324 lines
12 KiB
Plaintext
324 lines
12 KiB
Plaintext
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 *--------------------------------
|