; Utility subroutines for SuBAsm.

.org util_data
; Hex character table.
hex_char:
	.byte "0123456789ABCDEF"

; Compare, and return table for pre-tokens.
ptok_tab:
	.byte ".@:=+-><(),xy\"\'#;$%"
; Compare, and return table for isdelm.
dtab:
	.byte "\n,\"\' "
; Compare, and return table for isdelm2.
dtab2:
	.byte "),.+<>-=;\n"

.org utils

print_hi:
	and #0		; Reset A.
	sta idx3	; Clear the string index.
	lda #'$'	; Print the hex delimiter.
	jsr charcpy	;
	lda.q idx0	; Get the masked address.
	ldx #$10	; Set digit count to 16.
	jsr print_hex	; Print the address.
	lda.q hex_str	; Get the lower half of the string.
	sta.q strbuf+1	; Save it in the string buffer.
	lda.q hex_str+8	; Get the upper half of the string.
	sta.q strbuf+9	; Save it in the string buffer.
	ldx #$11	; Add 16 to the index.
	stx idx3	;
	lda #':'	; Print a colon.
	jsr charcpy	;
	lda # ' '	; Print a space.
	jsr charcpy	;
	rts		; End of print_hi.

print_lo:
	lda #0		; Reset A.
	sta idx3	; Clear the string index.
@loop:
	ldx #2		; Set digit count to 2.
	pha #1		; Preserve the nibble offset.
	jsr print_hex	; Print the low nibble offset.
	lda.w (ptr3)	; Get the two digits.
	jsr charcpy	; Copy the first digit.
	lsr #8		; Copy the next digit.
	jsr charcpy	;
	pla #1		; Get the nibble offset back.
	inc		; Increment the offset.
	cmp #$10	; Are we at the last offset?
	bcs @end	; Yes, so we're done.
@loop1:
	pha #1		; No, so preserve the nibble offset.
	lda #' '	; Add a space to the string buffer.
	jsr charcpy	;
	pla #1		; Get the nibble offset back.
	jmp @loop	; Keep looping.
@end:
	inx		; Increment the index by one.
	lda #0		; Null terminate the string buffer.
	sta strbuf, x	;
	tax		; Reset X.
	lda.d #strbuf	; Print the string buffer.
	jsr print_str	;
	rts		; End of print_lo.

print_chunk:
	ldx #0		; Reset X.
	phy #2		; Preserve the screen buffer index.
	txy		; Copy the byte index to it.
@loop:
	and #0		; Reset A.
	ldx #2		; Set the digit count to 2.
	lda (idx0), y	; Get the byte at that address.
	jsr print_hex	; Print the byte.
	lda.w (ptr3)	; Get the two digits.
	jsr charcpy	; Copy the first digit.
	lsr #8		; Copy the next digit.
	jsr charcpy	;
	iny		; Increment the byte index.
	cpy #$10	; Have we read 16 bytes?
	beq @end	; Yes, so we're done.
	lda #' '	; No, so add a soace to the string buffer.
	jsr charcpy	;
	jmp @loop	; Keep looping.
@end:
	ply #2		; Get the screen buffer index back.
	inx		; Increment the index by one.
	and #0		; Null terminate the string.
	sta strbuf, x	;
	tax		; Reset X.
	sta idx3	; Clear the string index.
	rts		; End of print_chunk.


print_hex:
	pha #8		; Preserve the hex value.
	and #0		; Reset A.
	ldb #1		; Set the second pointer
	lda.w #hex_char	; to the start of hex character table.
	jsr set_ptr	;
	inb		; Set the third pointer
	lda.d #hex_str	; to the end of hex string buffer.
	clc		; Do a non carrying add.
	adc #$10	;
	jsr set_ptr	;
	ldb #0		; Reset B.
	pla #8		; Get the hex value back.
@loop:
	pha #8		; Preserve the hex value.
	and #$F		; Mask the lowest nibble.
	phy #2		; Preserve the screen buffer position.
	tay		; Get the index for the hex digit.
	lda (ptr2), y	; Get the hex digit.
	dec ptr3	; Decrement the string pointer.
	sta (ptr3)	; Save the hex digit character in the string.
	ply #2		; Get back the screen buffer position.
	pla #8		; Get the hex value back.
@isauto:
	cpx #1		; Is the digit count less than one?
	bcc @auto	; Yes, so don't decrement the digit count.
	dex		; No, but was the digit count zero, when decremented?
	beq @end	; Yes, so we're done.
	jmp @next	; No, so get the next nibble.
