vic20.a65.full.html; generated on Fri Sep 18 21:44:51 2015 by ca65html
uz@cc65.org
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:
10612:
10613: ; B-9. Function Name: CLOSE
10614: ;
10615: ; Purpose: Close a logical file
10616: ; Call address: $FFC3 (hex) 65475 (decimal)
10617: ; Communication registers: A
10618: ; Preparatory routines: None
10619: ; Error returns: 0,240 (See READST)
10620: ; Stack requirements: 2+
10621: ; Registers affected: A, X, Y
10622: ;
10623: ; Description: This routine is used to close a logical file after all I/O
10624: ; operations have been completed on that file. This routine is called after
10625: ; the accumulator is loaded with the logical file number to be closed (the
10626: ; same number used when the file was opened using the OPEN routine).
10627: ;
10628: ;
10629: ;
10630: ;
10631: ;
10632: ;
10633: ; How to Use:
10634: ;
10635: ; 1) Load the accumulator with the number of the logical file to be
10636: ; closed.
10637: ; 2) Call this routine.
10638: ;
10639: ; EXAMPLE:
10640: ;
10641: ; ;CLOSE 15
10642: ; LDA #15
10643: ; JSR CLOSE
10644: ;
10645: KCLOSE:
10646: jsr FindFile ; find index for file no. in A, return in X
10647: beq @DoClose ; z=1 -> file index exists -> branch, close file
10648:
10649: ; if we reach here, the file did not exist
10650: clc ; report success (closing a non-existing file is not an error!)
10651: rts
10652: ; ------------
10653:
10654: @DoClose:
10655: jsr SetActiveFile ; set the active file to the parameters of the file just found
10656:
10657: txa ; put current index into table of open files into A
10658: pha ; and store it on the stack
10659:
10660: lda zFA ; get device address
10661: beq CLOSE_GET_BACK_INDEX_AND_DELETE_FROM_TABLE ; console (0) --> get back index into table and set file parameters into table of open files
10662: cmp #FILE_SCREEN
10663: beq CLOSE_GET_BACK_INDEX_AND_DELETE_FROM_TABLE ; screen (3) --> get back index into table and set file parameters into table of open files
10664:
10665: bcs CLOSE_FILE_ON_IEC ; > 3 (IEC device) --> perform open on IEC
10666:
10667: cmp #FILE_RS232
10668: bne @Tape ; not RS232 (2) --> only TAPE left --> open TAPE
10669:
10670:
10671: ; if we reach here, we want to open a RS232 file
10672:
10673: ; the following 2 instructions could be replaced with jsr CLOSE_GET_BACK_INDEX_AND_DELETE_FROM_TABLE
10674: pla ; get back index into table of open files
10675: jsr CLOSE_DELETE_FROM_TABLE ; set file parameters in table of open files
10676:
10677: .if CompileComputer >= C64_GENERAL
10678: jsr LF483
10679: .else
10680: lda #$7D
10681: sta VIA1_IEC
10682: lda #$06
10683: sta VIA1_PB
10684: lda #$EE
10685: sta VIA1_PCR
10686: .endif
10687:
10688: ; manipulate MEMTOP in order to release the memory of (2*) 256 byte each for
10689: ; the RS232 input and output buffers
10690: ;
10691: jsr iMEMTOP_Get ; get current memory top into (X/Y)
10692: lda zRIBUF + 1 ; current RS232 input ring buffer high address set?
10693: beq :+ ; no, skip, we do not need to free memory for it
10694:
10695: iny ; free memory by incrementing MEMTOP high byte
10696:
10697: :
10698: lda zROBUF + 1 ; current RS232 output ring buffer high address set?
10699: beq :+ ; no, skip, we do not need to free memory for it
10700:
10701: iny ; free memory by incrementing MEMTOP high byte
10702:
10703: :
10704: lda #0 ; in order to mark that they do not exist anymore,
10705: sta zRIBUF + 1 ; clear high bytes of RS232 input buffer
10706: sta zROBUF + 1 ; and rS232 output buffer
10707:
10708: jmp SetMemtop_And_Return_With_F0 ; set memory top and return with error code $F0, which indicates the memory top has been changed
10709: ; --------------
10710:
10711:
10712: ; TODO: Comment tape close routine
10713:
10714: @Tape:
10715: .ifdef JIFFY
10716: pla
10717: jmp KErrIllegalDeviceNumber
10718:
10719: LF2CC: jsr kCLRCHN
10720: LF2CF: lda #$6F
10721: jsr FindFile
10722: bne CLOSE_Rts
10723: jmp JDLF2F3
10724:
10725: LF2D9: stx zFA
10726: LF2DB: tya
10727: pha
10728: jsr JDLF8B2
10729: jsr JDLF7A2
10730: php
10731: jsr LF2CC
10732: plp
10733: pla
10734: tay
10735: ldx zFA
10736: rts
10737: .byte $F2
10738:
10739: .else
10740:
10741: lda zSA ; get secondary address
10742: and #$0F ; (only the lower 4 bit, as the value has been ORed with IEEE_OPEN)
10743: beq CLOSE_GET_BACK_INDEX_AND_DELETE_FROM_TABLE ; == 0 -> tape was opened for read --> branch, we do not need to write out the rest of the tape buffer --> get back index into table and set file parameters into table of open files
10744:
10745: jsr TapeGetPointer ; get pointer to tape buffer into (X/Y) (unused, but flags important)
10746: lda #0
10747:
10748: .if CompileComputer >= C64_GENERAL
10749: sec ; set C = 1 to make sure the output is not send to RS232 in KBSOUT_TAPE!
10750: ; (C=0 would output to RS232 instead; the C64 implementation differs from the VIC20 one in this aspect!)
10751:
10752: .endif
10753:
10754: jsr KBSOUT_TAPE ; output to TAPE
10755:
10756: .if 0
10757: ; this macro is defined in fileio_data.inc
10758:
10759: .macro FILEIO_PATCH_CLOSE_TAPE
10760:
10761: jsr TapeWriteCompleteBuffer ; write out the tape buffer to tape
10762: bcc FileIoPatch_NoError ; C = 0 -> no error -> branch
10763:
10764: pla ; get back index into table of open files
10765: lda #$00
10766:
10767: .endmacro
10768: .endif
10769:
10770: .if CompileComputer >= C64_GENERAL
10771:
10772: FILEIO_PATCH_CLOSE_TAPE
10773:
10774: rts
10775:
10776: FileIoPatch_NoError:
10777:
10778: .elseif CompileComputer = VIC20_02
10779:
10780: jsr TapeWriteCompleteBuffer ; write out the tape buffer to tape
10781: bcs CLOSE_ClcRts ; C = 1 -> error -> quit
10782:
10783: .else
10784: jmp FileIoPatchCloseTape
10785:
10786: FileIoPatchCloseTape_Return:
10787:
10788: bcs CLOSE_Rts ; if error, quit with RTS
10789: ; not needed on C64, as the RTS is directly after the patch there.
10790:
10791: .endif
10792:
10793: lda zSA ; secondary address
10794: cmp #$62 ; $62 (that is, bit 1 set: "Write end-of-tape (EOT) marker"
10795: bne CLOSE_GET_BACK_INDEX_AND_DELETE_FROM_TABLE ; not $62 --> get back index into table and set file parameters into table of open files
10796:
10797: ; Special processing for secondary address $62: Write an end-of-tape marker on the tape
10798:
10799: lda #TAPE_BUFFER_TYPE_EOT ; tape buffer type: END-OF-TAPE (EOT)
10800: jsr TapeCreateFileBuffer ; create the file buffer and write it on tape
10801:
10802: jmp CLOSE_GET_BACK_INDEX_AND_DELETE_FROM_TABLE ; get back index into table and set file parameters into table of open files
10803:
10804: .endif
10805:
10806: CLOSE_FILE_ON_IEC:
10807: jsr IecClose ; if zSA.7 is not set, close the file on the IEC bus.
10808:
10809: CLOSE_GET_BACK_INDEX_AND_DELETE_FROM_TABLE:
10810: pla ; get back index into table of open files
10811:
10812: CLOSE_DELETE_FROM_TABLE:
10813: tax ; X := index of entry to close
10814:
10815: JDLF2F3:
10816: dec zLDTND ; decrement number of entries in table of open files
10817:
10818: cpx zLDTND ; have we found 0 open files?
10819: beq CLOSE_ClcRts ; yes, nothing to do
10820:
10821: ; replace entry to be closed with last entry in table
10822: ldy zLDTND ; get index of last entry
10823:
10824: lda lLAT,y ; replace logical file number (LA)
10825: sta lLAT,x
10826: lda lFAT,y ; replace device address (FA)
10827: sta lFAT,x
10828: lda lSAT,y ; replace secondary address (SA)
10829: sta lSAT,x
10830:
10831: CLOSE_ClcRts:
10832: clc ; mark: success
10833: CLOSE_Rts:
10834: rts
10835: ; ------------
10836:
10837:
10838: ; Clear status and perform FindFile afterwards
10839: ;
10840: ; Input: X := file no
10841: ; Output: X := index into the tables (>= 0), or $FF if not found
10842: ; Z = 1, N = 0 if index found,
10843: ; Z = 0, N = 1 otherwise
10844: ; Uses: X, A
10845: ;
10846: ; This function is often followed by a call to SetActiveFile
10847: ; to get the data of lLAT, lFAT and lSAT into zLA, zFA and zSA.
10848: ;
10849: ; Note that register inputs differ from FindFile!
10850: ;
10851: FindFileAndClearStatus:
10852: lda #0
10853: sta zSTATUS
10854: txa
10855:
10856: ; Find the index into the lLAT, lFAT and lSAT tables
10857: ; for a specific file number.
10858: ;
10859: ; That is, if a file is opened with (BASIC)
10860: ; open 1,2,3
10861: ; then find the index into these tables for the given "1".
10862: ;
10863: ; Input: A := file no
10864: ; Output: X := index into the tables (>= 0), or $FF if not found
10865: ; Z = 1, N = 0 if index found,
10866: ; Z = 0, N = 1 otherwise
10867: ; Uses: X
10868: ;
10869: ; This function is often followed by a call to SetActiveFile
10870: ; to get the data of lLAT, lFAT and lSAT into zLA, zFA and zSA.
10871: ;
10872: FindFile:
10873: ldx zLDTND ; get number of entries in the table
10874: @Next: dex
10875: bmi FindFileRts ; all searched? Then quit
10876: cmp lLAT,x ; is this the right file no?
10877: bne @Next ; no -> branch, try the next index
10878: rts
10879: ; --------------------
10880:
10881:
10882: ; Set the file parameters (zLA, zFA and zSA) for a given file
10883: ;
10884: ; Input: X := index into the tables lLAT, lFAT and LSAT, as returned by
10885: ; FindFile or FindFileAndClearStatus
10886: ; Output:
10887: ; Z = 1, N = 0 if index found,
10888: ; Z = 0, N = 1 otherwise
10889: ; Uses: A
10890: ;
10891: SetActiveFile:
10892: lda lLAT,x ; get file no from table
10893: sta zLA ; into current value
10894:
10895: lda lFAT,x ; get device number from table
10896: sta zFA ; into current value
10897:
10898: lda lSAT,x ; get secondary address from table
10899: sta zSA ; into current value
10900:
10901: FindFileRts:
10902: rts
10903: ; ---------------------
10904:
10905: ; B-8. Function Name: CLALL
10906: ;
10907: ; Purpose: Close all files
10908: ; Call address: $FFE7 (hex) 65511 (decimal)
10909: ; Communication registers: None
10910: ; Preparatory routines: None
10911: ; Error returns: None
10912: ; Stack requirements: 11
10913: ; Registers affected: A, X
10914: ;
10915: ; Description: This routine closes all open files. When this routine is
10916: ; called, the pointers into the open file table are reset, closing all
10917: ; files. Also, the CLRCHN routine is automatically called to reset the I/O
10918: ; channels.
10919: ;
10920: ; How to Use:
10921: ;
10922: ; 1) Call this routine.
10923: ;
10924: ; EXAMPLE:
10925: ;
10926: ; JSR CLALL ;CLOSE ALL FILES AND SELECT DEFAULT I/O CHANNELS
10927: ; JMP RUN ;BEGIN EXECUTION
10928: ;
10929: ;
10930: KCLALL:
10931: lda #$00
10932: sta zLDTND ; set number of open files to 0
10933:
10934: ; "fall through" to CLRCHN
10935:
10936: ; B-10. Function Name: CLRCHN a.k.a. CLRCH
10937: ;
10938: ; Purpose: Clear I/O channels
10939: ; Call address: $FFCC (hex) 65484 (decimal)
10940: ; Communication registers: None
10941: ; Preparatory routines: None
10942: ; Error returns:
10943: ; Stack requirements: 9
10944: ; Registers affected: A, X
10945: ;
10946: ; Description: This routine is called to clear all open channels and re-
10947: ; store the I/O channels to their original default values. It is usually
10948: ; called after opening other I/O channels (like a tape or disk drive) and
10949: ; using them for input/output operations. The default input device is 0
10950: ; (keyboard). The default output device is 3 (the Commodore 64 screen).
10951: ; If one of the channels to be closed is to the serial port, an UNTALK
10952: ; signal is sent first to clear the input channel or an UNLISTEN is sent to
10953: ; clear the output channel. By not calling this routine (and leaving lis-
10954: ; tener(s) active on the serial bus) several devices can receive the same
10955: ; data from the Commodore 64 at the same time. One way to take advantage
10956: ; of this would be to command the printer to TALK and the disk to LISTEN.
10957: ; This would allow direct printing of a disk file.
10958: ; This routine is automatically called when the KERNAL CLALL routine is
10959: ; executed.
10960: ;
10961: ; How to Use:
10962: ; 1) Call this routine using the JSR instruction.
10963: ;
10964: ; EXAMPLE:
10965: ; JSR CLRCHN
10966: ;
10967: KCLRCH:
10968: ldx #FILE_SCREEN ; device address for screen (3)
10969:
10970: cpx zDFLTO ; compare current default output device to 3?
10971: bcs :+ ; <= 3, skip next step
10972:
10973: jsr iUNLSN ; send UNLISTEN on IEC bus
10974:
10975: : cpx zDFLTN ; compare current default input device to 3?
10976: bcs :+ ; <= 3, skip next step
10977:
10978: jsr iUNTLK ; send UNTALK on IEC bus
10979:
10980: : stx zDFLTO ; set default output device to screen
10981:
10982: lda #FILE_KEYBOARD
10983: sta zDFLTN ; set default input device to keyboard
10984: rts
10985: ; ---------------
10986:
10987: ; B-18. Function Name: OPEN
10988: ;
10989: ;
10990: ; Purpose: Open a logical file
10991: ; Call address: $FFC0 (hex) 65472 (decimal)
10992: ; Communication registers: None
10993: ; Preparatory routines: SETLFS, SETNAM
10994: ; Error returns: 1,2,4,5,6,240, READST
10995: ; Stack requirements: None
10996: ; Registers affected: A, X, Y
10997: ;
10998: ; Description: This routine is used to OPEN a logical file. Once the
10999: ; logical file is set up, it can be used for input/output operations. Most
11000: ; of the I/O KERNAL routines call on this routine to create the logical
11001: ; files to operate on. No arguments need to be set up to use this routine,
11002: ; but both the SETLFS and SETNAM KERNAL routines must be called before
11003: ; using this routine.
11004: ;
11005: ;
11006: ; How to Use:
11007: ;
11008: ; 0) Use the SETLFS routine.
11009: ; 1) Use the SETNAM routine.
11010: ; 2) Call this routine.
11011: ;
11012: ; EXAMPLE:
11013: ;
11014: ; This is an implementation of the BASIC statement: OPEN 15,8,15,"I/O"
11015: ;
11016: ;
11017: ; LDA #NAME2-NAME ;LENGTH OF FILE NAME FOR SETLFS
11018: ; LDY #>NAME ;ADDRESS OF FILE NAME
11019: ; LDX #<NAME
11020: ; JSR SETNAM
11021: ; LDA #15
11022: ; LDX #8
11023: ; LDY #15
11024: ; JSR SETLFS
11025: ; JSR OPEN
11026: ; NAME .BYT 'I/O'
11027: ; NAME2
11028: ;
11029:
11030: KOPEN:
11031: ldx zLA ; logical address of file to open
11032: bne :+ ; not 0 -> ok, can be opened
11033: jmp KErrNotInputFile ; return with error: "Not Input File"
11034: ; ---------------------
11035:
11036: : jsr FindFileAndClearStatus ; find index for file no. in X
11037: bne :+ ; Z=0 -> file does not exist yet -> branch -> process this open
11038: jmp KErrFileOpen ; return with "file open" error
11039:
11040: : ldx zLDTND ; get number of open files
11041: cpx #lLAT_Size ; limit not yet reached?
11042: bcc :+ ; no -> continue
11043: jmp KErrTooManyOpenFiles ; return with error: "Too many files error"
11044:
11045: : inc zLDTND ; increment number of open files
11046:
11047: lda zLA ; store logical file number
11048: sta lLAT,x ; in table
11049:
11050: lda zSA ; modify secondary address
11051: ora #IEEE_OPEN ; to mean "for OPEN" on the IEC Bus
11052: sta zSA ; store it back
11053: sta lSAT,x ; and in the table
11054:
11055: lda zFA ; store device (primary) address
11056: sta lFAT,x ; in table
11057:
11058: beq KOPEN_ClcRts ; open of the keyboard -> branch -> quit function with success, nothing else to do
11059:
11060: cmp #FILE_SCREEN
11061: beq KOPEN_ClcRts ; open of the screen -> branch -> quit function with success, nothing else to do
11062:
11063: bcc @NoIec ; open of something else but IEC (tape, rs232) -> test for it
11064:
11065: jsr KOPEN_IEC ; open the IEC file
11066: bcc KOPEN_ClcRts ; if we succeeded in opening the IEC file, succeed this call, too
11067:
11068: ; TODO: what if KOPEN_IEC (calling iUNLSN as last command) ended with C=1? Is this a BUG?
11069:
11070: @NoIec:
11071:
11072: .ifdef JIFFY
11073: cmp #$01
11074: beq JDLF3F3
11075: jmp OPEN_RS232
11076:
11077: JDLF38B:
11078: jsr kUNTLK
11079: lda zFA
11080: jsr kTALK
11081: lda zSA
11082: jmp kTKSA
11083:
11084: JDLF398:
11085: ; @@@todo some table?
11086:
11087: eor $572D
11088: brk
11089: asl $1C
11090: lda $0261
11091: sta zCHARAC
11092: lda #$12
11093: sta $06
11094: ldx #$00
11095: stx zROBUF
11096: jsr $D586
11097: ldy $0267
11098: lda ($30),y
11099: eor #$40
11100: sta ($30),y
11101: jmp $D58A
11102: eor $452D
11103: brk
11104: asl zOPMASK
11105: and $6A57
11106: brk
11107: ora (zOPMASK,x)
11108: and $6957
11109: brk
11110: ora ($50,x)
11111: ror a:zR6510
11112: .byte $53
11113: .byte $3A
11114:
11115: .else
11116: cmp #FILE_RS232 ; is it an RS232 device?
11117:
11118: .if CompileComputer = C64_SX64
11119: bne @ErrIllegalDeviceNumber ; no -> tape -> the SX64 does not have a tape -> report an error
11120: .else
11121: bne @Tape ; no -> tape -> process opening a tape file
11122: .endif
11123: jmp OPEN_RS232 ; open the RS232 device
11124: ; ------------------
11125:
11126: ; TODO: Document
11127:
11128: @Tape:
11129: jsr TapeGetPointer ; get pointer to tape buffer into (X/Y) (unused, but flags important)
11130: bcs @TapeAllowed ; C = 1 -> tape buffer does NOT point to stack page or zero page -> proceed, we do not overwrite essential data!
11131:
11132: @ErrIllegalDeviceNumber:
11133: jmp KErrIllegalDeviceNumber
11134:
11135: @TapeAllowed:
11136: lda zSA ; check secondary address of the file
11137: and #$0F ; (only the lower 4 bit, as the value has been ORed with IEEE_OPEN)
11138: bne KLOAD_OpenTapeForWrite ; anything but 0 means: WRITE. Thus, branch if we have a write operation
11139:
11140: ; Open the tape for a read operation
11141:
11142: jsr TapePressPlayOnTape ; output "PRESS PLAY ON TAPE" and wait for PLAY to be pressd
11143: bcs KOPEN_Rts ; C=1 -> an error occurred (i.e., STOP was pressed) -> branch, abort
11144:
11145: jsr OutputSearchingFor ; output the text "SEARCHING" or "SEARCHING FOR <filename>"
11146:
11147: lda zFNLEN ; test file name length
11148: beq KLOAD_NoFilenameGiven ; == 0 -> no file name given -> branch, skip finding the right file
11149:
11150: ; try to find the specified file
11151:
11152: jsr TapeFindSpecificFile ; try to find the specified file
11153: bcc KLOAD_PrepareTapeBuffer ; C = 0 -> no error occurred -> branch, proceed with operation
11154:
11155: beq KOPEN_Rts ; Z = 1 --> EOT was found, abort (TODO can this branch happen actually?)
11156:
11157: KLOAD_ErrFileNotFound:
11158: jmp KErrFileNotFound ; return with FILE NOT FOUND error
11159: ; ------------------------
11160:
11161:
11162: KLOAD_NoFilenameGiven:
11163: ; there was no file name given, just search for any file
11164:
11165: jsr TapeReadTapeHeaderOfNextFile ; try to find ANY file header
11166: beq KOPEN_Rts ; TODO what?
11167: bcc KLOAD_PrepareTapeBuffer ; C = 0 --> no error occurred -> branch, proceed with operation
11168:
11169: bcs KLOAD_ErrFileNotFound ; (uncond. branch) return with FILE NOT FOUND error
11170: ; ---------------------------
11171:
11172: KLOAD_OpenTapeForWrite:
11173: jsr TapePressRecordAndPlayOnTape ; output "PRESS RECORD + PLAY ON TAPE" and wait for PLAY to be pressd
11174: bcs KOPEN_Rts ; C=1 -> an error occurred (i.e., STOP was pressed) -> branch, abort
11175:
11176: lda #TAPE_BUFFER_TYPE_DATA ; tape buffer type: a data file
11177: jsr TapeCreateFileBuffer ; create the file buffer (including start and end address and file name) and write it on tape
11178:
11179: KLOAD_PrepareTapeBuffer:
11180: ; depending upon if the tape file is opened for read or write, the tape
11181: ; buffer has to be prepared differently.
11182: ;
11183: ; For reading, the tape buffer pointer has to point to the last address (lTBUFFR_SIZE - 1)
11184: ; in order to generate an overflow on the first call to read a character.
11185: ; The buffer itself does not need to be changed.
11186: ;
11187: ; For writing, however, the pointer must be set to the beginning of the buffer,
11188: ; and the beginning must be initialized to "2" (TODO: List of values with defines).
11189: ;
11190: lda #lTBUFFR_SIZE - 1 ; assumed value for the tape buffer pointer: Assume reading of the tape
11191:
11192: ldy zSA ; check secondary address
11193: cpy #$60 ; is it 0 ( | IEEE_OPEN)?
11194: beq @NoWrite ; yes -> branch, we want to read the tape
11195:
11196: ; process tape buffer for writing:
11197:
11198: ldy #0 ; index into tape buffer = 0 (start at the beginning)
11199: lda #TAPE_BUFFER_TYPE_CONTINUATION
11200: sta (zTAPE1),y ; mark the block as continuation buffer
11201:
11202: tya ; set tape buffer pointer to 0
11203:
11204: .endif
11205:
11206: @NoWrite:
11207: sta zBUFPNT ; and store it.
11208:
11209: .if CompileComputer >= C64_GENERAL
11210: KOPEN_ClcRts2:
11211: .endif
11212:
11213: KOPEN_ClcRts:
11214: clc
11215:
11216: KOPEN_Rts:
11217: rts
11218: ; -------------------------------
11219:
11220:
11221:
11222: ; Remark:
11223: ; In case the device does not exist, thus function will not return to the caller,
11224: ; but to the caller of the caller (in case there was no manipulation of the stack in between!)
11225:
11226: KOPEN_IEC: ; Open a file on the IEC bus
11227: lda zSA ; get secondary address
11228: bmi KOPEN_ClcRts2 ; bit 7 set -> nothing to do, we're done
11229:
11230: ldy zFNLEN ; get length of the file name
11231: beq KOPEN_ClcRts2 ; is it 0 -> nothing to do, we're done
11232:
11233: .if CompileComputer >= C64_GENERAL
11234: lda #0 ; clear the status byte, that is, start with a clean status
11235: sta zSTATUS
11236: .endif
11237:
11238: lda zFA
11239: jsr iLISTEN ; send LISTEN to the device
11240:
11241: lda zSA
11242: ora #IEEE_SECONDARY
11243: jsr iSECOND ; send secondary address after LISTEN
11244:
11245: lda zSTATUS ; check device status
11246: bpl KOPEN_Iec_DeviceExists ; bit 7 (device not present) unset -> device exists -> proceed
11247:
11248: JDLF3F1:
11249: ; if we reach here, zSTATUS.7 was set. Thus, we got a timeout -> the device does not exist
11250: ;
11251: pla ; remove return address of caller from the stack (!)
11252: pla
11253:
11254: JDLF3F3:
11255: jmp KErrDeviceNotPresent ; return to the caller of the caller with "Device not Present" error
11256: ; --------------------------
11257:
11258: KOPEN_Iec_DeviceExists:
11259: lda zFNLEN ; get length of the file name
11260: beq @NoName ; if 0, we're done. (UNNECCESSARY, as this has already been tested above!)
11261:
11262: ; now, the file name is output to the IEC bus, one byte after the other
11263:
11264: ldy #0
11265: : lda (zFNADR),y ; get next character of the file name
11266: jsr iCIOUT ; output it to the IEC bus
11267: iny ; proceed to next character
11268: cpy zFNLEN ; have we reached the end yet?
11269: bne :- ; now, process this character, too.
11270:
11271: @NoName:
11272: .if CompileComputer >= C64_GENERAL
11273: ; for C64, this functionality has been implemented by jumping to another place with the same implementation as here:
11274:
11275: jmp DoUnlistenClcRts
11276: .else
11277: ; the VIC-20 does it itself here, which results in duplicate code:
11278:
11279: jsr iUNLSN
11280:
11281: .if CompileComputer < C64_GENERAL
11282: KOPEN_ClcRts2:
11283: .endif
11284: clc
11285: rts
11286: .endif
11287:
11288: OPEN_RS232:
11289:
11290: ; TODO: Initialize RS232
11291:
11292: .if CompileComputer >= C64_GENERAL
11293: jsr LF483
11294: .else
11295: lda #$06
11296: sta VIA1_DDRB
11297: sta VIA1_PB
11298: lda #$EE
11299: sta VIA1_PCR
11300: ldy #0
11301: .endif
11302: sty lRSSTAT
11303: @LF40F: cpy zFNLEN
11304: beq @LF41D
11305: lda (zFNADR),y
11306: sta lM51CTR,y
11307: iny
11308: cpy #$04
11309: bne @LF40F
11310: @LF41D:
11311: jsr LEF4A
11312: stx lBITNUM
11313: lda lM51CTR
11314: and #$0F
11315:
11316: .if CompileComputer >= C64_02
11317: beq @LF446
11318: asl a
11319: tax
11320: lda lTVSFLG
11321: bne @LF43A
11322: ldy LFEC2 - 1,x
11323: lda LFEC2 - 2,x
11324: jmp @LF440
11325: @LF43A:
11326: ldy LE4EC-1,x
11327: lda LE4EC-2,x
11328: @LF440:
11329: sty lM51AJB + 1
11330: sta lM51AJB
11331: @LF446:
11332: lda lM51AJB
11333: asl a
11334: jsr LFF2E
11335: lda lM51CDR
11336: lsr a
11337: bcc @LF45C
11338: lda CIA2 + CIA_O_PB
11339: asl a
11340: bcs @LF45C
11341: jsr LF00D
11342: .else
11343: bne @LF435
11344: .if CompileComputer >= C64_GENERAL
11345: lda lM51AJB
11346: asl a
11347: tay
11348: lda lM51AJB + 1
11349: jmp @LF43F
11350: .endif
11351: @LF435: asl a
11352: tax
11353: lda LFEC2 - 2,x
11354: asl a
11355: tay
11356: lda LFEC2 - 1,x
11357: @LF43F: rol a
11358: pha
11359: tya
11360: adc #<200
11361: sta lBAUDOF
11362: pla
11363: adc #>200
11364: sta lBAUDOF + 1
11365: lda lM51CDR
11366: lsr a
11367: bcc @LF45C
11368: .if CompileComputer >= C64_GENERAL
11369: lda CIA2 + CIA_O_PB
11370: .else
11371: lda VIA2_PB
11372: .endif
11373: asl a
11374: bcs @LF45C
11375: .if CompileComputer >= C64_GENERAL
11376: jmp LF00D
11377: .else
11378: jmp LF016
11379: .endif
11380: .endif
11381:
11382: @LF45C: lda lRIDBE
11383: sta lRIDBS
11384: lda lRODBE
11385: sta lRODBS
11386: jsr iMEMTOP_Get
11387: lda zRIBUF + 1
11388: bne @LF474
11389: dey
11390: sty zRIBUF + 1
11391: stx zRIBUF
11392: @LF474:
11393: lda zROBUF + 1
11394: bne SetMemtop_And_Return_With_F0
11395: dey
11396: sty zROBUF + 1
11397: stx zROBUF
11398:
11399: SetMemtop_And_Return_With_F0:
11400: sec
11401: lda #$F0
11402: jmp iMEMTOP_Set
11403:
11404: .if CompileComputer >= C64_GENERAL
11405: LF483: lda #$7F
11406: sta CIA2 + CIA_O_ICR
11407: lda #$06
11408: sta CIA2 + CIA_O_DDRB
11409: sta CIA2 + CIA_O_PB
11410: lda #$04
11411: ora IEC_REG
11412: sta IEC_REG
11413: ldy #$00
11414: sty lENABL
11415: rts
11416: .endif
11417:
11418:
11419: ; B-15. Function Name: LOAD
11420: ;
11421: ; Purpose: Load RAM from device
11422: ; Call address: $FFD5 (hex) 65493 (decimal)
11423: ; Communication registers: A, X, Y
11424: ; Preparatory routines: SETLFS, SETNAM
11425: ; Error returns: 0,4,5,8,9, READST
11426: ; Stack requirements: None
11427: ; Registers affected: A, X, Y
11428: ;
11429: ; Description: This routine LOADs data bytes from any input device di-
11430: ; rectly into the memory of the Commodore 64. It can also be used for a
11431: ; verify operation, comparing data from a device with the data already in
11432: ; memory, while leaving the data stored in RAM unchanged.
11433: ; The accumulator (.A) must be set to 0 for a LOAD operation, or 1 for a
11434: ; verify, If the input device is OPENed with a secondary address (SA) of 0
11435: ; the header information from the device is ignored. In this case, the X
11436: ; and Y registers must contain the starting address for the load. If the
11437: ; device is addressed with a secondary address of 1, then the data is
11438: ; loaded into memory starting at the location specified by the header. This
11439: ; routine returns the address of the highest RAM location loaded.
11440: ; Before this routine can be called, the KERNAL SETLFS, and SETNAM
11441: ; routines must be called.
11442: ;
11443: ;
11444: ; +-----------------------------------------------------------------------+
11445: ; | NOTE: You can NOT LOAD from the keyboard (0), RS-232 (2), or the |
11446: ; | screen (3). |
11447: ; +-----------------------------------------------------------------------+
11448: ;
11449: ;
11450: ; How to Use:
11451: ;
11452: ; 0) Call the SETLFS, and SETNAM routines. If a relocated load is de-
11453: ; sired, use the SETLFS routine to send a secondary address of 0.
11454: ; 1) Set the A register to 0 for load, 1 for verify.
11455: ; 2) If a relocated load is desired, the X and Y registers must be set
11456: ; to the start address for the load.
11457: ; 3) Call the routine using the JSR instruction.
11458: ;
11459: ;
11460: ;
11461: ;
11462: ;
11463: ;
11464: ; EXAMPLE:
11465: ;
11466: ; ;LOAD A FILE FROM TAPE
11467: ;
11468: ; LDA #DEVICE1 ;SET DEVICE NUMBER
11469: ; LDX #FILENO ;SET LOGICAL FILE NUMBER
11470: ; LDY CMD1 ;SET SECONDARY ADDRESS
11471: ; JSR SETLFS
11472: ; LDA #NAME1-NAME ;LOAD A WITH NUMBER OF
11473: ; ;CHARACTERS IN FILE NAME
11474: ; LDX #<NAME ;LOAD X AND Y WITH ADDRESS OF
11475: ; LDY #>NAME ;FILE NAME
11476: ; JSR SETNAM
11477: ; LDA #0 ;SET FLAG FOR A LOAD
11478: ; LDX #$FF ;ALTERNATE START
11479: ; LDY #$FF
11480: ; JSR LOAD
11481: ; STX VARTAB ;END OF LOAD
11482: ; STY VARTA B+1
11483: ; JMP START
11484: ; NAME .BYT 'FILE NAME'
11485: ; NAME1 ;
11486: ;
11487: iLOAD: stx zMEMUSS_2 ; remember alternate start at (zMEMUSS_2/zMEMUSS_2+1)
11488: sty zMEMUSS_2 + 1
11489: jmp (lILOAD) ; normally points to KLOAD
11490:
11491: KLOAD:
11492: sta zVERCKK ; remember if LOAD (= 0) or VERIFY (= 1)
11493:
11494: lda #0 ; clear status
11495: sta zSTATUS
11496:
11497: lda zFA ; get device address
11498: bne @NotKeyboard ; not keyboard (0) -> test for other devices
11499:
11500: @ErrIllegalDeviceNumber:
11501: jmp KErrIllegalDeviceNumber ; exit with "Illegal Device Number" error
11502: ; -----------------------------
11503:
11504: @NotKeyboard:
11505: cmp #FILE_SCREEN
11506: beq @ErrIllegalDeviceNumber ; load from screen --> exit with "Illegal Device Number" error
11507:
11508: ; if C = 0, only tape and RS232 have been left.
11509:
11510: .ifdef JIFFY
11511: ; JiffyDOS does not support a tape, and load from RS232 is not possible.
11512: ; thus, if C=0, we are not able to load. Thus:
11513:
11514: bcc @ErrIllegalDeviceNumber ; RS232 or TAPE --> exit with "Illegal Device Number" error
11515: .elseif CompileComputer = C64_SX64
11516: ; the SX64 does not have a tape, and load from RS232 is not possible.
11517: ; thus, if C=0, we are not able to load. Thus:
11518:
11519: bcc @ErrIllegalDeviceNumber ; RS232 or TAPE --> exit with "Illegal Device Number" error
11520: .else
11521: bcc KLOAD_TapeOrRS232 ; RS232 or TAPE --> try further tests
11522: .endif
11523:
11524:
11525: ; if we reach here, we want to load a file from IEC
11526:
11527: .if CompileComputer = VIC20_02
11528: lda #IEEE_OPEN ; set secondary address: LOAD
11529: sta zSA
11530: .endif
11531:
11532: ldy zFNLEN ; get length of file name
11533: bne KLOAD_FileNameGiven ; not 0 -> branch, name was given -> proceed
11534: .ifdef JIFFY
11535: jmp $F659
11536: .else
11537: jmp KErrFileNameMissing ; error: We need a file name for IEC load --> return with "File Name Missing" error
11538: .endif
11539: ; -------------------------
11540:
11541: KLOAD_FileNameGiven:
11542:
11543: .if CompileComputer = VIC20_02
11544:
11545: ; on the VIC20-02 ROM, a "ldx zSA" is missing:
11546: ; TODO: Is this "ldx" needed at all?
11547:
11548: jsr OutputSearchingFor ; output the "Searching [for <FILENAME>]" message
11549:
11550: .elseif CompileComputer >= C64_GENERAL
11551:
11552: ; the C64 ROMs contain this ldx:
11553:
11554: ldx zSA ; TODO: why?
11555: jsr OutputSearchingFor ; output the "Searching [for <FILENAME>]" message
11556: .else
11557: ; for the VIC20 ROMs (other than -02), the same sequence as in the C64 case is done in a patch that is called here:
11558:
11559: jsr LE4BC
11560: .endif
11561:
11562: .if CompileComputer <> VIC20_02
11563: lda #IEEE_LOAD ; set secondary address: LOAD
11564: sta zSA
11565: .endif
11566:
11567: jsr KOPEN_IEC ; open the file on the IEC bus. In case of a timeout, this function will not return here, but return to our caller!
11568:
11569: ; send a TALK command
11570: lda zFA
11571: jsr iTALK ; send TALK
11572: lda zSA
11573: jsr iTKSA ; and secondary address after TALK
11574:
11575: jsr iACPTR ; read 1st byte from IEC
11576: sta zEAL ; and store it as low byte of start address
11577:
11578: lda zSTATUS ; check status bit 6 (EOI)
11579: lsr a
11580: lsr a
11581: bcs KLOAD_ErrFileNotFound2 ; EOI -> return with "File Not Found" error
11582:
11583: .ifdef JIFFY
11584: jsr JDLF179
11585: .else
11586: jsr iACPTR ; read 2nd byte from IEC
11587: .endif
11588: sta zEAL + 1 ; and store it as high byte of start address
11589:
11590: .if 0
11591: ; this macro is defined in fileio_data.inc
11592:
11593: .macro LOAD_OVERWRITE_START_ADDRESS
11594: txa
11595: bne :+
11596: lda zMEMUSS
11597: sta zEAL
11598: lda zMEMUSS + 1
11599: sta zEAL + 1
11600: :
11601:
11602: .endmacro
11603: .endif
11604:
11605: .if CompileComputer >= C64_GENERAL
11606: LOAD_OVERWRITE_START_ADDRESS
11607: .endif
11608:
11609:
11610: .ifdef JIFFY
11611: @LF4F0:
11612: jmp JDLFAC4
11613:
11614: LF4F3:
11615: jsr kSTOP
11616: bne @LF4FB
11617: jmp IecCloseBecauseStopKey
11618: @LF4FB:
11619: jsr JDLFBAA
11620: lda zSTATUS
11621: and #$FD
11622: cmp zSTATUS
11623: sta zSTATUS
11624: bne LF4F3
11625: ldy #$00
11626: ldx zTSFCNT
11627: lda zTBTCNT
11628: cpy zVERCKK
11629: beq @LF51A
11630: cmp (zEAL),y
11631: beq @LF51C
11632: jsr LF19E
11633: .byte $2C
11634: @LF51A:
11635: sta (zEAL),y
11636: @LF51C:
11637: stx zTSFCNT
11638:
11639: .else
11640:
11641: .if CompileComputer >= C64_GENERAL .or CompileComputer = VIC20_02
11642: jsr OutputLoadingOrVerify ; output LOADING or VERIFYING messages
11643: .else
11644: ; the following patch contains:
11645: ; LOAD_OVERWRITE_START_ADDRESS
11646: ; jsr OutputLoadingOrVerify
11647:
11648: ; Thus, the implementation is identical to the C64
11649:
11650: jsr LE4C1
11651: .endif
11652:
11653: LF4F3:
11654: lda #~STATUS_IEC_TIMEOUT_READ ; clear read timeout
11655: and zSTATUS ; TODO: why?
11656: sta zSTATUS
11657:
11658: jsr kSTOP ; check if the stop key has been pressed
11659: bne @ReadByte ; no stop key, proceed
11660:
11661: jmp IecCloseBecauseStopKey ; close file and return with error: Stopped because user pressed <STOP> key
11662:
11663: @ReadByte:
11664: jsr iACPTR ; get data byte from IEC bus
11665: tax ; remember it in X
11666:
11667: lda zSTATUS ; check status bit 6 (EOI)
11668: lsr a
11669: lsr a
11670: bcs LF4F3 ; EOI -> there is no data to process -> branch
11671:
11672: txa ; get back the data byte from the IEC bus
11673:
11674: ldy zVERCKK ; test verify flag
11675: beq @Load ; =0 --> LOAD --> Store data byte in memory
11676:
11677: ldy #0 ; make sure to compare the first byte
11678: cmp (zEAL),y ; compare data byte
11679: beq @IncrementAddress ; it's the same -> everything ok -> branch
11680:
11681: lda #STATUS_VERIFY ; set "verify error" bit
11682: jsr SetStatus
11683:
11684: .byte ASM_BIT3 ; mask next instruction so it is not executed
11685:
11686: @Load:
11687: ; Y is already 0 here, as this is only executed when beq @Load after ldy zVERCKK has been taken...
11688: sta (zEAL),y ; store data byte in memory
11689:
11690: .endif
11691:
11692: @IncrementAddress:
11693: inc zEAL ; increment low address
11694: bne :+ ; if not zero, skip incrementing high address
11695: inc zEAL + 1 ; increment high address
11696:
11697: : bit zSTATUS ; test status bit 6 (EOI)
11698: bvc LF4F3 ; unset -> proceed with next byte
11699:
11700: KLOAD_UntalkClose:
11701: jsr iUNTLK ; send UNTALK to device
11702: jsr IecClose ; close the file
11703: bcc LoadEndSuccess ; C=0 -> no error occurred -> quit with success
11704:
11705: KLOAD_ErrFileNotFound2:
11706: jmp KErrFileNotFound ; return with "File Not Found" error
11707: ; -------------------------
11708:
11709: KLOAD_TapeOrRS232:
11710: ; if we reach here, either a LOAD from TAPE (A=1) or from RS232 (=2) has been
11711: ; asked for
11712:
11713: .ifdef JIFFY
11714:
11715: lda zFNLEN
11716: beq LF546
11717: lda (zFNADR),y
11718: cmp #$24
11719: beq LF56C
11720: jmp JDLFC9A
11721: tya
11722: LF541: pha
11723: jsr JDLF8BF
11724: pla
11725: LF546: sta zBUFPNT
11726: LF548: jsr JDLF911
11727: bne LF568
11728: lda zBUFPNT
11729: php
11730: beq LF557
11731: jsr JDLE4C6
11732: beq LF567
11733: LF557: jsr JDLF79A
11734: jsr OutputFilename
11735: bit zSTKEY
11736: bpl LF567
11737: plp
11738: bne LF548
11739: bvc LF548
11740: .byte $24
11741: LF567: plp
11742: LF568: rts
11743: ldx #$6C
11744: .byte $2C
11745: LF56C: ldx #$60
11746: jsr JDLF8C1
11747: lda #$39
11748: sta lIERROR
11749: ldy #$FC
11750: jsr JDLFCA6
11751: LF57B: ldy #$00
11752: LF57D: jsr JDLFCA6
11753: bvs LF5A3
11754: cpy #$02
11755: beq LF5A3
11756: cpy #$06
11757: bcc LF57D
11758: ldx zFNADR
11759: stx $5F
11760: ldx $BC
11761: stx $60
11762: ldy #$01
11763: sta ($5F),y
11764: jsr JDLA6C3
11765: jsr JDLF79A
11766: jsr JDLA6D4
11767: bit zSTKEY
11768: bmi LF57B
11769: LF5A3: lda #$63
11770: sta lIERROR
11771: rts
11772:
11773: .else
11774:
11775: .if CompileComputer >= C64_GENERAL
11776: lsr a ; check if bit 0 of the device number is 1
11777: bcs @Tape ; yes -> it is the tape -> branch, process LOAD from tape
11778: jmp KErrIllegalDeviceNumber ; load from RS232 not possible, quit with "Illegal Device Number" error
11779: .else
11780: cmp #FILE_RS232 ; test if the device number is the number of RS232
11781: bne @Tape ; no -> it is the tape -> branch, process LOAD from tape
11782: jmp Rs232ErrIllegalDeviceNumber ; load from RS232 not possible, quit with "Illegal Device Number" error
11783: .endif
11784:
11785: ; TODO document load from TAPE
11786: @Tape:
11787: jsr TapeGetPointer ; get pointer to tape buffer into (X/Y) (unused, but flags important)
11788: bcs :+ ; C = 1 -> tape buffer does NOT point to stack page or zero page -> proceed, we do not overwrite essential data!
11789: jmp KErrIllegalDeviceNumber
11790:
11791: :
11792: jsr TapePressPlayOnTape ; output "PRESS PLAY ON TAPE" and wait for the PLAY key to be pressed
11793: bcs LoadRts ; C = 1 --> an error occurred (STOP key) --> branch, quit
11794:
11795: jsr OutputSearchingFor ; output "SEARCHING FOR ..."
11796:
11797: @LF549: lda zFNLEN ; length of file name
11798: beq :+ ; 0 --> no file name specified -> skip
11799: jsr TapeFindSpecificFile ; try to find the specified file
11800: bcc @FoundFile ; C = 0 -> no error occurred -> branch, proceed with operation
11801: beq LoadRts ; Z = 1 --> an EOT was found
11802: bcs KLOAD_ErrFileNotFound2 ; return with FILE NOT FOUND error
11803: ; ------------------------
11804:
11805: :
11806: jsr TapeReadTapeHeaderOfNextFile ; try to find ANY file header
11807: beq LoadRts ; Z = 1 --> an EOT was found (BUG or TODO?: This is only valid if C=0, thus, this test would have to be the first one!)
11808: bcs KLOAD_ErrFileNotFound2 ; C = 1 --> an error occurred -> branch, quit with FILE NOT FOUND error
11809:
11810: @FoundFile:
11811: lda zSTATUS
11812: and #STATUS_VERIFY ; TODO: STATUS_VERIFY or STATUS_TAPE_UNRECOVERABLE_READ_ERROR? The latter seems not to be generated (or I missed it until now)
11813: sec
11814: bne LoadRts ; if the status indicated the error -> branch, we're done
11815:
11816: cpx #TAPE_BUFFER_TYPE_BASIC ; is this file a BASIC program?
11817: beq @BASIC_Program ; yes -> branch, process the BASIC program
11818:
11819: cpx #TAPE_BUFFER_TYPE_ABSOLUTE ; is this file an absolute program?
11820: bne @LF549 ; no -> branch, search for the next file (there is a data file with the same name, skip it)
11821:
11822: @Absolute_Program:
11823: ldy #TAPE_BUFFER_OFFSET_SAL_LOW ; offset of start address low in tape buffer
11824: lda (zTAPE1),y ; read the start address low
11825: sta zMEMUSS_2 ; and store it
11826: iny ; advance offset to start address high
11827: lda (zTAPE1),y ; read the start address high
11828: sta zMEMUSS_2 + 1 ; and store it
11829: bcs @LoadFile ; (uncond. branch: TAPE_BUFFER_TYPE_DATA or TAPE_BUFFER_TYPE_EOT can be ruled out here, thus, the CPX resulted in a C=1)
11830: ; -------------------
11831:
11832: @BASIC_Program:
11833: lda zSA ; get secondary address used to open the file
11834: bne @Absolute_Program ; not 0 --> we want to read the file absolute, ignore that it is written as BASIC program and load it absolute instead
11835:
11836: ; If the above branch did not branch and we reach this place from above (not via bcs @LoadFile), then we have a BASIC program.
11837: ; The start address to load it to is already at zMEMUSS_2/zMEMUSS_2 + 1.
11838:
11839: @LoadFile:
11840: ; Calculate the end address and write it into zEAL/zEAL+1
11841:
11842: ; sec ; C=1 is always true here, thus, no need for an SEC
11843:
11844: ldy #TAPE_BUFFER_OFFSET_EAL_LOW ; (offset of end address low in tape buffer)
11845: lda (zTAPE1),y ; get end address low
11846: ldy #TAPE_BUFFER_OFFSET_SAL_LOW ; (offset of start address low in tape buffer)
11847: sbc (zTAPE1),y ; subtract end address low - start address low
11848: tax ; remember the result in X
11849:
11850: ldy #TAPE_BUFFER_OFFSET_EAL_HIGH ; (offset of end address high in tape buffer)
11851: lda (zTAPE1),y ; get end address high
11852: ldy #TAPE_BUFFER_OFFSET_SAL_HIGH ; (offset of start address high in tape buffer)
11853: sbc (zTAPE1),y ; subtract end address high - start address high
11854: tay ; remember the result in Y
11855:
11856: ; now, add the length (in X/Y) t zMEMUSS_2/zMEMUSS_2+1, and store the result in zEAL/zEAL+1
11857: clc
11858: txa ; get length low
11859: adc zMEMUSS_2 ; add it to the start address low
11860: sta zEAL ; and store it as end address low
11861:
11862: tya ; get length high
11863: adc zMEMUSS_2 + 1 ; add it to the start address high
11864: sta zEAL + 1 ; and store it as end address high
11865:
11866: ; copy the start address from zMEMUSS_2/zMEMUSS_2+1 to zSTAL/zSTAL+1
11867:
11868: lda zMEMUSS_2
11869: sta zSTAL
11870: lda zMEMUSS_2 + 1
11871: sta zSTAL + 1
11872:
11873: jsr OutputLoadingOrVerify ; output LOADING or VERIFYING messages
11874:
11875: jsr TapeReadFileContents ; read in the next buffer from the tape
11876: .byte ASM_BIT2 ; make
11877:
11878: .endif
11879:
11880: LoadEndSuccess:
11881: clc ; mark: success
11882: ldx zEAL ; return end address (+1) in X/Y
11883: ldy zEAL + 1
11884: LoadRts:
11885: rts
11886: ; --------------
11887:
11888: OutputSearchingFor:
11889: lda zNSGFLG ; do we output messages "searching for", or is it prohibited?
11890: bpl OutputSearchingFor_Rts ; no -> branch -> quit, we don't want to output anything
11891:
11892: ldy #StrSearching - LMESSAGES ; offset of "Searching" message
11893: jsr OutputMessage ; output it
11894:
11895: lda zFNLEN ; test length of file name
11896: beq OutputSearchingFor_Rts ; length = 0 -> no filename -> branch -> quit, nothing else to do
11897:
11898: ldy #StrFor - LMESSAGES ; offset of " for " message
11899: jsr OutputMessage ; output it
11900:
11901: OutputFilename:
11902: ldy zFNLEN ; test length of file name
11903: beq OutputSearchingFor_Rts ; length = 0 -> no filename -> branch -> quit, nothing else to do
11904:
11905: ldy #0 ; start with first character
11906: : lda (zFNADR),y ; get character of file name
11907: jsr kCHROUT ; and output it
11908: iny ; advance to next character
11909: cpy zFNLEN ; did we reach the end of the file name?
11910: bne :- ; no, process next character
11911:
11912: OutputSearchingFor_Rts:
11913: rts
11914: ; --------------------
11915:
11916: OutputLoadingOrVerify:
11917: ldy #StrLoading - LMESSAGES ; offset of "LOADING" message
11918: lda zVERCKK ; check verify flag
11919: beq @Output ; 0 -> LOAD -> output LOADING"
11920: ldy #StrVerifying - LMESSAGES ; otherwise, it is a VERIFY: Get offset of "VERIFYING" message
11921: @Output:
11922: jmp OutputMessageIfAllowed ; output the message, if not prohibited
11923:
11924:
11925:
11926: ; B-24. Function Name: SAVE
11927: ;
11928: ; Purpose: Save memory to a device
11929: ; Call address: $FFD8 (hex) 65496 (decimal)
11930: ; Communication registers: A, X, Y
11931: ; Preparatory routines: SETLFS, SETNAM
11932: ; Error returns: 5,8,9, READST
11933: ; Stack requirements: None
11934: ; Registers affected: A, X, Y
11935: ;
11936: ;
11937: ;
11938: ; Description: This routine saves a section of memory. Memory is saved
11939: ; from an indirect address on page 0 specified by the accumulator to the
11940: ; address stored in the X and Y registers. It is then sent to a logical
11941: ; file on an input/output device. The SETLFS and SETNAM routines must be
11942: ; used before calling this routine. However, a file name is not required to
11943: ; SAVE to device 1 (the Datassette(TM) recorder). Any attempt to save to
11944: ; other devices without using a file name results in an error.
11945: ;
11946: ; +-----------------------------------------------------------------------+
11947: ; | NOTE: Device 0 (the keyboard), device 2 (RS-232), and device 3 (the |
11948: ; | screen) cannot be SAVEd to. If the attempt is made, an error occurs, |
11949: ; | and the SAVE is stopped. |
11950: ; +-----------------------------------------------------------------------+
11951: ;
11952: ; How to Use:
11953: ;
11954: ; 0) Use the SETLFS routine and the SETNAM routine (unless a SAVE with no
11955: ; file name is desired on "a save to the tape recorder"),
11956: ; 1) Load two consecutive locations on page 0 with a pointer to the start
11957: ; of your save (in standard 6502 low byte first, high byte next
11958: ; format).
11959: ; 2) Load the accumulator with the single byte page zero offset to the
11960: ; pointer.
11961: ; 3) Load the X and Y registers with the low byte and high byte re-
11962: ; spectively of the location of the end of the save.
11963: ; 4) Call this routine.
11964: ;
11965: ; EXAMPLE:
11966: ;
11967: ; LDA #1 ;DEVICE = 1:CASSETTE
11968: ; JSR SETLFS
11969: ; LDA #0 ;NO FILE NAME
11970: ; JSR SETNAM
11971: ; LDA PROG ;LOAD START ADDRESS OF SAVE
11972: ; STA TXTTAB ;(LOW BYTE)
11973: ; LDA PROG+1
11974: ; STA TXTTA B+1 ;(HIGH BYTE)
11975: ; LDX VARTAB ;LOAD X WITH LOW BYTE OF END OF SAVE
11976: ; LDY VARTAB+1 ;LOAD Y WITH HIGH BYTE
11977: ; LDA #<TXTTAB ;LOAD ACCUMULATOR WITH PAGE 0 OFFSET
11978: ; JSR SAVE
11979: ;
11980: ;
11981: iSAVE:
11982: stx zEAL ; store end address of save at (zEAL/zEAL+1)
11983: sty zEAL + 1
11984:
11985: ; store start address at (zSTAL/zSTAL + 1)
11986:
11987: tax ; get index of zero page location that contains the start address into X
11988: lda 0,x ; get start address low
11989: sta zSTAL
11990: lda 0 + 1,x ; get start address high
11991: sta zSTAL + 1
11992: jmp (lISAVE) ; points to KSAVE normally
11993:
11994: KSAVE:
11995: lda zFA ; get device number
11996: bne SaveNotKeyboard ; not keyboard (0) -> branch, test for other devices
11997:
11998: SaveErrIllegalDeviceNumber:
11999: jmp KErrIllegalDeviceNumber ; return with "Illegal Device Number" error
12000:
12001: SaveNotKeyboard:
12002: cmp #FILE_SCREEN ; device number screen (3)?
12003: beq SaveErrIllegalDeviceNumber ; yes -> return with "Illegal Device Number" error
12004:
12005: ; if we reach here, only tape and RS232 are left with C=0
12006: ; (and IEC with C=1)
12007: .ifdef JIFFY
12008: bcc SaveErrIllegalDeviceNumber ; on the SX64, tape and RS232 are both illegal -> return with error
12009: .elseif CompileComputer = C64_SX64
12010: bcc SaveErrIllegalDeviceNumber ; on the SX64, tape and RS232 are both illegal -> return with error
12011: .else
12012: bcc SaveTapeOrRs232 ; check if tape or RS232
12013: .endif
12014:
12015: ; if we reach here, we want to save on IEC bus
12016:
12017: lda #IEEE_SAVE ; set the secondary address
12018: sta zSA ; to the address of a save
12019:
12020: ldy zFNLEN ; is there a file name?
12021: bne LF605 ; yes -> everything ok, proceed
12022:
12023: SAVE_KErrFileNameMissing:
12024: jmp KErrFileNameMissing ; return with "File Name Missing" error
12025:
12026: LF605:
12027: jsr KOPEN_IEC ; open the file on the IEC bus
12028: jsr OutputSaving ; output the "SAVING" message
12029:
12030: lda zFA ; send LISTEN to device
12031: jsr iLISTEN
12032: lda zSA ; with correspondig SA
12033: jsr iSECOND
12034:
12035: ldy #0 ; index for writing data (for later, when receiving data)
12036:
12037: jsr Copy_zSTAL_to_zSAL ; save start address into pointer which will be used for saving
12038:
12039: ; output the start address as two first bytes
12040: lda zSAL ; low byte
12041: jsr iCIOUT
12042: lda zSAL + 1 ; high byte
12043: jsr iCIOUT
12044:
12045: SAVE_Loop:
12046: jsr HasEndAddressBeenReached ; check if working address (zSAL/zSAL+1) has reached end address (zEAL/zEAL+1)
12047: bcs SAVE_End ; reached -> branch
12048:
12049: lda (zSAL),y ; byte to be saved
12050: jsr iCIOUT ; output to IEC
12051:
12052: jsr kSTOP ; check if <stop> has been pressed
12053: bne SAVE_NoStop ; no -> branch, process next byte (if any)
12054:
12055: IecCloseBecauseStopKey:
12056: jsr IecClose ; close the file on the IEC bus
12057:
12058: lda #0 ; error: Routine terminated by the <STOP> key
12059: sec ; mark: error return
12060: rts
12061: ; --------------
12062:
12063: SAVE_NoStop:
12064: jsr Increment_zSAL_Address ; increment working address
12065: bne SAVE_Loop ; if no "wrap around" to address 0, save the next byte
12066:
12067:
12068: SAVE_End:
12069: jsr iUNLSN ; send UNLISTEN to device
12070:
12071: IecClose:
12072: ; Close an IEC file by sending a LISTEN with the secondary address specifying "CLOSE"
12073: bit zSA ; secondary address
12074: bmi SAVE_ClcRts ; bit 7 set -> branch, we are done
12075:
12076: lda zFA ; send listen to device
12077: jsr iLISTEN
12078:
12079: lda zSA ; send secondary address "CLOSE"
12080: and #$EF
12081: ora #IEEE_CLOSE
12082: jsr iSECOND
12083:
12084: DoUnlistenClcRts:
12085: jsr iUNLSN ; send UNLISTEN
12086:
12087: SAVE_ClcRts:
12088: clc
12089: rts
12090: ; --------------
12091:
12092: SaveTapeOrRs232:
12093:
12094: .ifdef JIFFY
12095:
12096: LF659: lda zNDX
12097: beq SAVE_KErrFileNameMissing
12098: lda #$02
12099: sta zSA
12100: ldx #$74
12101: ldy #$F6
12102: jsr kSETNAM
12103: jmp KLOAD_FileNameGiven
12104: LF66B: ldx #$33
12105: ldy #$04
12106: jmp JDLF932
12107:
12108: .byte $40, $24, $3a, $2a, $0d, $00, $2f, $00
12109: .byte $5e, $00, $25, $00, $40, $44, $00, $40
12110: .byte $54, $00, $5f, $00, $40, $20, $20, $22
12111: .byte $53, $3a, $00
12112:
12113: .else
12114:
12115: ; if we reach here, either a SAVE from TAPE (A=1) or from RS232 (=2) has been
12116: ; asked for
12117:
12118: .if CompileComputer >= C64_GENERAL
12119: lsr a ; check if bit 0 of the device number is 1
12120: bcs @Tape ; yes -> it is the tape -> branch, process SAVE from tape
12121: jmp KErrIllegalDeviceNumber ; save to RS232 not possible, quit with "Illegal Device Number" error
12122: .else
12123: cmp #FILE_RS232 ; test if the device number is the number of RS232
12124: bne @Tape ; no -> it is the tape -> branch, process SAVE to tape
12125: jmp Rs232ErrIllegalDeviceNumber ; save to RS232 not possible, quit with "Illegal Device Number" error
12126: .endif
12127:
12128: @Tape:
12129: jsr TapeGetPointer ; is the tape buffer set (high byte >= 2)?
12130: bcc SaveErrIllegalDeviceNumber ; no -> abort operation, as we would overwrite ZP or stack
12131:
12132: jsr TapePressRecordAndPlayOnTape ; output "PRESS RECORD + PLAY ON TAPE" and wait for PLAY to be pressd
12133: bcs SAVE_Rts ; C=1 -> an error occurred (i.e., STOP was pressed) -> branch, abort
12134:
12135: jsr OutputSaving ; Output the text "SAVING <filename>"
12136:
12137: ; determine the tape buffer type to generate for the first block (filename)
12138:
12139: ldx #TAPE_BUFFER_TYPE_ABSOLUTE ; assume: file is a absolute loading program (not BASIC)
12140:
12141: lda zSA ; check secondary address
12142: and #$01 ; bit 0 set?
12143: bne :+ ; yes -> branch, skip
12144:
12145: ldx #TAPE_BUFFER_TYPE_BASIC ; no -> file is a BASIC program
12146:
12147: : txa
12148: jsr TapeCreateFileBuffer ; create the file buffer (including start and end address and file name) and write it on tape
12149: bcs SAVE_Rts ; C = 1 -> an error occurred -> branch, quit save with an error
12150:
12151: jsr TapeWriteCompleteFile ; write out the file to tape
12152: bcs SAVE_Rts ; C = 1 -> an error occurred -> branch, quit save with an error
12153:
12154: ; check if bit 1 of the secondary address is set. If so, we have to write an end-of-tape (EOT) marker on the tape
12155: lda zSA ; get secondary address
12156: and #$02 ; is bit 1 set?
12157: beq @ClcRts ; no -> branch, we're done
12158:
12159: lda #TAPE_BUFFER_TYPE_EOT ; tape buffer type: END-OF-TAPE (EOT)
12160: jsr TapeCreateFileBuffer ; create the file buffer and write it on tape
12161:
12162: .byte ASM_BIT2 ; make sure not to loose the status of C by hiding the next instruction
12163:
12164: .endif
12165:
12166: @ClcRts:
12167: clc
12168: SAVE_Rts:
12169: rts
12170: ; ---------------------
12171:
12172: OutputSaving:
12173: lda zNSGFLG ; do we output messages "searching for", or is it prohibited?
12174: bpl SAVE_Rts ; no -> branch -> quit, we don't want to output anything
12175:
12176: ldy #StrSaving - LMESSAGES ; offset of "Saving" message
12177: jsr OutputMessage ; output it
12178:
12179: jmp OutputFilename ; output the file name of file to be saved
12180: ; ---------------------
12181:
12182:
12183: ; B-36. Function Name: UDTIM
12184: ;
12185: ; Purpose: Update the system clock
12186: ; Call address: $FFEA (hex) 65514 (decimal)
12187: ; Communication registers: None
12188: ; Preparatory routines: None
12189: ; Error returns: None
12190: ; Stack requirements: 2
12191: ; Registers affected: A, X
12192: ;
12193: ; Description: This routine updates the system clock. Normally this
12194: ; routine is called by the normal KERNAL interrupt routine every 1/60th of
12195: ; a second. If the user program processes its own interrupts this routine
12196: ; must be called to update the time. In addition, the <STOP> key routine
12197: ; must be called, if the <STOP> key is to remain functional.
12198: ;
12199: ; How to Use:
12200: ; 1) Call this routine.
12201: ;
12202: ; EXAMPLE:
12203: ;
12204: ; JSR UDTIM
12205: ;
12206: ;
12207: iUDTIM:
12208: ldx #0 ; will be used in the case of a wrap-around of the timer for setting the timer back to zero.
12209:
12210: inc zTIME + 2 ; increment lowest byte
12211: bne @CheckOverflow ; no overflow -> done incrementing
12212:
12213: inc zTIME + 1 ; increment middle byte
12214: bne @CheckOverflow ; no overflow -> done incrementing
12215:
12216: inc zTIME ; increment highest byte
12217:
12218: @CheckOverflow:
12219:
12220: ; now, check if the timer overflowed, that is, 24h have been reached
12221: ; for this, subtract the constant for 24h (24*60*60*60)+1 from the
12222: ; current value
12223:
12224: sec
12225: lda zTIME + 2
12226: sbc #<((24*60*60*60)+1)
12227: lda zTIME + 1
12228: sbc #>((24*60*60*60)+1)
12229: lda zTIME
12230: sbc #^((24*60*60*60)+1)
12231:
12232: ; if carry is not set, the timer value is smaller -> branch, no need to perform wrap-around
12233: bcc iUDTIM_CheckRunStop
12234:
12235: ; we had a wrap-around, set timer value to 0
12236: stx zTIME
12237: stx zTIME + 1
12238: stx zTIME + 2
12239:
12240: iUDTIM_CheckRunStop:
12241: ; check if the Run/STOP key has been pressed
12242:
12243: ; TODO document
12244:
12245: lda KEYB_COL_FOR_STOP
12246: cmp KEYB_COL_FOR_STOP
12247: bne iUDTIM_CheckRunStop
12248:
12249: .if CompileComputer >= C64_GENERAL
12250: tax
12251: bmi @StoreStop
12252: ldx #KEYB_ROW_STOP
12253: stx KEYB_ROW
12254: @Debounce:
12255: ldx KEYB_COL_FOR_STOP
12256: cpx KEYB_COL_FOR_STOP
12257: bne @Debounce
12258: sta KEYB_ROW
12259: inx
12260: bne @Rts
12261: .endif
12262:
12263: @StoreStop:
12264: sta zSTKEY
12265: @Rts:
12266: rts
12267:
12268:
12269: ; B-21. Function Name: RDTIM
12270: ;
12271: ; Purpose: Read system clock
12272: ; Call address: $FFDE (hex) 65502 (decimal)
12273: ; Communication registers: A, X, Y
12274: ; Preparatory routines: None
12275: ; Error returns: None
12276: ; Stack requirements: 2
12277: ; Registers affected: A, X, Y
12278: ;
12279: ; Description: This routine is used to read the system clock. The clock's
12280: ; resolution is a 60th of a second. Three bytes are returned by the
12281: ; routine. The accumulator contains the most significant byte, the X index
12282: ; register contains the next most significant byte, and the Y index
12283: ; register contains the least significant byte.
12284: ;
12285: ; EXAMPLE:
12286: ;
12287: ; JSR RDTIM
12288: ; STY TIME
12289: ; STX TIME+1
12290: ; STA TIME+2
12291: ; ...
12292: ; TIME *=*+3
12293: ;
12294: ;
12295: iRDTIM:
12296: sei ; make sure we get not interrupted (atomicity)
12297:
12298: ; read the values of the time
12299: lda zTIME + 2 ; high byte
12300: ldx zTIME + 1 ; middle byte
12301: ldy zTIME ; low byte
12302:
12303: ; B-31. Function Name: SETTIM
12304: ;
12305: ; Purpose: Set the system clock
12306: ; Call address: $FFDB (hex) 65499 (decimal)
12307: ; Communication registers: A, X, Y
12308: ; Preparatory routines: None
12309: ; Error returns: None
12310: ; Stack requirements: 2
12311: ; Registers affected: None
12312: ;
12313: ;
12314: ;
12315: ; Description: A system clock is maintained by an interrupt routine that
12316: ; updates the clock every 1/60th of a second (one "jiffy"). The clock is
12317: ; three bytes long, which gives it the capability to count up to 5,184,000
12318: ; jiffies (24 hours). At that point the clock resets to zero. Before
12319: ; calling this routine to set the clock, the accumulator must contain the
12320: ; most significant byte, the X index register the next most significant
12321: ; byte, and the Y index register the least significant byte of the initial
12322: ; time setting (in jiffies).
12323: ;
12324: ; How to Use:
12325: ; 1) Load the accumulator with the MSB of the 3-byte number to set the
12326: ; clock.
12327: ; 2) Load the X register with the next byte.
12328: ; 3) Load the Y register with the LSB.
12329: ; 4) Call this routine.
12330: ;
12331: ; EXAMPLE:
12332: ; ;SET THE CLOCK TO 10 MINUTES = 3600 JIFFIES
12333: ; LDA #0 ;MOST SIGNIFICANT
12334: ; LDX #>3600
12335: ; LDY #<3600 ;LEAST SIGNIFICANT
12336: ; JSR SETTIM
12337: ;
12338: iSETTIM:
12339: sei ; make sure we get not interrupted (atomicity)
12340:
12341: ; set the values of the time
12342: sta zTIME + 2 ; high byte
12343: stx zTIME + 1 ; middle byte
12344: sty zTIME ; low byte
12345:
12346: cli ; the critical section is over
12347:
12348: rts
12349: ; ----------------
12350:
12351: ; B-33. Function Name: STOP
12352: ;
12353: ; Purpose: Check if <STOP> key is pressed
12354: ; Call address: $FFE1 (hex) 65505 (decimal)
12355: ; Communication registers: A
12356: ; Preparatory routines: None
12357: ; Error returns: None
12358: ; Stack requirements: None
12359: ; Registers affected: A, X
12360: ;
12361: ; Description: If the <STOP> key on the keyboard was pressed during a
12362: ; UDTIM call, this call returns the Z flag set. In addition, the channels
12363: ; will be reset to default values. All other flags remain unchanged. If the
12364: ; <STOP> key is not pressed then the accumulator will contain a byte
12365: ; representing the lost row of the keyboard scan. The user can also check
12366: ; for certain other keys this way.
12367: ;
12368: ; How to Use:
12369: ; 0) UDTIM should be called before this routine.
12370: ; 1) Call this routine.
12371: ; 2) Test for the zero flag.
12372: ;
12373: ;
12374: ; EXAMPLE:
12375: ;
12376: ; JSR UDTIM ;SCAN FOR STOP
12377: ; JSR STOP
12378: ; BNE *+5 ;KEY NOT DOWN
12379: ; JMP READY ;=... STOP
12380: ;
12381: KSTOP:
12382: lda zSTKEY
12383: cmp #KEYB_CHECK_STOP ; was <STOP> key pressed?
12384: bne @Rts ; no -> branch, quit
12385:
12386: php ; make sure to preserve the status of Z (=1)
12387:
12388: jsr kCLRCHN ; clear default input and output devices
12389: ; (returns with A=0)
12390: sta zNDX ; mark: No characters in the keyboard buffer
12391:
12392: plp ; get back the status of Z (=1)
12393:
12394: @Rts: rts
12395: ; -----------------
12396:
12397: ; ERROR CODES
12398: ;
12399: ; The following is a list of error messages which can occur when using
12400: ; the KERNAL routines. If an error occurs during a KERNAL routine , the
12401: ; carry bit of the accumulator is set, and the number of the error message
12402: ; is returned in the accumulator.
12403: ; +-----------------------------------------------------------------------+
12404: ; | NOTE: Some KERNAL I/O routines do not use these codes for error |
12405: ; | messages. Instead, errors are identified using the KERNAL READST |
12406: ; | routine. |
12407: ; +-----------------------------------------------------------------------+
12408: ; +-------+---------------------------------------------------------------+
12409: ; | NUMBER| MEANING |
12410: ; +-------+---------------------------------------------------------------+
12411: ; | 0 | Routine terminated by the <STOP> key |
12412: ; | 1 | Too many open files |
12413: ; | 2 | File already open |
12414: ; | 3 | File not open |
12415: ; | 4 | File not found |
12416: ; | 5 | Device not present |
12417: ; | 6 | File is not an input file |
12418: ; | 7 | File is not an output file |
12419: ; | 8 | File name is missing |
12420: ; | 9 | Illegal device number |
12421: ; | 240 | Top-of-memory change RS-232 buffer allocation/deallocation |
12422: ; +-------+---------------------------------------------------------------+
12423: KErrTooManyOpenFiles:
12424: lda #$01
12425: .byte ASM_BIT3
12426:
12427: KErrFileOpen:
12428: lda #$02
12429: .byte ASM_BIT3
12430:
12431: KErrFileNotOpen:
12432: lda #$03
12433: .byte ASM_BIT3
12434:
12435: KErrFileNotFound:
12436: lda #$04
12437: .byte ASM_BIT3
12438:
12439: KErrDeviceNotPresent:
12440: lda #$05
12441: .byte ASM_BIT3
12442:
12443: KErrNotInputFile:
12444: lda #$06
12445: .byte ASM_BIT3
12446:
12447: KErrNotOutputFile:
12448: lda #$07
12449: .byte ASM_BIT3
12450:
12451: KErrFileNameMissing:
12452: lda #$08
12453: .byte ASM_BIT3
12454:
12455: KErrIllegalDeviceNumber:
12456: lda #$09
12457:
12458: pha ; remember error number
12459: jsr kCLRCHN ; restore output and input to console
12460: ldy #StrIoError - LMESSAGES ; prepare to output "I/O ERROR #" by getting its index
12461:
12462: bit zNSGFLG ; check the flag which has the message output policy
12463: bvc @NoOutput ; test bit 6: Output error message. If not set -> branch, do not output text
12464:
12465: jsr OutputMessage ; output the message with index in Y
12466:
12467: pla ; get back error number
12468: pha ; and remember it again
12469:
12470: ora #'0' ; convert it to ASCII ('0' - '9')
12471: jsr kCHROUT ; and output it
12472:
12473: @NoOutput:
12474: pla ; get back the error number
12475: sec ; mark: An error occurred
12476: rts
12477: ; --------------
12478: ; .include "../kernal/tape.a65"
12479: TAPE_BUFFER_TYPE_BASIC = $01
12480: TAPE_BUFFER_TYPE_CONTINUATION = $02
12481: TAPE_BUFFER_TYPE_ABSOLUTE = $03
12482: TAPE_BUFFER_TYPE_DATA = $04
12483: TAPE_BUFFER_TYPE_EOT = $05
12484:
12485: TAPE_BUFFER_OFFSET_TYPE = $00
12486: TAPE_BUFFER_OFFSET_SAL_LOW = $01
12487: TAPE_BUFFER_OFFSET_SAL_HIGH = $02
12488: TAPE_BUFFER_OFFSET_EAL_LOW = $03
12489: TAPE_BUFFER_OFFSET_EAL_HIGH = $04
12490: TAPE_BUFFER_OFFSET_FILENAME = $05 ; start of file name in every tape buffer but TAPE_BUFFER_TYPE_CONTINUATION
12491: TAPE_BUFFER_OFFSET_ENDFILENAME = $15 ; one after the end of the file name in every tape buffer but TAPE_BUFFER_TYPE_CONTINUATION
12492:
12493:
12494: TAPE_TIMER_CONSTANT_BIT0 := $60
12495: TAPE_TIMER_CONSTANT_BIT1 := $B0
12496: TAPE_TIMER_CONSTANT_PREAMBLE := $78
12497: TAPE_TIMER_CONSTANT_WRITE := $0110
12498:
12499: TAPE_RIPRTY_69 := $69
12500: TAPE_RIPRTY_14 := $14
12501:
12502: ; Define some aliases for understandability
12503:
12504: Pass1ReadErrors = zPTR1
12505: Pass2ReadErrors = zPTR2
12506: ReadCharacterError = zRODATA
12507: ReadCharacterIn = zROPRTY
12508: WriteCharacterOut = zROPRTY
12509: NrBlocksRemaining = zINBIT
12510: ByteReceivedFlag = zDPSW
12511: SerialWordBuffer = zMYCH
12512: ReadBitSequenceErrors = zRINONE
12513: ErrorFlagOnTapeRead = zBITC1
12514:
12515:
12516: ; Tape buffer format on tape (cf. TapeCreateFileBuffer):
12517: ; $00: type of block (cf. TAPE_BUFFER_TYPE_... constants above)
12518: ;
12519: ; if type of block == $01, $03, $04 or $05:
12520: ; $01: start address low
12521: ; $02: start address high
12522: ; $03: end address low
12523: ; $04: end address high
12524: ; $05 - $14: name of file
12525: ;
12526:
12527:
12528: .if CompileComputer = C64_GS
12529:
12530: ; .include "../c64/c64gs.inc"
12531: zFB = $fb
12532: zFC = $fc
12533:
12534: L0E00 := $0e00
12535:
12536:
12537: sec
12538: .byte ASM_BIT2
12539:
12540: C64GS_Init:
12541: clc
12542: ror zFB
12543: php
12544: sei
12545:
12546: lda #VICII_B_ControlReg1_RSEL + 3
12547: sta VIC + VICII_O_ControlReg1
12548:
12549: lda #$17
12550: sta VIC + VICII_O_MemControl
12551:
12552: ldx #0
12553:
12554: @ClearLoop:
12555: lda #0
12556: sta COLORRAM,x
12557: sta COLORRAM + $100,x
12558: sta COLORRAM + $200,x
12559: sta COLORRAM + $300,x
12560:
12561: lda #' '
12562: sta lVIDEORAM,x
12563: sta lVIDEORAM + $100,x
12564: sta lVIDEORAM + $200,x
12565: sta lVIDEORAM + $300,x
12566:
12567: inx
12568: bne @ClearLoop
12569:
12570: lda #<(lVIDEORAM + 83)
12571: sta zFC
12572: lda #>(lVIDEORAM + 83)
12573: sta zFC + 1
12574:
12575: ldx #$15
12576: @OuterLoop:
12577: ldy #$21
12578: lda #$A0
12579: @SpaceLoop:
12580: sta (zFC),y
12581: dey
12582: bne @SpaceLoop
12583:
12584: clc
12585: lda zFC
12586: adc #40
12587: sta zFC
12588: bcc :+
12589: inc zFC + 1
12590: :
12591: dex
12592: bne @OuterLoop
12593:
12594: lda #' '
12595: sta lVIDEORAM + 2 * 40 + 36
12596: sta lVIDEORAM + 22 * 40 + 4
12597:
12598: lda #14
12599: ldx #31
12600: @ColorLoop:
12601: sta COLORRAM + 2 * 40 + 4,x
12602: sta COLORRAM + 3 * 40 + 4,x
12603: sta COLORRAM + 4 * 40 + 4,x
12604: sta COLORRAM + 20 * 40 + 4,x
12605: sta COLORRAM + 21 * 40 + 4,x
12606: dex
12607: bpl @ColorLoop
12608:
12609: ldx #<(COLORRAM + 5 * 40 + 4)
12610: stx zFC
12611: ldx #>(COLORRAM + 5 * 40 + 4)
12612: stx zFC + 1
12613:
12614: ldx #$0f
12615: @ColorSetLoop:
12616: lda #$0e
12617: ldy #0
12618: sta (zFC),y
12619: ldy #31
12620: sta (zFC),y
12621:
12622: clc
12623: lda zFC
12624: adc #40
12625: sta zFC
12626: bcc :+
12627: inc zFC + 1
12628: :
12629: dex
12630: bne @ColorSetLoop
12631:
12632: bit zFB
12633: bpl GS_ExtraHandling
12634:
12635: lda #VICII_B_ControlReg1_DEN + VICII_B_ControlReg1_RSEL + 3
12636: sta VIC + VICII_O_ControlReg1
12637:
12638: plp
12639: rts
12640: ; --------------------
12641:
12642: GS_ExtraHandling:
12643: ldx #$00
12644:
12645: @Loop:
12646: lda GS_Data,X
12647: beq LF7D9
12648: sta lVIDEORAM + 129,x
12649: inx
12650: bpl @Loop
12651: ldx #7
12652:
12653: LF7D9:
12654: lda LF8E5,x
12655: sta lVIDEORAM + $3F8,x
12656: dex
12657: bpl LF7D9
12658:
12659: ; Copy sprites into locations
12660: ldx #$3f
12661: :
12662: lda LF90D,x
12663: sta L0E00,x
12664:
12665: lda LF94D,x
12666: sta L0E00 + $40,x
12667:
12668: lda LF98D,x
12669: sta L0E00 + $80,x
12670:
12671: lda LF9CD,x
12672: sta L0E00 + $C0,x
12673:
12674: lda LFA0D,x
12675: sta L0E00 + $100,x
12676:
12677: lda LFA4D,x
12678: sta L0E00 + $140,x
12679:
12680: lda LFA8D,x
12681: sta L0E00 + $180,x
12682:
12683: dex
12684: bpl :-
12685:
12686:
12687: lda #$04
12688: sta VIC + VICII_O_SprMCM
12689:
12690: lda #$73
12691: sta VIC + VICII_O_SprExpandX
12692:
12693: LF81B:
12694: ; copy another sprite
12695: ldx #$3f
12696: :
12697: lda LFACD,x
12698: sta L0E00 + $1C0,x
12699:
12700: dex
12701: bpl :-
12702:
12703:
12704: ldx #$0f
12705: :
12706: lda LF8ED,x
12707: sta VIC + VICII_O_SprBackColl,x
12708: lda LF8FD,x
12709: sta VIC,x
12710: dex
12711: bpl :-
12712:
12713: lda #VICII_B_ControlReg1_DEN + VICII_B_ControlReg1_RSEL + 3
12714: sta VIC + VICII_O_ControlReg1
12715:
12716: lda #$BE
12717: sta VIC + VICII_O_SprEnable
12718: jsr LF89F
12719:
12720: lda #$FC
12721: sta VIC + VICII_O_SprEnable
12722: jsr LF8AB
12723:
12724: lda #$BD
12725: sta VIC + VICII_O_SprEnable
12726: jsr LF8A8
12727:
12728: lda #$3D
12729: sta VIC + VICII_O_SprEnable
12730: jsr LF8A8
12731:
12732: LF85C:
12733: inc VIC + VICII_O_Sprite3Y
12734: jsr LF8AE
12735:
12736: ldx VIC + VICII_O_Sprite3Y
12737: cpx #$7c
12738: bcc LF85C
12739:
12740: jsr LF8A8
12741:
12742: ; overwrite sprite
12743: ldx #$3f
12744: :
12745: lda LFB0D,x
12746: sta L0E00 + $1C0,x
12747:
12748: dex
12749: bpl :-
12750:
12751: lda #$05
12752: sta VIC + VICII_O_Spr7Col
12753:
12754: lda #$7C
12755: sta VIC + VICII_O_SprEnable
12756: jsr LF8AB
12757:
12758: lda #$3E
12759: sta VIC + VICII_O_SprEnable
12760: jsr LF8A8
12761:
12762: lda #$BE
12763: sta VIC + VICII_O_SprEnable
12764: jsr LF89F
12765:
12766: lda #$04
12767: sta VIC + VICII_O_SprEnable
12768: jsr LF8A8
12769:
12770: jmp LF81B
12771:
12772: LF89F:
12773: jsr LF8A8
12774: jsr LF8A8
12775: jsr LF8A8
12776:
12777: LF8A8:
12778: ldy #40
12779: .byte ASM_BIT3
12780:
12781: LF8AB:
12782: ldy #$06
12783: .byte ASM_BIT3
12784:
12785: LF8AE:
12786: ldy #$02
12787:
12788: :
12789: jsr LF8BF
12790: dey
12791: bne :-
12792:
12793: jsr CheckCartridge
12794: beq LF8BC
12795: rts
12796: ; ---------------
12797:
12798: LF8BC:
12799: jmp ($FFFC) ; 6502 RESET vector
12800:
12801: LF8BF:
12802: bit VIC + VICII_O_ControlReg1
12803: bmi LF8BF
12804: :
12805: bit VIC + VICII_O_ControlReg1
12806: bpl :-
12807: rts
12808:
12809: GS_Data:
12810: .byte $c3, $8f, $8d, $8d, $8f, $84, $8f, $92
12811: .byte $85, $a0, $c3, $b6, $b4, $a0, $c7, $81
12812: .byte $8d, $85, $93, $a0, $d3, $99, $93, $94
12813: .byte $85, $8d, $00
12814:
12815: LF8E5:
12816: .byte $38, $39, $3a, $3b, $3c, $3d, $3e, $3f
12817:
12818: LF8ED:
12819: .byte $00, $06, $06, $01, $02, $03, $06, $01
12820: .byte $0f, $0f, $0a, $0f, $0f, $0f, $0f, $02
12821:
12822: LF8FD:
12823: .byte $e0, $7e, $e0, $7e, $43, $43, $94, $64
12824: .byte $90, $82, $60, $82, $e0, $7e, $ac, $a7
12825:
12826: LF90D:
12827: .byte $80, $00, $00
12828: .byte $80, $00, $00
12829: .byte $ff, $c0, $00
12830: .byte $c0, $40, $00
12831: .byte $c0, $40, $00
12832: .byte $c0, $40, $00
12833: .byte $c0, $c0, $00
12834: .byte $c1, $80, $00
12835: .byte $c3, $00, $00
12836: .byte $c6, $00, $60
12837: .byte $cc, $00, $90
12838: .byte $c8, $00, $90
12839: .byte $c8, $40, $90
12840: .byte $c8, $80, $90
12841: .byte $c9, $f8, $60
12842: .byte $c8, $80, $00
12843: .byte $c8, $46, $77
12844: .byte $d8, $09, $44
12845: .byte $f0, $09, $66
12846: .byte $80, $09, $44
12847: .byte $80, $06, $44
12848: .byte $00
12849: LF94D:
12850:
12851: .byte $80, $00, $40
12852: .byte $80, $00, $40
12853: .byte $f0, $00, $40
12854: .byte $d8, $40, $40
12855: .byte $c8, $80, $40
12856: .byte $c9, $f8, $40
12857: .byte $c8, $80, $00
12858: .byte $c8, $43, $24
12859: .byte $c8, $04, $b4
12860: .byte $c8, $04, $ac
12861: .byte $c8, $04, $a4
12862: .byte $cc, $03, $24
12863: .byte $c6, $00, $00
12864: .byte $c3, $00, $00
12865: .byte $c1, $80, $00
12866: .byte $c0, $80, $00
12867: .byte $c0, $80, $00
12868: .byte $c0, $80, $00
12869: .byte $ff, $80, $00
12870: .byte $80, $00, $00
12871: .byte $80, $00, $00
12872: .byte $00
12873: LF98D:
12874:
12875: .byte $00, $00, $00
12876: .byte $00, $00, $00
12877: .byte $00, $00, $00
12878: .byte $01, $54, $00
12879: .byte $05, $54, $00
12880: .byte $05, $54, $00
12881: .byte $15, $54, $00
12882: .byte $15, $02, $a8
12883: .byte $14, $02, $a0
12884: .byte $14, $02, $80
12885: .byte $14, $00, $00
12886: .byte $14, $03, $c0
12887: .byte $14, $03, $f0
12888: .byte $15, $03, $fc
12889: .byte $15, $54, $00
12890: .byte $05, $54, $00
12891: .byte $05, $54, $00
12892: .byte $01, $54, $00
12893: .byte $00, $00, $00
12894: .byte $00, $00, $00
12895: .byte $00, $00, $00
12896: .byte $00
12897:
12898: LF9CD:
12899:
12900: .byte $1f, $ff, $e0
12901: .byte $30, $00, $a0
12902: .byte $3f, $ff, $a0
12903: .byte $3f, $ff, $a0
12904: .byte $20, $00, $a0
12905: .byte $20, $00, $a0
12906: .byte $20, $00, $a0
12907: .byte $3f, $ff, $a0
12908: .byte $3f, $ff, $a0
12909: .byte $3f, $ff, $a0
12910: .byte $3f, $ff, $a0
12911: .byte $3f, $ff, $c0
12912: .byte $3f, $ff, $80
12913: .byte $00, $00, $00
12914: .byte $00, $60, $00
12915: .byte $00, $60, $00
12916: .byte $00, $60, $00
12917: .byte $03, $6c, $00
12918: .byte $01, $f8, $00
12919: .byte $00, $f0, $00
12920: .byte $00, $60, $00
12921: .byte $00
12922:
12923: LFA0D:
12924:
12925: .byte $00, $00, $00
12926: .byte $00, $00, $00
12927: .byte $bf, $ff, $7c
12928: .byte $bf, $ff, $7d
12929: .byte $7f, $fe, $f9
12930: .byte $60, $06, $fb
12931: .byte $df, $ed, $f3
12932: .byte $80, $1d, $f6
12933: .byte $ff, $fb, $e6
12934: .byte $ff, $fb, $ec
12935: .byte $ff, $f7, $cc
12936: .byte $ff, $f7, $d8
12937: .byte $ff, $ef, $98
12938: .byte $ff, $ef, $b0
12939: .byte $ff, $df, $30
12940: .byte $00, $00, $60
12941: .byte $ff, $ff, $60
12942: .byte $ff, $ff, $c0
12943: .byte $ff, $ff, $c0
12944: .byte $00, $00, $00
12945: .byte $00, $00, $00
12946: .byte $00
12947:
12948: LFA4D:
12949:
12950: .byte $00, $00, $00
12951: .byte $00, $00, $00
12952: .byte $03, $ff, $ff
12953: .byte $03, $ff, $ff
12954: .byte $07, $ff, $ff
12955: .byte $07, $ff, $ff
12956: .byte $0f, $ff, $fe
12957: .byte $0f, $ff, $fe
12958: .byte $1f, $ff, $fd
12959: .byte $1f, $ff, $fd
12960: .byte $3f, $ff, $fb
12961: .byte $3f, $ff, $fb
12962: .byte $7f, $ff, $f7
12963: .byte $7f, $ff, $f7
12964: .byte $ff, $ff, $ef
12965: .byte $80, $00, $00
12966: .byte $ff, $ff, $ff
12967: .byte $ff, $ff, $ff
12968: .byte $ff, $ff, $ff
12969: .byte $00, $00, $00
12970: .byte $00, $00, $00
12971: .byte $00
12972:
12973: LFA8D:
12974:
12975: .byte $80, $00, $00
12976: .byte $80, $00, $00
12977: .byte $fe, $00, $00
12978: .byte $c1, $00, $00
12979: .byte $c1, $00, $00
12980: .byte $c2, $00, $00
12981: .byte $c2, $00, $00
12982: .byte $c4, $00, $00
12983: .byte $c4, $00, $00
12984: .byte $c8, $00, $00
12985: .byte $c8, $00, $00
12986: .byte $c8, $00, $00
12987: .byte $c4, $00, $00
12988: .byte $c4, $00, $00
12989: .byte $c2, $00, $00
12990: .byte $c2, $00, $00
12991: .byte $c1, $00, $00
12992: .byte $c1, $00, $00
12993: .byte $fe, $00, $00
12994: .byte $80, $00, $00
12995: .byte $80, $00, $00
12996: .byte $00
12997:
12998: LFACD:
12999:
13000: .byte $00, $00, $00
13001: .byte $e0, $00, $38
13002: .byte $f0, $00, $78
13003: .byte $78, $00, $f0
13004: .byte $3c, $01, $e0
13005: .byte $1e, $03, $c0
13006: .byte $0f, $07, $80
13007: .byte $07, $8f, $00
13008: .byte $03, $de, $00
13009: .byte $01, $fc, $00
13010: .byte $00, $f8, $00
13011: .byte $00, $f8, $00
13012: .byte $01, $fc, $00
13013: .byte $03, $de, $00
13014: .byte $07, $8f, $00
13015: .byte $0f, $07, $80
13016: .byte $1e, $03, $c0
13017: .byte $3c, $01, $e0
13018: .byte $78, $00, $f0
13019: .byte $f0, $00, $78
13020: .byte $e0, $00, $38
13021: .byte $00
13022:
13023: LFB0D:
13024:
13025: .byte $00, $00, $00
13026: .byte $00, $00, $38
13027: .byte $00, $00, $78
13028: .byte $00, $00, $f0
13029: .byte $00, $01, $e0
13030: .byte $00, $03, $c0
13031: .byte $00, $07, $80
13032: .byte $00, $0f, $00
13033: .byte $00, $1e, $00
13034: .byte $00, $3c, $00
13035: .byte $60, $78, $00
13036: .byte $e0, $f0, $00
13037: .byte $e1, $e0, $00
13038: .byte $e3, $c0, $00
13039: .byte $e7, $80, $00
13040: .byte $ef, $00, $00
13041: .byte $fe, $00, $00
13042: .byte $fc, $00, $00
13043: .byte $f8, $00, $00
13044: .byte $f0, $00, $00
13045: .byte $e0, $00, $00
13046: .byte $00
13047:
13048: TapeIrqRead:
13049: TapeIrqWrite:
13050: TapeIrqWritePreamble:
13051: TapeWriteCompleteFile:
13052: TapeReadFileContents:
13053: TapePressRecordAndPlayOnTape:
13054: TapeReadTapeHeaderOfNextFile:
13055: TapeFindSpecificFile:
13056: TapePressPlayOnTape:
13057: TapeCreateFileBuffer:
13058: TapeGetPointer:
13059: TapeWriteCompleteBuffer:
13060: TapeReadNextBuffer:
13061: TAPE_INCREMENT_WRITE_POINTER:
13062:
13063: jmp KErrDeviceNotPresent
13064:
13065: ; FillUntil $FB8E, $00
13066: .segment "KERNAL_GS_8E"
13067:
13068: Copy_zSTAL_to_zSAL:
13069: lda zSTAL + 1
13070: sta zSAL + 1
13071: lda zSTAL
13072: sta zSAL
13073: rts
13074: ; -------------------------
13075:
13076: ; FillUntil $FC00, $00
13077: .segment "KERNAL_GS_00"
13078: .byte "COPYRIGHT 1990 COMMODORE ELECTRONICS LTD. ALL RIGHTS RESERVED."
13079:
13080: ; FillUntil $FC54, $00
13081: .segment "KERNAL_GS_54"
13082: TapeIrqEnd2:
13083: jmp NMI_End
13084: ; -------------------------
13085:
13086:
13087: ; FillUntil $FC93, $00
13088: .segment "KERNAL_GS_93"
13089:
13090:
13091: .else ; .if CompileComputer = C64_GS
13092:
13093: ; Find the next file on tape
13094: ;
13095: ; Output:
13096: ; C = 1 --> an error occurred
13097: ; C = 0 --> no error occurred
13098: ; Z = 1 --> EOT was found
13099: ; Z = 0 --> no EOT was found
13100: ; X = tape buffer type if no error occurred
13101: ;
13102: ; BUG:
13103: ; If the buffer could not be read at all, Z = 1 will be true if zVERCKK contains a 0.
13104: ; Thus, Z will not represent the status of the EOT.
13105: ;
13106: TapeReadTapeHeaderOfNextFile:
13107:
13108: @ReadNextHeader:
13109: lda zVERCKK ; remember verify (=1) or load (=0) flag
13110: pha ; onto stack
13111:
13112: jsr TapeReadNextBuffer ; get next buffer from tape
13113:
13114: pla
13115: sta zVERCKK ; restore verify (=1) or load (=0) flag
13116:
13117: bcs @Rts ; if an error occurred, we are done
13118:
13119: ldy #TAPE_BUFFER_OFFSET_TYPE ; start reading buffer at tape buffer type byte
13120: lda (zTAPE1),y ; get tape buffer type byte into A
13121:
13122: cmp #TAPE_BUFFER_TYPE_EOT ; is it of type "end-of-tape, EOT"?
13123: beq @Rts ; yes, we are done
13124:
13125: cmp #TAPE_BUFFER_TYPE_BASIC ; is it of type "BASIC program"?
13126: beq @FoundFile ; yes -> branch, process it
13127:
13128: cmp #TAPE_BUFFER_TYPE_ABSOLUTE ; is it of type "ABSOLUTE loading program, i.e., machine language program"?
13129: beq @FoundFile ; yes -> branch, process it
13130:
13131: cmp #TAPE_BUFFER_TYPE_DATA ; is it of type "DATA file, that is, no program"?
13132: bne @ReadNextHeader ; no -> branch, get next tape buffer from tape
13133:
13134: @FoundFile:
13135: tax ; remember tape buffer type in X
13136: bit zNSGFLG ; kernal message output policy: do we want to output "Loading", "Saving", "Verifying", "Found", ... messages?
13137: bpl @ClcRts ; no --> skip output, return without an error
13138:
13139: ldy #StrFound - LMESSAGES ; offset of "FOUND " message
13140: jsr OutputMessage ; output it
13141:
13142:
13143: ldy #TAPE_BUFFER_OFFSET_FILENAME ; offset of file name in buffer
13144:
13145: @OutputFilename:
13146: lda (zTAPE1),y ; get character from the file name
13147: jsr kCHROUT ; and output it (onto screen)
13148: iny ; proceed to next character
13149: cpy #TAPE_BUFFER_OFFSET_ENDFILENAME ; already at end of file name?
13150: bne @OutputFilename ; no -> branch, output next character
13151:
13152: .if CompileComputer >= C64_02
13153:
13154: ; introduce a delay so the user has the option to actually see the output
13155: ; This is necessary on the C64, as it disables the VIC-II output on tape operations.
13156: ; On the VIC-20, this is not the case, thus, the user can see the output anyway
13157:
13158: lda zTIME + 1 ; get the current time (middle byte)
13159: jsr TapeKeyOrTimeout ; delay the output until a timeout happens, or the user presses a key
13160: nop ; fill-byte
13161:
13162: .elseif CompileComputer >= C64_GENERAL
13163:
13164: ; on the C64-01, the delay was until some key was pressed.
13165: ; This is quite large and most probably the reason why the C64-02 KERNAL (cf. above)
13166: ; introduced a timeout
13167:
13168: @WaitKeyPress:
13169: lda zSTKEY ; get the status of the keyboard column at the time the keyboard was checked the last time
13170: cmp #$FF ; no key pressed?
13171: beq @WaitKeyPress ; yes -> branch -> loop until a key is pressed
13172: .endif
13173:
13174: @ClcRts:
13175: clc
13176: dey ; put Y to point at the last byte of the filename
13177: ; (thus, a subsequent INY will point it to the next data byte)
13178: @Rts: rts
13179:
13180:
13181: ; Create an empty tape buffer
13182: ; Input: A = type of tape buffer (one of TAPE_BUFFER_TYPE_...)
13183: ;
13184: TapeCreateFileBuffer:
13185: sta zPTR1 ; remember tape buffer type
13186:
13187: jsr TapeGetPointer ; get pointer to tape buffer into (X/Y) (unused, but flags important)
13188: bcc @Rts ; C = 0 -> tape buffer points to stack page or zero page -> quit, we do not want to overwrite essential data!
13189:
13190: lda zSTAL + 1 ; remember start address high
13191: pha
13192: lda zSTAL ; remember start address low
13193: pha
13194: lda zEAL + 1 ; remember end address high
13195: pha
13196: lda zEAL ; remember end address low
13197: pha
13198:
13199: ; Delete complete tape buffer, overwriting it with $20 (SPACE)
13200: ldy #lTBUFFR_SIZE - 1 ; size of buffer to erase
13201: lda #$20 ; empty buffer pattern
13202: :
13203: sta (zTAPE1),y
13204: dey
13205: bne :-
13206:
13207: lda zPTR1 ; store tape buffer type
13208: sta (zTAPE1),y ; into position $00
13209: iny
13210:
13211: lda zSTAL ; store start address low
13212: sta (zTAPE1),y ; into position $01
13213: iny
13214:
13215: lda zSTAL + 1 ; store start address high
13216: sta (zTAPE1),y ; into position $02
13217: iny
13218:
13219: lda zEAL ; store end address low
13220: sta (zTAPE1),y ; into position $03
13221: iny
13222:
13223: lda zEAL + 1 ; store end address high
13224: sta (zTAPE1),y ; into position $04
13225: iny
13226:
13227: sty zPTR2 ; remember write pointer
13228:
13229: ; store file name into buffer
13230:
13231: ldy #0 ; pointer into file name
13232: sty zPTR1
13233:
13234: @CopyFilename:
13235: ldy zPTR1 ; check if we reached end of file name
13236: cpy zFNLEN
13237: beq @CopyFilenameQuit ; yes -> quit loop
13238:
13239: lda (zFNADR),y ; get next file name character
13240: ldy zPTR2 ; (write pointer into tape buffer)
13241: sta (zTAPE1),y ; store file name character into tape buffer
13242:
13243: inc zPTR1 ; increment file name read pointer
13244: inc zPTR2 ; increment tape write pointer
13245: bne @CopyFilename ; (unconditional)
13246: ; -----------------------
13247:
13248: @CopyFilenameQuit:
13249: jsr TapeSetStartAndEndToBuffer ; set zSTAL/zSTAL + 1 to begin of tape buffer, and zEAL/zEAL+1 to end of it
13250:
13251: lda #TAPE_RIPRTY_69
13252: sta zRIPRTY ; Write TAPE_RIPRTY_69 * $100 pulses for the preamble
13253:
13254: jsr TapeWriteCompleteFileCustomPreamble ; write buffer onto tape, using the set preamble length
13255:
13256: tay ; remember A in Y (TODO why? What content does A have here?)
13257:
13258: ; restore start adn end addresses
13259: pla ; restore end address low
13260: sta zEAL
13261: pla ; restore end address high
13262: sta zEAL + 1
13263: pla ; restore start address low
13264: sta zSTAL
13265: pla ; restore start address high
13266: sta zSTAL + 1
13267:
13268: tya ; restore A from Y (TODO why? What content does A have here?)
13269: @Rts:
13270: rts
13271:
13272: ; Get tape buffer pointer into X/Y
13273: ;
13274: ; Return:
13275: ; C = 0 if tape buffer points into stack page or zero page
13276: ; C = 1 if not
13277: ;
13278: TapeGetPointer:
13279: ldx zTAPE1
13280: ldy zTAPE1 + 1
13281: cpy #>lBUF
13282: rts
13283:
13284: ; set zSTAL/zSTAL + 1 to begin of tape buffer, and zEAL/zEAL+1 to end of it
13285:
13286: TapeSetStartAndEndToBuffer:
13287: jsr TapeGetPointer ; get tape buffer pointer into x/y
13288:
13289: txa ; get address low
13290: sta zSTAL ; and store it as start address low
13291:
13292: clc
13293: adc #lTBUFFR_SIZE ; add size of tape buffer
13294: sta zEAL ; and store it as end address
13295:
13296: tya ; get address high
13297: sta zSTAL + 1 ; and store it as end address high
13298: adc #0 ; add carry from previous addition
13299: sta zEAL + 1 ; store the result as end address high
13300: rts
13301: ; -----------------
13302:
13303:
13304: ; Find a specific file on tape
13305: ;
13306: ; Input:
13307: ; zFNLEN: Length of the file name
13308: ; zFNADR/zFNADR+1: Pointer to file name (if zFNLEN != 0)
13309: ;
13310: ; Output:
13311: ; C = 1 --> an error occurred
13312: ; C = 0 --> no error occurred
13313: ; Z = 1 --> EOT was found
13314: ; Z = 0 --> no EOT was found
13315: ; X = tape buffer type if no error occurred
13316: ;
13317: ; BUG:
13318: ; If the buffer could not be read at all, Z = 1 will be true if zVERCKK contains a 0.
13319: ; Thus, Z will not represent the status of the EOT.
13320: ;
13321: TapeFindSpecificFile:
13322:
13323: @NextFile:
13324: jsr TapeReadTapeHeaderOfNextFile ; read in the next header on tape
13325: bcs @Rts ; C == 1 --> an error occurred --> branch --> quit (This will also happen if Z=1)
13326:
13327: ldy #TAPE_BUFFER_OFFSET_FILENAME ; offset of file name in tape buffer
13328: sty zPTR2
13329:
13330: ldy #0 ; offset of requested file name
13331: sty zPTR1
13332:
13333: @TestNextChar:
13334: cpy zFNLEN ; check if we reached the end of the file name
13335: beq @ClcRts ; yes -> branch, return with c = 0
13336:
13337: lda (zFNADR),y ; read in character from requested file name
13338: ldy zPTR2
13339: cmp (zTAPE1),y ; compare with character from file name in tape buffer
13340: bne @NextFile ; not equal -> file name differes -> branch -> check next file on tape
13341:
13342: inc zPTR1 ; increment pointers for file name characters
13343: inc zPTR2
13344:
13345: ldy zPTR1 ; make sure Y has the offset of the current character of the requested file name
13346: bne @TestNextChar ; uncond. branch
13347: ; ----------------------
13348:
13349: @ClcRts:
13350: clc ; mark: no error (i.e., we found the requested file)
13351: @Rts:
13352: rts
13353: ; -------------------
13354:
13355: ; increment the pointer into the tape buffer
13356: ;
13357: ; Return:
13358: ; Y = the tape pointer
13359: ;
13360: ; Z = 1 if the buffer is full / completely read
13361: ; Z = 0 otherwise
13362: ;
13363: TAPE_INCREMENT_WRITE_POINTER:
13364: jsr TapeGetPointer
13365: inc zBUFPNT ; increment the pointer into the tape buffer
13366: ldy zBUFPNT ; read i
13367: cpy #lTBUFFR_SIZE
13368: rts
13369:
13370: ; Wait for the PLAY key to be pressed
13371: ; If it is not, output "PRESS PLAY ON TAPE" and wait for it to be pressed
13372: ;
13373: TapePressPlayOnTape:
13374: jsr TapeCheckPlayPressed ; check if play key is pressed
13375: beq TapeClcRts ; yes -> branch, we're done
13376:
13377: ldy #StrPlay - LMESSAGES ; get offset of "PRESS PLAY ON TAPE" string to output the text
13378:
13379: TapePressPlayCommon:
13380:
13381: .if CompileComputer = C64_4064
13382: jsr OutputMessageIfAllowed ; output the text, only if allowed
13383: .else
13384: jsr OutputMessage ; output the text
13385: .endif
13386:
13387: ; Wait for PLAY key to be pressed
13388:
13389: @WaitForPlay:
13390: jsr TapeCheckForStop ; check if stop key was pressed. If so, do not return here, but to our caller!
13391:
13392: jsr TapeCheckPlayPressed ; has PLAY been pressed on the tape?
13393: bne @WaitForPlay ; no -> branch --> test again
13394:
13395: ldy #StrOk - LMESSAGES ; get offset of "OK" text to output it
13396:
13397: .if CompileComputer = C64_4064
13398: jmp OutputMessageIfAllowed ; output the text, only if allowed
13399: ; ------------------------------
13400: .else
13401: jmp OutputMessage ; output the text
13402: ; ------------------------------
13403: .endif
13404:
13405: ; Find out if the PLAY key
13406: ; is pressed on the tape
13407: ;
13408: ; This includes the combination of RECORD + PLAY
13409: ;
13410: ; Output:
13411: ; Z = 0: not pressed
13412: ; Z = 1: pressed
13413: ;
13414: TapeCheckPlayPressed:
13415: lda #TAPE_B_SENSE
13416: bit TAPE_REG_SENSE
13417: bne TapeClcRts
13418: bit TAPE_REG_SENSE
13419:
13420: TapeClcRts:
13421: clc
13422: rts
13423:
13424: ; Wait for the PLAY key to be pressed
13425: ; If it is not, output "PRESS RECORD & PLAY ON TAPE" and wait for it to be pressed
13426:
13427: TapePressRecordAndPlayOnTape:
13428: jsr TapeCheckPlayPressed ; check if play key is pressed
13429: beq TapeClcRts ; yes -> branch, we're done
13430:
13431: ldy #StrRecPlay - LMESSAGES ; get offset of "PRESS RECORD & PLAY ON TAPE" string to output the text
13432:
13433: bne TapePressPlayCommon ; (other than the text, this routine is identical to TapePressPlayOnTape. Thus, handle it over there)
13434: ; ---------------------------
13435:
13436:
13437: TapeReadNextBuffer:
13438: lda #0
13439: sta zSTATUS ; clear status, no error yet
13440:
13441: sta zVERCKK ; mark: we are loading (not verifying) from tape
13442:
13443: jsr TapeSetStartAndEndToBuffer ; set zSTAL/zSTAL + 1 to begin of tape buffer, and zEAL/zEAL+1 to end of it
13444:
13445: TapeReadFileContents:
13446: jsr TapePressPlayOnTape ; output "PRESS PLAY ON TAPE" and wait for the PLAY key to be pressed
13447: bcs LF86E ; C = 1 --> an error occurred (STOP was pressed) --> branch --> quit (this address is used as a trampoline, as the real target is too far away)
13448:
13449: sei
13450:
13451: ; clear some essential variables
13452:
13453: lda #$00
13454: sta zRIDATA
13455: sta zBITTS
13456: sta zCMPO
13457: sta zPTR1 ; or Pass1ReadErrors
13458: sta zPTR2 ; or Pass2ReadErrors
13459: sta zDPSW ; or ByteReceivedFlag
13460:
13461: lda #TAPE_REG_ICR_B_CASSREAD
13462: ldx #(VecTapeIrqRead - TapeIrqVectors) + 8 ; IRQ vector number to be set: Reading from tape
13463: bne LF875 ; everything but the IRQ vector is identical to recording, thus, use the code there
13464: ; ------------------------------
13465:
13466: ; write out the tape buffer to tape
13467: ; TODO
13468:
13469: TapeWriteCompleteBuffer:
13470: jsr TapeSetStartAndEndToBuffer ; set zSTAL/zSTAL + 1 to begin of tape buffer, and zEAL/zEAL+1 to end of it
13471:
13472: TapeWriteCompleteFile:
13473: lda #TAPE_RIPRTY_14
13474: sta zRIPRTY ; Write TAPE_RIPRTY_14 * TODO pulses for the preamble
13475: TapeWriteCompleteFileCustomPreamble:
13476: jsr TapePressRecordAndPlayOnTape ; output "PRESS RECORD & PLAY ON TAPE" and wait for the PLAY key to be pressed
13477: LF86E:
13478: bcs TapeSave_ClearIRQtmp_and_RTS ; C = 1 --> an error occurred (STOP was pressed) --> branch, quit
13479:
13480: sei
13481:
13482: lda #TAPE_REG_ICR_B_WR_TIMER ; start the write timer after setting the IRQ vector
13483: ldx #(VecTapeIrqWritePreamble - TapeIrqVectors) + 8 ; IRQ vector number to be set
13484:
13485: LF875:
13486: ldy #TAPE_REG_ICR_B_CLEARALL ; mask: clear all interrupt sources
13487: sty TAPE_REG_ICR ; clear all interrupt sources
13488:
13489: sta TAPE_REG_ICR ; and set the needed interrupt source (given in A)
13490:
13491: .if CompileComputer >= C64_GENERAL
13492: ; TODO: what?
13493: lda CIA1 + CIA_O_CRA
13494: ora #CIA_CRB_B_FORCE_LOAD | CIA_CRB_B_ONESHOT | CIA_CRB_B_START
13495: sta CIA1 + CIA_O_CRB
13496: and #CIA_CRA_B_50HZ | CIA_CRA_B_FORCE_LOAD | CIA_CRA_B_START
13497: sta lTODSNS
13498: .endif
13499:
13500: jsr LF0A4 ; TODO
13501:
13502: .if CompileComputer >= C64_GENERAL
13503: ; switch off display
13504: lda VIC + VICII_O_ControlReg1
13505: and # ~ VICII_B_ControlReg1_DEN
13506: sta VIC + VICII_O_ControlReg1
13507: .endif
13508:
13509: ; save IRQ vector in order to be able to restore it after the tape operation
13510: lda lCINV ; IRQ vector low byte
13511: sta lIRQTMP
13512: lda lCINV + 1 ; IRQ vector high byte
13513: sta lIRQTMP + 1
13514:
13515: jsr TapeSetIrqVector
13516:
13517: lda #$02
13518: sta zFSBLK ; set number of copies to write = 2.
13519:
13520: jsr TapeInitInputOutputOfByte ; prepare output of a byte by initialising zTSFCNT, zTBTCNT, zBITC1, zPRTY and zRINONE
13521:
13522:
13523: ; switch on the tape motor
13524: lda TAPE_REG_MOTOR
13525: and #TAPE_B_MOTOR_OFF_AND
13526: .if CompileComputer < C64_GENERAL
13527: ora #TAPE_B_MOTOR_OFF_OR
13528: .endif
13529: sta TAPE_REG_MOTOR
13530:
13531: sta zCAS1 ; mark: tape operation in progress.
13532:
13533: ; delay of TODO ms to allow tape motor for stable operation
13534: ldx #$FF
13535: @LF8B5:
13536: ldy #$FF
13537: @LF8B7:
13538: dey
13539: bne @LF8B7
13540: dex
13541: bne @LF8B5
13542:
13543: .if CompileComputer < C64_GENERAL
13544: sta TAPE_TIMER1_HI ; TODO why?
13545: .endif
13546: cli ; allow interrupts: From now on, writing to the tape is controlled by the IRQ routine only!
13547:
13548: ; Wait for the recording to have quit. For this, we compare the IRQ vector. When it is restored to be original vector
13549: ; stored in lIRQTMP/lIRQTMP+1, then the recording has finished.
13550: ;
13551: ; Also check for STOP, as the user might want to stop the recording prematurely.
13552: ;
13553: @WaitForFinish:
13554: lda lIRQTMP + 1 ; compare stored IRQ vector high
13555: cmp lCINV + 1 ; with current IRQ vector high
13556: clc ; (in case we finish the loop: mark "no error")
13557: beq TapeSave_ClearIRQtmp_and_RTS ; if they are the same, the recording has finished -> quit this loop
13558:
13559: jsr TapeCheckForStop ; check if stop key was pressed. If so, do not return here, but to our caller!
13560:
13561: ; (physically) check if RUN/STOP has been pressed
13562:
13563: .if CompileComputer >= C64_GENERAL
13564: ; on the C64, we just check for RUN/STOP. Note that the time is not updated while storing to TAPE
13565: jsr iUDTIM_CheckRunStop
13566: .else
13567: lda VIA2_IFR ; check interrupt flag register: Would T1 (the ticker) generate an event?
13568: and #VIA_IFR_B_T1
13569: beq @WaitForFinish ; no -> loop
13570: lda VIA1_T1CL ; clear the IFR state by reading T1
13571: jsr iUDTIM ; update time. This function also checks for RUN/STOP
13572: .endif
13573: jmp @WaitForFinish ; loop, wait for finishing
13574: ; ------------------
13575:
13576: ; Check for stop key
13577: ;
13578: ; This function checks if the STOP key has been pressed.
13579: ; If so, it does not return to its caller, but to the caller of its caller!
13580: ;
13581: TapeCheckForStop:
13582: jsr kSTOP ; check for stop key (returns: Z = 1 <--> STOP key was pressed)
13583: clc
13584: bne TapeSaveRts ; no stop key -> branch, we're done.
13585:
13586: jsr TapeStopMotor_and_InitTimer ; stop cass. motor, restore timer, restore IRQ vector
13587: sec ; mark: an error occurred
13588:
13589: ; remove return address of our caller from the stack
13590: pla
13591: pla
13592:
13593: TapeSave_ClearIRQtmp_and_RTS:
13594: ; mark: we do not have an IRQ vector to restore
13595: lda #$00
13596: sta lIRQTMP + 1 ; high byte of IRQ vector to restore (if any)
13597:
13598: TapeSaveRts:
13599: rts
13600: ; ------------------------
13601:
13602:
13603:
13604:
13605:
13606: TapeBitTimingAdjust:
13607: ; TODO what does this function do?
13608: ; Set expected tape timing. (according to some ROM description list)
13609:
13610: stx zCMPO + 1
13611:
13612: ; Calculate: A := zCMPO * 5
13613: lda zCMPO
13614: asl a ; multiply by 2
13615: asl a ; multiply by 2
13616: clc
13617: adc zCMPO ; add old value of zCMPO
13618:
13619: ; calculate: [zCMPO+1] := [zCMPO+1] + zCMPO * 5
13620: clc
13621: adc zCMPO + 1
13622: sta zCMPO + 1
13623:
13624: lda #$00
13625: bit zCMPO
13626: bmi @LF8F7
13627: rol a
13628: @LF8F7:
13629: asl zCMPO + 1
13630: rol a
13631: asl zCMPO + 1
13632: rol a
13633: tax
13634:
13635: @LF8FE:
13636: lda TAPE_TIMER1_LO
13637: cmp #TAPE_TIMER1_CONST
13638: bcc @LF8FE
13639: adc zCMPO + 1
13640: sta TAPE_TIMER2_LO
13641: txa
13642: adc TAPE_TIMER1_HI
13643: sta TAPE_TIMER2_HI
13644:
13645: .if CompileComputer >= C64_GENERAL
13646: lda lTODSNS
13647: sta CIA1 + CIA_O_CRA
13648: sta lTD1IRQ
13649: lda CIA1 + CIA_O_ICR
13650: and #CIA_ICR_B_FLAG
13651: beq @RetCli
13652: lda #>(@Ret-1)
13653: pha
13654: lda #<(@Ret-1)
13655: pha
13656: jmp FakeIRQ
13657: .endif
13658:
13659: @RetCli:
13660: cli
13661: @Ret:
13662: rts
13663:
13664: ;******************************************************************************
13665: ;
13666: ;; [[According to "The almost completely commented Vic 20 ROM disassembly.
13667: ;; V1.01 Lee Davison 2005-2012, amended by Ruud Baltissen; I relabeled the
13668: ;; cases from A B C D to X S M L:]]
13669: ;;
13670: ;; On Commodore computers, the streams consist of four kinds of symbols
13671: ;; that denote different kinds of low-to-high-to-low transitions on the
13672: ;; read or write signals of the Commodore cassette interface.
13673: ;;
13674: ;; X A break in the communications, or a pulse with very long cycle
13675: ;; time.
13676: ;;
13677: ;; S A short pulse, whose cycle time typically ranges from 296 to 424
13678: ;; microseconds, depending on the computer model.
13679: ;;
13680: ;; M A medium-length pulse, whose cycle time typically ranges from
13681: ;; 440 to 576 microseconds, depending on the computer model.
13682: ;;
13683: ;; L A long pulse, whose cycle time typically ranges from 600 to 744
13684: ;; microseconds, depending on the computer model.
13685:
13686: ;; [[According to the text in `Programming the PET/CBM' by Raeto West:]]
13687: ;; A byte is stored as a byte marker (a long wave followed by a medium wave: L-M)
13688: ;; followed by 9 bits: 8 data plus odd parity.
13689: ;; A 0-bit is short followed by long (S-L)
13690: ;; A 1-bit is long followed by short (L-S)
13691: ;; [[but the diagram on page -236- agrees with the below:]]
13692:
13693: ;; [[According to Keith Falkner in Compute! Issue #008, Jan 1981:]]
13694: ;; A 0-bit is short followed by medium (S-M)
13695: ;; A 1-bit is medium followed by short (M-S)
13696:
13697: ;; [[According to the VICE source code, tape/tap.c:]]
13698: ;; The tape preamble (leader) consists of at least 32 short pulses.
13699:
13700: ;; The tape preamble (leader) ends with the data bytes 89, 88, 87, .. 81,
13701: ;; or for the second copy 09, 08, 07, .. 01.
13702: ;;
13703: ;; A tape block is ended with L-S (instead of L-M for the next byte).
13704:
13705: ; read tape bits, IRQ routine
13706:
13707: ; read T2C which has been counting down from $FFFF. subtract this from $FFFF
13708:
13709: TapeIrqRead:
13710: ; IRQ4
13711: ; read out the timer value making sure that we do not read
13712: ; while a underflow occurs from the low byte to the high byte
13713:
13714: ldx TAPE_TIMER1_HI ; read in timer high byte
13715:
13716: ; calculate $FF - timer low byte
13717: ldy #$FF
13718: tya
13719: sbc TAPE_TIMER1_LO
13720:
13721: cpx TAPE_TIMER1_HI ; is the high byte still the same as above?
13722:
13723: bne TapeIrqRead ; no -> we just had an underflow -> retry
13724:
13725: stx zCMPO + 1 ; remember high byte of timer value
13726:
13727: tax ; X := $FF - low byte of timer value as calculated above
13728:
13729: ; restart timer with $FFFF (longest possible timer start address)
13730:
13731: sty TAPE_TIMER1_LO
13732: sty TAPE_TIMER1_HI
13733:
13734: .if CompileComputer >= C64_GENERAL
13735:
13736: ; restart the timer in oneshot mode
13737:
13738: lda #CIA_CRB_B_FORCE_LOAD | CIA_CRB_B_ONESHOT | CIA_CRB_B_START
13739: sta CIA1 + CIA_O_CRB
13740:
13741: ; read the ICR (the read clears it) and store it in lTRDTMP
13742:
13743: lda TAPE_REG_ICR
13744: sta lTRDTMP
13745:
13746: .endif
13747:
13748: tya ; now, calculate $FF - high byte of timer value
13749: sbc zCMPO + 1
13750: stx zCMPO + 1 ; here, zCMPO+1 / A contains ($FFFF - timer value)
13751:
13752: ; divide the timer value by 4
13753:
13754: lsr a ; shift right, dividing by 2 (hi)
13755: ror zCMPO + 1 ; (lo)
13756: lsr a ; shift right, deviding by 2 another time (hi)
13757: ror zCMPO + 1 ; ==> time of pulse / 4 (lo)
13758:
13759: lda zCMPO ; get tape timing constant min byte
13760: clc
13761: adc #$3C
13762:
13763: .if CompileComputer < C64_GENERAL
13764: bit VIA2_PA
13765: .endif
13766:
13767: cmp zCMPO + 1 ; compare with time of pulse / 4
13768: ; compare with ($FFFF - TAPE_TIMER1) >> 2
13769: bcs @LF9AC ; branch if min + $3C >= ($FFFF - T2C) >> 2
13770: ; or in other words, if the pulse is too short.
13771: ldx ByteReceivedFlag ; or zDPSW
13772: beq @LF969 ; no byte received yet
13773: jmp LFA60 ; byte received
13774: ; -------------------
13775:
13776: @LF969:
13777: ldx zTSFCNT ; bit counter (8->0)
13778: bmi @LF988 ; -> @LFA10
13779:
13780: ; ? Determine if the pulse is short, medium or long.
13781:
13782: ldx #$00 ; data bit may be 0
13783: adc #$30
13784: adc zCMPO ; add tape timing constant min byte
13785: cmp zCMPO + 1 ; compare with time of pulse / 4
13786: bcs @LF993 ; Is the pulse smaller? -> It is a SHORT pulse
13787: inx ; data bit may be 1
13788: adc #$26
13789: adc zCMPO ; add tape timing constant min byte
13790: cmp zCMPO + 1 ; compare with time of pulse / 4
13791: bcs @LF997 ; Is the pulse still smaller? -> it is a MEDIUM pulse
13792: adc #$2C
13793: adc zCMPO ; add tape timing constant min byte
13794: cmp zCMPO + 1 ; compare with time of pulse / 4
13795: bcc @LF98B ; pulse is too long
13796: @LF988:
13797: jmp @LFA10 ; Is the pulse smaller than the max long pulse?
13798: ; -> it is a LONG pulse
13799: ; -----------------
13800:
13801: @LF98B: ; pulse is too long
13802: lda zBITTS ; ? get EOI flag byte
13803: beq @LF9AC ; -> IrqEnd1
13804: sta ErrorFlagOnTapeRead ; or zBITC1 store non-zero
13805: bne @LF9AC ; always
13806:
13807: ; After a short pulse we need a medium one,
13808: ; or the other way around. That keeps the counter on 0.
13809: @LF993: ; pulse was SHORT
13810: inc ReadBitSequenceErrors ; or zRINONE
13811: bcs @LF999 ; always
13812: @LF997: ; pulse was MEDIUM
13813: dec ReadBitSequenceErrors ; or zRINONE
13814: @LF999:
13815: sec ; ?? adjust some timing parameter
13816: sbc #$13
13817: sbc zCMPO + 1 ; subtract time of pulse / 4
13818: adc zSVXT
13819: sta zSVXT
13820:
13821: lda zTBTCNT ; cycle counter (which half of the bit cycle is current)
13822: eor #$01
13823: sta zTBTCNT ; cycle counter
13824: beq @LF9D5 ; wrong half of the bit cycle? i.e. 2nd pulse
13825:
13826: stx zSCHAR ; distilled a bit (from ldx #$00 / inx above)
13827: ; takes the timing from the 1st pulse
13828:
13829: @LF9AC: ; don't store a bit
13830: lda zBITTS ; ? get EOI flag byte
13831: beq @IrqEnd1
13832: .if CompileComputer >= C64_GENERAL
13833: lda lTRDTMP ; saved TAPE_REG_ICR
13834: and #$01
13835: bne @LF9BC ; timer had no interrupt
13836: lda lTD1IRQ
13837: bne @IrqEnd1
13838: .else
13839: bit VIA2_IFR
13840: bvc @IrqEnd1 ; timer 1 no interrupt
13841: .endif
13842:
13843: @LF9BC: ; force restart for next bit
13844: lda #$00
13845: sta zTBTCNT ; cycle counter; there are 2 pulses per bit
13846: .if CompileComputer >= C64_GENERAL
13847: sta lTD1IRQ
13848: .endif
13849: lda zTSFCNT ; bit counter (8->0)
13850: bpl @LF9F7
13851: bmi @LF988
13852:
13853: @LF9C9:
13854: ldx #$A6
13855: jsr TapeBitTimingAdjust
13856: lda zPRTY ; parity
13857: bne @LF98B
13858: @IrqEnd1:
13859: jmp NMI_End
13860: ; ----------------------
13861:
13862: @LF9D5:
13863: lda zSVXT
13864: beq @LF9E0
13865: bmi @LF9DE
13866: dec zCMPO
13867: .byte ASM_BIT3
13868: @LF9DE:
13869: inc zCMPO
13870: @LF9E0:
13871: lda #$00
13872: sta zSVXT
13873: cpx zSCHAR
13874: bne @LF9F7
13875: txa
13876: bne @LF98B
13877: lda ReadBitSequenceErrors ; or zRINONE
13878: bmi @LF9AC
13879: cmp #$10
13880: bcc @LF9AC
13881: sta zSYNO
13882: bcs @LF9AC
13883: @LF9F7:
13884: txa
13885: eor zPRTY
13886: sta zPRTY
13887: lda zBITTS
13888: beq @IrqEnd1
13889: dec zTSFCNT ; bit counter (8->0)
13890: bmi @LF9C9
13891:
13892: lsr zSCHAR ; shift a bit into the collected byte
13893: ror SerialWordBuffer ; or zMYCH
13894: ldx #$DA
13895: jsr TapeBitTimingAdjust
13896: jmp NMI_End
13897: ; ----------------------
13898:
13899: @LFA10: ; found a LONG pulse -or- no more bits
13900: lda zSYNO
13901: beq @LFA18
13902: lda zBITTS
13903: beq @LFA1F
13904:
13905: @LFA18:
13906: lda zTSFCNT ; bit counter (8->0)
13907: .if CompileComputer >= C64_GENERAL
13908: bmi @LFA1F
13909: jmp @LF997
13910: .else
13911: bpl @LF997
13912: .endif
13913:
13914: @LFA1F:
13915: lsr zCMPO + 1
13916: lda #$93
13917: sec
13918: sbc zCMPO + 1
13919: adc zCMPO
13920: asl a
13921: tax
13922:
13923: jsr TapeBitTimingAdjust
13924: inc ByteReceivedFlag ; or zDPSW
13925: lda zBITTS
13926: bne @LFA44
13927: lda zSYNO
13928: beq @IrqEnd2
13929: sta ErrorFlagOnTapeRead ; or zBITC1
13930: lda #$00
13931: sta zSYNO
13932:
13933: lda #TAPE_REG_ICR_B_SET_3
13934: sta TAPE_REG_ICR
13935:
13936: sta zBITTS
13937:
13938: @LFA44:
13939: lda zSYNO
13940: sta zNXTBIT ; ?? indicate whether we got a bit
13941: beq @LFA53
13942: lda #$00
13943: sta zBITTS
13944:
13945: lda #TAPE_REG_ICR_B_UNSET_3
13946: sta TAPE_REG_ICR
13947:
13948: @LFA53:
13949: lda SerialWordBuffer ; or zMYCH
13950: sta ReadCharacterIn ; or zROPRTY
13951: lda ErrorFlagOnTapeRead ; or zBITC1
13952: ora ReadBitSequenceErrors ; or zRINONE
13953: sta ReadCharacterError ; or zRODATA
13954: @IrqEnd2:
13955: jmp NMI_End
13956: ; --------------------
13957:
13958:
13959: ; store tape chars ; FA57 in PET 3032
13960:
13961: LFA60: ; byte received
13962: jsr TapeInitInputOutputOfByte ; prepare input of a byte by initialising zTSFCNT, zTBTCNT, zBITC1, zPRTY and zRINONE; returns with A = 0
13963: sta ByteReceivedFlag ; zDPSW := 0
13964:
13965: ldx #$DA
13966: jsr TapeBitTimingAdjust
13967: lda zFSBLK ; number of blocks remaining to read
13968: beq @LFA70 ; if pass 1 was error free, don't really
13969: sta NrBlocksRemaining ; bother with the second pass ; or zINBIT
13970: @LFA70:
13971: lda #$0F
13972: bit zRIDATA ; 00=scan, $01-$0F=count, $40=load, $80=End of Tape marker
13973: bpl @LFA8D
13974: ; ---- $80 = EOT
13975: lda zNXTBIT ; ?? did we get a bit?
13976: bne @LFA86
13977:
13978: ldx zFSBLK ; nr of copies remaining to read
13979: dex
13980: bne @IrqEnd3
13981: lda #STATUS_TAPE_LONG_BLOCK
13982: jsr SetStatus
13983: bne @IrqEnd3
13984:
13985: @LFA86:
13986: lda #$00
13987: sta zRIDATA ; switch to scan
13988: @IrqEnd3:
13989: jmp NMI_End
13990: ; ------------------
13991:
13992: @LFA8D:
13993: bvs @LFAC0
13994: bne @LFAA9
13995:
13996: lda zNXTBIT ; ---- 00 = scan
13997: bne @IrqEnd3 ; ?? if we got a bit -> done
13998:
13999: lda ReadCharacterError ; or zRODATA
14000: bne @IrqEnd3 ; error? -> done
14001: lda NrBlocksRemaining ; or zINBIT
14002: lsr a
14003: lda ReadCharacterIn ; or zROPRTY
14004: bmi @LFAA3
14005: bcc @LFABA ; ?? 0 or 2 blocks remaining ; switch to EOT
14006: clc
14007: @LFAA3:
14008: bcs @LFABA ; switch to EOT
14009: and #$0F
14010: sta zRIDATA ; switch to count
14011:
14012: @LFAA9: ; ---- 01-0F = count
14013: dec zRIDATA ; count down 1
14014: bne @IrqEnd3
14015: lda #$40 ; when we have reached 00,
14016: sta zRIDATA ; switch to load
14017: jsr Copy_zSTAL_to_zSAL
14018: lda #$00
14019: sta zRIPRTY
14020: beq @IrqEnd3
14021: ; -------------------------
14022:
14023: @LFABA:
14024: lda #$80 ; switch to EOT
14025: sta zRIDATA
14026: bne @IrqEnd3
14027: @LFAC0: ; ---- $40 = load
14028: lda zNXTBIT
14029: beq @LFACE ; ?? if we got a bit, go on
14030:
14031: lda #STATUS_TAPE_SHORT_BLOCK
14032: jsr SetStatus
14033: lda #$00
14034: jmp @LFB4A ; switch to 00 scan
14035:
14036: @LFACE:
14037: jsr HasEndAddressBeenReached
14038: bcc @LFAD6 ; no
14039: jmp @LFB48 ; yes
14040: ; ------------------------
14041:
14042: @LFAD6: ; end address has not been reached
14043: ldx NrBlocksRemaining ; # blocks remaining, 1 or 2 ; or zINBIT
14044: dex
14045:
14046: beq @LFB08 ; go to second pass
14047:
14048: lda zVERCKK ; LOAD or VERIFY
14049: beq @LFAEB
14050:
14051: ldy #$00 ; VERIFY
14052: lda ReadCharacterIn ; or zROPRTY
14053: cmp (zSAL),y ; check if byte matches
14054: beq @LFAEB
14055:
14056: lda #$01 ; remember there was an error
14057: sta ReadCharacterError ; or zRODATA
14058: @LFAEB: ; LOAD
14059: lda ReadCharacterError ; or zRODATA
14060: beq @LFB3A ; just store this byte
14061:
14062: ldx #$3D ; max # of read errors we can store
14063: cpx Pass1ReadErrors ; or zPTR1
14064: bcc @LFB33 ; too many -> LOAD or VERIFY error
14065: ldx Pass1ReadErrors ; or zPTR1
14066: lda zSAL + 1 ; store high byte of error address
14067: sta lSTACK + 1,x
14068: lda zSAL ; and low byte
14069: sta lSTACK,x
14070: inx
14071: inx
14072: stx Pass1ReadErrors ; or zPTR1
14073: jmp @LFB3A ; store this byte anyway
14074: ; -----------------
14075:
14076:
14077: @LFB08: ; this is done during the second read pass
14078: ldx Pass2ReadErrors ; pass 2 read errors or zPTR2
14079: cpx Pass1ReadErrors ; pass 1 read errors or zPTR1
14080: beq @GotAllReadErrors ; processed all
14081:
14082: lda zSAL ; current address LO
14083: cmp lSTACK,x ; equal to address of next read error?
14084: bne @GotAllReadErrors
14085: lda zSAL + 1 ; also check current address HI
14086: cmp lSTACK + 1,x
14087: bne @GotAllReadErrors
14088: inc Pass2ReadErrors ; move over to next address of a read error
14089: inc Pass2ReadErrors ; or zPTR2
14090: lda zVERCKK ; check if LOAD or VERIFY
14091: beq @LFB2F
14092:
14093: lda ReadCharacterIn ; do a VERIFY ; or zROPRTY
14094: ldy #0
14095: cmp (zSAL),y ; 2nd pass matches memory -> ok
14096: beq @GotAllReadErrors
14097: iny
14098: sty ReadCharacterError ; read character error flag ; or zRODATA
14099: @LFB2F:
14100: lda ReadCharacterError ; or zRODATA
14101: beq @LFB3A
14102: @LFB33: ; unrecoverable read error, or, VERIFY error
14103: lda #STATUS_VERIFY
14104: jsr SetStatus
14105: bne @GotAllReadErrors
14106:
14107: @LFB3A: ; just (maybe) store the byte that was read
14108: lda zVERCKK ; 1 = VERIFY
14109: bne @GotAllReadErrors
14110: tay
14111: lda ReadCharacterIn ; or zROPRTY
14112: sta (zSAL),y ; store the byte as read from tape into memory
14113: @GotAllReadErrors:
14114: jsr Increment_zSAL_Address
14115: bne @IrqEnd4
14116: @LFB48:
14117: lda #$80 ; switch to EOT
14118: @LFB4A:
14119: sta zRIDATA ; switch reading mode
14120:
14121: .if CompileComputer >= C64_GENERAL
14122: sei
14123: ldx #TAPE_REG_ICR_B_UNSET_3
14124: stx TAPE_REG_ICR
14125:
14126: ldx TAPE_REG_ICR
14127: .endif
14128:
14129: ldx zFSBLK ; nr of blocks to read (or write)
14130: dex
14131: bmi @LFB5C
14132: stx zFSBLK ; only decrement if not negative
14133: @LFB5C:
14134: dec NrBlocksRemaining ; or zINBIT
14135: beq @LFB68 ; finish up by calculating the parity
14136:
14137: lda Pass1ReadErrors ; or zPTR1
14138: bne @IrqEnd4 ; more errors? keep going
14139: sta zFSBLK ; no errors? 0 blocks to read (or write)
14140: beq @IrqEnd4 ; unconditional branch
14141: ; --------------
14142:
14143: ; Finish up the loading by checking the parity byte
14144:
14145: @LFB68:
14146: jsr TapeStopMotor_and_InitTimer ; stop cass. motor, restore timer, restore IRQ vector
14147:
14148: ; Calculate and check parity (just a XOR)
14149: jsr Copy_zSTAL_to_zSAL
14150: ldy #$00
14151: sty zRIPRTY ; clear to 00
14152:
14153: @LFB72:
14154: lda (zSAL),y
14155: eor zRIPRTY ; xor another byte into it
14156: sta zRIPRTY
14157: jsr Increment_zSAL_Address
14158: jsr HasEndAddressBeenReached
14159: bcc @LFB72 ; and another byte
14160: lda zRIPRTY
14161: eor ReadCharacterIn ; mix in final parity byte ; or zROPRTY
14162: beq @IrqEnd4
14163:
14164: lda #STATUS_TAPE_CHKSUM_ERR ; not equal -> error
14165: jsr SetStatus
14166: @IrqEnd4:
14167: jmp NMI_End
14168: ; --------------------
14169:
14170: Copy_zSTAL_to_zSAL:
14171: lda zSTAL + 1
14172: sta zSAL + 1
14173: lda zSTAL
14174: sta zSAL
14175: rts
14176: ; -------------------------
14177:
14178: ; prepare input or output of a byte by initialising zTSFCNT, zTBTCNT, zBITC1, zPRTY and zRINONE
14179: ;
14180: ; Return:
14181: ; A = 0
14182:
14183: TapeInitInputOutputOfByte:
14184: lda #$08 ; set number of bits to be output to 8
14185: sta zTSFCNT
14186:
14187: lda #$00
14188: sta zTBTCNT ; mark: the bit to output is the real bit, not the inverted one
14189:
14190: sta zBITC1 ; clear bit-counter that determines if the start or the end of a pulse have been reached
14191:
14192: sta zPRTY ; clear parity
14193:
14194: sta zRINONE ; set: the start bit ("1") has not yet been written
14195:
14196: rts
14197: ; --------------------
14198:
14199: TapeSetTimerAndWriteEdgeForBit:
14200: lda zROPRTY ; get data byte to be output
14201: lsr a ; get lowest bit into C
14202: lda #TAPE_TIMER_CONSTANT_BIT0 ; preset $60 as timer value in case the lowest bit is 0
14203: bcc TapeSetTimerLowAndWriteEdge ; C = 0 --> branch, use $60 constant
14204:
14205: TapeSetTimerAndWriteEdgeFor1:
14206: lda #TAPE_TIMER_CONSTANT_BIT1 ; set $B0 as timer value because the lowest bit is 1
14207:
14208: TapeSetTimerLowAndWriteEdge:
14209: ldx #$00 ; high byte of timer value
14210:
14211: TapeSetTimerAndWriteEdge:
14212: sta TAPE_TIMER1_LO ; set timer low
14213: stx TAPE_TIMER1_HI ; and high
14214:
14215: .if CompileComputer >= C64_GENERAL
14216: lda TAPE_REG_ICR ; clear ICR by reading it
14217:
14218: lda #CIA_CRB_B_FORCE_LOAD | CIA_CRB_B_ONESHOT | CIA_CRB_B_START
14219: sta CIA1 + CIA_O_CRB ; program timer B as oneshot, starting it
14220: .endif
14221:
14222: ; change the level of the CASS WRITE line
14223:
14224: lda TAPE_REG_WRITE
14225: eor #TAPE_B_WRITE
14226: sta TAPE_REG_WRITE
14227:
14228: and #TAPE_B_WRITE ; determine the new level
14229: rts
14230: ; -----------------------
14231:
14232: LFBC8:
14233: ; TODO
14234: sec
14235: .if CompileComputer >= C64_GENERAL
14236: ror zRODATA
14237: .else
14238: ror zSAL + 1
14239: .endif
14240: bmi TapeIrqEnd1 ; (uncond. branch)
14241: ; ------------------------
14242:
14243: TapeIrqWrite:
14244: ; IRQ2
14245: lda zBITC1
14246: bne @LFBE3
14247:
14248: lda #<TAPE_TIMER_CONSTANT_WRITE
14249: ldx #>TAPE_TIMER_CONSTANT_WRITE
14250: jsr TapeSetTimerAndWriteEdge
14251: bne TapeIrqEnd1 ; if the write bit is 1, the pulse has just started -> branch -> quit IRQ, we only proceed when the pulse has ended
14252:
14253: inc zBITC1 ; mark: we have already written the bit above
14254:
14255: ; TODO ???
14256:
14257: .if CompileComputer >= C64_GENERAL
14258: lda zRODATA
14259: .else
14260: lda zSAL + 1
14261: .endif
14262: bpl TapeIrqEnd1
14263:
14264: jmp TapeBlockCompletelyWritten ; the complete block has been written
14265: ; ---------------------------
14266:
14267: @LFBE3:
14268: ; write a "1" bit
14269:
14270: lda zRINONE ; have we already written the bit?
14271: bne @LFBF0 ; yes -> branch, write data bit
14272:
14273: jsr TapeSetTimerAndWriteEdgeFor1 ; set a pulse for a "1" bit
14274: bne TapeIrqEnd1 ; if the write bit is 1, the pulse has just started -> branch -> quit IRQ, we only proceed when the pulse has ended
14275:
14276: inc zRINONE ; mark: The "1" bit has already been written
14277: bne TapeIrqEnd1 ; (uncond. branch: If we are here, zRINONE was zero, thus, it cannot be there here after the inc)
14278: ; ---------------------------
14279:
14280: @LFBF0:
14281: jsr TapeSetTimerAndWriteEdgeForBit ; set the timer for a "1" or "0" bit, depending upon if the bit to be output (zROPRTY.0) is 1 or 0.
14282: bne TapeIrqEnd1 ; if the write bit is 1, the pulse has just started -> branch -> quit IRQ, we only proceed when the pulse has ended
14283:
14284: ; after outputting the "0" or "1" bit, the routine
14285: ; also outputs the inverse of it ("1" or "0", respectively)
14286:
14287: ; Here, at this place, zTBTCNT is used to find out if the first,
14288: ; original bit has been sent (= $00), or if the inverted one has
14289: ; been sent (= $01)
14290:
14291: lda zTBTCNT
14292: eor #$01
14293: sta zTBTCNT ; invert zTBTCNT.0
14294:
14295: beq TapeBitWritten ; if zTBTCNT == $00 here, then the second, inverted bit has been sent -> branch, the bit is completely written
14296:
14297: ; invert data bit that was just output (zROPRTY.0)
14298: ; Thus, the inverted bit is output the next time
14299:
14300: lda zROPRTY
14301: eor #$01
14302: sta zROPRTY
14303:
14304: ; calculate the parity (with the inverted bit)
14305: and #$01 ; extract the (inverted) data bit
14306: eor zPRTY ; and eor it with parity (TODO?)
14307: sta zPRTY
14308:
14309: TapeIrqEnd1:
14310: jmp NMI_End
14311: ; -------------------
14312:
14313: TapeBitWritten:
14314: ; the bit has been written (in non-inverted and inverted form)
14315:
14316: lsr zROPRTY ; extract next bit to be output
14317:
14318: dec zTSFCNT ; decrement number of bits to be output
14319:
14320: lda zTSFCNT ; still bits to be output?
14321: beq TapeOutputParityBit ; no -> branch, output the parity bit
14322:
14323: bpl TapeIrqEnd1 ; no. of bits to be output > 0 --> still bits to be output, end IRQ here
14324:
14325: LFC16:
14326: ; when we reach here, all bits of the current byte have been output
14327: ; thus, advance to the next byte
14328:
14329: jsr TapeInitInputOutputOfByte ; prepare output of a byte by initialising zTSFCNT, zTBTCNT, zBITC1, zPRTY and zRINONE
14330:
14331: cli ; TODO: timing is not that critical anymore (we have a start bit, thus, a delay is not fatal)
14332:
14333: ; TODO ??? Have we reached end of current byte?
14334:
14335: ; TODO follow logic of this code part
14336:
14337: lda zCNTDN ; countdown at end of preamble
14338: beq @LFC30 ; zero -> branch, proceed to next byte and check if end address has been reached
14339:
14340: ; We're at the end of the preamble, write 89, 88, or 09, 08, ... etc
14341:
14342: ldx #0
14343: stx zSCHAR ; clear check byte
14344:
14345: dec zCNTDN
14346:
14347: ldx zFSBLK ; is this the first copy of the tape file?
14348: cpx #$02
14349: bne @LFC2C ; no -> branch, output TODO ???
14350:
14351: ora #$80 ; or in 1st copy, 89, 88, 87...
14352:
14353: @LFC2C:
14354: sta zROPRTY ; byte to write
14355: bne TapeIrqEnd1 ; (uncond. branch)
14356: ; ------------------
14357:
14358: @LFC30:
14359: jsr HasEndAddressBeenReached ; check if the last byte has been written (the end address has been reached)
14360: bcc @ProcessNextByte ; no -> branch, process the next byte
14361:
14362: bne LFBC8 ; has the extra check byte been written -> branch -> TODO
14363:
14364: inc zSAL + 1 ; increment start address: this way, the "bne" above will branch the next time!
14365:
14366: lda zSCHAR ; get the check byte
14367: sta zROPRTY ; and put it as output byte
14368:
14369: bcs TapeIrqEnd1 ; (uncond. branch)
14370: ; -------------------------
14371:
14372: @ProcessNextByte:
14373: ldy #0
14374: lda (zSAL),y ; read next byte to process
14375: sta zROPRTY ; and store it as new byte to output
14376:
14377: eor zSCHAR ; XOR it with the check byte
14378: sta zSCHAR ; and store it
14379:
14380: jsr Increment_zSAL_Address ; increment pointer to next byte to write
14381:
14382: bne TapeIrqEnd1 ; if we do not want to write $FFFF, this is an uncond. branch
14383: ; BUG: If we write the KERNAL onto tape, we will fall through! (TODO: Really)
14384: ; ---------------------------
14385:
14386: TapeOutputParityBit:
14387: lda zPRTY
14388: eor #$01
14389: sta zROPRTY
14390:
14391: TapeIrqEnd2:
14392: jmp NMI_End
14393: ; -------------------------
14394:
14395: TapeBlockCompletelyWritten:
14396: ; the block has been completely written to the tape
14397:
14398: ; found out if we still have a copy to be written
14399:
14400: dec zFSBLK ; decrement number of copies still to write
14401: bne :+ ; have we reached 0? --> skip next instruction --> do not switch off the tape motor
14402:
14403: jsr TapeSwitchOffMotor ; switch off the tape motor
14404:
14405: : lda #$50
14406: sta zINBIT ; TODO: Write "shorter" preamble
14407:
14408: ; set IRQ vector to: write preamble
14409:
14410: ldx #(VecTapeIrqWritePreamble - TapeIrqVectors) + 8
14411: sei
14412: jsr TapeSetIrqVector
14413:
14414: bne TapeIrqEnd2 ; (uncond. branch)
14415: ; -------------------------------------
14416:
14417:
14418: ; This IRQ routine is called when the system wants to write a preamble to the tape
14419:
14420: TapeIrqWritePreamble:
14421: lda #TAPE_TIMER_CONSTANT_PREAMBLE
14422: jsr TapeSetTimerLowAndWriteEdge
14423:
14424: bne TapeIrqEnd2 ; if the write bit is 1, the pulse has just started -> branch -> quit IRQ, we only proceed when the pulse has ended
14425:
14426: ; if we reach here, the tape write bit is 0.
14427: ; We have just written a pulse of length TAPE_TIMER_CONSTANT_PREAMBLE
14428:
14429: dec zINBIT ; decrement number of bits to write
14430: bne TapeIrqEnd2 ; not yet 0 --> branch --> quit IRQ, we're done for now (write more bits)
14431:
14432: jsr TapeInitInputOutputOfByte ; prepare output of a byte by initialising zTSFCNT, zTBTCNT, zBITC1, zPRTY and zRINONE
14433:
14434: dec zRIPRTY ; decrement number of "bytes" (of zINBIT bits each, that is, $100 bits each!) to write
14435: bpl TapeIrqEnd2 ; not yet negative -> branch, we're done for now (write more bytes)
14436:
14437: ldx #(VecTapeIrqWrite - TapeIrqVectors) + 8 ; change the IRQ routine to the write routine itself
14438: jsr TapeSetIrqVector
14439:
14440: cli
14441:
14442: inc zRIPRTY ; set number of bytes back to 0
14443:
14444: lda zFSBLK ; check number of copies still to write
14445: beq TapeAllCopiesWritten ; 0 copies to write --> branch, quit writing to tape
14446:
14447: jsr Copy_zSTAL_to_zSAL ; TODO copy the tape start address to the start address
14448:
14449: ldx #$09 ; Leader (preamble) finishes with 89, 88, .. 81
14450: ; for 2nd copy: 09, 08, ... 01
14451: stx zCNTDN
14452:
14453: .if CompileComputer >= C64_GENERAL
14454: stx zRODATA
14455: .endif
14456: bne LFC16 ; always ; switch to writing bytes
14457: ; -----------------------
14458:
14459: .endif ; .if CompileComputer = C64_GS
14460:
14461: ; stop cass. motor, restore timer, restore IRQ vector
14462: ;
14463: ; Remark:
14464: ; Flags stay unchanged!
14465: ;
14466: TapeStopMotor_and_InitTimer:
14467: php ; remember I status
14468: sei ; make sure we do not get interrupted by an IRQ
14469:
14470: .if CompileComputer >= C64_GENERAL
14471: ; enable display
14472: lda VIC + VICII_O_ControlReg1
14473: ora #VICII_B_ControlReg1_DEN
14474: sta VIC + VICII_O_ControlReg1
14475: .endif
14476:
14477: jsr TapeSwitchOffMotor ; switch tape motor off
14478:
14479: lda #TAPE_REG_ICR_B_CLEARALL ; clear all interrupt sources
14480: sta TAPE_REG_ICR
14481:
14482: .if CompileComputer < C64_GENERAL
14483: ; TODO document
14484: lda #$F7
14485: sta VIA2_PB
14486: lda #VIA_ACR_B_T1_CONTROL_FREERUN
14487: sta VIA2_ACR
14488: .endif
14489:
14490: jsr iIOINIT_TIMER ; initialise timers (part of iIOINIT)
14491:
14492: ; restore interrupt vector
14493: ;
14494: lda lIRQTMP + 1 ; get high address of stored IRQ vector
14495: beq :+ ; = 0 --> no IRQ vector was stored -> branch, skip restoring
14496: sta lCINV + 1 ; restore IRQ vector high
14497:
14498: lda lIRQTMP ; stored IRQ vector low
14499: sta lCINV ; restore IRQ vector low
14500: :
14501: plp ; restore I status
14502: rts
14503: ; -----------------------
14504:
14505: TapeAllCopiesWritten:
14506: jsr TapeStopMotor_and_InitTimer ; stop cass. motor, restore timer, restore IRQ vector --> complete END the tape IRQ routines.
14507: beq TapeIrqEnd2 ; (uncond. branch, as TapeStopMotor_and_InitTimer restores the flags, and we are only called via a BEQ)
14508: ; -------------------------
14509:
14510: ; set IRQ vector according to X
14511: ; X must be calculated rather "weird": It is done as ldx #(VecNAME - TapeIrqVectors) + 8 if VecNAME is to be set.
14512: TapeSetIrqVector:
14513: lda TapeIrqVectors - 8,x ; get low byte of vector
14514: sta lCINV ; and store it as IRQ vector low
14515: lda TapeIrqVectors - 8 + 1,x ; get high byte of vector
14516: sta lCINV + 1 ; and store it as IRQ vector high
14517: rts
14518: ; -------------------
14519:
14520: ; Switch off the tape motor
14521: ;
14522: TapeSwitchOffMotor:
14523: lda TAPE_REG_MOTOR
14524: ora #TAPE_B_MOTOR_ON_ALL
14525: sta TAPE_REG_MOTOR
14526: rts
14527:
14528: ; Check if the end address has been reached
14529: ; in writing
14530: ;
14531: ; Return:
14532: ; C = 0: End address has not yet been reached
14533: ; C = 1: End address has been reached
14534: ;
14535: ; This routine calculated zSAL/zSAL+1 - zEAL/zEAL+1.
14536: ; If zSAL/zSAL+1 is smaller than zEAL/zEAL+1, we end with C=0, as there was a "borrow".
14537: ; Otherwise (equal or bigger), C=1 as no borrow occurred.
14538: ;
14539: ; This routine is also used in fileio.a65 for IEC transfers
14540: ;
14541: HasEndAddressBeenReached:
14542: sec
14543: lda zSAL
14544: sbc zEAL
14545: lda zSAL + 1
14546: sbc zEAL + 1
14547: rts
14548:
14549: ; Increment the zSAL/zSAL+1 address
14550: ; That is, this routine proceeds the pointer to the next character to be written/read.
14551: ;
14552: ; This routine is also used in fileio.a65 for IEC transfers
14553: ;
14554: Increment_zSAL_Address:
14555: inc zSAL
14556: bne @Rts
14557: inc zSAL + 1
14558: @Rts:
14559: rts
14560: ; ------------------------
14561:
14562: ; .include "../kernal/init.a65"
14563: ; This is the RESET routine that is called when a hardware RESET occurs.
14564: ; After determining if an expansion cartridge is available - in this case,
14565: ; this routine aborts and calls the RESET routine of the cartridge -
14566: ; it has to set up the I/O areas and all memory. Afterwards, it calls
14567: ; the BASIC through the BASIC cold start vector
14568: ;
14569: RESET:
14570: ldx #<$01FF
14571: sei ; no interrupts are allowed (we have not set it up yet)
14572: txs ; SP = $FF, so we have maximum stack space
14573: cld ; make sure we are in binary mode, not in decimal mode
14574: jsr CheckCartridge ; check for an expansion cartridge
14575: bne @NoCartridge ; no cartridge -> jump
14576: jmp (CART_RESET) ; we have a cartridge, exit and call the RESET routine of the cart
14577:
14578: ; in case we have no cartridge, proceed with initialisation
14579:
14580: @NoCartridge:
14581: .if CompileComputer >= C64_GENERAL
14582: stx VIC + VICII_O_ControlReg2 ; switch to 38 cols mode
14583: ; this seems to be cosmetic only. If the C64 already has a visible
14584: ; screen, one can clearly see that the RESET makes the left and
14585: ; right border smaller on a RESET and/or JSR $FCE2 (SYS 64738)
14586: jsr iIOINIT ; initialise the I/O area
14587: .endif
14588:
14589: jsr iRAMTAS ; clear memory and determine RAM areas
14590: jsr iRESTOR ; restore the KERNEL jump vectors
14591: .if CompileComputer < C64_GENERAL
14592: jsr iIOINIT ; initialise the I/O area
14593: .endif
14594:
14595: ; Initialise the video
14596: .if CompileComputer >= C64_02
14597: jsr iCINT_WITH_PAL_NTSC ; initialise the video. Also make sure to determine PAL or NTSC, and adjust the timings accordingly
14598: .else
14599: jsr iCINT ; initialise the video.
14600: .endif
14601: cli
14602: jmp (bRESTART) ; call BASIC
14603:
14604: ; Check if a cartridge is available.
14605: ; For this, it checks for the "cartridge magic"
14606: ; If there is a cartridge, this routine returns with Z=1
14607: ; else with Z=0
14608: ;
14609: CheckCartridge:
14610: ldx #END_Copy_CARTRIDGE_MAGIC - Copy_CARTRIDGE_MAGIC
14611: @CheckNext:
14612: lda Copy_CARTRIDGE_MAGIC - 1,x
14613: cmp CART_MAGIC - 1,x
14614: bne @NoCart
14615: dex
14616: bne @CheckNext
14617: @NoCart:
14618: rts
14619:
14620: ; Copy of the cartridge magic
14621: ; CheckCartridge checks agains these characters
14622: ; to find out if a cartridge is available.
14623: ;
14624: Copy_CARTRIDGE_MAGIC:
14625: .if CompileComputer >= C64_GENERAL
14626: asc80 "CBM"
14627: .byte "80"
14628: .else
14629: .byte "A0"
14630: asc80 "CBM"
14631: .endif
14632: END_Copy_CARTRIDGE_MAGIC:
14633:
14634: ;
14635: ; B-23. Function Name: RESTOR
14636: ;
14637: ; Purpose: Restore default system and interrupt vectors
14638: ; Call address: $FF8A (hex) 65418 (decimal)
14639: ; Preparatory routines: None
14640: ; Error returns: None
14641: ; Stack requirements: 2
14642: ; Registers affected: A, X, Y
14643: ;
14644: ; Description: This routine restores the default values of all system
14645: ; vectors used in KERNAL and BASIC routines and interrupts. (See the Memory
14646: ; Map for the default vector contents). The KERNAL VECTOR routine is used
14647: ; to read and alter individual system vectors.
14648: ;
14649: ; How to Use:
14650: ; 1) Call this routine.
14651: ;
14652: ; EXAMPLE:
14653: ; JSR RESTOR
14654: ;
14655: iRESTOR:
14656: ldx #<Copy_of_lCINV
14657: ldy #>Copy_of_lCINV
14658: clc
14659:
14660: ; B-39. Function Name: VECTOR
14661: ;
14662: ; Purpose: Manage RAM vectors
14663: ; Call address: $FF8D (hex) 65421 (decimal)
14664: ; Communication registers: X, Y
14665: ; Preparatory routines: None
14666: ; Error returns: None
14667: ; Stack requirements: 2
14668: ; Registers affected: A, X, Y
14669: ;
14670: ;
14671: ; Description: This routine manages all system vector jump addresses
14672: ; stored in RAM. Calling this routine with the the accumulator carry bit
14673: ; set stores the current contents of the RAM vectors in a list pointed to
14674: ; by the X and Y registers. When this routine is called with the carry
14675: ; clear, the user list pointed to by the X and Y registers is transferred
14676: ; to the system RAM vectors. The RAM vectors are listed in the memory map.
14677: ;
14678: ; +-----------------------------------------------------------------------+
14679: ; | NOTE: This routine requires caution in its use. The best way to use it|
14680: ; | is to first read the entire vector contents into the user area, alter |
14681: ; | the desired vectors, and then copy the contents back to the system |
14682: ; | vectors. |
14683: ; +-----------------------------------------------------------------------+
14684: ;
14685: ; How to Use:
14686: ;
14687: ; READ THE SYSTEM RAM VECTORS
14688: ;
14689: ; 1) Set the carry.
14690: ; 2) Set the X and y registers to the address to put the vectors.
14691: ; 3) Call this routine.
14692: ;
14693: ; LOAD THE SYSTEM RAM VECTORS
14694: ;
14695: ; 1) Clear the carry bit.
14696: ; 2) Set the X and Y registers to the address of the vector list in RAM
14697: ; that must be loaded.
14698: ; 3) Call this routine.
14699: ;
14700: ;
14701: ; EXAMPLE:
14702: ; ;CHANGE THE INPUT ROUTINES TO NEW SYSTEM
14703: ; LDX #<USER
14704: ; LDY #>USER
14705: ; SEC
14706: ; JSR VECTOR ;READ OLD VECTORS
14707: ; LDA #<MYINP ;CHANGE INPUT
14708: ; STA USER+10
14709: ; LDA #>MYINP
14710: ; STA USER+11
14711: ; LDX #<USER
14712: ; LDY #>USER
14713: ; CLC
14714: ; JSR VECTOR ;ALTER SYSTEM
14715: ; ...
14716: ; USER *=*+26
14717:
14718: iVECTOR:
14719: ; remember the address where to load/store the vector list
14720: stx zMEMUSS
14721: sty zMEMUSS + 1
14722:
14723: ldy #END_Copy_of_lCINV - Copy_of_lCINV - 1 ; get number of bytes to copy
14724: @Loop: lda lCINV,y
14725: bcs @DoSet ; if C=0, write the buffer to the address at x/y
14726: lda (zMEMUSS),y ; if C=1, get the data from x/y and write it to the system buffers
14727: @DoSet: sta (zMEMUSS),y
14728: sta lCINV,y
14729: dey
14730: bpl @Loop
14731: rts
14732:
14733: ; the system vectors as set by default
14734:
14735: Copy_of_lCINV:
14736: .addr KIRQ ; lCINV
14737: .addr RUNSTOP_RESTORE ; lCNBINV
14738: .addr KNMI ; lNMINV
14739: .addr KOPEN ; lIOPEN
14740: .addr KCLOSE ; lICLOSE
14741: .addr KCHKIN ; lICHKIN
14742: .addr KCHKOUT ; lICHKOUT
14743: .addr KCLRCH ; lICLRCH
14744: .addr KBASIN ; lIBASIN
14745: .addr KBSOUT ; lIBSOUT
14746: .addr KSTOP ; lISTOP
14747: .addr KGETIN ; lIGETIN
14748: .addr KCLALL ; lICLALL
14749: .addr RUNSTOP_RESTORE ; lUSRCMD
14750: .addr KLOAD ; lILOAD
14751: .addr KSAVE ; lISAVE
14752: END_Copy_of_lCINV:
14753:
14754: ; B.20. Function Name: RAMTAS
14755: ;
14756: ; Purpose: Perform RAM test
14757: ; Call address: $FF87 (hex) 65415 (decimal)
14758: ; Communication registers: A, X, Y
14759: ; Preparatory routines: None
14760: ; Error returns: None
14761: ; Stack requirements: 2
14762: ; Registers affected: A, X, Y
14763: ;
14764: ; Description: This routine is used to test RAM and set the top and
14765: ; bottom of memory pointers accordingly. It also clears locations $0000 to
14766: ; $0101 and $0200 to $03FF. It also allocates the cassette buffer, and sets
14767: ; the screen base to $0400. Normally, this routine is called as part of the
14768: ; initialization process of a Commodore 64 program cartridge.
14769: ;
14770: ; EXAMPLE:
14771: ; JSR RAMTAS
14772: ;
14773: iRAMTAS:
14774: ; clear zero page and $200-$3ff
14775: lda #0
14776: .if CompileComputer >= C64_GENERAL
14777: tay
14778: .else
14779: tax
14780: .endif
14781:
14782: @MemClearLoop:
14783:
14784: .if CompileComputer >= C64_GENERAL
14785: sta 2,y ; on the C64, start with ZP address 2 so we do not overwrite $00/$01 (6510 on-chip I/O pins!)
14786: sta $200,y
14787: sta $300,y
14788: iny
14789: .else
14790: sta 0,x
14791: sta $200,x
14792: sta $300,x
14793: inx
14794: .endif
14795: bne @MemClearLoop
14796:
14797: ; set the cassette (tape) buffer address
14798: ldx #<lTBUFFR
14799: ldy #>lTBUFFR
14800: stx zTAPE1
14801: sty zTAPE1 + 1
14802:
14803: ; Check memory for writability by writing
14804: ; a pattern to it ($55, then $AA). If the
14805: ; addresses contain exactly these values afterwards,
14806: ; we have working RAM.
14807:
14808: .if CompileComputer >= C64_GENERAL
14809: tay ; y = 0
14810: lda #(>lVIDEORAM)-1
14811: sta zSTAL + 1
14812: @IncHi: inc zSTAL + 1
14813: @Loop: lda (zSTAL),y ; remember original value of the memory location
14814: tax ; in X
14815:
14816: lda #$55 ; write $55 into memory location
14817: sta (zSTAL),y
14818: cmp (zSTAL),y ; still $55?
14819: bne @NotEqual ; no, quit loop
14820:
14821: rol a ; test $AA pattern instead
14822: sta (zSTAL),y
14823: cmp (zSTAL),y ; still $AA?
14824: bne @NotEqual ; no, quit loop
14825:
14826: ;
14827: ; the old value is only restored if the memory is determined as RAM.
14828: ; otherwise, either $55 or $AA remains at the last location.
14829: ; this is in contrast to the VIC 20 implementation, which leaves all
14830: ; bytes unchanged.
14831: ; Ironically, for the VIC20, there is no difference if this byte is
14832: ; restored or not. For the C64, however, there is a difference, as
14833: ; the RAM under the ROM at $A000 is overwritten with $55 after this
14834: ; function has been called if the BASIC ROM is switched on.
14835: ;
14836: txa ; restore old value
14837: sta (zSTAL),y
14838:
14839: .if CompileComputer = C64_GS
14840: nop
14841: bne @IncHi
14842: .else
14843: iny ; proceed to next memory location
14844: bne @Loop ; and do it again
14845: .endif
14846: beq @IncHi ; try next page
14847: ; ------------------------------
14848:
14849: @NotEqual:
14850: tya ; low byte of failed addres
14851: tax ; into X
14852: ldy zSTAL + 1 ; high byte of failed address into y
14853: clc ; (unneccessary, as we call iMEMTOP_Set, not iMEMTOP in the next line)
14854: jsr iMEMTOP_Set ; set memory top to x/y
14855:
14856: lda #>lBASICRAM ; set BASIC start to $0800
14857: sta lMEMSTR + 1 ; (low byte is already 0, as we just cleared the ZP)
14858:
14859: lda #>lVIDEORAM ; set video RAM start to $0400
14860: sta lHIBASE
14861: rts
14862:
14863: .else
14864:
14865: sta zSTAL ; zSTAL low = 0 (unneccessary, as we already cleared ZP to 0)
14866: sta zTEMPX ; (unneccessary, as we already cleared ZP to 0)
14867: sta lMEMSTR ; BASIC start low = 0 (unneccessary, as we already cleared ZP to 0)
14868: tay ; Y = 0
14869:
14870: lda #>$0400 ; start memory test at the location $0400.
14871: ; This is the first address where memory can be available on the VIC20,
14872: ; if a 3 KB RAM expansion is present.
14873: sta zSTAL + 1
14874:
14875: @MemTestLoop:
14876: ; increment address to be tested.
14877: ; Note that the VIC20 will actually start the test at $0401 with this, thus, $0400 will not be tested at all.
14878:
14879: inc zSTAL ; increment low byte of address to be tested
14880: bne @SkipHighByte
14881: inc zSTAL + 1 ; increment high byte, if necessary
14882:
14883: @SkipHighByte:
14884: jsr CheckWritability ; check if byte is writeable RAM (C=1) or not (C=0)
14885:
14886: lda zTEMPX ; until we found (first) RAM, handle
14887: beq @FindMemStart ; the test separately at @FindMemStart
14888:
14889: ; if we reach here, we have already found the start of RAM somewhere between $0400-$10FF.
14890: ; Thus, we continue the loop until we found a non-RAM location
14891:
14892: bcs @MemTestLoop ; if we still have RAM, test the next location
14893:
14894: ; here, we found the end of RAM
14895:
14896: ldy zSTAL + 1 ; get end of RAM pointer into x/y
14897: ldx zSTAL
14898: cpy #>$2000 ; end of RAM below $2000?
14899: bcc @Panic ; then panic, we have a severe problem, as we did not even find the RAM every VIC20 has!
14900:
14901: cpy #>$2100 ; end of RAM >= $2100?
14902: bcs @MemConf2 ; yet, set "configuration type 2", expanded with more than 3 KB RAM
14903:
14904: ; we have an unexpanded VIC20 (or expanded with not more than 3KB)
14905: ldy #>$1E00 ; put screen memory at $1E00 (- $1FFF)
14906: sty lHIBASE
14907: ; put memory top at $1E00
14908:
14909: @SetMemTop:
14910: jmp iMEMTOP_Set
14911:
14912: @MemConf2:
14913: lda #>$1200 ; set user basic start to $1200
14914: sta lMEMSTR + 1
14915: lda #>$1000 ; set screen memory to $1000
14916: sta lHIBASE
14917: bne @SetMemTop ; set memory top to what was determined (in x/y)
14918: ; ------------------
14919:
14920: @FindMemStart:
14921: ; if we reach here, we are not sure if there is memory at $0400-$0FFF (3 KB expansion)
14922: ; thus, we proceed when we have NOT yet found writeable RAM.
14923:
14924: bcc @MemTestLoop ; no RAM --> jump
14925:
14926: ; here, we have found the start of RAM
14927: lda zSTAL + 1 ; remember the start of RAM
14928: sta lMEMSTR + 1 ; at (lMEMSTR)
14929: sta zTEMPX ; remember we already found start of RAM.
14930: ; with this, we will not jump to @FindMemStart anymore
14931: cmp #>$1100
14932: bcc @MemTestLoop ; if start of RAM is below $1100, continue
14933:
14934: ; otherwise, we have a severe error, as RAM *must* start at $1000 in every VIC20.
14935: ; Thus, stop booting with a:
14936:
14937: ; endless loop: stop boot
14938: @Panic:
14939: jsr SET_VIC_DEFAULTS
14940: jmp @Panic
14941: .endif
14942:
14943:
14944: ; TODO
14945:
14946: TapeIrqVectors:
14947:
14948: .if CompileComputer = C64_GS
14949: .addr NMI_End
14950: .addr NMI_End
14951: .addr NMI_End
14952: .addr NMI_End
14953: .else
14954:
14955: VecTapeIrqWritePreamble:
14956: .addr TapeIrqWritePreamble
14957: VecTapeIrqWrite:
14958: .addr TapeIrqWrite
14959: VecKIRQ:
14960: .addr KIRQ
14961: VecTapeIrqRead:
14962: .addr TapeIrqRead
14963:
14964: .endif
14965:
14966: ; B-13. Function Name: IOINIT
14967: ;
14968: ; Purpose: Initialize I/O devices
14969: ; Call Address: $FF84 (hex) 65412 (decimal)
14970: ; Communication registers: None
14971: ; Preparatory routines: None
14972: ; Error returns:
14973: ; Stack requirements: None
14974: ; Registers affected: A, X, Y
14975: ;
14976: ; Description: This routine initializes all input/output devices and
14977: ; routines. It is normally called as part of the initialization procedure
14978: ; of a Commodore 64 program cartridge.
14979: ;
14980: ; EXAMPLE:
14981: ; JSR IOINIT
14982: ;
14983:
14984: iIOINIT:
14985: .if CompileComputer >= C64_GENERAL
14986:
14987: ; clear all bits in the interrupt control register.
14988: ; Thus, no CIA will generate any interrupts until
14989: ; reprogrammed
14990: lda #~CIA_ICR_BW_SET
14991: sta CIA1 + CIA_O_ICR
14992: sta CIA2 + CIA_O_ICR
14993:
14994: ; (A = $7F)
14995: sta CIA1 + CIA_O_PA
14996:
14997: ; stop all timers (TA, TB) on CIA1 and CIA2
14998: lda #CIA_CRA_B_ONESHOT ; is the same as CIA_CRB_B_ONESHOT!
14999: sta CIA1 + CIA_O_CRA
15000: sta CIA2 + CIA_O_CRA
15001:
15002: sta CIA1 + CIA_O_CRB
15003: sta CIA2 + CIA_O_CRB
15004:
15005: ; Port B (PB) of CIA1 and CIA2 are inputs
15006: ldx #$00
15007: stx CIA1 + CIA_O_DDRB ; keyboard column
15008: stx CIA2 + CIA_O_DDRB
15009:
15010: stx SID + SID_O_FiltMode
15011:
15012: ; Port A (PA) of CIA1 is output
15013: dex ; X = $FF
15014: stx CIA1 + CIA_O_DDRA ; keyboard row
15015:
15016: ; VIC reaches bank 0 ($0000-$1FFF), RS232 TXD is active. IEC lines are all inactive.
15017: lda #CIA2_PA_B_VA14 | CIA2_PA_B_VA15 | CIA2_PA_B_RS232_TXD
15018: sta CIA2 + CIA_O_PA ; IEC_REG_DATA_CLK_OUT
15019:
15020: lda #CIA2_PA_B_VA14 | CIA2_PA_B_VA15 | CIA2_PA_B_RS232_TXD | CIA2_PA_B_IEC_ATN_OUT | CIA2_PA_B_IEC_CLK_OUT | CIA2_PA_B_IEC_DATA_OUT ; not: CIA2_PA_B_IEC_CLK_IN and CIA2_PA_B_IEC_DATA_IN
15021: sta CIA2 + CIA_O_DDRA ; IEC_DDR
15022:
15023: lda #P6510_B_LORAM | P6510_B_HIRAM | P6510_B_CHAREN | P6510_B_CASS_MOTOR | P6510_B_UNUSED
15024: sta zR6510
15025: lda #P6510_B_LORAM | P6510_B_HIRAM | P6510_B_CHAREN | P6510_B_CASS_WRITE | P6510_B_CASS_MOTOR
15026:
15027: sta zD6510
15028:
15029: iIOINIT_TIMER:
15030: .if CompileComputer >= C64_02
15031: lda lTVSFLG
15032: beq LFDEC
15033: lda #<DEFAULT_INIT_VALUE_CIA1_TA_PAL
15034: .else
15035: lda #<DEFAULT_INIT_VALUE_CIA1_TA_1MHZ
15036: .endif
15037: sta CIA1 + CIA_O_TALO
15038:
15039: .if CompileComputer >= C64_02
15040: lda #>DEFAULT_INIT_VALUE_CIA1_TA_PAL
15041: jmp LFDF3
15042: LFDEC: lda #<DEFAULT_INIT_VALUE_CIA1_TA_NTSC
15043: sta CIA1 + CIA_O_TALO
15044: lda #>DEFAULT_INIT_VALUE_CIA1_TA_NTSC
15045: LFDF3: sta CIA1 + CIA_O_TAHI
15046: .else
15047: lda #>DEFAULT_INIT_VALUE_CIA1_TA_1MHZ
15048: sta CIA1 + CIA_O_TAHI
15049: .endif
15050:
15051: .macro IOINIT_PATCH
15052: lda #CIA_ICR_BW_SET |CIA_ICR_B_TA
15053: sta CIA1 + CIA_O_ICR
15054: lda CIA1 + CIA_O_CRA
15055: and #CIA_CRA_B_50HZ ; clear everything but 50/60 Hz flag
15056: ora #CIA_CRA_B_FORCE_LOAD | CIA_CRA_B_START ; start timer in continuous mode
15057: sta CIA1 + CIA_O_CRA
15058: jmp IecClkSet
15059: .endmacro
15060:
15061: .if CompileComputer >= C64_02
15062: jmp Patch_IOINIT
15063: .else
15064: IOINIT_PATCH
15065: .endif
15066:
15067: .else
15068: ; this is a VIC20
15069:
15070: lda #$7F
15071: sta VIA1_IEC
15072: sta VIA2_IEC
15073: lda #$40
15074: sta VIA2_ACR
15075: lda #$40
15076: sta VIA1_ACR
15077: lda #$FE
15078: sta VIA1_PCR
15079: lda #$DE
15080: sta VIA2_PCR
15081: ldx #$00
15082: stx VIA1_DDRB
15083: ldx #$FF
15084: stx VIA2_DDRB
15085: ldx #$00
15086: stx VIA2_DDRA
15087: ldx #$80
15088: stx VIA1_DDRA
15089: ldx #$00
15090: stx VIA1_PA_NO_HS
15091: jsr IecClkClear
15092: lda #$82
15093: sta VIA1_IEC
15094: jsr IecClkSet
15095:
15096: ;LFE39:
15097: iIOINIT_TIMER:
15098: lda #$C0
15099: sta VIA2_IEC
15100: lda #<DEFAULT_VIA2_T1
15101: sta VIA2_T1CL
15102: lda #>DEFAULT_VIA2_T1
15103: sta VIA2_T1CH
15104: rts
15105:
15106: .endif
15107:
15108:
15109: ; B-30. Function Name: SETNAM
15110: ;
15111: ; Purpose: Set file name
15112: ; Call address: $FFBD (hex) 65469 (decimal)
15113: ; Communication registers: A, X, Y
15114: ; Preparatory routines:
15115: ; Stack requirements: 2
15116: ; Registers affected:
15117: ;
15118: ; Description: This routine is used to set up the file name for the OPEN,
15119: ; SAVE, or LOAD routines. The accumulator must be loaded with the length of
15120: ; the file name. The X and Y registers must be loaded with the address of
15121: ; the file name, in standard 6502 low-byte/high-byte format. The address
15122: ; can be any valid memory address in the system where a string of
15123: ; characters for the file name is stored. If no file name is desired, the
15124: ; accumulator must be set to 0, representing a zero file length. The X and
15125: ; Y registers can be set to any memory address in that case.
15126: ;
15127: ; How to Use:
15128: ;
15129: ; 1) Load the accumulator with the length of the file name.
15130: ; 2) Load the X index register with the low order address of the file
15131: ; name.
15132: ; 3) Load the Y index register with the high order address.
15133: ; 4) Call this routine.
15134: ;
15135: ; EXAMPLE:
15136: ;
15137: ; LDA #NAME2-NAME ;LOAD LENGTH OF FILE NAME
15138: ; LDX #<NAME ;LOAD ADDRESS OF FILE NAME
15139: ; LDY #>NAME
15140: ; JSR SETNAM
15141: ;
15142: iSETNAM:
15143: sta zFNLEN ; store name of file name
15144: stx zFNADR ; and pointer to it
15145: sty zFNADR + 1
15146: rts
15147:
15148: ; B-28. Function Name: SETLFS
15149: ;
15150: ; Purpose: Set up a logical file
15151: ; Call address: $FFBA (hex) 65466 (decimal)
15152: ; Communication registers: A, X, Y
15153: ; Preparatory routines: None
15154: ; Error returns: None
15155: ; Stack requirements: 2
15156: ; Registers affected: None
15157: ;
15158: ;
15159: ; Description: This routine sets the logical file number, device address,
15160: ; and secondary address (command number) for other KERNAL routines.
15161: ; The logical file number is used by the system as a key to the file
15162: ; table created by the OPEN file routine. Device addresses can range from 0
15163: ; to 31. The following codes are used by the Commodore 64 to stand for the
15164: ; CBM devices listed below:
15165: ;
15166: ;
15167: ; ADDRESS DEVICE
15168: ;
15169: ; 0 Keyboard
15170: ; 1 Datassette(TM)
15171: ; 2 RS-232C device
15172: ; 3 CRT display
15173: ; 4 Serial bus printer
15174: ; 8 CBM serial bus disk drive
15175: ;
15176: ;
15177: ; Device numbers 4 or greater automatically refer to devices on the
15178: ; serial bus.
15179: ; A command to the device is sent as a secondary address on the serial
15180: ; bus after the device number is sent during the serial attention
15181: ; handshaking sequence. If no secondary address is to be sent, the Y index
15182: ; register should be set to 255.
15183: ;
15184: ; How to Use:
15185: ;
15186: ; 1) Load the accumulator with the logical file number.
15187: ; 2) Load the X index register with the device number.
15188: ; 3) Load the Y index register with the command.
15189: ;
15190: ;
15191: ;
15192: ;
15193: ; EXAMPLE:
15194: ;
15195: ; FOR LOGICAL FILE 32, DEVICE #4, AND NO COMMAND:
15196: ; LDA #32
15197: ; LDX #4
15198: ; LDY #255
15199: ; JSR SETLFS
15200: ;
15201: ;
15202: iSETLFS:
15203: sta zLA ; store logical file number
15204: stx zFA ; store device number (primary address)
15205: sty zSA ; store secondary address
15206: rts
15207:
15208: ; B-22. Function Name: READST
15209: ;
15210: ; Purpose: Read status word
15211: ; Call address: $FFB7 (hex) 65463 (decimal)
15212: ; Communication registers: A
15213: ; Preparatory routines: None
15214: ; Error returns: None
15215: ; Stack requirements: 2
15216: ; Registers affected: A
15217: ;
15218: ; Description: This routine returns the current status of the I/O devices
15219: ; in the accumulator. The routine is usually called after new communication
15220: ; to an I/O device. The routine gives you information about device status,
15221: ; or errors that have occurred during the I/O operation.
15222: ; The bits returned in the accumulator contain the following information:
15223: ; (see table below)
15224: ;
15225: ; +---------+------------+---------------+------------+-------------------+
15226: ; | ST Bit | ST Numeric | Cassette | Serial | Tape Verify |
15227: ; | Position| Value | Read | Bus R/W | + Load |
15228: ; +---------+------------+---------------+------------+-------------------+
15229: ; | 0 | 1 | | time out | |
15230: ; | | | | write | |
15231: ; +---------+------------+---------------+------------+-------------------+
15232: ; | 1 | 2 | | time out | |
15233: ; | | | | read | |
15234: ; +---------+------------+---------------+------------+-------------------+
15235: ; | 2 | 4 | short block | | short block |
15236: ; +---------+------------+---------------+------------+-------------------+
15237: ; | 3 | 8 | long block | | long block |
15238: ; +---------+------------+---------------+------------+-------------------+
15239: ; | 4 | 16 | unrecoverable | | any mismatch |
15240: ; | | | read error | | |
15241: ; +---------+------------+---------------+------------+-------------------+
15242: ; | 5 | 32 | checksum | | checksum |
15243: ; | | | error | | error |
15244: ; +---------+------------+---------------+------------+-------------------+
15245: ; | 6 | 64 | end of file | EOI line | |
15246: ; +---------+------------+---------------+------------+-------------------+
15247: ; | 7 | -128 | end of tape | device not | end of tape |
15248: ; | | | | present | |
15249: ; +---------+------------+---------------+------------+-------------------+
15250: ;
15251: ;
15252: ;
15253: ; How to Use:
15254: ;
15255: ; 1) Call this routine.
15256: ; 2) Decode the information in the A register as it refers to your pro-
15257: ; gram.
15258: ;
15259: ; EXAMPLE:
15260: ;
15261: ; ;CHECK FOR END OF FILE DURING READ
15262: ; JSR READST
15263: ; AND #64 ;CHECK EOF BIT (EOF=END OF FILE)
15264: ; BNE EOF ;BRANCH ON EOF
15265: ;
15266: iREADST:
15267: lda zFA ; get device address
15268: cmp #FILE_RS232 ; is it a RS232 device?
15269: bne iREADST_Normal ; no, return regular status
15270:
15271: ; here, we have a RS232 device.
15272: ; return the special status of the RS232 device
15273: ; (not documented in the KERNAL description above!)
15274:
15275: lda lRSSTAT ; get RS232 status
15276: .if CompileComputer >= C64_GENERAL
15277: pha ; make sure to remember RS232 status
15278:
15279: ; Leaving this out for the VIC 20 is obviously a severe bug, which
15280: ; makes iREADST for RS232 completely useless on it
15281:
15282: .endif
15283: lda #$00 ; clear RS232 status
15284: sta lRSSTAT
15285: .if CompileComputer >= C64_GENERAL
15286: pla ; get the RS232 status back
15287:
15288: ; Leaving this out for the VIC 20 is obviously a severe bug, which
15289: ; makes iREADST for RS232 completely useless on it
15290:
15291: .endif
15292: rts
15293:
15294: ; B-29. Function Name: SETMSG
15295: ;
15296: ; Purpose: Control system message output
15297: ; Call address: $FF90 (hex) 65424 (decimal)
15298: ; Communication registers: A
15299: ; Preparatory routines: None
15300: ; Error returns: None
15301: ; Stack requirements: 2
15302: ; Registers affected: A
15303: ;
15304: ; Description: This routine controls the printing of error and control
15305: ; messages by the KERNAL. Either print error messages or print control mes-
15306: ; sages can be selected by setting the accumulator when the routine is
15307: ; called. FILE NOT FOUND is an example of an error message. PRESS PLAY ON
15308: ; CASSETTE is an example of a control message.
15309: ; Bits 6 and 7 of this value determine where the message will come from.
15310: ; If bit 7 is 1, one of the error messages from the KERNAL is printed. If
15311: ; bit 6 is set, control messages are printed.
15312: ;
15313: ; How to Use:
15314: ;
15315: ; 1) Set accumulator to desired value.
15316: ; 2) Call this routine.
15317: ;
15318: ; EXAMPLE:
15319: ;
15320: ; LDA #$40
15321: ; JSR SETMSG ;TURN ON CONTROL MESSAGES
15322: ; LDA #$80
15323: ; JSR SETMSG ;TURN ON ERROR MESSAGES
15324: ; LDA #0
15325: ; JSR SETMSG ;TURN OFF ALL KERNAL MESSAGES
15326: ;
15327: iSETMSG:
15328: sta zNSGFLG
15329:
15330: ; in fact, these three commands belong to iREADST!
15331: ; read the status (LFE1A) or set one or more status bits (LFE1C)
15332: iREADST_Normal:
15333: lda zSTATUS
15334: SetStatus:
15335: ora zSTATUS
15336: sta zSTATUS
15337: rts
15338:
15339: ; B-32. Function Name: SETTMO
15340: ;
15341: ; Purpose: Set IEEE bus card timeout flag
15342: ; Call address: $FFA2 (hex) 65442 (decimal)
15343: ; Communication registers: A
15344: ; Preparatory routines: None
15345: ; Error returns: None
15346: ; Stack requirements: 2
15347: ; Registers affected: None
15348: ; +-----------------------------------------------------------------------+
15349: ; | NOTE: This routine is used ONLY with an IEEE add-on card! |
15350: ; +-----------------------------------------------------------------------+
15351: ; Description: This routine sets the timeout flag for the IEEE bus. When
15352: ; the timeout flag is set, the Commodore 64 will wait for a device on the
15353: ; IEEE port for 64 milliseconds. If the device does not respond to the
15354: ; Commodore 64's Data Address Valid (DAV) signal within that time the
15355: ; Commodore 64 will recognize an error condition and leave the handshake
15356: ; sequence. When this routine is called when the accumulator contains a 0
15357: ; in bit 7, timeouts are enabled. A 1 in bit 7 will disable the timeouts.
15358: ;
15359: ; +-----------------------------------------------------------------------+
15360: ; | NOTE: The Commodore 64 uses the timeout feature to communicate that a |
15361: ; | disk file is not found on an attempt to OPEN a file only with an IEEE |
15362: ; | card. |
15363: ; +-----------------------------------------------------------------------+
15364: ;
15365: ; How to Use:
15366: ;
15367: ; TO SET THE TIMEOUT FLAG
15368: ; 1) Set bit 7 of the accumulator to 0.
15369: ; 2) Call this routine.
15370: ;
15371: ; TO RESET THE TIMEOUT FLAG
15372: ; 1) Set bit 7 of the accumulator to 1.
15373: ; 2) Call this routine.
15374: ;
15375: ; EXAMPLE:
15376: ;
15377: ; ;DISABLE TIMEOUT
15378: ; LDA #0
15379: ; JSR SETTMO
15380: ;
15381: iSETTMO:
15382: sta lTIMOUT
15383: rts
15384:
15385:
15386: ; B-17. Function Name: MEMTOP
15387: ;
15388: ; Purpose: Set the top of RAM
15389: ; Call address: $FF99 (hex) 65433 (decimal)
15390: ; Communication registers: X, Y
15391: ; Preparatory routines: None
15392: ; Error returns: None
15393: ; Stack requirements: 2
15394: ; Registers affected: X, Y
15395: ;
15396: ; Description: This routine is used to set the top of RAM. When this
15397: ; routine is called with the carry bit of the accumulator set, the pointer
15398: ; to the top of RAM will be loaded into the X and Y registers. When this
15399: ; routine is called with the accumulator carry bit clear, the contents of
15400: ; the X and Y registers are loaded in the top of memory pointer, changing
15401: ; the top of memory.
15402: ;
15403: ; EXAMPLE:
15404: ; ;DEALLOCATE THE RS-232 BUFFER
15405: ; SEC
15406: ; JSR MEMTOP ;READ TOP OF MEMORY
15407: ; DEX
15408: ; CLC
15409: ; JSR MEMTOP ;SET NEW TOP OF MEMORY
15410: ;
15411: iMEMTOP:
15412: bcc iMEMTOP_Set ; c = 0 --> set MEMTOP
15413: iMEMTOP_Get:
15414: ldx lMEMSIZ ; get MEMTOP to x/y
15415: ldy lMEMSIZ + 1
15416: iMEMTOP_Set:
15417: stx lMEMSIZ ; set MEMTOP from x/y
15418: sty lMEMSIZ + 1
15419: rts
15420:
15421: ; B-16. Function Name: MEMBOT
15422: ;
15423: ; Purpose: Set bottom of memory
15424: ; Call address: $FF9C (hex) 65436 (decimal)
15425: ; Communication registers: X, Y
15426: ; Preparatory routines: None
15427: ; Error returns: None
15428: ; Stack requirements: None
15429: ; Registers affected: X, Y
15430: ;
15431: ; Description: This routine is used to set the bottom of the memory. If
15432: ; the accumulator carry bit is set when this routine is called, a pointer
15433: ; to the lowest byte of RAM is returned in the X and Y registers. On the
15434: ; unexpanded Commodore 64 the initial value of this pointer is $0800
15435: ; (2048 in decimal). If the accumulator carry bit is clear (-O) when this
15436: ; routine is called, the values of the X and Y registers are transferred to
15437: ; the low and high bytes, respectively, of the pointer to the beginning of
15438: ; RAM.
15439: ;
15440: ;
15441: ;
15442: ; How to Use:
15443: ; TO READ THE BOTTOM OF RAM
15444: ; 1) Set the carry.
15445: ; 2) Call this routine.
15446: ;
15447: ; TO SET THE BOTTOM OF MEMORY
15448: ; 1) Clear the carry.
15449: ; 2) Call this routine.
15450: ;
15451: ; EXAMPLE:
15452: ;
15453: ; ;MOVE BOTTOM OF MEMORY UP 1 PAGE
15454: ; SEC ;READ MEMORY BOTTOM
15455: ; JSR MEMBOT
15456: ; INY
15457: ; CLC ;SET MEMORY BOTTOM TO NEW VALUE
15458: ; JSR MEMBOT
15459: ;
15460: iMEMBOT:
15461: bcc @Set ; c = 0 --> set MEMBOT
15462:
15463: ldx lMEMSTR ; get MEMBOT to x/y
15464: ldy lMEMSTR + 1
15465:
15466: @Set: stx lMEMSTR ; set MEMBOT from x/y
15467: sty lMEMSTR + 1
15468: rts
15469:
15470:
15471: .if CompileComputer < C64_GENERAL
15472: ;
15473: ; Test if the memory location pointed to by (zSTAL),y is writable RAM.
15474: ; For this, we write $55, then $AA into the location. After each write,
15475: ; we test if the memory is $55 and $AA, respectively.
15476: ; The memory location is left unchanged (that is, the old value is written
15477: ; back to it), regardless of the outcome of the test.
15478: ;
15479: ; If the area is determined as RAM, return with c=1, else c=0.
15480: ;
15481: CheckWritability:
15482: lda (zSTAL),y ; remember original value of the memory location
15483: tax ; in X
15484:
15485: lda #$55 ; write $55 into memory location
15486: sta (zSTAL),y
15487: cmp (zSTAL),y ; still $55?
15488: bne @NotEqual ; no, quit loop
15489:
15490: ror a ; test $AA pattern instead
15491: sta (zSTAL),y
15492: cmp (zSTAL),y ; still $AA?
15493: bne @NotEqual ; no, quit loop
15494:
15495: .byte $A9 ; with next byte: "lda #$18". Make sure the CLC is not executed.
15496:
15497: @NotEqual:
15498: clc ; return: There was a difference
15499:
15500: txa ; restore old value
15501: sta (zSTAL),y
15502: rts
15503: .endif
15504:
15505: ; 6502 NMI routine
15506: ; This routine is called whenever an NMI occurs.
15507: ;
15508: NMI: sei ; block IRQ
15509: jmp (lNMINV) ; normally points to KNMI
15510:
15511: KNMI: pha ; save A, X and Y onto the stack
15512: txa
15513: pha
15514: tya
15515: pha
15516:
15517: .if CompileComputer >= C64_GENERAL
15518: ; clear all bits in the interrupt control register to prevent further interrupts
15519: lda #~CIA_ICR_BW_SET
15520: sta CIA2 + CIA_O_ICR
15521:
15522: ; check if CIA2 generated this NMI
15523: ldy CIA2 + CIA_O_ICR
15524: bmi NMI_FROM_IO ; CIA2 generated the NMI, process it
15525: .else
15526: ; check if VIA1 generated this NMI
15527: lda VIA1_IFR
15528: bpl LFEFF
15529: and VIA1_IEC
15530: tax
15531: and #$02
15532: beq NMI_FROM_IO
15533: .endif
15534:
15535: jsr CheckCartridge ; is there a cartridge (with magic) installed at $8000 (C64) / $A000 (VIC-20)?
15536: bne @NoCartridge ; no, skip
15537: jmp (CART_NMI) ; yes, let the cartridge process the NMI
15538:
15539: @NoCartridge:
15540: .if CompileComputer >= C64_GENERAL
15541: jsr iUDTIM_CheckRunStop
15542: .else
15543: bit VIA1_PA
15544: jsr iUDTIM
15545: .endif
15546: jsr kSTOP
15547: bne LFEFF
15548:
15549: RUNSTOP_RESTORE:
15550: jsr iRESTOR
15551: jsr iIOINIT
15552: jsr iCINT
15553: jmp (bRESTART + 2)
15554:
15555: NMI_FROM_IO:
15556:
15557: .if CompileComputer >= C64_GENERAL
15558: LFEFF:
15559: ; TODO combine more?
15560:
15561: ; TODO follow logic (currently, there is no description *why* these tests are done!)
15562:
15563: tya ; A := Y, which has contents of CIA2 + CIA_O_ICR here
15564: and lENABL ; only check bits that are set in lENABL
15565: tax
15566:
15567: and #CIA_ICR_B_TA ; check if TA of CIA2 generated the interrupt
15568: beq @NoTimerAUnderflow ; no -> branch, next test
15569:
15570: lda RS232_TXD_REG
15571: and #~CIA2_PA_B_RS232_TXD
15572: ora zNXTBIT
15573: sta RS232_TXD_REG
15574:
15575: ; clear all interrupt sources of CIA2 that are currently set
15576: lda lENABL ; get enabled interrupt sources
15577: sta CIA2 + CIA_O_ICR
15578:
15579: txa
15580: and #CIA_ICR_B_FLAG | CIA_ICR_B_TB ; check if timer B or FLAG generated the interrupt
15581: beq @Continue ; none -> branch
15582:
15583: and #CIA_ICR_B_TB ; check if timer B generated the interrupt
15584: beq @IntFromFlag ; no -> branch
15585:
15586: jsr LFED6
15587: jmp @Continue
15588:
15589: @IntFromFlag:
15590: jsr LFF07
15591:
15592: @Continue:
15593: jsr LEEBB
15594: jmp @ClearAllCIA2Interrupts
15595:
15596: @NoTimerAUnderflow:
15597: txa
15598: and #CIA_ICR_B_TB ; check if TB of CIA2 generated the interrupt
15599: beq @NoTimerBUnderflow ; no -> branch, next test
15600: jsr LFED6
15601: jmp @ClearAllCIA2Interrupts
15602:
15603: @NoTimerBUnderflow:
15604: txa
15605: and #CIA_ICR_B_FLAG ; check if FLAG of CIA2 generated the interrupt
15606: beq @ClearAllCIA2Interrupts ; no -> branch, next test
15607: jsr LFF07
15608:
15609: @ClearAllCIA2Interrupts:
15610: ; clear all interrupt sources of CIA2 that are currently set
15611: lda lENABL ; get enabled interrupt sources
15612: sta CIA2 + CIA_O_ICR
15613:
15614: .else
15615:
15616: lda VIA1_IEC
15617: ora #$80
15618: pha
15619: lda #$7F
15620: sta VIA1_IEC
15621: txa
15622: and #$40
15623: beq LFF02
15624: lda #$CE
15625: ora zNXTBIT
15626: sta VIA1_PCR
15627: lda VIA1_T1CL
15628: pla
15629: sta VIA1_IEC
15630: jsr LEEBB
15631: LFEFF:
15632: jmp NMI_End
15633: ; -----------------------
15634:
15635: LFF02: txa
15636: and #$20
15637: beq @LFF2C
15638: lda VIA1_PB
15639: and #$01
15640: sta zINBIT
15641: lda VIA1_T2CL
15642: sbc #$16
15643: adc lBAUDOF
15644: sta VIA1_T2CL
15645: lda VIA1_T2CH
15646: adc lBAUDOF + 1
15647: sta VIA1_T2CH
15648: pla
15649: sta VIA1_IEC
15650: jsr LEF59
15651: jmp NMI_End
15652: @LFF2C: txa
15653: and #$10
15654: beq NMI_End
15655: lda lM51CTR
15656: and #$0F
15657: bne @LFF38
15658: @LFF38: asl a
15659: tax
15660: lda LFEC2 - 2,x
15661: sta VIA1_T2CL
15662: lda LFEC2 - 1,x
15663: sta VIA1_T2CH
15664: lda VIA1_PB
15665: pla
15666: ora #$20
15667: and #$EF
15668: sta VIA1_IEC
15669: ldx lBITNUM
15670: stx zBITC1
15671: .endif
15672:
15673: NMI_End:
15674: pla
15675: tay
15676: pla
15677: tax
15678: pla
15679: rti
15680:
15681: LFEC2:
15682:
15683: .if CompileComputer >= C64_GENERAL
15684:
15685: .if CompileComputer >= C64_02
15686: .word $27C1
15687: .word $1A3E
15688: .word $11C5
15689: .word $0E74
15690: .word $0CED
15691: .word $0645
15692: .word $02F0
15693: .word $0146
15694: .word $00B8
15695: .word $0071
15696: .else
15697: .word $26AC
15698: .word $19A7
15699: .word $115D
15700: .word $0E1F
15701: .word $0CA1
15702: .word $061F
15703: .word $02DD
15704: .word $013D
15705: .word $00B2
15706: .word $006C
15707:
15708: .endif
15709:
15710: .else
15711:
15712: .if CompileComputer >= VIC20_07
15713:
15714: .word $2AE6
15715: .word $1C78
15716: .word $1349
15717: .word $0FB1
15718: .word $0E0A
15719: .word $06D3
15720: .word $0338
15721: .word $016A
15722: .word $00D0
15723: .word $0083
15724: .word $0036
15725:
15726: .else
15727:
15728: .word $2792
15729: .word $1A40
15730: .word $11C6
15731: .word $0E74
15732: .word $0CEE
15733: .word $0645
15734: .word $02F1
15735: .word $0146
15736: .word $00B8
15737: .word $0071
15738: .word $002A
15739:
15740: .endif
15741:
15742: .endif
15743:
15744:
15745: .if CompileComputer >= C64_GENERAL
15746: LFED6: lda CIA2 + CIA_O_PB
15747: and #$01
15748: sta zINBIT
15749: lda CIA2 + CIA_O_TBLO
15750: sbc #$1C
15751: adc lBAUDOF
15752: sta CIA2 + CIA_O_TBLO
15753: lda CIA2 + CIA_O_TBHI
15754: adc lBAUDOF + 1
15755: sta CIA2 + CIA_O_TBHI
15756: lda #$11
15757: sta CIA2 + CIA_O_CRB
15758:
15759: ; clear all interrupt sources of CIA2 that are currently set
15760: lda lENABL ; get enabled interrupt sources
15761: sta CIA2 + CIA_O_ICR
15762:
15763: lda #$FF
15764: sta CIA2 + CIA_O_TBLO
15765: sta CIA2 + CIA_O_TBHI
15766: jmp LEF59
15767: LFF07:
15768: .if CompileComputer = C64_01
15769: lda lM51CTR
15770: and #$0F
15771: bne LFF1A
15772: .endif
15773: lda lM51AJB
15774: sta CIA2 + CIA_O_TBLO
15775: lda lM51AJB + 1
15776: .if CompileComputer = C64_01
15777: jmp LFF25
15778: LFF1A: asl a
15779: tax
15780: lda LFEC2 - 2,x
15781: sta CIA2 + CIA_O_TBLO
15782: lda LFEC2 - 1,x
15783: LFF25:
15784: .endif
15785: sta CIA2 + CIA_O_TBHI
15786: lda #$11
15787: sta CIA2 + CIA_O_CRB
15788:
15789: lda #CIA_ICR_B_FLAG | CIA_ICR_B_TB
15790: eor lENABL
15791: sta lENABL
15792:
15793: lda #$FF
15794: sta CIA2 + CIA_O_TBLO
15795: sta CIA2 + CIA_O_TBHI
15796: ldx lBITNUM
15797: stx zBITC1
15798: rts
15799:
15800: .if CompileComputer >= C64_02
15801: LFF2E: tax
15802: lda lM51AJB + 1
15803: rol a
15804: tay
15805: txa
15806: adc #<200
15807: sta lBAUDOF
15808: tya
15809: adc #>200
15810: sta lBAUDOF + 1
15811: rts
15812: .endif
15813:
15814: .segment "TapeFakeFiller"
15815: nop
15816: nop
15817:
15818: ; FillUntil KERNAL_START + $1F43, $EA
15819: .segment "TapeFakeIrq"
15820:
15821: ; This is a faked IRQ entry point. It is used by the tape routine to execute the IRQ routine,
15822: ; returning to a predefined address afterwards.
15823: ;
15824: ; When this address is called (JMPed to), the return address - 1 is already on the stack.
15825: ; This routine has to set a flag register on the stack, making sure that the B bit is unset
15826: ; forcing a processing of an IRQ (and not of a BRK instruction)
15827: ;
15828: FakeIRQ:
15829: php ; push flag register onto stack
15830:
15831: ; now, manipulate the flag register making sure B is unset
15832:
15833: pla ; get it back into the Accu
15834: and #~A6502_FLAGS_B ; make sure B is unset
15835: pha ; store the flag register back onto the stack
15836:
15837:
15838: .endif
15839:
15840: ; 6502 IRQ routine
15841: ; This routine is called whenever an IRQ occurs.
15842: ;
15843: IRQ: pha ; save A, X and Y onto stack
15844: txa
15845: pha
15846: tya
15847: pha
15848:
15849: tsx ; SP -> X
15850: lda lSTACK + 4,x ; Read status register from stack
15851: and #A6502_FLAGS_B ; check BRK flag
15852: beq @isIRQ ; BRK flag is 0 --> it was an IRQ
15853:
15854: jmp (lCNBINV) ; BRK flag was 1, process the BRK instruction
15855:
15856: @isIRQ: jmp (lCINV) ; process the IRQ. Normally, this points to KIRQ
15857:
15858:
15859: .if CompileComputer >= C64_GENERAL
15860: .if CompileComputer >= C64_02
15861:
15862: ; B-7. Function Name: CINT
15863: ;
15864: ; Purpose: Initialize screen editor & 6567 video chip
15865: ; Call address: $FF81 (hex) 65409 (decimal)
15866: ; Communication registers: None
15867: ; Preparatory routines: None
15868: ; Error returns: None
15869: ; Stack requirements: 4
15870: ; Registers affected: A, X, Y
15871: ;
15872: ;
15873: ; Description: This routine sets up the 6567 video controller chip in the
15874: ; Commodore 64 for normal operation. The KERNAL screen editor is also
15875: ; initialized. This routine should be called by a Commodore 64 program
15876: ; cartridge.
15877: ;
15878: ; How to Use:
15879: ;
15880: ; 1) Call this routine.
15881: ;
15882: ; EXAMPLE:
15883: ;
15884: ; JSR CINT
15885: ; JMP RUN ;BEGIN EXECUTION
15886: ;
15887: ; NOTE: iCINT_WITH_PAL_NTSC is an *extended* version.
15888: ; It determines if there is a 6567 (NTSC) or 6569 (PAL) VIC chip.
15889: ; It stores the result in lTVSFLG (TV Standard FLaG), with
15890: ; 0 = NTSC, 1 = PAL.
15891: ; Then, it reprograms the CIA timer for PAL or NTSC.
15892: ;
15893: iCINT_WITH_PAL_NTSC:
15894: jsr iCINT
15895:
15896: @WaitForRaster:
15897: lda VIC + VICII_O_Raster
15898: bne @WaitForRaster
15899: lda VIC + VICII_O_IRQFlags
15900: and #$01
15901: sta lTVSFLG
15902: jmp iIOINIT_TIMER
15903:
15904: ; Remainder of iIOINIT. As the code become too large because of the PAL/NTSC
15905: ; implementation, this patch is here now.
15906: ;
15907: Patch_IOINIT:
15908: IOINIT_PATCH
15909: .endif
15910: .endif
15911:
15912: .if CompileComputer >= C64_GENERAL
15913:
15914: ; FillUntil KERNAL_START + $1F80
15915: .segment "KernalJumpTable"
15916:
15917: .byte VERSION_FF80 ; a version number for the KERNAL
15918:
15919: ; here, the KERNAL jump table begins
15920: ;
15921:
15922:
15923: ; the VIC-20 does not know CINT, IOINIT and RAMTAS, as these were added with the C64:
15924:
15925: kCINT:
15926: .if CompileComputer >= C64_02
15927: ; on C64 >= -02 ROM, determine if this is a PAL or an NTSC machine,
15928: ; and set the IRQ timings accordingly.
15929: ; Afterwards, iCINT is called.
15930: jmp iCINT_WITH_PAL_NTSC
15931: .else
15932: ; for C64 with -01 ROM, iCINT is called directly.
15933: jmp iCINT
15934: .endif
15935:
15936: kIOINIT: jmp iIOINIT
15937: kRAMTAS: jmp iRAMTAS
15938:
15939: .else
15940:
15941: ; FillUntil $FF8A,FILL_FFXX
15942:
15943: .endif
15944:
15945: .segment "KernalJumpTable2"
15946:
15947: ; here, the KERNAL jump table common to VIC20 and C64 begins
15948:
15949: kRESTOR: jmp iRESTOR
15950: kVECTOR: jmp iVECTOR
15951: kSETMSG: jmp iSETMSG
15952: kSECOND: jmp iSECOND
15953: kTKSA: jmp iTKSA
15954: kMEMTOP: jmp iMEMTOP
15955: kMEMBOT: jmp iMEMBOT
15956: kSCNKEY: jmp iSCNKEY
15957: kSETTMO: jmp iSETTMO
15958: kACPTR:
15959: .ifdef JIFFY
15960: jmp JDLFBAA
15961: .else
15962: jmp iACPTR
15963: .endif
15964: kCIOUT: jmp iCIOUT
15965: kUNTLK: jmp iUNTLK
15966: kUNLSN: jmp iUNLSN
15967: kLISTEN: jmp iLISTEN
15968: kTALK: jmp iTALK
15969: kREADST: jmp iREADST
15970: kSETLFS: jmp iSETLFS
15971: kSETNAM: jmp iSETNAM
15972: kOPEN: jmp (lIOPEN)
15973: kCLOSE: jmp (lICLOSE)
15974: kCHKIN: jmp (lICHKIN)
15975: kCHKOUT: jmp (lICKOUT)
15976: kCLRCHN: jmp (lICLRCH)
15977: kCHRIN: jmp (lIBASIN)
15978: kCHROUT: jmp (lIBSOUT)
15979: kLOAD: jmp iLOAD
15980: kSAVE: jmp iSAVE
15981: kSETTIM: jmp iSETTIM
15982: kRDTIM: jmp iRDTIM
15983: kSTOP: jmp (lISTOP)
15984: kGETIN: jmp (lIGETIN)
15985: kCLALL: jmp (lICLALL)
15986: kUDTIM: jmp iUDTIM
15987: kSCREEN: jmp iSCREEN
15988: kPLOT: jmp iPLOT
15989: kIOBASE: jmp iIOBASE
15990:
15991: .if (CompileComputer >= C64_GENERAL) .AND (.NOT .defined(C64JAPAN))
15992: .byte "RR" ; Robert Russell
15993: .if CompileComputer = C64_4064
15994: .byte 0,0
15995: .else
15996: .byte "BY" ; Bob Yannes
15997: .endif
15998: .endif
15999:
16000: ; FillUntil $FFFA,FILL_FFXXa
16001: .segment "Int6502"
16002:
16003: .addr NMI ; 6502 NMI vector
16004: .addr RESET ; 6502 RESET vector
16005: .addr IRQ ; 6502 IRQ vector
16006:
16007: .segment "BASICFILL"
16008: FillCount $1e, $aa
16009: