1010 *-------------------------------- 1020 * CREATE A NEW ARRAY, UNLESS CALLED FROM GETARYPT 1030 *-------------------------------- 1040 MAKE.NEW.ARRAY 1050 LDA SUBFLG CALLED FROM GETARYPT? 1060 BEQ .1 NO 1070 LDX #ERR.NODATA YES, GIVE "OUT OF DATA" ERROR 1080 JMP ERROR 1090 .1 JSR GETARY PUT ADDR OF 1ST ELEMENT IN ARYPNT 1100 JSR REASON MAKE SURE ENOUGH MEMORY LEFT 1110 *-------------------------------- 1120 * <<< NEXT 3 LINES COULD BE WRITTEN: >>> 1130 * LDY #0 1140 * STY STRNG2+1 1150 *-------------------------------- 1160 LDA #0 POINT Y-REG AT VARIABLE NAME SLOT 1170 TAY 1180 STA STRNG2+1 START SIZE COMPUTATION 1190 LDX #5 ASSUME 5-BYTES PER ELEMENT 1200 LDA VARNAM STUFF VARIABLE NAME IN ARRAY 1210 STA (LOWTR),Y 1220 BPL .2 NOT INTEGER ARRAY 1230 DEX INTEGER ARRAY, DECR. SIZE TO 4-BYTES 1240 .2 INY POINT Y-REG AT NEXT CHAR OF NAME 1250 LDA VARNAM+1 REST OF ARRAY NAME 1260 STA (LOWTR),Y 1270 BPL .3 REAL ARRAY, STICK WITH SIZE = 5 BYTES 1280 DEX INTEGER OR STRING ARRAY, ADJUST SIZE 1290 DEX TO INTEGER=3, STRING=2 BYTES 1300 .3 STX STRNG2 STORE LOW-BYTE OF ARRAY ELEMENT SIZE 1310 LDA NUMDIM STORE NUMBER OF DIMENSIONS 1320 INY IN 5TH BYTE OF ARRAY 1330 INY 1340 INY 1350 STA (LOWTR),Y 1360 .4 LDX #11 DEFAULT DIMENSION = 11 ELEMENTS 1370 LDA #0 FOR HI-BYTE OF DIMENSION IF DEFAULT 1380 BIT DIMFLG DIMENSIONED ARRAY? 1390 BVC .5 NO, USE DEFAULT VALUE 1400 PLA GET SPECIFIED DIM IN A,X 1410 CLC # ELEMENTS IS 1 LARGER THAN 1420 ADC #1 DIMENSION VALUE 1430 TAX 1440 PLA 1450 ADC #0 1460 .5 INY ADD THIS DIMENSION TO ARRAY DESCRIPTOR 1470 STA (LOWTR),Y 1480 INY 1490 TXA 1500 STA (LOWTR),Y 1510 JSR MULTIPLY.SUBSCRIPT MULTIPLY THIS 1520 * DIMENSION BY RUNNING SIZE 1530 * ((LOWTR)) * (STRNG2) --> A,X 1540 STX STRNG2 STORE RUNNING SIZE IN STRNG2 1550 STA STRNG2+1 1560 LDY INDEX RETRIEVE Y SAVED BY MULTIPLY.SUBSCRIPT 1570 DEC NUMDIM COUNT DOWN # DIMS 1580 BNE .4 LOOP TILL DONE 1590 *-------------------------------- 1600 * NOW A,X HAS TOTAL # BYTES OF ARRAY ELEMENTS 1610 *-------------------------------- 1620 ADC ARYPNT+1 COMPUTE ADDRESS OF END OF THIS ARRAY 1630 BCS GME ...TOO LARGE, ERROR 1640 STA ARYPNT+1 1650 TAY 1660 TXA 1670 ADC ARYPNT 1680 BCC .6 1690 INY 1700 BEQ GME ...TOO LARGE, ERROR 1710 .6 JSR REASON MAKE SURE THERE IS ROOM UP TO Y,A 1720 STA STREND THERE IS ROOM SO SAVE NEW END OF TABLE 1730 STY STREND+1 AND ZERO THE ARRAY 1740 LDA #0 1750 INC STRNG2+1 PREPARE FOR FAST ZEROING LOOP 1760 LDY STRNG2 # BYTES MOD 256 1770 BEQ .8 FULL PAGE 1780 .7 DEY CLEAR PAGE FULL 1790 STA (ARYPNT),Y 1800 BNE .7 1810 .8 DEC ARYPNT+1 POINT TO NEXT PAGE 1820 DEC STRNG2+1 COUNT THE PAGES 1830 BNE .7 STILL MORE TO CLEAR 1840 INC ARYPNT+1 RECOVER LAST DEC, POINT AT 1ST ELEMENT 1850 SEC 1860 LDA STREND COMPUTE OFFSET TO END OF ARRAYS 1870 SBC LOWTR AND STORE IN ARRAY DESCRIPTOR 1880 LDY #2 1890 STA (LOWTR),Y 1900 LDA STREND+1 1910 INY 1920 SBC LOWTR+1 1930 STA (LOWTR),Y 1940 LDA DIMFLG WAS THIS CALLED FROM "DIM" STATEMENT? 1950 BNE RTS.9 YES, WE ARE FINISHED 1960 INY NO, NOW NEED TO FIND THE ELEMENT 1970 *-------------------------------- 1980 * FIND SPECIFIED ARRAY ELEMENT 1990 * 2000 * (LOWTR),Y POINTS AT # OF DIMS IN ARRAY DESCRIPTOR 2010 * THE SUBSCRIPTS ARE ALL ON THE STACK AS INTEGERS 2020 *-------------------------------- 2030 FIND.ARRAY.ELEMENT 2040 LDA (LOWTR),Y GET # OF DIMENSIONS 2050 STA NUMDIM 2060 LDA #0 ZERO SUBSCRIPT ACCUMULATOR 2070 STA STRNG2 2080 FAE.1 STA STRNG2+1 2090 INY 2100 PLA PULL NEXT SUBSCRIPT FROM STACK 2110 TAX SAVE IN FAC+3,4 2120 STA FAC+3 AND COMPARE WITH DIMENSIONED SIZE 2130 PLA 2140 STA FAC+4 2150 CMP (LOWTR),Y 2160 BCC FAE.2 SUBSCRIPT NOT TOO LARGE 2170 BNE GSE SUBSCRIPT IS TOO LARGE 2180 INY CHECK LOW-BYTE OF SUBSCRIPT 2190 TXA 2200 CMP (LOWTR),Y 2210 BCC FAE.3 NOT TOO LARGE 2220 *-------------------------------- 2230 GSE JMP SUBERR BAD SUBSCRIPTS ERROR 2240 GME JMP MEMERR MEM FULL ERROR 2250 *-------------------------------- 2260 FAE.2 INY BUMP POINTER INTO DESCRIPTOR 2270 FAE.3 LDA STRNG2+1 BYPASS MULTIPLICATION IF VALUE SO 2280 ORA STRNG2 FAR = 0 2290 CLC 2300 BEQ .1 IT IS ZERO SO FAR 2310 JSR MULTIPLY.SUBSCRIPT NOT ZERO, SO MULTIPLY 2320 TXA ADD CURRENT SUBSCRIPT 2330 ADC FAC+3 2340 TAX 2350 TYA 2360 LDY INDEX RETRIEVE Y SAVED BY MULTIPLY.SUBSCRIPT 2370 .1 ADC FAC+4 FINISH ADDING CURRENT SUBSCRIPT 2380 STX STRNG2 STORE ACCUMULATED OFFSET 2390 DEC NUMDIM LAST SUBSCRIPT YET? 2400 BNE FAE.1 NO, LOOP TILL DONE 2410 STA STRNG2+1 YES, NOW MULTIPLY BE ELEMENT SIZE 2420 LDX #5 START WITH SIZE = 5 2430 LDA VARNAM DETERMINE VARIABLE TYPE 2440 BPL .2 NOT INTEGER 2450 DEX INTEGER, BACK DOWN SIZE TO 4 BYTES 2460 .2 LDA VARNAM+1 DISCRIMINATE BETWEEN REAL AND STR 2470 BPL .3 IT IS REAL 2480 DEX SIZE = 3 IF STRING, =2 IF INTEGER 2490 DEX 2500 .3 STX RESULT+2 SET UP MULTIPLIER 2510 LDA #0 HI-BYTE OF MULTIPLIER 2520 JSR MULTIPLY.SUBS.1 (STRNG2) BY ELEMENT SIZE 2530 TXA ADD ACCUMULATED OFFSET 2540 ADC ARYPNT TO ADDRESS OF 1ST ELEMENT 2550 STA VARPNT TO GET ADDRESS OF SPECIFIED ELEMENT 2560 TYA 2570 ADC ARYPNT+1 2580 STA VARPNT+1 2590 TAY RETURN WITH ADDR IN VARPNT 2600 LDA VARPNT AND IN Y,A 2610 RTS.9 RTS 2620 *-------------------------------- 2630 * MULTIPLY (STRNG2) BY ((LOWTR),Y) 2640 * LEAVING PRODUCT IN A,X. (HI-BYTE ALSO IN Y.) 2650 * USED ONLY BY ARRAY SUBSCRIPT ROUTINES 2660 *-------------------------------- 2670 MULTIPLY.SUBSCRIPT STY INDEX SAVE Y-REG 2680 LDA (LOWTR),Y GET MULTIPLIER 2690 STA RESULT+2 SAVE IN RESULT+2,3 2700 DEY 2710 LDA (LOWTR),Y 2720 *-------------------------------- 2730 MULTIPLY.SUBS.1 2740 STA RESULT+3 LOW BYTE OF MULTIPLIER 2750 LDA #16 MULTIPLY 16 BITS 2760 STA INDX 2770 LDX #0 PRODUCT = 0 INITIALLY 2780 LDY #0 2790 .1 TXA DOUBLE PRODUCT 2800 ASL LOW BYTE 2810 TAX 2820 TYA HIGH BYTE 2830 ROL IF TOO LARGE, SET CARRY 2840 TAY 2850 BCS GME TOO LARGE, "MEM FULL ERROR" 2860 ASL STRNG2 NEXT BIT OF MUTLPLICAND 2870 ROL STRNG2+1 INTO CARRY 2880 BCC .2 BIT=0, DON'T NEED TO ADD 2890 CLC BIT=1, ADD INTO PARTIAL PRODUCT 2900 TXA 2910 ADC RESULT+2 2920 TAX 2930 TYA 2940 ADC RESULT+3 2950 TAY 2960 BCS GME TOO LARGE, "MEM FULL ERROR" 2970 .2 DEC INDX 16-BITS YET? 2980 BNE .1 NO, KEEP SHUFFLING 2990 RTS YES, PRODUCT IN Y,X AND A,X 3000 *-------------------------------- 3010 * "FRE" FUNCTION 3020 * 3030 * COLLECTS GARBAGE AND RETURNS # BYTES OF MEMORY LEFT 3040 *-------------------------------- 3050 FRE LDA VALTYP LOOK AT VALUE OF ARGUMENT 3060 BEQ .1 =0 MEANS REAL, =$FF MEANS STRING 3070 JSR FREFAC STRING, SO SET IT FREE IS TEMP 3080 .1 JSR GARBAG COLLECT ALL THE GARBAGE IN SIGHT 3090 SEC COMPUTE SPACE BETWEEN ARRAYS AND 3100 LDA FRETOP STRING TEMP AREA 3110 SBC STREND 3120 TAY 3130 LDA FRETOP+1 3140 SBC STREND+1 FREE SPACE IN Y,A 3150 * FALL INTO GIVAYF TO FLOAT THE VALUE 3160 * NOTE THAT VALUES OVER 32767 WILL RETURN AS NEGATIVE 3170 *-------------------------------- 3180 * FLOAT THE SIGNED INTEGER IN A,Y 3190 *-------------------------------- 3200 GIVAYF LDX #0 MARK FAC VALUE TYPE REAL 3210 STX VALTYP 3220 STA FAC+1 SAVE VALUE FROM A,Y IN MANTISSA 3230 STY FAC+2 3240 LDX #$90 SET EXPONENT TO 2^16 3250 JMP FLOAT.1 CONVERT TO SIGNED FP 3260 *-------------------------------- 3270 * "POS" FUNCTION 3280 * 3290 * RETURNS CURRENT LINE POSITION FROM MON.CH 3300 *-------------------------------- 3310 POS LDY MON.CH GET A,Y = (MON.CH, GO TO GIVAYF 3320 *-------------------------------- 3330 * FLOAT (Y) INTO FAC, GIVING VALUE 0-255 3340 *-------------------------------- 3350 SNGFLT LDA #0 MSB = 0 3360 SEC <<< NO PURPOSE WHATSOEVER >>> 3370 BEQ GIVAYF ...ALWAYS 3380 *-------------------------------- 3390 * CHECK FOR DIRECT OR RUNNING MODE 3400 * GIVING ERROR IF DIRECT MODE 3410 *-------------------------------- 3420 ERRDIR LDX CURLIN+1 =$FF IF DIRECT MODE 3430 INX MAKES $FF INTO ZERO 3440 BNE RTS.9 RETURN IF RUNNING MODE 3450 LDX #ERR.ILLDIR DIRECT MODE, GIVE ERROR 3460 .HS 2C TRICK TO SKIP NEXT 2 BYTES 3470 *-------------------------------- 3480 UNDFNC LDX #ERR.UNDEFFUNC UNDEFINDED FUNCTION ERROR 3490 JMP ERROR 3500 *-------------------------------- 3510 * "DEF" STATEMENT 3520 *-------------------------------- 3530 DEF JSR FNC. PARSE "FN", FUNCTION NAME 3540 JSR ERRDIR ERROR IF IN DIRECT MODE 3550 JSR CHKOPN NEED "(" 3560 LDA #$80 FLAG PTRGET THAT CALLED FROM "DEF FN" 3570 STA SUBFLG ALLOW ONLY SIMPLE FP VARIABLE FOR ARG 3580 JSR PTRGET GET PNTR TO ARGUMENT 3590 JSR CHKNUM MUST BE NUMERIC 3600 JSR CHKCLS MUST HAVE ")" NOW 3610 LDA #TOKEN.EQUAL NOW NEED "=" 3620 JSR SYNCHR OR ELSE SYNTAX ERROR 3630 PHA SAVE CHAR AFTER "=" 3640 LDA VARPNT+1 SAVE PNTR TO ARGUMENT 3650 PHA 3660 LDA VARPNT 3670 PHA 3680 LDA TXTPTR+1 SAVE TXTPTR 3690 PHA 3700 LDA TXTPTR 3710 PHA 3720 JSR DATA SCAN TO NEXT STATEMENT 3730 JMP FNCDATA STORE ABOVE 5 BYTES IN "VALUE" 3740 *-------------------------------- 3750 * COMMON ROUTINE FOR "DEFFN" AND "FN", TO 3760 * PARSE "FN" AND THE FUNCTION NAME 3770 *-------------------------------- 3780 FNC. LDA #TOKEN.FN MUST NOW SEE "FN" TOKEN 3790 JSR SYNCHR OR ELSE SYNTAX ERROR 3800 ORA #$80 SET SIGN BIT ON 1ST CHAR OF NAME, 3810 STA SUBFLG MAKING $C0 < SUBFLG < $DB 3820 JSR PTRGET3 WHICH TELLS PTRGET WHO CALLED 3830 STA FNCNAM FOUND VALID FUNCTION NAME, SO 3840 STY FNCNAM+1 SAVE ADDRESS 3850 JMP CHKNUM MUST BE NUMERIC 3860 *-------------------------------- 3870 * "FN" FUNCTION CALL 3880 *-------------------------------- 3890 FUNCT JSR FNC. PARSE "FN", FUNCTION NAME 3900 LDA FNCNAM+1 STACK FUNCTION ADDRESS 3910 PHA IN CASE OF A NESTED FN CALL 3920 LDA FNCNAM 3930 PHA 3940 JSR PARCHK MUST NOW HAVE "(EXPRESSION)" 3950 JSR CHKNUM MUST BE NUMERIC EXPRESSION 3960 PLA GET FUNCTION ADDRESS BACK 3970 STA FNCNAM 3980 PLA 3990 STA FNCNAM+1 4000 LDY #2 POINT AT ADD OF ARGUMENT VARIABLE 4010 LDA (FNCNAM),Y 4020 STA VARPNT 4030 TAX 4040 INY 4050 LDA (FNCNAM),Y 4060 BEQ UNDFNC UNDEFINED FUNCTION 4070 STA VARPNT+1 4080 INY Y=4 NOW 4090 .1 LDA (VARPNT),Y SAVE OLD VALUE OF ARGUMENT VARIABLE 4100 PHA ON STACK, IN CASE ALSO USED AS 4110 DEY A NORMAL VARIABLE! 4120 BPL .1 4130 LDY VARPNT+1 (Y,X)= ADDRESS, STORE FAC IN VARIABLE 4140 JSR STORE.FAC.AT.YX.ROUNDED 4150 LDA TXTPTR+1 REMEMBER TXTPTR AFTER FN CALL 4160 PHA 4170 LDA TXTPTR 4180 PHA 4190 LDA (FNCNAM),Y Y=0 FROM MOVMF 4200 STA TXTPTR POINT TO FUNCTION DEF'N 4210 INY 4220 LDA (FNCNAM),Y 4230 STA TXTPTR+1 4240 LDA VARPNT+1 SAVE ADDRESS OF ARGUMENT VARIABLE 4250 PHA 4260 LDA VARPNT 4270 PHA 4280 JSR FRMNUM EVALUATE THE FUNCTION EXPRESSION 4290 PLA GET ADDRESS OF ARGUMENT VARIABLE 4300 STA FNCNAM AND SAVE IT 4310 PLA 4320 STA FNCNAM+1 4330 JSR CHRGOT MUST BE AT ":" OR EOL 4340 BEQ .2 WE ARE 4350 JMP SYNERR WE ARE NOT, SLYNTAX ERROR 4360 .2 PLA RETRIEVE TXTPTR AFTER "FN" CALL 4370 STA TXTPTR 4380 PLA 4390 STA TXTPTR+1 4400 * STACK NOW HAS 5-BYTE VALUE 4410 * OF THE ARGUMENT VARIABLE, 4420 * AND FNCNAM POINTS AT THE VARIABLE 4430 *-------------------------------- 4440 * STORE FIVE BYTES FROM STACK AT (FNCNAM) 4450 *-------------------------------- 4460 FNCDATA 4470 LDY #0 4480 PLA 4490 STA (FNCNAM),Y 4500 PLA 4510 INY 4520 STA (FNCNAM),Y 4530 PLA 4540 INY 4550 STA (FNCNAM),Y 4560 PLA 4570 INY 4580 STA (FNCNAM),Y 4590 PLA 4600 INY 4610 STA (FNCNAM),Y 4620 RTS