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

version 1.11, 1997/08/02 20:19:05 version 1.12, 1997/08/03 20:21:35
Line 173  define? faligned 0= [IF] Line 173  define? faligned 0= [IF]
   
 types definitions  types definitions
   
 : static   ( -- )  mallot Create , #static ,  : static   ( -- ) \ oof- oof
   DOES> @ o@ + ;      \G Create a class-wide cell sized variable
 : method   ( -- )  mallot Create , #method ,      mallot Create , #static ,
   DOES> @ o@ + @ execute ;  DOES> @ o@ + ;
 : early    ( -- )  Create ['] crash , #early ,  : method   ( -- ) \ oof- oof
   DOES> @ execute ;      \G Create a method selector
 : var ( size -- )  vallot Create , #var ,      mallot Create , #method ,
   DOES> @ ^ + ;  DOES> @ o@ + @ execute ;
 : defer    ( -- )  valign cell vallot Create , #defer ,  : early    ( -- ) \ oof- oof
   DOES> @ ^ + @ execute ;      \G Create a method selector for early binding
       Create ['] crash , #early ,
   DOES> @ execute ;
   : var ( size -- ) \ oof- oof
       \G Create an instance variable
       vallot Create , #var ,
   DOES> @ ^ + ;
   : defer    ( -- ) \ oof- oof
       \G Create an instance defer
       valign cell vallot Create , #defer ,
   DOES> @ ^ + @ execute ;
   
 \ dealing with threads                                 29oct94py  \ dealing with threads                                 29oct94py
   
Line 430  Variable last-interface  0 last-interfac Line 440  Variable last-interface  0 last-interfac
   
 types definitions  types definitions
   
 : how:  ( -- )  decl @ 0= abort" not twice!" 0 decl !  : how:  ( -- ) \ oof- oof how-to
   \G End declaration, start implementation
       decl @ 0= abort" not twice!" 0 decl !
     align  interface,      align  interface,
     lastob! thread, parent, var, 'link, 0 , cells, interfaces,      lastob! thread, parent, var, 'link, 0 , cells, interfaces,
     dup      dup
     IF    dup :method# + @ >r :init + swap r> :init /string move      IF    dup :method# + @ >r :init + swap r> :init /string move
     ELSE  2drop  THEN ;      ELSE  2drop  THEN ;
   
 : class; ( -- ) decl @ IF  how:  THEN  0 'link !  : class; ( -- ) \ oof- oof end-class
   voc# @ drop-order old-current @ set-current ;  \G End class declaration or implementation
       decl @ IF  how:  THEN  0 'link !
 : ptr ( -- ) Create immediate lastob @ here lastob ! instptr, ;      voc# @ drop-order old-current @ set-current ;
 : asptr ( addr -- )  cell+ @ Create immediate  
   lastob @ here lastob ! , ,  instptr> ;  : ptr ( -- ) \ oof- oof
       \G Create an instance pointer
       Create immediate lastob @ here lastob ! instptr, ;
   : asptr ( class -- ) \ oof- oof
       \G Create an alias to an instance pointer, casted to another class
       cell+ @ Create immediate
       lastob @ here lastob ! , ,  instptr> ;
   
 : Fpostpone  postpone postpone ; immediate  : Fpostpone  postpone postpone ; immediate
   
Line 474  Create object  immediate  0 (class \ do Line 492  Create object  immediate  0 (class \ do
          static    size         \ number of variables (bytes)           static    size         \ number of variables (bytes)
          static    newlink      \ ptr to allocated space           static    newlink      \ ptr to allocated space
          static    ilist        \ interface list           static    ilist        \ interface list
          method    init           method    init ( ... -- ) \ object- oof
          method    dispose           method    dispose ( -- ) \ object- oof
   
          early     class           early     class ( "name" -- ) \ object- oof
          early     new         immediate           early     new ( -- o ) \ object- oof
          early     new[]       immediate                                  immediate
          early     :           early     new[] ( n -- o ) \ object- oof new-array
          early     ptr                                  immediate
          early     asptr           early     : ( "name" -- ) \ object- oof define
          early     []           early     ptr ( "name" -- ) \ object- oof
          early     ::          immediate           early     asptr ( o "name" -- ) \ object- oof
          early     class?           early     [] ( n "name" -- ) \ object- oof array
          early     super       immediate           early     ::  ( "name" -- ) \ object- oof scope
          early     self                                  immediate
          early     bind        immediate           early     class? ( o -- flag ) \ object- oof class-query
          early     bound           early     super  ( "name" -- ) \ object- oof
          early     link        immediate                                  immediate
          early     is          immediate           early     self ( -- o ) \ object- oof
          early     send        immediate           early     bind ( o "name" -- ) \ object- oof
          early     with        immediate                                  immediate
          early     endwith     immediate           early     bound ( class addr "name" -- ) \ object- oof
          early     '           immediate           early     link ( "name" -- class addr ) \ object- oof
          early     postpone    immediate                                  immediate
          early     definitions           early     is  ( xt "name" -- ) \ object- oof
                                   immediate
            early     send ( xt -- ) \ object- oof
                                   immediate
            early     with ( o -- ) \ object- oof
                                   immediate
            early     endwith ( -- ) \ object- oof
                                   immediate
            early     ' ( "name" -- xt ) \ object- oof tick
                                   immediate
            early     postpone ( "name" -- ) \ object- oof
                                   immediate
            early     definitions ( -- ) \ object- oof
                     
 \ base object class implementation part                23mar95py  \ base object class implementation part                23mar95py
   

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


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