Subversion Repositories pentevo

Rev

Blame | Last modification | View Log | Download | RSS feed | ?url?

  1. ;  December 18, 1986
  2. ;  MS-DOS compatible Source code for MCS BASIC-52 (tm)
  3. ;  Assembles with ASM51 Macro Assembler Version 2.2
  4. ;
  5. ;  The following source code does not include the floating point math
  6. ;  routines. These are seperately compiled using FP52.SRC.
  7. ;
  8. ;  Both the BASIC.SRC and FP52.SRC programs assemble into ABSOLUTE
  9. ;  object files, and do not need to be relocated or linked. The FP52
  10. ;  object code and the BASIC object code, when compiled without modification
  11. ;  of the source listings, create the same object code that is found on
  12. ;  the MCS BASIC-52 Version 1.1 microcontrollers.
  13. ;
  14. ;  The original source code had 7 "include" files that have been incorporated
  15. ;  into this file for ease of assembly.
  16. ;  These 7 files are: LOOK52.SRC, BAS52.RST, BAS52.PGM, BAS52.TL, BAS52.OUT,
  17. ;  BAS52.PWM, and BAS52.CLK.
  18. ;
  19. ;
  20. ;                       Intel Corporation, Embedded Controller Operations
  21.  
  22.         cpu     8052
  23.  
  24.         page    0
  25.         newpage
  26.  
  27.         include stddef51.inc
  28.         include bitfuncs.inc
  29.         bigendian on
  30.  
  31.         segment code
  32.  
  33.         ;**************************************************************
  34.         ;
  35.         ; TRAP VECTORS TO MONITOR
  36.         ;
  37.         ; RESET TAG (0AAH) ---------2001H
  38.         ;
  39.         ; TAG LOCATION (5AH) ------ 2002H
  40.         ;
  41.         ; EXTERNAL INTERRUPT 0 ---- 2040H
  42.         ;
  43.         ; COMMAND MODE ENTRY ------ 2048H
  44.         ;
  45.         ; SERIAL PORT ------------- 2050H
  46.         ;
  47.         ; MONITOR (BUBBLE) OUTPUT - 2058H
  48.         ;
  49.         ; MONITOR (BUBBLE) INPUT -- 2060H
  50.         ;
  51.         ; MONITOR (BUBBLE) CSTS --- 2068H
  52.         ;
  53.         ; GET USER JUMP VECTOR ---- 2070H
  54.         ;
  55.         ; GET USER LOOKUP VECTOR -- 2078H
  56.         ;
  57.         ; PRINT AT VECTOR --------- 2080H
  58.         ;
  59.         ; INTERRUPT PWM ----------- 2088H
  60.         ;
  61.         ; EXTERNAL RESET ---------- 2090H
  62.         ;
  63.         ; USER OUTPUT-------------- 4030H
  64.         ;
  65.         ; USER INPUT -------------- 4033H
  66.         ;
  67.         ; USER CSTS --------------- 4036H
  68.         ;
  69.         ; USER RESET -------------- 4039H
  70.         ;
  71.         ; USER DEFINED PRINT @ ---  403CH
  72.         ;
  73.         ;***************************************************************
  74.         ;
  75.         newpage
  76.         ;***************************************************************
  77.         ;
  78.         ; MCS - 51  -  8K BASIC VERSION 1.1
  79.         ;
  80.         ;***************************************************************
  81.         ;
  82.         AJMP    CRST            ;START THE PROGRAM
  83.         db      037h            ; ******AA inserted
  84.         ;
  85.         ORG     3H
  86.         ;
  87.         ;***************************************************************
  88.         ;
  89.         ;EXTERNAL INTERRUPT 0
  90.         ;
  91.         ;***************************************************************
  92.         ;
  93.         JB      DRQ,STQ         ;SEE IF DMA IS SET
  94.         PUSH    PSW             ;SAVE THE STATUS
  95.         LJMP    4003H           ;JUMP TO USER IF NOT SET
  96.         ;
  97.         ORG     0BH
  98.         ;
  99.         ;***************************************************************
  100.         ;
  101.         ;TIMER 0 OVERFLOW INTERRUPT
  102.         ;
  103.         ;***************************************************************
  104.         ;
  105.         PUSH    PSW             ;SAVE THE STATUS
  106.         JB      C_BIT,STJ       ;SEE IF USER WANTS INTERRUPT
  107.         LJMP    400BH           ;EXIT IF USER WANTS INTERRUPTS
  108.         ;
  109.         ORG     13H
  110.         ;
  111.         ;***************************************************************
  112.         ;
  113.         ;EXTERNAL INTERRUPT 1
  114.         ;
  115.         ;***************************************************************
  116.         ;
  117.         JB      INTBIT,STK
  118.         PUSH    PSW
  119.         LJMP    4013H
  120.         ;
  121.         newpage
  122.         ;
  123.         ORG     1BH
  124.         ;
  125.         ;***************************************************************
  126.         ;
  127.         ;TIMER 1 OVERFLOW INTERRUPT
  128.         ;
  129.         ;***************************************************************
  130.         ;
  131.         PUSH    PSW
  132.         LJMP    CKS_I
  133.         ;
  134. STJ:    LJMP    I_DR            ;DO THE INTERRUPT
  135.         ;
  136.         ;***************************************************************
  137.         ;
  138.         ;SERIAL PORT INTERRUPT
  139.         ;
  140.         ;***************************************************************
  141.         ;
  142.         ORG     23H
  143.         ;
  144.         PUSH    PSW
  145.         JB      SPINT,STU       ;SEE IF MONITOR EANTS INTERRUPT
  146.         LJMP    4023H
  147.         ;
  148.         ORG     2BH
  149.         ;
  150.         ;**************************************************************
  151.         ;
  152.         ;TIMER 2 OVERFLOW INTERRUPT
  153.         ;
  154.         ;**************************************************************
  155.         ;
  156.         PUSH    PSW
  157.         LJMP    402BH
  158.         ;
  159.         newpage
  160.         ;**************************************************************
  161.         ;
  162.         ;USER ENTRY
  163.         ;
  164.         ;**************************************************************
  165.         ;
  166.         ORG     30H
  167.         ;
  168.         LJMP    IBLK            ;LINK TO USER BLOCK
  169.         ;
  170. STQ:    JB      I_T0,STS        ;SEE IF MONITOR WANTS IT
  171.         CLR     DACK
  172.         JNB     P3.2,$          ;WAIT FOR DMA TO END
  173.         SETB    DACK
  174.         RETI
  175.         ;
  176. STS:    LJMP    2040H           ;GO TO THE MONITOR
  177.         ;
  178. STK:    SETB    INTPEN          ;TELL BASIC AN INTERRUPT WAS RECEIVED
  179.         RETI
  180.         ;
  181. STU:    LJMP    2050H           ;SERIAL PORT INTERRUPT
  182.         ;
  183.         newpage
  184.  
  185.         include look52.inc      ; ******AA
  186.        
  187. EIG:    DB      "EXTRA IGNORED",'"'
  188.         ;
  189. EXA:    DB      "A-STACK",'"'
  190.         ;
  191. EXC:    DB      "C-STACK",'"'
  192.         ;
  193.         newpage
  194.  
  195.         include bas52.rst       ; ******AA
  196.  
  197.         newpage
  198.         ;***************************************************************
  199.         ;
  200.         ; CIPROG AND CPROG - Program a prom
  201.         ;
  202.         ;***************************************************************
  203.         ;
  204.         include bas52.pgm       ; ******AA
  205.         newpage
  206.         ;**************************************************************
  207.         ;
  208. PGU:    ;PROGRAM A PROM FOR THE USER
  209.         ;
  210.         ;**************************************************************
  211.         ;
  212.         CLR     PROMV           ;TURN ON THE VOLTAGE
  213.         MOV     PSW,#00011000B  ;SELECT RB3
  214.         ACALL   PG1             ;DO IT
  215.         SETB    PROMV           ;TURN IT OFF
  216.         RET
  217.         ;
  218.         ;
  219.         ;*************************************************************
  220.         ;
  221. CCAL:   ; Set up for prom moves
  222.         ; R3:R1 gets source
  223.         ; R7:R6 gets # of bytes
  224.         ;
  225.         ;*************************************************************
  226.         ;
  227.         ACALL   GETEND          ;GET THE LAST LOCATION
  228.         INC     DPTR            ;BUMP TO LOAD EOF
  229.         MOV     R3,BOFAH
  230.         MOV     R1,BOFAL        ;RESTORE START
  231.         CLR     C               ;PREPARE FOR SUBB
  232.         MOV     A,DPL           ;SUB DPTR - BOFA > R7:R6
  233.         SUBB    A,R1
  234.         MOV     R6,A
  235.         MOV     A,DPH
  236.         SUBB    A,R3
  237.         MOV     R7,A
  238.         RET
  239.         ;
  240.         ;
  241.         include bas52.tl        ; ******AA
  242.         newpage
  243.         ;***************************************************************
  244.         ;
  245. CROM:   ; The command action routine - ROM - Run out of rom
  246.         ;
  247.         ;***************************************************************
  248.         ;
  249.         CLR     CONB            ;CAN'T CONTINUE IF MODE CHANGE
  250.         ACALL   RO1             ;DO IT
  251.         ;
  252. C_K:    LJMP    CL3             ;EXIT
  253.         ;
  254. RO1:    LCALL   DELTST          ;SEE IF INTGER PRESENT ******AA CALL-->LCALL, INTGER-->DELTST
  255.         MOV     R4,#R1B0        ;SAVE THE NUMBER ******AA ABS-->IMM, R0B0-->R0B1 ?!?
  256.         JNC     $+6             ; ******AA $+4-->$+6 ???
  257.         ;MOV    R4,#01H         ;ONE IF NO INTEGER PRESENT ******AA repl. by next two
  258.         LCALL   ONE             ; ******AA
  259.         MOV     R4,A            ; ******AA
  260.         ACALL   ROMFD           ;FIND THE PROGRAM
  261.         CJNE    R4,#0,RFX       ;EXIT IF R4 <> 0
  262.         INC     DPTR            ;BUMP PAST TAG
  263.         MOV     BOFAH,DPH       ;SAVE THE ADDRESS
  264.         MOV     BOFAL,DPL
  265.         RET
  266.         ;
  267. ROMFD:  MOV     DPTR,#ROMADR+16 ;START OF USER PROGRAM
  268.         ;
  269. RF1:    MOVX    A,@DPTR         ;GET THE BYTE
  270.         CJNE    A,#55H,RF3      ;SEE IF PROPER TAG
  271.         DJNZ    R4,RF2          ;BUMP COUNTER
  272.         ;
  273. RFX:    RET                     ;DPTR HAS THE START ADDRESS
  274.         ;
  275. RF2:    INC     DPTR            ;BUMP PAST TAG
  276.         ACALL   G5
  277.         INC     DPTR            ;BUMP TO NEXT PROGRAM
  278.         SJMP    RF1             ;DO IT AGAIN
  279.         ;
  280. RF3:    JBC     INBIT,RFX       ;EXIT IF SET
  281.         ;
  282. NOGO:   MOV     DPTR,#NOROM
  283.         AJMP    ERRLK
  284.         ;
  285.         newpage
  286.         ;***************************************************************
  287.         ;
  288. L20DPI: ; load R2:R0 with the location the DPTR is pointing to
  289.         ;
  290.         ;***************************************************************
  291.         ;
  292.         MOVX    A,@DPTR
  293.         MOV     R2,A
  294.         INC     DPTR
  295.         MOVX    A,@DPTR
  296.         MOV     R0,A
  297.         RET                     ;DON'T BUMP DPTR
  298.         ;
  299.         ;***************************************************************
  300.         ;
  301. X31DP:  ; swap R3:R1 with DPTR
  302.         ;
  303.         ;***************************************************************
  304.         ;
  305.         XCH     A,R3
  306.         XCH     A,DPH
  307.         XCH     A,R3
  308.         XCH     A,R1
  309.         XCH     A,DPL
  310.         XCH     A,R1
  311.         RET
  312.         ;
  313.         ;***************************************************************
  314.         ;
  315. LD_T:   ; Load the timer save location with the value the DPTR is
  316.         ; pointing to.
  317.         ;
  318.         ;****************************************************************
  319.         ;
  320.         MOVX    A,@DPTR
  321.         MOV     T_HH,A
  322.         INC     DPTR
  323.         MOVX    A,@DPTR
  324.         MOV     T_LL,A
  325.         RET
  326.         ;
  327.         newpage
  328.         ;
  329.         ;***************************************************************
  330.         ;
  331.         ;GETLIN - FIND THE LOCATION OF THE LINE NUMBER IN R3:R1
  332.         ;         IF ACC = 0 THE LINE WAS NOT FOUND I.E. R3:R1
  333.         ;         WAS TOO BIG, ELSE ACC <> 0 AND THE DPTR POINTS
  334.         ;         AT THE LINE THAT IS GREATER THAN OR EQUAL TO THE
  335.         ;         VALUE IN R3:R1.
  336.         ;
  337.         ;***************************************************************
  338.         ;
  339. GETEND: SETB    ENDBIT          ;GET THE END OF THE PROGRAM
  340.         ;
  341. GETLIN: LCALL   DP_B            ;GET BEGINNING ADDRESS ******AA CALL-->LCALL
  342.         ;
  343. G1:     LCALL   B_C             ; ******AA CALL-->LCALL
  344.         JZ      G3              ;EXIT WITH A ZERO IN A IF AT END
  345.         INC     DPTR            ;POINT AT THE LINE NUMBER
  346.         JB      ENDBIT,G2       ;SEE IF WE WANT TO FIND THE END
  347.         ACALL   DCMPX           ;SEE IF (DPTR) = R3:R1
  348.         ACALL   DECDP           ;POINT AT LINE COUNT
  349.         MOVX    A,@DPTR         ;PUT LINE LENGTH INTO ACC
  350.         JB      UBIT,G3         ;EXIT IF EQUAL
  351.         JC      G3              ;SEE IF LESS THAN OR ZERO
  352.         ;
  353. G2:     ACALL   ADDPTR          ;ADD IT TO DPTR
  354.         SJMP    G1              ;LOOP
  355.         ;
  356. G3:     CLR     ENDBIT          ;RESET ENDBIT
  357.         RET                     ;EXIT
  358.         ;
  359. G4:     MOV     DPTR,#PSTART    ;DO RAM
  360.         ;
  361. G5:     SETB    ENDBIT
  362.         SJMP    G1              ;NOW DO TEST
  363.         ;
  364.         newpage
  365.         ;***************************************************************
  366.         ;
  367.         ; LDPTRI - Load the DATA POINTER with the value it is pointing
  368.         ;          to - DPH = (DPTR) , DPL = (DPTR+1)
  369.         ;
  370.         ; acc gets wasted
  371.         ;
  372.         ;***************************************************************
  373.         ;
  374. LDPTRI: MOVX    A,@DPTR         ;GET THE HIGH BYTE
  375.         PUSH    ACC             ;SAVE IT
  376.         INC     DPTR            ;BUMP THE POINTER
  377.         MOVX    A,@DPTR         ;GET THE LOW BYTE
  378.         MOV     DPL,A           ;PUT IT IN DPL
  379.         POP     DPH             ;GET THE HIGH BYTE
  380.         RET                     ;GO BACK
  381.         ;
  382.         ;***************************************************************
  383.         ;
  384.         ;L31DPI - LOAD R3 WITH (DPTR) AND R1 WITH (DPTR+1)
  385.         ;
  386.         ;ACC GETS CLOBBERED
  387.         ;
  388.         ;***************************************************************
  389.         ;
  390. L31DPI: MOVX    A,@DPTR         ;GET THE HIGH BYTE
  391.         MOV     R3,A            ;PUT IT IN THE REG
  392.         INC     DPTR            ;BUMP THE POINTER
  393.         MOVX    A,@DPTR         ;GET THE NEXT BYTE
  394.         MOV     R1,A            ;SAVE IT
  395.         RET
  396.         ;
  397.         ;***************************************************************
  398.         ;
  399.         ;DECDP - DECREMENT THE DATA POINTER - USED TO SAVE SPACE
  400.         ;
  401.         ;***************************************************************
  402.         ;
  403. DECDP2: ACALL   DECDP
  404.         ;
  405. DECDP:  XCH     A,DPL           ;GET DPL
  406.         JNZ     $+4             ;BUMP IF ZERO
  407.         DEC     DPH
  408.         DEC     A               ;DECREMENT IT
  409.         XCH     A,DPL           ;GET A BACK
  410.         RET                     ;EXIT
  411.         ;
  412.         newpage
  413.         ;***************************************************************
  414.         ;
  415.         ;DCMPX - DOUBLE COMPARE - COMPARE (DPTR) TO R3:R1
  416.         ;R3:R1 - (DPTR) = SET CARRY FLAG
  417.         ;
  418.         ;IF R3:R1 > (DPTR) THEN C = 0
  419.         ;IF R3:R1 < (DPTR) THEN C = 1
  420.         ;IF R3:R1 = (DPTR) THEN C = 0
  421.         ;
  422.         ;***************************************************************
  423.         ;
  424. DCMPX:  CLR     UBIT            ;ASSUME NOT EQUAL
  425.         MOVX    A,@DPTR         ;GET THE BYTE
  426.         CJNE    A,R3B0,D1       ;IF A IS GREATER THAN R3 THEN NO CARRY
  427.                                 ;WHICH IS R3<@DPTR = NO CARRY AND
  428.                                 ;R3>@DPTR CARRY IS SET
  429.         INC     DPTR            ;BUMP THE DATA POINTER
  430.         MOVX    A,@DPTR         ;GET THE BYTE
  431.         ACALL   DECDP           ;PUT DPTR BACK
  432.         CJNE    A,R1B0,D1       ;DO THE COMPARE
  433.         CPL     C               ;FLIP CARRY
  434.         ;
  435.         CPL     UBIT            ;SET IT
  436. D1:     CPL     C               ;GET THE CARRY RIGHT
  437.         RET                     ;EXIT
  438.         ;
  439.         ;***************************************************************
  440.         ;
  441.         ; ADDPTR - Add acc to the dptr
  442.         ;
  443.         ; acc gets wasted
  444.         ;
  445.         ;***************************************************************
  446.         ;
  447. ADDPTR: ADD     A,DPL           ;ADD THE ACC TO DPL
  448.         MOV     DPL,A           ;PUT IT IN DPL
  449.         JNC     $+4             ;JUMP IF NO CARRY
  450.         INC     DPH             ;BUMP DPH
  451.         RET                     ;EXIT
  452.         ;
  453.         newpage
  454.         ;*************************************************************
  455.         ;
  456. LCLR:   ; Set up the storage allocation
  457.         ;
  458.         ;*************************************************************
  459.         ;
  460.         ACALL   ICLR            ;CLEAR THE INTERRUPTS
  461.         ACALL   G4              ;PUT END ADDRESS INTO DPTR
  462.         MOV     A,#6            ;ADJUST MATRIX SPACE
  463.         ACALL   ADDPTR          ;ADD FOR PROPER BOUNDS
  464.         ACALL   X31DP           ;PUT MATRIX BOUNDS IN R3:R1
  465.         MOV     DPTR,#MT_ALL    ;SAVE R3:R1 IN MATRIX FREE SPACE
  466.         ACALL   S31DP           ;DPTR POINTS TO MEMTOP
  467.         ACALL   L31DPI          ;LOAD MEMTOP INTO R3:R1
  468.         MOV     DPTR,#STR_AL    ;GET MEMORY ALLOCATED FOR STRINGS
  469.         ACALL   LDPTRI
  470.         LCALL   DUBSUB          ;R3:R1 = MEMTOP - STRING ALLOCATION ******AA CALL-->LCALL
  471.         MOV     DPTR,#VARTOP    ;SAVE R3:R1 IN VARTOP
  472.         ;
  473.         ; FALL THRU TO S31DP2
  474.         ;
  475.         ;***************************************************************
  476.         ;
  477.         ;S31DP - STORE R3 INTO (DPTR) AND R1 INTO (DPTR+1)
  478.         ;
  479.         ;ACC GETS CLOBBERED
  480.         ;
  481.         ;***************************************************************
  482.         ;
  483. S31DP2: ACALL   S31DP           ;DO IT TWICE
  484.         ;
  485. S31DP:  MOV     A,R3            ;GET R3 INTO ACC
  486.         MOVX    @DPTR,A         ;STORE IT
  487.         INC     DPTR            ;BUMP DPTR
  488.         MOV     A,R1            ;GET R1
  489.         MOVX    @DPTR,A         ;STORE IT
  490.         INC     DPTR            ;BUMP IT AGAIN TO SAVE PROGRAM SPACE
  491.         RET                     ;GO BACK
  492.         ;
  493.         ;
  494.         ;***************************************************************
  495.         ;
  496. STRING: ; Allocate memory for strings
  497.         ;
  498.         ;***************************************************************
  499.         ;
  500.         LCALL   TWO             ;R3:R1 = NUMBER, R2:R0 = LEN
  501.         MOV     DPTR,#STR_AL    ;SAVE STRING ALLOCATION
  502.         ACALL   S31DP
  503.         INC     R6              ;BUMP
  504.         MOV     S_LEN,R6        ;SAVE STRING LENGTH
  505.         AJMP    RCLEAR          ;CLEAR AND SET IT UP
  506.         ;
  507.         newpage
  508.         ;***************************************************************
  509.         ;
  510.         ; F_VAR - Find  the variable in symbol table
  511.         ;         R7:R6 contain the variable name
  512.         ;         If not found create a zero entry and set the carry
  513.         ;         R2:R0 has the address of variable on return
  514.         ;
  515.         ;***************************************************************
  516.         ;
  517. F_VAR:  MOV     DPTR,#VARTOP    ;PUT VARTOP IN DPTR
  518.         ACALL   LDPTRI
  519.         ACALL   DECDP2          ;ADJUST DPTR FOR LOOKUP
  520.         ;
  521. F_VAR0: MOVX    A,@DPTR         ;LOAD THE VARIABLE
  522.         JZ      F_VAR2          ;TEST IF AT THE END OF THE TABLE
  523.         INC     DPTR            ;BUMP FOR NEXT BYTE
  524.         CJNE    A,R7B0,F_VAR1   ;SEE IF MATCH
  525.         MOVX    A,@DPTR         ;LOAD THE NAME
  526.         CJNE    A,R6B0,F_VAR1
  527.         ;
  528.         ; Found the variable now adjust and put in R2:R0
  529.         ;
  530. DLD:    MOV     A,DPL           ;R2:R0 = DPTR-2
  531.         SUBB    A,#2
  532.         MOV     R0,A
  533.         MOV     A,DPH
  534.         SUBB    A,#0            ;CARRY IS CLEARED
  535.         MOV     R2,A
  536.         RET
  537.         ;
  538. F_VAR1: MOV     A,DPL           ;SUBTRACT THE STACK SIZE+ADJUST
  539.         CLR     C
  540.         SUBB    A,#STESIZ
  541.         MOV     DPL,A           ;RESTORE DPL
  542.         JNC     F_VAR0
  543.         DEC     DPH
  544.         SJMP    F_VAR0          ;CONTINUE COMPARE
  545.         ;
  546.         newpage
  547.         ;
  548.         ; Add the entry to the symbol table
  549.         ;
  550. F_VAR2: LCALL   R76S            ;SAVE R7 AND R6
  551.         CLR     C
  552.         ACALL   DLD             ;BUMP THE POINTER TO GET ENTRY ADDRESS
  553.         ;
  554.         ; Adjust pointer and save storage allocation
  555.         ; and make sure we aren't wiping anything out
  556.         ; First calculate new storage allocation
  557.         ;
  558.         MOV     A,R0
  559.         SUBB    A,#STESIZ-3     ;NEED THIS MUCH RAM
  560.         MOV     R1,A
  561.         MOV     A,R2
  562.         SUBB    A,#0
  563.         MOV     R3,A
  564.         ;
  565.         ; Now save the new storage allocation
  566.         ;
  567.         MOV     DPTR,#ST_ALL
  568.         CALL    S31DP           ;SAVE STORAGE ALLOCATION
  569.         ;
  570.         ; Now make sure we didn't blow it, by wiping out MT_ALL
  571.         ;
  572.         ACALL   DCMPX           ;COMPARE STORAGE ALLOCATION
  573.         JC      CCLR3           ;ERROR IF CARRY
  574.         SETB    C               ;DID NOT FIND ENTRY
  575.         RET                     ;EXIT IF TEST IS OK
  576.         ;
  577.         newpage
  578.         ;***************************************************************
  579.         ;
  580.         ; Command action routine - NEW
  581.         ;
  582.         ;***************************************************************
  583.         ;
  584. CNEW:   MOV     DPTR,#PSTART    ;SAVE THE START OF PROGRAM
  585.         MOV     A,#EOF          ;END OF FILE
  586.         MOVX    @DPTR,A         ;PUT IT IN MEMORY
  587.         ;
  588.         ; falls thru
  589.         ;
  590.         ;*****************************************************************
  591.         ;
  592.         ; The statement action routine - CLEAR
  593.         ;
  594.         ;*****************************************************************
  595.         ;
  596.         CLR     LINEB           ;SET UP FOR RUN AND GOTO
  597.         ;
  598. RCLEAR: ACALL   LCLR            ;CLEAR THE INTERRUPTS, SET UP MATRICES
  599.         MOV     DPTR,#MEMTOP    ;PUT MEMTOP IN R3:R1
  600.         ACALL   L31DPI
  601.         ACALL   G4              ;DPTR GETS END ADDRESS
  602.         ACALL   CL_1            ;CLEAR THE MEMORY
  603.         ;
  604. RC1:    MOV     DPTR,#STACKTP   ;POINT AT CONTROL STACK TOP
  605.         CLR     A               ;CONTROL UNDERFLOW
  606.         ;
  607. RC2:    MOVX    @DPTR,A         ;SAVE IN MEMORY
  608.         MOV     CSTKA,#STACKTP
  609.         MOV     ASTKA,#STACKTP
  610.         CLR     CONB            ;CAN'T CONTINUE
  611.         RET
  612.         ;
  613.         newpage
  614.         ;***************************************************************
  615.         ;
  616.         ; Loop until the memory is cleared
  617.         ;
  618.         ;***************************************************************
  619.         ;
  620. CL_1:   INC     DPTR            ;BUMP MEMORY POINTER
  621.         CLR     A               ;CLEAR THE MEMORY
  622.         MOVX    @DPTR,A         ;CLEAR THE RAM
  623.         MOVX    A,@DPTR         ;READ IT
  624.         JNZ     CCLR3           ;MAKE SURE IT IS CLEARED
  625.         MOV     A,R3            ;GET POINTER FOR COMPARE
  626.         CJNE    A,DPH,CL_1      ;SEE TO LOOP
  627.         MOV     A,R1            ;NOW TEST LOW BYTE
  628.         CJNE    A,DPL,CL_1
  629.         ;
  630. CL_2:   RET
  631.         ;
  632. CCLR3:  LJMP    TB              ;ALLOCATED MEMORY DOESN'T EXSIST ******AA JMP-->LJMP
  633.         ;
  634.         ;**************************************************************
  635.         ;
  636. SCLR:   ;Entry point for clear return
  637.         ;
  638.         ;**************************************************************
  639.         ;
  640.         LCALL   DELTST          ;TEST FOR A CR ******AA CALL-->LCALL
  641.         JNC     RCLEAR
  642.         LCALL   GCI1            ;BUMP THE TEST POINTER ******AA CALL-->LCALL
  643.         CJNE    A,#'I',RC1      ;SEE IF I, ELSE RESET THE STACK
  644.         ;
  645.         ;**************************************************************
  646.         ;
  647. ICLR:   ; Clear interrupts and system garbage
  648.         ;
  649.         ;**************************************************************
  650.         ;
  651.         JNB     INTBIT,$+5      ;SEE IF BASIC HAS INTERRUPTS
  652.         CLR     EX1             ;IF SO, CLEAR INTERRUPTS
  653.         ANL     34,#00100000B   ;SET INTERRUPTS + CONTINUE
  654.         RETI
  655.         ;
  656.         newpage
  657.         ;***************************************************************
  658.         ;
  659.         ;OUTPUT ROUTINES
  660.         ;
  661.         ;***************************************************************
  662.         ;
  663. CRLF2:  ACALL   CRLF            ;DO TWO CRLF'S
  664.         ;
  665. CRLF:   MOV     R5,#CR          ;LOAD THE CR
  666.         ACALL   TEROT           ;CALL TERMINAL OUT
  667.         MOV     R5,#LF          ;LOAD THE LF
  668.         AJMP    TEROT           ;OUTPUT IT AND RETURN
  669.         ;
  670.         ;PRINT THE MESSAGE ADDRESSED IN ROM OR RAM BY THE DPTR
  671.         ;ENDS WITH THE CHARACTER IN R4
  672.         ;DPTR HAS THE ADDRESS OF THE TERMINATOR
  673.         ;
  674. CRP:    ACALL   CRLF            ;DO A CR THEN PRINT ROM
  675.         ;
  676. ROM_P:  CLR     A               ;CLEAR A FOR LOOKUP
  677.         MOVC    A,@A+DPTR       ;GET THE CHARACTER
  678.         CLR     ACC.7           ;CLEAR MS BIT
  679.         CJNE    A,#'"',$+4      ;EXIT IF TERMINATOR
  680.         RET
  681.         SETB    C0ORX1
  682.         ;
  683. PN1:    MOV     R5,A            ;OUTPUT THE CHARACTER
  684.         ACALL   TEROT
  685.         INC     DPTR            ;BUMP THE POINTER
  686.         SJMP    PN0
  687.         ;
  688. UPRNT:  ACALL   X31DP
  689.         ;
  690. PRNTCR: MOV     R4,#CR          ;OUTPUT UNTIL A CR
  691.         ;
  692. PN0:    JBC     C0ORX1,ROM_P
  693.         MOVX    A,@DPTR         ;GET THE RAM BYTE
  694.         JZ      $+5
  695.         CJNE    A,R4B0,$+4      ;SEE IF THE SAME AS TERMINATOR
  696.         RET                     ;EXIT IF THE SAME
  697.         CJNE    A,#CR,PN1       ;NEVER PRINT A CR IN THIS ROUTINE
  698.         LJMP    E1XX            ;BAD SYNTAX
  699.         ;
  700.         newpage
  701.         ;***************************************************************
  702.         ;
  703.         ; INLINE - Input a line to IBUF, exit when a CR is received
  704.         ;
  705.         ;***************************************************************
  706.         ;
  707. INL2:   CJNE    A,#CNTRLD,INL2B ;SEE IF A CONTROL D
  708.         ;
  709. INL0:   ACALL   CRLF            ;DO A CR
  710.         ;
  711. INLINE: MOV     P2,#HI(IBUF)    ;IBUF IS IN THE ZERO PAGE
  712.         MOV     R0,#LO(IBUF)    ;POINT AT THE INPUT BUFFER
  713.         ;
  714. INL1:   ACALL   INCHAR          ;GET A CHARACTER
  715.         MOV     R5,A            ;SAVE IN R5 FOR OUTPUT
  716.         CJNE    A,#7FH,INL2     ;SEE IF A DELETE CHARACTER
  717.         CJNE    R0,#LO(IBUF),INL6
  718.         MOV     R5,#BELL        ;OUTPUT A BELL
  719.         ;
  720. INLX:   ACALL   TEROT           ;OUTPUT CHARACTER
  721.         SJMP    INL1            ;DO IT AGAIN
  722.         ;
  723. INL2B:  MOVX    @R0,A           ;SAVE THE CHARACTER
  724.         CJNE    A,#CR,$+5       ;IS IT A CR
  725.         AJMP    CRLF            ;OUTPUT A CRLF AND EXIT
  726.         CJNE    A,#20H,$+3
  727.         JC      INLX            ;ONLY ECHO CONTROL CHARACTERS
  728.         INC     R0              ;BUMP THE POINTER
  729.         CJNE    R0,#IBUF+79,INLX
  730.         DEC     R0              ;FORCE 79
  731.         SJMP    INLX-2          ;OUTPUT A BELL
  732.         ;
  733. INL6:   DEC     R0              ;DEC THE RAM POINTER
  734.         MOV     R5,#BS          ;OUTPUT A BACK SPACE
  735.         ACALL   TEROT
  736.         ACALL   STEROT          ;OUTPUT A SPACE
  737.         MOV     R5,#BS          ;ANOTHER BACK SPACE
  738.         SJMP    INLX            ;OUTPUT IT
  739.         ;
  740. PTIME:  DB      128-2           ; PROM PROGRAMMER TIMER
  741.         DB      00H
  742.         DB      00H
  743.         DB      50H
  744.         DB      67H
  745.         DB      41H
  746.         ;
  747.         newpage
  748.         include bas52.out       ; ******AA
  749.         ;
  750. BCK:    ACALL   CSTS            ;CHECK STATUS
  751.         JNC     CI_RET+1        ;EXIT IF NO CHARACTER
  752.         ;
  753.         newpage
  754.         ;***************************************************************
  755.         ;
  756.         ;INPUTS A CHARACTER FROM THE SYSTEM CONSOLE.
  757.         ;
  758.         ;***************************************************************
  759.         ;
  760. INCHAR: JNB     BI,$+8          ;CHECK FOR MONITOR (BUBBLE)
  761.         LCALL   2060H
  762.         SJMP    INCH1
  763.         JNB     CIUB,$+8        ;CHECK FOR USER
  764.         LCALL   4033H
  765.         SJMP    INCH1
  766.         JNB     RI,$            ;WAIT FOR RECEIVER READY.
  767.         MOV     A,SBUF
  768.         CLR     RI              ;RESET READY
  769.         CLR     ACC.7           ;NO BIT 7
  770.         ;
  771. INCH1:  CJNE    A,#13H,$+5
  772.         SETB    CNT_S
  773.         CJNE    A,#11H,$+5
  774.         CLR     CNT_S
  775.         CJNE    A,#CNTRLC,$+7
  776.         JNB     NO_C,C_EX       ;TRAP NO CONTROL C
  777.         RET
  778.         ;
  779.         CLR     JKBIT
  780.         CJNE    A,#17H,CI_RET   ;CONTROL W
  781.         SETB    JKBIT
  782.         ;
  783. CI_RET: SETB    C               ;CARRY SET IF A CHARACTER
  784.         RET                     ;EXIT
  785.         ;
  786.         ;*************************************************************
  787.         ;
  788.         ;RROM - The Statement Action Routine RROM
  789.         ;
  790.         ;*************************************************************
  791.         ;
  792. RROM:   SETB    INBIT           ;SO NO ERRORS
  793.         ACALL   RO1             ;FIND THE LINE NUMBER
  794.         JBC     INBIT,CRUN
  795.         RET                     ;EXIT
  796.         ;
  797.         newpage
  798.         ;***************************************************************
  799.         ;
  800. CSTS:   ;       RETURNS CARRY = 1 IF THERE IS A CHARACTER WAITING FROM
  801.         ;       THE SYSTEM CONSOLE. IF NO CHARACTER THE READY CHARACTER
  802.         ;       WILL BE CLEARED
  803.         ;
  804.         ;***************************************************************
  805.         ;
  806.         JNB     BI,$+6          ;BUBBLE STATUS
  807.         LJMP    2068H
  808.         JNB     CIUB,$+6        ;SEE IF EXTERNAL CONSOLE
  809.         LJMP    4036H
  810.         MOV     C,RI
  811.         RET
  812.         ;
  813.         MOV     DPTR,#WB        ;EGO MESSAGE
  814.         ACALL   ROM_P
  815.         ;
  816. C_EX:   CLR     CNT_S           ;NO OUTPUT STOP
  817.         LCALL   SPRINT+4        ;ASSURE CONSOLE
  818.         ACALL   CRLF
  819.         JBC     JKBIT,C_EX-5
  820.         ;
  821.         JNB     DIRF,SSTOP0
  822.         AJMP    C_K             ;CLEAR COB AND EXIT
  823.         ;
  824. T_CMP:  MOV     A,TVH           ;COMPARE TIMER TO SP_H AND SP_L
  825.         MOV     R1,TVL
  826.         CJNE    A,TVH,T_CMP
  827.         XCH     A,R1
  828.         SUBB    A,SP_L
  829.         MOV     A,R1
  830.         SUBB    A,SP_H
  831.         RET
  832.         ;
  833.         ;*************************************************************
  834.         ;
  835. BR0:    ; Trap the timer interrupt
  836.         ;
  837.         ;*************************************************************
  838.         ;
  839.         CALL    T_CMP           ;COMPARE TIMER
  840.         JC      BCHR+6          ;EXIT IF TEST FAILS
  841.         SETB    OTI             ;DOING THE TIMER INTERRUPT
  842.         CLR     OTS             ;CLEAR TIMER BIT
  843.         MOV     C,INPROG        ;SAVE IN PROGRESS
  844.         MOV     ISAV,C
  845.         MOV     DPTR,#TIV
  846.         SJMP    BR2
  847.         ;
  848.         newpage
  849.         ;***************************************************************
  850.         ;
  851.         ; The command action routine - RUN
  852.         ;
  853.         ;***************************************************************
  854.         ;
  855. CRUN:   LCALL   RCLEAR-2        ;CLEAR THE STORAGE ARRAYS
  856.         ACALL   SRESTR+2        ;GET THE STARTING ADDRESS
  857.         ACALL   B_C
  858.         JZ      CMNDLK          ;IF NULL GO TO COMMAND MODE
  859.         ;
  860.         ACALL   T_DP
  861.         ACALL   B_TXA           ;BUMP TO STARTING LINE
  862.         ;
  863. CILOOP: ACALL   SP0             ;DO A CR AND A LF
  864.         CLR     DIRF            ;NOT IN DIRECT MODE
  865.         ;
  866.         ;INTERPERTER DRIVER
  867.         ;
  868. ILOOP:  MOV     SP,SPSAV        ;RESTORE THE STACK EACH TIME
  869.         JB      DIRF,$+9        ;NO INTERRUPTS IF IN DIRECT MODE
  870.         MOV     INTXAH,TXAH     ;SAVE THE TEXT POINTER
  871.         MOV     INTXAL,TXAL
  872.         LCALL   BCK             ;GET CONSOLE STATUS
  873.         JB      DIRF,I_L        ;DIRECT MODE
  874.         ANL     C,/GTRD         ;SEE IF CHARACTER READY
  875.         JNC     BCHR            ;NO CHARACTER = NO CARRY
  876.         ;
  877.         ; DO TRAP OPERATION
  878.         ;
  879.         MOV     DPTR,#GTB       ;SAVE TRAP CHARACTER
  880.         MOVX    @DPTR,A
  881.         SETB    GTRD            ;SAYS READ A BYTE
  882.         ;
  883. BCHR:   JB      OTI,I_L         ;EXIT IF TIMER INTERRUPT IN PROGRESS
  884.         JB      OTS,BR0         ;TEST TIMER VALUE IF SET
  885.         JNB     INTPEN,I_L      ;SEE IF INTERRUPT PENDING
  886.         JB      INPROG,I_L      ;DON'T DO IT AGAIN IF IN PROGRESS
  887.         MOV     DPTR,#INTLOC    ;POINT AT INTERRUPT LOCATION
  888.         ;
  889. BR2:    MOV     R4,#GTYPE       ;SETUP FOR A FORCED GOSUB
  890.         ACALL   SGS1            ;PUT TXA ON STACK
  891.         SETB    INPROG          ;INTERRUPT IN PROGRESS
  892.         ;
  893. ERL4:   CALL    L20DPI
  894.         AJMP    D_L1            ;GET THE LINE NUMBER
  895.         ;
  896. I_L:    ACALL   ISTAT           ;LOOP
  897.         ACALL   CLN_UP          ;FINISH IT OFF
  898.         JNC     ILOOP           ;LOOP ON THE DRIVER
  899.         JNB     DIRF,CMNDLK     ;CMND1 IF IN RUN MODE
  900.         LJMP    CMNDR           ;DON'T PRINT READY
  901.         ;
  902. CMNDLK: LJMP    CMND1           ;DONE ******AA JMP-->LJMP
  903.         newpage
  904.         ;**************************************************************
  905.         ;
  906.         ; The Statement Action Routine - STOP
  907.         ;
  908.         ;**************************************************************
  909.         ;
  910. SSTOP:  ACALL   CLN_UP          ;FINISH OFF THIS LINE
  911.         MOV     INTXAH,TXAH     ;SAVE TEXT POINTER FOR CONT
  912.         MOV     INTXAL,TXAL
  913.         ;
  914. SSTOP0: SETB    CONB            ;CONTINUE WILL WORK
  915.         MOV     DPTR,#STP       ;PRINT THE STOP MESSAGE
  916.         SETB    STOPBIT         ;SET FOR ERROR ROUTINE
  917.         LJMP    ERRS            ;JUMP TO ERROR ROUTINE ******AA JMP-->LJMP
  918.         ;
  919.         newpage
  920.         ;**************************************************************
  921.         ;
  922.         ; ITRAP - Trap special function register operators
  923.         ;
  924.         ;**************************************************************
  925.         ;
  926. ITRAP:  CJNE    A,#TMR0,$+8     ;TIMER 0
  927.         MOV     TH0,R3
  928.         MOV     TL0,R1
  929.         RET
  930.         ;
  931.         CJNE    A,#TMR1,$+8     ;TIMER 1
  932.         MOV     TH1,R3
  933.         MOV     TL1,R1
  934.         RET
  935.         ;
  936.         CJNE    A,#TMR2,$+8     ;TIMER 2
  937.         DB      8BH             ;MOV R3 DIRECT OP CODE
  938.         DB      0CDH            ;T2H LOCATION
  939.         DB      89H             ;MOV R1 DIRECT OP CODE
  940.         DB      0CCH            ;T2L LOCATION
  941.         RET
  942.         ;
  943.         CJNE    A,#TRC2,$+8     ;RCAP2 TOKEN
  944. RCL:    DB      8BH             ;MOV R3 DIRECT OP CODE
  945.         DB      0CBH            ;RCAP2H LOCATION
  946.         DB      89H             ;MOV R1 DIRECT OP CODE
  947.         DB      0CAH            ;RCAP2L LOCATION
  948.         RET
  949.         ;
  950.         ACALL   R3CK            ;MAKE SURE THAT R3 IS ZERO
  951.         CJNE    A,#TT2C,$+6
  952.         DB      89H             ;MOV R1 DIRECT OP CODE
  953.         DB      0C8H            ;T2CON LOCATION
  954.         RET
  955.         ;
  956.         CJNE    A,#T_IE,$+6     ;IE TOKEN
  957.         MOV     IE,R1
  958.         RET
  959.         ;
  960.         CJNE    A,#T_IP,$+6     ;IP TOKEN
  961.         MOV     IP,R1
  962.         RET
  963.         ;
  964.         CJNE    A,#TTC,$+6      ;TCON TOKEN
  965.         MOV     TCON,R1
  966.         RET
  967.         ;
  968.         CJNE    A,#TTM,$+6      ;TMOD TOKEN
  969.         MOV     TMOD,R1
  970.         RET
  971.         ;
  972.         CJNE    A,#T_P1,T_T2    ;P1 TOKEN
  973.         MOV     P1,R1
  974.         RET
  975.         ;
  976.         ;***************************************************************
  977.         ;
  978.         ; T_TRAP - Trap special operators
  979.         ;
  980.         ;***************************************************************
  981.         ;
  982. T_T:    MOV     TEMP5,A         ;SAVE THE TOKEN
  983.         ACALL   GCI1            ;BUMP POINTER
  984.         ACALL   SLET2           ;EVALUATE AFTER =
  985.         MOV     A,TEMP5         ;GET THE TOKEN BACK
  986.         CJNE    A,#T_XTAL,$+6
  987.         LJMP    AXTAL1          ;SET UP CRYSTAL
  988.         ;
  989.         ACALL   IFIXL           ;R3:R1 HAS THE TOS
  990.         MOV     A,TEMP5         ;GET THE TOKEN AGAIN
  991.         CJNE    A,#T_MTOP,T_T1  ;SEE IF MTOP TOKEN
  992.         MOV     DPTR,#MEMTOP
  993.         CALL    S31DP
  994.         JMP     RCLEAR          ;CLEAR THE MEMORY
  995.         ;
  996. T_T1:   CJNE    A,#T_TIME,ITRAP ;SEE IF A TIME TOKEN
  997.         MOV     C,EA            ;SAVE INTERRUPTS
  998.         CLR     EA              ;NO TIMER 0 INTERRUPTS DURING LOAD
  999.         MOV     TVH,R3          ;SAVE THE TIME
  1000.         MOV     TVL,R1
  1001.         MOV     EA,C            ;RESTORE INTERRUPTS
  1002.         RET                     ;EXIT
  1003.         ;
  1004. T_T2:   CJNE    A,#T_PC,INTERX  ;PCON TOKEN
  1005.         DB      89H             ;MOV DIRECT, R1 OP CODE
  1006.         DB      87H             ;ADDRESS OF PCON
  1007.         RET                     ;EXIT
  1008.         ;
  1009. T_TRAP: CJNE    A,#T_ASC,T_T    ;SEE IF ASC TOKEN
  1010.         ACALL   IGC             ;EAT IT AND GET THE NEXT CHARACTER
  1011.         CJNE    A,#'$',INTERX   ;ERROR IF NOT A STRING
  1012.         ACALL   CSY             ;CALCULATE ADDRESS
  1013.         ACALL   X3120
  1014.         LCALL   TWO_EY          ; ******AA CALL-->LCALL
  1015.         ACALL   SPEOP+4         ;EVALUATE AFTER EQUALS
  1016.         AJMP    ISTAX1          ;SAVE THE CHARACTER
  1017.         ;
  1018.         newpage
  1019.         ;**************************************************************
  1020.         ;
  1021.         ;INTERPERT THE STATEMENT POINTED TO BY TXAL AND TXAH
  1022.         ;
  1023.         ;**************************************************************
  1024.         ;
  1025. ISTAT:  ACALL   GC              ;GET THR FIRST CHARACTER
  1026.         JNB     XBIT,IAT        ;TRAP TO EXTERNAL RUN PACKAGE
  1027.         CJNE    A,#20H,$+3
  1028.         JNC     IAT
  1029.         LCALL   2070H           ;LET THE USER SET UP THE DPTR
  1030.         ACALL   GCI1
  1031.         ANL     A,#0FH          ;STRIP OFF BIAS
  1032.         SJMP    ISTA1
  1033.         ;
  1034. IAT:    CJNE    A,#T_XTAL,$+3
  1035.         JNC     T_TRAP
  1036.         JNB     ACC.7,SLET      ;IMPLIED LET IF BIT 7 NOT SET
  1037.         CJNE    A,#T_UOP+12,ISTAX       ;DBYTE TOKEN
  1038.         ACALL   SPEOP           ;EVALUATE SPECIAL OPERATOR
  1039.         ACALL   R3CK            ;CHECK LOCATION
  1040.         MOV     @R1,A           ;SAVE IT
  1041.         RET
  1042.         ;
  1043. ISTAX:  CJNE    A,#T_UOP+13,ISTAY       ;XBYTE TOKEN
  1044.         ACALL   SPEOP
  1045.         ;
  1046. ISTAX1: MOV     P2,R3
  1047.         MOVX    @R1,A
  1048.         RET
  1049.         ;
  1050. ISTAY:  CJNE    A,#T_CR+1,$+3   ;TRAP NEW OPERATORS
  1051.         JC      I_S
  1052.         CJNE    A,#0B0H,$+3     ;SEE IF TOO BIG
  1053.         JNC     INTERX
  1054.         ADD     A,#0F9H         ;BIAS FOR LOOKUP TABLE
  1055.         SJMP    ISTA0           ;DO THE OPERATION
  1056.         ;
  1057. I_S:    CJNE    A,#T_LAST,$+3   ;MAKE SURE AN INITIAL RESERVED WORD
  1058.         JC      $+5             ;ERROR IF NOT
  1059.         ;
  1060. INTERX: LJMP    E1XX            ;SYNTAX ERROR
  1061.         ;
  1062.         JNB     DIRF,ISTA0      ;EXECUTE ALL STATEMENTS IF IN RUN MODE
  1063.         CJNE    A,#T_DIR,$+3    ;SEE IF ON TOKEN
  1064.         JC      ISTA0           ;OK IF DIRECT
  1065.         CJNE    A,#T_GOSB+1,$+5 ;SEE IF FOR
  1066.         SJMP    ISTA0           ;FOR IS OK
  1067.         CJNE    A,#T_REM+1,$+5  ;NEXT IS OK
  1068.         SJMP    ISTA0
  1069.         CJNE    A,#T_STOP+6,INTERX      ;SO IS REM
  1070.         ;
  1071.         newpage
  1072. ISTA0:  ACALL   GCI1            ;ADVANCE THE TEXT POINTER
  1073.         MOV     DPTR,#STATD     ;POINT DPTR TO LOOKUP TABLE
  1074.         CJNE    A,#T_GOTO-3,$+5 ;SEE IF LET TOKEN
  1075.         SJMP    ISTAT           ;WASTE LET TOKEN
  1076.         ANL     A,#3FH          ;STRIP OFF THE GARBAGE
  1077.         ;
  1078. ISTA1:  RL      A               ;ROTATE FOR OFFSET
  1079.         ADD     A,DPL           ;BUMP
  1080.         MOV     DPL,A           ;SAVE IT
  1081.         CLR     A
  1082.         MOVC    A,@A+DPTR       ;GET HIGH BYTE
  1083.         PUSH    ACC             ;SAVE IT
  1084.         INC     DPTR
  1085.         CLR     A
  1086.         MOVC    A,@A+DPTR       ;GET LOW BYTE
  1087.         POP     DPH
  1088.         MOV     DPL,A
  1089.         ;
  1090. AC1:    CLR     A
  1091.         JMP     @A+DPTR         ;GO DO IT
  1092.         ;
  1093.         newpage
  1094.         ;***************************************************************
  1095.         ;
  1096.         ; The statement action routine - LET
  1097.         ;
  1098.         ;***************************************************************
  1099.         ;
  1100. SLET:   ACALL   S_C             ;CHECK FOR POSSIBLE STRING
  1101.         JC      SLET0           ;NO STRING
  1102.         CLR     LINEB           ;USED STRINGS
  1103.         ;
  1104.         CALL    X31DP           ;PUT ADDRESS IN DPTR
  1105.         MOV     R7,#T_EQU       ;WASTE =
  1106.         ACALL   EATC
  1107.         ACALL   GC              ;GET THE NEXT CHARACTER
  1108.         CJNE    A,#'"',S_3      ;CHECK FOR A "
  1109.         MOV     R7,S_LEN        ;GET THE STRING LENGTH
  1110.         ;
  1111. S_0:    ACALL   GCI1            ;BUMP PAST "
  1112.         ACALL   DELTST          ;CHECK FOR DELIMITER
  1113.         JZ      INTERX          ;EXIT IF CARRIAGE RETURN
  1114.         MOVX    @DPTR,A         ;SAVE THE CHARACTER
  1115.         CJNE    A,#'"',S_1      ;SEE IF DONE
  1116.         ;
  1117. S_E:    MOV     A,#CR           ;PUT A CR IN A
  1118.         MOVX    @DPTR,A         ;SAVE CR
  1119.         AJMP    GCI1
  1120.         ;
  1121. S_3:    PUSH    DPH
  1122.         PUSH    DPL             ;SAVE DESTINATION
  1123.         ACALL   S_C             ;CALCULATE SOURCE
  1124.         JC      INTERX          ;ERROR IF CARRY
  1125.         POP     R0B0            ;GET DESTINATION BACK
  1126.         POP     R2B0
  1127.         ;
  1128. SSOOP:  MOV     R7,S_LEN        ;SET UP COUNTER
  1129.         ;
  1130. S_4:    LCALL   TBYTE           ;TRANSFER THE BYTE ******AA CALL-->LCALL
  1131.         CJNE    A,#CR,$+4       ;EXIT IF A CR
  1132.         RET
  1133.         DJNZ    R7,S_5          ;BUMP COUNTER
  1134.         MOV     A,#CR           ;SAVE A CR
  1135.         MOVX    @R0,A
  1136.         AJMP    EIGP            ;PRINT EXTRA IGNORED
  1137.         ;
  1138.         newpage
  1139.         ;
  1140. S_5:    CALL    INC3210         ;BUMP POINTERS
  1141.         SJMP    S_4             ;LOOP
  1142.         ;
  1143. S_1:    DJNZ    R7,$+8          ;SEE IF DONE
  1144.         ACALL   S_E
  1145.         ACALL   EIGP            ;PRINT EXTRA IGNORED
  1146.         AJMP    FINDCR          ;GO FIND THE END
  1147.         INC     DPTR            ;BUMP THE STORE POINTER
  1148.         SJMP    S_0             ;CONTINUE TO LOOP
  1149.         ;
  1150. E3XX:   MOV     DPTR,#E3X       ;BAD ARG ERROR
  1151.         AJMP    EK
  1152.         ;
  1153. SLET0:  ACALL   SLET1
  1154.         AJMP    POPAS           ;COPY EXPRESSION TO VARIABLE
  1155.         ;
  1156. SLET1:  ACALL   VAR_ER          ;CHECK FOR A"VARIABLE"
  1157.         ;
  1158. SLET2:  PUSH    R2B0            ;SAVE THE VARIABLE ADDRESS
  1159.         PUSH    R0B0
  1160.         MOV     R7,#T_EQU       ;GET EQUAL TOKEN
  1161.         ACALL   WE
  1162.         POP     R1B0            ;POP VARIABLE TO R3:R1
  1163.         POP     R3B0
  1164.         RET                     ;EXIT
  1165.         ;
  1166. R3CK:   CJNE    R3,#00H,E3XX    ;CHECK TO SEE IF R3 IS ZERO
  1167.         RET
  1168.         ;
  1169. SPEOP:  ACALL   GCI1            ;BUMP TXA
  1170.         ACALL   P_E             ;EVALUATE PAREN
  1171.         ACALL   SLET2           ;EVALUATE AFTER =
  1172.         CALL    TWOL            ;R7:R6 GETS VALUE, R3:R1 GETS LOCATION
  1173.         MOV     A,R6            ;SAVE THE VALUE
  1174.         ;
  1175.         CJNE    R7,#00H,E3XX    ;R2 MUST BE = 0
  1176.         RET
  1177.         ;
  1178.         newpage
  1179.         ;**************************************************************
  1180.         ;
  1181.         ; ST_CAL - Calculate string Address
  1182.         ;
  1183.         ;**************************************************************
  1184.         ;
  1185. IST_CAL:;
  1186.         ;
  1187.         ACALL   I_PI            ;BUMP TEXT, THEN EVALUATE
  1188.         ACALL   R3CK            ;ERROR IF R3 <> 0
  1189.         INC     R1              ;BUMP FOR OFFSET
  1190.         MOV     A,R1            ;ERROR IF R1 = 255
  1191.         JZ      E3XX
  1192.         MOV     DPTR,#VARTOP    ;GET TOP OF VARIABLE STORAGE
  1193.         MOV     B,S_LEN         ;MULTIPLY FOR LOCATION
  1194.         ACALL   VARD            ;CALCULATE THE LOCATION
  1195.         MOV     DPTR,#MEMTOP    ;SEE IF BLEW IT
  1196.         CALL    FUL1
  1197.         MOV     DPL,S_LEN       ;GET STRING LENGTH, DPH = 00H
  1198.         DEC     DPH             ;DPH = 0
  1199.         ;
  1200. DUBSUB: CLR     C
  1201.         MOV     A,R1
  1202.         SUBB    A,DPL
  1203.         MOV     R1,A
  1204.         MOV     A,R3
  1205.         SUBB    A,DPH
  1206.         MOV     R3,A
  1207.         ORL     A,R1
  1208.         RET
  1209.         ;
  1210.         ;***************************************************************
  1211.         ;
  1212.         ;VARD - Calculate the offset base
  1213.         ;
  1214.         ;***************************************************************
  1215.         ;
  1216. VARB:   MOV     B,#FPSIZ        ;SET UP FOR OPERATION
  1217.         ;
  1218. VARD:   CALL    LDPTRI          ;LOAD DPTR
  1219.         MOV     A,R1            ;MULTIPLY BASE
  1220.         MUL     AB
  1221.         ADD     A,DPL
  1222.         MOV     R1,A
  1223.         MOV     A,B
  1224.         ADDC    A,DPH
  1225.         MOV     R3,A
  1226.         RET
  1227.         ;
  1228.         newpage
  1229.         ;*************************************************************
  1230.         ;
  1231. CSY:    ; Calculate a biased string address and put in R3:R1
  1232.         ;
  1233.         ;*************************************************************
  1234.         ;
  1235.         ACALL   IST_CAL         ;CALCULATE IT
  1236.         PUSH    R3B0            ;SAVE IT
  1237.         PUSH    R1B0
  1238.         MOV     R7,#','         ;WASTE THE COMMA
  1239.         ACALL   EATC
  1240.         ACALL   ONE             ;GET THE NEXT EXPRESSION
  1241.         MOV     A,R1            ;CHECK FOR BOUNDS
  1242.         CJNE    A,S_LEN,$+3
  1243.         JNC     E3XX            ;MUST HAVE A CARRY
  1244.         DEC     R1              ;BIAS THE POINTER
  1245.         POP     ACC             ;GET VALUE LOW
  1246.         ADD     A,R1            ;ADD IT TO BASE
  1247.         MOV     R1,A            ;SAVE IT
  1248.         POP     R3B0            ;GET HIGH ADDRESS
  1249.         JNC     $+3             ;PROPAGATE THE CARRY
  1250.         INC     R3
  1251.         AJMP    ERPAR           ;WASTE THE RIGHT PAREN
  1252.         ;
  1253.         newpage
  1254.         ;***************************************************************
  1255.         ;
  1256.         ; The statement action routine FOR
  1257.         ;
  1258.         ;***************************************************************
  1259.         ;
  1260. SFOR:   ACALL   SLET1           ;SET UP CONTROL VARIABLE
  1261.         PUSH    R3B0            ;SAVE THE CONTROL VARIABLE LOCATION
  1262.         PUSH    R1B0
  1263.         ACALL   POPAS           ;POP ARG STACK AND COPY CONTROL VAR
  1264.         MOV     R7,#T_TO        ;GET TO TOKEN
  1265.         ACALL   WE
  1266.         ACALL   GC              ;GET NEXT CHARACTER
  1267.         CJNE    A,#T_STEP,SF2
  1268.         ACALL   GCI1            ;EAT THE TOKEN
  1269.         ACALL   EXPRB           ;EVALUATE EXPRESSION
  1270.         SJMP    $+5             ;JUMP OVER
  1271.         ;
  1272. SF2:    LCALL   PUSH_ONE        ;PUT ONE ON THE STACK
  1273.         ;
  1274.         MOV     A,#-FSIZE       ;ALLOCATE FSIZE BYTES ON THE CONTROL STACK
  1275.         ACALL   PUSHCS          ;GET CS IN R0
  1276.         ACALL   CSC             ;CHECK CONTROL STACK
  1277.         MOV     R3,#CSTKAH      ;IN CONTROL STACK
  1278.         MOV     R1,R0B0         ;STACK ADDRESS
  1279.         ACALL   POPAS           ;PUT STEP ON STACK
  1280.         ACALL   POPAS           ;PUT LIMIT ON STACK
  1281.         ACALL   DP_T            ;DPTR GETS TEXT
  1282.         MOV     R0,R1B0         ;GET THE POINTER
  1283.         ACALL   T_X_S           ;SAVE THE TEXT
  1284.         POP     TXAL            ;GET CONTROL VARIABLE
  1285.         POP     TXAH
  1286.         MOV     R4,#FTYPE       ;AND THE TYPE
  1287.         ACALL   T_X_S           ;SAVE IT
  1288.         ;
  1289. SF3:    ACALL   T_DP            ;GET THE TEXT POINTER
  1290.         AJMP    ILOOP           ;CONTINUE TO PROCESS
  1291.         ;
  1292.         newpage
  1293.         ;**************************************************************
  1294.         ;
  1295.         ; The statement action routines - PUSH and POP
  1296.         ;
  1297.         ;**************************************************************
  1298.         ;
  1299. SPUSH:  ACALL   EXPRB           ;PUT EXPRESSION ON STACK
  1300.         ACALL   C_TST           ;SEE IF MORE TO DO
  1301.         JNC     SPUSH           ;IF A COMMA PUSH ANOTHER
  1302.         RET
  1303.         ;
  1304.         ;
  1305. SPOP:   ACALL   VAR_ER          ;GET VARIABLE
  1306.         ACALL   XPOP            ;FLIP THE REGISTERS FOR POPAS
  1307.         ACALL   C_TST           ;SEE IF MORE TO DO
  1308.         JNC     SPOP
  1309.         ;
  1310.         RET
  1311.         ;
  1312.         ;***************************************************************
  1313.         ;
  1314.         ; The statement action routine - IF
  1315.         ;
  1316.         ;***************************************************************
  1317.         ;
  1318. SIF:    ACALL   RTST            ;EVALUATE THE EXPRESSION
  1319.         MOV     R1,A            ;SAVE THE RESULT
  1320.         ACALL   GC              ;GET THE CHARACTER AFTER EXPR
  1321.         CJNE    A,#T_THEN,$+5   ;SEE IF THEN TOKEN
  1322.         ACALL   GCI1            ;WASTE THEN TOKEN
  1323.         CJNE    R1,#0,T_F1      ;CHECK R_OP RESULT
  1324.         ;
  1325. E_FIND: MOV     R7,#T_ELSE      ;FIND ELSE TOKEN
  1326.         ACALL   FINDC
  1327.         JZ      SIF-1           ;EXIT IF A CR
  1328.         ACALL   GCI1            ;BUMP PAST TOKEN
  1329.         CJNE    A,#T_ELSE,E_FIND;WASTE IF NO ELSE
  1330.         ;
  1331. T_F1:   ACALL   INTGER          ;SEE IF NUMBER
  1332.         JNC     D_L1            ;EXECUTE LINE NUMBER
  1333.         AJMP    ISTAT           ;EXECUTE STATEMENT IN NOT
  1334.         ;
  1335. B_C:    MOVX    A,@DPTR
  1336.         DEC     A
  1337.         JB      ACC.7,FL3-5
  1338.         RET
  1339.         ;
  1340.         newpage
  1341.         ;***************************************************************
  1342.         ;
  1343.         ; The statement action routine - GOTO
  1344.         ;
  1345.         ;***************************************************************
  1346.         ;
  1347. SGOTO:  ACALL   RLINE           ;R2:R0 AND DPTR GET INTGER
  1348.         ;
  1349. SGT1:   ACALL   T_DP            ;TEXT POINTER GETS DPTR
  1350.         ;
  1351.         JBC     RETBIT,SGT2     ;SEE IF RETI EXECUTED
  1352.         ;
  1353.         JNB     LINEB,$+6       ;SEE IF A LINE WAS EDITED
  1354.         LCALL   RCLEAR-2        ;CLEAR THE MEMORY IF SET
  1355.         AJMP    ILOOP-2         ;CLEAR DIRF AND LOOP
  1356.         ;
  1357. SGT2:   JBC     OTI,$+8         ;SEE IF TIMER INTERRUPT
  1358.         ANL     34,#10111101B   ;CLEAR INTERRUPTS
  1359.         AJMP    ILOOP           ;EXECUTE
  1360.         MOV     C,ISAV
  1361.         MOV     INPROG,C
  1362.         AJMP    ILOOP           ;RESTORE INTERRUPTS AND RET
  1363.         ;
  1364.         ;
  1365.         ;*************************************************************
  1366.         ;
  1367. RTST:   ; Test for ZERO
  1368.         ;
  1369.         ;*************************************************************
  1370.         ;
  1371.         ACALL   EXPRB           ;EVALUATE EXPRESSION
  1372.         CALL    INC_ASTKA       ;BUMP ARG STACK
  1373.         JZ      $+4             ;EXIT WITH ZERO OR 0FFH
  1374.         MOV     A,#0FFH
  1375.         RET
  1376.         ;
  1377.         newpage
  1378.         ;
  1379.         ;**************************************************************
  1380.         ;
  1381.         ; GLN - get the line number in R2:R0, return in DPTR
  1382.         ;
  1383.         ;**************************************************************
  1384.         ;
  1385. GLN:    ACALL   DP_B            ;GET THE BEGINNING ADDRESS
  1386.         ;
  1387. FL1:    MOVX    A,@DPTR         ;GET THE LENGTH
  1388.         MOV     R7,A            ;SAVE THE LENGTH
  1389.         DJNZ    R7,FL3          ;SEE IF END OF FILE
  1390.         ;
  1391.         MOV     DPTR,#E10X      ;NO LINE NUMBER
  1392.         AJMP    EK              ;HANDLE THE ERROR
  1393.         ;
  1394. FL3:    JB      ACC.7,$-5       ;CHECK FOR BIT 7
  1395.         INC     DPTR            ;POINT AT HIGH BYTE
  1396.         MOVX    A,@DPTR         ;GET HIGH BYTE
  1397.         CJNE    A,R2B0,FL2      ;SEE IF MATCH
  1398.         INC     DPTR            ;BUMP TO LOW BYTE
  1399.         DEC     R7              ;ADJUST AGAIN
  1400.         MOVX    A,@DPTR         ;GET THE LOW BYTE
  1401.         CJNE    A,R0B0,FL2      ;SEE IF LOW BYTE MATCH
  1402.         INC     DPTR            ;POINT AT FIRST CHARACTER
  1403.         RET                     ;FOUND IT
  1404.         ;
  1405. FL2:    MOV     A,R7            ;GET THE LENGTH COUNTER
  1406.         CALL    ADDPTR          ;ADD A TO DATA POINTER
  1407.         SJMP    FL1             ;LOOP
  1408.         ;
  1409.         ;
  1410.         ;*************************************************************
  1411.         ;
  1412.         ;RLINE - Read in ASCII string, get line, and clean it up
  1413.         ;
  1414.         ;*************************************************************
  1415.         ;
  1416. RLINE:  ACALL   INTERR          ;GET THE INTEGER
  1417.         ;
  1418. RL1:    ACALL   GLN
  1419.         AJMP    CLN_UP
  1420.         ;
  1421.         ;
  1422. D_L1:   ACALL   GLN             ;GET THE LINE
  1423.         AJMP    SGT1            ;EXECUTE THE LINE
  1424.         ;
  1425.         newpage
  1426.         ;***************************************************************
  1427.         ;
  1428.         ; The statement action routines WHILE and UNTIL
  1429.         ;
  1430.         ;***************************************************************
  1431.         ;
  1432. SWHILE: ACALL   RTST            ;EVALUATE RELATIONAL EXPRESSION
  1433.         CPL     A
  1434.         SJMP    S_WU
  1435.         ;
  1436. SUNTIL: ACALL   RTST            ;EVALUATE RELATIONAL EXPRESSION
  1437.         ;
  1438. S_WU:   MOV     R4,#DTYPE       ;DO EXPECTED
  1439.         MOV     R5,A            ;SAVE R_OP RESULT
  1440.         SJMP    SR0             ;GO PROCESS
  1441.         ;
  1442.         ;
  1443.         ;***************************************************************
  1444.         ;
  1445. CNULL:  ; The Command Action Routine - NULL
  1446.         ;
  1447.         ;***************************************************************
  1448.         ;
  1449.         ACALL   INTERR          ;GET AN INTEGER FOLLOWING NULL
  1450.         MOV     NULLCT,R0       ;SAVE THE NULLCOUNT
  1451.         AJMP    CMNDLK          ;JUMP TO COMMAND MODE
  1452.         ;
  1453.         newpage
  1454.         ;***************************************************************
  1455.         ;
  1456.         ; The statement action routine - RETI
  1457.         ;
  1458.         ;***************************************************************
  1459.         ;
  1460. SRETI:  SETB    RETBIT          ;SAYS THAT RETI HAS BEEN EXECUTED
  1461.         ;
  1462.         ;***************************************************************
  1463.         ;
  1464.         ; The statement action routine - RETURN
  1465.         ;
  1466.         ;***************************************************************
  1467.         ;
  1468. SRETRN: MOV     R4,#GTYPE       ;MAKE SURE OF GOSUB
  1469.         MOV     R5,#55H         ;TYPE RETURN TYPE
  1470.         ;
  1471. SR0:    ACALL   CSETUP          ;SET UP CONTROL STACK
  1472.         MOVX    A,@R0           ;GET RETURN TEXT ADDRESS
  1473.         MOV     DPH,A
  1474.         INC     R0
  1475.         MOVX    A,@R0
  1476.         MOV     DPL,A
  1477.         INC     R0              ;POP CONTROL STACK
  1478.         MOVX    A,@DPTR         ;SEE IF GOSUB WAS THE LAST STATEMENT
  1479.         CJNE    A,#EOF,$+5
  1480.         AJMP    CMNDLK
  1481.         MOV     A,R5            ;GET TYPE
  1482.         JZ      SGT1            ;EXIT IF ZERO
  1483.         MOV     CSTKA,R0        ;POP THE STACK
  1484.         CPL     A               ;OPTION TEST, 00H, 55H, 0FFH, NOW 55H
  1485.         JNZ     SGT1            ;MUST BE GOSUB
  1486.         RET                     ;NORMAL FALL THRU EXIT FOR NO MATCH
  1487.         ;
  1488.         newpage
  1489.         ;***************************************************************
  1490.         ;
  1491.         ; The statement action routine - GOSUB
  1492.         ;
  1493.         ;***************************************************************
  1494.         ;
  1495. SGOSUB: ACALL   RLINE           ;NEW TXA IN DPTR
  1496.         ;
  1497. SGS0:   MOV     R4,#GTYPE
  1498.         ACALL   SGS1            ;SET EVERYTHING UP
  1499.         AJMP    SF3             ;EXIT
  1500.         ;
  1501. SGS1:   MOV     A,#-3           ;ALLOCATE 3 BYTES ON CONTROL STACK
  1502.         ACALL   PUSHCS
  1503.         ;
  1504. T_X_S:  MOV     P2,#CSTKAH      ;SET UP PORT FOR CONTROL STACK
  1505.         MOV     A,TXAL          ;GET RETURN ADDRESS AND SAVE IT
  1506.         MOVX    @R0,A
  1507.         DEC     R0
  1508.         MOV     A,TXAH
  1509.         MOVX    @R0,A
  1510.         DEC     R0
  1511.         MOV     A,R4            ;GET TYPE
  1512.         MOVX    @R0,A           ;SAVE TYPE
  1513.         RET                     ;EXIT
  1514.         ;
  1515.         ;
  1516. CS1:    MOV     A,#3            ;POP 3 BYTES
  1517.         ACALL   PUSHCS
  1518.         ;
  1519. CSETUP: MOV     R0,CSTKA        ;GET CONTROL STACK
  1520.         MOV     P2,#CSTKAH
  1521.         MOVX    A,@R0           ;GET BYTE
  1522.         CJNE    A,R4B0,$+5      ;SEE IF TYPE MATCH
  1523.         INC     R0
  1524.         RET
  1525.         JZ      E4XX            ;EXIT IF STACK UNDERFLOW
  1526.         CJNE    A,#FTYPE,CS1    ;SEE IF FOR TYPE
  1527.         ACALL   PUSHCS-2        ;WASTE THE FOR TYPE
  1528.         SJMP    CSETUP          ;LOOP
  1529.         ;
  1530.         newpage
  1531.         ;***************************************************************
  1532.         ;
  1533.         ; The statement action routine - NEXT
  1534.         ;
  1535.         ;***************************************************************
  1536.         ;
  1537. SNEXT:  MOV     R4,#FTYPE       ;FOR TYPE
  1538.         ACALL   CSETUP          ;SETUP CONTROL STACK
  1539.         MOV     TEMP5,R0        ;SAVE CONTROL VARIABLE ADDRESS
  1540.         MOV     R1,#TEMP1       ;SAVE VAR + RETURN IN TEMP1-4
  1541.         ;
  1542. XXI:    MOVX    A,@R0           ;LOOP UNTIL DONE
  1543.         MOV     @R1,A
  1544.         INC     R1
  1545.         INC     R0
  1546.         CJNE    R1,#TEMP5,XXI
  1547.         ;
  1548.         ACALL   VAR             ;SEE IF THE USER HAS A VARIABLE
  1549.         JNC     $+6
  1550.         MOV     R2,TEMP1
  1551.         MOV     R0,TEMP2
  1552.         MOV     A,R2            ;SEE IF VAR'S AGREE
  1553.         CJNE    A,TEMP1,E4XX
  1554.         MOV     A,R0
  1555.         CJNE    A,TEMP2,E4XX
  1556.         ACALL   PUSHAS          ;PUT CONTROL VARIABLE ON STACK
  1557.         MOV     A,#FPSIZ+FPSIZ+2;COMPUTE ADDRESS TO STEP VALUE SIGN
  1558.         ADD     A,TEMP5         ;ADD IT TO BASE OF STACK
  1559.         MOV     R0,A            ;SAVE IN R0
  1560.         MOV     R2,#CSTKAH      ;SET UP TO PUSH STEP VALUE
  1561.         MOV     P2,R2           ;SET UP PORT
  1562.         MOVX    A,@R0           ;GET SIGN
  1563.         INC     R0              ;BACK TO EXPONENT
  1564.         PUSH    ACC             ;SAVE SIGN OF STEP
  1565.         ACALL   PUSHAS          ;PUT STEP VALUE ON STACK
  1566.         PUSH    R0B0            ;SAVE LIMIT VALUE LOCATION
  1567.         CALL    AADD            ;ADD STEP VALUE TO VARIABLE
  1568.         CALL    CSTAKA          ;COPY STACK
  1569.         MOV     R3,TEMP1        ;GET CONTROL VARIABLE
  1570.         MOV     R1,TEMP2
  1571.         ACALL   POPAS           ;SAVE THE RESULT
  1572.         MOV     R2,#CSTKAH      ;RESTORE LIMIT LOCATION
  1573.         POP     R0B0
  1574.         ACALL   PUSHAS          ;PUT LIMIT ON STACK
  1575.         CALL    FP_BASE+4       ;DO THE COMPARE
  1576.         POP     ACC             ;GET LIMIT SIGN BACK
  1577.         JZ      $+3             ;IF SIGN NEGATIVE, TEST "BACKWARDS"
  1578.         CPL     C
  1579.         ORL     C,F0            ;SEE IF EQUAL
  1580.         JC      N4              ;STILL SMALLER THAN LIMIT?
  1581.         MOV     A,#FSIZE        ;REMOVE CONTROL STACK ENTRY
  1582.         ;
  1583.         ; Fall thru to PUSHCS
  1584.         ;
  1585.         newpage
  1586.         ;***************************************************************
  1587.         ;
  1588.         ; PUSHCS - push frame onto control stack
  1589.         ;          acc has - number of bytes, also test for overflow
  1590.         ;
  1591.         ;***************************************************************
  1592.         ;
  1593. PUSHCS: ADD     A,CSTKA         ;BUMP CONTROL STACK
  1594.         CJNE    A,#CONVT+17,$+3 ;SEE IF OVERFLOWED
  1595.         JC      E4XX            ;EXIT IF STACK OVERFLOW
  1596.         XCH     A,CSTKA         ;STORE NEW CONTROL STACK VALUE, GET OLD
  1597.         DEC     A               ;BUMP OLD VALUE
  1598.         MOV     R0,A            ;PUT OLD-1 IN R0
  1599.         ;
  1600.         RET                     ;EXIT
  1601.         ;
  1602. CSC:    ACALL   CLN_UP          ;FINISH OFF THE LINE
  1603.         JNC     CSC-1           ;EXIT IF NO TERMINATOR
  1604.         ;
  1605. E4XX:   MOV     DPTR,#EXC       ;CONTROL STACK ERROR
  1606.         AJMP    EK              ;STACK ERROR
  1607.         ;
  1608. N4:     MOV     TXAH,TEMP3      ;GET TEXT POINTER
  1609.         MOV     TXAL,TEMP4
  1610.         AJMP    ILOOP           ;EXIT
  1611.         ;
  1612.         ;***************************************************************
  1613.         ;
  1614.         ; The statement action routine - RESTORE
  1615.         ;
  1616.         ;***************************************************************
  1617.         ;
  1618. SRESTR: ACALL   X_TR            ;SWAP POINTERS
  1619.         ACALL   DP_B            ;GET THE STARTING ADDRESS
  1620.         ACALL   T_DP            ;PUT STARTING ADDRESS IN TEXT POINTER
  1621.         ACALL   B_TXA           ;BUMP TXA
  1622.         ;
  1623.         ; Fall thru
  1624.         ;
  1625. X_TR:   ;swap txa and rtxa
  1626.         ;
  1627.         XCH     A,TXAH
  1628.         XCH     A,RTXAH
  1629.         XCH     A,TXAH
  1630.         XCH     A,TXAL
  1631.         XCH     A,RTXAL
  1632.         XCH     A,TXAL
  1633.         RET                     ;EXIT
  1634.         ;
  1635.         newpage
  1636.         ;***************************************************************
  1637.         ;
  1638.         ; The statement action routine - READ
  1639.         ;
  1640.         ;***************************************************************
  1641.         ;
  1642. SREAD:  ACALL   X_TR            ;SWAP POINTERS
  1643.         ;
  1644. SRD0:   ACALL   C_TST           ;CHECK FOR COMMA
  1645.         JC      SRD4            ;SEE WHAT IT IS
  1646.         ;
  1647. SRD:    ACALL   EXPRB           ;EVALUATE THE EXPRESSION
  1648.         ACALL   GC              ;GET THE CHARACTER AFTER EXPRESSION
  1649.         CJNE    A,#',',SRD1     ;SEE IF MORE DATA
  1650.         SJMP    SRD2            ;BYBASS CLEAN UP IF A COMMA
  1651.         ;
  1652. SRD1:   ACALL   CLN_UP          ;FINISH OFF THE LINE, IF AT END
  1653.         ;
  1654. SRD2:   ACALL   X_TR            ;RESTORE POINTERS
  1655.         ACALL   VAR_ER          ;GET VARIABLE ADDRESS
  1656.         ACALL   XPOP            ;FLIP THE REGISTERS FOR POPAS
  1657.         ACALL   C_TST           ;SEE IF A COMMA
  1658.         JNC     SREAD           ;READ AGAIN IF A COMMA
  1659.         RET                     ;EXIT IF NOT
  1660.         ;
  1661. SRD4:   CJNE    A,#T_DATA,SRD5  ;SEE IF DATA
  1662.         ACALL   GCI1            ;BUMP POINTER
  1663.         SJMP    SRD
  1664.         ;
  1665. SRD5:   CJNE    A,#EOF,SRD6     ;SEE IF YOU BLEW IT
  1666.         ACALL   X_TR            ;GET THE TEXT POINTER BACK
  1667.         MOV     DPTR,#E14X      ;READ ERROR
  1668.         ;
  1669. EK:     LJMP    ERROR
  1670.         ;
  1671. SRD6:   ACALL   FINDCR          ;WASTE THIS LINE
  1672.         ACALL   CLN_UP          ;CLEAN IT UP
  1673.         JC      SRD5+3          ;ERROR IF AT END
  1674.         SJMP    SRD0
  1675.         ;
  1676. NUMC:   ACALL   GC              ;GET A CHARACTER
  1677.         CJNE    A,#'#',NUMC1    ;SEE IF A #
  1678.         SETB    COB             ;VALID LINE PRINT
  1679.         AJMP    IGC             ;BUMP THE TEXT POINTER
  1680.         ;
  1681. NUMC1:  CJNE    A,#'@',SRD4-1   ;EXIT IF NO GOOD
  1682.         SETB    LPB
  1683.         AJMP    IGC
  1684.         ;
  1685.         newpage
  1686.         ;***************************************************************
  1687.         ;
  1688.         ; The statement action routine - PRINT
  1689.         ;
  1690.         ;***************************************************************
  1691.         ;
  1692. SPH0:   SETB    ZSURP           ;NO ZEROS
  1693.         ;
  1694. SPH1:   SETB    HMODE           ;HEX MODE
  1695.         ;
  1696. SPRINT: ACALL   NUMC            ;TEST FOR A LINE PRINT
  1697.         ACALL   $+9             ;PROCEED
  1698.         ANL     35,#11110101B   ;CLEAR COB AND LPB
  1699.         ANL     38,#00111111B   ;NO HEX MODE
  1700.         ;
  1701.         RET
  1702.         ;
  1703.         ACALL   DELTST          ;CHECK FOR A DELIMITER
  1704.         JC      SP1
  1705.         ;
  1706. SP0:    JMP     CRLF            ;EXIT WITH A CR IF SO
  1707.         ;
  1708. SP2:    ACALL   C_TST           ;CHECK FOR A COMMA
  1709.         JC      SP0             ;EXIT IF NO COMMA
  1710.         ;
  1711. SP1:    ACALL   CPS             ;SEE IF A STRING TO PRINT
  1712.         JNC     SP2             ;IF A STRING, CHECK FOR A COMMA
  1713.         ;
  1714. SP4:    CJNE    A,#T_TAB,SP6
  1715.         ACALL   I_PI            ;ALWAYS CLEARS CARRY
  1716.         SUBB    A,PHEAD         ;TAKE DELTA BETWEEN TAB AND PHEAD
  1717.         JC      SP2             ;EXIT IF PHEAD > TAB
  1718.         SJMP    SP7             ;OUTPUT SPACES
  1719.         ;
  1720. SP6:    CJNE    A,#T_SPC,SM
  1721.         ACALL   I_PI            ;SET UP PAREN VALUE
  1722.         ;
  1723. SP7:    JZ      SP2
  1724.         LCALL   STEROT          ;OUTPUT A SPACE
  1725.         DEC     A               ;DECREMENT COUNTER
  1726.         SJMP    SP7             ;LOOP
  1727.         ;
  1728.         newpage
  1729. SM:     CJNE    A,#T_CHR,SP8
  1730.         ACALL   IGC
  1731.         CJNE    A,#'$',$+9
  1732.         ACALL   CNX             ;PUT THE CHARACTER ON THE STACK
  1733.         ACALL   IFIXL           ;PUT THE CHARACTER IN R1
  1734.         SJMP    $+6
  1735.         ACALL   ONE             ;EVALUATE THE EXPRESSION, PUT IN R3:R1
  1736.         ACALL   ERPAR
  1737.         MOV     R5,R1B0         ;BYTE TO OUTPUT
  1738.         SJMP    SQ
  1739.         ;
  1740. SP8:    CJNE    A,#T_CR,SX
  1741.         ACALL   GCI1            ;EAT THE TOKEN
  1742.         MOV     R5,#CR
  1743.         ;
  1744. SQ:     CALL    TEROT
  1745.         SJMP    SP2             ;OUTPUT A CR AND DO IT AGAIN
  1746.         ;
  1747. SX:     CJNE    A,#T_USE,SP9    ;USING TOKEN
  1748.         ACALL   IGC             ;GE THE CHARACTER AFTER THE USING TOKEN
  1749.         CJNE    A,#'F',U4       ;SEE IF FLOATING
  1750.         MOV     FORMAT,#0F0H    ;SET FLOATING
  1751.         ACALL   IGC             ;BUMP THE POINTER AND GET THE CHARACTER
  1752.         ACALL   GCI1            ;BUMP IT AGAIN
  1753.         ANL     A,#0FH          ;STRIP OFF ASCII BIAS
  1754.         JZ      U3              ;EXIT IF ZERO
  1755.         CJNE    A,#3,$+3        ;SEE IF AT LEAST A THREE
  1756.         JNC     U3              ;FORCE A THREE IF NOT A THREE
  1757.         MOV     A,#3
  1758.         ;
  1759. U3:     ORL     FORMAT,A        ;PUT DIGIT IN FORMAT
  1760.         SJMP    U8              ;CLEAN UP END
  1761.         ;
  1762. U4:     CJNE    A,#'0',U5
  1763.         MOV     FORMAT,#0       ;FREE FORMAT
  1764.         ACALL   GCI1            ;BUMP THE POINTER
  1765.         SJMP    U8
  1766.         ;
  1767. U5:     CJNE    A,#'#',U8       ;SEE IF INTGER FORMAT
  1768.         ACALL   U6
  1769.         MOV     FORMAT,R7       ;SAVE THE FORMAT
  1770.         CJNE    A,#'.',U8A      ;SEE IF TERMINATOR WAS RADIX
  1771.         ACALL   IGC             ;BUMP PAST .
  1772.         ACALL   U6              ;LOOP AGAIN
  1773.         MOV     A,R7            ;GET COUNT
  1774.         ADD     A,FORMAT        ;SEE IF TOO BIG
  1775.         ADD     A,#0F7H
  1776.         JNC     U5A
  1777.         ;
  1778.         newpage
  1779. SE0:    AJMP    INTERX          ;ERROR, BAD SYNTAX
  1780.         ;
  1781. U5A:    MOV     A,R7            ;GET THE COUNT BACK
  1782.         SWAP    A               ;ADJUST
  1783.         ORL     FORMAT,A        ;GET THE COUNT
  1784.         ;
  1785. U8A:    MOV     A,FORMAT
  1786.         ;
  1787. U8B:    SWAP    A               ;GET THE FORMAT RIGHT
  1788.         MOV     FORMAT,A
  1789.         ;
  1790. U8:     ACALL   ERPAR
  1791.         AJMP    SP2             ;DONE
  1792.         ;
  1793. U6:     MOV     R7,#0           ;SET COUNTER
  1794.         ;
  1795. U7:     CJNE    A,#'#',SP9A     ;EXIT IF NOT A #
  1796.         INC     R7              ;BUMP COUNTER
  1797.         ACALL   IGC             ;GET THE NEXT CHARACTER
  1798.         SJMP    U7              ;LOOP
  1799.         ;
  1800. SP9:    ACALL   DELTST+2        ;CHECK FOR DELIMITER
  1801.         JNC     SP9A            ;EXIT IF A DELIMITER
  1802.         ;
  1803.         CJNE    A,#T_ELSE,SS
  1804.         ;
  1805. SP9A:   RET                     ;EXIT IF ELSE TOKEN
  1806.         ;
  1807.         ;**************************************************************
  1808.         ;
  1809.         ; P_E - Evaluate an expression in parens ( )
  1810.         ;
  1811.         ;**************************************************************
  1812.         ;
  1813. P_E:    MOV     R7,#T_LPAR
  1814.         ACALL   WE
  1815.         ;
  1816. ERPAR:  MOV     R7,#')'         ;EAT A RIGHT PAREN
  1817.         ;
  1818. EATC:   ACALL   GCI             ;GET THE CHARACTER
  1819.         CJNE    A,R7B0,SE0      ;ERROR IF NOT THE SAME
  1820.         RET
  1821.         ;
  1822.         newpage
  1823.         ;***************************************************************
  1824.         ;
  1825. S_ON:   ; ON Statement
  1826.         ;
  1827.         ;***************************************************************
  1828.         ;
  1829.         ACALL   ONE             ;GET THE EXPRESSION
  1830.         ACALL   GCI             ;GET THE NEXT CHARACTER
  1831.         CJNE    A,#T_GOTO,C0
  1832.         ACALL   C1              ;EAT THE COMMAS
  1833.         AJMP    SF3             ;DO GOTO
  1834.         ;
  1835. C0:     CJNE    A,#T_GOSB,SE0
  1836.         ACALL   C1
  1837.         AJMP    SGS0            ;DO GOSUB
  1838.         ;
  1839. C1:     CJNE    R1,#0,C2
  1840.         ACALL   INTERR          ;GET THE LINE NUMBER
  1841.         ACALL   FINDCR
  1842.         AJMP    RL1             ;FINISH UP THIS LINE
  1843.         ;
  1844. C2:     MOV     R7,#','
  1845.         ACALL   FINDC
  1846.         CJNE    A,#',',SE0      ;ERROR IF NOT A COMMA
  1847.         DEC     R1
  1848.         ACALL   GCI1            ;BUMP PAST COMMA
  1849.         SJMP    C1
  1850.         ;
  1851.         newpage
  1852.         ;
  1853. SS:     ACALL   S_C             ;SEE IF A STRING
  1854.         JC      SA              ;NO STRING IF CARRY IS SET
  1855.         LCALL   UPRNT           ;PUT POINTER IN DPTR
  1856.         AJMP    SP2             ;SEE IF MORE
  1857.         ;
  1858. SA:     ACALL   EXPRB           ;MUST BE AN EXPRESSION
  1859.         MOV     A,#72
  1860.         CJNE    A,PHEAD,$+3     ;CHECK PHEAD POSITION
  1861.         JNC     $+4
  1862.         ACALL   SP0             ;FORCE A CRLF
  1863.         JNB     HMODE,S13       ;HEX MODE?
  1864.         CALL    FCMP            ;SEE IF TOS IS < 0FFFH
  1865.         JC      S13             ;EXIT IF GREATER
  1866.         CALL    AABS            ;GET THE SIGN
  1867.         JNZ     OOPS            ;WASTE IF NEGATIVE
  1868.         ACALL   IFIXL
  1869.         CALL    FP_BASE+22      ;PRINT HEXMODE
  1870.         AJMP    SP2
  1871. OOPS:   CALL    ANEG            ;MAKE IT NEGATIVE
  1872.         ;
  1873. S13:    CALL    FP_BASE+14      ;DO FP OUTPUT
  1874.         MOV     A,#1            ;OUTPUT A SPACE
  1875.         AJMP    SP7
  1876.         ;
  1877.         newpage
  1878.         ;***************************************************************
  1879.         ;
  1880.         ; ANU -  Get variable name from text - set carry if not found
  1881.         ;        if succeeds returns variable in R7:R6
  1882.         ;        R6 = 0 if no digit in name
  1883.         ;
  1884.         ;***************************************************************
  1885.         ;
  1886. ANU:    ACALL   IGC             ;INCREMENT AND GET CHARACTER
  1887.         LCALL   1FEDH           ;CHECK FOR DIGIT
  1888.         JC      $+14            ;EXIT IF VALID DIGIT
  1889.         CJNE    A,#'_',$+4      ;SEE IF A _
  1890.         RET
  1891.         ;
  1892. AL:     CJNE    A,#'A',$+3      ;IS IT AN ASCII A?
  1893.         JC      $+6             ;EXIT IF CARRY IS SET
  1894.         CJNE    A,#'Z'+1,$+3    ;IS IT LESS THAN AN ASCII Z
  1895.         CPL     C               ;FLIP CARRY
  1896.         RET
  1897.         ;
  1898.         JNB     F0,VAR2
  1899.         ;
  1900. SD0:    MOV     DPTR,#E6X
  1901.         AJMP    EK
  1902.         ;
  1903. SDIMX:  SETB    F0              ;SAYS DOING A DIMENSION
  1904.         SJMP    VAR1
  1905.         ;
  1906. VAR:    CLR     F0              ;SAYS DOING A VARIABLE
  1907.         ;
  1908. VAR1:   ACALL   GC              ;GET THE CHARACTER
  1909.         ACALL   AL              ;CHECK FOR ALPHA
  1910.         JNC     $+6             ;ERROR IF IN DIM
  1911.         JB      F0,SD0
  1912.         RET
  1913.         MOV     R7,A            ;SAVE ALPHA CHARACTER
  1914.         CLR     A               ;ZERO IN CASE OF FAILURE
  1915.         MOV     R5,A            ;SAVE IT
  1916.         ;
  1917. VY:     MOV     R6,A
  1918.         ACALL   ANU             ;CHECK FOR ALPHA OR NUMBER
  1919.         JC      VX              ;EXIT IF NO ALPHA OR NUM
  1920.         ;
  1921.         XCH     A,R7
  1922.         ADD     A,R5            ;NUMBER OF CHARACTERS IN ALPHABET
  1923.         XCH     A,R7            ;PUT IT BACK
  1924.         MOV     R5,#26          ;FOR THE SECOND TIME AROUND
  1925.         SJMP    VY
  1926.         ;
  1927. VX:     CLR     LINEB           ;TELL EDITOR A VARIABLE IS DECLARED
  1928.         CJNE    A,#T_LPAR,V4    ;SEE IF A LEFT PAREN
  1929.         ;
  1930.         ORL     R6B0,#80H       ;SET BIT 7 TO SIGINIFY MATRIX
  1931.         CALL    F_VAR           ;FIND THE VARIABLE
  1932.         PUSH    R2B0            ;SAVE THE LOCATION
  1933.         PUSH    R0B0
  1934.         JNC     SD0-3           ;DEFAULT IF NOT IN TABLE
  1935.         JB      F0,SDI          ;NO DEFAULT FOR DIMENSION
  1936.         MOV     R1,#10
  1937.         MOV     R3,#0
  1938.         ACALL   D_CHK
  1939.         ;
  1940. VAR2:   ACALL   PAREN_INT       ;EVALUATE INTEGER IN PARENS
  1941.         CJNE    R3,#0,SD0       ;ERROR IF R3<>0
  1942.         POP     DPL             ;GET VAR FOR LOOKUP
  1943.         POP     DPH
  1944.         MOVX    A,@DPTR         ;GET DIMENSION
  1945.         DEC     A               ;BUMP OFFSET
  1946.         SUBB    A,R1            ;A MUST BE > R1
  1947.         JC      SD0
  1948.         LCALL   DECDP2          ;BUMP POINTER TWICE
  1949.         ACALL   VARB            ;CALCULATE THE BASE
  1950.         ;
  1951. X3120:  XCH     A,R1            ;SWAP R2:R0, R3:R1
  1952.         XCH     A,R0
  1953.         XCH     A,R1
  1954.         XCH     A,R3
  1955.         XCH     A,R2
  1956.         XCH     A,R3
  1957.         RET
  1958.         ;
  1959. V4:     JB      F0,SD0          ;ERROR IF NO LPAR FOR DIM
  1960.         LCALL   F_VAR           ;GET SCALAR VARIABLE
  1961.         CLR     C
  1962.         RET
  1963.         ;
  1964.         newpage
  1965.         ;
  1966. SDI:    ACALL   PAREN_INT       ;EVALUATE PAREN EXPRESSION
  1967.         CJNE    R3,#0,SD0       ;ERROR IF NOT ZERO
  1968.         POP     R0B0            ;SET UP R2:R0
  1969.         POP     R2B0
  1970.         ACALL   D_CHK           ;DO DIM
  1971.         ACALL   C_TST           ;CHECK FOR COMMA
  1972.         JNC     SDIMX           ;LOOP IF COMMA
  1973.         RET                     ;RETURN IF NO COMMA
  1974.         ;
  1975. D_CHK:  INC     R1              ;BUMP FOR TABLE LOOKUP
  1976.         MOV     A,R1
  1977.         JZ      SD0             ;ERROR IF 0FFFFH
  1978.         MOV     R4,A            ;SAVE FOR LATER
  1979.         MOV     DPTR,#MT_ALL    ;GET MATRIX ALLOCATION
  1980.         ACALL   VARB            ;DO THE CALCULATION
  1981.         MOV     R7,DPH          ;SAVE MATRIX ALLOCATION
  1982.         MOV     R6,DPL
  1983.         MOV     DPTR,#ST_ALL    ;SEE IF TOO MUCH MEMORY TAKEN
  1984.         CALL    FUL1            ;ST_ALL SHOULD BE > R3:R1
  1985.         MOV     DPTR,#MT_ALL    ;SAVE THE NEW MATRIX POINTER
  1986.         CALL    S31DP
  1987.         MOV     DPL,R0          ;GET VARIABLE ADDRESS
  1988.         MOV     DPH,R2
  1989.         MOV     A,R4            ;DIMENSION SIZE
  1990.         MOVX    @DPTR,A         ;SAVE IT
  1991.         CALL    DECDP2          ;SAVE TARGET ADDRESS
  1992.         ;
  1993. R76S:   MOV     A,R7
  1994.         MOVX    @DPTR,A
  1995.         INC     DPTR
  1996.         MOV     A,R6            ;ELEMENT SIZE
  1997.         MOVX    @DPTR,A
  1998.         RET                     ;R2:R0 STILL HAS SYMBOL TABLE ADDRESS
  1999.         ;
  2000.         newpage
  2001.         ;***************************************************************
  2002.         ;
  2003.         ; The statement action routine - INPUT
  2004.         ;
  2005.         ;***************************************************************
  2006.         ;
  2007. SINPUT: ACALL   CPS             ;PRINT STRING IF THERE
  2008.         ;
  2009.         ACALL   C_TST           ;CHECK FOR A COMMA
  2010.         JNC     IN2A            ;NO CRLF
  2011.         ACALL   SP0             ;DO A CRLF
  2012.         ;
  2013. IN2:    MOV     R5,#'?'         ;OUTPUT A ?
  2014.         CALL    TEROT
  2015.         ;
  2016. IN2A:   SETB    INP_B           ;DOING INPUT
  2017.         CALL    INLINE          ;INPUT THE LINE
  2018.         CLR     INP_B
  2019.         MOV     TEMP5,#HI(IBUF)
  2020.         MOV     TEMP4,#LO(IBUF)
  2021.         ;
  2022. IN3:    ACALL   S_C             ;SEE IF A STRING
  2023.         JC      IN3A            ;IF CARRY IS SET, NO STRING
  2024.         ACALL   X3120           ;FLIP THE ADDRESSES
  2025.         MOV     R3,TEMP5
  2026.         MOV     R1,TEMP4
  2027.         ACALL   SSOOP
  2028.         ACALL   C_TST           ;SEE IF MORE TO DO
  2029.         JNC     IN2
  2030.         RET
  2031.         ;
  2032. IN3A:   CALL    DTEMP           ;GET THE USER LOCATION
  2033.         CALL    GET_NUM         ;GET THE USER SUPPLIED NUMBER
  2034.         JNZ     IN5             ;ERROR IF NOT ZERO
  2035.         CALL    TEMPD           ;SAVE THE DATA POINTER
  2036.         ACALL   VAR_ER          ;GET THE VARIABLE
  2037.         ACALL   XPOP            ;SAVE THE VARIABLE
  2038.         CALL    DTEMP           ;GET DPTR BACK FROM VAR_ER
  2039.         ACALL   C_TST           ;SEE IF MORE TO DO
  2040.         JC      IN6             ;EXIT IF NO COMMA
  2041.         MOVX    A,@DPTR         ;GET INPUT TERMINATOR
  2042.         CJNE    A,#',',IN5      ;IF NOT A COMMA DO A CR AND TRY AGAIN
  2043.         INC     DPTR            ;BUMP PAST COMMA AND READ NEXT VALUE
  2044.         CALL    TEMPD
  2045.         SJMP    IN3
  2046.         ;
  2047.         newpage
  2048.         ;
  2049. IN5:    MOV     DPTR,#IAN       ;PRINT INPUT A NUMBER
  2050.         CALL    CRP             ;DO A CR, THEN, PRINT FROM ROM
  2051.         LJMP    CC1             ;TRY IT AGAIN
  2052.         ;
  2053. IN6:    MOVX    A,@DPTR
  2054.         CJNE    A,#CR,EIGP
  2055.         RET
  2056.         ;
  2057. EIGP:   MOV     DPTR,#EIG
  2058.         CALL    CRP             ;PRINT THE MESSAGE AND EXIT
  2059.         AJMP    SP0             ;EXIT WITH A CRLF
  2060.         ;
  2061.         ;***************************************************************
  2062.         ;
  2063. SOT:    ; On timer interrupt
  2064.         ;
  2065.         ;***************************************************************
  2066.         ;
  2067.         ACALL   TWO             ;GET THE NUMBERS
  2068.         MOV     SP_H,R3
  2069.         MOV     SP_L,R1
  2070.         MOV     DPTR,#TIV       ;SAVE THE NUMBER
  2071.         SETB    OTS
  2072.         AJMP    R76S            ;EXIT
  2073.         ;
  2074.         ;
  2075.         ;***************************************************************
  2076.         ;
  2077. SCALL:  ; Call a user rountine
  2078.         ;
  2079.         ;***************************************************************
  2080.         ;
  2081.         ACALL   INTERR          ;CONVERT INTEGER
  2082.         CJNE    R2,#0,S_C_1     ;SEE IF TRAP
  2083.         MOV     A,R0
  2084.         JB      ACC.7,S_C_1
  2085.         ADD     A,R0
  2086.         MOV     DPTR,#4100H
  2087.         MOV     DPL,A
  2088.         ;
  2089. S_C_1:  ACALL   AC1             ;JUMP TO USER PROGRAM
  2090.         ANL     PSW,#11100111B  ;BACK TO BANK 0
  2091.         RET                     ;EXIT
  2092.         ;
  2093.         newpage
  2094.         ;**************************************************************
  2095.         ;
  2096. THREE:  ; Save value for timer function
  2097.         ;
  2098.         ;**************************************************************
  2099.         ;
  2100.         ACALL   ONE             ;GET THE FIRST INTEGER
  2101.         CALL    CBIAS           ;BIAS FOR TIMER LOAD
  2102.         MOV     T_HH,R3
  2103.         MOV     T_LL,R1
  2104.         MOV     R7,#','         ;WASTE A COMMA
  2105.         ACALL   EATC            ;FALL THRU TO TWO
  2106.         ;
  2107.         ;**************************************************************
  2108.         ;
  2109. TWO:    ; Get two values seperated by a comma off the stack
  2110.         ;
  2111.         ;**************************************************************
  2112.         ;
  2113.         ACALL   EXPRB
  2114.         MOV     R7,#','         ;WASTE THE COMMA
  2115.         ACALL   WE
  2116.         JMP     TWOL            ;EXIT
  2117.         ;
  2118.         ;*************************************************************
  2119.         ;
  2120. ONE:    ; Evaluate an expression and get an integer
  2121.         ;
  2122.         ;*************************************************************
  2123.         ;
  2124.         ACALL   EXPRB           ;EVALUATE EXPERSSION
  2125.         ;
  2126. IFIXL:  CALL    IFIX            ;INTEGERS IN R3:R1
  2127.         MOV     A,R1
  2128.         RET
  2129.         ;
  2130.         ;
  2131.         ;*************************************************************
  2132.         ;
  2133. I_PI:   ; Increment text pointer then get an integer
  2134.         ;
  2135.         ;*************************************************************
  2136.         ;
  2137.         ACALL   GCI1            ;BUMP TEXT, THEN GET INTEGER
  2138.         ;
  2139. PAREN_INT:; Get an integer in parens ( )
  2140.         ;
  2141.         ACALL   P_E
  2142.         SJMP    IFIXL
  2143.         ;
  2144.         newpage
  2145.         ;
  2146. DP_B:   MOV     DPH,BOFAH
  2147.         MOV     DPL,BOFAL
  2148.         RET
  2149.         ;
  2150. DP_T:   MOV     DPH,TXAH
  2151.         MOV     DPL,TXAL
  2152.         RET
  2153.         ;
  2154. CPS:    ACALL   GC              ;GET THE CHARACTER
  2155.         CJNE    A,#'"',NOPASS   ;EXIT IF NO STRING
  2156.         ACALL   DP_T            ;GET TEXT POINTER
  2157.         INC     DPTR            ;BUMP PAST "
  2158.         MOV     R4,#'"'
  2159.         CALL    PN0             ;DO THE PRINT
  2160.         INC     DPTR            ;GO PAST QUOTE
  2161.         CLR     C               ;PASSED TEST
  2162.         ;
  2163. T_DP:   MOV     TXAH,DPH        ;TEXT POINTER GETS DPTR
  2164.         MOV     TXAL,DPL
  2165.         RET
  2166.         ;
  2167.         ;*************************************************************
  2168.         ;
  2169. S_C:    ; Check for a string
  2170.         ;
  2171.         ;*************************************************************
  2172.         ;
  2173.         ACALL   GC              ;GET THE CHARACTER
  2174.         CJNE    A,#'$',NOPASS   ;SET CARRY IF NOT A STRING
  2175.         AJMP    IST_CAL         ;CLEAR CARRY, CALCULATE OFFSET
  2176.         ;
  2177.         ;
  2178.         ;
  2179.         ;**************************************************************
  2180.         ;
  2181. C_TST:  ACALL   GC              ;GET A CHARACTER
  2182.         CJNE    A,#',',NOPASS   ;SEE IF A COMMA
  2183.         ;
  2184.         newpage
  2185.         ;***************************************************************
  2186.         ;
  2187.         ;GC AND GCI - GET A CHARACTER FROM TEXT (NO BLANKS)
  2188.         ;             PUT CHARACTER IN THE ACC
  2189.         ;
  2190.         ;***************************************************************
  2191.         ;
  2192. IGC:    ACALL   GCI1            ;BUMP POINTER, THEN GET CHARACTER
  2193.         ;
  2194. GC:     SETB    RS0             ;USE BANK 1
  2195.         MOV     P2,R2           ;SET UP PORT 2
  2196.         MOVX    A,@R0           ;GET EXTERNAL BYTE
  2197.         CLR     RS0             ;BACK TO BANK 0
  2198.         RET                     ;EXIT
  2199.         ;
  2200. GCI:    ACALL   GC
  2201.         ;
  2202.         ; This routine bumps txa by one and always clears the carry
  2203.         ;
  2204. GCI1:   SETB    RS0             ;BANK 1
  2205.         INC     R0              ;BUMP TXA
  2206.         CJNE    R0,#0,$+4
  2207.         INC     R2
  2208.         CLR     RS0
  2209.         RET                     ;EXIT
  2210.         ;
  2211.         newpage
  2212.         ;**************************************************************
  2213.         ;
  2214.         ; Check delimiters
  2215.         ;
  2216.         ;**************************************************************
  2217.         ;
  2218. DELTST: ACALL   GC              ;GET A CHARACTER
  2219.         CJNE    A,#CR,DT1       ;SEE IF A CR
  2220.         CLR     A
  2221.         RET
  2222.         ;
  2223. DT1:    CJNE    A,#':',NOPASS   ;SET CARRY IF NO MATCH
  2224.         ;
  2225. L_RET:  RET
  2226.         ;
  2227.         ;
  2228.         ;***************************************************************
  2229.         ;
  2230.         ; FINDC - Find the character in R7, update TXA
  2231.         ;
  2232.         ;***************************************************************
  2233.         ;
  2234. FINDCR: MOV     R7,#CR          ;KILL A STATEMENT LINE
  2235.         ;
  2236. FINDC:  ACALL   DELTST
  2237.         JNC     L_RET
  2238.         ;
  2239.         CJNE    A,R7B0,FNDCL2   ;MATCH?
  2240.         RET
  2241.         ;
  2242. FNDCL2: ACALL   GCI1
  2243.         SJMP    FINDC           ;LOOP
  2244.         ;
  2245.         ACALL   GCI1
  2246.         ;
  2247. WCR:    ACALL   DELTST          ;WASTE UNTIL A "REAL" CR
  2248.         JNZ     WCR-2
  2249.         RET
  2250.         ;
  2251.         newpage
  2252.         ;***************************************************************
  2253.         ;
  2254.         ; VAR_ER - Check for a variable, exit if error
  2255.         ;
  2256.         ;***************************************************************
  2257.         ;
  2258. VAR_ER: ACALL   VAR
  2259.         SJMP    INTERR+2
  2260.         ;
  2261.         ;
  2262.         ;***************************************************************
  2263.         ;
  2264.         ; S_D0 - The Statement Action Routine DO
  2265.         ;
  2266.         ;***************************************************************
  2267.         ;
  2268. S_DO:   ACALL   CSC             ;FINISH UP THE LINE
  2269.         MOV     R4,#DTYPE       ;TYPE FOR STACK
  2270.         ACALL   SGS1            ;SAVE ON STACK
  2271.         AJMP    ILOOP           ;EXIT
  2272.         ;
  2273.         newpage
  2274.         ;***************************************************************
  2275.         ;
  2276.         ; CLN_UP - Clean up the end of a statement, see if at end of
  2277.         ;          file, eat character and line count after CR
  2278.         ;
  2279.         ;***************************************************************
  2280.         ;
  2281. C_2:    CJNE    A,#':',C_1      ;SEE IF A TERMINATOR
  2282.         AJMP    GCI1            ;BUMP POINTER AND EXIT, IF SO
  2283.         ;
  2284. C_1:    CJNE    A,#T_ELSE,EP5
  2285.         ACALL   WCR             ;WASTE UNTIL A CR
  2286.         ;
  2287. CLN_UP: ACALL   GC              ;GET THE CHARACTER
  2288.         CJNE    A,#CR,C_2       ;SEE IF A CR
  2289.         ACALL   IGC             ;GET THE NEXT CHARACTER
  2290.         CJNE    A,#EOF,B_TXA    ;SEE IF TERMINATOR
  2291.         ;
  2292. NOPASS: SETB    C
  2293.         RET
  2294.         ;
  2295. B_TXA:  XCH     A,TXAL          ;BUMP TXA BY THREE
  2296.         ADD     A,#3
  2297.         XCH     A,TXAL
  2298.         JBC     CY,$+4
  2299.         RET
  2300.         INC     TXAH
  2301.         RET
  2302.         ;
  2303.         newpage
  2304.         ;***************************************************************
  2305.         ;
  2306.         ;         Get an INTEGER from the text
  2307.         ;         sets CARRY if not found
  2308.         ;         returns the INTGER value in DPTR and R2:R0
  2309.         ;         returns the terminator in ACC
  2310.         ;
  2311.         ;***************************************************************
  2312.         ;
  2313. INTERR: ACALL   INTGER          ;GET THE INTEGER
  2314.         JC      EP5             ;ERROR IF NOT FOUND
  2315.         RET                     ;EXIT IF FOUND
  2316.         ;
  2317. INTGER: ACALL   DP_T
  2318.         CALL    FP_BASE+18      ;CONVERT THE INTEGER
  2319.         ACALL   T_DP
  2320.         MOV     DPH,R2          ;PUT THE RETURNED VALUE IN THE DPTR
  2321.         MOV     DPL,R0
  2322.         ;
  2323. ITRET:  RET                     ;EXIT
  2324.         ;
  2325.         ;
  2326. WE:     ACALL   EATC            ;WASTE THE CHARACTER
  2327.         ;
  2328.         ; Fall thru to evaluate the expression
  2329.         ;
  2330.         newpage
  2331.         ;***************************************************************
  2332.         ;
  2333.         ; EXPRB - Evaluate an expression
  2334.         ;
  2335.         ;***************************************************************
  2336.         ;
  2337. EXPRB:  MOV     R2,#LO(OPBOL)   ;BASE PRECEDENCE
  2338.         ;
  2339. EP1:    PUSH    R2B0            ;SAVE OPERATOR PRECEDENCE
  2340.         CLR     ARGF            ;RESET STACK DESIGNATOR
  2341.         ;
  2342. EP2:    MOV     A,SP            ;GET THE STACK POINTER
  2343.         ADD     A,#12           ;NEED AT LEAST 12 BYTES
  2344.         JNC     $+5
  2345.         LJMP    ERROR-3
  2346.         MOV     A,ASTKA         ;GET THE ARG STACK
  2347.         SUBB    A,#LO(TM_TOP+12);NEED 12 BYTES ALSO
  2348.         JNC     $+5
  2349.         LJMP    E4YY
  2350.         JB      ARGF,EP4        ;MUST BE AN OPERATOR, IF SET
  2351.         ACALL   VAR             ;IS THE VALUE A VARIABLE?
  2352.         JNC     EP3             ;PUT VARIABLE ON STACK
  2353.         ;
  2354.         ACALL   CONST           ;IS THE VALUE A NUMERIC CONSTANT?
  2355.         JNC     EP4             ;IF SO, CONTINUE, IF NOT, SEE WHAT
  2356.         CALL    GC              ;GET THE CHARACTER
  2357.         CJNE    A,#T_LPAR,EP4   ;SEE IF A LEFT PAREN
  2358.         MOV     A,#(LO(OPBOL+1))
  2359.         SJMP    XLPAR           ;PROCESS THE LEFT PAREN
  2360.         ;
  2361. EP3:    ACALL   PUSHAS          ;SAVE VAR ON STACK
  2362.         ;
  2363. EP4:    ACALL   GC              ;GET THE OPERATOR
  2364.         ;
  2365.         CJNE    A,#T_LPAR,$+3   ;IS IT AN OPERATOR
  2366.         JNC     XOP             ;PROCESS OPERATOR
  2367.         CJNE    A,#T_UOP,$+3    ;IS IT A UNARY OPERATOR
  2368.         JNC     XBILT           ;PROCESS UNARY (BUILT IN) OPERATOR
  2369.         POP     R2B0            ;GET BACK PREVIOUS OPERATOR PRECEDENCE
  2370.         JB      ARGF,ITRET      ;OK IF ARG FLAG IS SET
  2371.         ;
  2372. EP5:    CLR     C               ;NO RECOVERY
  2373.         LJMP    E1XX+2
  2374.         ;
  2375.         ; Process the operator
  2376.         ;
  2377. XOP:    ANL     A,#1FH          ;STRIP OFF THE TOKE BITS
  2378.         JB      ARGF,XOP1       ;IF ARG FLAG IS SET, PROCESS
  2379.         CJNE    A,#T_SUB-T_LPAR,XOP3
  2380.         MOV     A,#T_NEG-T_LPAR
  2381.         ;
  2382.         newpage
  2383. XOP1:   ADD     A,#LO(OPBOL+1)  ;BIAS THE TABLE
  2384.         MOV     R2,A
  2385.         MOV     DPTR,#00H
  2386.         MOVC    A,@A+DPTR       ;GET THE CURRENT PRECEDENCE
  2387.         MOV     R4,A
  2388.         POP     ACC             ;GET THE PREVIOUS PRECEDENCE
  2389.         MOV     R5,A            ;SAVE THE PREVIOUS PRECEDENCE
  2390.         MOVC    A,@A+DPTR       ;GET IT
  2391.         CJNE    A,R4B0,$+7      ;SEE WHICH HAS HIGHER PRECEDENCE
  2392.         CJNE    A,#12,ITRET     ;SEE IF ANEG
  2393.         SETB    C
  2394.         JNC     ITRET           ;PROCESS NON-INCREASING PRECEDENCE
  2395.         ;
  2396.         ; Save increasing precedence
  2397.         ;
  2398.         PUSH    R5B0            ;SAVE OLD PRECEDENCE ADDRESS
  2399.         PUSH    R2B0            ;SAVE NEW PRECEDENCE ADDRESS
  2400.         ACALL   GCI1            ;EAT THE OPERATOR
  2401.         ACALL   EP1             ;EVALUATE REMAINING EXPRESSION
  2402.         POP     ACC
  2403.         ;
  2404.         ; R2 has the action address, now setup and perform operation
  2405.         ;
  2406. XOP2:   MOV     DPTR,#OPTAB
  2407.         ADD     A,#LO(~OPBOL)
  2408.         CALL    ISTA1           ;SET UP TO RETURN TO EP2
  2409.         AJMP    EP2             ;JUMP TO EVALUATE EXPRESSION
  2410.         ;
  2411.         ; Built-in operator processing
  2412.         ;
  2413. XBILT:  ACALL   GCI1            ;EAT THE TOKEN
  2414.         ADD     A,#LO(50H+LO(UOPBOL))
  2415.         JB      ARGF,EP5        ;XBILT MUST COME AFTER AN OPERATOR
  2416.         CJNE    A,#STP,$+3
  2417.         JNC     XOP2
  2418.         ;
  2419. XLPAR:  PUSH    ACC             ;PUT ADDRESS ON THE STACK
  2420.         ACALL   P_E
  2421.         SJMP    XOP2-2          ;PERFORM OPERATION
  2422.         ;
  2423. XOP3:   CJNE    A,#T_ADD-T_LPAR,EP5
  2424.         ACALL   GCI1
  2425.         AJMP    EP2             ;WASTE + SIGN
  2426.         ;
  2427.         newpage
  2428. XPOP:   ACALL   X3120           ;FLIP ARGS THEN POP
  2429.         ;
  2430.         ;***************************************************************
  2431.         ;
  2432.         ; POPAS - Pop arg stack and copy variable to R3:R1
  2433.         ;
  2434.         ;***************************************************************
  2435.         ;
  2436. POPAS:  LCALL   INC_ASTKA
  2437.         JMP     VARCOP          ;COPY THE VARIABLE
  2438.         ;
  2439. AXTAL:  MOV     R2,#HI(CXTAL)
  2440.         MOV     R0,#LO(CXTAL)
  2441.         ;
  2442.         ; fall thru
  2443.         ;
  2444.         ;***************************************************************
  2445.         ;
  2446. PUSHAS: ; Push the Value addressed by R2:R0 onto the arg stack
  2447.         ;
  2448.         ;***************************************************************
  2449.         ;
  2450.         CALL    DEC_ASTKA
  2451.         SETB    ARGF            ;SAYS THAT SOMTHING IS ON THE STACK
  2452.         LJMP    VARCOP
  2453.         ;
  2454.         ;
  2455.         ;***************************************************************
  2456.         ;
  2457. ST_A:   ; Store at expression
  2458.         ;
  2459.         ;***************************************************************
  2460.         ;
  2461.         ACALL   ONE             ;GET THE EXPRESSION
  2462.         SJMP    POPAS           ;SAVE IT
  2463.         ;
  2464.         ;
  2465.         ;***************************************************************
  2466.         ;
  2467. LD_A:   ; Load at expression
  2468.         ;
  2469.         ;***************************************************************
  2470.         ;
  2471.         ACALL   ONE             ;GET THE EXPRESSION
  2472.         ACALL   X3120           ;FLIP ARGS
  2473.         SJMP    PUSHAS
  2474.         ;
  2475.         newpage
  2476.         ;***************************************************************
  2477.         ;
  2478. CONST:  ; Get a constant fron the text
  2479.         ;
  2480.         ;***************************************************************
  2481.         ;
  2482.         CALL    GC              ;FIRST SEE IF LITERAL
  2483.         CJNE    A,#T_ASC,C0C    ;SEE IF ASCII TOKEN
  2484.         CALL    IGC             ;GET THE CHARACTER AFTER TOKEN
  2485.         CJNE    A,#'$',CN0      ;SEE IF A STRING
  2486.         ;
  2487. CNX:    CALL    CSY             ;CALCULATE IT
  2488.         LJMP    AXBYTE+2        ;SAVE IT ON THE STACK ******AA JMP-->LJMP
  2489.         ;
  2490. CN0:    LCALL   TWO_R2          ;PUT IT ON THE STACK ******AA CALL-->LCALL
  2491.         CALL    GCI1            ;BUMP THE POINTER
  2492.         LJMP    ERPAR           ;WASTE THE RIGHT PAREN ******AA JMP-->LJMP
  2493.         ;
  2494.         ;
  2495. C0C:    CALL    DP_T            ;GET THE TEXT POINTER
  2496.         CALL    GET_NUM         ;GET THE NUMBER
  2497.         CJNE    A,#0FFH,C1C     ;SEE IF NO NUMBER
  2498.         SETB    C
  2499. C2C:    RET
  2500.         ;
  2501. C1C:    JNZ     FPTST
  2502.         CLR     C
  2503.         SETB    ARGF
  2504.         ;
  2505. C3C:    JMP     T_DP
  2506.         ;
  2507. FPTST:  ANL     A,#00001011B    ;CHECK FOR ERROR
  2508.         JZ      C2C             ;EXIT IF ZERO
  2509.         ;
  2510.         ; Handle the error condition
  2511.         ;
  2512.         MOV     DPTR,#E2X       ;DIVIDE BY ZERO
  2513.         JNB     ACC.0,$+6       ;UNDERFLOW
  2514.         MOV     DPTR,#E7X
  2515.         JNB     ACC.1,$+6       ;OVERFLOW
  2516.         MOV     DPTR,#E11X
  2517.         ;
  2518. FPTS:   JMP     ERROR
  2519.         ;
  2520.         newpage
  2521.         ;***************************************************************
  2522.         ;
  2523.         ; The Command action routine - LIST
  2524.         ;
  2525.         ;***************************************************************
  2526.         ;
  2527. CLIST:  CALL    NUMC            ;SEE IF TO LINE PORT
  2528.         ACALL   FSTK            ;PUT 0FFFFH ON THE STACK
  2529.         CALL    INTGER          ;SEE IF USER SUPPLIES LN
  2530.         CLR     A               ;LN = 0 TO START
  2531.         MOV     R3,A
  2532.         MOV     R1,A
  2533.         JC      CL1             ;START FROM ZERO
  2534.         ;
  2535.         CALL    TEMPD           ;SAVE THE START ADDTESS
  2536.         CALL    GCI             ;GET THE CHARACTER AFTER LIST
  2537.         CJNE    A,#T_SUB,$+10   ;CHECK FOR TERMINATION ADDRESS '-'
  2538.         ACALL   INC_ASTKA       ;WASTE 0FFFFH
  2539.         LCALL   INTERR          ;GET TERMINATION ADDRESS
  2540.         ACALL   TWO_EY          ;PUT TERMINATION ON THE ARG STACK
  2541.         MOV     R3,TEMP5        ;GET THE START ADDTESS
  2542.         MOV     R1,TEMP4
  2543.         ;
  2544. CL1:    CALL    GETLIN          ;GET THE LINE NO IN R3:R1
  2545.         JZ      CL3             ;RET IF AT END
  2546.         ;
  2547. CL2:    ACALL   C3C             ;SAVE THE ADDRESS
  2548.         INC     DPTR            ;POINT TO LINE NUMBER
  2549.         ACALL   PMTOP+3         ;PUT LINE NUMBER ON THE STACK
  2550.         ACALL   CMPLK           ;COMPARE LN TO END ADDRESS
  2551.         JC      CL3             ;EXIT IF GREATER
  2552.         CALL    BCK             ;CHECK FOR A CONTROL C
  2553.         ACALL   DEC_ASTKA       ;SAVE THE COMPARE ADDRESS
  2554.         CALL    DP_T            ;RESTORE ADDRESS
  2555.         ACALL   UPPL            ;UN-PROCESS THE LINE
  2556.         ACALL   C3C             ;SAVE THE CR ADDRESS
  2557.         ACALL   CL6             ;PRINT IT
  2558.         INC     DPTR            ;BUMP POINTER TO NEXT LINE
  2559.         MOVX    A,@DPTR         ;GET LIN LENGTH
  2560.         DJNZ    ACC,CL2         ;LOOP
  2561.         ACALL   INC_ASTKA       ;WASTE THE COMPARE BYTE
  2562.         ;
  2563. CL3:    AJMP    CMND1           ;BACK TO COMMAND PROCESSOR
  2564.         ;
  2565. CL6:    MOV     DPTR,#IBUF      ;PRINT IBUF
  2566.         CALL    PRNTCR          ;PRINT IT
  2567.         CALL    DP_T
  2568.         ;
  2569. CL7:    JMP     CRLF
  2570.         ;
  2571.         LCALL   X31DP
  2572.         newpage
  2573.         ;***************************************************************
  2574.         ;
  2575.         ;UPPL - UN PREPROCESS A LINE ADDRESSED BY DPTR INTO IBUF
  2576.         ;       RETURN SOURCE ADDRESS OF CR IN DPTR ON RETURN
  2577.         ;
  2578.         ;***************************************************************
  2579.         ;
  2580. UPPL:   MOV     R3,#HI(IBUF)    ;POINT R3 AT HIGH IBUF
  2581.         MOV     R1,#LO(IBUF)    ;POINT R1 AT IBUF
  2582.         INC     DPTR            ;SKIP OVER LINE LENGTH
  2583.         ACALL   C3C             ;SAVE THE DPTR (DP_T)
  2584.         CALL    L20DPI          ;PUT LINE NUMBER IN R2:R0
  2585.         CALL    FP_BASE+16      ;CONVERT R2:R0 TO INTEGER
  2586.         CALL    DP_T
  2587.         INC     DPTR            ;BUMP DPTR PAST THE LINE NUMBER
  2588.         ;
  2589. UPP0:   CJNE    R1,#LO(IBUF+6),$+3
  2590.         JC      UPP1A-4         ;PUT SPACES IN TEXT
  2591.         INC     DPTR            ;BUMP PAST LN HIGH
  2592.         MOVX    A,@DPTR         ;GET USER TEXT
  2593.         MOV     R6,A            ;SAVE A IN R6 FOR TOKE COMPARE
  2594.         JB      ACC.7,UPP1      ;IF TOKEN, PROCESS
  2595.         CJNE    A,#20H,$+3      ;TRAP THE USER TOKENS
  2596.         JNC     $+5
  2597.         CJNE    A,#CR,UPP1      ;DO IT IF NOT A CR
  2598.         CJNE    A,#'"',UPP9     ;SEE IF STRING
  2599.         ACALL   UPP7            ;SAVE IT
  2600.         ACALL   UPP8            ;GET THE NEXT CHARACTER AND SAVE IT
  2601.         CJNE    A,#'"',$-2      ;LOOP ON QUOTES
  2602.         SJMP    UPP0
  2603.         ;
  2604. UPP9:   CJNE    A,#':',UPP1A    ;PUT A SPACE IN DELIMITER
  2605.         ACALL   UPP7A
  2606.         MOV     A,R6
  2607.         ACALL   UPP7
  2608.         ACALL   UPP7A
  2609.         SJMP    UPP0
  2610.         ;
  2611. UPP1A:  ACALL   UPP8+2          ;SAVE THE CHARACTER, UPDATE POINTER
  2612.         SJMP    UPP0            ;EXIT IF A CR, ELSE LOOP
  2613.         ;
  2614. UPP1:   ACALL   C3C             ;SAVE THE TEXT POINTER
  2615.         MOV     C,XBIT
  2616.         MOV     F0,C            ;SAVE XBIT IN F0
  2617.         MOV     DPTR,#TOKTAB    ;POINT AT TOKEN TABLE
  2618.         JNB     F0,UPP2
  2619.         LCALL   2078H           ;SET UP DPTR FOR LOOKUP
  2620.         ;
  2621. UPP2:   CLR     A               ;ZERO A FOR LOOKUP
  2622.         MOVC    A,@A+DPTR       ;GET TOKEN
  2623.         INC     DPTR            ;ADVANCE THE TOKEN POINTER
  2624.         CJNE    A,#0FFH,UP_2    ;SEE IF DONE
  2625.         JBC     F0,UPP2-9       ;NOW DO NORMAL TABLE
  2626.         AJMP    CMND1           ;EXIT IF NOT FOUND
  2627.         ;
  2628. UP_2:   CJNE    A,R6B0,UPP2     ;LOOP UNTIL THE SAME
  2629.         ;
  2630. UP_3:   CJNE    A,#T_UOP,$+3
  2631.         JNC     UPP3
  2632.         ACALL   UPP7A           ;PRINT THE SPACE IF OK
  2633.         ;
  2634. UPP3:   CLR     A               ;DO LOOKUP
  2635.         MOVC    A,@A+DPTR
  2636.         JB      ACC.7,UPP4      ;EXIT IF DONE, ELSE SAVE
  2637.         JZ      UPP4            ;DONE IF ZERO
  2638.         ACALL   UPP7            ;SAVE THE CHARACTER
  2639.         INC     DPTR
  2640.         SJMP    UPP3            ;LOOP
  2641.         ;
  2642. UPP4:   CALL    DP_T            ;GET IT BACK
  2643.         MOV     A,R6            ;SEE IF A REM TOKEN
  2644.         XRL     A,#T_REM
  2645.         JNZ     $+6
  2646.         ACALL   UPP8
  2647.         SJMP    $-2
  2648.         JNC     UPP0            ;START OVER AGAIN IF NO TOKEN
  2649.         ACALL   UPP7A           ;PRINT THE SPACE IF OK
  2650.         SJMP    UPP0            ;DONE
  2651.         ;
  2652. UPP7A:  MOV     A,#' '          ;OUTPUT A SPACE
  2653.         ;
  2654. UPP7:   AJMP    PPL9+1          ;SAVE A
  2655.         ;
  2656. UPP8:   INC     DPTR
  2657.         MOVX    A,@DPTR
  2658.         CJNE    A,#CR,UPP7
  2659.         AJMP    PPL7+1
  2660.         ;
  2661.         newpage
  2662.         ;**************************************************************
  2663.         ;
  2664.         ; This table contains all of the floating point constants
  2665.         ;
  2666.         ; The constants in ROM are stored "backwards" from the way
  2667.         ; basic normally treats floating point numbers. Instead of
  2668.         ; loading from the exponent and decrementing the pointer,
  2669.         ; ROM constants pointers load from the most significant
  2670.         ; digits and increment the pointers. This is done to 1) make
  2671.         ; arg stack loading faster and 2) compensate for the fact that
  2672.         ; no decrement data pointer instruction exsist.
  2673.         ;
  2674.         ; The numbers are stored as follows:
  2675.         ;
  2676.         ; BYTE X+5    = MOST SIGNIFICANT DIGITS IN BCD
  2677.         ; BYTE X+4    = NEXT MOST SIGNIFICANT DIGITS IN BCD
  2678.         ; BYTE X+3    = NEXT LEAST SIGNIFICANT DIGITS IN BCD
  2679.         ; BYTE X+2    = LEAST SIGNIFICANT DIGITS IN BCD
  2680.         ; BYTE X+1    = SIGN OF THE ABOVE MANTISSA 0 = +, 1 = -
  2681.         ; BYTE X      = EXPONENT IN TWO'S COMPLEMENT BINARY
  2682.         ;               ZERO EXPONENT = THE NUMBER ZERO
  2683.         ;
  2684.         ;**************************************************************
  2685.         ;
  2686. ATTAB:  DB      128-2           ; ARCTAN LOOKUP
  2687.         DB      00H
  2688.         DB      57H
  2689.         DB      22H
  2690.         DB      66H
  2691.         DB      28H
  2692.         ;
  2693.         DB      128-1
  2694.         DB      01H
  2695.         DB      37H
  2696.         DB      57H
  2697.         DB      16H
  2698.         DB      16H
  2699.         ;
  2700.         DB      128-1
  2701.         DB      00H
  2702.         DB      14H
  2703.         DB      96H
  2704.         DB      90H
  2705.         DB      42H
  2706.         ;
  2707.         DB      128-1
  2708.         DB      01H
  2709.         DB      40H
  2710.         DB      96H
  2711.         DB      28H
  2712.         DB      75H
  2713.         ;
  2714.         DB      128
  2715.         DB      00H
  2716.         DB      64H
  2717.         DB      62H
  2718.         DB      65H
  2719.         DB      10H
  2720.         ;
  2721.         DB      128
  2722.         DB      01H
  2723.         DB      99H
  2724.         DB      88H
  2725.         DB      20H
  2726.         DB      14H
  2727.         ;
  2728.         DB      128
  2729.         DB      00H
  2730.         DB      51H
  2731.         DB      35H
  2732.         DB      99H
  2733.         DB      19H
  2734.         ;
  2735.         DB      128
  2736.         DB      01H
  2737.         DB      45H
  2738.         DB      31H
  2739.         DB      33H
  2740.         DB      33H
  2741.         ;
  2742.         DB      129
  2743.         DB      00H
  2744.         DB      00H
  2745.         DB      00H
  2746.         DB      00H
  2747.         DB      10H
  2748.         ;
  2749.         DB      0FFH            ;END OF TABLE
  2750.         ;
  2751. NTWO:   DB      129
  2752.         DB      0
  2753.         DB      0
  2754.         DB      0
  2755.         DB      0
  2756.         DB      20H
  2757.         ;
  2758. TTIME:  DB      128-4           ; CLOCK CALCULATION
  2759.         DB      00H
  2760.         DB      00H
  2761.         DB      00H
  2762.         DB      04H
  2763.         DB      13H
  2764.         ;
  2765.         newpage
  2766.         ;***************************************************************
  2767.         ;
  2768.         ; COSINE - Add pi/2 to stack, then fall thru to SIN
  2769.         ;
  2770.         ;***************************************************************
  2771.         ;
  2772. ACOS:   ACALL   POTWO           ;PUT PI/2 ON THE STACK
  2773.         ACALL   AADD            ;TOS = TOS+PI/2
  2774.         ;
  2775.         ;***************************************************************
  2776.         ;
  2777.         ; SINE - use taylor series to calculate sin function
  2778.         ;
  2779.         ;***************************************************************
  2780.         ;
  2781. ASIN:   ACALL   PIPI            ;PUT PI ON THE STACK
  2782.         ACALL   RV              ;REDUCE THE VALUE
  2783.         MOV     A,MT2           ;CALCULATE THE SIGN
  2784.         ANL     A,#01H          ;SAVE LSB
  2785.         XRL     MT1,A           ;SAVE SIGN IN MT1
  2786.         ACALL   CSTAKA          ;NOW CONVERT TO ONE QUADRANT
  2787.         ACALL   POTWO
  2788.         ACALL   CMPLK           ;DO COMPARE
  2789.         JC      $+6
  2790.         ACALL   PIPI
  2791.         ACALL   ASUB
  2792.         ACALL   AABS
  2793.         MOV     DPTR,#SINTAB    ;SET UP LOOKUP TABLE
  2794.         ACALL   POLYC           ;CALCULATE THE POLY
  2795.         ACALL   STRIP
  2796.         AJMP    SIN0
  2797.         ;
  2798.         ; Put PI/2 on the stack
  2799.         ;
  2800. POTWO:  ACALL   PIPI            ;PUT PI ON THE STACK, NOW DIVIDE
  2801.         ;
  2802. DBTWO:  MOV     DPTR,#NTWO
  2803.         ACALL   PUSHC
  2804.         ;MOV    A,#2            ;BY TWO
  2805.         ;ACALL  TWO_R2
  2806.         AJMP    ADIV
  2807.         ;
  2808.         newpage
  2809.         ;*************************************************************
  2810.         ;
  2811. POLYC:  ; Expand a power series to calculate a polynomial
  2812.         ;
  2813.         ;*************************************************************
  2814.         ;
  2815.         ACALL   CSTAKA2         ;COPY THE STACK
  2816.         ACALL   AMUL            ;SQUARE THE STACK
  2817.         ACALL   POP_T1          ;SAVE X*X
  2818.         ACALL   PUSHC           ;PUT CONSTANT ON STACK
  2819.         ;
  2820. POLY1:  ACALL   PUSH_T1         ;PUT COMPUTED VALUE ON STACK
  2821.         ACALL   AMUL            ;MULTIPLY CONSTANT AND COMPUTED VALUE
  2822.         ACALL   PUSHC           ;PUT NEXT CONSTANT ON STACK
  2823.         ACALL   AADD            ;ADD IT TO THE OLD VALUE
  2824.         CLR     A               ;CHECK TO SEE IF DONE
  2825.         MOVC    A,@A+DPTR
  2826.         CJNE    A,#0FFH,POLY1   ;LOOP UNTIL DONE
  2827.         ;
  2828. AMUL:   LCALL   FP_BASE+6
  2829.         AJMP    FPTST
  2830.         ;
  2831.         ;*************************************************************
  2832.         ;
  2833. RV:     ; Reduce a value for Trig and A**X functions
  2834.         ;
  2835.         ; value = (value/x - INT(value/x)) * x
  2836.         ;
  2837.         ;*************************************************************
  2838.         ;
  2839.         ACALL   C_T2            ;COPY TOS TO T2
  2840.         ACALL   ADIV            ;TOS = TOS/TEMP2
  2841.         ACALL   AABS            ;MAKE THE TOS A POSITIVE NUMBER
  2842.         MOV     MT1,A           ;SAVE THE SIGN
  2843.         ACALL   CSTAKA2         ;COPY THE STACK TWICE
  2844.         ACALL   IFIX            ;PUT THE NUMBER IN R3:R1
  2845.         PUSH    R3B0            ;SAVE R3
  2846.         MOV     MT2,R1          ;SAVE THE LS BYTE IN MT2
  2847.         ACALL   AINT            ;MAKE THE TOS AN INTEGER
  2848.         ACALL   ASUB            ;TOS = TOS/T2 - INT(TOS/T2)
  2849.         ACALL   P_T2            ;TOS = T2
  2850.         ACALL   AMUL            ;TOS = T2*(TOS/T2 - INT(TOS/T2)
  2851.         POP     R3B0            ;RESTORE R3
  2852.         RET                     ;EXIT
  2853.         ;
  2854.         newpage
  2855.         ;**************************************************************
  2856.         ;
  2857.         ; TAN
  2858.         ;
  2859.         ;**************************************************************
  2860.         ;
  2861. ATAN:   ACALL   CSTAKA          ;DUPLACATE STACK
  2862.         ACALL   ASIN            ;TOS = SIN(X)
  2863.         ACALL   SWAP_ASTKA      ;TOS = X
  2864.         ACALL   ACOS            ;TOS = COS(X)
  2865.         AJMP    ADIV            ;TOS = SIN(X)/COS(X)
  2866.         ;
  2867. STRIP:  ACALL   SETREG          ;SETUP R0
  2868.         MOV     R3,#1           ;LOOP COUNT
  2869.         AJMP    AI2-1           ;WASTE THE LSB
  2870.         ;
  2871.         ;************************************************************
  2872.         ;
  2873.         ; ARC TAN
  2874.         ;
  2875.         ;************************************************************
  2876.         ;
  2877. AATAN:  ACALL   AABS
  2878.         MOV     MT1,A           ;SAVE THE SIGN
  2879.         ACALL   SETREG          ;GET THE EXPONENT
  2880.         ADD     A,#7FH          ;BIAS THE EXPONENT
  2881.         MOV     UBIT,C          ;SAVE CARRY STATUS
  2882.         JNC     $+4             ;SEE IF > 1
  2883.         ACALL   RECIP           ;IF > 1, TAKE RECIP
  2884.         MOV     DPTR,#ATTAB     ;SET UP TO CALCULATE THE POLY
  2885.         ACALL   POLYC           ;CALCULATE THE POLY
  2886.         JNB     UBIT,SIN0       ;JUMP IF NOT SET
  2887.         ACALL   ANEG            ;MAKE X POLY NEGATIVE
  2888.         ACALL   POTWO           ;SUBTRACT PI/2
  2889.         ACALL   AADD
  2890.         ;
  2891. SIN0:   MOV     A,MT1           ;GET THE SIGN
  2892.         JZ      SRT
  2893.         AJMP    ANEG
  2894.         ;
  2895.         newpage
  2896.         ;*************************************************************
  2897.         ;
  2898.         ; FCOMP - COMPARE 0FFFFH TO TOS
  2899.         ;
  2900.         ;*************************************************************
  2901.         ;
  2902. FCMP:   ACALL   CSTAKA          ;COPY THE STACK
  2903.         ACALL   FSTK            ;MAKE THE TOS = 0FFFFH
  2904.         ACALL   SWAP_ASTKA      ;NOW COMPARE IS 0FFFFH - X
  2905.         ;
  2906. CMPLK:  JMP     FP_BASE+4       ;DO THE COMPARE
  2907.         ;
  2908.         ;*************************************************************
  2909.         ;
  2910. DEC_ASTKA:      ;Push ARG STACK and check for underflow
  2911.         ;
  2912.         ;*************************************************************
  2913.         ;
  2914.         MOV     A,#-FPSIZ
  2915.         ADD     A,ASTKA
  2916.         CJNE    A,#LO(TM_TOP+6),$+3
  2917.         JC      E4YY
  2918.         MOV     ASTKA,A
  2919.         MOV     R1,A
  2920.         MOV     R3,#ASTKAH
  2921.         ;
  2922. SRT:    RET
  2923.         ;
  2924. E4YY:   MOV     DPTR,#EXA
  2925.         AJMP    FPTS            ;ARG STACK ERROR
  2926.         ;
  2927.         ;
  2928. AXTAL3: ACALL   PUSHC           ;PUSH CONSTANT, THEN MULTIPLY
  2929.         ACALL   AMUL
  2930.         ;
  2931.         ; Fall thru to IFIX
  2932.         ;
  2933.         newpage
  2934.         ;***************************************************************
  2935.         ;
  2936. IFIX:   ; Convert a floating point number to an integer, put in R3:R1
  2937.         ;
  2938.         ;***************************************************************
  2939.         ;
  2940.         CLR     A               ;RESET THE START
  2941.         MOV     R3,A
  2942.         MOV     R1,A
  2943.         MOV     R0,ASTKA        ;GET THE ARG STACK
  2944.         MOV     P2,#ASTKAH
  2945.         MOVX    A,@R0           ;READ EXPONENT
  2946.         CLR     C
  2947.         SUBB    A,#81H          ;BASE EXPONENT
  2948.         MOV     R4,A            ;SAVE IT
  2949.         DEC     R0              ;POINT AT SIGN
  2950.         MOVX    A,@R0           ;GET THE SIGN
  2951.         JNZ     SQ_ERR          ;ERROR IF NEGATIVE
  2952.         JC      INC_ASTKA       ;EXIT IF EXPONENT IS < 81H
  2953.         INC     R4              ;ADJUST LOOP COUNTER
  2954.         MOV     A,R0            ;BUMP THE POINTER REGISTER
  2955.         SUBB    A,#FPSIZ-1
  2956.         MOV     R0,A
  2957.         ;
  2958. I2:     INC     R0              ;POINT AT DIGIT
  2959.         MOVX    A,@R0           ;GET DIGIT
  2960.         SWAP    A               ;FLIP
  2961.         CALL    FP_BASE+20      ;ACCUMULATE
  2962.         JC      SQ_ERR
  2963.         DJNZ    R4,$+4
  2964.         SJMP    INC_ASTKA
  2965.         MOVX    A,@R0           ;GET DIGIT
  2966.         CALL    FP_BASE+20
  2967.         JC      SQ_ERR
  2968.         DJNZ    R4,I2
  2969.         ;
  2970.         newpage
  2971.         ;************************************************************
  2972.         ;
  2973. INC_ASTKA:      ; Pop the ARG STACK and check for overflow
  2974.         ;
  2975.         ;************************************************************
  2976.         ;
  2977.         MOV     A,#FPSIZ        ;NUMBER TO POP
  2978.         SJMP    SETREG+1
  2979.         ;
  2980. SETREG: CLR     A               ;DON'T POP ANYTHING
  2981.         MOV     R0,ASTKA
  2982.         MOV     R2,#ASTKAH
  2983.         MOV     P2,R2
  2984.         ADD     A,R0
  2985.         JC      E4YY
  2986.         MOV     ASTKA,A
  2987.         MOVX    A,@R0
  2988. A_D:    RET
  2989.         ;
  2990.         ;************************************************************
  2991.         ;
  2992.         ; EBIAS - Bias a number for E to the X calculations
  2993.         ;
  2994.         ;************************************************************
  2995.         ;
  2996. EBIAS:  ACALL   PUSH_ONE
  2997.         ACALL   RV
  2998.         CJNE    R3,#00H,SQ_ERR  ;ERROR IF R3 <> 0
  2999.         ACALL   C_T2            ;TEMP 2 GETS FRACTIONS
  3000.         ACALL   INC_ASTKA
  3001.         ACALL   POP_T1
  3002.         ACALL   PUSH_ONE
  3003.         ;
  3004. AELP:   MOV     A,MT2
  3005.         JNZ     AEL1
  3006.         ;
  3007.         MOV     A,MT1
  3008.         JZ      A_D
  3009.         MOV     DPTR,#FPT2-1
  3010.         MOVX    @DPTR,A         ;MAKE THE FRACTIONS NEGATIVE
  3011.         ;
  3012. RECIP:  ACALL   PUSH_ONE
  3013.         ACALL   SWAP_ASTKA
  3014.         AJMP    ADIV
  3015.         ;
  3016. AEL1:   DEC     MT2
  3017.         ACALL   PUSH_T1
  3018.         ACALL   AMUL
  3019.         SJMP    AELP
  3020.         ;
  3021. SQ_ERR: LJMP    E3XX            ;LINK TO BAD ARG
  3022.         ;
  3023.         newpage
  3024.         ;************************************************************
  3025.         ;
  3026.         ; SQUARE ROOT
  3027.         ;
  3028.         ;************************************************************
  3029.         ;
  3030. ASQR:   ACALL   AABS            ;GET THE SIGN
  3031.         JNZ     SQ_ERR          ;ERROR IF NEGATIVE
  3032.         ACALL   C_T2            ;COPY VARIABLE TO T2
  3033.         ACALL   POP_T1          ;SAVE IT IN T1
  3034.         MOV     R0,#LO(FPT1)
  3035.         MOVX    A,@R0           ;GET EXPONENT
  3036.         JZ      ALN-2           ;EXIT IF ZERO
  3037.         ADD     A,#128          ;BIAS THE EXPONENT
  3038.         JNC     SQR1            ;SEE IF < 80H
  3039.         RR      A
  3040.         ANL     A,#127
  3041.         SJMP    SQR2
  3042.         ;
  3043. SQR1:   CPL     A               ;FLIP BITS
  3044.         INC     A
  3045.         RR      A
  3046.         ANL     A,#127          ;STRIP MSB
  3047.         CPL     A
  3048.         INC     A
  3049.         ;
  3050. SQR2:   ADD     A,#128          ;BIAS EXPONENT
  3051.         MOVX    @R0,A           ;SAVE IT
  3052.         ;
  3053.         ; NEWGUESS = ( X/OLDGUESS + OLDGUESS) / 2
  3054.         ;
  3055. SQR4:   ACALL   P_T2            ;TOS = X
  3056.         ACALL   PUSH_T1         ;PUT NUMBER ON STACK
  3057.         ACALL   ADIV            ;TOS = X/GUESS
  3058.         ACALL   PUSH_T1         ;PUT ON AGAIN
  3059.         ACALL   AADD            ;TOS = X/GUESS + GUESS
  3060.         ACALL   DBTWO           ;TOS = ( X/GUESS + GUESS ) / 2
  3061.         ACALL   TEMP_COMP       ;SEE IF DONE
  3062.         JNB     F0,SQR4
  3063.         ;
  3064.         AJMP    PUSH_T1         ;PUT THE ANSWER ON THE STACK
  3065.         ;
  3066.         newpage
  3067.         ;*************************************************************
  3068.         ;
  3069.         ; NATURAL LOG
  3070.         ;
  3071.         ;*************************************************************
  3072.         ;
  3073. ALN:    ACALL   AABS            ;MAKE SURE THAT NUM IS POSITIVE
  3074.         JNZ     SQ_ERR          ;ERROR IF NOT
  3075.         MOV     MT2,A           ;CLEAR FOR LOOP
  3076.         INC     R0              ;POINT AT EXPONENT
  3077.         MOVX    A,@R0           ;READ THE EXPONENT
  3078.         JZ      SQ_ERR          ;ERROR IF EXPONENT IS ZERO
  3079.         CJNE    A,#81H,$+3      ;SEE IF NUM >= 1
  3080.         MOV     UBIT,C          ;SAVE CARRY STATUS
  3081.         JC      $+4             ;TAKE RECIP IF >= 1
  3082.         ACALL   RECIP
  3083.         ;
  3084.         ; Loop to reduce
  3085.         ;
  3086. ALNL:   ACALL   CSTAKA          ;COPY THE STACK FOR COMPARE
  3087.         ACALL   PUSH_ONE        ;COMPARE NUM TO ONE
  3088.         ACALL   CMPLK
  3089.         JNC     ALNO            ;EXIT IF DONE
  3090.         ACALL   SETREG          ;GET THE EXPONENT
  3091.         ADD     A,#85H          ;SEE HOW BIG IT IS
  3092.         JNC     ALN11           ;BUMP BY EXP(11) IF TOO SMALL
  3093.         ACALL   PLNEXP          ;PUT EXP(1) ON STACK
  3094.         MOV     A,#1            ;BUMP COUNT
  3095.         ;
  3096. ALNE:   ADD     A,MT2
  3097.         JC      SQ_ERR
  3098.         MOV     MT2,A
  3099.         ACALL   AMUL            ;BIAS THE NUMBER
  3100.         SJMP    ALNL
  3101.         ;
  3102. ALN11:  MOV     DPTR,#EXP11     ;PUT EXP(11) ON STACK
  3103.         ACALL   PUSHC
  3104.         MOV     A,#11
  3105.         SJMP    ALNE
  3106.         ;
  3107.         newpage
  3108. ALNO:   ACALL   C_T2            ;PUT NUM IN TEMP 2
  3109.         ACALL   PUSH_ONE        ;TOS = 1
  3110.         ACALL   ASUB            ;TOS = X - 1
  3111.         ACALL   P_T2            ;TOS = X
  3112.         ACALL   PUSH_ONE        ;TOS = 1
  3113.         ACALL   AADD            ;TOS = X + 1
  3114.         ACALL   ADIV            ;TOS = (X-1)/(X+1)
  3115.         MOV     DPTR,#LNTAB     ;LOG TABLE
  3116.         ACALL   POLYC
  3117.         INC     DPTR            ;POINT AT LN(10)
  3118.         ACALL   PUSHC
  3119.         ACALL   AMUL
  3120.         MOV     A,MT2           ;GET THE COUNT
  3121.         ACALL   TWO_R2          ;PUT IT ON THE STACK
  3122.         ACALL   ASUB            ;INT - POLY
  3123.         ACALL   STRIP
  3124.         JNB     UBIT,AABS
  3125.         ;
  3126. LN_D:   RET
  3127.         ;
  3128.         ;*************************************************************
  3129.         ;
  3130. TEMP_COMP:      ; Compare FPTEMP1 to TOS, FPTEMP1 gets TOS
  3131.         ;
  3132.         ;*************************************************************
  3133.         ;
  3134.         ACALL   PUSH_T1         ;SAVE THE TEMP
  3135.         ACALL   SWAP_ASTKA      ;TRADE WITH THE NEXT NUMBER
  3136.         ACALL   CSTAKA          ;COPY THE STACK
  3137.         ACALL   POP_T1          ;SAVE THE NEW NUMBER
  3138.         JMP     FP_BASE+4       ;DO THE COMPARE
  3139.         ;
  3140.         newpage
  3141. AETOX:  ACALL   PLNEXP          ;EXP(1) ON TOS
  3142.         ACALL   SWAP_ASTKA      ;X ON TOS
  3143.         ;
  3144. AEXP:   ;EXPONENTIATION
  3145.         ;
  3146.         ACALL   EBIAS           ;T1=BASE,T2=FRACTIONS,TOS=INT MULTIPLIED
  3147.         MOV     DPTR,#FPT2      ;POINT AT FRACTIONS
  3148.         MOVX    A,@DPTR         ;READ THE EXP OF THE FRACTIONS
  3149.         JZ      LN_D            ;EXIT IF ZERO
  3150.         ACALL   P_T2            ;TOS = FRACTIONS
  3151.         ACALL   PUSH_T1         ;TOS = BASE
  3152.         ACALL   SETREG          ;SEE IF BASE IS ZERO
  3153.         JZ      $+4
  3154.         ACALL   ALN             ;TOS = LN(BASE)
  3155.         ACALL   AMUL            ;TOS = FRACTIONS * LN(BASE)
  3156.         ACALL   PLNEXP          ;TOS = EXP(1)
  3157.         ACALL   SWAP_ASTKA      ;TOS = FRACTIONS * LN(BASE)
  3158.         ACALL   EBIAS           ;T2 = FRACTIONS, TOS = INT MULTIPLIED
  3159.         MOV     MT2,#00H        ;NOW CALCULATE E**X
  3160.         ACALL   PUSH_ONE
  3161.         ACALL   CSTAKA
  3162.         ACALL   POP_T1          ;T1 = 1
  3163.         ;
  3164. AEXL:   ACALL   P_T2            ;TOS = FRACTIONS
  3165.         ACALL   AMUL            ;TOS = FRACTIONS * ACCUMLATION
  3166.         INC     MT2             ;DO THE DEMONIATOR
  3167.         MOV     A,MT2
  3168.         ACALL   TWO_R2
  3169.         ACALL   ADIV
  3170.         ACALL   CSTAKA          ;SAVE THE ITERATION
  3171.         ACALL   PUSH_T1         ;NOW ACCUMLATE
  3172.         ACALL   AADD            ;ADD ACCUMLATION
  3173.         ACALL   TEMP_COMP
  3174.         JNB     F0,AEXL         ;LOOP UNTIL DONE
  3175.         ;
  3176.         ACALL   INC_ASTKA
  3177.         ACALL   PUSH_T1
  3178.         ACALL   AMUL            ;LAST INT MULTIPLIED
  3179.         ;
  3180. MU1:    AJMP    AMUL            ;FIRST INT MULTIPLIED
  3181.         ;
  3182.         newpage
  3183.         ;***************************************************************
  3184.         ;
  3185.         ; integer operator - INT
  3186.         ;
  3187.         ;***************************************************************
  3188.         ;
  3189. AINT:   ACALL   SETREG          ;SET UP THE REGISTERS, CLEAR CARRY
  3190.         SUBB    A,#129          ;SUBTRACT EXPONENT BIAS
  3191.         JNC     AI1             ;JUMP IF ACC > 81H
  3192.         ;
  3193.         ; Force the number to be a zero
  3194.         ;
  3195.         ACALL   INC_ASTKA       ;BUMP THE STACK
  3196.         ;
  3197. P_Z:    MOV     DPTR,#ZRO       ;PUT ZERO ON THE STACK
  3198.         AJMP    PUSHC
  3199.         ;
  3200. AI1:    SUBB    A,#7
  3201.         JNC     AI3
  3202.         CPL     A
  3203.         INC     A
  3204.         MOV     R3,A
  3205.         DEC     R0              ;POINT AT SIGN
  3206.         ;
  3207. AI2:    DEC     R0              ;NOW AT LSB'S
  3208.         MOVX    A,@R0           ;READ BYTE
  3209.         ANL     A,#0F0H         ;STRIP NIBBLE
  3210.         MOVX    @R0,A           ;WRITE BYTE
  3211.         DJNZ    R3,$+3
  3212.         RET
  3213.         CLR     A
  3214.         MOVX    @R0,A           ;CLEAR THE LOCATION
  3215.         DJNZ    R3,AI2
  3216.         ;
  3217. AI3:    RET                     ;EXIT
  3218.         ;
  3219.         newpage
  3220.         ;***************************************************************
  3221.         ;
  3222. AABS:   ; Absolute value - Make sign of number positive
  3223.         ;                  return sign in ACC
  3224.         ;
  3225.         ;***************************************************************
  3226.         ;
  3227.         ACALL   ANEG            ;CHECK TO SEE IF + OR -
  3228.         JNZ     ALPAR           ;EXIT IF NON ZERO, BECAUSE THE NUM IS
  3229.         MOVX    @R0,A           ;MAKE A POSITIVE SIGN
  3230.         RET
  3231.         ;
  3232.         ;***************************************************************
  3233.         ;
  3234. ASGN:   ; Returns the sign of the number 1 = +, -1 = -
  3235.         ;
  3236.         ;***************************************************************
  3237.         ;
  3238.         ACALL   INC_ASTKA       ;POP STACK, GET EXPONENT
  3239.         JZ      P_Z             ;EXIT IF ZERO
  3240.         DEC     R0              ;BUMP TO SIGN
  3241.         MOVX    A,@R0           ;GET THE SIGN
  3242.         MOV     R7,A            ;SAVE THE SIGN
  3243.         ACALL   PUSH_ONE        ;PUT A ONE ON THE STACK
  3244.         MOV     A,R7            ;GET THE SIGN
  3245.         JZ      ALPAR           ;EXIT IF ZERO
  3246.         ;
  3247.         ; Fall thru to ANEG
  3248.         ;
  3249.         ;***************************************************************
  3250.         ;
  3251. ANEG:   ; Flip the sign of the number on the tos
  3252.         ;
  3253.         ;***************************************************************
  3254.         ;
  3255.         ACALL   SETREG
  3256.         DEC     R0              ;POINT AT THE SIGN OF THE NUMBER
  3257.         JZ      ALPAR           ;EXIT IF ZERO
  3258.         MOVX    A,@R0
  3259.         XRL     A,#01H          ;FLIP THE SIGN
  3260.         MOVX    @R0,A
  3261.         XRL     A,#01H          ;RESTORE THE SIGN
  3262.         ;
  3263. ALPAR:  RET
  3264.         ;
  3265.         newpage
  3266.         ;***************************************************************
  3267.         ;
  3268. ACBYTE: ; Read the ROM
  3269.         ;
  3270.         ;***************************************************************
  3271.         ;
  3272.         ACALL   IFIX            ;GET EXPRESSION
  3273.         CALL    X31DP           ;PUT R3:R1 INTO THE DP
  3274.         CLR     A
  3275.         MOVC    A,@A+DPTR
  3276.         AJMP    TWO_R2
  3277.         ;
  3278.         ;***************************************************************
  3279.         ;
  3280. ADBYTE: ; Read internal memory
  3281.         ;
  3282.         ;***************************************************************
  3283.         ;
  3284.         ACALL   IFIX            ;GET THE EXPRESSION
  3285.         CALL    R3CK            ;MAKE SURE R3 = 0
  3286.         MOV     A,@R1
  3287.         AJMP    TWO_R2
  3288.         ;
  3289.         ;***************************************************************
  3290.         ;
  3291. AXBYTE: ; Read external memory
  3292.         ;
  3293.         ;***************************************************************
  3294.         ;
  3295.         ACALL   IFIX            ;GET THE EXPRESSION
  3296.         MOV     P2,R3
  3297.         MOVX    A,@R1
  3298.         AJMP    TWO_R2
  3299.         ;
  3300.         newpage
  3301.         ;***************************************************************
  3302.         ;
  3303.         ; The relational operators - EQUAL                        (=)
  3304.         ;                            GREATER THAN                 (>)
  3305.         ;                            LESS THAN                    (<)
  3306.         ;                            GREATER THAN OR EQUAL        (>=)
  3307.         ;                            LESS THAN OR EQUAL           (<=)
  3308.         ;                            NOT EQUAL                    (<>)
  3309.         ;
  3310.         ;***************************************************************
  3311.         ;
  3312. AGT:    ACALL   CMPLK
  3313.         ORL     C,F0            ;SEE IF EITHER IS A ONE
  3314.         JC      P_Z
  3315.         ;
  3316. FSTK:   MOV     DPTR,#FS
  3317.         AJMP    PUSHC
  3318.         ;
  3319. FS:     DB      85H
  3320.         DB      00H
  3321.         DB      00H
  3322.         DB      50H
  3323.         DB      53H
  3324.         DB      65H
  3325.         ;
  3326. ALT:    ACALL   CMPLK
  3327.         CPL     C
  3328.         SJMP    AGT+4
  3329.         ;
  3330. AEQ:    ACALL   CMPLK
  3331.         MOV     C,F0
  3332.         SJMP    ALT+2
  3333.         ;
  3334. ANE:    ACALL   CMPLK
  3335.         CPL     F0
  3336.         SJMP    AEQ+2
  3337.         ;
  3338. AGE:    ACALL   CMPLK
  3339.         SJMP    AGT+4
  3340.         ;
  3341. ALE:    ACALL   CMPLK
  3342.         ORL     C,F0
  3343.         SJMP    ALT+2
  3344.         ;
  3345.         newpage
  3346.         ;***************************************************************
  3347.         ;
  3348. ARND:   ; Generate a random number
  3349.         ;
  3350.         ;***************************************************************
  3351.         ;
  3352.         MOV     DPTR,#RCELL     ;GET THE BINARY SEED
  3353.         CALL    L31DPI
  3354.         MOV     A,R1
  3355.         CLR     C
  3356.         RRC     A
  3357.         MOV     R0,A
  3358.         MOV     A,#6
  3359.         RRC     A
  3360.         ADD     A,R1
  3361.         XCH     A,R0
  3362.         ADDC    A,R3
  3363.         MOV     R2,A
  3364.         DEC     DPL             ;SAVE THE NEW SEED
  3365.         ACALL   S20DP
  3366.         ACALL   TWO_EY
  3367.         ACALL   FSTK
  3368.         ;
  3369. ADIV:   LCALL   FP_BASE+8
  3370.         AJMP    FPTST
  3371.         ;
  3372.         newpage
  3373.         ;***************************************************************
  3374.         ;
  3375. SONERR: ; ON ERROR Statement
  3376.         ;
  3377.         ;***************************************************************
  3378.         ;
  3379.         LCALL   INTERR          ;GET THE LINE NUMBER
  3380.         SETB    ON_ERR
  3381.         MOV     DPTR,#ERRNUM    ;POINT AT THR ERROR LOCATION
  3382.         SJMP    S20DP
  3383.         ;
  3384.         ;
  3385.         ;**************************************************************
  3386.         ;
  3387. SONEXT: ; ON EXT1 Statement
  3388.         ;
  3389.         ;**************************************************************
  3390.         ;
  3391.         LCALL   INTERR
  3392.         SETB    INTBIT
  3393.         ORL     IE,#10000100B   ;ENABLE INTERRUPTS
  3394.         MOV     DPTR,#INTLOC
  3395.         ;
  3396. S20DP:  MOV     A,R2            ;SAVE R2:R0 @DPTR
  3397.         MOVX    @DPTR,A
  3398.         INC     DPTR
  3399.         MOV     A,R0
  3400.         MOVX    @DPTR,A
  3401.         RET
  3402.         ;
  3403.         newpage
  3404.         ;***************************************************************
  3405.         ;
  3406.         ; CASTAK - Copy and push another top of arg stack
  3407.         ;
  3408.         ;***************************************************************
  3409.         ;
  3410. CSTAKA2:ACALL   CSTAKA          ;COPY STACK TWICE
  3411.         ;
  3412. CSTAKA: ACALL   SETREG          ;SET UP R2:R0
  3413.         SJMP    PUSH_T1+4
  3414.         ;
  3415. PLNEXP: MOV     DPTR,#EXP1
  3416.         ;
  3417.         ;***************************************************************
  3418.         ;
  3419.         ; PUSHC - Push constant on to the arg stack
  3420.         ;
  3421.         ;***************************************************************
  3422.         ;
  3423. PUSHC:  ACALL   DEC_ASTKA
  3424.         MOV     P2,R3
  3425.         MOV     R3,#FPSIZ       ;LOOP COUNTER
  3426.         ;
  3427. PCL:    CLR     A               ;SET UP A
  3428.         MOVC    A,@A+DPTR       ;LOAD IT
  3429.         MOVX    @R1,A           ;SAVE IT
  3430.         INC     DPTR            ;BUMP POINTERS
  3431.         DEC     R1
  3432.         DJNZ    R3,PCL          ;LOOP
  3433.         ;
  3434.         SETB    ARGF
  3435.         RET                     ;EXIT
  3436.         ;
  3437. PUSH_ONE:;
  3438.         ;
  3439.         MOV     DPTR,#FPONE
  3440.         AJMP    PUSHC
  3441.         ;
  3442.         newpage
  3443.         ;
  3444. POP_T1:
  3445.         ;
  3446.         MOV     R3,#HI(FPT1)
  3447.         MOV     R1,#LO(FPT1)
  3448.         JMP     POPAS
  3449.         ;
  3450. PUSH_T1:
  3451.         ;
  3452.         MOV     R0,#LO(FPT1)
  3453.         MOV     R2,#HI(FPT1)
  3454.         LJMP    PUSHAS
  3455.         ;
  3456. P_T2:   MOV     R0,#LO(FPT2)
  3457.         SJMP    $-7                     ;JUMP TO PUSHAS
  3458.         ;
  3459.         ;****************************************************************
  3460.         ;
  3461. SWAP_ASTKA:     ; SWAP TOS<>TOS-1
  3462.         ;
  3463.         ;****************************************************************
  3464.         ;
  3465.         ACALL   SETREG          ;SET UP R2:R0 AND P2
  3466.         MOV     A,#FPSIZ        ;PUT TOS+1 IN R1
  3467.         MOV     R2,A
  3468.         ADD     A,R0
  3469.         MOV     R1,A
  3470.         ;
  3471. S_L:    MOVX    A,@R0
  3472.         MOV     R3,A
  3473.         MOVX    A,@R1
  3474.         MOVX    @R0,A
  3475.         MOV     A,R3
  3476.         MOVX    @R1,A
  3477.         DEC     R1
  3478.         DEC     R0
  3479.         DJNZ    R2,S_L
  3480.         RET
  3481.         ;
  3482.         newpage
  3483.         ;
  3484. C_T2:   ACALL   SETREG          ;SET UP R2:R0
  3485.         MOV     R3,#HI(FPT2)
  3486.         MOV     R1,#LO(FPT2)    ;TEMP VALUE
  3487.         ;
  3488.         ; Fall thru
  3489.         ;
  3490.         ;***************************************************************
  3491.         ;
  3492.         ; VARCOP - Copy a variable from R2:R0 to R3:R1
  3493.         ;
  3494.         ;***************************************************************
  3495.         ;
  3496. VARCOP: MOV     R4,#FPSIZ       ;LOAD THE LOOP COUNTER
  3497.         ;
  3498. V_C:    MOV     P2,R2           ;SET UP THE PORTS
  3499.         MOVX    A,@R0           ;READ THE VALUE
  3500.         MOV     P2,R3           ;PORT TIME AGAIN
  3501.         MOVX    @R1,A           ;SAVE IT
  3502.         ACALL   DEC3210         ;BUMP POINTERS
  3503.         DJNZ    R4,V_C          ;LOOP
  3504.         RET                     ;EXIT
  3505.         ;
  3506. PIPI:   MOV     DPTR,#PIE
  3507.         AJMP    PUSHC
  3508.         ;
  3509.         newpage
  3510.         ;***************************************************************
  3511.         ;
  3512.         ; The logical operators ANL, ORL, XRL, NOT
  3513.         ;
  3514.         ;***************************************************************
  3515.         ;
  3516. AANL:   ACALL   TWOL            ;GET THE EXPRESSIONS
  3517.         MOV     A,R3            ;DO THE AND
  3518.         ANL     A,R7
  3519.         MOV     R2,A
  3520.         MOV     A,R1
  3521.         ANL     A,R6
  3522.         SJMP    TWO_EX
  3523.         ;
  3524. AORL:   ACALL   TWOL            ;SAME THING FOR OR
  3525.         MOV     A,R3
  3526.         ORL     A,R7
  3527.         MOV     R2,A
  3528.         MOV     A,R1
  3529.         ORL     A,R6
  3530.         SJMP    TWO_EX
  3531.         ;
  3532. ANOT:   ACALL   FSTK            ;PUT 0FFFFH ON THE STACK
  3533.         ;
  3534. AXRL:   ACALL   TWOL
  3535.         MOV     A,R3
  3536.         XRL     A,R7
  3537.         MOV     R2,A
  3538.         MOV     A,R1
  3539.         XRL     A,R6
  3540.         SJMP    TWO_EX
  3541.         ;
  3542. TWOL:   ACALL   IFIX
  3543.         MOV     R7,R3B0
  3544.         MOV     R6,R1B0
  3545.         AJMP    IFIX
  3546.         ;
  3547.         newpage
  3548.         ;*************************************************************
  3549.         ;
  3550. AGET:   ; READ THE BREAK BYTE AND PUT IT ON THE ARG STACK
  3551.         ;
  3552.         ;*************************************************************
  3553.         ;
  3554.         MOV     DPTR,#GTB       ;GET THE BREAK BYTE
  3555.         MOVX    A,@DPTR
  3556.         JBC     GTRD,TWO_R2
  3557.         CLR     A
  3558.         ;
  3559. TWO_R2: MOV     R2,#00H         ;ACC GOES TO STACK
  3560.         ;
  3561.         ;
  3562. TWO_EX: MOV     R0,A            ;R2:ACC GOES TO STACK
  3563.         ;
  3564.         ;
  3565. TWO_EY: SETB    ARGF            ;R2:R0 GETS PUT ON THE STACK
  3566.         JMP     FP_BASE+24      ;DO IT
  3567.         ;
  3568.         newpage
  3569.         ;*************************************************************
  3570.         ;
  3571.         ; Put directs onto the stack
  3572.         ;
  3573.         ;**************************************************************
  3574.         ;
  3575. A_IE:   MOV     A,IE            ;IE
  3576.         SJMP    TWO_R2
  3577.         ;
  3578. A_IP:   MOV     A,IP            ;IP
  3579.         SJMP    TWO_R2
  3580.         ;
  3581. ATIM0:  MOV     R2,TH0          ;TIMER 0
  3582.         MOV     R0,TL0
  3583.         SJMP    TWO_EY
  3584.         ;
  3585. ATIM1:  MOV     R2,TH1          ;TIMER 1
  3586.         MOV     R0,TL1
  3587.         SJMP    TWO_EY
  3588.         ;
  3589. ATIM2:  DB      0AAH            ;MOV R2 DIRECT OP CODE
  3590.         DB      0CDH            ;T2 HIGH
  3591.         DB      0A8H            ;MOV R0 DIRECT OP CODE
  3592.         DB      0CCH            ;T2 LOW
  3593.         SJMP    TWO_EY          ;TIMER 2
  3594.         ;
  3595. AT2CON: DB      0E5H            ;MOV A,DIRECT OPCODE
  3596.         DB      0C8H            ;T2CON LOCATION
  3597.         SJMP    TWO_R2
  3598.         ;
  3599. ATCON:  MOV     A,TCON          ;TCON
  3600.         SJMP    TWO_R2
  3601.         ;
  3602. ATMOD:  MOV     A,TMOD          ;TMOD
  3603.         SJMP    TWO_R2
  3604.         ;
  3605. ARCAP2: DB      0AAH            ;MOV R2, DIRECT OP CODE
  3606.         DB      0CBH            ;RCAP2H LOCATION
  3607.         DB      0A8H            ;MOV R0, DIRECT OP CODE
  3608.         DB      0CAH            ;R2CAPL LOCATION
  3609.         SJMP    TWO_EY
  3610.         ;
  3611. AP1:    MOV     A,P1            ;GET P1
  3612.         SJMP    TWO_R2          ;PUT IT ON THE STACK
  3613.         ;
  3614. APCON:  DB      0E5H            ;MOV A, DIRECT OP CODE
  3615.         DB      87H             ;ADDRESS OF PCON
  3616.         SJMP    TWO_R2          ;PUT PCON ON THE STACK
  3617.         ;
  3618.         newpage
  3619.         ;***************************************************************
  3620.         ;
  3621.         ;THIS IS THE LINE EDITOR
  3622.         ;
  3623.         ;TAKE THE PROCESSED LINE IN IBUF AND INSERT IT INTO THE
  3624.         ;BASIC TEXT FILE.
  3625.         ;
  3626.         ;***************************************************************
  3627.         ;
  3628.         LJMP    NOGO            ;CAN'T EDIT A ROM
  3629.         ;
  3630. LINE:   MOV     A,BOFAH
  3631.         CJNE    A,#HI(PSTART),LINE-3
  3632.         CALL    G4              ;GET END ADDRESS FOR EDITING
  3633.         MOV     R4,DPL
  3634.         MOV     R5,DPH
  3635.         MOV     R3,TEMP5        ;GET HIGH ORDER IBLN
  3636.         MOV     R1,TEMP4        ;LOW ORDER IBLN
  3637.         ;
  3638.         CALL    GETLIN          ;FIND THE LINE
  3639.         JNZ     INSR            ;INSERT IF NOT ZERO, ELSE APPEND
  3640.         ;
  3641.         ;APPEND THE LINE AT THE END
  3642.         ;
  3643.         MOV     A,TEMP3         ;PUT IBCNT IN THE ACC
  3644.         CJNE    A,#4H,$+4       ;SEE IF NO ENTRY
  3645.         RET                     ;RET IF NO ENTRY
  3646.         ;
  3647.         ACALL   FULL            ;SEE IF ENOUGH SPACE LEFT
  3648.         MOV     R2,R5B0         ;PUT END ADDRESS A INTO TRANSFER
  3649.         MOV     R0,R4B0         ;REGISTERS
  3650.         ACALL   IMOV            ;DO THE BLOCK MOVE
  3651.         ;
  3652. UE:     MOV     A,#EOF          ;SAVE EOF CHARACTER
  3653.         AJMP    TBR
  3654.         ;
  3655.         ;INSERT A LINE INTO THE FILE
  3656.         ;
  3657. INSR:   MOV     R7,A            ;SAVE IT IN R7
  3658.         CALL    TEMPD           ;SAVE INSERATION ADDRESS
  3659.         MOV     A,TEMP3         ;PUT THE COUNT LENGTH IN THE ACC
  3660.         JC      LTX             ;JUMP IF NEW LINE # NOT = OLD LINE #
  3661.         CJNE    A,#04H,$+4      ;SEE IF NULL
  3662.         CLR     A
  3663.         ;
  3664.         SUBB    A,R7            ;SUBTRACT LINE COUNT FROM ACC
  3665.         JZ      LIN1            ;LINE LENGTHS EQUAL
  3666.         JC      GTX             ;SMALLER LINE
  3667.         ;
  3668.         newpage
  3669.         ;
  3670.         ;EXPAND FOR A NEW LINE OR A LARGER LINE
  3671.         ;
  3672. LTX:    MOV     R7,A            ;SAVE A IN R7
  3673.         MOV     A,TEMP3         ;GET THE COUNT IN THE ACC
  3674.         CJNE    A,#04H,$+4      ;DO NO INSERTATION IF NULL LINE
  3675.         RET                     ;EXIT IF IT IS
  3676.         ;
  3677.         MOV     A,R7            ;GET THE COUNT BACK - DELTA IN A
  3678.         ACALL   FULL            ;SEE IF ENOUGH MEMORY NEW EOFA IN R3:R1
  3679.         CALL    DTEMP           ;GET INSERATION ADDRESS
  3680.         ACALL   NMOV            ;R7:R6 GETS (EOFA)-DPTR
  3681.         CALL    X3120
  3682.         MOV     R1,R4B0         ;EOFA LOW
  3683.         MOV     R3,R5B0         ;EOFA HIGH
  3684.         INC     R6              ;INCREMENT BYTE COUNT
  3685.         CJNE    R6,#00,$+4      ;NEED TO BUMP HIGH BYTE?
  3686.         INC     R7
  3687.         ;
  3688.         ACALL   RMOV            ;GO DO THE INSERTION
  3689.         SJMP    LIN1            ;INSERT THE CURRENT LINE
  3690.         ;
  3691. GTX:    CPL     A               ;FLIP ACC
  3692.         INC     A               ;TWOS COMPLEMENT
  3693.         CALL    ADDPTR          ;DO THE ADDITION
  3694.         ACALL   NMOV            ;R7:R6 GETS (EOFA)-DPTR
  3695.         MOV     R1,DPL          ;SET UP THE REGISTERS
  3696.         MOV     R3,DPH
  3697.         MOV     R2,TEMP5        ;PUT INSERTATION ADDRESS IN THE RIGHT REG
  3698.         MOV     R0,TEMP4
  3699.         JZ      $+4             ;IF ACC WAS ZERO FROM NMOV, JUMP
  3700.         ACALL   LMOV            ;IF NO ZERO DO A LMOV
  3701.         ;
  3702.         ACALL   UE              ;SAVE NEW END ADDRESS
  3703.         ;
  3704. LIN1:   MOV     R2,TEMP5        ;GET THE INSERTATION ADDRESS
  3705.         MOV     R0,TEMP4
  3706.         MOV     A,TEMP3         ;PUT THE COUNT LENGTH IN ACC
  3707.         CJNE    A,#04H,IMOV     ;SEE IF NULL
  3708.         RET                     ;EXIT IF NULL
  3709.         newpage
  3710.         ;***************************************************************
  3711.         ;
  3712.         ;INSERT A LINE AT ADDRESS R2:R0
  3713.         ;
  3714.         ;***************************************************************
  3715.         ;
  3716. IMOV:   CLR     A               ;TO SET UP
  3717.         MOV     R1,#LO(IBCNT)   ;INITIALIZE THE REGISTERS
  3718.         MOV     R3,A
  3719.         MOV     R6,TEMP3        ;PUT THE BYTE COUNT IN R6 FOR LMOV
  3720.         MOV     R7,A            ;PUT A 0 IN R7 FOR LMOV
  3721.         ;
  3722.         ;***************************************************************
  3723.         ;
  3724.         ;COPY A BLOCK FROM THE BEGINNING
  3725.         ;
  3726.         ;R2:R0 IS THE DESTINATION ADDRESS
  3727.         ;R3:R1 IS THE SOURCE ADDRESS
  3728.         ;R7:R6 IS THE COUNT REGISTER
  3729.         ;
  3730.         ;***************************************************************
  3731.         ;
  3732. LMOV:   ACALL   TBYTE           ;TRANSFER THE BYTE
  3733.         ACALL   INC3210         ;BUMP THE POINTER
  3734.         ACALL   DEC76           ;BUMP R7:R6
  3735.         JNZ     LMOV            ;LOOP
  3736.         RET                     ;GO BACK TO CALLING ROUTINE
  3737.         ;
  3738. INC3210:INC     R0
  3739.         CJNE    R0,#00H,$+4
  3740.         INC     R2
  3741.         ;
  3742.         INC     R1
  3743.         CJNE    R1,#00H,$+4
  3744.         INC     R3
  3745.         RET
  3746.         ;
  3747.         newpage
  3748.         ;***************************************************************
  3749.         ;
  3750.         ;COPY A BLOCK STARTING AT THE END
  3751.         ;
  3752.         ;R2:R0 IS THE DESTINATION ADDRESS
  3753.         ;R3:R1 IS THE SOURCE ADDRESS
  3754.         ;R6:R7 IS THE COUNT REGISTER
  3755.         ;
  3756.         ;***************************************************************
  3757.         ;
  3758. RMOV:   ACALL   TBYTE           ;TRANSFER THE BYTE
  3759.         ACALL   DEC3210         ;DEC THE LOCATIONS
  3760.         ACALL   DEC76           ;BUMP THE COUNTER
  3761.         JNZ     RMOV            ;LOOP
  3762.         ;
  3763. DEC_R:  NOP                     ;CREATE EQUAL TIMING
  3764.         RET                     ;EXIT
  3765.         ;
  3766. DEC3210:DEC     R0              ;BUMP THE POINTER
  3767.         CJNE    R0,#0FFH,$+4    ;SEE IF OVERFLOWED
  3768.         DEC     R2              ;BUMP THE HIGH BYTE
  3769.         DEC     R1              ;BUMP THE POINTER
  3770.         CJNE    R1,#0FFH,DEC_R  ;SEE IF OVERFLOWED
  3771.         DEC     R3              ;CHANGE THE HIGH BYTE
  3772.         RET                     ;EXIT
  3773.         ;
  3774.         ;***************************************************************
  3775.         ;
  3776.         ;TBYTE - TRANSFER A BYTE
  3777.         ;
  3778.         ;***************************************************************
  3779.         ;
  3780. TBYTE:  MOV     P2,R3           ;OUTPUT SOURCE REGISTER TO PORT
  3781.         MOVX    A,@R1           ;PUT BYTE IN ACC
  3782.         ;
  3783. TBR:    MOV     P2,R2           ;OUTPUT DESTINATION TO PORT
  3784.         MOVX    @R0,A           ;SAVE THE BYTE
  3785.         RET                     ;EXIT
  3786.         ;
  3787.         newpage
  3788.         ;***************************************************************
  3789.         ;
  3790.         ;NMOV - R7:R6 = END ADDRESS - DPTR
  3791.         ;
  3792.         ;ACC GETS CLOBBERED
  3793.         ;
  3794.         ;***************************************************************
  3795.         ;
  3796. NMOV:   MOV     A,R4            ;THE LOW BYTE OF EOFA
  3797.         CLR     C               ;CLEAR THE CARRY FOR SUBB
  3798.         SUBB    A,DPL           ;SUBTRACT DATA POINTER LOW
  3799.         MOV     R6,A            ;PUT RESULT IN R6
  3800.         MOV     A,R5            ;HIGH BYTE OF EOFA
  3801.         SUBB    A,DPH           ;SUBTRACT DATA POINTER HIGH
  3802.         MOV     R7,A            ;PUT RESULT IN R7
  3803.         ORL     A,R6            ;SEE IF ZERO
  3804.         RET                     ;EXIT
  3805.         ;
  3806.         ;***************************************************************
  3807.         ;
  3808.         ;CHECK FOR A FILE OVERFLOW
  3809.         ;LEAVES THE NEW END ADDRESS IN R3:R1
  3810.         ;A HAS THE INCREASE IN SIZE
  3811.         ;
  3812.         ;***************************************************************
  3813.         ;
  3814. FULL:   ADD     A,R4            ;ADD A TO END ADDRESS
  3815.         MOV     R1,A            ;SAVE IT
  3816.         CLR     A
  3817.         ADDC    A,R5            ;ADD THE CARRY
  3818.         MOV     R3,A
  3819.         MOV     DPTR,#VARTOP    ;POINT AT VARTOP
  3820.         ;
  3821. FUL1:   CALL    DCMPX           ;COMPARE THE TWO
  3822.         JC      FULL-1          ;OUT OF ROOM
  3823.         ;
  3824. TB:     MOV     DPTR,#E5X       ;OUT OF MEMORY
  3825.         AJMP    FPTS
  3826.         ;
  3827.         newpage
  3828.         ;***************************************************************
  3829.         ;
  3830.         ; PP - Preprocesses the line in IBUF back into IBUF
  3831.         ;      sets F0 if no line number
  3832.         ;      leaves the correct length of processed line in IBCNT
  3833.         ;      puts the line number in IBLN
  3834.         ;      wastes the text address TXAL and TXAH
  3835.         ;
  3836.         ;***************************************************************
  3837.         ;
  3838. PP:     ACALL   T_BUF           ;TXA GETS IBUF
  3839.         CALL    INTGER          ;SEE IF A NUMBER PRESENT
  3840.         CALL    TEMPD           ;SAVE THE INTEGER IN TEMP5:TEMP4
  3841.         MOV     F0,C            ;SAVE INTEGER IF PRESENT
  3842.         MOV     DPTR,#IBLN      ;SAVE THE LINE NUMBER, EVEN IF NONE
  3843.         ACALL   S20DP
  3844.         MOV     R0,TXAL         ;TEXT POINTER
  3845.         MOV     R1,#LO(IBUF)    ;STORE POINTER
  3846.         ;
  3847.         ; Now process the line back into IBUF
  3848.         ;
  3849. PPL:    CLR     ARGF            ;FIRST PASS DESIGNATOR
  3850.         MOV     DPTR,#TOKTAB    ;POINT DPTR AT LOOK UP TABLE
  3851.         ;
  3852. PPL1:   MOV     R5B0,R0         ;SAVE THE READ POINTER
  3853.         CLR     A               ;ZERO A FOR LOOKUP
  3854.         MOVC    A,@A+DPTR       ;GET THE TOKEN
  3855.         MOV     R7,A            ;SAVE TOKEN IN CASE OF MATCH
  3856.         ;
  3857. PPL2:   MOVX    A,@R0           ;GET THE USER CHARACTER
  3858.         MOV     R3,A            ;SAVE FOR REM
  3859.         CJNE    A,#'a',$+3
  3860.         JC      PPX             ;CONVERT LOWER TO UPPER CASE
  3861.         CJNE    A,#('z'+1),$+3
  3862.         JNC     PPX
  3863.         CLR     ACC.5
  3864.         ;
  3865. PPX:    MOV     R2,A
  3866.         MOVX    @R0,A           ;SAVE UPPER CASE
  3867.         INC     DPTR            ;BUMP THE LOOKUP POINTER
  3868.         CLR     A
  3869.         MOVC    A,@A+DPTR
  3870.         CJNE    A,R2B0,PPL3     ;LEAVE IF NOT THE SAME
  3871.         INC     R0              ;BUMP THE USER POINTER
  3872.         SJMP    PPL2            ;CONTINUE TO LOOP
  3873.         ;
  3874. PPL3:   JB      ACC.7,PPL6      ;JUMP IF FOUND MATCH
  3875.         JZ      PPL6            ;USER MATCH
  3876.         ;
  3877.         ;
  3878.         ; Scan to the next TOKTAB entry
  3879.         ;
  3880. PPL4:   INC     DPTR            ;ADVANCE THE POINTER
  3881.         CLR     A               ;ZERO A FOR LOOKUP
  3882.         MOVC    A,@A+DPTR       ;LOAD A WITH TABLE
  3883.         JB      ACC.7,$+6       ;KEEP SCANNING IF NOT A RESERVED WORD
  3884.         JNZ     PPL4
  3885.         INC     DPTR
  3886.         ;
  3887.         ; See if at the end of TOKTAB
  3888.         ;
  3889.         MOV     R0,R5B0         ;RESTORE THE POINTER
  3890.         CJNE    A,#0FFH,PPL1    ;SEE IF END OF TABLE
  3891.         ;
  3892.         ; Character not in TOKTAB, so see what it is
  3893.         ;
  3894.         CJNE    R2,#' ',PPLX    ;SEE IF A SPACE
  3895.         INC     R0              ;BUMP USER POINTER
  3896.         SJMP    PPL             ;TRY AGAIN
  3897.         ;
  3898. PPLX:   JNB     XBIT,PPLY       ;EXTERNAL TRAP
  3899.         JB      ARGF,PPLY
  3900.         SETB    ARGF            ;SAYS THAT THE USER HAS TABLE
  3901.         LCALL   2078H           ;SET UP POINTER
  3902.         AJMP    PPL1
  3903.         ;
  3904. PPLY:   ACALL   PPL7            ;SAVE CHARACTER, EXIT IF A CR
  3905.         CJNE    A,#'"',PPL      ;SEE IF QUOTED STRING, START AGAIN IF NOT
  3906.         ;
  3907.         ; Just copy a quoted string
  3908.         ;
  3909.         ACALL   PPL7            ;SAVE THE CHARACTER, TEST FOR CR
  3910.         CJNE    A,#'"',$-2      ;IS THERE AN ENDQUOTE, IF NOT LOOP
  3911.         SJMP    PPL             ;DO IT AGAIN IF ENDQUOTE
  3912.         ;
  3913. PPL6:   MOV     A,R7            ;GET THE TOKEN
  3914.         ACALL   PPL9+1          ;SAVE THE TOKEN
  3915.         CJNE    A,#T_REM,PPL    ;SEE IF A REM TOKEN
  3916.         MOV     A,R3
  3917.         ACALL   PPL7+1          ;WASTE THE REM STATEMENT
  3918.         ACALL   PPL7            ;LOOP UNTIL A CR
  3919.         SJMP    $-2
  3920.         ;
  3921. PPL7:   MOVX    A,@R0           ;GET THE CHARACTER
  3922.         CJNE    A,#CR,PPL9      ;FINISH IF A CR
  3923.         POP     R0B0            ;WASTE THE CALLING STACK
  3924.         POP     R0B0
  3925.         MOVX    @R1,A           ;SAVE CR IN MEMORY
  3926.         INC     R1              ;SAVE A TERMINATOR
  3927.         MOV     A,#EOF
  3928.         MOVX    @R1,A
  3929.         MOV     A,R1            ;SUBTRACT FOR LENGTH
  3930.         SUBB    A,#4
  3931.         MOV     TEMP3,A         ;SAVE LENGTH
  3932.         MOV     R1,#LO(IBCNT)   ;POINT AT BUFFER COUNT
  3933.         ;
  3934. PPL9:   INC     R0
  3935.         MOVX    @R1,A           ;SAVE THE CHARACTER
  3936.         INC     R1              ;BUMP THE POINTERS
  3937.         RET                     ;EXIT TO CALLING ROUTINE
  3938.         ;
  3939.         ;
  3940.         ;***************************************************************
  3941.         ;
  3942.         ;DEC76 - DECREMENT THE REGISTER PAIR R7:R6
  3943.         ;
  3944.         ;ACC = ZERO IF R7:R6 = ZERO ; ELSE ACC DOES NOT
  3945.         ;
  3946.         ;***************************************************************
  3947.         ;
  3948. DEC76:  DEC     R6              ;BUMP R6
  3949.         CJNE    R6,#0FFH,$+4    ;SEE IF RAPPED AROUND
  3950.         DEC     R7
  3951.         MOV     A,R7            ;SEE IF ZERO
  3952.         ORL     A,R6
  3953.         RET                     ;EXIT
  3954.         ;
  3955.         ;***************************************************************
  3956.         ;
  3957.         ; MTOP - Get or Put the top of assigned memory
  3958.         ;
  3959.         ;***************************************************************
  3960.         ;
  3961. PMTOP:  MOV     DPTR,#MEMTOP
  3962.         CALL    L20DPI
  3963.         AJMP    TWO_EY          ;PUT R2:R0 ON THE STACK
  3964.         ;
  3965.         newpage
  3966.         ;*************************************************************
  3967.         ;
  3968.         ; AXTAL - Crystal value calculations
  3969.         ;
  3970.         ;*************************************************************
  3971.         ;
  3972. AXTAL0: MOV     DPTR,#XTALV     ;CRYSTAL VALUE
  3973.         ACALL   PUSHC
  3974.         ;
  3975. AXTAL1: ACALL   CSTAKA2         ;COPY CRYSTAL VALUE TWICE
  3976.         ACALL   CSTAKA
  3977.         MOV     DPTR,#PTIME     ;PROM TIMER
  3978.         ACALL   AXTAL2
  3979.         MOV     DPTR,#PROGS
  3980.         ACALL   S31L
  3981.         MOV     DPTR,#IPTIME    ;IPROM TIMER
  3982.         ACALL   AXTAL2
  3983.         MOV     DPTR,#IPROGS
  3984.         ACALL   S31L
  3985.         MOV     DPTR,#TTIME     ;CLOCK CALCULATION
  3986.         ACALL   AXTAL3
  3987.         MOV     A,R1
  3988.         CPL     A
  3989.         INC     A
  3990.         MOV     SAVE_T,A
  3991.         MOV     R3,#HI(CXTAL)
  3992.         MOV     R1,#LO(CXTAL)
  3993.         JMP     POPAS
  3994.         ;
  3995. AXTAL2: ACALL   AXTAL3
  3996.         ;
  3997. CBIAS:  ;Bias the crystal calculations
  3998.         ;
  3999.         MOV     A,R1            ;GET THE LOW COUNT
  4000.         CPL     A               ;FLIP IT FOR TIMER LOAD
  4001.         ADD     A,#15           ;BIAS FOR CALL AND LOAD TIMES
  4002.         MOV     R1,A            ;RESTORE IT
  4003.         MOV     A,R3            ;GET THE HIGH COUNT
  4004.         CPL     A               ;FLIP IT
  4005.         ADDC    A,#00H          ;ADD THE CARRY
  4006.         MOV     R3,A            ;RESTORE IT
  4007.         RET
  4008.         ;
  4009.         newpage
  4010.         include bas52.pwm       ; ******AA
  4011.         newpage
  4012.         ;LNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLN
  4013.         ;
  4014. LNTAB:  ; Natural log lookup table
  4015.         ;
  4016.         ;LNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLN
  4017.         ;
  4018.         DB      80H
  4019.         DB      00H
  4020.         DB      71H
  4021.         DB      37H
  4022.         DB      13H
  4023.         DB      19H
  4024.         ;
  4025.         DB      7FH
  4026.         DB      00H
  4027.         DB      76H
  4028.         DB      64H
  4029.         DB      37H
  4030.         DB      94H
  4031.         ;
  4032.         DB      80H
  4033.         DB      00H
  4034.         DB      07H
  4035.         DB      22H
  4036.         DB      75H
  4037.         DB      17H
  4038.         ;
  4039.         DB      80H
  4040.         DB      00H
  4041.         DB      52H
  4042.         DB      35H
  4043.         DB      93H
  4044.         DB      28H
  4045.         ;
  4046.         DB      80H
  4047.         DB      00H
  4048.         DB      71H
  4049.         DB      91H
  4050.         DB      85H
  4051.         DB      86H
  4052.         ;
  4053.         DB      0FFH
  4054.         ;
  4055.         DB      81H
  4056.         DB      00H
  4057.         DB      51H
  4058.         DB      58H
  4059.         DB      02H
  4060.         DB      23H
  4061.         ;
  4062.         newpage
  4063.         ;SINSINSINSINSINSINSINSINSINSINSINSINSINSINSINSINSIN
  4064.         ;
  4065. SINTAB: ; Sin lookup table
  4066.         ;
  4067.         ;SINSINSINSINSINSINSINSINSINSINSINSINSINSINSINSINSIN
  4068.         ;
  4069.         DB      128-9
  4070.         DB      00H
  4071.         DB      44H
  4072.         DB      90H
  4073.         DB      05H
  4074.         DB      16H
  4075.         ;
  4076.         DB      128-7
  4077.         DB      01H
  4078.         DB      08H
  4079.         DB      21H
  4080.         DB      05H
  4081.         DB      25H
  4082.         ;
  4083.         DB      128-5
  4084.         DB      00H
  4085.         DB      19H
  4086.         DB      73H
  4087.         DB      55H
  4088.         DB      27H
  4089.         ;
  4090.         newpage
  4091.         ;
  4092.         DB      128-3
  4093.         DB      01H
  4094.         DB      70H
  4095.         DB      12H
  4096.         DB      84H
  4097.         DB      19H
  4098.         ;
  4099.         DB      128-2
  4100.         DB      00H
  4101.         DB      33H
  4102.         DB      33H
  4103.         DB      33H
  4104.         DB      83H
  4105.         ;
  4106.         DB      128
  4107.         DB      01H
  4108.         DB      67H
  4109.         DB      66H
  4110.         DB      66H
  4111.         DB      16H
  4112.         ;
  4113. FPONE:  DB      128+1
  4114.         DB      00H
  4115.         DB      00H
  4116.         DB      00H
  4117.         DB      00H
  4118.         DB      10H
  4119.         ;
  4120.         DB      0FFH            ;END OF TABLE
  4121.         ;
  4122.         newpage
  4123.         ;
  4124. SBAUD:  CALL    AXTAL           ;PUT CRYSTAL ON THE STACK
  4125.         CALL    EXPRB           ;PUT THE NUMBER AFTER BAUD ON STACK
  4126.         MOV     A,#12
  4127.         ACALL   TWO_R2          ;TOS = 12
  4128.         ACALL   AMUL            ;TOS = 12*BAUD
  4129.         ACALL   ADIV            ;TOS = XTAL/(12*BAUD)
  4130.         ACALL   IFIX
  4131.         ACALL   CBIAS
  4132.         MOV     DPTR,#SPV
  4133.         ;
  4134. S31L:   JMP     S31DP
  4135.         ;
  4136. AFREE:  CALL    PMTOP           ;PUT MTOP ON STACK
  4137.         CALL    G4              ;GET END ADDRESS
  4138.         MOV     R0,DPL
  4139.         MOV     R2,DPH
  4140.         ACALL   TWO_EY
  4141.         ;
  4142. ASUB:   LCALL   FP_BASE+2       ;DO FP SUB
  4143.         AJMP    FPTST
  4144.         ;
  4145. ALEN:   CALL    CCAL            ;CALCULATE THE LEN OF THE SELECTED PROGRAM
  4146.         MOV     R2,R7B0         ;SAVE THE HIGH BYTE
  4147.         MOV     A,R6            ;SAVE THE LOW BYTE
  4148.         AJMP    TWO_EX          ;PUT IT ON THE STACK
  4149.         ;
  4150. ATIME:  MOV     C,EA            ;SAVE INTERRUTS
  4151.         CLR     EA
  4152.         PUSH    MILLIV          ;SAVE MILLI VALUE
  4153.         MOV     R2,TVH          ;GET THE TIMER
  4154.         MOV     A,TVL
  4155.         MOV     EA,C            ;SAVE INTERRUPTS
  4156.         ACALL   TWO_EX          ;PUT TIMER ON THE STACK
  4157.         POP     ACC             ;GET MILLI
  4158.         ACALL   TWO_R2          ;PUT MILLI ON STACK
  4159.         MOV     A,#200
  4160.         ACALL   TWO_R2          ;DIVIDE MILLI BY 200
  4161.         ACALL   ADIV
  4162.         ;
  4163. AADD:   LCALL   FP_BASE         ;DO FP ADDITION
  4164.         AJMP    FPTST           ;CHECK FOR ERRORS
  4165.         ;
  4166.         newpage
  4167.         ;**************************************************************
  4168.         ;
  4169.         ; Here are some error messages that were moved
  4170.         ;
  4171.         ;**************************************************************
  4172.         ;
  4173.         ;
  4174. E1X:    DB      "BAD SYNTAX",'"'
  4175. E2X:    DB      128+10
  4176.         DB      "DIVIDE BY ZERO",'"'
  4177.         ;
  4178. E6X:    DB      "ARRAY SIZE",'"'
  4179.         ;
  4180.         newpage
  4181.         ;**************************************************************
  4182.         ;
  4183. T_BUF:  ; TXA gets IBUF
  4184.         ;
  4185.         ;**************************************************************
  4186.         ;
  4187.         MOV     TXAH,#HI(IBUF)
  4188.         MOV     TXAL,#LO(IBUF)
  4189.         RET
  4190.         ;
  4191.         ;
  4192.         ;***************************************************************
  4193.         ;
  4194. CXFER:  ; Transfer a program from rom to ram
  4195.         ;
  4196.         ;***************************************************************
  4197.         ;
  4198.         CALL    CCAL            ;GET EVERYTHING SET UP
  4199.         MOV     R2,#HI(PSTART)
  4200.         MOV     R0,#LO(PSTART)
  4201.         ACALL   LMOV            ;DO THE TRANSFER
  4202.         CALL    RCLEAR          ;CLEAR THE MEMORY
  4203.         ;
  4204.         ; Fall thru to CRAM
  4205.         ;
  4206.         ;***************************************************************
  4207.         ;
  4208. CRAM:   ; The command action routine - RAM - Run out of ram
  4209.         ;
  4210.         ;***************************************************************
  4211.         ;
  4212.         CLR     CONB            ;CAN'T CONTINUE IF MODE CHANGE
  4213.         MOV     BOFAH,#HI(PSTART)
  4214.         MOV     BOFAL,#LO(PSTART)
  4215.         ;
  4216.         ; Fall thru to Command Processor
  4217.         ;
  4218.         newpage
  4219.         ;***************************************************************
  4220.         ;
  4221. CMND1:  ; The entry point for the command processor
  4222.         ;
  4223.         ;***************************************************************
  4224.         ;
  4225.         LCALL   SPRINT+4        ;WASTE AT AND HEX
  4226.         CLR     XBIT            ;TO RESET IF NEEDED
  4227.         CLR     A
  4228.         MOV     DPTR,#2002H     ;CHECK FOR EXTERNAL TRAP PACKAGE
  4229.         MOVC    A,@A+DPTR
  4230.         CJNE    A,#5AH,$+6
  4231.         LCALL   2048H           ;IF PRESENT JUMP TO LOCATION 200BH
  4232.         MOV     DPTR,#RDYS      ;PRINT THE READY MESSAGE
  4233.         CALL    CRP             ;DO A CR, THEN, PRINT FROM THE ROM
  4234.         ;
  4235. CMNDR:  SETB    DIRF            ;SET THE DIRECT INPUT BIT
  4236.         MOV     SP,SPSAV        ;LOAD THE STACK
  4237.         ACALL   CL7             ;DO A CRLF
  4238.         ;
  4239. CMNX:   CLR     GTRD            ;CLEAR BREAK
  4240.         MOV     DPTR,#5EH       ;DO RUN TRAP
  4241.         MOVX    A,@DPTR
  4242.         XRL     A,#52
  4243.         JNZ     $+5
  4244.         LJMP    CRUN
  4245.         MOV     R5,#'>'         ;OUTPUT A PROMPT
  4246.         LCALL   TEROT
  4247.         CALL    INLINE          ;INPUT A LINE INTO IBUF
  4248.         CALL    PP              ;PRE-PROCESS THE LINE
  4249.         JB      F0,CMND3        ;NO LINE NUMBER
  4250.         CALL    LINE            ;PROCESS THE LINE
  4251.         LCALL   LCLR
  4252.         JB      LINEB,CMNX      ;DON'T CLEAR MEMORY IF NO NEED
  4253.         SETB    LINEB
  4254.         LCALL   RCLEAR          ;CLEAR THE MEMORY
  4255.         SJMP    CMNX            ;LOOP BACK
  4256.         ;
  4257. CMND3:  CALL    T_BUF           ;SET UP THE TEXT POINTER
  4258.         CALL    DELTST          ;GET THE CHARACTER
  4259.         JZ      CMNDR           ;IF CR, EXIT
  4260.         MOV     DPTR,#CMNDD     ;POINT AT THE COMMAND LOOKUP
  4261.         CJNE    A,#T_CMND,$+3   ;PROCESS STATEMENT IF NOT A COMMAND
  4262.         JC      CMND5
  4263.         CALL    GCI1            ;BUMP TXA
  4264.         ANL     A,#0FH          ;STRIP MSB'S FOR LOOKUP
  4265.         LCALL   ISTA1           ;PROCESS COMMAND
  4266.         SJMP    CMNDR
  4267.         ;
  4268. CMND5:  LJMP    ILOOP           ;CHECK FOR A POSSIBLE BREAK
  4269.         ;
  4270.         ;
  4271.         ;
  4272.         ;CONSTANTS
  4273.         ;
  4274. XTALV:  DB      128+8           ; DEFAULT CRYSTAL VALUE
  4275.         DB      00H
  4276.         DB      00H
  4277.         DB      92H
  4278.         DB      05H
  4279.         DB      11H
  4280.         ;
  4281. EXP11:  DB      85H
  4282.         DB      00H
  4283.         DB      42H
  4284.         DB      41H
  4285.         DB      87H
  4286.         DB      59H
  4287.         ;
  4288. EXP1:   DB      128+1           ; EXP(1)
  4289.         DB      00H
  4290.         DB      18H
  4291.         DB      28H
  4292.         DB      18H
  4293.         DB      27H
  4294.         ;
  4295. IPTIME: DB      128-4           ;FPROG TIMING
  4296.         DB      00H
  4297.         DB      00H
  4298.         DB      00H
  4299.         DB      75H
  4300.         DB      83H
  4301.         ;
  4302. PIE:    DB      128+1           ;PI
  4303.         DB      00H
  4304.         DB      26H
  4305.         DB      59H
  4306.         DB      41H
  4307.         DB      31H             ; 3.1415926
  4308.         ;
  4309.         newpage
  4310.         ;***************************************************************
  4311.         ;
  4312.         ; The error messages, some have been moved
  4313.         ;
  4314.         ;***************************************************************
  4315.         ;
  4316. E7X:    DB      128+30
  4317.         DB      "ARITH. UNDERFLOW",'"'
  4318.         ;
  4319. E5X:    DB      "MEMORY ALLOCATION",'"'
  4320.         ;
  4321. E3X:    DB      128+40
  4322.         DB      "BAD ARGUMENT",'"'
  4323.         ;
  4324. EXI:    DB      "I-STACK",'"'
  4325.         ;
  4326.         newpage
  4327.         ;***************************************************************
  4328.         ;
  4329.         ; The command action routine - CONTINUE
  4330.         ;
  4331.         ;***************************************************************
  4332.         ;
  4333. CCONT:  MOV     DPTR,#E15X
  4334.         JNB     CONB,ERROR      ;ERROR IF CONTINUE IS NOT SET
  4335.         ;
  4336. CC1:    ;used for input statement entry
  4337.         ;
  4338.         MOV     TXAH,INTXAH     ;RESTORE TXA
  4339.         MOV     TXAL,INTXAL
  4340.         JMP     CILOOP          ;EXECUTE
  4341.         ;
  4342. DTEMP:  MOV     DPH,TEMP5       ;RESTORE DPTR
  4343.         MOV     DPL,TEMP4
  4344.         RET
  4345.         ;
  4346. TEMPD:  MOV     TEMP5,DPH
  4347.         MOV     TEMP4,DPL
  4348.         RET
  4349.         ;
  4350.         newpage
  4351.         ;**************************************************************
  4352.         ;
  4353. I_DL:   ; IDLE
  4354.         ;
  4355.         ;**************************************************************
  4356.         ;
  4357.         JB      DIRF,E1XX       ;SYNTAX ERROR IN DIRECT INPUT
  4358.         CLR     DACK            ;ACK IDLE
  4359.         ;
  4360. U_ID1:  DB      01000011B       ;ORL DIRECT OP CODE
  4361.         DB      87H             ;PCON ADDRESS
  4362.         DB      01H             ;SET IDLE BIT
  4363.         JB      INTPEN,I_RET    ;EXIT IF EXTERNAL INTERRUPT
  4364.         JBC     U_IDL,I_RET     ;EXIT IF USER WANTS TO
  4365.         JNB     OTS,U_ID1       ;LOOP IF TIMER NOT ENABLED
  4366.         LCALL   T_CMP           ;CHECK THE TIMER
  4367.         JC      U_ID1           ;LOOP IF TIME NOT BIG ENOUGH
  4368.         ;
  4369. I_RET:  SETB    DACK            ;RESTORE EXECUTION
  4370.         RET                     ;EXIT IF IT IS
  4371.         ;
  4372.         ;
  4373.         ;
  4374. ER0:    INC     DPTR            ;BUMP TO TEXT
  4375.         JB      DIRF,ERROR0     ;CAN'T GET OUT OF DIRECT MODE
  4376.         JNB     ON_ERR,ERROR0   ;IF ON ERROR ISN'T SET, GO BACK
  4377.         MOV     DPTR,#ERRLOC    ;SAVE THE ERROR CODE
  4378.         CALL    RC2             ;SAVE ERROR AND SET UP THE STACKS
  4379.         INC     DPTR            ;POINT AT ERRNUM
  4380.         JMP     ERL4            ;LOAD ERR NUM AND EXIT
  4381.         ;
  4382.         newpage
  4383.         ;
  4384.         ; Syntax error
  4385.         ;
  4386. E1XX:   MOV     C,DIRF          ;SEE IF IN DIRECT MODE
  4387.         MOV     DPTR,#E1X       ;ERROR MESSAGE
  4388.         SJMP    ERROR+1         ;TRAP ON SET DIRF
  4389.         ;
  4390.         MOV     DPTR,#EXI       ;STACK ERROR
  4391.         ;
  4392.         ; Falls through
  4393.         ;
  4394.         ;***************************************************************
  4395.         ;
  4396.         ;ERROR PROCESSOR - PRINT OUT THE ERROR TYPE, CHECK TO SEE IF IN
  4397.         ;                  RUN OR COMMAND MODE, FIND AND PRINT OUT THE
  4398.         ;                  LINE NUMBER IF IN RUN MODE
  4399.         ;
  4400.         ;***************************************************************
  4401.         ;
  4402. ERROR:  CLR     C               ;RESET STACK
  4403.         MOV     SP,SPSAV        ;RESET THE STACK
  4404.         LCALL   SPRINT+4        ;CLEAR LINE AND AT MODE
  4405.         CLR     A               ;SET UP TO GET ERROR CODE
  4406.         MOVC    A,@A+DPTR
  4407.         JBC     ACC.7,ER0       ;PROCESS ERROR
  4408.         ;
  4409. ERROR0: ACALL   TEMPD           ;SAVE THE DATA POINTER
  4410.         JC      $+5             ;NO RESET IF CARRY IS SET
  4411.         LCALL   RC1             ;RESET THE STACKS
  4412.         CALL    CRLF2           ;DO TWO CARRIAGE RET - LINE FEED
  4413.         MOV     DPTR,#ERS       ;OUTPUT ERROR MESSAGE
  4414.         CALL    ROM_P
  4415.         CALL    DTEMP           ;GET THE ERROR MESSAGE BACK
  4416.         ;
  4417. ERRS:   CALL    ROM_P           ;PRINT ERROR TYPE
  4418.         JNB     DIRF,ER1        ;DO NOT PRINT IN LINE IF DIRF=1
  4419.         ;
  4420. SERR1:  CLR     STOPBIT         ;PRINT STOP THEN EXIT, FOR LIST
  4421.         JMP     CMND1
  4422.         ;
  4423. ER1:    MOV     DPTR,#INS       ;OUTPUT IN LINE
  4424.         CALL    ROM_P
  4425.         ;
  4426.         ;NOW, FIND THE LINE NUMBER
  4427.         ;
  4428.         ;
  4429.         newpage
  4430.         ;
  4431.         ;
  4432.         CALL    DP_B            ;GET THE FIRST ADDRESS OF THE PROGRAM
  4433.         CLR     A               ;FOR INITIALIZATION
  4434.         ;
  4435. ER2:    ACALL   TEMPD           ;SAVE THE DPTR
  4436.         CALL    ADDPTR          ;ADD ACC TO DPTR
  4437.         ACALL   ER4             ;R3:R1 = TXA-DPTR
  4438.  JC     ER3             ;EXIT IF DPTR>TXA
  4439.         JZ      ER3             ;EXIT IF DPTR=TXA
  4440.         MOVX    A,@DPTR         ;GET LENGTH
  4441.         CJNE    A,#EOF,ER2      ;SEE IF AT THE END
  4442.         ;
  4443. ER3:    ACALL   DTEMP           ;PUT THE LINE IN THE DPTR
  4444.         ACALL   ER4             ;R3:R1 = TXA - BEGINNING OF LINE
  4445.         MOV     A,R1            ;GET LENGTH
  4446.         ADD     A,#10           ;ADD 10 TO LENGTH, DPTR STILL HAS ADR
  4447.         MOV     MT1,A           ;SAVE THE COUNT
  4448.         INC     DPTR            ;POINT AT LINE NUMBER HIGH BYTE
  4449.         CALL    PMTOP+3         ;LOAD R2:R0, PUT IT ON THE STACK
  4450.         ACALL   FP_BASE+14      ;OUTPUT IT
  4451.         JB      STOPBIT,SERR1   ;EXIT IF STOP BIT SET
  4452.         CALL    CRLF2           ;DO SOME CRLF'S
  4453.         CALL    DTEMP
  4454.         CALL    UPPL            ;UNPROCESS THE LINE
  4455.         CALL    CL6             ;PRINT IT
  4456.         MOV     R5,#'-'         ;OUTPUT DASHES, THEN AN X
  4457.         ACALL   T_L             ;PRINT AN X IF ERROR CHARACTER FOUND
  4458.         DJNZ    MT1,$-4         ;LOOP UNTIL DONE
  4459.         MOV     R5,#'X'
  4460.         ACALL   T_L
  4461.         AJMP    SERR1
  4462.         ;
  4463. ER4:    MOV     R3,TXAH         ;GET TEXT POINTER AND PERFORM SUBTRACTION
  4464.         MOV     R1,TXAL
  4465.         JMP     DUBSUB
  4466.         ;
  4467.         newpage
  4468.         ;**************************************************************
  4469.         ;
  4470.         ; Interrupt driven timer
  4471.         ;
  4472.         ;**************************************************************
  4473.         ;
  4474. I_DR:   MOV     TH0,SAVE_T      ;LOAD THE TIMER
  4475.         XCH     A,MILLIV        ;SAVE A, GET MILLI COUNTER
  4476.         INC     A               ;BUMP COUNTER
  4477.         CJNE    A,#200,TR       ;CHECK OUT TIMER VALUE
  4478.         CLR     A               ;FORCE ACC TO BE ZERO
  4479.         INC     TVL             ;INCREMENT LOW TIMER
  4480.         CJNE    A,TVL,TR        ;CHECK LOW VALUE
  4481.         INC     TVH             ;BUMP TIMER HIGH
  4482.         ;
  4483. TR:     XCH     A,MILLIV
  4484.         POP     PSW
  4485.         RETI
  4486.         ;
  4487.         newpage
  4488.         include bas52.clk
  4489.         ;***************************************************************
  4490.         ;
  4491. SUI:    ; Statement USER IN action routine
  4492.         ;
  4493.         ;***************************************************************
  4494.         ;
  4495.         ACALL   OTST
  4496.         MOV     CIUB,C          ;SET OR CLEAR CIUB
  4497.         RET
  4498.         ;
  4499.         ;***************************************************************
  4500.         ;
  4501. SUO:    ; Statement USER OUT action routine
  4502.         ;
  4503.         ;***************************************************************
  4504.         ;
  4505.         ACALL   OTST
  4506.         MOV     COUB,C
  4507.         RET
  4508.         ;
  4509. OTST:   ; Check for a one
  4510.         ;
  4511.         LCALL   GCI             ;GET THE CHARACTER, CLEARS CARRY
  4512.         SUBB    A,#'1'          ;SEE IF A ONE
  4513.         CPL     C               ;SETS CARRY IF ONE, CLEARS IT IF ZERO
  4514.         RET
  4515.         ;
  4516.         newpage
  4517.         ;**************************************************************
  4518.         ;
  4519.         ; IBLK - EXECUTE USER SUPPLIED TOKEN
  4520.         ;
  4521.         ;**************************************************************
  4522.         ;
  4523. IBLK:   JB      PSW.4,IBLK-1    ;EXIT IF REGISTER BANK <> 0
  4524.         JB      PSW.3,IBLK-1
  4525.         JBC     ACC.7,$+9       ;SEE IF BIT SEVEN IS SET
  4526.         MOV     DPTR,#USENT     ;USER ENTRY LOCATION
  4527.         LJMP    ISTA1
  4528.         ;
  4529.         JB      ACC.0,199FH     ;FLOATING POINT INPUT
  4530.         JZ      T_L             ;DO OUTPUT ON 80H
  4531.         MOV     DPTR,#FP_BASE-2
  4532.         JMP     @A+DPTR
  4533.         ;
  4534.         ;
  4535.         ;**************************************************************
  4536.         ;
  4537.         ; GET_NUM - GET A NUMBER, EITHER HEX OR FLOAT
  4538.         ;
  4539.         ;**************************************************************
  4540.         ;
  4541. GET_NUM:ACALL   FP_BASE+10      ;SCAN FOR HEX
  4542.         JNC     FP_BASE+12      ;DO FP INPUT
  4543.         ;
  4544.         ACALL   FP_BASE+18      ;ASCII STRING TO R2:R0
  4545.         JNZ     H_RET
  4546.         PUSH    DPH             ;SAVE THE DATA_POINTER
  4547.         PUSH    DPL
  4548.         ACALL   FP_BASE+24      ;PUT R2:R0 ON THE STACK
  4549.         POP     DPL             ;RESTORE THE DATA_POINTER
  4550.         POP     DPH
  4551.         CLR     A               ;NO ERRORS
  4552.         RET                     ;EXIT
  4553.         ;
  4554.         newpage
  4555.         ;**************************************************************
  4556.         ;
  4557.         ; WB - THE EGO MESSAGE
  4558.         ;
  4559.         ;**************************************************************
  4560.         ;
  4561. WB:     DB      'W'+80H,'R'+80H
  4562.         DB      'I'+80H,'T'+80H,'T','E'+80H,'N'+80H
  4563.         DB      ' ','B'+80H,'Y'+80H,' '
  4564.         DB      'J'+80H,'O'+80H,'H'+80H,'N'+80H,' '+80H
  4565.         DB      'K','A'+80H,'T'+80H,'A'+80H,'U'+80H
  4566.         DB      'S','K'+80H,'Y'+80H
  4567.         DB      ", I",'N'+80H,'T'+80H,'E'+80H,'L'+80H
  4568.         DB      ' '+80H,'C'+80H,'O'+80H,'R'+80H,'P'+80H
  4569.         DB      ". 1",'9'+80H,"85"
  4570. H_RET:  RET
  4571.         ;
  4572.         newpage
  4573.         ORG     1990H
  4574.         ;
  4575. T_L:    LJMP    TEROT
  4576.         ;
  4577.         ORG     1F78H
  4578.         ;
  4579. CKS_I:  JB      CKS_B,CS_I
  4580.         LJMP    401BH
  4581.         ;
  4582. CS_I:   LJMP    2088H
  4583.         ;
  4584. E14X:   DB      "NO DATA",'"'
  4585.         ;
  4586. E11X:   DB      128+20
  4587.         DB      "ARITH. OVERFLOW",'"'
  4588.         ;
  4589. E16X:   DB      "PROGRAMMING",'"'
  4590.         ;
  4591. E15X:   DB      "CAN"
  4592.         DB      27H
  4593.         DB      "T CONTINUE",'"'
  4594.         ;
  4595. E10X:   DB      "INVALID LINE NUMBER",'"'
  4596.         ;
  4597. NOROM:  DB      "PROM MODE",'"'
  4598.         ;
  4599. S_N:    DB      "*MCS-51(tm) BASIC V1.1*",'"'
  4600.         ;
  4601.         ORG     1FF8H
  4602.         ;
  4603. ERS:    DB      "ERROR: ",'"'
  4604.         ;
  4605.         newpage
  4606.         ;***************************************************************
  4607.         ;
  4608.         segment xdata   ;External Ram
  4609.         ;
  4610.         ;***************************************************************
  4611.         ;
  4612.         DS      4
  4613. IBCNT:  DS      1               ;LENGTH OF A LINE
  4614. IBLN:   DS      2               ;THE LINE NUMBER
  4615. IBUF:   DS      LINLEN          ;THE INPUT BUFFER
  4616. CONVT:  DS      15              ;CONVERSION LOCATION FOR FPIN
  4617.         ;
  4618.         ORG     100H
  4619.         ;
  4620. GTB:    DS      1               ;GET LOCATION
  4621. ERRLOC: DS      1               ;ERROR TYPE
  4622. ERRNUM: DS      2               ;WHERE TO GO ON AN ERROR
  4623. VARTOP: DS      2               ;TOP OF VARIABLE STORAGE
  4624. ST_ALL: DS      2               ;STORAGE ALLOCATION
  4625. MT_ALL: DS      2               ;MATRIX ALLOCATION
  4626. MEMTOP: DS      2               ;TOP OF MEMORY
  4627. RCELL:  DS      2               ;RANDOM NUMBER CELL
  4628.         DS      FPSIZ-1
  4629. CXTAL:  DS      1               ;CRYSTAL
  4630.         DS      FPSIZ-1
  4631. FPT1:   DS      1               ;FLOATINP POINT TEMP 1
  4632.         DS      FPSIZ-1
  4633. FPT2:   DS      1               ;FLOATING POINT TEMP 2
  4634. INTLOC: DS      2               ;LOCATION TO GO TO ON INTERRUPT
  4635. STR_AL: DS      2               ;STRING ALLOCATION
  4636. SPV:    DS      2               ;SERIAL PORT BAUD RATE
  4637. TIV:    DS      2               ;TIMER INTERRUPT NUM AND LOC
  4638. PROGS:  DS      2               ;PROGRAM A PROM TIME OUT
  4639. IPROGS: DS      2               ;INTELLIGENT PROM PROGRAMMER TIMEOUT
  4640. TM_TOP: DS      1
  4641.  
  4642.         include bas52.fp
  4643.  
  4644.         END
  4645.