version 1.21, 1994/10/18 15:51:19
|
version 1.22, 1994/10/24 19:16:00
|
Line 66 DOES> ( n -- ) + c@ ;
|
Line 66 DOES> ( n -- ) + c@ ;
|
bl c, |
bl c, |
LOOP ; |
LOOP ; |
|
|
|
: chars ; immediate |
|
|
: A! ( addr1 addr2 -- ) dup relon ! ; |
: A! ( addr1 addr2 -- ) dup relon ! ; |
: A, ( addr -- ) here cell allot A! ; |
: A, ( addr -- ) here cell allot A! ; |
Line 173 Defer source
|
Line 173 Defer source
|
: [char] ( 'char' -- n ) char postpone Literal ; immediate |
: [char] ( 'char' -- n ) char postpone Literal ; immediate |
' [char] Alias Ascii immediate |
' [char] Alias Ascii immediate |
|
|
: (compile) ( -- ) r> dup cell+ >r @ A, ; |
: (compile) ( -- ) r> dup cell+ >r @ compile, ; |
: postpone ( "name" -- ) |
: postpone ( "name" -- ) |
name sfind dup 0= abort" Can't compile " |
name sfind dup 0= abort" Can't compile " |
0> IF A, ELSE postpone (compile) A, THEN ; |
0> IF compile, ELSE postpone (compile) A, THEN ; |
immediate restrict |
immediate restrict |
|
|
\ Use (compile) for the old behavior of compile! |
\ Use (compile) for the old behavior of compile! |
Line 417 AConstant locals-list \ acts like a vari
|
Line 417 AConstant locals-list \ acts like a vari
|
|
|
|
|
variable dead-code \ true if normal code at "here" would be dead |
variable dead-code \ true if normal code at "here" would be dead |
|
variable backedge-locals |
: unreachable ( -- ) |
\ contains the locals list that BEGIN will assume to be live on |
\ declares the current point of execution as unreachable |
\ the back edge if the BEGIN is unreachable from above. Set by |
dead-code on ; |
\ ASSUME-LIVE, reset by UNREACHABLE. |
|
|
|
: UNREACHABLE ( -- ) |
|
\ declares the current point of execution as unreachable |
|
dead-code on |
|
0 backedge-locals ! ; immediate |
|
|
|
: ASSUME-LIVE ( orig -- orig ) |
|
\ used immediateliy before a BEGIN that is not reachable from |
|
\ above. causes the BEGIN to assume that the same locals are live |
|
\ as at the orig point |
|
dup orig? |
|
2 pick backedge-locals ! ; immediate |
|
|
\ locals list operations |
\ locals list operations |
|
|
: common-list ( list1 list2 -- list3 ) |
: common-list ( list1 list2 -- list3 ) |
Line 546 variable dead-code \ true if normal code
|
Line 558 variable dead-code \ true if normal code
|
\ Structural Conditionals 12dec92py |
\ Structural Conditionals 12dec92py |
|
|
: AHEAD ( -- orig ) |
: AHEAD ( -- orig ) |
POSTPONE branch >mark unreachable ; immediate restrict |
POSTPONE branch >mark POSTPONE unreachable ; immediate restrict |
|
|
: IF ( -- orig ) |
: IF ( -- orig ) |
POSTPONE ?branch >mark ; immediate restrict |
POSTPONE ?branch >mark ; immediate restrict |
Line 588 variable dead-code \ true if normal code
|
Line 600 variable dead-code \ true if normal code
|
|
|
: BEGIN ( -- dest ) |
: BEGIN ( -- dest ) |
dead-code @ if |
dead-code @ if |
\ set up an assumption of the locals visible here |
\ set up an assumption of the locals visible here. if the |
\ currently we just take the top cs-item |
\ users want something to be visible, they have to declare |
\ it would be more intelligent to take the top orig |
\ that using ASSUME-LIVE |
\ but that can be arranged by the user |
backedge-locals @ set-locals-size-list |
dup defstart <> if |
|
dup cs-item? |
|
2 pick |
|
else |
|
0 |
|
then |
|
set-locals-size-list |
|
then |
then |
cs-push-part dest |
cs-push-part dest |
dead-code off ; immediate restrict |
dead-code off ; immediate restrict |
Line 614 variable dead-code \ true if normal code
|
Line 619 variable dead-code \ true if normal code
|
POSTPONE branch |
POSTPONE branch |
<resolve |
<resolve |
check-begin |
check-begin |
unreachable ; immediate restrict |
POSTPONE unreachable ; immediate restrict |
|
|
\ UNTIL (the current control flow may join an earlier one or continue): |
\ UNTIL (the current control flow may join an earlier one or continue): |
\ Similar to AGAIN. The new locals-list and locals-size are the current |
\ Similar to AGAIN. The new locals-list and locals-size are the current |
Line 746 Avariable leave-sp leave-stack 3 cells
|
Line 751 Avariable leave-sp leave-stack 3 cells
|
: EXIT ( -- ) |
: EXIT ( -- ) |
0 adjust-locals-size |
0 adjust-locals-size |
POSTPONE ;s |
POSTPONE ;s |
unreachable ; immediate restrict |
POSTPONE unreachable ; immediate restrict |
|
|
: ?EXIT ( -- ) |
: ?EXIT ( -- ) |
POSTPONE if POSTPONE exit POSTPONE then ; immediate restrict |
POSTPONE if POSTPONE exit POSTPONE then ; immediate restrict |