S-C DocuMentor — Applesoft
SAVE S.E597
1010 *--------------------------------
1020 * CONCATENATE TWO STRINGS
1030 *--------------------------------
E597- A5 A1 1040 CAT LDA FAC+4 SAVE ADDRESS OF FIRST DESCRIPTOR
E599- 48 1050 PHA
E59A- A5 A0 1060 LDA FAC+3
E59C- 48 1070 PHA
E59D- 20 60 DE 1080 JSR FRM.ELEMENT GET SECOND STRING ELEMENT
E5A0- 20 6C DD 1090 JSR CHKSTR MUST BE A STRING
E5A3- 68 1100 PLA RECOVER ADDRES OF 1ST DESCRIPTOR
E5A4- 85 AB 1110 STA STRNG1
E5A6- 68 1120 PLA
E5A7- 85 AC 1130 STA STRNG1+1
E5A9- A0 00 1140 LDY #0
E5AB- B1 AB 1150 LDA (STRNG1),Y ADD LENGTHS, GET CONCATENATED SIZE
E5AD- 18 1160 CLC
E5AE- 71 A0 1170 ADC (FAC+3),Y
E5B0- 90 05 1180 BCC .1 OK IF < $100
E5B2- A2 B0 1190 LDX #ERR.STRLONG
E5B4- 4C 12 D4 1200 JMP ERROR
E5B7- 20 D5 E3 1210 .1 JSR STRINI GET SPACE FOR CONCATENATED STRINGS
E5BA- 20 D4 E5 1220 JSR MOVINS MOVE 1ST STRING
E5BD- A5 8C 1230 LDA DSCPTR
E5BF- A4 8D 1240 LDY DSCPTR+1
E5C1- 20 04 E6 1250 JSR FRETMP
E5C4- 20 E6 E5 1260 JSR MOVSTR.1 MOVE 2ND STRING
E5C7- A5 AB 1270 LDA STRNG1
E5C9- A4 AC 1280 LDY STRNG1+1
E5CB- 20 04 E6 1290 JSR FRETMP
E5CE- 20 2A E4 1300 JSR PUTNEW SET UP DESCRIPTOR
E5D1- 4C 95 DD 1310 JMP FRMEVL.2 FINISH EXPRESSION
1320 *--------------------------------
1330 * GET STRING DESCRIPTOR POINTED AT BY (STRNG1)
1340 * AND MOVE DESCRIBED STRING TO (FRESPC)
1350 *--------------------------------
E5D4- A0 00 1360 MOVINS LDY #0
E5D6- B1 AB 1370 LDA (STRNG1),Y
E5D8- 48 1380 PHA LENGTH
E5D9- C8 1390 INY
E5DA- B1 AB 1400 LDA (STRNG1),Y
E5DC- AA 1410 TAX PUT STRING POINTER IN X,Y
E5DD- C8 1420 INY
E5DE- B1 AB 1430 LDA (STRNG1),Y
E5E0- A8 1440 TAY
E5E1- 68 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 *--------------------------------
E5E2- 86 5E 1500 MOVSTR STX INDEX PUT POINTER IN INDEX
E5E4- 84 5F 1510 STY INDEX+1
1520 MOVSTR.1
E5E6- A8 1530 TAY LENGTH TO Y-REG
E5E7- F0 0A 1540 BEQ .2 IF LENGTH IS ZERO, FINISHED
E5E9- 48 1550 PHA SAVE LENGTH ON STACK
E5EA- 88 1560 .1 DEY MOVE BYTES FROM (INDEX) TO (FRESPC)
E5EB- B1 5E 1570 LDA (INDEX),Y
E5ED- 91 71 1580 STA (FRESPC),Y
E5EF- 98 1590 TYA TEST IF ANY LEFT TO MOVE
E5F0- D0 F8 1600 BNE .1 YES, KEEP MOVING
E5F2- 68 1610 PLA NO, FINISHED. GET LENGTH
E5F3- 18 1620 .2 CLC AND ADD TO FRESPC, SO
E5F4- 65 71 1630 ADC FRESPC FRESPC POINTS TO NEXT HIGHER
E5F6- 85 71 1640 STA FRESPC BYTE. (USED BY CONCATENATION)
E5F8- 90 02 1650 BCC .3
E5FA- E6 72 1660 INC FRESPC+1
E5FC- 60 1670 .3 RTS
1680 *--------------------------------
1690 * IF (FAC) IS A TEMPORARY STRING, RELEASE DESCRIPTOR
1700 *--------------------------------
E5FD- 20 6C DD 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 *--------------------------------
E600- A5 A0 1760 FREFAC LDA FAC+3 GET DESCRIPTOR POINTER
E602- A4 A1 1770 LDY FAC+4
1780 *--------------------------------
1790 * IF STRING DESCRIPTOR WHOSE ADDRESS IS IN Y,A IS
1800 * A TEMPORARY STRING, RELEASE IT.
1810 *--------------------------------
E604- 85 5E 1820 FRETMP STA INDEX SAVE THE ADDRESS OF THE DESCRIPTOR
E606- 84 5F 1830 STY INDEX+1
E608- 20 35 E6 1840 JSR FRETMS FREE DESCRIPTOR IF IT IS TEMPORARY
E60B- 08 1850 PHP REMEMBER IF TEMP
E60C- A0 00 1860 LDY #0 POINT AT LENGTH OF STRING
E60E- B1 5E 1870 LDA (INDEX),Y
E610- 48 1880 PHA SAVE LENGTH ON STACK
E611- C8 1890 INY
E612- B1 5E 1900 LDA (INDEX),Y
E614- AA 1910 TAX GET ADDRESS OF STRING IN Y,X
E615- C8 1920 INY
E616- B1 5E 1930 LDA (INDEX),Y
E618- A8 1940 TAY
E619- 68 1950 PLA LENGTH IN A
E61A- 28 1960 PLP RETRIEVE STATUS, Z=1 IF TEMP
E61B- D0 13 1970 BNE .2 NOT A TEMPORARY STRING
E61D- C4 70 1980 CPY FRETOP+1 IS IT THE LOWEST STRING?
E61F- D0 0F 1990 BNE .2 NO
E621- E4 6F 2000 CPX FRETOP
E623- D0 0B 2010 BNE .2 NO
E625- 48 2020 PHA YES, PUSH LENGTH AGAIN
E626- 18 2030 CLC RECOVER THE SPACE USED BY
E627- 65 6F 2040 ADC FRETOP THE STRING
E629- 85 6F 2050 STA FRETOP
E62B- 90 02 2060 BCC .1
E62D- E6 70 2070 INC FRETOP+1
E62F- 68 2080 .1 PLA RETRIEVE LENGTH AGAIN
E630- 86 5E 2090 .2 STX INDEX ADDRESS OF STRING IN Y,X
E632- 84 5F 2100 STY INDEX+1 LENGTH OF STRING IN A-REG
E634- 60 2110 RTS
2120 *--------------------------------
2130 * RELEASE TEMPORARY DESCRIPTOR IF Y,A = LASTPT
2140 *--------------------------------
E635- C4 54 2150 FRETMS CPY LASTPT+1 COMPARE Y,A TO LATEST TEMP
E637- D0 0C 2160 BNE .1 NOT SAME ONE, CANNOT RELEASE
E639- C5 53 2170 CMP LASTPT
E63B- D0 08 2180 BNE .1 NOT SAME ONE, CANNOT RELEASE
E63D- 85 52 2190 STA TEMPPT UPDATE TEMPT FOR NEXT TEMP
E63F- E9 03 2200 SBC #3 BACK OFF LASTPT
E641- 85 53 2210 STA LASTPT
E643- A0 00 2220 LDY #0 NOW Y,A POINTS TO TOP TEMP
E645- 60 2230 .1 RTS Z=0 IF NOT TEMP, Z=1 IF TEMP
2240 *--------------------------------
2250 * "CHR$" FUNCTION
2260 *--------------------------------
E646- 20 FB E6 2270 CHRSTR JSR CONINT CONVERT ARGUMENT TO BYTE IN X
E649- 8A 2280 TXA
E64A- 48 2290 PHA SAVE IT
E64B- A9 01 2300 LDA #1 GET SPACE FOR STRING OF LENGTH 1
E64D- 20 DD E3 2310 JSR STRSPA
E650- 68 2320 PLA RECALL THE CHARACTER
E651- A0 00 2330 LDY #0 PUT IN STRING
E653- 91 9E 2340 STA (FAC+1),Y
E655- 68 2350 PLA POP RETURN ADDRESS
E656- 68 2360 PLA
E657- 4C 2A E4 2370 JMP PUTNEW MAKE IT A TEMPORARY STRING
2380 *--------------------------------
2390 * "LEFT$" FUNCTION
2400 *--------------------------------
2410 LEFTSTR
E65A- 20 B9 E6 2420 JSR SUBSTRING.SETUP
E65D- D1 8C 2430 CMP (DSCPTR),Y COMPARE 1ST PARAMETER TO LENGTH
E65F- 98 2440 TYA Y=A=0
2450 SUBSTRING.1
E660- 90 04 2460 BCC .1 1ST PARAMETER SMALLER, USE IT
E662- B1 8C 2470 LDA (DSCPTR),Y 1ST IS LONGER, USE STRING LENGTH
E664- AA 2480 TAX IN X-REG
E665- 98 2490 TYA Y=A=0 AGAIN
E666- 48 2500 .1 PHA PUSH LEFT END OF SUBSTRING
2510 SUBSTRING.2
E667- 8A 2520 TXA
2530 SUBSTRING.3
E668- 48 2540 PHA PUSH LENGTH OF SUBSTRING
E669- 20 DD E3 2550 JSR STRSPA MAKE ROOM FOR STRING OF (A) BYTES
E66C- A5 8C 2560 LDA DSCPTR RELEASE PARAMETER STRING IF TEMP
E66E- A4 8D 2570 LDY DSCPTR+1
E670- 20 04 E6 2580 JSR FRETMP
E673- 68 2590 PLA GET LENGTH OF SUBSTRING
E674- A8 2600 TAY IN Y-REG
E675- 68 2610 PLA GET LEFT END OF SUBSTRING
E676- 18 2620 CLC ADD TO POINTER TO STRING
E677- 65 5E 2630 ADC INDEX
E679- 85 5E 2640 STA INDEX
E67B- 90 02 2650 BCC .1
E67D- E6 5F 2660 INC INDEX+1
E67F- 98 2670 .1 TYA LENGTH
E680- 20 E6 E5 2680 JSR MOVSTR.1 COPY STRING INTO SPACE
E683- 4C 2A E4 2690 JMP PUTNEW ADD TO TEMPS
2700 *--------------------------------
2710 * "RIGHT$" FUNCTION
2720 *--------------------------------
2730 RIGHTSTR
E686- 20 B9 E6 2740 JSR SUBSTRING.SETUP
E689- 18 2750 CLC COMPUTE LENGTH-WIDTH OF SUBSTRING
E68A- F1 8C 2760 SBC (DSCPTR),Y TO GET STARTING POINT IN STRING
E68C- 49 FF 2770 EOR #$FF
E68E- 4C 60 E6 2780 JMP SUBSTRING.1 JOIN LEFT$
2790 *--------------------------------
2800 * "MID$" FUNCTION
2810 *--------------------------------
E691- A9 FF 2820 MIDSTR LDA #$FF FLAG WHETHER 2ND PARAMETER
E693- 85 A1 2830 STA FAC+4
E695- 20 B7 00 2840 JSR CHRGOT SEE IF ")" YET
E698- C9 29 2850 CMP #')'
E69A- F0 06 2860 BEQ .1 YES, NO 2ND PARAMETER
E69C- 20 BE DE 2870 JSR CHKCOM NO, MUST HAVE COMMA
E69F- 20 F8 E6 2880 JSR GETBYT GET 2ND PARAM IN X-REG
E6A2- 20 B9 E6 2890 .1 JSR SUBSTRING.SETUP
E6A5- CA 2900 DEX 1ST PARAMETER - 1
E6A6- 8A 2910 TXA
E6A7- 48 2920 PHA
E6A8- 18 2930 CLC
E6A9- A2 00 2940 LDX #0
E6AB- F1 8C 2950 SBC (DSCPTR),Y
E6AD- B0 B8 2960 BCS SUBSTRING.2
E6AF- 49 FF 2970 EOR #$FF
E6B1- C5 A1 2980 CMP FAC+4 USE SMALLER OF TWO
E6B3- 90 B3 2990 BCC SUBSTRING.3
E6B5- A5 A1 3000 LDA FAC+4
E6B7- B0 AF 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
E6B9- 20 B8 DE 3080 JSR CHKCLS REQUIRE ")"
E6BC- 68 3090 PLA SAVE RETURN ADDRESS
E6BD- A8 3100 TAY IN Y-REG AND LENGTH
E6BE- 68 3110 PLA
E6BF- 85 91 3120 STA LENGTH
E6C1- 68 3130 PLA POP PREVIOUS RETURN ADDRESS
E6C2- 68 3140 PLA (FROM GOROUT).
E6C3- 68 3150 PLA RETRIEVE 1ST PARAMETER
E6C4- AA 3160 TAX
E6C5- 68 3170 PLA GET ADDRESS OF STRING DESCRIPTOR
E6C6- 85 8C 3180 STA DSCPTR
E6C8- 68 3190 PLA
E6C9- 85 8D 3200 STA DSCPTR+1
E6CB- A5 91 3210 LDA LENGTH RESTORE RETURN ADDRESS
E6CD- 48 3220 PHA
E6CE- 98 3230 TYA
E6CF- 48 3240 PHA
E6D0- A0 00 3250 LDY #0
E6D2- 8A 3260 TXA GET 1ST PARAMETER IN A-REG
E6D3- F0 1D 3270 BEQ GOIQ ERROR IF 0
E6D5- 60 3280 RTS
3290 *--------------------------------
3300 * "LEN" FUNCTION
3310 *--------------------------------
E6D6- 20 DC E6 3320 LEN JSR GETSTR GET LENTGH IN Y-REG, MAKE FAC NUMERIC
E6D9- 4C 01 E3 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 *--------------------------------
E6DC- 20 FD E5 3380 GETSTR JSR FRESTR IF LAST RESULT IS A STRING, FREE IT
E6DF- A2 00 3390 LDX #0 MAKE VALTYP NUMERIC
E6E1- 86 11 3400 STX VALTYP
E6E3- A8 3410 TAY LENGTH OF STRING TO Y-REG
E6E4- 60 3420 RTS
3430 *--------------------------------
3440 * "ASC" FUNCTION
3450 *--------------------------------
E6E5- 20 DC E6 3460 ASC JSR GETSTR GET STRING, GET LENGTH IN Y-REG
E6E8- F0 08 3470 BEQ GOIQ ERROR IF LENGTH 0
E6EA- A0 00 3480 LDY #0
E6EC- B1 5E 3490 LDA (INDEX),Y GET 1ST CHAR OF STRING
E6EE- A8 3500 TAY
E6EF- 4C 01 E3 3510 JMP SNGFLT FLOAT Y-REG INTO FAC
3520 *--------------------------------
E6F2- 4C 99 E1 3530 GOIQ JMP IQERR ILLEGAL QUANTITY ERROR
3540 *--------------------------------
3550 * SCAN TO NEXT CHARACTER AND CONVERT EXPRESSION
3560 * TO SINGLE BYTE IN X-REG
3570 *--------------------------------
E6F5- 20 B1 00 3580 GTBYTC JSR CHRGET
3590 *--------------------------------
3600 * EVALUATE EXPRESSION AT TXTPTR, AND
3610 * CONVERT IT TO SINGLE BYTE IN X-REG
3620 *--------------------------------
E6F8- 20 67 DD 3630 GETBYT JSR FRMNUM
3640 *--------------------------------
3650 * CONVERT (FAC) TO SINGLE BYTE INTEGER IN X-REG
3660 *--------------------------------
E6FB- 20 08 E1 3670 CONINT JSR MKINT CONVERT IF IN RANGE -32767 TO +32767
E6FE- A6 A0 3680 LDX FAC+3 HI-BYTE MUST BE ZERO
E700- D0 F0 3690 BNE GOIQ VALUE > 255, ERROR
E702- A6 A1 3700 LDX FAC+4 VALUE IN X-REG
E704- 4C B7 00 3710 JMP CHRGOT GET NEXT CHAR IN A-REG
3720 *--------------------------------
3730 * "VAL" FUNCTION
3740 *--------------------------------
E707- 20 DC E6 3750 VAL JSR GETSTR GET POINTER TO STRING IN INDEX
E70A- D0 03 3760 BNE .1 LENGTH NON-ZERO
E70C- 4C 4E E8 3770 JMP ZERO.FAC RETURN 0 IF LENGTH=0
E70F- A6 B8 3780 .1 LDX TXTPTR SAVE CURRENT TXTPTR
E711- A4 B9 3790 LDY TXTPTR+1
E713- 86 AD 3800 STX STRNG2
E715- 84 AE 3810 STY STRNG2+1
E717- A6 5E 3820 LDX INDEX
E719- 86 B8 3830 STX TXTPTR POINT TXTPTR TO START OF STRING
E71B- 18 3840 CLC
E71C- 65 5E 3850 ADC INDEX ADD LENGTH
E71E- 85 60 3860 STA DEST POINT DEST TO END OF STRING + 1
E720- A6 5F 3870 LDX INDEX+1
E722- 86 B9 3880 STX TXTPTR+1
E724- 90 01 3890 BCC .2
E726- E8 3900 INX
E727- 86 61 3910 .2 STX DEST+1
E729- A0 00 3920 LDY #0 SAVE BYTE THAT FOLLOWS STRING
E72B- B1 60 3930 LDA (DEST),Y ON STACK
E72D- 48 3940 PHA
E72E- A9 00 3950 LDA #0 AND STORE $00 IN ITS PLACE
E730- 91 60 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! >>>
E732- 20 B7 00 4020 JSR CHRGOT PRIME THE PUMP
E735- 20 4A EC 4030 JSR FIN EVALUATE STRING
E738- 68 4040 PLA GET BYTE THAT SHOULD FOLLOW STRING
E739- A0 00 4050 LDY #0 AND PUT IT BACK
E73B- 91 60 4060 STA (DEST),Y
4070 * RESTORE TXTPTR
4080 *--------------------------------
4090 * COPY STRNG2 INTO TXTPTR
4100 *--------------------------------
E73D- A6 AD 4110 POINT LDX STRNG2
E73F- A4 AE 4120 LDY STRNG2+1
E741- 86 B8 4130 STX TXTPTR
E743- 84 B9 4140 STY TXTPTR+1
E745- 60 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 *--------------------------------
E746- 20 67 DD 4220 GTNUM JSR FRMNUM
E749- 20 52 E7 4230 JSR GETADR
4240 *--------------------------------
4250 * EVALUATE ",EXPRESSION"
4260 * CONVERT EXPRESSION TO SINGLE BYTE IN X-REG
4270 *--------------------------------
4280 COMBYTE
E74C- 20 BE DE 4290 JSR CHKCOM MUST HAVE COMMA FIRST
E74F- 4C F8 E6 4300 JMP GETBYT CONVERT EXPRESSION TO BYTE IN X-REG
4310 *--------------------------------
4320 * CONVERT (FAC) TO A 16-BIT VALUE IN LINNUM
4330 *--------------------------------
E752- A5 9D 4340 GETADR LDA FAC FAC < 2^16?
E754- C9 91 4350 CMP #$91
E756- B0 9A 4360 BCS GOIQ NO, ILLEGAL QUANTITY
E758- 20 F2 EB 4370 JSR QINT CONVERT TO INTEGER
E75B- A5 A0 4380 LDA FAC+3 COPY IT INTO LINNUM
E75D- A4 A1 4390 LDY FAC+4
E75F- 84 50 4400 STY LINNUM TO LINNUM
E761- 85 51 4410 STA LINNUM+1
E763- 60 4420 RTS
4430 *--------------------------------
4440 * "PEEK" FUNCTION
4450 *--------------------------------
E764- A5 50 4460 PEEK LDA LINNUM SAVE (LINNUM) ON STACK DURING PEEK
E766- 48 4470 PHA
E767- A5 51 4480 LDA LINNUM+1
E769- 48 4490 PHA
E76A- 20 52 E7 4500 JSR GETADR GET ADDRESS PEEKING AT
E76D- A0 00 4510 LDY #0
E76F- B1 50 4520 LDA (LINNUM),Y TAKE A QUICK LOOK
E771- A8 4530 TAY VALUE IN Y-REG
E772- 68 4540 PLA RESTORE LINNUM FROM STACK
E773- 85 51 4550 STA LINNUM+1
E775- 68 4560 PLA
E776- 85 50 4570 STA LINNUM
E778- 4C 01 E3 4580 JMP SNGFLT FLOAT Y-REG INTO FAC
4590 *--------------------------------
4600 * "POKE" STATEMENT
4610 *--------------------------------
E77B- 20 46 E7 4620 POKE JSR GTNUM GET THE ADDRESS AND VALUE
E77E- 8A 4630 TXA VALUE IN A,
E77F- A0 00 4640 LDY #0
E781- 91 50 4650 STA (LINNUM),Y STORE IT AWAY,
E783- 60 4660 RTS AND THAT'S ALL FOR TODAY
4670 *--------------------------------
4680 * "WAIT" STATEMENT
4690 *--------------------------------
E784- 20 46 E7 4700 WAIT JSR GTNUM GET ADDRESS IN LINNUM, MASK IN X
E787- 86 85 4710 STX FORPNT SAVE MASK
E789- A2 00 4720 LDX #0
E78B- 20 B7 00 4730 JSR CHRGOT ANOTHER PARAMETER?
E78E- F0 03 4740 BEQ .1 NO, USE $00 FOR EXCLUSIVE-OR
E790- 20 4C E7 4750 JSR COMBYTE GET XOR-MASK
E793- 86 86 4760 .1 STX FORPNT+1 SAVE XOR-MASK HERE
E795- A0 00 4770 LDY #0
E797- B1 50 4780 .2 LDA (LINNUM),Y GET BYTE AT ADDRESS
E799- 45 86 4790 EOR FORPNT+1 INVERT SPECIFIED BITS
E79B- 25 85 4800 AND FORPNT SELECT SPECIFIED BITS
E79D- F0 F8 4810 BEQ .2 LOOP TILL NOT 0
E79F- 60 4820 RTS.10 RTS
S.E3C5