--- gforth/oof.fs 1997/01/25 20:53:02 1.5 +++ gforth/oof.fs 1997/02/16 20:51:10 1.7 @@ -15,7 +15,9 @@ decimal : define? ( -- flag ) bl word find nip 0= ; -define? cell [IF] 1 cells Constant cell [THEN] +define? cell [IF] +1 cells Constant cell +[THEN] define? ?EXIT [IF] : ?EXIT postpone IF postpone EXIT postpone THEN ; immediate @@ -26,6 +28,13 @@ define? Vocabulary [IF] DOES> @ >r get-order nip r> swap set-order ; [THEN] +define? faligned [IF] false [ELSE] 1 faligned 8 = [THEN] +[IF] +: 8aligned ( n1 -- n2 ) faligned ; +[ELSE] +: 8aligned ( n1 -- n2 ) 7 + -8 and ; +[THEN] + Vocabulary Objects also Objects also definitions Vocabulary types types also @@ -85,11 +94,6 @@ Objects definitions : defer? ( addr -- flag ) >body cell+ @ #defer = ; -define? faligned [IF] false [ELSE] 1 faligned 8 = [THEN] -[IF] : 8aligned ( n1 -- n2 ) faligned ; -[ELSE] : 8aligned ( n1 -- n2 ) 7 + -8 and ; -[THEN] - : o+, ( addr offset -- ) postpone Literal postpone ^ postpone + postpone >o drop ; @@ -493,11 +497,11 @@ how: 0 parento ! : with ( -- ) state @ oset? 0= and IF postpone >o THEN o@ add-order voc# ! false to oset? - rdrop state @ + r> drop state @ IF o> ELSE oset? IF ^ THEN o> postpone >o THEN - rdrop rdrop ; + r> drop r> drop ; : endwith postpone o> voc# @ drop-order ; class; \ object @@ -559,3 +563,35 @@ Forth definitions DOES> @ decl @ IF implement ELSE inter-method, THEN ; previous previous + +\ The program uses the following words +\ from CORE : +\ decimal : bl word 0= ; cells Constant POSTPONE IF EXIT THEN immediate +\ Create , DOES> @ >r r> swap + and Variable ! allot ELSE +! dup * >body +\ cell+ = Literal drop align here aligned execute ['] 2@ recurse 1+ over +\ LOOP ?dup 0< rot r@ - i negate +LOOP 2drop BEGIN WHILE 2dup REPEAT 1- +\ rshift > / ' move UNTIL or count +\ from CORE-EXT : +\ nip tuck true ?DO compile, false Value erase pick :noname 0<> +\ from BLOCK-EXT : +\ \ +\ from EXCEPTION : +\ throw +\ from EXCEPTION-EXT : +\ abort" +\ from FILE : +\ ( S" +\ from FLOAT : +\ faligned +\ from LOCAL : +\ TO +\ from MEMORY : +\ allocate free +\ from SEARCH : +\ find wordlist get-order set-order definitions get-current set-current search-wordlist +\ from SEARCH-EXT : +\ also Forth previous +\ from STRING : +\ /string compare +\ from TOOLS-EXT : +\ state [IF] [THEN]