\ OBJECT Stack =========================================
\ This stack is used for storing the current object address.
\ Access to instance variables is based on that address.
\ This code is a good candidate for optimization.
\
\ Author: Phil Burk
\ Copyright 1986 Delta Research
\
\ MOD: PLB 1/21/87 Add OS.DEPTH
\ MOD: PLB 2/10/87 Assemble and optimize OS.PUSH and OS.DROP
\ MOD: PLB 4/19/87 Optimize for Mac too.
\ MOD: PLB 4/26/88 Add OS_MAX_DEPTH
\ MOD: MDH 7/9/88 Use variable reference in OS.PUSH and OS.DROP
\      for CLONE.

ANEW TASK-OBJ_STACK

256 constant OS_SIZE

VARIABLE OBJECT-STACK os_size VALLOT

os_size cell/ constant OS_MAX_DEPTH

( Hyphens had to be removed to prevent Mac assembler from crashing.)
VARIABLE OSSTACKPTR

: OS.SP!  ( -- , Set Object Stack Pointer )
     object-stack os_size + osstackptr !
; OS.SP!

\ These three words need to be optimized for object speed.
\ : OS.PUSH  ( N -- , Push onto object stack )
\      osstackptr @ cell-  ( predecrement )
\      dup osstackptr !    ( update pointer )
\      !            ( write value )
\ ;
\ : OS.DROP  ( -- , drop top of object stack )
\     cell osstackptr +!
\ ;

#host_amiga_jforth
.IF  HEX

: OS.DROP   ( -- )
  OSSTACKPTR  [
\
\ add.l   #$4,$0(org,tos.l)
                            06B4 w,   0000 w,   0004 w,   7800 w,
\ move.l  (dsp)+,tos
                            2E1E w,
] tail  ;


: OS.PUSH  ( n1 -- ) 
  OSSTACKPTR   [
\
\ move.l  $0(org,tos.l),d1
                            2234 w,   7800 w,
\ subq.l  #$4,d1
                            5981 w,
\ move.l  (dsp),$0(org,d1.l)
                            2996 w,   1800 w,
\ move.l  d1,$0(org,tos.l)
                            2981 w,   7800 w,
\ addq.l  #$4,dsp
                            588E w,
\ move.l  (dsp)+,tos
                            2E1E w,
] tail ;


DECIMAL
max-inline @  20 max-inline !   ( optimize )
: OS.COPY  ( -- N , make copy of top of object stack )
    osstackptr @ @
;   ( must be fast for objects )

\ This could probably be optimized )
: OS+ ( M -- N+M , add top of object stack )
    osstackptr @ @ +
;

\ OS+PUSH is used for instance object binding.
: OS+PUSH ( N -- , combine OS+ and OS.PUSH )
    os+ os.push
;
.THEN

#HOST_MAC_MACH2 .IF
ALSO ASSEMBLER
CODE OS.PUSH  ( N -- , Push onto object stack )
   MOVE.L OSSTACKPTR,A0
   MOVE.L  (A6)+,-(A0)
   MOVE.L A0,OSSTACKPTR
   RTS
END-CODE

CODE OS.DROP  ( -- , drop top of object stack )
    ADDQ.L #$4,OSSTACKPTR
    RTS
END-CODE

CODE OS.COPY  ( -- N , make copy of top of object stack )
    MOVE.L OSSTACKPTR,A0
    MOVE.L (A0),-(A6)
    RTS
END-CODE

ONLY MAC ALSO FORTH
CODE OS+ ( M -- N+M , add top of object stack )
    MOVE.L OSSTACKPTR,A0
    ADD.L (A0),(A6)
    RTS
END-CODE

CODE OS+PUSH  ( N -- , Add to OS TOP and push onto object stack )
   MOVE.L OSSTACKPTR,A0
   MOVE.L (A0),D0  ( Get top. )
   ADD.L  (A6)+,D0
   MOVE.L D0,-(A0)
   MOVE.L A0,OSSTACKPTR
   RTS
END-CODE

.THEN

: OS.POP  ( -- N , pop from object stack )
    os.copy  os.drop
;

: OS.DEPTH ( -- #cells , depth of object stack )
    object-stack os_size +
    osstackptr @ - cell/
;

: OS.PICK ( n -- Vn , pick value off object stack )
    cell* osstackptr @ + @
;

#host_amiga_jforth .IF
   max-inline !
.THEN

\ Benchmark
if-testing @ .IF
VARIABLE #OS.BENCH
1000 #OS.BENCH !
: OS.BENCH  123 #OS.BENCH @ 0
    DO  os.push os.copy os.drop
    LOOP drop
;
.THEN