--- gforth/oof.fs	1996/09/24 19:15:04	1.2
+++ gforth/oof.fs	1997/01/25 20:53:02	1.5
@@ -157,8 +157,9 @@ Objects definitions
     dup  IF    2@ >r recurse r> :ilist + @ swap 1+
          ELSE  drop  THEN ;
 
-: add-order ( addr -- n )  >r
-    get-order r> swap >r 0 swap object-order
+: 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 ;
@@ -173,22 +174,22 @@ Objects definitions
   drop dup early?  IF >body @  THEN  compile, ;
 
 : findo    ( string -- cfa n )
-    >r get-order 0
-    o@ object-order
-    o@ :iface + @ interface-order set-order
-    r> find
+    o@ add-order >r
+    find
     ?dup 0= IF drop set-order true abort" method not found!" THEN
-    >r >r set-order r> r> ;
+    r> drop-order ;
 
 false Value method?
+false Value oset?
+
 : 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?  ;
 
-: early, ( object -- )  true  method,
-  state @ IF  postpone o>  THEN  ;
-: late,  ( object -- )  false method,
-  state @ IF  postpone o>  THEN  ;
+: early, ( object -- )  true to oset?  true  method,
+  state @ IF  postpone o>  THEN  false to oset? ;
+: late,  ( object -- )  true to oset?  false method,
+  state @ IF  postpone o>  THEN  false to oset? ;
 
 \ new,                                                 29oct94py
 
@@ -241,7 +242,7 @@ Create chunks here 16 cells dup allot er
   >r drop r@ @ rot ! r@ swap erase r> ;
 
 : >chunk ( n -- root n' )
-  8aligned dup 3 rshift cells chunks + swap ;
+  1- -8 and dup 3 rshift cells chunks + swap 8 + ;
 
 : Dalloc ( size -- addr )
   dup 128 > IF  allocate throw EXIT  THEN
@@ -272,7 +273,7 @@ Objects definitions
   DOES> state @ IF  dup postpone Literal postpone >o  THEN early, ;
 : ptr,      ( o -- )  0 , ,
   DOES>  state @
-    IF    postpone Literal postpone @ postpone >o cell+
+    IF    dup postpone Literal postpone @ postpone >o cell+
     ELSE  @  THEN late, ;
 
 : array,  ( n o -- )  alloc @ >r static new[], r> alloc ! drop
@@ -451,41 +452,54 @@ Create object  immediate  0 (class \ do
          early     link        immediate
 	 early     '           immediate
 	 early     send        immediate
+	 early     with        immediate
+	 early     endwith     immediate
 	 
 \ 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  postpone Literal postpone new,  ELSE  new,  THEN ;
-         : new[]   ( n -- o )   o@ state @
-           IF postpone Literal postpone 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  postpone Literal  THEN ;
-	 : send    ( xt -- )  execute ;
+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  postpone Literal postpone new,  ELSE  new,  THEN ;
+        : new[]   ( n -- o )   o@ state @
+          IF postpone Literal postpone 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  postpone Literal  THEN ;
+	: send    ( xt -- )  execute ;
+
+	: with ( -- )
+          state @ oset? 0= and IF  postpone >o  THEN
+	  o@ add-order voc# ! false to oset?
+	  rdrop state @
+	  IF    o>
+	  ELSE  oset? IF  ^ THEN  o> postpone >o
+	  THEN
+          rdrop rdrop ;
+	: endwith  postpone o> 
+	  voc# @ drop-order ;
 class; \ object
 
 \ interface                                            01sep96py
@@ -515,7 +529,8 @@ Vocabulary interfaces  interfaces defini
 
 : how: ( -- )  align
     here lastif @ !  0 decl !
-    last-interface @ ,  inter-list @ ,  methods @ ,  inter# @ ,
+    here  last-interface @ ,  last-interface !
+    inter-list @ ,  methods @ ,  inter# @ ,
     methods @ :inum cell+ ?DO  ['] crash ,  LOOP ;
 
 : interface; ( -- )  old-current @ set-current