;<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
;
; CUTER - MODIFIED TO USE MITS CARDS IN ALTAIR 8800
;
; PSEUDO DEVICE 0, CONSOLE: VDM-1 AT C8/CC00, KBD AT 4/5
; PSEUDO DEVICE 1, SERIAL:  MITS SIO REV. 1 AT 0/1
; PSEUDO DEVICE 2, SERIAL:  MITS 2SIO CHANNEL B AT 18/19
;
; TAPE I/O MODIFIED TO USE MITS ACR SIO AT 6/7
;
; 03/02/2017 UDO MUNK    FIRST VERSION FOR RELEASE
; 03/23/2017 UDO MUNK    USE MITS 2SIO CHANNEL B FOR PSEUDO 2
; 03/27/2017 UDO MUNK    USE MITS ACR SIO FOR TAPE I/O
; 06/27/2017 UDO MUNK    DON'T CLEAR TO EOL FOR CR, JUST ADVANCE LINE
;
;<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
;
;
;
;        CUTER(TM)
;
;                 COPYRIGHT (C) 1977
;                 SOFTWARE TECHNOLOGY CORP.
;                 P.O. BOX 5260
;                 SAN MATEO, CA 94402
;                 (415) 349-8080
;
;    A L L    R I G H T S   R E S E R V E D ! ! !
;
;
;        VERSION  1.3
;                 77-03-27
;
;
;  THIS PROGRAM IS DESIGNED TO BE A STANDALONE CUTS
;  OPERATING SYSTEM. CUTER IS DESIGNED TO BE READ IN FROM
;  CASSETTE TAPE OR TO BE RESIDENT IN READ-ONLY-MEMORY.
;  CUTER SUPPORTS VARIOUS DEVICES INCLUDING SERIAL,
;  PARALLEL, THE PROCESSOR TECHNOLOGY VDM(TM) AND UP TO
;  TWO CUTS TAPE DRIVES.
;
;  CUTER(TM) HAS BEEN WRITTEN SO AS TO BE COMPATIBLE WITH
;  SOLOS(TM).  THE FOLLOWING KEYS ARE USED BY CUTER(TM)
;  IN PLACE OF THE SPECIAL KEYS ON THE SOL KEYBOARD:
;
;     CURSOR UP       CTL-W
;     CURSOR LEFT     CTL-A
;     CURSOR RIGHT    CTL-S
;     CURSOR DOWN     CTL-Z
;     CURSOR HOME     CTL-N
;     CLEAR SCREEN    CTL-K
;     MODE            CTL-@
;
;
;
        ORG     0C000H
;
;
;   AUTO-STARTUP CODE
;
START:  MOV     A,A     ;SHOW THIS IS CUTER (SOLOS=00)
;      THIS BYTE ALLOWS AUTOMATIC POWER ON ENTRY
;      WHEN IN ROM SUPPORTING THIS HARDWARE FEATURE.
INIT:   JMP     STRTA   ;SYSTEM RESTART ENTRY POINT
;
;   THESE JUMP POINTS ARE PROVIDED TO ALLOW COMMON ENTRY
; LOCATIONS FOR ALL VERSIONS OF CUTER.  THEY ARE USED
; EXTENSIVELY BY CUTS SYSTEM PROGRAMS AND IT IS RECOMMENDED
; THAT USER ROUTINES ACCESS CUTER ROUTINES THROUGH THESE
; POINTS ONLY!
;
RETRN:  JMP     COMND   ;RETURN TO CUTER COMMAND PROCESSOR
FOPEN:  JMP     BOPEN   ;CASSETTE OPEN FILE ENTRY
FCLOS:  JMP     PCLOS   ;CASSETTE CLOSE FILE ENTRY
RDBYT:  JMP     RTBYT   ;CASSETTE READ BYTE ENTRY
WRBYT:  JMP     WTBYT   ;CASSETTE WRITE BYTE ENTRY
RDBLK:  JMP     RTAPE   ;CASSETTE READ BLOCK ENTRY
WRBLK:  JMP     WTAPE   ;CASSETTE WRITE BLOCK ENTRY
;
;     SYSTEM I/O ENTRY POINTS
;
;  THESE FOUR ENTRY POINTS ARE USED TO EITHER INPUT
;  OR OUTPUT TO CUTER PSUEDO PORTS.
;  THESE PSUEDO PORTS ARE AS FOLLOWS:
;
;  PORT   INPUT              OUTPUT
;  ----   -----------------  ---------------------
;   0     KEYBOARD INPUT     BUILT-IN VDM DRIVER
;         ACTUAL PORT 3      PORT C8, MEMORY FROM CC00
;   1     SERIAL PORT        SERIAL PORT
;         ACTUAL PORT 1      ACTUAL PORT 1
;   2     PARALLEL PORT      PARALLEL PORT
;         ACTUAL PORT 2      ACTUAL PORT 2
;   3     USER'S INPUT RTN   USER'S OUTPUT ROUTINE
;
;  STATUS FOR ACTUAL PORTS 1, 2 AND 3 IS VIA ACTUAL
;  PORT 0.  THE BITS OF PORT ZERO ARE DEFINED AS FOLLOWS:
;
;   :     :     :     :     :     :---- : --- : --- :
;   : TBE : RDA :     :     :     :PXDR : PDR : KDR :
; BIT  7     6     5     4     3     2     1     0
;
;  WHERE:
;    TBE    1=TRANSMITTER BUFFER EMPTY (SERIAL)
;    RDA    1=READER DATA AVAILABLE (SERIAL)
;    ----
;    PXDR   0=PARALLEL EXTERNAL DEVICE READY
;    ---
;    PDR    0=PARALLEL DATA READY
;    ---
;    KDR    0=KEYBOARD DATA READY
;
;
;
;
;  NOTE: SOUT AND SINP ARE "LDA" INSTRUCTIONS.
;        THIS FACT IS USED TO ALLOW ACCESS TO THE
;        BYTES "OPORT" AND "IPORT" DYNAMICALLY.
;        THESE MUST REMAIN "LDA" INSTRUCTIONS!!!!!
;
SOUT:   LDA     OPORT   ;OUTPUT VIA STANDARD OUTPUT PSUEDO PORT
AOUT:   JMP     OUTPR   ;OUTPUT VIA PSUEDO PORT SPECIFIED IN REG A
SINP:   LDA     IPORT   ;INPUT VIA STANDARD INPUT PSUEDO PORT
AINP    EQU     $       ;INPUT VIA PSUEDO PORT SPECIFIED IN REG A
; -----------END OF SYSTEM ENTRY POINTS----------
;
;
; AINP CONTINUES HERE (IT COULD HAVE BEEN A "JMP" THOUGH)
        PUSH    H       ;SAVE HL FM ENTRY
        LXI     H,ITAB
;
;    THIS ROUTINE PROCESSES THE I/O REQUESTS
;
IOPRC:  ANI     3       ;KEEP REGISTER "A" TO FOUR VALUES
        RLC             ;COMPUTE ENTRY ADDRESS
        ADD     L
        MOV     L,A     ;WE HAVE ADDRESS
        JMP     DISPT   ;DISPATCH TO IT
;
;
OUTPR   EQU     $       ;PROCESS OUTPUT REQUESTS
        PUSH    H       ;SAVE REGS
        LXI     H,OTAB  ;POINT TO OUTPUT DISPATCH TABLE
        JMP     IOPRC   ;DISPATCH FOR PROPER PSUEDO PORT
;
;
;
; CUTER SYSTEM I/O ROUTINES
;
;
;    THIS ROUTINE IS A MODEL OF ALL INPUT ROUTINES WITHIN
;  CUTER.  THE FIRST ROUTINE "KREA1" PERFORMS THE INPUT
;  FROM THE STANDARD KEYBOARD ON PARALLEL PORT 3.
;  ALL STANDARD INPUT DRIVERS RETURN EITHER THE CHARACTER
;  WITH A NON-ZERO FLAG, OR JUST A ZERO FLAG INDICATING
;  THAT NO CHARACTER IS AVAILABLE YET.  IT WILL BE THE
;  RESPONSIBILITY OF THE USER TO LOOP WAITING FOR A
;  CHARACTER, OR TO USE THE INPUT AS A STATUS REQUEST.
;  WHEN A CHARACTER IS AVAILABLE, IT IS RETURNED IN REG A.
;
;  THE FOLLOWING KEYBOARD ROUTINE MAY BE USED AS A SAMPLE
;  OF HOW TO WRITE A USER INPUT ROUTINE.
;
;         KEYBOARD INPUT ROUTINE
;
; MODIFIED SO THAT KBD STATUS PORT CAN BE DIFFERENT FROM SIO STATUS PORT
; UDO MUNK
;
KREA1   EQU     $       ;KEYBOARD READ ROUTINE
;       IN      STAPT   ;GET STATUS WORD
        IN      STKBD   ;*UM*
        CMA             ;INVERT IT FOR PROPER RETURN
        ANI     KDR     ;TEST NOT KEYBOARD DATA READY
        RZ              ;ZERO IF NO CHARACTER RECEIVED
;
        IN      KDATA   ;GET CHARACTER
        RET             ;GO BACK WITH IT
;
;
;
;   SERIAL INPUT ROUTINE
;
SREA1   EQU     $       ;SERIAL INPUT ROUTINE
        IN      STAPT   ;GET STATUS
        CMA             ;*UM* MITS SIO FLAGS ARE ACTIVE LOW
        ANI     SDR     ;TEST FOR SERIAL DATA READY
        RZ              ;FLAGS ARE SET
;
        IN      SDATA   ;GET DATA BYTE
;  IT IS UP TO THE CALLER TO STRIP PARITY IF DESIRED
        RET             ;WE HAVE IT
;
;
;   SERIAL DATA OUTPUT
;
; MODIFIED SO THAT STATUS BIT CAN BE DEFINED AS ANY BIT
; UDO MUNK
;
SEROT   EQU     $       ;SERIAL OUTPUT ROUTINE
        IN      STAPT   ;GET STATUS
;        RAL             ;PUT HIGH BIT IN CARRY
;        JNC     SEROT   ;LOOP UNTIL TRANSMITTER BUFFER IS EMPTY
        ANI     STBE    ;*UM*
        JNZ     SEROT   ;*UM*
        MOV     A,B     ;GET THE CHARACTER BACK
        OUT     SDATA   ;SEND IT OUT
        RET             ;AND WE'RE DONE
;
;
; PARALLEL DATA INPUT
;
; MODIFIED TO USE 2SIO CHANNEL B
; UDO MUNK
;
PARIT   EQU     $       ;GET CHAR FM PARALLEL PORT
;        IN      STAPT   ;STATUS
;        CMA             ;INVERT FOR PROPER RETURN
;        ANI     PDR     ;IS DATA READY?
;        RZ              ;NO--JUST EXIT
;        IN      PDATA   ;YES--GET CHAR THEN
;        RET             ;THEN EXIT
        IN      SIO2S   ;GET STATUS
        ANI     SDR2    ;TEST FOR SERIAL DATA READY
        RZ              ;FLAGS ARE SET
        IN      SIO2D   ;GET DATA BYTE
        RET             ;WE HAVE IT
;
;
;  PARALLEL DATA OUTPUT ROUTINE
;
; MODIFIED TO USE 2SIO CHANNEL B
; UDO MUNK
;
PAROT   EQU     $       ;OUTPUT CHAR TO PARALLEL PORT
;        IN      STAPT   ;STATUS
;        ANI     PXDR    ;IS EXTERNAL DEVICE READY?
;        JNZ     PAROT   ;NO--WAIT TIL IT IS
;        MOV     A,B     ;GET CHAR
;        OUT     PDATA   ;SEND DATA NOW
;        RET             ;DONE
        IN      SIO2S   ;GET STATUS
        ANI     STBE2   ;DEVICE READY ?
        JZ      PAROT   ;NO, WAIT
        MOV     A,B     ;GET THE CHARACTER BACK
        OUT     SIO2D   ;SEND IT OUT
        RET             ;AND WE'RE DONE
