Diff for /gforth/oof.fs between versions 1.5 and 1.8

version 1.5, 1997/01/25 20:53:02 version 1.8, 1997/03/13 23:40:33
Line 7 Line 7
 \  \
 \               Thank you.  \               Thank you.
 \  \
   \ The program uses the following words
   \ from CORE :
   \ decimal : bl word 0= ; = cells Constant Variable ! Create , allot @ IF POSTPONE >r ELSE +! dup + THEN immediate r> * >body cell+ Literal drop align here aligned DOES> execute ['] 2@ recurse swap 1+ over LOOP and EXIT ?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 definitions get-order set-order get-current wordlist set-current search-wordlist 
   \ from SEARCH-EXT :
   \ also Forth previous 
   \ from STRING :
   \ /string compare 
   \ from TOOLS-EXT :
   \ [IF] [THEN] [ELSE] state 
   
 \ Loadscreen                                           27dec95py  \ Loadscreen                                           27dec95py
   
Line 15  decimal Line 42  decimal
 : define?  ( -- flag )  : define?  ( -- flag )
   bl word find  nip 0= ;    bl word find  nip 0= ;
   
 define? cell  [IF]  1 cells Constant cell  [THEN]  define? cell  [IF]
   1 cells Constant cell
   [THEN]
   
 define? ?EXIT [IF]  define? ?EXIT [IF]
 : ?EXIT  postpone IF  postpone EXIT postpone THEN ; immediate  : ?EXIT  postpone IF  postpone EXIT postpone THEN ; immediate
Line 26  define? Vocabulary [IF] Line 55  define? Vocabulary [IF]
 DOES> @ >r get-order nip r> swap set-order ;  DOES> @ >r get-order nip r> swap set-order ;
 [THEN]  [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 Objects  also Objects also definitions
   
 Vocabulary types  types also  Vocabulary types  types also
Line 85  Objects definitions Line 121  Objects definitions
 : defer?   ( addr -- flag )  : defer?   ( addr -- flag )
   >body cell+ @ #defer  = ;    >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 -- )  : o+,   ( addr offset -- )
   postpone Literal postpone ^ postpone +    postpone Literal postpone ^ postpone +
   postpone >o drop ;    postpone >o drop ;
Line 493  how: 0 parento ! Line 524  how: 0 parento !
         : with ( -- )          : with ( -- )
           state @ oset? 0= and IF  postpone >o  THEN            state @ oset? 0= and IF  postpone >o  THEN
           o@ add-order voc# ! false to oset?            o@ add-order voc# ! false to oset?
           rdrop state @            r> drop state @
           IF    o>            IF    o>
           ELSE  oset? IF  ^ THEN  o> postpone >o            ELSE  oset? IF  ^ THEN  o> postpone >o
           THEN            THEN
           rdrop rdrop ;            r> drop r> drop ;
         : endwith  postpone o>           : endwith  postpone o> 
           voc# @ drop-order ;            voc# @ drop-order ;
 class; \ object  class; \ object
Line 559  Forth definitions Line 590  Forth definitions
     DOES>  @ decl @  IF  implement  ELSE  inter-method,  THEN ;      DOES>  @ decl @  IF  implement  ELSE  inter-method,  THEN ;
   
 previous previous  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] 

Removed from v.1.5  
changed lines
  Added in v.1.8


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