home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Fred Fish Collection 1.5
/
ffcollection-1-5-1992-11.iso
/
ff_progs
/
miscutil
/
xplor.lzh
/
XPLOR
/
MACROS.OPT
< prev
next >
Wrap
Text File
|
1991-08-16
|
13KB
|
669 lines
****************************************************************
* NOTES: Include this file where the subroutines are to go.
* This way, the subroutines and macros may be
* kept together in this file.
****************************************************************
*----- EQUATES -----*
AbsBase EQU 4
*-------------------*
SECTION CODE
IFD libs
XTRN OpenLibrary
XTRN CloseLibrary
*************************************************
* Leave program after closing all open libraries
*************************************************
exit MACRO ;leave program with return code \1
move.l \1,d2
jmp do.close
ENDM
*******************************************
* Open all libraries specified by USE macro
*******************************************
dolibs MACRO
jsr do.libs
ENDM
*************************************************
* Miscellaneous macros called by EXIT and DOLIBS
*************************************************
openlib MACRO ;opens an individual library
lea \1,a1 ;name of library
bsr openit
move.l d0,\2 ;store pointer
ENDM
closelib MACRO
move.l \1,a1 ;pointer to library
bsr closeit
ENDM
setlib MACRO
move.l \1,a6 ;pointer to library
ENDM
********************************
* Open all pertinent libraries
********************************
CNOP 0,4
do.libs
IFD doslib
openlib dosname,dos
beq exitlib
ENDC
IFD intlib
openlib intname,int
beq exitlib
ENDC
IFD gfxlib
openlib gfxname,gfx
beq exitlib
ENDC
IFD dfontlib
openlib dfontname,dfont
beq exitlib
ENDC
IFD clistlib
openlib clistname,clist
beq exitlib
ENDC
IFD layerslib
openlib layersname,layers
beq exitlib
ENDC
IFD ffplib
openlib ffpname,ffp
ENDC
IFD translib
openlib transname,trans
ENDC
IFD mathdoublib
openlib doublename,double
ENDC
IFD speechlib
openlib speechname,speech
ENDC
IFD iconlib
openlib iconname,icon
ENDC
exitlib rts
************************************************************************
* Close all libraries.
* NOTE: JSR to this routine if you want to close all libraries and do
* some more stuff in the main program.
* If you want to leave the progam, use the 'exit' MACRO, and
* call with a return code, ie. EXIT 0 ;(good return)
************************************************************************
do.close
IFD doslib
tst.l dos
beq close1
closelib dos
close1
ENDC
IFD intlib
tst.l int
beq close2
closelib int
close2
ENDC
IFD gfxlib
tst.l gfx
beq close3
closelib gfx
close3
ENDC
IFD dfontlib
tst.l dfont
beq close4
closelib dfont
close4
ENDC
IFD clistlib
tst.l clist
beq close5
closelib clist
close5
ENDC
IFD layerslib
tst.l layers
beq close6
closelib layers
close6
ENDC
IFD ffplib
tst.l ffp
beq close7
closelib ffp
close7
ENDC
IFD translib
tst.l trans
beq close8
closelib trans
close8
ENDC
IFD mathdoublib
tst.l double
beq close9
closelib double
close9
ENDC
IFD speechlib
tst.l speech
beq close10
closelib speech
close10
ENDC
IFD iconlib
tst.l icon
beq close11
closelib icon
close11
ENDC
move.l d2,d0
rts
***********************************
* Openit. Opens a library
************************************
openit clr.l d0
move.l AbsBase,a6
call OpenLibrary(a6)
rts
****************************************************************
* Subroutine called by EXIT to close libraries.
* NOTE: Closes only those libraries that have been
* opened by your program.
****************************************************************
closeit move.l AbsBase,a6
call CloseLibrary(a6)
rts
ENDC ;libs
***********************************************************************
*
* binhex
*
* PURPOSE: Convert a binary value in a register to
* a hex ASCII string at the destination address
*
* ROUTINE TYPE: MACRO with SUBROUTINE
*
* SYNTAX: binhex source(long),destination
* binhexw source(word),destination
* binhexb source(byte),destination
*
* ENTRY CONDITIONS: None
*
* RETURNS: ASCII string in destination address
* NOTE: destination is 8 bytes long to hold string
* for any length (long, word, byte).
* Destination contains result padded with leading zeros.
*
* CHANGED: Nothing
*
* USAGE: binhex #label,address ;converts the address at label to
* ;string at address
* binhex label,address ;conv contents at label
*
* binhex #value,address ;convert immediate value
*
****************************************************************
IFD b2h
binhexb MACRO ;convert a single byte
clr.l d0
move.b \1,d0
lea \2,a0
jsr bin2hex
ENDM
binhexw MACRO ;convert 2 byte value
clr.l d0
move.w \1,d0
lea \2,a0
jsr bin2hex
ENDM
binhex MACRO ;convert 4 byte value
move.l \1,d0
lea \2,a0 ;address of destination
jsr bin2hex
ENDM
bin2hex move.l a0,-(sp)
move.l d2,-(sp) ;preserve d2
move.l #7,d2 ;count to d2
clr.l d1 ;conversion work register
bhloop rol.l #4,d0 ;get high order nybble to low order
move.b d0,d1 ;low order byte to d1
andi.b #$f,d1 ;isolate low order nybble
cmp.b #$0a,d1 ;digit or letter?
blt.s bhaddz ;branch if digit
add.b #'A'-'0'-$0A,d1 ;offset for letters
bhaddz add.b #'0',d1 ;convert to ASCII
move.b d1,(a0)+ ;store it and increment address
dbf d2,bhloop ;do 8 times
move.l (sp)+,d2 ;restore d2
move.l (a7)+,a0 ;restore a0
rts
ENDC ;b2h
**********************************************************************
*
* print, printz
*
* PURPOSE: Print a string
*
* ROUTINE TYPE: MACRO
*
* SYNTAX: print <string pointer>,<length of string>
* printz <pointer to NULL terminated string>
*
* ENTRY CONDITIONS: <setlib dos> required
* Must have screen handle in stdout
*
* RETURNS: None
*
* USAGE: print message,length
*
**********************************************************************
IFD prt
use scnnull ;include scan for null macro
print MACRO
move.l stdout,d1
move.l \1,d2 ;NOTE: Needs full addressing mode in args
move.l \2,d3
call Write(a6)
ENDM
printz MACRO ;print NULL terminated string
move.l stdout,d1
move.l \1,d2 ;address of string
move.l d2,a0 ;to a0 for calculation
bsr scanull ;count length to first NULL
call Write(a6)
ENDM
ENDC ;prt
IFD scnnull
scanull move.l #-1,d3 ;preset for proper count
scnuloop:
add.l #1,d3 ;count times through here
cmp.b #0,(a0)+ ;compare and increment
bne.s scnuloop ;go try next
rts ;or leave with count in d3 fo Write
ENDC
**********************************************************************
*
* copy
*
* PURPOSE: MACRO with SUBROUTINE
*
* ROUTINE TYPE: MACRO with SUBROUTINE
*
* SYNTAX: copyb <source address>,<dest address>
*
* USAGE: copyb label,label2,#length (addressing mode passed for length)
*
**********************************************************************
IFD copy
copyb MACRO
lea \1,a0
lea \2,a1
move.l \3,d0
jsr docopy
ENDM
docopy subq.l #1,d0
coploop move.b 0(a0,d0),0(a1,d0)
dbf d0,coploop
rts
ENDC
**********************************************************************
*
* instr
*
* PURPOSE: MACRO with SUBROUTINE
*
* ROUTINE TYPE: MACRO with SUBROUTINE
*
* SYNTAX: instr <address of string>,<address of string>,terminator
*
* ENTRY CONDITIONS: None
*
* RETURNS: D0 = position of string 1 in string2
* or -1 if string1 not in string2
*
* USAGE: instr string1,string2,13 ;terminator is C/R
* cmp.b #-1,d0
* beq nomatch ;string1 not in string2
* move.l d0,position ;save position if needed
*
**********************************************************************
IFD ins
use sln
use scm
instr MACRO
move.l \1,a0 ;string 1
move.l \2,a1 ;string 2
move.l #\3,d0 ;terminator
jsr instrn
ENDM
instrn movem.l d1/a0-a1,-(sp) ;preserve addresses and d1
pushl a1 ;for later calculation of position
move.l d0,d1 ;terminator to d1
inloop bsr.s strcomp ;go check for match
beq.s isin ;got a match
adda.l #1,a1 ;adjust string 2 address
cmp.b -1(a1),d0 ;check for terminator
bne.s inloop ;go try again
isntin move.l #-1,d0 ;-1 indicates str1 not in str2
popl a1 ;adjust stack
bra.s insexit ;leave
isin move.l a1,d0 ;final address of a1 to d0
popl a1 ;initial address of a1 to a1
sub.l a1,d0 ;calculate position of str1 in str2
insexit movem.l (sp)+,d1/a0-a1 ;restore stack (gruesome results otherwise)
rts ;that's it
ENDC ;ins
**********************************************************************
*
* cmpstr
*
* PURPOSE: compare two strings
*
* ROUTINE TYPE: MACRO with subroutine
*
* SYNTAX: cmpstr <address of string>,<address of string>,terminator
*
* ENTRY CONDITIONS: None
*
* RETURNS: D0 = terminator if strings compare up to terminator
* first non comparing character of first operand
* A1 = address of first non comparing character in 2nd operand
*
* USAGE: cmpstr string1,string2,' ' ;space is end of string
* bne nocompare ;strings differ
* cmp d0,(a1) ;check for terminator in string1
* beq samestrings ;strings are identical
* bne substringok ;string1 is a substring of string2
*
* NOTE: This routine is a fairly general one, and may be used in many
* ways. If the lengths of the string are not known, you might
*
*
*
**********************************************************************
IFD scm
strcmp MACRO
lea \1,a0 ;address of first string
lea \2,a1 ;address of second string
move.l #\3,d1 ;terminator
jsr strcomp ;do compare
ENDM
strcomp movem.l d1/a0-a1,-(sp) ;preserve addresses
cmloop move.b (a0)+,d0 ;get byte of first string
cmp.b d0,d1 ;check for terminator
beq.s cmprtn ;branch if terminator (substring compares)
;perhaps entire string
cmp.b (a1)+,d0 ;compare to byte of second string
beq.s cmloop ;OK.. check next byte
cmprtn movem.l (sp)+,d1/a0-a1 ;restore addresses
rts
ENDC ;scm
**********************************************************************
*
* strlen
*
* PURPOSE: To find the length of a string.
*
* ROUTINE TYPE: MACRO and SUBROUTINE
*
* SYNTAX: strlen <address of string>,terminator
*
* ENTRY CONDITIONS: None
*
* RETURNS: D0 = length of string
*
* USAGE: strlen string,0 ;0 is terminator, can be any value
* move.l d0,lengthvar ;store the length if needed
*
**********************************************************************
IFD sln
strlen MACRO
lea \1,a0
move.b #\2,d0
jsr slen
ENDM
slen move.l a0,a1
slnloop cmp.b (a0)+,d0
bne slnloop
sub.l a1,a0
move.l a0,d0
subq.l #1,d0
rts
ENDC ;sln
**********************************************************************
*
* regdata
*
* PURPOSE: Dump all registers to screen
*
* ROUTINE TYPE: SUBROUTINE
*
* SYNTAX: jsr regdump
*
* ENTRY CONDITIONS: None
*
* RETURNS: Dumps all regs (a0-a7, d0-d7) to screen
*
* USAGE: jsr regdump
*
**********************************************************************
IFD dbug
regdata dc.b ' D0: '
d0d dc.b '00000000 '
dc.b ' D1: '
d1d dc.b '00000000 '
dc.b ' D2: '
d2d dc.b '00000000 '
dc.b ' D3: '
d3d dc.b '00000000',10
dc.b ' D4: '
d4d dc.b '00000000 '
dc.b ' D5: '
d5d dc.b '00000000 '
dc.b ' D6: '
d6d dc.b '00000000 '
dc.b ' D7: '
d7d dc.b '00000000',10,10
dc.b ' A0: '
a0d dc.b '00000000 '
dc.b ' A1: '
a1d dc.b '00000000 '
dc.b ' A2: '
a2d dc.b '00000000 '
dc.b ' A3: '
a3d dc.b '00000000',10
dc.b ' A4: '
a4d dc.b '00000000 '
dc.b ' A5: '
a5d dc.b '00000000 '
dc.b ' A6: '
a6d dc.b '00000000 '
dc.b ' A7: '
a7d dc.b '00000000',10,10
endump EQU *-regdata
CNOP 0,4
regdump movem.l d0-d7/a0-a7,-(sp)
popl d0
binhex d0,d0d
popl d0
binhex d0,d1d
popl d0
binhex d0,d2d
popl d0
binhex d0,d3d
popl d0
binhex d0,d4d
popl d0
binhex d0,d5d
popl d0
binhex d0,d6d
popl d0
binhex d0,d7d
popl d0
binhex d0,a0d
popl d0
binhex d0,a1d
popl d0
binhex d0,a2d
popl d0
binhex d0,a3d
popl d0
binhex d0,a4d
popl d0
binhex d0,a5d
popl d0
binhex d0,a6d
popl d0
binhex d0,a7d
rts
shoregs print regdata,#endump
rts
ENDC
**********************************************************************
*
* leadspace
*
* PURPOSE: replace ASCII zeros with spaces
*
* ROUTINE TYPE: MACRO with SUBROUTINE
*
* SYNTAX: ldspc stringaddr,terminator
*
* ENTRY CONDITIONS: String must be terminated with anything but
* an ASCII '0' ($30)
*
* RETURNS: address of first non '0' (ASCII) byte
*
* USAGE: ldspc buffer
*
**********************************************************************
IFD leadspc
ldspc MACRO
move.l #\1,a0 ;string address
bsr doldspc
ENDM
doldspc cmp.b #'0',(a0)
bne endldspc
move.b #' ',(a0)+
bra doldspc
endldspc:
rts
ENDC
**********************************************************************
NOTES: The routines contained in this file were written to make things
easier for me. They may not be to your liking, in which case you are
invited to change them to suit your own way of looking at things. In
any case, please feel free to use them in any way you see fit.
Larry Phillips, CIS - 76703,4322