;
;
; USER DEFINED INPUT/OUTPUT ROUTINES
ERRIT   EQU     $       ;USER INPUT ROUTINE
        PUSH    H       ;SAVE ORIG HL
        LHLD    UIPRT   ;GET USER'S RTN ADDR
        JMP     ERRO1   ;MERGE TO VERIFY THE ADDR
;
ERROT   EQU     $       ;USER OUTPUT ROUTINE
        PUSH    H       ;SAVE ORIG HL
        LHLD    UOPRT   ;GET USER'S RTN ADDR
ERRO1   EQU     $       ;WE MERGE HERE TO VFY ADDR
        MOV     A,L     ;ZERO=UNDEFINED
        ORA     H       ;IS IT?
        JNZ     DISP1   ;NO--VALID--OFF TO IT
        JMP     STRTD   ;RESET I/O PORTS AND BACK TO COMMAND MODE
;
;
;
;                  VIDEO DISPLAY ROUTINES
;
;
;  THESE ROUTINES ALLOW FOR STANDARD VIDEO TERMINAL
;  OPERATIONS.  ON ENTRY, THE CHARACTER FOR OUTPUT IS IN
;  REGISTER B AND ALL REGISTERS ARE UNALTERED ON RETURN.
;
;
;
VDM01   EQU     $       ;VDM OUTPUT DRIVER
        PUSH    H       ;SAVE HL
        PUSH    D       ;SAVE DE
        PUSH    B
;
;  PROCESS ESC SEQUENCE IF ANY
;
        LDA     ESCFL   ;GET ESCAPE FLAG
        ORA     A
        JNZ     ESCS    ;IF NON ZERO GO PROCESS THE REST OF THE SEQUENCE
;
        MOV     A,B     ;GET CHAR
        ANI     7FH     ;CLR HI BIT IN CASE
        MOV     B,A     ;USE CHAR STRIPPED OF HI BIT FOR COMPATABILITY
        JZ      GOBK    ;MAKE A QUICK EXIT FOR A NULL
;
        LXI     H,TBL
        CALL    TSRCH   ;GO PROCESS
;
GOBACK  EQU     $       ;RESET CURSOR AND DELAY
        CALL    VDADD   ;GET SCRN ADDR
        MOV     A,M     ;GET CHAR
        ORI     80H     ;INVERSE VIDEO
        MOV     M,A     ;CURSOR IS NOW THERE
        LHLD    SPEED-1 ;GET DELAY SPEED
        INR     L       ;MAKE IT DEFINITELY NON-ZERO
        XRA     A       ;DELAY ENDS WHEN H=ZERO
TIMER:  DCX     H       ;LOOP FOR DELAY AMNT
        CMP     H       ;IS IT DONE YET
        JNZ     TIMER   ;NO--KEEP DELAYING
GOBK:   POP     B
        POP     D       ;RESTORE ALL REGISTERS
        POP     H
        RET             ;EXIT FROM VDMOT
;
;
NEXT    EQU     $       ;GO TO NEXT CHR
        INX     H
        INX     H
;
;  THIS ROUTINE SEARCHES FOR A MATCH OF THE CHAR IN "B"
;  TO THE CHAR IN THE TBL POINTED TO BY HL.
;
TSRCH:  MOV     A,M     ;GET CHR FROM TABLE
        ORA     A       ;SEE IF END OF TBL
        JZ      CHAR    ;ZERO IS THE LAST
        CMP     B       ;TEST THE CHR
        INX     H       ;POINT FORWARD
        JNZ     NEXT
        PUSH    H       ;FOUND ONE...SAVE ADDRESS
        CALL    CREM    ;REMOVE CURSOR
        XTHL            ;RESTORE ADDR OF CHAR ENTRY IN TBL
        JMP     DISPT   ;DISPATCH FOR CURSOR CONTROL
;
;
CHAR    EQU     $       ;WE HAVE A CHAR
        MOV     A,B     ;GET CHARACTER
        CPI     7FH     ;IS IT A DEL?
        RZ              ;GO BACK IF SO
;
;
;
OCHAR:  CALL    VDADD   ;GET SCREEN ADDRESS
        MOV     M,B     ;PUT CHR ON SCREEN
        LDA     NCHAR   ;GET CHARACTER POSITION
        CPI     63      ;END OF LINE?
        JC      OK
        LDA     LINE
        CPI     15      ;END OF SCREEN?
        JNZ     OK
;
;   END OF SCREEN...ROLL UP ONE LINE
;
SCROLL: XRA     A
        STA     NCHAR   ;BACK TO FIRST CHAR POSITION
SROL:   MOV     C,A
        CALL    VDAD    ;CALCULATE LINE TO BE BLANKED
        XRA     A
        CALL    CLIN1   ;CLEAR IT
        LDA     BOT
        INR     A
        ANI     0FH
        JMP     ERAS3
;
;   INCREMENT LINE COUNTER IF NECESSARY
;
OK:     LDA     NCHAR   ;GET CHR POSITION
        INR     A
        ANI     3FH     ;MOD 64
        STA     NCHAR   ;STORE THE NEW
        RNZ             ;MORE CHARS THIS LINE
PDOWN   EQU     $       ;MOVE CURSOR DOWN ONE LINE
        LDA     LINE    ;GET THE LINE COUNT
        INR     A
CURSC:  ANI     0FH     ;MOD 15 INCREMENT
CUR:    STA     LINE    ;STORE THE NEW
        RET
;
;    ERASE SCREEN
;
PERSE:  LXI     H,VDMEM ;POINT TO SCREEN
        MVI     M,80H+' ' ;THIS IS THE CURSOR
;
        INX     H       ;NEXT CHAR
ERAS1   EQU     $       ;LOOP TO CLR SCRN
        MVI     M,' '   ;BLANK IT OUT
        INX     H       ;NEXT SCRN LOC
        MOV     A,H     ;SEE IF DONE
        CPI     0D0H    ;DID IT GO ABOVE VDM
        JC      ERAS1   ;NO--MORE
        STC             ;SAY WE WANT TO DROP THRU TO ERAS3
;
PHOME   EQU     $       ;RESET CURSOR TO HOME
        MVI     A,0     ;CLEAR, LEAVE CARRY AS IS
        STA     LINE    ;ZERO LINE
        STA     NCHAR   ;LEFT SIDE OF SCREEN
        RNC             ;THIS IS JUST A HOME OPERATION
;
ERAS3:  OUT     DSTAT   ;RESET SCROLL PARAMETERS
        STA     BOT     ;BEGINNING OF TEXT OFFSET
        RET
;
;
CLIN2   EQU     $       ;HERE TO SEE IF VDM OUTPUT
        LDA     OPORT   ;GET CRNT OUTPUT PORT
        ORA     A
        RNZ             ;NOT VDM--DONE THEN
CLINE:  CALL    VDADD   ;GET CURRENT SCREEN ADDRESS
        LDA     NCHAR   ;CURRENT CURSOR POSITION
CLIN1:  CPI     64      ;NO MORE THAN 63
        RNC             ;ALL DONE
        MVI     M,' '   ;ALL SPACED OUT
        INX     H
        INR     A
        JMP     CLIN1   ;LOOP TO END OF LINE
;
;
;  ROUTINE TO MOVE THE CURSOR UP ONE LINE
;
PUP:    LDA     LINE    ;GET LINE COUNT
        DCR     A
        JMP     CURSC   ;MERGE
;
;  MOVE CURSOR LEFT ONE POSITION
;
PLEFT:  LDA     NCHAR
        DCR     A
PCUR    EQU     $       ;TAKE CARE OF CURSOR SAME LINE
        ANI     03FH    ;LET CURSOR WRAP AROUND
        STA     NCHAR   ;UPDATED CURSOR
        RET
;
;     CURSOR RIGHT ONE POSITION
;
PRIT:   LDA     NCHAR
        INR     A
        JMP     PCUR
;
;   ROUTINE TO CALCULATE SCREEN ADDRESS
;
;   ENTRY AT:    RETURNS:
;
;         VDADD  CURRENT SCREEN ADDRESS
;         VDAD2  ADDRESS OF CURRENT LINE, CHAR 'C'
;         VDAD   LINE 'A', CHARACTER POSITION 'C'

VDADD:  LDA     NCHAR   ;GET CHARACTER POSITION
        MOV     C,A     ;'C' KEEPS IT
VDAD2:  LDA     LINE    ;LINE POSITION
VDAD:   MOV     L,A     ;INTO 'L'
        LDA     BOT     ;GET TEXT OFFSET
        ADD     L       ;ADD IT TO THE LINE POSITION
        RRC             ;TIMES TWO
        RRC             ;MAKES FOUR
        MOV     L,A     ;L HAS IT
        ANI     3       ;MOD THREE FOR LATER
        ADI     VDMEM SHR 8 ;LOW SCREEN OFFSET
        MOV     H,A     ;NOW H IS DONE
        MOV     A,L     ;TWIST L'S ARM
        ANI     0C0H
        ADD     C
        MOV     L,A
        RET             ;H & L ARE NOW PERVERTED
;
;    ROUTINE TO REMOVE CURSOR
;
CREM:   CALL    VDADD   ;GET CURRENT SCREEN ADDRESS
        MOV     A,M
        ANI     7FH     ;STRIP OFF THE CURSOR
        MOV     M,A
        RET
;
;     ROUTINE TO BACKSPACE
;
PBACK:  CALL    PLEFT
        CALL    VDADD   ;GET SCREEN ADDRESS
        MVI     M,' '   ;PUT A BLANK THERE
        RET
;
;     ROUTINE TO PROCESS A CARRIAGE RETURN
;
PCR:    ;CALL    CLINE   ;CLEAR FROM CURRENT CURSOR TO END OF LINE
;  NOTE THAT A COMES BACK=64 WHICH WILL BE CLEARED AT PCUR
        MVI     A,64    ;*UM* JUST ADVANCE LINE
        JMP     PCUR    ;AND STORE THE NEW VALUE
;
;   ROUTINE TO PROCESS LINEFEED
;
PLF:    LDA     LINE    ;GET LINE COUNT
        INR     A       ;NEXT LINE
        ANI     15      ;SEE IF IT WRAPPED AROUND
        JNZ     CUR     ;IT DID NOT--NO SCROLL
;
        JMP     SROL    ;SCROLL ONE LINE--CURSOR SOME POSITION
;
;     SET ESCAPE PROCESS FLAG
;
PESC:   MVI     A,(-1) AND 0FFH
        STA     ESCFL   ;SET FLAG
        RET
;
;       PROCESS ESCAPE SEQUENCE
;
ESCS:   CALL    CREM    ;REMOVE CURSOR
        CALL    ESCSP   ;PROCESS THE CHARACTER
        JMP     GOBACK
;
ESCSP:  LDA     ESCFL   ;GET ESCAPE FLAG
        CPI     (-1) AND 0FFH ;TEST FLAG
        JZ      SECOND
;
;  PROCESS THIRD CHR OF ESC SEQUENCE
;
        LXI     H,ESCFL
        MVI     M,0
        CPI     2
        JC      SETX    ;SET X
        JZ      SETY    ;SET Y
        CPI     8       ;SPECIAL SET SPEED
        JZ      STSPD   ;YES--SET THE SPEED WITH IT THEN
        CPI     9
        JC      OCHAR   ;PUT IT ON THE SCREEN
        RNZ
;
;  TAB ABSOLUTE TO VALUE IN REG B
;
SETX:   MOV     A,B
        JMP     PCUR
;
;  SET CURSOR TO LINE "B"
;
SETY:   MOV     A,B
        JMP     CURSC
;
;
;   PROCESS SECOND CHR OF ESC SEQUENCE
;
SECOND: MOV     A,B
        CPI     3
        JZ      CURET
        CPI     4
        JNZ     ARET2
