 TITL Diskcopy command"Version November 27,1978  DDR
*
*
*
*
*
*                   DISKCOPY COMMAND
*
*    VERSION 2.0 MOD 0
*
*
*
*    ASSEMBLER DIRECTIVES
*
*
 ASCF 0
 IFLS .  LIST ALL "IF" CONDITIONALS
 COPY NPTDEFS  GET 1.4 DEFINITIONS
 ORG 100H
 XEQ CSTRT  DO THE PART THAT GETS EATEN FIRST
*
*
*    A FEW EQUATES
*
SECTSZ EQU 256  ONE SECTOR
FULSZ EQU 320  EACH ADDITIONAL SECTOR
CR EQU 10  A CARRIAGE RETURN
LF EQU 13
*
*
*
*
*
*        START UP ROUTINE AND BRANCH TO SELECTED OPTION
*
*
*   TEST OPTIONS IN A V,F,E,W SEQUENCE
*
COPY1 CALL DDRI  INITIALIZE THE DRIVES
*
 LXI H,MXUNT  CHECK IF IN-UNIT OR OUT-UNIT
 MOV A,M
 DCR A  ...IS >= MAX UNIT
 DCX H  POINT TO INUNT
 CMP M
 CC ER1  IF SO THEN ERROR
 DCX H  POINT TO OTUNT
 CMP M
 CC ER1
*
 LDA VEONL  VERIFY ONLY?
 ORA A
 JNZ VERIFY  NO NEED TO TEST OTHER FLAGS
*
*
*     TEST LOCK, UNIT ZERO AND OUTPUT UNITS HERE
*
 LDA DTUNT  GET DEFAULT UNIT
 CMP M  HL SET FROM ABOVE
 CZ ER4  ERROR OUT-UNIT SAME AS DEFAULT
*
 MOV A,M  GET OUT-UNIT
 ORA A
 CZ ER5  ERROR OUT-UNIT CAN'T BE ZERO
*
 LHLD SYSGLO  NOW POINT TO SYSTEM LOCK
 LXI D,GLLOK  POINT TO LOCK
 DAD D
 MOV A,M
 DCR A  TEST
 CZ ER9  SYSTEM LOCKED
*
*   BRANCH IF FORMAT
*
 LDA FMONL  FORMAT?
 ORA A
 JNZ FORMT  YUP
*
*   BRANCH IF ERASE
*
 LDA ERFLG  ERASE?
 ORA A
 JNZ DERAS  YUP THIS TIME
*
 PAGE
*
*
*******************************************
*
*
*          CODE FOR DISK TO DISK COPY
*
*
*   GIVE MESSAGE AND WAIT FOR A CR OR ESC
*
*
 CALL OUST
 DB CR,LF
 ASC 'Copy unit '
 DB 0
 LDA INUNT
 CALL UNOUT  OUTPUT THE UNIT NUMBER
 CALL OUST
 ASC ' to unit '
 DB 0
 LDA OTUNT
 CALL UNOUT
 CALL MWAIT  WAIT FOR KEY
*
*
*
*         NOW DO THE ACTUAL COPY
*
*
COPY XRA A
 STA TETRK  AND TRACK 0
*
RTRACK LXI H,TKBUF  GET CURRENT TRACK TO THE TRACK BUFFER
 LXI SP,STACK  RESET THE STACK IN CASE OF ERROR RETURNS
 LDA INUNT  BE SURE THE INPUT UNIT IS SELECTED
 STA TUNIT
 CALL CTRED  READ IN THE TRACK
*
RTRK1 EQU $  LEAVE THIS HERE....THE RETURN ADDRESS OF THE CALL
*
*  ENTIRE TRACK HAS BEEN READ...NOW DO THE WRITES
*
 LDA OTUNT
 STA TUNIT  CHANGE TO THE OUTPUT UNIT
 CALL SUNIT
 CALL SECHK  SEEK TO PROPER TRACK IN CASE OF DIFFERENT DRIVE
 LDA TETRK  GET WHICH TRACK
 CPI DITRK  THE DIRECTORY?
 CZ FMTRK  IF SO ERASE AND PRE FORMAT THE TRACK
*
*
TKOVR LXI H,TKBUF  RESET THE BUFFER
 SHLD TBUFP
*
*  START AT SECTOR ZERO
*
 XRA A
 STA TTSEC
 LDA OTUNT  GET OUTPUT UNIT
 STA TUNIT
 CALL SUNIT
*
WRCOP LHLD TBUFP  GET THE LOCATION POINTER
 MOV A,M
 ORA A
 JNZ WRCO1  USE TBUF HEADER IF IND=1
 LXI H,STDHD-1  CHANGE TO STANDARD HEADER
*
WRCO1 INX H  BUMP THE POINTER
 XCHG
 LXI H,TRBUF
 MVI C,HELEN  MOVE PROPER HEADER INTO TRBUF
 CALL HDSE1  MOVE IT OVER
*
*********************
*
*  NOW WRITE THE HEADER
*
 CALL XDSKH  WRITE THE HEADER
 JMP WDERR  WRITE HEADER ERROR
 LHLD TBUFP
 INX H
 LXI D,HELEN
 DAD D  POINT TO DATA
 CALL WDNOP  AND WRITE IT
 JC WDERR
*
*   DATA WAS WRITTEN...PROCESS THE BUFFER
*
 LHLD TBUFP
 MOV A,M
 ORA A
 INX H  MOVE PAST INDICATOR
 MVI B,1  IN CASE OF BRANCH WE WROTE ONLY ONE SECTOR
 JZ WDNO2  NO REAL DATA, JUST SPACE OVER INDICATOR
*
 LXI D,HELEN
 DAD D  SKIP OVER HEADER
 XCHG
 LHLD TBCNT
 DAD D  NOW SKIP THE DATA
 LDA OHPRO  BLKLN HAS SET IT
 ANI 15  MASK THE UPPER BITS
 MOV B,A  NUMBER OF SECTORS IS IN B
*
*  THIS SECTOR IS WRITTEN STORE THE NEW POINTER
*
WDNO2 SHLD TBUFP
 LDA TTSEC  THE BLOCK JUST WRITTEN
 ADD B  ADD IN THE SECTOR COUNT
 STA TTSEC  EQUALS THE NEW SECTOR
 CPI 16
 JC WRCOP  LOOP UNTIL ALL 16
*
*
*  THE TRACK IS WRITTEN, LOOP TO READ IF COPY NOT FINISHED
*
NETRK XRA A  RESET THE SECTOR
 STA TTSEC
 LDA TETRK
 INR A  POINT TO THE NEXT TRACK
 STA TETRK
 CPI 77
 JC RTRACK  NOW DO THE NEXT TRACK
 JMP COPDN  WAY UP ON TOP SO WE CAN EAT THIS CODE
*
 PAGE
*
*
*******************************************
*
*
*   THIS CODE VERIFYS TWO DISKS FOR ABSOLUTE EQUALITY
*
*
VERIFY LDA INUNT
 LXI H,OTUNT
 CMP M
 JNZ VERF1
 CALL OUST
 DB CR,LF
 ASC 'Verify unit '
 DB 0
 JMP VERF2
*
VERF1 CALL OUST
 DB CR,LF
 ASC 'Compare units '
 DB 0
 LDA INUNT
 CALL UNOUT
 CALL OUST
 ASC " and "
 DB 0
VERF2 LDA OTUNT
 CALL UNOUT
 CALL MWAIT
*
 XRA A
 STA TETRK
*
*   MAIN LOOP FOR VERIFY
*
VERFM LXI H,TKBUF  FIRST READ THE IN UNIT
 LDA INUNT
 STA TUNIT
 CALL CTRED  READ IN THE TRACK
 SHLD IBEND  THE END OF THE INPUT BUFFER (HL SET FROM CTRED)
*
 LXI H,INUNT
 LDA OTUNT
 CMP M  SEE IF THEY ARE THE SAME
 JZ VTKDON  IF SO THEN SKIP ALL THE TESTS
 STA TUNIT
 LXI H,VEBUF  NOW THE OUT UNIT
 CALL CTRED
 SHLD OBEND  OUTPUT BUFFER END
 LXI D,VEBUF  AND THE START
 CALL DSUB  HL = HL - DE
 MOV B,H
 MOV C,L  BC HAS LENGTH OF OUTBUF
 LHLD IBEND
 LXI D,TKBUF
 CALL DSUB  HL GETS LENGTH OF INBUF
 MOV A,B
 CMP H
 JNZ NVERF  MUST BE THE SAME!!
 MOV A,C
 CMP L
 JNZ NVERF
*
*
*   NOW COMPARE THE CONTENT OF BOTH BUFFERS
*
*  BC = COUNT
*
 LXI H,TKBUF
 LXI D,VEBUF
*
VLOOP DCX B
 MOV A,B
 ORA C
 JZ VTKDON  THIS TRACK IS DONE
 LDAX D
 CMP M
 INX H
 INX D
 JZ VLOOP
*
NVERF CALL OUST
 DB CR,LF
 ASC 'Difference found on track '
 DB 0
 LDA TETRK
 CALL DEC99
 JMP DRRET  AND FINISH UP THE OPERATION
*
*
VTKDON LDA TETRK  GET TRACK
 INR A
 STA TETRK
 CPI 77
 JNZ VERFM
 JMP VEDON
*
 PAGE
*
*
************************************
*
*
*   READ A FULL TRACK INTO BUFFER POINTED TO BY TKBUF
*
CTRED SHLD CBUFP
*
*  ERROR RETURNS ETC CAN COME HERE
*
CTTVR LHLD CBUFP  GET POINTER
 SHLD TBUFP  SET THE POINTER
 XRA A
 STA TTSEC
 CALL SUNIT  SELECT UNIT IN TUNIT
 CALL SECHK  STEP TO PROPER TRACK
*
*********************
*
*
*   LOOP POINT FOR EACH SECTOR ON EACH TRACK
*
CTOVR LDA TUNIT  GET CURRENT UNIT
 CALL SUNIT
 CALL ESCST  SEE IF ESCAPE IS WANTED
*
THEAD CALL DATNS
TOVER CALL HDVER
*
*   INIT THE HEADER
*
 MVI A,HELEN
 LXI H,IHEAD
CLRHE MVI M,0FFH
 INX H
 DCR A
 JNZ CLRHE
