S-C DocuMentor — Applesoft
SAVE S.E3C5
1010 *--------------------------------
1020 * "STR$" FUNCTION
1030 *--------------------------------
E3C5- 20 6A DD 1040 STR JSR CHKNUM EXPRESSION MUST BE NUMERIC
E3C8- A0 00 1050 LDY #0 START STRING AT STACK-1 ($00FF)
1060 * SO STRLIT CAN DIFFRENTIATE STR$ CALLS
E3CA- 20 36 ED 1070 JSR FOUT.1 CONVERT FAC TO STRING
E3CD- 68 1080 PLA POP RETURN OFF STACK
E3CE- 68 1090 PLA
E3CF- A9 FF 1100 LDA #STACK-1 POINT TO STACK-1
E3D1- A0 00 1110 LDY /STACK-1 (WHICH=0)
E3D3- F0 12 1120 BEQ STRLIT ...ALWAYS, CREATE DESC & MOVE STRING
1130 *--------------------------------
1140 * GET SPACE AND MAKE DESCRIPTOR FOR STRING WHOSE
1150 * ADDRESS IS IN FAC+3,4 AND WHOSE LENGTH IS IN A-REG
1160 *--------------------------------
E3D5- A6 A0 1170 STRINI LDX FAC+3 Y,X = STRING ADDRESS
E3D7- A4 A1 1180 LDY FAC+4
E3D9- 86 8C 1190 STX DSCPTR
E3DB- 84 8D 1200 STY DSCPTR+1
1210 *--------------------------------
1220 * GET SPACE AND MAKE DESCRIPTOR FOR STRING WHOSE
1230 * ADDRESS IS IN Y,X AND WHOSE LENGTH IS IN A-REG
1240 *--------------------------------
E3DD- 20 52 E4 1250 STRSPA JSR GETSPA A HOLDS LENGTH
E3E0- 86 9E 1260 STX FAC+1 SAVE DESCRIPTOR IN FAC
E3E2- 84 9F 1270 STY FAC+2 ---FAC--- --FAC+1-- --FAC+2--
E3E4- 85 9D 1280 STA FAC <LENGTH> <ADDR-LO> <ADDR-HI>
E3E6- 60 1290 RTS
1300 *--------------------------------
1310 * BUILD A DESCRIPTOR FOR STRING STARTING AT Y,A
1320 * AND TERMINATED BY $00 OR QUOTATION MARK
1330 * RETURN WITH DESCRIPTOR IN A TEMPORARY
1340 * AND ADDRESS OF DESCRIPTOR IN FAC+3,4
1350 *--------------------------------
E3E7- A2 22 1360 STRLIT LDX #'"' SET UP LITERAL SCAN TO STOP ON
E3E9- 86 0D 1370 STX CHARAC QUOTATION MARK OR $00
E3EB- 86 0E 1380 STX ENDCHR
1390 *--------------------------------
1400 * BUILD A DESCRIPTOR FOR STRING STARTING AT Y,A
1410 * AND TERMINATED BY $00, (CHARAC), OR (ENDCHR)
1420 *
1430 * RETURN WITH DESCRIPTOR IN A TEMPORARY
1440 * AND ADDRESS OF DESCRIPTOR IN FAC+3,4
1450 *--------------------------------
E3ED- 85 AB 1460 STRLT2 STA STRNG1 SAVE ADDRESS OF STRING
E3EF- 84 AC 1470 STY STRNG1+1
E3F1- 85 9E 1480 STA FAC+1 ...AGAIN
E3F3- 84 9F 1490 STY FAC+2
E3F5- A0 FF 1500 LDY #$FF
E3F7- C8 1510 .1 INY FIND END OF STRING
E3F8- B1 AB 1520 LDA (STRNG1),Y NEXT STRING CHAR
E3FA- F0 0C 1530 BEQ .3 END OF STRING
E3FC- C5 0D 1540 CMP CHARAC ALTERNATE TERMINATOR # 1?
E3FE- F0 04 1550 BEQ .2 YES
E400- C5 0E 1560 CMP ENDCHR ALTERNATE TERMINATOR # 2?
E402- D0 F3 1570 BNE .1 NO, KEEP SCANNING
E404- C9 22 1580 .2 CMP #'"' IS STRING ENDED WITH QUOTE MARK?
E406- F0 01 1590 BEQ .4 YES, C=1 TO INCLUDE " IN STRING
E408- 18 1600 .3 CLC
E409- 84 9D 1610 .4 STY FAC SAVE LENGTH
E40B- 98 1620 TYA
E40C- 65 AB 1630 ADC STRNG1 COMPUTE ADDRESS OF END OF STRING
E40E- 85 AD 1640 STA STRNG2 (OF 00 BYTE, OR JUST AFTER ")
E410- A6 AC 1650 LDX STRNG1+1
E412- 90 01 1660 BCC .5
E414- E8 1670 INX
E415- 86 AE 1680 .5 STX STRNG2+1
E417- A5 AC 1690 LDA STRNG1+1 WHERE DOES THE STRING START?
E419- F0 04 1700 BEQ .6 PAGE 0, MUST BE FROM STR$ FUNCTION
E41B- C9 02 1710 CMP #2 PAGE 2?
E41D- D0 0B 1720 BNE PUTNEW NO, NOT PAGE 0 OR 2
E41F- 98 1730 .6 TYA LENGTH OF STRING
E420- 20 D5 E3 1740 JSR STRINI MAKE SPACE FOR STRING
E423- A6 AB 1750 LDX STRNG1
E425- A4 AC 1760 LDY STRNG1+1
E427- 20 E2 E5 1770 JSR MOVSTR MOVE IT IN
1780 *--------------------------------
1790 * STORE DESCRIPTOR IN TEMPORARY DESCRIPTOR STACK
1800 *
1810 * THE DESCRIPTOR IS NOW IN FAC, FAC+1, FAC+2
1820 * PUT ADDRESS OF TEMP DESCRIPTOR IN FAC+3,4
1830 *--------------------------------
E42A- A6 52 1840 PUTNEW LDX TEMPPT POINTER TO NEXT TEMP STRING SLOT
E42C- E0 5E 1850 CPX #TEMPST+9 MAX OF 3 TEMP STRINGS
E42E- D0 05 1860 BNE PUTEMP ROOM FOR ANOTHER ONE
E430- A2 BF 1870 LDX #ERR.FRMCPX TOO MANY, FORMULA TOO COMPLEX
E432- 4C 12 D4 1880 JERR JMP ERROR
1890 *--------------------------------
E435- A5 9D 1900 PUTEMP LDA FAC COPY TEMP DESCRIPTOR INTO TEMP STACK
E437- 95 00 1910 STA 0,X
E439- A5 9E 1920 LDA FAC+1
E43B- 95 01 1930 STA 1,X
E43D- A5 9F 1940 LDA FAC+2
E43F- 95 02 1950 STA 2,X
E441- A0 00 1960 LDY #0
E443- 86 A0 1970 STX FAC+3 ADDRESS OF TEMP DESCRIPTOR
E445- 84 A1 1980 STY FAC+4 IN Y,X AND FAC+3,4
E447- 88 1990 DEY Y=$FF
E448- 84 11 2000 STY VALTYP FLAG (FAC ) AS STRING
E44A- 86 53 2010 STX LASTPT INDEX OF LAST POINTER
E44C- E8 2020 INX UPDATE FOR NEXT TEMP ENTRY
E44D- E8 2030 INX
E44E- E8 2040 INX
E44F- 86 52 2050 STX TEMPPT
E451- 60 2060 RTS
2070 *--------------------------------
2080 * MAKE SPACE FOR STRING AT BOTTOM OF STRING SPACE
2090 * (A)=# BYTES SPACE TO MAKE
2100 *
2110 * RETURN WITH (A) SAME,
2120 * AND Y,X = ADDRESS OF SPACE ALLOCATED
2130 *--------------------------------
E452- 46 13 2140 GETSPA LSR GARFLG CLEAR SIGNBIT OF FLAG
E454- 48 2150 .1 PHA A HOLDS LENGTH
E455- 49 FF 2160 EOR #$FF GET -LENGTH
E457- 38 2170 SEC
E458- 65 6F 2180 ADC FRETOP COMPUTE STARTING ADDRESS OF SPACE
E45A- A4 70 2190 LDY FRETOP+1 FOR THE STRING
E45C- B0 01 2200 BCS .2
E45E- 88 2210 DEY
E45F- C4 6E 2220 .2 CPY STREND+1 SEE IF FITS IN REMAINING MEMORY
E461- 90 11 2230 BCC .4 NO, TRY GARBAGE
E463- D0 04 2240 BNE .3 YES, IT FITS
E465- C5 6D 2250 CMP STREND HAVE TO CHECK LOWER BYTES
E467- 90 0B 2260 BCC .4 NOT ENUF ROOM YET
E469- 85 6F 2270 .3 STA FRETOP THERE IS ROOM SO SAVE NEW FRETOP
E46B- 84 70 2280 STY FRETOP+1
E46D- 85 71 2290 STA FRESPC
E46F- 84 72 2300 STY FRESPC+1
E471- AA 2310 TAX ADDR IN Y,X
E472- 68 2320 PLA LENGTH IN A
E473- 60 2330 RTS
E474- A2 4D 2340 .4 LDX #ERR.MEMFULL
E476- A5 13 2350 LDA GARFLG GARBAGE DONE YET?
E478- 30 B8 2360 BMI JERR YES, MEMORY IS REALLY FULL
E47A- 20 84 E4 2370 JSR GARBAG NO, TRY COLLECTING NOW
E47D- A9 80 2380 LDA #$80 FLAG THAT COLLECTED GARBAGE ALREADY
E47F- 85 13 2390 STA GARFLG
E481- 68 2400 PLA GET STRING LENGTH AGAIN
E482- D0 D0 2410 BNE .1 ...ALWAYS
2420 *--------------------------------
2430 * SHOVE ALL REFERENCED STRINGS AS HIGH AS POSSIBLE
2440 * IN MEMORY (AGAINST HIMEM), FREEING UP SPACE
2450 * BELOW STRING AREA DOWN TO STREND.
2460 *--------------------------------
E484- A6 73 2470 GARBAG LDX MEMSIZ COLLECT FROM TOP DOWN
E486- A5 74 2480 LDA MEMSIZ+1
2490 FIND.HIGHEST.STRING
E488- 86 6F 2500 STX FRETOP ONE PASS THROUGH ALL VARS
E48A- 85 70 2510 STA FRETOP+1 FOR EACH ACTIVE STRING!
E48C- A0 00 2520 LDY #0
E48E- 84 8B 2530 STY FNCNAM+1 FLAG IN CASE NO STRINGS TO COLLECT
E490- A5 6D 2540 LDA STREND
E492- A6 6E 2550 LDX STREND+1
E494- 85 9B 2560 STA LOWTR
E496- 86 9C 2570 STX LOWTR+1
2580 *--------------------------------
2590 * START BY COLLECTING TEMPORARIES
2600 *--------------------------------
E498- A9 55 2610 LDA #TEMPST
E49A- A2 00 2620 LDX /TEMPST
E49C- 85 5E 2630 STA INDEX
E49E- 86 5F 2640 STX INDEX+1
E4A0- C5 52 2650 .1 CMP TEMPPT FINISHED WITH TEMPS YET?
E4A2- F0 05 2660 BEQ .2 YES, NOW DO SIMPLE VARIABLES
E4A4- 20 23 E5 2670 JSR CHECK.VARIABLE DO A TEMP
E4A7- F0 F7 2680 BEQ .1 ...ALWAYS
2690 *--------------------------------
2700 * NOW COLLECT SIMPLE VARIABLES
2710 *--------------------------------
E4A9- A9 07 2720 .2 LDA #7 LENGTH OF EACH VARIABLE IS 7 BYTES
E4AB- 85 8F 2730 STA DSCLEN
E4AD- A5 69 2740 LDA VARTAB START AT BEGINNING OF VARTAB
E4AF- A6 6A 2750 LDX VARTAB+1
E4B1- 85 5E 2760 STA INDEX
E4B3- 86 5F 2770 STX INDEX+1
E4B5- E4 6C 2780 .3 CPX ARYTAB+1 FINISHED WITH SIMPLE VARIABLES?
E4B7- D0 04 2790 BNE .4 NO
E4B9- C5 6B 2800 CMP ARYTAB MAYBE, CHECK LO-BYTE
E4BB- F0 05 2810 BEQ .5 YES, NOW DO ARRAYS
E4BD- 20 19 E5 2820 .4 JSR CHECK.SIMPLE.VARIABLE
E4C0- F0 F3 2830 BEQ .3 ...ALWAYS
2840 *--------------------------------
2850 * NOW COLLECT ARRAY VARIABLES
2860 *--------------------------------
E4C2- 85 94 2870 .5 STA ARYPNT
E4C4- 86 95 2880 STX ARYPNT+1
E4C6- A9 03 2890 LDA #3 DESCRIPTORS IN ARRAYS ARE 3-BYTES EACH
E4C8- 85 8F 2900 STA DSCLEN
E4CA- A5 94 2910 .6 LDA ARYPNT COMPARE TO END OF ARRAYS
E4CC- A6 95 2920 LDX ARYPNT+1
E4CE- E4 6E 2930 .7 CPX STREND+1 FINISHED WITH ARRAYS YET?
E4D0- D0 07 2940 BNE .8 NOT YET
E4D2- C5 6D 2950 CMP STREND MAYBE, CHECK LO-BYTE
E4D4- D0 03 2960 BNE .8 NOT FINISHED YET
E4D6- 4C 62 E5 2970 JMP MOVE.HIGHEST.STRING.TO.TOP FINISHED
E4D9- 85 5E 2980 .8 STA INDEX SET UP PNTR TO START OF ARRAY
E4DB- 86 5F 2990 STX INDEX+1
E4DD- A0 00 3000 LDY #0 POINT AT NAME OF ARRAY
E4DF- B1 5E 3010 LDA (INDEX),Y
E4E1- AA 3020 TAX 1ST LETTER OF NAME IN X-REG
E4E2- C8 3030 INY
E4E3- B1 5E 3040 LDA (INDEX),Y
E4E5- 08 3050 PHP STATUS FROM SECOND LETTER OF NAME
E4E6- C8 3060 INY
E4E7- B1 5E 3070 LDA (INDEX),Y OFFSET TO NEXT ARRAY
E4E9- 65 94 3080 ADC ARYPNT (CARRY ALWAYS CLEAR)
E4EB- 85 94 3090 STA ARYPNT CALCULATE START OF NEXT ARRAY
E4ED- C8 3100 INY
E4EE- B1 5E 3110 LDA (INDEX),Y HI-BYTE OF OFFSET
E4F0- 65 95 3120 ADC ARYPNT+1
E4F2- 85 95 3130 STA ARYPNT+1
E4F4- 28 3140 PLP GET STATUS FROM 2ND CHAR OF NAME
E4F5- 10 D3 3150 BPL .6 NOT A STRING ARRAY
E4F7- 8A 3160 TXA SET STATUS WITH 1ST CHAR OF NAME
E4F8- 30 D0 3170 BMI .6 NOT A STRING ARRAY
E4FA- C8 3180 INY
E4FB- B1 5E 3190 LDA (INDEX),Y # OF DIMENSIONS FOR THIS ARRAY
E4FD- A0 00 3200 LDY #0
E4FF- 0A 3210 ASL PREAMBLE SIZE = 2*#DIMS + 5
E500- 69 05 3220 ADC #5
E502- 65 5E 3230 ADC INDEX MAKE INDEX POINT AT FIRST ELEMENT
E504- 85 5E 3240 STA INDEX IN THE ARRAY
E506- 90 02 3250 BCC .9
E508- E6 5F 3260 INC INDEX+1
3270 .9
E50A- A6 5F 3280 LDX INDEX+1 STEP THRU EACH STRING IN THIS ARRAY
E50C- E4 95 3290 .10 CPX ARYPNT+1 ARRAY DONE?
E50E- D0 04 3300 BNE .11 NO, PROCESS NEXT ELEMENT
E510- C5 94 3310 CMP ARYPNT MAYBE, CHECK LO-BYTE
E512- F0 BA 3320 BEQ .7 YES, MOVE TO NEXT ARRAY
E514- 20 23 E5 3330 .11 JSR CHECK.VARIABLE PROCESS THE ARRAY
E517- F0 F3 3340 BEQ .10 ...ALWAYS
3350 *--------------------------------
3360 * PROCESS A SIMPLE VARIABLE
3370 *--------------------------------
3380 CHECK.SIMPLE.VARIABLE
E519- B1 5E 3390 LDA (INDEX),Y LOOK AT 1ST CHAR OF NAME
E51B- 30 35 3400 BMI CHECK.BUMP NOT A STRING VARIABLE
E51D- C8 3410 INY
E51E- B1 5E 3420 LDA (INDEX),Y LOOK AT 2ND CHAR OF NAME
E520- 10 30 3430 BPL CHECK.BUMP NOT A STRING VARIABLE
E522- C8 3440 INY
3450 *--------------------------------
3460 * IF STRING IS NOT EMPTY, CHECK IF IT IS HIGHEST
3470 *--------------------------------
3480 CHECK.VARIABLE
E523- B1 5E 3490 LDA (INDEX),Y GET LENGTH OF STRING
E525- F0 2B 3500 BEQ CHECK.BUMP IGNORE STRING IF LENGTH IS ZERO
E527- C8 3510 INY
E528- B1 5E 3520 LDA (INDEX),Y GET ADDRESS OF STRING
E52A- AA 3530 TAX
E52B- C8 3540 INY
E52C- B1 5E 3550 LDA (INDEX),Y
E52E- C5 70 3560 CMP FRETOP+1 CHECK IF ALREADY COLLECTED
E530- 90 06 3570 BCC .1 NO, BELOW FRETOP
E532- D0 1E 3580 BNE CHECK.BUMP YES, ABOVE FRETOP
E534- E4 6F 3590 CPX FRETOP MAYBE, CHECK LO-BYTE
E536- B0 1A 3600 BCS CHECK.BUMP YES, ABOVE FRETOP
E538- C5 9C 3610 .1 CMP LOWTR+1 ABOVE HIGHEST STRING FOUND?
E53A- 90 16 3620 BCC CHECK.BUMP NO, IGNORE FOR NOW
E53C- D0 04 3630 BNE .2 YES, THIS IS THE NEW HIGHEST
E53E- E4 9B 3640 CPX LOWTR MAYBE, TRY LO-BYTE
E540- 90 10 3650 BCC CHECK.BUMP NO, IGNORE FOR NOW
E542- 86 9B 3660 .2 STX LOWTR MAKE THIS THE HIGHEST STRING
E544- 85 9C 3670 STA LOWTR+1
E546- A5 5E 3680 LDA INDEX SAVE ADDRESS OF DESCRIPTOR TOO
E548- A6 5F 3690 LDX INDEX+1
E54A- 85 8A 3700 STA FNCNAM
E54C- 86 8B 3710 STX FNCNAM+1
E54E- A5 8F 3720 LDA DSCLEN
E550- 85 91 3730 STA LENGTH
3740 *--------------------------------
3750 * ADD (DSCLEN) TO PNTR IN INDEX
3760 * RETURN WITH Y=0, PNTR ALSO IN X,A
3770 *--------------------------------
3780 CHECK.BUMP
E552- A5 8F 3790 LDA DSCLEN BUMP TO NEXT VARIABLE
E554- 18 3800 CLC
E555- 65 5E 3810 ADC INDEX
E557- 85 5E 3820 STA INDEX
E559- 90 02 3830 BCC CHECK.EXIT
E55B- E6 5F 3840 INC INDEX+1
3850 *--------------------------------
3860 CHECK.EXIT
E55D- A6 5F 3870 LDX INDEX+1
E55F- A0 00 3880 LDY #0
E561- 60 3890 RTS
3900 *--------------------------------
3910 * FOUND HIGHEST NON-EMPTY STRING, SO MOVE IT
3920 * TO TOP AND GO BACK FOR ANOTHER
3930 *--------------------------------
3940 MOVE.HIGHEST.STRING.TO.TOP
E562- A6 8B 3950 LDX FNCNAM+1 ANY STRING FOUND?
E564- F0 F7 3960 BEQ CHECK.EXIT NO, RETURN
E566- A5 91 3970 LDA LENGTH GET LENGTH OF VARIABLE ELEMENT
E568- 29 04 3980 AND #4 WAS 7 OR 3, MAKE 4 OR 0
E56A- 4A 3990 LSR 2 0R 0; IN SIMPLE VARIABLES,
E56B- A8 4000 TAY NAME PRECEDES DESCRIPTOR
E56C- 85 91 4010 STA LENGTH 2 OR 0
E56E- B1 8A 4020 LDA (FNCNAM),Y GET LENGTH FROM DESCRIPTOR
E570- 65 9B 4030 ADC LOWTR CARRY ALREADY CLEARED BY LSR
E572- 85 96 4040 STA HIGHTR STRING IS BTWN (LOWTR) AND (HIGHTR)
E574- A5 9C 4050 LDA LOWTR+1
E576- 69 00 4060 ADC #0
E578- 85 97 4070 STA HIGHTR+1
E57A- A5 6F 4080 LDA FRETOP HIGH END DESTINATION
E57C- A6 70 4090 LDX FRETOP+1
E57E- 85 94 4100 STA HIGHDS
E580- 86 95 4110 STX HIGHDS+1
E582- 20 9A D3 4120 JSR BLTU2 MOVE STRING UP
E585- A4 91 4130 LDY LENGTH FIX ITS DESCRIPTOR
E587- C8 4140 INY POINT AT ADDRESS IN DESCRIPTOR
E588- A5 94 4150 LDA HIGHDS STORE NEW ADDRESS
E58A- 91 8A 4160 STA (FNCNAM),Y
E58C- AA 4170 TAX
E58D- E6 95 4180 INC HIGHDS+1 CORRECT BLTU'S OVERSHOOT
E58F- A5 95 4190 LDA HIGHDS+1
E591- C8 4200 INY
E592- 91 8A 4210 STA (FNCNAM),Y
E594- 4C 88 E4 4220 JMP FIND.HIGHEST.STRING
4230 *--------------------------------
S.E1B8
