keep	obj/util
	mcopy util.mac
****************************************************************
*
*  Util
*
*  This module contains general purpose utility subroutines
*  used throughout the editor.  It also contains utility
*  subroutines used by both linker passes.
*
****************************************************************
	copy	directPage
****************************************************************
*
*  CheckAlign - make sure the alignment is a power of 2
*
*  Inputs:
*	align - alignment factor
*
****************************************************************
*
CheckAlign start
count	equ	1	bit count

	sub	(4:align),2

	cmpl	align,#$10001	if align > $10000 then
	blt	lb0
	ph4	#0	  flag the error (alignment too large)
	ph2	#25
	jsr	Error
	
lb0	stz	count	count the bits
	ldx	#32
lb1	lsr	align+2
	ror	align
	bcc	lb2
	inc	count
lb2	dex
	bne	lb1
	lda	count	if count <> 1 then
	cmp	#1
	beq	lb3
	ph4	#0	  flag the error
	ph2	#23
	jsr	Error

lb3	ret
	end

****************************************************************
*
*  Error - Writes segment error messages
*
*  Inputs:
*	name - pointer to the symbol name; nil for none
*	num - error number
*
****************************************************************
*
Error	start
	using Common
temp	equ	1	temp work number
lpc	equ	5	local copy of the program counter

	sub	(4:name,2:num),8

	ldx	dpReg	get the program counter
	lda	>pc,X
	sta	lpc
	lda	>pc+2,X
	sta	lpc+2
	inc	numError	up the error count
	lda	list
	bne	lb1
	putcr errout=t
lb1	puts	#'Error at ',errout=t	print error info
	sub4	lpc,startpc,temp
	ph4	temp
	ph2	#8
	ph2	#1
	jsr	PrintHex
	puts	#' past ',errout=t
	sub4	segName,#1,temp
	puts	[temp],errout=t
	puts	#' PC = ',errout=t
	ph4	lpc
	ph2	#8
	ph2	#1
	jsr	PrintHex
	puts	#' : ',errout=t

	ldx	num	set the error level
	lda	erLev-1,X
	and	#$00FF
	cmp	merrf
	blt	ls3
	sta	merrf
ls3	lda	num	write the error message
	dec	A
	asl	A
	tax
	lda	erAdr,X
	sta	temp
	lda	#^er1
	sta	temp+2
	puts	[temp],errout=t
	lda	name	print segment name if any
	ora	name+2
	beq	ls6
	ldx	num
	cpx	#8
	bne	ls4
	puts	#' Data area: ',errout=t
	bra	ls5
ls4	puts	#' Label: ',errout=t
ls5	sub4	name,#1,temp
	puts	[temp],errout=t
ls6	putcr errout=t
	lda	pause	see if we need to pause on error
	beq	ls7
	jsr	Wait
ls7	ret
;
;  Local data
;
erLev	dc	I1'8,16,16,2'
	dc	I1'16,8,16,2'
	dc	I1'8,8,8,4'
	dc	I1'4,16,2,8'
	dc	I1'8,4,4,8'
	dc	I1'8,8,8,8'
	dc	I1'8'

erAdr	dc	a'er1-1'
	dc	a'er2-1'
	dc	a'er3-1'
	dc	a'er4-1'
	ds	2
	dc	a'er6-1'
	dc	a'er7-1'
	dc	a'er8-1'
	dc	a'er9-1'
	dc	a'er10-1'
	dc	a'er11-1'
	dc	a'er12-1'
	dc	a'er13-1'
	ds	2
	dc	a'er15-1'
	dc	a'er16-1'
	dc	a'er17-1'
	dc	a'er18-1'
	dc	a'er19-1'
	dc	a'er20-1'
	dc	a'er21-1'
	dc	a'er22-1'
	dc	a'er23-1'
	dc	a'er24-1'
	dc	a'er25-1'

