*
*
*   INSERT FILE ROUTINE
*
*
IFILE CALL HRET1  RESTORE THE SCREEN AND EDIT PARAMS
 CALL IFSET  SET DRIVE NOT READY AND HARD TRAPS
 CALL HFARG  GET FIRST ARGUMENT
 DCX H
 LXI D,BUFNA
 MVI A,PSOP+40H
 CALL PSCAN  OPEN THE FILE
 MVI A,ERNAX
 JZ IFEROP  IF NOTHING--NAME EXPECTED ERROR
 MOV A,E
 JC IFEROP  OPEN ERROR
 STA IFNUM  SAVE THE FILE NUMBER
 MVI A,1
 STA IMODF  INSERT MODE ON
*
*
IFLOOP CALL SCCUR  ON WITH THE CURSOR
 CALL CONTST  TEST FOR MODE SELECT
 JZ IFLO2
 CALL CONIN
 ANI 7FH
 ORA A
 JZ IFCLO  WAS MODE SELECT SO STOP INSERTING
 LHLD SYSGLO  WASN'T MODE SELECT SO PUT IT BACK
 LXI D,GLFLG
 DAD D
 MVI M,-1
IFLO2 LDA IFNUM
 CALL RB
 JMP IFER0  EOF??
 ANI 7FH
 CPI CR
 JZ IFLO1
 CALL CHAR  PUT CHARACTER INTO FILE
 JMP IFLOOP
*
*
IFLO1 CALL DISPT  PROCESS THE CARRIAGE RETURN
 JMP IFLOOP
*
*
IFER0 CPI EREOF
 JNZ IFERD  READ ERROR IF NOT EOF
IFCLO LDA IFNUM
 CALL SYS
 DB CLOOP
 JMP IFERCL
IFDONE MVI A,-1
 STA IFNUM  REMEMBER THAT IFNUM IS CLOSED
 XRA A
 STA IMODF
 CALL IFRESET  RESET DRIVE NOT READY AND HARD TRAPS
 LXI SP,AREA+18
 JMP DISPO  BACK TO THE EDITOR
*
*
IFEROP MVI B,OPEOP  OPEN ERROR
 ORA A
 JNZ IFERR
 MVI A,ERSYN  IF PSCAN RETURNED 0, SAY SYNTAX ERROR
 JMP IFERR
IFERD MVI B,RBLOP  READ ERROR
 JMP IFERR
IFERCL MVI B,CLOOP  CLOSE ERROR
 JMP IFERR
IFERS MVI B,CTLOP  CTRL/STATUS ERROR
 JMP IFERR
*
IFERR STA ERCOD
 MOV A,B
 STA CMCOD
 CALL UPDT  UPDATE LINE IN MEMORY
 CALL SAVCUR  SAVE CURSOR'S ADDRESS
 CALL INITS  CLEAR SCREEN
 LDA ERCOD
 CPI ERRED  IS IT DRIVE-NOT-READY ERROR?
 JZ IFER7  YES--IGNORE IT
 MVI A,-1  SET SCREEN SAVED FLAG
 STA SAVFLAG  IN CASE OF SUTIL DRIVE NOT READY
 LXI H,0  SAVE SP BECAUSE OF BUG IN UXOP
 DAD SP
 SHLD SPSAFE
 LXI H,CRMSG  WHAT TO PRINT ON 2ND LINE
 MVI A,80H  RETURN TO EDIT
 CALL UTIL
 DB UXOP
 JMP IFER9
CMCOD DB -1
ERCOD DB -1
IFER5 LHLD SPSAFE  RESTORE SP
 SPHL .
*
IFER6 CALL CONIN  WAIT FOR A CR
 CPI 0DH
 JNZ IFER6
IFER7 LDA IFNUM  CLOSE IFNUM
 CALL SYS
 DB CLOOP
 NOP .  IGNORE ERRORS
 NOP .
 NOP .
 CALL HRET1  RESTORE SCREEN
 XRA A
 STA SAVFLAG  RESET SCREEN SAVED FLAG
 JMP IFDONE
