; Apr 19, 2007 ;TRS80 MODEL 4 Montezuma Micro BIOS Version 2.20 for CP/M V2.2. ;Disassembled by Luis C.Grosso. ;Most of the comments from the book: ;'SYSTEM PROGRAMMER'S GUIDE for the TRS-80 model 4/4P ;Using Montezuma Micro CP/M Vers 2.2' ;Routines not listed in the book commented by Luis C. Grosso. ;A '%' at the beginning of a comment indicates that the instruction ;references an address not listed in the book. ORG 0EA00H ; ********************************************************** ; * Standard BIOS jump vectors * ; ********************************************************** LEA00: JP LEA4B ;BOOT Cold stert LEA03: JP LEB61 ;WBOOT Warm start LEA06: JP LEBD0 ;CONST Console status LEA09: JP LEBF2 ;CONIN Console character in LEA0C: JP LEC02 ;CONOUT Console character out LEA0F: JP LEC1A ;LIST List character out LEA12: JP LEC3E ;PUNCH Punch character out LEA15: JP LEC52 ;READER Reader character in LEA18: JP LF1E5 ;% HOME Restore disk drive LEA1B: JP LF178 ;% SELDSK Select disk drive LEA1E: JP LF193 ;% SETTRK Set track number LEA21: JP LF19C ;% SETSEC Set sector number LEA24: JP LF1DD ;% SETDMA set DMA address LEA27: JP LF1ED ;% READ Read disk LEA2A: JP LF224 ;% WRITE Write disk LEA2D: JP LEC2C ;LISTST List status LEA30: JP LF1E2 ;% SECTRN Sector translation ; ********************************************************** ; * System Parameter block * ; * This block is used to contain configuration data of * ; * a general nature that is required by the BIOS and * ; * external routines that may need to modify it. * ; ********************************************************** LEA33: DEFB 81H ;IOBYTE: LPT,TTY,TTY,CRT +0 LEA34: DEFB 0BH ;Display sign on at boot +1 LEA35: DEFB 04H ;Total # of disk drives +2 LEA36: DEFB 20H ;BIOS version number +3 LEA37: DEFW LF6FD ;DPH table address +4 LEA38: DEFW LF655 ;Disk DCB 0 address +6 LEA3A: DEFW LF661 ;Disk DCB 1 address +8 LEA3C: DEFW LF66D ;Disk DCB 2 address +10 LEA3E: DEFW LF679 ;Disk DCB 3 address +12 LEA40: DEFW LEC73 ;Device driver address +14 LEA42: DEFW LEE9A ;Keyboard DCB +16 LEA45: DEFW LF08D ;Video display DCB +18 LEA47: DEFW LF124 ;Parallel port DCB +20 LEA49: DEFW LF172 ;Serial port DCB +22 ; ********************************************************** ; * BIOS Cold Start entry * ; * Input: None * ; * Output: None - System loaded into RAM * ; ********************************************************** ;BOOT LEA4B: LD SP,0000H ;Set stack at top of RAM CALL LECD3 ;% do a complete reset XOR A ;Current drive/user = A/0 LD (L0004),A ;Update current drive/user LD (LEB3F),A ;Kill drive M message (put end marker) DEC A ;Reset drive track history LD (LF65E),A ;Set track number to 'unknown' (0FFH) LD (LF66A),A ;in all DCBs LD (LF676),A LD (LF682),A LD HL,LF59C ;Point HL at first DPH LD BC,0010H ;BC=length of DPH LD (LF6FD),HL ;Set drive A in DPHTBL ADD HL,BC LD (LF6FF),HL ; Drive B ADD HL,BC LD (LF701),HL ; Drive C ADD HL,BC LD (LF703),HL ; Drive D LD HL,0000H ;Point to start of RAM LD A,0EFH ;Switch in expansion bank 0 OUT (084H),A ;Out to the operation register LD (HL),3CH ;Plug with inversion of C3 LD A,8FH ;swithc back to main RAM OUT (084H),A ;Out to the operation register LD A,(HL) ;Get test byte LD (HL),0C3H ;Replace in case it changed CP (HL) ;Is it unchanged? JR NZ,LEAAB ;Go if changed - not 128K LD A,0EFH ;Switch in expansion bank 0 OUT (084H),A ;Out to the operation register CALL LEABA ;Fill 32K with E5 bytes ADD HL,HL ;set HL back to 0000H LD A,0FFH ;Switch in expansion bank 1 OUT (084H),A ;Out to the operation register CALL LEABA ;Fill 32K with E5 bytes LD A,0DH ;Enable drive M message LD (LEB3F),A LD HL,LF5DC ;Set up DPH for M: LD (LF715),HL LD A,8FH ;Restore lower RAM map OUT (084H),A ;Out to the operation register LEAAB: LD HL,LEAC2 ;Point to opening banner LD A,(LEA34) ;Check the signon flag OR A CALL NZ,LED08 ;Display if requested LD C,00H ;Set default drive to A: JP LD400 ;Go to CP/M CCP LEABA: LD (HL),0E5H ;Store an E5 byte INC HL ;Advance pointer BIT 7,H ;Check bit 7 of address RET NZ ;Exit if at 32K JR LEABA ;Keep filling ; ; CP/M signon message ; ------------------- LEAC2: DEFB 1AH,07H,16H DEFB 'TRS-80 Model 4 64k CP/M vers 2.2 ' DEFB '(c) (p) 1982 Digital Research Inc.' DEFB 15H,0DH,0AH DEFB 'BIOS vers 2.22 (c) (p) 1984 Montezuma Micro/JBO' DEFB 15H,16H,0DH,0AH,0AH LEB3F: DEFB 0DH DEFB '>>> Memory Drive M: ',16H,'ENABLED',16H,0DH,0AH,0AH DEFB 00H ; ********************************************************** ; * BIOS Warm Start entry * ; * Input: None * ; * Output: None - System reloaded into RAM * ; ********************************************************** ;WBOOT LEB61: LD SP,0100H ;Use buffer for stack CALL LF307 ;% Clear the BIOS disk buffer CALL LECE0 ;% do a warm reset LD C,00H ;Drive A: CALL LF178 ;% Select the drive LD BC,000AH ;Offset to address of DPB in DPH ADD HL,BC ;Point to the DPB address pointer LD A,(HL) ;Get the address of DPB INC HL LD H,(HL) LD L,A LD A,(HL) ;Records/track to HL INC HL LD H,(HL) LD L,A LD (LF734),HL ;Save it LD HL,0000H ;Set starting track LD (LF730),HL LD L,02H ;set starting sector LD (LF732),HL LD HL,LD400 ;set beginning DMA (CCP address) LD (LF725),HL LD B,2CH ;Set record counter LEB91: PUSH BC ;Save record counter LD BC,(LF730) ;Set the track CALL LF193 ;% SETTRK LD BC,(LF732) ;Set the sector CALL LF19C ;% SETSEC CALL LF1ED ;% Read the record OR A ;Any error? JR NZ,LEB61 ;If so start all over LD HL,LF730 ;Update record # CALL LF290 ;% increment track if necessary LD HL,(LF725) ;Update DMA LD BC,0080H ADD HL,BC LD (LF725),HL POP BC ;Restore record counter DJNZ LEB91 ;Loop until complete LD A,(L0004) ;Get current drive # AND 0FH ;Mask off user code LD C,A ;Drive # to C CALL LF178 ;% Select it (validate) LD A,H ;Check for validity OR L JR NZ,LEBC9 ;Go if valid drive LD (L0004),A ;Reset to USER 0, A: LEBC9: LD A,(L0004) ;Get User/Default Drive LD C,A JP LD403 ;Go to CCP ; ********************************************************** ; * Report console status * ; * Input: None * ; * Output: A=FFH if input present * ; * 00H if no input present * ; ********************************************************** ;CONST LEBD0: CALL LEC12 ;Get CON IOBYTE JR Z,LEBE0 ;Go if BAT status CALL LEC64 ;Call IO dispatcher DEFW LEC73 ; TTY status DEFW LEC7B ; CRT status DEFW LECCB ; BAT status (dummy entry) DEFW LEC83 ; UC1 status LEBE0: LD A,(L0003) ;Get the IOBYTE RRCA ;Isolate RDR bits RRCA AND 03H CALL LEC64 ;Call IO dispatcher DEFW LEC73 ; TTY status DEFW LEC9B ; PTR status DEFW LECA3 ; UR1 status DEFW LECAB ; UR2 status ; ********************************************************** ; * Console input * ; * Input: None * ; * Output: A=Character input from console * ; ********************************************************** ;CONIN LEBF2: CALL LEC12 ;Get CON IOBYTE JR Z,LEC52 ;Go if BAT CALL LEC64 ;Call I/O dispatcher DEFW LEC75 ; TTY input DEFW LEC7D ; CRT input DEFW LECCD ; BAT input (Dummy entry) DEFW LEC85 ; UC1 input ; ********************************************************** ; * Console output * ; * Input: C=character to be output to console * ; * Output: None * ; ********************************************************** ;CONOUT LEC02: CALL LEC12 ;Get CON IOBYTE JR Z,LEC1A ;Go if BAT CALL LEC64 ;Call I/O dispatcher DEFW LEC77 ; TTY output DEFW LEC7F ; CRT output DEFW LECCC ; BAT output (Dummy entry) DEFW LEC87 ; UC1 output ; ********************************************************** ; * Return CON IOBYTE value * ; * Input: None * ; * Output: A=CON IOBYTE value, Z flag set if BAT * ; ********************************************************** LEC12: LD A,(L0003) ;Get the IOBYTE AND 03H ;Isolate CON bits CP 02H ;Check for BAT RET ; ********************************************************** ; * Output character to LST device * ; * Input: C=character to be output * ; * Output: None * ; ********************************************************** ;LIST LEC1A: LD A,(L0003) ;Get the IOBYTE RLCA ;Isolate LST bits RLCA AND 03H CALL LEC64 ;Call I/O dispatcher DEFW LEC77 ; TTY output DEFW LEC7F ; CRT output DEFW LEC8F ; LPT output DEFW LEC97 ; UL1 output ; ********************************************************** ; * Return LST status * ; * Input: None * : * Output: A=LST status * ; ********************************************************** ;LISTST LEC2C: LD A,(L0003) ;Get the IOBYTE RLCA ;Isolate LST bits RLCA AND 03H CALL LEC64 ;Call I/O dispatcher DEFW LEC79 ; TTY busy DEFW LEC81 ; CRT busy DEFW LEC91 ; LPT busy DEFW LEC99 ; UL1 busy ; ********************************************************** ; * Output character to PUN devivce * ; * Input: C=character to be output * ; * Output: None * ; ********************************************************** ;PUNCH LEC3E: LD A,(L0003) ;Get IOBYTE RLCA ;Isolate PUN bits RLCA RLCA RLCA AND 03H CALL LEC64 ;Call I/O dispatcher DEFW LEC77 ; TTY output DEFW LECB7 ; PTP output DEFW LECBF ; UP1 output DEFW LECC7 ; UP2 output ; ********************************************************** ; * Input from RDR device * ; * Input: None * ; * Output: A=Character input * ; ********************************************************** ;READER LEC52: LD A,(L0003) ;Get IOBYTE RRCA ;Isolate RDR bits RRCA AND 03H CALL LEC64 ;Call I/O dispatcher DEFW LEC75 ; TTY input DEFW LEC9D ; PTR input DEFW LECA5 ; UR1 input DEFW LECAD ; UR2 input ; ********************************************************** ; * I/O dispatch routine * ; * Input: A=device code (0-3) * ; * (SP)=pointer to address table * ; * Output: None - goes to device routine * ; ********************************************************** LEC64: POP HL ;Table pointer to HL ADD A,A ;Compute offset LD E,A ;Move offset to DE LD D,00H ADD HL,DE ;Point to address LD E,(HL) ;DE=vector pointer INC HL LD D,(HL) EX DE,HL ;HL=vector pointer LD E,(HL) ;Vector to DE INC HL LD D,(HL) EX DE,HL ;HL=driver address JP (HL) ;Exit to device driver ; ********************************************************** ; * Device Driver Address Table * ; ********************************************************** ; ; TTY definitions ; --------------- LEC73: DEFW LF128 ;Serial port status LEC75: DEFW LF130 ;Serial port input LEC77: DEFW LF13B ;Serial port output LEC79: DEFW LF144 ;Serial port busy ; ; CRT definitions ; --------------- LEC7B: DEFW LED51 ;Ketboard status LEC7D: DEFW LED61 ;Keyboard input LEC7F: DEFW LEF46 ;Video output LEC81: DEFW LECD0 ;Null busy ; ; UC1 definitions ; --------------- LEC83: DEFW LED51 ;Keyboard status LEC85: DEFW LED61 ;keyboard input LEC87: DEFW LEF46 ;Video output LEC89: DEFW LECD0 ;Null busy ; ; LPT definitions ; --------------- LEC8B: DEFW LECCB ;Null status LEC8D: DEFW LECCD ;Null input LEC8F: DEFW LF0BF ;Parallel port output LEC91: DEFW LF0B3 ;Parallel port busy ; ; UL1 definitions ; --------------- LEC93: DEFW LECCB ;Null status LEC95: DEFW LECCD ;null input LEC97: DEFW LF0BF ;Parallel port output LEC99: DEFW LF0B3 ;Parallel port busy ; ; PTR definitions ; --------------- LEC9B: DEFW LED51 ;Keyboard status LEC9D: DEFW LED61 ;Keyboard input LEC9F: DEFW LECCC ;Null output LECA1: DEFW LECD0 ;Null busy ; ; UR1 definitions ; --------------- LECA3: DEFW LF128 ;Serial port status LECA5: DEFW LF130 ;Serial port input LECA7: DEFW LF13B ;Serial port output LECA9: DEFW LF144 ;Serial port busy ; ; UR2 definitions ; --------------- LECAB: DEFW LF128 ;Serial port status LECAD: DEFW LF130 ;Serial port input LECAF: DEFW LF13B ;Serial port output LECB1: DEFW LF144 ;Serial port busy ; ; PTP definitions ; --------------- LECB3: DEFW LECCB ;Null status LECB5: DEFW LECCD ;Null input LECB7: DEFW LEF46 ;Video output LECB9: DEFW LECD0 ;Null busy ; ; UP1 definitions ; --------------- LECBB: DEFW LF128 ;Serial port status LECBD: DEFW LF130 ;Serial port input LECBF: DEFW LF13B ;Serial port output LECC1: DEFW LF144 ;Serial port busy ; ; UP2 definitions ; --------------- LECC3: DEFW LF128 ;Serial port status LECC5: DEFW LF130 ;Serial port input LECC7: DEFW LF13B ;Serial port output LECC9: DEFW LF144 ;Serial port busy ; ********************************************************** ; * Null device drivers * ; * Input: None expected * ; * Output: None * ; ********************************************************** LECCB: XOR A ;Null status LECCC: RET ;Null output LECCD: LD A,1AH ;Null input RET LECD0: LD A,0FFH ;Null busy RET ;START OF ROUTINES NOT LISTED IN THE BOOK ;CLEAR SOME AREAS, INIT DEVICES, UPDATE PSP JUMPS LECD3: CALL LED23 ;clear the following memory area DEFW LF6FD ;DPH table address DEFW 0020H ;32 bytes to fill CALL LF085 ;initialize video display DCB fields CALL LF165 ;initialize serial port LECE0: CALL LED23 ;clear the following memory area DEFW LF71D ;CP/M system variables DEFW 0023H ;35 bytes LD A,(LEA33) ;get the default IOBYTE LD (L0003),A ;update the IOBYTE CALL LEE8C ;initialize keyboard DCB CALL LF119 ;initialize parallel port DCB LD A,0C3H ;the opcode of JP LD (0000H),A ;place a JP at PSP wboot entry point LD (0005H),A ;place a JP at PSP bdos entry point LD HL,LEA03 ;the BIOS warm boot vector LD (0001H),HL ;update the JP argument LD HL,LDC06 ;the bdos entry point LD (0006H),HL ;update the JP argument RET ;ret ; display the ASCIIZ string pointed by HL LED08: LD A,(HL) ;get a character from text INC HL ;increment pointer OR A ;is it the end marker? RET Z ;ret if yes PUSH HL ;push the pointer LD C,A ;pass the character to C CALL LEC02 ;display the character POP HL ;pop the pointer JR LED08 ;process next character ;TIME DELAY ;In :A=time delay in msec's LED14: PUSH BC ;push BC LED15: LD B,99H ;these two LED17: DJNZ LED17 ;loops produce a delay LD B,9AH ;of approximatedly LED1B: DJNZ LED1B ;one milisecond NOP ;just a NOP DEC A ;decrement msec counter JR NZ,LED15 ;loop back if not zero POP BC ;pop BC RET ;and ret ;FILL A MEMORY AREA WITH ZEROES ; In:=parameters are passed as DEFW after the CALL LED23 this way ; CALL LED23 ; DEFW start address for filling ; DEFW number of bytes to fill ; LED23: XOR A ;fill memory with zeroes EX (SP),HL ;save HL, get the return address LD E,(HL) ;get the start address lo byte INC HL ;increment pointer LD D,(HL) ;get the start address hi byte INC HL ;increment pointer LD C,(HL) ;get the byte count lo byte INC HL ;increment pointer LD B,(HL) ;get the byte count hi byte INC HL ;increment pointer EX (SP),HL ;get HL, push the updated return address LED2E: LD H,D ;pass the start LD L,E ;address to HL LD (HL),A ;clear the first byte DEC BC ;one less to clear LD A,B ;is the byte count OR C ;equal to zero? RET Z ;ret if yes, else.. INC DE ;point to next byte LDIR ;clear the rest using LDIR RET ;ret ; increment the 16 bits variable pointed by HL LED39: INC (HL) ;increment low byte RET NZ ;ret if not zero, no carry to high byte INC HL ;point to high byte INC (HL) ;increment it DEC HL ;point back to low byte RET ;ret ; compare two 16 bit variables ; In:HL=first variable to be compared ; :DE=second variable ;Out:ZF set if both variables match LED3F: INC DE ;point DE to 2nd var high byte INC HL ;point HL to 1st var high byte LD A,(DE) ;get high byte and CP (HL) ;compare with the other byte DEC DE ;point back to DEC HL ;low bytes RET NZ ;ret with ZF reset if no match LD A,(DE) ;now compare CP (HL) ;low bytes RET ;ret with proper flags ; compare two memory blocks ; In:DE=start of first block ; :HL=start of second block ; : B=number of bytes to compare ;Out:ZF set if blocks compare OK LED49: LD A,(DE) ;get a byte from first block INC DE ;increment first pointer CP (HL) ;compare with byte in 2nd block INC HL ;increment second pointer RET NZ ;ret if bytes do not matsc, else DJNZ LED49 ;compare next byte RET ;and ret ;END OF ROUTINES NOT LISTED IN THE BOOK ; ********************************************************** ; * Keyboard device drivers * ; * Input: None * ; * Output: Dependent of function * ; ********************************************************** ; ; Return keyboerd status in A ; --------------------------- LED51: LD A,(LEE9A) ;Check key buffer OR A JR NZ,LED5E ;Go if key there CALL LED6F ;Scan the keyboard RET Z ;Exit if no key LD (LEE9A),A ;Save the key found LED5E: OR 0FFH ;Set status RET ; ; Input from keyboard and return key in A ; --------------------------------------- LED61: LD HL,LEE9A ;Point to key buffer LD A,(HL) ;Empty it LD (HL),00H OR A ;Check for key RET NZ ;Exit if found LED69: CALL LED6F ;Scan the keyboard JR Z,LED69 ;Loop if no key RET ; ; General keyboard scan - key returned in A if found ; LED6F: DI ;No interrupts LD A,8EH ;Switch keyboard into RAM OUT (084H),A ;Out to the operation register CALL LEE24 ;Check function keys JP NZ,LEE1C ;Go if key found LED7A: LD DE,0F401H ;Point to first row LD B,00H ;Initialize row # LD HL,LEE9D ;Point DE at history table LED82: LD A,(DE) ;Strobe the keyboard LD C,A ;Save strobe in C XOR (HL) ;Mask off pro=ior keys LD (HL),C ;Save current scan AND C ;Mask released keys JR NZ,LEDC6 ;Go if any key pressed INC B ;Update row # INC HL ;Update history pointer RLC E ;Move to next key row JP P,LED82 ;Loop if any rows left LD A,(LEEA5) ;Point DE at Prv Key Row LD E,A LD A,(DE) ;Scan the row again LD C,A ;Save the scan LD HL,(LEEA6) ;Point HL at Prv Key Image LD A,(HL) ;Get previous image AND C ;Key still down? JR NZ,LEDAA ;Go if yes SBC HL,HL ;Clear repeat counter LD (LEEAA),HL LD HL,0800H ;Reset delay counter LD (LEEA8),HL JR LEE1C ;Exit with no key LEDAA: XOR A ;Clear carry & A EX DE,HL ;History pointer to DE LD HL,(LEEAA) ;Repeat counter to HL INC HL ;Increment the count LD (LEEAA),HL ;Save the counter LD BC,(LEEA8) ;Get the delay value SBC HL,BC ;Delay long enough? JR C,LEE1C ;Exit if no time-out LD (DE),A ;Clear history for rescan LD (LEEAA),HL ;Save zeroed counter LD L,80H ;Set short delay LD (LEEA8),HL JR LED7A ;Go scan again LEDC6: LD C,A ;True scan to C CALL LEE84 ;Do debounce delay JR Z,LEE1C ;Exit if no key LD A,E ;Save row bit LD (LEEA5),A LD (LEEA6),HL ;Save image pointer SLA B ;Multiply row # by 8 SLA B SLA B DEC B ;Precomp for shift LEDDA: INC B ;Update char position SRL C ;shift strobe bit left 1 JR NC,LEDDA ;Loop till it falls off LD HL,LEEA4 ;Point HL at control image LD A,B ;Get table offset CP 20H ;In alpha keys? JR NC,LEE02 ;Go if not BIT 2,(HL) ;Control pressed? JR NZ,LEE1C ;Exit if yes SET 6,B ;Convert offset to ASCII OR A ;Is this '@' key? JR Z,LEE1B ;Exit if yes LD A,(LEEAC) ;Get CAPS lock flag OR A ;CAPS locked? JR NZ,LEE1B ;Go if yes SET 5,B ;Make lower case LD A,03H ;Check shift keys AND (HL) ;Is either one down? JR Z,LEE1B ;Go if not LD A,20H ;Invert bit 5 XOR B JR LEE1C ;Exit with key LEE02: SUB 20H ;Calculate offset LD C,A ;Put in BC LD B,00H LD DE,LEEAD ;Decode table base to DE EX DE,HL ;Move to HL, KBDHST to DE ADD HL,BC ;Point to standard table LD BC,0018H ;Table length to BC LD A,(DE) ;Isolate CTRL,SHIFT keys AND 07H JR Z,LEE1A ;Go if neigther down ADD HL,BC ;Move to shift table AND 04H ;Isolate CTRL key JR Z,LEE1A ;Go if only SHIFT ADD HL,BC ;Move to CTRL table LEE1A: LD B,(HL) ;Get decoded key in B LEE1B: LD A,B ;Return key to A LEE1C: LD C,A ;Store character in C LD A,8FH ;Switch out keyboard OUT (084H),A ;Out to the operation register LD A,C ;Restore the key if any OR A ;Set Z if no key found RET ; ; Scan function keys ; LEE24: LD HL,(LEE9B) ;Get function key pointer LD A,H ;Is a key active? OR L JR NZ,LEE77 ;Go if yes LD DE,0F47FH ;Set DE for rows 0-6 LD C,E ;Preset key mask LD A,(DE) ;Strobe rows 0-6 OR A ;Anything down JR Z,LEE35 ;Go if not LD C,07H ;Must ignore F1,F2,F3,CAPS LEE35: LD HL,LEEA4 ;Point HL at row 7 image INC E ;Set DE for row 7 LD A,(DE) ;Strobe row 7 AND C ;Mask off if necessary LD C,A ;Result in C XOR (HL) ;Set changed bits LD (HL),C ;Save current scan AND C ;Mask released keys RET Z ;Exit if no key down LD C,A ;Corrected scan to C CALL LEE84 ;Do debounce delay RET Z ;Exit if no key down BIT 3,C ;CAPS key down? JR Z,LEE58 ;Go if not LD A,(LEEAC) ;Toggle the flag XOR 01H LD (LEEAC),A PUSH BC ;Save registers LD C,28H ;Set counter for short beep CALL NZ,LEFEE ;Beep if locking POP BC LEE58: LD A,70H ;check function keys AND C RET Z ;Exit if none down RLCA ;Prepare to position EX DE,HL ;History pointer to DE LD HL,LEF10 ;Point HL at decode table LD BC,0009H ;Set BC to 1 entry length LEE64: SBC HL,BC ;Back up table pointer RLCA ;Check next F key bit JR NC,LEE64 ;Loop until found LD C,1BH ;Preload for next round LD A,(DE) ;Get key scan from KBDHST AND 03H ;Check the SHIFT keys JR NZ,LEE76 ;Go if eigther down LD A,(DE) ;Get key scan again AND 04H ;Check the CTRL key JR Z,LEE77 ;Go if not pressed ADD HL,BC ;Move down one group LEE76: ADD HL,BC ;Move down one group LEE77: LD A,(HL) ;Get next keystroke INC HL ;Update pointer OR A ;End of definition? LD (LEE9B),HL ;save def pointer RET NZ ;Exit if valid key LD H,A ;Clear the pointer LD L,A LD (LEE9B),HL RET ;Exit with key ; ; Debounce a key ; LEE84: LD A,0FH ;Set time (app. 15 ms) CALL LED14 ;% Do the delay LD A,(DE) ;Scan keyboard agein AND C ;Mask off released keys RET ; ; Initialize keyboard DCB ; LEE8C: CALL LED23 ;Clear DCB fields DEFW LEE9A DEFW 0012H LD HL,0800H ;Reset repeat counter LD (LEEA8),HL RET ; ; Keyboard Device Control Block ; LEE9A: DEFB 00H ;Character buffer LEE9B: DEFW 0000H ;Function key pointer LEE9D: DEFB 00H ;History for row 0 DEFB 00H ;History for row 1 DEFB 00H ;History for row 2 LEEA0: DEFB 00H ;History for row 3 DEFB 00H ;History for row 4 DEFB 00H ;History for row 5 DEFB 00H ;History for row 6 LEEA4: DEFB 00H ;History for row 7 LEEA5: DEFB 08H ;Previous key row bit LEEA6: DEFW LEEA0 ;Previous key image pointer LEEA8: DEFW 0800H ;Delay before repeating LEEAA: DEFW 0000H ;Delay between repeats LEEAC: DEFB 01H ;CAPS lock flag ; ; Unshifted keys LEEAD: DEFB '01234567' ;0 1 2 3 4 5 6 7 DEFB '89:;,-./' ;8 9 : ; , - . / DEFB 0DH,18H,03H,0BH ;ENTER CLEAR BREAK UP DEFB 0AH,08H,09H,20H ;DOWN LEFT RIGHT SPACE ; ; Shifted keys LEEC5: DEFB '0!',22H,'#$%&',27H ;0 1 2 3 4 5 6 7 DEFB '()*+<=>?' ;8 9 : ; , - . / DEFB 0DH,1BH,03H,0BH ;ENTER CLEAR BREAK UP DEFB 0AH,08H,09H,20H ;DOWN LEFT RIGHT SPACE ; ; Control keys LEEDD: DEFB 30H,7CH,32H,7EH,34H,5EH,36H,60H ;0 1 2 3 4 5 6 7 DEFB 5BH,5DH,3AH,3BH,7BH,5FH,7DH,5CH ;8 9 : ; , - . / DEFB 0DH,7FH,03H,0BH ;ENTER CLEAR BREAK UP DEFB 0AH,08H,09H,20H ;DOWN LEFT RIGHT SPACE ; ; Function key definition table (9 bytes per entry) ; ------------------------------------------------- LEEF5: DEFB 'DIR A:',0DH DEFW 0000H DEFB 'DIR B:',0DH DEFW 0000H DEFB 'DIR M:',0DH DEFW 0000H LEF10: DEFB 'PIP A:=' DEFW 0000H DEFB 'PIP B:=' DEFW 0000H DEFB 'PIP M:=' DEFW 0000H LEF2B: DEFB 'DUP',0DH DEFB 00H,00H,00H,00H,00H DEFB 'CONFIG',0DH DEFW 0000H DEFB 'STAT ' DEFB 00H,00H,00H,00H ; ********************************************************** ; * Video Display drivers * ; * Input: Dependent on function * ; * Output: None returned to caller * ; ********************************************************** ; ; Output character in C to Video Display ; -------------------------------------- LEF46: DI ;No interrupts LD A,8EH ;Switch video into RAM OUT (084H),A ;Out to the operation register LD A,(LF08D) ;Get character at cursor CALL LEF6F ;Replace it in Video Ram CALL LEF8B ;Process input character CALL LEF6A ;Get character at cursor LD (LF08D),A ;Save in DCB BIT 7,A ;Is character inverted? JR Z,LEF60 ;Go if not LD A,9BH ;Set in alternate cursor LEF60: OR 80H ;Insure reverse video CALL LEF6F ;Output cursor LD A,8FH ;Switch out Video OUT (084H),A ;Out to the operation register RET ; ; Get a character from Video RAM at cursor ; ---------------------------------------- LEF6A: CALL LEF74 ;Point HL at cursor position LD A,(HL) ;Get the character RET ; ; Put a character into Video RAM at cursor ; ---------------------------------------- LEF6F: CALL LEF74 ;Point HL at cursor position LD (HL),A ;Output the character RET ; ; Point HL at cursor position in Video RAM ; ---------------------------------------- LEF74: LD HL,(LF08E) ;Get cursor column & row ; ; Compute RAM address for position (L=Row, H=Col) ; ----------------------------------------------- LEF77: PUSH BC ;Save work register PUSH DE LD BC,0F800H ;Video RAM base to BC LD D,C ;Row # to DE LD E,L LD C,H ;Column # to C LD H,D ;Row # also in HL ADD HL,HL ;HL=Row # * 4 ADD HL,HL ADD HL,DE ;HL=Row # * 5 (4+1) ADD HL,HL ;HL=Row # * 80 (80=5*16) ADD HL,HL ADD HL,HL ADD HL,HL ADD HL,BC ;Add video base, column # POP DE ;Restore registers POP BC RET ; ; Process video output characters ; ------------------------------- LEF8B: LD A,(LF091) ;Get ESC sequence control OR A ;In ESC sequence? JR NZ,LEFA3 ;Go if yes LD A,C ;Get the character CP 20H ;Control code? JR C,LEFD9 ;Go if yes LD A,(LF090) ;Get inverse video mask OR C ;Combine with character CALL LEF6F ;Output to video display LD HL,(LF08E) ;Cursor Column,Row to HL JP LF024 ;Cursor right and exit ; ; Video Display ESC Sequence Handler ; ---------------------------------- LEFA3: CP 02H ;Check state of ESC JR C,LEFB3 ;Go if state 1 JR Z,LEFC7 ;Go if State 2 LD A,C ;Get input character CP 3DH ;Must be '=' LD A,02H ;Set next state in A JR Z,LEFD5 ;Go if valid XOR A ;Clear state variable JR LEFD5 ; and exit LEFB3: LD A,(LF092) ;Get saved Row LD L,A ;Put it in L LD A,C ;Get input Column SUB 20H ;Convert to actual CP 50H ;Is column # valid? JR C,LEFC0 ;Skip next if so LD A,4FH ;Move to last column LEFC0: LD H,A ;Put it in H LD (LF08E),HL ;Store as new cursor XOR A ;Clear state variable JR LEFD5 ; and exit LEFC7: LD A,C ;Get the input character SUB 20H ;Convert to acual row CP 18H ;Is it valid? JR C,LEFD0 ;Skip next if it is LD A,17H ;Move to last row LEFD0: LD (LF092),A ;Store in DCB LD A,01H ;Set next state in A LEFD5: LD (LF091),A ;Save state variable RET ; and exit ; ; Video Display Control Code processing ; ------------------------------------- LEFD9: LD HL,LF093 ;HL=Code Address Table LD B,00H ;Table offset in BC ADD HL,BC ;Index to routine offset LD A,(HL) ;Pick up routine offset OR A ;Is the code defined? RET Z ;Ignore if not LEFE2: LD HL,LEFE2 ;Point HL at base address VDCTL1 LD C,A ;Add offset for this code ADD HL,BC PUSH HL ;Routine addreee to stack LD HL,(LF08E) ;Cursor Column,Row to HL RET ;Go to it ; ; Sound the built-in speaker ; -------------------------- LEFEC: LD C,00H ;Set duration counter LEFEE: LD A,01H ;Set bit 0 on LD B,64H ;Set pitch counter LEFF2: OUT (090H),A ;Crank up a wave DJNZ LEFF2 XOR A ;Turn bit 0 off LD B,64H ;Reset pitch counter LEFF9: OUT (090H),A ;Let the wave die DJNZ LEFF9 DEC C ;Count down duration JR NZ,LEFEE ;Loop until timeout RET ; ; Move the cursor left 1 position ; ------------------------------- LF001: LD A,H ;At top of screen? OR L JR Z,LF032 ;Go if yes DEC H ;Back up one position JP P,LF032 ;Exit if no wrap LD H,4FH ;Move to end of line JR LF01C ; and back up 1 row ; ; Move cursor to next tab stop ; ---------------------------- LF00D: LD A,H ;Column # to A AND 0F8H ;Make it 0 mod 8 ADD A,08H ;Move to next tab stop LD H,A CP 50H ;Line overflow? JR C,LF032 ;Exit if not LD H,00H ;Move down one line ; ; Move cursor down 1 line ; ----------------------- LF019: INC L ;Increment the row # JR LF032 ; ; Move cursor up 1 line ; --------------------- LF01C: DEC L ;Back up 1 row JP P,LF032 ;Go if not negative LD L,00H ;Hold on top line JR LF032 ; ; Move cursor right 1 position ; ---------------------------- LF024: INC H ;Advance 1 column LD A,H ;Get the new column CP 50H ;Still on line? JR C,LF032 ;Go if yes LD H,00H ;Move to next line JR LF019 ; ; Perform Cursor Home ; ------------------- LF02E: LD L,00H ;Set row # to 0 ; ; Perform Carriage Return ; ----------------------- LF030: LD H,00H ;Set column # to 0 ; ; Check cursor position & scroll if necessary ; ------------------------------------------- LF032: LD A,L ;Get the cursor Row # CP 18H ;Is it on-screen? LD (LF08E),HL ;Save the cursor RET C ;Exit if on screen LD L,17H ;Stay on line 23 LD (LF08E),HL ;Save the cursor LD HL,0F850H ;Point HL at second line LD DE,0F800H ;Point DE at top of screen LD BC,0730H ;Move 23 lines of video (80*23) LDIR ;Scroll Video Ram LD HL,0017H ;Set Row=23 , Column=0 JR LF05E ;Clear new line and exit ; ; Erase to end of current line ; ---------------------------- LF04E: PUSH HL ;Save cursor position LD H,50H ;Set to end of line + 1 CALL LEF77 ;Calculate RAM address EX DE,HL ;Put in DE POP HL ;Restore cursor JR LF061 ;Go clear ; ; Home the cursor and clear the screen ; ------------------------------------ LF058: LD HL,0000H ;Set cursor at 0,0 LD (LF08E),HL ;save it in DCB ; ; Erase to end of screen ; ---------------------- LF05E: LD DE,0FF80H ;Set end address LF061: CALL LEF77 ;Calc start address EX DE,HL ;Start to DE, end to HL LD A,(LF090) ;Get inverse video mask OR 20H ;Create a blank SBC HL,DE ;Compute clear length LD B,H ;Move length to BC LD C,L JP LED2E ;Fill memory and exit ; ; Turn inverse video OFF ; ---------------------- LF071: XOR A ;Clear the flag JR LF07C ;Go store it ; ; Turn inverse video ON ; --------------------- LF074: XOR A ;Clear the flag JR LF07A ;toggle & store it ; ; Toggle state of inverse video ; ----------------------------- LF077: LD A,(LF090) ;Get inverse video mask LF07A: XOR 80H ;Reverse it LF07C: LD (LF090),A ;Replace in DCB RET ; ; Start an Escape sequence ; ------------------------ LF080: LD A,03H ;Set ESC state variable JP LEFD5 ; and exit ; ; Initialize Video Display DCB fields ; ----------------------------------- LF085: CALL LED23 ;Clear DCB fields DEFW LF08E ;Video DCB address DEFW 0005H ;Length RET ; ; Video Display Device Control Block ; ---------------------------------- LF08D: DEFB 20H ;Character under cursor LF08E: DEFB 11H ;Cursor row (0-23) LF08F: DEFB 00H ;Cursor column (0-79) LF090: DEFB 00H ;Inverse video mask LF091: DEFB 00H ;Escape sequence control LF092: DEFB 0FH ;Escape sequence storage ; ; Control Code Address Table ; -------------------------- LF093: DEFB 00H ;Code 00 - ignored 00 DEFB 00H ;Code 01 - ignored 00 DEFB 00H ;Code 02 - ignored 00 DEFB 00H ;Code 03 - ignored 00 DEFB 00H ;Code 04 - ignored 00 DEFB 00H ;Code 05 - ignored 00 DEFB 00H ;Code 06 - ignored 00 DEFB LEFEC-LEFE2 ;Code 07 - Sound bell 0A DEFB LF001-LEFE2 ;Code 08 - Backspace 1F DEFB LF00D-LEFE2 ;Code 09 - Tab 2B DEFB LF019-LEFE2 ;Code 0A - Line feed 37 DEFB LF01C-LEFE2 ;Code 0B - Vertical tab 3A DEFB LF024-LEFE2 ;Code 0C - Cursor right 42 DEFB LF030-LEFE2 ;Code 0D - Carriage return 4E DEFB LF071-LEFE2 ;Code 0E - Inverse video OFF 8F DEFB LF074-LEFE2 ;Code 0F - Inverse video ON 92 DEFB 00 ;Code 10 - ignored 00 DEFB 00 ;Code 11 - ignored 00 DEFB 00 ;Code 12 - ignored 00 DEFB 00 ;Code 13 - ignored 00 DEFB 00 ;Code 14 - ignored 00 DEFB LF04E-LEFE2 ;Code 15 - Erase to EOL 6C DEFB LF077-LEFE2 ;Code 16 - Toggle inverse 95 DEFB LF05E-LEFE2 ;Code 17 - ignored? era to EOS 7C DEFB LF04E-LEFE2 ;Code 18 - ignored? era to EOL 6C DEFB LF05E-LEFE2 ;Code 19 - Erase to EOS 7C DEFB LF058-LEFE2 ;Code 1A - Home & clear 76 DEFB LF080-LEFE2 ;Code 1B - Start of ESC 9E DEFB 00 ;Code 1C - ignored 00 DEFB 00 ;Code 1D - ignored 00 DEFB LF02E-LEFE2 ;Code 1E - Home cursor 4C DEFB 00 ;Code 1F - ignored 00 ; ********************************************************** ; * Parallel Port device drivers * ; * Input: Dependent on function * ; * Output: Dependent on function * ; ********************************************************** ; ; Check port for busy and/or error - return in A ; ---------------------------------------------- LF0B3: IN A,(0F8H) ;Read port status AND 0F0H ;Isolate status bits XOR 30H ;Invert negative logic bits JR Z,LF0BD ;Go if ready LD A,01H ;Preset for zero return LF0BD: DEC A ;Set A to 00H or FFH RET ; ; Output C to parallel port ; ------------------------- LF0BF: LD HL,LF125 ;Point at option bits LD A,C ;Get character to print CP 20H ;Is it a control code? JR NC,LF0F4 ;Go if not CP 0AH ;Is it line feed? JR NZ,LF0D8 ;Go if not BIT 0,(HL) ;Suppress line feeds? JR Z,LF0F4 ;Go if not LD A,(LF124) ;Cgeck previous character CP 0DH ;Was it carriage return? JR Z,LF0FC ;Exit if so JR LF0F4 ;Go print the line feed LF0D8: CP 0CH ;Is this a form feed? JR NZ,LF0F4 ;Go if not BIT 1,(HL) ;Simulate form feeds? JR Z,LF0F4 ;Go if not LD A,(LF126) ;Get line counter OR A ;Anything left on page? JR Z,LF108 ;Exit if not LD B,A ;Set up loop counter LF0E7: CALL LF0B3 ;Wait for printer ready JR Z,LF0E7 ; LD A,0AH ;Output a line feed OUT (0F8H),A ; DJNZ LF0E7 ;Loop through the page JR LF10E ;Exit ; ; Print the character in C ; ------------------------ LF0F4: CALL LF0B3 ;Wait for printer ready JR Z,LF0F4 LD A,C ;Print the character OUT (0F8H),A ; ; Check for line feed, count down if so ; ------------------------------------- LF0FC: LD A,0AH ;Set A to line feed CP C ;Did we just do one? JR NZ,LF108 ;Exit if not LD A,(LF126) ;Decrement line counter DEC A LD (LF126),A ; ; Reset line counter if zero, exit ; -------------------------------- LF108: LD A,(LF126) ;Get line counter OR A ;Is it zero? JR NZ,LF114 ;Exit if not LF10E: LD A,(LF127) ;Reset line counter LD (LF126),A ; ; Save character and exit ; ----------------------- LF114: LD A,C ;Save character in DCB LD (LF124),A RET ; ; Initialize parallel port DCB ; ---------------------------- LF119: LD A,(LF127) ;Reset line counter LD (LF126),A XOR A ;Kill previous character LD (LF124),A RET ; ; Parallel port DCB ; ----------------- LF124: DEFB 00 ;Previous character LF125: DEFB 00 ;Option bits ; ; 0=Suppress LF after CR ; ; 1=Simulate form feeds ; ; 2-7=Reserved LF126: DEFB 46H ;Line counter LF127: DEFB 46H ;Page length ; ********************************************************** ; * Serial Port device drivers * ; * Input: Dependent on function * ; * Output: Dependent on function * ; ********************************************************** ; ; Check for input at Serial Port, return status in A ; -------------------------------------------------- LF128: IN A,(0EAH) ;Get UART status AND 80H ;Isolate data received bit RET Z ;Exit if nothing OR 0FFH ;Set status to show input RET ; ; Input a byte from the Serial Port ; --------------------------------- LF130: IN A,(0EAH) ;Get UART status AND 80H ;Anything received? JR Z,LF130 ;Loop if not IN A,(0EBH) ;Read data byte AND 07FH ;Mask off parity bit RET ; ; Output a byte to the Serial Port ; -------------------------------- LF13B: CALL LF144 ;Is the port busy? JR Z,LF13B ;Loop until ready LD A,C ;Get output byte OUT (0EBH),A ;Output it RET ; ; Check Serial Port for busy ; -------------------------- LF144: IN A,(0EAH) ;Get UART status AND 40H ;Ready to Xmit? RET Z ;Exit if not LD HL,LF175 ;Point to options byte BIT 0,(HL) ;wait for CTS enabled? JR Z,LF157 ;Go if not IN A,(0E8H) ;Get secondary status AND 80H ;Check CTS input bit XOR 80H ;Invert state of CTS ; ; Above changed to NOP in 2.22 RET Z ;Exit if no CTS LF157: BIT 1,(HL) ;Wait for DSR enabled? JR Z,LF162 ;Go if not IN A,(0E8H) ;Get secondary status AND 40H ;Isolate DSR bit XOR 40H ;Invert status of DSR ; ; Above changed to NOP in 2.22 RET Z ;Exit if no DSR LF162: OR 0FFH ;Indicate ready state RET ; ; Initialize Serial Port ; ---------------------- LF165: LD A,(LF176) ;Set the baud rate OUT (0E9H),A OUT (0E8H),A ;Reset the UART LD A,(LF177) ;Configure primary UART register OUT (0EAH),A RET ; ; Serial Port Device Control Block ; -------------------------------- LF172: JP LF165 ;Initialization vector LF175: DEFB 00H ;Serial Port Options ; ; Bit 0=Wait for CTS ; ; Bit 1=Wait for DSR LF176: DEFB 77H ;Baud rate code LF177: DEFB 6CH ;UART configuration ;START OF ROUTINES NOT LISTED IN THE BOOK ; select disk given by register C ; In: C=disk drive to be selected ;Out:HL=pointer to the selected drive DPH ;SELDSK LF178: LD A,C ;pass the selected drive to A LD HL,0000H ;HL=0000H CP 10H ;compare with drive Q: RET NC ;ret with error if greater or equal LF17F: LD (LF71D),A ;save current selected drive LD (LF72A),A ;save selected drive in the seek params LD B,H ;high byte = 0 LD HL,LF6FD ;DPH table addresses ADD HL,BC ;add drive number twice to index ADD HL,BC ;within a two byte elements table LD A,(HL) ;get DPH address low byte INC HL ;increment pointer LD H,(HL) ;get DPH address high byte LD L,A ;pass low byte to L LD (LF71E),HL ;store DPH address in the variable RET ;and ret ; set track address for subsequent read/write given by BC ;SETTRK LF193: LD (LF720),BC ;set requested track LD (LF72B),BC ;set also in the seek parameters RET ; set sector address for subsequent read/write given by C ;SETSEC LF19C: LD (LF722),BC ;set requested sector LD (LF72D),BC ;also in the SEEK parameters LD A,(LF71D) ;get the current drive # CP 0CH ;is it drive M:? RET Z ;ret if yes CALL LF2A8 ;DCB to IX and DPB to IY LD HL,0000H ;initial offset within the phis sect LD DE,(LF722) ;get the requested sector LD A,(IY+010H) ;log2(sect size/128) OR A ;is the sector length = 128 bytes? JR Z,LF1C9 ;yes, offset is always 0 LD B,A ;pass the sector length code to B LF1BB: SRL D ;calculate the offset RR E ;within the RR L ;the host sector buffer DJNZ LF1BB LF1C3: DEC A JR Z,LF1C9 ADD HL,HL JR LF1C3 LF1C9: LD (LF727),HL ;save the offset within host sector LD HL,(LF71E) ;get DPH address LD A,(HL) ;get the address of the INC HL ;skew translation table LD H,(HL) ;in HL LD L,A OR H ;translation needed? JR Z,LF1D8 ;no, store requested sector directly ADD HL,DE ;index through the table LD E,(HL) ;get the translated sector LF1D8: LD (LF722),DE ;update requested sector RET ;and ret ; set disk DMA address given by BC ;SETDMA LF1DD: LD (LF725),BC ;copy BC to the RET ;transfer address ; translate the sector given by BC ; the phisical is returned in HL ; No traslation at all in this BIOS ;SECTRN LF1E2: LD H,B ;pass directly LD L,C ;BC to HL RET ; Homes the currently selected disk to track 0 ;HOME LF1E5: XOR A ;signal track 00 LD (LF720),A ;as the requested track LD (LF721),A ;high byte too RET ; Reads the previously specified track and sector from ; the selected disk into the DMA address ;READ LF1ED: CALL LF2A8 ;DCB to IX and DPB to IY LD A,(LF71D) ;get the current drive # CP 0CH ;is it drive M:? JP Z,LF3B5 ;jump to memory drive read LD A,01H ;signal 'need to read' CALL LF2DA ;read host sector if needed RET NZ ;ret with ZF reset if any error XOR A ;signal 'no unallocated sectors', read LD (LF736),A ;update the variable LF202: LD HL,(LF727) ;get the offset within host sect buff LD DE,LFA5B ;disk sector buffer address ADD HL,DE ;point to beginning of requested record LD DE,(LF725) ;get the transfer address OR A ;reading or writing? JR Z,LF211 ;jump if reading EX DE,HL ;swap pointers if writing LF211: CALL LF3C2 ;move the record to destination addr BIT 4,(IY+013H) ;is the data inverted? JR Z,LF222 ;jump if not ; complement the record data to get its true value LD B,80H ;128 bytes LF21C: DEC DE ;decrement pointer LD A,(DE) ;get a byte from buffer CPL ;complement to get true value LD (DE),A ;poke it back DJNZ LF21C ;process next byte LF222: XOR A ;signal 'no error' RET ;ret ; Writes the previously specified track and sector onto ; the specified disk from the DMA address ; on entry, C has this info: ; 0 = normal sector write ; 1 = write to directory sector ; 2 = write to the first sector of a new data block ; ; in case 2, we don't need to preread the physical sector since ; it is invalid anyway. in case 0 we want to do deblocking magic. ; in case 1, we don't want to use deblocking because of the danger ; of really messing up the directory structure in case of a ; subsequent error. ;WRITE LF224: LD A,C ;pass the write type to A LD (LF729),A ;and save it in a variable CALL LF2A8 ;DCB to IX and DPB to IY LD A,(LF71D) ;get the current drive # CP 0CH ;is it drive M:? JP Z,LF3C8 ;jump to memory drive write LD A,(LF729) ;get the write type CP 02H ;is it 2? (write to unallocated sect) JR NZ,LF255 ;jump if not, else.. ; write to unallocated, set parameters LD HL,LF72A ;the start of seek parameters LD DE,LF72F ;the start of unallocated parameters LD BC,0005H ;five bytes LDIR ;copy SEEK parms to UNALLOC parms LD L,(IY+00H) ;get records per track lo from DPB LD H,(IY+01H) ;get records per track hi from DPB LD (LF734),HL ;store in the variable LD A,(IY+03H) ;get the block mask from DPB INC A LD (LF736),A ;records per sector?? ; check for write to unallocated sector LF255: LD A,(LF736) ;get unalloc sector count OR A ;any unalloc remain? JR Z,LF275 ;skip if not DEC A ;decrement unalloc sector count LD (LF736),A ;update the variablw LD HL,LF72A ;SEEK parameters LD DE,LF72F ;UNALLOC parameters LD B,05H ;five bytes CALL LED49 ;compare blocks JR NZ,LF275 ;jump if blocks do not match LD HL,LF730 ;point to unalloc track number CALL LF290 ;update record number XOR A ;signal 'unnecesary read' JR LF27A ;skip to LF27A LF275: XOR A ;signal 'no unalloc sectors' LD (LF736),A ;update the variable INC A ;signal 'need to read' LF27A: CALL LF2DA ;read host sector if needed RET NZ ;return if any error LD A,01H ;signal 'write' CALL LF202 ;move data data to host buffer LD A,(LF729) ;get the write type DEC A ;set ZF if type 1 LD (LF73E),A ;signal 'no pending wites' if type 1 LD A,00H ;useless instruction RET NZ ;ret if not write type 1 JP LF30C ;write host sector to disk and ret ; update record number, increment track if necessary LF290: INC HL ;point HL INC HL ;to sector number CALL LED39 ;increment it LD D,H ;pass the pointer to sector LD E,L ;number to DE INC DE ;point DE INC DE ;to records per track CALL LED3F ;check if track increment needed RET NZ ;ret if not, else.. INC HL ;point HL to sector number hi byte LD (HL),00H ;make it zero DEC HL ;point to low byte LD (HL),00H ;make sector number lo byte = zero DEC HL ;point HL DEC HL ;to track number JP LED39 ;increment track and exit ; get DCB address into IX and DPB address into IY, IX and ; IY will be restore after executing the caller LF2A8: EX (SP),IX ;return addr to IX, pusu IX PUSH IY ;push IY LD HL,0000H ;get the current value ADD HL,SP ;of the stack pointer in HL LD SP,0000H ;define a new stack PUSH HL ;save the old stack pointer CALL LF2BE ;get DPB and DCB addresses ; retrieve original index registers upon return POP HL ;retrieve the old stack pointer LD SP,HL ;restore SP POP IY ;retrieve original POP IX ;IY and IX RET ;ret ; get DCB address into IX and DPB address into IY LF2BE: PUSH IX ;push the original return address LD HL,(LF71E) ;get DPH address LF2C3: EX DE,HL ;pass it to DE LD HL,000AH ;offset to DPB ADD HL,DE ;point to the address of DPB in DPH LD B,(HL) ;get DPB address lo into B INC HL ;increment pointer LD H,(HL) ;get DPB address hi into H LD L,B ;pass low byte to L EX DE,HL ;DPB address to DE PUSH DE ;push DPB address POP IY ;pop it into IY LD E,(IY+011H) ;get the drive DCB address LD D,(IY+012H) ;into DE PUSH DE ;push it LF2D7: POP IX ;pop DCB address into IX RET ;return to the original address ;READ A HOST SECTOR IF SEEK AND HOST PARAMETERS DO NOT MATCH LF2DA: LD (LF724),A ;store in the read flag LD HL,LF71D ;seek parameters LD DE,LF737 ;host parameters LD B,07H ;seven bytes CALL LED49 ;same drive, track and sector? RET Z ;ret if yes CALL LF307 ;perform any pending write JR NZ,LF2D7 ;if error, discard ret addr LD HL,LF71D ;seek parameters LD DE,LF737 ;host parameters LD BC,0007H ;seven bytes LDIR ;make host params = seek params LD A,(HL) ;point to read flag? OR A ;need to read? RET Z ;ret if not, else.. LF2FC: LD A,01H ;signal 'read operation' CALL LF31C ;read into host buffer RET Z ;ret if no error, else.. CALL LF33B ;display the error JR LF2FC ;retry the operation ;WRITE TO THE HOST DISK IF THERE IS ANY PENDING WRITE LF307: LD A,(LF73E) ;get the write pending flag OR A ;any write pending? RET Z ;ret it not, else.. LF30C: LD A,02H ;signal 'write operation' CALL LF31C ;write the sector via disk driver JR NZ,LF317 ;jump in case of error LD (LF73E),A ;signal no pending writes RET ;ret LF317: CALL LF33B ;display the error JR LF30C ;retry the operation LF31C: PUSH IX ;save the index PUSH IY ;registers LD HL,(LF738) ;point to host DPB address CALL LF2C3 ;DCB to IX and DPB to IY LD BC,(LF73A) ;track number LD DE,(LF73C) ;sector number LD HL,LFA5B ;disk sector buffer address CALL LF339 ;disk driver pointed in DCB POP IY ;retrieve POP IX ;index registers RET ;ret LF339: JP (IX) ;jump to the disk driver ;PROCESS DISK ERRORS ;Out:Warm boot if Ctrl-c pressed :CF reset if any other key is depressed LF33B: LD (LF73F),A ;save the error code in a variable LD C,A ;error code to C LD A,(LFFFF) ;high byte of SP when accessing to disk CP 0DCH ;was it called from BDOS? LDCXX LD A,01H ;signal error JR C,LF2D7 ;yes, return displaying nothing LD A,C ;pass error code back to A RLA ;pass the ready bit to carry LD HL,LF380 ;'Not ready' message JR C,LF358 ;display in case of error RLA ;pass the write protect bit to carry LD HL,LF38D ;'Write protect' message JR C,LF358 ;display in case of error LD HL,LF39E ;'Unrecoverable error' message LF358: LD A,(LF737) ;get the host selected drive ADD A,41H ;add ASCII code of 'A' LD (LF37C),A ;update the drive message CALL LED08 ;display the message LD HL,LF372 ;'on drive' message CALL LED08 ;display it CALL LEBF2 ;get input from console CP 03H ;is it Ctrl-C JP Z,0000H ;warm boot CP/M if yes, else.. RET ;ret ; disk BIOS error messages LF372: DEFB ' on drive ' LF37C: DEFB 'A:!',00H LF380: DEFB 07H,0DH,0AH DEFB 'Not ready',00H LF38D: DEFB 07H,0DH,0AH DEFB 'Write protect',00H LF39E: DEFB 07H,0DH,0AH DEFB 'Unrecoverable error',00H ;END OF ROUTINES NOT LISTED IN THE BOOK ; ********************************************************** ; * Memory drive read routine * ; * Input: Select parameters in select control Block * ; * Output: Record moved to (DSBDMA) * ; ********************************************************** LF3B5: CALL LF3D7 ;Set up addresses CALL LF3ED ;Move data to work buffer LD DE,(LF725) ;Point DE at destination LD HL,LF9DB ; & HL at source ; ********************************************************** ; * Move a record * ; * Input: HL=Source record address * ; * DE=Destination record address * ; * Output: None - record moved to new location * ; ********************************************************** LF3C2: LD BC,0080H ; for 1 record length LDIR ;Move the record RET ; ********************************************************** ; * Memory drive write routine * ; * Input: Select parameters in select control Block * ; * Output: Record moved from (DSBDMA) * ; ********************************************************** LF3C8: LD HL,(LF725) ;Point HL at record LD DE,LF9DB ; & DE at work buffer CALL LF3C2 ;Move record to work buffer CALL LF3D7 ;Set up addresses EX DE,HL ;Switch for writw JR LF3ED ;Write record and exit ; ********************************************************** ; * Memory drive address setup routine * ; * Input: Information in select Control Block * ; * Output: A=Map address select bits * ; * DE=Internal record buffer address * ; * HL=Record address in alternate memory map * ; ********************************************************** LF3D7: LD HL,LF723 ;Point HL at sector # (high byte) LD A,(HL) ;Page # to A (0 or 1) DEC HL ;Point to 1s byte of sector LD H,(HL) ;Memory address * 256 to HL LD L,00H SRL H ;Divide by 2 to get true RR L ; record address OR 06H ;Set FXUPMEM, MBITI RLCA ;Rotate into bits 6-4 RLCA RLCA RLCA LD DE,LF9DB ;Point to internal buffer RET ; ********************************************************** ; * Memory drive data move routine * ; * Input: A=Address select bits for move * ; * HL-Source address for move * ; * DE=Destination address for move * ; * Output: 128 bytes moved as requested * ; ********************************************************** LF3ED: DI ;No interrupts now! OR 8FH ;Set mapping bits OUT (084H),A ;Select alternate map CALL LF3C2 ;Move the record LD A,8FH ;set normal map bits OUT (084H),A ;Restore normal map XOR A ;Clear status for good I/O RET ; ********************************************************** ; * Floppy Disk I/O Driver * ; * Input: A=Function code * ; * 1 - Read a sector * ; * 2 - Write a sector * ; * BC=Track number (B should always be 0) * ; * DE=Sector number (D should always be 0) * ; * HL=Buffer address * ; * IX=DCB for selected drive * ; * IY=DPB for selected drive * ; * Output: A=Status of operation * ; * Bits match WD 1791 FDC conventions * ; ********************************************************** LF3FB: DI ;No interrupts DEC A ;Check function code JR Z,LF406 ;1 = Read DEC A JR Z,LF43C ;2 = Write ; ; Return INOP status for Floppy Disk Drive ; ---------------------------------------- LF402: LD A,10H ;Return RNF error OR A ;Clear Z to set error status RET ; ; Read a sector from disk ; ----------------------- LF406: CALL LF483 ;Start the I/O operation RET NZ ;exit if error CALL LF419 ;Try to read 3 times RET Z ;Exit if successful RET M ;Exit if inoperative CALL LF516 ;Jog the head CALL LF419 ;Try 3 more tmes RET Z ;Exit if read OK CALL LF50D ;Restore the drive ; ; Read a sector with 3 attempts ; ----------------------------- LF419: CALL LF422 ;Try to readthe sector RET Z ;Exit if it worked RET M ;Exit if inoperative CALL LF422 ;Try agein RET Z ;Exit if OK ; ; Read a sector ; ------------- LF422: PUSH HL ;Save buffer address LD B,80H ;Set up read command CALL LF54A ;Start the command DEFW LF438 ; Termination address LF42A: IN A,(0F0H) ;Read the status AND E ;Got a DRQ yet? JR Z,LF42A ;Loop if not INI ;Read first byte LD A,D ;Establish wait states LF432: OUT (0F4H),A ;Go into wait state INI ;Read a byte JR LF432 ;Keep reading LF438: POP HL ;Restore buffer address AND 9CH ;Any errors? RET ;Exit with status ; ; Write a sector to disk ; ---------------------- LF43C: CALL LF483 ;Start the I/O operation RET NZ ;Exit if error CALL LF451 ;Try to write 3 times RET Z ;Exit if successful AND 0C0H ;Exit if inop or w/p RET NZ CALL LF516 ;Jog the head CALL LF451 ;Try three more times RET Z ;Exit if write OK CALL LF50D ;Restore the drive ; ; Write a sector with 3 attempts ; ------------------------------ LF451: CALL LF45C ;Try to write the sector RET Z ;Exit if it worked AND 0C0H ;Exit if inop or w/p RET NZ CALL LF45C ;Try again RET Z ;Exit if OK ; ; Write a sector ; -------------- LF45C: PUSH HL ;Save buffer address LD B,0A0H ;Set up write command CALL LF54A ;Start the command DEFW LF47F ; Termination address Lf464: IN A,(0F0H) ;Read the status AND E ;Got a DRQ yet? JR Z,LF464 ;Loop if not OUTI ;Output first byte LD A,(HL) ;Get the next byte in A INC HL LD C,0F0H ;Point C at status reg LF46F: IN E,(C) ;Loop for second DRQ JP PO,LF46F OUT (0F3H),A ;Output the byte LD C,0F3H ;Restore C to data port LD A,D ;Establish wait states LF479: OUT (0F4H),A ;Go into wait state OUTI ;Write aa byte JR LF479 ;Keep writing LF47F: POP HL ;Restore buffer address AND 0FCH ;Any errors? RET ;Exit with status ; ; Select the disk & wait for speed ; -------------------------------- LF483: LD A,(IY+013H) ;Get drive option bits AND 80H ;Isolate density OR (IX+03H) ;Combine with select bits LD (IX+0BH),C ;Save logical track # BIT 6,(IY+013H) ;Double sided disk? ;NOTE \-EXBIOS replaces the above instruction with this: ;NOTE CALL LFE80 ;Call BIOS patch JR Z,LF4B0 ;Go if not SRL C ;Divide track # by 2 BIT 2,(IY+013H) ;Side 1 same track #? JR NZ,LF49F ;Go if not LD (IX+0BH),C ;Save new track # LF49F: JR NC,LF4B0 ;Go if on side 0 OR 10H ;Turn on side 1 select BIT 3,(IY+013H) ;Side 1 sectors biased? JR Z,LF4B0 ;Go if not PUSH AF ;Save select bits LD A,E ;Get sector # ADD A,(IY+0FH) ;Add side 1 bias LD E,A ;Restore sector # POP AF ;Restore select bits LF4B0: LD (IX+0AH),A ;Save select bits LD A,C ;Get track # BIT 5,(IY+013H) ;Double stepping drive? JR Z,LF4BB ;Go if not ADD A,A ;Compute true track # LF4BB: CP (IX+08H) ;Precomp needed yet? JR C,LF4C4 ;Go if not SET 5,(IX+0AH) ;Turn it on LF4C4: LD D,A ;True track # to D IN A,(0F0H) ;Get controller status RLCA ;Ready bit to carry flag CALL LF53C ;Select the drive LD A,0D0H ;Reset the FDC OUT (0F0H),A JR NC,LF4DE ;Go if drive running LD B,(IX+05H) ;Start-up delay to B LF4D4: LD A,0FAH ;Delay for 1/4 second CALL LED14 CALL LF53C ;Select again DJNZ LF4D4 ;Wait for speed LF4DE: LD A,E ;Set the sector # OUT (0F2H),A ;Give to controller ; ; Seek the proper track ; --------------------- LF4E1: LD A,(IX+09H) ;Get current track OUT (0F1H),A ;Give to controller INC A ;First access (=FFH)? CALL Z,LF51D ;Restore the drive if so LD A,D ;Get desired track CP (IX+07H) ;Is it legal? JP NC,LF402 ;Return INOP if so OUT (0F3H),A ;Output track to FDC LD (IX+09H),A ;Save also in DCB CALL LF53C ;Re-select the drive IN A,(0F1H) ;Get the track # SUB D ;Any seek required? JR Z,LF507 ;Go if not LD A,D ;Target track # to A OR A ;Is it zero? JR Z,LF504 ;Go if yes LD A,10H ;Set up seek command LF504: CALL LF51D ;Seek the track LF507: LD A,(IX+0BH) ;Get logical track # OUT (0F1H),A ;Give it to controller RET ; ; Restore the head for I/O retry ; ------------------------------ LF50D: LD D,(IX+09H) ;Current track # to D LD (IX+09H),0FFH ;Force restore JR LF4E1 ;Restore, seek and exit ; ; Jog the head for I/O retry ; -------------------------- LF516: LD A,58H ;Step the head in 1 track CALL LF51D LD A,68H ;Now step out 1 track ; ; Perform a step operation ; ------------------------ LF51D: PUSH BC ;Save BC LD C,A ;Save step command LD A,02H ;Wait 2 ms to be sure CALL LED14 ; erase turned off LD A,(IX+04H) ;Get drive attributes AND 03H ;Isolate step rate OR C ;Combine with command POP BC ;Restore BC CALL LF542 ;Issue step command LF52E: CALL LF53C ;Reselect the drive IN A,(0F0H) ;get the status RRA ;Still busy? JR C,LF52E ;Loop if yes LD A,(IX+06H) ;Settle time to A JP LED14 ;Delay and return ; ; Keep disk selected until not busy ; --------------------------------- LF53C: LD A,(IX+0AH) ;Select the drive OUT (0F4H),A RET ; ; Issue a command to the disk controller ; -------------------------------------- LF542: OUT (0F0H),A ;Issue the command LD A,14H ;Set delay counter LF546: DEC A ;Count down 16 usec JR NZ,LF546 ;Loop if not zero RET ; ; Set up for I/O to FDC ; --------------------- LF54A: PUSH HL ;Save buffer address LD A,(0066H) ;Save NMI vector LD (LF958),A LD HL,(0067H) LD (LF959),HL LD A,0C3H ;Set up new NMI vector LD (0066H),A LD HL,LF588 LD (0067H),HL POP HL ;Get buffer address EX (SP),HL ;Swap with return LD E,(HL) ;Get termination address INC HL LD D,(HL) INC HL EX DE,HL ;Termination to HL EX (SP),HL ;Put on stack PUSH DE ;Replace return address LD D,(IX+0AH) ;Set D=Select + bit 6 SET 6,D LD E,02H ;Set E to DRQ mask LD C,0F3H ;Set C to data port CALL LF53C ;Re-select the drive BIT 6,(IX+04H) ;Is this 8 inch drive? JR Z,LF57F ;Go if not SET 3,B ;Enable HLT delay LF57F: LD A,B ;Command to A CALL LF542 ;Give it to the controller LD A,0C0H ;Enable NMI from disk OUT (0E4H),A RET ; ; Non maskable interrupt service routine ; -------------------------------------- LF588: EX (SP),HL ;Discard return, save HL XOR A ;Turn off MNI enable OUT (0E4H),A LD A,(LF958) ;Restore NMI vector LD (0066H),A LD HL,(LF959) LD (0067H),HL IN A,(0F0H) ;Read final status POP HL ;Restore HL RET ; ********************************************************** ; * Disk Parameter Headers (DPH) for drives A-D & M * ; ********************************************************** ; ; Drive A parameter header ; LF59C: DEFW LF685 ;XLT0 DEFW 001BH DEFW 0004H DEFW 0090H DEFW LF95B ;DBUF DEFW LF5EC ;DPB0 DEFW LF8D8 ;CHK0 DEFW LF740 ;ALL0 ; ; Drive B parameter header ; LF5AC: DEFW LF6A3 ;XLT1 DEFW 0013H ; DEFW 0000H ; DEFW 0000H ; DEFW LF95B ;DBUF DEFW LF601 ;DPB1 DEFW LF8F8 ;CHK1 DEFW LF7A4 ;ALL1 ; ; Drive C parameter header ; LF5BC: DEFW LF6C1 ;XLT2 DEFW 0080H ; DEFW 0000H ; DEFW 0000H ; DEFW LF95B ;DBUF DEFW LF616 ;DPB2 DEFW LF918 ;CHK2 DEFW LF808 ;ALL2 ; ; Drive D parameter header ; LF5CC: DEFW LF6DF ;XLT3 DEFW 0080H ; DEFW 000AH ; DEFW 0168H ; DEFW LF95B ;DBUF DEFW LF62B ;DPB3 DEFW LF938 ;CHK3 DEFW LF86C ;ALL3 ; ; Drive M parameter header ; LF5DC: DEFW 0000H ; DEFW 0003H ; DEFW 0000H ; DEFW 0000H ; DEFW LF95B ;DBUF DEFW LF640 ;DPBM DEFW 0000H DEFW LF8D0 ;ALLM ; ; Offsets used to address Disk Parameter Header (DPH) fields ; ---------------------------------------------------------- ; DPHXLT 0 ;Skew translation table ; DPHBUF 8 ;Directory buffer address ; DPHDPB 10 ;Disk paraneter block ; DPHCHK 12 ;Check vector address ; DPHALL 14 ;Allocation vector address ; ********************************************************** ; * Disk Parameter Blocks (DPB) for drives A-D & M * ; ********************************************************** ; ; Drive 0 parameter block ; LF5EC: DEFW 0024H ; Records per track DEFB 04H ; Block shift count DEFB 0FH ; Block mask DEFB 01H ; Extent mask count DEFW 0054H ; Highest allocation block DEFW 007FH ; Highest directory # DEFB 0C0H ; Initial allocation 0 DEFB 00H ; Initial allocation 1 DEFW 0020H ; Directory check size DEFW 0002H ; Reserved track count DEFB 12H ; Sectors per track DEFB 01H ; Sector size code DEFW LF655 ; Drive DCB address DEFB 80H ; Drive option bits DEFB 01H ; Drive format ID code ; ; Drive 1 parameter block ; LF601: DEFW 0024H ; Records per track DEFB 04H ; Block shift count DEFB 0FH ; Block mask DEFB 01H ; Extent mask count DEFW 0054H ; Highest allocation block DEFW 007FH ; Highest directory # DEFB 0C0H ; Initial allocation 0 DEFB 00H ; Initial allocation 1 DEFW 0020H ; Directory check size DEFW 0002H ; Directory check size DEFB 12H ; Reserved track count DEFB 01H ; Sector size code DEFW LF661 ; Drive DCB address DEFB 80H ; Drive option bits DEFB 01H ; Drive format ID code ; ; Drive 2 parameter block ; LF616: DEFW 0024H ; Records per track DEFB 04H ; Block shift count DEFB 0FH ; Block mask DEFB 01H ; Extent mask count DEFW 0054H ; Highest allocation block DEFW 007FH ; Highest directory # DEFB 0C0H ; Initial allocation 0 DEFB 00H ; Initial allocation 1 DEFW 0020H ; Directory check size DEFW 0002H ; Directory check size DEFB 12H ; Reserved track count DEFB 01H ; Sector size code DEFW LF66D ; Drive DCB address DEFB 80H ; Drive option bits DEFB 01H ; Drive format ID code ; ; Drive 3 parameter block ; LF62B: DEFW 0024H ; Records per track DEFB 04H ; Block shift count DEFB 0FH ; Block mask DEFB 01H ; Extent mask count DEFW 0054H ; Highest allocation block DEFW 007FH ; Highest directory # DEFB 0C0H ; Initial allocation 0 DEFB 00H ; Initial allocation 1 DEFW 0020H ; Directory check size DEFW 0002H ; Directory check size DEFB 12H ; Reserved track count DEFB 01H ; Sector size code DEFW LF679 ; Drive DCB address DEFB 0A0H ; Drive option bits DEFB 01H ; Drive format ID code ; ; Drive M parameter block ; LF640: DEFW 0200H ; Records per track DEFB 03H ; Block shift count DEFB 07H ; Block mask DEFB 00H ; Extent mask count DEFW 003FH ; Highest allocation block DEFW 001FH ; Highest directory # DEFB 80H ; Initial allocation 0 DEFB 00H ; Initial allocation 1 DEFW 0000H ; Directory check size DEFW 0000H ; Directory check size DEFB 00H ; Reserved track count DEFB 00H ; Sector size code DEFW 0000H ; Drive DCB address DEFB 00H ; Drive option bits DEFB 00H ; Drive format ID code ; ; Offsets used to address Disk Parameter Block (DPB) fields ; --------------------------------------------------------- ; DPBRPT 0 ;Records Per Track ; DPBBSH 2 ;Block Shift factor ; DPBBLM 3 ;Block mask ; DPBEXM 4 ;Extent mask ; DPBDSM 5 ;Drive capacity ; DPBDRM 7 ;Directory Maximum ; DPBAL0 9 ;Initial Allocation 0 ; DPBAL1 10 ;Initial Allocation 1 ; DPBCKS 11 ;Check area size ; DPBOFF 13 ;Reserved track count ; DPBSPT 15 ;Sectors Per Track ; DPBSSZ 16 ;Sector Size code ; DPBDCB 17 ;Drive DCB address ; DPBOPT 19 ;Drive option bits ; ; 7=Density (0=S, 1=D) ; ; 6=Sides (0=S, 1=D) ; ; 5=Step (0=Norm, 1=2 x) ; ; 4=Data (0-Norm,.1=Inv) ; ; 3=Side 1 (0=Norm, 1=Bias) ; ; 2=Track #(0=Norm, 1=Bias) ; ; 1-0=Reserved ; DPBDID 20 ;Disk Format ID # ; ********************************************************** ; * Disk Device Control Blocks (DCB) for drives 0-3 * ; ********************************************************** ; ; Drive 0 DCB ; LF655: JP LF3FB ; Driver vector DEFB 01H ; Drive select bits DEFB 00H ; Drive attribute bits DEFB 02H ; Start up delay in 1/4 sec DEFB 0FH ; Settle time in ms DEFB 28H ; Number of tracks DEFB 16H ; Precomp turn-on track LF65E: DEFB 01H ; Current track DEFB 81H ; Current select bits DEFB 01H ; Logical track # ; ; Drive 1 DCB ; LF661: JP LF3FB ; Driver vector DEFB 02H ; Drive select bits DEFB 00H ; Drive attribute bits DEFB 02H ; Start up delay in 1/4 sec DEFB 0FH ; Settle time in ms DEFB 28H ; Number of tracks DEFB 16H ; Precomp turn-on track LF66A: DEFB 0FFH ; Current track DEFB 82H ; Current select bits DEFB 02H ; Logical track # ; ; Drive 2 DCB ; LF66D: JP LF3FB ; Driver vector DEFB 04H ; Drive select bits DEFB 00H ; Drive attribute bits DEFB 02H ; Start up delay in 1/4 sec DEFB 0FH ; Settle time in ms DEFB 28H ; Number of tracks DEFB 16H ; Precomp turn-on track LF676: DEFB 0FFH ; Current track DEFB 84H ; Current select bits DEFB 00H ; Logical track # ; ; Drive 3 DCB ; LF679: JP LF3FB ; Driver vector DEFB 08H ; Drive select bits DEFB 80H ; Drive attribute bits DEFB 02H ; Start up delay in 1/4 sec DEFB 0FH ; Settle time in ms DEFB 50H ; Number of tracks DEFB 2CH ; Precomp turn-on track LF682: DEFB 0FFH ; Current track DEFB 98H ; Current select bits DEFB 0CH ; Logical track # ; ; Offsets used to address Disk (DCB) fields ; --------------------------------------------------------- ; DKDDVR 0 ;Driver address ; DKDSEL 3 ;Drive select bits ; DKDATT 4 ;Drive attribute bits ; ; 7=Sides (0=S, 1=D) ; ; 6=Type (0=5, 1=8) ; ; 5-2=Reserved ; ; 1-0=Step rate (0-3) ; DKDSTD 5 ;Drive start-up delay in 1/4 s ; DKDSTL 6 ;Drive settle time in ms ; DKDNTK 7 ;Number of tracks ; DKDPTO 8 ;Precomp turn-on track ; DKDCTK 9 ;Current track ; DKDCSL 10 ;Current select bits ; DKDLTK 11 ;Logical track # ; ********************************************************** ; * Disk sector translation tables * ; * Space reserved for 30 sectors per track maximum * ; ********************************************************** ; ; Disk sector translation table for drive 0 ; LF685: DEFB 01H,03H,05H,07H,09H,0BH DEFB 0DH,0FH,11H,02H,04H,06H DEFB 08H,0AH,0CH,0EH,10H,12H DEFB 00H,00H,00H,00H,00H,00H DEFB 00H,00H,00H,00H,00H,00H ; ; Disk sector translation table for drive 1 ; LF6A3: DEFB 01H,03H,05H,07H,09H,0BH DEFB 0DH,0FH,11H,02H,04H,06H DEFB 08H,0AH,0CH,0EH,10H,12H DEFB 00H,00H,00H,00H,00H,00H DEFB 00H,00H,00H,00H,00H,00H ; ; Disk sector translation table for drive 2 ; LF6C1: DEFB 01H,03H,05H,07H,09H,0BH DEFB 0DH,0FH,11H,02H,04H,06H DEFB 08H,0AH,0CH,0EH,10H,12H DEFB 00H,00H,00H,00H,00H,00H DEFB 00H,00H,00H,00H,00H,00H ; ; Disk sector translation table for drive 3 ; LF6DF: DEFB 01H,03H,05H,07H,09H,0BH DEFB 0DH,0FH,11H,02H,04H,06H DEFB 08H,0AH,0CH,0EH,10H,12H DEFB 00H,00H,00H,00H,00H,00H DEFB 00H,00H,00H,00H,00H,00H DEFW LF59C ;garbage kept to DEFB 0ACH ;make files to compare ok L0003: EQU 0003H ;System I/O byte B L0004: EQU 0004H ;System current disk drive/user B LD400: EQU 0D400H ;CP/M CCP entry point LD403: EQU 0D403H ;CP/M CCP entry (clear input buffers before start) LDC06: EQU 0DC06H ;BDOS entry point ;TABLE WITH DPH ADDRESSES LF6FD: EQU 0F6FDH ;holds the address of DPH for drive A: W LF6FF: EQU 0F6FFH ;holds the address of DPH for drive B: W LF701: EQU 0F701H ;holds the address of DPH for drive C: W LF703: EQU 0F703H ;holds the address of DPH for drive D: W LF705: EQU 0F705H ;dummy entry for drive E: W LF707: EQU 0F707H ;dummy entry for drive F: W LF709: EQU 0F709H ;dummy entry for drive G: W LF70B: EQU 0F70BH ;dummy entry for drive H: W LF70D: EQU 0F70DH ;dummy entry for drive I: W LF70F: EQU 0F70FH ;dummy entry for drive J: W LF711: EQU 0F711H ;dummy entry for drive K: W LF713: EQU 0F713H ;dummy entry for drive L: W LF715: EQU 0F715H ;holds the address of DPH for drive M: W LF71D: EQU 0F71DH ;current selected drive (00=A:... 0C=M:) B LF71E: EQU 0F71EH ;DPH address of currently selected drive W LF720: EQU 0F720H ;requested track for currently selected drive lo B LF721: EQU 0F721H ;requested track for currently selected drive hi B LF722: EQU 0F722H ;requested sector low byte B LF723: EQU 0F723H ;requested sector high byte B LF724: EQU 0F724H ;read flag 00=no need to read host disk B LF725: EQU 0F725H :current disk transfer address W LF727: EQU 0F727H ;offset within the disk sector buffer W LF729: EQU 0F729H ;write type B LF72A: EQU 0F72AH ;selected drive \ B LF72B: EQU 0F72BH ;track number | Seek parameters W LF72D: EQU 0F72DH ;sector numvber / W LF72F: EQU 0F72FH ;selected drive \ B LF730: EQU 0F730H ;track number | Unallocated parameters W LF732: EQU 0F732H ;sector numvber / W LF734: EQU 0F734H ;records per track of current drive W LF736: EQU 0F736H ;unallocated sector count B LF737: EQU 0F737H ;host selected drive B LF738: EQU 0F738H ;host dph address of selected drive W LF73A: EQU 0F73AH ;host track for selected drive W LF73C: EQU 0F73CH ;host sector low byte for selected drive B LF73D: EQU 0F73DH ;host sector high byte for selected drive B LF73E: EQU 0F73EH ;pending write flag 00=no pending writes B LF73F: EQU 0F73FH ;disk error code B LF740: EQU 0F740H :allocation buffer for frive A: LF7A4: EQU 0F7A4H :allocation buffer for frive B: LF808: EQU 0F808H :allocation buffer for frive C: LF86C: EQU 0F86CH ;allocation buffer for drive D: LF8D0: EQU 0F8D0H ;allocation buffer for drive M: LF8D8: EQU 0F8D8H ;check buffer for drive A: LF8F8: EQU 0F8F8H ;check buffer for drive B: LF918: EQU 0F918H ;check buffer for drive C: LF938: EQU 0F938H ;check buffer for drive D: LF958: EQU 0F958H ;saved NMI vector (instruction) B LF959: EQU 0F959H ;saved NMI vector (argument) W LF95B: EQU 0F95BH ;directory buffer LF9DB: EQU 0F9DBH ;internal record buffer 128 B LFA5B: EQU 0FA5BH ;host sector buffer address host sec len LFFFF: EQU 0FFFFH ;high byte of SP when accessing to disk B END