運作

VARIABLE CONTEXT #VOCS CELLS ALLOT \ make context array of #VOCS+1 cells

VARIABLE CURRENT

VARIABLE LAST \ NFA of last header created

VARIABLE LAST-LINK \ address of last link for last header created

VARIABLE VOC-LINK \ linked list of vocabularies

\ Vocabularies; currently, these MUST be defined as specified

1 #VOCABULARY ROOT \ root vocab

VOCABULARY FORTH \ main vocabulary

\ #PTHREADS #LEXICON PROCS \ procs vocabulary; there's only 1

1 #VOCABULARY LOCALS \ locals vocab

#FTHREADS #VOCABULARY FILES \ files vocab

#HTHREADS #VOCABULARY HIDDEN \ hidden words

\ -------------------- Vocabulary dictionary structure ----------------------

\ [ cfa field ] +0 VCFA = vocabulary cfa -> DOES> code

\ [ num voc threads ] +4 #THREADS

\ [ voc link ] +8 VLINK

\ [ voc header ] +12 VHEAD

\ [ voc search ] +16 VSRCH

\ [ voc iterate ] +20 VITER

\ [ voc thread 0 ] +24 VOC thread 0 = voc-address

\ [ voc thread 1 ] +28 VOC thread 1

\ [ voc thread 2 ] +32 VOC thread 2

\ [ voc thread ... ] +n*4+24 VOC thread n

0 EQU VCFA

VCFA CELL+ EQU VTHRD

VTHRD CELL+ EQU VHEAD

VHEAD CELL+ EQU VSRCH

VSRCH CELL+ EQU VITER

VITER CELL+ EQU VLINK

VLINK CELL+ EQU VOC#0

DEFER VOC-ALSO

' NOOP IS VOC-ALSO \ possibly for lookaside use

VOC#0 VLINK - OFFSET VLINK>VOC ( voc-link-field -- voc-address )

VLINK VOC#0 - OFFSET VOC>VLINK ( voc-address -- voc-link-field )

: VOC#THREADS ( voc-address -- #threads ) [ VTHRD VOC#0 - ] literal + @ ;

VOC#0 VCFA - OFFSET VCFA>VOC ( vocabulary-cfa -- voc-address )

VCFA VOC#0 - OFFSET VOC>VCFA ( voc-address -- vocabulary-cfa )

CFA-CODE DOVOC ( -- ) \ "runtime" for VOCABULARY

add eax, # 0 VCFA>VOC \ set CONTEXT to VOC address

mov context , eax

next c;

ASSEMBLER DOVOC META CONSTANT DOVOC

VARIABLE [UNKNOWN] \ also used to store last cfa found

: "HEADER ( a1 n1 -- ) \ build header in same dict as wordlist

DUP 0= THROW_NAMEREQD AND THROW

"CLIP"

2dup UPPER \ bad; should really copy

WARNING @ IF

2DUP CURRENT @ (SEARCH-SELF) IF

DROP DUP-WARNING? IF

WARN_NOTUNIQUE WARNMSG

THEN

("HEADER)

;

| NCODE (HEADER) ( addr len -- ) \ standard voc header word

mov ecx, CURRENT \ get current vocab

mov eax, VHEAD VOC#0 - [ecx] \ fetch header word to execute

exec c;

0 value slfactor \ adjust this to slow down loading

: _START/STOP ( -- )

KEY?

IF KEY 10 DIGIT ( number keys select delay )

IF 2 * DELAYS + W@ TO SCREENDELAY

ELSE ( k_ESC ) 27 = IF ABORT THEN WAIT

THEN

THEN ;

' _START/STOP IS START/STOP

: SLOW ( -- ) slfactor ms start/stop ; \ set 'slfactor' to slow down loading

: HEADER ( "name" -- ) \ build a header

BL WORD COUNT (HEADER) slow ; \ self-call the header word

here ok.

. 4494152 ok

s" cyn" "header ok

here . 4494152 ok

' cyn . 4494152 ok

here . 4494152 ok

create wesley ok

here . 4494156 ok

' wesley . 4494152 ok

wesley . 4494156 ok

cyn . 4494156 ok

' wesley EXECUTE . 4494156 ok

order

Context: FORTH FORTH ROOT

Current: FORTH ok

NEW-NAME DEFINITIONS ok

order

Context: NEW-NAME FORTH ROOT

Current: NEW-NAME ok