LINKOBJECT

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

       -> YAEC Notes : compiled as external linklib.
       -> Function-names changed to start with upper-case.
       -> Alot changes in asm-parts, but still recogniseable.

RAISE "MEM" IF New()=NIL
  
-> 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
      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

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
  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
  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)
  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)

  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
  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
  jsr (a6)                   ;-> call real function
  lea .sstack(pc), a0
  movem.l (a0), d2-d7/a2-a4  ;-> restore registers
  move.l #CUSTOMADDR, a0     ;-> reset a0 to custom base
  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
  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
  jsr (a0)                          ;-> Call real function
  move.l (a7)+, a2              ; restore a2
  rts
ENDASM                       
oEnd: