steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

load primitive types in stage 1

cvs
Slava Pestov 2005-12-07 02:34:18 +00:00
parent 00ec673094
commit ceb15dbe5d
5 changed files with 33 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
library/bootstrap/boot-stage1.factor
View File

@ -136,6 +136,7 @@ vectors words ;
"/library/compiler/compiler.factor" "/library/compiler/compiler.factor"
"/library/alien/c-types.factor" "/library/alien/c-types.factor"
"/library/alien/primitive-types.factor"
"/library/alien/structs.factor" "/library/alien/structs.factor"
"/library/alien/compiler.factor" "/library/alien/compiler.factor"
"/library/alien/syntax.factor" "/library/alien/syntax.factor"

32
library/bootstrap/boot-stage2.factor
View File

@ -5,27 +5,23 @@ errors generic hashtables io io-internals kernel
kernel-internals lists math memory namespaces optimizer parser kernel-internals lists math memory namespaces optimizer parser
sequences sequences-internals words ; sequences sequences-internals words ;
: pull-in ( ? list -- )
swap [ [ dup print run-resource ] each ] [ drop ] if ;
"Loading compiler backend..." print "Loading compiler backend..." print
cpu "x86" = [ cpu "x86" = [
"/library/compiler/x86/load.factor" "/library/compiler/x86/load.factor" run-resource
] pull-in ] when
cpu "ppc" = [ cpu "ppc" = [
"/library/compiler/ppc/load.factor" "/library/compiler/ppc/load.factor" run-resource
] pull-in ] when
cpu "amd64" = [ cpu "amd64" = [
"/library/compiler/amd64/load.factor" "/library/compiler/amd64/load.factor" run-resource
] pull-in ] when
"Loading more library code..." print "Loading more library code..." print
t [ [
"/library/alien/primitive-types.factor"
"/library/alien/malloc.factor" "/library/alien/malloc.factor"
"/library/io/buffer.factor" "/library/io/buffer.factor"
@ -34,19 +30,21 @@ t [
"/library/freetype/load.factor" "/library/freetype/load.factor"
"/library/ui/load.factor" "/library/ui/load.factor"
"/library/help/load.factor" "/library/help/load.factor"
] pull-in ] [
dup print run-resource
] each
! Handle -libraries:... overrides ! Handle -libraries:... overrides
parse-command-line parse-command-line
"compile" get supported-cpu? and [ "compile" get supported-cpu? and [
unix? [ unix? [
"/library/unix/load.factor" "/library/unix/load.factor" run-resource
] pull-in ] when
os "win32" = [ os "win32" = [
"/library/win32/load.factor" "/library/win32/load.factor" run-resource
] pull-in ] when
"Compiling base..." print "Compiling base..." print
@ -96,5 +94,3 @@ number>string write " ms" print
"factor.image" save-image "factor.image" save-image
0 exit 0 exit
FORGET: pull-in

2
library/compiler/amd64/architecture.factor
View File

@ -28,3 +28,5 @@ M: float-regs fastcall-regs drop 0 ;
0 scratch [ swap MOV ] keep ; inline 0 scratch [ swap MOV ] keep ; inline
: fixnum>slot@ drop ; inline : fixnum>slot@ drop ; inline
: return-register RAX ; inline

2
library/compiler/x86/architecture.factor
View File

@ -28,3 +28,5 @@ M: float-regs fastcall-regs drop 0 ;
; inline ; inline
: fixnum>slot@ 1 SHR ; inline : fixnum>slot@ 1 SHR ; inline
: return-register EAX ; inline

26
library/compiler/x86/fixnum.factor
View File

@ -29,7 +29,7 @@ math-internals memory namespaces words ;
"s48_long_to_bignum" f compile-c-call "s48_long_to_bignum" f compile-c-call
! An untagged pointer to the bignum is now in EAX; tag it ! An untagged pointer to the bignum is now in EAX; tag it
EAX bignum-tag OR EAX bignum-tag OR
ESP 4 ADD 0 scratch POP
"end" get save-xt ; inline "end" get save-xt ; inline
M: %fixnum+ generate-node ( vop -- ) M: %fixnum+ generate-node ( vop -- )
@ -111,32 +111,33 @@ M: %fixnum-bitnot generate-node ( vop -- )
0 output-operand tag-mask XOR ; 0 output-operand tag-mask XOR ;
M: %fixnum<< generate-node M: %fixnum<< generate-node
#! This has specific register requirements.
drop drop
! This has specific register requirements.
<label> "no-overflow" set <label> "no-overflow" set
<label> "end" set <label> "end" set
! make a copy ! make a copy
ECX EAX MOV 0 scratch 1 input-operand MOV
! check for potential overflow ! check for potential overflow
ECX 0 input shift-add ADD 0 scratch 0 input shift-add ADD
ECX 0 input shift-add 2 * 1- CMP 0 scratch 0 input shift-add 2 * 1- CMP
! is there going to be an overflow? ! is there going to be an overflow?
"no-overflow" get JBE "no-overflow" get JBE
! there is going to be an overflow, make a bignum ! there is going to be an overflow, make a bignum
EAX tag-bits SAR 1 input-operand tag-bits SAR
0 input PUSH 0 input PUSH
EAX PUSH 1 input-operand PUSH
"s48_long_to_bignum" f compile-c-call "s48_long_to_bignum" f compile-c-call
EDX POP 0 scratch POP
EAX PUSH 1 input-operand PUSH
"s48_bignum_arithmetic_shift" f compile-c-call "s48_bignum_arithmetic_shift" f compile-c-call
! tag the result ! tag the result
EAX bignum-tag OR 1 input-operand bignum-tag OR
ESP cell 2 * ADD 0 scratch POP
1 scratch POP
"end" get JMP "end" get JMP
! there is not going to be an overflow ! there is not going to be an overflow
"no-overflow" get save-xt "no-overflow" get save-xt
EAX 0 input SHL 1 input-operand 0 input SHL
"end" get save-xt ; "end" get save-xt ;
M: %fixnum>> generate-node M: %fixnum>> generate-node
@ -147,6 +148,7 @@ M: %fixnum>> generate-node
0 output-operand tag-mask bitnot AND ; 0 output-operand tag-mask bitnot AND ;
M: %fixnum-sgn generate-node M: %fixnum-sgn generate-node
#! This has specific register requirements.
drop drop
! store 0 in EDX if EAX is >=0, otherwise store -1. ! store 0 in EDX if EAX is >=0, otherwise store -1.
CDQ CDQ