*
IFER9 CALL OUST  ERROR RETURN FROM UXOP
 DB 0DH,0AH  TELL THEM WE CAN'T EXPLAIN THE ERROR
 ASC "ERROR: CAN'T EXPLAIN"
 DB 0DH,0AH
CRMSG ASC "C/R TO CONTINUE"
 DB 0
 JMP IFER5
*
*
IFSET MVI B,8  SET DRIVE NOT READY AND HARD TRAPS
 LXI H,DNRTRAP
 MVI A,SUTILFN  DO CRTL/STATUS ON SUTIL TO SET TRAP
 CALL SYS
 DB CTLOP
 JMP IFERS
 LHLD SYSGLO
 LXI D,GLERH
 DAD D
 MOV E,M
 MVI M,-1
 INX H
 MOV D,M
 MVI M,-1
 XCHG .
 SHLD HERRTRP
 RET .
*
IFRESET MVI B,8  RESET DRIVE NOT READY AND HARD TRAPS
 LXI H,0
 MVI A,SUTILFN
 CALL SYS
 DB CTLOP
 JMP IFERS
 LHLD SYSGLO
 LXI D,GLERH
 DAD D
 XCHG .
 LHLD HERRTRP
 XCHG .
 MOV M,E
 INX H
 MOV M,D
 RET .
*
DNRTRAP LDA SAVFLAG
 ORA A
 JNZ DNRT2  IF SCREEN HAS ALLREADY BEEN SAVED, DON'T SAVE AGAIN
 CALL UPDT  UPDATE LINE IN MEMORY
 CALL SAVCUR  SAVE CURSOR'S ADDRESS
DNRT2 CALL INITS  CLEAR SCREEN
 CALL OUST
 DB 0DH,0AH
 ASC "DRIVE NOT READY"
 DB 0DH,0AH
 ASC "TYPE C/R WHEN READY"
 DB 0
 CALL CONIN  WAIT FOR ANY CHARACTER
 PUSH PSW
 LDA SAVFLAG
 ORA A
 JNZ DNRT3
 CALL HRET1  RESTORE SCREEN
DNRT3 POP PSW
 ANI 7FH  ZAP PARITY AND SET/RESET ZERO FLAG
 RET .  IF MODE WAS HIT RETURN WITH ZERO SET, ELSE ZERO CLEAR
*
HERRTRP DW -1  STORAGE FOR HARD ERROR TRAP WORD
SAVFLAG DB 0  SCREEN SAVED FLAG USED IN INSERT FILE
*
*
*        BLOCK MOVE           VER 1.0
*
*
*
*    CXBUF IS USED FOR TEMPORARY STORAGE. (IBUF & ABUF)
*    THE LABELS INST,FRST,AND LAST REFER TO
*    LOCATIONS WHERE THE CORRESPONDING ADRS
*    ARE STORED.
*
*
BMOV CALL INITS  Clear screen.
 XRA A  Set cursor to line 0, char position 0.
 MOV B,A
 CALL SCUR
 CALL ZBUF  ZERO ABUF FOR STORAGE
 LHLD BFP  GET START OF FILE ADR
*
GF CALL FFLG  FIND A FLAG LINE
 JNC CHKN  IF NO FLAG FOUND
 PUSH H  SAVE FILE POINTER
*
* THE FOLLOWING COUNTS # OF FLAGS FOUND
*
 CPI 'I'
 JZ GF1
 CPI 'F'
 JZ GF2
 LXI H,ABUF+8  THE 'L' CNTR REG
 INR M  INC # OF 'LAST' FLAGS CNTR
 POP H
 SHLD LAST  STORE ADR OF FLAG LINE
 JMP GF3
*
*
GF1 LXI H,ABUF+6  THE 'I' CNTR REG
 INR M  INC # OF 'INST' FLAGS CNTR
 POP H
 SHLD INST  STORE ADR OF FLAG LINE
 JMP GF3