er1	dw	'Duplicate label'
er2	dw	'Illegal shift operator'
er3	dw	'ORG location has been passed'
er4	dw	'Duplicate segment'
er6	dw	'Unresolved reference'
er7	dw	'Addressing error'
er8	dw	'Data area not found'
er9	dw	'Address is not in zero page'
er10	dw	'Address is not in current bank'
er11	dw	'Relative address out of range'
er12	dw	'Temporg not supported'
er13	dw	'Illegal {KeepType} shell variable'
er15	dw	'Segment types conflict'
er16	dw	'Invalid operation on relocatable expression'
er17	dw	'Only JSL can reference dynamic segment'
er18	dw	'Code exceeds code bank size'
er19	dw	'Illegal {AuxType} shell variable'
er20	dw	'Shift operator is not allowed on JSL to dynamic segment'
er21	dw	'Alignment and ORG conflict'
er22	dw	'Alignment factor must not exceed segment align factor'
er23	dw	'Alignment factor must be a power of two'
er24	dw	'Expression operand is not in same segment'
er25	dw	'Alignment factor is too large'
	end

****************************************************************
*
*  Free - free memory allocated by Malloc
*
*  Inputs:
*	ptr - address of the parameter block
*
*  Notes:
*	No action is taken if a nil pointer is passed.
*
*	This subroutine must be called in long mode.
*
****************************************************************
*
Free	start

	sub	(4:ptr),0

	lda	ptr
	ora	ptr+2
	beq	rts
	pha
	pha
	ph4	ptr
	_FindHandle
	_DisposeHandle
rts	ret
	end

****************************************************************
*
*  MLalloc - allocate memory
*
*  Inputs:
*	len - # of bytes to allocate
*
*  Outputs:
*	X-A - pointer to allocated memory
*
*  Notes:
*	Flags a terminal error and quits if there is not
*	emough memory.
*
*	This subroutine must be called in long mode.
*
****************************************************************
*
MLalloc	start
	using Common
ptr	equ	1	pointer to memory
hand	equ	5	handle of memory

	sub	(4:len),8

	pha		reserve the memory
	pha
	ph4	len
	ph2	userID
	ph2	#$C010
	ph4	#0
	_NewHandle
	pl4	hand	pull the handle
	bcc	lb1	branch if there was an error
	lda	#5
	jmp	TermError
lb1	ldy	#2	dereference the handle
	lda	[hand],Y
	sta	ptr+2
	lda	[hand]
	sta	ptr

	ret	4:ptr	return
	end

****************************************************************
*
*  CheckForPause - pause if a key was pressed; check for abort
*
****************************************************************
*
CheckForPause start
	using Common

	short I,M
	lda	>keyboard	see if we need to pause
	bpl	no	branch if not
	sta	>strobe	yes - clear strobe
	and	#$7F
	cmp	#'.'	quit if is an open apple .
	bne	lb1
	lda	>kflags
	bmi	yes

lb1	lda	>keyboard	wait for keypress
	bpl	lb1
	sta	>strobe
	and	#$7F
	cmp	#'.'	quit if is an open apple .
	bne	no
	lda	>kflags
	bmi	yes
no	long	I,M
	rts

yes	long	I,M	quit
	lda	#15
	jmp	TermError
	end

****************************************************************
*
*  PrintHex - print a hex number
*
*  Inputs:
*	val - hex value
*	digits - number of digits to print
*	errout - error out flag
*
****************************************************************
*
PrintHex start
temp	equ	1	temp work value

	sub	(4:val,2:digits,2:errout),4

	lda	digits	if digits <> 1 then
	cmp	#1
	beq	lb1
	move4 val,temp	  PrintHex(val>>4, digits-1)
	lsr	temp+2
	ror	temp
	lsr	temp+2
	ror	temp
	lsr	temp+2
	ror	temp
	lsr	temp+2
	ror	temp
	ph4	temp
	lda	digits
	dec	A
	pha
	ph2	errout
	jsr	PrintHex
lb1	lda	val	print a hex digit
	and	#$000F
	ora	#'0'
	cmp	#'9'+1
	blt	lb2
	adc	#6
lb2	sta	temp
	lda	errout
	bne	lb3
	putc	temp
	bra	lb4
