1010 *-------------------------------- 1020 * "STR$" FUNCTION 1030 *-------------------------------- 1040 STR JSR CHKNUM EXPRESSION MUST BE NUMERIC 1050 LDY #0 START STRING AT STACK-1 ($00FF) 1060 * SO STRLIT CAN DIFFRENTIATE STR$ CALLS 1070 JSR FOUT.1 CONVERT FAC TO STRING 1080 PLA POP RETURN OFF STACK 1090 PLA 1100 LDA #STACK-1 POINT TO STACK-1 1110 LDY /STACK-1 (WHICH=0) 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 *-------------------------------- 1170 STRINI LDX FAC+3 Y,X = STRING ADDRESS 1180 LDY FAC+4 1190 STX DSCPTR 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 *-------------------------------- 1250 STRSPA JSR GETSPA A HOLDS LENGTH 1260 STX FAC+1 SAVE DESCRIPTOR IN FAC 1270 STY FAC+2 ---FAC--- --FAC+1-- --FAC+2-- 1280 STA FAC <LENGTH> <ADDR-LO> <ADDR-HI> 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 *-------------------------------- 1360 STRLIT LDX #'"' SET UP LITERAL SCAN TO STOP ON 1370 STX CHARAC QUOTATION MARK OR $00 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 *-------------------------------- 1460 STRLT2 STA STRNG1 SAVE ADDRESS OF STRING 1470 STY STRNG1+1 1480 STA FAC+1 ...AGAIN 1490 STY FAC+2 1500 LDY #$FF 1510 .1 INY FIND END OF STRING 1520 LDA (STRNG1),Y NEXT STRING CHAR 1530 BEQ .3 END OF STRING 1540 CMP CHARAC ALTERNATE TERMINATOR # 1? 1550 BEQ .2 YES 1560 CMP ENDCHR ALTERNATE TERMINATOR # 2? 1570 BNE .1 NO, KEEP SCANNING 1580 .2 CMP #'"' IS STRING ENDED WITH QUOTE MARK? 1590 BEQ .4 YES, C=1 TO INCLUDE " IN STRING 1600 .3 CLC 1610 .4 STY FAC SAVE LENGTH 1620 TYA 1630 ADC STRNG1 COMPUTE ADDRESS OF END OF STRING 1640 STA STRNG2 (OF 00 BYTE, OR JUST AFTER ") 1650 LDX STRNG1+1 1660 BCC .5 1670 INX 1680 .5 STX STRNG2+1 1690 LDA STRNG1+1 WHERE DOES THE STRING START? 1700 BEQ .6 PAGE 0, MUST BE FROM STR$ FUNCTION 1710 CMP #2 PAGE 2? 1720 BNE PUTNEW NO, NOT PAGE 0 OR 2 1730 .6 TYA LENGTH OF STRING 1740 JSR STRINI MAKE SPACE FOR STRING 1750 LDX STRNG1 1760 LDY STRNG1+1 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 *-------------------------------- 1840 PUTNEW LDX TEMPPT POINTER TO NEXT TEMP STRING SLOT 1850 CPX #TEMPST+9 MAX OF 3 TEMP STRINGS 1860 BNE PUTEMP ROOM FOR ANOTHER ONE 1870 LDX #ERR.FRMCPX TOO MANY, FORMULA TOO COMPLEX 1880 JERR JMP ERROR 1890 *-------------------------------- 1900 PUTEMP LDA FAC COPY TEMP DESCRIPTOR INTO TEMP STACK 1910 STA 0,X 1920 LDA FAC+1 1930 STA 1,X 1940 LDA FAC+2 1950 STA 2,X 1960 LDY #0 1970 STX FAC+3 ADDRESS OF TEMP DESCRIPTOR 1980 STY FAC+4 IN Y,X AND FAC+3,4 1990 DEY Y=$FF 2000 STY VALTYP FLAG (FAC ) AS STRING 2010 STX LASTPT INDEX OF LAST POINTER 2020 INX UPDATE FOR NEXT TEMP ENTRY 2030 INX 2040 INX 2050 STX TEMPPT 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 *-------------------------------- 2140 GETSPA LSR GARFLG CLEAR SIGNBIT OF FLAG 2150 .1 PHA A HOLDS LENGTH 2160 EOR #$FF GET -LENGTH 2170 SEC 2180 ADC FRETOP COMPUTE STARTING ADDRESS OF SPACE 2190 LDY FRETOP+1 FOR THE STRING 2200 BCS .2 2210 DEY 2220 .2 CPY STREND+1 SEE IF FITS IN REMAINING MEMORY 2230 BCC .4 NO, TRY GARBAGE 2240 BNE .3 YES, IT FITS 2250 CMP STREND HAVE TO CHECK LOWER BYTES 2260 BCC .4 NOT ENUF ROOM YET 2270 .3 STA FRETOP THERE IS ROOM SO SAVE NEW FRETOP 2280 STY FRETOP+1 2290 STA FRESPC 2300 STY FRESPC+1 2310 TAX ADDR IN Y,X 2320 PLA LENGTH IN A 2330 RTS 2340 .4 LDX #ERR.MEMFULL 2350 LDA GARFLG GARBAGE DONE YET? 2360 BMI JERR YES, MEMORY IS REALLY FULL 2370 JSR GARBAG NO, TRY COLLECTING NOW 2380 LDA #$80 FLAG THAT COLLECTED GARBAGE ALREADY 2390 STA GARFLG 2400 PLA GET STRING LENGTH AGAIN 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 *-------------------------------- 2470 GARBAG LDX MEMSIZ COLLECT FROM TOP DOWN 2480 LDA MEMSIZ+1 2490 FIND.HIGHEST.STRING 2500 STX FRETOP ONE PASS THROUGH ALL VARS 2510 STA FRETOP+1 FOR EACH ACTIVE STRING! 2520 LDY #0 2530 STY FNCNAM+1 FLAG IN CASE NO STRINGS TO COLLECT 2540 LDA STREND 2550 LDX STREND+1 2560 STA LOWTR 2570 STX LOWTR+1 2580 *-------------------------------- 2590 * START BY COLLECTING TEMPORARIES 2600 *-------------------------------- 2610 LDA #TEMPST 2620 LDX /TEMPST 2630 STA INDEX 2640 STX INDEX+1 2650 .1 CMP TEMPPT FINISHED WITH TEMPS YET? 2660 BEQ .2 YES, NOW DO SIMPLE VARIABLES 2670 JSR CHECK.VARIABLE DO A TEMP 2680 BEQ .1 ...ALWAYS 2690 *-------------------------------- 2700 * NOW COLLECT SIMPLE VARIABLES 2710 *-------------------------------- 2720 .2 LDA #7 LENGTH OF EACH VARIABLE IS 7 BYTES 2730 STA DSCLEN 2740 LDA VARTAB START AT BEGINNING OF VARTAB 2750 LDX VARTAB+1 2760 STA INDEX 2770 STX INDEX+1 2780 .3 CPX ARYTAB+1 FINISHED WITH SIMPLE VARIABLES? 2790 BNE .4 NO 2800 CMP ARYTAB MAYBE, CHECK LO-BYTE 2810 BEQ .5 YES, NOW DO ARRAYS 2820 .4 JSR CHECK.SIMPLE.VARIABLE 2830 BEQ .3 ...ALWAYS 2840 *-------------------------------- 2850 * NOW COLLECT ARRAY VARIABLES 2860 *-------------------------------- 2870 .5 STA ARYPNT 2880 STX ARYPNT+1 2890 LDA #3 DESCRIPTORS IN ARRAYS ARE 3-BYTES EACH 2900 STA DSCLEN 2910 .6 LDA ARYPNT COMPARE TO END OF ARRAYS 2920 LDX ARYPNT+1 2930 .7 CPX STREND+1 FINISHED WITH ARRAYS YET? 2940 BNE .8 NOT YET 2950 CMP STREND MAYBE, CHECK LO-BYTE 2960 BNE .8 NOT FINISHED YET 2970 JMP MOVE.HIGHEST.STRING.TO.TOP FINISHED 2980 .8 STA INDEX SET UP PNTR TO START OF ARRAY 2990 STX INDEX+1 3000 LDY #0 POINT AT NAME OF ARRAY 3010 LDA (INDEX),Y 3020 TAX 1ST LETTER OF NAME IN X-REG 3030 INY 3040 LDA (INDEX),Y 3050 PHP STATUS FROM SECOND LETTER OF NAME 3060 INY 3070 LDA (INDEX),Y OFFSET TO NEXT ARRAY 3080 ADC ARYPNT (CARRY ALWAYS CLEAR) 3090 STA ARYPNT CALCULATE START OF NEXT ARRAY 3100 INY 3110 LDA (INDEX),Y HI-BYTE OF OFFSET 3120 ADC ARYPNT+1 3130 STA ARYPNT+1 3140 PLP GET STATUS FROM 2ND CHAR OF NAME 3150 BPL .6 NOT A STRING ARRAY 3160 TXA SET STATUS WITH 1ST CHAR OF NAME 3170 BMI .6 NOT A STRING ARRAY 3180 INY 3190 LDA (INDEX),Y # OF DIMENSIONS FOR THIS ARRAY 3200 LDY #0 3210 ASL PREAMBLE SIZE = 2*#DIMS + 5 3220 ADC #5 3230 ADC INDEX MAKE INDEX POINT AT FIRST ELEMENT 3240 STA INDEX IN THE ARRAY 3250 BCC .9 3260 INC INDEX+1 3270 .9 3280 LDX INDEX+1 STEP THRU EACH STRING IN THIS ARRAY 3290 .10 CPX ARYPNT+1 ARRAY DONE? 3300 BNE .11 NO, PROCESS NEXT ELEMENT 3310 CMP ARYPNT MAYBE, CHECK LO-BYTE 3320 BEQ .7 YES, MOVE TO NEXT ARRAY 3330 .11 JSR CHECK.VARIABLE PROCESS THE ARRAY 3340 BEQ .10 ...ALWAYS 3350 *-------------------------------- 3360 * PROCESS A SIMPLE VARIABLE 3370 *-------------------------------- 3380 CHECK.SIMPLE.VARIABLE 3390 LDA (INDEX),Y LOOK AT 1ST CHAR OF NAME 3400 BMI CHECK.BUMP NOT A STRING VARIABLE 3410 INY 3420 LDA (INDEX),Y LOOK AT 2ND CHAR OF NAME 3430 BPL CHECK.BUMP NOT A STRING VARIABLE 3440 INY 3450 *-------------------------------- 3460 * IF STRING IS NOT EMPTY, CHECK IF IT IS HIGHEST 3470 *-------------------------------- 3480 CHECK.VARIABLE 3490 LDA (INDEX),Y GET LENGTH OF STRING 3500 BEQ CHECK.BUMP IGNORE STRING IF LENGTH IS ZERO 3510 INY 3520 LDA (INDEX),Y GET ADDRESS OF STRING 3530 TAX 3540 INY 3550 LDA (INDEX),Y 3560 CMP FRETOP+1 CHECK IF ALREADY COLLECTED 3570 BCC .1 NO, BELOW FRETOP 3580 BNE CHECK.BUMP YES, ABOVE FRETOP 3590 CPX FRETOP MAYBE, CHECK LO-BYTE 3600 BCS CHECK.BUMP YES, ABOVE FRETOP 3610 .1 CMP LOWTR+1 ABOVE HIGHEST STRING FOUND? 3620 BCC CHECK.BUMP NO, IGNORE FOR NOW 3630 BNE .2 YES, THIS IS THE NEW HIGHEST 3640 CPX LOWTR MAYBE, TRY LO-BYTE 3650 BCC CHECK.BUMP NO, IGNORE FOR NOW 3660 .2 STX LOWTR MAKE THIS THE HIGHEST STRING 3670 STA LOWTR+1 3680 LDA INDEX SAVE ADDRESS OF DESCRIPTOR TOO 3690 LDX INDEX+1 3700 STA FNCNAM 3710 STX FNCNAM+1 3720 LDA DSCLEN 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 3790 LDA DSCLEN BUMP TO NEXT VARIABLE 3800 CLC 3810 ADC INDEX 3820 STA INDEX 3830 BCC CHECK.EXIT 3840 INC INDEX+1 3850 *-------------------------------- 3860 CHECK.EXIT 3870 LDX INDEX+1 3880 LDY #0 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 3950 LDX FNCNAM+1 ANY STRING FOUND? 3960 BEQ CHECK.EXIT NO, RETURN 3970 LDA LENGTH GET LENGTH OF VARIABLE ELEMENT 3980 AND #4 WAS 7 OR 3, MAKE 4 OR 0 3990 LSR 2 0R 0; IN SIMPLE VARIABLES, 4000 TAY NAME PRECEDES DESCRIPTOR 4010 STA LENGTH 2 OR 0 4020 LDA (FNCNAM),Y GET LENGTH FROM DESCRIPTOR 4030 ADC LOWTR CARRY ALREADY CLEARED BY LSR 4040 STA HIGHTR STRING IS BTWN (LOWTR) AND (HIGHTR) 4050 LDA LOWTR+1 4060 ADC #0 4070 STA HIGHTR+1 4080 LDA FRETOP HIGH END DESTINATION 4090 LDX FRETOP+1 4100 STA HIGHDS 4110 STX HIGHDS+1 4120 JSR BLTU2 MOVE STRING UP 4130 LDY LENGTH FIX ITS DESCRIPTOR 4140 INY POINT AT ADDRESS IN DESCRIPTOR 4150 LDA HIGHDS STORE NEW ADDRESS 4160 STA (FNCNAM),Y 4170 TAX 4180 INC HIGHDS+1 CORRECT BLTU'S OVERSHOOT 4190 LDA HIGHDS+1 4200 INY 4210 STA (FNCNAM),Y 4220 JMP FIND.HIGHEST.STRING 4230 *--------------------------------