c64.a65.full.html; generated on Fri Sep 18 21:44:50 2015 by ca65html
uz@cc65.org
1: .setcpu "6502"
2:
3: ; .include "../asm6502.inc"
4: ASM_JMP = $4C
5: ASM_BIT2 = $24
6: ASM_BIT3 = $2C
7:
8: ; Flags of the 6502
9: A6502_FLAGS_N = $80 ; Negative
10: A6502_FLAGS_V = $40 ; oVerflow
11: A6502_FLAGS_R = $20 ; Reserved
12: A6502_FLAGS_B = $10 ; Break (only valid on stack after BRK/IRQ, otherwise 0)
13: A6502_FLAGS_D = $08 ; Decimal
14: A6502_FLAGS_I = $04 ; Interrupt
15: A6502_FLAGS_Z = $02 ; Zero
16: A6502_FLAGS_C = $01 ; Carry
17: ; .include "../petscii.inc"
18: ASC_LF = $0A
19: ASC_CR = $0D
20: ASC_RVS = $12
21: ASC_HOME = $13
22: ASC_INSDEL = $14
23:
24: ASC_LOWERCASE = $0E
25: ASC_UPPERCASE = $8E
26: ASC_DISALLOW_LOWERCASE = $08
27: ASC_ALLOW_LOWERCASE = $09
28:
29: ASC_CURSORLEFTRIGHT = $1D
30: ASC_CURSORUPDOWN = $11
31:
32: .if .defined(C64JAPAN)
33: ASC_PI = $B0
34: .else
35: ASC_PI = $DE
36: .endif
37:
38: KEY_NONE = $40
39: KEY_STOP = $03
40:
41: PETSCII_CRSR_RIGHT = $1D
42:
43: ; .include "../macros.inc"
44: ; htasc - set the hi bit on the last byte of a string for termination
45: ; (by Tom Greene)
46: .macro htasc str
47: .repeat .strlen(str)-1,I
48: .byte .strat(str,I)
49: .endrep
50: .byte .strat(str,.strlen(str)-1) | $80
51: .endmacro
52:
53: .macro htasc_floppy_error str
54: .byte .strat(str,0) | $80
55: .repeat .strlen(str)-2,I
56: .byte .strat(str,I + 1)
57: .endrep
58: .byte .strat(str,.strlen(str)-1) | $80
59: .endmacro
60:
61: ; For every token, a byte gets put into segment "DUMMY".
62: ; This way, we count up with every token. The DUMMY segment
63: ; doesn't get linked into the binary.
64: .macro init_token_tables
65: .segment "VECTORS"
66: TOKEN_ADDRESS_TABLE:
67: .segment "KEYWORDS"
68: TOKEN_NAME_TABLE:
69: .segment "DUMMY"
70: DUMMY_START:
71: .endmacro
72:
73: ; optionally define token symbol
74: ; count up token number
75: .macro define_token token
76: .segment "DUMMY"
77: .ifnblank token
78: token := <(*-DUMMY_START)+$80
79: .endif
80: .res 1; count up in any case
81: .endmacro
82:
83: ; lay down a keyword, optionally define a token symbol
84: .macro keyword key, token
85: .segment "KEYWORDS"
86: htasc key
87: define_token token
88: .endmacro
89:
90: ; lay down a keyword and an address (RTS style),
91: ; optionally define a token symbol
92: .macro keyword_rts key, vec, token
93: .segment "VECTORS"
94: .word vec-1
95: keyword key, token
96: .endmacro
97:
98: ; lay down a keyword and an address,
99: ; optionally define a token symbol
100: .macro keyword_addr key, vec, token
101: .segment "VECTORS"
102: .addr vec
103: keyword key, token
104: .endmacro
105:
106: .macro count_tokens
107: .segment "DUMMY"
108: NUM_TOKENS := <(*-DUMMY_START)
109: .endmacro
110:
111: .macro init_error_table
112: .segment "DUMMY"
113: DUMMY_START_ERROR:
114:
115: .segment "ERROR"
116: ERROR_MESSAGES:
117: .endmacro
118:
119: .ifdef CBM2_EXT_FILE_ERRORS
120: .macro define_error_token token
121: .segment "DUMMY"
122: .ifnblank token
123: token := <(*-DUMMY_START_ERROR + 1)
124: .endif
125: .res 1; count up in any case
126: .endmacro
127:
128: .macro define_error error, msg, addr
129: .segment "ERROR"
130: addr := *
131: htasc msg
132: define_error_token error
133: .endmacro
134:
135: .else
136: .macro define_error error, msg, addr
137: .segment "ERROR"
138: error := <(*-ERROR_MESSAGES)
139: htasc msg
140: .endmacro
141:
142: .endif
143:
144: ;---------------------------------------------
145: ; set the MSB of every byte of a string
146: .macro asc80 str
147: .repeat .strlen(str),I
148: .byte .strat(str,I)+$80
149: .endrep
150: .endmacro
151:
152:
153: ; .include "defines.inc"
154: ; .include "defines-c64vic20.inc"
155:
156: COMPUTER_UNKNOWN=0
157:
158: VIC20_GENERAL=COMPUTER_UNKNOWN + $10
159: VIC20_02=VIC20_GENERAL + 2
160: VIC20_06=VIC20_GENERAL + 6
161: VIC20_07=VIC20_GENERAL + 7
162:
163: C64_GENERAL=VIC20_GENERAL + $20
164: C64_01=C64_GENERAL + 1
165: C64_02=C64_GENERAL + 2
166: C64_03=C64_GENERAL + 3
167: C64_SX64=C64_GENERAL + 4
168: C64_4064=C64_GENERAL + 5
169: C64_GS=C64_GENERAL + 6
170:
171: .ifdef vic20
172: CompileComputer=VIC20_GENERAL + vic20
173: .elseif .defined(c64)
174: .if c64 = 4064
175: CompileComputer=C64_4064
176: .else
177: CompileComputer=C64_GENERAL + c64
178: .endif
179: .endif
180:
181: .ifdef sx64
182: CompileComputer=C64_SX64
183: c64 = sx64
184: .endif
185:
186: .ifdef c64gs
187: CompileComputer=C64_GS
188: c64 = c64gs
189: .endif
190:
191: .ifndef CompileComputer
192: CompileComputer=COMPUTER_UNKNOWN
193: .endif
194:
195: .macro FillCount count,filler
196: .repeat count
197: .ifblank filler
198: .byte DRIVEFILLER
199: .else
200: .byte filler
201: .endif
202: .endrep
203: .endmacro
204:
205: .macro FillUntil address,filler
206: FillCount address-*,filler
207: .endmacro
208:
209: .macro FillNOP count
210: FillCount count,$EA
211: .endmacro
212:
213: IEEE_LISTEN = $20 ; on ATN, with primary address
214: IEEE_TALK = $40 ; on ATN, with primary address
215: IEEE_OPEN = $60 ; on ATN, with secondary address
216: IEEE_CLOSE = $E0 ; on ATN, with primary address
217: IEEE_SECONDARY = $F0 ; on ATN, with secondary address
218:
219: IEEE_LOAD = IEEE_OPEN + 0
220: IEEE_SAVE = IEEE_OPEN + 1
221:
222: IEEE_UNLISTEN = IEEE_LISTEN + $1F
223: IEEE_UNTALK = IEEE_TALK + $1F
224:
225: STATUS_IEC_DEVICE_NOT_PRESENT = $80
226: STATUS_IEC_EOI = $40
227: STATUS_IEC_TIMEOUT_READ = $02
228: STATUS_IEC_TIMEOUT_WRITE = $01
229:
230: STATUS_VERIFY = $10
231:
232: STATUS_TAPE_EOT = $80
233: STATUS_TAPE_EOF = $40 ; not on LOAD and VERIFY
234: STATUS_TAPE_CHKSUM_ERR = $20
235: STATUS_TAPE_UNRECOVERABLE_READ_ERROR = $10
236: STATUS_TAPE_LONG_BLOCK = $08
237: STATUS_TAPE_SHORT_BLOCK = $04
238:
239:
240: FREQUENCY_1MHZ = 1000000
241: FREQUENCY_NTSC = 1022700
242: FREQUENCY_PAL = 985248
243:
244: DEFAULT_INIT_VALUE_CIA1_TA_1MHZ = ((FREQUENCY_1MHZ + 59) / 60) ; $411B
245: DEFAULT_INIT_VALUE_CIA1_TA_NTSC = ((FREQUENCY_NTSC + 59) / 60) ; $4295
246: DEFAULT_INIT_VALUE_CIA1_TA_PAL = ((FREQUENCY_PAL + 59) / 60) ; $4025
247:
248: .if CompileComputer=C64_01
249: DRIVEFILLER=$AA
250: VERSION_FF80=$AA
251: VERSION_E4AC=$2B
252: BASIC_END := $E3A2
253: SET_COLOR_FRAME := COL_LIGHTBLUE
254: SET_COLOR_BACKGROUND := COL_BLUE
255: TEXT_SHIFTRUNSTOP = TEXT_LOADRUN
256: END_TEXT_SHIFTRUNSTOP = END_TEXT_LOADRUN
257:
258: DEFAULT_COLOR := COL_LIGHTBLUE
259:
260: .elseif CompileComputer=C64_02
261: DRIVEFILLER=$AA
262: VERSION_FF80=0
263: BASIC_END := $E3A2
264: TEXT_SHIFTRUNSTOP = TEXT_LOADRUN
265: END_TEXT_SHIFTRUNSTOP = END_TEXT_LOADRUN
266: .if .defined(C64JAPAN)
267: VERSION_E4AC=$0
268: SET_COLOR_FRAME := COL_CYAN
269: SET_COLOR_BACKGROUND := COL_WHITE
270: DEFAULT_COLOR := COL_BLUE
271: .else
272: VERSION_E4AC=$5C
273: SET_COLOR_FRAME := COL_LIGHTBLUE
274: SET_COLOR_BACKGROUND := COL_BLUE
275: DEFAULT_COLOR := COL_LIGHTBLUE
276: .endif
277:
278: .elseif CompileComputer=C64_03
279: DRIVEFILLER=$AA
280: VERSION_FF80=3
281: VERSION_E4AC=$81
282: BASIC_END := $E3A2
283: SET_COLOR_FRAME := COL_LIGHTBLUE
284: SET_COLOR_BACKGROUND := COL_BLUE
285: TEXT_SHIFTRUNSTOP = TEXT_LOADRUN
286: END_TEXT_SHIFTRUNSTOP = END_TEXT_LOADRUN
287:
288: DEFAULT_COLOR := COL_LIGHTBLUE
289:
290: .elseif CompileComputer=C64_4064
291: DRIVEFILLER=$AA
292: VERSION_FF80=$64
293: VERSION_E4AC=$63
294: BASIC_END := $E3A2
295: SET_COLOR_FRAME := COL_BLACK
296: SET_COLOR_BACKGROUND := COL_BLACK
297: TEXT_SHIFTRUNSTOP = TEXT_LOADRUN
298: END_TEXT_SHIFTRUNSTOP = END_TEXT_LOADRUN
299:
300: DEFAULT_COLOR := COL_WHITE
301:
302: .elseif CompileComputer=C64_SX64
303: DRIVEFILLER=$AA
304: VERSION_FF80=$43
305: VERSION_E4AC=$B3
306: BASIC_END := $E3A2
307: SET_COLOR_FRAME := COL_CYAN
308: SET_COLOR_BACKGROUND := COL_WHITE
309: TEXT_SHIFTRUNSTOP = TEXT_LOAD_8_RUN
310: END_TEXT_SHIFTRUNSTOP = END_TEXT_LOAD_8_RUN
311:
312: DEFAULT_COLOR := COL_BLUE
313:
314: .elseif CompileComputer=C64_GS
315: DRIVEFILLER=$AA
316: VERSION_FF80=3
317: VERSION_E4AC=$81
318: BASIC_END := $E3A2
319: SET_COLOR_FRAME := COL_LIGHTBLUE
320: SET_COLOR_BACKGROUND := COL_BLUE
321: TEXT_SHIFTRUNSTOP = TEXT_LOADRUN
322: END_TEXT_SHIFTRUNSTOP = END_TEXT_LOADRUN
323:
324: DEFAULT_COLOR := COL_LIGHTBLUE
325:
326: .endif
327:
328: CHKSUM_BF52 = $EC
329:
330: EDITOR_TAB = 10
331: EDITOR_COLS = 40
332: EDITOR_ROWS = 25
333:
334: EDITOR_MAX_COMBINED_ROWS = 2
335: ; .include "memory.inc"
336: ; .include "../basic/basic-memory.inc"
337: .segment "MEM_BASIC_ZP": zeropage
338:
339: zADRAY1: .res 2 ; $0003
340: zADRAY2: .res 2 ; $0005
341: zCHARAC: .res 1 ; $0007
342: zENDCHR: .res 1 ; $0008
343: zTRMPOS: .res 1 ; $0009
344: zVERCK: .res 1 ; $000A
345: zCOUNT: .res 1 ; $000B
346: zDIMFLG: .res 1 ; $000C
347: zVALTYP: .res 1 ; $000D
348: zINTFLG: .res 1 ; $000E
349: zGARBFL: .res 1 ; $000F
350: zINTALLOWED: .res 1 ; $0010 ; TODO
351: zSUBFLG: .res 1 ; $0011
352: zTANSGN: .res 1 ; $0012
353: z13: .res 1 ; $0013 ; TODO
354: zLINNUM: .res 2 ; $0014
355: zTEMPPT: .res 1 ; $0016
356: zLASTPT: .res 2 ; $0017
357: zTEMPST: .res 5 ; $0019
358: zCHANNL: .res 4 ; $001E
359: zINDEX: .res 2 ; $0022
360: zINDEX2: .res 2 ; $0024
361: zRESHO: .res 5 ; $0026
362: zTEMP_28 := zRESHO + 2 ; TODO
363: zTXTTAB: .res 2 ; $002B
364: zVARTAB: .res 2 ; $002D
365: zARYTAB: .res 2 ; $002F
366: zSTREND: .res 2 ; $0031
367: zFRETOP: .res 2 ; $0033
368: zFRESPC: .res 2 ; $0035
369: zMEMSIZ: .res 2 ; $0037
370: zCURLIN: .res 2 ; $0039
371: zOLDLIN: .res 2 ; $003B
372: zOLDTXT: .res 2 ; $003D
373: zDATLIN: .res 2 ; $003F
374: zDATPTR: .res 2 ; $0041
375: zINPPTR: .res 2 ; $0043
376: zVARNAM: .res 2 ; $0045
377: zVARPNT: .res 2 ; $0047
378: zFORPNT: .res 2 ; $0049
379: zVARTXT: .res 2 ; $004B
380: zOPMASK: .res 1 ; $004D
381: zTEMPF3: .res 5 ; $004E
382: zTEMP_50 := zTEMPF3 + 2 ; TODO
383: zFOUR6: .res 1 ; $0053
384: zJMPER: .res 3 ; $0054
385: zTEMPF1: .res 5 ; $0057
386: zTEMP_58 := zTEMPF1 + 1 ; TODO
387: zTEMP_5A := zTEMPF1 + 3 ; TODO
388: zTEMPF2: .res 5 ; $005C
389: zTEMP_5D := zTEMPF2 + 1 ; TODO
390: zTEMP_5E := zTEMPF2 + 2 ; TODO
391: zTEMP_5F := zTEMPF2 + 3 ; TODO
392: zTEMP_60 := zTEMPF2 + 4 ; TODO
393: zFAC: .res 7 ; $0061
394: zFACEXP := zFAC ; $0061
395: zFACHO := zFAC + 1 ; $0062
396: zFACSGN := zFAC + 5 ; $0066
397: zSGNFLG := zFAC + 6 ; $0067
398: zBITS: .res 1 ; $0068
399: zARG: .res 7 ; $0069
400: zARGEXP := zARG ; $0069
401: zARGHO := zARG + 1 ; $006A
402: zARGSGN := zARG + 5 ; $006E
403: zARISGN := zARG + 6 ; $006F
404: zFACOV: .res 1 ; $0070
405: zFBUFPT: .res 2 ; $0071
406: zCHRGET: .res 6 ; $0073
407: zCHRGOT: .res 7 ; $0079
408: zCHRGOT_SPACE: .res 11 ; $0080
409: zTXTPTR := zCHRGOT + 1 ; $007A
410: zRNDX: .res 5 ; $008B
411:
412: .segment "MEM_BASIC_ZP2": zeropage
413:
414: zASCWRK: .res 1 ; $00FF
415:
416: .segment "STACK"
417:
418: lSTACK: .res 256
419:
420: .segment "MEM_BASIC_DATA_0200"
421:
422: lBUF: .res 89
423: END_lBUF:
424:
425: .segment "MEM_BASIC_DATA_0300"
426:
427: lIERROR: .res 2
428: lIMAIN: .res 2
429: lICRNCH: .res 2
430: lIQPLOP: .res 2
431: lIGONE: .res 2
432: lIEVAL: .res 2
433: lSAREG: .res 1
434: lSXREG: .res 1
435: lSYREG: .res 1
436: lSPREG: .res 1
437:
438: .if CompileComputer >= C64_GENERAL
439: .segment "MEM_BASIC_USR"
440: .else
441: .segment "MEM_BASIC_USR": zeropage
442: .endif
443:
444: lUSRPOK: .res 1
445: lUSRADD: .res 2
446:
447: .segment "C6510_ZP": zeropage
448:
449: zD6510: .res 1
450: zR6510: .res 1
451:
452: lVICSCN := $0400
453: lSPNTRN := $07F8
454:
455: CARTRIDGE := $8000
456: CART_RESET := CARTRIDGE + 0
457: CART_NMI := CARTRIDGE + 2
458: CART_MAGIC := CARTRIDGE + 4
459:
460: ; .include "../vic-ii.inc"
461: VICII_O_Sprite0X := 0
462: VICII_O_Sprite0Y := 1
463: VICII_O_Sprite1X := 2
464: VICII_O_Sprite1Y := 3
465: VICII_O_Sprite2X := 4
466: VICII_O_Sprite2Y := 5
467: VICII_O_Sprite3X := 6
468: VICII_O_Sprite3Y := 7
469: VICII_O_Sprite4X := 8
470: VICII_O_Sprite4Y := 9
471: VICII_O_Sprite5X := 10
472: VICII_O_Sprite5Y := 11
473: VICII_O_Sprite6X := 12
474: VICII_O_Sprite6Y := 13
475: VICII_O_Sprite7X := 14
476: VICII_O_Sprite7Y := 15
477: VICII_O_SpriteXMSB := 16 ; MSBs of all Sprite X coordinates; bit i corresponds to sprite i
478:
479: VICII_O_ControlReg1 := 17
480: VICII_B_ControlReg1_Raster8 := $80 ; bit 8 of VICII_O_Raster
481: VICII_B_ControlReg1_ECM := $40 ; extended color mode
482: VICII_B_ControlReg1_BMM := $20 ; bit map mode (HiRes)
483: VICII_B_ControlReg1_DEN := $10 ; display enable
484: VICII_B_ControlReg1_RSEL := $08 ; 1 = 25 rows, 0 = 24 rows
485: VICII_B_ControlReg1_YSCROLL_MASK := $07 ; offset from top in raster lines
486:
487: VICII_O_Raster := 18
488: VICII_O_LightPenX := 19
489: VICII_O_LightPenY := 20
490: VICII_O_SprEnable := 21 ; sprite enable: 1 = sprite is enabled. bit i corresponds to sprite i
491:
492: VICII_O_ControlReg2 := 22
493: VICII_B_ControlReg2_Reserved1 := $80 ; unused
494: VICII_B_ControlReg2_Reserved2 := $40 ; unused
495: VICII_B_ControlReg2_RES := $20 ; RESET on 6566; unused on 6567/6569
496: VICII_B_ControlReg2_MCM := $10 ; multicolor bitmap
497: VICII_B_ControlReg2_CSEL := $08 ; 1 = 40 colums, 0 = 38 columns
498: VICII_B_ControlReg2_XSCROLL_MASK := $07 ; offset in pixels from left side
499:
500: VICII_O_SprExpandY := 23 ; sprite Y expansion: 1 = sprite is expanded. bit i corresponds to sprite i
501:
502: VICII_O_MemControl := 24
503: VICII_B_MemControl_Reserved := $01
504: VICII_B_MemControl_CB_Mask := $0E
505: VICII_B_MemControl_VM_Mask := $F0
506:
507: VICII_O_IRQFlags := 25 ; interrupt register
508: VICII_B_IRQFlags_RST := $01
509: VICII_B_IRQFlags_MBC := $02
510: VICII_B_IRQFlags_MMC := $04
511: VICII_B_IRQFlags_LP := $08 ; lightpen
512: VICII_B_IRQFlags_Reserved := $70
513: VICII_B_IRQFlags_Any := $80 ; any IRQ happened
514:
515: VICII_O_IRQMasks := 26
516: VICII_B_IRQMasks_RST := VICII_B_IRQFlags_RST
517: VICII_B_IRQMasks_MBC := VICII_B_IRQFlags_MBC
518: VICII_B_IRQMasks_MMC := VICII_B_IRQFlags_MMC
519: VICII_B_IRQMasks_LP := VICII_B_IRQFlags_LP
520: VICII_B_IRQMasks_Reserved := $F0
521:
522: VICII_O_SprPriority := 27 ; sprite data priority: 1 = sprite is behind data, 0 = sprite is before. bit i corresponds to sprite i
523: VICII_O_SprMCM := 28 ; sprite multi color mode: 1 = sprite is multi-color. bit i corresponds to sprite i
524: VICII_O_SprExpandX := 29 ; sprite X expansion: 1 = sprite is expanded. bit i corresponds to sprite i
525: VICII_O_SprSprColl := 30 ; sprite-sprite collision: 1 = sprite has collided with another sprite. bit i corresponds to sprite i
526: VICII_O_SprBackColl := 31 ; sprite-background collision: 1 = sprite has collided with the background. bit i corresponds to sprite i
527:
528: VICII_O_BorderCol := 32 ; border color
529: VICII_O_BackgCol0 := 33 ; background color 0
530: VICII_O_BackgCol1 := 34 ; background color 1
531: VICII_O_BackgCol2 := 35 ; background color 2
532: VICII_O_BackgCol3 := 36 ; background color 3
533:
534: VICII_O_SprMCMCol0 := 37 ; multi-color sprite: color 0
535: VICII_O_SprMCMCol1 := 38 ; multi-color sprite: color 1
536:
537: VICII_O_Spr0Col := 39 ; sprite 0 color
538: VICII_O_Spr1Col := 40 ; sprite 1 color
539: VICII_O_Spr2Col := 41 ; sprite 2 color
540: VICII_O_Spr3Col := 42 ; sprite 3 color
541: VICII_O_Spr4Col := 43 ; sprite 4 color
542: VICII_O_Spr5Col := 44 ; sprite 5 color
543: VICII_O_Spr6Col := 45 ; sprite 6 color
544: VICII_O_Spr7Col := 46 ; sprite 7 color
545:
546: VICIIe_O_Keyboard := 47 ; bit 3..0: status of 4 additional keyboard pins (TODO: 3 or 4?)
547: VICIIe_B_Keyboard_Reserved_MASK := $F0 ; unused
548:
549: VICIIe_O_ControlReg3 := 48 ; TODO: Is there a test bit $02?
550: VICIIe_B_ControlReg3_2MHZ := $01 ; 1 = 2 MHz mode, 0 = 1 MHz mode
551: VICIIe_B_ControlReg3_Reserved_MASK := $FE ; unused
552:
553: COL_BLACK = 0
554: COL_WHITE = 1
555: COL_RED = 2
556: COL_CYAN = 3
557: COL_VIOLET = 4
558: COL_GREEN = 5
559: COL_BLUE = 6
560: COL_YELLOW = 7
561: COL_ORANGE = 8
562: COL_BROWN = 9
563: COL_LIGHTRED = 10
564: COL_GRAY1 = 11
565: COL_GRAY2 = 12
566: COL_LIGHTGREEN = 13
567: COL_LIGHTBLUE = 14
568: COL_GRAY3 = 15
569:
570: VIC := $D000
571:
572: ; .include "../sid.inc"
573: SID_O_Voc1FreqLo := 0
574: SID_O_Voc1FreqHi := 1
575: SID_O_Voc1PWidthLo := 2
576: SID_O_Voc1PWidthHi := 3
577: SID_O_Voc1Control := 4
578: SID_O_Voc1AttDec := 5
579: SID_O_Voc1SusRel := 6
580: SID_O_Voc2FreqLo := 7
581: SID_O_Voc2FreqHi := 8
582: SID_O_Voc2PWidthLo := 9
583: SID_O_Voc2PWidthHi := 10
584: SID_O_Voc2Control := 11
585: SID_O_Voc2AttDec := 12
586: SID_O_Voc2SusRel := 13
587: SID_O_Voc3FreqLo := 14
588: SID_O_Voc3FreqHi := 15
589: SID_O_Voc3PWidthLo := 16
590: SID_O_Voc3PWidthHi := 17
591: SID_O_Voc3Control := 18
592: SID_O_Voc3AttDec := 19
593: SID_O_Voc3SusRel := 20
594: SID_O_FiltFreqLo := 21
595: SID_O_FiltFreqHi := 22
596: SID_O_FiltControl := 23
597: SID_O_FiltMode := 24
598: SID_O_ADC1 := 25
599: SID_O_ADC2 := 26
600: SID_O_Random := 27
601: SID_O_Voc3Output := 28
602:
603: SID := $D400
604:
605: COLORRAM := $D800
606:
607: ; .include "../cia.inc"
608: CIA_O_PA := 0
609: CIA_O_PB := 1
610: CIA_O_DDRA := 2
611: CIA_O_DDRB := 3
612: CIA_O_TALO := 4
613: CIA_O_TAHI := 5
614: CIA_O_TBLO := 6
615: CIA_O_TBHI := 7
616: CIA_O_TOD10THS := 8
617: CIA_O_TODSEC := 9
618: CIA_O_TODMIN := 10
619: CIA_O_TODHR := 11
620: CIA_O_SDR := 12
621: CIA_O_ICR := 13
622: CIA_O_CRA := 14
623: CIA_O_CRB := 15
624:
625: CIA_ICR_B_TA := $01 ; bit: timer A underflow
626: CIA_ICR_B_TB := $02 ; bit: timer B underflow
627: CIA_ICR_B_TOD := $04 ; bit: TOD alarm
628: CIA_ICR_B_SP := $08 ; bit: Serial port full/empty
629: CIA_ICR_B_FLAG := $10 ; bit: external -FLAG
630: CIA_ICR_B_UNUSED := $60
631: CIA_ICR_BR_IR := $80 ; bit: any interrupt occurred (read-only)
632: CIA_ICR_BW_SET := $80 ; bit: set (=1) or clear (=0) bit (write-only)
633: CIA_ICR_BW_UNSET := $00 ;
634:
635: CIA_CRA_B_START := $01 ; 1 = start timer A, 0 = stop timer A
636: CIA_CRA_B_PBON := $02 ; 1 = timer A output appears on PB6, 0 = PB6 is not affected by timer
637: CIA_CRA_B_TOGGLE := $04 ; PB6 output mode: 1 = toggle, 0 = pulse
638: CIA_CRA_B_ONESHOT := $08 ; 1 = one shot timer, 0 = continuous mode
639: CIA_CRA_B_FORCE_LOAD := $10 ; 1 = force load (this is a strobe, that is, it will always be read as "0")
640: CIA_CRA_B_COUNT_CNT := $20 ; 1 = timer A counts positive edges of CNT, 0 = timer A counts PHI2 pulses
641: CIA_CRA_B_SP_OUTPUT := $40 ; 1 = serial port (SP) is output, 0 = it is input
642: CIA_CRA_B_50HZ := $80 ; 1 = 50Hz clock at TOD, 0 = 60Hz clock
643:
644: CIA_CRB_B_START := $01 ; 1 = start timer B, 0 = stop timer B
645: CIA_CRB_B_PBON := $02 ; 1 = timer B output appears on PB7, 0 = PB7 is not affected by timer
646: CIA_CRB_B_TOGGLE := $04 ; PB7 output mode: 1 = toggle, 0 = pulse
647: CIA_CRB_B_ONESHOT := $08 ; 1 = one shot timer, 0 = continuous mode
648: CIA_CRB_B_FORCE_LOAD := $10 ; 1 = force load (this is a strobe, that is, it will always be read as "0")
649: CIA_CRB_B_TOD_ALARM := $80 ; 1 = writing to TOD registers sets ALARM, 0 = writing to TOD registers sets time-of-day
650:
651: CIA_CRB_B_MODE_MASK := $60 ; mask bits for setting the timer B count mode
652: CIA_CRB_B_MODE_PHI2 := $00 ; timer B counts PHI2 pulses
653: CIA_CRB_B_MODE_CNT := $20 ; timer B counts positive edges of CNT
654: CIA_CRB_B_MODE_TA_ := $40 ; timer B counts timer A underflows
655: CIA_CRB_B_MODE_TA_WITH_CNT := $60 ; timer B counts timer A underflows which occur while CNT is high
656:
657: CIA1 := $DC00
658:
659: CIA2 := $DD00
660:
661: CIA2_PA_B_VA14 := $01
662: CIA2_PA_B_VA15 := $02
663: CIA2_PA_B_RS232_TXD := $04
664: CIA2_PA_B_IEC_ATN_OUT := $08
665: CIA2_PA_B_IEC_CLK_OUT := $10
666: CIA2_PA_B_IEC_DATA_OUT := $20
667: CIA2_PA_B_IEC_CLK_IN := $40
668: CIA2_PA_B_IEC_DATA_IN := $80
669:
670: CIA2_PB_B_RS232_RXD := $01 ; also connected with -FLAG
671: CIA2_PB_B_RS232_RTS := $02
672: CIA2_PB_B_RS232_DTR := $04
673: CIA2_PB_B_RS232_RING := $08
674: CIA2_PB_B_RS232_DCD := $10
675: CIA2_PB_B_RS232_PB5 := $20 ; unused
676: CIA2_PB_B_RS232_CTS := $40
677: CIA2_PB_B_RS232_DSR := $80
678:
679:
680: P6510_B_LORAM := $01
681: P6510_B_HIRAM := $02
682: P6510_B_CHAREN := $04
683: P6510_B_CASS_WRITE := $08
684: P6510_B_CASS_SENSE := $10
685: P6510_B_CASS_MOTOR := $20
686: P6510_B_UNUSED := $C0
687:
688: P6510_B_MASK := ~ P6510_B_UNUSED
689:
690: IOBASE := CIA1
691:
692: FILE_KEYBOARD := 0
693: FILE_TAPE := 1
694: FILE_RS232 := 2
695: FILE_SCREEN := 3
696: FILE_IEC := 4
697:
698: KEY_SHIFTRUN := $83
699:
700: IEC_REG := CIA2 + CIA_O_PA
701: IEC_DDR := CIA2 + CIA_O_DDRA
702:
703: IEC_B_ATN_OUT := CIA2_PA_B_IEC_ATN_OUT
704: IEC_B_CLK_OUT := CIA2_PA_B_IEC_CLK_OUT
705: IEC_B_DATA_OUT := CIA2_PA_B_IEC_DATA_OUT
706: IEC_B_CLK_IN := CIA2_PA_B_IEC_CLK_IN
707: IEC_B_DATA_IN := CIA2_PA_B_IEC_DATA_IN
708:
709: IEC_REG_ATN_OUT := CIA2 + CIA_O_PA
710: IEC_REG_DATA_CLK_OUT := CIA2 + CIA_O_PA
711: IEC_REG_DATA_CLK_IN := CIA2 + CIA_O_PA
712:
713: IEC_TIMER_LO := CIA1 + CIA_O_TBLO
714: IEC_TIMER_HI := CIA1 + CIA_O_TBHI
715:
716: IEC_TIMER_FLAG_REG := CIA1 + CIA_O_ICR
717: IEC_TIMER_FLAG_B := CIA_ICR_B_TB
718:
719: TAPE_REG := zR6510
720: TAPE_DDR := zD6510
721: TAPE_B_WRITE := P6510_B_CASS_WRITE
722: TAPE_B_SENSE := P6510_B_CASS_SENSE
723: TAPE_B_MOTOR_ON_ALL := P6510_B_CASS_MOTOR
724: TAPE_B_MOTOR_ON := P6510_B_CASS_MOTOR
725: TAPE_B_MOTOR_OFF_AND := ~ P6510_B_CASS_MOTOR & P6510_B_MASK
726:
727: TAPE_REG_WRITE := zR6510
728: TAPE_REG_SENSE := zR6510
729: TAPE_REG_MOTOR := zR6510
730: TAPE_REG_ICR := CIA1 + CIA_O_ICR
731: TAPE_REG_ICR_B_CLEARALL := CIA_ICR_BW_UNSET | $7F
732: TAPE_REG_ICR_B_CASSREAD := CIA_ICR_BW_SET | CIA_ICR_B_FLAG
733: TAPE_REG_ICR_B_WR_TIMER := CIA_ICR_BW_SET | CIA_ICR_B_TB
734: TAPE_REG_ICR_B_SET_3 := CIA_ICR_BW_SET | CIA_ICR_B_TA
735: TAPE_REG_ICR_B_UNSET_3 := CIA_ICR_BW_UNSET | CIA_ICR_B_TA
736:
737: TAPE_TIMER1_LO := CIA1 + CIA_O_TBLO
738: TAPE_TIMER1_HI := CIA1 + CIA_O_TBHI
739: TAPE_TIMER2_LO := CIA1 + CIA_O_TALO
740: TAPE_TIMER2_HI := CIA1 + CIA_O_TAHI
741: TAPE_TIMER1_CONST := $16
742:
743: KEYB_ROW := CIA1 + CIA_O_PA
744: KEYB_COL := CIA1 + CIA_O_PB
745: KEYB_COL_FOR_STOP := KEYB_COL
746:
747: KEYB_ROW_CTRL := $7F
748: KEYB_COL_CTRL := $FB
749: KEYB_ROW_STOP := $BD
750: KEYB_ROW_STANDARD := $7F
751: KEYB_CHECK_STOP := $7F
752:
753: RS232_TXD_REG := CIA2 + CIA_O_PA
754: RS232_TXD_BIT := CIA2_PA_B_RS232_TXD
755:
756: RS232_REG_1 := CIA2 + CIA_O_PB
757: RS232_REG_2 := CIA2 + CIA_O_PB
758: RS232_TIMER_LO := CIA2 + CIA_O_TALO
759: RS232_TIMER_HI := CIA2 + CIA_O_TAHI
760:
761: ; .include "../basic/basic2.inc"
762:
763: .segment "HEADER"
764:
765: BASIC_START:
766:
767: bRESTART:
768: .addr LE394
769: .addr LE37B
770: .byte "CBMBASIC"
771:
772: ; This is the table of the entry addresses of the various
773: ; BASIC commands. Every address is " - 1" as this table is
774: ; used in pushing the address onto the stack and perfoming
775: ; an RTS afterwards.
776:
777: .segment "VECTORS"
778:
779: .segment "KEYWORDS"
780:
781: CONFIG_FILE=1
782: CONFIG_CBM_ALL=1
783: CONFIG_2=1
784:
785: ; .include "token.s"
786:
787: .segment "VECTORS"
788:
789: bSTMDSP = TOKEN_ADDRESS_TABLE
790: bFUNDSP = UNFNC
791:
792:
793: ; This is the table of the BASIC functions.
794:
795: ; This is the table of the operands. Every entry consists
796: ; of 3 consecutive bytes: A first byte (@?) and the address
797: ; of the processing function ( - 1).
798:
799: bOPTAB = MATHTBL
800:
801: ;.segment "KEYWORDS"
802:
803: bRESLST = TOKEN_NAME_TABLE
804:
805: ; This is the list of the reserved words. Every word ends
806: ; with the last byte having bit 7 set.
807: ; The list ends with the last byte being 0.
808: ; The complete list is not allowed to exceed 256 byte!
809:
810: TokPi = $FF
811:
812:
813: .segment "ERROR"
814:
815: ; This is the table of error strings. Every entry ends with
816: ; bit 7 set.
817:
818: ErrTooManyFiles = 1
819: ErrFileOpen = 2
820: ErrFileNotOpen = 3
821: ErrFileNotFound = 4
822: ErrDeviceNotPresent = 5
823: ErrNotInputFile = 6
824: ErrNotOutputFile = 7
825: ErrMissingFileName = 8
826: ErrIllegalDeviceNumber = 9
827: ErrNextWithoutFor = 10
828: ErrSyntax = 11
829: ErrReturnWithoutGosub = 12
830: ErrOutOfData = 13
831: ErrIllegalQuantity = 14
832: ErrOverflow = 15
833: ErrOutOfMemory = 16
834: ErrUndefinedStatement = 17
835: ErrBadSubscript = 18
836: ErrRedimdArray = 19
837: ErrDivisionByZero = 20
838: ErrIllegalDirect = 21
839: ErrTypeMismatch = 22
840: ErrStringTooLong = 23
841: ErrFileData = 24
842: ErrFormulaTooComplex = 25
843: ErrCantContinue = 26
844: ErrUndefdFunction = 27
845: ErrVerify = 28
846: ErrLoad = 29
847: ErrBreak = 30
848:
849:
850: bERRTAB:
851: StrTooManyFiles:
852: htasc "TOO MANY FILES"
853: StrFileOpen:
854: htasc "FILE OPEN"
855: StrFileNotOpen:
856: htasc "FILE NOT OPEN"
857: StrFileNotFound:
858: htasc "FILE NOT FOUND"
859: StrDeviceNotPresent:
860: htasc "DEVICE NOT PRESENT"
861: StrNotInputFile:
862: htasc "NOT INPUT FILE"
863: StrNotOutputFile:
864: htasc "NOT OUTPUT FILE"
865: StrMissingFileName:
866: htasc "MISSING FILE NAME"
867: StrIllegalDeviceNumber:
868: htasc "ILLEGAL DEVICE NUMBER"
869: StrNextWithoutFor:
870: htasc "NEXT WITHOUT FOR"
871: StrSyntax:
872: htasc "SYNTAX"
873: StrReturnWithoutGosub:
874: htasc "RETURN WITHOUT GOSUB"
875: StrOutOfData:
876: htasc "OUT OF DATA"
877: StrIllegalQuantity:
878: htasc "ILLEGAL QUANTITY"
879: StrOverflow:
880: htasc "OVERFLOW"
881: StrOutOfMemory:
882: htasc "OUT OF MEMORY"
883: StrUndefinedStatement:
884: htasc "UNDEF'D STATEMENT"
885: StrBadSubscript:
886: htasc "BAD SUBSCRIPT"
887: StrRedimdArray:
888: htasc "REDIM'D ARRAY"
889: StrDivisionByZero:
890: htasc "DIVISION BY ZERO"
891: StrIllegalDirect:
892: htasc "ILLEGAL DIRECT"
893: StrTypeMismatch:
894: htasc "TYPE MISMATCH"
895: StrStringTooLong:
896: htasc "STRING TOO LONG"
897: StrFileData:
898: htasc "FILE DATA"
899: StrFormulaTooComplex:
900: htasc "FORMULA TOO COMPLEX"
901: StrCantContinue:
902: htasc "CAN'T CONTINUE"
903: StrUndefdFunction:
904: htasc "UNDEF'D FUNCTION"
905: StrVerify:
906: htasc "VERIFY"
907: StrLoad:
908: htasc "LOAD"
909:
910: ; This is the list of pointers into the error strings.
911:
912: bERRPTR:
913: .addr StrTooManyFiles
914: .addr StrFileOpen
915: .addr StrFileNotOpen
916: .addr StrFileNotFound
917: .addr StrDeviceNotPresent
918: .addr StrNotInputFile
919: .addr StrNotOutputFile
920: .addr StrMissingFileName
921: .addr StrIllegalDeviceNumber
922: .addr StrNextWithoutFor
923: .addr StrSyntax
924: .addr StrReturnWithoutGosub
925: .addr StrOutOfData
926: .addr StrIllegalQuantity
927: .addr StrOverflow
928: .addr StrOutOfMemory
929: .addr StrUndefinedStatement
930: .addr StrBadSubscript
931: .addr StrRedimdArray
932: .addr StrDivisionByZero
933: .addr StrIllegalDirect
934: .addr StrTypeMismatch
935: .addr StrStringTooLong
936: .addr StrFileData
937: .addr StrFormulaTooComplex
938: .addr StrCantContinue
939: .addr StrUndefdFunction
940: .addr StrVerify
941: .addr StrLoad
942: .addr StrBreak
943:
944: bOKK: .byte $0D,"OK",$0D,$00
945:
946: .segment "CODE"
947:
948: StrError:
949: .if CompileComputer >= C64_GENERAL
950: .byte ' '
951: .else
952: .byte $0D
953: .endif
954: .byte " ERROR"
955: .byte $00
956:
957: StrIn:
958: .byte " IN "
959: .byte $00
960:
961: StrReady:
962: .byte $0D,$0A
963: .byte "READY."
964: .byte $0D,$0A,$00
965:
966: StrCrBreak:
967: .byte $0D,$0A
968: StrBreak:
969: .byte "BREAK"
970: .byte $00
971:
972: .byte $A0 ; @?
973:
974: ; This routine tries to find a stack entry for a
975: ; previous "FOR" statement.
976: ;
977: ; Input:
978: ; zFORPNT/zFORPNT + 1:
979: ; Contans the variable name of the variable given
980: ; by the "NEXT" command.
981: ; If ANY for has to be closed, zFORPNT + 1 is 0.
982: ;
983: ; Output:
984: ; X:
985: ; contains a pointer into the stack page
986: ; where the "FOR entry" is located.
987: ;
988: ; Z:
989: ; Is set iff an entry has been found.
990: ; OR the stack has been exhausted.
991: ;
992: ; zFORPNT/zFORPNT + 1:
993: ; contains the variable name of the variable
994: ; being "NEXT"ed, even if no variable name
995: ; was given on input.
996: ;
997: ; Remarks:
998: ; This function is tricks as it also handles the
999: ; FOR, GOSUB and RETURN statements. @
1000:
1001: bFNDFOR:
1002: tsx
1003: inx
1004: inx
1005: inx
1006: inx
1007: @Loop:
1008: ; first check if there is a "FOR entry"
1009: lda lSTACK + 1,x
1010: cmp #TokFor
1011: bne @Ret ; no FOR entry, return with error
1012:
1013: ; check if the user asked for a specific variable
1014: lda zFORPNT + 1
1015: bne @TestVar ; yes, this, test this variable
1016:
1017: ; no variable name was given, just take the current
1018: ; one out of the stack entry
1019: lda lSTACK + 2,x
1020: sta zFORPNT
1021: lda lSTACK + 3,x
1022: sta zFORPNT + 1
1023:
1024: ; now, test if the variable in the stack entry
1025: ; is the right one.
1026: ; If no variable is given, it will be the right one
1027: ; as we just took that one out of the stack entry.
1028: @TestVar:
1029: cmp lSTACK + 3,x
1030: bne @UnWind ; not the same, unwind the stack
1031: lda zFORPNT
1032: cmp lSTACK + 2,x
1033: beq @Ret ; ok, we found the variable, quit.
1034:
1035: ; we have not found the variable. Unwind the stack,
1036: ; that is, remove the current "FOR entry" and test
1037: ; if there is another one before that.
1038: @UnWind:
1039: ; add 18 to the stack pointer to skip to the next entry
1040: txa
1041: clc
1042: adc #18
1043: tax
1044:
1045: ; if we did not reach the end of the stack, test the next entry
1046: ; This one is a bit tricky. It only works as expected because
1047: ; X has been incremented four times at the beginning of this
1048: ; function.
1049: bne @Loop
1050:
1051: @Ret: rts
1052:
1053:
1054: bBLTU: jsr bREASON
1055: sta zSTREND
1056: sty zSTREND + 1
1057:
1058: ; Move memory around
1059: ;
1060: ; Input:
1061: ; zTEMP_5F: Old begin
1062: ; zTEMP_5A: Old end ( + 1)
1063: ; zTEMP_58: New end ( + 1)
1064: ;
1065: ; Remark:
1066: ; If both areas overlap, the new area has to be "above" the old one.
1067: ;
1068: MoveMem:
1069:
1070: @OldBegin = zTEMP_5F
1071: @OldEndP1 = zTEMP_5A
1072: @NewEndP1 = zTEMP_58
1073:
1074: ; calculate length of block to transfer
1075: ; via subtracting Old begin from old end ( + 1).
1076: ;
1077: sec
1078: lda @OldEndP1
1079: sbc @OldBegin
1080: sta zINDEX ; low byte of length into zIndex
1081: tay ; and remember it in Y, too.
1082: lda @OldEndP1 + 1
1083: sbc @OldBegin + 1
1084: tax ; now, the high byte of length is in X
1085:
1086: inx
1087: tya ; check low byte of length
1088: beq @SkipPartialPage ; is 0, thus, we do net have a partial page to process
1089:
1090: ; now, subtract "page hangover" (low byte of length to move)
1091: ; from OldEndP1 and NewEndP1.
1092: ; This way, we process this "hangover" at first. Afterwards, only complete
1093: ; pages have to be processed.
1094:
1095: lda @OldEndP1
1096: sec
1097: sbc zINDEX
1098: sta @OldEndP1
1099: bcs @CalcNewEnd
1100: dec @OldEndP1 + 1
1101: sec
1102:
1103: @CalcNewEnd:
1104: lda @NewEndP1
1105: sbc zINDEX
1106: sta @NewEndP1
1107: bcs @ProcessNextPage
1108: dec @NewEndP1 + 1
1109: bcc @ProcessNextPage ; unconditional jump
1110: ; --------------------------
1111:
1112: @Loop:
1113: lda (@OldEndP1),y ; copy from old...
1114: sta (@NewEndP1),y ; ... to new location
1115: @ProcessNextPage:
1116: dey ; number of bytes to process in this page
1117: bne @Loop ; not zero? Then, copy memory.
1118:
1119: ; copy the "last" byte of each page separately
1120: lda (@OldEndP1),y
1121: sta (@NewEndP1),y
1122:
1123: @SkipPartialPage:
1124: ; decrement the page numbers of source and destination
1125: ; and check if we have more pages to process (x).
1126:
1127: dec @OldEndP1 + 1
1128: dec @NewEndP1 + 1
1129: dex
1130: bne @ProcessNextPage
1131: rts
1132:
1133:
1134: ; check if there is enough memory on the stack
1135: ;
1136: ; Input:
1137: ; A:
1138: ; Half of the number of bytes to check for
1139: ; (that is, the number of double bytes)
1140: ;
1141: ; Output:
1142: ; If this function returns, there is enough memory
1143: ; on the stack.
1144: ;
1145: ; Remark:
1146: ; If there is not enough memory on the stack, this
1147: ; function does not return, but outputs an "?OUT OF MEMORY ERROR"
1148: ;
1149: bGETSTK:
1150: ; first of all, calculate how much byte we would not
1151: asl a ; as we are checking for double-words, multiply with 2
1152: adc #$3E ; add a "security area" (@? Why $3E = 62)
1153: bcs bOMERR ; we overflowed, that is, it would not even fit into the 256 byte stack
1154: sta zINDEX ; remember the value
1155:
1156: ; now, check if the stack pointer is higher than what we just calculated
1157: tsx
1158: cpx zINDEX
1159: bcc bOMERR
1160: rts
1161:
1162: bREASON:
1163: cpy zFRETOP + 1
1164: bcc @Ret
1165: bne @LA412
1166: cmp zFRETOP
1167: bcc @Ret
1168:
1169: ; save zTMPF1 and zTMPF2 area onto the stack
1170:
1171: @SAVE_AREA_SIZE = zFACEXP - zTEMPF1
1172:
1173: @LA412: pha
1174: ldx #@SAVE_AREA_SIZE - 1
1175: tya
1176: @LA416: pha
1177: lda zTEMPF1,x
1178: dex
1179: bpl @LA416
1180:
1181: jsr bGARBAG
1182:
1183: ; restore the zTMPF1 and zTMPF2 area from the stack
1184: ldx #-(@SAVE_AREA_SIZE - 1)
1185: @LA421: pla
1186: sta zTEMPF1 + @SAVE_AREA_SIZE,x
1187: inx
1188: bmi @LA421
1189: pla
1190: tay
1191: pla
1192: cpy zFRETOP + 1
1193: bcc @Ret
1194: bne bOMERR
1195: cmp zFRETOP
1196: bcs bOMERR
1197: @Ret: rts
1198:
1199: bOMERR: ldx #ErrOutOfMemory
1200: bERROR: jmp (lIERROR) ; for the VIC - 20, this is a no-op
1201: ; for the C64, only proceed if bit 7
1202: ; of the error code is not set
1203:
1204: ; output a specific error message
1205: ;
1206: ; Input:
1207: ; X:
1208: ; The number of the error message
1209: ;
1210: ; Remark:
1211: ; After outputting the message, this function returns into
1212: ; the main BASIC loop. It never returns to its caller.
1213: ;
1214: ErrorOut:
1215: txa ; multiply the error number with 2
1216: asl a ; (this gives a pointer into the error text table)
1217: tax
1218: lda bERRPTR - 2,x ; Get the low byte
1219: sta zINDEX
1220: lda bERRPTR - 1,x ; and the high byte into zIndex/zIndex + 1
1221: sta zINDEX + 1
1222:
1223: jsr kCLRCHN ; clear channel, that is, output to the screen
1224:
1225: lda #0 ; make sure: we do not want to output LF after CR anymore
1226: sta z13
1227: jsr bCRDO ; output a CR
1228:
1229: jsr LAB45 ; output a question mark '?'
1230:
1231: ; now, output the text from the table
1232:
1233: ldy #0 ; start at the first character of the text
1234: @Loop: lda (zINDEX),y ; get the next character
1235: pha ; remember it
1236: and #$7F ; clear bit 7 (thus, make it printable)
1237: jsr LAB47 ; output the character
1238: iny ; proceed to the next character
1239: pla ; get back the remembered character
1240: bpl @Loop ; if bit 7 was not set, proceed to the next character
1241:
1242: jsr LA67A ; initialize stack pointers (hardware stack and string stack)
1243:
1244: ; output the text "error"
1245:
1246: lda #<StrError
1247: ldy #>StrError
1248:
1249: bERRFIN:jsr bSTROUT ; output the text given in A/Y.a
1250:
1251: ldy zCURLIN + 1 ; get high byte of current line (is $FF if in direct mode)
1252: iny
1253: beq bREADY ; it was $FF, thus, skip th next instruction
1254: jsr bINPRT ; output "in line XXX"
1255:
1256: bREADY: lda #<StrReady
1257: ldy #>StrReady
1258: jsr bSTROUT
1259: lda #$80 ; set the direct modus flag
1260: jsr kSETMSG
1261:
1262: bMAIN: jmp (lIMAIN) ; points to IMAIN normally
1263: IMAIN: jsr bINLIN
1264: stx zTXTPTR
1265: sty zTXTPTR + 1
1266: jsr zCHRGET
1267: tax
1268: beq bMAIN
1269: 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
1270: stx zCURLIN + 1
1271: bcc bMAIN1
1272: jsr bCRUNCH
1273: jmp bGONE
1274: bMAIN1: jsr bLINGET
1275: jsr bCRUNCH
1276: bINSLIN:sty zCOUNT
1277:
1278: @58 = zTEMPF1 + 1
1279: @5A = zTEMPF1 + 3
1280:
1281: @5F = zTEMPF2 + 3
1282:
1283: jsr bFNDLIN
1284: bcc @LA4ED
1285: ldy #1
1286: lda (@5F),y
1287: sta zINDEX + 1
1288: lda zVARTAB
1289: sta zINDEX
1290: lda @5F + 1
1291: sta zINDEX2 + 1
1292: lda @5F
1293: dey
1294: sbc (@5F),y
1295: clc
1296: adc zVARTAB
1297: sta zVARTAB
1298: sta zINDEX2
1299: lda zVARTAB + 1
1300: adc #-1
1301: sta zVARTAB + 1
1302: sbc @5F + 1
1303: tax
1304: sec
1305: lda @5F
1306: sbc zVARTAB
1307: tay
1308: bcs @LA4D7
1309: inx
1310: dec zINDEX2 + 1
1311: @LA4D7:
1312: clc
1313: adc zINDEX
1314: bcc @LA4DF
1315: dec zINDEX + 1
1316: clc
1317: @LA4DF:
1318: lda (zINDEX),y
1319: sta (zINDEX2),y
1320: iny
1321: bne @LA4DF
1322: inc zINDEX + 1
1323: inc zINDEX2 + 1
1324: dex
1325: bne @LA4DF
1326: @LA4ED:
1327: jsr LA659
1328: jsr bLINKPRG
1329: lda lBUF
1330: beq bMAIN
1331: clc
1332: lda zVARTAB
1333: sta @5A
1334: adc zCOUNT
1335: sta @58
1336: ldy zVARTAB + 1
1337: sty @5A + 1
1338: bcc @LA508
1339: iny
1340: @LA508:
1341: sty @58 + 1
1342: jsr bBLTU
1343: lda zLINNUM
1344: ldy zLINNUM + 1
1345: sta lBUF - 2
1346: sty lBUF - 1
1347: lda zSTREND
1348: ldy zSTREND + 1
1349: sta zVARTAB
1350: sty zVARTAB + 1
1351: ldy zCOUNT
1352: dey
1353: @LA522:
1354: lda lBUF - 4,y
1355: sta (@5F),y
1356: dey
1357: bpl @LA522
1358: LA52A: jsr LA659
1359: jsr bLINKPRG
1360: jmp bMAIN
1361: bLINKPRG:
1362: lda zTXTTAB
1363: ldy zTXTTAB + 1
1364: sta zINDEX
1365: sty zINDEX + 1
1366: clc
1367: @LA53C:
1368: ldy #1
1369: lda (zINDEX),y
1370: beq @Ret
1371: ldy #4
1372: @LA544:
1373: iny
1374: lda (zINDEX),y
1375: bne @LA544
1376: iny
1377: tya
1378: adc zINDEX
1379: tax
1380: ldy #0
1381: sta (zINDEX),y
1382: lda zINDEX + 1
1383: adc #0
1384: iny
1385: sta (zINDEX),y
1386: stx zINDEX
1387: sta zINDEX + 1
1388: bcc @LA53C
1389: @Ret: rts
1390:
1391: bINLIN: ldx #0
1392: @LA562: jsr bCHIN
1393: cmp #ASC_CR
1394: beq @LA576
1395: sta lBUF,x
1396: inx
1397: cpx #END_lBUF - lBUF
1398: bcc @LA562
1399: ldx #ErrStringTooLong
1400: jmp bERROR
1401:
1402: @LA576: jmp bSTREND
1403:
1404: bCRUNCH:jmp (lICRNCH)
1405: LA57C: ldx zTXTPTR
1406: ldy #$04
1407: sty zGARBFL
1408: LA582: lda lBUF,x
1409: bpl @LA58E
1410: cmp #TokPi
1411: beq LA5C9
1412: inx
1413: bne LA582
1414: @LA58E:
1415: cmp #' '
1416: beq LA5C9
1417: sta zENDCHR
1418: cmp #'"'
1419: beq LA5EE
1420: bit zGARBFL
1421: bvs LA5C9
1422: cmp #'?'
1423: bne @LA5A4
1424: lda #TokPrint
1425: bne LA5C9
1426: @LA5A4:
1427: cmp #'0'
1428: bcc @LA5AC
1429: cmp #'<'
1430: bcc LA5C9
1431: @LA5AC:
1432: sty zFBUFPT
1433: ldy #0
1434: sty zCOUNT
1435: dey
1436: stx zTXTPTR
1437: dex
1438: LA5B6: iny
1439: inx
1440: LA5B8: lda lBUF,x
1441: sec
1442: sbc bRESLST,y
1443: beq LA5B6
1444: cmp #$80
1445: bne LA5F5
1446: ora zCOUNT
1447: LA5C7: ldy zFBUFPT
1448: LA5C9: inx
1449: iny
1450: sta lBUF - 5,y
1451: lda lBUF - 5,y
1452: beq LA609
1453: sec
1454: sbc #$3A ; ':' @?
1455: beq @LA5DC
1456: cmp #$49 ; DATA @?
1457: bne @LA5DE
1458: @LA5DC:
1459: sta zGARBFL
1460: @LA5DE:
1461: sec
1462: sbc #$55 ; REM @?
1463: bne LA582
1464: JDLA5E3:
1465: sta zENDCHR
1466: LA5E5: lda lBUF,x
1467: beq LA5C9
1468: cmp zENDCHR
1469: beq LA5C9
1470: LA5EE: iny
1471: sta lBUF - 5,y
1472: inx
1473: bne LA5E5
1474: LA5F5: ldx zTXTPTR
1475: inc zCOUNT
1476: @LA5F9: iny
1477: lda bRESLST - 1,y
1478: bpl @LA5F9
1479: lda bRESLST,y
1480: bne LA5B8
1481: lda lBUF,x
1482: bpl LA5C7
1483: LA609: sta lBUF - 3,y
1484: dec zTXTPTR + 1 ; = 1, this is (>(lBUF - 1))
1485: lda #<lBUF - 1
1486: sta zTXTPTR
1487: rts
1488:
1489: bFNDLIN:lda zTXTTAB
1490: ldx zTXTTAB + 1
1491: LA617: ldy #1
1492: sta zTEMP_5F
1493: stx zTEMP_5F + 1
1494: lda (zTEMP_5F),y
1495: beq @RetSuccess
1496: iny
1497: iny
1498: lda zLINNUM + 1
1499: cmp (zTEMP_5F),y
1500: bcc @Ret
1501: beq @LA62E
1502: dey
1503: bne @LA637
1504: @LA62E:
1505: lda zLINNUM
1506: dey
1507: cmp (zTEMP_5F),y
1508: bcc @Ret
1509: beq @Ret
1510: @LA637:
1511: dey
1512: lda (zTEMP_5F),y
1513: tax
1514: dey
1515: lda (zTEMP_5F),y
1516: bcs LA617
1517: @RetSuccess:
1518: clc
1519: @Ret: rts
1520:
1521: RetA641 = @Ret
1522:
1523: bSCRTCH:bne RetA641
1524: LA644: lda #0
1525: tay
1526: sta (zTXTTAB),y
1527: iny
1528: sta (zTXTTAB),y
1529: lda zTXTTAB
1530: clc
1531: adc #<2
1532: sta zVARTAB
1533: lda zTXTTAB + 1
1534: adc #>2
1535: sta zVARTAB + 1
1536:
1537: LA659: jsr bSTXPT
1538: lda #0
1539:
1540: bCLEAR: bne RetA68D
1541: LA660: jsr kCLALL
1542: LA663: lda zMEMSIZ
1543: ldy zMEMSIZ + 1
1544: sta zFRETOP
1545: sty zFRETOP + 1
1546: lda zVARTAB
1547: ldy zVARTAB + 1
1548: sta zARYTAB
1549: sty zARYTAB + 1
1550: sta zSTREND
1551: sty zSTREND + 1
1552: LA677: jsr bRESTOR
1553:
1554: LA67A: ldx #zTEMPST
1555: stx zTEMPPT
1556: pla
1557: tay
1558: pla
1559: ldx #-6
1560: txs ; Stackpointer to $01FA
1561: pha
1562: tya
1563: pha
1564: lda #0
1565: sta zOLDTXT + 1
1566: sta zINTALLOWED
1567: RetA68D:
1568: rts
1569:
1570: bSTXPT: clc
1571: lda zTXTTAB
1572: adc #<-1
1573: sta zTXTPTR
1574: lda zTXTTAB + 1
1575: adc #>-1
1576: sta zTXTPTR + 1
1577: rts
1578:
1579: bLIST: bcc LA6A4
1580: beq LA6A4
1581: cmp #TokMinus
1582: bne RetA68D
1583: LA6A4:
1584: jsr bLINGET
1585: jsr bFNDLIN
1586: jsr zCHRGOT
1587: beq @LA6BB
1588: cmp #TokMinus
1589: bne RetA641
1590: jsr zCHRGET
1591: jsr bLINGET
1592: bne RetA641
1593: @LA6BB:
1594: pla
1595: pla
1596: lda zLINNUM
1597: ora zLINNUM + 1
1598: bne LA6C9
1599: JDLA6C3:
1600: lda #-1
1601: sta zLINNUM
1602: sta zLINNUM + 1
1603: LA6C9: ldy #1
1604: sty zGARBFL
1605: lda (zTEMP_5F),y
1606: beq LA714
1607: jsr bSTOP
1608: JDLA6D4:
1609: jsr bCRDO
1610: iny
1611: lda (zTEMP_5F),y
1612: tax
1613: iny
1614: lda (zTEMP_5F),y
1615: cmp zLINNUM + 1
1616: bne @LA6E6
1617: cpx zLINNUM
1618: beq @LA6E8
1619: @LA6E6: bcs LA714
1620: @LA6E8: sty zFORPNT
1621: jsr LBDCD
1622: lda #' '
1623: LA6EF: ldy zFORPNT
1624: and #$7F
1625: LA6F3: jsr LAB47
1626: cmp #'"'
1627: bne LA700
1628: lda zGARBFL
1629: eor #$FF
1630: sta zGARBFL
1631: LA700: iny
1632: beq LA714
1633: lda (zTEMP_5F),y
1634: bne bQPLOP
1635: tay
1636: lda (zTEMP_5F),y
1637: tax
1638: iny
1639: lda (zTEMP_5F),y
1640: stx zTEMP_5F
1641: sta zTEMP_5F + 1
1642: bne LA6C9
1643: LA714:
1644: .if CompileComputer >= C64_GENERAL
1645: jmp ReadyVector
1646: .else
1647: jmp bREADY
1648: .endif
1649:
1650: bQPLOP: jmp (lIQPLOP)
1651: LA71A: bpl LA6F3
1652: cmp #TokPi
1653: beq LA6F3
1654: bit zGARBFL
1655: bmi LA6F3
1656: sec
1657: sbc #$7F
1658: tax
1659: sty zFORPNT
1660: ldy #$FF
1661: @LA72C:
1662: dex
1663: beq @LA737
1664: @LA72F:
1665: iny
1666: lda bRESLST,y
1667: bpl @LA72F
1668: bmi @LA72C
1669: @LA737:
1670: iny
1671: lda bRESLST,y
1672: bmi LA6EF
1673: jsr LAB47
1674: bne @LA737
1675:
1676: bFOR: lda #$80
1677: sta zINTALLOWED
1678: jsr bLET
1679: jsr bFNDFOR
1680: bne @LA753
1681: txa
1682: adc #$0F
1683: tax
1684: txs
1685: @LA753:
1686: pla
1687: pla
1688: lda #$09
1689: jsr bGETSTK
1690: jsr bDATAN
1691: clc
1692: tya
1693: adc zTXTPTR
1694: pha
1695: lda zTXTPTR + 1
1696: adc #0
1697: pha
1698: lda zCURLIN + 1
1699: pha
1700: lda zCURLIN
1701: pha
1702: lda #TokTo
1703: jsr LAEFF
1704: jsr LAD8D
1705: jsr bFRMNUM
1706: lda zFACSGN
1707: ora #$7F
1708: and zFACHO
1709: sta zFACHO
1710: lda #<@LA78B
1711: ldy #>@LA78B
1712: sta zINDEX
1713: sty zINDEX + 1
1714: jmp LAE43
1715:
1716: @LA78B:
1717: lda #<bFPTABL
1718: ldy #>bFPTABL
1719: jsr bMOVFM
1720: jsr zCHRGOT
1721: cmp #TokStep
1722: bne @LA79F
1723: jsr zCHRGET
1724: jsr bFRMNUM
1725: @LA79F:
1726: jsr bSIGN
1727: jsr LAE38
1728: lda zFORPNT + 1
1729: pha
1730: lda zFORPNT
1731: pha
1732: lda #TokFor
1733: pha
1734: bNEWSTT:jsr bSTOP
1735: lda zTXTPTR
1736: ldy zTXTPTR + 1
1737: cpy #>lBUF
1738: nop
1739: beq @LA7BE
1740: sta zOLDTXT
1741: sty zOLDTXT + 1
1742: @LA7BE:
1743: ldy #0
1744: lda (zTXTPTR),y
1745: bne LA807
1746:
1747: bCKEOL: ldy #2
1748: lda (zTXTPTR),y
1749: clc
1750: bne @LA7CE
1751: jmp LA84B
1752: @LA7CE:
1753: iny
1754: lda (zTXTPTR),y
1755: sta zCURLIN
1756: iny
1757: lda (zTXTPTR),y
1758: sta zCURLIN + 1
1759: tya
1760: adc zTXTPTR
1761: sta zTXTPTR
1762: bcc bGONE
1763: inc zTXTPTR + 1
1764:
1765: bGONE: jmp (lIGONE)
1766: LA7E4: jsr zCHRGET
1767: jsr bGONE3
1768: jmp bNEWSTT
1769: bGONE3: beq RetA82B
1770: LA7EF: sbc #TokEnd
1771: bcc @LA804
1772: cmp #TokTab - TokEnd
1773: bcs LA80E
1774: asl a
1775: tay
1776: lda bSTMDSP + 1,y
1777: pha
1778: lda bSTMDSP,y
1779: pha
1780: jmp zCHRGET
1781: @LA804:
1782: jmp bLET
1783:
1784: LA807: cmp #':'
1785: beq bGONE
1786: LA80B: jmp bSYNERR
1787:
1788: LA80E: cmp #TokGo - $80
1789: bne LA80B
1790: jsr zCHRGET
1791: lda #TokTo
1792: jsr LAEFF
1793: jmp bGOTO
1794: bRESTOR:sec
1795: lda zTXTTAB
1796: sbc #1
1797: ldy zTXTTAB + 1
1798: bcs LA827
1799: dey
1800: LA827: sta zDATPTR
1801: sty zDATPTR + 1
1802: RetA82B:
1803: rts
1804:
1805: bSTOP: jsr kSTOP
1806: bSTOP2: bcs LA832
1807: bEND: clc
1808: LA832: bne RetA870
1809: lda zTXTPTR
1810: ldy zTXTPTR + 1
1811: ldx zCURLIN + 1
1812: inx
1813: beq @LA849
1814: sta zOLDTXT
1815: sty zOLDTXT + 1
1816: lda zCURLIN
1817: ldy zCURLIN + 1
1818: sta zOLDLIN
1819: sty zOLDLIN + 1
1820: @LA849:
1821: pla
1822: pla
1823:
1824: LA84B: lda #<StrCrBreak
1825: ldy #>StrCrBreak
1826: bcc LA854
1827: jmp bERRFIN
1828:
1829: LA854:
1830: .if CompileComputer >= C64_GENERAL
1831: jmp ReadyVector
1832: .else
1833: jmp bREADY
1834: .endif
1835:
1836: bCONT: bne RetA870
1837: ldx #ErrCantContinue
1838: ldy zOLDTXT + 1
1839: bne @LA862
1840: jmp bERROR
1841:
1842: @LA862:
1843: lda zOLDTXT
1844: sta zTXTPTR
1845: sty zTXTPTR + 1
1846: lda zOLDLIN
1847: ldy zOLDLIN + 1
1848: sta zCURLIN
1849: sty zCURLIN + 1
1850: RetA870:
1851: rts
1852:
1853: bRUN: php
1854: lda #0
1855: jsr kSETMSG
1856: plp
1857: bne @LA87D
1858: jmp LA659
1859:
1860: @LA87D:
1861: jsr LA660
1862: jmp LA897
1863:
1864: bGOSUB: lda #3 ; we want to push 3 16 bit values on the stack
1865: jsr bGETSTK ; check for enough memory on stack
1866: lda zTXTPTR + 1
1867: pha
1868: lda zTXTPTR
1869: pha
1870: lda zCURLIN + 1
1871: pha
1872: lda zCURLIN
1873: pha
1874: lda #TokGosub
1875: pha
1876:
1877: LA897: jsr zCHRGOT
1878: jsr bGOTO
1879: jmp bNEWSTT
1880:
1881: bGOTO: jsr bLINGET
1882: jsr LA909
1883: sec
1884: lda zCURLIN
1885: sbc zLINNUM
1886: lda zCURLIN + 1
1887: sbc zLINNUM + 1
1888: bcs @LA8BC
1889: tya
1890: sec
1891: adc zTXTPTR
1892: ldx zTXTPTR + 1
1893: bcc @LA8C0
1894: inx
1895: bcs @LA8C0
1896: @LA8BC:
1897: lda zTXTTAB
1898: ldx zTXTTAB + 1
1899: @LA8C0:
1900: jsr LA617
1901: bcc LA8E3
1902: lda zTEMP_5F
1903: sbc #<1
1904: sta zTXTPTR
1905: lda zTEMP_5F + 1
1906: sbc #>0
1907: sta zTXTPTR + 1
1908: RetA8D1:
1909: rts
1910:
1911: bRETURN:bne RetA8D1
1912: lda #-1
1913: sta zFORPNT + 1
1914: jsr bFNDFOR
1915: txs
1916: cmp #TokGosub
1917: beq LA8EB
1918: ldx #ErrReturnWithoutGosub
1919: .byte ASM_BIT3
1920: LA8E3: ldx #ErrUndefinedStatement
1921: jmp bERROR
1922: LA8E8: jmp bSYNERR
1923: LA8EB: pla
1924: pla
1925: sta zCURLIN
1926: pla
1927: sta zCURLIN + 1
1928: pla
1929: sta zTXTPTR
1930: pla
1931: sta zTXTPTR + 1
1932:
1933: bDATA: jsr bDATAN
1934: LA8FB: tya
1935:
1936: JDLA8FC:
1937: clc
1938: adc zTXTPTR
1939: sta zTXTPTR
1940: bcc RetA905
1941: inc zTXTPTR + 1
1942: RetA905:
1943: rts
1944:
1945: bDATAN: ldx #':'
1946: .byte ASM_BIT3
1947: LA909: ldx #0 ; end of line
1948: stx zCHARAC
1949: ldy #0
1950: sty zENDCHR
1951: LA911:
1952: lda zENDCHR
1953: ldx zCHARAC
1954: sta zCHARAC
1955: JDLA917:
1956: stx zENDCHR
1957: @LA919:
1958: lda (zTXTPTR),y
1959: beq RetA905
1960: cmp zENDCHR
1961: beq RetA905
1962: iny
1963: cmp #'"'
1964: bne @LA919
1965: beq LA911
1966: ; ----------------
1967:
1968: bIF: jsr bFRMEVL
1969: jsr zCHRGOT
1970: cmp #TokGoto
1971: beq @LA937
1972: lda #TokThen
1973: jsr LAEFF
1974: @LA937:
1975: lda zFACEXP
1976: bne LA940
1977:
1978: bREM: jsr LA909
1979: beq LA8FB
1980: LA940: jsr zCHRGOT
1981: bcs @LA948
1982: jmp bGOTO
1983:
1984: @LA948:
1985: jmp bGONE3
1986:
1987: bONGOTO:jsr LB79E
1988: pha
1989: cmp #TokGosub
1990: beq LA957
1991: LA953: cmp #TokGoto
1992: bne LA8E8
1993: LA957: dec zFACHO + 3
1994: bne @LA95F
1995: pla
1996: jmp LA7EF
1997: @LA95F:
1998: jsr zCHRGET
1999: jsr bLINGET
2000: cmp #','
2001: beq LA957
2002: pla
2003: RetA96A:
2004: rts
2005:
2006: bLINGET:ldx #0
2007: stx zLINNUM
2008: stx zLINNUM + 1
2009: @LA971:
2010: bcs RetA96A
2011: sbc #'0' - 1
2012: sta zCHARAC
2013: lda zLINNUM + 1
2014: sta zINDEX
2015: cmp #>6400 ; interestingly, <6400 is 0.
2016: bcs LA953
2017: lda zLINNUM
2018: asl a
2019: rol zINDEX
2020: asl a
2021: rol zINDEX
2022: adc zLINNUM
2023: sta zLINNUM
2024: lda zINDEX
2025: adc zLINNUM + 1
2026: sta zLINNUM + 1
2027: asl zLINNUM
2028: rol zLINNUM + 1
2029: lda zLINNUM
2030: adc zCHARAC
2031: sta zLINNUM
2032: bcc @LA99F
2033: inc zLINNUM + 1
2034: @LA99F:
2035: jsr zCHRGET
2036: jmp @LA971
2037:
2038: bLET: jsr bPTRGET
2039: sta zFORPNT
2040: sty zFORPNT + 1
2041: lda #TokEqual
2042: jsr LAEFF
2043: lda zINTFLG
2044: pha
2045: lda zVALTYP
2046: pha
2047: jsr bFRMEVL
2048: pla
2049: rol a
2050: jsr LAD90
2051: bne bPUTSTR
2052: pla
2053: LA9C2: bpl bPTFLPT
2054:
2055: bPUTINT:jsr bROUND
2056: jsr bAYINT
2057: ldy #0
2058: lda zFACHO + 2
2059: sta (zFORPNT),y
2060: iny
2061: lda zFACHO + 3
2062: sta (zFORPNT),y
2063: rts
2064: bPTFLPT:jmp LBBD0
2065:
2066: bPUTSTR:pla
2067: LA9DA: ldy zFORPNT + 1
2068: cpy #>bTI ; is the variable TI$?
2069: bne bGETSPT
2070: jsr LB6A6
2071: bPUTTIM:cmp #6
2072: bne @LAA24
2073: ldy #0
2074: sty zFACEXP
2075: sty zFACSGN
2076: @LA9ED:
2077: sty zFBUFPT
2078: jsr @LAA1D
2079: jsr bMUL10
2080: inc zFBUFPT
2081: ldy zFBUFPT
2082: jsr @LAA1D
2083: jsr bMOVAF
2084: tax
2085: beq @LAA07
2086: inx
2087: txa
2088: jsr LBAED
2089: @LAA07:
2090: ldy zFBUFPT
2091: iny
2092: cpy #6
2093: bne @LA9ED
2094: jsr bMUL10
2095: jsr bQINT
2096: ldx zFACHO + 2
2097: ldy zFACHO + 1
2098: lda zFACHO + 3
2099: jmp kSETTIM
2100:
2101: @LAA1D:
2102: lda (zINDEX),y
2103: jsr zCHRGOT_SPACE
2104: bcc @LAA27
2105: @LAA24:
2106: jmp bIQERR
2107:
2108: @LAA27:
2109: sbc #'0' - 1 ; carry is already set!
2110: jmp LBD7E
2111:
2112: bGETSPT:ldy #2
2113: lda (zFACHO + 2),y
2114: cmp zFRETOP + 1
2115: bcc @LAA4B
2116: bne @LAA3D
2117: dey
2118: lda (zFACHO + 2),y
2119: cmp zFRETOP
2120: bcc @LAA4B
2121: @LAA3D:
2122: ldy zFACHO + 3
2123: cpy zVARTAB + 1
2124: bcc @LAA4B
2125: bne @LAA52
2126: lda zFACHO + 2
2127: cmp zVARTAB
2128: bcs @LAA52
2129: @LAA4B:
2130: lda zFACHO + 2
2131: ldy zFACHO + 3
2132: jmp @LAA68
2133:
2134: @LAA52:
2135: ldy #0
2136: lda (zFACHO + 2),y
2137: jsr LB475
2138: lda zTEMP_50
2139: ldy zTEMP_50 + 1
2140: sta zARISGN
2141: sty zFACOV
2142: jsr bMOVINS
2143: lda #<zFAC
2144: ldy #>zFAC
2145: @LAA68:
2146: sta zTEMP_50
2147: sty zTEMP_50 + 1
2148: jsr bFREFAC
2149: ldy #0
2150: lda (zTEMP_50),y
2151: sta (zFORPNT),y
2152: iny
2153: lda (zTEMP_50),y
2154: sta (zFORPNT),y
2155: iny
2156: lda (zTEMP_50),y
2157: sta (zFORPNT),y
2158: rts
2159:
2160: bPRINTN:jsr bCMD
2161: jmp LABB5
2162:
2163: bCMD: jsr LB79E
2164: beq @LAA90
2165: lda #','
2166: jsr LAEFF
2167: @LAA90:
2168: php
2169: stx z13
2170: jsr bCKOUT
2171: plp
2172: jmp bPRINT
2173:
2174: bSTRDON:jsr LAB21
2175:
2176: LAA9D: jsr zCHRGOT
2177:
2178: bPRINT: beq bCRDO
2179: LAAA2: beq RetAAE7
2180: cmp #TokTab
2181: beq LAAF8
2182: cmp #TokSpc
2183: clc
2184: beq LAAF8
2185: cmp #','
2186: beq bCOMPRT
2187: cmp #';'
2188: beq LAB13
2189: jsr bFRMEVL
2190: bVAROP: bit zVALTYP
2191: bmi bSTRDON
2192: jsr bFOUT
2193: jsr bSTRLIT
2194: jsr LAB21
2195: jsr bOUTSPC
2196: bne LAA9D
2197: bSTREND:lda #0
2198: sta lBUF,x
2199: ldx #<(lBUF - 1)
2200: ldy #>(lBUF - 1)
2201: lda z13
2202: bne RetAAE7
2203:
2204: ; output a CR and possibly a LF
2205: ;
2206: ; Input:
2207: ; none
2208: ;
2209: ; Remark:
2210: ; At first, this function outputs a CR ($0D). If z13 is negative,
2211: ; it outputs a LF afterwards.
2212: ;
2213: bCRDO: lda #ASC_CR ; output the CR
2214: jsr LAB47
2215: bit z13 ; check: Shall we output a LF?
2216: bpl LAAE5
2217: lda #ASC_LF ; yes, output the LF
2218: jsr LAB47
2219: LAAE5: eor #$FF
2220: RetAAE7:
2221: rts
2222:
2223: bCOMPRT:sec
2224: jsr kPLOT
2225: tya
2226: sec
2227: @LAAEE:
2228: sbc #EDITOR_TAB
2229: bcs @LAAEE
2230: eor #$FF
2231: adc #$01
2232: bne LAB0E
2233: LAAF8: php
2234: sec
2235: jsr kPLOT
2236: sty zTRMPOS
2237: jsr bGTBYTC
2238: cmp #')'
2239: bne LAB5F
2240: plp
2241: bcc LAB0F
2242: txa
2243: sbc zTRMPOS
2244: bcc LAB13
2245: LAB0E: tax
2246: LAB0F: inx
2247: LAB10: dex
2248: bne LAB19
2249: LAB13: jsr zCHRGET
2250: jmp LAAA2
2251:
2252: LAB19: jsr bOUTSPC
2253: bne LAB10
2254:
2255: bSTROUT:jsr bSTRLIT
2256:
2257: LAB21: jsr LB6A6
2258: tax
2259: ldy #0
2260: inx
2261: @LAB28:
2262: dex
2263: beq RetAAE7
2264: lda (zINDEX),y
2265: jsr LAB47
2266: iny
2267: cmp #ASC_CR
2268: bne @LAB28
2269: jsr LAAE5
2270: jmp @LAB28
2271:
2272: bOUTSPC:lda z13
2273: beq @LAB42
2274: lda #' '
2275: .byte ASM_BIT3
2276: @LAB42:
2277: lda #ASC_CURSORLEFTRIGHT
2278: .byte ASM_BIT3
2279:
2280:
2281: LAB45: lda #'?'
2282:
2283: LAB47: jsr bCHOUT
2284: and #$FF
2285: rts
2286:
2287: bDOAGIN:lda zSUBFLG
2288: beq LAB62
2289: bmi @LAB57
2290: ldy #$FF
2291: bne @LAB5B
2292: ; ---------------
2293: @LAB57:
2294: lda zDATLIN
2295: ldy zDATLIN + 1
2296: @LAB5B:
2297: sta zCURLIN
2298: sty zCURLIN + 1
2299: LAB5F: jmp bSYNERR
2300: LAB62: lda z13
2301: beq @LAB6B
2302: ldx #ErrFileData
2303: jmp bERROR
2304:
2305: @LAB6B:
2306: lda #<StrRedoFromStart
2307: ldy #>StrRedoFromStart
2308: jsr bSTROUT
2309: lda zOLDTXT
2310: ldy zOLDTXT + 1
2311: sta zTXTPTR
2312: sty zTXTPTR + 1
2313: rts
2314:
2315: bGET: jsr bERRDIR
2316: cmp #'#'
2317: bne @LAB92
2318: jsr zCHRGET
2319: jsr LB79E
2320: lda #','
2321: jsr LAEFF
2322: stx z13
2323: jsr bCKIN
2324: @LAB92:
2325: ldx #<(lBUF + 1)
2326: ldy #>(lBUF + 1)
2327: lda #0
2328: sta lBUF + 1
2329: lda #$40
2330: jsr LAC0F
2331: ldx z13
2332: bne LABB7
2333: rts
2334:
2335: bINPUTN:jsr LB79E
2336: lda #','
2337: jsr LAEFF
2338: stx z13
2339: jsr bCKIN
2340: jsr LABCE
2341: LABB5: lda z13
2342: LABB7: jsr kCLRCHN
2343: ldx #0
2344: stx z13
2345: rts
2346: bINPUT: cmp #'"'
2347: bne LABCE
2348: jsr LAEBD
2349: lda #';'
2350: jsr LAEFF
2351: jsr LAB21
2352: LABCE: jsr bERRDIR
2353: lda #','
2354: sta lBUF - 1
2355: LABD6: jsr bQINLIN
2356: lda z13
2357: beq bBUFFUL
2358: jsr kREADST
2359: and #$02
2360: beq bBUFFUL
2361: jsr LABB5
2362: jmp bDATA
2363:
2364: bBUFFUL:lda lBUF
2365: bne LAC0D
2366: lda z13
2367: bne LABD6
2368: jsr bDATAN
2369: jmp LA8FB
2370:
2371: bQINLIN:lda z13
2372: bne @LAC03
2373: jsr LAB45
2374: jsr bOUTSPC
2375: @LAC03:
2376: jmp bINLIN
2377:
2378: bREAD: ldx zDATPTR
2379: ldy zDATPTR + 1
2380: lda #$98
2381: .byte ASM_BIT3
2382: LAC0D: lda #0
2383: LAC0F: sta zSUBFLG
2384: stx zINPPTR
2385: sty zINPPTR + 1
2386: LAC15: jsr bPTRGET
2387: sta zFORPNT
2388: sty zFORPNT + 1
2389: lda zTXTPTR
2390: ldy zTXTPTR + 1
2391: sta zVARTXT
2392: sty zVARTXT + 1
2393: ldx zINPPTR
2394: ldy zINPPTR + 1
2395: stx zTXTPTR
2396: sty zTXTPTR + 1
2397: jsr zCHRGOT
2398: bne LAC51
2399: bit zSUBFLG
2400: bvc LAC41
2401:
2402: bRGDET: jsr bGETIN
2403: sta lBUF
2404: ldx #<(lBUF - 1)
2405: ldy #>(lBUF - 1)
2406: bne LAC4D
2407: LAC41: bmi LACB8
2408: lda z13
2409: bne @LAC4A
2410: jsr LAB45
2411: @LAC4A:
2412: jsr bQINLIN
2413:
2414: LAC4D: stx zTXTPTR
2415: sty zTXTPTR + 1
2416: LAC51: jsr zCHRGET
2417: bit zVALTYP
2418: bpl @LAC89
2419: bit zSUBFLG
2420: bvc @LAC65
2421: inx
2422: stx zTXTPTR
2423: lda #0
2424: sta zCHARAC
2425: beq @LAC71
2426: @LAC65:
2427: sta zCHARAC
2428: cmp #'"'
2429: beq @LAC72
2430: lda #':'
2431: sta zCHARAC
2432: lda #','
2433: @LAC71:
2434: clc
2435: @LAC72:
2436: sta zENDCHR
2437: lda zTXTPTR
2438: ldy zTXTPTR + 1
2439: adc #0
2440: bcc @LAC7D
2441: iny
2442: @LAC7D:
2443: jsr LB48D
2444: jsr LB7E2
2445: jsr LA9DA
2446: jmp @LAC91
2447: @LAC89:
2448: jsr bFIN
2449: lda zINTFLG
2450: jsr LA9C2
2451: @LAC91:
2452: jsr zCHRGOT
2453: beq @LAC9D
2454: cmp #','
2455: beq @LAC9D
2456: jmp bDOAGIN
2457:
2458: @LAC9D:
2459: lda zTXTPTR
2460: ldy zTXTPTR + 1
2461: sta zINPPTR
2462: sty zINPPTR + 1
2463: lda zVARTXT
2464: ldy zVARTXT + 1
2465: sta zTXTPTR
2466: sty zTXTPTR + 1
2467: jsr zCHRGOT
2468: beq LACDF
2469: jsr bCHKCMA
2470: jmp LAC15
2471: LACB8: jsr bDATAN
2472: iny
2473: tax
2474: bne @LACD1
2475: ldx #$0D
2476: iny
2477: lda (zTXTPTR),y
2478: beq LAD32
2479: iny
2480: lda (zTXTPTR),y
2481: sta zDATLIN
2482: iny
2483: lda (zTXTPTR),y
2484: iny
2485: sta zDATLIN + 1
2486: @LACD1:
2487: jsr LA8FB
2488: jsr zCHRGOT
2489: tax
2490: cpx #$83
2491: bne LACB8
2492: jmp LAC51
2493: LACDF: lda zINPPTR
2494: ldy zINPPTR + 1
2495: ldx zSUBFLG
2496: bpl @LACEA
2497: jmp LA827
2498: @LACEA:
2499: ldy #0
2500: lda (zINPPTR),y
2501: beq @Ret
2502: lda z13
2503: bne @Ret
2504: lda #<bEXINT
2505: ldy #>bEXINT
2506: jmp bSTROUT
2507: @Ret: rts
2508:
2509: bEXINT: .byte "?EXTRA IGNORED",$0D,$00
2510:
2511: StrRedoFromStart:
2512: .byte "?REDO FROM START",$0D,$00
2513:
2514: bNEXT: bne LAD24
2515: ldy #0
2516: beq LAD27
2517: LAD24: jsr bPTRGET
2518: LAD27: sta zFORPNT
2519: sty zFORPNT + 1
2520: jsr bFNDFOR
2521: beq LAD35
2522: ldx #ErrNextWithoutFor
2523: LAD32: jmp bERROR
2524: LAD35: txs
2525: txa
2526: clc
2527: adc #$04
2528: pha
2529: adc #$06
2530: sta zINDEX2
2531: pla
2532: ldy #$01
2533: jsr bMOVFM
2534: tsx
2535: lda lSTACK + 9,x
2536: sta zFACSGN
2537: lda zFORPNT
2538: ldy zFORPNT + 1
2539: jsr bFADD
2540: jsr LBBD0
2541: ldy #$01
2542: jsr LBC5D
2543: tsx
2544: sec
2545: sbc lSTACK + 9,x
2546: beq LAD78
2547: bDONEXT:lda lSTACK + 15,x
2548: sta zCURLIN
2549: lda lSTACK + 16,x
2550: sta zCURLIN + 1
2551: lda lSTACK + 18,x
2552: sta zTXTPTR
2553: lda lSTACK + 17,x
2554: sta zTXTPTR + 1
2555: LAD75: jmp bNEWSTT
2556: LAD78: txa
2557: adc #17
2558: tax
2559: txs
2560: jsr zCHRGOT
2561: cmp #','
2562: bne LAD75
2563: jsr zCHRGET
2564: jsr LAD24
2565: bFRMNUM:jsr bFRMEVL
2566: LAD8D: clc
2567: .byte ASM_BIT2
2568: LAD8F: sec
2569: LAD90: bit zVALTYP
2570: bmi LAD97
2571: bcs LAD99
2572: LAD96: rts
2573: LAD97: bcs LAD96
2574: LAD99: ldx #ErrTypeMismatch
2575: jmp bERROR
2576: bFRMEVL:ldx zTXTPTR
2577: bne LADA4
2578: dec zTXTPTR + 1
2579: LADA4: dec zTXTPTR
2580: ldx #0
2581: .byte ASM_BIT2
2582: LADA9: pha
2583: txa
2584: pha
2585: lda #1
2586: jsr bGETSTK
2587: jsr bEVAL
2588: lda #$00
2589: sta zOPMASK
2590: LADB8: jsr zCHRGOT
2591: LADBB: sec
2592: sbc #TokGreater
2593: bcc LADD7
2594: cmp #TokSgn - TokGreater
2595: bcs LADD7
2596: cmp #TokEqual - TokGreater
2597: rol a
2598: eor #$01
2599: eor zOPMASK
2600: cmp zOPMASK
2601: bcc LAE30
2602: sta zOPMASK
2603: jsr zCHRGET
2604: jmp LADBB
2605: LADD7: ldx zOPMASK
2606: bne LAE07
2607: bcs LAE58
2608: adc #$07
2609: bcc LAE58
2610: adc zVALTYP
2611: bne LADE8
2612: jmp bCAT
2613: LADE8: adc #-1
2614: sta zINDEX
2615: asl a
2616: adc zINDEX
2617: tay
2618: LADF0: pla
2619: cmp bOPTAB,y
2620: bcs LAE5D
2621: jsr LAD8D
2622: LADF9: pha
2623: LADFA: jsr LAE20
2624: pla
2625: ldy zVARTXT
2626: bpl LAE19
2627: tax
2628: beq LAE5B
2629: bne LAE66
2630: LAE07: lsr zVALTYP
2631: txa
2632: rol a
2633: ldx zTXTPTR
2634: bne LAE11
2635: dec zTXTPTR + 1
2636: LAE11: dec zTXTPTR
2637: ldy #$1B
2638: sta zOPMASK
2639: bne LADF0
2640: LAE19: cmp bOPTAB,y
2641: bcs LAE66
2642: bcc LADF9
2643: LAE20: lda bOPTAB + 2,y
2644: pha
2645: lda bOPTAB + 1,y
2646: pha
2647: jsr LAE33
2648: lda zOPMASK
2649: jmp LADA9
2650: LAE30: jmp bSYNERR
2651: LAE33: lda zFACSGN
2652: ldx bOPTAB,y
2653: LAE38: tay
2654: pla
2655: sta zINDEX
2656: inc zINDEX
2657: pla
2658: sta zINDEX + 1
2659: tya
2660: pha
2661: LAE43: jsr bROUND
2662: lda zFACHO + 3
2663: pha
2664: lda zFACHO + 2
2665: pha
2666: lda zFACHO + 1
2667: pha
2668: lda zFACHO
2669: pha
2670: lda zFACEXP
2671: pha
2672: jmp (zINDEX)
2673: LAE58: ldy #$FF
2674: pla
2675: LAE5B: beq LAE80
2676: LAE5D: cmp #$64
2677: beq LAE64
2678: jsr LAD8D
2679: LAE64: sty zVARTXT
2680: LAE66: pla
2681: lsr a
2682: sta zTANSGN
2683: pla
2684: sta zARGEXP
2685: pla
2686: sta zARGHO
2687: pla
2688: sta zARGHO + 1
2689: pla
2690: sta zARGHO + 2
2691: pla
2692: sta zARGHO + 3
2693: pla
2694: sta zARGSGN
2695: eor zFACSGN
2696: sta zARISGN
2697: LAE80: lda zFACEXP
2698: rts
2699: bEVAL: jmp (lIEVAL)
2700: LAE86: lda #$00
2701: sta zVALTYP
2702: LAE8A: jsr zCHRGET
2703: bcs LAE92
2704: LAE8F: jmp bFIN
2705: LAE92: jsr bISLETC
2706: bcc LAE9A
2707: jmp bISVAR
2708: LAE9A: cmp #$FF
2709: bne bQDOT
2710: lda #<bPIVAL
2711: ldy #>bPIVAL
2712: jsr bMOVFM
2713: jmp zCHRGET
2714:
2715: bPIVAL: .byte $82,$49,$0F,$DA,$A1
2716:
2717: bQDOT: cmp #'.'
2718: beq LAE8F
2719: cmp #TokMinus
2720: beq bDOMIN
2721: cmp #TokPlus
2722: beq LAE8A
2723: cmp #'"'
2724: bne LAECC
2725: LAEBD: lda zTXTPTR
2726: ldy zTXTPTR + 1
2727: adc #0
2728: bcc LAEC6
2729: iny
2730: LAEC6: jsr bSTRLIT
2731: jmp LB7E2
2732: LAECC: cmp #TokNot
2733: bne LAEE3
2734: ldy #$18
2735: bne LAF0F
2736: bEQUOP: jsr bAYINT
2737: lda zFACHO + 3
2738: eor #$FF
2739: tay
2740: lda zFACHO + 2
2741: eor #$FF
2742: jmp bGIVAYF
2743: LAEE3: cmp #TokFn
2744: bne LAEEA
2745: jmp bFNDOER
2746: LAEEA: cmp #TokSgn
2747: bcc bOARCHK
2748: jmp bISFUN
2749: bOARCHK:jsr bCHKopen
2750: jsr bFRMEVL
2751: bCHKclose:
2752: lda #')'
2753: .byte ASM_BIT3
2754: bCHKopen:
2755: lda #'('
2756: .byte ASM_BIT3
2757: bCHKCMA:lda #','
2758: LAEFF: ldy #0
2759: cmp (zTXTPTR),y
2760: bne bSYNERR
2761: jmp zCHRGET
2762: bSYNERR:ldx #ErrSyntax
2763: jmp bERROR
2764: bDOMIN: ldy #$15
2765: LAF0F: pla
2766: pla
2767: jmp LADFA
2768: bRSVVAR:sec
2769: lda zFACHO + 2
2770: sbc #<BASIC_START
2771: lda zFACHO + 3
2772: sbc #>BASIC_START
2773: bcc LAF27
2774: lda #<BASIC_END
2775: sbc zFACHO + 2
2776: lda #>BASIC_END
2777: sbc zFACHO + 3
2778: LAF27: rts
2779: bISVAR: jsr bPTRGET
2780: sta zFACHO + 2
2781: sty zFACHO + 3
2782: ldx zVARNAM
2783: ldy zVARNAM + 1
2784: lda zVALTYP
2785: beq LAF5D
2786: lda #0
2787: sta zFACOV
2788: jsr bRSVVAR
2789: bcc LAF5C
2790: cpx #'T' ; "T"
2791: bne LAF5C
2792: cpy #'I' + $80 ; "I$"
2793: bne LAF5C
2794: bTISASC:jsr LAF84
2795: sty zTEMP_5E
2796: dey
2797: sty zFBUFPT
2798: ldy #6
2799: sty zTEMP_5D
2800: ldy #$24
2801: jsr bFOUTIM
2802: jmp LB46F
2803: LAF5C: rts
2804: LAF5D: bit zINTFLG
2805: bpl LAF6E
2806: ldy #0
2807: lda (zFACHO + 2),y
2808: tax
2809: iny
2810: lda (zFACHO + 2),y
2811: tay
2812: txa
2813: jmp bGIVAYF
2814: LAF6E: jsr bRSVVAR
2815: bcc LAFA0
2816: cpx #'T'
2817: bne LAF92
2818: cpy #'I'
2819: bne LAFA0
2820: jsr LAF84
2821: tya
2822: ldx #$A0
2823: jmp LBC4F
2824: LAF84: jsr kRDTIM
2825: stx zFACHO + 2
2826: sty zFACHO + 1
2827: sta zFACHO + 3
2828: ldy #0
2829: sty zFACHO
2830: rts
2831: LAF92: cpx #'S'
2832: bne LAFA0
2833: cpy #'T'
2834: bne LAFA0
2835: jsr kREADST
2836: jmp LBC3C
2837: LAFA0: lda zFACHO + 2
2838: ldy zFACHO + 3
2839: jmp bMOVFM
2840: bISFUN: asl a
2841: pha
2842: tax
2843: jsr zCHRGET
2844: cpx #TokRem
2845: bcc bNUMFUN
2846: bSTRFUN:jsr bCHKopen
2847: jsr bFRMEVL
2848: jsr bCHKCMA
2849: jsr LAD8F
2850: pla
2851: tax
2852: lda zFACHO + 3
2853: pha
2854: lda zFACHO + 2
2855: pha
2856: txa
2857: pha
2858: jsr LB79E
2859: pla
2860: tay
2861: txa
2862: pha
2863: jmp LAFD6
2864: bNUMFUN:jsr bOARCHK
2865: pla
2866: tay
2867: LAFD6: lda bFUNDSP - 2*(TokSgn - $80),y
2868: sta zJMPER + 1
2869: lda bFUNDSP - 2*(TokSgn - $80) + 1,y
2870: sta zJMPER + 2
2871: jsr zJMPER
2872: jmp LAD8D
2873: bOROP: ldy #$FF
2874: .byte ASM_BIT3
2875: TAND: ldy #0
2876: sty zCOUNT
2877: jsr bAYINT
2878: lda zFACHO + 2
2879: eor zCOUNT
2880: sta zCHARAC
2881: lda zFACHO + 3
2882: eor zCOUNT
2883: sta zENDCHR
2884: jsr bMOVFA
2885: jsr bAYINT
2886: lda zFACHO + 3
2887: eor zCOUNT
2888: and zENDCHR
2889: eor zCOUNT
2890: tay
2891: lda zFACHO + 2
2892: eor zCOUNT
2893: and zCHARAC
2894: eor zCOUNT
2895: jmp bGIVAYF
2896: bDOREL: jsr LAD90
2897: bcs bSTRREL
2898: bNUMREL:lda zARGSGN
2899: ora #$7F
2900: and zARGHO
2901: sta zARGHO
2902: lda #<zARG
2903: ldy #>zARG
2904: jsr bFCOMP
2905: tax
2906: jmp LB061
2907: bSTRREL:lda #0
2908: sta zVALTYP
2909: dec zOPMASK
2910: jsr LB6A6
2911: sta zFACEXP
2912: stx zFACHO
2913: sty zFACHO + 1
2914: lda zARGHO + 2
2915: ldy zARGHO + 3
2916: jsr LB6AA
2917: stx zARGHO + 2
2918: sty zARGHO + 3
2919: tax
2920: sec
2921: sbc zFACEXP
2922: beq LB056
2923: lda #1
2924: bcc LB056
2925: ldx zFACEXP
2926: lda #$FF
2927: LB056: sta zFACSGN
2928: ldy #$FF
2929: inx
2930: LB05B: iny
2931: dex
2932: bne LB066
2933: ldx zFACSGN
2934: LB061: bmi LB072
2935: clc
2936: bcc LB072
2937: LB066: lda (zARGHO + 2),y
2938: cmp (zFACHO),y
2939: beq LB05B
2940: ldx #$FF
2941: bcs LB072
2942: ldx #$01
2943: LB072: inx
2944: txa
2945: rol a
2946: and zTANSGN
2947: beq LB07B
2948: lda #$FF
2949: LB07B: jmp LBC3C
2950: bDIM: jsr bCHKCMA
2951: bDIM2: tax
2952: jsr LB090
2953: jsr zCHRGOT
2954: bne bDIM
2955: rts
2956: bPTRGET:ldx #$00
2957: jsr zCHRGOT
2958: LB090: stx zDIMFLG
2959: LB092: sta zVARNAM
2960: jsr zCHRGOT
2961: jsr bISLETC
2962: bcs LB09F
2963: LB09C: jmp bSYNERR
2964: LB09F: ldx #$00
2965: stx zVALTYP
2966: stx zINTFLG
2967: jsr zCHRGET
2968: bcc LB0AF
2969: jsr bISLETC
2970: bcc LB0BA
2971: LB0AF: tax
2972: LB0B0: jsr zCHRGET
2973: bcc LB0B0
2974: jsr bISLETC
2975: bcs LB0B0
2976: LB0BA: cmp #'$'
2977: bne LB0C4
2978: lda #$FF
2979: sta zVALTYP
2980: bne LB0D4
2981: LB0C4: cmp #'%'
2982: bne LB0DB
2983: lda zINTALLOWED
2984: bne LB09C
2985: lda #$80
2986: sta zINTFLG
2987: ora zVARNAM
2988: sta zVARNAM
2989: LB0D4: txa
2990: ora #$80
2991: tax
2992: jsr zCHRGET
2993: LB0DB: stx zVARNAM + 1
2994: sec
2995: ora zINTALLOWED
2996: sbc #'('
2997: bne bORDVAR
2998: jmp bISARY
2999: bORDVAR:ldy #$00
3000: sty zINTALLOWED
3001: lda zVARTAB
3002: ldx zVARTAB + 1
3003: LB0EF: stx zTEMP_5F + 1
3004: LB0F1: sta zTEMP_5F
3005: cpx zARYTAB + 1
3006: bne LB0FB
3007: cmp zARYTAB
3008: beq bNOTFNS
3009: LB0FB: lda zVARNAM
3010: cmp (zTEMP_5F),y
3011: bne LB109
3012: lda zVARNAM + 1
3013: iny
3014: cmp (zTEMP_5F),y
3015: beq LB185
3016: dey
3017: LB109: clc
3018: lda zTEMP_5F
3019: adc #7
3020: bcc LB0F1
3021: inx
3022: bne LB0EF
3023: bISLETC:cmp #'A'
3024: bcc LB11C
3025: sbc #'Z' + 1
3026: sec
3027: sbc #-('Z' + 1)
3028: LB11C: rts
3029: bNOTFNS:pla
3030: pha
3031: cmp #$2A ; ?
3032: bne bNOTEVL
3033: LB123: lda #<bTI ; for TI$, store the special pointer
3034: ldy #>bTI ; so it can be recognized
3035: rts
3036: bNOTEVL:lda zVARNAM
3037: ldy zVARNAM + 1
3038: cmp #'T' ; "T"
3039: bne LB13B
3040: cpy #'I' + $80 ; "I$"
3041: beq LB123
3042: cpy #'I'
3043: bne LB13B
3044: LB138: jmp bSYNERR
3045: LB13B: cmp #'S'
3046: bne LB143
3047: cpy #'T'
3048: beq LB138
3049: LB143: lda zARYTAB
3050: ldy zARYTAB + 1
3051: sta zTEMP_5F
3052: sty zTEMP_5F + 1
3053: lda zSTREND
3054: ldy zSTREND + 1
3055: sta zTEMP_5A
3056: sty zTEMP_5A + 1
3057: clc
3058: adc #7
3059: bcc LB159
3060: iny
3061: LB159: sta zTEMP_58
3062: sty zTEMP_58 + 1
3063: jsr bBLTU
3064: lda zTEMP_58
3065: ldy zTEMP_58 + 1
3066: iny
3067: sta zARYTAB
3068: sty zARYTAB + 1
3069: ldy #0
3070: lda zVARNAM
3071: sta (zTEMP_5F),y
3072: iny
3073: lda zVARNAM + 1
3074: sta (zTEMP_5F),y
3075: lda #0
3076: iny
3077: sta (zTEMP_5F),y
3078: iny
3079: sta (zTEMP_5F),y
3080: iny
3081: sta (zTEMP_5F),y
3082: iny
3083: sta (zTEMP_5F),y
3084: iny
3085: sta (zTEMP_5F),y
3086: LB185: lda zTEMP_5F
3087: clc
3088: adc #2
3089: ldy zTEMP_5F + 1
3090: bcc LB18F
3091: iny
3092: LB18F: sta zVARPNT
3093: sty zVARPNT + 1
3094: rts
3095: bARYGET:lda zCOUNT
3096: asl a
3097: adc #5
3098: adc zTEMP_5F
3099: ldy zTEMP_5F + 1
3100: bcc LB1A0
3101: iny
3102: LB1A0: sta zTEMP_58
3103: sty zTEMP_58 + 1
3104: rts
3105:
3106: bN32768:.byte $90,$80,$00,$00,$00
3107:
3108: bFACINX:jsr bAYINT
3109: lda zFACHO + 2
3110: ldy zFACHO + 3
3111: rts
3112: bINTIDX:jsr zCHRGET
3113: jsr bFRMEVL
3114: LB1B8: jsr LAD8D
3115: lda zFACSGN
3116: bmi LB1CC
3117: bAYINT: lda zFACEXP
3118: cmp #$90
3119: bcc LB1CE
3120: lda #<bN32768
3121: ldy #>bN32768
3122: jsr bFCOMP
3123: LB1CC: bne bIQERR
3124: LB1CE: jmp bQINT
3125: bISARY: lda zDIMFLG
3126: ora zINTFLG
3127: pha
3128: lda zVALTYP
3129: pha
3130: ldy #0
3131: LB1DB: tya
3132: pha
3133: lda zVARNAM + 1
3134: pha
3135: lda zVARNAM
3136: pha
3137: jsr bINTIDX
3138: pla
3139: sta zVARNAM
3140: pla
3141: sta zVARNAM + 1
3142: pla
3143: tay
3144: tsx
3145: lda lSTACK + 2,x
3146: pha
3147: lda lSTACK + 1,x
3148: pha
3149: lda zFACHO + 2
3150: sta lSTACK + 2,x
3151: lda zFACHO + 3
3152: sta lSTACK + 1,x
3153: iny
3154: jsr zCHRGOT
3155: cmp #','
3156: beq LB1DB
3157: sty zCOUNT
3158: jsr bCHKclose
3159: pla
3160: sta zVALTYP
3161: pla
3162: sta zINTFLG
3163: and #$7F
3164: sta zDIMFLG
3165: bFNDARY:ldx zARYTAB
3166: lda zARYTAB + 1
3167: LB21C: stx zTEMP_5F
3168: sta zTEMP_5F + 1
3169: cmp zSTREND + 1
3170: bne LB228
3171: cpx zSTREND
3172: beq bNOTFDD
3173: LB228: ldy #0
3174: lda (zTEMP_5F),y
3175: iny
3176: cmp zVARNAM
3177: bne LB237
3178: lda zVARNAM + 1
3179: cmp (zTEMP_5F),y
3180: beq bRAERR
3181: LB237: iny
3182: lda (zTEMP_5F),y
3183: clc
3184: adc zTEMP_5F
3185: tax
3186: iny
3187: lda (zTEMP_5F),y
3188: adc zTEMP_5F + 1
3189: bcc LB21C
3190: bBSERR: ldx #ErrBadSubscript
3191: .byte ASM_BIT3
3192: bIQERR: ldx #ErrIllegalQuantity
3193: LB24A: jmp bERROR
3194: bRAERR: ldx #ErrRedimdArray
3195: lda zDIMFLG
3196: bne LB24A
3197: jsr bARYGET
3198: lda zCOUNT
3199: ldy #4
3200: cmp (zTEMP_5F),y
3201: bne bBSERR
3202: jmp LB2EA
3203: bNOTFDD:jsr bARYGET
3204: jsr bREASON
3205: ldy #0
3206: sty zFBUFPT + 1
3207: ldx #5
3208: lda zVARNAM
3209: sta (zTEMP_5F),y
3210: bpl LB274
3211: dex
3212: LB274: iny
3213: lda zVARNAM + 1
3214: sta (zTEMP_5F),y
3215: bpl LB27D
3216: dex
3217: dex
3218: LB27D: stx zFBUFPT
3219: lda zCOUNT
3220: iny
3221: iny
3222: iny
3223: sta (zTEMP_5F),y
3224: LB286: ldx #11
3225: lda #0
3226: bit zDIMFLG
3227: bvc LB296
3228: pla
3229: clc
3230: adc #1
3231: tax
3232: pla
3233: adc #0
3234: LB296: iny
3235: sta (zTEMP_5F),y
3236: iny
3237: txa
3238: sta (zTEMP_5F),y
3239: jsr bUMULT
3240: stx zFBUFPT
3241: sta zFBUFPT + 1
3242: ldy zINDEX
3243: dec zCOUNT
3244: bne LB286
3245: adc zTEMP_58 + 1
3246: bcs LB30B
3247: sta zTEMP_58 + 1
3248: tay
3249: txa
3250: adc zTEMP_58
3251: bcc LB2B9
3252: iny
3253: beq LB30B
3254: LB2B9: jsr bREASON
3255: sta zSTREND
3256: sty zSTREND + 1
3257: lda #0
3258: inc zFBUFPT + 1
3259: ldy zFBUFPT
3260: beq LB2CD
3261: LB2C8: dey
3262: sta (zTEMP_58),y
3263: bne LB2C8
3264: LB2CD: dec zTEMP_58 + 1
3265: dec zFBUFPT + 1
3266: bne LB2C8
3267: inc zTEMP_58 + 1
3268: sec
3269: lda zSTREND
3270: sbc zTEMP_5F
3271: ldy #2
3272: sta (zTEMP_5F),y
3273: lda zSTREND + 1
3274: iny
3275: sbc zTEMP_5F + 1
3276: sta (zTEMP_5F),y
3277: lda zDIMFLG
3278: bne LB34B
3279: iny
3280: LB2EA: lda (zTEMP_5F),y
3281: sta zCOUNT
3282: lda #0
3283: sta zFBUFPT
3284: LB2F2: sta zFBUFPT + 1
3285: iny
3286: pla
3287: tax
3288: sta zFACHO + 2
3289: pla
3290: sta zFACHO + 3
3291: cmp (zTEMP_5F),y
3292: bcc bINLPN2
3293: bne LB308
3294: iny
3295: txa
3296: cmp (zTEMP_5F),y
3297: bcc LB30F
3298: LB308: jmp bBSERR
3299: LB30B: jmp bOMERR
3300:
3301: bINLPN2:iny
3302: LB30F: lda zFBUFPT + 1
3303: ora zFBUFPT
3304: clc
3305: beq LB320
3306: jsr bUMULT
3307: txa
3308: adc zFACHO + 2
3309: tax
3310: tya
3311: ldy zINDEX
3312: LB320: adc zFACHO + 3
3313: stx zFBUFPT
3314: dec zCOUNT
3315: bne LB2F2
3316: sta zFBUFPT + 1
3317: ldx #5
3318: lda zVARNAM
3319: bpl LB331
3320: dex
3321: LB331: lda zVARNAM + 1
3322: bpl LB337
3323: dex
3324: dex
3325: LB337: stx zTEMP_28
3326: lda #0
3327: jsr LB355
3328: txa
3329: adc zTEMP_58
3330: sta zVARPNT
3331: tya
3332: adc zTEMP_58 + 1
3333: sta zVARPNT + 1
3334: tay
3335: lda zVARPNT
3336: LB34B: rts
3337: bUMULT: sty zINDEX
3338: lda (zTEMP_5F),y
3339: sta zTEMP_28
3340: dey
3341: lda (zTEMP_5F),y
3342: LB355: sta zTEMP_28 + 1
3343: lda #$10
3344: sta zTEMP_5D
3345: ldx #0
3346: ldy #0
3347: LB35F: txa
3348: asl a
3349: tax
3350: tya
3351: rol a
3352: tay
3353: bcs LB30B
3354: asl zFBUFPT
3355: rol zFBUFPT + 1
3356: bcc LB378
3357: clc
3358: txa
3359: adc zTEMP_28
3360: tax
3361: tya
3362: adc zTEMP_28 + 1
3363: tay
3364: bcs LB30B
3365: LB378: dec zTEMP_5D
3366: bne LB35F
3367: rts
3368: bFRE: lda zVALTYP
3369: beq LB384
3370: jsr LB6A6
3371: LB384: jsr bGARBAG
3372: sec
3373: lda zFRETOP
3374: sbc zSTREND
3375: tay
3376: lda zFRETOP + 1
3377: sbc zSTREND + 1
3378: bGIVAYF:ldx #0
3379: stx zVALTYP
3380: sta zFACHO
3381: sty zFACHO + 1
3382: ldx #$90
3383: jmp LBC44
3384: bPOS: sec
3385: jsr kPLOT
3386: LB3A2: lda #0
3387: beq bGIVAYF
3388: bERRDIR:ldx zCURLIN + 1
3389: inx
3390: bne LB34B
3391: ldx #ErrIllegalDirect
3392: .byte ASM_BIT3
3393: bUFERR: ldx #ErrUndefdFunction
3394: jmp bERROR
3395:
3396: bDEF: jsr bGETFNM
3397: jsr bERRDIR
3398: jsr bCHKopen
3399: lda #$80
3400: sta zINTALLOWED
3401: jsr bPTRGET
3402: jsr LAD8D
3403: jsr bCHKclose
3404: lda #TokEqual
3405: jsr LAEFF
3406: pha
3407: lda zVARPNT + 1
3408: pha
3409: lda zVARPNT
3410: pha
3411: lda zTXTPTR + 1
3412: pha
3413: lda zTXTPTR
3414: pha
3415: jsr bDATA
3416: jmp LB44F
3417: bGETFNM:lda #TokFn
3418: jsr LAEFF
3419: ora #$80
3420: sta zINTALLOWED
3421: jsr LB092
3422: sta zTEMPF3
3423: sty zTEMPF3 + 1
3424: jmp LAD8D
3425: bFNDOER:jsr bGETFNM
3426: lda zTEMPF3 + 1
3427: pha
3428: lda zTEMPF3
3429: pha
3430: jsr bOARCHK
3431: jsr LAD8D
3432: pla
3433: sta zTEMPF3
3434: pla
3435: sta zTEMPF3 + 1
3436: ldy #2
3437: lda (zTEMPF3),y
3438: sta zVARPNT
3439: tax
3440: iny
3441: lda (zTEMPF3),y
3442: beq bUFERR
3443: sta zVARPNT + 1
3444: iny
3445: LB418: lda (zVARPNT),y
3446: pha
3447: dey
3448: bpl LB418
3449: ldy zVARPNT + 1
3450: jsr LBBD4
3451: lda zTXTPTR + 1
3452: pha
3453: lda zTXTPTR
3454: pha
3455: lda (zTEMPF3),y
3456: sta zTXTPTR
3457: iny
3458: lda (zTEMPF3),y
3459: sta zTXTPTR + 1
3460: lda zVARPNT + 1
3461: pha
3462: lda zVARPNT
3463: pha
3464: jsr bFRMNUM
3465: pla
3466: sta zTEMPF3
3467: pla
3468: sta zTEMPF3 + 1
3469: jsr zCHRGOT
3470: beq LB449
3471: jmp bSYNERR
3472: LB449: pla
3473: sta zTXTPTR
3474: pla
3475: sta zTXTPTR + 1
3476: LB44F: ldy #0
3477: pla
3478: sta (zTEMPF3),y
3479: pla
3480: iny
3481: sta (zTEMPF3),y
3482: pla
3483: iny
3484: sta (zTEMPF3),y
3485: pla
3486: iny
3487: sta (zTEMPF3),y
3488: pla
3489: iny
3490: sta (zTEMPF3),y
3491: rts
3492: bSTRD: jsr LAD8D
3493: ldy #0
3494: jsr LBDDF
3495: pla
3496: pla
3497: LB46F: lda #<(zASCWRK)
3498: ldy #>(zASCWRK)
3499: beq bSTRLIT
3500: ; -------------
3501:
3502: LB475: ldx zFACHO + 2
3503: ldy zFACHO + 3
3504: stx zTEMP_50
3505: sty zTEMP_50 + 1
3506: LB47D: jsr bGETSPA
3507: stx zFACHO
3508: sty zFACHO + 1
3509: sta zFACEXP
3510: rts
3511: bSTRLIT:ldx #'"'
3512: stx zCHARAC
3513: stx zENDCHR
3514: LB48D: sta zARISGN
3515: sty zFACOV
3516: sta zFACHO
3517: sty zFACHO + 1
3518: ldy #-1
3519: LB497: iny
3520: lda (zARISGN),y
3521: beq LB4A8
3522: cmp zCHARAC
3523: beq LB4A4
3524: cmp zENDCHR
3525: bne LB497
3526: LB4A4: cmp #'"'
3527: beq LB4A9
3528: LB4A8: clc
3529: LB4A9: sty zFACEXP
3530: tya
3531: adc zARISGN
3532: sta zFBUFPT
3533: ldx zFACOV
3534: bcc LB4B5
3535: inx
3536: LB4B5: stx zFBUFPT + 1
3537: lda zFACOV
3538: beq LB4BF
3539: cmp #2
3540: bne LB4CA
3541: LB4BF: tya
3542: jsr LB475
3543: ldx zARISGN
3544: ldy zFACOV
3545: JDLB4C7:
3546: jsr LB688
3547: LB4CA: ldx zTEMPPT
3548: cpx #zTEMPST + 9
3549: bne bPUTNW1
3550: ldx #ErrFormulaTooComplex
3551: LB4D2: jmp bERROR
3552: bPUTNW1:lda zFACEXP
3553: sta 0,x
3554: lda zFACHO
3555: sta 1,x
3556: lda zFACHO + 1
3557: sta 2,x
3558: ldy #>zTEMPST
3559: stx zFACHO + 2
3560: sty zFACHO + 3
3561: sty zFACOV
3562: dey
3563: sty zVALTYP
3564: stx zLASTPT
3565: inx
3566: inx
3567: inx
3568: stx zTEMPPT
3569: rts
3570: bGETSPA:lsr zGARBFL
3571: LB4F6: pha
3572: eor #$FF
3573: sec
3574: adc zFRETOP
3575: ldy zFRETOP + 1
3576: bcs LB501
3577: dey
3578: LB501: cpy zSTREND + 1
3579: bcc LB516
3580: bne LB50B
3581: cmp zSTREND
3582: bcc LB516
3583: LB50B: sta zFRETOP
3584: sty zFRETOP + 1
3585: sta zFRESPC
3586: sty zFRESPC + 1
3587: tax
3588: pla
3589: rts
3590: LB516: ldx #$10
3591: lda zGARBFL
3592: bmi LB4D2
3593: jsr bGARBAG
3594: lda #$80
3595: sta zGARBFL
3596: pla
3597: bne LB4F6
3598: bGARBAG:ldx zMEMSIZ
3599: lda zMEMSIZ + 1
3600: LB52A: stx zFRETOP
3601: sta zFRETOP + 1
3602: ldy #0
3603: sty zTEMPF3 + 1
3604: sty zTEMPF3
3605: lda zSTREND
3606: ldx zSTREND + 1
3607: sta zTEMP_5F
3608: stx zTEMP_5F + 1
3609: lda #<zTEMPST
3610: ldx #>zTEMPST
3611: sta zINDEX
3612: stx zINDEX + 1
3613: LB544: cmp zTEMPPT
3614: beq LB54D
3615: jsr LB5C7
3616: beq LB544
3617: LB54D: lda #$07
3618: sta zFOUR6
3619: lda zVARTAB
3620: ldx zVARTAB + 1
3621: sta zINDEX
3622: stx zINDEX + 1
3623: LB559: cpx zARYTAB + 1
3624: bne LB561
3625: cmp zARYTAB
3626: beq LB566
3627: LB561: jsr bDVARS
3628: beq LB559
3629: LB566: sta zTEMP_58
3630: stx zTEMP_58 + 1
3631: lda #3
3632: sta zFOUR6
3633: LB56E: lda zTEMP_58
3634: ldx zTEMP_58 + 1
3635: LB572: cpx zSTREND + 1
3636: bne LB57D
3637: cmp zSTREND
3638: bne LB57D
3639: jmp bGRBPAS
3640: LB57D: sta zINDEX
3641: stx zINDEX + 1
3642: ldy #0
3643: lda (zINDEX),y
3644: tax
3645: iny
3646: lda (zINDEX),y
3647: php
3648: iny
3649: lda (zINDEX),y
3650: adc zTEMP_58
3651: sta zTEMP_58
3652: iny
3653: lda (zINDEX),y
3654: adc zTEMP_58 + 1
3655: sta zTEMP_58 + 1
3656: plp
3657: bpl LB56E
3658: txa
3659: bmi LB56E
3660: iny
3661: lda (zINDEX),y
3662: ldy #0
3663: asl a
3664: adc #5
3665: adc zINDEX
3666: sta zINDEX
3667: bcc LB5AE
3668: inc zINDEX + 1
3669: LB5AE: ldx zINDEX + 1
3670: LB5B0: cpx zTEMP_58 + 1
3671: bne LB5B8
3672: cmp zTEMP_58
3673: beq LB572
3674: LB5B8: jsr LB5C7
3675: beq LB5B0
3676: bDVARS: lda (zINDEX),y
3677: bmi LB5F6
3678: iny
3679: lda (zINDEX),y
3680: bpl LB5F6
3681: iny
3682: LB5C7: lda (zINDEX),y
3683: beq LB5F6
3684: iny
3685: lda (zINDEX),y
3686: tax
3687: iny
3688: lda (zINDEX),y
3689: cmp zFRETOP + 1
3690: bcc LB5DC
3691: bne LB5F6
3692: cpx zFRETOP
3693: bcs LB5F6
3694: LB5DC: cmp zTEMP_5F + 1
3695: bcc LB5F6
3696: bne LB5E6
3697: cpx zTEMP_5F
3698: bcc LB5F6
3699: LB5E6: stx zTEMP_5F
3700: sta zTEMP_5F + 1
3701: lda zINDEX
3702: ldx zINDEX + 1
3703: sta zTEMPF3
3704: stx zTEMPF3 + 1
3705: lda zFOUR6
3706: sta zJMPER + 1
3707: LB5F6: lda zFOUR6
3708: clc
3709: adc zINDEX
3710: sta zINDEX
3711: bcc LB601
3712: inc zINDEX + 1
3713: LB601: ldx zINDEX + 1
3714: ldy #0
3715: rts
3716: bGRBPAS:lda zTEMPF3 + 1
3717: ora zTEMPF3
3718: beq LB601
3719: lda zJMPER + 1
3720: and #$04
3721: lsr a
3722: tay
3723: sta zJMPER + 1
3724: lda (zTEMPF3),y
3725: adc zTEMP_5F
3726: sta zTEMP_5A
3727: lda zTEMP_5F + 1
3728: adc #0
3729: sta zTEMP_5A + 1
3730: lda zFRETOP
3731: ldx zFRETOP + 1
3732: sta zTEMP_58
3733: stx zTEMP_58 + 1
3734: jsr MoveMem
3735: ldy zJMPER + 1
3736: iny
3737: lda zTEMP_58
3738: sta (zTEMPF3),y
3739: tax
3740: inc zTEMP_58 + 1
3741: lda zTEMP_58 + 1
3742: iny
3743: sta (zTEMPF3),y
3744: jmp LB52A
3745: bCAT: lda zFACHO + 3
3746: pha
3747: lda zFACHO + 2
3748: pha
3749: jsr bEVAL
3750: jsr LAD8F
3751: pla
3752: sta zARISGN
3753: pla
3754: sta zFACOV
3755: ldy #0
3756: lda (zARISGN),y
3757: clc
3758: adc (zFACHO + 2),y
3759: bcc LB65D
3760: ldx #ErrStringTooLong
3761: jmp bERROR
3762: LB65D: jsr LB475
3763: jsr bMOVINS
3764: lda zTEMP_50
3765: ldy zTEMP_50 + 1
3766: jsr LB6AA
3767: jsr LB68C
3768: lda zARISGN
3769: ldy zFACOV
3770: jsr LB6AA
3771: jsr LB4CA
3772: jmp LADB8
3773: bMOVINS:ldy #0
3774: lda (zARISGN),y
3775: pha
3776: iny
3777: lda (zARISGN),y
3778: tax
3779: iny
3780: lda (zARISGN),y
3781: tay
3782: pla
3783: LB688: stx zINDEX
3784: sty zINDEX + 1
3785: LB68C: tay
3786: beq LB699
3787: pha
3788: LB690: dey
3789: lda (zINDEX),y
3790: sta (zFRESPC),y
3791: tya
3792: bne LB690
3793: pla
3794: LB699: clc
3795: adc zFRESPC
3796: sta zFRESPC
3797: bcc LB6A2
3798: inc zFRESPC + 1
3799: LB6A2: rts
3800: bFRESTR:jsr LAD8F
3801: LB6A6: lda zFACHO + 2
3802: ldy zFACHO + 3
3803: LB6AA: sta zINDEX
3804: sty zINDEX + 1
3805: jsr bFREFAC
3806: php
3807: ldy #0
3808: lda (zINDEX),y
3809: pha
3810: iny
3811: lda (zINDEX),y
3812: tax
3813: iny
3814: lda (zINDEX),y
3815: tay
3816: pla
3817: plp
3818: bne LB6D6
3819: cpy zFRETOP + 1
3820: bne LB6D6
3821: cpx zFRETOP
3822: bne LB6D6
3823: pha
3824: clc
3825: adc zFRETOP
3826: sta zFRETOP
3827: bcc LB6D5
3828: inc zFRETOP + 1
3829: LB6D5: pla
3830: LB6D6: stx zINDEX
3831: sty zINDEX + 1
3832: rts
3833: bFREFAC:cpy zLASTPT + 1
3834: bne LB6EB
3835: cmp zLASTPT
3836: bne LB6EB
3837: sta zTEMPPT
3838: sbc #3
3839: sta zLASTPT
3840: ldy #0
3841: LB6EB: rts
3842: bCHRD: jsr LB7A1
3843: txa
3844: pha
3845: lda #1
3846: jsr LB47D
3847: pla
3848: ldy #0
3849: sta (zFACHO),y
3850: pla
3851: pla
3852: jmp LB4CA
3853: bLEFTD: jsr bPREAM
3854: cmp (zTEMP_50),y
3855: tya
3856: LB706: bcc LB70C
3857: lda (zTEMP_50),y
3858: tax
3859: tya
3860: LB70C: pha
3861: LB70D: txa
3862: LB70E: pha
3863: jsr LB47D
3864: lda zTEMP_50
3865: ldy zTEMP_50 + 1
3866: jsr LB6AA
3867: pla
3868: tay
3869: pla
3870: clc
3871: adc zINDEX
3872: sta zINDEX
3873: bcc LB725
3874: inc zINDEX + 1
3875: LB725: tya
3876: jsr LB68C
3877: jmp LB4CA
3878: bRIGHTD:jsr bPREAM
3879: clc
3880: sbc (zTEMP_50),y
3881: eor #$FF
3882: jmp LB706
3883: bMIDD: lda #$FF
3884: sta zFACHO + 3
3885: jsr zCHRGOT
3886: cmp #')'
3887: beq LB748
3888: jsr bCHKCMA
3889: jsr LB79E
3890: LB748: jsr bPREAM
3891: beq LB798
3892: dex
3893: txa
3894: pha
3895: clc
3896: ldx #0
3897: sbc (zTEMP_50),y
3898: bcs LB70D
3899: eor #$FF
3900: cmp zFACHO + 3
3901: bcc LB70E
3902: lda zFACHO + 3
3903: bcs LB70E
3904: bPREAM: jsr bCHKclose
3905: pla
3906: tay
3907: pla
3908: sta zJMPER + 1
3909: pla
3910: pla
3911: pla
3912: tax
3913: pla
3914: sta zTEMP_50
3915: pla
3916: sta zTEMP_50 + 1
3917: lda zJMPER + 1
3918: pha
3919: tya
3920: pha
3921: ldy #0
3922: txa
3923: rts
3924: bLEN: jsr bLEN1
3925: jmp LB3A2
3926: bLEN1: jsr bFRESTR
3927: ldx #0
3928: stx zVALTYP
3929: tay
3930: rts
3931: bASC: jsr bLEN1
3932: beq LB798
3933: ldy #0
3934: lda (zINDEX),y
3935: tay
3936: jmp LB3A2
3937: LB798: jmp bIQERR
3938: bGTBYTC:jsr zCHRGET
3939: LB79E: jsr bFRMNUM
3940: LB7A1: jsr LB1B8
3941: ldx zFACHO + 2
3942: bne LB798
3943: ldx zFACHO + 3
3944: jmp zCHRGOT
3945: bVAL: jsr bLEN1
3946: bne bSTRVAL
3947: jmp LB8F7
3948: bSTRVAL:ldx zTXTPTR
3949: ldy zTXTPTR + 1
3950: stx zFBUFPT
3951: sty zFBUFPT + 1
3952: ldx zINDEX
3953: stx zTXTPTR
3954: clc
3955: adc zINDEX
3956: sta zINDEX2
3957: ldx zINDEX + 1
3958: stx zTXTPTR + 1
3959: bcc LB7CD
3960: inx
3961: LB7CD: stx zINDEX2 + 1
3962: ldy #0
3963: lda (zINDEX2),y
3964: pha
3965: tya
3966: sta (zINDEX2),y
3967: jsr zCHRGOT
3968: jsr bFIN
3969: pla
3970: ldy #0
3971: sta (zINDEX2),y
3972: LB7E2: ldx zFBUFPT
3973: ldy zFBUFPT + 1
3974: stx zTXTPTR
3975: sty zTXTPTR + 1
3976: rts
3977: bGETNUM:jsr bFRMNUM
3978: jsr bGETADR
3979: LB7F1: jsr bCHKCMA
3980: jmp LB79E
3981: bGETADR:lda zFACSGN
3982: bmi LB798
3983: lda zFACEXP
3984: cmp #$91 ; exponent for 65536
3985: bcs LB798
3986: jsr bQINT
3987: lda zFACHO + 2
3988: ldy zFACHO + 3
3989: sty zLINNUM
3990: sta zLINNUM + 1
3991: rts
3992: bPEEK: lda zLINNUM + 1
3993: pha
3994: lda zLINNUM
3995: pha
3996: jsr bGETADR
3997: ldy #0
3998: lda (zLINNUM),y
3999: tay
4000: pla
4001: sta zLINNUM
4002: pla
4003: sta zLINNUM + 1
4004: jmp LB3A2
4005: bPOKE: jsr bGETNUM
4006: txa
4007: ldy #0
4008: sta (zLINNUM),y
4009: rts
4010: bWAIT: jsr bGETNUM
4011: stx zFORPNT
4012: ldx #0
4013: jsr zCHRGOT
4014: beq LB83C
4015: jsr LB7F1
4016: LB83C: stx zFORPNT + 1
4017: ldy #0
4018: LB840: lda (zLINNUM),y
4019: eor zFORPNT + 1
4020: and zFORPNT
4021: beq LB840
4022: LB848: rts
4023: bFADDH: lda #<bFHALF
4024: ldy #>bFHALF
4025: jmp bFADD
4026: bFSUB: jsr bCONUPK
4027: FSUBT: lda zFACSGN
4028: eor #$FF
4029: sta zFACSGN
4030: eor zARGSGN
4031: sta zARISGN
4032: lda zFACEXP
4033: jmp FADDT
4034: bFADD5: jsr LB999
4035: bcc LB8A3
4036: bFADD: jsr bCONUPK
4037: FADDT: bne LB86F
4038: jmp bMOVFA
4039: LB86F: ldx zFACOV
4040: stx zJMPER + 2
4041: ldx #zARGEXP
4042: lda zARGEXP
4043: LB877: tay
4044: beq LB848
4045: sec
4046: sbc zFACEXP
4047: beq LB8A3
4048: bcc LB893
4049: sty zFACEXP
4050: ldy zARGSGN
4051: sty zFACSGN
4052: eor #$FF
4053: adc #0
4054: ldy #0
4055: sty zJMPER + 2
4056: ldx #zFACEXP
4057: bne LB897
4058: LB893: ldy #0
4059: sty zFACOV
4060: LB897: cmp #$F9
4061: bmi bFADD5
4062: tay
4063: lda zFACOV
4064: lsr 1,x
4065: jsr LB9B0
4066: LB8A3: bit zARISGN
4067: bpl LB8FE
4068: ldy #zFACEXP
4069: cpx #zARGEXP
4070: beq LB8AF
4071: ldy #zARGEXP
4072: LB8AF: sec
4073: eor #$FF
4074: adc zJMPER + 2
4075: sta zFACOV
4076: lda 4,y
4077: sbc 4,x
4078: sta zFACHO + 3
4079: lda zADRAY1,y
4080: sbc zADRAY1,x
4081: sta zFACHO + 2
4082: lda 2,y
4083: sbc 2,x
4084: sta zFACHO + 1
4085: lda 1,y
4086: sbc 1,x
4087: sta zFACHO
4088: LB8D2: bcs LB8D7
4089: jsr bNEGFAC
4090: LB8D7: ldy #0
4091: tya
4092: clc
4093: LB8DB: ldx zFACHO
4094: bne LB929
4095: ldx zFACHO + 1
4096: stx zFACHO
4097: ldx zFACHO + 2
4098: stx zFACHO + 1
4099: ldx zFACHO + 3
4100: stx zFACHO + 2
4101: ldx zFACOV
4102: stx zFACHO + 3
4103: sty zFACOV
4104: adc #8
4105: cmp #$20
4106: bne LB8DB
4107: LB8F7: lda #0
4108: LB8F9: sta zFACEXP
4109: LB8FB: sta zFACSGN
4110: rts
4111: LB8FE: adc zJMPER + 2
4112: sta zFACOV
4113: lda zFACHO + 3
4114: adc zARGHO + 3
4115: sta zFACHO + 3
4116: lda zFACHO + 2
4117: adc zARGHO + 2
4118: sta zFACHO + 2
4119: lda zFACHO + 1
4120: adc zARGHO + 1
4121: sta zFACHO + 1
4122: lda zFACHO
4123: adc zARGHO
4124: sta zFACHO
4125: jmp LB936
4126: LB91D: adc #1
4127: asl zFACOV
4128: rol zFACHO + 3
4129: rol zFACHO + 2
4130: rol zFACHO + 1
4131: rol zFACHO
4132: LB929: bpl LB91D
4133: sec
4134: sbc zFACEXP
4135: bcs LB8F7
4136: eor #$FF
4137: adc #1
4138: sta zFACEXP
4139: LB936: bcc LB946
4140: LB938: inc zFACEXP
4141: beq bOVERR
4142: ror zFACHO
4143: ror zFACHO + 1
4144: ror zFACHO + 2
4145: ror zFACHO + 3
4146: ror zFACOV
4147: LB946: rts
4148: bNEGFAC:lda zFACSGN
4149: eor #$FF
4150: sta zFACSGN
4151: LB94D: lda zFACHO
4152: eor #$FF
4153: sta zFACHO
4154: lda zFACHO + 1
4155: eor #$FF
4156: sta zFACHO + 1
4157: lda zFACHO + 2
4158: eor #$FF
4159: sta zFACHO + 2
4160: lda zFACHO + 3
4161: eor #$FF
4162: sta zFACHO + 3
4163: lda zFACOV
4164: eor #$FF
4165: sta zFACOV
4166: inc zFACOV
4167: bne LB97D
4168: LB96F: inc zFACHO + 3
4169: bne LB97D
4170: inc zFACHO + 2
4171: bne LB97D
4172: inc zFACHO + 1
4173: bne LB97D
4174: inc zFACHO
4175: LB97D: rts
4176: bOVERR: ldx #ErrOverflow
4177: jmp bERROR
4178: bMULSHF:ldx #zRESHO - 1
4179: LB985: ldy 4,x
4180: sty zFACOV
4181: ldy 3,x
4182: sty 4,x
4183: ldy 2,x
4184: sty 3,x
4185: ldy 1,x
4186: sty 2,x
4187: ldy zBITS
4188: sty 1,x
4189: LB999: adc #8
4190: bmi LB985
4191: beq LB985
4192: sbc #8
4193: tay
4194: lda zFACOV
4195: bcs LB9BA
4196: LB9A6: asl 1,x
4197: bcc LB9AC
4198: inc 1,x
4199: LB9AC: ror 1,x
4200: ror 1,x
4201: LB9B0: ror 2,x
4202: ror 3,x
4203: ror 4,x
4204: ror a
4205: iny
4206: bne LB9A6
4207: LB9BA: clc
4208: rts
4209:
4210: bFPTABL:.byte $81,$00,$00,$00,$00 ; FP 1
4211: LB9C1: .byte $03 ; Grade of polynomial
4212: .byte $7F,$5E,$56,$CB,$79 ; .434255942
4213: .byte $80,$13,$9B,$0B,$64 ; .576584541
4214: .byte $80,$76,$38,$93,$16 ; .961800759
4215: .byte $82,$38,$AA,$3B,$20 ; 2.88539007
4216: LB9D6: .byte $80,$35,$04,$F3,$34 ; 1 / SQR(2)
4217: LB9DB: .byte $81,$35,$04,$F3,$34 ; SQR(2)
4218: LB9E0: .byte $80,$80,$00,$00,$00 ; - 0.5
4219: LB9E5: .byte $80,$31,$72,$17,$F8 ; LOG(2)
4220:
4221: bLOG: jsr bSIGN
4222: beq LB9F1
4223: bpl LB9F4
4224: LB9F1: jmp bIQERR
4225: LB9F4: lda zFACEXP
4226: sbc #$7F
4227: pha
4228: lda #$80
4229: sta zFACEXP
4230: lda #<LB9D6
4231: ldy #>LB9D6
4232: jsr bFADD
4233: lda #<LB9DB
4234: ldy #>LB9DB
4235: jsr bFDIVT
4236: lda #<bFPTABL
4237: ldy #>bFPTABL
4238: jsr bFSUB
4239: lda #<LB9C1
4240: ldy #>LB9C1
4241: jsr bPOLYX
4242: lda #<LB9E0
4243: ldy #>LB9E0
4244: jsr bFADD
4245: pla
4246: jsr LBD7E
4247: lda #<LB9E5
4248: ldy #>LB9E5
4249: bFMULT: jsr bCONUPK
4250: FMULTT: bne LBA30
4251: jmp LBA8B
4252: LBA30: jsr bMULDIV
4253: lda #$00
4254: sta zRESHO
4255: sta zRESHO + 1
4256: sta zRESHO + 2
4257: sta zRESHO + 3
4258: lda zFACOV
4259: jsr bMULPLY
4260: lda zFACHO + 3
4261: jsr bMULPLY
4262: lda zFACHO + 2
4263: jsr bMULPLY
4264: lda zFACHO + 1
4265: jsr bMULPLY
4266: lda zFACHO
4267: jsr LBA5E
4268: jmp LBB8F
4269: bMULPLY:bne LBA5E
4270: jmp bMULSHF
4271: LBA5E: lsr a
4272: ora #$80
4273: LBA61: tay
4274: bcc LBA7D
4275: clc
4276: lda zRESHO + 3
4277: adc zARGHO + 3
4278: sta zRESHO + 3
4279: lda zRESHO + 2
4280: adc zARGHO + 2
4281: sta zRESHO + 2
4282: lda zRESHO + 1
4283: adc zARGHO + 1
4284: sta zRESHO + 1
4285: lda zRESHO
4286: adc zARGHO
4287: sta zRESHO
4288: LBA7D: ror zRESHO
4289: ror zRESHO + 1
4290: ror zRESHO + 2
4291: ror zRESHO + 3
4292: ror zFACOV
4293: tya
4294: lsr a
4295: bne LBA61
4296: LBA8B: rts
4297: bCONUPK:sta zINDEX
4298: sty zINDEX + 1
4299: ldy #4
4300: lda (zINDEX),y
4301: sta zARGHO + 3
4302: dey
4303: lda (zINDEX),y
4304: sta zARGHO + 2
4305: dey
4306: lda (zINDEX),y
4307: sta zARGHO + 1
4308: dey
4309: lda (zINDEX),y
4310: sta zARGSGN
4311: eor zFACSGN
4312: sta zARISGN
4313: lda zARGSGN
4314: ora #$80
4315: sta zARGHO
4316: dey
4317: lda (zINDEX),y
4318: sta zARGEXP
4319: lda zFACEXP
4320: rts
4321: bMULDIV:lda zARGEXP
4322: LBAB9: beq LBADA
4323: clc
4324: adc zFACEXP
4325: bcc LBAC4
4326: bmi LBADF
4327: clc
4328: .byte ASM_BIT3
4329: LBAC4: bpl LBADA
4330: adc #$80
4331: sta zFACEXP
4332: bne LBACF
4333: jmp LB8FB
4334: LBACF: lda zARISGN
4335: sta zFACSGN
4336: rts
4337: bMLDVEX:lda zFACSGN
4338: eor #$FF
4339: bmi LBADF
4340: LBADA: pla
4341: pla
4342: jmp LB8F7
4343: LBADF: jmp bOVERR
4344: bMUL10: jsr bMOVAF
4345: tax
4346: beq LBAF8
4347: clc
4348: adc #2 ; exponent + 2, thus, X * 4
4349: bcs LBADF
4350: LBAED: ldx #0
4351: stx zARISGN
4352: jsr LB877
4353: inc zFACEXP ; exponent + 2, thus, ((X * 4) + X) * 2 = X * 10
4354: beq LBADF
4355: LBAF8: rts
4356:
4357: bTENC: .byte $84,$20,$00,$00,$00
4358:
4359: bDIV10: jsr bMOVAF
4360: lda #<bTENC
4361: ldy #>bTENC
4362: ldx #0
4363: bFDIV: stx zARISGN
4364: jsr bMOVFM
4365: jmp FDIVT
4366: bFDIVT: jsr bCONUPK
4367: FDIVT: beq LBB8A
4368: jsr bROUND
4369: lda #0
4370: sec
4371: sbc zFACEXP
4372: sta zFACEXP
4373: jsr bMULDIV
4374: inc zFACEXP
4375: beq LBADF
4376: ldx #-4
4377: lda #1
4378: LBB29: ldy zARGHO
4379: cpy zFACHO
4380: bne LBB3F
4381: ldy zARGHO + 1
4382: cpy zFACHO + 1
4383: bne LBB3F
4384: ldy zARGHO + 2
4385: cpy zFACHO + 2
4386: bne LBB3F
4387: ldy zARGHO + 3
4388: cpy zFACHO + 3
4389: LBB3F: php
4390: rol a
4391: bcc LBB4C
4392: inx
4393: sta zRESHO + 3,x
4394: beq LBB7A
4395: bpl LBB7E
4396: lda #1
4397: LBB4C: plp
4398: bcs LBB5D
4399: LBB4F: asl zARGHO + 3
4400: rol zARGHO + 2
4401: rol zARGHO + 1
4402: rol zARGHO
4403: bcs LBB3F
4404: bmi LBB29
4405: bpl LBB3F
4406:
4407: LBB5D: tay
4408: lda zARGHO + 3
4409: sbc zFACHO + 3
4410: sta zARGHO + 3
4411: lda zARGHO + 2
4412: sbc zFACHO + 2
4413: sta zARGHO + 2
4414: lda zARGHO + 1
4415: sbc zFACHO + 1
4416: sta zARGHO + 1
4417: lda zARGHO
4418: sbc zFACHO
4419: sta zARGHO
4420: tya
4421: jmp LBB4F
4422: LBB7A: lda #$40
4423: bne LBB4C
4424: ; -----------
4425: LBB7E: asl a
4426: asl a
4427: asl a
4428: asl a
4429: asl a
4430: asl a
4431: sta zFACOV
4432: plp
4433: jmp LBB8F
4434: LBB8A: ldx #ErrDivisionByZero
4435: jmp bERROR
4436: LBB8F: lda zRESHO
4437: sta zFACHO
4438: lda zRESHO + 1
4439: sta zFACHO + 1
4440: lda zRESHO + 2
4441: sta zFACHO + 2
4442: lda zRESHO + 3
4443: sta zFACHO + 3
4444: jmp LB8D7
4445: bMOVFM: sta zINDEX
4446: sty zINDEX + 1
4447: ldy #4
4448: lda (zINDEX),y
4449: sta zFACHO + 3
4450: dey
4451: lda (zINDEX),y
4452: sta zFACHO + 2
4453: dey
4454: lda (zINDEX),y
4455: sta zFACHO + 1
4456: dey
4457: lda (zINDEX),y
4458: sta zFACSGN
4459: ora #$80
4460: sta zFACHO
4461: dey
4462: lda (zINDEX),y
4463: sta zFACEXP
4464: sty zFACOV
4465: rts
4466: bMOV2F: ldx #zTEMPF2
4467: .byte ASM_BIT3
4468: LBBCA: ldx #zTEMPF1
4469: ldy #0
4470: beq LBBD4
4471: LBBD0: ldx zFORPNT
4472: ldy zFORPNT + 1
4473: LBBD4: jsr bROUND
4474: stx zINDEX
4475: sty zINDEX + 1
4476: ldy #4
4477: lda zFACHO + 3
4478: sta (zINDEX),y
4479: dey
4480: lda zFACHO + 2
4481: sta (zINDEX),y
4482: dey
4483: lda zFACHO + 1
4484: sta (zINDEX),y
4485: dey
4486: lda zFACSGN
4487: ora #$7F
4488: and zFACHO
4489: sta (zINDEX),y
4490: dey
4491: lda zFACEXP
4492: sta (zINDEX),y
4493: sty zFACOV
4494: rts
4495: bMOVFA: lda zARGSGN
4496: LBBFE: sta zFACSGN
4497: ldx #5 ; why 5, but 6 in LBC0F?
4498: LBC02: lda zARG - 1,x
4499: sta zFAC - 1,x
4500: dex
4501: bne LBC02
4502: stx zFACOV
4503: rts
4504: bMOVAF: jsr bROUND
4505: LBC0F: ldx #6 ; why 6, but 5 in LBBFE + 2?
4506: LBC11: lda zFAC - 1,x
4507: sta zARG - 1,x
4508: dex
4509: bne LBC11
4510: stx zFACOV
4511: LBC1A: rts
4512: bROUND: lda zFACEXP
4513: beq LBC1A
4514: asl zFACOV
4515: bcc LBC1A
4516: LBC23: jsr LB96F
4517: bne LBC1A
4518: jmp LB938
4519: bSIGN: lda zFACEXP
4520: beq LBC38
4521: LBC2F: lda zFACSGN
4522: LBC31: rol a
4523: lda #$FF
4524: bcs LBC38
4525: lda #1
4526: LBC38: rts
4527: bSGN: jsr bSIGN
4528: LBC3C: sta zFACHO
4529: lda #$00
4530: sta zFACHO + 1
4531: ldx #$88
4532: LBC44: lda zFACHO
4533: eor #$FF
4534: rol a
4535: LBC49: lda #$00
4536: sta zFACHO + 3
4537: sta zFACHO + 2
4538: LBC4F: stx zFACEXP
4539: sta zFACOV
4540: sta zFACSGN
4541: jmp LB8D2
4542: bABS: lsr zFACSGN
4543: rts
4544: bFCOMP: sta zINDEX2
4545: LBC5D: sty zINDEX2 + 1
4546: ldy #0
4547: lda (zINDEX2),y
4548: iny
4549: tax
4550: beq bSIGN
4551: lda (zINDEX2),y
4552: eor zFACSGN
4553: bmi LBC2F
4554: cpx zFACEXP
4555: bne LBC92
4556: lda (zINDEX2),y
4557: ora #$80
4558: cmp zFACHO
4559: bne LBC92
4560: iny
4561: lda (zINDEX2),y
4562: cmp zFACHO + 1
4563: bne LBC92
4564: iny
4565: lda (zINDEX2),y
4566: cmp zFACHO + 2
4567: bne LBC92
4568: iny
4569: lda #$7F
4570: cmp zFACOV
4571: lda (zINDEX2),y
4572: sbc zFACHO + 3
4573: beq LBCBA
4574: LBC92: lda zFACSGN
4575: bcc LBC98
4576: eor #$FF
4577: LBC98: jmp LBC31
4578: bQINT: lda zFACEXP
4579: beq LBCE9
4580: sec
4581: sbc #$A0
4582: bit zFACSGN
4583: bpl LBCAF
4584: tax
4585: lda #$FF
4586: sta zBITS
4587: jsr LB94D
4588: txa
4589: LBCAF: ldx #$61
4590: cmp #$F9
4591: bpl LBCBB
4592: jsr LB999
4593: sty zBITS
4594: LBCBA: rts
4595: LBCBB: tay
4596: lda zFACSGN
4597: and #$80
4598: lsr zFACHO
4599: ora zFACHO
4600: sta zFACHO
4601: jsr LB9B0
4602: sty zBITS
4603: rts
4604: bINT: lda zFACEXP
4605: cmp #$A0
4606: bcs LBCF2
4607: jsr bQINT
4608: sty zFACOV
4609: lda zFACSGN
4610: sty zFACSGN
4611: eor #$80
4612: rol a
4613: lda #$A0
4614: sta zFACEXP
4615: lda zFACHO + 3
4616: sta zCHARAC
4617: jmp LB8D2
4618: LBCE9: sta zFACHO
4619: sta zFACHO + 1
4620: sta zFACHO + 2
4621: sta zFACHO + 3
4622: tay
4623: LBCF2: rts
4624: bFIN: ldy #0
4625: ldx #zFACSGN - zTEMPF2
4626: LBCF7: sty zTEMPF2 + 1,x
4627: dex
4628: bpl LBCF7
4629: bcc LBD0D
4630: cmp #'-'
4631: bne LBD06
4632: stx zSGNFLG
4633: beq LBD0A
4634: LBD06: cmp #'+'
4635: bne LBD0F
4636: LBD0A: jsr zCHRGET
4637: LBD0D: bcc LBD6A
4638: LBD0F: cmp #'.'
4639: beq LBD41
4640: cmp #'E'
4641: bne LBD47
4642: jsr zCHRGET
4643: bcc LBD33
4644: cmp #TokMinus
4645: beq LBD2E
4646: cmp #'-'
4647: beq LBD2E
4648: cmp #TokPlus
4649: beq LBD30
4650: cmp #'+'
4651: beq LBD30
4652: bne LBD35
4653: LBD2E: ror zTEMP_60
4654: LBD30: jsr zCHRGET
4655: LBD33: bcc LBD91
4656: LBD35: bit zTEMP_60
4657: bpl LBD47
4658: lda #0
4659: sec
4660: sbc zTEMP_5E
4661: jmp LBD49
4662: LBD41: ror zTEMP_5F
4663: bit zTEMP_5F
4664: bvc LBD0A
4665: LBD47: lda zTEMP_5E
4666: LBD49: sec
4667: sbc zTEMP_5D
4668: sta zTEMP_5E
4669: beq LBD62
4670: bpl LBD5B
4671: LBD52: jsr bDIV10
4672: inc zTEMP_5E
4673: bne LBD52
4674: beq LBD62
4675: LBD5B: jsr bMUL10
4676: dec zTEMP_5E
4677: bne LBD5B
4678: LBD62: lda zSGNFLG
4679: bmi LBD67
4680: rts
4681: LBD67: jmp bNEGOP
4682: LBD6A: pha
4683: bit zTEMP_5F
4684: bpl LBD71
4685: inc zTEMP_5D
4686: LBD71: jsr bMUL10
4687: pla
4688: sec
4689: sbc #'0'
4690: jsr LBD7E
4691: jmp LBD0A
4692: LBD7E: pha
4693: jsr bMOVAF
4694: pla
4695: jsr LBC3C
4696: lda zARGSGN
4697: eor zFACSGN
4698: sta zARISGN
4699: ldx zFACEXP
4700: jmp FADDT
4701: LBD91: lda zTEMP_5E
4702: cmp #10 ; $0A
4703: bcc LBDA0
4704: lda #100 ; $64
4705: bit zTEMP_60
4706: bmi LBDAE
4707: jmp bOVERR
4708: LBDA0: asl a
4709: asl a
4710: clc
4711: adc zTEMP_5E
4712: asl a
4713: clc
4714: ldy #0
4715: adc (zTXTPTR),y
4716: sec
4717: sbc #'0'
4718: LBDAE: sta zTEMP_5E
4719: jmp LBD30
4720:
4721: bN0999: .byte $9B,$3E,$BC,$1F,$FD ; FP: 99999999.9
4722: LBDB8: .byte $9E,$6E,$6B,$27,$FD ; FP: 999999999
4723: LBDBD: .byte $9E,$6E,$6B,$28,$00 ; FP: 1E9
4724:
4725: bINPRT: lda #<StrIn ; output string " IN "
4726: ldy #>StrIn
4727: jsr LBDDA
4728:
4729: lda zCURLIN + 1 ; output the current line number
4730: ldx zCURLIN
4731: LBDCD: sta zFACHO
4732: stx zFACHO + 1
4733: ldx #$90
4734: sec
4735: jsr LBC49
4736: jsr LBDDF
4737: LBDDA: jmp bSTROUT
4738:
4739: bFOUT: ldy #1
4740: LBDDF: lda #' '
4741: bit zFACSGN
4742: bpl LBDE7
4743: lda #'-'
4744: LBDE7: sta zASCWRK,y
4745: sta zFACSGN
4746: sty zFBUFPT
4747: iny
4748: lda #'0'
4749: ldx zFACEXP
4750: bne LBDF8
4751: jmp LBF04
4752: LBDF8: lda #$00
4753: cpx #$80
4754: beq LBE00
4755: bcs LBE09
4756: LBE00: lda #<LBDBD
4757: ldy #>LBDBD
4758: jsr bFMULT
4759: lda #$F7
4760: LBE09: sta zTEMP_5D
4761: LBE0B: lda #<LBDB8
4762: ldy #>LBDB8
4763: jsr bFCOMP
4764: beq LBE32
4765: bpl LBE28
4766: LBE16: lda #<bN0999
4767: ldy #>bN0999
4768: jsr bFCOMP
4769: beq LBE21
4770: bpl LBE2F
4771: LBE21: jsr bMUL10
4772: dec zTEMP_5D
4773: bne LBE16
4774: LBE28: jsr bDIV10
4775: inc zTEMP_5D
4776: bne LBE0B
4777: LBE2F: jsr bFADDH
4778: LBE32: jsr bQINT
4779: ldx #$01
4780: lda zTEMP_5D
4781: clc
4782: adc #$0A
4783: bmi LBE47
4784: cmp #$0B
4785: bcs LBE48
4786: adc #$FF
4787: tax
4788: lda #$02
4789: LBE47: sec
4790: LBE48: sbc #$02
4791: sta zTEMP_5E
4792: stx zTEMP_5D
4793: txa
4794: beq LBE53
4795: bpl LBE66
4796: LBE53: ldy zFBUFPT
4797: lda #'.'
4798: iny
4799: sta zASCWRK,y
4800: txa
4801: beq LBE64
4802: lda #'0'
4803: iny
4804: sta zASCWRK,y
4805: LBE64: sty zFBUFPT
4806: LBE66: ldy #$00
4807: bFOUTIM:ldx #$80
4808: LBE6A: lda zFACHO + 3
4809: clc
4810: adc LBF16 + 3,y
4811: sta zFACHO + 3
4812: lda zFACHO + 2
4813: adc LBF16 + 2,y
4814: sta zFACHO + 2
4815: lda zFACHO + 1
4816: adc LBF16 + 1,y
4817: sta zFACHO + 1
4818: lda zFACHO
4819: adc LBF16,y
4820: sta zFACHO
4821: inx
4822: bcs LBE8E
4823: bpl LBE6A
4824: bmi LBE90
4825: LBE8E: bmi LBE6A
4826: LBE90: txa
4827: bcc LBE97
4828: eor #$FF
4829: adc #10
4830: LBE97: adc #'0' - 1
4831: iny
4832: iny
4833: iny
4834: iny
4835: sty zVARPNT
4836: ldy zFBUFPT
4837: iny
4838: tax
4839: and #$7F
4840: sta zASCWRK,y
4841: dec zTEMP_5D
4842: bne LBEB2
4843: lda #'.'
4844: iny
4845: sta zASCWRK,y
4846: LBEB2: sty zFBUFPT
4847: ldy zVARPNT
4848: txa
4849: eor #$FF
4850: and #$80
4851: tax
4852: cpy #$24 ; @?
4853: beq LBEC4
4854: cpy #$3C ; @?
4855: bne LBE6A
4856: LBEC4: ldy zFBUFPT
4857: LBEC6: lda zASCWRK,y
4858: dey
4859: cmp #'0'
4860: beq LBEC6
4861: cmp #'.'
4862: beq LBED3
4863: iny
4864: LBED3: lda #'+'
4865: ldx zTEMP_5E
4866: beq LBF07
4867: bpl LBEE3
4868: lda #0
4869: sec
4870: sbc zTEMP_5E
4871: tax
4872: lda #'-'
4873: LBEE3: sta lSTACK + 1,y
4874: lda #'E'
4875: sta lSTACK,y
4876: txa
4877: ldx #'0' - 1
4878: sec
4879: LBEEF: inx
4880: sbc #10
4881: bcs LBEEF
4882: adc #'9' + 1
4883: sta lSTACK + 3,y
4884: txa
4885: sta lSTACK + 2,y
4886: lda #0
4887: sta lSTACK + 4,y
4888: beq LBF0C
4889: LBF04: sta zASCWRK,y
4890: LBF07: lda #0
4891: sta lSTACK,y
4892: LBF0C: lda #<lSTACK
4893: ldy #>lSTACK
4894: rts
4895: bFHALF: .byte $80,$00,$00,$00,$00
4896:
4897: bFNULL = bFHALF + 2
4898: bTI = bFNULL
4899:
4900: LBF16: .byte $FA,$0A,$1F,$00
4901:
4902: .byte $00,$98,$96,$80
4903: .byte $FF,$F0,$BD,$C0
4904: .byte $00,$01,$86,$A0
4905: .byte $FF,$FF,$D8,$F0
4906: .byte $00,$00,$03,$E8
4907: .byte $FF,$FF,$FF,$9C
4908: .byte $00,$00,$00,$0A
4909: .byte $FF,$FF,$FF,$FF
4910:
4911: .byte $FF,$DF,$0A,$80
4912: .byte $00,$03,$4B,$C0
4913: .byte $FF,$FF,$73,$60
4914: .byte $00,$00,$0E,$10
4915: .byte $FF,$FF,$FD,$A8
4916: .byte $00,$00,$00,$3C
4917:
4918: ; This seems to be something like a checksum for the BASIC-ROM.
4919:
4920: .byte CHKSUM_BF52
4921:
4922: ; FillUntil BASIC_START + $1F71,BASIC_FILLER
4923:
4924: .segment "BASICSQR"
4925:
4926: bSQR: jsr bMOVAF
4927: lda #<bFHALF
4928: ldy #>bFHALF
4929: jsr bMOVFM
4930: bFPWRT: beq bEXP
4931: lda zARGEXP
4932: bne LBF84
4933: jmp LB8F9
4934: LBF84: ldx #<zTEMPF3
4935: ldy #>zTEMPF3
4936: jsr LBBD4
4937: lda zARGSGN
4938: bpl LBF9E
4939: jsr bINT
4940: lda #<zTEMPF3
4941: ldy #>zTEMPF3
4942: jsr bFCOMP
4943: bne LBF9E
4944: tya
4945: ldy zCHARAC
4946: LBF9E: jsr LBBFE
4947: tya
4948: pha
4949: jsr bLOG
4950: lda #<zTEMPF3
4951: ldy #>zTEMPF3
4952: jsr bFMULT
4953: jsr bEXP
4954: pla
4955: lsr a
4956: bcc LBFBE
4957: bNEGOP: lda zFACEXP
4958: beq LBFBE
4959: lda zFACSGN
4960: eor #$FF
4961: sta zFACSGN
4962: LBFBE: rts
4963:
4964: bLOGEB2:
4965: .byte $81,$38,$AA,$3B,$29
4966: LBFC4:
4967: .byte $07
4968: .byte $71,$34,$58,$3E,$56
4969: .byte $74,$16,$7E,$B3,$1B
4970: .byte $77,$2F,$EE,$E3,$85
4971: .byte $7A,$1D,$84,$1C,$2A
4972: .byte $7C,$63,$59,$58,$0A
4973: .byte $7E,$75,$FD,$E7,$C6
4974: .byte $80,$31,$72,$18,$10
4975: .byte $81,$00,$00,$00,$00
4976:
4977: bEXP: lda #<bLOGEB2
4978: ldy #>bLOGEB2
4979: jsr bFMULT
4980: lda zFACOV
4981: adc #$50
4982: bcc LBFFD
4983: jsr LBC23
4984:
4985: LBFFD:
4986:
4987: .segment "BASICSQRJMP"
4988:
4989: jmp LE000
4990:
4991: .segment "BASICSQR2"
4992:
4993: LE000:
4994: sta zJMPER + 2
4995:
4996: .segment "BASICSQR3"
4997: jsr LBC0F
4998: lda zFACEXP
4999: cmp #$88
5000: bcc LE00E
5001: LE00B: jsr bMLDVEX
5002: LE00E: jsr bINT
5003: lda zCHARAC
5004: clc
5005: adc #$81
5006: beq LE00B
5007: sec
5008: sbc #1
5009: pha
5010: ldx #5
5011: LE01E: lda zARGEXP,x
5012: ldy zFACEXP,x
5013: sta zFACEXP,x
5014: sty zARGEXP,x
5015: dex
5016: bpl LE01E
5017: lda zJMPER + 2
5018: sta zFACOV
5019: jsr FSUBT
5020: jsr bNEGOP
5021: lda #<LBFC4
5022: ldy #>LBFC4
5023: jsr LE059
5024: lda #0
5025: sta zARISGN
5026: pla
5027: jsr LBAB9
5028: rts
5029: bPOLYX: sta zFBUFPT
5030: sty zFBUFPT + 1
5031: jsr LBBCA
5032: lda #zTEMPF1
5033: jsr bFMULT
5034: jsr LE05D
5035: lda #<zTEMPF1
5036: ldy #>zTEMPF1
5037: jmp bFMULT
5038: LE059: sta zFBUFPT
5039: sty zFBUFPT + 1
5040: LE05D: jsr bMOV2F
5041: lda (zFBUFPT),y
5042: sta zSGNFLG
5043: ldy zFBUFPT
5044: iny
5045: tya
5046: bne LE06C
5047: inc zFBUFPT + 1
5048: LE06C: sta zFBUFPT
5049: ldy zFBUFPT + 1
5050: LE070: jsr bFMULT
5051: lda zFBUFPT
5052: ldy zFBUFPT + 1
5053: clc
5054: adc #5
5055: bcc LE07D
5056: iny
5057: LE07D: sta zFBUFPT
5058: sty zFBUFPT + 1
5059: jsr bFADD
5060: lda #<zTEMPF2
5061: ldy #>zTEMPF2
5062: dec zSGNFLG
5063: bne LE070
5064: rts
5065: bRMULC: .byte $98,$35,$44,$7A,$00
5066: LE092: .byte $68,$28,$B1,$46,$00
5067:
5068: bRND: jsr bSIGN
5069: bmi LE0D3
5070: bne LE0BE
5071: jsr kIOBASE
5072: stx zINDEX
5073: sty zINDEX + 1
5074: ldy #4
5075: lda (zINDEX),y
5076: sta zFACHO
5077: iny
5078: lda (zINDEX),y
5079: sta zFACHO + 2
5080: ldy #8
5081: lda (zINDEX),y
5082: sta zFACHO + 1
5083: iny
5084: lda (zINDEX),y
5085: sta zFACHO + 3
5086: jmp LE0E3
5087: LE0BE: lda #<zRNDX
5088: ldy #>zRNDX
5089: jsr bMOVFM
5090: lda #<bRMULC
5091: ldy #>bRMULC
5092: jsr bFMULT
5093: lda #<LE092
5094: ldy #>LE092
5095: jsr bFADD
5096: LE0D3: ldx zFACHO + 3
5097: lda zFACHO
5098: sta zFACHO + 3
5099: stx zFACHO
5100: ldx zFACHO + 1
5101: lda zFACHO + 2
5102: sta zFACHO + 1
5103: stx zFACHO + 2
5104: LE0E3: lda #0
5105: sta zFACSGN
5106: lda zFACEXP
5107: sta zFACOV
5108: lda #$80
5109: sta zFACEXP
5110: jsr LB8D7
5111: ldx #<zRNDX
5112: ldy #>zRNDX
5113: LE0F6: jmp LBBD4
5114: bBIOERR:cmp #$F0
5115: bne LE104
5116: sty zMEMSIZ + 1
5117: stx zMEMSIZ
5118: jmp LA663
5119: LE104: tax
5120: bne LE109
5121: ldx #ErrBreak
5122: LE109: jmp bERROR
5123: bCHOUT: jsr kCHROUT
5124: bcs bBIOERR
5125: rts
5126: bCHIN: jsr kCHRIN
5127: bcs bBIOERR
5128: rts
5129: bCKOUT:
5130: .if CompileComputer >= C64_02
5131: jsr LE4AD
5132: .else
5133: jsr kCHKOUT
5134: .endif
5135: bcs bBIOERR
5136: rts
5137: bCKIN: jsr kCHKIN
5138: bcs bBIOERR
5139: rts
5140: bGETIN: jsr kGETIN
5141: bcs bBIOERR
5142: rts
5143: bSYS: jsr bFRMNUM
5144: jsr bGETADR
5145: lda #>(LE147 - 1)
5146: pha
5147: lda #<(LE147 - 1)
5148: pha
5149: lda lSPREG
5150: pha
5151: lda lSAREG
5152: ldx lSXREG
5153: ldy lSYREG
5154: plp
5155: jmp (zLINNUM)
5156: LE147: php
5157: sta lSAREG
5158: stx lSXREG
5159: sty lSYREG
5160: pla
5161: sta lSPREG
5162: rts
5163: bSAVET: jsr bSLPARA
5164: ldx zVARTAB
5165: ldy zVARTAB + 1
5166: lda #zTXTTAB
5167: jsr kSAVE
5168: bcs bBIOERR
5169: rts
5170: bVERFYT:lda #1
5171: .byte ASM_BIT3
5172:
5173: bLOADT: lda #0
5174: sta zVERCK
5175: jsr bSLPARA
5176: lda zVERCK
5177: ldx zTXTTAB
5178: ldy zTXTTAB + 1
5179: jsr kLOAD
5180: bcs LE1D1
5181: lda zVERCK
5182: beq ChkStatus
5183: JDLE17E:
5184: ldx #ErrVerify
5185: jsr kREADST
5186: and #$10
5187:
5188: .if CompileComputer >= C64_GENERAL
5189: bne LE19E
5190: .else
5191:
5192: beq @E187
5193: jmp bERROR
5194: .endif
5195:
5196: @E187: lda zTXTPTR
5197:
5198: cmp #>lBUF
5199: beq LE194
5200: lda #<bOKK
5201: ldy #>bOKK
5202:
5203: jmp bSTROUT
5204: LE194: rts
5205:
5206: ChkStatus:
5207: jsr kREADST
5208: and #$BF
5209: beq LE1A1
5210: ldx #ErrLoad
5211: LE19E: jmp bERROR
5212: LE1A1: lda zTXTPTR + 1
5213: cmp #>lBUF
5214: bne LE1B5
5215: JDLE1A7:
5216: stx zVARTAB
5217: sty zVARTAB + 1
5218: lda #<StrReady
5219: ldy #>StrReady
5220: jsr bSTROUT
5221: jmp LA52A
5222: LE1B5: jsr bSTXPT
5223:
5224: .if CompileComputer >= C64_GENERAL
5225: jsr bLINKPRG
5226: jmp LA677
5227: .elseif CompileComputer >= VIC20_06
5228: JMP LE476
5229: .else
5230: JMP LA677
5231: .endif
5232:
5233: ; FillUntil BASIC_START_2 + $01BE
5234: .segment "BASICOPEN"
5235:
5236: bOPENT: jsr bOCPARA
5237: jsr kOPEN
5238: bcs LE1D1
5239: rts
5240: bCLOSET:jsr bOCPARA
5241: lda zFORPNT
5242: jsr kCLOSE
5243: bcc LE194
5244: LE1D1: jmp bBIOERR
5245: bSLPARA:lda #0
5246: jsr kSETNAM
5247: ldx #1
5248: ldy #0
5249: .ifdef JIFFY
5250: jsr JDLF73A
5251: .else
5252: jsr kSETLFS
5253: .endif
5254: jsr bDEFLT
5255: jsr LE257
5256: jsr bDEFLT
5257: jsr bCOMBYT
5258: ldy #0
5259: stx zFORPNT
5260: jsr kSETLFS
5261: jsr bDEFLT
5262: jsr bCOMBYT
5263: txa
5264: tay
5265: ldx zFORPNT
5266: jmp kSETLFS
5267: bCOMBYT:jsr bCMMERR
5268: jmp LB79E
5269: bDEFLT: jsr zCHRGOT
5270: bne LE20D
5271: pla
5272: pla
5273: LE20D: rts
5274: bCMMERR:jsr bCHKCMA
5275: LE211: jsr zCHRGOT
5276: bne LE20D
5277: jmp bSYNERR
5278: bOCPARA:lda #0
5279: jsr kSETNAM
5280: jsr LE211
5281: jsr LB79E
5282: stx zFORPNT
5283: txa
5284: ldx #1
5285: JDLE229:
5286: ldy #0
5287: jsr kSETLFS
5288: jsr bDEFLT
5289: jsr bCOMBYT
5290: stx zFORPNT + 1
5291: ldy #0
5292: lda zFORPNT
5293: cpx #3
5294: bcc LE23F
5295: dey
5296: LE23F: jsr kSETLFS
5297: jsr bDEFLT
5298: jsr bCOMBYT
5299: txa
5300: tay
5301: ldx zFORPNT + 1
5302: lda zFORPNT
5303: jsr kSETLFS
5304: jsr bDEFLT
5305: jsr bCMMERR
5306: LE257: jsr bFRMEVL
5307: JDLE25A:
5308: jsr bFRESTR
5309: ldx zINDEX
5310: ldy zINDEX + 1
5311: jmp kSETNAM
5312: bCOS: lda #<bPI2
5313: ldy #>bPI2
5314: jsr bFADD
5315: bSIN: jsr bMOVAF
5316: lda #<LE2E5
5317: ldy #>LE2E5
5318: ldx zARGSGN
5319: jsr bFDIV
5320: jsr bMOVAF
5321: jsr bINT
5322: lda #0
5323: sta zARISGN
5324: jsr FSUBT
5325: lda #<LE2EA
5326: ldy #>LE2EA
5327: jsr bFSUB
5328: lda zFACSGN
5329: pha
5330: bpl LE29D
5331: jsr bFADDH
5332: lda zFACSGN
5333: bmi LE2A0
5334: lda zTANSGN
5335: eor #$FF
5336: sta zTANSGN
5337: LE29D: jsr bNEGOP
5338: LE2A0: lda #<LE2EA
5339: ldy #>LE2EA
5340: jsr bFADD
5341: pla
5342: bpl LE2AD
5343: jsr bNEGOP
5344: LE2AD: lda #<LE2EF
5345: ldy #>LE2EF
5346: jmp bPOLYX
5347: bTAN: jsr LBBCA
5348: lda #$00
5349: sta zTANSGN
5350: jsr bSIN
5351: ldx #<zTEMPF3
5352: ldy #>zTEMPF3
5353: jsr LE0F6
5354: lda #<zTEMPF1
5355: ldy #>zTEMPF1
5356: jsr bMOVFM
5357: lda #$00
5358: sta zFACSGN
5359: lda zTANSGN
5360: jsr LE2DC
5361: lda #<zTEMPF3
5362: ldy #>zTEMPF3
5363: jmp bFDIVT
5364: LE2DC: pha
5365: jmp LE29D
5366:
5367: bPI2: .byte $81,$49,$0F,$DA,$A2
5368: LE2E5: .byte $83,$49,$0F,$DA,$A2
5369: LE2EA: .byte $7F,$00,$00,$00,$00
5370: LE2EF: .byte $05
5371: .byte $84,$E6,$1A,$2D,$1B
5372: .byte $86,$28,$07,$FB,$F8
5373: .byte $87,$99,$68,$89,$01
5374: .byte $87,$23,$35,$DF,$E1
5375: .byte $86,$A5,$5D,$E7,$28
5376: .byte $83,$49,$0F,$DA,$A2
5377:
5378: bATN: lda zFACSGN
5379: pha
5380: bpl LE316
5381: jsr bNEGOP
5382: LE316: lda zFACEXP
5383: pha
5384: cmp #$81
5385: bcc LE324
5386: lda #<bFPTABL
5387: ldy #>bFPTABL
5388: jsr bFDIVT
5389: LE324: lda #<bATNCON
5390: ldy #>bATNCON
5391: jsr bPOLYX
5392: pla
5393: cmp #$81
5394: bcc LE337
5395: lda #<bPI2
5396: ldy #>bPI2
5397: jsr bFSUB
5398: LE337: pla
5399: bpl LE33D
5400: jmp bNEGOP
5401: LE33D: rts
5402:
5403: bATNCON:.byte $0B
5404: .byte $76,$B3,$83,$BD,$D3
5405: .byte $79,$1E,$F4,$A6,$F5
5406: .byte $7B,$83,$FC,$B0,$10
5407: .byte $7C,$0C,$1F,$67,$CA
5408: .byte $7C,$DE,$53,$CB,$C1
5409: .byte $7D,$14,$64,$70,$4C
5410: .byte $7D,$B7,$EA,$51,$7A
5411: .byte $7D,$63,$30,$88,$7E
5412: .byte $7E,$92,$44,$99,$3A
5413: .byte $7E,$4C,$CC,$91,$C7
5414: .byte $7F,$AA,$AA,$AA,$13
5415: .byte $81,$00,$00,$00,$00
5416:
5417: .if CompileComputer >= C64_GENERAL
5418: LE37B: jsr kCLRCHN
5419: lda #0
5420: sta z13
5421: jsr LA67A
5422: cli
5423:
5424: ; Patch: Output READY, but respect the (lIERROR) vector
5425: ReadyVector:
5426: ldx #$80 ; errorcode = bit 7 set, that is, no error occurred
5427: jmp (lIERROR) ; by default, this is a no-op
5428:
5429: PatchErrorOut:
5430: txa ; check the error code
5431: bmi @LE391 ; bit 7 set? Then no error occurred, jump to "ready"
5432: jmp ErrorOut ; output the error
5433: @LE391:
5434: jmp bREADY
5435: .endif
5436:
5437: LE394:
5438: .ifdef JIFFY
5439: jsr JDLE4B7
5440: .else
5441: jsr LE453
5442: .endif
5443: jsr LE3BF
5444: jsr LE422
5445: ldx #-5 ; stack pointer to $01FB
5446: txs
5447:
5448: .if CompileComputer >= C64_GENERAL
5449: bne ReadyVector
5450: .else
5451: jmp bREADY
5452: .endif
5453:
5454: .segment "CHRGET"
5455:
5456: COPY_OF_CHRGET:
5457: inc zTXTPTR
5458: bne COPY_OF_CHRGOT
5459: inc zTXTPTR + 1
5460:
5461: COPY_OF_CHRGOT:
5462: lda $EA60 ; this is just a dummy address
5463: cmp #'9' + 1
5464: bcs COPY_OF_CHRGOT_RTS
5465:
5466: COPY_OF_CHRGOT_SPACE:
5467: cmp #' '
5468: beq COPY_OF_CHRGET
5469: sec
5470: sbc #'0'
5471: sec
5472: sbc #-'0'
5473: COPY_OF_CHRGOT_RTS:
5474: rts
5475:
5476: .byte $80,$4F,$C7,$52,$58
5477:
5478: END_COPY_OF_CHRGET:
5479:
5480: .segment "INIT"
5481:
5482: LE3BF: lda #ASM_JMP
5483: sta zJMPER
5484: sta lUSRPOK
5485: lda #<bIQERR
5486: ldy #>bIQERR
5487: sta lUSRADD
5488: sty lUSRADD + 1
5489: lda #<bGIVAYF
5490: ldy #>bGIVAYF
5491: sta zADRAY2
5492: sty zADRAY2 + 1
5493: lda #<bFACINX
5494: ldy #>bFACINX
5495: sta zADRAY1
5496: sty zADRAY1 + 1
5497: ldx #END_COPY_OF_CHRGET - COPY_OF_CHRGET - 1
5498: LE3E2: lda COPY_OF_CHRGET,x
5499: sta zCHRGET,x
5500: dex
5501: bpl LE3E2
5502: lda #$03
5503: sta zFOUR6
5504: lda #0
5505: sta zBITS
5506: sta z13
5507: sta zLASTPT + 1
5508: ldx #1
5509: stx lBUF - 3
5510: stx lBUF - 4
5511: ldx #zTEMPST
5512: stx zTEMPPT
5513: sec
5514: jsr kMEMBOT
5515: stx zTXTTAB
5516: sty zTXTTAB + 1
5517: sec
5518: jsr kMEMTOP
5519: stx zMEMSIZ
5520: sty zMEMSIZ + 1
5521: stx zFRETOP
5522: sty zFRETOP + 1
5523: ldy #0
5524: tya
5525: sta (zTXTTAB),y
5526: inc zTXTTAB
5527: bne LE421
5528: inc zTXTTAB + 1
5529: LE421: rts
5530: LE422: lda zTXTTAB
5531: ldy zTXTTAB + 1
5532: jsr bREASON
5533: lda #<LE473
5534: ldy #>LE473
5535: .if CompileComputer = C64_4064
5536: jmp LE441
5537: .else
5538: jsr bSTROUT
5539: .endif
5540: lda zMEMSIZ
5541: sec
5542: sbc zTXTTAB
5543: tax
5544: lda zMEMSIZ + 1
5545: sbc zTXTTAB + 1
5546: jsr LBDCD
5547: lda #<LE460
5548: ldy #>LE460
5549: LE441: jsr bSTROUT
5550: jmp LA644
5551:
5552: .if CompileComputer < C64_GENERAL
5553: ; .include "../vic20/basic-texts.inc"
5554: LE460:
5555: .byte " BYTES FREE",$0D,$00
5556:
5557: LE473: .byte $93
5558: .byte "**** CBM BASIC V2 ****"
5559: .byte $0D,$00
5560: .endif
5561:
5562: LE447:
5563: .if CompileComputer >= C64_GENERAL
5564: .ifdef JIFFY
5565: .addr JDLF763
5566: .else
5567: .addr PatchErrorOut ; for the C64, check if bit 7 of the error code is set.
5568: .endif
5569: .else
5570: .addr ErrorOut ; for the VIC20, this is always an error.
5571: .endif
5572:
5573: .if CompileComputer = C64_GS
5574: .addr C64GS_Init
5575: .else
5576: .addr IMAIN
5577: .endif
5578:
5579: .ifdef JIFFY
5580: .addr LEA64
5581: .else
5582: .addr LA57C
5583: .endif
5584: .addr LA71A
5585: .addr LA7E4
5586: .addr LAE86
5587: END_LE447:
5588:
5589: LE453: ldx #END_LE447 - LE447 - 1
5590: LE455: lda LE447,x
5591: sta lIERROR,x
5592: dex
5593: bpl LE455
5594: rts
5595:
5596: .if CompileComputer >= C64_GENERAL
5597: .byte $00 ; basic checksum?
5598:
5599: ; .include "../c64/basic-texts.inc"
5600: LE460:
5601: .byte " BASIC BYTES FREE",$0D,$00
5602:
5603: LE473: .byte $93
5604:
5605: .ifdef JIFFY
5606: .byte $0D," JIFFYDOS V6.01 (C)1989 CMD "
5607: .byte $0D,$0D
5608: .byte " C-64 BASIC V2 ",$00
5609: .elseif CompileComputer = C64_SX64
5610: .byte $0D," ***** SX-64 BASIC V2.0 *****"
5611: .byte $0D,$0D
5612: .byte " 64K RAM SYSTEM ",$00
5613: .elseif CompileComputer = C64_4064
5614: .byte $0D," **** COMMODORE 4064 BASIC V2.0 ****"
5615: .byte $0D,$0D,$00
5616: .byte " "
5617: .elseif CompileComputer >= C64_GENERAL
5618: .byte $0D," **** COMMODORE 64 BASIC V2 ****"
5619: .byte $0D,$0D
5620: .byte " 64K RAM SYSTEM ",$00
5621: .endif
5622: .endif
5623:
5624: .if CompileComputer < C64_GENERAL
5625:
5626: LE37B:
5627: jsr kCLRCHN
5628: lda #0
5629: sta z13
5630: jsr LA67A
5631: cli
5632: jmp bREADY
5633:
5634: .byte CHECKSUM_E475
5635:
5636: .if CompileComputer >= VIC20_06
5637: LE476:
5638: jsr bLINKPRG
5639: jmp LA677
5640: .endif
5641: .endif
5642:
5643: ; .include "../kernal/kernal-memory.inc"
5644: .segment "MEM_KERNAL_ZP": zeropage
5645:
5646: zSTATUS: .res 1 ; $0090 ; status of TAPE/IEC routines
5647:
5648: zSTKEY: .res 1 ; $0091
5649: zSVXT: .res 1 ; $0092
5650: zVERCKK: .res 1 ; $0093 ; verify flag: Remember in KLOAD if LOAD (=0) or VERIFY (=1) is requested.
5651: zC3PO: .res 1 ; $0094 ; delayed byte for IEC output
5652: ; As an EOI must be signaled BEFORE the last byte is transferred,
5653: ; the KERNAL routines use a delayed write approach:
5654: ;
5655: ; It starts with zC3PO = 0.
5656: ; When the first byte to be output is given to the IEC routines,
5657: ; it is written to zBSOUR, and zC3PO.7 is set.
5658: ; When the next byte is written, zC3PO is tested. As it is negative,
5659: ; the byte in zBSOUR is being output to the IEC bus. Afterwards,
5660: ; the new byte is written into zBSOUR.
5661: ; When the last byte is transferred, the next command transmitted
5662: ; (i.e. LISTEN, TALK, UNLISTEN, UNTALK) tests for zC3PO. As it is
5663: ; negative, the last byte (in zBSOUR) is output to the IEC bus, and
5664: ; an EOI is signalled.
5665: ;
5666: zBSOUR: .res 1 ; $0095 ; The byte to write on the IEC bus. (see also zC3PO)
5667: zSYNO: .res 1 ; $0096
5668: zTEMPX: .res 1 ; $0097
5669: zLDTND: .res 1 ; $0098 ; number of active entries in the lLAT, lFAT and lSAT table
5670: zDFLTN: .res 1 ; $0099
5671: zDFLTO: .res 1 ; $009A
5672: zPRTY: .res 1 ; $009B
5673: zDPSW: .res 1 ; $009C
5674: zNSGFLG: .res 1 ; $009D ; message output policy:
5675: ; bit 7: Output "Loading", "Saving", "Verifying", "Found", ... messages
5676: ; bit 6: Output "I/O ERROR #n" if KERNAL routines encounter an error
5677: ; This value is only set by kSETMSG.
5678:
5679: zPTR1: .res 1 ; $009E
5680: zPTR2: .res 1 ; $009F
5681: zTIME: .res 3 ; $00A0
5682: zTSFCNT: .res 1 ; $00A3 ; mark: signal EOI (== $80) or not (== $00) on IEC bus.
5683: zTBTCNT: .res 1 ; $00A4
5684: zCNTDN: .res 1 ; $00A5
5685: 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.
5686: zINBIT: .res 1 ; $00A7
5687: zBITC1: .res 1 ; $00A8
5688: zRINONE: .res 1 ; $00A9
5689: zRIDATA: .res 1 ; $00AA
5690: zRIPRTY: .res 1 ; $00AB
5691: zSAL: .res 2 ; $00AC
5692: zEAL: .res 2 ; $00AE
5693: zCMPO: .res 2 ; $00B0
5694: zTAPE1: .res 2 ; $00B2
5695: zBITTS: .res 1 ; $00B4
5696: zNXTBIT: .res 1 ; $00B5
5697: zRODATA: .res 1 ; $00B6
5698: zFNLEN: .res 1 ; $00B7 ; length of the name of the file to be opened. Address at zFNADR. Only used on OPEN and LOAD.
5699: zLA: .res 1 ; $00B8 ; logical device number of current open file (or in preparation to a call to OPEN)
5700: zSA: .res 1 ; $00B9 ; device (primary) address of current open file (or in preparation to a call to OPEN)
5701: zFA: .res 1 ; $00BA ; secondary address of current open file (or in preparation to a call to OPEN)
5702: zFNADR: .res 2 ; $00BB ; address of the name of the file to be opened. Length at zFNLEN. Only used on OPEN and LOAD.
5703: zROPRTY: .res 1 ; $00BD
5704: zFSBLK: .res 1 ; $00BE
5705: zMYCH: .res 1 ; $00BF
5706: 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.
5707: zSTAL: .res 2 ; $00C1
5708: zMEMUSS: .res 2 ; $00C3
5709: 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.
5710: zNDX: .res 1 ; $00C6 ; current numbers of characters in the keyboard buffer (lKEYD). The maximum is stored in lXMAX.
5711: zRVS: .res 1 ; $00C7
5712: zINDX: .res 1 ; $00C8
5713: zLXSP: .res 1 ; $00C9
5714: zTEMP_zPNTR: .res 1 ; $00CA ; temporary buffer for cursorpos (zPNTR) inside of BASIN
5715: zSFDX: .res 1 ; $00CB ; key code if the code that is currently found pressed
5716: zBLNSW: .res 1 ; $00CC ; blink switch: <> 0 -> disable cursor, == 0 -> enable cursor
5717: zBLNCT: .res 1 ; $00CD
5718: zGDBLN: .res 1 ; $00CE
5719: zBLNON: .res 1 ; $00CF ; current blink state: 0 = cursor currently invisible, 1 = cursor is just now visible on the screen
5720: 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)
5721: zPNT: .res 2 ; $00D1 ; pointer to start of current cursor row in video RAM (cf. zUSER)
5722: zPNTR: .res 1 ; $00D3 ; column of current cursor position (0 ... X-1)
5723: zQTSW: .res 1 ; $00D4 ; quotation mark switch: 1 = we are in quotation mode, 0 = we are not.
5724: zLNMX: .res 1 ; $00D5 ; maximum column number in the current (logical) line
5725: zTBLX: .res 1 ; $00D6 ; row of current cursor positon (0 ... Y-1)
5726: zSCHAR: .res 1 ; $00D7 ; temporary storage for a character in editor routines for input and output, and temporary storage in tape routines
5727: zINSRT: .res 1 ; $00D8 ; number of characters to output in INSERT mode. 0 = we are not in insert mode
5728: zLDTB1: .res 26 ; $00D9 ; high byte of start address of (logical) screen rows
5729: ; Bit 7 ($80) is 1 if this line is "stand-alone";
5730: ; it is 0 if this line is combined with the previous one
5731: ; the lower bits (and #>lVIDEORAM_SIZE) define the high byte bits of the start address of this row.
5732: ;
5733: ; For the last row, this table entry contains $FF as an end marker.
5734:
5735: zUSER: .res 2 ; $00F3 ; pointer to start of current cursor row in color RAM (cf. zPNT)
5736: zKEYTAB: .res 2 ; $00F5
5737: zRIBUF: .res 2 ; $00F7 ; pointer to the RS232 input buffer (ring buffer) (see also lRIDBE, lRIDBS)
5738: zROBUF: .res 2 ; $00F9 ; pointer to the RS232 output buffer (ring buffer) (see also lRODBE, lRODBS)
5739: zFREKXP: .res 4 ; $00FB
5740:
5741: .segment "MEM_KERNAL_DATA_0200"
5742:
5743: ; the following table contains the data (logical file number, primary address, secondary address) for open files.
5744: ; The entries correspond to each other: That is, lLAT + x, lFAT + x and lSAT + x contain the data for the file
5745: ; with the index (*not* logical file number!) x.
5746:
5747: lLAT_Size := 10
5748: 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.
5749: lFAT: .res lLAT_Size ; $0263 ; table of device (primary) addresses for open files. Number of active entries in zLDTND.
5750: lSAT: .res lLAT_Size ; $026D ; table of secondary addresses for open files. Number of active entries in zLDTND.
5751:
5752: lKEYD: .res 10 ; $0277
5753: lMEMSTR: .res 2 ; $0281
5754: lMEMSIZ: .res 2 ; $0283
5755: lTIMOUT: .res 1 ; $0285
5756: lCOLOR: .res 1 ; $0286 ; default color (bit 7 must be 0, or CHROUT_SCREEN will behave erroneouskly!)
5757: lGDCOL: .res 1 ; $0287
5758: lHIBASE: .res 1 ; $0288 ; high byte of video RAM address
5759: lXMAX: .res 1 ; $0289 ; maximum number of characters in the keyboard buffer (lKEYD). zNDX is checked against this value
5760: lRPTFLG: .res 1 ; $028A ; repeat flag for keys
5761: ; bit 7 ($80) == 1 -> repeat all keys
5762: ; bit 6 ($40) == 1 -> do not repeat any key
5763: ; else: Repeat special keys (space, CRSRS, INS/DEL), but not the others
5764:
5765: ; the test is done starting with bit 7, then bit 6.
5766: ; thus, if both are set, all keys are repeated
5767:
5768: lKOUNT: .res 1 ; $028B ; delay counter for key repetitions. This is decremented on every IRQ, starting from 4.
5769:
5770: lDELAY: .res 1 ; $028C ; delay counter for key repetitions. It is used for the initial delay before the key repetition starts.
5771:
5772: lSHFLAG: .res 1 ; $028D ; contains the state of the shift keys while scanning the keyboard.
5773: ; The state is an OR between the following values, if the correspondig key is pressed:
5774: ; bit 0 ($01) = shift
5775: ; bit 1 ($02) = C=
5776: ; bit 2 ($04) = CTRL
5777: lSHFLAG_SHIFT := $01
5778: lSHFLAG_CBM := $02
5779: lSHFLAG_CTRL := $04
5780:
5781: 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=
5782: lKEYLOG: .res 2 ; $028F
5783: lMODE: .res 1 ; $0291 ; determines editor mode.
5784: ; bit 7 ($80) == 1 -> Switching between uppercase-mode and lowercase-mode via SHIFT + C= is not allowed
5785: ; bit 4 ($10) == 1 -> TODO ??? (used in VIC20-02)
5786: ; bit 3 ($08) == 1 -> we are in lowercase mode, == 0 -> we are in uppercase mode (only VIC20-02)
5787: ; on VIC20-02, lMODE also contains the offset into the @KEYTABS_VEC table ($00-$16)
5788:
5789: ; on the VIC20-02, lMODE is used in CHROUT_SCREEN to determine if some chars are to
5790: ; be translated (according to CHROUT_REPLACEMENT_TABLE). If lMODE is not 0, the
5791: ; translation is done. If it is 0, the translation is skipped.
5792:
5793: lAUTODN: .res 1 ; $0292 ; TODO "Auto down" flag: (Flag: "combine line with next line, if needed")
5794:
5795: ; If the output is done because of some key press, lAUTODN is not 0. In this case,
5796: ; when the output reaches the end of a row, this row is combined with the next
5797: ; row. Furthermore, the screen contents below the current line are scrolled down.
5798:
5799: ; If the output is done without some key press, lAUTODN is 0. In this case,
5800: ; when the output reaches the end of a row, this row is combined with the next
5801: ; one, but the screen contents are NOT scrolled down.
5802:
5803: lM51CTR: .res 1 ; $0293
5804: lM51CDR: .res 1 ; $0294
5805: lM51AJB: .res 2 ; $0295
5806: lRSSTAT: .res 1 ; $0297
5807: lBITNUM: .res 1 ; $0298
5808: lBAUDOF: .res 2 ; $0299
5809: lRIDBE: .res 1 ; $029B ; RS232 input buffer at zRIBUF: read pointer
5810: lRIDBS: .res 1 ; $029C ; RS232 input buffer at zRIBUF: write pointer
5811: lRODBS: .res 1 ; $029D ; RS232 output buffer at zROBUF: read pointer
5812: lRODBE: .res 1 ; $029E ; RS232 output buffer at zROBUF: write pointer
5813: lIRQTMP: .res 2 ; $029F
5814:
5815: .if CompileComputer >= C64_GENERAL
5816:
5817: lENABL: .res 1 ; $02A1 ; CIA2 ICR temporary register
5818: lTODSNS: .res 1 ; $02A2
5819: lTRDTMP: .res 1 ; $02A3
5820: lTD1IRQ: .res 1 ; $02A4
5821: lTLNIDX: .res 1 ; $02A5
5822: lTVSFLG: .res 1 ; $02A6
5823:
5824: .else
5825:
5826: lTLNIDX := $00F2
5827:
5828: .endif
5829:
5830: .segment "MEM_KERNAL_DATA_0300"
5831:
5832: lCINV: .res 2 ; $0314
5833: lCNBINV: .res 2 ; $0316
5834: lNMINV: .res 2 ; $0318
5835: lIOPEN: .res 2 ; $031A
5836: lICLOSE: .res 2 ; $031C
5837: lICHKIN: .res 2 ; $031E
5838: lICKOUT: .res 2 ; $0320
5839: lICLRCH: .res 2 ; $0322
5840: lIBASIN: .res 2 ; $0324
5841: lIBSOUT: .res 2 ; $0326
5842: lISTOP: .res 2 ; $0328
5843: lIGETIN: .res 2 ; $032A
5844: lICLALL: .res 2 ; $032C
5845: lUSRCMD: .res 2 ; $032E
5846: lILOAD: .res 2 ; $0330
5847: lISAVE: .res 2 ; $0332
5848:
5849: .res 8 ; $0334 - $033B, unused
5850:
5851: lTBUFFR_SIZE := $00C0
5852: lTBUFFR: .res lTBUFFR_SIZE ; $033C ; tape buffer. The pointer into this buffer can be found at zBUFPNT.
5853:
5854: .if CompileComputer >= C64_GENERAL
5855: lVIDEORAM := $0400
5856: .if .defined(C64JAPAN)
5857: lBASICRAM := $1000
5858: .else
5859: lBASICRAM := $0800
5860: .endif
5861: .endif
5862:
5863: lVIDEORAM_SIZE := $03FF
5864:
5865: .if CompileComputer = VIC20_02
5866: zMEMUSS_2 := zC3PO
5867: .else
5868: zMEMUSS_2 := zMEMUSS
5869: .endif
5870:
5871: ; .include "../kernal/fileio_data.inc"
5872: .macro LOAD_OVERWRITE_START_ADDRESS
5873: txa
5874: bne :+
5875: lda zMEMUSS
5876: sta zEAL
5877: lda zMEMUSS + 1
5878: sta zEAL + 1
5879: :
5880:
5881: .endmacro
5882:
5883: .macro FILEIO_PATCH_CLOSE_TAPE
5884:
5885: jsr TapeWriteCompleteBuffer ; write out the tape buffer to tape
5886: bcc FileIoPatch_NoError ; C = 0 -> no error -> branch
5887:
5888: pla ; get back index into table of open files
5889: lda #$00
5890:
5891: .endmacro
5892:
5893: ; .include "../kernal/iec_data.inc"
5894: ; after calling IecGetDataClockIn, gets
5895: ; - DATA IN in Carry
5896: .macro IEC_GET_DATA_INTO_CARRY
5897: .if CompileComputer < C64_GENERAL
5898: lsr a
5899: .endif
5900: .endmacro
5901:
5902: .macro IEC_REG__DATA_IN_INTO_CARRY
5903: .if CompileComputer >= C64_GENERAL
5904: asl a
5905: .else
5906: lsr a
5907: lsr a
5908: .endif
5909: .endmacro
5910:
5911: .macro IEC_REG__CLOCK_IN_INTO_CARRY
5912: .if CompileComputer >= C64_GENERAL
5913: .error IEC_REG__CLOCK_IN_INTO_CARRY not defined for C64!
5914: .else
5915: lsr a
5916: .endif
5917: .endmacro
5918:
5919: .segment "INIT"
5920: .byte VERSION_E4AC
5921:
5922: .if CompileComputer >= C64_02
5923:
5924: LE4AD: pha
5925: jsr kCHKOUT
5926: tax
5927: pla
5928: bcc LE4B6
5929: txa
5930: LE4B6: rts
5931:
5932: .endif
5933:
5934: .if CompileComputer = C64_4064
5935: ; FillUntil KERNAL_START + $04C8
5936: .segment "KERNALPATCH_4064"
5937:
5938: LE4C8: bit lCOLOR
5939: bmi LE4D7
5940: lda #COL_BLACK
5941: ldx #(VICII_O_Spr7Col - VICII_O_BorderCol)
5942: LE4D1: sta VIC + VICII_O_BorderCol,x
5943: dex
5944: bpl LE4D1
5945: LE4D7: jmp iSCNKEY
5946:
5947: .elseif CompileComputer >= C64_03
5948:
5949: .ifdef JIFFY
5950: JDLE4B7:
5951: jsr LE453
5952: lda #<$F672
5953: sta zCMPO
5954: lda #>$F672
5955: sta zCMPO + 1
5956:
5957: JDLE4C2:
5958: inx
5959: stx zPRTY
5960: rts
5961:
5962: JDLE4C6:
5963: lda #$6F
5964: jsr $F0E4
5965: jsr kCHRIN
5966: cmp #$35
5967: rts
5968: .endif
5969:
5970: ; FillUntil KERNAL_START + $04D3,BASIC_FILLER
5971: .segment "KERNALPATCH_03"
5972:
5973: LE4D3: sta zRINONE
5974: lda #$01
5975: sta zRIPRTY
5976: rts
5977: .endif
5978:
5979: .if CompileComputer >= C64_02
5980:
5981: ; FillUntil KERNAL_START + $04DA
5982: .segment "KERNALPATCH_02"
5983:
5984: Patch_StoreColor:
5985: .if CompileComputer >= C64_03 .AND CompileComputer <> C64_4064
5986: ; TODO: Generic define
5987: lda lCOLOR
5988: .else
5989: lda VIC + VICII_O_BackgCol0
5990: .endif
5991: sta (zUSER),y
5992: rts
5993:
5994: ; Introduce a delay when the TAPE outputs a "FOUND <filename>" message
5995: ; We either wait for a timeout to happen,
5996: ; or for the user to press a key
5997: ;
5998: ; Input: A = zTIME + 1 (timer middle byte)
5999: ;
6000: ; Bugs:
6001: ; - In the case when the timer wraps around (after 24h), the middle byte
6002: ; can be $18 or $19, and the end of timeout is calculated as $1A or $1B.
6003: ; But: $1A or $1B is not reached before the wrap-around and the middle byte
6004: ; going to $1A or $1B again.
6005: ; This will result in a timeout of almost 2 minutes.
6006: ;
6007: TapeKeyOrTimeout:
6008: adc #2 ; add 2 to the middle byte, resulting in a timeout of
6009: ; not more than $0200 * 1/60th seconds
6010: ; ("not more" because we do not care about the lower byte)
6011: @Loop:
6012: ldy zSTKEY ; get the status of the keyboard column at the time the keyboard was checked the last time
6013:
6014: iny ; key pressed?
6015: bne @Ret ; yes -> branch, end this loop
6016:
6017: cmp zTIME + 1 ; compare the timer middle byte with the calculated end of the timeout
6018: bne @Loop ; timeout not yet reached -> spin more
6019: @Ret:
6020: rts
6021: ; ------------------------
6022:
6023: LE4EC:
6024: .word $2619
6025: .word $1944
6026: .word $111A
6027: .word $0DE8
6028: .word $0C70
6029: .word $0606
6030: .word $02D1
6031: .word $0137
6032: .word $00AE
6033: .word $0069
6034: .endif
6035:
6036: ; FillUntil KERNAL_START + $0500
6037: .segment "KERNAL"
6038:
6039: ; .include "../kernal/editor.a65"
6040: ; B-12. Function Name: IOBASE
6041: ;
6042: ; Purpose: Define I/O memory page
6043: ; Call address: $FFF3 (hex) 65523 (decimal)
6044: ; Communication registers: X, Y
6045: ; Preparatory routines: None
6046: ; Error returns:
6047: ; Stack requirements: 2
6048: ; Registers affected: X, Y
6049: ;
6050: ;
6051: ; Description: This routine sets the X and Y registers to the address of
6052: ; the memory section where the memory mapped 110 devices are located. This
6053: ; address can then be used with an offset to access the memory mapped I/O
6054: ; devices in the Commodore 64. The offset is the number of locations from
6055: ; the beginning of the page on which the I/O register you want is located.
6056: ; The X register contains the low order address byte, while the Y register
6057: ; contains the high order address byte.
6058: ; This routine exists to provide compatibility between the Commodore 64,
6059: ; VIC-20, and future models of the Commodore 64. If the J/0 locations for
6060: ; a machine language program are set by a call to this routine, they should
6061: ; still remain compatible with future versions of the Commodore 64, the
6062: ; KERNAL and BASIC.
6063: ;
6064: ;
6065: ; How to Use:
6066: ;
6067: ; 1) Call this routine by using the JSR instruction.
6068: ; 2) Store the X and the Y registers in consecutive locations.
6069: ; 3) Load the Y register with the offset.
6070: ; 4) Access that I/O location.
6071: ;
6072: ; EXAMPLE:
6073: ;
6074: ; ;SET THE DATA DIRECTION REGISTER OF THE USER PORT TO 0 (INPUT)
6075: ; JSR IOBASE
6076: ; STX POINT ;SET BASE REGISTERS
6077: ; STY POINT+1
6078: ; LDY #2
6079: ; LDA #0 ;OFFSET FOR DDR OF THE USER PORT
6080: ; STA (POINT),Y ;SET DDR TO 0
6081: ;
6082: ;
6083: iIOBASE:
6084: ; return IO base address in x/y
6085: ; On the VIC-20 and C64, this is interpreted as
6086: ; the base address of the first VIA/CIA.
6087:
6088: ldx #<IOBASE
6089: ldy #>IOBASE
6090: rts
6091:
6092: ; B-26. Function Name: SCREEN
6093: ;
6094: ; Purpose: Return screen format
6095: ; Call address: $FFED (hex) 65517 (decimal)
6096: ; Communication registers: X, Y
6097: ; Preparatory routines: None
6098: ; Stack requirements: 2
6099: ; Registers affected: X, Y
6100: ;
6101: ; Description: This routine returns the format of the screen, e.g., 40
6102: ; columns in X and 25 lines in Y. The routine can be used to determine what
6103: ; machine a program is running on. This function has been implemented on
6104: ; the Commodore 64 to help upward compatibility of your programs.
6105: ;
6106: ;
6107: ;
6108: ;
6109: ; How to Use:
6110: ;
6111: ; 1) Call this routine.
6112: ;
6113: ; EXAMPLE:
6114: ;
6115: ; JSR SCREEN
6116: ; STX MAXCOL
6117: ; STY MAXROW
6118: ;
6119: ;
6120: iSCREEN:
6121: ; return screen resolution in x / y
6122:
6123: ldx #EDITOR_COLS
6124: ldy #EDITOR_ROWS
6125: rts
6126:
6127: ; B-19. Function Name: PLOT
6128: ;
6129: ; Purpose: Set cursor location
6130: ; Call address: $FFF0 (hex) 65520 (decimal)
6131: ; Communication registers: A, X, Y
6132: ; Preparatory routines: None
6133: ; Error returns: None
6134: ; Stack requirements: 2
6135: ; Registers affected: A, X, Y
6136: ;
6137: ; Description: A call to this routine with the accumulator carry flag
6138: ; set loads the current position of the cursor on the screen (in X,Y
6139: ; coordinates) into the Y and X registers. Y is the column number of the
6140: ; cursor location (0-39), and X is the row number of the location of the
6141: ; cursor (0-24). A call with the carry bit clear moves the cursor to X,Y
6142: ; as determined by the Y and X registers.
6143: ;
6144: ; How to Use:
6145: ;
6146: ;
6147: ; READING CURSOR LOCATION
6148: ;
6149: ; 1) Set the carry flag.
6150: ; 2) Call this routine.
6151: ; 3) Get the X and Y position from the Y and X registers, respectively.
6152: ;
6153: ;
6154: ; SETTING CURSOR LOCATION
6155: ;
6156: ; 1) Clear carry flag.
6157: ; 2) Set the Y and X registers to the desired cursor location.
6158: ; 3) Call this routine.
6159: ;
6160: ;
6161: ; EXAMPLE:
6162: ;
6163: ; ;MOVE THE CURSOR TO ROW 10, COLUMN 5 (5,10)
6164: ; LDX #10
6165: ; LDY #5
6166: ; CLC
6167: ; JSR PLOT
6168: ;
6169: ;
6170: iPLOT:
6171: bcs iPLOTReadOnly ; carry set -> read values
6172:
6173: JDLE50C:
6174: stx zTBLX ; save new cursor pos: y position from X
6175: sty zPNTR ; save new cursor pos: x position from Y
6176:
6177: jsr SET_CURSORPOS ; update all other internal states to the new position
6178:
6179: iPLOTReadOnly:
6180: ldx zTBLX ; get cursor position in x and y
6181: ldy zPNTR
6182:
6183: rts
6184:
6185: ; B-7. Function Name: CINT
6186: ;
6187: ; Purpose: Initialize screen editor & 6567 video chip
6188: ; Call address: $FF81 (hex) 65409 (decimal)
6189: ; Communication registers: None
6190: ; Preparatory routines: None
6191: ; Error returns: None
6192: ; Stack requirements: 4
6193: ; Registers affected: A, X, Y
6194: ;
6195: ;
6196: ; Description: This routine sets up the 6567 video controller chip in the
6197: ; Commodore 64 for normal operation. The KERNAL screen editor is also
6198: ; initialized. This routine should be called by a Commodore 64 program
6199: ; cartridge.
6200: ;
6201: ; How to Use:
6202: ;
6203: ; 1) Call this routine.
6204: ;
6205: ; EXAMPLE:
6206: ;
6207: ; JSR CINT
6208: ; JMP RUN ;BEGIN EXECUTION
6209: ;
6210: ;
6211: iCINT: jsr CLRCHN_AND_VIC_DEFAULTS
6212:
6213: .if CompileComputer < C64_GENERAL
6214:
6215: ; adjust the VIC-I to take the screen memory from the memory
6216: ; area that is configured in lHIBASE.
6217:
6218: ; on the VIC-I,
6219: ; bits 13-10 of the video RAM address is stored in VICI_O_MemoryLocations.7-VICI_O_MemoryLocations.4,
6220: ; and bit 9 of the video RAM address is stored in VIC_02.7.
6221:
6222: ; Now, bit 13 of the VIC-I is connected to the INVERSE of A15 of the 6502.
6223: ; Thus, the VIC-I sees another memory map than the 6502:
6224: ;
6225: ; VIC-I <-> 6502
6226: ; $0000-$1FFF <-> $8000-$9FFF
6227: ; $2000-$3FFF <-> $0000-$1FFF (*)
6228: ;
6229: ; (*) Note that the VIC-I cannot see $0400-$0FFF of the 6502 memory map
6230: ; ($2400-$2FFF in the VIC-I memory map) due to the way the memory
6231: ; is connected on the external RAM cartridge
6232:
6233:
6234: lda lHIBASE ; get high byte of video RAM address
6235: and #~$02 ; mask out bit 9 (bit 8-0 of the base address
6236: ; must be 0, anyway)
6237:
6238: asl a ; shift the address to the right position
6239: asl a
6240:
6241: ; here, A.7 - A.4 contain the address of the video RAM start, as needed in VICI_O_MemoryLocations
6242:
6243: ora #$80 ; b13 of the VIC-I is connected to the INVERSE of A15
6244: ; of the 6502 (cf. comment above).
6245: ; Take this into account and make the VIC-I see
6246: ; the 6502 memory area $0000-$1FFF.
6247:
6248: sta VIC + VICI_O_MemoryLocations ; store b
6249:
6250: lda lHIBASE ; get back the high byte of the video RAM address
6251: and #$02 ; is bit 9 set?
6252: beq @NoSetBit9 ; no, branch -> do not set VICI_O_VideoColumns.7
6253: ; (it has been already reset in CLRCHN_AND_VIC_DEFAULTS)
6254:
6255: lda #VICI_B_VideoColumns_ScreenMemoryB9 ; set bit 9 of video RAM address
6256: ora VIC + VICI_O_VideoColumns ; in VICI_O_02.7
6257: sta VIC + VICI_O_VideoColumns
6258:
6259: @NoSetBit9:
6260:
6261: .endif
6262:
6263: lda #$00 ; set editor mode
6264: sta lMODE
6265:
6266: sta zBLNON ; blink mode: Currently, the cursor is not on
6267:
6268: lda #<CHECK_SHIFT_CTRL_CBM
6269: sta lKEYLOG
6270: lda #>CHECK_SHIFT_CTRL_CBM
6271: sta lKEYLOG + 1
6272:
6273: lda #10
6274: sta lXMAX ; maximum number of characters in the keyboard buffer is 10
6275: sta lDELAY ; set delay for delay of the start of key repetition to default (10)
6276:
6277: lda #DEFAULT_COLOR ; set default color
6278: sta lCOLOR
6279:
6280: lda #$04 ; set delay counter for key repetitions
6281: sta lKOUNT
6282:
6283: lda #$0C
6284: sta zBLNCT ; set the blink counter
6285: sta zBLNSW ; disable cursor
6286:
6287: ; update the table of low bytes and link bits for the screen row
6288:
6289: ClearScreen:
6290: lda lHIBASE ; get the high byte of the start of the video RAM
6291: ora #$80 ; set link bit -> this row is not connected to the previous one
6292: tay
6293: lda #$00 ; low byte of the start of the video RAM (A) := 0
6294: tax ; row counter (X) := 0, start in row zero
6295:
6296: @Next: sty zLDTB1,x ; store the high byte and the link bit of this line
6297:
6298: ; proceed to next row by adding the number of columns in one row (EDITOR_COLS)
6299:
6300: clc
6301: adc #EDITOR_COLS ; add the number of columns in a line to the low byte
6302: bcc @NoHighByte ; no carry -> we do not need to increment the high byte
6303: iny ; increment the high byte
6304:
6305: @NoHighByte:
6306: inx ; increment row counter
6307: cpx #EDITOR_ROWS + 1 ; did we reach the last row?
6308: bne @Next ; not yet, store the next high byte and link bit
6309:
6310: lda #$FF ; write the "end marker"
6311: sta zLDTB1,x ; into the location for the row past the last one
6312:
6313: ; Erase the screen rows (overwrite with spaces)
6314:
6315: ldx #EDITOR_ROWS - 1 ; start in the last row
6316: @NextLine:
6317: jsr EraseScreenRow ; erase the row
6318: dex ; go to previous line
6319: bpl @NextLine ; not all rows are processed, branch -> process previous one
6320:
6321: CURSOR_HOME:
6322: ; set cursor position to 0/0
6323:
6324: ldy #0
6325: sty zPNTR ; column
6326: sty zTBLX ; row
6327:
6328: SET_CURSORPOS:
6329:
6330: ; this routine updates the internal pointer to conform to the cursor
6331: ; position set in zPNTR/zTBLX. As this function is used from other
6332: ; places, for example from iPLOT, it is completely implemented, and it
6333: ; does not use any hard-coded constants for CURSOR_HOME only.
6334:
6335: ldx zTBLX ; get row into X
6336: lda zPNTR ; get column into A
6337:
6338: @AddLine:
6339: ldy zLDTB1,x ; is this row combined with the previous one?
6340: bmi @StandaloneLine ; no, branch
6341:
6342: ; otherwise, add the number of columns to the col position
6343: clc
6344: adc #EDITOR_COLS
6345: sta zPNTR ; store (updated) column position
6346: dex ; ... and the row is one less
6347: bpl @AddLine ; unconditional jump (row 0 should never be combined with the previous row!)
6348: ; --------------
6349:
6350: @StandaloneLine:
6351:
6352: .if CompileComputer >= C64_03 .or .defined(C64JAPAN)
6353: 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.
6354: ; This subroutine is used to gain memory for the later patch
6355: .else
6356: lda zLDTB1,x ; get high byte of the starting address of this row
6357: and #>lVIDEORAM_SIZE ; mask out additional bits used as flags
6358: ora lHIBASE ; add the video RAM base
6359: sta zPNT + 1 ; remember high byte
6360:
6361: lda SCREEN_LOWBYTE,x ; get low byte of the starting address of this row
6362: sta zPNT ; remember low byte
6363:
6364: .endif
6365:
6366: ; calculate the number of columns (more precisely: The last column number)
6367: ; in this logical line
6368:
6369: lda #EDITOR_COLS - 1 ; start with one physical line
6370:
6371: inx ; Here, X points to the first line *before* the extended long line. Thus, go back into the long line area
6372:
6373: @Loop: ldy zLDTB1,x ; is this line combined with the previous one?
6374: bmi @StoreLineLength ; no, branch -> quit loop
6375:
6376: clc ; add a complete line length
6377: adc #EDITOR_COLS
6378:
6379: inx ; proceed to the next line
6380: bpl @Loop ; (unconditional branch)
6381: ; -----------------------------
6382:
6383: @StoreLineLength:
6384: sta zLNMX ; store line length
6385:
6386: .if CompileComputer >= C64_03 .or .defined(C64JAPAN)
6387: ; this fixes a bug in the C64 ROMs:
6388: ; If the last row is combined to build a long line (80 chars),
6389: ; and the last character is deleted afterwards with backspace,
6390: ; the C64 will start a LOAD command and will not react
6391: ; anymore unless there is an attached tape recorder.
6392:
6393: ; This patch fixes this:
6394:
6395: jmp UpdateColorRAMPointerToVideoramPointer ; also update the color RAM pointer (zUSER)
6396:
6397: ; this is another patch on the C64-03 ROMs:
6398: ; TODO: why?
6399: ;
6400: ; It is called after LDX zTBLX (get current cursor row)
6401:
6402: Patch_CursorOneRowUp:
6403: cpx zLXSP ; did the cursor row change while we were in the routine?
6404: beq @Ret ; no -> branch, we're done
6405: jmp CursorOneRowUp
6406: @Ret: rts
6407:
6408: nop
6409:
6410: .else
6411: rts
6412: .endif
6413:
6414:
6415: ; unused in VIC20 and C64 ROM!
6416:
6417: jsr CLRCHN_AND_VIC_DEFAULTS
6418: jmp CURSOR_HOME
6419:
6420:
6421: CLRCHN_AND_VIC_DEFAULTS:
6422: ; This routine restores input and output to the terminal
6423: ; (screen and keyboard).
6424: ; Afterwards, it initialises the VIC (or VIC-II) registers
6425:
6426: lda #FILE_SCREEN ; default output to screen
6427: sta zDFLTO
6428: lda #FILE_KEYBOARD ; default input to keyboard
6429: sta zDFLTN
6430:
6431: SET_VIC_DEFAULTS:
6432:
6433: ; This routine initialises the VIC (or VIC-II) registers
6434:
6435: ; Loop throught the table and overwrite the VIC (-II) registers
6436: ; with the table contents
6437:
6438: ldx #END_VIC_DEFAULTS - VIC_DEFAULTS + 1 ; number of register values in the table
6439: @Loop: lda VIC_DEFAULTS - 1,x
6440: sta VIC - 1,x
6441: dex
6442: bne @Loop
6443: rts
6444:
6445: GETIN_KEYB:
6446:
6447: ; Get a character from the keyboard buffer
6448: ; this function returns a character from the keyboard buffer
6449: ; It also deletes it from there.
6450: ;
6451: ; Prerequisites:
6452: ;
6453: ; - Before calling this function, the I flag must be set (SEI)
6454: ; It will be cleared on exit
6455: ;
6456: ; - Make sure the keyboard buffer is not empty before calling this function!
6457:
6458: ldy lKEYD ; remember first key press in the keyboard buffer
6459:
6460: ; move all key presses in the keyboard buffer one step to the front
6461:
6462: ldx #0
6463: @Loop: lda lKEYD + 1,x ; move entry one step ahead
6464: sta lKEYD,x
6465: inx ; proceed to next one
6466: cpx zNDX ; did we already process all keys?
6467: bne @Loop ; no, branch -> process the next key
6468:
6469: dec zNDX ; we just removed and key, thus, decrement the number of keys in the buffer
6470:
6471: tya ; get back the first key press in the keyboard buffer
6472:
6473: cli
6474: clc ; quit with success
6475: rts
6476:
6477: OutputCharacterAndWaitForKeyPress:
6478: jsr CHROUT_SCREEN
6479:
6480: WaitForKeyPress:
6481: lda zNDX ; number of key presses in keyboard buffer
6482: sta zBLNSW ; if > 0: disable cursor blinking, otherwise: Enable cursor blinking
6483: sta lAUTODN ; If there was some key press, mark that any output that will combine two rows will scroll down the screen contents
6484: ; (this loop cannot be quit with lAUTODN = 0)
6485: beq WaitForKeyPress ; no key presses -> wait until some key has been pressed
6486:
6487: ; now that one or more key has been pressed, output it/them
6488:
6489: ; first, restore the character under the cursor (if the cursor has been visible)
6490:
6491: sei
6492: lda zBLNON ; cursor currently visible?
6493: beq @CursorNotVisible ; no, skip restoring it
6494:
6495: ; restore character under the cursor
6496:
6497: lda zGDBLN ; get character code
6498: ldx lGDCOL ; and color of character under cursor
6499:
6500: ldy #0
6501: sty zBLNON ; mark: Cursor is currently invisible
6502:
6503: jsr StoreCharacterOnScreenAndDisableBlinking ; store the character under the cursor on the screen
6504:
6505: @CursorNotVisible:
6506:
6507: .ifdef JIFFY
6508: jsr JDLF9E5
6509: .else
6510: jsr GETIN_KEYB ; get the next character
6511: .endif
6512: cmp #KEY_SHIFTRUN ; was is Shift + Run/Stop?
6513: bne NoShiftRunStop ; no, branch -> jump special processing
6514:
6515: ; If we reach here, the user pressed Shift + Run/Stop
6516: ; Then, store the special text into the keyboard buffer and
6517: ; process the characters, one after the other.
6518: ;
6519: ; Note that any other key presses that might have been
6520: ; in the keyboard buffer are removed.
6521:
6522: ldx #END_TEXT_SHIFTRUNSTOP - TEXT_SHIFTRUNSTOP
6523: sei
6524: stx zNDX ; set the count of characters
6525:
6526: @ShiftRunStop:
6527: lda TEXT_SHIFTRUNSTOP - 1,x ; copy text
6528: sta lKEYD - 1,x ; into the keyboard buffer
6529: dex
6530: bne @ShiftRunStop ; until all characters have been processed
6531: beq WaitForKeyPress ; now, process the key presses (uncond. branch)
6532: ; -------------------------------
6533:
6534: NoShiftRunStop:
6535: cmp #ASC_CR ; was the key a CR?
6536: bne OutputCharacterAndWaitForKeyPress ; no, output the character and wait for the next key press
6537:
6538: ; When we reach here, the user has entered anything and pressed CR.
6539: ; Now, we process the input
6540:
6541: ldy zLNMX ; get the (logical) line length of the current line
6542: sty zCRSW ; store it as number of characters to read
6543:
6544: @CheckSpaceNext:
6545: lda (zPNT),y ; read the next character at the end of the line
6546: cmp #' ' ; is it a space?
6547: bne @NoSpace ; No -> branch,
6548: dey ; Yes, it was a space: Test the previous character
6549: bne @CheckSpaceNext ; until we have checked all characters in this line, branch
6550:
6551: @NoSpace:
6552: iny
6553: sty zINDX ; remember the number of characters in the current line
6554: ldy #0
6555: sty lAUTODN ; Mark: No key press yet, thus, any output will scroll down the screen contents if some rows will be combined
6556: sty zPNTR ; start reading at the beginning of the line
6557: sty zQTSW ; We are not in quotation mark mode
6558: lda zLXSP ; value of zTBLX before calling BASIN (zTBLX is not changed when calling GETIN
6559: bmi BASIN_KEYB_PROCESS_KEY ; TODO what?
6560:
6561: ldx zTBLX ; current cursor row on screen
6562:
6563: ; set the cursor one (virtual) row up
6564:
6565: .if CompileComputer >= C64_03 .or .defined(C64JAPAN)
6566: ; for -03 ROMs, it was decided that this the cursor row is only moved up
6567: ; if it has already changed since this function began
6568: ; TODO why?
6569: ;
6570: jsr Patch_CursorOneRowUp
6571: .else
6572: jsr CursorOneRowUp
6573: .endif
6574:
6575: ; here: with X := current row (modified in CursorOneRowUp / Patch_CursorOneRowUp)
6576:
6577: cpx zLXSP ; has the cursor row on screen changed?
6578: bne BASIN_KEYB_PROCESS_KEY ; yes -> branch, get keyboard input
6579:
6580: .if CompileComputer < C64_GENERAL
6581: bne BASIN_KEYB_PROCESS_KEY ; some superfluous leftover
6582: .endif
6583:
6584: lda zTEMP_zPNTR ; restore current cursor column (zPNTR) from zTEMP_zPNTR
6585: sta zPNTR
6586: cmp zINDX ; did the column change while we were in the routine?
6587: bcc BASIN_KEYB_PROCESS_KEY ; we are now to the left of the column at the beginning -> branch, get new key input
6588: bcs BASIN_KEYB_END_LINE ; we are at the same column or right from it -> branch, done
6589: ; -------------------------
6590:
6591: BASIN_KEYB:
6592:
6593: ; remember Y and X on the stack
6594:
6595: tya
6596: pha
6597: txa
6598: pha
6599:
6600: lda zCRSW ; has CR been pressed already?
6601: ; that is, are there already keys to
6602: ; process on the screen?
6603: beq WaitForKeyPress ; No, wait for input of a complete line
6604:
6605: BASIN_KEYB_PROCESS_KEY:
6606: ldy zPNTR ; get pointer into current line
6607: lda (zPNT),y ; get current character at that position
6608:
6609: .if CompileComputer >= C64_GENERAL
6610: .elseif CompileComputer >= VIC20_06
6611:
6612: ; FillUntil $E672,$EA
6613: FillNOP 23
6614:
6615: .else
6616:
6617: ; It seems the VIC20_0ß2 ROM has some kind of "cooked" screen codes.
6618: ; This routine converts some characters into others, bypassing the
6619: ; screen code to PETSCII conversion later
6620:
6621: ldx lMODE ; if lMODE == 0 then we do not use the "cooked" mode
6622: beq @End ; Thus, in this case, skip the conversion
6623:
6624: ldx #SpecialScreenCodeHandleTable_END - SpecialScreenCodeHandleTable - 2
6625: @FindChar:
6626: cmp SpecialScreenCodeHandleTable,x ; is the current character a special one?
6627: beq @FoundCharacter ; yes, branch -> convert it
6628: dex ; no, proceed to previous special character
6629: dex
6630: bpl @FindChar ; test the next char
6631: bmi @End ; table has completed -> branch, quit
6632: ; ---------------
6633:
6634: @FoundCharacter:
6635: lda SpecialScreenCodeHandleTable + 1,x ; convert the screen code to the replacement
6636: bne @ProceedToNextScreenLocation ; (uncond. branch)
6637: ; --------------------------------------
6638:
6639: @End:
6640:
6641: .endif
6642:
6643: ; convert the character (in A) into PETSCII TODO
6644: ;
6645: ; Here, we convert the codes as follows:
6646: ;
6647: ; SCREEN CODE -> PETSCII
6648: ; $00-$1F -> $40-$5F
6649: ; $20-$3F -> $20-$3F
6650: ; $40-$5F -> $60-$7F
6651: ; TODO ???
6652: ;
6653:
6654: sta zSCHAR ; store the character
6655:
6656: and #$3F ; mask out the upper 2 bits (7, 6)
6657: asl zSCHAR ; put bit 7 into C
6658: bit zSCHAR ; test the remaining part
6659:
6660: ; now, we have the following status of the flags:
6661: ; C = bit 7 of A on input
6662: ; N = bit 6 of A on input
6663: ; V = bit 5 of A on input
6664:
6665: bpl @DoNotSetBit7 ; N=0 -> bit 6 was 0, that is, we have $00-$3F or $80-$BF
6666:
6667: ora #$80 ; otherwise, set bit 7
6668:
6669: @DoNotSetBit7:
6670: bcc @Process0x00_To_0x7F ; was bit 7 == 0? --> branch
6671:
6672: ldx zQTSW ; Check quotation mark mode
6673: bne @ProceedToNextScreenLocation ; branch if we are in quotation mark mode
6674:
6675: @Process0x00_To_0x7F:
6676: bvs @ProceedToNextScreenLocation ; was bit 5 == 1? --> branch
6677: ora #$40 ; otherwise, set bit 6
6678:
6679: ; here, we converted: (TODO: check again!)
6680: ; $00-$1F -> $40-$5F
6681: ; $20-$3F -> $20-$3F
6682: ; $40-$5F -> $80-$9F
6683: ; $60-$7F -> $C0-$DF
6684:
6685: @ProceedToNextScreenLocation:
6686: inc zPNTR ; proceed to next screen location
6687:
6688: jsr CheckQuote ; update the quotation mark mode flag
6689:
6690: cpy zINDX ; have we reached the end of the line?
6691: bne BASIN_KEYB_QUIT ; no, return the current character
6692:
6693: ; if we reach here, then we have read the complete line
6694: ; Thus, clear all states and return the CR as marker for end-of-line
6695:
6696: BASIN_KEYB_END_LINE:
6697: lda #0
6698: sta zCRSW ; remember: We do not have any characters anymore
6699: lda #ASC_CR ; return a CR Value
6700:
6701: ldx zDFLTN
6702: cpx #FILE_SCREEN ; default input file = screen?
6703: beq @OutputCharacter ; yes, output the CR
6704:
6705: ldx zDFLTO
6706: cpx #FILE_SCREEN ; default output file = screen?
6707: beq @QuitWithCR ; yes, quit
6708:
6709: ; if we reach here, the input was from the keyboard, and the output was not the screen.
6710: ; Thus, output the CR we got from the keyboard
6711:
6712: @OutputCharacter:
6713: jsr CHROUT_SCREEN ; output the character on the screen
6714:
6715: @QuitWithCR:
6716: lda #ASC_CR ; return a CR value
6717:
6718: BASIN_KEYB_QUIT:
6719: sta zSCHAR ; remember read char
6720:
6721: ; restore X and Y from stack
6722: pla
6723: tax
6724: pla
6725: tay
6726:
6727: lda zSCHAR ; get back remembered read char
6728: cmp #ASC_PI ; is it the PETSCII code for PI?
6729: bne @ClcRts ; no, branch -> we are done
6730: lda #TokPi ; yes, replace it by the BASIC token for PI (TODO why did CBM choose this route?)
6731: @ClcRts:
6732: clc ; we successfully ended the routine
6733: rts
6734: ; --------------
6735:
6736: CheckQuote:
6737: cmp #'"' ; Is the current char a quotation mark?
6738: bne @Rts ; no, quit
6739:
6740: ; invert the state of the quotation mark
6741: lda zQTSW
6742: eor #$01
6743: sta zQTSW
6744:
6745: lda #'"' ; restore the character
6746: @Rts: rts
6747:
6748:
6749: ; @@@@@
6750:
6751: LE691: ora #$40
6752:
6753: CHROUT_SCREEN_OUTPUT_WITH_TEST_RVS:
6754: ldx zRVS ; Is the flag "output in reverse" set?
6755: beq CHROUT_OUTPUT_SCREEN_IN_NORMAL ; no -> branch, output in normal
6756:
6757: CHROUT_SCREEN_OUTPUT_IN_RVS:
6758: ora #$80 ; setting bit 7 of the char to output: reverse the char
6759:
6760: CHROUT_OUTPUT_SCREEN_IN_NORMAL:
6761: ldx zINSRT ; Number of characters to output in "insert mode"
6762: beq @NoInsertMode ; none -> we are not in insert mode -> branch
6763: dec zINSRT ; decrement number of characters to output in revers mode
6764:
6765: @NoInsertMode:
6766: ldx lCOLOR ; get the current color
6767: jsr StoreCharacterOnScreenAndDisableBlinking ; output character in A, color in X
6768: jsr MoveCursorRightAfterOutput ; move the cursor to the next output position
6769:
6770: CHROUT_SCREEN_END:
6771: pla ; restore Y from stack
6772: tay
6773:
6774: lda zINSRT ; insert mode?
6775: beq @DontStopQuotationMode ; no, branch
6776: lsr zQTSW ; end quotation mark mode
6777: @DontStopQuotationMode:
6778: pla ; restore X from stack
6779: tax
6780:
6781: pla ; restore A from stack
6782: clc ; we ended successfully
6783: cli
6784: rts
6785: ; --------------
6786:
6787: MoveCursorRightAfterOutput:
6788: jsr AdjustCursorRowBeforeMovingRight ; if we will move to the next row, increment row number
6789: inc zPNTR ; increment column into current row -> move cursor to the right
6790: lda zLNMX ; get number of column in current row
6791: cmp zPNTR ; did we go past the last column?
6792: bcs EditorRts ; no -> branch, we do not need to adjust column
6793: cmp #(EDITOR_MAX_COMBINED_ROWS * EDITOR_COLS) - 1 ; did we reach the maximum length of a virtual row?
6794: beq SetCursorToTheBeginningOfTheNextLine ; yes -> branch, set cursor to the beginning of the next line
6795:
6796: lda lAUTODN ; do we have to scroll down the screen contents?
6797: beq @CombineRows ; no, skip the scrolling
6798: jmp LE967 ; (will return to LogicallyCombineTwoRows)
6799: ; ------------------
6800:
6801: @CombineRows:
6802: ldx zTBLX
6803: cpx #EDITOR_ROWS
6804: bcc LogicallyCombineTwoRows
6805: jsr LE8EA
6806: dec zTBLX
6807: ldx zTBLX
6808:
6809: LogicallyCombineTwoRows:
6810: asl zLDTB1,x ; clear bit 7 -> combine this phyiscal row with the previous one
6811: lsr zLDTB1,x
6812:
6813: .macro EDITOR_PATCH_LogicallyCombineTwoRows_FIX
6814:
6815: ; only present on VIC20-06 ROMs and above, and C64 ROMs.
6816:
6817: ; mark the next row as being stand-alone
6818:
6819: ; TODO what exactly does this patch fix?
6820:
6821: inx ; go to the next row
6822: lda zLDTB1,x
6823: ora #$80 ; set bit 7 --> this row is not combined with the previous one
6824: sta zLDTB1,x
6825: dex ; go back to the previous row
6826: .endmacro
6827:
6828: .macro EDITOR_PATCH_LogicallyCombineTwoRows_COMMON
6829: ; from here on, this is done for all variants, including the VIC20-2
6830:
6831: lda zLNMX ; maximum number of columns on the current (virtual) row
6832: clc
6833: .endmacro
6834:
6835: ; depending on the firmware built,
6836: .if CompileComputer >= C64_GENERAL
6837: EDITOR_PATCH_LogicallyCombineTwoRows_FIX
6838: EDITOR_PATCH_LogicallyCombineTwoRows_COMMON
6839: .elseif CompileComputer >= VIC20_06
6840: ; on the VIC20-06 and -07, this patch is really a patch.
6841: ; We come back with a JMP
6842: jmp EditorPatchLogicallyCombineTwoRows
6843: EditorPatchLogicallyCombineTwoRows_Return:
6844:
6845: .else
6846: ; old implementation for VIC20-02
6847: EDITOR_PATCH_LogicallyCombineTwoRows_COMMON
6848: .endif
6849:
6850: adc #EDITOR_COLS ; add the number of column of one (physical) row
6851: sta zLNMX ; and set it as the new maximum number of columns on the current (virtual) row
6852:
6853: CursorOneRowUp:
6854: ; input: X := Cursor row
6855: ;
6856: ; set the cursor row to point to the (virtual) row above us.
6857:
6858: lda zLDTB1,x ; is the current row combined with the previous one?
6859: bmi @NotCombined ; no, we're done
6860: dex ; cursor on (physical) row up
6861: bne CursorOneRowUp ; not 0 -> not at top of screen -> branch, test the next (physical) row
6862:
6863: @NotCombined:
6864: jmp CalculateScreenPointerFromRowNumber ; adjust screen pointer
6865: ; -----------------------------------------
6866:
6867: SetCursorToTheBeginningOfTheNextLine:
6868: dec zTBLX ; go up one row (will be undone in the next routine)
6869: jsr GoDownOneVirtualRow ; go down one (virtual) row
6870: lda #0
6871: sta zPNTR ; set column to the beginning of the row
6872: EditorRts:
6873: rts
6874: ; -----------------------------------------
6875:
6876:
6877: ; Perform the wrap-around to the previous row of
6878: ; INS/DEL or CRSR LEFT is pressed on the leftmost column.
6879: ;
6880: ; If the cursor is not at the home position, it
6881: ; puts the cursor one row to the top, and on the last
6882: ; column if that row.
6883: ;
6884: ; NOTE:
6885: ; If the cursor is already at the home position,
6886: ; this function removes the return address from the stack!
6887: ; Instead, it jumps to CHROUT_SCREEN_END.
6888: ;
6889: CHROUT_SCREEN_WrapAroundToPreviousRow:
6890: ldx zTBLX ; get row of current cursor position
6891: bne @CanGoBack ; not zero -> branch
6892:
6893: ; 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).
6894: ; Thus, we do not have an option to go more to the left.
6895:
6896: stx zPNTR ; set column to 0 (TODO: should not be necessary, as it is already set to 0!)
6897:
6898: ; Remove the return address from the stack:
6899: ; we do not want to return to the caller;
6900: ; instead, we will abort the output!
6901: ;
6902: pla
6903: pla
6904:
6905: 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.)
6906: ; -----------------------
6907:
6908: @CanGoBack:
6909: dex
6910: stx zTBLX ; set the cursor one row to the top
6911:
6912: jsr SET_CURSORPOS ; set the cursor position (and calculate the line length of the current line, in zLNMX)
6913:
6914: ; set the cursor to the last column of the line
6915: ldy zLNMX ; get current (virtual) line length
6916: sty zPNTR ; and set the cursor to that column
6917: rts
6918:
6919: ; CHROUT onto screen
6920: ;
6921: ; Output the character in A to the current cursor position on the screen
6922: ;
6923: CHROUT_SCREEN:
6924: pha ; remember the character to output on stack
6925: sta zSCHAR ; and in memory
6926:
6927: ; remember X and Y on the stack
6928: txa
6929: pha
6930: tya
6931: pha
6932:
6933: lda #$00 ; no CR has been pressed yet
6934: sta zCRSW ; That is, on next BASIN, the routine will wait for an input again, regardless if the input has been completely used yet.
6935:
6936: ldy zPNTR ; get pointer into current (logical) line
6937: lda zSCHAR ; character to be output
6938: bpl @PositiveChar ; is it positive (<= $7F) -> branch
6939: jmp @NegativeChar
6940: ; ------------
6941:
6942: @PositiveChar:
6943: cmp #ASC_CR ; is the character a CR?
6944: bne @NoCR ; No -> branch, next test
6945: jmp CHROUT_SCREEN_CR ; Output a CR
6946:
6947: @NoCR:
6948: ; Here, we convert the codes as follows:
6949: ;
6950: ; PETSCII -> SCREEN CODE
6951: ; $20-$3F -> $20-$3F
6952: ; $40-$5F -> $00-$1F
6953: ; $60-$7F -> $40-$5F
6954:
6955: cmp #$20 ; is the character a control code (< $20)?
6956: bcc @TestControlCode ; yes, process the control code
6957:
6958: cmp #$60 ; is the character small than $60 (i.e., $20..$5F)?
6959: bcc @Convert0x20_0x60 ; yes, branch -> convert char
6960: and #~$20 ; convert $60-$7F --> $40-$5F
6961: bne @CheckQuoteAndOutput ; (uncond. branch)
6962: ; -----------------
6963:
6964: @Convert0x20_0x60:
6965: and #$3F ; converts $20-$3F --> $20-$3F, but $40-$5F -> $00-$1F
6966:
6967: @CheckQuoteAndOutput:
6968: jsr CheckQuote ; update quote state, if necessary
6969: jmp CHROUT_SCREEN_OUTPUT_WITH_TEST_RVS
6970: ; -----------------
6971:
6972: @TestControlCode:
6973: ldx zINSRT ; are we in insert mode?
6974: beq @ProcessControlCode ; no, branch -> process control codes
6975: jmp CHROUT_SCREEN_OUTPUT_IN_RVS ; output the control codes in reverse (and quit), do not process them
6976: ; -----------------
6977:
6978: @ProcessControlCode:
6979: cmp #ASC_INSDEL ; is the character an INS/DEL?
6980: bne @NoINSDEL ; no -> branch, skip special handling of INS/DEL
6981:
6982: tya ; A := Y (zPNTR), offset of current column into current screen line
6983: bne @NotFirstColumn ; not the first column -> branch
6984:
6985: jsr CHROUT_SCREEN_WrapAroundToPreviousRow ; Perform the wrap around to the previous row, putting the cursor on the rightmost column of the previous line.
6986: ; If we are at the home position already, this function does NOT return, but goes to CHROUT_SCREEN_END instead.
6987: jmp @AddBlankAtCurrentPosition
6988: ; -----------------
6989:
6990: @NotFirstColumn:
6991: jsr AdjustCursorRowBeforeMovingLeft ; we want to move the cursor to the left. If we will cross a row this way, decrement the row number.
6992:
6993: ; move cursor one to the left
6994:
6995: dey
6996: sty zPNTR
6997: jsr UpdateColorRAMPointerToVideoramPointer ; update color RAM pointer
6998:
6999: ; move the screen parts to the right of the cursor one to the left
7000:
7001: @MoveLoop:
7002: iny ; get the char to the right
7003: lda (zPNT),y
7004: dey ; and copy it one to the left
7005: sta (zPNT),y
7006:
7007: iny ; get the color to the right
7008: lda (zUSER),y
7009: dey ; and copy it one to the left
7010: sta (zUSER),y
7011:
7012: iny ; proceed to the next position (to the right)
7013: cpy zLNMX ; did we reach the end of the (logical) line?
7014: bne @MoveLoop ; no, move the next char
7015:
7016: ; if we "fall through", then Y points to the last location on the current (logical) screen line
7017:
7018: @AddBlankAtCurrentPosition:
7019: lda #' ' ; put a space char (blank)
7020: sta (zPNT),y ; into the current screen location
7021: lda lCOLOR ; put the default color
7022: sta (zUSER),y ; into the current color location
7023: 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!
7024: ; ------------------
7025:
7026: @NoINSDEL:
7027: ldx zQTSW ; are we in quotation mark mode?
7028: beq @NoQuotationMode ; no -> branch
7029: jmp CHROUT_SCREEN_OUTPUT_IN_RVS ; output the control codes in reverse
7030: ; ---------------------------------
7031:
7032: @NoQuotationMode:
7033: cmp #ASC_RVS ; character code for reverse (RVS) mode?
7034: bne @NotReverse ; no -> branch, next test
7035: sta zRVS ; remember the reverse mode
7036:
7037: @NotReverse:
7038: cmp #ASC_HOME ; character code for cursor home?
7039: bne @NoCrsrHome ; no -> branch, next test
7040: jsr CURSOR_HOME ; put the cursor at the home position
7041:
7042: @NoCrsrHome:
7043: cmp #ASC_CURSORLEFTRIGHT ; character code for cursor left/right?
7044: bne @NoCrsrLeftRight ; no -> branch, next test
7045:
7046: iny ; move cursor to the right
7047: jsr AdjustCursorRowBeforeMovingRight ; if we will move to the next row, increment row number
7048: sty zPNTR ; store cursor column
7049:
7050: dey ; get old cursor position back
7051: cpy zLNMX ; was the cursor before the end of the (virtual) row?
7052: bcc @End ; yes -> branch
7053:
7054: ; If we reach here, we moved from the end of the previous row to the current row
7055:
7056: dec zTBLX ; decrement the row number (go up one row)
7057: ; the first operation GoDownOneVirtualRow does is increment
7058: ; the row number. This dec is a countermeasure
7059: ; for this incrementing.
7060: jsr GoDownOneVirtualRow ; go down one (virtual) row
7061: ldy #0 ; set cursor to the beginning of the row
7062: @StoreColAndEnd:
7063: sty zPNTR
7064:
7065: @End: jmp CHROUT_SCREEN_END
7066: ; -------------------------
7067:
7068: @NoCrsrLeftRight:
7069: cmp #ASC_CURSORUPDOWN ; character code for cursor up/down?
7070: bne @NoCrsrUpDown ; no -> branch, next test
7071:
7072: ; In case we moved down one phyiscal row, but we are still in the
7073: ; same (virtual) row, we calculate the new column we would be at
7074: ; If this case is not true, the calculation will be thrown away.
7075: ; Otherwise, we will use this value.
7076:
7077: clc
7078: tya ; A := Y (current column number)
7079: adc #EDITOR_COLS ; add the number of columns in a physical row
7080: tay ; Y := A (column number if we are still in the same virtual row)
7081:
7082: ;
7083: inc zTBLX ; go down one row
7084: cmp zLNMX ; compare just calculated column number with maximum number of column in the current row
7085: bcc @StoreColAndEnd ; calculated row number is smaller -> we are still in the same virtual row -> branch, store column
7086: beq @StoreColAndEnd ; calculated row number is equal -> we are still in the same virtual row -> branch, store column
7087: dec zTBLX ; go up one row (again to where we started)
7088: ; this is a preparation to the JSR GoDownOneVirtualRow below
7089:
7090: ; "Normalise" the column (in zPNTR)
7091: ; That is, calculate zPNTR MOD EDITOR_COLS with a loop
7092: ; TODO why?
7093:
7094: @Normalise:
7095: ; sec, but we already have C=1: If we come from "above", then we would have branched in the bcc
7096: ; if C=0
7097: ; if we looped, then we would have branched in the other bcc from below
7098:
7099: sbc #EDITOR_COLS ; subtract the number of columns in a physical row
7100: bcc @GoDown ; if we reached < 0, end the loop
7101: sta zPNTR ; store the column
7102: bne @Normalise ; if we did not reach 0 yet, loop again
7103:
7104: @GoDown:
7105: jsr GoDownOneVirtualRow ; go down one (virtual) row
7106: @End2:
7107: jmp CHROUT_SCREEN_END
7108:
7109: @NoCrsrUpDown:
7110: jsr EditorCheckColorCodeAndSetColor ; check if the current PETSCII code is a color. IF yes, set lCOLOR. Return anyway
7111:
7112: .if CompileComputer >= VIC20_06
7113: jmp EditorCheckForAscLowercase ; check for additional codes (change uppercase, change lowercase, allow changing uppercase/lowercase, disallow it)
7114: .else
7115: jmp CHROUT_SCREEN_END ; we're done
7116: .endif
7117:
7118:
7119: @NegativeChar:
7120:
7121: .if CompileComputer >= C64_GENERAL
7122:
7123: .elseif CompileComputer < VIC20_06
7124: ; depending on lMODE, the old VIC20 KERNAL does some translation of
7125: ; character codes to be output.
7126: ; All of these codes being replaced have in common that their
7127: ; 7th bit ($80) is set.
7128: ;
7129: ; TODO Why is this done?
7130:
7131: ldx lMODE ; get lMODE
7132: beq @LE815 ; is it 0? Then do NOT do any conversion
7133:
7134: ldx #$31
7135: @LE807: cmp CHROUT_REPLACEMENT_TABLE,x
7136: beq @LE812
7137: dex
7138: dex
7139: bpl @LE807
7140: bmi @LE815
7141: @LE812: lda CHROUT_REPLACEMENT_TABLE - 1,x
7142: .else
7143:
7144: ; FillUntil $E815, $EA
7145: FillNOP 21
7146:
7147: .endif
7148:
7149: @LE815:
7150:
7151: and #$7F
7152: cmp #TokPi - $80
7153: bne @LE7DC
7154: .if .defined(C64JAPAN)
7155: lda #ASC_PI - $40 ; @@@???
7156: .else
7157: lda #ASC_PI - $80
7158: .endif
7159: @LE7DC:
7160: .if CompileComputer >= C64_GENERAL
7161:
7162: .elseif CompileComputer >= VIC20_06
7163: .repeat 6
7164: nop
7165: .endrep
7166: .else
7167: cmp #$04
7168: bne @LE823
7169: lda #$7F
7170: .endif
7171:
7172: @LE823:
7173: cmp #' '
7174: bcc @LE7E3
7175: jmp LE691
7176: ; ----------------
7177:
7178: @LE7E3: cmp #ASC_CR
7179: bne @LE7EA
7180: jmp CHROUT_SCREEN_CR
7181:
7182: @LE7EA: ldx zQTSW ; are we in quotation mark mode?
7183: bne @LE82D ; yes -> branch
7184: cmp #ASC_INSDEL
7185: bne @LE829
7186: ldy zLNMX
7187: lda (zPNT),y
7188: cmp #' '
7189: bne @LE7FE
7190: cpy zPNTR
7191: bne @LE805
7192: @LE7FE: cpy #(EDITOR_MAX_COMBINED_ROWS * EDITOR_COLS) - 1
7193: beq @LE826
7194: jsr LE965
7195: @LE805: ldy zLNMX
7196: jsr UpdateColorRAMPointerToVideoramPointer
7197: @LE80A: dey
7198: lda (zPNT),y
7199: iny
7200: sta (zPNT),y
7201: dey
7202: lda (zUSER),y
7203: iny
7204: sta (zUSER),y
7205: dey
7206: cpy zPNTR
7207: bne @LE80A
7208: lda #' '
7209: sta (zPNT),y
7210: lda lCOLOR
7211: sta (zUSER),y
7212: inc zINSRT ; increment number of characters to output in insert mode
7213: @LE826: jmp CHROUT_SCREEN_END
7214: ; -----------------------
7215:
7216: @LE829: ldx zINSRT ; number of characters to output in insert mode
7217: beq @LE832
7218: @LE82D: ora #$40
7219: jmp CHROUT_SCREEN_OUTPUT_IN_RVS
7220:
7221: @LE832: cmp #ASC_CURSORUPDOWN
7222: bne @LE84C
7223: ldx zTBLX
7224: beq @LE871
7225: dec zTBLX
7226: lda zPNTR
7227: sec
7228: sbc #EDITOR_COLS
7229: bcc @LE847
7230: sta zPNTR
7231: bpl @LE871
7232: @LE847: jsr SET_CURSORPOS
7233: bne @LE871
7234: @LE84C: cmp #ASC_RVS
7235: bne @LE854
7236: lda #$00
7237: sta zRVS
7238: @LE854: cmp #ASC_CURSORLEFTRIGHT
7239: bne @LE86A
7240: tya
7241: beq @LE864
7242: jsr AdjustCursorRowBeforeMovingLeft ; we want to move the cursor to the left. If we will cross a row this way, decrement the row number.
7243: dey
7244: sty zPNTR
7245: jmp CHROUT_SCREEN_END
7246:
7247: @LE864: jsr CHROUT_SCREEN_WrapAroundToPreviousRow
7248: jmp CHROUT_SCREEN_END
7249: @LE86A: cmp #ASC_HOME
7250: bne @LE874
7251: jsr ClearScreen
7252: @LE871: jmp CHROUT_SCREEN_END
7253: @LE874: ora #$80
7254: jsr EditorCheckColorCodeAndSetColor
7255: .if CompileComputer >= VIC20_06
7256: jmp EditorCheckForAscUppercase
7257: .else
7258: jmp CHROUT_SCREEN_END
7259: .endif
7260: ; -----------------------
7261:
7262: GoDownOneVirtualRow:
7263: lsr zLXSP
7264: ldx zTBLX
7265: @LE880: inx
7266: cpx #EDITOR_ROWS
7267: bne @LE888
7268: jsr LE8EA
7269: @LE888: lda zLDTB1,x
7270: bpl @LE880
7271: stx zTBLX
7272: jmp SET_CURSORPOS
7273:
7274: CHROUT_SCREEN_CR:
7275: ; output a CR onto the screen at the current cursor position
7276:
7277: ldx #$00
7278: stx zINSRT ; end INSERT mode
7279: stx zRVS ; end REVERSE (RVS) mode
7280: stx zQTSW ; end quotation mark mode
7281: stx zPNTR ; put cursor to the beginning of the current line (that is, CR w/o NL, so to speak)
7282:
7283: jsr GoDownOneVirtualRow ; go down one (virtual) row
7284: jmp CHROUT_SCREEN_END
7285: ; --------------
7286:
7287: ; If the cursor will be part of the previous row after being moved to the left
7288: ; (that is, the cursor is at the beginning of the current row now), move
7289: ; the cursor one row to the top.
7290:
7291: AdjustCursorRowBeforeMovingLeft:
7292: ldx #EDITOR_MAX_COMBINED_ROWS ; maximum number of rows that can be combined in one virtual row
7293: lda #$00 ; start counter at column 0
7294: @Loop:
7295: cmp zPNTR ; is current cursor column the same as our counter?
7296: beq @DecrementAndExit ; yes -> branch, decrement row and exit
7297: clc
7298: adc #EDITOR_COLS ; calculate next multiple of EDITOR_COLS to test against
7299: dex ; still a row to handle?
7300: bne @Loop ; yes -> branch, process next row
7301: rts
7302:
7303: @DecrementAndExit:
7304: dec zTBLX ; decrement current cursor row
7305: rts
7306:
7307:
7308: ; If the cursor will be part of the next row after being moved to the right
7309: ; (that is, the cursor is at the end of the current row now), move
7310: ; the cursor one row to the bottom.
7311:
7312: AdjustCursorRowBeforeMovingRight:
7313: ldx #EDITOR_MAX_COMBINED_ROWS ; maximum number of rows that can be combined in one virtual row
7314: lda #EDITOR_COLS - 1 ; start counter at last column of a physical row
7315: @Loop:
7316: cmp zPNTR ; is current cursor column the same as our counter?
7317: beq @IncrementAndExit ; yes -> branch, increment row and exit
7318: clc
7319: adc #EDITOR_COLS ; calculate next column to test against
7320: dex ; still a row to handle?
7321: bne @Loop ; yes -> branch, process next row
7322: rts
7323:
7324: @IncrementAndExit:
7325: ldx zTBLX ; is current cursor row
7326: cpx #EDITOR_ROWS ; less than the maximum?
7327: beq @Rts ; no, we cannot increment as we are already at the last row -> branch, skip increment
7328: inc zTBLX ; increment cursor row
7329: @Rts: rts
7330:
7331: ; Check if the current PETSCII code is a color code
7332: ; If it is, set lCOLOR accordingly.
7333: ; Input: A := PETSCII code
7334: ; Output: if A is a color code:
7335: ; lCOLOR := X := color code
7336: ; else
7337: ; X := $FF, lCOLOR unchanged
7338: ; Uses: X
7339: ;
7340: EditorCheckColorCodeAndSetColor:
7341: ldx #END_ColorCodes - ColorCodes - 1 ; get number of color codes
7342: @CheckColor:
7343: cmp ColorCodes,x ; is the current char a color code?
7344: beq @ColorFound ; yes -> branch, we found a color
7345: dex ; test the next color
7346: bpl @CheckColor ; until there is not one left
7347: rts
7348: @ColorFound:
7349: stx lCOLOR ; store the color code in lCOLOR
7350: rts
7351:
7352: ColorCodes:
7353:
7354: ; These are the PETSCII values of the color codes
7355:
7356: .byte $90,$05,$1C,$9F,$9C,$1E,$1F,$9E ; colors no. 0-7
7357:
7358: .if CompileComputer >= C64_GENERAL
7359: .byte $81,$95,$96,$97,$98,$99,$9A,$9B ; The C64 has 8 additional colors defined here: colors no. 8-15
7360:
7361: .endif
7362:
7363: END_ColorCodes:
7364:
7365: .if CompileComputer < C64_GENERAL
7366:
7367: ; depending on lMODE, the old VIC20 KERNAL does some translation of
7368: ; character codes to be output.
7369: ; All of these codes being replaced have in common that their
7370: ; 7th bit ($80) is set.
7371: ;
7372: ; TODO Why is this done?
7373:
7374: ; this table is organised as follows: Each entry consists of a byte pair.
7375: ; the byte at offset 1 is the character that is to be replaced, and
7376: ; the byte at offset 0 is the character with which to replace.
7377:
7378: ; This is only used in VIC20_02 ROMs, although the
7379: ; table is also present in later ROMs.
7380:
7381: CHROUT_REPLACEMENT_TABLE:
7382: .byte $EF,$A1
7383: .byte $DF,$A6
7384: .byte $E1,$B1
7385: .byte $E2,$B2
7386: .byte $E3,$B3
7387: .byte $E4,$B4
7388: .byte $E5,$B5
7389: .byte $E6,$B6
7390: .byte $E7,$B7
7391: .byte $E8,$B8
7392: .byte $E9,$B9
7393: .byte $FA,$BA
7394: .byte $FB,$BB
7395: .byte $FC,$BC
7396: .byte $EC,$BD
7397: .byte $FE,$BE
7398: .byte $84,$BF
7399: .byte $F7,$C0
7400: .byte $F8,$DB
7401: .byte $F9,$DD
7402: .byte $EA,$DE
7403:
7404: SpecialScreenCodeHandleTable:
7405: ; special screen code to PETSCII conversion table
7406: ; the first character is the screen code to convert,
7407: ; the second character is the PETSCII code to convert in
7408: ;
7409: ; This is only used in VIC20_02 ROMs, although the
7410: ; table is also present in later ROMs.
7411:
7412: .byte $5E,$E0
7413: .byte $5B,$E1
7414: .byte $5D,$E2
7415: .byte $40,$B0
7416: .byte $61,$B1
7417: .byte $78,$DB
7418: .byte $79,$DD
7419: .byte $66,$B6
7420: .byte $77,$C0
7421: .byte $70,$F0
7422: .byte $71,$F1
7423: .byte $72,$F2
7424: .byte $73,$F3
7425: .byte $74,$F4
7426: .byte $75,$F5
7427: .byte $76,$F6
7428: .byte $7D,$FD
7429:
7430: SpecialScreenCodeHandleTable_END:
7431:
7432: .endif
7433:
7434: LE8EA: lda zSAL
7435: pha
7436: lda zSAL + 1
7437: pha
7438: lda zEAL
7439: pha
7440: lda zEAL + 1
7441: pha
7442: @LE8F6: ldx #$FF
7443: dec zTBLX
7444: dec zLXSP
7445: dec lTLNIDX
7446:
7447: @LE8FF: inx
7448: jsr CalculateScreenPointerFromRowNumber
7449: cpx #EDITOR_ROWS - 1
7450: bcs @LE913
7451: lda SCREEN_LOWBYTE + 1,x
7452: sta zSAL
7453: lda zLDTB1 + 1,x
7454: jsr CopyPhysicalScreenRow
7455: bmi @LE8FF ; => jmp, as CopyPhysicalScreenRow will not return with N=0 ("bpl loop")
7456: ; -----------------
7457:
7458: @LE913:
7459: jsr EraseScreenRow
7460: ldx #0
7461: @LE918: lda zLDTB1,x
7462: and #$7F
7463: ldy zLDTB1 + 1,x
7464: bpl @LE922
7465: ora #$80
7466: @LE922: sta zLDTB1,x
7467: inx
7468: cpx #EDITOR_ROWS - 1
7469: bne @LE918
7470: lda zLDTB1 + EDITOR_ROWS - 1
7471: ora #$80
7472: sta zLDTB1 + EDITOR_ROWS - 1
7473: lda zLDTB1
7474: bpl @LE8F6
7475: inc zTBLX
7476: inc lTLNIDX
7477:
7478: ; check for a pressed CTRL key:
7479: ; If it is pressed, incorporate an additional delay
7480:
7481: .ifdef JIFFY
7482:
7483: JDLE938:
7484: jsr RestoreKeyboardRowAndRet
7485:
7486: .else
7487: lda #KEYB_ROW_CTRL ; set the keyboard row to the row that has the CTRL key
7488: sta KEYB_ROW
7489: .endif
7490: lda KEYB_COL ; test the keyboard columns
7491: cmp #KEYB_COL_CTRL ; check the CTRL key specifically
7492:
7493: .ifdef JIFFY
7494: bne @SkipDelay
7495: ldx zNDX
7496: beq JDLE938
7497: lda $0276,x
7498: sbc #$13
7499: bne @SkipDelay
7500: sta zNDX
7501: @JDLE94F: cli
7502: cmp zNDX
7503: beq @JDLE94F
7504: sta zNDX
7505:
7506: .else
7507: php ; remember status
7508: lda #KEYB_ROW_STANDARD ; restore the keyboard row
7509: sta KEYB_ROW
7510: plp ; get back the status
7511: bne @SkipDelay ; Z=1 --> CTRL key not pressed --> branch, skip delay
7512:
7513: ; create a delay of TODO clock cycles
7514: ldy #0
7515: @Delay:
7516: nop
7517: dex
7518: bne @Delay
7519: dey
7520: bne @Delay
7521: sty zNDX
7522:
7523: .endif
7524:
7525: @SkipDelay:
7526: ldx zTBLX
7527:
7528: Restore_zEAL_and_zSAL:
7529: pla
7530: sta zEAL + 1
7531: pla
7532: sta zEAL
7533: pla
7534: sta zSAL + 1
7535: pla
7536: sta zSAL
7537: rts
7538:
7539: LE965:
7540: ldx zTBLX
7541: LE967:
7542: ; find next (virtual) row
7543: inx ; proceed to next (physical) row
7544: lda zLDTB1,x ; is it combined with the previous one (bit 7 = 0)?
7545: bpl LE967 ; yes -> branch, loop to test the next row
7546:
7547: stx lTLNIDX ; remember the row number of the next (virtual) row
7548: cpx #EDITOR_ROWS - 1 ; is this the last (phyiscal) row?
7549: beq @LE981 ; yes -> branch
7550: bcc @LE981 ; row number is less than last row -> also branch
7551:
7552: jsr LE8EA
7553: ldx lTLNIDX
7554: dex
7555: dec zTBLX
7556: jmp LogicallyCombineTwoRows
7557: ; --------------------
7558:
7559: ; Make room on the screen for the extension of a logical screen row to comprise another
7560: ; physical screen row. This involves scrolling every row below lTLNIDX down (to make
7561: ; room), erasing the new row, and adjusting the pointers in zLDTB1.
7562:
7563: @LE981:
7564: ; save zEAL/zEAL+1 and zSAL/zSAL+1 on the stack as they will be used
7565: ; as temporary storage for pointers.
7566: ; These will be restored before leaving.
7567:
7568: lda zSAL
7569: pha
7570: lda zSAL + 1
7571: pha
7572: lda zEAL
7573: pha
7574: lda zEAL + 1
7575: pha
7576:
7577: ; Move screen contents below the current cursor position downwards
7578:
7579: ldx #EDITOR_ROWS ; start at the last physical row
7580: @CopyRow:
7581: dex
7582: jsr CalculateScreenPointerFromRowNumber ; update the destination pointer into video RAM (zPNT/zPNT+1)
7583: cpx lTLNIDX ; have we already reached the current screen row?
7584: bcc @EndMove ; we are above the current screen row -> branch, end the copy (TODO is this needed at all?)
7585: beq @EndMove ; we are at the current screen row -> branch, end the copy
7586:
7587: ; update the source pointers
7588: lda SCREEN_LOWBYTE - 1,x ; get low byte of the starting address of this row
7589: sta zSAL ; remember low byte
7590: lda zLDTB1 - 1,x ; get high byte of the starting address of this row
7591: jsr CopyPhysicalScreenRow ; copy the current screen row from source to destination, moving it down
7592: bmi @CopyRow ; => jmp, as CopyPhysicalScreenRow will not return with N=0 ("bpl loop")
7593: ; ---------------------------
7594:
7595: @EndMove:
7596: jsr EraseScreenRow ; erase the (physical) screen row in X
7597:
7598: ; update zLDTB1 to reflect the new situation
7599: ; copy the high order (7th) bit of the byte for each row that has been moved
7600: ; to the next row.
7601: ; source row is the row that is copied, destination row is the next row
7602:
7603: ldx #EDITOR_ROWS - 2 ; start at 2nd to last row of source row
7604:
7605: @MoveCombinationBits:
7606: cpx lTLNIDX ; have we already reached (<=) the current row?
7607: bcc @EndMoveCombinationBits ; yes, quit
7608:
7609: lda zLDTB1 + 1,x ; get the byte for the next row
7610: and #~$80 ; clear bit 7 in all cases
7611: ldy zLDTB1,x ; read 7th bit of source row
7612: bpl @Positive ; if it is unset (positive), skip
7613: ora #$80 ; set the 7th bit of destination row
7614: @Positive:
7615: sta zLDTB1 + 1,x ; store byte for destination row
7616: dex ; proceed with previous row
7617: bne @MoveCombinationBits
7618:
7619: @EndMoveCombinationBits:
7620: ldx lTLNIDX
7621: jsr LogicallyCombineTwoRows
7622:
7623: ; restore zEAL/zEAL+1 and zSAL/zSAL+1
7624:
7625: .if CompileComputer >= C64_GENERAL
7626: jmp Restore_zEAL_and_zSAL ; same implementation like VIC-20, but we save memory as it is already there
7627: .else
7628: pla
7629: sta zEAL + 1
7630: pla
7631: sta zEAL
7632: pla
7633: sta zSAL + 1
7634: pla
7635: sta zSAL
7636: rts
7637: .endif
7638:
7639: ; Copy one (physical) screen row on screen to another screen row
7640:
7641: ; This will copy a physical screen row in memory, including the video and the color RAM.
7642: ; It is used to scroll the screen up or down, but it is not limited to this usage.
7643:
7644: ; Input: A = high byte of start address of (logical TODO) screen row (cf. zLDTB1) from which to copy
7645: ; zSAL = low byte of start address of (physical) screen row (cf. SCREEN_LOWBYTE) from which to copy
7646:
7647: ; zPNT/zPNT+1 = Start address of physical screen row video RAM destination
7648: ; zUSER/zUSER+1 = Start address of physical screen row color RAM destination
7649:
7650: CopyPhysicalScreenRow:
7651: and #>lVIDEORAM_SIZE ; make sure to let the start address
7652: ora lHIBASE ; point into the current video RAM
7653: sta zSAL + 1 ; store the address as pointer
7654: jsr @UpdateColorRamPointers
7655:
7656: ; Copy one (physical) row
7657:
7658: ldy #EDITOR_COLS - 1 ; index of last character in a (physical) row
7659: @CopyPreviousChar:
7660: lda (zSAL),y ; get character from source
7661: sta (zPNT),y ; and store it at the destination
7662: lda (zEAL),y ; get color from source
7663: sta (zUSER),y ; and store it at the destination
7664: dey ; go to previous character
7665: bpl @CopyPreviousChar ; non-negative -> branch, there is still a character to be processed
7666: rts
7667: ; -----------------------
7668:
7669: ; Update the color RAM pointers in zUSER/zUSER+1 and zEAL/zEAL+1, respectively,
7670: ; to point to the same locations as the video RAM pointers
7671: ; in zPNT/zPNT+1 and zSAL/zSAL+1, respectively.
7672:
7673: @UpdateColorRamPointers:
7674: jsr UpdateColorRAMPointerToVideoramPointer ; update the color RAM pointer to match the video RAM pointer
7675:
7676: ; adjust video RAM pointer in zSAL/zSAL+1 to point to the color RAM (in zEAL/zEAL+1)
7677: lda zSAL
7678: sta zEAL
7679: lda zSAL + 1
7680: and #>lVIDEORAM_SIZE
7681: ora #>COLORRAM
7682: sta zEAL + 1
7683: rts
7684:
7685: CalculateScreenPointerFromRowNumber:
7686: ; calculate the start of the screen row of which the number
7687: ; is given in X. Store it in zPNT.
7688:
7689: lda SCREEN_LOWBYTE,x ; get low byte of the starting address of this row
7690: sta zPNT ; remember low byte
7691: lda zLDTB1,x ; get high byte of the starting address of this row
7692: and #>lVIDEORAM_SIZE ; mask out additional bits used as flags
7693: ora lHIBASE ; add the video RAM base
7694: sta zPNT + 1 ; remember high byte
7695: rts
7696:
7697:
7698: EraseScreenRow:
7699:
7700: ; this routine erases the screen row no. X
7701:
7702: ldy #EDITOR_COLS - 1 ; start in the last column
7703: jsr CalculateScreenPointerFromRowNumber ; set the video RAM pointer in zPNT to the row we want to process
7704: jsr UpdateColorRAMPointerToVideoramPointer ; update the video RAM pointer in zUSER to correspond to zPNT
7705:
7706: @Loop:
7707: .if CompileComputer >= C64_03 .AND CompileComputer <> C64_4064
7708: jsr Patch_StoreColor ; set the color of the location
7709: .endif
7710: lda #' ' ; store a SPACE (' ') into the video RAM position
7711: sta (zPNT),y
7712: .if CompileComputer = C64_02 .OR CompileComputer = C64_4064
7713: jsr Patch_StoreColor ; set the color of the location
7714: nop
7715: .elseif CompileComputer <= C64_01
7716: lda #COL_WHITE ; set the color of the location to white
7717: sta (zUSER),y
7718: .endif
7719: dey ; proceed to the previous column
7720: bpl @Loop ; still >= 0, branch -> process the next column
7721: rts
7722: ; ----------------------------------
7723:
7724: .if CompileComputer >= C64_03 .AND CompileComputer <> C64_4064
7725: nop
7726: .endif
7727:
7728:
7729: StoreCharacterOnScreenAndDisableBlinking:
7730: tay ; remember character to output
7731:
7732: lda #$02 ; set blink counter to $02 (TODO WHY?)
7733: sta zBLNCT
7734:
7735: jsr UpdateColorRAMPointerToVideoramPointer ; set pointer to video RAM at cursor position
7736:
7737: tya ; get back character to output
7738:
7739: ;
7740: ; Store character on screen at the current cursor position
7741: ;
7742: ; A = character
7743: ; X = color
7744: ;
7745: StoreCharacterOnScreen:
7746: ldy zPNTR ; get column offset in of current screen position
7747: sta (zPNT),y ; store character in video RAM
7748: txa ; get color
7749: sta (zUSER),y ; store color in color RAM
7750: rts
7751:
7752: UpdateColorRAMPointerToVideoramPointer:
7753: lda zPNT
7754: sta zUSER
7755: lda zPNT + 1
7756: and #>lVIDEORAM_SIZE
7757: ora #>COLORRAM
7758: sta zUSER + 1
7759: rts
7760:
7761: KIRQ:
7762: jsr kUDTIM
7763: lda zBLNSW
7764: bne @LEA61
7765: dec zBLNCT
7766: bne @LEA61
7767: lda #$14
7768: sta zBLNCT
7769: ldy zPNTR
7770: lsr zBLNON
7771: ldx lGDCOL
7772: lda (zPNT),y
7773: bcs @LEA5C
7774: inc zBLNON
7775: sta zGDBLN
7776: jsr UpdateColorRAMPointerToVideoramPointer
7777: lda (zUSER),y
7778: sta lGDCOL
7779: ldx lCOLOR
7780: lda zGDBLN
7781: @LEA5C: eor #$80
7782: jsr StoreCharacterOnScreen
7783:
7784: @LEA61:
7785:
7786: .ifdef JIFFY
7787:
7788: LEA61: jmp LEA7B
7789: LEA64: pla
7790: pha
7791: cmp #$98
7792: beq JDLEA6D
7793: JDLEA6A: jmp LA57C
7794: JDLEA6D: jsr JDLF72C
7795: bne JDLEA6A
7796: ldx zTXTPTR
7797: ldy #$04
7798: tya
7799: jmp JDLA5E3
7800: .byte $01
7801:
7802: .else
7803: lda TAPE_REG_SENSE
7804: and #TAPE_B_SENSE
7805: beq @LEA71
7806: ldy #$00
7807: sty zCAS1
7808: lda TAPE_REG_MOTOR
7809: ora #TAPE_B_MOTOR_ON
7810: bne @LEA79
7811: ; -------------------------
7812:
7813: @LEA71: lda zCAS1
7814: bne LEA7B
7815: lda TAPE_REG_MOTOR
7816: and #TAPE_B_MOTOR_OFF_AND
7817: @LEA79:
7818: .if CompileComputer < C64_GENERAL
7819: bit VIA1_IEC
7820: bvs LEA7B
7821: .endif
7822: sta TAPE_REG_MOTOR
7823:
7824: .endif
7825:
7826: LEA7B:
7827: .if CompileComputer = C64_4064
7828: jsr LE4C8
7829: .else
7830: jsr iSCNKEY
7831: .endif
7832:
7833: .if CompileComputer >= C64_GENERAL
7834: lda CIA1 + CIA_O_ICR
7835: .else
7836: bit VIA2_T1CL
7837: .endif
7838: pla
7839: tay
7840: pla
7841: tax
7842: pla
7843: rti
7844:
7845: ; B-25. Function Name: SCNKEY
7846: ;
7847: ; Purpose: Scan the keyboard
7848: ; Call address: $FF9F (hex) 65439 (decimal)
7849: ; Communication registers: None
7850: ; Preparatory routines: IOINIT
7851: ; Error returns: None
7852: ; Stack requirements: 5
7853: ; Registers affected: A, X, Y
7854: ;
7855: ; Description: This routine scans the Commodore 64 keyboard and checks
7856: ; for pressed keys. It is the same routine called by the interrupt handler.
7857: ; If a key is down, its ASCII value is placed in the keyboard queue. This
7858: ; routine is called only if the normal IRQ interrupt is bypassed.
7859: ;
7860: ; How to Use:
7861: ;
7862: ; 1) Call this routine.
7863: ;
7864: ; EXAMPLE:
7865: ;
7866: ; GET JSR SCNKEY ;SCAN KEYBOARD
7867: ; JSR GETIN ;GET CHARACTER
7868: ; CMP #0 ;IS IT NULL?
7869: ; BEQ GET ;YES... SCAN AGAIN
7870: ; JSR CHROUT ;PRINT IT
7871: ;
7872: ;
7873: iSCNKEY:
7874: lda #0 ; start with: No shift key (SHIFT, CTRL, CBM) is pressed
7875: sta lSHFLAG
7876:
7877: ldy #KEY_NONE ; start with: No key pressed
7878: sty zSFDX
7879:
7880: ; check if any key is pressed at all
7881: sta KEYB_ROW ; set all rows to 0
7882: ldx KEYB_COL ; get columns
7883: cpx #$FF ; everything set?
7884: beq iSCNKEY_EndScan ; yes, no key is pressed, abort.
7885: ; 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
7886:
7887: .if CompileComputer >= C64_GENERAL
7888: tay ; Place of the key pressed in the KEYTAB (stored in Y) = 0
7889: .else
7890: lda #~$01 ; start at row 0 (2^0)
7891: sta KEYB_ROW
7892: ldy #$00 ; Place of the key pressed in the KEYTAB (stored in Y) = 0
7893: .endif
7894: lda #<KEYTAB_UNSHIFTED ; start with the unshifted keytab
7895: sta zKEYTAB
7896: lda #>KEYTAB_UNSHIFTED
7897: sta zKEYTAB + 1
7898:
7899: .if CompileComputer >= C64_GENERAL
7900: lda #~$01 ; start at row 0 (2^0)
7901: sta KEYB_ROW
7902: .endif
7903:
7904: @CheckAllRows:
7905: ldx #8 ; process every of the 8 keyboard columns
7906:
7907: .if CompileComputer >= C64_GENERAL
7908: pha ; remember the mask we put into KEYB_ROW for later processing
7909: .endif
7910:
7911: @UnbounceColumns:
7912: lda KEYB_COL ; get column
7913: cmp KEYB_COL ; unbounce it
7914: .if CompileComputer >= C64_GENERAL
7915: bne @UnbounceColumns ; if it changed between reading, re-read it
7916: .else
7917: 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.
7918:
7919: .endif
7920:
7921: ; the following loop tests each column one after one if the bit was 0
7922: ; if it was, the key on the row/column was pressed.
7923: ; This is not completely right if more than one key was pressed,
7924: ; but this is a hardware limitation we cannot handle.
7925:
7926: @ProcessColumn:
7927: lsr a ; get bit from column into C
7928: bcs @KeyNotPressed ; C set -> jump, key was not pressed
7929:
7930: pha ; remember current column mask
7931:
7932: lda (zKEYTAB),y ; get the key code that corresponds to the current row/column
7933: cmp #5 ; is it >= 5?
7934: bcs @StoreKey ; yes, it is a printable char, branch in order to store it
7935: cmp #KEY_STOP ; is it the Run/Stop key?
7936: beq @StoreKey ; yes, store it
7937:
7938: ; if we reached here, the character code is 1, 2, or 4: One of the keys shift or CBM
7939: ; thus, remember the shift flag
7940:
7941: ora lSHFLAG ; set the corresponding flag
7942: sta lSHFLAG ;
7943:
7944: bpl @DoNotStoreKey ; unconditional jump, as lSHFLAG.7 is never set.
7945: ; ----------------------------
7946:
7947: @StoreKey:
7948: sty zSFDX ; remember key code
7949:
7950: @DoNotStoreKey:
7951: pla ; get back column mask
7952:
7953: @KeyNotPressed:
7954: iny ; this keytable entry was processed, go to the next one
7955: cpy #$41 ; did we already process all $40 entries?
7956: bcs @EndScanning ; yes, we are done (for now)
7957:
7958: dex ; decrement the column counter
7959: bne @ProcessColumn ; and repeat scanning, if the counter did not reach 0.
7960:
7961: ; The following code rotates the mask at KEYB_ROW to the left.
7962: ; This moves the "0" bit from right to left.
7963: ; Thus, every row is processed, one after the other.
7964: ; The implementation was changed between VIC20 and C64, though:
7965: ; While the VIC20 uses a ROL on the KEYB_ROW address directly,
7966: ; the C64 performs the ROL in a register and puts the value into
7967: ; KEYB_ROW afterwards.
7968: ; This change most likely occurred since ROL is a read-modify-write
7969: ; instruction. Thus, it will write to the location two times, in two
7970: ; consecutives cycles: First, it will write the old value, and after-
7971: ; wards, it will write the new one. This might generate some "spike"
7972: ; which could inadvertedly affect the reading.
7973:
7974: sec ; make sure to ROL in a "1" bit
7975:
7976: .if CompileComputer >= C64_GENERAL
7977: pla ; get back the mask we put at KEYB_ROW last time
7978: rol a ; rotate it to the left
7979: sta KEYB_ROW ; and set the new mask
7980: .else
7981: rol KEYB_ROW ; rotate to mask to the left
7982: .endif
7983: bne @CheckAllRows
7984:
7985: @EndScanning:
7986:
7987: .if CompileComputer >= C64_GENERAL
7988: pla ; we do not need the mask we put at KEYB_ROW last time anymore, remove it
7989: .endif
7990:
7991: ; Essentially, we are done with scanning here. However, we have to determine
7992: ; if a shift key (SHIFT, C=, CTRL) was pressed, which changes the meaning of
7993: ; some keys. Thus, process the shift keys now.
7994: jmp (lKEYLOG) ; points to CHECK_SHIFT_CTRL_CBM
7995:
7996: ConvertRawKeycodeToInterpretedKeycode:
7997: ldy zSFDX ; get the character code
7998: lda (zKEYTAB),y ; and read in the right ASCII value of it according to the right KEYTAB
7999: tax
8000:
8001: cpy zLSTX
8002: beq @CheckRepeat
8003: ldy #$10
8004: sty lDELAY
8005: bne StoreKeyCodeIntoKeyBuffer
8006:
8007: @CheckRepeat:
8008: and #$7F ; ignore bit 7 of key (TODO why?)
8009:
8010: ; determine if the key press is to be repeated
8011:
8012: bit lRPTFLG ; check repeat flag
8013: bmi RepeatKey ; bit 7 set, repeat all keys --> branch
8014: bvs RestoreKeyboardRowAndRet ; bit 6 set, do not repeat any key --> branch
8015:
8016: cmp #$7F ; Is this the key ... (TODO Which key is this?)
8017:
8018: iSCNKEY_EndScan:
8019: beq StoreKeyCodeIntoKeyBuffer ; Yes, branch -> Store the key into the keyboard buffer
8020: ; TODO Why this extra handling?
8021:
8022: cmp #ASC_INSDEL ; did the user press INS/DEL?
8023: beq RepeatKey ; yes, branch -> process repetition
8024:
8025: cmp #' ' ; did the user press SPACE (" "), or shifted SPACE ($A0)?
8026: beq RepeatKey ; yes, process the repetition
8027:
8028: cmp #ASC_CURSORLEFTRIGHT ; did the user press CRSR LEFT/CRSR RIGHT key?
8029: beq RepeatKey ; yes, branch -> process the repetition
8030:
8031: cmp #ASC_CURSORUPDOWN ; did the user press CRSR LEFT/CRSR RIGHT key?
8032: bne RestoreKeyboardRowAndRet ; no, branch -> do not store the key at all
8033:
8034: RepeatKey:
8035:
8036: ; wait for the initial delay counter lDELAY
8037:
8038: ; For key repetitions, there are two delay: One is the initial delay, that is,
8039: ; how long must a key be pressed before the repetition takes place.
8040: ; This is counted by lDELAY.
8041:
8042: ; The other delay is the counter between repeated keys, if the key is hold
8043: ; long enough. This is counted by lKOUNT.
8044:
8045: ldy lDELAY ; is there an initial delay?
8046: beq @NoInitialDelay ; no, repeat immediately
8047:
8048: dec lDELAY ; yes, decrement the initial delay counter
8049: bne RestoreKeyboardRowAndRet ; still not delayed enough -> branch, do nothing
8050:
8051: @NoInitialDelay:
8052: dec lKOUNT ; decrement the delay counter
8053: bne RestoreKeyboardRowAndRet ; not yet 0, do nothing
8054:
8055: ldy #$04 ; restore the delay counter
8056: sty lKOUNT
8057:
8058: ; test if the keyboard buffer is empty.
8059: ; if it is not empty, no key repetition will take place.
8060:
8061: ; this way, we prevent a full keyboard buffer with repeated keys,
8062: ; which would not be a good user experience (we repeat keys faster
8063: ; than the program can handle them)
8064:
8065: ldy zNDX ; number of keys in keyboard buffer
8066: dey ; - 1
8067: bpl RestoreKeyboardRowAndRet ; still > 0? Then, the buffer is not empty -> branch, do nothing
8068:
8069: StoreKeyCodeIntoKeyBuffer:
8070:
8071: ; Store key code in X into keybuffer
8072:
8073: ; remember key code for the next call of the keyboard routines.
8074: ; this is used for determining if a key was pressed for a longer time
8075: ; and if it has to be repeated, or not.
8076: ldy zSFDX
8077: sty zLSTX
8078:
8079: ; remember shift states for the next call of the keyboard routines.
8080: ; this way, we prevent that SHIFT-CBM is processed more than once, as
8081: ;it is only processed if the shift state changed.
8082: ldy lSHFLAG
8083: sty lLSTSHF
8084:
8085: cpx #$FF ; is the key an invalid one ($FF in the keyboard tables?)
8086: beq RestoreKeyboardRowAndRet ; yes, branch -> do not store it
8087: txa
8088:
8089: ; here, we store the keycode that is in A into the keyboard buffer
8090: ; Note that this routine will generate a race in case it is called w/o
8091: ; interrupts disabled
8092:
8093: ldx zNDX ; get the index into the keyboard buffer
8094: cpx lXMAX ; is the buffer full?
8095: bcs RestoreKeyboardRowAndRet ; yes, branch -> do not store the key
8096: sta lKEYD,x ; store the keycode into the buffer
8097: inx ; increment the number of keys in the buffer
8098: stx zNDX ; and store it
8099:
8100: RestoreKeyboardRowAndRet:
8101: lda #KEYB_ROW_STANDARD ; restore the keyboard row
8102: sta KEYB_ROW
8103: rts
8104:
8105:
8106: CHECK_SHIFT_CTRL_CBM:
8107:
8108: ; Determine if a shift key (SHIFT, C=, CTRL) was pressed, which changes
8109: ; the meaning of some keys.
8110:
8111: lda lSHFLAG ; get the shift state
8112: cmp #lSHFLAG_SHIFT | lSHFLAG_CBM ; shift and commodore pressed?
8113: bne @SwitchToShiftedKeyTable ; no, branch -> process a shifted key table instead
8114:
8115: cmp lLSTSHF ; yes, check if the state changed from the last scan
8116: beq RestoreKeyboardRowAndRet ; it's the same state, branch -> do nothing
8117:
8118: ; If we reach here, SHIFT and C= were pressed simultaneously.
8119: ; Thus, the user wants to switch between Uppercase+Graphics mode,
8120: ; and Lowercase + Uppercase mode.
8121:
8122: lda lMODE ; are we allowed to switch modes?
8123: bmi @ConvertRawKeycodeToInterpretedKeycode ; no, branch -> skip
8124:
8125: .if CompileComputer >= C64_GENERAL
8126:
8127: ; we change mode by changing the base address of the character ROM in the VIC-II
8128:
8129: lda VIC + VICII_O_MemControl
8130: eor #$02
8131: sta VIC + VICII_O_MemControl
8132: .elseif CompileComputer >= VIC20_06
8133: .repeat 19
8134: nop
8135: .endrep
8136:
8137: ; we change mode by changing the base address of the character ROM in the VIC-II
8138:
8139: lda VIC + VICI_O_MemoryLocations
8140: eor #$02
8141: sta VIC + VICI_O_MemoryLocations
8142:
8143: .repeat 4
8144: nop
8145: .endrep
8146: .else
8147: ; this is just a complicated way to EOR VICI_O_MemoryLocations with $02
8148: ; furthermore, it keeps track if the state in lMODE.4 ($10)
8149:
8150: and #$18 ; determine current mode
8151: beq @SwitchToLowercase ; it is uppercase, branch -> switch to lowercase
8152:
8153: ; if we reach here, we are in lowercase mode and want to switch to uppercase mode
8154:
8155: ; remember uppercase mode
8156: lda #$00
8157: sta lMODE
8158:
8159: ; switch VIC to uppercase mode
8160: lda VIC + VICI_O_MemoryLocations
8161: and #~$02
8162: sta VIC + VICI_O_MemoryLocations
8163:
8164: bne @ConvertRawKeycodeToInterpretedKeycode ; unconditional branch
8165: ; --------------
8166:
8167: @SwitchToLowercase:
8168: ; switch VIC to lowercase mode
8169: lda VIC + VICI_O_MemoryLocations
8170: ora #$02
8171: sta VIC + VICI_O_MemoryLocations
8172:
8173: ; remember lowercase mode
8174: lda #$08
8175: sta lMODE
8176: .endif
8177:
8178: .if CompileComputer = VIC20_02
8179: bne @ConvertRawKeycodeToInterpretedKeycode ; unconditional jump
8180: .else
8181: jmp @ConvertRawKeycodeToInterpretedKeycode
8182: .endif
8183: ; ---------------------------
8184:
8185: @SwitchToShiftedKeyTable:
8186:
8187: ; (here, we enter with A := lSHFLAG)
8188:
8189: ; Calculate the offset of the key table for the shift flags
8190: ; this is done by doubling the value of lSHFLAG, and special
8191: ; handling of lSHFLAG_CTRL which would double to 8, but 6 is
8192: ; the right offset
8193:
8194: asl a ; double shift flag
8195: cmp #2 * lSHFLAG_CTRL ; is it CTRL?
8196: bcc @UseOffset ; no, use the offset
8197: lda #$06 ; yes, correct the offset
8198:
8199: .if CompileComputer >= C64_GENERAL
8200: .elseif CompileComputer >= VIC20_06
8201: nop
8202: nop
8203: .else
8204: bne @VIC20_02_HandleOffsetDirectly ; for VIC-20-02, use this offset. (unconditional branch)
8205: ; ------------------------------------
8206: .endif
8207:
8208: @UseOffset:
8209:
8210: .if CompileComputer >= C64_GENERAL
8211:
8212: .elseif CompileComputer >= VIC20_06
8213: .repeat 32
8214: nop
8215: .endrep
8216: .else
8217:
8218: ldx lMODE ; if lMODE = 0, use the offset
8219: beq @VIC20_02_HandleOffsetDirectly
8220:
8221: ldx lSHFLAG ; if C= key is not the only shift key pressed:
8222: cpx #lSHFLAG_CBM
8223: bne @VIC20_02_HandleOffsetDirectly ; branch -> handle the offset
8224:
8225: ; if we reach here, the C= key is pressed (but not SHIFT or CTRL)
8226:
8227: cpx lLSTSHF ; did the shift state change from the last time?
8228: beq @ConvertRawKeycodeToInterpretedKeycode ; no, just convert the key code.
8229:
8230: ; TODO
8231: ; switch uppercase mode with lowercase mode (why?)
8232: ; switch bit 4 (???) (why?)
8233: ; but do not update the VIC itself (why?)
8234:
8235: lda lMODE
8236: eor #$18
8237: sta lMODE
8238:
8239: bpl @ConvertRawKeycodeToInterpretedKeycode ; branches if lMODE.7 is 0: switching between uppercase-mode and lowercase-mode is allowed. (TODO why?)
8240:
8241: @VIC20_02_HandleOffsetDirectly:
8242: ora lMODE ; get the offset into KEYTABS_VEC
8243: and #$7F
8244: .endif
8245:
8246: tax ; X := offset into KEYTABS_VEC
8247:
8248: ; switch to the right KEYTAB according to the shift states
8249:
8250: lda @KEYTABS_VEC,x
8251: sta zKEYTAB
8252: lda @KEYTABS_VEC + 1,x
8253: sta zKEYTAB + 1
8254:
8255: @ConvertRawKeycodeToInterpretedKeycode:
8256: jmp ConvertRawKeycodeToInterpretedKeycode
8257:
8258: @KEYTABS_VEC:
8259: .addr KEYTAB_UNSHIFTED ; $00
8260: .addr KEYTAB_SHIFT ; $02 (lSHFLAG=$01, SHIFT)
8261: .addr KEYTAB_CBM ; $04 (lSHFLAG=$02, C=)
8262: .addr KEYTAB_CTRL ; $06 (lSHFLAG=$04, CTRL)
8263:
8264: .if CompileComputer < C64_GENERAL
8265:
8266: ; these keytabs are only used in the VIC20-02 ROM, but they
8267: ; are still present in the later ones.
8268:
8269: ; these 4 tables are used if we are in lowercase mode
8270: .addr KEYTAB_UNSHIFTED ; $08
8271: .addr KEYTAB_SHIFT ; $0A
8272: .addr KEYTAB6 ; $0C
8273: .addr KEYTAB_CTRL ; $0E
8274:
8275: .addr KEYTAB5 ; $10
8276: .addr KEYTAB6 ; $12
8277: .addr KEYTAB6 ; $14
8278: .addr KEYTAB_CTRL ; $16
8279:
8280: .endif
8281:
8282: KEYTAB_UNSHIFTED:
8283:
8284: .if CompileComputer >= C64_GENERAL
8285:
8286: .byte $14,$0D,$1D,$88,$85,$86,$87,$11
8287: .byte $33,$57,$41,$34,$5A,$53,$45,$01
8288: .byte $35,$52,$44,$36,$43,$46,$54,$58
8289: .byte $37,$59,$47,$38,$42,$48,$55,$56
8290:
8291: .byte $39,$49,$4A,$30,$4D,$4B,$4F,$4E
8292: .byte $2B,$50,$4C,$2D,$2E,$3A,$40,$2C
8293: .byte $5C,$2A,$3B,$13,$01,$3D,$5E,$2F
8294: .byte $31,$5F,$04,$32,$20,$02,$51,$03
8295: .byte $FF
8296:
8297: .else
8298:
8299: .byte $31,$33,$35,$37,$39,$2B,$5C,$14
8300: .byte $5F,$57,$52,$59,$49,$50,$2A,$0D
8301: .byte $04,$41,$44,$47,$4A,$4C,$3B,$1D
8302: .byte $03,$01,$58,$56,$4E,$2C,$2F,$11
8303:
8304: .byte $20,$5A,$43,$42,$4D,$2E,$01,$85
8305: .byte $02,$53,$46,$48,$4B,$3A,$3D,$86
8306: .byte $51,$45,$54,$55,$4F,$40,$5E,$87
8307: .byte $32,$34,$36,$38,$30,$2D,$13,$88
8308:
8309: .byte $FF
8310:
8311: .endif
8312:
8313: KEYTAB_SHIFT:
8314:
8315: .if CompileComputer >= C64_GENERAL
8316:
8317: .if .defined(C64JAPAN)
8318: .byte $94,$8D,$9D,$8C,$89,$8A,$8B,$91
8319: .byte $23,$A8,$AA,$24,$AD,$AB,$A9,$01
8320: .byte $25,$A5,$AC,$26,$AF,$A4,$FF,$AE
8321: .byte $27,$FF,$FF,$28,$FF,$FF,$FF,$FF
8322:
8323: .byte $29,$FF,$FF,$30,$FF,$FF,$FF,$FF
8324: .byte $A1,$FF,$FF,$A2,$3E,$5B,$FF,$3C
8325: .byte $A3,$FF,$5D,$93,$01,$3D,$B0,$3F
8326: .byte $21,$5F,$04,$22,$A0,$02,$A7,$83
8327: .byte $FF
8328: .else
8329: .byte $94,$8D,$9D,$8C,$89,$8A,$8B,$91
8330: .byte $23,$D7,$C1,$24,$DA,$D3,$C5,$01
8331: .byte $25,$D2,$C4,$26,$C3,$C6,$D4,$D8
8332: .byte $27,$D9,$C7,$28,$C2,$C8,$D5,$D6
8333:
8334: .byte $29,$C9,$CA,$30,$CD,$CB,$CF,$CE
8335: .byte $DB,$D0,$CC,$DD,$3E,$5B,$BA,$3C
8336: .byte $A9,$C0,$5D,$93,$01,$3D,$DE,$3F
8337: .byte $21,$5F,$04,$22,$A0,$02,$D1,$83
8338: .byte $FF
8339: .endif
8340:
8341:
8342: .else
8343:
8344: .byte $21,$23,$25,$27,$29
8345: .if CompileComputer >= VIC20_06
8346: .byte $DB,$A9
8347: .else
8348: .byte $AB,$DC
8349: .endif
8350: .byte $94
8351:
8352: .if CompileComputer >= VIC20_06
8353: .byte $5F
8354: .else
8355: .byte $DF
8356: .endif
8357: .byte $D7,$D2,$D9,$C9,$D0
8358: .if CompileComputer >= VIC20_06
8359: .byte $C0
8360: .else
8361: .byte $AA
8362: .endif
8363: .byte $8D
8364:
8365: .byte $04,$C1,$C4,$C7,$CA,$CC,$5D,$9D
8366: .byte $83,$01,$D8,$D6,$CE,$3C,$3F,$91
8367:
8368: .byte $A0,$DA,$C3,$C2,$CD,$3E,$01,$89
8369: .byte $02,$D3,$C6,$C8,$CB,$5B
8370: .if CompileComputer >= VIC20_06
8371: .byte $3D
8372: .else
8373: .byte $BD
8374: .endif
8375: .byte $8A
8376:
8377: .byte $D1,$C5,$D4,$D5,$CF
8378: .if CompileComputer >= VIC20_06
8379: .byte $BA
8380: .else
8381: .byte $C0
8382: .endif
8383: .byte $DE,$8B
8384:
8385: .byte $22,$24,$26,$28
8386: .if CompileComputer >= VIC20_06
8387: .byte $30,$DD
8388: .else
8389: .byte $B0,$AD
8390: .endif
8391: .byte $93,$8C
8392:
8393: .byte $FF
8394:
8395: .endif
8396:
8397: KEYTAB_CBM:
8398:
8399: .if CompileComputer >= C64_GENERAL
8400:
8401: .if .defined(C64JAPAN)
8402: .byte $94,$8D,$9D,$8C,$89,$8A,$8B,$91
8403: .byte $B1,$C3,$C1,$B3,$C2,$C4,$B2,$01
8404: .byte $B4,$BD,$BC,$B5,$BF,$CA,$B6,$BB
8405: .byte $D4,$DD,$B7,$D5,$BA,$B8,$C5,$CB
8406:
8407: .byte $D6,$C6,$CF,$DC,$D3,$C9,$D7,$D0
8408: .byte $CE,$BE,$D8,$CD,$D9,$DA,$DB,$C8
8409: .byte $A6,$DE,$B9,$93,$01,$D1,$DF,$D2
8410: .byte $C7,$5F,$04,$CC,$A0,$02,$C0,$83
8411: .byte $FF
8412: .else
8413: .byte $94,$8D,$9D,$8C,$89,$8A,$8B,$91
8414: .byte $96,$B3,$B0,$97,$AD,$AE,$B1,$01
8415: .byte $98,$B2,$AC,$99,$BC,$BB,$A3,$BD
8416: .byte $9A,$B7,$A5,$9B,$BF,$B4,$B8,$BE
8417:
8418: .byte $29,$A2,$B5,$30,$A7,$A1,$B9,$AA
8419: .byte $A6,$AF,$B6,$DC,$3E,$5B,$A4,$3C
8420: .byte $A8,$DF,$5D,$93,$01,$3D,$DE,$3F
8421: .byte $81,$5F,$04,$95,$A0,$02,$AB,$83
8422: .byte $FF
8423: .endif
8424:
8425: .elseif CompileComputer = VIC20_02
8426: .byte $B1,$B3,$B5,$B7,$B9,$AB,$DC,$94
8427: .byte $DF,$D7,$D2,$D9,$C9,$D0,$AA,$8D
8428: .byte $04,$C1,$C4,$C7,$CA,$CC,$BB,$9D
8429: .byte $83,$01,$D8,$D6,$CE,$AC,$AF,$91
8430:
8431: .byte $0A,$DA,$C3,$C2,$CD,$AE,$01,$FF
8432: .byte $02,$D3,$C6,$C8,$CB,$BA,$BD,$FF
8433: .byte $D1,$C5,$D4,$D5,$CF,$C0,$DE,$FF
8434: .byte $B2,$B4,$B6,$B8,$B0,$AD,$93,$FF
8435: .byte $FF
8436: .else
8437: .byte $21,$23,$25,$27,$29,$A6,$A8,$94
8438: .byte $5F,$B3,$B2,$B7,$A2,$AF,$DF,$8D
8439: .byte $04,$B0,$AC,$A5,$B5,$B6,$5D,$9D
8440: .byte $83,$01,$BD,$BE,$AA,$3C,$3F,$91
8441:
8442: .byte $A0,$AD,$BC,$BF,$A7,$3E,$01,$89
8443: .byte $02,$AE,$BB,$B4,$A1,$5B,$3D,$8A
8444: .byte $AB,$B1,$A3,$B8,$B9,$A4,$DE,$8B
8445: .byte $22,$24,$26,$28,$30,$DC,$93,$8C
8446: .byte $FF
8447: .endif
8448:
8449: .if CompileComputer >= VIC20_06
8450:
8451: KEYTAB5: ; unused, but references for VIC20-06 and -07
8452:
8453: EditorCheckForAscLowercase:
8454: cmp #ASC_LOWERCASE ; if this the code to change to lowercase chars?
8455: bne EditorCheckForAscUppercase ; no, test for the next code
8456:
8457: ; set the VIC memory control byte to point to the lowercase characters:
8458:
8459: .if CompileComputer >= C64_GENERAL
8460: lda VIC + VICII_O_MemControl
8461: ora #2
8462: bne EditorSta_vMemControl ; sta VIC + VICII_O_MemControl ; this bne saves one byte
8463: .else
8464: lda #2
8465: ora VIC + VICI_O_MemoryLocations
8466: sta VIC + VICI_O_MemoryLocations
8467: jmp CHROUT_SCREEN_END ; we're done
8468: ; this JMP is not necessary, but does not do any harm, either.
8469: ; It has been removed from the C64 ROMs, presumably to save space.
8470: .endif
8471:
8472: EditorCheckForAscUppercase:
8473: cmp #ASC_UPPERCASE ; if this the code to change to lowercase chars?
8474: bne EditorCheckForDisallowLowercase ; no, test for the next code
8475:
8476: ; set the VIC memory control byte to point to the uppercase characters:
8477:
8478: .if CompileComputer >= C64_GENERAL
8479: lda VIC + VICII_O_MemControl
8480: and #~2
8481: EditorSta_vMemControl:
8482: sta VIC + VICII_O_MemControl
8483: .else
8484: lda #~2
8485: and VIC + VICI_O_MemoryLocations
8486: sta VIC + VICI_O_MemoryLocations
8487: .endif
8488:
8489: EditorChroutScreenEnd:
8490: jmp CHROUT_SCREEN_END
8491: ; ----------------------------
8492:
8493: EditorCheckForDisallowLowercase:
8494: cmp #ASC_DISALLOW_LOWERCASE ; if this the code to disallow changing to lowercase mode via keyboard?
8495: bne @CheckForAllowLowercase ; no, test for the next code
8496:
8497: ; disallow changing mode with SHIFT + C= by setting bit 7 of lMODE:
8498:
8499: lda #$80
8500: ora lMODE
8501: .if CompileComputer >= C64_GENERAL
8502: bmi @Sta_lMODE ; sta lMODE (uncond. branch)
8503: ; ------------------
8504: .else
8505: sta lMODE
8506: bmi EditorChroutScreenEnd
8507: .endif
8508: @CheckForAllowLowercase:
8509: cmp #ASC_ALLOW_LOWERCASE ; if this the code to allow changing to lowercase mode via keyboard?
8510: bne EditorChroutScreenEnd ; no -> branch, this is no special code (or it has been already handled)
8511:
8512: ; (re-)allow changing mode with SHIFT + C= by clearing bit 7 of lMODE:
8513:
8514: lda #$7F
8515: and lMODE
8516: @Sta_lMODE:
8517: sta lMODE
8518:
8519: ; end chrout to the screen.
8520: ; the VIC-20 and C64 do exactly the same.
8521:
8522: .if CompileComputer >= C64_GENERAL
8523: jmp CHROUT_SCREEN_END
8524: .else
8525: bpl EditorChroutScreenEnd ; branches to a "JMP CHROUT_SCREEN_END" (uncond. branch)
8526: ; ------------------------------
8527:
8528: ; a patch: cf. directly before EditorPatchLogicallyCombineTwoRows_Return
8529:
8530: EditorPatchLogicallyCombineTwoRows:
8531: EDITOR_PATCH_LogicallyCombineTwoRows_FIX
8532: EDITOR_PATCH_LogicallyCombineTwoRows_COMMON
8533: jmp EditorPatchLogicallyCombineTwoRows_Return
8534:
8535: .endif
8536: .endif
8537:
8538: .if CompileComputer = VIC20_02
8539:
8540: KEYTAB5:
8541:
8542: .byte $C7,$B1,$B4,$D4,$D6,$CE,$A6,$14
8543: .byte $FF,$C3,$EC,$DD,$C6,$BE,$EA,$0D
8544: .byte $04,$C1,$BC,$B7,$CF,$D8,$B9,$1D
8545: .byte $03,$01,$BB,$CB,$D0,$C8,$D2,$11
8546: .byte $20,$C2,$BF,$BA,$D3,$D9,$01,$85
8547: .byte $02,$C4,$CA,$B8,$C9,$DA,$D1,$86
8548: .byte $C0,$B2,$B6,$C5,$D7,$DB,$A1,$87
8549: .byte $CC,$B3,$B5,$D5,$DC,$CD,$13,$88
8550: .byte $FF
8551: .endif
8552:
8553: KEYTAB6:
8554:
8555: .if CompileComputer = VIC20_02
8556:
8557: .byte $F1,$F3,$F5,$FF,$FF,$EB,$FF,$94
8558: .byte $FF,$FF,$FF,$FF,$FF,$FF,$FF,$8D
8559: .byte $04,$FF,$FF,$FF,$FF,$FF,$E2,$9D
8560: .byte $83,$01,$FF,$FF,$FF,$FF,$FF,$91
8561: .byte $A0,$FF,$FF,$FF,$FF,$EE,$01,$89
8562: .byte $02,$FF,$FF,$FF,$FF,$E1,$FD,$8A
8563: .byte $FF,$FF,$FF,$FF,$FF,$B0,$E0,$8B
8564: .byte $F2,$F4,$F6,$FF,$F0,$ED,$93,$8C
8565: .byte $FF
8566:
8567: .elseif CompileComputer < C64_GENERAL
8568:
8569: ; unused, but present
8570:
8571: .byte $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
8572: .byte $FF,$04,$FF,$FF,$FF,$FF,$FF,$E2
8573: .byte $9D,$83,$01,$FF,$FF,$FF,$FF,$FF
8574: .byte $91,$A0,$FF,$FF,$FF,$FF,$EE,$01
8575: .byte $89,$02,$FF,$FF,$FF,$FF,$E1,$FD
8576: .byte $8A,$FF,$FF,$FF,$FF,$FF,$B0,$E0
8577: .byte $8B,$F2,$F4,$F6,$FF,$F0,$ED,$93
8578: .byte $8C,$FF
8579:
8580: .endif
8581:
8582: KEYTAB_CTRL:
8583:
8584: .if CompileComputer >= C64_GENERAL
8585:
8586: .if .defined(C64JAPAN)
8587: .byte $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
8588: .byte $1C,$95,$01,$9F,$1A,$13,$96,$FF
8589: .byte $9C,$97,$04,$1E,$03,$06,$98,$18
8590: .byte $1F,$99,$07,$9E,$02,$08,$9A,$16
8591:
8592: .byte $12,$9B,$0A,$92,$0D,$0B,$0F,$0E
8593: .byte $08,$10,$0C,$09,$11,$14,$00,$09
8594: .byte $FF,$05,$15,$FF,$FF,$17,$19,$12
8595: .byte $90,$06,$FF,$05,$FF,$FF,$81,$FF
8596: .byte $FF
8597: .else
8598: .byte $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
8599: .byte $1C,$17,$01,$9F,$1A,$13,$05,$FF
8600: .byte $9C,$12,$04,$1E,$03,$06,$14,$18
8601: .byte $1F,$19,$07,$9E,$02,$08,$15,$16
8602:
8603: .byte $12,$09,$0A,$92,$0D,$0B,$0F,$0E
8604: .byte $FF,$10,$0C,$FF,$FF,$1B,$00,$FF
8605: .byte $1C,$FF,$1D,$FF,$FF,$1F,$1E,$FF
8606: .byte $90,$06,$FF,$05,$FF,$FF,$11,$FF
8607: .byte $FF
8608: .endif
8609:
8610: .else
8611:
8612: .byte $90,$1C,$9C,$1F
8613: .if CompileComputer = VIC20_02
8614: .byte $FF
8615: .else
8616: .byte $12
8617: .endif
8618: .byte $FF,$FF,$FF
8619: .if CompileComputer = VIC20_02
8620: .byte $FF
8621: .else
8622: .byte $06
8623: .endif
8624: .byte $FF,$12,$FF,$FF,$FF,$FF,$FF
8625: .byte $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
8626: .byte $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
8627: .byte $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
8628: .byte $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
8629: .byte $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
8630: .byte $05,$9F,$1E,$9E,$92,$FF,$FF,$FF
8631: .byte $FF
8632:
8633: .endif
8634:
8635: VIC_DEFAULTS:
8636:
8637: ; the default values for the VIC or VIC-II
8638: ; these will be copied in a loop into the
8639: ; VIC or VIC-II register when initialising the VIC(-II)
8640: ;
8641:
8642: .if CompileComputer >= C64_GENERAL
8643:
8644: .byte $00,$00,$00,$00,$00,$00,$00,$00
8645: .byte $00,$00,$00,$00,$00,$00,$00,$00
8646: .byte $00
8647: .if CompileComputer >= C64_02
8648: .byte $1B | (>311 .SHL 7) ,<311
8649: .else
8650: .byte $1B,$00
8651: .endif
8652: .byte $00,$00,$00,$08,$00
8653: .byte $14
8654: .if CompileComputer >= C64_02
8655: .byte $0F
8656: .else
8657: .byte $00
8658: .endif
8659: .byte $00,$00,$00,$00,$00,$00
8660:
8661: .byte SET_COLOR_FRAME,SET_COLOR_BACKGROUND
8662: .if CompileComputer = C64_4064
8663: .byte $00,$00,$00,$00,$00
8664: .byte $00,$00,$00,$00,$00,$00,$00
8665: .else
8666: .byte $01,$02,$03,$04,$00
8667: .byte $01,$02,$03,$04,$05,$06,$07
8668: .endif
8669:
8670: .else
8671:
8672: .if CompileComputer >= VIC20_07
8673: .byte $0C,$26
8674: .else
8675: .byte $05,$19
8676: .endif
8677: .byte $16,$2E,$00,$C0,$00,$00
8678: .byte $00,$00,$00,$00,$00,$00,$00
8679:
8680: .endif
8681:
8682: END_VIC_DEFAULTS:
8683:
8684: .if CompileComputer < C64_GENERAL
8685:
8686: .byte $1B ; TODO unused?
8687:
8688: .endif
8689:
8690: TEXT_LOADRUN:
8691: .byte "LOAD",ASC_CR
8692: .byte "RUN",ASC_CR
8693: END_TEXT_LOADRUN:
8694:
8695: SCREEN_LOWBYTE:
8696:
8697: ; the low bytes of the screen addresses
8698:
8699: .repeat EDITOR_ROWS,i
8700: .byte <(i*EDITOR_COLS)
8701: .endrep
8702:
8703: ; .include "../kernal/iec.a65"
8704: ; B-34. Function Name: TALK
8705: ;
8706: ; Purpose: Command a device on the serial bus to TALK
8707: ; Call address: $FFB4 (hex) 65460 (decimal)
8708: ; Communication registers: A
8709: ; Preparatory routines: None
8710: ; Error returns: See READST
8711: ; Stack requirements: 8
8712: ; Registers affected: A
8713: ;
8714: ; Description: To use this routine the accumulator must first be loaded
8715: ; with a device number between 0 and 31. When called, this routine then
8716: ; ORs bit by bit to convert this device number to a talk address. Then this
8717: ; data is transmitted as a command on the serial bus.
8718: ;
8719: ; How to Use:
8720: ;
8721: ; 1) Load the accumulator with the device number.
8722: ; 2) Call this routine.
8723: ;
8724: ; EXAMPLE:
8725: ;
8726: ; ;COMMAND DEVICE #4 TO TALK
8727: ; LDA #4
8728: ; JSR TALK
8729: ;
8730: iTALK:
8731: ora #IEEE_TALK ; create primary address for TALK
8732:
8733: .byte ASM_BIT3 ; hide next instruction
8734:
8735: ; B-14. Function Name: LISTEN
8736: ;
8737: ; Purpose: Command a device on the serial bus to listen
8738: ; Call Address: $FFB1 (hex) 65457 (decimal)
8739: ; Communication registers: A
8740: ; Preparatory routines: None
8741: ; Error returns: See READST
8742: ; Stack requirements: None
8743: ; Registers affected: A
8744: ;
8745: ; Description: This routine will command a device on the serial bus to
8746: ; receive data. The accumulator must be loaded with a device number between
8747: ; 0 and 31 before calling the routine. LISTEN will OR the number bit by bit
8748: ; to convert to a listen address, then transmits this data as a command on
8749: ; the serial bus. The specified device will then go into listen mode, and
8750: ; be ready to accept information.
8751: ;
8752: ; How to Use:
8753: ; 1) Load the accumulator with the number of the device to command
8754: ; to LISTEN.
8755: ; 2) Call this routine using the JSR instruction.
8756: ;
8757: ; EXAMPLE:
8758: ; ;COMMAND DEVICE #8 TO LISTEN
8759: ; LDA #8
8760: ; JSR LISTEN
8761: ;
8762: ;
8763: iLISTEN:
8764: ora #IEEE_LISTEN ; create primary address for TALK
8765: jsr LF0A4 ; TODO (assumed: Wait for RS232 transmission to stop)
8766:
8767: IecOutputCommand:
8768: pha ; remember byte to be output
8769:
8770: bit zC3PO ; test: Is there already some character in the output buffer?
8771: bpl @BufferByte ; no -> branch, do not output but put the byte into the buffer instead
8772:
8773: ; there is some byte in the output buffer.
8774: ; output it on the IEC bus.
8775:
8776: sec
8777: ror zTSFCNT ; set zTSFCNT.7, thus: Signal an EOI on output
8778:
8779: .ifdef JIFFY
8780: jsr JDLFBFE
8781: .else
8782: jsr IecOutputByte ; output a byte on IEC bus
8783: .endif
8784:
8785: ; IecOutputByte returns with C == 0
8786: lsr zC3PO ; unset zC3PO.7, thus:
8787: ; mark: There is no byte in the buffer
8788: lsr zTSFCNT ; unset zTSFCNT.7. Subsequent bytes will not be signalled with EOI
8789:
8790: @BufferByte:
8791: ; here, zC3PO.7 is unset.
8792: ; Either we jumped here because of the bpl, or it was specifically unset two lines above
8793:
8794: ; Thus, the buffer is already marked as empty
8795:
8796: pla ; get back the byte to be output
8797: sta zBSOUR ; and store it into the output buffer
8798:
8799: .if CompileComputer >= C64_GENERAL
8800: sei ; make sure the interrupt does not disturb our timing
8801:
8802: ; it is not completely clear if this command is missing
8803: ; on the VIC20, or if it is not critical there, as the VIC20
8804: ; does not have badlines, which might help the timing here.
8805: .endif
8806:
8807: ; TODO: document
8808: .ifdef JIFFY
8809: jsr JDLF0ED
8810: .else
8811: jsr IecDataClear
8812: .endif
8813:
8814: cmp #IEEE_UNLISTEN
8815: bne @NotUNLISTEN
8816:
8817: jsr IecClkClear
8818:
8819: @NotUNLISTEN:
8820:
8821: ; set ATN state
8822:
8823: lda IEC_REG_ATN_OUT
8824: ora #IEC_B_ATN_OUT
8825: sta IEC_REG_ATN_OUT
8826:
8827: IecOutputByte2:
8828: .if CompileComputer >= C64_GENERAL
8829: sei ; make sure the interrupt does not disturb our timing
8830:
8831: ; it is not completely clear if this command is missing
8832: ; on the VIC20, or if it is not critical there, as the VIC20
8833: ; does not have badlines, which might help the timing here.
8834: .endif
8835: jsr IecClkSet
8836: jsr IecDataClear
8837: jsr IecDelay1ms
8838:
8839:
8840:
8841: IecOutputByte:
8842: sei ; make sure the interrupt does not disturb our timing
8843:
8844: .if CompileComputer >= VIC20_06
8845: jsr IecDataClear
8846: .endif
8847:
8848: jsr IecGetDataClockIn
8849: IEC_GET_DATA_INTO_CARRY
8850: bcs @DeviceNotPresent
8851: jsr IecClkClear
8852: bit zTSFCNT
8853: bpl @LED5A
8854:
8855: @WaitDataInactive:
8856: jsr IecGetDataClockIn
8857: IEC_GET_DATA_INTO_CARRY
8858: bcc @WaitDataInactive
8859:
8860: @WaitDataActive:
8861: jsr IecGetDataClockIn
8862: IEC_GET_DATA_INTO_CARRY
8863: bcs @WaitDataActive
8864:
8865: @LED5A:
8866: jsr IecGetDataClockIn
8867: IEC_GET_DATA_INTO_CARRY
8868: bcc @LED5A
8869:
8870: jsr IecClkSet
8871:
8872: .ifdef JIFFY
8873: txa
8874: pha
8875: ldx #8
8876: .else
8877: lda #8 ; number of bits to be output
8878: sta zCNTDN
8879: .endif
8880:
8881: @NextBit:
8882:
8883: .ifdef JIFFY
8884: pha
8885: pla
8886: bit IEC_REG
8887: bmi @JDLED72
8888: pla
8889: tax
8890: jmp SendTimeout
8891:
8892: @JDLED72:
8893: jsr IecDataClear
8894: ror zBSOUR
8895: bcs @JDLED7C
8896: jsr IecDataSet
8897:
8898: @JDLED7C:
8899: jsr IecClkClear
8900: lda IEC_REG
8901: and # ~ IEC_B_DATA_OUT
8902: ora #IEC_B_CLK_OUT
8903: php
8904: pha
8905: jsr JDLF8EA
8906: pla
8907: plp
8908: dex
8909: bne @NextBit
8910: pla
8911: tax
8912:
8913: .else
8914: lda IEC_REG_DATA_CLK_IN
8915: cmp IEC_REG_DATA_CLK_IN
8916: bne @NextBit ; wait for IEC register to settle (TODO entprellen)
8917: IEC_REG__DATA_IN_INTO_CARRY
8918: bcc SendTimeout ; data set (inactive) -> something/someone else is messing with us, there is a transmission problem -> branch
8919:
8920: ror zBSOUR ; next bit to output (LSB) into C
8921: bcs @OutputData1 ; is it set -> output a "1" (inactive) on the IEC bus data line
8922: jsr IecDataSet ; it was not set -> output a "0" (active) on the IEC bus data line
8923: bne @ContinueAfterOutputData ; skip next command
8924:
8925: @OutputData1:
8926: jsr IecDataClear ; output a "1" (inactive) on the IEC bus data line
8927:
8928: @ContinueAfterOutputData:
8929: jsr IecClkClear ; clear clock to indicate: Data has been set accordingly
8930:
8931: ; delay 8 (4*2) clock cycles, giving the other side time to read the value in
8932: nop
8933: nop
8934: nop
8935: nop
8936:
8937: ; clear DATA and set Clock again, indicating the bit is not available anymore
8938: lda IEC_REG_DATA_CLK_OUT
8939: and #~IEC_B_DATA_OUT
8940: ora #IEC_B_CLK_OUT
8941: sta IEC_REG_DATA_CLK_OUT
8942:
8943: dec zCNTDN ; still bits to be output?
8944: bne @NextBit ; yes -> branch -> process the next bit
8945: .endif
8946:
8947: ; TODO document
8948:
8949: ; wait for acknowledgement from other side
8950:
8951: lda #>$0400 ; set timer to approx. 1000 µs ( = 1 ms)
8952: sta IEC_TIMER_HI
8953:
8954: .if CompileComputer >= C64_GENERAL
8955:
8956: ; start timer B with one-shot mode, no PB7, counting PHI2
8957: lda #CIA_CRB_B_START | CIA_CRB_B_ONESHOT | CIA_CRB_B_FORCE_LOAD
8958: sta CIA1 + CIA_O_CRB
8959:
8960: lda IEC_TIMER_FLAG_REG ; make sure the ICR is cleared, so we do not
8961: ; immediately stop the following loop because
8962: ; some other TB underflow condition has occurred before
8963: .endif
8964:
8965:
8966: @WaitForAck:
8967: lda IEC_TIMER_FLAG_REG
8968: and #IEC_TIMER_FLAG_B
8969: bne SendTimeout
8970: jsr IecGetDataClockIn
8971: IEC_GET_DATA_INTO_CARRY
8972: bcs @WaitForAck
8973: cli
8974: rts
8975:
8976:
8977: @DeviceNotPresent:
8978: lda #$80 ; set bit: device not present error
8979:
8980: .byte ASM_BIT3 ; hide the next instruction
8981:
8982: SendTimeout:
8983: lda #$03 ; set bits: read timeout and write timeout
8984:
8985: IecSetStatusAndFreeBus:
8986: jsr SetStatus ; set the status bits
8987:
8988: .if CompileComputer = VIC20_02
8989: jsr IEC_CLR_ATN
8990: jsr IecClkSet
8991: .endif
8992:
8993: cli
8994: .if CompileComputer >= VIC20_06
8995: clc
8996: bcc IecClearAtnAndClockAndDataAfterDelay
8997: ; ------------------
8998: .else
8999: jmp IecDataClear
9000: ; ------------------
9001: .endif
9002:
9003: ; B-27. Function Name: SECOND
9004: ;
9005: ; Purpose: Send secondary address for LISTEN
9006: ; Call address: $FF93 (hex) 65427 (decimal)
9007: ; Communication registers: A
9008: ; Preparatory routines: LISTEN
9009: ; Error returns: See READST
9010: ; Stack requirements: 8
9011: ; Registers affected: A
9012: ;
9013: ; Description: This routine is used to send a secondary address to an
9014: ; I/O device after a call to the LISTEN routine is made, and the device is
9015: ; commanded to LISTEN. The routine canNOT be used to send a secondary
9016: ; address after a call to the TALK routine.
9017: ; A secondary address is usually used to give setup information to a
9018: ; device before I/O operations begin.
9019: ; When a secondary address is to be sent to a device on the serial bus,
9020: ; the address must first be ORed with $60.
9021: ;
9022: ; How to Use:
9023: ;
9024: ; 1) load the accumulator with the secondary address to be sent.
9025: ; 2) Call this routine.
9026: ;
9027: ; EXAMPLE:
9028: ;
9029: ; ;ADDRESS DEVICE #8 WITH COMMAND (SECONDARY ADDRESS) #15
9030: ; LDA #8
9031: ; JSR LISTEN
9032: ; LDA #15
9033: ; JSR SECOND
9034: ;
9035: ;
9036: iSECOND:
9037: sta zBSOUR ; byte (secondary address after LISTEN) to be output
9038: jsr IecOutputByte2
9039:
9040: IEC_CLR_ATN:
9041:
9042: ; clear ATN state
9043: lda IEC_REG_ATN_OUT
9044: and #~IEC_B_ATN_OUT
9045: sta IEC_REG_ATN_OUT
9046:
9047: rts
9048:
9049: ; B-35. Function Name: TKSA
9050: ;
9051: ; Purpose: Send a secondary address to a device commanded to TALK
9052: ; Call address: $FF96 (hex) 65430 (decimal)
9053: ; Communication registers: A
9054: ; Preparatory routines: TALK
9055: ; Error returns: See READST
9056: ; Stack requirements: 8
9057: ; Registers affected: A
9058: ;
9059: ;
9060: ;
9061: ; Description: This routine transmits a secondary address on the serial
9062: ; bus for a TALK device. This routine must be called with a number between
9063: ; 0 and 31 in the accumulator. The routine sends this number as a secondary
9064: ; address command over the serial bus. This routine can only be called
9065: ; after a call to the TALK routine. It will not work after a LISTEN.
9066: ;
9067: ; How to Use:
9068: ;
9069: ; 0) Use the TALK routine.
9070: ; 1) Load the accumulator with the secondary address.
9071: ; 2) Call this routine.
9072: ;
9073: ; EXAMPLE:
9074: ;
9075: ; ;TELL DEVICE #4 TO TALK WITH COMMAND #7
9076: ; LDA #4
9077: ; JSR TALK
9078: ; LDA #7
9079: ; JSR TALKSA
9080: ;
9081: iTKSA:
9082: sta zBSOUR ; byte (secondary address after TALK) to be output
9083: jsr IecOutputByte2
9084:
9085: ; perform talk - listener - change (TODO)
9086:
9087: iTKSA2:
9088: sei
9089: jsr IecDataSet
9090: jsr IEC_CLR_ATN
9091: jsr IecClkClear
9092:
9093: @LEDD6:
9094: .ifdef JIFFY
9095: bit IEC_REG
9096: .else
9097: jsr IecGetDataClockIn
9098: .endif
9099:
9100: .ifdef JIFFY
9101: bvs @LEDD6
9102: .elseif CompileComputer >= C64_GENERAL
9103: bmi @LEDD6
9104: .else
9105: bcs @LEDD6
9106: .endif
9107: cli
9108: rts
9109:
9110: ; B-6. Function Name: CIOUT
9111: ;
9112: ; Purpose: Transmit a byte over the serial bus
9113: ; Call address: $FFA8 (hex) 65448 (decimal)
9114: ; Communication registers: A
9115: ; Preparatory routines: LISTEN, [SECOND]
9116: ; Error returns: See READST
9117: ; Stack requirements: 5
9118: ; Registers affected: None
9119: ;
9120: ; Description: This routine is used to send information to devices on the
9121: ; serial bus. A call to this routine will put a data byte onto the serial
9122: ; bus using full serial handshaking. Before this routine is called, the
9123: ; LISTEN KERNAL routine must be used to command a device on the serial bus
9124: ; to get ready to receive data. (If a device needs a secondary address, it
9125: ; must also be sent by using the SECOND KERNAL routine.) The accumulator is
9126: ; loaded with a byte to handshake as data on the serial bus. A device must
9127: ; be listening or the status word will return a timeout. This routine
9128: ; always buffers one character. (The routine holds the previous character
9129: ; to be sent back.) So when a call to the KERNAL UNLSN routine is made to
9130: ; end the data transmission, the buffered character is sent with an End Or
9131: ; Identify (EOI) set. Then the UNLSN command is sent to the device.
9132: ;
9133: ; How to Use:
9134: ;
9135: ; 0) Use the LISTEN KERNAL routine (and the SECOND routine if needed).
9136: ; 1) Load the accumulator with a byte of data.
9137: ; 2) Call this routine to send the data byte.
9138: ;
9139: ; EXAMPLE:
9140: ;
9141: ;
9142: ; LDA #'X ;SEND AN X TO THE SERIAL BUS
9143: ; JSR CIOUT
9144: ;
9145: ;
9146: iCIOUT:
9147: bit zC3PO ; check if there is already a byte buffered to be output
9148: bmi @SendBufferedChar ; there is one -> branch, send it
9149:
9150: sec ; there was none -> set bit 7 to mark that we now have a byte to be output
9151: ror zC3PO
9152:
9153: bne @NoCached ; uncond. branch: store the next byte to be output
9154: ; ------------------
9155:
9156: @SendBufferedChar:
9157: pha ; remember the new byte to be output
9158: .ifdef JIFFY
9159: jsr $FBFE
9160: .else
9161: jsr IecOutputByte ; output the old buffered byte
9162: .endif
9163: pla ; get back the new byte to be output
9164:
9165: @NoCached:
9166: sta zBSOUR ; store the new byte to be output on the next call
9167:
9168: clc ; mark: no error
9169: rts
9170: ; ------------------
9171:
9172:
9173: ; B-38. Function Name: UNTLK
9174: ;
9175: ; Purpose: Send an UNTALK command
9176: ; Call address: $FFAB (hex) 65451 (decimal)
9177: ; Communication registers: None
9178: ; Preparatory routines: None
9179: ; Error returns: See READST
9180: ; Stack requirements: 8
9181: ; Registers affected: A
9182: ;
9183: ; Description: This routine transmits an UNTALK command on the serial
9184: ; bus. All devices previously set to TALK will stop sending data when this
9185: ; command is received.
9186: ;
9187: ; How to Use:
9188: ; 1) Call this routine.
9189: ;
9190: ;
9191: ; EXAMPLE:
9192: ; JSR UNTALK
9193: ;
9194: iUNTLK:
9195: .if CompileComputer >= C64_GENERAL
9196: sei
9197: .endif
9198:
9199: ; make sure to signal the talker that we will take over the bus now!
9200:
9201: .ifdef JIFFY
9202: .else
9203: jsr IecClkSet
9204: .endif
9205:
9206: ; set ATN state
9207:
9208: lda IEC_REG_ATN_OUT
9209: ora #IEC_B_ATN_OUT
9210: sta IEC_REG_ATN_OUT
9211:
9212: .ifdef JIFFY
9213: jsr IecClkSet
9214: .endif
9215:
9216: lda #IEEE_UNTALK ; set command byte: UNTALK
9217:
9218: .byte ASM_BIT3 ; hide the next instruction
9219:
9220: ; B-37. Function Name: UNLSN
9221: ;
9222: ; Purpose: Send an UNLISTEN command
9223: ; Call address: $FFAE (hex) 65454 (decimal)
9224: ; Communication registers: None
9225: ; Preparatory routines: None
9226: ; Error returns: See READST
9227: ; Stack requirements: 8
9228: ; Registers affected: A
9229: ;
9230: ; Description: This routine commands all devices on the serial bus to
9231: ; stop receiving data from the Commodore 64 (i.e., UNLISTEN). Calling this
9232: ; routine results in an UNLISTEN command being transmitted on the serial
9233: ; bus. Only devices previously commanded to listen are affected. This
9234: ; routine is normally used after the Commodore 64 is finished sending data
9235: ; to external devices. Sending the UNLISTEN commands the listening devices
9236: ; to get off the serial bus so it can be used for other purposes.
9237: ;
9238: ; How to Use:
9239: ; 1) Call this routine.
9240: ;
9241: ; EXAMPLE:
9242: ; JSR UNLSN
9243: ;
9244: iUNLSN:
9245: lda #IEEE_UNLISTEN ; set command byte: UNLISTEN
9246:
9247: jsr IecOutputCommand ; output the command byte on the IEC bus
9248:
9249: .if CompileComputer = VIC20_02
9250: bne IEC_CLR_ATN ; done (bug)
9251: ; ---------------------
9252: .else
9253:
9254: IecClearAtnAndClockAndDataAfterDelay:
9255: jsr IEC_CLR_ATN ; clear ATN
9256:
9257: ; TODO document
9258:
9259: IecClearClockAndDataAfterDelay:
9260: txa
9261: .if CompileComputer >= C64_GENERAL
9262: ; TODO define
9263: ldx #10
9264: .else
9265: ldx #11
9266: .endif
9267: @Delay: dex
9268: bne @Delay
9269: tax
9270: jsr IecClkClear
9271: jmp IecDataClear
9272: .endif
9273:
9274: ; B-1. Function Name: ACPTR
9275: ;
9276: ; Purpose: Get data from the serial bus
9277: ; Call address: $FFA5 (hex) 65445 (decimal)
9278: ; Communication registers: A
9279: ; Preparatory routines: TALK, TKSA
9280: ; Error returns: See READST
9281: ; Stack requirements: 13
9282: ; Registers affected: A, X
9283: ;
9284: ;
9285: ;
9286: ; Description: This is the routine to use when you want to get informa-
9287: ; tion from a device on the serial bus, like a disk. This routine gets a
9288: ; byte of data off the serial bus using full handshaking. The data is
9289: ; returned in the accumulator. To prepare for this routine the TALK routine
9290: ; must be called first to command the device on the serial bus to send data
9291: ; through the bus. If the input device needs a secondary command, it must
9292: ; be sent by using the TKSA KERNAL routine before calling this routine.
9293: ; Errors are returned in the status word. The READST routine is used to
9294: ; read the status word.
9295: ;
9296: ;
9297: ; How to Use:
9298: ;
9299: ; 0) Command a device on the serial bus to prepare to send data to
9300: ; the Commodore 64. (Use the TALK and TKSA KERNAL routines.)
9301: ; 1) Call this routine (using JSR).
9302: ; 2) Store or otherwise use the data.
9303: ;
9304: ;
9305: ; EXAMPLE:
9306: ;
9307: ; ;GET A BYTE FROM THE BUS
9308: ; JSR ACPTR
9309: ; STA DATA
9310: ;
9311: ;
9312: ;
9313: iACPTR:
9314: .ifdef JIFFY
9315: jmp $FBAA
9316:
9317: .else
9318:
9319: sei ; make sure to be able to hold the timing
9320:
9321: .if CompileComputer < VIC20_06
9322: lda #8 ; 8 bits to be input
9323: .else
9324: lda #0 ; TODO: ???
9325: .endif
9326: .endif
9327:
9328: JDiACPTR:
9329: sta zCNTDN ; and store it as counter
9330:
9331:
9332:
9333: .if CompileComputer >= VIC20_06
9334: jsr IecClkClear ; clear CLOCK to signal: We are ready to handle the byte
9335: .endif
9336:
9337:
9338: @WaitDataInactive:
9339:
9340: ; wait for DATA to become inactive:
9341: ; That is, wait for the other side to be ready to send a byte
9342:
9343: jsr IecGetDataClockIn
9344: .if CompileComputer >= C64_GENERAL
9345: bpl @WaitDataInactive
9346: .else
9347: bcc @WaitDataInactive
9348: jsr IecDataClear ; clear DATA (unnecessary, as the loop would not terminate if we would not have data cleared!)
9349: .endif
9350:
9351: @LEE20:
9352:
9353: lda #>$0100 ; set timer to approx. 250 µs
9354: sta IEC_TIMER_HI
9355:
9356: .if CompileComputer >= C64_GENERAL
9357: ; start timer B with one-shot mode, no PB7, counting PHI2
9358: lda #CIA_CRB_B_START | CIA_CRB_B_ONESHOT | CIA_CRB_B_FORCE_LOAD
9359: sta CIA1 + CIA_O_CRB
9360:
9361: jsr IecDataClear ; clear DATA
9362:
9363: lda IEC_TIMER_FLAG_REG ; make sure the ICR is cleared, so we do not
9364: ; immediately stop the following loop because
9365: ; some other TB underflow condition has occurred before
9366:
9367: .endif
9368:
9369: @LEE30: lda IEC_TIMER_FLAG_REG
9370: and #IEC_TIMER_FLAG_B
9371: bne @LEE3E
9372:
9373: jsr IecGetDataClockIn
9374:
9375: .if CompileComputer >= C64_GENERAL
9376: bmi @LEE30
9377: bpl @LEE56
9378: .else
9379: bcs @LEE30
9380: bcc @LEE56
9381: .endif
9382:
9383:
9384: @LEE3E:
9385:
9386: .if CompileComputer = VIC20_02
9387:
9388: jsr IecDataSet
9389: txa
9390: ldx #$10
9391: @Delay: dex
9392: bne @Delay
9393: tax
9394: jsr IecDataClear
9395: jsr IecGetDataClockIn
9396:
9397: lda #$40 ; status bit: EOI
9398: jsr SetStatus ; set the status to EOI
9399:
9400: @LEE56: lda IEC_REG_DATA_CLK_IN
9401: cmp IEC_REG_DATA_CLK_IN
9402: bne @LEE56
9403: IEC_REG__CLOCK_IN_INTO_CARRY
9404: bcc @LEE56
9405: lsr a
9406: ror zTBTCNT
9407:
9408: @WaitClkInactive:
9409: lda IEC_REG_DATA_CLK_IN
9410: cmp IEC_REG_DATA_CLK_IN
9411: bne @WaitClkInactive
9412:
9413: IEC_REG__CLOCK_IN_INTO_CARRY
9414: bcs @WaitClkInactive
9415: dec zCNTDN
9416: bne @LEE56
9417: jsr IecDataSet
9418: lda zTBTCNT
9419: cli
9420: clc
9421: rts
9422:
9423: .else
9424:
9425: lda zCNTDN
9426: beq @Proceed
9427:
9428: lda #$02 ; set status: read timeout
9429: jmp IecSetStatusAndFreeBus ; ... and free the bus and exit
9430: ; ------------------
9431:
9432: @Proceed:
9433: jsr IecDataSet
9434: .if CompileComputer >= C64_GENERAL
9435: jsr IecClkClear
9436: .else
9437: jsr IecClearClockAndDataAfterDelay
9438: .endif
9439: lda #$40
9440: jsr SetStatus
9441: inc zCNTDN
9442: bne @LEE20
9443:
9444: @LEE56: lda #8 ; number of bits to be input
9445: sta zCNTDN
9446: @LEE5A:
9447: lda IEC_REG_DATA_CLK_IN
9448: cmp IEC_REG_DATA_CLK_IN
9449: bne @LEE5A
9450:
9451: .if CompileComputer >= C64_GENERAL
9452: asl a
9453: bpl @LEE5A
9454: .else
9455: lsr a
9456: bcc @LEE5A
9457: lsr a
9458: .endif
9459: ror zTBTCNT
9460: @LEE67:
9461: lda IEC_REG_DATA_CLK_IN
9462: cmp IEC_REG_DATA_CLK_IN
9463: bne @LEE67
9464: .if CompileComputer >= C64_GENERAL
9465: asl a
9466: bmi @LEE67
9467: .else
9468: lsr a
9469: bcs @LEE67
9470: .endif
9471:
9472: dec zCNTDN
9473: bne @LEE5A
9474: jsr IecDataSet
9475: .if CompileComputer >= C64_GENERAL
9476: bit zSTATUS
9477: bvc @LEE80
9478: .else
9479: lda zSTATUS
9480: beq @LEE80
9481: .endif
9482: jsr IecClearClockAndDataAfterDelay
9483: @LEE80: lda zTBTCNT
9484: cli
9485: clc
9486: rts
9487: .endif
9488:
9489: IecClkClear:
9490: ; clear (set inactive) the clock line
9491: lda IEC_REG_DATA_CLK_OUT
9492: and #~IEC_B_CLK_OUT
9493: sta IEC_REG_DATA_CLK_OUT
9494: rts
9495:
9496: IecClkSet:
9497: ; set (set active) the clock line
9498: lda IEC_REG_DATA_CLK_OUT
9499: ora #IEC_B_CLK_OUT
9500: sta IEC_REG_DATA_CLK_OUT
9501: rts
9502:
9503: .segment "KERNAL_IEC_DATA"
9504:
9505: IecDataClear:
9506: lda IEC_REG_DATA_CLK_OUT
9507: and #~IEC_B_DATA_OUT
9508: sta IEC_REG_DATA_CLK_OUT
9509: rts
9510: IecDataSet:
9511: lda IEC_REG_DATA_CLK_OUT
9512: ora #IEC_B_DATA_OUT
9513: sta IEC_REG_DATA_CLK_OUT
9514: rts
9515:
9516: ; reads in IEC register and returns
9517: ; * C64:
9518: ; - DATA IN in Carry
9519: ; - CLOCK IN in A & 0x80
9520: ; * VIC20:
9521: ; - CLOCK IN in Carry
9522: ; - DATA IN in A & 0x01
9523: ;
9524: IecGetDataClockIn:
9525: lda IEC_REG_DATA_CLK_IN
9526: cmp IEC_REG_DATA_CLK_IN
9527: bne IecGetDataClockIn
9528: .if CompileComputer >= C64_GENERAL
9529: asl a
9530: .else
9531: lsr a
9532: .endif
9533: rts
9534:
9535:
9536: .segment "KERNAL_IEC_DELAY"
9537:
9538: IecDelay1ms:
9539:
9540: .if CompileComputer >= C64_GENERAL
9541: txa
9542: ldx #184
9543: @Delay: dex
9544: bne @Delay
9545: tax
9546: .else
9547: lda #>$0400 ; program T2 for $0400 = 1024 cycles (approx. 1 ms)
9548: sta VIA2_T2CH ; (low byte is not written, thus, should be 0)
9549:
9550: ; wait for T2 flag being set in the IFR,
9551: ; telling us that the timer expired
9552: @Wait:
9553: lda VIA2_IFR
9554: and #VIA_IFR_B_T2
9555: beq @Wait
9556: .endif
9557: rts
9558:
9559: ; .include "../kernal/rs232.a65"
9560: LEEBB:
9561: lda zBITTS
9562: beq LEF06
9563: bmi @LEF00
9564: lsr zRODATA
9565: ldx #$00
9566: bcc @LEEC8
9567: dex
9568: @LEEC8:
9569: txa
9570: eor zROPRTY
9571: sta zROPRTY
9572: dec zBITTS
9573: beq @LEED7
9574: @LEED1:
9575: txa
9576: .if CompileComputer >= C64_GENERAL
9577: and #$04
9578: .else
9579: and #$20
9580: .endif
9581: sta zNXTBIT
9582: rts
9583:
9584: @LEED7:
9585: lda #$20
9586: bit lM51CDR
9587: beq @LEEF2
9588: bmi @LEEFC
9589: bvs @LEEF6
9590: lda zROPRTY
9591: bne @LEEE7
9592: @LEEE6:
9593: dex
9594: @LEEE7:
9595: dec zBITTS
9596: lda lM51CTR
9597: bpl @LEED1
9598: dec zBITTS
9599: bne @LEED1
9600: @LEEF2:
9601: inc zBITTS
9602: bne @LEEE6
9603: @LEEF6:
9604: lda zROPRTY
9605: beq @LEEE7
9606: bne @LEEE6
9607: @LEEFC:
9608: bvs @LEEE7
9609: bvc @LEEE6
9610: ; ------------------
9611:
9612: @LEF00:
9613: inc zBITTS
9614: ldx #$FF
9615: bne @LEED1
9616:
9617: LEF06:
9618: lda lM51CDR
9619: lsr a
9620: bcc @LEF13
9621: bit RS232_REG_2
9622: bpl LF016
9623: bvc LEF31
9624: @LEF13:
9625: lda #$00
9626: sta zROPRTY
9627: sta zNXTBIT
9628: ldx lBITNUM
9629: stx zBITTS
9630: ldy lRODBS
9631: cpy lRODBE
9632: beq LEF39
9633: lda (zROBUF),y
9634: sta zRODATA
9635: inc lRODBS
9636: rts
9637:
9638: LF016:
9639: lda #$40
9640: .byte ASM_BIT3
9641: LEF31:
9642: lda #$10
9643: ora lRSSTAT
9644: sta lRSSTAT
9645: LEF39:
9646: .if CompileComputer >= C64_GENERAL
9647: lda #CIA_ICR_B_TA
9648: LEF3B: sta CIA2 + CIA_O_ICR
9649: eor lENABL
9650: ora #CIA_ICR_BW_SET
9651: sta lENABL
9652: sta CIA2 + CIA_O_ICR
9653: .else
9654: lda #$40
9655: sta VIA1_IEC
9656: .endif
9657: rts
9658:
9659: ; get number of bits to transmit
9660: ;
9661: LEF4A:
9662: ldx #$09
9663: lda #$20
9664: bit lM51CTR
9665: beq @LEF54
9666: dex
9667: @LEF54:
9668: bvc @LEF58
9669: dex
9670: dex
9671: @LEF58:
9672: rts
9673: ; ---------------
9674:
9675: LEF59: ldx zRINONE
9676: bne LEF90
9677: dec zBITC1
9678: beq LEF97
9679: bmi LEF70
9680: lda zINBIT
9681: eor zRIPRTY
9682: sta zRIPRTY
9683: lsr zINBIT
9684: ror zRIDATA
9685: LEF6D: rts
9686:
9687: LEF6E: dec zBITC1
9688: LEF70: lda zINBIT
9689: beq LEFDB
9690: lda lM51CTR
9691: asl a
9692: lda #$01
9693: adc zBITC1
9694: bne LEF6D
9695: LEF7E:
9696: .if CompileComputer >= C64_GENERAL
9697: lda #CIA_ICR_B_FLAG | CIA_ICR_BW_SET
9698: sta CIA2 + CIA_O_ICR
9699: ora lENABL
9700: sta lENABL
9701: .else
9702: lda #$90
9703: sta VIA1_IEC
9704: .endif
9705: sta zRINONE
9706: .if CompileComputer >= C64_GENERAL
9707: lda #$02
9708: jmp LEF3B
9709: .else
9710: lda #$20
9711: sta VIA1_IEC
9712: rts
9713: .endif
9714:
9715: LEF90: lda zINBIT
9716: bne LEF7E
9717: .if CompileComputer >= C64_03 .AND CompileComputer <> C64_4064
9718: jmp LE4D3
9719: .else
9720: sta zRINONE
9721: rts
9722: .endif
9723:
9724: LEF97: ldy lRIDBE
9725: iny
9726: cpy lRIDBS
9727: beq @LEFCA
9728: sty lRIDBE
9729: dey
9730: lda zRIDATA
9731: ldx lBITNUM
9732: @LEFA9: cpx #$09
9733: beq @LEFB1
9734: lsr a
9735: inx
9736: bne @LEFA9
9737: @LEFB1: sta (zRIBUF),y
9738: lda #$20
9739: bit lM51CDR
9740: beq LEF6E
9741: bmi LEF6D
9742: lda zINBIT
9743: eor zRIPRTY
9744: beq @LEFC5
9745: bvs LEF6D
9746: .byte ASM_BIT3
9747: @LEFC5: bvc LEF6D
9748: lda #$01
9749: .byte ASM_BIT3
9750: @LEFCA: lda #$04
9751: .byte ASM_BIT3
9752: LEFCD: lda #$80
9753: .byte ASM_BIT3
9754: LEFD0: lda #$02
9755: ora lRSSTAT
9756: sta lRSSTAT
9757: jmp LEF7E
9758:
9759: LEFDB: lda zRIDATA
9760: bne LEFD0
9761: beq LEFCD
9762: .if CompileComputer < C64_GENERAL
9763: Rs232ErrIllegalDeviceNumber:
9764: jmp KErrIllegalDeviceNumber
9765: .endif
9766:
9767: RS232_CHKOUT:
9768: sta zDFLTO
9769: lda lM51CDR
9770: lsr a
9771: bcc LF012
9772: lda #$02
9773: bit RS232_REG_1
9774: bpl LF00D
9775: bne LF012
9776:
9777: @LEFF2:
9778: .if CompileComputer >= C64_GENERAL
9779: lda lENABL
9780: and #CIA_ICR_B_TB
9781: .else
9782: lda VIA1_IEC
9783: and #$30
9784: .endif
9785: bne @LEFF2
9786: @LEFF9:
9787: bit RS232_REG_1
9788: bvs @LEFF9
9789: lda RS232_REG_1
9790: ora #$02
9791: sta RS232_REG_1
9792: @LF006:
9793: bit RS232_REG_1
9794: bvs LF012
9795: bmi @LF006
9796:
9797: LF00D:
9798: .if CompileComputer >= C64_GENERAL
9799: lda #$40
9800: sta lRSSTAT
9801: .else
9802: jsr LF016
9803: .endif
9804: LF012: clc
9805: rts
9806:
9807:
9808: LF014:
9809:
9810: .if CompileComputer >= C64_GENERAL
9811: jsr LF028
9812: .endif
9813:
9814: ; Write a character to the RS232 output buffer
9815: ;
9816: ; The character is returned in A. If there is
9817: ; no character in the buffer, A will contain 0.
9818: ;
9819: ; For C64 and above, this function also
9820: ; sets lRSSTAT.3 (TODO: "buffer empty"?)
9821: ;
9822: RS232_PUTCHAR:
9823: ldy lRODBE ; is the output buffer read pointer
9824: iny ; + 1
9825: cpy lRODBS ; equal to the output buffer write pointer?
9826: beq LF014 ; yes -> ring buffer is full -> wait until it is empty again
9827:
9828: sty lRODBE ; advance the output buffer write pointer, leaving room for the character to be written
9829:
9830: dey ; the location we reserved the space for is one before, thus, decrement Y again
9831:
9832: .if CompileComputer >= C64_GENERAL
9833: lda zPTR1
9834: .endif
9835: sta (zROBUF),y ; store the output character into the output buffer
9836:
9837: .if CompileComputer >= C64_GENERAL
9838: LF028: lda lENABL
9839: lsr a ; test CIA_ICR_B_TA
9840: bcs @Rts
9841: lda #CIA_CRA_B_FORCE_LOAD
9842: sta CIA2 + CIA_O_CRA
9843: .else
9844: bit VIA1_IEC
9845: bvc @LF102
9846: rts
9847: @LF102:
9848:
9849: .endif
9850:
9851: lda lBAUDOF
9852: sta RS232_TIMER_LO
9853: lda lBAUDOF + 1
9854: sta RS232_TIMER_HI
9855:
9856: .if CompileComputer >= C64_GENERAL
9857: lda #$81
9858: jsr LEF3B
9859: jsr LEF06
9860: lda #$11
9861: sta CIA2 + CIA_O_CRA
9862: @Rts: rts
9863: .else
9864: lda #$C0
9865: sta VIA1_IEC
9866: jmp LEF06
9867: .endif
9868:
9869: RS232_CHKIN:
9870: sta zDFLTN ; set default output device
9871: lda lM51CDR
9872: lsr a
9873: bcc @LF07D
9874: and #$08
9875: beq @LF07D
9876: lda #$02
9877: bit RS232_REG_1
9878: bpl LF00D
9879: beq @ClcRts
9880:
9881: @LF062:
9882: .if CompileComputer >= C64_GENERAL
9883: lda lENABL
9884: lsr a ; test CIA_ICR_B_TA
9885: bcs @LF062
9886: .else
9887: bit VIA1_IEC
9888: bvs @LF062
9889: .endif
9890:
9891: lda RS232_REG_1
9892: and #~$02
9893: sta RS232_REG_1
9894: @LF070:
9895: lda RS232_REG_1
9896: and #$04
9897: beq @LF070
9898: @LF077: lda #$90
9899: .if CompileComputer >= C64_GENERAL
9900: clc
9901: jmp LEF3B
9902: .else
9903: sta VIA1_IEC
9904: @ClcRts:
9905: clc
9906: rts
9907: .endif
9908:
9909: @LF07D:
9910:
9911: .if CompileComputer >= C64_GENERAL
9912: lda lENABL
9913: and #CIA_ICR_B_FLAG | CIA_ICR_B_TB
9914: .else
9915: lda VIA1_IEC
9916: and #$30
9917: .endif
9918: beq @LF077
9919:
9920: .if CompileComputer >= C64_GENERAL
9921: @ClcRts:
9922: .endif
9923: clc
9924: rts
9925:
9926: ; Read a character from the RS232 input buffer
9927: ;
9928: ; The character is returned in A. If there is
9929: ; no character in the buffer, A will contain 0.
9930: ;
9931: ; For C64 and above, this function also
9932: ; sets lRSSTAT.3 (TODO: "buffer empty"?)
9933: ;
9934: RS232_GETCHAR:
9935:
9936: .if CompileComputer >= C64_GENERAL
9937: lda lRSSTAT ; as we modifiy lRSSTAT, make its value available for both if() cases.
9938: .endif
9939:
9940: ldy lRIDBS ; get read buffer into RS232 input buffer
9941: cpy lRIDBE ; compare with write buffer
9942: beq @BufferEmpty ; they are the same -> input buffer empty -> skip reading
9943:
9944: .if CompileComputer >= C64_GENERAL
9945: and #~$08
9946: sta lRSSTAT ; clear bit: buffer is not empty (TODO?)
9947: .endif
9948: lda (zRIBUF),y ; get character from buffer
9949: inc lRIDBS ; increment read pointer
9950: rts
9951: ; ---------------
9952:
9953: @BufferEmpty:
9954:
9955: .if CompileComputer >= C64_GENERAL
9956: ora #$08
9957: sta lRSSTAT ; set bit: buffer empty (TODO?)
9958: .endif
9959: lda #$00 ; return: no character in buffer
9960: rts
9961: ; ---------------
9962:
9963:
9964: LF0A4:
9965:
9966: pha
9967: .if CompileComputer >= C64_GENERAL
9968: lda lENABL
9969: .else
9970: lda VIA1_IEC
9971: .endif
9972: beq @PlaRts
9973:
9974: @Wait:
9975:
9976: .if CompileComputer >= C64_GENERAL
9977: lda lENABL
9978: and #CIA_ICR_B_TA | CIA_ICR_B_TB
9979: .else
9980: lda VIA1_IEC
9981: and #VIA_IER_B_T1 | VIA_IER_B_T2
9982: .endif
9983: bne @Wait
9984:
9985: .if CompileComputer >= C64_GENERAL
9986: lda #CIA_ICR_B_FLAG
9987: sta CIA2 + CIA_O_ICR
9988: .else
9989: lda #VIA_IER_B_CB1
9990: sta VIA1_IEC
9991: .endif
9992:
9993: .if CompileComputer >= C64_GENERAL
9994: lda #$00
9995: sta lENABL
9996: .endif
9997:
9998: @PlaRts:
9999: pla
10000: rts
10001:
10002: ; .include "../kernal/message.a65"
10003: ; KERNAL system essages
10004:
10005: LMESSAGES:
10006:
10007: StrIoError:
10008: .byte ASC_CR
10009: htasc "I/O ERROR #" ; used in case an I/O error occurs in a KERNAL routine, and zNSGFLG.6 is set
10010:
10011: StrSearching:
10012: .byte ASC_CR
10013: htasc "SEARCHING " ; used when loading, and zNSGFLG.7 is set
10014:
10015: StrFor:
10016: htasc "FOR " ; used when loading with a file name, and zNSGFLG.7 is set
10017:
10018: StrPlay:
10019:
10020: .ifdef JIFFY
10021:
10022: StrRecPlay = $F0EB
10023:
10024: JDLF0D8:
10025: lda #$00
10026: sta VIC + VICII_O_SprEnable
10027: @JDLF0DD:
10028: adc #$01
10029: bne @JDLF0DD
10030: rts
10031:
10032: JDLF0E2:
10033: lda zPTR2
10034: JDLF0E4:
10035: pha
10036: jsr kCLRCHN
10037: pla
10038: tax
10039: jmp kCHKIN
10040:
10041: JDLF0ED:
10042: lda #$00
10043: sta zTSFCNT
10044: jmp IecDataClear
10045:
10046: JDLF0F4:
10047: txa
10048: pha
10049: jsr JDLF7A2
10050: pla
10051: tax
10052: @JDLF0FB:
10053: lda JDLF398,x
10054: jsr kCHROUT
10055: inx
10056: dey
10057: bne @JDLF0FB
10058: rts
10059:
10060: .else
10061:
10062: .if CompileComputer = C64_SX64
10063:
10064: ; the SX64 does not have a tape, thus, "PRESS PLAY ON TAPE" is not needed there
10065: ; However, it redefines the Shift+Run/STOP message. This alternative message
10066: ; can be found here:
10067:
10068: TEXT_LOAD_8_RUN:
10069: .byte "LOAD",'"',":*",'"',",8",ASC_CR
10070: .byte "RUN",ASC_CR
10071: END_TEXT_LOAD_8_RUN:
10072:
10073: .else
10074: .byte ASC_CR,"PRESS PLAY ON " ; used when loading from tape (on the 4064, zNSGFLG.7 has to be set, too)
10075: .endif
10076: htasc "TAPE" ; remaining part of the "PRESS PLAY ON TAPE" message
10077:
10078: StrRecPlay:
10079: htasc "PRESS RECORD & PLAY ON TAPE" ; used when storing to tape (on the 4064, zNSGFLG.7 has to be set, too)
10080:
10081: .endif
10082:
10083: StrLoading:
10084: .byte ASC_CR
10085: htasc "LOADING" ; used when KERNAL LOAD is executed, and zNSGFLG.7 is set
10086:
10087: StrSaving:
10088: .byte ASC_CR
10089: htasc "SAVING " ; used when KERNAL SAVE is executed, and zNSGFLG.7 is set
10090:
10091: StrVerifying:
10092: .byte ASC_CR
10093: htasc "VERIFYING" ; used when KERNAL VERIFY is executed, and zNSGFLG.7 is set
10094:
10095: StrFound:
10096: .byte ASC_CR
10097: htasc "FOUND " ; used when loading from tape
10098: StrOk:
10099: .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)
10100:
10101:
10102: OutputMessageIfAllowed:
10103: bit zNSGFLG ; check KERNAL output policy
10104: bpl OutputMessage_ClcRts ; bit 7 unset -> policy forbids output -> branch, all done
10105:
10106: OutputMessage:
10107: lda LMESSAGES,y ; get character from message
10108: php ; remember status (especially N, which represents bit 7 of the message)
10109:
10110: and #$7F ; delete bit 7 (which acts as an end marker)
10111: jsr kCHROUT ; output the character
10112: iny ; proceed to next character
10113:
10114: plp ; get back N as indicator for bit 7 of the message
10115: bpl OutputMessage ; bit 7 was not set -> process to next character
10116:
10117: OutputMessage_ClcRts:
10118: clc ; mark: no error
10119: rts
10120: ; -------------------
10121: ; .include "../kernal/fileio.a65"
10122: ; B-11. Function Name: GETIN
10123: ;
10124: ;
10125: ; Purpose: Get a character
10126: ; Call address: $FFE4 (hex) 65508 (decimal)
10127: ; Communication registers: A
10128: ; Preparatory routines: CHKIN, OPEN
10129: ; Error returns: See READST
10130: ; Stack requirements: 7+
10131: ; Registers affected: A (X, Y)
10132: ;
10133: ; Description: If the channel is the keyboard, this subroutine removes
10134: ; one character from the keyboard queue and returns it as an ASCII value in
10135: ; the accumulator. If the queue is empty, the value returned in the
10136: ; accumulator will be zero. Characters are put into the queue automatically
10137: ; by an interrupt driven keyboard scan routine which calls the SCNKEY
10138: ; routine. The keyboard buffer can hold up to ten characters. After the
10139: ; buffer is filled, additional characters are ignored until at least one
10140: ; character has been removed from the queue. If the channel is RS-232, then
10141: ; only the A register is used and a single character is returned. See
10142: ; READST to check validity. If the channel is serial, cassette, or screen,
10143: ; call BASIN routine.
10144: ;
10145: ;
10146: ; How to Use:
10147: ;
10148: ; 1) Call this routine using a JSR instruction.
10149: ; 2) Check for a zero in the accumulator (empty buffer).
10150: ; 3) Process the data.
10151: ;
10152: ;
10153: ; EXAMPLE:
10154: ;
10155: ; ;WAIT FOR A CHARACTER
10156: ; WAIT JSR GETIN
10157: ; CMP #0
10158: ; BEQ WAIT
10159: ;
10160:
10161: KGETIN:
10162: lda zDFLTN ; get device address
10163: bne @NoKeyboard ; != 0 --> not the keyboard
10164: lda zNDX ; are there characters in the key buffer?
10165: beq ClcRts1 ; no, next test
10166: sei ; protect the keyboard buffer
10167: jmp GETIN_KEYB ; get key from keyboard buffer
10168:
10169: @NoKeyboard:
10170: cmp #FILE_RS232 ; device address = RS232 device?
10171: bne LF166 ; no, next test
10172:
10173: KGETIN_RS232:
10174: sty zTEMPX ; save Y in order to leave it unchanged
10175: jsr RS232_GETCHAR ; get a character from RS232
10176: ldy zTEMPX ; restore Y
10177:
10178: .if CompileComputer >= C64_GENERAL
10179: ClcRts1:
10180: .endif
10181:
10182: clc
10183: rts
10184:
10185: ; B-4. Function Name: CHRIN a.k.a. BASIN
10186: ;
10187: ; Purpose: Get a character from the input channel
10188: ; Call address: $FFCF (hex) 65487 (decimal)
10189: ; Communication registers: A
10190: ; Preparatory routines: (OPEN, CHKIN)
10191: ; Error returns: 0 (See READST)
10192: ; Stack requirements: 7+
10193: ; Registers affected: A, X
10194: ;
10195: ; Description: This routine gets a byte of data from a channel already
10196: ; set up as the input channel by the KERNAL routine CHKIN. If the CHKIN has
10197: ; NOT been used to define another input channel, then all your data is
10198: ; expected from the keyboard. The data byte is returned in the accumulator.
10199: ; The channel remains open after the call.
10200: ; Input from the keyboard is handled in a special way. First, the cursor
10201: ; is turned on, and blinks until a carriage return is typed on the
10202: ; keyboard. All characters on the line (up to 88 characters) are stored in
10203: ; the BASIC input buffer. These characters can be retrieved one at a time
10204: ; by calling this routine once for each character. When the carriage return
10205: ; is retrieved, the entire line has been processed. The next time this
10206: ; routine is called, the whole process begins again, i.e., by flashing the
10207: ; cursor.
10208: ;
10209: ; How to Use:
10210: ;
10211: ; FROM THE KEYBOARD
10212: ;
10213: ; 1) Retrieve a byte of data by calling this routine.
10214: ; 2) Store the data byte.
10215: ; 3) Check if it is the last data byte (is it a CR?)
10216: ; 4) If not, go to step 1.
10217: ;
10218: ; EXAMPLE:
10219: ;
10220: ; LDY $#00 ;PREPARE THE Y REGISTER TO STORE THE DATA
10221: ; RD JSR CHRIN
10222: ; STA DATA,Y ;STORE THE YTH DATA BYTE IN THE YTH
10223: ; ;LOCATION IN THE DATA AREA.
10224: ; INY
10225: ; CMP #CR ;IS IT A CARRIAGE RETURN?
10226: ; BNE RD ;NO, GET ANOTHER DATA BYTE
10227: ;
10228: ;
10229: ;
10230: ; EXAMPLE:
10231: ;
10232: ; JSR CHRIN
10233: ; STA DATA
10234: ;
10235: ; FROM OTHER DEVICES
10236: ;
10237: ; 0) Use the KERNAL OPEN and CHKIN routines.
10238: ; 1) Call this routine (using a JSR instruction).
10239: ; 2) Store the data.
10240: ;
10241: ; EXAMPLE:
10242: ;
10243: ; JSR CHRIN
10244: ; STA DATA
10245: ;
10246: ;
10247: KBASIN:
10248: lda zDFLTN ; get device address
10249: .ifdef JIFFY
10250: bne JDLF1A9
10251: .else
10252: bne LF166 ; not keyboard --> jump
10253: .endif
10254:
10255: ; TODO
10256: lda zPNTR ; remember zPNTR (current column on screen) in zTEMP_zPNTR
10257: sta zTEMP_zPNTR ; for later restoration
10258:
10259: lda zTBLX ; remember zTBLX (current row on screen) in zLXSP
10260: sta zLXSP
10261:
10262: jmp BASIN_KEYB ; input character from the screen
10263: ; ---------------------
10264:
10265: LF166: cmp #FILE_SCREEN ; device address == screen?
10266: bne KBASIN_NoScreen ; no, next test
10267:
10268: ; TODO
10269: JDLF16A:
10270: sta zCRSW ; zCRSW := 3 --> mark that we do not wait for key pressed until CR has been pressed
10271:
10272: lda zLNMX ; logical line length of the current line
10273: sta zINDX ; is the number of characters in this line
10274:
10275: jmp BASIN_KEYB ; input character from the screen
10276: ; ---------------------
10277:
10278: KBASIN_NoScreen:
10279: bcs KBASIN_TestIec ; greater than screen (that is, IEC bus) --> jump
10280: cmp #FILE_RS232 ; is it from RS232?
10281: beq BASIN_RS232 ; Yes, process RS232
10282:
10283: .ifdef JIFFY
10284: JDLF179:
10285: jsr JDLFBAA
10286: pha
10287: bit zTSFCNT
10288: bvc LF19C
10289: cpx #$00
10290: bne LF187
10291: lda $C4
10292: LF187: cmp #$04
10293: bcc LF19C
10294: ldy #$00
10295: lda (zFNADR),y
10296: cmp #$24
10297: beq LF19C
10298: inc zSA
10299: jsr JDLF38B
10300: dec zSA
10301: asl zTSFCNT
10302: LF19C: pla
10303: rts
10304: LF19E: lda #$10
10305: jmp SetStatus
10306:
10307: LF1A3: .addr PatchErrorOut
10308: .addr IMAIN
10309: .addr LA57C
10310:
10311: JDLF1A9:
10312: cmp #$04
10313: bcc LF166
10314:
10315: .else
10316: ; if we are here, we want to get input from TAPE
10317:
10318: stx zTEMPX ; remember X
10319: jsr @GetNextTapeCharacterFromBuffer ; read in the next character from the tape buffer
10320: bcs @Ret_No_PLA ; if an error occurred, stop here
10321:
10322: ; Find out if we can read even one more character, and that character is not 0.
10323: ; Note that we only test for it. The value will be disregarded, and the tape buffer pointer
10324: ; will be set backwards afterwards!
10325:
10326: pha ; remember the read character
10327: jsr @GetNextTapeCharacterFromBuffer ; read in the next character from the tape buffer
10328: bcs @Ret_With_PLA ; if an error occurred, stop here, making sure to PLA the remembered character
10329:
10330: bne @NoNulCharacter ; no NUL ($00) character -> branch, skip setting the status flag
10331:
10332: ; mark an end-of-file status
10333: lda #STATUS_TAPE_EOF
10334: jsr SetStatus
10335:
10336: @NoNulCharacter:
10337: dec zBUFPNT ; put tape buffer pointer backwards, so we will read the same byte again in the next call
10338:
10339: ldx zTEMPX ; get back (remembered) X
10340: pla ; get back remembered character
10341: rts
10342: ; ----------------------
10343:
10344: @Ret_With_PLA:
10345: tax
10346: pla
10347: txa
10348:
10349: @Ret_No_PLA:
10350: ldx zTEMPX ; get back (remembered) X
10351: rts
10352: ; ----------------------
10353:
10354: @GetNextTapeCharacterFromBuffer:
10355: jsr TAPE_INCREMENT_WRITE_POINTER ; increment the pointer into the tape buffer
10356: bne @ReadTapeBuffer ; Z = 0 --> there are still bytes to read --> branch, read bytes
10357:
10358: ; we must read in the next tape buffer from tape
10359:
10360: jsr TapeReadNextBuffer ; read in the next tape buffer
10361: bcs BASIN_RTS1 ; C = 1 --> an error occurred -> branch, return with C = 1 indicating an error
10362:
10363: lda #0 ; set tape buffer pointer to 0 (will be incremented directly afterwards)
10364: sta zBUFPNT ; this ensures we skip the tape buffer type marker at position 0.
10365:
10366: beq @GetNextTapeCharacterFromBuffer ; (uncond. branch) retry reading the tape buffer
10367: ; ------------------
10368:
10369: @ReadTapeBuffer:
10370: lda (zTAPE1),y
10371: clc
10372: rts
10373: .endif
10374:
10375: KBASIN_TestIec:
10376: ; Input from IEC bus
10377: lda zSTATUS ; current status
10378: beq BASIN_IEC ; == 0 --> jump, get byte from IEC bus
10379:
10380: ReturnCR:
10381: lda #ASC_CR ; an error or EOI occurred on the IEC bus, return CR
10382:
10383: .if CompileComputer < C64_GENERAL
10384: ClcRts1:
10385: .endif
10386: ClcRts2:
10387: clc
10388: .if CompileComputer >= C64_GENERAL
10389: BASIN_RTS2:
10390: .endif
10391: BASIN_RTS1:
10392: rts
10393:
10394: BASIN_IEC:
10395: .ifdef JIFFY
10396: jmp JDLFBAA
10397: .else
10398: jmp iACPTR
10399: .endif
10400:
10401: BASIN_RS232:
10402: ; get data from RS232
10403: jsr KGETIN_RS232 ; get character from RS232, or 0 if empty
10404: bcs BASIN_RTS2
10405:
10406: cmp #0 ; did we read a 0 (buffer empty)?
10407:
10408: .if CompileComputer >= C64_GENERAL
10409: bne ClcRts2 ; no -> return with the current character
10410:
10411: lda lRSSTAT ; check lRSSTAT (TODO)
10412: and #$60 ; TODO: Meaning of the bits?
10413: bne ReturnCR ; bits are not null -> return with ASCII CR instead of waiting
10414: beq BASIN_RS232 ; wait until there is a character received from RS232
10415: ; -------------------
10416: .else
10417: beq BASIN_RS232 ; yes, wait until there is a character received from RS232
10418: clc ; return: No error
10419:
10420: BASIN_RTS2:
10421: rts
10422: ; --------------------
10423: .endif
10424: ; --------------------
10425:
10426: ; B-5. Function Name: CHROUT a.k.a. BSOUT
10427: ;
10428: ; Purpose: Output a character
10429: ; Call address: $FFD2 (hex) 65490 (decimal)
10430: ; Communication registers: A
10431: ; Preparatory routines: (CHKOUT,OPEN)
10432: ; Error returns: 0 (See READST)
10433: ; Stack requirements: 8+
10434: ; Registers affected: A
10435: ;
10436: ; Description: This routine outputs a character to an already opened
10437: ; channel. Use the KERNAL OPEN and CHKOUT routines to set up the output
10438: ; channel before calling this routine, If this call is omitted, data is
10439: ; sent to the default output device (number 3, the screen). The data byte
10440: ; to be output is loaded into the accumulator, and this routine is called.
10441: ; The data is then sent to the specified output device. The channel is left
10442: ; open after the call.
10443: ;
10444: ; +-----------------------------------------------------------------------+
10445: ; | NOTE: Care must be taken when using this routine to send data to a |
10446: ; | specific serial device since data will be sent to all open output |
10447: ; | channels on the bus. Unless this is desired, all open output channels |
10448: ; | on the serial bus other than the intended destination channel must be |
10449: ; | closed by a call to the KERNAL CLRCHN routine. |
10450: ; +-----------------------------------------------------------------------+
10451: ;
10452: ;
10453: ;
10454: ; How to Use:
10455: ;
10456: ; 0) Use the CHKOUT KERNAL routine if needed, (see description above).
10457: ; 1) Load the data to be output into the accumulator.
10458: ; 2) Call this routine.
10459: ;
10460: ; EXAMPLE:
10461: ;
10462: ; ;DUPLICATE THE BASIC INSTRUCTION CMD 4,"A";
10463: ; LDX #4 ;LOGICAL FILE #4
10464: ; JSR CHKOUT ;OPEN CHANNEL OUT
10465: ; LDA #'A
10466: ; JSR CHROUT ;SEND CHARACTER
10467: ;
10468: ;
10469: KBSOUT:
10470: pha ; remember character to be output
10471: lda zDFLTO ; get output device
10472: cmp #FILE_SCREEN ; is it the screen?
10473: bne @NoScreen ; no -> jump, test other devices
10474: pla ; get back the character to be output
10475: jmp CHROUT_SCREEN ; output to screen
10476: ; ----------------------
10477:
10478: @NoScreen:
10479: 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
10480: pla ; get back the character to be output
10481: jmp iCIOUT ; output character to the IEC bus
10482:
10483: @NoIec:
10484: .if CompileComputer >= C64_GENERAL
10485: ; here, A can only contain 0, 1 or 2. "1" is tape, "2" is RS232.
10486: ; TODO: Can it contain 0 at all?
10487:
10488: lsr a ; prepare comparison with RS232 device
10489: ; if C == 1, than output is to tape. If C == 0, then output is to console (0 - TODO) or RS232 (2).
10490:
10491: .else
10492: cmp #FILE_RS232 ; output device = RS232?
10493: beq KBSOUT_RS232 ; yes -> jump, output to RS232
10494: .endif
10495:
10496: pla ; get back the character to be output
10497:
10498: KBSOUT_TAPE:
10499:
10500: sta zPTR1 ; remember character to be output
10501:
10502: .if CompileComputer < C64_GENERAL
10503: pha ; remember character to be output on stack
10504: .endif
10505: txa ; remember X
10506: pha ; on stack
10507: tya ; remember Y
10508: pha ; on stack
10509:
10510: .if CompileComputer >= C64_GENERAL
10511: bcc KBSOUT_RS232 ; we want to output onto RS232 (TODO: Or console (0)?) --> jump
10512: .endif
10513:
10514: ; if we reached here, it is BSOUT on tape
10515:
10516: .ifdef JIFFY
10517: jmp JDLF3F1
10518:
10519: JDLF1E8:
10520: jsr JDLF8BF
10521: jsr JDLE4C6
10522: cmp #$30
10523: rts
10524: jsr bGTBYTC
10525: stx zFA
10526: jsr JDLF75C
10527: stx zFSBLK
10528: rts
10529:
10530: .else
10531: jsr TAPE_INCREMENT_WRITE_POINTER ; increment pointer into tape buffer, and return it in Y
10532: bne @BufferNotYetFull ; buffer not yet full -> jump
10533:
10534: ; the tape buffer is full, write out the buffer and create a new one
10535: ;
10536: jsr TapeWriteCompleteBuffer ; write out the tape buffer to tape
10537: bcs BSOUT_Quit ; C = 1 -> error -> quit
10538:
10539: lda #TAPE_BUFFER_TYPE_CONTINUATION ; mark the buffer: It is a continuation buffer
10540: ldy #TAPE_BUFFER_OFFSET_TYPE ; new pointer into the tape buffer
10541: sta (zTAPE1),y ; store the mark for the buffer that it is a continuation buffer
10542: iny ; advance buffer pointer
10543: sty zBUFPNT ; and remember it
10544:
10545: @BufferNotYetFull:
10546: lda zPTR1 ; get character to be output
10547: sta (zTAPE1),y ; put it into the tape buffer
10548:
10549: .endif
10550:
10551: BSOUT_QuitSuccess:
10552: clc ; mark: We quit with success
10553:
10554: BSOUT_Quit:
10555: pla ; restore Y from stack
10556: tay
10557: pla ; restore X from stack
10558: tax
10559: .if CompileComputer >= C64_GENERAL
10560: lda zPTR1 ; restore A (character to be output)
10561: .else
10562: pla ; restore A (character to be output) from stack
10563: .endif
10564:
10565: bcc @Rts ; if routine was successfull, skip next instruction
10566: lda #0 ; set error number to 0 (TODO: why 0?)
10567: @Rts: rts
10568:
10569: KBSOUT_RS232:
10570:
10571: .if CompileComputer < C64_GENERAL
10572: pla ; restore A (character to be output) from stack
10573: stx zTEMPX ; remember X
10574: sty zPTR1 ; and Y
10575: .endif
10576:
10577: jsr RS232_PUTCHAR ; put character in A into RS232 output buffer
10578:
10579: .if CompileComputer >= C64_GENERAL
10580: jmp BSOUT_QuitSuccess
10581: ; -----------------------
10582: .else
10583: ldx zTEMPX ; restore X
10584: ldy zPTR1 ; and Y
10585: clc ; mark: success
10586: rts
10587: ; -----------------------
10588: .endif
10589: ; -----------------------
10590:
10591: ; B-2. Function Name: CHKIN
10592: ;
10593: ; Purpose: Open a channel for input
10594: ; Call address: $FFC6 (hex) 65478 (decimal)
10595: ; Communication registers: X
10596: ; Preparatory routines: (OPEN)
10597: ; Error returns:
10598: ; Stack requirements: None
10599: ; Registers affected: A, X
10600: ;
10601: ;
10602: ; Description: Any logical file that has already been opened by the
10603: ; KERNAL OPEN routine can be defined as an input channel by this routine.
10604: ; Naturally, the device on the channel must be an input device. Otherwise
10605: ; an error will occur, and the routine will abort.
10606: ; If you are getting data from anywhere other than the keyboard, this
10607: ; routine must be called before using either the CHRIN or the GETIN KERNAL
10608: ; routines for data input. If you want to use the input from the keyboard,
10609: ; and no other input channels are opened, then the calls to this routine,
10610: ; and to the OPEN routine are not needed.
10611: ; When this routine is used with a device on the serial bus, it auto-
10612: ; matically sends the talk address (and the secondary address if one was
10613: ; specified by the OPEN routine) over the bus.
10614: ;
10615: ; How to Use:
10616: ;
10617: ; 0) OPEN the logical file (if necessary; see description above).
10618: ; 1) Load the X register with number of the logical file to be used.
10619: ; 2) Call this routine (using a JSR command).
10620: ;
10621: ;
10622: ; Possible errors are:
10623: ;
10624: ; #3: File not open
10625: ; #5: Device not present
10626: ; #6: File not an input file
10627: ;
10628: ; EXAMPLE:
10629: ;
10630: ; ;PREPARE FOR INPUT FROM LOGICAL FILE 2
10631: ; LDX #2
10632: ; JSR CHKIN
10633: ;
10634: KCHKIN:
10635: jsr FindFileAndClearStatus ; find index for file no. in X, return in X
10636: beq @Found ; Z=1 -> has been found, branch and process
10637: jmp KErrFileNotOpen ; return with "file not open" error
10638:
10639: @Found:
10640: jsr SetActiveFile ; set the active file to the parameters of the file just found
10641: lda zFA ; get device number (of output file)
10642: beq @SetDefault ; console (0) --> set it, quit with success
10643:
10644: cmp #FILE_SCREEN
10645: beq @SetDefault ; screen (3) --> set it, quit with success
10646:
10647: bcs @Iec ; > 3 ( = some IEC device) -> special processing for IEC device
10648:
10649: cmp #FILE_RS232 ; rs232 (2)?
10650: bne @Tape ; no -> only tape left -> process tapes
10651:
10652: jmp RS232_CHKIN ; special processing for RS232 CHKIN
10653:
10654: ; special processing for TAPE:
10655: ; check if the tape file is opened as input
10656:
10657: @Tape:
10658: ldx zSA ; check secondary address
10659: cpx #$60 ; = $60 (output file)?
10660: beq @SetDefault ; yes, set it as default device
10661: jmp KErrNotInputFile ; return with error: Not Input File
10662:
10663: @SetDefault:
10664: sta zDFLTN ; set default output device
10665: clc ; mark: success
10666: rts
10667: ; -----------------
10668:
10669: ; Special processing for IEC:
10670: ; tell device to talk to use (TALK)
10671:
10672: @Iec:
10673: tax ; remember device address in X
10674: jsr iTALK ; give device in A a TALK command
10675:
10676: lda zSA ; get secondary address
10677: bpl @SecondaryAddress ; In range $00..$7F? -> give secondary address
10678:
10679: jsr iTKSA2 ; no secondary address, but perform talker - listener - exchange
10680: jmp @CheckStatus
10681:
10682: @SecondaryAddress:
10683: jsr iTKSA ; set secondary address after TALK
10684:
10685: @CheckStatus:
10686: txa ; get back device number
10687:
10688: bit zSTATUS ; check status
10689: bpl @SetDefault ; bit 7 (device not present) unset -> success -> set device as default input device
10690:
10691: jmp KErrDeviceNotPresent ; return with error: Device Not Present
10692: ; -----------------------------
10693:
10694: ; B-3. Function Name: CHKOUT
10695: ;
10696: ; Purpose: Open a channel for output
10697: ; Call address: $FFC9 (hex) 65481 (decimal)
10698: ; Communication registers: X
10699: ; Preparatory routines: (OPEN)
10700: ; Error returns: 0,3,5,7 (See READST)
10701: ; Stack requirements: 4+
10702: ; Registers affected: A, X
10703: ;
10704: ; Description: Any logical file number that has been created by the
10705: ; KERNAL routine OPEN can be defined as an output channel. Of course, the
10706: ; device you intend opening a channel to must be an output device.
10707: ; Otherwise an error will occur, and the routine will be aborted.
10708: ; This routine must be called before any data is sent to any output
10709: ; device unless you want to use the Commodore 64 screen as your output
10710: ; device. If screen output is desired, and there are no other output chan-
10711: ; nels already defined, then calls to this routine, and to the OPEN routine
10712: ; are not needed.
10713: ; When used to open a channel to a device on the serial bus, this routine
10714: ; will automatically send the LISTEN address specified by the OPEN routine
10715: ; (and a secondary address if there was one).
10716: ;
10717: ; How to Use:
10718: ; +-----------------------------------------------------------------------+
10719: ; | REMEMBER: this routine is NOT NEEDED to send data to the screen. |
10720: ; +-----------------------------------------------------------------------+
10721: ; 0) Use the KERNAL OPEN routine to specify a logical file number, a
10722: ; LISTEN address, and a secondary address (if needed).
10723: ; 1) Load the X register with the logical file number used in the open
10724: ; statement.
10725: ; 2) Call this routine (by using the JSR instruction).
10726: ;
10727: ; EXAMPLE:
10728: ;
10729: ; LDX #3 ;DEFINE LOGICAL FILE 3 AS AN OUTPUT CHANNEL
10730: ; JSR CHKOUT
10731: ;
10732: ; Possible errors are:
10733: ; #3: File not open
10734: ; #5: Device not present
10735: ; #7: Not an output file
10736: ;
10737: ;
10738: ;
10739: KCHKOUT:
10740: jsr FindFileAndClearStatus ; find index for file no. in X, return in X
10741: beq @Found ; Z=1 -> has been found, branch and process
10742: jmp KErrFileNotOpen ; return with "file not open" error
10743:
10744: @Found:
10745: jsr SetActiveFile ; set the active file to the parameters of the file just found
10746: lda zFA ; get device number (of input file)
10747: bne @NoScreen ; not screen (0) -> check for other devices
10748:
10749:
10750: @NotInputFile:
10751: jmp KErrNotOutputFile ; return with error: Not Output File (screen cannot be output file)
10752:
10753: @NoScreen:
10754: cmp #FILE_SCREEN ; is output file screen (3)?
10755: beq @SetDefault ; yes -> jump, set it as default device
10756:
10757: bcs @Iec ; > 3 ( = some IEC device) -> special processing for IEC device
10758:
10759: cmp #FILE_RS232 ; rs232 (2)?
10760: bne @Tape ; no -> only tape left -> process tapes
10761:
10762: jmp RS232_CHKOUT ; special processing for RS232 CHKIN
10763:
10764: @Tape:
10765: ldx zSA ; check secondary address
10766: cpx #$60 ; = $60 (output file)?
10767: beq @NotInputFile ; yes -> return with error: Not Input File
10768:
10769: @SetDefault:
10770: sta zDFLTO ; set default output device
10771: clc ; mark: success
10772: rts
10773: ; --------------------
10774:
10775: @Iec:
10776: tax ; remember device address in X
10777: jsr iLISTEN ; give device in A a LISTEN command
10778:
10779: lda zSA ; get secondary address
10780: bpl @SecondaryAddress ; In range $00..$7F? -> give secondary address
10781:
10782: jsr IEC_CLR_ATN ; only clear ATN status of IEC device
10783: bne @CheckStatus
10784: ; ----------------------
10785:
10786: @SecondaryAddress:
10787: jsr iSECOND ; set secondary address after LISTEN
10788:
10789: @CheckStatus:
10790: txa ; get back device number
10791:
10792: bit zSTATUS ; check status
10793: bpl @SetDefault ; bit 7 (device not present) unset -> success -> set device as default output device
10794:
10795: jmp KErrDeviceNotPresent ; return with error: Device Not Present
10796: ; -----------------------------
10797:
10798:
10799: ; B-9. Function Name: CLOSE
10800: ;
10801: ; Purpose: Close a logical file
10802: ; Call address: $FFC3 (hex) 65475 (decimal)
10803: ; Communication registers: A
10804: ; Preparatory routines: None
10805: ; Error returns: 0,240 (See READST)
10806: ; Stack requirements: 2+
10807: ; Registers affected: A, X, Y
10808: ;
10809: ; Description: This routine is used to close a logical file after all I/O
10810: ; operations have been completed on that file. This routine is called after
10811: ; the accumulator is loaded with the logical file number to be closed (the
10812: ; same number used when the file was opened using the OPEN routine).
10813: ;
10814: ;
10815: ;
10816: ;
10817: ;
10818: ;
10819: ; How to Use:
10820: ;
10821: ; 1) Load the accumulator with the number of the logical file to be
10822: ; closed.
10823: ; 2) Call this routine.
10824: ;
10825: ; EXAMPLE:
10826: ;
10827: ; ;CLOSE 15
10828: ; LDA #15
10829: ; JSR CLOSE
10830: ;
10831: KCLOSE:
10832: jsr FindFile ; find index for file no. in A, return in X
10833: beq @DoClose ; z=1 -> file index exists -> branch, close file
10834:
10835: ; if we reach here, the file did not exist
10836: clc ; report success (closing a non-existing file is not an error!)
10837: rts
10838: ; ------------
10839:
10840: @DoClose:
10841: jsr SetActiveFile ; set the active file to the parameters of the file just found
10842:
10843: txa ; put current index into table of open files into A
10844: pha ; and store it on the stack
10845:
10846: lda zFA ; get device address
10847: 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
10848: cmp #FILE_SCREEN
10849: 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
10850:
10851: bcs CLOSE_FILE_ON_IEC ; > 3 (IEC device) --> perform open on IEC
10852:
10853: cmp #FILE_RS232
10854: bne @Tape ; not RS232 (2) --> only TAPE left --> open TAPE
10855:
10856:
10857: ; if we reach here, we want to open a RS232 file
10858:
10859: ; the following 2 instructions could be replaced with jsr CLOSE_GET_BACK_INDEX_AND_DELETE_FROM_TABLE
10860: pla ; get back index into table of open files
10861: jsr CLOSE_DELETE_FROM_TABLE ; set file parameters in table of open files
10862:
10863: .if CompileComputer >= C64_GENERAL
10864: jsr LF483
10865: .else
10866: lda #$7D
10867: sta VIA1_IEC
10868: lda #$06
10869: sta VIA1_PB
10870: lda #$EE
10871: sta VIA1_PCR
10872: .endif
10873:
10874: ; manipulate MEMTOP in order to release the memory of (2*) 256 byte each for
10875: ; the RS232 input and output buffers
10876: ;
10877: jsr iMEMTOP_Get ; get current memory top into (X/Y)
10878: lda zRIBUF + 1 ; current RS232 input ring buffer high address set?
10879: beq :+ ; no, skip, we do not need to free memory for it
10880:
10881: iny ; free memory by incrementing MEMTOP high byte
10882:
10883: :
10884: lda zROBUF + 1 ; current RS232 output ring buffer high address set?
10885: beq :+ ; no, skip, we do not need to free memory for it
10886:
10887: iny ; free memory by incrementing MEMTOP high byte
10888:
10889: :
10890: lda #0 ; in order to mark that they do not exist anymore,
10891: sta zRIBUF + 1 ; clear high bytes of RS232 input buffer
10892: sta zROBUF + 1 ; and rS232 output buffer
10893:
10894: jmp SetMemtop_And_Return_With_F0 ; set memory top and return with error code $F0, which indicates the memory top has been changed
10895: ; --------------
10896:
10897:
10898: ; TODO: Comment tape close routine
10899:
10900: @Tape:
10901: .ifdef JIFFY
10902: pla
10903: jmp KErrIllegalDeviceNumber
10904:
10905: LF2CC: jsr kCLRCHN
10906: LF2CF: lda #$6F
10907: jsr FindFile
10908: bne CLOSE_Rts
10909: jmp JDLF2F3
10910:
10911: LF2D9: stx zFA
10912: LF2DB: tya
10913: pha
10914: jsr JDLF8B2
10915: jsr JDLF7A2
10916: php
10917: jsr LF2CC
10918: plp
10919: pla
10920: tay
10921: ldx zFA
10922: rts
10923: .byte $F2
10924:
10925: .else
10926:
10927: lda zSA ; get secondary address
10928: and #$0F ; (only the lower 4 bit, as the value has been ORed with IEEE_OPEN)
10929: 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
10930:
10931: jsr TapeGetPointer ; get pointer to tape buffer into (X/Y) (unused, but flags important)
10932: lda #0
10933:
10934: .if CompileComputer >= C64_GENERAL
10935: sec ; set C = 1 to make sure the output is not send to RS232 in KBSOUT_TAPE!
10936: ; (C=0 would output to RS232 instead; the C64 implementation differs from the VIC20 one in this aspect!)
10937:
10938: .endif
10939:
10940: jsr KBSOUT_TAPE ; output to TAPE
10941:
10942: .if 0
10943: ; this macro is defined in fileio_data.inc
10944:
10945: .macro FILEIO_PATCH_CLOSE_TAPE
10946:
10947: jsr TapeWriteCompleteBuffer ; write out the tape buffer to tape
10948: bcc FileIoPatch_NoError ; C = 0 -> no error -> branch
10949:
10950: pla ; get back index into table of open files
10951: lda #$00
10952:
10953: .endmacro
10954: .endif
10955:
10956: .if CompileComputer >= C64_GENERAL
10957:
10958: FILEIO_PATCH_CLOSE_TAPE
10959:
10960: rts
10961:
10962: FileIoPatch_NoError:
10963:
10964: .elseif CompileComputer = VIC20_02
10965:
10966: jsr TapeWriteCompleteBuffer ; write out the tape buffer to tape
10967: bcs CLOSE_ClcRts ; C = 1 -> error -> quit
10968:
10969: .else
10970: jmp FileIoPatchCloseTape
10971:
10972: FileIoPatchCloseTape_Return:
10973:
10974: bcs CLOSE_Rts ; if error, quit with RTS
10975: ; not needed on C64, as the RTS is directly after the patch there.
10976:
10977: .endif
10978:
10979: lda zSA ; secondary address
10980: cmp #$62 ; $62 (that is, bit 1 set: "Write end-of-tape (EOT) marker"
10981: 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
10982:
10983: ; Special processing for secondary address $62: Write an end-of-tape marker on the tape
10984:
10985: lda #TAPE_BUFFER_TYPE_EOT ; tape buffer type: END-OF-TAPE (EOT)
10986: jsr TapeCreateFileBuffer ; create the file buffer and write it on tape
10987:
10988: jmp CLOSE_GET_BACK_INDEX_AND_DELETE_FROM_TABLE ; get back index into table and set file parameters into table of open files
10989:
10990: .endif
10991:
10992: CLOSE_FILE_ON_IEC:
10993: jsr IecClose ; if zSA.7 is not set, close the file on the IEC bus.
10994:
10995: CLOSE_GET_BACK_INDEX_AND_DELETE_FROM_TABLE:
10996: pla ; get back index into table of open files
10997:
10998: CLOSE_DELETE_FROM_TABLE:
10999: tax ; X := index of entry to close
11000:
11001: JDLF2F3:
11002: dec zLDTND ; decrement number of entries in table of open files
11003:
11004: cpx zLDTND ; have we found 0 open files?
11005: beq CLOSE_ClcRts ; yes, nothing to do
11006:
11007: ; replace entry to be closed with last entry in table
11008: ldy zLDTND ; get index of last entry
11009:
11010: lda lLAT,y ; replace logical file number (LA)
11011: sta lLAT,x
11012: lda lFAT,y ; replace device address (FA)
11013: sta lFAT,x
11014: lda lSAT,y ; replace secondary address (SA)
11015: sta lSAT,x
11016:
11017: CLOSE_ClcRts:
11018: clc ; mark: success
11019: CLOSE_Rts:
11020: rts
11021: ; ------------
11022:
11023:
11024: ; Clear status and perform FindFile afterwards
11025: ;
11026: ; Input: X := file no
11027: ; Output: X := index into the tables (>= 0), or $FF if not found
11028: ; Z = 1, N = 0 if index found,
11029: ; Z = 0, N = 1 otherwise
11030: ; Uses: X, A
11031: ;
11032: ; This function is often followed by a call to SetActiveFile
11033: ; to get the data of lLAT, lFAT and lSAT into zLA, zFA and zSA.
11034: ;
11035: ; Note that register inputs differ from FindFile!
11036: ;
11037: FindFileAndClearStatus:
11038: lda #0
11039: sta zSTATUS
11040: txa
11041:
11042: ; Find the index into the lLAT, lFAT and lSAT tables
11043: ; for a specific file number.
11044: ;
11045: ; That is, if a file is opened with (BASIC)
11046: ; open 1,2,3
11047: ; then find the index into these tables for the given "1".
11048: ;
11049: ; Input: A := file no
11050: ; Output: X := index into the tables (>= 0), or $FF if not found
11051: ; Z = 1, N = 0 if index found,
11052: ; Z = 0, N = 1 otherwise
11053: ; Uses: X
11054: ;
11055: ; This function is often followed by a call to SetActiveFile
11056: ; to get the data of lLAT, lFAT and lSAT into zLA, zFA and zSA.
11057: ;
11058: FindFile:
11059: ldx zLDTND ; get number of entries in the table
11060: @Next: dex
11061: bmi FindFileRts ; all searched? Then quit
11062: cmp lLAT,x ; is this the right file no?
11063: bne @Next ; no -> branch, try the next index
11064: rts
11065: ; --------------------
11066:
11067:
11068: ; Set the file parameters (zLA, zFA and zSA) for a given file
11069: ;
11070: ; Input: X := index into the tables lLAT, lFAT and LSAT, as returned by
11071: ; FindFile or FindFileAndClearStatus
11072: ; Output:
11073: ; Z = 1, N = 0 if index found,
11074: ; Z = 0, N = 1 otherwise
11075: ; Uses: A
11076: ;
11077: SetActiveFile:
11078: lda lLAT,x ; get file no from table
11079: sta zLA ; into current value
11080:
11081: lda lFAT,x ; get device number from table
11082: sta zFA ; into current value
11083:
11084: lda lSAT,x ; get secondary address from table
11085: sta zSA ; into current value
11086:
11087: FindFileRts:
11088: rts
11089: ; ---------------------
11090:
11091: ; B-8. Function Name: CLALL
11092: ;
11093: ; Purpose: Close all files
11094: ; Call address: $FFE7 (hex) 65511 (decimal)
11095: ; Communication registers: None
11096: ; Preparatory routines: None
11097: ; Error returns: None
11098: ; Stack requirements: 11
11099: ; Registers affected: A, X
11100: ;
11101: ; Description: This routine closes all open files. When this routine is
11102: ; called, the pointers into the open file table are reset, closing all
11103: ; files. Also, the CLRCHN routine is automatically called to reset the I/O
11104: ; channels.
11105: ;
11106: ; How to Use:
11107: ;
11108: ; 1) Call this routine.
11109: ;
11110: ; EXAMPLE:
11111: ;
11112: ; JSR CLALL ;CLOSE ALL FILES AND SELECT DEFAULT I/O CHANNELS
11113: ; JMP RUN ;BEGIN EXECUTION
11114: ;
11115: ;
11116: KCLALL:
11117: lda #$00
11118: sta zLDTND ; set number of open files to 0
11119:
11120: ; "fall through" to CLRCHN
11121:
11122: ; B-10. Function Name: CLRCHN a.k.a. CLRCH
11123: ;
11124: ; Purpose: Clear I/O channels
11125: ; Call address: $FFCC (hex) 65484 (decimal)
11126: ; Communication registers: None
11127: ; Preparatory routines: None
11128: ; Error returns:
11129: ; Stack requirements: 9
11130: ; Registers affected: A, X
11131: ;
11132: ; Description: This routine is called to clear all open channels and re-
11133: ; store the I/O channels to their original default values. It is usually
11134: ; called after opening other I/O channels (like a tape or disk drive) and
11135: ; using them for input/output operations. The default input device is 0
11136: ; (keyboard). The default output device is 3 (the Commodore 64 screen).
11137: ; If one of the channels to be closed is to the serial port, an UNTALK
11138: ; signal is sent first to clear the input channel or an UNLISTEN is sent to
11139: ; clear the output channel. By not calling this routine (and leaving lis-
11140: ; tener(s) active on the serial bus) several devices can receive the same
11141: ; data from the Commodore 64 at the same time. One way to take advantage
11142: ; of this would be to command the printer to TALK and the disk to LISTEN.
11143: ; This would allow direct printing of a disk file.
11144: ; This routine is automatically called when the KERNAL CLALL routine is
11145: ; executed.
11146: ;
11147: ; How to Use:
11148: ; 1) Call this routine using the JSR instruction.
11149: ;
11150: ; EXAMPLE:
11151: ; JSR CLRCHN
11152: ;
11153: KCLRCH:
11154: ldx #FILE_SCREEN ; device address for screen (3)
11155:
11156: cpx zDFLTO ; compare current default output device to 3?
11157: bcs :+ ; <= 3, skip next step
11158:
11159: jsr iUNLSN ; send UNLISTEN on IEC bus
11160:
11161: : cpx zDFLTN ; compare current default input device to 3?
11162: bcs :+ ; <= 3, skip next step
11163:
11164: jsr iUNTLK ; send UNTALK on IEC bus
11165:
11166: : stx zDFLTO ; set default output device to screen
11167:
11168: lda #FILE_KEYBOARD
11169: sta zDFLTN ; set default input device to keyboard
11170: rts
11171: ; ---------------
11172:
11173: ; B-18. Function Name: OPEN
11174: ;
11175: ;
11176: ; Purpose: Open a logical file
11177: ; Call address: $FFC0 (hex) 65472 (decimal)
11178: ; Communication registers: None
11179: ; Preparatory routines: SETLFS, SETNAM
11180: ; Error returns: 1,2,4,5,6,240, READST
11181: ; Stack requirements: None
11182: ; Registers affected: A, X, Y
11183: ;
11184: ; Description: This routine is used to OPEN a logical file. Once the
11185: ; logical file is set up, it can be used for input/output operations. Most
11186: ; of the I/O KERNAL routines call on this routine to create the logical
11187: ; files to operate on. No arguments need to be set up to use this routine,
11188: ; but both the SETLFS and SETNAM KERNAL routines must be called before
11189: ; using this routine.
11190: ;
11191: ;
11192: ; How to Use:
11193: ;
11194: ; 0) Use the SETLFS routine.
11195: ; 1) Use the SETNAM routine.
11196: ; 2) Call this routine.
11197: ;
11198: ; EXAMPLE:
11199: ;
11200: ; This is an implementation of the BASIC statement: OPEN 15,8,15,"I/O"
11201: ;
11202: ;
11203: ; LDA #NAME2-NAME ;LENGTH OF FILE NAME FOR SETLFS
11204: ; LDY #>NAME ;ADDRESS OF FILE NAME
11205: ; LDX #<NAME
11206: ; JSR SETNAM
11207: ; LDA #15
11208: ; LDX #8
11209: ; LDY #15
11210: ; JSR SETLFS
11211: ; JSR OPEN
11212: ; NAME .BYT 'I/O'
11213: ; NAME2
11214: ;
11215:
11216: KOPEN:
11217: ldx zLA ; logical address of file to open
11218: bne :+ ; not 0 -> ok, can be opened
11219: jmp KErrNotInputFile ; return with error: "Not Input File"
11220: ; ---------------------
11221:
11222: : jsr FindFileAndClearStatus ; find index for file no. in X
11223: bne :+ ; Z=0 -> file does not exist yet -> branch -> process this open
11224: jmp KErrFileOpen ; return with "file open" error
11225:
11226: : ldx zLDTND ; get number of open files
11227: cpx #lLAT_Size ; limit not yet reached?
11228: bcc :+ ; no -> continue
11229: jmp KErrTooManyOpenFiles ; return with error: "Too many files error"
11230:
11231: : inc zLDTND ; increment number of open files
11232:
11233: lda zLA ; store logical file number
11234: sta lLAT,x ; in table
11235:
11236: lda zSA ; modify secondary address
11237: ora #IEEE_OPEN ; to mean "for OPEN" on the IEC Bus
11238: sta zSA ; store it back
11239: sta lSAT,x ; and in the table
11240:
11241: lda zFA ; store device (primary) address
11242: sta lFAT,x ; in table
11243:
11244: beq KOPEN_ClcRts ; open of the keyboard -> branch -> quit function with success, nothing else to do
11245:
11246: cmp #FILE_SCREEN
11247: beq KOPEN_ClcRts ; open of the screen -> branch -> quit function with success, nothing else to do
11248:
11249: bcc @NoIec ; open of something else but IEC (tape, rs232) -> test for it
11250:
11251: jsr KOPEN_IEC ; open the IEC file
11252: bcc KOPEN_ClcRts ; if we succeeded in opening the IEC file, succeed this call, too
11253:
11254: ; TODO: what if KOPEN_IEC (calling iUNLSN as last command) ended with C=1? Is this a BUG?
11255:
11256: @NoIec:
11257:
11258: .ifdef JIFFY
11259: cmp #$01
11260: beq JDLF3F3
11261: jmp OPEN_RS232
11262:
11263: JDLF38B:
11264: jsr kUNTLK
11265: lda zFA
11266: jsr kTALK
11267: lda zSA
11268: jmp kTKSA
11269:
11270: JDLF398:
11271: ; @@@todo some table?
11272:
11273: eor $572D
11274: brk
11275: asl $1C
11276: lda $0261
11277: sta zCHARAC
11278: lda #$12
11279: sta $06
11280: ldx #$00
11281: stx zROBUF
11282: jsr $D586
11283: ldy $0267
11284: lda ($30),y
11285: eor #$40
11286: sta ($30),y
11287: jmp $D58A
11288: eor $452D
11289: brk
11290: asl zOPMASK
11291: and $6A57
11292: brk
11293: ora (zOPMASK,x)
11294: and $6957
11295: brk
11296: ora ($50,x)
11297: ror a:zR6510
11298: .byte $53
11299: .byte $3A
11300:
11301: .else
11302: cmp #FILE_RS232 ; is it an RS232 device?
11303:
11304: .if CompileComputer = C64_SX64
11305: bne @ErrIllegalDeviceNumber ; no -> tape -> the SX64 does not have a tape -> report an error
11306: .else
11307: bne @Tape ; no -> tape -> process opening a tape file
11308: .endif
11309: jmp OPEN_RS232 ; open the RS232 device
11310: ; ------------------
11311:
11312: ; TODO: Document
11313:
11314: @Tape:
11315: jsr TapeGetPointer ; get pointer to tape buffer into (X/Y) (unused, but flags important)
11316: bcs @TapeAllowed ; C = 1 -> tape buffer does NOT point to stack page or zero page -> proceed, we do not overwrite essential data!
11317:
11318: @ErrIllegalDeviceNumber:
11319: jmp KErrIllegalDeviceNumber
11320:
11321: @TapeAllowed:
11322: lda zSA ; check secondary address of the file
11323: and #$0F ; (only the lower 4 bit, as the value has been ORed with IEEE_OPEN)
11324: bne KLOAD_OpenTapeForWrite ; anything but 0 means: WRITE. Thus, branch if we have a write operation
11325:
11326: ; Open the tape for a read operation
11327:
11328: jsr TapePressPlayOnTape ; output "PRESS PLAY ON TAPE" and wait for PLAY to be pressd
11329: bcs KOPEN_Rts ; C=1 -> an error occurred (i.e., STOP was pressed) -> branch, abort
11330:
11331: jsr OutputSearchingFor ; output the text "SEARCHING" or "SEARCHING FOR <filename>"
11332:
11333: lda zFNLEN ; test file name length
11334: beq KLOAD_NoFilenameGiven ; == 0 -> no file name given -> branch, skip finding the right file
11335:
11336: ; try to find the specified file
11337:
11338: jsr TapeFindSpecificFile ; try to find the specified file
11339: bcc KLOAD_PrepareTapeBuffer ; C = 0 -> no error occurred -> branch, proceed with operation
11340:
11341: beq KOPEN_Rts ; Z = 1 --> EOT was found, abort (TODO can this branch happen actually?)
11342:
11343: KLOAD_ErrFileNotFound:
11344: jmp KErrFileNotFound ; return with FILE NOT FOUND error
11345: ; ------------------------
11346:
11347:
11348: KLOAD_NoFilenameGiven:
11349: ; there was no file name given, just search for any file
11350:
11351: jsr TapeReadTapeHeaderOfNextFile ; try to find ANY file header
11352: beq KOPEN_Rts ; TODO what?
11353: bcc KLOAD_PrepareTapeBuffer ; C = 0 --> no error occurred -> branch, proceed with operation
11354:
11355: bcs KLOAD_ErrFileNotFound ; (uncond. branch) return with FILE NOT FOUND error
11356: ; ---------------------------
11357:
11358: KLOAD_OpenTapeForWrite:
11359: jsr TapePressRecordAndPlayOnTape ; output "PRESS RECORD + PLAY ON TAPE" and wait for PLAY to be pressd
11360: bcs KOPEN_Rts ; C=1 -> an error occurred (i.e., STOP was pressed) -> branch, abort
11361:
11362: lda #TAPE_BUFFER_TYPE_DATA ; tape buffer type: a data file
11363: jsr TapeCreateFileBuffer ; create the file buffer (including start and end address and file name) and write it on tape
11364:
11365: KLOAD_PrepareTapeBuffer:
11366: ; depending upon if the tape file is opened for read or write, the tape
11367: ; buffer has to be prepared differently.
11368: ;
11369: ; For reading, the tape buffer pointer has to point to the last address (lTBUFFR_SIZE - 1)
11370: ; in order to generate an overflow on the first call to read a character.
11371: ; The buffer itself does not need to be changed.
11372: ;
11373: ; For writing, however, the pointer must be set to the beginning of the buffer,
11374: ; and the beginning must be initialized to "2" (TODO: List of values with defines).
11375: ;
11376: lda #lTBUFFR_SIZE - 1 ; assumed value for the tape buffer pointer: Assume reading of the tape
11377:
11378: ldy zSA ; check secondary address
11379: cpy #$60 ; is it 0 ( | IEEE_OPEN)?
11380: beq @NoWrite ; yes -> branch, we want to read the tape
11381:
11382: ; process tape buffer for writing:
11383:
11384: ldy #0 ; index into tape buffer = 0 (start at the beginning)
11385: lda #TAPE_BUFFER_TYPE_CONTINUATION
11386: sta (zTAPE1),y ; mark the block as continuation buffer
11387:
11388: tya ; set tape buffer pointer to 0
11389:
11390: .endif
11391:
11392: @NoWrite:
11393: sta zBUFPNT ; and store it.
11394:
11395: .if CompileComputer >= C64_GENERAL
11396: KOPEN_ClcRts2:
11397: .endif
11398:
11399: KOPEN_ClcRts:
11400: clc
11401:
11402: KOPEN_Rts:
11403: rts
11404: ; -------------------------------
11405:
11406:
11407:
11408: ; Remark:
11409: ; In case the device does not exist, thus function will not return to the caller,
11410: ; but to the caller of the caller (in case there was no manipulation of the stack in between!)
11411:
11412: KOPEN_IEC: ; Open a file on the IEC bus
11413: lda zSA ; get secondary address
11414: bmi KOPEN_ClcRts2 ; bit 7 set -> nothing to do, we're done
11415:
11416: ldy zFNLEN ; get length of the file name
11417: beq KOPEN_ClcRts2 ; is it 0 -> nothing to do, we're done
11418:
11419: .if CompileComputer >= C64_GENERAL
11420: lda #0 ; clear the status byte, that is, start with a clean status
11421: sta zSTATUS
11422: .endif
11423:
11424: lda zFA
11425: jsr iLISTEN ; send LISTEN to the device
11426:
11427: lda zSA
11428: ora #IEEE_SECONDARY
11429: jsr iSECOND ; send secondary address after LISTEN
11430:
11431: lda zSTATUS ; check device status
11432: bpl KOPEN_Iec_DeviceExists ; bit 7 (device not present) unset -> device exists -> proceed
11433:
11434: JDLF3F1:
11435: ; if we reach here, zSTATUS.7 was set. Thus, we got a timeout -> the device does not exist
11436: ;
11437: pla ; remove return address of caller from the stack (!)
11438: pla
11439:
11440: JDLF3F3:
11441: jmp KErrDeviceNotPresent ; return to the caller of the caller with "Device not Present" error
11442: ; --------------------------
11443:
11444: KOPEN_Iec_DeviceExists:
11445: lda zFNLEN ; get length of the file name
11446: beq @NoName ; if 0, we're done. (UNNECCESSARY, as this has already been tested above!)
11447:
11448: ; now, the file name is output to the IEC bus, one byte after the other
11449:
11450: ldy #0
11451: : lda (zFNADR),y ; get next character of the file name
11452: jsr iCIOUT ; output it to the IEC bus
11453: iny ; proceed to next character
11454: cpy zFNLEN ; have we reached the end yet?
11455: bne :- ; now, process this character, too.
11456:
11457: @NoName:
11458: .if CompileComputer >= C64_GENERAL
11459: ; for C64, this functionality has been implemented by jumping to another place with the same implementation as here:
11460:
11461: jmp DoUnlistenClcRts
11462: .else
11463: ; the VIC-20 does it itself here, which results in duplicate code:
11464:
11465: jsr iUNLSN
11466:
11467: .if CompileComputer < C64_GENERAL
11468: KOPEN_ClcRts2:
11469: .endif
11470: clc
11471: rts
11472: .endif
11473:
11474: OPEN_RS232:
11475:
11476: ; TODO: Initialize RS232
11477:
11478: .if CompileComputer >= C64_GENERAL
11479: jsr LF483
11480: .else
11481: lda #$06
11482: sta VIA1_DDRB
11483: sta VIA1_PB
11484: lda #$EE
11485: sta VIA1_PCR
11486: ldy #0
11487: .endif
11488: sty lRSSTAT
11489: @LF40F: cpy zFNLEN
11490: beq @LF41D
11491: lda (zFNADR),y
11492: sta lM51CTR,y
11493: iny
11494: cpy #$04
11495: bne @LF40F
11496: @LF41D:
11497: jsr LEF4A
11498: stx lBITNUM
11499: lda lM51CTR
11500: and #$0F
11501:
11502: .if CompileComputer >= C64_02
11503: beq @LF446
11504: asl a
11505: tax
11506: lda lTVSFLG
11507: bne @LF43A
11508: ldy LFEC2 - 1,x
11509: lda LFEC2 - 2,x
11510: jmp @LF440
11511: @LF43A:
11512: ldy LE4EC-1,x
11513: lda LE4EC-2,x
11514: @LF440:
11515: sty lM51AJB + 1
11516: sta lM51AJB
11517: @LF446:
11518: lda lM51AJB
11519: asl a
11520: jsr LFF2E
11521: lda lM51CDR
11522: lsr a
11523: bcc @LF45C
11524: lda CIA2 + CIA_O_PB
11525: asl a
11526: bcs @LF45C
11527: jsr LF00D
11528: .else
11529: bne @LF435
11530: .if CompileComputer >= C64_GENERAL
11531: lda lM51AJB
11532: asl a
11533: tay
11534: lda lM51AJB + 1
11535: jmp @LF43F
11536: .endif
11537: @LF435: asl a
11538: tax
11539: lda LFEC2 - 2,x
11540: asl a
11541: tay
11542: lda LFEC2 - 1,x
11543: @LF43F: rol a
11544: pha
11545: tya
11546: adc #<200
11547: sta lBAUDOF
11548: pla
11549: adc #>200
11550: sta lBAUDOF + 1
11551: lda lM51CDR
11552: lsr a
11553: bcc @LF45C
11554: .if CompileComputer >= C64_GENERAL
11555: lda CIA2 + CIA_O_PB
11556: .else
11557: lda VIA2_PB
11558: .endif
11559: asl a
11560: bcs @LF45C
11561: .if CompileComputer >= C64_GENERAL
11562: jmp LF00D
11563: .else
11564: jmp LF016
11565: .endif
11566: .endif
11567:
11568: @LF45C: lda lRIDBE
11569: sta lRIDBS
11570: lda lRODBE
11571: sta lRODBS
11572: jsr iMEMTOP_Get
11573: lda zRIBUF + 1
11574: bne @LF474
11575: dey
11576: sty zRIBUF + 1
11577: stx zRIBUF
11578: @LF474:
11579: lda zROBUF + 1
11580: bne SetMemtop_And_Return_With_F0
11581: dey
11582: sty zROBUF + 1
11583: stx zROBUF
11584:
11585: SetMemtop_And_Return_With_F0:
11586: sec
11587: lda #$F0
11588: jmp iMEMTOP_Set
11589:
11590: .if CompileComputer >= C64_GENERAL
11591: LF483: lda #$7F
11592: sta CIA2 + CIA_O_ICR
11593: lda #$06
11594: sta CIA2 + CIA_O_DDRB
11595: sta CIA2 + CIA_O_PB
11596: lda #$04
11597: ora IEC_REG
11598: sta IEC_REG
11599: ldy #$00
11600: sty lENABL
11601: rts
11602: .endif
11603:
11604:
11605: ; B-15. Function Name: LOAD
11606: ;
11607: ; Purpose: Load RAM from device
11608: ; Call address: $FFD5 (hex) 65493 (decimal)
11609: ; Communication registers: A, X, Y
11610: ; Preparatory routines: SETLFS, SETNAM
11611: ; Error returns: 0,4,5,8,9, READST
11612: ; Stack requirements: None
11613: ; Registers affected: A, X, Y
11614: ;
11615: ; Description: This routine LOADs data bytes from any input device di-
11616: ; rectly into the memory of the Commodore 64. It can also be used for a
11617: ; verify operation, comparing data from a device with the data already in
11618: ; memory, while leaving the data stored in RAM unchanged.
11619: ; The accumulator (.A) must be set to 0 for a LOAD operation, or 1 for a
11620: ; verify, If the input device is OPENed with a secondary address (SA) of 0
11621: ; the header information from the device is ignored. In this case, the X
11622: ; and Y registers must contain the starting address for the load. If the
11623: ; device is addressed with a secondary address of 1, then the data is
11624: ; loaded into memory starting at the location specified by the header. This
11625: ; routine returns the address of the highest RAM location loaded.
11626: ; Before this routine can be called, the KERNAL SETLFS, and SETNAM
11627: ; routines must be called.
11628: ;
11629: ;
11630: ; +-----------------------------------------------------------------------+
11631: ; | NOTE: You can NOT LOAD from the keyboard (0), RS-232 (2), or the |
11632: ; | screen (3). |
11633: ; +-----------------------------------------------------------------------+
11634: ;
11635: ;
11636: ; How to Use:
11637: ;
11638: ; 0) Call the SETLFS, and SETNAM routines. If a relocated load is de-
11639: ; sired, use the SETLFS routine to send a secondary address of 0.
11640: ; 1) Set the A register to 0 for load, 1 for verify.
11641: ; 2) If a relocated load is desired, the X and Y registers must be set
11642: ; to the start address for the load.
11643: ; 3) Call the routine using the JSR instruction.
11644: ;
11645: ;
11646: ;
11647: ;
11648: ;
11649: ;
11650: ; EXAMPLE:
11651: ;
11652: ; ;LOAD A FILE FROM TAPE
11653: ;
11654: ; LDA #DEVICE1 ;SET DEVICE NUMBER
11655: ; LDX #FILENO ;SET LOGICAL FILE NUMBER
11656: ; LDY CMD1 ;SET SECONDARY ADDRESS
11657: ; JSR SETLFS
11658: ; LDA #NAME1-NAME ;LOAD A WITH NUMBER OF
11659: ; ;CHARACTERS IN FILE NAME
11660: ; LDX #<NAME ;LOAD X AND Y WITH ADDRESS OF
11661: ; LDY #>NAME ;FILE NAME
11662: ; JSR SETNAM
11663: ; LDA #0 ;SET FLAG FOR A LOAD
11664: ; LDX #$FF ;ALTERNATE START
11665: ; LDY #$FF
11666: ; JSR LOAD
11667: ; STX VARTAB ;END OF LOAD
11668: ; STY VARTA B+1
11669: ; JMP START
11670: ; NAME .BYT 'FILE NAME'
11671: ; NAME1 ;
11672: ;
11673: iLOAD: stx zMEMUSS_2 ; remember alternate start at (zMEMUSS_2/zMEMUSS_2+1)
11674: sty zMEMUSS_2 + 1
11675: jmp (lILOAD) ; normally points to KLOAD
11676:
11677: KLOAD:
11678: sta zVERCKK ; remember if LOAD (= 0) or VERIFY (= 1)
11679:
11680: lda #0 ; clear status
11681: sta zSTATUS
11682:
11683: lda zFA ; get device address
11684: bne @NotKeyboard ; not keyboard (0) -> test for other devices
11685:
11686: @ErrIllegalDeviceNumber:
11687: jmp KErrIllegalDeviceNumber ; exit with "Illegal Device Number" error
11688: ; -----------------------------
11689:
11690: @NotKeyboard:
11691: cmp #FILE_SCREEN
11692: beq @ErrIllegalDeviceNumber ; load from screen --> exit with "Illegal Device Number" error
11693:
11694: ; if C = 0, only tape and RS232 have been left.
11695:
11696: .ifdef JIFFY
11697: ; JiffyDOS does not support a tape, and load from RS232 is not possible.
11698: ; thus, if C=0, we are not able to load. Thus:
11699:
11700: bcc @ErrIllegalDeviceNumber ; RS232 or TAPE --> exit with "Illegal Device Number" error
11701: .elseif CompileComputer = C64_SX64
11702: ; the SX64 does not have a tape, and load from RS232 is not possible.
11703: ; thus, if C=0, we are not able to load. Thus:
11704:
11705: bcc @ErrIllegalDeviceNumber ; RS232 or TAPE --> exit with "Illegal Device Number" error
11706: .else
11707: bcc KLOAD_TapeOrRS232 ; RS232 or TAPE --> try further tests
11708: .endif
11709:
11710:
11711: ; if we reach here, we want to load a file from IEC
11712:
11713: .if CompileComputer = VIC20_02
11714: lda #IEEE_OPEN ; set secondary address: LOAD
11715: sta zSA
11716: .endif
11717:
11718: ldy zFNLEN ; get length of file name
11719: bne KLOAD_FileNameGiven ; not 0 -> branch, name was given -> proceed
11720: .ifdef JIFFY
11721: jmp $F659
11722: .else
11723: jmp KErrFileNameMissing ; error: We need a file name for IEC load --> return with "File Name Missing" error
11724: .endif
11725: ; -------------------------
11726:
11727: KLOAD_FileNameGiven:
11728:
11729: .if CompileComputer = VIC20_02
11730:
11731: ; on the VIC20-02 ROM, a "ldx zSA" is missing:
11732: ; TODO: Is this "ldx" needed at all?
11733:
11734: jsr OutputSearchingFor ; output the "Searching [for <FILENAME>]" message
11735:
11736: .elseif CompileComputer >= C64_GENERAL
11737:
11738: ; the C64 ROMs contain this ldx:
11739:
11740: ldx zSA ; TODO: why?
11741: jsr OutputSearchingFor ; output the "Searching [for <FILENAME>]" message
11742: .else
11743: ; for the VIC20 ROMs (other than -02), the same sequence as in the C64 case is done in a patch that is called here:
11744:
11745: jsr LE4BC
11746: .endif
11747:
11748: .if CompileComputer <> VIC20_02
11749: lda #IEEE_LOAD ; set secondary address: LOAD
11750: sta zSA
11751: .endif
11752:
11753: 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!
11754:
11755: ; send a TALK command
11756: lda zFA
11757: jsr iTALK ; send TALK
11758: lda zSA
11759: jsr iTKSA ; and secondary address after TALK
11760:
11761: jsr iACPTR ; read 1st byte from IEC
11762: sta zEAL ; and store it as low byte of start address
11763:
11764: lda zSTATUS ; check status bit 6 (EOI)
11765: lsr a
11766: lsr a
11767: bcs KLOAD_ErrFileNotFound2 ; EOI -> return with "File Not Found" error
11768:
11769: .ifdef JIFFY
11770: jsr JDLF179
11771: .else
11772: jsr iACPTR ; read 2nd byte from IEC
11773: .endif
11774: sta zEAL + 1 ; and store it as high byte of start address
11775:
11776: .if 0
11777: ; this macro is defined in fileio_data.inc
11778:
11779: .macro LOAD_OVERWRITE_START_ADDRESS
11780: txa
11781: bne :+
11782: lda zMEMUSS
11783: sta zEAL
11784: lda zMEMUSS + 1
11785: sta zEAL + 1
11786: :
11787:
11788: .endmacro
11789: .endif
11790:
11791: .if CompileComputer >= C64_GENERAL
11792: LOAD_OVERWRITE_START_ADDRESS
11793: .endif
11794:
11795:
11796: .ifdef JIFFY
11797: @LF4F0:
11798: jmp JDLFAC4
11799:
11800: LF4F3:
11801: jsr kSTOP
11802: bne @LF4FB
11803: jmp IecCloseBecauseStopKey
11804: @LF4FB:
11805: jsr JDLFBAA
11806: lda zSTATUS
11807: and #$FD
11808: cmp zSTATUS
11809: sta zSTATUS
11810: bne LF4F3
11811: ldy #$00
11812: ldx zTSFCNT
11813: lda zTBTCNT
11814: cpy zVERCKK
11815: beq @LF51A
11816: cmp (zEAL),y
11817: beq @LF51C
11818: jsr LF19E
11819: .byte $2C
11820: @LF51A:
11821: sta (zEAL),y
11822: @LF51C:
11823: stx zTSFCNT
11824:
11825: .else
11826:
11827: .if CompileComputer >= C64_GENERAL .or CompileComputer = VIC20_02
11828: jsr OutputLoadingOrVerify ; output LOADING or VERIFYING messages
11829: .else
11830: ; the following patch contains:
11831: ; LOAD_OVERWRITE_START_ADDRESS
11832: ; jsr OutputLoadingOrVerify
11833:
11834: ; Thus, the implementation is identical to the C64
11835:
11836: jsr LE4C1
11837: .endif
11838:
11839: LF4F3:
11840: lda #~STATUS_IEC_TIMEOUT_READ ; clear read timeout
11841: and zSTATUS ; TODO: why?
11842: sta zSTATUS
11843:
11844: jsr kSTOP ; check if the stop key has been pressed
11845: bne @ReadByte ; no stop key, proceed
11846:
11847: jmp IecCloseBecauseStopKey ; close file and return with error: Stopped because user pressed <STOP> key
11848:
11849: @ReadByte:
11850: jsr iACPTR ; get data byte from IEC bus
11851: tax ; remember it in X
11852:
11853: lda zSTATUS ; check status bit 6 (EOI)
11854: lsr a
11855: lsr a
11856: bcs LF4F3 ; EOI -> there is no data to process -> branch
11857:
11858: txa ; get back the data byte from the IEC bus
11859:
11860: ldy zVERCKK ; test verify flag
11861: beq @Load ; =0 --> LOAD --> Store data byte in memory
11862:
11863: ldy #0 ; make sure to compare the first byte
11864: cmp (zEAL),y ; compare data byte
11865: beq @IncrementAddress ; it's the same -> everything ok -> branch
11866:
11867: lda #STATUS_VERIFY ; set "verify error" bit
11868: jsr SetStatus
11869:
11870: .byte ASM_BIT3 ; mask next instruction so it is not executed
11871:
11872: @Load:
11873: ; Y is already 0 here, as this is only executed when beq @Load after ldy zVERCKK has been taken...
11874: sta (zEAL),y ; store data byte in memory
11875:
11876: .endif
11877:
11878: @IncrementAddress:
11879: inc zEAL ; increment low address
11880: bne :+ ; if not zero, skip incrementing high address
11881: inc zEAL + 1 ; increment high address
11882:
11883: : bit zSTATUS ; test status bit 6 (EOI)
11884: bvc LF4F3 ; unset -> proceed with next byte
11885:
11886: KLOAD_UntalkClose:
11887: jsr iUNTLK ; send UNTALK to device
11888: jsr IecClose ; close the file
11889: bcc LoadEndSuccess ; C=0 -> no error occurred -> quit with success
11890:
11891: KLOAD_ErrFileNotFound2:
11892: jmp KErrFileNotFound ; return with "File Not Found" error
11893: ; -------------------------
11894:
11895: KLOAD_TapeOrRS232:
11896: ; if we reach here, either a LOAD from TAPE (A=1) or from RS232 (=2) has been
11897: ; asked for
11898:
11899: .ifdef JIFFY
11900:
11901: lda zFNLEN
11902: beq LF546
11903: lda (zFNADR),y
11904: cmp #$24
11905: beq LF56C
11906: jmp JDLFC9A
11907: tya
11908: LF541: pha
11909: jsr JDLF8BF
11910: pla
11911: LF546: sta zBUFPNT
11912: LF548: jsr JDLF911
11913: bne LF568
11914: lda zBUFPNT
11915: php
11916: beq LF557
11917: jsr JDLE4C6
11918: beq LF567
11919: LF557: jsr JDLF79A
11920: jsr OutputFilename
11921: bit zSTKEY
11922: bpl LF567
11923: plp
11924: bne LF548
11925: bvc LF548
11926: .byte $24
11927: LF567: plp
11928: LF568: rts
11929: ldx #$6C
11930: .byte $2C
11931: LF56C: ldx #$60
11932: jsr JDLF8C1
11933: lda #$39
11934: sta lIERROR
11935: ldy #$FC
11936: jsr JDLFCA6
11937: LF57B: ldy #$00
11938: LF57D: jsr JDLFCA6
11939: bvs LF5A3
11940: cpy #$02
11941: beq LF5A3
11942: cpy #$06
11943: bcc LF57D
11944: ldx zFNADR
11945: stx $5F
11946: ldx $BC
11947: stx $60
11948: ldy #$01
11949: sta ($5F),y
11950: jsr JDLA6C3
11951: jsr JDLF79A
11952: jsr JDLA6D4
11953: bit zSTKEY
11954: bmi LF57B
11955: LF5A3: lda #$63
11956: sta lIERROR
11957: rts
11958:
11959: .else
11960:
11961: .if CompileComputer >= C64_GENERAL
11962: lsr a ; check if bit 0 of the device number is 1
11963: bcs @Tape ; yes -> it is the tape -> branch, process LOAD from tape
11964: jmp KErrIllegalDeviceNumber ; load from RS232 not possible, quit with "Illegal Device Number" error
11965: .else
11966: cmp #FILE_RS232 ; test if the device number is the number of RS232
11967: bne @Tape ; no -> it is the tape -> branch, process LOAD from tape
11968: jmp Rs232ErrIllegalDeviceNumber ; load from RS232 not possible, quit with "Illegal Device Number" error
11969: .endif
11970:
11971: ; TODO document load from TAPE
11972: @Tape:
11973: jsr TapeGetPointer ; get pointer to tape buffer into (X/Y) (unused, but flags important)
11974: bcs :+ ; C = 1 -> tape buffer does NOT point to stack page or zero page -> proceed, we do not overwrite essential data!
11975: jmp KErrIllegalDeviceNumber
11976:
11977: :
11978: jsr TapePressPlayOnTape ; output "PRESS PLAY ON TAPE" and wait for the PLAY key to be pressed
11979: bcs LoadRts ; C = 1 --> an error occurred (STOP key) --> branch, quit
11980:
11981: jsr OutputSearchingFor ; output "SEARCHING FOR ..."
11982:
11983: @LF549: lda zFNLEN ; length of file name
11984: beq :+ ; 0 --> no file name specified -> skip
11985: jsr TapeFindSpecificFile ; try to find the specified file
11986: bcc @FoundFile ; C = 0 -> no error occurred -> branch, proceed with operation
11987: beq LoadRts ; Z = 1 --> an EOT was found
11988: bcs KLOAD_ErrFileNotFound2 ; return with FILE NOT FOUND error
11989: ; ------------------------
11990:
11991: :
11992: jsr TapeReadTapeHeaderOfNextFile ; try to find ANY file header
11993: 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!)
11994: bcs KLOAD_ErrFileNotFound2 ; C = 1 --> an error occurred -> branch, quit with FILE NOT FOUND error
11995:
11996: @FoundFile:
11997: lda zSTATUS
11998: 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)
11999: sec
12000: bne LoadRts ; if the status indicated the error -> branch, we're done
12001:
12002: cpx #TAPE_BUFFER_TYPE_BASIC ; is this file a BASIC program?
12003: beq @BASIC_Program ; yes -> branch, process the BASIC program
12004:
12005: cpx #TAPE_BUFFER_TYPE_ABSOLUTE ; is this file an absolute program?
12006: bne @LF549 ; no -> branch, search for the next file (there is a data file with the same name, skip it)
12007:
12008: @Absolute_Program:
12009: ldy #TAPE_BUFFER_OFFSET_SAL_LOW ; offset of start address low in tape buffer
12010: lda (zTAPE1),y ; read the start address low
12011: sta zMEMUSS_2 ; and store it
12012: iny ; advance offset to start address high
12013: lda (zTAPE1),y ; read the start address high
12014: sta zMEMUSS_2 + 1 ; and store it
12015: 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)
12016: ; -------------------
12017:
12018: @BASIC_Program:
12019: lda zSA ; get secondary address used to open the file
12020: 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
12021:
12022: ; If the above branch did not branch and we reach this place from above (not via bcs @LoadFile), then we have a BASIC program.
12023: ; The start address to load it to is already at zMEMUSS_2/zMEMUSS_2 + 1.
12024:
12025: @LoadFile:
12026: ; Calculate the end address and write it into zEAL/zEAL+1
12027:
12028: ; sec ; C=1 is always true here, thus, no need for an SEC
12029:
12030: ldy #TAPE_BUFFER_OFFSET_EAL_LOW ; (offset of end address low in tape buffer)
12031: lda (zTAPE1),y ; get end address low
12032: ldy #TAPE_BUFFER_OFFSET_SAL_LOW ; (offset of start address low in tape buffer)
12033: sbc (zTAPE1),y ; subtract end address low - start address low
12034: tax ; remember the result in X
12035:
12036: ldy #TAPE_BUFFER_OFFSET_EAL_HIGH ; (offset of end address high in tape buffer)
12037: lda (zTAPE1),y ; get end address high
12038: ldy #TAPE_BUFFER_OFFSET_SAL_HIGH ; (offset of start address high in tape buffer)
12039: sbc (zTAPE1),y ; subtract end address high - start address high
12040: tay ; remember the result in Y
12041:
12042: ; now, add the length (in X/Y) t zMEMUSS_2/zMEMUSS_2+1, and store the result in zEAL/zEAL+1
12043: clc
12044: txa ; get length low
12045: adc zMEMUSS_2 ; add it to the start address low
12046: sta zEAL ; and store it as end address low
12047:
12048: tya ; get length high
12049: adc zMEMUSS_2 + 1 ; add it to the start address high
12050: sta zEAL + 1 ; and store it as end address high
12051:
12052: ; copy the start address from zMEMUSS_2/zMEMUSS_2+1 to zSTAL/zSTAL+1
12053:
12054: lda zMEMUSS_2
12055: sta zSTAL
12056: lda zMEMUSS_2 + 1
12057: sta zSTAL + 1
12058:
12059: jsr OutputLoadingOrVerify ; output LOADING or VERIFYING messages
12060:
12061: jsr TapeReadFileContents ; read in the next buffer from the tape
12062: .byte ASM_BIT2 ; make
12063:
12064: .endif
12065:
12066: LoadEndSuccess:
12067: clc ; mark: success
12068: ldx zEAL ; return end address (+1) in X/Y
12069: ldy zEAL + 1
12070: LoadRts:
12071: rts
12072: ; --------------
12073:
12074: OutputSearchingFor:
12075: lda zNSGFLG ; do we output messages "searching for", or is it prohibited?
12076: bpl OutputSearchingFor_Rts ; no -> branch -> quit, we don't want to output anything
12077:
12078: ldy #StrSearching - LMESSAGES ; offset of "Searching" message
12079: jsr OutputMessage ; output it
12080:
12081: lda zFNLEN ; test length of file name
12082: beq OutputSearchingFor_Rts ; length = 0 -> no filename -> branch -> quit, nothing else to do
12083:
12084: ldy #StrFor - LMESSAGES ; offset of " for " message
12085: jsr OutputMessage ; output it
12086:
12087: OutputFilename:
12088: ldy zFNLEN ; test length of file name
12089: beq OutputSearchingFor_Rts ; length = 0 -> no filename -> branch -> quit, nothing else to do
12090:
12091: ldy #0 ; start with first character
12092: : lda (zFNADR),y ; get character of file name
12093: jsr kCHROUT ; and output it
12094: iny ; advance to next character
12095: cpy zFNLEN ; did we reach the end of the file name?
12096: bne :- ; no, process next character
12097:
12098: OutputSearchingFor_Rts:
12099: rts
12100: ; --------------------
12101:
12102: OutputLoadingOrVerify:
12103: ldy #StrLoading - LMESSAGES ; offset of "LOADING" message
12104: lda zVERCKK ; check verify flag
12105: beq @Output ; 0 -> LOAD -> output LOADING"
12106: ldy #StrVerifying - LMESSAGES ; otherwise, it is a VERIFY: Get offset of "VERIFYING" message
12107: @Output:
12108: jmp OutputMessageIfAllowed ; output the message, if not prohibited
12109:
12110:
12111:
12112: ; B-24. Function Name: SAVE
12113: ;
12114: ; Purpose: Save memory to a device
12115: ; Call address: $FFD8 (hex) 65496 (decimal)
12116: ; Communication registers: A, X, Y
12117: ; Preparatory routines: SETLFS, SETNAM
12118: ; Error returns: 5,8,9, READST
12119: ; Stack requirements: None
12120: ; Registers affected: A, X, Y
12121: ;
12122: ;
12123: ;
12124: ; Description: This routine saves a section of memory. Memory is saved
12125: ; from an indirect address on page 0 specified by the accumulator to the
12126: ; address stored in the X and Y registers. It is then sent to a logical
12127: ; file on an input/output device. The SETLFS and SETNAM routines must be
12128: ; used before calling this routine. However, a file name is not required to
12129: ; SAVE to device 1 (the Datassette(TM) recorder). Any attempt to save to
12130: ; other devices without using a file name results in an error.
12131: ;
12132: ; +-----------------------------------------------------------------------+
12133: ; | NOTE: Device 0 (the keyboard), device 2 (RS-232), and device 3 (the |
12134: ; | screen) cannot be SAVEd to. If the attempt is made, an error occurs, |
12135: ; | and the SAVE is stopped. |
12136: ; +-----------------------------------------------------------------------+
12137: ;
12138: ; How to Use:
12139: ;
12140: ; 0) Use the SETLFS routine and the SETNAM routine (unless a SAVE with no
12141: ; file name is desired on "a save to the tape recorder"),
12142: ; 1) Load two consecutive locations on page 0 with a pointer to the start
12143: ; of your save (in standard 6502 low byte first, high byte next
12144: ; format).
12145: ; 2) Load the accumulator with the single byte page zero offset to the
12146: ; pointer.
12147: ; 3) Load the X and Y registers with the low byte and high byte re-
12148: ; spectively of the location of the end of the save.
12149: ; 4) Call this routine.
12150: ;
12151: ; EXAMPLE:
12152: ;
12153: ; LDA #1 ;DEVICE = 1:CASSETTE
12154: ; JSR SETLFS
12155: ; LDA #0 ;NO FILE NAME
12156: ; JSR SETNAM
12157: ; LDA PROG ;LOAD START ADDRESS OF SAVE
12158: ; STA TXTTAB ;(LOW BYTE)
12159: ; LDA PROG+1
12160: ; STA TXTTA B+1 ;(HIGH BYTE)
12161: ; LDX VARTAB ;LOAD X WITH LOW BYTE OF END OF SAVE
12162: ; LDY VARTAB+1 ;LOAD Y WITH HIGH BYTE
12163: ; LDA #<TXTTAB ;LOAD ACCUMULATOR WITH PAGE 0 OFFSET
12164: ; JSR SAVE
12165: ;
12166: ;
12167: iSAVE:
12168: stx zEAL ; store end address of save at (zEAL/zEAL+1)
12169: sty zEAL + 1
12170:
12171: ; store start address at (zSTAL/zSTAL + 1)
12172:
12173: tax ; get index of zero page location that contains the start address into X
12174: lda 0,x ; get start address low
12175: sta zSTAL
12176: lda 0 + 1,x ; get start address high
12177: sta zSTAL + 1
12178: jmp (lISAVE) ; points to KSAVE normally
12179:
12180: KSAVE:
12181: lda zFA ; get device number
12182: bne SaveNotKeyboard ; not keyboard (0) -> branch, test for other devices
12183:
12184: SaveErrIllegalDeviceNumber:
12185: jmp KErrIllegalDeviceNumber ; return with "Illegal Device Number" error
12186:
12187: SaveNotKeyboard:
12188: cmp #FILE_SCREEN ; device number screen (3)?
12189: beq SaveErrIllegalDeviceNumber ; yes -> return with "Illegal Device Number" error
12190:
12191: ; if we reach here, only tape and RS232 are left with C=0
12192: ; (and IEC with C=1)
12193: .ifdef JIFFY
12194: bcc SaveErrIllegalDeviceNumber ; on the SX64, tape and RS232 are both illegal -> return with error
12195: .elseif CompileComputer = C64_SX64
12196: bcc SaveErrIllegalDeviceNumber ; on the SX64, tape and RS232 are both illegal -> return with error
12197: .else
12198: bcc SaveTapeOrRs232 ; check if tape or RS232
12199: .endif
12200:
12201: ; if we reach here, we want to save on IEC bus
12202:
12203: lda #IEEE_SAVE ; set the secondary address
12204: sta zSA ; to the address of a save
12205:
12206: ldy zFNLEN ; is there a file name?
12207: bne LF605 ; yes -> everything ok, proceed
12208:
12209: SAVE_KErrFileNameMissing:
12210: jmp KErrFileNameMissing ; return with "File Name Missing" error
12211:
12212: LF605:
12213: jsr KOPEN_IEC ; open the file on the IEC bus
12214: jsr OutputSaving ; output the "SAVING" message
12215:
12216: lda zFA ; send LISTEN to device
12217: jsr iLISTEN
12218: lda zSA ; with correspondig SA
12219: jsr iSECOND
12220:
12221: ldy #0 ; index for writing data (for later, when receiving data)
12222:
12223: jsr Copy_zSTAL_to_zSAL ; save start address into pointer which will be used for saving
12224:
12225: ; output the start address as two first bytes
12226: lda zSAL ; low byte
12227: jsr iCIOUT
12228: lda zSAL + 1 ; high byte
12229: jsr iCIOUT
12230:
12231: SAVE_Loop:
12232: jsr HasEndAddressBeenReached ; check if working address (zSAL/zSAL+1) has reached end address (zEAL/zEAL+1)
12233: bcs SAVE_End ; reached -> branch
12234:
12235: lda (zSAL),y ; byte to be saved
12236: jsr iCIOUT ; output to IEC
12237:
12238: jsr kSTOP ; check if <stop> has been pressed
12239: bne SAVE_NoStop ; no -> branch, process next byte (if any)
12240:
12241: IecCloseBecauseStopKey:
12242: jsr IecClose ; close the file on the IEC bus
12243:
12244: lda #0 ; error: Routine terminated by the <STOP> key
12245: sec ; mark: error return
12246: rts
12247: ; --------------
12248:
12249: SAVE_NoStop:
12250: jsr Increment_zSAL_Address ; increment working address
12251: bne SAVE_Loop ; if no "wrap around" to address 0, save the next byte
12252:
12253:
12254: SAVE_End:
12255: jsr iUNLSN ; send UNLISTEN to device
12256:
12257: IecClose:
12258: ; Close an IEC file by sending a LISTEN with the secondary address specifying "CLOSE"
12259: bit zSA ; secondary address
12260: bmi SAVE_ClcRts ; bit 7 set -> branch, we are done
12261:
12262: lda zFA ; send listen to device
12263: jsr iLISTEN
12264:
12265: lda zSA ; send secondary address "CLOSE"
12266: and #$EF
12267: ora #IEEE_CLOSE
12268: jsr iSECOND
12269:
12270: DoUnlistenClcRts:
12271: jsr iUNLSN ; send UNLISTEN
12272:
12273: SAVE_ClcRts:
12274: clc
12275: rts
12276: ; --------------
12277:
12278: SaveTapeOrRs232:
12279:
12280: .ifdef JIFFY
12281:
12282: LF659: lda zNDX
12283: beq SAVE_KErrFileNameMissing
12284: lda #$02
12285: sta zSA
12286: ldx #$74
12287: ldy #$F6
12288: jsr kSETNAM
12289: jmp KLOAD_FileNameGiven
12290: LF66B: ldx #$33
12291: ldy #$04
12292: jmp JDLF932
12293:
12294: .byte $40, $24, $3a, $2a, $0d, $00, $2f, $00
12295: .byte $5e, $00, $25, $00, $40, $44, $00, $40
12296: .byte $54, $00, $5f, $00, $40, $20, $20, $22
12297: .byte $53, $3a, $00
12298:
12299: .else
12300:
12301: ; if we reach here, either a SAVE from TAPE (A=1) or from RS232 (=2) has been
12302: ; asked for
12303:
12304: .if CompileComputer >= C64_GENERAL
12305: lsr a ; check if bit 0 of the device number is 1
12306: bcs @Tape ; yes -> it is the tape -> branch, process SAVE from tape
12307: jmp KErrIllegalDeviceNumber ; save to RS232 not possible, quit with "Illegal Device Number" error
12308: .else
12309: cmp #FILE_RS232 ; test if the device number is the number of RS232
12310: bne @Tape ; no -> it is the tape -> branch, process SAVE to tape
12311: jmp Rs232ErrIllegalDeviceNumber ; save to RS232 not possible, quit with "Illegal Device Number" error
12312: .endif
12313:
12314: @Tape:
12315: jsr TapeGetPointer ; is the tape buffer set (high byte >= 2)?
12316: bcc SaveErrIllegalDeviceNumber ; no -> abort operation, as we would overwrite ZP or stack
12317:
12318: jsr TapePressRecordAndPlayOnTape ; output "PRESS RECORD + PLAY ON TAPE" and wait for PLAY to be pressd
12319: bcs SAVE_Rts ; C=1 -> an error occurred (i.e., STOP was pressed) -> branch, abort
12320:
12321: jsr OutputSaving ; Output the text "SAVING <filename>"
12322:
12323: ; determine the tape buffer type to generate for the first block (filename)
12324:
12325: ldx #TAPE_BUFFER_TYPE_ABSOLUTE ; assume: file is a absolute loading program (not BASIC)
12326:
12327: lda zSA ; check secondary address
12328: and #$01 ; bit 0 set?
12329: bne :+ ; yes -> branch, skip
12330:
12331: ldx #TAPE_BUFFER_TYPE_BASIC ; no -> file is a BASIC program
12332:
12333: : txa
12334: jsr TapeCreateFileBuffer ; create the file buffer (including start and end address and file name) and write it on tape
12335: bcs SAVE_Rts ; C = 1 -> an error occurred -> branch, quit save with an error
12336:
12337: jsr TapeWriteCompleteFile ; write out the file to tape
12338: bcs SAVE_Rts ; C = 1 -> an error occurred -> branch, quit save with an error
12339:
12340: ; 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
12341: lda zSA ; get secondary address
12342: and #$02 ; is bit 1 set?
12343: beq @ClcRts ; no -> branch, we're done
12344:
12345: lda #TAPE_BUFFER_TYPE_EOT ; tape buffer type: END-OF-TAPE (EOT)
12346: jsr TapeCreateFileBuffer ; create the file buffer and write it on tape
12347:
12348: .byte ASM_BIT2 ; make sure not to loose the status of C by hiding the next instruction
12349:
12350: .endif
12351:
12352: @ClcRts:
12353: clc
12354: SAVE_Rts:
12355: rts
12356: ; ---------------------
12357:
12358: OutputSaving:
12359: lda zNSGFLG ; do we output messages "searching for", or is it prohibited?
12360: bpl SAVE_Rts ; no -> branch -> quit, we don't want to output anything
12361:
12362: ldy #StrSaving - LMESSAGES ; offset of "Saving" message
12363: jsr OutputMessage ; output it
12364:
12365: jmp OutputFilename ; output the file name of file to be saved
12366: ; ---------------------
12367:
12368:
12369: ; B-36. Function Name: UDTIM
12370: ;
12371: ; Purpose: Update the system clock
12372: ; Call address: $FFEA (hex) 65514 (decimal)
12373: ; Communication registers: None
12374: ; Preparatory routines: None
12375: ; Error returns: None
12376: ; Stack requirements: 2
12377: ; Registers affected: A, X
12378: ;
12379: ; Description: This routine updates the system clock. Normally this
12380: ; routine is called by the normal KERNAL interrupt routine every 1/60th of
12381: ; a second. If the user program processes its own interrupts this routine
12382: ; must be called to update the time. In addition, the <STOP> key routine
12383: ; must be called, if the <STOP> key is to remain functional.
12384: ;
12385: ; How to Use:
12386: ; 1) Call this routine.
12387: ;
12388: ; EXAMPLE:
12389: ;
12390: ; JSR UDTIM
12391: ;
12392: ;
12393: iUDTIM:
12394: ldx #0 ; will be used in the case of a wrap-around of the timer for setting the timer back to zero.
12395:
12396: inc zTIME + 2 ; increment lowest byte
12397: bne @CheckOverflow ; no overflow -> done incrementing
12398:
12399: inc zTIME + 1 ; increment middle byte
12400: bne @CheckOverflow ; no overflow -> done incrementing
12401:
12402: inc zTIME ; increment highest byte
12403:
12404: @CheckOverflow:
12405:
12406: ; now, check if the timer overflowed, that is, 24h have been reached
12407: ; for this, subtract the constant for 24h (24*60*60*60)+1 from the
12408: ; current value
12409:
12410: sec
12411: lda zTIME + 2
12412: sbc #<((24*60*60*60)+1)
12413: lda zTIME + 1
12414: sbc #>((24*60*60*60)+1)
12415: lda zTIME
12416: sbc #^((24*60*60*60)+1)
12417:
12418: ; if carry is not set, the timer value is smaller -> branch, no need to perform wrap-around
12419: bcc iUDTIM_CheckRunStop
12420:
12421: ; we had a wrap-around, set timer value to 0
12422: stx zTIME
12423: stx zTIME + 1
12424: stx zTIME + 2
12425:
12426: iUDTIM_CheckRunStop:
12427: ; check if the Run/STOP key has been pressed
12428:
12429: ; TODO document
12430:
12431: lda KEYB_COL_FOR_STOP
12432: cmp KEYB_COL_FOR_STOP
12433: bne iUDTIM_CheckRunStop
12434:
12435: .if CompileComputer >= C64_GENERAL
12436: tax
12437: bmi @StoreStop
12438: ldx #KEYB_ROW_STOP
12439: stx KEYB_ROW
12440: @Debounce:
12441: ldx KEYB_COL_FOR_STOP
12442: cpx KEYB_COL_FOR_STOP
12443: bne @Debounce
12444: sta KEYB_ROW
12445: inx
12446: bne @Rts
12447: .endif
12448:
12449: @StoreStop:
12450: sta zSTKEY
12451: @Rts:
12452: rts
12453:
12454:
12455: ; B-21. Function Name: RDTIM
12456: ;
12457: ; Purpose: Read system clock
12458: ; Call address: $FFDE (hex) 65502 (decimal)
12459: ; Communication registers: A, X, Y
12460: ; Preparatory routines: None
12461: ; Error returns: None
12462: ; Stack requirements: 2
12463: ; Registers affected: A, X, Y
12464: ;
12465: ; Description: This routine is used to read the system clock. The clock's
12466: ; resolution is a 60th of a second. Three bytes are returned by the
12467: ; routine. The accumulator contains the most significant byte, the X index
12468: ; register contains the next most significant byte, and the Y index
12469: ; register contains the least significant byte.
12470: ;
12471: ; EXAMPLE:
12472: ;
12473: ; JSR RDTIM
12474: ; STY TIME
12475: ; STX TIME+1
12476: ; STA TIME+2
12477: ; ...
12478: ; TIME *=*+3
12479: ;
12480: ;
12481: iRDTIM:
12482: sei ; make sure we get not interrupted (atomicity)
12483:
12484: ; read the values of the time
12485: lda zTIME + 2 ; high byte
12486: ldx zTIME + 1 ; middle byte
12487: ldy zTIME ; low byte
12488:
12489: ; B-31. Function Name: SETTIM
12490: ;
12491: ; Purpose: Set the system clock
12492: ; Call address: $FFDB (hex) 65499 (decimal)
12493: ; Communication registers: A, X, Y
12494: ; Preparatory routines: None
12495: ; Error returns: None
12496: ; Stack requirements: 2
12497: ; Registers affected: None
12498: ;
12499: ;
12500: ;
12501: ; Description: A system clock is maintained by an interrupt routine that
12502: ; updates the clock every 1/60th of a second (one "jiffy"). The clock is
12503: ; three bytes long, which gives it the capability to count up to 5,184,000
12504: ; jiffies (24 hours). At that point the clock resets to zero. Before
12505: ; calling this routine to set the clock, the accumulator must contain the
12506: ; most significant byte, the X index register the next most significant
12507: ; byte, and the Y index register the least significant byte of the initial
12508: ; time setting (in jiffies).
12509: ;
12510: ; How to Use:
12511: ; 1) Load the accumulator with the MSB of the 3-byte number to set the
12512: ; clock.
12513: ; 2) Load the X register with the next byte.
12514: ; 3) Load the Y register with the LSB.
12515: ; 4) Call this routine.
12516: ;
12517: ; EXAMPLE:
12518: ; ;SET THE CLOCK TO 10 MINUTES = 3600 JIFFIES
12519: ; LDA #0 ;MOST SIGNIFICANT
12520: ; LDX #>3600
12521: ; LDY #<3600 ;LEAST SIGNIFICANT
12522: ; JSR SETTIM
12523: ;
12524: iSETTIM:
12525: sei ; make sure we get not interrupted (atomicity)
12526:
12527: ; set the values of the time
12528: sta zTIME + 2 ; high byte
12529: stx zTIME + 1 ; middle byte
12530: sty zTIME ; low byte
12531:
12532: cli ; the critical section is over
12533:
12534: rts
12535: ; ----------------
12536:
12537: ; B-33. Function Name: STOP
12538: ;
12539: ; Purpose: Check if <STOP> key is pressed
12540: ; Call address: $FFE1 (hex) 65505 (decimal)
12541: ; Communication registers: A
12542: ; Preparatory routines: None
12543: ; Error returns: None
12544: ; Stack requirements: None
12545: ; Registers affected: A, X
12546: ;
12547: ; Description: If the <STOP> key on the keyboard was pressed during a
12548: ; UDTIM call, this call returns the Z flag set. In addition, the channels
12549: ; will be reset to default values. All other flags remain unchanged. If the
12550: ; <STOP> key is not pressed then the accumulator will contain a byte
12551: ; representing the lost row of the keyboard scan. The user can also check
12552: ; for certain other keys this way.
12553: ;
12554: ; How to Use:
12555: ; 0) UDTIM should be called before this routine.
12556: ; 1) Call this routine.
12557: ; 2) Test for the zero flag.
12558: ;
12559: ;
12560: ; EXAMPLE:
12561: ;
12562: ; JSR UDTIM ;SCAN FOR STOP
12563: ; JSR STOP
12564: ; BNE *+5 ;KEY NOT DOWN
12565: ; JMP READY ;=... STOP
12566: ;
12567: KSTOP:
12568: lda zSTKEY
12569: cmp #KEYB_CHECK_STOP ; was <STOP> key pressed?
12570: bne @Rts ; no -> branch, quit
12571:
12572: php ; make sure to preserve the status of Z (=1)
12573:
12574: jsr kCLRCHN ; clear default input and output devices
12575: ; (returns with A=0)
12576: sta zNDX ; mark: No characters in the keyboard buffer
12577:
12578: plp ; get back the status of Z (=1)
12579:
12580: @Rts: rts
12581: ; -----------------
12582:
12583: ; ERROR CODES
12584: ;
12585: ; The following is a list of error messages which can occur when using
12586: ; the KERNAL routines. If an error occurs during a KERNAL routine , the
12587: ; carry bit of the accumulator is set, and the number of the error message
12588: ; is returned in the accumulator.
12589: ; +-----------------------------------------------------------------------+
12590: ; | NOTE: Some KERNAL I/O routines do not use these codes for error |
12591: ; | messages. Instead, errors are identified using the KERNAL READST |
12592: ; | routine. |
12593: ; +-----------------------------------------------------------------------+
12594: ; +-------+---------------------------------------------------------------+
12595: ; | NUMBER| MEANING |
12596: ; +-------+---------------------------------------------------------------+
12597: ; | 0 | Routine terminated by the <STOP> key |
12598: ; | 1 | Too many open files |
12599: ; | 2 | File already open |
12600: ; | 3 | File not open |
12601: ; | 4 | File not found |
12602: ; | 5 | Device not present |
12603: ; | 6 | File is not an input file |
12604: ; | 7 | File is not an output file |
12605: ; | 8 | File name is missing |
12606: ; | 9 | Illegal device number |
12607: ; | 240 | Top-of-memory change RS-232 buffer allocation/deallocation |
12608: ; +-------+---------------------------------------------------------------+
12609: KErrTooManyOpenFiles:
12610: lda #$01
12611: .byte ASM_BIT3
12612:
12613: KErrFileOpen:
12614: lda #$02
12615: .byte ASM_BIT3
12616:
12617: KErrFileNotOpen:
12618: lda #$03
12619: .byte ASM_BIT3
12620:
12621: KErrFileNotFound:
12622: lda #$04
12623: .byte ASM_BIT3
12624:
12625: KErrDeviceNotPresent:
12626: lda #$05
12627: .byte ASM_BIT3
12628:
12629: KErrNotInputFile:
12630: lda #$06
12631: .byte ASM_BIT3
12632:
12633: KErrNotOutputFile:
12634: lda #$07
12635: .byte ASM_BIT3
12636:
12637: KErrFileNameMissing:
12638: lda #$08
12639: .byte ASM_BIT3
12640:
12641: KErrIllegalDeviceNumber:
12642: lda #$09
12643:
12644: pha ; remember error number
12645: jsr kCLRCHN ; restore output and input to console
12646: ldy #StrIoError - LMESSAGES ; prepare to output "I/O ERROR #" by getting its index
12647:
12648: bit zNSGFLG ; check the flag which has the message output policy
12649: bvc @NoOutput ; test bit 6: Output error message. If not set -> branch, do not output text
12650:
12651: jsr OutputMessage ; output the message with index in Y
12652:
12653: pla ; get back error number
12654: pha ; and remember it again
12655:
12656: ora #'0' ; convert it to ASCII ('0' - '9')
12657: jsr kCHROUT ; and output it
12658:
12659: @NoOutput:
12660: pla ; get back the error number
12661: sec ; mark: An error occurred
12662: rts
12663: ; --------------
12664: .ifdef JIFFY
12665: ; .include "../kernal/jiffydos.a65"
12666:
12667: ; These are not used nor really defined,
12668: ; but the values are still in the ROM as JD
12669: ; has just been patched in.
12670: ; So, we define it to make the assembler + linker
12671: ; happy.
12672:
12673: TapeIrqRead=$F92C
12674: TapeIrqWrite=$FBCD
12675: TapeIrqWritePreamble=$FC6A
12676:
12677:
12678: JDLF72C:
12679: ldy #$0C
12680: jsr zCHRGOT
12681: JDLF731:
12682: cmp JDLF7DD,y
12683: beq JDLF739
12684: dey
12685: bpl JDLF731
12686: JDLF739:
12687: rts
12688: JDLF73A:
12689: jsr kSETLFS
12690: JDLF73D:
12691: clc
12692: php
12693: ldx zFSBLK
12694: cpx #$08
12695: bcc JDLF749
12696: JDLF745:
12697: cpx #$1F
12698: bcc JDLF750
12699: JDLF749:
12700: plp
12701: bcs JDLF761
12702: sec
12703: php
12704: ldx #$08
12705: JDLF750:
12706: stx zFSBLK
12707: jsr LF2D9
12708: bcc JDLF75A
12709: inx
12710: bne JDLF745
12711: JDLF75A:
12712: pla
12713: JDLF75B:
12714: rts
12715:
12716: JDLF75C:
12717: jsr LF2DB
12718: bcc JDLF75B
12719: JDLF761:
12720: ldx #$05
12721: JDLF763:
12722: cpx #$0B
12723: beq JDLF76A
12724: JDLF767:
12725: jmp PatchErrorOut
12726: JDLF76A:
12727: jsr JDLF72C
12728: bne JDLF767
12729: sty $27
12730: tax
12731: bmi JDLF776
12732: pla
12733: pla
12734: JDLF776:
12735: jsr JDLF73D
12736: jsr JDLF838
12737: lda $27
12738: ldy #$00
12739: asl a
12740: tax
12741: lda JDLF7F5,x
12742: sta $55
12743: lda JDLF7F6,x
12744: sta $56
12745: JDLF78C:
12746: jsr zJMPER
12747: jsr bDATA
12748: jsr LF2CC
12749: lda zPTR2
12750: jsr kCLOSE
12751: JDLF79A:
12752: jsr kCLRCHN
12753: ldx $13
12754: beq JDLF75B
12755: .byte $2C
12756: JDLF7A2:
12757: ldx #$6F
12758: jmp kCHKOUT
12759: tya
12760: iny
12761: bit $98C8
12762: sty zSA
12763: ldx zTXTTAB
12764: ldy $2C
12765: jsr kLOAD
12766: bcc JDLF7C0
12767: jmp bBIOERR
12768: JDLF7BA:
12769: jmp ChkStatus
12770: JDLF7BD:
12771: jmp JDLE17E
12772: JDLF7C0:
12773: lda $27
12774: cmp #$0B
12775: beq JDLF7BD
12776: bcs JDLF78C
12777: cmp #$08
12778: beq JDLF75B
12779: bcc JDLF7BA
12780: stx zVARTAB
12781: sty $2E
12782: pla
12783: pla
12784: jsr bCRDO
12785: jsr bLINKPRG
12786: jmp bRUN
12787: JDLF7DD:
12788: rti
12789: .byte $5F
12790: rol a
12791: ldy $1222
12792: .byte $2F
12793: lda $5E25
12794: ldx $5C27
12795: .byte $44
12796: jmp $2354
12797: .byte $42
12798: lsr $4F
12799: bvc JDLF844
12800: cli
12801: .byte $47
12802: JDLF7F5:
12803: .byte $33
12804: JDLF7F6:
12805: sbc $59,x
12806: sbc (zCURLIN,x)
12807: .byte $FA
12808: and $2BFA,y
12809: .byte $F7
12810: .byte $2B
12811: .byte $F7
12812: .byte $AB
12813: .byte $F7
12814: .byte $AB
12815: .byte $F7
12816: .byte $A7
12817: .byte $F7
12818: .byte $AB
12819: .byte $F7
12820: .byte $AB
12821: .byte $F7
12822: tax
12823: .byte $F7
12824: .byte $A7
12825: .byte $F7
12826: adc #$F5
12827: .byte $D4
12828: sed
12829: rti
12830: sbc $F1,x
12831: sbc ($2C),y
12832: sbc JDLE4C2,y
12833: and $F8
12834: .byte $97
12835: .byte $FA
12836: ldy $A0FC,x
12837: .byte $FC
12838: bit zROBUF
12839: iny
12840: tya
12841: sta (zTXTTAB),y
12842: jsr bLINKPRG
12843: txa
12844: adc #$02
12845: tax
12846: lda $23
12847: adc #$00
12848: tay
12849: jmp JDLE1A7
12850: JDLF838:
12851: tya
12852: bne JDLF853
12853: sta zFNLEN
12854: jsr zCHRGET
12855: beq JDLF887
12856: ldy #$17
12857: JDLF844:
12858: jsr JDLF731
12859: bne JDLF858
12860: cpy #$0D
12861: bcc JDLF858
12862: sty $27
12863: cpy #$10
12864: bcs JDLF887
12865: JDLF853:
12866: lda #$01
12867: jsr JDLA8FC
12868: JDLF858:
12869: ldy #$FF
12870: JDLF85A:
12871: iny
12872: lda (zTXTPTR),y
12873: beq JDLF867
12874: cmp #$22
12875: beq JDLF872
12876: cmp #$3A
12877: bne JDLF85A
12878: JDLF867:
12879: bit zNSGFLG
12880: bpl JDLF875
12881: clc
12882: jsr LAEBD
12883: jmp JDLF878
12884: JDLF872:
12885: jsr LA8FB
12886: JDLF875:
12887: jsr bFRMEVL
12888: JDLF878:
12889: jsr JDLE25A
12890: jsr zCHRGOT
12891: cmp #$2C
12892: bne JDLF887
12893: jsr bGTBYTC
12894: JDLF885:
12895: stx zFA
12896: JDLF887:
12897: ldy #$00
12898: bit zNSGFLG
12899: bpl JDLF89A
12900: JDLF88D:
12901: lda (zPNT),y
12902: cmp #$20
12903: beq JDLF89A
12904: lda #$0D
12905: jsr CHROUT_SCREEN
12906: bne JDLF88D
12907: JDLF89A:
12908: jsr JDLF75C
12909: lda #$FF
12910: jsr LB475
12911: lda zFNLEN
12912: ldx zFNADR
12913: ldy $BC
12914: jsr JDLB4C7
12915: jsr bFRESTR
12916: stx zFNADR
12917: sty $BC
12918: JDLF8B2:
12919: jsr LF2CF
12920: lda zFNLEN
12921: ldx #$00
12922: stx zFNLEN
12923: ldx #$6F
12924: bne JDLF8C3
12925: JDLF8BF:
12926: ldx #$6E
12927: JDLF8C1:
12928: lda zFNLEN
12929: JDLF8C3:
12930: stx zSA
12931: stx zPTR2
12932: JDLF8C7:
12933: pha
12934: stx zLA
12935: jsr kCLRCHN
12936: jsr kOPEN
12937: pla
12938: sta zFNLEN
12939: JDLF8D3:
12940: rts
12941: jsr JDLF1E8
12942: bne JDLF8D3
12943: ldx #$00
12944: ldy #$22
12945: jsr JDLF8E4
12946: ldy #$05
12947: ldx #$22
12948: JDLF8E4:
12949: jsr JDLF0F4
12950: jmp kCLRCHN
12951: JDLF8EA:
12952: sta CIA2
12953: and #$08
12954: beq JDLF910
12955: lda zBSOUR
12956: ror a
12957: ror a
12958: cpx #$02
12959: bne JDLF910
12960: ldx #$1E
12961: JDLF8FB:
12962: bit CIA2
12963: bpl JDLF905
12964: dex
12965: bne JDLF8FB
12966: beq JDLF90E
12967: JDLF905:
12968: bit CIA2
12969: bpl JDLF905
12970: ora #$40
12971: sta zTSFCNT
12972: JDLF90E:
12973: ldx #$02
12974: JDLF910:
12975: rts
12976: JDLF911:
12977: ldy #$00
12978: jsr JDLF0E2
12979: JDLF916:
12980: jsr JDLFCA9
12981: bvs JDLF91D
12982: bcc JDLF916
12983: JDLF91D:
12984: sty zFNLEN
12985: lda zSTATUS
12986: and #$82
12987: rts
12988: jsr bGTBYTC
12989: txa
12990: ldx #$2D
12991: bne JDLF930
12992: JDLF92C:
12993: lda #$85
12994: ldx #$27
12995: JDLF930:
12996: ldy #$06
12997: JDLF932:
12998: pha
12999: jsr JDLF0F4
13000: pla
13001: jmp kCHROUT
13002: JDLF93A:
13003: ldx #$00
13004: .byte $2C
13005: JDLF93D:
13006: ldx #$06
13007: jsr bSTXPT
13008: ldy #$05
13009: lda (zTXTPTR),y
13010: cmp #$12
13011: bne JDLF9B0
13012: pla
13013: txa
13014: pha
13015: ldy #$23
13016: JDLF94F:
13017: ldx #$22
13018: jsr JDLA917
13019: dey
13020: jsr LA8FB
13021: pla
13022: pha
13023: beq JDLF96C
13024: sta zPNTR
13025: ldy #$01
13026: JDLF960:
13027: iny
13028: jsr JDLF16A
13029: cmp (zTXTPTR),y
13030: bne JDLF977
13031: sbc #$22
13032: bne JDLF960
13033: JDLF96C:
13034: tay
13035: lda (zTXTPTR),y
13036: eor #$0A
13037: sta (zTXTPTR),y
13038: ldy #$04
13039: sta (zPNT),y
13040: JDLF977:
13041: jsr bDATA
13042: ldy #$05
13043: sec
13044: lda (zTXTPTR),y
13045: sbc #$42
13046: bne JDLF94F
13047: ldy #$02
13048: sta (zTXTPTR),y
13049: pla
13050: beq JDLF98D
13051: lda #$8D
13052: rts
13053: JDLF98D:
13054: jmp LA6A4
13055: JDLF990:
13056: bit zNSGFLG
13057: bpl JDLF9B0
13058: tsx
13059: ldy $0107,x
13060: cpy #$E1
13061: bne JDLF9B0
13062: cmp #$04
13063: bne JDLF9B2
13064: inc zFSBLK
13065: jsr JDLF73D
13066: lda #$00
13067: jsr LBDCD
13068: jsr bCRDO
13069: jsr JDLF79A
13070: JDLF9B0:
13071: pla
13072: rts
13073: JDLF9B2:
13074: cmp #$01
13075: beq JDLF93A
13076: cmp #$17
13077: beq JDLF93D
13078: ldy zPRTY
13079: bne JDLF9B0
13080: cmp #$8D
13081: bcs JDLF9B0
13082: cmp #$85
13083: bcc JDLF9B0
13084: pla
13085: sbc #$85
13086: tax
13087: beq JDLF9D5
13088: JDLF9CC:
13089: iny
13090: lda (zCMPO),y
13091: bne JDLF9CC
13092: dex
13093: bne JDLF9CC
13094: JDLF9D4:
13095: iny
13096: JDLF9D5:
13097: lda (zCMPO),y
13098: beq JDLF9E2
13099: cmp #$0D
13100: beq JDLF9E4
13101: jsr CHROUT_SCREEN
13102: bne JDLF9D4
13103: JDLF9E2:
13104: sta zQTSW
13105: JDLF9E4:
13106: rts
13107: JDLF9E5:
13108: jsr GETIN_KEYB
13109: pha
13110: ldx zQTSW
13111: bne JDLFA37
13112: ldx zINSRT
13113: bne JDLFA37
13114: cmp #$10
13115: bne JDLF990
13116: lda #$04
13117: jsr kLISTEN
13118: lda VIC + VICII_O_MemControl
13119: and #$02
13120: beq JDLFA03
13121: lda #$07
13122: JDLFA03:
13123: ora #$60
13124: jsr kSECOND
13125: lda zPNTR
13126: pha
13127: lda zTBLX
13128: pha
13129: JDLFA0E:
13130: ldy #$00
13131: sty zQTSW
13132: jsr JDLE50C
13133: inc zLNMX
13134: JDLFA17:
13135: jsr JDLF16A
13136: jsr iCIOUT
13137: cmp #$0D
13138: bne JDLFA17
13139: inx
13140: cpx #$19
13141: bcs JDLFA2D
13142: asl zLNMX
13143: bpl JDLFA0E
13144: inx
13145: bne JDLFA0E
13146: JDLFA2D:
13147: jsr kUNLSN
13148: pla
13149: tax
13150: pla
13151: tay
13152: jsr JDLE50C
13153: JDLFA37:
13154: pla
13155: JDLFA38:
13156: rts
13157: sty zRESHO
13158: jsr JDLF1E8
13159: bne JDLFA38
13160: jsr zCHRGOT
13161: cmp #$52
13162: bne JDLFA5A
13163: JDLFA47:
13164: dec zRESHO
13165: lda zRESHO
13166: jsr LF66B
13167: jsr JDLE4C6
13168: beq JDLFA47
13169: lda #$00
13170: jsr LF66B
13171: lda #$4C
13172: JDLFA5A:
13173: pha
13174: ldx zMYCH
13175: cpx zFA
13176: beq JDLFA37
13177: jsr JDLF885
13178: ldx #$37
13179: ldy #$02
13180: jsr JDLF0F4
13181: jsr OutputFilename
13182: lda #$2C
13183: sta (zFNADR),y
13184: iny
13185: pla
13186: sta (zFNADR),y
13187: iny
13188: lda #$2C
13189: sta (zFNADR),y
13190: iny
13191: lda zRESHO
13192: pha
13193: bne JDLFA83
13194: lda #$57
13195: JDLFA83:
13196: sta (zFNADR),y
13197: iny
13198: sty zFNLEN
13199: ldy #$0C
13200: JDLFA8A:
13201: jsr JDLFAB2
13202: jsr JDLF73D
13203: jsr JDLF8B2
13204: pla
13205: jsr LF541
13206: lda $13
13207: beq JDLFAA7
13208: cmp #$7F
13209: bne JDLFA38
13210: jsr LABB7
13211: lda #$7F
13212: jmp kCLOSE
13213: JDLFAA7:
13214: ldx #$04
13215: jsr zCHRGET
13216: jsr JDLE229
13217: jsr JDLF75C
13218: JDLFAB2:
13219: sty zSA
13220: ldx #$7F
13221: stx $13
13222: lda zFNLEN
13223: jmp JDLF8C7
13224: tax
13225: bne JDLFA8A
13226: lda zNXTBIT
13227: beq JDLFACE
13228: JDLFAC4:
13229: jsr OutputLoadingOrVerify
13230: tsx
13231: lda $0102,x
13232: cmp #$F7
13233: .byte $D0
13234: JDLFACE:
13235: php
13236: lda zEAL
13237: sta $55
13238: lda $AF
13239: sta $56
13240: bit zTSFCNT
13241: bmi JDLFADE
13242: jmp LF4F3
13243: JDLFADE:
13244: sei
13245: ldy #$03
13246: JDLFAE1:
13247: lda $AF,y
13248: pha
13249: dey
13250: bne JDLFAE1
13251: lda VIC + VICII_O_SprEnable
13252: sta zCMPO
13253: jsr JDLF0D8
13254: JDLFAF0:
13255: jsr iUDTIM_CheckRunStop
13256: bpl JDLFB27
13257: lda VIC + VICII_O_ControlReg1
13258: and #$07
13259: clc
13260: adc #$2F
13261: sta $B1
13262: lda CIA2
13263: and #$07
13264: sta zTAPE1
13265: sta CIA2
13266: ora #$20
13267: tax
13268: JDLFB0C:
13269: bit CIA2
13270: bvc JDLFB0C
13271: bpl JDLFB3E
13272: ldx #$64
13273: JDLFB15:
13274: bit CIA2
13275: bvc JDLFB20
13276: dex
13277: bne JDLFB15
13278: lda #$42
13279: .byte $2C
13280: JDLFB20:
13281: lda #$40
13282: jsr SetStatus
13283: clc
13284: .byte $24
13285: JDLFB27:
13286: sec
13287: lda zCMPO
13288: sta VIC + VICII_O_SprEnable
13289: pla
13290: sta zCMPO
13291: pla
13292: sta $B1
13293: pla
13294: sta zTAPE1
13295: bcs JDLFB3B
13296: jmp KLOAD_UntalkClose
13297:
13298: JDLFB3B:
13299: jmp IecCloseBecauseStopKey
13300: JDLFB3E:
13301: bit CIA2
13302: bpl JDLFB3E
13303: sec
13304: JDLFB44:
13305: lda VIC + VICII_O_Raster
13306: sbc $B1
13307: bcc JDLFB4F
13308: and #$07
13309: beq JDLFB44
13310: JDLFB4F:
13311: lda zTAPE1
13312: stx CIA2
13313: bit CIA2
13314: bvc JDLFAF0
13315: nop
13316: sta CIA2
13317: ora CIA2
13318: lsr a
13319: lsr a
13320: nop
13321: ora CIA2
13322: lsr a
13323: lsr a
13324: eor zTAPE1
13325: eor CIA2
13326: lsr a
13327: lsr a
13328: eor zTAPE1
13329: eor CIA2
13330: cpy zVERCKK
13331: bne JDLFB83
13332: sta (zEAL),y
13333: JDLFB7A:
13334: inc zEAL
13335: bne JDLFB44
13336: inc zEAL + 1
13337: jmp JDLFB44
13338: JDLFB83:
13339: cmp (zEAL),y
13340: beq JDLFB7A
13341: sec
13342: lda #$10
13343: sta zSTATUS
13344: bne JDLFB7A
13345:
13346: Copy_zSTAL_to_zSAL:
13347: lda zSTAL + 1
13348: sta zSAL + 1
13349: lda zSTAL
13350: sta zSAL
13351: rts
13352: ; -------------------------
13353:
13354: JDLFB97:
13355: pha
13356: jsr JDLF0D8
13357: jsr JDLFBB4
13358: pla
13359: sta VIC + VICII_O_SprEnable
13360: lda zTBTCNT
13361: rts
13362: JDLFBA5:
13363: lda #$00
13364: jmp JDiACPTR
13365: JDLFBAA:
13366: sei
13367: bit zTSFCNT
13368: bvc JDLFBA5
13369: lda VIC + VICII_O_SprEnable
13370: bne JDLFB97
13371: JDLFBB4:
13372: lda CIA2
13373: cmp #$40
13374: bcc JDLFBB4
13375: and #$07
13376: pha
13377: JDLFBBE:
13378: lda VIC + VICII_O_Raster
13379: sbc VIC + VICII_O_ControlReg1
13380: and #$07
13381: cmp #$07
13382: bcs JDLFBBE
13383: pla
13384: .byte $8D
13385: brk
13386: JDLFBCD:
13387: cmp $A485,x
13388: ora #$20
13389: pha
13390: nop
13391: nop
13392: ora CIA2
13393: lsr a
13394: lsr a
13395: nop
13396: ora CIA2
13397: lsr a
13398: lsr a
13399: eor zTBTCNT
13400: eor CIA2
13401: lsr a
13402: lsr a
13403: eor zTBTCNT
13404: eor CIA2
13405: sta zTBTCNT
13406: pla
13407: bit CIA2
13408: sta CIA2
13409: bvc JDLFC22
13410: bpl JDLFC1D
13411: lda #$42
13412: jmp IecSetStatusAndFreeBus
13413: JDLFBFE:
13414: sei
13415: bit zTSFCNT
13416: bvc JDLFC14
13417: JDLFC03:
13418: lda VIC + VICII_O_SprEnable
13419: beq JDLFC27
13420: pha
13421: jsr JDLF0D8
13422: jsr JDLFC27
13423: pla
13424: sta VIC + VICII_O_SprEnable
13425: rts
13426: JDLFC14:
13427: lda zTSFCNT
13428: cmp #$A0
13429: bcs JDLFC03
13430: jmp IecOutputByte
13431: JDLFC1D:
13432: lda #$40
13433: jsr SetStatus
13434: JDLFC22:
13435: lda zTBTCNT
13436: JDLFC24:
13437: cli
13438: clc
13439: rts
13440: JDLFC27:
13441: txa
13442: pha
13443: lda zBSOUR
13444: and #$F0
13445: pha
13446: lda zBSOUR
13447: and #$0F
13448: tax
13449: JDLFC33:
13450: lda CIA2
13451: bpl JDLFC33
13452: and #$07
13453: sta zBSOUR
13454: sec
13455: JDLFC3D:
13456: lda VIC + VICII_O_Raster
13457: sbc VIC + VICII_O_ControlReg1
13458: and #$07
13459: cmp #$06
13460: bcs JDLFC3D
13461: lda zBSOUR
13462: sta CIA2
13463: pla
13464: ora zBSOUR
13465: sta CIA2
13466: lsr a
13467: lsr a
13468: and #$F0
13469: ora zBSOUR
13470: sta CIA2
13471: lda JDLFC8A,x
13472: ora zBSOUR
13473: sta CIA2
13474: lsr a
13475: lsr a
13476: and #$F0
13477: .byte $05
13478: JDLFC6A:
13479: sta $8D,x
13480: brk
13481: cmp $0F29,x
13482: bit zTSFCNT
13483: bmi JDLFC76
13484: ora #$10
13485: JDLFC76:
13486: sta CIA2
13487: pla
13488: tax
13489: lda zBSOUR
13490: ora #$10
13491: sta CIA2
13492: bit CIA2
13493: bpl JDLFC24
13494: jmp SendTimeout
13495:
13496: ; @@@ todo table?
13497:
13498: JDLFC8A:
13499: .byte $00,$80,$20,$A0
13500: .byte $40,$C0,$60,$E0
13501: .byte $10,$90,$30,$B0
13502: .byte $50,$D0,$70,$F0
13503:
13504: JDLFC9A:
13505: jsr JDLF7A2
13506: jmp OutputFilename
13507: jsr bGTBYTC
13508: stx zMYCH
13509: rts
13510: JDLFCA6:
13511: jsr JDLF0E2
13512: JDLFCA9:
13513: jsr kCHRIN
13514: sta (zFNADR),y
13515: iny
13516: bit zSTATUS
13517: bvs JDLFCBB
13518: cpy #$FE
13519: bcs JDLFCBB
13520: cmp #$01
13521: bcs JDLFCA9
13522: JDLFCBB:
13523: rts
13524: ldx #$05
13525: JDLFCBE:
13526: lda LF1A3,x
13527: sta lIERROR,x
13528: dex
13529: JDLFCC5:
13530: bpl JDLFCBE
13531: stx zPRTY
13532: rts
13533: lda zCNTDN
13534: ora ($29,x)
13535: sbc $0185,x
13536:
13537:
13538:
13539: ; Taken from vanilla C64/VIC-20 KERNAL
13540: ; (tape.a65)
13541:
13542:
13543: ; Check if the end address has been reached
13544: ; in writing
13545: ;
13546: ; Return:
13547: ; C = 0: End address has not yet been reached
13548: ; C = 1: End address has been reached
13549: ;
13550: ; This routine calculated zSAL/zSAL+1 - zEAL/zEAL+1.
13551: ; If zSAL/zSAL+1 is smaller than zEAL/zEAL+1, we end with C=0, as there was a "borrow".
13552: ; Otherwise (equal or bigger), C=1 as no borrow occurred.
13553: ;
13554: ; This routine is also used in fileio.a65 for IEC transfers
13555: ;
13556: HasEndAddressBeenReached:
13557: sec
13558: lda zSAL
13559: sbc zEAL
13560: lda zSAL + 1
13561: sbc zEAL + 1
13562: rts
13563:
13564: ; Increment the zSAL/zSAL+1 address
13565: ; That is, this routine proceeds the pointer to the next character to be written/read.
13566: ;
13567: ; This routine is also used in fileio.a65 for IEC transfers
13568: ;
13569: Increment_zSAL_Address:
13570: inc zSAL
13571: bne @Rts
13572: inc zSAL + 1
13573: @Rts:
13574: rts
13575: ; ------------------------
13576:
13577: .else
13578: ; .include "../kernal/tape.a65"
13579: TAPE_BUFFER_TYPE_BASIC = $01
13580: TAPE_BUFFER_TYPE_CONTINUATION = $02
13581: TAPE_BUFFER_TYPE_ABSOLUTE = $03
13582: TAPE_BUFFER_TYPE_DATA = $04
13583: TAPE_BUFFER_TYPE_EOT = $05
13584:
13585: TAPE_BUFFER_OFFSET_TYPE = $00
13586: TAPE_BUFFER_OFFSET_SAL_LOW = $01
13587: TAPE_BUFFER_OFFSET_SAL_HIGH = $02
13588: TAPE_BUFFER_OFFSET_EAL_LOW = $03
13589: TAPE_BUFFER_OFFSET_EAL_HIGH = $04
13590: TAPE_BUFFER_OFFSET_FILENAME = $05 ; start of file name in every tape buffer but TAPE_BUFFER_TYPE_CONTINUATION
13591: TAPE_BUFFER_OFFSET_ENDFILENAME = $15 ; one after the end of the file name in every tape buffer but TAPE_BUFFER_TYPE_CONTINUATION
13592:
13593:
13594: TAPE_TIMER_CONSTANT_BIT0 := $60
13595: TAPE_TIMER_CONSTANT_BIT1 := $B0
13596: TAPE_TIMER_CONSTANT_PREAMBLE := $78
13597: TAPE_TIMER_CONSTANT_WRITE := $0110
13598:
13599: TAPE_RIPRTY_69 := $69
13600: TAPE_RIPRTY_14 := $14
13601:
13602: ; Define some aliases for understandability
13603:
13604: Pass1ReadErrors = zPTR1
13605: Pass2ReadErrors = zPTR2
13606: ReadCharacterError = zRODATA
13607: ReadCharacterIn = zROPRTY
13608: WriteCharacterOut = zROPRTY
13609: NrBlocksRemaining = zINBIT
13610: ByteReceivedFlag = zDPSW
13611: SerialWordBuffer = zMYCH
13612: ReadBitSequenceErrors = zRINONE
13613: ErrorFlagOnTapeRead = zBITC1
13614:
13615:
13616: ; Tape buffer format on tape (cf. TapeCreateFileBuffer):
13617: ; $00: type of block (cf. TAPE_BUFFER_TYPE_... constants above)
13618: ;
13619: ; if type of block == $01, $03, $04 or $05:
13620: ; $01: start address low
13621: ; $02: start address high
13622: ; $03: end address low
13623: ; $04: end address high
13624: ; $05 - $14: name of file
13625: ;
13626:
13627:
13628: .if CompileComputer = C64_GS
13629:
13630: ; .include "../c64/c64gs.inc"
13631: zFB = $fb
13632: zFC = $fc
13633:
13634: L0E00 := $0e00
13635:
13636:
13637: sec
13638: .byte ASM_BIT2
13639:
13640: C64GS_Init:
13641: clc
13642: ror zFB
13643: php
13644: sei
13645:
13646: lda #VICII_B_ControlReg1_RSEL + 3
13647: sta VIC + VICII_O_ControlReg1
13648:
13649: lda #$17
13650: sta VIC + VICII_O_MemControl
13651:
13652: ldx #0
13653:
13654: @ClearLoop:
13655: lda #0
13656: sta COLORRAM,x
13657: sta COLORRAM + $100,x
13658: sta COLORRAM + $200,x
13659: sta COLORRAM + $300,x
13660:
13661: lda #' '
13662: sta lVIDEORAM,x
13663: sta lVIDEORAM + $100,x
13664: sta lVIDEORAM + $200,x
13665: sta lVIDEORAM + $300,x
13666:
13667: inx
13668: bne @ClearLoop
13669:
13670: lda #<(lVIDEORAM + 83)
13671: sta zFC
13672: lda #>(lVIDEORAM + 83)
13673: sta zFC + 1
13674:
13675: ldx #$15
13676: @OuterLoop:
13677: ldy #$21
13678: lda #$A0
13679: @SpaceLoop:
13680: sta (zFC),y
13681: dey
13682: bne @SpaceLoop
13683:
13684: clc
13685: lda zFC
13686: adc #40
13687: sta zFC
13688: bcc :+
13689: inc zFC + 1
13690: :
13691: dex
13692: bne @OuterLoop
13693:
13694: lda #' '
13695: sta lVIDEORAM + 2 * 40 + 36
13696: sta lVIDEORAM + 22 * 40 + 4
13697:
13698: lda #14
13699: ldx #31
13700: @ColorLoop:
13701: sta COLORRAM + 2 * 40 + 4,x
13702: sta COLORRAM + 3 * 40 + 4,x
13703: sta COLORRAM + 4 * 40 + 4,x
13704: sta COLORRAM + 20 * 40 + 4,x
13705: sta COLORRAM + 21 * 40 + 4,x
13706: dex
13707: bpl @ColorLoop
13708:
13709: ldx #<(COLORRAM + 5 * 40 + 4)
13710: stx zFC
13711: ldx #>(COLORRAM + 5 * 40 + 4)
13712: stx zFC + 1
13713:
13714: ldx #$0f
13715: @ColorSetLoop:
13716: lda #$0e
13717: ldy #0
13718: sta (zFC),y
13719: ldy #31
13720: sta (zFC),y
13721:
13722: clc
13723: lda zFC
13724: adc #40
13725: sta zFC
13726: bcc :+
13727: inc zFC + 1
13728: :
13729: dex
13730: bne @ColorSetLoop
13731:
13732: bit zFB
13733: bpl GS_ExtraHandling
13734:
13735: lda #VICII_B_ControlReg1_DEN + VICII_B_ControlReg1_RSEL + 3
13736: sta VIC + VICII_O_ControlReg1
13737:
13738: plp
13739: rts
13740: ; --------------------
13741:
13742: GS_ExtraHandling:
13743: ldx #$00
13744:
13745: @Loop:
13746: lda GS_Data,X
13747: beq LF7D9
13748: sta lVIDEORAM + 129,x
13749: inx
13750: bpl @Loop
13751: ldx #7
13752:
13753: LF7D9:
13754: lda LF8E5,x
13755: sta lVIDEORAM + $3F8,x
13756: dex
13757: bpl LF7D9
13758:
13759: ; Copy sprites into locations
13760: ldx #$3f
13761: :
13762: lda LF90D,x
13763: sta L0E00,x
13764:
13765: lda LF94D,x
13766: sta L0E00 + $40,x
13767:
13768: lda LF98D,x
13769: sta L0E00 + $80,x
13770:
13771: lda LF9CD,x
13772: sta L0E00 + $C0,x
13773:
13774: lda LFA0D,x
13775: sta L0E00 + $100,x
13776:
13777: lda LFA4D,x
13778: sta L0E00 + $140,x
13779:
13780: lda LFA8D,x
13781: sta L0E00 + $180,x
13782:
13783: dex
13784: bpl :-
13785:
13786:
13787: lda #$04
13788: sta VIC + VICII_O_SprMCM
13789:
13790: lda #$73
13791: sta VIC + VICII_O_SprExpandX
13792:
13793: LF81B:
13794: ; copy another sprite
13795: ldx #$3f
13796: :
13797: lda LFACD,x
13798: sta L0E00 + $1C0,x
13799:
13800: dex
13801: bpl :-
13802:
13803:
13804: ldx #$0f
13805: :
13806: lda LF8ED,x
13807: sta VIC + VICII_O_SprBackColl,x
13808: lda LF8FD,x
13809: sta VIC,x
13810: dex
13811: bpl :-
13812:
13813: lda #VICII_B_ControlReg1_DEN + VICII_B_ControlReg1_RSEL + 3
13814: sta VIC + VICII_O_ControlReg1
13815:
13816: lda #$BE
13817: sta VIC + VICII_O_SprEnable
13818: jsr LF89F
13819:
13820: lda #$FC
13821: sta VIC + VICII_O_SprEnable
13822: jsr LF8AB
13823:
13824: lda #$BD
13825: sta VIC + VICII_O_SprEnable
13826: jsr LF8A8
13827:
13828: lda #$3D
13829: sta VIC + VICII_O_SprEnable
13830: jsr LF8A8
13831:
13832: LF85C:
13833: inc VIC + VICII_O_Sprite3Y
13834: jsr LF8AE
13835:
13836: ldx VIC + VICII_O_Sprite3Y
13837: cpx #$7c
13838: bcc LF85C
13839:
13840: jsr LF8A8
13841:
13842: ; overwrite sprite
13843: ldx #$3f
13844: :
13845: lda LFB0D,x
13846: sta L0E00 + $1C0,x
13847:
13848: dex
13849: bpl :-
13850:
13851: lda #$05
13852: sta VIC + VICII_O_Spr7Col
13853:
13854: lda #$7C
13855: sta VIC + VICII_O_SprEnable
13856: jsr LF8AB
13857:
13858: lda #$3E
13859: sta VIC + VICII_O_SprEnable
13860: jsr LF8A8
13861:
13862: lda #$BE
13863: sta VIC + VICII_O_SprEnable
13864: jsr LF89F
13865:
13866: lda #$04
13867: sta VIC + VICII_O_SprEnable
13868: jsr LF8A8
13869:
13870: jmp LF81B
13871:
13872: LF89F:
13873: jsr LF8A8
13874: jsr LF8A8
13875: jsr LF8A8
13876:
13877: LF8A8:
13878: ldy #40
13879: .byte ASM_BIT3
13880:
13881: LF8AB:
13882: ldy #$06
13883: .byte ASM_BIT3
13884:
13885: LF8AE:
13886: ldy #$02
13887:
13888: :
13889: jsr LF8BF
13890: dey
13891: bne :-
13892:
13893: jsr CheckCartridge
13894: beq LF8BC
13895: rts
13896: ; ---------------
13897:
13898: LF8BC:
13899: jmp ($FFFC) ; 6502 RESET vector
13900:
13901: LF8BF:
13902: bit VIC + VICII_O_ControlReg1
13903: bmi LF8BF
13904: :
13905: bit VIC + VICII_O_ControlReg1
13906: bpl :-
13907: rts
13908:
13909: GS_Data:
13910: .byte $c3, $8f, $8d, $8d, $8f, $84, $8f, $92
13911: .byte $85, $a0, $c3, $b6, $b4, $a0, $c7, $81
13912: .byte $8d, $85, $93, $a0, $d3, $99, $93, $94
13913: .byte $85, $8d, $00
13914:
13915: LF8E5:
13916: .byte $38, $39, $3a, $3b, $3c, $3d, $3e, $3f
13917:
13918: LF8ED:
13919: .byte $00, $06, $06, $01, $02, $03, $06, $01
13920: .byte $0f, $0f, $0a, $0f, $0f, $0f, $0f, $02
13921:
13922: LF8FD:
13923: .byte $e0, $7e, $e0, $7e, $43, $43, $94, $64
13924: .byte $90, $82, $60, $82, $e0, $7e, $ac, $a7
13925:
13926: LF90D:
13927: .byte $80, $00, $00
13928: .byte $80, $00, $00
13929: .byte $ff, $c0, $00
13930: .byte $c0, $40, $00
13931: .byte $c0, $40, $00
13932: .byte $c0, $40, $00
13933: .byte $c0, $c0, $00
13934: .byte $c1, $80, $00
13935: .byte $c3, $00, $00
13936: .byte $c6, $00, $60
13937: .byte $cc, $00, $90
13938: .byte $c8, $00, $90
13939: .byte $c8, $40, $90
13940: .byte $c8, $80, $90
13941: .byte $c9, $f8, $60
13942: .byte $c8, $80, $00
13943: .byte $c8, $46, $77
13944: .byte $d8, $09, $44
13945: .byte $f0, $09, $66
13946: .byte $80, $09, $44
13947: .byte $80, $06, $44
13948: .byte $00
13949: LF94D:
13950:
13951: .byte $80, $00, $40
13952: .byte $80, $00, $40
13953: .byte $f0, $00, $40
13954: .byte $d8, $40, $40
13955: .byte $c8, $80, $40
13956: .byte $c9, $f8, $40
13957: .byte $c8, $80, $00
13958: .byte $c8, $43, $24
13959: .byte $c8, $04, $b4
13960: .byte $c8, $04, $ac
13961: .byte $c8, $04, $a4
13962: .byte $cc, $03, $24
13963: .byte $c6, $00, $00
13964: .byte $c3, $00, $00
13965: .byte $c1, $80, $00
13966: .byte $c0, $80, $00
13967: .byte $c0, $80, $00
13968: .byte $c0, $80, $00
13969: .byte $ff, $80, $00
13970: .byte $80, $00, $00
13971: .byte $80, $00, $00
13972: .byte $00
13973: LF98D:
13974:
13975: .byte $00, $00, $00
13976: .byte $00, $00, $00
13977: .byte $00, $00, $00
13978: .byte $01, $54, $00
13979: .byte $05, $54, $00
13980: .byte $05, $54, $00
13981: .byte $15, $54, $00
13982: .byte $15, $02, $a8
13983: .byte $14, $02, $a0
13984: .byte $14, $02, $80
13985: .byte $14, $00, $00
13986: .byte $14, $03, $c0
13987: .byte $14, $03, $f0
13988: .byte $15, $03, $fc
13989: .byte $15, $54, $00
13990: .byte $05, $54, $00
13991: .byte $05, $54, $00
13992: .byte $01, $54, $00
13993: .byte $00, $00, $00
13994: .byte $00, $00, $00
13995: .byte $00, $00, $00
13996: .byte $00
13997:
13998: LF9CD:
13999:
14000: .byte $1f, $ff, $e0
14001: .byte $30, $00, $a0
14002: .byte $3f, $ff, $a0
14003: .byte $3f, $ff, $a0
14004: .byte $20, $00, $a0
14005: .byte $20, $00, $a0
14006: .byte $20, $00, $a0
14007: .byte $3f, $ff, $a0
14008: .byte $3f, $ff, $a0
14009: .byte $3f, $ff, $a0
14010: .byte $3f, $ff, $a0
14011: .byte $3f, $ff, $c0
14012: .byte $3f, $ff, $80
14013: .byte $00, $00, $00
14014: .byte $00, $60, $00
14015: .byte $00, $60, $00
14016: .byte $00, $60, $00
14017: .byte $03, $6c, $00
14018: .byte $01, $f8, $00
14019: .byte $00, $f0, $00
14020: .byte $00, $60, $00
14021: .byte $00
14022:
14023: LFA0D:
14024:
14025: .byte $00, $00, $00
14026: .byte $00, $00, $00
14027: .byte $bf, $ff, $7c
14028: .byte $bf, $ff, $7d
14029: .byte $7f, $fe, $f9
14030: .byte $60, $06, $fb
14031: .byte $df, $ed, $f3
14032: .byte $80, $1d, $f6
14033: .byte $ff, $fb, $e6
14034: .byte $ff, $fb, $ec
14035: .byte $ff, $f7, $cc
14036: .byte $ff, $f7, $d8
14037: .byte $ff, $ef, $98
14038: .byte $ff, $ef, $b0
14039: .byte $ff, $df, $30
14040: .byte $00, $00, $60
14041: .byte $ff, $ff, $60
14042: .byte $ff, $ff, $c0
14043: .byte $ff, $ff, $c0
14044: .byte $00, $00, $00
14045: .byte $00, $00, $00
14046: .byte $00
14047:
14048: LFA4D:
14049:
14050: .byte $00, $00, $00
14051: .byte $00, $00, $00
14052: .byte $03, $ff, $ff
14053: .byte $03, $ff, $ff
14054: .byte $07, $ff, $ff
14055: .byte $07, $ff, $ff
14056: .byte $0f, $ff, $fe
14057: .byte $0f, $ff, $fe
14058: .byte $1f, $ff, $fd
14059: .byte $1f, $ff, $fd
14060: .byte $3f, $ff, $fb
14061: .byte $3f, $ff, $fb
14062: .byte $7f, $ff, $f7
14063: .byte $7f, $ff, $f7
14064: .byte $ff, $ff, $ef
14065: .byte $80, $00, $00
14066: .byte $ff, $ff, $ff
14067: .byte $ff, $ff, $ff
14068: .byte $ff, $ff, $ff
14069: .byte $00, $00, $00
14070: .byte $00, $00, $00
14071: .byte $00
14072:
14073: LFA8D:
14074:
14075: .byte $80, $00, $00
14076: .byte $80, $00, $00
14077: .byte $fe, $00, $00
14078: .byte $c1, $00, $00
14079: .byte $c1, $00, $00
14080: .byte $c2, $00, $00
14081: .byte $c2, $00, $00
14082: .byte $c4, $00, $00
14083: .byte $c4, $00, $00
14084: .byte $c8, $00, $00
14085: .byte $c8, $00, $00
14086: .byte $c8, $00, $00
14087: .byte $c4, $00, $00
14088: .byte $c4, $00, $00
14089: .byte $c2, $00, $00
14090: .byte $c2, $00, $00
14091: .byte $c1, $00, $00
14092: .byte $c1, $00, $00
14093: .byte $fe, $00, $00
14094: .byte $80, $00, $00
14095: .byte $80, $00, $00
14096: .byte $00
14097:
14098: LFACD:
14099:
14100: .byte $00, $00, $00
14101: .byte $e0, $00, $38
14102: .byte $f0, $00, $78
14103: .byte $78, $00, $f0
14104: .byte $3c, $01, $e0
14105: .byte $1e, $03, $c0
14106: .byte $0f, $07, $80
14107: .byte $07, $8f, $00
14108: .byte $03, $de, $00
14109: .byte $01, $fc, $00
14110: .byte $00, $f8, $00
14111: .byte $00, $f8, $00
14112: .byte $01, $fc, $00
14113: .byte $03, $de, $00
14114: .byte $07, $8f, $00
14115: .byte $0f, $07, $80
14116: .byte $1e, $03, $c0
14117: .byte $3c, $01, $e0
14118: .byte $78, $00, $f0
14119: .byte $f0, $00, $78
14120: .byte $e0, $00, $38
14121: .byte $00
14122:
14123: LFB0D:
14124:
14125: .byte $00, $00, $00
14126: .byte $00, $00, $38
14127: .byte $00, $00, $78
14128: .byte $00, $00, $f0
14129: .byte $00, $01, $e0
14130: .byte $00, $03, $c0
14131: .byte $00, $07, $80
14132: .byte $00, $0f, $00
14133: .byte $00, $1e, $00
14134: .byte $00, $3c, $00
14135: .byte $60, $78, $00
14136: .byte $e0, $f0, $00
14137: .byte $e1, $e0, $00
14138: .byte $e3, $c0, $00
14139: .byte $e7, $80, $00
14140: .byte $ef, $00, $00
14141: .byte $fe, $00, $00
14142: .byte $fc, $00, $00
14143: .byte $f8, $00, $00
14144: .byte $f0, $00, $00
14145: .byte $e0, $00, $00
14146: .byte $00
14147:
14148: TapeIrqRead:
14149: TapeIrqWrite:
14150: TapeIrqWritePreamble:
14151: TapeWriteCompleteFile:
14152: TapeReadFileContents:
14153: TapePressRecordAndPlayOnTape:
14154: TapeReadTapeHeaderOfNextFile:
14155: TapeFindSpecificFile:
14156: TapePressPlayOnTape:
14157: TapeCreateFileBuffer:
14158: TapeGetPointer:
14159: TapeWriteCompleteBuffer:
14160: TapeReadNextBuffer:
14161: TAPE_INCREMENT_WRITE_POINTER:
14162:
14163: jmp KErrDeviceNotPresent
14164:
14165: ; FillUntil $FB8E, $00
14166: .segment "KERNAL_GS_8E"
14167:
14168: Copy_zSTAL_to_zSAL:
14169: lda zSTAL + 1
14170: sta zSAL + 1
14171: lda zSTAL
14172: sta zSAL
14173: rts
14174: ; -------------------------
14175:
14176: ; FillUntil $FC00, $00
14177: .segment "KERNAL_GS_00"
14178: .byte "COPYRIGHT 1990 COMMODORE ELECTRONICS LTD. ALL RIGHTS RESERVED."
14179:
14180: ; FillUntil $FC54, $00
14181: .segment "KERNAL_GS_54"
14182: TapeIrqEnd2:
14183: jmp NMI_End
14184: ; -------------------------
14185:
14186:
14187: ; FillUntil $FC93, $00
14188: .segment "KERNAL_GS_93"
14189:
14190:
14191: .else ; .if CompileComputer = C64_GS
14192:
14193: ; Find the next file on tape
14194: ;
14195: ; Output:
14196: ; C = 1 --> an error occurred
14197: ; C = 0 --> no error occurred
14198: ; Z = 1 --> EOT was found
14199: ; Z = 0 --> no EOT was found
14200: ; X = tape buffer type if no error occurred
14201: ;
14202: ; BUG:
14203: ; If the buffer could not be read at all, Z = 1 will be true if zVERCKK contains a 0.
14204: ; Thus, Z will not represent the status of the EOT.
14205: ;
14206: TapeReadTapeHeaderOfNextFile:
14207:
14208: @ReadNextHeader:
14209: lda zVERCKK ; remember verify (=1) or load (=0) flag
14210: pha ; onto stack
14211:
14212: jsr TapeReadNextBuffer ; get next buffer from tape
14213:
14214: pla
14215: sta zVERCKK ; restore verify (=1) or load (=0) flag
14216:
14217: bcs @Rts ; if an error occurred, we are done
14218:
14219: ldy #TAPE_BUFFER_OFFSET_TYPE ; start reading buffer at tape buffer type byte
14220: lda (zTAPE1),y ; get tape buffer type byte into A
14221:
14222: cmp #TAPE_BUFFER_TYPE_EOT ; is it of type "end-of-tape, EOT"?
14223: beq @Rts ; yes, we are done
14224:
14225: cmp #TAPE_BUFFER_TYPE_BASIC ; is it of type "BASIC program"?
14226: beq @FoundFile ; yes -> branch, process it
14227:
14228: cmp #TAPE_BUFFER_TYPE_ABSOLUTE ; is it of type "ABSOLUTE loading program, i.e., machine language program"?
14229: beq @FoundFile ; yes -> branch, process it
14230:
14231: cmp #TAPE_BUFFER_TYPE_DATA ; is it of type "DATA file, that is, no program"?
14232: bne @ReadNextHeader ; no -> branch, get next tape buffer from tape
14233:
14234: @FoundFile:
14235: tax ; remember tape buffer type in X
14236: bit zNSGFLG ; kernal message output policy: do we want to output "Loading", "Saving", "Verifying", "Found", ... messages?
14237: bpl @ClcRts ; no --> skip output, return without an error
14238:
14239: ldy #StrFound - LMESSAGES ; offset of "FOUND " message
14240: jsr OutputMessage ; output it
14241:
14242:
14243: ldy #TAPE_BUFFER_OFFSET_FILENAME ; offset of file name in buffer
14244:
14245: @OutputFilename:
14246: lda (zTAPE1),y ; get character from the file name
14247: jsr kCHROUT ; and output it (onto screen)
14248: iny ; proceed to next character
14249: cpy #TAPE_BUFFER_OFFSET_ENDFILENAME ; already at end of file name?
14250: bne @OutputFilename ; no -> branch, output next character
14251:
14252: .if CompileComputer >= C64_02
14253:
14254: ; introduce a delay so the user has the option to actually see the output
14255: ; This is necessary on the C64, as it disables the VIC-II output on tape operations.
14256: ; On the VIC-20, this is not the case, thus, the user can see the output anyway
14257:
14258: lda zTIME + 1 ; get the current time (middle byte)
14259: jsr TapeKeyOrTimeout ; delay the output until a timeout happens, or the user presses a key
14260: nop ; fill-byte
14261:
14262: .elseif CompileComputer >= C64_GENERAL
14263:
14264: ; on the C64-01, the delay was until some key was pressed.
14265: ; This is quite large and most probably the reason why the C64-02 KERNAL (cf. above)
14266: ; introduced a timeout
14267:
14268: @WaitKeyPress:
14269: lda zSTKEY ; get the status of the keyboard column at the time the keyboard was checked the last time
14270: cmp #$FF ; no key pressed?
14271: beq @WaitKeyPress ; yes -> branch -> loop until a key is pressed
14272: .endif
14273:
14274: @ClcRts:
14275: clc
14276: dey ; put Y to point at the last byte of the filename
14277: ; (thus, a subsequent INY will point it to the next data byte)
14278: @Rts: rts
14279:
14280:
14281: ; Create an empty tape buffer
14282: ; Input: A = type of tape buffer (one of TAPE_BUFFER_TYPE_...)
14283: ;
14284: TapeCreateFileBuffer:
14285: sta zPTR1 ; remember tape buffer type
14286:
14287: jsr TapeGetPointer ; get pointer to tape buffer into (X/Y) (unused, but flags important)
14288: bcc @Rts ; C = 0 -> tape buffer points to stack page or zero page -> quit, we do not want to overwrite essential data!
14289:
14290: lda zSTAL + 1 ; remember start address high
14291: pha
14292: lda zSTAL ; remember start address low
14293: pha
14294: lda zEAL + 1 ; remember end address high
14295: pha
14296: lda zEAL ; remember end address low
14297: pha
14298:
14299: ; Delete complete tape buffer, overwriting it with $20 (SPACE)
14300: ldy #lTBUFFR_SIZE - 1 ; size of buffer to erase
14301: lda #$20 ; empty buffer pattern
14302: :
14303: sta (zTAPE1),y
14304: dey
14305: bne :-
14306:
14307: lda zPTR1 ; store tape buffer type
14308: sta (zTAPE1),y ; into position $00
14309: iny
14310:
14311: lda zSTAL ; store start address low
14312: sta (zTAPE1),y ; into position $01
14313: iny
14314:
14315: lda zSTAL + 1 ; store start address high
14316: sta (zTAPE1),y ; into position $02
14317: iny
14318:
14319: lda zEAL ; store end address low
14320: sta (zTAPE1),y ; into position $03
14321: iny
14322:
14323: lda zEAL + 1 ; store end address high
14324: sta (zTAPE1),y ; into position $04
14325: iny
14326:
14327: sty zPTR2 ; remember write pointer
14328:
14329: ; store file name into buffer
14330:
14331: ldy #0 ; pointer into file name
14332: sty zPTR1
14333:
14334: @CopyFilename:
14335: ldy zPTR1 ; check if we reached end of file name
14336: cpy zFNLEN
14337: beq @CopyFilenameQuit ; yes -> quit loop
14338:
14339: lda (zFNADR),y ; get next file name character
14340: ldy zPTR2 ; (write pointer into tape buffer)
14341: sta (zTAPE1),y ; store file name character into tape buffer
14342:
14343: inc zPTR1 ; increment file name read pointer
14344: inc zPTR2 ; increment tape write pointer
14345: bne @CopyFilename ; (unconditional)
14346: ; -----------------------
14347:
14348: @CopyFilenameQuit:
14349: jsr TapeSetStartAndEndToBuffer ; set zSTAL/zSTAL + 1 to begin of tape buffer, and zEAL/zEAL+1 to end of it
14350:
14351: lda #TAPE_RIPRTY_69
14352: sta zRIPRTY ; Write TAPE_RIPRTY_69 * $100 pulses for the preamble
14353:
14354: jsr TapeWriteCompleteFileCustomPreamble ; write buffer onto tape, using the set preamble length
14355:
14356: tay ; remember A in Y (TODO why? What content does A have here?)
14357:
14358: ; restore start adn end addresses
14359: pla ; restore end address low
14360: sta zEAL
14361: pla ; restore end address high
14362: sta zEAL + 1
14363: pla ; restore start address low
14364: sta zSTAL
14365: pla ; restore start address high
14366: sta zSTAL + 1
14367:
14368: tya ; restore A from Y (TODO why? What content does A have here?)
14369: @Rts:
14370: rts
14371:
14372: ; Get tape buffer pointer into X/Y
14373: ;
14374: ; Return:
14375: ; C = 0 if tape buffer points into stack page or zero page
14376: ; C = 1 if not
14377: ;
14378: TapeGetPointer:
14379: ldx zTAPE1
14380: ldy zTAPE1 + 1
14381: cpy #>lBUF
14382: rts
14383:
14384: ; set zSTAL/zSTAL + 1 to begin of tape buffer, and zEAL/zEAL+1 to end of it
14385:
14386: TapeSetStartAndEndToBuffer:
14387: jsr TapeGetPointer ; get tape buffer pointer into x/y
14388:
14389: txa ; get address low
14390: sta zSTAL ; and store it as start address low
14391:
14392: clc
14393: adc #lTBUFFR_SIZE ; add size of tape buffer
14394: sta zEAL ; and store it as end address
14395:
14396: tya ; get address high
14397: sta zSTAL + 1 ; and store it as end address high
14398: adc #0 ; add carry from previous addition
14399: sta zEAL + 1 ; store the result as end address high
14400: rts
14401: ; -----------------
14402:
14403:
14404: ; Find a specific file on tape
14405: ;
14406: ; Input:
14407: ; zFNLEN: Length of the file name
14408: ; zFNADR/zFNADR+1: Pointer to file name (if zFNLEN != 0)
14409: ;
14410: ; Output:
14411: ; C = 1 --> an error occurred
14412: ; C = 0 --> no error occurred
14413: ; Z = 1 --> EOT was found
14414: ; Z = 0 --> no EOT was found
14415: ; X = tape buffer type if no error occurred
14416: ;
14417: ; BUG:
14418: ; If the buffer could not be read at all, Z = 1 will be true if zVERCKK contains a 0.
14419: ; Thus, Z will not represent the status of the EOT.
14420: ;
14421: TapeFindSpecificFile:
14422:
14423: @NextFile:
14424: jsr TapeReadTapeHeaderOfNextFile ; read in the next header on tape
14425: bcs @Rts ; C == 1 --> an error occurred --> branch --> quit (This will also happen if Z=1)
14426:
14427: ldy #TAPE_BUFFER_OFFSET_FILENAME ; offset of file name in tape buffer
14428: sty zPTR2
14429:
14430: ldy #0 ; offset of requested file name
14431: sty zPTR1
14432:
14433: @TestNextChar:
14434: cpy zFNLEN ; check if we reached the end of the file name
14435: beq @ClcRts ; yes -> branch, return with c = 0
14436:
14437: lda (zFNADR),y ; read in character from requested file name
14438: ldy zPTR2
14439: cmp (zTAPE1),y ; compare with character from file name in tape buffer
14440: bne @NextFile ; not equal -> file name differes -> branch -> check next file on tape
14441:
14442: inc zPTR1 ; increment pointers for file name characters
14443: inc zPTR2
14444:
14445: ldy zPTR1 ; make sure Y has the offset of the current character of the requested file name
14446: bne @TestNextChar ; uncond. branch
14447: ; ----------------------
14448:
14449: @ClcRts:
14450: clc ; mark: no error (i.e., we found the requested file)
14451: @Rts:
14452: rts
14453: ; -------------------
14454:
14455: ; increment the pointer into the tape buffer
14456: ;
14457: ; Return:
14458: ; Y = the tape pointer
14459: ;
14460: ; Z = 1 if the buffer is full / completely read
14461: ; Z = 0 otherwise
14462: ;
14463: TAPE_INCREMENT_WRITE_POINTER:
14464: jsr TapeGetPointer
14465: inc zBUFPNT ; increment the pointer into the tape buffer
14466: ldy zBUFPNT ; read i
14467: cpy #lTBUFFR_SIZE
14468: rts
14469:
14470: ; Wait for the PLAY key to be pressed
14471: ; If it is not, output "PRESS PLAY ON TAPE" and wait for it to be pressed
14472: ;
14473: TapePressPlayOnTape:
14474: jsr TapeCheckPlayPressed ; check if play key is pressed
14475: beq TapeClcRts ; yes -> branch, we're done
14476:
14477: ldy #StrPlay - LMESSAGES ; get offset of "PRESS PLAY ON TAPE" string to output the text
14478:
14479: TapePressPlayCommon:
14480:
14481: .if CompileComputer = C64_4064
14482: jsr OutputMessageIfAllowed ; output the text, only if allowed
14483: .else
14484: jsr OutputMessage ; output the text
14485: .endif
14486:
14487: ; Wait for PLAY key to be pressed
14488:
14489: @WaitForPlay:
14490: jsr TapeCheckForStop ; check if stop key was pressed. If so, do not return here, but to our caller!
14491:
14492: jsr TapeCheckPlayPressed ; has PLAY been pressed on the tape?
14493: bne @WaitForPlay ; no -> branch --> test again
14494:
14495: ldy #StrOk - LMESSAGES ; get offset of "OK" text to output it
14496:
14497: .if CompileComputer = C64_4064
14498: jmp OutputMessageIfAllowed ; output the text, only if allowed
14499: ; ------------------------------
14500: .else
14501: jmp OutputMessage ; output the text
14502: ; ------------------------------
14503: .endif
14504:
14505: ; Find out if the PLAY key
14506: ; is pressed on the tape
14507: ;
14508: ; This includes the combination of RECORD + PLAY
14509: ;
14510: ; Output:
14511: ; Z = 0: not pressed
14512: ; Z = 1: pressed
14513: ;
14514: TapeCheckPlayPressed:
14515: lda #TAPE_B_SENSE
14516: bit TAPE_REG_SENSE
14517: bne TapeClcRts
14518: bit TAPE_REG_SENSE
14519:
14520: TapeClcRts:
14521: clc
14522: rts
14523:
14524: ; Wait for the PLAY key to be pressed
14525: ; If it is not, output "PRESS RECORD & PLAY ON TAPE" and wait for it to be pressed
14526:
14527: TapePressRecordAndPlayOnTape:
14528: jsr TapeCheckPlayPressed ; check if play key is pressed
14529: beq TapeClcRts ; yes -> branch, we're done
14530:
14531: ldy #StrRecPlay - LMESSAGES ; get offset of "PRESS RECORD & PLAY ON TAPE" string to output the text
14532:
14533: bne TapePressPlayCommon ; (other than the text, this routine is identical to TapePressPlayOnTape. Thus, handle it over there)
14534: ; ---------------------------
14535:
14536:
14537: TapeReadNextBuffer:
14538: lda #0
14539: sta zSTATUS ; clear status, no error yet
14540:
14541: sta zVERCKK ; mark: we are loading (not verifying) from tape
14542:
14543: jsr TapeSetStartAndEndToBuffer ; set zSTAL/zSTAL + 1 to begin of tape buffer, and zEAL/zEAL+1 to end of it
14544:
14545: TapeReadFileContents:
14546: jsr TapePressPlayOnTape ; output "PRESS PLAY ON TAPE" and wait for the PLAY key to be pressed
14547: 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)
14548:
14549: sei
14550:
14551: ; clear some essential variables
14552:
14553: lda #$00
14554: sta zRIDATA
14555: sta zBITTS
14556: sta zCMPO
14557: sta zPTR1 ; or Pass1ReadErrors
14558: sta zPTR2 ; or Pass2ReadErrors
14559: sta zDPSW ; or ByteReceivedFlag
14560:
14561: lda #TAPE_REG_ICR_B_CASSREAD
14562: ldx #(VecTapeIrqRead - TapeIrqVectors) + 8 ; IRQ vector number to be set: Reading from tape
14563: bne LF875 ; everything but the IRQ vector is identical to recording, thus, use the code there
14564: ; ------------------------------
14565:
14566: ; write out the tape buffer to tape
14567: ; TODO
14568:
14569: TapeWriteCompleteBuffer:
14570: jsr TapeSetStartAndEndToBuffer ; set zSTAL/zSTAL + 1 to begin of tape buffer, and zEAL/zEAL+1 to end of it
14571:
14572: TapeWriteCompleteFile:
14573: lda #TAPE_RIPRTY_14
14574: sta zRIPRTY ; Write TAPE_RIPRTY_14 * TODO pulses for the preamble
14575: TapeWriteCompleteFileCustomPreamble:
14576: jsr TapePressRecordAndPlayOnTape ; output "PRESS RECORD & PLAY ON TAPE" and wait for the PLAY key to be pressed
14577: LF86E:
14578: bcs TapeSave_ClearIRQtmp_and_RTS ; C = 1 --> an error occurred (STOP was pressed) --> branch, quit
14579:
14580: sei
14581:
14582: lda #TAPE_REG_ICR_B_WR_TIMER ; start the write timer after setting the IRQ vector
14583: ldx #(VecTapeIrqWritePreamble - TapeIrqVectors) + 8 ; IRQ vector number to be set
14584:
14585: LF875:
14586: ldy #TAPE_REG_ICR_B_CLEARALL ; mask: clear all interrupt sources
14587: sty TAPE_REG_ICR ; clear all interrupt sources
14588:
14589: sta TAPE_REG_ICR ; and set the needed interrupt source (given in A)
14590:
14591: .if CompileComputer >= C64_GENERAL
14592: ; TODO: what?
14593: lda CIA1 + CIA_O_CRA
14594: ora #CIA_CRB_B_FORCE_LOAD | CIA_CRB_B_ONESHOT | CIA_CRB_B_START
14595: sta CIA1 + CIA_O_CRB
14596: and #CIA_CRA_B_50HZ | CIA_CRA_B_FORCE_LOAD | CIA_CRA_B_START
14597: sta lTODSNS
14598: .endif
14599:
14600: jsr LF0A4 ; TODO
14601:
14602: .if CompileComputer >= C64_GENERAL
14603: ; switch off display
14604: lda VIC + VICII_O_ControlReg1
14605: and # ~ VICII_B_ControlReg1_DEN
14606: sta VIC + VICII_O_ControlReg1
14607: .endif
14608:
14609: ; save IRQ vector in order to be able to restore it after the tape operation
14610: lda lCINV ; IRQ vector low byte
14611: sta lIRQTMP
14612: lda lCINV + 1 ; IRQ vector high byte
14613: sta lIRQTMP + 1
14614:
14615: jsr TapeSetIrqVector
14616:
14617: lda #$02
14618: sta zFSBLK ; set number of copies to write = 2.
14619:
14620: jsr TapeInitInputOutputOfByte ; prepare output of a byte by initialising zTSFCNT, zTBTCNT, zBITC1, zPRTY and zRINONE
14621:
14622:
14623: ; switch on the tape motor
14624: lda TAPE_REG_MOTOR
14625: and #TAPE_B_MOTOR_OFF_AND
14626: .if CompileComputer < C64_GENERAL
14627: ora #TAPE_B_MOTOR_OFF_OR
14628: .endif
14629: sta TAPE_REG_MOTOR
14630:
14631: sta zCAS1 ; mark: tape operation in progress.
14632:
14633: ; delay of TODO ms to allow tape motor for stable operation
14634: ldx #$FF
14635: @LF8B5:
14636: ldy #$FF
14637: @LF8B7:
14638: dey
14639: bne @LF8B7
14640: dex
14641: bne @LF8B5
14642:
14643: .if CompileComputer < C64_GENERAL
14644: sta TAPE_TIMER1_HI ; TODO why?
14645: .endif
14646: cli ; allow interrupts: From now on, writing to the tape is controlled by the IRQ routine only!
14647:
14648: ; Wait for the recording to have quit. For this, we compare the IRQ vector. When it is restored to be original vector
14649: ; stored in lIRQTMP/lIRQTMP+1, then the recording has finished.
14650: ;
14651: ; Also check for STOP, as the user might want to stop the recording prematurely.
14652: ;
14653: @WaitForFinish:
14654: lda lIRQTMP + 1 ; compare stored IRQ vector high
14655: cmp lCINV + 1 ; with current IRQ vector high
14656: clc ; (in case we finish the loop: mark "no error")
14657: beq TapeSave_ClearIRQtmp_and_RTS ; if they are the same, the recording has finished -> quit this loop
14658:
14659: jsr TapeCheckForStop ; check if stop key was pressed. If so, do not return here, but to our caller!
14660:
14661: ; (physically) check if RUN/STOP has been pressed
14662:
14663: .if CompileComputer >= C64_GENERAL
14664: ; on the C64, we just check for RUN/STOP. Note that the time is not updated while storing to TAPE
14665: jsr iUDTIM_CheckRunStop
14666: .else
14667: lda VIA2_IFR ; check interrupt flag register: Would T1 (the ticker) generate an event?
14668: and #VIA_IFR_B_T1
14669: beq @WaitForFinish ; no -> loop
14670: lda VIA1_T1CL ; clear the IFR state by reading T1
14671: jsr iUDTIM ; update time. This function also checks for RUN/STOP
14672: .endif
14673: jmp @WaitForFinish ; loop, wait for finishing
14674: ; ------------------
14675:
14676: ; Check for stop key
14677: ;
14678: ; This function checks if the STOP key has been pressed.
14679: ; If so, it does not return to its caller, but to the caller of its caller!
14680: ;
14681: TapeCheckForStop:
14682: jsr kSTOP ; check for stop key (returns: Z = 1 <--> STOP key was pressed)
14683: clc
14684: bne TapeSaveRts ; no stop key -> branch, we're done.
14685:
14686: jsr TapeStopMotor_and_InitTimer ; stop cass. motor, restore timer, restore IRQ vector
14687: sec ; mark: an error occurred
14688:
14689: ; remove return address of our caller from the stack
14690: pla
14691: pla
14692:
14693: TapeSave_ClearIRQtmp_and_RTS:
14694: ; mark: we do not have an IRQ vector to restore
14695: lda #$00
14696: sta lIRQTMP + 1 ; high byte of IRQ vector to restore (if any)
14697:
14698: TapeSaveRts:
14699: rts
14700: ; ------------------------
14701:
14702:
14703:
14704:
14705:
14706: TapeBitTimingAdjust:
14707: ; TODO what does this function do?
14708: ; Set expected tape timing. (according to some ROM description list)
14709:
14710: stx zCMPO + 1
14711:
14712: ; Calculate: A := zCMPO * 5
14713: lda zCMPO
14714: asl a ; multiply by 2
14715: asl a ; multiply by 2
14716: clc
14717: adc zCMPO ; add old value of zCMPO
14718:
14719: ; calculate: [zCMPO+1] := [zCMPO+1] + zCMPO * 5
14720: clc
14721: adc zCMPO + 1
14722: sta zCMPO + 1
14723:
14724: lda #$00
14725: bit zCMPO
14726: bmi @LF8F7
14727: rol a
14728: @LF8F7:
14729: asl zCMPO + 1
14730: rol a
14731: asl zCMPO + 1
14732: rol a
14733: tax
14734:
14735: @LF8FE:
14736: lda TAPE_TIMER1_LO
14737: cmp #TAPE_TIMER1_CONST
14738: bcc @LF8FE
14739: adc zCMPO + 1
14740: sta TAPE_TIMER2_LO
14741: txa
14742: adc TAPE_TIMER1_HI
14743: sta TAPE_TIMER2_HI
14744:
14745: .if CompileComputer >= C64_GENERAL
14746: lda lTODSNS
14747: sta CIA1 + CIA_O_CRA
14748: sta lTD1IRQ
14749: lda CIA1 + CIA_O_ICR
14750: and #CIA_ICR_B_FLAG
14751: beq @RetCli
14752: lda #>(@Ret-1)
14753: pha
14754: lda #<(@Ret-1)
14755: pha
14756: jmp FakeIRQ
14757: .endif
14758:
14759: @RetCli:
14760: cli
14761: @Ret:
14762: rts
14763:
14764: ;******************************************************************************
14765: ;
14766: ;; [[According to "The almost completely commented Vic 20 ROM disassembly.
14767: ;; V1.01 Lee Davison 2005-2012, amended by Ruud Baltissen; I relabeled the
14768: ;; cases from A B C D to X S M L:]]
14769: ;;
14770: ;; On Commodore computers, the streams consist of four kinds of symbols
14771: ;; that denote different kinds of low-to-high-to-low transitions on the
14772: ;; read or write signals of the Commodore cassette interface.
14773: ;;
14774: ;; X A break in the communications, or a pulse with very long cycle
14775: ;; time.
14776: ;;
14777: ;; S A short pulse, whose cycle time typically ranges from 296 to 424
14778: ;; microseconds, depending on the computer model.
14779: ;;
14780: ;; M A medium-length pulse, whose cycle time typically ranges from
14781: ;; 440 to 576 microseconds, depending on the computer model.
14782: ;;
14783: ;; L A long pulse, whose cycle time typically ranges from 600 to 744
14784: ;; microseconds, depending on the computer model.
14785:
14786: ;; [[According to the text in `Programming the PET/CBM' by Raeto West:]]
14787: ;; A byte is stored as a byte marker (a long wave followed by a medium wave: L-M)
14788: ;; followed by 9 bits: 8 data plus odd parity.
14789: ;; A 0-bit is short followed by long (S-L)
14790: ;; A 1-bit is long followed by short (L-S)
14791: ;; [[but the diagram on page -236- agrees with the below:]]
14792:
14793: ;; [[According to Keith Falkner in Compute! Issue #008, Jan 1981:]]
14794: ;; A 0-bit is short followed by medium (S-M)
14795: ;; A 1-bit is medium followed by short (M-S)
14796:
14797: ;; [[According to the VICE source code, tape/tap.c:]]
14798: ;; The tape preamble (leader) consists of at least 32 short pulses.
14799:
14800: ;; The tape preamble (leader) ends with the data bytes 89, 88, 87, .. 81,
14801: ;; or for the second copy 09, 08, 07, .. 01.
14802: ;;
14803: ;; A tape block is ended with L-S (instead of L-M for the next byte).
14804:
14805: ; read tape bits, IRQ routine
14806:
14807: ; read T2C which has been counting down from $FFFF. subtract this from $FFFF
14808:
14809: TapeIrqRead:
14810: ; IRQ4
14811: ; read out the timer value making sure that we do not read
14812: ; while a underflow occurs from the low byte to the high byte
14813:
14814: ldx TAPE_TIMER1_HI ; read in timer high byte
14815:
14816: ; calculate $FF - timer low byte
14817: ldy #$FF
14818: tya
14819: sbc TAPE_TIMER1_LO
14820:
14821: cpx TAPE_TIMER1_HI ; is the high byte still the same as above?
14822:
14823: bne TapeIrqRead ; no -> we just had an underflow -> retry
14824:
14825: stx zCMPO + 1 ; remember high byte of timer value
14826:
14827: tax ; X := $FF - low byte of timer value as calculated above
14828:
14829: ; restart timer with $FFFF (longest possible timer start address)
14830:
14831: sty TAPE_TIMER1_LO
14832: sty TAPE_TIMER1_HI
14833:
14834: .if CompileComputer >= C64_GENERAL
14835:
14836: ; restart the timer in oneshot mode
14837:
14838: lda #CIA_CRB_B_FORCE_LOAD | CIA_CRB_B_ONESHOT | CIA_CRB_B_START
14839: sta CIA1 + CIA_O_CRB
14840:
14841: ; read the ICR (the read clears it) and store it in lTRDTMP
14842:
14843: lda TAPE_REG_ICR
14844: sta lTRDTMP
14845:
14846: .endif
14847:
14848: tya ; now, calculate $FF - high byte of timer value
14849: sbc zCMPO + 1
14850: stx zCMPO + 1 ; here, zCMPO+1 / A contains ($FFFF - timer value)
14851:
14852: ; divide the timer value by 4
14853:
14854: lsr a ; shift right, dividing by 2 (hi)
14855: ror zCMPO + 1 ; (lo)
14856: lsr a ; shift right, deviding by 2 another time (hi)
14857: ror zCMPO + 1 ; ==> time of pulse / 4 (lo)
14858:
14859: lda zCMPO ; get tape timing constant min byte
14860: clc
14861: adc #$3C
14862:
14863: .if CompileComputer < C64_GENERAL
14864: bit VIA2_PA
14865: .endif
14866:
14867: cmp zCMPO + 1 ; compare with time of pulse / 4
14868: ; compare with ($FFFF - TAPE_TIMER1) >> 2
14869: bcs @LF9AC ; branch if min + $3C >= ($FFFF - T2C) >> 2
14870: ; or in other words, if the pulse is too short.
14871: ldx ByteReceivedFlag ; or zDPSW
14872: beq @LF969 ; no byte received yet
14873: jmp LFA60 ; byte received
14874: ; -------------------
14875:
14876: @LF969:
14877: ldx zTSFCNT ; bit counter (8->0)
14878: bmi @LF988 ; -> @LFA10
14879:
14880: ; ? Determine if the pulse is short, medium or long.
14881:
14882: ldx #$00 ; data bit may be 0
14883: adc #$30
14884: adc zCMPO ; add tape timing constant min byte
14885: cmp zCMPO + 1 ; compare with time of pulse / 4
14886: bcs @LF993 ; Is the pulse smaller? -> It is a SHORT pulse
14887: inx ; data bit may be 1
14888: adc #$26
14889: adc zCMPO ; add tape timing constant min byte
14890: cmp zCMPO + 1 ; compare with time of pulse / 4
14891: bcs @LF997 ; Is the pulse still smaller? -> it is a MEDIUM pulse
14892: adc #$2C
14893: adc zCMPO ; add tape timing constant min byte
14894: cmp zCMPO + 1 ; compare with time of pulse / 4
14895: bcc @LF98B ; pulse is too long
14896: @LF988:
14897: jmp @LFA10 ; Is the pulse smaller than the max long pulse?
14898: ; -> it is a LONG pulse
14899: ; -----------------
14900:
14901: @LF98B: ; pulse is too long
14902: lda zBITTS ; ? get EOI flag byte
14903: beq @LF9AC ; -> IrqEnd1
14904: sta ErrorFlagOnTapeRead ; or zBITC1 store non-zero
14905: bne @LF9AC ; always
14906:
14907: ; After a short pulse we need a medium one,
14908: ; or the other way around. That keeps the counter on 0.
14909: @LF993: ; pulse was SHORT
14910: inc ReadBitSequenceErrors ; or zRINONE
14911: bcs @LF999 ; always
14912: @LF997: ; pulse was MEDIUM
14913: dec ReadBitSequenceErrors ; or zRINONE
14914: @LF999:
14915: sec ; ?? adjust some timing parameter
14916: sbc #$13
14917: sbc zCMPO + 1 ; subtract time of pulse / 4
14918: adc zSVXT
14919: sta zSVXT
14920:
14921: lda zTBTCNT ; cycle counter (which half of the bit cycle is current)
14922: eor #$01
14923: sta zTBTCNT ; cycle counter
14924: beq @LF9D5 ; wrong half of the bit cycle? i.e. 2nd pulse
14925:
14926: stx zSCHAR ; distilled a bit (from ldx #$00 / inx above)
14927: ; takes the timing from the 1st pulse
14928:
14929: @LF9AC: ; don't store a bit
14930: lda zBITTS ; ? get EOI flag byte
14931: beq @IrqEnd1
14932: .if CompileComputer >= C64_GENERAL
14933: lda lTRDTMP ; saved TAPE_REG_ICR
14934: and #$01
14935: bne @LF9BC ; timer had no interrupt
14936: lda lTD1IRQ
14937: bne @IrqEnd1
14938: .else
14939: bit VIA2_IFR
14940: bvc @IrqEnd1 ; timer 1 no interrupt
14941: .endif
14942:
14943: @LF9BC: ; force restart for next bit
14944: lda #$00
14945: sta zTBTCNT ; cycle counter; there are 2 pulses per bit
14946: .if CompileComputer >= C64_GENERAL
14947: sta lTD1IRQ
14948: .endif
14949: lda zTSFCNT ; bit counter (8->0)
14950: bpl @LF9F7
14951: bmi @LF988
14952:
14953: @LF9C9:
14954: ldx #$A6
14955: jsr TapeBitTimingAdjust
14956: lda zPRTY ; parity
14957: bne @LF98B
14958: @IrqEnd1:
14959: jmp NMI_End
14960: ; ----------------------
14961:
14962: @LF9D5:
14963: lda zSVXT
14964: beq @LF9E0
14965: bmi @LF9DE
14966: dec zCMPO
14967: .byte ASM_BIT3
14968: @LF9DE:
14969: inc zCMPO
14970: @LF9E0:
14971: lda #$00
14972: sta zSVXT
14973: cpx zSCHAR
14974: bne @LF9F7
14975: txa
14976: bne @LF98B
14977: lda ReadBitSequenceErrors ; or zRINONE
14978: bmi @LF9AC
14979: cmp #$10
14980: bcc @LF9AC
14981: sta zSYNO
14982: bcs @LF9AC
14983: @LF9F7:
14984: txa
14985: eor zPRTY
14986: sta zPRTY
14987: lda zBITTS
14988: beq @IrqEnd1
14989: dec zTSFCNT ; bit counter (8->0)
14990: bmi @LF9C9
14991:
14992: lsr zSCHAR ; shift a bit into the collected byte
14993: ror SerialWordBuffer ; or zMYCH
14994: ldx #$DA
14995: jsr TapeBitTimingAdjust
14996: jmp NMI_End
14997: ; ----------------------
14998:
14999: @LFA10: ; found a LONG pulse -or- no more bits
15000: lda zSYNO
15001: beq @LFA18
15002: lda zBITTS
15003: beq @LFA1F
15004:
15005: @LFA18:
15006: lda zTSFCNT ; bit counter (8->0)
15007: .if CompileComputer >= C64_GENERAL
15008: bmi @LFA1F
15009: jmp @LF997
15010: .else
15011: bpl @LF997
15012: .endif
15013:
15014: @LFA1F:
15015: lsr zCMPO + 1
15016: lda #$93
15017: sec
15018: sbc zCMPO + 1
15019: adc zCMPO
15020: asl a
15021: tax
15022:
15023: jsr TapeBitTimingAdjust
15024: inc ByteReceivedFlag ; or zDPSW
15025: lda zBITTS
15026: bne @LFA44
15027: lda zSYNO
15028: beq @IrqEnd2
15029: sta ErrorFlagOnTapeRead ; or zBITC1
15030: lda #$00
15031: sta zSYNO
15032:
15033: lda #TAPE_REG_ICR_B_SET_3
15034: sta TAPE_REG_ICR
15035:
15036: sta zBITTS
15037:
15038: @LFA44:
15039: lda zSYNO
15040: sta zNXTBIT ; ?? indicate whether we got a bit
15041: beq @LFA53
15042: lda #$00
15043: sta zBITTS
15044:
15045: lda #TAPE_REG_ICR_B_UNSET_3
15046: sta TAPE_REG_ICR
15047:
15048: @LFA53:
15049: lda SerialWordBuffer ; or zMYCH
15050: sta ReadCharacterIn ; or zROPRTY
15051: lda ErrorFlagOnTapeRead ; or zBITC1
15052: ora ReadBitSequenceErrors ; or zRINONE
15053: sta ReadCharacterError ; or zRODATA
15054: @IrqEnd2:
15055: jmp NMI_End
15056: ; --------------------
15057:
15058:
15059: ; store tape chars ; FA57 in PET 3032
15060:
15061: LFA60: ; byte received
15062: jsr TapeInitInputOutputOfByte ; prepare input of a byte by initialising zTSFCNT, zTBTCNT, zBITC1, zPRTY and zRINONE; returns with A = 0
15063: sta ByteReceivedFlag ; zDPSW := 0
15064:
15065: ldx #$DA
15066: jsr TapeBitTimingAdjust
15067: lda zFSBLK ; number of blocks remaining to read
15068: beq @LFA70 ; if pass 1 was error free, don't really
15069: sta NrBlocksRemaining ; bother with the second pass ; or zINBIT
15070: @LFA70:
15071: lda #$0F
15072: bit zRIDATA ; 00=scan, $01-$0F=count, $40=load, $80=End of Tape marker
15073: bpl @LFA8D
15074: ; ---- $80 = EOT
15075: lda zNXTBIT ; ?? did we get a bit?
15076: bne @LFA86
15077:
15078: ldx zFSBLK ; nr of copies remaining to read
15079: dex
15080: bne @IrqEnd3
15081: lda #STATUS_TAPE_LONG_BLOCK
15082: jsr SetStatus
15083: bne @IrqEnd3
15084:
15085: @LFA86:
15086: lda #$00
15087: sta zRIDATA ; switch to scan
15088: @IrqEnd3:
15089: jmp NMI_End
15090: ; ------------------
15091:
15092: @LFA8D:
15093: bvs @LFAC0
15094: bne @LFAA9
15095:
15096: lda zNXTBIT ; ---- 00 = scan
15097: bne @IrqEnd3 ; ?? if we got a bit -> done
15098:
15099: lda ReadCharacterError ; or zRODATA
15100: bne @IrqEnd3 ; error? -> done
15101: lda NrBlocksRemaining ; or zINBIT
15102: lsr a
15103: lda ReadCharacterIn ; or zROPRTY
15104: bmi @LFAA3
15105: bcc @LFABA ; ?? 0 or 2 blocks remaining ; switch to EOT
15106: clc
15107: @LFAA3:
15108: bcs @LFABA ; switch to EOT
15109: and #$0F
15110: sta zRIDATA ; switch to count
15111:
15112: @LFAA9: ; ---- 01-0F = count
15113: dec zRIDATA ; count down 1
15114: bne @IrqEnd3
15115: lda #$40 ; when we have reached 00,
15116: sta zRIDATA ; switch to load
15117: jsr Copy_zSTAL_to_zSAL
15118: lda #$00
15119: sta zRIPRTY
15120: beq @IrqEnd3
15121: ; -------------------------
15122:
15123: @LFABA:
15124: lda #$80 ; switch to EOT
15125: sta zRIDATA
15126: bne @IrqEnd3
15127: @LFAC0: ; ---- $40 = load
15128: lda zNXTBIT
15129: beq @LFACE ; ?? if we got a bit, go on
15130:
15131: lda #STATUS_TAPE_SHORT_BLOCK
15132: jsr SetStatus
15133: lda #$00
15134: jmp @LFB4A ; switch to 00 scan
15135:
15136: @LFACE:
15137: jsr HasEndAddressBeenReached
15138: bcc @LFAD6 ; no
15139: jmp @LFB48 ; yes
15140: ; ------------------------
15141:
15142: @LFAD6: ; end address has not been reached
15143: ldx NrBlocksRemaining ; # blocks remaining, 1 or 2 ; or zINBIT
15144: dex
15145:
15146: beq @LFB08 ; go to second pass
15147:
15148: lda zVERCKK ; LOAD or VERIFY
15149: beq @LFAEB
15150:
15151: ldy #$00 ; VERIFY
15152: lda ReadCharacterIn ; or zROPRTY
15153: cmp (zSAL),y ; check if byte matches
15154: beq @LFAEB
15155:
15156: lda #$01 ; remember there was an error
15157: sta ReadCharacterError ; or zRODATA
15158: @LFAEB: ; LOAD
15159: lda ReadCharacterError ; or zRODATA
15160: beq @LFB3A ; just store this byte
15161:
15162: ldx #$3D ; max # of read errors we can store
15163: cpx Pass1ReadErrors ; or zPTR1
15164: bcc @LFB33 ; too many -> LOAD or VERIFY error
15165: ldx Pass1ReadErrors ; or zPTR1
15166: lda zSAL + 1 ; store high byte of error address
15167: sta lSTACK + 1,x
15168: lda zSAL ; and low byte
15169: sta lSTACK,x
15170: inx
15171: inx
15172: stx Pass1ReadErrors ; or zPTR1
15173: jmp @LFB3A ; store this byte anyway
15174: ; -----------------
15175:
15176:
15177: @LFB08: ; this is done during the second read pass
15178: ldx Pass2ReadErrors ; pass 2 read errors or zPTR2
15179: cpx Pass1ReadErrors ; pass 1 read errors or zPTR1
15180: beq @GotAllReadErrors ; processed all
15181:
15182: lda zSAL ; current address LO
15183: cmp lSTACK,x ; equal to address of next read error?
15184: bne @GotAllReadErrors
15185: lda zSAL + 1 ; also check current address HI
15186: cmp lSTACK + 1,x
15187: bne @GotAllReadErrors
15188: inc Pass2ReadErrors ; move over to next address of a read error
15189: inc Pass2ReadErrors ; or zPTR2
15190: lda zVERCKK ; check if LOAD or VERIFY
15191: beq @LFB2F
15192:
15193: lda ReadCharacterIn ; do a VERIFY ; or zROPRTY
15194: ldy #0
15195: cmp (zSAL),y ; 2nd pass matches memory -> ok
15196: beq @GotAllReadErrors
15197: iny
15198: sty ReadCharacterError ; read character error flag ; or zRODATA
15199: @LFB2F:
15200: lda ReadCharacterError ; or zRODATA
15201: beq @LFB3A
15202: @LFB33: ; unrecoverable read error, or, VERIFY error
15203: lda #STATUS_VERIFY
15204: jsr SetStatus
15205: bne @GotAllReadErrors
15206:
15207: @LFB3A: ; just (maybe) store the byte that was read
15208: lda zVERCKK ; 1 = VERIFY
15209: bne @GotAllReadErrors
15210: tay
15211: lda ReadCharacterIn ; or zROPRTY
15212: sta (zSAL),y ; store the byte as read from tape into memory
15213: @GotAllReadErrors:
15214: jsr Increment_zSAL_Address
15215: bne @IrqEnd4
15216: @LFB48:
15217: lda #$80 ; switch to EOT
15218: @LFB4A:
15219: sta zRIDATA ; switch reading mode
15220:
15221: .if CompileComputer >= C64_GENERAL
15222: sei
15223: ldx #TAPE_REG_ICR_B_UNSET_3
15224: stx TAPE_REG_ICR
15225:
15226: ldx TAPE_REG_ICR
15227: .endif
15228:
15229: ldx zFSBLK ; nr of blocks to read (or write)
15230: dex
15231: bmi @LFB5C
15232: stx zFSBLK ; only decrement if not negative
15233: @LFB5C:
15234: dec NrBlocksRemaining ; or zINBIT
15235: beq @LFB68 ; finish up by calculating the parity
15236:
15237: lda Pass1ReadErrors ; or zPTR1
15238: bne @IrqEnd4 ; more errors? keep going
15239: sta zFSBLK ; no errors? 0 blocks to read (or write)
15240: beq @IrqEnd4 ; unconditional branch
15241: ; --------------
15242:
15243: ; Finish up the loading by checking the parity byte
15244:
15245: @LFB68:
15246: jsr TapeStopMotor_and_InitTimer ; stop cass. motor, restore timer, restore IRQ vector
15247:
15248: ; Calculate and check parity (just a XOR)
15249: jsr Copy_zSTAL_to_zSAL
15250: ldy #$00
15251: sty zRIPRTY ; clear to 00
15252:
15253: @LFB72:
15254: lda (zSAL),y
15255: eor zRIPRTY ; xor another byte into it
15256: sta zRIPRTY
15257: jsr Increment_zSAL_Address
15258: jsr HasEndAddressBeenReached
15259: bcc @LFB72 ; and another byte
15260: lda zRIPRTY
15261: eor ReadCharacterIn ; mix in final parity byte ; or zROPRTY
15262: beq @IrqEnd4
15263:
15264: lda #STATUS_TAPE_CHKSUM_ERR ; not equal -> error
15265: jsr SetStatus
15266: @IrqEnd4:
15267: jmp NMI_End
15268: ; --------------------
15269:
15270: Copy_zSTAL_to_zSAL:
15271: lda zSTAL + 1
15272: sta zSAL + 1
15273: lda zSTAL
15274: sta zSAL
15275: rts
15276: ; -------------------------
15277:
15278: ; prepare input or output of a byte by initialising zTSFCNT, zTBTCNT, zBITC1, zPRTY and zRINONE
15279: ;
15280: ; Return:
15281: ; A = 0
15282:
15283: TapeInitInputOutputOfByte:
15284: lda #$08 ; set number of bits to be output to 8
15285: sta zTSFCNT
15286:
15287: lda #$00
15288: sta zTBTCNT ; mark: the bit to output is the real bit, not the inverted one
15289:
15290: sta zBITC1 ; clear bit-counter that determines if the start or the end of a pulse have been reached
15291:
15292: sta zPRTY ; clear parity
15293:
15294: sta zRINONE ; set: the start bit ("1") has not yet been written
15295:
15296: rts
15297: ; --------------------
15298:
15299: TapeSetTimerAndWriteEdgeForBit:
15300: lda zROPRTY ; get data byte to be output
15301: lsr a ; get lowest bit into C
15302: lda #TAPE_TIMER_CONSTANT_BIT0 ; preset $60 as timer value in case the lowest bit is 0
15303: bcc TapeSetTimerLowAndWriteEdge ; C = 0 --> branch, use $60 constant
15304:
15305: TapeSetTimerAndWriteEdgeFor1:
15306: lda #TAPE_TIMER_CONSTANT_BIT1 ; set $B0 as timer value because the lowest bit is 1
15307:
15308: TapeSetTimerLowAndWriteEdge:
15309: ldx #$00 ; high byte of timer value
15310:
15311: TapeSetTimerAndWriteEdge:
15312: sta TAPE_TIMER1_LO ; set timer low
15313: stx TAPE_TIMER1_HI ; and high
15314:
15315: .if CompileComputer >= C64_GENERAL
15316: lda TAPE_REG_ICR ; clear ICR by reading it
15317:
15318: lda #CIA_CRB_B_FORCE_LOAD | CIA_CRB_B_ONESHOT | CIA_CRB_B_START
15319: sta CIA1 + CIA_O_CRB ; program timer B as oneshot, starting it
15320: .endif
15321:
15322: ; change the level of the CASS WRITE line
15323:
15324: lda TAPE_REG_WRITE
15325: eor #TAPE_B_WRITE
15326: sta TAPE_REG_WRITE
15327:
15328: and #TAPE_B_WRITE ; determine the new level
15329: rts
15330: ; -----------------------
15331:
15332: LFBC8:
15333: ; TODO
15334: sec
15335: .if CompileComputer >= C64_GENERAL
15336: ror zRODATA
15337: .else
15338: ror zSAL + 1
15339: .endif
15340: bmi TapeIrqEnd1 ; (uncond. branch)
15341: ; ------------------------
15342:
15343: TapeIrqWrite:
15344: ; IRQ2
15345: lda zBITC1
15346: bne @LFBE3
15347:
15348: lda #<TAPE_TIMER_CONSTANT_WRITE
15349: ldx #>TAPE_TIMER_CONSTANT_WRITE
15350: jsr TapeSetTimerAndWriteEdge
15351: bne TapeIrqEnd1 ; if the write bit is 1, the pulse has just started -> branch -> quit IRQ, we only proceed when the pulse has ended
15352:
15353: inc zBITC1 ; mark: we have already written the bit above
15354:
15355: ; TODO ???
15356:
15357: .if CompileComputer >= C64_GENERAL
15358: lda zRODATA
15359: .else
15360: lda zSAL + 1
15361: .endif
15362: bpl TapeIrqEnd1
15363:
15364: jmp TapeBlockCompletelyWritten ; the complete block has been written
15365: ; ---------------------------
15366:
15367: @LFBE3:
15368: ; write a "1" bit
15369:
15370: lda zRINONE ; have we already written the bit?
15371: bne @LFBF0 ; yes -> branch, write data bit
15372:
15373: jsr TapeSetTimerAndWriteEdgeFor1 ; set a pulse for a "1" bit
15374: bne TapeIrqEnd1 ; if the write bit is 1, the pulse has just started -> branch -> quit IRQ, we only proceed when the pulse has ended
15375:
15376: inc zRINONE ; mark: The "1" bit has already been written
15377: bne TapeIrqEnd1 ; (uncond. branch: If we are here, zRINONE was zero, thus, it cannot be there here after the inc)
15378: ; ---------------------------
15379:
15380: @LFBF0:
15381: 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.
15382: bne TapeIrqEnd1 ; if the write bit is 1, the pulse has just started -> branch -> quit IRQ, we only proceed when the pulse has ended
15383:
15384: ; after outputting the "0" or "1" bit, the routine
15385: ; also outputs the inverse of it ("1" or "0", respectively)
15386:
15387: ; Here, at this place, zTBTCNT is used to find out if the first,
15388: ; original bit has been sent (= $00), or if the inverted one has
15389: ; been sent (= $01)
15390:
15391: lda zTBTCNT
15392: eor #$01
15393: sta zTBTCNT ; invert zTBTCNT.0
15394:
15395: beq TapeBitWritten ; if zTBTCNT == $00 here, then the second, inverted bit has been sent -> branch, the bit is completely written
15396:
15397: ; invert data bit that was just output (zROPRTY.0)
15398: ; Thus, the inverted bit is output the next time
15399:
15400: lda zROPRTY
15401: eor #$01
15402: sta zROPRTY
15403:
15404: ; calculate the parity (with the inverted bit)
15405: and #$01 ; extract the (inverted) data bit
15406: eor zPRTY ; and eor it with parity (TODO?)
15407: sta zPRTY
15408:
15409: TapeIrqEnd1:
15410: jmp NMI_End
15411: ; -------------------
15412:
15413: TapeBitWritten:
15414: ; the bit has been written (in non-inverted and inverted form)
15415:
15416: lsr zROPRTY ; extract next bit to be output
15417:
15418: dec zTSFCNT ; decrement number of bits to be output
15419:
15420: lda zTSFCNT ; still bits to be output?
15421: beq TapeOutputParityBit ; no -> branch, output the parity bit
15422:
15423: bpl TapeIrqEnd1 ; no. of bits to be output > 0 --> still bits to be output, end IRQ here
15424:
15425: LFC16:
15426: ; when we reach here, all bits of the current byte have been output
15427: ; thus, advance to the next byte
15428:
15429: jsr TapeInitInputOutputOfByte ; prepare output of a byte by initialising zTSFCNT, zTBTCNT, zBITC1, zPRTY and zRINONE
15430:
15431: cli ; TODO: timing is not that critical anymore (we have a start bit, thus, a delay is not fatal)
15432:
15433: ; TODO ??? Have we reached end of current byte?
15434:
15435: ; TODO follow logic of this code part
15436:
15437: lda zCNTDN ; countdown at end of preamble
15438: beq @LFC30 ; zero -> branch, proceed to next byte and check if end address has been reached
15439:
15440: ; We're at the end of the preamble, write 89, 88, or 09, 08, ... etc
15441:
15442: ldx #0
15443: stx zSCHAR ; clear check byte
15444:
15445: dec zCNTDN
15446:
15447: ldx zFSBLK ; is this the first copy of the tape file?
15448: cpx #$02
15449: bne @LFC2C ; no -> branch, output TODO ???
15450:
15451: ora #$80 ; or in 1st copy, 89, 88, 87...
15452:
15453: @LFC2C:
15454: sta zROPRTY ; byte to write
15455: bne TapeIrqEnd1 ; (uncond. branch)
15456: ; ------------------
15457:
15458: @LFC30:
15459: jsr HasEndAddressBeenReached ; check if the last byte has been written (the end address has been reached)
15460: bcc @ProcessNextByte ; no -> branch, process the next byte
15461:
15462: bne LFBC8 ; has the extra check byte been written -> branch -> TODO
15463:
15464: inc zSAL + 1 ; increment start address: this way, the "bne" above will branch the next time!
15465:
15466: lda zSCHAR ; get the check byte
15467: sta zROPRTY ; and put it as output byte
15468:
15469: bcs TapeIrqEnd1 ; (uncond. branch)
15470: ; -------------------------
15471:
15472: @ProcessNextByte:
15473: ldy #0
15474: lda (zSAL),y ; read next byte to process
15475: sta zROPRTY ; and store it as new byte to output
15476:
15477: eor zSCHAR ; XOR it with the check byte
15478: sta zSCHAR ; and store it
15479:
15480: jsr Increment_zSAL_Address ; increment pointer to next byte to write
15481:
15482: bne TapeIrqEnd1 ; if we do not want to write $FFFF, this is an uncond. branch
15483: ; BUG: If we write the KERNAL onto tape, we will fall through! (TODO: Really)
15484: ; ---------------------------
15485:
15486: TapeOutputParityBit:
15487: lda zPRTY
15488: eor #$01
15489: sta zROPRTY
15490:
15491: TapeIrqEnd2:
15492: jmp NMI_End
15493: ; -------------------------
15494:
15495: TapeBlockCompletelyWritten:
15496: ; the block has been completely written to the tape
15497:
15498: ; found out if we still have a copy to be written
15499:
15500: dec zFSBLK ; decrement number of copies still to write
15501: bne :+ ; have we reached 0? --> skip next instruction --> do not switch off the tape motor
15502:
15503: jsr TapeSwitchOffMotor ; switch off the tape motor
15504:
15505: : lda #$50
15506: sta zINBIT ; TODO: Write "shorter" preamble
15507:
15508: ; set IRQ vector to: write preamble
15509:
15510: ldx #(VecTapeIrqWritePreamble - TapeIrqVectors) + 8
15511: sei
15512: jsr TapeSetIrqVector
15513:
15514: bne TapeIrqEnd2 ; (uncond. branch)
15515: ; -------------------------------------
15516:
15517:
15518: ; This IRQ routine is called when the system wants to write a preamble to the tape
15519:
15520: TapeIrqWritePreamble:
15521: lda #TAPE_TIMER_CONSTANT_PREAMBLE
15522: jsr TapeSetTimerLowAndWriteEdge
15523:
15524: bne TapeIrqEnd2 ; if the write bit is 1, the pulse has just started -> branch -> quit IRQ, we only proceed when the pulse has ended
15525:
15526: ; if we reach here, the tape write bit is 0.
15527: ; We have just written a pulse of length TAPE_TIMER_CONSTANT_PREAMBLE
15528:
15529: dec zINBIT ; decrement number of bits to write
15530: bne TapeIrqEnd2 ; not yet 0 --> branch --> quit IRQ, we're done for now (write more bits)
15531:
15532: jsr TapeInitInputOutputOfByte ; prepare output of a byte by initialising zTSFCNT, zTBTCNT, zBITC1, zPRTY and zRINONE
15533:
15534: dec zRIPRTY ; decrement number of "bytes" (of zINBIT bits each, that is, $100 bits each!) to write
15535: bpl TapeIrqEnd2 ; not yet negative -> branch, we're done for now (write more bytes)
15536:
15537: ldx #(VecTapeIrqWrite - TapeIrqVectors) + 8 ; change the IRQ routine to the write routine itself
15538: jsr TapeSetIrqVector
15539:
15540: cli
15541:
15542: inc zRIPRTY ; set number of bytes back to 0
15543:
15544: lda zFSBLK ; check number of copies still to write
15545: beq TapeAllCopiesWritten ; 0 copies to write --> branch, quit writing to tape
15546:
15547: jsr Copy_zSTAL_to_zSAL ; TODO copy the tape start address to the start address
15548:
15549: ldx #$09 ; Leader (preamble) finishes with 89, 88, .. 81
15550: ; for 2nd copy: 09, 08, ... 01
15551: stx zCNTDN
15552:
15553: .if CompileComputer >= C64_GENERAL
15554: stx zRODATA
15555: .endif
15556: bne LFC16 ; always ; switch to writing bytes
15557: ; -----------------------
15558:
15559: .endif ; .if CompileComputer = C64_GS
15560:
15561: ; stop cass. motor, restore timer, restore IRQ vector
15562: ;
15563: ; Remark:
15564: ; Flags stay unchanged!
15565: ;
15566: TapeStopMotor_and_InitTimer:
15567: php ; remember I status
15568: sei ; make sure we do not get interrupted by an IRQ
15569:
15570: .if CompileComputer >= C64_GENERAL
15571: ; enable display
15572: lda VIC + VICII_O_ControlReg1
15573: ora #VICII_B_ControlReg1_DEN
15574: sta VIC + VICII_O_ControlReg1
15575: .endif
15576:
15577: jsr TapeSwitchOffMotor ; switch tape motor off
15578:
15579: lda #TAPE_REG_ICR_B_CLEARALL ; clear all interrupt sources
15580: sta TAPE_REG_ICR
15581:
15582: .if CompileComputer < C64_GENERAL
15583: ; TODO document
15584: lda #$F7
15585: sta VIA2_PB
15586: lda #VIA_ACR_B_T1_CONTROL_FREERUN
15587: sta VIA2_ACR
15588: .endif
15589:
15590: jsr iIOINIT_TIMER ; initialise timers (part of iIOINIT)
15591:
15592: ; restore interrupt vector
15593: ;
15594: lda lIRQTMP + 1 ; get high address of stored IRQ vector
15595: beq :+ ; = 0 --> no IRQ vector was stored -> branch, skip restoring
15596: sta lCINV + 1 ; restore IRQ vector high
15597:
15598: lda lIRQTMP ; stored IRQ vector low
15599: sta lCINV ; restore IRQ vector low
15600: :
15601: plp ; restore I status
15602: rts
15603: ; -----------------------
15604:
15605: TapeAllCopiesWritten:
15606: jsr TapeStopMotor_and_InitTimer ; stop cass. motor, restore timer, restore IRQ vector --> complete END the tape IRQ routines.
15607: beq TapeIrqEnd2 ; (uncond. branch, as TapeStopMotor_and_InitTimer restores the flags, and we are only called via a BEQ)
15608: ; -------------------------
15609:
15610: ; set IRQ vector according to X
15611: ; X must be calculated rather "weird": It is done as ldx #(VecNAME - TapeIrqVectors) + 8 if VecNAME is to be set.
15612: TapeSetIrqVector:
15613: lda TapeIrqVectors - 8,x ; get low byte of vector
15614: sta lCINV ; and store it as IRQ vector low
15615: lda TapeIrqVectors - 8 + 1,x ; get high byte of vector
15616: sta lCINV + 1 ; and store it as IRQ vector high
15617: rts
15618: ; -------------------
15619:
15620: ; Switch off the tape motor
15621: ;
15622: TapeSwitchOffMotor:
15623: lda TAPE_REG_MOTOR
15624: ora #TAPE_B_MOTOR_ON_ALL
15625: sta TAPE_REG_MOTOR
15626: rts
15627:
15628: ; Check if the end address has been reached
15629: ; in writing
15630: ;
15631: ; Return:
15632: ; C = 0: End address has not yet been reached
15633: ; C = 1: End address has been reached
15634: ;
15635: ; This routine calculated zSAL/zSAL+1 - zEAL/zEAL+1.
15636: ; If zSAL/zSAL+1 is smaller than zEAL/zEAL+1, we end with C=0, as there was a "borrow".
15637: ; Otherwise (equal or bigger), C=1 as no borrow occurred.
15638: ;
15639: ; This routine is also used in fileio.a65 for IEC transfers
15640: ;
15641: HasEndAddressBeenReached:
15642: sec
15643: lda zSAL
15644: sbc zEAL
15645: lda zSAL + 1
15646: sbc zEAL + 1
15647: rts
15648:
15649: ; Increment the zSAL/zSAL+1 address
15650: ; That is, this routine proceeds the pointer to the next character to be written/read.
15651: ;
15652: ; This routine is also used in fileio.a65 for IEC transfers
15653: ;
15654: Increment_zSAL_Address:
15655: inc zSAL
15656: bne @Rts
15657: inc zSAL + 1
15658: @Rts:
15659: rts
15660: ; ------------------------
15661:
15662: .endif
15663: ; .include "../kernal/init.a65"
15664: ; This is the RESET routine that is called when a hardware RESET occurs.
15665: ; After determining if an expansion cartridge is available - in this case,
15666: ; this routine aborts and calls the RESET routine of the cartridge -
15667: ; it has to set up the I/O areas and all memory. Afterwards, it calls
15668: ; the BASIC through the BASIC cold start vector
15669: ;
15670: RESET:
15671: ldx #<$01FF
15672: sei ; no interrupts are allowed (we have not set it up yet)
15673: txs ; SP = $FF, so we have maximum stack space
15674: cld ; make sure we are in binary mode, not in decimal mode
15675: jsr CheckCartridge ; check for an expansion cartridge
15676: bne @NoCartridge ; no cartridge -> jump
15677: jmp (CART_RESET) ; we have a cartridge, exit and call the RESET routine of the cart
15678:
15679: ; in case we have no cartridge, proceed with initialisation
15680:
15681: @NoCartridge:
15682: .if CompileComputer >= C64_GENERAL
15683: stx VIC + VICII_O_ControlReg2 ; switch to 38 cols mode
15684: ; this seems to be cosmetic only. If the C64 already has a visible
15685: ; screen, one can clearly see that the RESET makes the left and
15686: ; right border smaller on a RESET and/or JSR $FCE2 (SYS 64738)
15687: jsr iIOINIT ; initialise the I/O area
15688: .endif
15689:
15690: jsr iRAMTAS ; clear memory and determine RAM areas
15691: jsr iRESTOR ; restore the KERNEL jump vectors
15692: .if CompileComputer < C64_GENERAL
15693: jsr iIOINIT ; initialise the I/O area
15694: .endif
15695:
15696: ; Initialise the video
15697: .if CompileComputer >= C64_02
15698: jsr iCINT_WITH_PAL_NTSC ; initialise the video. Also make sure to determine PAL or NTSC, and adjust the timings accordingly
15699: .else
15700: jsr iCINT ; initialise the video.
15701: .endif
15702: cli
15703: jmp (bRESTART) ; call BASIC
15704:
15705: ; Check if a cartridge is available.
15706: ; For this, it checks for the "cartridge magic"
15707: ; If there is a cartridge, this routine returns with Z=1
15708: ; else with Z=0
15709: ;
15710: CheckCartridge:
15711: ldx #END_Copy_CARTRIDGE_MAGIC - Copy_CARTRIDGE_MAGIC
15712: @CheckNext:
15713: lda Copy_CARTRIDGE_MAGIC - 1,x
15714: cmp CART_MAGIC - 1,x
15715: bne @NoCart
15716: dex
15717: bne @CheckNext
15718: @NoCart:
15719: rts
15720:
15721: ; Copy of the cartridge magic
15722: ; CheckCartridge checks agains these characters
15723: ; to find out if a cartridge is available.
15724: ;
15725: Copy_CARTRIDGE_MAGIC:
15726: .if CompileComputer >= C64_GENERAL
15727: asc80 "CBM"
15728: .byte "80"
15729: .else
15730: .byte "A0"
15731: asc80 "CBM"
15732: .endif
15733: END_Copy_CARTRIDGE_MAGIC:
15734:
15735: ;
15736: ; B-23. Function Name: RESTOR
15737: ;
15738: ; Purpose: Restore default system and interrupt vectors
15739: ; Call address: $FF8A (hex) 65418 (decimal)
15740: ; Preparatory routines: None
15741: ; Error returns: None
15742: ; Stack requirements: 2
15743: ; Registers affected: A, X, Y
15744: ;
15745: ; Description: This routine restores the default values of all system
15746: ; vectors used in KERNAL and BASIC routines and interrupts. (See the Memory
15747: ; Map for the default vector contents). The KERNAL VECTOR routine is used
15748: ; to read and alter individual system vectors.
15749: ;
15750: ; How to Use:
15751: ; 1) Call this routine.
15752: ;
15753: ; EXAMPLE:
15754: ; JSR RESTOR
15755: ;
15756: iRESTOR:
15757: ldx #<Copy_of_lCINV
15758: ldy #>Copy_of_lCINV
15759: clc
15760:
15761: ; B-39. Function Name: VECTOR
15762: ;
15763: ; Purpose: Manage RAM vectors
15764: ; Call address: $FF8D (hex) 65421 (decimal)
15765: ; Communication registers: X, Y
15766: ; Preparatory routines: None
15767: ; Error returns: None
15768: ; Stack requirements: 2
15769: ; Registers affected: A, X, Y
15770: ;
15771: ;
15772: ; Description: This routine manages all system vector jump addresses
15773: ; stored in RAM. Calling this routine with the the accumulator carry bit
15774: ; set stores the current contents of the RAM vectors in a list pointed to
15775: ; by the X and Y registers. When this routine is called with the carry
15776: ; clear, the user list pointed to by the X and Y registers is transferred
15777: ; to the system RAM vectors. The RAM vectors are listed in the memory map.
15778: ;
15779: ; +-----------------------------------------------------------------------+
15780: ; | NOTE: This routine requires caution in its use. The best way to use it|
15781: ; | is to first read the entire vector contents into the user area, alter |
15782: ; | the desired vectors, and then copy the contents back to the system |
15783: ; | vectors. |
15784: ; +-----------------------------------------------------------------------+
15785: ;
15786: ; How to Use:
15787: ;
15788: ; READ THE SYSTEM RAM VECTORS
15789: ;
15790: ; 1) Set the carry.
15791: ; 2) Set the X and y registers to the address to put the vectors.
15792: ; 3) Call this routine.
15793: ;
15794: ; LOAD THE SYSTEM RAM VECTORS
15795: ;
15796: ; 1) Clear the carry bit.
15797: ; 2) Set the X and Y registers to the address of the vector list in RAM
15798: ; that must be loaded.
15799: ; 3) Call this routine.
15800: ;
15801: ;
15802: ; EXAMPLE:
15803: ; ;CHANGE THE INPUT ROUTINES TO NEW SYSTEM
15804: ; LDX #<USER
15805: ; LDY #>USER
15806: ; SEC
15807: ; JSR VECTOR ;READ OLD VECTORS
15808: ; LDA #<MYINP ;CHANGE INPUT
15809: ; STA USER+10
15810: ; LDA #>MYINP
15811: ; STA USER+11
15812: ; LDX #<USER
15813: ; LDY #>USER
15814: ; CLC
15815: ; JSR VECTOR ;ALTER SYSTEM
15816: ; ...
15817: ; USER *=*+26
15818:
15819: iVECTOR:
15820: ; remember the address where to load/store the vector list
15821: stx zMEMUSS
15822: sty zMEMUSS + 1
15823:
15824: ldy #END_Copy_of_lCINV - Copy_of_lCINV - 1 ; get number of bytes to copy
15825: @Loop: lda lCINV,y
15826: bcs @DoSet ; if C=0, write the buffer to the address at x/y
15827: lda (zMEMUSS),y ; if C=1, get the data from x/y and write it to the system buffers
15828: @DoSet: sta (zMEMUSS),y
15829: sta lCINV,y
15830: dey
15831: bpl @Loop
15832: rts
15833:
15834: ; the system vectors as set by default
15835:
15836: Copy_of_lCINV:
15837: .addr KIRQ ; lCINV
15838: .addr RUNSTOP_RESTORE ; lCNBINV
15839: .addr KNMI ; lNMINV
15840: .addr KOPEN ; lIOPEN
15841: .addr KCLOSE ; lICLOSE
15842: .addr KCHKIN ; lICHKIN
15843: .addr KCHKOUT ; lICHKOUT
15844: .addr KCLRCH ; lICLRCH
15845: .addr KBASIN ; lIBASIN
15846: .addr KBSOUT ; lIBSOUT
15847: .addr KSTOP ; lISTOP
15848: .addr KGETIN ; lIGETIN
15849: .addr KCLALL ; lICLALL
15850: .addr RUNSTOP_RESTORE ; lUSRCMD
15851: .addr KLOAD ; lILOAD
15852: .addr KSAVE ; lISAVE
15853: END_Copy_of_lCINV:
15854:
15855: ; B.20. Function Name: RAMTAS
15856: ;
15857: ; Purpose: Perform RAM test
15858: ; Call address: $FF87 (hex) 65415 (decimal)
15859: ; Communication registers: A, X, Y
15860: ; Preparatory routines: None
15861: ; Error returns: None
15862: ; Stack requirements: 2
15863: ; Registers affected: A, X, Y
15864: ;
15865: ; Description: This routine is used to test RAM and set the top and
15866: ; bottom of memory pointers accordingly. It also clears locations $0000 to
15867: ; $0101 and $0200 to $03FF. It also allocates the cassette buffer, and sets
15868: ; the screen base to $0400. Normally, this routine is called as part of the
15869: ; initialization process of a Commodore 64 program cartridge.
15870: ;
15871: ; EXAMPLE:
15872: ; JSR RAMTAS
15873: ;
15874: iRAMTAS:
15875: ; clear zero page and $200-$3ff
15876: lda #0
15877: .if CompileComputer >= C64_GENERAL
15878: tay
15879: .else
15880: tax
15881: .endif
15882:
15883: @MemClearLoop:
15884:
15885: .if CompileComputer >= C64_GENERAL
15886: sta 2,y ; on the C64, start with ZP address 2 so we do not overwrite $00/$01 (6510 on-chip I/O pins!)
15887: sta $200,y
15888: sta $300,y
15889: iny
15890: .else
15891: sta 0,x
15892: sta $200,x
15893: sta $300,x
15894: inx
15895: .endif
15896: bne @MemClearLoop
15897:
15898: ; set the cassette (tape) buffer address
15899: ldx #<lTBUFFR
15900: ldy #>lTBUFFR
15901: stx zTAPE1
15902: sty zTAPE1 + 1
15903:
15904: ; Check memory for writability by writing
15905: ; a pattern to it ($55, then $AA). If the
15906: ; addresses contain exactly these values afterwards,
15907: ; we have working RAM.
15908:
15909: .if CompileComputer >= C64_GENERAL
15910: tay ; y = 0
15911: lda #(>lVIDEORAM)-1
15912: sta zSTAL + 1
15913: @IncHi: inc zSTAL + 1
15914: @Loop: lda (zSTAL),y ; remember original value of the memory location
15915: tax ; in X
15916:
15917: lda #$55 ; write $55 into memory location
15918: sta (zSTAL),y
15919: cmp (zSTAL),y ; still $55?
15920: bne @NotEqual ; no, quit loop
15921:
15922: rol a ; test $AA pattern instead
15923: sta (zSTAL),y
15924: cmp (zSTAL),y ; still $AA?
15925: bne @NotEqual ; no, quit loop
15926:
15927: ;
15928: ; the old value is only restored if the memory is determined as RAM.
15929: ; otherwise, either $55 or $AA remains at the last location.
15930: ; this is in contrast to the VIC 20 implementation, which leaves all
15931: ; bytes unchanged.
15932: ; Ironically, for the VIC20, there is no difference if this byte is
15933: ; restored or not. For the C64, however, there is a difference, as
15934: ; the RAM under the ROM at $A000 is overwritten with $55 after this
15935: ; function has been called if the BASIC ROM is switched on.
15936: ;
15937: txa ; restore old value
15938: sta (zSTAL),y
15939:
15940: .if CompileComputer = C64_GS
15941: nop
15942: bne @IncHi
15943: .else
15944: iny ; proceed to next memory location
15945: bne @Loop ; and do it again
15946: .endif
15947: beq @IncHi ; try next page
15948: ; ------------------------------
15949:
15950: @NotEqual:
15951: tya ; low byte of failed addres
15952: tax ; into X
15953: ldy zSTAL + 1 ; high byte of failed address into y
15954: clc ; (unneccessary, as we call iMEMTOP_Set, not iMEMTOP in the next line)
15955: jsr iMEMTOP_Set ; set memory top to x/y
15956:
15957: lda #>lBASICRAM ; set BASIC start to $0800
15958: sta lMEMSTR + 1 ; (low byte is already 0, as we just cleared the ZP)
15959:
15960: lda #>lVIDEORAM ; set video RAM start to $0400
15961: sta lHIBASE
15962: rts
15963:
15964: .else
15965:
15966: sta zSTAL ; zSTAL low = 0 (unneccessary, as we already cleared ZP to 0)
15967: sta zTEMPX ; (unneccessary, as we already cleared ZP to 0)
15968: sta lMEMSTR ; BASIC start low = 0 (unneccessary, as we already cleared ZP to 0)
15969: tay ; Y = 0
15970:
15971: lda #>$0400 ; start memory test at the location $0400.
15972: ; This is the first address where memory can be available on the VIC20,
15973: ; if a 3 KB RAM expansion is present.
15974: sta zSTAL + 1
15975:
15976: @MemTestLoop:
15977: ; increment address to be tested.
15978: ; Note that the VIC20 will actually start the test at $0401 with this, thus, $0400 will not be tested at all.
15979:
15980: inc zSTAL ; increment low byte of address to be tested
15981: bne @SkipHighByte
15982: inc zSTAL + 1 ; increment high byte, if necessary
15983:
15984: @SkipHighByte:
15985: jsr CheckWritability ; check if byte is writeable RAM (C=1) or not (C=0)
15986:
15987: lda zTEMPX ; until we found (first) RAM, handle
15988: beq @FindMemStart ; the test separately at @FindMemStart
15989:
15990: ; if we reach here, we have already found the start of RAM somewhere between $0400-$10FF.
15991: ; Thus, we continue the loop until we found a non-RAM location
15992:
15993: bcs @MemTestLoop ; if we still have RAM, test the next location
15994:
15995: ; here, we found the end of RAM
15996:
15997: ldy zSTAL + 1 ; get end of RAM pointer into x/y
15998: ldx zSTAL
15999: cpy #>$2000 ; end of RAM below $2000?
16000: bcc @Panic ; then panic, we have a severe problem, as we did not even find the RAM every VIC20 has!
16001:
16002: cpy #>$2100 ; end of RAM >= $2100?
16003: bcs @MemConf2 ; yet, set "configuration type 2", expanded with more than 3 KB RAM
16004:
16005: ; we have an unexpanded VIC20 (or expanded with not more than 3KB)
16006: ldy #>$1E00 ; put screen memory at $1E00 (- $1FFF)
16007: sty lHIBASE
16008: ; put memory top at $1E00
16009:
16010: @SetMemTop:
16011: jmp iMEMTOP_Set
16012:
16013: @MemConf2:
16014: lda #>$1200 ; set user basic start to $1200
16015: sta lMEMSTR + 1
16016: lda #>$1000 ; set screen memory to $1000
16017: sta lHIBASE
16018: bne @SetMemTop ; set memory top to what was determined (in x/y)
16019: ; ------------------
16020:
16021: @FindMemStart:
16022: ; if we reach here, we are not sure if there is memory at $0400-$0FFF (3 KB expansion)
16023: ; thus, we proceed when we have NOT yet found writeable RAM.
16024:
16025: bcc @MemTestLoop ; no RAM --> jump
16026:
16027: ; here, we have found the start of RAM
16028: lda zSTAL + 1 ; remember the start of RAM
16029: sta lMEMSTR + 1 ; at (lMEMSTR)
16030: sta zTEMPX ; remember we already found start of RAM.
16031: ; with this, we will not jump to @FindMemStart anymore
16032: cmp #>$1100
16033: bcc @MemTestLoop ; if start of RAM is below $1100, continue
16034:
16035: ; otherwise, we have a severe error, as RAM *must* start at $1000 in every VIC20.
16036: ; Thus, stop booting with a:
16037:
16038: ; endless loop: stop boot
16039: @Panic:
16040: jsr SET_VIC_DEFAULTS
16041: jmp @Panic
16042: .endif
16043:
16044:
16045: ; TODO
16046:
16047: TapeIrqVectors:
16048:
16049: .if CompileComputer = C64_GS
16050: .addr NMI_End
16051: .addr NMI_End
16052: .addr NMI_End
16053: .addr NMI_End
16054: .else
16055:
16056: VecTapeIrqWritePreamble:
16057: .addr TapeIrqWritePreamble
16058: VecTapeIrqWrite:
16059: .addr TapeIrqWrite
16060: VecKIRQ:
16061: .addr KIRQ
16062: VecTapeIrqRead:
16063: .addr TapeIrqRead
16064:
16065: .endif
16066:
16067: ; B-13. Function Name: IOINIT
16068: ;
16069: ; Purpose: Initialize I/O devices
16070: ; Call Address: $FF84 (hex) 65412 (decimal)
16071: ; Communication registers: None
16072: ; Preparatory routines: None
16073: ; Error returns:
16074: ; Stack requirements: None
16075: ; Registers affected: A, X, Y
16076: ;
16077: ; Description: This routine initializes all input/output devices and
16078: ; routines. It is normally called as part of the initialization procedure
16079: ; of a Commodore 64 program cartridge.
16080: ;
16081: ; EXAMPLE:
16082: ; JSR IOINIT
16083: ;
16084:
16085: iIOINIT:
16086: .if CompileComputer >= C64_GENERAL
16087:
16088: ; clear all bits in the interrupt control register.
16089: ; Thus, no CIA will generate any interrupts until
16090: ; reprogrammed
16091: lda #~CIA_ICR_BW_SET
16092: sta CIA1 + CIA_O_ICR
16093: sta CIA2 + CIA_O_ICR
16094:
16095: ; (A = $7F)
16096: sta CIA1 + CIA_O_PA
16097:
16098: ; stop all timers (TA, TB) on CIA1 and CIA2
16099: lda #CIA_CRA_B_ONESHOT ; is the same as CIA_CRB_B_ONESHOT!
16100: sta CIA1 + CIA_O_CRA
16101: sta CIA2 + CIA_O_CRA
16102:
16103: sta CIA1 + CIA_O_CRB
16104: sta CIA2 + CIA_O_CRB
16105:
16106: ; Port B (PB) of CIA1 and CIA2 are inputs
16107: ldx #$00
16108: stx CIA1 + CIA_O_DDRB ; keyboard column
16109: stx CIA2 + CIA_O_DDRB
16110:
16111: stx SID + SID_O_FiltMode
16112:
16113: ; Port A (PA) of CIA1 is output
16114: dex ; X = $FF
16115: stx CIA1 + CIA_O_DDRA ; keyboard row
16116:
16117: ; VIC reaches bank 0 ($0000-$1FFF), RS232 TXD is active. IEC lines are all inactive.
16118: lda #CIA2_PA_B_VA14 | CIA2_PA_B_VA15 | CIA2_PA_B_RS232_TXD
16119: sta CIA2 + CIA_O_PA ; IEC_REG_DATA_CLK_OUT
16120:
16121: 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
16122: sta CIA2 + CIA_O_DDRA ; IEC_DDR
16123:
16124: lda #P6510_B_LORAM | P6510_B_HIRAM | P6510_B_CHAREN | P6510_B_CASS_MOTOR | P6510_B_UNUSED
16125: sta zR6510
16126: lda #P6510_B_LORAM | P6510_B_HIRAM | P6510_B_CHAREN | P6510_B_CASS_WRITE | P6510_B_CASS_MOTOR
16127:
16128: sta zD6510
16129:
16130: iIOINIT_TIMER:
16131: .if CompileComputer >= C64_02
16132: lda lTVSFLG
16133: beq LFDEC
16134: lda #<DEFAULT_INIT_VALUE_CIA1_TA_PAL
16135: .else
16136: lda #<DEFAULT_INIT_VALUE_CIA1_TA_1MHZ
16137: .endif
16138: sta CIA1 + CIA_O_TALO
16139:
16140: .if CompileComputer >= C64_02
16141: lda #>DEFAULT_INIT_VALUE_CIA1_TA_PAL
16142: jmp LFDF3
16143: LFDEC: lda #<DEFAULT_INIT_VALUE_CIA1_TA_NTSC
16144: sta CIA1 + CIA_O_TALO
16145: lda #>DEFAULT_INIT_VALUE_CIA1_TA_NTSC
16146: LFDF3: sta CIA1 + CIA_O_TAHI
16147: .else
16148: lda #>DEFAULT_INIT_VALUE_CIA1_TA_1MHZ
16149: sta CIA1 + CIA_O_TAHI
16150: .endif
16151:
16152: .macro IOINIT_PATCH
16153: lda #CIA_ICR_BW_SET |CIA_ICR_B_TA
16154: sta CIA1 + CIA_O_ICR
16155: lda CIA1 + CIA_O_CRA
16156: and #CIA_CRA_B_50HZ ; clear everything but 50/60 Hz flag
16157: ora #CIA_CRA_B_FORCE_LOAD | CIA_CRA_B_START ; start timer in continuous mode
16158: sta CIA1 + CIA_O_CRA
16159: jmp IecClkSet
16160: .endmacro
16161:
16162: .if CompileComputer >= C64_02
16163: jmp Patch_IOINIT
16164: .else
16165: IOINIT_PATCH
16166: .endif
16167:
16168: .else
16169: ; this is a VIC20
16170:
16171: lda #$7F
16172: sta VIA1_IEC
16173: sta VIA2_IEC
16174: lda #$40
16175: sta VIA2_ACR
16176: lda #$40
16177: sta VIA1_ACR
16178: lda #$FE
16179: sta VIA1_PCR
16180: lda #$DE
16181: sta VIA2_PCR
16182: ldx #$00
16183: stx VIA1_DDRB
16184: ldx #$FF
16185: stx VIA2_DDRB
16186: ldx #$00
16187: stx VIA2_DDRA
16188: ldx #$80
16189: stx VIA1_DDRA
16190: ldx #$00
16191: stx VIA1_PA_NO_HS
16192: jsr IecClkClear
16193: lda #$82
16194: sta VIA1_IEC
16195: jsr IecClkSet
16196:
16197: ;LFE39:
16198: iIOINIT_TIMER:
16199: lda #$C0
16200: sta VIA2_IEC
16201: lda #<DEFAULT_VIA2_T1
16202: sta VIA2_T1CL
16203: lda #>DEFAULT_VIA2_T1
16204: sta VIA2_T1CH
16205: rts
16206:
16207: .endif
16208:
16209:
16210: ; B-30. Function Name: SETNAM
16211: ;
16212: ; Purpose: Set file name
16213: ; Call address: $FFBD (hex) 65469 (decimal)
16214: ; Communication registers: A, X, Y
16215: ; Preparatory routines:
16216: ; Stack requirements: 2
16217: ; Registers affected:
16218: ;
16219: ; Description: This routine is used to set up the file name for the OPEN,
16220: ; SAVE, or LOAD routines. The accumulator must be loaded with the length of
16221: ; the file name. The X and Y registers must be loaded with the address of
16222: ; the file name, in standard 6502 low-byte/high-byte format. The address
16223: ; can be any valid memory address in the system where a string of
16224: ; characters for the file name is stored. If no file name is desired, the
16225: ; accumulator must be set to 0, representing a zero file length. The X and
16226: ; Y registers can be set to any memory address in that case.
16227: ;
16228: ; How to Use:
16229: ;
16230: ; 1) Load the accumulator with the length of the file name.
16231: ; 2) Load the X index register with the low order address of the file
16232: ; name.
16233: ; 3) Load the Y index register with the high order address.
16234: ; 4) Call this routine.
16235: ;
16236: ; EXAMPLE:
16237: ;
16238: ; LDA #NAME2-NAME ;LOAD LENGTH OF FILE NAME
16239: ; LDX #<NAME ;LOAD ADDRESS OF FILE NAME
16240: ; LDY #>NAME
16241: ; JSR SETNAM
16242: ;
16243: iSETNAM:
16244: sta zFNLEN ; store name of file name
16245: stx zFNADR ; and pointer to it
16246: sty zFNADR + 1
16247: rts
16248:
16249: ; B-28. Function Name: SETLFS
16250: ;
16251: ; Purpose: Set up a logical file
16252: ; Call address: $FFBA (hex) 65466 (decimal)
16253: ; Communication registers: A, X, Y
16254: ; Preparatory routines: None
16255: ; Error returns: None
16256: ; Stack requirements: 2
16257: ; Registers affected: None
16258: ;
16259: ;
16260: ; Description: This routine sets the logical file number, device address,
16261: ; and secondary address (command number) for other KERNAL routines.
16262: ; The logical file number is used by the system as a key to the file
16263: ; table created by the OPEN file routine. Device addresses can range from 0
16264: ; to 31. The following codes are used by the Commodore 64 to stand for the
16265: ; CBM devices listed below:
16266: ;
16267: ;
16268: ; ADDRESS DEVICE
16269: ;
16270: ; 0 Keyboard
16271: ; 1 Datassette(TM)
16272: ; 2 RS-232C device
16273: ; 3 CRT display
16274: ; 4 Serial bus printer
16275: ; 8 CBM serial bus disk drive
16276: ;
16277: ;
16278: ; Device numbers 4 or greater automatically refer to devices on the
16279: ; serial bus.
16280: ; A command to the device is sent as a secondary address on the serial
16281: ; bus after the device number is sent during the serial attention
16282: ; handshaking sequence. If no secondary address is to be sent, the Y index
16283: ; register should be set to 255.
16284: ;
16285: ; How to Use:
16286: ;
16287: ; 1) Load the accumulator with the logical file number.
16288: ; 2) Load the X index register with the device number.
16289: ; 3) Load the Y index register with the command.
16290: ;
16291: ;
16292: ;
16293: ;
16294: ; EXAMPLE:
16295: ;
16296: ; FOR LOGICAL FILE 32, DEVICE #4, AND NO COMMAND:
16297: ; LDA #32
16298: ; LDX #4
16299: ; LDY #255
16300: ; JSR SETLFS
16301: ;
16302: ;
16303: iSETLFS:
16304: sta zLA ; store logical file number
16305: stx zFA ; store device number (primary address)
16306: sty zSA ; store secondary address
16307: rts
16308:
16309: ; B-22. Function Name: READST
16310: ;
16311: ; Purpose: Read status word
16312: ; Call address: $FFB7 (hex) 65463 (decimal)
16313: ; Communication registers: A
16314: ; Preparatory routines: None
16315: ; Error returns: None
16316: ; Stack requirements: 2
16317: ; Registers affected: A
16318: ;
16319: ; Description: This routine returns the current status of the I/O devices
16320: ; in the accumulator. The routine is usually called after new communication
16321: ; to an I/O device. The routine gives you information about device status,
16322: ; or errors that have occurred during the I/O operation.
16323: ; The bits returned in the accumulator contain the following information:
16324: ; (see table below)
16325: ;
16326: ; +---------+------------+---------------+------------+-------------------+
16327: ; | ST Bit | ST Numeric | Cassette | Serial | Tape Verify |
16328: ; | Position| Value | Read | Bus R/W | + Load |
16329: ; +---------+------------+---------------+------------+-------------------+
16330: ; | 0 | 1 | | time out | |
16331: ; | | | | write | |
16332: ; +---------+------------+---------------+------------+-------------------+
16333: ; | 1 | 2 | | time out | |
16334: ; | | | | read | |
16335: ; +---------+------------+---------------+------------+-------------------+
16336: ; | 2 | 4 | short block | | short block |
16337: ; +---------+------------+---------------+------------+-------------------+
16338: ; | 3 | 8 | long block | | long block |
16339: ; +---------+------------+---------------+------------+-------------------+
16340: ; | 4 | 16 | unrecoverable | | any mismatch |
16341: ; | | | read error | | |
16342: ; +---------+------------+---------------+------------+-------------------+
16343: ; | 5 | 32 | checksum | | checksum |
16344: ; | | | error | | error |
16345: ; +---------+------------+---------------+------------+-------------------+
16346: ; | 6 | 64 | end of file | EOI line | |
16347: ; +---------+------------+---------------+------------+-------------------+
16348: ; | 7 | -128 | end of tape | device not | end of tape |
16349: ; | | | | present | |
16350: ; +---------+------------+---------------+------------+-------------------+
16351: ;
16352: ;
16353: ;
16354: ; How to Use:
16355: ;
16356: ; 1) Call this routine.
16357: ; 2) Decode the information in the A register as it refers to your pro-
16358: ; gram.
16359: ;
16360: ; EXAMPLE:
16361: ;
16362: ; ;CHECK FOR END OF FILE DURING READ
16363: ; JSR READST
16364: ; AND #64 ;CHECK EOF BIT (EOF=END OF FILE)
16365: ; BNE EOF ;BRANCH ON EOF
16366: ;
16367: iREADST:
16368: lda zFA ; get device address
16369: cmp #FILE_RS232 ; is it a RS232 device?
16370: bne iREADST_Normal ; no, return regular status
16371:
16372: ; here, we have a RS232 device.
16373: ; return the special status of the RS232 device
16374: ; (not documented in the KERNAL description above!)
16375:
16376: lda lRSSTAT ; get RS232 status
16377: .if CompileComputer >= C64_GENERAL
16378: pha ; make sure to remember RS232 status
16379:
16380: ; Leaving this out for the VIC 20 is obviously a severe bug, which
16381: ; makes iREADST for RS232 completely useless on it
16382:
16383: .endif
16384: lda #$00 ; clear RS232 status
16385: sta lRSSTAT
16386: .if CompileComputer >= C64_GENERAL
16387: pla ; get the RS232 status back
16388:
16389: ; Leaving this out for the VIC 20 is obviously a severe bug, which
16390: ; makes iREADST for RS232 completely useless on it
16391:
16392: .endif
16393: rts
16394:
16395: ; B-29. Function Name: SETMSG
16396: ;
16397: ; Purpose: Control system message output
16398: ; Call address: $FF90 (hex) 65424 (decimal)
16399: ; Communication registers: A
16400: ; Preparatory routines: None
16401: ; Error returns: None
16402: ; Stack requirements: 2
16403: ; Registers affected: A
16404: ;
16405: ; Description: This routine controls the printing of error and control
16406: ; messages by the KERNAL. Either print error messages or print control mes-
16407: ; sages can be selected by setting the accumulator when the routine is
16408: ; called. FILE NOT FOUND is an example of an error message. PRESS PLAY ON
16409: ; CASSETTE is an example of a control message.
16410: ; Bits 6 and 7 of this value determine where the message will come from.
16411: ; If bit 7 is 1, one of the error messages from the KERNAL is printed. If
16412: ; bit 6 is set, control messages are printed.
16413: ;
16414: ; How to Use:
16415: ;
16416: ; 1) Set accumulator to desired value.
16417: ; 2) Call this routine.
16418: ;
16419: ; EXAMPLE:
16420: ;
16421: ; LDA #$40
16422: ; JSR SETMSG ;TURN ON CONTROL MESSAGES
16423: ; LDA #$80
16424: ; JSR SETMSG ;TURN ON ERROR MESSAGES
16425: ; LDA #0
16426: ; JSR SETMSG ;TURN OFF ALL KERNAL MESSAGES
16427: ;
16428: iSETMSG:
16429: sta zNSGFLG
16430:
16431: ; in fact, these three commands belong to iREADST!
16432: ; read the status (LFE1A) or set one or more status bits (LFE1C)
16433: iREADST_Normal:
16434: lda zSTATUS
16435: SetStatus:
16436: ora zSTATUS
16437: sta zSTATUS
16438: rts
16439:
16440: ; B-32. Function Name: SETTMO
16441: ;
16442: ; Purpose: Set IEEE bus card timeout flag
16443: ; Call address: $FFA2 (hex) 65442 (decimal)
16444: ; Communication registers: A
16445: ; Preparatory routines: None
16446: ; Error returns: None
16447: ; Stack requirements: 2
16448: ; Registers affected: None
16449: ; +-----------------------------------------------------------------------+
16450: ; | NOTE: This routine is used ONLY with an IEEE add-on card! |
16451: ; +-----------------------------------------------------------------------+
16452: ; Description: This routine sets the timeout flag for the IEEE bus. When
16453: ; the timeout flag is set, the Commodore 64 will wait for a device on the
16454: ; IEEE port for 64 milliseconds. If the device does not respond to the
16455: ; Commodore 64's Data Address Valid (DAV) signal within that time the
16456: ; Commodore 64 will recognize an error condition and leave the handshake
16457: ; sequence. When this routine is called when the accumulator contains a 0
16458: ; in bit 7, timeouts are enabled. A 1 in bit 7 will disable the timeouts.
16459: ;
16460: ; +-----------------------------------------------------------------------+
16461: ; | NOTE: The Commodore 64 uses the timeout feature to communicate that a |
16462: ; | disk file is not found on an attempt to OPEN a file only with an IEEE |
16463: ; | card. |
16464: ; +-----------------------------------------------------------------------+
16465: ;
16466: ; How to Use:
16467: ;
16468: ; TO SET THE TIMEOUT FLAG
16469: ; 1) Set bit 7 of the accumulator to 0.
16470: ; 2) Call this routine.
16471: ;
16472: ; TO RESET THE TIMEOUT FLAG
16473: ; 1) Set bit 7 of the accumulator to 1.
16474: ; 2) Call this routine.
16475: ;
16476: ; EXAMPLE:
16477: ;
16478: ; ;DISABLE TIMEOUT
16479: ; LDA #0
16480: ; JSR SETTMO
16481: ;
16482: iSETTMO:
16483: sta lTIMOUT
16484: rts
16485:
16486:
16487: ; B-17. Function Name: MEMTOP
16488: ;
16489: ; Purpose: Set the top of RAM
16490: ; Call address: $FF99 (hex) 65433 (decimal)
16491: ; Communication registers: X, Y
16492: ; Preparatory routines: None
16493: ; Error returns: None
16494: ; Stack requirements: 2
16495: ; Registers affected: X, Y
16496: ;
16497: ; Description: This routine is used to set the top of RAM. When this
16498: ; routine is called with the carry bit of the accumulator set, the pointer
16499: ; to the top of RAM will be loaded into the X and Y registers. When this
16500: ; routine is called with the accumulator carry bit clear, the contents of
16501: ; the X and Y registers are loaded in the top of memory pointer, changing
16502: ; the top of memory.
16503: ;
16504: ; EXAMPLE:
16505: ; ;DEALLOCATE THE RS-232 BUFFER
16506: ; SEC
16507: ; JSR MEMTOP ;READ TOP OF MEMORY
16508: ; DEX
16509: ; CLC
16510: ; JSR MEMTOP ;SET NEW TOP OF MEMORY
16511: ;
16512: iMEMTOP:
16513: bcc iMEMTOP_Set ; c = 0 --> set MEMTOP
16514: iMEMTOP_Get:
16515: ldx lMEMSIZ ; get MEMTOP to x/y
16516: ldy lMEMSIZ + 1
16517: iMEMTOP_Set:
16518: stx lMEMSIZ ; set MEMTOP from x/y
16519: sty lMEMSIZ + 1
16520: rts
16521:
16522: ; B-16. Function Name: MEMBOT
16523: ;
16524: ; Purpose: Set bottom of memory
16525: ; Call address: $FF9C (hex) 65436 (decimal)
16526: ; Communication registers: X, Y
16527: ; Preparatory routines: None
16528: ; Error returns: None
16529: ; Stack requirements: None
16530: ; Registers affected: X, Y
16531: ;
16532: ; Description: This routine is used to set the bottom of the memory. If
16533: ; the accumulator carry bit is set when this routine is called, a pointer
16534: ; to the lowest byte of RAM is returned in the X and Y registers. On the
16535: ; unexpanded Commodore 64 the initial value of this pointer is $0800
16536: ; (2048 in decimal). If the accumulator carry bit is clear (-O) when this
16537: ; routine is called, the values of the X and Y registers are transferred to
16538: ; the low and high bytes, respectively, of the pointer to the beginning of
16539: ; RAM.
16540: ;
16541: ;
16542: ;
16543: ; How to Use:
16544: ; TO READ THE BOTTOM OF RAM
16545: ; 1) Set the carry.
16546: ; 2) Call this routine.
16547: ;
16548: ; TO SET THE BOTTOM OF MEMORY
16549: ; 1) Clear the carry.
16550: ; 2) Call this routine.
16551: ;
16552: ; EXAMPLE:
16553: ;
16554: ; ;MOVE BOTTOM OF MEMORY UP 1 PAGE
16555: ; SEC ;READ MEMORY BOTTOM
16556: ; JSR MEMBOT
16557: ; INY
16558: ; CLC ;SET MEMORY BOTTOM TO NEW VALUE
16559: ; JSR MEMBOT
16560: ;
16561: iMEMBOT:
16562: bcc @Set ; c = 0 --> set MEMBOT
16563:
16564: ldx lMEMSTR ; get MEMBOT to x/y
16565: ldy lMEMSTR + 1
16566:
16567: @Set: stx lMEMSTR ; set MEMBOT from x/y
16568: sty lMEMSTR + 1
16569: rts
16570:
16571:
16572: .if CompileComputer < C64_GENERAL
16573: ;
16574: ; Test if the memory location pointed to by (zSTAL),y is writable RAM.
16575: ; For this, we write $55, then $AA into the location. After each write,
16576: ; we test if the memory is $55 and $AA, respectively.
16577: ; The memory location is left unchanged (that is, the old value is written
16578: ; back to it), regardless of the outcome of the test.
16579: ;
16580: ; If the area is determined as RAM, return with c=1, else c=0.
16581: ;
16582: CheckWritability:
16583: lda (zSTAL),y ; remember original value of the memory location
16584: tax ; in X
16585:
16586: lda #$55 ; write $55 into memory location
16587: sta (zSTAL),y
16588: cmp (zSTAL),y ; still $55?
16589: bne @NotEqual ; no, quit loop
16590:
16591: ror a ; test $AA pattern instead
16592: sta (zSTAL),y
16593: cmp (zSTAL),y ; still $AA?
16594: bne @NotEqual ; no, quit loop
16595:
16596: .byte $A9 ; with next byte: "lda #$18". Make sure the CLC is not executed.
16597:
16598: @NotEqual:
16599: clc ; return: There was a difference
16600:
16601: txa ; restore old value
16602: sta (zSTAL),y
16603: rts
16604: .endif
16605:
16606: ; 6502 NMI routine
16607: ; This routine is called whenever an NMI occurs.
16608: ;
16609: NMI: sei ; block IRQ
16610: jmp (lNMINV) ; normally points to KNMI
16611:
16612: KNMI: pha ; save A, X and Y onto the stack
16613: txa
16614: pha
16615: tya
16616: pha
16617:
16618: .if CompileComputer >= C64_GENERAL
16619: ; clear all bits in the interrupt control register to prevent further interrupts
16620: lda #~CIA_ICR_BW_SET
16621: sta CIA2 + CIA_O_ICR
16622:
16623: ; check if CIA2 generated this NMI
16624: ldy CIA2 + CIA_O_ICR
16625: bmi NMI_FROM_IO ; CIA2 generated the NMI, process it
16626: .else
16627: ; check if VIA1 generated this NMI
16628: lda VIA1_IFR
16629: bpl LFEFF
16630: and VIA1_IEC
16631: tax
16632: and #$02
16633: beq NMI_FROM_IO
16634: .endif
16635:
16636: jsr CheckCartridge ; is there a cartridge (with magic) installed at $8000 (C64) / $A000 (VIC-20)?
16637: bne @NoCartridge ; no, skip
16638: jmp (CART_NMI) ; yes, let the cartridge process the NMI
16639:
16640: @NoCartridge:
16641: .if CompileComputer >= C64_GENERAL
16642: jsr iUDTIM_CheckRunStop
16643: .else
16644: bit VIA1_PA
16645: jsr iUDTIM
16646: .endif
16647: jsr kSTOP
16648: bne LFEFF
16649:
16650: RUNSTOP_RESTORE:
16651: jsr iRESTOR
16652: jsr iIOINIT
16653: jsr iCINT
16654: jmp (bRESTART + 2)
16655:
16656: NMI_FROM_IO:
16657:
16658: .if CompileComputer >= C64_GENERAL
16659: LFEFF:
16660: ; TODO combine more?
16661:
16662: ; TODO follow logic (currently, there is no description *why* these tests are done!)
16663:
16664: tya ; A := Y, which has contents of CIA2 + CIA_O_ICR here
16665: and lENABL ; only check bits that are set in lENABL
16666: tax
16667:
16668: and #CIA_ICR_B_TA ; check if TA of CIA2 generated the interrupt
16669: beq @NoTimerAUnderflow ; no -> branch, next test
16670:
16671: lda RS232_TXD_REG
16672: and #~CIA2_PA_B_RS232_TXD
16673: ora zNXTBIT
16674: sta RS232_TXD_REG
16675:
16676: ; clear all interrupt sources of CIA2 that are currently set
16677: lda lENABL ; get enabled interrupt sources
16678: sta CIA2 + CIA_O_ICR
16679:
16680: txa
16681: and #CIA_ICR_B_FLAG | CIA_ICR_B_TB ; check if timer B or FLAG generated the interrupt
16682: beq @Continue ; none -> branch
16683:
16684: and #CIA_ICR_B_TB ; check if timer B generated the interrupt
16685: beq @IntFromFlag ; no -> branch
16686:
16687: jsr LFED6
16688: jmp @Continue
16689:
16690: @IntFromFlag:
16691: jsr LFF07
16692:
16693: @Continue:
16694: jsr LEEBB
16695: jmp @ClearAllCIA2Interrupts
16696:
16697: @NoTimerAUnderflow:
16698: txa
16699: and #CIA_ICR_B_TB ; check if TB of CIA2 generated the interrupt
16700: beq @NoTimerBUnderflow ; no -> branch, next test
16701: jsr LFED6
16702: jmp @ClearAllCIA2Interrupts
16703:
16704: @NoTimerBUnderflow:
16705: txa
16706: and #CIA_ICR_B_FLAG ; check if FLAG of CIA2 generated the interrupt
16707: beq @ClearAllCIA2Interrupts ; no -> branch, next test
16708: jsr LFF07
16709:
16710: @ClearAllCIA2Interrupts:
16711: ; clear all interrupt sources of CIA2 that are currently set
16712: lda lENABL ; get enabled interrupt sources
16713: sta CIA2 + CIA_O_ICR
16714:
16715: .else
16716:
16717: lda VIA1_IEC
16718: ora #$80
16719: pha
16720: lda #$7F
16721: sta VIA1_IEC
16722: txa
16723: and #$40
16724: beq LFF02
16725: lda #$CE
16726: ora zNXTBIT
16727: sta VIA1_PCR
16728: lda VIA1_T1CL
16729: pla
16730: sta VIA1_IEC
16731: jsr LEEBB
16732: LFEFF:
16733: jmp NMI_End
16734: ; -----------------------
16735:
16736: LFF02: txa
16737: and #$20
16738: beq @LFF2C
16739: lda VIA1_PB
16740: and #$01
16741: sta zINBIT
16742: lda VIA1_T2CL
16743: sbc #$16
16744: adc lBAUDOF
16745: sta VIA1_T2CL
16746: lda VIA1_T2CH
16747: adc lBAUDOF + 1
16748: sta VIA1_T2CH
16749: pla
16750: sta VIA1_IEC
16751: jsr LEF59
16752: jmp NMI_End
16753: @LFF2C: txa
16754: and #$10
16755: beq NMI_End
16756: lda lM51CTR
16757: and #$0F
16758: bne @LFF38
16759: @LFF38: asl a
16760: tax
16761: lda LFEC2 - 2,x
16762: sta VIA1_T2CL
16763: lda LFEC2 - 1,x
16764: sta VIA1_T2CH
16765: lda VIA1_PB
16766: pla
16767: ora #$20
16768: and #$EF
16769: sta VIA1_IEC
16770: ldx lBITNUM
16771: stx zBITC1
16772: .endif
16773:
16774: NMI_End:
16775: pla
16776: tay
16777: pla
16778: tax
16779: pla
16780: rti
16781:
16782: LFEC2:
16783:
16784: .if CompileComputer >= C64_GENERAL
16785:
16786: .if CompileComputer >= C64_02
16787: .word $27C1
16788: .word $1A3E
16789: .word $11C5
16790: .word $0E74
16791: .word $0CED
16792: .word $0645
16793: .word $02F0
16794: .word $0146
16795: .word $00B8
16796: .word $0071
16797: .else
16798: .word $26AC
16799: .word $19A7
16800: .word $115D
16801: .word $0E1F
16802: .word $0CA1
16803: .word $061F
16804: .word $02DD
16805: .word $013D
16806: .word $00B2
16807: .word $006C
16808:
16809: .endif
16810:
16811: .else
16812:
16813: .if CompileComputer >= VIC20_07
16814:
16815: .word $2AE6
16816: .word $1C78
16817: .word $1349
16818: .word $0FB1
16819: .word $0E0A
16820: .word $06D3
16821: .word $0338
16822: .word $016A
16823: .word $00D0
16824: .word $0083
16825: .word $0036
16826:
16827: .else
16828:
16829: .word $2792
16830: .word $1A40
16831: .word $11C6
16832: .word $0E74
16833: .word $0CEE
16834: .word $0645
16835: .word $02F1
16836: .word $0146
16837: .word $00B8
16838: .word $0071
16839: .word $002A
16840:
16841: .endif
16842:
16843: .endif
16844:
16845:
16846: .if CompileComputer >= C64_GENERAL
16847: LFED6: lda CIA2 + CIA_O_PB
16848: and #$01
16849: sta zINBIT
16850: lda CIA2 + CIA_O_TBLO
16851: sbc #$1C
16852: adc lBAUDOF
16853: sta CIA2 + CIA_O_TBLO
16854: lda CIA2 + CIA_O_TBHI
16855: adc lBAUDOF + 1
16856: sta CIA2 + CIA_O_TBHI
16857: lda #$11
16858: sta CIA2 + CIA_O_CRB
16859:
16860: ; clear all interrupt sources of CIA2 that are currently set
16861: lda lENABL ; get enabled interrupt sources
16862: sta CIA2 + CIA_O_ICR
16863:
16864: lda #$FF
16865: sta CIA2 + CIA_O_TBLO
16866: sta CIA2 + CIA_O_TBHI
16867: jmp LEF59
16868: LFF07:
16869: .if CompileComputer = C64_01
16870: lda lM51CTR
16871: and #$0F
16872: bne LFF1A
16873: .endif
16874: lda lM51AJB
16875: sta CIA2 + CIA_O_TBLO
16876: lda lM51AJB + 1
16877: .if CompileComputer = C64_01
16878: jmp LFF25
16879: LFF1A: asl a
16880: tax
16881: lda LFEC2 - 2,x
16882: sta CIA2 + CIA_O_TBLO
16883: lda LFEC2 - 1,x
16884: LFF25:
16885: .endif
16886: sta CIA2 + CIA_O_TBHI
16887: lda #$11
16888: sta CIA2 + CIA_O_CRB
16889:
16890: lda #CIA_ICR_B_FLAG | CIA_ICR_B_TB
16891: eor lENABL
16892: sta lENABL
16893:
16894: lda #$FF
16895: sta CIA2 + CIA_O_TBLO
16896: sta CIA2 + CIA_O_TBHI
16897: ldx lBITNUM
16898: stx zBITC1
16899: rts
16900:
16901: .if CompileComputer >= C64_02
16902: LFF2E: tax
16903: lda lM51AJB + 1
16904: rol a
16905: tay
16906: txa
16907: adc #<200
16908: sta lBAUDOF
16909: tya
16910: adc #>200
16911: sta lBAUDOF + 1
16912: rts
16913: .endif
16914:
16915: .segment "TapeFakeFiller"
16916: nop
16917: nop
16918:
16919: ; FillUntil KERNAL_START + $1F43, $EA
16920: .segment "TapeFakeIrq"
16921:
16922: ; This is a faked IRQ entry point. It is used by the tape routine to execute the IRQ routine,
16923: ; returning to a predefined address afterwards.
16924: ;
16925: ; When this address is called (JMPed to), the return address - 1 is already on the stack.
16926: ; This routine has to set a flag register on the stack, making sure that the B bit is unset
16927: ; forcing a processing of an IRQ (and not of a BRK instruction)
16928: ;
16929: FakeIRQ:
16930: php ; push flag register onto stack
16931:
16932: ; now, manipulate the flag register making sure B is unset
16933:
16934: pla ; get it back into the Accu
16935: and #~A6502_FLAGS_B ; make sure B is unset
16936: pha ; store the flag register back onto the stack
16937:
16938:
16939: .endif
16940:
16941: ; 6502 IRQ routine
16942: ; This routine is called whenever an IRQ occurs.
16943: ;
16944: IRQ: pha ; save A, X and Y onto stack
16945: txa
16946: pha
16947: tya
16948: pha
16949:
16950: tsx ; SP -> X
16951: lda lSTACK + 4,x ; Read status register from stack
16952: and #A6502_FLAGS_B ; check BRK flag
16953: beq @isIRQ ; BRK flag is 0 --> it was an IRQ
16954:
16955: jmp (lCNBINV) ; BRK flag was 1, process the BRK instruction
16956:
16957: @isIRQ: jmp (lCINV) ; process the IRQ. Normally, this points to KIRQ
16958:
16959:
16960: .if CompileComputer >= C64_GENERAL
16961: .if CompileComputer >= C64_02
16962:
16963: ; B-7. Function Name: CINT
16964: ;
16965: ; Purpose: Initialize screen editor & 6567 video chip
16966: ; Call address: $FF81 (hex) 65409 (decimal)
16967: ; Communication registers: None
16968: ; Preparatory routines: None
16969: ; Error returns: None
16970: ; Stack requirements: 4
16971: ; Registers affected: A, X, Y
16972: ;
16973: ;
16974: ; Description: This routine sets up the 6567 video controller chip in the
16975: ; Commodore 64 for normal operation. The KERNAL screen editor is also
16976: ; initialized. This routine should be called by a Commodore 64 program
16977: ; cartridge.
16978: ;
16979: ; How to Use:
16980: ;
16981: ; 1) Call this routine.
16982: ;
16983: ; EXAMPLE:
16984: ;
16985: ; JSR CINT
16986: ; JMP RUN ;BEGIN EXECUTION
16987: ;
16988: ; NOTE: iCINT_WITH_PAL_NTSC is an *extended* version.
16989: ; It determines if there is a 6567 (NTSC) or 6569 (PAL) VIC chip.
16990: ; It stores the result in lTVSFLG (TV Standard FLaG), with
16991: ; 0 = NTSC, 1 = PAL.
16992: ; Then, it reprograms the CIA timer for PAL or NTSC.
16993: ;
16994: iCINT_WITH_PAL_NTSC:
16995: jsr iCINT
16996:
16997: @WaitForRaster:
16998: lda VIC + VICII_O_Raster
16999: bne @WaitForRaster
17000: lda VIC + VICII_O_IRQFlags
17001: and #$01
17002: sta lTVSFLG
17003: jmp iIOINIT_TIMER
17004:
17005: ; Remainder of iIOINIT. As the code become too large because of the PAL/NTSC
17006: ; implementation, this patch is here now.
17007: ;
17008: Patch_IOINIT:
17009: IOINIT_PATCH
17010: .endif
17011: .endif
17012:
17013: .if CompileComputer >= C64_GENERAL
17014:
17015: ; FillUntil KERNAL_START + $1F80
17016: .segment "KernalJumpTable"
17017:
17018: .byte VERSION_FF80 ; a version number for the KERNAL
17019:
17020: ; here, the KERNAL jump table begins
17021: ;
17022:
17023:
17024: ; the VIC-20 does not know CINT, IOINIT and RAMTAS, as these were added with the C64:
17025:
17026: kCINT:
17027: .if CompileComputer >= C64_02
17028: ; on C64 >= -02 ROM, determine if this is a PAL or an NTSC machine,
17029: ; and set the IRQ timings accordingly.
17030: ; Afterwards, iCINT is called.
17031: jmp iCINT_WITH_PAL_NTSC
17032: .else
17033: ; for C64 with -01 ROM, iCINT is called directly.
17034: jmp iCINT
17035: .endif
17036:
17037: kIOINIT: jmp iIOINIT
17038: kRAMTAS: jmp iRAMTAS
17039:
17040: .else
17041:
17042: ; FillUntil $FF8A,FILL_FFXX
17043:
17044: .endif
17045:
17046: .segment "KernalJumpTable2"
17047:
17048: ; here, the KERNAL jump table common to VIC20 and C64 begins
17049:
17050: kRESTOR: jmp iRESTOR
17051: kVECTOR: jmp iVECTOR
17052: kSETMSG: jmp iSETMSG
17053: kSECOND: jmp iSECOND
17054: kTKSA: jmp iTKSA
17055: kMEMTOP: jmp iMEMTOP
17056: kMEMBOT: jmp iMEMBOT
17057: kSCNKEY: jmp iSCNKEY
17058: kSETTMO: jmp iSETTMO
17059: kACPTR:
17060: .ifdef JIFFY
17061: jmp JDLFBAA
17062: .else
17063: jmp iACPTR
17064: .endif
17065: kCIOUT: jmp iCIOUT
17066: kUNTLK: jmp iUNTLK
17067: kUNLSN: jmp iUNLSN
17068: kLISTEN: jmp iLISTEN
17069: kTALK: jmp iTALK
17070: kREADST: jmp iREADST
17071: kSETLFS: jmp iSETLFS
17072: kSETNAM: jmp iSETNAM
17073: kOPEN: jmp (lIOPEN)
17074: kCLOSE: jmp (lICLOSE)
17075: kCHKIN: jmp (lICHKIN)
17076: kCHKOUT: jmp (lICKOUT)
17077: kCLRCHN: jmp (lICLRCH)
17078: kCHRIN: jmp (lIBASIN)
17079: kCHROUT: jmp (lIBSOUT)
17080: kLOAD: jmp iLOAD
17081: kSAVE: jmp iSAVE
17082: kSETTIM: jmp iSETTIM
17083: kRDTIM: jmp iRDTIM
17084: kSTOP: jmp (lISTOP)
17085: kGETIN: jmp (lIGETIN)
17086: kCLALL: jmp (lICLALL)
17087: kUDTIM: jmp iUDTIM
17088: kSCREEN: jmp iSCREEN
17089: kPLOT: jmp iPLOT
17090: kIOBASE: jmp iIOBASE
17091:
17092: .if (CompileComputer >= C64_GENERAL) .AND (.NOT .defined(C64JAPAN))
17093: .byte "RR" ; Robert Russell
17094: .if CompileComputer = C64_4064
17095: .byte 0,0
17096: .else
17097: .byte "BY" ; Bob Yannes
17098: .endif
17099: .endif
17100:
17101: ; FillUntil $FFFA,FILL_FFXXa
17102: .segment "Int6502"
17103:
17104: .addr NMI ; 6502 NMI vector
17105: .addr RESET ; 6502 RESET vector
17106: .addr IRQ ; 6502 IRQ vector