Diff for /gforth/oof.fs between versions 1.10 and 1.11

version 1.10, 1997/07/02 20:30:06 version 1.11, 1997/08/02 20:19:05
Line 489  Create object  immediate  0 (class \ do Line 489  Create object  immediate  0 (class \ do
          early     super       immediate           early     super       immediate
          early     self           early     self
          early     bind        immediate           early     bind        immediate
          early     is          immediate  
          early     bound           early     bound
          early     link        immediate           early     link        immediate
          early     '           immediate           early     is          immediate
          early     send        immediate           early     send        immediate
          early     with        immediate           early     with        immediate
          early     endwith     immediate           early     endwith     immediate
            early     '           immediate
          early     postpone    immediate           early     postpone    immediate
            early     definitions
                     
 \ base object class implementation part                23mar95py  \ base object class implementation part                23mar95py
   
 how:    0 parento !  how:
         0 childo !  0 parento !
         0 nexto !  0 childo !
         : class   ( -- )       Create immediate o@ (class ;  0 nexto !
         : :       ( -- )       Create immediate o@      : class   ( -- )       Create immediate o@ (class ;
           decl @ IF  instvar,    ELSE  instance,  THEN ;      : :       ( -- )       Create immediate o@
         : ptr     ( -- )       Create immediate o@          decl @ IF  instvar,    ELSE  instance,  THEN ;
           decl @ IF  instptr,    ELSE  ptr,       THEN ;      : ptr     ( -- )       Create immediate o@
         : asptr   ( addr -- )          decl @ IF  instptr,    ELSE  ptr,       THEN ;
           decl @ 0= abort" only in declaration!"      : asptr   ( addr -- )
           Create immediate o@ , cell+ @ , instptr> ;          decl @ 0= abort" only in declaration!"
         : []      ( n -- )     Create immediate o@          Create immediate o@ , cell+ @ , instptr> ;
           decl @ IF  instarray,  ELSE  array,     THEN ;      : []      ( n -- )     Create immediate o@
         : new     ( -- o )     o@ state @          decl @ IF  instarray,  ELSE  array,     THEN ;
           IF  Fpostpone Literal Fpostpone new,  ELSE  new,  THEN ;      : new     ( -- o )     o@ state @
         : new[]   ( n -- o )   o@ state @          IF  Fpostpone Literal Fpostpone new,  ELSE  new,  THEN ;
           IF Fpostpone Literal Fpostpone new[], ELSE new[], THEN ;      : new[]   ( n -- o )   o@ state @
         : dispose ( -- )       ^ size @ dispose, ;          IF Fpostpone Literal Fpostpone new[], ELSE new[], THEN ;
         : bind    ( addr -- )  (bind ;      : dispose ( -- )       ^ size @ dispose, ;
         : bound   ( o1 o2 addr2  -- ) (bound ;      : bind    ( addr -- )  (bind ;
         : link    ( -- o addr ) (link ;      : bound   ( o1 o2 addr2  -- ) (bound ;
         : class?  ( class -- flag )  ^ parent? nip 0<> ;      : link    ( -- o addr ) (link ;
         : ::      ( -- )      : class?  ( class -- flag )  ^ parent? nip 0<> ;
           state @ IF  ^ true method,  ELSE  inherit  THEN ;      : ::      ( -- )
         : super   ( -- )       parento true method, ;          state @ IF  ^ true method,  ELSE  inherit  THEN ;
         : is      ( cfa -- )   (is ;      : super   ( -- )       parento true method, ;
         : self    ( -- obj )   ^ ;      : is      ( cfa -- )   (is ;
         : init    ( -- )       ;      : self    ( -- obj )   ^ ;
       : init    ( -- )       ;
         : '       ( -- xt )  bl word findo 0= abort" not found!"      
           state @ IF  Fpostpone Literal  THEN ;      : '       ( -- xt )  bl word findo 0= abort" not found!"
         : send    ( xt -- )  execute ;          state @ IF  Fpostpone Literal  THEN ;
         : postpone ( -- )  o@ add-order Fpostpone Fpostpone drop-order ;      : send    ( xt -- )  execute ;
       : postpone ( -- )  o@ add-order Fpostpone Fpostpone drop-order ;
       
       : with ( -- )
           state @ oset? 0= and IF  Fpostpone >o  THEN
           o@ add-order voc# ! false to oset? ;
       : endwith  Fpostpone o> voc# @ drop-order ;
   
         : with ( -- )      : definitions
           state @ oset? 0= and IF  Fpostpone >o  THEN          o@ add-order 1+ voc# ! also types o@ lastob !
           o@ add-order voc# ! false to oset? ;          false to oset?   get-current old-current !
         : endwith  Fpostpone o>           thread @ set-current ;
           voc# @ drop-order ;  
 class; \ object  class; \ object
   
 \ interface                                            01sep96py  \ interface                                            01sep96py

Removed from v.1.10  
changed lines
  Added in v.1.11


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