diff --git a/jumpforth.S b/jumpforth.S index b0142ce..0d661c7 100644 --- a/jumpforth.S +++ b/jumpforth.S @@ -80,7 +80,7 @@ DODATA: pushl 4(%eax) NEXT -/* The default behavior for words defined with VALUE (or defparam) */ +/* The default behavior for words defined with VALUE (or defvalue) */ /* Load the word at the address in the DFA field and place it on the stack */ .text .align 4 @@ -173,7 +173,7 @@ defname \label,DODATA,\value,"\name",\flags /* Parameters are stored like variables but produce a value, not an address. */ /* Use this for data which is read-only after initialization. */ -.macro defparam label:req,initial=0,name="",flags=0 +.macro defvalue label:req,initial=0,name="",flags=0 defname \label,DOLOAD,data_\label,"\name",\flags .data .align 4 @@ -613,8 +613,8 @@ defconst SIGABRT,6 /* defconst __O_NONBLOCK,04000,"O_NONBLOCK" */ /* NOTE: These are initialized in _start and read-only thereafter. */ -defparam C0 /* first byte of the heap */ -defparam S0 /* initial (empty) data stack pointer */ +defvalue C0 /* first byte of the heap */ +defvalue S0 /* initial (empty) data stack pointer */ /* STATE controls whether we are currently executing code (0) or compiling (1) */ defvar STATE,0 /* default to executing code */ @@ -751,6 +751,20 @@ defcode PICK pushl (%esp,%eax,4) NEXT +/* ( xu ... x0 u -- xu-1 ... x0 xu ) */ +defcode ROLL + pop %ecx + movl (%esp,%ecx,4),%ebx + mov %esi,%edx + lea -4(%esp,%ecx,4),%esi + lea (%esp,%ecx,4),%edi + std + rep movsd + cld + mov %edx,%esi + movl %ebx,(%esp) + NEXT + /* ( 0 -- 0 ) */ /* ( a -- a a ) */ defcode QDUP,"?DUP" @@ -760,6 +774,13 @@ defcode QDUP,"?DUP" push %eax 1: NEXT +/* ( n -- d ) Convert a single-cell signed integer to a double-cell integer */ +defcode STOD,"S>D" + movl (%esp),%eax + cltd + push %edx + NEXT + /* ( a b -- a+b ) */ defcode ADD,"+" pop %eax @@ -782,10 +803,20 @@ defcode SUB1,"1-" decl (%esp) NEXT +/* ( x1 -- x2 ) Two's complement of x1 */ defcode NEGATE negl (%esp) NEXT +/* ( n -- u ) Absolute value */ +defcode ABS + pop %eax + test %eax,%eax + jl 0f + neg %eax +0: push %eax + NEXT + /* ( n1 n2 -- n1*n2 ) ( ignores overflow ) */ defcode MUL,"*" pop %eax @@ -794,6 +825,15 @@ defcode MUL,"*" push %eax NEXT +/* ( n1 n2 -- d ) Multiply, producting a double-cell result */ +defcode MMUL,"M*" + pop %eax + pop %ebx + imull %ebx,%eax + push %eax + push %edx + NEXT + /* ( u1 u2 -- u1*u2 ) ( ignores overflow ) */ defcode UMUL,"U*" pop %eax @@ -802,26 +842,87 @@ defcode UMUL,"U*" push %eax NEXT -/* ( n1 n2 -- n1%n2 n1/n2 ) */ -defcode DIVMOD,"/MOD" - pop %ebx +/* ( u1 u2 -- ud ) Multiply unsigned, producting a double-cell result */ +defcode UMMUL,"UM*" + pop %eax + pop %ebx + mull %ebx + push %eax + push %edx + NEXT + +/* ( d1 n1 -- d1%n1 d1/n1 ) Symmetric division (rounds toward zero) and remainder */ +defcode SMDIVREM,"SM/REM" + pop %ebx + pop %edx pop %eax - cltd idivl %ebx push %edx push %eax NEXT -/* ( u1 u2 -- u1%u2 u1/u2 ) */ -defcode UDIVMOD,"U/MOD" - xor %edx,%edx +/* ( ud1 u1 -- ud1%u1 ud1/u1 ) Unsigned division */ +defcode UMDIVMOD,"UM/MOD" pop %ebx + pop %edx pop %eax divl %ebx push %edx push %eax NEXT +/* ( n1 n2 n3 -- (n1*n2)%n3 (n1*n2)/n3 ) */ +/* Equivalent to >R M* R> SM/MOD */ +/* Note: The intermediate value between multiplication and division is 64 bits */ +defcode MULDIVMOD,"*/MOD" + pop %ecx + pop %ebx + pop %eax + imull %ebx + idivl %ecx + push %edx + push %eax + NEXT + +/* Same as MULDIVMOD but for unsigned inputs */ +/* Equivalent to >R UM* R> UM/MOD */ +defcode UMULDIVMOD,"U*/MOD" + pop %ecx + pop %ebx + pop %eax + mull %ebx + divl %ecx + push %edx + push %eax + NEXT + +/* ( x1 -- x2 ) Shift left by one bit */ +defcode TWOMUL,"2*" + shll $1,(%esp) + NEXT + +/* ( n1 -- n2 ) Arithmetic (signed) shift right by one bit */ +defcode TWODIV,"2/" + sarl $1,(%esp) + NEXT + +/* ( u1 -- u2 ) Logical (unsigned) shift right by one bit */ +defcode UTWODIV,"U2/" + shrl $1,(%esp) + NEXT + +/* ( x1 u -- x2 ) Shift left by u bits */ +defcode LSHIFT + pop %ecx + shll %cl,(%esp) + NEXT + +/* ( u1 u -- u2 ) Logical (unsigned) shift right by u bits */ +defcode RSHIFT + pop %ecx + shll %cl,(%esp) + NEXT + .macro defzcmp label,opcode,name="\label",flags=0 defcode \label,"\name",0,\flags pop %eax @@ -895,18 +996,6 @@ defcode INVERT notl (%esp) NEXT -defcode STORE,"!" - pop %ebx - pop %eax - mov %eax,(%ebx) - NEXT - -defcode FETCH,"@" - pop %ebx - mov (%ebx),%eax - push %eax - NEXT - defcode STOREBYTE,"C!" pop %ebx pop %eax @@ -920,6 +1009,48 @@ defcode FETCHBYTE,"C@" push %eax NEXT +defcode STORE,"!" + pop %ebx + popl (%ebx) + NEXT + +defcode FETCH,"@" + pop %ebx + pushl (%ebx) + NEXT + +defcode INCREMENT,"+!" + pop %ebx + pop %eax + addl %eax,(%ebx) + NEXT + +defcode DECREMENT,"-!" + pop %ebx + pop %eax + subl %eax,(%ebx) + NEXT + +defcode TWOSTORE,"2!" + pop %ebx + popl (%ebx) + popl 4(%ebx) + NEXT + +defcode TWOFETCH,"2@" + pop %ebx + pushl 4(%ebx) + pushl (%ebx) + NEXT + +/* ( c-addr u char -- ) Fill u characters starting at c-addr with char */ +defcode FILL + pop %eax + pop %ecx + pop %edi + rep stosb + NEXT + /* ( src dst n -- ) ( block copy n bytes from src to dst ) */ defcode CMOVE mov %esi,%edx diff --git a/startup.4th b/startup.4th index 52c1637..4e9c8dc 100644 --- a/startup.4th +++ b/startup.4th @@ -37,8 +37,18 @@ : ] ( -- ) IMMEDIATE TRUE STATE ! ; \ Separate the division and modulus operators -: / ( n1 n2 -- n1/n2 ) /MOD NIP ; -: MOD ( n1 n2 -- n1%n2 ) /MOD DROP ; +: /MOD ( n1 n2 -- n1%n2 n1/n2 ) >R S>D R> SM/REM ; +: / ( n1 n2 -- n1/n2 ) >R S>D R> SM/REM NIP ; +: MOD ( n1 n2 -- n1%n2 ) >R S>D R> SM/REM DROP ; + +\ Single-cell unsigned division and modulus +: U/MOD ( u1 u2 -- u1%u2 u1/u2 ) 0 SWAP UM/MOD ; +: U/ ( u1 u2 -- u1/u2 ) 0 SWAP UM/MOD NIP ; +: UMOD ( u1 u2 -- u1%u2 ) 0 SWAP UM/MOD DROP ; + +\ Flooring division and modulus (n1%n2 >= 0) +: FM/MOD ( d1 n1 -- d1%n1 d1/n1 ) + DUP >R SM/REM OVER 0< IF 1- SWAP R> + SWAP ELSE RDROP THEN ; \ Names for the standard file descriptor numbers 0 CONSTANT STDIN @@ -412,7 +422,7 @@ CHAR POSTPONE LITERAL ; \ Return -1, 0, or 1 if n is respectively negative, zero, or positive -: SIGN ( n -- -1 | 0 | 1 ) DUP IF 0< 2 * 1+ THEN ; +: SIGNUM ( n -- -1 | 0 | 1 ) DUP IF 0< 2 * 1+ THEN ; \ Return -1, 0, or 1 if the left string is respectively \ less than, equal to, or greater than the right string @@ -423,7 +433,7 @@ SWAP ?DUP IF ( S: a1 a2 u1 u2 ) 2SWAP 2DUP C@ SWAP C@ - DUP IF - >R 4 NDROP R> SIGN EXIT + >R 4 NDROP R> SIGNUM EXIT ELSE DROP ( S: u1 u2 a1 a2 ) @@ -442,29 +452,22 @@ THEN AGAIN ; +\ Display the unsigned number at the top of the stack +: U. ( u -- "" ) + \ Start with the highest place-value on the left + 1000000000 + \ Skip place-values that would be larger than the input + BEGIN 2DUP U< OVER 1 U> AND WHILE 10 U/ REPEAT + \ Emit the remaining digits down to the units' place + BEGIN + TUCK U/MOD [CHAR] 0 + EMIT SWAP + DUP 1 U<= IF 2DROP EXIT THEN + 10 U/ + AGAIN ; + \ Display the signed number at the top of the stack -: . ( n -- "" ) - DUP -2147483648 = IF - \ Special case, can't negate due to overflow - DROP "-2147483648" TYPE - ELSE - \ Emit the - sign and use absolute value if input is negative - DUP 0< IF - [CHAR] - EMIT - NEGATE - THEN - \ Start with the highest place-value on the left - 1000000000 - \ Skip place-values that would be larger than the input - BEGIN 2DUP < OVER 1 > AND WHILE 10 / REPEAT - \ Emit the remaining digits down to the units' place - BEGIN - TUCK /MOD [CHAR] 0 + EMIT SWAP - DUP 1 <= IF 2DROP EXIT THEN - 10 / - AGAIN - THEN -; +: . ( n -- "" ) + DUP 0< IF [CHAR] - EMIT NEGATE THEN U. ; \ Field accessors for the search order linked list : ORDER>LINK ( a-addr1 -- a-addr2 ) ; @@ -708,7 +711,7 @@ HIDE ORDER>LINK READSTRING THEN ELSE - PUTBACK WORD + PUTBACK 64 ALLOT WORD -64 ALLOT PARSENUMBER IF STATE @ IF POSTPONE LITERAL