.segment "CODE" ; ---------------------------------------------------------------------------- ; COMPUTE ADDRESS OF FIRST VALUE IN ARRAY ; ARYPNT = (LOWTR) + #DIMS*2 + 5 ; ---------------------------------------------------------------------------- GETARY: lda EOLPNTR asl a adc #$05 adc LOWTR ldy LOWTR+1 bcc L2FAF iny L2FAF: sta HIGHDS sty HIGHDS+1 rts ; ---------------------------------------------------------------------------- NEG32768: .byte $90,$80,$00,$00 .ifdef CONFIG_2C .byte $00; bugfix: short number .endif ; ---------------------------------------------------------------------------- ; EVALUATE NUMERIC FORMULA AT TXTPTR ; CONVERTING RESULT TO INTEGER 0 <= X <= 32767 ; IN FAC+3,4 ; ---------------------------------------------------------------------------- MAKINT: jsr CHRGET .ifdef CONFIG_2 jsr FRMEVL .else jsr FRMNUM .endif ; ---------------------------------------------------------------------------- ; CONVERT FAC TO INTEGER ; MUST BE POSITIVE AND LESS THAN 32768 ; ---------------------------------------------------------------------------- MKINT: .ifdef CONFIG_2 jsr CHKNUM .endif lda FACSIGN bmi MI1 ; ---------------------------------------------------------------------------- ; CONVERT FAC TO INTEGER ; MUST BE -32767 <= FAC <= 32767 ; ---------------------------------------------------------------------------- AYINT: lda FAC cmp #$90 bcc MI2 lda #NEG32768 jsr FCOMP MI1: bne IQERR MI2: jmp QINT ; ---------------------------------------------------------------------------- ; LOCATE ARRAY ELEMENT OR CREATE AN ARRAY ; ---------------------------------------------------------------------------- ARRAY: lda DIMFLG .ifndef CONFIG_SMALL ora VALTYP+1 .endif pha lda VALTYP pha ldy #$00 L2FDE: tya pha lda VARNAM+1 pha lda VARNAM pha jsr MAKINT pla sta VARNAM pla sta VARNAM+1 pla tay tsx lda STACK+2,x pha lda STACK+1,x pha lda FAC_LAST-1 sta STACK+2,x lda FAC_LAST sta STACK+1,x iny jsr CHRGOT cmp #$2C beq L2FDE sty EOLPNTR jsr CHKCLS pla sta VALTYP pla .ifndef CONFIG_SMALL sta VALTYP+1 and #$7F .endif sta DIMFLG ; ---------------------------------------------------------------------------- ; SEARCH ARRAY TABLE FOR THIS ARRAY NAME ; ---------------------------------------------------------------------------- ldx ARYTAB lda ARYTAB+1 L301F: stx LOWTR sta LOWTR+1 cmp STREND+1 bne L302B cpx STREND beq MAKE_NEW_ARRAY L302B: ldy #$00 lda (LOWTR),y iny cmp VARNAM bne L303A lda VARNAM+1 cmp (LOWTR),y beq USE_OLD_ARRAY L303A: iny lda (LOWTR),y clc adc LOWTR tax iny lda (LOWTR),y adc LOWTR+1 bcc L301F ; ---------------------------------------------------------------------------- ; ERROR: BAD SUBSCRIPTS ; ---------------------------------------------------------------------------- SUBERR: ldx #ERR_BADSUBS .byte $2C ; ---------------------------------------------------------------------------- ; ERROR: ILLEGAL QUANTITY ; ---------------------------------------------------------------------------- IQERR: ldx #ERR_ILLQTY JER: jmp ERROR ; ---------------------------------------------------------------------------- ; FOUND THE ARRAY ; ---------------------------------------------------------------------------- USE_OLD_ARRAY: ldx #ERR_REDIMD lda DIMFLG bne JER jsr GETARY lda EOLPNTR ldy #$04 cmp (LOWTR),y bne SUBERR jmp FIND_ARRAY_ELEMENT ; ---------------------------------------------------------------------------- ; CREATE A NEW ARRAY, UNLESS CALLED FROM GETARYPT ; ---------------------------------------------------------------------------- MAKE_NEW_ARRAY: jsr GETARY jsr REASON lda #$00 tay sta STRNG2+1 ldx #BYTES_PER_ELEMENT .if .def(CONFIG_SMALL) && (!.def(CONFIG_2)) stx STRNG2 .endif lda VARNAM sta (LOWTR),y .ifndef CONFIG_SMALL bpl L3078 dex L3078: .endif iny lda VARNAM+1 sta (LOWTR),y .if (!.def(CONFIG_SMALL)) || .def(CONFIG_2) bpl L3081 dex .if !(.def(CONFIG_SMALL) && .def(CONFIG_2)) dex .endif L3081: stx STRNG2 .endif lda EOLPNTR iny iny iny sta (LOWTR),y L308A: ldx #$0B lda #$00 bit DIMFLG bvc L309A pla clc adc #$01 tax pla adc #$00 L309A: iny sta (LOWTR),y iny txa sta (LOWTR),y jsr MULTIPLY_SUBSCRIPT stx STRNG2 sta STRNG2+1 ldy INDEX dec EOLPNTR bne L308A adc HIGHDS+1 bcs GME sta HIGHDS+1 tay txa adc HIGHDS bcc L30BD iny beq GME L30BD: jsr REASON sta STREND sty STREND+1 lda #$00 inc STRNG2+1 ldy STRNG2 beq L30D1 L30CC: dey sta (HIGHDS),y bne L30CC L30D1: dec HIGHDS+1 dec STRNG2+1 bne L30CC inc HIGHDS+1 sec lda STREND sbc LOWTR ldy #$02 sta (LOWTR),y lda STREND+1 iny sbc LOWTR+1 sta (LOWTR),y lda DIMFLG bne RTS9 iny ; ---------------------------------------------------------------------------- ; FIND SPECIFIED ARRAY ELEMENT ; ; (LOWTR),Y POINTS AT # OF DIMS IN ARRAY DESCRIPTOR ; THE SUBSCRIPTS ARE ALL ON THE STACK AS INTEGERS ; ---------------------------------------------------------------------------- FIND_ARRAY_ELEMENT: lda (LOWTR),y sta EOLPNTR lda #$00 sta STRNG2 L30F6: sta STRNG2+1 iny pla tax sta FAC_LAST-1 pla sta FAC_LAST cmp (LOWTR),y bcc FAE2 bne GSE iny txa cmp (LOWTR),y bcc FAE3 ; ---------------------------------------------------------------------------- GSE: jmp SUBERR GME: jmp MEMERR ; ---------------------------------------------------------------------------- FAE2: iny FAE3: lda STRNG2+1 ora STRNG2 clc beq L3124 jsr MULTIPLY_SUBSCRIPT txa adc FAC_LAST-1 tax tya ldy INDEX L3124: adc FAC_LAST stx STRNG2 dec EOLPNTR bne L30F6 .if .def(CONFIG_SMALL) && (!.def(CONFIG_2)) asl STRNG2 rol a bcs GSE asl STRNG2 rol a bcs GSE tay lda STRNG2 .else .ifdef CONFIG_11A sta STRNG2+1 .endif ldx #BYTES_FP .ifdef CONFIG_SMALL lda VARNAM+1 .else lda VARNAM .endif bpl L3135 dex L3135: .ifdef CONFIG_SMALL stx RESULT+1 .else lda VARNAM+1 bpl L313B dex dex L313B: stx RESULT+2 .endif lda #$00 jsr MULTIPLY_SUBS1 txa .endif adc HIGHDS sta VARPNT tya adc HIGHDS+1 sta VARPNT+1 tay lda VARPNT RTS9: rts ; ---------------------------------------------------------------------------- ; MULTIPLY (STRNG2) BY ((LOWTR),Y) ; LEAVING PRODUCT IN A,X. (HI-BYTE ALSO IN Y.) ; USED ONLY BY ARRAY SUBSCRIPT ROUTINES ; ---------------------------------------------------------------------------- MULTIPLY_SUBSCRIPT: sty INDEX lda (LOWTR),y sta RESULT_LAST-2 dey lda (LOWTR),y MULTIPLY_SUBS1: sta RESULT_LAST-1 lda #$10 sta INDX ldx #$00 ldy #$00 L3163: txa asl a tax tya rol a tay bcs GME asl STRNG2 rol STRNG2+1 bcc L317C clc txa adc RESULT_LAST-2 tax tya adc RESULT_LAST-1 tay bcs GME L317C: dec INDX bne L3163 rts