PROGRAM LISTING: 87-02/CHAA.M65
0100 ;D1:CHAA.M65
0110 ;(c)1987 Antic Publishing
0120 ;Written by Patrick Bass
0130 ;Included from D:CHARLIE.M65
0140 ;
0150 ;Load address into pointer.
0160 ;Example: LEA.W LABEL,POINTER
0170 ;
0180 .MACRO LEA.W
0190 LDA # <%1
0200 LDY # >%1
0210 STA %2
0220 STY %2+1
0230 .ENDM
0240 ;
0250 ;Move a single byte in memory.
0260 ;Example: MOVE.B SOURCE,DEST
0270 ;
0280 .MACRO MOVE.B
0290 LDA %1
0300 STA %2
0310 .ENDM
0320 ;
0330 ;Move a single word in memory.
0340 ;Example: MOVE.W SOURCE,DEST
0350 ;
0360 .MACRO MOVE.W
0370 MOVE.B %1,%2
0380 MOVE.B %1+1,%2+1
0390 .ENDM
0400 ;
0410 ;Add a WORD value to a pointer
0420 ;Example: ADD.W 5,AMOUNT
0430 ;
0440 .MACRO ADD.W
0450 CLC
0460 LDA # <%1
0470 ADC %2
0480 STA %2
0490 LDA # >%1
0500 ADC %2+1
0510 STA %2+1
0520 .ENDM
0530 ;
0540 ;Fix Proper master pointers.
0550 ;Ex: FIX BASE,OFFSET,POINTER
0560 ;
0570 .MACRO FIX
0580 LDY #4
0590 CLC
0600 LDA (%1),Y
0610 ADC # <%2
0620 STA %3
0630 INY
0640 LDA (%1),Y
0650 ADC # >%2
0660 STA %3+1
0670 .ENDM
0680 ;
0690 ;-------------------------------
0700 ; Constants
0710 ;
0720 CTRL.SHIFT.ESCAPE = $80+$40+$1C
0730 POINTER.A = $DA ;Over here!
0740 POINTER.B = $DC ;Over there!
0750 P.A = POINTER.A
0760 P.B = POINTER.B
0770 ;
0780 STARTCODE = $2400 ;Gonzo
0790 SDLSTL = $0230 ;Dlist shadow
0800 VKEYBD = $0208 ;Vec: Keyboard
0810 MEMLO = $02E7 ;Down in Dixie
0820 WARMST = $08 ;Sugar Bear
0830 BASIC.WARM.START = $A000
0840 KBCODE = $D209 ;Whatz pressed?
0850 OPTION.BYTE = $FFF1 ;Whos there?
0860 XL.XE.SERIES = 2 ;Type of type
0870 STOPLN = $BA ;Where stopped.
0880 ERRSAVE = 195 ;Last err known
0890 LBUFF = $0580 ;BASIC buildnum
0900 INBUFF = $F3 ;Here too
0910 CIX = $F2 ;Character index
0920 FR0 = $D4 ;Float zero
0930 IFP = $D9AA ;Integer->Float
0940 FASC = $D8E6 ;Float->ATASCII
0950 ;
0960 WINDOW.FLAG = $0400 ;Window on?
0970 ;
0980 ; Offsets for printable lines.
0990 WINDOW.OFFSET = [40*2]+4
1000 REPORT.OFFSET = [40*5]+6
1010 ERROR.OFFSET = [40*7]+14
1020 LINE.OFFSET = [40*8]+14
1030 ;...and contractions.
1040 W.O = WINDOW.OFFSET
1050 R.O = REPORT.OFFSET
1060 E.O = ERROR.OFFSET
1070 L.O = LINE.OFFSET
1080 ;
1090 ;---------------------------
1100 ;So the program code starts
1110 ; right here, and jumps.
1120 *= STARTCODE
1130 JMP SETUP
1140 ;
1150 ;- - - - - - - - - - - - - -
1160 ACCESSORY
1170 ;Save current acc.
1180 ;Was key press CTRL-ALT-ESC?
1190 ;Branch over if it was...
1200 PHA
1210 LDA KBCODE
1220 CMP #CTRL.SHIFT.ESCAPE
1230 BEQ SETSTART
1240 ;
1250 ;Else not right char, is
1260 ; window currently up?
1270 ;Branch out if not... else erase
1280 LDA WINDOW.FLAG
1290 BEQ SETX
1300 ;
1310 SETSTART
1320 ;Toggle window-on flag.
1330 LDA WINDOW.FLAG
1340 EOR #1
1350 STA WINDOW.FLAG
1360 ;
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.FLAG
1460 BEQ SETOFF
1470 ;
1480 ;Else open, work the window.
1490 JSR OPEN.WINDOW
1500 JSR WORK.WINDOW
1510 JMP SETX1
1520 SETOFF
1530 JSR CLOSE.WINDOW
1540 SETX1
1550 PLA
1560 TAX
1570 PLA
1580 TAY
1590 SETX
1600 ;Folks, I know all about
1610 ;indirect jumps. MAC65 would
1620 ; not let me grab the old
1630 ;VKEYBD vector. Don't know why.
1640 ;
1650 LDA OPTION.BYTE
1660 CMP #XL.XE.SERIES
1670 BNE MAYBE.THE.1200XL
1680 ;
1690 PLA
1700 JMP $FC19
1710 ;
1720 MAYBE.THE.1200XL
1730 CMP #1
1740 BNE ITS.AN.800
1750 ;
1760 PLA
1770 JMP $FC0C
1780 ;
1790 ITS.AN.800
1800 PLA
1810 JMP $FFBE
1820 ;
1830 ;-----------------
1840 W.SCREEN
1850 .WORD 0 ;Window
1860 R.SCREEN
1870 .WORD 0 ;Report Line
1880 E.SCREEN
1890 .WORD 0 ;Error Line
1900 L.SCREEN
1910 .WORD 0 ;Line Line
1920 C.MESS
1930 .BYTE " CHARLIE!"
1940 .BYTE " is active.",0
1950 C.SCREEN
1960 .WORD 0 ;CHAS Line
1970 ;
1980 ;- - - - - - - - - - - - -
1990 SETUP
2000 ;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 window
2050 ;Tell 'em CHARLIEs active.
2060 ;Replace Keyboard Vector
2070 ;Start listening again...
2080 ;...and initialize BASIC.
2090 ;
2100 SEI
2110 LDA #0
2120 STA WINDOW.FLAG
2130 STA REVERSE.FLAG
2140 LEA.W $3000,MEMLO
2150 ;
2160 MOVE.W SDLSTL,POINTER.A
2170 FIX P.A,W.O,W.SCREEN
2180 FIX P.A,R.O,R.SCREEN
2190 FIX P.A,E.O,E.SCREEN
2200 FIX P.A,L.O,L.SCREEN
2210 FIX P.A,5,C.SCREEN
2220 ;
2230 LEA.W C.MESS,POINTER.A
2240 MOVE.W C.SCREEN,POINTER.B
2250 JSR WIND.LINE.OUT
2260 ;
2270 LEA.W ACCESSORY,VKEYBD
2280 LDA #0
2290 STA WARMST
2300 CLI
2310 JMP BASIC.WARM.START
2320 ;
2330 ;- - - - - - - - - - - - -
2340 .WORD 0,0,0
2350 WINDOW
2360 .BYTE "
"
2370 WIND.W = *-WINDOW
2380 .BYTE "ü ü ĂČÁŇĚÉĹĄ ü ü"
2390 .BYTE ""
2400 .BYTE "üž ü"
2410 .BYTE ""
2420 .BYTE "üĹňňďň Łş ü ü"
2430 .BYTE "üÁô Ěéîĺş ü ü"
2440 .BYTE ""
2450 .BYTE "üźü üžüü"
2460 .BYTE ""
2470 WIND.H = [*-WINDOW-1]/WIND.W
2480 .WORD 0
2490 W.BUFF
2500 *= *+[*-WINDOW]
2510 .WORD 0
2520 ;
2530 ;--------------------------
2540 OPEN.WINDOW
2550 JSR INIT.OPEN ;Set pointers
2560 ;
2570 LDX #WIND.H
2580 OW1
2590 LDY #0
2600 O1FROM
2610 LDA $1234,Y ;Copy the screen
2620 STA $1234,Y ;to buffer.
2630 ;
2640 LDA $1234,Y ;Copy the window
2650 JSR ADJUST ;in screen code
2660 STA $1234,Y ;to the screen.
2670 ;
2680 INY
2690 CPY #WIND.W
2700 BCC O1FROM
2710 ;
2720 ADD.W 40,O1FROM+1
2730 ADD.W WIND.W,O1FROM+4
2740 ADD.W WIND.W,O1FROM+7
2750 ADD.W 40,O1FROM+13
2760 DEX
2770 BPL OW1
2780 ;
2790 RTS
2800 ;
2810 ;- - - - - - - - - - - - - -
2820 INIT.OPEN
2830 MOVE.W W.SCREEN,O1FROM+1
2840 LEA.W W.BUFF,O1FROM+4
2850 ;
2860 LEA.W WINDOW,O1FROM+7
2870 MOVE.W W.SCREEN,O1FROM+13
2880 ;
2890 RTS
2900 ;
2910 ;----------------------------
2920 CLOSE.WINDOW
2930 JSR INIT.CLOSE
2940 ;
2950 LDX #WIND.H
2960 CW1
2970 LDY #0
2980 CFROM
2990 LDA $1234,Y :Copy buffer
3000 STA $1234,Y ;back to screen
3010 ;
3020 INY
3030 CPY #WIND.W
3040 BCC CFROM
3050 ;
3060 ADD.W WIND.W,CFROM+1
3070 ADD.W 40,CFROM+4
3080 DEX
3090 BPL CW1
3100 ;
3110 RTS
3120 ;
3130 ;- - - - - - - - - - - - - -
3140 INIT.CLOSE
3150 LEA.W W.BUFF,CFROM+1
3160 MOVE.W W.SCREEN,CFROM+4
3170 RTS
3180 ;
3190 ;----------------------------
3200 ADJUST
3210 PHA
3220 AND #$80
3230 STA ADJUST.BIT
3240 PLA
3250 AND #$7F
3260 ;
3270 CMP #32 ;less than 32?
3280 BCS AJ1 ;Branch if not.
3290 ;
3300 ADC #64 ;Else add 64
3310 BCC AJX ;and split.
3320 AJ1
3330 CMP #96 ;Is char >=96?
3340 BCS AJX ;branch if yes
3350 ;
3360 SEC ;Else 31>chr<96
3370 SBC #32
3380 AJX
3390 ORA ADJUST.BIT
3400 RTS
3410 ;
3420 ADJUST.BIT
3430 .BYTE 0
3440 ;
3450 ;------------------------
3460 FIX.LBUFF
3470 LDY #$FF
3480 FX1
3490 INY
3500 LDA (INBUFF),Y
3510 BPL FX1
3520 ;
3530 AND #$7F
3540 STA (INBUFF),Y
3550 INY
3560 LDA #0
3570 STA (INBUFF),Y
3580 RTS
3590 ;
3600 ;------------------------
3610 WORK.WINDOW
3620 ;Set to print in reverse...
3630 ;...and make FR0/CIX zero.
3640 LDA #$80
3650 STA REVERSE.FLAG
3660 LEA.W 0,FR0
3670 MOVE.B FR0,CIX
3680 ;
3690 ;We print the value in ERRSAVE
3700 MOVE.B ERRSAVE,FR0
3710 ;
3720 ;Integer to float...
3730 ;...Float to ATASCII.
3740 ;Place zero on end, print it.
3750 JSR IFP
3760 JSR FASC
3770 JSR FIX.LBUFF
3780 LEA.W LBUFF,POINTER.A
3790 MOVE.W E.SCREEN,POINTER.B
3800 JSR WIND.LINE.OUT
3810 ;
3820 ;Ditto with the value in STOPLN
3830 MOVE.W STOPLN,FR0
3840 LDA #0
3850 STA CIX
3860 JSR IFP
3870 JSR FASC
3880 JSR FIX.LBUFF
3890 LEA.W LBUFF,POINTER.A
3900 MOVE.W L.SCREEN,POINTER.B
3910 JSR WIND.LINE.OUT
3920 ;
3930 ;- - - - - - - - - - - - - - -
3940 ;Now, to pick up proper error
3950 ;text string, first get error
3960 ;number, and compare it against
3970 ;each entry in a table of known
3980 ;error codes.
3990 ;
4000 LDA ERRSAVE
4010 LDX #NUM.ERR.ENTRIES-1
4020 WW1
4030 CMP ERROR.TABLE,X ;match?
4040 BEQ WW2 ;branch on match
4050 ;
4060 DEX ;else next
4070 BPL WW1 ;until finis.
4080 LDX #43 ;NO MATCH
4090 WW2
4100 ;At this point, a match was
4110 ;found in the table, and the
4120 ;X register contains the number
4130 ;of the error entry.
4140 TXA
4150 ASL A ;pointerize it.
4160 TAX
4170 ;
4180 ;Now pick up the address of the
4190 ;coresponding error string and
4200 ;place inside POINTER.A
4210 ;Then print the string out.
4220 LDA ERROR.JUMP,X
4230 STA POINTER.A
4240 LDA ERROR.JUMP+1,X
4250 STA POINTER.A+1
4260 MOVE.W R.SCREEN,POINTER.B
4270 JSR WIND.LINE.OUT
4280 WWX
4290 RTS
4300 ;
4310 ;----------------------------
4320 WIND.LINE.OUT
4330 LDY #0
4340 WL1
4350 LDA (POINTER.A),Y
4360 BEQ WLX
4370 ;
4380 JSR ADJUST
4390 ORA REVERSE.FLAG
4400 STA (POINTER.B),Y
4410 INY
4420 BNE WL1
4430 WLX
4440 RTS
4450 ;
4460 REVERSE.FLAG
4470 .BYTE 0
4480 ;
4490 ;---------------------------
4500 ;A Table of all known error
4510 ;code numbers. Searched top down
4520 ;
4530 ERROR.TABLE
4540 .BYTE 2,3,4,5,6
4550 .BYTE 7,8,9,10,11
4560 .BYTE 12,13,14,15,16
4570 .BYTE 17,18,19,20,21
4580 ;
4590 .BYTE 128,129,130,131,132
4600 .BYTE 133,134,135,136,137
4610 .BYTE 138,139,140,141,142
4620 .BYTE 143,144,145,146,147
4630 ;
4640 .BYTE 160,161,162,163,164
4650 .BYTE 165,166,167,168,169
4660 .BYTE 170,171
4670 NUM.ERR.ENTRIES = *-ERROR.TABLE
4680 ;
4690 ;A table of all known error
4700 ;message addresses, in the same
4710 ;order as the table above.
4720 ;
4730 ERROR.JUMP
4740 .WORD E2,E3,E4,E5
4750 .WORD E6,E7,E8,E9
4760 .WORD E10,E11,E12
4770 .WORD E13,E14,E15
4780 .WORD E16,E17,E18
4790 .WORD E19,E20,E21
4800 ;
4810 .WORD E128,E129,E130
4820 .WORD E131,E132,E133
4830 .WORD E134,E135,E136
4840 .WORD E137,E138,E139
4850 .WORD E140,E141,E142
4860 .WORD E143,E144,E145
4870 .WORD E146,E147
4880 ;
4890 .WORD E160,E161,E162
4900 .WORD E163,E164,E165
4910 .WORD E166,E167,E168
4920 .WORD E169,E170,E171
4930 ;
4940 ;----------------------------
4950 ;The error messages themselves.
4960 ;
4970 E2 .BYTE "OUT OF MEMORY",0
4980 E3 .BYTE "VALUE ERROR",0
4990 E4 .BYTE "TOO MANY VARIABLES",0
5000 E5 .BYTE "STRING TOO LONG",0
5010 E6 .BYTE "END OF DATA",0
5020 E7 .BYTE "NUMBER TOO LARGE",0
5030 E8 .BYTE "TYPE MISMATCH",0
5040 E9 .BYTE "ARRAY DIMENSION",0
5050 E10 .BYTE "ARG STACK OVERFLOW",0
5060 E11 .BYTE "DIVIDE BY ZERO",0
5070 E12 .BYTE "LINE NOT FOUND",0
5080 E13 .BYTE "NEXT WITHOUT FOR",0
5090 E14 .BYTE "LINE TOO LONG",0
5100 E15 .BYTE "TARGET DELETED",0
5110 E16 .BYTE "RETURN TO WHERE?",0
5120 E17 .BYTE "GARBAGE IN CODE",0
5130 E18 .BYTE "NOT NUMERIC",0
5140 E19 .BYTE "PROGRAM TOO BIG",0
5150 E20 .BYTE "BAD CHANNEL #",0
5160 E21 .BYTE "NOT LOAD FORMAT",0
5170 ;
5180 E128 .BYTE "BREAK ABORT",0
5190 E129 .BYTE "CHANNEL IS OPEN",0
5200 E130 .BYTE "UNKNOWN DEVICE",0
5210 E131 .BYTE "OUTPUT ONLY",0
5220 E132 .BYTE "XIO SYNTAX ERROR",0
5230 E133 .BYTE "CHANNEL NOT OPEN",0
5240 E134 .BYTE "UNKNOWN CHANNEL",0
5250 E135 .BYTE "INPUT ONLY",0
5260 E136 .BYTE "END OF FILE",0
5270 E137 .BYTE "RECORD TRUNCATED",0
5280 E138 .BYTE "DEVICE TIMEOUT",0
5290 E139 .BYTE "COMMAND REFUSED",0
5300 E140 .BYTE "FRAMING ERROR",0
5310 E141 .BYTE "OUT OF RANGE",0
5320 E142 .BYTE "FRAME OVERRUN",0
5330 E143 .BYTE "FRAME CHECKSUM",0
5340 E144 .BYTE "DISK ERROR",0
5350 E145 .BYTE "COMPARE ERROR",0
5360 E146 .BYTE "NOT IMPLEMENTED",0
5370 E147 .BYTE "NOT ENOUGH RAM",0
5380 ;
5390 E160 .BYTE "DRIVE NUMBER",0
5400 E161 .BYTE "TOO MANY FILES",0
5410 E162 .BYTE "DISK FULL",0
5420 E163 .BYTE "UNKNOWN ERROR",0
5430 E164 .BYTE "FILE MISMATCH",0
5440 E165 .BYTE "BAD FILE NAME",0
5450 E166 .BYTE "POINT ERROR",0
5460 E167 .BYTE "FILE LOCKED",0
5470 E168 .BYTE "UNKNOWN XIO",0
5480 E169 .BYTE "DIRECTORY FULL",0
5490 E170 .BYTE "FILE NOT FOUND",0
5500 E171 .BYTE "POINT INVALID",0
Back to previous page