TITLE Columbia M64/Conkey-64 Rochester Modified BIOS ;CNKYOSnn.Z80 ;official filename REV EQU 22 ;same as nn above, REV= revision x 10 ;------------------------------------------------------------------ ; Search for '< COND >' without spaces to quickly get to the ; conditional assembly defines. ;------------------------------------------------------------------ ; Future plans: ; - More RAM support ;------------------------------------------------------------------ ; Revision history: (change equate above) ; ; 06 Dec 87, rev 2.2 Added Autostart code. Fixed TPA calc for ; Jim Lill Boot Msg. Added better explanation of IOBYTE ; options (from Paul Sittler's PROBE) ; ; 08 MAY 87, rev 2.1 Fixed disk error message. Also note that ; D Brown Z80ASM is now the only assembler that will work. ; ; 16 APR 87, rev 2.0 Extended skew tables to 80 bytes each, and ; D Brown added boot message, if the assembler is Z80ASM. ; Also relocated code if assembler is Z80ASM. ; 23 FEB 87, rev 1.7 Added initialization of software baud rate ; D Brown ; ; 18 Feb 87, rev 1.6 Added routine to conditionally print the drive ; D Brown formats on warm or cold boot. ; ; 09 Feb 87, rev 1.5 New SETNS and HSTPHY routines allow selection from ; D Brown a wide range of DSDD formats. ; ; 08 Feb 87, rev 1.4 Added additional address displays. Changed DSBOOT ; Jim Lill equate to NATFRMT, adding table and Foreign format. Corrected ; "Mount Disk" code so that CON is properly serviced when running ; BYE (Sass mod). Changed numerous JP to JR ; ; 06 Feb 87, rev 1.3 Added PRTVAL routine for convenience in implementing ; Brown/Lill ZCPR3 and locating variable addresses. ; ; 03 Feb 87, rev 1.2 No changes, simply reformatted revision history ; J. Lill putting latest at beginning of list etc. ; ; 01 Feb 87, rev 1.1 Interrupt code is now somewhat relocatable ; D. Brown ; ; 14 Jan 87, rev 1.0 Supports Conkey double-sided only. Supports two drives ; D. Brown correctly now. ; ; 13 Dec 86 Added 2nd DPB, data inversion support. ; D. Brown ; ; 05 Dec 86 Added conditional code so that any flavor of the BIOS can ; D. Brown be generated from the same file. ; ; 30 Oct 86 Added support for 2 physical drives. (remainder deleted 2/8) ; S. Schrier ; ; 26 Oct 86 Added interrupts to console receive routines, to create a type ; S. Schrier ahead buffer. The size of the buffer is determined by equate ; RXASIZ. This mod requires a jumper at the interrupt socket U1. ; Connect pins 7 and 10, or use a dip switch with all positions ; open except switch 7. I also added priority symbols, and an ; equate table to make it easier to add new interrupt routines ; without having to mess with the vectortable. See vector ; table code for details. ; I also altered the IOBYTE initialization so that the punch and ; reader work without having to reassign using STAT. The printer ; is still disabled, but may be activated with STAT (LST:=LPT:). ; The IOBYTE is initialized to the IOBVAL equate. ; ;--------------------------------------------------------------------------- .Z80 ; Misc. Equates: FALSE EQU 0 TRUE EQU NOT FALSE NULL EQU 00H CR EQU 0DH LF EQU 0AH BEL EQU 07H HT EQU 09H FFEED EQU 0CH ; Conditional Assembly Constants: RXASIZ EQU 20H ; Make type ahead buffer 32 characters. LSTNUL EQU FALSE ; Output NULLs to modem list device INTCON EQU FALSE ; Use interrupts for console ONEDRV EQU FALSE ; Single-drive system SOFTBD EQU FALSE ; Software baud rate BAUD EQU 5768H ; This means 1200 baud to the CTC AUTOST EQU FALSE ; for AutoStart ;---------------------------------------------------------------------- IOBVAL EQU 10101000B ; Initial IOBYTE value. .COMMENT $ Explanation of IOBYTE LST: is currently 02 hex or [10 ] binary, or LPT: PUN: is currently 01 hex or [ 10 ] binary, or UP1: RDR: is currently 01 hex or [ 10 ] binary, or UR1: CON: is currently 01 hex or [ 00] binary, or TTY: ----------- where, for the following devices: Device LST: PUN: RDR: CON: ---------------------------------- 00 assigns TTY: TTY: TTY: TTY: 01 assigns CRT: PTP: PTR: CRT: 10 assigns LPT: UP1: UR1: BAT: 11 assigns UL1: UP2: UR2: UC1: $ ;----------------------------------------------------------------------- TELFMT EQU 3 ; Write A: and B: formats when booting: ; 0 = Do not write formats ; 1 = Write formats when non-Conkey ; 2 = Write formats when different from ; the cold-boot formats ; 3 = Write formats unconditionally ;----------------------------------------------------------------------- NATFRMT EQU 2 ; Native Format | EQU | MACRO ;---------------+-----+----------------- ; Conkey SSDD | 1 | CONKSS ; Conkey DSDD | 2 | CONKDS ; Foreign | 3 | FOREGN ;---------------+-----+----------------- ;----------------------------------------------------------------------- WARMBT EQU FALSE ; warm boot reads the system from the device ; whose number is stored in the low ram ; address WARMDV ZCPR3 EQU FALSE ; leaves room for 4K of segments above ; BIOS ;-------------------------------------------------------- ; PRTVAL MACRO prints text and a value ; PRTVAL MACRO MSG,N .PRINTX MSG N ENDM ;-------------------------------------------------------- .XLIST SUBTTL CONKEY-64 EQUATES .LIST PAGE ; I/O PORT ADDRESSES (for reference only) U10 EQU 50H ;8255 (U10) BASE ADDRESS U16 EQU 5CH ;8255 (U16) BASE ADDRESS FDC EQU 54H ;FLOPPY DISK CONTROLLER UARTA EQU 40H ;8251 (U26) CONSOLE USART BASE ADDRESS UARTB EQU 58H ;8251 (U19) MODEM USART BASE ADDRESS ; Page Zero BIOS scratch area DERCNT EQU 0040H ;Address of disk error counter. DSKTBL EQU 0042H ;Address of Disk Table (NUMDSK) pointer DPBTBL EQU 0044H ;Address of DPB Table (NUMDPB) pointer LINES EQU 0046H ;Address of Lines per page WARMDV EQU 0047H ;Address of WARMBOOT device SKWTBL EQU 0048H ;Address of skew tables, 40 bytes each VERSNM EQU 004AH ;Version number of CBIOS IF ZCPR3 ;CCP cold start address CCP EQU 0CC00H ;ZCPR3 requires room above the BIOS so ELSE ;everything down to make room. CCP EQU 0D900H ;0D900H should work for all standard ENDIF ;systems unless we add a Ramdisk BDOS EQU CCP + 0806H ;BDOS entry point. BIOS EQU CCP + 1600H ;Start of BIOS. VECOFF EQU 0B8H ;Low byte of Vector table address. ;High byte is determined by assembler IF0 PRTVAL <*BIOS Revision=>,%REV .RADIX 16 PRTVAL <*CCP Address=>,%CCP PRTVAL <*BDOS Address=>,%BDOS PRTVAL <*BIOS Address=>,%BIOS .RADIX 10 ENDIF .XLIST SUBTTL CONKEY-64 BOOT MESSAGE ASEG ORG 0900H .LIST PAGE BOOTMS: PHSECZ EQU 512 IF0 PRTVAL <*Physical sector size of boot disk = >,%PHSECZ ENDIF DW PHSECZ ; System disk sector size, in bytes DB NPHSEC ; #phy sec. to read for a cold boot DB 10 ; System disk phy. sectors per track DW CCP ; Low address of CP/M DW BIOS ; BIOS entry point VERSN1 EQU (REV/10) VERSN2 EQU (REV-(VERSN1*10)) TPASIZ EQU (BDOS - 100H)/1024 TPA1 EQU TPASIZ/10 TPA2 EQU TPASIZ - (TPA1*10) MSIZE EQU ((CCP - 3400H)/1024) + 20 ; As used in CP/M documentation MSIZE1 EQU MSIZE/10 MSIZE2 EQU MSIZE - (MSIZE1 * 10) DB CR,CR,LF DB 'CP/M 2.2 Rochester BIOS Rev ' DB (VERSN1+'0'),'.',(VERSN2+'0'),13,10 IF ZCPR3 DB 'ZCPR3.3 ' ELSE DB (MSIZE1+'0'),(MSIZE2+'0'),'K system ' ENDIF DB 'TPA = ' DB (TPA1+'0'),(TPA2+'0'),'K',13,10 IF AUTOST DB 'Autostart ' ENDIF IF ONEDRV DB 'Single Drive System',13,10 ELSE DB 'Dual Drive System',13,10 ENDIF IF INTCON DB 'Typeahead buffer = ' TBUF1 EQU RXASIZ/10 TBUF2 EQU RXASIZ - (TBUF1*10) DB (TBUF1 + '0'),(TBUF2 + '0'),' characters',13,10 ENDIF IF WARMBT DB 'Warm boot drive selectable',13,10 ENDIF DB 0 IF ($-BOOTMS) GT 512 .PRINTX BOOT MESSAGE TOO LARGE ENDIF .XLIST SUBTTL DISK FORMAT MACROS .LIST CONKSS MACRO IF0 .PRINTX Conkey SSDD format ENDIF ; ( DSDD ) DW 28H ;SPT,Sectors per track DB 03H ; 04H ;BSH, Block shift factor. DB 07H ; 0FH ;BLM, Make blocks 1K. DB 00H ; 01H ;EXM, Extent mask. DW 00BDH ; 0C2H ;DSM, 190k usable data space. DW 007FH ;DRM, 128 directory entries. DB 0F0H ; 0C0H ;AL0, Directory occupies 4 blocks. DB 00H ;AL1 DW 0020H ;CKS, check 32 directories. DW 0002H ;OFF, 2 reserved tracks. DB 02H ;sector shift value (2**n cpm/phys sectors) DW 0028H ;The number of tracks per side of disk. DB 0 ;These 2 bytes appear to be unused. DB 0 DB 1 ; 2 ;Number of sides on disk DB 02H ; 4 ;The number of sectors per CP/M block. DB 0AH ;The number of sectors per side. (track) DB 0 ; NOP - do not invert data on disk DB 1 ;First physical sector number DB 0 ;Type of double-sided DB 1 ;Logical Skew factor DB 1 ;FMT program record number DB 'Columbia M64 SSDD ',0 DB 2 ;Physical skew factor DB 36 ;Gap size DB 0,0,0 ; Sector, side, track difference ENDM CONKDS MACRO IF0 .PRINTX Conkey DSDD format ENDIF DW 28H ;SPT,Sectors per track DB 04H ;BSH, Block shift factor. DB 0FH ;BLM, Make blocks 2K. DB 01H ;EXM, Extent mask. DW 00C2H ;DSM, usable data space-1 in blocks DW 007FH ;DRM, 128 directory entries. DB 0C0H ;AL0, Directory occupies 4 blocks. DB 00H ;AL1 DW 0020H ;CKS, check 32 directories. DW 0002H ;OFF, 2 reserved tracks. DB 02H ;sector shift value (2**n cpm/phys sectors) DW 0028H ;The number of tracks per side of disk. DB 0 ;These 2 bytes appear to be unused. DB 0 DB 2 ;Number of sides on disk DB 4 ;The number of sectors per CP/M block. DB 0AH ;The number of sectors per side. (track) DB 0 ; NOP - do not invert data on disk DB 1 ;First physical sector number DB 5 ;Type of double-sided DB 1 ;Logical Skew factor DB 0 ;FMT program record number DB 'Columbia M64 DSDD ',0 DB 2 ;Physical skew factor DB 36 ;Gap size DB 0,40,1 ; Sector, track, side difference ENDM FOREGN MACRO DS 64 ENDM IF AUTOST .XLIST SUBTTL AUTOSTART ROUTINE FOR CCP ASEG ORG 0B00H + 7 .PHASE CCP + 7 ;runs at CCP .LIST DB CMDEND - CMDST ; command length CMDST: DB 'AUTOST' ; the hard-coded command CMDEND: DB 0 ; marks end of command .DEPHASE ENDIF .XLIST SUBTTL CONKEY-64 BIOS JUMP TABLE ASEG ORG 2100H .PHASE BIOS ;but runs at BIOS. .LIST PAGE JP BOOT ;Cold boot function. JP WBOOT ;Warm boot function. JP CONST ;Console input status function. CONIN: JP NCONIN ;Console input function. CONOUT: JP NCONOT ;Console output function. JP LIST ;Printer output function. JP PUNCH ;Punch output function. JP READER ;Reader input function. JP HOME ;Seek drive head to track zero function. JP SELDSK ;Select drive function. JP SETTRK ;Select track function. JP SETSEC ;Select sector function. JP SETDMA ;Set DMA address function. JP READ ;Read sector function (CP/M sectors). JP WRITE ;Write sector function (CP/M sectors). JP LSTST ;Printer status funtion. JP TRANS ;Sector number translate function. ; The following jumps were present in the original disassembled ; BIOS but are not used by CP/M. JP RREAL ;Read "real" disk sector (unblocked). JP WREAL ;Write "real" disk sector (unblocked). .XLIST SUBTTL .LIST PAGE BOOT: LD SP,80H CALL INICB LD A,42H ;Set up Lines per page variable at (46) LD (LINES),A ;to 66 lines per page. IF WARMBT XOR A ;Set warm boot device to A: LD (WARMDV),A ENDIF LD IX,DVAR1 LD A,0 LD (IX+00H),A LD (IX+01H),A LD (IX+02H),A LD HL,(NUMDSK+1) ;Get address of disk table 0 LD (CURTBL),HL ;and store as current table. LD (BUFMOD),A ;Show sector blocking buffer empty. LD A,IOBVAL ;Initialize the IOBYTE. LD (3),A ; LD IY,DVAR2 ;Set up current disk to invalid value LD (IY+00H),0FFH ; (force new disk login) LD IY,DVAR3 LD (IY+05H),0 LD A,94H ;Mode 8255 (U10) PORT A = INPUT MODE 0. OUT (U10+3),A ;PORT B = OUTPUT MODE 1, PORT C UPPER ; = OUTPUT. JP CBOOT1 WBOOT: LD SP,80H ;Initialize the stack. IF WARMBT LD C,(WARMDV) ;Select drive whose number is in WARMDV ELSE LD C,0 ;Always select drive A: ENDIF CALL SELDSK ;Select drive 0. LD BC,0 CALL SETTRK ;Select track 0. ;*** LD HL,DPB0 LD BC,15 ADD HL,BC LD B,(HL) ;Get sector shift value INC B XOR A SCF WB01: RL A DJNZ WB01 LD C,A ;CPM sectors / phys sectors INC C ;Point to start of second physical sector ;*** CALL SETSEC ;Select sector LD BC,CCP CALL SETDMA ;Set DMA address at DD00H LD B,LOW((BIOS-CCP)/128) ;The number of CPM sectors to read PUSH BC ;Save the sector counter. WB02: CALL READ ;Go read in a sector. POP BC ;Retrieve the sector counter, DEC B ;and decrement it. PUSH BC ;Save it again. JP Z,WB16 ;Branch here if all sectors read. JP WB10 ;Else go set up to read next sector. IF LOW($) GT VECOFF VECTORS EQU (HIGH($)+1)*256 + VECOFF ; Use next higher page ELSE VECTORS EQU HIGH($)*256 + VECOFF ; Use current page ENDIF IF $ GT VECTORS ; True if VECTORS wrapped to zero IF0 .PRINTX /NO ROOM FOR VECTOR TABLES/ ENDIF ENDIF IF $ NE VECTORS DS VECTORS-$ ;Put this at an absolute address: ENDIF IF0 .RADIX 16 PRTVAL <*Vector Table Address=>,%$ .RADIX 10 ENDIF ; Z80 VECTORED INTERRUPT TABLES AND EQUATES ; ; There are eleven possible Z80 interrupt sources. One of the sources ; is the Data Request interrupt from the floppy disk controller. This ; interrupt line is hard wired to the Z80's NMI interrupt pin. This ; leaves ten maskable interrupt sources. Below is a list of the ten ; possible sources. ; ; CTC0 CTC channel 0. ; CTC1 CTC channel 1. ; CTC2 CTC channel 2. ; CTC3 CTC channel 3. ; INT1 Comes from the interrupt socket U1 pins 3, and 4. ; INT2 Comes from the Floppy Disk Controller's INT output. ; INT3 Comes from the interrupt socket U1 pins 1, and 8. ; INT4 Comes from the interrupt socket U1 pins 2, and 5. ; INT5 Comes from the interrupt socket U1 pin 7. ; INT6 Comes from the interrupt socket U1 pin 6. ; ; With the exception of the NMI interrupt, the only interrupt priority ; forced by the hardware is that the CTC has the highest priority, and ; INT6 has the lowest priority. The priorities of INT1 through INT5 are ; determined by the structure of the interrupt vector table. For the sake ; of simplicity my table is constructed so that out of the five sources, ; INT1 through INT5, INT1 has the highest priority and INT5 has the lowest ; priority. Below is an equate table used to add an interrupt routine ; address to the table. Simply "EQU"ate your routine's address to the ; desired interrupt priority symbol name. Example "INT1 EQU MYROUTINE". ; Only the INT2 interrupt is used in the original BIOS. Also a generic ; catch all routine "GENINT" was assigned to all other interrupts. See ; the equate table for added interrupts. Also remember that when adding ; new interrupt routines, the corresponding connections must be made to ; the interrupt socket U1, to allow the Z80 to see the interrupt. ; ; INTERRUPT VECTOR ASSIGNMENT TABLE CTC0 EQU GENINT ;Not currently used. CTC1 EQU GENINT ; " " " CTC2 EQU GENINT ; " " " CTC3 EQU GENINT ; " " " INT1 EQU GENINT ; " " " INT2 EQU FDCINT ;Used by FDC's INT hardware. INT3 EQU GENINT ;Not currently used. INT4 EQU GENINT ; " " " IF INTCON INT5 EQU RXAINT ;The console input interrupt routine. ELSE INT5 EQU GENINT ;If not console interrupts, not used ENDIF INT6 EQU GENINT ;Not currently used. PAGE VECTBL: DW CTC0 ;The actual Z80 interrupt vector table. DW CTC1 ;No mods should be made to this table. DW CTC2 ; (unless I made a mistake). DW CTC3 DW INT6 DW INT1 DW INT2 DW INT1 DW INT3 DW INT1 DW INT2 DW INT1 DW INT4 DW INT1 DW INT2 DW INT1 DW INT3 DW INT1 DW INT2 DW INT1 DW INT5 DW INT1 DW INT2 DW INT1 DW INT3 DW INT1 DW INT2 DW INT1 DW INT4 DW INT1 DW INT2 DW INT1 DW INT3 DW INT1 DW INT2 DW INT1 PAGE CBOOT1: LD A,0BH ;Set bit 5 of port C (ROM OFF). OUT (U10+3),A ; IF SOFTBD ; Software baud rate -- initialize rate LD A,(HIGH BAUD) ; load high byte of baud rate constant OUT (80H),A ; initialize CTC LD A,(LOW BAUD) ; Load low byte of baud rate constant OUT (80H),A ; initialize CTC ENDIF IF TELFMT NE 0 ; If outputting the format is enabled CALL PUTFMT ; then go do it ENDIF LD C,0 JP CCP ;Go to CCP. WB10: LD IY,DVAR0 ;Get the current sector number. LD A,(IY+04H) ; (BDOS sector number) LD HL,(CURDPB) ;Point to the DPB CP (HL) ;Is sector number > sectors/track? JR NZ,WB12 ; LD (IY+04H),1 ;If it is, then set the sector = 1. INC (IY+01H) ;Increment the current track. JR WB14 ; WB12: INC (IY+04H) ;Else if not max, increment sector. WB14: LD HL,(CURDMA) ;Get the current DMA address and LD DE,128 ;bump by 1 sector. ADD HL,DE ; LD (CURDMA),HL ; JP WB02 WB16: CALL INICB ;Go initialize page 0, cpm ram. IF TELFMT NE 0 ; If outputting the format is enabled CALL PUTFMT ; then go do it ENDIF LD A,(4) ;Jump to CCP warm start and give LD C,A ;default drive as the drive to select. JP CCP+3 ;Go to CCP warm entry point. IF TELFMT NE 0 ; If we can tell the format -- PUTFMT: IF TELFMT LE 2 LD HL,DPB0+27 ; Point to record# byte of DPB IF TELFMT EQ 1 LD A,3 ; Compare with Conkey ELSE LD A,NATFRMT ; Compare with boot format ENDIF CP (HL) IF TELFMT EQ 1 ; If less than Conkey DSDD JR NC,PUTFM2 ; dont print ELSE JR Z,PUTFM2 ; If not boot format, dont print ENDIF ENDIF LD HL,DRVA CALL PRTSTR LD HL,DPB0+28 ; Get address of drive A's string CALL PRTSTR ; and print it. PUTFM2: IF TELFMT LE 2 LD HL,DPB1+27 ; Point to record# byte of DPB IF TELFMT EQ 1 LD A,3 ; Compare with Conkey ELSE LD A,NATFRMT ; Compare with boot format ENDIF CP (HL) IF TELFMT EQ 1 ; If less than Conkey DSDD RET NC ; dont print ELSE RET Z ; If not boot format, dont print ENDIF ENDIF LD HL,DRVB CALL PRTSTR LD HL,DPB1+28 ; Get address of drive B's string JP PRTSTR ; Call and return PRTSTR ENDIF INICB: LD A,0C3H ;Put jump to WARM BOOT at address 0. LD (0),A ; LD HL,BIOS+3 ; LD (1),HL ; LD (5),A ;Put jump to BDOS at address 5. LD HL,BDOS ; LD (6),HL ; LD HL,NUMDSK ;Store pointer to table in scratch ram. LD (DSKTBL),HL ; LD HL,NUMDPB ;Store pointer to DPB table in scratch ram. LD (DPBTBL),HL ; LD HL,SKWTB1 ;Store pointer to skew tables LD (SKWTBL),HL ; LD A,REV ;Store revision number LD (VERSNM),A LD A,0 ;Set the modem port line number = 0. LD (MLPOS),A ; IM 2 ;Mode 2, vectored interrupts. LD HL,VECTBL ;Set up "I" register to point to LD A,H ;vector table. LD I,A ; RET JPTBL1: DW RXRDYA ; CONST CONSOLE UART = TTY: DW RXRDYB ; CONST MODEM UART = CRT: DW AUXDEV ; CONST READER = BAT: DW RXRDYB ; CONST MODEM UART = UC1: DW RXA ; CONIN CONSOLE UART = TTY: DW RXB ; CONIN MODEM UART = CRT: DW READER ; CONIN READER = BAT: DW RXB ; CONIN MODEM UART = UC1: DW TXA ; CONOUT CONSOLE UART = TTY: DW TXB ; CONOUT MODEM UART = CRT: DW PUNCH ; CONOUT PUNCH (LIST?)= BAT: DW TXB ; CONOUT MODEM UART = UC1: DW TXA ; LIST CONSOLE UART = TTY: DW TXB ; LIST MODEM UART = CRT: DW POUT ; LIST CENTRONIX = LPT: DW MDMSND ; LIST MODEM UART (H/S) = UL1: DW TXA ; PUNCH CONSOLE UART = TTY: DW TXA ; PUNCH CONSOLE UART = PTP: DW MDMSND ; PUNCH MODEM UART (H/S) = UP1: DW TXB ; PUNCH MODEM UART = UP2: DW RXA ; READER CONSOLE UART = TTY: DW RXA ; READER CONSOLE UART = PTP: DW RXBD ; READER MODEM UART (H/S)= UP1: DW RXB ; READER MODEM UART = UP2: DW TXRDYA ; LISTST CONSOLE UART = TTY: DW TXRDYB ; LISTST MODEM UART = CRT: DW PSTAT1 ; LISTST CENTRONIX = LPT: DW TRDYBD ; LISTST MODEM UART (H/S) = UL1: DW RXRDYA ; RDRSTS CONSOLE UART = TTY: DW RXRDYA ; RDRSTS CONSOLE UART = PTP: DW RRDYBD ; RDRSTS MODEM UART (H/S) = UP1: DW RXRDYB ; RDRSTS MODEM UART = UP2: REDIO: POP HL ;Get address of 2 byte parameters. LD D,0 ;Get 1st parameter into DE. LD E,(HL) ; "E" is the index. INC HL ;Get the second parameter into B. LD B,(HL) ; INC HL ;Bump HL and save as the return address. PUSH HL ; LD HL,JPTBL1 ;Get handler table address. DEC E ;Decrement the index in E. SLA E ;Then multiply decremented index by 8. SLA E ; SLA E ; ADD HL,DE ;Add modified index to table start address. LD A,(3) ;Get the IOBYTE. SLA B ;Multiply parameter byte in B by 2. REDIO2: JR Z,REDIO4 ;Jump if result now equal zero. SRL A ;Else shift IOBYTE value right. DEC B ;Decrement parameter byte. JR REDIO2 ;Keep going until B = 0. REDIO4: AND 3 SLA A LD D,0 LD E,A ADD HL,DE CALL LDHLM JP (HL) CONST: CALL REDIO ; First byte = offset into table above DB 01,00 ; Second byte = part of IOBYT to use RET NCONIN: CALL REDIO DB 02,00 RET NCONOT: CALL REDIO DB 03,00 RET LIST: CALL REDIO DB 04,03 RET PUNCH: CALL REDIO DB 05,02 RET READER: CALL REDIO DB 06,01 RET LSTST: CALL REDIO DB 07,03 RET AUXDEV: CALL REDIO DB 08,01 RET PAGE ; ; U26 USART I/O HANDLERS IF INTCON RXACNT: DB 00H RXAPUT: DB 00H ;KEEP THESE IN ORDER. RXAGET: DB 00H RXABUF: DS RXASIZ ; RXAINT: PUSH AF PUSH BC PUSH DE PUSH HL IN A,(UARTA) ;Get the received character into B. LD B,A ; LD A,(RXACNT) ;Get the received character count CP RXASIZ ;and test for a full buffer. JR Z,RXAI04 ;If the buffer is full, trash character. INC A ;Else increment and save the chracter LD (RXACNT),A ;count for next time. LD A,(RXAPUT) ;Get the buffer pointer (index). LD E,A ;Put it into DE. LD D,0 ; INC A ;Increment the pointer for next time, CP RXASIZ ;and if the pointer goes past the end JR NZ,RXAI02 ;of the buffer. XOR A ;Put it back to the start. RXAI02: LD (RXAPUT),A ;In any case save it for next interrupt. LD HL,RXABUF ;Point HL to the start of the buffer. ADD HL,DE ;Add in the index for the character. LD (HL),B ;Put the character into the buffer. RXAI04: POP HL POP DE POP BC POP AF EI RETI RXRDYA: LD A,(RXACNT) OR A RET Z LD A,0FFH RET RXA: CALL RXRDYA ;Test to see if any character received. JR Z,RXA ;Just keep testing until character received. DI LD HL,RXACNT DEC (HL) LD A,(RXAGET) LD E,A LD D,0 INC A CP RXASIZ JR NZ,RXA02 XOR A RXA02: LD (RXAGET),A LD HL,RXABUF ADD HL,DE LD A,(HL) RES 7,A EI RET ELSE ; NON INTERRUPT CONSOLE CODE: RXRDYA: IN A,(UARTA+1) ;Get usart's current status. AND 2 ;Test the "RXRDY" status bit. RET Z ;If no character received, return A = 0. LD A,0FFH ;Else if character received, return a = FF. RET RXA: CALL RXRDYA ;Test to see if any character received. JR Z,RXA ;Just keep testing until character received. IN A,(UARTA) ;Read character from usart. RES 7,A ;Force to 7 bit ascii. RET ENDIF TXRDYA: IN A,(UARTA+1) ;Get the usart's status. CPL ;If DSR and TXEMPTY status bits both set. AND 84H ; JR NZ,TRDYA2 ; OR 0FFH ;Return A = FF. RET ; TRDYA2: XOR A ;Else return A = 0. RET TXA: CALL TXRDYA ;Check to see if OK to send character. JR Z,TXA ;If not OK, then wait. LD A,C ;Put character to send into A. RES 7,A ;Force character to 7 bit ascii. OUT (UARTA),A ;Send the character out. RET PAGE ; ; U19 USART I/O HANDLERS ; RXRDYB: IN A,(UARTB+1) ;Get usart's current status. AND 2 ;Test the "RXRDY" status bit. RET Z ;If no character received, return A = 0. LD A,0FFH ;Else if character received, return A = FF. RET RXB: CALL RXRDYB ;Test to see if any character received. JR Z,RXB ;Just keep testing until character received. IN A,(UARTB) ;Read character from usart. RES 7,A ;Force to 7 bit ascii. RET TXRDYB: IN A,(UARTB+1) ;Get usart's status. CPL ;If DSR and TXEMPTY status bits both set, AND 84H ; JR NZ,TRDYB2 ; OR 0FFH ;Return A = FF. RET ; TRDYB2: XOR A ;Else return A = 0. RET TXB: CALL TXRDYB ;See if OK to send character. JR Z,TXB ;If not OK, then wait until it is. LD A,C ;Get the charcter to send into reg A. RES 7,A ;Force character to 7 bit ascii. OUT (UARTB),A ;Send out the character. RET RRDYBD: IN A,(UARTB+1) ;DUPLICATE "RXRDYB" AND 2 ; RET Z ; LD A,0FFH ; RET RXBD: CALL RRDYBD ;DUPLICATE "RXB" JR Z,RXBD ; IN A,(UARTB) ; RES 7,A ; RET TRDYBD: IN A,(UARTB+1) ;DUPLICATE "TXRDYB" CPL ; AND 84H ; JR NZ,TRRBD2 ; OR 0FFH ; RET ; TRRBD2: XOR A ; RET PAGE MDMSND: LD A,C ;Send a character out the modem port, CP LF ;but call special handlers if character JR Z,MSNDLF ;is a linefeed CP FFEED ;or a formfeed. JR Z,MSNDFF ; CALL MDMOUT ; RET MSNDLF: CALL LFSEND ;Send a linefeed out the modem port. LD HL,MLPOS ;Increment the current line variable INC (HL) ;and if at the end of a page, set the LD A,(LINES) ;current line variable back to zero. CP (HL) ; JR C,MSLF02 ; JR Z,MSLF02 ; RET MSLF02: LD (HL),0 RET PAGE ; SEND OUT LINE FEED TO MODEM PORT. MSNDFF: LD A,(LINES) ;Find out how many lines are left LD HL,MLPOS ;on the current page. SUB (HL) ; MSFF02: JR Z,MSFF04 ; JP M,MSFF04 ; PUSH AF ; CALL LFSEND ;Send out linefeeds until at top of POP AF ;next page. DEC A ; JR MSFF02 ; MSFF04: LD A,0 ;Set up new line position to 0. LD (MLPOS),A ; RET LFSEND: LD C,LF ;Send out the line feed. CALL MDMOUT ; IF LSTNUL LD C,NULL ;AND 2 nulls, CONDITIONAL CALL MDMOUT ; ASSEMBLY LD C,NULL ; CALL MDMOUT ; ENDIF RET MDMOUT: CALL RRDYBD ;If any character has been received CALL NZ,MDMRXF ;by the modem usart, go read it. LD A,(MTXFLG) ;Check to see if an X-OFF has been received OR A ; JR NZ,MDMOUT ;If it has sit here and loop until X-ON rcvd. CALL TRDYBD ;Now check to see if usart ready for character JR Z,MDMOUT ;If not ready, go back and start over. LD A,C ;Else if ready, force output character to RES 7,A ;7 bit. OUT (UARTB),A ;Send out the character. RET MDMRXF: IN A,(UARTB) ;Read in character from modem usart (U19) RES 7,A ;Force to 7 bit. CP 11H ; JR Z,GOTXON ;Check to see if character is an CP 13H ;X-ON or an X-OFF RET NZ ;If neither, return with character. GOTXOF: LD A,1 ;Set "MTXFLG" = 1 if X-OFF received. LD (MTXFLG),A ; RET GOTXON: LD A,0 ;Clear "MTXFLG" if X-ON received. LD (MTXFLG),A ; RET PAGE ; PRINTER OUTPUT ROUTINES PSTAT1: IN A,(U10) ;Check U10 port A, bit 6. This is a printer AND 40H ;status line. J2 pin 16 I think. (PAPER OUT ?) RET Z ;Return A = 0 if bit = 0 LD A,0FFH ;Else return A = FF if bit is set. RET POUT: CALL PSTAT1 ;Check printer status bit JR NZ,POUT4 ; PUSH BC ;If not set, print "printer not ready message" LD HL,PNRMSG ; CALL PRTSTR ; POUT2: CALL PSTAT1 ;Then wait until printer ready. JR Z,POUT2 ; POP BC ; POUT4: LD A,C ;Set up data on printer data lines. OUT (U10+1),A ; LD A,0AH ;Lower the printer "STROBE" control line. OUT (U10+3),A ; LD A,0BH ;Raise the printer "STROBE" control line. OUT (U10+3),A ; POUT6: IN A,(U10+2) ;Read in bit 1 of port C, and loop till set. AND 2 ;SCHEMATIC SHOWS THIS AS A NO CONNECT. JR Z,POUT6 ;MIGHT BE "ACK" RET PAGE ; ;-------------------------------------------------------------------------- ; D I S K I / O S E C T I O N ;------------------------------------------------------------------------- ; HOME: LD IX,DVAR0 ;Set LSB of "current track" equal zero. LD (IX+01H),0 ; RET SELDSK: LD A,(NUMDSK) ;Get number of disk drives in system. DEC A ;Check to see if request is for a legal drive. CP C ; JR NC,SLDSK2 LD HL,0 ;If drive is illegal, return HL = 0. RET ; SLDSK2: LD E,C ;Else if legal drive, make index from SLA E ;drive number. INC E ; LD HL,NUMDSK ;Add the index to "NUMDSK" address. LD D,0 ; ADD HL,DE ; CALL LDHLM ;Get the Disk table address for this drive. LD (CURDTB),HL ;Save it for the disk I/O handlers LD DE,0 ;This don't seem necessary. ADD HL,DE ; CALL LDHLM ;Now get the DPT's address. LD (CURDPT),HL ;Save it somewhere. PUSH HL ;Save also on stack. LD DE,0AH ;Point to DPB address in the DPT. ADD HL,DE ; CALL LDHLM ;Get the DPB address into HL. LD (CURDPB),HL ;Save it as the current DPB. POP HL ;Retrieve the DPT address for caller. LD IX,DVAR0 ;Store the current drive number LD (IX+00H),C ;in the drive variables table. RET SETTRK: LD IX,DVAR0 ;Store the track number. LD (IX+01H),C ; LD (IX+02H),B ; RET SETSEC: LD IX,DVAR0 ;Save the sector number. LD (IX+04H),C ; RET SETDMA: LD (CURDMA),BC RET TRANS: PUSH AF LD A,D ;Check to see if DE = 0. (No translation CP E ; table). JR NZ,TRANS2 ; PUSH BC ;If no table, return the phisycal sector POP HL ;to be the logical sector plus 1. INC HL ; (first sector = 1) JR TRANS4 ; Go restore and return. TRANS2: EX DE,HL ;Else if translation required. LD B,0 ;Force sector number to 8 bit range. ADD HL,BC ;Index into translation table. LD E,(HL) ;Get byte value from table, and LD D,0 ;convert it to word value. EX DE,HL ;Result is returned in HL. TRANS4: POP AF RET READ: LD HL,(CURDPB) ;Get the sector size shift value LD DE,0FH ;for the current drive, from the DPB. ADD HL,DE ; LD D,(HL) ; Put it into D. LD A,0 ; CP D ;If the shift factor = 0 JR Z,RREAL ;go do standard CP/M 8" disk read. LD HL,DBUF0 ;Else initialize sector buffer pointer LD (CURBUF),HL ;to start of sector buffer. LD (DSKFLG),A ;Set the DSKFLG = 0. (READ ?) JR RW006 WRITE: LD HL,(CURDPB) LD DE,0FH ADD HL,DE LD D,(HL) LD A,0 CP D JR Z,WREAL LD HL,DBUF0 ;Initialize buffer pointer LD (CURBUF),HL ;to start of sector buffer. LD A,1 ;Set the DSKFLG = 1. (WRITE ?) LD (DSKFLG),A ; LD A,C LD (WRTTYP),A ;Put the type of write from bdos ;into ram variable. JR RW006 ; READ IN A SECTOR WITHOUT DEBLOCKING RREAL: LD HL,(CURDMA) ;Set up current buffer pointer LD (CURBUF),HL ;to equal current DMA address. LD IX,DVAR0 ;Point IX to disk variables. LD A,(IX+04H) ;Get the sector number into A. LD (IX+03H),A ;Store it back in variables. JP INIRD ; WRITE OUT A SECTOR WITHOUT DEBLOCKING WREAL: LD HL,(CURDMA) LD (CURBUF),HL LD IX,DVAR0 LD A,(IX+04H) LD (IX+03H),A JP INIWD ; COMMON R/W ENTRY POINT FOR SECTORS BIGGER THEN 128 BYTES. RW006: LD A,0 ;Initialize the error flag to return LD (LSTSTA),A ;to BDOS to show no error. LD HL,(CURDPB) ;Get the sector size shift value for LD DE,0FH ;this drive from the DPB. ADD HL,DE ; LD A,(HL) ; LD B,A ;Put it into A and B. ; Take the sector number that BDOS wants and convert to a ; sector number for the "real" disk. LD IY,DVAR0 ;Get the BDOS sector number LD C,(IY+04H) ;from the table, into C. DEC C ;Decrement to make logical sector number. LD D,0 ;Test the sector shift factor for zero. OR A ;If zero, skip the next part. RW008: JR Z,RW010 ;Shift the logical CP/M sector number SRL C ;right, (divide by 2) RR D ;Put any remainder into upper bit of D. DEC A ;Decrement the sector size shift factor. JR RW008 ;Repeat until shift factor = zero. RW010: LD A,8 ;Now subtract the original shift factor SUB B ;from 8 to find remainder in reg D. RW012: JR Z,RW014 ;Now shift the ramainder value to SRL D ;create an index for the CP/M sector DEC A ;within the larger "real" sector. JR RW012 ; RW014: PUSH BC ;Save logical sector number LD BC,09H ;Get offset in DPB of sector offset, ADD HL,BC ; (offset from the sector shift value) LD A,(HL) ;Get the starting sector number POP BC ;Restore logical sector number ADD A,C ;Inc logical sector number if 1st sector = 1 LD (IY+03H),A ;Save the ACTUAL DISK SECTOR NUMBER. LD (IY+05H),D ;Save the INDEX INTO THE SECTOR. LD IX,DVAR2 ;Point to the previous sector operation CALL CMPVAR ;variables and see if we're all set up. JR Z,CPYDAT ;If we are go transfer the data between ;the DMA location, and the sector buffer. ;NO ACTUAL DISK I/O UNLESS DIRECTORY SECTOR LD A,(BUFMOD) ;Get value from ram to see if sector OR A ;buffer in use. JR Z,RW018 ;In not in use, skip the next part. LD A,(WRTNB) ;See if the data in sector buffer is being OR A ;written to a new block. JR NZ,RW016 LD IX,DVAR2 ;If not then simply flush buffer. CALL INIWD ;Use data in DVAR2. JR RW017 ;Skip the next part. RW016: LD IX,DVAR3 ;When writting to a new block. CALL INIWD ;Flush buffer first, using DVAR3 variables. CALL SETNS ;Then set up DVAR3 to show next sector. RW017: LD A,0 ;Show that sector buffer has been flushed. LD (BUFMOD),A ; RW018: LD A,(DSKFLG) ;Find out if we want to read or write. OR A ; JR NZ,RW070 ; LD IX,DVAR0 ;IF WE WANT TO READ, set up pointer to CALL INIRD ;"next" variables, and go read in sector. LD A,0 ; LD (WRTNB),A ;Show that sector buffer not modified. JR CPYDAT ;Go transfer data from sector buffer to DMA. ; if write RW070: LD A,(WRTTYP) ;Find out what type of write operation we CP 2 ;need to do. When "re-writing" we must JR NZ,RW072 ;pre-read sector. ; WRITE FIRST SECTOR OF NEW BLOCK CALL CPY0T3 ;Copy operation variables to alternate. LD A,1 ;Show that sector buffer is modified. LD (WRTNB),A ;Then go transfer data. JR CPYDAT ;Note here we do no actual disk write. ; Check to see if sector must be pre-read before writting. RW072: LD IY,DVAR3 ;Look and see if we were previous writing LD A,(IY+05H) ;to an unallocated block. CP 0 ; JR Z,RW074 ;If we weren't then go pre-read sector. LD IX,DVAR0 ;See if last write was to same sector. CALL CMPVAR ; JR NZ,RW074 ;If it wasn't, then go pre-read sector. LD A,1 ;Else show sector buffer as modified. LD (WRTNB),A ;Then go copy data, no disk access required. JR CPYDAT ; RW074: LD IX,DVAR0 ;Pre-read sector from disk. CALL INIRD ; LD A,0 ; LD (WRTNB),A ;Show sector buffer not modified. PAGE ; Copy 128 bytes of data to, or from, the DMA address to, or from, ; the larger sector buffer. CPYDAT: LD IY,DVAR0 ;Get the index into the sector from LD B,(IY+05H) ;the variables area. LD C,0 ;Make it 16 bit first. SRL B ;Then divide by 128 (bytes per CPM sector). RR C ; LD HL,DBUF0 ;Add offset to the start of the buffer. ADD HL,BC ; LD DE,(CURDMA) ;Get the data destination address (DMA) LD BC,80H ;Set to transfer 128 bytes (1 cpm sector). LD A,(DSKFLG) ;Get the disk read/write flag OR A ; JR Z,RW030 ;If it's 0 (read) then jump... LD A,1 ;Else if write first mark the sector LD (BUFMOD),A ;buffer as being modified. EX DE,HL ; RW030: LDIR ;Depending on read or write, copy data ;between the DMA address and the sector ;buffer. LD HL,DVAR0 ;Copy the 1st 6 bytes of the current LD DE,DVAR2 ;disk variables to alternate buffer. LD BC,6 ; LDIR ; LD A,(DSKFLG) ;Check to see if read or write operation. OR A ; JR Z,RW032 ;If READ skip next part. LD A,(WRTTYP) ;Else if WRITE, find out what type. CP 1 ; JR NZ,RW032 LD IX,DVAR0 ;IF WE ARE WRITTING TO A DIRECTORY SECTOR. CALL INIWD ;FORCE A WRITE SECTOR NOW !!!!!!!! LD A,0 ;Show sector buffer as flushed. LD (BUFMOD),A ; RW032: LD A,(LSTSTA) RET ; Compare two disk operation variables tables. CMPVAR: LD A,(IX+00H) ; Same drive? CP (IY+00H) RET NZ LD A,(IX+03H) ; Same physical sector? CP (IY+03H) RET NZ LD A,(IX+01H) ; Same track? CP (IY+01H) RET NZ LD A,(IX+02H) ; Same track (other byte)? CP (IY+02H) RET CPY0T3: LD HL,DVAR0 LD DE,DVAR3 LD BC,6 LDIR LD HL,(CURDPB) LD DE,15H ;Get value from DPB (=02) ADD HL,DE ; (phys sectors per cpm block) LD A,(HL) ; LD IY,DVAR3 LD (IY+05H),A ;Store it. RET ; SET UP DVAR3 TO POINT TO NEXT SECTOR IN THE NEW BLOCK SETNS: LD IY,DVAR3 ;Decrement number of unread sectors in block DEC (IY+05H) LD HL,(CURDPB) ;Get value from DPB LD DE,24 ; starting sector number ADD HL,DE ; LD A,(HL) ;into A. LD DE,2 ; Point to the physical skew factor ADD HL,DE LD C,(HL) ; Save it in C LD DE,-4 ; Now point to phys sectors per track ADD HL,DE LD D,(HL) ; into D. LD E,A ; E = starting sector number LD A,(IY+03H) ;Increment the actual disk sector number ADD A,C ;(only in reg A) SUB E ; Make zero offset RW040: CP D ;If A >= D then wrap around JP M,RW041 SUB D ; Subtract one track from sector number RW041: AND A ; Is sector zero? JR NZ,RW042 ; If so, increment track LD C,(IY+01H) ;increment the variables copy of LD B,(IY+02H) ;current track number INC BC ; LD (IY+02H),B ; LD (IY+01H),C ; RW042: ADD A,E ; Add sector offset back in LD (IY+03H),A ;Save the final result as actual disk sector. RET ; INITIALIZATION CODE FOR READ SECTOR ROUTINES INIRD: ;****************** NEW CODE TO SUPPORT INVERTED DATA SS 12/12/86 LD HL,78EDH ;Insert the following code into NMI routine LD (NMICPY+2),HL ; IN A,(C) LD HL,7700H ; NOP ; MAYBE CPL LATER LD (NMICPY+4),HL ; LD (HL),A LD A,00H ; NOP LD (NMICPY+6),A ; ;****************** END OF NEW CODE SS 12/12/86 ;;; LD HL,0A2EDH ;Put an "INI" instruction into the ;;; LD (NMIINS),HL ;disk NMI handler. LD A,7FH ;Set up FDC command for READ SECTOR. LD (FDCCMD),A ; LD A,1CH ;Set mask to show any read error. LD (ERRMSK),A ; LD HL,RDMSG ;Set up error message to print "READ ERROR" LD (DSKMSG),HL ; JR DODIO ; INITIALIZATION CODE FOR WRITE SECTOR ROUTINES INIWD: ;****************** NEW CODE TO SUPPORT INVERTED DATA SS 12/12/86 LD HL,007EH ;Insert the following code into NMI routine LD (NMICPY+2),HL ; LD A,(HL) LD HL,0ED00H ; NOP LD (NMICPY+4),HL ; NOP ; MAYBE CPL LATER LD A,79H ; OUT (C),A LD (NMICPY+6),A ; ;****************** END OF NEW CODE SS 12/12/86 ;;; LD HL,0A3EDH ;Put "OUTI" instruction into interrupt ;;; LD (NMIINS),HL ;handler. LD A,5FH ;Set up write sector command. LD (FDCCMD),A ; LD A,7CH ;Check for any write error. LD (ERRMSK),A ; LD HL,WRMSG ;Set error message to print LD (DSKMSG),HL ;"WRITE ERROR" DODIO: LD HL,(CURDPB) ;Get current DPB address LD DE,23 ;Offset by 23 ADD HL,DE ;Get Data inversion byte LD A,(HL) ;into A. LD (NMIINS),A ;Store in NMI code LD IY,DVAR1 ;Check variables and see if we need to LD A,(IY+00H) ;change disks. CP (IX+00H) ; CALL NZ,CHGDRV ;If we do, then go do it. CALL HSTPHY ;Convert HOST parameters (in DVAR1) to ;physical (what FDC wants) parameters CALL SIDCHK ;Check for and maybe perform side change CALL TRKCHK ;Seek track, if necessary, and set sector LD A,0 ;Clear the disk error counter. LD (DERCNT),A ; LD HL,66H ;Save 8 bytes of data at Z80's NMI LD DE,NMISAV ;interrupt location in scratch ram. ;;; LD BC,8 ; LD BC,12 ; CHANGED FOR NEW NMI CODE SS 12/12/86 LDIR LD HL,NMICPY ;Copy the NMI disk interrupt LD DE,66H ;routine to the Z80 NMI interrupt ;;; LD BC,8 ;location. LD BC,12 ; CHANGED FOR NEW NMI CODE SS 12/12/86 LDIR PAGE ; ACTUALLY READ OR WRITE A DISK SECTOR RW050: EXX LD HL,(CURBUF) ;Put sector buffer address in HL' LD C,57H ;Put FDC's data port address into C'. EXX LD B,0AH ;Put delay count into B. LD A,(PHYSEC) ;Get current sector number. CPL ;Invert all FDC data. OUT (FDC+2),A ;Send FDC current sector number. LD A,(FDCCMD) ;Get the FDC command byte from memory. OUT (FDC),A ;Send it to the FDC. DLYLP0: DJNZ DLYLP0 ;Wait a little while before reading status. LP02: IN A,(FDC) ;Wait till FDC not busy. AND 1 ; (until read or write complete) JR Z,LP02 ; IN A,(FDC) ;Get the FDC's final status CPL ;Correct for inverted data buss. LD (ERRSTA),A ;Save status in ram. LD HL,ERRMSK ;Mask status with memory mask. AND (HL) ; JR NZ,GOTDER ;If error occured jump to handler. NODER: LD A,0 ;If no error, save A = 0 for later. PUSH AF ; PUSH IX ;Get address of disk variables from POP HL ;IX into HL LD DE,DVAR1 ;Copy variables to DVAR1. LD BC,6 ; LDIR ; JR RESNMI ;Go start operation cleanup. PAGE ; DISK ERROR HANDLER GOTDER: LD A,(DERCNT) ;Get the disk error counter. CP 0AH ;Is it = 10 ? JR NZ,RW058 ;If not jump and keep going. CALL PRTDER ;Else print disk error message. LD A,1 PUSH AF LD IY,DVAR2 LD (IY+03H),0FFH ;Set sector number = FF, (unknown). JR RESNMI ;Go start operation cleanup. RW058: INC A ;Increment the disk error counter. LD (DERCNT),A ; LD A,(ERRSTA) ;Get the error code from ram copy. AND 10H ;Was the error a "seek" error. JR Z,RW060 ; CALL RESTOR ;If it was restore drive head to track zero. CALL SIDCHK ; Re-set the requested side CALL TRKCHK ; Re-set the requested track and sector RW060: JR RW050 ;Go back and retry. RESNMI: LD HL,NMISAV ;Restore the data that was moved LD DE,66H ;from the Z80's NMI interrupt ;;; LD BC,8 ;location. LD BC,12 ; CHANGED FOR NEW NMI CODE SS 12/12/86 LDIR POP AF ;Retrieve error status to return to BDOS. LD (LSTSTA),A ;Also save status in ram for us. RET PAGE IF ONEDRV ; CONDITIONAL CODE: ONE DRIVE SYSTEM CHGDRV: LD IY,(CURDTB) ;Get the ASCII letter corresponding LD A,(IY+02H) ;to the drive to be mounted and LD (MOUNAM),A ;stuff it into the message. LD HL,MOUMSG ; CALL PRTSTR ;Print the "mount" message. CALL CONIN LD HL,(CURDTB) ;Set up pointer to Disk table. LD (CURTBL),HL ; LD IY,(CURTBL) ; LD A,(IY+05H) ;Get the side number from the table. CALL SELSID ;Set up hardware to select correct side. LD IY,DVAR2 ;Copy the drive number from current ELSE ; CONDITIONAL CODE: TWO DRIVE SYSTEM CHGDRV: LD A,(DVAR1+1) ;Get current track LD IY,(CURTBL) ;Get previous drive table LD (IY+03H),A ;Store current track LD IY,(CURDTB) ;Get address of new drive LD (CURTBL),IY ;Make it the current drive ;Side selection originally done here! LD A,(IY+08H) ;Get command for C port of U16 OUT (U16+02H),A ;Select this drive LD A,(IY+05H) ;Get current side CALL SELSID ;Select the side physically LD A,(IY+03H) ;Get current track CP 0FFH ;Is it unknown? JR NZ,CHGD01 ;If so, CALL RESTOR ;Restore the head LD A,0 ;Set track # to zero CHGD01: LD IY,DVAR1 LD (IY+01H),A ;Store the track in the DVARs CPL OUT (FDC+01H),A ;Set the track in the FDC ENDIF LD A,(IX+00H) ;Put DVAR0's disk # LD (IY+00H),A ;into DVAR1's disk # RET ; ; HSTPHY - Performs host (DVAR1) to physical (FDC) conversion ; HSTPHY: LD A,(IX+01H) ; HOST TRACK LD (PHYTRK),A ; SET TO PHYS. TRACK BY DEFAULT LD A,(IX+03H) ; HOST SECTOR LD (PHYSEC),A ; SET TO PHYS. SECTOR BY DEFAULT LD A,0 ; ASSUME ZERO VALUES FOR LD (PHYSID),A ; THE SIDE AND LD (PHYTDF),A ; THE TRACK DIFFERENCE LD HL,(CURDPB) ; GET THE CURRENT DPB LD DE,25 ; GET THE OFFSET TO THE TYPE BYTE ADD HL,DE LD A,(HL) ; GET THE TYPE BYTE AND 0FH ; LIMIT TO 16 CHOICES ; ERROR CHECKING COULD GO HERE LD HL,CASES ADD A,A ; DO THE SELECTED CASE: ADD A,L ; HL = HL + 2 * A LD L,A ADC A,H SUB L LD H,A CALL LDHLM ; HL = (HL) JP (HL) ; JUMP TO ADDRESS IN HL CASES: DW CASE0 ; Single sided - no translation DW CASE1 ; Cylinders, subtype 0 = side1 like side0 ; subtype 1 = side1 continues side0 DW CASE2 ; Odd/Even, like Kaypro, uses subtype DW CASE3 ; Side0 then side1, sides formatted alike DW CASE4 ; IBM: side0, then side1 backwards from 79 DW CASE5 ; Conkey: side0 then side1, track#s 40-79 CASE0: RET ; ONE SIDED - NO TRANSLATION REQUIRED CASE1: LD A,(PHYSEC) ; TRUE CYLINDERS LD HL,(CURDPB) LD DE,22 ; Get physical sectors per track ADD HL,DE SUB (HL) ; A = A - SPT LD DE,2 ; 24 - 22, ADD HL,DE ; POINT TO SECTOR OFFSET CP (HL) ; COMPARE WITH A RET M ; RETURN IF STILL ON SIDE 0 LD B,A ; SAVE CALCULATED SECTOR NUMBER LD A,1 LD (PHYSID),A ; PHYSICAL SIDE = 1 LD HL,(CURDPB) LD DE,25 ADD HL,DE LD A,(HL) ; GET TYPE AGAIN AND 0F0H ; GET UPPER NIBBLE - SUBTYPE RET NZ ; IF SUBTYPE = 1, SECTOR NUMBERS CONT. TO SID1 LD A,B LD (PHYSEC),A ; STORE NEW PHYSICAL SECTOR NUMBER RET CASE2: LD A,(PHYTRK) ; ODD/EVEN TRACKS, PHYSICAL CYLINDERS LD B,A ; ALA KAYPRO 4 AND 1 LD (PHYSID),A ; SIDE IS 1 IF ODD, 0 IF EVEN LD A,B RRA LD (PHYTRK),A ; DIVIDE TRACK BY 2 RET NC ; RETURN IF ON SIDE 0 LD HL,(CURDPB) LD DE,25 ADD HL,DE ; POINT TO SUBTYPE BYTE LD A,(HL) AND 0F0H ; STRIP OFF THE TYPE RET Z ; IF SUBTYPE = 0, SIDE1 SEC# SAME AS SIDE0 LD DE,-3 ; (DPB.SPT-DPB.TYP) ADD HL,DE LD A,(PHYSEC) ADD A,(HL) ; IF SUBTYPE = 1 THEN LD (PHYSEC),A ; SECTOR = SECTOR + SECTORS PER TRACK RET CASE3: LD A,(PHYTRK) ; SIDE1 HAS HOST TRACKS 40-79 LD HL,(CURDPB) ; BUT PHYS TRACKS 0-39 LD DE,16 ; POINT TO TRACKS PER SIDE ADD HL,DE CP (HL) ; RET C ; RETURN IF SIDE 0 SUB (HL) LD (PHYTRK),A ; SET PHYS TRK ON SIDE 1 LD A,1 LD (PHYSID),A ; SET SIDE TO 1 RET CASE4: LD HL,(CURDPB) ; SIDE 1 HAS HOST TRACKS 79-40 LD DE,16 ; BUT PHYS TRACKS 40-79 ADD HL,DE ; POINT TO TRACKS PER SIDE LD A,(HL) LD (PHYTDF),A ; STORE PHYSICAL TRACK DIFFERENCE LD A,(PHYTRK) CP (HL) RET C ; RETURN IF SIDE 0 CPL ADD A,(HL) ADD A,(HL) LD (PHYTRK),A LD A,1 LD (PHYSID),A RET CASE5: LD HL,(CURDPB) ; SIDE 1 HAS HOST TRACKS 40-79 (Conkey) LD DE,16 ; AND PHYS TRACKS 40-79 ADD HL,DE ; POINT TO TRACKS PER SIDE LD A,(HL) LD (PHYTDF),A ; STORE PHYSICAL TRACK DIFFERENCE LD A,(PHYTRK) CP (HL) RET C ; RETURN IF SIDE 0 LD A,1 LD (PHYSID),A RET SELSID: ADD A,0CH ;Tricky: 0CH sets side 0, 0DH sets side 1 OUT (U16+3),A ;Command side change LD DE,2 ;Delay for 2 msec JP DLYDE ; And return to caller ; ; SIDCHK - CHECK FOR SIDE CHANGES 2/8/87 -dcb ; SIDCHK: IN A,(U16+2) ;Read current side number from PORT C of U16 AND 40H ;Mask off side bit RLCA RLCA ;Put bit in LSB, values 0 or 1 LD HL,PHYSID CP (HL) ;Compare with physical side RET Z ;If same, no side change required LD A,(HL) ;If different, select new side CALL SELSID PUSH IY LD IY,(CURTBL) LD A,(PHYSID) ;Get new side again LD (IY+05H),A ;Store in disk table POP IY LD A,(PHYTDF) ;Get physical track difference AND A ;Is it zero? RET Z ;If so, we're done LD B,A ;Save track difference LD A,(PHYSID) ;Get new side AND A ;Is it zero? IN A,(FDC+1) ;Read the current track number from FDC JR NZ,SIDCK1 ;If zero then CPL SUB B ; Subtract track difference JR SIDCK2 ;Else SIDCK1: CPL ADD A,B ; Add track difference SIDCK2: CPL OUT (FDC+1),A ;Set new track number RET ; ; TRKCHK - seek track, if required, and set sector in FDC ; TRKCHK: IN A,(FDC+1) ;Find current track number CPL LD B,A LD A,(PHYTRK) ;Compare with requested track CP B ; JR Z,TRKCK2 ;Branch if no seek required CPL OUT (FDC+3),A ;Prepare to seek LD B,10 ;Load a short delay into B LD A,0E7H ;Seek, no verify, INVERTED OUT (FDC),A ; TRKCK1: DJNZ TRKCK1 ; Wait a while TRKBZY: IN A,(FDC) ; Keep reading FDC status AND 1 ; Until not busy JR Z,TRKBZY LD DE,14H ; Head settling time CALL DLYDE TRKCK2: LD A,(PHYSEC) ; Get physical sector CPL OUT (FDC+2),A ; And write to the FDC RET PAGE ; RESTORE HEAD TO TRACK BUT DO NOT VERIFY. RESTOR: LD A,0CH ;Select side zero. OUT (U16+3),A ; LD B,0AH ; LD A,0F7H ;Command FDC to restore head to track zero OUT (FDC),A ; (no verify). RESTR2: DJNZ RESTR2 ;Wait here a little while. RESTR4: IN A,(FDC) ;Loop here until FDC not busy. AND 1 ; JR Z,RESTR4 ; RET PRTDER: PUSH IX ;CALLED TO PRINT DISK ERROR LOCATION LD IX,DVAR0 LD HL,ASTR CALL PRTSTR LD A,(IX+0) ;Disk number CALL PRTHEX LD HL,BSTR CALL PRTSTR LD A,(IX+1) ;Track number CALL PRTHEX LD HL,CSTR CALL PRTSTR LD A,(IX+3) ;Disk sector number CALL PRTHEX LD HL,DSTR CALL PRTSTR LD A,(IX+4) ;CPM sector number CALL PRTHEX LD HL,ESTR CALL PRTSTR LD A,(IX+5) ;Index into sector CALL PRTHEX LD HL,(DSKMSG) ;AND STATUS. CALL PRTSTR ;Print "READ" or "WRITE". LD IY,(CURTBL) ;Get the ascii name of the drive. LD A,(IY+02H) ; LD HL,DSKNAM ;Put the drive name into the error LD (HL),A ;message. LD HL,DERMSG ;Go print the error message. CALL PRTSTR ; IN A,(FDC+1) ;Read the track number directly from CPL ;the FDC. CALL PRTHEX ;Print the track number. LD HL,SECMSG ;Print the sector number message text. CALL PRTSTR ; IN A,(FDC+2) ;Read the sector number directly from CPL ;the FDC. CALL PRTHEX ;Go print the sector number. LD HL,SIDMSG ;Print the side number message text CALL PRTSTR IN A,(U16+2) ;Get side/drive status CALL PRTHEX ;Print it LD A,(ERRSTA) ;Get the FDC error status. LD HL,ASCSTA ;Set up 8 byte scratch pad to make ascii LD B,8 ;string of error status shown as binary. MAKBIN: RLA ;Shift current upper bit into Carry. JR C,MAKB2 ; LD (HL),'0' ;If bit = 0, put a "0" in the message. JR MAKB3 ; MAKB2: LD (HL),'1' ;Else put a "1" into the message. MAKB3: INC HL ;Bump message address pointer. DJNZ MAKBIN ;Do all 8 bits. LD HL,STAMSG ;Print the error status message and the status CALL PRTSTR ; CALL CONIN ;Get user's reponse. POP IX ; CP 3 ;See if user typed CTRL-C. JR Z,GIVEUP ;If CTRL-C typed, go do warm boot. CP 'R' ;If user typed "R" JR Z,RETRY ;Go re-try disk operation. CP 'I' ;Else if user typed "I" JR Z,IGNORE ;Just ignore the error completely. RET GIVEUP: JP WBOOT RETRY: POP HL ;Clear the stack ? LD A,0 ;Clear the disk error (retry) counter. LD (DERCNT),A ; JP RW050 ;Got start the disk operation again. IGNORE: POP HL ;Pretend the error never occured. JP NODER ; PAGE LDHLM: LD E,(HL) ;Get the word pointed to by HL into HL. INC HL ; LD D,(HL) ; EX DE,HL ; RET PRTSTR: LD A,(HL) ;Get a character from memory. OR A ;If it's a zero then we are done. RET Z ; LD C,A ;Else if non-zero, put character into C. PUSH HL ; CALL CONOUT ;Send character to console. POP HL ; INC HL ;Bump the character pointer. JR PRTSTR ;Keep printing.. PRTHEX: PUSH AF ;Save copy of input byte. RRCA ;Move high nibble to low nibble. RRCA ; RRCA ; RRCA ; CALL PHEX2 ;Convert low nibble to ascii and print. POP AF ;Retrieve original byte and print low nibble. PHEX2: AND 0FH ;Mask off all but low nibble. ADD A,'0' ;Make ascii. CP ':' ;Check for a A-F value. JR C,PHEX4 ; ADD A,7 ;Adjust if necessary. PHEX4: LD C,A ;Character goes to C for printing. CALL CONOUT ;Print the character. RET DLYDE: PUSH HL ;This is just one big timing loop. PUSH AF ;The delay is determined by value in DE. DLYDE2: DEC DE ;Outer loop. Do inner loop number of LD A,E ;times in DE OR D ; JR Z,DLYDE6 ;When DE decrement to zero, exit. LD HL,63H ; Inner loop, decrement HL from DLYDE4: DEC HL ; 63 to 0. LD A,H ; NOP ; NOP ; NOP ; NOP ; OR L ; JR NZ,DLYDE4 ; JR DLYDE2 ;When inner loop done, go back to outer loop. DLYDE6: POP AF POP HL RET PAGE ; INTERRUPT ROUTINES ;;;NMICPY: EXX ;The memory image of the disk sector I/O ;;; EX AF,AF' ;Non Maskable Interrupt routine. (DMAREQ) ;;;NMIINS: OUTI ;This instruction may be an "INI" or ;;; EX AF,AF' ;an "OUTI" depending on a read or write ;;; EXX ;sector operation. NOTE that it appears ;;; RETN ;that the disk data is inverted on the disk. NMICPY: EXX ; READ WRITE EX AF,AF' ; NOP ; IN A,(C) LD A,(HL) NOP ; (2 BYTES) NOP NMIINS: NOP ; NOP / CPL NOP / CPL NOP ; LD (HL),A OUT (C),A NOP ; NOP (2 BYTES) INC HL EX AF,AF' EXX RETN GENINT: EI ;Generic "catch all" interrupt handler. RETI ; FDCINT: PUSH AF ;The FDC interrupt routine for INT not DATREQ. IN A,(FDC) ;Just read the status register and trash data. POP AF ; EI ; RETI PAGE MTXFLG: NOP ;Set = 1 if X-OFF received from modem usart. ;Set = 0 if X-ON received. DRVA: DB CR,LF,'A: ',0 DRVB: DB CR,LF,'B: ',0 PNRMSG: DB CR,LF,BEL DB 'PRINTER NOT READY',0 ASTR: DB CR,LF,BEL,'DISK ',0 BSTR: DB ', HTRK ',0 CSTR: DB ', HSEC ',0 DSTR: DB ', CPMSEC ',0 ESTR: DB ', INDEX ',0 RDMSG: DB CR,LF,'READ ',0 WRMSG: DB CR,LF,'WRITE ',0 DERMSG: DB BEL,'ERROR ON DISK ' DSKNAM: DS 1 ;Holds the drive name for printing. TRKMSG: DB ': TRACK ',0 SECMSG: DB ', SECTOR ',0 SIDMSG: DB ', SIDEPORT ',0 STAMSG: DB ', STATUS= ' ASCSTA: DS 8 ;Holds the ascii representation of the ;FDC error status in binary. DB ' ',0 DB 0 MOUMSG: DB CR,LF,BEL,'MOUNT ' MOUNAM: DS 1 DB '?' DB 0 NUMDSK: DB 02H ;The number of drives in the system. DW DTBL0 DW DTBL1 NUMDPB: DB 02H ;DPB table of pointers DW DPB0 DW DPB1 DPBASE: DPT0: DW 0 ;There is NO SECTOR TRANSLATION TABLE DW 0,0,0 ;BDOS scratch pad. DW DIRBUF ;Address of directory buffer (128 bytes) DW DPB0 ;Address of Disk Parameter Block. DW CSV0 DW ALV0 DPT1: DW 0 DW 0,0,0 DW DIRBUF DW DPB1 DW CSV1 DW ALV1 DTBL0: DW DPT0 DB 'A' ;The drive's ascii name. DB 0FFH ;current track under head DB 00 DB 00 ;CURRENT DISK SIDE DW 0000H DB 0D0H DB 0D0H DTBL1: DW DPT1 DB 'B' ;The drive's ascii name. DB 0FFH ;current track under head DB 00 DB 00 ;CURRENT DISK SIDE DW 0000H DB 0E0H DB 0E0H IF NATFRMT EQ 1 DPB0: CONKSS ; Cold-boot default of both drives is DPB1: CONKSS ; Conkey single-sided. ENDIF IF NATFRMT EQ 2 DPB0: CONKDS ; Cold-boot default of both drives is DPB1: CONKDS ; Conkey double-sided. ENDIF IF NATFRMT EQ 3 DPB0: FOREGN ; Cold-boot default of both drives is DPB1: FOREGN ; foreign ENDIF PAGE ; BDOS DISK OPERATION RAM LOCATIONS BRAM: ; BIOS RAM variables - no need to load from disk DIRBUF: DS 128 ALV0: DS 30 ALV1: DS 30 CSV0: DS 20H DS 20H ; Expansion space CSV1: DS 20H DS 20H ; Expansion space SKWTB1: DS 80 SKWTB2: DS 80 ; PHYSICAL DISK VARIABLES PHYTRK: DB 0 ; Physical track number PHYSEC: DB 0 ; Physical sector number PHYSID: DB 0 ; Physical side number PHYTDF: DB 0 ; Difference between track numbers on each side ; CBIOS DISK OPERATION RAM LOCATIONS DVAR0: DS 6 ; CURRENTLY COMMANDED CP/M DISK OPERATION ;1 byte - disk number ;2 bytes - track number ;1 byte - ACTUAL DISK sector number. ;1 byte - BDOS sector number ;1 byte - INDEX into actual disk sector. DVAR1: DS 6 ;Previous DISK operation variables. ;Where the hardware is set up for. ;The format is the same as DVAR0. DVAR2: DS 6 ;Previous CP/M operation variables. ;Write disk variables for re-writting ;previous data.The format is the same ;as DVAR0. DVAR3: DS 6 ;Write disk variables for writting ;to unallocated sectors. ;Format same as DVAR0, except DVAR3+5 ;holds sectors per block counter, ;which is decremented in SETNS DBUF0: DS 400H ;The actual disk sector buffer. 1k long CURBUF: DS 2 ;Points to the sector buffer. CURDMA: DS 2 ;Holds address of BDOS DMA address. BUFMOD: DS 1 ;If = 1, sector buffer contains unwritten data. WRTNB: DS 1 ;If = 1, sector buffer holds modified ;data to be written to an unallocated sector. FDCCMD: DS 1 ;Holds the single byte command for the FDC. ERRMSK: DS 1 ;Holds a mask value for FDC error status. ERRSTA: DS 1 ;Holds the actual error status from FDC. DSKMSG: DS 2 ;Holds starting address of disk error message. DSKFLG: DS 1 ;If = 1, write operation requested. ;If = 0, read operation requested. CURDPT: DS 2 ;Pointer to current DPT. CURDPB: DS 2 ;Pointer to current DPB. CURDTB: DS 2 ;Pointer to current DTB. CURTBL: DS 2 WRTTYP: DS 1 ;Holds value passed to WRITE from BDOS. ; 0 - normal sector write. ; 1 - write to directory sector. ; 2 - write to the first sector of new block. NMISAV: DS 12 ;Storage area for the data that is removed ;from the NMI location during disk I/O. MLPOS: DS 1 ;The line number of the modem port output. ;(used when simulating Form Feeds by counting ;Line Feeds). LSTSTA: DS 1 ;Holds the error value returned to BDOS ;at the last disk I/O operation. BTOP EQU $ NPHSEC EQU ((BRAM - CCP - 1)/PHSECZ) + 1 IF0 .RADIX 16 PRTVAL <*Top of BIOS=>,%BTOP .RADIX 10 PRTVAL <*BIOS Size=>,%(BTOP - BIOS) PRTVAL <*Space Above BIOS=>,%(0FFFFh - BTOP) PRTVAL <*TPA=>,%(CCP - 0100h) PRTVAL <*Number of phy. sectors for cold boot = >,%NPHSEC IF $ LT BIOS .PRINTX /ADDRESS OVERFLOW!/ ENDIF ENDIF .DEPHASE END ;CNKYOSnn.Z80