20 REM SNAPSHOT
   40 REM A.K. 11/6/86
   50 REM PALO004 Generates own imposter
   60 REM Has Eclipse parser less get_string
   80  
  100 osfile=&FFDD
  120 oswrch=&FFEE
  140 osbyte=&FFF4
  160 osnewl=&FFE7
  180 osasci=&FFE3
  185 gsread=&FFC5
  190 gsinit=&FFC2
  200  
  220  
  240 FOR pass=4 TO 7 STEP 3
  260 P%=&8000
  280 O%=&4000
  300 [
  320 OPT pass
  340 .lang EQUB 0
  360 EQUW 0
  380  
  400 .serv JMP enter
  420 .rom EQUB &82
  440 .offset EQUB copy-&8000
  460 .title EQUS "Snapshot"
  480 .copy EQUB 0
  500 EQUS "(C)"
  520 .mess EQUS "Allan"
  540 EQUB 0
  560 EQUD 0
  580 EQUD 0
  600  
  620 .enter CMP#5
  640 BEQ interbr
  660 CMP#9
  680 BEQ help
  700 CMP#4
  720 BEQ parse
  730 CMP#&FE
  735 BEQ stop
  740 RTS
  750 .stop LDA#0
  751 STA repeat_flag
  752 LDA#&FE
  753 RTS
  760 .interbr JMP inter
  780 .help \ *help message
  800 PHA
  820 TXA
  840 PHA
  860 TYA
  880 PHA
  900 LDX#dark MOD 256
  920 LDY#dark DIV 256
  940 JSR display
  960 PLA
  980 TAY
 1000 PLA
 1020 TAX
 1040 PLA
 1060 RTS
 1080  
 1120 .display \ X & Y piont to message
 1140 \ X lb, Y HB, mess end with 0
 1160 STX&70
 1180 STY&71
 1200 LDY#0
 1220 .dback LDA(&70),Y
 1240 JSR osasci
 1260 INY
 1280 CMP#0
 1300 BNE dback
 1320 RTS
 1500  
 1510 .parse STY sy \ mask for P \ desgned for ROMs Service call 4 to here
 1520 LDA(&F2),Y
 1530 ORA#&20
 1540 CMP#ASC"p"
 1550 BNE pfo1
 1560 INY
 1570 .pfo1 STY sy+1
 1580 LDX#0 \ count through coms
 1590 STX count
 1600 .pba5 LDY sy+1
 1610 .pba1 LDA(&F2),Y
 1620 ORA#&20
 1630 CMP comms,X
 1640 BNE next_com
 1650 CMP#&20
 1660 BEQ end_com
 1670 CMP#&2D
 1680 BEQ end_com
 1690 INX
 1700 INY
 1710 JMP pba1
 1720 .next_com LDA comms,X
 1730 CMP#&FF
 1740 BEQ bad_com
 1750 CMP#&2D
 1760 BEQ upto_next_com
 1770 CMP#&20
 1780 BEQ upto_next_com
 1790 INX
 1800 JMP next_com
 1810 .upto_next_com INX
 1820 INC count
 1830 JMP pba5
 1840 .end_com LDA count
 1850 ASL A
 1860 TAX
 1870 LDA com_addr,X
 1880 STA jump
 1890 LDA com_addr+1,X
 1900 STA jump+1
 1910 JMP(jump)
 1920 .bad_com LDY sy \ it's not for me
 1930 LDA#4
 1940 RTS
 1950  
 1960 .syntax \ an error has occured issue error &DC
 1970 LDY#0
 1980 STY&100
 1990 .pba2 LDA errorDC,Y
 2000 STA&101,Y
 2010 INY
 2020 CMP#0
 2030 BNE pba2
 2040 JMP&100
 2050  
 2060 .asc_hex SEC
 2070 SBC#&30
 2080 CMP#9
 2090 BMI pfo2
 2100 SEC
 2110 SBC#7
 2120 .pfo2 CMP#0
 2130 BMI syntax
 2140 RTS
 2150 .cli_two_asc_hex \ convert 2 ascii chars in a cli to hex in A
 2160 .pba3 INY \ Y is offset
 2170 BEQ syntax
 2180 LDA(&F2),Y
 2190 CMP#&D
 2200 JSR valid_asc
 2210 BCS pba3
 2220 .pfo3 JSR asc_hex
 2230 STA sa
 2240 INY
 2250 LDA(&F2),Y
 2260 INY
 2270 CMP#&D
 2280 BEQ was
 2290 CMP#&20
 2300 BEQ was
 2310 JSR valid_asc
 2320 BCS syntax
 2330 BEQ was
 2340 ASL sa
 2350 ASL sa
 2360 ASL sa
 2370 ASL sa
 2380 JSR asc_hex
 2390 ORA sa
 2400 RTS
 2410 .was LDA sa
 2420 RTS
 2430  
 2440 .valid_asc \ check is A(asc) is valid in hex C=0 ok,C=1 no
 2450 CMP#&30
 2460 BMI pset
 2470 CMP#&47
 2480 BCS pset
 2490 CMP#&3A
 2500 BMI pclear
 2510 CMP#&40
 2520 BMI pset
 2530 .pclear CLC
 2540 RTS
 2550 .pset SEC
 2560 RTS
 2690  
 2900 .prepear \ get an imposter
 2901 LDA#&FF
 2902 STA got_imposter
 2910 \ put at &AC00 up
 2920 SEI
 2930 LDY#0
 2940 .back LDA 0,Y
 2950 STA&AC00,Y
 2960 INY
 2970 CPY#0
 2980 BNE back
 2990 LDA#0
 3000 STA&70
 3010 STA&72
 3020 LDA#1
 3030 STA&71
 3040 LDA#&AD
 3050 STA&73
 3060 LDY#0
 3070 .back2 LDA(&70),Y
 3080 STA(&72),Y
 3090 INY
 3100 CPY#0
 3110 BNE back2
 3120 INC&71
 3130 INC&73
 3140 LDA&73
 3150 CMP#&C0
 3160 BNE back2
 3170 CLI
 3180 LDA#7
 3190 JSR oswrch
 3200 LDA#0
 3210 RTS
 3220  
 3300 .get \ bring oldboy up
 3310 LDY#0
 3320 .back1 LDA0,Y
 3330 STA&8A00,Y
 3340 INY
 3350 BNE back1
 3360 LDA#0
 3370 STA&70
 3380 STA&72
 3390 LDA#1
 3400 STA&71
 3410 LDA#&8B
 3420 STA&73
 3430 .back2 LDY#0
 3440 .back3 LDA(&70),Y
 3450 STA(&72),Y
 3460 INY
 3470 BNE back3
 3480 INC&71
 3490 INC&73
 3500 LDA&71
 3510 CMP#&15
 3520 BNE back2
 3530  
 3540 \ Send in the imposter stored at &AC00 to &C000
 3550 LDA#0
 3560 STA&70
 3570 STA&72
 3580 LDA#1
 3590 STA&71
 3600 LDA#&AD
 3610 STA&73
 3620  
 3630 .back5 LDY#0
 3640 .back6 LDA(&72),Y
 3650 STA(&70),Y
 3660 INY
 3670 BNE back6
 3680 INC&71
 3690 INC&73
 3700 LDA&71
 3710 CMP#&14
 3720 BNE back5
 3730 LDY#0
 3740 .back7 LDA&AC00,Y
 3750 STA0,Y
 3760 INY
 3770 BNE back7
 3780  
 3790 LDY#0 \ copy OSFILE control block
 3800 .back4 LDA data,Y
 3810 STA&7E0,Y
 3820 INY
 3830 CPY#&1A
 3840 BNE back4
 3850 CLI \ interupts on
 3860 JSR save
 3870 SEI \ interupts off
 3880  
 3890 LDA#0
 3900 STA&70
 3910 STA&72
 3920 LDA#&30
 3930 STA&71
 3940 LDA#&8A
 3950 STA&73
 3960 .back8 LDY#0
 3970 .back9 LDA(&72),Y
 3980 STA(&70),Y
 3990 INY
 4000 BNE back9
 4010 INC&71
 4020 INC&73
 4030 LDA&73
 4040 CMP#&9F
 4050 BNE back8
 4060  
 4070 LDA ss
 4080 STA&4508
 4090  
 4100 LDY#0
 4110 .backA LDA data2,Y
 4120 STA&7E0,Y
 4130 INY
 4140 CPY#&1A
 4150 BNE backA
 4160 CLI
 4170 JSR save
 4180 LDA#0
 4190 JMP put_plus
 4300  
 4310 .put \ Disc data into memory
 4320 LDY#0 \ load Oldboy
 4330 .gback1 LDA data3,Y
 4340 STA&7E0,Y
 4350 INY
 4360 CPY#&1A
 4370 BNE gback1
 4380 JSR load
 4390  
 4400 .put_plus LDA#0 \ Oldboy coming up
 4410 STA&70
 4420 STA&72
 4430 LDA#&30
 4440 STA&71
 4450 LDA#&8A
 4460 STA&73
 4470 LDY#0
 4480 .gback2 LDA(&70),Y
 4490 STA(&72),Y
 4500 INY
 4510 CPY#0
 4520 BNE gback2
 4530 INC&71
 4540 INC&73
 4550 LDA&71
 4560 CMP#&45
 4570 BNE gback2
 4580  
 4590 LDA&4508 \ Oldboy carries stack pointer
 4600 STA ss
 4610 LDA#22 \ correct mode
 4620 JSR oswrch
 4630 LDA&3355
 4640 STA mode
 4650 JSR oswrch
 4660  
 4670 LDY#0 \ bring in POT
 4680 .gback3 LDA data4,Y
 4690 STA&7E0,Y
 4700 INY
 4710 CPY#&1A
 4720 BNE gback3
 4730 JSR load
 4740  
 4750 \ interupts off
 4760 SEI
 4770 LDA#0 \ send Oldboy home excepy Z
 4780 STA&70
 4790 STA&72
 4800 LDA#&8B
 4810 STA&71
 4820 LDA#&1
 4830 STA&73
 4840 LDY#0
 4850 .gback5 LDA(&70),Y
 4860 STA(&72),Y
 4870 INY
 4880 BNE gback5
 4890 INC&71
 4900 INC&73
 4910 LDA&71
 4920 CMP#&9F
 4930 BNE gback5
 4940  
 4950 LDY#0 \ send z page home
 4960 .gback6 LDA&8A00,Y
 4970 STA 0,Y
 4980 INY
 4990 BNE gback6
 5000  
 5010 LDX mode
 5020 CPX#7
 5030 BNE other
 5040 LDA#13 \ only mode 7
 5050 STA&FE00
 5060 LDA&350
 5070 STA&FE01
 5080 LDA#12
 5090 STA&FE00
 5100 LDA&351
 5110 SEC
 5120 SBC#&74
 5130 EOR#&20
 5140 STA&FE01
 5150 .gback7 \ impersonate an IRQ2 return
 5160 LDX ss
 5170 TXS
 5171 LDA repeat_flag
 5172 CMP#&FF
 5173 BNE no_repeat
 5174 JMP set_inter
 5180 .no_repeat LDA#0
 5190 CLI \ interupts
 5200 RTS
 5210 .other LDA#&D
 5220 STA&FE00
 5230 LDA&350
 5240 LSR A
 5245 LSR A
 5250 LSR A
 5260 STA&FE01
 5270 LDA#&C
 5280 STA&FE00
 5290 LDA&351
 5300 LSR A
 5305 LSR A
 5310 LSR A
 5320 STA&FE01
 5330 JMP gback7
 5490  
 5500 .wait JSR cli_two_asc_hex
 5505 STA waiting
 5506 .set_inter LDA#0
 5510 STA tim+1
 5520 JMP timer
 5530 .inter \ service interupt
 5540 LDA#&40
 5550 STA&FE6D
 5560 LDA tim
 5570 CLC
 5580 ADC#1
 5590 STA tim
 5600 LDA tim+1
 5610 ADC#0
 5620 STA tim+1
 5630 CMP waiting
 5640 BEQ show
 5650 .timer LDA#&FF
 5660 STA&FE64
 5670 STA&FE65
 5680 LDA#&C0
 5690 STA&FE6E
 5700 LDA#0
 5710 CLI
 5720 RTS
 5730 .show TSX
 5740 STX ss
 5750 JMP get
 5760  
 5800 .now LDA got_imposter \ check that we have an imposter
 5801 CMP#&FF
 5802 BNE do_not
 5805 JMP show
 5822 .do_not LDA#7
 5824 JSR oswrch
 5826 LDA#0
 5828 RTS
 5830  
 5840 .restore JMP put
 5850  
 5860 .repeat LDA#&FF
 5870 STA repeat_flag
 5880 LDA#0
 5890 RTS
 8000 .save LDA#0
 8010 LDX#&E0
 8020 LDY#&7
 8030 JMP osfile
 8040 .load LDA#&FF
 8050 LDX#&E0
 8060 LDY#&7
 8070 JMP osfile
 8800  
 8850 .repeat_flag BRK
 8860 .waiting BRK
 8870 .got_imposter BRK
 8880 .tim EQUW0
 8890 .mode BRK
 8900 .ss BRK
 8910 .sa BRK:BRK
 8930 .sy BRK:BRK
 8950 .sx BRK:BRK
 8970 .count EQUB0
 8980 .jump EQUW0
 8990 .comms EQUS"now"
 9020 EQUB&2D
 9030 EQUS"ready"
 9040 EQUB&2D
 9050 EQUS"restore"
 9060 EQUB&2D
 9070 EQUS"wait"
 9080 EQUB&20
 9090 EQUS"repeat"
 9100 EQUB&2D
 9121 EQUB&FF
 9130 .com_addr EQUW now
 9140 EQUW prepear
 9150 EQUW restore
 9170 EQUW wait
 9180 EQUW repeat
 9800 .errorDC EQUB&DC
 9810 EQUS"Syntax error from Dark"
 9820 BRK
 9830 .dark EQUB&D
 9835 EQUS"Dark Side of the RAM bays"
 9836 EQUW&D0A:EQUS"Snapshot version Palo 4.1"
 9837 EQUW&D0A:EQUS"Ready, Wait, Repeat, Restore, Now"
 9838 EQUW&D0A
 9840 BRK
 9850 .data EQUW&7F3
 9852 EQUD&1400
 9854 EQUD&1400
 9856 EQUD&1400
 9858 EQUD&8000
 9860 EQUB0
 9862 EQUS"POT"
 9864 EQUB&D
 9870 .data2 EQUW&7F3
 9872 EQUD0
 9874 EQUD0
 9876 EQUD&3000
 9878 EQUD&4510
 9880 EQUB0
 9882 EQUS"OLDBOY"
 9884 EQUB&D
 9890 .data3 EQUW&7F3
 9892 EQUD&3000
 9894 EQUD0
 9896 EQUD0
 9898 EQUD0
 9900 EQUB0
 9902 EQUS"OLDBOY"
 9904 EQUB&D
 9910 .data4 EQUW&7F3
 9912 EQUD&1400
 9914 EQUD0
 9916 EQUD0
 9918 EQUD0
 9920 EQUB0
 9922 EQUS"POT"
 9924 EQUB&D
 9990 ]
 9992 NEXT
 9994 END