;
ARET:   MOV     B,H
        MOV     C,L     ;PRESENT SCREEN ADDRESS TO BC FOR RETURN
ARET1:  POP     H       ;RETURN ADDRESS
        POP     D       ;OLD B
        PUSH    B
        PUSH    H
        XRA     A
ARET2:  STA     ESCFL
        RET
;
;
;     RETURN PRESENT SCREEN PARAMETERS IN BC
;
CURET:  LXI     H,NCHAR
        MOV     B,M     ;CHARACTER POSITION
        INX     H
        MOV     C,M     ;LINE POSITION
        JMP     ARET1
;
;
;
;                START UP SYSTEM
;
;   CLEAR SCREEN AND THE FIRST 256 BYTES OF GLOBAL RAM
;  THEN ENTER THE COMMAND MODE.
;
STRTA:  XRA     A
        MOV     C,A
        LXI     H,DFLTS ;CLEAR AFTER USER PORT ADDRESSES
;
CLERA:  MOV     M,A
        INX     H
        INR     C
        JNZ     CLERA
;
; DETERMINE THE DEFAULT PORTS
;     THIS COULD BECOME "MVI A,XX" FOR YOUR SPECIFIC PORTS
        IN      SENSE   ;GET SWITCHES
;
        MOV     B,A     ;SAVE IT
        ANI     3       ;MAKE IT A VALID PORT
        STA     DFLTS+1 ;SET DEFAULT OUTPUT PORT
        ORA     A       ;SEE IF THIS THE VDM
        JNZ     STRTB   ;NO--DO NOT RESET VDM
        LXI     SP,SYSTP ;SET UP THE STACK FOR CALL
        CALL    PERSE   ;(REG A ASSUMED TO COME BACK ZERO)
STRTB   EQU     $       ;FINISH OFF THIS PORT THEN DO NEXT
        LXI     H,0     ;USE FOR CLEARING USER ADDRESSES
        CPI     3       ;IS IT A USER PORT
        JZ      STRTC   ;YES-- DO NOT CLEAR IT
        SHLD    UOPRT   ;NO--CLEAR ADDR
STRTC   EQU     $       ;OUTPUT PORT ALL SET
        MOV     A,B     ;FM SENSE SWITCHES
        RAR
        RAR             ;NEXT 2 BITS ARE INPUT PORT
        ANI     3       ;VALID PORT
        STA     DFLTS   ;THIS IS DEFAULT INPUT PORT
        CPI     3       ;IS THIS ONE A USER PORT
        JZ      STRTD   ;YES--DO NOT CLEAR IT THEN
        SHLD    UIPRT   ;NO--FORCE USER ADDRESS ZERO
STRTD   EQU     $       ;1ST TIME INITIALIZATION ALL DONE NOW
        LHLD    DFLTS   ;PICK UP DEFAULT PORTS
        SHLD    IPORT   ;FORCE PORTS TO DEFAULT
COMN1   EQU     $       ;HERE TO TURN OFF TAPES, THEN COMMAND MODE
        XRA     A
        OUT     TAPPT   ;BE SURE TAPES ARE OFF
;
;
;
;            =--  COMMAND MODE  --=
;
;
;   THIS ROUTINE GETS AND PROCESSES COMMANDS
;
COMND:  LXI     SP,SYSTP ;SET STACK POINTER
        CALL    PROMPT  ;PUT PROMPT ON SCREEN
        CALL    GCLI0   ;INIT TO GET COMMAND LINE
        CALL    COPRC   ;PROCESS THE LINE
        JMP     COMND   ;OVER AND OVER
;
;
;
;   THIS ROUTINE READS A COMMAND LINE FROM THE SYSTEM
;  KEYBOARD
;
;  C/R   TERMINATES THE SEQUENCE ERASING ALL CHARS TO THE
;        RIGHT OF THE CURSOR
;  L/F   TERMINATES THE SEQUENCE
;  ESC   RESETS TO COMMAND MODE.
;
GCLI0   EQU     $       ;HERE TO INIT FOR GCLIN
        LXI     H,INLIN-1 ;PT TO CHAR IN FRONT OF INPUT BFR
        MVI     M,7     ;MAKE SURE IT IS "BELL" TO KEEP FM DEL'ING TOO FAR
        INX     H       ;NOW PT TO INPUT BFR
        SHLD    INPTR   ;SAVE AS STARTING PTR
        MVI     A,80    ;NUMBER OF CHARS IN LINE (MAX)
GCLI1   EQU     $       ;LOOP TO BLANK OUT LINE BFR
        MVI     M,' '   ;BLANKS
        INX     H       ;NEXT CHAR
        DCR     A       ;FOR THIS COUNT
        JNZ     GCLI1   ;ENTIRE LINE
GCLIN:  CALL    SINP    ;READ INPUT DEVICE
        JZ      GCLIN
        ANI     7FH     ;MAKE SURE NO X'80' BIT DURING CMND MODE
        JZ      STRTD   ;IF EITHER MODE (OR CTL-@)
        MOV     B,A
        CPI     CR      ;IS IT CR?
        JZ      CLIN2   ;YES--TERMINATE LINE HERE (CLR IF VDM)
        CPI     LF      ;IS IT A LINEFEED
        RZ              ;YES--TERMINATE LINE AS IS
        LHLD    INPTR   ;CRNT LINE PTR
        CPI     7FH     ;DELETE CHR?
        JNZ     GCLI2   ;NO--OK
        MVI     B,BACKS ;REPLACE IT
        DCX     H       ;BACK LINE PTR UP TOO
        MVI     A,'G'-40H ;SEE IF A BELL
        CMP     M       ;IS IT?
        JNZ     GCLI3   ;NO--OK
        MOV     B,A     ;YES--RING THE BELL THEN
GCLI2   EQU     $       ;STORE CHAR IN INPUT AREA
        MOV     M,B     ;PLACE CHAR INTO LINE
        INX     H       ;NEXT CHAR
GCLI3   EQU     $       ;SAVE NEW LINE PTR
        SHLD    INPTR   ;SAVE PTR
;
CONT:   CALL    SOUT
        JMP     GCLIN
;
;
;
;
;      FIND AND PROCESS COMMAND
;
COPRC   EQU     $       ;PROCESS THIS COMMAND LINE
        CALL    STUP    ;SETUP TO PROCESS INPUT LINE
        XCHG            ;DE=ADDR
        LXI     H,START ;PREP SO THAT HL WILL PT TO CUTER LATER
        PUSH    H       ;PLACE PTR TO CUTER ON STACK FOR LATER DISPT
        CALL    SCHR    ;SCAN PAST BLANKS
        JZ      ERR1    ;NO COMMAND?
        XCHG            ;HL HAS FIRST CHR
        LXI     D,COMTAB ;POINT TO COMMAND TABLE
        CALL    FDCOM   ;SEE IF IN PRIMARY TABLE
        CZ      FDCOU   ;TRY CUSTOM ONLY IF NOT PRIMARY COMMAND
DISP0   EQU     $       ;HERE TO EITHER DISPATCH OR DO ERROR
        JZ      ERR2    ;NOT IN EITHER TABLE
        INX     D       ;PT DE TO ADDR OF RTN
        XCHG            ;HL=ADDR OF ADDR OF RTN
; **** DROP THRU TO DISPT ***
;
; THIS ROUTINE DISPTACHES TO THE ADDR AT CONTENTS OF HL.
; HL ARE RESTORED PRIOR TO GOING TO ROUTINE.
;
DISPT   EQU     $       ;DISPATCH
        MOV     A,M     ;LOW BYTE
        INX     H
        MOV     H,M     ;HI BYTE
        MOV     L,A     ;AND LO, HL NOW COMPLETE