*
*   READ AND CHECK HEADER
*
TDAOP CALL HDATOP  READ THE NEXT HEADER
TDAO1 IN STAPT
 ANI ABERR+CCERR
 JNZ HERRA  ERROR READING HEADER
*
 IN STAPT  LOOP FOR READY OR ERROR
 ANI TRCOM+SREDY  LOOP FOR FLAG
 JZ TDAO1
*
 ANI TRCOM
 JZ HERRA  ERROR IF NO TC...CAME OUT WITH SREADY
*
*   HEADER SEEMS OK...TEST PARAMETERS
*
 LDA IHTRK
 ORA A
 JM TNSEC  ?????  <----<<<<<
 CMP C  TEST FOR TRACK ERROR
 JNZ TTKER
 LDA IHSEC
 CMP B
 JNZ TNSEC  FIND PROPER SECTOR
*
*     WE'VE READ A PROPER HEADER NOW FIND
*     OUT IF THERE'S ANY DATA.
*
 LHLD IHFID
 MOV A,H
 ORA L
 JZ HERR1  NO DATA SET UP FOR STANDARD HEADER ON WRITE
*
*
*    HEADER SHOWS VALID FILE - SO READ INDICATED DATA
*    TO THE TRACK BUFFER IF VALID READ OCCURS.
*
 SHLD TFID  SET ID INTO TRANSFER DESCRIPTOR
 LHLD TBUFP  GET CURRENT POINTER
 LXI D,HELEN+1  POINT PAST HEADER
 DAD D  WE DON'T MOVE THE POINTER UNTIL AFTER READ
 SHLD TBUF  WE'LL READ THE DATA TO HERE
 LHLD IHSIZ
 SHLD TBCNT  THE SIZE TOO
 SHLD DRLEN  NEEDED ALL OVER
 LDA IHPRO
 STA OHPRO
*
*********************
*
*   NOW DO THE READ OPERATION
*
 MVI A,RDATA
 STA DOPER  SET READ OPERATION
 CALL GOPER  JUST READ THE DATA
 JMP RDERR  ERROR RETURN
*
*   VALID DATA WAS READ...PROCESS THE BUFFER
*
 MVI A,1  SET INDICATOR
 LXI D,IHEAD
 CALL HDSET  MOVE IHEAD INTO THE BUFFER
 XCHG .  TBUFP TO DE
 LHLD IHSIZ  GET THE SIZE OF DATA BLOCK THAT WAS READ IN
 DAD D
 SHLD TBUFP  NEW POINTER FOR NEXT SECTOR
 LDA IHPRO
 ANI 15
 MOV B,A  NUMBER OF SECTORS USED BY THIS BLOCK
*
*   COME HERE TO MOVE PAST SECTORS
*
NODAT LDA TTSEC  CURRENT SECTOR+REG "B"
 ADD B
 CPI 16  HAVE WE DONE THE LAST SECTOR
 STA TTSEC
 JC CTOVR  KEEP DOING THE READS
 RET
*
 PAGE
*
*
*******************************************
*
*
*
*
*   ROUTINE TO WRITE THE DATA FROM THE BUFFER TO DISK
*
WDNOP SHLD TBUF  SET UP THE DESCRIPTOR,WRITE DATA FROM HERE
 LHLD TRSIZ
 SHLD TBCNT
 LHLD TRFID
 SHLD TFID
 CALL WDSK  WRITE OUT THE DATA
 STC .  SET ERROR!!
 RET
 DB 0  SPACE FILLER
 ORA A
 RET .  WITH CARRY CLEAR FOR NORMAL RETURN
*
 PAGE
*
*
*
*     ERROR ROUTINES
*
HERRA MVI A,-1
 OUT TRAPT  CANCEL LAST COMMAND
 CALL ERRPR
 JMP HERR1
 JMP TOVER
*
*   COULDN'T READ THE HEADER SO USE STANDARD
*
HERR1 XRA A
 CALL HDSET  SET THE TRACK BUFFER RIGHT
 MVI B,1
 JMP NODAT  DATS RIGHT SKIP THE SECTOR
*
*
*     TRACK ERROR
*
TTKER CALL TERRP
 JMP TTKE1  SKIP THIS TRACK
 JMP TOVER  TRY MORE
*
TTKE1 POP H  GET RETURN ADDRESS
 MOV A,H
 CPI <RTRK1
 JNZ COABT  ABORT IF NOT FROM COPY
 MOV A,L
 CPI >RTRK1
 JNZ COABT
 CALL FMTRK  ERASE THE OUT-UNIT
*
*   ERASE MUST CHANGE TO THE OUTPUT UNIT!!!
*
 JMP NETRK  AND SKIP TRACK
*
*
*           HAVEN'T FOUND SECTOR YET
*
TNSEC CALL WAITS  WAIT FOR SREADY
 LDA DSECN
 INR A
 STA DSECN
 CPI 25
 JC TDAOP
 LDA VEONL  IF CALLED FROM VERIFY THEN THIS IS
 ORA A  REALLY AN ERROR
 JZ HERR1
*
*
*    ERROR TRYING TO READ DATA FIELD
*
RDERR CALL ESCST
 CALL OUST
 DW 0A0DH
 ASC 'Unable to read '
 DB 0
*
 CALL TSMES
 LDA WAFLG  SEE IF WAIT FLAG IS SET
 ORA A
 JNZ HERR1
 CALL OUST
 ASC 'Retry? '
 DB 0
 CALL CONIN
 ANI 7FH
 PUSH PSW
 CALL CONOUT
 CALL OUST
 DW 0A0DH
 DB 0
 POP PSW
 ORI ' '
 CPI 'n'
 JZ HERR1  SKIP OVER IF NO
*
RDER1 XRA A
 STA TTSEC
 JMP CTTVR  TRY...TRY AGAIN
*
TSMES CALL OUST
 ASC 'sector- '
 DB 0
 LDA TTSEC
 CALL DEC99  OUTPUT IN DECIMAL
 CALL OUST
 ASC ' track- '
 DB 0
 LDA TETRK
 CALL DEC99
 CALL OUST
 DW 0A0DH
 DB 0
 RET
*
*
WDERR LXI SP,STACK
 CALL OUST
 DW 0A0DH
 ASC 'Write retry... '
 DB 0
 CALL TSMES
 CALL FMTRK  ERASE AND FORMAT
 JMP TKOVR  AND DO AGAIN
*
 PAGE
*
*
************************************
*
*
*
*     THIS ROUTINE MOVES THE HEADER POINTED TO BY "DE"
*  INTO THE CURRENT LOCATION OF THE TRACK BUFFER.  REG
*  'A' IF ZERO ONLY SETS THE INDICATOR TO SHOW NO VALID
*  DATA FOLLOWS.
*
*   ON RETURN THE POINTER IS UPDATED ONE BEYOND THE HEADER
*
HDSET LHLD TBUFP  GET CURRENT BUFFER LOCATION
 MOV M,A  SAVE THE INDICATOR
 MVI C,HELEN  HEADER LENGTH
 INX H
 ORA A
 CNZ HDSE1  MOVE IN HEADER IF NON ZERO
 SHLD TBUFP  UPDATE THE BUFFER POINTER
 RET
*
*
*  GENERAL PURPOSE MOVE ROUTINE
*
HDSE1 LDAX D
 MOV M,A
 INX H
 INX D
 DCR C
 JNZ HDSE1
 RET
*
*
*   SUBTRACT DE FROM HL AND RETURN RESULT IN HL
*
DSUB MOV A,L
 SUB E
 MOV L,A
 MOV A,H
 SBB D
 MOV H,A  HL HAS LENGTH OF BUFFER
 INX H
 RET
*
*
DEC99 MVI B,'0'
 PUSH PSW
 XRA A
 STA FIRS1
 POP PSW
DEC2 SUI 10
 JC DEC3
 INR B
 JMP DEC2
*
*
DEC3 ADI 10  ADJUST BACK
 PUSH PSW
 CALL WRITB
 POP PSW
 ADI '0'
 MOV B,A
*
WRITB LDA FIRS1
 ORA A
 MOV A,B
 JNZ CONOUT
 STA FIRS1
 CPI '0'
 RZ
 JMP CONOUT
*
FIRS1 DB 0
*
*
*
*   GIVE MESSAGE AND WAIT FOR CR TO CONTINUE
*
*    SKIP MESSAGE IF -W WAS GIVEN
*
MWAIT LDA WAFLG  NO WAIT?
 ORA A
 RNZ
*
 CALL OUST
 DB CR,LF
 ASC 'Press RETURN to begin; MODE to abort: '
 DB 0
*
MESIN CALL CONIN
 ANI 7FH
 JZ DRRET  COPY ABORT
 CPI 0DH  CARRIAGE RETURN
 JNZ MWAIT  RETYPE MESSAGE IF ANYTHING ELSE
 CALL CONOUT
 MVI B,10  LINE FEED
 CALL CONOUT
 RET
*
*
*    MESSAGE OUTPUT ROUTINE
*
OUST POP H
OUST5 MOV A,M
 INX H
 ORA A
 JNZ OUST9
 PCHL
*
OUST9 CALL CONOUT
 JMP OUST5
*
*
UNOUT ADI '0'
 JMP CONOUT  OUTPUT IT AND RETURN
*
*
*********
 COPY DCOP:2S/1
*
 COPY DCOP:3S/1
*
*
 END
*
 
 PAGE
*
*
*******************************************
*
*
*                 <<<  DISK FORMATTER  >>>
*
*
*
*                FORMAT THE DISK IN OTUNT
*
*
*  ROUTINE WRITES STARTING HEADER IN EACH SECTOR OF EACH
*  TRACK ON THE DISC.  THE DATA FIELD IS WRITTEN WITH ZEROS
*  (ERASE) AND EACH HEADER IS VERIFIED.
*
*
FORMT LXI SP,STACK
 CALL OUST
 DB CR,LF
 ASC "Format unit "
 DB 0
*
 LDA OTUNT  GET THE OUTPUT UNIT
 STA TUNIT
 CALL UNOUT  AND OUTPUT IT
*
 CALL MWAIT  WAIT FOR KEY
 XRA A
 STA TETRK  ZERO TRACK COUNT
*
*
*****  END OF INITIALIZATION CODE  ****
*
*
*   LOOP HERE TO FORMAT A TRACK
*
FMTRK CALL ESCST  WANT TO ESCAPE?
 XRA A
 STA TTSEC  ZERO SECTORS
