Annotation of gforth/toolsext.fs, revision 1.4
1.4 ! pazsan 1: \ Interpretative Structuren 16feb92py
1.1 anton 2:
1.4 ! pazsan 3: Variable countif
1.1 anton 4:
1.4 ! pazsan 5: : dummy ; immediate
! 6: : >exec >r ; restrict ( :-)
! 7: : scanIF f83find dup 0= IF drop ['] dummy >name THEN ;
! 8:
! 9: Create [struct]-search ' scanIF A, ' (reveal) A, ' drop A,
! 10: Create [struct]-voc NIL A, G [struct]-search T A,
! 11: NIL A, NIL A,
! 12:
! 13: : ?if countif @ 0<
! 14: IF [ [struct]-voc 3 cells + ] ALiteral @ lookup ! THEN ;
! 15:
! 16: UNLOCK Tlast @ NIL Tlast ! LOCK
! 17:
! 18: : [IF] 1 countif +! ?if ; immediate
! 19: : [THEN] -1 countif +! ?if ; immediate
! 20: : [ELSE] postpone [THEN] r> >exec postpone [IF] ;
! 21: immediate
! 22: ' [IF] Alias [IFDEF] immediate
! 23: ' [IF] Alias [IFUNDEF] immediate
! 24: ' [IF] Alias [BEGIN] immediate
! 25: ' [IF] Alias [WHILE] immediate
! 26: ' [THEN] Alias [UNTIL] immediate
! 27: ' [THEN] Alias [AGAIN] immediate
! 28: ' [IF] Alias [DO] immediate
! 29: ' [IF] Alias [?DO] immediate
! 30: ' [THEN] Alias [LOOP] immediate
! 31: ' [THEN] Alias [+LOOP] immediate
! 32: : [REPEAT] postpone [AGAIN] postpone [THEN] ;
! 33: immediate
! 34: ' ( Alias ( immediate
! 35: ' \ Alias \ immediate
! 36:
! 37: UNLOCK Tlast @ swap Tlast ! LOCK
! 38: 1 cells - G [struct]-voc T !
! 39:
! 40: \ Interpretative Structuren 30apr92py
! 41:
! 42: : defined bl word find nip 0<> ; immediate
! 43: : [IF] 0= IF countif off
! 44: lookup @ [ [struct]-voc 3 cells + ] ALiteral !
! 45: [struct]-voc lookup !
! 46: THEN ; immediate
! 47: : [IFDEF] postpone defined postpone [IF] ; immediate
! 48: : [IFUNDEF] postpone defined 0= postpone [IF] ; immediate
! 49: : [ELSE] 0 postpone [IF] ; immediate
! 50: : [THEN] ; immediate
! 51:
! 52: \ Structs for interpreter 28nov92py
! 53:
! 54: User (i)
! 55:
! 56: : [DO] ( start end -- ) >in @ -rot
! 57: DO I (i) ! dup >r >in ! interpret r> swap +LOOP drop ;
! 58: immediate
! 59: : [?DO] 2dup = IF 2drop postpone [ELSE] ELSE postpone [DO] THEN ;
! 60: immediate
! 61: : [+LOOP] ( n -- ) rdrop rdrop ; immediate
! 62: : [LOOP] ( -- ) 1 rdrop rdrop ; immediate
! 63: : [FOR] ( n -- ) 0 swap postpone [DO] ; immediate
! 64: : [NEXT] ( n -- ) -1 rdrop rdrop ; immediate
! 65: : [I] ( -- index ) (I) @ postpone Literal ; immediate
! 66: : [BEGIN] >in @ >r BEGIN r@ >in ! interpret UNTIL rdrop ;
! 67: immediate
! 68: ' [+LOOP] Alias [UNTIL] immediate
! 69: : [REPEAT] ( -- ) false rdrop rdrop ; immediate
! 70: ' [REPEAT] Alias [AGAIN] immediate
! 71: : [WHILE] ( flag -- )
! 72: 0= IF postpone [ELSE] true rdrop rdrop 1 countif +! THEN ;
! 73: immediate
1.1 anton 74:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>