DISP1   EQU     $       ;HERE TO GO OFF TO HL DIRECTLY
        XTHL            ;HL RESTORED AND ADDR ON STACK
        MOV     A,L     ;ALWAYS PASS L IN "A" (PRIMARILY FOR SET'S)
        RET             ;OFF TO ROUTINE
;
;
;
;   THIS ROUTINE SEARCHES THROUGH A TABLE, POINTED TO
;  BY 'DE', FOR A DOUBLE CHARACTER MATCH OF THE 'HL'
;  MEMORY CONTENT.  IF NO MATCH IS FOUND THE SCAN ENDS
;  WITH THE ZERO FLAG SET, ELSE NON-ZERO SET.
;
FDCOU   EQU     $       ;HERE TO SCAN CUSTOM TABLE
        LXI     D,CUTAB ;PT TO CUSTOM RTN TBL
FDCOM:  LDAX    D
        ORA     A       ;TEST FOR TABLE END
        RZ              ;NOT FOUND POST THAT AND RETURN
        PUSH    H       ;SAVE START OF SCAN ADDRESS
        CMP     M       ;TEST FIRST CHR
        INX     D
        JNZ     NCOM
;
        INX     H
        LDAX    D
        CMP     M       ;NOW SECOND CHARACTER
        JNZ     NCOM    ;GOODNESS
;
        POP     H       ;RETURN HL TO PT TO CHAR START
        ORA     A       ;FORCE TO NON-ZERO FLAG
        RET             ;LET CALLER KNOW
;
;
NCOM:   INX     D       ;GO TO NEXT ENTRY
        INX     D
        INX     D
        POP     H       ;GET BACK ORIGINAL ADDRESS
        JMP     FDCOM   ;CONTINUE SEARCH
;
;
; SET UP TO PROCESS AN INPUT LINE
STUP    EQU     $       ;PREPARE WHETHER VDM OR NOT
        LXI     H,INLIN ;ASSUME NON-VDM INPUT
        SHLD    INPTR   ;ALSO RESET PTR FOR NOW
        LDA     OPORT   ;SEE IF IT IS VDM
        ORA     A       ;IS IT THE VDM PORT
        RNZ             ;NO--HL ARE SET PROPERLY
        CALL    CREM    ;REMOVE CURSOR
        MVI     C,1     ;GET VDM ADDR FM POSITION ONE
        JMP     VDAD2   ;GET SCRN ADDR
;
;           COMMAND TABLE
;
;  THIS TABLE DESCRIBES THE VALID COMMANDS FOR CUTER
;
COMTAB  EQU     $       ;START OF KNOWN COMMANDS
        DB      'DU'    ;DUMP
        DW      DUMP
        DB      'EN'    ;ENTR
        DW      ENTER
        DB      'EX'    ;EXEC
        DW      EXEC
        DB      'GE'    ;GET
        DW      TLOAD
        DB      'SA'    ;SAVE
        DW      TSAVE
        DB      'XE'    ;XEQ
        DW      TXEQ
        DB      'CA'    ;CAT
        DW      TLIST
        DB      'SE'    ;SET COMMAND
        DW      CSET
        DB      'CU'    ;CUSTOM COMMAND ENTER/CLEAR
        DW      CUSET
        DB      0       ;END OF TABLE MARK
;
;
;               DISPLAY DRIVER COMMAND TABLE
;
;     THIS TABLE DEFINES THE CHARACTERS FOR SPECIAL
;  PROCESSING. IF THE CHARACTER IS NOT IN THE TABLE IT
;  GOES TO THE SCREEN.
;
TBL:    DB      CLEAR   ;SCREEN
        DW      PERSE
        DB      UP      ;CURSOR
        DW      PUP
        DB      DOWN    ;"
        DW      PDOWN
        DB      LEFT    ;"
        DW      PLEFT
        DB      RIGHT   ;"
        DW      PRIT
        DB      HOME    ;"
        DW      PHOME
        DB      CR      ;CARRIAGE RETURN
        DW      PCR
        DB      LF      ;LINE FEED
        DW      PLF
        DB      BACKS   ;BACK SPACE
        DW      PBACK
        DB      ESC     ;ESCAPE KEY
        DW      PESC
        DB      0       ;END OF TABLE
;
;   OUTPUT DEVICE TABLE
;
OTAB:   DW      VDM01   ;VDM DRIVER
        DW      SEROT   ;SERIAL OUTPUT
        DW      PAROT   ;PARALLEL OUTPUT
        DW      ERROT   ;ERROR OR USER DRIVER HANDLER
;
;    INPUT DEVICE TABLE
;
ITAB:   DW      KREA1   ;KEYBOARD INPUT
        DW      SREA1   ;SERIAL INPUT
        DW      PARIT   ;PARALLEL INPUT
        DW      ERRIT   ;ERROR OR USER DRIVER HANDLER
;
;
;       SECONDARY COMMAND TABLE FOR SET COMMAND
;
SETAB:  DB      'TA'    ;SET TAPE SPEED
        DW      TASPD
        DB      'S='    ;SET DISPLAY SPEED
        DW      DISPD
        DB      'I='    ;SET INPUT PORT
        DW      SETIN
        DB      'O='    ;SET OUTPUT PORT
        DW      SETOT
        DB      'CI'    ;SET CUSTOM DRIVER ADDRESS
        DW      SETCI
        DB      'CO'    ;SET CUSTOM OUTPUT DRIVER ADDRESS
        DW      SETCO
        DB      'XE'    ;SET HEADER XEQ ADDRESS
        DW      SETXQ
        DB      'TY'    ;SET HEADER TYPE
        DW      SETTY
        DB      'N='    ;SET NUMBER OF NULLS
        DW      SETNU
        DB      'CR'    ;SET CRC (NORMAL OR IGNORE CRC ERRORS)
        DW      SETCR
        DB      0       ;END OF TABLE MARK
; -*-
;
;
;      OUTPUT A CRLF FOLLOWED BY A PROMPT
;
PROMPT: CALL    CRLF
        MVI     B,'>'   ;THE PROMPT
        JMP     SOUT    ;PUT IT ON THE SCREEN
;
CRLF:   MVI     B,LF    ;LINE FEED
        CALL    SOUT
        MVI     B,CR    ;CARRIAGE RETURN
        CALL    SOUT
        LDA     NUCNT   ;GET COUNT OF NULLS TO OUTPUT
        MOV     C,A     ;SAVE COUNT IN C
NULOT:  DCR     C
        RM              ;COUNTED DOWN PAST ZERO (MAX COUNT IS X'7F')
        XRA     A       ;HERE IS THE NULL
        CALL    OUTH    ;OUTPUT IT
        JMP     NULOT   ;LOOP FOR NUMBER OF NULLS
;
;
;  SCAN OVER UP TO 12 CHARACTERS LOOKING FOR A BLANK
;
SBLK:   MVI     C,12    ;MAXIMUM COMMAND STRING
SBLK1:  LDAX    D
        CPI     BLANK
        JZ      SCHR    ;GOT A BLANK NOW SCAN PAST IT
        INX     D
        CPI     '='     ;A EQUAL WILL ALSO STOP US (AT NEXT CHAR)
        JZ      SCHR    ;FOUND, DE PT TO NEXT CHAR
        DCR     C       ;NO MORE THAN TWELVE
        JNZ     SBLK1
        RET             ;GO BACK WITH ZERO FLAG SET
;
;
;  SCAN PAST UP TO 10 BLANK POSITIONS LOOKING FOR
; A NON BLANK CHARACTER.
;
SCHR:   MVI     C,10    ;SCAN TO FIRST NON BLANK CHR WITHIN 10
SCHR1:  LDAX    D       ;GET NEXT CHARACTER
        CPI     SPACE
        RNZ             ;WE'RE PAST THEM
        INX     D       ;NEXT SCAN ADDRESS
        DCR     C
        RZ              ;COMMAND ERROR
        JMP     SCHR1   ;KEEP LOOPING
;
;  THIS ROUTINE SCANS OVER CHARACTERS, PAST BLANKS AND
; CONVERTS THE FOLLOWING ADDRESS TO HEX.  ERRORS RETURN TO
; THE ERROR HANDLER.
;
SCONV:  CALL    SBLK
        JZ      ERR1
;
;  THIS ROUTINE CONVERTS ASCII DIGITS INTO BINARY FOLLOWING
; A STANDARD HEX CONVERSION.  THE SCAN STOPS WHEN AN ASCII
; SPACE IS ENCOUNTERED.  PARAMETER ERRORS REPLACE THE ERROR
; CHARACTER ON THE SCREEN WITH A QUESTION MARK.
;
SHEX:   LXI     H,0     ;CLEAR H & L
SHE1:   LDAX    D       ;GET CHARACTER
        CPI     20H     ;IS IT A SPACE?
        RZ              ;IF SO
        CPI     '/'
        RZ
        CPI     ':'
        RZ
;
HCONV:  DAD     H       ;MAKE ROOM FOR THE NEW ONE
        DAD     H
        DAD     H
        DAD     H
        CALL    HCOV1   ;DO THE CONVERSION
        JNC     ERR1    ;NOT VALID HEXIDECIMAL VALUE
        ADD     L
        MOV     L,A     ;MOVE IT IN
        INX     D       ;BUMP THE POINTER
        JMP     SHE1
;
HCOV1:  SUI     48      ;REMOVE ASCII BIAS
        CPI     10
        RC              ;IF LESS THAN 9
        SUI     7       ;IT'S A LETTER??
        CPI     10H
        RET             ;WITH TEST IN HAND
;
;
;  THIS ROUTINE WILL SEE IF A FIELD (OPERAND) IS PRESENT.
;  IF NOT, THEN HL WILL REMAIN AS THEY WERE ON ENTRY.
;  IF IT WAS PRESENT, THEN HL=THAT VALUE IN HEX.
;
PSCAN   EQU     $       ;OPTIONAL FIELD SCANNER
        CALL    SBLK    ;SEE IF FIELD IS PRESENT
        RZ              ;RETURN LEAVING HL AS THEY WERE ON ENTRY
        CALL    SHEX    ;FIELD IS THERE, GO GET IT
        RET             ;HL= EITHER OPTIONAL FIELD (HEX), OR AS IT WAS
;
;
;
;
;           DUMP COMMAND
;
;     THIS ROUTINE DUMPS CHARACTERS FROM MEMORY TO THE
;  CURRENT OUTPUT DEVICE.
;  ALL VALUES ARE DESPLAYED AS ASCII HEX.
;
;  THE COMMAND FORM IS AS FOLLOWS:
;
;        DUMP  ADDR1  ADDR2
;
;    THE VALUES FROM ADDR1 TO ADDR2 ARE THEN OUTPUT TO THE
;  OUTPUT DEVICE.  IF ONLY ADDR1 IS SPECIFIED THEN THE
;  VALUE AT THAT ADDRESS IS OUTPUT.
;
;  IF WHILE DUMPING, THE MODE KEY IS PRESSED, THE DUMP WILL
;  BE TERMINATED.  IF THE SPACE BAR IS PRESSED, THE DUMP
;  WILL BE TEMPORARILY SUSPENDED UNTIL ANY KEY IS PRESSED.
;
DUMP    EQU     $       ;SET UP REGS TO DUMP SPECIFIED AREA
        CALL    SCONV   ;GET START ADDR (REQUIRED)
        PUSH    H       ;SAVE THE START ADDR
        CALL    PSCAN   ;GET OPTIONAL END ADDR, HL=THIS OR START ADDR
        POP     D       ;DE=START ADDR
        XCHG            ;DE=END ADDR, HL=START ADDR NOW
;
DLOOP:  CALL    CRLF
        CALL    ADOUT   ;OUTPUT ADDRESS
        CALL    BOUT    ;ANOTHER SPACE TO KEEP IT PRETTY
        MVI     C,16    ;VALUES PER LINE
;
DLP1:   MOV     A,M     ;GET THE CHR
        PUSH    B       ;SAVE VALUE COUNT
        CALL    HBOUT   ;SEND IT OUT WITH A BLANK
        MOV     A,H     ;CRNT ADDR
        CMP     D       ;VERSUS ENDING ADDR
        JC      DLP1A   ;NOT DONE YET
        MOV     A,L     ;TRY LOW ORDER BYTE
        CMP     E
        JNC     COMND   ;ALL DONE WHEN CRNT REACHES ENDING
DLP1A   EQU     $       ;HERE TO KEEP DUMPING
        POP     B       ;VALUES PER LINE
        INX     H
        DCR     C       ;BUMP THE LINE COUNT
        JNZ     DLP1    ;NOT ZERO IF MORE FOR THIS LINE
        JMP     DLOOP   ;DO A LFCR BEFORE THE NEXT
;
;    OUTPUT HL AS HEX 16 BIT VALUE
;
ADOUT:  MOV     A,H     ;H FIRST
        CALL    HEOUT
        MOV     A,L     ;THEN L FOLLOWED BY A SPACE
;
HBOUT:  CALL    HEOUT
        CALL    SINP    ;SEE IF WE SHD ESCAPE FM DUMP
        JZ      BOUT    ;NO--ADD THE SPACE THEN
        ANI     7FH     ;MAKE SURE ITS CLEAR OF PARITY
        JZ      COMND   ;EITHER MODE (OR CTL-@)
        CPI     ' '     ;IS IT SPACE
        JNZ     BOUT    ;NO--IGNORE THE CHAR
WTLP1:  CALL    SINP    ;ON SPACE, WAIT FOR ANY OTHER CHAR
        JZ      WTLP1   ;JUST LOOP AFTER A SPACE UNTIL ANY KEY PRESSED
BOUT:   MVI     B,' '
        JMP     SOUT    ;PUT IT OUT
;
HEOUT:  MOV     C,A     ;GET THE CHARACTER
        RRC
        RRC             ;MOVE THE HIGH FOUR DOWN
        RRC
        RRC
        CALL    HEOU1   ;PUT THEM OUT
        MOV     A,C     ;THIS TIME THE LOW FOUR
;
HEOU1:  ANI     0FH     ;FOUR ON THE FLOOR
        ADI     48      ;WE WORK WITH ASCII HERE
        CPI     58      ;0-9?
        JC      OUTH    ;YUP!
        ADI     7       ;MAKE IT A LETTER
OUTH:   MOV     B,A     ;OUTPUT IT FROM REGISTER 'B'
        JMP     SOUT
;
;
;           ENTR COMMAND
;
;   THIS ROUTINE GETS VALUES FROM THE KEYBOARD AND ENTERS
; THEM INTO MEMORY.  THE INPUT VALUES ARE SCANNED FOLLOWING
; A STANDARD 'GCLIN' INPUT SO ON-SCREEN EDITING MAY TAKE
; PLACE PRIOR TO THE LINE TERMINATOR.  A SLASH '/'
; ENDS THE ROUTINE AND RETURNS CONTROL TO THE COMMAND MODE.
;
ENTER:  CALL    SCONV   ;SCAN OVER CHARS AND GET ADDRESS
        PUSH    H       ;SAVE ADDRESS
;
ENLOP:  CALL    CRLF
        MVI     B,':'
        CALL    SOUT    ;DSPLY THE COLON
        CALL    GCLI0   ;INIT AND PROCESS A LINE
        CALL    STUP    ;SET UP TO PROCESS INPUT LINE
        XCHG            ;....TO DE
;
;
ENLO1:  MVI     C,3     ;NO MORE THAN THREE SPACES BETWEEN VALUES
        CALL    SCHR1   ;SCAN TO NEXT VALUE
        JZ      ENLOP   ;LAST ENTRY FOUND START NEW LINE
;
        CPI     '/'     ;COMMAND TERMINATOR?
        JZ      COMND   ;IF SO...
        CALL    SHEX    ;CONVERT VALUE
        CPI     ':'     ;ADDRESS TERMINATOR?
        JZ      ENLO3   ;GO PROCESS IF SO
        MOV     A,L     ;GET LOW PART AS CONVERTED
        POP     H       ;GET MEMORY ADDRESS
        MOV     M,A     ;PUT IN THE VALUE
        INX     H
        PUSH    H       ;BACK GOES THE ADDRESS
        JMP     ENLO1   ;CONTINUE THE SCAN
;
ENLO3:  XTHL            ;PUT NEW ADDRESS ON STACK
        INX     D       ;MOVE SCAN PAST TERMINATOR
        JMP     ENLO1
;
;
;              EXECUTE COMMAND
;
;   THIS ROUTINE GETS THE FOLLOWING PARAMETER AND DOES A
; PROGRAM JUMP TO THE LOCATION GIVEN BY IT.  IF PROPER
; STACK OPERATIONS ARE USED WITHIN THE EXTERNAL PROGRAM
; IT CAN DO A STANDARD 'RET'URN TO THE CUTER COMMAND MODE.
;
;
EXEC:   CALL    SCONV   ;SCAN PAST BLANKS AND GET PARAMETER
EXEC1   EQU     $       ;HERE TO GO TO HL
        PUSH    H       ;SAVE ON STACK
        LXI     H,START ;LET USER KNOW WHERE WE ARE
        RET             ;AND OFF TO USER
;
;
;
;
;   THIS ROUTINE GETS A NAME OF UP TO 5 CHARACTERS
;  FROM THE INPUT STRING.  IF THE TERMINATOR IS A
;  SLASH (/) THEN THE CHARACTER FOLLOWING IS TAKEN
;  AS THE CASSETTE UNIT SPECIFICATION.
;
;
NAME0   EQU     $       ;ENTER HERE TO SET HL TO THEAD
        LXI     H,THEAD ;PT WHERE TO PUT NAME
NAME:   CALL    SBLK    ;SCAN OVER TO FIRST CHRS
        MVI     B,6
;
NAME1:  LDAX    D       ;GET CHARACTER
        CPI     ' '     ;NO UNIT DELIMITER
        JZ      NFIL
        CPI     '/'     ;UNIT DELIMITER
        JZ      NFIL
        MOV     M,A
        INX     D       ;BUMP THE SCAN POINTER
        INX     H
        DCR     B
        JNZ     NAME1   ;NAME IS OK, FALL THRU TO 'ERR1' IF NOT
;
;     CUTER ERROR HANDLER
;
ERR1:   XCHG            ;GET SCAN ADDRESS
ERR2:   MVI     M,'?'   ;FLAG THE ERROR
        LDA     OPORT   ;SEE IF VIA VDM DRIVER
        ORA     A
        JZ      COMND   ;YES--VDM SCREEN NOW HAS THE ?
        CALL    CRLF
        MVI     B,'?'   ;SET UP THE ????
        CALL    SOUT    ;INDICATE INPUT NOT VALID
        JMP     COMND   ;NOW READY FOR NEXT INPUT
;
;
;
;  HERE WE HAVE SCANNED OFF THE NAME. ZERO FILL IN FOR
;  NAMES LESS THAN FIVE CHARACTERS.
;
NFIL:   MVI     M,0     ;PUT IN AT LEAST ONE ZERO
        INX     H
        DCR     B
        JNZ     NFIL    ;LOOP UNTIL B IS ZERO
;
        CPI     '/'     ;IS THERE A UNIT SPECIFICATION?
        MVI     A,1     ;PRETEND NOT
        JNZ     DEFLT
        INX     D       ;MOVE PAST THE TERMINATOR
        CALL    SCHR    ;GO GET IT
        SUI     '0'     ;REMOVE ASCII BIAS
;
DEFLT   EQU     $       ;CNVRT TO INTERNAL BIT FOR TAPE CONTROL
        ANI     1       ;JUST BIT ZERO
        MVI     A,TAPE1 ;ASSUME TAPE ONE
        JNZ     STUNT   ;IF NON ZERO, IT IS ONE
        RAR             ;ELSE MAKE IT TAPE TWO
STUNT:  STA     FNUMF   ;SET IT IN
        RET
;
;
;
;   THIS ROUTINE PROCESSES THE XEQ AND GET COMMANDS
;
;
TXEQ:   DB      3EH     ;THIS BEGINS "MVI" OF THE "XRA" FOLLOWING
TLOAD:  XRA     A       ;A=0 TLOAD, A=AF (#0) THEN XEQ
        PUSH    PSW     ;SAVE FLAG TO SAY WHETHER LOAD OR XEQ
        LXI     H,DHEAD ;PLACE DUMMY HDR HERE FOR COMPARES
        CALL    NAME    ;SET IN NAME AND UNIT
        LXI     H,0     ;ASSUME LOAD ADDR NOT GIVEN
        CALL    PSCAN   ;HL EITHER =0, OR OVERRIDE LOAD ADDR
;
TLOA2:  XCHG            ;PUT ADDRESS IN DE
        LXI     H,DHEAD ;PT TO NORMAL HDR
        MOV     A,M     ;GET 1ST CHAR OF NAME
        ORA     A       ;IS THERE A NAME?
        JNZ     TLOA3   ;YES--LOOK FOR IT
        LXI     H,THEAD ;PT TO SAME HDR TO LOAD NEXT FILE
TLOA3:  PUSH    H       ;SAVE PTR TO WHICH HDR TO USE
        CALL    ALOAD   ;GET UNIT AND SPEED
        POP     H       ;RESTORE PTR TO PROPER HDR TO USE
        CALL    RTAPE   ;READ IN THE TAPE
        JC      TAERR   ;TAPE ERROR?
;
        CALL    NAOUT   ;PUT OUT THE HEADER PARAMETERS
        POP     PSW     ;RESTORE FLAG SAYING WHETHER IT WAS LOAD OR XEQ
        ORA     A
        RZ              ;AUTO XEQ NOT WANTED
        LDA     HTYPE   ;CHECK TYPE
        ORA     A       ;SET FLAGS
        JM      TAERR   ;TYPE IS NON XEQ
        LDA     THEAD+5
        ORA     A
        JNZ     TAERR   ;THE BYTE MUST BE ZERO FOR AUTO XEQ
        LHLD    XEQAD   ;GET THE TAPE ADDRESS
        JMP     EXEC1   ;AND GO OFF TO IT
;
;
;
;   THIS ROUTINE IS USED TO SAVE PROGRAMS AND DATA ON
;   THE CASSETTE UNIT.
;
;
TSAVE   EQU     $       ;SAVE MEMORY IMAGE TO TAPE
        CALL    NAME0   ;GET NAME AND UNIT
        CALL    SCONV   ;GET START ADDRESS
        PUSH    H       ;SAVE START ADDR FOR SIZE COMPUTATION LATER
        CALL    SCONV   ;GET END ADDR (REQUIRED)
        XTHL            ;HL=START ADDR NOW, STACK=END ADDR
        PUSH    H       ;STACK =START FOLLOWED BY END
        CALL    PSCAN   ;SEE IF RETRIEVE FROM ADDR
        SHLD    LOADR   ;EITHER ACTUAL START, OR OVERRIDE INTO HDR
        POP     H       ;HL=START ADDR
        POP     D       ;DE=END ADDR
        PUSH    H       ;PUT START BACK ONTO STACK
        MOV     A,E     ;SIZE=END-START+1
        SUB     L
        MOV     L,A
        MOV     A,D
        SBI     0       ;THIS EQUALS A "SBB H"
        SUB     H       ;THIS IS NEEDED
        MOV     H,A
        INX     H
        SHLD    BLOCK   ;STORE THE SIZE
        PUSH    H       ;SAVE AS THE BLOCK SIZE
;
        CALL    ALOAD   ;GET UNIT AND SPEED
        LXI     H,THEAD ;PT TO HEADER TO WRITE
        CALL    WHEAD   ;TURN TAPE ON, THEN WRITE HEADER
        POP     D       ;GET BACK THE SIZE
        POP     H       ;AND GET BACK THE ACTUAL START ADDR
        JMP     WTAP1   ;WRITE THE BLK (W/EXTRA PUSH)
;
;   OUTPUT ERROR AND HEADER
;
TAERR:  CALL    CRLF
        MVI     D,6
        LXI     H,ERRM
        CALL    NLOOP   ;OUTPUT ERROR
        CALL    NAOUT   ;THEN THE HEADER
        JMP     COMN1
;
ERRM:   DB      'ERROR '

;
;
;              CAT COMMAND
;
;   THIS ROUTINE READS HEADERS FROM THE TAPE AND OUTPUTS
;   THEM TO THE OUTPUT DEVICE.  IT CONTINUES UNTIL THE
;   MODE KEY IS DEPRESSED.
;
TLIST   EQU     $       ;PRODUCE A LIST OF FILES ON A TAPE
        CALL    NAME0   ;GET UNIT IF ANY (NAME IS IGNORED)
        CALL    CRLF    ;START ON A FRESH LINE
;
;
LLIST:  CALL    ALOAD
        MVI     B,1
        CALL    TON     ;TURN ON THE TAPE
LIST1:  CALL    RHEAD
        JC      COMN1   ;TRUN OFF THE TAPE UNIT
        JNZ     LIST1
        CALL    NAOUT   ;OUTPUT THE HEADER
        JMP     LLIST
;
;
;   THIS ROUTINE GETS THE CASSETTE UNIT NUMBER AND
;   SPEED TO REGISTER "A" FOR THE TAPE CALLS
;
ALOAD:  LXI     H,FNUMF ;POINT TO THE UNIT SPECIFICATION
        LDA     TSPD    ;GET THE TAPE SPEED
        ORA     M       ;PUT THEM TOGETHER
        RET             ;AND GO BACK
;
;   THIS ROUTINE OUTPUTS THE NAME AND PARAMETERS OF
;   THEAD TO THE OUTPUT DEVICE.
;
;
NAOUT:  MVI     D,8
        LXI     H,THEAD-1 ;POINT TO THE HEADER
        CALL    NLOOP   ;OUTPUT THE HEADER
        CALL    BOUT    ;ANOTHER BLANK
        LHLD    LOADR   ;NOW THE LOAD ADDRESS
        CALL    ADOUT   ;PUT IT OUT
        LHLD    BLOCK   ;AND THE BLOCK SIZE
        CALL    ADOUT
        JMP     CRLF    ;DO THE CRLF AND RETURN
;
;
NLOOP:  MOV     A,M     ;GET CHARACTER
        ORA     A
        JNZ     CHRLI   ;IF IT ISN'T A ZERO
        MVI     A,' '   ;SPACE OTHERWISE
CHRLI   EQU     $       ;CHAR IS OK TO SEND
        CALL    OUTH    ;OUTPUT IT FROM A REG
        INX     H
        DCR     D
        JNZ     NLOOP
        RET
;
;
;
;
;      "SET" COMMAND
;
;   THIS ROUTINE GETS THE ASSOCIATED PARAMETER AND
;   DISPATCHES TO THE PROPER ROUTINE FOR SETTING
;   MEMORY VALUES.
;
CSET:   CALL    SBLK    ;SCAN TO SECONDARY COMMAND
        JZ      ERR1    ;MUST HAVE AT LEAST SOMETHING!!
        PUSH    D       ;SAVE SCAN ADDRESS
        CALL    SCONV   ;CONVERT FOLLOWING VALUE
        XTHL            ;HL=SAVED SCAN ADDR AND STACK=VALUE
        LXI     D,SETAB ;SECONDARY COMMAND TABLE
        CALL    FDCOM   ;TRY TO LOCATE IT
        JMP     DISP0   ;OFF TO IT OR ERROR IF NOT IN TBL
;
;
;  THIS ROUTINE SETS THE TAPE SPEED
;
TASPD   EQU     $       ;GET CONVERTED VALUE
        ORA     A       ;IS IT ZERO?
        JZ      SETSP   ;YES--THAT IS A PROPER SPEED
        MVI     A,32    ;NO--SET SPEED PROPERLY THEN
SETSP:  STA     TSPD
        RET
;
;
STSPD   EQU     $       ;VDM ESCAPE SEQUENCE COMES HERE
        MOV     A,B     ;GET CHAR FOR FOLLOWING DISPD
DISPD   EQU     $       ;SET DISPLAY SPEED
        STA     SPEED
        RET
;
;
SETIN   EQU     $       ;SET AN INPUT PSUEDO PORT
        STA     IPORT
        RET
;
;
SETOT   EQU     $       ;SET AN OUTPUT PSUEDO PORT
        STA     OPORT
        RET
;
;
SETCI   EQU     $       ;DEFINE USER INPUT RTN ADDR
        SHLD    UIPRT
        RET
;
;
SETCO   EQU     $       ;DEFINE USER OUTPUT RTN ADDR
        SHLD    UOPRT
        RET
;
;
SETTY   EQU     $       ;SET TAPE HDR TYPE
        STA     HTYPE
        RET
;
;
SETXQ   EQU     $       ;SET TAPE-EXECUTE ADDDR FOR HDR
        SHLD    XEQAD
        RET
;
;
SETNU   EQU     $       ;HERE TO SET NUMBER OF NULLS
        STA     NUCNT   ;THIS IS IT
        RET
;
;
SETCR   EQU     $       ;SET CRC TO BE NORMAL, OR IGNORE CRC ERRORS
        STA     IGNCR   ;FF=IGNORE CRC ERRORS, ELSE=NORMAL
        RET
;
;
CUSET   EQU     $       ;TRY TO SET/CLEAR CUSTOM ROUTINE ADDR
        CALL    NAME0   ;GET A NAME (S/B 2 CHARS OR MORE)
        LXI     H,COMND ;PT HERE IN CASE ADDR NOT GIVEN
        CALL    PSCAN   ;GET OPTIONAL OPERAND IF ANY
        PUSH    H       ;SAVE THAT VALUE (IF ANY)
        LXI     H,THEAD ;PT TO NAME
        CALL    FDCOU   ;SEE IF NAME IS KNOWN IN CUST TABLE
        JZ      CUSE2   ;NO--PROCEED TO KNOW IT
        DCX     D       ;DE PT TO 1ST CHAR OF NAME IN TBL
        MVI     M,0     ;(HL CAME BACK PT'ING TO THEAD)  CLR THIS NAME
CUSE2   EQU     $       ;ENTER NEW ONE IN TBL
        MOV     A,M     ;GET 1ST CHAR OF NAME
        STAX    D       ;PUT NAME INTO TABLE
        INX     D
        INX     H
        MOV     A,M     ;GET 2ND CHAR OF NAME
        STAX    D       ;NAME IS NOW POSTED
        INX     D       ;PT TO 1ST BYTE OF ADDR
        POP     H       ;RESTORE SAVED RTN ADDR
        XCHG            ;DE=RTN ADDR, HL=THIS CU ENTRY
        MOV     M,E     ;LO BYTE
        INX     H
        MOV     M,D     ;AND HI BYTE
        RET             ;ALL DONE
;
;
; -*-
;
;
;
;
;   THE FOLLOWING ROUTINES PROVIDE "BYTE BY BYTE" ACCESS
;  TO THE CASSETTE TAPES ON EITHER A READ OR WRITE BASIS.
;
;  THE TAPE IS READ ONE BLOCK AT A TIME AND INDIVIDUAL
;  TRANSFERS OF DATA HANDLED BY MANAGING A BUFFER AREA.
;
;  THE BUFFER AREA IS CONTROLLED BY A FILE CONTROL BLOCK
;  (FCB) WHOSE STRUCTURE IS:
;
;
;     7 BYTES FOR EACH OF THE TWO FILES STRUCTURED AS
;   FOLLOWS:
;
;         1 BYTE -  ACCESS CONTROL   00 IF CLOSED
;                                    FF IF READING
;                                    FE IF WRITING
;         1 BYTE -  READ COUNTER
;         1 BYTE -  BUFFER POSITION POINTER
;         2 BYTE -  CONTROL HEADER ADDRESS
;         2 BYTE -  BUFFER LOCATION ADDRESS
;
;
;
;        THIS ROUTINE "OPENS" THE CASSETTE UNIT FOR ACCESS
;
;   ON ENTRY:  A - HAS THE TAPE UNIT NUMBER (1 OR 2)
;             HL - HAS USER SUPPLIED HEADER FOR TAPE FILE
;
;
;   NORMAL RETURN:   ALL REGISTERS ARE ALTERED
;                    BLOCK IS READY FOR ACCESS
;
;   ERROR RETURN:    CARRY BIT IS SET
;
;   ERRORS:  BLOCK ALREADY OPEN
;
;
BOPEN:  PUSH    H       ;SAVE HEADER ADDRESS
        CALL    LFCB    ;GET ADDRESS OF FILE CONTROL
        JNZ     TERE2   ;FILE WAS ALREADY OPEN
        MVI     M,1     ;NOW IT IS
        INX     H       ;POINT TO READ COUNT
        MOV     M,A     ;ZERO
        INX     H       ;POINT TO BUFFER CURSOR
        MOV     M,A     ;PUT IN THE ZERO COUNT
;
;  ALLOCATE THE BUFFER
;
        LXI     D,FBUF1 ;POINT TO BUFFER AREA
        LDA     FNUMF   ;GET WHICH ONE WE ARE GOING TO USE
        ADD     D
        MOV     D,A     ;256 BIT ADD
;
UBUF:   POP     B       ;HEADER ADDRESS
        ORA     A       ;CLEAR CARRY AND RETURN AFTER STORING PARAMS
        JMP     PSTOR   ;STORE THE VALUES
;
;    GENERAL ERROR RETURN POINTS FOR STACK CONTROL
;
TERE2:  POP     H
TERE1:  POP     D
TERE0:  XRA     A       ;CLEAR ALL FLAGS
        STC             ;SET ERROR
        RET
;
;
EOFER:  DCR     A       ;SET MINUS FLAGS
        STC             ;AND CARRY
        POP     D       ;CLEAR THE STACK
        RET             ;THE FLAGS TELL ALL
;
;
;
;
;   THIS ROUTINE CLOSES THE FILE BUFFER TO ALLOW ACCESS
;   FOR A DIFFERENT CASSETTE OR PROGRAM.  IF THE FILE
;   OPERATIONS WERE "WRITE" THEN THE LAST BLOCK IS WRITTED
;   OUT AND AN "END OF FILE" WRITTEN TO THE TAPE.  IF
;   THE OPERATIONS WERE "READS" THEN THE FILE IS JUST
;   MADE READY FOR NEW USE.
;
;   ON ENTRY:  A - HAS WHICH UNIT (1 OR 2)
;
;   ERROR RETURNS:  FILE WASN'T OPEN
;
;
PCLOS:  CALL    LFCB    ;GET CONTROL BLOCK ADDRESS
        RZ              ;WASN'T OPEN, CARRY IS SET FROM LFCB
        ORA     A       ;CLEAR CARRY
        INR     A       ;SET CONDITION FLAGS
        MVI     M,0     ;CLOSE THE CONTROL BYTE
        RZ              ;WE WERE READING...NOTHING MORE TO DO
;
;    THE FILE OPERATIONS WERE "WRITES"
;
;  PUT THE CURRENT BLOCK ON THE TAPE
;  (EVEN IF ONLY ONE BYTE)
;  THEN WRITE AN END OF FILE TO THE TAPE
;
;
        INX     H
        INX     H
        MOV     A,M     ;GET CURSOR POSITION
        MOV     A,M     ;GET CURSOR POSITION
        CALL    PLOAD   ;BC GET HEADER ADDRESS, DE BUFFER ADDRESS
        PUSH    B       ;HEADER TO STACK
        LXI     H,BLKOF ;OFFSET TO BLOCK SIZE
        DAD     B
        ORA     A       ;TEST COUNT
        JZ      EOFW    ;NO BYTES...JUST WRITE EOF
;
;    WRITE LAST BLOCK
;
        PUSH    H       ;SAVE BLOCK SIZE POINTER FOR EOF
        MOV     M,A     ;PUT IN COUNT
        INX     H
        MVI     M,0     ;ZERO THE HIGHER BYTE
        INX     H
        MOV     M,E     ;BUFFER ADDRESS
        INX     H
        MOV     M,D
        MOV     H,B
        MOV     L,C     ;PUT HEADER ADDRESS IN HL
        CALL    WFBLK   ;GO WRITE IT OUT
        POP     H       ;BLOCK SIZE POINTER
;
;   NOW WRITE END OF FILE TO CASSETTE
;
EOFW:   XRA     A       ;PUT IN ZEROS FOR SIZE:  EOF MARK IS ZERO BYTES!
        MOV     M,A
        INX     H
        MOV     M,A
        POP     H       ;HEADER ADDRESS
        JMP     WFBLK   ;WRITE IT OUT AND RETURN
;
;
;
;
;   THIS ROUTINE LOCATES THE FILE CONTROL BLOCK POINTED TO
;   BY REGISTER "A".  ON RETURN HL POINT TO THE CONTROL BYT
;   AND REGISTER "A" HAS THE CONTROL WORD WITH THE FLAGS
;   SET FOR IMMEDIATE CONDITION DECISIONS.
;
;
LFCB:   LXI     H,FCBAS ;POINT TO THE BASE OF IT
        RAR             ;MOVE THE 1 & 2 TO 0 & 1 LIKE COMPUTERS LIKE
        ANI     1       ;SMALL NUMBERS ARE THE RULE
        STA     FNUMF   ;CURRENT ACCESS FILE NUMBER
        JZ      LFCB1   ;UNIT ONE (VALUE OF ZERO)
        LXI     H,FCBA2 ;UNIT TWO--PT TO ITS FCB
LFCB1   EQU     $       ;HL PT TO PROPER FCB
        MOV     A,M     ;PICK UP FLAGS FM FCB
        ORA     A       ;SET FLAGS BASED ON CONTROL WORD
        STC             ;SET CARRY IN CASE OF IMMEDIATE ERROR RETURN
        RET
;
;
;
;
;    READ TAPE BYTE ROUTINE
;
;    ENTRY:       -  A -  HAS FILE NUMBER
;    EXIT: NORMAL -  A -  HAS BYTE
;          ERROR
;            CARRY SET     - IF FILE NOT OPEN OR
;                            PREVIOUS OPERATIONS WERE WRITE
;            CARRY & MINUS - END OF FILE ENCOUNTERED
;
;
;
;
RTBYT:  CALL    LFCB    ;LOCATE THE FILE CONTROL BLOCK
        RZ              ;FILE NOT OPEN
        INR     A       ;TEST IF FF
        JM      TERE0   ;ERROR WAS WRITING
        MVI     M,(-1) AND 0FFH ;SET IT AS READ  (IN CASE IT WAS JUST OPENED)
        INX     H
        MOV     A,M     ;GET READ COUNT
        PUSH    H       ;SAVE COUNT ADDRESS
        INX     H
        CALL    PLOAD   ;GET THE OTHER PARAMETERS
        POP     H
        ORA     A
        JNZ     GTBYT   ;IF NOT EMPTY GO GET BYTE
;
;  CURSOR POSITION WAS ZERO...READ A NEW BLOCK INTO
;  THE BUFFER.
;
RDNBLK: PUSH    D       ;BUFFER POINTER
        PUSH    H       ;TABLE ADDRESS
        INX     H
        CALL    PHEAD   ;PREPARE THE HEADER FOR READ
        CALL    RFBLK   ;READ IN THE BLOCK
        JC      TERE2   ;ERROR POP OFF STACK BEFORE RETURN
        POP     H
        MOV     A,E     ;LOW BYTE OF COUNT (WILL BE ZERO IF 256)
        ORA     D       ;SEE IF BOTH ARE ZERO
        JZ      EOFER   ;BYTE COUNT WAS ZERO....END OF FILE
        MOV     M,E     ;NEW COUNT ( ZERO IS 256 AT THIS POINT)
        INX     H       ;BUFFER LOCATION POINTER
        MVI     M,0
        DCX     H
        MOV     A,E     ;COUNT TO A
        POP     D       ;GET BACK BUFFER ADDRESS
;
;
;
;   THIS ROUTINE GETS ONE BYTE FROM THE BUFFER
;  AND RETURNS IT IN REGISTER "A".  IF THE END
;  OF THE BUFFER IS REACHED IT MOVES THE POINTER
;  TO THE BEGINNING OF THE BUFFER FOR THE NEXT
;  LOAD.
;
GTBYT:  DCR     A       ;BUMP THE COUNT
        MOV     M,A     ;RESTORE IT
        INX     H
        MOV     A,M     ;GET BUFFER POSITION
        INR     M       ;BUMP IT
;
        ADD     E
        MOV     E,A     ;DE NOW POINT TO CORRECT BUFFER POSITION
        JNC     RT1
        INR     D
RT1:    LDAX    D       ;GET CHARACTER FROM BUFFER
        ORA     A       ;CLEAR CARRY
        RET             ;ALL DONE
;
;
;
;
;      THIS ROUTINE IS USED TO WRITE A BYTE TO THE FILE
;
;      ON ENTRY:   A -  HAS FILE NUMBER
;                  B -  HAS DATA BYTE
;
;
WTBYT:  CALL    LFCB    ;GET CONTROL BLOCK
        RZ              ;FILE WASN'T OPEN
        INR     A
        RZ              ;FILE WAS READ
        MVI     M,0FEH  ;SET IT TO WRITE
        INX     H
        INX     H
        MOV     A,B     ;GET CHARACTER
        PUSH    PSW
        PUSH    H       ;SAVE CONTROL ADDRESS+2
;
;   NOW DO THE WRITE
;
        CALL    PLOAD   ;BC GETS HEADER ADDR, DE BUFFER ADDRESS
        POP     H
        MOV     A,M     ;COUNT BYTE
        ADD     E
        MOV     E,A
        JNC     WT1
        INR     D
WT1:    POP     PSW     ;CHARACTER
        STAX    D       ;PUT CHR IN BUFFER
        ORA     A       ;CLEAR FLAGS
        INR     M       ;INCREMENT THE COUNT
        RNZ             ;RETURN IF COUNT DIDN'T ROLL OVER
;
;   THE BUFFER IS FULL. WRITE IT TO TAPE AND RESET
;  CONTROL BLOCK.
;
        CALL    PHEAD   ;PREPARE THE HEADER
        JMP     WFBLK   ;WRITE IT OUT AND RETURN
;
;
;
;
;  THIS ROUTINE PUTS THE BLOCK SIZE (256) AND BUFFER
;  ADDRESS IN THE FILE HEADER.
;
PHEAD:  CALL    PLOAD   ;GET HEADER AND BUFFER ADDRESSES
        PUSH    B       ;HEADER ADDRESS
        LXI     H,BLKOF-1 ;PSTOR DOES AN INCREMENT
        DAD     B       ;HL POINT TO BLOCKSIZE ENTRY
        LXI     B,256
        CALL    PSTOR
        POP     H       ;HL RETURN WITH HEADER ADDRESS
        RET
;
;
PSTOR:  INX     H
        MOV     M,C
        INX     H
        MOV     M,B
        INX     H
        MOV     M,E
        INX     H
        MOV     M,D
        RET
;
;
PLOAD:  INX     H
        MOV     C,M
        INX     H
        MOV     B,M
        INX     H
        MOV     E,M
        INX     H
        MOV     D,M
        RET
;
;
;
;
;
;   THIS ROUTINE SETS THE CORRECT UNIT FOR SYSTEM READS
RFBLK:  CALL    GTUNT   ;SET UP A=UNIT WITH SPEED
;
;
;
;
;              TAPE READ ROUTINES
;
;     ON-ENTRY:     A HAS UNIT AND SPEED
;                   HL POINT TO HEADER BLOCK
;                   DE HAVE OPTIONAL PUT ADDRESS
;
;     ON EXIT:      CARRY IS SET IF ERROR OCCURED
;                   TAPE UNITS ARE OFF
;
;
RTAPE:  PUSH    D       ;SAVE OPTIONAL ADDRESS
        MVI     B,3     ;SHORT DELAY
        CALL    TON
        IN      TDATA   ;CLEAR THE UART FLAGS
;
PTAP1:  PUSH    H       ;HEADER ADDRESS
        CALL    RHEAD   ;GO READ HEADER
        POP     H
        JC      TERR    ;IF AN ERROR OR ESC WAS RECEIVED
        JNZ     PTAP1   ;IF VALID HEADER NOT FOUND
;
;  FOUND A VALID HEADER NOW DO COMPARE
;
        PUSH    H       ;GET BACK AND RESAVE ADDRESS
        LXI     D,THEAD
        CALL    DHCMP   ;COMPARE DE-HL HEADERS
        POP     H
        JNZ     PTAP1
;
;
        POP     D       ;OPTIONAL "PUT" ADDRESS
        MOV     A,D
        ORA     E       ;SEE IF DE IS ZERO
        LHLD    BLOCK   ;GET BLOCK SIZE
        XCHG            ;...TO DE
;  DE HAS HBLOCK....HL HAS USER OPTION
        JNZ     RTAP    ;IF DE WAS ZERO GET TAPE LOAD ADDRESS
        LHLD    LOADR   ;GET TAPE LOAD ADDRESS
;
;
;     THIS ROUTINE READS "DE" BYTES FROM THE TAPE
;     TO ADDRESS HL.  THE BYTES MUST BE FROM ONE
;     CONTIGUOUS PHYSICAL BLOCK ON THE TAPE.
;
;          HL HAS "PUT" ADDRESS
;          DE HAS SIZE OF TAPE BLOCK
;
RTAP:   PUSH    D       ;SAVE SIZE FOR RETURN TO CALLING PROGRAM
;
RTAP2   EQU     $       ;HERE TO LOOP RDING BLKS
        CALL    DCRCT   ;DROP COUNT, B=LEN THIS BLK
        JZ      RTOFF   ;ZERO=ALL DONE
;
        CALL    RHED1   ;READ THAT MANY BYTES
        JC      TERR    ;IF ERROR OR ESC
        JZ      RTAP2   ;RD OK--READ SOME MORE
;
;  ERROR RETURN
;
TERR:   XRA     A
        STC             ;SET ERROR FLAGS
        JMP     RTOF1
;
;
TOFF:   MVI     B,1
        CALL    DELAY
RTOFF:  XRA     A
RTOF1:  OUT     TAPPT
        POP     D       ;RETURN BYTE COUNT
        RET
;
;
DCRCT   EQU     $       ;COMMON RTN TO COUNT DOWN BLK LENGTHS
        XRA     A       ;CLR FOR LATER TESTS
        MOV     B,A     ;SET THIS BLK LEN=256
        ORA     D       ;IS AMNT LEFT < 256
        JNZ     DCRC2   ;NO--REDUCE AMNT BY 256
        ORA     E       ;IS ENTIRE COUNT ZERO
        RZ              ;ALL DONE--ZERO=THIS CONDITION
        MOV     B,E     ;SET THIS BLK LEN TO AMNT REMAINING
        MOV     E,D     ;MAKE ENTIRE COUNT ZERO NOW
        RET             ;ALL DONE (NON-ZERO FLAG)
DCRC2   EQU     $       ;REDUCE COUNT BY 256
        DCR     D       ;DROP BY 256
        ORA     A       ;FORCE NON-ZERO FLAG
        RET             ;NON-ZERO=NOT DONE YET (BLK LEN=256)
;
;
;   READ THE HEADER
;
RHEAD:  MVI     B,10    ;FIND 10 NULLS
RHEA1:  CALL    STAT
        RC              ;IF ESCAPE
        IN      TDATA   ;IGNORE ERROR CONDITIONS
        ORA     A       ;ZERO?
        JNZ     RHEAD
        DCR     B
        JNZ     RHEA1   ;LOOP UNTIL 10 IN A ROW
;
;    WAIT FOR THE START CHARACTER
;
SOHL:   CALL    TAPIN
        RC              ;ERROR OR ESCAPE
        CPI     1       ;ARE WE AT THE 01 YET (START CHAR)
        JC      SOHL    ;NO, BUT STIL ZEROES
        JNZ     RHEAD   ;NO, LOOK FOR ANOTHER 10 NULLS
;
;    WE HAVE  10 (OR MORE) NULLS FOLLOWED IMMEDIATELY
;    BY AN 01.  NOW READ THE HEADER.
;
        LXI     H,THEAD ;POINT TO BUFFER
        MVI     B,HLEN  ;LENGTH TO READ
;
RHED1   EQU     $       ;RD A BLOCK INTO HL FOR B BYTES
        MVI     C,0     ;INIT THE CRC
RHED2   EQU     $       ;LOOP HERE
        CALL    TAPIN   ;GET A BYTE
        RC
        MOV     M,A     ;STORE IT
        INX     H       ;INCREMENT ADDRESS
        CALL    DOCRC   ;GO COMPUTE THE CRC
        DCR     B       ;WHOLE HEADER YET?
        JNZ     RHED2   ;DO ALL THE BYTES
;
;   THIS ROUTINE GETS THE NEXT BYTE AND COMPARES IT
; TO THE VALUE IN REGISTER C.  THE FLAGS ARE SET ON
; RETURN.
;
        CALL    TAPIN   ;GET CRC BYTE
        XRA     C       ;CLR CARRY AND SET ZERO IF MATCH, ELSE NON-ZERO
        RZ              ;CRC IS FINE
        LDA     IGNCR   ;BAD CRC, SHD WE STILL ACCEPT IT
        INR     A       ;SEE IF IT WAS FF, IF FF THEN ZERO SAYS IGN ERR
;   NOW, CRC ERR DETECTION DEPENDS ON IGNCR.
        RET
;
;    THIS ROUTINE GETS THE NEXT AVAILABLE BYTE FROM THE
;  TAPE.  WHILE WAITING FOR THE BYTE THE KEYBOARD IS TESTED
;  FOR AN ESC COMMAND.  IF RECEIVED THE TAPE LOAD IS
;  TERMINATED AND A RETURN TO THE COMMAND MODE IS MADE.
;
STAT:   IN      TAPPT   ;TAPE STATUS PORT
        CMA             ;*UM* MITS ACR USES ACTIVE LOW
        ANI     TDR
        RNZ
        CALL    SINP    ;CHECK INPUT
        JZ      STAT    ;NOTHING THERE YET
        ANI     7FH     ;CLEAR PARITY 1ST
        JNZ     STAT    ;EITHER MODE OR CTL-@
        STC             ;SET ERROR FLAG
        RET             ;AND RETURN
;
;
;
TAPIN:  CALL    STAT    ;WAIT UNTIL A CHARACTER IS AVAILABLE
        RC
;
TREDY:  IN      TAPPT   ;TAPE STATUS
        ANI     TFE+TOE ;DATA ERROR?
        IN      TDATA   ;GET THE DATA
        RZ              ;IF NO ERRORS
        STC             ;SET ERROR FLAG
        RET
;
;
;  THIS ROUTINE GETS THE CORRECT UNIT FOR SYSTEM WRITES
WFBLK:  CALL    GTUNT   ;SET UP A WITH UNIT AND SPEED
;
;
;
;       WRITE TAPE BLOCK ROUTINE
;
;   ON ENTRY:   A   HAS UNIT AND SPEED
;              HL   HAS POINTER TO HEADER
;
;
WTAPE   EQU     $       ;HERE TO WRITE TAPE
        PUSH    H       ;SAVE HEADER ADDRESS
        CALL    WHEAD   ;TURN ON, THEN WRITE HDR
        POP     H
        LXI     D,BLKOF ;OFFSET TO BLOCK SIZE IN HEADER
        DAD     D       ;HL POINT TO BLOCK SIZE
        MOV     E,M
        INX     H
        MOV     D,M     ;DE HAVE SIZE
        INX     H
        MOV     A,M
        INX     H
        MOV     H,M
        MOV     L,A     ;HL HAVE STARTING ADDRESS
;
;    THIS ROUTINE WRITES ONE PHYSICAL BLOCK ON THE
;  TAPE "DE" BYTES LONG FROM ADDRESS "HL".
;
;
WTAP1   EQU     $       ;HERE FOR THE EXTRA PUSH
        PUSH    H       ;A DUMMY PUSH FOR LATER EXIT
WTAP2   EQU     $       ;LOOP HERE UNTIL ENTIRE AMOUNT READ
        CALL    DCRCT   ;DROP COUNT IN DE AND SET UP B W/LEN THIS BLK
        JZ      TOFF    ;RETURNS ZERO IF ALL DONE
        CALL    WTBL    ;WRITE BLOCK FOR BYTES IN B (256)
        JMP     WTAP2   ;LOOP UNTIL ALL DONE
;
;
WRTAP:  PUSH    PSW
WRWAT:  IN      TAPPT   ;TAPE STATUS
        CMA             ;*UM* MITS ACR USES ACTIVE LOW
        ANI     TTBE    ;IS TAPE READY FOR A CHAR YET
        JZ      WRWAT   ;NO--WAIT
        POP     PSW     ;YES--RESTORE CHAR TO OUTPUT
        OUT     TDATA   ;SEND CHAR TO TAPE
;
DOCRC   EQU     $       ;A COMMON CRC COMPUTATION ROUTINE
        SUB     C
        MOV     C,A
        XRA     C
        CMA
        SUB     C
        MOV     C,A
        RET             ;ONE  BYTE NOW WRITTEN
;
;
;   THIS ROUTINE WRITES THE HEADER POINTED TO BY
;   HL TO THE TAPE.
;
WHEAD   EQU     $       ;HERE TO 1ST TURN ON THE TAPE
        CALL    WTON    ;TURN IT ON, THEN WRITE HEADER
        MVI     D,50    ;WRITE 50 ZEROS
NULOP:  XRA     A
        CALL    WRTAP
        DCR     D
        JNZ     NULOP
;
        MVI     A,1
        CALL    WRTAP
        MVI     B,HLEN  ;LENGTH TO WRITE OUT
;
WTBL:   MVI     C,0     ;RESET CRC BYTE
WLOOP:  MOV     A,M     ;GET CHARACTER
        CALL    WRTAP   ;WRITE IT TO THE TAPE
        DCR     B
        INX     H
        JNZ     WLOOP
        MOV     A,C     ;GET CRC
        JMP     WRTAP   ;PUT IT ON THE TAPE AND RETURN
;
;
;   THIS ROUTINE COMPARES THE HEADER IN THEAD TO
;   THE USER SUPPLIED HEADER IN ADDRESS HL.
;   ON RETURN IF ZERO IS SET THE TWO NAMES COMPARED
;
DHCMP:  MVI     B,5
DHLOP:  LDAX    D
        CMP     M
        RNZ
        DCR     B
        RZ              ;IF ALL FIVE COMPARED
        INX     H
        INX     D
        JMP     DHLOP
;
GTUNT   EQU     $       ;SET A=SPEED + UNIT
        LDA     FNUMF   ;GET UNIT
        ORA     A       ;SEE WHICH UNIT
        LDA     TSPD    ;BUT 1ST GET SPEED
        JNZ     GTUN2   ;MAKE IT UNIT TWO
        ADI     TAPE2   ;THIS ONCE=UNIT 2, TWICE=UNIT 1
GTUN2:  ADI     TAPE2   ;UNIT AND SPEED NOW SET IN A
        RET             ;ALL DONE
;
WTON:   MVI     B,4     ;SET LOOP DELAY  (BIT LONGER ON A WRITE)
TON     EQU     $       ;HERE TO TURN A TAPE ON THEN DELAY
        OUT     TAPPT   ;GET TAPE MOVING, THEN DELAY
;
DELAY:  LXI     D,0
DLOP1:  DCX     D
        MOV     A,D
        ORA     E
        JNZ     DLOP1
        DCR     B
        JNZ     DELAY
        RET
;
;
;**** -- END OF PROGRAM--
;
;
;
;
;    S Y S T E M    E Q U A T E S
;
;
;          VDM PARAMETERS
;
VDMEM   EQU     0CC00H  ;VDM SCREEN MEMORY
;
;
;            KEYBOARD SPECIAL KEY ASSIGNMENTS
;
;  THESE DEFINITIONS ARE DESIGNED TO ALLOW
;  COMPATABILITY WITH SOLOS(TM). THESE ARE THE
;  SAME KEYS WITH BIT 7 (X'80') STRIPPED OFF.
;
DOWN    EQU     1AH     ;CTL Z
UP      EQU     17H     ;CTL W
LEFT    EQU     01H     ;CTL A
RIGHT   EQU     13H     ;CTL S
CLEAR   EQU     0BH     ;CTL K
HOME    EQU     0EH     ;CTL N
MODE    EQU     00H     ;CTL-@
;BACKS   EQU     5FH     ;BACKSPACE
BACKS   EQU     08H     ;*UM*
LF      EQU     10
CR      EQU     13
BLANK   EQU     ' '
SPACE   EQU     BLANK
CX      EQU     'X'-40H
ESC     EQU     1BH
;
;          PORT ASSIGNMENTS
;
STAPT   EQU     0       ;STATUS PORT GENERAL
;STKBD   EQU     STAPT   ;PROCTEC 3P+S
STKBD   EQU     4       ;*UM* MITS PIO
SDATA   EQU     1       ;SERIAL DATA
SIO2S   EQU     18      ;*UM* STATUS SIO2 B
SIO2D   EQU     19      ;*UM* DATA SIO2 B
PDATA   EQU     2       ;PARALLEL DATA
;KDATA   EQU     3       ;KEYBOARD DATA PROCTEC 3P+S
KDATA   EQU     5       ;*UM* KEYBOARD DATA MITS PIO
DSTAT   EQU     0C8H    ;VDM CONTROL PORT
;TAPPT   EQU     0FAH    ;TAPE STATUS PORT PROCTEC SOL-20
TAPPT   EQU     06H     ;*UM* TAPE STATUS PORT MITS ACR
;TDATA   EQU     0FBH    ;TAPE DATA PORT PROCTEC SOL-20
TDATA   EQU     07H     ;*UM* TAPE DATA PORT MITS ACR
SENSE   EQU     0FFH    ;SENSE SWITCHES
;
;
;
;          BIT ASSIGNMENT MASKS
;
SCD     EQU     1       ;SERIAL CARRIER DETECT
SDSR    EQU     2       ;SERIAL DATA SET READY
SPE     EQU     4       ;SERIAL PARITY ERROR
SFE     EQU     8       ;SERIAL FRAMING ERROR
SOE     EQU     16      ;SERIAL OVERRUN ERROR
SCTS    EQU     32      ;SERIAL CLEAR TO SEND
;SDR     EQU     64      ;SERIAL DATA READY PROCTEC 3P+S
SDR     EQU     1       ;*UM* SERIAL DATA READY MITS SIO
SDR2    EQU     1       ;*UM* SERIAL DATA READY MITS 2SIO
;STBE    EQU     128     ;SERIAL TRANSMITTER BUFFER EMPTY PROCTEC 3P+S
STBE    EQU     128     ;*UM* SERIAL TRANSMITTER BUFFER EMPTY MITS SIO
STBE2   EQU     2       ;*UM* SERIAL TRANSMITTER BUFFER EMPTY MITS 2SIO
;
KDR     EQU     1       ;KEYBOARD DATA READY
PDR     EQU     2       ;PARALLEL DATA READY
PXDR    EQU     4       ;PARALLEL DEVICE READY
;TFE     EQU     8       ;TAPE FRAMING ERROR PROCTEC CUTS
TFE     EQU     16      ;*UM* TAPE FRAMING ERROR MITS ACR
;TOE     EQU     16      ;TAPE OVERFLOW ERROR PROCTEC CUTS
TOE     EQU     8       ;*UM* TAPE OVERFLOW ERROR MITS ACR
;TDR     EQU     64      ;TAPE DATA READY PROCTEC CUTS
TDR     EQU     1       ;*UM* TAPE DATA READY MITS ACR
TTBE    EQU     128     ;TAPE TRANSMITTER BUFFER EMPTY
;
SOK     EQU     1       ;SCROLL OK FLAG
;
TAPE1   EQU     80H     ;1=TURN TAPE ONE ON
TAPE2   EQU     40H     ;1=TURN TAPE TWO ON
;
;
;
;
;       S Y S T E M   G L O B A L    A R E A
;
        ORG    START+0800H ;RAM STARTS JUST AFTER ROM
;
SYSRAM  EQU     $       ;START OF SYSTEM RAM
SYSTP   EQU     SYSRAM+3FFH ;STACK WORKS FM TOP DOWN
;
;
;   PARAMETERS STORED IN RAM
;
UIPRT:  DS      2       ;USER DEFINED INPUT RTN IF NON ZERO
UOPRT:  DS      2       ;USER DEFINED OUTPUT RTN IF NON ZERO
DFLTS:  DS      2       ;DEFAULT PSUEDO I/O PORTS
IPORT:  DS      1       ;CRNT INPUT PSUEDO PORT
OPORT:  DS      1       ;CRNT OUTPUT PSUEDO PORT
NCHAR:  DS      1       ;CURRENT CHARACTER POSITION
LINE:   DS      1       ;CURRENT LINE POSITION
BOT:    DS      1       ;BEGINNING OF TEXT DISPLACEMENT
SPEED:  DS      1       ;SPEED CONTROL BYTE
ESCFL:  DS      1       ;ESCAPE FLAG CONTROL BYTE
TSPD:   DS      1       ;CURRENT TAPE SPEED
INPTR:  DS      2       ;PTR TO NEXT CHAR POSITION IN INLIN
NUCNT:  DS      1       ;NUMBER OF NULLS AFTER CRLF
IGNCR:  DS      1       ;IGN CRC ERR FLAG, FF=IGN CRC ERRS, ELSE=NORMAL
;
        DS      10      ;ROOM FOR FUTURE EXPANSION
;
; * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;    T H I S   I S   T H E   H E A D E R   L A Y O U T    *
; * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;
THEAD:  DS      5       ;NAME
        DS      1       ;THIS BYTE MUST BE ZERO
HTYPE:  DS      1       ;TYPE
BLOCK:  DS      2       ;BLOCK SIZE
LOADR:  DS      2       ;LOAD ADDRESS
XEQAD:  DS      2       ;AUTO EXECUTE ADDRESS
HSPR:   DS      3       ;SPARES
;
HLEN    EQU     $-THEAD ;LENGTH OF HEADER
BLKOF   EQU     BLOCK-THEAD ;OFFSET TO BLOCK SIZE
DHEAD:  DS      HLEN    ;A DUMMY HDR FOR COMPARES WHILE RD'ING
;
;
CUTAB:  DS      6*4     ;ROOM FOR UP TO 6 CUSTOM USER COMMANDS
;
;
FNUMF:  DS      1       ;FOR CURRENT FILE OPERATIONS
FCBAS:  DS      7       ;1ST FILE CONTROL BLOCK
FCBA2:  DS      7       ;2ND FILE CONTROL BLOCK
FBUF1:  DS      2*256   ;SYSTEM FILE BUFFER BASE
        DS      1       ;"BELL" (X'07') FLAGS START OF INPUT BFR
INLIN:  DS      80      ;ROOM FOR THE INPUT LINE
USARE   EQU     $       ;START OF USER AREA
;
;   REMEMBER THAT THE STACK WORKS ITS WAY DOWN-FROM
;   THE END OF THIS 1K RAM AREA.
;
; -*-
        END