SOVE1 CALL ERAS  FIRST ERASE IT
*
*  LOOP AND WRITE ON EACH SECTOR OF TRACK IN TETRK
*
 LXI D,STDHD
 LXI H,TRBUF
 MVI C,HELEN
 CALL HDSE1  MOVE IN THE STANDARD HEADER
*
FMT20 CALL XDSKH  GO WRITE HEADER
 JMP FMTRK  KEEP TRYING (ERROR RETURN)  <----<<<<
*
 LXI H,STBUF
 CALL WDNOP  WRITE PHONY DATA
 JC FMTRK  ERROR RETURN  <----<<<<
 LDA TETRK  GET TRACK
 CPI DITRK  IS IT THE DIRECTORY TRACK?
 LDA TTSEC  GET SECTOR COUNT
 JZ FRONE  SPECIAL SEQUENCE FOR DIRECTORY TRACK
 INR A
*
FMT30 STA TTSEC  SAVE NEW COUNT
 CPI 16
 JC FMT20  IF NOT 15 YET.
*
*
*  THIS TRACK IS COMPLETE
*
FRDON LDA FMONL  CHECK IF FORMAT ONLY
 ORA A
 STA TTSEC
 RZ .  IT WASN'T....RETURN TO CALLER
*
 LDA TETRK  GET THE FINISHED TRACK
 INR A
 STA TETRK  NEXT TRACK
 CPI 77  HAVE WE DONE TRACK 76?
 JNC FMDON  IF SO HALT OUT MEMORY AND LEAVE
*
*  MOVE TO NEXT TRACK
*
NXTRK CALL SECHK
 JMP FMTRK  GO DO THIS TRACK
*
*
*  THIS ROUTINE FORMATS THE DIRECTORY TRACK IN A 0,8,1,9...
* SEQUENCE TO ALLOW FASTER DIRECTORY SEARCH OPERATIONS.
*
FRONE CPI 15  SECTOR IS IN "A"
 JZ FRDON  DONE IF SECTOR 15
 CPI 8
 JNC FOVR8
 ADI 8+7  EFFECTIVLY ADD EIGHT
*
FOVR8 SUI 7  TAKE AWAY SEVEN
 JMP FMT30
*
 PAGE
*
*
*******************************************
*
*
*
*   THIS ROUTINE ERASES THE ENTIRE DISKETTE
*
*
DERAS CALL OUST  FIRST GIVE THE MESSAGE
 DB CR,LF
 ASC "Initialize unit "
 DB 0
 LDA OTUNT  OUTPUT THE UNIT
 CALL UNOUT
 CALL MWAIT  WAIT IF CALLED FOR
 XRA A  START AT TRACK 0
 STA TETRK
 LDA OTUNT
 STA TUNIT
 CALL SUNIT  SYNCRONIZE EVERYBODY
*
*   LOOP HERE ERASING EACH TRACK
*
DERLP CALL ESCST  SEE IF WE WANT TO ABORT
 CALL SECHK  SEEK TO THE CURRENT TRACK
 CALL ERAS1  AND ERASE IT
 LDA TETRK
 INR A
 STA TETRK
 CPI 77
 JC DERLP  LOOP FOR ALL 76
 JMP ERDON  AND RETURN
*
*
*
*     ROUTINE TO PRE-FORMAT DISC PRIOR
*     TO ACTUAL FORMAT OPERATIONS.
*
ERAS LDA OTUNT  ONLY ON THE OUT-UNIT
 STA TUNIT  THIS CODE MUST STAY HERE!!!!!
 CALL SUNIT  THIS WILL CATCH DRIVE NOT READY
*
ERAS1 MVI A,0FCH  THE ERASE COMMAND
 OUT TRAPT
 CALL FINDI  FIND TWO INDEX MARKS
 MVI A,0FFH
 OUT TRAPT  TURN OFF ERASE
 JMP DELY  DO A DELAY AND RETURN
*
 PAGE
*
*
*******************************************
*
*
*
*          WRITE DISC HEADER OPERATION
*
*  IF SECTOR ZERO THEN KEY ON INDEX MARK
*  IF OTHER SECTOR THEN KEY ON PRECEEDING
*  FILE ID BY CHECKING PROPER SECTOR NUMBER.
*
*  UP TO 11 ABORTS AND 16 HEADER MISSES ALLOWED
*  FOR EACH SECTOR, AFTER THIS THE PROCESS
*  STARTS OVER UNLESS STOPPED BY THE OPERATOR.
*
*
*
XDSKH LDA OTUNT  BE SURE DRIVE IS READY
 STA TUNIT
 CALL SUNIT
 LHLD TTSEC
 SHLD TRSEC  WRITE ABSOLUTE SECTOR AND TRACK
 MVI A,WDATA
 STA DOPER  FOR BLKLN
 LHLD TRSIZ
 SHLD TBCNT  SAME REQUIREMENT
 CALL BLKLN  SET UP THE TRANSFER PARAMETERS
 LDA OHPRO
 STA TRPRO
*
*   NOW READ HEADERS
*
 CALL DATNS  CLEAR ERROR FLAGS
HOVER CALL HDVER  SET UP FOR HEADER
HDLOP CALL WAITS  WAIT FOR SREDY
 LXI H,TXBUF  POINT TO TRANSFER IN BUFFER
 MOV A,L
 OUT ADRLO  LOW TRANSFER ADDRESS
 MOV A,H
 OUT ADRHI  NOW THE HIGH
 MVI A,HELEN  THE HEADER LENGTH
 OUT BYTLO  BYTE COUNT
 XRA A  ZERO THE HIGH BYTE
 OUT BYTHI
 LDA TTSEC
 MOV B,A  GET CURRENT SECTOR
 ORA A  SET THE FLAGS
 JNZ FUDGE  IF NOT SECTOR ZERO
 CALL IFIND  WRITE SECTOR ZERO
 JMP WHEAD
*
FUDGE LDA TETRK  GET TRACK
 CPI DITRK
 JZ ONFIN  SPECIAL CALCULATION DIRECTORY TRACK
 MOV A,B
 DCR A  FUDGE THE COUNT
ZECHK CZ IFIND  HAVE TO READ SECTOR ZERO KEY ON INDEX
*
COMND MVI A,READH
 OUT TRAPT  READ HEADER COMMAND
*
LOOP1 IN STAPT  GET STATUS
 ANI TRCOM+SREDY+ABERR+CCERR  WAIT FOR FLAGS
 JZ LOOP1
 IN STAPT
 ANI ABERR+CCERR  ABORT OR CRC?
 JNZ ERABT  IF SO THEN PROCESS COUNT
*
LOOP2 IN STAPT  LOOP FOR DONE INDICATION
 ANI TRCOM
 JZ ERAB2  CAME OUT WITH SREDY...ERROR
 IN STAPT
 ANI CCERR+ABERR
 JNZ ERABT  CALL IT AN ABORT
*
 LDA TXPRO  GET SECTOR COUNT
 ORA A
 JM HDLOP  JUST IN CASE //// WE SHOULD MINUS OUT THE
 NOP .  //// HEADER BEFORE EACH READ
 ANI 15
 MOV E,A
 LDA TXSEC  GET READ SECTOR
 CPI 16
 JNC HDLOP
 ADD E
 CMP B  COMPARE WITH WHAT WE WANT
 JNZ HNSEC  IF NO THEN READ ANOTHER
*
*    NOW WE WRITE THE HEADER
*
WHEAD CALL WAITS  WAIT FOR SREADY
 LXI H,TRBUF  HERE'S WHERE WE GIT IT.
 MOV A,L
 OUT ADRLO  LOW BYTE TRANSFER
 MOV A,H
 OUT ADRHI  AND THE HIGH
*
 LXI H,HELEN  HEADER SIZE FOR TRANSFER
 MOV A,L
 OUT BYTLO
 MOV A,H
 OUT BYTHI
 MVI A,WRITH
 OUT TRAPT  WRITE HEADER COMMAND
*
WHED1 IN STAPT  LOOP FOR FLAGS
 ANI TRCOM+SREDY+ABERR
 JZ WHED1
 ANI ABERR  ABORT?
 JNZ ERABT  IF SO GO PROCESS
*
*  BE SURE CONTROLLER IS DONE
*
 CALL WAITS
 IN STAPT
 ANI ABERR
 JNZ ERABT
 CALL DELY
 JMP RP2  RETURN CALL+2 FOR OK
*
*
*   PROCESS CALCULATION FOR TRACK ONE
*
*  SECTORS ARE WRITTEN IN A  0,8,1,9,2,10,3....SEQUENCE
*
ONFIN MOV A,B  GET DESIRED SECTOR
 CPI 8  TEST IF ADD OR SUBTRACT
 JNC OVER8  IF SUBTRACT
 ADI 7+8  8-1,9-2,10-3.....
OVER8 SUI 8  0-8,1-9,2-10
ONFI1 MOV B,A  SAVE NEW DESIRED VALUE
 PUSH PSW  SAVE ZERO FLAG
 INR B
 POP PSW
 JMP ZECHK  AND DO COMPARE AT ZERO CHECK
*
*
*  FIND TWO INDEX MARKS
*
FINDI CALL IFIND
 CALL DELY
 CALL DELY
*
*  ROUTINE TO FIND INDEX MARK ON SELECTED DISK
*
IFIND IN STAPT  GET STATUS
 RLC .  PUT INDEX INTO CARRY BIT
 JC IFIND
 RET .  ON NO CARRY
*
*
*  COME HERE ON ABORT ERRORS
*
ERABT ANI ABERR  PROCESS THE ERROR
 JZ ERAB1
ERAB2 MVI A,-1
 OUT TRAPT
ERAB1 CALL ERRPR  PROCESS THE ERROR
 RET
 DW 0
 JMP HOVER  AND DO IT OVER
*
*   COULDN'T FIND SECTOR
*
HNSEC CALL WAITS
 LDA DSECN
 INR A  PROCESS SECTOR ATTEMPT COUNT
 STA DSECN
 CPI 30  TRY VERY, VERY HARD
 JC HDLOP  READ THE NEXT
 RET .  ERROR RETURN
*
 PAGE
