From 70c87e3d7a77ec1549d6bb1d9cb55b77e3deb1e5 Mon Sep 17 00:00:00 2001 From: Jesse McDonald Date: Sat, 31 Oct 2020 11:55:57 -0500 Subject: [PATCH] refactor word header so only >NAME involves variable-length data --- jumpforth.S | 64 +++++++++++++++++++++++++---------------------------- startup.4th | 46 ++++++++++++++++++++++---------------- 2 files changed, 57 insertions(+), 53 deletions(-) diff --git a/jumpforth.S b/jumpforth.S index b37e945..ffa6189 100644 --- a/jumpforth.S +++ b/jumpforth.S @@ -110,14 +110,8 @@ DODOES: PUSHRSP %esi /* Load address of DOES> body from DFA into %esi */ movl 4(%eax),%esi - /* Load name length byte into %eax and mask out flag bits */ - xor %ebx,%ebx - movb 12(%eax),%bl - andb $F_LENMASK,%bl - /* Calculate %eax + 13 + %ebx and round up to next cell for address of body */ - lea 16(%eax,%ebx),%eax - andl $-4,%eax - /* Push body address on the data stack */ + /* Load address of word body (after DFA) onto stack */ + add $8,%eax push %eax /* Execute the DOES> code */ NEXT @@ -132,19 +126,19 @@ DODOES: .macro defname label:req,codeword:req,dataword:req,name="",flags=0 .section .data .align 4 - .globl \label -\label : - .int \codeword - .int \dataword - .int link - .set link,\label - .byte \flags+(9f-8f) + .skip (-(9f-8f+1) & 3),0 .ifeqs "\name","" 8: .ascii "\label" .else 8: .ascii "\name" .endif -9: .align 4 +9: .byte \flags+(9b-8b) + .int link + .globl \label +\label : + .set link,\label + .int \codeword + .int \dataword .endm .macro defword label:req,name="",flags=0 @@ -1254,37 +1248,37 @@ defword STREQU,"=S",F_HIDDEN 1: .int TWODROP,DROP,FALSE,EXIT /* FALSE R: */ 2: .int TWODROP,DROP,TRUE,EXIT /* TRUE R: */ -/* ( xt -- cfa-addr ) Address of the codeword field */ -defword TCFA,">CFA",F_HIDDEN - .int EXIT +/* ( xt -- a-addr ) Body a.k.a. data-field address (next cell after the dataword field) */ +defword TBODY,">BODY",F_HIDDEN + .int LIT,8,ADD,EXIT /* ( xt -- dfa-addr ) Address of the dataword field */ defword TDFA,">DFA",F_HIDDEN .int CELL,ADD,EXIT -/* ( xt -- link-addr ) Address of the dataword field */ +/* ( xt -- cfa-addr ) Address of the codeword field */ +defword TCFA,">CFA",F_HIDDEN + .int EXIT + +/* ( xt -- link-addr ) Address of the link field */ defword TLINK,">LINK",F_HIDDEN - .int LIT,8,ADD,EXIT + .int LIT,4,SUB,EXIT /* ( xt -- flags-addr ) Address of the flag/length byte */ defword TFLAGS,">FLAGS",F_HIDDEN - .int LIT,12,ADD,EXIT + .int LIT,5,SUB,EXIT /* ( xt -- name-addr name-len ) Address and length of the name field */ defword TNAME,">NAME",F_HIDDEN - .int TFLAGS,DUP,ADD1,SWAP,FETCHBYTE,__F_LENMASK,AND,EXIT - -/* ( xt -- a-addr ) Data-field address (next cell after the name) */ -defword TBODY,">BODY",F_HIDDEN - .int TNAME,ADD,ALIGNED,EXIT + .int TFLAGS,DUP,FETCHBYTE,__F_LENMASK,AND,TUCK,SUB,SWAP,EXIT ; /* ( xt -- flag ) Is the F_IMMED flag set? */ defword ISIMMEDIATE,"IMMEDIATE?",F_HIDDEN - .int LIT,12,ADD,FETCHBYTE,__F_IMMED,AND,LIT,0,NEQU,EXIT + .int TFLAGS,FETCHBYTE,__F_IMMED,AND,ZNEQU,EXIT /* ( xt -- flag ) Is the F_HIDDEN flag set? */ defword ISHIDDEN,"HIDDEN?",F_HIDDEN - .int LIT,12,ADD,FETCHBYTE,__F_HIDDEN,AND,LIT,0,NEQU,EXIT + .int TFLAGS,FETCHBYTE,__F_HIDDEN,AND,ZNEQU,EXIT /* ( xt -- flag ) Is the xt a non-primitive bootstrap word? */ defword ISBOOTSTRAP,"BOOTSTRAP?",F_HIDDEN @@ -1418,13 +1412,15 @@ defword QUIT,,F_HIDDEN defword LATEST,,F_HIDDEN .int CURRENT,FETCH,FETCH,EXIT +defword COMMANAME,"NAME,",F_HIDDEN + .int TUCK,ALIGN,HERE,OVER,ADD,ADD1,NEGATE,CELL,SUB1,AND,BOOTSTRAP_ALLOT + .int HERE,OVER,BOOTSTRAP_ALLOT,SWAP,CMOVE,COMMABYTE,EXIT + /* CREATE depends on various bootstrap words */ defword CREATE - .int ALIGN,HERE - .int LIT,DODATA,COMMA,LIT,0,COMMA,LATEST,COMMA - .int PARSE_NAME,DUP,COMMABYTE,HERE,SWAP,DUP,BOOTSTRAP_ALLOT,CMOVE - .int ALIGN,HERE,OVER,TDFA,STORE - .int CURRENT,FETCH,STORE,EXIT + .int PARSE_NAME,COMMANAME,LATEST,COMMA + .int HERE,CURRENT,FETCH,STORE + .int __DODATA,COMMA,HERE,CELL,ADD,COMMA,EXIT /* ** These next few words aren't strictly necessary for bootstrapping but diff --git a/startup.4th b/startup.4th index 7416f78..f0ed82c 100644 --- a/startup.4th +++ b/startup.4th @@ -59,12 +59,12 @@ SYSTEM-WORDLIST SET-CURRENT >>UTILITY \ Field accessors for execution tokens -: >CFA ( xt -- a-addr ) ; -: >DFA ( xt -- a-addr ) CELL+ ; -: >LINK ( xt -- a-addr ) 2 CELLS+ ; -: >FLAGS ( xt -- c-addr ) 3 CELLS+ ; -: >NAME ( xt -- c-addr u ) >FLAGS DUP 1+ SWAP C@ F_LENMASK AND ; -: >BODY ( xt -- a-addr ) >NAME + ALIGNED ; +: >BODY ( xt -- a-addr ) [ 2 CELLS ] LITERAL + ; +: >DFA ( xt -- a-addr ) CELL+ ; +: >CFA ( xt -- a-addr ) ; +: >LINK ( xt -- a-addr ) CELL- ; +: >FLAGS ( xt -- c-addr ) [ CELL 1+ ] LITERAL - ; +: >NAME ( xt -- c-addr u ) >FLAGS DUP C@ F_LENMASK AND TUCK - SWAP ; >>SYSTEM @@ -769,6 +769,13 @@ DEFER QUIT \ Allocate bytes from the data area (less than one cell) to cell-align the address : ALIGN ( -- ) CELL ALIGN-TO ; +\ Compile the name field of a word header, which is a counted string _right_ aligned +\ to a cell boundary, with the length at the _end_ of the string. Example: +\ [ x x x N ][ A M E 4 ] +: NAME, ( c-addr u -- ) + TUCK ▪ ALIGN HERE OVER + 1+ ▪ NEGATE CELL 1- AND ALLOT + HERE ▪ OVER ALLOT ▪ SWAP CMOVE ▪ C, ; + \ Append the effect of the token on top of the stack to the current definition. \ Here it's equivalent to , since words are just arrays of execution tokens. \ Once COMPILE, has been defined we can use POSTPONE for non-immediate words. @@ -1194,7 +1201,7 @@ DEFER REFILL \ The word is NOT added to the current compilation word list \ The start and end of the header are both cell-aligned : (CREATE-RAW) ( c-addr u link dfa cfa -- xt ) - ALIGN HERE >R , , , DUP F_LENMASK UMIN C, HERE SWAP DUP ALLOT CMOVE ALIGN R> ; + 2>R >R ▪ F_LENMASK UMIN NAME, ▪ R> , ▪ 2R> , , ▪ HERE 2 CELLS- ; \ Called when a word using DOES> is executed (not compiled) to set \ the runtime behavior of the most recently defined word @@ -1651,15 +1658,16 @@ ENDSTRUCT MEMBLOCK% \ the closure is no longer needed. When executed, the closure xt will place \ xu ... x1 on the data stack and then execute the captured xt1. : CLOSURE ( xu ... x1 xt1 u -- xt2 ) - 1+ DUP 5 + CELLS ALLOCATE DUP >R - DODOES !(+) [[ ' (CLOSURE) >DFA @ ]] !(+) NULL !(+) 0 !(+) OVER !(+) N! R> ; + 1+ DUP 5 + CELLS ALLOCATE DUP 2 CELLS+ >R + \ name(0) link(NULL) codeword dataword #words xt x1 x2 x3 … + 0 !(+) NULL !(+) DODOES !(+) [[ ' (CLOSURE) >DFA @ ]] !(+) OVER !(+) N! R> ; \ Return a closure which executes xt1 followed by xt2 : COMPOSE ( xt1 xt2 -- xt3 ) { >R EXECUTE R> EXECUTE } 2 CLOSURE ; -\ In the future the closure object and its xt may not share the same address -' FREE ALIAS FREE-CLOSURE +\ The xt points to the codeword, which is two cells above the base of the object +: FREE-CLOSURE ( closure-xt -- ) 2 CELLS- FREE ; \ Reserve data or heap space for a data structure given alignment and size \ It is assumed that ALLOCATE (but not ALLOT) returns an address suitably @@ -2183,15 +2191,15 @@ HIDE (TRACE) THEN ENDCASE LOOP DROP ; -\ Recognize the pattern BRANCH a:{c-a} b:{word} {code…} c:LIT d:{b} +\ Recognize the pattern BRANCH a:{c-a} {name} {link} b:{codeword} {…} c:LIT d:{b} \ This pattern is generated by the { … } inline :NONAME syntax : NONAME-LITERAL? ( a-addr -- flag ) @(+) [[ ' BRANCH ]] = AND-THEN - @(+) DUP 0> AND-THEN - ( S: addr-b offset-c-a ) - OVER CELL- + @(+) [[ ' LIT ]] = AND-THEN - ( S: addr-b addr-d ) - @ OVER = AND-THEN + DUP @ DUP 5 CELLS >= AND-THEN + ( S: addr-a offset-c-a ) + OVER + @(+) [[ ' LIT ]] = AND-THEN + ( S: addr-a addr-d ) + @ SWAP 3 CELLS+ OVER = AND-THEN DUP WORD? THEN ELSE NIP THEN @@ -2222,11 +2230,11 @@ ALSO UTILITY ENDOF OVER CELL- NONAME-LITERAL? IF DROP DUP @ OVER + 2 CELLS+ DUP R> UMAX >R SWAP - "{ " TYPE CELL+ >DFA @ UNTHREAD "} " TYPE + "{ " TYPE 3 CELLS+ >DFA @ UNTHREAD "} " TYPE ELSE DUP [[ ' BRANCH ]] = OR-ELSE DUP [[ ' 0BRANCH ]] = THEN IF >NAME TYPE SPACE - @(+) DUP "{" TYPE DUP 0> IF "+" TYPE THEN . "} " TYPE + @(+) DUP "{" TYPE DUP 0>= IF "+" TYPE THEN . "} " TYPE OVER CELL- + R> UMAX >R ELSE DUP WORD? AND-THEN DUP IMMEDIATE? THEN IF