 TITL PTDOS  2.00
 PAGE
 ASCF 0  NO EXTENDED ASCII
 IFLS .  LIST THE IF'S TOO
*
*
*
*
*
*
*
*
*                               PTDOS v2.00
*
*                       FLOPPY DISK OPERATING SYSTEM
*
*
*
*     COPYRIGHT 1978 BY:
*
*                        PROCESSOR TECHNOLOGY CORP.
*                        7100 JOHNSON INDUSTRIAL DRIVE
*                        PLEASANTON, CALIF   94566
*
*                       <<  ALL RIGHTS RESERVED  >>
*
*
*    DESIGNED AND WRITTEN BY:  PHILIP LEVY
*
***********************************************************
 PAGE
*
*
*
*          THE FOLLOWING DEFINE THE SYSTEM CONFIGURATION
*
*
*
*                  CONFIGURATION PARAMETERS
*
*********************
*
*   SYSTEM OPERATIONS
*
CREOP EQU 0  CREATE FILE
OPEOP EQU 1  OPEN FILE
KILOP EQU 2  DELETE FILE
RBLOP EQU 3  READ BLOCK
WBLOP EQU 4  WRITE BLOCK
SPAOP EQU 5  SPACE
EOFOP EQU 6  ENDFILE
CLOOP EQU 7  CLOSE FILE
CHTOP EQU 8  CHANGE TYPE
CHAOP EQU 9  CHANGE ATTRIBUTES
CHNOP EQU 10  CHANGE NAME
INFOP EQU 11  INFORMATION REQUEST
SUNOP EQU 12  SET DISK UNIT
RETOP EQU 13  RETURN TO CI
RESOP EQU 14  RESET, THEN RETURN TO CI
ABTOP EQU 15  ABORT, THEN RETURN TO CI
SEKOP EQU 16  SEEK OPERATION
RNDOP EQU 17  RANDOMIZE
CAOP EQU 18  CLOSE ALL/UNIT
CTLOP EQU 19  FILE CONTROL/STATUS
SREST EQU 20  SHORT RESET TO CI
DRDOP EQU 21  DELIMITED READ
DWROP EQU 22  DELIMITED WRITE
DSPOP EQU 23  DELIMITED SPACE OPERATION
RTROP EQU 24  RETURN WITH TRAP OPERAITON
*
MAXOP EQU RTROP  MAX OPERATION
*
*
*********************
*
*    ERROR NUMBERS
*
*
*  THESE ARE THE CORRECT ERROR NUMBERS
*
ERNEX EQU 1  NONEXISTENT FILE
ERAEX EQU ERNEX+1  FILE ALREADY EXISTS
ERUFN EQU ERAEX+1  UNASSIGNED FILE NUMBER
ERPRO EQU ERUFN+1  PROTECTION VIOLATION
ERNIF EQU ERPRO+1  FILE NOT TYPE IMAGE
ERMOP EQU ERNIF+1  ILLEGAL OPERATION ON MUDTIPLY OPEN FILE
ERRAC EQU ERMOP+1  RANDOM ACCESS TO NON-RANDON FILE
ERRDV EQU ERRAC+1  RANDOM ACCESS TO DEVICE FILE
ERZBC EQU ERRDV+1  EMPTY DEVICE FILE
*
ERIOP EQU ERZBC+1  ILLEGAL PTDOS OPERATION
ERIBF EQU ERIOP+1  ILLEGAL BUFFER ADDRESS
ERIBS EQU ERIBF+1  ILLEGAL BLOCK SIZE
ERINM EQU ERIBS+1  ILLEGAL CHARACTER IN NAME
ERICU EQU ERINM+1  ILLEGAL CHARACTER IN UNIT
ERIUN EQU ERICU+1  ILLEGAL UNIT
ERNTL EQU ERIUN+1  NAME TOO LONG
ERMEM EQU ERNTL+1  USER MEMORY PROTECT VIOLATION
ERSMP EQU ERMEM+1  SYSTEM MEMORY PROTECT VIOLATION
ERUCN EQU ERSMP+1  UNIT CONFLICT
ERIUP EQU ERUCN+1  ILLEGAL UTILITY OPERATION
ERDRI EQU ERIUP+1  DRIVER ERROR
ERIDA EQU ERDRI+1  ILLEGAL DRIVER ACCESS
ERNCT EQU ERIDA+1  DRIVER NOT PARTICIPATING IN THIS CTRL
*                                      OPERATION
*
EREOF EQU 24  END OF FILE ENCOUNTERED (OR BOF)
ERSEK EQU EREOF+1  SEEK ADDRESS OUT OF RANGE
*
ERTOP EQU ERSEK+1  TOO MANY FILES OPEN
ERMOV EQU ERTOP+1  MEMORY OVERFLOW
ERNID EQU ERMOV+1  NO FILE ID'S LEFT
ERDFL EQU ERNID+1  DISK FULL
ERDIR EQU ERDFL+1  DIRECTORY FULL
ERBLF EQU ERDIR+1  BAD LOAD FILE
*
*
ERFSB EQU 32  FILE STRUCTURE BAD
ERFIC EQU ERFSB+1  FILE ID CONFLICT
ERBSC EQU ERFIC+1  BLOCK SIZE CONFLICT
ERSCC EQU ERBSC+1  SECTOR CONFLICT
ERCFS EQU ERSCC+1  CAN'T FIND SECTOR
ERCRC EQU ERCFS+1  CRC ERROR OR READ/WRITE ABORTS
ERCFT EQU ERCRC+1  CAN'T FIND TRACK
ERRBC EQU ERCFT+1  READ-BACK-CHECK FAILED
ERLOK EQU ERRBC+1  DISK IS WRITE LOCKED
ERXXX EQU ERLOK+1  CATESTROPHIC ERROR
*
*
ERRED EQU 39H  DRIVE NOT READY
*
**
*  THESE ARE THE OLD SYMBOLS,WHICH ARE STILL USED HERE
*
SERR0 EQU ERRAC  - FILE NOT INDEXED
SERR2 EQU ERSEK  - SEEK ADDR OUT OF RANGE
RERR0 EQU ERRDV  - RANDOM OP ON DEVICE FILE
*
CER0 EQU ERAEX  - FILE ALREADY EXISTS
CER1 EQU ERDIR  - DIRECTORY FULL
DER0 EQU ERNEX  - NONEXISTENT FILE
DER1 EQU ERMOP  - ATTEMPT TO KILL OR EOF MULTIPLY OPEN FILE
OER1 EQU ERIBF  - ILLEGAL BUFFER ADDRESS
PER0 EQU ERPRO  - PROTECT VIOLATION
EER0 EQU EREOF  - END OF FILE
FINE0 EQU ERNEX  - FILE DOES NOT EXIST
FINE1 EQU ERPRO  - PROTECTION
FER0 EQU ERTOP  - NO FCBS AVAILABLE
MER0 EQU ERMOV  - MEMORY OVERFLOW
PER1 EQU ERUFN  - ILLEGAL FCB
IER0 EQU ERNID  - NO IDS LEFT
FBER EQU ERFSB  - FS BAD
CHER EQU ERPRO  - ALTERATION PROTECTED
CIER0 EQU ERBLF  - BAD LOAD FILE
CIER1 EQU ERNIF  - NOT IMAGE FILE
*
*
DAER0 EQU ERDFL  - DISC IS FULL
DAER1 EQU ERIBS  - ILLEGAL BLOCK SIZE
DVER0 EQU ERDRI  - DRIVER ERROR
IDAER EQU ERIDA  - ILLEGAL DRIVER ACCESS
ILOER EQU ERIOP  - ILLEGAL OPERATION
UNER0 EQU ERIUN  - ILLEGAL UNIT
LDE2 EQU ERZBC  - BAD DRIVER--ZERO
UTE0 EQU ERIUP  - BAD UTILITY OPERATION
*
MPE0 EQU ERMEM  - MEMORY PROTECT
MPE1 EQU ERSMP  - SYSTEM MEMORY PROTECT
CHR2 EQU ERUCN  - UNIT CONFLICT
ICE0 EQU ERINM  - ILLEGAL CHARACTER IN NAME
ICE1 EQU ERICU  - ILLEGAL CHARACTER IN UNIT
CSER0 EQU ERXXX  - CATESTROPHIC ERROR
*
*
*********************
*
*  DRIVER TYPE/STATUS BITS
*
SBDUP EQU 128  DUPLICATIVE
SBIAT EQU 64  INTERACTIVE
SBTAB EQU 32  TABBING
SBSTB EQU 16  SET TABS
SBFF  EQU 8  FORM-FEED
SBATB EQU 4  ABSOLUTE TABS
SBINT EQU 2  INTERRUPT DRIVEN
SBPRO EQU 1  SETTABLE PROMPT
*
*********************
*
*   SECONDARY OPERATIONS
*
UXOP EQU 0  EXPLAIN ERROR NICELY
UXOP1 EQU 1  SECOND LEVEL
*
CCLDE EQU 32  LOADER OPERATION CODE
*
*
*********************
*
*
*
*             SYSTEM FILE INFORMATION
*
*
*   DIRECTORY INFORMATION
*
IDDIR EQU 2    DIRECTORY FILE ID
DIRDB EQU 200  FIRST BLOCK OF DISK DIRECTORY
*
NMLEN EQU 8    NAME LENGTH
DREMS EQU 24   MAX ENTRIES PER SECTOR
DICNT EQU 8    NUMBER OF DIRECTORY SECTORS
*
*
*   SYSTEM GLOBAL FILE
*
DASPB EQU 6    FIRST BLOCK OF SYSTEM GLOBAL
IDSPA EQU 5    FILE ID
*
*
*   SYSTEM RESIDENT
*
DAREB EQU 8    FIRST SECTOR OF RESIDENT
IDRES EQU 4    FILE ID
D2REB EQU 16   SECOND SECTION OF RESIDENT
*
*
*   FSM (FREE SPACE MAP) INFORMATION
*
IDFSM EQU 1    FSM FILE ID
DAFSB EQU 208  BLOCK # OF FSM (TRACK 26)
*
*
*   NEXT FILE ID FILE INFORMATION
*
IDNID EQU 3    NEXT ID FILE ID
DANIB EQU 209  BLOCK OF NEXT ID FILE
NIDBC EQU 2    BYTE COUNT OF BLOCK
*
*
*   BOOTSTRAP FILE
*
DABOS EQU 0  ST ADDR OF DISK BLOCK # ( must never change)
IDBOT EQU 6  FILE ID
*
*********************
*
*           HEADER VALUES ETC
*
*
*   SECTOR SIZES
*
SECTSZ EQU  500
FULSZ EQU  512   # DATA BYTES IN FOLLOWING BLOCKS
*
*
*   FILE STRUCTURE LINKAGE VALUES
*
BOFCD EQU 65535  BOF CODE IN BACK POINTER
EOFCD EQU 32768  EOF BIT IN FORE POINTER
*
*
*   FILE PROTECTION ATTRIBUTE BITS
*
PDEL EQU 1  DELETE PROTECT
PWRI EQU 2  WRITE PROTECT
PREA EQU 4  READ PROTECT
PFINF EQU 8  INFORMATION PROTECT
PATR EQU 16  ATTRIBUTE CHANGE PROTECT
PNAT EQU 32  NAME AND TYPE CHANGE PROTECT
PALO EQU 64  ALLOCATION PROTECTION
*
*
*   DEFINE FILE TYPES
*
SYSIM EQU 00H  SYSTEM IMAGE TYPE --(I00)
BNTYP EQU 80H  BINARY DATA FILE --(00)
UTTYP EQU 01H  UTILITY TYPE
*
IMTYPE EQU 80H  IMAGE FILE MASK (OFF IS IMAGE!!)
*
*
*******************************************
*
*
*             DRIVER TABLE STRUCTURE
*
*   THESE ARE DISPLACEMENTS INTO A DRIVER
*
DTRB EQU 0  READ BLOCK
DTRNB EQU 2  READ NEXT BLOCK
DTRLB EQU 4  READ LAST BLOCK
DTWBR EQU 6  WRITE BLOCK: LOAD NEXT
DTWB EQU 8  WRITE BLOCK
DTREW EQU 10  REWIND
DTEOF EQU 12  END-FILE
DTCLO EQU 14  CLOSE
DTSEK EQU 16  SEEK
DTCTL EQU 18  CONTROL/STATUS
DTBLK EQU 20  BLOCK SIZE
DTITO EQU 22  IMMEDIATE TRANSFER OPTION
DTINI EQU 23  INITIALIZE ENTRY POINT
*
 PAGE
*
*
*******************************************
*
*
*                 SYSTEM GLOBAL AREA STUFF
*
*
*   MEMORY AREA
*
MINMA EQU 08800H  LOWEST MEMORY ADDRESS
LNMBF EQU 0FB8H   LENGTH OF MAIN BUFFER AREA  (4024)
FCB0 EQU MINMA+LNMBF  START OF FCB AREA
XFER EQU 0F016H  DISK ROUTINE
*
*
*   FILE CONTROL BLOCKS
*
MAXFCB EQU 8  MAX. NUMBER OF OPEN FILES
MINFCB EQU 5  MIN. NUMBER OF FILE CONTROL BLOCKS
LNFCB  EQU 34 LENGTH OF FCB. MUST AGREE WITH LAYOUT !!!!!!
FCBLN  EQU LNFCB*MAXFCB  LENGTH OF FCB AREA
*
*   FCB SIZE DEFINED LITERALLY <<-------------< WARNING
*
*
*   DEFINE SYSTEM STACK
*
BOTSK EQU FCB0+FCBLN  MAX TOP OF STACK ADDRESS
STKSZ EQU 60  STACK SIZE
TOPSK EQU BOTSK+STKSZ  BOTTOM OF STACK (INITIAL TOP)
*
*   INITIAL ELEMENTS IN THE STACK ALWAYS LOOK LIKE THIS
*
UHL EQU TOPSK-2  USER HL
UL EQU UHL  USER L
UH EQU UHL+1  USER H
UD EQU TOPSK-3  USER D
UE EQU TOPSK-4  USER E
UDE EQU UE
UB EQU TOPSK-5  USER B
UC EQU TOPSK-6  USER C
UBC EQU UC
UA EQU TOPSK-7  USER A
UPSW EQU TOPSK-8  USER PSW
UTOS EQU TOPSK-10  USER SP
*
 PAGE
*
*
*******************************************
*
*
*
*
*
*                SYSTEM GLOBAL AREA
*
 ORG TOPSK
*
SGAREA EQU $  BEGINNING OF THE SYSTEM GLOBAL AREA
SP1 EQU -MINFCB*LNFCB+SGAREA  LOAD ADDRESS FOR SYSGLOBL
MASPA EQU SP1  SAME
*
*
*
*   THE FOLLOWING PARAMETERS ARE AVAILABLE TO THE USER
*   THROUGH THE POINTER IN THE ENTRY POINT AREA.
*
*
*  DEFAULT FILE NUMBERS
*
CIFILE DB 0  C/I INPUT FILE
COFILE DB 1  C/I OUTPUT FILE
UTIL DB 2  DEFAULT UTILITY FILE =2
ECFILE DB 1  ECHO OUTPUT FILE
*
*   DO NOT CHANGE THE ORDER OR POSITION OF THE ABOVE FOUR
*   PARAMETERS UNDER ANY CIRCUMSTANCES!!!!
*
DUNIT DB 0  DEFAULT DISK DRIVE AND UNIT
SYSFIL DB 3  NUMBER OF SYSTEM FILES CONFIGURED
MAXUN DB 2  NUMBER OF DRIVES+1 CONFIGURED
*
SWITCHS DB 0  BITS FOR ON OFF
 DB 0  USER SENSE SWITCHES
*
*
*   ERROR HANDLING
*
EERR DW -1  EOF-BOF ERRORS
AERR DW 0  ABORTIVE ERRORS
FERR DW 0  FATAL, SERIOUS ERRORS
*
*
*   MISC.
*
CRTRAP DW -1  C/I TRAP RETURN
UPROT DW 0  USER MEMORY PROTECT
*
STFLG DB 0  EXTRA CHARACTER WAITING ON CONIN FLAG
INBYT DB 0  THE SAID EXTRA CHARACTER
*
*   CI READ/WRITE/TEST POINTERS
*
RCH DW CIRCH  READ CONSOLE
WCH DW CIVDM  WRITE CONSOLE
SCH DW CITCH  TEST CONSOLE
*
NULLS DB 0  NUMBER OF NULLS TO FOLLOW CR
*
*
*
*         CONFIGURATION INFORMATION
*
*   SYSTEM VERSION
*
 DB 52H  SYS VERSION 2.0.2
 DB 01H  MONTH MM
 DB 01H  DATE DD
 DB 88H  YEAR YY
*
 ASC 'PTDOS2.0'  DISK NAME
*
 ASC 'PTDOS'  PASSWORD
 DW 0  (8 CHARS, ZERO FILL)
 DB 0
*
*
*   INTERRUPT STUFF
*
BDSK1 DW -1  STANDARD RETURN INTERRUPT ADDRESS
BDSK2 DW -1  FAST " " " " " "
IFLG1 DB 0  FLAG TO RE-ENABLE INTERRUPTS
IFLG2 DB 0  DISK DONE FLAG FOR INT HANDLER
*
*
*   MEMORY CONFIGURATION
*
LOWAD DW MINMA  MINIMUM AVAILABLE LOCATION
*
*
*   SYSTEM SWITCH FLAGS
*
SWECH DB 0  ECHO ENABLE
SWLOK DB 0  DISK WRITE LOCK
SWUPS DB 0  UPSHIFT ASCII
SWRBC DB 0  DISK READ-BACK-CHECK AFTER WRITE
SWBIO DB 0  BINARY I/O ON CONSOLE
SWLOG DB 0  LOG FILE FOR CI ECHO FLAG
SWVRB DB 1  VERBOSE DISABLE
SWFTR DB 0  FUTURE (I.E. ISN'T 8 A NICE NUMBER)
*
*
*   LEAVE SOME ROOM FOR FUTURE JUNK
*
GLVDC DW PCRCK  SET SCREEN LINE ADDRESS
 DW -1
*
 PAGE
*
*
*
*
*
*  /////  THE PARAMETERS BELOW ARE DEFINED FOR SYSTEM  ////
* /////  USE FROM SYSGLO.  DO NOT CHANGE THEIR LOCATION ///
*
*
*             FCB AREA PARAMETERS
*
HIGHA DW MAXFCB*LNFCB+FCB0  TOP AVAILABLE LOCATION
MINAD DW FCB0-BUFT-BUFT2  MINIMUM BUFFER ALLOCATED SO FAR
FCBASE DW FCB0  FIRST FCB ADDRESS
NFCB DB MAXFCB  NUMBER OF FCBS
*
CRSEEN DB 0  CR FLAG FOR TTY DRIVER
TDPRO DW CIMSG  CI TTY PROMPT MESSAGE POINTER
FRADD DW 0  FCB RESTORATION ADDRESS
*
*
*
*
 PAGE
*
*
*******************************************
*
*
*                <  PARAMETER CONVERTER  >
*                  ASCII:<BASE> - BINARY
*
*   VERSION 1.1   OCT. 25, 1976   S. DOMPIER
*
*   CALLING SEQUENCE:
*   reg HL has ASCII value string address
*   terminated by a binary zero.
*
*   PCONA:  reg B has alpha base chr
*   PCONB:  reg B has binary base
*
* max parameter values:  FFFF<:H>   65535:D
*          1111 1111 1111 1111:B   177777:Q
*
* alpha base notation:   B = binary
*                        O = octal
*                        Q = octal
*                        D = decimal
*                        H = hexidecimal
*
*
PCONA LXI D,PBTBL-1  base table
 XCHG
 MVI C,6  table entry count+1
 MOV A,B  get base chr
*
CBASE DCR C
 JZ ZRET  illegal base chr
 INX H
 CMP M
 INX H  point to next base chr/value
 JNZ CBASE
 MOV B,M  get binary base value
 XCHG
*
*   convert base-n digits to binary
*
PCONB MOV A,B  get base
 STA PBASE  save base
 PUSH H  save input buffer address
 LXI D,0  initialize total
*
CNUM2 LDA PBASE  get base
 MOV B,A
 POP H
 MOV A,M  get chr
 ORA A  binary zero?
 RZ .  yes, we are done
*
 INX H
 PUSH H  save CBUF pointer
 SUI 30H  strip ascii bias
 CPI 10  >10?
 JC CNUM3
 ANI 0DFH  upshift, if necessary
 SUI 7  strip alpha bias
 CPI 10H  illegal chr? > "F"
 JNC ZRET
 CPI 10
 JC ZRET
*
CNUM3 MOV C,A  save number
 SUB B  subtract base
 JP ZRET  not legal in base
 LXI H,0  clear temp total
 CALL MULT  total * base
 MVI B,1  one pass
 MVI D,0
 MOV E,C
 CALL MULT  add digit
 XCHG
 JMP CNUM2  get next digit
*
*
*   multilpy  DE*B
*
MULT INR B
MULT2 DCR B
 RZ .  done ~.~.~.~.~.~ EXIT ~.~.~.~.~
 DAD D
 JNC MULT2  continue if no overflow
 JMP ZRET  > 64K error
*
*
*   alpha base table
*
PBTBL DW 242H  'B' binary
 DW 84FH  'O' octal
 DW 851H  'Q' octal
 DW 0A44H  'D' decimal
 DW 1048H  'H' hexidecimal
*
*
MAXIN EQU 20  maximum chr input count
*
*
*    THIS IS THE REST OF PSCAN FROM PAGE "B" UP TOP
*
*   error returns
*
ERRET CALL PREAD  set-up error return address
ZRET XRA A  zero reg A = field error
ERET STC .  set carry = error
 MOV E,A  error number to reg E
 JMP PNR2
*
*
PREAD CPI 0D5H  ascii in HL from base in B?
 LHLD UIBUF  -> USER INPUT
 JNZ PR2  nope
 CALL PCONB  convert value; returns DE
 JMP PNR1  normal return
*
*
PR2 ANI 20H  one chr only?
 JZ R1  no
 CALL G1  get one chr from CI or user buffer
 STA LC
 JMP PNR1  go home
*
*
*   read chrs into OUBUF
*
R1 MVI C,0
 LHLD UOBUF
R2 CALL GETCH  get chr
 JZ STOP  done, found delimiter ,/;/cr
 MOV M,A  store chr in UOBUF
 INX H
 INR C  update chr count
 MVI A,MAXIN  maximum input count
 SUB C
 RZ .  to many chrs
 JMP R2  get next chr
*
*
*   get input character
*      RETURN IN A,  ZERO IF DELIMITER
*
GETCH PUSH H  save output pointer
GETC2 CALL G1
 CPI ' '  skip spaces
 JZ GETC2
 MOV L,A  SAVE CHR IN L
 LDA OPT
 ANI 88H
 ADD A  SET CARRY AND ZERO FLAGS FOR JUMPS BELOW
 MOV A,L  RESTOR CHR
 POP H
 JNZ DLTEST  SKIP ALL BUT NORMAL DELIMITERS
 JC DLMTST  VALUE OP, SKIP NO DELIMITERS
 JMP DLTST  NAME OP, SKIP ALL BUT NAME DELIMITERS
*
*
G1 LDA OPT
 ANI 40H  user input buffer?
 JNZ G2  yes
 LDA CIFILE  get cifile number from DOS
 PUSH B
 CALL RB  read one byte from cifile
 JMP ERET
 POP B
 RET
*
*
G2 LHLD UIBUF  get user input buffer pointer
 MOV A,M
 INX H
 SHLD UIBUF
 RET
*
*
STOP MVI M,0  set stop byte (last UOBUF chr),
 MOV L,C  stops scan in PCON or puts 0
 MOV H,A  after name
 SHLD CCLC  save chr count and last chr scanned
 MOV A,C
 ORA A  any characters?
 JZ PNRET  nope, its a default field
 LHLD UOBUF  get name/scratch buffer pointer
 LDA OPT  get options
 MOV B,A
 ANI 8  CHECK IF READ ALL CHRS TO NORMAL,
 JNZ PNRET  RETURN CHR - , ; cr 0
 MOV A,B
 RAL .  name?
 JNC NAME
*
* VALUE FIELD
*
 DCX H
 MVI B,'H'  set hexidecimal base default
*
V2 INX H
 MOV A,M
 ORA A
 JZ V3  if binary zero, field is finished
 SUI ':'  base?
 JNZ V2  no, look for ':' or binary zero
 MOV M,A  set binary zero in place of ':'
 INX H
 MOV B,M  get base chr
 INX H
 CMP M  better be zero!
 RNZ .  error, only one base chr allowed.
*
V3 LHLD UOBUF  point to value string
 CALL PCONA  convert ascii string to binary
 POP H
 RET .  normal return, value in DE
*
*
*   NAME FIELD
*
NAME LDA LC  GET LAST CHR SCANNED
 CALL DLTEST  CHECK IF , ; cr 0
 MVI A,-1  REG E = -1 ON RETURN,
 JNZ NOPEN  FILE NOT CREATED OR OPENED
*
 MOV A,M  GET FIRST NAME CHR
 CPI '#'  file number?
 LXI B,0A00H  SET C=0 & BINARY BASE = 10
 JNZ N1  NOPE
 INX H
 CALL PCONB  CONVERT FILE NUMBER TO BINARY
 POP H  CLEAR STACK FOR NORMAL RETURN
 RET
*
*
N1 LDA OPT  GET OPTIONS
 ORA C  ADD IN POSSIBLE SUPPRESS CREATE FROM OPEN
 RAR .  suppress create?
 LHLD UOBUF  POINT TO NAME
 JC POPEN  yes
 LXI D,-4  POINT TO TYPE (CREATE BLOCK)
 DAD D
 XCHG
 CALL SYS
 DB CREOP  create file
 JMP CREER  something wrong
CRNR MVI C,1  set suppress create
 JMP N1  now attempt to open file
*
*
CREER CPI ERAEX  existing file?
 JNZ ERET  no, something else wrong
 LDA OPT  get options
 ANI 2  . force create?
 JZ CRNR  no, open file
 MVI A,ERAEX  yes; and,
 JMP ERET  set existing file error.
*
*
*   OPEN, DE HAS UOBUF WITH NAME
*
POPEN LXI D,0  clear value/ set static buffer
 RAR .  suppress open?
 RAR
 JC PNRET  yes, return
 XCHG .  name pointer to DE,
 CALL SYS  static buffer to HL.
 DB OPEOP  open named file
 JMP ERET  opps!
*
*
NOPEN MOV E,A  save file number OR -1
 MVI D,0  clear reg D
 POP H  return, with file number in E
 RET
*
*
*
*
*   LAST WORD LOADED
*
 DB 0  THIS BYTE IT A SPARE
*
SP2 EQU $-1
LNSPA EQU SP2-SP1+1  LENGTH OF SYSGLOBL (DO NOT CHANGE)
*
*   *** WARNING, MAX = 380H   (ELSE MOVE SYS GLO AREA) ***
*
*
 PAGE
*
*
*******************************************
*
*
*
*            TEMPORARY STORAGE AREA
*
*
OPER RES 1  DOS OPERATION
*
*   DIRECTORY SEARCH PARAMETERS
*
DFC  RES 2  FREE DIRECTORY ENTRY ADDRESS
DBUF RES 2  DIRECTORY ENTRY POINTER
DCNT RES 1  DIRECTORY ENTRY COUNTER
DRID RES 2  FILE ID TO SEARCH FOR
*
TBUFA RES 2  TRUE BUFFER ADDRESS (USED ALL OVER)
*
DISA RES 2  DISPATCH ADDRESS (SYS)
*
AFBT1 RES 1  BLOCKS REQUIRED
AFBT3 RES 2  TRACK MAP POINTER
AFBT4 RES 2  START SECTOR (BLOCK#)
AFBT6 RES 2  PBUF POINTER
*
DABT1 RES 2  BUFFER ADDRESS
DABT2 RES 2  BUFFER SIZE
DABT3 RES 1  FCB COUNTER
*
*
WBUFSZ RES 2  AUTO DEALLOCATION
WBUFAD RES 2
*
SFCT1 RES 1  COUNT FOUND
SFCT2 RES 1  FCB COUNTER
*
LNKT1 RES 2  CURRENT BLOCK #
LNKT2 RES 2  BACK POINTER
*
*
SOU RES 2  SOURCE (RWP)
DEST RES 2  DESTINATION
RWF RES 1  READ/WRITE FLAG
LCNT RES 2  LOCAL COUNT
DELFG RES 1  DELIMITER FLAG (0=>NONE,-1=>SEARCHING,1=>FND)
*
ETMP RES 2  FOR EOF
ECRS RES 2  LAST BLOCK
CLCNT EQU SOU  CLOSE ALL FCB COUNTER
RINAD RES 2  RANDOM INDEX ADDRESS (IN MEMORY)
*
LSECT RES 2  LAST BLOCK ADDRESS (DDRNB)
*
RFBCN RES 1  COUNT, (RFBLK)
RFBC1 RES 1  COUNT, (RFBLK)
*
*
XA RES 1  A FOR UTIL AND CI
XHL RES 2  HL FOR UTIL
XOPER RES 1  OPER FOR UTIL
*
RNPTR RES 2  RANDOM INDEX POINTER
RNCNT RES 1  ENTRY COUNT
CICNT RES 1  COUNTER (CI)
CPNT RES 2  POINTER (CI)
CECT EQU CPNT  ECHO COUNT (CI)
CERC EQU CICNT  LINE POSITION (CI)
FRAD2 RES 2  FOR OPEN
XQFLG RES 1  EXECUTE FLAG FOR CI
CONCH RES 1  CHARACTER READ BY CONIN OR CONOUT
*
*
*   PSCAN TEMPORARIES
*
PBASE DS 1  BASE CHARACTER
OPT DS 1  OPTIONS
UOBUF DS 2  USER OUTPUT BUFFER POINTER
UIBUF DS 2  USER INPUT BUFFER POINTER
CCLC EQU $  CHAR CT/LAST CHAR
CC DS 1  CHARACTER COUNT
LC DS 1  LAST CHARACTER
ERSWC DS 2  AERR SAVE AREA
RSTK DS 2  RETURN ADDRESS
*
*
*   VDM TEMPORARIES
*
SPEED RES 1
VDMAD RES 2
BOT RES 1
KNTT RES 1
*
*   DISK DRIVER TEMPORARIES USED IN RDSK,WDSK(H)
*
*
INTRT DS 2  FOR INTERRUPT PROCESSING RETURN
INRET DS 2  INTERRUPT TEST ROUTINE ADDRESS
DSKRT DS 2  SYSTEM STACK SAVE LOCATION
DRVRT DS 2  DRIVER STACK SAVE LOCATION
DSKRD DS 2  DRIVE NOT READY RETURN TRAP
*
 PAGE
*
*
*******************************************
*
*
*
*             SYSTEM BUFFERS
*
*
*
*   DISK ALLOCATION BUFFER
DKBUF RES 80  TRACKS/DISK ( 1 BIT/BLOCK)
*
* NOTE: OUTPUT TRANSFERS EAT GARBAGE PAST THIS (UP TO 256)
*
*
*
*   COMMAND INTERPRETER INPUT BUFFER
*
* (THIS BUFFER IS HERE TO SOLVE MEMORY PROTECT PROBLEMS)
*
CBUF RES NMLEN+2+1
*
*
*
*   DIRECTORY SEARCH BUFFER
DIBUF RES SECTSZ  500 BYTES
*
*
*   HEADER OFFSET VAUES FOR DIBUF
*
DINE EQU DIBUF  NUMBER OF ENTRIES
DIND EQU DIBUF+1  NEXT ENTRY DISPLACEMENT (2 BYTES TO ADDR 500)
DRFDS EQU DIND+2  ADDRESS OF FIRST ENTRY
*
*
*
*   NEXT FILE ID BUFFER
*
IDBUF RES NIDBC
*
*
*
*   TRACK MAP BUFFER
*
TMBUF RES 8  FOR UNPACKED TRACK MAP
*
*
*
*   COMMAND INTERPRETER STACK
*
CISS RES 50  FOR CI STACK
CISTK EQU CISS+50  CI STACK
*
*
*   DIRECTORY ENTRY BUFFER
*
DEBUF RES NMLEN  NAME
DETYP RES 1  TYPE
DEBBS RES 2  BLOCK SIZE IN BYTES
DEPRO RES 1  PROTECTION ATTRIBUTES
DEFID RES 2  FILE ID
DEINX RES 2  FILE INDEX
DEFBA RES 2  FIRST BLOCK DISK ADDRESS
DENBL RES 2  NUMBER OF BLOCKS
*
DRESZ EQU DENBL+2-DEBUF  ENTRY SIZE
*
 PAGE
*
*
*******************************************
*
*
*
*   FCB ENTRY FORMAT, CURRENT FCB ENTRY
*
FCBORG RES 1  BEGINNING
FTYPE EQU FCBORG  FILE TYPE
FBLKS RES 2  BLOCK SIZE
FPROT RES 1  PROTECTION
FID RES 2  FILE ID
FINDX RES 2  INDEX ADDRESS
FFBA RES 2  FIRST BLOCK ADDRESS
FUNIT RES 1  UNIT
FBUFA RES 2  BUFFER ADDRESS/UNBUFFERED FLAG
FDLTA RES 2  DELTA ALLOCATION IN BLOCKS
FDRIV RES 2  DRIVER POINTER
FAIND RES 2  MEMORY ADDRESS OF FILE INDEX BLOCK OR -1
FNBD RES 2  NEXT BYTE DISPLACEMENT
FBDL RES 2  BYTE DISPLACEMENT LIMIT
FFLAG RES 1  DIRTY BLOCK FLAG
FCURSC RES 2  CURRENT SECTOR ADDRESS
FGSPR RES 1  GARYS SPARE
FFORE RES 2  FORE POINTER
FBACK RES 2  BACK POINTER
FHID RES 2  ID FROM HEADER
FPRST RES 1  PROTECTION/STATUS
*
*    NOTES:
*       1) FTYPE-FFBA  MUST MATCH DETYP-DEFBA
*       2) FFORE-FPRST  MUST MATCH THE DISK HEADER
*
TSTV1 EQU FTYPE-FFBA
TSTV2 EQU DETYP-DEFBA
TSTV3 EQU FFORE-FPRST
*
*
*   LNFCB EQU FPRST+1-FCBORG  FCB LENGTH
*
TSTV4 EQU LNFCB
TSTV5 EQU FPRST+1-FCBORG
*
*   THIS MUST AGREE OR ELSE!
*
 PAGE
