Object-Oriented Forth
Jump to navigation
Jump to search
This page documents a conversation with Mitch Bradley in my attempt to understand the following piece of Forth code, which implements a namespaced object-oriented forth package called OOF. This is the implementation from GForth; there's a little bit of description at in the GForth manual section describing OOF.
oof.fs, from gforth
\ oof.fs Object Oriented FORTH \ This file is (c) 1996,2000 by Bernd Paysan \ e-mail: bernd.paysan@gmx.de \ \ Please copy and share this program, modify it for your system \ and improve it as you like. But don't remove this notice. \ \ Thank you. \ \ The program uses the following words \ from CORE : \ decimal : bl word 0= ; = cells Constant Variable ! Create , allot @ \ IF POSTPONE >r ELSE +! dup + THEN immediate r> * >body cell+ \ Literal drop align here aligned DOES> execute ['] 2@ recurse swap \ 1+ over LOOP and EXIT ?dup 0< ] [ rot r@ - i negate +LOOP 2drop \ BEGIN WHILE 2dup REPEAT 1- rshift > / ' move UNTIL or count \ from CORE-EXT : \ nip false Value tuck true ?DO compile, 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 definitions get-order set-order get-current wordlist \ set-current search-wordlist \ from SEARCH-EXT : \ also Forth previous \ from STRING : \ /string compare \ from TOOLS-EXT : \ [IF] [THEN] [ELSE] state \ from non-ANS : \ cell dummy [THEN] ?EXIT Vocabulary [ELSE] ( \G \ Loadscreen 27dec95py decimal : define? ( -- flag ) bl word find nip 0= ; define? cell [IF] 1 cells Constant cell [THEN] define? \G [IF] : \G postpone \ ; immediate [THEN] define? ?EXIT [IF] : ?EXIT postpone IF postpone EXIT postpone THEN ; immediate [THEN] define? Vocabulary [IF] : Vocabulary wordlist create , DOES> @ >r get-order nip r> swap set-order ; [THEN] define? faligned [IF] false [ELSE] 1 faligned 8 = [THEN] [IF] : 8aligned ( n1 -- n2 ) faligned ; [ELSE] : 8aligned ( n1 -- n2 ) 7 + -8 and ; [THEN] Vocabulary Objects also Objects also definitions Vocabulary types types also 0 cells Constant :wordlist 1 cells Constant :parent 2 cells Constant :child 3 cells Constant :next 4 cells Constant :method# 5 cells Constant :var# 6 cells Constant :newlink 7 cells Constant :iface 8 cells Constant :init 0 cells Constant :inext 1 cells Constant :ilist 2 cells Constant :ilen 3 cells Constant :inum Variable op : op! ( o -- ) op ! ; Forth definitions Create ostack 0 , 16 cells allot : ^ ( -- o ) op @ ; : o@ ( -- o ) op @ @ ; : >o ( o -- ) state @ IF postpone ^ postpone >r postpone op! ELSE 1 ostack +! ^ ostack dup @ cells + ! op! THEN ; immediate : o> ( -- ) state @ IF postpone r> postpone op! ELSE ostack dup @ cells + @ op! -1 ostack +! THEN ; immediate : o[] ( n -- ) o@ :var# + @ * ^ + op! ; Objects definitions \ Coding 27dec95py 0 Constant #static 1 Constant #method 2 Constant #early 3 Constant #var 4 Constant #defer : exec? ( addr -- flag ) >body cell+ @ #method = ; : static? ( addr -- flag ) >body cell+ @ #static = ; : early? ( addr -- flag ) >body cell+ @ #early = ; : defer? ( addr -- flag ) >body cell+ @ #defer = ; false Value oset? : o+, ( addr offset -- ) postpone Literal postpone ^ postpone + oset? IF postpone op! ELSE postpone >o THEN drop ; : o*, ( addr offset -- ) postpone Literal postpone * postpone Literal postpone + oset? IF postpone op! ELSE postpone >o THEN ; : ^+@ ( offset -- addr ) ^ + @ ; : o+@, ( addr offset -- ) postpone Literal postpone ^+@ oset? IF postpone op! ELSE postpone >o THEN drop ; : ^*@ ( offset -- addr ) ^ + @ tuck @ :var# + @ 8aligned * + ; : o+@*, ( addr offset -- ) postpone Literal postpone ^*@ oset? IF postpone op! ELSE postpone >o THEN drop ; \ variables / memory allocation 30oct94py Variable lastob Variable lastparent 0 lastparent ! Variable vars Variable methods Variable decl 0 decl ! Variable 'link : crash true abort" unbound method" ; : link, ( addr -- ) align here 'link ! , 0 , 0 , ; 0 link, \ type declaration 30oct94py : vallot ( size -- offset ) vars @ >r dup vars +! 'link @ 0= IF lastparent @ dup IF :newlink + @ THEN link, THEN 'link @ 2 cells + +! r> ; : valign ( -- ) vars @ aligned vars ! ; define? faligned 0= [IF] : vfalign ( -- ) vars @ faligned vars ! ; [THEN] : mallot ( -- offset ) methods @ cell methods +! ; types definitions : static ( -- ) \ oof- oof \G Create a class-wide cell-sized variable. mallot Create , #static , DOES> @ o@ + ; : method ( -- ) \ oof- oof \G Create a method selector. mallot Create , #method , DOES> @ o@ + @ execute ; : early ( -- ) \ oof- oof \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 Objects definitions : object-order ( wid0 .. widm m addr -- wid0 .. widn n ) dup IF 2@ >r recurse r> swap 1+ ELSE drop THEN ; : interface-order ( wid0 .. widm m addr -- wid0 .. widn n ) dup IF 2@ >r recurse r> :ilist + @ swap 1+ ELSE drop THEN ; : add-order ( addr -- n ) dup 0= ?EXIT >r get-order r> swap >r 0 swap dup >r object-order r> :iface + @ interface-order r> over >r + set-order r> ; : drop-order ( n -- ) 0 ?DO previous LOOP ; \ object compiling/executing 20feb95py : o, ( xt early? -- ) over exec? over and IF drop >body @ o@ + @ compile, EXIT THEN over static? over and IF drop >body @ o@ + @ postpone Literal EXIT THEN drop dup early? IF >body @ THEN compile, ; : findo ( string -- cfa n ) o@ add-order >r find ?dup 0= IF drop set-order true abort" method not found!" THEN r> drop-order ; false Value method? : method, ( object early? -- ) true to method? swap >o >r bl word findo 0< state @ and IF r> o, ELSE r> drop execute THEN o> false to method? ; : cmethod, ( object early? -- ) state @ dup >r 0= IF postpone ] THEN method, r> 0= IF postpone [ THEN ; : early, ( object -- ) true to oset? true method, state @ oset? and IF postpone o> THEN false to oset? ; : late, ( object -- ) true to oset? false method, state @ oset? and IF postpone o> THEN false to oset? ; \ new, 29oct94py previous Objects definitions Variable alloc 0 Value ohere : oallot ( n -- ) ohere + to ohere ; : ((new, ( link -- ) dup @ ?dup IF recurse THEN cell+ 2@ swap ohere + >r ?dup IF ohere >r dup >r :newlink + @ recurse r> r> ! THEN r> to ohere ; : (new ( object -- ) ohere >r dup >r :newlink + @ ((new, r> r> ! ; : init-instance ( pos link -- pos ) dup >r @ ?dup IF recurse THEN r> cell+ 2@ IF drop dup >r ^ + >o o@ :init + @ execute 0 o@ :newlink + @ recurse o> r> THEN + ; : init-object ( object -- size ) >o o@ :init + @ execute 0 o@ :newlink + @ init-instance o> ; : (new, ( object -- ) ohere dup >r over :var# + @ erase (new r> init-object drop ; : size@ ( objc -- size ) :var# + @ 8aligned ; : (new[], ( n o -- addr ) ohere >r dup size@ rot over * oallot r@ ohere dup >r 2 pick - ?DO I to ohere >r dup >r (new, r> r> dup negate +LOOP 2drop r> to ohere r> ; \ new, 29oct94py Create chunks here 16 cells dup allot erase : DelFix ( addr root -- ) dup @ 2 pick ! ! ; : NewFix ( root size # -- addr ) BEGIN 2 pick @ ?dup 0= WHILE 2dup * allocate throw over 0 ?DO dup 4 pick DelFix 2 pick + LOOP drop REPEAT >r drop r@ @ rot ! r@ swap erase r> ; : >chunk ( n -- root n' ) 1- -8 and dup 3 rshift cells chunks + swap 8 + ; : Dalloc ( size -- addr ) dup 128 > IF allocate throw EXIT THEN >chunk 2048 over / NewFix ; : Salloc ( size -- addr ) align here swap allot ; : dispose, ( addr size -- ) dup 128 > IF drop free throw EXIT THEN >chunk drop DelFix ; : new, ( o -- addr ) dup :var# + @ alloc @ execute dup >r to ohere (new, r> ; : new[], ( n o -- addr ) dup :var# + @ 8aligned 2 pick * alloc @ execute to ohere (new[], ; Forth definitions : dynamic ['] Dalloc alloc ! ; dynamic : static ['] Salloc alloc ! ; Objects definitions \ instance creation 29mar94py : instance, ( o -- ) alloc @ >r static new, r> alloc ! drop DOES> state @ IF dup postpone Literal oset? IF postpone op! ELSE postpone >o THEN THEN early, ; : ptr, ( o -- ) 0 , , DOES> state @ IF dup postpone Literal postpone @ oset? IF postpone op! ELSE postpone >o THEN cell+ ELSE @ THEN late, ; : array, ( n o -- ) alloc @ >r static new[], r> alloc ! drop DOES> ( n -- ) dup dup @ size@ state @ IF o*, ELSE nip rot * + THEN early, ; \ class creation 29mar94py Variable voc# Variable classlist Variable old-current Variable ob-interface : voc! ( addr -- ) get-current old-current ! add-order 2 + voc# ! get-order wordlist tuck classlist ! 1+ set-order also types classlist @ set-current ; : (class-does> DOES> false method, ; : (class ( parent -- ) (class-does> here lastob ! true decl ! 0 ob-interface ! 0 , dup voc! dup lastparent ! dup 0= IF 0 ELSE :method# + 2@ THEN methods ! vars ! ; : (is ( addr -- ) bl word findo drop dup defer? abort" not deferred!" >body @ state @ IF postpone ^ postpone Literal postpone + postpone ! ELSE ^ + ! THEN ; : inherit ( -- ) bl word findo drop dup exec? IF >body @ dup o@ + @ swap lastob @ + ! EXIT THEN abort" Not a polymorph method!" ; \ instance variables inside objects 27dec93py : instvar, ( addr -- ) dup , here 0 , 0 vallot swap ! 'link @ 2 cells + @ IF 'link @ link, THEN 'link @ >r dup r@ cell+ ! :var# + @ dup vars +! r> 2 cells + ! DOES> dup 2@ swap state @ IF o+, ELSE ^ + nip nip THEN early, ; : instptr> ( -- ) DOES> dup 2@ swap state @ IF o+@, ELSE ^ + @ nip nip THEN late, ; : instptr, ( addr -- ) , here 0 , cell vallot swap ! instptr> ; : (o* ( i addr -- addr' ) dup @ :var# + @ 8aligned rot * + ; : instarray, ( addr -- ) , here 0 , cell vallot swap ! DOES> dup 2@ swap state @ IF o+@*, ELSE ^ + @ nip nip (o* THEN late, ; \ bind instance pointers 27mar94py : ((link ( addr -- o addr' ) 2@ swap ^ + ; : (link ( -- o addr ) bl word findo drop >body state @ IF postpone Literal postpone ((link EXIT THEN ((link ; : parent? ( class o -- class class' ) @ BEGIN 2dup = ?EXIT dup WHILE :parent + @ REPEAT ; : (bound ( obj1 obj2 adr2 -- ) >r over parent? nip 0= abort" not the same class !" r> ! ; : (bind ( addr -- ) \ <name> (link state @ IF postpone (bound EXIT THEN (bound ; : (sbound ( o addr -- ) dup cell+ @ swap (bound ; Forth definitions : bind ( o -- ) ' state @ IF postpone Literal postpone >body postpone (sbound EXIT THEN >body (sbound ; immediate Objects definitions \ method implementation 29oct94py Variable m-name Variable last-interface 0 last-interface ! : interface, ( -- ) last-interface @ BEGIN dup WHILE dup , @ REPEAT drop ; : inter, ( iface -- ) align here over :inum + @ lastob @ + ! here over :ilen + @ dup allot move ; : interfaces, ( -- ) ob-interface @ lastob @ :iface + ! ob-interface @ BEGIN dup WHILE 2@ inter, REPEAT drop ; : lastob! ( -- ) lastob @ dup BEGIN nip dup @ here cell+ 2 pick ! dup 0= UNTIL drop dup , op! o@ lastob ! ; : thread, ( -- ) classlist @ , ; : var, ( -- ) methods @ , vars @ , ; : parent, ( -- o parent ) o@ lastparent @ 2dup dup , 0 , dup IF :child + dup @ , ! ELSE , drop THEN ; : 'link, ( -- ) 'link @ ?dup 0= IF lastparent @ dup IF :newlink + @ THEN THEN , ; : cells, ( -- ) methods @ :init ?DO ['] crash , cell +LOOP ; \ method implementation 20feb95py types definitions : how: ( -- ) \ oof- oof how-to \G End declaration, start implementation decl @ 0= abort" not twice!" 0 decl ! align interface, lastob! thread, parent, var, 'link, 0 , cells, interfaces, dup IF dup :method# + @ >r :init + swap r> :init /string move ELSE 2drop THEN ; : class; ( -- ) \ oof- oof end-class \G End class declaration or implementation decl @ IF how: THEN 0 'link ! voc# @ drop-order old-current @ set-current ; : 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, cast to another class. cell+ @ Create immediate lastob @ here lastob ! , , instptr> ; : Fpostpone postpone postpone ; immediate : : ( <methodname> -- ) \ oof- oof colon decl @ abort" HOW: missing! " bl word findo 0= abort" not found" dup exec? over early? or over >body cell+ @ 0< or 0= abort" not a method" m-name ! :noname ; Forth : ; ( xt colon-sys -- ) \ oof- oof postpone ; m-name @ dup >body swap exec? IF @ o@ + ELSE dup cell+ @ 0< IF 2@ swap o@ + @ + THEN THEN ! ; immediate Forth definitions \ object 23mar95py Create object immediate 0 (class \ do not create as subclass cell var oblink \ create offset for backlink static thread \ method/variable wordlist static parento \ pointer to parent static childo \ ptr to first child static nexto \ ptr to next child of parent static method# \ number of methods (bytes) static size \ number of variables (bytes) static newlink \ ptr to allocated space static ilist \ interface list method init ( ... -- ) \ object- oof method dispose ( -- ) \ object- oof early class ( "name" -- ) \ object- oof early new ( -- o ) \ object- oof immediate early new[] ( n -- o ) \ object- oof new-array immediate early : ( "name" -- ) \ object- oof define early ptr ( "name" -- ) \ object- oof early asptr ( o "name" -- ) \ object- oof early [] ( n "name" -- ) \ object- oof array early :: ( "name" -- ) \ object- oof scope immediate early class? ( o -- flag ) \ object- oof class-query early super ( "name" -- ) \ object- oof immediate early self ( -- o ) \ object- oof early bind ( o "name" -- ) \ object- oof immediate early bound ( class addr "name" -- ) \ object- oof early link ( "name" -- class addr ) \ object- oof immediate 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 how: 0 parento ! 0 childo ! 0 nexto ! : class ( -- ) Create immediate o@ (class ; : : ( -- ) Create immediate o@ decl @ IF instvar, ELSE instance, THEN ; : ptr ( -- ) Create immediate o@ decl @ IF instptr, ELSE ptr, THEN ; : asptr ( addr -- ) decl @ 0= abort" only in declaration!" Create immediate o@ , cell+ @ , instptr> ; : [] ( n -- ) Create immediate o@ decl @ IF instarray, ELSE array, THEN ; : new ( -- o ) o@ state @ IF Fpostpone Literal Fpostpone new, ELSE new, THEN ; : new[] ( n -- o ) o@ state @ IF Fpostpone Literal Fpostpone new[], ELSE new[], THEN ; : dispose ( -- ) ^ size @ dispose, ; : bind ( addr -- ) (bind ; : bound ( o1 o2 addr2 -- ) (bound ; : link ( -- o addr ) (link ; : class? ( class -- flag ) ^ parent? nip 0<> ; : :: ( -- ) state @ IF ^ true method, ELSE inherit THEN ; : super ( -- ) parento true method, ; : is ( cfa -- ) (is ; : self ( -- obj ) ^ ; : init ( -- ) ; : ' ( -- xt ) bl word findo 0= abort" not found!" state @ IF Fpostpone Literal THEN ; : 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 ; : definitions o@ add-order 1+ voc# ! also types o@ lastob ! false to oset? get-current old-current ! thread @ set-current ; class; \ object \ interface 01sep96py Objects definitions : implement ( interface -- ) \ oof-interface- oof align here over , ob-interface @ , ob-interface ! :ilist + @ >r get-order r> swap 1+ set-order 1 voc# +! ; : inter-method, ( interface -- ) \ oof-interface- oof :ilist + @ bl word count 2dup s" '" str= dup >r IF 2drop bl word count THEN rot search-wordlist dup 0= abort" Not an interface method!" r> IF drop state @ IF postpone Literal THEN EXIT THEN 0< state @ and IF compile, ELSE execute THEN ; Variable inter-list Variable lastif Variable inter# Vocabulary interfaces interfaces definitions : method ( -- ) \ oof-interface- oof mallot Create , inter# @ , DOES> 2@ swap o@ + @ + @ execute ; : how: ( -- ) \ oof-interface- oof align here lastif @ ! 0 decl ! here last-interface @ , last-interface ! inter-list @ , methods @ , inter# @ , methods @ :inum cell+ ?DO ['] crash , LOOP ; : interface; ( -- ) \ oof-interface- oof old-current @ set-current previous previous ; : : ( <methodname> -- ) \ oof-interface- oof colon decl @ abort" HOW: missing! " bl word count lastif @ @ :ilist + @ search-wordlist 0= abort" not found" dup >body cell+ @ 0< 0= abort" not a method" m-name ! :noname ; Forth : ; ( xt colon-sys -- ) \ oof-interface- oof postpone ; m-name @ >body @ lastif @ @ + ! ; immediate Forth definitions : interface-does> DOES> @ decl @ IF implement ELSE inter-method, THEN ; : interface ( -- ) \ oof-interface- oof Create interface-does> here lastif ! 0 , get-current old-current ! last-interface @ dup IF :inum @ THEN 1 cells - inter# ! get-order wordlist dup inter-list ! dup set-current swap 1+ set-order true decl ! 0 vars ! :inum cell+ methods ! also interfaces ; previous previous
Discussion transcript
- cscott: http://pastebin.com/qGtzgwhE is the oof.fs source, which apparently implements namespacing for object methods, but it's a little opaque to me
- Quozl: (the mixed case hurts my sensibilities ;-)
- cscott: i assume that the definition for 'obj' would could call input parser to lookahead to get the method name, and then lookup the method name in the object's vocabulary, but i'm lost looking at the code
- MitchBradley: which line is the definition for obj on?
- Quozl: it would take me a long time to parse oof.fs ... and i can't find an " obj " either, is there sample of use?
- cscott: http://www.delorie.com/gnu/docs/gforth/gforth_173.html
- cscott: at the very bottom of that page, "You can only invoke a selector if the receiving object belongs to the class where the selector was defined or one of its descendents; e.g., you can invoke draw only for objects belonging to graphical or its descendents (e.g., circle). The scoping mechanism will check if you try to invoke a selector that is not defined in this class hierarchy, so you'll get an error at compilation time."
- cscott: that's the part I'm trying to figure out how it's implemented
- MitchBradley: add-order and findo
- MitchBradley: lines 216 and 232
- MitchBradley: cscott: I think findo is the key. method, uses it, and various words used method, to resolve and compile inherited method references
- MitchBradley: all the "state @ if" stuff is to handle the distinction between interactive use and compilation
- cscott: yeah, i agree that findo is doing the method lookup; i'm still trying to grok where exactly the method is invoked
- cscott: probably i'm not understanding the "state @ if" stuff
- MitchBradley: state @ if <how to handle the reference in compile state> else <what to do in interactive interpretation state> then
- MitchBradley: method, either executes the word (" r> drop execute") or compiles it ("r> o,")
- cscott: ok. so (looking at the example in the gforth manual) if I execute '50 circle : my-circle' that gives me a word 'my-circle' in the dictionary. When I execute '100 100 my-circle draw' when I get to the 'my-circle' in the line, where am i exactly?
- MitchBradley: it will take me a few to dig through; please stand by
- cscott: somewhere in 'o,' (lines 225-230)?
- CanoeBerry: fyi *@laptop.org mails seemed to stop forwarding 30min ago; backlogged emails are now arriving, sometime slowly
- cjb: CanoeBerry: please give headers when you report that
- cjb: i.e. received at spam.laptop.org at time <X>, received at your mailbox at time <X+a lot>
- cscott: oh, hm, looks like there's method of object named 'send', so that "100 100 my-circle ' draw my-circle send" would be equivalent to "100 100 my-circle draw"
- MitchBradley: quite likely
- erikos left the room (quit: Ping timeout: 480 seconds).
- cscott: i still haven't figured out exactly where "my circle" futzes with the active vocabulary, but ' and send are defined in likes 579 and 581 in a pretty straightforward way
- cscott: the hard work being done by ' which invokes findo, as you pointed out before; then send just needs to execute that word; presumably the "object context" (whatever that is) has already been set up for the send method.
- MitchBradley: The overloading of ":" makes it difficult to work out what is going on...
- cscott: yes, and the fact that there's bits executed at compile time and at run-time, and in "declaring the class" and "defining the implementation" modes.
- MitchBradley: I think how: (line 456) may be important
- cscott: i thought so, then i convinced myself that that just changed the parsing state from "declaring the class" to "defining the implementation" and that what I was really looking for was object instantiation stuff
- cscott: graphical class circle \ "graphical" is the parent class
- cscott: cell var circle-radius
- cscott: how:
- cscott: : draw ( x y -- )
- cscott: circle-radius @ draw-circle ;
- cscott: : init ( n-radius -- (
- cscott: circle-radius ! ;
- cscott: class;
- cscott: so i think all 'how' is doing is redefining : and friends so that they make proper method declarations for the circle class
- cscott: (and checking that you don't have two 'how:' words in a single class)
- cscott: really what I should do is fire up gforth, execute '50 circle : my-circle' and then 'see my-circle'
- MitchBradley: "op" seems to refer to the current object
- MitchBradley: I think that activating an object sets op via op!
- MitchBradley: and that in turn affects pretty much everything else via o@
- cscott: so i fired up gforth. 'see my-circle' reports:
- cscott: create my-circle
- cscott: DOES> useraddr <64> @
- cscott: IF dup POSTPONE Literal oset?
- cscott: IF -1223034368 compile,
- cscott: ELSE POSTPONE >o
- cscott: THEN
- cscott: THEN
- cscott: early, ; immediate
- MitchBradley: okay, that is the does? clause for instance,
- MitchBradley: s/does?/does>/
- dogi left the room (quit: Ping timeout: 480 seconds).
- MitchBradley: confirming my suspicion about op! being key
- MitchBradley: >o pushes object references on a stack
- cscott: : foo 100 100 my-circle draw ; see foo
- cscott: : foo
- cscott: 100 100 -1223017680 ^ >r op! <-1223017768> r> op! ;
- cscott: so there's your op! again
- MitchBradley: that is very similar to how OFW $call-method works
- cscott: I haven't quite understood where the vocabulary is being altered
- MitchBradley: the vocabulary is not being altered
- MitchBradley: the vocabulary is used at compile time
- MitchBradley: this is an early bound object
- cscott: so is that the "compile," reference in "see my-circle" ?
- cscott: i think i need to better understand early binding in forth
- MitchBradley: "-1223034368 compile," is how the decompiler renders the source expression "postpone op!"
- cscott: where ' op! would give -1223034368, presumably?
- MitchBradley: yeah, the number is probably the xt value for op!
- MitchBradley: look at the definition of ">o"
- cscott: so, vocabularies are used for late binding -- where does the lookup for early binding happen?
- MitchBradley: It includes "postpone ^ postpone >r postpone op!"
- MitchBradley: vocabularies are used for the lookup for early binding too
- MitchBradley: once the lookup is complete, the result is bound inside the new definition
- MitchBradley: the binding takes the form:
- MitchBradley: <instance-ref> ^ >r op! <method> r> op!
- MitchBradley: which is pushing the old instance on the return stack, switching the instance context to the new instance, executing the method in that context, and then popping the return stack to restore the previous instance context
- MitchBradley: OFW method calls work exactly the same way, without all the syntactic sugar
- cscott: i like the syntactic sugar, i just don't understand how it works yet ;-)
- MitchBradley: line 555
- cscott: i'm expecting to find ['] somewhere to parse the next word in the input (the method name) and then call findo on it to look it up, and then emit that in the output of the compiler
- MitchBradley: bl word find
- MitchBradley: line 241
- MitchBradley: line 482
- cscott: what does 'bl' do?
- MitchBradley: pushes the ascii code for the space character
- erikos [~erikos@c-75-74-200-96.hsd1.fl.comcast.net] entered the room.
- cscott: 'word' parses the next word from the input then?
- MitchBradley: bl word parses a blank-delimited token
- MitchBradley: I would have used the newer form "parse-word", but "bl word" is possibly slightly more portable
- MitchBradley: lots of ancient history I'd rather not go into...
- cscott: ok, so i'm chugging along parsing "100 100 my-circle draw". When I get to "my-circle" i'm executing some code from the instance, word around line 333, right?
- MitchBradley: The canonical phrase used by the non-oof Forth interpreter is "bl word find"
- MitchBradley: yes, my-circle executes the does> clause of instance,
- cscott: and because i'm in compile state, i'm executing the "dup postpone Literal oset? IF postpone op! ELSE postpone >o THEN" part, followed by a call to "early," ?
- MitchBradley: since you are in interpret state at that point, it executes the ">o" branch, pushing the "my-circle" instance on the interpret state object stack
- MitchBradley: you are not in compile state
- MitchBradley: You would be in compile state if you had said : draw-me 100 100 my-circle draw ;
- cscott: hm, ok. either way i end up in early, which after some other stuff invokes method, which eventually does the "bl word findo" that I was looking for
- cscott: if i was in compile state, i wouldn't actually have an object reference yet, but i still would have ended up in early, and then in method, looking up "draw" in an appropriate class (via some early binding magic)
- MitchBradley: presumably, yes
- cscott: in my traditional static types world, i'd say that we know the type of 'my-circle' even though we don't know its value yet, and so we look up 'draw' based on the type
- cscott: something similar is happening in the early binding world, without the meta-mechanism of static types
- MitchBradley: I'll take your word for it
- cscott: i wish i could spend a couple of days and really grok all the early-binding magic i'm glossing over
- cscott: what I think is happening is that the *class* 'circle' is early-bound, and so the compilation-mode stuff is passing around references to the class value, even though 'my-circle' is a runtime value which is not yet defined. but i'm guessing.
- MitchBradley: I have to go to town now
- cscott: o is the class, and op is the object? findo deals with o@ not op!
mikey_w MitchBradley
- cscott: MitchBradley: thanks again for your wizardry
- cscott: i need to get back to nacl porting anyway
- MitchBradley: everything is much easier if you just dispense with the sugar
- cjb: don't let Walter hear
- MitchBradley: The only sugar I might add is the word "the", so that instead of saying "also class-name methodname previous", you could instead say "the class-name method-name"
- MitchBradley: e.g. "the circle draw"
- cjb: jnettlet: hey, any ideas for debugging why this F13 arm build I made (not an upgrade) is hanging after "Freeing init memory: 108K"?
- MitchBradley: tip-o-the-hat to Robert Berkey for "the"
- cscott: MitchBradley: that makes sense. I can't let all of the (say) GTK namespace into the main forth dictionary, it's too huge; but "someobj the gtk label show" might be reasonable.