10 REM >Basic6809
   20 REM
   30 REM
   40 REM Patches BASIC V module to assemble 6809 code
   50 REM
   60 REM
   70 REM Version 1.00 (05 Nov 2009)
   80 REM by John Kortink, (c) Zeridajh 2009
   90 REM
  100 REM Version 1.0-jgh (21 Nov 2010)
  110 REM J.G.Harston - Also patches BASIC v1.05, corrected assembler error numbers
  120 REM
  130 REM
  140 REM
  150 
  160 ON ERROR PRINT "Error: ";REPORT$;" at ";ERL:END
  170 
  180 DIM Patch_Off(100)
  190 
  200 Data_Size% = 256 * 1024
  210 
  220 DIM Data% Data_Size% + 4
  230 
  240 Source% = FNwhich_source
  250 
  260 CASE Source% OF
  270   
  280     WHEN 105 : PROCdoing_105
  290     WHEN 116 : PROCdoing_116
  300     WHEN 119 : PROCdoing_119
  310     WHEN 120 : PROCdoing_120
  320     WHEN 920 : PROCdoing_120x
  330     WHEN 128 : PROCdoing_128
  340     WHEN 129 : PROCdoing_129
  350   
  360 ENDCASE
  370 
  380 PROCpatch_code
  390 
  400 PRINT "Total size ";Size%;" bytes"
  410 
  420 out_file$ = "6809_" + Which$
  430 
  440 SYS "OS_File", 10, out_file$, &FFA,, Data%, Data% + Size%
  450 
  460 PRINT '"Saved to ";out_file$'
  470 
  480 END
  490 
  500 
  510 
  520 DEFFNwhich_source
  530 
  540 LOCAL choice%
  550 LOCAL source%
  560 
  570 CLS
  580 
  590 PRINT "Possible sources:"'
  600 PRINT "1. Local RISC OS ROM"
  610 PRINT "2. RISC OS ROM image file"
  620 PRINT "3. BASIC module image file"
  630 
  640 PRINT '"Your source: ";
  650 
  660 SYS "OS_Byte", 15, 0
  670 
  680 REPEAT choice% = GET - ASC("0"):UNTIL choice% >= 1 AND choice% <= 3
  690 
  700 PRINT ;choice%'
  710 
  720 FOR A% = Data% TO Data% + Data_Size% - 1 STEP 4
  730   
  740     !A% = 0
  750   
  760 NEXT
  770 
  780 CASE choice% OF
  790   
  800     WHEN 1 : PROCsrc_local
  810     WHEN 2 : PROCsrc_riscos
  820     WHEN 3 : PROCsrc_module
  830   
  840 ENDCASE
  850 
  860 source% = 0
  870 
  880 IF source% = 0 THEN IF FNtest_module(52308, &70AD) THEN source% = 105 :REM JGH
  890 IF source% = 0 THEN IF FNtest_module(52628, &5EF2) THEN source% = 116
  900 IF source% = 0 THEN IF FNtest_module(55392, &58E4) THEN source% = 119
  910 IF source% = 0 THEN IF FNtest_module(55440, &71CA) THEN source% = 120
  920 IF source% = 0 THEN IF FNtest_module(55532, &45DF) THEN source% = 920
  930 IF source% = 0 THEN IF FNtest_module(55632, &EB77) THEN source% = 128
  940 IF source% = 0 THEN IF FNtest_module(55636, &8A16) THEN source% = 129
  950 
  960 IF source% = 0 THEN ERROR 64, "BASIC module not recognized"
  970 
  980 = source%
  990 
 1000 
 1010 
 1020 DEFPROCsrc_local
 1030 
 1040 LOCAL base%
 1050 
 1060 SYS "OS_Module", 18, "Basic" TO ,,, base%
 1070 
 1080 Size% = base%!-4 - 4
 1090 
 1100 FOR A% = 0 TO Size% - 1 STEP 4
 1110   
 1120     Data%!A% = base%!A%
 1130   
 1140 NEXT
 1150 
 1160 ENDPROC
 1170 
 1180 
 1190 
 1200 DEFPROCsrc_riscos
 1210 
 1220 LOCAL in
 1230 LOCAL riscos%
 1240 LOCAL file_name$
 1250 
 1260 INPUT "Filename: " file_name$'
 1270 
 1280 Size% = FNfile_size(file_name$)
 1290 
 1300 in = OPENIN(file_name$)
 1310 
 1320 riscos% = 0
 1330 
 1340 IF riscos% = 0 THEN IF FNtest_riscos(in, &119D54, &000000DC) THEN riscos% = 370
 1350 IF riscos% = 0 THEN IF FNtest_riscos(in, &11D7A4, &000000DC) THEN riscos% = 371
 1360 IF riscos% = 0 THEN IF FNtest_riscos(in, &18F5FC, &000000F4) THEN riscos% = 402
 1370 IF riscos% = 0 THEN IF FNtest_riscos(in, &18FFAC, &00000138) THEN riscos% = 403
 1380 
 1390 IF riscos% = 0 THEN ERROR 65, "RISC OS ROM not recognized (knows 3.70, 3.71, 4.02, 4.03)"
 1400 
 1410 PTR#in = PTR#in - 8
 1420 
 1430 SYS "OS_GBPB", 4, in, Data%, 4
 1440 
 1450 Size% = !Data% - 4
 1460 
 1470 SYS "OS_GBPB", 4, in, Data%, Size%
 1480 
 1490 CLOSE#in
 1500 
 1510 ENDPROC
 1520 
 1530 
 1540 
 1550 DEFPROCsrc_module
 1560 
 1570 LOCAL file_name$
 1580 
 1590 INPUT "Filename: " file_name$'
 1600 
 1610 Size% = FNfile_size(file_name$)
 1620 
 1630 SYS "OS_File", 16, file_name$, Data%
 1640 
 1650 ENDPROC
 1660 
 1670 
 1680 
 1690 DEFFNfile_size(file_name$)
 1700 
 1710 LOCAL size%
 1720 LOCAL object%
 1730 
 1740 SYS "OS_File", 17, file_name$ TO object% ,,,, size%
 1750 
 1760 IF object% <> 1 THEN ERROR 214, "File not found"
 1770 
 1780 = size%
 1790 
 1800 
 1810 
 1820 DEFFNtest_riscos(in, offset%, word%)
 1830 
 1840 SYS "OS_GBPB", 3, in, Data%, 4, offset%
 1850 
 1860 = (!Data% = word%)
 1870 
 1880 
 1890 
 1900 DEFFNtest_module(actual_size%, actual_crc%)
 1910 
 1920 LOCAL crc%
 1930 
 1940 SYS "OS_CRC", 0, Data%, Data% + actual_size%, 1 TO crc%
 1950 
 1960 IF crc% <> actual_crc% THEN = FALSE
 1970 
 1980 Size% = actual_size%
 1990 
 2000 = TRUE
 2010 
 2020 
 2030 
 2040 DEFPROCpatch_code
 2050 
 2060 token_AND = &80
 2070 token_EOR = &82
 2080 token_OR  = &84
 2090 
 2100 Size% = (Size% + 3) AND NOT 3
 2110 
 2120 REM
 2130 REM Change module name
 2140 REM
 2150 
 2160 FOR A%=Data% TO Data%+Size%-1
 2170     IF !A%=&49534142 AND A%?4=&43 THEN
 2180         IF A%!-4<>&20434242 AND A%?5<>ASC"$" AND A%?5<>ASC"T" AND A%?5<>ASC"." THEN
 2190             A%!1=&39303836:REM "6809"
 2200         ENDIF
 2210     ENDIF
 2220 NEXT A%
 2230 
 2240 FOR `P = %0000 TO %0010 STEP %0010
 2250   
 2260   REM
 2270   REM On TEXTLOAD, RENUMBER 1,1 instead of 10,10
 2280   REM
 2290   
 2300   PROCprime(1, &E3A0400A)
 2310   
 2320   [OPT `P
 2330   ;
 2340    MOV r4,#1
 2350    MOV r5,#1
 2360   ;
 2370   ]
 2380   
 2390   REM
 2400   REM 6809 assembler
 2410   REM
 2420   
 2430   IF Source% = 105 OR Source% = 116 THEN word% = &E28F1014 ELSE word% = &E28F103C
 2440   PROCprime(2, word%)
 2450   
 2460   [OPT `P
 2470   ;
 2480    BL patch_6809_1
 2490   ;
 2500   ]
 2510   
 2520   PROCprim4(3, &E202140F)
 2530   
 2540   [OPT `P
 2550   ;
 2560    B patch_6809_2
 2570   ;
 2580   ]
 2590   
 2600   IF Source% = 105 OR Source% = 116 THEN
 2610     
 2620     IF Source%=105 THEN Dest%=&A864
 2630     IF Source%=116 THEN Dest%=&A9A4
 2640     
 2650     P% -= 6 * 4
 2660     
 2670     [OPT `P
 2680     ;
 2690      SUB r2,r2,#&F0000000-&C0000000
 2700      BCS Data%+Dest%
 2710      ADD r11,r11,#2
 2720      CMP r2,#&F0000000
 2730      BCS P% - 4 * 4
 2740     ;
 2750     ]
 2760     
 2770     PROCprime(5, &E200000F)
 2780     
 2790     [OPT `P
 2800     ;
 2810      AND r0,r0,#%11111
 2820     ;
 2830     ]
 2840     
 2850   ENDIF
 2860   
 2870   IF Source% = 105 OR Source% = 116 THEN word% = &E35A0080 ELSE word% = &E35A007F
 2880   PROCprime(4, word%)
 2890   
 2900   [OPT `P
 2910   ;
 2920    B patch_6809_0
 2930   ;
 2940   ]
 2950   
 2960   REM
 2970   REM Other code points
 2980   REM
 2990   
 3000   PROCprim4(50, &E51830C0)
 3010   PROCprime(51, &E92D4002)
 3020   PROCprime(52, &E1A00400)
 3030   
 3040   REM
 3050   REM Extra code
 3060   REM
 3070   
 3080   P% = Data% + Size%
 3090   
 3100   [OPT `P
 3110   
 3120   
 3130   
 3140   .patch_6809_0
 3150   ;
 3160    TEQ r10,#token_OR                  ; 'Expand' tokenised mnemonics
 3170    BNE mnem_notOR
 3180    LDRB r1,[r11]
 3190    BIC r1,r1,#&20
 3200    TEQ r1,#ASC"A"
 3210    TEQNE r1,#ASC"B"
 3220    TEQNE r1,#ASC"C"
 3230    BNE mnem_notOR
 3240    SUB r11,r11,#1
 3250    CMP r1,#ASC"B"
 3260    LDRLO r0,mnem_ORA
 3270    LDREQ r0,mnem_ORB
 3280    LDRHI r0,mnem_ORC
 3290    B Data%+Patch_Off(52)
 3300   ;
 3310   .mnem_notOR
 3320   ;
 3330    TEQ r10,#token_AND
 3340    SUBEQ r11,r11,#2
 3350    LDREQ r0,mnem_AND
 3360    BEQ Data%+Patch_Off(52)
 3370   ;
 3380    TEQ r10,#token_EOR
 3390    SUBEQ r11,r11,#2
 3400    LDREQ r0,mnem_EOR
 3410    BEQ Data%+Patch_Off(52)
 3420   ;
 3430    BIC r0,r10,#&20                    ; Skip 'L' for all 'LBxx'
 3440    TEQ r0,#ASC"L"
 3450    LDREQB r0,[r11,#0]
 3460    BICEQ r0,r0,#&20
 3470    TEQEQ r0,#ASC"B"
 3480    LDREQB r10,[r11],#1
 3490   ;
 3500    BIC r0,r10,#&20                    ; Build 'mnemonic word'
 3510   ;
 3520    LDRB r1,[r11,#0]
 3530    BIC r1,r1,#&20
 3540    ORR r0,r0,r1,LSL#8
 3550   ;
 3560    LDRB r1,[r11,#1]
 3570    BIC r1,r1,#&20
 3580    ORR r0,r0,r1,LSL#16
 3590   ;
 3600    B Data%+Patch_Off(52)
 3610   ;
 3620   .mnem_ORA
 3630   ;
 3640    EQUS "ORA "
 3650   ;
 3660   .mnem_ORB
 3670   ;
 3680    EQUS "ORB "
 3690   ;
 3700   .mnem_ORC
 3710   ;
 3720    EQUS "ORC "
 3730   ;
 3740   .mnem_AND
 3750   ;
 3760    EQUS "AND "
 3770   ;
 3780   .mnem_EOR
 3790   ;
 3800    EQUS "EOR "
 3810   
 3820   
 3830   
 3840   .patch_6809_1
 3850   ;
 3860    ADR r1,table_mnem_6809             ; Use 6809 mnemonic table instead of ARM one
 3870   ;
 3880    MOV pc,r14                         ; Return
 3890   
 3900   
 3910   
 3920   .table_mnem_6809
 3930   ;
 3940    EQUS "ADC":EQUB &00
 3950    EQUS "ADD":EQUB &01
 3960    EQUS "AND":EQUB &02
 3970    EQUS "BIT":EQUB &03
 3980    EQUS "CMP":EQUB &04
 3990    EQUS "EOR":EQUB &05
 4000    EQUS "SBC":EQUB &06
 4010    EQUS "SUB":EQUB &07
 4020    EQUS "JMP":EQUB &08
 4030    EQUS "JSR":EQUB &09
 4040    EQUS "LEA":EQUB &0A
 4050    EQUS "CWA":EQUB &0B
 4060   ;
 4070    EQUS "ASL":EQUB &10
 4080    EQUS "ASR":EQUB &11
 4090    EQUS "CLR":EQUB &12
 4100    EQUS "COM":EQUB &13
 4110    EQUS "DEC":EQUB &14
 4120    EQUS "INC":EQUB &15
 4130    EQUS "LSL":EQUB &16
 4140    EQUS "LSR":EQUB &17
 4150    EQUS "NEG":EQUB &18
 4160    EQUS "ROL":EQUB &19
 4170    EQUS "ROR":EQUB &1A
 4180    EQUS "TST":EQUB &1B
 4190   ;
 4200    EQUS "ORA":EQUB &2D
 4210    EQUS "ORB":EQUB &2D
 4220    EQUS "ORC":EQUB &2D
 4230   ;
 4240    EQUS "LDA":EQUB &2E
 4250    EQUS "LDB":EQUB &2E
 4260    EQUS "LDD":EQUB &2E
 4270    EQUS "LDS":EQUB &2E
 4280    EQUS "LDU":EQUB &2E
 4290    EQUS "LDX":EQUB &2E
 4300    EQUS "LDY":EQUB &2E
 4310   ;
 4320    EQUS "STA":EQUB &2F
 4330    EQUS "STB":EQUB &2F
 4340    EQUS "STD":EQUB &2F
 4350    EQUS "STS":EQUB &2F
 4360    EQUS "STU":EQUB &2F
 4370    EQUS "STX":EQUB &2F
 4380    EQUS "STY":EQUB &2F
 4390   ;
 4400    EQUS "BCC":EQUB &40
 4410    EQUS "BCS":EQUB &41
 4420    EQUS "BEQ":EQUB &42
 4430    EQUS "BGE":EQUB &43
 4440    EQUS "BGT":EQUB &44
 4450    EQUS "BHI":EQUB &45
 4460    EQUS "BHS":EQUB &46
 4470    EQUS "BLE":EQUB &47
 4480    EQUS "BLO":EQUB &48
 4490    EQUS "BLS":EQUB &49
 4500    EQUS "BLT":EQUB &4A
 4510    EQUS "BMI":EQUB &4B
 4520    EQUS "BNE":EQUB &4C
 4530    EQUS "BPL":EQUB &4D
 4540    EQUS "BRA":EQUB &4E
 4550    EQUS "BRN":EQUB &4F
 4560    EQUS "BSR":EQUB &50
 4570    EQUS "BVC":EQUB &51
 4580    EQUS "BVS":EQUB &52
 4590   ;
 4600    EQUS "EXG":EQUB &70
 4610    EQUS "TFR":EQUB &71
 4620   ;
 4630    EQUS "PSH":EQUB &80
 4640    EQUS "PUL":EQUB &81
 4650   ;
 4660    EQUS "ABX":EQUB &A0
 4670    EQUS "DAA":EQUB &A1
 4680    EQUS "MUL":EQUB &A2
 4690    EQUS "NOP":EQUB &A3
 4700    EQUS "RTI":EQUB &A4
 4710    EQUS "RTS":EQUB &A5
 4720    EQUS "SEX":EQUB &A6
 4730    EQUS "SYN":EQUB &A7
 4740   ;
 4750    EQUS "SWI":EQUB &B0
 4760   ;
 4770    EQUS "DCB":EQUB &E0                ; (make DCx directives big-endian)
 4780    EQUS "DCW":EQUB &E1
 4790    EQUS "DCD":EQUB &E2
 4800   ;
 4810    EQUS "OPT":EQUB &F0                ; (pass the other relevant ones)
 4820    EQUS "EQU":EQUB &F1
 4830   ;
 4840    EQUD 0                             ; (end of table)
 4850   
 4860   
 4870   
 4880   .patch_6809_2
 4890   ;
 4900    MOV r3,r2,LSR#24                   ; Initialise processing flags
 4910   ;
 4920    LDRB r10,[r11],#1                  ; To next character
 4930   ;
 4940    AND r0,r3,#&F0                     ; Possibly a 4-char mnemonic ?
 4950    TEQ r0,#&00
 4960    TEQNE r0,#&10
 4970    TEQNE r0,#&20
 4980    TEQNE r0,#&40
 4990    TEQNE r0,#&50
 5000    TEQNE r0,#&80
 5010    TEQNE r3,#&A7
 5020    TEQNE r0,#&B0
 5030    BEQ class_nobn                     ; Yes, don't skip spaces
 5040   ;
 5050    BL skip_spaces                     ; Skip spaces
 5060   ;
 5070   .class_nobn
 5080   ;
 5090    SUB r2,r8,#-basoff_stracc%         ; Buffer for instruction
 5100   ;
 5110    MOV r0,#0                          ; Wipe it
 5120    STR r0,[r2,#0]
 5130    STR r0,[r2,#4]
 5140   ;
 5150    ADR r14,class_done                 ; Call 'class' handler
 5160    STMFD r13!,{r14}
 5170    AND r0,r3,#%11110000
 5180    ADD pc,pc,r0,LSR#4-2
 5190    MOV r0,r0
 5200   ;
 5210    B class_ADC
 5220    B class_ASL
 5230    B class_ORA
 5240    EQUD 0
 5250    B class_BCC
 5260    B class_BCC
 5270    EQUD 0
 5280    B class_EXG
 5290    B class_PSH
 5300    EQUD 0
 5310    B class_ABX
 5320    B class_SWI
 5330    EQUD 0
 5340    EQUD 0
 5350    B class_DCx
 5360    EQUD 0
 5370   ;
 5380   .class_done
 5390   ;
 5400    BL skip_spaces                     ; Skip spaces
 5410   ;
 5420    B Data%+Patch_Off(50)              ; Join 'n>4 bytes' code
 5430   ;
 5440   ;
 5450   ;
 5460   .eval_expr_back
 5470   ;
 5480    SUB r11,r11,#1                     ; Step back one character
 5490    LDRB r10,[r11,#-1]
 5500   ;
 5510   .eval_expr
 5520   ;
 5530    STMFD r13!,{r1-r3,r14}             ; Evaluate expression
 5540   ;
 5550    BL Data%+Patch_Off(51)
 5560   ;
 5570    LDMFD r13!,{r1-r3,pc}^
 5580   ;
 5590   ;
 5600   ;
 5610   .hop_skip_spaces
 5620   ;
 5630    LDRB r10,[r11],#1                  ; Skip character
 5640   ;
 5650   .skip_spaces
 5660   ;
 5670    TEQ r10,#ASC" "                    ; Scan to non-space
 5680    LDREQB r10,[r11],#1
 5690    BEQ skip_spaces
 5700   ;
 5710    MOVS pc,r14
 5720   ;
 5730   ;
 5740   ;
 5750   .not_a_variable
 5760   ;
 5770    STMFD r13!,{r14}
 5780   ;
 5790    LDRB r14,[r11]
 5800   ;
 5810    CMP r14,#ASC"A"
 5820    BLO notav_chelo
 5830    CMP r14,#ASC"Z"
 5840    BLS notav_isvar
 5850   ;
 5860   .notav_chelo
 5870   ;
 5880    CMP r14,#ASC"a"
 5890    BLO notav_chedi
 5900    CMP r14,#ASC"z"
 5910    BLS notav_isvar
 5920   ;
 5930   .notav_chedi
 5940   ;
 5950    CMP r14,#ASC"0"
 5960    BLO notav_cheot
 5970    CMP r14,#ASC"9"
 5980    BLS notav_isvar
 5990   ;
 6000   .notav_cheot
 6010   ;
 6020    TEQ r14,#ASC"`"
 6030    TEQNE r14,#ASC"_"
 6040    TEQNE r14,#ASC"$"
 6050    TEQNE r14,#ASC"%"
 6060    TEQNE r14,#ASC"("
 6070    BEQ notav_isvar
 6080   ;
 6090    TEQ r14,r14
 6100   ;
 6110    LDMFD r13!,{pc}
 6120   ;
 6130   .notav_isvar
 6140   ;
 6150    CMN r14,#1
 6160   ;
 6170    LDMFD r13!,{pc}
 6180   ;
 6190   ;
 6200   ;
 6210   .opt_2
 6220   ;
 6230    STMFD r13!,{r0,r14}
 6240   ;
 6250    LDRB r0,[r8,#basoff_opt%]
 6260    TST r0,#2
 6270   ;
 6280    LDMFD r13!,{r0,pc}
 6290   ;
 6300   ;
 6310   ;
 6320   .error_bad_mnemonic
 6330   ;
 6340    ADR r0,ermsg_bad_mnemonic
 6350   ;
 6360    B error_generate
 6370   ;
 6380   .ermsg_bad_mnemonic
 6390   ;
 6400    FNerror_message(4, "No such mnemonic")
 6410   ;
 6420   ;
 6430   ;
 6440   .error_constoverflow
 6450   ;
 6460    STMFD r13!,{r14}                   ; Save link
 6470   ;
 6480    BL opt_2                           ; Errors fatal ?
 6490   ;
 6500    LDMFD r13!,{r14}                   ; Restore link
 6510   ;
 6520    MOVEQS pc,r14                      ; No, return
 6530   ;
 6540    TST r1,#&FF00
 6550    ADREQ r0,ermsg_constoverflow_b
 6560    ADRNE r0,ermsg_constoverflow_s
 6570   ;
 6580    B error_generate
 6590   ;
 6600   .ermsg_constoverflow_b
 6610   ;
 6620    FNerror_message(2, "Immediate value out of range [0..255]")
 6630   ;
 6640   .ermsg_constoverflow_s
 6650   ;
 6660    FNerror_message(2, "Immediate value out of range [0..65535]")
 6670   ;
 6680   ;
 6690   ;
 6700   .error_offsetoutofrange
 6710   ;
 6720    STMFD r13!,{r14}                   ; Save link
 6730   ;
 6740    BL opt_2                           ; Errors fatal ?
 6750   ;
 6760    LDMFD r13!,{r14}                   ; Restore link
 6770   ;
 6780    MOVEQS pc,r14                      ; No, return
 6790   ;
 6800    MOV r0,r3,LSR#24
 6810    CMP r0,#5
 6820    ADRLO r0,ermsg_offsetoutofrange_l4
 6830    ADRHS r0,ermsg_offsetoutofrange_l5
 6840   ;
 6850    B error_generate
 6860   ;
 6870   .ermsg_offsetoutofrange_l4
 6880   ;
 6890    FNerror_message(1, "Offset target out of range [P%-32764,P%+32771]")
 6900   ;
 6910   .ermsg_offsetoutofrange_l5
 6920   ;
 6930    FNerror_message(1, "Offset target out of range [P%-32763,P%+32772]")
 6940   ;
 6950   ;
 6960   ;
 6970   .error_branchoutofrange
 6980   ;
 6990    STMFD r13!,{r14}                   ; Save link
 7000   ;
 7010    BL opt_2                           ; Errors fatal ?
 7020   ;
 7030    LDMFD r13!,{r14}                   ; Restore link
 7040   ;
 7050    MOVEQS pc,r14                      ; No, return
 7060   ;
 7070    MOV r0,r3,LSR#28
 7080    CMP r0,#3
 7090    ADRLO r0,ermsg_branchoutofrange_n
 7100    ADREQ r0,ermsg_branchoutofrange_l3
 7110    ADRHI r0,ermsg_branchoutofrange_l4
 7120   ;
 7130    B error_generate
 7140   ;
 7150   .ermsg_branchoutofrange_n
 7160   ;
 7170    FNerror_message(1, "Branch target out of range [P%-126,P%+129]")
 7180   ;
 7190   .ermsg_branchoutofrange_l3
 7200   ;
 7210    FNerror_message(1, "Branch target out of range [P%-32765,P%+32770]")
 7220   ;
 7230   .ermsg_branchoutofrange_l4
 7240   ;
 7250    FNerror_message(1, "Branch target out of range [P%-32764,P%+32771]")
 7260   ;
 7270   ;
 7280   ;
 7290   .error_R_register
 7300   ;
 7310    STMFD r13!,{r14}                   ; Save link
 7320   ;
 7330    BIC r14,r10,#&20                   ; 'X', 'Y', 'U' or 'S', as expected ?
 7340    TEQ r14,#ASC"X"
 7350    TEQNE r14,#ASC"Y"
 7360    TEQNE r14,#ASC"U"
 7370    TEQNE r14,#ASC"S"
 7380    LDMEQFD r13!,{pc}^                 ; Yes, return
 7390   ;
 7400    ADR r0,ermsg_R_register
 7410   ;
 7420    B error_generate
 7430   ;
 7440   .ermsg_R_register
 7450   ;
 7460    FNerror_message(3, "Indexed addressing: expected X, Y, U or S")
 7470   ;
 7480   ;
 7490   ;
 7500   .error_R_PCR_register
 7510   ;
 7520    STMFD r13!,{r14}                   ; Save link
 7530   ;
 7540    BIC r14,r10,#&20                   ; 'X', 'Y', 'U', 'S' or 'PCR', as expected ?
 7550    TEQ r14,#ASC"X"
 7560    TEQNE r14,#ASC"Y"
 7570    TEQNE r14,#ASC"U"
 7580    TEQNE r14,#ASC"S"
 7590    LDMEQFD r13!,{pc}^                 ; Yes, return
 7600   ;
 7610    TEQ r14,#ASC"P"
 7620    LDREQB r14,[r11,#0]
 7630    BICEQ r14,r14,#&20
 7640    TEQEQ r14,#ASC"C"
 7650    LDREQB r14,[r11,#1]
 7660    BICEQ r14,r14,#&20
 7670    TEQEQ r14,#ASC"R"
 7680    LDMEQFD r13!,{pc}^                 ; Yes, return
 7690   ;
 7700    ADR r0,ermsg_R_PCR_register
 7710   ;
 7720    B error_generate
 7730   ;
 7740   .ermsg_R_PCR_register
 7750   ;
 7760    FNerror_message(3, "Indexed addressing: expected X, Y, U, S or PCR")
 7770   ;
 7780   ;
 7790   ;
 7800   .error_all_register
 7810   ;
 7820    STMFD r13!,{r10,r14}               ; Save used registers
 7830   ;
 7840    BIC r14,r10,#&20                   ; 'A', 'B', 'D', 'X', 'Y', 'U', 'S', 'CC', 'DP' or 'PC' as expected ?
 7850    TEQ r14,#ASC"A"
 7860    TEQNE r14,#ASC"B"
 7870    TEQNE r14,#ASC"D"
 7880    TEQNE r14,#ASC"X"
 7890    TEQNE r14,#ASC"Y"
 7900    TEQNE r14,#ASC"U"
 7910    TEQNE r14,#ASC"S"
 7920    LDMEQFD r13!,{r10,pc}^             ; Yes, return
 7930   ;
 7940    LDRB r10,[r11,#0]
 7950    BIC r10,r10,#&20
 7960   ;
 7970    TEQ r14,#ASC"C"
 7980    TEQEQ r10,#ASC"C"
 7990    LDMEQFD r13!,{r10,pc}^             ; Yes, return
 8000   ;
 8010    TEQ r14,#ASC"D"
 8020    TEQEQ r10,#ASC"P"
 8030    LDMEQFD r13!,{r10,pc}^             ; Yes, return
 8040   ;
 8050    TEQ r14,#ASC"P"
 8060    TEQEQ r10,#ASC"C"
 8070    LDMEQFD r13!,{r10,pc}^             ; Yes, return
 8080   ;
 8090    ADR r0,ermsg_all_register
 8100   ;
 8110    B error_generate
 8120   ;
 8130   .ermsg_all_register
 8140   ;
 8150    FNerror_message(3, "Expected A, B, D, X, Y, U, S, CC, DP or PC")
 8160   ;
 8170   ;
 8180   ;
 8190   .error_bad_addressing
 8200   ;
 8210    ADR r0,ermsg_bad_addressing
 8220   ;
 8230    B error_generate
 8240   ;
 8250   .ermsg_bad_addressing
 8260   ;
 8270    FNerror_message(3, "Addressing mode not allowed for this instruction")
 8280   ;
 8290   ;
 8300   ;
 8310   .error_bad_ifnotalpha
 8320   ;
 8330    STMFD r13!,{r14}                   ; Save link
 8340   ;
 8350    EOR r14,r10,r0                     ; Alpha character as expected ?
 8360    BICS r14,r14,#&20
 8370    BNE error_bad_mnemonic             ; No, error 'no such mnemonic'
 8380   ;
 8390    BL hop_skip_spaces                 ; Skip character and spaces
 8400   ;
 8410    LDMFD r13!,{pc}                    ; Return
 8420   ;
 8430   ;
 8440   ;
 8450   .error_indexed_c
 8460   ;
 8470    TEQ r10,#ASC","                    ; ',', as expected ?
 8480    MOVEQS pc,r14                      ; Yes, return
 8490   ;
 8500    ADR r0,ermsg_indexed_c
 8510   ;
 8520    B error_generate
 8530   ;
 8540   .ermsg_indexed_c
 8550   ;
 8560    FNerror_message(3, "Indexed addressing: expected ,")
 8570   ;
 8580   ;
 8590   ;
 8600   .error_indexed_i
 8610   ;
 8620    TEQ r10,#ASC"]"                    ; ']', as expected ?
 8630    MOVEQS pc,r14                      ; Yes, return
 8640   ;
 8650    ADR r0,ermsg_indexed_i
 8660   ;
 8670    B error_generate
 8680   ;
 8690   .ermsg_indexed_i
 8700   ;
 8710    FNerror_message(3, "Indirect indexed addressing: expected ]")
 8720   ;
 8730   ;
 8740   ;
 8750   .error_transfer_c
 8760   ;
 8770    TEQ r10,#ASC","                    ; ',', as expected ?
 8780    MOVEQS pc,r14                      ; Yes, return
 8790   ;
 8800    ADR r0,ermsg_transfer_c
 8810   ;
 8820    B error_generate
 8830   ;
 8840   .ermsg_transfer_c
 8850   ;
 8860    FNerror_message(3, "TFR/EXG : expected ,")
 8870   ;
 8880   ;
 8890   ;
 8900   .error_transfer_x
 8910   ;
 8920    ADR r0,ermsg_transfer_x
 8930   ;
 8940    B error_generate
 8950   ;
 8960   .ermsg_transfer_x
 8970   ;
 8980    FNerror_message(3, "TFR/EXG: registers are different size")
 8990   ;
 9000   ;
 9010   ;
 9020   .error_bad_pushpull
 9030   ;
 9040    ADR r0,ermsg_bad_pushpull
 9050   ;
 9060    B error_generate
 9070   ;
 9080   .ermsg_bad_pushpull
 9090   ;
 9100    FNerror_message(3, "PSH/PUL: register cannot be stacked")
 9110   ;
 9120   ;
 9130   ;
 9140   .error_bad_autostep
 9150   ;
 9160    ADR r0,ermsg_bad_autostep
 9170   ;
 9180    B error_generate
 9190   ;
 9200   .ermsg_bad_autostep
 9210   ;
 9220    FNerror_message(3, "Indirect indexed addressing: auto-increment/decrement must be by 2")
 9230   ;
 9240   ;
 9250   ;
 9260   .error_generate
 9270   ;
 9280    SWI "OS_GenerateError"
 9290   ;
 9300   ;
 9310   ;
 9320   .do_R_register
 9330   ;
 9340    STMFD r13!,{r14}                   ; Save link
 9350   ;
 9360    BL error_R_register                ; Match 'R' register
 9370   ;
 9380    BIC r10,r10,#&20                   ; Return specified 'R' register
 9390    TEQ r10,#ASC"X"
 9400    MOVEQ r14,#%00
 9410    TEQ r10,#ASC"Y"
 9420    MOVEQ r14,#%01
 9430    TEQ r10,#ASC"U"
 9440    MOVEQ r14,#%10
 9450    TEQ r10,#ASC"S"
 9460    MOVEQ r14,#%11
 9470   ;
 9480    LDRB r10,[r11],#1                  ; Next character
 9490   ;
 9500    LDMFD r13!,{pc}
 9510   ;
 9520   ;
 9530   ;
 9540   .do_R_PCR_register
 9550   ;
 9560    STMFD r13!,{r14}                   ; Save link
 9570   ;
 9580    BL error_R_PCR_register            ; Match 'R' register or 'PCR'
 9590   ;
 9600    BIC r10,r10,#&20                   ; Return specified 'R' register
 9610    TEQ r10,#ASC"X"
 9620    MOVEQ r14,#%00
 9630    TEQ r10,#ASC"Y"
 9640    MOVEQ r14,#%01
 9650    TEQ r10,#ASC"U"
 9660    MOVEQ r14,#%10
 9670    TEQ r10,#ASC"S"
 9680    MOVEQ r14,#%11
 9690   ;
 9700    TEQ r10,#ASC"P"                    ; Next character
 9710    ADDEQ r11,r11,#2                   ; (and flag 'PCR')
 9720    LDRB r10,[r11],#1
 9730   ;
 9740    LDMFD r13!,{pc}
 9750   ;
 9760   ;
 9770   ;
 9780   .do_T_register
 9790   ;
 9800    STMFD r13!,{r0,r14}                ; Save used registers
 9810   ;
 9820    BL error_all_register              ; Match 'T' register
 9830   ;
 9840    BIC r10,r10,#&20                   ; Return specified 'T' register
 9850    LDRB r14,[r11,#0]
 9860    BIC r14,r14,#&20
 9870   ;
 9880    TEQ r10,#ASC"A"
 9890    MOVEQ r0,#%10000
 9900    TEQ r10,#ASC"B"
 9910    MOVEQ r0,#%10010
 9920    TEQ r10,#ASC"D"
 9930    MOVEQ r0,#%00000
 9940    TEQEQ r14,#ASC"P"
 9950    MOVEQ r0,#%10111
 9960    TEQ r10,#ASC"X"
 9970    MOVEQ r0,#%00010
 9980    TEQ r10,#ASC"Y"
 9990    MOVEQ r0,#%00100
10000    TEQ r10,#ASC"U"
10010    MOVEQ r0,#%00110
10020    TEQ r10,#ASC"S"
10030    MOVEQ r0,#%01000
10040    TEQ r10,#ASC"C"
10050    MOVEQ r0,#%10101
10060    TEQ r10,#ASC"P"
10070    MOVEQ r0,#%01011
10080   ;
10090    MOVS r14,r0,LSR#1                  ; Next character
10100    ADDCS r11,r11,#1
10110    LDRB r10,[r11],#1
10120   ;
10130    LDMFD r13!,{r0,pc}
10140   ;
10150   ;
10160   ;
10170   .do_P_register
10180   ;
10190    STMFD r13!,{r0,r14}                ; Save used registers
10200   ;
10210    BL do_T_register                   ; Match 'P' register
10220   ;
10230    ADR r0,do_P_register_map           ; Return specified 'P' register
10240    LDRB r14,[r0,r14]
10250   ;
10260    LDMFD r13!,{r0,pc}
10270   ;
10280   .do_P_register_map
10290   ;
10300    EQUB 0 << 0:REM D
10310    EQUB 1 << 4:REM X
10320    EQUB 1 << 5:REM Y
10330    EQUB 1 << 6:REM U
10340    EQUB 1 << 6:REM S
10350    EQUB 1 << 7:REM PC
10360    EQUB 0 << 0:REM -
10370    EQUB 0 << 0:REM -
10380    EQUB 1 << 1:REM A
10390    EQUB 1 << 2:REM B
10400    EQUB 1 << 0:REM CC
10410    EQUB 1 << 3:REM DP
10420    EQUB 0 << 0:REM -
10430    EQUB 0 << 0:REM -
10440    EQUB 0 << 0:REM -
10450    EQUB 0 << 0:REM -
10460   ;
10470   ;
10480   ;
10490   .do_dieximin
10500   ;
10510    STMFD r13!,{r1-r2,r14}             ; Save used registers
10520   ;
10530    MOV r3,r3,LSL#24                   ; Move instruction info
10540   ;
10550    MOV r0,#1<<1                       ; 8- or 16-bit force ?
10560    TEQ r10,#ASC"<"
10570    MOVEQ r0,#1<<0
10580    TEQNE r10,#ASC">"
10590    ORREQ r3,r3,r0,LSL#4               ; Yes, flag it (and which one)
10600    BLEQ hop_skip_spaces               ; And skip '<' or '>' and spaces
10610   ;
10620    TEQ r10,#ASC"#"                    ; Immediate ?
10630    BNE do_dieximin_noimm              ; No, continue
10640   ;
10650    BL eval_expr                       ; Immediate value
10660   ;
10670    ORR r3,r3,#2<<0                    ; Indicate 'immediate'
10680   ;
10690    B do_dieximin_rtarg                ; Finish
10700   ;
10710   .do_dieximin_noimm
10720   ;
10730    TEQ r10,#ASC"["                    ; Indirection ?
10740    ORREQ r3,r3,#1<<7                  ; Yes, flag it
10750    BLEQ hop_skip_spaces               ; And skip '[' and spaces
10760   ;
10770    TEQ r10,#ASC","                    ; Indexed, no offset ?
10780    BEQ do_dieximin_ixnul              ; Yes, handle as such
10790   ;
10800    BIC r0,r10,#&20                    ; Indexed, accu based ?
10810    TEQ r0,#ASC"A"
10820    TEQNE r0,#ASC"B"
10830    TEQNE r0,#ASC"D"
10840    BLEQ not_a_variable
10850    BEQ do_dieximin_ixacc              ; Yes, handle as such
10860   ;
10870    BL eval_expr_back                  ; Address or offset
10880   ;
10890    TEQ r10,#ASC","                    ; Indexed, with offset ?
10900    BEQ do_dieximin_ixoff              ; Yes, handle as such
10910   ;
10920    TST r3,#1<<7                       ; Indirection ?
10930    ORRNE r3,r3,#%10011111<<8          ; Yes, extended indirect
10940    BNE do_dieximin_ixfin              ; And finish as 'indexed'
10950   ;
10960    TST r3,#1<<4                       ; Indicate 'direct' or 'extended'
10970    ORRNE r3,r3,#0<<0
10980    ORREQ r3,r3,#1<<0
10990   ;
11000    B do_dieximin_rtarg                ; Finish
11010   ;
11020   .do_dieximin_ixfin
11030   ;
11040    ORR r3,r3,#3<<0                    ; Indicate 'indexed'
11050   ;
11060    TST r3,#1<<7                       ; Indirection ?
11070    BEQ do_dieximin_rtarg              ; No, don't check for ']'
11080   ;
11090    ORR r3,r3,#%00010000<<8            ; Make post-byte 'indirect'
11100   ;
11110    BL skip_spaces                     ; Skip spaces
11120   ;
11130    BL error_indexed_i                 ; Match ']'
11140   ;
11150    LDRB r10,[r11],#1                  ; Next character
11160   ;
11170   .do_dieximin_rtarg
11180   ;
11190    LDMFD r13!,{r1-r2,pc}              ; Return
11200   ;
11210   .do_dieximin_ixnul
11220   ;
11230    BL hop_skip_spaces                 ; Skip ',' and spaces
11240   ;
11250    MOV r0,#%10000100                  ; Initialise post-byte
11260   ;
11270    TEQ r10,#ASC"-"                    ; Pre-decrement ?
11280    MOVEQ r0,#%10000010                ; Yes, note and skip '-'
11290    LDREQB r10,[r11],#1
11300    TEQEQ r10,#ASC"-"                  ; Double decrement ?
11310    MOVEQ r0,#%10000011                ; Yes, note and skip '-'
11320    LDREQB r10,[r11],#1
11330   ;
11340    BL do_R_register                   ; Note 'R' register
11350    ORR r3,r3,r14,LSL#13
11360   ;
11370    TEQ r0,#%10000100                  ; Have a pre-decrement ?
11380    BNE do_dieximin_noinc              ; Yes, no post-increment
11390   ;
11400    TEQ r10,#ASC"+"                    ; Post-increment ?
11410    MOVEQ r0,#%10000000                ; Yes, note and skip '+'
11420    LDREQB r10,[r11],#1
11430    TEQEQ r10,#ASC"+"                  ; Double increment ?
11440    MOVEQ r0,#%10000001                ; Yes, note and skip '+'
11450    LDREQB r10,[r11],#1
11460   ;
11470   .do_dieximin_noinc
11480   ;
11490    ORR r3,r3,r0,LSL#8                 ; Note required post-byte
11500   ;
11510    TST r3,#1<<7                       ; Fault single-inc/dec indirect
11520    TEQNE r0,#%10000100
11530    TEQNE r0,#%10000011
11540    TEQNE r0,#%10000001
11550    BNE error_bad_autostep
11560   ;
11570    B do_dieximin_ixfin                ; Finish 'indexed'
11580   ;
11590   .do_dieximin_ixacc
11600   ;
11610    CMP r0,#ASC"B"                     ; Note specified accumulator
11620    ORRLO r3,r3,#%10000110<<8
11630    ORREQ r3,r3,#%10000101<<8
11640    ORRHI r3,r3,#%10001011<<8
11650   ;
11660    BL hop_skip_spaces                 ; Skip accumulator name and spaces
11670   ;
11680    BL error_indexed_c                 ; Match ','
11690   ;
11700    BL hop_skip_spaces                 ; Skip ',' and spaces
11710   ;
11720    BL do_R_register                   ; Note 'R' register
11730    ORR r3,r3,r14,LSL#13
11740   ;
11750    B do_dieximin_ixfin                ; Finish 'indexed'
11760   ;
11770   .do_dieximin_ixoff
11780   ;
11790    BL hop_skip_spaces                 ; Skip ',' and spaces
11800   ;
11810    BL do_R_PCR_register               ; Note 'R' register (or detect 'PCR')
11820    BEQ do_dieximin_ixopc              ; (if 'PCR' detected, handle seperately)
11830    ORR r3,r3,r14,LSL#13
11840   ;
11850    TST r3,#1<<4                       ; 8-bit force ?
11860    ORRNE r3,r3,#%10001000<<8          ; Yes, do it
11870    BNE do_dieximin_ixfin              ; And finish 'indexed'
11880   ;
11890    TST r3,#1<<5                       ; 16-bit force ?
11900    ORRNE r3,r3,#%10001001<<8          ; Yes, do it
11910    BNE do_dieximin_ixfin              ; And finish 'indexed'
11920   ;
11930    TST r3,#1<<7                       ; No 5-bit offset indirect
11940    BNE do_dieximin_ixoby
11950   ;
11960    ADD r14,r0,#&10                    ; Offset fits in 5 bits ?
11970    CMP r14,#&20
11980    BHS do_dieximin_ixoby              ; No, try next larger
11990   ;
12000    ANDS r14,r0,#%11111                ; Note offset in post-byte
12010    ORRNE r3,r3,r14,LSL#8
12020    ORREQ r3,r3,#%10000100<<8          ; (replace '0,R' with ',R')
12030   ;
12040    B do_dieximin_ixfin                ; Finish 'indexed'
12050   ;
12060   .do_dieximin_ixoby
12070   ;
12080    ADD r14,r0,#&80                    ; Fit offset in 8 or 16 bits ?
12090    CMP r14,#&100
12100    ORRLO r3,r3,#%10001000<<8          ; 8
12110    ORRHS r3,r3,#%10001001<<8          ; 16
12120   ;
12130    B do_dieximin_ixfin                ; Finish 'indexed'
12140   ;
12150   .do_dieximin_ixopc
12160   ;
12170    LDR r14,[r8,#basoff_p%]            ; Calculate offset relative to PCR
12180    ADD r3,r3,#2<<24                   ; (assuming 16-bit offset -> 2 bytes)
12190    ADD r14,r14,r3,LSR#24
12200    SUB r0,r0,r14
12210   ;
12220    ADD r14,r0,#&8000                  ; In range ?
12230    CMP r14,#&10000
12240    BLHS error_offsetoutofrange        ; No, error 'offset target out of range'
12250   ;
12260    ADD r0,r0,#1                       ; 8-bit force ?
12270    TST r3,#1<<4
12280    ORRNE r3,r3,#%10001100<<8          ; Yes, do it
12290    BNE do_dieximin_ixfin              ; And finish 'indexed'
12300   ;
12310    SUB r0,r0,#1                       ; 16-bit force ?
12320    TST r3,#1<<5
12330    ORRNE r3,r3,#%10001101<<8          ; Yes, do it
12340    BNE do_dieximin_ixfin              ; And finish 'indexed'
12350   ;
12360    ADD r0,r0,#1                       ; Fit offset in 8 or 16 bits ?
12370    ADD r14,r0,#&80
12380    CMP r14,#&100
12390    ORRLO r3,r3,#%10001100<<8          ; 8
12400    SUBHS r0,r0,#1
12410    ORRHS r3,r3,#%10001101<<8          ; 16
12420   ;
12430    B do_dieximin_ixfin                ; Finish 'indexed'
12440   ;
12450   ;
12460   ;
12470   .finish_hop_byte
12480   ;
12490    LDRB r10,[r11],#1                  ; Skip last character
12500   ;
12510   .finish_byte
12520   ;
12530    STRB r0,[r2],#1                    ; Buffer opcode argument
12540   ;
12550    LDMFD r13!,{pc}
12560   ;
12570   ;
12580   ;
12590   .finish_hop_word
12600   ;
12610    LDRB r10,[r11],#1                  ; Skip last character
12620   ;
12630   .finish_word
12640   ;
12650    MOV r0,r0,ROR#8                    ; Buffer opcode argument
12660    STRB r0,[r2],#1
12670    MOV r0,r0,ROR#24
12680    STRB r0,[r2],#1
12690   ;
12700    LDMFD r13!,{pc}
12710   ;
12720   ;
12730   ;
12740   .finish_hop_dble
12750   ;
12760    LDRB r10,[r11],#1                  ; Skip last character
12770   ;
12780   .finish_dble
12790   ;
12800    MOV r0,r0,ROR#24                   ; Buffer opcode argument
12810    STRB r0,[r2],#1
12820    MOV r0,r0,ROR#24
12830    STRB r0,[r2],#1
12840    MOV r0,r0,ROR#24
12850    STRB r0,[r2],#1
12860    MOV r0,r0,ROR#24
12870    STRB r0,[r2],#1
12880   ;
12890    LDMFD r13!,{pc}
12900   ;
12910   ;
12920   ;
12930   .finish_hop_implied
12940   ;
12950    LDRB r10,[r11],#1                  ; Skip last character
12960   ;
12970   .finish_implied
12980   ;
12990    LDMFD r13!,{pc}
13000   ;
13010   ;
13020   ;
13030   .class_ABX
13040   ;
13050    TEQ r3,#&A7                        ; Check 4th mnemonic character (if any)
13060    MOVEQ r0,#ASC"C"
13070    BLEQ error_bad_ifnotalpha
13080   ;
13090    ADR r1,table_implieds_ABX-&A0      ; Output opcode
13100    LDRB r1,[r1,r3]
13110    STRB r1,[r2],#1
13120   ;
13130    B finish_implied                   ; End with 0 argument bytes
13140   ;
13150   ;
13160   ;
13170   .table_implieds_ABX
13180   ;
13190    EQUB &3A
13200    EQUB &19
13210    EQUB &3D
13220    EQUB &12
13230    EQUB &3B
13240    EQUB &39
13250    EQUB &1D
13260    EQUB &13
13270   ;
13280    ALIGN
13290   ;
13300   ;
13310   ;
13320   .class_EXG
13330   ;
13340    TEQ r3,#&70                        ; Output opcode
13350    MOVEQ r1,#&1E
13360    MOVNE r1,#&1F
13370    STRB r1,[r2],#1
13380   ;
13390    BL do_T_register                   ; Determine argument byte
13400    ORR r0,r14,r0,LSL#4
13410   ;
13420    BL skip_spaces
13430   ;
13440    BL error_transfer_c
13450   ;
13460    BL hop_skip_spaces
13470   ;
13480    BL do_T_register
13490    ORR r0,r14,r0,LSL#4
13500   ;
13510    EOR r14,r0,r0,LSR#4                ; Fault incompatible sizes
13520    TST r14,#%1000
13530    BNE error_transfer_x
13540   ;
13550    B finish_byte                      ; End with 1 argument byte
13560   ;
13570   ;
13580   ;
13590   .class_PSH
13600   ;
13610    BIC r0,r10,#&20                    ; Check 4th mnemonic character
13620    TEQ r0,#ASC"S"
13630    TEQNE r0,#ASC"U"
13640    MVNNE r0,r0
13650    BL error_bad_ifnotalpha
13660   ;
13670    TEQ r3,#&80                        ; Output opcode
13680    MOVEQ r1,#&34
13690    MOVNE r1,#&35
13700    TEQ r0,#ASC"U"
13710    ADDEQ r1,r1,#&02
13720    STRB r1,[r2],#1
13730   ;
13740    MOV r0,#%00000000                  ; Determine argument byte
13750   ;
13760   .class_PSH_reg
13770   ;
13780    BL do_P_register
13790   ;
13800    TEQ r14,#0
13810    BEQ error_bad_pushpull
13820   ;
13830    ORR r0,r0,r14
13840   ;
13850    BL skip_spaces
13860   ;
13870    TEQ r10,#ASC","
13880    BNE class_PSH_regd
13890   ;
13900    BL hop_skip_spaces
13910   ;
13920    B class_PSH_reg
13930   ;
13940   .class_PSH_regd
13950   ;
13960    B finish_byte                      ; End with 1 argument byte
13970   ;
13980   ;
13990   ;
14000   .class_BCC
14010   ;
14020    LDRB r0,[r11,#-5]                  ; 'Long' version ?
14030    BIC r0,r0,#&20
14040    TEQ r0,#ASC"L"
14050    ORREQ r3,r3,#1<<16                 ; Yes, flag it
14060   ;
14070    ADR r1,table_branches-&40*4        ; Determine opcode
14080    AND r14,r3,#%11111111
14090    LDR r1,[r1,r14,LSL#2]
14100    TST r3,#1<<16
14110    MOVNE r1,r1,ROR#16
14120    ADDNE r3,r3,#1<<28
14130   ;
14140    ANDS r14,r1,#&FF00                 ; Output opcode
14150    MOVNE r14,r14,LSR#8
14160    STRNEB r14,[r2],#1
14170    ADDNE r3,r3,#1<<28
14180    STRB r1,[r2],#1
14190   ;
14200    BL eval_expr_back                  ; Calculate branch offset
14210    LDR r1,[r8,#basoff_p%]
14220    ADD r3,r3,#2<<28
14230    ADD r1,r1,r3,LSR#28
14240    SUB r0,r0,r1
14250   ;
14260    TST r3,#1<<16                      ; In range ?
14270    MOVEQ r1,#&0080
14280    MOVNE r1,#&8000
14290    ADD r14,r0,r1
14300    CMP r14,r1,LSL#1
14310    BLHS error_branchoutofrange        ; No, error 'branch target out of range'
14320   ;
14330    TST r3,#1<<16                      ; Finish with 1 or 2 argument bytes
14340    BEQ finish_byte
14350    BNE finish_word
14360   ;
14370   ;
14380   ;
14390   .table_branches
14400   ;
14410    EQUW &0024:EQUW &1024
14420    EQUW &0025:EQUW &1025
14430    EQUW &0027:EQUW &1027
14440    EQUW &002C:EQUW &102C
14450    EQUW &002E:EQUW &102E
14460    EQUW &0022:EQUW &1022
14470    EQUW &0024:EQUW &1024
14480    EQUW &002F:EQUW &102F
14490    EQUW &0025:EQUW &1025
14500    EQUW &0023:EQUW &1023
14510    EQUW &002D:EQUW &102D
14520    EQUW &002B:EQUW &102B
14530    EQUW &0026:EQUW &1026
14540    EQUW &002A:EQUW &102A
14550    EQUW &0020:EQUW &0016
14560    EQUW &0021:EQUW &1021
14570    EQUW &008D:EQUW &0017
14580    EQUW &0028:EQUW &1028
14590    EQUW &0029:EQUW &1029
14600   ;
14610   ;
14620   ;
14630   .class_SWI
14640   ;
14650    TEQ r10,#ASC"2"                    ; SWI number postfix ?
14660    TEQNE r10,#ASC"3"
14670    BNE class_SWI_nonum                ; No, not 'special'
14680   ;
14690    SUB r1,r10,#ASC"2"-&10             ; Output opcode prefix
14700    STRB r1,[r2],#1
14710   ;
14720    LDRB r10,[r11],#1                  ; Skip SWI number
14730   ;
14740   .class_SWI_nonum
14750   ;
14760    MOV r1,#%00111111                  ; Output opcode
14770    STRB r1,[r2],#1
14780   ;
14790    B finish_implied                   ; End with 0 argument bytes
14800   ;
14810   ;
14820   ;
14830   .class_ADC
14840   ;
14850    TEQ r3,#&02                        ; ANDCC / ORCC ?
14860    TEQNE r3,#&0D
14870    BICEQ r0,r10,#&20
14880    TEQEQ r0,#ASC"C"
14890    LDREQB r0,[r11,#0]
14900    BICEQ r0,r0,#&20
14910    TEQEQ r0,#ASC"C"
14920    ADDEQ r11,r11,#1                   ; Yes, 'forget' first C
14930    MOVEQ r10,#&03                     ; And 're-code' second
14940   ;
14950   .class_ASL_noacc
14960   ;
14970    ADR r0,table_deii_instns           ; Mnemonic's info table
14980    LDR r3,[r0,r3,LSL#2]
14990    ADD r3,r0,r3
15000   ;
15010    BIC r0,r10,#&20                    ; Match register name postfix
15020   ;
15030    SUB r1,r3,#1
15040   ;
15050   .class_ADC_pocha
15060   ;
15070    LDRB r14,[r1,#1]!
15080    TEQ r14,#0
15090    BEQ error_bad_mnemonic
15100    TEQ r14,#ASC" "
15110    BEQ class_ADC_ponot
15120    TEQ r14,r0
15130    BNE class_ADC_pocha
15140   ;
15150   .class_ADC_ponot
15160   ;
15170    SUB r0,r1,r3                       ; Mnemonic's info entry
15180    ADD r1,r3,#8
15190    ADD r1,r1,r0,LSL#3
15200   ;
15210    TEQ r14,#ASC" "                    ; Skip register name (if any)
15220    LDRNEB r10,[r11],#1
15230   ;
15240    BL skip_spaces                     ; Skip spaces
15250   ;
15260    MOV r3,#2<<0                       ; Minimum number of bytes for 'indexed'
15270    LDR r14,[r1,#3<<1]
15280    TST r14,#&1F00
15290    ADDNE r3,r3,#1<<0
15300   ;
15310    BL do_dieximin                     ; Parse direct/extended/immediate/indexed
15320   ;
15330    AND r14,r3,#%11                    ; Output opcode
15340    LDR r1,[r1,r14,LSL#1]
15350    ANDS r14,r1,#&1F00
15360    MOVNE r14,r14,LSR#8
15370    STRNEB r14,[r2],#1
15380    STRB r1,[r2],#1
15390   ;
15400    TST r1,#1<<15                      ; Addressing mode allowed ?
15410    BNE error_bad_addressing           ; No, abort with error
15420   ;
15430    AND r14,r3,#%11                    ; Dispatch addressing mode
15440    CMP r14,#2
15450    BLO class_ADC_straight
15460    BEQ class_ADC_immediate
15470    BHI class_ADC_indexed
15480   ;
15490   .class_ADC_straight
15500   ;
15510    CMP r14,#1                         ; Finish with 1 or 2 argument bytes
15520    BLO finish_byte
15530    BEQ finish_word
15540   ;
15550   .class_ADC_immediate
15560   ;
15570    TST r1,#1<<14                      ; In range ?
15580    MOVEQ r1,#&0080
15590    MOVNE r1,#&8000
15600    CMP r0,r1,LSL#1
15610    BLHS error_constoverflow           ; No, error 'immediate value out of range'
15620   ;
15630    TST r1,#&FF00                      ; Finish with 1 or 2 argument bytes
15640    BEQ finish_byte
15650    BNE finish_word
15660   ;
15670   .class_ADC_indexed
15680   ;
15690    MOV r1,r3,LSR#8                    ; Output opcode post-byte
15700    STRB r1,[r2],#1
15710   ;
15720    AND r1,r1,#%10001111               ; Finish with 0, 1 or 2 argument bytes
15730   ;
15740    TEQ r1,#%10001001
15750    TEQNE r1,#%10001101
15760    TEQNE r1,#%10001111
15770    BEQ finish_word
15780   ;
15790    TEQ r1,#%10001000
15800    TEQNE r1,#%10001100
15810    BEQ finish_byte
15820   ;
15830    B finish_implied
15840   ;
15850   ;
15860   ;
15870   .table_deii_instns
15880   ;
15890    EQUD table_deii_ADC - table_deii_instns
15900    EQUD table_deii_ADD - table_deii_instns
15910    EQUD table_deii_AND - table_deii_instns
15920    EQUD table_deii_BIT - table_deii_instns
15930    EQUD table_deii_CMP - table_deii_instns
15940    EQUD table_deii_EOR - table_deii_instns
15950    EQUD table_deii_SBC - table_deii_instns
15960    EQUD table_deii_SUB - table_deii_instns
15970    EQUD table_deii_JMP - table_deii_instns
15980    EQUD table_deii_JSR - table_deii_instns
15990    EQUD table_deii_LEA - table_deii_instns
16000    EQUD table_deii_CWA - table_deii_instns
16010    EQUD 0
16020    EQUD table_deii_ORx - table_deii_instns
16030    EQUD table_deii_LDx - table_deii_instns
16040    EQUD table_deii_STx - table_deii_instns
16050   ;
16060    EQUD table_deii_ASL - table_deii_instns
16070    EQUD table_deii_ASR - table_deii_instns
16080    EQUD table_deii_CLR - table_deii_instns
16090    EQUD table_deii_COM - table_deii_instns
16100    EQUD table_deii_DEC - table_deii_instns
16110    EQUD table_deii_INC - table_deii_instns
16120    EQUD table_deii_LSL - table_deii_instns
16130    EQUD table_deii_LSR - table_deii_instns
16140    EQUD table_deii_NEG - table_deii_instns
16150    EQUD table_deii_ROL - table_deii_instns
16160    EQUD table_deii_ROR - table_deii_instns
16170    EQUD table_deii_TST - table_deii_instns
16180    EQUD 0
16190    EQUD 0
16200    EQUD 0
16210    EQUD 0
16220   ;
16230   ;
16240   ;
16250   .table_deii_ADC
16260   ;
16270    EQUS FNnull_pad_8("AB")
16280    EQUW &0099:EQUW &00B9:EQUW 0 << 14 OR &0089:EQUW &00A9
16290    EQUW &00D9:EQUW &00F9:EQUW 0 << 14 OR &00C9:EQUW &00E9
16300   ;
16310   .table_deii_ADD
16320   ;
16330    EQUS FNnull_pad_8("ABD")
16340    EQUW &009B:EQUW &00BB:EQUW 0 << 14 OR &008B:EQUW &00AB
16350    EQUW &00DB:EQUW &00FB:EQUW 0 << 14 OR &00CB:EQUW &00EB
16360    EQUW &00D3:EQUW &00F3:EQUW 1 << 14 OR &00C3:EQUW &00E3
16370   ;
16380   .table_deii_AND
16390   ;
16400    EQUS FNnull_pad_8("AB"+CHR$(&03))
16410    EQUW &0094:EQUW &00B4:EQUW 0 << 14 OR &0084:EQUW &00A4
16420    EQUW &00D4:EQUW &00F4:EQUW 0 << 14 OR &00C4:EQUW &00E4
16430    EQUW &FFFF:EQUW &FFFF:EQUW 0 << 14 OR &001C:EQUW &FFFF
16440   ;
16450   .table_deii_BIT
16460   ;
16470    EQUS FNnull_pad_8("AB")
16480    EQUW &0095:EQUW &00B5:EQUW 0 << 14 OR &0085:EQUW &00A5
16490    EQUW &00D5:EQUW &00F5:EQUW 0 << 14 OR &00C5:EQUW &00E5
16500   ;
16510   .table_deii_CMP
16520   ;
16530    EQUS FNnull_pad_8("ABDSUXY")
16540    EQUW &0091:EQUW &00B1:EQUW 0 << 14 OR &0081:EQUW &00A1
16550    EQUW &00D1:EQUW &00F1:EQUW 0 << 14 OR &00C1:EQUW &00E1
16560    EQUW &1093:EQUW &10B3:EQUW 1 << 14 OR &1083:EQUW &10A3
16570    EQUW &119C:EQUW &11BC:EQUW 1 << 14 OR &118C:EQUW &11AC
16580    EQUW &1193:EQUW &11B3:EQUW 1 << 14 OR &1183:EQUW &11A3
16590    EQUW &009C:EQUW &00BC:EQUW 1 << 14 OR &008C:EQUW &00AC
16600    EQUW &109C:EQUW &10BC:EQUW 1 << 14 OR &108C:EQUW &10AC
16610   ;
16620   .table_deii_EOR
16630   ;
16640    EQUS FNnull_pad_8("AB")
16650    EQUW &0098:EQUW &00B8:EQUW 0 << 14 OR &0088:EQUW &00A8
16660    EQUW &00D8:EQUW &00F8:EQUW 0 << 14 OR &00C8:EQUW &00E8
16670   ;
16680   .table_deii_SBC
16690   ;
16700    EQUS FNnull_pad_8("AB")
16710    EQUW &0092:EQUW &00B2:EQUW 0 << 14 OR &0082:EQUW &00A2
16720    EQUW &00D2:EQUW &00F2:EQUW 0 << 14 OR &00C2:EQUW &00E2
16730   ;
16740   .table_deii_SUB
16750   ;
16760    EQUS FNnull_pad_8("ABD")
16770    EQUW &0090:EQUW &00B0:EQUW 0 << 14 OR &0080:EQUW &00A0
16780    EQUW &00D0:EQUW &00F0:EQUW 0 << 14 OR &00C0:EQUW &00E0
16790    EQUW &0093:EQUW &00B3:EQUW 1 << 14 OR &0083:EQUW &00A3
16800   ;
16810   .table_deii_JMP
16820   ;
16830    EQUS FNnull_pad_8(" ")
16840    EQUW &000E:EQUW &007E:EQUW &FFFF:EQUW &006E
16850   ;
16860   .table_deii_JSR
16870   ;
16880    EQUS FNnull_pad_8(" ")
16890    EQUW &009D:EQUW &00BD:EQUW &FFFF:EQUW &00AD
16900   ;
16910   .table_deii_LEA
16920   ;
16930    EQUS FNnull_pad_8("SUXY")
16940    EQUW &FFFF:EQUW &FFFF:EQUW &FFFF:EQUW &0032
16950    EQUW &FFFF:EQUW &FFFF:EQUW &FFFF:EQUW &0033
16960    EQUW &FFFF:EQUW &FFFF:EQUW &FFFF:EQUW &0030
16970    EQUW &FFFF:EQUW &FFFF:EQUW &FFFF:EQUW &0031
16980   ;
16990   .table_deii_CWA
17000   ;
17010    EQUS FNnull_pad_8("I")
17020    EQUW &FFFF:EQUW &FFFF:EQUW &003C:EQUW &FFFF
17030   ;
17040   .table_deii_ORx
17050   ;
17060    EQUS FNnull_pad_8("AB"+CHR$(&03))
17070    EQUW &009A:EQUW &00BA:EQUW 0 << 14 OR &008A:EQUW &00AA
17080    EQUW &00DA:EQUW &00FA:EQUW 0 << 14 OR &00CA:EQUW &00EA
17090    EQUW &FFFF:EQUW &FFFF:EQUW 0 << 14 OR &001A:EQUW &FFFF
17100   ;
17110   .table_deii_LDx
17120   ;
17130    EQUS FNnull_pad_8("ABDSUXY")
17140    EQUW &0096:EQUW &00B6:EQUW 0 << 14 OR &0086:EQUW &00A6
17150    EQUW &00D6:EQUW &00F6:EQUW 0 << 14 OR &00C6:EQUW &00E6
17160    EQUW &00DC:EQUW &00FC:EQUW 1 << 14 OR &00CC:EQUW &00EC
17170    EQUW &10DE:EQUW &10FE:EQUW 1 << 14 OR &10CE:EQUW &10EE
17180    EQUW &00DE:EQUW &00FE:EQUW 1 << 14 OR &00CE:EQUW &00EE
17190    EQUW &009E:EQUW &00BE:EQUW 1 << 14 OR &008E:EQUW &00AE
17200    EQUW &109E:EQUW &10BE:EQUW 1 << 14 OR &108E:EQUW &10AE
17210   ;
17220   .table_deii_STx
17230   ;
17240    EQUS FNnull_pad_8("ABDSUXY")
17250    EQUW &0097:EQUW &00B7:EQUW &FFFF:EQUW &00A7
17260    EQUW &00D7:EQUW &00F7:EQUW &FFFF:EQUW &00E7
17270    EQUW &00DD:EQUW &00FD:EQUW &FFFF:EQUW &00ED
17280    EQUW &10DF:EQUW &10FF:EQUW &FFFF:EQUW &10EF
17290    EQUW &00DF:EQUW &00FF:EQUW &FFFF:EQUW &00EF
17300    EQUW &009F:EQUW &00BF:EQUW &FFFF:EQUW &00AF
17310    EQUW &109F:EQUW &10BF:EQUW &FFFF:EQUW &10AF
17320   ;
17330   .table_deii_ASL
17340   ;
17350    EQUS FNnull_pad_8(" ")
17360    EQUW &0008:EQUW &0078:EQUW &FFFF:EQUW &0068
17370   ;
17380   .table_deii_ASR
17390   ;
17400    EQUS FNnull_pad_8(" ")
17410    EQUW &0007:EQUW &0077:EQUW &FFFF:EQUW &0067
17420   ;
17430   .table_deii_CLR
17440   ;
17450    EQUS FNnull_pad_8(" ")
17460    EQUW &000F:EQUW &007F:EQUW &FFFF:EQUW &006F
17470   ;
17480   .table_deii_COM
17490   ;
17500    EQUS FNnull_pad_8(" ")
17510    EQUW &0003:EQUW &0073:EQUW &FFFF:EQUW &0063
17520   ;
17530   .table_deii_DEC
17540   ;
17550    EQUS FNnull_pad_8(" ")
17560    EQUW &000A:EQUW &007A:EQUW &FFFF:EQUW &006A
17570   ;
17580   .table_deii_INC
17590   ;
17600    EQUS FNnull_pad_8(" ")
17610    EQUW &000C:EQUW &007C:EQUW &FFFF:EQUW &006C
17620   ;
17630   .table_deii_LSL
17640   ;
17650    EQUS FNnull_pad_8(" ")
17660    EQUW &0008:EQUW &0078:EQUW &FFFF:EQUW &0068
17670   ;
17680   .table_deii_LSR
17690   ;
17700    EQUS FNnull_pad_8(" ")
17710    EQUW &0004:EQUW &0074:EQUW &FFFF:EQUW &0064
17720   ;
17730   .table_deii_NEG
17740   ;
17750    EQUS FNnull_pad_8(" ")
17760    EQUW &0000:EQUW &0070:EQUW &FFFF:EQUW &0060
17770   ;
17780   .table_deii_ROL
17790   ;
17800    EQUS FNnull_pad_8(" ")
17810    EQUW &0009:EQUW &0079:EQUW &FFFF:EQUW &0069
17820   ;
17830   .table_deii_ROR
17840   ;
17850    EQUS FNnull_pad_8(" ")
17860    EQUW &0006:EQUW &0076:EQUW &FFFF:EQUW &0066
17870   ;
17880   .table_deii_TST
17890   ;
17900    EQUS FNnull_pad_8(" ")
17910    EQUW &000D:EQUW &007D:EQUW &FFFF:EQUW &006D
17920   ;
17930   ;
17940   ;
17950   .class_ASL
17960   ;
17970    BIC r0,r10,#&20                    ; Accumulator name postfix ?
17980    TEQ r0,#ASC"A"
17990    TEQNE r0,#ASC"B"
18000    BLEQ not_a_variable
18010    BNE class_ASL_noacc                ; No, not implied
18020   ;
18030    ADR r1,table_implieds_ASL-&10      ; Output opcode
18040    LDRB r1,[r1,r3]
18050    SUB r0,r0,#ASC"A"
18060    ORR r1,r1,r0,LSL#4
18070    STRB r1,[r2],#1
18080   ;
18090    B finish_hop_implied               ; Skip accumulator name and end with 0 argument bytes
18100   ;
18110   ;
18120   ;
18130   .table_implieds_ASL
18140   ;
18150    EQUB &48
18160    EQUB &47
18170    EQUB &4F
18180    EQUB &43
18190    EQUB &4A
18200    EQUB &4C
18210    EQUB &48
18220    EQUB &44
18230    EQUB &40
18240    EQUB &49
18250    EQUB &46
18260    EQUB &4D
18270   ;
18280    ALIGN
18290   ;
18300   ;
18310   ;
18320   .class_ORA
18330   ;
18340    SUB r11,r11,#2                     ; Step back to 3rd char
18350    LDRB r10,[r11],#1
18360   ;
18370    EOR r3,r3,#&20 EOR &00             ; Change to 'ADC' class
18380   ;
18390    B class_ADC
18400   ;
18410   ;
18420   ;
18430   .class_DCx
18440   ;
18450    BL eval_expr_back                  ; Calculate argument
18460   ;
18470    CMP r3,#&E1                        ; Finish with 1, 2 or 4 argument bytes
18480    BLO finish_byte
18490    BEQ finish_word
18500    BHI finish_dble
18510   
18520   
18530   
18540   ]
18550   
18560 NEXT
18570 
18580 Size% = P% - Data%
18590 
18600 ENDPROC
18610 
18620 
18630 
18640 DEFFNnull_pad_8(string$)
18650 
18660 = LEFT$(string$ + STRING$(8, CHR$(0)), 8)
18670 
18680 
18690 
18700 DEFFNerror_message(asm_err%, error_message$)
18710 
18720 [OPT `P
18730 ;
18740  EQUD asm_err%
18750  EQUS error_message$
18760  EQUB 0
18770 ;
18780  ALIGN
18790 ;
18800 ]
18810 
18820 = 0
18830 
18840 
18850 
18860 DEFPROCdoing_105
18870 
18880 REM RISC OS 3.1x BASIC 1.05
18890 REM Address data for v1.05 added by J.G.Harston
18900 
18910 Patch_Off(1) = &B994:REM TEXTLOAD renumber 1,1
18920 Patch_Off(2) = &A044:REM Point to mnemonic table
18930 Patch_Off(3) = &A0E8:REM B patch_6809_2
18940 Patch_Off(4) = &9FE8:REM B patch_6809_0
18950 Patch_Off(5) = &A87C:REM AND R0,R0,#15; mask OPT
18960 
18970 Patch_Off(50) = &A668
18980 Patch_Off(51) = &AA18
18990 Patch_Off(52) = &A040:REM Search mnemonic table
19000 
19010 basoff_p%   = -&C0
19020 basoff_opt% = -&26
19030 basoff_stracc% = -&600
19040 
19050 Which$ = "BASIC105"
19060 
19070 ENDPROC
19080 
19090 
19100 
19110 DEFPROCdoing_116
19120 
19130 REM RISC OS 3.70 BASIC 1.16
19140 
19150 Patch_Off(1) = &BAD4
19160 Patch_Off(2) = &A184
19170 Patch_Off(3) = &A228
19180 Patch_Off(4) = &A128
19190 Patch_Off(5) = &A9BC
19200 
19210 Patch_Off(50) = &A7A8
19220 Patch_Off(51) = &AB58
19230 Patch_Off(52) = &A180
19240 
19250 basoff_p%      = -&C0
19260 basoff_opt%    = -&1E
19270 basoff_stracc% = -&600
19280 
19290 Which$ = "BASIC116"
19300 
19310 ENDPROC
19320 
19330 
19340 
19350 DEFPROCdoing_119
19360 
19370 REM RISC OS 4.02 BASIC 1.19
19380 
19390 Patch_Off(1) = &C588
19400 Patch_Off(2) = &A198
19410 Patch_Off(3) = &A35C
19420 Patch_Off(4) = &A14C
19430 Patch_Off(5) = &B204
19440 
19450 Patch_Off(50) = &AFF0
19460 Patch_Off(51) = &B498
19470 Patch_Off(52) = &A194
19480 
19490 basoff_p%      = -&C0
19500 basoff_opt%    = -&1E
19510 basoff_stracc% = -&600
19520 
19530 Which$ = "BASIC119"
19540 
19550 ENDPROC
19560 
19570 
19580 
19590 DEFPROCdoing_120
19600 
19610 REM RISC OS 4.03 BASIC 1.20
19620 
19630 Patch_Off(1) = &C5B8
19640 Patch_Off(2) = &A1CC
19650 Patch_Off(3) = &A390
19660 Patch_Off(4) = &A180
19670 Patch_Off(5) = &B238
19680 
19690 Patch_Off(50) = &B024
19700 Patch_Off(51) = &B4CC
19710 Patch_Off(52) = &A1C8
19720 
19730 basoff_p%      = -&C0
19740 basoff_opt%    = -&1E
19750 basoff_stracc% = -&600
19760 
19770 Which$ = "BASIC120"
19780 
19790 ENDPROC
19800 
19810 
19820 
19830 DEFPROCdoing_120x
19840 
19850 REM RISC OS 4.02 'mystery' BASIC 1.20
19860 
19870 Patch_Off(1) = &C5D4
19880 Patch_Off(2) = &A1E0
19890 Patch_Off(3) = &A3A4
19900 Patch_Off(4) = &A194
19910 Patch_Off(5) = &B24C
19920 
19930 Patch_Off(50) = &B038
19940 Patch_Off(51) = &B4E0
19950 Patch_Off(52) = &A1DC
19960 
19970 basoff_p%      = -&C0
19980 basoff_opt%    = -&1E
19990 basoff_stracc% = -&600
20000 
20010 Which$ = "BASIC120X"
20020 
20030 ENDPROC
20040 
20050 
20060 
20070 DEFPROCdoing_128
20080 
20090 REM RISC OS 4.37 BASIC 1.28
20100 
20110 Patch_Off(1) = &C678
20120 Patch_Off(2) = &A244
20130 Patch_Off(3) = &A408
20140 Patch_Off(4) = &A1F8
20150 Patch_Off(5) = &B300
20160 
20170 Patch_Off(50) = &B0EC
20180 Patch_Off(51) = &B594
20190 Patch_Off(52) = &A240
20200 
20210 basoff_p%      = -&C0
20220 basoff_opt%    = -&1A
20230 basoff_stracc% = -&600
20240 
20250 Which$ = "BASIC128"
20260 
20270 ENDPROC
20280 
20290 
20300 
20310 DEFPROCdoing_129
20320 
20330 REM RISC OS 4.39 BASIC 1.29
20340 
20350 Patch_Off(1) = &C678
20360 Patch_Off(2) = &A244
20370 Patch_Off(3) = &A408
20380 Patch_Off(4) = &A1F8
20390 Patch_Off(5) = &B300
20400 
20410 Patch_Off(50) = &B0EC
20420 Patch_Off(51) = &B594
20430 Patch_Off(52) = &A240
20440 
20450 basoff_p%      = -&C0
20460 basoff_opt%    = -&1A
20470 basoff_stracc% = -&600
20480 
20490 Which$ = "BASIC129"
20500 
20510 ENDPROC
20520 
20530 
20540 
20550 DEFPROCprime(code%, old%)
20560 
20570 PROCcheck(code%, old%, 0)
20580 
20590 ENDPROC
20600 
20610 
20620 
20630 DEFPROCprim4(code%, old%)
20640 
20650 PROCcheck(code%, old%, 4)
20660 
20670 ENDPROC
20680 
20690 
20700 
20710 DEFPROCcheck(code%, old%, choff%)
20720 
20730 P% = Data% + Patch_Off(code%)
20740 
20750 IF `P = %0000 ELSE ENDPROC
20760 
20770 IF P%!choff% <> old% THEN ERROR 66, "Old doesn't match (code " + STR$(code%) + ")"
20780 
20790 ENDPROC