*
*
*******************************************
*
*
*             DISK INTERFACE CONTROL BLOCKS
*
*
*   TRANSFER DESCRIPTOR or BLOCK TRANSFER DESCRIPTOR
*   Used to describe all transfers between disk and memory by
*   by calling XFER in SAMDI (disk interface) at $F016.
*   On entry HL ^ to BXD.
*   CALL  XFER    transfer data bet disk and memory
*   JMP   ERROR   error return  (HL ^ to BXD, error code in A)
*   ....          standard return
*
*
TDAD   EQU  $
TSEC   RES  2
TBCNT  RES  2
TFID   RES  2
TBUF   RES  2
TUNIT  RES  1
*
BXD    EQU  $
BXDEV  RES  1
BXOP   RES  1
BXRZ   RES  2
BXFR   RES  2
BXXA   RES  2
BXRES  RES  2
*
*
*
*
*   INCOMING HEADER
*   The header exists on disk as the last 12 bytes of a block
*   When a block is read from the disk to memory the header is
*   transferred from the buffer to here by RDDSK.
*
IHEAD EQU $
IHBLK RES 2  BLOCK
IHFOR RES 2  FORE POINTER
IHBAK RES 2  BACK POINTER
IHFID RES 2  FILE ID
IHPRO RES 1  PROTECTION/BLOCK SIZE (# of blocks)
IHSIZ RES 2  BLOCK SIZE ie # of bytes in a block
IHSPR RES 1
RWBUF RES SECTSZ  DATA PUT HERE AFTER BUFFER SO WRITTEN TOGETHE

*
*
*   OUTGOING HEADER
*   The filing header is written to disk as the last 12 bytes of
*   a block.  When a block of a file is to be written the header
*   is assembled here, then transferred to the end of the block
*   by WRDSK.
*
OHEAD EQU $
OHBLK RES 2  SECTOR # (starts at 0)
OHFOR RES 2  FORE POINTER
OHBAK RES 2  BACK POINTER
OHFID RES 2  FILE ID
OHPRO RES 1  PROTECTION-SECTORS/BLOCK
OHSIZ RES 2  BLOCK SIZE
OHSPR RES 1
*
ENPAR EQU $  END OF THIS
*
*
MARES EQU 0A002H  SYSTEM RESIDENT WILL START HERE
*
 PAGE
*
*
*******************************************
*
*
*
*                       FILE 0 FCB
*
*
*      THIS FILE IS THE SYSTEM CONSOLE. IT IS USED FOR
*      DEFAULT INPUT AND CANNOT BE CLOSED.
*
*
*  THE INITIAL FCB'S ARE ASSEMBLED HERE AND MOVED
*  TO FCB0  (THEIR PROPER PLACE) WHEN THE SYSTEM IS
*  BOOTSTRAPPED.
*
*
 ORG SP1  INITIALLY HERE
*
*
*   FILE '0'--C/I INPUT FILE
*
 DB 255  TYPE IS DEVICE
 DW BUFT  BLOCK SIZE
 DB PWRI  WRITE PROTECTED KEYBOARD
 DW -1  ID
 DW 0  INDEX
 DW 0  FIRST BLOCK
 DB 0  UNIT
 DW FCB0-BUFT  BUFFER ADDRESS
 DW 0  DELTA
 DW TDRIV  TTY DRIVER
 DW -1  ALTERNATE INDEX
 DW 0  NBD
 DW 0  BDL
 DB 0  FLAG
 DW 0  CURRENT SECTOR
 DB 0  FGSPR
 DW EOFCD  FORE = EOF
 DW BOFCD  BACK = BOF
 DW -1  FILE ID
 DB 0  PROTECTION
*
*
*
*   FILE '1'--CI OUTPUT FILE
*
 DB 255  TYPE
 DW BUFT2  BLOCK SIZE
 DB PREA  READ PROTECTED TYPER
 DW -1  IDENTIFICATION
 DW 0  INDEX
 DW 0  FBA
 DB 0  UNIT
 DW FCB0-BUFT-BUFT2
 DW 0  DELTA
 DW TDRIV  DRIVER
 DW -1  ALTERNATE INDEX ADDRESS
 DW 0  NBD
 DW 0  BDL
 DB 0  FLAG
 DW 0  CUR SECT
 DB 0  FGSPR
 DW EOFCD  FORE
 DW BOFCD  BACK
 DW -1  ID
 DB 0  PROT
*
*
*
*    UTILITY FILE RESIDES HERE (FILE '2')
*
 DB 80H
 DW 1F4H
 DB 0
 DW 8
 DW 214
 DW 210
 DB 0
 DW FCB0-BUFT-BUFT2-1F4H
 DW 0
 DW DDRIV
 DW -1
 DW 0
 DW 0
 DB 0  DIRTY FLAG
 DW -1
 DB 0
 DW 211
 DW -1
 DW 8
 DB 0
 PAGE
*
*
******************************************************
*
*
*
 ORG MARES  SYSTEM RESIDENT   <|----------------<<---<<---<<<
AP1 EQU MARES  STARTS HERE.
*
*
*
*
*
*
*            ****      PTDOS SYSTEM ENTRY POINT     ****
*
*
*
*     SAVE REGISTERS AND DISPATCH TO OPERATION
*
*
SYS DI .  DISABLE INTERRUPTS FOR AWHILE
 SHLD UHL  SAVE HL
 LXI H,0
 SHLD WBUFSZ  CLEAR LOCAL BUFFER FLAG
 DAD SP  HL=SP
 LXI SP,UHL  SET SYSTEM STACK POINTER
 PUSH D  SAVE D,E
 PUSH B  SAVE B,C
 PUSH PSW  SAVE A,FLAGS
 PUSH H  SAVE SP
 SPHL .  RESTORE USER SP
 POP H  GET RETURN ADDRESS
 MOV A,M
 INX H  MOVE PAST IT
 PUSH H  SAVE RETURN ADDR AGAIN
 STA OPER  SAVE OPERATION
 LXI SP,UTOS  RESTORE SP
 CALL TSTEI  PUT THE INTERRUPTS BACK ON IF DESIRED
*
*   VALIDATE OPERATION
*
 LDA OPER  GET OPERATION
 CPI MAXOP+1
 JC SDISPT  IF OK GO TO OPERATION
*
*   ILLEGAL OPERATION
*
ERR0 CALL ERRL1  ILLEGAL OPERATION
 DB ERIOP
*
*
*   DISPATCH TO OPERATION
*
* LOOK UP IN TABLE
*
SDISPT LXI H,DISPA  DISPATCH ADDRESS
 MOV E,A
 MVI D,0  HL <--DISPA+(2*A)
 DAD D
 DAD D
 MOV A,M
 INX H
 MOV H,M
 MOV L,A
*
*  HL NOW CONTAINS THE DISPATCH ADDRESS
*
 PCHL .  GO TO OPERATION
*
*
*
*      SYSTEM DISPATCH TABLE
*
*
DISPA DW CREATE  0
 DW OPEN  1
 DW KILL  2
 DW READ  3
 DW WRITE  4
 DW SPACE  5
 DW EOF  6
 DW CLOSE  7
 DW CHTYP  8
 DW CHATR  9
 DW CHNAM  10
 DW FINFO  11
 DW SUNH  12
 DW RETURN  13
 DW USRES  14
 DW ABURP  15
 DW SEEK  16
 DW RNDOM  17
 DW CA  18 CLOSE ALL FILES OPERATION
 DW FCTRL  19 DRIVER CONTROL/STATUS
 DW USRES  20
 DW DREAD  21
 DW DWRITE  22
 DW DSPACE  23
 DW RETRAP  24
*
 PAGE
*
*
*****************************************
*
*
*
*           NORMAL RETURN
*
*    RESTORE USER REGISTERS AND STACK
*
NRET CALL RFCB
 DI .  NO INTERRUPTS THROUGH HERE
 LHLD UTOS
 SPHL
 POP H  GET USER RETURN ADDRESS
 INX H
 INX H
 INX H
 PUSH H  MAKE IT NORMAL RETURN
*
NRE10 DI .  NO INTERRUPTS
 LHLD UHL
 PUSH H  PUT USER HL ON USER STACK
 LXI SP,UPSW
 POP PSW  RESTORE A,FLAGS
 POP B  RESTORE BC
 POP D  RESTORE DE
*
*    FINAL RESTORATION
*
 LHLD UTOS
 SPHL .  RESET USER STACK POINTER
 DCX SP
 DCX SP  MOVE BACK TO HL
 POP H  RESTORE HL
 PUSH PSW
 CALL TSTEI  RESTORE INTERRUPTS IF NEEDED
 POP PSW
 RET .  GO BACK TO CALL
*
 PAGE
*
*
*****************************************
*
*
*                    ERROR RETURN
*
*        LEVELS ARE:
*
*          0  VERY SERIOUS - BAD FILES, DISK PROBLEMS
*          1       SERIOUS - USER PROBLEM
*          2       EOF/BOF - ALWAYS HAPPEN
*
ERRL0 LHLD FERR  GET PROCESSOR ADDRESS
 JMP ERRLP
*
*
ERRL1 LHLD AERR  GET LEVEL 1 PROCESSER
 JMP ERRLP
*
*
ERRL2 LHLD EERR  GET LEVEL 2 ERROR PROCESSER
*
* ERRLP - RESTORE FCB, RELEASE BUFFER, AND RECORD ERROR #
*
ERRLP DI .  NO INTERRUPTS FOR A BIT
 PUSH H  SAVE TYPE OF HANDLING
 CALL RFCB  RESTORE FCB, IF ANY
 CALL RIDBF  CLEAN UP BUFFER
 POP H  ERROR HANDLING TYPE
 POP D  POINTER TO ERROR NUMBER FROM CALL
 LDAX D  = ERROR #
 STA UA  RETURN IT TO THE HANDLER OR USER
*
*  IF HL IS ZERO, SYSTEM PROCESSES ERROR
*  IF HL IS -1, USER ERROR RETURN, ELSE JUMP THERE
*
ERRP XCHG .  TYPE
 LHLD UTOS  RESTORE USERS STACK
 SPHL
 INX D
 MOV A,E
 ORA D
 JZ NRE10  USER ERROR RETURN
 DCX D
 MOV A,E
 ORA D
 JZ ERRP7  SYSTEM HANDLES IT
*
*  CHANGE RETURN ADDRESS TO HL FOR ERROR TRAP
*
 POP H  GET RID OF OLD RETURN
 PUSH D  PUT IN TRAP ADDRESS
 JMP NRE10  GO LOOK NORMAL
*
*
*    SYSTEM ERROR HANDLER, FORGET ABOUT USER PROGRAM
*
ERRP7 POP H  GET RETURN ADDRESS IN HL
 LDA UTIL  SEE IF A UTILITY FILE IS GOING
 INR A  (-1 IF NOT)
 JNZ ERRP8  OK, USE IT
 LDA OPER
 MOV B,A  GET OPERATION IN B
 LDA UA  GET ERROR NUMBER IN A
 CALL SYS  GO AWAY AND DON'T COME BACK
 DB ABTOP  ABORT
*
*
*
*  EXPLAIN THE ERROR USING UTILITY
*
ERRP8 LDA UA
 STA ERCD  SET ERROR CODE (OPER ALREADY SET)
 LDA OPER
 STA EOPR  SET OPERATION CODE
*
ERRPX PUSH H
 LXI H,XTRP  TRAP ANY SERIOUS ERRORS
 SHLD AERR
 SHLD FERR
 POP H
 MVI A,3  (=> NUMBER AND "CALLER FROM" MSG.)
 JMP ERRP9
*
 PAGE
*
*
*****************************************
*
*
*
*
*             CREATE FILE OPERATION
*
*
*  USER DE POINTS TO A BLOCK WITH THE FOLLOWING FORM....
*
*       BYTE                   CONTENTS
*         0            FILE TYPE
*         1-2          FILE BLOCK SIZE
*         3            FILE PROTECTION WORD
*         4 .....      FILE NAME <0> OR NAME/UNIT #
*
*
*      ERRORS:
*             FILE ALREADY EXISTS
*             DIRECTORY FULL
*             MEMORY OVERFLOW
*             DISK FULL
*             ILLEGAL NAME
*
*    FIRST, SEARCH DIRECTORY FOR FILE
*
CREATE LHLD UDE  GET NAME POINTER
 LXI D,DEPRO-DETYP+1
 DAD D
 CALL SDIR  SEARCH
 JMP CRE10  NOT FOUND, OK
 CALL ERRL1  ERROR
 DB ERAEX
*
*    CHECK FOR FULL DIRECTORY
*
CRE10 LHLD DFC
 MOV A,L
 ORA H
 JZ ERDIR  FREE PTR IS ZERO - ERROR
*
*    CREATE A DIRECTORY ENTRY IN DEBUF
*    COPY CONSTANT PARAMETERS
*
 LHLD UDE
 XCHG .  PARAMETER PTR IN DE
 LXI H,DETYP  BUFFER PTR IN HL
 CALL MOVEF  MOVE USER PARAMETERS
 DB DEPRO-DETYP+1
*
*    ALLOCATE BUFFER FOR INITIAL BLOCK ALLOCATION
*
 LHLD DEBBS
 SHLD FBLKS  PUT BLOCK SIZE INTO FCB
*
*    PICK SOMEWHERE FOR A BUFFER JUST USE ANYWHERE
*
 LHLD LOWAD
 SHLD TBUFA  SAVE ADDRESS
*
*    ALLOCATE FILE ID
*
 CALL GFID
 XCHG
 SHLD DEFID  SAVE ID IN DIREC. ENTRY
*
*    SETUP PSEUDO FCB FOR CALL TO AFBLK
*
 SHLD FHID  SAVE ID
 LXI H,EOFCD  SET EOF
 SHLD FFORE
 LXI H,BOFCD  AND BOF
 SHLD FBACK
 XRA A  =0
 STA FPRST  SET NOT DIRTY
*
*    ALLOCATE BLOCK
*
 CALL AFBLK
 SHLD DEFBA  SAVE FIRST BLOCK ADDR IN DIREC.
 LXI H,1
 SHLD DENBL  SET NUMBER OF BLOCKS TO 1
 DCX H  MAKE HL=0
 SHLD DEINX  SET NO INDEX
*    MAKE DIRECTORY ENTRY
 CALL EDIR
 JMP NRET  RETURN TO USER
*
*
CERR1 CALL ERRL1  DIRECTORY FULL
 DB CER1
*
 PAGE
*
*
*****************************************
*
*
*
*                 DELETE (KILL) FILE OPERATION
*
*
*    USER DE POINTS TO NAME
*
*    ERRORS:
*       FILE DOES NOT EXIST
*       FILE IS DELETE-PROTECTED OR OPEN
*       MEMORY OVERFLOW
*
*
KILL LHLD UDE
 CALL SDIR  SEARCH DIRECTORY
 JMP KIL90  ERROR - NONEXISTENT
*
*    CHECK FOR DELETE PROTECTION
*
 LDA DEPRO
 ANI PDEL  DEL. PROT. BIT
 JNZ EOFE0  ERROR - PROTECTED
*
*    CHECK IF FILE IS OPEN
*
 LHLD DEFID  FILE ID
 SHLD FID  SET SO RBLK WILL WORK
 CALL SFCBS
 JMP KIL91  FOUND, OPEN ERROR
 JMP KIL91  FOUND
*
 LHLD DEBBS
 SHLD FBLKS  SETUP BLOCK SIZE FOR DEALLOCATION
 XCHG
 CALL ALBUF  GET A BUFFER
 SHLD TBUFA
*
 CALL RDIR  REMOVE DIREC ENTRY
*
*    RELEASE DISK SPACE
*
 LHLD DEFBA
 SHLD FCURSC  NOW, DISK ADDR, ID, AND BLK SZ SET
 LXI H,DDRIV  SET DRIVER
 SHLD FDRIV  ADDRESS IN FCB
 XRA A  =0
 STA FFLAG  SET NOT DIRTY
 CALL RBLK  READ FIRST BLOCK
*
*    RELEASE EACH BLOCK
*
KIL20 CALL RFBLK  RELEASE
 CALL DDRNB  READ NEXT BLOCK
 JMP KIL50  EOF, DONE
 JMP KIL20
*
*    RELEASE BUFFER
*
KIL50 LHLD FBLKS
 XCHG
 LHLD TBUFA
 CALL DLBUF  RELEASE IT
*
*    RELEASE FILE INDEX
*
 LHLD DEINX  GET INDEX POINTER
 MOV A,H
 ORA L
 JZ NRET  NONE
 SHLD FCURSC  SET ESECT TO RET
 MVI A,1
 STA FPRST  SECTOR COUNT IS 1
 CALL RFBLK  RELEASE BLOCK
 JMP NRET  DONE
*
*
KIL90 CALL ERRL1  NONEXISTENT
 DB ERNEX
KIL91 CALL ERRL1  FILE OPEN
 DB ERMOP
*
 PAGE
*
*
*******************************************
*
*
*
*
*                         OPEN FILE OPERATION
*
*
*    USER DE POINTS TO NAME
*    USER HL HAS BUFFER OPTIONS:
*
*          IF -1  THEN UNBUFFERED
*          IF  0  THEN SYSTEM BUFFERED
*          ELSE   USER BUFFERED
*
*
*    ON NORMAL RETURN,
*       A HAS THE FILE NUMBER
*       B HAS THE FILE TYPE, AND IF A=255:
*
*          DE HAS THE DRIVER SIZE
*          HL HAS THE DRIVER LOAD ADDRESS
*
*
*    ERRORS:
*          FILE DOES NOT EXIST
*          NO FCBS AVAILABLE
*          MEMORY OVERFLOW
*          ILLEGAL USER BUFFER ADDRESS
*
*
*
*   FIRST, LOOK UP FILE
*
OPEN LHLD UDE
 CALL SDIR
 JMP KIL90  DOESN'T EXIST
*
*   FOUND, ALLOCATE FCB
*
 LXI H,0
 SHLD FRADD
 CALL ALFCB
*
*   MOVE STUFF FROM DIRECTORY ENTRY TO FCB
*
 LHLD DBUF
 LXI D,DETYP-DEBUF  DISPLACEMENT TO TYPE
 DAD D
 XCHG .  DE GETS SOURCE
 LXI H,FTYPE  HL GETS DESTINATION
 CALL MOVEF
 DB DEFBA-DETYP+2
*
 LXI H,0
 SHLD FNBD  SET NBD=O
 SHLD FDLTA  SET DELTA=O
 DCX H  = -1
 SHLD FAIND  SET FAIND = -1
 LHLD FFBA  FIRST BLOCK ADDRESS
 SHLD FCURSC  MAKE IT CURRENT BLOCK
 XRA A
 STA FFLAG  CLEAR DIRTY FLAG
*
 LXI H,DDRIV
 SHLD FDRIV  SET DRIVER
 CALL OBUF
 JMP OPE70  UNBUFFERED
*  FILE IS BUFFERED
 CALL RBLK  LOAD IN FIRST BLOCK
 SHLD FBDL  SET BDL, (NBD=0)
*
OPE70 CALL LODRI  SET UP DRIVER
 LHLD FRAD2
 SHLD FRADD
*
*   IF ALREADY OPEN, DON'T ALLOW NEW ALLOCATIONS
*
 LHLD FID
 CALL SFCBS  CHECK FOR OTHER FCB'S WITH SAME ID, UNIT
 JMP OPE75  YES
 JMP OPE75  YES, = 1 ALREADY
 JMP NRET  NO, THIS WILL BE THE FIRST
*
*
*
*   FILE ALREADY OPEN, SET PALO
*
OPE75 LDA FPROT  FILE ALREADY OPEN,
 ORI PALO  NO ALLOCATION ALLOWED.
 STA FPROT
 JMP NRET
*
*
*   CHECK FOR UNBUFFERED
*
OBUF LHLD UHL  USER HL
 MOV D,H
 MOV E,L  MAKE COPY IN DE
 INX D  DE IS 0 IF UNBUFFERED
 MOV A,D
 ORA E  ZERO TEST
 JZ OPE60  YES, UNBUFFERED
*
*   CHECK FOR SYSTEM BUFFER REQUEST
*
 MOV A,H
 ORA L  IS IT ZERO
 JZ OPE40  YES, ALLOCATE SYSTEM BUFFER
*
*   (S)HE HAS SPECIFIED A USER BUFFER
*   VALIDATE ADDRESS
*
 XCHG
 LHLD FBLKS
 XCHG .  DE = BLOCKSIZE, HL -> BUFFER
 CALL MEMCHK  CHECK
*
OPE20 LHLD UHL
*
*   COME HERE WITH BUFFER ADDRESS IN HL
*
OPE30 SHLD FBUFA
 SHLD TBUFA
 JMP RP2  RETURN CALL PLUS 2
*
*
*   ALLOCATE SYSTEM BUFFER
*
OPE40 LHLD FBLKS
 XCHG
 CALL ALBUF  ALLOCATE BUFFER
 JMP OPE30  GOT IT
*
*
*   FILE IS UNBUFFERED
*
OPE60 LXI H,-1
 SHLD FBUFA
 RET
*
 PAGE
*
*
******************
*
*
*
*
*          ALLOCATE FILE CONTROL BLOCK
*
*  NO PARAMETERS
*
*          CALL ALFCB
*          RETURN FRADD SET, UA GETS NUMBER
*          ABORT IF NO FCB IS AVAILABLE
*
ALFCB LHLD FCBASE
 LXI D,FID-FCBORG
 DAD D  FORM FID ADDRESS OF UST FCB
 LDA NFCB
 MOV C,A  C = COUNT
 MVI B,-1  START WITH ZERO
*
ALF10 INR B  COUNT UP
 MOV A,M  GET ID
 INX H
 ORA M
 JZ ALF50  FOUND ONE
 LXI D,LNFCB-1
 DAD D  MOVE TO NEXT FCB
 DCR C  COUNT DOWN
 JNZ ALF10
*
*    ABORT, NONE AVAILABLE
*
 CALL ERRL1  LEVEL 1
 DB ERTOP
*
*   FOUND ONE
*
ALF50 MOV A,B
 STA UA
 LXI D,FCBORG-FID-1
 DAD D  MOVE BACK
 SHLD FRAD2  SET ADDRESS
 RET
*
 PAGE
*
*
*****************************************
*
*
*
*   "LODRI"  CHECK IF DEVICE FILE AND LOAD IF SO
*
LODRI LDA FTYPE  GET FILE TYPE
 STA UB  RETURN TO CALLER IN "B"
 INR A  CHECK FOR DEVICE FILE
 RNZ .  ASSUMPTIONS SOMETIMES PROVE OUT
*
*
*
*               LOAD A DEVICE DRIVER
*
*
*    THE FILE IS A DEVICE FILE. IT'S TIME TO LOAD IT.
*  THE DRIVER FILE IS AN IMAGE STRUCTURED FILE WHOSE
*  FIRST LOAD ADDRESS IS THE DRIVER TABLE ADDRESS.
*  ONLY A SINGLE BLOCK IS LAODED AND,OF COURSE, THE
*  START ADDRESS, IF ANY, IS NOT PROCESSED.
*
*
*
LOD20 CALL PBUF  PREPARE THE BUFFER AND SAVE UBC,UDE
*
*    NOW READ THE BLOCK. THE FIRST FILE BLOCK CONTAINS
*  THE COUNT AND LOAD ADDRESS SO IS SPECIAL.
*
 LHLD FBDL
 LXI D,-4
 DAD D
 JNC LER2  THE FILE DOESN'T EVEN HAVE FOUR BYTES!!
*
 SHLD LCNT  LCNT=FBDL-4
 LHLD TBUFA  CALCUALATE SOURCE ADDESS
 LXI D,4
 DAD D
 SHLD SOU  SOU=TBUF+4
*
*    PICKUP COUNT AND LOAD ADDRESS
*
 XCHG
 DCX D  BACKUP TO LAST BYTE OF ADDRESS
 LDAX D
 MOV H,A  SET HIGH OF ADDRESS
 DCX D
 LDAX D
 MOV L,A  LOW OF ADDRESS
 SHLD UDE  SET LOAD ADDRESS
*
*    NOW GET COUNT
*
 DCX D
 LDAX D
 MOV H,A  GET H OF COUNT
 DCX D
 LDAX D
 MOV L,A  GET L OF COUNT
 SHLD UBC  SET BLOCK COUNT
 ORA H
 JZ LER2  ERROR--ZERO BLOCK COUNT
*
* SAVE SIZE, LOAD ADDRESS FOR RETURN TO THE USER
*
 PUSH H  COUNT
 LHLD UDE
 PUSH H  ADDRESS
 XRA A
 STA DELFG  NO DELIMITER, PLEASE!
*
*    NOW LOOP AND MOVE THE BLOCK
*
LOD30 LHLD UDE  DESTINATION ADDEESS
 SHLD DEST  SET IT
 LHLD LCNT
 XCHG .  DE HAS LOCAL COUNT
 LHLD UBC  HL HAS GLOBAL COUNT
 CALL MBLK
 LHLD UBC  CHECK FOR LOAD COMPLETED
 MOV A,H
 ORA L
 JZ LOD40  COMPLETED--COUNT NOW ZERO
*
*   READ IN NEXT BLOCK AND SET UP TRANSFER
*
 LHLD FBLKS
 CALL RDNB  READ NEXT BLOCK
 JMP LER3  EOF, ERROR
 LHLD TBUFA
 SHLD SOU  SET SOURCE TO BUFFER
 LHLD FBDL
 SHLD LCNT  SET LOCAL OUNT
 JMP LOD30  MOVE NEXT BUFFER LOAD
*
*
*   NEXT SET THE DRIVER ADDRESS IN THE FCB AND THROW
*   AWAY THE BUFFER USED TO READ THE FILE.
*
LOD40 POP H  ADDRESS WAS THE THE STACK,REMEMBER
 PUSH H  BUT KEEP IT
 SHLD FDRIV
 CALL CLBUX  CLOSE OUT BUFFER
*
*   GET NEW BLOCK SIZE FOR DEVICE AND REPROCESS BUFFER
*
 LHLD FDRIV
 LXI D,DTBLK
 DAD D  HL POINTS TO BLOCK SIZE
 MOV E,M
 INX H
 MOV D,M  GOT IT IN DE
 XCHG
 SHLD FBLKS  SET NEW BLOCK SIZE
 CALL OBUF  OPEN A BUFFER
 NOP .  YES THESE ARE REQUIRED.....
 NOP
 NOP
*
*   FINALLY SET UP THE FCB FOR USE
*
 LXI H,0
 SHLD FNBD  NBD=0
 SHLD FBDL  BDL=0
 SHLD FINDX  INDEX PTR TO ZERO
 DCX H  MINUS ONE
 SHLD FBACK  BACK IS BOF
 MOV A,H
 STA FUNIT  SET UNIT=255
 LXI H,EOFCD
 SHLD FFORE  FORE IS EOF
*
*   SET UBC,UDE TO REPORT BACK TO CALLER
*
 POP H  FROM STACK
 SHLD UDE
 POP H  AREN'T STACKS WONDERFUL
 SHLD UBC
*
*   INITIALIZE THE DRIVER
*
 CALL DVBR  INITIAL ENTRY
 DB DTINI
*
 RET
*
*
*   ERRORS ERRS ERS
*
LER2 CALL ERRL1  BAD DRIVER--ZERO COUNT
 DB ERZBC
*
LER3 CALL ERRL1  BAD DRIVER--EOF
 DB EREOF
*
******************
*
*
*
*    DISK DRIVER INTERFACE TO SYSTEM
*
*
DDRIV DW DDRBL  READ BLOCK
 DW DDRNB  READ NEXT BLOCK
 DW DDRLB  READ LAST BLOCK
 DW DDWBR  WRITE/READ BLOCK
 DW DDWBL  WRITE BLOCK
 DW DDREW  REWIND
 DW DDEOF  ENDFILE
 DW DDCLO  CLOSE
 DW DDSEK  SEEK
 DW DDCTL  CONTROL
 DW 0  BUFFER SIZE
 DB 0  ITO (DO NOT CHANGE)
 DW DDCLO  INITIALIZE
DDCLO RET
*
IDAC CALL ERRL1  ILLEGAL DRIVER OPERATION
 DB ERIDA
*
 PAGE
*
*
*******************************************
*
*
*
*
*              FILE READ/WRITE PROCESSER
*
*      USER  A - HAS FILE NUMBER
*      USER BC - HAS TRANSFER COUNT
*      USER DE - HAS SOURCE/DESTINATION ADDRESS
*      USER  L - DELIMITER  (IF DREAD OR DWRITE ENTRY)
*
*  USES RWF, SOU, DEST, LCNT FOR TEMP STORAGE
*
*    ERRORS:
*
*       ILLEGAL FILE NUMBER
*       READ/WRITE PROTECTED FILE
*       EOF
*       DISK FULL
*       OTHER, MORE SERIOUS ERRORS
*
*  DELIMITED READ ENTRY POINT
*
DREAD MVI A,-1  DEFLG GETS THIS RWF GETS 0
 JMP RWP00  SET THE TWO FLAGS
*
*  WRITE ENTRY POINT
*
WRITE XRA A
RWP00 STA DELFG  SET DELIMETER
 CMA .  NOW INVERT THE FLAG
 JMP RWP02  AND SET THE READ/WRITE FLAG
*
*  DELIMITED WRITE ENTRY POINT
*
DWRITE MVI A,-1
 JMP RWP01
*
*  READ ENTRY POINT
*
READ XRA A  =0
RWP01 STA DELFG  THE DELIMITED FLAG
RWP02 STA RWF  THE READ/WRITE FLAG
*
*    PREPARE FCB, ETC.
*    READ ENTRY POINT
*
 CALL PFCB  PREPARE THE FCB
*
*  CHECK PROTECTION
*
RWCON LDA RWF
 ORA A
 JZ RWP10  READ
*
*  CHECK AND REPORT WRITE PROTECT
*
 CALL PROTST
 DB PWRI
 JMP RER0  ERROR - WRITE PROTECT
 JMP RWP20  OK
*
*  CHECK AND REPORT READ PROTECT
*
RWP10 CALL PROTST
 DB PREA
 JMP RER0  ERROR - READ PROTECTION
 LHLD UBC
 XCHG .  DE = COUNT
 LHLD UDE  HL = ADDRESS
 CALL MEMCHK  CHECK FOR WRITE INTO PROTECTED MEMORY
*
*  PREPARE BUFFER
*
RWP20 CALL PBUF
*  SET UP TRANSFER OR RESTART AFTER NEW BUFFER LOAD
RWP22 LHLD FNBD  GET NEXT BYTE DISPLACEMENT
 XCHG
 LHLD TBUFA  BUFFER ADDRESS
 DAD D  HL = BUFF+NBD = SOURCE
 XCHG
 LHLD UDE  = USER ADDRESS
 LDA RWF  = READ/WRITE FLAG
 ORA A
 JZ RWP25  READ
*
*  WRITE, INTERCHANGE SOURCE AND DEST
*
 XCHG
*
RWP25 SHLD DEST  SAVE DEST
 XCHG
 SHLD SOU  AND SOURCE
 LHLD FNBD
 XCHG .  DE MUST HAVE FNBD FOR RWP26
 LHLD FBLKS  = BLOCK SIZE
*
* IF WRITE, USE BLOCKSIZE AS BDL, ELSE BDL
*
 JNZ RWP26
 LHLD FBDL
*
*  DE HAS NBD, HL HAS BDL OR BLOCK SIZE
*  COMPUTE HL-DE AS LOCAL COUNT
*
RWP26 CALL ARITH  HL=HL-DE
 SHLD LCNT  SAVE LOCAL COUNT
 XCHG .  DE HAS LOCAL COUNT
*
*  TEST IF COUNT IS ZERO (DE HAS LCNT)
*
RWP30 LHLD UBC
 MOV A,H
 ORA L
 JZ RWP70  YES, COUNT IS 0 --DONE
*
*  SEE IF DELIMITER SEEN
*
 LDA DELFG
 DCR A
 JZ RWP70  YES!, STOP TRANSFER
*
*  TEST IF LOCAL COUNT IS ZERO
*
 MOV A,D
 ORA E
 JNZ RWP50  NON-ZERO, MOVE DATA
*
*  LOCAL COUNT IS ZERO
*
 CALL UPBDL  UPDATE BDL
 LDA RWF
 ORA A  READ OR WRITE?
 JNZ RWP40  WRITE
*   READ
 LHLD FBLKS  READ
 CALL RDNB  READ NEXT BLOCK
 JMP EOFER  EOF HIT
 JMP RWP22  CONTINUE THE READ
*
*
*   WRITE
*
RWP40 LHLD FBDL
 CALL WDBR  WRITE BLOCK
 JMP RWP22  AND ONWARD
*
*
*  COUNT IS ZERO, OPERATION IS COMPLETE
*  UPDATE BDL IF NECESSARY
*
*  WE CAN ALWAYS CALL FDB EVEN IF OPER=READ
*  IF WE ASSUME READ DIDN'T SET DIRTY
*
RWP70 CALL UPBDL
 CALL FDB  YES, FLUSH DEVICE BUFFER
 CALL RBUF  RELEASE BUFFER
 JMP NRET  NORMAL RETURN WHEN DONE
*
*
*  UPDATE BDL
*
UPBDL LHLD FBDL
 XCHG
 LHLD FNBD
 CALL COMP  CHECK BDL AND NBD
 RNC .  BDL GE NBD
 SHLD FBDL  UPDATE BDL
 RET
*
*
*  SET DIRTY IF WRITING
*
RWP50 CALL MBLK
 LHLD LCNT
 XCHG .  DE GETS NEW LOCAL COUNT FOR LATER
 LDA RWF
 ORA A
 JZ RWP30  NOT WRITE
 STA FFLAG  IT'S WRITE SET DIRTY FLAG
 JMP RWP30
*
*********************
*
*  CALCULATE HL = HL-BC
*
RWPS MOV A,L
 SUB C
 MOV L,A
 MOV A,H
 SBB B
 MOV H,A
 RET
*
*
*  CALCULATE HL = HL-DE
*
ARITH MOV A,L
 SUB E
 MOV L,A
 MOV A,H
 SBB D
 MOV H,A
 RET
*****************************************
*
*
*     CHECK FOR READ OR BUFFER IN PROTECTED AREAS
*
*     ON CALL HL HAS START ADDRESS
*             DE HAS COUNT
*
*     ON RETURN, ALL REGISTERS DESTROYED;  ABORT IF ERROR
*
MEMCHK DCX D  LOWER COUNT FOR PROPER TESTS
 PUSH D  SAVE COUNT
 LXI D,SYSTOP  TOP OF SYSTEM
 CALL COMP  DO COMPARE
 POP D
 JNC MEMC0  IF START ADDRESS LESS THAN TOP OF SYSTEM
*
*  START IS ABOVE SYSTEM.  OK IF IT DOESN'T PASS ZER0
*
 DAD D  HL= TOP OF WRITE
 MOV A,H  GET HIGH BYTE
 ORA A
 RM .  STILL MINUS....OK
*
MERR1 CALL ERRL1
 DB ERMEM  USER MEMORY PROTECT ERROR
*
MEMC0 PUSH H  ADDRESS
 PUSH D  COUNT
 DAD D  HL GETS HIGEST USED ADDRESS
 XCHG .  TO DE
 LHLD LOWAD  GET LOWEST SYSTEM ADDRESS
 CALL COMP
 POP H  COUNT TO HL
 POP D  START ADDRESS
 MOV B,H
 MOV C,L  SAVE COUNT IN BC
 JC MEM10  DE .LT. LOWAD OK STILL
*
*  ATTEMPTING TO WRITE INTO SYSTEM..SEE IF CBUF
*
 LXI H,CBUF
 CALL COMP  DE HAS WRITE ADDRESS
 JNZ MERR2  IF IT WASN'T CBUF
*
*  NOW TEST COUNT FOR 256 OR LESS
*
 LXI H,-256
 DAD B  BC = COUNT
 RNC .  IF COUNT .LT. 256
*
MERR2 CALL ERRL1
 DB ERSMP  SYSTEM MEMORY PROTECT
*
*
*  SEE IF ABOVE USER PROTECT
*
MEM10 LHLD UPROT  DE HAS MEMORY WRITE START
 CALL COMP
 RNC .  HL .GE. DE (START <= UPROT ), OK
 JMP MERR1  USER MEMORY PROTECT
*
*
*********************
*
*
*     MOVE DATA
*
*  COME HERE WITH LOCAL COUNT IN DE, GLOBAL IN HL
*
MBLK CALL COMP
 JNC RWP52  DE => HL, USE GLOBAL COUNT
 XCHG .  USE LOCAL COUNT
*
RWP52 CALL CKDEL  CHECK FOR DELIMITER
 MOV B,H
 MOV C,L  COUNT IN BC
*
 LHLD UDE  UPDATE NUMBERS
 DAD B
 SHLD UDE  SOU/DEST ADDRESS
 LHLD UBC
 CALL RWPS
 SHLD UBC  USER COUNT
 LHLD LCNT
 CALL RWPS
 SHLD LCNT  LOCAL COUNT
 LHLD FNBD
 DAD B
 SHLD FNBD  NBD
*
 LHLD SOU
 XCHG .  DE HAS SOURCE
 LHLD DEST  HL HAS DESTINATION
 JMP MOVEV  BC HAS COUNT, MOVE AND RETURN
*
*********************
*
*
*      CHECK FOR DELIMITER
*
*    SET FLAG IF FOUND
*    HL = COUNT
*    RETURN, HL = POSSIBLY REDUCED COUNT, DELFG SET
*
CKDEL LDA DELFG
 ORA A  SEE IF CHECKING FOR DELIMITERS AT ALL
 RZ .  NO
 PUSH H
 XCHG
 LHLD SOU  HL -> DATA, DE = MAX COUNT
*
*  LOOP FOR END OF COUNT OR DELIMITER
*
CKD20 MOV A,D  TEST IF OUT OF COUNT
 ORA E
 JZ CKD30
*
 DCX D  ACCOUNT FOR THIS ONE
 LDA UL  = DELIMITER
 CMP M
 JZ CKD50  FOUND!
 INX H
 JMP CKD20  LOOP
*
*  END OF COUNT... NOT FOUND
*
CKD30 POP H  RESTORE COUNT
 RET
*
*
*  FOUND, COMPUTE UPDATED COUNT
*
CKD50 POP H
 MOV B,D
 MOV C,E  DECREMENTED COUNT IN BC
 CALL RWPS  HL=HL-BC
 MVI A,1
 STA DELFG  SET FLAG
 RET .  ALL SET
*
 PAGE
*
*
*******************************************
*
*
*
*
*                  READ SINGLE BYTE OPERATION
*
*    "A"  HAS THE FILE NUMBER
*
*  THIS OPERATION USES THE USER STACK. THE
*  STANDARD ENTRY AND EXIT ROUTINES ARE NOT USED.
*
*    ERRORS:
*       ILLEGAL FILE NUMBER
*       PROTECTED FILE
*       EOF
*
RB CALL RWPREP  SAVE A BUNCH OF JUNK AND PREPARE
 CALL PROTST  CHECK IF PROTECTED
 DB PREA
*
 JMP RER0  ERROR - PROTECTED
 CALL PBUF  PREPARE BUFFER
*
*  CHECK IF BUFFER EMPTY
*
 LHLD FNBD
 XCHG
 LHLD FBDL  BBD BDL
 CALL COMP  COMPARE DE HL
 JC RB50  NBD LT BDL, OK
*
*  FILL BUFFER
*
 LHLD FBLKS
 CALL RDNB
 JMP RBEOF
*
*  LOAD BYTE AND UPDATE NBD
*
RB50 CALL UPNBD  GET THE BUFFER ADDRESS AND COUNT UP
 MOV A,M
 STA UA  SAVE BYTE
 CALL RBUF  RELEASE BUFFER
 CALL RFCB  RESTORE FCB
 LDA UA  RETURN WITH BYTE IN A
*
*
*  EVERYONE COMES HERE FOR CALL+2
*  RETURN THROUGH HL
*
RP2 POP H
RP3 INX H
 INX H
 INX H
 PCHL .  NORMAL RETURN
*
*
*  PROTECTED
*
RER0 CALL ERRL1
 DB ERPRO
*
*********************
*
*
*  PREPARE FOR READS AND WRITES
*
RWPREP STA UA  SAVE FILE NUMBER IN USER A
 MOV A,B
 STA UB  WRITE USES THIS
 LXI H,0
 SHLD WBUFSZ  CLEAR DANGLING BUFFER FLAG
 DAD SP
 INX H
 INX H
 SHLD UTOS  SET UTOS FOR ERRORS
 JMP PFCB  PREPARE FCB AND RETURN
*
*
*  UDATE NEXT BYTE DISPLACEMENT AND RETURN BUFFER ADDRESS
*
UPNBD LHLD FNBD  GET NEXT BYTE DISPLACEMENT
 INX H  BUMP IT FOR THIS BYTE
 SHLD FNBD
 DCX H  ADJUST COUNT TO POINT TO CURRENT POSITION
 XCHG
 LHLD TBUFA
 DAD D  HL = NBD + BUFF ADDRESS
 RET
*
 PAGE
*
*
*******************************************
*
*
*
*
*                WRITE SINGLE BYTE OPERATION
*
*  A HAS THE FILE NUMBER
*  B HAS THE BYTE
*
*
*  ON RETURN,
*    A,B ARE UNCHANGED
*
*  THIS OPERATION USES THE USER STACK. STANDARD ENTRY,
*  EXIT, AND ERROR ROUTINES ARE NOT USED
*
*    ERRORS:
*       ILLEGAL FILE NUMBER
*       PROTECTED FILE
*       DISK FULL
*
*
*
WB CALL RWPREP  PREPARE EVERYTHING
 CALL PROTST  CHECK PROTECTION
 DB PWRI
 JMP RER0  ERROR - PROTECTED
 CALL PBUF  PREPARE BUFFER
*
*  CHECK FOR FULL BLOCK
*
 LHLD FNBD
 XCHG
 LHLD FBLKS  NBD BLOCK SIZE
 CALL COMP  COMPARE DE HL
 JC WB50  NBD LT BLOCKSIZE
 CALL WDBR  BUFFER IS FULL...WRITE IT
*
*  STORE BYTE, UPDATE NBD
*
WB50 CALL UPNBD
 LDA UB
 MOV M,A  STORE BYTE
 MVI A,1
 STA FFLAG  SET DIRTY
*
*  UPDATE BDL IF NECESSARY
*
 INX D
 LHLD FBDL  DE HAS NBD
 CALL COMP
 JC WB60  NBD LT BDL, LEAVE BDL ALONE
 XCHG
 SHLD FBDL  UPDATE BOL
*
*  FINISH UP
*
WB60 CALL FDB  FLUSH BUFFER IF DEVICE FILE
 CALL RBUF  RESTORE BUFFER
 CALL RFCB  RESTORE FCB
 LDA UB
 MOV B,A  SET B
 LDA UA  RESTORE A
 JMP RP2
*
 PAGE
*
*
*******************************************
*
*
*
*
*               MOVE FILE POINTER OPERATION (SPACE)
*
*     UA HAS   FILE NUMBER
*     UBC HAS  DELTA VALUE
*     UD= 0    FOR REWIND
*        -1    FOR SPACE-TO-END
*         1    FOR SPACE FOREWARD
*     200(8)   FOR SPACE BACKWARDS
*     UL       DELIMITER IF DSPACE
*
*
*    ERRORS:
*       ILLEGAL FILE NUMBER
*       EOF/BOF
*
*
*  DELIMITER SPACE ENTRY
*
DSPACE MVI A,-1
 JMP SPA01
*
*
*  STANDARD SPACE ENTRY
*
SPACE XRA A
SPA01 STA DELFG  SETUP DELIMITER SCAN FLAG
 CALL PFCB  PREPARE FCB
 CALL PBUF  PREPARE BUFFER
 CALL WDBUF  FLUSH OUT ANYTHING
 LDA UD
 ORA A  LOOK AT OPTIONS
 JNZ SPA20  NOT REWIND
*
*  D=0...REWIND FILE
*
 LHLD FBLKS  GET BLOCK SIZE
 XCHG
 LHLD TBUFA  DE=COUNT, HL->BUFFER
 CALL DVBR  DO THE REWIND
 DB DTREW
*
 SHLD FBDL  GOOD, SET BDL FROM HEADER COUNT
 LXI H,0
 SHLD FNBD
 JMP SPA80
*
*********************
*
*
*  (PART OF DISK INTERFACE)  COME HERE TO REWIND DISK FILE
*
DDREW LHLD FCURSC  CURRENT SECTOR AND TRACK
 XCHG
 LHLD FFBA  FIRST SECTOR AND TRACK
 CALL COMP  CHECK IF CORRECT BLOCK IS IN
 JZ REW10  YES
 SHLD FCURSC  SET AS CURRENT SECTOR
 CALL RBLK  PRIME WITH FIRST BLOCK
 RET .  HL HAS COUNT IN SECTOR
*
*
* CURRENT BLOCK IS IN
*
REW10 LHLD FBDL  RETURN SIZE
 RET
*
*
*   SPACE FORWARD OR BACKWARD
*
SPA20 JP SPAF  (S)HE WANTS FOREWARD
 INR A
 JNZ SPAB  (S)HE WANTS BACKWARDS
*
*  MOVE TO EOF
*
SPA22 LHLD FBLKS
 CALL RDNB  READ NEXT BLOCK
 JMP SPA25  EOF
 JMP SPA22  TRY AGAIN
*
*
SPA25 LHLD FBDL
 SHLD FNBD  SET NBD=BDL
 JMP SPA80  GO QUIT
*
*
*    SPACE FOREWARD
*
SPAF LHLD FNBD
 XCHG .  DE HAS NBD
 LHLD FBDL  HL HAS BDL
 CALL ARITH  HL=HL-DE
 XCHG .  DE HAS BDL-NBD
 CALL UPCNT  GET MAXIMUM COUNT TO HL
 PUSH H
 LHLD TBUFA  COMPUTE -> DATA
 XCHG
 LHLD FNBD
 DAD D  -> DATA
 SHLD SOU  SET DATA SOURCE POINTER
 POP H  GET BACK COUNT
*
*  IF DELIMITED, DO PRESCAN FOR DELIMITER
*
 CALL CKDEL  FIND NEW COUNT IF DELIMITED
 XCHG .  DE HAS MIN OF USER, LOCAL CNT.
 LHLD FNBD
 DAD D
 SHLD FNBD  UPDATE NBD
 LHLD UBC
 CALL ARITH  HL=HL-DE= NEW USER COUNT
 SHLD UBC  UPDATE USER COUNT
*
*  TEST FOR ZERO COUNT OR DELIMITER
*
 ORA L  "A" HAS "H" FROM ARITH
 JZ SPA80  YES, GO QUIT
*
 LDA DELFG  CHECK IF DELIMITER SEEN
 DCR A
 JZ SPA80  YES, GO QUIT
*
*  NO, MOVE TO NEXT BLOCK
*
 CALL RDNB  MOVE TO NEXT
 JMP SEOF  EOF
 JMP SPAF
*
*********************
*
*
*    FIND MIN OF UBC, AND DE INTO HL
*
UPCNT LHLD UBC
 CALL COMP
 RNC .  HL GE DE
 XCHG .  DE LT HL
 RET
*
*********************
*
*    SPACE REVERSE
*
SPAB LHLD FNBD
SPABX XCHG .  DE HAS NBD
 LHLD UBC
 CALL UPCNT  HL GETS MIN OF DE,HL
*
*  HL = MAX COUNT, THIS BUFFER
*  SCAN BACKWARD FOR DEL
*
 LDA DELFG
 ORA A
 JZ SPA69  NO DELIMITER TO LOOK FOR, SKIP THIS JUNK
*
*   CHECK FOR DELIMITER BACKWARDS
*
 PUSH H
 MOV B,H
 MOV C,L  BC = MAX COUNT
 LHLD TBUFA
 XCHG
 LHLD FNBD
 DAD D  HL -> BUFFER END (NEXT CHAR)
*
SPA60 MOV A,B
 ORA C  CHECK FOR ZERO COUNT
 JZ SPA63  YES, END OF BUFFER, NOT FOUND
 DCX H
 LDA UL  = DELIMITER
 CMP M
 DCX B
 JNZ SPA60  TRY AGAIN
 INX B  RESTORE THE COUNT
*
*   FOUND THE DELIMITER...TIME TO QUIT
*
SPA65 POP H
 CALL RWPS  HL = HL - BC
 MVI A,1
 STA DELFG  SET DELIM FOUND FLAG
*
*  UPDATE NBD
*
SPA69 XCHG .  BUFFER ADDRESS TO DE
 LHLD FNBD  OLD BUFFER DISPLACEMENT
 CALL ARITH  HL=HL-DE
 SHLD FNBD
*
*  UPDATE USER COUNT (UBC)
*
 LHLD UBC
 CALL ARITH  HL=HL-DE
 SHLD UBC
 ORA L  IS COUNT ZERO? A HAS H FROM ARITH
 JZ SPA80  YES, GO QUIT
*
 LDA DELFG
 DCR A
 JNZ SPA81  DELIMITER NOT FOUND
*
*  DONE, END OF COUNT OR DELIMITER FOUND
*
SPA80 CALL RBUF  RELEASE BUFFER
 JMP NRET
*
*
*  READ LAST SECTOR
*
SPA81 LHLD FBLKS
 XCHG
 LHLD TBUFA
 CALL DVBR  READ LAST BLOCK
 DB DTRLB
*
 JMP SEOF  EOF
 SHLD FBDL  SET SIZE
 SHLD FNBD  AND PTR TO END
 JMP SPABX  CONTINUE
*
*
* NOT FOUND IN THIS BUFFER
*
SPA63 POP H
 JMP SPA69  MAKE LIKE NOTHING HAPPENED
*
*
*    EOF
*
SEOF CALL RBUF
 CALL ERRL2  ERROR
 DB EREOF
*
EOFER EQU SEOF
RBEOF EQU SEOF
*
 PAGE
*
*
*******************************************
*
*
*
*
*                CLOSE FILE OPERATION
*
*    UA HAS FILE NUMBER
*    THE FCB IS RELEASED
*
*    ERRORS:
*       ILLEGAL FILE NUMBER
*
*
*
CLOSE LDA UA  GET FILE NUMBER
 LXI H,SYSFIL
 CMP M
 JC NRET  OK, IT'S DONE BUT NOT SO!!!
 CALL PFCB
 CALL CLOSIT  CLOSE THE FILE
 JMP NRET  DONE
*
*********************
*
*
*       CLOSE FILE SUBROUTINE
*
*  COME HERE WITH CURRENT FCB SET
*
CLOSIT CALL CLBUF  CLOSE BUFFER
 LHLD FDLTA
 MOV A,H
 ORA L  NO CHANGE... NOT NEEDED
 JZ CLO30
 LHLD FID
 CALL SDIRX  SEARCH DIRECTORY BY ID
*
*    UPDATE FILE SIZE
*
 LHLD DBUF
 LXI D,DENBL-DEBUF  DISPLACEMENT TO SIZE
 DAD D
 XCHG
 LHLD FDLTA  GET NUMBER BLOCKS ALLOCATED
 LDAX D
 ADD L  UPDATE
 STAX D  FILE
 INX D  SIZE
 LDAX D  IN
 ADC H  BLOCKS
 STAX D
 CALL WDSK  REWRITE DIRECTORY
*
CLO30 LXI H,0
 SHLD FID  RELEASE THE FILE CONTROL BLOCK
 RET
*
*********************
*
*
*    WRITE DIRTY BLOCK AND DEALLOCATE BUFFER
*
CLBUF LHLD FBUFA
 INX H
 MOV A,H
 ORA L
 RZ .  UNBUFFERED, NOTHING TO DO
 DCX H
 SHLD TBUFA  SET TBUFA FOR UTILITIES
 CALL WDBUF  FLUSH BUFFER
 CALL DVBR  TAKE CLOSE DRIVER
 DB DTCLO  ENTRY
*
*    COME HERE TO JUST RELEASE BUFFER
*
CLBUX LHLD FBUFA
 INX H
 MOV A,H
 ORA L
 RZ .  UNBUFFERED, QUIT
 DCX H
 XCHG .  DE HAS BUFFER ADDRESS
 LHLD MINAD  HL HAS BOTTOM OF SYS GLOBAL
 CALL COMP
 RC .  DE LT HL, USER BUFFER
 LXI H,SYSTOP  NOW TOP OF SYSTEM
 CALL COMP
 RNC .  DE GT HL USER BUFFER
*
*  RELEASE BUFFER
*
 LHLD FBLKS
 XCHG .  DE HAS SIZE, HL HAS ADDRESS
 CALL DLBUF  DEALLOCATE BUFFER
 RET
*
 PAGE
*
*
*******************************************
*
*
*
*                   CLOSE MULTIPLE FILES
*
*     UA = UNIT #<0-254>  CLOSE ALL ON UNIT SPECIFIED
*        = 255            CLOSE ALL OPEN FILES
*
*     ERRORS:  NONE OTHER THAN DISK
*
*
CA MVI A,0
 STA CLCNT  COUNT UP FROM ZERO THROUGH FCB'S
 LHLD FCBASE  START AT FIRST FCB
*
*   LOOP HERE WITH NEXT FCB (PNTR ON TOS)
*
CA20 PUSH H  SAVE FCB POINTER
*
*  SEE IF FILE # < SYSFIL
*
 LXI H,SYSFIL
 LDA CLCNT
 CMP M  IS FILE# < SYSFIL?
 JC CA50  YES, SKIP
 POP H
 PUSH H  RESTORE HL
*
*  CHECK FILE ID FOR A OPEN FILE FCB (REAL? OOOBOY)
*
 LXI D,FID-FCBORG
 DAD D  MOVE TO FID BYTES
 MOV A,M
 INX H
 ORA M  CHECK IF ID=0
 JZ CA50  YES, SKIP IT
*
*  CHECK IF DESIRED UNIT
*
 LXI D,FUNIT-FID-1
 DAD D  MOVE TO UNIT NUMBER
 LDA UA
 CPI 255  CLOSE ALL
 JZ CA30  YES
 CMP M  CHECK IF THIS UNIT
 JNZ CA50  NOT THE ONE, LEAVE OPEN
*
*  CLOSE CURRENT FILE
*
CA30 POP H  GET POINTER TO FCB
 PUSH H
 CALL PFC6  SETUP FCB
 CALL CLOSIT  CLOSE THE FILE
 CALL RFCB  RESTORE FCB
*
*  MOVE TO NEXT FILE
*
CA50 LXI H,CLCNT  --> COUNTER
 INR M  COUNT UP
 LDA NFCB  = # OF FCB'S
 CMP M  HAVE WE DONE EM ALL?
 JZ NRET  YES, DONE
*
*  STILL MORE
*
 POP H
 LXI D,LNFCB
 DAD D  MOVE TO NEXT FILE
 JMP CA20  AND LOOP
*
 PAGE
*
*
*******************************************
*
*
*
*                 ENDFILE OPERATION
*
*    UA HAS FILE NUMBER
*
*    ERRORS:
*       ILLEGAL FILE NUMBER
*       PROTECTED FILE
*
*
EOF CALL PFCB  PREPARE FCB
 CALL PROTST
 DB PWRI
 JMP RER0  ERROR - PROTECTED FILE
 CALL PBUF  PREPARE BUFFER
 LHLD FNBD
 SHLD FBDL  SET BDL TO CURRENT POINTER
 XCHG
 LHLD TBUFA  DE=CT, HL=BUF
 CALL DVBR  CALL DRIVER
 DB DTEOF
*
EOF1A CALL WDB50  CLEAR THE DIRTY FLAG
 CALL RBUF  RELEASE BUFFER
 JMP NRET  RETURN
*
*********************
*
*
*  DISK FILE CLOSE (PART OF DISK INTERFACE)
*
DDEOF LHLD FID
 CALL SFCBS
 JMP RER0  OPEN MORE THAN ONCE, ERROR
 JMP EOF10  OPEN ONCE, OK
*
EOF10 LHLD FFORE
 SHLD ETMP  SAVE FORE PTR
 LHLD FNBD
 SHLD FBDL  SET BDL,ALSO
 MOV A,H
 ORI 128  SET HIGH BIT
 MOV H,A
 SHLD FFORE  SET EOF AND BYTE COUNT
 LHLD FCURSC
 SHLD ECRS  SAVE CURRENT SECTOR
 CALL WBLK  WRITE BLOCK
*
*  RELEASE ALL  BLOCKS PAST THIS ONE
*
 LHLD ETMP
 SHLD FFORE  RESTORE FORE PTR
*
EOF20 CALL DDRNB  MOVE TO NEXT BLOCK
 JMP EOF50  EOF, DONE
 CALL RFBLK  RELEASE BLOCK
 JMP EOF20  MOVE TO NEXT
*
*
EOF50 LHLD FINDX  GET INDEX FILE
 MOV A,H  IS THERE AN INDEX
 ORA L
 JZ EOF60  NO, DONE
 CALL RBUF  RELEASE BUFFER
 CALL RFCB  YES,RESTRE FCB, THEN
 JMP RNDOM  UPDATE INDEX
*
*
EOF60 LHLD FCURSC  TEST IF AT CORRECT BLOCK
 XCHG
 LHLD ECRS
 CALL COMP
 JZ EOF70  DON'T READ
 SHLD FCURSC
 CALL RBLK  RESTORE CURRENT BLOCK
 SHLD FBDL  SET BDL
*
EOF70 LHLD FBDL
 SHLD FNBD  SET NBD
 JMP EOF1A
*
*
EOFE0 EQU RER0  PROTECTED FILE
*
*
 PAGE
*
*
*******************************************
*
*
*
*
*          FILE INFORMATION REQUEST OPERATION
*
*
*    UDE POINTS TO NAME
*    UHL HAS DATA BLOCK ADDRESS
*
*    ERRORS:
*       FILE DOES NOT EXIST
*       FILE IS PROTECTED
*
*
FINFO LHLD UDE
 CALL SDIR  SEE IF NAME EXISTS
 JMP FIN90  WE RETURN HERE IF NOT
*
*    IT EXISTS.....CHECK FOR OVERWRITE INTO SYSTEM
*
 LXI D,DRESZ+3  SIZE
 LHLD UHL  USER SPECIFIED ADDRESS
 CALL MEMCHK
*
*  OK, COPY DIREC ENTRY
*
 LXI D,DEFID  -> FILE ID
 LHLD UHL  HL POINTS TO USER AREA
 CALL MOVEF  MOVE
 DB DENBL-DEFID+2  THIS MANY WORDS
*
 LXI D,DETYP  -> FILE TYPE
 LHLD UHL
 LXI B,DENBL-DEFID+3+2
 DAD B
 CALL MOVEF  MOVE CREATE PARM PART
 DB DEPRO-DETYP+1
*
 LHLD DBUF  -> NAME
 XCHG
 LHLD UHL
 LXI B,DENBL-DEFID+3+2+DEPRO-DETYP+1
 DAD B
 CALL MOVEF  MOVE NAME
 DB NMLEN
*
*  SEE IF FILE IS OPEN
*
 LHLD DBUF
 LXI D,DEFID-DEBUF
 DAD D  HL POINTS TO FILE ID
 MOV E,M
 INX H
 MOV D,M
 XCHG .  HL HAS FILE ID
 CALL SFCBS  SEARCH....TRIPLE LEVEL RETURN
 JMP FIN20  YES
 JMP FIN20  YES
 XRA A  NO
 JMP FIN21
*
*
*  "A" HAS NUMBER OF FCBS
*
FIN20 MVI A,1  YES
FIN21 LHLD UHL  STORE A 1 PAST DIREC ENTRY
 LXI D,DENBL-DEFID+3
 DAD D
 MOV M,A
 XRA A  =0
 LXI D,NMLEN+DEPRO-DETYP+1+1+1
 DAD D
 MOV M,A  PUT ZERO BYTE AFTER NAME
 JMP NRET  ALL DONE
*
*
FIN90 CALL ERRL2
 DB ERNEX  NONEXISTENT
*
 PAGE
*
*
*******************************************
*
*
*
*
*                 ALTER FILE CHARACTERISTICS OPERATIONS
*
*
*  USER DE ALWAYS POINTS TO NAME
*
*
*
*     CHANGE FILE TYPE OPERATION
*
*  ON CALL  USER H HAS NEW TYPE
*
*  ERRORS:
*       FILE DOES NOT EXIST
*       FILE IS PROTECTED
*
CHTYP CALL FFILE  CHECK FOR PROTECTION (NAME AND TYPE)
 DB PNAT
 LDA UH
 STA DETYP  CHANGE TYPE
 JMP UWFIL  FINISH UP
*
*********************
*
*
*    CHANGE ATTRIBUTES OPERATION
*
*  USER H HAS NEW ONES
*
CHATR CALL FFILE
 DB PATR
 LDA UH
 STA DEPRO  SET NEW PROTECTION
 JMP UWFIL
*
*********************
*
*
*    CHANGE NAME OPERATION
*
*  USER HL POINTS TO NEW NAME
*
CHNAM LHLD UHL
 CALL SDIR  SEE IF NEW NAME EXISTS
 JMP CHN20  NO
 CALL ERRL1  YES
 DB ERAEX  FILE ALREADY EXISTS
*
*
CHN20 LDA FUNIT  GET DEFAULT UNIT
 PUSH PSW
 CALL FFILE  SET UP
 DB PNAT
*
*  MOVE IN NEW NAME
*
 POP H  H=UNIT
 LDA FUNIT
 CMP H  SAME?
 JNZ CHER1  NO, UNIT CONFLICT
 LHLD UHL
 CALL NAMIN  READ IN NAME
*
*  UPDATE DIRECTORY ENTRY FROM DEBUF, THEN
*  REWRITE DIRECTORY SECTOR AND RETURN.
*
UWFIL LXI D,DEBUF
 LHLD DBUF
 CALL MOVEF  MOVE ENTRY BACK
 DB DRESZ
 CALL WDSK  WRITE IT OUT
 JMP NRET  THEN GO.
*
*
*    SEARCH FOR FILE AND SET UP
*
FFILE LHLD UDE  HL POINT TO NAME
 CALL SDIR
 JMP KIL90  NONEXISTENT
 POP H
 LDA DEPRO
 ANA M
 INX H
 JNZ CHER0  ERROR...PROTECTED
 PCHL .  OK, RETURN CALL+1
*
*
CHER0 CALL ERRL1  ERROR
 DB ERPRO
*
CHER1 CALL ERRL1  UNIT CONFLICT
 DB ERUCN
*
 PAGE
*
*
*******************************************
*
*
*
*
*                     SEEK OPERATION
*
*
*   USER A   HAS FILE NUMBER
*   USER B = 0 => HL = BYTE#
*         <> 0 => HL = BLOCK#
*   USER HL  HAS REQUESTED BYTE NUMBER
*
*   ERRORS:
*           DEVICE FILE
*           FILE NOT RANDOM
*           TOO FAR IN FILE
*           EOF
*
*
SEEK CALL PFCB
 CALL PBUF  PREPARE BUFFER
 LHLD UHL
 PUSH H  SAVE SEEK ADDRESS
 LHLD FBLKS
 XCHG
 LHLD TBUFA
 LDA UB  GET BLOCK OPTIONS
 CALL DVBR
 DB DTSEK  GO SEEK
 JMP SEKE1  OUT OF RANGE
*  CALL TO DVBR RETURNS HERE IF OK
 SHLD FBDL  SET BDL
 XCHG
 SHLD FNBD  AND NBD
 CALL RBUF  DONE
 JMP NRET
*
*********************
*
*
*     DISK INTERFACE FOR SEEK
*
*  CHECK IF RANDOM INDEX EXISTS
*  THEN READ IT INTO DIRECTORY BUFFER IF NOT ALREADY IN
*  MEMORY
*
DDSEK LHLD FAIND  SEE IF INDEX IN MEMORY
 SHLD RINAD  ASSUME LOADED
 INX H  (ITS -1 IF NOT)
 MOV A,H
 ORA L
 CZ RINDX  LOAD AND SET RINAD IF NOT
*
*    COMPUTE QUOTIENT AND REMAINDER OF UHL/FBLKS
*
 LHLD FBLKS
 MOV B,H
 MOV C,L  BC IS BLOCK SIZE
 POP H  =RETURN ADDRESS
 XTHL .  HL=SEEK POINT, STACK= RETURN ADDRESS
 LXI D,0  DE HAS QUOTIENT..IT WILL,IT WILL
*
*    CHECK FOR SEEK BLOCK
*
 LDA UB  GET OPTION...BLOCK OR BYTE
 ORA A
 JZ SEK10  NO BYTE
 XCHG .  DE = BLOCK#
 LXI B,0
 LXI H,0  SET SO NBD = 0 EVENTUALLY
 JMP SEK20
*
*
*   GO TO INDIVIDUAL BYTE
*
SEK10 CALL RWPS  HL = HL - BC
 INX D
 JNC SEK10
 DCX D
*
*  GOT IT
*
SEK20 MOV A,D
 ORA A
 RNZ .  ERROR, REQUESTED BLOCK .GT. 256
 MOV A,E
 CPI 250
 RNC .  ERROR, ITS GE 250
 DAD B  HL IS REMAINDER
 PUSH H  SAVE IT AS FUTURE NBD
*
*  NOW FETCH INDEX ENTRY
*
 LHLD RINAD  -> INDEX BLOCK
 DAD D
 DAD D  HL POINTS TO APPROPRITE ONE
*
*  PICK IT UP
*
 MOV E,M
 INX H
 MOV D,M
 PUSH D  SECTOR/TRACK OF DISK ADDRESS
 PUSH H  INDEX BLOCK ADDRESS
 LHLD FCURSC  GET CURRENT SECTOR/TRACK
 CALL COMP  COMPARE
 PUSH PSW  SAVE FLAGS FOR LATER
 CNZ WDBUF  WRITE OUT DIRTY BUFFER IF NOT SAME ADDRESS
 POP PSW
 POP D  INDEX ADDRESS
 POP H  DISK ADDRESS
 PUSH PSW
*
*  IS DISK ADDRESS IN EXISTENCE YET
*
 MOV A,H
 ORA L
 JZ SEX  NO, PAST EOF ERROR, PROBABLY
*
*  HL HAS ADDRESS OF NEW CURRENT BLOCK, NBD ON TOP OF STACK
*
 SHLD FCURSC  SAVE AS CURRNT ADDRESS
 POP PSW
 LHLD FBDL  IN CASE WE DON'T READ IN THE BLOCK
 CNZ RBLK  READ NEW BLOCK
 POP D
*
* DE=NBD, HL=BDL; CHECK NBD .LE. BDL
*
 CALL COMP
 JZ RX2  OK, WE'RE AT THE EOF
 JC RX2  OK, WE'RE NOT AT THE EOF, BUT IN THE FILE
 RET .  EOF ERROR, WE'VE GONE TOO FAR
*
*********************
*
*
*  THERE ARE SOME NASTY SPECIAL CASES ABOUT SEEKING
*  TO THE END OF FILE.  IT IS OK TO SEEK TO LAST BYTE +1,
*  BUT, UNFOUTUNATELY, A SPECIAL TEST MUST BE MADE TO
*  FORCE THE CURSOR INTO THE LAST LEGAL BLOCK INSTEAD
*  OF THE NEXT, NOT-YET-EXISTENT BLOCK.
*
*  ADDRESS DIDN'T EXIST, SEE IF ALTERNATE ADDRESS AT
*  END OF LAST BLOCK APPLIES.
*
* FIRST, SETUP FOR PREVIOUS SECTOR
*
SEX XCHG .  HL -> 1 BEYOND CURRENT
 DCX H
 DCX H
 POP PSW
 MOV A,M  FOR H LATER
 DCX H
 MOV L,M
 MOV H,A
 ORA L  TEST FOR EXISTENCE
 POP D  KEEP STACK CLEAN
 RZ .  NO, WE'RE DEFINITLY BEYOND EOF
 SHLD FCURSC  WELL, MAYBE OK, LAST BLOCK EXISTS
*
* SEE IF NBD WAS ZERO, IF SO, COULD ALSO USE BDL OF LAST BL
*
 MOV A,D
 ORA E
 RNZ .  NOT ZERO, OUT OF RANGE
*
* OK, LOAD LAST BLOCK, SET NBD=BDL, BUT ERR IF NOT FULL
*
 CALL RBLK
 XCHG
 LHLD FBLKS  BDL MUST = BLOCK SIZE, ELSE OUT OF RANGE
 CALL COMP
 JZ RX2  OK
 RET .  NO, GO BACK WITH ERROR
*
*
SEKE0 CALL ERRL1  FILE NOT RANDOM
 DB ERRAC
*
SEKE1 CALL ERRL1  SEEK ADDRESS OUT OF RANGE
 DB ERSEK
*
*********************
*
*
*           READ FILE INDEX
*
*  ENTER AT RINDX TO READ INTO DIBUF
*  ENTER AT RINDY WITH HL -> WHERE TO LOAD
*  LOAD INDEX AND SET RINAD TO -> INDEX IN EITHER CASE
*
RINDX LXI H,DIBUF
RINDY SHLD RINAD  SET LOAD ADDRESS
 LHLD FINDX  INDEX ADDRESS
 MOV A,H
 ORA L
 JZ SEKE0  ITS ZERO, ERROR
*
 CALL STDAD  SET XFER DESC....
 LHLD FINDX
 SHLD TDAD
 LXI H,SECTSZ  BLOCKSIZE IS 500 OR ELSE
 SHLD TBCNT
 LHLD RINAD
 SHLD TBUF  READ INTO SPECIFIED ADDRESS
 JMP RDSK  READ INDEX AND RETURN
*
 PAGE
*
*
*******************************************
*
*
*
*              MAKE FILE RANDOM OPERATION
*
*
*  CREATE IF NECESSARY AND UPDATE INDEX BLOCK
*
*
*  USER A HAS THE FILE NUMBER
*
*    ERRORS:
*            DEVICE FILE
*
*
RNDOM CALL PFCB  PREPARE FCB
 LDA FTYPE  CHECK FOR DEVICE FILE
 INR A
 JZ RNER0  YES...ERROR
 CALL PBUF  PREPARE BUFFER
 CALL WDBUF  CLEAN IT UP
*
*  READ FIRST BLOCK
*
 LHLD FFBA
 SHLD FCURSC
 CALL RBLK
*
*  ZERO THE DIRECTORY BUFFER..DIBUF
*
 MVI D,0
 LXI B,SECTSZ   COUNT=SECTSZ
 LXI H,DIBUF
 SHLD RNPTR  RNPTR IS ''DIBUF''
*
RND10 MOV M,D  ZERO A WORD
 INX H
 DCX B  COUNT DOWN
 MOV A,B
 ORA C
 JNZ RND10
*
*  CHECK IF FILE ALREADY HAS AN INDEX
*
 LHLD FINDX
 MOV A,H
 ORA L
 JNZ RND20  YES...
*
*  ALLOCATE AN INDEX BLOCK FOR THE FILE
*
 LHLD FBLKS
 PUSH H  SAVE BLOCK SIZE
 LXI H,SECTSZ
 SHLD FBLKS
 CALL AFBLK  ALLOCATE INDEX BLOCK
 SHLD FINDX  SAVE ITS ADDRESS
 POP H
 SHLD FBLKS  RESTORE BLOCK SIZE
*
*  NOW READ THROUGH THE FILE AND NOTE THE ADDRESS
*  OF EACH BLOCK IN THE INDEX
*
RND20 MVI A,250
 STA RNCNT  250 MAX
*
*  DO NEXT BLOCK
*
RND30 LHLD FCURSC
 XCHG
 LHLD RNPTR
 MOV M,E  STORE CURENT SECTOR ADDRESS
 INX H
 MOV M,D  INTO MAP
 INX H
 SHLD RNPTR  UPDATE MAP POINTER
 LDA RNCNT
 DCR A  DECREMENT COUNT
 STA RNCNT
 JZ RND35  DONE 128, MOVE TO EOF
*
*  MOVE TO NEXT BLOCK
*
 CALL DDRNB
 JMP RND40  EOF, DONE
 JMP RND30
*
*
*  SPACE UNTIL EOF
*
RND35 CALL DDRNB
 JMP RND40  EOF
 JMP RND35  MOVE TO NEXT BLOCK
*
*  NOW WRITE OUT MAP...ID IS SET IN TFID.,SO IS UNIT
*
RND40 SHLD FBDL
 SHLD FNBD  SET AT EOF
 LHLD FINDX
 SHLD TDAD
 LXI H,DIBUF
 SHLD TBUF
 LXI H,SECTSZ  GET STANDARD SECTOR SIZE
 SHLD TBCNT
 CALL WDSK
*
* UPDATE INDEX SAVED IN MEMORY, IF ANY
*
 CALL UPIM
*
*  UPDATE DIRECTORY INDEX POINTER
*
 LHLD FID
 CALL SDIRX  SEARCH FOR FILE
 LHLD DBUF  POINTS TO ENTRY FOR FILE
 LXI D,DEINX-DEBUF
 DAD D
 XCHG
 LHLD FINDX  PUT IN INDEX ADDRESS
 MOV A,L
 STAX D
 INX D  LOW
 MOV A,H
 STAX D  HIGH
 CALL WDSK  REWRITE DIRCTORY
*
*  THATS IT
*
 CALL RBUF  RELEASE BUFFER
 JMP NRET
*
*
RNER0 CALL ERRL1  DEVICE FILE RANDOM OPERATION
 DB RERR0
*
*********************
*
*
*  UPDATE INDEX POINTED TO BY FAIND, IF ANY
*  MAKE A COPY OF DIBUF INTO IT
*
UPIM LHLD FAIND
 INX H  FAIND = -1 IF NONE
 MOV A,H
 ORA L
 RZ .  NONE TO DO
 DCX H  -> MEMORY COPY OF INDEX
 LXI D,DIBUF  -> MASTER COPY
 LXI B,SECTSZ
 CALL MOVEV  MOVE IT
 RET .  SIMPLE, NO?
*
 PAGE
*
*
*******************************************
*
*
*
*                  ABORT OPERATION
*
*
*  TYPE ERR FOLLOWED BY THE CONTENTS OF USER A,
*           USER B, AND USER HL.
*
*  RETURN TO THE SYSTEM THROUGH SRESET.
*
*
ABURP CALL OUST  TYPE CR LF ERR
 DB CR
 DB LF
 ASC 'ERR: '
 DB 0
 LDA UA
 CALL OUT8B  TYPE A
 LDA UB
 CALL OUT8B  TYPE B
 CALL O16N  TYPE HL
 DW UHL
 JMP SRESET  RETURN THRU SRESET
*
*********************
*
*
* PRINT THE 16 BIT NUMBER POINTER TO BY CALL+1,
*  PRECEEDED BY A BLANK.
*  RETURN PAST THE POINTER
*
O16N MVI A,BLNK
 CALL CONOUT
 POP H  -> POINTER
 MOV E,M
 INX H
 MOV D,M  DE = POINTER
 INX H
 PUSH H  UPDATE RETURN
 XCHG
 MOV E,M
 INX H
 MOV D,M
 XCHG .  = NUMBER
*  FALL INTO OUT16
*
*   OUTPUT THE 16 BIT NUMBER IN HL
*
OUT16 MOV A,H
 CALL OUT8
 MOV A,L
*
*  OUTPUT 8 BIT NUMBER
*
OUT8 MOV C,A
 RAR
 RAR .  OVER IT GOES
 RAR
 RAR
 CALL OUT8A
 MOV A,C
*
*
OUT8A ANI 15
 ADI 48
 CPI 58
 JC CONOUT  IT WAS A NUMBER, OUTPUT IT AND RETURN
 ADI 7
 JMP CONOUT
*
*
*   OUTPUT A 8 BIT NUMBER FOLLOWED BY A BLANK
*
OUT8B CALL OUT8
 MVI A,BLNK  NOW THE SPACE
 JMP CONOUT  OUTPUT IT AND RETURN
*
*
*   OUTPUT ASCII MESSAGE FOLLOWING CALL TO ZERO BYTE
*
OUST POP H
OUST5 MOV A,M  FETCH CHAR
 INX H
 ORA A
 JZ OUST9  ZERO BYTE, RETURN
 CALL CONOUT  TYPE CHAR
 JMP OUST5
*
OUST9 PCHL
*
 PAGE
*
*
*******************************************
*
*
*
*                  SET UNIT OPERATION
*
*  UA HAS THE DESIRED UNIT NUMBER
*
*    ERRORS:
*       ILLEGAL UNIT NUMBER
*
*
SUNH LDA UA
 LXI H,MAXUN  POINT TO MAXIMUM UNIT NUMBER
 CMP M
 JNC SUNER  YES, IT IS ILLEGAL
 STA DUNIT  NO, SET UNIT,DEFAULT
 JMP NRET
*
*
SUNER CALL ERRL1
 DB UNER0  ILLEGAL UNIT
*
 PAGE
*
*
*******************************************
*
*
*
*
*            FILE CONTROL STATUS CHECK
*
*   UA HAS THE FILE NUMBER
*
FCTRL CALL PFCB  PREPARE
 LHLD UDE  LOAD A, DE, HL
 XCHG
 LHLD UHL
 LDA UB
 CALL DVBR  CALL DRIVER
 DB DTCTL
*
 SHLD UHL  SAVE REGISTERS
 XCHG .  FOR
 SHLD UDE  RETURN
 STA UA
 JMP NRET
*
*********************
*
*
*                    ALLOCATE BUFFER
*
*        DE HAS DESIRED SIZE
*        CALL ALBUF
*        RETURN HL HAS THE BUFFER
*
*  MINAD-DE IS USED, MINAD IS UPDATED
*  ABORT EXIT IF NO SPACE
*
ALBUF LHLD MINAD  GET LOWEST ADDRESS IN USE
 CALL ARITH  HL=HL-DE
 XCHG
 SHLD WBUFSZ  SAVE SIZE FOR ERROR DEALLOCATION
 LHLD LOWAD  GET LOWEST ALLOWED ADDRESS
 CALL COMP  PASSING MIN ADDR?
 JC ALB9  NEW MIN LT LOWAD, MEM OVERFLOW
 XCHG
 SHLD MINAD
 SHLD WBUFAD  SAVE FOR ERROR DEALLOCATION
 RET
*
*
*  ABORT, NO SPACE IS AVAILABLE
*
ALB9 LXI H,0
 SHLD WBUFSZ  CLEAR TO AVOID SCREW-UPS
 CALL ERRL1
 DB MER0
*
*********************
*
*
*       COMPARE DE AND HL
*
*  DE,HL ARE UNCHANGED
*
*  CARRY IF HL > DE  UNSIGNED
*  ZERO  IF HL = DE
*
COMP MOV A,D
 SUB H
 RC
 RNZ
 MOV A,E
 SUB L
 RET .  SIGN AND ZERO SET
*
*********************
*
*
*             PROTECTION TEST (PROTEST)
*
*  CURRENT FCB IS SET
*      CALL PROTST
*      BIT(S) TO TEST
*      RETURN, NO (NONZERO RESULT)
*      RETURN, OK (ZERO RESULT)
*
*
PROTST POP H  GET RETURN ADDRESS, POINTER TO PROTECTION
 LDA FPROT  GET FILE ATTRIBUTES
 ANA M  MASK AND TEST
 INX H  MOVE PAST TEST WORD
 JZ RP3  OK...RETURN PAST IT
 PCHL .  RETURN, PROTECTION SET
*
*
*
*********************
*
*
*            MOVE MEMORY ROUTINES
*
*    DE HAS SOU ADDRESS, HL HAS DEST ADDRESS
*       CALL MOVEF
*       MOVE COUNT
*       RETURN
*
*
MOVEF XTHL .  GET RETURN ADDRESS
 MOV C,M  IT POINTED TO THE COUNT
 INX H  MOVE UP RETURN
 XTHL .  PUT IT BACK
 XRA A
 MOV B,A  BC HAS COUNT
 JMP MOVEA
*
*********************
*
*
*    MOVE VARIABLE SIZE BLOCK
*
*  BC HAS COUNT, DE HAS SOURCE, HL HAS DESTINATION
*  CALL MOVEV
*  RETURN
*
MOVV1 LDAX D
 MOV M,A
 INX H  BUMP POINTERS
 INX D
 DCX B
MOVEV MOV A,B
MOVEA ORA C
 JNZ MOVV1
 RET
*
*********************
*
*
*
*                  PREPARE FCB
*
*  UA HAS FCB NUMBER
*  CALL PFCB
*  RETURN FCB   FRADD SET
*  ABORT IF ILLEGAL FCB NUMBER
*
*
PFCB LDA NFCB  GET NUMBER OF FCB'S
 MOV B,A
 LDA UA  GET FILE NUMBER DESIRED
 CMP B
 JNC PFC90  ERROR, TOO BIG
*
 LHLD FCBASE  BOTTOM OF FCB'S
 LXI D,LNFCB  LENGTH OF EACH ONE
 ORA A
 JZ PFC6  FILE "0" NO ADDING NEEDED
*
PFC5 DAD D  MOVE TO NEXT FCB
 DCR A
 JNZ PFC5
*
*
*   SPECIAL ENTRY POINT FOR CLOSE ALL OPERATION
*
*      ENTER WITH HL--> FCB
*
PFC6 SHLD FRADD  SAVE THE FCB ADDRESS
 XCHG
 LXI H,FCBORG  MAKE A COPY TO FCBORG
 CALL MOVEF  MOVE IT
 DB LNFCB
*
*  CHECK IF UNOCCUPIED
*
 LHLD FID
 MOV A,H
 ORA L
 RNZ .  NON ZERO ID, OK
*
PFC90 CALL ERRL1  ERROR
 DB ERUFN
*
*********************
*
*
*    IF BUFFER IS DYNAMIC RELEASE IT
*
*  CURRENT FCB IS SET
*  CALL RBUF
*  RETURN
*
RBUF LHLD FBUFA
 INX H
 MOV A,H
 ORA L
 RNZ .  FILE IS NOT UNBUFFERED
*
*  RELEASE BUFFER
*
 CALL WDBUF  WRITE DIRTY BUFFER
 LHLD FBLKS
 XCHG .  DE HAS SIZE
 LHLD TBUFA  HL HAS ADDRESS
 CALL DLBUF  DEALLOCATE
 LXI H,0
 SHLD TBUFA  ZERO BUFFER POINTER
 RET
*
*********************
*
*
*        NAMIN, PROCESS IN A NAME
*
*    HL POINTS TO NAME
*    CALL NAMIN
*
*    NAME IS ASSEMBLED INTO DEBUF
*    FUNIT IS SET
*
*  FIRST ZERO OUT NMLEN BYTES
*
NAMIN LXI D,DEBUF
 MVI B,NMLEN
 XRA A
*
NAM05 STAX D
 INX D
 DCR B
 JNZ NAM05
 LXI D,DEBUF  PUT IT HERE
 MVI B,NMLEN+1  MAXCOUNT+1
*
*
*  LOOP HERE WITH:  DE--> NEXT CHARACTER POSITION
*                   B =   NUMBER OF CHARACTERS REMAINING
*                   HL--> NEXT INPUT CHARACTER
*
NAM10 MOV A,M  PICKUP A CHAR
 CALL NAMTST
 JZ ICIN  ERROR!!
*
*  FALL THROUGH WITH LEGAL CHAR IN 'A'
*
NAM20 STAX D
 INX H
 INX D
 DCR B
 JNZ NAM10
*
*  ERROR--TOO MANY CHARACTERS
*
 CALL ERRL1
 DB ERNTL  NAME TOO LONG
*
*
*  ZERO BYTE FOUND (NAMTST COMES HERE)
*
NAM30 POP B  GET RID OF RET
 LDA DUNIT  USE DEFAULT UNIT
NAM31 STA FUNIT  AS FILE UNIT
 LDA DEBUF  CHECK FOR NULL NAME
 ORA A
 RNZ .  IF OK
*
ICIN CALL ERRL1
 DB ERINM  ILLEGAL NAME
*
*
*  FOUND UNIT, PICK IT UP
*
NAM40 POP B
 INX H
 MOV A,M  PICKUP CHAR
 ANI 127
 SBI '0'  SUBTRACT ZERO CHR
 JC ICIU  BAD CHAR
 LXI H,MAXUN  CHECK RANGE OF UNIT NUMBER
 CMP M
 JC NAM31  OK, SELECT IT
*
ICIU CALL ERRL1
 DB ERICU  UNIT ERROR
*
*********************
*
*
*   TEST A NAME CHARACTER IN "A"
*
*   RETURN IF NONSPECIAL LEGAL CHARACTER
*   ERROR  IF ILLEGAL CHARACTER
*
*   GO TO NAM30 OR NAM40 IF TERMINATOR FOUND
*   (RETURN DISPOSED OF)
*
NAMTST ANI 127  MASK DOWN
 JZ NAM30  END OF NAME
 CPI '/'  SLASH?
 JZ NAM40  SELECT UNIT
 CALL DLTST  CHECK FOR BAD CHARS
 RZ .  IF SO
*
 CPI '#'  THE OTHER ONES
 RZ .  BAD
 CPI ' '+1 SPACE
 JC ICIN  CONTROL CHAR OR SPACE
 CPI 127  NOT .EQ. OR .GT.
 RET .  LEGAL CHAR
*
 PAGE
*
*
*********************
*
*
*
*               SEARCH DIRECTORY
*
*
*   HL POINTS TO NAME, CURRENT DIREC SET ( ??? )
*
*      CALL SDIR
*      RETURN = NOT FOUND, DFC=BLOCK WITH ROOM OR 0 IF DIR FULL
*      RETURN = FOUND, DBUF POINTS TO ENTRY
*
SDIR CALL NAMIN  PROCESS NAME
 XRA A
 STA DRID  SET ID TO ZERO
 STA DRID+1
*
*  ALTERNATE ENTRY FROM SDIRX
*  COME HERE WITH A=0,DRID EQU FILE ID
*
SDI02 STA DFC  INITIALIZE
 STA DFC+1  FREE POINTER
*
*  READ FIRST SECTOR
*
 LXI D,DDSC
 LXI H,TDAD
 CALL MOVEF  SET TRANSFER DESCRIPTOR
 DB TBUF-TDAD+2
 LDA FUNIT
 STA TUNIT  DISK UNIT
*  READ
SDI07 CALL RDSK
*
*  SEE ABOUT FREE STUFF
*
 LHLD DFC
 MOV A,L
 ORA H
 JNZ SDI20  ALREADY FOUND ONE
 LDA DINE
 CPI DREMS
 JNC SDI20  SECTOR IS FULL
 LHLD TDAD
 SHLD DFC  SAVE AVAILABLE SECTOR
*
*  SET UP DIRECTORY SECTOR SEARCH
*
SDI20 LXI H,DRFDS  FIRST ENTRY ADDRESS
 SHLD DBUF  SAVE POINTER
 LDA DINE
 STA DCNT  SAVE COUNT
 ORA A
 JZ SDI70  SECTOR IS EMPTY, MOVE TO NEXT
*
*  LOOP AND TEST ENTRIES
*
SDI30 LHLD DRID
 MOV A,L
 ORA H
 JNZ SDI50  ITS A SEARCH BY ID
*
*  TEST NAME
*
 LXI D,DEBUF  USER NAME
 LHLD DBUF  NAME IN SECTOR
*
*  COMPARE STRINGS
*
 MVI B,NMLEN
SDI40 LDAX D
 CMP M
 JZ SDI44  MATHC ON THIS CHARACTER
*
*  TRY TO MATCH UPPER/LOWER CASE CHARACTERS
*
 CPI 97  ="a"
 JC SDI42  DEBUF CHARACTER NOT LOWER CASE
 SBI 32  DEBUF CHAR WAS LC, UPSHIFT AND TRY
 JMP SDI43  TO MATCH AGAIN
*
* DEBUF CHAR NOT LC,  TRY TO UPSHIFT DIREC CHAR
*
SDI42 MOV A,M
 CPI 97  ="a"
 JC SDI60  DIREC CHAR NOT LC, NO MATCH
 LDAX D  GET DEBUG CHAR
 ADI 32  DOWNSHIFT DEBUG CHAR TO TRY MATCH
*
* TRY ALTERNATE MATCH
*
SDI43 CMP M
 JNZ SDI60  NO, SECOND MATCH ATTEMPT FAILED
*
SDI44 INX D  MATCH
 INX H
 DCR B  MOVE TO NEXT CHARACTER
 JNZ SDI40
*
*  MATCH
*
SDI45 LHLD DBUF  MOVE ENTRY INTO
 XCHG
 LXI H,DEBUF  DEBUF
 CALL MOVEF
 DB DRESZ
 JMP RP2  RETURN TO CALL PLUS 2
*
*
*  MOVE TO NEXT ENTRY
*
SDI60 LDA DCNT
 DCR A  COUNT DOWN
 JZ SDI70  SECTOR EMPTY
 STA DCNT
 LHLD DBUF
 LXI D,DRESZ  MOVE POINTER
 DAD D
 SHLD DBUF
 JMP SDI30
*
*
*   MOVE TO NEXT SECTOR
*
SDI70 LHLD IHFOR  FORE POINTER
 MOV A,H
 ORA A
 RM .  EOF, FAIL
 SHLD TDAD  SET NEXT BLOCK
 JMP SDI07
*
*
*  CHECK FILE ID, NOT NAME
*
SDI50 LHLD DBUF
 LXI D,DEFID-DEBUF
 DAD D  HL POINT TO ID
 LDA DRID
 CMP M
 JNZ SDI60  NOT SAME
 INX H
 LDA DRID+1
 CMP M
 JNZ SDI60  NOPE
 JMP SDI45  YES, MATCH
*
*********************
*
*
*             SEARCH DIRECTORY BY ID
*
*    SAME AS SDIR BUT HL HAVE ID
*    ENTER AT SDIRY WITH A = UNIT#, ALSO
*
*   THE FILE MUST EXIST.  THE DIRECTORY ON WHICH THE
*   FILE EXISTS IS SEARCHED.
*
SDIRY STA FUNIT  SPECIAL ENTRY FOR "OPEN?"
SDIRX SHLD DRID  SAVE ID
 XRA A  SET A TO ZERO
 CALL SDI02  GO SEARCH
 CALL CI98  FILE MUST EXIST, OR ELSE!
 RET
*
*********************
*
*
*    DIRECTORY FILE DESCRIPTOR
*
DDSC DW DIRDB  READ OPCODE
DDSC2 DW SECTSZ
  DW IDDIR
  DW DIBUF
*
*********************
*
*
*     MAKE ENTRY IN DIRECTORY
*
*  DEBUF HAS ENTRY, DFC IS SET
*
EDIR LHLD DFC
 MOV A,L
 ORA H
 CZ CI98  BETTER NOT BE FULL!
*
*  READ SECTOR WITH FREE ENTRY
*
EDI10 SHLD TDAD  SAVE DISK ADDRESS
 LXI D,DDSC2
 LXI H,TBCNT
 CALL MOVEF
 DB TBUF-TBCNT+2
 LDA FUNIT
 STA TUNIT  UNIT
 CALL RDSK  READ SECTOR
*
*  MOVE IN ENTRY
*
 LXI D,DIBUF
 LHLD DIND  HL = NEXT DISPLACEMENT
 DAD D  HL = DESTINATION
 LXI D,DEBUF  DE = ENTRY BUFFER
 CALL MOVEF
 DB DRESZ
*
*  UPDATE HEADER
*
 LXI H,DINE
 INR M     NUMBER OF ENTRIES
 LHLD DIND
 LXI D,DRESZ
 DAD D
 SHLD DIND   NEXT ENTRY DISPLACEMENT
 CALL WDSK  RE WRITE THE ENTRY
 RET .  THATS ALL
*
*********************
*
*
*      REMOVE DIRECTORY ENTRY
*
*  DIBUF HAS SECTOR
*  DBUF  POINTS TO ENTRY
*  ALWAYS NORMAL RETURN
*
RDIR LXI H,DINE
 DCR M  UPDATE COUNT
 JZ RDI60  IT IS NOW ZERO, NOTHING TO MOVE
*
*    CALCULATE NUMBER OF WORDS TO MOVE
*
*
 LXI D,DIBUF
 LHLD DIND
 DAD D    HL=ADDR OF NEXT FREE DIR ENTRY
 LXI D,-DRESZ
 DAD D    SUBTRACT ONE ENTRY
 XCHG
 LHLD DBUF
 MOV A,E  CALCULATE BC=DE-HL =NO.OF BYTES TO BE MOVED
 SUB L
 MOV C,A
 MOV A,D
 SBB H
 MOV B,A
 ORA C
 JZ RDI60  NOTHING TO MOVE
 LXI D,DRESZ
 PUSH H  SAVE DBUF FOR DESTINATION
 DAD D  = SOURCE ADDRESS (DBUF+DRESZ)
 XCHG .  PUT IN DE
 POP H  = DESTINATION ADDRESS (DBUF)
 CALL MOVEV  RECALL THAT BC HAS COUNT
*
RDI60 LHLD DIND
 LXI D,-DRESZ  UPDATE NEXT ENTRY DISPLACEMENT
 DAD D
 SHLD DIND
 CALL WDSK  TDAD STILL IS SET, REWRITE
 RET
*
*********************
*
*
*        GET FILE ID
*
*  CURRENT LOGICAL UNIT DESCRIPTOR IS SET UP
*  CALL GFID
*  RET WITH ID IN DE
*  ABORT IF NO IDS ARE AVAILABLE
*
*  SET UP READ
*
GFID LXI D,NIDD
 LXI H,TDAD
 CALL MOVEF  SET TRANSFER DESCRIPTOR
 DB TBUF-TDAD+2
 LDA FUNIT
 STA TUNIT  UNIT.
 CALL RDSK  READ IT
*
 LHLD IDBUF
 PUSH H  SAVE ID
 INX H  INCREMENT
 MOV A,H
 ORA L
 JZ NOIDS  NO IDS LEFT, SERIOUS
 SHLD IDBUF  OK, REWRITE
 CALL WDSK
 POP D  PUT ID INTO DE
 RET
*
*
NOIDS POP D  GET RID OF IT
 CALL ERRL0
 DB ERNID  NO IDS LEFT
*
*********************
*
*
*    FSM DESCRIPTOR
*
NIDD DW DANIB BLOCK #
 DW NIDBC  BYTE COUNT
 DW IDNID  FILE ID
 DW IDBUF  BUFFER
*
*********************
*
*
*    WRITE BUFFER TO DEVICE IF DIRTY
*
WDBUF LDA FFLAG
 ORA A  TEST DIRTY FLAG
 RZ .  NOT DIRTY
*
 LHLD FBDL  THE LAST BYTE IN THE BUFFER
 XCHG
 LHLD TBUFA  SET HL=START ADDRESS, DE=LAST ADDRESS
 CALL DVBR  WRITE BLOCK
 DB DTWB
 JMP SEOF  EOF, ERROR
 JMP WDB50
*
*********************
*
*
*          READ NEXT BUFFER LOAD FROM DEVICE
*
* CLEAN BUFFERS, READ BLOCK, THEN SET NBD=0,
* AND BDL=INCOMING BLOCK SIZE
* COME WITH HL=BUFFER SIZE
*
RDNB PUSH H
 CALL WDBUF  CLEAN IF DIRTY
 POP D
 LHLD TBUFA
 CALL DVBR  READ NEXT
 DB DTRNB
 RET .  EOF ENCOUNTERED
 NOP
 NOP
 SHLD FBDL  SET BDL
 LXI H,0
 SHLD FNBD  NBD=0
 JMP RP2  RETURN CALL +2
*
*********************
*
*
*     WRITE CURRENT BUFFER AND LOAD NEXT
*
*  CALL WITH SIZE IN HL
*  SET NBD=0, BDL FROM DRIVER, FFLAG=0
*
WDBR XCHG
 LHLD TBUFA
 CALL DVBR  WRITE
 DB DTWBR
 JMP SEOF  EOF, ERROR
*
WDB45 SHLD FBDL  SET BDL
 LXI H,0
 SHLD FNBD  NBD=0
*
WDB50 XRA A
 STA FFLAG  FFLAG=0
 RET .  RETURN
*
*********************
*
*
*              DEVICE DRIVER BRANCH
*
*  CALL WITH CALL+1=OPERATION
*  PASS DE, HL, AND A TO THE DRIVER
*
DVBR XTHL
 MOV C,M  PICKUP DISPLACEMENT
 INX H  MOVE PAST IT
 MVI B,0  BC=DISPLACEMENT
 XTHL .  SAVE UPDATED RETURN
 PUSH H
 LHLD FDRIV
 DAD B  HL->DISPATCH ADDRESS
 MOV B,A
 MOV A,M  PICKUP FIRST PART
 INX H
 MOV H,M  THEN SECOND
 MOV L,A  HL=DISPATCH ADDRESS
 ORA H
 JZ IDAC  NO ZERO OPERATION.. ERROR
 MOV A,B
 XTHL .  RESTORE HL,
 RET .  THEN GO INTO DRIVER.
*
*********************
*
*
*            DISK DRIVER READ LAST BLOCK
*
DDRLB LHLD FBACK  GET BACK POINTER
 MOV A,H  TEST FOR BOF
 ORA A
 RM .  YES, WE'RE ALL THE WAY BACK
 SHLD FCURSC  SET AS CURRENT SECTOR AND FALL THROUGH
*
*
*
*          DISK DRIVER READ BLOCK
*
DDRBL CALL RBLK
RX2 XTHL .  RETURN CALL+2, BUT
 INX H  LEAVE
 INX H  HL
 INX H  ALONE.
 XTHL
 RET
*
*
*
 PAGE
*
*
*********************
*
*
*
*           DISK DRIVER CONTROL/STATUS OPERATION
*
*  COME HERE WITH A, DE, HL SET FROM USER CALL B,DE,HL
*
DDCTL ORA A
 JZ DDC2  IF STATUS REQUEST
*
*
 CPI 7
 JZ CTRL7  RETURN STATUS
*
*
 CPI 8
 JZ CTRL8  SET DRIVE READY TRAP
 CPI 9
 JZ CTRL9  READ BUFFER
 CPI 10
 JZ CTR10  WRITE BUFFER
*
 CPI 4  IS IT A "LOAD INDEX" REQUEST?
 JZ DDC4  YES
*
 CALL ERRL2  NO, BUT THAT'S ALL WE DO
 DB ERNCT
*
CTRL7 EQU $
* <============ NEED TO LOOK INTO THIS ROUTINE  =====
*
 LHLD FNBD  GET CURRENT BYTE DISPLACEMENT
 XCHG
 LHLD FBLKS  AND THE BLOCK SIZE
 CALL ARITH  HL = HL - DE
 XCHG .  RETURN IT IN DE
 MVI A,-1  SAY DRIVE READY FOR NOW  <=============
 RET
*
*
*
*  SET DRIVE NOT READY TRAP
*
CTRL8 SHLD DSKRD  SET IT
 RET .  QUICK CALL
*
*
*  REFRESH BUFFER OF STATIC BUFFERED FILE
*
CTRL9 CALL BUFTST  TEST TYPE OF BUFFERING
 RZ .  IF DYNAMIC BUFFER
 JMP RBLK  READ THE BLOCK AGAIN AND RETURN
*
*
*  WRITE OUT THE BUFFER IF STATIC BUFFERED
*
CTR10 CALL BUFTST  TEST TYPE OF BUFFERING
 RZ
 XRA A
 STA FFLAG  CLEAR THE BUFFER DIRTY FLAG
 JMP WBLK  WRITE IT OUT AND RETURN
*
*
*
*  RETURN FILE STATUS
*
DDC2 LDA FPROT  A = FILE PROTECTION
 MVI D,0  NOTHING ELSE OF IMPORTANCE!
 RET
*
*
*  LOAD INDEX INTO ADDRESS IN HL
*
DDC4 INX H  TEST FOR -1 FIRST
 MOV A,H
 ORA L
 DCX H
 JZ DDC4A  IT IS -1, SKIP TEST
*
 LXI D,SECTSZ  CHECK FOR OVERWRITE
 CALL MEMCHK
 MVI A,1
 ORA A  SET NZ TO FORCE CALL
*
DDC4A LHLD UHL  WE KNOW WHERE IT IS
 SHLD FAIND  ALL IS WELL, SET IT IN
 CNZ RINDY  LOAD THE INDEX
 RET
*
 PAGE
*
*
*********************
*
*
*
*          DISK DRIVER WRITE BLOCK
*
DDWBL CALL WBLK  WRITE IT
 JMP RX2  AND RETURN
*
*
*
*    DISK DRIVER WRITE BLOCK/READ NEXT
*
DDWBR CALL WBLK  WRITE OUT
 CALL DDRNB  READ NEXT
 CALL LNKBLK  NONE SO ADD ONE
 JMP RX2  WASN'T THAT EASY
*
* NOTE:  THE ABOVE ROUTINE IS REALLY ESTHETICALLY
*        PLEASING. (IF I DO SAY SO MYSELF.)
*
*********************
*
*
*         WRITE BLOCK OF DISK FILE
*
*   WRITE THE CURRENT BLOCK OF THE CURRENT FILE.
*   IF THIS BLOCK HAS THE EOF, UPDATE THE HEADER.
*
*   INFORMATION IN THE CURRENT FCB IS USED.
*
*
*  UPDATE HEADER IF NECESSARY
*
WBLK LDA FFORE+1  HIGH ORDER FORE
 ORA A
 JP WBL60  NO EOF, JUST WRITE
 LHLD FBDL
 MOV A,H
 ORI 128  SET HIGH BIT
 MOV H,A
 SHLD FFORE  SET NEW COUNT IN FORE PTR
*
*  SET OUTGOING HEADER
*
 LXI D,FFORE
 LXI H,OHFOR
 CALL MOVEF  JUST MOVE IT
 DB OHPRO-OHFOR+1
 CALL STDAD  SET TRANSFER DESCRIPTOR
 JMP WDSKH  WRITE BLOCK AND HEADER
*
*
*  WRITE BLOCK TO DISK OR OTHER WONDERFUL DEVICE
*
WBL60 CALL STDAD  SET TRANSFER DESCRIPTOR
 JMP WDSK  WRITE IT OUT
*
*********************
*
*
*      SET TRANSFER DESCRIPTOR
*
*  COPY STUFF FROM FCB TO TDAD
*
STDAD LHLD FCURSC
 SHLD TDAD  DISK ADDRESS
 LHLD FBLKS
 SHLD TBCNT  BYTE COUNT
 LHLD FID
 SHLD TFID  FILE ID
 LHLD TBUFA
 SHLD TBUF  BUFFER ADDRESS
 LDA FUNIT
 STA TUNIT  DISK UNIT
 RET
*
*********************
*
*
*      READ NEXT BLOCK OF A DISK FILE
*
*   CURRENT FCB HAS HEADER, ID, ETC.
*   CALL DDRNB
*   RETURN - EOF
*   RETURN - OK, HEADER, FCB UPDATED
*
*
*  TEST FOR  EOF
*
DDRNB LHLD FFORE
 MOV A,H
 ANI 127
 CMP H  IS A=H=127?
 MOV H,A  HAVE HL=COUNT IN CASE
 RNZ .  A AND H DIFFER BY HIGH BIT, => EOF
*
 XCHG .  DE HAS NEXT SECTOR ADDRESS
 LHLD FCURSC
 SHLD LSECT  SAVE CURRENT SECTOR ADDRESS
 XCHG
 SHLD FCURSC  SET CURRENT AS NEXT
 CALL RBLK  READ BLOCK
 PUSH H  SAVE BDL
*
*  PERFORM STRUCTURE TEST
*
 LXI H,LSECT  POINT TO LAST SECTOR ADDRESS
 LDA FBACK
 CMP M  COMPARE LOW ORDER
 JNZ FSBAD  BAD BAD BAD
 INX H
 LDA FBACK+1
 CMP M  COMPARE HIGH ORDER
 JNZ FSBAD  BAD BAD BAD
 POP H  PASS BACK BDL
 JMP RX2
*
*
FSBAD CALL ERRL0  SERIOUS ERROR
 DB FBER  FILE STRUCTURE BAD
*
*********************
*
*
*
*      READ DISK BLOCK
*
*   CURRENT FCB IS SET
*   CALL RBLK
*   RETURN
*
*
RBLK CALL STDAD  SET TRANSFER DESCRIPTOR
 CALL RDSK  READ IT
*
*  COME HERE AFTER TRANSFER
*
RBL30 LXI D,IHFOR  COPY HEADER TO
 LXI H,FFORE  FCB.
 CALL MOVEF
 DB FPRST-FFORE+1
*
*  IF EOF, RETURN COUNT, ELSE BLOCK SIZE
*
 LHLD FFORE
 MOV A,H
 ORA A  TEST HIGH BIT FOR EOF
 JP RBL40  NO EOF
 ANI 127  MASK OFF HIGH BIT
 MOV H,A  HL HAVE NEW COUNT
 RET .  RETURN
*
RBL40 LHLD FBLKS  NO EOF, USE BLOCK SIZE
 RET
*
*********************
*
*
*      FLUSH DEVICE BUFFER
*
FDB LHLD FDRIV
 LXI D,DTITO  DISPL. TO ITO
 DAD D
 MOV A,M  PICK UP ITO
 ORA A
 RZ .  ZERO, RETURN
 CALL WDBUF  WRITE OUT (IT BETTER BE DIRTY)
 LXI H,0  THEN BDL=NBD=0
 JMP WDB45
*
 PAGE
*
*
*********************
*
*
*
*               RELEASE FILE BLOCK
*
*  CURRENT FCB HAS STUFF
*  CALL RFBLK
*  RETURN
*
*  FCURSC IS THE BLOCK RELEASED.
*  THE FREE SPACE MAP IS UPDATED.
*  FDLTA IS UPDATED
*
*  GET COUNT OF TRUE NUMBER OF SECTORS
*
RFBLK LDA FPRST
 ANI  7  EXTRACT LOW 3 BITS
 STA RFBCN
 STA RFBC1  SAVE
*
*      REWRITE BLOCK
*  SET OUTPUT HEADER, THEN LOOP AND WRITE
*
 LXI H,0
 SHLD OHFOR
 SHLD OHBAK
 SHLD OHFID
 SHLD TFID
 MVI A,1
 STA OHPRO  1 SECTOR
 LHLD FCURSC
 SHLD TDAD  SET DISK ADDRESS
 LXI H,SECTSZ
 SHLD TBCNT  SET STANDARD BYTE COUNT
 LXI H,DKBUF
 SHLD TBUF  SET TO USE DISK ALLOC. BUFFER
 LDA FUNIT
 STA TUNIT  SET UNIT
*
RFB10 CALL WDSKH  WRITE SECTOR AND HEADER
 LHLD TDAD
 INX  H   MOVE TO NEXT SECTOR
 SHLD TDAD
 LXI H,RFBCN
 DCR M  COUNT DOWN ON SECTOR COUNT
 JNZ RFB10
*
*  READ FREE MAP
*
 LXI D,MAPDS
 LXI H,TDAD
 CALL MOVEF  MOVE STUFF TO TRANSFER DESCRIPTOR
 DB TBUF-TDAD+2
 CALL RDSK
*
*  FIND WORD TO UPDATE
*
 LHLD FCURSC  BLOCK NUMBER
 DAD H
 DAD H
 DAD H
 DAD H
 DAD H    *32/256 = /8
 MOV L,H
 MVI H,0  HL HAS TRACK NO.
 LXI D,DKBUF
 DAD D  HL POINTS TO ENTRY
*
*  UNPACK IT
*
 PUSH H  SAVE HL
 MOV B,M
 CALL UNPK  UNPACK INTO PBUF
*
*  SET BITS
*
 LXI D,TMBUF  TRACK MAP BUFFER
 LDA FCURSC
 ANI 7
 MOV L,A
 MVI H,0  HL HAVE SECTOR ADDRESS
 DAD D  HL NOW POINT TO WORD
 LDA RFBC1  GET COUNT OF SECTORS
*
RFB30 MVI M,1  SET BIT
 INX H
 DCR A
 JNZ RFB30
 CALL PACK  RE PACK THE WORD
 POP H
 MOV M,B  STORE BACK INTO MAP
*
*  REWRITE MAP
*
 CALL WDSK
 LHLD FDLTA
 DCX H
 SHLD FDLTA
 RET .  THAT IS ALL
*
*********************
*
*
*  FREE SPACE MAP DESCRIPTOR
*
MAPDS DW DAFSB
 DW 80  MAP LENGTH
 DW IDFSM  MAP ID
 DW DKBUF  USE DISK ALLOCATION BUFFER
*
*********************
*
*
*        UNPACK B INTO TMBUF
*  1 BIT IS PLACED IN EACH WORD.
*
*
UNPK LXI H,TMBUF
 MVI D,8  ZERO IT FIRST
 XRA A  = 0
*
UNPK5 MOV M,A
 INX H
 DCR D
 JNZ UNPK5
*
 LXI H,TMBUF
 MOV A,B
*
*  UNPACK A INTO HL
*
UNP ORA A
 RZ .  ZERO, DONE
 RAL .  LEFT 1 PLACE, ZERO FILL
 MVI M,0
 JNC UNP10  NO CARRY, ITS ZERO
 INR M  INCREMENT TO 1
UNP10 INX H
 JMP UNP
*
*
*  PACK TMBUF INTO B, RETURNS B
*
*
PACK LXI H,TMBUF
*  PACK HL INTO B
*
PAC XRA A
 MVI D,8  COUNT IS 8
*
PAC5 MOV E,A  SAVE PARTIAL
 MOV A,M  GET BIT
 RAR .  PUT IN CARRY
 MOV A,E  GET PARTIAL
 RAL .  SHIFT IN BIT
 INX H
 DCR D
 JNZ PAC5  AGAIN
 MOV B,A
 RET .  QUIT
*
*********************
*
*
*       PREPARE BUFFER
*
*  CURRENT FCB IS SET UP
*  CALL PBUF
*  RETURN - BUFFER IS SET UP
*
PBUF CALL BUFTST
 RNZ .  ALL DONE IF BUFFERED
*
*  UNBUFFERED, ALLOCATE AND PRIME BUFFER
*
PBU70 LHLD FBLKS
 PUSH H  SAVE BLOCK SIZE
 XCHG
 CALL ALBUF  ALLOCATE BUFFER
 SHLD TBUFA  OK
 POP D  DE=CT, HL->BUFFER
 CALL DVBR  READ IN BLOCK
 DB DTRB
 JMP SEOF  BAD IDEA *******
 SHLD FBDL
 RET
*
*
*   TEST IF FILE IS UNBUFFERED
*
BUFTST LHLD FBUFA
 INX H
 MOV A,H
 ORA L  IF IT WAS -1, IT IS UNBUFFERED
 DCX H  BACK TO TRUE
 SHLD TBUFA  SET IT TO TRUE BUFFERED ADDRESS
 RET .  ZERO PSW IF UNBUFFERED
*
*********************
*
*
*    RESTORE FCB
*
*  IF FRADD ZERO, DO NOTHING. LEAVE FRADD ZERO.
*
RFCB LHLD FRADD
 MOV A,L
 ORA H
 RZ .  ZERO, JUST RETURN
 LXI D,FCBORG
 CALL MOVEF  MOVE BACK
 DB LNFCB
*
RFCB1 LXI H,0
 SHLD FRADD  SET FRADD TO ZERO
 RET
*
*********************
*
*
*    LINK BLOCK
*
*  ALLOCATE AND LINK A BLOCK ONTO THE CURRENT ONE.
*  FOR DISK FILES ONLY.
*
LNKBLK CALL PROTST  CHECK IF ALLOCATE PROTECTED
 DB PALO
 JMP EOFE0  YES, PROTECTED!
*
 LHLD FBACK
 SHLD LNKT2  SAVE BACK POINTER
*
*  SET UP HEADER FOR NEW BLOCK
*
 LHLD FCURSC
 SHLD FBACK  SET BACK AS CURRENT
 SHLD LNKT1  SAVE CURRENT
 LXI H,EOFCD
 SHLD FFORE  SET FORE = EOF
*
*  ID, ETC. ARE THE SAME, ALLOCATE NEW
*
 CALL AFBLK
 SHLD FCURSC  SET AS CURRENT SECTOR
*
*  UPDATE HEADER OF LAST BLOCK
*
 SHLD OHFOR  FORE IS NEW SECTOR
 LHLD LNKT1
 SHLD TDAD  DISK ADDRESS OF LAST BLOCK
 LHLD LNKT2
 SHLD OHBAK  RESTORE BACK POINTER
 CALL WDSKH
 LHLD FINDX  INDEXED?
 MOV A,H
 ORA L
 JZ LNK40  NO, FORGET IT
*
*     UPDATE RANDOM FILE INDEX
*
 CALL RINDX  READ INDEX
 MVI B,250
 LXI H,DIBUF
*
*    SEARCH FOR ZERO ENTRY
*
LNK10 MOV A,M
 INX H
 ORA M
 JNZ LNK30
 XCHG
 LHLD FCURSC  GET CURRENT BLOCK
 XCHG
 MOV M,D  PUT IN NEW ENTRY
 DCX H
 MOV M,E
 CALL WDSK  WRITE OUT INDEX
 CALL UPIM  UPDATE INDEX IN MEMORY, IF ANY
 MVI B,1  SET FLAG THAT WE FOUND IT
*
LNK30 INX H
 DCR B
 JNZ LNK10  NOT YET
LNK40 LXI H,0  NO BYTES YET
 RET
*
 PAGE
*
*
*********************
*
*
*      SEARCH FILE CONTROL BLOCKS
*
*    HL HAS FILE ID
*    FUNIT HAS UNIT
*    CALL SFCBS
*
*    RETURN - >1 FOUND
*    RETURN -  1 FOUND
*    RETURN -  0 FOUND
*
SFCBS XCHG .  DE HAS ID NOW
 XRA A
 STA SFCT1  INITIALIZE COUNT
 LHLD FCBASE  HL POINT TO FCB
 LDA NFCB
 STA SFCT2  SET COUNT
*
SFC20 LXI B,FID-FCBORG
 DAD B  HL POINT TO FILE ID
 MOV A,M  GET LOW ORDER ID
 INX H
 CMP E  CHECK
 JNZ SFC70  NO, MOVE TO NEXT
*
 MOV A,M  GET HIGH ORDER ID
 CMP D  CHECK
 JNZ SFC70  NO, MOVE TO NEXT
*
*  ID MATCH, CHECK UNIT
*
 LXI B,FUNIT-FID-1
 DAD B  MOVE TO UNIT
 LDA FUNIT
 CMP M  CHECK UNIT
 JNZ SFC40  NO, UNITS DIFFER
*
*  FOUND
*
 LDA SFCT1  COUNT UP
 INR A
 STA SFCT1
*
SFC40 LXI B,FPRST-FUNIT+1
 DAD B  MOVE TO BEGINNING OF NEXT FCB
 JMP SFC75
*
*
SFC70 LXI B,FPRST-FID-1+1
 DAD B  MOVE TO NEXT FROM FID+1
*
SFC75 LDA SFCT2
 DCR A
 STA SFCT2  DROP COUNT
 JNZ SFC20  DO NEXT
*
*  DONE, DO RETURN
*
 LDA SFCT1  GET COUNT
 CPI 2
 RNC .  MORE THAN 2
 POP H
 INX H
 INX H
 INX H
 PUSH H  UPDATE RETURN
 ORA A  SET FLAGS
 RNZ .  MUST BE 1
 INX H
 INX H
 INX H
 XTHL .  UPDATE RETURN
 RET .  AND RETURN FOR ZERO.
*
 PAGE
*
*
*********************
*
*
*    GET RID OF DANGLING BUFFER
*    BECAUSE OF AN ERROR
*
RIDBF LHLD WBUFSZ
 MOV A,H
 ORA L
 RZ .  NONE
 XCHG
 LHLD WBUFAD  GET IT AND FALL THROUGH TO DEALLOCATE
*
*     FALL THROUGH
*
*********************
*
*
*   DEALLOCATE BUFFER
*
*  HL POINTS TO BUFFER
*  DE HAS BUFFER SIZE
*  THE BUFFER MUST BE IN THE SYSTEM GLOBAL AREA.
*  CALL DLBUF
*  RETURN
*
DLBUF SHLD DABT1  SAVE BUFFER ADDRESS
 XCHG
 SHLD DABT2  SAVE BUFFER SIZE
 DAD D  ADDRESS OF NEXT BUFFER (HL)
 PUSH H
 LXI H,0
 SHLD WBUFSZ  CLEAR SAVED BUF
 POP H
*
*  BUFFER ADDRESS (DE)
*
*      COMPRESS BUFFER SPACE
*
*  DE POINTS TO ONE WORD HIGHER THAN BUFFER
*  HL POINTS ONE WORD HIGHER THAN NEXT LOWER BUFFER.
*
DAB10 PUSH H
 LHLD MINAD  COMPARE DE WITH MINIMUM ADDRESS
 CALL COMP
 POP H  RESTORE HL
 JZ DAB30  MOVE IS DONE
*  MOVE A BYTE
 DCX H
 DCX D
 LDAX D
 MOV M,A
 JMP DAB10
*
*
*  ADJUST ANY AFFECTED ADDRESSES IN THE FCBS
*
DAB30 SHLD MINAD
 LHLD FCBASE
 LXI D,FBUFA-FCBORG
 DAD D
 PUSH H  FIRST BUFFER ADDRESS
 LDA NFCB
 STA DABT3
*
DAB40 MOV E,M
 INX H
 MOV D,M  GET BUFFER ADDRESS FROM FCB
 LHLD LOWAD
 CALL COMP  COMPARE WITH GLOBAL BASE
 JC DAB50  BELOW, MUST BE A USER BUFFER
*
 LHLD DABT1
 CALL COMP  COMPARE WITH BUFFER ADDRESS
 JNC DAB50  ABOVE AFFECTED AREA
*
 LHLD DABT2  GET DELTA
 DAD D  = UPDATED BUFFER ADDRESS
 XCHG .  IN DE
 POP H
 MOV M,E
 INX H
 MOV M,D  PUT BACK INTO FCB
 DCX H
 PUSH H
*
*  MOVE TO NEXT
*
DAB50 POP H  GET POINTER TO BUFF +1
 LXI D,LNFCB  DELTA TO NEXT FCB
 DAD D
 LDA DABT3  CHECK COUNT
 DCR A
 RZ
 STA DABT3
 PUSH H  SAVE POINTER AGAIN
 JMP DAB40
*
*
 PAGE
*
*
*********************
*
*
*            ALLOCATE FILE BLOCK
*
*  THE CURRENT FCB HAS THE DESIRED BLOCK SIZE AND HEADER.
*  AN ABORT IS TAKEN IF THE BLOCK SIZE IS ILLEGAL OR
*  IF THE DISK IS TOO FULL.
*
*  CONTROL RETURNS TO CALL+1 WITH THE BLOCK ADDRESS IN HL
*
AFBLK LHLD FBLKS  FIRST CHECK FOR LEGAL BLOCK SIZE
 PUSH H
 MOV A,L
 ORA H  IS IT ZERO?
 JZ AFB95  IF SO, ILLEGAL
 LXI D,-4084
 DAD D  >=4084? (8*512-12)
 JC AFB95  YES ILLEGAL
 POP H  GET BACK BLOCK SIZE
 CALL AFCALC  CALCULATE THE REQUIRED NUMBER OF SECTORS
*
AFB10 MOV A,C  C HAS THE NUMBER OF SECTORS
 STA AFBT1  WE SAVE IT HERE
*
*  READ THE FSMAP
*
 LXI D,MAPDS  FROM HERE
 LXI H,TDAD  TO THE TRANSFER DESCRIPTOR
 CALL MOVEF  SET UP
 DB TBUF-TDAD+2
 LDA FUNIT  GET WHICH UNIT
 STA TUNIT  SET FOR DISK DRIVER
 CALL RDSK
*
*  SET UP MAP SEARCH FOR FREE SPACE
*
 LXI H,0
 SHLD AFBT4  SET BLOCK NUMBER
 LXI H,DKBUF  ALLOCATION MAP BUFFER
 SHLD AFBT3  SET TRACK MAP POINTER
*
*  OUTER LOOP FOR ALLOCATION BEGINS HERE
*  LOOK FOR NEXT TRACK
*
AFB20 LHLD AFBT3
 MOV B,M  PICKUP MAP
 INX H
 SHLD AFBT3  SAVE UPDATED POINTER
 CALL UNPK  UNPACK THE MAP
*
*  A TRACK MAP IS NOW UNPACKED IN PBUF
* AFBT1 HAS THE REQUIRED NUMBER OF SECTORS
*  SET UP FOR MAP SCAN
*
 LDA AFBT1  NUMBER OF SECTORS REQUIRED
 MOV B,A  CALCULATE NUMBER FOR LOOP
 MVI A,9  ITERATIONS = 8-AFTB1+1
 SUB B
 MOV B,A  B HAS LOOP COUNT
 LXI H,TMBUF  SCAN STARTING POINT
*
*  THE INNER LOOP TO SCAN THE MAP OF THE CURRENT
*  TRACK BEGINS HERE
*
AFB40 SHLD AFBT6  SAVE PBUF POINTER
 LDA AFBT1
 MOV C,A  NUMBER OF SECTORS REQUIRED
*
AFB50 MOV A,M
 ORA A
 JZ AFB70  NO, THIS BLOCK IS NO GOOD
 INX H  BUMP POINTER
 DCR C  COUNT DOWN
 JNZ AFB50  TRY NEXT SECTOR
*
*  AT THIS POINT WE HAVE FOUND A BLOCK ON THE CURRENT
*  TRACK OF SUFFICIENT LENGTH.  WE NOW PROCEED TO GIVE
*  IT TO THE USER.
*
*  CLEAR BITS IN MAP
*
 LHLD AFBT6  PBUF POINTER
 LDA AFBT1  SECTOR COUNT
AFB60 MVI M,0  CLEAR BIT
 INX H  MOVE TO NEXT
 DCR A
 JNZ AFB60
*
*  REPACK CURRENT TRACK MAP AND REWRITE TO DISK
*
 CALL PACK
 LHLD AFBT3  GET UPDATED TRACK MAP POINTER
 DCX H
 MOV M,B  STORE MAP BACK IN
 CALL WDSK  WRITE MAP, TDAD IS STILL SET UP
*
*  INITIALIZE BLOCK FOR USER
*
 LHLD AFBT4  GET SECTOR NUMBER
 SHLD TDAD  TO THE TRANSFER DESCRIPTOR
*
*  SET OUTGOING HEADER AND TRANSFER DESCRIPTOR
*
 LHLD FBLKS
 SHLD TBCNT BYTE COUNT
 LXI H,0
 SHLD TFID  SET FREE SPACE FILE ID
 LHLD TBUFA
 SHLD TBUF  SET BUFFER ADDRESS
*
*  UNIT IS ALREADY SET
*
 LXI D,FFORE
 LXI H,OHFOR
 CALL MOVEF  MOVE IN USER HEADER
 DB OHPRO-OHFOR+1
*
*  INITIALIZE DISK BLOCK
*
 CALL WDSKH  WRITE HEADER AND DATA
*
*  RETURN DISK ADDRESS TO USER AND UPDATE DELTA
*
 LHLD FDLTA
 INX H
 SHLD FDLTA
 LHLD TDAD
 RET
*
*********************
*
*
*  CALCULATE NUMBER OF SECTORS REQUIRED
*
AFCALC MVI C,0  FOR STARTERS
 LXI D,-SECTSZ  FIRST SECTOR IS THIS BIG
*
AFB05 DAD D  SUBTRACT AMOUNT IN THIS SECTOR
 INR C  BUMP THE SECTOR COUNT
 MOV A,H
 ORA A
 RM .  RESULT NEGATIVE, GOT ENOUGH
*
 ORA L  ZERO IS GOOD ENOUGH, THOUGH
 RZ
*
 LXI D,-FULSZ  SUBSEQUENT SECTORS ARE THIS BIG
 JMP AFB05
*
*********************
*
*   CAN'T ALLOCATE ONE HERE...MOVE TO NEXT
*
*
AFB70 LHLD AFBT4
 DCR B  TOTAL ITERATIONS
 JZ AFB80  THIS TRACK IS FULL
 INX H  BUMP SECTOR NUMBER
 SHLD AFBT4
 LHLD AFBT6  MOVE PBUF POINTER
 INX H  UP ONE
 JMP AFB40  AND LOOP
*
*
*   THIS TRACK IS TOO FULL,  TRY NEXT TRACK
*
AFB80 MOV A,L  HL HAS SECTOR #
 ORI 7
 MOV L,A
 INX H  NOW AT NEXT TRACK
 SHLD AFBT4
 DAD H
 MOV A,H
 CPI 5  UP TO SECTOR 280H ?
 JC AFB20  STILL OK
*
*   DISK IS FULL ABORT
*
 LHLD LNKT1  GET BACK CURRENT SECTOR
 SHLD FCURSC
 LHLD LNKT2  AND BACK POINTER
 SHLD FBACK
*
 CALL ERRL1
 DB DAER0  DISK FULL
*
*
AFB95 CALL ERRL1
 DB DAER1  ILLEGAL BLOCK SIZE
*
 PAGE
*
*
****************************
*
*
*          SHORT RESET AFTER ABORT
*
USRES XRA A
 STA UA
SRESET XRA A
 STA CIFILE  SET CIFILE TO 0
 INR A
 STA COFILE
 INR A
 STA UTIL  SET UTILITY FILE = 2
*
*  CLEAR COMMAND STRING
*
 LHLD FCBASE
 LXI D,FNBD-FCBORG
 DAD D  POINT TO NBD WORD IN FCB #0
 MVI A,4  CLEAR FOUR BYTES
*
CSTRG MVI M,0
 INX H
 DCR A
 JNZ CSTRG  NBD=BDL=0
*
 LXI SP,CISTK  USE CI STACK
 CALL INRST  RESET THE DISK TRAPS
 SHLD CRTRAP  CLEAR CI RETURN TRAP = -1
 LDA UA
 ORA A
 JZ CI  CAN'T EXPLAIN ZERO
*
*  WAIT FOR A CHARACTER
*
 CALL CONIN
 CPI CR
 JZ CI  CR....DON'T EXPLAIN
*
*  TYPE MESSAGE
*
 LHLD UTOS  GET USER RETURN INTO HL
 SPHL
 POP H  = USER RETURN HOPEFULLY
 LXI SP,CISTK
 MVI A,-1
 STA OPER  ERRP8 SETS EOPR TO OPER
 JMP ERRP8
*
*
*********************
*
SRE50 STA UA  SAVE SYSTEM ERROR
*
*  1) SET ERCD TO UA  (THE CALLED ERROR #)
*  2) SET ERROR TRAPS
*  3) DO UTILITY WILL "CALLED FROM" MSG
*
*   TRAP HERE IF ERROR DURING EXPLAIN
*
XTRP CALL OUST
 DB CR
 DB LF
 ASC "CAN'T EXPLAIN"
 DB 0
 JMP ABURP  TRY TO ABORT AGAIN