*
*
*******************************************
*
*
*
*               **    DISK DRIVER EQUATES   **
*
*
*     CONTROLLER PORTS
*
STAPT EQU 0F0H  STATUS INPUT PORT
TRAPT EQU 0F1H  TRANSFER COMMAND PORT
BYTLO EQU 0F3H  LOW BYTE COUNT PORT
BYTHI EQU 0F4H  HIGH BYTE COUNT PORT
ADRLO EQU 0F5H  LOW TRANSFER ADDRESS PORT
ADRHI EQU 0F6H  HIGH TRANSFER ADDRESS PORT
COMPT EQU 0F7H  COMMAND OUTPUT PORT
*
*     CONTROLLER TRANSFER COMMANDS
*
RDATA EQU 3  READ DATA COMMAND
WDATA EQU 1  WRITE DATA COMMAND
READH EQU 7  READ HEADER COMMAND
WRITH EQU 5  WRITE HEADER COMMAND
*
*     BIT MASKS
*
TRCOM EQU 1  TRANSFER COMPLETE
SREDY EQU 2  CONTROLLER READY
ABERR EQU 4  ABORT FLAG
CCERR EQU 8  CRC ERROR FLAG
CKCOM EQU 16  CRC CHECK COMPLETE
DREDY EQU 32  SELECTED DRIVE READY
SKCOM EQU 64  SEEK COMPLETE FLAG
INDEX EQU 128  INDEX MARK
*
*     ERROR CODES
*
SIZER EQU 30H  SIZE CONFLICT
FIDER EQU 31H  FILE ID CONFLICT
SECER EQU 32H  SECTOR CONFLICT
FORER EQU 33H  FORMAT ERROR (CAN'T FIND SECTOR)
TRIER EQU 34H  ABORTS AND CRCC'S
TRKER EQU 35H  CAN'T FIND TRACK
RWERR EQU 36H  READ AFTER WRITE ERROR
LOCER EQU 0FEH  SYSTEM LOCKED
*
*     MISC
*
DITRK EQU 25  DIRECTORY TRACK
HELEN EQU 13  LENGTH OF HEADER
*
*
*
*
*                         <<<<   DISK DRIVER   >>>
*
*
*
*
*           DRIVER ENTRY POINTS
*
*
WDSK MVI A,WDATA
 JMP OPSET
RDSK MVI A,RDATA  READ OPERATION
*
OPSET STA DOPER  SET OPERATION IN MEMORY
 CALL BLKLN  SET UP TRANSFER PARAMETERS
 CALL SUNIT  SET UNIT AND SELECT DRIVE
*
DATRN CALL DATNS  CLEAR ERROR CONTROL FLAGS
DOVER CALL HDVER  SET UP TO READ HEADER
DATAOP CALL HDATOP  READ THE NEXT HEADER
*
 ANI CCERR+ABERR  CRC ERROR OR ABORT?
 JNZ SERR1  PROCESS THE ERROR
 LXI H,TBCNT  TIME FUDGE
*
 IN STAPT
 ANI TRCOM  BE SURE THE TRANSFER IS COMPLETE
 JZ SERR  PROCESS THE ERROR
 IN STAPT
 ANI CCERR+ABERR
 JNZ SERR1
*
*    CHECK TRACK AND SECTOR
*
 LDA IHTRK  GET READ TRACK
 ORA A
 JM DATRN
 CMP C  BETTER BE THE SAME!
 JNZ TKERR
 LDA IHSEC  NOW THE SECTOR
 CMP B
 JNZ NOSEC  TRY,TRY AGAIN
*
*
*     TEST HEADER PARAMETERS
*
 LXI H,TBCNT
 LDA IHSIZ  GET SPECIFIED SIZE
 CMP M  IS IT THE SAME?
 RNZ
 INX H
 LDA IHSIZ+1  OTHER PORTION GETS TESTED NOW
 CMP M
 RNZ
*
*   BYTE COUNT IS OK NOW CHECK FILE ID
*
 INX H
 LDA IHFID
 CMP M
 RNZ
 INX H
 LDA IHFID+1
 CMP M
 RNZ
*
*   WE EVEN CHECK THE SECTOR COUNT
*
 LDA OHPRO
 ANI 15  STRIP OFF HIGH BIT
 MOV B,A
 LDA IHPRO  GET READ IN VALUE
 ANI 15
 CMP B
 RNZ .  IF NOT THE SAME
*
*          ALL SYSTEMS GO!!!    5,4,3.......
*
GOPER LHLD TBUF  AND THE TRANSFER ADDRESS
 MOV A,L
 OUT ADRLO
 MOV A,H
 OUT ADRHI
 LHLD DRLEN  GET TRANSFER LENGTH
 MOV A,L
 OUT BYTLO
 MOV A,H
 OUT BYTHI
 LDA DOPER  GET THE OPERATION
 OUT TRAPT  GIVE THE COMMAND
*
*    NOW WAIT FOR TRANSFER
*
CCHK IN STAPT
 ANI ABERR+SREDY+TRCOM
 JZ CCHK
*
 IN STAPT
 ANI ABERR
 JNZ SERR1
*
*    LOOP HERE FOR ERROR OR SREADY
*
CCHK1 IN STAPT  WAIT FOR SREADY
 ANI ABERR+CCERR
 JNZ SERR1
 IN STAPT
 ANI 2
 JZ CCHK1  LOOP IF NOT
*
 LDA DOPER  GET OPERATION
 CPI WDATA
 JZ WCCHK
*
*   THIS IS THE DRIVER RETURN POINT
*
RP2 POP H
 INX H
 INX H
 INX H
 PCHL .  RETURN CALL PLUS 2
*
*
*   TEST ERRORS AGAIN AND DELAY IF OPERATION WAS WRITE
*
WCCHK IN STAPT
 ANI ABERR
 JNZ SERR1
 CALL DELY
 JMP RP2
*
*
*   DELAY SUBROUTINE
*
DELY LXI D,1290H/7
DELY1 DCX D
 MOV A,D
 ORA E
 JNZ DELY1
 RET
*
*
*   ERROR FLAG SET UP USED BY RDSKH & WDSKH
*
DATNS XRA A  START WITH NO TRIES
 STA DTRIES
 CMA
 STA DNERR  SET IN/OUT SEEK SWITCH
 STA DTERR  MINUS TRACK ERRORS
 RET
*
*
*   SET UP FOR HEADER SEARCH
*
HDVER XRA A
 STA DSECN  SET NO SECTORS TRIED
 CALL SECHK  GO TO PROPER TRACK
 LDA TTSEC  GET DESIRED SECTOR
 MOV B,A  AND CARRY IT AROUND IN "B"
 RET
*
*
*         READ NEXT HEADER
*
*  ON RETURN ALL INFORMATION IS IN IHEAD
*
HDATOP CALL WAITS
 LXI H,IHEAD  TRANSFER ADDRESS
 MOV A,L
 OUT ADRLO
 MOV A,H
 OUT ADRHI
 MVI A,HELEN
 OUT BYTLO
 XRA A
 OUT BYTHI
*
 MVI A,READH  READ HEADER COMMAND
 OUT TRAPT  GIVE IT....
*
DLOPS IN STAPT  GET STATUS
 ANI 0FH  LOOP FOR ANY FLAGS SET
 JZ DLOPS  KEEP LOOPING
 RET .  GO BACK IF ANY
*
*
*       ERROR ROUTINES
*
SERR1 ANI ABERR  CHECK IF CRC ERROR
 JZ DATER
* ABORT COMES HERE
SERR MVI A,0FFH
 OUT TRAPT  CANCEL LAST COMMAND
DATER CALL ERRPR
 RET
 DW 0
 JMP DOVER
*
*
TKERR CALL TERRP  PROCESS THE TRACK ERROR
 RET
 DW 0
 JMP DOVER  AND RETURN
*
WAITS IN STAPT  GET CONTROLLER STATUS
 ANI SREDY
 JZ WAITS  LOOP UNTIL SREADY GOES HIGH
 RET
*
*
*   DATA ERROR FOUND...PROCESS COUNT
*
ERRPR CALL WAITS  WAIT FOR SREDY
CONT LDA DTRIES
 INR A
 STA DTRIES
 CPI 20  BOY DO WE TRY HARD
 CNC ERRN  DONE TEN.. GO SEEK
 LDA DNERR
 CPI 2
 RZ
 JMP RP2
*
*
ERRN XRA A
 STA DTRIES  RESTORE TRIES
 LDA DNERR
 ORA A
 JM FIRST  FIRST ONE DIRECTION
 INR A
 STA DNERR  THEN THE OTHER
 CPI 2
 RNC .  GONE THROUGH TWICE...GIVE UP
*
FIDWN LDA TETRK  GET DESIRED TRACK
 SUI 2  BACK DOWN TWO TRACKS
 JP ERRO
 XRA A  DON'T GO LOWER THAN ZERO
ERRO MOV C,A
 JMP SEEKT  SEEK TO THIS TRACK AND RETRY OPERATION
*
*
FIRST XRA A
 STA DNERR  SET FOR NEXT DIRECTION
 CALL IFIND
*
FIUP LDA TETRK
 ADI 2  STEP UP TWO TRACKS
 CPI 77
 JC ERRO
 MVI A,76  NO MORE OUT THAN 76
 JMP ERRO
*
*
*   PROCESS TRACK ERROR
*
TERRP CALL WAITS
 LDA DTERR
 ORA A  SET FLAGS
 JM ONCMO  IF FIRST TIME TRY THE DIFFERENCE
 INR A
 STA DTERR  INCREMENT THE COUNT
 CPI 1
 JNZ SEDN9
 CALL IFIND  IF SECOND TIME THRU JUST FIND INDEX
 JMP RP2
*
SEDN9 CPI 11  JUST FIVE TIMES
 RNC
 RRC
 JC SEDN2
 CALL FIUP
 JMP RP2
*
SEDN2 CALL FIDWN
SEDN3 JMP RP2
*
*
ONCMO XRA A
 STA DTERR  SET AS SECOND TIME
 CALL SEEK0
 CALL FINDI  LOT'S O DELAY
 JMP RP2
*
*
*    WASN'T THE RIGHT SECTOR
*
NOSEC CALL WAITS  WAIT FOR DRIVE READY
 LDA DSECN  GET READ ATTEMPTS
 INR A  COUNT UP
 STA DSECN  STORE IT
 CPI 25  HOW MANY?
 JC DATAOP  TOO MANY?
 RET
*
 PAGE
*
*
***********************
*
*
*
*      DRIVE AND DRIVER INITIALIZATION ROUTINES
*
*  THIS ROUTINE INITIALIZES ALL DRIVES AND SETS THE
*  TRACK COUNT VALUES IN THE UNIT TABLE TO ZERO.
*
DDRI MVI B,4  NUMBER OF POSSIBLE DRIVES
 LXI H,UNTAB
*
DDRI1 MVI M,0  CLEAR THE UNIT TABLE
 INX H
 DCR B
 JNZ DDRI1
*
*  RESTORE ANY DRIVES ASSOCIATED WITH THIS OPERATION
*  ALSO CHECK FOR LEGAL UNIT NUMBER
*
 LHLD SYSGLO  GET SYSTEM AREA
 LXI D,GLMXU  POINT TO MAXIMUM UNITS
 DAD D
 MOV A,M  GET IT
 STA MXUNT  SAVE FOR LATER
 MOV D,A  SAVE IN "D"
*
 LDA INUNT  CHECK IN UNIT AGAINST MAXUNIT
 CMP D
 JNC DDRI2  IN-UNIT >= MAXUNIT
 STA CUNIT  CHECK OUT UNIT AGAINST MAXUNIT
 CALL SEEK0
*
DDRI2 LDA OTUNT  RESTORE INUNT DRIVE
 CMP D
 RNC
 STA CUNIT
 CALL SEEK0
 RET
*
*
*    ROUTINE TO SEEK TRACK ZERO AND RESET THE
*    TRACK COUNTER.
*
SEEK0 LDA CUNIT  GET CURRENT UNIT
 CALL USET  GET PROPER COMMAND
 OUT COMPT  SELECT THE DRIVE
 ANI 0EFH  SET RESTORE LOW
 OUT COMPT  NEXT SEEK WILL CLEAR THE RESTORE
 XRA A
 STA CTRCK  SET CURRENT TRACK AS ZERO
*
SKDON IN STAPT  WAIT FOR SEEK COMPLETE
 ANI SKCOM
 JNZ SKDON  WHEN FINISHED
 RET
*
*
*   THIS ROUTINE SEEKS TO THE TRACK GIVEN IN TTRK
*
SECHK CALL DRLOP  GET DRIVE STATUS
 LDA TETRK  GET DESIRED TRACK
 MOV C,A  WE KEEP IT HERE
*
SEEKT LDA CTRCK  GET CURRENT TRACK
 SUB C  THE DIFFERENCE
 RZ .  ALL DONE IF EQUAL
 JP SECH1
*
 CMA .  DO THE COMPLEMENT FOR NEGATIVE RESULTS
 INR A
 MOV B,A  "B" HAS NUMBER TO MOVE
 LDA RUNIT  GET PROPER COMMAND
 ANI 0FDH  STEP TO HIGHER TRACK
 JMP SECH2
*
SECH1 MOV B,A
 LDA RUNIT  THE PROPER ONE
*
SECH2 OUT COMPT  SET THE DIRECTION
 ANI 0FEH  TURN ON THE STEP BIT
*  LOOP HERE GIVING STEP COMMANDS
SECH3 OUT COMPT  GIVE THE STEPS
 DCR B
 JNZ SECH3  GIVE B STEPS
*
 MOV A,C  GET TRACK
 STA CTRCK  MAKE IT THE CURRENT ONE
 JMP SKDON
*
 PAGE
*
*
*
*
*   THIS ROUTINE IS CALLED PRIOR TO DRIVER OPERATIONS
* TO SET UP THE DRIVER PARAMETERS RELATING TO UNIT AND
* TRACK.
*
*        SET CURRENT UNIT INTO RUNIT
*
SUNIT LDA TUNIT  GET DESIRED UNIT
 CALL USET  SET DESIRED DRIVE AND UNIT IN "A"
 PUSH PSW  SAVE FOR LATER
*
* TEST IF DIFFERENT UNIT...IF SO THEN WAIT FOR INDEX MARK
*
 LDA TUNIT  GET DESIRED UNIT
 LXI H,CUNIT  POINT TO LAST CURRENT UNIT
 CMP M  COMPARE
 MOV M,A  SAVE THIS AS CURRENT
 JNZ SETU1  IF DIFFERENT UNIT
 POP PSW
 STA RUNIT
 ORA A  SET FLAGS TO NZ
*
*
SETUN PUSH PSW
 OUT COMPT
 IN STAPT
 OUT ADRLO
 CALL DRLOP
 CALL WAITS
*
*  GET CURRENT TRACK FOR THIS DRIVE
*
*
 LXI H,UNTAB  POINT TO UNIT TABLE
 LDA TUNIT  GET UNIT
 ANI 7  IN CASE OF ERROR !!! CLEARS CARRY !!!
 RAR .  DIVIDE BY TWO TO GET DRIVE SPECIFICATION
*
*  NOTE:  UNTAB CAN'T PASS 256 PAGE BOUNDERY
*
 ADD L  POINT TO PROPER ONE
 MOV L,A
 MOV A,M  GET TRACK POINTER FROM IT
 STA CTRCK  STORE IT AS CURRENT TRACK
 LDA TETRK  GET DESIRED TRACK
 MOV M,A  SET IT AS NEW POINTER (SEEK COMES LATER)
 POP PSW
 MOV A,M  RETURN WITH TRACK AS BEFORE??????
 RNZ .  IF NOT NEW UNIT
 JMP IFIND  WAIT FOR INDEX IF SO
*
*
*  NEW UNIT....UNLOAD OLD HEAD FIRST
*
SETU1 LDA RUNIT  OLD UNIT
 ORI 60H  TURN OFF HEADS
 OUT COMPT
 POP PSW  NEW UNIT
 STA RUNIT
 XRA A  CLEAR THE FLAGS
 LDA RUNIT
 JMP SETUN
*
*
*  CALCULATE PHYSICAL DRIVE AND UNIT FROM NUMBER IN "A"
*
USET ANI 7  IN CASE OF ERROR AND CLEAR CARRY
 LXI B,0D030H  ONE HEAD AT A TIME
 RRC .  PUT BIT ZERO IN CARRY
 RLC .  RESTORE A
 JNC STDRV
 MOV B,C  SELECT EVEN UNIT (0,2,4)
*
STDRV ANI 6  STRIP OFF UNUSED LOWER BIT
 RLC .  MOVE DRIVE SELECT TO PROPER POSITION
 CMA .  DOUG'S DELIGHT
 ANI 0CH  KEEP IT TO THE DRIVES ONLY
 ORA B  ADD IN THE UNIT
 ORI 3  NO STEP OR DIRECTION
 RET
*
*
*   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
 MVI C,1  START WITH ONE SECTOR
 LXI D,-256  FIRST SECTOR IS 256
*
BSUB DAD D  SUBTRACT AMOUNT IN THIS SECTOR
 MOV A,H
 ORA A
 JM BREM  GOT ENOUGH--NEED TO FUDGE?
 ORA L
 JZ BRON  ZERO IS RIGHT ON!!!
 LXI D,-320  NOW THE BIG SECTORS
 INR C  ONE MO SECTOR
 JMP BSUB  DO THE MO
*
BREM LXI D,320-127  FIND OUT IF REMAINDER IS => 65
 DAD D
 MOV A,H
 ORA H
 JM BMORE  IF NEGATIVE NOT BIG ENOUGH
*
BRON LHLD TBCNT
 SHLD OHSIZ  OUTGOING HEADER SIZE
 SHLD TRSIZ
BSECT SHLD DRLEN  TRANSFER LENGTH FOR THE DRIVER
 LDA OHPRO  OUTGOING HEADER PROTECTION WORD
 ANI 80H  CLEAR PREVIOUS COUNT
 ORA C  ADD IN THE SECTOR COUNT
 STA OHPRO  PUT IT BACK
 RET
*
*    FUDGE THE TRANSFER LENGTH FOR WRITES.......
*  WE MUSN'T LEAVE THE SECTOR MARK HANGING!!
*
BMORE LDA DOPER  GET THE OPERATION
 CPI WDATA  IS IT A WRITE OPERATION?
 JNZ BRON  READS DON'T NEED FUDGE
 LHLD TBCNT
 SHLD OHSIZ  TRUE COUNT TO HEADER
 SHLD TRSIZ
 LXI D,127  ADD THE FUDGE FACTOR
 DAD D  ADD EM UP
 JMP BSECT  FILL EM IN
*
 PAGE
*
*
*
*          DRIVE NOT READY
*
*   GIVE MESSAGE AND WAIT FOR DRIVE READY (CONTINUE
*  OPERATION OR CHARACTER FROM TERMINAL FOR ABORT.)
*
DRERR CALL OUST  OUTPUT MESSAGE
 DB CR,LF
 ASC "Unit "
 DB 0
 LDA TUNIT
 CALL UNOUT
 CALL OUST
 ASC " is not ready"
 DB CR,LF
 DB 0
 CALL CONIN  READ BYTE FROM CONSOL
 ANI 7FH
 JZ DRRET  ABORT IF MODE
 OUT ADRLO  KEEP THE HEADS DOWN IF POSSIBLE
*
DRLOP IN STAPT  SEE IF NOW READY
 ANI DREDY
 RZ .  DRIVE IS READY
 JMP DRERR
*
 PAGE
*
*
*
*
*  THIS ROUTINE "HALTS" OUT MEMORY PRIOR TO EXIT
*
RETIT LXI H,0
REHLT MVI M,76H  HALT INSTRUCTION
 INX H
 MOV A,H
 CPI <RETIT
 JNZ REHLT
 MOV A,L
 CPI >RETIT
 JNZ REHLT
 RET .  AND RETURN TO CALLER
*
*
*   TEST FOR ESCAPE
*
ESCST CALL CONTST
 RZ
 CALL CONIN
 ANI 7FH
 RNZ
*
DRRET CALL OUST
 DB CR,LF
 ASC 'Operation aborted'
 DB CR,LF
 DB 0
 JMP SYRET
*
*  TRACK ERROR CAN'T CONTINUE
*
COABT CALL OUST
 DB CR,LF
 ASC "Can't read track
 DB 0
 JMP DRRET
*
*
*   COME HERE WHEN THE COPY IS COMPLETE
*
COPDN CALL OUST
 DB CR,LF
 ASC 'Copy complete'
 DB CR,LF
 DB 0
 JMP SYRET
*
*
*  ERASE COMPLETE
*
ERDON CALL OUST
 DB CR,LF
 ASC 'Initialization complete'
 DB CR,LF
 DB 0
 JMP SYRET
*
*
*   COME HERE AFTER A VERIFY IS COMPLETE
*
VEDON LDA INUNT  CHECK IF ONE OR TWO UNITS
 LXI H,OTUNT
 CMP M
 JNZ VEDO1
*
 CALL OUST  WE ONLY VERIFIED ONE UNIT
 DB CR,LF
 ASC 'Unit '
 DB 0
 LDA INUNT
 CALL UNOUT
 CALL OUST
 ASC ' verifies'
 DB CR,LF
 DB 0
 JMP SYRET
*
VEDO1 CALL OUST
 DB CR,LF
 ASC "Units "
 DB 0
 LDA INUNT
 CALL UNOUT  OUTPUT THE UNIT NUMBER
 CALL OUST
 ASC ' and '
 DB 0
 LDA OTUNT
 CALL UNOUT
 CALL OUST
 ASC ' are identical'
 DB CR,LF
 DB 0
 JMP SYRET  RETURN TO THE SYSTEM
*
*
*    LOAD COMPLETE
*
*
LDR60 CALL OUST
 DB CR,LF  CRLF
 ASC 'Data load complete on unit '
 DB 0
 LDA TUNIT
 CALL UNOUT
 CALL OUST
 DB CR,LF  AGAIN
 DB 0
*
*   THIS IS THE MAIN SYSTEM RETURN POINT
*
SYRET CALL DDRI  RETURN ASSOCIATED DRIVES TO ZERO
 CALL RETIT  HALT IT ALL OUT
 CALL SYS
 DB RETOP  AND RETURN
*
 PAGE
*
*
************************************
*
*
*
*             SYSTEM FILE INFORMATION
*
*
*   DIRECTORY INFORMATION
*
IDDIR EQU 2  DIRECTORY FILE ID
DIRDS EQU 0  SECTOR AND
DIRDT EQU 25  TRACK OF DIRECTORY
*
NMLEN EQU 8  NAME LENGTH
DREMS EQU 12  MAX ENTRIES PER SECTOR
DICNT EQU 16  NUMBER OF DIRECTORY SECTORS
*
*
*   SYSTEM GLOBAL FILE
*
DASPS EQU 13  SECTOR ADDRESS
DASPT EQU 1  TRACK ADDRESS
IDSPA EQU 5  FILE ID
*
*
*   FSM (FREE SPACE MAP) INFORMATION
*
IDFSM EQU 1  FSM FILE ID
DAFSS EQU 0  SECTOR AND
DAFST EQU 26  TRACK OF FSM
*
*
*   NEXT FILE ID FILE INFORMATION
*
IDNID EQU 3  NEXT ID FILE ID
DANIS EQU 1  DISK ADDRESS OF
DANIT EQU 26  NEXT ID FILE
NIDBC EQU 2  BYTE COUNT OF BLOCK
*
*
*   BOOTSTRAP FILE
*
DABOS EQU 0  DISK
DABOT EQU 0  ADDRESS
IDBOT EQU 6  FILE ID
BOCNT EQU 333H  LENGTH OF FILE
*
*   FILE STRUCTURE LINKAGE VALUES
*
BOFCD EQU 65535  BOF CODE IN BACK POINTER
EOFCD EQU 32768  EOF BIT IN FORE POINTER
*
*
*   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!!)
*
 PAGE
