home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / SIMTEL / CPMUG / CPMUG012.ARK / PILOT.ASM < prev    next >
Assembly Source File  |  1985-02-10  |  68KB  |  2,030 lines

  1. ;    THIS WORK WAS PREPARED UNDER CONTRACT TO THE LISTER HILL NATIONAL CENTER
  2. ;    FOR BIOMEDICAL COMMUNICATIONS, NATIONAL LIBRARY OF MEDICINE, BETHESDA,
  3. ;    MARYLAND BY JOHN A. STARKWEATHER OF THE UNIVERSITY OF CALIFORNIA AT
  4. ;    SAN FRANCISCO.
  5. ;
  6. ;
  7. ;
  8. ;       P I L O T    8080    V E R S I O N   1.2
  9. ;
  10. ;    9/15/77
  11. ; MODIFIED TO INTERFACE WITH CPM.  11/11/77  JOHN I. FREDERICK
  12. ;
  13. ;
  14. ;
  15. CPM:    EQU    5    ;JIF
  16. ORIGN:    EQU    0100H    ;JIF
  17. PSTRT:    EQU    ORIGN    ;JIF
  18. SYSDAT:    EQU    0E00H    ;JIF
  19. PBUFB:    EQU    1100H    ;JIF
  20. PBUFF:    EQU    PBUFB    ;JIF
  21. STKPR:    EQU    1000H    ;JIF
  22. MNTR:    EQU    0    ;JIF    RETURN TO CPM
  23. MON:    EQU    1000H    ;JIF
  24. INITL:    EQU    MON    ;JIF
  25. BUFAD:    EQU    MON+3    ;JIF
  26. JMPTAB:    EQU    MON+5    ;JIF
  27. ;ORIGN    EQU    06000H        ;ORIGIN OF PROGRAM.
  28. ;PSTRT    EQU    ORIGN+2E0H    ;START OF PILOT INTERPRETER.
  29. ;PBUFB    EQU    ORIGN+1000H    ;BEGINNING OF PROGRAM BUFFER.
  30. ;PBUFE    EQU    ORIGN+1FFFH    ;END OF PROGRAM BUFFER.
  31. LINE    EQU    72        ;MAX INPUT AT STARTUP.
  32. ;VIDEO   EQU     0FE77H        ;EXTERNAL VIDEO DISPLAY ADDR.
  33. ;MNTR    EQU     0008H           ;EXTERNAL MONITOR ADDRESS
  34. ;STKPR    EQU    ORIGN+100H    ;START OF STACK
  35. ;
  36. ;PORT    EQU    0F6H    ;MDS CONSOLE INPUT PORT
  37. ;STPORT    EQU    0F7H    ;MDS CONSOLE STATUS PORT
  38. ;RDA    EQU    02H    ;READ DATA AVAILABLE MASK.
  39. ;TBE    EQU    01H    ;TRANSMIT BUFFER EMPTY MASK.
  40. ;
  41. ;INTSRT    EQU    38H    ;MDS INTERRUPT 7 FOR RESTARTING PILOT.
  42. ;
  43. ;        ORG   INTSRT    ;RESTART PROGRAM BY USE OF INTERRUPT 7.
  44. ;    ASEG
  45. ;        JMP   START      ;ENTRY SETS NORMAL I/O
  46. ;
  47.         ;LXI   H,CTV      ;ENTRY TO USE VIDEO OUTPUT
  48.         ;SHLD  CO+1       ;  AT STARTUP
  49.         ;SHLD  LO+1
  50.         ;SHLD  PO+1
  51.         ;JMP   RSTRT
  52. ;CTV:    PUSH  B
  53.         ;MOV   B,C
  54.         ;CALL  VIDEO
  55.         ;POP   B
  56.         ;RET
  57. ;
  58. ; JUMP TABLE FOR I/O ROUTINES
  59. ; RELOCATED TO MONITOR              JIF
  60. ;   ONLY TTY ROUTINES ARE PROVIDED INTERNALLY
  61. ;
  62. CI:    EQU    JMPTAB        ;JIF
  63. CO:    EQU    JMPTAB+3    ;JIF
  64. RI:    EQU    JMPTAB+6    ;JIF
  65. LO:    EQU    JMPTAB+9H    ;JIF
  66. PO:    EQU    JMPTAB+0CH    ;JIF
  67. EXIT:    EQU    JMPTAB+0FH    ;JIF
  68. EDIT:    EQU    JMPTAB+12H    ;JIF
  69. ASCAN:    EQU    JMPTAB+15H    ;JIF
  70. ;        ORG   STKPR
  71. ;CI:     JMP   CHI           ;CHAR INPUT  TO   A REG.
  72. ;CO:     JMP   CHO           ;CHAR OUTPUT FROM C REG.
  73. ;RI:     JMP   CHI           ;READER INPUT TO  A REG.
  74. ;LO:     JMP   CHO           ;LIST OUTPUT FROM C REG.
  75. ;PO:     JMP   CHO           ;PUNCH OUTPUT FROM C REG.
  76. ;EXIT:   JMP   MNTR          ;RETURN TO MONITOR
  77. ;EDIT:   JMP   MNTR          ;CALL TO EDITOR
  78. ;ASCAN:  JMP   BASIC         ;ALTERN INTERPRETER
  79. ;
  80. ; DATA AREAS
  81.     ORG    SYSDAT        ;JIF
  82. TOPP:   DW    0             ;TOP OF PROGRAM STORAGE
  83. HLSAV:  DW    0             ;TEMPORARY POINTER (HL)
  84. HLLSAV: DW    0             ;TEMPORARY POINTER (HL)
  85. HL2SAV: DW    0             ;TEMPORARY POINTER (HL)
  86. DESAV:  DW    0             ;TEMPORARY POINTER (DE)
  87. LLSAV:  DW    0             ;LAST LINE POINTER
  88. RETSAV: DW    0             ;ZERO LEVEL OF STACK
  89.         DW    0             ;LEVEL 1
  90.         DW    0             ;LEVEL 2
  91.         DW    0             ;LEVEL 3
  92.         DW    0             ;LEVEL 4
  93.         DW    0             ;LEVEL 5
  94.         DW    0             ;LEVEL 6
  95.         DW    0             ;LEVEL 7  (TOP)
  96. APTR:   DW    0             ;A STMT POINTER
  97. EPTR:   DW    0             ;ENTRY POINTER
  98. CPTR:   DW    0             ;CHAR POINTER
  99. IPTR:   DW    0             ;INPUT BUFFER POINTER
  100. MPTR:   DW    0             ;M-STMT POINTER
  101. MEMTP:  DW    0             ;LAST MEMORY LOCATION
  102. OUTADR: DW    0             ;CO,LOPO OUTPUT VECTOR
  103. SCANB:  DW   0            ;SCAN BEGINNING ADDR
  104. CHMAX:  DS    1             ;MAXCHARSACCEPTED
  105. LEVEL:    DS    1          ;CURRENT RTURN LEVEL
  106. LNSKP:  DS    1             ;LINE NUMBER SKIP
  107. MBRCH:  DS    1             ;M-BREAK CHAR
  108. SCNT:   DS    1             ;STRING COUNT
  109. TEMP:   DS    1             ;TEMPORARY BINARY VALUE
  110. VARSAV: DS    1             ;VARIABLE SAVED
  111. YNSW:   DS    1             ;YN-SWITCH, 000: NO MATCH
  112. TSAVE:  DS    81            ;T-TEXT AREA
  113. EBUFF:  DS    81            ;ENTRY BUFFER AREA
  114. MSAVE:  DS    81            ;M LIST AREA
  115. LABSAV: DS    12            ;LABEL SAVE AREA
  116. LASTOP: DS    11            ;LAST OP CODE
  117. NVAR:   DS    53            ;NUMERIC VARIABLE STORAGE
  118. WORD:   DS    81            ;WORD AREA
  119. ;
  120. ; START AND TERMINATION OF MAIN PROGRAM
  121. ;   ORG HERE CAN SET BEGINNING OF ROM AREA
  122. ;
  123.         ORG   PSTRT
  124. ;START:  LXI   SP,STKPR       ;INITIALIZE STACK POINTER
  125. START:    CALL    INITL        ;JIF
  126.     JMP    ARO        ;JIF
  127.     JMP    BASIC        ;JIF
  128.     JMP    INTR        ;JIF
  129. ARO:
  130. ;        LXI   H,PBUFE-1     ;INITIALIZE APTR
  131. ;        SHLD  APTR
  132. ;        LXI   H,IOJMP       ;SET NORMAL I/O VECTORS
  133. ;        LXI   D,CI
  134. ;        MVI   C,24
  135. ;        CALL  BLKTFR
  136.         JMP   RSTRT
  137. ;IOJMP:  JMP   CHI           ;COPY OF STD JMP TABLE
  138. ;        JMP   CHO
  139. ;        JMP   CHI
  140. ;        JMP   CHO
  141. ;        JMP   CHO
  142. ;        JMP   MNTR
  143. ;        JMP   MNTR
  144. ;        JMP   BASIC
  145. ;
  146. RSTRT:  LXI   SP,STKPR       ;INIT STACK ON RESTART
  147.         CALL  INIT          ;INITIALIZE THE REST
  148.         CALL  SCAN          ;SCAN THE BUFFER
  149.         JMP   RSTRT         ;START OVER
  150. ;
  151.         DB    '020677',0DH
  152. ;
  153.         DB    'PILOT-8080, 1.1',0DH
  154. ;
  155. ;
  156. ;
  157. ; INITIALIZE DATA FOR NEW PROGRAM
  158. ;
  159. INIT:   LXI   H,IBUFF       ;RESET INPUT POINTER
  160.         SHLD  IPTR          ;  TO FRONT OF BUFFER
  161.         SHLD  SCANB         ;SET SCAN BEGINNING
  162.     LHLD    BUFAD    ;JIF
  163. ;        LXI   H,PBUFE       ;SET LAST MEMORY LOC
  164.         SHLD  MEMTP
  165.         CALL  NEWN          ;SET A-POINTER
  166.         CALL  INITV         ;INITIALIZE VARIABLES
  167.         MVI   M,1           ;    SET STOP
  168.         MVI   A,LINE        ;RESET INMAX TO LINE
  169.         STA   CHMAX
  170.         XRA   A             ;ZERO RETURN LEVEL
  171.         STA   LEVEL
  172.         STA   LNSKP         ;ZERO LN NO. SKIP
  173.         LXI   H,CO          ;RESET CONSOLE OUTPUT
  174.         SHLD  OUTADR
  175.         RET
  176. ;
  177. ; SCAN OF INPUT BUFFER
  178. ;   ENTER:   HL=BUFFER ADDR
  179. ;   RETURNS: HL=LAST ADDR, B=LAST CHAR (01)
  180. ;
  181. SCAN:   LHLD  IPTR          ;GET POINTER
  182.         MOV   A,M           ;GET FIRST CHAR
  183.         CPI   1             ;IF END MARKER
  184.         RZ                  ;  THEN RETURN
  185.         CPI   0DH           ;IF NOT END OF LINE
  186.         JNZ   CKEND         ;  THEN CK FOR SOURCE END
  187.         INX   H             ;  ELSE BUMP POINTER
  188.         JMP   SCAN+3        ;  AND CONTINUE
  189. CKEND:  CALL  CNTLN         ;HL=EOL, A=BR CHAR
  190.         CPI   1             ;IF END MARKER
  191.         RZ                  ;  THEN RETURN
  192.         INX   H             ;HL=START OF NEXT LINE
  193.         SHLD  IPTR          ;SAVE THAT ADDR
  194.         DCX   H             ;HL=BREAK CHAR
  195.         CALL  BACKUP        ;RESET HL TO CURRENT LINE
  196.         CALL  SKLN          ;SKIP ANY LN NOS., ETC.
  197.         CALL  GETCH         ;   GET FIRST TEXT CHAR
  198.         CPI   ':'           ;IF COLON
  199.         CZ    CONTIN        ;  THEN CONTINUE SAME OP
  200.         JZ    SCAN          ;  IF CALLED THEN NEXT SCAN
  201.         CPI   '*'           ;IF ASTERISK
  202.         CZ    GETWD         ;  THEN SKIP LABEL
  203.         JZ    SCAN+3        ;IF CALLED THEN RESCAN
  204.         CALL  OPS           ;PROCESS OPERATIONS
  205.         JMP   SCAN
  206. ;
  207. CONTIN: INX   H             ;COLON ADDR + 1
  208.         SHLD  HLSAV         ;SAVE IT
  209.         LXI   H,LASTOP      ;  ADDR LAST OP CODE
  210.         SHLD  LLSAV         ;SAVE OP CODE ADDR
  211.         MVI   B,':'
  212.         CALL  INDX          ;ADDR COLON POS
  213.         CALL  OLDOP         ;USE PART OF OPS
  214.         XRA   A             ; SET RETURN FLAG
  215.         RET
  216. ;
  217. ; OP CODES-- INTERPRET OPERATION
  218. ;   ENTER: HL = FIRST NON-BLANK CHAR IN LINE
  219. ;   RETURNS: RETURN (ZERO) FLAG SET
  220. ;
  221. OPS:    SHLD  LLSAV         ;SAVE OP CODE ADDR
  222.         CALL  SAVOP         ;SAVE OP CODE
  223.         LHLD  LLSAV         ;ADDR OP CODE
  224.         MVI   B,':'         ;  LOOK FOR COLON
  225.         CALL  INDX          ;IF NOT FOUND
  226.         MOV   A,C
  227.         ORA   A
  228.         JZ    ALTSC         ;  THEN TRY ALTERN SCAN
  229.         INX   H             ;COLON ADDR + 1
  230.         SHLD  HLSAV         ;SAVE IT
  231.         DCX   H             ;ADDR POS OF COLON
  232. OLDOP:  DCX   H             ;ADDR POS BEFORE COLON
  233.         CALL  YNCHK         ;IF YN-SW OFF(Y) OR ON(N)
  234.         ORA   A             ;   (A=000)
  235.         RZ                  ;  THEN RETURN
  236.         CALL  VARCHK        ;IF VARIABLE PRESENT < 1
  237.         RZ                  ;  THEN RETURN
  238.         LHLD  LLSAV         ;ADDR OP CODE
  239.         CALL  GETCTL        ;GET THE CONTROL WORD
  240.         CALL  CTLMCH        ;CALL SPECIFIC CONTROL
  241.         CPI   1             ;IF CONTROL FOUND
  242.         RNZ                 ;  THEN RETURN
  243. ALTSC:  LHLD  LLSAV         ;ADDR FIRST CHAR
  244.         CALL  ASCAN         ;TRY ALTERN SCAN
  245.         RZ                  ;IF OK, THEN RETURN
  246.         LHLD  LLSAV         ;ELSE ADDR FIRST CHAR
  247.         SHLD  HLSAV         ;SET POINTER
  248.         CALL  TOP           ;DISPLAY TEXT
  249.         RET
  250. ;
  251. ; TEXT CHECK FOR PRESENCE OF LINE FEEDS,
  252. ;   LINE COUNTS, OR LINE NUMBERS.
  253. ; SETS LNSKP TO NO. OF CHARS TO SKIP BEFORE TEXT
  254. ;
  255. TXTCK:  LXI   H,PBUFF       ;ADDR PROGRAM TEXT
  256.         CALL  CNTLN         ;ADDR CR
  257.         INX   H
  258.         MOV   A,M           ;GET NEXT CHAR
  259.         CPI   0AH           ;IF NOT LF
  260.         JNZ   CKLC          ;  THEN CK FOR LINE COUNT
  261.         CALL  CNTLN         ;ELSE CK ANOTHER LINE
  262.         INX   H
  263.         MOV   A,M
  264.         CPI   0AH           ;IF NOT LF
  265.         JNZ   CKLC          ;  THEN CK FOR LINE COUNT
  266.         LDA   LNSKP         ;ELSE ADD 1 TO LNSKP
  267.         ADI   1
  268.         STA   LNSKP
  269. CKLC:   LXI   H,PBUFF       ;CK FOR LINE COUNT
  270.         CALL  CNTLN         ;ADDR CR
  271.         INX   H             ;  NEXT CHAR
  272.         CALL  SKLN          ;SKIP ANY LF
  273.         MOV   E,M           ;GET POSSIBLE LINE COUNT
  274.         MVI   D,0
  275.         DCX   D             ;DECR IT
  276.         DAD   D             ;ADDR LINE END
  277.         MOV   A,M           ;GET CHAR
  278.         CPI   0DH           ;IF NOT CR
  279.         JNZ   CKLN          ;  THEN CK FOR LINE NO.
  280.         INX   H             ;ELSE CK ANOTHER LINE
  281.         CALL  SKLN
  282.         MOV   E,M
  283.         DCX   D
  284.         DAD   D
  285.         MOV   A,M
  286.         CPI   0DH           ;IF NOT CR
  287.         JNZ   CKLN          ;  THEN CK FOR LINE NOS.
  288.         LDA   LNSKP         ;ELSE ADD 1 TO LNSKP
  289.         ADI   1
  290.         STA   LNSKP
  291. CKLN:   LXI   H,PBUFF+1     ;NOW LOOK FOR LN NOS.
  292.         CALL  CNTLN         ;ADDR CR
  293.         INX   H             ;  NEXT CHAR
  294.         CALL  SKLN          ;SKIP LF OR LN CNT
  295.         MOV   A,M           ;GET CHAR AFTER LN CT
  296.         CALL  NUM           ;IF NOT ASCII NUMBER
  297.         RNZ                 ;  THEN QUIT
  298.         LDA   LNSKP         ;ELSE ADD 4 TO LNSKP
  299.         ADI   4
  300.         STA   LNSKP
  301.         RET
  302. ;
  303. NUM:    CPI   '0'           ;CHECK FOR ASCII NUMBER
  304.         RM                  ;TOO LOW
  305.         CPI   '9'+1
  306.         JM    YNUM
  307.         ORA   H             ;TOO HIGH
  308.         RET
  309. YNUM:   XRA   A             ;OK
  310.         RET
  311. ;
  312. ; SKIP LINE NUMBER AND LINE COUNT
  313. ;    BASED ON VALUE OF LNSKP
  314. ;
  315. SKLN:   LDA   LNSKP         ;GET SKIP COUNT
  316.         ORA   A             ;IF ZERO
  317.         RZ                  ;  THEN RETURN
  318.         INX   H             ;SKIP A CHARACTER
  319.         DCR   A             ;DECR COUNT
  320.         JMP   SKLN+3        ;MORE
  321. ;
  322. ;    CHECK FOR Y OR N CONDITIONS
  323. ; Y AND N FOLLOWING OP CODE
  324. ;      ACT AS A SWITCH ALONG WITH YN-SWITCH
  325. ;   ENTER:   HL = ADDR OF COLON
  326. ;   RETURNS: A = 000 IF NO ACTION REQUIRED
  327. ;                ELSE A = CHAR BEFORE COLON
  328. ;            HL = ADDR OF LAST CHAR BEFORE COLON
  329. ;
  330.  
  331. YNCHK:  CALL  GETLCH        ;GET LAST CHARACTER
  332.         CPI   'Y'           ;IF Y
  333.         JZ    YCHK
  334.         CPI   'N'           ;IF N
  335.         JZ    NCHK
  336.         ORA   A             ; ELSE SET SWITCH ON
  337.         RET                 ;  AND RETURN WITH CHAR
  338. YCHK:   LDA   YNSW          ;IF YN-SWITCH
  339.         ORA   A             ;    SHOWS MATCH
  340.         JZ    DONT          ;  THEN QUIT
  341.         ORA   H             ; ELSE SET SWITCH ON
  342.         RET                 ;  AND RETURN
  343. NCHK:   LDA   YNSW
  344.         ORA   A             ;    SHOWS NO MATCH
  345.         JNZ   DONT          ;  THEN QUIT
  346.         ORA   H             ; ELSE SET SWITCH ON
  347.         RET                 ;  AND RETURN
  348. DONT:   XRA   A             ; SET SWITCH OFF
  349.         RET                 ;  AND RETURN
  350. ;
  351. ;     CHECK FOR NUMERIC VARIABLE CONDITIONS
  352. ; VARIABLE IN PARENTHESES AFTER OP CODE
  353. ;   CAUSES EXECUTION IF VALUE +1 OR MORE
  354. ;    ENTER:   A = LAST CHAR BEFORE COLON
  355. ;    RETURNS: ZERO FLAG OFF IF NO ACTION REQUIRED
  356. ;
  357. VARCHK: CPI   ')'           ;IF VARIABLE PRESENT
  358.         JZ    VCHK          ;  THEN CHECK IT
  359.         ORA   H             ; ELSE SET SWITCH ON
  360.         RET                 ;  AND RETURN
  361. VCHK:   DCX   H             ;DECR POINTER
  362.         DCX   H             ;  TWICE
  363.         MOV   A,M           ;   GET CHAR
  364.         CPI   '('           ;IF PAREN NOT PRESENT
  365.         JNZ   BADFRM        ;  THEN COMPLAIN
  366.         INX   H             ;BUMP POINTER
  367.         MOV   B,M           ;   SAVE CHAR IN B
  368.         CALL  VARMCH        ;LOOK IT UP
  369.         CPI   1             ;IF END MARKER
  370.         JZ    BADFRM        ;  THEN COMPLAIN
  371.         INX   H             ;  ELSE POINT AT VALUE
  372.         MOV   A,M           ;   GET VALUE
  373.         CPI   01
  374.         JM    VOFF          ;  THEN QUIT
  375.         ORA   H             ; ELSE SET SWITCH ON
  376.         RET                 ;  AND RETURN
  377. VOFF:   XRA   A             ; SET SWITCH OFF
  378.         RET                 ;  AND RETURN
  379. ;
  380. BADFRM: LHLD  LLSAV         ;SHOW THE LINE
  381.  
  382.         CALL  TOP+3
  383.         LXI   H,EXPMSG
  384.         CALL  ERROR
  385.         RET
  386. ;
  387. ; VARIABLE MATCH - LOOKUP OF VARIABLE NAME/VALUE LIST
  388. ;    ENTER:   VARIABLE NAME CHAR IN B REGISTER
  389. ;    RETURNS: HL = ADDR OF MATCHED NAME
  390. ;             IF VAR NOT IN LIST THEN A = 01
  391. ;
  392. VARMCH: LXI   H,NVAR
  393.         MOV   A,M
  394.         CPI   1             ;IF LIST END
  395.         RZ                  ;  THEN RETURN
  396.         CMP   B             ;IF MATCH
  397.         RZ                  ;  THEN RETURN
  398.         INX   H             ;  ELSE LOOK AGAIN
  399.         INX   H
  400.         JMP   VARMCH+3
  401. ;
  402. ; CONTROL MATCH- CALLS SPECIFIC CONTROL OPERATIONS
  403. ;   ENTER:   'WORD':CONTROL WORD
  404. ;   RETURNS: IF WORD NOT IN LIST, THEN 01 RETURNED
  405. ;            HL: START OF NEXT WORD
  406. ;
  407. CTLMCH: LXI   D,CTLST       ;  DE=CONTROL LIST ADDR
  408.         CALL  LSTMCH        ;LOOK FOR WORD
  409.         CPI   1             ;IF NOT FOUND
  410.         RZ                  ;  THEN RETURN
  411.         XCHG
  412.         INX   H
  413.         LXI   D,RTRN        ;PUT RETURN ON STACK
  414.         PUSH  D
  415.         MOV   E,M
  416.         INX   H
  417.         MOV   D,M
  418.         PUSH  D             ;CALL ADDR ON STACK
  419.         RET
  420. RTRN:   XRA   A
  421.         RET
  422. ;
  423. ; LIST MATCH - LOOKUP OF WORD/ADDRESS LIST
  424. ;   ENTER:   'WORD' = WORD TO BE FOUND
  425. ;            DE = ADDR OF BEGINNING OF LIST
  426. ;   RETURNS: DE = ADDR OF POINTER (L BYTE)
  427. ;            IF WORD NOT IN LIST THEN A = 01
  428. ;
  429. LSTMCH: LXI   H,WORD        ;  HL=INPUT WORD
  430.         CALL  CMPR          ;COMPARE WORD WITH LIST
  431.         ORA   A             ; IF MATCH
  432.  
  433.         RNZ                 ;  THEN RETURN
  434.         INX   H             ;ELSE HL = DE
  435.         XCHG
  436.         INX   H             ;AND INCR HL TO
  437.         INX   H             ;NEXT LIST ADDR
  438.         INX   H
  439.         MOV   A,M           ;   GET NEXT LIST CHAR
  440.         CPI   1             ;IF END MARKER
  441.         RZ                  ;  THEN RETURN
  442.         XCHG                ;ELSE RESET DE TO NEXT ITEM
  443.         JMP   LSTMCH        ;  AND TRY IT
  444. ;
  445. ; CONTROL LIST - OP CODES AND KEYWORDS
  446. ;
  447. CTLST:  DB    'T',0DH
  448.  
  449.         DW    TOP
  450.         DB    'A',0DH
  451.         DW    AOP
  452.         DB    'M',0DH
  453.         DW    MOP
  454.         DB    'MC',0DH
  455.         DW    MC
  456.         DB    'J',0DH
  457.         DW    JOP
  458.         DB    'R',0DH
  459.         DW    ROP
  460.         DB    'C',0DH
  461.         DW    COP
  462.         DB    'U',0DH
  463.         DW    UOP
  464.         DB    'E',0DH
  465.         DW    EOP
  466.         DB    'Y',0DH
  467.         DW    TOP
  468.         DB    'N',0DH
  469.         DW    TOP
  470.         DB    'LOAD',0DH 
  471. ;LOAD NEW PROGRAM
  472.         DW    LOAD
  473.         DB    'INMAX',0DH 
  474. ;LIMITS CHARS ACCEPTED
  475.         DW    INMAX
  476.         DB    'NEW$',0DH 
  477. ;ERASE $TEXT
  478.         DW    NEWN
  479.         DB    'DP',0DH 
  480.         ;DISPLAY PROGRAM
  481.         DW    DPRG  
  482.         DB    'PRINT',0DH 
  483. ;PRINT PROGRAM
  484.         DW    LPRG
  485.         DB    'SAVE',0DH 
  486. ;SAVE PROGRAM
  487.         DW    SPRG
  488.         DB    'IEP',0DH 
  489. ;INTERPRET EXIST PROG
  490.         DW    IEP
  491.         DB    'BYE',0DH
  492.         DW    EXIT
  493.         DB    'EDIT',0DH
  494.         DW    EDIT
  495. ;COMMON DATAPOINT PILOT CODES NOT IN OPERATION
  496.         DB    'CA',0DH
  497.         DW    CURSR
  498.         DB    'CE',0DH
  499.         DW    CLRE
  500.         DB    'CL',0DH
  501.         DW    CLRL
  502.         DB    'CH',0DH
  503.         DW    CLRH
  504.         DB    'RL',0DH
  505.         DW    ROLL
  506. ;        DB    'WA',0DH
  507. ;        DW    WAIT
  508.     DB    1
  509. ;
  510. CURSR:    MVI C,1BH
  511.     CALL CO
  512.     MVI C,'&'
  513.     CALL CO
  514.     MVI C,61H
  515.     CALL CO
  516.     LHLD HLSAV
  517. CURS1:    MOV A,M
  518.     CPI ','
  519.     JZ CURS3
  520.     CPI 0DH
  521.     JZ CURS4
  522.     MOV C,A
  523. CURS2:    CALL CO
  524.     INX H
  525.     JMP CURS1
  526. CURS3:    MVI C,'r'
  527.     JMP CURS2
  528. CURS4:    MVI C,'C'
  529.     CALL CO
  530.       RET
  531. CLRE:    MVI C,1BH
  532.     CALL CO
  533.     MVI C,'J'
  534.     CALL CO
  535.     RET
  536. CLRL:    MVI C,1BH
  537.     CALL CO
  538.     MVI C,'K'
  539.     CALL CO
  540.     RET
  541. CLRH:    MVI C,1BH
  542.     CALL CO
  543.     MVI C,'H'
  544.     CALL CO
  545.     JMP CLRE
  546. ROLL:    MVI C,1BH
  547.     CALL CO
  548.     MVI C,'S'
  549.     CALL CO
  550.        RET
  551. ;WAIT:   RET
  552. ;
  553. ; INTERPRET EXISTING PROGRAM
  554. ;    STARTS SCAN OF PROGRAM BUFFER
  555. ;
  556. IEP:    LXI   H,PBUFF
  557.         SHLD  IPTR          ;SET POINTER
  558.         SHLD  SCANB         ;  AND SCAN BEGINNING
  559.     CALL    TXTCK        ;CHK FOR CHARS TO SKIP
  560.         RET
  561. ;
  562. INMAX:  CALL  NMCTL         ;E = NUMBER CONTROL
  563.         MOV   A,E
  564.         CPI   73            ;LIMIT TO 72
  565.         JM    INMX2
  566.         MVI   A,72
  567.         MOV   E,A
  568. INMX2:  LXI   H,CHMAX       ;  SET INPUT CHAR MAX
  569.         MOV   M,E
  570.         RET
  571. ;
  572. ; CHAR TO BINARY CONVERSION FOR CONTROL ARGUMENTS
  573. ; NUMBER CONTROL - FINDS 1 OR 2 DIGIT NUMBER OR NAME
  574. ;  OF VARIABLE IN NEXT WORD. NEGATIVE VALUES SET TO ZERO.
  575. ;    ENTER:   HLSAV = EXPRESSION ADDRESS
  576. ;    RETURNS: E = BINARY VERSION OF THE NUMBER
  577. ;             A = 0DH IF ALREADY AT END OF LINE
  578. ;             HLSAV = BR CHAR   ADDR
  579. ;
  580. NMCTL:  LHLD  HLSAV         ;EXPRESSION ADDR
  581.         CALL  GETCH         ;GET CHAR
  582.         CPI   0DH           ; IF CR
  583.         RZ                  ;  THEN RETURN
  584.         CALL  GETWD         ;GET NEXT WORD
  585.         DCX   H             ;BACK UP TO BR CHAR
  586.         SHLD  HLSAV         ;SAVE POINTER
  587.         LXI   H,WORD        ;    IN 'WORD'
  588.         CALL  LETTER        ;IF NOT LETTER
  589.         JNZ   CVNUM         ;  THEN CONVERT A NUMBER
  590.         MOV   B,M           ;   ELSE SAVE CHAR IN B
  591.         CALL  VARMCH        ;LOOK IT UP
  592.         CPI   1             ;IF END MARKER
  593.         CZ    BADFRM        ;  THEN COMPLAIN
  594.         RZ                  ;  AND RETURN
  595.         INX   H             ;ELSE POINT AT VALUE
  596.         MOV   E,M           ;   PUT VALUE IN E
  597.         JMP   CVNUM+3       ;  AND QUIT
  598. CVNUM:  CALL  GETNM         ;CONVERT NUMBER
  599.         MOV   A,E           ;      GET VALUE
  600.         ORA   A
  601.         RP                  ;RETURN IF POSITIVE
  602.         MVI   E,0           ;  ELSE SET TO ZERO
  603.         RET
  604. ;
  605. ; JUMP TO LABEL NAME
  606. ;   ENTER:   HLSAV = EXPRESSION FIELD
  607. ;   RETURNS: HL RESET OR MESSAGE
  608. ;
  609. JOP:    LHLD  HLSAV         ;ADDR EXPRESSION
  610.         CALL  GETCH         ;GET FIRST CHAR
  611.         CPI   '*'           ;IF *
  612.         JZ    JOP2          ;  THEN MOVE WORD
  613.         MVI   A,'*'
  614.         STA   WORD          ;ELSE ADD *
  615.         LXI   D,WORD+1      ;  THEN MOVE WORD
  616.         LHLD  HLSAV
  617.         CALL  WDTFR
  618.         JMP   JOP2+3        ;AND CONTINUE
  619. JOP2:   CALL  GETWD         ;GET NEXT WORD
  620.         LHLD  SCANB         ;  START OF SCAN AREA
  621.         CALL  LOOKL         ;LOOK FOR IT
  622.         CPI   1             ;IF LABEL NOT FOUND
  623.         CZ    NTFND         ;  THEN COMPLAIN
  624.         RZ                  ;  AND RETURN
  625.         INX   H
  626.         SHLD  IPTR          ;NEW SCAN POSITION
  627.         RET                 ;RESTART SCAN
  628. ;
  629. ;
  630. NTFND:  LXI   H,WORD        ;  SHOW THE LABEL
  631.         CALL  DSPLY
  632.         LXI   H,BLMSG
  633.         CALL  ERROR
  634.         RET
  635. ;
  636. UOP:    CALL  SAVRET        ;SAVE RETURN POINTER
  637.         JMP   JOP
  638. ;
  639. ; SET A BLOCK OF LENGTH C TO CHAR B
  640. ;
  641. BLKSET: MOV   M,B           ;   STORE ONE CHAR
  642.         INX   H             ;BUMP ADDR
  643.         MOV   A,C           ;   DECR COUNT
  644.         SUI   1
  645.         MOV   C,A           ;      IF COUNT NOT ZERO
  646.         JNZ   BLKSET        ;  THEN STORE ANOTHER
  647.         RET
  648. ;
  649. ; BLANK THE INPUT BUFFER
  650. ;
  651. BLKBF:  LHLD  APTR          ;DE=TOP OF BUFFER
  652.         XCHG
  653.         LXI   H,PBUFF       ;HL=BOTTOM OF BUFFER
  654.         MVI   B,' '
  655. BLKB2:  MOV   M,B
  656.         INX   H
  657.         CALL  ADRCMP
  658.         JNZ   BLKB2
  659.         RET
  660. ;
  661. ; ADDRESS COMPARISON - COMPARES HL + DE
  662. ;    RETURNS: ZERO AND SIGN FLAGS SET AS THOUGH
  663. ;             A CONTAINED HL AND DE WAS COMPARED
  664. ;    CALLED BY BLKBF
  665. ;
  666. ADRCMP: MOV   A,H           ;      GET H
  667.         CMP   D             ;COMPARE D
  668.         RM                  ;IF D > H THEN RETURN
  669.         RNZ                 ;IF D NOT = H THEN RETURN
  670.         MOV   A,L           ;      GET L
  671.         CMP   E             ;COMPARE E
  672.         RET                 ;  AND RETURN
  673. ;
  674. ;    CHARACTER TO BINARY CONVERSION
  675. ; GET A DECIMAL NUMBER-- UP TO 99
  676. ;   ENTER:   HL= CHAR ADDR OF ONE OR TWO DIGIT NUMBER
  677. ;   RETURNS: BINARY NUMBER IN E
  678. ;      IF INPUT NOT NUMERIC, THEN E = 0
  679. ;
  680. GETNM:  MVI   E,0           ;  INIT. OUTPUT VALUE
  681.         INX   H             ;LOOK AT NEXT CHAR
  682.         CALL  BRCHAR        ;IF BREAK CHAR
  683.         JZ    SDIG          ;  THEN SINGLE DIGIT
  684.         CPI   '+'
  685.         JZ    SDIG
  686.         CPI   '-'
  687.         JZ    SDIG
  688.         DCX   H             ;ELSE BACK UP
  689.         MOV   A,M           ;   GET FIRST CHAR
  690.         CPI   '0'           ;LIMIT RANGE
  691.         RM                  ;  TO NUMERALS
  692.         CPI   '9'+1
  693.         RP
  694.         SUI   '0'           ;REMOVE ASCII BIAS
  695.         ADD   A             ;MULT. BY 10
  696.         MOV   E,A           ;        E=A*2
  697.         ADD   A             ;  A*4
  698.         ADD   A             ;  A*8
  699.         ADD   E             ;  A+E=A*10
  700.         MOV   E,A           ;      SAVE IT
  701.         INX   H             ;HL=HL+1
  702. UNITS:  MOV   A,M           ;   GET SECOND CHAR
  703.         CPI   '0'           ;LIMIT RANGE
  704.         RM                  ;  TO NUMERALS
  705.         CPI   '9'+1
  706.         RP
  707.         SUI   '0'           ;REMOVE ASCII BIAS
  708.         ADD   E             ;ADD NEW DIGIT
  709.         MOV   E,A           ;        TO E
  710.         RET
  711. SDIG:   DCX   H             ;BACK UP POINTER
  712.         JMP   UNITS         ;CONVERT UNITS POSITION
  713. ;
  714. ;    BINARY TO CHARACTER CONVERSION
  715. ; PUT BINARY NUMBER IN DECIMAL CHARS -99 TO +99
  716. ;    ENTER:   BINARY NUMBER IN E
  717. ;             HL = CHARACTER AREA
  718. ;    RETURNS: HL = ADDR OF 0DH AFTER RIGHT DIGIT
  719. ;
  720. PUTNM:  MVI   C,0           ;  INITIALIZE C
  721.         MOV   A,E           ;      GET BINARY NUMBER
  722.         ORA   A             ; IF NEGATIVE
  723.         CM    NEG           ;  THEN SHOW MINUS SIGN
  724.         CPI   10            ;IF < 10
  725.         JM    FRMCH         ;  THEN FORM CHAR
  726.         SUI   10            ;  ELSE SUBTR 10
  727.         MOV   E,A           ;        SAVE IN E
  728.         MOV   A,C           ;   INCR TENS COUNT
  729.         ADI   1
  730.         MOV   C,A
  731.         JMP   PUTNM+2       ;  AND LOOP
  732. FRMCH:  MOV   A,C           ;   GET TENS COUNT
  733.         ADI   '0'           ;ADD ASCII BIAS
  734.         CPI   '0'           ;IF CHAR IS 0
  735.         JZ    FRMU          ;  THEN FORM UNITS
  736.         MOV   M,A           ;   STORE THE CHAR
  737.         INX   H             ;BUMP CHAR ADDR
  738. FRMU:   MOV   A,E           ;      GET THE UNITS
  739.         ADI   '0'           ;ADD ASCII BIAS
  740.         MOV   M,A           ;   STORE THE CHAR
  741.         INX   H             ;BUMP POINTER
  742.         MVI   A,0DH         ;   STORE EOL
  743.         MOV   M,A
  744.         RET
  745. ;
  746. NEG:    MVI   A,'-'         ;  STORE MINUS SIGN
  747.         MOV   M,A
  748.         INX   H             ;BUMP CHAR ADDRESS
  749.         XRA   A             ; MAKE BINARY POSITIVE
  750.         SUB   E
  751.         MOV   E,A           ;      SAVE IN E
  752.         RET
  753. ;
  754. ; LOOK FOR *LABEL OR $NAME OF STRING VARIABLE
  755. ;   (LOOKL OR LOOKS)
  756. ;   ENTER: 'WORD'=LABEL TO BE FOUND, HL=SCAN ADDR
  757. ;   RETURNS: HL = ADDR OF BLANK AFTER LABEL
  758. ;            IF LABEL NOT FOUND THEN A = 01
  759. ;
  760. LOOKS:  XRA   A             ;SET TEMP FOR NO SKIPS
  761.         STA   TEMP
  762.         JMP   LOOK
  763. LOOKL:  ORA   H             ;SET TEMP ON FOR SKIPS
  764.         STA   TEMP
  765.         CALL  SKLN          ;SKIP ANY LINE NOS.
  766. LOOK:   CALL  GETCH         ;NEXT CHAR
  767.         CPI   1             ;IF DATA END
  768.         RZ                  ;  THEN RETURN
  769.         CPI   '*'           ;IF *
  770.         JZ    CHK           ;  THEN CHECK THE LABEL
  771.         CPI   '$'           ;IF $
  772.         JZ    CHK           ;  THEN CHECK STRING NAME
  773.         CALL  CNTLN         ;ELSE GO TO NEXT LINE
  774.         INX   H
  775.         LDA   TEMP          ;IF TEMP=0
  776.         ORA   A
  777.         JZ    LOOK          ;  THEN NO SKIPS
  778.         JMP   LOOK-3        ;ELSE SKIP LN NOS.
  779. CHK:    SHLD  HLSAV         ;SAVE POINTER
  780.         CALL  CNTWD         ;C = WORD LENGTH
  781.         MOV   A,C
  782.         CPI   13            ;LIMIT TO 12 CHARS
  783.         JM    MVLAB
  784.         MVI   C,12
  785. MVLAB:  LHLD  HLSAV         ;RETRIEVE POINTER
  786.         LXI   D,LABSAV      ;  DESTIN ADDR
  787.         CALL  BLKTFR        ;MOV   A,BSAV=LABEL
  788.         XCHG                ;HL:DESTIN BR CHAR+1
  789.         DCX   H             ;   DESTIN BR CHAR
  790.         MVI   A,0DH         ;   REPLACE WITH 0DH
  791.         MOV   M,A
  792.         LXI   H,LABSAV
  793.         LXI   D,WORD        ;    WORD ADDR
  794.         CALL  CMPR          ;COMPARE THEM
  795.         ORA   A             ; LOOK AT A REGISTER
  796.         JNZ   LFND          ;IF MATCH THEN LABEL FOUND
  797.         LHLD  HLSAV         ;ELSE RETRIEVE POINTER
  798.         CALL  CNTWD         ;SKIP LABEL
  799.         JMP   LOOK          ;  AND CONTINUE
  800. LFND:   LHLD  HLSAV         ;RETRIEVE POINTER
  801.         CALL  CNTWD         ;SKIP LABEL
  802.         RET                 ;  AND RETURN
  803. ;
  804. ; COMPARE STRINGS X AND Y
  805. ;   ENTER:   HL= X ITEM ADDR, DE= Y ITEM ADDR
  806. ;            BOTH ITEMS TERMINATE IN 0DH
  807. ;   RETURNS: A=0 FOR NO MATCH,
  808. ;            HL AND DE AT 0DH ADDRESS
  809. ;
  810. CMPR:   MOV   A,M           ;   GET X CHAR
  811.         CPI   0DH           ; IF END OF LINE
  812.         JZ    XEND          ;  THEN END OF X ITEM
  813.         MOV   C,A           ;      SAVE X CHAR IN C
  814.         INX   H             ;ADDR Y ITEM
  815.         XCHG
  816.         MOV   A,M           ;   GET Y CHAR
  817.         CPI   0DH           ; IF END OF LINE
  818.         JZ    YENDB         ;  THEN END OF Y ITEM
  819.         CMP   C             ;IF A(Y) NOT= C(X)
  820.         JNZ   NOMCH         ;THEN NO MATCH
  821.         INX   H             ;ADDR NEXT X ITEM
  822.         XCHG
  823.         JMP   CMPR          ;START OVER
  824. XEND:   XCHG                ;ADDR Y ITEM
  825.         MOV   A,M           ;   GET Y CHAR
  826.         CPI   0DH           ; IF END OF LINE
  827.         JZ    MCH           ;  THEN MATCH FOUND
  828.         CALL  CNTWD         ;ADDR Y BR CHAR
  829.         XCHG                ;SET DE
  830.         XRA   A             ;  NOMATCH
  831.         RET
  832. NOMCH:  CALL  CNTWD         ;ADDR Y BR CHAR
  833. YENDB:  XCHG                ;  SET DE
  834.         CALL  CNTWD         ;ADDR X BR CHAR
  835.         XRA   A             ; NO MATCH
  836.         RET
  837. MCH:    XCHG                ;SET DE & HL
  838.         ORA   H             ; MATCH
  839.         RET
  840. ;
  841. ; GET CHARACTER-- SKIPS LEADING BLANKS
  842. ;   ENTER:   HL=SOURCE ADDR
  843. ;   RETURNS: HL=NEXT NON-BLANK ADDR, A=CHAR
  844. ;
  845. GETCH:  MOV   A,M           ;   GET CHARACTER
  846.         CPI   20H           ;IF NOT BLANK
  847.         RNZ                 ;  THEN RETURN
  848.         INX   H             ;  ELSE GET NEXT CHAR
  849.         JMP   GETCH
  850. ;
  851. ; GET LAST CHAR - SCANS BACKWARD, SKIPS BLANKS AND CR'S
  852. ;   ENTER:   HL = STRING ADDR
  853. ;   RETURNS: HL = LAST NON-BLANK CHAR, A = CHAR
  854. ;
  855. GETLCH: MOV   A,M           ;   GET CHARACTER
  856.         CPI   20H           ;IF NOT BLANK
  857.         RNZ                 ;  THEN RETURN
  858.         DCX   H             ;ELSE GET NEXT CHAR
  859.         JMP   GETLCH
  860. ;
  861. ; GET WORD -- UP TO FIRST BREAK CHARACTER
  862. ;            IGNORESáLEADING BLANKS
  863. ;   ENTER:   HL=SOURCE ADDR
  864. ;   RETURNS: 'WORD'=SOURCE STRING + 0DH
  865. ;            HL= BR CHAR+1 ADDR, B= BR CHAR
  866. ;            DE= 'WORD' ADDR AFTER 0DH
  867. ;            C = NO OF CHARS MOVED INCL BR CHAR
  868. ;
  869. GETWD:  CALL  GETCH         ;IGNORE LEADING BLANKS
  870.         LXI   D,WORD        ;  DESTIN ADDR
  871.         CALL  WDTFR         ;MOVE IT
  872.         RET
  873. ;
  874. ; COUNT WORD
  875. ;   ENTER:   HL=SOURCE ADDR
  876. ;   RETURNS: HL=BR CHAR ADDR
  877. ;            A,B=BR CHAR, C=COUNT INCL BR CHAR
  878. ;
  879. CNTWD:  MVI   C,1           ;  COUNT=1
  880.         CALL  BRCHAR        ;IF CHAR=BREAK
  881.         RZ                  ;  C=CHAR COUNT
  882.         MOV   A,C           ;   GET COUNT
  883.         ADI   1             ;C=C+1
  884.         MOV   C,A           ;      STORE IT
  885.         INX   H             ;HL=NEXT
  886.         JMP   CNTWD+2       ;NEXT CHAR
  887. ;
  888. ; WORD TRANSFER
  889. ;   MOVES STRING FROM HL TO DE + 0DH ADDED
  890. ;   ENTER:   HL= SOURCE ADDR, DE= DESTIN ADDR
  891. ;   RETURNS: HL= SOURCE ADDR AFTER BR CHAR
  892. ;            DE= DESTIN ADDR AFTER 0DH
  893. ;            B= BR CHAR
  894. ;            C= NO OF CHARS MOVED INCL BR CHAR
  895. ;
  896. WDTFR:  MVI   C,1           ;  INIT COUNT
  897.         CALL  BRCHAR        ;IF BREAK CHAR
  898.         JZ    MVBR          ;  THEN END OF SOURCE
  899.         INX   H             ;HL= DESTIN ADDR
  900.         XCHG
  901.         MOV   M,B           ;   MOVE CHARACTER
  902.         MOV   A,C           ;   INCR COUNT
  903.         ADI   1
  904.         MOV   C,A
  905.         INX   H             ;HL= NEXT SOURCE ADDR
  906.         XCHG
  907.         JMP   WDTFR+2
  908. MVBR:   INX   H             ;HL= DESTIN BR CHAR ADDR
  909.         XCHG
  910.         MVI   A,0DH         ;   REPLACE WITH 0DH
  911.         MOV   M,A
  912.         INX   H             ;HL= SOURCE BR CHAR ADDR+1
  913.         XCHG
  914.         XRA   A             ; SET RETURN FLAG
  915.         RET
  916. ;
  917. ; GET CONTROL WORD IN 'WORD'
  918. ;   REPLACES FINAL Y OR N WITH 0DH
  919. ;   ENTER:   HL = SOURCE ADDR
  920. ;
  921. GETCTL: LXI   D,WORD        ;  DESTIN ADDR
  922.         CALL  WDTFR         ;MOVE WORD
  923.         MOV   A,C           ;   GET COUNT
  924.         CPI   3             ;IF < 3 CHARS MOVED
  925.         RM                  ;  THEN RETURN
  926.         MOV   H,D           ;   ADDR WORD
  927.         MOV   L,E
  928.         DCX   H             ;AVOID COLON
  929.         DCX   H
  930.         CALL  GETLCH        ;GET LAST CHAR
  931.         CPI   'Y'           ;IF Y
  932.         JZ    YNOUT         ;  THEN REMOVE IT
  933.         CPI   'N'           ;IF NOT N
  934.         RNZ                 ;  THEN RETURN
  935. YNOUT:  MVI   A,0DH         ;   REPLACE Y OR N
  936.         MOV   M,A           ;     WITH 0DH
  937.         RET
  938. ;
  939. ; SAVE OP CODE THROUGH COLON IN LASTOP
  940. ;
  941. SAVOP:  MVI   B,':'
  942.         CALL  INDX          ;COUNT CHARS TO COLON
  943.         LHLD  LLSAV         ;ADDR OP CODE
  944.         LXI   D,LASTOP
  945.         CALL  BLKTFR        ;MOVE CHAR STRING
  946.         RET
  947. ;
  948. ; COUNT LINE
  949. ;   ENTER:   HL=SOURCE ADDR
  950. ;   RETURNS: C=CHAR COUNT INCL 0DH OR 01
  951. ;            HL=BREAK POS., A=BR CHAR
  952. ;
  953. CNTLN:  MVI   C,1           ;  COUNT=1
  954.         MOV   A,M           ;   GET CHARACTER
  955.         CPI   0DH           ; IF 0DH
  956.         RZ                  ;   C=CHAR COUNT
  957.         CPI   1             ;IF 01
  958.         RZ                  ;  C=CHAR COUNT
  959.         MOV   A,C           ;   GET COUNT
  960.         ADI   1             ;C=C+1
  961.         MOV   C,A           ;      STORE IT
  962.         INX   H             ;HL=NEXT
  963.         JMP   CNTLN+2       ;NEXT CHAR
  964. ;
  965. ; BACKUP-- DECREMENTS HL BY VALUE OF C-1
  966. ;   ENTER:   HL START VALUE, C=COUNT
  967. ;   RETURNS: NEW HL VALUE
  968. ;
  969. BACKUP: MOV   A,C           ;   GET COUNT
  970.         CPI   1             ;IF COUNT=1
  971.         RZ                  ;  THEN RETURN
  972.         SUI   1             ;C=C-1
  973.         MOV   C,A           ;      STORE C
  974.         DCX   H             ;HL=HL-1
  975.         JMP   BACKUP
  976. ;
  977. ; BREAK CHARACTER SEARCH
  978. ;   ENTER:   HL=CHAR ADDR
  979. ;   RETURNS: A, B = CHARACTER
  980. ;            IF BR CHAR THEN Z FLAG TRUE
  981. ;
  982. BRCHAR: MOV   A,M           ;   GET CHAR
  983.         MOV   B,A           ;   AND SAVE IT
  984.         CPI   ' '           ;CHECK FOR VARIOUS
  985.         RZ                  ;BREAK CHARACTERS
  986.         CPI   0DH           ;   END OF LINE
  987.         RZ
  988.         CPI   ','
  989.         RZ
  990.         CPI   ';'
  991.         RZ
  992.         CPI   ':'
  993.         RZ
  994.         CPI   '.'
  995.         RZ
  996.         CPI   '?'
  997.         RZ
  998.         CPI   21H           ;EXCLAMATION
  999.         RZ
  1000.         CPI   '"'           ;DOUBLE QUOTE
  1001.         RZ
  1002.         CPI   '('           ;L PARENS
  1003.         RZ
  1004.         CPI   ')'           ;R PARENS
  1005.         RZ
  1006.         CPI   27H           ;APOSTROPHE
  1007.         RZ
  1008.         CPI   1             ;END OF LIST
  1009.         RET                 ;BR CHAR NOT FOUND
  1010. ;
  1011. ; INDEX - FIND CHAR POSITION OF MATCHED STRING
  1012. ;    ENTER: HLSAV = STRING ADDR, HLLSAVE = SUBSTR ADDR
  1013. ;    RETURNS: C = CHAR POS OF MATCH, IF NOMATCH, C=0
  1014. ;             HLSAV = STRING ADDR OF FIRST MATCHED CHAR
  1015. ;             EPTR = ADDR OF NEXT CHAR AFTER MATCH
  1016. ;
  1017. INDEX:  XRA   A
  1018.         STA   SCNT          ;INIT STRING COUNT
  1019. INDE2:  LHLD  HLSAV         ;ADDR STRING
  1020.         XCHG                ;DE = STRING ADDR
  1021.         LHLD  HLLSAV        ;ADDR SUBSTRING
  1022.         MOV   B,M           ;FIRST SUBSTR CHAR IN B
  1023.         INX   H             ;ADDR STRING
  1024.         XCHG
  1025.         CALL  INDX          ;LOOK FOR FIRST CHAR
  1026.         MOV   A,C
  1027.         ORA   A             ; IF NOT FOUND
  1028.         RZ                  ;  THEN RETURN
  1029.         SHLD  HLSAV         ;  ELSE SAVE POINTER
  1030.         LDA   SCNT          ;GET OLD STRING COUNT
  1031.         ADD   C             ;ADD NEW COUNT
  1032.         STA   SCNT          ;  IN SCNT
  1033.         LHLD  HLLSAV        ;ADDR SUBSTR
  1034.         CALL  CNTLN         ;COUNT SUBSTR CHARS
  1035.         MOV   A,C           ;   REDUCE COUNT TO
  1036.         SUI   1             ;  ALPHA CHARS
  1037.         MOV   C,A
  1038.         LXI   D,WORD        ;  MOVE SAME NUMBER OF
  1039.         LHLD  HLSAV         ;  CHARS FROM STRING
  1040.         CALL  BLKTFR        ;  TO 'WORD'
  1041.         SHLD  EPTR          ;SAVE NEXT CHAR ADDR
  1042.         XCHG                ;ADDR END OF 'WORD'
  1043.         MVI   A,0DH         ;   TERMINATE WITH 0DH
  1044.         MOV   M,A
  1045.         LHLD  HLLSAV        ;ADDR SUBSTR
  1046.         XCHG                ;DE = SUBSTR ADDR
  1047.         LXI   H,WORD        ;  ADDR PORTION OF STRING
  1048.         CALL  CMPR          ;COMPARE THEM
  1049.         ORA   A             ; IF FOUND
  1050.         JNZ   SETCNT        ;  THEN SET POSITION COUNT
  1051.         LHLD  HLSAV         ;  ELSE GET STRING POINTER
  1052.         INX   H             ;  BUMP IT
  1053.         SHLD  HLSAV         ;  SAVE IT
  1054.         JMP   INDE2         ;  AND TRY AGAIN
  1055. SETCNT: LXI   H,SCNT        ;  PUT STRING COUNT IN C
  1056.         MOV   C,M
  1057.         RET                 ;    AND RETURN
  1058. ;
  1059. ; INDX - FIND CHARACTER POSITION OF SINGLE LETTER
  1060. ;    ENTER:    HL = STRING ADDR, B= CHAR
  1061. ;    RETURNS:  C = CHAR POS OF MATCH, IF NOMATCH, C=0
  1062. ;              HL = ADDR OF MATCHED CHAR OR EOL
  1063. ;
  1064. INDX:   MVI   C,1           ;  INIT C REGISTER
  1065.         MOV   A,M           ;   GET CHAR
  1066.         CMP   B             ;IF B-CHAR FOUND
  1067.         RZ                  ;  THEN RETURN
  1068.         CPI   0DH           ; IF END OF LINE
  1069.         JZ    ZC            ;  THEN ZERO COUNT
  1070.         MOV   A,C           ;     ELSE
  1071.         ADI   1             ;  BUMP COUNT
  1072.         MOV   C,A
  1073.         INX   H             ;  BUMP ADDR
  1074.         JMP   INDX+2        ;  GO TO NEXT
  1075. ZC:     XRA   A             ; RETURN WITH
  1076.         MOV   C,A           ;        C = 0
  1077.         RET
  1078. ;
  1079. ; SINDX - SPECIAL INDEX FOR POSITION OF $ OR #
  1080. ;    ENTER:   HL = STRING ADDRESS
  1081. ;    RETURNS: BA = $, #, OR 0DH;  C = CHAR POS
  1082. ;             HL = ADDR OF MATCHED CHAR
  1083. ;
  1084. SINDX:  MVI   C,1           ;  INIT C REGISTER
  1085.         MOV   A,M           ;   GET CHAR
  1086.         CPI   '$'           ;IF $
  1087.         RZ                  ;  THEN RETURN
  1088.         CPI   043O          ;IF #
  1089.         RZ                  ;  THEN RETURN
  1090.         CPI   0DH           ; IF EOL
  1091.         RZ                  ;  THEN RETURN
  1092.         MOV   A,C           ;   ELSE
  1093.         ADI   1             ;BUMP COUNT
  1094.         MOV   C,A
  1095.         INX   H             ;BUMP ADDR
  1096.         JMP   SINDX+2       ;GO TO NEXT
  1097. ;
  1098. ; LETTER TESTS WHETHER CHARACTER IS UPCASE A-Z
  1099. ;    ENTER:   HL = ADDR OF CHAR
  1100. ;    RETURNS: ZERO FLAG TRUE IF IT IS
  1101. ;             B = CHARACTER
  1102. ;
  1103. LETTER: MOV   A,M           ;   GET CHAR
  1104.         MOV   B,M           ;   SAVE IN B
  1105.         CPI   41H           ;CHECK RANGE
  1106.         JM    NOTL          ;TOO LOW?
  1107.         CPI   5AH
  1108.         JP    NOTL          ;TOO HIGH?
  1109.         XRA   A             ;   ELSE RESET ZERO FLAG
  1110.         RET                 ;  AND RETURN IF LETTER
  1111. NOTL:   ORA   H             ; RETURN IF NOT LETTER
  1112.         RET
  1113. ;
  1114. ; SETUP GETS CHAR COUNT AND SETS ADDR FOR TEXT MOVES
  1115. ;
  1116. SETUP:  CALL  CNTLN         ;C=CHAR COUNT
  1117.         MOV   B,C           ;   SAVE COUNT
  1118.         CALL  BACKUP        ;RESET HL
  1119.         MOV   C,B           ;   RESET COUNT
  1120.         RET
  1121. ;
  1122. ; T OPERATION--DISPLAY 'T' STATEMENT
  1123. ;   ENTER:   HLSAV= FIRST CHAR OF T EXPRESSION FIELD
  1124. ;
  1125. TOP:    LHLD  HLSAV         ;RETRIEVE POINTER
  1126.         SHLD  CPTR          ;SAVE CHAR POINTER
  1127.         SHLD  LLSAV         ;SAVE FIRST CHAR ADDR
  1128.         LXI   H,TSAVE       ;  DESTIN START ADDR
  1129.         SHLD  DESAV         ;SAVE DESTIN ADDR
  1130.         XCHG                ;AND KEEP IN DE
  1131. TMORE:  LHLD  CPTR          ;GET CHAR POINTER
  1132.         CALL  SINDX         ;LOOK FOR $ OR #
  1133.         CPI   '$'           ;IF $ FOUND
  1134.         JZ    GETXT         ;  THEN GET LABELED TEXT
  1135.         CPI   043O          ;IF # FOUND
  1136.         JZ    GETNUM        ;  THEN GET NUMBER
  1137.         JMP   TMOVE         ;ELSE MOVE REST OF TEXT
  1138. GETXT:  CALL  INSERT        ;INSERT TEXT
  1139.         CPI   1             ;IF FOUND (A NOT 01)
  1140.         JNZ   TMORE         ;  THEN CONTINUE
  1141.         LXI   D,TSAVE       ;  ELSE DISPLAY THE LINE
  1142.         LHLD  LLSAV
  1143.         JMP   TALL
  1144. GETNUM: CALL  INSNUM        ;INSERT NUMBER
  1145.         JMP   GETXT+3       ;  AND SEE IF FOUND
  1146. TMOVE:  LHLD  DESAV         ;DESTIN ADDR
  1147.         XCHG
  1148.         LHLD  CPTR          ;ADDRESS INPUT
  1149. TALL:   CALL  SETUP         ;C = CHAR COUNT
  1150.         CALL  BLKTFR        ;MOVE T-TEXT
  1151.         MVI   A,0DH         ;   TERMINATE
  1152.         XCHG
  1153.         MOV   M,A
  1154.         LXI   H,TSAVE       ;  ADDRESS TEXT
  1155.         CALL  DSPLY         ;DISPLAY T STATEMENT
  1156.         XRA   A             ; SET RETURN FLAG
  1157.         RET
  1158. ;
  1159. ; INSERT NUMERIC VALUE INTO T-STATEMENT
  1160. ;    ENTER:   C = POSITION OF '#'
  1161. ;    RETURNS: TSAVE CONTAINS ASSEMBLED T-TEXT
  1162. ;             IF LABEL NOT FOUND, THEN A = 01
  1163. ;
  1164. INSNUM: MOV   A,C           ;   GET POSITION OF #
  1165.         SUI   1             ;REDUCE COUNT BY 1
  1166.         JZ    VBL           ;IF 0 THEN GET VARIABLE
  1167.         MOV   C,A
  1168.         LHLD  DESAV         ;DESTIN ADDR
  1169.         XCHG
  1170.         LHLD  CPTR          ;GET CHAR POINTER
  1171.         CALL  BLKTFR        ;MOVE FRONT OF TEXT
  1172. VBL:    MOV   B,H
  1173.         MOV   C,L
  1174.         XCHG
  1175.         SHLD  DESAV         ;SAVE DESTIN POINTER
  1176.         MOV   H,B           ;   GET CHAR POINTER
  1177.         MOV   L,C
  1178.         INX   H             ;BUMP TO VAR NAME
  1179.         MOV   C,M           ;   SAVE NAME IN C
  1180.         INX   H             ;BUMP ADDR
  1181.         SHLD  CPTR          ;SAVE CHAR POINTER
  1182.         MOV   B,C           ;   PUT VAR NAME IN B
  1183.         CALL  VARMCH        ;LOOK UP VAR NAME
  1184.         CPI   1             ;IF NOT FOUND (A = 01)
  1185.         RZ                  ;  THEN RETURN
  1186.         INX   H             ;ELSE POINT AT VALUE
  1187.         MOV   E,M           ;   GET VALUE IN E
  1188.         LXI   H,WORD        ;  PUT DIGITS IN WORD
  1189.         CALL  PUTNM
  1190.         LHLD  DESAV         ;DESTIN ADDR
  1191.         XCHG
  1192.         LXI   H,WORD        ;  DIGIT CHAR ADDR
  1193.         CALL  SETUP         ;C = CHAR COUNT+1
  1194.         MOV   A,C
  1195.         SUI   1
  1196.         MOV   C,A           ;      C = CHAR COUNT
  1197.         CALL  BLKTFR        ;MOVE DIGITS
  1198.         XCHG
  1199.         SHLD  DESAV         ;SAVE DESTIN ADDR
  1200.         XRA   A             ; SET RETURN FLAG
  1201.         RET
  1202. ;
  1203. ; INSERT LABELED TEXT INTO T-STATEMENT
  1204. ;    ENTER:   C = POSITION OF '$'
  1205. ;    RETURNS: TSAVE CONTAINS ASSEMBLED T-TEXT
  1206. ;             IF LABEL NOT FOUND, THEN A = 01
  1207. ;
  1208. INSERT: MOV   A,C           ;   GET POSITION COUNT
  1209.         SUI   1             ;REDUCE COUNT BY 1
  1210.         JZ    LBL           ;IF 0 THEN POINT TO LABEL
  1211.         MOV   C,A
  1212.         LHLD  DESAV         ;DESTIN ADDR
  1213.         XCHG
  1214.         LHLD  CPTR          ;GET CHAR POINTER
  1215.         CALL  BLKTFR        ;MOVE FRONT OF TEXT
  1216. LBL:    MOV   B,H           ; SAVE CHAR POINTER IN BC
  1217.         MOV   C,L
  1218.         XCHG
  1219.         SHLD  DESAV         ;SAVE DESTIN POINTER
  1220.         MOV   H,B           ;   GET CHAR POINTER
  1221.         MOV   L,C
  1222.         CALL  GETWD         ;GET LABEL
  1223.         DCX   H             ;ADDR BR CHAR
  1224.         SHLD  CPTR          ;SAVE CHAR POINTER
  1225.         LHLD  APTR          ;HL = START OF LIST
  1226.         INX   H
  1227.         CALL  LOOKS         ;LOOK FOR STRING NAME
  1228.         CPI   1             ;IF NOT FOUND (A = 01)
  1229.         RZ                  ;  THEN RETURN
  1230.         CALL  GETA          ;  ELSE GET A-TEXT
  1231.         RET
  1232. ;
  1233. ; GET A-TEXT POINTED TO BY MATCHED LABEL
  1234. ;    ENTER:   HL = BLANK AFTER MATCHED LABEL
  1235. ;             DESAV = DESTIN ADDRESS
  1236. ;    RETURNS: A-TEXT MOVED TO DESTINATION
  1237. ;             DESAV = NEXT DESTIN ADDRESS
  1238. ;
  1239. GETA:   INX   H             ;ADDR FIRST A-CHAR
  1240.         MOV   B,H           ;   BC = A-TEXT ADDR
  1241.         MOV   C,L
  1242.         LHLD  DESAV         ;DESTIN ADDR
  1243.         XCHG
  1244.         MOV   H,B           ;   HL = A-TEXT ADDR
  1245.         MOV   L,C
  1246.         CALL  SETUP         ;C = CHAR COUNT
  1247.         MOV   A,C           ;   REDUCE COUNT TO
  1248.         SUI   1             ;  EXCLUDE MOVE OF 0DH
  1249.         MOV   C,A
  1250.         CALL  BLKTFR        ;MOVE A-TEXT
  1251.         XCHG
  1252.         SHLD  DESAV         ;SAVE DESTIN POINTER
  1253.         XRA   A             ; SET RETURN FLAG
  1254.         RET
  1255. ;
  1256. ; A OPERATION-- ACCEPT INPUT
  1257. ;   ENTER:    HLSAV = ADDR AFTER COLON
  1258. ;   RETURNS:  INPUT IN EBUFF
  1259. ;   'CTL Z' ALLOWS SINGLE STATEMENT EXECUTION OR QUIT
  1260. ;
  1261. AOP:    LHLD  HLSAV         ;ADDR EXPRESSION
  1262.         CALL  GETCH         ;GET FIRST CHAR
  1263.         CPI   '$'           ;IF NOT $
  1264.         JNZ   NIN           ;  THEN LOOK FOR #
  1265.         LXI   D,LABSAV      ;  ELSE ADDR DESTIN
  1266.         CALL  WDTFR         ;  SAVE THE LABEL
  1267.         CALL  ENTRY         ;GET THE ENTRY
  1268.         CALL  ASTORE        ;  STORE IT
  1269.         RET                 ;  THEN EXIT
  1270. NIN:    CPI   043O          ;IF NOT #
  1271.         JNZ   CENT          ;  THEN CALL ENTRY
  1272.         INX   H             ;ELSE ADDR VARIABLE
  1273.         MOV   A,M           ;   GET THE NAME
  1274.         STA   VARSAV        ;AND SAVE IT
  1275.         CALL  ENTRY         ;GET THE ENTRY
  1276.         CALL  CKNUM         ;REQUIRE NUMERIC
  1277.         CALL  NSTORE        ;  STORE THE NUMBER
  1278.         RET                 ;THEN EXIT
  1279. CENT:   CALL  ENTRY
  1280.         RET
  1281. ;
  1282. ENTRY:  CALL  KEYIN         ;GET ONE LINE IN EBUFF
  1283.         LXI   H,EBUFF       ;IF ENTRY NOT CTL Z
  1284.         MOV   A,M
  1285.         CPI   1AH
  1286.         RNZ                 ;THEN RETURN
  1287.         INX   H             ;ELSE BUMP POINTER
  1288.         MOV   A,M           ;GET CHAR
  1289.         CPI   0DH           ;IF CR
  1290.         JZ    RSTRT         ;  THEN RESTART
  1291.         CALL  OPS           ;ELSE DO IMMED OP
  1292.         JMP   ENTRY         ;  AND ACCEPT MORE INPUT
  1293. ;
  1294. CKNUM:  CPI   '0'           ;CHECK FOR NUMBER
  1295.         JM    NERR          ;TOO LOW
  1296.         CPI   '9'+1
  1297.         RM                  ;MUST BE NUMBER
  1298. NERR:   LXI   H,NMSG        ;OUT OF RANGE
  1299.         CALL  ERROR         ;SEND MESSAGE
  1300.         CALL  ENTRY         ;TRY AGAIN
  1301.         JMP   CKNUM
  1302. ;
  1303. ; A ITEM STORE - STORAGE OF LABELED TEXT FROM ENTRY
  1304. ;    FROM TOP OF INPUT BUFFER AREA AND SETS POINTER
  1305. ;
  1306. ASTORE: LXI   H,EBUFF       ;  SOURCE ADDR
  1307.         CALL  CNTLN         ;C = CHAR COUNT
  1308.         MOV   B,C           ;   DUPL COUNT IN B
  1309.         LHLD  APTR          ;LAST A-ADDR
  1310.         CALL  DECA          ;BACK UP DESTIN ADDRESS
  1311.         MOV   A,C           ;   IF CHAR COUNT = 0
  1312.         ORA   A
  1313.         RZ                  ;  THEN RETURN
  1314.         LXI   H,EBUFF       ;  SOURCE ADDR
  1315.         CALL  BLKTFR        ;MOVE TEXT
  1316.         LXI   H,LABSAV      ;  ADDR LABEL
  1317.         CALL  CNTLN         ;C = CHAR COUNT
  1318.         MOV   B,C           ;   DUPL COUNT IN B
  1319.         LHLD  APTR          ;GET A-POINTER
  1320.         CALL  DECA          ;BACK UP ADDR
  1321.         MOV   A,C           ;   IF CHAR COUNT = 0
  1322.         ORA   A
  1323.         RZ                  ;  THEN RETURN
  1324.         LXI   H,LABSAV      ;  SOURCE ADDR
  1325.         CALL  BLKTFR        ;MOVE THE LABEL
  1326.         MOV   L,E           ;   ADDR A-TEXT
  1327.         MOV   H,D
  1328.         DCX   H             ;BACK UP ONE CHAR
  1329.         MVI   A,' '         ;AND SET
  1330.         MOV   M,A           ;     BLANK THERE
  1331.         RET
  1332. ;
  1333. ; DECREMENT ADDRESS FOR TEXT STORAGE
  1334. ;    ENTER:  HL = LAST (LOWEST) ADDRESS USED (01)
  1335. ;            B & C = CHAR COUNT IN WORD TO BE MOVED
  1336. ;    RETURNS:DE = DESTIN ADDR,  C = CHAR COUNT
  1337. ;       APTR POINTS AT STOP(01) BELOW LIST
  1338. ;
  1339. DECA:   MOV   E,L           ;DESTIN ADDR IN DE
  1340.         MOV   D,H
  1341.         DCX   H             ;DECR POINTER
  1342.         MOV   A,M           ;   GET CHARACTER
  1343.         CPI   1             ;IF 01 (END OF SPACE)
  1344.         JZ    STOVF         ;  THEN STORAGE OVERFLOW
  1345.         MOV   A,B           ;      DECR COUNT
  1346.         SUI   1
  1347.         MOV   B,A
  1348.         JNZ   DECA          ;BACK UP AGAIN?
  1349.         SHLD  APTR          ;SAVE A-POINTER
  1350.         MVI   M,1           ;SET STOP
  1351.         RET
  1352. ;
  1353. STOVF:  LXI   H,NRMSG       ;  COMPLAIN OF OVERFLOW
  1354.         CALL  ERROR
  1355.         MVI   C,0           ;  SET CHAR COUNT = 0
  1356.         RET
  1357. ;
  1358. ; NUMBER STORAGE - STORAGE OF NUMERIC VALUE FROM ENTRY
  1359. ;             AS VALUE OF VARIABLE NAME IN A-STATEMENT
  1360. ;
  1361. NSTORE: LXI   H,EBUFF       ;  SOURCE ADDR
  1362.         CALL  GETCH         ;ADDR 1ST CHAR
  1363.         CALL  GETNM         ;GET THE NUMBER
  1364.         LXI   H,VARSAV      ;  GET THE NAME IN B
  1365.         MOV   B,M
  1366.         CALL  VARMCH        ;LOOK IT UP
  1367.         CPI   1             ;IF END MARKER
  1368.         CZ    BADFRM        ;THEN COMPLAIN
  1369.         RZ                  ;  AND RETURN
  1370.         INX   H             ;  ELSE BUMP TO NEXT
  1371.         MOV   M,E
  1372.         RET
  1373. ;
  1374. ; M OPERATION - MOVING WINDOW STRING MATCH
  1375. ;    COMPARE ITEMS IN LIST WITH LAST INPUT
  1376. ;      M-ITEMS HAVE MULTIPLE BLANKS REDUCED TO ONE
  1377. ;      INPUT HAS BLANK ADDED AT EACH END AND
  1378. ;      MULTIPLE BLANKS REDUCED TO ONE.
  1379. ; ENTER: HLSAV = ADDR AFTER LAST COLON, INPUT IN EBUFF
  1380. ; RETURNS: YNSW = 0 IF MATCH NOT FOUND WITH LAST ENTRY
  1381. ;
  1382. MC:     LXI   H,MBRCH       ;SET BR CHAR
  1383.         MVI   M,'^'         ;  TO CARET (SHIFT N)
  1384.         JMP   MOP1
  1385. MOP:    LXI   H,MBRCH       ;SET BR CHAR TO COMMA
  1386.         MVI   M,','
  1387. MOP1:   LHLD  HLSAV         ;ADDR EXPRESSION FIELD
  1388.         SHLD  MPTR          ;INIT M-POINTER
  1389. NEXTM:  CALL  MMOV          ;MSAVE = M-ITEM
  1390.         LHLD  MPTR          ;ADDR M-ITEM
  1391.         SHLD  HLSAV
  1392.         CALL  SQUEZ         ;REDUCE MULTIPLE BLANKS
  1393.         LXI   H,EBUFF
  1394.         SHLD  HLSAV         ;HLSAV = STRING ADDR
  1395.         CALL  PAD           ;ADD BLANKS AT EACH END
  1396.         CALL  SQUEZ         ;REDUCE MULTIPLE BLANKS
  1397.         LXI   H,EBUFF       ;  PUT EBUFF ADDR
  1398.         SHLD  HLSAV         ;  IN HLSAV
  1399.         LXI   H,MSAVE       ;  PUT MSAVE ADDR
  1400.         SHLD  HLLSAV        ; IN HLLSAV
  1401.         CALL  INDEX         ;LOOK FOR M-ITEM
  1402.         MOV   A,C
  1403.         ORA   A             ; IF ITEM FOUND
  1404.         CNZ   SWY           ;  THEN SET SWITCH YES
  1405.         RNZ                 ;  AND RETURN
  1406.         LHLD  MPTR          ;RETRIEVE M-POINTER
  1407.         DCX   H             ;ADDR BR CHAR
  1408.         MOV   A,M           ;   IF END OF LINE
  1409.         CPI   0DH
  1410.         JZ    MDONE         ;  THEN QUIT
  1411.         INX   H             ;ADDR NEXT CHAR
  1412.         MOV   A,M           ;   IF END OF LINE
  1413.         CPI   0DH
  1414.         JZ    MDONE         ;  THEN QUIT
  1415.         JMP   NEXTM         ;ELSE MORE M-ITEMS
  1416. MDONE:  CALL  SWN           ;SET SWITCH NO
  1417.         RET
  1418. ;
  1419. SWY:    ORA   H             ; SET YN SWITCH YES
  1420.         STA   YNSW
  1421.         RET
  1422. ;
  1423. SWN:    XRA   A             ; SET YN SWITCH NO
  1424.         STA   YNSW
  1425.         RET
  1426. ;
  1427. ; M-MOVE: MOVE M-ITEM TO MSAVE
  1428. ;   ITEMS ARE SEPARATED BY COMMA OR TERMINATED BY 0DH
  1429. ;   ENTER:   MPTR = M-ITEM ADDRESS
  1430. ;   RETURNS: HL & MPTR = NEXT M-ITEM ADDR
  1431. ;            B = BR CHAR
  1432. ;
  1433. MMOV:   LHLD  MPTR          ;GET M-POINTER
  1434.         LXI   D,MSAVE       ;  DESTIN ADDR
  1435. MMOV2:  CALL  MBR           ;IF BR CHAR OR EOL
  1436.         JZ    SMOV          ;  THEN STOP THE MOVE
  1437.         INX   H
  1438.         XCHG                ;HL = DESTIN ADDR
  1439.         MOV   M,B           ;   MOVE CHAR
  1440.         INX   H
  1441.         XCHG                ;HL = NEXT SOURCE ADDR
  1442.         JMP   MMOV2         ;CHECK THE NEXT CHAR
  1443. SMOV:   INX   H
  1444.         XCHG                ;HL = DESTIN BR CHAR ADDR
  1445.         MVI   A,0DH         ;   PUT AN 0DH THERE
  1446.         MOV   M,A
  1447.         INX   H
  1448.         XCHG                ;HL = NEXT M-ITEM ADDR
  1449.         SHLD  MPTR          ;SAVE M-POINTER
  1450.         RET
  1451. ;
  1452. ; M-BREAK CHAR BETWEEN ITEMS
  1453. ;    ENTER:   HL = CHAR ADDR
  1454. ;    RETURNS: A,B = CHAR.  IF BR CHAR THEN Z FLAG TRUE
  1455. ;
  1456. MBR:    MOV   A,M           ;   GET CHAR
  1457.         MOV   B,A           ;   SAVE IT
  1458.         CPI   0DH           ; IF EOL
  1459.         RZ                  ;  THEN RETURN
  1460.         LDA   MBRCH         ;GET CURRENT BR CHAR
  1461.         CMP   B
  1462.         RET
  1463. ;
  1464. ; PAD ADDS A BLANK TO EACH END OF A STRING
  1465. ;   ENTER:   HLSAV = STRING ADDRESS
  1466. ;
  1467. PAD:    LXI   H,WORD
  1468.         MVI   A,' '         ;  SET BLANK AT FRONT OF
  1469.         MOV   M,A
  1470.         INX   H             ;DE = DESTIN ADDR
  1471.         XCHG
  1472.         LHLD  HLSAV         ;GET SOURCE ADDR
  1473.         CALL  CNTLN         ;C = CHAR COUNT
  1474.         LHLD  HLSAV         ;GET SOURCE ADDR
  1475.         CALL  BLKTFR        ;MOVE TEXT
  1476.         XCHG                ;ADDR NEW TEXT END
  1477.         DCX   H             ;SET BLANK AT
  1478.         MVI   A,' '         ;    END OF
  1479.         MOV   M,A           ;     TEMP STRING
  1480.         INX   H             ;SET EOL
  1481.         MVI   A,0DH
  1482.         MOV   M,A
  1483.         LHLD  HLSAV         ;MOVE NEW STRING
  1484.         XCHG                ;  TO ORIGINAL
  1485.         LXI   H,WORD        ;    LOCATION
  1486.         CALL  CNTLN
  1487.         LXI   H,WORD
  1488.         CALL  BLKTFR
  1489.         RET
  1490. ;
  1491. ; SQUEZ REDUCES MULTIPLE BLANKS TO A SINGLE BLANK
  1492. ;   ENTER:   HLSAV = STRING ADDRESS
  1493. ;
  1494. SQUEZ:  LHLD  HLSAV         ;ADDR STRING
  1495.         SHLD  HLLSAV        ;SAVE POINTER
  1496.         MOV   A,M           ;   GET CHAR
  1497. CKEOL:  CPI   0DH           ; IF EOL
  1498.         RZ                  ;  THEN RETURN
  1499.         CPI   ' '           ;IF BLANK
  1500.         JZ    CKNC          ;  THEN CHECK NEXT CHAR
  1501.         INX   H             ;ELSE BUMP ADDR
  1502.         JMP   SQUEZ+3       ;  AND CONTINUE
  1503. CKNC:   INX   H             ;IF NEXT CHAR IS
  1504. CKNC1:  MOV   A,M           ;     NOT BLANK
  1505.         CPI   ' '           ;  THEN CHECK IF EOL
  1506.         JNZ   CKEOL
  1507.         SHLD  HLLSAV        ;ELSE SAVE ADDRESS
  1508.         CALL  SHIFT         ;  REMOVE A BLANK
  1509.         LHLD  HLLSAV        ;  RETRIEVE ADDRESS
  1510.         JMP   CKNC1         ;  AND CONTINUE
  1511. ;
  1512. ; SHIFT STRING CHARS LEFT WITH LOSS OF FIRST CHAR
  1513. ;   ENTER:   HL = ADDR OF STRING
  1514. ;   RETURNS: HL = ADDR OF 0DH
  1515. ;
  1516. SHIFT:  INX   H             ;ADDR NEXT CHAR
  1517.         MOV   B,M           ;   GET IT IN B
  1518.         DCX   H             ;MOVE IT
  1519.         MOV   M,B
  1520.         MOV   A,M
  1521.         CPI   0DH           ; IF IT WAS EOL
  1522.         RZ                  ;  THEN RETURN
  1523.         INX   H             ;  ELSE MOVE ANOTHER
  1524.         JMP   SHIFT
  1525. ;
  1526. ; C OPERATION:  COMPUTE WITH TEXT OF STATEMENT
  1527. ;    LIMITED TO: X = NN  (NN = INTEGER -99 TO +99)
  1528. ;                OR X = X + NN  OR X = X - NN
  1529. ;                OR X = X + X   OR X = X - X
  1530. ;      WHERE X = SINGLE LETTER VARIABLE NAME A-Z
  1531. ;           FIRST LETTER ONLY OF LONGER NAME GETS USED
  1532. ;    ENTER:   HLSAV = ADDR OF EXPRESSION FIELD
  1533. ;
  1534. COP:    LHLD  HLSAV         ;ADDR EXPRESSION FIELD
  1535.         MVI   B,'='         ;  LOOK FOR EQUAL SIGN
  1536.         CALL  INDX
  1537.         MOV   A,C
  1538.         ORA   A             ; IF NOT PRESENT
  1539.         JZ    EXMSG         ;  THEN COMPLAIN
  1540.         INX   H             ;BUMP POINTER
  1541.         CALL  GETCH         ;GET THE CHAR
  1542.         CPI   '-'           ;IF NOT MINUS SIGN
  1543.         JNZ   CGVAL         ;  THEN GET THE VALUE
  1544.         SHLD  HLLSAV        ;SAVE THE POINTER
  1545.         XRA   A
  1546.         STA   TEMP          ;SET TEMP = 0
  1547.         LHLD  HLLSAV        ;RETRIEVE POINTER
  1548.         JMP   SUBV          ;  AND SUBTRACT
  1549. CGVAL:  CALL  GVALUE        ;GET THE VALUE
  1550.         LXI   H,TEMP        ;  SAVE IT
  1551.         MOV   M,E
  1552.         LHLD  CPTR          ;RETRIEVE CHAR POINTER
  1553.         INX   H             ;BUMP POINTER
  1554.         CALL  GETCH         ;GET CHAR
  1555.         CPI   0DH           ; IF END OF LINE
  1556.         JZ    AVAL          ;  THEN ASSIGN VALUE
  1557.         CPI   '-'           ;IF MINUS
  1558.         JZ    SUBV          ;  THEN SUBTRACT VALUE
  1559.         CPI   '+'           ;IF PLUS
  1560.         JZ    ADDV          ;  THEN ADD VALUE
  1561.         CALL  GVALUE        ;ELSE GET VALUE
  1562.         JMP   AVAL          ;ASSIGN VALUE
  1563. ADDV:   INX   H             ;BUMP POINTER
  1564.         CALL  GVALUE        ;GET THE VALUE
  1565.         LDA   TEMP          ;GET OLD VALUE
  1566.         ADD   E             ;ADD VALUES
  1567.         CPI   100           ;IF > 99
  1568.         JP    OVMSG         ;  THEN COMPLAIN
  1569.         MOV   E,A           ;      ELSE FORM NEW VALUE
  1570.         JMP   AVAL          ;ASSIGN VALUE
  1571. SUBV:   INX   H             ;BUMP POINTER
  1572.         CALL  GVALUE        ;GET THE VALUE
  1573.         LDA   TEMP          ;GET OLD VALUE
  1574.         SUB   E             ;SUBTRACT VALUES
  1575.         CPI   9DH           ;IF >= -99
  1576.         JP    AVAL-1        ;  THEN CONTINUE
  1577.         CPI   100           ;IF > 99
  1578.         JP    UNMSG         ;  THEN COMPLAIN
  1579.         MOV   E,A
  1580. AVAL:   CALL  ASSIGN
  1581.         RET
  1582. ;
  1583. EXMSG:  CALL  TOP           ;SHOW THE BAD EXPR
  1584.         LXI   H,EXPMSG
  1585.         CALL  ERROR
  1586.         RET
  1587. ;
  1588. OVMSG:  MVI   E,99          ;  SET VALUE TO 99
  1589.         CALL  ASSIGN
  1590.         CALL  TOP           ;SHOW THE EXPR
  1591.         LXI   H,OVFMSG
  1592.         CALL  ERROR
  1593.         RET
  1594. ;
  1595. UNMSG:  MVI   E,9DH         ;  SET VALUE TO -99
  1596.         CALL  ASSIGN
  1597.         CALL  TOP
  1598.         LXI   H,UNFMSG
  1599.         CALL  ERROR
  1600.         RET
  1601. ;
  1602. ; GVALUE - GETS VALUE OF CONSTANT OR VARIABLE
  1603. ;    ENTER:   HL = ADDRESS OF CHAR NAMING THE VARIABLE
  1604. ;             CPTR = ADDRESS OF CHAR
  1605. ;    RETURNS: E = VALUE
  1606. ;             CPTR = ADDRESS OF THE CHARACTER
  1607. ;
  1608. GVALUE: CALL  GETCH         ;GET CHAR
  1609.         MOV   E,A           ;      SAVE IN E
  1610.         CALL  LETTER        ;IF LETTER
  1611.         JZ    LTR           ;  THEN PROCEED
  1612.         CALL  GETNM         ;ELSE EXPECT NUMBER
  1613.         SHLD  CPTR          ;SAVE CHAR POINTER
  1614.         RET
  1615. LTR:    SHLD  CPTR          ;SAVE CHAR POINTER
  1616. CONV:   MOV   B,M           ;   SAVE CHAR IN B
  1617.         CALL  VARMCH        ;LOOK IT UP
  1618.         CPI   1             ;IF END MARKER
  1619.         CZ    BADFRM        ;  THEN COMPLAIN
  1620.         RZ                  ;  AND RETURN
  1621.         INX   H             ;ELSE POINT AT VALUE
  1622.         MOV   E,M           ;   SAVE VALUE IN E
  1623.         RET
  1624. ;
  1625. ; ASSIGN SETS A NEW VALUE TO AN OLD OR NEW VARIABLE
  1626. ;    ENTER:   HLSAV = ADDR OF EXPRESSION FIELD
  1627. ;             BINARY VALUE IN E
  1628. ;
  1629. ASSIGN: LHLD  HLSAV         ;ADDR EXPRESSION FIELD
  1630.         CALL  GETCH         ;GET FIRST CHAR
  1631.         CALL  LETTER        ;IF NOT A LETTER
  1632.         JNZ   EXMSG         ;  THEN COMPLAIN
  1633.         MOV   B,M           ;   GET CHAR IN B
  1634.         CALL  VARMCH        ;LOOK IT UP
  1635.         CPI   1             ;IF END MARKER
  1636.         CZ    BADFRM        ;  THEN COMPLAIN
  1637.         RZ                  ;  AND RETURN
  1638.         INX   H             ;  ELSE BUMP TO VALUE ADDR
  1639.         MOV   M,E
  1640.         RET                 ;  AND RETURN
  1641. ;
  1642. ; BASIC INTERPRETATION -
  1643. ;   IF PROGRAM TEXT IS NOT LEGAL PILOT, THEN
  1644. ;   AN ALTERNATE INTERPRETER SUCH AS BASIC CAN BE
  1645. ;   SUPPLIED TO BE TRIED BEFORE PILOT COMPLAINS.
  1646. ;
  1647. BASIC:  ORA   H             ;DUMMY ILLEGAL RETURN
  1648.         RET
  1649. ;
  1650. ; R OPERATION -
  1651. ;    ENTER:   HLSAV = R-STATEMENT ADDRESS
  1652. ;
  1653. ROP:    RET
  1654. ;
  1655. ; E OPERATION - RETURNS FROM CALL OR ENDS PROGRAM
  1656. ;
  1657. EOP:    LDA   LEVEL         ;IF RETURN LEVEL = 0
  1658.         ORA   A             ;   THEN QUIT
  1659.         JZ    RSTRT
  1660.         CALL  RESRET        ;  ELSE SET RETURN FROM
  1661.         RET                 ;  PILOT CALL
  1662. ;
  1663. LOAD:   LXI   H,PBUFF
  1664.         CALL  INPUT
  1665.         RET
  1666. ;
  1667. ; NEW$ DELETES $NAMES BY RESETTING A-POINTER
  1668. ;
  1669. NEWN:   LHLD  APTR          ;REMOVE STOP CHAR
  1670.         MVI   M,20H
  1671.         LHLD  MEMTP         ;ADDR MEMTP
  1672.         MVI   M,1           ;PLACE STOP CHAR
  1673.         DCX   H
  1674.         SHLD  APTR          ;STORE MEMTP-1 ADDRESS
  1675.         RET
  1676. ;
  1677. ; INITIALIZE NUMERIC VARIABLES
  1678. ;   SETS A-Z TO ZERO VALUE
  1679. ;
  1680. INITV:  LXI   H,NVAR        ;ADDR FRONT OF VAR LIST
  1681.         MVI   B,'A'         ;START WITH 'A'
  1682.         MOV   A,B
  1683. NV:     CPI   'Z'+1         ;IF ALPHABET COMPLETE
  1684.         RZ                  ;THEN RETURN
  1685.         MOV   M,A           ;   STORE THE LETTER
  1686.         INX   H             ;BUMP ADDRESS
  1687.         MVI   A,0
  1688.         MOV   M,A           ;   STORE ZERO
  1689.         INX   H             ;BUMP THE ADDRESS
  1690.         MOV   A,B           ;      GET LETTER
  1691.         ADI   1             ;CHANGE TO NEXT LETTER
  1692.         MOV   B,A           ;   SAVE IN B
  1693.         JMP   NV            ;NEXT VARIABLE
  1694. ;
  1695. ; SAVE RETURN POINTER IN STACK
  1696. ;    ENTER:   IPTR = START OF NEXT SOURCE LINE
  1697. ;    RETURNS: LEVEL BUMPED ONE HIGHER
  1698. ;             IPTR COPIED AT LEVEL POSITION
  1699. ;
  1700. SAVRET: LXI   H,LEVEL       ;GET CURRENT LEVEL
  1701.         MOV   A,M
  1702.         ADI   1             ;BUMP TO NEXT LEVEL
  1703.         CPI   8             ;IF < 8
  1704.         JM    SAV2          ;  THEN CONTINUE
  1705.         LXI   H,STMSG       ;ELSE STACK OVERFLOW
  1706.         CALL  ERROR
  1707.         RET
  1708. SAV2:   MOV   M,A           ;   STORE IT
  1709.         ADD   A             ;DOUBLE IT
  1710.         MOV   C,A           ;      SAVE IN C
  1711.         LHLD  IPTR          ;PUT IPTR IN DE
  1712.         XCHG
  1713.         LXI   H,RETSAV      ;  GET BASE ADDR
  1714.         MOV   A,L
  1715.         ADD   C             ;BASE + 2 X LEVEL
  1716.         MOV   L,A           ;      HL = STACK ADDR
  1717.         MOV   M,D           ;   SAVE IPTR
  1718.         ADI   1
  1719.         MOV   L,A           ;      HL = STACK ADDR+1
  1720.         MOV   M,E
  1721.         RET
  1722. ;
  1723. ; RESET RETURN POINTER FROM STACK
  1724. ;    RETURNS: IPTR SET TO LAST SAVED RETURN
  1725. ;             LEVEL REDUCED BY ONE
  1726. ;
  1727. RESRET: LDA   LEVEL         ;GET RETURN LEVEL
  1728.         ADD   A             ;DOUBLE IT
  1729.         MOV   C,A           ;      SAVE IN C
  1730.         LXI   H,RETSAV      ;  GET BASE ADDR
  1731.         MOV   A,L
  1732.         ADD   C             ;BASE + 2 X LEVEL
  1733.         MOV   L,A           ;      HL = STACK ADDR
  1734.         MOV   D,M           ;   SAVE POINTER IN DE
  1735.         ADI   1
  1736.         MOV   L,A           ;      HL = STACK ADDR+1
  1737.         MOV   E,M
  1738.         XCHG
  1739.         SHLD  IPTR          ;RESET IPTR
  1740.         LXI   H,LEVEL       ;REDUCE LEVEL
  1741.         MOV   A,M
  1742.         SUI   1
  1743.         MOV   M,A
  1744.         RET
  1745. ;
  1746. ; BLOCK TRANSFER FROM HL TO DE, C CHARACTERS
  1747. ;   RETURNS: HL AND DE AT LAST CHAR+1 ADDR
  1748. ;
  1749. BLKTFR: MOV   A,C           ;   GET COUNT
  1750.         ORA   A             ; IF COUNT = 0
  1751.         RZ                  ;  THEN RETURN
  1752.         MOV   B,M           ;   GET A SOURCE CHARACTER
  1753.         INX   H             ;GET NEXT DEST ADDR
  1754.         XCHG
  1755.         MOV   M,B           ;   PUT IT IN DEST LOCATION
  1756.         INX   H             ;GET NEXT SOURCE ADDR
  1757.         XCHG
  1758.         MOV   A,C           ;   DECREMENT COUNT
  1759.         SUI   1
  1760.         MOV   C,A
  1761.         JNZ   BLKTFR        ;IF NONZERO THEN NEXT
  1762.         RET
  1763. ;
  1764. ; KEYBOARD INPUT TO EBUFF
  1765. ;   ENTER:  CHMAX= MAXIMUM CHARS ALLOWED IN LINE
  1766. ;   DEL (SHIFT O) OR RUBOUT CANCELS LAST CHAR
  1767. ;   CTL/U CANCELS CURRENT LINE
  1768. ;   USES B FOR CHAR COUNT, C FOR OUTPUT
  1769. ;
  1770. KEYIN:  LXI   H,EBUFF       ;POINT AT EBUFF
  1771.         SHLD  EPTR          ;SAVE POINTER
  1772.         LXI   H,CHMAX       ;GET MAX COUNT
  1773.         MOV   B,M
  1774. KIN2:   LHLD  EPTR          ;RETRIEVE POINTER
  1775.         CALL  CI            ;GET CHAR AND ECHO
  1776.         CPI   5FH           ;IF DEL
  1777.         JZ    CANC          ;  THEN CANCEL LAST CHAR
  1778.         CPI   7FH           ;IF RUBOUT
  1779.         JZ    CANC          ;  THEN CANCEL LAST CHAR
  1780.         CPI   15H           ;IF CTL/U
  1781.         JZ    CANL          ;  THEN CANCEL LINE
  1782.         CPI   61H           ;FORCE UPPER CASE
  1783.         JM    NTR
  1784.         XRI   20H
  1785. NTR:    MOV   M,A           ;STORE THE CHAR
  1786.         INX   H             ;INCR POINTER
  1787.         SHLD  EPTR          ;SAVE IT
  1788.         CPI   0DH           ;IF CR
  1789.         JZ    KOUT          ;  THEN STOP ENTRY
  1790.         DCR   B             ;ELSE DECR CHAR COUNT
  1791.         MOV   A,B
  1792.         ORA   A             ;IF COUNT NOT 0
  1793.         JNZ   KIN2          ;  THEN NEXT CHAR
  1794.         MVI   C,0DH         ;ELSE END WITH CR
  1795.         MOV   M,C
  1796.         CALL  CO            ;  AND SEND IT
  1797. KOUT:   CALL  LF            ;SEND LINE FEED
  1798.         RET                 ;  AND RETURN
  1799. CANL:   MVI   C,3CH         ;SEND <
  1800.         CALL  CO 
  1801.         CALL  CRLF          ;SEND CRLF
  1802.         JMP   KEYIN         ;  START OVER
  1803. CANC:   MOV   A,B           ;INCR CHAR COUNT
  1804.         LXI   H,CHMAX       ;  UNLESS AT BEGINNING
  1805.         MOV   C,M
  1806.         CMP   C
  1807.         JZ    KIN2
  1808.         INR   B
  1809.         LHLD  EPTR
  1810.         DCX   H             ;DECR POINTER
  1811.         SHLD  EPTR
  1812.         JMP   KIN2+3
  1813. ;
  1814. CRLF:   MVI   C,0DH
  1815.         CALL  CO 
  1816. LF:     MVI   C,0AH
  1817.         CALL  CO 
  1818.         RET
  1819. ;
  1820. ; INPUT PROGRAM TO BUFFER AREA
  1821. ;   DEL (SHIFT O) CANCELS LAST CHAR, CTL/U CANCELS LINE
  1822. ;   TERMINATES WITH CTL/Z (1AH)
  1823. ;
  1824. INPUT:  CALL  BLKBF         ;BLANK THE BUFFER
  1825.         LXI   H,PBUFF       ;SET POINTER
  1826. INPT1:  MOV   A,M           ;GET EXISTING CHAR
  1827.         SHLD  LLSAV         ;SAVE FIRST CHAR ADDR
  1828.         CPI   1             ;IF END MARK
  1829.         JZ    CHOP          ;  THEN CHOP ENTRY
  1830.         CALL  RI            ;GET CHAR
  1831.         CPI   ' '           ;IF NOT BLANK
  1832.         JNZ   INPT3+3       ;  THEN CONTINUE
  1833.         JMP   INPT1         ;ELSE SKIP LEADING BLANK
  1834. INPT2:  MOV   A,M           ;GET EXISTING CHAR
  1835.         CPI   1             ;IF END MARK
  1836.         JZ    CHOP          ;  THEN CHOP ENTRY
  1837. INPT3:  CALL  RI            ;GET CHARACTER
  1838.         CPI   0             ;IGNORE NULLS
  1839.         JZ    INPT3
  1840.         CPI   7FH           ;IGNORE RUBOUTS
  1841.         JZ    INPT3
  1842.         CPI   1AH           ;IF TERM CHAR CTL/Z
  1843.         JZ    INEND         ;  THEN END OF INPUT
  1844.         CPI   15H           ;IF CTL/U
  1845.         JZ    KLN           ;  THEN KILL THE LINE
  1846.         CPI   5FH           ;IF DEL
  1847.         JZ    CLC           ;  THEN CANCEL LAST CHAR
  1848.         MOV   M,A           ;ELSE STORE THE CHAR
  1849.         INX   H             ;AND INCR THE POINTER
  1850.         CPI   0DH           ;IF NOT CR
  1851.         JNZ   INPT2         ;  THEN GET NEXT CHAR
  1852.         CALL  LF            ;ELSE SEND LF
  1853.         JMP   INPT1         ;AND GET NEXT NEW LINE
  1854. INPT4:  MOV   M,A           ;STORE CHAR
  1855.         INX   H             ;INCR POINTER
  1856.         JMP   INPT2
  1857. CLC:    DCX   H             ;CANCEL LAST CHAR
  1858.         JMP   INPT3
  1859. KLN:    MVI   C,3CH         ;SEND <
  1860.         CALL  CO 
  1861.         CALL  CRLF          ;SEND CRLF
  1862.         LHLD  LLSAV         ;ADDR FRONT OF LINE
  1863.         JMP   INPT3
  1864. CHOP:   LHLD  LLSAV         ;ADDR FRONT OF LINE
  1865.         CALL  DSPLY
  1866.         LXI   H,IOVMSG
  1867.         CALL  ERROR
  1868. INEND:  MVI   M,1           ;STORE END MARK
  1869.         SHLD  TOPP          ;STORE ADDRESS
  1870.         CALL  CRLF          ;SEND CRLF
  1871.         LXI   H,LEVEL       ;ZERO RETURN LEVEL
  1872.         MVI   M,0
  1873.         RET
  1874. ;
  1875. ; DISPLAY A CHARACTER STRING TO CR OR 01
  1876. ;   ENTER:  HL = STARTING ADDRESS
  1877. ;   OUTADR CONTAINS ADDRESS OF CO, LO, OR PO
  1878. ;
  1879. DSPLY:  MOV   A,M           ;GET A CHARACTER
  1880.         INX   H             ;BUMP POINTER
  1881.         MOV   D,H           ;SAVE IT
  1882.         MOV   E,L
  1883.         CPI   1             ;IF 01
  1884.         RZ                  ;  THEN RETURN
  1885.         MOV   C,A           ;PUT CHAR IN C
  1886.         LHLD  OUTADR        ;MAKE AN INDIRECT CALL
  1887.         CALL  OVCTR         ;  TO SEND THE CHAR
  1888.         CPI   0DH           ;IF CR
  1889.         JZ    ENDOL         ;  THEN EOL
  1890.         XCHG                ;ELSE RETRIEVE POINTER
  1891.         JMP   DSPLY         ;AND DISPLAY MORE
  1892. ENDOL:  MVI   C,0AH         ;SEND LINE FEED
  1893.         LHLD  OUTADR        ;MAKE AN INDIRECT CALL
  1894.         CALL  OVCTR         ;  TO SEND IT
  1895.         XCHG                ;RETRIEVE POINTER
  1896.         CALL  SKLN           ;SKIP ANY LINE NOS.
  1897.         RET
  1898. OVCTR:  PCHL
  1899. ;
  1900. ; OUTPUT PROGRAM IN MEMORY TO 01 END MARK
  1901. ;
  1902. PRGOUT: LXI   H,PBUFF        ;PGM START ADDR
  1903.         CALL  DSPLY          ;DISPLAY ONE LINE
  1904.         CPI   1              ;IF NOT END MARK
  1905.         JNZ   PRGOUT+3       ;  THEN MORE
  1906.         RET
  1907. ;
  1908. DPRG:   LXI   H,CO           ;DISPLAY PROGRAM IN MEMORY
  1909.         SHLD  OUTADR
  1910.         CALL  PRGOUT
  1911.         RET
  1912. ;
  1913. LPRG:   LXI   H,LO           ;LIST PROGRAM IN MEMORY
  1914.         SHLD  OUTADR
  1915.         CALL  PRGOUT
  1916.         LXI   H,CO           ;RESET TO CONSOLE
  1917.         SHLD  OUTADR
  1918.         RET
  1919. ;
  1920. SPRG:   LXI   H,PO           ;SAVE PROGRAM
  1921.         SHLD  OUTADR
  1922.         CALL  PRGOUT
  1923.         LXI   H,CO           ;RESET TO CONSOLE
  1924.         SHLD  OUTADR
  1925.         RET
  1926. ;
  1927. ; I/O ROUTINES
  1928. ;     USE STPORT (MDS-0F7H) FOR STATUS, PORT (MDS-0F6H) FOR DATA
  1929. ;     STATUS BIT 1 (2H) FOR READ DATA AVAIL (RDA)
  1930. ;     BIT 0 (1H) FOR TRANSMIT BUFFER EMPTY (TBE)
  1931. ;
  1932. ; OUTPUT CHAR FROM C
  1933. ;   LOOKS FOR CTL/Z         INPUT FOR PANIC EXIT
  1934. ;
  1935. ;CHO:    IN    STPORT    ;GET STATUS
  1936. ;    ANI    RDA    ;IF NO INPUT
  1937. ;    JZ    CHO1    ;THEN CONTINUE
  1938. ;    CALL    CI    ;ELSE SEE WHAT IT IS
  1939. ;    CPI    1AH    ;IF CNTRL/Z
  1940. ;    JZ    INTR    ;THEN INTERRUPT
  1941. ;CHO1:   IN    STPORT          ;NOW FOR STANDARD OUTPUT
  1942. ;        ANI   TBE
  1943. ;        JZ    CHO1
  1944. ;        MOV   A,C
  1945. ;        OUT   PORT
  1946. ;        RET
  1947. ;
  1948. INTR:   PUSH  H          ;SAVE REGISTERS
  1949.         PUSH  D
  1950.         PUSH  B
  1951.         LXI   H,INTMSG   ;INTERRUPT MESSAGE
  1952.         CALL  ERROR
  1953.         CALL  ENTRY      ;ALLOW RESTART
  1954.         POP   B          ;ELSE CONTINUE
  1955.         POP   D
  1956.         POP   H
  1957.         RET
  1958. ;
  1959. ; INPUT CHAR TO A AND ECHO
  1960. ;
  1961. ;CHI:    IN    STPORT          ;NORMAL INPUT
  1962. ;        ANI   RDA
  1963. ;        JZ    CHI
  1964. ;        IN    PORT
  1965. ;        ANI   7FH
  1966. CHI:    PUSH    B
  1967.     MVI    C,1
  1968.     CALL    CPM
  1969.     POP    B
  1970.         MOV   C,A
  1971.         CALL  CO
  1972.         RET
  1973. ;
  1974. ; ERROR - DISPLAYS ERROR MESSAGE
  1975. ;    ENTER:  HL = ADDRESS OF MESSAGE
  1976. ;    RETURNS: ZERO FLAG SET
  1977. ;
  1978. ERROR:  CALL  DSPLY
  1979.         XRA   A
  1980.         RET
  1981. ;
  1982. ; ERROR MESSAGES
  1983. ;
  1984. BLMSG:  DB    '- LABEL NOT FOUND',0DH
  1985. ;
  1986. IOVMSG: DB    '/OVERFLOW',0DH
  1987. ;
  1988. NRMSG:  DB    '*NO ROOM',0DH
  1989. ;
  1990. EXPMSG: DB    '*ILLEGAL EXPRESSION',0DH
  1991. ;
  1992. OVFMSG: DB    '*VALUE >  99',0DH
  1993. ;
  1994. UNFMSG: DB    '*VALUE < -99',0DH
  1995. ;
  1996. STMSG:  DB    '*USE DEPTH EXCEEDED',0DH
  1997. ;
  1998. NMSG:   DB    '*NUMERIC RESPONSE REQUIRED',0DH
  1999. ;
  2000. INTMSG: DB    '*INTERRUPTED',0DH
  2001. ;
  2002. IBUFF:  DB    'T:',0DH
  2003.         DB    'T:PILOT-8080, 1.1',0DH
  2004. ;
  2005. ;        DB    ':LOAD A NEW PROGRAM?',0DH
  2006. ;
  2007. ;        DB    'A:',0DH
  2008. ;
  2009. ;        DB    'M: Y',0DH
  2010. ;
  2011. ;        DB    'JN:*%',0DH
  2012. ;
  2013. ;        DB    'T:ENTER PILOT PROGRAM',0DH
  2014. ;
  2015. ;        DB    ':TERMINATE INPUT WITH CTL/Z',0DH
  2016. ;
  2017.         DB    'LOAD:',0DH
  2018. ;
  2019.         DB    '*% IEP:',0DH
  2020. ;
  2021. ; ORG HERE CAN SET START OF RAM PROGRAM BUFFER SPACE
  2022. ;
  2023. ; RELOCATED TO END OF MONITOR            ;JIF
  2024. ;        ORG   PBUFB
  2025. ;PBUFF:  DB    1
  2026. ;
  2027. ; SOURCE PROGRAM AND $STRING STORAGE HERE TO MEMTP
  2028. ;DISPLACEMENTS NEEDED IN PMON        JIF
  2029.         END    START
  2030.