[gforth] / gforth / oof.fs  

gforth: gforth/oof.fs

Diff for /gforth/oof.fs between version 1.9 and 1.10

version 1.9, Mon Mar 31 22:14:39 1997 UTC version 1.10, Wed Jul 2 20:30:06 1997 UTC
Line 126 
Line 126 
 : defer?   ( addr -- flag )  : defer?   ( addr -- flag )
   >body cell+ @ #defer  = ;    >body cell+ @ #defer  = ;
   
   false Value oset?
   
 : o+,   ( addr offset -- )  : o+,   ( addr offset -- )
   postpone Literal postpone ^ postpone +    postpone Literal postpone ^ postpone +
   postpone >o drop ;    oset? IF  postpone op!  ELSE  postpone >o  THEN  drop ;
 : o*,   ( addr offset -- )  : o*,   ( addr offset -- )
   postpone Literal postpone * postpone Literal postpone +    postpone Literal postpone * postpone Literal postpone +
   postpone >o ;    oset? IF  postpone op!  ELSE  postpone >o  THEN ;
 : ^+@  ( offset -- addr )  ^ + @ ;  : ^+@  ( offset -- addr )  ^ + @ ;
 : o+@,  ( addr offset -- )  : o+@,  ( addr offset -- )
     postpone Literal postpone ^+@  postpone >o drop ;      postpone Literal postpone ^+@  oset? IF  postpone op!  ELSE  postpone >o  THEN drop ;
 : ^*@  ( offset -- addr )  ^ + @ tuck @ :var# + @ 8aligned * + ;  : ^*@  ( offset -- addr )  ^ + @ tuck @ :var# + @ 8aligned * + ;
 : o+@*, ( addr offset -- )  : o+@*, ( addr offset -- )
   postpone Literal postpone ^*@  postpone >o drop ;    postpone Literal postpone ^*@  oset? IF  postpone op!  ELSE  postpone >o  THEN drop ;
   
 \ variables / memory allocation                        30oct94py  \ variables / memory allocation                        30oct94py
   
Line 216 
Line 218 
     r> drop-order ;      r> drop-order ;
   
 false Value method?  false Value method?
 false Value oset?  
   
 : method,  ( object early? -- )  true to method?  : method,  ( object early? -- )  true to method?
     swap >o >r bl word  findo  0< state @ and      swap >o >r bl word  findo  0< state @ and
     IF  r> o,  ELSE  r> drop execute  THEN  o> false to method?  ;      IF  r> o,  ELSE  r> drop execute  THEN  o> false to method?  ;
   
   : cmethod,  ( object early? -- )
       state @ >r state on  method, r> state ! ;
   
 : early, ( object -- )  true to oset?  true  method,  : early, ( object -- )  true to oset?  true  method,
   state @ IF  postpone o>  THEN  false to oset? ;    state @ oset? and IF  postpone o>  THEN  false to oset? ;
 : late,  ( object -- )  true to oset?  false method,  : late,  ( object -- )  true to oset?  false method,
   state @ IF  postpone o>  THEN  false to oset? ;    state @ oset? and IF  postpone o>  THEN  false to oset? ;
   
 \ new,                                                 29oct94py  \ new,                                                 29oct94py
   
Line 306 
Line 310 
 \ instance creation                                    29mar94py  \ instance creation                                    29mar94py
   
 : instance, ( o -- )  alloc @ >r static new, r> alloc ! drop  : instance, ( o -- )  alloc @ >r static new, r> alloc ! drop
   DOES> state @ IF  dup postpone Literal postpone >o  THEN early, ;    DOES> state @ IF  dup postpone Literal oset? IF  postpone op!  ELSE  postpone >o  THEN  THEN early, ;
 : ptr,      ( o -- )  0 , ,  : ptr,      ( o -- )  0 , ,
   DOES>  state @    DOES>  state @
     IF    dup postpone Literal postpone @ postpone >o cell+      IF    dup postpone Literal postpone @ oset? IF  postpone op!  ELSE  postpone >o  THEN cell+
     ELSE  @  THEN late, ;      ELSE  @  THEN late, ;
   
 : array,  ( n o -- )  alloc @ >r static new[], r> alloc ! drop  : array,  ( n o -- )  alloc @ >r static new[], r> alloc ! drop
Line 440 
Line 444 
 : asptr ( addr -- )  cell+ @ Create immediate  : asptr ( addr -- )  cell+ @ Create immediate
   lastob @ here lastob ! , ,  instptr> ;    lastob @ here lastob ! , ,  instptr> ;
   
   : Fpostpone  postpone postpone ; immediate
   
 : : ( <methodname> -- )  decl @ abort" HOW: missing! "  : : ( <methodname> -- )  decl @ abort" HOW: missing! "
     bl word findo 0= abort" not found"      bl word findo 0= abort" not found"
     dup exec? over early? or over >body cell+ @ 0< or      dup exec? over early? or over >body cell+ @ 0< or
Line 490 
Line 496 
          early     send        immediate           early     send        immediate
          early     with        immediate           early     with        immediate
          early     endwith     immediate           early     endwith     immediate
            early     postpone    immediate
   
 \ base object class implementation part                23mar95py  \ base object class implementation part                23mar95py
   
Line 507 
Line 514 
         : []      ( n -- )     Create immediate o@          : []      ( n -- )     Create immediate o@
           decl @ IF  instarray,  ELSE  array,     THEN ;            decl @ IF  instarray,  ELSE  array,     THEN ;
         : new     ( -- o )     o@ state @          : new     ( -- o )     o@ state @
           IF  postpone Literal postpone new,  ELSE  new,  THEN ;            IF  Fpostpone Literal Fpostpone new,  ELSE  new,  THEN ;
         : new[]   ( n -- o )   o@ state @          : new[]   ( n -- o )   o@ state @
           IF postpone Literal postpone new[], ELSE new[], THEN ;            IF Fpostpone Literal Fpostpone new[], ELSE new[], THEN ;
         : dispose ( -- )       ^ size @ dispose, ;          : dispose ( -- )       ^ size @ dispose, ;
         : bind    ( addr -- )  (bind ;          : bind    ( addr -- )  (bind ;
         : bound   ( o1 o2 addr2  -- ) (bound ;          : bound   ( o1 o2 addr2  -- ) (bound ;
Line 523 
Line 530 
         : init    ( -- )       ;          : init    ( -- )       ;
   
         : '       ( -- xt )  bl word findo 0= abort" not found!"          : '       ( -- xt )  bl word findo 0= abort" not found!"
           state @ IF  postpone Literal  THEN ;            state @ IF  Fpostpone Literal  THEN ;
         : send    ( xt -- )  execute ;          : send    ( xt -- )  execute ;
           : postpone ( -- )  o@ add-order Fpostpone Fpostpone drop-order ;
   
         : with ( -- )          : with ( -- )
           state @ oset? 0= and IF  postpone >o  THEN            state @ oset? 0= and IF  Fpostpone >o  THEN
           o@ add-order voc# ! false to oset?            o@ add-order voc# ! false to oset? ;
           r> drop state @          : endwith  Fpostpone o>
           IF    o>  
           ELSE  oset? IF  ^ THEN  o> postpone >o  
           THEN  
           r> drop r> drop ;  
         : endwith  postpone o>  
           voc# @ drop-order ;            voc# @ drop-order ;
 class; \ object  class; \ object
   
Line 596 
Line 599 
   
 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]  

Generate output suitable for use with a patch program
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help