Annotation of gforth/oof.fs, revision 1.1

1.1     ! pazsan      1: \ oof.fs       Object Oriented FORTH
        !             2: \              This file is (c) 1996 by Bernd Paysan
        !             3: \                      e-mail: paysan@informatik.tu-muenchen.de
        !             4: \
        !             5: \              Please copy and share this program, modify it for your system
        !             6: \              and improve it as you like. But don't remove this notice.
        !             7: \
        !             8: \              Thank you.
        !             9: \
        !            10: 
        !            11: \ Loadscreen                                           27dec95py
        !            12: 
        !            13: decimal
        !            14: 
        !            15: : define?  ( -- flag )
        !            16:   bl word find  nip 0= ;
        !            17: 
        !            18: define? cell  [IF]  1 cells Constant cell  [THEN]
        !            19: 
        !            20: define? ?EXIT [IF]
        !            21: : ?EXIT  postpone IF  postpone EXIT postpone THEN ; immediate
        !            22: [THEN]
        !            23: 
        !            24: define? Vocabulary [IF]
        !            25: : Vocabulary wordlist create ,
        !            26: DOES> @ >r get-order nip r> swap set-order ;
        !            27: [THEN]
        !            28: 
        !            29: Vocabulary Objects  also Objects also definitions
        !            30: 
        !            31: Vocabulary types  types also
        !            32: 
        !            33: 0 cells Constant :wordlist
        !            34: 1 cells Constant :parent
        !            35: 2 cells Constant :child
        !            36: 3 cells Constant :next
        !            37: 4 cells Constant :method#
        !            38: 5 cells Constant :var#
        !            39: 6 cells Constant :newlink
        !            40: 7 cells Constant :iface
        !            41: 8 cells Constant :init
        !            42: 
        !            43: 0 cells Constant :inext
        !            44: 1 cells Constant :ilist
        !            45: 2 cells Constant :ilen
        !            46: 3 cells Constant :inum
        !            47: 
        !            48: Variable op
        !            49: : op! ( o -- )  op ! ;
        !            50: 
        !            51: Forth definitions
        !            52: 
        !            53: Create ostack 0 , 16 cells allot
        !            54: 
        !            55: : ^ ( -- o )  op @ ;
        !            56: : o@ ( -- o )  op @ @ ;
        !            57: : >o ( o -- )
        !            58:     state @
        !            59:     IF    postpone ^ postpone >r postpone op!
        !            60:     ELSE  1 ostack +! ^ ostack dup @ cells + ! op!
        !            61:     THEN  ; immediate
        !            62: : o> ( -- )
        !            63:     state @
        !            64:     IF    postpone r> postpone op!
        !            65:     ELSE  ostack dup @ cells + @ op! -1 ostack +!
        !            66:     THEN  ; immediate
        !            67: : o[] ( n -- ) o@ :var# + @ * ^ + op! ;
        !            68: 
        !            69: Objects definitions
        !            70: 
        !            71: \ Coding                                               27dec95py
        !            72: 
        !            73: 0 Constant #static
        !            74: 1 Constant #method
        !            75: 2 Constant #early
        !            76: 3 Constant #var
        !            77: 4 Constant #defer
        !            78: 
        !            79: : exec?    ( addr -- flag )
        !            80:   >body cell+ @ #method = ;
        !            81: : static?  ( addr -- flag )
        !            82:   >body cell+ @ #static = ;
        !            83: : early?   ( addr -- flag )
        !            84:   >body cell+ @ #early  = ;
        !            85: : defer?   ( addr -- flag )
        !            86:   >body cell+ @ #defer  = ;
        !            87: 
        !            88: define? faligned [IF] false [ELSE] 1 faligned 8 = [THEN]
        !            89: [IF]   : 8aligned ( n1 -- n2 )  faligned ;
        !            90: [ELSE] : 8aligned ( n1 -- n2 )  7 + -8 and ;
        !            91: [THEN]
        !            92: 
        !            93: : o+,   ( addr offset -- )
        !            94:   postpone Literal postpone ^ postpone +
        !            95:   postpone >o drop ;
        !            96: : o*,   ( addr offset -- )
        !            97:   postpone Literal postpone * postpone Literal postpone +
        !            98:   postpone >o ;
        !            99: : ^+@  ( offset -- addr )  ^ + @ ;
        !           100: : o+@,  ( addr offset -- )
        !           101:     postpone Literal postpone ^+@  postpone >o drop ;
        !           102: : ^*@  ( offset -- addr )  ^ + @ tuck @ :var# + @ 8aligned * + ;
        !           103: : o+@*, ( addr offset -- )
        !           104:   postpone Literal postpone ^*@  postpone >o drop ;
        !           105: 
        !           106: \ variables / memory allocation                        30oct94py
        !           107: 
        !           108: Variable lastob
        !           109: Variable lastparent   0 lastparent !
        !           110: Variable vars
        !           111: Variable methods
        !           112: Variable decl  0 decl !
        !           113: Variable 'link
        !           114: 
        !           115: : crash  true abort" unbound method" ;
        !           116: 
        !           117: : link, ( addr -- ) align here 'link !  , 0 , 0 , ;
        !           118: 
        !           119: 0 link,
        !           120: 
        !           121: \ type declaration                                     30oct94py
        !           122: 
        !           123: : vallot ( size -- offset )  vars @ >r  dup vars +!
        !           124:     'link @ 0=
        !           125:     IF  lastparent @ dup IF  :newlink + @  THEN  link,
        !           126:     THEN
        !           127:     'link @ 2 cells + +! r> ;
        !           128: 
        !           129: : valign  ( -- )  vars @ aligned vars ! ;
        !           130: define? faligned 0= [IF]
        !           131: : vfalign ( -- )  vars @ faligned vars ! ;
        !           132: [THEN]
        !           133: 
        !           134: : mallot ( -- offset )    methods @ cell methods +! ;
        !           135: 
        !           136: types definitions
        !           137: 
        !           138: : static   ( -- )  mallot Create , #static ,
        !           139:   DOES> @ o@ + ;
        !           140: : method   ( -- )  mallot Create , #method ,
        !           141:   DOES> @ o@ + @ execute ;
        !           142: : early    ( -- )  Create ['] crash , #early ,
        !           143:   DOES> @ execute ;
        !           144: : var ( size -- )  vallot Create , #var ,
        !           145:   DOES> @ ^ + ;
        !           146: : defer    ( -- )  valign cell vallot Create , #defer ,
        !           147:   DOES> @ ^ + @ execute ;
        !           148: 
        !           149: \ dealing with threads                                 29oct94py
        !           150: 
        !           151: Objects definitions
        !           152: 
        !           153: : object-order ( wid0 .. widm m addr -- wid0 .. widn n )
        !           154:     dup  IF  2@ >r recurse r> swap 1+  ELSE  drop  THEN ;
        !           155: 
        !           156: : interface-order ( wid0 .. widm m addr -- wid0 .. widn n )
        !           157:     dup  IF    2@ >r recurse r> :ilist + @ swap 1+
        !           158:          ELSE  drop  THEN ;
        !           159: 
        !           160: : add-order ( addr -- n )  >r
        !           161:     get-order r> swap >r 0 swap object-order
        !           162:     r> over >r + set-order r> ;
        !           163: 
        !           164: : drop-order ( n -- )  0 ?DO  previous  LOOP ;
        !           165: 
        !           166: \ object compiling/executing                           20feb95py
        !           167: 
        !           168: : o, ( xt early? -- )
        !           169:   over exec?   over and  IF 
        !           170:       drop >body @ o@ + @ compile,  EXIT  THEN
        !           171:   over static? over and  IF 
        !           172:       drop >body @ o@ + @ postpone Literal  EXIT THEN
        !           173:   drop dup early?  IF >body @  THEN  compile, ;
        !           174: 
        !           175: : findo    ( string -- cfa n )
        !           176:     >r get-order 0
        !           177:     o@ object-order
        !           178:     o@ :iface + @ interface-order set-order
        !           179:     r> find
        !           180:     ?dup 0= IF drop set-order true abort" method not found!" THEN
        !           181:     >r >r set-order r> r> ;
        !           182: 
        !           183: false Value method?
        !           184: : method,  ( object early? -- )  true to method?
        !           185:     swap >o >r bl word  findo  0< state @ and
        !           186:     IF  r> o,  ELSE  r> drop execute  THEN  o> false to method?  ;
        !           187: 
        !           188: : early, ( object -- )  true  method,
        !           189:   state @ IF  postpone o>  THEN  ;
        !           190: : late,  ( object -- )  false method,
        !           191:   state @ IF  postpone o>  THEN  ;
        !           192: 
        !           193: \ new,                                                 29oct94py
        !           194: 
        !           195: previous Objects definitions
        !           196: 
        !           197: Variable alloc
        !           198: 0 Value ohere
        !           199: 
        !           200: : oallot ( n -- )  ohere + to ohere ;
        !           201: 
        !           202: : ((new, ( link -- )
        !           203:   dup @ ?dup IF  recurse  THEN   cell+ 2@ swap ohere + >r
        !           204:   ?dup IF  ohere >r dup >r :newlink + @ recurse r> r> !  THEN
        !           205:   r> to ohere ;
        !           206: 
        !           207: : (new  ( object -- )
        !           208:   ohere >r dup >r :newlink + @ ((new, r> r> ! ;
        !           209: 
        !           210: : init-instance ( pos link -- pos )
        !           211:     dup >r @ ?dup IF  recurse  THEN  r> cell+ 2@
        !           212:     IF  drop dup >r ^ +
        !           213:         >o o@ :init + @ execute  0 o@ :newlink + @ recurse o>
        !           214:         r> THEN + ;
        !           215: 
        !           216: : init-object ( object -- size )
        !           217:     >o o@ :init + @ execute  0 o@ :newlink + @ init-instance o> ;
        !           218: 
        !           219: : (new, ( object -- ) ohere dup >r over :var# + @ erase (new
        !           220:     r> init-object drop ;
        !           221: 
        !           222: : size@  ( objc -- size )  :var# + @ 8aligned ;
        !           223: : (new[],   ( n o -- addr ) ohere >r
        !           224:     dup size@ rot over * oallot r@ ohere dup >r 2 pick -
        !           225:     ?DO  I to ohere >r dup >r (new, r> r> dup negate +LOOP
        !           226:     2drop r> to ohere r> ;
        !           227: 
        !           228: \ new,                                                 29oct94py
        !           229: 
        !           230: Create chunks here 16 cells dup allot erase
        !           231: 
        !           232: : DelFix ( addr root -- ) dup @ 2 pick ! ! ;
        !           233: 
        !           234: : NewFix  ( root size # -- addr )
        !           235:   BEGIN  2 pick @ ?dup 0=
        !           236:   WHILE  2dup * allocate throw over 0
        !           237:          ?DO    dup 4 pick DelFix 2 pick +
        !           238:          LOOP
        !           239:          drop
        !           240:   REPEAT
        !           241:   >r drop r@ @ rot ! r@ swap erase r> ;
        !           242: 
        !           243: : >chunk ( n -- root n' )
        !           244:   8aligned dup 3 rshift cells chunks + swap ;
        !           245: 
        !           246: : Dalloc ( size -- addr )
        !           247:   dup 128 > IF  allocate throw EXIT  THEN
        !           248:   >chunk 2048 over / NewFix ;
        !           249: 
        !           250: : Salloc ( size -- addr ) align here swap allot ;
        !           251: 
        !           252: : dispose, ( addr size -- )
        !           253:     dup 128 > IF drop free throw EXIT THEN
        !           254:     >chunk drop DelFix ;
        !           255: 
        !           256: : new, ( o -- addr )  dup :var# + @
        !           257:   alloc @ execute dup >r to ohere (new, r> ;
        !           258: 
        !           259: : new[], ( n o -- addr )  dup :var# + @ 8aligned
        !           260:   2 pick * alloc @ execute to ohere (new[], ;
        !           261: 
        !           262: Forth definitions
        !           263: 
        !           264: : dynamic ['] Dalloc alloc ! ;  dynamic
        !           265: : static  ['] Salloc alloc ! ;
        !           266: 
        !           267: Objects definitions
        !           268: 
        !           269: \ instance creation                                    29mar94py
        !           270: 
        !           271: : instance, ( o -- )  alloc @ >r static new, r> alloc ! drop
        !           272:   DOES> state @ IF  dup postpone Literal postpone >o  THEN early, ;
        !           273: : ptr,      ( o -- )  0 , ,
        !           274:   DOES>  state @
        !           275:     IF    postpone Literal postpone @ postpone >o cell+
        !           276:     ELSE  @  THEN late, ;
        !           277: 
        !           278: : array,  ( n o -- )  alloc @ >r static new[], r> alloc ! drop
        !           279:     DOES> ( n -- ) dup dup @ size@
        !           280:           state @ IF  o*,  ELSE  nip rot * +  THEN  early, ;
        !           281: 
        !           282: \ class creation                                       29mar94py
        !           283: 
        !           284: Variable voc#
        !           285: Variable classlist
        !           286: Variable old-current
        !           287: Variable ob-interface
        !           288: 
        !           289: : voc! ( addr -- )  get-current old-current !
        !           290:   add-order  2 + voc# !
        !           291:   get-order wordlist tuck classlist ! 1+ set-order
        !           292:   also types classlist @ set-current ;
        !           293: 
        !           294: : (class ( parent -- )
        !           295:     here lastob !  true decl !  0 ob-interface !
        !           296:     0 ,  dup voc!  dup lastparent !
        !           297:     dup 0= IF  0  ELSE  :method# + 2@  THEN  methods ! vars !
        !           298:     DOES>  false method, ;
        !           299: 
        !           300: : (is ( addr -- )  bl word findo drop
        !           301:     dup defer? abort" not deferred!"
        !           302:     >body @ state @
        !           303:     IF    postpone ^ postpone Literal postpone + postpone !
        !           304:     ELSE  ^ + !  THEN ;
        !           305: 
        !           306: : inherit   ( -- )  bl word findo drop
        !           307:     dup exec?  IF  >body @ dup o@ + @ swap lastob @ + !  EXIT  THEN
        !           308:     abort" Not a polymorph method!" ;
        !           309: 
        !           310: \ instance variables inside objects                    27dec93py
        !           311: 
        !           312: : instvar,    ( addr -- ) dup , here 0 , 0 vallot swap !
        !           313:     'link @ 2 cells + @  IF  'link @ link,  THEN
        !           314:     'link @ >r dup r@ cell+ ! :var# + @ dup vars +! r> 2 cells + !
        !           315:     DOES>  dup 2@ swap state @ IF  o+,  ELSE  ^ + nip nip  THEN
        !           316:            early, ;
        !           317: 
        !           318: : instptr>  ( -- )  DOES>  dup 2@ swap
        !           319:     state @ IF  o+@,  ELSE  ^ + @ nip nip  THEN  late, ;
        !           320: 
        !           321: : instptr,    ( addr -- )  , here 0 , cell vallot swap !
        !           322:     instptr> ;
        !           323: 
        !           324: : (o* ( i addr -- addr' ) dup @ :var# + @ 8aligned rot * + ;
        !           325: 
        !           326: : instarray,  ( addr -- )  , here 0 , cell vallot swap !
        !           327:     DOES>  dup 2@ swap
        !           328:            state @  IF  o+@*,  ELSE  ^ + @ nip nip (o*  THEN
        !           329:            late, ;
        !           330: 
        !           331: \ bind instance pointers                               27mar94py
        !           332: 
        !           333: : ((link ( addr -- o addr' ) 2@ swap ^ + ;
        !           334: 
        !           335: : (link  ( -- o addr )  bl word findo drop >body state @
        !           336:     IF postpone Literal postpone ((link EXIT THEN ((link ;
        !           337: 
        !           338: : parent? ( class o -- class class' ) @
        !           339:   BEGIN  2dup = ?EXIT dup  WHILE  :parent + @  REPEAT ;
        !           340: 
        !           341: : (bound ( obj1 obj2 adr2 -- ) >r over parent?
        !           342:     nip 0= abort" not the same class !" r> ! ;
        !           343: 
        !           344: : (bind ( addr -- ) \ <name>
        !           345:     (link state @ IF postpone (bound EXIT THEN (bound ;
        !           346: 
        !           347: : (sbound ( o addr -- ) dup cell+ @ swap (bound ;
        !           348: 
        !           349: Forth definitions
        !           350: 
        !           351: : bind ( o -- )  '  state @
        !           352:   IF   postpone Literal postpone >body postpone (sbound EXIT  THEN
        !           353:   >body (sbound ;  immediate
        !           354: 
        !           355: Objects definitions
        !           356: 
        !           357: \ method implementation                                29oct94py
        !           358: 
        !           359: Variable m-name
        !           360: Variable last-interface  0 last-interface !
        !           361: 
        !           362: : interface, ( -- )  last-interface @
        !           363:     BEGIN  dup  WHILE  dup , @  REPEAT drop ;
        !           364: 
        !           365: : inter, ( iface -- )
        !           366:     align here over :inum + @ lastob @ + !
        !           367:     here over :ilen + @ dup allot move ;
        !           368: 
        !           369: : interfaces, ( -- ) ob-interface @ lastob @ :iface + !
        !           370:     ob-interface @
        !           371:     BEGIN  dup  WHILE  2@ inter,  REPEAT  drop ;
        !           372: 
        !           373: : lastob!  ( -- )  lastob @ dup
        !           374:     BEGIN  nip dup @ here cell+ 2 pick ! dup 0= UNTIL  drop
        !           375:     dup , op! o@ lastob ! ;
        !           376: 
        !           377: : thread,  ( -- )  classlist @ , ;
        !           378: : var,     ( -- )  methods @ , vars @ , ;
        !           379: : parent,  ( -- o parent )
        !           380:     o@ lastparent @ 2dup dup , 0 ,
        !           381:     dup IF  :child + dup @ , !   ELSE  , drop  THEN ;
        !           382: : 'link,  ( -- )
        !           383:     'link @ ?dup 0=
        !           384:     IF  lastparent @ dup  IF  :newlink + @  THEN  THEN , ;
        !           385: : cells,  ( -- )
        !           386:   methods @ :init ?DO  ['] crash , cell +LOOP ;
        !           387: 
        !           388: \ method implementation                                20feb95py
        !           389: 
        !           390: types definitions
        !           391: 
        !           392: : how:  ( -- )  decl @ 0= abort" not twice!" 0 decl !
        !           393:     align  interface,
        !           394:     lastob! thread, parent, var, 'link, 0 , cells, interfaces,
        !           395:     dup
        !           396:     IF    dup :method# + @ >r :init + swap r> :init /string move
        !           397:     ELSE  2drop  THEN ;
        !           398: 
        !           399: : class; ( -- ) decl @ IF  how:  THEN  0 'link !
        !           400:   voc# @ drop-order old-current @ set-current ;
        !           401: 
        !           402: : ptr ( -- ) Create immediate lastob @ here lastob ! instptr, ;
        !           403: : asptr ( addr -- )  cell+ @ Create immediate
        !           404:   lastob @ here lastob ! , ,  instptr> ;
        !           405: 
        !           406: : : ( <methodname> -- )  decl @ abort" HOW: missing! "
        !           407:     bl word findo 0= abort" not found"
        !           408:     dup exec? over early? or over >body cell+ @ 0< or
        !           409:     0= abort" not a method"
        !           410:     m-name ! :noname ;
        !           411: 
        !           412: Forth
        !           413: 
        !           414: : ; ( xt colon-sys -- )  postpone ;
        !           415:     m-name @ dup >body swap exec?
        !           416:     IF    @ o@ +
        !           417:     ELSE  dup cell+ @ 0< IF  2@ swap o@ + @ +  THEN
        !           418:     THEN ! ; immediate
        !           419: 
        !           420: Forth definitions
        !           421: 
        !           422: \ object                                               23mar95py
        !           423: 
        !           424: Create object  immediate  0 (class \ do not create as subclass
        !           425:          cell var  oblink       \ create offset for backlink
        !           426:          static    thread       \ method/variable wordlist
        !           427:          static    parento      \ pointer to parent
        !           428:          static    childo       \ ptr to first child
        !           429:          static    nexto        \ ptr to next child of parent
        !           430:          static    method#      \ number of methods (bytes)
        !           431:          static    size         \ number of variables (bytes)
        !           432:         static    newlink      \ ptr to allocated space
        !           433:         static    ilist        \ interface list
        !           434:          method    init
        !           435:          method    dispose
        !           436: 
        !           437:          early     class
        !           438:          early     new         immediate
        !           439:          early     new[]       immediate
        !           440:          early     :
        !           441:          early     ptr
        !           442:          early     asptr
        !           443:          early     []
        !           444:          early     ::          immediate
        !           445:          early     class?
        !           446:          early     super       immediate
        !           447:          early     self
        !           448:          early     bind        immediate
        !           449:          early     is          immediate
        !           450:          early     bound
        !           451:          early     link        immediate
        !           452:         early     '           immediate
        !           453:         early     send        immediate
        !           454:         
        !           455: \ base object class implementation part                23mar95py
        !           456: 
        !           457: how:     0 parento !
        !           458:          0 childo !
        !           459:         0 nexto !
        !           460:          : class   ( -- )       Create immediate o@ (class ;
        !           461:          : :       ( -- )       Create immediate o@
        !           462:             decl @ IF  instvar,    ELSE  instance,  THEN ;
        !           463:          : ptr     ( -- )       Create immediate o@
        !           464:            decl @ IF  instptr,    ELSE  ptr,       THEN ;
        !           465:          : asptr   ( addr -- )
        !           466:            decl @ 0= abort" only in declaration!"
        !           467:            Create immediate o@ , cell+ @ , instptr> ;
        !           468:          : []      ( n -- )     Create immediate o@
        !           469:            decl @ IF  instarray,  ELSE  array,     THEN ;
        !           470:          : new     ( -- o )     o@ state @
        !           471:            IF  postpone Literal postpone new,  ELSE  new,  THEN ;
        !           472:          : new[]   ( n -- o )   o@ state @
        !           473:            IF postpone Literal postpone new[], ELSE new[], THEN ;
        !           474:          : dispose ( -- )       ^ size @ dispose, ;
        !           475:          : bind    ( addr -- )  (bind ;
        !           476:          : bound   ( o1 o2 addr2  -- ) (bound ;
        !           477:          : link    ( -- o addr ) (link ;
        !           478:          : class?  ( class -- flag )  ^ parent? nip 0<> ;
        !           479:          : ::      ( -- )
        !           480:            state @ IF  ^ true method,  ELSE  inherit  THEN ;
        !           481:          : super   ( -- )       parento true method, ;
        !           482:          : is      ( cfa -- )   (is ;
        !           483:          : self    ( -- obj )   ^ ;
        !           484:          : init    ( -- )       ;
        !           485: 
        !           486:          : '       ( -- xt )  bl word findo 0= abort" not found!"
        !           487:            state @ IF  postpone Literal  THEN ;
        !           488:         : send    ( xt -- )  execute ;
        !           489: class; \ object
        !           490: 
        !           491: \ interface                                            01sep96py
        !           492: 
        !           493: Objects definitions
        !           494: 
        !           495: : implement ( interface -- )
        !           496:     align here over , ob-interface @ , ob-interface !
        !           497:     :ilist + @ >r get-order r> swap 1+ set-order ;
        !           498: 
        !           499: : inter-method, ( interface -- )
        !           500:     :ilist + @ bl word count 2dup s" '" compare
        !           501:     0= dup >r IF  2drop bl word count  THEN
        !           502:     rot search-wordlist
        !           503:     dup 0= abort" Not an interface method!"
        !           504:     r> IF  drop state @ IF  postpone Literal  THEN  EXIT  THEN
        !           505:     0< state @ and  IF  compile,  ELSE  execute  THEN ;
        !           506: 
        !           507: Variable inter-list
        !           508: Variable lastif
        !           509: Variable inter#
        !           510: 
        !           511: Vocabulary interfaces  interfaces definitions
        !           512: 
        !           513: : method  ( -- )  mallot Create , inter# @ ,
        !           514:   DOES> 2@ swap o@ + @ + @ execute ;
        !           515: 
        !           516: : how: ( -- )  align
        !           517:     here lastif @ !  0 decl !
        !           518:     last-interface @ ,  inter-list @ ,  methods @ ,  inter# @ ,
        !           519:     methods @ :inum cell+ ?DO  ['] crash ,  LOOP ;
        !           520: 
        !           521: : interface; ( -- )  old-current @ set-current
        !           522:     previous previous ;
        !           523: 
        !           524: : : ( <methodname> -- ) decl @ abort" HOW: missing! "
        !           525:     bl word count lastif @ @ :ilist + @
        !           526:     search-wordlist 0= abort" not found"
        !           527:     dup >body cell+ @ 0< 0= abort" not a method"
        !           528:     m-name ! :noname ;
        !           529: 
        !           530: Forth
        !           531: 
        !           532: : ; ( xt colon-sys -- )  postpone ;
        !           533:   m-name @ >body @ lastif @ @ + ! ; immediate
        !           534: 
        !           535: Forth definitions
        !           536: 
        !           537: : interface ( -- )
        !           538:     Create  here lastif !  0 ,  get-current old-current !
        !           539:     last-interface @ dup  IF  :inum @  THEN  1 cells - inter# !
        !           540:     get-order wordlist
        !           541:     dup inter-list ! dup set-current swap 1+ set-order
        !           542:     true decl !
        !           543:     0 vars ! :inum cell+ methods !  also interfaces
        !           544:     DOES>  @ decl @  IF  implement  ELSE  inter-method,  THEN ;
        !           545: 
        !           546: previous previous

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