[gforth] / gforth / see.fs  

gforth: gforth/see.fs

Diff for /gforth/see.fs between version 1.16 and 1.17

version 1.16, Wed May 21 20:39:39 1997 UTC version 1.17, Sun Jun 1 20:50:39 1997 UTC
Line 108 
Line 108 
 : .struc  : .struc
         uppercase on Str# .string ;          uppercase on Str# .string ;
   
 \ CODES                                                 15may93jaw  \ CODES (Branchtypes)                                    15may93jaw
   
 21 CONSTANT RepeatCode  21 CONSTANT RepeatCode
 22 CONSTANT AgainCode  22 CONSTANT AgainCode
Line 118 
Line 118 
 11 CONSTANT AheadCode  11 CONSTANT AheadCode
 13 CONSTANT WhileCode2  13 CONSTANT WhileCode2
 14 CONSTANT Disable  14 CONSTANT Disable
   15 CONSTANT LeaveCode
   
   
 \ FORMAT WORDS                                          13jun93jaw  \ FORMAT WORDS                                          13jun93jaw
   
 VARIABLE C-Stop  VARIABLE C-Stop
 VARIABLE Branches  VARIABLE Branches
   
 VARIABLE BranchPointer  VARIABLE BranchPointer  \ point to the end of branch table
 VARIABLE SearchPointer  VARIABLE SearchPointer
   
   \ The branchtable consists of three entrys:
   \ address of branch , branch destination , branch type
   
 CREATE BranchTable 500 allot  CREATE BranchTable 500 allot
 here 3 cells -  here 3 cells -
 ACONSTANT MaxTable  ACONSTANT MaxTable
   
 : FirstBranch BranchTable cell+ SearchPointer ! ;  : FirstBranch BranchTable cell+ SearchPointer ! ;
   
 : (BranchAddr?) ( a-addr -- a-addr true | false )  : (BranchAddr?) ( a-addr1 -- a-addr2 true | false )
   \ searches a branch with destination a-addr1
   \ a-addr1: branch destination
   \ a-addr2: pointer in branch table
         SearchPointer @          SearchPointer @
         BEGIN   dup BranchPointer @ u<          BEGIN   dup BranchPointer @ u<
         WHILE          WHILE
Line 161 
Line 170 
         2drop true          2drop true
         THEN ;          THEN ;
   
   : MyBranch      ( a-addr -- a-addr a-addr2 )
   \ finds branch table entry for branch at a-addr
                   dup @ over +
                   BranchAddr?
                   BEGIN
                   WHILE 1 cells - @
                         over <>
                   WHILE dup @ over +
                         MoreBranchAddr?
                   REPEAT
                   SearchPointer @ 3 cells -
                   ELSE    true ABORT" SEE: Table failure"
                   THEN ;
   
 \  \
 \                 addrw               addrt  \                 addrw               addrt
 \       BEGIN ... WHILE ... AGAIN ... THEN  \       BEGIN ... WHILE ... AGAIN ... THEN
Line 250 
Line 273 
         THEN ;          THEN ;
   
   
 : Forward? ( a-addr true | false -- )  : Forward? ( a-addr true | false -- a-addr true | false )
   \ a-addr1 is pointer into branch table
   \ returns true when jump is a forward jump
         IF      dup dup @ swap 1 cells - @ -          IF      dup dup @ swap 1 cells - @ -
                 Ahead? IF true ELSE drop false THEN                  Ahead? IF true ELSE drop false THEN
                 \ only if forward jump                  \ only if forward jump
         ELSE    false THEN ;          ELSE    false THEN ;
   
 : RepeatCheck  : RepeatCheck ( a-addr1 a-addr2 true | false -- false )
         IF  BEGIN  2dup          IF  BEGIN  2dup
                    1 cells - @ swap dup @ +                     1 cells - @ swap dup @ +
                    u<=                     u<=
Line 295 
Line 320 
                         IF      drop S" REPEAT " .struc nl                          IF      drop S" REPEAT " .struc nl
                         ELSE    S" AGAIN " .struc nl                          ELSE    S" AGAIN " .struc nl
                         THEN                          THEN
                 ELSE    dup cell+ BranchAddr? Forward?                  ELSE    MyBranch cell+ @ LeaveCode =
                           IF      S" LEAVE " .struc
                           ELSE
                                   dup cell+ BranchAddr? Forward?
                         IF      dup cell+ @ WhileCode2 =                          IF      dup cell+ @ WhileCode2 =
                                 IF nl S" ELSE" .struc level+                                  IF nl S" ELSE" .struc level+
                                 ELSE level- nl S" ELSE" .struc level+ THEN                                  ELSE level- nl S" ELSE" .struc level+ THEN