*
*
 PAGE
*
*
*******************************************
*
*
*
*
*               COMMAND INTERPRETER
*               *********************
*
*
*    SOME CHARACTERS
*
CR EQU 13  ASCII CR
LF EQU 10  ASCII LF
SEMI EQU 59  SEMICOLON
COMMA EQU ','
SLASH EQU '/'
NSIGN EQU '#'
ZCHR EQU '0'
ASTRC EQU '*'
*
*********************
*
*
*  EOF ON INPUT FILE, IF CIFILE = 0 (CONSOLE), THEN
*     DO A CLOSE ALL, ELSE DO A SHORT RESET.
*
CIEIF LDA CIFILE
 ORA A  CHECK FOR ZERO
 JNZ USRES  NOT ZERO, DO A SHORT RESET TO MOVE THE CONSOLE
 MVI A,255  CLOSE ALL FILES
 CALL SYS
 DB CAOP
 JMP CIABT
 JMP USRES  WHY NOT?
*
*********************
*
*
*      "RETURN" ENTRY
*
*  PROCESS NEXT COMMAND, IF ANY
*  IF NONE, RETYPE PROMPT
*
RETURN LXI SP,CISTK
 CALL INRST  RESET INT TRAPS
 LHLD CRTRAP  CHECK RETURN TRAP
 INX H  IF =-1, NOTHING TO DO
 MOV A,H
 ORA L
 JZ CI50  NONE
 DCX H  <> -1, JUMP TO ADDRESS
 PUSH H  HERE WE GO
 LXI H,-1
 SHLD CRTRAP  CLEAR TRAP
 RET .  GO TO TRAPPER
