1010 *-------------------------------- 1020 * CONCATENATE TWO STRINGS 1030 *-------------------------------- 1040 CAT LDA FAC+4 SAVE ADDRESS OF FIRST DESCRIPTOR 1050 PHA 1060 LDA FAC+3 1070 PHA 1080 JSR FRM.ELEMENT GET SECOND STRING ELEMENT 1090 JSR CHKSTR MUST BE A STRING 1100 PLA RECOVER ADDRES OF 1ST DESCRIPTOR 1110 STA STRNG1 1120 PLA 1130 STA STRNG1+1 1140 LDY #0 1150 LDA (STRNG1),Y ADD LENGTHS, GET CONCATENATED SIZE 1160 CLC 1170 ADC (FAC+3),Y 1180 BCC .1 OK IF < $100 1190 LDX #ERR.STRLONG 1200 JMP ERROR 1210 .1 JSR STRINI GET SPACE FOR CONCATENATED STRINGS 1220 JSR MOVINS MOVE 1ST STRING 1230 LDA DSCPTR 1240 LDY DSCPTR+1 1250 JSR FRETMP 1260 JSR MOVSTR.1 MOVE 2ND STRING 1270 LDA STRNG1 1280 LDY STRNG1+1 1290 JSR FRETMP 1300 JSR PUTNEW SET UP DESCRIPTOR 1310 JMP FRMEVL.2 FINISH EXPRESSION 1320 *-------------------------------- 1330 * GET STRING DESCRIPTOR POINTED AT BY (STRNG1) 1340 * AND MOVE DESCRIBED STRING TO (FRESPC) 1350 *-------------------------------- 1360 MOVINS LDY #0 1370 LDA (STRNG1),Y 1380 PHA LENGTH 1390 INY 1400 LDA (STRNG1),Y 1410 TAX PUT STRING POINTER IN X,Y 1420 INY 1430 LDA (STRNG1),Y 1440 TAY 1450 PLA RETRIEVE LENGTH 1460 *-------------------------------- 1470 * MOVE STRING AT (Y,X) WITH LENGTH (A) 1480 * TO DESTINATION WHOSE ADDRESS IS IN FRESPC,FRESPC+1 1490 *-------------------------------- 1500 MOVSTR STX INDEX PUT POINTER IN INDEX 1510 STY INDEX+1 1520 MOVSTR.1 1530 TAY LENGTH TO Y-REG 1540 BEQ .2 IF LENGTH IS ZERO, FINISHED 1550 PHA SAVE LENGTH ON STACK 1560 .1 DEY MOVE BYTES FROM (INDEX) TO (FRESPC) 1570 LDA (INDEX),Y 1580 STA (FRESPC),Y 1590 TYA TEST IF ANY LEFT TO MOVE 1600 BNE .1 YES, KEEP MOVING 1610 PLA NO, FINISHED. GET LENGTH 1620 .2 CLC AND ADD TO FRESPC, SO 1630 ADC FRESPC FRESPC POINTS TO NEXT HIGHER 1640 STA FRESPC BYTE. (USED BY CONCATENATION) 1650 BCC .3 1660 INC FRESPC+1 1670 .3 RTS 1680 *-------------------------------- 1690 * IF (FAC) IS A TEMPORARY STRING, RELEASE DESCRIPTOR 1700 *-------------------------------- 1710 FRESTR JSR CHKSTR LAST RESULT A STRING? 1720 *-------------------------------- 1730 * IF STRING DESCRIPTOR POINTED TO BY FAC+3,4 IS 1740 * A TEMPORARY STRING, RELEASE IT. 1750 *-------------------------------- 1760 FREFAC LDA FAC+3 GET DESCRIPTOR POINTER 1770 LDY FAC+4 1780 *-------------------------------- 1790 * IF STRING DESCRIPTOR WHOSE ADDRESS IS IN Y,A IS 1800 * A TEMPORARY STRING, RELEASE IT. 1810 *-------------------------------- 1820 FRETMP STA INDEX SAVE THE ADDRESS OF THE DESCRIPTOR 1830 STY INDEX+1 1840 JSR FRETMS FREE DESCRIPTOR IF IT IS TEMPORARY 1850 PHP REMEMBER IF TEMP 1860 LDY #0 POINT AT LENGTH OF STRING 1870 LDA (INDEX),Y 1880 PHA SAVE LENGTH ON STACK 1890 INY 1900 LDA (INDEX),Y 1910 TAX GET ADDRESS OF STRING IN Y,X 1920 INY 1930 LDA (INDEX),Y 1940 TAY 1950 PLA LENGTH IN A 1960 PLP RETRIEVE STATUS, Z=1 IF TEMP 1970 BNE .2 NOT A TEMPORARY STRING 1980 CPY FRETOP+1 IS IT THE LOWEST STRING? 1990 BNE .2 NO 2000 CPX FRETOP 2010 BNE .2 NO 2020 PHA YES, PUSH LENGTH AGAIN 2030 CLC RECOVER THE SPACE USED BY 2040 ADC FRETOP THE STRING 2050 STA FRETOP 2060 BCC .1 2070 INC FRETOP+1 2080 .1 PLA RETRIEVE LENGTH AGAIN 2090 .2 STX INDEX ADDRESS OF STRING IN Y,X 2100 STY INDEX+1 LENGTH OF STRING IN A-REG 2110 RTS 2120 *-------------------------------- 2130 * RELEASE TEMPORARY DESCRIPTOR IF Y,A = LASTPT 2140 *-------------------------------- 2150 FRETMS CPY LASTPT+1 COMPARE Y,A TO LATEST TEMP 2160 BNE .1 NOT SAME ONE, CANNOT RELEASE 2170 CMP LASTPT 2180 BNE .1 NOT SAME ONE, CANNOT RELEASE 2190 STA TEMPPT UPDATE TEMPT FOR NEXT TEMP 2200 SBC #3 BACK OFF LASTPT 2210 STA LASTPT 2220 LDY #0 NOW Y,A POINTS TO TOP TEMP 2230 .1 RTS Z=0 IF NOT TEMP, Z=1 IF TEMP 2240 *-------------------------------- 2250 * "CHR$" FUNCTION 2260 *-------------------------------- 2270 CHRSTR JSR CONINT CONVERT ARGUMENT TO BYTE IN X 2280 TXA 2290 PHA SAVE IT 2300 LDA #1 GET SPACE FOR STRING OF LENGTH 1 2310 JSR STRSPA 2320 PLA RECALL THE CHARACTER 2330 LDY #0 PUT IN STRING 2340 STA (FAC+1),Y 2350 PLA POP RETURN ADDRESS 2360 PLA 2370 JMP PUTNEW MAKE IT A TEMPORARY STRING 2380 *-------------------------------- 2390 * "LEFT$" FUNCTION 2400 *-------------------------------- 2410 LEFTSTR 2420 JSR SUBSTRING.SETUP 2430 CMP (DSCPTR),Y COMPARE 1ST PARAMETER TO LENGTH 2440 TYA Y=A=0 2450 SUBSTRING.1 2460 BCC .1 1ST PARAMETER SMALLER, USE IT 2470 LDA (DSCPTR),Y 1ST IS LONGER, USE STRING LENGTH 2480 TAX IN X-REG 2490 TYA Y=A=0 AGAIN 2500 .1 PHA PUSH LEFT END OF SUBSTRING 2510 SUBSTRING.2 2520 TXA 2530 SUBSTRING.3 2540 PHA PUSH LENGTH OF SUBSTRING 2550 JSR STRSPA MAKE ROOM FOR STRING OF (A) BYTES 2560 LDA DSCPTR RELEASE PARAMETER STRING IF TEMP 2570 LDY DSCPTR+1 2580 JSR FRETMP 2590 PLA GET LENGTH OF SUBSTRING 2600 TAY IN Y-REG 2610 PLA GET LEFT END OF SUBSTRING 2620 CLC ADD TO POINTER TO STRING 2630 ADC INDEX 2640 STA INDEX 2650 BCC .1 2660 INC INDEX+1 2670 .1 TYA LENGTH 2680 JSR MOVSTR.1 COPY STRING INTO SPACE 2690 JMP PUTNEW ADD TO TEMPS 2700 *-------------------------------- 2710 * "RIGHT$" FUNCTION 2720 *-------------------------------- 2730 RIGHTSTR 2740 JSR SUBSTRING.SETUP 2750 CLC COMPUTE LENGTH-WIDTH OF SUBSTRING 2760 SBC (DSCPTR),Y TO GET STARTING POINT IN STRING 2770 EOR #$FF 2780 JMP SUBSTRING.1 JOIN LEFT$ 2790 *-------------------------------- 2800 * "MID$" FUNCTION 2810 *-------------------------------- 2820 MIDSTR LDA #$FF FLAG WHETHER 2ND PARAMETER 2830 STA FAC+4 2840 JSR CHRGOT SEE IF ")" YET 2850 CMP #')' 2860 BEQ .1 YES, NO 2ND PARAMETER 2870 JSR CHKCOM NO, MUST HAVE COMMA 2880 JSR GETBYT GET 2ND PARAM IN X-REG 2890 .1 JSR SUBSTRING.SETUP 2900 DEX 1ST PARAMETER - 1 2910 TXA 2920 PHA 2930 CLC 2940 LDX #0 2950 SBC (DSCPTR),Y 2960 BCS SUBSTRING.2 2970 EOR #$FF 2980 CMP FAC+4 USE SMALLER OF TWO 2990 BCC SUBSTRING.3 3000 LDA FAC+4 3010 BCS SUBSTRING.3 ...ALWAYS 3020 *-------------------------------- 3030 * COMMON SETUP ROUTINE FOR LEFT$, RIGHT$, MID$: 3040 * REQUIRE ")"; POP RETURN ADRS, GET DESCRIPTOR 3050 * ADDRESS, GET 1ST PARAMETER OF COMMAND 3060 *-------------------------------- 3070 SUBSTRING.SETUP 3080 JSR CHKCLS REQUIRE ")" 3090 PLA SAVE RETURN ADDRESS 3100 TAY IN Y-REG AND LENGTH 3110 PLA 3120 STA LENGTH 3130 PLA POP PREVIOUS RETURN ADDRESS 3140 PLA (FROM GOROUT). 3150 PLA RETRIEVE 1ST PARAMETER 3160 TAX 3170 PLA GET ADDRESS OF STRING DESCRIPTOR 3180 STA DSCPTR 3190 PLA 3200 STA DSCPTR+1 3210 LDA LENGTH RESTORE RETURN ADDRESS 3220 PHA 3230 TYA 3240 PHA 3250 LDY #0 3260 TXA GET 1ST PARAMETER IN A-REG 3270 BEQ GOIQ ERROR IF 0 3280 RTS 3290 *-------------------------------- 3300 * "LEN" FUNCTION 3310 *-------------------------------- 3320 LEN JSR GETSTR GET LENTGH IN Y-REG, MAKE FAC NUMERIC 3330 JMP SNGFLT FLOAT Y-REG INTO FAC 3340 *-------------------------------- 3350 * IF LAST RESULT IS A TEMPORARY STRING, FREE IT 3360 * MAKE VALTYP NUMERIC, RETURN LENGTH IN Y-REG 3370 *-------------------------------- 3380 GETSTR JSR FRESTR IF LAST RESULT IS A STRING, FREE IT 3390 LDX #0 MAKE VALTYP NUMERIC 3400 STX VALTYP 3410 TAY LENGTH OF STRING TO Y-REG 3420 RTS 3430 *-------------------------------- 3440 * "ASC" FUNCTION 3450 *-------------------------------- 3460 ASC JSR GETSTR GET STRING, GET LENGTH IN Y-REG 3470 BEQ GOIQ ERROR IF LENGTH 0 3480 LDY #0 3490 LDA (INDEX),Y GET 1ST CHAR OF STRING 3500 TAY 3510 JMP SNGFLT FLOAT Y-REG INTO FAC 3520 *-------------------------------- 3530 GOIQ JMP IQERR ILLEGAL QUANTITY ERROR 3540 *-------------------------------- 3550 * SCAN TO NEXT CHARACTER AND CONVERT EXPRESSION 3560 * TO SINGLE BYTE IN X-REG 3570 *-------------------------------- 3580 GTBYTC JSR CHRGET 3590 *-------------------------------- 3600 * EVALUATE EXPRESSION AT TXTPTR, AND 3610 * CONVERT IT TO SINGLE BYTE IN X-REG 3620 *-------------------------------- 3630 GETBYT JSR FRMNUM 3640 *-------------------------------- 3650 * CONVERT (FAC) TO SINGLE BYTE INTEGER IN X-REG 3660 *-------------------------------- 3670 CONINT JSR MKINT CONVERT IF IN RANGE -32767 TO +32767 3680 LDX FAC+3 HI-BYTE MUST BE ZERO 3690 BNE GOIQ VALUE > 255, ERROR 3700 LDX FAC+4 VALUE IN X-REG 3710 JMP CHRGOT GET NEXT CHAR IN A-REG 3720 *-------------------------------- 3730 * "VAL" FUNCTION 3740 *-------------------------------- 3750 VAL JSR GETSTR GET POINTER TO STRING IN INDEX 3760 BNE .1 LENGTH NON-ZERO 3770 JMP ZERO.FAC RETURN 0 IF LENGTH=0 3780 .1 LDX TXTPTR SAVE CURRENT TXTPTR 3790 LDY TXTPTR+1 3800 STX STRNG2 3810 STY STRNG2+1 3820 LDX INDEX 3830 STX TXTPTR POINT TXTPTR TO START OF STRING 3840 CLC 3850 ADC INDEX ADD LENGTH 3860 STA DEST POINT DEST TO END OF STRING + 1 3870 LDX INDEX+1 3880 STX TXTPTR+1 3890 BCC .2 3900 INX 3910 .2 STX DEST+1 3920 LDY #0 SAVE BYTE THAT FOLLOWS STRING 3930 LDA (DEST),Y ON STACK 3940 PHA 3950 LDA #0 AND STORE $00 IN ITS PLACE 3960 STA (DEST),Y 3970 * <<< THAT CAUSES A BUG IF HIMEM = $BFFF, >>> 3980 * <<< BECAUSE STORING $00 AT $C000 IS NO >>> 3990 * <<< USE; $C000 WILL ALWAYS BE LAST CHAR >>> 4000 * <<< TYPED, SO FIN WON'T TERMINATE UNTIL >>> 4010 * <<< IT SEES A ZERO AT $C010! >>> 4020 JSR CHRGOT PRIME THE PUMP 4030 JSR FIN EVALUATE STRING 4040 PLA GET BYTE THAT SHOULD FOLLOW STRING 4050 LDY #0 AND PUT IT BACK 4060 STA (DEST),Y 4070 * RESTORE TXTPTR 4080 *-------------------------------- 4090 * COPY STRNG2 INTO TXTPTR 4100 *-------------------------------- 4110 POINT LDX STRNG2 4120 LDY STRNG2+1 4130 STX TXTPTR 4140 STY TXTPTR+1 4150 RTS 4160 *-------------------------------- 4170 * EVALUATE "EXP1,EXP2" 4180 * 4190 * CONVERT EXP1 TO 16-BIT NUMBER IN LINNUM 4200 * CONVERT EXP2 TO 8-BIT NUMBER IN X-REG 4210 *-------------------------------- 4220 GTNUM JSR FRMNUM 4230 JSR GETADR 4240 *-------------------------------- 4250 * EVALUATE ",EXPRESSION" 4260 * CONVERT EXPRESSION TO SINGLE BYTE IN X-REG 4270 *-------------------------------- 4280 COMBYTE 4290 JSR CHKCOM MUST HAVE COMMA FIRST 4300 JMP GETBYT CONVERT EXPRESSION TO BYTE IN X-REG 4310 *-------------------------------- 4320 * CONVERT (FAC) TO A 16-BIT VALUE IN LINNUM 4330 *-------------------------------- 4340 GETADR LDA FAC FAC < 2^16? 4350 CMP #$91 4360 BCS GOIQ NO, ILLEGAL QUANTITY 4370 JSR QINT CONVERT TO INTEGER 4380 LDA FAC+3 COPY IT INTO LINNUM 4390 LDY FAC+4 4400 STY LINNUM TO LINNUM 4410 STA LINNUM+1 4420 RTS 4430 *-------------------------------- 4440 * "PEEK" FUNCTION 4450 *-------------------------------- 4460 PEEK LDA LINNUM SAVE (LINNUM) ON STACK DURING PEEK 4470 PHA 4480 LDA LINNUM+1 4490 PHA 4500 JSR GETADR GET ADDRESS PEEKING AT 4510 LDY #0 4520 LDA (LINNUM),Y TAKE A QUICK LOOK 4530 TAY VALUE IN Y-REG 4540 PLA RESTORE LINNUM FROM STACK 4550 STA LINNUM+1 4560 PLA 4570 STA LINNUM 4580 JMP SNGFLT FLOAT Y-REG INTO FAC 4590 *-------------------------------- 4600 * "POKE" STATEMENT 4610 *-------------------------------- 4620 POKE JSR GTNUM GET THE ADDRESS AND VALUE 4630 TXA VALUE IN A, 4640 LDY #0 4650 STA (LINNUM),Y STORE IT AWAY, 4660 RTS AND THAT'S ALL FOR TODAY 4670 *-------------------------------- 4680 * "WAIT" STATEMENT 4690 *-------------------------------- 4700 WAIT JSR GTNUM GET ADDRESS IN LINNUM, MASK IN X 4710 STX FORPNT SAVE MASK 4720 LDX #0 4730 JSR CHRGOT ANOTHER PARAMETER? 4740 BEQ .1 NO, USE $00 FOR EXCLUSIVE-OR 4750 JSR COMBYTE GET XOR-MASK 4760 .1 STX FORPNT+1 SAVE XOR-MASK HERE 4770 LDY #0 4780 .2 LDA (LINNUM),Y GET BYTE AT ADDRESS 4790 EOR FORPNT+1 INVERT SPECIFIED BITS 4800 AND FORPNT SELECT SPECIFIED BITS 4810 BEQ .2 LOOP TILL NOT 0 4820 RTS.10 RTS