*
*
*   SAVE
*
CSAVE CALL GFNX  GET FILE NAME
*
 LHLD BOFA
 MOV A,M
 CPI EOF  TEST FOR EMPTY PROGRAM
 JZ NPERR
*
 XRA A
 STA CRT  THERE IS NO REQUIRED TYPE YET
 MVI A,BTSCP  DEFAULT TYPE FOR CREATING
 STA CFT
*
 CALL GC  GET SAVE TYPE
 CPI CR
 JZ NEX1  TAKE DEFAULT
*
 CPI ','
 JNZ BSERR
*
 CALL GCI
 CALL GCI
 MVI B,BTTXT
 CPI 'T'  TEXT TYPE?
 JZ NEX0
 MVI B,BTSCP
 CPI 'C'  SEMI-COMPILED TYPE
 JNZ BSERR  THEN WHAT???
 MOV A,B
 STA CRT  IF SEMI-COMP. THEN TYPE IS REQUIRED
NEX0 MOV A,B
 STA CFT  WHAT TO CREATE IT AS
*
*  OPEN FILE
*
NEX1 MVI A,2  GET WRITE ACCESS
 STA CACRE
*
 MVI A,1  LAST WAS OPEN
 CALL UOPE  SETUP FOR OPEN
*
 CALL FLOPEN
 MVI A,3
 STA CEOF  LAST WAS WRITE (NOT OPEN)
 CALL CLOFCB
*
 LDA CFT  GET FILE TYPE
 CPI BTRND  CAN'T USE A RANDOM FILE
 JZ ILLT
 CPI BTSCP
 JNZ ASAVE  SAVE AS TEXT
*
*
PSAVE CALL GC
 CPI CR
 JNZ BSERR
*
 LHLD BOFA  CALC PROGRAM SIZE
 XCHG
 LHLD EOFA
 CALL DSUB
 INX H
 MOV B,H  COUNT TO BC
 MOV C,L
 LHLD BOFA  ADDRESS OF DATA TO SAVE
 XCHG .  TO DE
*
 LDA CSFID  WRITE THE PROGRAM
 CALL SYS
 DB WBLOP
 JMP DKERR
*
SAVC MVI A,3  LAST WAS WRITE
 STA CEOF
 CALL UCLZ  CLOSE (END-FILE) FILE
 JMP END1  ALL DONE
*
*
ASAVE CALL GC
 CPI CR
 JNZ BSERR
*
 LHLD BOFA
ASAV0 LXI D,IBUF
 CALL UPPL  UN-PREPROCESS LINE
 INX H  POINT TO NEXT LINE
*
 PUSH H
 MOV E,C  MOVE C TO DE
 MVI D,0
 DCX D  FORGET THE CR ON THE END
 LXI H,IBUF
 LXI B,1
 CALL FLW1I  WRITE LINE OUT AS A SINGLE ITEM
 POP H
*
 MOV A,M  TEST FOR EOF
 CPI EOF
 JNZ ASAV0  MORE TO DO
*
 JMP SAVC  CLOSE AND RETURN
*
*
*     "GET", "XEQ" AND "APPEND"
*
CXEQ MVI A,-1  SET XEQ FLAG
 STA XEQFG
 XRA A  CLEAR APPEND FLAG
 STA APPFG
 CALL FLCLA  CLOSE ALL FILES (RAND INXED BLOCKS MUST BE EJECTED)
 JMP GET1
CAPP MVI A,-1  SET APPEND FLAG
 STA APPFG
 JMP GET0
CGET XRA A  CLEAR APPEND FLAG
 STA APPFG
GET0 XRA A  CLEAR XEQ FLAG
 STA XEQFG
*
GET1 CALL GFNX  GET FILE NAME
*
 XRA A
 STA CRT  THIS MEANS TO OPEN ANY TYPE FILE
 MVI A,1  THIS MEANS IT MUST EXIST AND I WAN'T TO READ FROM IT
 STA CACRE
 CALL UOPE  SETUP FOR OPEN
 CALL FLOPEN
 CALL CLOFCB
*
 LDA CFT  WHAT TYPE DID WE GET?
 CPI BTRND
 JZ ILLT  CAN'T USE A RANDOM FILE
 CPI BTSCP  SEMI-COMP?
 JZ PGET
*
*  GET FROM A TEXT FILE
*
AGET CALL ZAPER  CLEAR VARIABLES
 LDA APPFG  APPENDING?
 ORA A
 CZ ZAPALL  NO, ERASE OLD PROGRAM
*
 LHLD TXA  SAVE WHERE WE ARE ON INPUT LINE
 PUSH H
*
AGET0 LXI D,IBUF1
 CALL FLR1I  READ ONE ITEM (ONE LINE)
 JC DKERQ  EOR ??????
 JZ GETC0  EOF, DONE
 CALL PP  PRE-PROCESS THE LINE
 JC LNERR  MUST HAVE LINE NUMBERS!!
 CALL LINE  EDIT LINE INTO PROGRAM
 JMP AGET0  MORE LINES?