*
*********************
*
*
*  SET ERROR TRAPS TO CI STANDARD AND RESET INT TRAPS
*
CIRST LXI H,0
 SHLD AERR
 SHLD FERR
 DCX H
 SHLD EERR
*
*  RESET BOTH INTERRUPT TRAPS
*
*  RETURN HL=-1
*
INRST LXI H,0
 SHLD DSKRD  SET DISKREADY TO 0
 DCX H  NOW FOR -1
 SHLD BDSK1
 SHLD BDSK2
 RET .  MUST RETURN WITH -1
*
*********************
*
*
*      ECHO CHARACTER TO CI LOG FILE
*
*  COME WITH CHAR IN A, AND RETURN THAT WAY
*
CRECHO MVI A,CR  ENTRY POINT TO ECHO A CARRIAGE RETURN
*
ECHOUT MOV B,A
 LDA ECFILE
 CALL WB  WRITE IT OUT
 CALL CI98  PANIC!!!
 MOV A,B
 RET
*
*********************
*
*
*       RETURN AND SET TRAP
*
*  COME HERE WITH TRAP ADDRESS IN USER HL
*
RETRAP LHLD UHL
*   SET CRTRAP AND FALL INTO CI
 SHLD CRTRAP
*
*********************
*
*
*  READ AND PROCESS A COMMAND
*
CI LXI SP,CISTK  SETUP STACK
*
CI50 LXI H,CIMSG  RESET PROMPT STRING
 SHLD TDPRO
 CALL CIRST