*
*
*
*              DATA DISK LOADER
*
*  THIS SET OF ROUTINES WHOSE STARTING ADDRESS
*  IS LISTED ABOVE ESTABLISHES AN INITIAL SYSTEM
*  ON A PRE-WRITTEN DISK IN THE SELECTED UNIT.
*
*
*
*  WRITE OUT SYSTEM GLOBAL AREA
*
FMDON LXI D,LSGL
 CALL LPTD  SET TRANSFER DESCRIPTOR
 LXI D,LSGLH
 CALL LPHD1  SET OUTGOING HEADER
*
*  WRITE OUT BOOTSTRAP
*
 LXI D,LBOO
 CALL LPTD  SET TRANSFER DESCRIPTOR
 LXI D,LBOOH
 CALL LPHD1  SET OUTGOING HEADER
*
*  WRITE NEXT ID FILE
*
 LXI D,LNIF
 CALL LPTD  SET TRANSFER DESCRIPTOR
 LXI D,LNIFH
 CALL LPHD1  SET OUTGOING HEADER
*
*    INITIALIZE EMBRYONIC DIRECTORY
*
*  WRITE FIRST SECTOR
*
 LXI D,LDS0
 CALL LPTD  SET TRANSFER DESCRIPTOR
 LXI D,LDS0H
 CALL LPHD1  SET OUTGOING HEADER