*
*
GF2 LXI H,ABUF+7  THE 'F' CNTR REG
 INR M  INC # OF 'FRST' FLAGS CNTR
 POP H
 SHLD FRST  STORE ADR OF FLAG LINE
GF3 INX H
 INX H
 INX H
 JMP GF  LOOK FOR ANOTHER FLAG
*
*
* SEE IF EXACTLY 1 FLAG OF EACH KIND FOUND
*
CHKN LXI H,ABUF+6  INST CNTR
 MVI A,1
 CMP M  COMP CNTR WITH ACC
 JZ CN1
 MVI C,'I'
 JNC NOFL  NO FLAG MSG
 JMP MFL  MULTIPLE FLAG MSG
*
*
CN1 INX H  INC CNTR POINTER
 CMP M
 JZ CN2
 MVI C,'F'
 JNC NOFL
 JMP MFL
*
*
CN2 INX H  INC CNTR POINTER
 CMP M
 JZ CKFL  CHK FLAG ORDER
 MVI C,'L'
 JNC NOFL
*
*        OUT MULTIPLE FLAG MSG
*
MFL LXI H,M1  MULT FLAG MSG
 CALL PRINT  WRITE MSG ON SCRN
 MOV A,C  GET FLAG LETTER
 CALL CONOUT  WRT LETR ON SCRN
 CALL CRLF
 JMP STRTED  BACK TO BEGINNING OF EDITOR
*
*
*              OUT NO FLAG SET MSG
*
NOFL LXI H,M2  NO FLAG MSG
 JMP MFL+3
*
*
*             ARE FLAGS IN LEGAL SEQUENCE?
*
CKFL LHLD FRST
 XCHG
 LHLD LAST
 CALL CP16  COMPARE FRST TO LAST
 JNC CL1  OUT ERROR MSG
 LHLD INST
 XCHG
 LHLD FRST
 CALL CP16  COMP INST W/ FRST
 JC PKFL  SEQ OK - PACK FILE
 LHLD LAST
 CALL C61  COMP INST W/ LAST
 JNC STFL  JMP IF SEQ OK
*            OUT SEQUENCE ERROR MSGS
 LXI H,M3
ER1 CALL PRINT  OUT MSG
 CALL CRLF
 JMP STRTED  BACK TO EDITOR
CL1 LXI H,M4
 JMP ER1
*
*
*             ZERO A BYTE IN ABUF IF BLOCK
*             IS TO BE MOVED DOWN.
*
STFL SUB A
 STA ABUF+6
*
*   SET PNTRS,DELETE FLAGS AND REPACK FILE
*
PKFL LHLD BFP  GET START OF FILE ADR
 CALL FFLG  FIND A FLAG
 JNC NULS  IF END OF FILE
 PUSH H  SAVE FILE POINTER
 CPI 'I'
 JZ PL1
 CPI 'F'
 JZ PL2
 POP H  GET POINTER BACK
 SHLD LAST  STORE IN REG
 CALL DLFL  DELETE FLAG LN
 JMP PKFL+3
*
*
PL1 POP H
 SHLD INST
 SHLD FFLNP  We will return with this on the screen.
 JMP PL1-6
*
*
PL2 POP H
 SHLD FRST
 JMP PL1-6
*
*
*          IF 'NO OPERATION REQ' CONDITIONS
*          ARE FOUND RETURN TO TXT-2
*
NULS LHLD FRST
 XCHG
 LHLD LAST
 CALL CP16  ANY LINES TO MOVE?
 JZ WPAG
 LHLD INST
 XCHG
 LHLD FRST
 CALL CP16  IS INST PT NXT TO BLK
 JZ WPAG
 LHLD LAST
 CALL C61  IS INST PT NXT TO BLK
 JNZ INSTOK
 LHLD FRST
 SHLD FFLNP  We want to put FRST at top of screen.
 JMP WPAG
