version 1.43, 1997/02/08 22:58:09
|
version 1.47, 1997/04/10 21:32:08
|
Line 100 also Forth definitions
|
Line 100 also Forth definitions
|
[IFDEF] asm-include asm-include [THEN] |
[IFDEF] asm-include asm-include [THEN] |
|
|
previous |
previous |
|
hex |
|
|
>CROSS |
>CROSS |
|
|
Line 245 VARIABLE VocTemp
|
Line 246 VARIABLE VocTemp
|
: <T get-current VocTemp ! also Ghosts definitions ; |
: <T get-current VocTemp ! also Ghosts definitions ; |
: T> previous VocTemp @ set-current ; |
: T> previous VocTemp @ set-current ; |
|
|
|
hex |
4711 Constant <fwd> 4712 Constant <res> |
4711 Constant <fwd> 4712 Constant <res> |
4713 Constant <imm> 4714 Constant <do:> |
4713 Constant <imm> 4714 Constant <do:> |
|
|
Line 444 Defer skip? ' false IS skip?
|
Line 446 Defer skip? ' false IS skip?
|
ghost dup >magic @ <fwd> = |
ghost dup >magic @ <fwd> = |
IF >link @ 0<> ELSE drop false THEN ; |
IF >link @ 0<> ELSE drop false THEN ; |
|
|
|
: doer? ( -- flag ) \ name |
|
ghost >magic @ <do:> = ; |
|
|
: skip-defs ( -- ) |
: skip-defs ( -- ) |
BEGIN refill WHILE source -trailing nip 0= UNTIL THEN ; |
BEGIN refill WHILE source -trailing nip 0= UNTIL THEN ; |
|
|
Line 525 ghost (does>) ghost noop
|
Line 530 ghost (does>) ghost noop
|
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 over ghost = ghost drop 2drop drop |
|
|
\ compile 10may93jaw |
\ compile 10may93jaw |
|
|
Line 539 ghost :docol ghost :doesjump ghost :d
|
Line 545 ghost :docol ghost :doesjump ghost :d
|
\ generic threading modell |
\ generic threading modell |
: docol, ( -- ) compile :docol T 0 , H ; |
: docol, ( -- ) compile :docol T 0 , H ; |
|
|
: dodoes, ( -- ) compile :doesjump T 0 , H ; |
: dodoes, ( -- ) T cfalign H compile :doesjump T 0 , H ; |
|
|
[IFUNDEF] (code) |
[IFUNDEF] (code) |
Defer (code) |
Defer (code) |
Line 549 Defer (end-code)
|
Line 555 Defer (end-code)
|
>TARGET |
>TARGET |
: Code |
: Code |
(THeader there resolve |
(THeader there resolve |
there 2 T cells H + T a, 0 , H |
[ has-prims 0= [IF] ITC [ELSE] true [THEN] ] [IF] |
|
there 2 T cells H + T a, 0 , H |
|
[THEN] |
depth (code) ; |
depth (code) ; |
|
|
: Code: |
: Code: |
Line 644 Cond: MAXI
|
Line 652 Cond: MAXI
|
docol, depth T ] H ; |
docol, depth T ] H ; |
|
|
: :noname ( -- colon-sys ) |
: :noname ( -- colon-sys ) |
T align H there docol, depth T ] H ; |
T cfalign H there docol, depth T ] H ; |
|
|
Cond: EXIT ( -- ) restrict? compile ;S ;Cond |
Cond: EXIT ( -- ) restrict? compile ;S ;Cond |
|
|
Line 665 Cond: [ restrict? state off ;Cond
|
Line 673 Cond: [ restrict? state off ;Cond
|
|
|
>TARGET |
>TARGET |
Cond: DOES> restrict? |
Cond: DOES> restrict? |
compile (does>) dodoes, tdoes @ ?dup IF @ T here H resolve THEN |
compile (does>) dodoes, tdoes @ ?dup IF @ T here H resolve THEN |
;Cond |
;Cond |
: DOES> dodoes, T here H !does depth T ] H ; |
: DOES> dodoes, T here H !does depth T ] H ; |
|
|
Line 760 Build: T 0 au, , H ;
|
Line 768 Build: T 0 au, , H ;
|
by User |
by User |
Builder AUser |
Builder AUser |
|
|
Build: ( n -- ) T , H ; |
Build: ( n -- ) ; |
by: :docon ( ghost -- n ) T @ H ;DO |
by: :docon ( ghost -- n ) T @ H ;DO |
|
Builder (Constant) |
|
|
|
Build: ( n -- ) T , H ; |
|
by (Constant) |
Builder Constant |
Builder Constant |
|
|
Build: ( n -- ) T A, H ; |
Build: ( n -- ) T A, H ; |
by Constant |
by (Constant) |
Builder AConstant |
Builder AConstant |
|
|
Build: ( d -- ) T , , H ; |
Build: ( d -- ) T , , H ; |
DO: ( ghost -- d ) T dup cell+ @ swap @ H ;DO |
DO: ( ghost -- d ) T dup cell+ @ swap @ H ;DO |
Builder 2Constant |
Builder 2Constant |
|
|
Build: T 0 , H ; |
Build: T , H ; |
by Constant |
by (Constant) |
Builder Value |
Builder Value |
|
|
Build: T 0 A, H ; |
Build: T A, H ; |
by Constant |
by (Constant) |
Builder AValue |
Builder AValue |
|
|
Build: ( -- ) compile noop ; |
Build: ( -- ) compile noop ; |
Line 796 Builder interpret/compile:
|
Line 808 Builder interpret/compile:
|
1- tuck + swap invert and ; |
1- tuck + swap invert and ; |
>TARGET |
>TARGET |
|
|
|
Build: ; |
|
by: :dofield T @ H + ;DO |
|
Builder (Field) |
|
|
Build: >r rot r@ nalign dup T , H ( align1 size offset ) |
Build: >r rot r@ nalign dup T , H ( align1 size offset ) |
+ swap r> nalign ; |
+ swap r> nalign ; |
by: :dofield T @ H + ;DO |
by (Field) |
Builder Field |
Builder Field |
|
|
: struct T 0 1 chars H ; |
: struct T 0 1 chars H ; |
Line 853 Cond: AGAIN restrict? sys? compile b
|
Line 869 Cond: AGAIN restrict? sys? compile b
|
Cond: UNTIL restrict? sys? compile ?branch <resolve ;Cond |
Cond: UNTIL restrict? sys? compile ?branch <resolve ;Cond |
Cond: REPEAT restrict? over 0= ?struc compile AGAIN compile THEN ;Cond |
Cond: REPEAT restrict? over 0= ?struc compile AGAIN compile THEN ;Cond |
|
|
|
Cond: CASE restrict? 0 ;Cond |
|
Cond: OF restrict? 1+ >r compile over compile = compile IF compile drop |
|
r> ;Cond |
|
Cond: ENDOF restrict? >r compile ELSE r> ;Cond |
|
Cond: ENDCASE restrict? compile drop 0 ?DO compile THEN LOOP ;Cond |
|
|
\ Structural Conditionals 12dec92py |
\ Structural Conditionals 12dec92py |
|
|
Cond: DO restrict? compile (do) T here H ;Cond |
Cond: DO restrict? compile (do) T here H ;Cond |
Line 920 also minimal
|
Line 942 also minimal
|
\ define new [IFDEF] and [IFUNDEF] 20may93jaw |
\ define new [IFDEF] and [IFUNDEF] 20may93jaw |
|
|
: defined? defined? ; |
: defined? defined? ; |
|
: needed? needed? ; |
|
: doer? doer? ; |
|
|
: [IFDEF] defined? postpone [IF] ; |
: [IFDEF] defined? postpone [IF] ; |
: [IFUNDEF] defined? 0= postpone [IF] ; |
: [IFUNDEF] defined? 0= postpone [IF] ; |
Line 1018 mach-file count included
|
Line 1042 mach-file count included
|
: undef-words ['] defined? IS skip? ; |
: undef-words ['] defined? IS skip? ; |
|
|
: \ postpone \ ; immediate |
: \ postpone \ ; immediate |
|
: \G T-\G ; immediate |
: ( postpone ( ; immediate |
: ( postpone ( ; immediate |
: include bl word count included ; |
: include bl word count included ; |
: .( [char] ) parse type ; |
: .( [char] ) parse type ; |