*
*  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
 LHLD TBCNT
 SHLD TRSIZ
 CALL XDSKH  WRITE THE HEADER
 JMP LDERR  ERROR
 CALL WDSK
 JMP LDERR
*
*  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 TRFOR  SET IN FORE PTR.
*
LDR30 LHLD TBCNT  WRITE
 SHLD TRSIZ
 CALL XDSKH
 JMP LDERR
 CALL WDSK
 JMP LDERR
*
*  UPDATE POINTERS
*
 LXI H,TTSEC  PTR TO SECTOR ADDRESS
 INR M
 LXI H,TRFOR  PTR TO SECTOR FORE PTR
 INR M
 LXI H,TRBAK  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,77+77
 XRA A
 LXI H,FMBF
*
*  WRITE OUT FSM
*
LDR42 LXI D,LFSM
 CALL LPTD  SET TRANSFER DESCRIPTOR
 LXI D,LFSMH
 CALL LPHD1  WRITE IT OUT
 JMP LDR60  ALL DONE
*
*
*  PREPARE TRANSFER DESCRIPTOR
*
LPTD LXI H,TDAD
 MVI C,9
 CALL HDSE1
 RET
*
*  PREPARE OUTGOING HEADER
*
LPHD LXI H,TRFOR
 MVI C,7
 CALL HDSE1
 RET
*
LPHD1 CALL LPHD
 LHLD TBCNT
 SHLD TRSIZ
 CALL XDSKH
 JMP LDERR
 CALL WDSK
 JMP LDERR
 RET
*
*
LDERR CALL OUST
 DB CR,LF
 ASC "Error while writing to data disk"
 DB CR,LF
 ASC "use erase before a retry"
 DB CR,LF
 DB 0
 JMP DRRET
*
 PAGE
*
*
*******************************************
*
*
*
*
*  THESE TABLES DESCRIBE THE MODULES TO BE LOADED
*
*
*  BOOTLOAD
*
BOLEN EQU 333H  THREE SECTORS WORTH
*
LBOO DB DABOS  SECTOR
 DB DABOT  TRACK
 DW 380H  LENGTH
 DW IDBOT  ID
 DW BOOT  ADDRESS
 DB 0  UNIT
*
LBOOH DW EOFCD+BOCNT  FORE
 DW BOFCD  BACK
 DW IDBOT  ID
 DB 0  PROTECTION
*
*  THIS IS THE DATA DISK BOOTLOAD
*
BOOT DW 032AH
 DW 4
 HLT
 HLT
 HLT
 HLT
*
******************
*
*
*  SYSTEM GLOBAL
*
LNSPA EQU 268H  LENGTH OF GLOBAL
SP1 EQU 09AE2H  FIRST ADDRESS OF GLOBAL
*
LSGL DB DASPS  SECTOR
 DB DASPT  TRACK
 DW LNSPA  COUNT
 DW IDSPA  ID
 DW SP1  MEMORY ADDRESS
 DB 0  UNIT
*
LSGLH DW LNSPA+EOFCD
 DW BOFCD  BACK
 DW IDSPA  ID
 DB 0  PROT.
*
******************
*
*
*  NEXT ID  FILE
*
LNIF DB DANIS  SECTOR
 DB DANIT  TRACK
 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 DB DAFSS  SECTOR
 DB DAFST  TRACK
 DW 77+77  LENGTH
 DW IDFSM  ID
 DW FMBF  ADDR
 DB 0  UNIT
*
LFSMH DW EOFCD+77+77  FORE
 DW BOFCD  BACK
 DW IDFSM  ID
 DB 0  PROTECT
*
******************
*
*
*  DIRECTORY SECTOR 0
*
LDS0 DB DIRDS  SECTOR
 DB DIRDT  TRACK
 DW SECTSZ  SIZE
 DW IDDIR  ID
 DW DS0  ADDRESS
 DB 0  UNIT
*
LDS0H DB DIRDS+1  FORE
 DB DIRDT  POINTER
 DW BOFCD  BACK POINTER
 DW IDDIR  ID
 DB 0  PROT.
*
******************
*
*
*  DIRECTORY SECTORS  1 TO 15
*
LDS1 DB DIRDS+1  SECTOR
 DB DIRDT  TRACK
 DW SECTSZ  SIZE
 DW IDDIR  ID
 DW DS1  ADDRESS
 DB 0  UNIT
*
LDS1H DB DIRDS+2  FORE
 DB DIRDT  POINTER
 DB DIRDS  BACK
 DB DIRDT  POINTER
 DW IDDIR  ID
 DB 0  UNIT
*
*******************************************
*
*
*
*    INITIAL DIRECTORY
*
*  FIRST SECTOR
*
*
DS0 DB 5  NUMBER OF ENTRIES
 DB DS0N-DS0  NEXT ENTRY DISPLACEMENT
*
 ASC 'DIRECTRY'
 DB BNTYP  TYPE
 DW SECTSZ  BLOCK SIZE
 DB PKIL+PWRI+PFINF+PATR+PNAT
 DW IDDIR  ID
 DW 0  INDEX FILE POINTER
 DB DIRDS  DISK
 DB DIRDT  ADDRESS
 DW DICNT  BLOCK COUNT
 DB 'P'
*
 ASC 'NEXTID'
 DB 0
 DB 0
 DB BNTYP  TYPE
 DW NIDBC  BLOCK SIZE
 DB PKIL+PWRI+PATR+PNAT+PFINF
 DW IDNID  ID
 DW 0  INDEX
 DB DANIS  FBA
 DB DANIT
 DW 1  BLOCK COUNT
 DB 'T'
