mirror of https://github.com/GnoConsortium/gno.git
324 lines
12 KiB
Plaintext
324 lines
12 KiB
Plaintext
|
|
;
|
|
; Copyright (C) Kopriha Software, 1990 - 1991
|
|
; All rights reserved.
|
|
; Licensed material -- property of Kopriha Software
|
|
;
|
|
; This software is made available solely pursuant to the terms
|
|
; of a Kopriha Software license agreement which governs its use.
|
|
;
|
|
;
|
|
; The following macros (port_routine/port_return) are support
|
|
; routines for IIGS port drivers.
|
|
;
|
|
;
|
|
; Macros: port_routine (<length>:<parm name>[,...])[,<work size>]
|
|
; - Enter a port driver routine
|
|
;
|
|
; port_return <length>:<return name>[,<completion routine>]
|
|
; - Exit a port driver routine
|
|
; - This macro must be followed by an RTL. By coding the
|
|
; macro this way you can customize the return (some, but
|
|
; not all port driver routines must return after a CMP #1.
|
|
; See the source to port.asm for the details).
|
|
;
|
|
;
|
|
; Note: These macros are derived from the csubroutine/creturn
|
|
; macros supplied with Orca/C (on the demos disk).
|
|
;
|
|
MACRO
|
|
&lab port_subroutine &parms,&work
|
|
&lab anop Places the label from macro invocation
|
|
aif c:&work,.a If there is a work parm goto .a
|
|
lclc &work Local define work a string
|
|
&work setc 0 Set work to zero
|
|
.a .a
|
|
gbla &totallen Global define totallen
|
|
gbla &worklen Global define worklen
|
|
gbla &PClen Global define length of PC
|
|
&worklen seta &work Set worklen = work (type conversion)
|
|
&totallen seta 0 Set totallen to zero
|
|
&PClen seta 8 Set PC length to 8 (6(rtnPC*2)+1(direct page)+1(data bank))
|
|
aif c:&parms=0,.e If there are no parms to routine then goto .e
|
|
lclc &len Local define char len
|
|
lclc &p Local define char p
|
|
lcla &i Local define int i
|
|
&i seta 1 i = 1
|
|
.b .b
|
|
&p setc &parms(&i) p = parms[i]
|
|
&len amid &p,2,1 len = substr(p,2,1)
|
|
aif "&len"=":",.c if len == ':' goto .c
|
|
&len amid &p,1,2 len = substr(p,1,2) {First 2 chars}
|
|
&p amid &p,4,l:&p-3 p = substr(p,4,strlen(p)-3) {get name}
|
|
ago .d goto .d
|
|
.c .c
|
|
&len amid &p,1,1 len = substr(p,1,1) {only first char}
|
|
&p amid &p,3,l:&p-2 p = substr(p,3,strlen(p)-2) {get name}
|
|
.d .d We have a name and its length
|
|
&p equ &totallen+&PClen+&work {name} equ totallen+PClen+work
|
|
&totallen seta &totallen+&len totallen = totallen+len (length of parm)
|
|
&i seta &i+1 i = i + 1
|
|
aif &i<=c:&parms,^b if i<#parms goto b (backwards goto)
|
|
.e .e All parms setup (equ'd)
|
|
tsc get stack pointer
|
|
aif &work=0,.f If you need work space...
|
|
sec add it onto the stack pointer
|
|
sbc #&work
|
|
tcs
|
|
.f Stack is setup by here...
|
|
phd Save the direct page
|
|
tcd Set direct page == stack ptr
|
|
mend Thus lda parm is a direct page reference...
|
|
|
|
MACRO
|
|
&lab port_return &returnparm,&comproutine
|
|
;
|
|
; Parse the return parameter (if defined).
|
|
;
|
|
&lab anop Place any label from macro invocation
|
|
lclc &len Local create len
|
|
aif c:&returnparm,.a If there is a parameter goto .a
|
|
lclc &returnparm Local create r (for parm length)
|
|
&returnparm setc 0 Set returnparm to zero
|
|
&len setc 0 Set len to zero
|
|
ago .h Goto skip arguement parsing
|
|
.a .a We have a parameter - parse it!
|
|
&len amid &returnparm,2,1 len = substr(r,2,1)
|
|
aif "&len"=":",.b if (len == ':') goto .b
|
|
&len amid &returnparm,1,2 len = substr(r,1,2)
|
|
&returnparm amid &returnparm,4,l:&returnparm-3 r = substr(r,4,strlen(r)-3)
|
|
ago .c goto .c
|
|
.b .b One character length...
|
|
&len amid &returnparm,1,1 len = substr(r,1,1)
|
|
&returnparm amid &returnparm,3,l:&returnparm-2 r = substr(3,1,strlen(r)-2)
|
|
;
|
|
; Get the return parameter - if we have something to
|
|
; return. The return parameter can be 2,4 or 10 bytes
|
|
; (IE: Word, Long or Sane #).
|
|
;
|
|
.c
|
|
aif &len=0,.h If len == 0 then skip this...
|
|
aif &len<>2,.d if len != 2 goto .d
|
|
ldy &returnparm LDY <parm name>
|
|
ago .h goto .h
|
|
.d .d Not length == 2
|
|
aif &len<>4,.e if length != 4 goto .e
|
|
ldx &returnparm+2 LDX <parm name>+2 (high byte)
|
|
ldy &returnparm LDY <parm name> (low byte)
|
|
ago .h goto .h
|
|
.e .e Not length == 4
|
|
aif &len<>10,.g if length != 10 (IE: Sane #) goto .g
|
|
ldx #^&returnparm LDX #^<parm name> (high byte)
|
|
ldy #&returnparm LDY #<parm name> (low byte)
|
|
&len setc 4 We're returning a pointer...len 4
|
|
ago .h goto .h
|
|
.g .g Not sane # (hehehe)
|
|
mnote 'Not a valid return length',16 Print error}
|
|
mexit Oops... stop here
|
|
;
|
|
; Setup the completion routine - if there is one.
|
|
;
|
|
.h
|
|
aif c:&comproutine=0,.m
|
|
;
|
|
; Ok, lets setup the completion routine JSR (but only if its not NIL)
|
|
;
|
|
stz cjmp&SYSCNT+1 Clear the completion routine address
|
|
stz cjmp&SYSCNT+2 (all three words of it...)
|
|
;
|
|
lda &comproutine
|
|
ora &comproutine+1 'OR' the other bits in...
|
|
beq compa&SYSCNT If its NIL, then return to our caller.
|
|
;
|
|
; Looks non-NIL to me. Setup the completion routine call and then do it.
|
|
; (Ug... self modifying code... Its the easy solution for now...)
|
|
;
|
|
lda &comproutine Get low 2 bytes
|
|
sta cjmp&SYSCNT+1 Save them in our JSR instruction
|
|
lda &comproutine+1 Get the high bytes (actually,
|
|
sta cjmp&SYSCNT+2 just the bank byte...)
|
|
compa&SYSCNT anop
|
|
;
|
|
; Setup the return parameters on the stack (if any)
|
|
;
|
|
.m
|
|
aif &len<>2,.k If return nothing, goto .j
|
|
sty &worklen+&totallen+&PClen-&len
|
|
.k
|
|
aif &len<>4,.j
|
|
stx &worklen+&totallen+&PClen-&len Store low byte
|
|
sty &worklen+&totallen+&PClen-&len+2 Store high byte
|
|
.j
|
|
;
|
|
; If the return PCs need to be moved, then lets move
|
|
; them... the determination is based on if we have
|
|
; to remove parameters from the stack.
|
|
; Note: The order of the moving these PCs is significant!
|
|
; We must move the PCs in the order coded... any other
|
|
; may cause the first store to overwrite part of the
|
|
; PCs before moving them.
|
|
;
|
|
aif &totallen=0,.i if no parms to port_routine, goto .i
|
|
aif &totallen-&len=0,.i No sense in moving PCs nowhere...
|
|
lda &worklen+6 Copy return PCs (both of them)
|
|
sta &worklen+&totallen+6-&len
|
|
lda &worklen+4
|
|
sta &worklen+&totallen+4-&len
|
|
lda &worklen+2
|
|
sta &worklen+&totallen+2-&len
|
|
.i
|
|
;
|
|
; If there is a possible completion routine, then
|
|
; generate the code to check if it actually exists
|
|
; and if it does then call it (jsl) - otherwise rtl.
|
|
;
|
|
aif c:&comproutine=0,.p
|
|
;
|
|
; Ok, lets go to the completion routine JSR (but only if its not NIL)
|
|
;
|
|
lda cjmp&SYSCNT+1 Is there a completion routine?
|
|
ora cjmp&SYSCNT+2 'OR' the rest of the address...
|
|
beq compb&SYSCNT If its NIL, then return to our caller.
|
|
.i
|
|
;
|
|
; Looks non-NIL to me. Setup the completion routine call and then do it.
|
|
; (Ug... self modifying code... Its the easy solution for now...)
|
|
;
|
|
clc Clear carry - no errors on this call
|
|
lda #0 (Also need zero in ac for no error!)
|
|
cjmp&SYSCNT jsr >123456 Jmp to the completion routine
|
|
compb&SYSCNT anop (Jsl would come back to a rtl, may as well just go there)
|
|
.p
|
|
;
|
|
; If we have to then it is time to adjust the stack pointer
|
|
; (also get the direct page/data bank restored for our caller)
|
|
;
|
|
pld Restore the direct page
|
|
plb Restore the data bank
|
|
aif &worklen+&totallen-&len=0,.o If we aren't changing the stack ptr
|
|
tsc Fix the stack pointer
|
|
clc ...
|
|
adc #&worklen+&totallen-&len ...
|
|
tcs ...
|
|
.o
|
|
clc Clear carry - no errors on this call
|
|
lda #0 (Also need zero in ac for no error!)
|
|
mend
|
|
|
|
;............................................................
|
|
;
|
|
; Push long (4 bytes) onto stack
|
|
;
|
|
; pushlong address - push contents of address
|
|
; pushlong address,x - push contents of address,x
|
|
; pushlong const,s - push contents of stack+const
|
|
; pushlong #address/const - push address or constant
|
|
; pushlong [zeropage],offset - push using indirect address
|
|
;...............................................................
|
|
MACRO
|
|
&lab pushlong &addr,&offset
|
|
&lab ANOP
|
|
LCLC &C
|
|
LCLC &REST
|
|
&C AMID &addr,1,1
|
|
AIF "&C"="#",.immediate
|
|
AIF "&C"="[",.zeropage
|
|
AIF C:&offset=0,.nooffset
|
|
AIF "&offset"="s",.stack
|
|
pushword &addr+2,&offset
|
|
pushword &addr,&offset
|
|
MEXIT
|
|
.nooffset
|
|
pushword &addr+2
|
|
pushword &addr
|
|
MEXIT
|
|
.immediate
|
|
&REST AMID &addr,2,L:&addr-1
|
|
dc I1'$F4',I2'(&REST)|-16'
|
|
dc I1'$F4',I2'&REST'
|
|
MEXIT
|
|
.stack
|
|
pushword &addr+2,s
|
|
pushword &addr+2,s
|
|
MEXIT
|
|
.zeropage
|
|
ldy #&offset+2
|
|
pushword &addr,y
|
|
ldy #&offset
|
|
pushword &addr,y
|
|
MEND
|
|
;...............................................................
|
|
;
|
|
; Push 3 bytes onto stack
|
|
;
|
|
; push3 addr -- pushes bytes onto stack from "loc"
|
|
; push3 addr,x -- pushes bytes onto stack from "loc,x"
|
|
; push3 #n -- pushes constant #n onto stack
|
|
;...............................................................
|
|
MACRO
|
|
&lab push3 &addr,®
|
|
&lab ANOP
|
|
LCLC &C
|
|
LCLC &REST
|
|
&C AMID &addr,1,1
|
|
&REST AMID &addr,2,L:&addr
|
|
AIF C:®>0,.indexed
|
|
AIF "&C"="#",.immediate
|
|
lda &addr+1
|
|
pha
|
|
AGO .a
|
|
.immediate
|
|
lda #(&REST)|-8
|
|
pha
|
|
.a
|
|
phb
|
|
lda &addr
|
|
sta 1,s
|
|
MEXIT
|
|
.indexed
|
|
lda &addr+1,®
|
|
pha
|
|
phb
|
|
lda &addr,®
|
|
sta 1,s
|
|
MEND
|
|
;...............................................................
|
|
;
|
|
; Push 2 bytes onto stack
|
|
;
|
|
; pushword loc -- pushes bytes onto stack from "loc"
|
|
; pushword loc,x -- pushes bytes onto stack from "loc,x"
|
|
; pushword #n -- pushes constant #n onto stack
|
|
; pushword -- pushes bytes onto stack (from A)
|
|
;...............................................................
|
|
MACRO
|
|
&lab pushword &SYSOPR
|
|
&lab ANOP
|
|
AIF C:&SYSOPR=0,.b
|
|
LCLC &C
|
|
&C AMID "&SYSOPR",1,1
|
|
AIF ("&C"="#").AND.(S:LONGA),.immediate
|
|
lda &SYSOPR
|
|
pha
|
|
MEXIT
|
|
.b
|
|
pha
|
|
MEXIT
|
|
.immediate
|
|
LCLC &REST
|
|
LCLA &BL
|
|
&BL ASEARCH "&SYSOPR"," ",1
|
|
AIF &BL>0,.a
|
|
&BL SETA L:&SYSOPR+1
|
|
.a
|
|
&REST AMID "&SYSOPR",2,&BL-2
|
|
dc I1'$F4',I2'&REST'
|
|
MEND
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|