*
*   EAT LEADING BLANKS AND ","'S
*
CI51 CALL CIBNK
 JZ CIEIF  ZERO INDICATES EOF
 CALL CIBUP  WASN'T " " OR ","... BACK UP 1 CHAR
*
*   ECHO THE COMMAND
*
 LDA SWECH
 RRC
 JNC CI59  NO ECHO
 LXI H,0
 SHLD CECT  SET COUNT TO ZERO
*
CI53 LDA ECFILE  GET ECHO FILE NUMBER
 DCR A
 CZ CRECH  DO A CR IF IT'S #1
 XRA A
 STA CERC  CRLF COUNT TO ZERO
*
CI55 LDA CIFILE
 CALL RB
 JMP CI57
 CALL ECHOUT  PRINT CHAR
 LHLD CECT
 INX H
 SHLD CECT  INCREMENT CHARACTER COUNT
*
 CPI CR
 JZ CI58  CR -- DONE
 CPI ';'
 JZ CI57  ; -- DONE
*
 LXI H,CERC
 INR M  BUMP LINE POSITION
 MVI A,72  DO AUTO CRLF FOR TTY'S ETC
 CMP M
 JNC CI55  NOT PAST, KEEP GOING
 CALL CRECH  PAST 70, TYPE CR
 JMP CI53  LOOP
