1 line
11 KiB
Plaintext
1 line
11 KiB
Plaintext
\ locals based on locals code by B. Muench ( ANS ) (LOCAL) LOCALS| TO ( optional ) ADDR \ locals forth definitions decimal application 2 #screens 1- thru \ locals #20 user LP \ locals pointer (don't change) \ add locals to CATCH -? : CATCH ( xt -- except# | 0 ) lp @ >r catch r> over if lp ! else drop then ; \ locals label ladr \ BX <- address of local LP [up] bx mov byte lods ah ah sub ax bx sub ret end-code code L@ ( -- x ) \ fetch local ladr ) call 0 [bx] push next end-code code L! ( x -- ) \ store local ladr ) call 0 [bx] pop next end-code code L& ( -- addr ) \ address of local ladr ) call bx push next end-code \ locals \ build locals frame, init locals, push locals exit code L{ bp sp xchg LP [up] push sp 0 [di] mov byte lods ah ah sub ax cx mov 1 $: 0 [bp] push 2 # bp add 1 $ loop 2 $ # ax mov ax push bp sp xchg next 2 $: here cell+ , \ locals exit \ remove locals frame LP [up] bp mov bp sp xchg 0 [di] pop bp sp xchg ' exit ) jmp end-code \ locals system : ERR? ( x -- ) abort" locals error" ; : LGET ( "name" -- c-addr u ) token dup 0= err? ; #128 constant #NB \ name buffer size create NB #nb allot \ name buffer variable LC \ locals count variable NP \ name pointer : L[ ( -- ) lc off nb #nb erase nb np ! ; l[ \ local offset : LOS ( ? index -- u ) nip cells ; \ locals \ search local names : L= ( c-addr -- index | 0 ) 0 state @ if \ compiling only nb >r begin 1+ r@ c@ 0<> and dup while over count r> count 2dup + >r caps compare 0= until then r> drop then nip ; \ new FIND : LFIND ( c-addr -- c-addr 0 | xt flag ) dup l= ?dup if postpone l@ los c, ['] noop 1 end [ addr find @ compile, ] ; \ (LOCAL) LOCALS| : (LOCAL) ( c-addr u | 0 0 -- ) \ ANS dup if np @ 2dup + nb #nb 2- + u> err? over 1+ np +! place 1 lc +! else 2drop lc @ ?dup if postpone l{ c, then then ; \ assign locals : LOCALS| ( "name1...namen |" ) \ ANS begin lget 2dup s" |" compare while (local) repeat 2drop 0 0 (local) ; immediate \ TO ADDR -? : TO ( x "name" -- ) \ ANS >in @ bl word l= ?dup if postpone l! los c, end >in ! postpone to ; immediate \ Address of a local -? : ADDR ( "name" -- addr ) >in @ bl word l= ?dup if postpone l& los c, end >in ! postpone addr ; immediate \ locals -? : DOES> postpone does> l[ ; immediate -? : : : l[ ; -? : :NONAME :noname l[ ; \ add to remember chain :noname [ addr find @ ] literal is find ; remember ' lfind is find application \ locals behead ladr lfind |