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:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>