*
*********************
*
*
*   DONE WITH ECHO, MOVE BACK
*
CI57 CALL CRECHO  TYPE A CR
*
CI58 LHLD CECT
 MOV B,H
 MOV C,L  BC HAVE NUMBER OF CHARACTERS TYPED
 LDA CIFILE
 MVI D,128
 CALL SYS
 DB SPAOP  SPACE BACK
 JMP CIABT  ERROR- CAN'T BACK UP
*
*
*
*    INITIALIZE FOR COMMAND READ
*
CNBF EQU DKBUF  PUT NAME OUT OF THE WAY!
*
CI59 LXI H,CNBF
 SHLD CPNT  SET STORAGE POINTER
 MVI A,NMLEN+2
 STA CICNT  SET MAX CHAR COUNT
 MVI A,1
 STA XQFLG  SET XEQ FLAG
*
*  YES, HERE WE AGAIN EAT BLANKS AND COMMAS
*
 CALL CIBNK
 JZ USRES  END OF FILE
 JMP CI65  GO PROCESS THE FIRST CHR
*
*
*     READ COMMAND
*
CI60 LDA CIFILE
 CALL RB
 JMP USRES  SHORT RESET TO CONSOLE
*
CI65 CPI CR
 JZ CI68  ITS A CR, GO PROCESS
 CPI SEMI
 JZ CI68  ITS A SEMICOLON, GO PROCESS
 CPI BLNK
 JZ CI71  SPACE, GO PROCESS
 CPI COMMA
 JZ CI67
 MOV B,A
 LDA CICNT
 ORA A  ANY MORE CHARACTERS NEEDED?
 JZ CI60  NO, JUST IGNORE
 DCR A
 STA CICNT  YES, COUNT DOWN
 LHLD CPNT
 MOV M,B  STORE CHARACTER
 INX H
 MVI M,0
 SHLD CPNT  UPDATE POINTER
 JMP CI60
*
*
*   COMMA, INHIBIT EXECUTION
*
CI67 XRA A
 STA XQFLG
 JMP CI71  GO PROCESS
*
*********************
*
*
*   EAT COMMA'S AND SPACES FROM CI FILE
*
CIBNK LDA CIFILE
 CALL RB
 NOP
 XRA A  SET UP FOR EOF RETURN
 RET
 CPI BLNK
 JZ CIBNK
 CPI COMMA
 RNZ
 JMP CIBNK  LOOP FOR " ","," OR EOF
*
*********************
*
*
*   BACKUP ONE CHARACTER IN CIFILE
*
CIBUP LDA CIFILE
 LXI B,1
 MVI D,128
 CALL SYS
 DB SPAOP  BACKUP 1 CHAR
 JMP CIABT  SERIOUS ERROR
 RET
*
*********************
*
*
*   CLOSE LOAD FILE
*
CICLO LDA CICNT
 CALL SYS  CLOSE
 DB CLOOP
 JMP CIABT  ERROR
 RET
*
*********************
*
*
*      PROCESS COMMAND
*
*  COME HERE FOR CR AND ;
*  BACKUP SO ROUTINE CAN SEE THE CHARACTER
*
CI68 LDA CICNT  CHECK FOR NULL COMMAND
 CPI NMLEN+2
 CNZ CIBUP  BACKUP IF NON-NULL, IF NULL FOLLOWING TEST WILL
*                            DO.
CI71 LDA CICNT
 CPI NMLEN+2  CHECK FOR NULL COMMAND
 JZ RETURN  YES
*
*  OPEN FILE
*
 LXI D,CNBF  NAME POINTER
CI71A LXI H,-1
 SHLD AERR  GET MOST ERRORS
 INX H  =0, SYSTEM BUFFER OPTION
 CALL SYS  OPEN FILE
 DB OPEOP
 JMP CIOER  TRY TO REPORT THE ERROR
*
 STA CICNT  SAVE FILE NUMBER
 LXI H,0
 SHLD AERR  SET NORNAL ERROR TRAPPING
*
*  CHECK FILE TYPE
*
 LDA FTYPE
 ANI IMTYPE
 JNZ CI94  NOT IMAGE FILE, CANT LOAD
*
*  LOAD THE FILE
*
CI75 LDA CICNT  GET FILE NUMBER
 LXI B,4  4 BYTES
 LXI D,CBUF  INTO CBUF
 CALL SYS  READ BLOCK
 DB RBLOP
 JMP CI80  EOF ENCOUNTERED
*
*
*   NORMAL RETURN...GET COUNT AND DEST
*
 LHLD CBUF  WE READ IT TO HERE
 MOV B,H
 MOV C,L  BC HAVE COUNT
 LHLD CBUF+2  HL GET DESTINATION
 MOV A,B  CHECK FOR ZERO COUNT
 ORA C
 JZ CI96  YES, PROBABLY UTILITY
 LDA CICNT  A WILL BE NUMBER
 XCHG .  DE HAVE ADDRESS
 CALL SYS  A STILL HAS NUMBER
 DB RBLOP
 JMP CI89  BAD LOAD FILE
 JMP CI75  OK, DO NEXT BLOCK
*
*********************
*
*
*  CHECK FOR SELF START
*
CI80 CPI EER0  CHECK FOR EOF
 JNZ CI98  NOT EOF, VERY BAD
 MOV A,C
 CPI 2  ARE 2 BYTES LEFT
 JZ CI95  YES, SELF START
*
*  CLOSE FILE
*
 CALL CICLO
 LDA XQFLG  IF XQFLG=0 (=> COMMA),
 ORA A  THEN JUST HANDLE NEXT
 JZ CI59  WITHOUT ECHO
 JMP RETURN  TRY NEXT COMMAND
*
*********************
*
*
CI94 MVI A,ERNIF  NOT IMAGE FILE
 JMP CI90
*
*
*    BAD LOAD FILE, CLOSE FIRST
*
CI89 MVI A,ERBLF
*
*    COME HERE WITH ERROR # IN A
*
*
CI90 PUSH PSW  SAE ERROR NUMBER
 CALL CICLO  CLOSE THE LOAD FILE
 POP PSW  A = ERROR #
*
CIOER STA ERCD  SET ERROR NUMBER FOR UTILITY CALL
 MVI A,CCLDE  =CODE FOR LOADER
 STA EOPR  SET OPERATION
 MVI A,0  MESSAGE AND NO RETURN
 LXI H,CNBF  -> FILE NAME
 JMP ERRP9  GIVE MESSAGE
*
*********************
*
*
*    CATESTROPHIC ERROR
*
CI98 POP H  SHOW ADDRESS
CI99 MVI A,ERXXX  CATESTROPHIC
*
*********************
*
*
*    ABORT.  USE EXISTING REGISTERS
*
CIABT PUSH PSW  RESTORE ECHO FILE TO CONSOLE
 MVI A,1
 STA ECFILE
 POP PSW
 CALL SYS
 DB ABTOP
*
*********************
*
*
*
*     START UP USER PROGRAM
*
*  CLOSE THE FILE
*
CI95 CALL CICLO
 LHLD CBUF  SET START ADDRESS
*
*  COME HERE WITH HL EQUAL TO START ADDRESS
*  THE FILE WILL NOT BE CLOSED
*
CI96 LDA XQFLG
 ORA A
 JZ CI59  COMMAND ENDED WITH "," - LOAD NEXT FILE
 LDA XA
 PUSH H
 LHLD XHL
 RET
*
 PAGE
*
*
*******************************************
*
*
*
*
*         CONSOLE TELETYPE DRIVER
*
*
SSTA EQU 02  NEW STATUS PORT
USTA EQU 0
UDAI EQU 04  NEW INPUT PORT
UDAO EQU 1
INRDY EQU 20H  READY BIT
OTRDY EQU 128
*
BUFT EQU 80  BUFFER SIZE IN BYTES (255 MAX)
BUFT2 EQU 40  OUTBUF SIZE
*
*********************
*
*       DRIVER TABLE
*
TDRIV DW TDRL  READ BLOCK
 DW TDRL  READ NEXT
 DW IDAC  READ LAST, NO CAN DO
 DW TDWL  WRITE BLOCK, NEXT
 DW TDWL  WRITE BLOCK
 DW TDNGO  REWIND
 DW TDNGO  EOF
 DW TDNGO  CLOSE
 DW IDAC  SEEK
 DW TDCTL  CONTROL
 DW 0  BUFFER SIZE HOLDER
 DB 1  IMMEDIATE TRANSFER OPTION
 DW TDNGO  INITIALIZE, ETC... A CONVINIENT RETURN
*
*******************************************
*
*
*
*     CONSOLE INPUT DRIVER DISPATCH POINT
*
CONIN LDA STFLG  CHARACTER WAITING?
 ORA A
 JZ CONI1  NO
 XRA A  =0
 STA STFLG  CLEAR FLAG
 LDA INBYT  RETURN WAITING CHR
 JMP CONI2  GO
*
*********************
*
*
*  GET CHR FROM RCH DRIVER
*
CONI1 PUSH H  SAVE HL
 LXI H,CONI2  SETUP RETURN POINT
 XTHL .  RETURN ADDRESS NOW ON STACK
 PUSH H
 LHLD RCH  GET READ CHARACTER ADDRESS
 XTHL .  GET BACK HL
TDNGO RET .  DISPATCH TO RCH
*
*********************
*
*
*  RETURN HERE WITH CHARACTER IN A
*
CONI2 STA CONCH  SAVE IT AWAY
 PUSH B  DON'T DISTURB BC
 CALL UPSH  UPSHIFT CHARACTER
 LDA CONCH  BINARY, RELOAD CHAR
 POP B  NON-BINARY RETURN
 STA INBYT  SAVE BYTE FOR POSSIBLE LATER USE
 RET
*
*********************
*
*
*   READ SINGLE BYTE
*
CIRCH CALL CITCH  GET THE STATUS
 JZ CIRCH  WAIT
 IN UDAI  READ IT
 PUSH PSW  SAVE FOR SWITCH TEST
 LDA SWBIO  BINARY I/O?
 RRC
 JC CIR20  YES!
 POP PSW  NO
 ANI 127  MASK PARITY
 RET
*
*
CIR20 POP PSW
 RET
*
*******************************************
*
*
*        CONSOLE STATUS TEST DISPATCH POINT
*
CONST PUSH H  SAVE HL
 LXI H,CONT20
 PUSH H  SETUP RETURN ADDRESS
 LHLD SCH
 PCHL .  DISPATCH TO SCH
*
*
* COME HERE AFTER TEST WITH Z/NZ SET
*
CONT20 POP H  RESTORE HL
 JNZ CONT30  GOT A CHARACTER WAITING, USE IT
 LDA STFLG  NO REAL CHAR, WHAT ABOUT A PSEUDO ONE
 ORA A
 RET .  GO WITH FLAGS SET
*
*
*    A REAL CHAR, CLEAR PSEUDO CHAR FLAG
*
CONT30 XRA A
 STA STFLG
 INR A  DON'T FORGET ABOUT THE REAL ONE
 RET
*
*
*    CONSOLE TEST INPUT CHAR
*
CITCH IN SSTA
 NOP .  THIS FORMAT CANT BE CHANGED ( OVERLAYED ON RESET )
 ANI INRDY
 RET .  FLAGS SET (Z=NO CHAR)
*
*******************************************
*
*
*
*   CONSOLE OUTPUT CHARACTER ROUTINES
*
CONOUT STA CONCH  SAVE CHARACTER
 CALL UPSH  UPSHIFT CHARACTER
 JMP CON40  RETURN HERE => BINARY SWITCH SET, JUST OUTPUT
 STA CONCH  SAVE UPDATED CHARACTER
*
*  IF CR, SET CRSEEN FLAG AND OUTPUT NULLS
*
 CPI CR
 JNZ CON20  NOT A CR
 STA CRSEEN  SET FLAG
 JMP CON90  OUTPUT THE CHARACTER
*
*
*  NOT A CR, SEE ABOUT LF
*
CON20 CPI LF
 JZ CON30  YES, IT WAS
*
*  NOT A LF, IF LAST WAS CR, OUTPUT LF AND CLEAR CRSEEN
*
 MOV B,A
 LDA CRSEEN
 ORA A
 MOV A,B
 JZ CON40  LAST WASN'T A CR, JUST OUTPUT CHAR
 MVI A,LF  OUTPUT A LF TO PREVENT OVERPRINTING
 CALL CON90
*
CON30 XRA A
 STA CRSEEN  CLEAR CRSEEN FLAG
*
*  OUTPUT CHAR IN CONCH
*
CON40 LDA CONCH
CON90 CPI LF  LF?
 JZ CON91  YES, FOLLOW WITH NULLS
CONXO MOV B,A
 PUSH H  SETUP CALL TO WCH ROUTINE
 LHLD WCH  -> ROUTINE
 XTHL
 RET .  GET US THERE
*
*
*  SEND NULLS AFTER LF
*
CON91 CALL CONXO  TYPE TH ELF
 LDA NULLS  A=LF BEFORE SO NO NEED TO SAVE
 PUSH D  SAVE DE
 MOV D,A
 ORA A
 JZ CON93  NONE TO DO
*
CON92 XRA A
 CALL CONXO  SEND NULL
 DCR D  COUNT DOWN
 JNZ CON92  MORE
*
CON93 POP D
 MVI A,LF  RETURN WIT LF FOR CONSISTANCY
 RET .  NOW RETURN FOR REAL
*
*
*
*  THIS DOES THE ACTUAL OUTPUT.  CONTROL USUALLY COMES HERE
*          THROUGH (WCH) BY CON90.
*
CIWCH IN 0F8H
STBYT EQU $-1
 DB 0  PATCH ROOM
 ANI OTRDY
 JZ CIWCH
 MOV A,B  GET CHR
 OUT 0F9H
DABYT EQU $-1
 RET
*
*******************************************
*
*
*          UPSHIFT ASCII SUBROUTINE
*
*    COME HERE WITH CHAR IN CONCH
*
*    <RETURN>  BINARY, NO CHANGE, CHAR IN CONCH  (NOT IN A)
*    <RETURN>  OK, POSSIBLY UPDATED CHARACTER IN A
*
UPSH LDA SWBIO  BINARY CONSOLE?
 RRC
 RC .  YES, SKIP THE WHOLE THING AND LET CON.. KNOW
*
 LDA SWUPS  SEE IF UPSHIFT REQUESTED
 RRC
 LDA CONCH  A=CHAR
 CC UPSH1  CHECK IT
 JMP RX2  NO, SKIP IT
*
*
*  SEE ABOUT UPSHIFTING CHAR
*
UPSH1 CPI 123  ="z"+1
 RNC .  >"z", NO CHANGE
 CPI 97  ="a"
 RC .  <"a", NO CHANGE
 SBI 32  UPSHIFT
 RET .  OK
*
*******************************************
*
*  CI PROMPT MESSAGE
*
CIMSG DB CR
 DB LF
 DB ASTRC  THE ACTUAL PROMPT
 DB 0  END OF MESSAGE