@auto:
	ldb #1		; Enable auto digit count.
@next:
	lsr #4		; Is the next nibble, a zero?
	beq @isauto1	; Yes, so check if auto digit count is enabled.
	jmp @loop	; No, so print the next digit.
@isauto1:
	cpb #1		; Is auto digit count enabled?
	beq @end	; Yes, so we're done.
	jmp @loop	; No, so keep printing more digits.
@end:
	rts		; End of print_hex.


charcpy:
	ldx idx3	; Get the string index.
	sta strbuf, x	; Save it in the string buffer.
	inc idx3	; Increment the string index.
	rts		; End of charcpy.


strlen:
	ldb #1		; Set the second pointer
	jsr set_ptr	; to the passed pointer.
	deb		; Reset B.
	tba		; Reset A.
	tax		; Reset X.
	phy #2		; Preserve Y.
	txy		; Reset Y.
@loop:
	lda (ptr2), y	; Are we at the end of the string?
	beq @end	; Yes, so we're done.
	iny		; No, so increment the index.
	jmp @loop	; Keep looping.
@end:
	tyx		; Return the length in X.
	ply #2		; Get the preserved value back.
	rts		; End of strlen.


strcmp:
	ldb #1		; Set the second pointer
	jsr set_ptr	; to the passed pointer.
	deb		; Reset B.
	tba		; Reset A.
	phy #2		; Preserve Y.
	tay		; Reset Y.
@loop:
	ldb #0		; Set the islong flag to false.
	lda (ptr), y	; Are we at the end of the first string?
	beq cmpr	; Yes, so check if we're too short, or too long.
	ldb #1		; No, so set the islong flag to true.
	cmp (ptr2), y	; Is the character of both strings, the same?
	bne cmpr	; No, so check if we're too short, or too long.
	iny		; Yes, so increment the index.
	jmp @loop	; Keep looping.

strcasecmp:
	ldb #1		; Set the second pointer
	jsr set_ptr	; to the passed pointer.
	deb		; Reset B.
	tba		; Reset A.
	phy #2		; Preserve Y.
	tay		; Reset Y.
@loop:
	ldb #0		; Set the islong flag to false.
	lda (ptr), y	; Are we at the end of the first string?
	beq cmpr	; Yes, so check if we're too short, or too long.
	ldb #1		; No, so set the islong flag to true.
	jsr tolower	; Convert the character of string 1 to lowercase.
	phb #1		; Preserve the islong flag.
	pha #1		; Preserve the converted character.
	lda (ptr2), y	; Get the character of the second string.
	jsr tolower	; Convert the character of string 2 to lowercase.
	tab		; Place it in B.
	pla #1		; Get the character of string 1 back.
	cab		; Is the character of both strings, the same?
	plb #1		; Get the islong flag back.
	bne cmpr	; No, so check if we're too short, or too long.
	iny		; Yes, so increment the index.
	jmp @loop	; Keep looping.

cmpr:
	lda (ptr2), y	; Are we at the end of the second string?
	beq @islong	; Yes, so check the islong flag.
@isshort:
	lda (ptr), y	; No, but are we at the end of the first string?
	beq @short	; Yes, so return -1.
@islong:
	cpb #1		; Is the islong flag true?
	bne @equ	; No, so return 0.
@long:
	lda #1		; Yes, so return 1.
	jmp @end	; We are done.
@equ:
	lda #0		; Return 0.
	jmp @end	; We are done.
@short:
	lda #$FF	; Return -1.
@end:
	ply #2		; Get the preserved value back.
	rts		; End of strcmp.


isdigit:
	sec		; Prepare for a non carrying subtraction.
	sbc #'0'	; Subtract $30 from the passed character.
	and #$FF	; Make sure that we have only one byte.
	cmp #10		; Is the subtracted value, less than 10?
	bcs @false	; No, so return false.
@true:
	lda #1		; Yes, so return true.
	jmp @end	; We are done.
@false:
	lda #0		; Return false.
@end:
	rts		; End of isdigit.

isxdigit:
	pha #1		; Preserve the character.
	jsr isdigit	; Is this character, a decimal digit?
	pla #1		; Get the character back.
	bne @true	; Yes, so return true.
@alpha:
	sec		; No, so prepare for a non carrying subtract.
	ora #$20	; Convert it to lowercase.
	sbc #'a'	; Subtract $61 from the character.
	and #$FF	; Make sure that we have only one byte.
	cmp #6		; Is the subtracted value, less than 6?
	bcs @false	; No, so return false.