*
 ASC 'FSMAP'
 DB 0
 DB 0
 DB 0
 DB BNTYP  TYPE
 DW 77+77  BLOCK SIZE
 DB PKIL+PWRI+PATR+PNAT+PFINF
 DW IDFSM  ID
 DW 0  INDEX
 DB DAFSS  DA
 DB DAFST
 DW 1  BLOCK COUNT
 DB 'C'
*
 ASC 'BOOTLOAD'
 DB SYSIM  TYPE
 DW 380H  BLOCK SIZE
 DB PKIL+PWRI+PATR+PNAT+PFINF
 DW IDBOT  ID
 DW 0  INDEX
 DB DABOS  DISK
 DB DABOT  ADDRESS
 DW 1  BLOCK COUNT
 DB 'O'
*
 ASC 'SYSGLOBL'
 DB BNTYP  TYPE
 DW LNSPA  BLOCK SIZE
 DB PKIL+PWRI+PATR+PNAT+PFINF
 DW IDSPA  ID
 DW 0  INDEX
 DB DASPS  DISK
 DB DASPT  ADDRESS
 DW 1  BLOCK COUNT
DS0L DB 'R'
*
*
DS0N EQU DS0L+1  DISPLACEMENT TO NEXT ENTRY
*
*
*
*  IMAGE OF REMAINDER OF DIRECTORY SECTORS
*
*
DS1 DB 0  NUMBER OF ENTRIES
 DB 2  NEXT ENTRY DISPLACEMENT
 DW 0
*
STBUF ASC '(C) 1978  Processor Technology Corp'
 DB CR,LF
 ASC 'This is a system created DATA DISK
 DB CR,LF
 ASC 'All rights to code on this disk which is provided
 ASC ' by Processor Technology Corp are reserved by
 ASC ' Processor Technology Corp.
*
*
*  NEXT ID FILE IMAGE
*
LIDBF DW 15H NEXT FILE ID.
*
*
*  TEMP STORAGE FOR LOADER
*
*
LDCNT DB 0  DIRECTORY ENTRY COUNTER
UPFLG DB 1
*
*
*   THIS IS THE FREE SPACE MAP FOR THE DATA DISK
*
FMBF EQU $  BEGINNING OF 77+77 BUFFER
*
 DB 1FH,255,255,0F8H,255,255,255,255,255,255,255,255
 DB 255,255,255,255
 DB 255,255,255,255,255,255,255,255,255,255,255,255,255
 DB 255,255,255
 DB 255,255,255,255,255,255,255,255,255,255,255,255,255
 DB 255,255,255
 DB 255,255,0,0,3FH,255,255,255,255,255,255,255,255,255,255,255
 DB 255,255,255,255,255,255,255,255,255,255,255,255,255
 DB 255,255,255
 DB 255,255,255,255,255,255,255,255,255,255,255,255,255
 DB 255,255,255
 DB 255,255,255,255,255,255,255,255,255,255,255,255,255
 DB 255,255,255
 DB 255,255,255,255,255,255,255,255,255,255,255,255,255
 DB 255,255,255
 DB 255,255,255,255,255,255,255,255,255,255,255,255,255
 DB 255,255,255
 DB 255,255,255,255,255,255,255,255,255,255
*
 PAGE
*
*
*
*
*    STANDARD HEADER
*
*
STDHD DW 0  FOR SECTOR AND TRACK
STFOR DW 32768  FIRST SECTOR eg. NONE BEFORE
STBAK DW 65535  LAST SECTOR eg. NONE AFTER
STFID DW 0  ZERO = NO FILE
STPRO DB 1  PROTECT STATUS & NUMBER OF SECTORS
STSIZ DW 256  BLOCK SIZE
TSSPR DW 'TP'  P.T. OF COURSE
*
*
*
*     SYSTEM PARAMETER AND GLOBAL AREA
*
OFNUM DB 0  SYSTEM OUTPUT FILE NUMBER
DTUNT DB 0  SYSTEM DEFAULT UNIT NUMBER
*
*  THE FOLLOWING THREE ENTRIES MUST REMAIN IN THE
*  SAME RELATIVE POSITION TO EACH OTHER
*
OTUNT DB 0  OUTPUT UNIT
INUNT DB 0  INPUT UNIT
MXUNT DB 0  MAXIMUM ALLOWABLE UNIT
*
OPFLG DB 0  OPTIONS SELECTED FLAG
WAFLG DB 0  WAIT FLAG
FMONL DB 0  FORMAT ONLY FLAG
VEONL DB 0  VERIFY ONLY FLAG
ERFLG DB 0  INITIALIZE ONLY FLAG
DELMT DB 0  DELIMITER
TBUFP DW TKBUF  TRACK BUFFER POINTER
IBEND DW 0  TKBUF END
OBEND DW 0  VEBUF END
CBUFP DW 0  ADDRESS OF CURRENT TRACK BUFFER
*
*
*    UNIT AND TRACK COUNT KEEPER
*
RUNIT DB 0DFH
MAXZT DB 7
CUNIT DB 0
CTRCK DB 0
UNTAB DW 0
 DW 0
*
*
*   DISK DRIVER PARAMETERS
*
DTRIES DB 0
DSECN DB 0
DNERR DB 0
DTERR DB 0
DRLEN DW 0
DOPER DB 0
*
*
*
*      TRANSFER DESCRIPTOR
*
TDAD EQU $
*
TTSEC DB 0  SECTOR
TETRK DB 0  TRACK
TBCNT DW 0  BYTE COUNT
TFID DW 0  FILE ID
TBUF DW 0  BUFFER ADDRESS
TUNIT DB 0  UNIT
*
*
*
*     WRITE HEADER FROM HERE
*
TRBUF EQU $
*
TRSEC DB 0
TRTRK DB 0
TRFOR DW 0
TRBAK DW 0
TRFID DW 0
TRPRO DB 0
TRSIZ DW 0
SPARE DW 'TP'  TWO BYTES FOR EXPANSION
*
*
*
*     FORMAT HEADERS ARE READ TO HERE
*
TXBUF EQU $
*
TXSEC DB 0
TXTRK DB 0
TXFOR DW 0
TXBAK DW 0
TXFID DW 0
TXPRO DB 0
TXSIZ DW 0
TXSPR DW 0
*
*   INCOMMING HEADER BUFFER
*
IHEAD EQU $
*
IHSEC DB 0
IHTRK DB 0
IHFOR DW 0
IHBAK DW 0
IHFID DW 0
IHPRO DB 0
IHSIZ DW 0
IHSPR DW 0
*
*
*      OUTGOING HEADER
*
OHEAD EQU $
*
OHSEC DB 0
OHTRK DB 0
OHFOR DW 0
OHBAK DW 0
OHFID DW 0
OHPRO DB 0
OHSIZ DW 0
OHSPR DW 0
*
***********************
*
*
*
*     SYSTEM BUFFER FOR PSCAN
*
NBPTR DS 20
*
*
*     THEN THE STACK
*
 DS 60  FOR THE STACK
*
STACK EQU $
*
*
*
*   THE TRACK IS WOUND AND UNWOUND TO THIS BUFFER
*
HEADR EQU 13*4  FOUR HEADERS
MXTRK EQU 4095+380H  MAXIMUM DATA
MARKR EQU 4  NUMBER OF MARKERS
TKBUF DS HEADR+MXTRK+MARKR  MAX SIZE OF IT
VEBUF DS HEADR+MXTRK+MARKR  VERIFY BUFFER
*
PGEND EQU $  WE NEED THIS MUCH MEMORY
*
 PAGE
*
*
*******************************************
*
*
*
 ORG TKBUF
*
*
*
*            START UP AND SCAN THE OPTIONS
*
*  NOTE !!!!
*
*  THIS CODE GETS EATEN AFTER THE OPTIONS TEST
*
*
*   GET THE SYSTEM STUFF
*
CSTRT LHLD SYSGLO  GET GLOBAL AREA
 LXI D,GLUNI
 DAD D
 MOV A,M
 STA DTUNT  DEFAULT UNIT FOR CHECK LATER
*
*
*   GET FIRST UNIT  (REQUIRED)
*
GUNT1 CALL FUNGT  CALL GET UNIT ONLY
 CC ER1  UNIT SPEC OUT OF RANGE
 CZ ER0  NO PARAMS GIVEN
*
 STA INUNT  THIS IS THE IN-UNIT
 STA OTUNT  JUST IN CASE ONLY ONE UNIT IS SPECIFIED
 CALL DLMCK  CHECK IF ONLY ONE UNIT
 CZ ER2  NO OPTIONS ERROR
*
*   TEST FOR SECOND UNIT   (OPTIONAL)
*
 CALL FUNGT  GET NEXT UNIT IF ANY
 JNC GUNT2  BRANCH IF THERE WAS
*
 LDA NBPTR  GET FIRST CHR FROM BUFFER
 CPI 'a'
 JC SGET
 CPI 'z'
 JNC SGET
 XRI 20H  UPSHIFT FOR LOWER CASE
SGET CPI 'S'  SET OPTIONS?
 JZ OPNTN  NO SECOND UNIT....START OPTIONS
 CALL ER2  BAD OPTION PARAMETER, UNIDENTIFIED
*
*
GUNT2 STA OTUNT  SAVE AS THE OUTPUT UNIT
*
*
*   SCAN FOR OPTIONS IF ANY
*
OPNGT CALL FLMCK  FALLS THROUGH IF NO OPTIONS
 MVI A,PSOPT  READ THEM ALL IN
 LXI D,NBPTR
 CALL PSCAN
 STA DELMT  SAVE THE DELIMITER
 CC ER7  PSCAN ERROR
 JZ OPNGT  NO CHRS IN BUFFER
*
OPNTN LXI H,NBPTR  POINT TO START OF BUFFER
 MOV A,M  GET FIRST CHR FROM BUFFER
 CPI 'a'
 JC OPNT0
 CPI 'z'
 JNC OPNT0
 XRI 20H
OPNT0 PUSH PSW  SAVE FOR LATER
*
OPN1A ORA A  HAVE WE REACHED THE DELIMITER?
 CZ ER8  BAD OPTIONS
 CPI '='  SCAN PAST EQUALS
 INX H
 MOV A,M  GET NEXT CHR
 JNZ OPN1A