*
*
*          OUTPUT STRING TO CONSOLE
*
*  LIKE OUST BUT COME WITH HL -> STRING
*  THE STRING TERMINATES WITH A ZERO BYTE AND CONTROL
*   RETURNS TO CALL+1
*
OUSTH MOV A,M
 ORA A
 RZ
 INX H
 CALL CONOUT  PRINT
 JMP OUSTH
*
 PAGE
*
*
*******************************************
*
*
*  -----------------  TTY DRIVER FOR CONSOLE -----------
*
TDWB EQU CONOUT  OUTPUT CHARACTER ROUTINE
*
*        WRITE BLOCK
*
*  BUFFER ADDR IN HL, COUNT IN DE
*
TDWL MOV A,E
 ORA A  TEST COUNT
 JZ TDW30  ZERO, => DONE
 MOV A,M  GET CHAR
 CALL TDWB  PRINT
 INX H  BUMP POINTER
 DCR E  DEC. COUNT
 JMP TDWL
*
*
*  RETURN A ZERO COUNT
*
TDW30 LXI H,0
 JMP RX2  RETURN CALL+2
*
*
*         READ BLOCK
*
*  COME WITH BUFF IN HL, COUNT IN DE
*
*  PRINT PROMPT
*
TDRL PUSH H
 PUSH D  SAVE IMPORTANT NUMBERS
 LHLD TDPRO  -> PROMPT MESSAGE
 CALL OUSTH  PRINT IT
 POP D
 POP H
 MVI D,0  INITIALIZE CHAR COUNT
*
TDRL2 CALL CONIN  GET A CHARACTER
 CPI CTRLX  CANCEL?
 JZ TDRLC  YES, DELETE LINE
 CPI BSP  BACKSPACE?
 JZ TDRLB  YES, BACKSPACE
 MOV B,A
 MOV A,D  ONLY CHECK CTRL-C IF D=0 (1ST CHAR)
 ORA A
 JNZ TDRL3  SKIP TEST
 MOV A,B
 CPI CTRLC  CTRL-C ?
 JZ TDRLE  YES, EOF
*
TDRL3 MOV A,E
 ORA A
 JZ TDRLF  BUFFER IS FULL
 MOV M,B  STORE CHAR
 MOV A,B
 INX H
 CALL CONOUT  ECHO
 INR D  COUNT UP
 DCR E  COUNT DOWN
 CPI CR  IS IT A CR?
 JZ TDRLQ  CR, QUIT
 JMP TDRL2  GET NEXT.
*
*
*  DELETE ENTIRE LINE
*
TDRLC MVI A,'!'  TYPE !,CR, LF
 CALL TDWB
 MVI A,CR
 CALL TDWB
 MVI A,LF
 CALL TDWB
*
*  MOV BUFFER POINTER AND COUNTS BACK TO BEGINNING
*
TDRL5 MOV A,D
 ORA A
 JZ TDRL2
 INR E  MORE CHARS AVAIL
 DCX H  MOVE BACK BUFFER PTR
 DCR D  COUNT DOWN CHARS
 JMP TDRL5
*
*
*  BACK SPACE
*
TDRLB MOV A,D
 ORA A
 JZ TDRLF  ITS EMPTY, FORGET IT
 DCX H  ADJUST POINTER
 DCR D  AND
 INR E  COUNTS.
 MVI A,LARO
 CALL TDWB  TYPE BACK ARROW
 JMP TDRL2  AND GO ON
*
*
*  END OF FILE ENCOUNTERED.
*
*         ****  THIS ROUTINE USED AS INIT ENTRY POINT ***
*               WATCH OUT!!
*
TDRLE RET .  THATS IT
*
*  BUFFER IS FULL (OR EMPTY)
*
TDRLF MVI A,BELL
 CALL TDWB  DING
 JMP TDRL2  TRY AGAIN
*
*  CARRIAGE RETURN-QUIT.
*
TDRLQ MOV L,D  COUNT IN HL
 MVI H,0
 JMP RX2
*
 PAGE
*
*
*******************************************
*
*
*
*           TTY CONTROL/STATUS OPERATION
*
*  HANDLES STATUS AND PROMPT SET REQUESTS
*
TDCTL ORA A
 JNZ TDCT2  NOT STATUS REQUEST
*
 MVI A,PALO+PNAT+PATR+PDEL  PROTECT WORD
 LXI D,SBDUP+SBIAT+SBPRO*256  TYPE WORD
 RET .  THAT'S ALL
*
*
* CHECK IF PROMPT SET OPERATION
*
TDCT2 CPI 2
 JNZ TDCER  NO, ERROR
 SHLD TDPRO  YES, SET PROMPT POINTER
 RET
*
*
TDCER CALL ERRL2
 DB ERNCT  CAN'T DO THAT CONTROL OPERATION
*
*******************************************
*
*
*
*  HERE ARE SOME USEFUL ASCII CHARACTERS
*
BSP EQU 127  RUBOUT
CTRLC EQU 3  CONTROL-C
CTRLX EQU 24  CONTROL-X
BELL EQU 7  BELL
BSLSH EQU 92  BACK-SLASH
LARO EQU 95  LEFT ARROW
BLNK EQU 32  SPACE
*
 PAGE
*
*
*******************************************
*
*
*
*
*              UTILITY OPERATION MANAGER
*            *****************************
*
*
*  THIS OPERATION RUNS ON THE CALLING STACK
*
*      CALL UTIL
*      OPERATION
*      ERROR RETURN
*      NORMAL RETURN
*
*  THE CALLED OPERATION IS PASSED HL AND A
*
UTILTY SHLD XHL  SAVE HL
 STA XA  AND A
*
*  PICKUP THE OPERATION
*
 POP H
 MOV A,M
 INX H  MOVE RETURN PAST OPER
 PUSH H
 STA XOPER  SAVE OPERATION
*
*  REWIND THE FILE
*
 LDA UTIL
 MVI D,0
 CALL SYS  REWIND
 DB SPAOP
 JMP UER2
*
*  LOAD UTILITY FILE PREFIX
*
 LXI B,255  BC IS COUNT
 LXI H,CBUF  READ INTO CMD BUFFER
 XRA A  A IS ZERO
 MOV M,A  MAKE SURE A ZERO IS THERE
 XCHG .  DE IS DEST ADDRESS
*
 LDA UTIL  UTILITY FILE IS ALWAYS OPEN
 CALL SYS
 DB RBLOP  MEMORY PROTECT WILL SAY NO
 NOP
 NOP .  IGNORE
 NOP .  EOF
*
*  CHECK OPERATION
*
 LDA XOPER
 LXI H,CBUF
 CMP M  COMPARE TO MAX
 JNC UER1  ERROR, ITS TOO BIG
*
*  FIND OPERATION
*
 INX H  MOVE PAST MAX
 MOV C,A
 MVI B,0
 DAD B  + OPERATION
 DAD B
 MOV A,M
 INX H
 MOV H,M
 MOV L,A  = BRANCH ADDRESS
 ORA H
 JZ UER1  IT'S ZERO, FORGET IT
*
*  SETUP FOR CI IMAGE LOAD
*
 LDA UTIL
 STA CICNT  NOTE: B= 0 FROM ABOVE
 CALL SYS
 DB SEKOP
 JMP UER2
*
*  FINAL SETUP FOR CI LOAD IS DONE
*
 MVI A,1
 STA XQFLG  FORCE EXECUTION....BANG, BANG...SHOOT, STAB
 JMP CI75
*
*
*
UER1 MVI A,UTE0  BAD UTILITY OPERATION
UER2 RET .  JUST RETURN WITH SYS STUFF
*
*
*
 PAGE
*
*
*
*
*           <<  PTDOS PARAMETER SCANNER  >>
*
*
*
*       VERSION 1.4   MAY 10, 1977   S. DOMPIER
*
* ~.~.~.~.~.~.~.~.~.~.~.~.~.~.~.~.~.~.~.~.~.~.~.~.~.~
*
*  COMMON VALUES:  ( from PTDEF:LB )
*
*       VALUE +40H = MY BUFFER FROM REG HL
*
*  PSN    EQU  5     READ NAME TO REG DE
*  PSV    EQU  85H   CONVERT VALUE INTO REG DE
*  PSFC   EQU 6      FORCE CREATE FILE
*  PSFCO  EQU 2      FORCE CREATE AND OPEN FILE
*  PSC    EQU 4      CREATE FILE IF NONE EXIST
*  PSCO   EQU 0      CREATE IF NONE EXIST AND OPEN
*  PSOP   EQU 1      OPEN FILE
*  PSONE  EQU 0A5H   READ SINGLE BYTE
*  PSOPT  EQU 8      READ ALL CHRS TO , ; cr 0
*
*  NOTE: ABOVE VALUES + 40H = USER INPUT BUFFER IN REG HL
*
*
*  PSCN EQU 95H  CONVERT MY VALUE TO DE, BASE IN REG B
*
*
*
PSCAN STA OPT  save options
 SHLD UIBUF  save user input buffer address
 XCHG .  (if any)
 SHLD UOBUF  save output (work) buffer address
 LXI H,0
 DAD SP
 SHLD RSTK  save return address
 LHLD AERR  AERR save error switch value
 SHLD ERSWC
 LXI H,-1  return to me, my nus one!
 SHLD AERR  AERR set new error switch
 CALL ERRET  set-up normal return address
*
*   normal return
*
PNRET LDA CC  get chr count
 MOV C,A  clear carry,
PNR1 ORA A  set/reset zero (for chr count).
*
PNR2 LDA LC  get last chacter scanned to reg A
 LHLD ERSWC  reset DOS error switch
 SHLD AERR
 LHLD RSTK  get return address
 SPHL .  reset caller's stack pointer
 RET .  go home
*
*
*   THE REST OF THIS ROUTINE IS USED BY NAMTST IN THE
*   SYSTEM PROPER...USE CARE!!!
*
DLMTST CPI '*'
 RZ .
 CPI '!'
 RZ .
DLTST CPI '<'  special chrs, RETURN IMMEDIATLY
 RZ .  NO CHR COUNT FOR THESE!
 CPI '>'  CHR IS RETURNED IN REG A.
 RZ
 CPI '='
 RZ
*  THESE CHRS ARE ILEGAL FOR NMTST...ALREADY TESTED ZERO
DLTEST CPI ';'  check for normal terminators
 RZ
 CPI 0DH
 RZ
 CPI ','
 RZ
 ORA A  BINARY ZERO
 RET
*
 PAGE
*
***************************
*
*
*
*               SIMPLE VDM DRIVER
*
*
*
*
*   CHARACTER OUTPUT ROUTINE, CHARACTER PASSED IN B
*   NULLS, RUBOUT1
*
CIVDM MOV A,B  GET CHARACTER
 ORA A  NULL?
 RZ
 CPI 127  OR RUBOUT?
 RZ
 PUSH H  NONE OF THOSE, SAVE REGS
 PUSH D
 PUSH B  SAVE CALLING "B"
 ANI 7FH  STRIP HIGH BIT
 MOV B,A
 CPI LF  LINE FEEDS MUST GO FROM HERE
 JZ AGDLY  OR CONCH WILL BE CHANGED BY CONIN
 CALL NCHK  SEE IF NEW SPEED ON EACH CHR
 LDA SPEED  GET DELAY
 MOV H,A  COUNT IN HL
 MVI L,1
*
AGAIN DCX H
 MOV A,H  HIGH BYTE OF DELAY
 ORA A  CHECK IT
 JNZ AGAIN
*
*  END OF DELAY LOOP
*
AGDLY LHLD VDMAD  CURRENT CURSOR ADDRESS
 MOV A,M
 ANI 7FH
 MOV M,A
 MOV A,B
 CPI CR  HOW ABOUT CR (END OF LINE)
 JZ PCR1  YES, GO PROCESS IT
 CPI LARO  BACK SPACE?
 JZ VBKSP  IF SO YOU SEE
 CPI LF  NOW TRY LINE FEED
 LDA KNTT  CHAR COUNT IN THIS LINE
 JZ LFPCR  GO TO LINEFEED WITH KNTT
 INR A  + 1
 STA KNTT  STORE IT BACK
 CPI 65  CHECK FOR END OF LINE
 CNC PCR  NOT END OF LINE YET
 MOV M,B  OVERWRITE IT WITH CHARACTER
 INX H  POINT TO NEXT LOCATION
*
GOBK MVI M,' '+80H  PUT CURSOR ON SCREEN
GOBK1 SHLD VDMAD  STORE IT
 POP B  RESTORE REGS
 POP D
 POP H
 MOV A,B  RETURN CALLING OUTPUT CHARACTER
 RET
*
*
*    BACKSPACE AND ERASE LAST CHR
*
VBKSP DCX H
 LDA KNTT  GET CHARACTER COUNT
 DCR A
 STA KNTT
 JMP GOBK
*
*
*    CHECK FOR SPEED CONTROL
*
NCHK CALL CONST
 RZ .  IF NO CHR
NCHKA CALL CONIN  FOR NEW SPEED
 CALL CK  CHECK FOR NEW SPEED
 JNC PCR4  IF WASN'T SPEED
*
NCHK1 ANI 0FH  ASCII BIAS
 MOV C,A  SAVE DELAY NUMBER
 XRA A
 STC .  INIT DELAY BIT IN CARRY
*
TRY DCR C  DEC DELAY NUMBER
 STA SPEED
 RZ .  STOP NOW
 RAL .  SHIFT DELAY
 JMP TRY  DO IT AGAIN
*
*
* CHECK NEW CHARACTER FOR A NUMBER
*
CK ANI 7FH  JUST IN CASE
 CPI '9'+1  UPPER LIMIT
 RNC .  NOT NUMBER
 CPI '1'  LOWER LIMIT
 CMC
 RET
*
PCR4 INR A  IN CASE OF NULL
 STA STFLG  SAY CHR IS WAITING
 DCR A
 RET
*
*
*      PROCESS THE CARRIAGE RETURN
*
PCR1 CALL NCHK  SEE IF CHR WAS INPUT
 JZ PCR3  IF NOT OR IF NEW SPEED
*
WAIT CPI ' '  CHECK FOR A BLANK
 JNZ PCR3  NO - CONTINUE
WAIT1 XRA A
 STA STFLG  CLEAR FLAG...WE ARE USING THE SPACE
*
 CALL NCHKA
 JZ PCR3  A NUMBER, CONTINUE
 CPI ' '  SPACE WILL CONTINUE ALSO
 JNZ WAIT1  IF IT WASN'T
 XRA A
 STA STFLG  CLEAR THE FLAG AGAIN
*
*   MOVE CURSOR TO LEFT MOST POSITION  (CARRIAGE RET)
*
PCR3 CALL VDAD1  GET CORNER POSITION
 MOV A,M  GET CHR
 ORI 80H
 MOV M,A
 JMP GOBK1
*
*
*    END OF LINE PROCESSING
*
LFPCR CALL PCR
 JMP GOBK
*
*
*    LINE FEED OR END OF LINE SCROLL COME HERE
*
PCR LDA BOT  SCROLL CONTROL
 INR A  NEXT ONE
PCRCK ANI 0FH  KEEP ONLY LOW ORDER 4 BITS
 STA BOT  SAVE IT
 OUT VPORT  OUTPUT TO VDM
 DB   0,0    <<-------------------<<<<<
 CALL VDAD1  GET ADDRESS
 PUSH H  SAVE ADDRESS
 MVI C,64  CHARACTER COUNT
*
MOVE MVI M,' '  BLANK CHAR ON BOTTOM LINE
 INX H  BUMP POINTER
 DCR C  DECREMENT COUNT
 JNZ MOVE  DO AGAIN
 POP H  GET ADDRESS BACK AGAIN
 RET
*
*
* CALCULATE SCREEN ADDRESS
*
VDAD1 XRA A  ZERO THE CHR POSITION
 STA KNTT
 LDA BOT
*
VDADD ADI 15  LINE 15
 RRC
 RRC
 MOV L,A
 ANI 3
 ADI 0FCH
 MOV H,A
 MOV A,L
 ANI 0C0H
 MOV L,A  GOT NEW ADDRESS
 RET .
*
*
*  A FEW VDM EQUATES
*
VSCREN EQU 0FC00H  VDM SCREEN ADDR
VPORT EQU 0C8H  STANDARD OUTPUT PORT
VEND EQU 00  HIGH BYTE OF SCREEN END
*
************
 PAGE
