10REM SAVE"$.Arabic.Source.Cli" 20HelpHandler = A% 30PROCConsts 40PROCVars 50DIM O% &BFFF-P% 60Q%=O%:R%=P% 70table=&A8 :REM Safe two-bytes for decoding *-commands ???????? 80data=FNzp(2) 90user=&F2 100Param_Text = 256+1 110Param_Numerals = 256+2 120Param_Off = 256+3 130Param_On = 256+4 140Param_Printer = 256+5 150Param_Normal = 256+6 160Param_Wide = 256+7 170Alphabet_Latin1 = 101 180Alphabet_Latin2 = 102 190Alphabet_Latin3 = 103 200Alphabet_Latin4 = 104 210Alphabet_BFont = 100 220rest_comm_line=&F2 :REM location used by OSCLI for start addr. of command 230text_terminator=&00:REM to be compatible with ROM header 240MaxComLen = 8 :REM Fixed max length of commands used to calc offset 250NumCommands = 9 :REM Number of *-commands recognised 260REM 10 to add *KEYBOARD 270NumParams = 24 :REM No. of different parameters recognised by 280 :REM generic parser. 290osnewl=&FFE7 300oswrch=&FFEE 310FOR Pass=4 TO 6+L% STEP 2+L% 320O%=Q%:P%=R% 330[OPT Pass 340\ 350\******************************************************************* 360\* 370\* Arabic command parser 380\* 390\* Derived from HELP system (hence the label names!) 400\* 410\* On entry (rest_comm_line),Y points to start of the user's command 420\* This routine gets each word and compares it with a table of 430\* keywords. If a match is found, the appropriate code is entered 440\* If a command doesn't match, it is ignored. 450\* 460\* Everything is preserved on exit if the command is not recognised 470\* 480\******************************************************************* 490\ 500.CommandHandler 510\ 520\ 530 Lda user \ preserve parameter pointer 540 Pha \ for other roms. 550 Lda user+1 560 Pha 570 Jsr add_offset \ synchronise pointers for string comparisons 580\ 590.help_skip_spaces 600 Ldy #0 610 Lda (user),Y \ skip leading spaces 620 Cmp #&0D \ check for OSCLI string terminator 630 Beq cli_exit \ Probably can't happen but might as well check 640 Cmp #ASC(" ") 650 Bne help_compare \ if have non-space char, compare strings 660 Inc user 670 Bne help_skip_spaces 680 Inc user+1 690 Bne help_skip_spaces \ always true 700\ 710.help_compare 720 Jsr compare_str \ compare next word in user stream with keywords 730 Bcs cli_exit \ carry set = no match 740 Jsr execute_comm \ Having found the command, now execute it 750 Clc \ Clear carry to tell caller command found 760.cli_exit 770 Pla \ restore parameter pointer 780 Sta user+1 790 Pla 800 Sta user 810\ 820 Rts 830\ 840.ParamHandler 850 Ldy #0 860 Lda (user),Y 870 Cmp #&0D 880 Bne Param_exit_bar:Jmp Param_exit:.Param_exit_bar 890 Cmp #ASC(" ") 900 Bne Param_compare 910 Inc user:Bne p_inc:inc user+1:.p_inc 920 Bra ParamHandler 930 940.Param_compare 950 Jsr compare_param_str 960 Bcs param_not_found:Jmp param_found:.param_not_found 970 PHY 980 OPT FNbreakno(&BA) 990 OPT FNbreakstring("Error: parameter """) 1000 Ply:Phy 1010.spskip 1020 Lda (user),Y 1030 Cmp #&0D:Bne chksp:Jmp false_alarm:.chksp 1040 Cmp #32:Bne errparm 1050 Iny 1060 Bra spskip 1070.errparm 1080 Lda (user),Y:Iny 1090 Cmp #33:Bcc end_err_mess 1100 Sta (table):Inc table:Bne P%+4:Inc table+1 1110 Bra errparm 1120.end_err_mess 1130 OPT FNbreakstring(""" not recognised") 1140 OPT FNdobreak \ Never returns, but if it did you should ... 1150.false_alarm 1160 PLY 1170 Bra param_find_terminator 1180.param_found 1190 Jsr SetParamFlag 1200 Ldy #0 1210.param_find_terminator 1220 Lda (user),Y 1230 Cmp #&0D 1240 Beq Param_exit 1250 Cmp #ASC(" ") 1260 Beq param_synchronise 1270 Cmp #ASC(".") 1280 Beq param_synchronise 1290 Iny 1300 Bra param_find_terminator 1310 1320.param_synchronise 1330 Iny 1340 Jsr add_offset 1350 Jmp Param_compare 1360 1370.Param_exit 1380 1390 1400 1410 1420 1430 1440\ 1450\**************************** 1460\* 1470\* add_offset 1480\* 1490\* adds Y to user,user+1 1500\* to slide the user stream 1510\* under the window (Y) 1520\* 1530\**************************** 1540\ 1550.add_offset 1560 Tya 1570 Clc 1580 Adc user \ add Y to base value to give indexing with Y=0 1590 Sta user \ Y then has a common starting point for 1600 Bcc add_exit \ string comparison 1610 Inc user+1 1620.add_exit 1630 Rts 1640\ 1650\ 1660\********************************* 1670\* 1680\* compare_str 1690\* 1700\* compares a word in the user 1710\* stream with keyword table 1720\* stream 1730\* 1740\* On entry, the streams are 1750\* synchronised. i.e. Y=0 1760\* windows the first char. in 1770\* each 1780\* Abbreviations are recognised. 1790\* On exit, 1800\* Carry clear = match 1810\* Carry set = no match 1820\* user,user+1 point to last 1830\* char. in word and Y=0 1840\* 1850\********************************* 1860\ 1870\ (compare_param_str is a similar procedure for parameter strings) 1880\ 1890.compare_param_str 1900 Lda #param_table MOD &100 1910 Sta table \ pointer to parameter table 1920 Lda #param_table DIV &100 1930 Sta table+1 1940 Ldx #NumParams 1950 Bra compare_loop \ merge two procedure bodies 1960 1970.compare_str 1980 Lda #help_table MOD &100 1990 Sta table \ pointer to keyword table 2000 Lda #help_table DIV &100 2010 Sta table+1 2020 Ldx #NumCommands \ count table entries 2030\ 2040.compare_loop 2050 Ldy #&FF \ initialise window to strings 2060.compare_chars 2070 Iny \ window next pair of chars. - Y always < 255 2080 Lda (user),Y \ get next char. in user stream 2090 Cmp #ASC(".") \ abbreviation match? 2100 Beq compare_skip \ yes. get pointer to display page 2110 Cmp (table),Y \ no. compare with table stream 2120 Beq compare_end 2130 Sec \ no match. lower case? 2140 Sbc #&20 \ lower to upper case displacement 2150 Cmp (table),Y \ try again 2160 Beq compare_end 2170 Cmp #ASC(" ")-&20 \ char mismatch. space vs. return? 2180 Bne compare_table \ no. strings don't match 2190 Lda (table),Y \ yes. see if table stream is 2200 Cmp #&0D 2210 Beq compare_skip \ exact match 2220\ 2230.compare_table \ no match 2240 Cpx #1 \ more table entries to try? 2250 Beq compare_synchronise \ no. 2260 Dex \ yes. get next entry 2270 Lda #12 \ advance pointer to next table entry 2280 Jsr advance_pointer 2290 Jmp compare_loop 2300\ 2310.compare_end 2320 Cmp #&0D \ end of both strings? 2330 Bne compare_chars \ no. keep comparing streams 2340.compare_skip \ match 2350 Jsr add_offset \ point to terminator or dot in user stream 2360 Lda #MaxComLen+2 \ point to display data pointer 2370 Jsr advance_pointer 2380 Ldy #0 \ reset window 2390 Lda (table),Y \ low byte of data pointer 2400 Pha 2410 Iny 2420 Lda (table),Y \ high byte 2430 Sta table+1 2440 Pla 2450 Sta table 2460 Clc \ indicate string match 2470 Bcc compare_exit \ exit with carry flag and pointer 2480\ 2490.compare_synchronise 2500 Jsr add_offset \ point to terminator 2510 Sec \ indicate no match 2520\ 2530.compare_exit 2540 Ldy #0 \ exit pointing to current char. in user stream 2550 Rts \ and with carry flag (clear=match) 2560\ 2570\ 2580\****************************** 2590\* 2600\* advance_pointer 2610\* 2620\* add A to table,table+1 2630\* to get table entries etc. 2640\* 2650\****************************** 2660\ 2670.advance_pointer 2680 Clc 2690 Adc table 2700 Sta table 2710 Bcc advance_exit 2720 Inc table+1 2730.advance_exit 2740 Rts 2750\ 2760\ 2770\********************************** 2780\* 2790\* execute_comm 2800\* 2810\* executes the code pointed to by 2820\* the entry now in (table) 2830\* 2840\********************************** 2850\ 2860.execute_comm 2870 Jmp (table) \ ************ Execute command 2880\ 2890\ 2900\ ----- KEYWORD TABLE AND DISPLAY DATA 2910\ 2920.help_subheadings 2930 EQUS " " \ embedded spaces for summary display 2940.help_table 2950 OPT FNTable("ARABIC", cli_arabic) 2960 OPT FNTable("SCRNFLIP", cli_screenflip) 2970 OPT FNTable("FLIPSCRN", cli_screenflip) 2980 OPT FNTable("FONTFLIP", cli_fontflip) 2990 OPT FNTable("FLIPFONT", cli_fontflip) 3000 OPT FNTable("TEXTFLIP", cli_textflip) 3010 OPT FNTable("FLIPTEXT", cli_textflip) 3020 3030 OPT FNTable("COUNTRY", cli_country) 3040 OPT FNTable("ALPHABET", cli_alphabet) 3050 OPT FNTable("KEYBOARD", cli_keyboard) 3060 3070.param_table 3080 OPT FNTable("DEFAULT", 0) 3090 OPT FNTable("UK", 1) 3100 OPT FNTable("MASTER", 2) 3110 OPT FNTable("COMPACT", 3) 3120 OPT FNTable("SPAIN", 5) 3130 OPT FNTable("GERMANY", 7) 3140 OPT FNTable("ESPERANT", 9) 3150 OPT FNTable("SWEDEN", 11) 3160 OPT FNTable("FINLAND", 12) 3170 OPT FNTable("DENMARK", 14) 3180 OPT FNTable("NORWAY", 15) 3190 OPT FNTable("ARABIC", 21) 3200 3210 OPT FNTable("TEXT", Param_Text) 3220 OPT FNTable("NUMERALS", Param_Numerals) 3230 OPT FNTable("OFF", Param_Off) 3240 OPT FNTable("ON", Param_On) 3250 OPT FNTable("PRINTER", Param_Printer) 3260 OPT FNTable("NORMAL", Param_Normal) 3270 OPT FNTable("WIDE", Param_Wide) 3280 3290 OPT FNTable("LATIN1", Alphabet_Latin1) 3300 OPT FNTable("LATIN2", Alphabet_Latin2) 3310 OPT FNTable("LATIN3", Alphabet_Latin3) 3320 OPT FNTable("LATIN4", Alphabet_Latin4) 3330 OPT FNTable("BFONT", Alphabet_BFont) 3340 3350 3360 3370.cli_arabic OPT FNEnter \ | printer 3380 Lda #ParamList:OPT FNSta(ParamIndex):Jsr ParamHandler 3390 OPT FNLda(ParamIndex): Cmp #ParamList:Bne qq777:Jsr cli_arabic_noparam:Jmp cli_arabic_exit:.qq777 3400 OPT FNLda(ParamList):Cmp #1:Beq qq1:Jsr cli_country_not_allowed:Jmp cli_country_exit:.qq1 3410 OPT FNLda(ParamList+1) 3420 Cmp #Param_Text MOD 256:Bne qq2:Jsr cli_arabic_text:Jmp cli_arabic_exit:.qq2 3430 Cmp #Param_Numerals MOD 256:Bne qq3:Jsr cli_arabic_numerals:Jmp cli_arabic_exit:.qq3 3440 Cmp #Param_Printer MOD 256:Bne qq4:Jsr cli_arabic_printer:Jmp cli_arabic_exit:.qq4 3450 OPT FNbreak(&BB, "Error: Syntax is *ARABIC ") 3460 Rts 3470.cli_arabic_noparam 3480 OPT FNArabicOp(14):OPT FNArabicOp(18):OPT FNSucceeded 3490 OPT FNbreak(&BC, "Warning: *ARABIC not implemented") 3500.cli_country_not_allowed 3510 OPT FNbreak(&BD, "Error: a COUNTRY name is not valid here") 3520.cli_arabic_text 3530 OPT FNLda(ParamIndex):Sec:Sbc #ParamList 3540 Cmp #2:Bne qq5:Jmp cli_arabic_text_on:.qq5 3550 Cmp #4:Bne cli_arabic_text_toomany 3560 Jsr VetP2OnOff 3570 Cmp #0: Bne qq8:Jmp cli_arabic_text_on:.qq8 3580 Cmp #1: Bne qq7:Jmp cli_arabic_text_off:.qq7 3590 OPT FNbreak(&BE, "Error: Syntax is *ARABIC TEXT [on | off]") 3600.cli_arabic_text_toomany 3610 OPT FNbreak(&D9, "Error: too many parameters for *ARABIC TEXT") 3620.cli_arabic_numerals_toomany 3630 OPT FNbreak(&BF, "Error: too many parameters for *ARABIC NUMERALS") 3640.cli_arabic_text_on 3650 OPT FNArabicOp(14):OPT FNSucceeded 3660 OPT FNbreak(&C0, "Warning: *ARABIC TEXT ON not implemented") 3670.cli_arabic_numerals_on 3680 OPT FNArabicOp(18):OPT FNSucceeded 3690 OPT FNbreak(&D5, "Warning: *ARABIC NUMERALS ON not implemented") 3700.cli_arabic_text_off 3710 OPT FNArabicOp(15):OPT FNSucceeded 3720 OPT FNbreak(&C1, "Warning: *ARABIC TEXT OFF not implemented") 3730.cli_arabic_numerals_off 3740 OPT FNArabicOp(19):OPT FNSucceeded 3750 OPT FNbreak(&D4, "Warning: *ARABIC NUMERALS OFF not implemented") 3760.cli_arabic_numerals 3770 OPT FNLda(ParamIndex):Sec:Sbc #ParamList 3780 Cmp #2:Bne qq511:Jmp cli_arabic_numerals_on:.qq511 3790 Cmp #4:Beq qq12:Jmp cli_arabic_numerals_toomany:.qq12 3800 Jsr VetP2OnOff 3810 Cmp #0: Bne qq811:Jmp cli_arabic_numerals_on:.qq811 3820 Cmp #1: Bne qq711:Jmp cli_arabic_numerals_off:.qq711 3830 OPT FNbreak(&C2, "Error: Syntax is *ARABIC NUMERALS [on | off]") 3840.cli_arabic_printer 3850 OPT FNbreak(&C3, "Warning: *ARABIC PRINTER not implemented") 3860.cli_screenflip OPT FNEnter \ "", "Arabic", "UK" 3870 Jsr FlipParam 3880 Cmp #0:Bne qq42:Jsr screenflip:Jmp cli_screenflip_exit:.qq42 3890 Cmp #1:Bne ww99: Jsr screenflip_arabic:Jmp cli_screenflip_exit:.ww99 3900 Cmp #2:Bne qq142:Jsr screenflip_uk:Jmp cli_screenflip_exit:.qq142 3910 OPT FNbreak(&C4, "Error: Syntax is *SCRNFLIP < UK | Arabic >") 3920.screenflip_arabic 3930 OPT FNArabicOp(2):OPT FNSucceeded 3940 OPT FNbreak(&C5, "Warning: *SCRNFLIP ARABIC not implemented") 3950.screenflip_uk 3960 OPT FNArabicOp(3):OPT FNSucceeded 3970 OPT FNbreak(&C6, "Warning: *SCRNFLIP UK not implemented") 3980.screenflip 3990 OPT FNArabicOp(1):OPT FNSucceeded 4000 OPT FNbreak(&C7, "Warning: *SCRNFLIP not implemented") 4010\\\ Jsr FlipHandler\(A) - parameter in AND 4020 Rts 4030.cli_fontflip OPT FNEnter \ "", "Arabic", "UK" 4040 Jsr FlipParam 4050 Cmp #0:Bne ww88:Jsr fontflip:Jmp cli_fontflip_exit:.ww88 4060 Cmp #1:Bne qq987:Jsr fontflip_arabic:Jmp cli_fontflip_exit:.qq987 4070 Cmp #2:Bne qq14:Jsr fontflip_uk:Jmp cli_fontflip_exit:.qq14 4080 OPT FNbreak(&C8, "Error: Syntax is *FONTFLIP < UK | Arabic >") 4090 Rts 4100.fontflip 4110 OPT FNArabicOp(4):OPT FNSucceeded 4120 OPT FNbreak(&C9, "Warning: *FONTFLIP not implemented") 4130.fontflip_arabic 4140 OPT FNArabicOp(6):OPT FNSucceeded 4150 OPT FNbreak(&CA, "Warning: *FONTFLIP ARABIC not implemented") 4160.fontflip_uk 4170 OPT FNArabicOp(7):OPT FNSucceeded 4180 OPT FNbreak(&CB, "Warning: *FONTFLIP UK not implemented") 4190.cli_textflip OPT FNEnter \ "", "Arabic", "UK" 4200 Jsr FlipParam 4210 Cmp #0:Bne ww77:Jsr textflip:Jmp cli_textflip_exit:.ww77 4220 Cmp #1:Bne qq345:Jsr textflip_arabic:Jmp cli_textflip_exit:.qq345 4230 Cmp #2:Bne qq141:Jsr textflip_uk:Jmp cli_textflip_exit:.qq141 4240 OPT FNbreak(&CD, "Error: Syntax is *TEXTFLIP < UK | Arabic >") 4250 Rts 4260.textflip 4270 OPT FNArabicOp(8):OPT FNSucceeded 4280 OPT FNbreak(&CE, "Warning: *TEXTFLIP not implemented") 4290.textflip_arabic 4300 OPT FNArabicOp(10):OPT FNSucceeded 4310 OPT FNbreak(&CF, "Warning: *TEXTFLIP ARABIC not implemented") 4320.textflip_uk 4330 OPT FNArabicOp(11):OPT FNSucceeded 4340 OPT FNbreak(&D0, "Warning: *TEXTFLIP UK not implemented") 4350 4360.VetP2OnOff 4370 OPT FNLda(ParamIndex):Sec:Sbc #ParamList 4380 Cmp #2:Beq Return_on 4390 Cmp #4:Beq qq6:Jmp cli_arabic_text_toomany:.qq6 4400 OPT FNLda(ParamList+2):Cmp #1:Beq qq9:Jmp cli_country_not_allowed:.qq9 4410 OPT FNLda(ParamList+3) 4420 Cmp #Param_On MOD 256:Beq Return_on 4430 Cmp #Param_Off MOD 256:Beq Return_off 4440 Lda #&FF:Rts 4450.Return_on Lda #0:Rts 4460.Return_off Lda #1:Rts 4470 4480.FlipParam 4490 \ Vet "", "ARABIC", "UK" and return 0, 1 & 2 respectively in A 4500 Lda #ParamList:OPT FNSta(ParamIndex) 4510 Jsr ParamHandler 4520 OPT FNLda(ParamIndex):Sec:Sbc #ParamList 4530 Cmp #0: Beq UkArabic_noparam 4540 Cmp #4: Beq UkArabic_toomany 4550 OPT FNLda(ParamList) 4560 Cmp #0:Bne UkArabic_wrong 4570 OPT FNLda(ParamList+1) 4580 Cmp #21:Beq UkArabic_Arabic 4590 Cmp #1:Beq UkArabic_UK 4600.UkArabic_toomany 4610.UkArabic_wrong 4620 Lda #&FF 4630 Rts 4640 4650.UkArabic_Arabic Lda #1:Rts 4660.UkArabic_UK Lda #2:Rts 4670.UkArabic_noparam Lda #0:Rts 4680 4690.SetParamFlag \ Note all parameters received and let each command 4700 \ ask it its parameter was among them. Any left over 4710 \ at the end OUGHT to be complained about! 4720 Lda table:PHA:Lda table+1:PHA 4730 OPT FNLda(ParamIndex):Tay 4740 PLA:Sta (data),Y:Iny 4750 PLA:Sta (data),Y:Iny 4760 Tya:OPT FNSta(ParamIndex) 4770 Rts 4780 4790.PHEX 4800 PHA 4810 Lsr A:Lsr A:Lsr A:Lsr A 4820 Jsr PN 4830 PLA 4840.PN 4850 And #15 4860 Cmp #10 4870 Bcc zzz1 4880 Adc #6 4890.zzz1 4900 Adc #ASC("0") 4910 Jmp oswrch 4920 4930 4940 4950 4960.cli_country OPT FNEnter 4970 Lda #ParamList:OPT FNSta(ParamIndex) \ Pointer to next free slot 4980 Jsr ParamHandler 4990 OPT FNLda(ParamIndex) 5000 Cmp #ParamList 5010 Bne country_params_given 5020 OPT FNbreak(&D1,"Error: Syntax is *COUNTRY ") 5030.country_params_given 5040 Sec:Sbc #ParamList 5050 Cmp #2:Beq country_one_param 5060 OPT FNbreak(&D2,"Error: too many parameters for *Country") 5070.country_one_param 5080 OPT FNLda(ParamList) 5090 Cmp #0 5100 Beq is_a_country 5110 OPT FNbreak(&D3,"Error: parameter must be a COUNTRY name") 5120.is_a_country 5130 OPT FNLda(ParamList+1) 5140 Tax 5150 PHX 5160 Lda #70 \ *COUNTRY osbyte (documented elsewhere as *FX 240 !!) 5170 Ldy #0 5180 Jsr OsByte \ Set *COUNTRY 5190 PLX:PHX 5200 Lda #71 5210 Ldy #0 5220 Jsr OsByte \ Explicitly set *Keyboard (This will work when paul fixes his code) 5230 PLA:Ora #128:Tax 5240 Lda #71 5250 Ldy #0 5260 Jsr OsByte \ And Explicitly set *Alphabet 5270 Jmp cli_country_exit 5280 5290.cli_alphabet OPT FNEnter 5300 Lda #ParamList:OPT FNSta(ParamIndex) \ Pointer to next free slot 5310 Jsr ParamHandler 5320 OPT FNLda(ParamIndex) 5330 Cmp #ParamList 5340 Bne alphabet_params_given 5350 OPT FNbreak(&D6,"Error: Syntax is *ALPHABET ") 5360.alphabet_params_given 5370 Sec:Sbc #ParamList 5380 Cmp #2:Beq alphabet_one_param 5390 OPT FNbreak(&D7,"Error: too many parameters for *Alphabet") 5400.alphabet_one_param 5410 OPT FNLda(ParamList) 5420 Cmp #0 5430 Beq is_an_alphabet 5440 OPT FNbreak(&D8,"Error: parameter must be an ALPHABET name") 5450.is_an_alphabet 5460 OPT FNLda(ParamList+1) 5470 Tax 5480 Lda #71 \ *ALPHABET/*KEYBOARD osbyte 5490 Ldy #0 5500 Jsr OsByte 5510 Jmp cli_alphabet_exit 5520 Rts 5530 5540.cli_keyboard OPT FNEnter 5550 Lda #ParamList:OPT FNSta(ParamIndex) \ Pointer to next free slot 5560 Jsr ParamHandler 5570 OPT FNLda(ParamIndex) 5580 Cmp #ParamList 5590 Bne keyboard_params_given 5600 OPT FNbreak(&D9,"Error: Syntax is *Keyboard ") 5610.keyboard_params_given 5620 Sec:Sbc #ParamList 5630 Cmp #2:Beq keyboard_one_param 5640 OPT FNbreak(&D7,"Error: too many parameters for *Keyboard") 5650.keyboard_one_param 5660 OPT FNLda(ParamList) 5670 Cmp #0 5680 Beq is_a_keyboard 5690 OPT FNbreak(&D8,"Error: parameter must be a COUNTRY name") 5700.is_a_keyboard 5710 OPT FNLda(ParamList+1) 5720 Ora #128:Tax \ Set top bit for *KEYBOARD osbyte 5730 Lda #71 \ *ALPHABET/*KEYBOARD osbyte 5740 Ldy #0 5750 Jsr OsByte 5760 Jmp cli_keyboard_exit 5770 Rts 5780 5790.cli_screenflip_exit OPT FNExit:Rts 5800.cli_fontflip_exit OPT FNExit:Rts 5810.cli_textflip_exit OPT FNExit:Rts 5820.cli_country_exit OPT FNExit:Rts 5830.cli_alphabet_exit OPT FNExit:Rts 5840.cli_keyboard_exit OPT FNExit:Rts 5850.cli_arabic_exit OPT FNExit:Rts 5860] 5870NEXT Pass 5880OSCLI("SAVE $.Arabic.Object.CLIOBJ "+STR$~(Q%)+" "+STR$~(O%)+" "+STR$~(R%-&8000+&3000)+" "+STR$~(R%-&8000+&3000)) 5890B%=CommandHandler 5900CHAIN"$.Arabic.Source.Help" 5910 5920DEFFNbreak(Num, Mess$) 5930[OPT Pass 5940 Bra P%+LEN(Mess$)+2+1+1+1 5950.anylabel 5960 BRK:EQUB Num:EQUS Mess$:EQUB 0 5970.calculated_branch 5980 Lda #anylabel MOD 256:Sta table 5990 Lda #anylabel DIV 256:Sta table+1 6000 Ldy #0 6010.copyerr 6020 Lda (table),Y 6030 Sta &100,Y 6040 Iny 6050 Cpy #calculated_branch-anylabel 6060 Bne copyerr 6070 Jsr &100 \ Return address for possible debug help later 6080] 6090=Pass 6100 6110DEFFNprintstring(Mess$) 6120[OPT Pass 6130 Bra P%+LEN(Mess$)+2 6140.anylabel 6150 EQUS Mess$ 6160.calculated_branch 6170 Lda #anylabel MOD 256:Sta table 6180 Lda #anylabel DIV 256:Sta table+1 6190 Ldy #0 6200.copyerr 6210 Lda (table),Y 6220 Jsr oswrch 6230 Iny 6240 Cpy #calculated_branch-anylabel 6250 Bne copyerr 6260] 6270=Pass 6280 6290DEFFNTable(Name$, Val) 6300LOCAL name:DIM name 15:name!0=&0D0D0D0D:name!4=&0D0D0D0D:$name=Name$ 6310[OPT Pass 6320 EQUD name!0 6330 EQUD name!4 6340 EQUB 13 6350 EQUB text_terminator 6360 EQUW Val 6370] 6380=Pass 6390 6400DEFFNRelocate(from, to, ram) 6410IF (ram+to-from)>=&100 THEN =FNLongRelocate(from, to, ram) 6420[OPT Pass 6430 Ldx #0:Ldy #ram \ Y is pointer, X is counter 6440.copy 6450 Lda from,X: Sta (data),Y 6460 Iny 6470 Inx:Cpx #to-from:Bne copy 6480] 6490=Pass 6500 6510DEFFNAddr(offset) 6520IF offset >= &100 THEN =FNLongAddr(offset) 6530[OPT Pass 6540 PHP:PHA:Ldx &F4:Lda &DF0,X:Tay:Ldx #offset:PLA:PLP 6550] 6560=Pass 6570 6580DEFFNJmp(offset) : REM Jumps to private ram - absolute NOT indirect. 6590IF offset >= &100 THEN =FNLongJmp(offset) 6600[OPT Pass 6610 PHP:PHA:PHX 6620 Ldx &F4:Lda &DF0,X:Sta very_temp+1:Lda #offset:Sta very_temp 6630 PLX:PLA:PLP 6640 Jmp (very_temp) 6650] 6660=Pass 6670 6680DEFFNJmpI(offset) : REM Jumps VIA private ram - indirect. 6690IF offset >= &100 THEN =FNLongJmpI(offset) 6700[OPT Pass 6710 PHP:PHA:PHX 6720 Ldx &F4:Lda &DF0,X:Sta very_temp+1:Lda #offset:Sta very_temp 6730 Lda (very_temp):Pha:Inc very_temp:Bne P%+4:Inc very_temp+1 6740 6750 6760 6770 6780 6790 6800 Lda (very_temp):Sta very_temp+1:Pla:Sta very_temp 6810 PLX:PLA:PLP 6820 Jmp (very_temp) 6830] 6840=Pass 6850 6860DEFPROCConsts 6870 REM MyXXX's are initialised here for 6880 REM 2-pass assembly in Basic. 6890Ins = 21 : InsV = FNVector(Ins) 6900OsByte = &FFF4 6910Byte = 5 : ByteV = FNVector(Byte) 6920OsWord = &FFF1 6930OsCli = &FFF7 6940OsRdCh = &FFE0 6950RdCh = 8 : RdChV = FNVector(RdCh) 6960OsRdSc = &FFB9 6970OsWrCh = &FFEE 6980OsNewl = &FFE7 6990OsAscii = &FFE3 7000OsWrSc = &FFB3 7010OsFind = &FFCE 7020OsFile = &FFDD 7030OsArgs = &FFDA 7040OsGbPb = &FFD1 7050OsBPut = &FFD4 7060OsBGet = &FFD7 7070OsEvent = &FFBF 7080GSInit = &FFC2 7090GSRead = &FFC5 7100ENDPROC 7110 7120DEFFNVector(N) 7130 = &200 + 2*N 7140 7150DEFPROCVars 7160 ParamIndex = FNRmb(1) 7170 ParamList = FNRmb(10) 7180ENDPROC 7190 7200DEFFNzp(N) 7210LOCAL I 7220 I = N% 7230 N% = N% + N 7240 IF N% > Z% THEN PRINT"ERROR: Using too much zero page.":END 7250 = I 7260 7270DEFFNRmb(N) 7280LOCAL I 7290 I = M% 7300 M% = M% + N 7310 = I 7320 7330DEFFNEnter : REM Called once on entry to Rom 7340 REM Sets uplocal data area for easy access 7350[OPT Pass 7360 Lda data:PHA 7370 Lda data+1:PHA 7380 Phx:Ldx &F4:Lda &DF0,X:Plx 7390 Sta data+1 7400 Stz data 7410] 7420=Pass 7430 7440DEFFNLda(variable_offset) 7450[OPT Pass 7460 Ldy #variable_offset:Lda (data),Y 7470] 7480=Pass 7490 7500DEFFNSta(variable_offset) 7510[OPT Pass 7520 Ldy #variable_offset:Sta (data),Y 7530] 7540=Pass 7550 7560DEFFNExit :REM Called once on exit from Rom 7570[OPT Pass 7580 Pla: Sta data+1 7590 Pla: Sta data 7600] 7610=Pass 7620DEFFNbreakno(Num) 7630[OPT Pass 7640 Lda #0:Sta table:Lda #1:Sta table+1 7650 Lda #0:Sta (table):Inc table:Bne P%+4:Inc table+1 7660 Lda #Num:Sta (table):Inc table:Bne P%+4:Inc table+1 7670] 7680=Pass 7690 7700DEFFNbreakstring(Str$) 7710LOCAL s:DIM s LEN(Str$):$s=Str$ 7720FOR idx = 0 TO LEN(Str$)-1 7730 [OPT Pass: Lda #(s?idx):Sta (table):Inc table:Bne P%+4:Inc table+1:] 7740NEXT 7750=Pass 7760 7770DEFFNdobreak 7780[OPT Pass 7790 Lda #0:Sta (table) 7800 Jsr &100 \ Return address for possible debug help later 7810] 7820=Pass 7830 7840DEFFNArabicOp(YReg) 7850[OPT Pass 7860 Lda #70:Ldx #21:Ldy #YReg 7870 Jsr OsByte 7880] 7890=Pass 7900 7910DEFFNSucceeded 7920[OPT Pass 7930 Cmp #70:Beq P%+2+1:Rts 7940] 7950=Pass