*
*
*             BLOCK MOV UP OR DWN?
*
INSTOK LDA ABUF+6  GET DIRECTION BYTE
 ORA A  SET FLAGS
 JNZ UP
*
*             MOVE BLOCK DOWN
*
DWN CALL TOIB  MOV FIRST LINE TO IBUF
 LHLD INST  GET ADR OF INST PT
 DCX H
 SUB A  ZERO ACC
 MOV C,A  SET END OF MOV CHR FOR LMOV
 MOV M,A  WRITE A TEMP END OF MOV CHR
*
*            D&E CONTAIN SORC ADR FOR LMOV
*
 LHLD FRST  DESTINATION ADR FOR LMOV
 CALL LMOV  CLOSE GAP - OPEN INST PT
 MVI M,0DH  CR - REPLACE TEMP CHR
*       FIRST LOC IN IBUF IS ALWAYS LINE LNTH
 LDA IBUF  GET LINE LENGTH
 CMA
 MOV E,A
 MVI D,0FFH
 INX D  LNTH IS 2'S COMP
 LHLD LAST
 DAD D  SUB LN LNTH FRM LAST
 SHLD LAST  UPDATE LAST
*  Compute start of moved block so it can be displayed
*  at the top of the screen on exit.
*
 LHLD FFLNP  At first, this is INST.
 DAD D  Subtract line length.
 SHLD FFLNP
*          COMPUTE 1ST ADR OF INST GAP
 LHLD INST
 DAD D  SUBTRACT LN LENGTH
 CALL FRIB  INSERT LINE FROM IBUF
 LHLD FRST
 XCHG
 LHLD LAST
 CALL CP16
 JNZ DWN  DO UNTIL FRST = LAST
 JMP WPAG  ALL DONE
*                  MOVE BLOCK UP
UP CALL TOIB  MOV FIRST LINE TO IBUF
 LHLD INST
 DCX H
 SUB A  ZERO ACC
 MOV C,A  SET END OF MOV CHR
 MOV M,A  WRITE CHR AT END
 LHLD FRST
 DCX H  HL POINTS TO FRST-1
 DCX D  DE POINTS TO END OF GAP
 XCHG
 CALL RMOV  CLOSE GAP - OPEN INST PT
 INX D  PNTR AT TEMP EOL CHAR
 XCHG
 MVI M,0DH  RESTORE EOL CHR
 INX H  HL = INSRT POINT
 CALL FRIB  GET LINE FROM IBUF
 LDA IBUF  GET LINE LENGTH
 MOV E,A
 MVI D,0
 LHLD INST
 DAD D  ADD LN LNTH TO INST
 SHLD INST  UPDATE INST
 LHLD FRST
 DAD D
 SHLD FRST  UPDATE FRST
 XCHG
 LHLD LAST
 CALL CP16
 JNZ UP  DO UNTIL FRST = LAST
 JMP WPAG  ALL DONE
*
*
*   THIS ROUTINE LOCATES THE LETTER FLAGS
*
FFLG MOV A,M  GET BYTE FROM FILE
 CPI 01H  EOF MARKER?
 JNZ FFLGA
 ORA A  CLEAR CARRY
 RET
*
*
FFLGA CPI 3
 JZ FG1  IF LINE 3 BYTES LONG  (CT,BYTE,CR)
 CALL ADR  ADD LNTH OF CURNT LN TO HL
 JMP FFLG  CONTINUE SEARCH
*
*
*       SEE IF 6 BYTE STRING IN MEM CONTAINS
*       FLAG LETTER FOLLOWED BY 3 SPACES
*
FG1 INX H
 MOV A,M
 CALL MAP  MAP FROM LOWER TO UPPER CASE
 INX H
 INX H
 CPI 'I'
 JZ FG2
 CPI 'F'
 JZ FG2
 CPI 'L'
 JNZ FFLG
