LINKOBJECT

MODULE 'exec/memory',
       'hardware/custom',
       'utility/hooks'

       -> ecode.e - from Jasons R Hulance`s UsefulV2.

       -> YAEC Notes :
       -> - Compiled as external linklib.
       -> - Function-names changed to start with upper-case.
       -> - Alot changes in asm-parts, but still recogniseable.
       -> YAEC1.6a :
       -> - Added ECodeUtilHook().   Anything else ?
       -> - Fixed some various bugs.


       RAISE "MEM" IF New()=NIL

->EXPORT PROC Test(x,y,z) IS WriteF('testing \d,\d,\d\n',x,y,z)
  
-> Wraps an E function so it can still access globals, even from other tasks.
EXPORT PROC ECode(func) IS setup(func,({start}),({end})-({start}))

-> Wraps an E function as above, but also preserves the non-scratch registers.
EXPORT PROC ECodePreserve(func) IS setup(func,({pStart}),({pEnd})-({pStart}))

-> Wraps an E function for use with createTask()
EXPORT PROC ECodeTask(func) IS ECode(func)

-> Wraps an E function for use as an ASL hook
EXPORT PROC ECodeASLHook(func) IS setup(func,({aStart}),({aEnd})-({aStart}))

-> Wraps an E function for use as an CX custom function
EXPORT PROC ECodeCxCustom(func) IS setup(func,({cStart}),({cEnd})-({cStart}))

-> Wraps an E function for use as a GEL collision function
EXPORT PROC ECodeCollision(func) IS ECodeCxCustom(func)

-> Wraps an E function for use as an interrupt handler
EXPORT PROC ECodeIntHandler(func) IS setup(func,({hStart}),({hEnd})-({hStart}))

-> Wraps an E function for use as an interrupt server
EXPORT PROC ECodeIntServer(func) IS setup(func,({sStart}),({sEnd})-({sStart}))

-> Wraps an E function for use as a software interrupt
EXPORT PROC ECodeSoftInt(func) IS setup(func,({iStart}),({iEnd})-({iStart}))

-> Wraps an E function as eCode(), but swaps the order of two args
EXPORT PROC ECodeSwapArgs(func) IS setup(func,({oStart}),({oEnd})-({oStart}))

EXPORT PROC ECodeDispose(mem:PTR TO LONG)
   IF mem
      IF mem::hook.entry = {entry} THEN RETURN FastDispose(mem, SIZEOF ecodehook)
      mem := mem - 12
      IF mem[2] THEN Dispose(mem[2])
      Dispose(mem)
   ENDIF
ENDPROC

PROC setup(func, addr, len) HANDLE
  DEF mem:PTR TO LONG, a4
  mem := New(len) ->mem:=NewM(len, MEMF_PUBLIC)
  -> Fully relocatable code can be copied to another memory location
  CopyMem(addr, mem, len)
  mem[]++:=func
  ->a4 := A4 ->MOVE.L A4, a4
  mem[]++:= A4 -> I just know this is okey.
  mem[]++:= New(400)
  IF KickVersion(36) THEN CacheClearU()  -> Write out the cache (68040 especially bad...)
  RETURN mem
EXCEPT
  RETURN NIL
ENDPROC

OBJECT ecodehook OF hook
   priv[100]:ARRAY OF LONG
ENDOBJECT

-> Wraps an E function for use as an Utility hook
EXPORT PROC ECodeUtilHook(func, data)
   DEF h:PTR TO ecodehook
   NEW h
   h.subentry := func
   h.entry := {entry}
   h.data := data
ENDPROC h 

->EXPORT PROC InstallHook(hook, func)
->ENDPROC

entry:
ASM ' movem.l d2-d7/a2-a6,-(a7)'  -> save regs
ASM ' move.l  a0,-(a7)'           -> hook
ASM ' move.l  a2,-(a7)'           -> obj
ASM ' move.l  a1,-(a7)'           -> msg
ASM ' move.l  a4storage, a4'      -> reinstate a4
ASM ' lea.l   20(a0), a2'         -> a2space
ASM ' moveq.l #-1, d7'            -> clear exception
ASM ' move.l  12(a0),a0'          -> get sub-entry
ASM ' jsr     (a0)'               -> execute function
ASM ' movem.l (a7)+,d2-d7/a2-a6'  -> restore regs
ASM ' rts'                        -> return

start:
ASM
.function:
  dc.l 0
.storea4:
  dc.l 0
.a2space:
  dc.l 0
.entry:
  move.l .storea4(pc), a4      ;-> restore a4
  move.l .a2space(pc), a2
  move.l .function(pc), a6
  moveq.l #-1, d7
  jsr (a6)                         ;-> Call real function
  rts
ENDASM                       
end:



pStart:
ASM
.pfunction:
  dc.l 0
.pstorea4:
  dc.l 0
.a2space:
  dc.l 0
.pentry:
  movem.l d2-d7/a2-a6, -(a7)  ;-> preserve registers
  move.l .pstorea4(pc), a4    ; -> restore a4
  move.l .a2space(pc), a2
  move.l .pfunction(pc), a5
  moveq.l #-1, d7
  jsr (a5)                    ;-> call real function
  movem.l (a7)+, d2-d7/a2-a6  ;-> restore registers
  rts
ENDASM
pEnd:

-> aslhook
aStart:
ASM
.afunction:
  dc.l 0
.astorea4:
  dc.l 0
.a2space:
  dc.l 0
.aentry:
  lea .astack(pc), a0
  movem.l d2-d7/a1-a6, (a0)   ;-> preserve registers
  move.l .astorea4(pc), a4    ; -> restore a4
  move.l .afunction(pc), a6
  move.l .a2space(pc), a2

  move.l 4(a7), a0            ; swap 3 args
  move.l 8(a7), a1
  move.l 12(a7), d0
  move.l a0, -(a7)
  move.l a1, -(a7)
  move.l d0, -(a7)
  moveq.l #-1, d7
  jsr (a6)                    ;-> call real function
  lea .astack(pc), a0
  movem.l (a0), d2-d7/a1-a6   ;-> restore registers
  rts
.astack:
  dc.l 2,3,4,5,6,7,1,2,3,4,5,6,0
ENDASM
aEnd:

->cx/collision
cStart:
ASM
.cfunction:
  dc.l 0
.cstorea4:
  dc.l 0
.a2space:
  dc.l 0
.centry:
  lea .cstack(pc), a0
  movem.l d2-d7/a1-a6, (a0)   ;-> preserve registers

  move.l .cstorea4(pc), a4    ; -> restore a4
  move.l .cfunction(pc), a6
  move.l .a2space(pc), a2

  move.l 4(a7), a0            ; swap 2 args
  move.l 8(a7), a1
  move.l a0, -(a7)
  move.l a1, -(a7)
  moveq.l #-1, d7
  jsr (a6)                    ;-> call real function
  lea .cstack(pc), a0
  movem.l (a0), d2-d7/a1-a6   ;-> restore registers
  rts
.cstack:
  dc.l 2,3,4,5,6,7,1,2,3,4,5,6,0
ENDASM
cEnd:


hStart:
ASM
.hfunction:
  dc.l 0
.hstorea4:
  dc.l 0
.a2space:
  dc.l 0
.hentry:
  lea .hstack(pc), a0
  movem.l d2-d7/a2-a4, (a0)  ;-> preserve registers
  move.l .hstorea4(pc), a4   ; -> restore a4
  move.l .hfunction(pc), a0
  movem.l d1/a1, -(a7)       ;-> push d1 and a1 as arguments
  move.l .a2space(pc), a2
  moveq.l #-1, d7
  jsr (a0)                   ;-> call real function
  lea .hstack(pc), a0
  movem.l (a0), d2-d7/a2-a4  ;-> restore registers
  rts
.hstack:
  dc.l 2,3,4,5,6,7,2,3,4,0
ENDASM
hEnd:


sStart:
ASM
.sfunction:
 dc.l 0
.sstorea4:
 dc.l 0
.a2space:
 dc.l 0
.sentry:
 lea .sstack(pc), a0
 movem.l d2-d7/a2-a4, (a0) ;  -> preserve registers
 move.l .sstorea4(pc), a4  ;   -> restore a4
 move.l .sfunction(pc), a6
 move.l a1, -(a7)         ;   -> push a1 as an argument
 move.l .a2space(pc), a2
 moveq.l #-1, d7
 jsr (a6)                ;    -> call real function
 lea .sstack(pc), a0
 movem.l (a0), d2-d7/a2-a4 ;   -> restore registers
 move.l #$DFF000, a0  ;-> CUSTOMADDR
 tst.l d0 ;                    -> set z flag according to func result
 rts
.sstack:
 dc.l 2,3,4,5,6,7,2,3,4,0
ENDASM
sEnd:


iStart:
ASM
.ifunction:
  dc.l 0
.istorea4:
  dc.l 0
.a2space:
  dc.l 0
.ientry:
  lea .istack(pc), a0
  movem.l d2-d7/a2-a4/a6, (a0) ; -> preserve registers
  move.l .istorea4(pc), a4     ;  -> restore a4
  move.l .ifunction(pc), a6
  move.l a1, -(a7)             ; -> push a1 as an argument
  move.l .a2space(pc), a2
  moveq.l #-1, d7
  jsr (a6)                     ; -> call real function
  lea .istack(pc), a0
  movem.l (a0), d2-d7/a2-a4/a6 ; -> restore registers
  rts
.istack:
  dc.l 2,3,4,5,6,7,2,3,4,6,0
ENDASM
iEnd:


oStart:
ASM
.ofunction:
  dc.l 0
.ostorea4:
  dc.l 0
.a2space:
  dc.l 0
.oentry:
  move.l 4(a7), a0             ;-> swap 2 arguments
  move.l 8(a7), a1
  move.l a2, -(a7)            ; save a2
  move.l a0, -(a7)
  move.l a1, -(a7)
  move.l .ostorea4(pc), a4     ; -> restore a4
  move.l .ofunction(pc), a0
  move.l .a2space(pc), a2
  moveq.l #-1, d7
  jsr (a0)                          ;-> Call real function
  move.l (a7)+, a2              ; restore a2
  rts
ENDASM                       
oEnd: