**************************************************************** 
* NOTES: Include this file where the subroutines are to go. 
*	 This way, the subroutines and macros may be 
*	 kept together in this file.
*
*        by Larry Phillips (1986)
*
****************************************************************

*----- EQUATES -----*

AbsBase	EQU	4

*-------------------*

	SECTION CODE

	IFD libs

	XTRN	OpenLibrary
	XTRN	CloseLibrary

****************************************************************
*
*  		openlib
*
* ROUTINE TYPE: MACRO with SUBROUTINE
*
* SYNTAX: openlib name,pointer
*	  name = address of library string name
*	  pointer = address to store returned library pointer
*
* ENTRY CONDITIONS: None
*
* RETURNS: Pointer to library in D0:  = 0 if unsuccessful
*	   Pointer to library in 'pointer'
*
* USAGE: openlib	dosname,dosbase
*        beq		errorexit
*
****************************************************************

exit	MACRO		;leave program with return code \1
	move.l	\1,d2
	jmp	do.close
	ENDM

dolibs	MACRO
	jsr	do.libs
	ENDM

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

****************************************************************
*
*  		closelib
*
* ROUTINE TYPE: MACRO with SUBROUTINE
*
* SYNTAX: closelib pointer
*	  pointer = address of library pointer
*
* ENTRY CONDITIONS: Must have previously used <openlib>
*
* RETURNS: None
*
* USAGE: closelib	dosbase
*
****************************************************************

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,destination
*
* ENTRY CONDITIONS: None
*
* RETURNS: ASCII string in destination address
*
* 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
	clr.l	d0
	move.b	\1,d0
	lea	\2,a0
	jsr	bin2hex
	ENDM

binhexw	 MACRO
	clr.l	d0
	move.w	\1,d0
	lea	\2,a0
	jsr	bin2hex
	ENDM

binhex	MACRO
	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
*
* PURPOSE: Print a string
*
* ROUTINE TYPE: MACRO
*
* SYNTAX: print <string pointer>,<length of string>
*
* ENTRY CONDITIONS: <setlib dos> required
*		    Must have screen handle in stdout
*
* RETURNS: None
*
* USAGE: print message,length
*
**********************************************************************

	IFD	prt
	use scnnull

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: 
*
* SYNTAX: 
*
* ENTRY CONDITIONS: 
*
* RETURNS: 
*
* USAGE: 
*
**********************************************************************

	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

**********************************************************************
*
*  		  doargs   ***** Not working ******
*
* PURPOSE: 
*
* ROUTINE TYPE: MACRO with SUBROUTINE
*
* SYNTAX: 
*
* ENTRY CONDITIONS: 
*
* RETURNS: 
*
* USAGE: 
*
**********************************************************************

	IFD	arg
doargs	MACRO
	clr.l	d0
	move.l	args,a0

arg6	cmp.b	#' ',(a0)	;space?
	bne.s	arg1		;no, try another
	move.b	#0,(a0)		;terminate string
	bra.s	arginc		;try next

arg1	cmp.b	#'"',(a0)
	bne.s	arg2		;not a quote, try another
	move.b	#0,(a0)		;zero out a quote

arg5	cmp.b	#'"'+(a0)	;look for the terminating quote
	bne.s	arg4		;look for linefeed
	move.l	#9,(a0)		;got terminating quote.. zero it
	bra.s	arg6		;go look at rest of args

arg4	cmp.b	#10,(a0)
	bne.s	arg5		;not linefeed, scan more


arg2	cmp.b	#10,(a0)
	bne.s	arg3		;Not LF, no more of importance
	move.b	#0,(a0)		;zero out LF
	bra.s	argdone

arg3	adda.l	#1,a0	
	
	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
**********************************************************************
*
*  		  title
*
* PURPOSE: 
*
* ROUTINE TYPE: MACRO with SUBROUTINE
*
* SYNTAX: 
*
* ENTRY CONDITIONS: 
*
* RETURNS: 
*
* USAGE: 
*
**********************************************************************