lb3	putc	temp,errout=t
lb4	anop

	ret
	end

****************************************************************
*
*  PrintOSString - print an os string
*
*  Inputs:
*	ptr - pointer to the string
*	errout - error output flag
*
****************************************************************
*
PrintOSString start
loop	equ	1	loop counter
char	equ	3	character to write

	sub	(4:ptr,2:errout),4

	lda	ptr
	ora	ptr+2
	beq	lb4
	lda	[ptr]
	beq	lb4
	sta	loop
	add4	ptr,#2

lb1	lda	[ptr]
	sta	char
	lda	errout
	bne	lb2
	putc	char
	bra	lb3
lb2	putc	char,errout=t
lb3	inc4	ptr
	dec	loop
	bne	lb1

lb4	ret
	end

****************************************************************
*
*  TermError - handle a terminal error
*
*  Inputs:
*	A - error number
*	fname - file name (used for file errors)
*
*  1: Could not open file <fname>
*  2: Must be an object file: <fname>
*  3: Linker version mismatch
*  4: Illegal header value in <fname>
*  5: Out of memory
*  6: File read error: <fname>
*  7: Could not overwrite existing file: <fname>
*  8: Undefined opcode in <file>
*  9: Expression too complex in <file>
* 10: Could not find library header in <file>
* 11: Invalid dictionary in <file>
* 12: File write error
* 13: Only one script file is allowed
* 14: Script error: link aborted
* 15: Stopped by open-apple .
*
****************************************************************
*
TermError start
	using Common

	pha		print the message leader
	puts	#'Terminal error: ',errout=t
	lda	dpReg	restore the default DP register
	tcd
	lda	1,S	print the message
	asl	A
	tax
	lda	#^msg
	pha
	lda	msg-2,X
	pha
	ph2	#1
	jsr	PrintOSString
	plx		if needed, print the file name
	lda	needFname-1,X
	and	#$00FF
	beq	lb1
	ph4	fname
	ph2	#1
	jsr	PrintOSString
lb1	putcr errout=t
	stz	lops	set lops to 0
	lda	#127	set max error found to 127
	sta	merrf
	lda	Sreg	restore the original stack reg
	tcs
	jmp	exit	exit
;
;  Local data
;
msg	dc	a'e1,e2,e3,e4,e5,e6,e7,e8,e9,e10,e11,e12,e13,e14,e15'

e1	dos	'Could not open file '
e2	dos	'Must be an object file: '
e3	dos	'Linker version mismatch'
e4	dos	'Illegal header value in '
e5	dos	'Out of memory'
e6	dos	'File read error: '
e7	dos	'Could not overwrite existing file'
e8	dos	'Undefined opcode in '
e9	dos	'Expression too complex in '
e10	dos	'Could not find library header in '
e11	dos	'Invalid dictionary in '
e12	dos	'File write error'
e13	dos	'Only one script file is allowed'
e14	dos	'Script error: link aborted'
e15	dos	'Stopped by open-apple .'

needFname dc	i1'1,1,0,1,0,1,0,1,1,1,1,0,0,0,0'
	end

****************************************************************
*
*  ToUpper - Convert to Upper-case
*
*  Inputs:
*	A - character to shift
*
*  Outputs:
*	A - upper-case character
*
*  Notes:
*	This subroutine can be called in long or short mode.
*
****************************************************************
*
ToUpper	start

	php
	long	M
	and	#$00FF
	cmp	#'a'
	blt	rts
	cmp	#'z'+1
	bge	rts
	adc	#'A'-'a'
rts	plp
	rts
	end

****************************************************************
*
*  Wait - Wait for a keypress
*
*  Notes:
*	Quits if the user presses open-apple .
*
****************************************************************
*
Wait	start
	using Common

	short I,M
wa1	lda	>keyboard	wait for keypress
	bpl	wa1
	sta	>strobe
	and	#$7F
	cmp	#'.'	quit if is an open apple .
	bne	wa2
	lda	>kflags
	bmi	abort
wa2	long	I,M
	rts

abort	long	I,M
	lda	#15
	jmp	TermError
	end