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 / CPMUG015.ARK / SOLOS.ASM < prev    next >
Assembly Source File  |  1984-04-29  |  47KB  |  2,059 lines
  1. ; ******** SOLOS OPERATING SYSTEM ********
  2. ;
  3. ; PROCESSOR TECHNOLOGY CORP.
  4. ; EMERYVILLE, CALIFORNIA
  5. ;
  6. ;
  7. ;     VERSION   1.3
  8. ;     RELEASE   3/27/77
  9. ;
  10. ;
  11. ;
  12. ;
  13. ;
  14. ;     THIS 2048 BYTE PROGRAM IS THE STANDARD SOL STAND
  15. ; ALONE OPERATING SYSTEM.  IT IS CONFIGURED TO OPTIMIZE
  16. ; THE CONVENIENCE AND POWER OF THE SOL-20 AND ONE OR TWO
  17. ; CASSETTE RECORDERS IN STAND ALONE COMPUTER APPLICATIONS.
  18. ;
  19. ;
  20. ;COMMANDS:
  21. ;    TE            TERMINAL MODE
  22. ;    DU SSSS EEEE        DUMP (START ADDR   END ADDR)
  23. ;    EN SSSS            ENTER HEX TO MEMORY
  24. ;    EX SSSS            EXECUTE
  25. ;    GE FILENAME/U        GET (U=TAPE UNIT 0 OR 1, DFLT=1)
  26. ;    SA FNAME/U SSSS EEEE    SAVE ON TAPE (UNIT 0 OR 1)
  27. ;    XE FILENAME/U        AUTO LOAD/EXECUTE
  28. ;    CA            CATALOG OF TAPE FILES
  29. ;    CU LL SSSS        CUSTOM COMMAND (LL=LABLE)
  30. ;    SET TA N        SET TAPE SPEED (N:0=FAST,1=SLOW)
  31. ;    SET S=NN        SET DISPLAY SPEED (O-->FF)
  32. ;    SET I=N            SET IN PSEUDO PORT (N=0 - 3)
  33. ;    SET O=N            SET OUT PSEUDO PORT (N=0 - 3)
  34. ;    SET N=NN        SET NULLS (N=0 - FF)
  35. ;    SET CI SSSS        SET CUSTOM INPUT DRIVER ADDR
  36. ;    SET CO SSSS        SET CUSTOM OUTPUT DRIVER ADDR
  37. ;    SET XE SSSS        SET AUTO-EXECUTE ADDRESS FOR TAPE SAVE
  38. ;    SET TY NN        SET FILE TYPE FOR TAPE HEADER
  39. ;    SET CR NN        OVERRIDE CRC ERRORS (FF=IGNORE ERRORS)
  40. ;
  41. ;
  42. ;    PSEUDO PORTS:    0 = KEYBOARD/VIDEO
  43. ;            1 = SERIAL PORT
  44. ;            2 = PARALLEL PORT
  45. ;            3 = USER DEFINED (SET CI, SET CO)
  46. ;
  47. ;
  48. ;
  49.     ORG    0C000H
  50. ;
  51. ;
  52. ;
  53. ; AUTO-STARTUP CODE
  54. ;
  55. START:    DB    0
  56. INIT:    JMP    STRTA    ;SYSTEM RESTART ENTRY POINT
  57. ;
  58. ;
  59. ;     ENTRY POINTS
  60. ;
  61. ;     THESE JUMP POINTS ARE PROVIDED TO ALLOW COMMON ENTRY
  62. ; LOCATIONS FOR ALL VERSIONS OF SOLOS.  THEY ARE USED
  63. ; EXTENSIVLY BY SOL SYSTEM PROGRAMS AND IT IS RECOMMENDED
  64. ; THAT USER ROUTINES ACCESS SOLOS THROUGH THESE POINTS.
  65. ;
  66. RETRN:    JMP    COMND    ;RETURN TO SYSTEM ENTRY POINT
  67. FOPEN:    JMP    BOPEN    ;FILE OPEN ENTRY
  68. FCLOS:    JMP    PCLOS    ;FILE CLOSE ENTRY
  69. RDBYT:    JMP    RTBYT    ;CASSETTE READ BYTE ENTRY
  70. WRBYT:    JMP    WTBYT    ;CASSETTE WRITE BYTE ENTRY
  71. RDBLK:    JMP    RTAPE    ;CASSETTE READ BLOCK ENTRY
  72. WRBLK:    JMP    WTAPE    ;CASSETTE WRITE BLOCK ENTRY
  73. ;
  74. ;
  75. ;   SYSTEM I/O ENTRY POINTS
  76. ;
  77. ;   THESE ROUTINES PERFORM SYSTEM I/O
  78. ; THERE ARE TWO ENTRY TYPES:
  79. ;       SINP/SOUT    REG "A" WILL BE SET TO THE STANDARD
  80. ;                    SYSTEM PSEUDO PORT.
  81. ;       AINP/AOUT    REG "A" MUST BE SET BY THE USER AND
  82. ;                    WILL SPECIFY THE DESIRED PSEUDO PORT.
  83. ;
  84. ; THE FOLLOWING ARE THE PSEUDO PORTS:
  85. ;    PORT    DESCRIPTION
  86. ;    ----    --------------------------------
  87. ;     0    KEYBOARD WHEN INPUT, AND VDM WHEN OUTPUT
  88. ;     1    SERIAL I/O PORT
  89. ;     2    PARALLEL I/O PORT
  90. ;     3    USER DEFINED I/O PORT
  91. ;
  92. SOUT:    LDA    OPORT    ;SOUT ENTRY POINT
  93. AOUT:    JMP    OUTPR    ;AOUT ENTRY POINT
  94. SINP:    LDA    IPORT    ;SINP ENTRY POINT
  95. AINP:    EQU    $    ;AINP ENTRY POINT
  96. ;******** END OF SYSTEM ENTRY POINTS *********
  97.     PUSH    H    ;THIS IS ACTUALLY AINP
  98.     LXI    H,ITAB
  99. ;
  100. ;
  101. ;   THIS ROUTINE PROCESSES THE I/O REQUESTS BY DISPATCHING
  102. ; TO THE DRIVER REQUESTED IN REGISTER "A".  ON ENTRY HL
  103. ; HAS THE PROPER DISPATCH TABLE.
  104. ;
  105. IOPRC:    ANI    3    ;KEEP REGISTER "A" TO FOUR VALUES
  106.     RLC        ;COMPUTE ENTRY ADDRESS
  107.     ADD    L
  108.     MOV    L,A    ;WE HAVE ADDRESS
  109.     JMP    DISPT    ;DISPATCH TO IT
  110. ;
  111. ;
  112. ;    ***** SOL SYSTEM I/O ROUTINES *****
  113. ;
  114. ;
  115. ;   THIS ROUTINE IS A MODEL OF ALL INPUT ROUTINES WITHIN
  116. ; SOLOS.  EACH ROUTINE FIRST TESTS THE STATUS INPUT FOR
  117. ; DATA AVAILABLE.  IF NO CHARACTERHAS BEEN RECEIVED THE
  118. ; ROUTINE RETURNS WITH THE ZERO FLAG SEG.  OTHERWISE THE
  119. ; CHARACTER IS INPUT AND A RETURN MADE WITH THE CHARACTER
  120. ; IN THE ACCUMULATOR AND THE ZERO FLAG RESET.
  121. ;
  122. ;
  123. ;   KEYBOARD INPUT DRIVER
  124. ;
  125. KSTAT:    IN    STAPT    ;GET STATUS WORK
  126.     CMA        ;INVERT IT FOR PROPER RETURN
  127.     ANI    KDR    ;TEST KEYBOARD BIT
  128.     RZ        ;ZERO IS NO CHARACTER RECEIVED
  129. ;
  130.     IN    KDATA    ;GET CHARACTER
  131.     RET        ;GO BACK WITH IT
  132. ;
  133. ;
  134. ;   THIS JUMP IS PART OF THE AUTO START UP CODE
  135. ;
  136.     DB    0    ;VERIFY ADDR=C037 
  137.     JMP    INIT    ;THIS SHOULD BE C038
  138. ;
  139. ;
  140. ;    JMP TABLE OUTPUT ROUTINES
  141. ;
  142. ;   THIS ROUTINE SETS UP THE DISPATCH TABLE FOR OUTPUT
  143. ; ROUTINES.  THE CHARACTER FOR OUTPUT IS IN REGISTER "B".
  144. ; OUTPUT IS MADE TO THE DRIVER POINTED TO BY THE REGISTER
  145. ; "A".  THE DEVICE DRIVERS ARE DEFINED AS FOLLOWS:
  146. ;
  147. ;    0 - DISPLAY SCREEN
  148. ;    1 - SERIAL OUTPUT PORT
  149. ;    2 - PARALLEL OUTPUT PORT
  150. ;    3 - USER DEFINED OR ERROR FLAG
  151. ;
  152. ; ENTRY AT:    SOUT SELECTS CURRENT OUTPUT DEVICE
  153. ;        AOUT SELECTS DEVICE IN REGISTER "A"
  154. ;
  155. OUTPR:    PUSH    H
  156.     LXI    H,OTAB    ;POINT TO OUTPUT TABLE
  157.     JMP    IOPRC    ;AND DISPATCH TO OUTPUT ROUTINE
  158. ;
  159. ;
  160. ;
  161. ;    SERIAL INPUT DRIVER
  162. ;
  163. SSTAT:    IN    SERST    ;GET SERIAL STATUS WORD
  164.     ANI    SDR    ;TEST FOR SERIAL DATA READY
  165.     RZ        ;FLAGS ARE SET
  166. ;
  167.     IN    SDATA    ;GET DATA BYTE
  168.     RET        ;WE HAVE IT
  169. ;
  170. ;
  171. ;    SERIAL DATA OUTPUT
  172. ;
  173. SDROT:    IN    SERST    ;GET PORT STATUS
  174.     RAL        ;PUT HIGH BIT IN CARRY
  175.     JNC    SDROT    ;LOOP UNTIL TRANSMITTER BUFFER IS EMPTY
  176.     MOV    A,B    ;GET THE CHARACTER BACK
  177.     OUT    SDATA    ;SEND IT OUT
  178.     RET        ;AND WE'RE DONE
  179. ;
  180. ;
  181. ;
  182. ;
  183. ;    VIDEO DISPLAY ROUTINES
  184. ;
  185. ;
  186. ;   THESE ROUTINES ALLOW FOR STANDARD VIDEO TERMINAL
  187. ; OPERATIONS.  ON ENTRY, THE CHARACTER FOR OUTPUT IS IN
  188. ; REGISTER B AND ALL REGISTERS EXCEPT "A" AND FLAGS ARE
  189. ; UNALTERED ON RETURN.
  190. ;
  191. ;
  192. VDMOT:    PUSH    H    ;SAVE MOST REGISTERS
  193.     PUSH    D
  194.     PUSH    B
  195. ;
  196. ; TEST IS ESC SEPUENCE HAS BEEN STARTED
  197. ;
  198.     LDA    ESCFL    ;GET ESCAPE FLAG
  199.     ORA    A
  200.     JNZ    ESCS    ;IF NON-ZERO GO PROCESS THE REST
  201. ;
  202. ;
  203. CHPCK:    MOV    A,B    ;SAVE IN B...STRIP PARITY BEFORE SCREEN!
  204.     ANI    7FH    ;CLR PARITY TO LOCATE IN TBL
  205.     MOV    B,A    ;KEEP IT W/OUT PARITY IN B TOO
  206.     JZ    GOBK    ;DO A QUICK EXIT IF A NULL
  207.     LXI    H,TBL    ;POINT TO SPECIAL SHARACTER TABLE
  208.     CALL    TSRCH    ;GO PROCESS
  209. ;
  210. GOBACK:    CALL    VDADD    ;GET SCREEN ADDRESS
  211.     MOV    A,M    ;GET PRESENT CURSOR CHARACTER
  212.     ORI 80H
  213.     MOV    M,A    ;CURSOR IS BACK ON
  214.     LHLD    SPEED-1    ;GET DELAY SPEED
  215.     INR    L    ;MAKE SURE IT IS NON-ZERO
  216.     XRA    A    ;DELAY WILL END WHEN H=0
  217. TIMER:    DCX    H    ;TIMER DELAYS HERE
  218.     CMP    H    ;DONE WITH DELAY YET
  219.     JNZ    TIMER    ;KEEP DELAYING
  220. GOBK:    POP    B
  221.     POP    D    ;RESTORE REGISTERS
  222.     POP    H
  223.     RET        ;EXIT FROM VDMOT
  224. ;
  225. NEXT:    INX    H
  226.     INX    H
  227. ;
  228. ;
  229. ;   THIS ROUTINE SEARCHES THROUGH A SINGLE CHARACTER 
  230. ; TABLE FOR A MATCH TO THE CHARACTER IN "B".  IF FOUND
  231. ; A DISPATCH IS MADE TO THE ADDRESS FOLLOWING THE MATCHED
  232. ; CHARACTER.  IF NOT FOUND THE CHARACTER IS DISPLAYED ON
  233. ; THE MONITOR.
  234. ;
  235. TSRCH:    MOV    A,M    ;GET CHR FROM TABLE
  236.     ORA    A
  237.     JZ    CHAR    ;ZERO IS THE LAST
  238.     CMP    B    ;TEST THE CHR
  239.     INX    H    ;POINT FORWARD
  240.     JNZ    NEXT
  241.     PUSH    H    ;FOUND ONE...SAVE ADDRESS
  242.     CALL CREM    ;REMOVE CURSOR
  243.     XTHL        ;GET DISPATCH ADDRESS TO HL
  244.     JMP    DISPT    ;DISPATCH NOW
  245. ;
  246. ;    PUT CHARACTER TO SCREEN
  247. ;
  248. CHAR:    MOV    A,B    ;GET CHARACTER
  249.     CPI    7FH    ;IS IT A DEL?
  250.     RZ        ;GO BACK IF SO
  251. ;
  252. ;
  253. ;
  254. OCHAR:    EQU    $    ;ACTUALLY PUT CHAR TO SCREEN NOW
  255.     CALL    VDADD    ;GET SCREEN ADDRESS
  256.     MOV    M,B    ;PUT CHR ON SCREEN
  257. ;
  258.     LDA    NCHAR    ;GET CHARACTER POSITION
  259.     CPI    63    ;END OF LINE?
  260.     JC    OK
  261.     LDA    LINE
  262.     CPI    15    ;END OF SCREEN?
  263.     JNZ    OK
  264. ;
  265. ; END OF SCREEN...ROLL UP ONE LINE
  266. ;
  267. SCROLL:    XRA    A
  268.     STA    NCHAR    ;BACK TO FIRST CHAR POSITION
  269. SROL:    MOV    C,A
  270.     CALL VDAD    ;CALCULATE LINE TO BE BLANKED
  271.     XRA    A
  272.     CALL    CLIN1    ;CLEAR IT
  273.     LDA    BOT
  274.     INR    A
  275.     ANI    0FH
  276.     JMP    ERAS3
  277. ;
  278. ; INCREMENT LINE COUNTER IF NECESSARY
  279. ;
  280. OK:    LDA    NCHAR    ;GET CHR POSITION
  281.     INR    A
  282.     ANI    3FH    ;MOD 64 AND WRAP
  283.     STA    NCHAR
  284.     RNZ        ;DIDN'T HIT END OF LINE, OK
  285. PDOWN:    EQU    $    ;CURSOR DOWN ONE LINE HERE
  286.     LDA    LINE    ;GET THE LINE COUNT
  287.     INR    A
  288. CURSC:    ANI    0FH    ;STORE THE NEW
  289. CUR:    STA    LINE    ;STORE THE NEW
  290.     RET
  291. ;
  292. ; ERASE SCREEN
  293. ;
  294. PERSE:    LXI    H,VDMEM    ;POINT TO SCREEN
  295.     MVI    M,80H+' '    ;THIS IS THE CURSOR
  296. ;
  297.     INX    H    ;BUMP    1ST
  298. ERAS1:    EQU    $    ;LOOPS HERE TO ERASE SCREEN
  299.     MVI    M,' '    ;BLANK IT OUT
  300.     INX    H    ;NEXT
  301.     MOV     A,H    ;SEE IF END OF SCREEN YET
  302.     CPI    0D0H
  303.     JC    ERAS1    ;NO--KEEP BLANKING
  304.     STC        ;CARRY WILL SAY COMPLETE ERASE
  305. ;
  306. PHOME:    MVI    A,0    ;RESET CURSOR--CARRY=ERASE, ELSE HOME
  307.     STA    LINE    ;ZERO LINE
  308.     STA    NCHAR    ;LEFT SIDE OF SCREEN
  309.     RNC        ;IF NO CARRY, WE ARE DONE WITH HOME
  310. ;
  311. ERAS3:    OUT    DSTAT    ;RESET SCROOL PARAMETERS
  312.     STA    BOT    ;BEGINNING OF TEXT OFFSET
  313.     RET
  314. ;
  315. ;
  316. CLINE:    CALL    VDADD    ;GET CURRENT SCREEN ADDRESS
  317.     LDA    NCHAR    ;CURRENT CURSOR POSITION
  318. CLIN1:    CPI    64    ;NO MORE THAN 63
  319.     RNC        ;ALL DONE
  320.     MVI    M,' '    ;ALL SPACED OUT
  321.     INX    H
  322.     INR    A
  323.     JMP    CLIN1    ;LOOP TO END OF LINE
  324. ;
  325. ;
  326. ;  ROUTINE TO MOVE THE CURSOR UP ONE LINE
  327. ;
  328. PUP:    LDA     LINE    ;GET LINE COUNT
  329.     DCR    A
  330.     JMP    CURSC    ;MERGE TO HANDLE CURSOR
  331. ;
  332. ;  MOVE CURSOR LEFT ONE POSITION
  333. ;
  334. PLEFT:    LDA    NCHAR
  335.     DCR    A
  336. PCUR:    EQU    $    ;CURSOR ON SAME LINE
  337.     ANI    3FH    ;LET CURSOR WRAP
  338.     STA    NCHAR    ;UPDATED CURSOR
  339.     RET
  340. ;
  341. ;  CURSOR RIGHT ONE POSITION
  342. ;
  343. PRIT:    LDA    NCHAR
  344.     INR    A
  345.     JMP    PCUR
  346. ;
  347. ; ROUTINE TO CALCULATE SCREEN ADDRESS
  348. ;
  349. ;    ENTRY AT:    RETURNS:
  350. ;
  351. ;    VDADD    CURRENT SCREEN ADDRESS
  352. ;    VDAD2    ADDRESS OF CURRENT LINE, CHAR "C"
  353. ;    VDAD    LINE "A", CHARACTER POSITION 'C'
  354. ;
  355. VDADD:    LDA    NCHAR    ;GET CHARACTER POSITION
  356.     MOV    C,A    ;'C' KEEPS IT
  357. VDAD2:    LDA    LINE    ;LINE POSITION
  358. VDAD:    MOV    L,A    ;INTO 'L'
  359.     LDA    BOT    ;GET TEXT OFFSET
  360.     ADD    L    ;ADD IT TO THE LINE POSITION
  361.     RRC        ;TIMES TWO
  362.     RRC        ;MADES FOUR
  363.     MOV    L,A    ;L HAS IT
  364.     ANI    3    ;MOD THREE FOR LATER
  365.     ADI    VDMEM SHR 8    ;LOW SCREEN OFFSET
  366.     MOV    H,A    ;NOW H IS DONE
  367.     MOV     A,L    ;TWIST L'S ARM
  368.     ANI    0C0H
  369.     ADD    C
  370.     MOV    L,A
  371.     RET        ;H & L ARE NOW PERVERTED
  372. ;
  373. ;  ROUTINE TO REMOVE CURSOR
  374. ;
  375. CREM:    CALL    VDADD    ;GET CURRENT SCREEN ADDRESS
  376.     MOV    A,M
  377.     ANI    7FH    ;STRIP OFF THE CURSOR
  378.     MOV    M,A
  379.     RET
  380. ;
  381. ;  ROUTINE TO BACKSPACE
  382. ;
  383. PBACK:    CALL    PLEFT
  384.     CALL VDADD    ;GET SCREEN ADDRESS
  385.     MVI    M,' '    ;PUT A BLANK THERE
  386.     RET
  387. ;
  388. ;  ROUTINE TO PROCESS A CARRIAGE RETURN
  389. ;
  390. PCR:    XRA    A    ;REWIND TO BEGINNING OF LINE
  391. ;
  392. ;ORIGINAL HAD 'CALL CLINE' INSTEAD OF 'XRA A' AS SHOWN
  393. ;ABOVE. THIS CAUSED DISK COMMANDS TO DISAPPEAR FROM THE
  394. ;SCREEN AS CP/M MUST OUTPUT TWO 'CR' CHARACTERS.
  395. ;
  396.     JMP    PCUR    ;AND STORE THE NEW VALUE
  397. ;
  398. ;  ROUTINE TO PROCESS A LINEFEED
  399. ;
  400. PLF:    LDA    LINE    ;GET LINE COUNT
  401.     INR    A
  402.     ANI    15    ;SEE IF IT WRAPPED AROUND
  403.     JNZ    CUR    ;NO--NO NEED TO SCROLL
  404.     JMP    SROL    ;YES--THEN SCROLL
  405. ;
  406. ;  SET ESCAPE PROCESS FLAG
  407. ;
  408. PESC:    MVI    A,(-1) AND 0FFH
  409.     STA    ESCFL    ;SET FLAG
  410.     RET
  411. ;
  412. ;  PROCESS ESCAPE SEQUENCE
  413. ;
  414. ESCS:    CALL    CREM    ;REMOVE CURSOR
  415.     CALL    ESCSP    ;PROCESS THE NEXT PART OF SEQUENCE
  416.     JMP    GOBACK
  417. ;
  418. ESCSP:    LDA    ESCFL    ;GET ESCAPE FLAG
  419.     CPI    (-1) AND 0FFH    ;TEST FLAG
  420.     JZ    SECOND
  421. ;
  422. ;  PROCESS THIRD CHR OF ESC SEQUENCE
  423. ;
  424.     LXI    H,ESCFL
  425.     MVI    M,0    ;NO MORE PARTS TO THE SEQUENCE
  426.     CPI    2
  427.     JC    SETX    ;SET X IF IS ONE
  428.     JZ    SETY    ;SET Y IF IS TWO
  429.     CPI    8
  430.     JZ    STSPD    ;SET NEW DISPLAY SPEED IF "8"
  431.     CPI    9
  432.     JC    OCHAR    ;PUT IT ON THE SCREEN
  433.     RNZ
  434. ;
  435. ;  TAB ABSOLUTE TO VALUE IN REG B
  436. ;
  437. SETX:    MOV    A,B    ;GET CHARACTER
  438.     JMP    PCUR
  439. ;
  440. ;  SET CURSOR TO LINE "B"
  441. ;
  442. SETY:    MOV A,B
  443.     JMP    CURSC
  444. ;
  445. ;
  446. ;  PROCESS SECOND CHR OF ESC SEPUENCE
  447. ;
  448. SECOND:    MOV    A,B    ;GET WHICH
  449.     CPI    3
  450.     JZ    CURET    ;RETURN CURSOR PARAMETERS
  451.     CPI    4
  452.     JNZ    ARET2
  453. ;
  454. ;  ESC <4>  RETURN ABSOLUTE SCREEN ADDRESS
  455. ;
  456. ARET:    MOV    B,H
  457.     MOV    C,L    ;PRESENT SCREEN ADDRESS TO BC FOR RETURN
  458. ;
  459. ARET1:    POP    H    ;RETURN ADDRESS
  460.     POP    D    ;OLD B
  461.     PUSH    B
  462.     PUSH    H
  463.     XRA    A
  464. ARET2:    STA    ESCFL
  465.     RET
  466. ;
  467. ;
  468. ;  RETURN PRESENT SCREEN PARAMETERS IN "BC"
  469. ;
  470. CURET:    LXI    H,NCHAR
  471.     MOV    B,M    ;CHARACTER POSITION
  472.     INX    H
  473.     MOV    C,M    ;LINE POSITION
  474.     JMP    ARET1
  475. ;
  476. ;
  477. ;    ***** START UP SYSTEM *****
  478. ;
  479. ; CLEAR SCREEN AND THE FIRST 256 BYTES OF GLOBAL RAM
  480. ; THEN ENTER THE COMMAND MODE
  481. ;
  482. STRTA:    XRA    A
  483.     MOV    C,A
  484.     LXI    H,SYSRAM    ;CLEAR THR FIRST PAGE
  485. ;
  486. CLERA:    MOV    M,A
  487.     INX    H
  488.     INR    C
  489.     JNZ    CLERA
  490. ;
  491.     LXI    SP,SYSTP    ;SET UP THE STACK FOR CALL
  492.     CALL    PERSE
  493. COMN1:    XRA    A
  494.     OUT STAPT    ;BE SURE TAPES ARE OFF
  495.     STA    OPORT
  496.     STA    IPORT
  497. ;
  498. ;
  499. ;
  500. ;    ***** COMMAND MODE *****
  501. ;
  502. ;
  503. ;  THIS ROUTINE GETS AND PROCESSES COMMANDS
  504. ;
  505. COMND:    LXI    SP,SYSTP    ;SET STACK POINTER
  506.     LDA    OPORT    ;GET PORT
  507.     PUSH    PSW
  508.     XRA    A
  509.     STA    OPORT    ;FORCE SCREEN OPERATIONS
  510.     CALL    PROMPT    ;PUT PROMPT ON SCREEN
  511.     CALL    GCLIN    ;GET COMMAND LINE
  512.     POP    PSW
  513.     STA    OPORT    ;RESTORE DEFAULT PORT
  514.     CALL    COPRC    ;PROCESS THE LINE
  515.     JMP    COMND    ;OVER AND OVER
  516. ;
  517. ;
  518. ;
  519. ; THIS ROUTINE READS A COMMAND LINE
  520. ; FROM THE SYSTEM KEYBOARD
  521. ;
  522. ;    C/R    TERMINATES THE SWQUENCE ERASING ALL 
  523. ;        CHARS TO THE RIGHT OF THE CURSOR
  524. ;    L/F    TERMINATES THE SEQUENCE
  525. ;    MODE    RESTARTS THE COMMAND LINE
  526. ;
  527. GCLIN:    CALL    SINP    ;READ INPUT DEVICE
  528.     JZ    GCLIN
  529.     ANI    7FH    ;CLEAR PARITY BIT
  530.     JZ    COMN1    ;THIS WAS A MODE (OR EVEN CTRL-@)
  531.     MOV    B,A
  532.     CPI    CR    ;CARRIAGE RETURN
  533.     JZ    CLINE    ;YES--DONE WITH LINE
  534.     CPI    LF    ;LINE FEED
  535.     RZ        ;YES--DONE WITH LINE, LEAVE AS IS
  536.     CPI    7FH    ;DELETE CHR?
  537.     JNZ    CONT
  538.     MVI    B,BACKS    ;REPLACE IT
  539. ;
  540. CONT:    CALL    SOUT
  541.     JMP    GCLIN
  542. ;
  543. ;
  544. ; FIND AND PROCESS COMMAND
  545. ;
  546. COPRC:    CALL    CREM    ;REMOVE THE CURSOR
  547.     MVI    C,1    ;SET FOR CHARACTER POSITION
  548.     CALL    VDAD2    ;GET SCREEN ADDRESS
  549.     XCHG
  550.     LXI    H,START    ;MAKE SURE HL PT TO SOLOS START
  551.     PUSH    H    ;SAVE IT FOR LATER DISPT
  552.     CALL    SCHR    ;SCAN PAST BLANKS
  553.     JZ    ERR1    ;NO COMMAND?
  554.     XCHG        ;HL HAS FIRST CHR
  555. ;
  556.     LXI    D,COMTAB    ;POINT TO COMMAND TABLE
  557.     CALL    FDCOM    ;SEE IF IN PRIMARY COMMAND TABLE
  558.     CZ    FDCOU    ;IF NOT, TRY CUSTOM TABLE NEXT
  559. DISPO:    EQU    $    ;HERE TO SEE IF ERROR OR DISP
  560.     JZ    ERR2    ;NOT VALID, ERROR
  561.     INX    D    ;BUMP TO PTR OF RTN
  562.     XCHG        ;HL PT TO RTN ADDR
  563. ;
  564. ;
  565. ;  THIS IS THE DISPATCH ROUTINE
  566. ;  HL PT TO RTN ADDRESS, HL WILL BE RESTORED FROM STACK
  567. ;  SO THAT HL ARE RESTORED BEFORE DISPATCH.
  568. ;
  569. DISPT:    EQU    $    ;OFF TO A ROUTINE
  570.     MOV    A,M    ;LO ADDR
  571.     INX    H
  572.     MOV    H,M    ;HI ADDR
  573.     MOV    L,A    ;HL NOW COMPLETE
  574. DISP1:    EQU    $    ;HERE TO GO OFF TO HL
  575.     XTHL        ;XCHG HL W/HL ON STACK
  576.     MOV    A,L    ;ALSO COPY HERE FOR SETS
  577.     RET        ;AND GO OFF TO THE RTN
  578. ;
  579. ;
  580. ;    THIS ROUTINE SEARCHES THROUGH A TABLE, POINTED TO
  581. ; BY 'DE', FOR A DOUBLE CHARACTER MATCH OF THE 'HL'
  582. ; MEMORY CONTENT.  IF NO MATCH IS FOUND THE SCAN ENDS
  583. ; WITH HL POINTING TO ORIGINAL VALUE AND ZERO FLAG SET.
  584. ;
  585. FDCOU:    LXI    D,CUTAB    ;HERE TO SCAN CUSTOM TBL ONLY
  586. ;
  587. FDCOM:    LDAX    D
  588.     ORA    A    ;TEST FOR TABLE END
  589.     RZ        ;NOT FOUND..COMMAND ERROR
  590.     PUSH    H    ;SAVE START OF SCAN ADDRESS
  591.     CMP    M    ;TEST FIRST CHR
  592.     INX    D
  593.     JNZ    NCOM
  594. ;
  595.     INX    H
  596.     LDAX    D
  597.     CMP    M    ;NOW SECOND CHARACTER
  598.     JNZ    NCOM    ;GOODNESS
  599. ;
  600.     POP    H    ;RESTORE ORIGINAL SCAN ADDR
  601.     ORA    A    ;SET NON-ZERO FLAG SAYING FOUND
  602.     RET        ;WITH NON-ZERO SET
  603. ;
  604. ;
  605. NCOM:    INX    D    ;GO TO NEXT ENTRY
  606.     INX    D
  607.     INX    D
  608.     POP    H    ;GET BACK ORIGINAL ADDRESS
  609.     JMP    FDCOM    ;CONTINUE SEARCH
  610. ;
  611. ;
  612. ;    ***** COMMAND TABLE *****
  613. ;
  614. ; THIS TABLE DESCRIBES THE VALID COMMANDS FOR SOLOS
  615. ;
  616. COMTAB:    DW    'TE'    ;TERMINAL MODE
  617.     DW    TERM
  618.     DW    'DU'    ;DUMP
  619.     DW    DUMP
  620.     DW    'EN'    ;ENTER
  621.     DW    ENTER
  622.     DW    'EX'    ;EXECUTE
  623.     DW    EXEC
  624.     DW    'GE'    ;GET A FILE
  625.     DW    TLOAD
  626.     DW    'SA'    ;SAVE A FILE
  627.     DW    TSAVE
  628.     DW    'XE'    ;AUTO-EXECUTE A FILE
  629.     DW    TXEQ
  630.     DW    'CA'    ;CATALOG OF TAPE FILES
  631.     DW    TLIST
  632.     DW    'SE'    ;SET COMMAND
  633.     DW    CSET
  634.     DW    'CU'    ;CUSTOM COMMAND
  635.     DW    CUSET
  636.     DB    0    ;END OF TABLE MARK
  637. ;
  638. ;
  639. ;    DISPLAY DRIVER COMMAND TABLE
  640. ;
  641. ;     THIS TABLE DEFINES THE CHARACTERS FOR SPECIAL
  642. ; PROCESSING.  IF THE CHARACTER IS NOT IN THE TABLE IT
  643. ; GOES TO THE SCREEN.
  644. ;
  645. TBL:    DB    CLEAR-80H    ;CLEAR SCREEN
  646.     DW    PERSE
  647.     DB    UP-80H        ;UP CURSOR
  648.     DW    PUP
  649.     DB    DOWN-80H    ;DOWN CURSOR
  650.     DW    PDOWN
  651.     DB    LEFT-80H    ;LEFT CURSOR
  652.     DW    PLEFT
  653.     DB    RIGHT-80H        ;RIGHT CURSOR
  654.     DW    PRIT
  655.     DB    HOME-80H    ;HOME CURSOR
  656.     DW    PHOME
  657.     DB    CR        ;CARRIAGE RETURN
  658.     DW    PCR
  659.     DB    LF        ;LINE FEED
  660.     DW    PLF
  661.     DB    BACKS        ;BACKSPACE
  662.     DW    PBACK
  663.     DB    ESC        ;ESCAPE KEY
  664.     DW    PESC
  665.     DB    0        ;END OF TABLE
  666. ;
  667. ;
  668. ;    OUTPUT DEVICE TABLE
  669. ;
  670. OTAB:    DW    VDMOT    ;VDM DRIVER
  671.     DW    SDROT    ;SERIAL OUTPUT
  672.     DW    PROUT    ;PARALLAL OUTPUT
  673.     DW    ERROT    ;ERROR OR USER DRIVER HANDLER
  674. ;
  675. ;
  676. ;    INPUT DEVICE TABLE
  677. ;
  678. ITAB:    DW    KSTAT    ;KEYBOARD INPUT
  679.     DW    SSTAT    ;SERIAL INPUT
  680.     DW    PASTAT    ;PARALLEL INPUT
  681.     DW    ERRIT    ;ERROR OR USER DRIVER HANDLER
  682. ;
  683. ;
  684. ;    SECONDARY COMMAND TABLE FOR SET COMMAND
  685. ;
  686. SETAB:    DW    'TA'    ;SET TAPE SPEED
  687.     DW    TASPD
  688.     DW    'S='    ;SET DISPLAY SPEED
  689.     DW    DISPD
  690.     DW    'I='    ;SET INPUT PORT
  691.     DW    SETIN
  692.     DW    'O='    ;SET OUTPUT PORT
  693.     DW    SETOT
  694.     DW    'N='    ;SET NULLS
  695.     DW    SETNU
  696.     DW    'CI'    ;SET CUSTOM DRIVER ADDRESS
  697.     DW    SETCI
  698.     DW    'CO'    ;SET CUSTOM OUTPUT DRIVER ADDRESS
  699.     DW    SETCO
  700.     DW    'XE'    ;SET HEADER XEQ ADDRESS
  701.     DW    SETXQ
  702.     DW    'TY'    ;SET HEADER TYPE
  703.     DW    SETTY
  704.     DW    'CR'    ;SET CRC TO ALLOW IGNORING OF CRC ERRORS
  705.     DW    SETCR
  706.     DB    0    ;END OF TABLE MARK
  707. ;
  708. ;
  709. ;  SOLOS PORT ERROR HANDLER
  710. ;
  711. ERRIT:    PUSH    H    ;SAVE HL ONCE AGAIN
  712.     LHLD    UIPRT    ;GET USER INPUT PORT ADDRESS
  713.     JMP    ERRO1    ;AND GO PROCESS
  714. ;
  715. ERROT:    PUSH    H
  716.     LHLD    UOPRT    ;GET USER OUTPUT PORT ADDRESS
  717. ERRO1:    MOV    A,L    ;TEST HL FOR ZERO
  718.     ORA    H
  719.     JZ    COMN1    ;IF ZERO RETURN TO COMMAND MODE
  720.     XTHL        ;ADDRESS TO STACK...OLD HL TO HL
  721.     RET        ;GO TO THE DRIVER
  722. ;
  723. ;    THIS ROUTINE IS THE PARALLEL DEVICE HANGLER
  724. ; NO PROVISION IS MADE FOR CONTROLLING THE PORT
  725. ; CONTROL BIT.
  726. ;
  727. ;
  728. ;    PARALLEL INPUT DRIVER
  729. ;
  730. PASTAT:    IN    STAPT
  731.     CMA        ;INVERT STATUS FLAGS
  732.     ANI    PDR    ;TEST BIT
  733.     RZ
  734.     IN    PDATA    ;GET DATA
  735.     RET
  736. ;
  737. ;    PARALLEL OUTPUT HANDLER
  738. ;
  739. PROUT:    IN    STAPT    ;GET STATUS
  740.     ANI    PXDR    ;TEST IF DEVICE IS READY
  741.     JNZ    PROUT    ;LOOP UNTIL SO
  742.     MOV    A,B
  743.     OUT    PDATA
  744.     RET
  745. ;
  746. ;
  747. ;    OUTPUT A CR/LF FOLLOWED BY A PROMPT
  748. ;
  749. PROMPT:    CALL    CRLF
  750.     MVI    B,'>'    ;THE PROMPT
  751.     JMP    SOUT    ;PUT IT ON THE SCREEN
  752. ;
  753. ;
  754. CRLF:    MVI    B,LF    ;LINE FEED
  755.     CALL    SOUT
  756.     MVI    B,CR    ;CARRIAGE RETURN
  757.     CALL    SOUT
  758. ;  NOW OUTPUT THE NULLS
  759.     LDA    NUCNT    ;GET DESIRED COUNT
  760.     MOV    C,A    ;STORE IN C
  761. NULOT:    DCR    C
  762.     RM        ;RETURN WHEN PAST ZERO
  763.     XRA    A    ;GET A NULL
  764.     CALL    OUTH
  765.     JMP    NULOT
  766. ;
  767. ;
  768. ;    SCAN OFF OPTIONAL PARAMETER.  IF PRESENT RETURN WITH
  769. ; VALUE IN HL AND COPY OF 'L' IN 'A'.  IF NOT PRESENT
  770. ; RETURN WITH A "1" IN 'A' AND HL UNTOUCHED.
  771. ;
  772. PSCAN:    CALL    SBLK
  773.     MVI    A,1    ;DEFAULT VALUE
  774.     RZ        ;IF NONE
  775.     CALL    SHEX    ;CONVERT VALUE
  776.     MOV    A,L    ;GET LOWER HALF
  777.     RET
  778. ;
  779. ;
  780. ;   SCAN OVER UP TO 12 CHARACTERS LOOKING FOR A BLANK
  781. ;
  782. SBLK:    MVI    C,12    ;MAXIMUM COMMAND STRING
  783. SBLK1:    LDAX    D
  784.     CPI    BLANK
  785.     JZ    SCHR    ;GOT A BLANK NOW SCAN PAST IT
  786.     INX    D
  787.     CPI    '='    ;ALSO ALLOW EQUAL TO STOP US
  788.     JZ    SCHR    ;IF SO, PTR AT CHAR FOLLOWING
  789.     DCR    C    ;NO MORE THAN TWELVE
  790.     JNZ    SBLK1
  791.     RET        ;GO BACK WITH ZERO FLAG SET
  792. ;
  793. ;
  794. ;    SCAN PAST UP TO 10 BLANK POSITIONS LOOKING FOR
  795. ; A NON-BLANK CHARACTER
  796. ;
  797. SCHR:    MVI    C,10    ;SCAN TO FIRST NONBLANK CHR IN 10
  798. SCHR1:    LDAX    D    ;GET NEXT CHARACTER
  799.     CPI    SPACE
  800.     RNZ        ;WE'RE PAST THEM
  801.     INX    D    ;NEXT SCAN ADDRESS
  802.     DCR    C
  803.     RZ        ;COMMAND ERROR
  804.     JMP    SCHR1    ;KEEP LOOPING
  805. ;
  806. ;
  807. ;    THIS ROUTINE SCANS OVER CHARACTERS, PAST BLANKS AND
  808. ; CONVERTS THE FOLLOWING VALUE TO HEX.  ERRORS RETURN TO 
  809. ; THE ERROR HANDLER.
  810. ;
  811. SCONV:    CALL    SBLK    ;FIND IF VALUE IS PRESENT
  812.     JZ    ERR1    ;ABORT TO ERROR IF NONE
  813. ;
  814. ;
  815. ;    THIS ROUTINE CONVERTS ASCII DIGITS INTO BINARY FOLLOWING
  816. ; A STANDARD HEX CONVERSION.  THE SCAN STOPS WHEN AN ASCII
  817. ; SPACE IS ENCOUNTERED.  PARAMETER ERRORS REPLACE THE ERROR
  818. ; CHARACTER ON THE SCREEN WITH A QUESTION MARK.
  819. ;
  820. SHEX:    LXI    H,0    ;CLEAR H & L
  821. SHE1:    LDAX    D    ;GET CHARACTER
  822.     CPI    20H    ;IS IT A SPACE
  823.     RZ        ;IF SO
  824.     CPI    '/'    ;SLASH IS ALSO LEGAL
  825.     RZ
  826.     CPI    ':'    ;EVEN THE COLON IS ALLOWED
  827.     RZ
  828. ;
  829. HCONV:    DAD    H    ;MAKE ROOM FOR THE NEW ONE
  830.     DAD    H
  831.     DAD    H
  832.     DAD    H
  833.     CALL    HCOV1    ;DO THE CONVERSION
  834.     JNC    ERR1    ;NOT VALID HEXIDECIMAL VALUE
  835.     ADD    L
  836.     MOV    L,A    ;MOVE IT IN
  837.     INX    D    ;BUMP THE POINTER
  838.     JMP    SHE1
  839. ;
  840. HCOV1:    SUI    48    ;REMOVE ASCII BIAS
  841.     CPI    10
  842.     RC        ;IF LESS THAN 9
  843.     SUI    7    ;IT'S A LETTER
  844.     CPI    10H
  845.     RET        ;WITH TEST IN HAND
  846. ;
  847. ;
  848. ;    ***** TERMINAL COMMAND *****
  849. ;
  850. ;    THIS ROUTINE GETS CHARACTERS FROM THE SYSTEM KEYBOARD
  851. ; AND OUTPUTS THEM TO THE SELECTED OUTPUT PORT.  IT IS
  852. ; INTENDED TO CONFIGURE THE SOL AS A STANDARD VIDEO
  853. ; TERMINAL.  COMMAND KEYS ARE NOT OUTPUT TO THE OUTPUT
  854. ; PORT BUT ARE INTERPRETED AS DIRECT SOL COMMANDS.
  855. ; THE MODE COMMAND, RECEIVED BY THE KEYBOARD, PUTS THE SOL
  856. ; IN THE COMMAND MODE.
  857. ;
  858. ;
  859. ;
  860. TERM:    CALL    PSCAN    ;FIND IF INPUT PARAMETER IS PRESENT
  861.     STA    IPORT    ;SINP WILL USE THIS DRIVER (DEFAULT IS 1)
  862.     CALL    PSCAN    ;NOW FOR THE OUTPUT DRIVER
  863.     STA    OPORT
  864. ;
  865. TERM1:    CALL    KSTAT    ;IS THERE ONE WAITING?
  866.     JZ    TIN    ;IF NOT
  867.     MOV    B,A    ;SAVE IT IN B
  868.     CPI    MODE    ;IS IT MODE?
  869.     JZ    COMN1    ;YES...RESET AND QUIT TERM
  870.     JC    TOUT    ;NON-CURSOR KEY...SEND TO TERM PORT
  871.     CALL    VDMOT    ;PROCESS IT
  872.     JMP    TIN
  873. ;
  874. TOUT:    CALL    SOUT    ;OUTPUT IT TO THE SERIAL PORT
  875. TIN:    CALL    SINP    ;GET INPUT STATUS
  876.     JZ    TERM1    ;LOOP IF NOT
  877.     ANI    7FH    ;NO HIGH BITS FROM HERE
  878.     JZ    TERM1    ;A NULL IS IGNORED
  879.     MOV    B,A    ;IT'S OUTPUT FROM 'B'
  880.     CPI    1BH    ;IS IT A CONTROL CHAR TO BE IGNORED
  881.     JNC    TERM2    ;NO...TO VDM AS IS THEN
  882.     CPI    CR    ;CR OR LF ARE SPECIAL CASES THOUGH
  883.     JZ    TERM2    ;AND MUST BE PASSED STD MODE TO VDM
  884.     CPI    LF
  885.     JZ    TERM2
  886.     LDA    ESCFL    ;A CTRL CHAR...ARE WE W/IN ESC SEQUENCE?
  887.     ORA    A    ;IF YES, THEN OUTPUT CTRL CHAR DIRECTLY TO VDM
  888.     JNZ    TERM2    ;WE SURE ARE, LET VDM DRIVER HANDLE IT
  889.     PUSH    B    ;SAVE THE CHARACTER
  890.     MVI    B,ESC    ;CTRL CHAR TO VDM VIA ESC SEQUENCE
  891.     CALL    VDMOT
  892.     MVI    B,7    ;SAY TO PUT OUT NEXT CHAR AS IS
  893.     CALL     VDMOT    ;ALMOST READY
  894.     POP    B    ;RESTORE CHAR
  895. TERM2:    EQU    $    ;ALL READY TO OUTPUT THE CHAR
  896.     CALL    VDMOT    ;PUT IT ON THE SCREEN
  897.     JMP    TERM1    ;LOOP OVER AND OVER
  898. ;
  899. ;
  900. ;
  901. ;    ***** DUMP COMMAND *****
  902. ;
  903. ;   THIS ROUTINE DUMPS CHARACTERS FROM MEMORY TO THE
  904. ; CURRENT OUTPUT DEVICE.  ALL VALUES ARE DISPLATED AS
  905. ; ASCII HEX.
  906. ;
  907. ;   THE COMMAND FORM IS A FOLLOWS:
  908. ;
  909. ;    DU   ADDR1   ADDR2
  910. ;
  911. ;    THE VALUES FROM ADDR1 TO ADDR2 ARE THEN OUTPUT TO THE
  912. ; OUTPUT DEVICE.  IF ONLY ADDR1 IS SPECIFIED THEN THE
  913. ; VALUE AT THAT ADDRESS IS OUTPUT.
  914. ;
  915. DUMP:    CALL    SCONV    ;SCAN TO FIRST ADDRESS AND CONVERT IT
  916.     PUSH    H    ;SAVE THE VALUE
  917.     CALL    PSCAN    ;SEE IF SECOND WAS GIVIN
  918.     POP    D
  919.     XCHG        ;HL HAS START, DE HAS END
  920. ;
  921. DLOOP:    CALL    CRLF
  922.     CALL    ADOUT    ;OUTPUT ADDRESS
  923.     CALL    BOUT    ;ANOTHER SPACE TO KEEP IT PRETTY
  924.     MVI    C,16    ;VALUES PER LINE
  925. ;
  926. DLP1:    MOV    A,M    ;GET THE CHAR
  927.     PUSH    B    ;SAVE VALUE COUNT
  928.     CALL    HBOUT    ;SEND IT OUT WITH A BLANK
  929.     MOV    A,L    ;COMPARE DE AND HL
  930.     SUB    E
  931.     MOV    A,H
  932.     SBB    D
  933.     JNC    COMND    ;ALL DONE
  934.     POP    B    ;VALUES PER LINE
  935.     INX    H
  936.     DCR    C    ;BUMP THE LINE COUNT
  937.     JNZ    DLP1    ;NOT ZERO IF MORE FOR THIS LINE
  938.     JMP    DLOOP    ;DO A LFCR BEFORE THE NEXT
  939. ;
  940. ;
  941. ;  OUTPUT HL AS HEX 16 BIT VALUE
  942. ;
  943. ADOUT:    MOV    A,H    ;H FIRST
  944.     CALL    HEOUT
  945.     MOV    A,L    ;THEN L FOLLOWED BY A SPACE
  946. ;
  947. HBOUT:    CALL    HEOUT
  948.     CALL    SINP    ;SEE IF A CHAR WAITING
  949.     JZ    BOUT    ;NO
  950.     ANI    7FH    ;CLR PARITY FIRST THO
  951.     JZ    COMND    ;EITHER MODE OR CTRL-@
  952.     CPI    ' '    ;IS IT A SPACE
  953.     JNZ    BOUT    ;NO...IGNORE THE CHAR
  954. WTLP1:    CALL    SINP    ;IF SPACE, WAIT UNTIL ANY OTHER KEY HIT
  955.     JZ    WTLP1    ;THIS ALLOWS LOOKING AT THE DISPLAY
  956. BOUT:    MVI    B,' '
  957.     JMP    SOUT    ;PUT IT OUT
  958. ;
  959. HEOUT:    MOV    C,A    ;GET THE CHARACTER
  960.     RRC        ;MOVE THE HIGH FOUR DOWN
  961.     RRC
  962.     RRC
  963.     RRC
  964.     CALL    HEOU1    ;PUT THEM OUT
  965.     MOV    A,C    ;THIS TIME THE LOW FOUR
  966. ;
  967. HEOU1:    ANI    0FH    ;FOUR ON THE FLOOR
  968.     ADI    48    ;WE WORK WITH ASCII HERE
  969.     CPI    58    ;0-9?
  970.     JC    OUTH    ;YUP
  971.     ADI    7    ;MAKE IT A LETTER
  972. OUTH:    MOV    B,A    ;OUTPUT IT FROM REGISTER 'B'
  973.     JMP    SOUT
  974. ;
  975. ;
  976. ;    ***** ENTER COMMAND *****
  977. ;
  978. ;    THIS ROUTINE GETS VALUES FROM THE KEYBOARD AND ENTERS
  979. ; THEM INTO MEMORY.  THE INPUT VALUES ARE SCANNED FOLLOWING
  980. ; A STANDARD 'GCLIN' INPUT SO ON SCREEN EDITING MAY TAKE
  981. ; PLACE PRIOR TO THE LINE TERMINATOR.  A BACK SLASH '/'
  982. ; ENDS THE ROUTINE AND RETURNS CONTROL TO THE COMMAND MODE.
  983. ; A COLON ':' SETS THE PREVIOUS VALUE AS A NEW ADDRESS FOR
  984. ; ENTRY.
  985. ;
  986. ENTER:    CALL    SCONV    ;SCAN OVER CHARS AND GET ADDRESS
  987.     PUSH    H    ;SAVE ADDRESS
  988.     XRA    A
  989.     STA    OPORT    ;ENTER VALUES TO SCREEN BUFFER
  990. ;
  991. ENLOP:    CALL    CRLF
  992.     MVI    B,':'
  993.     CALL    CONT    ;GET LINE OF INPUT
  994.     CALL    CREM    ;REMOVE THE CURSOR
  995.     MVI    C,1    ;START SCAN
  996.     CALL    VDAD2    ;GET ADDRESS
  997.     XCHG        ;....TO DE
  998. ;
  999. ;
  1000. ENLO1:    MVI    C,3    ;NO MORE THAN THREE SPACES BETWEEN VALUES
  1001.     CALL    SCHR1    ;SCAN TO NEXT VALUE
  1002.     JZ    ENLOP    ;LAST ENTRY FOUND, START NEW LINE
  1003. ;
  1004.     CPI    '/'    ;COMMAND TERMINATOR
  1005.     JZ    COMN1    ;IF SO, RETURN TO STANDARD INPUT
  1006.     CALL    SHEX    ;CONVERT VALUE
  1007.     CPI    ':'    ;ADDRESS TERMINATOR
  1008.     JZ    ENLO3    ;GO PROCESS IF SO
  1009.     MOV     A,L    ;GET LOW PART AS CONVERTED
  1010.     POP    H    ;GET MEMORY ADDRESS
  1011.     MOV    M,A    ;PUT IN THE VALUE
  1012.     INX    H
  1013.     PUSH    H    ;BACK GOES THE ADDRESS
  1014.     JMP    ENLO1    ;CONTINUE THE SCAN
  1015. ;
  1016. ENLO3:    XTHL        ;PUT NEW ADDRESS ON STACK
  1017.     INX    D    ;MOVE SCAN PAST TERMINATOR    
  1018.     JMP    ENLO1
  1019. ;
  1020. ;
  1021. ;    ***** EXECUTE COMMAND *****
  1022. ;
  1023. ;    THIS ROUTINE GETS THE FOLLOWING PARAMETER AND DOES A
  1024. ; PROGRAM JUMP TO THE LOCATION GIVEN BY IT.  IF PROPER
  1025. ; STACK OPERATIONS ARE USED WITHIN THE EXTERNAL PROGRAM
  1026. ; IT CAN DO A STANDARD 'RET'URN TO THE SOLOS COMMAND MODE.
  1027. ; THE STARTING ADDRESS OF SOLOS IS PASSED TO THE PROGRAM
  1028. ; IN REGISTER PAIR HL SO IT CAN ADJUST INTERNAL PARAMETERS
  1029. ; FOR SOLOS OPERATION.
  1030. ;
  1031. ;
  1032. EXEC:    CALL    SCONV    ;SCAN PAST BLANKS AND GET PARAMETER
  1033. EXEC1:    PUSH    H    ;PUT GO ADDRESS ON STACK
  1034.     LXI    H,START    ;TELL THE PROGRAM WHERE WE CAME FROM
  1035.     RET        ;AND DISPATCH IT
  1036. ;
  1037. ;
  1038. ;    THIS ROUTINE GETS A NAME OF UP TO 5 CHARACTERS
  1039. ; FROM THE INPUT STRING.  IF THE TERMINATOR IS A 
  1040. ; SLASH (/) THEN THE CHARACTER FOLLOWING IS TAKEN
  1041. ; AS THE CASSETTE UNIT SPECIFICATION.
  1042. ;
  1043. ;
  1044. NAMES:    LXI    H,THEAD    ;POINT TO INTERNAL HEADER
  1045. NAME:    CALL    SBLK    ;SCAN OVER TO FIRST CHRS
  1046.     MVI    B,6    ;UP TO SIX ARE ACCEPTED
  1047. ;
  1048. NAME1:    LDAX    D    ;GET CHARACTER
  1049.     CPI    ' '    ;NO UNIT DELIMITER
  1050.     JZ    NFIL
  1051.     CPI    '/'    ;UNIT DELIMITER
  1052.     JZ    NFIL
  1053.     MOV    M,A
  1054.     INX    D    ;BUMP THE SCAN POINTER
  1055.     INX    H
  1056.     DCR    B
  1057.     JNZ    NAME1    ;FALL THROUGH TO ERR1 IF TOO MANY CHRS IN NAME
  1058. ;
  1059. ;
  1060. ;    ***** SOLOS ERROR HANDLER *****
  1061. ;
  1062. ERR1:    XCHG        ;GET SCAN ADDRESS TO HL
  1063. ERR2:    MVI    M,'?'    ;PUT QUESTION MARK ON SCREEN
  1064.     JMP    COMN1    ;AND RETURN TO COMMAND MODE
  1065. ;
  1066. ;
  1067. ;    HERE WE HAVE SCANNED OFF THE NAME.  ZERO FILL FOR
  1068. ; NAMES LESS THAN FIVE CHARACTERS.
  1069. ;
  1070. NFIL:    MVI    M,0    ;PUT IN AT LEAST ONE ZERO
  1071.     INX    H
  1072.     DCR    B
  1073.     JNZ    NFIL    ;LOOP UNTIL B IS ZERO
  1074. ;
  1075.     CPI    '/'    ;IS THERE A UNIT SPECIFICATION?
  1076.     MVI    A,1    ;PRETEND NOT
  1077.     JNZ    DEFLT
  1078.     INX    D    ;MOVE PAST THE TERMINATOR
  1079.     CALL    SCHR    ;GO GET UNIT SPEC
  1080.     SUI    '0'    ;REMOVE ASCII BIAS
  1081. ;
  1082. DEFLT:    EQU    $    ;MOVE OVER TO INTERNAL REPRESENTATION
  1083.     ANI    1    ;JUST BIT ZERO
  1084.     MVI    A,TAPE1    ;ASSUME TAPE ONE
  1085.     JNZ    STUNT    ;IF NON-ZERO, ITS ONE
  1086.     RAR
  1087. STUNT:    STA    FNUMF    ;SET IT IN
  1088.     RET
  1089. ;
  1090. ;
  1091. ;
  1092. ;   THIS ROUTINE PROCESSES THE XEQ AND GET COMMANDS
  1093. ;
  1094. ;
  1095. TXEQ:    DB    3EH    ;THIS BEGINS "MVI A,0AFH"
  1096. TLOAD:    XRA    A    ;A=0 MEANS TLOAD, ELSE TXEQ
  1097.     PUSH    PSW    ;SAVE FLAG FOR LATER
  1098.     LXI    H,DHEAD    ;PLACE DUMMY HEADER HERE
  1099.     CALL    NAME    ;SET IN NAME AND UNIT
  1100.     LXI    H,0    ;PRETEND NO SECOND VALUE
  1101.     CALL    PSCAN    ;GO GET THE ADDRESS (IF PRESENT)
  1102. ;
  1103. TLOA2:    XCHG        ;PUT ADDRESS IN DE
  1104.     LXI    H,DHEAD    ;POINT TO DUMMY HEADER WITH NAME TO LOAD
  1105.     MOV    A,M    ;SEE IF A NAME WAS ENTERED
  1106.     ORA    A    ;IS THERE A NAME?
  1107.     JNZ    TLOA3    ;YES...SEARCH FOR IT
  1108.     LXI    H,THEAD    ;NO NAME, LOAD 1ST FILE
  1109. TLOA3:    PUSH    H    ;SAVE PTR TO NAME TO LOAD
  1110.     CALL    ALOAD    ;GET UNIT AND SPEED
  1111.     POP    H    ;RESTORE PTR TO HDR TO LOAD
  1112.     CALL    RTAPE    ;READ IN THE TAPE
  1113.     JC    TAERR    ;TAPE ERROR?
  1114. ;
  1115.     CALL    NAOUT    ;PUT OUT THE HEADER PARAMETERS
  1116.     POP    PSW    ;RESTORE FLAG FROM ORIGINAL ENTRY
  1117.     ORA    A
  1118.     RZ        ;AUTO XEQ NOT WANTED
  1119.     LDA    HTYPE    ;CHECK TYPE
  1120.     ORA    A    ;SET FLAGS
  1121.     JM    TAERR    ;TYPE IS NOW XEQ
  1122.     LDA    THEAD+5    ;GET CHARACTER PAST NAME
  1123.     ORA    A
  1124.     JNZ    TAERR    ;THE BYTE MUST BE ZERO FOR AUTO XEQ
  1125.     LHLD    XEQAD    ;GET THE TAPE ADDRESS
  1126.     JMP    EXEC1    ;AND GO TO IT
  1127. ;
  1128. ;
  1129. ;    ***** GET COMMAND *****
  1130. ;
  1131. ; THIS ROUTINE IS USED TO SAVE PROGRAMS AND DATA ON
  1132. ; THE CASSETTE UNIT
  1133. ;
  1134. ;
  1135. TSAVE:    CALL    NAMES    ;GET NAME AND UNIT
  1136.     CALL    SCONV    ;GET START ADDRESS
  1137.     PUSH    H    ;USE THE STACK AS A REGISTER
  1138.     CALL    SCONV    ;GET END ADDRESS
  1139.     XTHL        ;PUT END ON STACK, GET BACK START
  1140.     PUSH    H    ;SAVE START ON TOP OF STACK
  1141.     CALL    PSCAN    ;SEE IF OPTIONAL HEADER ADDRESS WAS GIVEN
  1142.     SHLD    LOADR    ;PUT HEADER ADDRESS IN PLACE
  1143. ;
  1144.     POP    H    ;"FROM" ADDRESS TO HL
  1145.     POP    D    ;GET BACK END ADDRESS
  1146.     PUSH    H    ;SAVE FROM AGAIN FOR LATER
  1147.     MOV    A,E    ;NOW CALCULATE SIZE
  1148.     SUB    L    ;SIZE=END-START+1
  1149.     MOV    L,A
  1150.     MOV    A,D
  1151.     SBB    H
  1152.     MOV    H,A
  1153.     INX    H
  1154.     SHLD    BLOCK    ;STORE THE SIZE
  1155.     PUSH    H    ;SAVE IT FOR THE READ ALSO
  1156. ;
  1157.     CALL    ALOAD    ;GET UNIT AND SPEED
  1158.     LXI    H,THEAD    ;POINT TO HEADER
  1159.     CALL    WHEAD    ;AND WRITE IT OUT
  1160. ;  NOW WRITE OUT THE DATA
  1161.     POP    D    ;GET SIZE TO DE
  1162.     POP    H    ;GET BACK "FROM" ADDRESS
  1163.     JMP    WRLO1    ;WRITE OUT THE DATA AND RETURN
  1164. ;
  1165. ;
  1166. ;   OUTPUT ERROR AND HEADER
  1167. ;
  1168. TAERR:    CALL    CRLF
  1169.     MVI    D,6
  1170.     LXI    H,ERRM    ;POINT TO ERROR MESSAGE
  1171.     CALL    NLOOP    ;OUTPUT ERROR
  1172.     CALL    NAOUT    ;THEN THE HEADER
  1173.     JMP    COMN1    ;AND BE SURE THE TAPE UNITS ARE OFF
  1174. ;
  1175. ERRM:    DB    'ERROR '
  1176. ;
  1177. ;
  1178. ;   THIS ROUTINE READS HEADERS FROM THE TAPE AND OUTPUTS
  1179. ; THEM TO THE OUTPUT DEVICE.  IT CONTINUES UNTIL THE
  1180. ; MODE KEY IS DEPRESSED.
  1181. ;
  1182. TLIST:    CALL    NAMES    ;SET UP UNIT IF GIVEN
  1183.     CALL    CRLF
  1184. ;
  1185. ;
  1186. LLIST:    CALL    ALOAD
  1187.     MVI    B,1
  1188.     CALL    TON    ;TURN ON THE TAPE
  1189. ;
  1190. LIST1:    CALL    RHEAD
  1191.     JC    COMN1    ;TURN OFF THE TAPE UNIT
  1192.     JNZ    LIST1
  1193.     CALL    NAOUT    ;OUTPUT THE HEADER
  1194.     JMP    LIST1    ;LOOP UNTIL MODE IS DEPRESSED
  1195. ;
  1196. ;
  1197. ; THIS ROUTINE GETS THE CASSETTE UNIT NUMBER AND
  1198. ; SPEED TO REGISTER "A" FOR THE TAPE CALLS
  1199. ;
  1200. ALOAD:    LXI    H,FNUMF    ;POINT TO THE UNIT SPECIFICATION
  1201.     LDA    TSPD    ;GET THE TAPE SPEED
  1202.     ORA    M    ;PUT THEM TOGETHER
  1203.     RET        ;AND GO BACK
  1204. ;
  1205. ;
  1206. ; THIS ROUTINE OUTPUTS THE NAME AND PARAMETERS OF
  1207. ; THEAD TO THE OUTPUT DEVICE.
  1208. ;
  1209. ;
  1210. NAOUT:    MVI    D,8
  1211.     LXI    H,THEAD-1    ;POINT TO THE HEADER
  1212.     CALL    NLOOP    ;OUTPUT THE HEADER
  1213.     CALL    BOUT    ;ANOTHER BLANK
  1214.     LHLD    LOADR    ;NOW THE LOAD ADDRESS
  1215.     CALL    ADOUT    ;PUT IT OUT
  1216.     LHLD    BLOCK    ;AND THE BLOCK SIZE
  1217.     CALL    ADOUT
  1218.     JMP    CRLF    ;DO THE CRLF AND RETURN
  1219. ;
  1220. ;
  1221. NLOOP:    MOV    A,M    ;GET CHARACTER
  1222.     ORA    A
  1223.     JNZ    CHRLI    ;IF IT ISN'T A ZERO
  1224.     MVI    A,' '
  1225. CHRLI:    CALL    OUTH    ;OUTPUT CHAR NOW
  1226.     INX    H
  1227.     DCR    D
  1228.     JNZ    NLOOP
  1229.     RET
  1230. ;
  1231. ;
  1232. ;
  1233. ;
  1234. ;    ***** SET COMMAND *****
  1235. ;
  1236. ; THIS ROUTINE GETS THE ASSOCIATED PARAMETER AND
  1237. ; DISPATCHES TO THE PROPER ROUTINE FOR SETTING
  1238. ; GLOBAL VALUES.
  1239. ;
  1240. CSET:    EQU    $    ;THIS IS THE SET COMMAND
  1241.     CALL    SBLK    ;LOOK FOR SET NAME
  1242.     JZ    ERR1    ;MUST HAVE A LEAST SOMETHING!!
  1243.     PUSH    D    ;SAVE SCAN ADDRESS
  1244.     CALL    SCONV    ;CONVERT FOLLOWING VALUE
  1245.     XTHL        ;GET SCAN ADDR BACK...SAVE VALUE ON STACK
  1246.     LXI    D,SETAB    ;SECONDARY COMMAND TABLE
  1247.     CALL    FDCOM    ;SEE IF IN TABLE
  1248.     JMP    DISPO    ;AND EITHER ERR OR OFF TO IT
  1249. ;
  1250. ;
  1251. ; THIS ROUTINE SETS THE TAPE SPEED
  1252. ;
  1253. TASPD:    ORA    A    ;IS IT ZERO?
  1254.     JZ    SETSP    ;YES...THAT'S A VALID SPEED
  1255.     MVI    A,32    ;SET TO SLOW IF NON-ZERO
  1256. SETSP:    STA    TSPD    ;SPEED IS STORED HERE
  1257.     RET
  1258. ;
  1259. ;
  1260. STSPD:    MOV    A,B    ;ESCAPE COMES HERE TO SET SPEED
  1261. DISPD:    STA    SPEED    ;SET DISPLAY SPEED
  1262.     RET
  1263. ;
  1264. ; SET INPUT DRIVER
  1265. ;
  1266. SETIN:    EQU    $
  1267.     STA    IPORT
  1268.     RET
  1269. ;
  1270. ; SET OUTPUT DRIVER
  1271. ;
  1272. SETOT:    EQU    $
  1273.     STA    OPORT
  1274.     RET
  1275. ;
  1276. ; SET USERS CUSTOM INPUT DRIVER ADDRESS
  1277. ;
  1278. SETCI:    SHLD    UIPRT
  1279.     RET
  1280. ;
  1281. ; SET USERS CUSTOM OUTPUT DRIVER ADDRESS
  1282. ;
  1283. SETCO:    SHLD    UOPRT
  1284.     RET
  1285. ;
  1286. ; SET TYPE BYTE INTO HEADER
  1287. ;
  1288. SETTY:    STA    HTYPE
  1289.     RET
  1290. ;
  1291. ; SET EXECUTE ADDRESS INTO HEADER
  1292. ;
  1293. SETXQ:    SHLD    XEQAD
  1294.     RET
  1295. ;
  1296. ;
  1297. SETNU:    STA    NUCNT    ;SET THE NULL COUNT
  1298.     RET        ;THAT'S DONE
  1299. ;
  1300. ;
  1301. SETCR:    EQU    $    ;SET TO IGNORE CRC ERRORS
  1302.     STA    IGNCR    ;FF=IGNORE ERRORS, ELSE=NORMAL
  1303.     RET
  1304. ;
  1305. ;
  1306. ;
  1307. ;  CUSTOM COMMAND NAME AND ADDRESS INTO CUSTOM COMMAND
  1308. ;
  1309. CUSET:    CALL    NAMES    ;CUSTOM COMMAND ENTRY/REMOVAL
  1310.     LXI    H,COMND    ;DEFAULT ADDR IF NONE GIVEN
  1311.     CALL    PSCAN    ;GET RTN ADDRESS
  1312.     PUSH    H    ;SAVE RTN ADDRESS
  1313.     LXI    H,THEAD    ;POINT AT NAME TO SEARCH
  1314.     CALL    FDCOU    ;SEARCH IT IN CUSTOM TABLE
  1315.     JZ    CUSE2    ;NOT IN TABLE...ENTER IT
  1316.     DCX    D    ;IN TABLE, REMOVE IT
  1317.     MVI    M,0    ;CHANGE NEW NAME TO BE ZERO
  1318. CUSE2:    MOV    A,M    ;GET 1ST CHAR OF NAME
  1319.     STAX    D    ;ENTER IT INTO TABLE
  1320.     INX    D    ;AND THE 2ND NAME
  1321.     INX    H
  1322.     MOV    A,M
  1323.     STAX    D    ;NAME NOW ENTERED
  1324.     INX    D    ;GET SET TO ENTER ADDRESS
  1325.     POP    H    ;RESTORE RTN ADDR
  1326.     XCHG
  1327.     MOV    M,E    ;SET ADDR IN NOW
  1328.     INX    H    ;AND HI BYTE OF ADDR
  1329.     MOV    M,D
  1330.     RET        ;NAME IS NOW ENTERED OR CLEARED
  1331. ;
  1332. ;
  1333. ;
  1334. ; THE FOLLOWING ROUTINES PROVIDE "BYTE BY BYTE" ACCESS
  1335. ; TO THE CASSETTE TAPES ON EITHER A READ ORWRITE BASIS.
  1336. ;
  1337. ; THE TAPE IS READ ONE BLOCK AT A TIME AND INDIVIDUAL
  1338. ; TRANSFERS OF DATA HANDLED BY MANAGING A BUFFER AREA.
  1339. ;
  1340. ; THE BUFFER AREA IS CONTROLLED BY A FILE CONTROL BLOCK
  1341. ; (FCB) WHOSE STRUCTURE IS:
  1342. ;
  1343. ;    7 BYTES FOR EACH OF THE TWO FILES STRUCTURED AS
  1344. ;    FOLLOWS:
  1345. ;
  1346. ;    1 BYTE - ACCESS CONTROL      00 IF CLOSED
  1347. ;                  FF IF READING
  1348. ;                  FEIF WRITING
  1349. ;    1 BYTE - READ COUNTER
  1350. ;    1 BYTE - BUFFER POSITION POINTER
  1351. ;    2 BYTE - CONTROL HEADER ADDRESS
  1352. ;    2 BYTE - BUFFER LOCATION ADDRESS
  1353. ;
  1354. ;
  1355. ;
  1356. ; THIS ROUTINE "OPENS" THE CASSETTE UNIT FOR ACCESS
  1357. ;
  1358. ; ON ENTRY:     A - HAS THE TAPE UNIT NUMBER (1 OR 2)
  1359. ;        HL - HAS USER SUPPLIED HEADER FOR TAPE FILE
  1360. ;
  1361. ;
  1362. ; NORMAL RETURN:  ALL REGISTERS ARE ALTERED
  1363. ;          BLOCK IS READY FOR ACCESS
  1364. ;
  1365. ; ERROR RETURN:   CARRY BIT IS SET
  1366. ;
  1367. ; ERRORS:   BLOCK ALREADY OPEN
  1368. ;
  1369. ;
  1370. BOPEN:    PUSH    H    ;SAVE HEADER ADDRESS
  1371.     CALL    LFCB    ;GET ADDRESS OF FILE CONTROL
  1372.     JNZ    TERE2    ;FILE WAS ALREADY OPEN
  1373.     MVI    M,1    ;NOW IT IS
  1374.     INX    H    ;POINT TO READ COUNT
  1375.     MOV    M,A    ;ZERO
  1376.     INX    H    ;POINT TO BUFFER CURSOR
  1377.     MOV    M,A    ;PUT IN THE ZERO COUNT
  1378. ;
  1379. ; ALLOCATE THE BUFFER
  1380. ;
  1381.     LXI    D,FBUF1    ;POINT TO BUFFER AREA
  1382.     LDA    FNUMF    ;GET WHICH ONE WE ARE GOING TO USE
  1383.     ADD    D
  1384.     MOV    D,A    ;256 BIT ADD
  1385. ;
  1386. UBUF:    POP    B    ;HEADER ADDRESS
  1387.     ORA    A    ;CLEAR CARRY AND RET AFTER STORING PARAMS
  1388.     JMP    PSTOR    ;STORE THE VALUES
  1389. ;
  1390. ; GENERAL ERROR RETURN POINTS FOR STACK CONTROL
  1391. ;
  1392. TERE2:    POP    H
  1393. TERE1:    POP    D
  1394. TERE0:    XRA    A    ;CLEAR ALL FLAGS
  1395.     STC        ;SET ERROR
  1396.     RET
  1397. ;
  1398. ;
  1399. EOFER:    DCR    A    ;SET MINUS FLAGS
  1400.     STC        ;AND CARRY
  1401.     POP    D    ;CLEAR THE STACK
  1402.     RET        ;THE FLAGS TELL ALL
  1403. ;
  1404. ;
  1405. ;
  1406. ;
  1407. ; THIS ROUTINE CLOSES THE FILE BUFFER TO ALLOW ACCESS
  1408. ; FOR A DIFFERENT CASSETTE OF PROGRAM.  IF THE TILE
  1409. ; OPERATIONS WERE "WRITE" THEN THE LAST BLOCK IS WRITTEN
  1410. ; OUT AND AN "END OF FILE" WRITTEN TO THE TAPE.  IF
  1411. ; THE OPERATIONS WERE "READS" THEN THE FILE IS JUST
  1412. ; MADE READY FOR NEW USE.
  1413. ;
  1414. ; ON ENTRY:   A - HAS WHICH UNIT (1 OR 2)
  1415. ;
  1416. ; ERROR RETURNS:   FILE WASN'T OPEN
  1417. ;
  1418. ;
  1419. PCLOS:    CALL    LFCB    ;GET CONTROL BLOCK ADDRESS
  1420.     RZ        ;WASN'T OPEN, CARRY IS SET FROM LFCR
  1421.     ORA    A    ;CLEAR CARRY
  1422.     INR    A    ;SET CONDITION FLAGS
  1423.     MVI    M,0    ;CLOSE THE CONTROL BYTE
  1424.     RZ        ;WE WERE READING...NOTHING MORE TO DO
  1425. ;
  1426. ; THE FILE OPERATIONS WERE "WRITES"
  1427. ;
  1428. ; PUT THE CURRENT BLOCK ON THE TAPE
  1429. ; (EVEN IF ONLY ONE BYTE)
  1430. ; THEN WRITE AN END OF FILE TO THE TAPE
  1431. ;
  1432. ;
  1433.     INX    H
  1434.     INX    H
  1435.     MOV    A,M    ;GET CURSOR POSITION
  1436.     CALL    PLOAD    ;BC GET HEADER ADDRESS, DE BUFFER ADDRESS
  1437.     PUSH    B    ;HEADER TO STACK
  1438.     LXI    H,BLKOF    ;OFFSET TO BLOCK SIZE
  1439.     DAD    B
  1440.     ORA    A    ;TEST COUNT
  1441.     JZ    EOFW    ;NO BYTES...JUST WRITE EOF
  1442. ;
  1443. ; WRITE LAST BLOCK
  1444. ;
  1445.     PUSH    H    ;SAVE BLOCK SIZE POINTER FOR EOF
  1446.     MOV    M,A    ;PUT IN COUNT
  1447.     INX    H
  1448.     MVI    M,0    ;ZERO THE HIGHER BYTE
  1449.     INX    H
  1450.     MOV    M,E    ;BUFFER ADDRESS
  1451.     INX    H
  1452.     MOV    M,D
  1453.     MOV    H,B
  1454.     MOV    L,C    ;PUT HEADER ADDRESS IN HL
  1455.     CALL    WFBLK    ;GO WRITE IT OUT
  1456.     POP    H    ;BLOCK SIZE POINTER
  1457. ;
  1458. ; NOW WRITE END OF FILE TO CASSETTE
  1459. ;
  1460. EOFW:    XRA    A    ;PUT IN ZEROS FOR SIZE
  1461.             ;EOF MARK IS ZERO BYTES!
  1462.     MOV    M,A
  1463.     INX    H
  1464.     MOV    M,A
  1465.     POP    H    ;HEADER ADDRESS
  1466.     JMP    WFBLK    ;WRITE IT OUT AND RETURN
  1467. ;
  1468. ;
  1469. ;
  1470. ;
  1471. ; THIS ROUTINE LOCATES THE FILE CONTROL BLOCK POINTED TO
  1472. ; BY REGISTER "A".  ON RETURN HL POINTS TO THE CONTROL BYTE
  1473. ; AND REGISTER "A" HAS THE CONTROL WORD WITH THE FLAGS
  1474. ; SET FOR IMMEDIATE CONDITION DECISIONS.
  1475. ;
  1476. ;
  1477. LFCB:    LXI    H,FCBAS    ;POINT TO THE BASE OF IT
  1478.     RAR        ;MOVE THE 1 & 2 TO 0 & 1 
  1479.     ANI    1    ;SMALL NUMBERS ARE THE RULE
  1480.     STA    FNUMF    ;CURRENT ACCESS FILE NUMBER
  1481.     JZ    LFCB1    ;UNIT ONE (VALUE OF ZERO)
  1482.     LXI    H,FCBA2    ;UNIT TWO--POINT TO ITS FCB
  1483. LFCB1:    EQU    $    ;HL POINT TO PROPER FCB
  1484.     MOV    A,M    ;PICK UP FLAGS FROM FCB
  1485.     ORA    A    ;SET FLAGS BASED ON CONTROL WORD
  1486.     STC        ;SET CARRY IN CASE OF IMMEDIATE ERROR RET
  1487.     RET
  1488. ;
  1489. ;
  1490. ;
  1491. ;
  1492. ;    READ TAPE BYTE ROUTINE
  1493. ;
  1494. ; ENTRY:    - A - HAS FILE NUMBER
  1495. ; EXIT:  NORMAL - A - HAS BYTE
  1496. ;     ERROR
  1497. ;        CARRY SET       - IF FILE NOT OPEN OR
  1498. ;                 PREVIOUS OPERATIONS WERE WRITE
  1499. ;        CARRY & MINUS  - END OF FILE ENCOUNTERED
  1500. ;
  1501. ;
  1502. ;
  1503. ;
  1504. RTBYT:    CALL    LFCB    ;LOCATE THE FILE CONTROL BLOCK
  1505.     RZ        ;FILE NOT OPEN
  1506.     INR    A    ;TEST IF FF
  1507.     JM    TERE0    ;ERROR WAS WRITING
  1508.     MVI    M,(-1) AND 0FFH    ;SET IT AS READ (IN CASE IT WAS JUST OPENED)
  1509.     INX    H
  1510.     MOV    A,M    ;GET READ COUNT
  1511.     PUSH    H    ;SAVE COUNT ADDRESS
  1512.     INX    H
  1513.     CALL    PLOAD    ;GET THE OTHER PARAMETERS
  1514.     POP    H
  1515.     ORA    A
  1516.     JNZ    GTBYT    ;IF NOT EMPTY GO GET BYTE
  1517. ;
  1518. ; CURSOR POSITION WAS ZERO...READ A NEW BLOCK
  1519. ; INTO THE BUFFER.
  1520. ;
  1521. RDNBLK:    PUSH    D    ;BUFFER POINTER
  1522.     PUSH    H    ;TABLE ADDRESS
  1523.     INX    H
  1524.     CALL    PHEAD    ;PREPARE THE HEADER FOR READ
  1525.     CALL    RFBLK    ;READ IN THE BLOCK
  1526.     JC    TERE2    ;ERROR POP OFF STACK BEFORE RETURN
  1527.     POP    H
  1528.     MOV    A,E    ;LOW BYTE OF COUNT (WILL BE ZERO IF 256)
  1529.     ORA    D    ;SEE IF BOTH ARE ZERO
  1530.     JZ    EOFER    ;BYTE COUNT WAS ZERO...END OF FILE
  1531.     MOV    M,E    ;NEW COUNT (ZERO IS 256 AT THIS POINT)
  1532.     INX    H    ;BUFFER LOCATION POINTER
  1533.     MVI    M,0
  1534.     DCX    H
  1535.     MOV    A,E    ;GET BACK BUFFER ADDRESS
  1536.     POP    D
  1537. ;
  1538. ;
  1539. ;
  1540. ; THIS ROUTINE GETS ONE BYTE FROM THE BUFFER
  1541. ; AND RETURNS IT IN REGISTER "A".  IF THE END
  1542. ; OF THE BUFFER IS REACHED IT MOVES THE POINTER
  1543. ; TO THE BEGINNING OF THE BUFFER FOR THE NEXT
  1544. ; LOAD.
  1545. ;
  1546. GTBYT:    DCR    A    ;BUMP THE COUNT
  1547.     MOV    M,A    ;RESTORE IT
  1548.     INX    H
  1549.     MOV    M,A    ;GET BUFFER POSITION
  1550.     INR    M    ;BUMP IT
  1551. ;
  1552.     ADD    E
  1553.     MOV    E,A    ;DE NOW POINT TO CORRECT BUFFER POSITION
  1554.     JNC    RT1
  1555.     INR    D
  1556. RT1:    LDAX    D    ;GET CHARACTER FROM BUFFER
  1557.     ORA    A    ;CLEAR CARRY
  1558.     RET        ;ALL DONE
  1559. ;
  1560. ;
  1561. ;
  1562. ; THIS ROUTINE IS USED TO WRITE A BYTE TO THE FILE
  1563. ;
  1564. ; ON ENTRY:    A - HAS FILE NUMBER
  1565. ;        B - HAS DATA BYTE
  1566. ;
  1567. ;
  1568. WTBYT:    CALL    LFCB    ;GET CONTROL BLOCK
  1569.     RZ        ;FILE WASN'T OPEN
  1570.     INR    A
  1571.     RZ        ;FILE WAS READ
  1572.     MVI    M,0FEH    ;SET IT TO WRITE
  1573.     INX    H
  1574.     INX    H
  1575.     MOV    A,B    ;GET CHARACTER
  1576.     PUSH    PSW
  1577.     PUSH    H    ;SAVE CONTROL ADDRESS+2
  1578. ;
  1579. ; NOW DO THE WRITE
  1580. ;
  1581.     CALL    PLOAD    ;BC GETS HEADER ADDR
  1582.             ;DE BUFFER ADDRESS
  1583.     POP    H
  1584.     MOV    A,M    ;COUNT BYTE
  1585.     ADD    E
  1586.     MOV    E,A
  1587.     JNC    WT1
  1588.     INR    D
  1589. WT1:    POP    PSW    ;CHARACTER
  1590.     STAX    D    ;PUT CHR IN BUFFER
  1591.     ORA    A    ;CLEAR FLAGS
  1592.     INR    M    ;INCREMENT THE COUNT
  1593.     RNZ        ;RETURN IF COUNT DIDN'T ROLL OVER
  1594. ;
  1595. ; THE BUFFER IS FULL.  WRITE IT TO TAPE
  1596. ; AND RESET CONTROL BLOCK.
  1597. ;
  1598.     CALL    PHEAD    ;PREPARE THE HEADER
  1599.     JMP    WFBLK    ;WRITE IT OUT AND RETURN
  1600. ;
  1601. ;
  1602. ;
  1603. ;
  1604. ; THIS ROUTINE PUTS THE BLOCK SIZE (256) AND BUFFER
  1605. ; ADDRESS IN THE FILE HEADER.
  1606. ;
  1607. PHEAD:    CALL    PLOAD    ;GET HEADER AND BUFFER ADDRESSES
  1608.     PUSH    B    ;HEADER ADDRESS
  1609.     LXI    H,BLKOF-1    ;PSTOR DOES AN INCREMENT
  1610.     DAD    B    ;HL POINTS TO  BLOCKSIZE ENTRY
  1611.     LXI    B,256
  1612.     CALL    PSTOR
  1613.     POP    H    ;HL RETURN WITH HEADER ADDRESS
  1614.     RET
  1615. ;
  1616. ;
  1617. PSTOR:    INX    H
  1618.     MOV    M,C
  1619.     INX    H
  1620.     MOV    M,B
  1621.     INX    H
  1622.     MOV    M,E
  1623.     INX    H
  1624.     MOV    M,D
  1625.     RET
  1626. ;
  1627. ;
  1628. PLOAD:    INX    H
  1629.     MOV    C,M
  1630.     INX    H
  1631.     MOV    B,M
  1632.     INX    H
  1633.     MOV    E,M
  1634.     INX    H
  1635.     MOV    D,M
  1636.     RET
  1637. ;
  1638. ;
  1639. ;
  1640. ;
  1641. ;THIS ROUTINE SETS THE CORRECT UNIT FOR SYSTEM READS
  1642. ;
  1643. RFBLK:    CALL    GTUNT    ;SET UP A=UNIT WITH SPEED
  1644. ;
  1645. ;
  1646. ;    ***** TAPE READ ROUTINES *****
  1647. ;
  1648. ; ON ENTRY:     A - HAS UNIT AND SPEED
  1649. ;        HL - POINTS TO HEADER BLOCK
  1650. ;        DE - HAS OPTIONAL PUT ADDRESS
  1651. ;
  1652. ; ON EXIT:    CARRY IS SET IF ERROR OCCURED
  1653. ;        TAPE UNITS ARE OFF
  1654. ;
  1655. ;
  1656. RTAPE:    PUSH    D    ;SAVE OPTIONAL ADDRESS
  1657.     MVI    B,3    ;SHORT DELAY
  1658.     CALL    TON
  1659.     IN    TDATA    ;CLEAR THE UART FLAGS
  1660. ;
  1661. PTAP1:    PUSH    H    ;HEADER ADDRESS
  1662.     CALL    RHEAD    ;GO READ HEADER
  1663.     POP    H
  1664.     JC    TERR    ;IF AN ERROR OR ESC WAS RECEIVED
  1665.     JNZ    PTAP1    ;IF VALID HEADER NOT FOUND
  1666. ;
  1667. ; FOUND A VALID HEADER NOW DO COMPARE
  1668. ;
  1669.     PUSH    H    ;GET BACK AND RESAVE ADDRESS
  1670.     LXI    D,THEAD
  1671.     CALL    DHCMP    ;COMPARE DE/HL HEADERS
  1672.     POP    H
  1673.     JNZ    PTAP1
  1674. ;
  1675. ;
  1676.     POP    D    ;OPTIONAL "PUT" ADDRESS
  1677.     MOV    A,D
  1678.     ORA    E    ;SEE IF DE IS ZERO
  1679.     LHLD    BLOCK    ;GET BLOCK SIZE
  1680.     XCHG        ;....TO DE
  1681. ; DE HAS HBLOCK...HL HAS USER OPTION
  1682.     JNZ    RTAP    ;IF DE WAS 0 GET TAPE LOAD ADDR
  1683.     LHLD    LOADR    ;GET TAPE LOAD ADDRESS
  1684. ;
  1685. ;
  1686. ; THIS ROUTINE READS "DE" BYTES FROM THE TAPE
  1687. ; TO ADDRESS HL.  THE BYTES MUST BY FROM ONE
  1688. ; CONTIGUOUS PHYSICAL BLOCK ON THE TAPE.
  1689. ;
  1690. ;    HL HAS "PUT" ADDRESS
  1691. ;    DE HAS SIZE OF TAPE BLOCK
  1692. ;
  1693. RTAP:    PUSH    D    ;SAVE SIZE FOR RETURN TO CALLING PROGRAM
  1694. ;
  1695. RTAP2:    EQU    $    ;HERE TO LOOP RDING BLKS
  1696.     CALL    DCRCT    ;DROP COUNT, B=LEN THIS BLOCK
  1697.     JZ    RTOFF    ;ZERO=ALL DONE
  1698. ;
  1699.     CALL    RHED1    ;READ THAT MANY BYTES
  1700.     JC    TERR    ;IF ERROR OR ESC
  1701.     JZ    RTAP2    ;RD OK...READ SOME MORE
  1702. ;
  1703. ; ERROR RETURN
  1704. ;
  1705. TERR:    XRA    A
  1706.     STC        ;SET ERROR FLAGS
  1707.     JMP    RTOF1
  1708. ;
  1709. ;
  1710. TOFF:    MVI    B,1
  1711.     CALL    DELAY
  1712. RTOFF:    XRA    A
  1713. RTOF1:    OUT    TAPPT
  1714.     POP    D    ;RETURN BYTE COUNT
  1715.     RET
  1716. ;
  1717. ;
  1718. DCRCT:    EQU    $    ;COMMON RTN TO COUNT DOWN BLK LENGTHS
  1719.     XRA    A    ;CLR FOR LATER TESTS
  1720.     MOV    B,A    ;SET THIS BLK LEN = 256
  1721.     ORA    D    ;IS ANMT LEFT < 256
  1722.     JNZ    DCRC2    ;NO...REDUCE AMNT BY 256
  1723.     ORA    E    ;IS ENTIRE COUNT ZERO
  1724.     RZ        ;ALL DONE..ZERO=THIS CONDITION
  1725.     MOV    B,E    ;SET THIS BLK LEN TO AMNT REMAINING
  1726.     MOV    E,D    ;MAKE ENTIRE COUNT ZERO NOW
  1727.     RET        ;ALL DONE (NON-ZERO FLAG)
  1728. DCRC2:    EQU    $    ;REDUCE COUNT BY 256
  1729.     DCR    D    ;DROP BY 256
  1730.     ORA    A    ;FORCE NON-ZERO FLAG
  1731.     RET        ;NON-ZERO=NOT DONE YET (BLK LEN=256)
  1732. ;
  1733. ;
  1734. ; READ THE HEADER
  1735. ;
  1736. RHEAD:    MVI    B,10    ;FIND 10 NULLS
  1737. RHEA1:    CALL    STAT
  1738.     RC        ;IF ESCAPE
  1739.     IN    TDATA    ;IGNORE ERROR CONDITIONS
  1740.     ORA    A    ;ZERO?
  1741.     JNZ    RHEAD
  1742.     DCR    B
  1743.     JNZ    RHEA1    ;LOOP UNTIL 10 IN A ROW
  1744. ;
  1745. ; WAIT FOR THE START CHARACTER
  1746. ;
  1747. SOHL:    CALL    TAPIN
  1748.     RC        ;ERROR OR ESCAPE
  1749.     CPI    1    ;AT LEAST 10 NULLS FOLLOWED BY A 01
  1750.     JC    SOHL    ;STILL A NULL, KEEP WAITING
  1751.     JNZ    RHEAD    ;NON-ZERO, START SEQUENCE OVER AGAIN
  1752. ;
  1753. ; NOW GET THE HEADER
  1754. ;
  1755.     LXI    H,THEAD    ;POINT TO BUFFER
  1756.     MVI    B,HLEN    ;LENGTH TO READ
  1757. ;
  1758. RHED1:    EQU    $    ;RD A BLOCK INTO HL FOR B BYTES
  1759.     MVI    C,0    ;INITALIZE THE CRC
  1760. RHED2:    EQU    $    ;LOOP HERE
  1761.     CALL    TAPIN    ;GET A BYTE
  1762.     RC
  1763.     MOV    M,A    ;STORE IT
  1764.     INX    H    ;INCREMENT ADDRESS
  1765.     CALL    DOCRC    ;GO COMPUTE THE CRC
  1766.     DCR    B    ;WHOLE HEADER YET?
  1767.     JNZ    RHED2    ;DO ALL THE BYTES
  1768. ;
  1769. ; THIS ROUTINE GETS THE NEXT BYTE AND COMPARES IT
  1770. ; TO THE VALUE IN REGISTER C.  THE FLAGS ARE SET ON
  1771. ; RETURN.
  1772. ;
  1773.     CALL    TAPIN    ;GET CRC BYTE
  1774.     XRA    C    ;CLR CARRY AND SET ZERO IF MATCH
  1775.             ;    ELSE NON-ZERO
  1776.     RZ        ;CRC WAS FINE
  1777.     LDA    IGNCR    ;GET POSSIBLE OVERRIDE CRC ERROR FLAG
  1778.     INR    A    ;FF=IGNORE CRC ERRORS
  1779.     RET        ;ELSE PROCESS CRC ERROR
  1780. ;
  1781. ;
  1782. ; THIS ROUTINE GETS THE NEXT AVAILABLE BYTE FROM THE
  1783. ; TAPE.  WHILE WAITING FOR THE BYTE THE KEYBOARD IS TESTED
  1784. ; FOR AN ESC COMMAND.  IF RECEIVED THE TAPE LOAD IS
  1785. ; TERMINATED AND A RETURN TO THE COMMAND MODE IS MADE.
  1786. ;
  1787. STAT:    IN    TAPPT    ;TAPE STATUS PORT
  1788.     ANI    TDR
  1789.     RNZ
  1790.     CALL    SINP    ;CHECK INPUT
  1791.     JZ    STAT    ;NOTHING THERE YET
  1792.     ANI    7FH    ;CLR PARITY FIRST
  1793.     JNZ    STAT    ;NOT A MODE (OR EVEN CTRL-@)
  1794.     STC        ;SET ERROR FLAG
  1795.     RET        ;AND RETURN
  1796. ;
  1797. ;
  1798. ;
  1799. TAPIN:    CALL    STAT    ;WAIT UNTIL A CHARACTER IS AVAILABLE
  1800.     RC
  1801. ;
  1802. TREDY:    IN    TAPPT    ;TAPE STATUS
  1803.     ANI    TFE+TOE    ;DATA ERROR?
  1804.     IN    TDATA    ;GET THE DATA
  1805.     RZ        ;IF NO ERRORS
  1806.     STC        ;SET ERROR FLAG
  1807.     RET
  1808. ;
  1809. ;
  1810. ; THIS ROUTINE GETS THE CORRECT UNIT FOR SYSTEM WRITES
  1811. ;
  1812. WFBLK:    CALL    GTUNT    ;SET UP A WITH UNIT AND SPEED
  1813. ;
  1814. ;
  1815. ;    ***** WRITE TAPE BLOCK ROUTINE *****
  1816. ;
  1817. ; ON ENTRY:     A - HAS UNIT AND SPEED
  1818. ;        HL - HAS POINTER TO HEADER
  1819. ;
  1820. ;
  1821. WTAPE:    EQU    $    ;HERE TO WRITE TAPE
  1822.     PUSH    H    ;SAVE HEADER ADDRESS
  1823.     CALL    WHEAD    ;TURN ON, THEN WRITE HEADER
  1824.     POP    H
  1825.     LXI    D,BLKOF    ;OFFSET TO BLOCK SIZE IN HEADER
  1826.     DAD    D    ;HL POINT TO BLOCK SIZE
  1827.     MOV    E,M
  1828.     INX    H
  1829.     MOV    D,M    ;DE HAS SIZE
  1830.     INX    H
  1831.     MOV    A,M
  1832.     INX    H
  1833.     MOV    H,M
  1834.     MOV    L,A    ;HL HAS STARTING ADDRESS
  1835. ;
  1836. ; THIS ROUTINE WRITES ONE PHYSICAL BLOCK ON THE
  1837. ; TAPE "DE" BYTES LONG FROM ADDRESS "HL".
  1838. ;
  1839. ;
  1840. WRLO1:    EQU    $    ;HERE FOR THE EXTRA PUSH
  1841.     PUSH    H    ;A DUMMY PUSH FOR LATER EXIT
  1842. WTAP2:    EQU    $    ;LOOP HERE UNTIL ENTIRE AMOUNT READ
  1843.     CALL    DCRCT    ;DROP COUNT IN DE AND SET UP B 
  1844.             ;WITH LENGTH THIS BLOCK
  1845.     JZ    TOFF    ;RETURNS ZERO IF ALL DONE
  1846.     CALL    WTBL    ;WRITE BLOCK FOR BYTES IN B (256)
  1847.     JMP    WTAP2    ;LOOP UNTIL ALL DONE
  1848. ;
  1849. ;
  1850. WRTAP:    PUSH    PSW
  1851. WRWAT:    IN    TAPPT    ;TAPE STATUS
  1852.     ANI    TTBE    ;IS TAPE READY FOR A CHAR YET
  1853.     JZ    WRWAT    ;NO...WAIT
  1854.     POP    PSW    ;YES...RESTORE CHAR TO OUTPUT
  1855.     OUT    TDATA    ;SEND CHAR TO TAPE
  1856. ;
  1857. DOCRC:    EQU    $    ;A COMMON CRC COMPUTATION ROUTINE
  1858.     SUB    C
  1859.     MOV    C,A
  1860.     XRA    C
  1861.     CMA
  1862.     SUB    C
  1863.     MOV    C,A
  1864.     RET        ;ONE BYTE NOW WRITTEN
  1865. ;
  1866. ;
  1867. ; THIS ROUTINE WRITES THE HEADER POINTED TO BY
  1868. ; HL TO THE TAPE.
  1869. ;
  1870. WHEAD:    EQU    $    ;HERE TO FIRST TURN ON THE TAPE
  1871.     CALL    WTON    ;TURN IT ON, THEN WRITE HEADER
  1872.     MVI    D,50    ;WRITE 50 ZEROS
  1873. NULOP:    XRA    A
  1874.     CALL    WRTAP
  1875.     DCR    D
  1876.     JNZ    NULOP
  1877. ;
  1878.     MVI    A,1
  1879.     CALL    WRTAP
  1880.     MVI    B,HLEN    ;LENGTH TO WRITE OUT
  1881. ;
  1882. WTBL:    MVI    C,0    ;RESET CRC BYTE
  1883. WLOOP:    MOV    A,M    ;GET CHARACTER
  1884.     CALL    WRTAP    ;WRITE IT TO THE TAPE
  1885.     DCR    B
  1886.     INX    H
  1887.     JNZ    WLOOP
  1888.     MOV    A,C    ;GET CRC
  1889.     JMP    WRTAP    ;PUT IT ON THE TAPE AND RETURN
  1890. ;
  1891. ;
  1892. ; THIS ROUTINE COMPARES THE HEADER IN THEAD TO
  1893. ; THE USER SUPPLIED HEADER IN ADDRESS HL.
  1894. ; ON RETURN IF ZERO IS SET THE TWO NAMES COMPARED
  1895. ;
  1896. DHCMP:    MVI    B,5
  1897. DHLOP:    LDAX    D
  1898.     CMP    M
  1899.     RNZ
  1900.     DCR    B
  1901.     RZ        ;IF ALL FIVE COMPARED
  1902.     INX    H
  1903.     INX    D
  1904.     JMP    DHLOP
  1905. ;
  1906. GTUNT:    EQU    $    ;SET A=SPEED + UNIT
  1907.     LDA    FNUMF    ;GET UNIT
  1908.     ORA    A    ;SEE WHICH UNIT
  1909.     LDA    TSPD    ;BUT FIRST GET SPEED
  1910.     JNZ    GTUN2    ;MAKE IT UNIT TWO
  1911.     ADI    TAPE2    ;THIS ONCE=UNIT 2, TWICE=UNIT 1
  1912. GTUN2:    ADI    TAPE2    ;UNIT AND SPEED NOW SET IN A
  1913.     RET        ;ALL DONE
  1914. ;
  1915. WTON:    MVI    B,4    ;SET LOOP DELAY, (BIT LONGER ON WRITE)
  1916. TON:    EQU    $    ;HERE TO TURN A TAPE ON THEN DELAY
  1917.     OUT    TAPPT    ;GET TAPE MOVING, THEN DELAY
  1918. ;
  1919. DELAY:    LXI    D,0
  1920. DLOP1:    DCX    D
  1921.     MOV    A,D
  1922.     ORA    E
  1923.     JNZ    DLOP1
  1924.     DCR    B
  1925.     JNZ    DELAY
  1926.     RET
  1927. ;
  1928. ;
  1929. ;********* END OF PROGRAM ************
  1930. ;
  1931. ;
  1932. ;
  1933. ;
  1934. ;
  1935. ;        SOL SYSTEM EQUATES
  1936. ;
  1937. ;
  1938. ;    VDM PARAMETERS
  1939. ;
  1940. VDMEM    EQU    0CC00H    ;VDM SCREEN MEMORY
  1941. HIBYTE    EQU    0CCH    ;MEMORY HIGH BYTE
  1942. ;
  1943. ;
  1944. ;    KEYBOARD SPECIAL KEY ASSIGNMENTS
  1945. ;
  1946. DOWN    EQU    9AH
  1947. UP    EQU    97H
  1948. LEFT    EQU    81H
  1949. RIGHT    EQU    93H
  1950. MODE    EQU    80H
  1951. CLEAR    EQU    8BH
  1952. HOME    EQU    08EH
  1953. BACKS    EQU    5FH    ;BACKSPACE
  1954. LF    EQU    10
  1955. CR    EQU    13
  1956. BLANK    EQU    ' '
  1957. SPACE    EQU    BLANK
  1958. CX    EQU    'X'-40H
  1959. ESC    EQU    1BH
  1960. ;
  1961. ;    PORT ASSIGNMENTS
  1962. ;
  1963. STAPT    EQU    0FAH    ;STATUS PORT GENERAL
  1964. SERST    EQU    0F8H    ;SERIAL STATUS PORT
  1965. SDATA    EQU    0F9H    ;SERIAL DATA
  1966. TAPPT    EQU    0FAH    ;TAPE STATUS PORT
  1967. TDATA    EQU    0FBH    ;TAPE DATA
  1968. KDATA    EQU    0FCH    ;KEYBOARD DATA
  1969. PDATA    EQU    0FDH    ;PARALLEL DATA
  1970. DSTAT    EQU    0FEH    ;VDM DISPLAY PARAMETER PORT
  1971. SENSE    EQU    0FFH    ;SENSE SWITCHES
  1972. ;
  1973. ;
  1974. ;    BIT ASSIGNMENT MASKS
  1975. ;
  1976. SCD    EQU    1    ;SERIAL CARRIER DETECT
  1977. SDSR    EQU    2    ;SERIAL DATA SET READY
  1978. SPE    EQU    4    ;SERIAL PARITY ERROR
  1979. SFE    EQU    8    ;SERIAL FRAMING ERROR
  1980. SOE    EQU    16    ;SERIAL OVERRUN ERROR
  1981. SCTS    EQU    32    ;SERIAL CLEAR TO SEND
  1982. SDR    EQU    64    ;SERIAL DATA READY
  1983. STBE    EQU    128    ;SERIAL TRANSMITTER BUFFER EMPTY
  1984. ;
  1985. KDR    EQU    1    ;KEYBOARD DAYA READY
  1986. PDR    EQU    2    ;PARALLEL DATA READY
  1987. PXDR    EQU    4    ;PARALLEL DEVICE READY
  1988. TFE    EQU    8    ;TAPE FRAMING ERROR
  1989. TOE    EQU    16    ;TAPE OVERRUN ERROR
  1990. TDR    EQU    64    ;TAPE DATA READY
  1991. TTBE    EQU    128    ;TAPE TRANSMITTER BUFFER EMPTY
  1992. ;
  1993. SOK    EQU    1    ;SCROLL OK FLAG
  1994. ;
  1995. TAPE1    EQU    80H    ;1=TURN TAPE ONE ON
  1996. TAPE2    EQU    40H    ;1=TURN TAPE TWO ON
  1997. ;
  1998. ;
  1999. ;
  2000. ;        SOL SYSTEM GLOBAL AREA
  2001. ;
  2002.     ORG    0C800H    ;START OF 1K RAM AREA
  2003. ;
  2004. SYSRAM    EQU    $    ;START OF SYSTEM RAM
  2005. SYSTP    EQU    $+1024    ;STACK IS AT THE TOP
  2006. ;
  2007. ;
  2008. ;    ***** PARAMETERS STORED IN RAM *****
  2009. ;
  2010. UIPRT    DS    2    ;USER DEFINED INPUT RTN IF NON-ZERO
  2011. UOPRT    DS    2    ;USER DEFINED OUTPUT RTN IF NON-ZERO
  2012. DFLTS    DS    2    ;DEFAULT PSUEDO I/O PORTS 
  2013.             ;   (ALWAYS ZERO IN SOLOS)
  2014. IPORT    DS    1    ;CRNT INPUT PSEUDO PORT
  2015. OPORT    DS    1    ;CRNT OUTPUT PSEUDO PORT
  2016. NCHAR    DS    1    ;CURRENT CHARACTER POSITION
  2017. LINE    DS    1    ;CURRENT LINE POSITION
  2018. BOT    DS    1    ;BEGINNING OF TEXT DISPLACEMENT
  2019. SPEED    DS    1    ;SPEED CONTROL BYTE
  2020. ESCFL    DS    1    ;ESCAPE FLAG CONTROL BYTE
  2021. TSPD    DS    1    ;CURRENT TAPE SPEED
  2022. INPTR    DS    2    ;FOR COMPATABILITY W/CUTER
  2023. NUCNT    DS    1    ;NUMBER OF NULLS AFTER CRLF
  2024. IGNCR    DS    1    ;FF=IGNORE CRC ERRORE, ELSE NORMAL
  2025. ;
  2026.     DS    10    ;ROOM FOR FUTURE EXPANSION
  2027. ;
  2028. ;
  2029. ; THIS IS THE HEADER LAYOUT
  2030. ;
  2031. THEAD    DS    5    ;NAME
  2032.     DS    1    ;THIS BYTE MUST BE ZERO
  2033. HTYPE    DS    1    ;TYPE
  2034. BLOCK    DS    2    ;BLOCK SIZE
  2035. LOADR    DS    2    ;LOAD ADDRESS
  2036. XEQAD    DS    2    ;AUTO-EXECUTE ADDRESS
  2037. HSPR    DS    3    ;SPARES
  2038. ;
  2039. HLEN    EQU    $-THEAD    ;LENGTH OF HEADER
  2040. BLKOF    EQU    BLOCK-THEAD    ;OFFSET TO BLOCK SIZE
  2041. DHEAD    DS    HLEN    ;A DUMMY HDR FOR COMPARES WHILE RDING
  2042. ;
  2043. ;
  2044. CUTAB    DS    6*4    ;ROOM FOR UP TO 6 CUSTOM USER COMMANDS
  2045. ;
  2046. ;
  2047. FNUMF    DS    1    ;FOR CURRENT FILE OPERATIONS
  2048. FCBAS    DS    7    ;1ST FILE CONTROL BLOCK
  2049. FCBA2    DS    7    ;2ND FILE CONTROL BLOCK
  2050. FBUF1    DS    2*256    ;SYSTEM FILE BUFFER BASE
  2051.     DS    81    ;THIS IS AN AREA USED BY CUTER
  2052. USARE    EQU    $    ;START OF USER AREA *****************
  2053. ; REMEMBER THAT THE STACK WORKS ITS WAY DOWN FROM
  2054. ; THE END OF THIS 1K RAM AREA.
  2055. ;
  2056. ;
  2057. ;
  2058. END
  2059.