*
*  GET FROM A SEMI-COMPILED FILE
*
PGET LDA APPFG  TEST FOR APPENDING REQUESTED
 ORA A
 JNZ CAERR  CAN'T APPEND FROM A SEMI-COMPILED PROGRAM FILE
*
 CALL ZAPALL  WIPE SLATE CLEAN
 LHLD BOFA
 XCHG
 LHLD MEMTOP
 CALL DSUB  HL=HL-DE  FIND MEMORY SPACE
 LXI D,1-52-LINMAX-10  SOME XTRA ROOM
 DAD D
 MOV B,H  COUNT TO BC
 MOV C,L
 LHLD BOFA  ADDR OF WHERE TO PUT IT
 XCHG .  TO DE
 LDA CSFID  FILE #
 CALL SYS
 DB RBLOP
 JMP PEOF  IT SHOULD GET AN EOF ERROR
 CALL CSCR  SORRY...
 JMP SOERR  TOO BIG, WON'T FIT
PEOF CPI EREOF  EOF?
 JNZ DKERR  NO, SOMETHING ELSE
*
 XCHG .  DE TO HL
 DCX H  POINT TO LAST BYTE STORED
 SHLD EOFA
*
 MVI A,EOF
 CMP M  ALL READ IN OK?
 JNZ BCERR  BAD SEMI-COMPILED - ERROR
 JMP GETC
*
*  RETURNS
*
GETC0 POP H  GET TXA
 SHLD TXA  RESTORE
GETC CALL UCLZ  CLOSE FILE
 CALL CCLEAR
 LDA XEQFG  TEST FOR XEQ
 ORA A
 JNZ CRUN  RUN THE PROGRAM (Z MUST BE 1 FOR CRUNX)
 JMP END1  ALL DONE
*
*
*     KILL COMMAND
*
CKILL CALL GFNX  GET FILE NAME
 CALL GC  SYNTAX
 CPI CR
 JNZ BSERR
 CALL FLKIL
 ORA A  ANY ERROR?
 JZ END1  NO ERROR
 JMP DKERR  SOME ERROR IN ACCA
*
*
*     CATALOG COMMAND
*
CCAT LHLD STA  FIND SOME SPACE
 LXI D,512H+1
 DAD D
 CALL STOV
*
 LHLD SYSGLO  FIND DEFAULT UNIT
 LXI D,GLUNI
 DAD D
 MOV A,M
 LHLD STA  FOR UCAT
 MOV M,A
 ADI '0'  FOR THE HEADING
 STA CATMU
*
CAT0 CALL GCI  GET PARAMATERS
 CPI ','
 JZ CAT0
 CPI CR
 JZ CAT1
*
 CPI '/'  UNIT?
 JNZ CAT2
 CALL DIG  GET A DIGIT
 JC BSERR
 STA CATMU  FOR HEADING
 LHLD STA
 SUI '0'
 MOV M,A  FOR UCAT
 JMP CAT0
*
CAT1 MVI A,'C'
CAT2 LXI H,CATTB  ADDR OF TYPE TABLE
 CPI 'A'+32
 JC CAT3
 SUI 32  UPSHIFT!
CAT3 MOV B,M  SEARCH TABLE FOR THE TYPE IN ACCA
 DCR B  EOT?
 JZ BSERR  YES, UNKNOWN TYPE
 INX H
 MOV C,M  THE FILE TYPE
 INX H
 CMP B  FOUND IT?
 JNZ CAT3  NO, SEARCH
*
 STA CATMT  FOR HEADING
 MOV A,C  THE TYPE
 LHLD STA  ADDR OF CAT BUFFER
 CALL UTIL
 DB UCAT
 JMP DKERR
 ORA A
 RZ .  NO ENTRIES
*
 STA XA  NUM OF ENTRIES
 CALL CRLF  PRINT HEADING
 CALL CRLF
 LXI H,CATM
 CALL PRNT
 CALL CRLF
*
 MVI C,8  NAME FIELD SIZE
 MOV B,C  ZERO OUT LOW BITS OF B
 LHLD STA
 INX H  POINT TO FIRST ENTRY
 MVI D,2
*
CAT4 MOV A,M
 INX H
 ORA A  CNVT 0'S TO SPACES
 JNZ CAT5
 MVI A,' '
CAT5 CALL CATP
 DCR C  DONE WITH NAME?
 JNZ CAT4
*
 DCR D  SECOND PART?
 JZ CAT6  NO, ALL DONE WITH THIS ENTRY
*
 MVI A,' '
 CALL CATP
 MVI C,3  SIZE OF SIZE FIELD
 JMP CAT4
