;---------------------------------------------------------------------- TITLE Micro Decision ROM Source (Rev 3.1 - 21_APR_84) ;----------------------------------------------------- ; ; MICRO-DECISION ; CP/M 2.2 ROM REV. 3.1 ; COPYRIGHT 1982, 1983, 1984 ; MORROW DESIGNS, INC. ; REVCMPT EQU 13H ; Rom rev compatability level REVCMP1 EQU 22H ; Cpm rev number REV EQU 31H ; Rom Rev. ; ; Update Log ;----------- ; 7/27/83 Home retry added. ; Equipment check and Invalid command error messages added. ; Not found error handling improved to eliminate problem ; of head trapped below track 0. ; Checksum bytes moved to allow checksum program to auto- ; matically set these bytes. ; Boot without waiting if diskette in drive. ; HOME routine called from BIOS changed to set SEKTRK to 0, ; without doing physical home until discio. ; ; 7/27/83 Fix SELSK so that motor bits for drives 2 and 3 work. ; ; 8/1/83 Wrong track error handling improved to fix problem when ; Qume drives get stuck on track 1. ; ; 2/6/84 Not ready error handling improved to move head and hopefully ; un-stick head so motor can start. ; ; 4/2/84 Move SELDSK into rom. Move console output translation ; into rom. Add function key translation. Add delay to ; sign on message for atlas. Clear graphics and dim mode ; at start of sign on message. ; ; 4/21/84 Move CONOUT translation routine into rom. ; Add delay for Atlas terminal on. ; Add 0 sector for KAYPRO formats. ; Add esc codes to clear graphics & attributes ; at power on. ; page 64 ;---------------------------------------------------------------------- ; System Equates and Jump Table ;------------------------------ ; .Z80 ASEG ; system equates ;--------------- ; ROM EQU 0 ORG ROM diskbuf equ 0fc00h ; start of disk sector buffer memtop equ 0ffffh ; top of ram port equ memtop ; port to test stored here by diagnose bgnchar equ memtop-1 ; starting character for barber-pole test mempass equ memtop ; number of memory passes errors equ memtop-1 ; number of memory errors made romctl equ 0f6h ; rom enable/disable port s1data equ 0fch ; console port data s1stat equ 0fdh ; console port status s2data equ 0feh ; printer port data s2stat equ 0ffh ; printer port status cdata equ 0f4h ; centronics data port cstat equ 0f5h ; centronics status port cr equ 0dh ; carriage return lf equ 0ah ; line feed bell equ 07h ; bell wr equ 0 ; for building test pattern.. rd equ 40h ; ..for memory diagnostics ; Jump Table ;----------- JP START ; POWER ON JUMP JP MESG ; PRINT A MESSAGE POINTED TO BY DE JP HOME ; HOME HEAD JP RDHST ; READ PHYSICAL SECTOR JP WRTHST ; WRITE PHYSICAL SECTOR JP DISCIO ; DIRECT I/O READ OR WRITE JP RDIO ; I/O READ LOOP JP WRIO ; I/O WRITE LOOP JP BTER ; PRINT BOOT ERROR MESSAGE DW ROMDATX ; POINTER TO ROM VERSION OF DATX JP CENTOUT ; CENTRONICS DRIVER JP RDLSEC ; READ A LOGICAL SECTOR JP WRTLSEC ; WRITE A LOGICAL SECTOR JP SELDSK ; SELECT A DRIVE JP ROMOUT ; CONSOLE OUTPUT ROUTINE page ;---------------------------------------------------------------------- ; Module name: Microtest ;----------------------- ; ; Function: This module tests the RAM and ROM of the Micro Decision ; prior to booting. The module is entered any time the MD ; is RESET. Upon entry, a determination is made as to whether ; a power-on RESET ( cold reset ), or a " warm reset " is ; taking place. If it is a cold reset, than the RAM and ROM ; is tested, prior to booting, and if it is a warm reset, ; the diagnostics are skipped, and the system is booted. ; As the tests progress, the active test is displayed on ; the terminal. Upon completion of a test, a message is ; printed to indicate the passed test. If the test fails, ; then a message is printed, and the machine halts. ; ; ; Rev: 00 David Block 8/18/82 ; Rev: 10 DB 3/18/83 - Added firmware diagnostics ; ; Power on / Cold Start entry start: im 0 ; set interrupt mode 0 ld sp,0fffeh ; assume that ram is ok ld iy,romdaty ; init. iy call inituart ; initialize UARTS & counter-timer chip ld de,clr_term ; point to clear terminal message call clrmsg ; and print signon call romtst ; check rom call bufchk ; check memtst buffer ; ram space call stblk ; test rest of ram if ; necessary, then boot ; Warm start entry warm: in a,(s1data) ; make sure no characters are waiting in a,(0f5h) ; check if diagnostics required bit 5,a call z,diagnose ; call diagnostics test ;---------------------------------------------------------------------- ; cold boot loader ;----------------- ; boot: call xfrdata ; transfer data tables to ram ; call hmok ; home drive ld (ix+erflag),0feh ; suppress error messages call discio ; try to read cp ntrdy ; see if not ready jr nz,btagn ; jump if ready ; ld de,bootmsg ; point to boot msg call mesg ; and print it call ciny ; get a key ld de,crlf ; point to lf call mesg dec a ; btagn: or a ;see if error call nz,discio ;try again if error or a ;see if o.k. bootjp: jp z,bootbf ;jmp to boot if no error bter: ld de,bterr ;boot error mesg. jp memerr ;****************************************** ;This must stay at location 07fh in the ROM ;****************************************** DS (ROM+7FH-$),0FFH DW SKINT ;INTERUPT RETURN ADDRESS FOR WAIT ROUTINE. ROMCHK: DB 0 ;ROM CHECKSUM BYTE RAMCHK: DB 0 ;RAM CHECKSUM BYTE DW BLOCK ;RAM TEST ROUTINE ADDRESS page ;---------------------------------------------------------------------- ; Subroutine: INITUART ;--------------------- ; ; Function: This routine initializes both UARTS and the CTC. ; The UARTS are set for 8 bits, no parity, x1 clock ; rate, and 2 stop bits. In addition, DTR, and RTS, ; are programmed to be on. ; The CTC is set for 9600 on the console UART, 1200 ; baud on the printer UART, and maximum delay on the ; drive time out counter. ; inituart: ld hl,init_tab ;pointer to init data table ld b,init_len ;init data table length init_loop: ld c,(hl) ;port address inc hl ld a,(hl) ;data inc hl out (c),a ;output data to port djnz init_loop ;loop until done ret init_tab: db 0f3h ;CTC channel 0, mode 3 db 3eh db 0f0h ;CTC channel 0 set to max delay db 0ffh db 0f0h db 0ffh db 0f3h ;CTC channel 1, mode 3 db 7eh db 0f1h ;CTC channel 1 set to 9600 baud db 0dh db 0f1h db 0 db 0f3h ;CTC channel 2, mode 3 db 0beh db 0f2h ;CTC channel 2 set to 1200 baud db 68h db 0f2h db 0 db s1stat ;reset both UARTS db 80h db s2stat db 80h db s1stat db 80h db s2stat db 80h db s1stat db 40h db s2stat db 40h ;end of reset sequence db s1stat ;set both UARTS db 0ceh ;8 bits, no parity, x16, 2 stop db s2stat db 0ceh db s1stat ;Tx, Rx - on, DTR, RTS - on, ER reset db 37h db s2stat db 37h init_len equ ($-init_tab)/2 ;---------------------------------------------------------------------- ; Subroutine: ROMTST ;------------------- ; ; Function: This routine initializes the hl, and bc register ; pairs and calls chksum. It is used to test the system ; integrity. If the test passed, then a message is printed ; and the diagnostics continue. If the test failed, then ; execution will be passed to the memerr routine. ; Memerr will print a message indicating the problem found, ; and then abort the boot process. ; romtst: ; perform a checksum on the rom ld hl,0 ; starting address in rom ld bc,0ffdh ; number of bytes to check ld de,rommsg ; point to rommsg comtst: call chksum ; compute checksum of rom ret z ; return if checksum was o.k ramerr: call mesg ; print ROM error message ; print it, and halt ;---------------------------------------------------------------------- ; Subroutine: MEMERR ;--------------------- ; ; Function: When a bad memory location is detected during ; the memory test, execution comes here. This routine ; prints an error message, and halts the processor. ; memerr: in a,(0f5h) ; check if diagnostics selected bit 5,a jp z,warm ; if diagnostics selected, go to diag mode ld de,rerr ; point to fatal error message call mesg halt ; halt processor ;---------------------------------------------------------------------- ; Subroutine BUFCHK ;------------------ ; ; Function: This routine moves the memory test program to ; the disk buffer area, and pads the disk buffer ram ; such that when a checksum is computed on the buffer ; area, the result will be zero. It then calculates a ; checksum on the disk buffer RAM at location FC00h to ; FFFFh as an indication of system integrity. If the ; test passes, then the routine will return, and the ; accumulator will be equal to zero. If a bad checksum ; is computed, then execution will be passed to memerr. ; bufchk: ; set up to move prog to ram ld hl,block ; from.... ld de,diskbuf ; to.... ld bc,endblk-stblk ; how many... ldir ; move it!!!! ; ld bc,3f7h-endblk+stblk ; number of bytes to pad with push de ; save this pop hl ; get it for source of ldir inc de ; dest for ldir ld (hl), 0ffh ; initial padd ldir ; walk up and fill ld a,(ramchk) ; get checksum ld (hl),a ; set checksum ; set up pointers to test top of RAM ld hl,diskbuf ; low address ld bc,3f8h ; # of bytes to test ld de,rambad ; point to rammsg jr comtst ; jmp to error page ;---------------------------------------------------------------------- ; Subroutine: Chksum ;------------------- ; ; Function: This routine performs a checksum on a given block of ; memory. The memory may be ROM or RAM, but must be set ; such that the correct checksum is zero. The start of ; the block to be tested should be addressed by the HL ; register pair, and the number of bytes to check should ; be in the BC register pair. If the checksum is correct, ; then the accumulator will be zero upon return. ; If the accumulator is non-zero, then the memory is bad. ; The test used is a parity test, by column. The parity ; is computed by xor'ing all the bytes together. The last ; byte in the memory being tested is chosen to cause ; correct parity to yield a 0 after the xor's. ; chksum: xor a ; initialize checksum push af ; because it's popped later chk: pop af ; get current check byte value xor (hl) ; calculate new check byte inc hl ; next location to test dec bc ; decrement byte count push af ; save check byte ld a,b ; test if bc=0 or c ; b or c =0 ==> done jr nz,chk ; if not done, loop diagboot: pop af ; get completed check byte ret ; and return it ;---------------------------------------------------------------------- ; More Equates ;------------- ; ; i/o ports are: fdcstat equ 0fah fdcdata equ 0fbh motor equ 0f7h mtrchk equ 0f5h tc equ 0f7h wrall equ 0 ;write allocatted wrdir equ 1 ;write directroy wrual equ 2 ;write unallocatted ; bits within the diskdef byte. sec0 equ 6 den equ 6 dsb equ 2 DSM EQU 2 vd equ 7 tk80 equ 5 sizmsk equ 18h denmsk equ 40h ; bits within the flag byte: dflag. hstact equ 0 ;host active flag hstwrt equ 1 ;host written flag rsflag equ 2 ;read sector flag readop equ 3 ;read operation flag ; offsets within the ramdaty area. sekdsk equ 0 ;seek disk sektrk equ 1 ;seek track seksec equ 2 ;seek sector sekhst equ 3 ;seksec converted to host unacnt equ 4 ;unalloc rec count unadsk equ 5 ;unalloc disk unatrk equ 6 ;unalloc track unasec equ 7 ;unalloc sector unamax equ 8 ;sectors per alloc. block sectrk equ 9 ;sectors per track wrtype equ 10 ;write type dflag equ 11 ;flag byte trsec equ 12 ;temp storage vmsgp equ 13 ;pointer to virt drive mesg. vdrvp equ 15 ; " " " " in mesg. cdsk equ 17 ;current drive pdsk equ 18 ; vdsk equ 19 ;current virtual drive ; dmaadr equ 20 ;dma addr. ; conout equ 22 ;pointer to conout address conin equ 24 ;pointer to conin address ; mtab equ 26 ;pointer to mtab troff equ 7 ;offset to track in mtab ; offsets within the ramdatx area. hstdsk equ 0 ;host disk hsttrk equ 1 ;host track hstsec equ 2 ;host sector ; retry equ 4 ;retry count ; secsiz equ 12 ;two bytes which describe sector size seccnt equ 3 ;sector count ; ioadd equ 10 ;address of actual i/o code ; hstbuf equ 5 ;pointer to data buffer ; erflag equ 7 ;error flag ; stadd equ 14 ;7 byte buffer for fdc status ; phytrk equ 8 phyhd equ 9 ; length of command followed by the command bytes. cmdcnt equ 21 fdccmd equ cmdcnt+1 cy equ cmdcnt+3 hd equ cmdcnt+4 r equ cmdcnt+5 n equ cmdcnt+6 eot equ cmdcnt+7 gpl equ cmdcnt+8 dtl equ cmdcnt+9 eotof equ 5 ; hmbt equ 0 ;home bit for command spcmd equ 3 ;specify command sdstat equ 4 ;sense drive status command wrcmd equ 5 ;write command rdcmd equ 6 ;read command skcmd equ 7 ;root of seek & home command sicmd equ 8 ;sense int. command sekbt equ 8 ;seek bit for command stcnt equ 7 ;number of bytes returned by fdc ; error codes wperr equ 1 ;write protect code skerr equ 2 ;seek error code nferr equ 5 ;not found code ntrdy equ 6 ;not ready code ; dout equ 8000h ; asc0 equ 30h ;ascii 0 asca equ 41h ;ascii A asci equ 49h ;ascii I ascr equ 52h ;ascii R mrq equ 7 exb equ 5 mtrmsk equ 3 ;motor control bit mask mtrmsk1 equ 7 trk0msk equ 10h ;on track 0 mask prec equ 2 ;precomp bit merr equ 0c0h ;master error mask exec equ 20h ;mask for exec bit rdrdy equ 0f0h ;status for read byte wrrdy equ 0b0h ;status for write byte pr40 equ 19 ;precomp bound for 40 tracks pr80 equ 39 ;precomp bound for 80 tracks ; boot constants dskbuf equ 0fc00h bootbf equ dskbuf+200h ramdat equ dskbuf+300h DPHOFF EQU 10 page page ;---------------------------------------------------------------------- ; transfer data ;-------------- xfrdata: ld hl,romdatx ;get ready to move data areas ld de,ramdat ;into ram ld bc,datlng ldir ;do move ld ix,ramdat ;set ix & iy ld iy,ramdat+iyoff ret page ;---------------------------------------------------------------------- ; serial port routines ;--------------------- ; ; following are output routines for both serial ports. when serout is called, ; it expects the character to output to be in the c register, and the b reg. ; is to contain the port address for the serial port to be used. ; ; ; serial output routines ser2out: ld b,s2stat ;use port 2 jr serout ; use general purpose output routine cnout: ld b,s1stat ; use console port for i/o serout: ld a,c ; switch port and char. registers ld c,b ; now a has character to output ; now, c has port to use chkstato: ; check output status in b,(c) ;console output routine bit 0,b ;see if rdy jr z,chkstato ;jmp if not rdy dec c ; point to data port out (c),a ret ;serial input routines ser2in: ld c,s2stat ;point to 2nd status port jr serin ;use general purpose input routine cnin: ld c,s1stat ;set up for 1st status port serin: in a,(c) ; check input status bit 1,a ;see if rdy jr z,serin ;jmp if not rdy dec c in a,(c) ;get char. and 7fh ;mask off parity ret page ;---------------------------------------------------------------------- ; parallel output routines ;------------------------- ; ; centronics port driver ; this routine outputs the character in register c to the centronics port. ; after the character is output, the routine will monitor the ack bit from ; the port, and if no acknowledge is found within 1ms, the routine returns ; with the acc. non zero. if the character is acknowledged, then the acc. ; will be 0 upon return. ; acktime equ 064 ; centout: in a,(cstat) ; check printer rdy line bit 4,a jr nz,centout ; loop until printer ready ld a,c out (cdata),a ; output char to cent. data port ld a,80h ; send strobe to printer out (cstat),a xor a out (cstat),a ; strobe done ret page ;---------------------------------------------------------------------- ; message routines ;----------------- ; ; Clear the console srceen and output a prompt ;--------------------------------------------- ; 1) The DE reg pair must be set to the start of the prompt string ; clrmsg: ld hl,0 ;wait 1 sec. for terminal clr_lp: dec hl ld a,h or l jr nz,clr_lp call mesg ;turn off graphics & attribs. ld b,50 ;line count clrlp: ld a,lf call outcn djnz clrlp ld de,signon ;sign on message ; Output the message pointed to by the DE reg pair ;------------------------------------------------- ; 1) The message string must be terminated by a zero ; mesg: ld a,(de) or a ret z call outcn inc de jr mesg ; Ouput a character to the current console device ;------------------------------------------------ ; outcn: ld c,a push bc push de push hl ld l,(iy+conout) ;get conout addr in hl ld h,(iy+conout+1) call cntjp pop hl pop de pop bc ret page ;---------------------------------------------------------------------- ; read a logical sector ;---------------------- ; rdlsec: ld (iy+unacnt),0 ;clear unacnt set readop,(iy+dflag) ;set for read op set rsflag,(iy+dflag) ;force read ld (iy+wrtype),wrual ;treat as unalloc jr rwoper ;---------------------------------------------------------------------- ; write a logical sector ;----------------------- ; wrtlsec: res readop,(iy+dflag) ;set to write ld (iy+wrtype),c ;save write type ld a,c ;see if unalloc cp wrual jr nz,chkuna ;jmp if not ld a,(iy+unamax) ;a=init unalloc sec count ld (iy+unacnt),a ;init. unalloc count. ld a,(iy+sekdsk) ;unadsk=sekdsk ld (iy+unadsk),a ld a,(iy+sektrk) ;unatrk=sektrk ld (iy+unatrk),a ld a,(iy+seksec) ;unasec=seksec ld (iy+unasec),a chkuna: ld a,(iy+unacnt) ;any unalloc left? or a jr z,alloc ;jmp if not ; more unalloc remains. dec (iy+unacnt) ;dec unalloc count ld a,(iy+sekdsk) ;same disk ? cp (iy+unadsk) jr nz,alloc ;jmp if not ld a,(iy+sektrk) ;same track ? cp (iy+unatrk) jr nz,alloc ;jmp if not ld a,(iy+seksec) ;same sector ? cp (iy+unasec) jr nz,alloc ;jmp if not ; sector is unalloc. inc (iy+unasec) ;inc next unalloc sector ld a,(iy+sectrk) ;check for end of track cp (iy+unasec) jr nc,noovf ;jmp if not end of track inc (iy+unatrk) ;inc track ld (iy+unasec),1 ;sector 1 noovf: res rsflag,(iy+dflag) ;no read needed. jr rwoper alloc: ld (iy+unacnt),0 ;clear unalloc count set rsflag,(iy+dflag) ;read needed page ;---------------------------------------------------------------------- ; common routine section for read/write logical sectors ;------------------------------------------------------ ; rwoper: ld a,(iy+sekdsk) ;get drive call gdsk ;get pointer to diskdef inc hl ld a,(hl) ;a=dskdef1 dec hl ;hl => dskdef0 ld e,(iy+seksec) ;get sector dec e ;dec sector ld d,e ;save sector and sizmsk ;mask out size bits ld b,0 ;128 byte mask cp 0 ;see if 128 jr z,s128 ;jmp if 128 ld b,1 ;256 byte mask cp 8 ;see if 256 jr z,s256 ;jmp if 256 ld b,3 ;512 byte mask cp 10h ;see if 512 jr z,s512 ;jmp if 512 ld b,7 ;1024 byte mask s1024: sra e ;calc physical sector s512: sra e s256: sra e s128: bit sec0,(hl) ;check if sectors start at 0 jr nz,zsect ;jump if so inc e zsect: ld (iy+sekhst),e ;save physical sector ld a,b ;a=mask and d ;mask sector ld (iy+trsec),a ;save masked sector bit hstact,(iy+dflag) ;host active ? set hstact,(iy+dflag) ;set host active jr z,filhst ;fill if not active ld a,(iy+sekdsk) ;same disk ? cp (ix+hstdsk) jr nz,nomtch ;jmp if not ld a,(iy+sektrk) ;same track ? cp (ix+hsttrk) jr nz,nomtch ;jmp if not ld a,(iy+sekhst) ;same sector ? cp (ix+hstsec) jr z,match ;jmp if same nomtch: xor a ;a=no error status bit hstwrt,(iy+dflag) ;host written ? call nz,wrthst ;write host if needed or a ;check status ret nz ;return if error filhst: ld a,(iy+sekdsk) ;set host for xfer ld (ix+hstdsk),a ld a,(iy+sektrk) ld (ix+hsttrk),a ld a,(iy+sekhst) ld (ix+hstsec),a xor a ;a=no error status bit rsflag,(iy+dflag) ;need to read ? call nz,rdhst ;read or a ;check status ret nz ;return if error res hstwrt,(iy+dflag) ;no pending write match: ld l,(iy+trsec) ;get masked sector ld h,0 add hl,hl ;calc 2**hl add hl,hl add hl,hl add hl,hl add hl,hl add hl,hl add hl,hl ld e,(ix+hstbuf) ;de=> host buffer ld d,(ix+hstbuf+1) add hl,de ;hl=> sector in buffer ld e,(iy+dmaadr) ;de=dma addr. ld d,(iy+dmaadr+1) ld bc,128 ;bc=sector length xor a ;a = 0 bit readop,(iy+dflag) ;read or write ? ret nz ;return if read set hstwrt,(iy+dflag) ;set write flag ex de,hl ;reverse direction ret page ;---------------------------------------------------------------------- ; read a physical sector ;----------------------- ; rdhst: ld hl,rdio ;get read address ld (ix+ioadd),l ;put address in ramdatx ld (ix+ioadd+1),h ld c,rdcmd ;c=read commadn jr iohst ;go do i/o ;---------------------------------------------------------------------- ; write a physical sector ;------------------------ ; wrthst: ld hl,wrio ;get write address ld (ix+ioadd),l ;put address in ramdatx ld (ix+ioadd+1),h ld c,wrcmd ;c=write command page ;---------------------------------------------------------------------- ; routine common to read/write a physical sector ;----------------------------------------------- ; iohst: ld a,(ix+hstdsk) ;get host drive call gdsk ;get pointer to dskdef inc hl ld a,(hl) ;a=dskdef1 and denmsk ;mask off density bit or c ;or into command ld (ix+fdccmd),a ;put in command buffer ld (ix+cmdcnt),9 ;set command count ld a,sizmsk ;get sector size bits and (hl) rrca ;right justify rrca rrca ld (ix+n),a ;save in command buffer ld b,80h ;b=dtl for 128 ld de,80h ;de=size bytes for 128 cp 0 ;see if 128 jr z,stsiz ;jmp if 128 ld b,0ffh ;b=dtl for 256,512 & 1024 ld de,0 ;de=size bytes for 256 cp 1 ;see if 256 jr z,stsiz ;jmp if 256 ld d,1 ;de=size bytes for 512 cp 2 ;see if 512 jr z,stsiz ld d,3 ;de=size bytes for 1024 stsiz: ld (ix+dtl),b ;set dtl bit 7,(ix+secsiz+1) ;see if non-standard block size jr nz,nstd ;jmp if non-standard ld (ix+secsiz),e ;set size bytes ld (ix+secsiz+1),d nstd: xor a ;assume side 0 & clear cy bit dsb,(hl) ;see if double sided ld b,(ix+hsttrk) ;get host track ld c,(ix+hstsec) ;get host sector jr z,sside ;jmp if single sided rr b ;b=track cy=head rla ;get head bit in a sside: ld (ix+hd),a ;set head rlca rlca ld (ix+phyhd),a ld (ix+phytrk),b ;set track ld (ix+cy),b ld (ix+r),c ;set sector ld a,3 ;mask out physical drive address and (hl) or (ix+phyhd) ;or in head bit ld (ix+fdccmd+1),a ;put in command buffer ld de,eotof ;offset to eot & gpl in mtab add hl,de ;add to mtab pointer ld a,(hl) ;set eot ld (ix+eot),a inc hl ;set gpl ld a,(hl) ld (ix+gpl),a page ; the ix area has now been set up discio: ld b,(ix+retry) ;b=retry count ld d,3 ; Start of Retry loop dlop: push bc ;save retry count push de ;save not ready retry call selsk ;selct drive and seek push iy ;save iy call strtio ;start fdc call dio ;go do i/o pop iy ;restore iy ld b,stcnt ;set up and read push ix ;fdc status bytes pop hl ;into status memory. ld de,stadd add hl,de ;hl=status memory gstlp: call infdc ;wait for fdc ini ;get byte jr nz,gstlp skst: pop de ;restore not ready retry pop bc ;restore retry count ld a,(ix+stadd) ;a=status0 and merr ;check for error jr z,dret1 ;return if no error call ecode ;calc. error code ld a,wperr ;if write protect error cp c jr z,nrtry ld a,ntrdy ;if not ready error cp c call z,fix_rdy ld a,skerr ;if wrong track cp c call z,wngtrk ; home ld a,nferr ;see if not found cp c call z,ntfnd ld a,(ix+retry) ;home after 1/2 the retries rrca inc a cp b call z,hmok djnz dlop ;retry loop page ; no retries or retries exhausted nrtry: ld a,(ix+erflag) ; check erflag cp 0feh ; feh => no error handling jr z,dret call edsp jr c,dret ;ret if 'a' (abort) or a ;see if 'r' (retry) jp nz,discio ;try again dret1: ld c,a ;else, 'i' (ignore) dret: ld (ix+erflag),c ;update error flag ld a,c ret wngtrk: call hmok ;home ntfnd: call cnt ret z ld a,(ix+phytrk) cp 3 ;see if < track 3 ret nc ;return if > track 2 trck3: push af ;save track ld (ix+phytrk),3 ;set to track 3 call selsk ;seek to track 3 pop af ;restore track ld (ix+phytrk),a jp hmok ;home page fix_rdy: call cnt ret z call hmok ;home ld a,(ix+phytrk) ;get current track push af ;save current track ld (ix+phytrk),10 ;set for track 10 call selsk ;seek to track 10 pop af ;restore current track ld (ix+phytrk),a jp selsk ;seek to current track ;---------------------------------------------------------------------- ; start the disk controller ;-------------------------- ; strtio: ld c,fdcdata ;set up to xfer fdc command push ix ;calc. addr. of command list pop hl ;and put in hl ld de,cmdcnt ;offset to command list add hl,de ld b,(hl) ;b=command list length inc hl ;inc command list pntr. call rdy ;make sure fdc is ready statlp: call outfdc ;wait for fdc outi ;write command byte jr nz,statlp ;loop 'til done ld b,(ix+secsiz) ;set up regs. for i/o ld e,(ix+secsiz+1) res 7,e ;clear non-standard bit ld d,(ix+seccnt) dec d ;d=sector count -1 ld l,(ix+ioadd) ;hl=io addr. ld h,(ix+ioadd+1) push hl ;save on stack pop iy ;iy=i/o addr. ld l,(ix+hstbuf) ;hl=dma addr. ld h,(ix+hstbuf+1) ret page ;---------------------------------------------------------------------- ; do the actual i/o routine ;-------------------------- ; dilp: bit mrq,a ;see if master req. ret nz dio: in a,(fdcstat) bit exb,a ;see if executing jr z,dilp push de ;save de ld de,dout ;load time out count jp (iy) ;jmp to i/o edsp: ld a,c rlca ld e,a ld d,0 ld hl,etab-2 add hl,de ld e,(hl) inc hl ld d,(hl) push bc ;save status push de ;save de ld de,dmesg ;basic err mesg. call mesg ld a,asca ;get drive in ascii add a,(ix+hstdsk) call outcn ;display drive ld de,coln call mesg pop de ;restore call mesg ld a,0ffh ;see if error message desired cp (ix+erflag) scf ;simulate abort selection call nz,ersp pop bc ;c=status ret page ;---------------------------------------------------------------------- ; take care of virtual drive processing ;-------------------------------------- ; virt: inc a ;convert to ascii set 6,a ld e,(iy+vdrvp) ld d,(iy+vdrvp+1) ;de=pntr to vdrv ld (de),a ;put vdrv in vmsg. ld e,(iy+vmsgp) ;de=pntr to vmsg ld d,(iy+vmsgp+1) ;---------------------------------------------------------------------- ; output the virtual drive message ;--------------------------------- ; virtm: call mesg ;print mesg. plop: call ciny ;get response cp 0dh ;see if cr jr nz,plop ;loop if not dcrlf: ld de,crlf jp mesg ;print cr & lf ersp: ld de,resm call mesg erlp: call ciny and 0dfh ;force upper case ld e,a cp asca ;see if "a" scf jr z,eret cp ascr ;see if "r" jr z,eret sub asci ;see if "i" jr nz,erlp ;try again eret: push af ld a,e call outcn ld de,crlf call mesg pop af ret ;---------------------------------------------------------------------- ; get a character from the console ;--------------------------------- ; ciny: push bc push hl ld l,(iy+conin) ;hl=conin addr. ld h,(iy+conin+1) call cntjp pop hl pop bc ret page ;---------------------------------------------------------------------- ; read from the disk controller ;------------------------------ ; rloop1: and exec ;see if still executing jr z,exdn ;jmp if done in a,(fdcstat) ;get status cp rdrdy ;see if byte ready jr z,rdsc ;jmp if 1st byte ready dec de ;dec time out count ld a,e ;see if timed out or d jr z,tmout ;jmp if timed out rdio: in a,(fdcstat) ;get status cp rdrdy ;see if byte ready jr nz,rloop1 ;loop if byte not ready rdsc: ini ;xfer 1st byte pop de ;get de push de ;save de rloop3: ld a,e ;see if last part of last sector or d jr nz,rloop2 ;jmp if not last part dec b ;dec byte count if last rloop2: ei ;enable ints. halt ;wait for byte in a,(fdcstat) ;get status and exec ;see if still executing jr z,exdn ;jmp if not ini ;xfer byte jr nz,rloop2 ;loop if more bytes dec e ;dec msb of sector length jp p,rloop3 ;jmp if not end pop de ;restore sector size & count dec d ;dec sector count push de jp p,rloop3 ;jmp if not end ei ;enable ints. halt ;wait for last byte in a,(tc) ;stop fdc ini ;xfer last byte exdn: pop de ret page ;---------------------------------------------------------------------- ; time out handeler ;------------------ ; tmout: pop de pop hl pop iy push iy push bc ld c,motor ;init c reg to motor ld a,(iy+pdsk) ;a = physical disk ld b,a set 3,a out (c),a ;pulse ready line tmlp: in a,(fdcstat) ;get status of fdc bit exb,a ;see if executing jr nz,tmlp ;loop if executing out (c),b ;else pulse ready line pop bc ;restore registers jp (hl) ;execution done ;---------------------------------------------------------------------- ; write data to the floppy disk controller ;----------------------------------------- ; wloop1: and exec ;see if still executing jr z,exdn ;jmp if done in a,(fdcstat) ;get status cp wrrdy ;see if byte ready jr z,wrsc ;jmp if 1st byte ready dec de ;dec time out count ld a,e ;see if timed out or d jr z,tmout ;jmp if timed out wrio: in a,(fdcstat) ;get status cp wrrdy ;see if byte ready jr nz,wloop1 ;loop if byte not ready wrsc: outi ;xfer 1st byte pop de ;get de push de ;save de wloop3: ld a,e ;see if last part of last sector or d jr nz,wloop2 ;jmp if not last part dec b ;dec byte count if last wloop2: ei ;enable ints. halt ;wait for byte in a,(fdcstat) ;get status and exec ;see if still executing jr z,exdn ;jmp if not outi ;xfer byte jr nz,wloop2 ;loop if more bytes dec e ;dec msb of sector length jp p,wloop3 ;jmp if not end pop de ;restore sector size & count dec d ;dec sector count push de jp p,wloop3 ;jmp if not end ei ;enable ints. halt ;wait for last byte in a,(tc) ;stop fdc outi ;xfer last byte pop de ret cnt: inc b dec d ret nz ld b,1 ret ;---------------------------------------------------------------------- ; home the disk head ;------------------- ; home: bit hstwrt,(iy+dflag) ;clear host active flag jr nz,hmsk ;unless write is pending. res hstact,(iy+dflag) hmsk: ld (iy+sektrk),0 ;set track to 0 ret hmok: ld a,hmbt ;set bit for home command jr selhm page ;---------------------------------------------------------------------- ; select a drive ;--------------- ; selsk: ld a,sekbt ;set bit for seek command selhm: push bc ;save retry push de ld c,a ld a,(ix+hstdsk) ;get new drive push af ;save new drive call gdsk ;get pointer to dskdef ld a,(hl) ;get motor control bit and mtrmsk1 ;mask off motor bit bit 2,a jr z,mtok rrca mtok: ld e,a ;e=motor control bit inc hl ;hl=>to dskdef1 pop af ;a=new drive cp (iy+cdsk) ;see if drive changed jr z,same ;jmp if no change ld (iy+cdsk),a ;update current drive bit vd,(hl) ;see if virtual push bc jr z,nvirt ;jmp if not virtual cp (iy+vdsk) ;new drive = vdsk ? ld (iy+vdsk),a ;updtae vdsk to new drive push af ;save new drive push de push hl call nz,virt ;call if new drive <> vdsk pop hl ;restore regs. pop de pop af nvirt: call specfy ;set new drive parameters pop bc same: bit den,(hl) ;check density jr z,single ;jmp if single double: ld a,pr40 ;40 track precomp bound bit tk80,(hl) ;see if 80 track jr z,trk40 ;jmp if 40 track ld a,pr80 ;80 track precomp bound trk40: cp (ix+phytrk) ;see if precomp jr nc,single ;jmp if no precomp set prec,e ;turn on precomp page ; turn on the motors single: in a,(mtrchk) ;see if motor on and mtrmsk ;mask motor bits ld d,a ;save motor bits and e ;nz if motor on, cy=0 push af ;save flags ld a,(hl) ;get motor bits and mtrmsk ld b,a inc b ld a,8 mloop: rlca djnz mloop or d or e ;turn on motors out (motor),a ld (iy+pdsk),a ;save motor byte ; seek to the new track ; get current track gtrk: push hl ;save mtab pointer ld de,troff ;offset to track add hl,de ;add to hl ld d,(hl) ;d=current track pop hl ;restore hl ld a,(ix+phytrk) ;a=new track bit 3,c ;see if home jr z,sk0 ;jmp if home or a ;see if track zero jr nz,not0 ;jump if not track zero res 3,c ;force home operation jr sk0 ;do home not0: cp d ;new trk = old trk ? jr z,vskp ;jmp if trks. same sk0: call seek pop af ;get flags scf ;cy=1 for head settle push af ;save flags vskp: pop af ;restore flags push bc push hl call wait ;wait for motor and/or head pop hl pop bc bit 3,c ;see if home call z,hmchk ;call if home operation pop de pop bc ;restore retry ret page ;---------------------------------------------------------------------- ; find out if the heads homed ;---------------------------- ; hmchk: call outfdc ;wait for controller ld a,sdstat ;sense drive status command out (fdcdata),a ;out to fdc call outfdc ;wait for controller ld a,mtrmsk ;mask for drive select bits and (hl) ;get drive select bits out (fdcdata),a ;out to fdc call infdc ;wait for controller in a,(fdcdata) ;read status and trk0msk ;mask for track zero bit ret nz call seek ;home again ld a,0ffh ;set z and cy for proper delays or a scf jr wait page ;---------------------------------------------------------------------- ; set hl pair as a pointer to mtab ;--------------------------------- ; gdsk: push iy ;get iy into hl pop hl ;calc. pionter to mtab for drive ld de,mtab add hl,de ld d,a rlca ;mult. by 9 rlca rlca add a,d ld e,a ld d,0 add hl,de ;hl=mtab for drive ret page ;---------------------------------------------------------------------- ; wait in 4 ms increments ;------------------------ ; ; wait routine expects hl to point to dskdef1 in mtab. ; the z and the cy flags determine if motor and/or head settle ; delays are needed. ; if z=1 then motor delay is needed. ; if cy=1 then head settle delay is needed. ; delay time = 4ms. times the values in mtab. ; wait: inc hl ;hl=> motor wait time ld b,(iy+pdsk) ;get motor byte ld c,motor ;get motor port ld d,(hl) ;hl=>wait time ld e,0 inc hl ;hl=>settle time jr nc,wait1 ;jmp if no settle delay im 2 ;change int. mode ld a,rom shr 8 and 0ffh ;set int table address for rom+7f ld i,a jr nz,wait2 ;jmp if no motor delay ei ;enable ints. wlop1: dec de ;wait loop. dec count ld a,d ;check if count is 0 or e jr z,wlop2 ;jmp if count = 0 ld c,motor ;get motor port & time pad out (c),b ;keep motors running jr wlop1 ;loop wait2: ld d,(hl) ;get head settle delay ei wlop2: out (c),b ;keep motors running jr wlop2 ;jmp self skint: im 0 ;set int mode back to 0 inc sp ;fix stack inc sp call sintr ;clear int. ld a,d ;compare settle time to whats left cp (hl) ;of motor time. jr nc,wlop3 ;jmp if motor bigger ld d,(hl) ;de=settle time jr wlop3 wait1: ret nz ;return if no motor delay needed wlop3: out (c),b ;keep motors running out (c),b ;time pad nop ; " " dec de ;dec count ld a,d or e ;see if count = 0 jp nz,wlop3 ;jmp if done ret page ;---------------------------------------------------------------------- ; Check if the FDC is ready ;-------------------------- ; nrdy: call sint ;sense int. to clear seek flags rdy: in a,(fdcstat) ;see if any seek flags are set and 0fh jr nz,nrdy ;jump if any seek flags are set in a,(fdcstat) ;make sure fdc is ready bit 4,a jr nz,rdy ret ;---------------------------------------------------------------------- ; Hang until FDC output buffer is empty ;-------------------------------------- ; outfdc: in a,(fdcstat) ;wait for fdc to signal and 0c0h ;that it is ready to cp 80h ;accept input jr nz,outfdc ;loop if not ready ret ;return when ready ;---------------------------------------------------------------------- ; Hang until FDC input buffer is ready ;------------------------------------- ; infdc: in a,(fdcstat) ;wait for fdc to signal and 0c0h ;that it is ready to cp 0c0h ;return output. jr nz,infdc ;loop if not ready ret ;return when ready ;---------------------------------------------------------------------- ; Seek Routine ;------------- ; seek: call outfdc ;wait for fdc ld a,skcmd ;root of seek & home command or c ;or in bit to get home or seek out (fdcdata),a ;output command call outfdc ;wait for fdc ld a,mtrmsk ;get mask for ds and (hl) ;mask off ds bit 3,c ;see if home jr z,hd0 ;jmp if home or (ix+phyhd) ;or in head bit hd0: out (fdcdata),a ;output hd and ds bit 3,c ;see if home ret z ;ret if home call outfdc ;wait for fdc ld a,(ix+phytrk) ;get track out (fdcdata),a ;output track ret page ;---------------------------------------------------------------------- ; Write the two bytes of the FDC specify command ;----------------------------------------------- ; tmpbc equ (200h or fdcdata) ;B:=2, C:=FDC data port ; specfy: push hl ;save hl inc hl ;move hl to specify parameters inc hl ;for current drive. inc hl call outfdc ;wait for fdc ld a,spcmd ;specify command out (fdcdata),a ld bc,tmpbc ;param. count splp: call outfdc outi jr nz,splp pop hl ret ;---------------------------------------------------------------------- ; Do a Sense Interrupt Status Command ;------------------------------------ ; sint: call outfdc ld a,sicmd ;sense int. stat. command out (fdcdata),a call infdc ;Read ST0 in a,(fdcdata) and 0c0h ;only look at the interrupt code cp 80h ;If (invalid command was issued) ret z ; return call infdc ;Else in a,(fdcdata) ; read the present track value ret ;---------------------------------------------------------------------- ; Clear Interrupt status and update current track in MTAB ;-------------------------------------------------------- ; sintr: call sint ;CLR irq status - check command valid push hl ;save hl & de push de ld de,troff-2 ;offset to current track in MTAB add hl,de ;hl=>current track ld (hl),a ;update current track pop de ;restore hl & de pop hl ret page ;---------------------------------------------------------------------- ; error code computation ;----------------------- ; 1) this routine uses the status that has been stored in stadd ; through stadd+2 to compute an error code. possible error ; codes are: ; ; write protect 1 ; seek error 2 ; data crc 3 ; id crc 4 ; not found 5 ; drive not ready 6 ; sync 7 ; equipment check 8 ; invalid command 9 ; unknown error 10 ; wp equ 1 bce equ 1 wc equ 4 dd equ 5 en equ 7 nd equ 2 ma equ 0 cm equ 6 md equ 0 nr equ 3 ore equ 4 eq equ 4 der equ 5 ier equ 7 ecode: ld c,1 ;error root bit wp,(ix+stadd+1) ;see if wp ret nz inc c bit bce,(ix+stadd+2) ;see if seek error ret nz bit wc,(ix+stadd+2) ret nz inc c bit dd,(ix+stadd+2) ;see if data crc ret nz inc c bit der,(ix+stadd+1) ;see if id crc ret nz inc c bit en,(ix+stadd+1) ;see if unreadable ret nz bit nd,(ix+stadd+1) ret nz bit ma,(ix+stadd+1) ret nz ; bit cm,(ix+stadd+2) ; ret nz bit md,(ix+stadd+2) ret nz inc c bit nr,(ix+stadd) ;see if drive not rdy ret nz inc c bit ore,(ix+stadd+1) ;see if sync ret nz inc c bit eq,(ix+stadd) ;see if equip. chk. ret nz inc c bit ier,(ix+stadd) ;see if invalid command ret nz inc c ;unknown error ret ; ; On entry to CONOUT register C contains the character to be output. ; A test is made to see if the system is in the process of outputing ; a multiple character escape sequence, or if the character is a ; Morrow Standars Control Code. If neither test is true, than the ; character is output. ; If the character is part of a multiple character escape sequence, ; then the character is passed to the ESCAPE routine. If the ; character is a MSCC, then it is converted to the appropriate ; sequence, and output. ; esc equ 1bh dcaoff equ 8 etboff equ 0 ctboff equ 2 evcoff equ 4 cvcoff equ 6 esc_lvl equ 18 first equ 22 second equ 23 offset1 equ 19 offset2 equ 20 order equ 21 dcastrt equ 0 dcamid equ 6 dcaend equ 12 ; romout: ld l,(iy+dcaoff) ; get pointer to dca area ld h,(iy+dcaoff+1) push iy ; save iy push hl ; put dca pointer in iy pop iy ld a,(iy+esc_lvl) ; test escape flag or a ; check if flag is set jr nz,escape ; if escape sequence, jump ld a,1fh ; test if MSCC cp c jp c,cout_ret ; if not, then xmit it ld a,esc ; check if esc char cp c ; jr nz,notesc ; if not, jump ; otherwise, set escape ld (iy+esc_lvl),1 ; level to 1st stage pop iy ret ; and return notesc: pop iy ld l,(iy+ctboff) ; get pointer to control table ld h,(iy+ctboff+1) call lookup ; and lookup character in table or a ; see if char found jp z,bcout ; if not, output char ld l,(iy+cvcoff) ; get pointer to vector table ld h,(iy+cvcoff+1) jp outstr ; ; This routine is used to create a string for direct ; cursor addressing, or to translate character codes. ; Upon receipt of an Escape code from ; a program, the esc_lvl is set to indicate an escape ; sequence is being output. When the next character is ; received, it is tested to see if it is an equals sign (=). ; If it is not, than an escape character is output, followed ; by the character received. If the character is the equal sign, ; then two more characters will be accepted, after-which a string ; will be output for positioning the cursor. ; escape: cp 1 ; level 1? jr z,seq1 ; then process 1st part cp 2 ; level 2? jr z,seq2 ; then process 2nd level ; it must be level 3 seq3: ld a,(iy+offset2) ; get offset for 2nd char add a,c ; add to 2nd char ld (iy+second),a ; save 2nd char ld (iy+esc_lvl),0 ; clear escape sequence push iy ; get pointer to first char pop hl ld de,first add hl,de ex de,hl ld a,(de) ; get 1st char add a,(iy+offset1) ; add offset for 1st char ld (de),a ; save 1st char ld a,(iy+order) push af rra sbc a,a ; 0==>1-2 : FF==>2-1 ld b,a ; save order in b ld a,e ; use order to adjust de sub b ld e,a ; de points to 1st char to output push iy ; pointer to dca prefix sting pop hl call loop ; output string ld a,(de) ; get 1st char to output ld c,a pop af bit 1,a ; see if ascii push af call nz,ascout ; call ascii if nz call cout ; output char push de ld de,dcamid ; pointer to seperator string call get_str ; output string pop de ld a,e ; use order to adjust de add a,b inc b add a,b ld e,a ; de points to 2nd char to output ld a,(de) ; get char to output ld c,a pop af call nz,ascout ; call ascii if flag set call cout ; output char ld de,dcaend ; point to dca terminator pop af ; fix stack jr get_str seq1: ld a,'=' ; equal sign? cp c ; if char is =, then DCA started jr z,set ; else, could be character to xlate ld (iy+esc_lvl),0 ; clear escape level pop iy ld l,(iy+etboff) ; get pointer to escape table ld h,(iy+etboff+1) call lookup ; lookup character or a ; see if char found jr nz,down ; if found, jump to output push bc ld c,esc ; else, send escape, then char call cout ; send escape pop bc ; get original character bcout: ld c,b jr cout ; send it seq2: ld (iy+first),c ; this is the first char ld (iy+esc_lvl),3 ; set for level 3 jr iy_ret down: ld l,(iy+evcoff) ; calculate string location ld h,(iy+evcoff+1) jr outstr ; output the string set: ld (iy+esc_lvl),2 ; otherwise, set for level 2 iy_ret: pop iy ret ; and return ; ; subroutine: outstr ; ; This routine outputs a string of characters to the console. ; It is used by the translate program to output a terminal ; specific string in order to implement a control sequence. ; When entered, the HL register pair points to the base of ; the string table, and the BC register pair is the offset ; to the string. Characters are output starting with the ; first character until a byte value of ffH is detected. ; outstr: add hl,bc ; add offset to base ld e,(hl) ; get location of string Š inc hl ld d,(hl) ex de,hl ; move address of string to hl loop: ld a,(hl) ; get a char cp 0ffh ; see if done ( ffh==>done) ret z ld c,a ; if not, get char call cout ; xmit it inc hl jr loop ; until end of string ; ; General Purpose Indirect vectors ;--------------------------------- ; cout_ret: pop iy cout: jp (ix) get_str: push iy ;get pointer to dca strings pop hl add hl,de ;add offset jr loop ;print string ; BDRV: LD A,5 ;RETURN ERROR CODE POP DE RET DS (ROM+7FCH-$),0FFH ;****************************************** ;This area must remain at locations 7fc-7ff ;******************************************' ; DB REVCMPT DB REVCMP1 db REV DS 2,0FFH ; cntjp: jp (hl) page ; ; subroutine: lookup ; ; This routine is entered with the HL register pair pointing to ; the base of a table to be searched. Register C contains the ; character to search for. Upon return, The accumulator will ; contain 0 if the character was not found, and ffh if it was found. ; If the character was found in the table, then bc will contain ; the offset into the table, multiplied by 2. i.e BC / 2 = location Š; of character in table. ; lookup: ld b,c ; char to search for ld c,0 ; init offset nmtch: ld a,(hl) ; get value from table cp b ; see if char matches jr nz,nochar ; jmp if no match xor a ; a = 0 ld b,a ; b = 0 dec a ; a = ff ret nochar: sub 0ffh ; see if end of table ret z ; return if end inc hl ; inc table pointer inc c ; inc offset inc c ; " " jr nmtch ; continue search ; ; ASCOUT takes a binary value in C and output its decimal ascii ; equivalent. ; ascout: push bc ld a,c ld c,'0' ;init to ascii 0 tens: sub 10 ;subtract 10 from value jr c,ones ;jmp if underflow inc c ;inc ascii tens value jr tens ;loop ones: ld b,a ;save intermediate value ld a,'0' ;a = ascii 0 cp c ;see if tens value is 0 call nz,cout ;output tens value if not 0 ld a,3ah ;ascii 0 plus 10 add a,b ;add to produce ones value pop bc ld c,a ;get ready for output ret ; SELDSK: PUSH HL ;SAVE DPBASE POINTER LD A,4 ;CHECK DRIVE BOUND CP C JR C,BDRV ;JMP IF BAD ; LD (IY+SEKDSK),C;SET DRIVE ; BIT 0,E ;SEE IF FIRST TIME JR NZ,SKPSET ;JP IF NOT FIRST ; LD A,C CALL GDSK ;GET MTAB POINTER ; BIT 7,(HL) ;SEE IF FOREIGN DRIVE JR NZ,SKPSET ;JP IF FOREIGN ; INC HL PUSH HL ;SAVE DSKDEF POINTER PUSH BC CALL GETAB ;READ CONFIG TABLE FROM DISKETTE POP BC POP HL OR A ;SEE IF ERROR JR NZ,BDRV ;JUMP IF ERROR ; PUSH HL LD L,(IX+HSTBUF) ;CALC. POINTER TO BOOT TABLE LD H,(IX+HSTBUF+1) LD DE,80H+25 ADD HL,DE ; LD B,25 ;COUNT MUST BE ODD! LD E,0 ;INIT 0-CHECK BYTE LD A,0 ; CHKLP: DEC HL ;DEC POINTER XOR (HL) ;X-OR TABLE VALUE INTO PARITY CHECK BYTE LD D,A ;SAVE PARITY CHECK BYTE OR E ;OR IN 0-CHECK BYTE LD E,A ;SAVE 0-CHECK BYTE LD A,D ;RESTORE PARIY CHECK BYTE DJNZ CHKLP ;DEC TABLE LENGTH & LOOP TIL DONE INC HL ;HL=>DSKDEF1 ; OR A ;A=0 IF TABLE OK LD A,E ;A = 0-CHECK BYTE LD DE,SDPB ;POINTER TO S.S. DPB JR NZ,OSIDE ;ASSUME S.S. IF INVALID TABLE ; OR A ;CHECK 0-CHECK BYTE JR Z,OSIDE ;INVALID TABLE IF ZERO ; PUSH HL ;CALC. POINTER TO DPB IN BOOT LD L,(IX+HSTBUF) LD H,(IX+HSTBUF+1) LD DE,80H+9 ADD HL,DE EX DE,HL POP HL ; BIT DSM,(HL) ;SEE IF D.S. MEDIA JR Z,OSIDE ;JP IF S.S. ; POP HL ;GET DSKDEF POINTER SET DSM,(HL) ;SET FOR D.S. MEDIA JR DSIDE ; OSIDE: POP HL RES DSM,(HL) ;SET FOR S.S. MEDIA ; DSIDE: XOR A ;SET Z FLAG SKPST1: LD H,0 ;CALC. DPB POINTER LD L,C ; ADD HL,HL ADD HL,HL ADD HL,HL ADD HL,HL ; POP BC ;POINTER TO DPBASE ADD HL,BC ;HL=DPH POINTER ; PUSH HL ;SAVE DPH POINTER PUSH DE ;SAVE NEW DPB POINTER LD DE,DPHOFF ;OFFSET TO DPB POINTER ADD HL,DE ;GET POINTER TO DPB LD E,(HL) INC HL LD D,(HL) POP HL PUSH DE ; JR NZ,NOTAB ; LD BC,15 LDIR ;UPDATE DPB ; NOTAB: POP HL LD A,(HL) ;GET SECTORS PER TRACK LD (IY+SECTRK),A ;SAVE IN RAMDATY ; INC HL ;INC POINTER INC HL INC HL ; LD A,(HL) ;GET RECORDS PER ALLOC. BLOCK INC A LD (IY+UNAMAX),A ;SAVE IN RAMDATY ; POP DE ;RESTORE DPH POINTER LD A,0 ;NO ERROR STATUS RET ; SKPSET: OR 0FFH ;CLEAR Z FLAG JR SKPST1 ; GETAB: PUSH BC ; XOR A BIT HSTWRT,(IY+DFLAG) CALL NZ,WRTHST RES HSTWRT,(IY+DFLAG) RES HSTACT,(IY+DFLAG) POP BC OR A ;SEE IF ERROR RET NZ ; LD (IX+HSTDSK),C ;SET RAMDATX TO READ BOOT SECTOR LD (IX+HSTTRK),0 LD (IX+HSTSEC),1 CALL HOME ;HOME DRIVE ; JP RDHST ;READ BOOT SECTOR ; SDPB: DW 40 DB 4 DB 15 DB 1 DW 94 DW 127 DB 0C0H DB 0 DW 32 DW 2 ; page ;---------------------------------------------------------------------- ; Subroutine: DIAGNOSE ;--------------------- ; ; This routine is used to test the various functional blocks of the hardware. ; It displays a menu, from which you can select the test to be performed. ; diagnose: ld de,diagmsg ; print diagnostics signon msg call mesg ; and menu inlp: call ciny ; get test to run cp '1' ; adjust and check if in range jr c,inlp ; between 1, and... cp 3ah ; ... 9 jr nc,inlp push af call outcn ; output test number ld de,crlf ; if valid #, send cr/lf call mesg pop af sub '0' ; A = test number (1-9) ld (port),a ; set up port to use for bpole test dec a ; set base offset of 0 rlca ; calculate offset in dispatch table ld c,a xor a ld b,a ; bc = offset in dispatch table ld hl,dsptch ; hl = base of dispatch table add hl,bc ; hl = address of vector for selected ; diagnostic test ld e,(hl) inc hl ld d,(hl) ex de,hl call cntjp ; to indirect jump jr diagnose ; then return to menu dsptch: dw bpole ; test 1 = bpole on serial port 1 dw bpole ; 2 = bpole on serial port 2 dw bpole ; 3 = bpole on centronics port dw loopbk ; 4 = loop back test on serial port 2 dw mtest ; 5 = memory test dw rwtest ; 6 = floppy r/w test dw seektest ; 7 = floppy seek test dw vfotest ; 8 = vfo test dw diagboot ; boot system page ;---------------------------------------------------------------------- ; Subroutine: BPOLE ;------------------ ; ; This will print a barber-pole test pattern on the ports. The port ; to test is stored in location 'PORT'. 1 => serial port 1 ; 2 => serial port 2 ; 3 => centronics port ; bpole: ld hl,bgnchar ; initialize barberpole test ld (hl),20h ; a = character to print prntlp: ld b,4fh ; b = number of characters before cr/lf ld a,(hl) ; get character to start with outlp: call testout ; output the character inc a ; else, next character jp p,skipc ; send next character ld a,20h ; jump over control codes skipc: djnz outlp ; adjust character count ; if end, change start for next line shift: call keystat ; see if a key has been typed ret nz ; if so, then end test ld a,cr ; send out cr, lf call testout ; output the character ld a,lf call testout inc (hl) ; change starting character jp m,bpole ; if 80h, then re-start jr prntlp ; then print next line page ;---------------------------------------------------------------------- ; Subroutine: TESTOUT ;-------------------- ; ; Output a character to a port, where port saved in memory location 'PORT' ; On entry, A = character to output. This routine calls the appropriate ; output handler. ; testout: push af push bc ld c,a ld a,(port) ; get port to test cp 1 ; see if port 1 jr nz,port2 ; if not, check if port 2 call cnout ; if 1, test port 1 jr exitout ; restore, and return port2: cp 2 ; see if test for port 2 jr nz,cent ; no? then centronics call ser2out ; yes => use 2nd serial port jr exitout ; then restore and return cent: call centout ; must be centronics test exitout: pop bc pop af ; restore registers before return ret keystat: in a,(s1stat) ; read console status bit 1,a ; see if key hit ret page ;---------------------------------------------------------------------- ; Subroutine: LOOPBK ;------------------- ; ; Perform a loop-back test on serial port 2. Test ends when a key is pressed. ; loopbk: in a,(s2data) ; clear any character in buffer xor a ; starting character for test is null looptst: ld d,a ; character to look for ld c,a ; character to send in C call ser2out ; output char in C call ser2in ; get char from port 2 to acc. cp d ; did we get what we sent? jr nz,looperr ; jump if not call keystat ; else, was console key hit? jr nz,loopgd ld a,d ; get next char to send inc a jp p,looptst ; and send it loopgd: ld de,passed ; point to success mesg jr msgout ; and send message looperr: ld de,failed ; point to fail message msgout: call mesg ; print message ld de,loopmsg call mesg ret page ;---------------------------------------------------------------------- ; Subroutine: MTEST ;------------------ ; ; Perform memory test continually, until a key is hit on keyboard. ; mtest: ld de,tstmsg ; print memory test msg call mesg call clrerr ; clear error count and pass count memlp: ld hl,0 ; lowest address to test ld bc,diskbuf-1 ; highest address to test call memtest ; test memory call tsterr ; check error noerr: call prntpass ; print pass info call keystat ; see if key pressed jr z,memlp ; keep testing if no key ret ; else, return to test menu ; clrerr: xor a ; clear errors and pass ld (mempass),a ld (errors),a ret tsterr: or a ; see if error ret z ; return if not incerr: ld hl,errors ; increment error count inc (hl) ret prntpass: ; print pass info for test ld de,passmsg ; point to pass message call mesg ; print it ld a,(mempass) ; get number of passes made inc a ; increment by one ld (mempass),a ; save it call outbyte ; print it ld de,coln call mesg ld a,(errors) ; get number of errors found call outbyte ; print them ld de,errnum ; and a message call mesg ret page ;---------------------------------------------------------------------- ; RWTEST ;------- ; ; writes a worst case data pattern to track 39 of a selected drive, ; afterwhich it goes into a loop reading the data continually until a key ; is pressed on the keyboard. If CRC errors occur during the ID, or DATA ; areas, the error count is incremented. After each pass, the pass number, ; and the total number of errors detected since starting the test, is printed. ; ; rwtest: call setup ;set up tables, get drive to test ld (IX+HSTTRK),39 ; set to test track 39 ld (IX+SECCNT),5 ; set to read all five sectors call bldbuf ; build buffer of worst case data call clrerr ; clear error count rwloop: call wrtbuf ; write data to disk call rdbuf ; read data from disk call keystat ; check if key hit jr z,rwloop ; if no key hit, r/w again ret page ;---------------------------------------------------------------------- ; SETUP ;------ ; ; moves the ramdatx and ramdaty ares to ram, and selects the drive to ; be used for the test. ; setup: call xfrdata ; move ramdatx and ramdaty ld de,drvmsg ; prompt for drive to use call mesg ; print prompt drvlp: call ciny ; get drive and 0dfh ; force upper case sub 41h ; test for valid drive jr c,drvlp cp 4 jr nc,drvlp ld (IX+HSTDSK),a ; drive ok, so set up to use it push af ld de,insrt ; tell them to insert a disk call mesg pop af ; get back drive add a,41h ; turn to ascii call outcn ; tell which drive gets the diskette ld de,rtrnmsg ; point to rest of message call mesg call ciny ; get a character ld de,crlf ; output a cr and lf call mesg ret page ;---------------------------------------------------------------------- ; BLDBUF ;------- ; ; build a buffer of worst case data. ; pat1 equ 0aa5fh ; worst case pattern 1 pat2 equ 6db6h ; worst case pattern 2 tstbuf equ 8000h ; use 8000h as start of dma address bldbuf: ld bc,pat1 ; get first worst case pattern ld hl,tstbuf ; point to test buf push hl ; save testbuf ld de,tstbuf+2 ; point to dest. byte ld (hl),c ; save 1st byte of worst case pattern inc hl ld (hl),b ; save 2nd byte of pattern dec hl ; point to start for copy ld bc,800h ; copy 2k bytes ldir ; replicate pattern ld bc,pat2 ; rest gets 2nd pattern ld (hl),c inc hl ld (hl),b ; 2nd pattern set up dec hl ; start for move ld bc,0c00h ; 3k left to fill ldir ; fill it pop bc ;restore pointer to buffer area ld (IX+HSTBUF),c ;set dma addr. for disk I/O ld (IX+HSTBUF+1),b ;set dma address ret page ;---------------------------------------------------------------------- ; WRTBUF ;------- ; ; sets up the error flag for disk I/O, and writes the buffer to disk. ; wrtbuf: ld de,wrtmsg ; print Writing... call mesg ld (IX+ERFLAG),0FFh ; set type of error handling call wrthst ; write the data call tsterr ; check error ret ; else return to menu ;---------------------------------------------------------------------- ; RDBUF ;------ ; ; does disk reads of a worst case pattern from track 39 of the selected ; drive. If CRC errors occur, they are logged, and a record is printed out ; after each pass of the read. ; rdbuf: ld de,rdmsg ; print reading... call mesg ld (IX+ERFLAG),0ffh ; set type of error handling call rdhst ; read the data call tsterr ; check error call prntpass ret ; else return to menu page ;---------------------------------------------------------------------- ; SEEKTEST ;--------- ; ; performs a 'butterfly' seektest continually until a key is ; pressed on the keyboard. ; seektest: call setup ; get disk to test, and select it ld b,0 ; starting outer track ld c,39 ; starting inside track ld (IX+HSTBUF),0 ; set DMA address for command ld (IX+HSTBUF+1),80h ; at 8000h (arbitrary address) ld (IX+SECCNT),1 ; only 1 sector needs to be read call clrerr ; set error count to 0 seeklp: push bc ; save seek ranges call tstseek ; seek the two tracks pop bc ; get ranges back call nxtrng ; calculate next range call keystat ; check for key input jr z,seeklp ; if no key hit, test again ret ;---------------------------------------------------------------------- ; NXTRNG ;------- ; ; takes the b-c registers and adjusts them for the next track to seek ; to. For the butterfly pattern, the b register is incremented, and the c ; register is decremented. If the c register is decremented past zero, then ; it is time to change the direction for the seek. This is done by swapping ; the bc registers, and then re-adjusting them again. ; nxtrng: inc b ; increment track dec c ; decrement track jp m,swapbc ; if underflow, then it's time to swap ret ; otherwise, adjustment is done swapbc: ld a,b ; swap b-c pair, and readjust ld b,c ld c,a push bc ; save range call prntpass ; print pass info only after complete ; pass has been made. inc # of passes pop bc ; get back range values jr nxtrng ; swap done, so re-adjust bc page ;---------------------------------------------------------------------- ; TSTSEEK ;-------- ; ; seeks two tracks, keeping track of errors during the seek. If ; any errors occurred, then the error count is incremented. The tracks ; seeked are in the b-c pair upon entry. ; tstseek: push bc ; save tracks being seeked ld (IX+HSTTRK),b ; set first track to seek ld (IX+ERFLAG),0ffh ; set for error reporting/ no handling call rdhst ; read the sector call tsterr ; check error pop bc ; get other track to seek ld (IX+HSTTRK),c ; set other track to seek ld (IX+ERFLAG),0ffh ; set type of error handling call rdhst ; read the other sector call tsterr ; check error ret ;---------------------------------------------------------------------- ; VFOTEST ;-------- ; ; tries to read track zero continually until a key is hit on the ; keyboard. It is used to check the VFO to see if it's in range. When ; performing this test, error handling is completely turned off. ; vfotest: call xfrdata ; move ramdatx, ramdaty xor a ld (IX+HSTDSK),a ; select drive 'A' ld (IX+HSTTRK),a ; track zero ld (IX+SECCNT),1 ; set for one sector ld (IX+HSTBUF),0 ; set DMA address ld (IX+HSTBUF+1),80h vfoadj: ld (IX+ERFLAG),0feh ; turn off error handling call rdhst ; do a read call keystat ; look for a key jr z,vfoadj ; keep reading until a key is hit ret page ; ;***************************************** ; This section of code is run at FC00h!!!! ;***************************************** ; block: .phase diskbuf ; stblk: in a,(romctl) ; turn off rom ld a,(00) ; get value at loc. 0 cp 0c3h ; test if it's jp op code out (romctl),a ; turn on rom... ret z ; if jp then warm boot ; else, start testing system test: ld de,tstmsg ; point to test msg. call mesg ; print it ld hl,0 ; low addr to test ld bc,diskbuf-1 ; highest to test call memtest ; test memory or a ; test flags ld de,rambad ; point to rammsg jp nz,ramerr ; if memfail, then jump ld de,romok ; point to memory ok message call mesg ; and print it ret ; if ok, then go page ;---------------------------------------------------------------------- ; Subroutine: MEMTEST ;-------------------- ; ; Function: This routine performs a memory test on a block of memory. ; The block of memory may be of any size, and is determined ; by the values passed upon entry. ; When called, register pair HL points to the start of the ; block to be tested, and register pair BC points to the last ; location to be tested. When an error is encountered, the ; routine will return a non-zero value in the accumulator. ; When no errors are found, the routine will return with ; the accumulator equal to zero. ; memtest: in a,(romctl) ; turn off ROM ld (smem),hl ; save start pointer ld hl,patlst ; point to test table testlp: ld d,(hl) ; get data to test inc hl bit 7,(hl) ; check if end of table jr nz,pass ; if so, then passed ld e,(hl) ; get offset(0,1,2)& rd/wr bit 6,e ; test if read or write res 6,e ; reset the bit inc hl push hl ; save table pointer jr z,fill ; 0==> fill memory call check ; 1==> check memory jr over fill: ld ix,wrmem ; calculate start call testm ; test memory over: pop hl ; restore table pointer jr testlp ; loop while not done pass: ld a,0c3h ;put jump in 0 ld (0),a xor a ; set accumulator to pass out (romctl),a ; turn ROM back on ret ; return success check: ld ix,rdmem ; set for read testm: ld hl,(smem) ; get where to start LD A,E ; get offset from start ADD A,L ; compute actual starting LD L,A ; address ; hl<==hl+offset LD A,H ; ADC A,0 LD H,A lp: call indjp ; indirect jump via ix INC HL ; skip two bytes INC HL INC HL LD A,B CP H RET C jr NZ,lp ; if top not reached, keep going LD A,C CP L RET C jr lp indjp: jp (ix) ; perform jump to wr or rd wrmem: LD (HL),D ; write test value ret rdmem: ld a,(hl) ; get test value cp d jr nz,err ret ERR: ld e,a out (romctl),a ; made error, so turn on ROM in a,(0f5h) ; see if in diagnostics mode bit 5,a call z,outhl ; output full error msg if in ; diagnostics mode pop af pop af pop af LD A,0FFH ret page ;---------------------------------------------------------------------- ; Subroutine: OUTHL ;------------------ ; ; This routine prints out the memory location at which the error occured, ; followed by the data read from RAM, and what it expected to read. ; outhl: push de ld de,readmsg ; point to message call mesg ; print it in a,(romctl) ; get ROM out of the way pop de ; get value read push de ld a,e out (romctl),a ; turn ROM back on call outbyte ; output it in hex ld de,expctmsg ; point to message call mesg ; print it pop de ; get back expected value ld a,d call outbyte ; print expected value in hex ld de,rammsg ; point to ram error mesg call mesg ; print it, ld a,h ; get high byte of address call outbyte ; print it ld a,l ; get low byte of address call outbyte ; print it ret ;---------------------------------------------------------------------- ; Subroutine: OUTBYTE ;-------------------- ; ; This will print the hex value of the accumulator. ; outbyte: push af ; save value rrca ; get upper nibble rrca rrca rrca and 0fh ; mask off the rest call outasc ; print ascii hex digit pop af ; get value back and 0fh ; mask ; print ascii hex digit ;---------------------------------------------------------------------- ; Subroutine: OUTASC ;------------------- ; ; This routine outputs the lower nibble of the accumulator as a hex digit. ; outasc: cp 0ah ; see if digit or alpha jr c,num ; jump if digit add a,07h ; adjust for alpha num: add a,30h ; convert to ascii ld c,a call outcn ; print it ret page ;---------------------------------------------------------------------- ; MEMORY PATTERN TEST TABLE ;-------------------------- ; ; format is: ; 1st byte -- value to use (0-ffh) ; 2nd byte -- bit 6 r/w flag 0 => write ; 1 => read ; bits [0,1] offset (0,1,2) ; patlst: db 0ffh,wr or 0 db 00,wr or 1 db 0ffh,wr or 2 db 00,rd or 1 db 0ffh,rd or 2 db 0ffh,rd or 0 db 00,wr or 0 db 0ffh,wr or 1 db 00,wr or 2 db 00,rd or 2 db 00,rd or 0 db 0ffh,rd or 1 db 0aah,wr or 0 db 55h,wr or 2 db 0aah,wr or 1 db 0aah,rd or 1 db 55h,wr or 1 db 0aah,rd or 0 db 55h,wr or 0 db 55h,rd or 2 db 55h,rd or 1 db 55h,rd or 0 db 00,80h ; msb=1 ==> end of pattern list ; SMEM equ $ endblk equ stblk + 100h ; .dephase page ;---------------------------------------------------------------------- ; Messages ;--------- ; SKM: DC 'Wrong track.' DB 0 WPM: DC 'Write protected.' DB 0 CRM: DC 'Data error.' DB 0 URM: DC 'Not found.' DB 0 SYM: DC 'Lost data.' DB 0 NRM: DC 'Drive not ready.' DB 0 EQM EQU NRM ICM: DC 'Invalid command.' DB 0 UNM: DC 'Unknown error.' DB 0 DMESG: DW 0A0DH DC 'Disk error on drive ' DB 0 RESM: DW 0A0DH DC 'Type R to try again, A to abort, or I to ignore: ' DB 0 BTERR: DB 0AH DB 'Error on CP/M system diskette.',0 RERR: DW 0A0DH DC 'Push reset to try again. ' DB 0 clr_term: db esc,'%',esc,'G0',0 signon: db cr,'Micro-Decision -- ROM Rev. ' db ((rev and 0f0h) shr 4)+asc0,'.',(rev and 0fh)+asc0,cr,lf db 'Copyright 1982,1983,1984 Morrow Designs, Inc.',cr,lf,lf,0 tstmsg: db 'Testing memory -- please stand by: ',0 romok: db 'Memory O.K.',cr,lf,lf,0 bootmsg: db 'Insert CP/M system diskette in Drive A' rtrnmsg: db ' and press [RETURN] ',bell,0 rommsg: db bell,bell,'ROM Memory error',0 rambad: db bell,bell,'RAM Memory error',0 readmsg: db bell,bell,cr,lf,'Read ',0 expctmsg: db ' expected ',0 rammsg: db ' at RAM location ',0 diagmsg: db cr,lf,'Diagnostics Menu',cr,lf,lf db '1) Port 1 \',cr,lf db '2) Port 2 > Barber-Pole pattern test',cr,lf db '3) Centronics port /',cr,lf db '4) Loop back on port 2',cr,lf db '5) RAM test',cr,lf db '6) FDC R/W',cr,lf db '7) FDC seek test',cr,lf db '8) VFO test',cr,lf db '9) Boot',cr,lf,lf db 'Enter #:',0 passmsg: db cr,lf,'End of pass ',0 errnum: db ' errors so far.',0 loopmsg: db 'loop test.',0 failed: db cr,lf,'Failed ',0 passed: db cr,lf,'Passed ',0 drvmsg: db 'Enter drive to test (A-D):',0 insrt: db cr,lf,'Insert a formatted diskette in drive ',0 wrtmsg: db cr,lf,'Writing...',0 rdmsg: db 'reading',0 CRLF: DW 0A0DH DB 0 COLN: DC ': ' DB 0 page ;---------------------------------------------------------------------- ;DATA TABLES ;----------- ; ROMDATX: RHSTDV: DB 0 RHSTTK: DB 0 RHSTSC: DB 1 RSECCT: DB 1 RRETRY: DB 10 RHSTBF: DW BOOTBF RERFLG: DB 0 RPHYTK: DB 0 RPHYHD: DB 0 RIOADD: DW RDIO RSECSZ: DW 0 RSTADD: DW 0 DW 0 DW 0 DB 0 RCMDCT: DB 9 RCMDBF: DB 46H DB 0 DB 0 DB 0 DB 1 DB 3 DB 5 DB 28 DB 0FFH page IYOFF EQU $-ROMDATX ; ROMDATY: RSEKDK: DB 0 RSEKTK: DB 0 RSEKSC: DB 0 ; RSEKHT: DB 0 ; RUNACT: DB 0 RUNADK: DB 0 RUNATK: DB 0 RUNASC: DB 0 RUNAMX: DB 0 RSECTK: DB 0 ; RWRTYP: DB 0 RDFLAG: DB 0 RTRSEC: DB 0 ; RVMSGP: DW 0 RVDRVP: DW 0 ; RCDSK: DB 0FFH RPDSK: DB 0 RVDSK: DB 0 ; RDMADR: DW 0 ROUTP: DW CNOUT RINP: DW CNIN page ;---------------------------------------------------------------------- ; M-Tables ;--------- ; MTAB contains one 9 byte entry for each logical drive. ; The bytes of each entry are defined as follows: ; ; Byte 0 DSKDEF0: ; Bit 0-2 Motor control bit ; Bit 3-4 Double sided mode: ; 00=Even tracks on side 0, ; Odd tracks on side 1. ; 01=1st 40 (or 80) tracks ; on side 0, remaining ; tracks on side 1. ; 10=Both sides are treated ; as a single track with ; twice as many sectors. ; Bit 5 Double sided drive if = 1. ; Bit 6 Sectors start at 0 if = 1. ; Bit 7 Foreign drive format if = 1. ; ; Byte 1 DSKDEF1: ; Bit 0-1 Physical drive address. ; Bit 2 Double sided drive if = 1. ; Bit 3-4 Sector size: ; 00=128 ; 01=256 ; 10=512 ; 11=1024. ; Bit 5 Tracks: 0=40; 1=80. ; Bit 6 Density: 0=single; 1=double. ; Bit 7 Virtual drive: 1=virtual. ; ; Byte 2 Motor on wait time in increments of 4 ms. ; ; Byte 3 Head settle time (after seek) in increments ; of 4 ms. ; ; Byte 4-5 The two parameter bytes for the FDC specify ; command: Byte 4 = SRT/HUT ; Byte 5 = HLT/ND ; ND must be 1. ; ; Byte 6 EOT byte for FDC read or write commands. ; ; Byte 7 GPL byte for FDC read or write commands. ; ; Byte 8 Current track. page ; Drive 1 parameter table RMTAB: DB 1 DB 0D8H DB 88 DB 5 DB 6FH DB 3 DB 5 DB 28 DB 0FFH ; Drive 2 parameter table DB 2 DB 59H DB 88 DB 5 DB 6FH DB 3 DB 5 DB 28 DB 0FFH ; Drive 3 parameter table DB 4 DB 5AH DB 88 DB 5 DB 6FH DB 3 DB 5 DB 28 DB 0FFH ; Drive 4 parameter table DB 4 DB 5BH DB 88 DB 5 DB 6FH DB 3 DB 5 DB 28 DB 0FFH page DATLNG EQU $-ROMDATX ETAB: DW WPM DW SKM DW CRM DW CRM DW URM DW NRM DW SYM DW EQM DW ICM DW UNM DS (ROM+1000H-$),0FFH ;***************************************************************************** ; CAUTION: The last 3 bytes (ffd-fff) are reserved for serial ; number. They must be left as ff. ;***************************************************************************** END