Line 304 
Line 332 
                         THEN                          THEN
                 THEN                  THEN
         THEN          THEN
           THEN
         Debug?          Debug?
         IF      dup @ +          IF      dup @ +
         ELSE    cell+          ELSE    cell+
         THEN ;          THEN ;
   
 : MyBranch      ( a-addr -- a-addr a-addr2 )  
                 dup @ over +  
                 BranchAddr?  
                 BEGIN  
                 WHILE 1 cells - @  
                       over <>  
                 WHILE dup @ over +  
                       MoreBranchAddr?  
                 REPEAT  
                 SearchPointer @ 3 cells -  
                 ELSE    true ABORT" SEE: Table failure"  
                 THEN ;  
   
 : DebugBranch  : DebugBranch
         Debug?          Debug?
         IF      dup @ over + swap THEN ; \ return 2 different addresses          IF      dup @ over + swap THEN ; \ return 2 different addresses
Line 344 
Line 360 
                                 level- nl                                  level- nl
                                 S" WHILE " .struc                                  S" WHILE " .struc
                                 level+                                  level+
                           ELSE    MyBranch cell+ @ LeaveCode =
                                   IF   s" 0= ?LEAVE " .struc
                         ELSE    nl S" IF " .struc level+                          ELSE    nl S" IF " .struc level+
                         THEN                          THEN
                 THEN                  THEN
         THEN          THEN
           THEN
         DebugBranch          DebugBranch
         cell+ ;          cell+ ;
   
Line 355 
Line 374 
         Display? IF nl S" FOR" .struc level+ THEN ;          Display? IF nl S" FOR" .struc level+ THEN ;
   
 : .name-without  : .name-without
   \ prints a name without () e.g. (+LOOP)
         dup 1 cells - @ look IF name>string 1 /string 1- .struc ELSE drop THEN ;          dup 1 cells - @ look IF name>string 1 /string 1- .struc ELSE drop THEN ;
   
 : c-loop  : c-loop
         Display? IF level- nl .name-without bl cemit nl THEN          Display? IF level- nl .name-without bl cemit nl THEN
         DebugBranch cell+ cell+ ;          DebugBranch cell+
           Scan?
           IF      dup BranchAddr?
                   BEGIN   WHILE cell+ LeaveCode swap !
                           dup MoreBranchAddr?
                   REPEAT
           THEN
           cell+ ;
   
 : c-do  : c-do
         Display? IF nl .name-without level+ THEN ;          Display? IF nl .name-without level+ THEN ;
Line 368 
Line 395 
         Display? IF nl S" ?DO" .struc level+ THEN          Display? IF nl S" ?DO" .struc level+ THEN
         DebugBranch cell+ ;          DebugBranch cell+ ;
   
 : c-leave  
         Display? IF S" LEAVE " .struc THEN  
         Debug? IF dup @ + THEN cell+ ;  
   
 : c-?leave  
         Display? IF S" ?LEAVE " .struc THEN  
         cell+ DebugBranch swap cell+ swap cell+ ;  
   
 : c-exit  dup 1 cells -  : c-exit  dup 1 cells -
         CheckEnd          CheckEnd
         IF      Display? IF nlflag off S" ;" Com# .string THEN          IF      Display? IF nlflag off S" ;" Com# .string THEN
Line 403 
Line 422 
         ' (s") A,           ' c-s" A,          ' (s") A,           ' c-s" A,
         ' (.") A,           ' c-." A,          ' (.") A,           ' c-." A,
         ' "lit A,           ' c-c" A,          ' "lit A,           ' c-c" A,
         comp' leave drop A, ' c-leave A,  
         comp' ?leave drop A, ' c-?leave A,  
         ' (do) A,           ' c-do A,          ' (do) A,           ' c-do A,
         ' (+do) A,          ' c-do A,          ' (+do) A,          ' c-do A,
         ' (u+do) A,         ' c-do A,          ' (u+do) A,         ' c-do A,
Line 451 
Line 468 
                                 BEGIN cell+ @ dup 20 u>                                  BEGIN cell+ @ dup 20 u>
                                 IF drop nl S" BEGIN " .struc level+                                  IF drop nl S" BEGIN " .struc level+
                                 ELSE                                  ELSE
                                   dup Disable <>                                    dup Disable <> over LeaveCode <> and
                                   IF   WhileCode2 =                                    IF   WhileCode2 =
                                        IF nl S" THEN " .struc nl ELSE                                         IF nl S" THEN " .struc nl ELSE
                                        level- nl S" THEN " .struc nl THEN                                         level- nl S" THEN " .struc nl THEN

Generate output suitable for use with a patch program
Legend:
Removed from v.1.16  
changed lines
  Added in v.1.17
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help