refactor word header so only >NAME involves variable-length data
This commit is contained in:
parent
3009bc84e5
commit
70c87e3d7a
64
jumpforth.S
64
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
|
||||
|
|
|
|||
46
startup.4th
46
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
|
||||
|
|
|
|||
Loading…
Reference in New Issue