Annotation of gforth/objects.fs, revision 1.14

1.1       anton       1: \ yet another Forth objects extension
                      2: 
1.14    ! anton       3: \ written by Anton Ertl 1996-1999
1.4       anton       4: \ public domain; NO WARRANTY
1.1       anton       5: 
1.2       anton       6: \ This (in combination with compat/struct.fs) is in ANS Forth (with an
                      7: \ environmental dependence on case insensitivity; convert everything
                      8: \ to upper case for state sensitive systems).
1.1       anton       9: 
1.2       anton      10: \ compat/struct.fs and this file together use the following words:
                     11: 
                     12: \ from CORE :
1.4       anton      13: \ : 1- + swap invert and ; DOES> @ immediate drop Create rot dup , >r
                     14: \ r> IF ELSE THEN over chars aligned cells 2* here - allot execute
                     15: \ POSTPONE ?dup 2dup move Variable 2@ 2! ! ['] >body = 2drop ' r@ +!
                     16: \ Constant recurse 1+ BEGIN 0= UNTIL negate Literal ." .
1.2       anton      17: \ from CORE-EXT :
1.4       anton      18: \ tuck pick nip true <> 0> erase Value :noname compile, 
1.2       anton      19: \ from BLOCK-EXT :
                     20: \ \ 
                     21: \ from DOUBLE :
1.3       anton      22: \ 2Constant 
1.2       anton      23: \ from EXCEPTION :
                     24: \ throw catch 
                     25: \ from EXCEPTION-EXT :
                     26: \ abort" 
                     27: \ from FILE :
                     28: \ ( 
                     29: \ from FLOAT :
1.4       anton      30: \ faligned floats 
1.2       anton      31: \ from FLOAT-EXT :
1.4       anton      32: \ dfaligned dfloats sfaligned sfloats 
1.3       anton      33: \ from LOCAL :
                     34: \ TO 
1.2       anton      35: \ from MEMORY :
1.3       anton      36: \ allocate resize free 
                     37: \ from SEARCH :
                     38: \ get-order set-order wordlist get-current set-current 
1.2       anton      39: 
1.1       anton      40: \ needs struct.fs
                     41: 
                     42: \ helper words
                     43: 
1.6       anton      44: s" gforth" environment? [if]
                     45:     2drop
                     46: [else]
                     47: 
1.1       anton      48: : -rot ( a b c -- c a b )
                     49:     rot rot ;
                     50: 
                     51: : perform ( ... addr -- ... )
                     52:     @ execute ;
                     53: 
1.3       anton      54: : ?dup-if ( compilation: -- orig ; run-time: n -- n|  )
                     55:     POSTPONE ?dup POSTPONE if ; immediate
                     56: 
1.1       anton      57: : save-mem     ( addr1 u -- addr2 u ) \ gforth
                     58:     \ copy a memory block into a newly allocated region in the heap
                     59:     swap >r
                     60:     dup allocate throw
                     61:     swap 2dup r> -rot move ;
                     62: 
1.3       anton      63: : resize ( a-addr1 u -- a-addr2 ior ) \ gforth
                     64:     over
                     65:     if
                     66:        resize
                     67:     else
                     68:        nip allocate
                     69:     then ;
                     70: 
1.1       anton      71: : extend-mem   ( addr1 u1 u -- addr addr2 u2 )
                     72:     \ extend memory block allocated from the heap by u aus
1.4       anton      73:     \ the (possibly reallocated) piece is addr2 u2, the extension is at addr
1.1       anton      74:     over >r + dup >r resize throw
                     75:     r> over r> + -rot ;
                     76: 
1.6       anton      77: : \g ( -- )
                     78:     postpone \ ; immediate
                     79: [then]
                     80: 
1.3       anton      81: \ data structures
1.1       anton      82: 
                     83: struct
1.4       anton      84:     cell% field object-map
                     85: end-struct object%
1.1       anton      86: 
                     87: struct
1.4       anton      88:     cell% 2* field interface-map
                     89:     cell%    field interface-map-offset \ aus
1.3       anton      90:       \ difference between where interface-map points and where
                     91:       \ object-map points (0 for non-classes)
1.4       anton      92:     cell%    field interface-offset \ aus
1.3       anton      93:       \ offset of interface map-pointer in class-map (0 for classes)
1.4       anton      94: end-struct interface%
1.3       anton      95: 
1.4       anton      96: interface%
                     97:     cell%    field class-parent
1.5       anton      98:     cell%    field class-wordlist \ inst-vars and other protected words
1.10      anton      99:     cell% 2* field class-inst-size ( class -- addr ) \ objects- objects
1.12      crook     100:     \g Give the size specification for an instance (i.e. an object)
                    101:     \g of @var{class};
                    102:     \g used as @code{class-inst-size 2@ ( class -- align size )}.
1.4       anton     103: end-struct class%
1.1       anton     104: 
1.3       anton     105: struct
1.4       anton     106:     cell% field selector-offset \ the offset within the (interface) map
                    107:     cell% field selector-interface \ the interface offset
                    108: end-struct selector%
1.3       anton     109: 
                    110: \ maps are not defined explicitly; they have the following structure:
                    111: 
                    112: \ pointers to interface maps (for classes) <- interface-map points here
1.4       anton     113: \ interface%/class% pointer                <- (object-)map  points here
1.3       anton     114: \ xts of methods 
                    115: 
1.1       anton     116: 
1.3       anton     117: \ code
1.1       anton     118: 
1.3       anton     119: \ selectors and methods
                    120: 
1.10      anton     121: variable current-interface ( -- addr ) \ objects- objects
1.12      crook     122: \g Variable: contains the class or interface currently being
1.6       anton     123: \g defined.
                    124: 
                    125: 
1.1       anton     126: 
                    127: : no-method ( -- )
1.3       anton     128:     true abort" no method defined for this object/selector combination" ;
                    129: 
                    130: : do-class-method ( -- )
                    131: does> ( ... object -- ... )
1.5       anton     132:     ( object selector-body )
1.3       anton     133:     selector-offset @ over object-map @ + ( object xtp ) perform ;
                    134: 
                    135: : do-interface-method ( -- )
                    136: does> ( ... object -- ... )
                    137:     ( object selector-body )
                    138:     2dup selector-interface @ ( object selector-body object interface-offset )
                    139:     swap object-map @ + @ ( object selector-body map )
                    140:     swap selector-offset @ + perform ;
1.1       anton     141: 
1.10      anton     142: : method ( xt "name" -- ) \ objects- objects
1.6       anton     143:     \g @code{name} execution: @code{... object -- ...}@*
1.12      crook     144:     \g Create selector @var{name} and makes @var{xt} its method in
1.6       anton     145:     \g the current class.
1.3       anton     146:     create
                    147:     current-interface @ interface-map 2@ ( xt map-addr map-size )
                    148:     dup current-interface @ interface-map-offset @ - ,
                    149:     1 cells extend-mem current-interface @ interface-map 2! ! ( )
                    150:     current-interface @ interface-offset @ dup ,
                    151:     ( 0<> ) if
                    152:        do-interface-method
                    153:     else
                    154:        do-class-method
                    155:     then ;
1.1       anton     156: 
1.10      anton     157: : selector ( "name" -- ) \ objects- objects
1.12      crook     158:     \g @var{name} execution: @code{... object -- ...}@*
                    159:     \g Create selector @var{name} for the current class and its
1.6       anton     160:     \g descendents; you can set a method for the selector in the
                    161:     \g current class with @code{overrides}.
1.1       anton     162:     ['] no-method method ;
                    163: 
1.3       anton     164: : interface-override! ( xt sel-xt interface-map -- )
                    165:     \ xt is the new method for the selector sel-xt in interface-map
                    166:     swap >body ( xt map selector-body )
                    167:     selector-offset @ + ! ;
                    168: 
1.10      anton     169: : class->map ( class -- map ) \ objects- objects
1.12      crook     170:     \g @var{map} is the pointer to @var{class}'s method map; it
1.6       anton     171:     \g points to the place in the map to which the selector offsets
1.12      crook     172:     \g refer (i.e., where @var{object-map}s point to).
1.3       anton     173:     dup interface-map 2@ drop swap interface-map-offset @ + ;
                    174: 
                    175: : unique-interface-map ( class-map offset -- )
                    176:     \ if the interface at offset in class map is the same as its parent,
                    177:     \ copy it to make it unique; used for implementing a copy-on-write policy
                    178:     over @ class-parent @ class->map ( class-map offset parent-map )
                    179:     over + @ >r  \ the map for the interface for the parent
1.9       anton     180:     + dup @ ( interface-mapp interface-map )
1.3       anton     181:     dup r> =
                    182:     if
1.9       anton     183:        dup @ interface-map 2@ nip save-mem drop        
1.3       anton     184:        swap !
                    185:     else
                    186:        2drop
                    187:     then ;
                    188: 
1.10      anton     189: : class-override! ( xt sel-xt class-map -- ) \ objects- objects
1.12      crook     190:     \g @var{xt} is the new method for the selector @var{sel-xt} in
                    191:     \g @var{class-map}.
1.3       anton     192:     over >body ( xt sel-xt class-map selector-body )
                    193:     selector-interface @ ( xt sel-xt class-map offset )
                    194:     ?dup-if \ the selector is for an interface
                    195:        2dup unique-interface-map
                    196:        + @
                    197:     then
                    198:     interface-override! ;
1.1       anton     199: 
1.10      anton     200: : overrides ( xt "selector" -- ) \ objects- objects
1.12      crook     201:     \g replace default method for @var{selector} in the current class
                    202:     \g with @var{xt}. @code{overrides} must not be used during an
1.6       anton     203:     \g interface definition.
1.3       anton     204:     ' current-interface @ class->map class-override! ;
                    205: 
                    206: \ interfaces
                    207: 
                    208: \ every interface gets a different offset; the latest one is stored here
                    209: variable last-interface-offset 0 last-interface-offset !
                    210: 
1.10      anton     211: : interface ( -- ) \ objects- objects
1.12      crook     212:     \g Start an interface definition.
1.4       anton     213:     interface% %allot >r
1.8       anton     214:     r@ current-interface !
                    215:     current-interface 1 cells save-mem r@ interface-map 2!
1.3       anton     216:     -1 cells last-interface-offset +!
                    217:     last-interface-offset @ r@ interface-offset !
1.8       anton     218:     0 r> interface-map-offset ! ;
1.3       anton     219: 
1.10      anton     220: : end-interface-noname ( -- interface ) \ objects- objects
1.12      crook     221:     \g End an interface definition. The resulting interface is
                    222:     \g @var{interface}.
1.3       anton     223:     current-interface @ ;
                    224: 
1.10      anton     225: : end-interface ( "name" -- ) \ objects- objects
1.6       anton     226:     \g @code{name} execution: @code{-- interface}@*
1.12      crook     227:     \g End an interface definition. The resulting interface is
                    228:     \g @var{interface}.
1.3       anton     229:     end-interface-noname constant ;
                    230: 
1.13      anton     231: \ visibility control
                    232: 
                    233: variable public-wordlist
                    234: 
                    235: : protected ( -- ) \ objects- objects
                    236:     \g Set the compilation wordlist to the current class's wordlist
                    237:     current-interface @ class-wordlist @
                    238:     dup get-current <>
                    239:     if \ we are not protected already
                    240:        get-current public-wordlist !
                    241:     then
                    242:     set-current ;
                    243: 
                    244: : public ( -- ) \ objects- objects
                    245:     \g Restore the compilation wordlist that was in effect before the
                    246:     \g last @code{protected} that actually changed the compilation
                    247:     \g wordlist.
                    248:     current-interface @ class-wordlist @ get-current =
                    249:     if \ we are protected
                    250:        public-wordlist @ set-current
                    251:     then ;
                    252: 
1.3       anton     253: \ classes
                    254: 
                    255: : add-class-order ( n1 class -- wid1 ... widn n+n1 )
                    256:     dup >r class-parent @
                    257:     ?dup-if
                    258:        recurse \ first add the search order for the parent class
                    259:     then
                    260:     r> class-wordlist @ swap 1+ ;
                    261: 
1.10      anton     262: : push-order ( class -- ) \ objects- objects
1.12      crook     263:     \g Add @var{class}'s wordlists to the head of the search-order.
1.3       anton     264:     >r get-order r> add-class-order set-order ;
                    265: 
1.14    ! anton     266: : methods ( class -- )
        !           267:     \g Makes @var{class} the current class. This is intended to be
        !           268:     \g used for defining methods to override selectors; you cannot
        !           269:     \g define new fields or selectors.
        !           270:     dup current-interface ! push-order ;
        !           271: 
1.10      anton     272: : class ( parent-class -- align offset ) \ objects- objects
1.12      crook     273:     \g Start a new class definition as a child of
                    274:     \g @var{parent-class}. @var{align offset} are for use by
                    275:     \g @var{field} etc.
1.4       anton     276:     class% %allot >r
1.3       anton     277:     dup interface-map 2@ save-mem r@ interface-map 2!
                    278:     dup interface-map-offset @ r@ interface-map-offset !
                    279:     r@ dup class->map !
                    280:     0 r@ interface-offset !
                    281:     dup r@ class-parent !
                    282:     wordlist r@ class-wordlist !
1.14    ! anton     283:     r> methods
1.3       anton     284:     class-inst-size 2@ ;
                    285: 
                    286: : remove-class-order ( wid1 ... widn n+n1 class -- n1 )
                    287:     \ note: no checks, whether the wordlists are correct
                    288:     begin
                    289:        >r nip 1-
                    290:        r> class-parent @ dup 0=
                    291:     until
                    292:     drop ;
                    293: 
1.10      anton     294: : drop-order ( class -- ) \ objects- objects
1.12      crook     295:     \g Drop @var{class}'s wordlists from the search order. No
                    296:     \g checking is made whether @var{class}'s wordlists are actually
1.6       anton     297:     \g on the search order.
1.3       anton     298:     >r get-order r> remove-class-order set-order ;
                    299: 
1.14    ! anton     300: : end-methods ( -- )
        !           301:     \g Switch back from defining methods of a class to normal mode
        !           302:     \g (currently this just restores the old search order).
        !           303:     current-interface @ drop-order ;
        !           304: 
1.10      anton     305: : end-class-noname ( align offset -- class ) \ objects- objects
1.12      crook     306:     \g End a class definition. The resulting class is @var{class}.
1.14    ! anton     307:     public end-methods
        !           308:     current-interface @ class-inst-size 2!
1.3       anton     309:     end-interface-noname ;
                    310: 
1.10      anton     311: : end-class ( align offset "name" -- ) \ objects- objects
1.12      crook     312:     \g @var{name} execution: @code{-- class}@*
                    313:     \g End a class definition. The resulting class is @var{class}.
1.3       anton     314:     \ name execution: ( -- class )
                    315:     end-class-noname constant ;
                    316: 
                    317: \ classes that implement interfaces
                    318: 
                    319: : front-extend-mem ( addr1 u1 u -- addr addr2 u2 )
1.12      crook     320:     \ Extend memory block allocated from the heap by u aus, with the
1.3       anton     321:     \ old stuff coming at the end
                    322:     2dup + dup >r allocate throw ( addr1 u1 u addr2 ; R: u2 )
                    323:     dup >r + >r over r> rot move ( addr1 ; R: u2 addr2 )
                    324:     free throw
                    325:     r> dup r> ;
                    326:     
1.10      anton     327: : implementation ( interface -- ) \ objects- objects
1.12      crook     328:     \g The current class implements @var{interface}. I.e., you can
1.6       anton     329:     \g use all selectors of the interface in the current class and its
                    330:     \g descendents.
1.3       anton     331:     dup interface-offset @ ( interface offset )
                    332:     current-interface @ interface-map-offset @ negate over - dup 0>
                    333:     if \ the interface does not fit in the present class-map
                    334:        >r current-interface @ interface-map 2@
                    335:        r@ front-extend-mem
                    336:        current-interface @ interface-map 2!
                    337:        r@ erase
                    338:        dup negate current-interface @ interface-map-offset !
                    339:        r>
                    340:     then ( interface offset n )
                    341:     drop >r
                    342:     interface-map 2@ save-mem drop ( map )
                    343:     current-interface @ dup interface-map 2@ drop
                    344:     swap interface-map-offset @ + r> + ! ;
1.1       anton     345: 
                    346: \ this/self, instance variables etc.
                    347: 
1.3       anton     348: \ rename "this" into "self" if you are a Smalltalk fiend
1.10      anton     349: 0 value this ( -- object ) \ objects- objects
1.6       anton     350: \g the receiving object of the current method (aka active object).
1.10      anton     351: : to-this ( object -- ) \ objects- objects
1.12      crook     352:     \g Set @code{this} (used internally, but useful when debugging).
1.3       anton     353:     TO this ;
                    354: 
                    355: \ another implementation, if you don't have (fast) values
                    356: \ variable thisp
                    357: \ : this ( -- object )
                    358: \     thisp @ ;
                    359: \ : to-this ( object -- )
                    360: \     thisp ! ;
1.1       anton     361: 
1.10      anton     362: : m: ( -- xt colon-sys; run-time: object -- ) \ objects- objects
1.12      crook     363:     \g Start a method definition; @var{object} becomes new @code{this}.
1.1       anton     364:     :noname 
                    365:     POSTPONE this
                    366:     POSTPONE >r
1.3       anton     367:     POSTPONE to-this ;
1.1       anton     368: 
1.10      anton     369: : exitm ( -- ) \ objects- objects
1.6       anton     370:     \g @code{exit} from a method; restore old @code{this}.
1.5       anton     371:     POSTPONE r>
                    372:     POSTPONE to-this
                    373:     POSTPONE exit ; immediate
                    374: 
1.10      anton     375: : ;m ( colon-sys --; run-time: -- ) \ objects- objects
1.12      crook     376:     \g End a method definition; restore old @code{this}.
1.1       anton     377:     POSTPONE r>
1.3       anton     378:     POSTPONE to-this
1.1       anton     379:     POSTPONE ; ; immediate
                    380: 
1.7       anton     381: : catch ( ... xt -- ... n ) \ exception
1.12      crook     382:     \ Make it safe to call CATCH within a method.
1.1       anton     383:     \ should also be done with all words containing CATCH.
1.3       anton     384:     this >r catch r> to-this ;
                    385: 
                    386: \ the following is a bit roundabout; this is caused by the standard
                    387: \ disallowing to change the compilation wordlist between CREATE and
                    388: \ DOES> (see RFI 3)
                    389: 
1.4       anton     390: : inst-something ( align1 size1 align size xt "name" -- align2 size2 )
1.3       anton     391:     \ xt ( -- ) typically is for a DOES>-word
                    392:     get-current >r
                    393:     current-interface @ class-wordlist @ set-current
                    394:     >r create-field r> execute
                    395:     r> set-current ;
1.1       anton     396: 
1.3       anton     397: : do-inst-var ( -- )
                    398: does> \ name execution: ( -- addr )
1.1       anton     399:     ( addr1 ) @ this + ;
                    400: 
1.10      anton     401: : inst-var ( align1 offset1 align size "name" -- align2 offset2 ) \ objects- objects
1.12      crook     402:     \g @var{name} execution: @code{-- addr}@*
                    403:     \g @var{addr} is the address of the field @var{name} in
1.6       anton     404:     \g @code{this} object.
1.3       anton     405:     ['] do-inst-var inst-something ;
                    406: 
                    407: : do-inst-value ( -- )
                    408: does> \ name execution: ( -- w )
                    409:     ( addr1 ) @ this + @ ;
                    410: 
1.10      anton     411: : inst-value ( align1 offset1 "name" -- align2 offset2 ) \ objects- objects
1.12      crook     412:     \g @var{name} execution: @code{-- w}@*
                    413:     \g @var{w} is the value of the field @var{name} in @code{this}
1.6       anton     414:     \g object.
1.4       anton     415:     cell% ['] do-inst-value inst-something ;
1.3       anton     416: 
1.10      anton     417: : <to-inst> ( w xt -- ) \ objects- objects
1.12      crook     418:     \g store @var{w} into the field @var{xt} in @code{this} object.
1.3       anton     419:     >body @ this + ! ;
                    420: 
1.10      anton     421: : [to-inst] ( compile-time: "name" -- ; run-time: w -- ) \ objects- objects
1.12      crook     422:     \g store @var{w} into field @var{name} in @code{this} object.
1.3       anton     423:     ' >body @ POSTPONE literal
                    424:     POSTPONE this
                    425:     POSTPONE +
                    426:     POSTPONE ! ; immediate
                    427: 
1.4       anton     428: \ class binding stuff
1.1       anton     429: 
1.10      anton     430: : <bind> ( class selector-xt -- xt ) \ objects- objects
1.12      crook     431:     \g @var{xt} is the method for the selector @var{selector-xt} in
                    432:     \g @var{class}.
1.3       anton     433:     >body swap class->map over selector-interface @
                    434:     ?dup-if
                    435:        + @
                    436:     then
                    437:     swap selector-offset @ + @ ;
1.1       anton     438: 
1.10      anton     439: : bind' ( "class" "selector" -- xt ) \ objects- objects
1.12      crook     440:     \g @var{xt} is the method for @var{selector} in @var{class}.
1.3       anton     441:     ' execute ' <bind> ;
1.1       anton     442: 
1.10      anton     443: : bind ( ... "class" "selector" -- ... ) \ objects- objects
1.12      crook     444:     \g Execute the method for @var{selector} in @var{class}.
1.1       anton     445:     bind' execute ;
                    446: 
1.10      anton     447: : [bind] ( compile-time: "class" "selector" -- ; run-time: ... object -- ... ) \ objects- objects
1.12      crook     448:     \g Compile the method for @var{selector} in @var{class}.
1.1       anton     449:     bind' compile, ; immediate
                    450: 
1.10      anton     451: : current' ( "selector" -- xt ) \ objects- objects
1.12      crook     452:     \g @var{xt} is the method for @var{selector} in the current class.
1.4       anton     453:     current-interface @ ' <bind> ;
                    454: 
1.10      anton     455: : [current] ( compile-time: "selector" -- ; run-time: ... object -- ... ) \ objects- objects
1.12      crook     456:     \g Compile the method for @var{selector} in the current class.
1.4       anton     457:     current' compile, ; immediate
                    458: 
1.10      anton     459: : [parent] ( compile-time: "selector" -- ; run-time: ... object -- ... ) \ objects- objects
1.12      crook     460:     \g Compile the method for @var{selector} in the parent of the
1.6       anton     461:     \g current class.
1.3       anton     462:     current-interface @ class-parent @ ' <bind> compile, ; immediate
                    463: 
1.1       anton     464: \ the object class
                    465: 
1.3       anton     466: \ because OBJECT has no parent class, we have to build it by hand
                    467: \ (instead of with class)
                    468: 
1.4       anton     469: class% %allot current-interface !
                    470: current-interface 1 cells save-mem current-interface @ interface-map 2!
                    471: 0 current-interface @ interface-map-offset !
                    472: 0 current-interface @ interface-offset !
                    473: 0 current-interface @ class-parent !
                    474: wordlist current-interface @ class-wordlist !
                    475: object%
                    476: current-interface @ push-order
1.3       anton     477: 
1.5       anton     478: ' drop ( object -- )
1.10      anton     479: method construct ( ... object -- ) \ objects- objects
1.12      crook     480: \g Initialize the data fields of @var{object}. The method for the
                    481: \g class @var{object} just does nothing: @code{( object -- )}.
1.3       anton     482: 
                    483: :noname ( object -- )
                    484:     ." object:" dup . ." class:" object-map @ @ . ;
1.10      anton     485: method print ( object -- ) \ objects- objects
1.12      crook     486: \g Print the object. The method for the class @var{object} prints
1.6       anton     487: \g the address of the object and the address of its class.
1.3       anton     488: 
1.10      anton     489: end-class object ( -- class ) \ objects- objects
1.6       anton     490: \g the ancestor of all classes.
1.1       anton     491: 
1.3       anton     492: \ constructing objects
1.1       anton     493: 
1.10      anton     494: : init-object ( ... class object -- ) \ objects- objects
1.12      crook     495:     \g Initialize a chunk of memory (@var{object}) to an object of
                    496:     \g class @var{class}; then performs @code{construct}.
1.3       anton     497:     swap class->map over object-map ! ( ... object )
                    498:     construct ;
                    499: 
1.10      anton     500: : xt-new ( ... class xt -- object ) \ objects- objects
1.12      crook     501:     \g Make a new object, using @code{xt ( align size -- addr )} to
1.6       anton     502:     \g get memory.
1.3       anton     503:     over class-inst-size 2@ rot execute
                    504:     dup >r init-object r> ;
                    505: 
1.10      anton     506: : dict-new ( ... class -- object ) \ objects- objects
1.12      crook     507:     \g @code{allot} and initialize an object of class @var{class} in
1.6       anton     508:     \g the dictionary.
1.4       anton     509:     ['] %allot xt-new ;
1.3       anton     510: 
1.10      anton     511: : heap-new ( ... class -- object ) \ objects- objects
1.12      crook     512:     \g @code{allocate} and initialize an object of class @var{class}.
1.4       anton     513:     ['] %alloc xt-new ;

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