goapple2/source/applesoft/S.E3C5
2014-05-09 17:59:16 -07:00

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 *--------------------------------