Return to toolsext.fs CVS log

Up to [gforth] / gforth

Integrated locals (in particular automatic scoping) into the system.

    1: \ TOOLSEXT.FS [IF] [ELSE] [THEN] and more              20may93jaw
    2: 
    3: \ This here is fully ans compatible
    4: \ May be cross-compiled
    5: 
    6: \ ( \ added 09jun93jaw
    7: 
    8: \ very close to dpANS5
    9: 
   10: decimal
   11: 
   12: CREATE Opennest  7 chars allot
   13: CREATE Closenest 7 chars allot
   14: 
   15: : SKIPNEST
   16:       1 BEGIN
   17:           BEGIN name count dup WHILE
   18:                 2dup Opennest count compare 0=
   19:                 IF   2drop 1+
   20:                 ELSE    Closenest count compare 0= IF 1- THEN
   21:                 THEN
   22:                 ?dup 0= IF EXIT THEN
   23:           REPEAT
   24:           2drop refill 0=
   25:         UNTIL drop ;
   26: 
   27: \ : (     s" (" Opennest place
   28: \         s" )" Closenest place
   29: \         SKIPNEST ; immediate
   30: 
   31: : comment? ( c-addr u -- c-addr u )
   32:         2dup s" (" compare 0=
   33:         IF    postpone (
   34:         ELSE  2dup s" \" compare 0= IF postpone \ THEN
   35:         THEN ;
   36: 
   37: : [ELSE]
   38:       1 BEGIN
   39:           BEGIN name count dup WHILE
   40:                 comment?
   41:                 2dup s" [IF]" compare 0=
   42:                 IF   2drop 1+
   43:                 ELSE 2dup s" [ELSE]" compare 0=
   44:                      IF   2drop 1- dup IF 1+ THEN
   45:                      ELSE s" [THEN]" compare 0= IF 1- THEN
   46:                      THEN
   47:                 THEN
   48:                 ?dup 0= IF EXIT THEN
   49:           REPEAT
   50:           2drop refill 0=
   51:         UNTIL drop ; immediate
   52: 
   53: : [THEN] ( -- ) ;    immediate
   54: 
   55: : [IF] ( flag -- )
   56:         0= IF postpone [ELSE] THEN ; immediate
   57: 
   58: \ [IFUNDEF] [IFDEF]                                     9may93jaw
   59: 
   60: : [IFUNDEF]
   61:         name find nip 0= postpone [IF] ; immediate
   62: : [IFDEF]
   63:         name find nip 0<> postpone [IF] ; immediate
   64: 
   65: 
   66: \ [IF]?                                                 9jun93jaw
   67: 
   68: \ same as comment? but skips [IF] .... [THEN]
   69: 
   70: : [if]?   ( c-addr u -- c-addr u )
   71:         2dup s" [IF]" compare 0= >r
   72:         2dup s" [ELSE]" compare 0= >r
   73:         2dup s" [IFUNDEF]" compare 0= >r
   74:         2dup s" [IFDEF]" compare 0= r> or r> or r> or
   75:         IF   s" [IF]" Opennest place
   76:              s" [THEN]" Closenest place
   77:              SKIPNEST THEN ;
   78: