0100 ;D1:CHAA.M650110 ;(c)1987 Antic Publishing0120 ;Written by Patrick Bass0130 ;Included from D:CHARLIE.M650140 ;0150 ;Load address into pointer.0160 ;Example: LEA.W LABEL,POINTER0170 ;0180 .MACRO LEA.W 0190 LDA # <%10200 LDY # >%10210 STA %20220 STY %2+10230 .ENDM 0240 ;0250 ;Move a single byte in memory.0260 ;Example: MOVE.B SOURCE,DEST0270 ;0280 .MACRO MOVE.B 0290 LDA %10300 STA %20310 .ENDM 0320 ;0330 ;Move a single word in memory.0340 ;Example: MOVE.W SOURCE,DEST0350 ;0360 .MACRO MOVE.W 0370 MOVE.B %1,%20380 MOVE.B %1+1,%2+10390 .ENDM 0400 ;0410 ;Add a WORD value to a pointer0420 ;Example: ADD.W 5,AMOUNT0430 ;0440 .MACRO ADD.W 0450 CLC 0460 LDA # <%10470 ADC %20480 STA %20490 LDA # >%10500 ADC %2+10510 STA %2+10520 .ENDM 0530 ;0540 ;Fix Proper master pointers.0550 ;Ex: FIX BASE,OFFSET,POINTER0560 ;0570 .MACRO FIX 0580 LDY #40590 CLC 0600 LDA (%1),Y0610 ADC # <%20620 STA %30630 INY 0640 LDA (%1),Y0650 ADC # >%20660 STA %3+10670 .ENDM 0680 ;0690 ;-------------------------------0700 ; Constants0710 ;0720 CTRL.SHIFT.ESCAPE = $80+$40+$1C0730 POINTER.A = $DA ;Over here!0740 POINTER.B = $DC ;Over there!0750 P.A = POINTER.A0760 P.B = POINTER.B0770 ;0780 STARTCODE = $2400 ;Gonzo0790 SDLSTL = $0230 ;Dlist shadow0800 VKEYBD = $0208 ;Vec: Keyboard0810 MEMLO = $02E7 ;Down in Dixie0820 WARMST = $08 ;Sugar Bear0830 BASIC.WARM.START = $A0000840 KBCODE = $D209 ;Whatz pressed?0850 OPTION.BYTE = $FFF1 ;Whos there?0860 XL.XE.SERIES = 2 ;Type of type0870 STOPLN = $BA ;Where stopped.0880 ERRSAVE = 195 ;Last err known0890 LBUFF = $0580 ;BASIC buildnum0900 INBUFF = $F3 ;Here too0910 CIX = $F2 ;Character index0920 FR0 = $D4 ;Float zero0930 IFP = $D9AA ;Integer->Float0940 FASC = $D8E6 ;Float->ATASCII0950 ;0960 WINDOW.FLAG = $0400 ;Window on?0970 ;0980 ; Offsets for printable lines.0990 WINDOW.OFFSET = [40*2]+41000 REPORT.OFFSET = [40*5]+61010 ERROR.OFFSET = [40*7]+141020 LINE.OFFSET = [40*8]+141030 ;...and contractions.1040 W.O = WINDOW.OFFSET1050 R.O = REPORT.OFFSET1060 E.O = ERROR.OFFSET1070 L.O = LINE.OFFSET1080 ;1090 ;---------------------------1100 ;So the program code starts1110 ; right here, and jumps.1120 *= STARTCODE1130 JMP SETUP1140 ;1150 ;- - - - - - - - - - - - - -1160 ACCESSORY1170 ;Save current acc.1180 ;Was key press CTRL-ALT-ESC?1190 ;Branch over if it was...1200 PHA 1210 LDA KBCODE1220 CMP #CTRL.SHIFT.ESCAPE1230 BEQ SETSTART1240 ;1250 ;Else not right char, is1260 ; window currently up?1270 ;Branch out if not... else erase1280 LDA WINDOW.FLAG1290 BEQ SETX1300 ;1310 SETSTART1320 ;Toggle window-on flag.1330 LDA WINDOW.FLAG1340 EOR #11350 STA WINDOW.FLAG1360 ;1370 ;Stack rest of registers.1380 TYA 1390 PHA 1400 TXA 1410 PHA 1420 ;1430 ;Is window coming up?1440 ;Branch if not...1450 LDA WINDOW.FLAG1460 BEQ SETOFF1470 ;1480 ;Else open, work the window.1490 JSR OPEN.WINDOW1500 JSR WORK.WINDOW1510 JMP SETX11520 SETOFF1530 JSR CLOSE.WINDOW1540 SETX11550 PLA 1560 TAX 1570 PLA 1580 TAY 1590 SETX1600 ;Folks, I know all about1610 ;indirect jumps. MAC65 would1620 ; not let me grab the old1630 ;VKEYBD vector. Don't know why.1640 ;1650 LDA OPTION.BYTE1660 CMP #XL.XE.SERIES1670 BNE MAYBE.THE.1200XL1680 ;1690 PLA 1700 JMP $FC191710 ;1720 MAYBE.THE.1200XL1730 CMP #11740 BNE ITS.AN.8001750 ;1760 PLA 1770 JMP $FC0C1780 ;1790 ITS.AN.8001800 PLA 1810 JMP $FFBE1820 ;1830 ;-----------------1840 W.SCREEN1850 .WORD 0 ;Window1860 R.SCREEN1870 .WORD 0 ;Report Line1880 E.SCREEN1890 .WORD 0 ;Error Line1900 L.SCREEN1910 .WORD 0 ;Line Line1920 C.MESS1930 .BYTE " CHARLIE!"1940 .BYTE " is active.",01950 C.SCREEN1960 .WORD 0 ;CHAS Line1970 ;1980 ;- - - - - - - - - - - - -1990 SETUP2000 ;Don't listen to anybody.2010 ;Make sure window is down...2020 ;...and we print normal text.2030 ; Point MEMLO at $3000.2040 ;Build new pointers into window2050 ;Tell 'em CHARLIEs active.2060 ;Replace Keyboard Vector2070 ;Start listening again...2080 ;...and initialize BASIC.2090 ;2100 SEI 2110 LDA #02120 STA WINDOW.FLAG2130 STA REVERSE.FLAG2140 LEA.W $3000,MEMLO2150 ;2160 MOVE.W SDLSTL,POINTER.A2170 FIX P.A,W.O,W.SCREEN2180 FIX P.A,R.O,R.SCREEN2190 FIX P.A,E.O,E.SCREEN2200 FIX P.A,L.O,L.SCREEN2210 FIX P.A,5,C.SCREEN2220 ;2230 LEA.W C.MESS,POINTER.A2240 MOVE.W C.SCREEN,POINTER.B2250 JSR WIND.LINE.OUT2260 ;2270 LEA.W ACCESSORY,VKEYBD2280 LDA #02290 STA WARMST2300 CLI 2310 JMP BASIC.WARM.START2320 ;2330 ;- - - - - - - - - - - - -2340 .WORD 0,0,02350 WINDOW2360 .BYTE ""2370 WIND.W = *-WINDOW2380 .BYTE "š"2390 .BYTE ""2400 .BYTE ""2410 .BYTE ""2420 .BYTE "򠣺 "2430 .BYTE "庠 "2440 .BYTE ""2450 .BYTE " "2460 .BYTE ""2470 WIND.H = [*-WINDOW-1]/WIND.W2480 .WORD 02490 W.BUFF2500 *= *+[*-WINDOW]2510 .WORD 02520 ;2530 ;--------------------------2540 OPEN.WINDOW2550 JSR INIT.OPEN ;Set pointers2560 ;2570 LDX #WIND.H2580 OW12590 LDY #02600 O1FROM2610 LDA $1234,Y ;Copy the screen2620 STA $1234,Y ;to buffer.2630 ;2640 LDA $1234,Y ;Copy the window2650 JSR ADJUST ;in screen code2660 STA $1234,Y ;to the screen.2670 ;2680 INY 2690 CPY #WIND.W2700 BCC O1FROM2710 ;2720 ADD.W 40,O1FROM+12730 ADD.W WIND.W,O1FROM+42740 ADD.W WIND.W,O1FROM+72750 ADD.W 40,O1FROM+132760 DEX 2770 BPL OW12780 ;2790 RTS 2800 ;2810 ;- - - - - - - - - - - - - -2820 INIT.OPEN2830 MOVE.W W.SCREEN,O1FROM+12840 LEA.W W.BUFF,O1FROM+42850 ;2860 LEA.W WINDOW,O1FROM+72870 MOVE.W W.SCREEN,O1FROM+132880 ;2890 RTS 2900 ;2910 ;----------------------------2920 CLOSE.WINDOW2930 JSR INIT.CLOSE2940 ;2950 LDX #WIND.H2960 CW12970 LDY #02980 CFROM2990 LDA $1234,Y :Copy buffer3000 STA $1234,Y ;back to screen3010 ;3020 INY 3030 CPY #WIND.W3040 BCC CFROM3050 ;3060 ADD.W WIND.W,CFROM+13070 ADD.W 40,CFROM+43080 DEX 3090 BPL CW13100 ;3110 RTS 3120 ;3130 ;- - - - - - - - - - - - - -3140 INIT.CLOSE3150 LEA.W W.BUFF,CFROM+13160 MOVE.W W.SCREEN,CFROM+43170 RTS 3180 ;3190 ;----------------------------3200 ADJUST3210 PHA 3220 AND #$803230 STA ADJUST.BIT3240 PLA 3250 AND #$7F3260 ;3270 CMP #32 ;less than 32?3280 BCS AJ1 ;Branch if not.3290 ;3300 ADC #64 ;Else add 643310 BCC AJX ;and split.3320 AJ13330 CMP #96 ;Is char >=96?3340 BCS AJX ;branch if yes3350 ;3360 SEC ;Else 31>chr<963370 SBC #323380 AJX3390 ORA ADJUST.BIT3400 RTS 3410 ;3420 ADJUST.BIT3430 .BYTE 03440 ;3450 ;------------------------3460 FIX.LBUFF3470 LDY #$FF3480 FX13490 INY 3500 LDA (INBUFF),Y3510 BPL FX13520 ;3530 AND #$7F3540 STA (INBUFF),Y3550 INY 3560 LDA #03570 STA (INBUFF),Y3580 RTS 3590 ;3600 ;------------------------3610 WORK.WINDOW3620 ;Set to print in reverse...3630 ;...and make FR0/CIX zero.3640 LDA #$803650 STA REVERSE.FLAG3660 LEA.W 0,FR03670 MOVE.B FR0,CIX3680 ;3690 ;We print the value in ERRSAVE3700 MOVE.B ERRSAVE,FR03710 ;3720 ;Integer to float...3730 ;...Float to ATASCII.3740 ;Place zero on end, print it.3750 JSR IFP3760 JSR FASC3770 JSR FIX.LBUFF3780 LEA.W LBUFF,POINTER.A3790 MOVE.W E.SCREEN,POINTER.B3800 JSR WIND.LINE.OUT3810 ;3820 ;Ditto with the value in STOPLN3830 MOVE.W STOPLN,FR03840 LDA #03850 STA CIX3860 JSR IFP3870 JSR FASC3880 JSR FIX.LBUFF3890 LEA.W LBUFF,POINTER.A3900 MOVE.W L.SCREEN,POINTER.B3910 JSR WIND.LINE.OUT3920 ;3930 ;- - - - - - - - - - - - - - -3940 ;Now, to pick up proper error3950 ;text string, first get error3960 ;number, and compare it against3970 ;each entry in a table of known3980 ;error codes.3990 ;4000 LDA ERRSAVE4010 LDX #NUM.ERR.ENTRIES-14020 WW14030 CMP ERROR.TABLE,X ;match?4040 BEQ WW2 ;branch on match4050 ;4060 DEX ;else next4070 BPL WW1 ;until finis.4080 LDX #43 ;NO MATCH4090 WW24100 ;At this point, a match was4110 ;found in the table, and the4120 ;X register contains the number4130 ;of the error entry.4140 TXA 4150 ASL A ;pointerize it.4160 TAX 4170 ;4180 ;Now pick up the address of the4190 ;coresponding error string and4200 ;place inside POINTER.A4210 ;Then print the string out.4220 LDA ERROR.JUMP,X4230 STA POINTER.A4240 LDA ERROR.JUMP+1,X4250 STA POINTER.A+14260 MOVE.W R.SCREEN,POINTER.B4270 JSR WIND.LINE.OUT4280 WWX4290 RTS 4300 ;4310 ;----------------------------4320 WIND.LINE.OUT4330 LDY #04340 WL14350 LDA (POINTER.A),Y4360 BEQ WLX4370 ;4380 JSR ADJUST4390 ORA REVERSE.FLAG4400 STA (POINTER.B),Y4410 INY 4420 BNE WL14430 WLX4440 RTS 4450 ;4460 REVERSE.FLAG4470 .BYTE 04480 ;4490 ;---------------------------4500 ;A Table of all known error4510 ;code numbers. Searched top down4520 ;4530 ERROR.TABLE4540 .BYTE 2,3,4,5,64550 .BYTE 7,8,9,10,114560 .BYTE 12,13,14,15,164570 .BYTE 17,18,19,20,214580 ;4590 .BYTE 128,129,130,131,1324600 .BYTE 133,134,135,136,1374610 .BYTE 138,139,140,141,1424620 .BYTE 143,144,145,146,1474630 ;4640 .BYTE 160,161,162,163,1644650 .BYTE 165,166,167,168,1694660 .BYTE 170,1714670 NUM.ERR.ENTRIES = *-ERROR.TABLE4680 ;4690 ;A table of all known error4700 ;message addresses, in the same4710 ;order as the table above.4720 ;4730 ERROR.JUMP4740 .WORD E2,E3,E4,E54750 .WORD E6,E7,E8,E94760 .WORD E10,E11,E124770 .WORD E13,E14,E154780 .WORD E16,E17,E184790 .WORD E19,E20,E214800 ;4810 .WORD E128,E129,E1304820 .WORD E131,E132,E1334830 .WORD E134,E135,E1364840 .WORD E137,E138,E1394850 .WORD E140,E141,E1424860 .WORD E143,E144,E1454870 .WORD E146,E1474880 ;4890 .WORD E160,E161,E1624900 .WORD E163,E164,E1654910 .WORD E166,E167,E1684920 .WORD E169,E170,E1714930 ;4940 ;----------------------------4950 ;The error messages themselves.4960 ;4970 E2 .BYTE "OUT OF MEMORY",04980 E3 .BYTE "VALUE ERROR",04990 E4 .BYTE "TOO MANY VARIABLES",05000 E5 .BYTE "STRING TOO LONG",05010 E6 .BYTE "END OF DATA",05020 E7 .BYTE "NUMBER TOO LARGE",05030 E8 .BYTE "TYPE MISMATCH",05040 E9 .BYTE "ARRAY DIMENSION",05050 E10 .BYTE "ARG STACK OVERFLOW",05060 E11 .BYTE "DIVIDE BY ZERO",05070 E12 .BYTE "LINE NOT FOUND",05080 E13 .BYTE "NEXT WITHOUT FOR",05090 E14 .BYTE "LINE TOO LONG",05100 E15 .BYTE "TARGET DELETED",05110 E16 .BYTE "RETURN TO WHERE?",05120 E17 .BYTE "GARBAGE IN CODE",05130 E18 .BYTE "NOT NUMERIC",05140 E19 .BYTE "PROGRAM TOO BIG",05150 E20 .BYTE "BAD CHANNEL #",05160 E21 .BYTE "NOT LOAD FORMAT",05170 ;5180 E128 .BYTE "BREAK ABORT",05190 E129 .BYTE "CHANNEL IS OPEN",05200 E130 .BYTE "UNKNOWN DEVICE",05210 E131 .BYTE "OUTPUT ONLY",05220 E132 .BYTE "XIO SYNTAX ERROR",05230 E133 .BYTE "CHANNEL NOT OPEN",05240 E134 .BYTE "UNKNOWN CHANNEL",05250 E135 .BYTE "INPUT ONLY",05260 E136 .BYTE "END OF FILE",05270 E137 .BYTE "RECORD TRUNCATED",05280 E138 .BYTE "DEVICE TIMEOUT",05290 E139 .BYTE "COMMAND REFUSED",05300 E140 .BYTE "FRAMING ERROR",05310 E141 .BYTE "OUT OF RANGE",05320 E142 .BYTE "FRAME OVERRUN",05330 E143 .BYTE "FRAME CHECKSUM",05340 E144 .BYTE "DISK ERROR",05350 E145 .BYTE "COMPARE ERROR",05360 E146 .BYTE "NOT IMPLEMENTED",05370 E147 .BYTE "NOT ENOUGH RAM",05380 ;5390 E160 .BYTE "DRIVE NUMBER",05400 E161 .BYTE "TOO MANY FILES",05410 E162 .BYTE "DISK FULL",05420 E163 .BYTE "UNKNOWN ERROR",05430 E164 .BYTE "FILE MISMATCH",05440 E165 .BYTE "BAD FILE NAME",05450 E166 .BYTE "POINT ERROR",05460 E167 .BYTE "FILE LOCKED",05470 E168 .BYTE "UNKNOWN XIO",05480 E169 .BYTE "DIRECTORY FULL",05490 E170 .BYTE "FILE NOT FOUND",05500 E171 .BYTE "POINT INVALID",0