10
20
30
40
50
60
70
80
90
100 PROCinit
110 PROCassemble
120 A$="*SAVE xsum "+STR$~mcode%+" "+STR$~O%+" "+STR$~exec%+" "+STR$~load%
130 IFwarn%:P%=&480:P%=FNwarn ELSE PRINTA$;:OSCLIA$:PRINT
140 END
150 DEFPROCinit
160 DIM mcode% &400
170 load%=&404
180 warn%=0
190 osargs=&FFDA
200 osnewl=&FFE7
210 oswrch=&FFEE
220 osword=&FFF1
230 osbyte=&FFF4
240 rem=&F4
250 prnt_on=2
260 prntoff=3
270 return=13
280 page_on=14
290 pageoff=15
300 space=32
310 quotes=ASC""""
320 colon=ASC":"
330 comma=ASC","
340 lbrk=ASC"["
350 rbrk=ASC"]"
360 mcom=ASC"\"
370 startln=&60
380 endline=&62
390 linecrc=&70
400 overcrc=&72
410 workcrc=&74
420 lineptr=&76
430 crc_ptr=&78
440 linenum=&7A
450 linelen=&7C
460 linetmp=&7D
470 txt_ptr=&7E
480 nm_base=&80
490 lo_numb=&81
500 hi_numb=&82
510 lo_work=&83
520 hi_work=&84
530 quotflg=&85
540 codeflg=&86
550 savebyt=&87
560 fldsize=&88
570 zeroflg=&89
580 lineend=&8A
590 prnting=&8B
600 pageing=&8C
610 esc_flg=&FF
620 ENDPROC
630 DEFPROCassemble
640 FOR L%=4 TO 7 STEP 3
650 P%=load%:O%=mcode%
660 [OPT L%
670 .exec%
680 JMP check:BRK:BRK:BRK \ Header identifies
690 EQUB &42:EQUB copy-exec% \ this as 6502 code
700 EQUB &10:EQUS "xsum"
710 EQUB &00:EQUS "1.10 (15 Feb 1990)"
720 .copy
730 EQUB 0:EQUS"(C)":EQUB 0
740
750 \ Code to read parameters in variable area
760 \ Later overwritten on exit
770 .read_params
780 LDA #1
790 LDY #0
800 LDX #txt_ptr
810 JSR osargs
820 JSR rdspcs
830 BEQ xparams
840 CMP #ASC"P"
850 BEQ setprint
860 CMP #ASC"p"
870 BNE try_num
880 .setprint
890 DEC prnting
900 JSR rdspcs
910 BEQ xparams
920 .try_num
930 CMP #comma
940 BEQ try_num2
950 JSR getnum
960 STX startln+0
970 STY startln+1
980 CMP #return
990 BNE try_comma
1000 STX endline
1010 STY endline+1
1020 RTS
1030 .bad_pm
1040 LDA txt_ptr+1
1050 CMP #8
1060 BCC xparams
1070 OPT FNwarn
1080 JSR way_out
1090 BRK:EQUB 252:EQUS "Bad parameter":BRK
1100 OPT FNwarn
1110 .try_comma
1120 CMP #comma
1130 BNE bad_pm
1140 .try_num2
1150 JSR rdspcs
1160 BEQ xparams
1170 JSR getnum
1180 STX endline
1190 STY endline+1
1200 CMP #return
1210 BEQ xparams
1220 CMP #space
1230 BNE bad_pm
1240 JSR rdspcs
1250 BNE bad_pm
1260 .xparams
1270 RTS
1280 .rdspcs
1290 JSR getch
1300 CMP #space
1310 BEQ rdspcs
1320 CMP #return
1330 RTS
1340 .getch
1350 TXA
1360 PHA
1370 TYA
1380 PHA
1390 LDX #txt_ptr MOD256
1400 LDY #txt_ptr DIV256
1410 LDA #5
1420 JSR osword
1430 INC txt_ptr
1440 BNE no_carry
1450 INC txt_ptr+1
1460 .no_carry
1470 PLA
1480 TAY
1490 PLA
1500 TAX
1510 LDA txt_ptr+4
1520 CMP #return
1530 RTS
1540 .getnum
1550 PHA
1560 LDA #0
1570 STA lo_work
1580 STA hi_work
1590 PLA
1600 .num_lp
1610 CMP #ASC"9"+1
1620 BCS num_exit
1630 CMP #ASC"0"
1640 BCC num_exit
1650 SBC #ASC"0"
1660 JSR times10
1670 CLC
1680 ADC lo_work
1690 STA lo_work
1700 LDA hi_work
1710 ADC #0
1720 STA hi_work
1730 JSR getch
1740 JMP num_lp
1750 .num_exit
1760 LDX lo_work
1770 LDY hi_work
1780 BMI num_err
1790 CMP #space
1800 BNE num_x
1810 JSR rdspcs
1820 .num_x
1830 RTS
1840 .times10
1850 PHA
1860 LDA lo_work
1870 ASL A
1880 ROL hi_work
1890 TAX
1900 LDY hi_work
1910 ASL A
1920 ROL hi_work
1930 ASL A
1940 ROL hi_work
1950 STA lo_work
1960 CLC
1970 TXA
1980 ADC lo_work
1990 STA lo_work
2000 TYA
2010 ADC hi_work
2020 STA hi_work
2030 PLA
2040 RTS
2050
2060 .rdbyte
2070 LDX #0:LDY #255:JSR osbyte:TXA:AND #63
2080 .ok
2090 RTS
2100 .checkbasic
2110 LDA #187:JSR rdbyte:STA lineptr
2120 LDA #252:JSR rdbyte:CMP lineptr:BEQ ok
2130 BRK:EQUB 249:EQUS "Not in BASIC":BRK
2140
2150 .num_err
2160 OPT FNwarn
2170 JSR way_out
2180 BRK:EQUB 252:EQUS "Bad number":BRK
2190 OPT FNwarn
2200
2210 .check
2220 JSR checkbasic
2230 LDA #0
2240 STA overcrc+0
2250 STA overcrc+1
2260 STA startln+0
2270 STA startln+1
2280 STA codeflg
2290 STA prnting
2300 STA lineptr+0
2310 LDA &18
2320 STA lineptr+1
2330 LDA #&7F
2340 STA endline+1
2350 LDA #&FF
2360 STA endline
2370 JSR read_params
2380 BIT prnting
2390 BMI start
2400 LDA #page_on
2410 JSR oswrch
2420 .start
2430 .while
2440 BIT esc_flg
2450 BMI escape
2460 LDY #1
2470 LDA (lineptr),Y
2480 BPL do_line
2490 .way_out
2500 LDA #end AND 255:STA &0B
2510 LDA #end DIV 256:STA &0C
2520 LDA #0:STA &0A :\ ptra=><cr><endmarker>
2530 LDX #&7F
2540 .clear_lp
2550 OPT FNwarn
2560 STA &480,X
2570 DEX:BMI clear_lp :\ Clear variables
2580 LDA &00:STA &02
2590 LDA &01:STA &03 :\ VARTOP=LOMEM
2600 LDA #prntoff
2610 JSR oswrch
2620 LDA #pageoff
2630 JMP oswrch
2640 .end
2650 EQUB 13:EQUB &FF :\ <cr><endmarker>
2660 .escape
2670 JSR way_out
2680 BRK:EQUB 17:EQUS "Escape":BRK
2690 .bad
2700 JSR way_out
2710 BRK:EQUB 0:EQUS "Bad program":BRK
2720 OPT FNwarn
2730 .do_line
2740 LDA #0
2750 STA linecrc+0
2760 STA linecrc+1
2770 STA quotflg
2780 TAY
2790 LDA (lineptr),Y
2800 CMP #&0D
2810 BNE bad
2820 INY
2830 LDA (lineptr),Y
2840 STA linenum+1
2850 INY
2860 LDA (lineptr),Y
2870 STA linenum+0
2880 INY
2890 LDA (lineptr),Y
2900 STA lineend
2910 JSR pre_scan
2920 CPY #5
2930 BCC display
2940 LDY #4
2950 .skip_space
2960 LDA (lineptr),Y
2970 CMP #space
2980 BNE scan_line
2990 INY
3000 CPY linelen
3010 BEQ display
3020 BNE skip_space
3030 .scan_line
3040 LDA (lineptr),Y
3050 JSR do_byte
3060 INY
3070 CPY linelen
3080 BCC scan_line
3090 .display
3100 LDA linenum+1
3110 CMP startln+1
3120 BCC update
3130 BNE chk_high
3140 LDA linenum
3150 CMP startln
3160 BCC update
3170 .chk_high
3180 LDA linenum+1
3190 CMP endline+1
3200 BCC skip_it
3210 BNE update
3220 LDA linenum
3230 CMP endline
3240 BCC skip_it
3250 BNE update
3260 .skip_it
3270 BIT prnting
3280 BPL no_prn1
3290 LDA #prnt_on
3300 JSR oswrch
3310 .no_prn1
3320 LDX linenum
3330 LDY linenum+1
3340 JSR prnt_dec
3350 LDA #space
3360 JSR oswrch
3370 LDA #ASC"="
3380 JSR oswrch
3390 LDA #space
3400 JSR oswrch
3410 LDX linecrc
3420 LDY linecrc+1
3430 JSR prnt_hex
3440 LDA overcrc
3450 JSR last_chk
3460 LDY linelen
3470 CPY lineend
3480 BEQ newline
3490 LDA #ASC"*"
3500 JSR oswrch
3510 .newline
3520 JSR osnewl
3530 BIT prnting
3540 BPL update
3550 LDA #prntoff
3560 JSR oswrch
3570 .update
3580 CLC
3590 LDA lineptr
3600 ADC lineend
3610 STA lineptr
3620 BCC unwhile
3630 INC lineptr+1
3640 .unwhile
3650 JMP while
3660
3670 .pre_scan
3680 LDY lineend
3690 .ps_loop
3700 DEY
3710 LDA (lineptr),Y
3720 CMP #32
3730 BEQ ps_loop
3740 INY
3750 STY linelen
3760 RTS
3770 .do_byte
3780 STA savebyt
3790 CMP #quotes
3800 BNE notquote
3810 PHA
3820 LDA quotflg
3830 EOR #&FF
3840 STA quotflg
3850 PLA
3860 .notquote
3870 BIT quotflg
3880 BMI skpcode
3890 BIT codeflg
3900 BMI j_code
3910 JSR basic
3920 JMP skpcode
3930 .j_code
3940 JSR mcode
3950 .skpcode
3960 LDA savebyt
3970 CPY linelen
3980 BEQ skipcrc
3990 STY linetmp
4000 LDX linecrc
4010 LDY linecrc+1
4020 JSR do_crc
4030 STX linecrc
4040 STY linecrc+1
4050 LDX overcrc
4060 LDY overcrc+1
4070 JSR do_crc
4080 STX overcrc
4090 STY overcrc+1
4100 LDY linetmp
4110 .skipcrc
4120 RTS
4130 .basic
4140 CMP #rem
4150 BEQ skpline
4160 CMP #lbrk
4170 BNE xbasic
4180 LDA #&FF
4190 STA codeflg
4200 RTS
4210 .skpline
4220 LDY linelen
4230 .xbasic
4240 RTS
4250 .mcode
4260 CMP #mcom
4270 BEQ skipcom
4280 CMP #rbrk
4290 BNE xmcode
4300 LDA #0
4310 STA codeflg
4320 .xmcode
4330 RTS
4340 .skipcom
4350 LDA quotflg
4360 PHA
4370 LDA #0
4380 STA quotflg
4390 .skploop
4400 INY
4410 LDA (lineptr),Y
4420 CMP #quotes
4430 BNE skpchk
4440 PHA
4450 LDA quotflg
4460 EOR #&FF
4470 STA quotflg
4480 PLA
4490 .skpchk
4500 CPY linelen
4510 BEQ skpexit
4520 CMP #colon
4530 BNE skploop
4540 BIT quotflg
4550 BMI skploop
4560 .skpexit
4570 PLA
4580 STA quotflg
4590 LDA (lineptr),Y
4600 STA savebyt
4610 RTS
4620 .do_crc
4630 PHA
4640 STX workcrc
4650 STY workcrc+1
4660 EOR workcrc+1
4670 STA workcrc+1
4680 LDX #7
4690 .crc_lp
4700 BIT workcrc+1
4710 CLC
4720 BPL crc_skp
4730 LDA workcrc
4740 EOR #&10
4750 STA workcrc
4760 LDA workcrc+1
4770 EOR #&08
4780 STA workcrc+1
4790 SEC
4800 .crc_skp
4810 ROL workcrc
4820 ROL workcrc+1
4830 DEX
4840 BPL crc_lp
4850 LDX workcrc
4860 LDY workcrc+1
4870 PLA
4880 RTS
4890 .last_chk
4900 PHA
4910 LDA #32
4920 JSR oswrch
4930 PLA
4940 AND #&0F
4950 TAX
4960 LDA #&FF
4970 PHA
4980 TXA
4990 JMP notzero
5000 .prnt_dec
5010 LDA #10
5020 BNE prnt_num
5030 .prnt_hex
5040 LDA #16
5050 .prnt_num
5060 STX lo_numb
5070 STY hi_numb
5080 STA nm_base
5090 LDA #4
5100 STA fldsize
5110 LDA #255
5120 STA zeroflg
5130 .nbit
5140 PHA
5150 LDA #0
5160 STA lo_work
5170 STA hi_work
5180 LDX #16
5190 .next
5200 ASL lo_numb
5210 ROL hi_numb
5220 ROL lo_work
5230 ROL hi_work
5240 LDA lo_work
5250 SEC
5260 SBC nm_base
5270 TAY
5280 LDA hi_work
5290 SBC #0
5300 BCC done
5310 INC lo_numb
5320 STY lo_work
5330 STA hi_work
5340 .done
5350 DEX
5360 BNE next
5370 LDA lo_work
5380 DEC fldsize
5390 BNE nbit
5400 .out
5410 TAX
5420 BNE notzero
5430 PLA
5440 PHA
5450 PHP
5460 TXA
5470 PLP
5480 BMI notzero
5490 BIT zeroflg
5500 BPL notzero
5510 LDA #32
5520 BNE dig_out
5530 .notzero
5540 LDX #0
5550 STX zeroflg
5560 CMP #10
5570 BCC add
5580 ADC #6
5590 .add
5600 ADC #48
5610 .dig_out
5620 JSR oswrch
5630 PLA
5640 BPL out
5650 .exit
5660 RTS
5670 ]:NEXT
5680 ENDPROC
5690 DEFFNwarn:IFL%AND3:IFP%>&47F:IFP%<&500:PRINT"**** Warning: code overwritten on exit":warn%=warn%+1
5700 =L%