From df3852f54a7fc4cb60dedf9d35b0a2344cbb9d54 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= Date: Sun, 27 Mar 2016 17:07:27 +0200 Subject: [PATCH] bootstrap.assembler: new word define-sub-primitives This way all sub primitives can be declared at once which imo is cleaner. --- basis/bootstrap/assembler/x86.32.factor | 215 +++++---- basis/bootstrap/assembler/x86.64.factor | 213 +++++---- basis/bootstrap/assembler/x86.factor | 592 ++++++++++++------------ basis/bootstrap/image/image.factor | 3 + 4 files changed, 502 insertions(+), 521 deletions(-) diff --git a/basis/bootstrap/assembler/x86.32.factor b/basis/bootstrap/assembler/x86.32.factor index fd9bd2c69e..3926645359 100644 --- a/basis/bootstrap/assembler/x86.32.factor +++ b/basis/bootstrap/assembler/x86.32.factor @@ -89,17 +89,6 @@ IN: bootstrap.x86 : jit-call-quot ( -- ) EAX quot-entry-point-offset [+] CALL ; -[ - jit-load-vm - EAX EBP 8 [+] MOV - vm-reg EAX "begin_callback" jit-call-2arg - - jit-call-quot - - jit-load-vm - vm-reg "end_callback" jit-call-1arg -] \ c-to-factor define-sub-primitive - : signal-handler-save-regs ( -- regs ) { EAX EBX ECX EDX EBP EDI ESI } ; @@ -111,69 +100,6 @@ IN: bootstrap.x86 [ jit-jump-quot ] \ (call) define-combinator-primitive -! unwind-native-frames is marked as "special" in vm/quotations.cpp -! so it does not have a standard prolog -[ - ! Load ds and rs registers - jit-load-vm - jit-load-context - jit-restore-context - - ! clear the fault flag - vm-reg vm-fault-flag-offset [+] 0 MOV - - ! Windows-specific setup - ctx-reg jit-update-seh - - ! Load arguments - EAX ESP bootstrap-cell [+] MOV - EDX ESP 2 bootstrap-cells [+] MOV - - ! Unwind stack frames - ESP EDX MOV - - jit-jump-quot -] \ unwind-native-frames define-sub-primitive - -[ - ESP 2 SUB - ESP [] FNSTCW - FNINIT - AX ESP [] MOV - ESP 2 ADD -] \ fpu-state define-sub-primitive - -[ - ESP stack-frame-size [+] FLDCW -] \ set-fpu-state define-sub-primitive - -[ - ! Load callstack object - temp3 ds-reg [] MOV - ds-reg bootstrap-cell SUB - ! Get ctx->callstack_bottom - jit-load-vm - jit-load-context - temp0 ctx-reg context-callstack-bottom-offset [+] MOV - ! Get top of callstack object -- 'src' for memcpy - temp1 temp3 callstack-top-offset [+] LEA - ! Get callstack length, in bytes --- 'len' for memcpy - temp2 temp3 callstack-length-offset [+] MOV - temp2 tag-bits get SHR - ! Compute new stack pointer -- 'dst' for memcpy - temp0 temp2 SUB - ! Install new stack pointer - ESP temp0 MOV - ! Call memcpy - temp2 PUSH - temp1 PUSH - temp0 PUSH - "factor_memcpy" jit-call - ESP 12 ADD - ! Return with new callstack - 0 RET -] \ set-callstack define-sub-primitive - [ jit-load-vm jit-save-context @@ -233,29 +159,6 @@ IN: bootstrap.x86 ] jit-conditional ; -[ [ ADD ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive - -[ [ SUB ] "overflow_fixnum_subtract" jit-overflow ] \ fixnum- define-sub-primitive - -[ - ds-reg 4 SUB - jit-load-vm - jit-save-context - ECX ds-reg [] MOV - EAX ECX MOV - EBP ds-reg 4 [+] MOV - EBP tag-bits get SAR - ! clobbers EDX - EBP IMUL - ds-reg [] EAX MOV - [ JNO ] - [ - ECX tag-bits get SAR - ECX EBP vm-reg "overflow_fixnum_multiply" jit-call-3arg - ] - jit-conditional -] \ fixnum* define-sub-primitive - ! Contexts : jit-switch-context ( reg -- ) ! Push a bogus return address so the GC can track this frame back @@ -299,8 +202,6 @@ IN: bootstrap.x86 ds-reg 4 ADD ds-reg [] EDX MOV ; -[ jit-set-context ] \ (set-context) define-sub-primitive - : jit-save-quot-and-param ( -- ) EDX ds-reg MOV ds-reg 8 SUB ; @@ -335,18 +236,11 @@ IN: bootstrap.x86 EAX EDX [] MOV jit-jump-quot ; -[ jit-start-context ] \ (start-context) define-sub-primitive - : jit-delete-current-context ( -- ) jit-load-vm jit-load-context vm-reg "delete_context" jit-call-1arg ; -[ - jit-delete-current-context - jit-set-context -] \ (set-context-and-delete) define-sub-primitive - : jit-start-context-and-delete ( -- ) jit-load-vm @@ -371,6 +265,109 @@ IN: bootstrap.x86 0 EAX MOVABS rc-absolute rel-safepoint ] JIT-SAFEPOINT jit-define -[ - jit-start-context-and-delete -] \ (start-context-and-delete) define-sub-primitive +! # All x86.32 subprimitives +{ + ! ## Contexts + { (set-context) [ jit-set-context ] } + { (set-context-and-delete) [ + jit-delete-current-context + jit-set-context + ] } + { (start-context) [ jit-start-context ] } + { (start-context-and-delete) [ jit-start-context-and-delete ] } + + ! ## Entry points + { c-to-factor [ + jit-load-vm + EAX EBP 8 [+] MOV + vm-reg EAX "begin_callback" jit-call-2arg + + jit-call-quot + + jit-load-vm + vm-reg "end_callback" jit-call-1arg + ] } + { unwind-native-frames [ + ! unwind-native-frames is marked as "special" in + ! vm/quotations.cpp so it does not have a standard prolog Load + ! ds and rs registers + jit-load-vm + jit-load-context + jit-restore-context + + ! clear the fault flag + vm-reg vm-fault-flag-offset [+] 0 MOV + + ! Windows-specific setup + ctx-reg jit-update-seh + + ! Load arguments + EAX ESP bootstrap-cell [+] MOV + EDX ESP 2 bootstrap-cells [+] MOV + + ! Unwind stack frames + ESP EDX MOV + + jit-jump-quot + ] } + + ! ## Math + { fixnum+ [ [ ADD ] "overflow_fixnum_add" jit-overflow ] } + { fixnum- [ [ SUB ] "overflow_fixnum_subtract" jit-overflow ] } + { fixnum* [ + ds-reg 4 SUB + jit-load-vm + jit-save-context + ECX ds-reg [] MOV + EAX ECX MOV + EBP ds-reg 4 [+] MOV + EBP tag-bits get SAR + ! clobbers EDX + EBP IMUL + ds-reg [] EAX MOV + [ JNO ] + [ + ECX tag-bits get SAR + ECX EBP vm-reg "overflow_fixnum_multiply" jit-call-3arg + ] + jit-conditional + ] } + + ! ## Misc + { fpu-state [ + ESP 2 SUB + ESP [] FNSTCW + FNINIT + AX ESP [] MOV + ESP 2 ADD + ] } + { set-fpu-state [ + ESP stack-frame-size [+] FLDCW + ] } + { set-callstack [ + ! Load callstack object + temp3 ds-reg [] MOV + ds-reg bootstrap-cell SUB + ! Get ctx->callstack_bottom + jit-load-vm + jit-load-context + temp0 ctx-reg context-callstack-bottom-offset [+] MOV + ! Get top of callstack object -- 'src' for memcpy + temp1 temp3 callstack-top-offset [+] LEA + ! Get callstack length, in bytes --- 'len' for memcpy + temp2 temp3 callstack-length-offset [+] MOV + temp2 tag-bits get SHR + ! Compute new stack pointer -- 'dst' for memcpy + temp0 temp2 SUB + ! Install new stack pointer + ESP temp0 MOV + ! Call memcpy + temp2 PUSH + temp1 PUSH + temp0 PUSH + "factor_memcpy" jit-call + ESP 12 ADD + ! Return with new callstack + 0 RET + ] } +} define-sub-primitives diff --git a/basis/bootstrap/assembler/x86.64.factor b/basis/bootstrap/assembler/x86.64.factor index 1cf3ee2a78..398d7bb85a 100644 --- a/basis/bootstrap/assembler/x86.64.factor +++ b/basis/bootstrap/assembler/x86.64.factor @@ -85,17 +85,6 @@ IN: bootstrap.x86 : jit-call-quot ( -- ) arg1 quot-entry-point-offset [+] CALL ; -[ - arg2 arg1 MOV - vm-reg "begin_callback" jit-call-1arg - - ! call the quotation - arg1 return-reg MOV - jit-call-quot - - vm-reg "end_callback" jit-call-1arg -] \ c-to-factor define-sub-primitive - : signal-handler-save-regs ( -- regs ) { RAX RCX RDX RBX RBP RSI RDI R8 R9 R10 R11 R12 R13 R14 R15 } ; @@ -107,66 +96,6 @@ IN: bootstrap.x86 [ jit-jump-quot ] \ (call) define-combinator-primitive -[ - ! Unwind stack frames - RSP arg2 MOV - - ! Load VM pointer into vm-reg, since we're entering from - ! C code - vm-reg 0 MOV 0 rc-absolute-cell rel-vm - - ! Load ds and rs registers - jit-load-context - jit-restore-context - - ! Clear the fault flag - vm-reg vm-fault-flag-offset [+] 0 MOV - - ! Call quotation - jit-jump-quot -] \ unwind-native-frames define-sub-primitive - -[ - RSP 2 SUB - RSP [] FNSTCW - FNINIT - AX RSP [] MOV - RSP 2 ADD -] \ fpu-state define-sub-primitive - -[ - RSP 2 SUB - RSP [] arg1 16-bit-version-of MOV - RSP [] FLDCW - RSP 2 ADD -] \ set-fpu-state define-sub-primitive - -[ - ! Load callstack object - arg4 ds-reg [] MOV - ds-reg bootstrap-cell SUB - ! Get ctx->callstack_bottom - jit-load-context - arg1 ctx-reg context-callstack-bottom-offset [+] MOV - ! Get top of callstack object -- 'src' for memcpy - arg2 arg4 callstack-top-offset [+] LEA - ! Get callstack length, in bytes --- 'len' for memcpy - arg3 arg4 callstack-length-offset [+] MOV - arg3 tag-bits get SHR - ! Compute new stack pointer -- 'dst' for memcpy - arg1 arg3 SUB - ! Install new stack pointer - RSP arg1 MOV - ! Call memcpy; arguments are now in the correct registers - ! Create register shadow area for Win64 - RSP 32 SUB - "factor_memcpy" jit-call - ! Tear down register shadow area - RSP 32 ADD - ! Return with new callstack - 0 RET -] \ set-callstack define-sub-primitive - [ jit-save-context arg2 vm-reg MOV @@ -220,30 +149,6 @@ IN: bootstrap.x86 [ arg3 vm-reg MOV jit-call ] jit-conditional ; inline -[ [ ADD ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive - -[ [ SUB ] "overflow_fixnum_subtract" jit-overflow ] \ fixnum- define-sub-primitive - -[ - ds-reg 8 SUB - jit-save-context - RCX ds-reg [] MOV - RBX ds-reg 8 [+] MOV - RBX tag-bits get SAR - RAX RCX MOV - RBX IMUL - ds-reg [] RAX MOV - [ JNO ] - [ - arg1 RCX MOV - arg1 tag-bits get SAR - arg2 RBX MOV - arg3 vm-reg MOV - "overflow_fixnum_multiply" jit-call - ] - jit-conditional -] \ fixnum* define-sub-primitive - ! Contexts : jit-switch-context ( reg -- ) ! Push a bogus return address so the GC can track this frame back @@ -279,8 +184,6 @@ IN: bootstrap.x86 RSP 8 ADD jit-push-param ; -[ jit-set-context ] \ (set-context) define-sub-primitive - : jit-pop-quot-and-param ( -- ) arg1 ds-reg [] MOV arg2 ds-reg -8 [+] MOV @@ -299,16 +202,9 @@ IN: bootstrap.x86 jit-push-param jit-jump-quot ; -[ jit-start-context ] \ (start-context) define-sub-primitive - : jit-delete-current-context ( -- ) vm-reg "delete_context" jit-call-1arg ; -[ - jit-delete-current-context - jit-set-context -] \ (set-context-and-delete) define-sub-primitive - ! Resets the active context and instead the passed in quotation ! becomes the new code that it executes. : jit-start-context-and-delete ( -- ) @@ -333,6 +229,109 @@ IN: bootstrap.x86 0 [RIP+] EAX MOV rc-relative rel-safepoint ] JIT-SAFEPOINT jit-define -[ - jit-start-context-and-delete -] \ (start-context-and-delete) define-sub-primitive +! # All x86.64 subprimitives +{ + ! ## Contexts + { (set-context) [ jit-set-context ] } + { (set-context-and-delete) [ + jit-delete-current-context + jit-set-context + ] } + { (start-context) [ jit-start-context ] } + { (start-context-and-delete) [ jit-start-context-and-delete ] } + + ! ## Entry points + { c-to-factor [ + arg2 arg1 MOV + vm-reg "begin_callback" jit-call-1arg + + ! call the quotation + arg1 return-reg MOV + jit-call-quot + + vm-reg "end_callback" jit-call-1arg + ] } + { unwind-native-frames [ + ! unwind-native-frames is marked as "special" in + ! vm/quotations.cpp so it does not have a standard prolog + ! Unwind stack frames + RSP arg2 MOV + + ! Load VM pointer into vm-reg, since we're entering from + ! C code + vm-reg 0 MOV 0 rc-absolute-cell rel-vm + + ! Load ds and rs registers + jit-load-context + jit-restore-context + + ! Clear the fault flag + vm-reg vm-fault-flag-offset [+] 0 MOV + + ! Call quotation + jit-jump-quot + ] } + + ! ## Math + { fixnum+ [ [ ADD ] "overflow_fixnum_add" jit-overflow ] } + { fixnum- [ [ SUB ] "overflow_fixnum_subtract" jit-overflow ] } + { fixnum* [ + ds-reg 8 SUB + jit-save-context + RCX ds-reg [] MOV + RBX ds-reg 8 [+] MOV + RBX tag-bits get SAR + RAX RCX MOV + RBX IMUL + ds-reg [] RAX MOV + [ JNO ] + [ + arg1 RCX MOV + arg1 tag-bits get SAR + arg2 RBX MOV + arg3 vm-reg MOV + "overflow_fixnum_multiply" jit-call + ] + jit-conditional + ] } + + ! ## Misc + { fpu-state [ + RSP 2 SUB + RSP [] FNSTCW + FNINIT + AX RSP [] MOV + RSP 2 ADD + ] } + { set-fpu-state [ + RSP 2 SUB + RSP [] arg1 16-bit-version-of MOV + RSP [] FLDCW + RSP 2 ADD + ] } + { set-callstack [ + ! Load callstack object + arg4 ds-reg [] MOV + ds-reg bootstrap-cell SUB + ! Get ctx->callstack_bottom + jit-load-context + arg1 ctx-reg context-callstack-bottom-offset [+] MOV + ! Get top of callstack object -- 'src' for memcpy + arg2 arg4 callstack-top-offset [+] LEA + ! Get callstack length, in bytes --- 'len' for memcpy + arg3 arg4 callstack-length-offset [+] MOV + arg3 tag-bits get SHR + ! Compute new stack pointer -- 'dst' for memcpy + arg1 arg3 SUB + ! Install new stack pointer + RSP arg1 MOV + ! Call memcpy; arguments are now in the correct registers + ! Create register shadow area for Win64 + RSP 32 SUB + "factor_memcpy" jit-call + ! Tear down register shadow area + RSP 32 ADD + ! Return with new callstack + 0 RET + ] } +} define-sub-primitives diff --git a/basis/bootstrap/assembler/x86.factor b/basis/bootstrap/assembler/x86.factor index f5dd5884e6..6f5008d469 100644 --- a/basis/bootstrap/assembler/x86.factor +++ b/basis/bootstrap/assembler/x86.factor @@ -3,7 +3,7 @@ USING: bootstrap.image.private compiler.codegen.relocation compiler.constants compiler.units cpu.x86.assembler cpu.x86.assembler.operands kernel kernel.private layouts locals -locals.backend math math.private namespaces sequences +locals.backend math math.private memory namespaces sequences slots.private strings.private vocabs ; IN: bootstrap.x86 @@ -117,25 +117,6 @@ big-endian off POPF signal-handler-save-regs reverse [ POP ] each ; -[| | - jit-signal-handler-prolog - jit-save-context - temp0 vm-reg vm-signal-handler-addr-offset [+] MOV - temp0 CALL - jit-signal-handler-epilog - 0 RET -] \ signal-handler define-sub-primitive - -[| | - jit-signal-handler-prolog - jit-save-context - temp0 vm-reg vm-signal-handler-addr-offset [+] MOV - temp0 CALL - jit-signal-handler-epilog - ! Pop the fake leaf frame along with our return address - leaf-stack-frame-size bootstrap-cell - RET -] \ leaf-signal-handler define-sub-primitive - [ ! load boolean temp0 ds-reg [] MOV @@ -303,172 +284,6 @@ big-endian off ] jit-conditional ] MEGA-LOOKUP jit-define -! ! ! Sub-primitives - -! Objects -[ - ! load from stack - temp0 ds-reg [] MOV - ! compute tag - temp0 tag-mask get AND - ! tag the tag - temp0 tag-bits get SHL - ! push to stack - ds-reg [] temp0 MOV -] \ tag define-sub-primitive - -[ - ! load slot number - temp0 ds-reg [] MOV - ! adjust stack pointer - ds-reg bootstrap-cell SUB - ! load object - temp1 ds-reg [] MOV - ! turn slot number into offset - fixnum>slot@ - ! mask off tag - temp1 tag-bits get SHR - temp1 tag-bits get SHL - ! load slot value - temp0 temp1 temp0 [+] MOV - ! push to stack - ds-reg [] temp0 MOV -] \ slot define-sub-primitive - -[ - ! load string index from stack - temp0 ds-reg bootstrap-cell neg [+] MOV - temp0 tag-bits get SHR - ! load string from stack - temp1 ds-reg [] MOV - ! load character - temp0 8-bit-version-of temp0 temp1 string-offset [++] MOV - temp0 temp0 8-bit-version-of MOVZX - temp0 tag-bits get SHL - ! store character to stack - ds-reg bootstrap-cell SUB - ds-reg [] temp0 MOV -] \ string-nth-fast define-sub-primitive - -! Shufflers -[ - ds-reg bootstrap-cell SUB -] \ drop define-sub-primitive - -[ - ds-reg 2 bootstrap-cells SUB -] \ 2drop define-sub-primitive - -[ - ds-reg 3 bootstrap-cells SUB -] \ 3drop define-sub-primitive - -[ - ds-reg 4 bootstrap-cells SUB -] \ 4drop define-sub-primitive - -[ - temp0 ds-reg [] MOV - ds-reg bootstrap-cell ADD - ds-reg [] temp0 MOV -] \ dup define-sub-primitive - -[ - temp0 ds-reg [] MOV - temp1 ds-reg bootstrap-cell neg [+] MOV - ds-reg 2 bootstrap-cells ADD - ds-reg [] temp0 MOV - ds-reg bootstrap-cell neg [+] temp1 MOV -] \ 2dup define-sub-primitive - -[ - temp0 ds-reg [] MOV - temp1 ds-reg -1 bootstrap-cells [+] MOV - temp3 ds-reg -2 bootstrap-cells [+] MOV - ds-reg 3 bootstrap-cells ADD - ds-reg [] temp0 MOV - ds-reg -1 bootstrap-cells [+] temp1 MOV - ds-reg -2 bootstrap-cells [+] temp3 MOV -] \ 3dup define-sub-primitive - -[ - temp0 ds-reg [] MOV - temp1 ds-reg -1 bootstrap-cells [+] MOV - temp2 ds-reg -2 bootstrap-cells [+] MOV - temp3 ds-reg -3 bootstrap-cells [+] MOV - ds-reg 4 bootstrap-cells ADD - ds-reg [] temp0 MOV - ds-reg -1 bootstrap-cells [+] temp1 MOV - ds-reg -2 bootstrap-cells [+] temp2 MOV - ds-reg -3 bootstrap-cells [+] temp3 MOV -] \ 4dup define-sub-primitive - -[ - temp0 ds-reg [] MOV - ds-reg bootstrap-cell SUB - ds-reg [] temp0 MOV -] \ nip define-sub-primitive - -[ - temp0 ds-reg [] MOV - ds-reg 2 bootstrap-cells SUB - ds-reg [] temp0 MOV -] \ 2nip define-sub-primitive - -[ - temp0 ds-reg -1 bootstrap-cells [+] MOV - ds-reg bootstrap-cell ADD - ds-reg [] temp0 MOV -] \ over define-sub-primitive - -[ - temp0 ds-reg -2 bootstrap-cells [+] MOV - ds-reg bootstrap-cell ADD - ds-reg [] temp0 MOV -] \ pick define-sub-primitive - -[ - temp0 ds-reg [] MOV - temp1 ds-reg -1 bootstrap-cells [+] MOV - ds-reg [] temp1 MOV - ds-reg bootstrap-cell ADD - ds-reg [] temp0 MOV -] \ dupd define-sub-primitive - -[ - temp0 ds-reg [] MOV - temp1 ds-reg bootstrap-cell neg [+] MOV - ds-reg bootstrap-cell neg [+] temp0 MOV - ds-reg [] temp1 MOV -] \ swap define-sub-primitive - -[ - temp0 ds-reg -1 bootstrap-cells [+] MOV - temp1 ds-reg -2 bootstrap-cells [+] MOV - ds-reg -2 bootstrap-cells [+] temp0 MOV - ds-reg -1 bootstrap-cells [+] temp1 MOV -] \ swapd define-sub-primitive - -[ - temp0 ds-reg [] MOV - temp1 ds-reg -1 bootstrap-cells [+] MOV - temp3 ds-reg -2 bootstrap-cells [+] MOV - ds-reg -2 bootstrap-cells [+] temp1 MOV - ds-reg -1 bootstrap-cells [+] temp0 MOV - ds-reg [] temp3 MOV -] \ rot define-sub-primitive - -[ - temp0 ds-reg [] MOV - temp1 ds-reg -1 bootstrap-cells [+] MOV - temp3 ds-reg -2 bootstrap-cells [+] MOV - ds-reg -2 bootstrap-cells [+] temp0 MOV - ds-reg -1 bootstrap-cells [+] temp3 MOV - ds-reg [] temp1 MOV -] \ -rot define-sub-primitive - -[ jit->r ] \ load-local define-sub-primitive - ! Comparisons : jit-compare ( insn -- ) ! load t @@ -486,15 +301,6 @@ big-endian off ! store ds-reg [] temp1 MOV ; -: define-jit-compare ( insn word -- ) - [ [ jit-compare ] curry ] dip define-sub-primitive ; - -\ CMOVE \ eq? define-jit-compare -\ CMOVGE \ fixnum>= define-jit-compare -\ CMOVLE \ fixnum<= define-jit-compare -\ CMOVG \ fixnum> define-jit-compare -\ CMOVL \ fixnum< define-jit-compare - ! Math : jit-math ( insn -- ) ! load second input @@ -504,62 +310,6 @@ big-endian off ! compute result [ ds-reg [] temp0 ] dip execute( dst src -- ) ; -[ \ ADD jit-math ] \ fixnum+fast define-sub-primitive - -[ \ SUB jit-math ] \ fixnum-fast define-sub-primitive - -[ - ! load second input - temp0 ds-reg [] MOV - ! pop stack - ds-reg bootstrap-cell SUB - ! load first input - temp1 ds-reg [] MOV - ! untag second input - temp0 tag-bits get SAR - ! multiply - temp0 temp1 IMUL2 - ! push result - ds-reg [] temp0 MOV -] \ fixnum*fast define-sub-primitive - -[ \ AND jit-math ] \ fixnum-bitand define-sub-primitive - -[ \ OR jit-math ] \ fixnum-bitor define-sub-primitive - -[ \ XOR jit-math ] \ fixnum-bitxor define-sub-primitive - -[ - ! complement - ds-reg [] NOT - ! clear tag bits - ds-reg [] tag-mask get XOR -] \ fixnum-bitnot define-sub-primitive - -[ - ! load shift count - shift-arg ds-reg [] MOV - ! untag shift count - shift-arg tag-bits get SAR - ! adjust stack pointer - ds-reg bootstrap-cell SUB - ! load value - temp3 ds-reg [] MOV - ! make a copy - temp2 temp3 MOV - ! compute positive shift value in temp2 - temp2 CL SHL - shift-arg NEG - ! compute negative shift value in temp3 - temp3 CL SAR - temp3 tag-mask get bitnot AND - shift-arg 0 CMP - ! if shift count was negative, move temp0 to temp2 - temp2 temp3 CMOVGE - ! push to stack - ds-reg [] temp2 MOV -] \ fixnum-shift-fast define-sub-primitive - : jit-fixnum-/mod ( -- ) ! load second parameter temp1 ds-reg [] MOV @@ -572,64 +322,296 @@ big-endian off ! divide temp1 IDIV ; -[ - jit-fixnum-/mod - ! adjust stack pointer - ds-reg bootstrap-cell SUB - ! push to stack - ds-reg [] mod-arg MOV -] \ fixnum-mod define-sub-primitive +! # All x86 subprimitives +{ + ! ## Fixnums -[ - jit-fixnum-/mod - ! adjust stack pointer - ds-reg bootstrap-cell SUB - ! tag it - div-arg tag-bits get SHL - ! push to stack - ds-reg [] div-arg MOV -] \ fixnum/i-fast define-sub-primitive + ! ### Add + { fixnum+fast [ \ ADD jit-math ] } -[ - jit-fixnum-/mod - ! tag it - div-arg tag-bits get SHL - ! push to stack - ds-reg [] mod-arg MOV - ds-reg bootstrap-cell neg [+] div-arg MOV -] \ fixnum/mod-fast define-sub-primitive + ! ### Bit stuff + { fixnum-bitand [ \ AND jit-math ] } + { fixnum-bitnot [ + ! complement + ds-reg [] NOT + ! clear tag bits + ds-reg [] tag-mask get XOR + ] } + { fixnum-bitor [ \ OR jit-math ] } + { fixnum-bitxor [ \ XOR jit-math ] } + { fixnum-shift-fast [ + ! load shift count + shift-arg ds-reg [] MOV + ! untag shift count + shift-arg tag-bits get SAR + ! adjust stack pointer + ds-reg bootstrap-cell SUB + ! load value + temp3 ds-reg [] MOV + ! make a copy + temp2 temp3 MOV + ! compute positive shift value in temp2 + temp2 CL SHL + shift-arg NEG + ! compute negative shift value in temp3 + temp3 CL SAR + temp3 tag-mask get bitnot AND + shift-arg 0 CMP + ! if shift count was negative, move temp0 to temp2 + temp2 temp3 CMOVGE + ! push to stack + ds-reg [] temp2 MOV + ] } -[ - temp0 ds-reg [] MOV - ds-reg bootstrap-cell SUB - temp0 ds-reg [] OR - temp0 tag-mask get TEST - temp0 \ f type-number MOV - temp1 1 tag-fixnum MOV - temp0 temp1 CMOVE - ds-reg [] temp0 MOV -] \ both-fixnums? define-sub-primitive + ! ### Comparisons + { both-fixnums? [ + temp0 ds-reg [] MOV + ds-reg bootstrap-cell SUB + temp0 ds-reg [] OR + temp0 tag-mask get TEST + temp0 \ f type-number MOV + temp1 1 tag-fixnum MOV + temp0 temp1 CMOVE + ds-reg [] temp0 MOV + ] } + { eq? [ \ CMOVE jit-compare ] } + { fixnum> [ \ CMOVG jit-compare ] } + { fixnum>= [ \ CMOVGE jit-compare ] } + { fixnum< [ \ CMOVL jit-compare ] } + { fixnum<= [ \ CMOVLE jit-compare ] } -[ - ! load local number - temp0 ds-reg [] MOV - ! turn local number into offset - fixnum>slot@ - ! load local value - temp0 rs-reg temp0 [+] MOV - ! push to stack - ds-reg [] temp0 MOV -] \ get-local define-sub-primitive + ! ### Div/mod + { fixnum-mod [ + jit-fixnum-/mod + ! adjust stack pointer + ds-reg bootstrap-cell SUB + ! push to stack + ds-reg [] mod-arg MOV + ] } + { fixnum/i-fast [ + jit-fixnum-/mod + ! adjust stack pointer + ds-reg bootstrap-cell SUB + ! tag it + div-arg tag-bits get SHL + ! push to stack + ds-reg [] div-arg MOV + ] } + { fixnum/mod-fast [ + jit-fixnum-/mod + ! tag it + div-arg tag-bits get SHL + ! push to stack + ds-reg [] mod-arg MOV + ds-reg bootstrap-cell neg [+] div-arg MOV + ] } -[ - ! load local count - temp0 ds-reg [] MOV - ! adjust stack pointer - ds-reg bootstrap-cell SUB - ! turn local number into offset - fixnum>slot@ - ! decrement retain stack pointer - rs-reg temp0 SUB -] \ drop-locals define-sub-primitive + ! ### Mul + { fixnum*fast [ + ! load second input + temp0 ds-reg [] MOV + ! pop stack + ds-reg bootstrap-cell SUB + ! load first input + temp1 ds-reg [] MOV + ! untag second input + temp0 tag-bits get SAR + ! multiply + temp0 temp1 IMUL2 + ! push result + ds-reg [] temp0 MOV + ] } + + ! ### Sub + { fixnum-fast [ \ SUB jit-math ] } + + ! ## Locals + { drop-locals [ + ! load local count + temp0 ds-reg [] MOV + ! adjust stack pointer + ds-reg bootstrap-cell SUB + ! turn local number into offset + fixnum>slot@ + ! decrement retain stack pointer + rs-reg temp0 SUB + ] } + { get-local [ + ! load local number + temp0 ds-reg [] MOV + ! turn local number into offset + fixnum>slot@ + ! load local value + temp0 rs-reg temp0 [+] MOV + ! push to stack + ds-reg [] temp0 MOV + ] } + { load-local [ jit->r ] } + + ! ## Objects + { slot [ + ! load slot number + temp0 ds-reg [] MOV + ! adjust stack pointer + ds-reg bootstrap-cell SUB + ! load object + temp1 ds-reg [] MOV + ! turn slot number into offset + fixnum>slot@ + ! mask off tag + temp1 tag-bits get SHR + temp1 tag-bits get SHL + ! load slot value + temp0 temp1 temp0 [+] MOV + ! push to stack + ds-reg [] temp0 MOV + ] } + { string-nth-fast [ + ! load string index from stack + temp0 ds-reg bootstrap-cell neg [+] MOV + temp0 tag-bits get SHR + ! load string from stack + temp1 ds-reg [] MOV + ! load character + temp0 8-bit-version-of temp0 temp1 string-offset [++] MOV + temp0 temp0 8-bit-version-of MOVZX + temp0 tag-bits get SHL + ! store character to stack + ds-reg bootstrap-cell SUB + ds-reg [] temp0 MOV + ] } + { tag [ + ! load from stack + temp0 ds-reg [] MOV + ! compute tag + temp0 tag-mask get AND + ! tag the tag + temp0 tag-bits get SHL + ! push to stack + ds-reg [] temp0 MOV + ] } + + ! ## Shufflers + + ! ### Drops + { drop [ ds-reg bootstrap-cell SUB ] } + { 2drop [ ds-reg 2 bootstrap-cells SUB ] } + { 3drop [ ds-reg 3 bootstrap-cells SUB ] } + { 4drop [ ds-reg 4 bootstrap-cells SUB ] } + + ! ### Dups + { dup [ + temp0 ds-reg [] MOV + ds-reg bootstrap-cell ADD + ds-reg [] temp0 MOV + ] } + { 2dup [ + temp0 ds-reg [] MOV + temp1 ds-reg bootstrap-cell neg [+] MOV + ds-reg 2 bootstrap-cells ADD + ds-reg [] temp0 MOV + ds-reg bootstrap-cell neg [+] temp1 MOV + ] } + { 3dup [ + temp0 ds-reg [] MOV + temp1 ds-reg -1 bootstrap-cells [+] MOV + temp3 ds-reg -2 bootstrap-cells [+] MOV + ds-reg 3 bootstrap-cells ADD + ds-reg [] temp0 MOV + ds-reg -1 bootstrap-cells [+] temp1 MOV + ds-reg -2 bootstrap-cells [+] temp3 MOV + ] } + { 4dup [ + temp0 ds-reg [] MOV + temp1 ds-reg -1 bootstrap-cells [+] MOV + temp2 ds-reg -2 bootstrap-cells [+] MOV + temp3 ds-reg -3 bootstrap-cells [+] MOV + ds-reg 4 bootstrap-cells ADD + ds-reg [] temp0 MOV + ds-reg -1 bootstrap-cells [+] temp1 MOV + ds-reg -2 bootstrap-cells [+] temp2 MOV + ds-reg -3 bootstrap-cells [+] temp3 MOV + ] } + { dupd [ + temp0 ds-reg [] MOV + temp1 ds-reg -1 bootstrap-cells [+] MOV + ds-reg [] temp1 MOV + ds-reg bootstrap-cell ADD + ds-reg [] temp0 MOV + ] } + + ! ### Misc shufflers + { over [ + temp0 ds-reg -1 bootstrap-cells [+] MOV + ds-reg bootstrap-cell ADD + ds-reg [] temp0 MOV + ] } + { pick [ + temp0 ds-reg -2 bootstrap-cells [+] MOV + ds-reg bootstrap-cell ADD + ds-reg [] temp0 MOV + ] } + + ! ### Nips + { nip [ + temp0 ds-reg [] MOV + ds-reg bootstrap-cell SUB + ds-reg [] temp0 MOV + ] } + { 2nip [ + temp0 ds-reg [] MOV + ds-reg 2 bootstrap-cells SUB + ds-reg [] temp0 MOV + ] } + + ! ### Swaps + { -rot [ + temp0 ds-reg [] MOV + temp1 ds-reg -1 bootstrap-cells [+] MOV + temp3 ds-reg -2 bootstrap-cells [+] MOV + ds-reg -2 bootstrap-cells [+] temp0 MOV + ds-reg -1 bootstrap-cells [+] temp3 MOV + ds-reg [] temp1 MOV + ] } + { rot [ + temp0 ds-reg [] MOV + temp1 ds-reg -1 bootstrap-cells [+] MOV + temp3 ds-reg -2 bootstrap-cells [+] MOV + ds-reg -2 bootstrap-cells [+] temp1 MOV + ds-reg -1 bootstrap-cells [+] temp0 MOV + ds-reg [] temp3 MOV + ] } + { swap [ + temp0 ds-reg [] MOV + temp1 ds-reg bootstrap-cell neg [+] MOV + ds-reg bootstrap-cell neg [+] temp0 MOV + ds-reg [] temp1 MOV + ] } + { swapd [ + temp0 ds-reg -1 bootstrap-cells [+] MOV + temp1 ds-reg -2 bootstrap-cells [+] MOV + ds-reg -2 bootstrap-cells [+] temp0 MOV + ds-reg -1 bootstrap-cells [+] temp1 MOV + ] } + + ! ## Signal handling + { leaf-signal-handler [ + jit-signal-handler-prolog + jit-save-context + temp0 vm-reg vm-signal-handler-addr-offset [+] MOV + temp0 CALL + jit-signal-handler-epilog + ! Pop the fake leaf frame along with our return address + leaf-stack-frame-size bootstrap-cell - RET + ] } + { signal-handler [ + jit-signal-handler-prolog + jit-save-context + temp0 vm-reg vm-signal-handler-addr-offset [+] MOV + temp0 CALL + jit-signal-handler-epilog + 0 RET + ] } +} define-sub-primitives [ "bootstrap.x86" forget-vocab ] with-compilation-unit diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor index 52ce5c1fee..f4dc82f590 100755 --- a/basis/bootstrap/image/image.factor +++ b/basis/bootstrap/image/image.factor @@ -126,6 +126,9 @@ SYMBOL: special-objects : define-sub-primitive ( quot word -- ) [ make-jit 3array ] dip sub-primitives get set-at ; +: define-sub-primitives ( assoc -- ) + [ swap define-sub-primitive ] assoc-each ; + : define-combinator-primitive ( quot non-tail-quot tail-quot word -- ) [ [