
 1000  *SAVE S.DP18 AMPER-LINK
 1010  *--------------------------------
 1020         .OR $803
 1030  *-------------------------------
 1040  *    APPLESOFT SUBROUTINES
 1050  *-------------------------------
 1060  AS.ADDON     .EQ $D998    ADD (Y) TO TXTPTR
 1070  AS.IF.JUMP   .EQ $D9DA    HANDLE T/F FOR IF
 1080  AS.FRMNUM    .EQ $DD67    EVAL FP FORMULA
 1090  AS.CHKCLS    .EQ $DEB8    CHECK FOR )
 1100  AS.CHKOPN    .EQ $DEBB    CHECK FOR (
 1110  AS.CHKCOM    .EQ $DEBE    CHECK FOR COMMA
 1120  AS.SYNCHR    .EQ $DEC0    CHARACTER SCAN OR FAIL
 1130  AS.SYNERR    .EQ $DEC9    SYNTAX ERROR
 1140  AS.PTRGET    .EQ $DFE3    FIND VARIABLE
 1150  AS.ISLETC    .EQ $E07D    LETTER CHECK
 1160  AS.FRMCPX    .EQ $E430    "FORMULA TOO COMPLEX" ERROR
 1170  AS.GETSPA    .EQ $E452    GET SPACE FOR STRING
 1180  AS.MOVSTR    .EQ $E5E2    MOVE STRING
 1190  *--------------------------------
 1200  *      PAGE ZERO USAGE
 1210  *-------------------------------
 1220  AS.VALTYP    .EQ $11    LAST FAC OP 0=NUM,FF=STRING 
 1230  ARYTAB       .EQ $6B,6C
 1240  AS.FRESPA    .EQ $71,72
 1250  VARNAM       .EQ $81,82
 1260  AS.CHRGET    .EQ $B1
 1270  AS.CHRGOT    .EQ $B7
 1280  TXTPTR       .EQ $B8,B9
 1290  P2           .EQ $F9
 1300  *--------------------------------
 1310  *   DP18 SUBROUTINES ASSEMBLED ELSEWHERE
 1320  *--------------------------------
 1330  DP.PRINT            .EQ $FFFF
 1340  DP.INPUT            .EQ $FFFF
 1350  FIN                 .EQ $FFFF
 1360  DP.SGN              .EQ $FFFF
 1370  DP.INT              .EQ $FFFF
 1380  DP.ABS              .EQ $FFFF
 1390  DP.SQR              .EQ $FFFF
 1400  DP.LOGE             .EQ $FFFF
 1410  DP.EXPE             .EQ $FFFF
 1420  DP.COS              .EQ $FFFF
 1430  DP.SIN              .EQ $FFFF
 1440  DP.TAN              .EQ $FFFF
 1450  MOVE.DAC.YA         .EQ $FFFF
 1460  QUICK.FOUT          .EQ $FFFF
 1470  DP.POWER            .EQ $FFFF
 1480  DSUB                .EQ $FFFF
 1490  DADD                .EQ $FFFF
 1500  DMULT               .EQ $FFFF
 1510  DDIV                .EQ $FFFF
 1520  DP.ATN              .EQ $FFFF
 1530  DP.VAL              .EQ $FFFF
 1540  MOVE.YA.DAC         .EQ $FFFF
 1550  MOVE.YA.DAC.1       .EQ $FFFF
 1560  *--------------------------------
 1570  *   AMPERSAND VECTORS
 1580  *--------------------------------
 1590           .DA DP18     STARTING ADDRESS FOR &-INTERPRETER
 1600  AMP.LINK .DA AS.SYNERR   LINK TO NEXT &-INTERPRETER
 1610  *-------------------------------
 1620  *      WORK AREAS FOR DPFP
 1630  *-------------------------------
 1640  WORK          .EQ * 
 1650  SGNEXP        .BS 1
 1660  EXP           .BS 1
 1670  DGTCNT        .BS 1
 1680  DECFLG        .BS 1
 1690  *-------------------------------
 1700  DAC           .BS 12
 1710  DAC.EXPONENT  .EQ DAC
 1720  DAC.HI        .EQ DAC+1
 1730  DAC.EXTENSION .EQ DAC+10
 1740  DAC.SIGN      .EQ DAC+11
 1750  *-------------------------------
 1760  WRKSZ         .EQ *-WORK
 1770  *-------------------------------
 1780  ARG           .BS 12
 1790  *--------------------------------
 1800  *BUFFER FOR 'FOUT' AND
 1810  *LARGE ACC FOR MULTIPLICATION
 1820  *--------------------------------
 1830  FOUT.BUF      .BS 41
 1840  FOUT.BUF.SIZE .EQ *-FOUT.BUF
 1850  MAC           .EQ FOUT.BUF
 1860  *-------------------------------
 1870  STACK.SIZE    .EQ 12*10 10 ENTRIES BEFORE OVERFLOW
 1880  STACK.PNTR    .BS 1
 1890  STACK         .BS STACK.SIZE
 1900  RPAREN.CNT    .BS 1
 1910  *-------------------------------
 1920  REL.OPS       .BS 1
 1930  RESULT        .BS 2
 1940  INDEX         .BS 1
 1950  *-------------------------------
 1960  *      TOKEN ASSIGNMENTS
 1970  *-------------------------------
 1980  TKN.PLUS   .EQ 200  +
 1990  TKN.MINUS  .EQ 201  -
 2000  TKN.STAR   .EQ 202  *
 2010  TKN.SLASH  .EQ 203  /
 2020  TKN.POWER  .EQ 204  ^
 2030  TKN.EQUAL  .EQ 208  =
 2040  TKN.PRINT  .EQ 186  PRINT
 2050  TKN.INPUT  .EQ 132  INPUT
 2060  TKN.STR    .EQ 228  STR$
 2070  TKN.IF     .EQ 173  IF
 2080  TKN.THEN   .EQ 196  THEN
 2090  TKN.GOTO   .EQ 171  GOTO
 2100  TKN.NOT    .EQ 198  NOT
 2110  TKN.AND    .EQ 205  AND
 2120  TKN.OR     .EQ 206  OR
 2130  *-------------------------------
 2140  *      JMP TABLE FOR FUNCTIONS
 2150  *--------------------------------
 2160  DP.FUNC
 2170         .DA DP.SGN-1        SGN (TKN 210)
 2180         .DA DP.INT-1        INT
 2190         .DA DP.ABS-1        ABS
 2200         .DA AS.SYNERR-1     USR
 2210         .DA AS.SYNERR-1     FRE
 2220         .DA AS.SYNERR-1     SCRN(
 2230         .DA AS.SYNERR-1     PDL
 2240         .DA AS.SYNERR-1     POS
 2250         .DA DP.SQR-1        SQR
 2260         .DA AS.SYNERR-1     RND
 2270         .DA DP.LOGE-1       LOG  #220
 2280         .DA DP.EXPE-1       EXP
 2290         .DA DP.COS-1        COS
 2300         .DA DP.SIN-1        SIN
 2310         .DA DP.TAN-1        TAN
 2320  *      ATN HANDLED SPECIALLY
 2330  *--------------------------------
 2340  *--------------------------------
 2350  *      &-INTERPRETER FOR DP18
 2360  *--------------------------------
 2370  NOT.DP18.CALL
 2380         JSR AS.CHRGOT
 2390         JMP (AMP.LINK)  SYNTAX ERROR OR NEXT CHAINED &-ROUTINE
 2400  *--------------------------------
 2410  *   & ENTRY POINT
 2420  *--------------------------------
 2430  DP18   CMP #'D'     CHECK FOR "DP:" AFTER "&"
 2440         BNE NOT.DP18.CALL
 2450         LDY #1
 2460         LDA (TXTPTR),Y
 2470         CMP #'P'
 2480         BNE NOT.DP18.CALL
 2490         INY          ADD 2 TO TXTPTR, TO POINT
 2500         JSR AS.ADDON      AT NEXT CHAR AFTER "&DP"
 2510  *--------------------------------
 2520  DP.NEXT.CMD
 2530         JSR AS.CHRGOT  SEE IF EOL
 2540         BNE DP.SYNERR.1  ...NEITHER COLON NOR EOL
 2550         TAY          CHECK FOR EOL
 2560         BEQ .3       ...EOL, SO RETURN
 2570         JSR AS.CHRGET     CHARACTER AFTER COLON
 2580         BEQ .3       ...COLON OR EOL
 2590         CMP #TKN.PRINT
 2600         BEQ .1
 2610         CMP #TKN.INPUT
 2620         BEQ .2
 2630         CMP #TKN.IF
 2640         BEQ DP.IF
 2650         JSR GET.A.VAR GET ADDRESS OF VAR
 2660         LDX AS.VALTYP
 2670         BMI DP.STR  STRING VAR
 2680         JSR CHECK.DP.VAR
 2690         STY RESULT+1   SAVE ADRS OF VARIABLE
 2700         STA RESULT
 2710         LDA #TKN.EQUAL   NEXT CHAR MUST BE "="
 2720         JSR AS.SYNCHR  OR ELSE SYNTAX ERROR
 2730         JSR DP.EVALUATE
 2740         LDA RESULT
 2750         LDY RESULT+1
 2760         JSR MOVE.DAC.YA
 2770         JMP DP.NEXT.CMD
 2780  .1     JMP DP.PRINT
 2790  .2     JMP DP.INPUT
 2800  .3     RTS
 2810  *--------------------------------
 2820  DP.SYNERR.1
 2830         JMP AS.SYNERR
 2840  *--------------------------------
 2850  *   <STRING> = STR$(<DPEXP>)
 2860  *--------------------------------
 2870  DP.STR STA P2            SAVE ADDR OF STRING VARIABLE
 2880         STY P2+1
 2890         LDA #TKN.EQUAL    MUST HAVE "="
 2900         JSR AS.SYNCHR
 2910         LDA #TKN.STR      MUST HAVE "STR$"
 2920         JSR AS.SYNCHR
 2930         JSR AS.CHKOPN     MUST HAVE "("
 2940         JSR DP.EVALUATE   GET EXPRESSION
 2950         JSR AS.CHKCLS     MUST HAVE ")"
 2960         JSR QUICK.FOUT    CONVERT TO SIMPLE STR$ FORMAT
 2970         DEC INDEX         DON'T COUNT TRAILING $00 BYTE
 2980         LDA INDEX         GET LENGTH
 2990         JSR AS.GETSPA     GET SPACE IN STRING AREA
 3000         LDY #0            MOVE DATA INTO VARIABLE
 3010         STA (P2),Y        LENGTH
 3020         LDA AS.FRESPA
 3030         INY
 3040         STA (P2),Y        LO ADDRESS
 3050         LDA AS.FRESPA+1
 3060         INY
 3070         STA (P2),Y        HI ADDRESS
 3080         LDX #FOUT.BUF     COPY STRING DATA INTO PLACE
 3090         LDY /FOUT.BUF
 3100         LDA INDEX
 3110         JSR AS.MOVSTR
 3120         JMP DP.NEXT.CMD
 3130  *--------------------------------
 3140  *   IF <DPEXP> THEN <NORMAL STATEMENTS>
 3150  *   IF <DPEXP> THEN <LINE #>
 3160  *   IF <DPEXP> GOTO <LINE #>
 3170  *--------------------------------
 3180  DP.IF  JSR AS.CHRGET     GOBBLE THE IF
 3190         JSR DP.EVALUATE   GET THE EXPRESSION
 3200         JSR AS.CHRGOT     GET NEXT CHAR
 3210         CMP #TKN.GOTO     GOTO?
 3220         BEQ .1            ...YES
 3230         LDA #TKN.THEN     ...NO, TRY "THEN"
 3240         JSR AS.SYNCHR
 3250  .1     LDA DAC.EXPONENT  GET RESULT OF EXPRESSION
 3260         JMP AS.IF.JUMP    LET APPLESFOT FIRMWARE DO IT
 3270  * AS.IF.JUMP COMPARES ACC TO 0. IF 0, IT SKIPS
 3280  * TO NEXT PROG. LINE. IF # 0, IT EXECUTES NEXT STATEMENT
 3290  *--------------------------------
 3300  *   GET VARIABLE NAME AND ADDRESS
 3310  *--------------------------------
 3320  GET.A.VAR
 3330         JSR AS.ISLETC     1ST CHAR MUST BE LETTER
 3340         BCC DP.SYNERR.1       NO, SYN ERR
 3350         JMP AS.PTRGET GET ADRS OF VAR
 3360  *--------------------------------
 3370  *   CHECK IF VALID DP18 VARIABLE
 3380  *      ASSUME THIS ROUTINE CALLED AFTER "GET.A.VAR"
 3390  *      A DP18 VARIABLE MUST BE A REAL ARRAY
 3400  *--------------------------------
 3410  CHECK.DP.VAR
 3420         CPY ARYTAB+1      BE SURE IT IS AN ARRAY
 3430         BCC DP.SYNERR.1       NO, SYNTAX ERROR
 3440         BNE .1       YES, AN ARRAY
 3450         CMP ARYTAB
 3460         BCC DP.SYNERR.1       NOT AN ARRAY, SYNTAX ERROR
 3470  .1     BIT VARNAM+1 BE SURE FLOATING POINT
 3480         BMI DP.SYNERR.1       NO, SYNTAX ERROR
 3490         RTS
 3500  *--------------------------------
 3510  *   EVALUATE DP18 EXPRESSION
 3520  *--------------------------------
 3530  DP.EVALUATE
 3540         LDA #0            START WITH EMPTY STACK
 3550         STA RPAREN.CNT    ...AND NO PARENTHESES
 3560         STA STACK.PNTR
 3570         JSR DP.ZERO       ZERO TO DAC
 3580         JSR DP.EXP        EVALUATE AN EXPRESSION
 3590         LDA STACK.PNTR    SHOULD BE BACK TO EMPTY STACK
 3600         ORA RPAREN.CNT    AND NO PARENTHESES
 3610         BNE DP.SYNERR.2   ...SYNTAX ERROR
 3620         RTS               ...ALL OKAY!
 3630  *--------------------------------
 3640  *   GENERAL EXPRESSION
 3650  *      EXP = RELAT
 3660  *      EXP = EXP LOGOP RELAT
 3670  *    LOGOP = "AND" OR "OR"
 3680  *--------------------------------
 3690  DP.EXP JSR DP.RELAT
 3700  .1     JSR AS.CHRGOT
 3710         CMP #TKN.AND
 3720         BEQ .3
 3730         CMP #TKN.OR
 3740         BNE .6       ...FINISHED
 3750  *---<EXP> OR <EXP>---------------
 3760         JSR .5       GET NEXT RELAT
 3770         ORA DAC.EXPONENT
 3780         BNE .4       ...TRUE
 3790  .2     JSR DP.FALSE ...FALSE
 3800         JMP .1
 3810  *---<EXP> AND <EXP>--------------
 3820  .3     JSR .5       GET NEXT RELAT
 3830         AND DAC.EXPONENT
 3840         BEQ .2       ...FALSE
 3850  .4     JSR DP.TRUE  ...TRUE
 3860         JMP .1
 3870  *---GET <EXP> AFTER RELOP--------
 3880  .5     LDA DAC.EXPONENT
 3890         PHA
 3900         JSR AS.CHRGET
 3910         JSR DP.RELAT
 3920         PLA
 3930  .6     RTS
 3940  *--------------------------------
 3950  DP.SYNERR.2
 3960         JMP AS.SYNERR
 3970  *--------------------------------
 3980  *   RELATIONAL EXPRESSION
 3990  *      RELAT = SUM
 4000  *      RELAT = RELAT RELOP SUM
 4010  *      RELOP = "<", "=", ">", "<=", "=<", ">=",
 4020  *              "=>", "<>", OR "><"
 4030  *--------------------------------
 4040  DP.RELAT
 4050         JSR DP.SUM   GET <EXP>
 4060  .1     LDA #0
 4070         STA REL.OPS
 4080         JSR AS.CHRGOT
 4090  .2     SEC          > IS $CF, = IS $D0, < IS $D1
 4100         SBC #$CF     > IS 0, = IS 1, < IS 2
 4110         BCC .4       ...NOT RELOP
 4120         CMP #$03
 4130         BCS .4       ...NOT RELOP
 4140         ROL          > IS 0, = IS 2, < IS 4
 4150         BNE .3       4 OR 2
 4160         LDA #1       > IS 1
 4170  .3     EOR REL.OPS  SET BITS IN REL.OPS: 00000<=>
 4180         CMP REL.OPS  CHECK FOR REPEATED OPS
 4190         BCC DP.SYNERR.2   ...YES, SYNTAX ERROR
 4200         STA REL.OPS
 4210         JSR AS.CHRGET     GET NEXT CHAR
 4220         JMP .2       CHECK FOR <=> AGAIN
 4230  *---PERFORM RELOP----------------
 4240  .4     LDA REL.OPS  WERE THERE ANY?
 4250         BEQ .8       NO, RETURN
 4260         CMP #7       ALL THREE OPS?
 4270         BEQ DP.SYNERR.2   ...YES, SYNTAX ERROR
 4280         JSR PUSH.DAC.STACK  SAVE EXP1
 4290         JSR DP.SUM          GET NEXT EXP2
 4300         JSR POP.STACK.ARG   GET EXP1 IN ARG
 4310         JSR DSUB            FORM EXP1 - EXP2
 4320         LDA DAC.EXPONENT
 4330         BEQ .45             EXP1 = EXP2
 4340         LDA DAC.SIGN
 4350         BMI .6              EXP1 < EXP2
 4360         LDA REL.OPS         EXP1 > EXP2
 4370         AND #$01            ">" OPERATOR?
 4380         BEQ .7              ...NO, FALSE
 4390         BNE .5              ...YES, TRUE
 4400  .45    LDA REL.OPS  EXP1 = EXP2
 4410         AND #$02     "=" OPERATOR?
 4420         BEQ .7       ...NO, FALSE
 4430  .5     JSR DP.TRUE  ...YES, TRUE
 4440         JMP .1
 4450  .6     LDA REL.OPS  EXP1 < EXP2
 4460         AND #$04     "<" OPERATOR?
 4470         BNE .5       ...YES, TRUE
 4480  .7     JSR DP.FALSE ...NO, FALSE
 4490         JMP .1
 4500  .8     RTS
 4510  *--------------------------------
 4520  *   SUMMATION
 4530  *      SUM = TERM
 4540  *      SUM = SUM ADDOP TERM
 4550  *    ADDOP = "+" OR "-"
 4560  *--------------------------------
 4570  DP.SUM JSR DP.TERM
 4580  .1     JSR AS.CHRGOT
 4590         CMP #TKN.PLUS
 4600         BEQ .3       +
 4610         CMP #'+
 4620         BEQ .3       +
 4630         CMP #TKN.MINUS
 4640         BEQ .4       -
 4650         CMP #'-
 4660         BEQ .4       -
 4670         RTS          END OF EXP
 4680  .3     CLC          .CC. FOR +, .CS. FOR -
 4690  .4     PHP          SAVE WHETHER + OR -
 4700         JSR PUSH.DAC.STACK
 4710         JSR AS.CHRGET
 4720         JSR DP.TERM
 4730         JSR POP.STACK.ARG
 4740         PLP          .CC. FOR +, .CS. FOR -
 4750         BCC .5
 4760         LDA DAC.SIGN
 4770         EOR #$FF
 4780         STA DAC.SIGN
 4790  .5     JSR DADD
 4800         JMP .1
 4810  *--------------------------------
 4820  *   TERMS OF A SUMMATION
 4830  *      TERM = FACTOR
 4840  *      TERM = TERM MULOP FACTOR
 4850  *     MULOP = "*" OR "/"
 4860  *--------------------------------
 4870  DP.TERM
 4880         JSR DP.FACTOR
 4890  .1     JSR AS.CHRGOT
 4900         CMP #TKN.STAR     *?
 4910         BEQ .2
 4920         CMP #TKN.SLASH    / ?
 4930         BEQ .3
 4940         RTS
 4950  .2     CLC          .CC. FOR *, .CS. FOR /
 4960  .3     PHP          SAVE * OR / FLAG
 4970         JSR PUSH.DAC.STACK
 4980         JSR AS.CHRGET
 4990         JSR DP.FACTOR
 5000         JSR POP.STACK.ARG
 5010         PLP          GET * OR / FLAG
 5020         BCS .4       .../
 5030         JSR DMULT    ...*
 5040         JMP .1
 5050  .4     JSR DDIV
 5060         JMP .1
 5070  *--------------------------------
 5080  *   FACTORS OF A TERM
 5090  *      FACTOR = ELEMENT
 5100  *      FACTOR = FACTOR ^ ELEMENT
 5110  *--------------------------------
 5120  DP.FACTOR
 5130         JSR AS.CHRGOT
 5140         JSR DP.ELEMENT.1
 5150  .1     JSR AS.CHRGOT
 5160         CMP #TKN.POWER  ^?
 5170         BEQ .2
 5180         RTS          NO
 5190  .2     JSR PUSH.DAC.STACK
 5200         JSR DP.ELEMENT
 5210         JSR POP.STACK.ARG
 5220         JSR DP.POWER
 5230         JMP .1
 5240  *--------------------------------
 5250  *   ELEMENTS OF A FACTOR
 5260  *      ELEMENT = NUMBER, VARIABLE, OR FUNCTION()
 5270  *      ELEMENT = (EXP)
 5280  *      ELEMENT = UNARY ELEMENT
 5290  *        UNARY = "+" OR "-" OR "NOT"
 5300  *--------------------------------
 5310  DP.ELEMENT
 5320         JSR AS.CHRGET
 5330  DP.ELEMENT.1
 5340         CMP #TKN.PLUS     CHECK FOR UNARY +
 5350         BEQ DP.ELEMENT    ...YES, JUST IGNORE IT
 5360         CMP #TKN.MINUS    CHECK FOR UNARY -
 5370         BNE .1            ...NO
 5380         JSR DP.ELEMENT    GET THE EXP VALUE (RECURSIVE CALL)
 5390         LDA DAC.SIGN   AND NEGATE IT
 5400         EOR #$FF
 5410         STA DAC.SIGN
 5420         RTS
 5430  *---CHECK FOR (EXP)--------------
 5440  .1     CMP #'(
 5450         BNE .2       ...NO
 5460         INC RPAREN.CNT
 5470         JSR AS.CHRGET  GET 1ST CHAR OF EXP
 5480         JSR DP.EXP   (EXP)
 5490         JSR AS.CHKCLS
 5500         DEC RPAREN.CNT
 5510         RTS
 5520  *---TRY VARIOUS FUNCTIONS--------
 5530  .2     TAY               SEE IF FUNCTION
 5540         BPL DP.VARNUM     ...NO, TRY NUMBER OR VARIABLE
 5550         CMP #TKN.NOT      "NOT"?
 5560         BEQ .5            ...YES
 5570         CMP #210          CHECK RANGE
 5580         BCC DP.SYNERR.3   ...NOT VALID DP FUNCTION
 5590         CMP #229          MAY BE "VAL"
 5600         BEQ .4            ...VAL(STRING)
 5610         CMP #225          ATN?
 5620         BCC .3            ...NO, BUT IN RANGE FOR OTHERS
 5630         BNE DP.SYNERR.3   ...NOT VALID DP18 FUNCTION
 5640         JMP DP.ATN
 5650  .3     SBC #209          CARRY CLEAR SUBS 1 MORE
 5660         ASL               MULT BY 2
 5670         TAY               INDEX INTO TABLE
 5680         LDA DP.FUNC+1,Y   GET HI ADR
 5690         PHA
 5700         LDA DP.FUNC,Y     GET LO ADR
 5710         PHA
 5720         JSR AS.CHRGET
 5730         JSR AS.CHKOPN MUST HAVE (
 5740         INC RPAREN.CNT
 5750         JSR DP.EXP   EVALUATE ARG
 5760         JSR AS.CHKCLS
 5770         DEC RPAREN.CNT
 5780         RTS          EVALUATES FUNCTION
 5790  *---"VAL" FUNCTION---------------
 5800  .4     JSR AS.CHRGET
 5810         JSR AS.CHKOPN
 5820         JSR DP.VAL
 5830         JMP AS.CHKCLS
 5840  *---"NOT" ELEMENT----------------
 5850  .5     JSR DP.ELEMENT    GET ARGUMENT (RECURSIVE CALL)
 5860         LDA DAC.EXPONENT
 5870         BEQ DP.TRUE
 5880  *      FALL INTO DP.FALSE
 5890  *--------------------------------
 5900  DP.ZERO
 5910  DP.FALSE
 5920         LDA #0       FALSE, PUT 0 IN DAC
 5930         LDY #11
 5940  .1     STA DAC,Y
 5950         DEY
 5960         BPL .1
 5970         RTS
 5980  *--------------------------------
 5990  DP.TRUE
 6000         LDA #CON.ONE      TRUE, PUT 1 IN DAC
 6010         LDY /CON.ONE
 6020         JMP MOVE.YA.DAC
 6030  *--------------------------------
 6040  DP.SYNERR.3 JMP AS.SYNERR
 6050  *--------------------------------
 6060  *   VARIABLE OR NUMBER
 6070  *      VARNUM = DP18 VARIABLE
 6080  *      VARNUM = NUMBER
 6090  *      VARNUM = NEGOP NUMBER
 6100  *      VARNUM = "PI"
 6110  *--------------------------------
 6120  DP.VARNUM
 6130         LDY #0
 6140         LDA (TXTPTR),Y
 6150         CMP #'P      CHECK FOR PI
 6160         BNE .1
 6170         INY          Y=1
 6180         LDA (TXTPTR),Y
 6190         CMP #'I
 6200         BNE .1
 6210         INY          Y=2
 6220         LDA (TXTPTR),Y
 6230         CMP #'(      MUST NOT BE ARRAY
 6240         BEQ .1
 6250         JSR AS.ADDON      ADVANCE TXTPTR PAST "PI"
 6260         LDA #CON.PI
 6270         LDY /CON.PI
 6280         JMP MOVE.YA.DAC.1 GET PI INTO DAC W/GUARD DIGITS
 6290  *---CHECK FOR VARIABLE-----------
 6300  .1     JSR AS.CHRGOT
 6310         JSR AS.ISLETC
 6320         BCC .2            ...NOT LETTER, TRY NUMBER
 6330         JSR AS.PTRGET     ...LETTER, GET VARIABLE ADDR
 6340         JSR CHECK.DP.VAR  BE SURE IT IS REAL ARRAY
 6350         JMP MOVE.YA.DAC   GET VALUE INTO DAC
 6360  *---CHECK FOR NUMBER-------------
 6370  .2     CMP #'.      DECIMAL POINT?
 6380         BEQ .3       YES
 6390         CMP #TKN.PLUS PLUS?
 6400         BEQ .3       YES
 6410         CMP #TKN.MINUS MINUS?
 6420         BEQ .3       YES
 6430         CMP #'0
 6440         BCC DP.SYNERR.3       NOT A DIGIT
 6450         CMP #'9+1
 6460         BCS DP.SYNERR.3       NOT A DIGIT
 6470  .3     JMP FIN      CONVERT NUMBER
 6480  *--------------------------------
 6490  *      PUSH (DAC) ONTO EXPRESSION STACK
 6500  *--------------------------------
 6510  PUSH.DAC.STACK
 6520         LDY STACK.PNTR
 6530         CPY #STACK.SIZE-12
 6540         BCS .2       STACK ALREADY FULL
 6550         LDX #0
 6560  .1     LDA DAC,X
 6570         STA STACK,Y
 6580         INY
 6590         INX
 6600         CPX #12      STACK 12 BYTES
 6610         BCC .1
 6620         STY STACK.PNTR
 6630         RTS
 6640  .2     JMP AS.FRMCPX  FORMULA TOO COMPLEX
 6650  *--------------------------------
 6660  *      POP EXPRESSION STACK INTO ARG
 6670  *--------------------------------
 6680  POP.STACK.ARG
 6690         LDY STACK.PNTR
 6700         BEQ DP.SYNERR.3   STACK IS EMPTY
 6710         LDX #11
 6720  .1     DEY
 6730         LDA STACK,Y
 6740         STA ARG,X
 6750         DEX
 6760         BPL .1
 6770         STY STACK.PNTR
 6780         RTS
 6790  *--------------------------------
 6800  CON.ONE    .HS 4110000000000000000000
 6810  CON.PI     .HS 4131415926535897932385
 6820  *--------------------------------

