Annotation of gforth/toolsext.fs, revision 1.2

1.1       anton       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
1.2     ! anton      22:                 ?dup 0= IF EXIT THEN
1.1       anton      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
1.2     ! anton      48:                 ?dup 0= IF EXIT THEN
1.1       anton      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: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>