Commit ed23db58 authored by Bernd Paysan's avatar Bernd Paysan

Some changes to mini-oof2, use to instead of defines

parent c0e4b37b
......@@ -315,7 +315,7 @@ FORTH_SRC = $(KERN_SRC) $(GFORTH_FI_DIST_SRC) $(EC_SRC) $(LIBCC_DIST_SRC) \
test/macros.fs \
bubble.fs siev.fs matrix.fs fib.fs \
oof.fs oofsampl.fs objects.fs objexamp.fs mini-oof.fs moof-exm.fs \
moofglos.fs fixpath.fs \
moofglos.fs fixpath.fs mini-oof2.fs moof2-example.fs \
add.fs lib.fs oldlib.fs sieve.fs \
endtry-iferror.fs recover-endtry.fs smartdots.fs \
unix/terminal-server.fs
......
......@@ -449,7 +449,11 @@ defer defer-default ( -- )
extra>-dummy (doextra-dummy)
: !extra ( addr -- ) \ gforth store-extra
['] extra, !compile, latestxt extra-code! ;
vttemplate >vtcompile, @ ['] udp >namevt @ >vtcompile, @ =
IF
['] extra, !compile,
THEN
latestxt extra-code! ;
: DOES> ( compilation colon-sys1 -- colon-sys2 ; run-time nest-sys -- ) \ core extra
cfalign 0 , here !extra ] defstart :-hook ;
......
......@@ -4,8 +4,10 @@
Create o 0 , DOES> @ o#+ [ 0 , ] + ;
compile> >body @ postpone o#+ , ;
: to-m >body @ + ! ;
Create m 0 , DOES> @ o#+ [ -1 cells , ] @ + perform ;
compile> >body @ cell/ postpone o#exec , ;
' to-m !to
' o Value var-xt
' m Value method-xt
: current-o ['] o to var-xt ['] m to method-xt ;
......@@ -22,9 +24,7 @@ compile> >body @ cell/ postpone o#exec , ;
Create here >r , dup , 2 cells ?DO ['] noop , cell +LOOP
cell+ dup cell+ r> rot @ 2 cells /string move standard:field ;
: >vt ( class "name" -- addr ) ' >body @ + ;
: bind ( class "name" -- xt ) >vt @ ;
: defines ( xt class "name" -- ) >vt ! ;
: :: ( class "name" -- ) bind compile, ;
: :: ( class "name" -- ) >vt @ compile, ;
Create object 0 cells , 2 cells ,
\ memory allocation
......@@ -37,11 +37,11 @@ end-class storage
storage class end-class static-alloc
storage class end-class dynamic-alloc
:noname ( len -- addr ) here swap allot ; static-alloc defines :allocate
:noname ( addr -- ) drop ; static-alloc defines :free
:noname ( len -- addr ) here swap allot ; static-alloc to :allocate
:noname ( addr -- ) drop ; static-alloc to :free
:noname ( len -- addr ) allocate throw ; dynamic-alloc defines :allocate
:noname ( addr -- ) free throw ; dynamic-alloc defines :free
:noname ( len -- addr ) allocate throw ; dynamic-alloc to :allocate
:noname ( addr -- ) free throw ; dynamic-alloc to :free
static-alloc dup @ cell+ here swap allot swap over ! cell+ Constant static-a
static-a Value allocater
......
......@@ -10,9 +10,9 @@ object class
method p.
end-class point
:noname x @ y @ ; point defines p@
:noname x ? y ? ; point defines p.
:noname y ! x ! ; point defines p!
:noname x @ y @ ; point to p@
:noname x ? y ? ; point to p.
:noname y ! x ! ; point to p!
point new Constant p1
p1 >o 1 2 p! o>
......
......@@ -2912,6 +2912,14 @@ ip=IP;
SUPER_END;
VM_JUMP(EXEC1(((Xt**)op)[-1][w]));
x#exec ( c_addr #w -- c_addr ) new x_lit_exec
""method invocation using the stack""
#ifndef NO_IP
ip=IP;
#endif
SUPER_END;
VM_JUMP(EXEC1(((Xt**)c_addr)[-1][w]));
\+
\g static_super
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment