Return to toolsext.fs CVS log

Up to [gforth] / gforth

Annotation of gforth/toolsext.fs, revision 1.1

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
        !            22:                 ?dup 0= ?EXIT
        !            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= ?EXIT
        !            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: