Power-Programmierung

home *** CD-ROM | disk | FTP | other *** search

/ Power-Programmierung / CD1.mdf / magazine / drdobbs / 1986 / 07 / shaw.jul < prev next >

Wrap

Text File | 1986-07-31 | 13KB | 379 lines

NOTE: SHOULD SCREENS BE RENUMBERED????? Listing One B:PAPERS.BLK Screen 12* 0 \ FORTH-83 Standard type control structures GWS 86Mar31 1 \ note: !0 is 0 SWAP ! ADDR, is , (S is ( 2 3 : >MARK HERE 2 ALLOT ; (S - a )( mark forward branch ) 4 : >RESOLVE HERE SWAP ! ; (S a - )( patch forward branch ) 5 : MARKLIST (S a - )( extend list at a, link in dictionary ) 10 HERE SWAP DUP @ ADDR, ( link) ! ( new head) ; 11 : >RESOLVESLIST (S a - )( resolve all nodes in a to here ) 12 DUP @ BEGIN DUP WHILE DUP @ SWAP >RESOLVE REPEAT 13 DROP !0 ; 1 2 +THRU 14 15 Screen 13 0 \ conditional compilers - if/else/then begin/while GWS 86Mar31 1 2 : IF (S - a / f - )( compile to branch if f is false ) 3 COMPILE ?BRANCH >MARK ; IMMEDIATE 4 : ELSE (S a1 - a2 / - )( compile alternate to IF clause ) 5 COMPILE BRANCH >MARK SWAP >RESOLVE ; IMMEDIATE 6 : THEN (S a - / - )( resolve latest forward reference ) 7 >RESOLVE ; IMMEDIATE 8 9 : BEGIN RESOLVE ; IMMEDIATE 13 : UNTIL (S a - / f - )( branch to beginning of loop until true ) 14 COMPILE ?BRANCH <RESOLVE ; IMMEDIATE 15 Screen 14 0 \ do loops GWS 86Mar31 1 2 : LEAVE (S - / - )( compile exit from structure ) 3 COMPILE (LEAVE) LEAVE-LIST >MARKLIST ; IMMEDIATE 4 5 : DO (S - n a / n1 n2 - )( initiate counted loop ) 6 COMPILE (DO) LEAVE-LIST @ LEAVE-LIST !0 RESOLVESLIST 10 LEAVE-LIST ! ; IMMEDIATE 11 : +LOOP (S n a - / u - )( compile u incremented loop end ) 12 COMPILE (+LOOP) <RESOLVE LEAVE-LIST >RESOLVESLIST 13 LEAVE-LIST ! ; IMMEDIATE 14 15 Listing Two B:PAPERS.BLK Screen 15* 0 \ typical BEGIN loop extensions GWS 86Mar31 1 2 : RESOLVES (S 0..a - )( resolve forward branches a until 0 ) 3 BEGIN ?DUP WHILE >RESOLVE REPEAT ; 4 5 : BEGIN 0 <MARK ; IMMEDIATE (S 0 a - )( mark loop start ) 6 7 : WHILE (S a1 - a2 a1 / f - )( conditional loop exit ) 8 [COMPILE] IF SWAP ; IMMEDIATE 9 10 : REPEAT (S 0..an a - / - )( terminate repeating loop ) 11 COMPILE BRANCH <RESOLVE RESOLVES ; IMMEDIATE 12 : UNTIL (S 0..an a - / f - )( terminate conditional loop ) 13 COMPILE ?BRANCH <RESOLVE RESOLVES ; IMMEDIATE 14 15 Listing Three B:PAPERS.BLK Screen 3* 0 \ Proposed Standard Control Structures GWS 86Mar31 1 \ note: !0 is 0 SWAP ! ADDR, is , (S is ( 2 3 : >MARK HERE 2 ALLOT ; (S - a )( mark forward branch ) 4 : >RESOLVE HERE SWAP ! ; (S a - )( patch forward branch ) 5 : MARKLIST (S a - )( extend list at a, link in dictionary ) 9 HERE SWAP DUP @ ADDR, ( link) ! ( new head) ; 10 : >RESOLVELIST (S a - )( resolve top node in a to here ) 11 DUP @ DUP @ ROT ! ( unlink top node) >RESOLVE ; 12 : >RESOLVESLIST (S a - )( resolve all nodes in a to here ) 13 DUP @ BEGIN DUP WHILE DUP @ SWAP >RESOLVE REPEAT 14 DROP !0 ; 1 6 +THRU 15 Screen 4 0 \ compilation list initialization GWS 86Mar31 1 ORPHAN ( make headless words ) 2 VARIABLE IF-LIST VARIABLE LEAVES-LIST VARIABLE LEAVE-LIST 3 VARIABLE LEAVE-CF 4 : INIT-LISTS (S - )( reset all list pointers ) 5 IF-LIST !0 LEAVE-LIST !0 LEAVES-LIST !0 ; 6 7 : SAVE-LISTS (S - x x x x )( save current list pointers ) 8 LEAVE-CF @ IF-LIST @ LEAVE-LIST @ LEAVES-LIST @ 9 INIT-LISTS ; 10 : RESTORE-LISTS (S - x x x x )( restore current list pointers ) 11 ( could check here for unresolved structures) 12 LEAVES-LIST ! LEAVE-LIST ! IF-LIST ! LEAVE-CF ! ; 13 14 ADOPT ( make headed words ) 15 Screen 5 0 \ Conditional compilers - if/else/then & case GWS 86Mar31 1 2 : IF (S - / f - )( compile to branch if f is false ) 3 COMPILE ?BRANCH IF-LIST >MARKLIST ; IMMEDIATE 4 : ELSE (S - / - )( compile alternate to IF clause ) 5 COMPILE BRANCH IF-LIST >MARKLIST IF-LIST @ ( if branch) 6 >RESOLVELIST ; IMMEDIATE 7 : THEN (S - / - )( resolve latest forward reference ) 8 IF-LIST >RESOLVELIST ; IMMEDIATE 9 10 : CASE (S - x x x x / ? - ? )( setup for case statement ) 11 SAVE-LISTS ['] BRANCH LEAVE-CF ! ; IMMEDIATE 12 : ENDCASE (S - / x x x x - )( restore lists, resolve leaves ) 13 LEAVES-LIST >RESOLVESLIST RESTORE-LISTS ; IMMEDIATE 14 15 B:PAPERS.BLK Screen 6* 0 \ common loop end and exit GWS 86Mar31 1 2 ORPHAN ( make headless words ) 3 : LOOPEND (S x x x x a1 a2 - )( resolve list a2 & branch ) 4 ( a1, restore values x, transfer leaves-list to if-list ) 5 SWAP <RESOLVE ( back branch) >RESOLVESLIST ( forward branch) 6 LEAVES-LIST @ ?DUP IF >R RESTORE-LISTS IF-LIST @ R@ 7 BEGIN DUP @ WHILE @ REPEAT ( find leaves list end) ! 8 ( link to if list) R> IF-LIST ! ELSE RESTORE-LISTS 9 THEN ; 10 ADOPT ( make headed words ) 11 : OUTSIDE (S - / - )( allow LEAVES outside current loop level) 12 IF-LIST @ DUP @ IF-LIST ! ( unlink) LEAVES-LIST @ OVER ! 13 COMPILE-UNNEST LEAVES-LIST ! ( relink) ; IMMEDIATE 14 15 Screen 7 0 \ do loops GWS 86Mar31 1 2 : LEAVE (S - / - )( compile exit from structure ) 3 LEAVE-CF @ ADDR, LEAVE-LIST >MARKLIST ; IMMEDIATE 4 : LEAVES (S - / - )( compile exit to outside structure ) 5 LEAVE-CF @ ADDR, LEAVES-LIST >MARKLIST [COMPILE] THEN ; 6 IMMEDIATE 7 8 : DO (S - x x x x a / u u - )( initiate counted loop ) 9 SAVE-LISTS ['] (LEAVE) LEAVE-CF ! COMPILE (DO) 10 <MARK ; IMMEDIATE 11 : LOOP (S x x x x a - / - )( compile increment loop end ) 12 COMPILE (LOOP) LEAVE-LIST LOOPEND ; IMMEDIATE 13 : +LOOP (S x x x x x a - / u - )( compile u+ loop end ) 14 COMPILE (+LOOP) LEAVE-LIST LOOPEND ; IMMEDIATE 15 Screen 8 0 \ more loops GWS 86Mar31 1 2 : BEGIN (S - x x x x a / - )( mark start of a loop ) 3 [COMPILE] CASE RESOLVESLIST ; IMMEDIATE 8 : UNTIL (S x x x x a - / - )( terminate repeating loop ) 9 COMPILE ?BRANCH IF-LIST LOOPEND 10 LEAVE-LIST >RESOLVESLIST ; IMMEDIATE 11 12 : WHILE [COMPILE] IF ; IMMEDIATE (S - )( for compatibility) 13 14 15 Listing Four B:PAPERS.BLK Screen 9* 0 \ suggested extensions GWS 86Mar31 1 2 : ?LEAVE (S - / f - )( leave do loop if tf ) 3 COMPILE (?LEAVE) LEAVE-LIST >MARKLIST ; IMMEDIATE 4 : ?LEAVES (S - / f - )( leave do loop if tf ) 5 COMPILE (?LEAVE) LEAVES-LIST >MARKLIST ; IMMEDIATE 6 7 : THENS (S - / - )( resolve all outstanding IFs ) 8 IF-LIST >RESOLVESLIST ; IMMEDIATE 9 : ELSES (S - / - )( resolve all outstanding IFs w/common ELSE ) 10 [COMPILE] ELSE IF-LIST @ >RESOLVESLIST ; IMMEDIATE 11 12 13 14 15 Listing Five Previously Proposed Solutions Proposed Solution BEGIN ... same WHILE ... WHILE ... ... REPEAT BEGIN ... same WHILE ... WHILE ... ... UNTIL BEGIN ... BEGIN ... WHILE ... WHILE ANDWHILE ... WHILE ANDWHILE ... WHILE ... ... REPEAT REPEAT BEGIN ... BEGIN ... WHILE aa NOT IF ff LEAVES aa WHILE bb NOT IF ee LEAVES bb WHILE cc WHILE cc ... ... REPEAT dd REPEAT dd <WHILE ee <WHILE ff <END THEN THEN BEGIN ... see below IF ... LEAVE THEN IF ... LEAVE THEN ... REPEAT BEGIN ... BEGIN ... UNLESS ... FINISH IF ... LEAVES UNLESS ... FINISH IF ... LEAVES ... AGAIN REPEAT THEN THEN DO ... DO ... PERHAPS ... ESCAPE IF ... LEAVES PERHAPS ... ESCAPE IF ... LEAVES ... ... LOOP ... LOOP ... ESCAPED ... THEN THEN ... (or ELSE ... THEN) DO ... DO ... IF ... LEAVE THEN aa IF ... LEAVES aa LOOP--FALLTHRU: bb LOOP bb THEN cc THEN cc DO ... DO ... WHEN ... NOT IF LEAVE THEN ... LOOP LOOP DO ... DO ... NOTWHEN ... IF LEAVE THEN ... LOOP LOOP DO ... DO ... IF LEAVE THEN ... IF LEAVES EXITING LOOP LOOP ... ... THEN THEN none DO ... DO ... IF LEAVES ... LOOP OUTSIDE LOOP ... THEN none BEGIN ... BEGIN ... IF LEAVES ... REPEAT OUTSIDE REPEAT ... THEN <STEPS ... CASE &IF ... IF ... &IF ... IF ... STEPS> THENS ENDCASE IF ... ELSE ... IF ... ELSE ... THENIF ... ELSE IF ... ELSE ... THENIF ... ELSE IF ... ELSE ... ... ... THEN THENS or CASE IF ... LEAVES IF ... LEAVES ... ENDCASE IF ... IF ... ANDIF ... IF ... ANDIF ... IF ... ... ... ( ELSE) ( ELSES) THEN THENS ( THEN) CASE ... CASE ... OF ... ENDOF OVER = IF ... LEAVES OF ... ENDOF OVER = IF ... LEAVES ... ... ENDCASE DROP ENDCASE