*
**
*       VERSION:  78.10.04
*
*             EQUATES
*
*
*   ERROR CODES
*
SIZER EQU ERBSC  SIZE CONFLICT
FIDER EQU ERFIC  FILE ID CONFLICT
SECER EQU ERSCC  SECTOR CONFLICT
FORER EQU ERCFS  FORMAT ERROR (CAN'T FIND SECTOR)
TRIER EQU ERCRC  ABORTS AND CRCC'S
TRKER EQU ERCFT  CAN'T FIND TRACK
RWERR EQU ERRBC  READ AFTER WRITE ERROR
LOCER EQU ERLOK  SYSTEM LOCKED
*
*
*                                *************************
*                                *                       *
*                                ***    DISK DRIVER    ***
*                                *                       *
*                                *************************
*
* Original source code for ptdos stores the lenght for a
* transfer in DRLEN not in the BXD.  This MUST be fixed
*
*
*       VERSION:  05.01.88
*
* Introduction.  The disk operating system used on the HELIOS
* uses a controller which had the capacity to write and rewrite
* both the header and data segments of the disk.  This was
* achieved by using a hard sectored disk.  In addition sector
* lengths were variable, up to 4095 bytes long.  The IBM format
* uses only fixed length sectors, which can never be changed
* after definition.  Only the fixed length data sectors can be
* changed; the headers are fixed and inaccessable once they have
* been written.  The original data structure used by PTDOS
* was a doubly linked list; with linking pointers and filing
* information stored in the header for each data block.  The
* headers changed continually.  As this is not available with
* soft sectored disks and alternate place must be found to
* store the headers.  This is the the last 12 bytes of each
* sector.  When a file block is written to disk the header is
* concatenated to the data, before being written.  When a block
* is read the header is located and transferred from the end of
* the block (=sector) to an area reserved for the incoming
* header. The RDDSK and WRDSK routines are responsible for
* handling the header/data seperation.
*
* Each file buffer in memory must have the 12 following
* bytes spare at the "top end" to put the header. Disk writes
* transfer the header from the location OHEAD to this space
* befor the block is written. Disk reads move the header to
* IHEAD from the end of the block.  Merging and seperating
* the header and data segments is the responsibility of
* RDDSK and WRDSK.
*
* PTDOS is well protected against its own software being faulty.
* It checks the incoming header file id number against the same
* data in memory.  If these disagree an error is apparent,
* and it traps to an error handler.  This ensures that if the
* linking pointers are incorrect, potentially corrupting the
* the disk structure, this will be prevented.
*
*
*   TRANSFER COMMANDS
*
INIOP  EQU  00      reset the disk and home to trk 00
RDOP   EQU  01      read a block from the disk
WROP   EQU  02      write
*
*   ERROR CODES
*
NOER  EQU 00        no error detected
PAERR EQU 01        parameter error
RNFER EQU 02        record not found - can't find sector
RDERR EQU 04        read data incorrectly
WRERR EQU 08        write error
WPERR EQU 16        attempted write to a protected disk
UOERR EQU 32        unsupported operation
NSERR EQU 64        non standard error - for special devices
*                   user defined error code in A
DNRER EQU 128       drive not ready error
*
*   MISC
*
HELEN EQU 12  LENGTH OF HEADER
*
 PAGE
************************
*
*
*
*
*             ENTRY POINTS FOR READ AND WRITE DATA
*
*
*
*   ON CALL:  BXD    IS TRANSFER DESCRIPTOR AND MUST BE CORRECT
*                    IHEAD OR OHEAD MUST BE CORRECT
*   RETURNS:  CALL+1 FOR NORMAL
*             ERRL0  FOR ERRORS
*
*
*    WRITE DISK BLOCK
*
WDSK CALL LKCHK  CHECK WRITE LOCK AND SET OPERATION
 JMP WDSK1
*
*
*    READ DISK BLOCK
*
RDSK MVI A,RDOP  READ OPERATION
 CALL OPSE1  SET OPERATION AND CLEAR INT STUFF
*
WDSK1 EQU $
* READ HEADER
 LHLD TSEC          GET BLK # FROM PT TRANSFER DESCRIPTOR
 SHLD HBXFR         INTO BXD BLOCK #
 LXI H,HBXD+1
 MVI M,RDOP         SET READ CODE
 DCX H
 LDA TUNIT          INTO DRIVE BXD
 MOV M,A
 CALL XFER          READ THE HEADER
 JMP TRYER
* CHECK HEADER JUST READ AGAINST TDAD
 LXI H,TDAD         DO THE HEADERS MATCH?
 LDA IHBLK
 CMP M
 JNZ SZCON          NO .. !
 INX H
 LDA IHBLK+1
 CMP M
 JNZ SZCON          NO .. !
 INX H
 LDA IHSIZ          ARE THE FILE BLOCK SIZES THE SAME?
 CMP M
 JNZ BLKER
 INX H
 LDA IHSIZ+1
 CMP M
 JNZ BLKER
 INX H
 LDA IHFID          DO THE FILE ID'S MATCH?
 CMP M
 JNZ FIERR
 INX H
 LDA IHFID+1
 CMP M
 JNZ FIERR
 LDA OHPRO          ARE THERE THE SAME # OF BLOCKS
 ANI 15
 MOV B,A
 LDA IHPRO
 ANI 15
 CMP B
 JNZ SZCON
* THE HEADERS SEEM TO MATCH .. START TRANSFER
 LHLD TBCNT         GET THE # OF BYTES IN PT BLOCK
 LXI D,SECTSZ
 CALL COMP          IS TBCNT >  SECTOR SIZE?
 MOV B,H            (cy set is HL > DE)
 MOV C,L            cy reset if HL <= sector size
 JNC WDSK3          NO ..
WDSK2 LXI B,SECTSZ  YES .. BC has tbcnt or sectz, whichever smlr
WDSK3 LXI D,RWBUF
 LHLD TBUF
 LDA BXOP
 CPI RDOP
 PUSH PSW
 JZ WDSK4
 XCHG .             SWITCH SOURCE,DEST. FOR WRITE
WDSK4 CALL MOVEV    MOVE BC BYTES FROM DE TO HL
 POP PSW
 JZ WDSK5
* WRITE BUFFER TO DISK
 LXI H,HBXD+1
 MVI M,WROP
 DCX H              POINT TO START OF BXD TABLE
 CALL XFER          TRANSFER ONE BLOCK ..
 JMP TRYER
* CHECK IF MORE THAN 1 SECTOR TO DO
WDSK5 LDA IHPRO
 ANI 15
 DCR A
 RZ .               NO MORE TO DO
 LHLD TBUF
 LXI D,SECTSZ
 DAD D
 SHLD BXXA
 LDA TUNIT
 STA BXDEV
 LHLD TBCNT
 LXI D,-SECTSZ
 DAD D
 SHLD BXRZ
 LHLD TDAD
 INX H
 SHLD BXFR
*  DO REMAINING SECTORS
WDSK6 LXI H,BXD
 CALL XFER
 JMP TRYER
*
*LDA BXRZ+1
*DCR A  TAKE 512 OF # BYTES REMAINING
*DCR A
*RM .  FINISHED
*STA BXRZ+1
*
* THIS IS THE PATCH TO FIX THE RAM DISK EOS BUG
 LHLD BXRZ   GET RECORD SIZE
 LXI  D,-512
 DAD  D      TAKE OFF 512 FOR THE BLOCK JUST WRITTEN
 MOV  A,H
 ORA  A      <0?
 RM   .      YES .. WE'RE DONE
 ORA  L      ZERO?
 RZ   .      YES ..
 SHLD BXRZ
* END OF PATCH
 LHLD BXFR
 INX H
 SHLD BXFR
 LXI H,BXXA+1
 INR M  ADD 512 TO DEST. ADDR.
 INR M
 JMP WDSK6
*
* INITIAL TRANSFER DISCRIPTOR
HBXD DB 0,RDOP  UNIT,OP
 DW 512  # BYTES
HBXFR DW 0  SECTOR #
 DW IHEAD  BUFFER AT IHEAD AND 500 BYTES AFTER
 DB 0  RESULT
*
*
*
******************
*
*
*  HERE WE RETURN TO THE SYSTEM
*
INTD0 DI .  NO INTERRUPT
 XRA A
 STA IFLG2  SAY WE ARN'T DONE BECAUSE WE WERE
 LXI H,0  CLEAN HOUSE
 SHLD INRET  BE VERY SURE
 SHLD INTRT  EVERY ONE IS CLEAR
 SHLD DRVRT  EVEN HIM
 LHLD DSKRT  GET BACK SYSTEM STACK
 SPHL .  NORMAL AGAIN
*OUT ADRLO  RESET CONTROLLER FLAGS
*
*   TEST IF INTERRUPTS SHOULD BE RE-ENABLED AND DO SO IF
*
TSTEI LDA IFLG1
 ORA A
 RZ .  NOPE
*EI .  YUP
 RET
*
*
*****************************************
*
*
*
*    THIS ENTRY POINT IS FROM DDONE IF A TASK HANDLER
*  WAS PRESENT.  THE HANDLER CALLS HERE WHEN IFLG2 IS
*  <0>.
*
INTDN LHLD INTRT  SEE IF A TASKER STACK IS LAYING AROUND
 MOV A,H
 ORA L
 JNZ INTD0  SEEMS LEGAL??
*
*  BAD, BAD, BAD
*
 CALL ERRL0
 DB ERIDA  ILLEGAL DRIVER ACCESS
*
*
******************
*
*
*
*              INTERRUPT PROCESSING ROUTINES
*
*
*   THE EXTERNAL TASK ROUTINE COMES HERE THROUGH THE ENTRY
*   POINT AREA TO SEE IF WE CAUSED AN INTERRUPT.  IF WE
*   DID THEN CONTROL RETURNS TO THE INTST CALL.  IF NOT
*   THEN CONTROL RETURNS TO THE  INTERRUPT HANDLER.
*
INTDK DI .  JUST IN CASE
 LHLD INRET  WAS IT US?
 MOV A,H
 ORA L
 RZ .  COULDN'T BE US...WE'RE NOT HERE!!!
 PCHL .  GO FIND OUT IF WE DID
*
*******************
*
*
*     WRITE DISK HEADER (AND DATA)   WDSKH  ***
*
*
*   OHEAD IS SET UP BY CALLER
*
*   WRITE HEADER FOLLOWED BY DATA BLOCK
*
WDSKH  EQU $
 LHLD OHFID
 SHLD TFID
 CALL LKCHK
 LHLD TSEC
 SHLD OHEAD
 SHLD HBXFR
 MOV A,L
 ANI 7
 MOV B,A
 LDA TUNIT
 STA HBXD  SET UNIT
*
*  CHECK FOR WRITE OVER INDEX
*
 LDA OHPRO
 ANI 7
 ADD B
 CPI 9
 JNC SZCON  ERROR- BLOCK CROSSES TRACK DIVISION
 LXI H,IHEAD
 LXI D,OHEAD
 CALL MOVEF
 DB HELEN
 JMP WDSK2  TRANSFER DATA NOW
*
**************
*
*     TEST IF SYSTEM IS LOCKED
*
*  ERROR THROUGH ERRL0
*  NORMAL  SET OPERATION AND RETURN
*
LKCHK LDA SWLOK  TEST IF WRITE LOCKED
 RRC
 JC LOKER  YES, SWITCH IS SET
 MVI A,WROP
*
*   SAVE OPERATION AND CLEAR THE TASK AND INTERRUPT
*   STUFF
*
OPSE1 STA BXOP  SET OPERATION FOR LATER
 LXI H,0  SET UP STACK FOR RETURN
 POP D  GET THIS CALL OFF STACK
 DAD SP  GET SYSTEM RETURN WITH STACK
 SHLD DSKRT
 PUSH D  OUR CALL GOES BACK ON
 JMP  BLKLN  SET UP TRANSFER PARAMETERS AND RETURN
*
*
*
*
*
*     THIS ROUTINE CALCULATES THE TRANSFER SIZE FROM THE
*   HEADER INFORMATION AND SETS THE NUMBER OF SECTORS
*   INTO OHPRO.
*
*
BLKLN LHLD TBCNT  GET COUNT FROM TRANSFER DESCRIPTOR
 SHLD OHSIZ
 CALL AFCALC  CALCULATE NUMBER OF SECTORS
 LDA OHPRO  OUTGOING HEADER PROTECTION WORD
 ANI 80H  CLEAR PREVIOUS COUNT
 ORA C  ADD IN THE SECTOR COUNT
 STA OHPRO  PUT IT BACK
 RET
*
*
*
******************
*
*
*        DISK ERROR PROCESSOR
*
FMTER CALL DEREP  CAN'T FIND SECTOR
 DB ERCFS
*
BLKER CALL DEREP  SIZE CONFLICT
 DB ERBSC
*
FIERR CALL DEREP  FID CONFLICT
 DB ERFIC
*
SZCON CALL DEREP  SECTOR CONFLICT
 DB ERSCC
*
TRYER CALL DEREP  DRIVER ERROR
 DB ERDRI
*
ERTRK CALL DEREP
 DB ERCFT
*
LOKER CALL DEREP  SYSTEM LOCKED
 DB ERLOK
*
******************
*
*
*                DISK ERROR REPORT ROUTINE
*
*   CONTROL GOES TO ERRL0 EVENTUALLY
*   CALL WITH CALL+1 = ERROR #
*
DEREP CALL DREP  PRINT ID, TRACK, ETC.
 JMP ERRL0   JUST GIVE ERROR
*
*
*     SUBROUTINE TO PRINT FILE ID, TRACK, IHFID, IHSIZ
*   AS A PREFIX TO AN ABORT MESSAGE
*   BUT,... SKIP IF ERROR IS USER TRAPPED
*
DREP LHLD FERR
 MOV A,H
 ORA L  IS SOMEONE ELSE HANDLING THE ERROR?
 RNZ .  YES, NOTHING TO DO
 CALL OUST  SAY SOMETHING
 DB CR
 DB LF
 ASC "DSK:"
 DB 0
*
 CALL O16N  PRINT # POINTED TO BY CALL+1, ALSO BLANK
 DW TFID
 CALL O16N
 DW TDAD  TRACK AND SECTOR
 CALL O16N
 DW IHFID
 CALL O16N
 DW IHSIZ
 RET
*
******************
*
*
*          ERROR HANDLER FOR SYSTEM
*
*               ***  NOTE  ***
*
*   EOPR AND ERCD GET MODIFIED BY THE SYSTEM
*
ERRP9 CALL UTILTY  DO THE ERROR TYPEOUT
 DB UXOP
 JMP SRE50  ERROR!!!
EOPR DB -1  DOS OPERATION
ERCD DB -1  ERROR CODE
 JMP SRE50  JUST IN CASE OF SCREWUPS
*
*
*
 PAGE
***********************
*
*
*
*                  DEFINE THE TOP OF THE SYSTEM
*
*
MEMTOP EQU 0C000H  ABSOLUTE TOP
*
 ORG MEMTOP  DEFINE THE BIG BUFFERS
*
 DS -256  COME DOWN ONE SECTOR SIZE
 DS -320  PLUS ANOTHER BIG ONE
OLBUF EQU $  OVERLAY BUFFER
*
 DS -256  NOW ANOTHER SECTOR
CXBUF EQU $  COMMAND EXECUTION BUFFER
*
*
*
*            NOW FOR THE TOP OF THE SYSTEM
*
SYSTOP EQU $-1
*
NUENT EQU 15  NUMBER OF JUMP ENTRYS
EPLEN EQU 3*NUENT+6  JUMPS+DW
*
 ORG SYSTOP-EPLEN  LENGTH OF ENTRY POINT AREA
*
*
*    FIXED ENTRY POINT AREA
*
 DW CIVDM  -> VDM DRIVER OUTPUT CHAR
 DW CIWCH  -> TERMINAL OUTPUT CHAR
 JMP SDIRY  SEARCH DIRECTORY BY ID
 JMP INTDK  CONTINUE INTERRUPT PROCESSING
 JMP INTDN  PROCESSING DONE
 JMP PSCAN  PARAMETER SCANNER
 JMP CONST  CONSOLE TEST INPUT
 JMP CONOUT  CONSOLE OUTPUT 1 CHAR
 JMP CONIN  CONSOL INPUT 1 CHAR
 DW CIFILE  FIXED PARM AREA
 JMP ERRL2  ERROR LEVEL I
 JMP ERRL1  1
 JMP ERRL0  0
 JMP USRES  SHORT RESET
 JMP UTILTY  UTILITY CALL
 JMP WB  WRITE BYTE
 JMP RB  READ BYTE
 JMP SYS  MAIN CALL
*
AP2 EQU $  LAST BYTE + 1 OF RESIDENT
*
 PAGE
*
*
*
*
*
*
*               ONCE ONLY CODE FOLLOWING BOOTSTRAP.
*
*   THIS CODE LOADS THE SYSTEM GLOBAL AREA AND
*   ADJUSTS THE INITIAL FCBS'S POSITIONS.
*
 ORG CXBUF  PART OF THE SYSTEM
*
RESET DI .
 LXI SP,CISTK  SETUP STACK
 LXI H,SAM+7FFH MAKE SURE THAT THIS VERSION OF PTDOS MATCHES
 LDA REVNR     THE DRIVER IN SAM
 CMP M         DOES IT?
 JNZ REVER     NO .. !! THEN ABHORT THE BOOTING
 LXI H,0
 SHLD DSKRD  CLEAR THE DRIVE NOT READY TRAP
 SHLD AERR  CLEAR ANY ERROR HANDLING
 SHLD FERR
 SHLD EERR
 DCX H  =-1
 SHLD BDSK1  CLEAR ANY INTERRUPT LINK
 SHLD BDSK2
 XRA A
 STA IFLG1  DON'T RESTORE INTERRUPTS
 MVI A,2  SET MAXUN TO 2 TO INITIALIZE PROPERLY
 STA MAXUN
 CALL DDRI  INITIALIZE DISK DRIVER
*
*   LOAD THE SYSTEM GLOBAL AREA
*
 LXI D,RESPA
 LXI H,TDAD
 CALL MOVEF  MOVE SYSGLOBL DESCRIPTOR
 DB TUNIT-TDAD+1
*
 CALL RDSK  READ IT IN
*
*   NEXT, MOVE THE FCB'S TO THE RIGHT PLACE
*
 LXI D,SP1  MOVE FROM HERE
 LHLD FCBASE  TO HERE
 LXI B,MINFCB*LNFCB  = LENGTH
 CALL MOVEV
*
*   ZERO THE UNUSED FCB'S
*
 LHLD FCBASE
 LXI D,LNFCB  = FCB LENGTH
 LDA SYSFIL  = NUMBER OF ALLOCATED FCB'S
*
INI10 ORA A
 JZ INI20  HL -> FIRST UNUSED FCB, GO ZERO
 DAD D
 DCR A
 JMP INI10
*
*
INI20 XCHG .  DE -> FIRST WORD TO ZERO
 LXI H,SGAREA  HL -> FIRST WORD NOT TO ZERO
INI25 CALL COMP
 JNC INI30  ALL DONE
 XRA A  = 0
 STAX D
 INX D
 JMP INI25  OK FOR NEXT
*
*
*                INITALIZE I/O DRIVERS
*
*    IF SOLOS/CUTER, SEND I/O TO SAME PLACE AS CURRENT
*    PSEUDO-PORT.  ELSE, SEND IT TO CUTER-TYPE SERIAL PORT.
SAM   EQU  0F000H
*
INI30 LXI H,VSCREN  INITIALIZE VDM
 SHLD VDMAD  SO USER CAN DO AN OUT V COMMAND LATER
 XRA A
 STA BOT
 STA KNTT
 STA SPEED
*
 LDA SAM       THERE IS, DETERMINE WHICH
 LXI D,SOLTAB  ASSUME SOLOS TILL PROVEN GUILTY
 CPI 0
 JZ INI40      SOLOS EXISTS
 LXI D,CUTTAB  ASSUME CUTER SINCE IT WASN'T SOLOS
*
INI40 LHLD SAM+1AH  GET OUTPUT PSEUDO-PORT NUMBER
 MOV A,M
 CALL LKTAB  MOVE TO PROPER TABLE ENTRY
 CALL MODO  NOW UPDATE THE INTERNAL OUTPUT DRIVERS
*
 LHLD SAM+20H  GET INPUT PSEUDO-PORT NUMBER
 MOV A,M
 CALL LKTA2  MOVE TO THE PROPER TABLE ENTRY
 CALL MODI  NOW UPDATE THE INTERNAL INPUT/TSTCHR DRIVERS
*
 LHLD SAM+1AH  GET OUTPUT PSEUDO-PORT NUMBER
 MOV A,M
 ANI 3  IS IT VDM?
 JNZ INI60  NOPE
 LHLD WCH  YES-SET DRIVER POINTER TO VDM DRIVER
 LXI D,-CIWCH
 DAD D
 MOV A,H
 ORA L
 JNZ INI60  UNLESS, OF COURSE, USER HAS ALLREADY CHANGED IT
 LXI H,CIVDM
 SHLD WCH
 XRA A
 OUT VPORT
 CALL OUST  CLEAR SCREEN
 DB CR,LF,CR,LF,CR,LF,CR,LF,CR,LF,CR,LF,CR,LF,CR,LF
 DB CR,LF,CR,LF,CR,LF,CR,LF,CR,LF,CR,LF,CR,LF,CR,LF
 DB 0
 JMP INI60
*
*
*   SAY IT ALL
*
INI60 CALL OUST  SAY SOMETHING
 DB CR,LF,CR,LF,CR,LF
 ASC "PTDOS 2.0 Rev AA Nov 88"
 DB CR,LF
 ASC "Copyright 1978"
 DB CR,LF
 ASC "Processor Technology Corporation"
 DB CR,LF
 ASC "Implemented Feb 88 by D. Sherratt"
 DB CR,LF
 DB 0
*
*   SEE IF WE WANT A LOG FILE
*
 LDA SWLOG  GET LOG FILE SWITCH
 ORA A
 JZ INVRB
*
INLOG LXI H,-1  STATIC BUFFERING
 SHLD AERR
 SHLD EERR
 SHLD FERR
 INX H
 LXI D,LNAME  THE LOG FILE NAME
 CALL SYS
 DB OPEOP  OPEN IT
*
 JMP INCRE
 SHLD AERR
 SHLD FERR
 MVI D,-1
 CALL SYS
 DB SPAOP  SPACE TO END
 JMP USRES  RESET IF NOT
 STA ECFILE  SET AS ECHO FILE
 INR A
 STA SYSFIL  CAN'T CLOSE IT NOW
 XRA A
 STA UA  SET FOR NO ERROR REPORT FROM RESET
 JMP INVRB
*
*
INCRE CPI ERNEX  DOESN'T EXIST?
 JNZ USRES
 LXI D,LCBLK
 CALL SYS
 DB CREOP  CREATE IT
 JMP USRES
 JMP INLOG
*
*
*   OPEN AN INPUT FILE FOR GOOD COMMANDS
*
INVRB LDA SWVRB  SEE HOW TALKATIVE WE ARE
 ORA A
 JZ SRESET  OPEN ONLY IF VERBOSE IS WANTED
 LXI D,CNAME  NAME OF FILE
 LXI H,0  STATIC BUFFERING
 CALL SYS
 DB OPEOP
 JMP USRES  SHORT RESET IF ERROR
 STA CIFILE  IT IS FOR INPUT
 CALL SYS
 DB RETOP  RETURN TO RUNIT
*
REVNR EQU  $
  DB  0AAH   THIS BYTE MUST MATCH THE LAST BYTE IN SAM ROM
*            OR THE DRIVER WILL CORRUPT PTDOS FILES
REVER EQU  $
  CALL OUST
  DB   LF,CR
  ASC  "THIS VERSION OF PTDOS DOES NOT MATCH THE DISK DRIVER"
  DB   LF,CR
  ASC  "IN SAM.  BOOT ABHORTED !"
  DB   LF,CR,0
  JMP  SAM+4     QUIT
*
*
*
CNAME ASC "start.up/0"  THE SYSTEM START UP FILE
LCBLK DB 80H  TYPE
 DW 256  BLOCK SIZE
 DB 0  NO ATTRIBUTES
LNAME ASC "syst.log/0"  THE SYSTEM LOG FILE
*
*
*
*  SYSTEM GLOBAL FILE DESCRIPTOR
*
RESPA DW DASPB  SECTOR #
 DW LNSPA  LENGTH
 DW IDSPA  FILES ID NO.
 DW MASPA  LOAD ADDRESS
 DB 0  UNIT
*
*
*
*
*
*
*
*
*      DRIVE AND DRIVER INITIALIZATION ROUTINES
*
*  THIS ROUTINE INITIALIZES ALL DRIVES AND SETS THE
*  TRACK COUNT VALUES IN THE UNIT TABLE TO ZERO.
*
DDRI LDA MAXUN  NO. OF DRIVES TO RESTORE
DDRI1 DCR A
 LXI H,BXD+1
 MVI M,INIOP  OPCODE FOR INITIALISE
 DCX H  =BXD =UNIT
 MOV M,A  =HIGHEST UNIT NO.
DDRI2 CALL XFER
 NOP  NO ERRORS FOR INITIALISE
 NOP
 NOP
 LXI H,BXD
 DCR M   NEXT UNIT
 RM   FINISHED
 JMP DDRI2
*
*
*
*
*
****************************************************************
*
*  MOVE TO TABLE ENTRY SPECIFIED BY A (TABLE POINTED TO BY DE)
*
LKTA2 INX D  ENTRY HERE FOR INPUT TABLE
 INX D  (INPUT IS 4 BYTES PAST OUTPUT)
 INX D
 INX D
LKTAB MOV H,D  ENTRY HERE FOR OUTPUT TABLE
 MOV L,E
 ANI 3
 CPI 3
 JNZ LKTA5
 MVI A,1  IF PSEUDO-PORT WAS 3 (CUSTOM), MAKE IT A 1 (SERIAL)
LKTA5 ADD A  ENTRIES ARE 8 LONG, SO MULTIPLY BY 8
 ADD A
 ADD A
 MOV C,A
 MVI B,0
 DAD B  ADD TO CORRECT ENTRY
 RET .  RETURN WITH HL POINTING TO ENTRY DESIRED
*
*************************
*
MODO MOV A,M  MODIFY OUTPUT DRIVERS
 STA STBYT
 INX H
 MOV A,M
 STA STBYT+1
 INX H
 MOV A,M
 STA STBYT+3
 INX H
 MOV A,M
 STA DABYT
 RET .
*
MODI MOV A,M  MODIFY INPUT DRIVERS
 STA CITCH+1
 INX H
 MOV A,M
 STA CITCH+2
 INX H
 MOV A,M
 STA CITCH+4
 INX H
 MOV A,M
 STA CIRCH+7
 RET .
*
****************************************
*
*           I/O DRIVER MODIFICATION TABLES
*
*   NOTE:  IF THE CURRENT-PSEUDO PORT WAS 0, THE DRIVER
*   GETS MODIFIED TO THE SERIAL PORT, BUT THE SYSGLOBL
*   POINTER POINTS TO THE VDM DRIVER INSTEAD. SO IF AN
*   OUT P COMMAND IS DONE, OUTPUT WILL GO SERIAL.
*
********************
*
SOLTAB EQU $  TABLE FOR SOLOS-TYPE PORTS
*
*****  IF CURRENT PSEUDO-PORT WAS ZERO  (VDM/KBD)
*
 DB 0F8H  OUTPUT STATUS PORT
 NOP .  DON'T INVERT STATUS BITS
 DB 080H  MASK FOR READY BIT
 DB 0F9H  OUTPUT PORT
*
 DB 0FAH  INPUT STATUS PORT
 CMA .
 DB 1  MASK FOR READY BIT
 DB 0FCH  INPUT PORT
*
*****  IF CURRENT PSEUDO-PORT WAS 1 OR 3  (SERIAL)
*
 DB 0F8H
 NOP .
 DB 80H
 DB 0F9H
*
 DB 0F8H
 NOP .
 DB 40H
 DB 0F9H
*
*****  IF CURRENT PSEUDO-PORT WAS 2  (PARALLEL)
*
 DB 0FAH
 CMA .
 DB 4
 DB 0FDH
*
 DB 0FAH
 CMA .
 DB 2
 DB 0FDH
*
********************
*
CUTTAB EQU $  TABLE FOR CUTER-TYPE PORTS
*
*****  IF CURRENT PSEUDO-PORT WAS 0  (VDM/KBD)
*
 DB 0
 NOP .
 DB 80H
 DB 1
*
 DB 2     PARALLEL KBD
 NOP .
 DB 20H
 DB 4
*
*****  IF CURRENT PSEUDO-PORT WAS 1 OR 3  (SERIAL)
*
NEITAB DB 0  THIS TABLE IS ALSO USED IF NEITHER SOLOS OR CUTER
 NOP .
 DB 80H
 DB 1
*
 DB 0
 NOP .
 DB 40H
 DB 1
*
*****  IF CURRENT PSEUDO-PORT WAS 2  (PARALLEL)
*
 DB 0
 CMA .
 DB 4
 DB 2
*
 DB 0
 CMA .
 DB 2
 DB 2
*
****************************************************************
*
 PAGE
*
*
*
*
 ORG 07000H
*
*
*                   SYSTEM LOADER
*
*  THIS SET OF ROUTINES WHOSE STARTING ADDRESS
*  IS LISTED ABOVE ESTABLISHES AN INITIAL SYSTEM
*  ON A PRE-WRITTEN DISK IN DRIVE 0, UNIT 0.
*
*
*  START AT LDR01 TO JUST REWRITE THE SYSTEM LEAVING
*  EVERYTHING ELSE ALONE
*
*
LDR XRA A
 STA UPFLG
LDR01 LXI SP,LDSTK  SET STACK UP
 CALL LDRI  INITIALIZE DRIVER
*
*  WRITE OUT RESIDENT
*
 LXI D,LRES
 CALL LPTD  SET TRANSFER DESCRIPTOR
 LXI D,LRESH
 CALL LPHD  SET OUTGOING HEADER
 CALL LWDSH  WRITE OUT
*
*
 LXI D,LRES2
 CALL LPTD  SET TDAD
 LXI D,LRESD
 CALL LPHD  SET OHEAD
 CALL LWDSH  WRITE OUT
*
*  WRITE OUT SYSTEM GLOBAL AREA
*
 LXI D,LSGL
 CALL LPTD  SET TRANSFER DESCRIPTOR
 LXI D,LSGLH
 CALL LPHD  SET OUTGOING HEADER
 CALL LWDSH  WRITE OUT
*
* IF UPDATE ONLY, STOP
*
 LDA UPFLG
 ORA A
 JNZ LDR60
*
*  WRITE OUT BOOTSTRAP
*
*LXI D,LBOO
*CALL LPTD  SET TRANSFER DESCRIPTOR
*LXI D,LBOOH
*CALL LPHD  SET OUTGOING HEADER
*CALL LWDSH  WRITE OUT
*
 DB 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
*  WRITE NEXT ID FILE
*
 LXI D,LNIF
 CALL LPTD  SET TRANSFER DESCRIPTOR
 LXI D,LNIFH
 CALL LPHD  SET OUTGOING HEADER
 CALL LWDSH  WRITE OUT
*
*    INITIALIZE EMBRYONIC DIRECTORY
*
*  WRITE FIRST SECTOR
*
 LXI D,LDS0
 CALL LPTD  SET TRANSFER DESCRIPTOR
 LXI D,LDS0H
 CALL LPHD  SET OUTGOING HEADER
 CALL LWDSH  WRITE OUT
*  LOOP AND WRITE REST OF DIRECTORY
 MVI A,DICNT-2
 STA LDCNT  SET COUNT OF REMAINING SECTORS
*  SET HEADERS
 LXI D,LDS1
 CALL LPTD  SET TRANSFER DESCRIPTOR
 LXI D,LDS1H
 CALL LPHD  SET OUTGOING HEADER
*
*  IF LAST SECTOR, SET EOF
*
LDR20 LDA LDCNT
 ORA A  =O?
 JNZ LDR30  NO, NOT LAST SECTOR
*  SET EOF
 LXI H,EOFCD
 LXI D,SECTSZ
 DAD D  EOF+COUNT
 SHLD LOHFOR  SET IN FORE PTR.
*
LDR30 CALL LWDSH  WRITE
*  UPDATE POINTERS
 LXI H,LTSEC  PTR TO SECTOR ADDRESS
 INR M
 LXI H,LOHFOR  PTR TO SECTOR FORE PTR
 INR M
 LXI H,LOHBAK  PTR TO SECTOR BACK PTR
 INR M
*  CHECK COUNT
 LDA LDCNT
 ORA A
 JZ LDR40
 DCR A  NOPE
 STA LDCNT
 JMP LDR20  DO NEXT SECTOR.
*
*
LDR40 MVI B,80
 MVI A,-1
 LXI H,FMBF
*  ZERO THE FSM
LDR42 MOV M,A
 INX H
 DCR B
 JNZ LDR42
 LXI H,FMBF
 INR A  =0
 MOV M,A
 INX H
 MOV M,A
 INX H
 MOV M,A
 LXI H,FMBF+25  DIR TRK
 MOV M,A
 INX H
 MOV M,A  FSM,NID
*  WRITE OUT FSM
 LXI D,LFSM
 CALL LPTD  SET TRANSFER DESCRIPTOR
 LXI D,LFSMH
 CALL LPHD  SET OUTGOING HEADER
 CALL LWDSH
*
*
*    LOAD COMPLETE
*
*
LDR60 CALL OUST
 DB LF,CR  CRLF
 ASC 'Load Complete
 DB LF,CR  AGAIN
 DB 0
DONE JMP 0F004H  HEAD ON UP TO SAMDI
*
*
* PREPARE TRANSFER DESCRIPTOR
*
LPTD LXI H,LTDAD
 CALL MOVEF
 DB LTUNIT-LTDAD+1
 RET
*
*  PREPARE OUTGOING HEADER
*
LPHD LXI H,LOHFOR
 CALL MOVEF
 DB OHPRO-OHFOR+1
 RET
*
*
*  THESE TABLES DESCRIBE THE MODULES TO BE
*  LOADED.
*
*  RESIDENT
*
*
LRES DW DAREB  DISK ADDRESS
 DW 4084  LENGTH
 DW IDRES  ID
 DW 0A002H  ADDRESS <<-----------------<< WATCH MARES!!
 DB 0  UNIT
*
LRESH DW D2REB  FORE
 DW BOFCD
 DW IDRES
 DB 0  (PROTECTION)
*
*
LRES2 DW D2REB  SECTOR
 DW 4084  LENGTH
 DW IDRES  ID
 DW 0AFF6H  ADDRESS
 DB 0  UNIT
*
LRESD DW EOFCD+4084  FORE
 DW DAREB  BACK
 DW IDRES  ID
 DB 0  PROT
*
*  BOOTLOAD
*
BOLEN EQU   FULSZ+SECTSZ  TWO SECTORS WORTH
*
LBOO DW DABOS  SECTOR
 DW BOLEN  LENGTH
 DW IDBOT  ID
 DW 0F900H  ADDRESS
 DB 0  UNIT
*
LBOOH DW EOFCD+BOLEN  FORE  (BOCNT=BOLEN ???)
 DW BOFCD  BACK
 DW IDBOT  ID
 DB 0  PROTECTION
*
*  SYSTEM GLOBAL
*
LSGL DW DASPB  SECTOR
 DW LNSPA  COUNT
 DW IDSPA  ID
 DW SP1  MEMORY ADDRESS
 DB 0  UNIT
*
LSGLH DW SP2-SP1+1+EOFCD
 DW BOFCD  BACK
 DW IDSPA  ID
 DB 0  PROT.
*
*  NEXT ID  FILE
*
LNIF DW DANIB  SECTOR
 DW NIDBC  COUNT
 DW IDNID  ID
 DW LIDBF  ADDRESS
 DB 0  UNIT
*
LNIFH DW EOFCD+NIDBC  FORE
 DW BOFCD  BACK
 DW IDNID  ID
 DB 0  PROT.
*
*  FSM
*
LFSM DW DAFSB  SECTOR
 DW 80  LENGTH
 DW IDFSM  ID
 DW FMBF  ADDR
 DB 0  UNIT
*
LFSMH DW EOFCD+80  FORE
 DW BOFCD  BACK
 DW IDFSM  ID
 DB 0  PROTECT
*
*  DIRECTOR SECTOR  0
*
LDS0 DW DIRDB  SECTOR
 DW SECTSZ  SIZE
 DW IDDIR  ID
 DW DS0  ADDRESS
 DB 0  UNIT
*
LDS0H DW DIRDB+1  FORE
 DW BOFCD  BACK POINTER
 DW IDDIR  ID
 DB 0  PROT.
*
*  DIRECTORY SECTORS  1 TO 15
*
LDS1 DW DIRDB+1  SECTOR
 DW SECTSZ  SIZE
 DW IDDIR  ID
 DW DS1  ADDRESS
 DB 0  UNIT
*
LDS1H DW DIRDB+2  FORE
 DW DIRDB  BACK
 DW IDDIR  ID
 DB 0  UNIT
*
*
*    INITIAL DIRECTORY
*  FIRST SECTOR
*
*
DS0 DB 6  NUMBER OF ENTRIES
 DW DS0N-DS0  NEXT ENTRY DISPLACEMENT
*
 ASC 'DIRECTRY'
 DB BNTYP  TYPE
 DW SECTSZ  BLOCK SIZE
 DB PDEL+PWRI+PFINF+PATR+PNAT
 DW IDDIR  ID
 DW 0  INDEX FILE POINTER
 DW DIRDB  DISK
 DW DICNT  BLOCK COUNT
*
 ASC 'NEXTID'
 DB 0
 DB 0
 DB BNTYP  TYPE
 DW NIDBC  BLOCK SIZE
 DB PDEL+PWRI+PATR+PNAT+PFINF
 DW IDNID  ID
 DW 0  INDEX
 DW DANIB  FBA
 DW 1  BLOCK COUNT
*
 ASC 'FSMAP'
 DB 0
 DB 0
 DB 0
 DB BNTYP  TYPE
 DW 80     BLOCK SIZE
 DB PDEL+PWRI+PATR+PNAT+PFINF
 DW IDFSM  ID
 DW 0  INDEX
 DW DAFSB  DA
 DW 1  BLOCK COUNT
*
 ASC 'SUTIL'
 DB 0
 DW 0
 DB BNTYP  TYPE
 DW 500    BLOCK SIZE
 DB PDEL+PNAT+PFINF
 DW 8   ID
 DW 214  INDEX
 DW 210    DISK
 DW 4  BLOCK COUNT
*
 ASC 'SYSGLOBL'
 DB BNTYP  TYPE
 DW LNSPA  BLOCK SIZE
 DB PDEL+PWRI+PATR+PNAT+PFINF
 DW IDSPA  ID
 DW 0  INDEX
 DW DASPB  DISK
 DW 1  BLOCK COUNT
*
 ASC 'RESIDENT'
 DB BNTYP  TYPE
 DW 4084  BLOCKSIZE
 DB PDEL+PWRI+PREA+PFINF+PATR+PNAT
 DW IDRES  ID
 DW 0  INDEX
 DW DAREB  DA
 DW 2  BLOCK COUNT
DS0L EQU $
*
DS0N EQU DS0L  DISPLACEMENT TO NEXT ENTRY
*
*
*  IMAGE OF REMAINDER OF DIRECTORY SECTORS
*
*
DS1 DB 0  NUMBER OF ENTRIES
 DW 3  NEXT ENTRY DISPLACEMENT
 DW 0
*
*  NEXT ID FILE IMAGE
*
LIDBF DW 22H NEXT FILE ID.
*
*
*  TEMP STORAGE FOR LOADER
*
*
LDCNT RES 1  DIRECTORY ENTRY COUNTER
UPFLG DB 1
*
*  TRANSFER DESCRIPTOR
*
LTDAD RES 2  DISK ADDRESS
LTSEC EQU LTDAD
LTBCNT RES 2  BYTE COUNT
LTFID RES 2  FILE ID
LTBUF RES 2  BUFFER ADDRESS
LTUNIT RES 1  UNIT
*
*  INCOMMING HEADER
*
LIHEAD RES 2  DISK ADDRESS
LIHSEC EQU LIHEAD
LIHFOR RES 2  FORE
LIHBAK RES 2  BACK
LIHFID RES 2  ID
LIHPRO RES 1  PROT-SIZE
LIHSIZ RES 2  BLOCK SIZE
LIHSPR RES 2  EXPANSION ROOM
*
*  OUTGOING HEADER
*
LOHSEC RES 2  SECTOR AND TRACK BUFFER
LOHFOR RES 2  FORE
LOHBAK RES 2  BACK
LOHFID RES 2  ID
LOHPRO RES 1  PROT-SIZE
LOHSIZ RES 2  BLOCK SIZE
LOHSPR RES 2  MORE ROOM
*
LOHEA EQU LOHSEC
*
*  LOADER STACK
*
 RES 20
LDSTK DB 0
*
FMBF DS 80+2  BEGINNING OF 80 ZERO BUFFER
*
*
BUFEND EQU $
*
*
*   DISK WRITE ROUTINES FOR SYSTEM LOADER
*
LDRI MVI A,1  ONLY INITIALISE 1 DRIVE
 JMP DDRI1
*
*
*
LWDS2 LXI B,SECTSZ
 LXI D,RWBUF
 LHLD LTBUF
 XCHG .  SWITCH SOURCE,DEST. FOR WRITE
 CALL MOVEV
* WRITE BUFFER TO DISK
 LXI H,HBXD+1
 MVI M,WROP
 DCX H  POINT TO START OF BXD TABLE
 CALL XFER
 JMP  SZCON
* CHECK IF MORE THAN 1 SECTOR TO DO
LWDS5 LDA IHPRO
 ANI 15
 DCR A
 RZ .  NO MORE TO DO
 LHLD LTBUF
 LXI D,SECTSZ
 DAD D
 SHLD BXXA
 LDA  LTUNIT
 STA  BXDEV
 LHLD LTBCNT
 LXI D,-SECTSZ
 DAD D
 SHLD BXRZ
 LHLD LTDAD
 INX H
 SHLD BXFR
*  DO REMAINING SECTORS
LWDS6 LXI H,BXD
 CALL XFER
 JMP SZCON
 LHLD BXRZ
 LXI  D,-FULSZ
 DAD  D
 SHLD BXRZ
 MOV  A,H
 ORA  A
 RM   .  FINISHED
 ORA  L
 RZ   .
 LHLD BXFR
 INX H
 SHLD BXFR
 LXI H,BXXA+1
 INR M  ADD 512 TO DEST. ADDR.
 INR M
 JMP LWDS6
*
*
*     WRITE DISK HEADER (AND DATA)   LWDSH  ***
*
*
*   LOHEAD IS SET UP BY CALLER
*
*   WRITE HEADER FOLLOWED BY DATA BLOCK
*
LWDSH  EQU $
 MVI A,WROP
 STA BXOP
 LHLD LOHFID
 SHLD LTFID
 CALL LBLKL
 LHLD LTSEC
 SHLD LOHEAD
 SHLD HBXFR
 XRA A
 STA HBXD  UNIT 0
 MOV A,L
 ANI 7
 MOV B,A
*
*  CHECK FOR WRITE OVER INDEX
*
 LDA LOHPRO
 ANI 7
 ADD B
 CPI 9
 JNC SZCON  ERROR- BOLCK CROSSES TRACK DIVISION
 LXI H,IHEAD
 LXI D,LOHEAD
 CALL MOVEF
 DB HELEN
 JMP LWDS2  TRANSFER DATA NOW
*
*
*     THIS ROUTINE CALCULATES THE TRANSFER SIZE FROM THE
*   HEADER INFORMATION AND SETS THE NUMBER OF SECTORS
*   INTO LOHPRO.
*
*
LBLKL LHLD LTBCNT  GET COUNT FROM TRANSFER DESCRIPTOR
 SHLD LOHSIZ
 CALL AFCALC  CALCULATE NUMBER OF SECTORS
 LDA LOHPRO  OUTGOING HEADER PROTECTION WORD
 ANI 80H  CLEAR PREVIOUS COUNT
 ORA C  ADD IN THE SECTOR COUNT
 STA LOHPRO  PUT IT BACK
 RET
*
*
*