summaryrefslogtreecommitdiff
path: root/programs/sub-suite/utils.s
blob: a66f036484d369a36eadd0057390524937aba54b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
; 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		; 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		; 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		; No, so preserve the nibble offset.
	lda #' '	; Add a space to the string buffer.
	jsr charcpy	;
	pla		; Get the nibble offset back.
	bra @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.w		; 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	;
	bra @loop	; Keep looping.
@end:
	ply.w		; 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.q		; 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.q		; Get the hex value back.
@loop:
	pha.q		; Preserve the hex value.
	and #$F		; Mask the lowest nibble.
	phy.w		; 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.w		; Get back the screen buffer position.
	pla.q		; 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.
	bra @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.
	bra @loop	; No, so print the next digit.
@isauto1:
	cpb #1		; Is auto digit count enabled?
	beq @end	; Yes, so we're done.
	bra @loop	; No, so keep printing more digits.
@end:
	rts		; End of print_hex.


strtoull:
	phy.w		; Preserve Y.
	sta f		; Save the base.
	and #0		; Reset A.
	tay		; Reset Y.
	sta.q valbuf	; Reset the value buffer.
@loop:
	lda (ptr3), y	; Get a character from the string.
	pha		; Preserve the character.
	jsr isdigit	; Is this character, a digit?
	pla		; Get the character back.
	bne @digit	; Yes, so extract the value from it.
	jsr tolower	; No, so convert the character to lowercase.
	pha		; Preserve the character.
	jsr islower	; Is this an alphabetical character?
	pla		; Get the character back.
	beq @end	; No, so we're done.
@alpha:
	sec		; Yes, so prepare for a non borrowing subtract.
	sbc #'a'-10	; Get the numeric value from this digit.
	bra @chkbase	; Check if the value matches the base.
@digit:
	sec		; Prepare for a non borrowing subtract.
	sbc #'0'	; Get the numeric value from this digit.
@chkbase:
	cmp f		; Does the value match the base?
	bcs @end	; No, so we're done.
@addval:
	tab		; Save the digit value.
	lda.q valbuf	; Get the value from the value buffer.
	mul f		; Multiply the value by the base.
	clc		; Prepare for a non carrying add.
	aab		; Add the digit value to the total value.
	sta.q valbuf	; Place the value in the value buffer.
	iny		; Increment the string index.
	bra @loop	; Keep looping.
@end:
	ply.w		; Get Y back.
	ldb #0		; Reset B.
	rts		; End of strtoull.


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.w		; 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.
	bra @loop	; Keep looping.
@end:
	tyx		; Return the length in X.
	ply.w		; 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.w		; 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.
	bra @loop	; Keep looping.

strcasecmp:
	ldb #1		; Set the second pointer
	jsr set_ptr	; to the passed pointer.
	deb		; Reset B.
	tba		; Reset A.
	phy.w		; 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		; Preserve the islong flag.
	pha		; 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		; Get the character of string 1 back.
	cab		; Is the character of both strings, the same?
	plb		; Get the islong flag back.
	bne cmpr	; No, so check if we're too short, or too long.
	iny		; Yes, so increment the index.
	bra @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.
	bra @end	; We are done.
@equ:
	lda #0		; Return 0.
	bra @end	; We are done.
@short:
	lda #$FF	; Return -1.
@end:
	ply.w		; 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.
	bra @end	; We are done.
@false:
	lda #0		; Return false.
@end:
	rts		; End of isdigit.

isxdigit:
	pha		; Preserve the character.
	jsr isdigit	; Is this character, a decimal digit?
	pla		; 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.
	bra @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.
	bra 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.
	bra @end	; We are done.
@false:
	lda #0		; Return false.
@end:
	rts		; End of isletter.


tolower:
	pha		; Preserve the character.
	jsr isupper	; Is this character, an uppercase character?
	pla		; 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		; Preserve the character.
	jsr islower	; Is this character, a lowercase character?
	pla		; 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.
	bra @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.
	stx a		; Reset the shift value.
@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.
	bra @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.
	bra @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.