1:
2: .setcpu "6502"
3:
4: ; .include "../asm6502.inc"
5: ASM_JMP = $4C
6: ASM_BIT2 = $24
7: ASM_BIT3 = $2C
8:
9: ; Flags of the 6502
10: A6502_FLAGS_N = $80 ; Negative
11: A6502_FLAGS_V = $40 ; oVerflow
12: A6502_FLAGS_R = $20 ; Reserved
13: A6502_FLAGS_B = $10 ; Break (only valid on stack after BRK/IRQ, otherwise 0)
14: A6502_FLAGS_D = $08 ; Decimal
15: A6502_FLAGS_I = $04 ; Interrupt
16: A6502_FLAGS_Z = $02 ; Zero
17: A6502_FLAGS_C = $01 ; Carry
18: ; .include "../petscii.inc"
19: ASC_LF = $0A
20: ASC_CR = $0D
21: ASC_RVS = $12
22: ASC_HOME = $13
23: ASC_INSDEL = $14
24:
25: ASC_LOWERCASE = $0E
26: ASC_UPPERCASE = $8E
27: ASC_DISALLOW_LOWERCASE = $08
28: ASC_ALLOW_LOWERCASE = $09
29:
30: ASC_CURSORLEFTRIGHT = $1D
31: ASC_CURSORUPDOWN = $11
32:
33: .if .defined(C64JAPAN)
34: ASC_PI = $B0
35: .else
36: ASC_PI = $DE
37: .endif
38:
39: KEY_NONE = $40
40: KEY_STOP = $03
41:
42: PETSCII_CRSR_RIGHT = $1D
43:
44: ; .include "../macros.inc"
45: ; htasc - set the hi bit on the last byte of a string for termination
46: ; (by Tom Greene)
47: .macro htasc str
48: .repeat .strlen(str)-1,I
49: .byte .strat(str,I)
50: .endrep
51: .byte .strat(str,.strlen(str)-1) | $80
52: .endmacro
53:
54: .macro htasc_floppy_error str
55: .byte .strat(str,0) | $80
56: .repeat .strlen(str)-2,I
57: .byte .strat(str,I + 1)
58: .endrep
59: .byte .strat(str,.strlen(str)-1) | $80
60: .endmacro
61:
62: ; For every token, a byte gets put into segment "DUMMY".
63: ; This way, we count up with every token. The DUMMY segment
64: ; doesn't get linked into the binary.
65: .macro init_token_tables
66: .segment "VECTORS"
67: TOKEN_ADDRESS_TABLE:
68: .segment "KEYWORDS"
69: TOKEN_NAME_TABLE:
70: .segment "DUMMY"
71: DUMMY_START:
72: .endmacro
73:
74: ; optionally define token symbol
75: ; count up token number
76: .macro define_token token
77: .segment "DUMMY"
78: .ifnblank token
79: token := <(*-DUMMY_START)+$80
80: .endif
81: .res 1; count up in any case
82: .endmacro
83:
84: ; lay down a keyword, optionally define a token symbol
85: .macro keyword key, token
86: .segment "KEYWORDS"
87: htasc key
88: define_token token
89: .endmacro
90:
91: ; lay down a keyword and an address (RTS style),
92: ; optionally define a token symbol
93: .macro keyword_rts key, vec, token
94: .segment "VECTORS"
95: .word vec-1
96: keyword key, token
97: .endmacro
98:
99: ; lay down a keyword and an address,
100: ; optionally define a token symbol
101: .macro keyword_addr key, vec, token
102: .segment "VECTORS"
103: .addr vec
104: keyword key, token
105: .endmacro
106:
107: .macro count_tokens
108: .segment "DUMMY"
109: NUM_TOKENS := <(*-DUMMY_START)
110: .endmacro
111:
112: .macro init_error_table
113: .segment "DUMMY"
114: DUMMY_START_ERROR:
115:
116: .segment "ERROR"
117: ERROR_MESSAGES:
118: .endmacro
119:
120: .ifdef CBM2_EXT_FILE_ERRORS
121: .macro define_error_token token
122: .segment "DUMMY"
123: .ifnblank token
124: token := <(*-DUMMY_START_ERROR + 1)
125: .endif
126: .res 1; count up in any case
127: .endmacro
128:
129: .macro define_error error, msg, addr
130: .segment "ERROR"
131: addr := *
132: htasc msg
133: define_error_token error
134: .endmacro
135:
136: .else
137: .macro define_error error, msg, addr
138: .segment "ERROR"
139: error := <(*-ERROR_MESSAGES)
140: htasc msg
141: .endmacro
142:
143: .endif
144:
145: ;---------------------------------------------
146: ; set the MSB of every byte of a string
147: .macro asc80 str
148: .repeat .strlen(str),I
149: .byte .strat(str,I)+$80
150: .endrep
151: .endmacro
152:
153:
154: ; .include "defines.inc"
155: ; .include "../c64/defines-c64vic20.inc"
156:
157: COMPUTER_UNKNOWN=0
158:
159: VIC20_GENERAL=COMPUTER_UNKNOWN + $10
160: VIC20_02=VIC20_GENERAL + 2
161: VIC20_06=VIC20_GENERAL + 6
162: VIC20_07=VIC20_GENERAL + 7
163:
164: C64_GENERAL=VIC20_GENERAL + $20
165: C64_01=C64_GENERAL + 1
166: C64_02=C64_GENERAL + 2
167: C64_03=C64_GENERAL + 3
168: C64_SX64=C64_GENERAL + 4
169: C64_4064=C64_GENERAL + 5
170: C64_GS=C64_GENERAL + 6
171:
172: .ifdef vic20
173: CompileComputer=VIC20_GENERAL + vic20
174: .elseif .defined(c64)
175: .if c64 = 4064
176: CompileComputer=C64_4064
177: .else
178: CompileComputer=C64_GENERAL + c64
179: .endif
180: .endif
181:
182: .ifdef sx64
183: CompileComputer=C64_SX64
184: c64 = sx64
185: .endif
186:
187: .ifdef c64gs
188: CompileComputer=C64_GS
189: c64 = c64gs
190: .endif
191:
192: .ifndef CompileComputer
193: CompileComputer=COMPUTER_UNKNOWN
194: .endif
195:
196: .macro FillCount count,filler
197: .repeat count
198: .ifblank filler
199: .byte DRIVEFILLER
200: .else
201: .byte filler
202: .endif
203: .endrep
204: .endmacro
205:
206: .macro FillUntil address,filler
207: FillCount address-*,filler
208: .endmacro
209:
210: .macro FillNOP count
211: FillCount count,$EA
212: .endmacro
213:
214: IEEE_LISTEN = $20 ; on ATN, with primary address
215: IEEE_TALK = $40 ; on ATN, with primary address
216: IEEE_OPEN = $60 ; on ATN, with secondary address
217: IEEE_CLOSE = $E0 ; on ATN, with primary address
218: IEEE_SECONDARY = $F0 ; on ATN, with secondary address
219:
220: IEEE_LOAD = IEEE_OPEN + 0
221: IEEE_SAVE = IEEE_OPEN + 1
222:
223: IEEE_UNLISTEN = IEEE_LISTEN + $1F
224: IEEE_UNTALK = IEEE_TALK + $1F
225:
226: STATUS_IEC_DEVICE_NOT_PRESENT = $80
227: STATUS_IEC_EOI = $40
228: STATUS_IEC_TIMEOUT_READ = $02
229: STATUS_IEC_TIMEOUT_WRITE = $01
230:
231: STATUS_VERIFY = $10
232:
233: STATUS_TAPE_EOT = $80
234: STATUS_TAPE_EOF = $40 ; not on LOAD and VERIFY
235: STATUS_TAPE_CHKSUM_ERR = $20
236: STATUS_TAPE_UNRECOVERABLE_READ_ERROR = $10
237: STATUS_TAPE_LONG_BLOCK = $08
238: STATUS_TAPE_SHORT_BLOCK = $04
239:
240:
241: TEXT_SHIFTRUNSTOP := TEXT_LOADRUN
242: END_TEXT_SHIFTRUNSTOP := END_TEXT_LOADRUN
243:
244: DEFAULT_COLOR := COL_BLUE
245:
246: .if CompileComputer=VIC20_02
247: DRIVEFILLER=$AA
248: CHECKSUM_E475=$D6
249: FILL_FFXX=$AA
250: BASIC_END := $E387
251: DEFAULT_VIA2_T1=$4289
252: .elseif CompileComputer=VIC20_06
253: DRIVEFILLER=$AA
254: CHECKSUM_E475=$41
255: FILL_FFXX=$FF
256: BASIC_END := $E387
257: DEFAULT_VIA2_T1=$4289
258: .elseif CompileComputer=VIC20_07
259: DRIVEFILLER=$AA
260: FILL_FFXX=$FF
261: CHECKSUM_E475=$E8
262: BASIC_END := $E387
263: DEFAULT_VIA2_T1=$4826
264: .endif
265:
266: CHKSUM_BF52 = $BF
267:
268: EDITOR_TAB = 11
269: EDITOR_COLS = 22
270: EDITOR_ROWS = 23
271:
272: EDITOR_MAX_COMBINED_ROWS = 4
273: ; .include "memory.inc"
274: ; .include "../basic/basic-memory.inc"
275: .segment "MEM_BASIC_ZP": zeropage
276:
277: zADRAY1: .res 2 ; $0003
278: zADRAY2: .res 2 ; $0005
279: zCHARAC: .res 1 ; $0007
280: zENDCHR: .res 1 ; $0008
281: zTRMPOS: .res 1 ; $0009
282: zVERCK: .res 1 ; $000A
283: zCOUNT: .res 1 ; $000B
284: zDIMFLG: .res 1 ; $000C
285: zVALTYP: .res 1 ; $000D
286: zINTFLG: .res 1 ; $000E
287: zGARBFL: .res 1 ; $000F
288: zINTALLOWED: .res 1 ; $0010 ; TODO
289: zSUBFLG: .res 1 ; $0011
290: zTANSGN: .res 1 ; $0012
291: z13: .res 1 ; $0013 ; TODO
292: zLINNUM: .res 2 ; $0014
293: zTEMPPT: .res 1 ; $0016
294: zLASTPT: .res 2 ; $0017
295: zTEMPST: .res 5 ; $0019
296: zCHANNL: .res 4 ; $001E
297: zINDEX: .res 2 ; $0022
298: zINDEX2: .res 2 ; $0024
299: zRESHO: .res 5 ; $0026
300: zTEMP_28 := zRESHO + 2 ; TODO
301: zTXTTAB: .res 2 ; $002B
302: zVARTAB: .res 2 ; $002D
303: zARYTAB: .res 2 ; $002F
304: zSTREND: .res 2 ; $0031
305: zFRETOP: .res 2 ; $0033
306: zFRESPC: .res 2 ; $0035
307: zMEMSIZ: .res 2 ; $0037
308: zCURLIN: .res 2 ; $0039
309: zOLDLIN: .res 2 ; $003B
310: zOLDTXT: .res 2 ; $003D
311: zDATLIN: .res 2 ; $003F
312: zDATPTR: .res 2 ; $0041
313: zINPPTR: .res 2 ; $0043
314: zVARNAM: .res 2 ; $0045
315: zVARPNT: .res 2 ; $0047
316: zFORPNT: .res 2 ; $0049
317: zVARTXT: .res 2 ; $004B
318: zOPMASK: .res 1 ; $004D
319: zTEMPF3: .res 5 ; $004E
320: zTEMP_50 := zTEMPF3 + 2 ; TODO
321: zFOUR6: .res 1 ; $0053
322: zJMPER: .res 3 ; $0054
323: zTEMPF1: .res 5 ; $0057
324: zTEMP_58 := zTEMPF1 + 1 ; TODO
325: zTEMP_5A := zTEMPF1 + 3 ; TODO
326: zTEMPF2: .res 5 ; $005C
327: zTEMP_5D := zTEMPF2 + 1 ; TODO
328: zTEMP_5E := zTEMPF2 + 2 ; TODO
329: zTEMP_5F := zTEMPF2 + 3 ; TODO
330: zTEMP_60 := zTEMPF2 + 4 ; TODO
331: zFAC: .res 7 ; $0061
332: zFACEXP := zFAC ; $0061
333: zFACHO := zFAC + 1 ; $0062
334: zFACSGN := zFAC + 5 ; $0066
335: zSGNFLG := zFAC + 6 ; $0067
336: zBITS: .res 1 ; $0068
337: zARG: .res 7 ; $0069
338: zARGEXP := zARG ; $0069
339: zARGHO := zARG + 1 ; $006A
340: zARGSGN := zARG + 5 ; $006E
341: zARISGN := zARG + 6 ; $006F
342: zFACOV: .res 1 ; $0070
343: zFBUFPT: .res 2 ; $0071
344: zCHRGET: .res 6 ; $0073
345: zCHRGOT: .res 7 ; $0079
346: zCHRGOT_SPACE: .res 11 ; $0080
347: zTXTPTR := zCHRGOT + 1 ; $007A
348: zRNDX: .res 5 ; $008B
349:
350: .segment "MEM_BASIC_ZP2": zeropage
351:
352: zASCWRK: .res 1 ; $00FF
353:
354: .segment "STACK"
355:
356: lSTACK: .res 256
357:
358: .segment "MEM_BASIC_DATA_0200"
359:
360: lBUF: .res 89
361: END_lBUF:
362:
363: .segment "MEM_BASIC_DATA_0300"
364:
365: lIERROR: .res 2
366: lIMAIN: .res 2
367: lICRNCH: .res 2
368: lIQPLOP: .res 2
369: lIGONE: .res 2
370: lIEVAL: .res 2
371: lSAREG: .res 1
372: lSXREG: .res 1
373: lSYREG: .res 1
374: lSPREG: .res 1
375:
376: .if CompileComputer >= C64_GENERAL
377: .segment "MEM_BASIC_USR"
378: .else
379: .segment "MEM_BASIC_USR": zeropage
380: .endif
381:
382: lUSRPOK: .res 1
383: lUSRADD: .res 2
384:
385: ;lVICSCN := $0400
386: ;lSPNTRN := $07F8
387:
388: CARTRIDGE := $A000
389: CART_RESET := CARTRIDGE + 0
390: CART_NMI := CARTRIDGE + 2
391: CART_MAGIC := CARTRIDGE + 4
392:
393:
394: ; .include "../vic-i.inc"
395: VICI_O_OriginX := 0 ; bit 6-0: screen origin X, 4 pixels granularity
396: VICI_B_OriginX_Interlace := $80 ; 1 = interlace mode on, 0 = non-interlace (not on all VIC-I)
397: VICI_B_OriginX_OriginX_Mask := $7F
398:
399: VICI_O_OriginY := 1 ; screen origin Y, 2 lines granularity
400:
401: VICI_O_VideoColumns := 2 ; number of video columns
402: VICI_B_VideoColumns_Mask := $7F ; videocolumns are given by this value
403: VICI_B_VideoColumns_ScreenMemoryB9 := $80 ; b9 of screen memory location; b13-b10 are at VICI_O_MemoryLocations
404:
405: VICI_O_03 := 3
406: VICI_O_04 := 4
407:
408: VICI_O_MemoryLocations := 5
409: VICI_B_MemoryLocations_ScreenMemB10B13 := $F0 ; b13-b10 of screen memory locaiton; b9 is at VICI_O_VideoColumns (b13 is inverted in the VIC20!)
410: VICI_B_MemoryLocations_CharMemB10B13 := $0F ; b13-b10 of character memory location (b13 is inverted in the VIC20!)
411:
412: VICI_O_06 := 6
413: VICI_O_07 := 7
414: VICI_O_08 := 8
415: VICI_O_09 := 9
416: VICI_O_0A := 10
417: VICI_O_0B := 11
418: VICI_O_0C := 12
419: VICI_O_0D := 13
420: VICI_O_0E := 14
421: VICI_O_0F := 15
422:
423: COL_BLACK = 0
424: COL_WHITE = 1
425: COL_RED = 2
426: COL_3 = 3
427: COL_CYAN = 4
428: COL_GREEN = 5
429: COL_BLUE = 6
430: COL_YELLOW = 7
431: COL_ORANGE = 8
432: COL_LIGHTORANGE= 9
433: COL_PINK = 10
434: COL_LIGHTCYAN = 11
435: COL_LIGHTPURPLE= 12
436: COL_LIGHTGREEN = 13
437: COL_LIGHTBLUE = 14
438: COL_LIGHTYELLOW= 15
439:
440: VIC := $9000
441: .if 0
442: VIC_00 := VIC + 0
443: VIC_01 := VIC + 1
444: VIC_02 := VIC + 2
445: VIC_03 := VIC + 3
446: VIC_04 := VIC + 4
447: VIC_05 := VIC + 5
448: VIC_06 := VIC + 6
449: VIC_07 := VIC + 7
450: VIC_08 := VIC + 8
451: VIC_09 := VIC + 9
452: VIC_0A := VIC + 10
453: VIC_0B := VIC + 11
454: VIC_0C := VIC + 12
455: VIC_0D := VIC + 13
456: VIC_0E := VIC + 14
457: VIC_0F := VIC + 15
458: .endif
459:
460: ; .include "../via.inc"
461: VIA_O_PB := 0
462: VIA_O_PA := 1
463: VIA_O_DDRB := 2
464: VIA_O_DDRA := 3
465: VIA_O_T1CL := 4
466: VIA_O_T1CH := 5
467: VIA_O_T1CLL := 6
468: VIA_O_T1CHL := 7
469: VIA_O_T2CL := 8
470: VIA_O_T2CH := 9
471: VIA_O_SR := 10
472: VIA_O_ACR := 11
473: VIA_O_PCR := 12
474: VIA_O_IFR := 13
475: VIA_O_IEC := 14
476: VIA_O_PA_NO_HS := 15
477:
478: VIA_IFR_B_CA2 := $01 ; cleared by read or write to PA
479: VIA_IFR_B_CA1 := $02 ; cleared by read or write to PA
480: VIA_IFR_B_SR := $04 ; cleared by read or write to SR
481: VIA_IFR_B_CB2 := $08 ; cleared by read or write to PB
482: VIA_IFR_B_CB1 := $10 ; cleared by read or write to PB
483: VIA_IFR_B_T2 := $20 ; cleared by read T2L or write T2H
484: VIA_IFR_B_T1 := $40 ; cleared by read T1L or write T1H
485: VIA_IFR_B_ANY := $80 ; cleared if all interrupts are cleared
486:
487: VIA_IER_B_CA2 := VIA_IFR_B_CA2
488: VIA_IER_B_CA1 := VIA_IFR_B_CA1
489: VIA_IER_B_SR := VIA_IFR_B_SR
490: VIA_IER_B_CB2 := VIA_IFR_B_CB2
491: VIA_IER_B_CB1 := VIA_IFR_B_CB1
492: VIA_IER_B_T2 := VIA_IFR_B_T2
493: VIA_IER_B_T1 := VIA_IFR_B_T1
494: VIA_IER_BW_SET := $80
495: VIA_IER_BW_UNSET := $00
496:
497: VIA_PCR_B_CA1_INPUT_POS_EDGE := $01 ; 1 = input on positive edge, 0 = input on negative edge
498: VIA_PCR_B_CA2_MASK := $0E
499: VIA_PCR_B_CA2_INPUT_NEG_CLEAR_ON_READ := $00
500: VIA_PCR_B_CA2_INPUT_NEG := $02
501: VIA_PCR_B_CA2_INPUT_POS_CLEAR_ON_READ := $04
502: VIA_PCR_B_CA2_INPUT_POS := $06
503: VIA_PCR_B_CA2_OUTPUT_HANDSHAKE := $08
504: VIA_PCR_B_CA2_OUTPUT_PULSE := $0A
505: VIA_PCR_B_CA2_OUTPUT_LOW := $0C
506: VIA_PCR_B_CA2_OUTPUT_HIGH := $0E
507: VIA_PCR_B_CB1_INPUT_POS_EDGE := $10 ; 1 = input on positive edge, 0 = input on negative edge
508: VIA_PCR_B_CB2_MASK := $E0
509: VIA_PCR_B_CB2_INPUT_NEG_CLEAR_ON_READ := $00
510: VIA_PCR_B_CB2_INPUT_NEG := $20
511: VIA_PCR_B_CB2_INPUT_POS_CLEAR_ON_READ := $40
512: VIA_PCR_B_CB2_INPUT_POS := $60
513: VIA_PCR_B_CB2_OUTPUT_HANDSHAKE := $80
514: VIA_PCR_B_CB2_OUTPUT_PULSE := $A0
515: VIA_PCR_B_CB2_OUTPUT_LOW := $C0
516: VIA_PCR_B_CB2_OUTPUT_HIGH := $E0
517:
518: VIA_ACR_B_PA_LATCH_ENABLE := $01
519: VIA_ACR_B_PB_LATCH_ENABLE := $02
520: VIA_ACR_B_SHIFT_MASK := $1C
521: VIA_ACR_B_SHIFT_DISABLED := $00
522: VIA_ACR_B_SHIFT_IN_T2 := $04
523: VIA_ACR_B_SHIFT_IN_PHI2 := $08
524: VIA_ACR_B_SHIFT_IN_EXTCLOCK_CB1 := $0C
525: VIA_ACR_B_SHIFT_FREERUNNING_T2 := $10
526: VIA_ACR_B_SHIFT_OUT_T2 := $14
527: VIA_ACR_B_SHIFT_OUT_PHI2 := $18
528: VIA_ACR_B_SHIFT_OUT_EXTCLOCK_CB1 := $1C
529: VIA_ACR_B_T2_CONTROL_PB6 := $20
530: VIA_ACR_B_T1_CONTROL_MASK := $C0
531: VIA_ACR_B_T1_CONTROL_ONESHOT := $00
532: VIA_ACR_B_T1_CONTROL_FREERUN := $40
533: VIA_ACR_B_T1_CONTROL_ONESHOT_PB7 := $80
534: VIA_ACR_B_T1_CONTROL_FREERUN_PB7 := $C0
535:
536: ; Alternative:
537: VIA_ACR_B_T1_CONTROL_ONETIME := $40
538: VIA_ACR_B_T1_CONTROL_PB7_OUTPUT := $80
539:
540: VIA1 := $9110
541: VIA1_PB := VIA1 + 0
542: VIA1_PA := VIA1 + 1
543: VIA1_DDRB := VIA1 + 2
544: VIA1_DDRA := VIA1 + 3
545: VIA1_T1CL := VIA1 + 4
546: VIA1_T1CH := VIA1 + 5
547: VIA1_T1CLL := VIA1 + 6
548: VIA1_T1CHL := VIA1 + 7
549: VIA1_T2CL := VIA1 + 8
550: VIA1_T2CH := VIA1 + 9
551: VIA1_SR := VIA1 + 10
552: VIA1_ACR := VIA1 + 11
553: VIA1_PCR := VIA1 + 12
554: VIA1_IFR := VIA1 + 13
555: VIA1_IEC := VIA1 + 14
556: VIA1_PA_NO_HS := VIA1 + 15
557:
558: VIA2 := $9120
559: VIA2_PB := VIA2 + 0
560: VIA2_PA := VIA2 + 1
561: VIA2_DDRB := VIA2 + 2
562: VIA2_DDRA := VIA2 + 3
563: VIA2_T1CL := VIA2 + 4
564: VIA2_T1CH := VIA2 + 5
565: VIA2_T1CLL := VIA2 + 6
566: VIA2_T1CHL := VIA2 + 7
567: VIA2_T2CL := VIA2 + 8
568: VIA2_T2CH := VIA2 + 9
569: VIA2_SR := VIA2 + 10
570: VIA2_ACR := VIA2 + 11
571: VIA2_PCR := VIA2 + 12
572: VIA2_IFR := VIA2 + 13
573: VIA2_IEC := VIA2 + 14
574: VIA2_PA_NO_HS := VIA2 + 15
575:
576: VIA2_PB_B_CASS_WRITE := $04
577: ; CASS READ on CA1
578: VIA2_PB_B_JOY3 := $80
579:
580: VIA1_PA_B_IEC_CLK_IN := $01
581: VIA1_PA_B_IEC_DATA_IN := $02
582: VIA1_PA_B_JOY0 := $04
583: VIA1_PA_B_JOY1 := $08
584: VIA1_PA_B_JOY2 := $10
585: VIA1_PA_B_LIGHTPEN := $20
586: VIA1_PA_B_CASS_SWITCH := $40
587: VIA1_PA_B_IEC_ATN_OUT := $80
588:
589: VIA1_PB_B_0 := $01
590: VIA1_PB_B_1 := $02
591: VIA1_PB_B_2 := $04
592: VIA1_PB_B_3 := $08
593: VIA1_PB_B_4 := $10
594: VIA1_PB_B_5 := $20
595: VIA1_PB_B_6 := $40
596: VIA1_PB_B_7 := $80
597:
598: COLORRAM := $9400
599:
600: IOBASE := VIA1
601:
602: FILE_KEYBOARD := 0
603: FILE_TAPE := 1
604: FILE_RS232 := 2
605: FILE_SCREEN := 3
606: FILE_IEC := 4
607:
608: KEY_SHIFTRUN := $83
609:
610: IEC_REG := VIA1_PA_NO_HS
611: ;IEC_DDR := VIA1_DDRA
612:
613: IEC_B_ATN_OUT := VIA1_PA_B_IEC_ATN_OUT
614: IEC_B_CLK_OUT := $02
615: IEC_B_DATA_OUT := $20
616: IEC_B_CLK_IN := VIA1_PA_B_IEC_CLK_IN
617: IEC_B_DATA_IN := VIA1_PA_B_IEC_DATA_IN
618:
619: IEC_REG_ATN_OUT := VIA1_PA_NO_HS
620: IEC_REG_DATA_CLK_OUT := VIA2_PCR
621: IEC_REG_DATA_CLK_IN := VIA1_PA_NO_HS
622:
623: IEC_TIMER_LO := VIA2_T2CL
624: IEC_TIMER_HI := VIA2_T2CH
625:
626: IEC_TIMER_FLAG_REG := VIA2_IFR
627: IEC_TIMER_FLAG_B := $20
628:
629: TAPE_REG := VIA1_PA_NO_HS
630: TAPE_DDR := VIA1_DDRA
631: TAPE_B_WRITE := $08
632: TAPE_B_SENSE := $40
633: TAPE_B_MOTOR_ON := $02
634: TAPE_B_MOTOR_ON_ALL := $0E
635: TAPE_B_MOTOR_OFF_AND := $FD
636: TAPE_B_MOTOR_OFF_OR := $0C
637:
638: TAPE_REG_WRITE := VIA2_PB
639: TAPE_REG_SENSE := VIA1_PA_NO_HS
640: TAPE_REG_MOTOR := VIA1_PCR
641: TAPE_REG_ICR := VIA2_IEC
642: TAPE_REG_ICR_B_CLEARALL := VIA_IER_BW_UNSET | $7F
643: TAPE_REG_ICR_B_CASSREAD := VIA_IER_BW_SET | VIA_IER_B_CA1
644: TAPE_REG_ICR_B_WR_TIMER := VIA_IER_BW_SET | VIA_IER_B_T2
645: TAPE_REG_ICR_B_SET_3 := VIA_IER_BW_SET | VIA_IER_B_T1
646: TAPE_REG_ICR_B_UNSET_3 := VIA_IER_BW_UNSET | VIA_IER_B_T1
647:
648: TAPE_TIMER1_LO := VIA2_T2CL
649: TAPE_TIMER1_HI := VIA2_T2CH
650: TAPE_TIMER2_LO := VIA2_T1CL
651: TAPE_TIMER2_HI := VIA2_T1CH
652: TAPE_TIMER1_CONST := $15
653:
654: KEYB_ROW := VIA2_PB
655: KEYB_COL := VIA2_PA
656: KEYB_COL_FOR_STOP := VIA2_PA_NO_HS
657:
658: KEYB_ROW_CTRL := $FB
659: KEYB_COL_CTRL := $FE
660: KEYB_ROW_STOP := $F7
661: KEYB_ROW_STANDARD := $F7
662: KEYB_CHECK_STOP := $FE
663:
664: RS232_REG_1 := VIA1_PB
665: RS232_REG_2 := VIA2_PB
666: RS232_TIMER_LO := VIA1_T1CL
667: RS232_TIMER_HI := VIA1_T1CH
668:
669: ; .include "../basic/basic2.inc"
670:
671: .segment "HEADER"
672:
673: BASIC_START:
674:
675: bRESTART:
676: .addr LE394
677: .addr LE37B
678: .byte "CBMBASIC"
679:
680: ; This is the table of the entry addresses of the various
681: ; BASIC commands. Every address is " - 1" as this table is
682: ; used in pushing the address onto the stack and perfoming
683: ; an RTS afterwards.
684:
685: .segment "VECTORS"
686:
687: .segment "KEYWORDS"
688:
689: CONFIG_FILE=1
690: CONFIG_CBM_ALL=1
691: CONFIG_2=1
692:
693: ; .include "token.s"
694:
695: .segment "VECTORS"
696:
697: bSTMDSP = TOKEN_ADDRESS_TABLE
698: bFUNDSP = UNFNC
699:
700:
701: ; This is the table of the BASIC functions.
702:
703: ; This is the table of the operands. Every entry consists
704: ; of 3 consecutive bytes: A first byte (@?) and the address
705: ; of the processing function ( - 1).
706:
707: bOPTAB = MATHTBL
708:
709: ;.segment "KEYWORDS"
710:
711: bRESLST = TOKEN_NAME_TABLE
712:
713: ; This is the list of the reserved words. Every word ends
714: ; with the last byte having bit 7 set.
715: ; The list ends with the last byte being 0.
716: ; The complete list is not allowed to exceed 256 byte!
717:
718: TokPi = $FF
719:
720:
721: .segment "ERROR"
722:
723: ; This is the table of error strings. Every entry ends with
724: ; bit 7 set.
725:
726: ErrTooManyFiles = 1
727: ErrFileOpen = 2
728: ErrFileNotOpen = 3
729: ErrFileNotFound = 4
730: ErrDeviceNotPresent = 5
731: ErrNotInputFile = 6
732: ErrNotOutputFile = 7
733: ErrMissingFileName = 8
734: ErrIllegalDeviceNumber = 9
735: ErrNextWithoutFor = 10
736: ErrSyntax = 11
737: ErrReturnWithoutGosub = 12
738: ErrOutOfData = 13
739: ErrIllegalQuantity = 14
740: ErrOverflow = 15
741: ErrOutOfMemory = 16
742: ErrUndefinedStatement = 17
743: ErrBadSubscript = 18
744: ErrRedimdArray = 19
745: ErrDivisionByZero = 20
746: ErrIllegalDirect = 21
747: ErrTypeMismatch = 22
748: ErrStringTooLong = 23
749: ErrFileData = 24
750: ErrFormulaTooComplex = 25
751: ErrCantContinue = 26
752: ErrUndefdFunction = 27
753: ErrVerify = 28
754: ErrLoad = 29
755: ErrBreak = 30
756:
757:
758: bERRTAB:
759: StrTooManyFiles:
760: htasc "TOO MANY FILES"
761: StrFileOpen:
762: htasc "FILE OPEN"
763: StrFileNotOpen:
764: htasc "FILE NOT OPEN"
765: StrFileNotFound:
766: htasc "FILE NOT FOUND"
767: StrDeviceNotPresent:
768: htasc "DEVICE NOT PRESENT"
769: StrNotInputFile:
770: htasc "NOT INPUT FILE"
771: StrNotOutputFile:
772: htasc "NOT OUTPUT FILE"
773: StrMissingFileName:
774: htasc "MISSING FILE NAME"
775: StrIllegalDeviceNumber:
776: htasc "ILLEGAL DEVICE NUMBER"
777: StrNextWithoutFor:
778: htasc "NEXT WITHOUT FOR"
779: StrSyntax:
780: htasc "SYNTAX"
781: StrReturnWithoutGosub:
782: htasc "RETURN WITHOUT GOSUB"
783: StrOutOfData:
784: htasc "OUT OF DATA"
785: StrIllegalQuantity:
786: htasc "ILLEGAL QUANTITY"
787: StrOverflow:
788: htasc "OVERFLOW"
789: StrOutOfMemory:
790: htasc "OUT OF MEMORY"
791: StrUndefinedStatement:
792: htasc "UNDEF'D STATEMENT"
793: StrBadSubscript:
794: htasc "BAD SUBSCRIPT"
795: StrRedimdArray:
796: htasc "REDIM'D ARRAY"
797: StrDivisionByZero:
798: htasc "DIVISION BY ZERO"
799: StrIllegalDirect:
800: htasc "ILLEGAL DIRECT"
801: StrTypeMismatch:
802: htasc "TYPE MISMATCH"
803: StrStringTooLong:
804: htasc "STRING TOO LONG"
805: StrFileData:
806: htasc "FILE DATA"
807: StrFormulaTooComplex:
808: htasc "FORMULA TOO COMPLEX"
809: StrCantContinue:
810: htasc "CAN'T CONTINUE"
811: StrUndefdFunction:
812: htasc "UNDEF'D FUNCTION"
813: StrVerify:
814: htasc "VERIFY"
815: StrLoad:
816: htasc "LOAD"
817:
818: ; This is the list of pointers into the error strings.
819:
820: bERRPTR:
821: .addr StrTooManyFiles
822: .addr StrFileOpen
823: .addr StrFileNotOpen
824: .addr StrFileNotFound
825: .addr StrDeviceNotPresent
826: .addr StrNotInputFile
827: .addr StrNotOutputFile
828: .addr StrMissingFileName
829: .addr StrIllegalDeviceNumber
830: .addr StrNextWithoutFor
831: .addr StrSyntax
832: .addr StrReturnWithoutGosub
833: .addr StrOutOfData
834: .addr StrIllegalQuantity
835: .addr StrOverflow
836: .addr StrOutOfMemory
837: .addr StrUndefinedStatement
838: .addr StrBadSubscript
839: .addr StrRedimdArray
840: .addr StrDivisionByZero
841: .addr StrIllegalDirect
842: .addr StrTypeMismatch
843: .addr StrStringTooLong
844: .addr StrFileData
845: .addr StrFormulaTooComplex
846: .addr StrCantContinue
847: .addr StrUndefdFunction
848: .addr StrVerify
849: .addr StrLoad
850: .addr StrBreak
851:
852: bOKK: .byte $0D,"OK",$0D,$00
853:
854: .segment "CODE"
855:
856: StrError:
857: .if CompileComputer >= C64_GENERAL
858: .byte ' '
859: .else
860: .byte $0D
861: .endif
862: .byte " ERROR"
863: .byte $00
864:
865: StrIn:
866: .byte " IN "
867: .byte $00
868:
869: StrReady:
870: .byte $0D,$0A
871: .byte "READY."
872: .byte $0D,$0A,$00
873:
874: StrCrBreak:
875: .byte $0D,$0A
876: StrBreak:
877: .byte "BREAK"
878: .byte $00
879:
880: .byte $A0 ; @?
881:
882: ; This routine tries to find a stack entry for a
883: ; previous "FOR" statement.
884: ;
885: ; Input:
886: ; zFORPNT/zFORPNT + 1:
887: ; Contans the variable name of the variable given
888: ; by the "NEXT" command.
889: ; If ANY for has to be closed, zFORPNT + 1 is 0.
890: ;
891: ; Output:
892: ; X:
893: ; contains a pointer into the stack page
894: ; where the "FOR entry" is located.
895: ;
896: ; Z:
897: ; Is set iff an entry has been found.
898: ; OR the stack has been exhausted.
899: ;
900: ; zFORPNT/zFORPNT + 1:
901: ; contains the variable name of the variable
902: ; being "NEXT"ed, even if no variable name
903: ; was given on input.
904: ;
905: ; Remarks:
906: ; This function is tricks as it also handles the
907: ; FOR, GOSUB and RETURN statements. @
908:
909: bFNDFOR:
910: tsx
911: inx
912: inx
913: inx
914: inx
915: @Loop:
916: ; first check if there is a "FOR entry"
917: lda lSTACK + 1,x
918: cmp #TokFor
919: bne @Ret ; no FOR entry, return with error
920:
921: ; check if the user asked for a specific variable
922: lda zFORPNT + 1
923: bne @TestVar ; yes, this, test this variable
924:
925: ; no variable name was given, just take the current
926: ; one out of the stack entry
927: lda lSTACK + 2,x
928: sta zFORPNT
929: lda lSTACK + 3,x
930: sta zFORPNT + 1
931:
932: ; now, test if the variable in the stack entry
933: ; is the right one.
934: ; If no variable is given, it will be the right one
935: ; as we just took that one out of the stack entry.
936: @TestVar:
937: cmp lSTACK + 3,x
938: bne @UnWind ; not the same, unwind the stack
939: lda zFORPNT
940: cmp lSTACK + 2,x
941: beq @Ret ; ok, we found the variable, quit.
942:
943: ; we have not found the variable. Unwind the stack,
944: ; that is, remove the current "FOR entry" and test
945: ; if there is another one before that.
946: @UnWind:
947: ; add 18 to the stack pointer to skip to the next entry
948: txa
949: clc
950: adc #18
951: tax
952:
953: ; if we did not reach the end of the stack, test the next entry
954: ; This one is a bit tricky. It only works as expected because
955: ; X has been incremented four times at the beginning of this
956: ; function.
957: bne @Loop
958:
959: @Ret: rts
960:
961:
962: bBLTU: jsr bREASON
963: sta zSTREND
964: sty zSTREND + 1
965:
966: ; Move memory around
967: ;
968: ; Input:
969: ; zTEMP_5F: Old begin
970: ; zTEMP_5A: Old end ( + 1)
971: ; zTEMP_58: New end ( + 1)
972: ;
973: ; Remark:
974: ; If both areas overlap, the new area has to be "above" the old one.
975: ;
976: MoveMem:
977:
978: @OldBegin = zTEMP_5F
979: @OldEndP1 = zTEMP_5A
980: @NewEndP1 = zTEMP_58
981:
982: ; calculate length of block to transfer
983: ; via subtracting Old begin from old end ( + 1).
984: ;
985: sec
986: lda @OldEndP1
987: sbc @OldBegin
988: sta zINDEX ; low byte of length into zIndex
989: tay ; and remember it in Y, too.
990: lda @OldEndP1 + 1
991: sbc @OldBegin + 1
992: tax ; now, the high byte of length is in X
993:
994: inx
995: tya ; check low byte of length
996: beq @SkipPartialPage ; is 0, thus, we do net have a partial page to process
997:
998: ; now, subtract "page hangover" (low byte of length to move)
999: ; from OldEndP1 and NewEndP1.
1000: ; This way, we process this "hangover" at first. Afterwards, only complete
1001: ; pages have to be processed.
1002:
1003: lda @OldEndP1
1004: sec
1005: sbc zINDEX
1006: sta @OldEndP1
1007: bcs @CalcNewEnd
1008: dec @OldEndP1 + 1
1009: sec
1010:
1011: @CalcNewEnd:
1012: lda @NewEndP1
1013: sbc zINDEX
1014: sta @NewEndP1
1015: bcs @ProcessNextPage
1016: dec @NewEndP1 + 1
1017: bcc @ProcessNextPage ; unconditional jump
1018: ; --------------------------
1019:
1020: @Loop:
1021: lda (@OldEndP1),y ; copy from old...
1022: sta (@NewEndP1),y ; ... to new location
1023: @ProcessNextPage:
1024: dey ; number of bytes to process in this page
1025: bne @Loop ; not zero? Then, copy memory.
1026:
1027: ; copy the "last" byte of each page separately
1028: lda (@OldEndP1),y
1029: sta (@NewEndP1),y
1030:
1031: @SkipPartialPage:
1032: ; decrement the page numbers of source and destination
1033: ; and check if we have more pages to process (x).
1034:
1035: dec @OldEndP1 + 1
1036: dec @NewEndP1 + 1
1037: dex
1038: bne @ProcessNextPage
1039: rts
1040:
1041:
1042: ; check if there is enough memory on the stack
1043: ;
1044: ; Input:
1045: ; A:
1046: ; Half of the number of bytes to check for
1047: ; (that is, the number of double bytes)
1048: ;
1049: ; Output:
1050: ; If this function returns, there is enough memory
1051: ; on the stack.
1052: ;
1053: ; Remark:
1054: ; If there is not enough memory on the stack, this
1055: ; function does not return, but outputs an "?OUT OF MEMORY ERROR"
1056: ;
1057: bGETSTK:
1058: ; first of all, calculate how much byte we would not
1059: asl a ; as we are checking for double-words, multiply with 2
1060: adc #$3E ; add a "security area" (@? Why $3E = 62)
1061: bcs bOMERR ; we overflowed, that is, it would not even fit into the 256 byte stack
1062: sta zINDEX ; remember the value
1063:
1064: ; now, check if the stack pointer is higher than what we just calculated
1065: tsx
1066: cpx zINDEX
1067: bcc bOMERR
1068: rts
1069:
1070: bREASON:
1071: cpy zFRETOP + 1
1072: bcc @Ret
1073: bne @LA412
1074: cmp zFRETOP
1075: bcc @Ret
1076:
1077: ; save zTMPF1 and zTMPF2 area onto the stack
1078:
1079: @SAVE_AREA_SIZE = zFACEXP - zTEMPF1
1080:
1081: @LA412: pha
1082: ldx #@SAVE_AREA_SIZE - 1
1083: tya
1084: @LA416: pha
1085: lda zTEMPF1,x
1086: dex
1087: bpl @LA416
1088:
1089: jsr bGARBAG
1090:
1091: ; restore the zTMPF1 and zTMPF2 area from the stack
1092: ldx #-(@SAVE_AREA_SIZE - 1)
1093: @LA421: pla
1094: sta zTEMPF1 + @SAVE_AREA_SIZE,x
1095: inx
1096: bmi @LA421
1097: pla
1098: tay
1099: pla
1100: cpy zFRETOP + 1
1101: bcc @Ret
1102: bne bOMERR
1103: cmp zFRETOP
1104: bcs bOMERR
1105: @Ret: rts
1106:
1107: bOMERR: ldx #ErrOutOfMemory
1108: bERROR: jmp (lIERROR) ; for the VIC - 20, this is a no-op
1109: ; for the C64, only proceed if bit 7
1110: ; of the error code is not set
1111:
1112: ; output a specific error message
1113: ;
1114: ; Input:
1115: ; X:
1116: ; The number of the error message
1117: ;
1118: ; Remark:
1119: ; After outputting the message, this function returns into
1120: ; the main BASIC loop. It never returns to its caller.
1121: ;
1122: ErrorOut:
1123: txa ; multiply the error number with 2
1124: asl a ; (this gives a pointer into the error text table)
1125: tax
1126: lda bERRPTR - 2,x ; Get the low byte
1127: sta zINDEX
1128: lda bERRPTR - 1,x ; and the high byte into zIndex/zIndex + 1
1129: sta zINDEX + 1
1130:
1131: jsr kCLRCHN ; clear channel, that is, output to the screen
1132:
1133: lda #0 ; make sure: we do not want to output LF after CR anymore
1134: sta z13
1135: jsr bCRDO ; output a CR
1136:
1137: jsr LAB45 ; output a question mark '?'
1138:
1139: ; now, output the text from the table
1140:
1141: ldy #0 ; start at the first character of the text
1142: @Loop: lda (zINDEX),y ; get the next character
1143: pha ; remember it
1144: and #$7F ; clear bit 7 (thus, make it printable)
1145: jsr LAB47 ; output the character
1146: iny ; proceed to the next character
1147: pla ; get back the remembered character
1148: bpl @Loop ; if bit 7 was not set, proceed to the next character
1149:
1150: jsr LA67A ; initialize stack pointers (hardware stack and string stack)
1151:
1152: ; output the text "error"
1153:
1154: lda #<StrError
1155: ldy #>StrError
1156:
1157: bERRFIN:jsr bSTROUT ; output the text given in A/Y.a
1158:
1159: ldy zCURLIN + 1 ; get high byte of current line (is $FF if in direct mode)
1160: iny
1161: beq bREADY ; it was $FF, thus, skip th next instruction
1162: jsr bINPRT ; output "in line XXX"
1163:
1164: bREADY: lda #<StrReady
1165: ldy #>StrReady
1166: jsr bSTROUT
1167: lda #$80 ; set the direct modus flag
1168: jsr kSETMSG
1169:
1170: bMAIN: jmp (lIMAIN) ; points to IMAIN normally
1171: IMAIN: jsr bINLIN
1172: stx zTXTPTR
1173: sty zTXTPTR + 1
1174: jsr zCHRGET
1175: tax
1176: beq bMAIN
1177: ldx #$FF ; set the line number to >= $FF00 = 65280 - as line numbers > 64999 are not allowed, this is a marker that no program is running currently
1178: stx zCURLIN + 1
1179: bcc bMAIN1
1180: jsr bCRUNCH
1181: jmp bGONE
1182: bMAIN1: jsr bLINGET
1183: jsr bCRUNCH
1184: bINSLIN:sty zCOUNT
1185:
1186: @58 = zTEMPF1 + 1
1187: @5A = zTEMPF1 + 3
1188:
1189: @5F = zTEMPF2 + 3
1190:
1191: jsr bFNDLIN
1192: bcc @LA4ED
1193: ldy #1
1194: lda (@5F),y
1195: sta zINDEX + 1
1196: lda zVARTAB
1197: sta zINDEX
1198: lda @5F + 1
1199: sta zINDEX2 + 1
1200: lda @5F
1201: dey
1202: sbc (@5F),y
1203: clc
1204: adc zVARTAB
1205: sta zVARTAB
1206: sta zINDEX2
1207: lda zVARTAB + 1
1208: adc #-1
1209: sta zVARTAB + 1
1210: sbc @5F + 1
1211: tax
1212: sec
1213: lda @5F
1214: sbc zVARTAB
1215: tay
1216: bcs @LA4D7
1217: inx
1218: dec zINDEX2 + 1
1219: @LA4D7:
1220: clc
1221: adc zINDEX
1222: bcc @LA4DF
1223: dec zINDEX + 1
1224: clc
1225: @LA4DF:
1226: lda (zINDEX),y
1227: sta (zINDEX2),y
1228: iny
1229: bne @LA4DF
1230: inc zINDEX + 1
1231: inc zINDEX2 + 1
1232: dex
1233: bne @LA4DF
1234: @LA4ED:
1235: jsr LA659
1236: jsr bLINKPRG
1237: lda lBUF
1238: beq bMAIN
1239: clc
1240: lda zVARTAB
1241: sta @5A
1242: adc zCOUNT
1243: sta @58
1244: ldy zVARTAB + 1
1245: sty @5A + 1
1246: bcc @LA508
1247: iny
1248: @LA508:
1249: sty @58 + 1
1250: jsr bBLTU
1251: lda zLINNUM
1252: ldy zLINNUM + 1
1253: sta lBUF - 2
1254: sty lBUF - 1
1255: lda zSTREND
1256: ldy zSTREND + 1
1257: sta zVARTAB
1258: sty zVARTAB + 1
1259: ldy zCOUNT
1260: dey
1261: @LA522:
1262: lda lBUF - 4,y
1263: sta (@5F),y
1264: dey
1265: bpl @LA522
1266: LA52A: jsr LA659
1267: jsr bLINKPRG
1268: jmp bMAIN
1269: bLINKPRG:
1270: lda zTXTTAB
1271: ldy zTXTTAB + 1
1272: sta zINDEX
1273: sty zINDEX + 1
1274: clc
1275: @LA53C:
1276: ldy #1
1277: lda (zINDEX),y
1278: beq @Ret
1279: ldy #4
1280: @LA544:
1281: iny
1282: lda (zINDEX),y
1283: bne @LA544
1284: iny
1285: tya
1286: adc zINDEX
1287: tax
1288: ldy #0
1289: sta (zINDEX),y
1290: lda zINDEX + 1
1291: adc #0
1292: iny
1293: sta (zINDEX),y
1294: stx zINDEX
1295: sta zINDEX + 1
1296: bcc @LA53C
1297: @Ret: rts
1298:
1299: bINLIN: ldx #0
1300: @LA562: jsr bCHIN
1301: cmp #ASC_CR
1302: beq @LA576
1303: sta lBUF,x
1304: inx
1305: cpx #END_lBUF - lBUF
1306: bcc @LA562
1307: ldx #ErrStringTooLong
1308: jmp bERROR
1309:
1310: @LA576: jmp bSTREND
1311:
1312: bCRUNCH:jmp (lICRNCH)
1313: LA57C: ldx zTXTPTR
1314: ldy #$04
1315: sty zGARBFL
1316: LA582: lda lBUF,x
1317: bpl @LA58E
1318: cmp #TokPi
1319: beq LA5C9
1320: inx
1321: bne LA582
1322: @LA58E:
1323: cmp #' '
1324: beq LA5C9
1325: sta zENDCHR
1326: cmp #'"'
1327: beq LA5EE
1328: bit zGARBFL
1329: bvs LA5C9
1330: cmp #'?'
1331: bne @LA5A4
1332: lda #TokPrint
1333: bne LA5C9
1334: @LA5A4:
1335: cmp #'0'
1336: bcc @LA5AC
1337: cmp #'<'
1338: bcc LA5C9
1339: @LA5AC:
1340: sty zFBUFPT
1341: ldy #0
1342: sty zCOUNT
1343: dey
1344: stx zTXTPTR
1345: dex
1346: LA5B6: iny
1347: inx
1348: LA5B8: lda lBUF,x
1349: sec
1350: sbc bRESLST,y
1351: beq LA5B6
1352: cmp #$80
1353: bne LA5F5
1354: ora zCOUNT
1355: LA5C7: ldy zFBUFPT
1356: LA5C9: inx
1357: iny
1358: sta lBUF - 5,y
1359: lda lBUF - 5,y
1360: beq LA609
1361: sec
1362: sbc #$3A ; ':' @?
1363: beq @LA5DC
1364: cmp #$49 ; DATA @?
1365: bne @LA5DE
1366: @LA5DC:
1367: sta zGARBFL
1368: @LA5DE:
1369: sec
1370: sbc #$55 ; REM @?
1371: bne LA582
1372: JDLA5E3:
1373: sta zENDCHR
1374: LA5E5: lda lBUF,x
1375: beq LA5C9
1376: cmp zENDCHR
1377: beq LA5C9
1378: LA5EE: iny
1379: sta lBUF - 5,y
1380: inx
1381: bne LA5E5
1382: LA5F5: ldx zTXTPTR
1383: inc zCOUNT
1384: @LA5F9: iny
1385: lda bRESLST - 1,y
1386: bpl @LA5F9
1387: lda bRESLST,y
1388: bne LA5B8
1389: lda lBUF,x
1390: bpl LA5C7
1391: LA609: sta lBUF - 3,y
1392: dec zTXTPTR + 1 ; = 1, this is (>(lBUF - 1))
1393: lda #<lBUF - 1
1394: sta zTXTPTR
1395: rts
1396:
1397: bFNDLIN:lda zTXTTAB
1398: ldx zTXTTAB + 1
1399: LA617: ldy #1
1400: sta zTEMP_5F
1401: stx zTEMP_5F + 1
1402: lda (zTEMP_5F),y
1403: beq @RetSuccess
1404: iny
1405: iny
1406: lda zLINNUM + 1
1407: cmp (zTEMP_5F),y
1408: bcc @Ret
1409: beq @LA62E
1410: dey
1411: bne @LA637
1412: @LA62E:
1413: lda zLINNUM
1414: dey
1415: cmp (zTEMP_5F),y
1416: bcc @Ret
1417: beq @Ret
1418: @LA637:
1419: dey
1420: lda (zTEMP_5F),y
1421: tax
1422: dey
1423: lda (zTEMP_5F),y
1424: bcs LA617
1425: @RetSuccess:
1426: clc
1427: @Ret: rts
1428:
1429: RetA641 = @Ret
1430:
1431: bSCRTCH:bne RetA641
1432: LA644: lda #0
1433: tay
1434: sta (zTXTTAB),y
1435: iny
1436: sta (zTXTTAB),y
1437: lda zTXTTAB
1438: clc
1439: adc #<2
1440: sta zVARTAB
1441: lda zTXTTAB + 1
1442: adc #>2
1443: sta zVARTAB + 1
1444:
1445: LA659: jsr bSTXPT
1446: lda #0
1447:
1448: bCLEAR: bne RetA68D
1449: LA660: jsr kCLALL
1450: LA663: lda zMEMSIZ
1451: ldy zMEMSIZ + 1
1452: sta zFRETOP
1453: sty zFRETOP + 1
1454: lda zVARTAB
1455: ldy zVARTAB + 1
1456: sta zARYTAB
1457: sty zARYTAB + 1
1458: sta zSTREND
1459: sty zSTREND + 1
1460: LA677: jsr bRESTOR
1461:
1462: LA67A: ldx #zTEMPST
1463: stx zTEMPPT
1464: pla
1465: tay
1466: pla
1467: ldx #-6
1468: txs ; Stackpointer to $01FA
1469: pha
1470: tya
1471: pha
1472: lda #0
1473: sta zOLDTXT + 1
1474: sta zINTALLOWED
1475: RetA68D:
1476: rts
1477:
1478: bSTXPT: clc
1479: lda zTXTTAB
1480: adc #<-1
1481: sta zTXTPTR
1482: lda zTXTTAB + 1
1483: adc #>-1
1484: sta zTXTPTR + 1
1485: rts
1486:
1487: bLIST: bcc LA6A4
1488: beq LA6A4
1489: cmp #TokMinus
1490: bne RetA68D
1491: LA6A4:
1492: jsr bLINGET
1493: jsr bFNDLIN
1494: jsr zCHRGOT
1495: beq @LA6BB
1496: cmp #TokMinus
1497: bne RetA641
1498: jsr zCHRGET
1499: jsr bLINGET
1500: bne RetA641
1501: @LA6BB:
1502: pla
1503: pla
1504: lda zLINNUM
1505: ora zLINNUM + 1
1506: bne LA6C9
1507: JDLA6C3:
1508: lda #-1
1509: sta zLINNUM
1510: sta zLINNUM + 1
1511: LA6C9: ldy #1
1512: sty zGARBFL
1513: lda (zTEMP_5F),y
1514: beq LA714
1515: jsr bSTOP
1516: JDLA6D4:
1517: jsr bCRDO
1518: iny
1519: lda (zTEMP_5F),y
1520: tax
1521: iny
1522: lda (zTEMP_5F),y
1523: cmp zLINNUM + 1
1524: bne @LA6E6
1525: cpx zLINNUM
1526: beq @LA6E8
1527: @LA6E6: bcs LA714
1528: @LA6E8: sty zFORPNT
1529: jsr LBDCD
1530: lda #' '
1531: LA6EF: ldy zFORPNT
1532: and #$7F
1533: LA6F3: jsr LAB47
1534: cmp #'"'
1535: bne LA700
1536: lda zGARBFL
1537: eor #$FF
1538: sta zGARBFL
1539: LA700: iny
1540: beq LA714
1541: lda (zTEMP_5F),y
1542: bne bQPLOP
1543: tay
1544: lda (zTEMP_5F),y
1545: tax
1546: iny
1547: lda (zTEMP_5F),y
1548: stx zTEMP_5F
1549: sta zTEMP_5F + 1
1550: bne LA6C9
1551: LA714:
1552: .if CompileComputer >= C64_GENERAL
1553: jmp ReadyVector
1554: .else
1555: jmp bREADY
1556: .endif
1557:
1558: bQPLOP: jmp (lIQPLOP)
1559: LA71A: bpl LA6F3
1560: cmp #TokPi
1561: beq LA6F3
1562: bit zGARBFL
1563: bmi LA6F3
1564: sec
1565: sbc #$7F
1566: tax
1567: sty zFORPNT
1568: ldy #$FF
1569: @LA72C:
1570: dex
1571: beq @LA737
1572: @LA72F:
1573: iny
1574: lda bRESLST,y
1575: bpl @LA72F
1576: bmi @LA72C
1577: @LA737:
1578: iny
1579: lda bRESLST,y
1580: bmi LA6EF
1581: jsr LAB47
1582: bne @LA737
1583:
1584: bFOR: lda #$80
1585: sta zINTALLOWED
1586: jsr bLET
1587: jsr bFNDFOR
1588: bne @LA753
1589: txa
1590: adc #$0F
1591: tax
1592: txs
1593: @LA753:
1594: pla
1595: pla
1596: lda #$09
1597: jsr bGETSTK
1598: jsr bDATAN
1599: clc
1600: tya
1601: adc zTXTPTR
1602: pha
1603: lda zTXTPTR + 1
1604: adc #0
1605: pha
1606: lda zCURLIN + 1
1607: pha
1608: lda zCURLIN
1609: pha
1610: lda #TokTo
1611: jsr LAEFF
1612: jsr LAD8D
1613: jsr bFRMNUM
1614: lda zFACSGN
1615: ora #$7F
1616: and zFACHO
1617: sta zFACHO
1618: lda #<@LA78B
1619: ldy #>@LA78B
1620: sta zINDEX
1621: sty zINDEX + 1
1622: jmp LAE43
1623:
1624: @LA78B:
1625: lda #<bFPTABL
1626: ldy #>bFPTABL
1627: jsr bMOVFM
1628: jsr zCHRGOT
1629: cmp #TokStep
1630: bne @LA79F
1631: jsr zCHRGET
1632: jsr bFRMNUM
1633: @LA79F:
1634: jsr bSIGN
1635: jsr LAE38
1636: lda zFORPNT + 1
1637: pha
1638: lda zFORPNT
1639: pha
1640: lda #TokFor
1641: pha
1642: bNEWSTT:jsr bSTOP
1643: lda zTXTPTR
1644: ldy zTXTPTR + 1
1645: cpy #>lBUF
1646: nop
1647: beq @LA7BE
1648: sta zOLDTXT
1649: sty zOLDTXT + 1
1650: @LA7BE:
1651: ldy #0
1652: lda (zTXTPTR),y
1653: bne LA807
1654:
1655: bCKEOL: ldy #2
1656: lda (zTXTPTR),y
1657: clc
1658: bne @LA7CE
1659: jmp LA84B
1660: @LA7CE:
1661: iny
1662: lda (zTXTPTR),y
1663: sta zCURLIN
1664: iny
1665: lda (zTXTPTR),y
1666: sta zCURLIN + 1
1667: tya
1668: adc zTXTPTR
1669: sta zTXTPTR
1670: bcc bGONE
1671: inc zTXTPTR + 1
1672:
1673: bGONE: jmp (lIGONE)
1674: LA7E4: jsr zCHRGET
1675: jsr bGONE3
1676: jmp bNEWSTT
1677: bGONE3: beq RetA82B
1678: LA7EF: sbc #TokEnd
1679: bcc @LA804
1680: cmp #TokTab - TokEnd
1681: bcs LA80E
1682: asl a
1683: tay
1684: lda bSTMDSP + 1,y
1685: pha
1686: lda bSTMDSP,y
1687: pha
1688: jmp zCHRGET
1689: @LA804:
1690: jmp bLET
1691:
1692: LA807: cmp #':'
1693: beq bGONE
1694: LA80B: jmp bSYNERR
1695:
1696: LA80E: cmp #TokGo - $80
1697: bne LA80B
1698: jsr zCHRGET
1699: lda #TokTo
1700: jsr LAEFF
1701: jmp bGOTO
1702: bRESTOR:sec
1703: lda zTXTTAB
1704: sbc #1
1705: ldy zTXTTAB + 1
1706: bcs LA827
1707: dey
1708: LA827: sta zDATPTR
1709: sty zDATPTR + 1
1710: RetA82B:
1711: rts
1712:
1713: bSTOP: jsr kSTOP
1714: bSTOP2: bcs LA832
1715: bEND: clc
1716: LA832: bne RetA870
1717: lda zTXTPTR
1718: ldy zTXTPTR + 1
1719: ldx zCURLIN + 1
1720: inx
1721: beq @LA849
1722: sta zOLDTXT
1723: sty zOLDTXT + 1
1724: lda zCURLIN
1725: ldy zCURLIN + 1
1726: sta zOLDLIN
1727: sty zOLDLIN + 1
1728: @LA849:
1729: pla
1730: pla
1731:
1732: LA84B: lda #<StrCrBreak
1733: ldy #>StrCrBreak
1734: bcc LA854
1735: jmp bERRFIN
1736:
1737: LA854:
1738: .if CompileComputer >= C64_GENERAL
1739: jmp ReadyVector
1740: .else
1741: jmp bREADY
1742: .endif
1743:
1744: bCONT: bne RetA870
1745: ldx #ErrCantContinue
1746: ldy zOLDTXT + 1
1747: bne @LA862
1748: jmp bERROR
1749:
1750: @LA862:
1751: lda zOLDTXT
1752: sta zTXTPTR
1753: sty zTXTPTR + 1
1754: lda zOLDLIN
1755: ldy zOLDLIN + 1
1756: sta zCURLIN
1757: sty zCURLIN + 1
1758: RetA870:
1759: rts
1760:
1761: bRUN: php
1762: lda #0
1763: jsr kSETMSG
1764: plp
1765: bne @LA87D
1766: jmp LA659
1767:
1768: @LA87D:
1769: jsr LA660
1770: jmp LA897
1771:
1772: bGOSUB: lda #3 ; we want to push 3 16 bit values on the stack
1773: jsr bGETSTK ; check for enough memory on stack
1774: lda zTXTPTR + 1
1775: pha
1776: lda zTXTPTR
1777: pha
1778: lda zCURLIN + 1
1779: pha
1780: lda zCURLIN
1781: pha
1782: lda #TokGosub
1783: pha
1784:
1785: LA897: jsr zCHRGOT
1786: jsr bGOTO
1787: jmp bNEWSTT
1788:
1789: bGOTO: jsr bLINGET
1790: jsr LA909
1791: sec
1792: lda zCURLIN
1793: sbc zLINNUM
1794: lda zCURLIN + 1
1795: sbc zLINNUM + 1
1796: bcs @LA8BC
1797: tya
1798: sec
1799: adc zTXTPTR
1800: ldx zTXTPTR + 1
1801: bcc @LA8C0
1802: inx
1803: bcs @LA8C0
1804: @LA8BC:
1805: lda zTXTTAB
1806: ldx zTXTTAB + 1
1807: @LA8C0:
1808: jsr LA617
1809: bcc LA8E3
1810: lda zTEMP_5F
1811: sbc #<1
1812: sta zTXTPTR
1813: lda zTEMP_5F + 1
1814: sbc #>0
1815: sta zTXTPTR + 1
1816: RetA8D1:
1817: rts
1818:
1819: bRETURN:bne RetA8D1
1820: lda #-1
1821: sta zFORPNT + 1
1822: jsr bFNDFOR
1823: txs
1824: cmp #TokGosub
1825: beq LA8EB
1826: ldx #ErrReturnWithoutGosub
1827: .byte ASM_BIT3
1828: LA8E3: ldx #ErrUndefinedStatement
1829: jmp bERROR
1830: LA8E8: jmp bSYNERR
1831: LA8EB: pla
1832: pla
1833: sta zCURLIN
1834: pla
1835: sta zCURLIN + 1
1836: pla
1837: sta zTXTPTR
1838: pla
1839: sta zTXTPTR + 1
1840:
1841: bDATA: jsr bDATAN
1842: LA8FB: tya
1843:
1844: JDLA8FC:
1845: clc
1846: adc zTXTPTR
1847: sta zTXTPTR
1848: bcc RetA905
1849: inc zTXTPTR + 1
1850: RetA905:
1851: rts
1852:
1853: bDATAN: ldx #':'
1854: .byte ASM_BIT3
1855: LA909: ldx #0 ; end of line
1856: stx zCHARAC
1857: ldy #0
1858: sty zENDCHR
1859: LA911:
1860: lda zENDCHR
1861: ldx zCHARAC
1862: sta zCHARAC
1863: JDLA917:
1864: stx zENDCHR
1865: @LA919:
1866: lda (zTXTPTR),y
1867: beq RetA905
1868: cmp zENDCHR
1869: beq RetA905
1870: iny
1871: cmp #'"'
1872: bne @LA919
1873: beq LA911
1874: ; ----------------
1875:
1876: bIF: jsr bFRMEVL
1877: jsr zCHRGOT
1878: cmp #TokGoto
1879: beq @LA937
1880: lda #TokThen
1881: jsr LAEFF
1882: @LA937:
1883: lda zFACEXP
1884: bne LA940
1885:
1886: bREM: jsr LA909
1887: beq LA8FB
1888: LA940: jsr zCHRGOT
1889: bcs @LA948
1890: jmp bGOTO
1891:
1892: @LA948:
1893: jmp bGONE3
1894:
1895: bONGOTO:jsr LB79E
1896: pha
1897: cmp #TokGosub
1898: beq LA957
1899: LA953: cmp #TokGoto
1900: bne LA8E8
1901: LA957: dec zFACHO + 3
1902: bne @LA95F
1903: pla
1904: jmp LA7EF
1905: @LA95F:
1906: jsr zCHRGET
1907: jsr bLINGET
1908: cmp #','
1909: beq LA957
1910: pla
1911: RetA96A:
1912: rts
1913:
1914: bLINGET:ldx #0
1915: stx zLINNUM
1916: stx zLINNUM + 1
1917: @LA971:
1918: bcs RetA96A
1919: sbc #'0' - 1
1920: sta zCHARAC
1921: lda zLINNUM + 1
1922: sta zINDEX
1923: cmp #>6400 ; interestingly, <6400 is 0.
1924: bcs LA953
1925: lda zLINNUM
1926: asl a
1927: rol zINDEX
1928: asl a
1929: rol zINDEX
1930: adc zLINNUM
1931: sta zLINNUM
1932: lda zINDEX
1933: adc zLINNUM + 1
1934: sta zLINNUM + 1
1935: asl zLINNUM
1936: rol zLINNUM + 1
1937: lda zLINNUM
1938: adc zCHARAC
1939: sta zLINNUM
1940: bcc @LA99F
1941: inc zLINNUM + 1
1942: @LA99F:
1943: jsr zCHRGET
1944: jmp @LA971
1945:
1946: bLET: jsr bPTRGET
1947: sta zFORPNT
1948: sty zFORPNT + 1
1949: lda #TokEqual
1950: jsr LAEFF
1951: lda zINTFLG
1952: pha
1953: lda zVALTYP
1954: pha
1955: jsr bFRMEVL
1956: pla
1957: rol a
1958: jsr LAD90
1959: bne bPUTSTR
1960: pla
1961: LA9C2: bpl bPTFLPT
1962:
1963: bPUTINT:jsr bROUND
1964: jsr bAYINT
1965: ldy #0
1966: lda zFACHO + 2
1967: sta (zFORPNT),y
1968: iny
1969: lda zFACHO + 3
1970: sta (zFORPNT),y
1971: rts
1972: bPTFLPT:jmp LBBD0
1973:
1974: bPUTSTR:pla
1975: LA9DA: ldy zFORPNT + 1
1976: cpy #>bTI ; is the variable TI$?
1977: bne bGETSPT
1978: jsr LB6A6
1979: bPUTTIM:cmp #6
1980: bne @LAA24
1981: ldy #0
1982: sty zFACEXP
1983: sty zFACSGN
1984: @LA9ED:
1985: sty zFBUFPT
1986: jsr @LAA1D
1987: jsr bMUL10
1988: inc zFBUFPT
1989: ldy zFBUFPT
1990: jsr @LAA1D
1991: jsr bMOVAF
1992: tax
1993: beq @LAA07
1994: inx
1995: txa
1996: jsr LBAED
1997: @LAA07:
1998: ldy zFBUFPT
1999: iny
2000: cpy #6
2001: bne @LA9ED
2002: jsr bMUL10
2003: jsr bQINT
2004: ldx zFACHO + 2
2005: ldy zFACHO + 1
2006: lda zFACHO + 3
2007: jmp kSETTIM
2008:
2009: @LAA1D:
2010: lda (zINDEX),y
2011: jsr zCHRGOT_SPACE
2012: bcc @LAA27
2013: @LAA24:
2014: jmp bIQERR
2015:
2016: @LAA27:
2017: sbc #'0' - 1 ; carry is already set!
2018: jmp LBD7E
2019:
2020: bGETSPT:ldy #2
2021: lda (zFACHO + 2),y
2022: cmp zFRETOP + 1
2023: bcc @LAA4B
2024: bne @LAA3D
2025: dey
2026: lda (zFACHO + 2),y
2027: cmp zFRETOP
2028: bcc @LAA4B
2029: @LAA3D:
2030: ldy zFACHO + 3
2031: cpy zVARTAB + 1
2032: bcc @LAA4B
2033: bne @LAA52
2034: lda zFACHO + 2
2035: cmp zVARTAB
2036: bcs @LAA52
2037: @LAA4B:
2038: lda zFACHO + 2
2039: ldy zFACHO + 3
2040: jmp @LAA68
2041:
2042: @LAA52:
2043: ldy #0
2044: lda (zFACHO + 2),y
2045: jsr LB475
2046: lda zTEMP_50
2047: ldy zTEMP_50 + 1
2048: sta zARISGN
2049: sty zFACOV
2050: jsr bMOVINS
2051: lda #<zFAC
2052: ldy #>zFAC
2053: @LAA68:
2054: sta zTEMP_50
2055: sty zTEMP_50 + 1
2056: jsr bFREFAC
2057: ldy #0
2058: lda (zTEMP_50),y
2059: sta (zFORPNT),y
2060: iny
2061: lda (zTEMP_50),y
2062: sta (zFORPNT),y
2063: iny
2064: lda (zTEMP_50),y
2065: sta (zFORPNT),y
2066: rts
2067:
2068: bPRINTN:jsr bCMD
2069: jmp LABB5
2070:
2071: bCMD: jsr LB79E
2072: beq @LAA90
2073: lda #','
2074: jsr LAEFF
2075: @LAA90:
2076: php
2077: stx z13
2078: jsr bCKOUT
2079: plp
2080: jmp bPRINT
2081:
2082: bSTRDON:jsr LAB21
2083:
2084: LAA9D: jsr zCHRGOT
2085:
2086: bPRINT: beq bCRDO
2087: LAAA2: beq RetAAE7
2088: cmp #TokTab
2089: beq LAAF8
2090: cmp #TokSpc
2091: clc
2092: beq LAAF8
2093: cmp #','
2094: beq bCOMPRT
2095: cmp #';'
2096: beq LAB13
2097: jsr bFRMEVL
2098: bVAROP: bit zVALTYP
2099: bmi bSTRDON
2100: jsr bFOUT
2101: jsr bSTRLIT
2102: jsr LAB21
2103: jsr bOUTSPC
2104: bne LAA9D
2105: bSTREND:lda #0
2106: sta lBUF,x
2107: ldx #<(lBUF - 1)
2108: ldy #>(lBUF - 1)
2109: lda z13
2110: bne RetAAE7
2111:
2112: ; output a CR and possibly a LF
2113: ;
2114: ; Input:
2115: ; none
2116: ;
2117: ; Remark:
2118: ; At first, this function outputs a CR ($0D). If z13 is negative,
2119: ; it outputs a LF afterwards.
2120: ;
2121: bCRDO: lda #ASC_CR ; output the CR
2122: jsr LAB47
2123: bit z13 ; check: Shall we output a LF?
2124: bpl LAAE5
2125: lda #ASC_LF ; yes, output the LF
2126: jsr LAB47
2127: LAAE5: eor #$FF
2128: RetAAE7:
2129: rts
2130:
2131: bCOMPRT:sec
2132: jsr kPLOT
2133: tya
2134: sec
2135: @LAAEE:
2136: sbc #EDITOR_TAB
2137: bcs @LAAEE
2138: eor #$FF
2139: adc #$01
2140: bne LAB0E
2141: LAAF8: php
2142: sec
2143: jsr kPLOT
2144: sty zTRMPOS
2145: jsr bGTBYTC
2146: cmp #')'
2147: bne LAB5F
2148: plp
2149: bcc LAB0F
2150: txa
2151: sbc zTRMPOS
2152: bcc LAB13
2153: LAB0E: tax
2154: LAB0F: inx
2155: LAB10: dex
2156: bne LAB19
2157: LAB13: jsr zCHRGET
2158: jmp LAAA2
2159:
2160: LAB19: jsr bOUTSPC
2161: bne LAB10
2162:
2163: bSTROUT:jsr bSTRLIT
2164:
2165: LAB21: jsr LB6A6
2166: tax
2167: ldy #0
2168: inx
2169: @LAB28:
2170: dex
2171: beq RetAAE7
2172: lda (zINDEX),y
2173: jsr LAB47
2174: iny
2175: cmp #ASC_CR
2176: bne @LAB28
2177: jsr LAAE5
2178: jmp @LAB28
2179:
2180: bOUTSPC:lda z13
2181: beq @LAB42
2182: lda #' '
2183: .byte ASM_BIT3
2184: @LAB42:
2185: lda #ASC_CURSORLEFTRIGHT
2186: .byte ASM_BIT3
2187:
2188:
2189: LAB45: lda #'?'
2190:
2191: LAB47: jsr bCHOUT
2192: and #$FF
2193: rts
2194:
2195: bDOAGIN:lda zSUBFLG
2196: beq LAB62
2197: bmi @LAB57
2198: ldy #$FF
2199: bne @LAB5B
2200: ; ---------------
2201: @LAB57:
2202: lda zDATLIN
2203: ldy zDATLIN + 1
2204: @LAB5B:
2205: sta zCURLIN
2206: sty zCURLIN + 1
2207: LAB5F: jmp bSYNERR
2208: LAB62: lda z13
2209: beq @LAB6B
2210: ldx #ErrFileData
2211: jmp bERROR
2212:
2213: @LAB6B:
2214: lda #<StrRedoFromStart
2215: ldy #>StrRedoFromStart
2216: jsr bSTROUT
2217: lda zOLDTXT
2218: ldy zOLDTXT + 1
2219: sta zTXTPTR
2220: sty zTXTPTR + 1
2221: rts
2222:
2223: bGET: jsr bERRDIR
2224: cmp #'#'
2225: bne @LAB92
2226: jsr zCHRGET
2227: jsr LB79E
2228: lda #','
2229: jsr LAEFF
2230: stx z13
2231: jsr bCKIN
2232: @LAB92:
2233: ldx #<(lBUF + 1)
2234: ldy #>(lBUF + 1)
2235: lda #0
2236: sta lBUF + 1
2237: lda #$40
2238: jsr LAC0F
2239: ldx z13
2240: bne LABB7
2241: rts
2242:
2243: bINPUTN:jsr LB79E
2244: lda #','
2245: jsr LAEFF
2246: stx z13
2247: jsr bCKIN
2248: jsr LABCE
2249: LABB5: lda z13
2250: LABB7: jsr kCLRCHN
2251: ldx #0
2252: stx z13
2253: rts
2254: bINPUT: cmp #'"'
2255: bne LABCE
2256: jsr LAEBD
2257: lda #';'
2258: jsr LAEFF
2259: jsr LAB21
2260: LABCE: jsr bERRDIR
2261: lda #','
2262: sta lBUF - 1
2263: LABD6: jsr bQINLIN
2264: lda z13
2265: beq bBUFFUL
2266: jsr kREADST
2267: and #$02
2268: beq bBUFFUL
2269: jsr LABB5
2270: jmp bDATA
2271:
2272: bBUFFUL:lda lBUF
2273: bne LAC0D
2274: lda z13
2275: bne LABD6
2276: jsr bDATAN
2277: jmp LA8FB
2278:
2279: bQINLIN:lda z13
2280: bne @LAC03
2281: jsr LAB45
2282: jsr bOUTSPC
2283: @LAC03:
2284: jmp bINLIN
2285:
2286: bREAD: ldx zDATPTR
2287: ldy zDATPTR + 1
2288: lda #$98
2289: .byte ASM_BIT3
2290: LAC0D: lda #0
2291: LAC0F: sta zSUBFLG
2292: stx zINPPTR
2293: sty zINPPTR + 1
2294: LAC15: jsr bPTRGET
2295: sta zFORPNT
2296: sty zFORPNT + 1
2297: lda zTXTPTR
2298: ldy zTXTPTR + 1
2299: sta zVARTXT
2300: sty zVARTXT + 1
2301: ldx zINPPTR
2302: ldy zINPPTR + 1
2303: stx zTXTPTR
2304: sty zTXTPTR + 1
2305: jsr zCHRGOT
2306: bne LAC51
2307: bit zSUBFLG
2308: bvc LAC41
2309:
2310: bRGDET: jsr bGETIN
2311: sta lBUF
2312: ldx #<(lBUF - 1)
2313: ldy #>(lBUF - 1)
2314: bne LAC4D
2315: LAC41: bmi LACB8
2316: lda z13
2317: bne @LAC4A
2318: jsr LAB45
2319: @LAC4A:
2320: jsr bQINLIN
2321:
2322: LAC4D: stx zTXTPTR
2323: sty zTXTPTR + 1
2324: LAC51: jsr zCHRGET
2325: bit zVALTYP
2326: bpl @LAC89
2327: bit zSUBFLG
2328: bvc @LAC65
2329: inx
2330: stx zTXTPTR
2331: lda #0
2332: sta zCHARAC
2333: beq @LAC71
2334: @LAC65:
2335: sta zCHARAC
2336: cmp #'"'
2337: beq @LAC72
2338: lda #':'
2339: sta zCHARAC
2340: lda #','
2341: @LAC71:
2342: clc
2343: @LAC72:
2344: sta zENDCHR
2345: lda zTXTPTR
2346: ldy zTXTPTR + 1
2347: adc #0
2348: bcc @LAC7D
2349: iny
2350: @LAC7D:
2351: jsr LB48D
2352: jsr LB7E2
2353: jsr LA9DA
2354: jmp @LAC91
2355: @LAC89:
2356: jsr bFIN
2357: lda zINTFLG
2358: jsr LA9C2
2359: @LAC91:
2360: jsr zCHRGOT
2361: beq @LAC9D
2362: cmp #','
2363: beq @LAC9D
2364: jmp bDOAGIN
2365:
2366: @LAC9D:
2367: lda zTXTPTR
2368: ldy zTXTPTR + 1
2369: sta zINPPTR
2370: sty zINPPTR + 1
2371: lda zVARTXT
2372: ldy zVARTXT + 1
2373: sta zTXTPTR
2374: sty zTXTPTR + 1
2375: jsr zCHRGOT
2376: beq LACDF
2377: jsr bCHKCMA
2378: jmp LAC15
2379: LACB8: jsr bDATAN
2380: iny
2381: tax
2382: bne @LACD1
2383: ldx #$0D
2384: iny
2385: lda (zTXTPTR),y
2386: beq LAD32
2387: iny
2388: lda (zTXTPTR),y
2389: sta zDATLIN
2390: iny
2391: lda (zTXTPTR),y
2392: iny
2393: sta zDATLIN + 1
2394: @LACD1:
2395: jsr LA8FB
2396: jsr zCHRGOT
2397: tax
2398: cpx #$83
2399: bne LACB8
2400: jmp LAC51
2401: LACDF: lda zINPPTR
2402: ldy zINPPTR + 1
2403: ldx zSUBFLG
2404: bpl @LACEA
2405: jmp LA827
2406: @LACEA:
2407: ldy #0
2408: lda (zINPPTR),y
2409: beq @Ret
2410: lda z13
2411: bne @Ret
2412: lda #<bEXINT
2413: ldy #>bEXINT
2414: jmp bSTROUT
2415: @Ret: rts
2416:
2417: bEXINT: .byte "?EXTRA IGNORED",$0D,$00
2418:
2419: StrRedoFromStart:
2420: .byte "?REDO FROM START",$0D,$00
2421:
2422: bNEXT: bne LAD24
2423: ldy #0
2424: beq LAD27
2425: LAD24: jsr bPTRGET
2426: LAD27: sta zFORPNT
2427: sty zFORPNT + 1
2428: jsr bFNDFOR
2429: beq LAD35
2430: ldx #ErrNextWithoutFor
2431: LAD32: jmp bERROR
2432: LAD35: txs
2433: txa
2434: clc
2435: adc #$04
2436: pha
2437: adc #$06
2438: sta zINDEX2
2439: pla
2440: ldy #$01
2441: jsr bMOVFM
2442: tsx
2443: lda lSTACK + 9,x
2444: sta zFACSGN
2445: lda zFORPNT
2446: ldy zFORPNT + 1
2447: jsr bFADD
2448: jsr LBBD0
2449: ldy #$01
2450: jsr LBC5D
2451: tsx
2452: sec
2453: sbc lSTACK + 9,x
2454: beq LAD78
2455: bDONEXT:lda lSTACK + 15,x
2456: sta zCURLIN
2457: lda lSTACK + 16,x
2458: sta zCURLIN + 1
2459: lda lSTACK + 18,x
2460: sta zTXTPTR
2461: lda lSTACK + 17,x
2462: sta zTXTPTR + 1
2463: LAD75: jmp bNEWSTT
2464: LAD78: txa
2465: adc #17
2466: tax
2467: txs
2468: jsr zCHRGOT
2469: cmp #','
2470: bne LAD75
2471: jsr zCHRGET
2472: jsr LAD24
2473: bFRMNUM:jsr bFRMEVL
2474: LAD8D: clc
2475: .byte ASM_BIT2
2476: LAD8F: sec
2477: LAD90: bit zVALTYP
2478: bmi LAD97
2479: bcs LAD99
2480: LAD96: rts
2481: LAD97: bcs LAD96
2482: LAD99: ldx #ErrTypeMismatch
2483: jmp bERROR
2484: bFRMEVL:ldx zTXTPTR
2485: bne LADA4
2486: dec zTXTPTR + 1
2487: LADA4: dec zTXTPTR
2488: ldx #0
2489: .byte ASM_BIT2
2490: LADA9: pha
2491: txa
2492: pha
2493: lda #1
2494: jsr bGETSTK
2495: jsr bEVAL
2496: lda #$00
2497: sta zOPMASK
2498: LADB8: jsr zCHRGOT
2499: LADBB: sec
2500: sbc #TokGreater
2501: bcc LADD7
2502: cmp #TokSgn - TokGreater
2503: bcs LADD7
2504: cmp #TokEqual - TokGreater
2505: rol a
2506: eor #$01
2507: eor zOPMASK
2508: cmp zOPMASK
2509: bcc LAE30
2510: sta zOPMASK
2511: jsr zCHRGET
2512: jmp LADBB
2513: LADD7: ldx zOPMASK
2514: bne LAE07
2515: bcs LAE58
2516: adc #$07
2517: bcc LAE58
2518: adc zVALTYP
2519: bne LADE8
2520: jmp bCAT
2521: LADE8: adc #-1
2522: sta zINDEX
2523: asl a
2524: adc zINDEX
2525: tay
2526: LADF0: pla
2527: cmp bOPTAB,y
2528: bcs LAE5D
2529: jsr LAD8D
2530: LADF9: pha
2531: LADFA: jsr LAE20
2532: pla
2533: ldy zVARTXT
2534: bpl LAE19
2535: tax
2536: beq LAE5B
2537: bne LAE66
2538: LAE07: lsr zVALTYP
2539: txa
2540: rol a
2541: ldx zTXTPTR
2542: bne LAE11
2543: dec zTXTPTR + 1
2544: LAE11: dec zTXTPTR
2545: ldy #$1B
2546: sta zOPMASK
2547: bne LADF0
2548: LAE19: cmp bOPTAB,y
2549: bcs LAE66
2550: bcc LADF9
2551: LAE20: lda bOPTAB + 2,y
2552: pha
2553: lda bOPTAB + 1,y
2554: pha
2555: jsr LAE33
2556: lda zOPMASK
2557: jmp LADA9
2558: LAE30: jmp bSYNERR
2559: LAE33: lda zFACSGN
2560: ldx bOPTAB,y
2561: LAE38: tay
2562: pla
2563: sta zINDEX
2564: inc zINDEX
2565: pla
2566: sta zINDEX + 1
2567: tya
2568: pha
2569: LAE43: jsr bROUND
2570: lda zFACHO + 3
2571: pha
2572: lda zFACHO + 2
2573: pha
2574: lda zFACHO + 1
2575: pha
2576: lda zFACHO
2577: pha
2578: lda zFACEXP
2579: pha
2580: jmp (zINDEX)
2581: LAE58: ldy #$FF
2582: pla
2583: LAE5B: beq LAE80
2584: LAE5D: cmp #$64
2585: beq LAE64
2586: jsr LAD8D
2587: LAE64: sty zVARTXT
2588: LAE66: pla
2589: lsr a
2590: sta zTANSGN
2591: pla
2592: sta zARGEXP
2593: pla
2594: sta zARGHO
2595: pla
2596: sta zARGHO + 1
2597: pla
2598: sta zARGHO + 2
2599: pla
2600: sta zARGHO + 3
2601: pla
2602: sta zARGSGN
2603: eor zFACSGN
2604: sta zARISGN
2605: LAE80: lda zFACEXP
2606: rts
2607: bEVAL: jmp (lIEVAL)
2608: LAE86: lda #$00
2609: sta zVALTYP
2610: LAE8A: jsr zCHRGET
2611: bcs LAE92
2612: LAE8F: jmp bFIN
2613: LAE92: jsr bISLETC
2614: bcc LAE9A
2615: jmp bISVAR
2616: LAE9A: cmp #$FF
2617: bne bQDOT
2618: lda #<bPIVAL
2619: ldy #>bPIVAL
2620: jsr bMOVFM
2621: jmp zCHRGET
2622:
2623: bPIVAL: .byte $82,$49,$0F,$DA,$A1
2624:
2625: bQDOT: cmp #'.'
2626: beq LAE8F
2627: cmp #TokMinus
2628: beq bDOMIN
2629: cmp #TokPlus
2630: beq LAE8A
2631: cmp #'"'
2632: bne LAECC
2633: LAEBD: lda zTXTPTR
2634: ldy zTXTPTR + 1
2635: adc #0
2636: bcc LAEC6
2637: iny
2638: LAEC6: jsr bSTRLIT
2639: jmp LB7E2
2640: LAECC: cmp #TokNot
2641: bne LAEE3
2642: ldy #$18
2643: bne LAF0F
2644: bEQUOP: jsr bAYINT
2645: lda zFACHO + 3
2646: eor #$FF
2647: tay
2648: lda zFACHO + 2
2649: eor #$FF
2650: jmp bGIVAYF
2651: LAEE3: cmp #TokFn
2652: bne LAEEA
2653: jmp bFNDOER
2654: LAEEA: cmp #TokSgn
2655: bcc bOARCHK
2656: jmp bISFUN
2657: bOARCHK:jsr bCHKopen
2658: jsr bFRMEVL
2659: bCHKclose:
2660: lda #')'
2661: .byte ASM_BIT3
2662: bCHKopen:
2663: lda #'('
2664: .byte ASM_BIT3
2665: bCHKCMA:lda #','
2666: LAEFF: ldy #0
2667: cmp (zTXTPTR),y
2668: bne bSYNERR
2669: jmp zCHRGET
2670: bSYNERR:ldx #ErrSyntax
2671: jmp bERROR
2672: bDOMIN: ldy #$15
2673: LAF0F: pla
2674: pla
2675: jmp LADFA
2676: bRSVVAR:sec
2677: lda zFACHO + 2
2678: sbc #<BASIC_START
2679: lda zFACHO + 3
2680: sbc #>BASIC_START
2681: bcc LAF27
2682: lda #<BASIC_END
2683: sbc zFACHO + 2
2684: lda #>BASIC_END
2685: sbc zFACHO + 3
2686: LAF27: rts
2687: bISVAR: jsr bPTRGET
2688: sta zFACHO + 2
2689: sty zFACHO + 3
2690: ldx zVARNAM
2691: ldy zVARNAM + 1
2692: lda zVALTYP
2693: beq LAF5D
2694: lda #0
2695: sta zFACOV
2696: jsr bRSVVAR
2697: bcc LAF5C
2698: cpx #'T' ; "T"
2699: bne LAF5C
2700: cpy #'I' + $80 ; "I$"
2701: bne LAF5C
2702: bTISASC:jsr LAF84
2703: sty zTEMP_5E
2704: dey
2705: sty zFBUFPT
2706: ldy #6
2707: sty zTEMP_5D
2708: ldy #$24
2709: jsr bFOUTIM
2710: jmp LB46F
2711: LAF5C: rts
2712: LAF5D: bit zINTFLG
2713: bpl LAF6E
2714: ldy #0
2715: lda (zFACHO + 2),y
2716: tax
2717: iny
2718: lda (zFACHO + 2),y
2719: tay
2720: txa
2721: jmp bGIVAYF
2722: LAF6E: jsr bRSVVAR
2723: bcc LAFA0
2724: cpx #'T'
2725: bne LAF92
2726: cpy #'I'
2727: bne LAFA0
2728: jsr LAF84
2729: tya
2730: ldx #$A0
2731: jmp LBC4F
2732: LAF84: jsr kRDTIM
2733: stx zFACHO + 2
2734: sty zFACHO + 1
2735: sta zFACHO + 3
2736: ldy #0
2737: sty zFACHO
2738: rts
2739: LAF92: cpx #'S'
2740: bne LAFA0
2741: cpy #'T'
2742: bne LAFA0
2743: jsr kREADST
2744: jmp LBC3C
2745: LAFA0: lda zFACHO + 2
2746: ldy zFACHO + 3
2747: jmp bMOVFM
2748: bISFUN: asl a
2749: pha
2750: tax
2751: jsr zCHRGET
2752: cpx #TokRem
2753: bcc bNUMFUN
2754: bSTRFUN:jsr bCHKopen
2755: jsr bFRMEVL
2756: jsr bCHKCMA
2757: jsr LAD8F
2758: pla
2759: tax
2760: lda zFACHO + 3
2761: pha
2762: lda zFACHO + 2
2763: pha
2764: txa
2765: pha
2766: jsr LB79E
2767: pla
2768: tay
2769: txa
2770: pha
2771: jmp LAFD6
2772: bNUMFUN:jsr bOARCHK
2773: pla
2774: tay
2775: LAFD6: lda bFUNDSP - 2*(TokSgn - $80),y
2776: sta zJMPER + 1
2777: lda bFUNDSP - 2*(TokSgn - $80) + 1,y
2778: sta zJMPER + 2
2779: jsr zJMPER
2780: jmp LAD8D
2781: bOROP: ldy #$FF
2782: .byte ASM_BIT3
2783: TAND: ldy #0
2784: sty zCOUNT
2785: jsr bAYINT
2786: lda zFACHO + 2
2787: eor zCOUNT
2788: sta zCHARAC
2789: lda zFACHO + 3
2790: eor zCOUNT
2791: sta zENDCHR
2792: jsr bMOVFA
2793: jsr bAYINT
2794: lda zFACHO + 3
2795: eor zCOUNT
2796: and zENDCHR
2797: eor zCOUNT
2798: tay
2799: lda zFACHO + 2
2800: eor zCOUNT
2801: and zCHARAC
2802: eor zCOUNT
2803: jmp bGIVAYF
2804: bDOREL: jsr LAD90
2805: bcs bSTRREL
2806: bNUMREL:lda zARGSGN
2807: ora #$7F
2808: and zARGHO
2809: sta zARGHO
2810: lda #<zARG
2811: ldy #>zARG
2812: jsr bFCOMP
2813: tax
2814: jmp LB061
2815: bSTRREL:lda #0
2816: sta zVALTYP
2817: dec zOPMASK
2818: jsr LB6A6
2819: sta zFACEXP
2820: stx zFACHO
2821: sty zFACHO + 1
2822: lda zARGHO + 2
2823: ldy zARGHO + 3
2824: jsr LB6AA
2825: stx zARGHO + 2
2826: sty zARGHO + 3
2827: tax
2828: sec
2829: sbc zFACEXP
2830: beq LB056
2831: lda #1
2832: bcc LB056
2833: ldx zFACEXP
2834: lda #$FF
2835: LB056: sta zFACSGN
2836: ldy #$FF
2837: inx
2838: LB05B: iny
2839: dex
2840: bne LB066
2841: ldx zFACSGN
2842: LB061: bmi LB072
2843: clc
2844: bcc LB072
2845: LB066: lda (zARGHO + 2),y
2846: cmp (zFACHO),y
2847: beq LB05B
2848: ldx #$FF
2849: bcs LB072
2850: ldx #$01
2851: LB072: inx
2852: txa
2853: rol a
2854: and zTANSGN
2855: beq LB07B
2856: lda #$FF
2857: LB07B: jmp LBC3C
2858: bDIM: jsr bCHKCMA
2859: bDIM2: tax
2860: jsr LB090
2861: jsr zCHRGOT
2862: bne bDIM
2863: rts
2864: bPTRGET:ldx #$00
2865: jsr zCHRGOT
2866: LB090: stx zDIMFLG
2867: LB092: sta zVARNAM
2868: jsr zCHRGOT
2869: jsr bISLETC
2870: bcs LB09F
2871: LB09C: jmp bSYNERR
2872: LB09F: ldx #$00
2873: stx zVALTYP
2874: stx zINTFLG
2875: jsr zCHRGET
2876: bcc LB0AF
2877: jsr bISLETC
2878: bcc LB0BA
2879: LB0AF: tax
2880: LB0B0: jsr zCHRGET
2881: bcc LB0B0
2882: jsr bISLETC
2883: bcs LB0B0
2884: LB0BA: cmp #'$'
2885: bne LB0C4
2886: lda #$FF
2887: sta zVALTYP
2888: bne LB0D4
2889: LB0C4: cmp #'%'
2890: bne LB0DB
2891: lda zINTALLOWED
2892: bne LB09C
2893: lda #$80
2894: sta zINTFLG
2895: ora zVARNAM
2896: sta zVARNAM
2897: LB0D4: txa
2898: ora #$80
2899: tax
2900: jsr zCHRGET
2901: LB0DB: stx zVARNAM + 1
2902: sec
2903: ora zINTALLOWED
2904: sbc #'('
2905: bne bORDVAR
2906: jmp bISARY
2907: bORDVAR:ldy #$00
2908: sty zINTALLOWED
2909: lda zVARTAB
2910: ldx zVARTAB + 1
2911: LB0EF: stx zTEMP_5F + 1
2912: LB0F1: sta zTEMP_5F
2913: cpx zARYTAB + 1
2914: bne LB0FB
2915: cmp zARYTAB
2916: beq bNOTFNS
2917: LB0FB: lda zVARNAM
2918: cmp (zTEMP_5F),y
2919: bne LB109
2920: lda zVARNAM + 1
2921: iny
2922: cmp (zTEMP_5F),y
2923: beq LB185
2924: dey
2925: LB109: clc
2926: lda zTEMP_5F
2927: adc #7
2928: bcc LB0F1
2929: inx
2930: bne LB0EF
2931: bISLETC:cmp #'A'
2932: bcc LB11C
2933: sbc #'Z' + 1
2934: sec
2935: sbc #-('Z' + 1)
2936: LB11C: rts
2937: bNOTFNS:pla
2938: pha
2939: cmp #$2A ; ?
2940: bne bNOTEVL
2941: LB123: lda #<bTI ; for TI$, store the special pointer
2942: ldy #>bTI ; so it can be recognized
2943: rts
2944: bNOTEVL:lda zVARNAM
2945: ldy zVARNAM + 1
2946: cmp #'T' ; "T"
2947: bne LB13B
2948: cpy #'I' + $80 ; "I$"
2949: beq LB123
2950: cpy #'I'
2951: bne LB13B
2952: LB138: jmp bSYNERR
2953: LB13B: cmp #'S'
2954: bne LB143
2955: cpy #'T'
2956: beq LB138
2957: LB143: lda zARYTAB
2958: ldy zARYTAB + 1
2959: sta zTEMP_5F
2960: sty zTEMP_5F + 1
2961: lda zSTREND
2962: ldy zSTREND + 1
2963: sta zTEMP_5A
2964: sty zTEMP_5A + 1
2965: clc
2966: adc #7
2967: bcc LB159
2968: iny
2969: LB159: sta zTEMP_58
2970: sty zTEMP_58 + 1
2971: jsr bBLTU
2972: lda zTEMP_58
2973: ldy zTEMP_58 + 1
2974: iny
2975: sta zARYTAB
2976: sty zARYTAB + 1
2977: ldy #0
2978: lda zVARNAM
2979: sta (zTEMP_5F),y
2980: iny
2981: lda zVARNAM + 1
2982: sta (zTEMP_5F),y
2983: lda #0
2984: iny
2985: sta (zTEMP_5F),y
2986: iny
2987: sta (zTEMP_5F),y
2988: iny
2989: sta (zTEMP_5F),y
2990: iny
2991: sta (zTEMP_5F),y
2992: iny
2993: sta (zTEMP_5F),y
2994: LB185: lda zTEMP_5F
2995: clc
2996: adc #2
2997: ldy zTEMP_5F + 1
2998: bcc LB18F
2999: iny
3000: LB18F: sta zVARPNT
3001: sty zVARPNT + 1
3002: rts
3003: bARYGET:lda zCOUNT
3004: asl a
3005: adc #5
3006: adc zTEMP_5F
3007: ldy zTEMP_5F + 1
3008: bcc LB1A0
3009: iny
3010: LB1A0: sta zTEMP_58
3011: sty zTEMP_58 + 1
3012: rts
3013:
3014: bN32768:.byte $90,$80,$00,$00,$00
3015:
3016: bFACINX:jsr bAYINT
3017: lda zFACHO + 2
3018: ldy zFACHO + 3
3019: rts
3020: bINTIDX:jsr zCHRGET
3021: jsr bFRMEVL
3022: LB1B8: jsr LAD8D
3023: lda zFACSGN
3024: bmi LB1CC
3025: bAYINT: lda zFACEXP
3026: cmp #$90
3027: bcc LB1CE
3028: lda #<bN32768
3029: ldy #>bN32768
3030: jsr bFCOMP
3031: LB1CC: bne bIQERR
3032: LB1CE: jmp bQINT
3033: bISARY: lda zDIMFLG
3034: ora zINTFLG
3035: pha
3036: lda zVALTYP
3037: pha
3038: ldy #0
3039: LB1DB: tya
3040: pha
3041: lda zVARNAM + 1
3042: pha
3043: lda zVARNAM
3044: pha
3045: jsr bINTIDX
3046: pla
3047: sta zVARNAM
3048: pla
3049: sta zVARNAM + 1
3050: pla
3051: tay
3052: tsx
3053: lda lSTACK + 2,x
3054: pha
3055: lda lSTACK + 1,x
3056: pha
3057: lda zFACHO + 2
3058: sta lSTACK + 2,x
3059: lda zFACHO + 3
3060: sta lSTACK + 1,x
3061: iny
3062: jsr zCHRGOT
3063: cmp #','
3064: beq LB1DB
3065: sty zCOUNT
3066: jsr bCHKclose
3067: pla
3068: sta zVALTYP
3069: pla
3070: sta zINTFLG
3071: and #$7F
3072: sta zDIMFLG
3073: bFNDARY:ldx zARYTAB
3074: lda zARYTAB + 1
3075: LB21C: stx zTEMP_5F
3076: sta zTEMP_5F + 1
3077: cmp zSTREND + 1
3078: bne LB228
3079: cpx zSTREND
3080: beq bNOTFDD
3081: LB228: ldy #0
3082: lda (zTEMP_5F),y
3083: iny
3084: cmp zVARNAM
3085: bne LB237
3086: lda zVARNAM + 1
3087: cmp (zTEMP_5F),y
3088: beq bRAERR
3089: LB237: iny
3090: lda (zTEMP_5F),y
3091: clc
3092: adc zTEMP_5F
3093: tax
3094: iny
3095: lda (zTEMP_5F),y
3096: adc zTEMP_5F + 1
3097: bcc LB21C
3098: bBSERR: ldx #ErrBadSubscript
3099: .byte ASM_BIT3
3100: bIQERR: ldx #ErrIllegalQuantity
3101: LB24A: jmp bERROR
3102: bRAERR: ldx #ErrRedimdArray
3103: lda zDIMFLG
3104: bne LB24A
3105: jsr bARYGET
3106: lda zCOUNT
3107: ldy #4
3108: cmp (zTEMP_5F),y
3109: bne bBSERR
3110: jmp LB2EA
3111: bNOTFDD:jsr bARYGET
3112: jsr bREASON
3113: ldy #0
3114: sty zFBUFPT + 1
3115: ldx #5
3116: lda zVARNAM
3117: sta (zTEMP_5F),y
3118: bpl LB274
3119: dex
3120: LB274: iny
3121: lda zVARNAM + 1
3122: sta (zTEMP_5F),y
3123: bpl LB27D
3124: dex
3125: dex
3126: LB27D: stx zFBUFPT
3127: lda zCOUNT
3128: iny
3129: iny
3130: iny
3131: sta (zTEMP_5F),y
3132: LB286: ldx #11
3133: lda #0
3134: bit zDIMFLG
3135: bvc LB296
3136: pla
3137: clc
3138: adc #1
3139: tax
3140: pla
3141: adc #0
3142: LB296: iny
3143: sta (zTEMP_5F),y
3144: iny
3145: txa
3146: sta (zTEMP_5F),y
3147: jsr bUMULT
3148: stx zFBUFPT
3149: sta zFBUFPT + 1
3150: ldy zINDEX
3151: dec zCOUNT
3152: bne LB286
3153: adc zTEMP_58 + 1
3154: bcs LB30B
3155: sta zTEMP_58 + 1
3156: tay
3157: txa
3158: adc zTEMP_58
3159: bcc LB2B9
3160: iny
3161: beq LB30B
3162: LB2B9: jsr bREASON
3163: sta zSTREND
3164: sty zSTREND + 1
3165: lda #0
3166: inc zFBUFPT + 1
3167: ldy zFBUFPT
3168: beq LB2CD
3169: LB2C8: dey
3170: sta (zTEMP_58),y
3171: bne LB2C8
3172: LB2CD: dec zTEMP_58 + 1
3173: dec zFBUFPT + 1
3174: bne LB2C8
3175: inc zTEMP_58 + 1
3176: sec
3177: lda zSTREND
3178: sbc zTEMP_5F
3179: ldy #2
3180: sta (zTEMP_5F),y
3181: lda zSTREND + 1
3182: iny
3183: sbc zTEMP_5F + 1
3184: sta (zTEMP_5F),y
3185: lda zDIMFLG
3186: bne LB34B
3187: iny
3188: LB2EA: lda (zTEMP_5F),y
3189: sta zCOUNT
3190: lda #0
3191: sta zFBUFPT
3192: LB2F2: sta zFBUFPT + 1
3193: iny
3194: pla
3195: tax
3196: sta zFACHO + 2
3197: pla
3198: sta zFACHO + 3
3199: cmp (zTEMP_5F),y
3200: bcc bINLPN2
3201: bne LB308
3202: iny
3203: txa
3204: cmp (zTEMP_5F),y
3205: bcc LB30F
3206: LB308: jmp bBSERR
3207: LB30B: jmp bOMERR
3208:
3209: bINLPN2:iny
3210: LB30F: lda zFBUFPT + 1
3211: ora zFBUFPT
3212: clc
3213: beq LB320
3214: jsr bUMULT
3215: txa
3216: adc zFACHO + 2
3217: tax
3218: tya
3219: ldy zINDEX
3220: LB320: adc zFACHO + 3
3221: stx zFBUFPT
3222: dec zCOUNT
3223: bne LB2F2
3224: sta zFBUFPT + 1
3225: ldx #5
3226: lda zVARNAM
3227: bpl LB331
3228: dex
3229: LB331: lda zVARNAM + 1
3230: bpl LB337
3231: dex
3232: dex
3233: LB337: stx zTEMP_28
3234: lda #0
3235: jsr LB355
3236: txa
3237: adc zTEMP_58
3238: sta zVARPNT
3239: tya
3240: adc zTEMP_58 + 1
3241: sta zVARPNT + 1
3242: tay
3243: lda zVARPNT
3244: LB34B: rts
3245: bUMULT: sty zINDEX
3246: lda (zTEMP_5F),y
3247: sta zTEMP_28
3248: dey
3249: lda (zTEMP_5F),y
3250: LB355: sta zTEMP_28 + 1
3251: lda #$10
3252: sta zTEMP_5D
3253: ldx #0
3254: ldy #0
3255: LB35F: txa
3256: asl a
3257: tax
3258: tya
3259: rol a
3260: tay
3261: bcs LB30B
3262: asl zFBUFPT
3263: rol zFBUFPT + 1
3264: bcc LB378
3265: clc
3266: txa
3267: adc zTEMP_28
3268: tax
3269: tya
3270: adc zTEMP_28 + 1
3271: tay
3272: bcs LB30B
3273: LB378: dec zTEMP_5D
3274: bne LB35F
3275: rts
3276: bFRE: lda zVALTYP
3277: beq LB384
3278: jsr LB6A6
3279: LB384: jsr bGARBAG
3280: sec
3281: lda zFRETOP
3282: sbc zSTREND
3283: tay
3284: lda zFRETOP + 1
3285: sbc zSTREND + 1
3286: bGIVAYF:ldx #0
3287: stx zVALTYP
3288: sta zFACHO
3289: sty zFACHO + 1
3290: ldx #$90
3291: jmp LBC44
3292: bPOS: sec
3293: jsr kPLOT
3294: LB3A2: lda #0
3295: beq bGIVAYF
3296: bERRDIR:ldx zCURLIN + 1
3297: inx
3298: bne LB34B
3299: ldx #ErrIllegalDirect
3300: .byte ASM_BIT3
3301: bUFERR: ldx #ErrUndefdFunction
3302: jmp bERROR
3303:
3304: bDEF: jsr bGETFNM
3305: jsr bERRDIR
3306: jsr bCHKopen
3307: lda #$80
3308: sta zINTALLOWED
3309: jsr bPTRGET
3310: jsr LAD8D
3311: jsr bCHKclose
3312: lda #TokEqual
3313: jsr LAEFF
3314: pha
3315: lda zVARPNT + 1
3316: pha
3317: lda zVARPNT
3318: pha
3319: lda zTXTPTR + 1
3320: pha
3321: lda zTXTPTR
3322: pha
3323: jsr bDATA
3324: jmp LB44F
3325: bGETFNM:lda #TokFn
3326: jsr LAEFF
3327: ora #$80
3328: sta zINTALLOWED
3329: jsr LB092
3330: sta zTEMPF3
3331: sty zTEMPF3 + 1
3332: jmp LAD8D
3333: bFNDOER:jsr bGETFNM
3334: lda zTEMPF3 + 1
3335: pha
3336: lda zTEMPF3
3337: pha
3338: jsr bOARCHK
3339: jsr LAD8D
3340: pla
3341: sta zTEMPF3
3342: pla
3343: sta zTEMPF3 + 1
3344: ldy #2
3345: lda (zTEMPF3),y
3346: sta zVARPNT
3347: tax
3348: iny
3349: lda (zTEMPF3),y
3350: beq bUFERR
3351: sta zVARPNT + 1
3352: iny
3353: LB418: lda (zVARPNT),y
3354: pha
3355: dey
3356: bpl LB418
3357: ldy zVARPNT + 1
3358: jsr LBBD4
3359: lda zTXTPTR + 1
3360: pha
3361: lda zTXTPTR
3362: pha
3363: lda (zTEMPF3),y
3364: sta zTXTPTR
3365: iny
3366: lda (zTEMPF3),y
3367: sta zTXTPTR + 1
3368: lda zVARPNT + 1
3369: pha
3370: lda zVARPNT
3371: pha
3372: jsr bFRMNUM
3373: pla
3374: sta zTEMPF3
3375: pla
3376: sta zTEMPF3 + 1
3377: jsr zCHRGOT
3378: beq LB449
3379: jmp bSYNERR
3380: LB449: pla
3381: sta zTXTPTR
3382: pla
3383: sta zTXTPTR + 1
3384: LB44F: ldy #0
3385: pla
3386: sta (zTEMPF3),y
3387: pla
3388: iny
3389: sta (zTEMPF3),y
3390: pla
3391: iny
3392: sta (zTEMPF3),y
3393: pla
3394: iny
3395: sta (zTEMPF3),y
3396: pla
3397: iny
3398: sta (zTEMPF3),y
3399: rts
3400: bSTRD: jsr LAD8D
3401: ldy #0
3402: jsr LBDDF
3403: pla
3404: pla
3405: LB46F: lda #<(zASCWRK)
3406: ldy #>(zASCWRK)
3407: beq bSTRLIT
3408: ; -------------
3409:
3410: LB475: ldx zFACHO + 2
3411: ldy zFACHO + 3
3412: stx zTEMP_50
3413: sty zTEMP_50 + 1
3414: LB47D: jsr bGETSPA
3415: stx zFACHO
3416: sty zFACHO + 1
3417: sta zFACEXP
3418: rts
3419: bSTRLIT:ldx #'"'
3420: stx zCHARAC
3421: stx zENDCHR
3422: LB48D: sta zARISGN
3423: sty zFACOV
3424: sta zFACHO
3425: sty zFACHO + 1
3426: ldy #-1
3427: LB497: iny
3428: lda (zARISGN),y
3429: beq LB4A8
3430: cmp zCHARAC
3431: beq LB4A4
3432: cmp zENDCHR
3433: bne LB497
3434: LB4A4: cmp #'"'
3435: beq LB4A9
3436: LB4A8: clc
3437: LB4A9: sty zFACEXP
3438: tya
3439: adc zARISGN
3440: sta zFBUFPT
3441: ldx zFACOV
3442: bcc LB4B5
3443: inx
3444: LB4B5: stx zFBUFPT + 1
3445: lda zFACOV
3446: beq LB4BF
3447: cmp #2
3448: bne LB4CA
3449: LB4BF: tya
3450: jsr LB475
3451: ldx zARISGN
3452: ldy zFACOV
3453: JDLB4C7:
3454: jsr LB688
3455: LB4CA: ldx zTEMPPT
3456: cpx #zTEMPST + 9
3457: bne bPUTNW1
3458: ldx #ErrFormulaTooComplex
3459: LB4D2: jmp bERROR
3460: bPUTNW1:lda zFACEXP
3461: sta 0,x
3462: lda zFACHO
3463: sta 1,x
3464: lda zFACHO + 1
3465: sta 2,x
3466: ldy #>zTEMPST
3467: stx zFACHO + 2
3468: sty zFACHO + 3
3469: sty zFACOV
3470: dey
3471: sty zVALTYP
3472: stx zLASTPT
3473: inx
3474: inx
3475: inx
3476: stx zTEMPPT
3477: rts
3478: bGETSPA:lsr zGARBFL
3479: LB4F6: pha
3480: eor #$FF
3481: sec
3482: adc zFRETOP
3483: ldy zFRETOP + 1
3484: bcs LB501
3485: dey
3486: LB501: cpy zSTREND + 1
3487: bcc LB516
3488: bne LB50B
3489: cmp zSTREND
3490: bcc LB516
3491: LB50B: sta zFRETOP
3492: sty zFRETOP + 1
3493: sta zFRESPC
3494: sty zFRESPC + 1
3495: tax
3496: pla
3497: rts
3498: LB516: ldx #$10
3499: lda zGARBFL
3500: bmi LB4D2
3501: jsr bGARBAG
3502: lda #$80
3503: sta zGARBFL
3504: pla
3505: bne LB4F6
3506: bGARBAG:ldx zMEMSIZ
3507: lda zMEMSIZ + 1
3508: LB52A: stx zFRETOP
3509: sta zFRETOP + 1
3510: ldy #0
3511: sty zTEMPF3 + 1
3512: sty zTEMPF3
3513: lda zSTREND
3514: ldx zSTREND + 1
3515: sta zTEMP_5F
3516: stx zTEMP_5F + 1
3517: lda #<zTEMPST
3518: ldx #>zTEMPST
3519: sta zINDEX
3520: stx zINDEX + 1
3521: LB544: cmp zTEMPPT
3522: beq LB54D
3523: jsr LB5C7
3524: beq LB544
3525: LB54D: lda #$07
3526: sta zFOUR6
3527: lda zVARTAB
3528: ldx zVARTAB + 1
3529: sta zINDEX
3530: stx zINDEX + 1
3531: LB559: cpx zARYTAB + 1
3532: bne LB561
3533: cmp zARYTAB
3534: beq LB566
3535: LB561: jsr bDVARS
3536: beq LB559
3537: LB566: sta zTEMP_58
3538: stx zTEMP_58 + 1
3539: lda #3
3540: sta zFOUR6
3541: LB56E: lda zTEMP_58
3542: ldx zTEMP_58 + 1
3543: LB572: cpx zSTREND + 1
3544: bne LB57D
3545: cmp zSTREND
3546: bne LB57D
3547: jmp bGRBPAS
3548: LB57D: sta zINDEX
3549: stx zINDEX + 1
3550: ldy #0
3551: lda (zINDEX),y
3552: tax
3553: iny
3554: lda (zINDEX),y
3555: php
3556: iny
3557: lda (zINDEX),y
3558: adc zTEMP_58
3559: sta zTEMP_58
3560: iny
3561: lda (zINDEX),y
3562: adc zTEMP_58 + 1
3563: sta zTEMP_58 + 1
3564: plp
3565: bpl LB56E
3566: txa
3567: bmi LB56E
3568: iny
3569: lda (zINDEX),y
3570: ldy #0
3571: asl a
3572: adc #5
3573: adc zINDEX
3574: sta zINDEX
3575: bcc LB5AE
3576: inc zINDEX + 1
3577: LB5AE: ldx zINDEX + 1
3578: LB5B0: cpx zTEMP_58 + 1
3579: bne LB5B8
3580: cmp zTEMP_58
3581: beq LB572
3582: LB5B8: jsr LB5C7
3583: beq LB5B0
3584: bDVARS: lda (zINDEX),y
3585: bmi LB5F6
3586: iny
3587: lda (zINDEX),y
3588: bpl LB5F6
3589: iny
3590: LB5C7: lda (zINDEX),y
3591: beq LB5F6
3592: iny
3593: lda (zINDEX),y
3594: tax
3595: iny
3596: lda (zINDEX),y
3597: cmp zFRETOP + 1
3598: bcc LB5DC
3599: bne LB5F6
3600: cpx zFRETOP
3601: bcs LB5F6
3602: LB5DC: cmp zTEMP_5F + 1
3603: bcc LB5F6
3604: bne LB5E6
3605: cpx zTEMP_5F
3606: bcc LB5F6
3607: LB5E6: stx zTEMP_5F
3608: sta zTEMP_5F + 1
3609: lda zINDEX
3610: ldx zINDEX + 1
3611: sta zTEMPF3
3612: stx zTEMPF3 + 1
3613: lda zFOUR6
3614: sta zJMPER + 1
3615: LB5F6: lda zFOUR6
3616: clc
3617: adc zINDEX
3618: sta zINDEX
3619: bcc LB601
3620: inc zINDEX + 1
3621: LB601: ldx zINDEX + 1
3622: ldy #0
3623: rts
3624: bGRBPAS:lda zTEMPF3 + 1
3625: ora zTEMPF3
3626: beq LB601
3627: lda zJMPER + 1
3628: and #$04
3629: lsr a
3630: tay
3631: sta zJMPER + 1
3632: lda (zTEMPF3),y
3633: adc zTEMP_5F
3634: sta zTEMP_5A
3635: lda zTEMP_5F + 1
3636: adc #0
3637: sta zTEMP_5A + 1
3638: lda zFRETOP
3639: ldx zFRETOP + 1
3640: sta zTEMP_58
3641: stx zTEMP_58 + 1
3642: jsr MoveMem
3643: ldy zJMPER + 1
3644: iny
3645: lda zTEMP_58
3646: sta (zTEMPF3),y
3647: tax
3648: inc zTEMP_58 + 1
3649: lda zTEMP_58 + 1
3650: iny
3651: sta (zTEMPF3),y
3652: jmp LB52A
3653: bCAT: lda zFACHO + 3
3654: pha
3655: lda zFACHO + 2
3656: pha
3657: jsr bEVAL
3658: jsr LAD8F
3659: pla
3660: sta zARISGN
3661: pla
3662: sta zFACOV
3663: ldy #0
3664: lda (zARISGN),y
3665: clc
3666: adc (zFACHO + 2),y
3667: bcc LB65D
3668: ldx #ErrStringTooLong
3669: jmp bERROR
3670: LB65D: jsr LB475
3671: jsr bMOVINS
3672: lda zTEMP_50
3673: ldy zTEMP_50 + 1
3674: jsr LB6AA
3675: jsr LB68C
3676: lda zARISGN
3677: ldy zFACOV
3678: jsr LB6AA
3679: jsr LB4CA
3680: jmp LADB8
3681: bMOVINS:ldy #0
3682: lda (zARISGN),y
3683: pha
3684: iny
3685: lda (zARISGN),y
3686: tax
3687: iny
3688: lda (zARISGN),y
3689: tay
3690: pla
3691: LB688: stx zINDEX
3692: sty zINDEX + 1
3693: LB68C: tay
3694: beq LB699
3695: pha
3696: LB690: dey
3697: lda (zINDEX),y
3698: sta (zFRESPC),y
3699: tya
3700: bne LB690
3701: pla
3702: LB699: clc
3703: adc zFRESPC
3704: sta zFRESPC
3705: bcc LB6A2
3706: inc zFRESPC + 1
3707: LB6A2: rts
3708: bFRESTR:jsr LAD8F
3709: LB6A6: lda zFACHO + 2
3710: ldy zFACHO + 3
3711: LB6AA: sta zINDEX
3712: sty zINDEX + 1
3713: jsr bFREFAC
3714: php
3715: ldy #0
3716: lda (zINDEX),y
3717: pha
3718: iny
3719: lda (zINDEX),y
3720: tax
3721: iny
3722: lda (zINDEX),y
3723: tay
3724: pla
3725: plp
3726: bne LB6D6
3727: cpy zFRETOP + 1
3728: bne LB6D6
3729: cpx zFRETOP
3730: bne LB6D6
3731: pha
3732: clc
3733: adc zFRETOP
3734: sta zFRETOP
3735: bcc LB6D5
3736: inc zFRETOP + 1
3737: LB6D5: pla
3738: LB6D6: stx zINDEX
3739: sty zINDEX + 1
3740: rts
3741: bFREFAC:cpy zLASTPT + 1
3742: bne LB6EB
3743: cmp zLASTPT
3744: bne LB6EB
3745: sta zTEMPPT
3746: sbc #3
3747: sta zLASTPT
3748: ldy #0
3749: LB6EB: rts
3750: bCHRD: jsr LB7A1
3751: txa
3752: pha
3753: lda #1
3754: jsr LB47D
3755: pla
3756: ldy #0
3757: sta (zFACHO),y
3758: pla
3759: pla
3760: jmp LB4CA
3761: bLEFTD: jsr bPREAM
3762: cmp (zTEMP_50),y
3763: tya
3764: LB706: bcc LB70C
3765: lda (zTEMP_50),y
3766: tax
3767: tya
3768: LB70C: pha
3769: LB70D: txa
3770: LB70E: pha
3771: jsr LB47D
3772: lda zTEMP_50
3773: ldy zTEMP_50 + 1
3774: jsr LB6AA
3775: pla
3776: tay
3777: pla
3778: clc
3779: adc zINDEX
3780: sta zINDEX
3781: bcc LB725
3782: inc zINDEX + 1
3783: LB725: tya
3784: jsr LB68C
3785: jmp LB4CA
3786: bRIGHTD:jsr bPREAM
3787: clc
3788: sbc (zTEMP_50),y
3789: eor #$FF
3790: jmp LB706
3791: bMIDD: lda #$FF
3792: sta zFACHO + 3
3793: jsr zCHRGOT
3794: cmp #')'
3795: beq LB748
3796: jsr bCHKCMA
3797: jsr LB79E
3798: LB748: jsr bPREAM
3799: beq LB798
3800: dex
3801: txa
3802: pha
3803: clc
3804: ldx #0
3805: sbc (zTEMP_50),y
3806: bcs LB70D
3807: eor #$FF
3808: cmp zFACHO + 3
3809: bcc LB70E
3810: lda zFACHO + 3
3811: bcs LB70E
3812: bPREAM: jsr bCHKclose
3813: pla
3814: tay
3815: pla
3816: sta zJMPER + 1
3817: pla
3818: pla
3819: pla
3820: tax
3821: pla
3822: sta zTEMP_50
3823: pla
3824: sta zTEMP_50 + 1
3825: lda zJMPER + 1
3826: pha
3827: tya
3828: pha
3829: ldy #0
3830: txa
3831: rts
3832: bLEN: jsr bLEN1
3833: jmp LB3A2
3834: bLEN1: jsr bFRESTR
3835: ldx #0
3836: stx zVALTYP
3837: tay
3838: rts
3839: bASC: jsr bLEN1
3840: beq LB798
3841: ldy #0
3842: lda (zINDEX),y
3843: tay
3844: jmp LB3A2
3845: LB798: jmp bIQERR
3846: bGTBYTC:jsr zCHRGET
3847: LB79E: jsr bFRMNUM
3848: LB7A1: jsr LB1B8
3849: ldx zFACHO + 2
3850: bne LB798
3851: ldx zFACHO + 3
3852: jmp zCHRGOT
3853: bVAL: jsr bLEN1
3854: bne bSTRVAL
3855: jmp LB8F7
3856: bSTRVAL:ldx zTXTPTR
3857: ldy zTXTPTR + 1
3858: stx zFBUFPT
3859: sty zFBUFPT + 1
3860: ldx zINDEX
3861: stx zTXTPTR
3862: clc
3863: adc zINDEX
3864: sta zINDEX2
3865: ldx zINDEX + 1
3866: stx zTXTPTR + 1
3867: bcc LB7CD
3868: inx
3869: LB7CD: stx zINDEX2 + 1
3870: ldy #0
3871: lda (zINDEX2),y
3872: pha
3873: tya
3874: sta (zINDEX2),y
3875: jsr zCHRGOT
3876: jsr bFIN
3877: pla
3878: ldy #0
3879: sta (zINDEX2),y
3880: LB7E2: ldx zFBUFPT
3881: ldy zFBUFPT + 1
3882: stx zTXTPTR
3883: sty zTXTPTR + 1
3884: rts
3885: bGETNUM:jsr bFRMNUM
3886: jsr bGETADR
3887: LB7F1: jsr bCHKCMA
3888: jmp LB79E
3889: bGETADR:lda zFACSGN
3890: bmi LB798
3891: lda zFACEXP
3892: cmp #$91 ; exponent for 65536
3893: bcs LB798
3894: jsr bQINT
3895: lda zFACHO + 2
3896: ldy zFACHO + 3
3897: sty zLINNUM
3898: sta zLINNUM + 1
3899: rts
3900: bPEEK: lda zLINNUM + 1
3901: pha
3902: lda zLINNUM
3903: pha
3904: jsr bGETADR
3905: ldy #0
3906: lda (zLINNUM),y
3907: tay
3908: pla
3909: sta zLINNUM
3910: pla
3911: sta zLINNUM + 1
3912: jmp LB3A2
3913: bPOKE: jsr bGETNUM
3914: txa
3915: ldy #0
3916: sta (zLINNUM),y
3917: rts
3918: bWAIT: jsr bGETNUM
3919: stx zFORPNT
3920: ldx #0
3921: jsr zCHRGOT
3922: beq LB83C
3923: jsr LB7F1
3924: LB83C: stx zFORPNT + 1
3925: ldy #0
3926: LB840: lda (zLINNUM),y
3927: eor zFORPNT + 1
3928: and zFORPNT
3929: beq LB840
3930: LB848: rts
3931: bFADDH: lda #<bFHALF
3932: ldy #>bFHALF
3933: jmp bFADD
3934: bFSUB: jsr bCONUPK
3935: FSUBT: lda zFACSGN
3936: eor #$FF
3937: sta zFACSGN
3938: eor zARGSGN
3939: sta zARISGN
3940: lda zFACEXP
3941: jmp FADDT
3942: bFADD5: jsr LB999
3943: bcc LB8A3
3944: bFADD: jsr bCONUPK
3945: FADDT: bne LB86F
3946: jmp bMOVFA
3947: LB86F: ldx zFACOV
3948: stx zJMPER + 2
3949: ldx #zARGEXP
3950: lda zARGEXP
3951: LB877: tay
3952: beq LB848
3953: sec
3954: sbc zFACEXP
3955: beq LB8A3
3956: bcc LB893
3957: sty zFACEXP
3958: ldy zARGSGN
3959: sty zFACSGN
3960: eor #$FF
3961: adc #0
3962: ldy #0
3963: sty zJMPER + 2
3964: ldx #zFACEXP
3965: bne LB897
3966: LB893: ldy #0
3967: sty zFACOV
3968: LB897: cmp #$F9
3969: bmi bFADD5
3970: tay
3971: lda zFACOV
3972: lsr 1,x
3973: jsr LB9B0
3974: LB8A3: bit zARISGN
3975: bpl LB8FE
3976: ldy #zFACEXP
3977: cpx #zARGEXP
3978: beq LB8AF
3979: ldy #zARGEXP
3980: LB8AF: sec
3981: eor #$FF
3982: adc zJMPER + 2
3983: sta zFACOV
3984: lda 4,y
3985: sbc 4,x
3986: sta zFACHO + 3
3987: lda zADRAY1,y
3988: sbc zADRAY1,x
3989: sta zFACHO + 2
3990: lda 2,y
3991: sbc 2,x
3992: sta zFACHO + 1
3993: lda 1,y
3994: sbc 1,x
3995: sta zFACHO
3996: LB8D2: bcs LB8D7
3997: jsr bNEGFAC
3998: LB8D7: ldy #0
3999: tya
4000: clc
4001: LB8DB: ldx zFACHO
4002: bne LB929
4003: ldx zFACHO + 1
4004: stx zFACHO
4005: ldx zFACHO + 2
4006: stx zFACHO + 1
4007: ldx zFACHO + 3
4008: stx zFACHO + 2
4009: ldx zFACOV
4010: stx zFACHO + 3
4011: sty zFACOV
4012: adc #8
4013: cmp #$20
4014: bne LB8DB
4015: LB8F7: lda #0
4016: LB8F9: sta zFACEXP
4017: LB8FB: sta zFACSGN
4018: rts
4019: LB8FE: adc zJMPER + 2
4020: sta zFACOV
4021: lda zFACHO + 3
4022: adc zARGHO + 3
4023: sta zFACHO + 3
4024: lda zFACHO + 2
4025: adc zARGHO + 2
4026: sta zFACHO + 2
4027: lda zFACHO + 1
4028: adc zARGHO + 1
4029: sta zFACHO + 1
4030: lda zFACHO
4031: adc zARGHO
4032: sta zFACHO
4033: jmp LB936
4034: LB91D: adc #1
4035: asl zFACOV
4036: rol zFACHO + 3
4037: rol zFACHO + 2
4038: rol zFACHO + 1
4039: rol zFACHO
4040: LB929: bpl LB91D
4041: sec
4042: sbc zFACEXP
4043: bcs LB8F7
4044: eor #$FF
4045: adc #1
4046: sta zFACEXP
4047: LB936: bcc LB946
4048: LB938: inc zFACEXP
4049: beq bOVERR
4050: ror zFACHO
4051: ror zFACHO + 1
4052: ror zFACHO + 2
4053: ror zFACHO + 3
4054: ror zFACOV
4055: LB946: rts
4056: bNEGFAC:lda zFACSGN
4057: eor #$FF
4058: sta zFACSGN
4059: LB94D: lda zFACHO
4060: eor #$FF
4061: sta zFACHO
4062: lda zFACHO + 1
4063: eor #$FF
4064: sta zFACHO + 1
4065: lda zFACHO + 2
4066: eor #$FF
4067: sta zFACHO + 2
4068: lda zFACHO + 3
4069: eor #$FF
4070: sta zFACHO + 3
4071: lda zFACOV
4072: eor #$FF
4073: sta zFACOV
4074: inc zFACOV
4075: bne LB97D
4076: LB96F: inc zFACHO + 3
4077: bne LB97D
4078: inc zFACHO + 2
4079: bne LB97D
4080: inc zFACHO + 1
4081: bne LB97D
4082: inc zFACHO
4083: LB97D: rts
4084: bOVERR: ldx #ErrOverflow
4085: jmp bERROR
4086: bMULSHF:ldx #zRESHO - 1
4087: LB985: ldy 4,x
4088: sty zFACOV
4089: ldy 3,x
4090: sty 4,x
4091: ldy 2,x
4092: sty 3,x
4093: ldy 1,x
4094: sty 2,x
4095: ldy zBITS
4096: sty 1,x
4097: LB999: adc #8
4098: bmi LB985
4099: beq LB985
4100: sbc #8
4101: tay
4102: lda zFACOV
4103: bcs LB9BA
4104: LB9A6: asl 1,x
4105: bcc LB9AC
4106: inc 1,x
4107: LB9AC: ror 1,x
4108: ror 1,x
4109: LB9B0: ror 2,x
4110: ror 3,x
4111: ror 4,x
4112: ror a
4113: iny
4114: bne LB9A6
4115: LB9BA: clc
4116: rts
4117:
4118: bFPTABL:.byte $81,$00,$00,$00,$00 ; FP 1
4119: LB9C1: .byte $03 ; Grade of polynomial
4120: .byte $7F,$5E,$56,$CB,$79 ; .434255942
4121: .byte $80,$13,$9B,$0B,$64 ; .576584541
4122: .byte $80,$76,$38,$93,$16 ; .961800759
4123: .byte $82,$38,$AA,$3B,$20 ; 2.88539007
4124: LB9D6: .byte $80,$35,$04,$F3,$34 ; 1 / SQR(2)
4125: LB9DB: .byte $81,$35,$04,$F3,$34 ; SQR(2)
4126: LB9E0: .byte $80,$80,$00,$00,$00 ; - 0.5
4127: LB9E5: .byte $80,$31,$72,$17,$F8 ; LOG(2)
4128:
4129: bLOG: jsr bSIGN
4130: beq LB9F1
4131: bpl LB9F4
4132: LB9F1: jmp bIQERR
4133: LB9F4: lda zFACEXP
4134: sbc #$7F
4135: pha
4136: lda #$80
4137: sta zFACEXP
4138: lda #<LB9D6
4139: ldy #>LB9D6
4140: jsr bFADD
4141: lda #<LB9DB
4142: ldy #>LB9DB
4143: jsr bFDIVT
4144: lda #<bFPTABL
4145: ldy #>bFPTABL
4146: jsr bFSUB
4147: lda #<LB9C1
4148: ldy #>LB9C1
4149: jsr bPOLYX
4150: lda #<LB9E0
4151: ldy #>LB9E0
4152: jsr bFADD
4153: pla
4154: jsr LBD7E
4155: lda #<LB9E5
4156: ldy #>LB9E5
4157: bFMULT: jsr bCONUPK
4158: FMULTT: bne LBA30
4159: jmp LBA8B
4160: LBA30: jsr bMULDIV
4161: lda #$00
4162: sta zRESHO
4163: sta zRESHO + 1
4164: sta zRESHO + 2
4165: sta zRESHO + 3
4166: lda zFACOV
4167: jsr bMULPLY
4168: lda zFACHO + 3
4169: jsr bMULPLY
4170: lda zFACHO + 2
4171: jsr bMULPLY
4172: lda zFACHO + 1
4173: jsr bMULPLY
4174: lda zFACHO
4175: jsr LBA5E
4176: jmp LBB8F
4177: bMULPLY:bne LBA5E
4178: jmp bMULSHF
4179: LBA5E: lsr a
4180: ora #$80
4181: LBA61: tay
4182: bcc LBA7D
4183: clc
4184: lda zRESHO + 3
4185: adc zARGHO + 3
4186: sta zRESHO + 3
4187: lda zRESHO + 2
4188: adc zARGHO + 2
4189: sta zRESHO + 2
4190: lda zRESHO + 1
4191: adc zARGHO + 1
4192: sta zRESHO + 1
4193: lda zRESHO
4194: adc zARGHO
4195: sta zRESHO
4196: LBA7D: ror zRESHO
4197: ror zRESHO + 1
4198: ror zRESHO + 2
4199: ror zRESHO + 3
4200: ror zFACOV
4201: tya
4202: lsr a
4203: bne LBA61
4204: LBA8B: rts
4205: bCONUPK:sta zINDEX
4206: sty zINDEX + 1
4207: ldy #4
4208: lda (zINDEX),y
4209: sta zARGHO + 3
4210: dey
4211: lda (zINDEX),y
4212: sta zARGHO + 2
4213: dey
4214: lda (zINDEX),y
4215: sta zARGHO + 1
4216: dey
4217: lda (zINDEX),y
4218: sta zARGSGN
4219: eor zFACSGN
4220: sta zARISGN
4221: lda zARGSGN
4222: ora #$80
4223: sta zARGHO
4224: dey
4225: lda (zINDEX),y
4226: sta zARGEXP
4227: lda zFACEXP
4228: rts
4229: bMULDIV:lda zARGEXP
4230: LBAB9: beq LBADA
4231: clc
4232: adc zFACEXP
4233: bcc LBAC4
4234: bmi LBADF
4235: clc
4236: .byte ASM_BIT3
4237: LBAC4: bpl LBADA
4238: adc #$80
4239: sta zFACEXP
4240: bne LBACF
4241: jmp LB8FB
4242: LBACF: lda zARISGN
4243: sta zFACSGN
4244: rts
4245: bMLDVEX:lda zFACSGN
4246: eor #$FF
4247: bmi LBADF
4248: LBADA: pla
4249: pla
4250: jmp LB8F7
4251: LBADF: jmp bOVERR
4252: bMUL10: jsr bMOVAF
4253: tax
4254: beq LBAF8
4255: clc
4256: adc #2 ; exponent + 2, thus, X * 4
4257: bcs LBADF
4258: LBAED: ldx #0
4259: stx zARISGN
4260: jsr LB877
4261: inc zFACEXP ; exponent + 2, thus, ((X * 4) + X) * 2 = X * 10
4262: beq LBADF
4263: LBAF8: rts
4264:
4265: bTENC: .byte $84,$20,$00,$00,$00
4266:
4267: bDIV10: jsr bMOVAF
4268: lda #<bTENC
4269: ldy #>bTENC
4270: ldx #0
4271: bFDIV: stx zARISGN
4272: jsr bMOVFM
4273: jmp FDIVT
4274: bFDIVT: jsr bCONUPK
4275: FDIVT: beq LBB8A
4276: jsr bROUND
4277: lda #0
4278: sec
4279: sbc zFACEXP
4280: sta zFACEXP
4281: jsr bMULDIV
4282: inc zFACEXP
4283: beq LBADF
4284: ldx #-4
4285: lda #1
4286: LBB29: ldy zARGHO
4287: cpy zFACHO
4288: bne LBB3F
4289: ldy zARGHO + 1
4290: cpy zFACHO + 1
4291: bne LBB3F
4292: ldy zARGHO + 2
4293: cpy zFACHO + 2
4294: bne LBB3F
4295: ldy zARGHO + 3
4296: cpy zFACHO + 3
4297: LBB3F: php
4298: rol a
4299: bcc LBB4C
4300: inx
4301: sta zRESHO + 3,x
4302: beq LBB7A
4303: bpl LBB7E
4304: lda #1
4305: LBB4C: plp
4306: bcs LBB5D
4307: LBB4F: asl zARGHO + 3
4308: rol zARGHO + 2
4309: rol zARGHO + 1
4310: rol zARGHO
4311: bcs LBB3F
4312: bmi LBB29
4313: bpl LBB3F
4314:
4315: LBB5D: tay
4316: lda zARGHO + 3
4317: sbc zFACHO + 3
4318: sta zARGHO + 3
4319: lda zARGHO + 2
4320: sbc zFACHO + 2
4321: sta zARGHO + 2
4322: lda zARGHO + 1
4323: sbc zFACHO + 1
4324: sta zARGHO + 1
4325: lda zARGHO
4326: sbc zFACHO
4327: sta zARGHO
4328: tya
4329: jmp LBB4F
4330: LBB7A: lda #$40
4331: bne LBB4C
4332: ; -----------
4333: LBB7E: asl a
4334: asl a
4335: asl a
4336: asl a
4337: asl a
4338: asl a
4339: sta zFACOV
4340: plp
4341: jmp LBB8F
4342: LBB8A: ldx #ErrDivisionByZero
4343: jmp bERROR
4344: LBB8F: lda zRESHO
4345: sta zFACHO
4346: lda zRESHO + 1
4347: sta zFACHO + 1
4348: lda zRESHO + 2
4349: sta zFACHO + 2
4350: lda zRESHO + 3
4351: sta zFACHO + 3
4352: jmp LB8D7
4353: bMOVFM: sta zINDEX
4354: sty zINDEX + 1
4355: ldy #4
4356: lda (zINDEX),y
4357: sta zFACHO + 3
4358: dey
4359: lda (zINDEX),y
4360: sta zFACHO + 2
4361: dey
4362: lda (zINDEX),y
4363: sta zFACHO + 1
4364: dey
4365: lda (zINDEX),y
4366: sta zFACSGN
4367: ora #$80
4368: sta zFACHO
4369: dey
4370: lda (zINDEX),y
4371: sta zFACEXP
4372: sty zFACOV
4373: rts
4374: bMOV2F: ldx #zTEMPF2
4375: .byte ASM_BIT3
4376: LBBCA: ldx #zTEMPF1
4377: ldy #0
4378: beq LBBD4
4379: LBBD0: ldx zFORPNT
4380: ldy zFORPNT + 1
4381: LBBD4: jsr bROUND
4382: stx zINDEX
4383: sty zINDEX + 1
4384: ldy #4
4385: lda zFACHO + 3
4386: sta (zINDEX),y
4387: dey
4388: lda zFACHO + 2
4389: sta (zINDEX),y
4390: dey
4391: lda zFACHO + 1
4392: sta (zINDEX),y
4393: dey
4394: lda zFACSGN
4395: ora #$7F
4396: and zFACHO
4397: sta (zINDEX),y
4398: dey
4399: lda zFACEXP
4400: sta (zINDEX),y
4401: sty zFACOV
4402: rts
4403: bMOVFA: lda zARGSGN
4404: LBBFE: sta zFACSGN
4405: ldx #5 ; why 5, but 6 in LBC0F?
4406: LBC02: lda zARG - 1,x
4407: sta zFAC - 1,x
4408: dex
4409: bne LBC02
4410: stx zFACOV
4411: rts
4412: bMOVAF: jsr bROUND
4413: LBC0F: ldx #6 ; why 6, but 5 in LBBFE + 2?
4414: LBC11: lda zFAC - 1,x
4415: sta zARG - 1,x
4416: dex
4417: bne LBC11
4418: stx zFACOV
4419: LBC1A: rts
4420: bROUND: lda zFACEXP
4421: beq LBC1A
4422: asl zFACOV
4423: bcc LBC1A
4424: LBC23: jsr LB96F
4425: bne LBC1A
4426: jmp LB938
4427: bSIGN: lda zFACEXP
4428: beq LBC38
4429: LBC2F: lda zFACSGN
4430: LBC31: rol a
4431: lda #$FF
4432: bcs LBC38
4433: lda #1
4434: LBC38: rts
4435: bSGN: jsr bSIGN
4436: LBC3C: sta zFACHO
4437: lda #$00
4438: sta zFACHO + 1
4439: ldx #$88
4440: LBC44: lda zFACHO
4441: eor #$FF
4442: rol a
4443: LBC49: lda #$00
4444: sta zFACHO + 3
4445: sta zFACHO + 2
4446: LBC4F: stx zFACEXP
4447: sta zFACOV
4448: sta zFACSGN
4449: jmp LB8D2
4450: bABS: lsr zFACSGN
4451: rts
4452: bFCOMP: sta zINDEX2
4453: LBC5D: sty zINDEX2 + 1
4454: ldy #0
4455: lda (zINDEX2),y
4456: iny
4457: tax
4458: beq bSIGN
4459: lda (zINDEX2),y
4460: eor zFACSGN
4461: bmi LBC2F
4462: cpx zFACEXP
4463: bne LBC92
4464: lda (zINDEX2),y
4465: ora #$80
4466: cmp zFACHO
4467: bne LBC92
4468: iny
4469: lda (zINDEX2),y
4470: cmp zFACHO + 1
4471: bne LBC92
4472: iny
4473: lda (zINDEX2),y
4474: cmp zFACHO + 2
4475: bne LBC92
4476: iny
4477: lda #$7F
4478: cmp zFACOV
4479: lda (zINDEX2),y
4480: sbc zFACHO + 3
4481: beq LBCBA
4482: LBC92: lda zFACSGN
4483: bcc LBC98
4484: eor #$FF
4485: LBC98: jmp LBC31
4486: bQINT: lda zFACEXP
4487: beq LBCE9
4488: sec
4489: sbc #$A0
4490: bit zFACSGN
4491: bpl LBCAF
4492: tax
4493: lda #$FF
4494: sta zBITS
4495: jsr LB94D
4496: txa
4497: LBCAF: ldx #$61
4498: cmp #$F9
4499: bpl LBCBB
4500: jsr LB999
4501: sty zBITS
4502: LBCBA: rts
4503: LBCBB: tay
4504: lda zFACSGN
4505: and #$80
4506: lsr zFACHO
4507: ora zFACHO
4508: sta zFACHO
4509: jsr LB9B0
4510: sty zBITS
4511: rts
4512: bINT: lda zFACEXP
4513: cmp #$A0
4514: bcs LBCF2
4515: jsr bQINT
4516: sty zFACOV
4517: lda zFACSGN
4518: sty zFACSGN
4519: eor #$80
4520: rol a
4521: lda #$A0
4522: sta zFACEXP
4523: lda zFACHO + 3
4524: sta zCHARAC
4525: jmp LB8D2
4526: LBCE9: sta zFACHO
4527: sta zFACHO + 1
4528: sta zFACHO + 2
4529: sta zFACHO + 3
4530: tay
4531: LBCF2: rts
4532: bFIN: ldy #0
4533: ldx #zFACSGN - zTEMPF2
4534: LBCF7: sty zTEMPF2 + 1,x
4535: dex
4536: bpl LBCF7
4537: bcc LBD0D
4538: cmp #'-'
4539: bne LBD06
4540: stx zSGNFLG
4541: beq LBD0A
4542: LBD06: cmp #'+'
4543: bne LBD0F
4544: LBD0A: jsr zCHRGET
4545: LBD0D: bcc LBD6A
4546: LBD0F: cmp #'.'
4547: beq LBD41
4548: cmp #'E'
4549: bne LBD47
4550: jsr zCHRGET
4551: bcc LBD33
4552: cmp #TokMinus
4553: beq LBD2E
4554: cmp #'-'
4555: beq LBD2E
4556: cmp #TokPlus
4557: beq LBD30
4558: cmp #'+'
4559: beq LBD30
4560: bne LBD35
4561: LBD2E: ror zTEMP_60
4562: LBD30: jsr zCHRGET
4563: LBD33: bcc LBD91
4564: LBD35: bit zTEMP_60
4565: bpl LBD47
4566: lda #0
4567: sec
4568: sbc zTEMP_5E
4569: jmp LBD49
4570: LBD41: ror zTEMP_5F
4571: bit zTEMP_5F
4572: bvc LBD0A
4573: LBD47: lda zTEMP_5E
4574: LBD49: sec
4575: sbc zTEMP_5D
4576: sta zTEMP_5E
4577: beq LBD62
4578: bpl LBD5B
4579: LBD52: jsr bDIV10
4580: inc zTEMP_5E
4581: bne LBD52
4582: beq LBD62
4583: LBD5B: jsr bMUL10
4584: dec zTEMP_5E
4585: bne LBD5B
4586: LBD62: lda zSGNFLG
4587: bmi LBD67
4588: rts
4589: LBD67: jmp bNEGOP
4590: LBD6A: pha
4591: bit zTEMP_5F
4592: bpl LBD71
4593: inc zTEMP_5D
4594: LBD71: jsr bMUL10
4595: pla
4596: sec
4597: sbc #'0'
4598: jsr LBD7E
4599: jmp LBD0A
4600: LBD7E: pha
4601: jsr bMOVAF
4602: pla
4603: jsr LBC3C
4604: lda zARGSGN
4605: eor zFACSGN
4606: sta zARISGN
4607: ldx zFACEXP
4608: jmp FADDT
4609: LBD91: lda zTEMP_5E
4610: cmp #10 ; $0A
4611: bcc LBDA0
4612: lda #100 ; $64
4613: bit zTEMP_60
4614: bmi LBDAE
4615: jmp bOVERR
4616: LBDA0: asl a
4617: asl a
4618: clc
4619: adc zTEMP_5E
4620: asl a
4621: clc
4622: ldy #0
4623: adc (zTXTPTR),y
4624: sec
4625: sbc #'0'
4626: LBDAE: sta zTEMP_5E
4627: jmp LBD30
4628:
4629: bN0999: .byte $9B,$3E,$BC,$1F,$FD ; FP: 99999999.9
4630: LBDB8: .byte $9E,$6E,$6B,$27,$FD ; FP: 999999999
4631: LBDBD: .byte $9E,$6E,$6B,$28,$00 ; FP: 1E9
4632:
4633: bINPRT: lda #<StrIn ; output string " IN "
4634: ldy #>StrIn
4635: jsr LBDDA
4636:
4637: lda zCURLIN + 1 ; output the current line number
4638: ldx zCURLIN
4639: LBDCD: sta zFACHO
4640: stx zFACHO + 1
4641: ldx #$90
4642: sec
4643: jsr LBC49
4644: jsr LBDDF
4645: LBDDA: jmp bSTROUT
4646:
4647: bFOUT: ldy #1
4648: LBDDF: lda #' '
4649: bit zFACSGN
4650: bpl LBDE7
4651: lda #'-'
4652: LBDE7: sta zASCWRK,y
4653: sta zFACSGN
4654: sty zFBUFPT
4655: iny
4656: lda #'0'
4657: ldx zFACEXP
4658: bne LBDF8
4659: jmp LBF04
4660: LBDF8: lda #$00
4661: cpx #$80
4662: beq LBE00
4663: bcs LBE09
4664: LBE00: lda #<LBDBD
4665: ldy #>LBDBD
4666: jsr bFMULT
4667: lda #$F7
4668: LBE09: sta zTEMP_5D
4669: LBE0B: lda #<LBDB8
4670: ldy #>LBDB8
4671: jsr bFCOMP
4672: beq LBE32
4673: bpl LBE28
4674: LBE16: lda #<bN0999
4675: ldy #>bN0999
4676: jsr bFCOMP
4677: beq LBE21
4678: bpl LBE2F
4679: LBE21: jsr bMUL10
4680: dec zTEMP_5D
4681: bne LBE16
4682: LBE28: jsr bDIV10
4683: inc zTEMP_5D
4684: bne LBE0B
4685: LBE2F: jsr bFADDH
4686: LBE32: jsr bQINT
4687: ldx #$01
4688: lda zTEMP_5D
4689: clc
4690: adc #$0A
4691: bmi LBE47
4692: cmp #$0B
4693: bcs LBE48
4694: adc #$FF
4695: tax
4696: lda #$02
4697: LBE47: sec
4698: LBE48: sbc #$02
4699: sta zTEMP_5E
4700: stx zTEMP_5D
4701: txa
4702: beq LBE53
4703: bpl LBE66
4704: LBE53: ldy zFBUFPT
4705: lda #'.'
4706: iny
4707: sta zASCWRK,y
4708: txa
4709: beq LBE64
4710: lda #'0'
4711: iny
4712: sta zASCWRK,y
4713: LBE64: sty zFBUFPT
4714: LBE66: ldy #$00
4715: bFOUTIM:ldx #$80
4716: LBE6A: lda zFACHO + 3
4717: clc
4718: adc LBF16 + 3,y
4719: sta zFACHO + 3
4720: lda zFACHO + 2
4721: adc LBF16 + 2,y
4722: sta zFACHO + 2
4723: lda zFACHO + 1
4724: adc LBF16 + 1,y
4725: sta zFACHO + 1
4726: lda zFACHO
4727: adc LBF16,y
4728: sta zFACHO
4729: inx
4730: bcs LBE8E
4731: bpl LBE6A
4732: bmi LBE90
4733: LBE8E: bmi LBE6A
4734: LBE90: txa
4735: bcc LBE97
4736: eor #$FF
4737: adc #10
4738: LBE97: adc #'0' - 1
4739: iny
4740: iny
4741: iny
4742: iny
4743: sty zVARPNT
4744: ldy zFBUFPT
4745: iny
4746: tax
4747: and #$7F
4748: sta zASCWRK,y
4749: dec zTEMP_5D
4750: bne LBEB2
4751: lda #'.'
4752: iny
4753: sta zASCWRK,y
4754: LBEB2: sty zFBUFPT
4755: ldy zVARPNT
4756: txa
4757: eor #$FF
4758: and #$80
4759: tax
4760: cpy #$24 ; @?
4761: beq LBEC4
4762: cpy #$3C ; @?
4763: bne LBE6A
4764: LBEC4: ldy zFBUFPT
4765: LBEC6: lda zASCWRK,y
4766: dey
4767: cmp #'0'
4768: beq LBEC6
4769: cmp #'.'
4770: beq LBED3
4771: iny
4772: LBED3: lda #'+'
4773: ldx zTEMP_5E
4774: beq LBF07
4775: bpl LBEE3
4776: lda #0
4777: sec
4778: sbc zTEMP_5E
4779: tax
4780: lda #'-'
4781: LBEE3: sta lSTACK + 1,y
4782: lda #'E'
4783: sta lSTACK,y
4784: txa
4785: ldx #'0' - 1
4786: sec
4787: LBEEF: inx
4788: sbc #10
4789: bcs LBEEF
4790: adc #'9' + 1
4791: sta lSTACK + 3,y
4792: txa
4793: sta lSTACK + 2,y
4794: lda #0
4795: sta lSTACK + 4,y
4796: beq LBF0C
4797: LBF04: sta zASCWRK,y
4798: LBF07: lda #0
4799: sta lSTACK,y
4800: LBF0C: lda #<lSTACK
4801: ldy #>lSTACK
4802: rts
4803: bFHALF: .byte $80,$00,$00,$00,$00
4804:
4805: bFNULL = bFHALF + 2
4806: bTI = bFNULL
4807:
4808: LBF16: .byte $FA,$0A,$1F,$00
4809:
4810: .byte $00,$98,$96,$80
4811: .byte $FF,$F0,$BD,$C0
4812: .byte $00,$01,$86,$A0
4813: .byte $FF,$FF,$D8,$F0
4814: .byte $00,$00,$03,$E8
4815: .byte $FF,$FF,$FF,$9C
4816: .byte $00,$00,$00,$0A
4817: .byte $FF,$FF,$FF,$FF
4818:
4819: .byte $FF,$DF,$0A,$80
4820: .byte $00,$03,$4B,$C0
4821: .byte $FF,$FF,$73,$60
4822: .byte $00,$00,$0E,$10
4823: .byte $FF,$FF,$FD,$A8
4824: .byte $00,$00,$00,$3C
4825:
4826: ; This seems to be something like a checksum for the BASIC-ROM.
4827:
4828: .byte CHKSUM_BF52
4829:
4830: ; FillUntil BASIC_START + $1F71,BASIC_FILLER
4831:
4832: .segment "BASICSQR"
4833:
4834: bSQR: jsr bMOVAF
4835: lda #<bFHALF
4836: ldy #>bFHALF
4837: jsr bMOVFM
4838: bFPWRT: beq bEXP
4839: lda zARGEXP
4840: bne LBF84
4841: jmp LB8F9
4842: LBF84: ldx #<zTEMPF3
4843: ldy #>zTEMPF3
4844: jsr LBBD4
4845: lda zARGSGN
4846: bpl LBF9E
4847: jsr bINT
4848: lda #<zTEMPF3
4849: ldy #>zTEMPF3
4850: jsr bFCOMP
4851: bne LBF9E
4852: tya
4853: ldy zCHARAC
4854: LBF9E: jsr LBBFE
4855: tya
4856: pha
4857: jsr bLOG
4858: lda #<zTEMPF3
4859: ldy #>zTEMPF3
4860: jsr bFMULT
4861: jsr bEXP
4862: pla
4863: lsr a
4864: bcc LBFBE
4865: bNEGOP: lda zFACEXP
4866: beq LBFBE
4867: lda zFACSGN
4868: eor #$FF
4869: sta zFACSGN
4870: LBFBE: rts
4871:
4872: bLOGEB2:
4873: .byte $81,$38,$AA,$3B,$29
4874: LBFC4:
4875: .byte $07
4876: .byte $71,$34,$58,$3E,$56
4877: .byte $74,$16,$7E,$B3,$1B
4878: .byte $77,$2F,$EE,$E3,$85
4879: .byte $7A,$1D,$84,$1C,$2A
4880: .byte $7C,$63,$59,$58,$0A
4881: .byte $7E,$75,$FD,$E7,$C6
4882: .byte $80,$31,$72,$18,$10
4883: .byte $81,$00,$00,$00,$00
4884:
4885: bEXP: lda #<bLOGEB2
4886: ldy #>bLOGEB2
4887: jsr bFMULT
4888: lda zFACOV
4889: adc #$50
4890: bcc LBFFD
4891: jsr LBC23
4892:
4893: LBFFD:
4894:
4895: .segment "BASICSQRJMP"
4896:
4897: jmp LE000
4898:
4899: .segment "BASICSQR2"
4900:
4901: LE000:
4902: sta zJMPER + 2
4903:
4904: .segment "BASICSQR3"
4905: jsr LBC0F
4906: lda zFACEXP
4907: cmp #$88
4908: bcc LE00E
4909: LE00B: jsr bMLDVEX
4910: LE00E: jsr bINT
4911: lda zCHARAC
4912: clc
4913: adc #$81
4914: beq LE00B
4915: sec
4916: sbc #1
4917: pha
4918: ldx #5
4919: LE01E: lda zARGEXP,x
4920: ldy zFACEXP,x
4921: sta zFACEXP,x
4922: sty zARGEXP,x
4923: dex
4924: bpl LE01E
4925: lda zJMPER + 2
4926: sta zFACOV
4927: jsr FSUBT
4928: jsr bNEGOP
4929: lda #<LBFC4
4930: ldy #>LBFC4
4931: jsr LE059
4932: lda #0
4933: sta zARISGN
4934: pla
4935: jsr LBAB9
4936: rts
4937: bPOLYX: sta zFBUFPT
4938: sty zFBUFPT + 1
4939: jsr LBBCA
4940: lda #zTEMPF1
4941: jsr bFMULT
4942: jsr LE05D
4943: lda #<zTEMPF1
4944: ldy #>zTEMPF1
4945: jmp bFMULT
4946: LE059: sta zFBUFPT
4947: sty zFBUFPT + 1
4948: LE05D: jsr bMOV2F
4949: lda (zFBUFPT),y
4950: sta zSGNFLG
4951: ldy zFBUFPT
4952: iny
4953: tya
4954: bne LE06C
4955: inc zFBUFPT + 1
4956: LE06C: sta zFBUFPT
4957: ldy zFBUFPT + 1
4958: LE070: jsr bFMULT
4959: lda zFBUFPT
4960: ldy zFBUFPT + 1
4961: clc
4962: adc #5
4963: bcc LE07D
4964: iny
4965: LE07D: sta zFBUFPT
4966: sty zFBUFPT + 1
4967: jsr bFADD
4968: lda #<zTEMPF2
4969: ldy #>zTEMPF2
4970: dec zSGNFLG
4971: bne LE070
4972: rts
4973: bRMULC: .byte $98,$35,$44,$7A,$00
4974: LE092: .byte $68,$28,$B1,$46,$00
4975:
4976: bRND: jsr bSIGN
4977: bmi LE0D3
4978: bne LE0BE
4979: jsr kIOBASE
4980: stx zINDEX
4981: sty zINDEX + 1
4982: ldy #4
4983: lda (zINDEX),y
4984: sta zFACHO
4985: iny
4986: lda (zINDEX),y
4987: sta zFACHO + 2
4988: ldy #8
4989: lda (zINDEX),y
4990: sta zFACHO + 1
4991: iny
4992: lda (zINDEX),y
4993: sta zFACHO + 3
4994: jmp LE0E3
4995: LE0BE: lda #<zRNDX
4996: ldy #>zRNDX
4997: jsr bMOVFM
4998: lda #<bRMULC
4999: ldy #>bRMULC
5000: jsr bFMULT
5001: lda #<LE092
5002: ldy #>LE092
5003: jsr bFADD
5004: LE0D3: ldx zFACHO + 3
5005: lda zFACHO
5006: sta zFACHO + 3
5007: stx zFACHO
5008: ldx zFACHO + 1
5009: lda zFACHO + 2
5010: sta zFACHO + 1
5011: stx zFACHO + 2
5012: LE0E3: lda #0
5013: sta zFACSGN
5014: lda zFACEXP
5015: sta zFACOV
5016: lda #$80
5017: sta zFACEXP
5018: jsr LB8D7
5019: ldx #<zRNDX
5020: ldy #>zRNDX
5021: LE0F6: jmp LBBD4
5022: bBIOERR:cmp #$F0
5023: bne LE104
5024: sty zMEMSIZ + 1
5025: stx zMEMSIZ
5026: jmp LA663
5027: LE104: tax
5028: bne LE109
5029: ldx #ErrBreak
5030: LE109: jmp bERROR
5031: bCHOUT: jsr kCHROUT
5032: bcs bBIOERR
5033: rts
5034: bCHIN: jsr kCHRIN
5035: bcs bBIOERR
5036: rts
5037: bCKOUT:
5038: .if CompileComputer >= C64_02
5039: jsr LE4AD
5040: .else
5041: jsr kCHKOUT
5042: .endif
5043: bcs bBIOERR
5044: rts
5045: bCKIN: jsr kCHKIN
5046: bcs bBIOERR
5047: rts
5048: bGETIN: jsr kGETIN
5049: bcs bBIOERR
5050: rts
5051: bSYS: jsr bFRMNUM
5052: jsr bGETADR
5053: lda #>(LE147 - 1)
5054: pha
5055: lda #<(LE147 - 1)
5056: pha
5057: lda lSPREG
5058: pha
5059: lda lSAREG
5060: ldx lSXREG
5061: ldy lSYREG
5062: plp
5063: jmp (zLINNUM)
5064: LE147: php
5065: sta lSAREG
5066: stx lSXREG
5067: sty lSYREG
5068: pla
5069: sta lSPREG
5070: rts
5071: bSAVET: jsr bSLPARA
5072: ldx zVARTAB
5073: ldy zVARTAB + 1
5074: lda #zTXTTAB
5075: jsr kSAVE
5076: bcs bBIOERR
5077: rts
5078: bVERFYT:lda #1
5079: .byte ASM_BIT3
5080:
5081: bLOADT: lda #0
5082: sta zVERCK
5083: jsr bSLPARA
5084: lda zVERCK
5085: ldx zTXTTAB
5086: ldy zTXTTAB + 1
5087: jsr kLOAD
5088: bcs LE1D1
5089: lda zVERCK
5090: beq ChkStatus
5091: JDLE17E:
5092: ldx #ErrVerify
5093: jsr kREADST
5094: and #$10
5095:
5096: .if CompileComputer >= C64_GENERAL
5097: bne LE19E
5098: .else
5099:
5100: beq @E187
5101: jmp bERROR
5102: .endif
5103:
5104: @E187: lda zTXTPTR
5105:
5106: cmp #>lBUF
5107: beq LE194
5108: lda #<bOKK
5109: ldy #>bOKK
5110:
5111: jmp bSTROUT
5112: LE194: rts
5113:
5114: ChkStatus:
5115: jsr kREADST
5116: and #$BF
5117: beq LE1A1
5118: ldx #ErrLoad
5119: LE19E: jmp bERROR
5120: LE1A1: lda zTXTPTR + 1
5121: cmp #>lBUF
5122: bne LE1B5
5123: JDLE1A7:
5124: stx zVARTAB
5125: sty zVARTAB + 1
5126: lda #<StrReady
5127: ldy #>StrReady
5128: jsr bSTROUT
5129: jmp LA52A
5130: LE1B5: jsr bSTXPT
5131:
5132: .if CompileComputer >= C64_GENERAL
5133: jsr bLINKPRG
5134: jmp LA677
5135: .elseif CompileComputer >= VIC20_06
5136: JMP LE476
5137: .else
5138: JMP LA677
5139: .endif
5140:
5141: ; FillUntil BASIC_START_2 + $01BE
5142: .segment "BASICOPEN"
5143:
5144: bOPENT: jsr bOCPARA
5145: jsr kOPEN
5146: bcs LE1D1
5147: rts
5148: bCLOSET:jsr bOCPARA
5149: lda zFORPNT
5150: jsr kCLOSE
5151: bcc LE194
5152: LE1D1: jmp bBIOERR
5153: bSLPARA:lda #0
5154: jsr kSETNAM
5155: ldx #1
5156: ldy #0
5157: .ifdef JIFFY
5158: jsr JDLF73A
5159: .else
5160: jsr kSETLFS
5161: .endif
5162: jsr bDEFLT
5163: jsr LE257
5164: jsr bDEFLT
5165: jsr bCOMBYT
5166: ldy #0
5167: stx zFORPNT
5168: jsr kSETLFS
5169: jsr bDEFLT
5170: jsr bCOMBYT
5171: txa
5172: tay
5173: ldx zFORPNT
5174: jmp kSETLFS
5175: bCOMBYT:jsr bCMMERR
5176: jmp LB79E
5177: bDEFLT: jsr zCHRGOT
5178: bne LE20D
5179: pla
5180: pla
5181: LE20D: rts
5182: bCMMERR:jsr bCHKCMA
5183: LE211: jsr zCHRGOT
5184: bne LE20D
5185: jmp bSYNERR
5186: bOCPARA:lda #0
5187: jsr kSETNAM
5188: jsr LE211
5189: jsr LB79E
5190: stx zFORPNT
5191: txa
5192: ldx #1
5193: JDLE229:
5194: ldy #0
5195: jsr kSETLFS
5196: jsr bDEFLT
5197: jsr bCOMBYT
5198: stx zFORPNT + 1
5199: ldy #0
5200: lda zFORPNT
5201: cpx #3
5202: bcc LE23F
5203: dey
5204: LE23F: jsr kSETLFS
5205: jsr bDEFLT
5206: jsr bCOMBYT
5207: txa
5208: tay
5209: ldx zFORPNT + 1
5210: lda zFORPNT
5211: jsr kSETLFS
5212: jsr bDEFLT
5213: jsr bCMMERR
5214: LE257: jsr bFRMEVL
5215: JDLE25A:
5216: jsr bFRESTR
5217: ldx zINDEX
5218: ldy zINDEX + 1
5219: jmp kSETNAM
5220: bCOS: lda #<bPI2
5221: ldy #>bPI2
5222: jsr bFADD
5223: bSIN: jsr bMOVAF
5224: lda #<LE2E5
5225: ldy #>LE2E5
5226: ldx zARGSGN
5227: jsr bFDIV
5228: jsr bMOVAF
5229: jsr bINT
5230: lda #0
5231: sta zARISGN
5232: jsr FSUBT
5233: lda #<LE2EA
5234: ldy #>LE2EA
5235: jsr bFSUB
5236: lda zFACSGN
5237: pha
5238: bpl LE29D
5239: jsr bFADDH
5240: lda zFACSGN
5241: bmi LE2A0
5242: lda zTANSGN
5243: eor #$FF
5244: sta zTANSGN
5245: LE29D: jsr bNEGOP
5246: LE2A0: lda #<LE2EA
5247: ldy #>LE2EA
5248: jsr bFADD
5249: pla
5250: bpl LE2AD
5251: jsr bNEGOP
5252: LE2AD: lda #<LE2EF
5253: ldy #>LE2EF
5254: jmp bPOLYX
5255: bTAN: jsr LBBCA
5256: lda #$00
5257: sta zTANSGN
5258: jsr bSIN
5259: ldx #<zTEMPF3
5260: ldy #>zTEMPF3
5261: jsr LE0F6
5262: lda #<zTEMPF1
5263: ldy #>zTEMPF1
5264: jsr bMOVFM
5265: lda #$00
5266: sta zFACSGN
5267: lda zTANSGN
5268: jsr LE2DC
5269: lda #<zTEMPF3
5270: ldy #>zTEMPF3
5271: jmp bFDIVT
5272: LE2DC: pha
5273: jmp LE29D
5274:
5275: bPI2: .byte $81,$49,$0F,$DA,$A2
5276: LE2E5: .byte $83,$49,$0F,$DA,$A2
5277: LE2EA: .byte $7F,$00,$00,$00,$00
5278: LE2EF: .byte $05
5279: .byte $84,$E6,$1A,$2D,$1B
5280: .byte $86,$28,$07,$FB,$F8
5281: .byte $87,$99,$68,$89,$01
5282: .byte $87,$23,$35,$DF,$E1
5283: .byte $86,$A5,$5D,$E7,$28
5284: .byte $83,$49,$0F,$DA,$A2
5285:
5286: bATN: lda zFACSGN
5287: pha
5288: bpl LE316
5289: jsr bNEGOP
5290: LE316: lda zFACEXP
5291: pha
5292: cmp #$81
5293: bcc LE324
5294: lda #<bFPTABL
5295: ldy #>bFPTABL
5296: jsr bFDIVT
5297: LE324: lda #<bATNCON
5298: ldy #>bATNCON
5299: jsr bPOLYX
5300: pla
5301: cmp #$81
5302: bcc LE337
5303: lda #<bPI2
5304: ldy #>bPI2
5305: jsr bFSUB
5306: LE337: pla
5307: bpl LE33D
5308: jmp bNEGOP
5309: LE33D: rts
5310:
5311: bATNCON:.byte $0B
5312: .byte $76,$B3,$83,$BD,$D3
5313: .byte $79,$1E,$F4,$A6,$F5
5314: .byte $7B,$83,$FC,$B0,$10
5315: .byte $7C,$0C,$1F,$67,$CA
5316: .byte $7C,$DE,$53,$CB,$C1
5317: .byte $7D,$14,$64,$70,$4C
5318: .byte $7D,$B7,$EA,$51,$7A
5319: .byte $7D,$63,$30,$88,$7E
5320: .byte $7E,$92,$44,$99,$3A
5321: .byte $7E,$4C,$CC,$91,$C7
5322: .byte $7F,$AA,$AA,$AA,$13
5323: .byte $81,$00,$00,$00,$00
5324:
5325: .if CompileComputer >= C64_GENERAL
5326: LE37B: jsr kCLRCHN
5327: lda #0
5328: sta z13
5329: jsr LA67A
5330: cli
5331:
5332: ; Patch: Output READY, but respect the (lIERROR) vector
5333: ReadyVector:
5334: ldx #$80 ; errorcode = bit 7 set, that is, no error occurred
5335: jmp (lIERROR) ; by default, this is a no-op
5336:
5337: PatchErrorOut:
5338: txa ; check the error code
5339: bmi @LE391 ; bit 7 set? Then no error occurred, jump to "ready"
5340: jmp ErrorOut ; output the error
5341: @LE391:
5342: jmp bREADY
5343: .endif
5344:
5345: LE394:
5346: .ifdef JIFFY
5347: jsr JDLE4B7
5348: .else
5349: jsr LE453
5350: .endif
5351: jsr LE3BF
5352: jsr LE422
5353: ldx #-5 ; stack pointer to $01FB
5354: txs
5355:
5356: .if CompileComputer >= C64_GENERAL
5357: bne ReadyVector
5358: .else
5359: jmp bREADY
5360: .endif
5361:
5362: .segment "CHRGET"
5363:
5364: COPY_OF_CHRGET:
5365: inc zTXTPTR
5366: bne COPY_OF_CHRGOT
5367: inc zTXTPTR + 1
5368:
5369: COPY_OF_CHRGOT:
5370: lda $EA60 ; this is just a dummy address
5371: cmp #'9' + 1
5372: bcs COPY_OF_CHRGOT_RTS
5373:
5374: COPY_OF_CHRGOT_SPACE:
5375: cmp #' '
5376: beq COPY_OF_CHRGET
5377: sec
5378: sbc #'0'
5379: sec
5380: sbc #-'0'
5381: COPY_OF_CHRGOT_RTS:
5382: rts
5383:
5384: .byte $80,$4F,$C7,$52,$58
5385:
5386: END_COPY_OF_CHRGET:
5387:
5388: .segment "INIT"
5389:
5390: LE3BF: lda #ASM_JMP
5391: sta zJMPER
5392: sta lUSRPOK
5393: lda #<bIQERR
5394: ldy #>bIQERR
5395: sta lUSRADD
5396: sty lUSRADD + 1
5397: lda #<bGIVAYF
5398: ldy #>bGIVAYF
5399: sta zADRAY2
5400: sty zADRAY2 + 1
5401: lda #<bFACINX
5402: ldy #>bFACINX
5403: sta zADRAY1
5404: sty zADRAY1 + 1
5405: ldx #END_COPY_OF_CHRGET - COPY_OF_CHRGET - 1
5406: LE3E2: lda COPY_OF_CHRGET,x
5407: sta zCHRGET,x
5408: dex
5409: bpl LE3E2
5410: lda #$03
5411: sta zFOUR6
5412: lda #0
5413: sta zBITS
5414: sta z13
5415: sta zLASTPT + 1
5416: ldx #1
5417: stx lBUF - 3
5418: stx lBUF - 4
5419: ldx #zTEMPST
5420: stx zTEMPPT
5421: sec
5422: jsr kMEMBOT
5423: stx zTXTTAB
5424: sty zTXTTAB + 1
5425: sec
5426: jsr kMEMTOP
5427: stx zMEMSIZ
5428: sty zMEMSIZ + 1
5429: stx zFRETOP
5430: sty zFRETOP + 1
5431: ldy #0
5432: tya
5433: sta (zTXTTAB),y
5434: inc zTXTTAB
5435: bne LE421
5436: inc zTXTTAB + 1
5437: LE421: rts
5438: LE422: lda zTXTTAB
5439: ldy zTXTTAB + 1
5440: jsr bREASON
5441: lda #<LE473
5442: ldy #>LE473
5443: .if CompileComputer = C64_4064
5444: jmp LE441
5445: .else
5446: jsr bSTROUT
5447: .endif
5448: lda zMEMSIZ
5449: sec
5450: sbc zTXTTAB
5451: tax
5452: lda zMEMSIZ + 1
5453: sbc zTXTTAB + 1
5454: jsr LBDCD
5455: lda #<LE460
5456: ldy #>LE460
5457: LE441: jsr bSTROUT
5458: jmp LA644
5459:
5460: .if CompileComputer < C64_GENERAL
5461: ; .include "../vic20/basic-texts.inc"
5462: LE460:
5463: .byte " BYTES FREE",$0D,$00
5464:
5465: LE473: .byte $93
5466: .byte "**** CBM BASIC V2 ****"
5467: .byte $0D,$00
5468: .endif
5469:
5470: LE447:
5471: .if CompileComputer >= C64_GENERAL
5472: .ifdef JIFFY
5473: .addr JDLF763
5474: .else
5475: .addr PatchErrorOut ; for the C64, check if bit 7 of the error code is set.
5476: .endif
5477: .else
5478: .addr ErrorOut ; for the VIC20, this is always an error.
5479: .endif
5480:
5481: .if CompileComputer = C64_GS
5482: .addr C64GS_Init
5483: .else
5484: .addr IMAIN
5485: .endif
5486:
5487: .ifdef JIFFY
5488: .addr LEA64
5489: .else
5490: .addr LA57C
5491: .endif
5492: .addr LA71A
5493: .addr LA7E4
5494: .addr LAE86
5495: END_LE447:
5496:
5497: LE453: ldx #END_LE447 - LE447 - 1
5498: LE455: lda LE447,x
5499: sta lIERROR,x
5500: dex
5501: bpl LE455
5502: rts
5503:
5504: .if CompileComputer >= C64_GENERAL
5505: .byte $00 ; basic checksum?
5506:
5507: ; .include "../c64/basic-texts.inc"
5508: LE460:
5509: .byte " BASIC BYTES FREE",$0D,$00
5510:
5511: LE473: .byte $93
5512:
5513: .ifdef JIFFY
5514: .byte $0D," JIFFYDOS V6.01 (C)1989 CMD "
5515: .byte $0D,$0D
5516: .byte " C-64 BASIC V2 ",$00
5517: .elseif CompileComputer = C64_SX64
5518: .byte $0D," ***** SX-64 BASIC V2.0 *****"
5519: .byte $0D,$0D
5520: .byte " 64K RAM SYSTEM ",$00
5521: .elseif CompileComputer = C64_4064
5522: .byte $0D," **** COMMODORE 4064 BASIC V2.0 ****"
5523: .byte $0D,$0D,$00
5524: .byte " "
5525: .elseif CompileComputer >= C64_GENERAL
5526: .byte $0D," **** COMMODORE 64 BASIC V2 ****"
5527: .byte $0D,$0D
5528: .byte " 64K RAM SYSTEM ",$00
5529: .endif
5530: .endif
5531:
5532: .if CompileComputer < C64_GENERAL
5533:
5534: LE37B:
5535: jsr kCLRCHN
5536: lda #0
5537: sta z13
5538: jsr LA67A
5539: cli
5540: jmp bREADY
5541:
5542: .byte CHECKSUM_E475
5543:
5544: .if CompileComputer >= VIC20_06
5545: LE476:
5546: jsr bLINKPRG
5547: jmp LA677
5548: .endif
5549: .endif
5550:
5551: ; .include "../kernal/kernal-memory.inc"
5552: .segment "MEM_KERNAL_ZP": zeropage
5553:
5554: zSTATUS: .res 1 ; $0090 ; status of TAPE/IEC routines
5555:
5556: zSTKEY: .res 1 ; $0091
5557: zSVXT: .res 1 ; $0092
5558: zVERCKK: .res 1 ; $0093 ; verify flag: Remember in KLOAD if LOAD (=0) or VERIFY (=1) is requested.
5559: zC3PO: .res 1 ; $0094 ; delayed byte for IEC output
5560: ; As an EOI must be signaled BEFORE the last byte is transferred,
5561: ; the KERNAL routines use a delayed write approach:
5562: ;
5563: ; It starts with zC3PO = 0.
5564: ; When the first byte to be output is given to the IEC routines,
5565: ; it is written to zBSOUR, and zC3PO.7 is set.
5566: ; When the next byte is written, zC3PO is tested. As it is negative,
5567: ; the byte in zBSOUR is being output to the IEC bus. Afterwards,
5568: ; the new byte is written into zBSOUR.
5569: ; When the last byte is transferred, the next command transmitted
5570: ; (i.e. LISTEN, TALK, UNLISTEN, UNTALK) tests for zC3PO. As it is
5571: ; negative, the last byte (in zBSOUR) is output to the IEC bus, and
5572: ; an EOI is signalled.
5573: ;
5574: zBSOUR: .res 1 ; $0095 ; The byte to write on the IEC bus. (see also zC3PO)
5575: zSYNO: .res 1 ; $0096
5576: zTEMPX: .res 1 ; $0097
5577: zLDTND: .res 1 ; $0098 ; number of active entries in the lLAT, lFAT and lSAT table
5578: zDFLTN: .res 1 ; $0099
5579: zDFLTO: .res 1 ; $009A
5580: zPRTY: .res 1 ; $009B
5581: zDPSW: .res 1 ; $009C
5582: zNSGFLG: .res 1 ; $009D ; message output policy:
5583: ; bit 7: Output "Loading", "Saving", "Verifying", "Found", ... messages
5584: ; bit 6: Output "I/O ERROR #n" if KERNAL routines encounter an error
5585: ; This value is only set by kSETMSG.
5586:
5587: zPTR1: .res 1 ; $009E
5588: zPTR2: .res 1 ; $009F
5589: zTIME: .res 3 ; $00A0
5590: zTSFCNT: .res 1 ; $00A3 ; mark: signal EOI (== $80) or not (== $00) on IEC bus.
5591: zTBTCNT: .res 1 ; $00A4
5592: zCNTDN: .res 1 ; $00A5
5593: zBUFPNT: .res 1 ; $00A6 ; pointer into tape buffer (lTBUFFR), stored as an index 0..(TBUFFR_SIZE - 1): Contains the last value that was written or read.
5594: zINBIT: .res 1 ; $00A7
5595: zBITC1: .res 1 ; $00A8
5596: zRINONE: .res 1 ; $00A9
5597: zRIDATA: .res 1 ; $00AA
5598: zRIPRTY: .res 1 ; $00AB
5599: zSAL: .res 2 ; $00AC
5600: zEAL: .res 2 ; $00AE
5601: zCMPO: .res 2 ; $00B0
5602: zTAPE1: .res 2 ; $00B2
5603: zBITTS: .res 1 ; $00B4
5604: zNXTBIT: .res 1 ; $00B5
5605: zRODATA: .res 1 ; $00B6
5606: zFNLEN: .res 1 ; $00B7 ; length of the name of the file to be opened. Address at zFNADR. Only used on OPEN and LOAD.
5607: zLA: .res 1 ; $00B8 ; logical device number of current open file (or in preparation to a call to OPEN)
5608: zSA: .res 1 ; $00B9 ; device (primary) address of current open file (or in preparation to a call to OPEN)
5609: zFA: .res 1 ; $00BA ; secondary address of current open file (or in preparation to a call to OPEN)
5610: zFNADR: .res 2 ; $00BB ; address of the name of the file to be opened. Length at zFNLEN. Only used on OPEN and LOAD.
5611: zROPRTY: .res 1 ; $00BD
5612: zFSBLK: .res 1 ; $00BE
5613: zMYCH: .res 1 ; $00BF
5614: zCAS1: .res 1 ; $00C0 ; 0 if no tape operation in progress, != 0 otherwise. Use in the IRQ routine to switch off tape motor, if needed.
5615: zSTAL: .res 2 ; $00C1
5616: zMEMUSS: .res 2 ; $00C3
5617: zLSTX: .res 1 ; $00C5 ; last pressed key. That is, after keyboard scanning completes, this becomes a copy of zSFDX. This is used for determining if key repetition is to be performed.
5618: zNDX: .res 1 ; $00C6 ; current numbers of characters in the keyboard buffer (lKEYD). The maximum is stored in lXMAX.
5619: zRVS: .res 1 ; $00C7
5620: zINDX: .res 1 ; $00C8
5621: zLXSP: .res 1 ; $00C9
5622: zTEMP_zPNTR: .res 1 ; $00CA ; temporary buffer for cursorpos (zPNTR) inside of BASIN
5623: zSFDX: .res 1 ; $00CB ; key code if the code that is currently found pressed
5624: zBLNSW: .res 1 ; $00CC ; blink switch: <> 0 -> disable cursor, == 0 -> enable cursor
5625: zBLNCT: .res 1 ; $00CD
5626: zGDBLN: .res 1 ; $00CE
5627: zBLNON: .res 1 ; $00CF ; current blink state: 0 = cursor currently invisible, 1 = cursor is just now visible on the screen
5628: zCRSW: .res 1 ; $00D0 ; used in editor routines for sreen input: > 0 if CR has been pressed, 0 if there has not been any input yet (or no CR has been pressed yet)
5629: zPNT: .res 2 ; $00D1 ; pointer to start of current cursor row in video RAM (cf. zUSER)
5630: zPNTR: .res 1 ; $00D3 ; column of current cursor position (0 ... X-1)
5631: zQTSW: .res 1 ; $00D4 ; quotation mark switch: 1 = we are in quotation mode, 0 = we are not.
5632: zLNMX: .res 1 ; $00D5 ; maximum column number in the current (logical) line
5633: zTBLX: .res 1 ; $00D6 ; row of current cursor positon (0 ... Y-1)
5634: zSCHAR: .res 1 ; $00D7 ; temporary storage for a character in editor routines for input and output, and temporary storage in tape routines
5635: zINSRT: .res 1 ; $00D8 ; number of characters to output in INSERT mode. 0 = we are not in insert mode
5636: zLDTB1: .res 26 ; $00D9 ; high byte of start address of (logical) screen rows
5637: ; Bit 7 ($80) is 1 if this line is "stand-alone";
5638: ; it is 0 if this line is combined with the previous one
5639: ; the lower bits (and #>lVIDEORAM_SIZE) define the high byte bits of the start address of this row.
5640: ;
5641: ; For the last row, this table entry contains $FF as an end marker.
5642:
5643: zUSER: .res 2 ; $00F3 ; pointer to start of current cursor row in color RAM (cf. zPNT)
5644: zKEYTAB: .res 2 ; $00F5
5645: zRIBUF: .res 2 ; $00F7 ; pointer to the RS232 input buffer (ring buffer) (see also lRIDBE, lRIDBS)
5646: zROBUF: .res 2 ; $00F9 ; pointer to the RS232 output buffer (ring buffer) (see also lRODBE, lRODBS)
5647: zFREKXP: .res 4 ; $00FB
5648:
5649: .segment "MEM_KERNAL_DATA_0200"
5650:
5651: ; the following table contains the data (logical file number, primary address, secondary address) for open files.
5652: ; The entries correspond to each other: That is, lLAT + x, lFAT + x and lSAT + x contain the data for the file
5653: ; with the index (*not* logical file number!) x.
5654:
5655: lLAT_Size := 10
5656: lLAT: .res lLAT_Size ; $0259 ; table of logical file numbers for open files. Number of active entries in zLDTND. Cannot be 0 for active files.
5657: lFAT: .res lLAT_Size ; $0263 ; table of device (primary) addresses for open files. Number of active entries in zLDTND.
5658: lSAT: .res lLAT_Size ; $026D ; table of secondary addresses for open files. Number of active entries in zLDTND.
5659:
5660: lKEYD: .res 10 ; $0277
5661: lMEMSTR: .res 2 ; $0281
5662: lMEMSIZ: .res 2 ; $0283
5663: lTIMOUT: .res 1 ; $0285
5664: lCOLOR: .res 1 ; $0286 ; default color (bit 7 must be 0, or CHROUT_SCREEN will behave erroneouskly!)
5665: lGDCOL: .res 1 ; $0287
5666: lHIBASE: .res 1 ; $0288 ; high byte of video RAM address
5667: lXMAX: .res 1 ; $0289 ; maximum number of characters in the keyboard buffer (lKEYD). zNDX is checked against this value
5668: lRPTFLG: .res 1 ; $028A ; repeat flag for keys
5669: ; bit 7 ($80) == 1 -> repeat all keys
5670: ; bit 6 ($40) == 1 -> do not repeat any key
5671: ; else: Repeat special keys (space, CRSRS, INS/DEL), but not the others
5672:
5673: ; the test is done starting with bit 7, then bit 6.
5674: ; thus, if both are set, all keys are repeated
5675:
5676: lKOUNT: .res 1 ; $028B ; delay counter for key repetitions. This is decremented on every IRQ, starting from 4.
5677:
5678: lDELAY: .res 1 ; $028C ; delay counter for key repetitions. It is used for the initial delay before the key repetition starts.
5679:
5680: lSHFLAG: .res 1 ; $028D ; contains the state of the shift keys while scanning the keyboard.
5681: ; The state is an OR between the following values, if the correspondig key is pressed:
5682: ; bit 0 ($01) = shift
5683: ; bit 1 ($02) = C=
5684: ; bit 2 ($04) = CTRL
5685: lSHFLAG_SHIFT := $01
5686: lSHFLAG_CBM := $02
5687: lSHFLAG_CTRL := $04
5688:
5689: lLSTSHF: .res 1 ; $028E ; contains the *last* shift state. That is, after the keyboard is scanned, this becomes a copy of lSHFLAG. This way, the KERNAL prevents a repeated toggling when pressend SHIFT + C=
5690: lKEYLOG: .res 2 ; $028F
5691: lMODE: .res 1 ; $0291 ; determines editor mode.
5692: ; bit 7 ($80) == 1 -> Switching between uppercase-mode and lowercase-mode via SHIFT + C= is not allowed
5693: ; bit 4 ($10) == 1 -> TODO ??? (used in VIC20-02)
5694: ; bit 3 ($08) == 1 -> we are in lowercase mode, == 0 -> we are in uppercase mode (only VIC20-02)
5695: ; on VIC20-02, lMODE also contains the offset into the @KEYTABS_VEC table ($00-$16)
5696:
5697: ; on the VIC20-02, lMODE is used in CHROUT_SCREEN to determine if some chars are to
5698: ; be translated (according to CHROUT_REPLACEMENT_TABLE). If lMODE is not 0, the
5699: ; translation is done. If it is 0, the translation is skipped.
5700:
5701: lAUTODN: .res 1 ; $0292 ; TODO "Auto down" flag: (Flag: "combine line with next line, if needed")
5702:
5703: ; If the output is done because of some key press, lAUTODN is not 0. In this case,
5704: ; when the output reaches the end of a row, this row is combined with the next
5705: ; row. Furthermore, the screen contents below the current line are scrolled down.
5706:
5707: ; If the output is done without some key press, lAUTODN is 0. In this case,
5708: ; when the output reaches the end of a row, this row is combined with the next
5709: ; one, but the screen contents are NOT scrolled down.
5710:
5711: lM51CTR: .res 1 ; $0293
5712: lM51CDR: .res 1 ; $0294
5713: lM51AJB: .res 2 ; $0295
5714: lRSSTAT: .res 1 ; $0297
5715: lBITNUM: .res 1 ; $0298
5716: lBAUDOF: .res 2 ; $0299
5717: lRIDBE: .res 1 ; $029B ; RS232 input buffer at zRIBUF: read pointer
5718: lRIDBS: .res 1 ; $029C ; RS232 input buffer at zRIBUF: write pointer
5719: lRODBS: .res 1 ; $029D ; RS232 output buffer at zROBUF: read pointer
5720: lRODBE: .res 1 ; $029E ; RS232 output buffer at zROBUF: write pointer
5721: lIRQTMP: .res 2 ; $029F
5722:
5723: .if CompileComputer >= C64_GENERAL
5724:
5725: lENABL: .res 1 ; $02A1 ; CIA2 ICR temporary register
5726: lTODSNS: .res 1 ; $02A2
5727: lTRDTMP: .res 1 ; $02A3
5728: lTD1IRQ: .res 1 ; $02A4
5729: lTLNIDX: .res 1 ; $02A5
5730: lTVSFLG: .res 1 ; $02A6
5731:
5732: .else
5733:
5734: lTLNIDX := $00F2
5735:
5736: .endif
5737:
5738: .segment "MEM_KERNAL_DATA_0300"
5739:
5740: lCINV: .res 2 ; $0314
5741: lCNBINV: .res 2 ; $0316
5742: lNMINV: .res 2 ; $0318
5743: lIOPEN: .res 2 ; $031A
5744: lICLOSE: .res 2 ; $031C
5745: lICHKIN: .res 2 ; $031E
5746: lICKOUT: .res 2 ; $0320
5747: lICLRCH: .res 2 ; $0322
5748: lIBASIN: .res 2 ; $0324
5749: lIBSOUT: .res 2 ; $0326
5750: lISTOP: .res 2 ; $0328
5751: lIGETIN: .res 2 ; $032A
5752: lICLALL: .res 2 ; $032C
5753: lUSRCMD: .res 2 ; $032E
5754: lILOAD: .res 2 ; $0330
5755: lISAVE: .res 2 ; $0332
5756:
5757: .res 8 ; $0334 - $033B, unused
5758:
5759: lTBUFFR_SIZE := $00C0
5760: lTBUFFR: .res lTBUFFR_SIZE ; $033C ; tape buffer. The pointer into this buffer can be found at zBUFPNT.
5761:
5762: .if CompileComputer >= C64_GENERAL
5763: lVIDEORAM := $0400
5764: .if .defined(C64JAPAN)
5765: lBASICRAM := $1000
5766: .else
5767: lBASICRAM := $0800
5768: .endif
5769: .endif
5770:
5771: lVIDEORAM_SIZE := $03FF
5772:
5773: .if CompileComputer = VIC20_02
5774: zMEMUSS_2 := zC3PO
5775: .else
5776: zMEMUSS_2 := zMEMUSS
5777: .endif
5778:
5779: ; .include "../kernal/fileio_data.inc"
5780: .macro LOAD_OVERWRITE_START_ADDRESS
5781: txa
5782: bne :+
5783: lda zMEMUSS
5784: sta zEAL
5785: lda zMEMUSS + 1
5786: sta zEAL + 1
5787: :
5788:
5789: .endmacro
5790:
5791: .macro FILEIO_PATCH_CLOSE_TAPE
5792:
5793: jsr TapeWriteCompleteBuffer ; write out the tape buffer to tape
5794: bcc FileIoPatch_NoError ; C = 0 -> no error -> branch
5795:
5796: pla ; get back index into table of open files
5797: lda #$00
5798:
5799: .endmacro
5800:
5801: ; .include "../kernal/iec_data.inc"
5802: ; after calling IecGetDataClockIn, gets
5803: ; - DATA IN in Carry
5804: .macro IEC_GET_DATA_INTO_CARRY
5805: .if CompileComputer < C64_GENERAL
5806: lsr a
5807: .endif
5808: .endmacro
5809:
5810: .macro IEC_REG__DATA_IN_INTO_CARRY
5811: .if CompileComputer >= C64_GENERAL
5812: asl a
5813: .else
5814: lsr a
5815: lsr a
5816: .endif
5817: .endmacro
5818:
5819: .macro IEC_REG__CLOCK_IN_INTO_CARRY
5820: .if CompileComputer >= C64_GENERAL
5821: .error IEC_REG__CLOCK_IN_INTO_CARRY not defined for C64!
5822: .else
5823: lsr a
5824: .endif
5825: .endmacro
5826:
5827: .if CompileComputer >= VIC20_06
5828:
5829: ; FillUntil $E4A0,FILL_FFXX
5830:
5831: .segment "KERNALPATCH"
5832:
5833: LE4BC:
5834: ldx zSA
5835: jmp OutputSearchingFor
5836:
5837: LE4C1:
5838: LOAD_OVERWRITE_START_ADDRESS
5839: jmp OutputLoadingOrVerify ; output LOADING or VERIFYING messages
5840:
5841: FileIoPatchCloseTape:
5842: FILEIO_PATCH_CLOSE_TAPE
5843:
5844: FileIoPatch_NoError:
5845: jmp FileIoPatchCloseTape_Return
5846:
5847: .endif
5848:
5849: ; FillUntil $E500,FILL_FFXX
5850:
5851: .segment "KERNAL"
5852:
5853: ; .include "../kernal/editor.a65"
5854: ; B-12. Function Name: IOBASE
5855: ;
5856: ; Purpose: Define I/O memory page
5857: ; Call address: $FFF3 (hex) 65523 (decimal)
5858: ; Communication registers: X, Y
5859: ; Preparatory routines: None
5860: ; Error returns:
5861: ; Stack requirements: 2
5862: ; Registers affected: X, Y
5863: ;
5864: ;
5865: ; Description: This routine sets the X and Y registers to the address of
5866: ; the memory section where the memory mapped 110 devices are located. This
5867: ; address can then be used with an offset to access the memory mapped I/O
5868: ; devices in the Commodore 64. The offset is the number of locations from
5869: ; the beginning of the page on which the I/O register you want is located.
5870: ; The X register contains the low order address byte, while the Y register
5871: ; contains the high order address byte.
5872: ; This routine exists to provide compatibility between the Commodore 64,
5873: ; VIC-20, and future models of the Commodore 64. If the J/0 locations for
5874: ; a machine language program are set by a call to this routine, they should
5875: ; still remain compatible with future versions of the Commodore 64, the
5876: ; KERNAL and BASIC.
5877: ;
5878: ;
5879: ; How to Use:
5880: ;
5881: ; 1) Call this routine by using the JSR instruction.
5882: ; 2) Store the X and the Y registers in consecutive locations.
5883: ; 3) Load the Y register with the offset.
5884: ; 4) Access that I/O location.
5885: ;
5886: ; EXAMPLE:
5887: ;
5888: ; ;SET THE DATA DIRECTION REGISTER OF THE USER PORT TO 0 (INPUT)
5889: ; JSR IOBASE
5890: ; STX POINT ;SET BASE REGISTERS
5891: ; STY POINT+1
5892: ; LDY #2
5893: ; LDA #0 ;OFFSET FOR DDR OF THE USER PORT
5894: ; STA (POINT),Y ;SET DDR TO 0
5895: ;
5896: ;
5897: iIOBASE:
5898: ; return IO base address in x/y
5899: ; On the VIC-20 and C64, this is interpreted as
5900: ; the base address of the first VIA/CIA.
5901:
5902: ldx #<IOBASE
5903: ldy #>IOBASE
5904: rts
5905:
5906: ; B-26. Function Name: SCREEN
5907: ;
5908: ; Purpose: Return screen format
5909: ; Call address: $FFED (hex) 65517 (decimal)
5910: ; Communication registers: X, Y
5911: ; Preparatory routines: None
5912: ; Stack requirements: 2
5913: ; Registers affected: X, Y
5914: ;
5915: ; Description: This routine returns the format of the screen, e.g., 40
5916: ; columns in X and 25 lines in Y. The routine can be used to determine what
5917: ; machine a program is running on. This function has been implemented on
5918: ; the Commodore 64 to help upward compatibility of your programs.
5919: ;
5920: ;
5921: ;
5922: ;
5923: ; How to Use:
5924: ;
5925: ; 1) Call this routine.
5926: ;
5927: ; EXAMPLE:
5928: ;
5929: ; JSR SCREEN
5930: ; STX MAXCOL
5931: ; STY MAXROW
5932: ;
5933: ;
5934: iSCREEN:
5935: ; return screen resolution in x / y
5936:
5937: ldx #EDITOR_COLS
5938: ldy #EDITOR_ROWS
5939: rts
5940:
5941: ; B-19. Function Name: PLOT
5942: ;
5943: ; Purpose: Set cursor location
5944: ; Call address: $FFF0 (hex) 65520 (decimal)
5945: ; Communication registers: A, X, Y
5946: ; Preparatory routines: None
5947: ; Error returns: None
5948: ; Stack requirements: 2
5949: ; Registers affected: A, X, Y
5950: ;
5951: ; Description: A call to this routine with the accumulator carry flag
5952: ; set loads the current position of the cursor on the screen (in X,Y
5953: ; coordinates) into the Y and X registers. Y is the column number of the
5954: ; cursor location (0-39), and X is the row number of the location of the
5955: ; cursor (0-24). A call with the carry bit clear moves the cursor to X,Y
5956: ; as determined by the Y and X registers.
5957: ;
5958: ; How to Use:
5959: ;
5960: ;
5961: ; READING CURSOR LOCATION
5962: ;
5963: ; 1) Set the carry flag.
5964: ; 2) Call this routine.
5965: ; 3) Get the X and Y position from the Y and X registers, respectively.
5966: ;
5967: ;
5968: ; SETTING CURSOR LOCATION
5969: ;
5970: ; 1) Clear carry flag.
5971: ; 2) Set the Y and X registers to the desired cursor location.
5972: ; 3) Call this routine.
5973: ;
5974: ;
5975: ; EXAMPLE:
5976: ;
5977: ; ;MOVE THE CURSOR TO ROW 10, COLUMN 5 (5,10)
5978: ; LDX #10
5979: ; LDY #5
5980: ; CLC
5981: ; JSR PLOT
5982: ;
5983: ;
5984: iPLOT:
5985: bcs iPLOTReadOnly ; carry set -> read values
5986:
5987: JDLE50C:
5988: stx zTBLX ; save new cursor pos: y position from X
5989: sty zPNTR ; save new cursor pos: x position from Y
5990:
5991: jsr SET_CURSORPOS ; update all other internal states to the new position
5992:
5993: iPLOTReadOnly:
5994: ldx zTBLX ; get cursor position in x and y
5995: ldy zPNTR
5996:
5997: rts
5998:
5999: ; B-7. Function Name: CINT
6000: ;
6001: ; Purpose: Initialize screen editor & 6567 video chip
6002: ; Call address: $FF81 (hex) 65409 (decimal)
6003: ; Communication registers: None
6004: ; Preparatory routines: None
6005: ; Error returns: None
6006: ; Stack requirements: 4
6007: ; Registers affected: A, X, Y
6008: ;
6009: ;
6010: ; Description: This routine sets up the 6567 video controller chip in the
6011: ; Commodore 64 for normal operation. The KERNAL screen editor is also
6012: ; initialized. This routine should be called by a Commodore 64 program
6013: ; cartridge.
6014: ;
6015: ; How to Use:
6016: ;
6017: ; 1) Call this routine.
6018: ;
6019: ; EXAMPLE:
6020: ;
6021: ; JSR CINT
6022: ; JMP RUN ;BEGIN EXECUTION
6023: ;
6024: ;
6025: iCINT: jsr CLRCHN_AND_VIC_DEFAULTS
6026:
6027: .if CompileComputer < C64_GENERAL
6028:
6029: ; adjust the VIC-I to take the screen memory from the memory
6030: ; area that is configured in lHIBASE.
6031:
6032: ; on the VIC-I,
6033: ; bits 13-10 of the video RAM address is stored in VICI_O_MemoryLocations.7-VICI_O_MemoryLocations.4,
6034: ; and bit 9 of the video RAM address is stored in VIC_02.7.
6035:
6036: ; Now, bit 13 of the VIC-I is connected to the INVERSE of A15 of the 6502.
6037: ; Thus, the VIC-I sees another memory map than the 6502:
6038: ;
6039: ; VIC-I <-> 6502
6040: ; $0000-$1FFF <-> $8000-$9FFF
6041: ; $2000-$3FFF <-> $0000-$1FFF (*)
6042: ;
6043: ; (*) Note that the VIC-I cannot see $0400-$0FFF of the 6502 memory map
6044: ; ($2400-$2FFF in the VIC-I memory map) due to the way the memory
6045: ; is connected on the external RAM cartridge
6046:
6047:
6048: lda lHIBASE ; get high byte of video RAM address
6049: and #~$02 ; mask out bit 9 (bit 8-0 of the base address
6050: ; must be 0, anyway)
6051:
6052: asl a ; shift the address to the right position
6053: asl a
6054:
6055: ; here, A.7 - A.4 contain the address of the video RAM start, as needed in VICI_O_MemoryLocations
6056:
6057: ora #$80 ; b13 of the VIC-I is connected to the INVERSE of A15
6058: ; of the 6502 (cf. comment above).
6059: ; Take this into account and make the VIC-I see
6060: ; the 6502 memory area $0000-$1FFF.
6061:
6062: sta VIC + VICI_O_MemoryLocations ; store b
6063:
6064: lda lHIBASE ; get back the high byte of the video RAM address
6065: and #$02 ; is bit 9 set?
6066: beq @NoSetBit9 ; no, branch -> do not set VICI_O_VideoColumns.7
6067: ; (it has been already reset in CLRCHN_AND_VIC_DEFAULTS)
6068:
6069: lda #VICI_B_VideoColumns_ScreenMemoryB9 ; set bit 9 of video RAM address
6070: ora VIC + VICI_O_VideoColumns ; in VICI_O_02.7
6071: sta VIC + VICI_O_VideoColumns
6072:
6073: @NoSetBit9:
6074:
6075: .endif
6076:
6077: lda #$00 ; set editor mode
6078: sta lMODE
6079:
6080: sta zBLNON ; blink mode: Currently, the cursor is not on
6081:
6082: lda #<CHECK_SHIFT_CTRL_CBM
6083: sta lKEYLOG
6084: lda #>CHECK_SHIFT_CTRL_CBM
6085: sta lKEYLOG + 1
6086:
6087: lda #10
6088: sta lXMAX ; maximum number of characters in the keyboard buffer is 10
6089: sta lDELAY ; set delay for delay of the start of key repetition to default (10)
6090:
6091: lda #DEFAULT_COLOR ; set default color
6092: sta lCOLOR
6093:
6094: lda #$04 ; set delay counter for key repetitions
6095: sta lKOUNT
6096:
6097: lda #$0C
6098: sta zBLNCT ; set the blink counter
6099: sta zBLNSW ; disable cursor
6100:
6101: ; update the table of low bytes and link bits for the screen row
6102:
6103: ClearScreen:
6104: lda lHIBASE ; get the high byte of the start of the video RAM
6105: ora #$80 ; set link bit -> this row is not connected to the previous one
6106: tay
6107: lda #$00 ; low byte of the start of the video RAM (A) := 0
6108: tax ; row counter (X) := 0, start in row zero
6109:
6110: @Next: sty zLDTB1,x ; store the high byte and the link bit of this line
6111:
6112: ; proceed to next row by adding the number of columns in one row (EDITOR_COLS)
6113:
6114: clc
6115: adc #EDITOR_COLS ; add the number of columns in a line to the low byte
6116: bcc @NoHighByte ; no carry -> we do not need to increment the high byte
6117: iny ; increment the high byte
6118:
6119: @NoHighByte:
6120: inx ; increment row counter
6121: cpx #EDITOR_ROWS + 1 ; did we reach the last row?
6122: bne @Next ; not yet, store the next high byte and link bit
6123:
6124: lda #$FF ; write the "end marker"
6125: sta zLDTB1,x ; into the location for the row past the last one
6126:
6127: ; Erase the screen rows (overwrite with spaces)
6128:
6129: ldx #EDITOR_ROWS - 1 ; start in the last row
6130: @NextLine:
6131: jsr EraseScreenRow ; erase the row
6132: dex ; go to previous line
6133: bpl @NextLine ; not all rows are processed, branch -> process previous one
6134:
6135: CURSOR_HOME:
6136: ; set cursor position to 0/0
6137:
6138: ldy #0
6139: sty zPNTR ; column
6140: sty zTBLX ; row
6141:
6142: SET_CURSORPOS:
6143:
6144: ; this routine updates the internal pointer to conform to the cursor
6145: ; position set in zPNTR/zTBLX. As this function is used from other
6146: ; places, for example from iPLOT, it is completely implemented, and it
6147: ; does not use any hard-coded constants for CURSOR_HOME only.
6148:
6149: ldx zTBLX ; get row into X
6150: lda zPNTR ; get column into A
6151:
6152: @AddLine:
6153: ldy zLDTB1,x ; is this row combined with the previous one?
6154: bmi @StandaloneLine ; no, branch
6155:
6156: ; otherwise, add the number of columns to the col position
6157: clc
6158: adc #EDITOR_COLS
6159: sta zPNTR ; store (updated) column position
6160: dex ; ... and the row is one less
6161: bpl @AddLine ; unconditional jump (row 0 should never be combined with the previous row!)
6162: ; --------------
6163:
6164: @StandaloneLine:
6165:
6166: .if CompileComputer >= C64_03 .or .defined(C64JAPAN)
6167: jsr CalculateScreenPointerFromRowNumber ; This is essentially the same as the VIC20 (and C64-02 and earlier) implementation. Only the order in which high and low byte are calculated is changed.
6168: ; This subroutine is used to gain memory for the later patch
6169: .else
6170: lda zLDTB1,x ; get high byte of the starting address of this row
6171: and #>lVIDEORAM_SIZE ; mask out additional bits used as flags
6172: ora lHIBASE ; add the video RAM base
6173: sta zPNT + 1 ; remember high byte
6174:
6175: lda SCREEN_LOWBYTE,x ; get low byte of the starting address of this row
6176: sta zPNT ; remember low byte
6177:
6178: .endif
6179:
6180: ; calculate the number of columns (more precisely: The last column number)
6181: ; in this logical line
6182:
6183: lda #EDITOR_COLS - 1 ; start with one physical line
6184:
6185: inx ; Here, X points to the first line *before* the extended long line. Thus, go back into the long line area
6186:
6187: @Loop: ldy zLDTB1,x ; is this line combined with the previous one?
6188: bmi @StoreLineLength ; no, branch -> quit loop
6189:
6190: clc ; add a complete line length
6191: adc #EDITOR_COLS
6192:
6193: inx ; proceed to the next line
6194: bpl @Loop ; (unconditional branch)
6195: ; -----------------------------
6196:
6197: @StoreLineLength:
6198: sta zLNMX ; store line length
6199:
6200: .if CompileComputer >= C64_03 .or .defined(C64JAPAN)
6201: ; this fixes a bug in the C64 ROMs:
6202: ; If the last row is combined to build a long line (80 chars),
6203: ; and the last character is deleted afterwards with backspace,
6204: ; the C64 will start a LOAD command and will not react
6205: ; anymore unless there is an attached tape recorder.
6206:
6207: ; This patch fixes this:
6208:
6209: jmp UpdateColorRAMPointerToVideoramPointer ; also update the color RAM pointer (zUSER)
6210:
6211: ; this is another patch on the C64-03 ROMs:
6212: ; TODO: why?
6213: ;
6214: ; It is called after LDX zTBLX (get current cursor row)
6215:
6216: Patch_CursorOneRowUp:
6217: cpx zLXSP ; did the cursor row change while we were in the routine?
6218: beq @Ret ; no -> branch, we're done
6219: jmp CursorOneRowUp
6220: @Ret: rts
6221:
6222: nop
6223:
6224: .else
6225: rts
6226: .endif
6227:
6228:
6229: ; unused in VIC20 and C64 ROM!
6230:
6231: jsr CLRCHN_AND_VIC_DEFAULTS
6232: jmp CURSOR_HOME
6233:
6234:
6235: CLRCHN_AND_VIC_DEFAULTS:
6236: ; This routine restores input and output to the terminal
6237: ; (screen and keyboard).
6238: ; Afterwards, it initialises the VIC (or VIC-II) registers
6239:
6240: lda #FILE_SCREEN ; default output to screen
6241: sta zDFLTO
6242: lda #FILE_KEYBOARD ; default input to keyboard
6243: sta zDFLTN
6244:
6245: SET_VIC_DEFAULTS:
6246:
6247: ; This routine initialises the VIC (or VIC-II) registers
6248:
6249: ; Loop throught the table and overwrite the VIC (-II) registers
6250: ; with the table contents
6251:
6252: ldx #END_VIC_DEFAULTS - VIC_DEFAULTS + 1 ; number of register values in the table
6253: @Loop: lda VIC_DEFAULTS - 1,x
6254: sta VIC - 1,x
6255: dex
6256: bne @Loop
6257: rts
6258:
6259: GETIN_KEYB:
6260:
6261: ; Get a character from the keyboard buffer
6262: ; this function returns a character from the keyboard buffer
6263: ; It also deletes it from there.
6264: ;
6265: ; Prerequisites:
6266: ;
6267: ; - Before calling this function, the I flag must be set (SEI)
6268: ; It will be cleared on exit
6269: ;
6270: ; - Make sure the keyboard buffer is not empty before calling this function!
6271:
6272: ldy lKEYD ; remember first key press in the keyboard buffer
6273:
6274: ; move all key presses in the keyboard buffer one step to the front
6275:
6276: ldx #0
6277: @Loop: lda lKEYD + 1,x ; move entry one step ahead
6278: sta lKEYD,x
6279: inx ; proceed to next one
6280: cpx zNDX ; did we already process all keys?
6281: bne @Loop ; no, branch -> process the next key
6282:
6283: dec zNDX ; we just removed and key, thus, decrement the number of keys in the buffer
6284:
6285: tya ; get back the first key press in the keyboard buffer
6286:
6287: cli
6288: clc ; quit with success
6289: rts
6290:
6291: OutputCharacterAndWaitForKeyPress:
6292: jsr CHROUT_SCREEN
6293:
6294: WaitForKeyPress:
6295: lda zNDX ; number of key presses in keyboard buffer
6296: sta zBLNSW ; if > 0: disable cursor blinking, otherwise: Enable cursor blinking
6297: sta lAUTODN ; If there was some key press, mark that any output that will combine two rows will scroll down the screen contents
6298: ; (this loop cannot be quit with lAUTODN = 0)
6299: beq WaitForKeyPress ; no key presses -> wait until some key has been pressed
6300:
6301: ; now that one or more key has been pressed, output it/them
6302:
6303: ; first, restore the character under the cursor (if the cursor has been visible)
6304:
6305: sei
6306: lda zBLNON ; cursor currently visible?
6307: beq @CursorNotVisible ; no, skip restoring it
6308:
6309: ; restore character under the cursor
6310:
6311: lda zGDBLN ; get character code
6312: ldx lGDCOL ; and color of character under cursor
6313:
6314: ldy #0
6315: sty zBLNON ; mark: Cursor is currently invisible
6316:
6317: jsr StoreCharacterOnScreenAndDisableBlinking ; store the character under the cursor on the screen
6318:
6319: @CursorNotVisible:
6320:
6321: .ifdef JIFFY
6322: jsr JDLF9E5
6323: .else
6324: jsr GETIN_KEYB ; get the next character
6325: .endif
6326: cmp #KEY_SHIFTRUN ; was is Shift + Run/Stop?
6327: bne NoShiftRunStop ; no, branch -> jump special processing
6328:
6329: ; If we reach here, the user pressed Shift + Run/Stop
6330: ; Then, store the special text into the keyboard buffer and
6331: ; process the characters, one after the other.
6332: ;
6333: ; Note that any other key presses that might have been
6334: ; in the keyboard buffer are removed.
6335:
6336: ldx #END_TEXT_SHIFTRUNSTOP - TEXT_SHIFTRUNSTOP
6337: sei
6338: stx zNDX ; set the count of characters
6339:
6340: @ShiftRunStop:
6341: lda TEXT_SHIFTRUNSTOP - 1,x ; copy text
6342: sta lKEYD - 1,x ; into the keyboard buffer
6343: dex
6344: bne @ShiftRunStop ; until all characters have been processed
6345: beq WaitForKeyPress ; now, process the key presses (uncond. branch)
6346: ; -------------------------------
6347:
6348: NoShiftRunStop:
6349: cmp #ASC_CR ; was the key a CR?
6350: bne OutputCharacterAndWaitForKeyPress ; no, output the character and wait for the next key press
6351:
6352: ; When we reach here, the user has entered anything and pressed CR.
6353: ; Now, we process the input
6354:
6355: ldy zLNMX ; get the (logical) line length of the current line
6356: sty zCRSW ; store it as number of characters to read
6357:
6358: @CheckSpaceNext:
6359: lda (zPNT),y ; read the next character at the end of the line
6360: cmp #' ' ; is it a space?
6361: bne @NoSpace ; No -> branch,
6362: dey ; Yes, it was a space: Test the previous character
6363: bne @CheckSpaceNext ; until we have checked all characters in this line, branch
6364:
6365: @NoSpace:
6366: iny
6367: sty zINDX ; remember the number of characters in the current line
6368: ldy #0
6369: sty lAUTODN ; Mark: No key press yet, thus, any output will scroll down the screen contents if some rows will be combined
6370: sty zPNTR ; start reading at the beginning of the line
6371: sty zQTSW ; We are not in quotation mark mode
6372: lda zLXSP ; value of zTBLX before calling BASIN (zTBLX is not changed when calling GETIN
6373: bmi BASIN_KEYB_PROCESS_KEY ; TODO what?
6374:
6375: ldx zTBLX ; current cursor row on screen
6376:
6377: ; set the cursor one (virtual) row up
6378:
6379: .if CompileComputer >= C64_03 .or .defined(C64JAPAN)
6380: ; for -03 ROMs, it was decided that this the cursor row is only moved up
6381: ; if it has already changed since this function began
6382: ; TODO why?
6383: ;
6384: jsr Patch_CursorOneRowUp
6385: .else
6386: jsr CursorOneRowUp
6387: .endif
6388:
6389: ; here: with X := current row (modified in CursorOneRowUp / Patch_CursorOneRowUp)
6390:
6391: cpx zLXSP ; has the cursor row on screen changed?
6392: bne BASIN_KEYB_PROCESS_KEY ; yes -> branch, get keyboard input
6393:
6394: .if CompileComputer < C64_GENERAL
6395: bne BASIN_KEYB_PROCESS_KEY ; some superfluous leftover
6396: .endif
6397:
6398: lda zTEMP_zPNTR ; restore current cursor column (zPNTR) from zTEMP_zPNTR
6399: sta zPNTR
6400: cmp zINDX ; did the column change while we were in the routine?
6401: bcc BASIN_KEYB_PROCESS_KEY ; we are now to the left of the column at the beginning -> branch, get new key input
6402: bcs BASIN_KEYB_END_LINE ; we are at the same column or right from it -> branch, done
6403: ; -------------------------
6404:
6405: BASIN_KEYB:
6406:
6407: ; remember Y and X on the stack
6408:
6409: tya
6410: pha
6411: txa
6412: pha
6413:
6414: lda zCRSW ; has CR been pressed already?
6415: ; that is, are there already keys to
6416: ; process on the screen?
6417: beq WaitForKeyPress ; No, wait for input of a complete line
6418:
6419: BASIN_KEYB_PROCESS_KEY:
6420: ldy zPNTR ; get pointer into current line
6421: lda (zPNT),y ; get current character at that position
6422:
6423: .if CompileComputer >= C64_GENERAL
6424: .elseif CompileComputer >= VIC20_06
6425:
6426: ; FillUntil $E672,$EA
6427: FillNOP 23
6428:
6429: .else
6430:
6431: ; It seems the VIC20_0ß2 ROM has some kind of "cooked" screen codes.
6432: ; This routine converts some characters into others, bypassing the
6433: ; screen code to PETSCII conversion later
6434:
6435: ldx lMODE ; if lMODE == 0 then we do not use the "cooked" mode
6436: beq @End ; Thus, in this case, skip the conversion
6437:
6438: ldx #SpecialScreenCodeHandleTable_END - SpecialScreenCodeHandleTable - 2
6439: @FindChar:
6440: cmp SpecialScreenCodeHandleTable,x ; is the current character a special one?
6441: beq @FoundCharacter ; yes, branch -> convert it
6442: dex ; no, proceed to previous special character
6443: dex
6444: bpl @FindChar ; test the next char
6445: bmi @End ; table has completed -> branch, quit
6446: ; ---------------
6447:
6448: @FoundCharacter:
6449: lda SpecialScreenCodeHandleTable + 1,x ; convert the screen code to the replacement
6450: bne @ProceedToNextScreenLocation ; (uncond. branch)
6451: ; --------------------------------------
6452:
6453: @End:
6454:
6455: .endif
6456:
6457: ; convert the character (in A) into PETSCII TODO
6458: ;
6459: ; Here, we convert the codes as follows:
6460: ;
6461: ; SCREEN CODE -> PETSCII
6462: ; $00-$1F -> $40-$5F
6463: ; $20-$3F -> $20-$3F
6464: ; $40-$5F -> $60-$7F
6465: ; TODO ???
6466: ;
6467:
6468: sta zSCHAR ; store the character
6469:
6470: and #$3F ; mask out the upper 2 bits (7, 6)
6471: asl zSCHAR ; put bit 7 into C
6472: bit zSCHAR ; test the remaining part
6473:
6474: ; now, we have the following status of the flags:
6475: ; C = bit 7 of A on input
6476: ; N = bit 6 of A on input
6477: ; V = bit 5 of A on input
6478:
6479: bpl @DoNotSetBit7 ; N=0 -> bit 6 was 0, that is, we have $00-$3F or $80-$BF
6480:
6481: ora #$80 ; otherwise, set bit 7
6482:
6483: @DoNotSetBit7:
6484: bcc @Process0x00_To_0x7F ; was bit 7 == 0? --> branch
6485:
6486: ldx zQTSW ; Check quotation mark mode
6487: bne @ProceedToNextScreenLocation ; branch if we are in quotation mark mode
6488:
6489: @Process0x00_To_0x7F:
6490: bvs @ProceedToNextScreenLocation ; was bit 5 == 1? --> branch
6491: ora #$40 ; otherwise, set bit 6
6492:
6493: ; here, we converted: (TODO: check again!)
6494: ; $00-$1F -> $40-$5F
6495: ; $20-$3F -> $20-$3F
6496: ; $40-$5F -> $80-$9F
6497: ; $60-$7F -> $C0-$DF
6498:
6499: @ProceedToNextScreenLocation:
6500: inc zPNTR ; proceed to next screen location
6501:
6502: jsr CheckQuote ; update the quotation mark mode flag
6503:
6504: cpy zINDX ; have we reached the end of the line?
6505: bne BASIN_KEYB_QUIT ; no, return the current character
6506:
6507: ; if we reach here, then we have read the complete line
6508: ; Thus, clear all states and return the CR as marker for end-of-line
6509:
6510: BASIN_KEYB_END_LINE:
6511: lda #0
6512: sta zCRSW ; remember: We do not have any characters anymore
6513: lda #ASC_CR ; return a CR Value
6514:
6515: ldx zDFLTN
6516: cpx #FILE_SCREEN ; default input file = screen?
6517: beq @OutputCharacter ; yes, output the CR
6518:
6519: ldx zDFLTO
6520: cpx #FILE_SCREEN ; default output file = screen?
6521: beq @QuitWithCR ; yes, quit
6522:
6523: ; if we reach here, the input was from the keyboard, and the output was not the screen.
6524: ; Thus, output the CR we got from the keyboard
6525:
6526: @OutputCharacter:
6527: jsr CHROUT_SCREEN ; output the character on the screen
6528:
6529: @QuitWithCR:
6530: lda #ASC_CR ; return a CR value
6531:
6532: BASIN_KEYB_QUIT:
6533: sta zSCHAR ; remember read char
6534:
6535: ; restore X and Y from stack
6536: pla
6537: tax
6538: pla
6539: tay
6540:
6541: lda zSCHAR ; get back remembered read char
6542: cmp #ASC_PI ; is it the PETSCII code for PI?
6543: bne @ClcRts ; no, branch -> we are done
6544: lda #TokPi ; yes, replace it by the BASIC token for PI (TODO why did CBM choose this route?)
6545: @ClcRts:
6546: clc ; we successfully ended the routine
6547: rts
6548: ; --------------
6549:
6550: CheckQuote:
6551: cmp #'"' ; Is the current char a quotation mark?
6552: bne @Rts ; no, quit
6553:
6554: ; invert the state of the quotation mark
6555: lda zQTSW
6556: eor #$01
6557: sta zQTSW
6558:
6559: lda #'"' ; restore the character
6560: @Rts: rts
6561:
6562:
6563: ; @@@@@
6564:
6565: LE691: ora #$40
6566:
6567: CHROUT_SCREEN_OUTPUT_WITH_TEST_RVS:
6568: ldx zRVS ; Is the flag "output in reverse" set?
6569: beq CHROUT_OUTPUT_SCREEN_IN_NORMAL ; no -> branch, output in normal
6570:
6571: CHROUT_SCREEN_OUTPUT_IN_RVS:
6572: ora #$80 ; setting bit 7 of the char to output: reverse the char
6573:
6574: CHROUT_OUTPUT_SCREEN_IN_NORMAL:
6575: ldx zINSRT ; Number of characters to output in "insert mode"
6576: beq @NoInsertMode ; none -> we are not in insert mode -> branch
6577: dec zINSRT ; decrement number of characters to output in revers mode
6578:
6579: @NoInsertMode:
6580: ldx lCOLOR ; get the current color
6581: jsr StoreCharacterOnScreenAndDisableBlinking ; output character in A, color in X
6582: jsr MoveCursorRightAfterOutput ; move the cursor to the next output position
6583:
6584: CHROUT_SCREEN_END:
6585: pla ; restore Y from stack
6586: tay
6587:
6588: lda zINSRT ; insert mode?
6589: beq @DontStopQuotationMode ; no, branch
6590: lsr zQTSW ; end quotation mark mode
6591: @DontStopQuotationMode:
6592: pla ; restore X from stack
6593: tax
6594:
6595: pla ; restore A from stack
6596: clc ; we ended successfully
6597: cli
6598: rts
6599: ; --------------
6600:
6601: MoveCursorRightAfterOutput:
6602: jsr AdjustCursorRowBeforeMovingRight ; if we will move to the next row, increment row number
6603: inc zPNTR ; increment column into current row -> move cursor to the right
6604: lda zLNMX ; get number of column in current row
6605: cmp zPNTR ; did we go past the last column?
6606: bcs EditorRts ; no -> branch, we do not need to adjust column
6607: cmp #(EDITOR_MAX_COMBINED_ROWS * EDITOR_COLS) - 1 ; did we reach the maximum length of a virtual row?
6608: beq SetCursorToTheBeginningOfTheNextLine ; yes -> branch, set cursor to the beginning of the next line
6609:
6610: lda lAUTODN ; do we have to scroll down the screen contents?
6611: beq @CombineRows ; no, skip the scrolling
6612: jmp LE967 ; (will return to LogicallyCombineTwoRows)
6613: ; ------------------
6614:
6615: @CombineRows:
6616: ldx zTBLX
6617: cpx #EDITOR_ROWS
6618: bcc LogicallyCombineTwoRows
6619: jsr LE8EA
6620: dec zTBLX
6621: ldx zTBLX
6622:
6623: LogicallyCombineTwoRows:
6624: asl zLDTB1,x ; clear bit 7 -> combine this phyiscal row with the previous one
6625: lsr zLDTB1,x
6626:
6627: .macro EDITOR_PATCH_LogicallyCombineTwoRows_FIX
6628:
6629: ; only present on VIC20-06 ROMs and above, and C64 ROMs.
6630:
6631: ; mark the next row as being stand-alone
6632:
6633: ; TODO what exactly does this patch fix?
6634:
6635: inx ; go to the next row
6636: lda zLDTB1,x
6637: ora #$80 ; set bit 7 --> this row is not combined with the previous one
6638: sta zLDTB1,x
6639: dex ; go back to the previous row
6640: .endmacro
6641:
6642: .macro EDITOR_PATCH_LogicallyCombineTwoRows_COMMON
6643: ; from here on, this is done for all variants, including the VIC20-2
6644:
6645: lda zLNMX ; maximum number of columns on the current (virtual) row
6646: clc
6647: .endmacro
6648:
6649: ; depending on the firmware built,
6650: .if CompileComputer >= C64_GENERAL
6651: EDITOR_PATCH_LogicallyCombineTwoRows_FIX
6652: EDITOR_PATCH_LogicallyCombineTwoRows_COMMON
6653: .elseif CompileComputer >= VIC20_06
6654: ; on the VIC20-06 and -07, this patch is really a patch.
6655: ; We come back with a JMP
6656: jmp EditorPatchLogicallyCombineTwoRows
6657: EditorPatchLogicallyCombineTwoRows_Return:
6658:
6659: .else
6660: ; old implementation for VIC20-02
6661: EDITOR_PATCH_LogicallyCombineTwoRows_COMMON
6662: .endif
6663:
6664: adc #EDITOR_COLS ; add the number of column of one (physical) row
6665: sta zLNMX ; and set it as the new maximum number of columns on the current (virtual) row
6666:
6667: CursorOneRowUp:
6668: ; input: X := Cursor row
6669: ;
6670: ; set the cursor row to point to the (virtual) row above us.
6671:
6672: lda zLDTB1,x ; is the current row combined with the previous one?
6673: bmi @NotCombined ; no, we're done
6674: dex ; cursor on (physical) row up
6675: bne CursorOneRowUp ; not 0 -> not at top of screen -> branch, test the next (physical) row
6676:
6677: @NotCombined:
6678: jmp CalculateScreenPointerFromRowNumber ; adjust screen pointer
6679: ; -----------------------------------------
6680:
6681: SetCursorToTheBeginningOfTheNextLine:
6682: dec zTBLX ; go up one row (will be undone in the next routine)
6683: jsr GoDownOneVirtualRow ; go down one (virtual) row
6684: lda #0
6685: sta zPNTR ; set column to the beginning of the row
6686: EditorRts:
6687: rts
6688: ; -----------------------------------------
6689:
6690:
6691: ; Perform the wrap-around to the previous row of
6692: ; INS/DEL or CRSR LEFT is pressed on the leftmost column.
6693: ;
6694: ; If the cursor is not at the home position, it
6695: ; puts the cursor one row to the top, and on the last
6696: ; column if that row.
6697: ;
6698: ; NOTE:
6699: ; If the cursor is already at the home position,
6700: ; this function removes the return address from the stack!
6701: ; Instead, it jumps to CHROUT_SCREEN_END.
6702: ;
6703: CHROUT_SCREEN_WrapAroundToPreviousRow:
6704: ldx zTBLX ; get row of current cursor position
6705: bne @CanGoBack ; not zero -> branch
6706:
6707: ; if we reach here, then we are already on the first ("0th") row, and we are in the first ("0th") column (as we were called in the first place).
6708: ; Thus, we do not have an option to go more to the left.
6709:
6710: stx zPNTR ; set column to 0 (TODO: should not be necessary, as it is already set to 0!)
6711:
6712: ; Remove the return address from the stack:
6713: ; we do not want to return to the caller;
6714: ; instead, we will abort the output!
6715: ;
6716: pla
6717: pla
6718:
6719: bne CHROUT_SCREEN_END ; end the output (uncond. branch as long as the caller of the caller does not reside on the memory area $00xx.)
6720: ; -----------------------
6721:
6722: @CanGoBack:
6723: dex
6724: stx zTBLX ; set the cursor one row to the top
6725:
6726: jsr SET_CURSORPOS ; set the cursor position (and calculate the line length of the current line, in zLNMX)
6727:
6728: ; set the cursor to the last column of the line
6729: ldy zLNMX ; get current (virtual) line length
6730: sty zPNTR ; and set the cursor to that column
6731: rts
6732:
6733: ; CHROUT onto screen
6734: ;
6735: ; Output the character in A to the current cursor position on the screen
6736: ;
6737: CHROUT_SCREEN:
6738: pha ; remember the character to output on stack
6739: sta zSCHAR ; and in memory
6740:
6741: ; remember X and Y on the stack
6742: txa
6743: pha
6744: tya
6745: pha
6746:
6747: lda #$00 ; no CR has been pressed yet
6748: sta zCRSW ; That is, on next BASIN, the routine will wait for an input again, regardless if the input has been completely used yet.
6749:
6750: ldy zPNTR ; get pointer into current (logical) line
6751: lda zSCHAR ; character to be output
6752: bpl @PositiveChar ; is it positive (<= $7F) -> branch
6753: jmp @NegativeChar
6754: ; ------------
6755:
6756: @PositiveChar:
6757: cmp #ASC_CR ; is the character a CR?
6758: bne @NoCR ; No -> branch, next test
6759: jmp CHROUT_SCREEN_CR ; Output a CR
6760:
6761: @NoCR:
6762: ; Here, we convert the codes as follows:
6763: ;
6764: ; PETSCII -> SCREEN CODE
6765: ; $20-$3F -> $20-$3F
6766: ; $40-$5F -> $00-$1F
6767: ; $60-$7F -> $40-$5F
6768:
6769: cmp #$20 ; is the character a control code (< $20)?
6770: bcc @TestControlCode ; yes, process the control code
6771:
6772: cmp #$60 ; is the character small than $60 (i.e., $20..$5F)?
6773: bcc @Convert0x20_0x60 ; yes, branch -> convert char
6774: and #~$20 ; convert $60-$7F --> $40-$5F
6775: bne @CheckQuoteAndOutput ; (uncond. branch)
6776: ; -----------------
6777:
6778: @Convert0x20_0x60:
6779: and #$3F ; converts $20-$3F --> $20-$3F, but $40-$5F -> $00-$1F
6780:
6781: @CheckQuoteAndOutput:
6782: jsr CheckQuote ; update quote state, if necessary
6783: jmp CHROUT_SCREEN_OUTPUT_WITH_TEST_RVS
6784: ; -----------------
6785:
6786: @TestControlCode:
6787: ldx zINSRT ; are we in insert mode?
6788: beq @ProcessControlCode ; no, branch -> process control codes
6789: jmp CHROUT_SCREEN_OUTPUT_IN_RVS ; output the control codes in reverse (and quit), do not process them
6790: ; -----------------
6791:
6792: @ProcessControlCode:
6793: cmp #ASC_INSDEL ; is the character an INS/DEL?
6794: bne @NoINSDEL ; no -> branch, skip special handling of INS/DEL
6795:
6796: tya ; A := Y (zPNTR), offset of current column into current screen line
6797: bne @NotFirstColumn ; not the first column -> branch
6798:
6799: jsr CHROUT_SCREEN_WrapAroundToPreviousRow ; Perform the wrap around to the previous row, putting the cursor on the rightmost column of the previous line.
6800: ; If we are at the home position already, this function does NOT return, but goes to CHROUT_SCREEN_END instead.
6801: jmp @AddBlankAtCurrentPosition
6802: ; -----------------
6803:
6804: @NotFirstColumn:
6805: jsr AdjustCursorRowBeforeMovingLeft ; we want to move the cursor to the left. If we will cross a row this way, decrement the row number.
6806:
6807: ; move cursor one to the left
6808:
6809: dey
6810: sty zPNTR
6811: jsr UpdateColorRAMPointerToVideoramPointer ; update color RAM pointer
6812:
6813: ; move the screen parts to the right of the cursor one to the left
6814:
6815: @MoveLoop:
6816: iny ; get the char to the right
6817: lda (zPNT),y
6818: dey ; and copy it one to the left
6819: sta (zPNT),y
6820:
6821: iny ; get the color to the right
6822: lda (zUSER),y
6823: dey ; and copy it one to the left
6824: sta (zUSER),y
6825:
6826: iny ; proceed to the next position (to the right)
6827: cpy zLNMX ; did we reach the end of the (logical) line?
6828: bne @MoveLoop ; no, move the next char
6829:
6830: ; if we "fall through", then Y points to the last location on the current (logical) screen line
6831:
6832: @AddBlankAtCurrentPosition:
6833: lda #' ' ; put a space char (blank)
6834: sta (zPNT),y ; into the current screen location
6835: lda lCOLOR ; put the default color
6836: sta (zUSER),y ; into the current color location
6837: bpl @End2 ; BUG: This is meant as an uncond. branch. It is one as long as no-one has the idea to put a negative color into lCOLOR!
6838: ; ------------------
6839:
6840: @NoINSDEL:
6841: ldx zQTSW ; are we in quotation mark mode?
6842: beq @NoQuotationMode ; no -> branch
6843: jmp CHROUT_SCREEN_OUTPUT_IN_RVS ; output the control codes in reverse
6844: ; ---------------------------------
6845:
6846: @NoQuotationMode:
6847: cmp #ASC_RVS ; character code for reverse (RVS) mode?
6848: bne @NotReverse ; no -> branch, next test
6849: sta zRVS ; remember the reverse mode
6850:
6851: @NotReverse:
6852: cmp #ASC_HOME ; character code for cursor home?
6853: bne @NoCrsrHome ; no -> branch, next test
6854: jsr CURSOR_HOME ; put the cursor at the home position
6855:
6856: @NoCrsrHome:
6857: cmp #ASC_CURSORLEFTRIGHT ; character code for cursor left/right?
6858: bne @NoCrsrLeftRight ; no -> branch, next test
6859:
6860: iny ; move cursor to the right
6861: jsr AdjustCursorRowBeforeMovingRight ; if we will move to the next row, increment row number
6862: sty zPNTR ; store cursor column
6863:
6864: dey ; get old cursor position back
6865: cpy zLNMX ; was the cursor before the end of the (virtual) row?
6866: bcc @End ; yes -> branch
6867:
6868: ; If we reach here, we moved from the end of the previous row to the current row
6869:
6870: dec zTBLX ; decrement the row number (go up one row)
6871: ; the first operation GoDownOneVirtualRow does is increment
6872: ; the row number. This dec is a countermeasure
6873: ; for this incrementing.
6874: jsr GoDownOneVirtualRow ; go down one (virtual) row
6875: ldy #0 ; set cursor to the beginning of the row
6876: @StoreColAndEnd:
6877: sty zPNTR
6878:
6879: @End: jmp CHROUT_SCREEN_END
6880: ; -------------------------
6881:
6882: @NoCrsrLeftRight:
6883: cmp #ASC_CURSORUPDOWN ; character code for cursor up/down?
6884: bne @NoCrsrUpDown ; no -> branch, next test
6885:
6886: ; In case we moved down one phyiscal row, but we are still in the
6887: ; same (virtual) row, we calculate the new column we would be at
6888: ; If this case is not true, the calculation will be thrown away.
6889: ; Otherwise, we will use this value.
6890:
6891: clc
6892: tya ; A := Y (current column number)
6893: adc #EDITOR_COLS ; add the number of columns in a physical row
6894: tay ; Y := A (column number if we are still in the same virtual row)
6895:
6896: ;
6897: inc zTBLX ; go down one row
6898: cmp zLNMX ; compare just calculated column number with maximum number of column in the current row
6899: bcc @StoreColAndEnd ; calculated row number is smaller -> we are still in the same virtual row -> branch, store column
6900: beq @StoreColAndEnd ; calculated row number is equal -> we are still in the same virtual row -> branch, store column
6901: dec zTBLX ; go up one row (again to where we started)
6902: ; this is a preparation to the JSR GoDownOneVirtualRow below
6903:
6904: ; "Normalise" the column (in zPNTR)
6905: ; That is, calculate zPNTR MOD EDITOR_COLS with a loop
6906: ; TODO why?
6907:
6908: @Normalise:
6909: ; sec, but we already have C=1: If we come from "above", then we would have branched in the bcc
6910: ; if C=0
6911: ; if we looped, then we would have branched in the other bcc from below
6912:
6913: sbc #EDITOR_COLS ; subtract the number of columns in a physical row
6914: bcc @GoDown ; if we reached < 0, end the loop
6915: sta zPNTR ; store the column
6916: bne @Normalise ; if we did not reach 0 yet, loop again
6917:
6918: @GoDown:
6919: jsr GoDownOneVirtualRow ; go down one (virtual) row
6920: @End2:
6921: jmp CHROUT_SCREEN_END
6922:
6923: @NoCrsrUpDown:
6924: jsr EditorCheckColorCodeAndSetColor ; check if the current PETSCII code is a color. IF yes, set lCOLOR. Return anyway
6925:
6926: .if CompileComputer >= VIC20_06
6927: jmp EditorCheckForAscLowercase ; check for additional codes (change uppercase, change lowercase, allow changing uppercase/lowercase, disallow it)
6928: .else
6929: jmp CHROUT_SCREEN_END ; we're done
6930: .endif
6931:
6932:
6933: @NegativeChar:
6934:
6935: .if CompileComputer >= C64_GENERAL
6936:
6937: .elseif CompileComputer < VIC20_06
6938: ; depending on lMODE, the old VIC20 KERNAL does some translation of
6939: ; character codes to be output.
6940: ; All of these codes being replaced have in common that their
6941: ; 7th bit ($80) is set.
6942: ;
6943: ; TODO Why is this done?
6944:
6945: ldx lMODE ; get lMODE
6946: beq @LE815 ; is it 0? Then do NOT do any conversion
6947:
6948: ldx #$31
6949: @LE807: cmp CHROUT_REPLACEMENT_TABLE,x
6950: beq @LE812
6951: dex
6952: dex
6953: bpl @LE807
6954: bmi @LE815
6955: @LE812: lda CHROUT_REPLACEMENT_TABLE - 1,x
6956: .else
6957:
6958: ; FillUntil $E815, $EA
6959: FillNOP 21
6960:
6961: .endif
6962:
6963: @LE815:
6964:
6965: and #$7F
6966: cmp #TokPi - $80
6967: bne @LE7DC
6968: .if .defined(C64JAPAN)
6969: lda #ASC_PI - $40 ; @@@???
6970: .else
6971: lda #ASC_PI - $80
6972: .endif
6973: @LE7DC:
6974: .if CompileComputer >= C64_GENERAL
6975:
6976: .elseif CompileComputer >= VIC20_06
6977: .repeat 6
6978: nop
6979: .endrep
6980: .else
6981: cmp #$04
6982: bne @LE823
6983: lda #$7F
6984: .endif
6985:
6986: @LE823:
6987: cmp #' '
6988: bcc @LE7E3
6989: jmp LE691
6990: ; ----------------
6991:
6992: @LE7E3: cmp #ASC_CR
6993: bne @LE7EA
6994: jmp CHROUT_SCREEN_CR
6995:
6996: @LE7EA: ldx zQTSW ; are we in quotation mark mode?
6997: bne @LE82D ; yes -> branch
6998: cmp #ASC_INSDEL
6999: bne @LE829
7000: ldy zLNMX
7001: lda (zPNT),y
7002: cmp #' '
7003: bne @LE7FE
7004: cpy zPNTR
7005: bne @LE805
7006: @LE7FE: cpy #(EDITOR_MAX_COMBINED_ROWS * EDITOR_COLS) - 1
7007: beq @LE826
7008: jsr LE965
7009: @LE805: ldy zLNMX
7010: jsr UpdateColorRAMPointerToVideoramPointer
7011: @LE80A: dey
7012: lda (zPNT),y
7013: iny
7014: sta (zPNT),y
7015: dey
7016: lda (zUSER),y
7017: iny
7018: sta (zUSER),y
7019: dey
7020: cpy zPNTR
7021: bne @LE80A
7022: lda #' '
7023: sta (zPNT),y
7024: lda lCOLOR
7025: sta (zUSER),y
7026: inc zINSRT ; increment number of characters to output in insert mode
7027: @LE826: jmp CHROUT_SCREEN_END
7028: ; -----------------------
7029:
7030: @LE829: ldx zINSRT ; number of characters to output in insert mode
7031: beq @LE832
7032: @LE82D: ora #$40
7033: jmp CHROUT_SCREEN_OUTPUT_IN_RVS
7034:
7035: @LE832: cmp #ASC_CURSORUPDOWN
7036: bne @LE84C
7037: ldx zTBLX
7038: beq @LE871
7039: dec zTBLX
7040: lda zPNTR
7041: sec
7042: sbc #EDITOR_COLS
7043: bcc @LE847
7044: sta zPNTR
7045: bpl @LE871
7046: @LE847: jsr SET_CURSORPOS
7047: bne @LE871
7048: @LE84C: cmp #ASC_RVS
7049: bne @LE854
7050: lda #$00
7051: sta zRVS
7052: @LE854: cmp #ASC_CURSORLEFTRIGHT
7053: bne @LE86A
7054: tya
7055: beq @LE864
7056: jsr AdjustCursorRowBeforeMovingLeft ; we want to move the cursor to the left. If we will cross a row this way, decrement the row number.
7057: dey
7058: sty zPNTR
7059: jmp CHROUT_SCREEN_END
7060:
7061: @LE864: jsr CHROUT_SCREEN_WrapAroundToPreviousRow
7062: jmp CHROUT_SCREEN_END
7063: @LE86A: cmp #ASC_HOME
7064: bne @LE874
7065: jsr ClearScreen
7066: @LE871: jmp CHROUT_SCREEN_END
7067: @LE874: ora #$80
7068: jsr EditorCheckColorCodeAndSetColor
7069: .if CompileComputer >= VIC20_06
7070: jmp EditorCheckForAscUppercase
7071: .else
7072: jmp CHROUT_SCREEN_END
7073: .endif
7074: ; -----------------------
7075:
7076: GoDownOneVirtualRow:
7077: lsr zLXSP
7078: ldx zTBLX
7079: @LE880: inx
7080: cpx #EDITOR_ROWS
7081: bne @LE888
7082: jsr LE8EA
7083: @LE888: lda zLDTB1,x
7084: bpl @LE880
7085: stx zTBLX
7086: jmp SET_CURSORPOS
7087:
7088: CHROUT_SCREEN_CR:
7089: ; output a CR onto the screen at the current cursor position
7090:
7091: ldx #$00
7092: stx zINSRT ; end INSERT mode
7093: stx zRVS ; end REVERSE (RVS) mode
7094: stx zQTSW ; end quotation mark mode
7095: stx zPNTR ; put cursor to the beginning of the current line (that is, CR w/o NL, so to speak)
7096:
7097: jsr GoDownOneVirtualRow ; go down one (virtual) row
7098: jmp CHROUT_SCREEN_END
7099: ; --------------
7100:
7101: ; If the cursor will be part of the previous row after being moved to the left
7102: ; (that is, the cursor is at the beginning of the current row now), move
7103: ; the cursor one row to the top.
7104:
7105: AdjustCursorRowBeforeMovingLeft:
7106: ldx #EDITOR_MAX_COMBINED_ROWS ; maximum number of rows that can be combined in one virtual row
7107: lda #$00 ; start counter at column 0
7108: @Loop:
7109: cmp zPNTR ; is current cursor column the same as our counter?
7110: beq @DecrementAndExit ; yes -> branch, decrement row and exit
7111: clc
7112: adc #EDITOR_COLS ; calculate next multiple of EDITOR_COLS to test against
7113: dex ; still a row to handle?
7114: bne @Loop ; yes -> branch, process next row
7115: rts
7116:
7117: @DecrementAndExit:
7118: dec zTBLX ; decrement current cursor row
7119: rts
7120:
7121:
7122: ; If the cursor will be part of the next row after being moved to the right
7123: ; (that is, the cursor is at the end of the current row now), move
7124: ; the cursor one row to the bottom.
7125:
7126: AdjustCursorRowBeforeMovingRight:
7127: ldx #EDITOR_MAX_COMBINED_ROWS ; maximum number of rows that can be combined in one virtual row
7128: lda #EDITOR_COLS - 1 ; start counter at last column of a physical row
7129: @Loop:
7130: cmp zPNTR ; is current cursor column the same as our counter?
7131: beq @IncrementAndExit ; yes -> branch, increment row and exit
7132: clc
7133: adc #EDITOR_COLS ; calculate next column to test against
7134: dex ; still a row to handle?
7135: bne @Loop ; yes -> branch, process next row
7136: rts
7137:
7138: @IncrementAndExit:
7139: ldx zTBLX ; is current cursor row
7140: cpx #EDITOR_ROWS ; less than the maximum?
7141: beq @Rts ; no, we cannot increment as we are already at the last row -> branch, skip increment
7142: inc zTBLX ; increment cursor row
7143: @Rts: rts
7144:
7145: ; Check if the current PETSCII code is a color code
7146: ; If it is, set lCOLOR accordingly.
7147: ; Input: A := PETSCII code
7148: ; Output: if A is a color code:
7149: ; lCOLOR := X := color code
7150: ; else
7151: ; X := $FF, lCOLOR unchanged
7152: ; Uses: X
7153: ;
7154: EditorCheckColorCodeAndSetColor:
7155: ldx #END_ColorCodes - ColorCodes - 1 ; get number of color codes
7156: @CheckColor:
7157: cmp ColorCodes,x ; is the current char a color code?
7158: beq @ColorFound ; yes -> branch, we found a color
7159: dex ; test the next color
7160: bpl @CheckColor ; until there is not one left
7161: rts
7162: @ColorFound:
7163: stx lCOLOR ; store the color code in lCOLOR
7164: rts
7165:
7166: ColorCodes:
7167:
7168: ; These are the PETSCII values of the color codes
7169:
7170: .byte $90,$05,$1C,$9F,$9C,$1E,$1F,$9E ; colors no. 0-7
7171:
7172: .if CompileComputer >= C64_GENERAL
7173: .byte $81,$95,$96,$97,$98,$99,$9A,$9B ; The C64 has 8 additional colors defined here: colors no. 8-15
7174:
7175: .endif
7176:
7177: END_ColorCodes:
7178:
7179: .if CompileComputer < C64_GENERAL
7180:
7181: ; depending on lMODE, the old VIC20 KERNAL does some translation of
7182: ; character codes to be output.
7183: ; All of these codes being replaced have in common that their
7184: ; 7th bit ($80) is set.
7185: ;
7186: ; TODO Why is this done?
7187:
7188: ; this table is organised as follows: Each entry consists of a byte pair.
7189: ; the byte at offset 1 is the character that is to be replaced, and
7190: ; the byte at offset 0 is the character with which to replace.
7191:
7192: ; This is only used in VIC20_02 ROMs, although the
7193: ; table is also present in later ROMs.
7194:
7195: CHROUT_REPLACEMENT_TABLE:
7196: .byte $EF,$A1
7197: .byte $DF,$A6
7198: .byte $E1,$B1
7199: .byte $E2,$B2
7200: .byte $E3,$B3
7201: .byte $E4,$B4
7202: .byte $E5,$B5
7203: .byte $E6,$B6
7204: .byte $E7,$B7
7205: .byte $E8,$B8
7206: .byte $E9,$B9
7207: .byte $FA,$BA
7208: .byte $FB,$BB
7209: .byte $FC,$BC
7210: .byte $EC,$BD
7211: .byte $FE,$BE
7212: .byte $84,$BF
7213: .byte $F7,$C0
7214: .byte $F8,$DB
7215: .byte $F9,$DD
7216: .byte $EA,$DE
7217:
7218: SpecialScreenCodeHandleTable:
7219: ; special screen code to PETSCII conversion table
7220: ; the first character is the screen code to convert,
7221: ; the second character is the PETSCII code to convert in
7222: ;
7223: ; This is only used in VIC20_02 ROMs, although the
7224: ; table is also present in later ROMs.
7225:
7226: .byte $5E,$E0
7227: .byte $5B,$E1
7228: .byte $5D,$E2
7229: .byte $40,$B0
7230: .byte $61,$B1
7231: .byte $78,$DB
7232: .byte $79,$DD
7233: .byte $66,$B6
7234: .byte $77,$C0
7235: .byte $70,$F0
7236: .byte $71,$F1
7237: .byte $72,$F2
7238: .byte $73,$F3
7239: .byte $74,$F4
7240: .byte $75,$F5
7241: .byte $76,$F6
7242: .byte $7D,$FD
7243:
7244: SpecialScreenCodeHandleTable_END:
7245:
7246: .endif
7247:
7248: LE8EA: lda zSAL
7249: pha
7250: lda zSAL + 1
7251: pha
7252: lda zEAL
7253: pha
7254: lda zEAL + 1
7255: pha
7256: @LE8F6: ldx #$FF
7257: dec zTBLX
7258: dec zLXSP
7259: dec lTLNIDX
7260:
7261: @LE8FF: inx
7262: jsr CalculateScreenPointerFromRowNumber
7263: cpx #EDITOR_ROWS - 1
7264: bcs @LE913
7265: lda SCREEN_LOWBYTE + 1,x
7266: sta zSAL
7267: lda zLDTB1 + 1,x
7268: jsr CopyPhysicalScreenRow
7269: bmi @LE8FF ; => jmp, as CopyPhysicalScreenRow will not return with N=0 ("bpl loop")
7270: ; -----------------
7271:
7272: @LE913:
7273: jsr EraseScreenRow
7274: ldx #0
7275: @LE918: lda zLDTB1,x
7276: and #$7F
7277: ldy zLDTB1 + 1,x
7278: bpl @LE922
7279: ora #$80
7280: @LE922: sta zLDTB1,x
7281: inx
7282: cpx #EDITOR_ROWS - 1
7283: bne @LE918
7284: lda zLDTB1 + EDITOR_ROWS - 1
7285: ora #$80
7286: sta zLDTB1 + EDITOR_ROWS - 1
7287: lda zLDTB1
7288: bpl @LE8F6
7289: inc zTBLX
7290: inc lTLNIDX
7291:
7292: ; check for a pressed CTRL key:
7293: ; If it is pressed, incorporate an additional delay
7294:
7295: .ifdef JIFFY
7296:
7297: JDLE938:
7298: jsr RestoreKeyboardRowAndRet
7299:
7300: .else
7301: lda #KEYB_ROW_CTRL ; set the keyboard row to the row that has the CTRL key
7302: sta KEYB_ROW
7303: .endif
7304: lda KEYB_COL ; test the keyboard columns
7305: cmp #KEYB_COL_CTRL ; check the CTRL key specifically
7306:
7307: .ifdef JIFFY
7308: bne @SkipDelay
7309: ldx zNDX
7310: beq JDLE938
7311: lda $0276,x
7312: sbc #$13
7313: bne @SkipDelay
7314: sta zNDX
7315: @JDLE94F: cli
7316: cmp zNDX
7317: beq @JDLE94F
7318: sta zNDX
7319:
7320: .else
7321: php ; remember status
7322: lda #KEYB_ROW_STANDARD ; restore the keyboard row
7323: sta KEYB_ROW
7324: plp ; get back the status
7325: bne @SkipDelay ; Z=1 --> CTRL key not pressed --> branch, skip delay
7326:
7327: ; create a delay of TODO clock cycles
7328: ldy #0
7329: @Delay:
7330: nop
7331: dex
7332: bne @Delay
7333: dey
7334: bne @Delay
7335: sty zNDX
7336:
7337: .endif
7338:
7339: @SkipDelay:
7340: ldx zTBLX
7341:
7342: Restore_zEAL_and_zSAL:
7343: pla
7344: sta zEAL + 1
7345: pla
7346: sta zEAL
7347: pla
7348: sta zSAL + 1
7349: pla
7350: sta zSAL
7351: rts
7352:
7353: LE965:
7354: ldx zTBLX
7355: LE967:
7356: ; find next (virtual) row
7357: inx ; proceed to next (physical) row
7358: lda zLDTB1,x ; is it combined with the previous one (bit 7 = 0)?
7359: bpl LE967 ; yes -> branch, loop to test the next row
7360:
7361: stx lTLNIDX ; remember the row number of the next (virtual) row
7362: cpx #EDITOR_ROWS - 1 ; is this the last (phyiscal) row?
7363: beq @LE981 ; yes -> branch
7364: bcc @LE981 ; row number is less than last row -> also branch
7365:
7366: jsr LE8EA
7367: ldx lTLNIDX
7368: dex
7369: dec zTBLX
7370: jmp LogicallyCombineTwoRows
7371: ; --------------------
7372:
7373: ; Make room on the screen for the extension of a logical screen row to comprise another
7374: ; physical screen row. This involves scrolling every row below lTLNIDX down (to make
7375: ; room), erasing the new row, and adjusting the pointers in zLDTB1.
7376:
7377: @LE981:
7378: ; save zEAL/zEAL+1 and zSAL/zSAL+1 on the stack as they will be used
7379: ; as temporary storage for pointers.
7380: ; These will be restored before leaving.
7381:
7382: lda zSAL
7383: pha
7384: lda zSAL + 1
7385: pha
7386: lda zEAL
7387: pha
7388: lda zEAL + 1
7389: pha
7390:
7391: ; Move screen contents below the current cursor position downwards
7392:
7393: ldx #EDITOR_ROWS ; start at the last physical row
7394: @CopyRow:
7395: dex
7396: jsr CalculateScreenPointerFromRowNumber ; update the destination pointer into video RAM (zPNT/zPNT+1)
7397: cpx lTLNIDX ; have we already reached the current screen row?
7398: bcc @EndMove ; we are above the current screen row -> branch, end the copy (TODO is this needed at all?)
7399: beq @EndMove ; we are at the current screen row -> branch, end the copy
7400:
7401: ; update the source pointers
7402: lda SCREEN_LOWBYTE - 1,x ; get low byte of the starting address of this row
7403: sta zSAL ; remember low byte
7404: lda zLDTB1 - 1,x ; get high byte of the starting address of this row
7405: jsr CopyPhysicalScreenRow ; copy the current screen row from source to destination, moving it down
7406: bmi @CopyRow ; => jmp, as CopyPhysicalScreenRow will not return with N=0 ("bpl loop")
7407: ; ---------------------------
7408:
7409: @EndMove:
7410: jsr EraseScreenRow ; erase the (physical) screen row in X
7411:
7412: ; update zLDTB1 to reflect the new situation
7413: ; copy the high order (7th) bit of the byte for each row that has been moved
7414: ; to the next row.
7415: ; source row is the row that is copied, destination row is the next row
7416:
7417: ldx #EDITOR_ROWS - 2 ; start at 2nd to last row of source row
7418:
7419: @MoveCombinationBits:
7420: cpx lTLNIDX ; have we already reached (<=) the current row?
7421: bcc @EndMoveCombinationBits ; yes, quit
7422:
7423: lda zLDTB1 + 1,x ; get the byte for the next row
7424: and #~$80 ; clear bit 7 in all cases
7425: ldy zLDTB1,x ; read 7th bit of source row
7426: bpl @Positive ; if it is unset (positive), skip
7427: ora #$80 ; set the 7th bit of destination row
7428: @Positive:
7429: sta zLDTB1 + 1,x ; store byte for destination row
7430: dex ; proceed with previous row
7431: bne @MoveCombinationBits
7432:
7433: @EndMoveCombinationBits:
7434: ldx lTLNIDX
7435: jsr LogicallyCombineTwoRows
7436:
7437: ; restore zEAL/zEAL+1 and zSAL/zSAL+1
7438:
7439: .if CompileComputer >= C64_GENERAL
7440: jmp Restore_zEAL_and_zSAL ; same implementation like VIC-20, but we save memory as it is already there
7441: .else
7442: pla
7443: sta zEAL + 1
7444: pla
7445: sta zEAL
7446: pla
7447: sta zSAL + 1
7448: pla
7449: sta zSAL
7450: rts
7451: .endif
7452:
7453: ; Copy one (physical) screen row on screen to another screen row
7454:
7455: ; This will copy a physical screen row in memory, including the video and the color RAM.
7456: ; It is used to scroll the screen up or down, but it is not limited to this usage.
7457:
7458: ; Input: A = high byte of start address of (logical TODO) screen row (cf. zLDTB1) from which to copy
7459: ; zSAL = low byte of start address of (physical) screen row (cf. SCREEN_LOWBYTE) from which to copy
7460:
7461: ; zPNT/zPNT+1 = Start address of physical screen row video RAM destination
7462: ; zUSER/zUSER+1 = Start address of physical screen row color RAM destination
7463:
7464: CopyPhysicalScreenRow:
7465: and #>lVIDEORAM_SIZE ; make sure to let the start address
7466: ora lHIBASE ; point into the current video RAM
7467: sta zSAL + 1 ; store the address as pointer
7468: jsr @UpdateColorRamPointers
7469:
7470: ; Copy one (physical) row
7471:
7472: ldy #EDITOR_COLS - 1 ; index of last character in a (physical) row
7473: @CopyPreviousChar:
7474: lda (zSAL),y ; get character from source
7475: sta (zPNT),y ; and store it at the destination
7476: lda (zEAL),y ; get color from source
7477: sta (zUSER),y ; and store it at the destination
7478: dey ; go to previous character
7479: bpl @CopyPreviousChar ; non-negative -> branch, there is still a character to be processed
7480: rts
7481: ; -----------------------
7482:
7483: ; Update the color RAM pointers in zUSER/zUSER+1 and zEAL/zEAL+1, respectively,
7484: ; to point to the same locations as the video RAM pointers
7485: ; in zPNT/zPNT+1 and zSAL/zSAL+1, respectively.
7486:
7487: @UpdateColorRamPointers:
7488: jsr UpdateColorRAMPointerToVideoramPointer ; update the color RAM pointer to match the video RAM pointer
7489:
7490: ; adjust video RAM pointer in zSAL/zSAL+1 to point to the color RAM (in zEAL/zEAL+1)
7491: lda zSAL
7492: sta zEAL
7493: lda zSAL + 1
7494: and #>lVIDEORAM_SIZE
7495: ora #>COLORRAM
7496: sta zEAL + 1
7497: rts
7498:
7499: CalculateScreenPointerFromRowNumber:
7500: ; calculate the start of the screen row of which the number
7501: ; is given in X. Store it in zPNT.
7502:
7503: lda SCREEN_LOWBYTE,x ; get low byte of the starting address of this row
7504: sta zPNT ; remember low byte
7505: lda zLDTB1,x ; get high byte of the starting address of this row
7506: and #>lVIDEORAM_SIZE ; mask out additional bits used as flags
7507: ora lHIBASE ; add the video RAM base
7508: sta zPNT + 1 ; remember high byte
7509: rts
7510:
7511:
7512: EraseScreenRow:
7513:
7514: ; this routine erases the screen row no. X
7515:
7516: ldy #EDITOR_COLS - 1 ; start in the last column
7517: jsr CalculateScreenPointerFromRowNumber ; set the video RAM pointer in zPNT to the row we want to process
7518: jsr UpdateColorRAMPointerToVideoramPointer ; update the video RAM pointer in zUSER to correspond to zPNT
7519:
7520: @Loop:
7521: .if CompileComputer >= C64_03 .AND CompileComputer <> C64_4064
7522: jsr Patch_StoreColor ; set the color of the location
7523: .endif
7524: lda #' ' ; store a SPACE (' ') into the video RAM position
7525: sta (zPNT),y
7526: .if CompileComputer = C64_02 .OR CompileComputer = C64_4064
7527: jsr Patch_StoreColor ; set the color of the location
7528: nop
7529: .elseif CompileComputer <= C64_01
7530: lda #COL_WHITE ; set the color of the location to white
7531: sta (zUSER),y
7532: .endif
7533: dey ; proceed to the previous column
7534: bpl @Loop ; still >= 0, branch -> process the next column
7535: rts
7536: ; ----------------------------------
7537:
7538: .if CompileComputer >= C64_03 .AND CompileComputer <> C64_4064
7539: nop
7540: .endif
7541:
7542:
7543: StoreCharacterOnScreenAndDisableBlinking:
7544: tay ; remember character to output
7545:
7546: lda #$02 ; set blink counter to $02 (TODO WHY?)
7547: sta zBLNCT
7548:
7549: jsr UpdateColorRAMPointerToVideoramPointer ; set pointer to video RAM at cursor position
7550:
7551: tya ; get back character to output
7552:
7553: ;
7554: ; Store character on screen at the current cursor position
7555: ;
7556: ; A = character
7557: ; X = color
7558: ;
7559: StoreCharacterOnScreen:
7560: ldy zPNTR ; get column offset in of current screen position
7561: sta (zPNT),y ; store character in video RAM
7562: txa ; get color
7563: sta (zUSER),y ; store color in color RAM
7564: rts
7565:
7566: UpdateColorRAMPointerToVideoramPointer:
7567: lda zPNT
7568: sta zUSER
7569: lda zPNT + 1
7570: and #>lVIDEORAM_SIZE
7571: ora #>COLORRAM
7572: sta zUSER + 1
7573: rts
7574:
7575: KIRQ:
7576: jsr kUDTIM
7577: lda zBLNSW
7578: bne @LEA61
7579: dec zBLNCT
7580: bne @LEA61
7581: lda #$14
7582: sta zBLNCT
7583: ldy zPNTR
7584: lsr zBLNON
7585: ldx lGDCOL
7586: lda (zPNT),y
7587: bcs @LEA5C
7588: inc zBLNON
7589: sta zGDBLN
7590: jsr UpdateColorRAMPointerToVideoramPointer
7591: lda (zUSER),y
7592: sta lGDCOL
7593: ldx lCOLOR
7594: lda zGDBLN
7595: @LEA5C: eor #$80
7596: jsr StoreCharacterOnScreen
7597:
7598: @LEA61:
7599:
7600: .ifdef JIFFY
7601:
7602: LEA61: jmp LEA7B
7603: LEA64: pla
7604: pha
7605: cmp #$98
7606: beq JDLEA6D
7607: JDLEA6A: jmp LA57C
7608: JDLEA6D: jsr JDLF72C
7609: bne JDLEA6A
7610: ldx zTXTPTR
7611: ldy #$04
7612: tya
7613: jmp JDLA5E3
7614: .byte $01
7615:
7616: .else
7617: lda TAPE_REG_SENSE
7618: and #TAPE_B_SENSE
7619: beq @LEA71
7620: ldy #$00
7621: sty zCAS1
7622: lda TAPE_REG_MOTOR
7623: ora #TAPE_B_MOTOR_ON
7624: bne @LEA79
7625: ; -------------------------
7626:
7627: @LEA71: lda zCAS1
7628: bne LEA7B
7629: lda TAPE_REG_MOTOR
7630: and #TAPE_B_MOTOR_OFF_AND
7631: @LEA79:
7632: .if CompileComputer < C64_GENERAL
7633: bit VIA1_IEC
7634: bvs LEA7B
7635: .endif
7636: sta TAPE_REG_MOTOR
7637:
7638: .endif
7639:
7640: LEA7B:
7641: .if CompileComputer = C64_4064
7642: jsr LE4C8
7643: .else
7644: jsr iSCNKEY
7645: .endif
7646:
7647: .if CompileComputer >= C64_GENERAL
7648: lda CIA1 + CIA_O_ICR
7649: .else
7650: bit VIA2_T1CL
7651: .endif
7652: pla
7653: tay
7654: pla
7655: tax
7656: pla
7657: rti
7658:
7659: ; B-25. Function Name: SCNKEY
7660: ;
7661: ; Purpose: Scan the keyboard
7662: ; Call address: $FF9F (hex) 65439 (decimal)
7663: ; Communication registers: None
7664: ; Preparatory routines: IOINIT
7665: ; Error returns: None
7666: ; Stack requirements: 5
7667: ; Registers affected: A, X, Y
7668: ;
7669: ; Description: This routine scans the Commodore 64 keyboard and checks
7670: ; for pressed keys. It is the same routine called by the interrupt handler.
7671: ; If a key is down, its ASCII value is placed in the keyboard queue. This
7672: ; routine is called only if the normal IRQ interrupt is bypassed.
7673: ;
7674: ; How to Use:
7675: ;
7676: ; 1) Call this routine.
7677: ;
7678: ; EXAMPLE:
7679: ;
7680: ; GET JSR SCNKEY ;SCAN KEYBOARD
7681: ; JSR GETIN ;GET CHARACTER
7682: ; CMP #0 ;IS IT NULL?
7683: ; BEQ GET ;YES... SCAN AGAIN
7684: ; JSR CHROUT ;PRINT IT
7685: ;
7686: ;
7687: iSCNKEY:
7688: lda #0 ; start with: No shift key (SHIFT, CTRL, CBM) is pressed
7689: sta lSHFLAG
7690:
7691: ldy #KEY_NONE ; start with: No key pressed
7692: sty zSFDX
7693:
7694: ; check if any key is pressed at all
7695: sta KEYB_ROW ; set all rows to 0
7696: ldx KEYB_COL ; get columns
7697: cpx #$FF ; everything set?
7698: beq iSCNKEY_EndScan ; yes, no key is pressed, abort.
7699: ; Note that X = $FF is crucial here, as iSCNKEY_EndScan checked for the keycode (in X). If there were anything else in X, then this would be used as keycode and stored into the keyboard buffer
7700:
7701: .if CompileComputer >= C64_GENERAL
7702: tay ; Place of the key pressed in the KEYTAB (stored in Y) = 0
7703: .else
7704: lda #~$01 ; start at row 0 (2^0)
7705: sta KEYB_ROW
7706: ldy #$00 ; Place of the key pressed in the KEYTAB (stored in Y) = 0
7707: .endif
7708: lda #<KEYTAB_UNSHIFTED ; start with the unshifted keytab
7709: sta zKEYTAB
7710: lda #>KEYTAB_UNSHIFTED
7711: sta zKEYTAB + 1
7712:
7713: .if CompileComputer >= C64_GENERAL
7714: lda #~$01 ; start at row 0 (2^0)
7715: sta KEYB_ROW
7716: .endif
7717:
7718: @CheckAllRows:
7719: ldx #8 ; process every of the 8 keyboard columns
7720:
7721: .if CompileComputer >= C64_GENERAL
7722: pha ; remember the mask we put into KEYB_ROW for later processing
7723: .endif
7724:
7725: @UnbounceColumns:
7726: lda KEYB_COL ; get column
7727: cmp KEYB_COL ; unbounce it
7728: .if CompileComputer >= C64_GENERAL
7729: bne @UnbounceColumns ; if it changed between reading, re-read it
7730: .else
7731: bne @CheckAllRows ; if colum changed between reading, re-read it. The LDX #8 does not do any harm here; however, for the additional PHA on the C64, we would corrupt the stack. Thus, the target of the branch was changed on the C64.
7732:
7733: .endif
7734:
7735: ; the following loop tests each column one after one if the bit was 0
7736: ; if it was, the key on the row/column was pressed.
7737: ; This is not completely right if more than one key was pressed,
7738: ; but this is a hardware limitation we cannot handle.
7739:
7740: @ProcessColumn:
7741: lsr a ; get bit from column into C
7742: bcs @KeyNotPressed ; C set -> jump, key was not pressed
7743:
7744: pha ; remember current column mask
7745:
7746: lda (zKEYTAB),y ; get the key code that corresponds to the current row/column
7747: cmp #5 ; is it >= 5?
7748: bcs @StoreKey ; yes, it is a printable char, branch in order to store it
7749: cmp #KEY_STOP ; is it the Run/Stop key?
7750: beq @StoreKey ; yes, store it
7751:
7752: ; if we reached here, the character code is 1, 2, or 4: One of the keys shift or CBM
7753: ; thus, remember the shift flag
7754:
7755: ora lSHFLAG ; set the corresponding flag
7756: sta lSHFLAG ;
7757:
7758: bpl @DoNotStoreKey ; unconditional jump, as lSHFLAG.7 is never set.
7759: ; ----------------------------
7760:
7761: @StoreKey:
7762: sty zSFDX ; remember key code
7763:
7764: @DoNotStoreKey:
7765: pla ; get back column mask
7766:
7767: @KeyNotPressed:
7768: iny ; this keytable entry was processed, go to the next one
7769: cpy #$41 ; did we already process all $40 entries?
7770: bcs @EndScanning ; yes, we are done (for now)
7771:
7772: dex ; decrement the column counter
7773: bne @ProcessColumn ; and repeat scanning, if the counter did not reach 0.
7774:
7775: ; The following code rotates the mask at KEYB_ROW to the left.
7776: ; This moves the "0" bit from right to left.
7777: ; Thus, every row is processed, one after the other.
7778: ; The implementation was changed between VIC20 and C64, though:
7779: ; While the VIC20 uses a ROL on the KEYB_ROW address directly,
7780: ; the C64 performs the ROL in a register and puts the value into
7781: ; KEYB_ROW afterwards.
7782: ; This change most likely occurred since ROL is a read-modify-write
7783: ; instruction. Thus, it will write to the location two times, in two
7784: ; consecutives cycles: First, it will write the old value, and after-
7785: ; wards, it will write the new one. This might generate some "spike"
7786: ; which could inadvertedly affect the reading.
7787:
7788: sec ; make sure to ROL in a "1" bit
7789:
7790: .if CompileComputer >= C64_GENERAL
7791: pla ; get back the mask we put at KEYB_ROW last time
7792: rol a ; rotate it to the left
7793: sta KEYB_ROW ; and set the new mask
7794: .else
7795: rol KEYB_ROW ; rotate to mask to the left
7796: .endif
7797: bne @CheckAllRows
7798:
7799: @EndScanning:
7800:
7801: .if CompileComputer >= C64_GENERAL
7802: pla ; we do not need the mask we put at KEYB_ROW last time anymore, remove it
7803: .endif
7804:
7805: ; Essentially, we are done with scanning here. However, we have to determine
7806: ; if a shift key (SHIFT, C=, CTRL) was pressed, which changes the meaning of
7807: ; some keys. Thus, process the shift keys now.
7808: jmp (lKEYLOG) ; points to CHECK_SHIFT_CTRL_CBM
7809:
7810: ConvertRawKeycodeToInterpretedKeycode:
7811: ldy zSFDX ; get the character code
7812: lda (zKEYTAB),y ; and read in the right ASCII value of it according to the right KEYTAB
7813: tax
7814:
7815: cpy zLSTX
7816: beq @CheckRepeat
7817: ldy #$10
7818: sty lDELAY
7819: bne StoreKeyCodeIntoKeyBuffer
7820:
7821: @CheckRepeat:
7822: and #$7F ; ignore bit 7 of key (TODO why?)
7823:
7824: ; determine if the key press is to be repeated
7825:
7826: bit lRPTFLG ; check repeat flag
7827: bmi RepeatKey ; bit 7 set, repeat all keys --> branch
7828: bvs RestoreKeyboardRowAndRet ; bit 6 set, do not repeat any key --> branch
7829:
7830: cmp #$7F ; Is this the key ... (TODO Which key is this?)
7831:
7832: iSCNKEY_EndScan:
7833: beq StoreKeyCodeIntoKeyBuffer ; Yes, branch -> Store the key into the keyboard buffer
7834: ; TODO Why this extra handling?
7835:
7836: cmp #ASC_INSDEL ; did the user press INS/DEL?
7837: beq RepeatKey ; yes, branch -> process repetition
7838:
7839: cmp #' ' ; did the user press SPACE (" "), or shifted SPACE ($A0)?
7840: beq RepeatKey ; yes, process the repetition
7841:
7842: cmp #ASC_CURSORLEFTRIGHT ; did the user press CRSR LEFT/CRSR RIGHT key?
7843: beq RepeatKey ; yes, branch -> process the repetition
7844:
7845: cmp #ASC_CURSORUPDOWN ; did the user press CRSR LEFT/CRSR RIGHT key?
7846: bne RestoreKeyboardRowAndRet ; no, branch -> do not store the key at all
7847:
7848: RepeatKey:
7849:
7850: ; wait for the initial delay counter lDELAY
7851:
7852: ; For key repetitions, there are two delay: One is the initial delay, that is,
7853: ; how long must a key be pressed before the repetition takes place.
7854: ; This is counted by lDELAY.
7855:
7856: ; The other delay is the counter between repeated keys, if the key is hold
7857: ; long enough. This is counted by lKOUNT.
7858:
7859: ldy lDELAY ; is there an initial delay?
7860: beq @NoInitialDelay ; no, repeat immediately
7861:
7862: dec lDELAY ; yes, decrement the initial delay counter
7863: bne RestoreKeyboardRowAndRet ; still not delayed enough -> branch, do nothing
7864:
7865: @NoInitialDelay:
7866: dec lKOUNT ; decrement the delay counter
7867: bne RestoreKeyboardRowAndRet ; not yet 0, do nothing
7868:
7869: ldy #$04 ; restore the delay counter
7870: sty lKOUNT
7871:
7872: ; test if the keyboard buffer is empty.
7873: ; if it is not empty, no key repetition will take place.
7874:
7875: ; this way, we prevent a full keyboard buffer with repeated keys,
7876: ; which would not be a good user experience (we repeat keys faster
7877: ; than the program can handle them)
7878:
7879: ldy zNDX ; number of keys in keyboard buffer
7880: dey ; - 1
7881: bpl RestoreKeyboardRowAndRet ; still > 0? Then, the buffer is not empty -> branch, do nothing
7882:
7883: StoreKeyCodeIntoKeyBuffer:
7884:
7885: ; Store key code in X into keybuffer
7886:
7887: ; remember key code for the next call of the keyboard routines.
7888: ; this is used for determining if a key was pressed for a longer time
7889: ; and if it has to be repeated, or not.
7890: ldy zSFDX
7891: sty zLSTX
7892:
7893: ; remember shift states for the next call of the keyboard routines.
7894: ; this way, we prevent that SHIFT-CBM is processed more than once, as
7895: ;it is only processed if the shift state changed.
7896: ldy lSHFLAG
7897: sty lLSTSHF
7898:
7899: cpx #$FF ; is the key an invalid one ($FF in the keyboard tables?)
7900: beq RestoreKeyboardRowAndRet ; yes, branch -> do not store it
7901: txa
7902:
7903: ; here, we store the keycode that is in A into the keyboard buffer
7904: ; Note that this routine will generate a race in case it is called w/o
7905: ; interrupts disabled
7906:
7907: ldx zNDX ; get the index into the keyboard buffer
7908: cpx lXMAX ; is the buffer full?
7909: bcs RestoreKeyboardRowAndRet ; yes, branch -> do not store the key
7910: sta lKEYD,x ; store the keycode into the buffer
7911: inx ; increment the number of keys in the buffer
7912: stx zNDX ; and store it
7913:
7914: RestoreKeyboardRowAndRet:
7915: lda #KEYB_ROW_STANDARD ; restore the keyboard row
7916: sta KEYB_ROW
7917: rts
7918:
7919:
7920: CHECK_SHIFT_CTRL_CBM:
7921:
7922: ; Determine if a shift key (SHIFT, C=, CTRL) was pressed, which changes
7923: ; the meaning of some keys.
7924:
7925: lda lSHFLAG ; get the shift state
7926: cmp #lSHFLAG_SHIFT | lSHFLAG_CBM ; shift and commodore pressed?
7927: bne @SwitchToShiftedKeyTable ; no, branch -> process a shifted key table instead
7928:
7929: cmp lLSTSHF ; yes, check if the state changed from the last scan
7930: beq RestoreKeyboardRowAndRet ; it's the same state, branch -> do nothing
7931:
7932: ; If we reach here, SHIFT and C= were pressed simultaneously.
7933: ; Thus, the user wants to switch between Uppercase+Graphics mode,
7934: ; and Lowercase + Uppercase mode.
7935:
7936: lda lMODE ; are we allowed to switch modes?
7937: bmi @ConvertRawKeycodeToInterpretedKeycode ; no, branch -> skip
7938:
7939: .if CompileComputer >= C64_GENERAL
7940:
7941: ; we change mode by changing the base address of the character ROM in the VIC-II
7942:
7943: lda VIC + VICII_O_MemControl
7944: eor #$02
7945: sta VIC + VICII_O_MemControl
7946: .elseif CompileComputer >= VIC20_06
7947: .repeat 19
7948: nop
7949: .endrep
7950:
7951: ; we change mode by changing the base address of the character ROM in the VIC-II
7952:
7953: lda VIC + VICI_O_MemoryLocations
7954: eor #$02
7955: sta VIC + VICI_O_MemoryLocations
7956:
7957: .repeat 4
7958: nop
7959: .endrep
7960: .else
7961: ; this is just a complicated way to EOR VICI_O_MemoryLocations with $02
7962: ; furthermore, it keeps track if the state in lMODE.4 ($10)
7963:
7964: and #$18 ; determine current mode
7965: beq @SwitchToLowercase ; it is uppercase, branch -> switch to lowercase
7966:
7967: ; if we reach here, we are in lowercase mode and want to switch to uppercase mode
7968:
7969: ; remember uppercase mode
7970: lda #$00
7971: sta lMODE
7972:
7973: ; switch VIC to uppercase mode
7974: lda VIC + VICI_O_MemoryLocations
7975: and #~$02
7976: sta VIC + VICI_O_MemoryLocations
7977:
7978: bne @ConvertRawKeycodeToInterpretedKeycode ; unconditional branch
7979: ; --------------
7980:
7981: @SwitchToLowercase:
7982: ; switch VIC to lowercase mode
7983: lda VIC + VICI_O_MemoryLocations
7984: ora #$02
7985: sta VIC + VICI_O_MemoryLocations
7986:
7987: ; remember lowercase mode
7988: lda #$08
7989: sta lMODE
7990: .endif
7991:
7992: .if CompileComputer = VIC20_02
7993: bne @ConvertRawKeycodeToInterpretedKeycode ; unconditional jump
7994: .else
7995: jmp @ConvertRawKeycodeToInterpretedKeycode
7996: .endif
7997: ; ---------------------------
7998:
7999: @SwitchToShiftedKeyTable:
8000:
8001: ; (here, we enter with A := lSHFLAG)
8002:
8003: ; Calculate the offset of the key table for the shift flags
8004: ; this is done by doubling the value of lSHFLAG, and special
8005: ; handling of lSHFLAG_CTRL which would double to 8, but 6 is
8006: ; the right offset
8007:
8008: asl a ; double shift flag
8009: cmp #2 * lSHFLAG_CTRL ; is it CTRL?
8010: bcc @UseOffset ; no, use the offset
8011: lda #$06 ; yes, correct the offset
8012:
8013: .if CompileComputer >= C64_GENERAL
8014: .elseif CompileComputer >= VIC20_06
8015: nop
8016: nop
8017: .else
8018: bne @VIC20_02_HandleOffsetDirectly ; for VIC-20-02, use this offset. (unconditional branch)
8019: ; ------------------------------------
8020: .endif
8021:
8022: @UseOffset:
8023:
8024: .if CompileComputer >= C64_GENERAL
8025:
8026: .elseif CompileComputer >= VIC20_06
8027: .repeat 32
8028: nop
8029: .endrep
8030: .else
8031:
8032: ldx lMODE ; if lMODE = 0, use the offset
8033: beq @VIC20_02_HandleOffsetDirectly
8034:
8035: ldx lSHFLAG ; if C= key is not the only shift key pressed:
8036: cpx #lSHFLAG_CBM
8037: bne @VIC20_02_HandleOffsetDirectly ; branch -> handle the offset
8038:
8039: ; if we reach here, the C= key is pressed (but not SHIFT or CTRL)
8040:
8041: cpx lLSTSHF ; did the shift state change from the last time?
8042: beq @ConvertRawKeycodeToInterpretedKeycode ; no, just convert the key code.
8043:
8044: ; TODO
8045: ; switch uppercase mode with lowercase mode (why?)
8046: ; switch bit 4 (???) (why?)
8047: ; but do not update the VIC itself (why?)
8048:
8049: lda lMODE
8050: eor #$18
8051: sta lMODE
8052:
8053: bpl @ConvertRawKeycodeToInterpretedKeycode ; branches if lMODE.7 is 0: switching between uppercase-mode and lowercase-mode is allowed. (TODO why?)
8054:
8055: @VIC20_02_HandleOffsetDirectly:
8056: ora lMODE ; get the offset into KEYTABS_VEC
8057: and #$7F
8058: .endif
8059:
8060: tax ; X := offset into KEYTABS_VEC
8061:
8062: ; switch to the right KEYTAB according to the shift states
8063:
8064: lda @KEYTABS_VEC,x
8065: sta zKEYTAB
8066: lda @KEYTABS_VEC + 1,x
8067: sta zKEYTAB + 1
8068:
8069: @ConvertRawKeycodeToInterpretedKeycode:
8070: jmp ConvertRawKeycodeToInterpretedKeycode
8071:
8072: @KEYTABS_VEC:
8073: .addr KEYTAB_UNSHIFTED ; $00
8074: .addr KEYTAB_SHIFT ; $02 (lSHFLAG=$01, SHIFT)
8075: .addr KEYTAB_CBM ; $04 (lSHFLAG=$02, C=)
8076: .addr KEYTAB_CTRL ; $06 (lSHFLAG=$04, CTRL)
8077:
8078: .if CompileComputer < C64_GENERAL
8079:
8080: ; these keytabs are only used in the VIC20-02 ROM, but they
8081: ; are still present in the later ones.
8082:
8083: ; these 4 tables are used if we are in lowercase mode
8084: .addr KEYTAB_UNSHIFTED ; $08
8085: .addr KEYTAB_SHIFT ; $0A
8086: .addr KEYTAB6 ; $0C
8087: .addr KEYTAB_CTRL ; $0E
8088:
8089: .addr KEYTAB5 ; $10
8090: .addr KEYTAB6 ; $12
8091: .addr KEYTAB6 ; $14
8092: .addr KEYTAB_CTRL ; $16
8093:
8094: .endif
8095:
8096: KEYTAB_UNSHIFTED:
8097:
8098: .if CompileComputer >= C64_GENERAL
8099:
8100: .byte $14,$0D,$1D,$88,$85,$86,$87,$11
8101: .byte $33,$57,$41,$34,$5A,$53,$45,$01
8102: .byte $35,$52,$44,$36,$43,$46,$54,$58
8103: .byte $37,$59,$47,$38,$42,$48,$55,$56
8104:
8105: .byte $39,$49,$4A,$30,$4D,$4B,$4F,$4E
8106: .byte $2B,$50,$4C,$2D,$2E,$3A,$40,$2C
8107: .byte $5C,$2A,$3B,$13,$01,$3D,$5E,$2F
8108: .byte $31,$5F,$04,$32,$20,$02,$51,$03
8109: .byte $FF
8110:
8111: .else
8112:
8113: .byte $31,$33,$35,$37,$39,$2B,$5C,$14
8114: .byte $5F,$57,$52,$59,$49,$50,$2A,$0D
8115: .byte $04,$41,$44,$47,$4A,$4C,$3B,$1D
8116: .byte $03,$01,$58,$56,$4E,$2C,$2F,$11
8117:
8118: .byte $20,$5A,$43,$42,$4D,$2E,$01,$85
8119: .byte $02,$53,$46,$48,$4B,$3A,$3D,$86
8120: .byte $51,$45,$54,$55,$4F,$40,$5E,$87
8121: .byte $32,$34,$36,$38,$30,$2D,$13,$88
8122:
8123: .byte $FF
8124:
8125: .endif
8126:
8127: KEYTAB_SHIFT:
8128:
8129: .if CompileComputer >= C64_GENERAL
8130:
8131: .if .defined(C64JAPAN)
8132: .byte $94,$8D,$9D,$8C,$89,$8A,$8B,$91
8133: .byte $23,$A8,$AA,$24,$AD,$AB,$A9,$01
8134: .byte $25,$A5,$AC,$26,$AF,$A4,$FF,$AE
8135: .byte $27,$FF,$FF,$28,$FF,$FF,$FF,$FF
8136:
8137: .byte $29,$FF,$FF,$30,$FF,$FF,$FF,$FF
8138: .byte $A1,$FF,$FF,$A2,$3E,$5B,$FF,$3C
8139: .byte $A3,$FF,$5D,$93,$01,$3D,$B0,$3F
8140: .byte $21,$5F,$04,$22,$A0,$02,$A7,$83
8141: .byte $FF
8142: .else
8143: .byte $94,$8D,$9D,$8C,$89,$8A,$8B,$91
8144: .byte $23,$D7,$C1,$24,$DA,$D3,$C5,$01
8145: .byte $25,$D2,$C4,$26,$C3,$C6,$D4,$D8
8146: .byte $27,$D9,$C7,$28,$C2,$C8,$D5,$D6
8147:
8148: .byte $29,$C9,$CA,$30,$CD,$CB,$CF,$CE
8149: .byte $DB,$D0,$CC,$DD,$3E,$5B,$BA,$3C
8150: .byte $A9,$C0,$5D,$93,$01,$3D,$DE,$3F
8151: .byte $21,$5F,$04,$22,$A0,$02,$D1,$83
8152: .byte $FF
8153: .endif
8154:
8155:
8156: .else
8157:
8158: .byte $21,$23,$25,$27,$29
8159: .if CompileComputer >= VIC20_06
8160: .byte $DB,$A9
8161: .else
8162: .byte $AB,$DC
8163: .endif
8164: .byte $94
8165:
8166: .if CompileComputer >= VIC20_06
8167: .byte $5F
8168: .else
8169: .byte $DF
8170: .endif
8171: .byte $D7,$D2,$D9,$C9,$D0
8172: .if CompileComputer >= VIC20_06
8173: .byte $C0
8174: .else
8175: .byte $AA
8176: .endif
8177: .byte $8D
8178:
8179: .byte $04,$C1,$C4,$C7,$CA,$CC,$5D,$9D
8180: .byte $83,$01,$D8,$D6,$CE,$3C,$3F,$91
8181:
8182: .byte $A0,$DA,$C3,$C2,$CD,$3E,$01,$89
8183: .byte $02,$D3,$C6,$C8,$CB,$5B
8184: .if CompileComputer >= VIC20_06
8185: .byte $3D
8186: .else
8187: .byte $BD
8188: .endif
8189: .byte $8A
8190:
8191: .byte $D1,$C5,$D4,$D5,$CF
8192: .if CompileComputer >= VIC20_06
8193: .byte $BA
8194: .else
8195: .byte $C0
8196: .endif
8197: .byte $DE,$8B
8198:
8199: .byte $22,$24,$26,$28
8200: .if CompileComputer >= VIC20_06
8201: .byte $30,$DD
8202: .else
8203: .byte $B0,$AD
8204: .endif
8205: .byte $93,$8C
8206:
8207: .byte $FF
8208:
8209: .endif
8210:
8211: KEYTAB_CBM:
8212:
8213: .if CompileComputer >= C64_GENERAL
8214:
8215: .if .defined(C64JAPAN)
8216: .byte $94,$8D,$9D,$8C,$89,$8A,$8B,$91
8217: .byte $B1,$C3,$C1,$B3,$C2,$C4,$B2,$01
8218: .byte $B4,$BD,$BC,$B5,$BF,$CA,$B6,$BB
8219: .byte $D4,$DD,$B7,$D5,$BA,$B8,$C5,$CB
8220:
8221: .byte $D6,$C6,$CF,$DC,$D3,$C9,$D7,$D0
8222: .byte $CE,$BE,$D8,$CD,$D9,$DA,$DB,$C8
8223: .byte $A6,$DE,$B9,$93,$01,$D1,$DF,$D2
8224: .byte $C7,$5F,$04,$CC,$A0,$02,$C0,$83
8225: .byte $FF
8226: .else
8227: .byte $94,$8D,$9D,$8C,$89,$8A,$8B,$91
8228: .byte $96,$B3,$B0,$97,$AD,$AE,$B1,$01
8229: .byte $98,$B2,$AC,$99,$BC,$BB,$A3,$BD
8230: .byte $9A,$B7,$A5,$9B,$BF,$B4,$B8,$BE
8231:
8232: .byte $29,$A2,$B5,$30,$A7,$A1,$B9,$AA
8233: .byte $A6,$AF,$B6,$DC,$3E,$5B,$A4,$3C
8234: .byte $A8,$DF,$5D,$93,$01,$3D,$DE,$3F
8235: .byte $81,$5F,$04,$95,$A0,$02,$AB,$83
8236: .byte $FF
8237: .endif
8238:
8239: .elseif CompileComputer = VIC20_02
8240: .byte $B1,$B3,$B5,$B7,$B9,$AB,$DC,$94
8241: .byte $DF,$D7,$D2,$D9,$C9,$D0,$AA,$8D
8242: .byte $04,$C1,$C4,$C7,$CA,$CC,$BB,$9D
8243: .byte $83,$01,$D8,$D6,$CE,$AC,$AF,$91
8244:
8245: .byte $0A,$DA,$C3,$C2,$CD,$AE,$01,$FF
8246: .byte $02,$D3,$C6,$C8,$CB,$BA,$BD,$FF
8247: .byte $D1,$C5,$D4,$D5,$CF,$C0,$DE,$FF
8248: .byte $B2,$B4,$B6,$B8,$B0,$AD,$93,$FF
8249: .byte $FF
8250: .else
8251: .byte $21,$23,$25,$27,$29,$A6,$A8,$94
8252: .byte $5F,$B3,$B2,$B7,$A2,$AF,$DF,$8D
8253: .byte $04,$B0,$AC,$A5,$B5,$B6,$5D,$9D
8254: .byte $83,$01,$BD,$BE,$AA,$3C,$3F,$91
8255:
8256: .byte $A0,$AD,$BC,$BF,$A7,$3E,$01,$89
8257: .byte $02,$AE,$BB,$B4,$A1,$5B,$3D,$8A
8258: .byte $AB,$B1,$A3,$B8,$B9,$A4,$DE,$8B
8259: .byte $22,$24,$26,$28,$30,$DC,$93,$8C
8260: .byte $FF
8261: .endif
8262:
8263: .if CompileComputer >= VIC20_06
8264:
8265: KEYTAB5: ; unused, but references for VIC20-06 and -07
8266:
8267: EditorCheckForAscLowercase:
8268: cmp #ASC_LOWERCASE ; if this the code to change to lowercase chars?
8269: bne EditorCheckForAscUppercase ; no, test for the next code
8270:
8271: ; set the VIC memory control byte to point to the lowercase characters:
8272:
8273: .if CompileComputer >= C64_GENERAL
8274: lda VIC + VICII_O_MemControl
8275: ora #2
8276: bne EditorSta_vMemControl ; sta VIC + VICII_O_MemControl ; this bne saves one byte
8277: .else
8278: lda #2
8279: ora VIC + VICI_O_MemoryLocations
8280: sta VIC + VICI_O_MemoryLocations
8281: jmp CHROUT_SCREEN_END ; we're done
8282: ; this JMP is not necessary, but does not do any harm, either.
8283: ; It has been removed from the C64 ROMs, presumably to save space.
8284: .endif
8285:
8286: EditorCheckForAscUppercase:
8287: cmp #ASC_UPPERCASE ; if this the code to change to lowercase chars?
8288: bne EditorCheckForDisallowLowercase ; no, test for the next code
8289:
8290: ; set the VIC memory control byte to point to the uppercase characters:
8291:
8292: .if CompileComputer >= C64_GENERAL
8293: lda VIC + VICII_O_MemControl
8294: and #~2
8295: EditorSta_vMemControl:
8296: sta VIC + VICII_O_MemControl
8297: .else
8298: lda #~2
8299: and VIC + VICI_O_MemoryLocations
8300: sta VIC + VICI_O_MemoryLocations
8301: .endif
8302:
8303: EditorChroutScreenEnd:
8304: jmp CHROUT_SCREEN_END
8305: ; ----------------------------
8306:
8307: EditorCheckForDisallowLowercase:
8308: cmp #ASC_DISALLOW_LOWERCASE ; if this the code to disallow changing to lowercase mode via keyboard?
8309: bne @CheckForAllowLowercase ; no, test for the next code
8310:
8311: ; disallow changing mode with SHIFT + C= by setting bit 7 of lMODE:
8312:
8313: lda #$80
8314: ora lMODE
8315: .if CompileComputer >= C64_GENERAL
8316: bmi @Sta_lMODE ; sta lMODE (uncond. branch)
8317: ; ------------------
8318: .else
8319: sta lMODE
8320: bmi EditorChroutScreenEnd
8321: .endif
8322: @CheckForAllowLowercase:
8323: cmp #ASC_ALLOW_LOWERCASE ; if this the code to allow changing to lowercase mode via keyboard?
8324: bne EditorChroutScreenEnd ; no -> branch, this is no special code (or it has been already handled)
8325:
8326: ; (re-)allow changing mode with SHIFT + C= by clearing bit 7 of lMODE:
8327:
8328: lda #$7F
8329: and lMODE
8330: @Sta_lMODE:
8331: sta lMODE
8332:
8333: ; end chrout to the screen.
8334: ; the VIC-20 and C64 do exactly the same.
8335:
8336: .if CompileComputer >= C64_GENERAL
8337: jmp CHROUT_SCREEN_END
8338: .else
8339: bpl EditorChroutScreenEnd ; branches to a "JMP CHROUT_SCREEN_END" (uncond. branch)
8340: ; ------------------------------
8341:
8342: ; a patch: cf. directly before EditorPatchLogicallyCombineTwoRows_Return
8343:
8344: EditorPatchLogicallyCombineTwoRows:
8345: EDITOR_PATCH_LogicallyCombineTwoRows_FIX
8346: EDITOR_PATCH_LogicallyCombineTwoRows_COMMON
8347: jmp EditorPatchLogicallyCombineTwoRows_Return
8348:
8349: .endif
8350: .endif
8351:
8352: .if CompileComputer = VIC20_02
8353:
8354: KEYTAB5:
8355:
8356: .byte $C7,$B1,$B4,$D4,$D6,$CE,$A6,$14
8357: .byte $FF,$C3,$EC,$DD,$C6,$BE,$EA,$0D
8358: .byte $04,$C1,$BC,$B7,$CF,$D8,$B9,$1D
8359: .byte $03,$01,$BB,$CB,$D0,$C8,$D2,$11
8360: .byte $20,$C2,$BF,$BA,$D3,$D9,$01,$85
8361: .byte $02,$C4,$CA,$B8,$C9,$DA,$D1,$86
8362: .byte $C0,$B2,$B6,$C5,$D7,$DB,$A1,$87
8363: .byte $CC,$B3,$B5,$D5,$DC,$CD,$13,$88
8364: .byte $FF
8365: .endif
8366:
8367: KEYTAB6:
8368:
8369: .if CompileComputer = VIC20_02
8370:
8371: .byte $F1,$F3,$F5,$FF,$FF,$EB,$FF,$94
8372: .byte $FF,$FF,$FF,$FF,$FF,$FF,$FF,$8D
8373: .byte $04,$FF,$FF,$FF,$FF,$FF,$E2,$9D
8374: .byte $83,$01,$FF,$FF,$FF,$FF,$FF,$91
8375: .byte $A0,$FF,$FF,$FF,$FF,$EE,$01,$89
8376: .byte $02,$FF,$FF,$FF,$FF,$E1,$FD,$8A
8377: .byte $FF,$FF,$FF,$FF,$FF,$B0,$E0,$8B
8378: .byte $F2,$F4,$F6,$FF,$F0,$ED,$93,$8C
8379: .byte $FF
8380:
8381: .elseif CompileComputer < C64_GENERAL
8382:
8383: ; unused, but present
8384:
8385: .byte $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
8386: .byte $FF,$04,$FF,$FF,$FF,$FF,$FF,$E2
8387: .byte $9D,$83,$01,$FF,$FF,$FF,$FF,$FF
8388: .byte $91,$A0,$FF,$FF,$FF,$FF,$EE,$01
8389: .byte $89,$02,$FF,$FF,$FF,$FF,$E1,$FD
8390: .byte $8A,$FF,$FF,$FF,$FF,$FF,$B0,$E0
8391: .byte $8B,$F2,$F4,$F6,$FF,$F0,$ED,$93
8392: .byte $8C,$FF
8393:
8394: .endif
8395:
8396: KEYTAB_CTRL:
8397:
8398: .if CompileComputer >= C64_GENERAL
8399:
8400: .if .defined(C64JAPAN)
8401: .byte $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
8402: .byte $1C,$95,$01,$9F,$1A,$13,$96,$FF
8403: .byte $9C,$97,$04,$1E,$03,$06,$98,$18
8404: .byte $1F,$99,$07,$9E,$02,$08,$9A,$16
8405:
8406: .byte $12,$9B,$0A,$92,$0D,$0B,$0F,$0E
8407: .byte $08,$10,$0C,$09,$11,$14,$00,$09
8408: .byte $FF,$05,$15,$FF,$FF,$17,$19,$12
8409: .byte $90,$06,$FF,$05,$FF,$FF,$81,$FF
8410: .byte $FF
8411: .else
8412: .byte $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
8413: .byte $1C,$17,$01,$9F,$1A,$13,$05,$FF
8414: .byte $9C,$12,$04,$1E,$03,$06,$14,$18
8415: .byte $1F,$19,$07,$9E,$02,$08,$15,$16
8416:
8417: .byte $12,$09,$0A,$92,$0D,$0B,$0F,$0E
8418: .byte $FF,$10,$0C,$FF,$FF,$1B,$00,$FF
8419: .byte $1C,$FF,$1D,$FF,$FF,$1F,$1E,$FF
8420: .byte $90,$06,$FF,$05,$FF,$FF,$11,$FF
8421: .byte $FF
8422: .endif
8423:
8424: .else
8425:
8426: .byte $90,$1C,$9C,$1F
8427: .if CompileComputer = VIC20_02
8428: .byte $FF
8429: .else
8430: .byte $12
8431: .endif
8432: .byte $FF,$FF,$FF
8433: .if CompileComputer = VIC20_02
8434: .byte $FF
8435: .else
8436: .byte $06
8437: .endif
8438: .byte $FF,$12,$FF,$FF,$FF,$FF,$FF
8439: .byte $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
8440: .byte $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
8441: .byte $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
8442: .byte $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
8443: .byte $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
8444: .byte $05,$9F,$1E,$9E,$92,$FF,$FF,$FF
8445: .byte $FF
8446:
8447: .endif
8448:
8449: VIC_DEFAULTS:
8450:
8451: ; the default values for the VIC or VIC-II
8452: ; these will be copied in a loop into the
8453: ; VIC or VIC-II register when initialising the VIC(-II)
8454: ;
8455:
8456: .if CompileComputer >= C64_GENERAL
8457:
8458: .byte $00,$00,$00,$00,$00,$00,$00,$00
8459: .byte $00,$00,$00,$00,$00,$00,$00,$00
8460: .byte $00
8461: .if CompileComputer >= C64_02
8462: .byte $1B | (>311 .SHL 7) ,<311
8463: .else
8464: .byte $1B,$00
8465: .endif
8466: .byte $00,$00,$00,$08,$00
8467: .byte $14
8468: .if CompileComputer >= C64_02
8469: .byte $0F
8470: .else
8471: .byte $00
8472: .endif
8473: .byte $00,$00,$00,$00,$00,$00
8474:
8475: .byte SET_COLOR_FRAME,SET_COLOR_BACKGROUND
8476: .if CompileComputer = C64_4064
8477: .byte $00,$00,$00,$00,$00
8478: .byte $00,$00,$00,$00,$00,$00,$00
8479: .else
8480: .byte $01,$02,$03,$04,$00
8481: .byte $01,$02,$03,$04,$05,$06,$07
8482: .endif
8483:
8484: .else
8485:
8486: .if CompileComputer >= VIC20_07
8487: .byte $0C,$26
8488: .else
8489: .byte $05,$19
8490: .endif
8491: .byte $16,$2E,$00,$C0,$00,$00
8492: .byte $00,$00,$00,$00,$00,$00,$00
8493:
8494: .endif
8495:
8496: END_VIC_DEFAULTS:
8497:
8498: .if CompileComputer < C64_GENERAL
8499:
8500: .byte $1B ; TODO unused?
8501:
8502: .endif
8503:
8504: TEXT_LOADRUN:
8505: .byte "LOAD",ASC_CR
8506: .byte "RUN",ASC_CR
8507: END_TEXT_LOADRUN:
8508:
8509: SCREEN_LOWBYTE:
8510:
8511: ; the low bytes of the screen addresses
8512:
8513: .repeat EDITOR_ROWS,i
8514: .byte <(i*EDITOR_COLS)
8515: .endrep
8516:
8517: ; .include "../kernal/iec.a65"
8518: ; B-34. Function Name: TALK
8519: ;
8520: ; Purpose: Command a device on the serial bus to TALK
8521: ; Call address: $FFB4 (hex) 65460 (decimal)
8522: ; Communication registers: A
8523: ; Preparatory routines: None
8524: ; Error returns: See READST
8525: ; Stack requirements: 8
8526: ; Registers affected: A
8527: ;
8528: ; Description: To use this routine the accumulator must first be loaded
8529: ; with a device number between 0 and 31. When called, this routine then
8530: ; ORs bit by bit to convert this device number to a talk address. Then this
8531: ; data is transmitted as a command on the serial bus.
8532: ;
8533: ; How to Use:
8534: ;
8535: ; 1) Load the accumulator with the device number.
8536: ; 2) Call this routine.
8537: ;
8538: ; EXAMPLE:
8539: ;
8540: ; ;COMMAND DEVICE #4 TO TALK
8541: ; LDA #4
8542: ; JSR TALK
8543: ;
8544: iTALK:
8545: ora #IEEE_TALK ; create primary address for TALK
8546:
8547: .byte ASM_BIT3 ; hide next instruction
8548:
8549: ; B-14. Function Name: LISTEN
8550: ;
8551: ; Purpose: Command a device on the serial bus to listen
8552: ; Call Address: $FFB1 (hex) 65457 (decimal)
8553: ; Communication registers: A
8554: ; Preparatory routines: None
8555: ; Error returns: See READST
8556: ; Stack requirements: None
8557: ; Registers affected: A
8558: ;
8559: ; Description: This routine will command a device on the serial bus to
8560: ; receive data. The accumulator must be loaded with a device number between
8561: ; 0 and 31 before calling the routine. LISTEN will OR the number bit by bit
8562: ; to convert to a listen address, then transmits this data as a command on
8563: ; the serial bus. The specified device will then go into listen mode, and
8564: ; be ready to accept information.
8565: ;
8566: ; How to Use:
8567: ; 1) Load the accumulator with the number of the device to command
8568: ; to LISTEN.
8569: ; 2) Call this routine using the JSR instruction.
8570: ;
8571: ; EXAMPLE:
8572: ; ;COMMAND DEVICE #8 TO LISTEN
8573: ; LDA #8
8574: ; JSR LISTEN
8575: ;
8576: ;
8577: iLISTEN:
8578: ora #IEEE_LISTEN ; create primary address for TALK
8579: jsr LF0A4 ; TODO (assumed: Wait for RS232 transmission to stop)
8580:
8581: IecOutputCommand:
8582: pha ; remember byte to be output
8583:
8584: bit zC3PO ; test: Is there already some character in the output buffer?
8585: bpl @BufferByte ; no -> branch, do not output but put the byte into the buffer instead
8586:
8587: ; there is some byte in the output buffer.
8588: ; output it on the IEC bus.
8589:
8590: sec
8591: ror zTSFCNT ; set zTSFCNT.7, thus: Signal an EOI on output
8592:
8593: .ifdef JIFFY
8594: jsr JDLFBFE
8595: .else
8596: jsr IecOutputByte ; output a byte on IEC bus
8597: .endif
8598:
8599: ; IecOutputByte returns with C == 0
8600: lsr zC3PO ; unset zC3PO.7, thus:
8601: ; mark: There is no byte in the buffer
8602: lsr zTSFCNT ; unset zTSFCNT.7. Subsequent bytes will not be signalled with EOI
8603:
8604: @BufferByte:
8605: ; here, zC3PO.7 is unset.
8606: ; Either we jumped here because of the bpl, or it was specifically unset two lines above
8607:
8608: ; Thus, the buffer is already marked as empty
8609:
8610: pla ; get back the byte to be output
8611: sta zBSOUR ; and store it into the output buffer
8612:
8613: .if CompileComputer >= C64_GENERAL
8614: sei ; make sure the interrupt does not disturb our timing
8615:
8616: ; it is not completely clear if this command is missing
8617: ; on the VIC20, or if it is not critical there, as the VIC20
8618: ; does not have badlines, which might help the timing here.
8619: .endif
8620:
8621: ; TODO: document
8622: .ifdef JIFFY
8623: jsr JDLF0ED
8624: .else
8625: jsr IecDataClear
8626: .endif
8627:
8628: cmp #IEEE_UNLISTEN
8629: bne @NotUNLISTEN
8630:
8631: jsr IecClkClear
8632:
8633: @NotUNLISTEN:
8634:
8635: ; set ATN state
8636:
8637: lda IEC_REG_ATN_OUT
8638: ora #IEC_B_ATN_OUT
8639: sta IEC_REG_ATN_OUT
8640:
8641: IecOutputByte2:
8642: .if CompileComputer >= C64_GENERAL
8643: sei ; make sure the interrupt does not disturb our timing
8644:
8645: ; it is not completely clear if this command is missing
8646: ; on the VIC20, or if it is not critical there, as the VIC20
8647: ; does not have badlines, which might help the timing here.
8648: .endif
8649: jsr IecClkSet
8650: jsr IecDataClear
8651: jsr IecDelay1ms
8652:
8653:
8654:
8655: IecOutputByte:
8656: sei ; make sure the interrupt does not disturb our timing
8657:
8658: .if CompileComputer >= VIC20_06
8659: jsr IecDataClear
8660: .endif
8661:
8662: jsr IecGetDataClockIn
8663: IEC_GET_DATA_INTO_CARRY
8664: bcs @DeviceNotPresent
8665: jsr IecClkClear
8666: bit zTSFCNT
8667: bpl @LED5A
8668:
8669: @WaitDataInactive:
8670: jsr IecGetDataClockIn
8671: IEC_GET_DATA_INTO_CARRY
8672: bcc @WaitDataInactive
8673:
8674: @WaitDataActive:
8675: jsr IecGetDataClockIn
8676: IEC_GET_DATA_INTO_CARRY
8677: bcs @WaitDataActive
8678:
8679: @LED5A:
8680: jsr IecGetDataClockIn
8681: IEC_GET_DATA_INTO_CARRY
8682: bcc @LED5A
8683:
8684: jsr IecClkSet
8685:
8686: .ifdef JIFFY
8687: txa
8688: pha
8689: ldx #8
8690: .else
8691: lda #8 ; number of bits to be output
8692: sta zCNTDN
8693: .endif
8694:
8695: @NextBit:
8696:
8697: .ifdef JIFFY
8698: pha
8699: pla
8700: bit IEC_REG
8701: bmi @JDLED72
8702: pla
8703: tax
8704: jmp SendTimeout
8705:
8706: @JDLED72:
8707: jsr IecDataClear
8708: ror zBSOUR
8709: bcs @JDLED7C
8710: jsr IecDataSet
8711:
8712: @JDLED7C:
8713: jsr IecClkClear
8714: lda IEC_REG
8715: and # ~ IEC_B_DATA_OUT
8716: ora #IEC_B_CLK_OUT
8717: php
8718: pha
8719: jsr JDLF8EA
8720: pla
8721: plp
8722: dex
8723: bne @NextBit
8724: pla
8725: tax
8726:
8727: .else
8728: lda IEC_REG_DATA_CLK_IN
8729: cmp IEC_REG_DATA_CLK_IN
8730: bne @NextBit ; wait for IEC register to settle (TODO entprellen)
8731: IEC_REG__DATA_IN_INTO_CARRY
8732: bcc SendTimeout ; data set (inactive) -> something/someone else is messing with us, there is a transmission problem -> branch
8733:
8734: ror zBSOUR ; next bit to output (LSB) into C
8735: bcs @OutputData1 ; is it set -> output a "1" (inactive) on the IEC bus data line
8736: jsr IecDataSet ; it was not set -> output a "0" (active) on the IEC bus data line
8737: bne @ContinueAfterOutputData ; skip next command
8738:
8739: @OutputData1:
8740: jsr IecDataClear ; output a "1" (inactive) on the IEC bus data line
8741:
8742: @ContinueAfterOutputData:
8743: jsr IecClkClear ; clear clock to indicate: Data has been set accordingly
8744:
8745: ; delay 8 (4*2) clock cycles, giving the other side time to read the value in
8746: nop
8747: nop
8748: nop
8749: nop
8750:
8751: ; clear DATA and set Clock again, indicating the bit is not available anymore
8752: lda IEC_REG_DATA_CLK_OUT
8753: and #~IEC_B_DATA_OUT
8754: ora #IEC_B_CLK_OUT
8755: sta IEC_REG_DATA_CLK_OUT
8756:
8757: dec zCNTDN ; still bits to be output?
8758: bne @NextBit ; yes -> branch -> process the next bit
8759: .endif
8760:
8761: ; TODO document
8762:
8763: ; wait for acknowledgement from other side
8764:
8765: lda #>$0400 ; set timer to approx. 1000 µs ( = 1 ms)
8766: sta IEC_TIMER_HI
8767:
8768: .if CompileComputer >= C64_GENERAL
8769:
8770: ; start timer B with one-shot mode, no PB7, counting PHI2
8771: lda #CIA_CRB_B_START | CIA_CRB_B_ONESHOT | CIA_CRB_B_FORCE_LOAD
8772: sta CIA1 + CIA_O_CRB
8773:
8774: lda IEC_TIMER_FLAG_REG ; make sure the ICR is cleared, so we do not
8775: ; immediately stop the following loop because
8776: ; some other TB underflow condition has occurred before
8777: .endif
8778:
8779:
8780: @WaitForAck:
8781: lda IEC_TIMER_FLAG_REG
8782: and #IEC_TIMER_FLAG_B
8783: bne SendTimeout
8784: jsr IecGetDataClockIn
8785: IEC_GET_DATA_INTO_CARRY
8786: bcs @WaitForAck
8787: cli
8788: rts
8789:
8790:
8791: @DeviceNotPresent:
8792: lda #$80 ; set bit: device not present error
8793:
8794: .byte ASM_BIT3 ; hide the next instruction
8795:
8796: SendTimeout:
8797: lda #$03 ; set bits: read timeout and write timeout
8798:
8799: IecSetStatusAndFreeBus:
8800: jsr SetStatus ; set the status bits
8801:
8802: .if CompileComputer = VIC20_02
8803: jsr IEC_CLR_ATN
8804: jsr IecClkSet
8805: .endif
8806:
8807: cli
8808: .if CompileComputer >= VIC20_06
8809: clc
8810: bcc IecClearAtnAndClockAndDataAfterDelay
8811: ; ------------------
8812: .else
8813: jmp IecDataClear
8814: ; ------------------
8815: .endif
8816:
8817: ; B-27. Function Name: SECOND
8818: ;
8819: ; Purpose: Send secondary address for LISTEN
8820: ; Call address: $FF93 (hex) 65427 (decimal)
8821: ; Communication registers: A
8822: ; Preparatory routines: LISTEN
8823: ; Error returns: See READST
8824: ; Stack requirements: 8
8825: ; Registers affected: A
8826: ;
8827: ; Description: This routine is used to send a secondary address to an
8828: ; I/O device after a call to the LISTEN routine is made, and the device is
8829: ; commanded to LISTEN. The routine canNOT be used to send a secondary
8830: ; address after a call to the TALK routine.
8831: ; A secondary address is usually used to give setup information to a
8832: ; device before I/O operations begin.
8833: ; When a secondary address is to be sent to a device on the serial bus,
8834: ; the address must first be ORed with $60.
8835: ;
8836: ; How to Use:
8837: ;
8838: ; 1) load the accumulator with the secondary address to be sent.
8839: ; 2) Call this routine.
8840: ;
8841: ; EXAMPLE:
8842: ;
8843: ; ;ADDRESS DEVICE #8 WITH COMMAND (SECONDARY ADDRESS) #15
8844: ; LDA #8
8845: ; JSR LISTEN
8846: ; LDA #15
8847: ; JSR SECOND
8848: ;
8849: ;
8850: iSECOND:
8851: sta zBSOUR ; byte (secondary address after LISTEN) to be output
8852: jsr IecOutputByte2
8853:
8854: IEC_CLR_ATN:
8855:
8856: ; clear ATN state
8857: lda IEC_REG_ATN_OUT
8858: and #~IEC_B_ATN_OUT
8859: sta IEC_REG_ATN_OUT
8860:
8861: rts
8862:
8863: ; B-35. Function Name: TKSA
8864: ;
8865: ; Purpose: Send a secondary address to a device commanded to TALK
8866: ; Call address: $FF96 (hex) 65430 (decimal)
8867: ; Communication registers: A
8868: ; Preparatory routines: TALK
8869: ; Error returns: See READST
8870: ; Stack requirements: 8
8871: ; Registers affected: A
8872: ;
8873: ;
8874: ;
8875: ; Description: This routine transmits a secondary address on the serial
8876: ; bus for a TALK device. This routine must be called with a number between
8877: ; 0 and 31 in the accumulator. The routine sends this number as a secondary
8878: ; address command over the serial bus. This routine can only be called
8879: ; after a call to the TALK routine. It will not work after a LISTEN.
8880: ;
8881: ; How to Use:
8882: ;
8883: ; 0) Use the TALK routine.
8884: ; 1) Load the accumulator with the secondary address.
8885: ; 2) Call this routine.
8886: ;
8887: ; EXAMPLE:
8888: ;
8889: ; ;TELL DEVICE #4 TO TALK WITH COMMAND #7
8890: ; LDA #4
8891: ; JSR TALK
8892: ; LDA #7
8893: ; JSR TALKSA
8894: ;
8895: iTKSA:
8896: sta zBSOUR ; byte (secondary address after TALK) to be output
8897: jsr IecOutputByte2
8898:
8899: ; perform talk - listener - change (TODO)
8900:
8901: iTKSA2:
8902: sei
8903: jsr IecDataSet
8904: jsr IEC_CLR_ATN
8905: jsr IecClkClear
8906:
8907: @LEDD6:
8908: .ifdef JIFFY
8909: bit IEC_REG
8910: .else
8911: jsr IecGetDataClockIn
8912: .endif
8913:
8914: .ifdef JIFFY
8915: bvs @LEDD6
8916: .elseif CompileComputer >= C64_GENERAL
8917: bmi @LEDD6
8918: .else
8919: bcs @LEDD6
8920: .endif
8921: cli
8922: rts
8923:
8924: ; B-6. Function Name: CIOUT
8925: ;
8926: ; Purpose: Transmit a byte over the serial bus
8927: ; Call address: $FFA8 (hex) 65448 (decimal)
8928: ; Communication registers: A
8929: ; Preparatory routines: LISTEN, [SECOND]
8930: ; Error returns: See READST
8931: ; Stack requirements: 5
8932: ; Registers affected: None
8933: ;
8934: ; Description: This routine is used to send information to devices on the
8935: ; serial bus. A call to this routine will put a data byte onto the serial
8936: ; bus using full serial handshaking. Before this routine is called, the
8937: ; LISTEN KERNAL routine must be used to command a device on the serial bus
8938: ; to get ready to receive data. (If a device needs a secondary address, it
8939: ; must also be sent by using the SECOND KERNAL routine.) The accumulator is
8940: ; loaded with a byte to handshake as data on the serial bus. A device must
8941: ; be listening or the status word will return a timeout. This routine
8942: ; always buffers one character. (The routine holds the previous character
8943: ; to be sent back.) So when a call to the KERNAL UNLSN routine is made to
8944: ; end the data transmission, the buffered character is sent with an End Or
8945: ; Identify (EOI) set. Then the UNLSN command is sent to the device.
8946: ;
8947: ; How to Use:
8948: ;
8949: ; 0) Use the LISTEN KERNAL routine (and the SECOND routine if needed).
8950: ; 1) Load the accumulator with a byte of data.
8951: ; 2) Call this routine to send the data byte.
8952: ;
8953: ; EXAMPLE:
8954: ;
8955: ;
8956: ; LDA #'X ;SEND AN X TO THE SERIAL BUS
8957: ; JSR CIOUT
8958: ;
8959: ;
8960: iCIOUT:
8961: bit zC3PO ; check if there is already a byte buffered to be output
8962: bmi @SendBufferedChar ; there is one -> branch, send it
8963:
8964: sec ; there was none -> set bit 7 to mark that we now have a byte to be output
8965: ror zC3PO
8966:
8967: bne @NoCached ; uncond. branch: store the next byte to be output
8968: ; ------------------
8969:
8970: @SendBufferedChar:
8971: pha ; remember the new byte to be output
8972: .ifdef JIFFY
8973: jsr $FBFE
8974: .else
8975: jsr IecOutputByte ; output the old buffered byte
8976: .endif
8977: pla ; get back the new byte to be output
8978:
8979: @NoCached:
8980: sta zBSOUR ; store the new byte to be output on the next call
8981:
8982: clc ; mark: no error
8983: rts
8984: ; ------------------
8985:
8986:
8987: ; B-38. Function Name: UNTLK
8988: ;
8989: ; Purpose: Send an UNTALK command
8990: ; Call address: $FFAB (hex) 65451 (decimal)
8991: ; Communication registers: None
8992: ; Preparatory routines: None
8993: ; Error returns: See READST
8994: ; Stack requirements: 8
8995: ; Registers affected: A
8996: ;
8997: ; Description: This routine transmits an UNTALK command on the serial
8998: ; bus. All devices previously set to TALK will stop sending data when this
8999: ; command is received.
9000: ;
9001: ; How to Use:
9002: ; 1) Call this routine.
9003: ;
9004: ;
9005: ; EXAMPLE:
9006: ; JSR UNTALK
9007: ;
9008: iUNTLK:
9009: .if CompileComputer >= C64_GENERAL
9010: sei
9011: .endif
9012:
9013: ; make sure to signal the talker that we will take over the bus now!
9014:
9015: .ifdef JIFFY
9016: .else
9017: jsr IecClkSet
9018: .endif
9019:
9020: ; set ATN state
9021:
9022: lda IEC_REG_ATN_OUT
9023: ora #IEC_B_ATN_OUT
9024: sta IEC_REG_ATN_OUT
9025:
9026: .ifdef JIFFY
9027: jsr IecClkSet
9028: .endif
9029:
9030: lda #IEEE_UNTALK ; set command byte: UNTALK
9031:
9032: .byte ASM_BIT3 ; hide the next instruction
9033:
9034: ; B-37. Function Name: UNLSN
9035: ;
9036: ; Purpose: Send an UNLISTEN command
9037: ; Call address: $FFAE (hex) 65454 (decimal)
9038: ; Communication registers: None
9039: ; Preparatory routines: None
9040: ; Error returns: See READST
9041: ; Stack requirements: 8
9042: ; Registers affected: A
9043: ;
9044: ; Description: This routine commands all devices on the serial bus to
9045: ; stop receiving data from the Commodore 64 (i.e., UNLISTEN). Calling this
9046: ; routine results in an UNLISTEN command being transmitted on the serial
9047: ; bus. Only devices previously commanded to listen are affected. This
9048: ; routine is normally used after the Commodore 64 is finished sending data
9049: ; to external devices. Sending the UNLISTEN commands the listening devices
9050: ; to get off the serial bus so it can be used for other purposes.
9051: ;
9052: ; How to Use:
9053: ; 1) Call this routine.
9054: ;
9055: ; EXAMPLE:
9056: ; JSR UNLSN
9057: ;
9058: iUNLSN:
9059: lda #IEEE_UNLISTEN ; set command byte: UNLISTEN
9060:
9061: jsr IecOutputCommand ; output the command byte on the IEC bus
9062:
9063: .if CompileComputer = VIC20_02
9064: bne IEC_CLR_ATN ; done (bug)
9065: ; ---------------------
9066: .else
9067:
9068: IecClearAtnAndClockAndDataAfterDelay:
9069: jsr IEC_CLR_ATN ; clear ATN
9070:
9071: ; TODO document
9072:
9073: IecClearClockAndDataAfterDelay:
9074: txa
9075: .if CompileComputer >= C64_GENERAL
9076: ; TODO define
9077: ldx #10
9078: .else
9079: ldx #11
9080: .endif
9081: @Delay: dex
9082: bne @Delay
9083: tax
9084: jsr IecClkClear
9085: jmp IecDataClear
9086: .endif
9087:
9088: ; B-1. Function Name: ACPTR
9089: ;
9090: ; Purpose: Get data from the serial bus
9091: ; Call address: $FFA5 (hex) 65445 (decimal)
9092: ; Communication registers: A
9093: ; Preparatory routines: TALK, TKSA
9094: ; Error returns: See READST
9095: ; Stack requirements: 13
9096: ; Registers affected: A, X
9097: ;
9098: ;
9099: ;
9100: ; Description: This is the routine to use when you want to get informa-
9101: ; tion from a device on the serial bus, like a disk. This routine gets a
9102: ; byte of data off the serial bus using full handshaking. The data is
9103: ; returned in the accumulator. To prepare for this routine the TALK routine
9104: ; must be called first to command the device on the serial bus to send data
9105: ; through the bus. If the input device needs a secondary command, it must
9106: ; be sent by using the TKSA KERNAL routine before calling this routine.
9107: ; Errors are returned in the status word. The READST routine is used to
9108: ; read the status word.
9109: ;
9110: ;
9111: ; How to Use:
9112: ;
9113: ; 0) Command a device on the serial bus to prepare to send data to
9114: ; the Commodore 64. (Use the TALK and TKSA KERNAL routines.)
9115: ; 1) Call this routine (using JSR).
9116: ; 2) Store or otherwise use the data.
9117: ;
9118: ;
9119: ; EXAMPLE:
9120: ;
9121: ; ;GET A BYTE FROM THE BUS
9122: ; JSR ACPTR
9123: ; STA DATA
9124: ;
9125: ;
9126: ;
9127: iACPTR:
9128: .ifdef JIFFY
9129: jmp $FBAA
9130:
9131: .else
9132:
9133: sei ; make sure to be able to hold the timing
9134:
9135: .if CompileComputer < VIC20_06
9136: lda #8 ; 8 bits to be input
9137: .else
9138: lda #0 ; TODO: ???
9139: .endif
9140: .endif
9141:
9142: JDiACPTR:
9143: sta zCNTDN ; and store it as counter
9144:
9145:
9146:
9147: .if CompileComputer >= VIC20_06
9148: jsr IecClkClear ; clear CLOCK to signal: We are ready to handle the byte
9149: .endif
9150:
9151:
9152: @WaitDataInactive:
9153:
9154: ; wait for DATA to become inactive:
9155: ; That is, wait for the other side to be ready to send a byte
9156:
9157: jsr IecGetDataClockIn
9158: .if CompileComputer >= C64_GENERAL
9159: bpl @WaitDataInactive
9160: .else
9161: bcc @WaitDataInactive
9162: jsr IecDataClear ; clear DATA (unnecessary, as the loop would not terminate if we would not have data cleared!)
9163: .endif
9164:
9165: @LEE20:
9166:
9167: lda #>$0100 ; set timer to approx. 250 µs
9168: sta IEC_TIMER_HI
9169:
9170: .if CompileComputer >= C64_GENERAL
9171: ; start timer B with one-shot mode, no PB7, counting PHI2
9172: lda #CIA_CRB_B_START | CIA_CRB_B_ONESHOT | CIA_CRB_B_FORCE_LOAD
9173: sta CIA1 + CIA_O_CRB
9174:
9175: jsr IecDataClear ; clear DATA
9176:
9177: lda IEC_TIMER_FLAG_REG ; make sure the ICR is cleared, so we do not
9178: ; immediately stop the following loop because
9179: ; some other TB underflow condition has occurred before
9180:
9181: .endif
9182:
9183: @LEE30: lda IEC_TIMER_FLAG_REG
9184: and #IEC_TIMER_FLAG_B
9185: bne @LEE3E
9186:
9187: jsr IecGetDataClockIn
9188:
9189: .if CompileComputer >= C64_GENERAL
9190: bmi @LEE30
9191: bpl @LEE56
9192: .else
9193: bcs @LEE30
9194: bcc @LEE56
9195: .endif
9196:
9197:
9198: @LEE3E:
9199:
9200: .if CompileComputer = VIC20_02
9201:
9202: jsr IecDataSet
9203: txa
9204: ldx #$10
9205: @Delay: dex
9206: bne @Delay
9207: tax
9208: jsr IecDataClear
9209: jsr IecGetDataClockIn
9210:
9211: lda #$40 ; status bit: EOI
9212: jsr SetStatus ; set the status to EOI
9213:
9214: @LEE56: lda IEC_REG_DATA_CLK_IN
9215: cmp IEC_REG_DATA_CLK_IN
9216: bne @LEE56
9217: IEC_REG__CLOCK_IN_INTO_CARRY
9218: bcc @LEE56
9219: lsr a
9220: ror zTBTCNT
9221:
9222: @WaitClkInactive:
9223: lda IEC_REG_DATA_CLK_IN
9224: cmp IEC_REG_DATA_CLK_IN
9225: bne @WaitClkInactive
9226:
9227: IEC_REG__CLOCK_IN_INTO_CARRY
9228: bcs @WaitClkInactive
9229: dec zCNTDN
9230: bne @LEE56
9231: jsr IecDataSet
9232: lda zTBTCNT
9233: cli
9234: clc
9235: rts
9236:
9237: .else
9238:
9239: lda zCNTDN
9240: beq @Proceed
9241:
9242: lda #$02 ; set status: read timeout
9243: jmp IecSetStatusAndFreeBus ; ... and free the bus and exit
9244: ; ------------------
9245:
9246: @Proceed:
9247: jsr IecDataSet
9248: .if CompileComputer >= C64_GENERAL
9249: jsr IecClkClear
9250: .else
9251: jsr IecClearClockAndDataAfterDelay
9252: .endif
9253: lda #$40
9254: jsr SetStatus
9255: inc zCNTDN
9256: bne @LEE20
9257:
9258: @LEE56: lda #8 ; number of bits to be input
9259: sta zCNTDN
9260: @LEE5A:
9261: lda IEC_REG_DATA_CLK_IN
9262: cmp IEC_REG_DATA_CLK_IN
9263: bne @LEE5A
9264:
9265: .if CompileComputer >= C64_GENERAL
9266: asl a
9267: bpl @LEE5A
9268: .else
9269: lsr a
9270: bcc @LEE5A
9271: lsr a
9272: .endif
9273: ror zTBTCNT
9274: @LEE67:
9275: lda IEC_REG_DATA_CLK_IN
9276: cmp IEC_REG_DATA_CLK_IN
9277: bne @LEE67
9278: .if CompileComputer >= C64_GENERAL
9279: asl a
9280: bmi @LEE67
9281: .else
9282: lsr a
9283: bcs @LEE67
9284: .endif
9285:
9286: dec zCNTDN
9287: bne @LEE5A
9288: jsr IecDataSet
9289: .if CompileComputer >= C64_GENERAL
9290: bit zSTATUS
9291: bvc @LEE80
9292: .else
9293: lda zSTATUS
9294: beq @LEE80
9295: .endif
9296: jsr IecClearClockAndDataAfterDelay
9297: @LEE80: lda zTBTCNT
9298: cli
9299: clc
9300: rts
9301: .endif
9302:
9303: IecClkClear:
9304: ; clear (set inactive) the clock line
9305: lda IEC_REG_DATA_CLK_OUT
9306: and #~IEC_B_CLK_OUT
9307: sta IEC_REG_DATA_CLK_OUT
9308: rts
9309:
9310: IecClkSet:
9311: ; set (set active) the clock line
9312: lda IEC_REG_DATA_CLK_OUT
9313: ora #IEC_B_CLK_OUT
9314: sta IEC_REG_DATA_CLK_OUT
9315: rts
9316:
9317: .segment "KERNAL_IEC_DATA"
9318:
9319: IecDataClear:
9320: lda IEC_REG_DATA_CLK_OUT
9321: and #~IEC_B_DATA_OUT
9322: sta IEC_REG_DATA_CLK_OUT
9323: rts
9324: IecDataSet:
9325: lda IEC_REG_DATA_CLK_OUT
9326: ora #IEC_B_DATA_OUT
9327: sta IEC_REG_DATA_CLK_OUT
9328: rts
9329:
9330: ; reads in IEC register and returns
9331: ; * C64:
9332: ; - DATA IN in Carry
9333: ; - CLOCK IN in A & 0x80
9334: ; * VIC20:
9335: ; - CLOCK IN in Carry
9336: ; - DATA IN in A & 0x01
9337: ;
9338: IecGetDataClockIn:
9339: lda IEC_REG_DATA_CLK_IN
9340: cmp IEC_REG_DATA_CLK_IN
9341: bne IecGetDataClockIn
9342: .if CompileComputer >= C64_GENERAL
9343: asl a
9344: .else
9345: lsr a
9346: .endif
9347: rts
9348:
9349:
9350: .segment "KERNAL_IEC_DELAY"
9351:
9352: IecDelay1ms:
9353:
9354: .if CompileComputer >= C64_GENERAL
9355: txa
9356: ldx #184
9357: @Delay: dex
9358: bne @Delay
9359: tax
9360: .else
9361: lda #>$0400 ; program T2 for $0400 = 1024 cycles (approx. 1 ms)
9362: sta VIA2_T2CH ; (low byte is not written, thus, should be 0)
9363:
9364: ; wait for T2 flag being set in the IFR,
9365: ; telling us that the timer expired
9366: @Wait:
9367: lda VIA2_IFR
9368: and #VIA_IFR_B_T2
9369: beq @Wait
9370: .endif
9371: rts
9372:
9373: ; .include "../kernal/rs232.a65"
9374: LEEBB:
9375: lda zBITTS
9376: beq LEF06
9377: bmi @LEF00
9378: lsr zRODATA
9379: ldx #$00
9380: bcc @LEEC8
9381: dex
9382: @LEEC8:
9383: txa
9384: eor zROPRTY
9385: sta zROPRTY
9386: dec zBITTS
9387: beq @LEED7
9388: @LEED1:
9389: txa
9390: .if CompileComputer >= C64_GENERAL
9391: and #$04
9392: .else
9393: and #$20
9394: .endif
9395: sta zNXTBIT
9396: rts
9397:
9398: @LEED7:
9399: lda #$20
9400: bit lM51CDR
9401: beq @LEEF2
9402: bmi @LEEFC
9403: bvs @LEEF6
9404: lda zROPRTY
9405: bne @LEEE7
9406: @LEEE6:
9407: dex
9408: @LEEE7:
9409: dec zBITTS
9410: lda lM51CTR
9411: bpl @LEED1
9412: dec zBITTS
9413: bne @LEED1
9414: @LEEF2:
9415: inc zBITTS
9416: bne @LEEE6
9417: @LEEF6:
9418: lda zROPRTY
9419: beq @LEEE7
9420: bne @LEEE6
9421: @LEEFC:
9422: bvs @LEEE7
9423: bvc @LEEE6
9424: ; ------------------
9425:
9426: @LEF00:
9427: inc zBITTS
9428: ldx #$FF
9429: bne @LEED1
9430:
9431: LEF06:
9432: lda lM51CDR
9433: lsr a
9434: bcc @LEF13
9435: bit RS232_REG_2
9436: bpl LF016
9437: bvc LEF31
9438: @LEF13:
9439: lda #$00
9440: sta zROPRTY
9441: sta zNXTBIT
9442: ldx lBITNUM
9443: stx zBITTS
9444: ldy lRODBS
9445: cpy lRODBE
9446: beq LEF39
9447: lda (zROBUF),y
9448: sta zRODATA
9449: inc lRODBS
9450: rts
9451:
9452: LF016:
9453: lda #$40
9454: .byte ASM_BIT3
9455: LEF31:
9456: lda #$10
9457: ora lRSSTAT
9458: sta lRSSTAT
9459: LEF39:
9460: .if CompileComputer >= C64_GENERAL
9461: lda #CIA_ICR_B_TA
9462: LEF3B: sta CIA2 + CIA_O_ICR
9463: eor lENABL
9464: ora #CIA_ICR_BW_SET
9465: sta lENABL
9466: sta CIA2 + CIA_O_ICR
9467: .else
9468: lda #$40
9469: sta VIA1_IEC
9470: .endif
9471: rts
9472:
9473: ; get number of bits to transmit
9474: ;
9475: LEF4A:
9476: ldx #$09
9477: lda #$20
9478: bit lM51CTR
9479: beq @LEF54
9480: dex
9481: @LEF54:
9482: bvc @LEF58
9483: dex
9484: dex
9485: @LEF58:
9486: rts
9487: ; ---------------
9488:
9489: LEF59: ldx zRINONE
9490: bne LEF90
9491: dec zBITC1
9492: beq LEF97
9493: bmi LEF70
9494: lda zINBIT
9495: eor zRIPRTY
9496: sta zRIPRTY
9497: lsr zINBIT
9498: ror zRIDATA
9499: LEF6D: rts
9500:
9501: LEF6E: dec zBITC1
9502: LEF70: lda zINBIT
9503: beq LEFDB
9504: lda lM51CTR
9505: asl a
9506: lda #$01
9507: adc zBITC1
9508: bne LEF6D
9509: LEF7E:
9510: .if CompileComputer >= C64_GENERAL
9511: lda #CIA_ICR_B_FLAG | CIA_ICR_BW_SET
9512: sta CIA2 + CIA_O_ICR
9513: ora lENABL
9514: sta lENABL
9515: .else
9516: lda #$90
9517: sta VIA1_IEC
9518: .endif
9519: sta zRINONE
9520: .if CompileComputer >= C64_GENERAL
9521: lda #$02
9522: jmp LEF3B
9523: .else
9524: lda #$20
9525: sta VIA1_IEC
9526: rts
9527: .endif
9528:
9529: LEF90: lda zINBIT
9530: bne LEF7E
9531: .if CompileComputer >= C64_03 .AND CompileComputer <> C64_4064
9532: jmp LE4D3
9533: .else
9534: sta zRINONE
9535: rts
9536: .endif
9537:
9538: LEF97: ldy lRIDBE
9539: iny
9540: cpy lRIDBS
9541: beq @LEFCA
9542: sty lRIDBE
9543: dey
9544: lda zRIDATA
9545: ldx lBITNUM
9546: @LEFA9: cpx #$09
9547: beq @LEFB1
9548: lsr a
9549: inx
9550: bne @LEFA9
9551: @LEFB1: sta (zRIBUF),y
9552: lda #$20
9553: bit lM51CDR
9554: beq LEF6E
9555: bmi LEF6D
9556: lda zINBIT
9557: eor zRIPRTY
9558: beq @LEFC5
9559: bvs LEF6D
9560: .byte ASM_BIT3
9561: @LEFC5: bvc LEF6D
9562: lda #$01
9563: .byte ASM_BIT3
9564: @LEFCA: lda #$04
9565: .byte ASM_BIT3
9566: LEFCD: lda #$80
9567: .byte ASM_BIT3
9568: LEFD0: lda #$02
9569: ora lRSSTAT
9570: sta lRSSTAT
9571: jmp LEF7E
9572:
9573: LEFDB: lda zRIDATA
9574: bne LEFD0
9575: beq LEFCD
9576: .if CompileComputer < C64_GENERAL
9577: Rs232ErrIllegalDeviceNumber:
9578: jmp KErrIllegalDeviceNumber
9579: .endif
9580:
9581: RS232_CHKOUT:
9582: sta zDFLTO
9583: lda lM51CDR
9584: lsr a
9585: bcc LF012
9586: lda #$02
9587: bit RS232_REG_1
9588: bpl LF00D
9589: bne LF012
9590:
9591: @LEFF2:
9592: .if CompileComputer >= C64_GENERAL
9593: lda lENABL
9594: and #CIA_ICR_B_TB
9595: .else
9596: lda VIA1_IEC
9597: and #$30
9598: .endif
9599: bne @LEFF2
9600: @LEFF9:
9601: bit RS232_REG_1
9602: bvs @LEFF9
9603: lda RS232_REG_1
9604: ora #$02
9605: sta RS232_REG_1
9606: @LF006:
9607: bit RS232_REG_1
9608: bvs LF012
9609: bmi @LF006
9610:
9611: LF00D:
9612: .if CompileComputer >= C64_GENERAL
9613: lda #$40
9614: sta lRSSTAT
9615: .else
9616: jsr LF016
9617: .endif
9618: LF012: clc
9619: rts
9620:
9621:
9622: LF014:
9623:
9624: .if CompileComputer >= C64_GENERAL
9625: jsr LF028
9626: .endif
9627:
9628: ; Write a character to the RS232 output buffer
9629: ;
9630: ; The character is returned in A. If there is
9631: ; no character in the buffer, A will contain 0.
9632: ;
9633: ; For C64 and above, this function also
9634: ; sets lRSSTAT.3 (TODO: "buffer empty"?)
9635: ;
9636: RS232_PUTCHAR:
9637: ldy lRODBE ; is the output buffer read pointer
9638: iny ; + 1
9639: cpy lRODBS ; equal to the output buffer write pointer?
9640: beq LF014 ; yes -> ring buffer is full -> wait until it is empty again
9641:
9642: sty lRODBE ; advance the output buffer write pointer, leaving room for the character to be written
9643:
9644: dey ; the location we reserved the space for is one before, thus, decrement Y again
9645:
9646: .if CompileComputer >= C64_GENERAL
9647: lda zPTR1
9648: .endif
9649: sta (zROBUF),y ; store the output character into the output buffer
9650:
9651: .if CompileComputer >= C64_GENERAL
9652: LF028: lda lENABL
9653: lsr a ; test CIA_ICR_B_TA
9654: bcs @Rts
9655: lda #CIA_CRA_B_FORCE_LOAD
9656: sta CIA2 + CIA_O_CRA
9657: .else
9658: bit VIA1_IEC
9659: bvc @LF102
9660: rts
9661: @LF102:
9662:
9663: .endif
9664:
9665: lda lBAUDOF
9666: sta RS232_TIMER_LO
9667: lda lBAUDOF + 1
9668: sta RS232_TIMER_HI
9669:
9670: .if CompileComputer >= C64_GENERAL
9671: lda #$81
9672: jsr LEF3B
9673: jsr LEF06
9674: lda #$11
9675: sta CIA2 + CIA_O_CRA
9676: @Rts: rts
9677: .else
9678: lda #$C0
9679: sta VIA1_IEC
9680: jmp LEF06
9681: .endif
9682:
9683: RS232_CHKIN:
9684: sta zDFLTN ; set default output device
9685: lda lM51CDR
9686: lsr a
9687: bcc @LF07D
9688: and #$08
9689: beq @LF07D
9690: lda #$02
9691: bit RS232_REG_1
9692: bpl LF00D
9693: beq @ClcRts
9694:
9695: @LF062:
9696: .if CompileComputer >= C64_GENERAL
9697: lda lENABL
9698: lsr a ; test CIA_ICR_B_TA
9699: bcs @LF062
9700: .else
9701: bit VIA1_IEC
9702: bvs @LF062
9703: .endif
9704:
9705: lda RS232_REG_1
9706: and #~$02
9707: sta RS232_REG_1
9708: @LF070:
9709: lda RS232_REG_1
9710: and #$04
9711: beq @LF070
9712: @LF077: lda #$90
9713: .if CompileComputer >= C64_GENERAL
9714: clc
9715: jmp LEF3B
9716: .else
9717: sta VIA1_IEC
9718: @ClcRts:
9719: clc
9720: rts
9721: .endif
9722:
9723: @LF07D:
9724:
9725: .if CompileComputer >= C64_GENERAL
9726: lda lENABL
9727: and #CIA_ICR_B_FLAG | CIA_ICR_B_TB
9728: .else
9729: lda VIA1_IEC
9730: and #$30
9731: .endif
9732: beq @LF077
9733:
9734: .if CompileComputer >= C64_GENERAL
9735: @ClcRts:
9736: .endif
9737: clc
9738: rts
9739:
9740: ; Read a character from the RS232 input buffer
9741: ;
9742: ; The character is returned in A. If there is
9743: ; no character in the buffer, A will contain 0.
9744: ;
9745: ; For C64 and above, this function also
9746: ; sets lRSSTAT.3 (TODO: "buffer empty"?)
9747: ;
9748: RS232_GETCHAR:
9749:
9750: .if CompileComputer >= C64_GENERAL
9751: lda lRSSTAT ; as we modifiy lRSSTAT, make its value available for both if() cases.
9752: .endif
9753:
9754: ldy lRIDBS ; get read buffer into RS232 input buffer
9755: cpy lRIDBE ; compare with write buffer
9756: beq @BufferEmpty ; they are the same -> input buffer empty -> skip reading
9757:
9758: .if CompileComputer >= C64_GENERAL
9759: and #~$08
9760: sta lRSSTAT ; clear bit: buffer is not empty (TODO?)
9761: .endif
9762: lda (zRIBUF),y ; get character from buffer
9763: inc lRIDBS ; increment read pointer
9764: rts
9765: ; ---------------
9766:
9767: @BufferEmpty:
9768:
9769: .if CompileComputer >= C64_GENERAL
9770: ora #$08
9771: sta lRSSTAT ; set bit: buffer empty (TODO?)
9772: .endif
9773: lda #$00 ; return: no character in buffer
9774: rts
9775: ; ---------------
9776:
9777:
9778: LF0A4:
9779:
9780: pha
9781: .if CompileComputer >= C64_GENERAL
9782: lda lENABL
9783: .else
9784: lda VIA1_IEC
9785: .endif
9786: beq @PlaRts
9787:
9788: @Wait:
9789:
9790: .if CompileComputer >= C64_GENERAL
9791: lda lENABL
9792: and #CIA_ICR_B_TA | CIA_ICR_B_TB
9793: .else
9794: lda VIA1_IEC
9795: and #VIA_IER_B_T1 | VIA_IER_B_T2
9796: .endif
9797: bne @Wait
9798:
9799: .if CompileComputer >= C64_GENERAL
9800: lda #CIA_ICR_B_FLAG
9801: sta CIA2 + CIA_O_ICR
9802: .else
9803: lda #VIA_IER_B_CB1
9804: sta VIA1_IEC
9805: .endif
9806:
9807: .if CompileComputer >= C64_GENERAL
9808: lda #$00
9809: sta lENABL
9810: .endif
9811:
9812: @PlaRts:
9813: pla
9814: rts
9815:
9816: ; .include "../kernal/message.a65"
9817: ; KERNAL system essages
9818:
9819: LMESSAGES:
9820:
9821: StrIoError:
9822: .byte ASC_CR
9823: htasc "I/O ERROR #" ; used in case an I/O error occurs in a KERNAL routine, and zNSGFLG.6 is set
9824:
9825: StrSearching:
9826: .byte ASC_CR
9827: htasc "SEARCHING " ; used when loading, and zNSGFLG.7 is set
9828:
9829: StrFor:
9830: htasc "FOR " ; used when loading with a file name, and zNSGFLG.7 is set
9831:
9832: StrPlay:
9833:
9834: .ifdef JIFFY
9835:
9836: StrRecPlay = $F0EB
9837:
9838: JDLF0D8:
9839: lda #$00
9840: sta VIC + VICII_O_SprEnable
9841: @JDLF0DD:
9842: adc #$01
9843: bne @JDLF0DD
9844: rts
9845:
9846: JDLF0E2:
9847: lda zPTR2
9848: JDLF0E4:
9849: pha
9850: jsr kCLRCHN
9851: pla
9852: tax
9853: jmp kCHKIN
9854:
9855: JDLF0ED:
9856: lda #$00
9857: sta zTSFCNT
9858: jmp IecDataClear
9859:
9860: JDLF0F4:
9861: txa
9862: pha
9863: jsr JDLF7A2
9864: pla
9865: tax
9866: @JDLF0FB:
9867: lda JDLF398,x
9868: jsr kCHROUT
9869: inx
9870: dey
9871: bne @JDLF0FB
9872: rts
9873:
9874: .else
9875:
9876: .if CompileComputer = C64_SX64
9877:
9878: ; the SX64 does not have a tape, thus, "PRESS PLAY ON TAPE" is not needed there
9879: ; However, it redefines the Shift+Run/STOP message. This alternative message
9880: ; can be found here:
9881:
9882: TEXT_LOAD_8_RUN:
9883: .byte "LOAD",'"',":*",'"',",8",ASC_CR
9884: .byte "RUN",ASC_CR
9885: END_TEXT_LOAD_8_RUN:
9886:
9887: .else
9888: .byte ASC_CR,"PRESS PLAY ON " ; used when loading from tape (on the 4064, zNSGFLG.7 has to be set, too)
9889: .endif
9890: htasc "TAPE" ; remaining part of the "PRESS PLAY ON TAPE" message
9891:
9892: StrRecPlay:
9893: htasc "PRESS RECORD & PLAY ON TAPE" ; used when storing to tape (on the 4064, zNSGFLG.7 has to be set, too)
9894:
9895: .endif
9896:
9897: StrLoading:
9898: .byte ASC_CR
9899: htasc "LOADING" ; used when KERNAL LOAD is executed, and zNSGFLG.7 is set
9900:
9901: StrSaving:
9902: .byte ASC_CR
9903: htasc "SAVING " ; used when KERNAL SAVE is executed, and zNSGFLG.7 is set
9904:
9905: StrVerifying:
9906: .byte ASC_CR
9907: htasc "VERIFYING" ; used when KERNAL VERIFY is executed, and zNSGFLG.7 is set
9908:
9909: StrFound:
9910: .byte ASC_CR
9911: htasc "FOUND " ; used when loading from tape
9912: StrOk:
9913: .byte ASC_CR,"OK",ASC_CR + $80 ; used when loading from or storing to tape (on the 4064, zNSGFLG.7 has to be set, too)
9914:
9915:
9916: OutputMessageIfAllowed:
9917: bit zNSGFLG ; check KERNAL output policy
9918: bpl OutputMessage_ClcRts ; bit 7 unset -> policy forbids output -> branch, all done
9919:
9920: OutputMessage:
9921: lda LMESSAGES,y ; get character from message
9922: php ; remember status (especially N, which represents bit 7 of the message)
9923:
9924: and #$7F ; delete bit 7 (which acts as an end marker)
9925: jsr kCHROUT ; output the character
9926: iny ; proceed to next character
9927:
9928: plp ; get back N as indicator for bit 7 of the message
9929: bpl OutputMessage ; bit 7 was not set -> process to next character
9930:
9931: OutputMessage_ClcRts:
9932: clc ; mark: no error
9933: rts
9934: ; -------------------
9935: ; .include "../kernal/fileio.a65"
9936: ; B-11. Function Name: GETIN
9937: ;
9938: ;
9939: ; Purpose: Get a character
9940: ; Call address: $FFE4 (hex) 65508 (decimal)
9941: ; Communication registers: A
9942: ; Preparatory routines: CHKIN, OPEN
9943: ; Error returns: See READST
9944: ; Stack requirements: 7+
9945: ; Registers affected: A (X, Y)
9946: ;
9947: ; Description: If the channel is the keyboard, this subroutine removes
9948: ; one character from the keyboard queue and returns it as an ASCII value in
9949: ; the accumulator. If the queue is empty, the value returned in the
9950: ; accumulator will be zero. Characters are put into the queue automatically
9951: ; by an interrupt driven keyboard scan routine which calls the SCNKEY
9952: ; routine. The keyboard buffer can hold up to ten characters. After the
9953: ; buffer is filled, additional characters are ignored until at least one
9954: ; character has been removed from the queue. If the channel is RS-232, then
9955: ; only the A register is used and a single character is returned. See
9956: ; READST to check validity. If the channel is serial, cassette, or screen,
9957: ; call BASIN routine.
9958: ;
9959: ;
9960: ; How to Use:
9961: ;
9962: ; 1) Call this routine using a JSR instruction.
9963: ; 2) Check for a zero in the accumulator (empty buffer).
9964: ; 3) Process the data.
9965: ;
9966: ;
9967: ; EXAMPLE:
9968: ;
9969: ; ;WAIT FOR A CHARACTER
9970: ; WAIT JSR GETIN
9971: ; CMP #0
9972: ; BEQ WAIT
9973: ;
9974:
9975: KGETIN:
9976: lda zDFLTN ; get device address
9977: bne @NoKeyboard ; != 0 --> not the keyboard
9978: lda zNDX ; are there characters in the key buffer?
9979: beq ClcRts1 ; no, next test
9980: sei ; protect the keyboard buffer
9981: jmp GETIN_KEYB ; get key from keyboard buffer
9982:
9983: @NoKeyboard:
9984: cmp #FILE_RS232 ; device address = RS232 device?
9985: bne LF166 ; no, next test
9986:
9987: KGETIN_RS232:
9988: sty zTEMPX ; save Y in order to leave it unchanged
9989: jsr RS232_GETCHAR ; get a character from RS232
9990: ldy zTEMPX ; restore Y
9991:
9992: .if CompileComputer >= C64_GENERAL
9993: ClcRts1:
9994: .endif
9995:
9996: clc
9997: rts
9998:
9999: ; B-4. Function Name: CHRIN a.k.a. BASIN
10000: ;
10001: ; Purpose: Get a character from the input channel
10002: ; Call address: $FFCF (hex) 65487 (decimal)
10003: ; Communication registers: A
10004: ; Preparatory routines: (OPEN, CHKIN)
10005: ; Error returns: 0 (See READST)
10006: ; Stack requirements: 7+
10007: ; Registers affected: A, X
10008: ;
10009: ; Description: This routine gets a byte of data from a channel already
10010: ; set up as the input channel by the KERNAL routine CHKIN. If the CHKIN has
10011: ; NOT been used to define another input channel, then all your data is
10012: ; expected from the keyboard. The data byte is returned in the accumulator.
10013: ; The channel remains open after the call.
10014: ; Input from the keyboard is handled in a special way. First, the cursor
10015: ; is turned on, and blinks until a carriage return is typed on the
10016: ; keyboard. All characters on the line (up to 88 characters) are stored in
10017: ; the BASIC input buffer. These characters can be retrieved one at a time
10018: ; by calling this routine once for each character. When the carriage return
10019: ; is retrieved, the entire line has been processed. The next time this
10020: ; routine is called, the whole process begins again, i.e., by flashing the
10021: ; cursor.
10022: ;
10023: ; How to Use:
10024: ;
10025: ; FROM THE KEYBOARD
10026: ;
10027: ; 1) Retrieve a byte of data by calling this routine.
10028: ; 2) Store the data byte.
10029: ; 3) Check if it is the last data byte (is it a CR?)
10030: ; 4) If not, go to step 1.
10031: ;
10032: ; EXAMPLE:
10033: ;
10034: ; LDY $#00 ;PREPARE THE Y REGISTER TO STORE THE DATA
10035: ; RD JSR CHRIN
10036: ; STA DATA,Y ;STORE THE YTH DATA BYTE IN THE YTH
10037: ; ;LOCATION IN THE DATA AREA.
10038: ; INY
10039: ; CMP #CR ;IS IT A CARRIAGE RETURN?
10040: ; BNE RD ;NO, GET ANOTHER DATA BYTE
10041: ;
10042: ;
10043: ;
10044: ; EXAMPLE:
10045: ;
10046: ; JSR CHRIN
10047: ; STA DATA
10048: ;
10049: ; FROM OTHER DEVICES
10050: ;
10051: ; 0) Use the KERNAL OPEN and CHKIN routines.
10052: ; 1) Call this routine (using a JSR instruction).
10053: ; 2) Store the data.
10054: ;
10055: ; EXAMPLE:
10056: ;
10057: ; JSR CHRIN
10058: ; STA DATA
10059: ;
10060: ;
10061: KBASIN:
10062: lda zDFLTN ; get device address
10063: .ifdef JIFFY
10064: bne JDLF1A9
10065: .else
10066: bne LF166 ; not keyboard --> jump
10067: .endif
10068:
10069: ; TODO
10070: lda zPNTR ; remember zPNTR (current column on screen) in zTEMP_zPNTR
10071: sta zTEMP_zPNTR ; for later restoration
10072:
10073: lda zTBLX ; remember zTBLX (current row on screen) in zLXSP
10074: sta zLXSP
10075:
10076: jmp BASIN_KEYB ; input character from the screen
10077: ; ---------------------
10078:
10079: LF166: cmp #FILE_SCREEN ; device address == screen?
10080: bne KBASIN_NoScreen ; no, next test
10081:
10082: ; TODO
10083: JDLF16A:
10084: sta zCRSW ; zCRSW := 3 --> mark that we do not wait for key pressed until CR has been pressed
10085:
10086: lda zLNMX ; logical line length of the current line
10087: sta zINDX ; is the number of characters in this line
10088:
10089: jmp BASIN_KEYB ; input character from the screen
10090: ; ---------------------
10091:
10092: KBASIN_NoScreen:
10093: bcs KBASIN_TestIec ; greater than screen (that is, IEC bus) --> jump
10094: cmp #FILE_RS232 ; is it from RS232?
10095: beq BASIN_RS232 ; Yes, process RS232
10096:
10097: .ifdef JIFFY
10098: JDLF179:
10099: jsr JDLFBAA
10100: pha
10101: bit zTSFCNT
10102: bvc LF19C
10103: cpx #$00
10104: bne LF187
10105: lda $C4
10106: LF187: cmp #$04
10107: bcc LF19C
10108: ldy #$00
10109: lda (zFNADR),y
10110: cmp #$24
10111: beq LF19C
10112: inc zSA
10113: jsr JDLF38B
10114: dec zSA
10115: asl zTSFCNT
10116: LF19C: pla
10117: rts
10118: LF19E: lda #$10
10119: jmp SetStatus
10120:
10121: LF1A3: .addr PatchErrorOut
10122: .addr IMAIN
10123: .addr LA57C
10124:
10125: JDLF1A9:
10126: cmp #$04
10127: bcc LF166
10128:
10129: .else
10130: ; if we are here, we want to get input from TAPE
10131:
10132: stx zTEMPX ; remember X
10133: jsr @GetNextTapeCharacterFromBuffer ; read in the next character from the tape buffer
10134: bcs @Ret_No_PLA ; if an error occurred, stop here
10135:
10136: ; Find out if we can read even one more character, and that character is not 0.
10137: ; Note that we only test for it. The value will be disregarded, and the tape buffer pointer
10138: ; will be set backwards afterwards!
10139:
10140: pha ; remember the read character
10141: jsr @GetNextTapeCharacterFromBuffer ; read in the next character from the tape buffer
10142: bcs @Ret_With_PLA ; if an error occurred, stop here, making sure to PLA the remembered character
10143:
10144: bne @NoNulCharacter ; no NUL ($00) character -> branch, skip setting the status flag
10145:
10146: ; mark an end-of-file status
10147: lda #STATUS_TAPE_EOF
10148: jsr SetStatus
10149:
10150: @NoNulCharacter:
10151: dec zBUFPNT ; put tape buffer pointer backwards, so we will read the same byte again in the next call
10152:
10153: ldx zTEMPX ; get back (remembered) X
10154: pla ; get back remembered character
10155: rts
10156: ; ----------------------
10157:
10158: @Ret_With_PLA:
10159: tax
10160: pla
10161: txa
10162:
10163: @Ret_No_PLA:
10164: ldx zTEMPX ; get back (remembered) X
10165: rts
10166: ; ----------------------
10167:
10168: @GetNextTapeCharacterFromBuffer:
10169: jsr TAPE_INCREMENT_WRITE_POINTER ; increment the pointer into the tape buffer
10170: bne @ReadTapeBuffer ; Z = 0 --> there are still bytes to read --> branch, read bytes
10171:
10172: ; we must read in the next tape buffer from tape
10173:
10174: jsr TapeReadNextBuffer ; read in the next tape buffer
10175: bcs BASIN_RTS1 ; C = 1 --> an error occurred -> branch, return with C = 1 indicating an error
10176:
10177: lda #0 ; set tape buffer pointer to 0 (will be incremented directly afterwards)
10178: sta zBUFPNT ; this ensures we skip the tape buffer type marker at position 0.
10179:
10180: beq @GetNextTapeCharacterFromBuffer ; (uncond. branch) retry reading the tape buffer
10181: ; ------------------
10182:
10183: @ReadTapeBuffer:
10184: lda (zTAPE1),y
10185: clc
10186: rts
10187: .endif
10188:
10189: KBASIN_TestIec:
10190: ; Input from IEC bus
10191: lda zSTATUS ; current status
10192: beq BASIN_IEC ; == 0 --> jump, get byte from IEC bus
10193:
10194: ReturnCR:
10195: lda #ASC_CR ; an error or EOI occurred on the IEC bus, return CR
10196:
10197: .if CompileComputer < C64_GENERAL
10198: ClcRts1:
10199: .endif
10200: ClcRts2:
10201: clc
10202: .if CompileComputer >= C64_GENERAL
10203: BASIN_RTS2:
10204: .endif
10205: BASIN_RTS1:
10206: rts
10207:
10208: BASIN_IEC:
10209: .ifdef JIFFY
10210: jmp JDLFBAA
10211: .else
10212: jmp iACPTR
10213: .endif
10214:
10215: BASIN_RS232:
10216: ; get data from RS232
10217: jsr KGETIN_RS232 ; get character from RS232, or 0 if empty
10218: bcs BASIN_RTS2
10219:
10220: cmp #0 ; did we read a 0 (buffer empty)?
10221:
10222: .if CompileComputer >= C64_GENERAL
10223: bne ClcRts2 ; no -> return with the current character
10224:
10225: lda lRSSTAT ; check lRSSTAT (TODO)
10226: and #$60 ; TODO: Meaning of the bits?
10227: bne ReturnCR ; bits are not null -> return with ASCII CR instead of waiting
10228: beq BASIN_RS232 ; wait until there is a character received from RS232
10229: ; -------------------
10230: .else
10231: beq BASIN_RS232 ; yes, wait until there is a character received from RS232
10232: clc ; return: No error
10233:
10234: BASIN_RTS2:
10235: rts
10236: ; --------------------
10237: .endif
10238: ; --------------------
10239:
10240: ; B-5. Function Name: CHROUT a.k.a. BSOUT
10241: ;
10242: ; Purpose: Output a character
10243: ; Call address: $FFD2 (hex) 65490 (decimal)
10244: ; Communication registers: A
10245: ; Preparatory routines: (CHKOUT,OPEN)
10246: ; Error returns: 0 (See READST)
10247: ; Stack requirements: 8+
10248: ; Registers affected: A
10249: ;
10250: ; Description: This routine outputs a character to an already opened
10251: ; channel. Use the KERNAL OPEN and CHKOUT routines to set up the output
10252: ; channel before calling this routine, If this call is omitted, data is
10253: ; sent to the default output device (number 3, the screen). The data byte
10254: ; to be output is loaded into the accumulator, and this routine is called.
10255: ; The data is then sent to the specified output device. The channel is left
10256: ; open after the call.
10257: ;
10258: ; +-----------------------------------------------------------------------+
10259: ; | NOTE: Care must be taken when using this routine to send data to a |
10260: ; | specific serial device since data will be sent to all open output |
10261: ; | channels on the bus. Unless this is desired, all open output channels |
10262: ; | on the serial bus other than the intended destination channel must be |
10263: ; | closed by a call to the KERNAL CLRCHN routine. |
10264: ; +-----------------------------------------------------------------------+
10265: ;
10266: ;
10267: ;
10268: ; How to Use:
10269: ;
10270: ; 0) Use the CHKOUT KERNAL routine if needed, (see description above).
10271: ; 1) Load the data to be output into the accumulator.
10272: ; 2) Call this routine.
10273: ;
10274: ; EXAMPLE:
10275: ;
10276: ; ;DUPLICATE THE BASIC INSTRUCTION CMD 4,"A";
10277: ; LDX #4 ;LOGICAL FILE #4
10278: ; JSR CHKOUT ;OPEN CHANNEL OUT
10279: ; LDA #'A
10280: ; JSR CHROUT ;SEND CHARACTER
10281: ;
10282: ;
10283: KBSOUT:
10284: pha ; remember character to be output
10285: lda zDFLTO ; get output device
10286: cmp #FILE_SCREEN ; is it the screen?
10287: bne @NoScreen ; no -> jump, test other devices
10288: pla ; get back the character to be output
10289: jmp CHROUT_SCREEN ; output to screen
10290: ; ----------------------
10291:
10292: @NoScreen:
10293: bcc @NoIec ; device number is less than (or equal, but this cannot be here) than screen (3) -> jump, output is not on the IEC bus
10294: pla ; get back the character to be output
10295: jmp iCIOUT ; output character to the IEC bus
10296:
10297: @NoIec:
10298: .if CompileComputer >= C64_GENERAL
10299: ; here, A can only contain 0, 1 or 2. "1" is tape, "2" is RS232.
10300: ; TODO: Can it contain 0 at all?
10301:
10302: lsr a ; prepare comparison with RS232 device
10303: ; if C == 1, than output is to tape. If C == 0, then output is to console (0 - TODO) or RS232 (2).
10304:
10305: .else
10306: cmp #FILE_RS232 ; output device = RS232?
10307: beq KBSOUT_RS232 ; yes -> jump, output to RS232
10308: .endif
10309:
10310: pla ; get back the character to be output
10311:
10312: KBSOUT_TAPE:
10313:
10314: sta zPTR1 ; remember character to be output
10315:
10316: .if CompileComputer < C64_GENERAL
10317: pha ; remember character to be output on stack
10318: .endif
10319: txa ; remember X
10320: pha ; on stack
10321: tya ; remember Y
10322: pha ; on stack
10323:
10324: .if CompileComputer >= C64_GENERAL
10325: bcc KBSOUT_RS232 ; we want to output onto RS232 (TODO: Or console (0)?) --> jump
10326: .endif
10327:
10328: ; if we reached here, it is BSOUT on tape
10329:
10330: .ifdef JIFFY
10331: jmp JDLF3F1
10332:
10333: JDLF1E8:
10334: jsr JDLF8BF
10335: jsr JDLE4C6
10336: cmp #$30
10337: rts
10338: jsr bGTBYTC
10339: stx zFA
10340: jsr JDLF75C
10341: stx zFSBLK
10342: rts
10343:
10344: .else
10345: jsr TAPE_INCREMENT_WRITE_POINTER ; increment pointer into tape buffer, and return it in Y
10346: bne @BufferNotYetFull ; buffer not yet full -> jump
10347:
10348: ; the tape buffer is full, write out the buffer and create a new one
10349: ;
10350: jsr TapeWriteCompleteBuffer ; write out the tape buffer to tape
10351: bcs BSOUT_Quit ; C = 1 -> error -> quit
10352:
10353: lda #TAPE_BUFFER_TYPE_CONTINUATION ; mark the buffer: It is a continuation buffer
10354: ldy #TAPE_BUFFER_OFFSET_TYPE ; new pointer into the tape buffer
10355: sta (zTAPE1),y ; store the mark for the buffer that it is a continuation buffer
10356: iny ; advance buffer pointer
10357: sty zBUFPNT ; and remember it
10358:
10359: @BufferNotYetFull:
10360: lda zPTR1 ; get character to be output
10361: sta (zTAPE1),y ; put it into the tape buffer
10362:
10363: .endif
10364:
10365: BSOUT_QuitSuccess:
10366: clc ; mark: We quit with success
10367:
10368: BSOUT_Quit:
10369: pla ; restore Y from stack
10370: tay
10371: pla ; restore X from stack
10372: tax
10373: .if CompileComputer >= C64_GENERAL
10374: lda zPTR1 ; restore A (character to be output)
10375: .else
10376: pla ; restore A (character to be output) from stack
10377: .endif
10378:
10379: bcc @Rts ; if routine was successfull, skip next instruction
10380: lda #0 ; set error number to 0 (TODO: why 0?)
10381: @Rts: rts
10382:
10383: KBSOUT_RS232:
10384:
10385: .if CompileComputer < C64_GENERAL
10386: pla ; restore A (character to be output) from stack
10387: stx zTEMPX ; remember X
10388: sty zPTR1 ; and Y
10389: .endif
10390:
10391: jsr RS232_PUTCHAR ; put character in A into RS232 output buffer
10392:
10393: .if CompileComputer >= C64_GENERAL
10394: jmp BSOUT_QuitSuccess
10395: ; -----------------------
10396: .else
10397: ldx zTEMPX ; restore X
10398: ldy zPTR1 ; and Y
10399: clc ; mark: success
10400: rts
10401: ; -----------------------
10402: .endif
10403: ; -----------------------
10404:
10405: ; B-2. Function Name: CHKIN
10406: ;
10407: ; Purpose: Open a channel for input
10408: ; Call address: $FFC6 (hex) 65478 (decimal)
10409: ; Communication registers: X
10410: ; Preparatory routines: (OPEN)
10411: ; Error returns:
10412: ; Stack requirements: None
10413: ; Registers affected: A, X
10414: ;
10415: ;
10416: ; Description: Any logical file that has already been opened by the
10417: ; KERNAL OPEN routine can be defined as an input channel by this routine.
10418: ; Naturally, the device on the channel must be an input device. Otherwise
10419: ; an error will occur, and the routine will abort.
10420: ; If you are getting data from anywhere other than the keyboard, this
10421: ; routine must be called before using either the CHRIN or the GETIN KERNAL
10422: ; routines for data input. If you want to use the input from the keyboard,
10423: ; and no other input channels are opened, then the calls to this routine,
10424: ; and to the OPEN routine are not needed.
10425: ; When this routine is used with a device on the serial bus, it auto-
10426: ; matically sends the talk address (and the secondary address if one was
10427: ; specified by the OPEN routine) over the bus.
10428: ;
10429: ; How to Use:
10430: ;
10431: ; 0) OPEN the logical file (if necessary; see description above).
10432: ; 1) Load the X register with number of the logical file to be used.
10433: ; 2) Call this routine (using a JSR command).
10434: ;
10435: ;
10436: ; Possible errors are:
10437: ;
10438: ; #3: File not open
10439: ; #5: Device not present
10440: ; #6: File not an input file
10441: ;
10442: ; EXAMPLE:
10443: ;
10444: ; ;PREPARE FOR INPUT FROM LOGICAL FILE 2
10445: ; LDX #2
10446: ; JSR CHKIN
10447: ;
10448: KCHKIN:
10449: jsr FindFileAndClearStatus ; find index for file no. in X, return in X
10450: beq @Found ; Z=1 -> has been found, branch and process
10451: jmp KErrFileNotOpen ; return with "file not open" error
10452:
10453: @Found:
10454: jsr SetActiveFile ; set the active file to the parameters of the file just found
10455: lda zFA ; get device number (of output file)
10456: beq @SetDefault ; console (0) --> set it, quit with success
10457:
10458: cmp #FILE_SCREEN
10459: beq @SetDefault ; screen (3) --> set it, quit with success
10460:
10461: bcs @Iec ; > 3 ( = some IEC device) -> special processing for IEC device
10462:
10463: cmp #FILE_RS232 ; rs232 (2)?
10464: bne @Tape ; no -> only tape left -> process tapes
10465:
10466: jmp RS232_CHKIN ; special processing for RS232 CHKIN
10467:
10468: ; special processing for TAPE:
10469: ; check if the tape file is opened as input
10470:
10471: @Tape:
10472: ldx zSA ; check secondary address
10473: cpx #$60 ; = $60 (output file)?
10474: beq @SetDefault ; yes, set it as default device
10475: jmp KErrNotInputFile ; return with error: Not Input File
10476:
10477: @SetDefault:
10478: sta zDFLTN ; set default output device
10479: clc ; mark: success
10480: rts
10481: ; -----------------
10482:
10483: ; Special processing for IEC:
10484: ; tell device to talk to use (TALK)
10485:
10486: @Iec:
10487: tax ; remember device address in X
10488: jsr iTALK ; give device in A a TALK command
10489:
10490: lda zSA ; get secondary address
10491: bpl @SecondaryAddress ; In range $00..$7F? -> give secondary address
10492:
10493: jsr iTKSA2 ; no secondary address, but perform talker - listener - exchange
10494: jmp @CheckStatus
10495:
10496: @SecondaryAddress:
10497: jsr iTKSA ; set secondary address after TALK
10498:
10499: @CheckStatus:
10500: txa ; get back device number
10501:
10502: bit zSTATUS ; check status
10503: bpl @SetDefault ; bit 7 (device not present) unset -> success -> set device as default input device
10504:
10505: jmp KErrDeviceNotPresent ; return with error: Device Not Present
10506: ; -----------------------------
10507:
10508: ; B-3. Function Name: CHKOUT
10509: ;
10510: ; Purpose: Open a channel for output
10511: ; Call address: $FFC9 (hex) 65481 (decimal)
10512: ; Communication registers: X
10513: ; Preparatory routines: (OPEN)
10514: ; Error returns: 0,3,5,7 (See READST)
10515: ; Stack requirements: 4+
10516: ; Registers affected: A, X
10517: ;
10518: ; Description: Any logical file number that has been created by the
10519: ; KERNAL routine OPEN can be defined as an output channel. Of course, the
10520: ; device you intend opening a channel to must be an output device.
10521: ; Otherwise an error will occur, and the routine will be aborted.
10522: ; This routine must be called before any data is sent to any output
10523: ; device unless you want to use the Commodore 64 screen as your output
10524: ; device. If screen output is desired, and there are no other output chan-
10525: ; nels already defined, then calls to this routine, and to the OPEN routine
10526: ; are not needed.
10527: ; When used to open a channel to a device on the serial bus, this routine
10528: ; will automatically send the LISTEN address specified by the OPEN routine
10529: ; (and a secondary address if there was one).
10530: ;
10531: ; How to Use:
10532: ; +-----------------------------------------------------------------------+
10533: ; | REMEMBER: this routine is NOT NEEDED to send data to the screen. |
10534: ; +-----------------------------------------------------------------------+
10535: ; 0) Use the KERNAL OPEN routine to specify a logical file number, a
10536: ; LISTEN address, and a secondary address (if needed).
10537: ; 1) Load the X register with the logical file number used in the open
10538: ; statement.
10539: ; 2) Call this routine (by using the JSR instruction).
10540: ;
10541: ; EXAMPLE:
10542: ;
10543: ; LDX #3 ;DEFINE LOGICAL FILE 3 AS AN OUTPUT CHANNEL
10544: ; JSR CHKOUT
10545: ;
10546: ; Possible errors are:
10547: ; #3: File not open
10548: ; #5: Device not present
10549: ; #7: Not an output file
10550: ;
10551: ;
10552: ;
10553: KCHKOUT:
10554: jsr FindFileAndClearStatus ; find index for file no. in X, return in X
10555: beq @Found ; Z=1 -> has been found, branch and process
10556: jmp KErrFileNotOpen ; return with "file not open" error
10557:
10558: @Found:
10559: jsr SetActiveFile ; set the active file to the parameters of the file just found
10560: lda zFA ; get device number (of input file)
10561: bne @NoScreen ; not screen (0) -> check for other devices
10562:
10563:
10564: @NotInputFile:
10565: jmp KErrNotOutputFile ; return with error: Not Output File (screen cannot be output file)
10566:
10567: @NoScreen:
10568: cmp #FILE_SCREEN ; is output file screen (3)?
10569: beq @SetDefault ; yes -> jump, set it as default device
10570:
10571: bcs @Iec ; > 3 ( = some IEC device) -> special processing for IEC device
10572:
10573: cmp #FILE_RS232 ; rs232 (2)?
10574: bne @Tape ; no -> only tape left -> process tapes
10575:
10576: jmp RS232_CHKOUT ; special processing for RS232 CHKIN
10577:
10578: @Tape:
10579: ldx zSA ; check secondary address
10580: cpx #$60 ; = $60 (output file)?
10581: beq @NotInputFile ; yes -> return with error: Not Input File
10582:
10583: @SetDefault:
10584: sta zDFLTO ; set default output device
10585: clc ; mark: success
10586: rts
10587: ; --------------------
10588:
10589: @Iec:
10590: tax ; remember device address in X
10591: jsr iLISTEN ; give device in A a LISTEN command
10592:
10593: lda zSA ; get secondary address
10594: bpl @SecondaryAddress ; In range $00..$7F? -> give secondary address
10595:
10596: jsr IEC_CLR_ATN ; only clear ATN status of IEC device
10597: bne @CheckStatus
10598: ; ----------------------
10599:
10600: @SecondaryAddress:
10601: jsr iSECOND ; set secondary address after LISTEN
10602:
10603: @CheckStatus:
10604: txa ; get back device number
10605:
10606: bit zSTATUS ; check status
10607: bpl @SetDefault ; bit 7 (device not present) unset -> success -> set device as default output device
10608:
10609: jmp KErrDeviceNotPresent ; return with error: Device Not Present
10610: ; -----------------------------
10611:
10