version 1.91, 2001/01/29 11:39:43
|
version 1.94, 2001/03/11 22:50:49
|
Line 656 hex
|
Line 656 hex
|
4713 Constant <imm> 4714 Constant <do:> |
4713 Constant <imm> 4714 Constant <do:> |
4715 Constant <skip> |
4715 Constant <skip> |
|
|
\ iForth makes only immediate directly after create |
\ Compiler States |
\ make atonce trick! ? |
|
|
|
Variable atonce atonce off |
Variable comp-state |
|
0 Constant interpreting |
|
1 Constant compiling |
|
2 Constant resolving |
|
3 Constant assembling |
|
|
: NoExec true ABORT" CROSS: Don't execute ghost, or immediate target word" ; |
Defer lit, ( n -- ) |
|
Defer alit, ( n -- ) |
|
|
|
Defer branch, ( target-addr -- ) \ compiles a branch |
|
Defer ?branch, ( target-addr -- ) \ compiles a ?branch |
|
Defer branchmark, ( -- branch-addr ) \ reserves room for a branch |
|
Defer ?branchmark, ( -- branch-addr ) \ reserves room for a ?branch |
|
Defer ?domark, ( -- branch-addr ) \ reserves room for a ?do branch |
|
Defer branchto, ( -- ) \ actual program position is target of a branch (do e.g. alignment) |
|
Defer branchtoresolve, ( branch-addr -- ) \ resolves a forward reference from branchmark |
|
Defer branchfrom, ( -- ) \ ?! |
|
Defer branchtomark, ( -- target-addr ) \ marks a branch destination |
|
|
|
Defer colon, ( tcfa -- ) \ compiles call to tcfa at current position |
|
Defer prim, ( tcfa -- ) \ compiles a primitive invocation |
|
\ at current position |
|
Defer colonmark, ( -- addr ) \ marks a colon call |
|
Defer colon-resolve ( tcfa addr -- ) |
|
|
|
Defer addr-resolve ( target-addr addr -- ) |
|
Defer doer-resolve ( ghost res-pnt target-addr addr -- ghost res-pnt ) |
|
|
|
Defer do, ( -- do-token ) |
|
Defer ?do, ( -- ?do-token ) |
|
Defer for, ( -- for-token ) |
|
Defer loop, ( do-token / ?do-token -- ) |
|
Defer +loop, ( do-token / ?do-token -- ) |
|
Defer next, ( for-token ) |
|
|
|
[IFUNDEF] ca>native |
|
defer ca>native |
|
[THEN] |
|
|
: GhostHeader <fwd> , 0 , ['] NoExec , ; |
\ ghost structure |
|
|
: >magic ; \ type of ghost |
: >magic ; \ type of ghost |
: >link cell+ ; \ pointer where ghost is in target, or if unresolved |
: >link cell+ ; \ pointer where ghost is in target, or if unresolved |
\ points to the where we have to resolve (linked-list) |
\ points to the where we have to resolve (linked-list) |
: >exec cell+ cell+ ; \ execution symantics (while target compiling) of ghost |
: >exec cell+ cell+ ; \ execution symantics (while target compiling) of ghost |
: >end 3 cells + ; \ room for additional tags |
: >comp 3 cells + ; \ compilation semantics |
|
: >end 4 cells + ; \ room for additional tags |
\ for builder (create, variable...) words the |
\ for builder (create, variable...) words the |
\ execution symantics of words built are placed here |
\ execution symantics of words built are placed here |
|
|
|
\ resolve structure |
|
|
|
: >next ; \ link to next field |
|
: >tag cell+ ; \ indecates type of reference: 0: call, 1: address, 2: doer |
|
: >taddr cell+ cell+ ; |
|
: >ghost 3 cells + ; |
|
: >file 4 cells + ; |
|
: >line 5 cells + ; |
|
|
|
\ refer variables |
|
|
Variable executed-ghost \ last executed ghost, needed in tcreate and gdoes> |
Variable executed-ghost \ last executed ghost, needed in tcreate and gdoes> |
Variable last-ghost \ last ghost that is created |
Variable last-ghost \ last ghost that is created |
Variable last-header-ghost \ last ghost definitions with header |
Variable last-header-ghost \ last ghost definitions with header |
|
|
|
: (refered) ( ghost addr tag -- ) |
|
\G creates a reference to ghost at address taddr |
|
rot >r here r@ >link @ , r> >link ! |
|
( taddr tag ) , |
|
( taddr ) , |
|
last-header-ghost @ , |
|
loadfile , |
|
sourceline# , |
|
; |
|
|
|
\ iForth makes only immediate directly after create |
|
\ make atonce trick! ? |
|
|
|
Variable atonce atonce off |
|
|
|
: NoExec true ABORT" CROSS: Don't execute ghost, or immediate target word" ; |
|
|
|
: is-forward ( ghost -- ) |
|
colonmark, 0 (refered) ; \ compile space for call |
|
|
|
: GhostHeader <fwd> , 0 , ['] NoExec , ['] is-forward , ; |
|
|
: Make-Ghost ( "name" -- ghost ) |
: Make-Ghost ( "name" -- ghost ) |
>in @ GhostName swap >in ! |
>in @ GhostName swap >in ! |
<T Create atonce @ IF immediate atonce off THEN |
<T Create atonce @ IF immediate atonce off THEN |
Line 740 ghost (next)
|
Line 808 ghost (next)
|
ghost unloop ghost ;S 2drop |
ghost unloop ghost ;S 2drop |
ghost lit ghost (compile) ghost ! 2drop drop |
ghost lit ghost (compile) ghost ! 2drop drop |
ghost (does>) ghost noop 2drop |
ghost (does>) ghost noop 2drop |
ghost (.") ghost (S") ghost (ABORT") 2drop drop |
ghost (.") ghost (S") ghost (ABORT") 2drop drop ( " ) |
ghost ' drop |
ghost ' drop |
ghost :docol ghost :doesjump ghost :dodoes 2drop drop |
ghost :docol ghost :doesjump ghost :dodoes 2drop drop |
ghost :dovar drop |
ghost :dovar ghost :dodefer ghost :dofield 2drop drop |
ghost over ghost = ghost drop 2drop drop |
ghost over ghost = ghost drop 2drop drop |
ghost - drop |
ghost call ghost useraddr ghost execute 2drop drop |
|
ghost + ghost - ghost @ 2drop drop |
ghost 2drop drop |
ghost 2drop drop |
ghost 2dup drop |
ghost 2dup drop |
|
|
Line 802 false DefaultValue dcomps
|
Line 871 false DefaultValue dcomps
|
false DefaultValue hash |
false DefaultValue hash |
false DefaultValue xconds |
false DefaultValue xconds |
false DefaultValue header |
false DefaultValue header |
|
false DefaultValue backtrace |
false DefaultValue new-input |
false DefaultValue new-input |
[THEN] |
[THEN] |
|
|
Line 1267 previous
|
Line 1337 previous
|
|
|
\ \ -------------------- Compiler Plug Ins 01aug97jaw |
\ \ -------------------- Compiler Plug Ins 01aug97jaw |
|
|
\ Compiler States |
|
|
|
Variable comp-state |
|
0 Constant interpreting |
|
1 Constant compiling |
|
2 Constant resolving |
|
3 Constant assembling |
|
|
|
Defer lit, ( n -- ) |
|
Defer alit, ( n -- ) |
|
|
|
Defer branch, ( target-addr -- ) \ compiles a branch |
|
Defer ?branch, ( target-addr -- ) \ compiles a ?branch |
|
Defer branchmark, ( -- branch-addr ) \ reserves room for a branch |
|
Defer ?branchmark, ( -- branch-addr ) \ reserves room for a ?branch |
|
Defer ?domark, ( -- branch-addr ) \ reserves room for a ?do branch |
|
Defer branchto, ( -- ) \ actual program position is target of a branch (do e.g. alignment) |
|
Defer branchtoresolve, ( branch-addr -- ) \ resolves a forward reference from branchmark |
|
Defer branchfrom, ( -- ) \ ?! |
|
Defer branchtomark, ( -- target-addr ) \ marks a branch destination |
|
|
|
Defer colon, ( tcfa -- ) \ compiles call to tcfa at current position |
|
Defer colonmark, ( -- addr ) \ marks a colon call |
|
Defer colon-resolve ( tcfa addr -- ) |
|
|
|
Defer addr-resolve ( target-addr addr -- ) |
|
Defer doer-resolve ( ghost res-pnt target-addr addr -- ghost res-pnt ) |
|
|
|
Defer do, ( -- do-token ) |
|
Defer ?do, ( -- ?do-token ) |
|
Defer for, ( -- for-token ) |
|
Defer loop, ( do-token / ?do-token -- ) |
|
Defer +loop, ( do-token / ?do-token -- ) |
|
Defer next, ( for-token ) |
|
|
|
[IFUNDEF] ca>native |
|
defer ca>native |
|
[THEN] |
|
|
|
>TARGET |
>TARGET |
DEFER >body \ we need the system >body |
DEFER >body \ we need the system >body |
\ and the target >body |
\ and the target >body |
Line 1321 DEFER dodoes,
|
Line 1352 DEFER dodoes,
|
DEFER ]comp \ starts compilation |
DEFER ]comp \ starts compilation |
DEFER comp[ \ ends compilation |
DEFER comp[ \ ends compilation |
|
|
: (cc) T a, H ; ' (cc) IS colon, |
: (prim) T a, H ; ' (prim) IS prim, |
|
|
: (cr) >tempdp ]comp colon, comp[ tempdp> ; ' (cr) IS colon-resolve |
: (cr) >tempdp ]comp prim, comp[ tempdp> ; ' (cr) IS colon-resolve |
: (ar) T ! H ; ' (ar) IS addr-resolve |
: (ar) T ! H ; ' (ar) IS addr-resolve |
: (dr) ( ghost res-pnt target-addr addr ) |
: (dr) ( ghost res-pnt target-addr addr ) |
>tempdp drop over |
>tempdp drop over |
Line 1335 DEFER comp[ \ ends compilation
|
Line 1366 DEFER comp[ \ ends compilation
|
|
|
: (cm) ( -- addr ) |
: (cm) ( -- addr ) |
T here align H |
T here align H |
-1 colon, ; ' (cm) IS colonmark, |
-1 prim, ; ' (cm) IS colonmark, |
|
|
>TARGET |
>TARGET |
: compile, colon, ; |
: compile, prim, ; |
>CROSS |
>CROSS |
|
|
\ resolve structure |
|
|
|
: >next ; \ link to next field |
|
: >tag cell+ ; \ indecates type of reference: 0: call, 1: address, 2: doer |
|
: >taddr cell+ cell+ ; |
|
: >ghost 3 cells + ; |
|
: >file 4 cells + ; |
|
: >line 5 cells + ; |
|
|
|
: (refered) ( ghost addr tag -- ) |
|
\G creates a reference to ghost at address taddr |
|
rot >r here r@ >link @ , r> >link ! |
|
( taddr tag ) , |
|
( taddr ) , |
|
last-header-ghost @ , |
|
loadfile , |
|
sourceline# , |
|
; |
|
|
|
: refered ( ghost tag -- ) |
: refered ( ghost tag -- ) |
\G creates a resolve structure |
\G creates a resolve structure |
T here aligned H swap (refered) |
T here aligned H swap (refered) |
Line 1429 Exists-Warnings on
|
Line 1441 Exists-Warnings on
|
ELSE true abort" CROSS: Ghostnames inconsistent " |
ELSE true abort" CROSS: Ghostnames inconsistent " |
THEN ; |
THEN ; |
|
|
|
: colon-resolved ( ghost -- ) |
|
>link @ colon, ; \ compile-call |
|
: prim-resolved ( ghost -- ) |
|
>link @ prim, ; |
|
|
: resolve ( ghost tcfa -- ) |
: resolve ( ghost tcfa -- ) |
\G resolve referencies to ghost with tcfa |
\G resolve referencies to ghost with tcfa |
\ is ghost resolved?, second resolve means another definition with the |
\ is ghost resolved?, second resolve means another definition with the |
Line 1438 Exists-Warnings on
|
Line 1455 Exists-Warnings on
|
swap >r r@ >link @ swap \ ( list tcfa R: ghost ) |
swap >r r@ >link @ swap \ ( list tcfa R: ghost ) |
\ mark ghost as resolved |
\ mark ghost as resolved |
dup r@ >link ! <res> r@ >magic ! |
dup r@ >link ! <res> r@ >magic ! |
|
r@ >comp @ ['] is-forward = IF |
|
['] prim-resolved r@ >comp ! THEN |
\ loop through forward referencies |
\ loop through forward referencies |
r> -rot |
r> -rot |
comp-state @ >r Resolving comp-state ! |
comp-state @ >r Resolving comp-state ! |
Line 1449 Exists-Warnings on
|
Line 1468 Exists-Warnings on
|
|
|
\ gexecute ghost, 01nov92py |
\ gexecute ghost, 01nov92py |
|
|
: is-forward ( ghost -- ) |
|
colonmark, 0 (refered) ; \ compile space for call |
|
|
|
: is-resolved ( ghost -- ) |
|
>link @ colon, ; \ compile-call |
|
|
|
: gexecute ( ghost -- ) |
: gexecute ( ghost -- ) |
dup @ <fwd> = IF is-forward ELSE is-resolved THEN ; |
dup >comp @ execute ; |
|
|
: addr, ( ghost -- ) |
: addr, ( ghost -- ) |
dup @ <fwd> = IF 1 refered 0 T a, H ELSE >link @ T a, H THEN ; |
dup forward? IF 1 refered 0 T a, H ELSE >link @ T a, H THEN ; |
|
|
\ !! : ghost, ghost gexecute ; |
\ !! : ghost, ghost gexecute ; |
|
|
Line 1764 Comment ( Comment \
|
Line 1777 Comment ( Comment \
|
ELSE postpone literal postpone gexecute THEN ; |
ELSE postpone literal postpone gexecute THEN ; |
immediate |
immediate |
|
|
|
: (cc) compile call T a, H ; ' (cc) IS colon, |
|
|
: [G'] |
: [G'] |
\G ticks a ghost and returns its address |
\G ticks a ghost and returns its address |
bl word gfind 0= ABORT" CROSS: Ghost don't exists" |
bl word gfind 0= ABORT" CROSS: Ghost don't exists" |
Line 1797 Cond: ['] T ' H alit, ;Cond
|
Line 1812 Cond: ['] T ' H alit, ;Cond
|
|
|
: (>body) ( cfa -- pfa ) xt>body + ; ' (>body) T IS >body H |
: (>body) ( cfa -- pfa ) xt>body + ; ' (>body) T IS >body H |
|
|
: (doer,) ( ghost -- ) ]comp gexecute comp[ 1 fillcfa ; ' (doer,) IS doer, |
: (doer,) ( ghost -- ) ]comp addr, comp[ 1 fillcfa ; ' (doer,) IS doer, |
|
|
: (docol,) ( -- ) [G'] :docol doer, ; ' (docol,) IS docol, |
: (docol,) ( -- ) [G'] :docol doer, ; ' (docol,) IS docol, |
|
|
Line 1867 Cond: [Char] ( "<char>" -- ) restrict
|
Line 1882 Cond: [Char] ( "<char>" -- ) restrict
|
\ some special literals 27jan97jaw |
\ some special literals 27jan97jaw |
|
|
\ !! Known Bug: Special Literals and plug-ins work only correct |
\ !! Known Bug: Special Literals and plug-ins work only correct |
\ on 16 and 32 Bit Targets and 32 Bit Hosts! |
\ on targets with char = 8 bit |
|
|
Cond: MAXU |
Cond: MAXU |
restrict? |
restrict? |
tcell 1 cells u> |
compile lit tcell 0 ?DO FF T c, H LOOP |
IF compile lit tcell 0 ?DO FF T c, H LOOP |
|
ELSE ffffffff lit, THEN |
|
;Cond |
;Cond |
|
|
Cond: MINI |
Cond: MINI |
restrict? |
restrict? |
tcell 1 cells u> |
compile lit bigendian |
IF compile lit bigendian |
IF 80 T c, H tcell 1 ?DO 0 T c, H LOOP |
IF 80 T c, H tcell 1 ?DO 0 T c, H LOOP |
ELSE tcell 1 ?DO 0 T c, H LOOP 80 T c, H |
ELSE tcell 1 ?DO 0 T c, H LOOP 80 T c, H |
THEN |
THEN |
|
ELSE tcell 2 = IF 8000 ELSE 80000000 THEN lit, THEN |
|
;Cond |
;Cond |
|
|
Cond: MAXI |
Cond: MAXI |
restrict? |
restrict? |
tcell 1 cells u> |
compile lit bigendian |
IF compile lit bigendian |
IF 7F T c, H tcell 1 ?DO FF T c, H LOOP |
IF 7F T c, H tcell 1 ?DO FF T c, H LOOP |
ELSE tcell 1 ?DO FF T c, H LOOP 7F T c, H |
ELSE tcell 1 ?DO FF T c, H LOOP 7F T c, H |
THEN |
THEN |
|
ELSE tcell 2 = IF 7fff ELSE 7fffffff THEN lit, THEN |
|
;Cond |
;Cond |
|
|
>CROSS |
>CROSS |
Line 1966 Cond: ; ( -- ) restrict?
|
Line 1975 Cond: ; ( -- ) restrict?
|
comp[ |
comp[ |
state off |
state off |
;Resolve @ |
;Resolve @ |
IF ;Resolve @ ;Resolve cell+ @ resolve THEN |
IF ;Resolve @ ;Resolve cell+ @ resolve |
|
['] prim-resolved ;Resolve @ >comp ! THEN |
Interpreting comp-state ! |
Interpreting comp-state ! |
;Cond |
;Cond |
Cond: [ restrict? state off Interpreting comp-state ! ;Cond |
Cond: [ restrict? state off Interpreting comp-state ! ;Cond |
Line 1997 Cond: DOES> restrict?
|
Line 2007 Cond: DOES> restrict?
|
|
|
\ Builder 11may93jaw |
\ Builder 11may93jaw |
|
|
: Builder ( Create-xt do:-xt "name" -- ) |
: Builder ( Create-xt do-ghost "name" -- ) |
\ builds up a builder in current vocabulary |
\ builds up a builder in current vocabulary |
\ create-xt is executed when word is interpreted |
\ create-xt is executed when word is interpreted |
\ do:-xt is executet when the created word from builder is executed |
\ do:-xt is executet when the created word from builder is executed |
\ for do:-xt an additional entry after the normal ghost-enrys is used |
\ for do:-xt an additional entry after the normal ghost-enrys is used |
|
|
Make-Ghost ( Create-xt do:-xt ghost ) |
Make-Ghost ( Create-xt do-ghost ghost ) |
rot swap ( do:-xt Create-xt ghost ) |
rot swap ( do-ghost Create-xt ghost ) |
>exec ! , ; |
>exec ! , ; |
\ rot swap >exec dup @ ['] NoExec <> |
|
\ IF 2drop ELSE ! THEN , ; |
|
|
|
: gdoes, ( ghost -- ) |
: gdoes, ( ghost -- ) |
\ makes the codefield for a word that is built |
\ makes the codefield for a word that is built |
Line 2033 Cond: DOES> restrict?
|
Line 2041 Cond: DOES> restrict?
|
\ stores execution semantic in the built word |
\ stores execution semantic in the built word |
\ if the word already has a semantic (concerns S", IS, .", DOES>) |
\ if the word already has a semantic (concerns S", IS, .", DOES>) |
\ then keep it |
\ then keep it |
>end @ >exec @ r> >exec dup @ ['] NoExec = |
>end @ |
IF ! ELSE 2drop THEN ; |
dup >exec @ r@ >exec dup @ ['] NoExec = IF ! ELSE 2drop THEN |
|
>comp @ r> >comp ! ; |
|
|
: RTCreate ( <name> -- ) |
: RTCreate ( <name> -- ) |
\ creates a new word with code-field in ram |
\ creates a new word with code-field in ram |
Line 2066 Cond: DOES> restrict?
|
Line 2075 Cond: DOES> restrict?
|
postpone TCreate |
postpone TCreate |
[ [THEN] ] ; |
[ [THEN] ] ; |
|
|
|
: g>body ( ghost -- body ) |
|
>link @ T >body H ; |
: gdoes> ( ghost -- addr flag ) |
: gdoes> ( ghost -- addr flag ) |
executed-ghost @ |
executed-ghost @ |
state @ IF gexecute true EXIT THEN |
state @ IF gexecute true EXIT THEN |
>link @ T >body H false ; |
g>body false ; |
|
|
\ DO: ;DO 11may93jaw |
\ DO: ;DO 11may93jaw |
\ changed to ?EXIT 10may93jaw |
\ changed to ?EXIT 10may93jaw |
|
|
: DO: ( -- addr [xt] [colon-sys] ) |
: DO: ( -- ghost [xt] [colon-sys] ) |
here ghostheader |
here ghostheader |
:noname postpone gdoes> postpone ?EXIT ; |
:noname postpone gdoes> postpone ?EXIT ; |
|
|
: by: ( -- addr [xt] [colon-sys] ) \ name |
: by: ( -- ghost [xt] [colon-sys] ) \ name |
ghost |
ghost |
:noname postpone gdoes> postpone ?EXIT ; |
:noname postpone gdoes> postpone ?EXIT ; |
|
|
: ;DO ( addr [xt] [colon-sys] -- addr ) |
: ;DO ( ghost [xt] [colon-sys] -- ghost ) |
postpone ; ( S addr xt ) |
postpone ; ( S addr xt ) |
over >exec ! ; immediate |
over >exec ! ; immediate |
|
|
: by ( -- addr ) \ Name |
: compile: ( ghost -- ghost [xt] [colon-sys] ) |
|
:noname postpone g>body ; |
|
: ;compile ( ghost [xt] [colon-sys] -- ghost ) |
|
postpone ; over >comp ! ; immediate |
|
|
|
: by ( -- ghost ) \ Name |
ghost >end @ ; |
ghost >end @ ; |
|
|
>TARGET |
>TARGET |
Line 2094 Cond: DOES> restrict?
|
Line 2110 Cond: DOES> restrict?
|
|
|
Build: ( n -- ) ; |
Build: ( n -- ) ; |
by: :docon ( ghost -- n ) T @ H ;DO |
by: :docon ( ghost -- n ) T @ H ;DO |
|
compile: alit, compile @ ;compile |
Builder (Constant) |
Builder (Constant) |
|
|
Build: ( n -- ) T , H ; |
Build: ( n -- ) T , H ; |
Line 2110 Builder 2Constant
|
Line 2127 Builder 2Constant
|
|
|
BuildSmart: ; |
BuildSmart: ; |
by: :dovar ( ghost -- addr ) ;DO |
by: :dovar ( ghost -- addr ) ;DO |
|
compile: alit, ;compile |
Builder Create |
Builder Create |
|
|
T has? rom H [IF] |
T has? rom H [IF] |
Line 2161 Variable tudp 0 tudp !
|
Line 2179 Variable tudp 0 tudp !
|
|
|
Build: 0 u, X , ; |
Build: 0 u, X , ; |
by: :douser ( ghost -- up-addr ) X @ tup @ + ;DO |
by: :douser ( ghost -- up-addr ) X @ tup @ + ;DO |
|
compile: compile useraddr T @ , H ;compile |
Builder User |
Builder User |
|
|
Build: 0 u, X , 0 u, drop ; |
Build: 0 u, X , 0 u, drop ; |
Line 2181 Builder AValue
|
Line 2200 Builder AValue
|
|
|
BuildSmart: ( -- ) [T'] noop T A, H ; |
BuildSmart: ( -- ) [T'] noop T A, H ; |
by: :dodefer ( ghost -- ) ABORT" CROSS: Don't execute" ;DO |
by: :dodefer ( ghost -- ) ABORT" CROSS: Don't execute" ;DO |
|
compile: alit, compile @ compile execute ;compile |
Builder Defer |
Builder Defer |
|
|
Build: ( inter comp -- ) swap T immediate A, A, H ; |
Build: ( inter comp -- ) swap T immediate A, A, H ; |
Line 2197 Builder interpret/compile:
|
Line 2217 Builder interpret/compile:
|
|
|
Build: ; |
Build: ; |
by: :dofield T @ H + ;DO |
by: :dofield T @ H + ;DO |
|
compile: T @ H lit, compile + ;compile |
Builder (Field) |
Builder (Field) |
|
|
Build: ( align1 offset1 align size "name" -- align2 offset2 ) |
Build: ( align1 offset1 align size "name" -- align2 offset2 ) |
Line 2367 Cond: NEXT restrict? sys? next, ;Cond
|
Line 2388 Cond: NEXT restrict? sys? next, ;Cond
|
|
|
: ," [char] " parse T string, align H ; |
: ," [char] " parse T string, align H ; |
|
|
Cond: ." restrict? compile (.") T ," H ;Cond |
Cond: ." restrict? compile (.") T ," H ;Cond ( " ) |
Cond: S" restrict? compile (S") T ," H ;Cond |
Cond: S" restrict? compile (S") T ," H ;Cond ( " ) |
Cond: ABORT" restrict? compile (ABORT") T ," H ;Cond |
Cond: ABORT" restrict? compile (ABORT") T ," H ;Cond ( " ) |
|
|
Cond: IS T ' >body H compile ALiteral compile ! ;Cond |
Cond: IS T ' >body H compile ALiteral compile ! ;Cond |
: IS T >address ' >body ! H ; |
: IS T >address ' >body ! H ; |