for INTRQ JM FORMAT MAC~FORMAT COM SYSGEN29ASMaSYSGEN29COMCLOAD60 ASMCBIOS60DASMSGENPAT ASMMCPMPAT ASMSGENPAT HEXMCPMPAT HEX1771 DOCrn 0 on zero RZ MVI A,2 ;Rturn 2 on non-zero RET ; ; RROR REPORTING SUBROUTINE ERRMG: CALL PMSG ;Print message ; ; F O R M A T . M A C ; ; General Disk Formatter. ; Written by Willis E. Howard, III (1983). ; ; CP/M 8" SSSD Disk formatter. ; For TARBELL controller, dual PERTEC drives. ; ; For other systems, the code enclosed in asterisks ; may need to be changed. Narrow sectors may only be ; read by the 1771 disk controller. ; ; Modified 11-Dec-83 WEH. ; 1) Only 3 formats: 2, 26 and 29 sectors/track. ; 2) No index marks for non-standard formats. ; 3) Test disk speed 5208 +/- 50 bytes per track. ; 4) Increased gap for non-standard formats. ; 5) Verify by read after write. ; 6) Write routine shortened. ; ; Assemble with M80, L80. ; ; BOOT EQU 0 ;CP/M boot address BDOS EQU 5 ;CP/M vector address PIBC EQU 46 ;Preindex byte count LIMIT EQU 50 ;Disk speed limit variation ; CR EQU 0DH ;ASCII characters LF EQU 0AH CNTLC EQU 03H BELL EQU 07H ; ;******************************************************** ; * ; Disk constants for your system * ; * STPRAT EQU 2 ;10 ms stepping rate * HFLAG EQU 11010001B ;Home status mask * MAXDSK EQU 2 ;Maximum disk count * ; * DCOM EQU 0F8H ;DISK command port * DSTAT EQU DCOM ;DISK status port * TRACK EQU DCOM+1 ;DISK track port * SECTP EQU DCOM+2 ;DISK sector port * DDATA EQU DCOM+3 ;DISK data port * WAIT EQU DCOM+4 ;DISK wait port * DCONT EQU DCOM+4 ;DISK control port * ; * ;******************************************************** ; ; Macros ; PRINT MACRO MESSAGE ;Print a message LXI D,MESSAGE ;Address of message MVI C,9 ;Command code CALL BDOS ;Do it. ENDM ; ENDON MACRO CHAR ;Return on CHAR match CPI CHAR JZ RETURN ENDM ; SHOW MACRO CHAR ;Print character PUSH H ;Save registers PUSH D PUSH B MVI C,2 ;Command code MVI E,CHAR ;Output character CALL BDOS ;Do it POP B ;Restore registers POP D POP H ENDM ; ;******************************************************** ; * ; This MACRO must step the disk IN. * ; This routine must save B and set NZ if error. * ; * STEPIN MACRO ;Step disk in * MVI A,048H+STPRAT ;Step in command * OUT DCOM ; * IN WAIT ; * IN DSTAT ; * ANI HFLAG ;NZ=Error * ENDM ; * ; * ;******************************************************** ; CSEG ; ; Initialization. MAIN: ;Entry point LXI SP,STACK PRINT SIGNON ;Print SIGNON string ; ;******************************************************** ; * MVI A,STPRAT ;Home the disk now * OUT DCOM ; * IN WAIT ;No check for errors * ; * ;******************************************************** ; ; Get disk designation. ; Come here for each new disk to format. BEGIN: PRINT MSG1 ;Get drive ID CALL READKB ;Wait for reply ENDON CNTLC ;Exit on control-C SBI 'A' ;Get drive A offset JC BG0 ;Jump on too low CPI MAXDSK ;Disk count JP BG0 ;Jump on too high STA DISK ;Else store JMP BG1 ;and continue BG0: PRINT MSG7 ;Report error JMP BEGIN ;and retry ; ; Set tracks BG1: MVI A,77 ;Default final track number + 1 STA TTRK XRA A ;Default starting track STA STRK PRINT MSG2 ;Prompt for real track values CALL READKB ;Wait for reply ENDON CNTLC ;End on ^C CPI 'S' ;SYSTEM tracks only JNZ BG2 MVI A,2 ;Final track for system + 1 = 2 STA TTRK JMP BG4 BG2: CPI 'D' ;DATA tracks only JNZ BG3 MVI A,2 ;Start track for data = 2 STA STRK JMP BG4 BG3: CPI 'A' ;ALL tracks, already set JZ BG4 CPI 'R' ;Set a RANGE JNZ BGERR PRINT MSG12 ;Start track CALL NUMBER ;Get number MOV A,L STA STRK ;Store it PRINT MSG13 ;End track CALL NUMBER ;Get number MOV A,L INR A ;Add 1 STA TTRK ;Store it MOV B,A LDA STRK ;Check for start>final CMP B ;If so, fall through JM BG4 ;for error report BGERR: PRINT MSG7 ;Error message JMP BG1 ; ; Get sectors/track BG4: PRINT MSG9 ;Prompt CALL NUMBER ;Get sectors/track MOV A,L ;Use only LSB STA SPT ;Save it CPI 26 ;Test if standard JNZ BG6 ;Jump if not ; ; Standard format ; MVI A,26 BG5: STA GAP ;26 is the standard gap count XRA A STA SLENG ;Zero length byte for IBM,128 LXI H,128 SHLD FIELD ;128 bytes per sector JMP BG20 ;all parameters defined ; ; Test for 29 sectors/track BG6: CPI 29 ;If not 29 JNZ BG11 ;Then jump MVI A,13 ;Else set narrow gap JMP BG5 ; ; Test for 2 sectors/track BG11: CPI 2 ;If not 2 sectors/track JNZ BG14 ;then jump MVI A,102 ;Set gap STA GAP MVI A,2432/16 ;Set sector length code STA SLENG LXI H,2432 ;Set sector length SHLD FIELD JMP BG20 ;Continue ; ; Else error message BG14: PRINT MSG10 ;Print message JMP BG4 ;Retry ; ; Get here after all parameters have been defined. BG20: PRINT MSG8 ;Ready message CALL READKB ;Get KB character ENDON CNTLC ;Exit on control-C PRINT CRLF ;Echo that we are ready LDA DISK ;Disk # in A ; ;******************************************************** ; * ; Home drive given in A, then load head. * ; * PUSH PSW ; * MVI A,0D0H ;Kill current command * OUT DCOM ; * POP PSW ; * ANI 1 ;Only 2 disks * CMA ;Form the command * ADD A ; * ADD A ; * ADD A ; * ADD A ; * ORI 2 ; * OUT DCONT ;Select now * MVI A,STPRAT ;Home w/ head up * OUT DCOM ; * IN WAIT ; * IN DSTAT ; * ANI 10H ;Test seek bit * JNZ ERRHL ; * ; * ;******************************************************** ; ; Step in to the starting track in STRK ; LDA STRK ;Set initial track STA CTRK ORA A JZ NXTTRK ;Step head if start not zero MOV B,A STPAGN: SHOW '*' ;This track not written STEPIN ;MACRO to step to next track JNZ ERRHL DCR B ;Check counter JNZ STPAGN ;Loop if more ; ; We will first fill a buffer with all of the characters ; to be sent to the next track. Only afterwards will they ; be written. This eliminates some timing problems on 2MHz ; systems with large sector counting. By overfilling this ; buffer with 0FFH, we are unconcerned with the actual count. NXTTRK: LXI B,7000 ;Make too large - really 5208 +/- 20 LXI H,BUFFER ;Get starting address LP1: MVI M,0FFH ;Prefill with FF INX H ;Next address DCX B MOV A,B ORA C ;Count down JNZ LP1 ;to zero ; ; Setup sector counters ; MVI D,1 ;Sector counter LDA SPT MOV E,A ;Set sector count MVI B,PIBC ;Gap 4 preindex 40 bytes of FF LXI H,BUFFER ;Get address ; ; Fill the buffer before writing anything ; ; Preindex fill ; Skip if non-standard format ; LDA SPT ;Test sectors/track CPI 26 ;Jump on non-standard JNZ MORE ; PREIND: MVI M,0 ;Preindex fill INX H DCR B ;Count =Count - 1 JNZ PREIND ;Go back till B =0 ; ; Address mark for track ; MVI M,0FCH ;Load address mark INX H ; ; Post index gap MORE: MVI B,11 ;Set up for non-standard LDA SPT ;Test sectors/track CPI 26 ;Test if standard JNZ POSTID ;Jump if non-standard MVI B,26 ;Else set standard gap POSTID: MVI M,0FFH ;Load fill data INX H DCR B ;Count = count - 1 JNZ POSTID ;If not 0 go back ; ; Pre ID section ASECT: MVI B,6 ;Get # of bytes SECTOR: MVI M,0 ;Zero fill INX H DCR B ;Count = count-1 JNZ SECTOR ;Jmp back if not done ; ; ID address mark (IDAM) ; MVI M,0FEH ;Get address mark INX H ; ; Track number changes for each track ; LDA CTRK ;Get track number MOV M,A ;Write to buffer INX H ; ; Write one byte of 00 ; MVI M,0 ;Store a zero INX H ; ; Sector number ; MOV M,D ;Get sector # INX H ;Write to buffer INR D ; ; One more byte for sector count algorithm ; LDA SLENG ;Set to index MOV M,A ;Write it to buffer INX H ; ; Write 2 CRC'S on this sector ; MVI M,0F7H ;Get CRC pattern INX H ;Write to buffer ; ; Pre data 17 bytes 00 ; MVI B,17 ;Set count PREDAT: MVI M,0 ;Zero fill INX H DCR B ;Reduce count by 1 JNZ PREDAT ;Go back if not done ; ; Data address mark ; MVI M,0FBH ;Get data address mark INX H ;Write it to buffer ; ; Fill data field with E5. ; The use of the FIELD variable slowed down this routine ; so much that a 2MHz system could not calculate AND write ; to the disk fast enough. So, we fill first and dump later. ; LDA FIELD ;Sector length to BC MOV C,A LDA FIELD+1 MOV B,A DFILL: MVI M,0E5H ;Get fill byte INX H DCX B ;Drop 1 from count MOV A,B ORA C JNZ DFILL ;Do till BC=0 ; ; Write CRC'S ; MVI M,0F7H ;Get CRC byte INX H ; ; End of sector fill ; DCR E ;Reduce sector count JZ SEND ;If 0 do end of track routine DATGAP: MVI M,0FFH ;Store an FF INX H LDA GAP ;Set up for next sector MOV B,A JMP POSTID ;Go back for next sector ; ; Get here when the buffer has been filled with all data. ; It will now be written to disk. SEND: SHLD BUFCNT ;Save current address counter LXI H,BUFFER ;Get initial address ; ;**************************************************************** ; * ; Issue WRITE TRACK and dump contents pointed to * ; by HL until 1771 interupt. * ; * MVI A,0F4H ;Load track write * OUT DCOM ;Issue track write * IN WAIT ;Wait for command to finish * LOOP: ; * MOV A,M ;Get memory value * OUT DDATA ;Output to disk * INX H ;Next address * IN WAIT ;Wait for next request * ORA A ;Test type of request * JM LOOP ;Loop til done * ; * ;**************************************************************** ; ; This routine checks to see if all data has been written to ; disk. If not, an error message is generated and the ; program lets you try again. There are four tests: ; Byte count, Write error, Disk speed and Verify by read. ERRCHK: XCHG ;Save final address in DE LHLD BUFCNT ;Get memory max in HL CALL NEGHL ;Negate HL DAD D ;get difference MOV A,H ;test sign ORA A JM ERRMSG ;neg. is error ; ; Get here if buffer count was OK. DONE: ; ;******************************************************** ; * ; Check for disk write error * ; * IN DSTAT ;Read status * ANI 0FFH ;Test for flag * JNZ ERRWTK ;If error, display it * ; * ;******************************************************** ; ; For first track written, verify disk speed. ; We don't check disk speed before writing since ; there may be no formatted data to read. ; LDA CTRK ;Get current track MOV B,A ;Save in B LDA STRK ;Get starting track CMP B ;If same as current, JNZ VERIFY ;test speed, else just verify. LXI H,0 ;Initialize byte count ; ;******************************************************** ; * MVI A,0E5H ;Read track,non-sync * OUT DCOM ;Issue command * IN WAIT ;Wait for start * COUNT: ; * IN DDATA ;Read a byte * INX H ;Count+1 * IN WAIT ;Wait for next request * ORA A ;Test type of request * JM COUNT ;Jump if data * IN DSTAT ;Check for errors * ANI 0FFH ; * ; * ;******************************************************** ; JNZ ERRRTK ;NZ means read track error LXI D,LIMIT-5208 ;Offset for count test DAD D ;No error if 0 <= HL <= 2*LIMIT MOV A,H ;H must be 0 ORA A JNZ ERRSPD MOV A,L ;L must be <= 2*LIMIT SBI 2*LIMIT JNC ERRSPD ; ; Verify that all sectors just written are readable. VERIFY: ; ;******************************************************** ; * LDA CTRK ;Define current track * OUT TRACK ; * MVI E,1 ;First sector * VER2: ; * MOV A,E ;Tell the controller * OUT SECTP ; * LDA SPT ;Obtain read command * CPI 2 ; * MVI A,80H ;NON-IBM * JZ VER5 ; * ADI 8H ;IBM * VER5: ; * OUT DCOM ;Issue read command * IN WAIT ;Wait for request * VER10: ; * IN DDATA ;Get a byte * IN WAIT ;Wait for request * ORA A ;Test type of request * JM VER10 ;Jump if data request * IN DSTAT ;Get error codes * ANI 09DH ;Mask error bits * ; * ;******************************************************** ; JNZ ERRVFY ;Jump if error LDA SPT ;Check for last sector CMP E ;Compare to current sector JZ NEXT ;End of equal INR E ;Else next sector JMP VER2 ; ; Go to next track unless this is the last NEXT: SHOW '.' ;Show a dot for each track written LDA CTRK INR A ;Current track + 1 STA CTRK MOV B,A LDA TTRK CMP B ;Compare with final track JZ ANOTHER ;Jump if end ; BMPTRK: STEPIN ;Step to next track JZ NXTTRK ;Loop on no error JMP ERRHL ;Else report it ; ; Check for another disk to format ANOTHER: PRINT MSG11 ;Prompt for another disk CALL READKB ;Wait for reply ENDON CNTLC ;Exit on control-C ENDON 'N' ;Exit on NO JMP BEGIN ;Otherwise, another disk ; ; Common exit routine RETURN: ; ;******************************************************** ; * ; Select drive A and unload head * ; * XRA A ;Select drive A * CMA ;Form the command * ADD A ; * ADD A ; * ADD A ; * ADD A ; * ORI 2 ; * OUT DCONT ;Select now * MVI A,STPRAT ;Home w/ head up * OUT DCOM ; * IN WAIT ;No error test * ; * ;******************************************************** ; JMP BOOT ;Warm boot ; ; Subroutines. ; ; Read a character from the Keyboard. READKB: MVI C,1 ;Get any character CALL BDOS CPI 'a' ;CONVERT LOWER CASE! RC ;Below LC CPI '{' RNC ;Above LC ANI '_' ;Mask off LC bit RET ; ; Read a number from the keyboard in decimal. ; You may want to implement BS or DEL keys here. NUMBER: LXI H,0 ;initialize count LUPNUM: PUSH H CALL READKB ;Get a character POP H CPI CR ;Return ends the number RZ SBI '0' ;Make binary RM ;Non-digit ends number CPI 10 RP DAD H ;*2 MOV D,H MOV E,L DAD H ;*4 DAD H ;*8 DAD D ;*10 ADD L ;LSB MOV L,A JNC LUPNUM INR H ;MSB JMP LUPNUM ; ; Negate HL NEGHL: MOV A,H CMA MOV H,A MOV A,L CMA MOV L,A INX H RET ; ; These error routines are jumped to. ERRMSG: PRINT ERMSGA ;Interupt JMP ANOTHER ; ERRHL: PRINT ERMHLD ;Head move JMP ANOTHER ; ERRWTK: PRINT ERMWTK ;Write track JMP ANOTHER ; ERRVFY: PRINT ERMVFY ;Verify JMP ANOTHER ; ERRRTK: PRINT ERMRTK ;Read track JMP ANOTHER ; ERRSPD: PRINT ERMSPD ;Disk speed JMP ANOTHER ; ; Messages SIGNON: DB CR,LF,'Disk format utility for 8" Tarbell/Pertec' DB CR,LF,'Controller base address at 0F8H' DB CR,LF,'Written by W. E. Howard, III' DB CR,LF,'Revised 11-Dec-83$' ; MSG1: DB CR,LF,CR,LF,'In which DRIVE is the unformatted disk ? $' MSG2: DB CR,LF,'Format ALL, SYSTEM, DATA or a RANGE of tracks (A,S,D,R) ? $' MSG7: DB BELL,CR,LF,'Invalid entry, try again OR control-C to abort.$' MSG8: DB CR,LF,'Type any key to format OR control-C to reboot : $' MSG9: DB CR,LF,'Sectors per track ? $' MSG10: DB BELL,CR,LF,'Only 2, 26 and 29 sector/track formats supported.$' MSG11: DB CR,LF,'Return to restart OR control-C to reboot : $' MSG12: DB CR,LF,'Starting track number ? $' MSG13: DB CR,LF,'Final track number ? $' ; ERMSGA: DB BELL,CR,LF,'Disk interrupt error.',CR,LF,'$' ERMHLD: DB BELL,CR,LF,'Disk head move error.',CR,LF,'$' ERMRTK: DB BELL,CR,LF,'Disk read track error.',CR,LF,'$' ERMSPD: DB BELL,CR,LF,'Disk speed error.',CR,LF,'$' ERMVFY: DB BELL,CR,LF,'Disk sector verify error.',CR,LF,'$' ERMWTK: DB BELL,CR,LF,'Disk write track error.' CRLF: DB CR,LF,'$' ; ; Variables: The values shown will be overwritten. ; Don't make this a DSEG unless you make sure that it ; is loaded above the CSEG. The track buffer starts ; at BUFFER and now fills 8000 bytes. Using a DS ; command just takes up disk space for the COM file. ; DISK: DB 1 SPT: DB 26 STRK: DB 0 CTRK: DB 0 TTRK: DB 77 SLENG: DB 0 GAP: DB 26 FIELD: DW 128 DS 128 STACK: BUFCNT: DW BUFFER BUFFER EQU $ ; END MAIN 1yO > A442?8 >M22 Se>2îDr>2îAʮR£ }23 }<2G:8 ? }2>22!"> >f2>2! " îk  :>/>:2cG*>JEX!{6# xi:_.!{:6#…6# :›6#›6#¤6#:w#6#r#:w#6#6#6#:O:G6# x6#6#:GÛ"y!{>~#*y| #:G:L!>#-9|D}dD:{:>bf.:ʀS.:<2G:ʬ>Jc N/>a{_! 0 )T]))o$|/g}/o#K ìf ì ì ì ì ì Disk format utility for 8" Tarbell/Pertec Controller base address at 0F8H Written by W. E. Howard, III Revised 11-Dec-83$ In which DRIVE is the unformatted disk ? $ Format ALL, SYSTEM, DATA or a RANGE of tracks (A,S,D,R) ? $ Invalid entry, try again OR control-C to abort.$ Type any key to format OR control-C to reboot : $ Sectors per track ? $ Only 2, 26 and 29 sector/track formats supported.$ Return to restart OR control-C to reboot : $ Starting track number ? $ Final track number ? $ Disk interrupt error. $ Disk head move error. $ Disk read track error. $ Disk speed error. $ Disk sector verify error. $ Disk write track error. $Mw+ 0 10w+ 0/0w+00000{=*u:+~ 5 5 00!:͂ 41#6 +͇.&̇.:ʇ.{ ; ; S Y S G E N 2 9 . A S M ; ; This program allows a sysgen to/from system ; tracks with 29 sectors per track. ; ; Generated and modified from a disassembly by ; Willis E. Howard, III (1983). ; ; Useful constants. ; All equate variables in lower case. ; bell EQU 7 ;ASCII values bs EQU 8 tab EQU 9 lf EQU 10 vt EQU 11 ff EQU 12 cr EQU 13 ; boot EQU 0 ;Warm boot entry point wboot EQU 1 ;Warm boot vector address bdos EQU 5 ;BDOS entry point dfcb EQU 5CH ;Default FCB dmabuf EQU 80H ;Default DMA buffer buffer EQU 900H ;SYSGEN buffer begin maxdsk EQU 02H ;Maximum number of drives ; ; Set program origin ; ORG 0100H ; ; Jump over variables and subroutines ; JMP BEGIN ; DB ' ' ; ; Total number of system tracks to read/write TRACKS: DB 2H ; ; Total number of sectors per system track ; Standard value is 26. Now set for 29 to ; get extended CBIOS. MXSEC: DB 1DH ; ; This is a list of the sectors, from 1 to MXSEC. ; The ordering should reflect the desired skew for ; your system. Now set for two. There is no real ; conversion of logical to physical sectors. This ; table just gives the ORDER in which sectors are ; read and written. Unused table space zero filled. SECLST: DB 1H,3H,5H,7H,9H,0BH,0DH,0FH,11H,13H,15H,17H,19H,1BH,1DH DB 2H,4H,6H,8H,0AH,0CH,0EH,10H,12H,14H,16H,18H,1AH,1CH DB 0H,0H,0H,0H,0H,0H,0H,0H,0H,0H,0H,0H,0H DB 0H,0H,0H,0H,0H,0H,0H,0H,0H,0H,0H,0H,0H DB 0H,0H,0H,0H,0H,0H,0H,0H,0H ; ; HL = A * 128 ; This subroutine is used for calculating the offset ; of the track buffer for the sector given by A. MUL128: MOV L,A ;Put A in HL MVI H,00H DAD H ;Multiply by 128 DAD H DAD H DAD H DAD H DAD H DAD H RET ;Now return ; ; Get a character from the console in upper case. CONIN: MVI C,01H ;Read console character code CALL bdos ;Do it through the BDOS CPI 'a' ;Less than 'a' is OK RC CPI '{' ;Greater than 'z' is OK RNC ANI '_' ;Wipe out LC bit RET ; ; Output A to the console CONOUT: MOV E,A ;Put the character in E MVI C,02H ;Write console character code CALL bdos ;Do it throught the BDOS RET ; ; Output a CR, LF CRLF: MVI A,cr ;CR out CALL CONOUT MVI A,lf ;LF out CALL CONOUT RET ; ; Output CR, LF and a string NLOUT: PUSH H CALL CRLF POP H ; ; Output just a string pointed to by HL and ; terminated with a zero byte PSTRING: MOV A,M ;Get the character ORA A RZ ;End on zero PUSH H CALL CONOUT ;Else, output it POP H INX H ;Next address JMP PSTRING ;And loop ; ; Select the disk given in A SELDSK: MOV C,A ;Disk given by C LHLD wboot ;Vector into BIOS LXI D,018H ;to select disk routine DAD D PCHL ; ; Set the track given in C SETTRK: LHLD wboot ;Vector into BIOS LXI D,01BH ;from wboot address DAD D ;to set track routine PCHL ; ; Set sector given in C SETSEC: LHLD wboot ;Get WBOOT address in BIOS LXI D,01EH ;Offset to set sector address DAD D ;Calculate it PCHL ;and jump ; ; Set DMA address, given in BC SETDMA: LHLD wboot ;Get WBOOT address in BIOS LXI D,021H ;Offset for set DMA routine DAD D ;Calculate PCHL ;and execute ; ; Read a sector READ: LHLD wboot ;Get WBOOT address in BIOS LXI D,024H ;Offset for read sector routine DAD D ;Calculate the address PCHL ;Jump to it ; ; Write a sector WRITE: LHLD wboot ;Get WBOOT address in BIOS LXI D,027H ;Offset for write sector routine DAD D ;Calculate the address PCHL ;Jump to it ; ; Read a sequential file sector READSQ: MVI C,014H ;Command code to read JMP bdos ;via the BDOS ; ; Open a file to read OPEN: MVI C,0FH ;Command code to open JMP bdos ;a file ; ; This subroutine will read or write the entire ; buffer starting at 'buffer', now set at 900H. ; TRACKS gives the number of tracks read/written, starting at 0. ; MXSEC gives the number of sectors read/written per track. ; SECLST determines the order in which sectors are read/written. RWSYS: LXI H,buffer ;Get the starting address SHLD POINTER ;and store it. MVI A,0FFH ;Get a -1 in track counter so that STA TRKCNT ;the first increment makes it 0. ; ; Come here to read/write another track. RWTRK: LXI H,TRKCNT ;Increment the track counter INR M LDA TRACKS ;Compare with the total for R/W CMP M JZ FINISH ;Finish off after total reached. ; ;Else begin the R/W track section MOV C,M ;Get the track counter CALL SETTRK ;and call the set track routine MVI A,0FFH ;Get a -1 in the sector counter so that STA SECCNT ;the first increment makes it 0. ; ; Come here to read/write another sector. RWSEC: LDA MXSEC ;Get the maximum sector count. LXI H,SECCNT ;Increment current sector count INR M ;and compare CMP M ;the two. JZ NEWBUF ;Jump if all sectors are written. ; LXI H,SECCNT ;Get the current sector count MOV E,M ;in DE but we can just MVI D,00H ;put a 0 in D. LXI H,SECLST ;This points to the sector list MOV B,M ;Save the first sector # in B DAD D ;Calculate the current sector # MOV C,M ;and save in C. PUSH B ;Save start and current numbers. CALL SETSEC ;Set the current sector number. POP B ;Restore both numbers. ; MOV A,C ;The difference gives number of sectors SUB B ;into the current track. CALL MUL128 ;*128 gives the byte count. ; XCHG ;We now add this byte count LHLD POINTER ;to the base address in memory for the DAD D ;start of the current track. MOV B,H ;Put the base address for the current MOV C,L ;sector in BC and set CALL SETDMA ;the DMA address. ; XRA A ;Set a zero in the STA TRYCNT ;retry count variable ; RWTRY: LDA TRYCNT ;Check for too many errors. CPI 10 ;Now set for 10. JC DOIT ;Jump if OK ;Else there were too many LXI H,RWERR ;Get string address CALL PSTRING ;and print error message CALL CONIN ;Get a console character CPI cr ;If CR, ignore JNZ EXIT ;Else, exit now. ;Get here to ignore error CALL CRLF ;Respond with CR, LF. JMP RWSEC ;Bravely get next sector. ; ; Perform the read or write DOIT: INR A ;Increment retry count STA TRYCNT ;and save it. LDA RWFLAG ;Check for read or write ORA A JZ DOREAD ;Zero means read. ; CALL WRITE ;Non-zero means write. JMP NEXT ; DOREAD: CALL READ ; NEXT: ORA A ;Check for errors JZ RWSEC ;Jump on none. ; JMP RWTRY ;On error, retry. ; ; Come here after a whole track has been read/written. ; This routine calculates the next base address for ; new track and stores it. NEWBUF: LDA MXSEC ;Get the maximum sector count CALL MUL128 ;in bytes. XCHG ;Put it in DE LHLD POINTER ;Get previous base address DAD D ;Add the offset SHLD POINTER ;and update the poiner JMP RWTRK ; ; Not really much to do to finish up. FINISH: RET ; ; This is the actual start of the SYSGEN program code. ; First, the system will be placed in the memory buffer ; starting at 900H. Then, this buffer can be written ; to the system tracks of any recognized disk. There ; are three ways for this program to load memory: ; 1) To read the system tracks of a disk. ; 2) To read a file, usually CPMxx.COM. ; 3) To use the copy already in memory. BEGIN: LXI SP,STACK ;Set the stack LXI H,VERSION ;Sign on with the version number CALL PSTRING LDA dfcb + 1 ;Check for a command line parameter CPI ' ' ;and if none, JZ GET ;then jump. ; ; This code is not documented in any of the ; Dig. Res. manuals that I have seen. If the ; SYSGEN command is followed with a file name as ; ; A>SYSGEN CPM60.COM ; ; then that file is loaded into memory. This code ; thus replaces the step ; ; A>DDT CPM60.COM ; DDT VERS 2.2 ; NEXT PC ; 2300 0100 ; -^C ; A> ; ; when you want to sysgen a system different from ; that on the system tracks of your system disk. ; ; Note that if you save memory after loading the ; system, cold loader and CBIOS with DDT, more ; than the 34 pages as stated in the Alteration ; Guide may be required. For 29 sectors/track, ; this corresponds to 29+8=37 pages. ; LXI D,dfcb ;Get the FCB CALL OPEN ;and open the file. INR A ;Check for errors and JNZ FILE ;jump on none. ; LXI H,NOFILE ;Get string address CALL NLOUT ;and print error message. JMP EXIT ;Then exit. ; ; First, we have to skip over the junk sectors. FILE: XRA A ;Get a zero as STA dfcb+32 ;current record MVI C,010H ;Count of trash sectors to read. ; TRASH: PUSH B ;Save the count. LXI D,dfcb ;Get FCB in DE and CALL READSQ ;read into default buffer. POP B ;restore count. ORA A ;On error JNZ SRCERR ;Report it. ; DCR C ;Check count JNZ TRASH ;and loop till all read. ; LXI H,buffer ;Get start address of memory buffer. ; ; Fill the memory buffer from the disk file. FILLBUF: PUSH H ;Save buffer address MOV B,H ;Put it in BC MOV C,L CALL SETDMA ;and set DMA address LXI D,dfcb CALL READSQ ;Read next sector POP H ;Restore pointer ORA A ;Check for more data JNZ SAVE ;Jump if all file read. ; LXI D,80H ;Sector size DAD D ;Next address JMP FILLBUF ;Loop. ; ; Report error in sequential read. SRCERR: LXI H,SHORT ;Get string address CALL NLOUT ;Output the message JMP EXIT ;Exit ; ; Get the system from disk system tracks. GET: LXI H,SNAME ;Ask for source drive. CALL NLOUT CALL CONIN ;Wait for reply. CPI cr ;On CR, skip memory load JZ SAVE ;and jump to save routine ; SUI 'A' ;Get a valid designator CPI maxdsk ;Check maximum drive # JC DOGET ;Jump if OK ; CALL IVDERR ;Else, report error JMP GET ;and try again. ; ; Perform read of system tracks to memory DOGET: ADI 'A' ;Make ASCII again. STA SDRIVE ;Store in the string. SUI 'A' ;Now select the disk CALL SELDSK CALL CRLF ;Output a CR, LF LXI H,SON ;and prompt for action. CALL PSTRING CALL CONIN ;Get reply CPI cr ;Anything but CR exits JNZ EXIT ; CALL CRLF ;Give a CR, LF reply XRA A ;and set the flag for READ STA RWFLAG CALL RWSYS ;Read now. LXI H,ALLOK ;Report read complete. CALL PSTRING ;Fall through for write. ; ; This section writes memory buffer to disk. ; No matter how memory was loaded, once the ; program gets here, it can not load memory again. ; The system can be written as many times as desired. SAVE: LXI H,DNAME ;Prompt for distination CALL NLOUT ;drive name. CALL CONIN ;Wait for a reply. CPI cr ;Anything but CR exits. JZ EXIT ; SUI 'A' ;Form code. CPI maxdsk ;Check maximum drive count. JC DOSAVE ;If OK, do it, ;Else error. CALL IVDERR ;Report error message JMP SAVE ;and try again. ; ; Perform save of memory buffer to system tracks. DOSAVE: ADI 'A' ;Make ASCII again and STA DDRIVE ;store in string. SUI 'A' ;Back to a code CALL SELDSK ;and select the disk. LXI H,DON CALL NLOUT ;Prompt for reply CALL CONIN ;Wait for reply CPI cr ;Anything but CR will exit JNZ EXIT ; CALL CRLF ;Give a CR,LF response LXI H,RWFLAG ;Set R/W flag to non-zero MVI M,01H ;for write. CALL RWSYS ;DO IT NOW LXI H,ALLOK ;Report done. CALL PSTRING JMP SAVE ;Go get another disk to write. ; ; Exit routine EXIT: MVI A,00H ;Select disk A: CALL SELDSK CALL CRLF ;Output CR, LF JMP boot ;Do a warm boot ; ; Invalid drive error IVDERR: LXI H,BADNAM ;Get string address CALL NLOUT ;Print message RET ;and return. ; ; Strings and variables VERSION: DB 'SYSGEN29 V 2.0',0H SNAME: DB 'Source drive name (or return to skip)',0H SON: DB 'Source on ' SDRIVE: DB 0H DB ', then type return',0H DNAME: DB 'Destination drive name (or return to reboot)',0H DON: DB 'Destination on ' DDRIVE: DB 0H DB ', then type return',0H RWERR: DB 'Permanent error, type return to ignore',0H ALLOK: DB 'Function complete',0H BADNAM: DB 'Invalid drive name (Use A OR B) ',0H NOFILE: DB 'No system file on disk',0H SHORT: DB 'System file incomplete',0H,0H TRKCNT: DB 0H ;Current track count SECCNT: DB 0H ;Current sector count RWFLAG: DB 0H ;Indicates a read or write POINTER: DW 0H ;Points to address to read/write TRYCNT: DB 0H ;Retry count ; DS 32 STACK: END x   o&)))))))a{__> ̓> ̓͊~̓#ÚO****!*$*'! ">2!4:(wNͯ>2:)!4f!^!*FNͷyj*DMͿ2: K!͚u c͊<2:\_/:)j*"1!u͚:] \<œ!x͕c2|\ ¢! DMͿ\õ!͕c!͕u AnA2Aͦ͊!͚u c͊2!?͚!͕u cA7nA2Aͦ!͕u c͊!6!?͚>ͦ͊!Q͕SYSGEN29 V 2.0Source drive name (or return to skip)Source on , then type returnDestination drive name (or return to reboot)Destination on , then type returnPermanent error, type return to ignoreFunction completeInvalid drive name (Use A OR B) No system file on diskSystem file incomplete; ; C L O A D . A S M ; ; TARBELL CP/M COLDSTART DISK BASED LOADER. ; MODIFIED BY WILLIS E HOWARD, III (1982). ; ; 12/10/83 - READ CODE SHORTENED. WEH. ; ; THIS VERSION DOES NOT SET THE STACK ; SINCE IT IS LOADED FROM A ROM BASED ; SYSTEM WITH REENTRY ON ERROR AT ADDRESS ; 'SYSTEM', DEFINED BELOW. ; ; ERROR CODES ARE REPORTED ON THE CONSOLE IF ; THERE IS A READ ERROR, ELSE A POINT IS PRINTED. ; ; DEFINITIONS WHICH ARE SYSTEM DEPENDENT ; MSIZE EQU 60 ;MEMORY IN KB SIZE EQU MSIZE/33 ;>32K?=1 SPT EQU 29 ;SECTORS PER TRACK >>> UPDATED 1983 DISK EQU 0F8H ;DISK PORT BASE ADDRESS MMAP EQU 20H ;MEMORY MAP PORT SYSTEM EQU 0F803H ;ROM BRANCH ADDRESS ON ERROR CONOUT EQU 1 ;CONSOLE OUTPUT PORT CONST EQU 0 ;CONSOLE STATUS PORT ; ; FIXED DEFINITIONS ; DCOM EQU DISK ;COMMAND PORT DSTAT EQU DISK ;STATUS PORT TRACK EQU DISK+1 ;TRACK PORT SECT EQU DISK+2 ;SECTOR PORT DATA EQU DISK+3 ;DATA PORT WAIT EQU DISK+4 ;WAIT PORT DCONT EQU DISK+4 ;CONTROL PORT CBASE EQU (MSIZE-20)*1024 ;CPM BASE ABOVE 20K CPMB EQU CBASE+3400H ;START OF CP/M BOOTE EQU CPMB+1600H ;COLD BOOT ENTRY POINT NSECTS EQU SPT*2-1 ;SECTORS OF CP/M RTCNT EQU 10 ;RETRY COUNT ; ; BOOT ROUTINE ; ; INITIAL SETUP BOOT: ORG 0 ;START OF LOADER ; LXI SP,100H ;UNCOMMENT FOR TARBELL 82S123 ;NEXT TWO INSTRUCTIONS FOR ;BANK SELECT MVI A,SIZE ;0=KEEP ROM,1=ALL RAM OUT MMAP ;SET PORT ; MVI E,RTCNT ;GET RETRY COUNT ; ; RETRY ENTRY POINT HOME: MVI A,2 ;DRIVE HOME - STEP RATE TO A OUT DCOM ;(OPTIONAL) IN WAIT ;(SHOULD ALREADY BE THERE) LXI H,CPMB ;CP/M STARTS HERE MVI D,NSECTS ;NUMBER OF SECTORS TO READ MVI C,2 ;SECTOR NUMBER TO START ; ; READ NEW TRACK RNTRK: MVI B,4 ;FOR HEAD LOAD ; ; READ NEW SECTOR RNSEC: CALL READ ;READ FIRST SECTOR WITH CALL DCR D ;IF DONE, JZ SYSOK ;GOTO CP/M MVI B,0 ;SET FOR NO HEAD LOAD INR C ;NEXT SECTOR NUMBER MOV A,C ;FINISHED WITH CPI SPT+1 ;THIS TRACK? JC RNSEC ;IF NOT, READ NEXT SECTOR MVI A,52H ;STEP COMMAND IN A OUT DCOM ;ISSUE IT IN WAIT ;WAIT TILL DONE MVI C,1 ;INITIAL SECTOR NUMBER JMP RNTRK ;READ NEXT TRACK ; ; ROUTINE TO READ NEW SECTOR INTO MEMORY READ: MOV A,C ;GET SECTOR NUMBER OUT SECT ;SET SECTOR REGISTOR MVI A,88H ;COMMAND FOR READ ORA B ;GET HEAD LOAD BIT OUT DCOM ;ISSUE COMMAND IN WAIT RLOOP: IN DATA ;READ DATA MOV M,A ;PUT IN MEMORY INX H ;NEXT ADDRESS IN WAIT ;WAIT FOR DRQ ORA A ;SET FLAGS JM RLOOP ;LOOP TIL DONE ; ; CHECK FOR ERRORS CHECK: IN DSTAT ;READ STATUS ANI 9DH ;LOOK AT ERROR BITS RZ ;OK IF ZERO DCR E ;TRY AGAIN JNZ HOME ;IF NOT ZERO ; ; OUTPUT ERROR CODE ; MOV B,A ;SAVE ERROR CODE RRC ;GET HIGH NIBBLE RRC RRC RRC CALL DIGOUT ;PRINT IT DELAY: IN CONST ;WAIT FOR CONSOLE RAL ;OUTPUT READY JC DELAY ;FOR NEXT CHARACTER MOV A,B ;GET LOW NIBBLE CALL DIGOUT ;PRINT IT ; ; RETURN TO SYSTEM ; XRA A ;0=RESTORE ROM OUT MMAP ;DEFAULT BANK JMP SYSTEM ;GO BACK TO ROM MONITOR ; ; OUTPUT A DIGIT IN HEX FORMAT DIGOUT: ANI 0FH ;CLEAR HIGH NIBBLE ORI 30H ;ADD ON '0' CPI 3AH ;<10? JC OVR9 ;IF SO JUMP ADI 6 ;ELSE ADD 6 OVR9: OUT CONOUT RET ; ; EXIT TO CP/M ; ; REPLACE THE FOLLOWING CODE WITH ; "SYSOK EQU BOOTE" IF MORE SPACE IS NEEDED. ; THIS IS USEFUL FOR ERROR TRACING. SYSOK: MVI A,'.' ;POINT OUT = OK OUT CONOUT JMP BOOTE ;JUMP TO CP/M. ; ; UNIVERSAL ENTRY POINT ; THE 82S123 PROM JUMPS HERE ; ORG 7DH JMP BOOT ; ; END BOOT ;END OF DISK BOOT ; ; CBIOS.ASM ; ; Version D for 60K system. ; This version will NOT fit in 7 sectors. ; For use with 29 sector/system track disks only! ; ; CBIOS for CP/M 2.2 with IOBYTE vectoring ; for use with the Tarbell SD controller ; and dual disk drive secected for Pertec FD500. ; ; See Tarbell BIOS 2SBIOS24.ASM with "DUAL EQU TRUE". ; Modified by Willis E. Howard, III (1983). ; ; EQUATES ; TRUE EQU 0FFFFH FALSE EQU NOT TRUE ; MSIZE EQU 60 ;Menory size in kbytes IOBASE EQU 0 ;Base io address NDISK EQU 2 ;Number of logical disks HLAB EQU 0 ;8 for head load at seek STPRAT EQU 2 ;Rate 1=6ms, 2=10ms, 3=20 ms. ; DISK EQU 0F8H ;Disk base address DCOM EQU DISK ;Command port DSTAT EQU DISK ;Status port TRACK EQU DISK+1 ;Track port SECTP EQU DISK+2 ;Sector port DDATA EQU DISK+3 ;Data port WAIT EQU DISK+4 ;Wait port DCONT EQU DISK+4 ;Control port RTCNT EQU 10 ;Retry count ; IOBYTE EQU 3 ;Address of IOBYTE CBASE EQU (MSIZE-20)*1024 ;Bias for larger that 20K CPMB EQU CBASE+3400H ;Start of CPM 2.2 BDOS EQU CPMB+806H ;Start of BDOS BIOS EQU CPMB+1600H ;Start of CBIOS CDISK EQU 4 ;Current disk address NSECTS EQU 17 ;Number of sectors in CCP ;=44 with BDOS ; KBST EQU 0 ;KB status #1 KBDT EQU 1 ;KB data #1 TVST EQU 0 ;TV status #1 TVDT EQU 1 ;TV data #1 SERST EQU 12H ;Serial status SERDAT EQU 13H ;Serial data SERRDY EQU 9 ;Serial ready mask SERDAV EQU 10H ;Serial Data Avaliable CENTDT EQU 14H ;CENTRONICS Data port CENTST EQU 15H ;CENTRONICS Status port ; MSTAT EQU 10H ;Modem status MDATA EQU 11H ;Modem data MTBE EQU 9H ;Transmit mask MRDA EQU 10H ;Read mask ; TCTL EQU 53H ;Ports on cpu card T0 EQU 50H T1 EQU 51H T2 EQU 52H CONDTA EQU 56H CONCTL EQU 57H ; ; The following routines are in the BDOS ; Replace when more space is available. ; PMSGDL EQU BDOS+1CDH ;Print MSG until $ ; LDAX B ;Check for termination char. ; CPI '$' ; RZ ; INX B ; PUSH B ; MOV C,A ; CALL IOCNO ; POP B ; JMP PMSGDL ; JMPHLI EQU BDOS+344H ;Jump @(HL) ; MOV E,M ; INX H ; MOV D,M ; XCHG ; PCHL ; ADAHL EQU BDOS+55EH ;ADD A TO HL ; ADD L ; MOV L,A ; RNC ; INR H ; RET ; ; The following definitions are for the blocking routines. ; BLKSIZ EQU 2048 ;Group size HSTSIZ EQU 2432 ;Bytes/sector HSTSPT EQU 2 ;Sectors/track HSTBLK EQU HSTSIZ/128 ;Blocks/sector CPMSPT EQU HSTBLK*HSTSPT ;CPM blocks/track ; WRALL EQU 0 ;Write to allocated WRDIR EQU 1 ;Write to directory WRUAL EQU 2 ;Write to unallocated ; ; Note: WRUAL is not implemented. Since a single ; disk sector can contain more than one group, whether ; or not allocated, there MUST always be pre-reads. ; ; This version uses the IOBYTE. ; ; HIGH 2 BITS : PRINTER - not implemented ; ; NEXT 2 BITS : MODEM IN - not implemented ; ; NEXT 2 BITS : MODEM OUT - not implemented ; ; LOW 2 BITS : 00 KB/CRT #1 7 BIT ; (CONSOLE) 01 KB/CRT #2 ; 10 Serial Device ; 11 LINE - MODEM IN/MODEM OUT - 7 BIT ; ORG BIOS ;Start of BIOS ; ; BIOS JUMP TABLE ; JMP BOOT ;Come here after cold boot WBOOTE: JMP WBOOT ;Warm boot JMP IOCNS ;Vectored console status JMP IOCNI ;Vectored console in JMP IOCNO ;Vectored console out JMP LISTO ;Printer output JMP MODOUT ;Modem out JMP MODIN ;Modem in JMP HOME ;Home disk JMP SELDSK ;Select disk JMP SETTRK ;Set track JMP SETSEC ;Set sector JMP SETDMA ;Set DMA address JMP READ ;Read disk JMP WRITE ;Write disk JMP LISTST ;Printer status JMP SECTRN ;Sector translation ; ; DEFINE DISK PARAMETERS DPBASE: ;Base of parameter block DPE0: DW XLT0,0000H ;Translate table DW 0000H,0000H ;Scratch area DW DIRBUF,DPB0 ;Dir buff, parm block DW CSV0,ALV0 ;Check, alloc vectors ; DPE1: DW XLT1,0000H DW 0000H,0000H DW DIRBUF,DPB1 DW CSV1,ALV1 ; ; Large sector definitions DPE2: DW 0,0 DW 0,0 DW DIRBUF,DPB2 DW CSV2,ALV2 ; DPE3: DW 0,0 DW 0,0 DW DIRBUF,DPB3 DW CSV3,ALV3 ; ; DISK PHYSICAL DESCRIPTION ; Standard 8" SSSD DPB0: DPB1: DW 26 ;Sectors/track DB 3 ;Block shift DB 7 ;Block mask DB 0 ;Extnt mask DW 243-1 ;Disk size -1 DW 64-1 ;Directory max DB 11000000B ;Alloc0 DB 00000000B ;Alloc1 DW 16 ;Check size DW 2 ;Number of sys tracks ; ; Modified 8" SSSD w/ 2432 bytes/sector and 2 sectors/track DPB2: DPB3: DW 38 ;Logical sectors/track DB 4 ;BLS=2048 DB 15 DB 1 ;EXM DW 178-1 ;DSM DW 64-1 ;Directory DB 10000000B ;Alloc DB 00000000B DW 16 ;Check size DW 2 ;System track count ; ; Standard sector translation table XLT0: XLT1: DB 1, 7,13,19,25 DB 5,11,17,23, 3 DB 9,15,21, 2, 8 DB 14,20,26, 6,12 DB 18,24, 4,10,16,22 ; ; COME HERE FROM COLD BOOT (BURRR) ; BOOT: LXI SP,80H ;Set stack EI ; ; INITIALIZE I/O ; MVI A,36H ;Set console baud rate OUT TCTL MVI A,13 OUT T0 XRA A OUT T0 MVI A,7AH OUT CONCTL MVI A,37H OUT CONCTL IN KBDT ;Clear console status IN MDATA ;Clear modem status MVI A,0FFH ;Set Strobe line high OUT CENTST ;For printer ; ; INITIALIZE RAM ; XRA A ;Scratch area STA IOBYTE ;Clear I/O byte MVI C,ENDZ-STARTZ ;Zero memory variables LXI H,STARTZ ZERO: MOV M,A ;A=0 here DCR C INX H JNZ ZERO STA CDISK ;Disk A: for default LXI H,SMSG ;Sign on message CALL PMSG ;Tell 'em I'm OK. ; ; SETUP JUMPS TO CP/M SETUP: MVI A,0FFH ;Auto disk type select on boot STA BSET ;Deselect B: XRA A ;Select disk A: DI CALL SETLNG ;Get sector length EI STA DISKA MVI A,0C3H ;JMP code STA 0 LXI H,WBOOTE ;To WBOOT SHLD 1 ;At 0,1,2 STA 5 ;JMP code LXI H,BDOS ;To BDOS SHLD 6 ;At 5,6,7 LXI H,80H ;Set DMA address SHLD DMAADD LDA CDISK ;Get disk number MOV C,A ;In C JMP CPMB ;And jump to CCP ; ; COME HERE FOR WARM BOOT ; AND ON TO THE TROPICS ! WBOOT: LXI SP,80H ;Set stack ; XRA A ;Just set as not active. STA HSTACT ;No flush here means you MUST STA BLOCK ;close files properly. EI ;Enable interupts XRA A ;Select disk A: for CCP load. MOV C,A ;CDISK not used since my disk B: CALL SELDSK ;often has a different memory size CCP. CALL HOME ;ET MVI B,NSECTS ;# sectors for CCP MVI C,2 ;Track=0, Sector=2 starts it. DI ;Disable interupts LXI H,CPMB ;Starting address RBLK1: SHLD DMAADD ;Set it CALL SETSEC ;Start reading CALL READS ;CODE WORKS ONLY FOR CCP LOAD <<------< ;w/ 26 or 29 sectors on track 0 JNZ BTERR ;Report errors INR C ;Next sector DCR B ;Last sector? JNZ RBLK1 ;Loop til last XRA A STA CPMB+7 ;Clear default command EI ;Enable interupts JMP SETUP ;Set up jumps ; BTERR: LXI H,BTMSG ;Boor error message CALL ERRMSG ;Print it CALL IOCNI ;Wait for reply JMP WBOOT ;Another warm boot ; ; JUMP TABLES FOR IOBYTE DISPATCH ROUTINES ; ; CONSOLE STATUS CNS: DW CN1ST ;Console #1 DW CN2ST ;Console #2 DW SERSTAT ;Serial Device DW MODST ;Modem ; ; CONSOLE INPUT CNI: DW CN1IN DW CN2IN DW SERIN DW MODIN ; ; CONSOLE OUTPUT CNO: DW CN1OUT DW CN2OUT DW SEROUT DW MODOUT ; ; DISPATCH BASED ON THE IOBYTE ; ; CONSOLE STATUS IOCNS: LXI H,CNS ;Table start address IOCON: LDA IOBYTE ;Get IOBYTE ANI 3 ;Console bits ADD A ;Double for offset ; ; Dispatcher DISPCH: CALL ADAHL ;Add A to HL ;Buffered printer check here JMP JMPHLI ;Jump to HL indirectly ; ; CONSOLE INPUT IOCNI: LXI H,CNI ;Table start address JMP IOCON ;Jump to it ; ; CONSOLE OUTPUT IOCNO: LXI H,CNO ;Table start address JMP IOCON ;Do it ; ; DEVICE I/O ROUTINES ; ; CONSOLE #1 ; ; CHECK CONSOLE CHARACTER READY STATUS CN1ST: IN KBST RAR ;Test status bit JNC DEVRDY XRA A ;If set, return 0 RET DEVRDY: ORI 0FFH ;Else -1 (ready) RET ; ; CONSOLE IN - 7 BIT ( TO A ) CN1IN: IN KBST ;Loop til ready RAR JC CN1IN IN KBDT ;Get data ANI 7FH ;Less parity RET ;Just hope it's OK! ; ; CONSOLE OUTPUT ( FROM C ) CN1OUT: IN CONCTL ANI 1 JZ CN1OUT MOV A,C OUT CONDTA RET ; ; CONSOLE #2 (Only one KB now) ; ; CHECK CONSOLE CHARACTER READY CN2ST: JMP CN1ST ; ; CONSOLE INPUT CN2IN: JMP CN1IN ; ; CONSOLE OUTPUT CN2OUT: IN TVST RAL JC CN2OUT MOV A,C OUT TVDT RET ; ; Serial Device SERSTAT: IN SERST ANI 10H JNZ DEVRDY XRA A RET ; SERIN: CALL SERSTAT ORA A JZ SERIN IN SERDAT RET ; SEROUT: IN SERST ANI SERRDY CPI SERRDY JNZ SEROUT MOV A,C OUT SERDAT RET ; ; LINE PRINTER ; ; PRINTER STATUS LISTST: IN CENTST ;Check status ANI 1 ;Set means busy DCR A ;Zero=busy RET ; ; PRINTER OUTPUT LISTO: CALL LISTST ;Get ready status JZ LISTO ;Loop until ready MOV A,C ;then put C in A OUT CENTDT ;Output data XRA A ;Strobe OUT CENTST MVI A,1 OUT CENTST MOV A,C ;Restore A RET ; ; MODEM ROUTINES ; ; MODEM STATUS : Used in IOBYTE vectoring MODST: IN MSTAT ;Get modem status ANI MRDA ;Mask out other bits JNZ MODST2 ;NZ = DAV XRA A ;0 = NOT Ready RET MODST2: ORI 0FFH ;-1 = Ready RET ; ; MODEM INPUT MODIN: IN MSTAT ;Get modem status ANI MRDA ;Check if ready JZ MODIN ;Loop til ready IN MDATA ;Get byte RET ;KEEP PARITY ; ; MODEM OUTPUT MODOUT: IN MSTAT ;Get modem status ANI MTBE ;Loop til empty CPI MTBE JNZ MODOUT MOV A,C ;Get the byte OUT MDATA ;Send parity RET ; ; ; DISK I/O ROUTINES ; ; SELECT DISK DRIVE AS GIVEN BY C SELDSK: LXI H,0 ;Setup for error MOV A,C ;New drive code CPI NDISK ;Too large? RNC ;If so, return ORA A ;Check for A: JZ AOK ;Jump if A: LDA BSET ;Check for B: set ORA A JZ BOK ;Jump if B: already set XRA A ;It will be set now STA BSET INR A ;Valid until ^C DI CALL SETLNG ;Read B: sector length EI INR A ;Add B: offset STA DISKB ;Save result BOK: LDA DISKB ;Get real B: (sized) MOV L,A MVI H,0 JMP SELOK AOK: LDA DISKA ;Get real A: (sized) MOV L,A SELOK: STA SEKDSK ;Save selected disk ; ; SELECT DRIVE AS A FUNCTION OF HL ; LXI D,DPBASE ;Disk parameter base DAD H ;*16 DAD H DAD H DAD H DAD D ;Compute index XRA A ;Set A=0 RET ;Return ; ; MOVE DISK TO TRACK 0 HOME: LDA HSTWRT ;Long misunderstood, ORA A ;this code prepares JNZ HOMED ;for the directory STA HSTACT ;read command. HOMED: MVI C,0 ;Set track 0 ; ; ; SET DISK TRACK BY C SETTRK: MVI H,0 MOV L,C SHLD SEKTRK ;Set track RET ; ; SET DISK SECTOR NUMBER SETSEC: MOV A,C ;Save sector number STA SEKSEC RET ; ; TRANSLATE SECTOR SECTRN: MOV H,B ;Logical sector in HL MOV L,C MOV A,D ;If zero XLT, no translation ORA E RZ DAD D ;Otherwise, translate MOV L,M MVI H,0 ;Single byte only RET ; ; SET DMA ADDRESS SETDMA: MOV H,B ;Move BC to HL MOV L,C SHLD DMAADD ;Save address RET ; ; Read disk. ; READ: XRA A STA BLOCK ;Clear BLOCK I/O flag LDA SEKTRK CPI 2 ;Check for system track JM SYSREAD ;Jump if 0 or 1 LDA SEKDSK ANI 2 ;Check for large sectors JNZ READB ;Read blocked sector SYSREAD: CALL FLUSH ;No active writes ; ; Read standard disk READS: MVI A,RTCNT ;Get retry count RRETRY: CALL DSKSET ;Setup disk ADI 80H ;Add code for read READE: OUT DCOM ;Send command IN WAIT ;Wait for DRQ RLOOP: IN DDATA ;Get a byte MOV M,A ;Save it INX H ;Next address IN WAIT ;Wait for DRQ or INTRQ ORA A ;Test for more JM RLOOP ;Jump for more RDDONE: IN DSTAT ;Disk status EI ANI 9DH ;Error bits RZ ;RET if none STA ERRS ;w/ HL = next address CALL ERCHK ;Check for seek error JNZ RRETRY ;Try again LXI H,RDMSG ;Report error JMP ERRMSG ; ; Read blocked sector READB: MVI A,1 STA READOP ;read operation MVI A,WRUAL STA WRTYPE ;treat as unalloc JMP RWOPER ;Do it. ; ; Write disk. ; WRITE: XRA A STA BLOCK ;Clear BLOCK I/O flag LDA SEKTRK CPI 2 ;Check for system tracks JM SYSWRT LDA SEKDSK ;Check sector length ANI 2 JNZ WRITEB ;Buffered sector format SYSWRT: CALL FLUSH ;No active writes ; ; Write standard format disk WRITES: MVI A,RTCNT ;Retry count WRETRY: CALL DSKSET ;Setup disk ADI 0A0H ;Write code WRITE2: OUT DCOM ;To 1771 IN WAIT ;Wait for DRQ WLOOP: MOV A,M ;Get byte OUT DDATA ;To 1771 INX H ;Next address IN WAIT ;Wait for DRQ or INTRQ ORA A ;Test for more JM WLOOP ;Jump on more WDONE: IN DSTAT ;Status EI ANI 0FDH ;Error bits RZ ;Return if none STA ERRS ;Store it CALL ERCHK ;Check for seek error JNZ WRETRY ;Try again LXI H,WMSG ;Write error JMP ERRMSG ;Report ; ; Write blocked code WRITEB: XRA A ;0 to accumulator STA READOP ;not a read operation MOV A,C ;write type in c STA WRTYPE ; ; enter here to perform the read/write RWOPER: XRA A ;zero to accum STA ERFLAG ;no errors (yet) LDA SEKSEC ;compute host sector CPI 19 ;/19 NEW CODE MVI A,1 JM RW4 INR A RW4: STA SEKHST ;host sector to seek ; ; active host sector? ; LXI H,HSTACT ;host active flag MOV A,M MVI M,1 ;always becomes 1 ORA A ;was it already? JZ FILHST ;fill host if not ; ; host buffer active, same as seek buffer? ; LDA SEKDSK LXI H,HSTDSK ;same disk? CMP M ;sekdsk = hstdsk? JNZ NOMATCH ; ; same disk, same track? ; LXI H,HSTTRK CALL SEKTRKCMP ;sektrk = hsttrk? JNZ NOMATCH ; ; same disk, same track, same buffer? ; LDA SEKHST LXI H,HSTSEC ;sekhst = hstsec? CMP M JZ MATCH ;skip if match ; ; proper disk, but not correct sector NOMATCH: LDA HSTWRT ;host written? ORA A CNZ WRITEHST ;clear host buff ; ; may have to fill the host buffer FILHST: LDA SEKDSK STA HSTDSK LHLD SEKTRK SHLD HSTTRK LDA SEKHST STA HSTSEC CALL READHST XRA A ;0 to accum STA HSTWRT ;no pending write ; ; copy data to or from buffer MATCH: LDA SEKSEC ;mask buffer number CPI 19 ;mod 19 NEW CODE JM MAT3 SBI 19 MAT3: MOV L,A ;ready to multiply MVI H,0 DAD H ;*128 DAD H DAD H DAD H DAD H DAD H DAD H ; ; hl has relative host buffer address ; LXI D,HSTBUF DAD D ;hl = host address XCHG ;now in DE LHLD DMAADD ;get/put CP/M data MVI C,128 ;length of move LDA READOP ;which way? ORA A JNZ RWMOVE ;skip if read ; ; write operation, mark and switch direction ; MVI A,1 STA HSTWRT ;hstwrt = 1 XCHG ;source/dest swap ; ; C initially 128, DE is source, HL is dest RWMOVE: LDAX D ;source character INX D MOV M,A ;to dest INX H DCR C ;loop 128 times JNZ RWMOVE ; ; data has been moved to/from host buffer ; LDA WRTYPE ;write type CPI WRDIR ;to directory? LDA ERFLAG ;in case of errors RNZ ;no further processing ; ; clear host buffer for directory write ; ORA A ;errors? RNZ ;skip if so XRA A ;0 to accum STA HSTWRT ;buffer written CALL WRITEHST LDA ERFLAG RET ; ; compare with sektrk SEKTRKCMP: LDA SEKTRK ;NEW CODE CMP M ;same? RET ; ; Block read and write ; ; Flush the buffer FLUSH: LDA HSTACT ;Must be active ORA A RZ LDA HSTWRT ORA A CNZ WRITEHST ;Write if not written XRA A STA HSTWRT ;Clear flag in any case RET ; ; hstdsk = host disk #, hsttrk = host track #, ; hstsec = host sect #. write "hstsiz" bytes ; from hstbuf and return error flag in erflag. ; return erflag non-zero if error WRITEHST: MVI A,1 STA BLOCK ;Set BLOCK CALL WRITES JMP NOBLOCK ; ; hstdsk = host disk #, hsttrk = host track #, ; hstsec = host sect #. read "hstsiz" bytes ; into hstbuf and return error flag in erflag. READHST: MVI A,1 ;Set BLOCK STA BLOCK CALL READS NOBLOCK: ;Change no registers or flags PUSH H LXI H,BLOCK ;Clear BLOCK MVI M,0 POP H RET ; ; DISK SETUP ROUTINE COMMON TO READ ; AND WRITE ROUTINES DSKSET: STA ERCNT ;Save error counter MVI A,0D0H ;Terminate OUT DCOM ;Current command LDA BLOCK ORA A JZ SEKSET ;Direct sector ; LDA HSTDSK ;Get disk CALL SDISK LDA HSTTRK ;Get track CALL SEEK DI LXI H,HSTBUF ;Buffer LDA HSTSEC ;Get sector OUT SECTP JMP HDLD ; SEKSET: LDA SEKDSK CALL SDISK ;Select physical disk LDA SEKTRK ;Get track CALL SEEK ;Find it DI LHLD DMAADD ;Get address LDA SEKSEC ;Get sector # OUT SECTP ;To 1771 ; ; HDLD - GET HEAD LOAD BIT IF REQUIRED HDLD: LDA HLSF ;Get flag ORA A ;Is it 0? JZ HDLD1 ;Jump on zero CMA ;Set A=0 STA HLSF ;Set flag=0 if not ; ; IF CHANGING TO A NEW DRIVE, PERFORM A SEEK ; TO THE SAME TRACK TO ALLOW THE HEAD TO UNLOAD ; IN TRACK ;Get track OUT DDATA ;Tell 1771 MVI A,14H+STPRAT+HLAB ;Get step rate OUT DCOM ;Send it IN WAIT ;Wait for INTRQ HDLDY: CALL HDLD2 ;IBM format? ORI 4 ;Set bit to load head RET ;And return HDLD1: IN DSTAT ;Read status ANI 20H ;Test HL bit JZ HDLDY ;Load if not loaded HDLD2: LDA BLOCK ;Block type? ORA A ;Set up "b" flag MVI A,8 ;Ready for yes RZ XRA A ;Else, not blocked RET ; ; Select the Physical disk SDISK: ANI 1 ;Only 2 physical disks CMA ;Bits inverted into latch ADD A ;Bits 1&2 in 4&5 ADD A ADD A ADD A ORI 2 ;Make latch command STA LATCH ;Save it PUSH H LHLD LATCH ;Get new and old latch MOV A,L ;Get new latch OUT DCONT ;Select drive now STA CLATCH ;Remember it CMP H ;Same as old? MVI A,0FFH ;If not flag=FF JNZ SFLAG CMA ;If new=old, flag=0 SFLAG: STA HLSF ;Set head load select flag POP H RET ; ; SEEK - MOVE THE HEAD TO THE TRACK IN A SEEK: PUSH B ;Save BC MOV B,A ;Save new track CALL RDYCHK ;Disk ready MVI A,RTCNT ;Retry count SRETRY: STA SERCNT ;Remaining seek retries IN TRACK ;Read old track number CMP B ;Same as new? JNZ NOTHR ;Jump if not there THERE: POP B ;Restore BC RET ;End seek ; ; THIS ROUTINE ALLOWS THE DISK TO FINISH ; THE TUNNEL ERASE BEFORE MOVING THE HEAD. ; CA. 700 MICRO-SEC FOR 4MHZ AND DOUBLE ; FOR 2 MHZ NOTHR: MVI A,0D0H ;208 for 2 MHz BUSY1: DCR A ;Loop till done JNZ BUSY1 MOV A,B ;Restore A from B OUT DDATA ;Track to data reg MVI A,14H+STPRAT+HLAB ;Step rate OUT DCOM ;Set now IN WAIT ;Wait for INTRQ IN DSTAT ;Get status ANI 91H ;Look at bits JZ THERE ;OK if zero STA ERRS ;Save code LDA SERCNT ;Error count DCR A ;-1 JNZ SRETRY ;Retry seek LXI H,SKMSG ;Report error CALL ERRMSG CALL IOCNI ;Reply CPI 03 ;^C? JZ WBOOT ;If so,boot MOV A,B ;Restore A POP B ;Restore BC JMP SEEK ;Retry ; ; CHECK FOR DISK READY RDYCHK: LXI H,054EBH ;0.5 sec wait RDYCNT: IN DSTAT ;Ready? STA ERRS RLC RNC ;Return if ready DCX H MOV A,L ORA H JNZ RDYCNT ;Loop for .5 sec LXI H,DNRMSG ;Output msg CALL ERRMSG CALL IOCNI ;Reply JMP RDYCHK ;Loop ; ; ERCHK - CHECK FOR RECORD NOT FOUND ERCHK: ANI 10H ;If record not found JZ CHKOK ;Do a seek check CHKSK: ;Check for correct track MVI A,0C4H ;Command to 1771 OUT DCOM ;To read address IN WAIT ;Wait for DRQ or INTRQ IN DDATA ;Read address of prev. track MOV B,A ;Save in B CHKS2: IN WAIT ;Wait for INTRQ ORA A ;Check flags JP CHKS3 ;Finished with read address IN DDATA ;Read another byte JMP CHKS2 ;Loop CHKS3: IN DSTAT ;Get status ORA A ;Set flags JZ CHKS4 ;Jump if read addr. OK MVI A,0D0H ;Home disk now OUT DCOM ;Kill current command CALL RDYCHK ;Disk must be ready CHOME: IN DSTAT ;and not busy RRC JC CHOME MVI A,STPRAT ;Home command OUT DCOM IN WAIT ;Wait for execution IN DSTAT JMP CHKS5 CHKS4: MOV A,B ;Get track OUT TRACK ;To disk CHKS5: LDA BLOCK ;Which track? ORA A LDA SEKTRK ;Get standard track JZ CHKS6 LDA HSTTRK ;Get host track CHKS6: CALL SEEK ;Find it CHKOK: LDA ERCNT ;Count down errors DCR A RET ; ; Select disk in A, return 0 if zero sector length ; or 2 if non-zero sector length. SETLNG: CALL SDISK ;Select the disk MVI A,2 ;Third track CALL SEEK SET2: MVI E,RTCNT*2 SET5: MVI A,0C4H ;Read address OUT DCOM IN WAIT IN DDATA ;Track IN WAIT IN DDATA ;Zero IN WAIT IN DDATA ;Sector address IN WAIT IN DDATA ;Sector length MOV B,A ;Save it IN WAIT SET10: IN DDATA ;Remaining bytes IN WAIT ORA A ;Wait for INTRQ JM SET10 IN DSTAT ;Check status ANI 0FDH ;Error bits JZ SET20 ;Jump on no error DCR E ;Retry JNZ SET5 ;if not out of count STA ERRS ;Save error code LXI H,SLMSG ;Error message CALL ERRMSG ;Report error CALL IOCNI ;Require reply CPI 03 ;If ^C JZ WBOOT ;then warm boot JMP SET2 ;Else retry SET20: MOV A,B ORA A ;Return 0 on zero RZ MVI A,2 ;Return 2 on non-zero RET ; ; ERROR REPORTING SUBROUTINE ERRMSG: CALL PMSG ;Print message LXI H,EONMSG ;Drive # out CALL PMSG LDA ERRS ;Get error code CALL LNTA ;High NIB to ASCII STA ERRNUM ;Save ASCII LDA ERRS ;Code again STA ERFLAG CALL RNTA ;Low NIB to ASCII STA ERRNUM+1 ;Save it LXI H,ERRNUM ;Address of string CALL PMSG ;Output error code MVI A,1 ;Error code RET ; ; TRANSLATE NIBBLES TO ASCII LNTA: RAR ;First left nibble RAR RAR RAR RNTA: ANI 0FH ;Now right nibble ADI '0' ;Make a number CPI '9'+1 ;Low enough? RC ;No, over 9 ADI 6 ;Add HEX offset RET ;We're finished now ; ; PRINT MESSAGE AT HL UNTIL $ PMSG: PUSH B ;Save BC MOV B,H MOV C,L CALL PMSGDL ;Output string POP B ;Restore BC RET ;Return ; ; CBIOS MESSAGES ; SMSG: DB 0DH,0AH,0AH DB MSIZE/10+'0',MSIZE MOD 10 + '0' DB 'K CP/M 2.2 of 12/12/83',0DH,0AH DB 'CBIOS by W. E. Howard, III',0DH,0AH CRLF: DB 0DH,0AH,'$' DNRMSG: DB 0DH,0AH,'Ready$' ;Reply/retry BTMSG: DB 0DH,0AH,'Boot$' ;Reply/no boot SKMSG: DB 0DH,0AH,'Seek$' ;Reply/with boot RDMSG: DB 0DH,0AH,'Read$' ;No reply/error in A WMSG: DB 0DH,0AH,'Write$' ;No reply/error in A SLMSG: DB 0DH,0AH,'Read Adr.$' ;Reply/with boot EONMSG: DB ' Error $' ERRNUM: DB '00H$' ; ; Variables ; ; For a 29 system sector/track disk, the ; last address before this point ; should be no larger that ADDRESS + 067FH since ; there will be 13 sectors available for the CBIOS. ; ; AN ERROR MESSAGE WILL RESULT IF TOO LARGE. ; WHERE SET BIOS+680H-$ ;Set for 29 sectors/track IF WHERE/8000H DW BIOS, TOO, LONG ENDIF ; ; ; Zeroed variables STARTZ: ; HLSF: DS 1 ;Head load select DISKA: DS 1 ;Disk A indirect DISKB: DS 1 ;Disk B indirect BSET: DS 1 ;Disk B defined? BLOCK: DS 1 ;Blocked disk? ; SEKDSK: DS 1 ;Seek disk number SEKTRK: DS 2 ;Seek track number SEKSEC: DS 1 ;Seek sector number ; HSTDSK: DS 1 ;Host disk number HSTTRK: DS 2 ;Host track number HSTSEC: DS 1 ;Host sector number ; SEKHST: DS 1 ;Seek host in sector buffer HSTACT: DS 1 ;Host active flag HSTWRT: DS 1 ;Host written flag ; ERFLAG: DS 1 ;Error reporting flag READOP: DS 1 ;Set to 1 for a read WRTYPE: DS 1 ;Write operation type DMAADD: DS 2 ;DMA ADDRESS ; ENDZ: ; ; Other variables and tables ; ERCNT: DS 1 ;Error count SERCNT: DS 1 ;Seek retry count ERRS: DS 1 ;Error map LATCH: DS 1 ;New LATCH code CLATCH: DS 1 ;Current LATCH code BEGDAT EQU $ ; ; ; Parameter storage ALV0: ALV2: DS 31 ;Allocation area CSV0: CSV2: DS 16 ALV1: ALV3: DS 31 CSV1: CSV3: DS 16 ; DIRBUF: DS 128 ;Directory buffer ; HSTBUF: DS HSTSIZ ;Host buffer ; ENDDAT EQU $ DATSIZ EQU $-BEGDAT ;Disk parameter storage ; ; END ; ; S G E N P A T . A S M ; ; Patch to SYSGEN to allow booting from system ; tracks formatted as 29 sectors each. ; ; Written by Willis E. Howard, III (1983). ; ; Define the origin for the patch ; ORG 0128H ; ; Total number of system tracks to read/write TRACKS: DB 2H ; ; Total number of sectors per system track ; Standard value is 26. Now set for 29 to ; get extended CBIOS. MXSEC: DB 1DH ; ; This is a list of the sectors, from 1 to MXSEC. ; The ordering should reflect the desired skew for ; your system. Now set for two. There is no real ; conversion of logical to physical sectors. This ; table just gives the ORDER in which sectors are ; read and written. Unused table space zero filled. SECLST: DB 1H,3H,5H,7H,9H,0BH,0DH,0FH,11H,13H,15H,17H,19H,1BH,1DH DB 2H,4H,6H,8H,0AH,0CH,0EH,10H,12H,14H,16H,18H,1AH,1CH DB 0H,0H,0H,0H,0H,0H,0H,0H,0H,0H,0H,0H,0H DB 0H,0H,0H,0H,0H,0H,0H,0H,0H,0H,0H,0H,0H DB 0H,0H,0H,0H,0H,0H,0H,0H,0H END ; ; M C P M P A T . A S M ; ; Patch for MOVCPM to eliminate ; the directory write bug in V2.2 ; ORG 1CD2H NOP NOP LXI H,0 END :10012800021D01030507090B0D0F11131517191BE4 :100138001D020406080A0C0E10121416181A1C00C8 :1001480000000000000000000000000000000000A7 :100158000000000000000000000000000000000097 :02016800000095 :0000000000 :051CD2000000210000EC :0000000000  The following programs are submitted to SIG/M: 1) FORMAT.MAC and FORMAT.COM - Formatting programs for the 1771, especially with the Tarbell SD disk controller. This formatting program allows generation of disk formats which have 2, 26 or 29 sectors per track. These formats are useful with the extended SD storage technique as discussed by Bob Lurie in Microsystems (1983). 2) SYSGEN29.ASM and SYSGEN29.COM - Fully commented CP/M sysgen program modified to allow a sysgen from and to non-standard system tracks with 29 sectors/track. 3) SGENPAT.ASM and SGENPAT.HEX - Patch code to convert the standard SYSGEN.COM to SYSGEN29.COM by modification of the necessary pointers and counter. 4) MCPMPAT.ASM and MCPMPAT.HEX - Patch routine to correct a bug in MOVCPM involving the blocking/deblocking algorithm when making directory accesses. 5) CLOAD60.ASM - Modified Tarbell Cold Loader which will boot from system tracks formatted as 29 sectors/track. 6) CBIOS60D.ASM - My personal CBIOS for a 60K CP/M V2.2 system which implements the Bob Lurie technique of 29 sectors/system track and 2 sectors/data track with 2432 bytes per sector. Hardware dependent; for use with the Tarbell SD disk controller and Pertec FD500 8"SSSD dis drives. These programs supplement the article on "Extended Single Densit Formatting" by Willis E. Howard, III which has been submitted to Microsystems. The article should appear in early 1984 and those interested in the use of these programs ar urge t rea it. In essence, this technique, as implemented by the accompanying programs, allows users of the 1771 single density disk controller to double the size of their CBIOS and to increase the available data space by 50% without any hardware modifications.