*
CAT6 INR B  ENTRIES-PER-LINE COUNTER
 MVI A,4
 ANA B
 JZ CAT7  NO CRLF YET
 PUSH H
 MVI B,0
 PUSH B
 CALL CRLF
 CALL PCHECK  CHECK FOR ESCAPE AND SPEED CTRL
 POP B
 POP H
 JMP CAT8
*
CAT7 MVI A,' '
 CALL CATP
 CALL CATP
 CALL CATP
 CALL CATP
*
CAT8 LDA XA
 DCR A  LESS ON ENTRY
 STA XA
 INX H  SKIP STUFF WE DON'T USE
 MVI C,8
 MVI D,2
 JNZ CAT4  IF XA NOT 0 THEN MORE TO DO
*
 CALL CCRLF  ALL DONE
 CALL CRLF
 CALL CRLF
 JMP END1
*
*
CATP PUSH H
 PUSH D
 PUSH B
 PUSH PSW
 MOV B,A
 CALL CHOUT
 POP PSW
 POP B
 POP D
 POP H
 RET
*
*
*     LOAD COMMAND
*
*  OPEN FILE
*
CLOAD CALL GFNX  GET FILE NAME
 MVI A,2  LAST WAS READ
 CALL UOPE  SETUP FOR OPEN
 LDA OPEF
 INR A
 STA OPEF
*
 LHLD OPEBU
 LXI D,CFN
 CALL SYS
 DB OPEOP
 JMP DKERR
*
 STA CSFID
 MOV A,B  CHECK TYPE
 ANI 80H  IMAGE ?
 JNZ ILLT  NO, ILL TYPE
 CALL CLOFCB
*
*  LOOP TO READ BLOCKS OF STUFF IN
*
LOAD0 LDA CSFID
 LXI B,4
 LXI D,CFN
 CALL SYS  READ BLOCK HEADER
 DB RBLOP
 JMP LOADE
*
 LHLD CFN
 MOV B,H
 MOV C,L  BLOCK SIZE TO BC
 LHLD CFN+2  ADDRESS
 XCHG .  TO DE
*
 LHLD FBLK  ADDR OF FIRST BLOCK
 MOV A,H
 ORA L
 JNZ LOD00
 XCHG
 SHLD FBLK
 XCHG
*
LOD00 MOV A,B
 ORA C
 JZ LOAD2  COUNT ZERO, ADDRESS IS START ADDRESS
*
*  MEMORY PROTECT?
*
 LHLD MEMTOP
 INX H  CAN'T BE EQU TO MEMTOP
 CALL HDCMP
 JNC MPERR  DE MUST BE >= MEMTOP+1
*
*  READ BLOCK
*
 LDA CSFID
 CALL SYS
 DB RBLOP
 JMP DKERR
 JMP LOAD0  MORE BLOCKS?
*
*  END OF LOAD
*
LOADE CPI EREOF
 JNZ DKERR
 LHLD CFN  WHAT WAS READ
 MOV A,C
 CPI 2
 JZ LOAD2  ONLY AN ADDRESS WAS READ, USE IT
 LHLD FBLK  THE FIRST BLOCK LOADED
*
LOAD2 PUSH H  ADDR OF IT
 CALL UCLZ  DONE WITH FILE, CLOSE IT
 CALL SCOMA
 POP H  THE FIRST-BLOCK/START ADDRESS
 RC .  NO COMMA, RETURN
 CALL FLOAT  PUT ADDR OF IT ON STACK IN BCD
 CALL VAR
 JZ TYERR
 XCHG .  ADDR OF VAR TO DE
 JMP POPA1  ADDR TO VAR AND RETURN
*
*
*   COMMAND UTILITIES
*
UOPE LXI H,OFT  USE FIRST FCB FOR THIS FILE
 SHLD OFCB
 STA CEOF  LAST WAS ...
 STA CUFID  IN CASE OF AN ERROR
 LXI H,04C0H  BLOCK SIZE FOR GET/SAVE
 SHLD CBLKS
 XRA A
 STA RF  NOT RANDOM
 STA SF  AND NOT SPACED
 RET
*
*
UCLZ CALL FLCLZ  CLOSE AND MABY END-FILE
 JMP CLOFCB  FCB --> NO-LONGER OPEN
*
*
*    RAM STORAGE
*
XEQFG DB 0  XEQ-AFTER-LOAD FLAG
APPFG DB 0  APPENDING FLAG
FBLK  DW 0  FIRST BLOCK ADDRESS
*
CATM  ASC 'TYPE '
CATMT ASC ' '
      ASC ' FILES ON UNIT '
CATMU ASC ' "'
*
CATTB DB  'C'+1
      DB  BTSCP
      DB  'T'+1
      DB  BTTXT
      DB  'S'+1
      DB  BTSER
      DB  'R'+1
      DB  BTRND
      DB  'M'+1
      DB  BTMAT
      DB  1  EOT
*
*