*
*  PROCESS THE LOT OF THEM
*
 POP PSW  GET BACK FIRST CHR
 CPI 'S'  SWITCH?
 CNZ ER2  NOPE
 LDA OPFLG  GET OPTION PROCESSED FLAG
 ORA A
 CNZ ER3  ALREADY PROCESSED THE OPTIONS
 INR A
 STA OPFLG  SET OPTIONS PROCESSED
*
*  PROCESS S="F","V" AND "-W" TYPES
*
SOPNT MOV A,M  GET NEXT CHR
 CPI 'a'
 JC SOPNX
 CPI 'z'+1
 JNC SOPNX
 XRI 20H  UPSHIFT ASCII
*
SOPNX INX H  BUMP THE POINTER
 CPI 'F'
 JZ SEFMT  SET FORMAT ONLY
 CPI 'V'
 JZ SEVRF  SET VERIFY ONLY
 CPI 'I'
 JZ SEERA  SET INITIALIZE ONLY   ####
 ORA A
 JZ OPNGT  NOW GO BACK
 CPI '+'  PLUS SIGN?
 JZ SOPNT
 CPI '-'
 CNZ ER2  BAD OPTION IDENT
*
*   PROCESS THE CHR FOLLOWING THE MINUS SIGN
*
 MOV A,M  GET IT
 CPI 'W'
 JZ SWAIN
 CPI 'w'
 CNZ ER2  WRONG FOLLOWING PARAMETER
SWAIN INX H
 STA WAFLG  SET NO WAIT FLAG
 JMP SOPNT
*
SEFMT STA FMONL  FORMAT ONLY
 JMP SOPNT
*
SEVRF STA VEONL  VERIFY ONLY
 JMP SOPNT
*
SEERA STA ERFLG  INITIALIZE  ####
 JMP SOPNT
*
*
***************************
*
*
*
*    GET UNIT NUMBER FROM PSCAN
*
FUNGT LXI D,NBPTR
 MVI A,PSOPT  SCAN OPTIONS ONLY
 CALL PSCAN  DO THE SCAN
 STA DELMT  SAVE THE DELIMITER
 CC ER7  ERROR?
 RZ .  NO CHRS WERE GIVEN
*
 LXI H,NBPTR
 MOV A,M  GET FIRST CHR
 CPI '/'
 JNZ FUNG1  DEFAULT TO ACTUAL UNIT NUMBER
 INX H  SKIP OVER THE SLASH
*
FUNG1 MOV A,M  GET CHR
 SUI '0'  REMOVE BIAS
 RC .  TOO SMALL
 CPI 8  TOO BIG?
 CMC
 RET .  TEST IN HAND
*
*
*   CHECK FOR CR OR ; DELIMITER
*
DLMCK LDA DELMT  GET DELIMITER
 CPI 0DH
 RZ .
 CPI ';'
 RET
*
*
*   CHECK FOR CR OR ; AND TERMINATE SCAN IF RECEIVED
*
FLMCK CALL DLMCK
 RNZ .  WASN'T THE RIGHT ONE
 JMP COPY1
*
*   ERROR HANDLING
*
ER0 LXI H,MES0
MESG MOV A,M
 ORA A
 JZ DRRET
 CALL CONOUT
 INX H
 JMP MESG
*
ER1 LXI H,MES1
 JMP MESG
ER2 LXI H,MES2
 JMP MESG
ER3 LXI H,MES3
 JMP MESG
ER4 LXI H,MES4
 JMP MESG
ER5 LXI H,MES5
 JMP MESG
ER7 LXI H,MES7
 JMP MESG
ER8 LXI H,MES8
 JMP MESG
ER9 LXI H,MES9
 JMP MESG
ER10 LXI H,MES10
 JMP MESG
*
*
MES0 ASC "Unit parameter required"
 DB 0
MES1 ASC "Unit out of range"
 DB 0
MES2 ASC "Error in command syntax"
 DB CR,LF
 ASC "DISKCOPY fromunit{,tounit}{,S=options}
 DB CR,LF
 ASC 'options =   V  Verify disk(s)
 DB CR
 ASC '            I  Initialize disk
 DB CR
 ASC '            F  Generate a data disk
 DB CR
 ASC "           -W  Do not wait for carriage return
 DB 0
MES3 ASC "Options specified twice"
 DB 0
MES4 ASC "Default unit specified for output"
 DB 0
MES5 ASC "Unit 0 specified for output"
 DB 0
MES7 ASC "System scan error
 DB 0
MES8 ASC "Options expected '='"
 DB 0
MES9 ASC "System locked"
 DB 0
MES10 ASC "In and Out units can't be the same"
 DB 0
*
A
* Drawing Number :
* DCOPY:S 8085 source code for a disk copy routine to copy
* Mitsubishi 3.5 inch SS DD disks under PTDOS.
* Program author L.N. Smith
* Date 29 04 88
*
* This program expects the following:
* The monitor program SAMDI with :
* disk transfer routine call (xfer) available at $f016.
* Standard PTDOS system calls
  org  100h
  xeq  100h
main   equ  $
  lxi  sp,toms
  call inits        initialize disk head psn, block transfer
*                   descriptor table, select operation
  jc   error        No errors => cy clear
  call copy         copy 1 track at a time until done.
  jc   error        any error will result in cy set, or vv
*                   now home disks
  xra  a            set initialize op
  sta  op
  call init4        do both drives
  lxi  h,mdone
  call dtext        post copy complete message
  call sys          std return, continue processing cmnd line
  db   retop
*
********
inits  equ  $      intiialize ( home) both disk drives, setup
* the block transfer descriptor table, print message.
* Expects bxd setup correctly, returns cy set if errors.
  lxi  h,sdm        message place disks in drive, Y when ready
  call dtext
init1  equ  $
  call const        char ready?
  jz   init1
  call conin
  cpi  esc          esc?
  jz   abhort       yes .. then abhort
  cpi  cr
  jz   init4        cr .. then go copy
  jmp  init1        ignore all else

*
init4  equ  $
  lxi  h,bxd        first home disk heads.  We assume the
  mvi  m,unit1      op is valid. Set up unit 1
  call xfer         home .. any errors
  jc   inerr        yes .. return here
  lxi  h,bxd        no continue
  mvi  m,unit0      set unit 0
  call xfer
  jc   inerr
  xra  a           clear cy
  ret
*
inerr  equ  $
  stc
  ret
*
abhort equ  $
  lxi  h,mabho      post abhort message
  call dtext        onto console
  call sys          then return to system, resetting when there
  db   resop
*
*********
copy   equ  $       While block # < topbl+1 DO
*                     copy a track
*                   End
  lxi  d,topbl+1    Load the top sector number+1
  lhld blrec        Present sector #
  mov  a,h
  cma
  mov  h,a
  mov  a,l
  cma
  mov  l,a
  inx  h
  dad  d           subtract the two
  mov  a,h
  ora  l           same?
  jz   copy4       Yes .. we're done.
  call ctrk        No  .. copy the next track
  rc   .           Returns : cy set for errors - or else clear
  jmp  copy        Loop for more
*
copy4 equ  $
  xra  a           clear cy .. there are no errors
  ret

ctrk   equ  $
* ctrk : copy a track from drive 0 to drive 1.  On entry the
* the first sector number on the track is found in blrec.
  lhld blrec
  shld fblot        save the # of the first block on the track
* Prepare to read 8 sectors of a trk into buffer
  lxi  h,bxd+1
  mvi  m,rdop       read a sector into the buffer
  dcx  h
  mvi  m,unit0
  mvi  a,8
  sta  secnt        set sector cunter to 8 sectors for trk
  lxi  h,dbuff
  shld blxa         set transfer address to start of buffer
  call xftrk        read a track from disk
  rc   .
* Set up to write a track of 8 sectors
  mvi  a,8
  sta  secnt
  lhld fblot        get the OLD # of the first block on disk
  shld blrec        into the descriptor
  lxi  h,dbuff      set the transfer address
  shld blxa
  lxi  h,bxd+1      set the operation to a write
  mvi  m,wrop
  dcx  h            on drive 1
  mvi  m,unit1
  call xftrk        write the track
  ret  .
*

xftrk  equ  $
  lxi  h,bxd
  call xfer
  jmp  cerr         all errors return here
  lxi  d,blkz       add one blocksize to the transfer address
  lhld blxa
  dad  d
  shld blxa
  lhld blrec        increment the sector number
  inx  h
  shld blrec
  lda  secnt        count down the sectors 8 .. 7 .. .. 0
  dcr  a
  sta  secnt
  jnz  xftrk
  xra  a            clear cy
  ret
*
cerr   equ  $
  stc
  ret

error equ  $
* Error : an a drive related error has occurred. Report
*
  lxi h,merr
  call dtext
  call sys
  db   resop


bxd    equ  $       block 0 transfer descriptor
unit   db   0
op     db   0
       dw   blkz
blrec  dw   0
blxa   dw   dbuff
blres  db   00
*
********
dtext  equ  $
* Print the text @ hl to the current output device
* Text is terminated by null.
  mov  a,m
  ora  a
  rz
  call conot
  inx  h
  jmp  dtext
*
* all messages follow from here
*
sdm    equ  $
  dw   crlf
  asc  "Copy from drive 0 to  drive 1.  Insert your disks,"
  dw   crlf
  ascz "then type 'return' to continue or 'esc' to quit."
*
mabho  equ  $
  dw   crlf
  ascz "Copy abhorted"
*
merr   equ  $
  dw   crlf
  ascz "Copying error .. process abhorted"
*
mdone   equ  $
  dw    crlf
  ascz  "Copy complete"
*
********
*
secnt  db   0              sectors done in track counter
fblot  dw   0              tmp first sector # on this track
dbuff  ds   512*8          the track buffer's home
       ds   64             the stack lives here
toms   equ  $              top of machine stack
sam    equ  0f000h
conot  equ  0bc9fh         entry point for ptdos console op
conin  equ  0bca2h         console input
const  equ  0bc9ch         console input status
sys    equ  0bcbch         entry point for ptdos system calls
xfer   equ  sam+16h
blkz   equ  512            bytes
topbl  equ  27fH
rdop   equ  1
wrop   equ  2
unit0  equ  0
unit1  equ  1
crlf   equ  0a0dh
cr     equ  13
esc    equ  1bh
retop  equ  13             return to dos
resop  equ  20             dos reset operation
*
*
*