FG2 STC .  INDICATE MATCH FOUND
 DCX H
 DCX H  POINT BACK AT THE BYTE
 DCX H  POINT TO THE COUNT
 RET
*
*
*       COMPARE D&E TO H&L.  ZERO FLAG WILL
*       BE SET IF EQUAL, CARRY SET IF H&L
*       IS LARGER, CARRY CLEARED IF HL SMALL
*
CP16 MOV A,E
 CMA
 MOV E,A
 MOV A,D
 CMA
 MOV D,A
 INX D  D&E IS 2'S COMP
C61 DAD D  SUB D&E FROM H&L
 RAR .  GET CARRY IN ACC
 MOV B,A  SAVE CARRY
 MOV A,H
 ORA L  EXERCISE ZERO FLAG
 MOV A,B
 RAL RESTORE  CARRY
 RET
*
*
*       DELETE FLAG LINE
*
DLFL PUSH H  SAVE FILE POINTER
 XCHG .  MOV BGN LN ADR TO DE
 LXI H,03H
 DAD D  COMPUTE EOL ADR
 XCHG
 MVI C,01H  END OF FILE CHAR
 CALL LMOV  PACK FILE
 SHLD EFP  UPDATE END OF FILE PTR
 MOV M,C  WRITE EOF CHR
 POP H  RESTORE FILE PTR
 RET
*    PUT LINE FROM FILE IN IBUF
TOIB LHLD FRST
 XCHG
 LXI H,IBUF  SET FILE AND BUF PTRS
TB1 MVI C,0DH  LINE TERM CHAR
 LDAX D  *MOV THE FIRST
 MOV M,A  *CHAR OF LINE
 INX D  *HERE BECAUSE IT
 INX H  *MIGHT BE '0DH'.
 CALL LMOV  MOV REST OF LINE
 MOV M,C  WRITE EOL CHR
 RET
*   MOV LINE FROM IBUF TO FILE
FRIB LXI D,IBUF  SET POINTER
 JMP TB1
*
*  Routines which were formerly in ALS-8
*
ADR ADD L  Add A to HL.
 MOV L,A
 RNC
 INR H  Add in carry.
 RET
*
*  LMOV & RMOV move characters from DE to HL until they see
*  a character which matches the one in C.  LMOV increments
*  DE and HL, while RMOV decrements them.
*
LMOV LDAX D  A is source character.
 INX D
 CMP C  Done?
 RZ
 MOV M,A  Move the character.
 INX H  Next destination.
 JMP LMOV
*
RMOV LDAX D  Same as LMOV.
 DCX D  Go backwards.
 CMP C
 RZ
 MOV M,A
 DCX H
 JMP RMOV
*
*  Compare strings of length C at HL and DE.  Returns
*  with Z set iff both strings are the same.
*
SEAR LDAX D
 CMP M
 JNZ NOMTCH  Chars didn't match.
 INX H
 INX D
 DCR C
 JNZ SEAR
 RET .  The strings matched.
NOMTCH INX D
 DCR C
 JNZ NOMTCH
 INR C  Reset zero flag.
 RET
*
ZBUF XRA A  Zeros ABUF.
 LXI D,ABUF+10H
 MVI B,10H  loop counter
ZBUF1 DCX D
 STAX D
 DCR B
 JNZ ZBUF1
 RET .  All clear.
*
*            MESSAGE AND COMPARISON TABLES
M1 ASC 'Multiple '
 DB 0
M2 ASC 'No '
 DB 0
M3 ASC 'I between F and L'
 DB 0
M4 ASC 'L before F'
 DB 0
*
*  EQUATES TO SYSTEM BUFFER
ABUF EQU CXBUF  PTDOS system buffer
INST EQU ABUF  INSERT ADR BUFFER
FRST EQU ABUF+2  FIRST LINE ADR BUF
LAST EQU ABUF+4  LAST LINE ADR BUF
IBUF EQU ABUF+16  Space for one line
*  End of block move.
*