@true:
	lda #1		; Yes, so return true.
	jmp @end	; We are done.
@false:
	lda #0		; Return false.
@end:
	rts		; End of isxdigit.


isupper:
	sec		; Prepare for a non carrying subtraction.
	sbc #'A'	; Subtract $41 from the passed character.
	jmp isletter	; Check if it's less than 26.
islower:
	sec		; Prepare for a non carrying subtraction.
	sbc #'a'	; Subtract $61 from the passed character.
isletter:
	and #$FF	; Make sure that we have only one byte.
	cmp #26		; Is the subtracted value, less than 26?
	bcs @false	; No, so return false.
@true:
	lda #1		; Yes, so return true.
	jmp @end	; We are done.
@false:
	lda #0		; Return false.
@end:
	rts		; End of isletter.


tolower:
	pha #1		; Preserve the character.
	jsr isupper	; Is this character, an uppercase character?
	pla #1		; Get the character back.
	beq @end	; No, so we're done.
@lower:
	ora #$20	; Yes, so convert it to lowercase.
@end:
	rts		; End of tolower.


toupper:
	pha #1		; Preserve the character.
	jsr islower	; Is this character, a lowercase character?
	pla #1		; Get the character back.
	beq @end	; No, so we're done.
@upper:
	and #$5F	; Yes, so convert it to uppercase.
@end:
	rts		; End of toupper.


isdelm2:
	ldx #0		; Reset X.
@loop:
	ldb dtab2, x	; Get the compare value.
	beq @other	; We hit the end of the table, so check for the others.
	cab		; Are they the same?
	beq @r1		; Yes, so return 1.
	inx		; No, so increment the table index.
	jmp @loop	; Keep looping.
@other:
	ldx #0		; Reset X.
	cmp #0		; Is this a null terminator?
	beq @r1		; Yes, so return 1.
	cmp #'\t'	; No, but is it a tab?
	beq @r2		; Yes, so return 2.
	cmp #' '	; No, but is it a space?
	beq @r2		; Yes, so also return 2.
@r0:
	lda #0		; Return 0.
	rts		; End of isdelm2.
@r1:
	ldx #0		; Reset X.
	lda #1		; Return 1.
	rts		; End of isdelm2.
@r2:
	lda #2		; Return 2.
	rts		; End of isdelm2.


isdelm:
	ldx #0		; Reset X.
@loop:
	ldb dtab, x	; Get the compare value.
	beq @other	; We hit the end of the table, so check for the others.
	cab		; Are they the same?
	beq @rshft	; Yes, so return 1 << index.
	inx		; No, so increment the table index.
	jmp @loop	; Keep looping.
@other:
	ldx #0		; Reset X.
	cmp #0		; Is this a null terminator?
	beq @rshft	; Yes, so return 1.
	ldx #4		; No, so set the shift amount to 4.
	cmp #'\t'	; Is this a tab?
	beq @rshft	; Yes, so return 16.
	ldx #0		; No, so reset X.
@r0:
	lda #0		; Return 0.
	rts		; End of isdelm.
@rshft:
	stx a		; Save the shift value.
	ldx #0		; Reset X.
	lda #1		; Set up the bitshift.
	lsl a		; Return 1 << X.
	rts		; End of isdelm.


get_ptok:
	ldx #0		; Reset X.
	jsr tolower	; Conver the character to lowercase.
@loop:
	ldb ptok_tab, x	; Get the compare value.
	beq @other	; We hit the end of the table, so check for the others.
	cab		; Are they the same?
	beq @rtab	; Yes, so return X.
	inx		; No, so increment the table index.
	jmp @loop	; Keep looping.
@rtab:
	txa		; Return X.
	rts		; End of get_ptok.
@other:
	tab		; Preserve the character.
	jsr isdigit	; Is this character a digit?
	bne @rnum	; Yes, so return PTOK_NUM.
	tba		; No, so get the character back.
	jsr islower	; Is it an alphabetical character?
	bne @ralph	; Yes, so return PTOK_ALPH.
	lda #PTOK_OTHR	; No, so return PTOK_OTHR.
	rts		; End of get_ptok.
@rnum:
	lda #PTOK_NUM	; Return PTOK_NUM.
	rts		; End of get_ptok.
@ralph:
	lda #PTOK_ALPH	; Return PTOK_ALPH.
	rts		; End of get_ptok.