IMD 1.17: 5/01/2010 21:40:14 rom24.mac rom24.prn m80 c80 l80 m80=rom24/c c80=rom24 l80=rom24,rom24/n/e 28 dec 83 >2!9^#V!1 Not a SYSTEM Diskette. (0>2!9^#V!1 Not a SYSTEM Diskette. CBIOS MACV ROM24 MAC ROM24 MAC~!"#$%&'()*+,-./0C80 COM12L80 COMT345678M80 COM9:;<=>?@ABROM24 PRNCDEFGHIJKLMNOPQRROM24 PRNSTUVWXYZ[\]^_`abROM24 PRNcdefghijklmnopqrROM24 PRNstuvwxyz{|}~ROM24 PRN ROM24 PRN ROM24 PRN $CAT COM ;Sector must be read if = 1. ; READOP EQU 3 ;Read if = 1. Write if = 0. ; HNDSHK EQU 4 ;Handshake with DSR and CTS if 1, just CTS if 0. ; LSTMAP EQU 5 ;1=>Cent. is LST:, SER2 is PUN: ;0=>SER2 is LST:, Cent. is PUN: ; IMS EQU 6 ;In Memory Submit flag. ;I.M.S. in-active if = 0. ;I.M.S. active if = 1. ; IMSBUF EQU 7 ;In Memory Submit buffer empty flag. ;I.M.S. buffer is empty if = 0. ;I.M.S. buffer is not empty if = 1. ; ; ROMCTL EQU 0F6H ; DPHOFF EQU 10 ; BDFM EQU 5 NRDY EQU 6 SIZMSK EQU 18H DSM EQU 2 ; ; WRALL EQU 0 WRDIR EQU 1 WRUAL EQU 2 ; ; S1STAT EQU 0FDH S1DATA EQU 0FCH ; S2DATA EQU 0FEH S2STAT EQU 0FFH ; CSTAT EQU 0F5H CTCSEL EQU 0F3H ; CHANNEL SELECT PORT FOR CTC CH1DIV EQU 0F1H ; PORT FOR SETTING BAUD RATE OF 1st SERIAL PORT CH2DIV EQU 0F2H ; PORT FOR SETTING BAUD RATE OF 2nd SERIAL PORT DFLT1 EQU 06h ; default baud rate for 1st serial port DFLT2 EQU 03h ; default baud rate for 2nd serial port ; CR EQU 0DH LF EQU 0AH ASC0 EQU 30H ;  LD A,0C3H LD (0),A LD (5),A ; XOR A LD (3),A ; PUSH HL LD HL,WBOT LD (1),HL ; LD HL,BDOS LD (6),HL ; LD HL,(VNUMB) LD (8),HL ; LD A,(IY+DFLAG) AND 0B0H ;MASK IMSBUF FLAG, DON'T CHANGE BITS 4 OR 5 SET IMS,A ;ACTIVATE IMS LD (IY+DFLAG),A ; LD (IY+UNACNT),0 ; LD A,(4) LD C,A ; POP HL JP (HL) ; BTERR: OUT (ROMCTL),A JP BTERM ; ; INITCTC: ; SET BAUD RATES FOR BOTH SERIAL PORTS LD A,07EH ; SELECT CTC CHANNEL 1 OUT (CTCSEL),A LD A,(SER1BAUD) ; GET BAUD RATE FOR 1st SERIAL PORT LD C,A CALL GETVAL ; POINT TO DIVISOR LD C,CH1DIV ; SET UP TO LOAD DIVISOR FOR CHANNEL 1 CALL SETBAUD ; SET BAUD RATE FOR 1st SERIAL PORT LD A,0BEH ; SELECT CTC CHANNEL 2 OUT (CTCSEL),A LD A,(SER2BAUD) ; GET BAUD RATE FOR 2nd SERIAL PORT LD C,A CALL GETVAL ; POINT TO DIVISOR LD C,CH2DIV ; SET UP TO LOAD DIVISOR FOR CHANNEL 2 CALL SETBAUD ; SET IT RET ; GETVAL: ; SET HL TO POINT TO DIVISOR FOR SELECTED ; BAUD RATE. C IS OFFSET FROM BASE ON ENTRY LD ; MICRO-DECISION ; CP/M 2.2 ; BIOS REV 2.2 ; COPYRIGHT 1982,1983 ; MORROW DESIGNS, INC. ; SAN LEANDRO, CA. ; ; 06/20/83 ; ;*********************************************************************** ; DOUBLE SIDED ;*********************************************************************** ; .Z80 ; MEMSIZE EQU 64 ; REV EQU 22H ; CPM EQU (MEMSIZE-9)*1024 BDOS EQU CPM+806H BIOS EQU CPM+1600H ; .PHASE BIOS ; ; ROM EQU 0 ; HMRM EQU ROM+6 WRHSRM EQU ROM+0CH RDHSRM EQU ROM+9 DISRM EQU ROM+0FH BTERM EQU ROM+18H ROMDATX EQU ROM+1BH MSGRM EQU ROM+3 CENTDRV EQU ROM+1DH ;ROM ENTRY POINT FOR CENTRONICS DRIVER RDLSEC EQU ROM+20H WRTLSEC EQU ROM+23H ; ; CONTROL BITS WITHIN DFLAG BYTE HSTACT EQU 0 ;Host buffer active flag. ;Buffer contains nothing if = 0. ;Buffer contains a sector if = 1. ; HSTWRT EQU 1 ;Host buffer dirty flag. ;Buffer has not been written to if = 0. ;Buffer has been written to if = 1. ; RSFLAG EQU 2 ;Read sector flag. ;Sector need not be read if = 0. START: JP BOOT WBOT: JP WBOOT JP CONST JP CONIN CNOUT: JP CONOUT JP LST JP PUN JP PTR JP HOME JP SELDSK JP SETTRK JP SETSEC JP SETDMA JP READ JP WRITE JP LISTST JP SECTRAN ; JP CVMSG ;CHANGE VIRTUAL DRIVE MESG. ; JP RDBLK ;DIRECT DISK READ JP WRBLK ;DIRECT DISK WR JP DISCIO ;DIRECT DISK I/O ; DB REV DW RAMDATX DW RAMDATY DW MTAB DW XLTAB ; ETBLPTR:DW ESCTBL CTBLPTR:DW CTRLTBL EVCTPTR:DW ESCVECT CVCTPTR:DW CTVECT DW DCASTRT ; JP INITCTC ;CTC init routine ; WBOOT: LD SP,STACK LD DE,DSKBUF PUSH DE POP IX LD BC,DATXLN OUT (ROMCTL),A ;TURN ON ROM LD HL,(ROMDATX) LDIR ; LD IY,RAMDATY ; LD (IX+HSTSEC),2 LD (IX+SECCNT),8 LD (IX+SECSIZ+1),81H LD (IX+HSTBUF+1),HIGH CPM ; CALL RDHST ; LD A,(IX+ERFLAG) OR A JP NZ,BTERR ; LD (IX+HSTSEC),1 LD (IX+HSTTRK),1 LD (IX+SECCNT),3 LD (IX+HSTBUF+1),HIGH CPM + 16 ; CALL RDHST ; LD A,(IX+ERFLAG) OR A JP NZ,BTERR ; LD HL,CPM+3 ; GOCPM: LD BC,80H CALL SETDMA ; HL,BAUDTBL ; POINT TO BASE OF TABLE LD B,0 ADD HL,BC ADD HL,BC ; HL NOW POINTS TO DIVISOR FOR SELECTED BAUD RATE RET ; SETBAUD: ; OUTPUT THE VALUES POINTED TO BY HL TO THE ; PORT SELECTED IN REG. C. LD A,(HL) ; GET LOW BYTE OF DIVISOR OUT (C),A ; OUTPUT IT INC HL ; POINT TO HIGH BYTE LD A,(HL) ; GET THE HIGH BYTE OF DIVISOR OUT (C),A ; OUTPUT IT RET ; baudtbl: ; DIVISOR TABLE FOR BAUD RATES ; DW 1136 ;110 DW 417 ;300 DW 208 ;600 DW 104 ;1200 DW 52 ;2400 DW 26 ;4800 DW 13 ;9600 ; ; CONST: IN A,(S1STAT) ;CONSOLE STATUS ROUTINE AND 2 ;SEE IF RDY RET Z ;RETURN WITH 0 IF NOT RDY LD A,0FFH ;RETURN WITH FF IF RDY RET ; CONIN: LD A,(RAMDATY+DFLAG) ;GET DFLAG AND 0C0H ;MASK OUT IMS FLAGS CP 0C0H ;CHECK IF IMS ACTIVE JR Z,SUBMT ;JMP IF SUBMIT ACTIVE ; CNIN: IN A,(S1STAT) ;CONSOLE INPUT ROUTINE BIT 1,A ;SEE IF RDY JR Z,CNIN ;JMP IF NOT RDY ; IN A,(S1DATA) ;GET CHARACTER CHRET: AND 7FH ;MASK OFF PARITY RET ; ; SUBMT locatesHL),E INC HL ; LD A,E ;SEE IF LAST CHAR. OR D LD A,(RAMDATY+DFLAG) JR NZ,SKP1 ;JMP IF NOT LAST CHAR. ; RES IMSBUF,A ;CLEAR IMSBUF FLAG ; SKP1: BIT PARITY,(HL) ;CHECK PARITY BIT OF CHAR. JR Z,SKP2 ;JMP IF PARITY = 0 ; RES IMS,A ;DE-ACTIVATE IMS ; SKP2: LD (RAMDATY+DFLAG),A ;SAVE DFLAG ; LD A,(HL) ;GET CHAR. LD (HL),D ;FINISH UPDATING IMS BLOCK HEADER JR CHRET ;RETURN TO CP/M ; ; FIND searches BIOS ram area starting from HL for the block ; header contained in A. ; FIND: CP (HL) ;SEE IF HEADER CODE MATCHES INC HL ;INCREMENT POINTER ; LD E,(HL) ;GET OFFSET TO NEXT BLOCK INC HL LD D,(HL) ; RET Z ;RETURN IF BLOCK FOUND ; INC HL ;SET POINTER TO NEXT BLOCK ADD HL,DE JR FIND ;KEEP LOOKING ; ; ; On entry to XLATE, 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 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 ; ; 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  the submit string block within the BIOS ram area, ; the next character is taken from the buffer and passed to CP/M. ; The free block and submit string block pointers are updated. ; If this was the last character in the buffer, then the IMSBUF ; bit in dflag is cleared. ; If the parity bit is set on the character, then the IMS bit in ; dflag is cleared, which de-activates IMS until the next warm ; boot. ; ; PARITY EQU 7 ; SUBMT: IN A,(S1STAT) ;SEE IF CHAR. READY BIT 1,A JR Z,SUBGO ;JMP IF NO INPUT ; IN A,(S1DATA) ;GET CHAR. CP 3 ;SEE IF CNTL-C JR NZ,SUBGO ;JMP IF NOT ; LD A,(RAMDATY+DFLAG) ;DE-ACTIVATE IMS RES IMSBUF,A LD (RAMDATY+DFLAG),A ; LD A,18H RET ; SUBGO: LD HL,XLTAB ;POINTER TO RAM AREA LD A,0FFH ;FREE SPACE CODE CALL FIND ;FIND FREE SPACE ; INC DE ;UPDATE FREE SPACE POINTER LD (HL),D DEC HL LD (HL),E ; ADD HL,DE ;SET HL ==> IMS BUFFER INC HL INC HL ; LD E,(HL) ;UPDATE IMS BUFFER HEADER LD (HL),0FDH INC HL LD D,(HL) DEC DE LD (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 ; conout: ld a,(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 ; if not, then xmit it ld a,esc ; check if esc char cp c ; jp nz,notesc ; if not, jump ld a,1 ; otherwise, set escape ld (esc_lvl),a ; level to 1st stage ret ; and return notesc: ld hl,(ctblptr) ; set to search control table call lookup ; and lookup character in table or a ; see if char found jp z,cout ; if not, output char ld hl,(cvctptr) ; calculate string location ; ; 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 sign, ; then two more characters will be accepted, after-which a string ; will be output for positioning the cursor. ; escape: ld a,(esc_lvl) ; get current escape level cp 1 ; level 1? jr z,seq1 ; then process 1st part cp 2 ; level 2? jr z,seq2 ; then process 2nd level jr seq3 ; it must be level 3 ; seq1: ld a,'=' ; equal sign? cp c ; if char is =, then DCA started jr z,set ; else, could be character to xlate xor a ; clear escape level ld (esc_lvl),a ld hl,(etblptr) ; point to xlate table 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 jp cout ; send it ; down: ld hl,(evctptr) ; calculate string location jr outstr ; output the string set: ld a,2 ; otherwise, set for level 2 ld (esc_lvl),a ; processing ret ; and return ; seq2: ld a,c ld (first),a ; this is the first char ld a,3 ; set char to output ld c,a pop af call nz,ascout ; call ascii if flag set call cout ; output char ; outend: ld hl,dcaend ; point to dca terminator jp loop ; ; ; 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. The maximum number of values in the table is ; 20 h. ; lookup: ld b,0 ; init offset nmtch: ld a,(hl) ; get value from table cp 0ffh ; see if end of table jr z,nochar ; jmp if end ; cp c ; see if char matches jr z,mtch ; jmp if match ; inc hl ; inc table pointer inc b ; inc offset inc b ; " " jr nmtch ; continue search ; mtch: ld c,b ; put offset in bc ld b,0 ld a,0STATUS OF LSTFLG JR Z,LSTDRV ; IF NOT READY, LOOP OVER: LD A,C ; ELSE, GET CHAR OUT (S2DATA),A ; XMIT IT RET ; ; LISTST: LD A,(RAMDATY+DFLAG) ; GET PORT MAPPING BIT 5,A ; SEE IF CENTRONICS PORT JR NZ,CENTSTAT ; IF CENTRONICS, CHECK IT'S STATUS SSTAT: CALL RDRSTAT ; GET A CHARACTER, OR NULL CP 13H ; IF XOFF R'CVD... JR NZ,NXTCHK ; IF NOT, CHECK IF XON XOR A ; SET FLAG TO NOT RDY LD (LSTFLG),A RET ; RETURN NOT RDY NXTCHK: CP 11H ; IF XON, THEN IT MIGHT BE READY JR NZ,CHKFLG ; ELSE, STATE NOT CHANGING LD A,0FFH LD (LSTFLG),A ; SET FLAG TO RDY CHKFLG: LD A,(LSTFLG) ; GET STATUS FLAG LSTRET: OR A ; SET FLAGS RET Z ; IF ZERO, THEN XOFF PENDING LD A,(RAMDATY+DFLAG) ;SEE IF HRDWR HNDSHKNG ENABLED BIT 4,A JR Z,CTS ; IF 0, THEN USE ONLY CTS HANDSHAKING IN A,(S2STAT) ; GET STATUS AND 85H ; CHECK IF XMIT READY CP 85H ; SET FLAGS ON STATUS OF TBRE AND DSR JR STAT ; JUMP TO STATUS TEST CTS: IN A,(S2STAT) ; TEST STATUS, IGNORE DSR BIT AND 05h ; GET TBREfor level 3 ld (esc_lvl),a ret ; seq3: ld a,(offset2) ; get offset for 2nd char add a,c ; add to 2nd char ld (second),a ; save 2nd char ; ld a,0 ld (esc_lvl),a ; clear escape sequence ; ld de,first ; pointer to 1st char ; ld a,(de) ; get 1st char ld c,a ; save in c ld a,(offset1) ; get offset for 1st char add a,c ; add to 1st char ld (de),a ; save 1st char ; ld a,(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 ; ld hl,dcastrt ; pointer to dca prefix sting 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 ; ld hl,dcamid ; pointer to seperator string call loop ; output string ; 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 ffh ; set a to success ret ; nochar: xor a ; set a to failure ret ; ; ; 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 ; ; COUT: IN A,(S1STAT) ;CONSOLE OUTPUT ROUTINE BIT 0,A ;SEE IF RDY JR Z,COUT ;JMP IF NOT RDY ; LD A,C ;OUTPUT CHARACTER OUT (S1DATA),A RET ; ;XON/XOFF PROTOCOL HANDLER FOR MICRO DECISION CBIOS ; LST: LD A,(RAMDATY+DFLAG) ; GET FLAG BYTE TO CHECK WHICH OUTPUT DRIVER BIT 5,A ; SEE IF CENTRONICS BIT SET JR NZ,CENTOUT ; IF SO, USE CENTRONICS DRIVER ; ELSE, USE SERIAL PORT DRIVER LSTDRV: CALL SSTAT ;  FLAG CP 05h ; SET FLAGS ON STATUS OF TBRE STAT: LD A,0 ; SET NOT READY STATUS JR NZ,LSTRET ; JMP IF NOT READY DEC A ; SET READY STATUS RET ; AND RETURN IT. ; ; RDRSTAT: IN A,(S2STAT) ; GET STATUS AND 2 RET Z ; RETURN IF NO CHAR IN A,(S2DATA) ; ELSE, GET CHAR AND 7FH ; MASK PARITY SCF ; SET FLAG RET ; CENTSTAT: IN A,(CSTAT) ; CHECK CENTRONICS RDY STATUS BIT 4,A LD A,0 RET NZ DEC A RET ; ; PTR: CALL RDRSTAT ;GET STATUS OR CHAR. JR NC,PTR ;LOOP IF NO CHAR. RET ; PUN: LD A,(RAMDATY+DFLAG) ;CHECK IF CENT. OR SERIAL BIT 5,A JR Z,CENTOUT ;IF ZERO, THEN USE CENTRONICS JR LSTDRV ; USE SERIAL PORT DRIVER CENTOUT: CALL MSTK ; SAVE STACK OUT (ROMCTL),A ; TURN ON ROM CALL CENTDRV ; USE ROM CENTRONICS DRIVER IN A,(ROMCTL) ; TURN OFF ROM POP HL ; RESTORE STACK LD SP,HL RET ; HOME: CALL MSTK ;FIX STACK ; PUSH IX ;SAVE IX & IY PUSH IY ; LD IX,RAMDATX ;INIT IX & IY LD IY,RAMDATY ; OUT (ROMCTL),A ;TURN ON ROM ; CAL) ;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,SSIDE ;ASSUME S.S. IF INVALID TABLE ; OR A ;CHECK 0-CHECK BYTE JR Z,SSIDE ;INVALID TABLE IF ZERO ; DSKTDB EQU DSKBUF+80H+9 LD DE,DSKTDB ;POINTER TO DPB IN BOOT ; BIT DSM,(HL) ;SEE IF D.S. MEDIA JR Z,SSIDE ;JP IF S.S. ; POP HL ;GET DSKDEF POINTER SET DSM,(HL) ;SET FOR D.S. MEDIA JR DSIDE ; SSIDE: 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 ; LD BC,DPBASE ADD HL,BC ;HL=DPB POINTER ; PUSH HL ;SAVE DPB POINTER PUSH DE ;SAVE NEW DPB POINTER LD DE,DPHOFF ;OFFSET TO DPH POINTER ADD HL,DE ;GET POINTER TO DPH LD E,(HL) IK ; PUSH IX ;SAVE IX & IY PUSH IY ; LD IX,RAMDATX ;INIT IX & IY LD IY,RAMDATY ; OUT (ROMCTL),A ; TURN ON ROM CALL WRTLSEC ; WRITE A LOGICAL SECTOR ; ; RWMOVE: OR A ; SET FLAGS ON ACC IN A,(ROMCTL) ; TURN OFF ROM JR NZ,DIRET ; JUMP IF ERROR DURING READ OR WRITE LDIR ;MOVE SECTOR ; LD A,(IY+WRTYPE) ;CHECK IF DIR WRITE CP WRDIR LD A,0 ;A=NO ERROR STATUS IN CASE WE'RE DONE JR NZ,DIRET ;JMP IF NOT DIR WRITE ; RES HSTWRT,(IY+DFLAG) ;CLEAR WRITE FLAG ; CALL WRTHST ;WRITE BUFFER ; DIRET: POP IY ;RESTORE IX & IY POP IX ; POP HL ;RESTORE STACK LD SP,HL ; CP BDFM ;SEE IF UNREADABLE JP Z,BDRV ;JMP IF UNREADABLE ; CP NRDY ;SEE IF NOT READY JP Z,BDRV ;JMP IF NOT READY ; RET ; GETAB: CALL MSTK ;FIX STACK PUSH IX PUSH IY PUSH BC LD IX,RAMDATX LD IY,RAMDATY ; XOR A BIT HSTWRT,(IY+DFLAG) CALL NZ,WRTHST RES HSTWRT,(IY+DFLAG) RES HSTACT,(IY+DFLAG) POP BC OR A ;SEE IF ERROR JR NZ,DIRET ; LD (IX+HSTDSK),C ;SET RAMDATX TO READ BOOTL HMRM ;CALL ROM ; CRETN: IN A,(ROMCTL) ;TURN OFF ROM POP IY ;RESTORE IX & IY POP IX ; POP HL LD SP,HL ;FIX STACK ; RET ; MSTK: POP DE ;SAVE RET. ADDR. ; LD HL,0 ;GET CURRENT STACK ADD HL,SP ;IN HL. ; LD SP,STACK ;MOVE STACK PUSH HL ;SAVE OLD STACK ; PUSH DE ;RESTORE RET. ADDR. RET ; SELDSK: LD A,4 ;CHECK DRIVE BOUND CP C JR C,BDRV ;JMP IF BAD ; LD A,C ;SET DRIVE LD (SEKDSK+RAMDATY),A ; BIT 0,E ;SEE IF FIRST TIME JR NZ,SKPSET ;JP IF NOT FIRST ; LD HL,RAMDATY ;POINTER TO RAMDATY LD A,C CALL GDSK1 ;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 OR A ;SEE IF ERROR JP NZ,0 ;WARM BOOT IF ERROR ; DSKTB EQU DSKBUF+80H+25 ;CHECK FOR VALID TABLE LD HL,DSKTB ;POINTER TO END OF TABLE+1 LD B,25 ;COUNT MUST BE ODD! LD E,0 ;INIT 0-CHECK BYTE ; ; ACC IS 0 ALREADY CHKLP: DEC HL ;DEC POINTER XOR (HLNC 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 (SECTRK+RAMDATY),A ;SAVE IN RAMDATY ; INC HL ;INC POINTER INC HL ; LD A,8 ;GET RECORDS PER ALLOC. BLOCK BIT 2,(HL) JR Z,K1 ;JMP IF 1K BLOCKS ; LD A,16 ;2K VALUE ; K1: LD (UNAMAX+RAMDATY),A ;SAVE IN RAMDATY ; POP HL ;RESTORE DPB POINTER RET ; SKPSET: OR 0FFH ;CLEAR Z FLAG JR SKPST1 ; BDRV: LD HL,4 ;RETURN ERROR CODE AND LD (HL),H ;SET TO DRIVE A. LD L,H RET ; ; SETTRK: LD A,C ;SET TRACK IN RAMDATY LD (SEKTRK+RAMDATY),A RET ; ; SETSEC: LD A,C ;SET SECTOR IN RAMDATY LD (SEKSEC+RAMDATY),A RET ; ; SETDMA: LD (DMAADR+RAMDATY),BC ;SET DMA ADDRESS IN RAMDATY RET ; ; READ: CALL MSTK ;FIX THE STACK ; PUSH IX ;SAVE IX & IY PUSH IY ; LD IX,RAMDATX ;INIT IX & IY LD IY,RAMDATY ; OUT (ROMCTL),A ; TURN ON ROM CALL RDLSEC ; READ A LOGICAL SECTOR JR RWMOVE ; MOVE DATA ; WRITE: CALL MSTK ;FIX THE STAC SECTOR LD (IX+HSTTRK),0 LD (IX+HSTSEC),1 OUT (ROMCTL),A ;TURN ON ROM CALL HMRM ;HOME DRIVE ; CALL RDHST ;READ BOOT SECTOR JR DIRET ; SECTRAN:LD L,C ;HL=BC LD H,B ; INC HL ;START SECTORS AT 1 ; LD A,D ;SEE IF XLAT TABLE OR E RET Z ;RETURN IF NO XLAT ; EX DE,HL ;HL=XLT ; ADD HL,BC ;ADD TO TABLE LD L,(HL) ;GET XLATED SECTOR LD H,0 ; RET ; ; WRTHST: OUT (ROMCTL),A ;TURN THE ROM ON ; CALL WRHSRM ;CALL THE ROM ; HSTRET: IN A,(ROMCTL) ;TURN OFF THE ROM ; LD A,(IX+ERFLAG) ;GET STATUS ; RET ; RDHST: OUT (ROMCTL),A ;TURN ON ROM ; CALL RDHSRM ;CALL ROM ; JR HSTRET ;RETURN ; ; RDBLK: LD (IX+ERFLAG),0 ;CLEAR ERROR FLAG ; LD IY,RAMDATY ;INIT IY ; CALL MSTK ;FIX THE STACK ; CALL RDHST ;CALL ROM ; DRET: POP HL ;RESTORE THE STACK LD SP,HL ; RET ; WRBLK: LD (IX+ERFLAG),0 ;CLEAR ERROR FLAG ; LD IY,RAMDATY ;INIT IY ; CALL MSTK ;FIX STACK ; CALL WRTHST ;CALL ROM ; JR DRET ; DISCIO: LD (IX+ERFLAG),0 ;CLEAR ERROR FLAG ; LD IV1 DW ALV1 ; DPE2: DW XLT1K DW 0 DW 0 DW 0 DW DIRBUF DW DPB2 DW CSV2 DW ALV2 ; DPE3: DW XLT1K DW 0 DW 0 DW 0 DW DIRBUF DW DPB3 DW CSV3 DW ALV3 ; DPE4: DW XLT1K DW 0 DW 0 DW 0 DW DIRBUF DW DPB4 DW CSV4 DW ALV4 ; SDPB: DW 40 DB 4 DB 15 DB 1 DW 94 DW 127 DB 0C0H DB 0 DW 32 DW 2 ; DPB0: DW 40 DB 4 DB 15 DB 1 DW 194 DW 191 DB 0E0H DB 0 DW 48 DW 2 ; DPB1: DW 40 DB 4 DB 15 DB 1 DW 194 DW 191 DB 0E0H DB 0 DW 48 DW 2 ; DPB2: DW 40 DB 4 DB 15 DB 1 DW 194 DW 191 DB 0E0H DB 0 DW 48 DW 2 ; DPB3: DW 40 DB 4 DB 15 DB 1 DW 194 DW 191 DB 0E0H DB 0 DW 48 DW 2 ; DPB4: DW 40 DB 4 DB 15 DB 1 DW 194 DW 191 DB 0E0H DB 0 DW 48 DW 2 ; ; RAMDATX: HSTDSK EQU $-RAMDATX DB 0 HSTTRK EQU $-RAMDATX DB 0 HSTSEC EQU $-RAMDATX DB 0 SECCNT EQU $-RAMDATX DB 1 RETRY EQU $-RAMDATX DB 20 HSTBUF EQU $-RAMDATX DW DSKBUF ERFLAG EQU $-RAMDATX DB 0 PHYTRK EQU $-FFH PDSK EQU $-RAMDATY DB 0 VDSK EQU $-RAMDATY DB 0 ; DMAADR EQU $-RAMDATY DS 2 OUTP EQU $-RAMDATY DW CNOUT INP EQU $-RAMDATY DW CNIN ; ; 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 Unused. ; Bit 7 Foreign drive format if = 1. ; ; Byte 1 DSKDEF1: ; Bit 0-1 Physical drive address. ; Bit 2 Double sided media 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 tiY,RAMDATY ; CALL MSTK ;FIX THE STACK ; OUT (ROMCTL),A ;TURN ON THE ROM ; CALL DISRM ;CALL THE ROM ; IN A,(ROMCTL) ;TURN OFF ROM ; LD A,(IX+ERFLAG) ; JR DRET ;RETURN ; ; GDSK1: LD DE,MTOFF ;CALC. MTAB POINTER ADD HL,DE ; LD E,A ;MULTIPLY DRIVE BY 9 RLCA RLCA RLCA ADD A,E ; LD E,A ;ADD (9 * DRIVE) TO POINTER ADD HL,DE ; RET ; ; CVMSG IS A ROUTINE TO CHANGE THE VIRTUAL DRIVE MESSAGE. ; ON ENTRY: HL POINTS TO THE BEGINING OF THE NEW MESSAGE. ; DE POINTS TO THE LOCATION OF THE CHARACTER ; WHICH WILL BE SET TO THE LOGICAL DRIVE ; THAT THE VIRTUAL DRIVE IS TO BECOME. ; BC IS THE LENGTH OF THE NEW MESSAGE. ; ; AF,BC,DE,HL ARE CHANGED, ALL OTHER REGS. ARE UNCHANGED. ; CVMSG: PUSH HL EX DE,HL XOR A SBC HL,DE LD DE,VMSG ADD HL,DE LD (VDRVP+RAMDATY),HL ; POP HL LDIR RET ; DPBASE EQU $ DPE0: DW XLT1K DW 0 DW 0 DW 0 DW DIRBUF DW DPB0 DW CSV0 DW ALV0 ; DPE1: DW XLT1K DW 0 DW 0 DW 0 DW DIRBUF DW DPB1 DW CSRAMDATX DB 0 PHYHD EQU $-RAMDATX DB 0 IOADD EQU $-RAMDATX DW 0 SECSIZ EQU $-RAMDATX DW 0 STADD EQU $-RAMDATX DW 0 DW 0 DW 0 DB 0 CMDCNT EQU $-RAMDATX DB 9 CMDBUF EQU $-RAMDATX DW 0 DW 0 DW 0 DW 0 DB 0 ; DATXLN EQU $-RAMDATX ; SER1BAUD: DB DFLT1 ;index in Baud rate table for SER1 default baud rate SER2BAUD: DB DFLT2 ;index in Baud rate table for SER2 default baud rate DS 2,0ffh ;reserved for future expansion ; VNUMB: DB 3 ; # OF PHYSICAL DRIVES - 1 TLEV: DB 0 ; TERMINAL LEVEL ; ; RAMDATY: SEKDSK EQU $-RAMDATY DS 1 SEKTRK EQU $-RAMDATY DS 1 SEKSEC EQU $-RAMDATY DS 1 ; SEKHST EQU $-RAMDATY DS 1 ; UNACNT EQU $-RAMDATY DS 1 UNADSK EQU $-RAMDATY DS 1 UNATRK EQU $-RAMDATY DS 1 UNASEC EQU $-RAMDATY DS 1 UNAMAX EQU $-RAMDATY DS 1 SECTRK EQU $-RAMDATY DS 1 ; WRTYPE EQU $-RAMDATY DS 1 DFLAG EQU $-RAMDATY DB 10H TRSEC EQU $-RAMDATY DS 1 ; VMSGP EQU $-RAMDATY DW VMSG VDRVP EQU $-RAMDATY DW VDRV ; CDSK EQU $-RAMDATY DB 0me 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. ; MTAB: MTOFF EQU $-RAMDATY DB 21H DB 0DCH DB 125 DB 4 DB 0BFH DB 3 DB 5 DB 28 DB 0FFH ; DB 22H DB 5DH DB 125 DB 4 DB 0BFH DB 3 DB 5 DB 28 DB 0FFH ; DB 24H DB 5EH DB 125 DB 4 DB 0BFH DB 3 DB 5 DB 28 DB 0FFH ; DB 24H DB 5FH DB 125 DB 4 DB 0BFH DB 3 DB 5 DB 28 DB 0FFH ; DB 21H DB 0DCH DB 125 DB 4 DB 0BFH DB 3 DB 5 DB 28 DB 0FFH ; DIRBUF: DS 128 ; ALV0: DS 25 CSV0: DS 48 ALV1: DS 25 CSV1: DS 48 ALV2: DS 25 CSV2: DS 48 ALV3: DS 25 CSV3: DS 48 ALV4: DS 25 CSV4: DS 48 ; VMSG B cr,lf,'Your lower drive is being re-assigned as drive ' VDRV: A00H-$-57 ;SPACE FOR MORE XLT'S DS (BIOS+0A00H-$-55),0 ; DB 0FDH ;IMS BUFFER HEADER DW 0 ; DS 52,0 ;STACK SPACE ; DSKBUF EQU $ STACK EQU $ ; SIGNON: DB 0DH,0AH,'Micro-Decision -- 64K CP/M Vers. 2.2 -- Rev. ' DB ((REV AND 0F0H) SHR 4)+ASC0,'.',(REV AND 0FH)+ASC0 DB CR,LF DB "Copyright '76,'77,'78,'79,'80 Digital Research, Inc." DB CR,LF DB 'Copyright 1982,1983 Morrow Designs, Inc.' DB CR,LF,LF DB '************** Double Sided System **************' DB CR,LF,0 ; ; BOOT: LD SP,STACK LD IY,RAMDATY CALL INITCTC ;initialize baud rates LD DE,SIGNON OUT (ROMCTL),A ;TURN ON ROM CALL MSGRM IN A,(ROMCTL) ;TURN OFF ROM ; XOR A LD (3),A LD (4),A ; LD HL,CPM ; JP GOCPM ; END 5,36,37,38,39,40 DB 17,18,19,20,21,22,23,24 ; DB 0FEH ; CONSOLE XLT TABLE DW CLEN esctbl: DB 0FFH ctrltbl:DB 0FFH escvect:DW 0 ctvect: DW 0 ; ; TRANSLATION STRINGS FOR THE TERMINAL GO HERE ; CLEN EQU $-ESCTBL ; DB 0FFH ;EOT DW BIOS+0;---------------------------------------------------------------------- TITLE Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) ;----------------------------------------------------- ; ; MICRO-DECISION ; CP/M 2.2 ROM REV. 2.4 ; COPYRIGHT 1982, 1983 ; MORROW DESIGNS, INC. ; 8/1/83 ; REVCMPT EQU 13H ; Rom rev compatability level REVCMP1 EQU 22H ; Cpm rev number REV EQU 24h ; 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 oDB 'A.',cr,lf,'Exchange diskettes and press [RETURN]',0 ; LSTFLG: DB 0FFH ; PRINTER READY FLAG ; ; dcastrt b 1bh,3dh,0ffh dc prefi string ds 3,0ffh ; dcamid: ds 6,0ffh ; dca seperator ; dcaend: ds 6,0ffh ; dca terminator string ; esc_lvl b 0 ;indicate es sequenc level offset1: db 0 ;first character offset offset2: db 0 ;second character offset order: db 1 ;Bit 0 = 0 --> row, then column, ; = 1 --> column, then row ;Bit 1 = 0 --> binary cursor adresses ; 1 --> ascii cursor addresses first: db 0 ; temporary storage of first second: db 0 ; temporary storage of second ; XLTAB: DB 0 DW 40 XLT1K: DB 1,2,3,4,5,6,7,8 DB 25,26,27,28,29,30,31,32 DB 9,10,11,12,13,14,15,16 DB 33,34,35,36,37,38,39,40 DB 17,18,19,20,21,22,23,24 ; DB 0FEH ; CONSOLE XLT TABLE DW CLEN esctbl: DB 0FFH ctrltbl:DB 0FFH escvect:DW 0 ctvect: DW 0 ; ; TRANSLATION STRINGS FOR THE TERMINAL GO HERE ; CLEN EQU $-ESCTBL ; DB 0FFH ;EOT DW BIOS+0n track 1. ; 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-1 ; port to test stored here by diagnose bgnchar equ memtop-2 ; starting character for barber-pole test mempass equ memtop-1 ; number of memory passes errors equ memtop-2 ; 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 ;----------- d. ; 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,00h ; assume that ram is ok ld iy,romdaty ; init. iy call initctc ; initialize counter-timer chip call inituart ; initialize UARTS ld de,signon ; point to signon message call clrmsg ; and print signon call romtst ; check rom call move ; move memtest call bufchk ; check disk 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 jp boot ; and boot page ;--------------------------- ; Subroutine: INITCTC ;-------------------- ; ; Function: This routine initializes the counter timer chip to provide ; baud rate clocks for the USARTS. The definition of the use of ; the channels is as follows: ; 0 - motor time out delay ; 1 - Baud rate for serial port 1 ; ( set for 9600 baud) ; 2 - Baud rate for serial port 2 ; ( set for 1200 baud) ; initctc: ld a,3eh ;set mode 3, channel 0 out (0f3h),a ;used for motor time out ld a,0FFh ;set to maximum delay out (0f0h),a ld a,0FFH out (0f0h),a ld a,7eh ;set mode 3, channel 1 out (0f3h),a ;set to 9600 baud ld a,0Dh ;this is Console port out (0f1h),a ld a,00h out (0f1h),a ld a,0beh ;set mode 3, channel 2 out (0f3h),a ;set to 1200 baud ld a,068h ;this is printer port out (0f2h),a ld a,00h out (0f2h),a ; channel two set to 1200 baud ret page ;---------------------------------------------------------------------- ; Subroutine: ROMTST ;------------------- ; ; Function: Thi 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 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 boote------------------------------------------------------- ; Subroutine: INITUART ;--------------------- ; ; Function: This routine initializes both UARTS. They are set ; for 8 bits, no parity, x1 clock rate, and 2 stop bits. ; In addition, DTR, and RTS, are programmed to be on. ; inituart: ld a,80h ; reset uarts out (s1stat),a out (s2stat),a out (s1stat),a out (s2stat),a ld a,40h out (s1stat),a out (s2stat),a ; end of reset sequence ld a,0ceh ; 8 bits, no par, x16, 2 stop out (s1stat),a out (s2stat),a ld a,037h ; Tx,Rx - on, DTR,RTS - on, ER reset out (s1stat),a out (s2stat),a ret ;****************************************** ;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 ;----------------------------------------------------------s 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 call chksum ; compute checksum of rom ret z ; return if checksum was o.k ld de,rommsg ; point to rommsg call mesg ; print ROM error message jr memerr ; 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 selec 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 pop af ; get c;write allocatted wrdir equ 1 ;write directroy wrual equ 2 ;write unallocatted ; bits within the diskdef byte. den equ 6 dsb 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 ; dmaadted 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 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 pointers to test top of RAM ld hl,diskbuf ; low address ld bc,3f8h ; # of bytes to test call chksum ; test diskbuf area ret z ; return if O.K. ramerr: ld de,rambad ; point to rammsg call mesg ; print ram bad message jr memerr ; jmp to error page ;---------------------------------------------------------------------- ; Subroutine: Chksum ;------------------- ; ; Function: This routineompleted check byte ret ; and return it ;---------------------------------------------------------------------- ; Subroutine: MOVE ;----------------- ; ; 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. ; move: ; 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 ret page ;---------------------------------------------------------------------- ; More Equates ;------------- ; ; i/o ports are: fdcstat equ 0fah fdcdata equ 0fbh motor equ 0f7h mtrchk equ 0f5h tc equ 0f7h wrall equ 0 r 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 eqables to ram ld a,(rmtab) ; get dskdef0 and mtrmsk ; mask for motor bits bit 2,a ; check for 3rd motor bit jr z,btok ; jmp if not 3rd motor bit rrca ; convert 3rd bit to 2nd bit btok: ld c,a ; save motor bit ld a,(rmtab+1) ; get dskdef1 and mtrmsk ; mask for drive address ld b,a ; calc. physical drive address inc b ld a,8 blop: rlca djnz blop or c ; or in motor bit ld de,6000h ; set time count out (motor),a ; start drive ilop1: dec de ; decrement count ld a,d ; check if time out or e jr z,nodsk ; jmp if time out in a,(mtrchk) ; get status bit 2,a ; check index bit jr z,ilop1 ; loop until nz ilop2: dec de ; decrement count ld a,d ; check if time out or e jr z,nodsk ; jmp if time out in a,(mtrchk) ; get status bit 2,a ; check index bit jr nz,ilop2 ; loop until zero jr aboot ; go boot nodsk: ld de,bootmsg ; point to boot msg call mesg ; and print it loop: call ciny ; get a key ld de,crlf ; point to r i/o serout: ld a,b ; switch port and char. registers ld b,c ; now b has character to output ld c,a ; now, c has port to use chkstato: ; check output status in a,(c) ;console output routine bit 0,a ;see if rdy jr z,chkstato ;jmp if not rdy ld a,b ;output char. dec c ; point to data port out (c),a ret ;serial input routines ser2in: ld b,s2stat ;point to 2nd status port jr serin ;use general purpose input routine cnin: ld b,s1stat ;set up for 1st status port serin: ld c,b ;move port to use to c reg chkstati: ; check input status in a,(c) ;serial port input routine bit 1,a ;see if rdy jr z,chkstati ;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 cu 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 0 ; 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 page ;---------------------------------------------------------------------- ; cold boot loader ;----------------- ; boot: call xfrdata ; transfer data tlf call mesg aboot: call hmok call discio ;load boot ld a,(ix+erflag) ;get error byte or a ;see if o.k. jp z,bootbf ;jmp to boot if no error bter: ld de,bterr ;boot error mesg. jp memerr 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 foharacter 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 ld hl,acktime ; load timeout value for ack acklp: in a,(cstat) ; check ack bit bit 3,a jr z,ackok ; if cleared, return success flag dec hl ; if not cleared, update timeer ld a,l or h ; see if hl=0 => timeout jr nz,acklp ; if not timeout, keep looking dec a ; if timeout, set acc. to 0ffh ret ackok: xor a ; acknowledged, so set for printer ret ; ok, then return page ;---------------------------------------------------------------------- ; message routine set readop,(iy+dflag) ;set for read op set rsflag,(iy+dflag) ;force read ld (iy+wrtype),wrual ;treat as unalloc jp 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 (i 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: inc e 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 rsfls ;----------------- ; ; 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 b,50 ;line count clrlp: ld a,lf call outcn djnz clrlp ; 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 ; General Purpose Indirect vector ;-------------------------------- ; cntjp: jp (hl) page ;---------------------------------------------------------------------- ; read a logical sector ;---------------------- ; rdlsec: ld (iy+unacnt),0 ;clear unacnt y+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 (ix+erflag),0 ;clear error flag ld a,(iy+sekdsk) ;get drive call gdsk ;get pointer to diskdef inc hl ld a,(hl) ;a=dskdef1 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 ifag,(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 bit readop,(iy+dflag) ;read or write ? ld a,0 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 pfor 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+re ; 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 cnt ret z call hmok ;home ld a,(ix+phytrk) cp 3 ;see if < track 3 ret nc ;return if > track 2 jr trck3 ntfnd: ld a,(ix+phytrk) cp 3 ;see if < track 3 ret nc ;return if > track 2 call cnt ret z 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 ;---------------------------------------------------------------------- ; 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 hysical 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 try) ;b=retry count ld d,3 ; Start of Retry loop dlop: push bc ;save retry count push de ;save vfo pntr. 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 vfo pntr. 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,cnt 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 ;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 dilp: bit mrq,a ;see if master req. ret nz page ;---------------------------------------------------------------------- ; do the actual i/o routine ;-------------------------- ; 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 ------------------------------------------ ; 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 byt----------- ; 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 ;de ;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 ;---------------------------------------------------------------------- ; 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 ;----------------------------e 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 ;-----------------------------------------------------------c 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 co=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 call gtrk ;get current track 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: ca 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 ;---------------------------------------------------------------------- ; load the current track into the d reg ;-------------------------------------- ; 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 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 ntrol 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, cyll 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 ;---------------------------------------------------------------------- ; 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) jp virtm page ;---------------------------------------------------------------------- ; set hl pair as a pointer to mtab ;--------------------------------- ; gdsk: push iy ;get iy into 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 c ;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. incte 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= 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,infd 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 ;upda+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 DS (ROM+7FCH-$),0FFH ;****************************************** ;This area must remain at locations 7fc-7ff ;******************************************' ; DB REVCMPT DB REVCMP1 db rev DS 2,0FFH 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' ;t 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 a,20h ; initialize barberpole test ld (bgnchar),a ; a = character to print prntlp: ld a,05fh ; b = number of characters before cr/lf ld b,a ld a,(bgnchar) ; get character to start with outlp: call testout ; output the character dec b ; adjust character count jr z,shift ; if end, change start for next line inc a ; else, next character jp p,outlp ; send next character ld a,20h ; jump over control codes jr outlp ; then continue sending shift: call keystat ; see if a key has been typed op 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  adjust and check if in range jp m,inlp ; between 1, and... cp 3ah ; ... 9 jp p,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) cp 4 ; if bpole test, set up port jp p,notbp ; don't set up port if not bpole test ld (port),a ; set up port to use for bpole test notbp: 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 tesret nz ; if so, then end test ld a,cr ; send out cr, lf call testout ; output the character ld a,lf call testout ld a,(bgnchar) ; change starting character inc a jp m,bpole ; if 80h, then re-start ld (bgnchar),a 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 p ;---------------------------------------------------------------------- ; 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 or a ; test flags jr z,noerr ; if no errors, increment pass call incerr ; else, increment error count 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 incerr: ld a,(errors) ; increment error count inc a ld (errors),a 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 ; incr 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; wrtbuf: ld de,wrtmsg ; print Writing... call mesg ld (IX+ERFLAG),0FFh ; set type of error handling call wrthst ; write the data call tsterr ; see if any errors, if so inc errors 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 ; see if any errors, if so inc errors call prntpass ret ; else return to menu tsterr: ld a,(IX+ERFLAG) ; check returned error status cp 0 ; see if no errors call nz,incerr ; else, increment error count ret page ;---------------------------------------------------------------------- ; SEEKTEST ;--------- ; ; performs a 'butterfly' seektesement 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 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.  t 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 ; t ; 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 ; inc error count if necessary 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 diagboot: pop af ; bump a subroutine level ret ; ;************************** 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: xor a ; set accumulator to pass out (romctl),a ; turn ROM back on ret ; return success che 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 ; increment error count if necessary pop bc *************** ; 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... jr nz,test ; if jp then warm boot jp warm ; and 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 jp nz,ramerr ; if memfail, then jump ld de,romok ; point to memory ok message call mesg ; and print it jp warm ; 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 heck: 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: 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 bask call outasc ; print ascii hex digit ret page ;---------------------------------------------------------------------- ; Subroutine: OUTASC ;------------------- ; ; This routine outputs the lower nibble of the accumulator as a hex digit. ; outasc: cp 0ah ; see if digit or alpha jp m,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 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 rdmsy 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 ld a,(hl) ; get value read 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 ; mor 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: ; .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 signon: db cr,'Micro-Decision -- ROM Rev. ' db ((rev and 0f0h) shr 4)+asc0,'.',(rev and 0fh)+asc0,cr,lf db 'Copyright 1982, 1983 Morrow Designs, Inc.',cr,lf,lf,0 tstmsg: db 'Testing  g: 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 20 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 entrr 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+0FFFH-$),0FFH END  (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 foy 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-7 Unused. ; ; 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 fo! : CR"*!"!""Yt``9tP*#"> Yt" JG!Yy yw# f P"*!"|”}~» ³# ¨»7~O  Í͆ }*s#r*xyw#*s#r#w#w#yw# "A:O>4G> + 72!"PX R|P>:*w#":<2*KB!"~ʒ}|o|g>o|g}}}""*%T]##ó*++"ê*|}  ~GO  7#~#foN#F+w#wxy+͌*"*++## ~O#^#V"#^#V"#yn2͜~ #eͲ*>#*|4A>22͜> :<32Ԍ> > : ھ͜<2> ͌0 "(RELCRFPRN P?Command error?File not found?Can't enter file~C # ! 4 ! 4 !  U "z*+++"*z:2 *͠ : U 2222222<22 % ů22͞ :ʞ ́ {:z2  2 » :@2!8u y=7͞ 7́ z  7!Yu :!U !8: A> = U :( : ( : 2 _2 z *##:2 Gz ~o o w# e #e  w#x : !~ œ w#’  :7> xʞ , Ox=y [A@2z x  {, ,  T , T7, Y7 L , S7, T7> R7, D7R7> > = 6 #=5 y.2  xU b , V <2y/y, L72, Oh , [ҝ 0ڝ Aҙ :ҝ  O!~6G #~ ¸ ê  x+# ~þ 2 2:  p >*C   > C : ! " o>*+"S" " " " go"Q"`2 2!2!2X2Z2]2^2c2_2\2W!*" " " " "=";!" " " " 2 2 !" ?No Start Address?Loading Error?Nothing Loaded?Out of memory?Illegal Polish Exp:!‡!!!2!!!2*S! ~ 4!>2 2Y:c2c ,/MEG@RSUXYE{ O :Ù&O†2WHO2WG:c2c:'>`͇Ax¹'"U _2:f Ğ2U!c~w:f ~w:f 2Yæ2Y*`|##yȷ#jC~@#I" #ͬ*`|#*U~ !:Y:c~ G@x k o Link-80 3.44 09-Dec-81 Copyright (c) 1981 Microsoft ?Command Error~P#~#  `{ +!~G #~ ex+#<~: /͔>*P d> P:e!fo>g6 7ʌʌ  y:+y#P2\2f g !  :\GO: " " " " * * " ";* * BK* * "=2 G<2    \! ~# != = = \* ͅ = *ͅ = s#r"N2 * * ͅ ʐ ʅ 2 M\: z x/Gy/O~w#~wM M" z _z! ^#V   $ 2 = ] m `i ^+V! 4* M ! 4Ð ! 5 PY\  s #r lg   # |/g}/o   DM!>= ))K K z zi  BK}o|g҄ : ʫ ͅ ҫ | >]P͔: : $>2*Q"!o&'  d   >0G /}o|g x0   > xPH>G~#' j~@+^+V$MEMRY$$PROG$COMNM*QA!Hw#] j{ ~@{ +^+V"Q! 2A! ?Start symbol - - undefinedg  ~#³ ͞ REL7*`}2X:c` j: j͔ p @p ͔`p p p * } , >wk  :`? !K * !b  Undefined Global(s) Bytes Free 2bP  ~O~>-ʑ > >/P+^+V+~P ™ /PN~ ʼ !ÿ "~ N+^+V>>PN:b?2b̔>wt :bȯ2bg6 #> w: + ! ~ * a& & Aw# ~# , , j #" _* +~ #̠ #" +~7ȷ> C > C !"!8:ã !"!: ~ <1 <+ !"!Y~  w# wY-:m :8<-> > >*8ͣ8$:m :->2*ͣ$|}ʮƀ)`i> > > :m :8 =!>!:m :B *|='#"w:YY=ʣ!=!>ß_!  <~=w4{ > ~7ȷ! @@> C ! p DISK FULL, [ҝ 0ڝ Aҙ :ҝ  O!~6G #~ ¸ ê  x+# ~þ 2 2:  p >*C   > C : ! " o>z6#z: O4ͅ {Ҏ!y yBKO!; s#r! s#r! s#rͅ ڬ! s#r!; s#ry ! ~#fo! ѵ! }_|W>2 * * <* * : <ͅ P* * W{_* #" " "=:WGO0ڗ xڗ)))ҖʌҖ)o>gdy +%Overlaying areaDataProgramÔ!! ~#fo!ͅ ͅ ͅ &}< = yy7yM7>,>#ͅ !M> _!h >?P~#P!yk!:!ʆ!; Not Found> P> P>2 g 28: _<2 !~g ! w#! wO |!y:!(͔*QDMÙ&[Begin execution]:Z:X* * ͅ ~`~¨@w+++o>GO ~+t>ʊ6 #=ƒ* ! ͮ 2X * ~O_+++y++:XK͔:c2c *Q>[P"N!C \* s#r!I  k [ M  ~++GOŸ& H+D ; & yE >  * [ S } 7~k ~~r <</_* Å |}! 6S#6Y#6M<$>* * ͅ ~O~@ +^+V > h%+~h% > h%= >~ <</O ß ͑&%|}G[h%> h%> h%:WG)0P) 60P3|L}U[P0:͔! ~#foN"N"N>>PÔRQUESTͬæ* : * ͅ ~_~@+++~#* BK" ö+++ö2!2 2 2 : go" " " 2X" <2 : * * * * *=͝QiEZͿE! ~#foBK#: =ʝ: ”* |ʊҔ}Ҕ͝p#: ”* |ʲҔ·}ҔÔ: =: Uw+p+q+p+q#Bi++s" ͇:7>[?@2g ԇx " h 5)> F6 #=>x2f y.̇p xanbʃ!p ~ ƒ6R#6E#6Ly[ҥ0ڥAҡ:ҥÊ[ʡ]ʡ@ʡ\ʡ^ʡ_ʡOb: : 2 BK|A~_q#Vp\AU: =* " ͅ " " ";" " ͅ 7* * * ͅ ]!* * * BK* * * * * " * * BK* * " " " "; ~w#~wPYb>̈́BKj~@: ~@w+~_q+U: =>Cw+p+q+r+sA! ͔A%Mult. Def. Global ~@*`+"`PYb>̈́BKůj~+nN+F@‡: ›:B(b: =›zAA;|A: ›r#sA: ›|A\zA#U: =ʯ>Bw+r+s+r+sA*`#"`!7~#46+wxG ɯ2 7Y!HYH!Hw74#6 _Gw#;!T"7O<2 XP̊wwO!9 N#F 2[: ʚ2[AC( r>-: " *=>2 * ͅ A*=>j+^+V\"?Ab: =#<2 =A: A*= APY7* K" !*="=* !" }2 <2 A:[* * |G}ʼ~O©H©A+++¨+—~ y/O oHOx_Ow#2 +w+w+w+ w+w+#V^#V! s#r Gyx! @s#r#1xS|W}_x2 * 2 yoxg* " *="=*?PYͅ ڙ"?: ʹ=¯* !" * * ͅ үï͝*={OzG* * DM7xw#  +x~+ xw+ : 7={O>: 7J?Intersecting wO* ͅ <26: ?Oʣ: Jͅ Jͅ J!M>,P*6&0M^#Vy!HF#~#P>(P>)P: " Start = External Public = %*>@w+r+s+@1: 2 r+sA: =* >jV/o/g ڮA~@w:]2^s+++~ s2^q+p:^O!;>2 }|!; s#rͅ y A!>/P͔A~W+++~P+%2nd COMMON Larger /*;" |2 * ͅ A> j~@wA7U: >8: =->G: =7>@w@w+w++1: 2 : : =r+sA!HIF5#wj~+ܾU6+6++r+sA*K:J2 fU: ;: =>@w+6++r+sA:!A>.2!2P* !J͞!g2!+}2_! w#!ڐ ‚! \" " : :Z!ګ!  w#! ¸+w2!͞A!!?/D illegal with common runtime?No code can be loaded before program withcommon runtime not found, please create header file?End of file on common runtime header!aǗzʣ̈́"Qb! ^#V! ͪ!;ͪyک: * * ͅ * " * '* * * BK" 7ɩ))'):B($: ̈́: r2 * * DM* " *= "=* BK" " " " * " Ͷ'* |‡}ʠ~_|!^#V* " (M\~#+>>><2Z=O! $! ^#V0y=Uy?\ͅ ?\|y! i! us#rx^#V͞! p#”* ! N#F#~#fo! ^#V  ! ~#foͅ H! {_{_~H! ^q#Vp! ~s#_~rW}&: $#qͅ {_! 6)`i{ڠ! #Yš* * 6* " * * " ͞* ͅ ҙ" ! yڬ! ^#V ڻ F#fh! ^#V ^#Vy! ^ "!2Z!:Z?!͙!͙! y-!* * ͅ #* " ͅ |!*Sͅ "yb!*Sͅ "ͅ ڵ!*Sͅ ڮ!!!ù!!!!!!!2 YxbelowaboveOrigin loader memory, move anyway(Y or N)?ͅ 0"ͅ D" "!ͅ D"yS": W"*Sʀ"a"Oͅ €"y*S€"! ͅ ҇"!9;;;;;;ͅ "ͅ ڣ"z"&'7"ڿ"""ͅ #ͅ #"z"7* ";* "=* *;)##+#KP*;";!* BK*;* *=l#ʮ#l#O* * " * *=BK* *="=#PY* " * " Ø#* *=#BK* * " * * " " *=" *;" ! 8$~R#~E#~L4$:c)$7$w+)$COMHEX`$  <%2 : $}$* * ͅ $!c~ʌ$ ~$:\ʲ$: µ$*Q\" " &yO: &w&%*Q|$ͅ $%ͅ $ͅ $.%>%7Ԓ%R%:*z w#)0:ww:*!;) )+ )!1)?Segment , file not foundcan't create fileread errorDisk is full)!@))!O))ͣ)!a))ͣ)!l).***‹)*—).**!+@=~vO#~ Q w#6 #wD̈́K>2<2@2>2-=2<2<2=2<2?2=!= w#—<2(=2.=2/=2=> 2<:@2<:@2*=>;23=<22=!"4=+"@+"6=*'@!!62[?21=2+=29=2?<2)=?!H="F= ~# R*4=#"4=!"6=:2==23=!9=>2@2@͖ CCl CC0Cw#C!H= ʎ ~w# Žw:9==28=͖q:,=ʨNЯ2,=4OMگ!F> 2H=J> J7ò- !"C=20==2?*="=:H=*>$2H=$2E=U :ʋ:E=$:==$U !=~4#>$Nwy#*F=+~# ʿ+U ~#~"RR *F=+"F=:(=k+s -"x-ʯ7D-"F=+ÿ:(=ʹ1 -"C=j # :µ@ U 6 :(= ʒ8 :(=l`k#~! _^#V#N1! ; !H="F=*C=|U :(=lÍ'!==Nwy#3!>">!> q#K6 U l;l:<—:>VʋMʋDʋX2[?~+ACDEMNOPQRUVX!>~ p:>2> %yO%>%R%: Ă% <%>h%*Q}h%|h%سȯh%zG%%z~#h%\%!: _w{<%2  %%"%yO#"%!%\%.%fh%¹%! ~+ x :_*Q:_*Q\!%?Can't save object file{{ _zW;&> A&{ H&O>:h%y Y~# c&+&>:h%G*Q >>h%!*'͞'!0'͞'!3'͞'!9'͞'##²&##͞'##¿&#͞'!z'͞'!'͞'* "'* "'* "'* "'* "'* "'&'m&'͓','V'G'V'l'|'V'l'|'V'l'|'!' N#F#^#V#~#fo|} +x~+ q'xw# |'xw# Ó'~#fo&'q#p:B(* ͅ ~'M(:J2A(*;" 2 U6+:A(wAMz(2A(7(:B((*;" :A(2B(*;r#s+:A(i(*;͢(" 2A(2B(!* p# P(!HN#*~# ^(Ar#s *){ʅ({ƀ_҅(zʞ()Å(ͣ) *)!.*ʹ)!.*V#^(((!((ʹ)(z(!.*ʹ)(ͣ)z{7. %No END statement:=.ʊ$ʒ[YTE3ALLSALL1Cj?CF1M/MA?MCMP2NC2NZOMMONOND1PQ PrPDsPDR2PE*PIrPIsPIRj/PL2POSEG1Z'AAj'AA ADBC"CR CXR ECEFB"EFLEFMEFSEFWIiISJNZSSEGWIiILSE ND NDC NDIF NDM NTRY QUQXjXXXITMXTXTERNALXTRN LOBALkvALTvLTF2FB9FDIFFEFF:FIDN3FNBFTaM)NQNRNC8NCLUDErNDsNDRrNIsNIR"NRNXF1F2FDEFFNDEFRPRPC1C1M2MP2NC2NZ1PQP2PE2POQR1ZQD2:DA DAXrDDsDDRrDIsDIR3*HLDOCALJXI8ACLIBACRO:@OVBVIAMErDEGOPjOPQRRARG*RIsTDRsTIR*UTR UTsUTDsUTIAGECHLOPR"OP UBLICUSHS$USHALARC!EPTZ&ESETR(ETsMETIsEETN IMY*LjLALCZ,LCkLCAroLDMNCNZPPEPOY.RjRARCZ0RCkRCArgRD"STR2STZBB*BIR4BCj7CFZ6ET"ET3"HLD0IMZ8LAPHLZ:RA"?=͓ *n?z :m?O s#rw# & =7 >wG#w"?=#w#w#w###w#I "A=####p*@͍ ;*?=|>!x F?Symbol table full |}:<:@:-=*?=~@ڹ >>vL!=F#~vL *p?  G~8#~ +~w#~w#s#r#*=s#r~@w:<# ~a~a#^#V#͍ R*=xD{a#za:> *?=# :0=a*?=~*?=#~wxGõ>LyL@ Z6LZ@LZRLZRLyZOLyym-LZRO*ZRv̝LZR*ZOLyZ@*m-L6 ,ɷÝKN͝Ým-zf<ĝ{Y! ^#N! ^#VZԝBxL{?LZ8ĝBLNܝc:<Ü̓ :>H:<0:<Ü>L:< L>2<:<<=<2<ů2< 6 (-2LKҫ:<ԝ Om-ͷyHLyL:>G¯BxGj*=*=͍ j##T9zC<xxĝ>L2*L>LyK͜c:<} :<^:<;͜{:<  s:<񇇇@OÜ :<ĝ>LGÜ:<( c`ƝLp:<͜(@{ĝ>:L[ĝ:< Ü;c>6LKB(@{(YPy:<O:<ĝ>LyWÜ!>?AFwx# 3:<G:<7b*=#"='h'*>'>͍ +*>:@`))0) ‘0Ž:>:>6!6"6'6*#">ßG:>@2>:2>!>~ͯ~@ô~ʹ#~?Gxʚ#~72>>A;hS#^#V"=G̓2>#^#V">>C1#^#V+~z><2>= G>>B#~Š:>@>§>2>>A;''2>{2>!>"?=ͩ:<*=##"=:>G:>@x̓:>G̓*>#">C'B'x&x746!96**>##~#fo6"6'##">̓xP:>@xʈ:C+B+x*=++*>#:=G~w#s#r#*=s#rC'B'b:>2>:>x̓³z ĩ2>*>#~2>*>#>͍ +*>:@)0) 0ZUB#UBTTL*UI$ITLECHGR@ORRA*RITHL680807Z80%COMMENT&CREF'DEPHASE(LALL;LFCOND)LIST*PASS2+PHASE,PRINTX-RADIX5REQUEST.SALL(('()-((5*5,,))))))))h6f6(5C,~&+*A4**i7+9M+ +[9;7+U+\+!++))*+++,))d+h+m+'-@  F"  (85vCd} *F=~#"F= oA 0 : 7}ɷ[ a { } 6 *F=+"F=*F=#"F= aS 6 != q#a !=6#ͱ  2<a w# yʟ ͱ x җ x Gy2=xͱ җ × $.@?_// // &:? ͱ & 6 ͱ 7 G!r?:=' " 2=~!?  "p?^#V!g? w#: !=~K 6!=N zʾ ^#V#^#V#~=y =G‹ #n #~=¸ #"?=#~+?j?!g?w#Ÿ w#s#rP P +>Ð <*A=~*@####~7#_"@:=$.?_ ;O$ m-ë*ů2< 6 (2L{Nԝ:<ĝc:<=ĝNԝc>LcnAÜNԝcn [:<ĝ>Lĝ;{:<=ĝ>L@ÜNܝ*e R:<fĝ[NܝcH:<(:<ĝ>LcNܝe ĝ>LcNܝ:< ĝ:<ĝ>LZԝO*k7:<(>Lں{:<̝ :<Lcĝ>L[/k:<̝"(:< :<*cy  :<Ü:<Ü>%{ :L/:<L>FL;{N*c:<ʴ ĝ:<ĝ>LyBONĝe ̝c:<ĝ5N*c:<ʴ(:<ĝ â:<Nܝe ̝c:<̝Gxĝ> Ü:<ĝ :<[4:<:<ʙԝ c:<ĝÜ([:>:> c:<̝ ڱ:LyC͜(2>2>:<(>"LÒ:<ĝ>2LÒ:< :< ĝ:< `ƝL͜ĝc:< ">DExx0:(:*=G:)=G:(=N:/=S:> ~:> o:@+2+>ÿ>+2+>:> ¿:.=:> :1=:,=>C2*>:[?:/=:> !3=4:2=p:[?:@>vL!> ~#d:+=Z:?=##:?#!9=~#06d(>C:8=H> d!H=~# Z dK> d> dO:[?yvLJ>23=:/=ʍ> vL!1>!*4=#|+:/=ʤ*6=#"6=:/=|ʾ>-vLZ!>ZZ>SvLä~#vLPX |>:d MACRO-80 3.44 09-Dec-81 PAGE :> Q)*<#"<*<#" !>">O!f ~*>w!>"> '"!*=:=*=:=:=x¦*=*=͍ "?="=ĩ:A> y> C+B+y*?=+~xGW> #######FyxG+#W>_xGxGFɯFxGF .7FxFx!>~w#4ZL>2>U C \ \'"(ʬ)ʯ+ʲ-ʵ*ʸ/ʻ;ʨ,ʨ >>>> > > >!G) # ) o2=) # x) eo) n= 6 ,8!:>8!2>> ß!:W?O:>O!f! "x̓!G:W?O`!"f!ó _y{y!*=YGó !"_~xž!ůG|2>?"y2W?͎!!F%:W?Of!è!@ 2W?:W?G2>O! x怱!>w*F=+N{*>2>z |= yWx=z6"z6"ʳ 6"6"6" >G̓!Gó "Y?zR" ͪ""=">y2W?͎!"ʡ"2X?ʋ"ʋ"ʋ"ʋ"ʋ"ͪ":X?*Y?!#o>g~#fo:W?O*Y?ʶ"y}!"=y%"*="""*>"{%z%   P#Z#d#n###N$$%##Q%\%h%u%{%%%%#%&&&-&C&c&̈́$zW{_̈́$zW{_̈́$zW{_*>|/W}/_:W?O>%%*>|/W}/_:W?O>%%̈́$zʬ#)â#̈́$#+}zW{_ò#*>:W?y#:W?O2>:W? #*="=*>͔$>%%*>G$:W?%$%$y%$$$:W?%$ ?$=:W?9$y9$2>:W?O>%%{_zW*>i$:W?O> %%i$ DM!>=ʂ$))p$p$:W? *>:W?y*>ͳ$:W?O> %%zzB%|G|$|%$%|/G}/O!>$ $7>{_zW}o|:<<2(=?)2<@ ͣ:<ģ:<̣!<;)=@ 4=2(=<2<@ 51):<_2>W!<7~?)<\)w!<4:(=2(=!b*T],l*zr* Y*#*F=z̝}O|G:> U Oĝ7 -#~@w ~ĵwy,ʉ*1>O*>; *F=+~# ****#"F= () 'O*6 ) )ĝ@ >2/=Y+2/=Y+2-=Y+U G+ G+ $ :+~@w,U ,+>2-=>2.=Y+2.=@ >2.=Y+}+>}+:@/o:22<(2 {=ʝҝ<2 +{22=+?pU :=+>!=w#"?=:<ĩ,+:,= *F=+qN1,4O=2,=*F=~#"F=!5, () 'U ') )@ :<:=x,>=!]?G~µw#„,p, /U ,/@ #~µ~$w2'+"=>2=!"=ñ&>2=:=U - -~w#~d -~w=x*F=+H 2=*F=++"F=H "F=GHg:<o|DHB} |BwDʕHʝOdQ•ͼOqQ þ!H Bq0Ի)z#zͥDnHn!H 0)T]))_è!H 0Ի)))_ÿ!H G0 ))))_Hû:<4!H 00 ܻO:<=ܻ<_Pc$ =ͥ=ͼ6 q6 :=2=ҿ=$ ʿ!  ʿo#g=b#t!S ~Œ2< ;ʹ ʹ° & × °6 þ*F= # #7 -#~G ĵxw+!"F=$ t:<ʮ:<7͓ $ !*@w!7 Gx22>">ĩ:<>C~@x##^#VOQb#^#V"=y y¾þ7͓ "?=~Bڨ~8:<2<##~2  þ:=X # '¿ 'n$¿j OþXOR AND NOT MOD SHL SHR OR EQ NE LT LE GT GE LOW HIGHNUL TYPE :< :<:2>2=2<2>2>2>2<2<9">*)@͍ 4\!]!~!! f!O2>̓!=y "" "?"y2W?͎!z5%|5%|ͳ$%:W?O> %%>O!G͙%͍ o%͙%͍ ?o%͙%͍ W_ ͙%È%͙%͍ o%͙%{_zo%7o%?o%:W?L&*>*>\W:W?O>%*>]W:W?O>:>@2>!>4~?%o%$w5y%:>2>̈́$}R_̈́$}R_̈́$}@_̈́$}6_̈́$}Ro{R_̈́$}?_*=*=͍ :W?_ :> Ox&> 2>,̓ x 2=xGʱ&:=±&*=*=͍ :=G*="=:<ă"= :=&:<ĩ:\?2':\?ȯ2\?U 2'1>G2=<2\?2=*=õ&2'1>2\?G2=*=õ&2'1>2\?G2=*=õ&:\?,:==`'o& ^#V*=͍ s#r2=*=##K':<ʇ':=ʇ'*= ͩ2=1 6 "ʠ''(G) ) *F=++' ) '³' ʳ'6 ,';'' "F=(y(# G) ) 'L) ȸ'# ( ,ʍ'LÍ'Z:=y,ʍ'̓ x1 "N('ĝO) d( o(GŷLP(xx|(L,A(1(h'y,›(ZCä(:@ʹ(z*=#"=:<'ä(*=:=Gõ&2(:<:>U<2>1h'̓ y,(:<=)G2<:<=)2< ,,͝-w͵,~Bدw#w#w#wU ~#~>-,"C=m-:>21=Ux¯x 20=*C="?= x4̓ :>"C=~w|21=m-x¯*C=-#~µ~@ w#s#r#*=s#r4͸K:?w/:<Ĩ/!<4~=Z.!]?~-!1>~-!@#]?~# . .. . -!V?p#"?=ͩ2'!5O"@ A."?=~w#~@k/~.#^#Vͩ.*= ͩ *={ĩn*F=ԃ +!"4="6=}2/=p!/!3=44!r?>͗;Z:3=8p!3=44!/!?>͗;Zʹ/*<|.:@<2[?2[?.!L//!O//*<|/>,vL:@<>,J:@<2[?2[?!_//ʹ//̓ͩ*>|,/F/ͩ+:@C/>vLKLNo Fatal error(s) Warning(s):=Gͩ./!//)ô/REPT/IRP/IRPC/MACROUnterminated /!//)> Z> Z:@<> J> J!/:@0"?%O;.0~<=r0:@<2@:@:@=2@<#~^0:@^0:@^07"?:?=2? &0*F=~ 0 0U 0"F=0>&2?>1&0:?0>&;:2?*@~ 1=1O+1 0x@"@ bkë4:?2@+5ů2@@ :@ʊ5U :U O^5yf5y n5y@{5:@=2@:@<2@:@:<(:@#~>P)!ɷ/"@i2O:> ʰ5*@͊0y6+,ĝ5) <ĝw+:> G6G5͌2 D6>G65# <2@ 5 =6:@6G6 ;,76<36>76G67676 w+5:@G66+.0xĝ" @&i"?m6\4>Ô5^4*%@>2@3H0ʱ6 ʶ1;ʫ1'ʡ6"ʡ6>1Ç6G͕0 ʶ1ʛ6â6"%@;:͞:!*#@* @*?!!64>2@" @͍ 7:@6x 7* @##~#7+4r:47H=r:1:3 7* @4 bk6 ʝOJ) V7JG7> J> J:> @ ʝ2 @O ʄ7@ u77\4^4!H=: @O~ʥ7 #Ù7!ɷ #"?~(w/"@i2 ,7w+2@2@ ;:Þ::@1*@4I2* @~82G+#2~/_2~F2=G+~F23*2+<=C2+;2~>.33?*@O DEU Ă2=ʦ3%2,ʰ3 ʰ3 ʰ3;ʰ3!) 3w+ Ô2"{3q3(:> 63:<.33PX 2|2>:f3)0R3>)30R3=363D>3E>3 >0f3xG3x0:R3 f30O:f3>0f3y*{3w+"{36 *{32Ow+ ʏ3 3~3w+ ~3Ô2ʢ3w+22322{=*F=+~ 6 6 ʵ3õ3!=͍ 3#6 +>1&3:>1!  4>1!4r ?Stack overflow, try more P switches (:> O4"?/c4> \^4U :U H0ʄ4H=;: y4ɯ;:͞:!*#@*?!!44͍ 4:@¾4x4*?͔9͊02@*?r:5H=͈:3 4*@*@*?"?"@* @!94" @"@2@r:I9H=r:1:3 +9*@* @4* @#2@4}_|W:=̓ :> 2=xx2=*=T9"=:=2=@ !!@Ns#Frͦ9ͯ9q#p*@^#V+*@##^#V+*!@}9ͯ9"!@9*@ "@*)@͍ I;*?%:?͍ I;*@T9ͦ9*%@{_{:s#r#>w#wͯ9%:s#r*:"#@*#@ͦ9s#r{_*%@{̺9*@w{W:a:"%@{_ͯ9zʺ9*@}‚:}o~r:{ʗ:a:{_ͯ9{ȯw#w*@s#r͔9*#@ͦ9q#p*%@{:*@"%@~{_ͦ9{_{:a:*@*?:?;*)@%T9o zo W{_*@*@T9BK*@"@xE;+w 8;"@O;9*A=*@T9o zo W{_*@T9BK*@*A="@ "@xʕ; w#È;2>2>O!^#V#ͷ; ;:>Zz^#V{;};++V+^{;w#w+++; F#"?=~@#~<~#^#VG5<<_<{…<{@Đ<{ʈ<{_!f~vLz<###~#vL;<>L<5m<:>wZ!3=4:2=p*?=~@w> |<> vL>*>M>C>UvL2<*?=#{G#^#V#^#V"=̓"?=#~ ĩ>IvL!>">*>6!>~G#^#VͩRELCRFPRNA@2,A*Jx I -AoIJIT?IJT7JY7ILYIJS7JT7>IR7JD7R7>I> ڀI6 #=xIy.2@*J5AxژIʥIJÙIy/yJL¾I2@JOæINI2@÷IOI2@÷IRI2@÷ICI2@2@÷IMI2@÷IIJ2@÷IXJ>2@÷IZJ2@÷IP7:@<2@÷IJ[HJ0HJADJ:HJ-JO!~6GzJ#~ cJUJHFx+#tJ~iJ2@ÚJ2@:@JK>*J GF> J:HF!IF"Fo>g6 #> w:@J!IF~ JaJJAw#þJ~# J J K#"F_*F+~ #KJ#"F+~7ȷ> J> JEB!"CB!@:@NKCA!"AA!@:@K~K͡K vL> vL>vL*CBEB@NLEB@K:@ʰH:@K>L*AACA@NLCA@K|}YLƀ)`iíL> vL> vL> vL:@ʰH:@¡M =­L!CA>!@íL:@ʰH:@J*AA|=L#"AABA Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1 1 ;---------------------------------------------------------------------- 2 TITLE Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) 3 ;----------------------------------------------------- 4 ; 5 ; MICRO-DECISION 6 ; CP/M 2.2 ROM REV. 2.4 7 ; COPYRIGHT 1982, 1983 8 ; MORROW DESIGNS, INC. 9 ; 8/1/83 10 ; 11 0013 REVCMPT EQU 13H ; Rom rev compatability level 12 0022 REVCMP1 EQU 22H ; Cpm rev number 13 0024 REV EQU 24h ; Rom Rev. 14 ; 15 P?Command error?File not found?Can't enter file~J#F!FF!FF!FFXGCOMSCNF",AF2@!@͸H> 2-A25A2,Ay,2@G:@2@H>A:@G;AH-A:,A2@ 2@G:@@2@!@͸Hy=7H 7H,A#H 7!@͸H:@!@ܘH!@:@SH@;A> =IHܘH:@hH:@hH:@2@ _2̈́K%K;K*@##:@2@G,A ~²HHw# ¨H #èH w#»H:@!5A~ Hw#H*J:7>IxHJOx=y&I[w:@<KM*ED|%M#"EDFDKGD>@=NM!=*M!>JM_!@ sM qM vL~zMËM7ȷ!MF@@²M> J!MFKDISK FULL!M:>ŒN@Nw#2@.ʷN!ڷNw#N2@.ʾN!ҥNþN6 #·N:@.Nw#NpMMN2M2M:M=OMM0O!M"M>2M*M~+O70O#"M0!"EDGD!@~KsK w#ªKw@KGD:@ʰH:@ vL> vL>vL*CBEB@NLEB@K:@ʰH:@K>L*AACA@NLCA@K|}YLƀ)`iíL> vL> vL> vL:@ʰH:@¡M =­L!CA>!@íL:@ʰH:@J*AA|=L#"AABA ; Update Log 16 ;----------- 17 ; 7/27/83 Home retry added. 18 ; Equipment check and Invalid command error messages added. 19 ; Not found error handling improved to eliminate problem 20 ; of head trapped below track 0. 21 ; Checksum bytes moved to allow checksum program to auto- 22 ; matically set these bytes. 23 ; Boot without waiting if diskette in drive. 24 ; HOME routine called from BIOS changed to set SEKTRK to 0, 25 ; without doing physical home until discio. 26 ; 27 ; 7/27/83 Fix SELSK so that motor bits for drives 2 and 3 work. 28  ; 45 0000 ROM EQU 0 46 ORG ROM 47 48 FC00 diskbuf equ 0fc00h ; start of disk sector buffer 49 FFFF memtop equ 0ffffh ; top of ram 50 FFFE port equ memtop-1 ; port to test stored here by diagnose 51 FFFD bgnchar equ memtop-2 ; starting character for barber-pole test 52 FFFE mempass equ memtop-1 ; number of memory passes 53 FFFD errors equ memtop-2 ; number of memory errors made 54 00F6 romctl equ 0f6h ; rom enable/disable port 55 00FC s1data equ 0fch ; console port data 56 00FD s1stat equ 0fdh ; console port status 57 00FE s2data equ 0feh ; printer port data 58 00FF SECTOR 74 000C C3 030E JP WRTHST ; WRITE PHYSICAL SECTOR 75 000F C3 0392 JP DISCIO ; DIRECT I/O READ OR WRITE 76 0012 C3 04E6 JP RDIO ; I/O READ LOOP 77 0015 C3 053D JP WRIO ; I/O WRITE LOOP 78 0018 C3 0157 JP BTER ; PRINT BOOT ERROR MESSAGE 79 001B 0EB1 DW ROMDATX ; POINTER TO ROM VERSION OF DATX 80 001D C3 0198 JP CENTOUT ; CENTRONICS DRIVER 81 0020 C3 01DE JP RDLSEC ; READ A LOGICAL SECTOR 82 0023 C3 01F1 JP WRTLSEC ; WRITE A LOGICAL SECTOR 83 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-2 84 85 86 ;---------------------------------------------------------------------- 87  ; 29 ; 8/1/83 Wrong track error handling improved to fix problem when 30 ; Qume drives get stuck on track 1. 31 ; 32 page 64 Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-1 33 34 35 ;---------------------------------------------------------------------- 36 ; System Equates and Jump Table 37 ;------------------------------ 38 ; 39 .Z80 40 0000' ASEG 41 42 ; system equates 43 ;--------------- 44  s2stat equ 0ffh ; printer port status 59 00F4 cdata equ 0f4h ; centronics data port 60 00F5 cstat equ 0f5h ; centronics status port 61 000D cr equ 0dh ; carriage return 62 000A lf equ 0ah ; line feed 63 0007 bell equ 07h ; bell 64 0000 wr equ 0 ; for building test pattern.. 65 0040 rd equ 40h ; ..for memory diagnostics 66 67 ; Jump Table 68 ;----------- 69 70 0000 C3 0026 JP START ; POWER ON JUMP 71 0003 C3 01C3 JP MESG ; PRINT A MESSAGE POINTED TO BY DE 72 0006 C3 0570 JP HOME ; HOME HEAD 73 0009 C3 0301 JP RDHST ; READ PHYSICAL  ; Module name: Microtest 88 ;----------------------- 89 ; 90 ; Function: This module tests the RAM and ROM of the Micro Decision 91 ; prior to booting. The module is entered any time the MD 92 ; is RESET. Upon entry, a determination is made as to whether 93 ; a power-on RESET ( cold reset ), or a " warm reset " is 94 ; taking place. If it is a cold reset, than the RAM and ROM 95 ; is tested, prior to booting, and if it is a warm reset, 96 ; the diagnostics are skipped, and the system is booted. 97 ; As the tests progress, the active test is displayed on 98 ; the terminal. Upon completion of a test, a messa38 CD 01BA call clrmsg ; and print signon 114 003B CD 00AA call romtst ; check rom 115 003E CD 00E9 call move ; move memtest 116 0041 CD 00CA call bufchk ; check disk buffer 117 ; ram space 118 0044 CD FC00 call stblk ; test rest of ram if 119 ; necessary, then boot 120 ; Warm start entry 121 0047 DB FC warm: in a,(s1data) ; make sure no characters are waiting 122 0049 DB F5 in a,(0f5h) ; check if diagnostics required 123 004B CB 6F bit 5,a 124 004D CC 0801 call z,diagnose ; call diagnostics test 125 0050 C3 0103 jp boot ; and boot 126 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-3 12005D 3E 40 ld a,40h 144 005F D3 FD out (s1stat),a 145 0061 D3 FF out (s2stat),a ; end of reset sequence 146 0063 3E CE ld a,0ceh ; 8 bits, no par, x16, 2 stop 147 0065 D3 FD out (s1stat),a 148 0067 D3 FF out (s2stat),a 149 0069 3E 37 ld a,037h ; Tx,Rx - on, DTR,RTS - on, ER reset 150 006B D3 FD out (s1stat),a 151 006D D3 FF out (s2stat),a 152 006F C9 ret 153 154 155 ;****************************************** 156 ;This must stay at location 07fh in the ROM 157 ;****************************************** 158 159 0070 DS (ROMge is 99 ; printed to indicate the passed test. If the test fails, 100 ; then a message is printed, and the machine halts. 101 ; 102 ; 103 ; Rev: 00 David Block 8/18/82 104 ; Rev: 10 DB 3/18/83 - Added firmware diagnostics 105 ; 106 ; Power on / Cold Start entry 107 0026 ED 46 start: im 0 ; set interrupt mode 0 108 0028 31 0000 ld sp,00h ; assume that ram is ok 109 002B FD 21 0ED0 ld iy,romdaty ; init. iy 110 002F CD 0085 call initctc ; initialize counter-timer chip 111 0032 CD 0053 call inituart ; initialize UARTS 112 0035 11 0C37 ld de,signon ; point to signon message 113 007 128 129 ;---------------------------------------------------------------------- 130 ; Subroutine: INITUART 131 ;--------------------- 132 ; 133 ; Function: This routine initializes both UARTS. They are set 134 ; for 8 bits, no parity, x1 clock rate, and 2 stop bits. 135 ; In addition, DTR, and RTS, are programmed to be on. 136 ; 137 0053 inituart: 138 0053 3E 80 ld a,80h ; reset uarts 139 0055 D3 FD out (s1stat),a 140 0057 D3 FF out (s2stat),a 141 0059 D3 FD out (s1stat),a 142 005B D3 FF out (s2stat),a 143 +7FH-$),0FFH 160 007F 0681 DW SKINT ;INTERUPT RETURN ADDRESS FOR WAIT ROUTINE. 161 162 0081 00 ROMCHK: DB 0 ;ROM CHECKSUM BYTE 163 0082 00 RAMCHK: DB 0 ;RAM CHECKSUM BYTE 164 0083 0A3F DW BLOCK ;RAM TEST ROUTINE ADDRESS 165 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-4 166 167 168 ;---------------------------------------------------------------------- 169 ; Subroutine: INITCTC 170 ;-------------------- 171 ; 172 ; Function: This routine initializes the counter timer chip to provide 173 ; baud rate clocks for  out (0f3h),a ;set to 9600 baud 190 0095 3E 0D ld a,0Dh ;this is Console port 191 0097 D3 F1 out (0f1h),a 192 0099 3E 00 ld a,00h 193 009B D3 F1 out (0f1h),a 194 009D 3E BE ld a,0beh ;set mode 3, channel 2 195 009F D3 F3 out (0f3h),a ;set to 1200 baud 196 00A1 3E 68 ld a,068h ;this is printer port 197 00A3 D3 F2 out (0f2h),a 198 00A5 3E 00 ld a,00h 199 00A7 D3 F2 out (0f2h),a ; channel two set to 1200 baud 200 00A9 C9 ret 201 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-5 202 203 204 ;--------------------------------------------------in rom 218 00AD 01 0FFD ld bc,0ffdh ; number of bytes to check 219 00B0 CD 00DC call chksum ; compute checksum of rom 220 00B3 C8 ret z ; return if checksum was o.k 221 00B4 11 0CF4 ld de,rommsg ; point to rommsg 222 00B7 CD 01C3 call mesg ; print ROM error message 223 00BA 18 00 jr memerr ; print it, and halt 224 225 ;---------------------------------------------------------------------- 226 ; Subroutine: MEMERR 227 ;--------------------- 228 ; 229 ; Function: When a bad memory location is detected during 230 ; the memory test, execution comes here. This routine 231 ; prints an error the USARTS. The definition of the use of 174 ; the channels is as follows: 175 ; 0 - motor time out delay 176 ; 1 - Baud rate for serial port 1 177 ; ( set for 9600 baud) 178 ; 2 - Baud rate for serial port 2 179 ; ( set for 1200 baud) 180 ; 181 0085 initctc: 182 0085 3E 3E ld a,3eh ;set mode 3, channel 0 183 0087 D3 F3 out (0f3h),a ;used for motor time out 184 0089 3E FF ld a,0FFh ;set to maximum delay 185 008B D3 F0 out (0f0h),a 186 008D 3E FF ld a,0FFH 187 008F D3 F0 out (0f0h),a 188 0091 3E 7E ld a,7eh ;set mode 3, channel 1 189 0093 D3 F3 -------------------- 205 ; Subroutine: ROMTST 206 ;------------------- 207 ; 208 ; Function: This routine initializes the hl, and bc register 209 ; pairs and calls chksum. It is used to test the system 210 ; integrity. If the test passed, then a message is printed 211 ; and the diagnostics continue. If the test failed, then 212 ; execution will be passed to the memerr routine. 213 ; Memerr will print a message indicating the problem found, 214 ; and then abort the boot process. 215 ; 216 00AA romtst: ; perform a checksum on the rom 217 00AA 21 0000 ld hl,0 ; starting address message, and halts the processor. 232 ; 233 00BC DB F5 memerr: in a,(0f5h) ; check if diagnostics selected 234 00BE CB 6F bit 5,a 235 00C0 CA 0047 jp z,warm ; if diagnostics selected, go to diag mode 236 00C3 11 0C1B ld de,rerr ; point to fatal error message 237 00C6 CD 01C3 call mesg 238 00C9 76 halt ; halt processor 239 240 ;---------------------------------------------------------------------- 241 ; Subroutine BUFCHK 242 ;------------------ 243 ; 244 ; Function: This routine calculates a checksum on the disk 245 ; buffer RAM at location FC00h to FFFFh as an indication 246 Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-6 260 261 262 ;---------------------------------------------------------------------- 263 ; Subroutine: Chksum 264 ;------------------- 265 ; 266 ; Function: This routine performs a checksum on a given block of 267 ; memory. The memory may be ROM or RAM, but must be set 268 ; such that the correct checksum is zero. The start of 269 ; the block to be tested should be addressed by the HL 270 ; register pair, and the number of bytes to check should 271 ; be in the BC register pair. If the checksum is correct, 272  count 285 00E2 F5 push af ; save check byte 286 00E3 78 ld a,b ; test if bc=0 287 00E4 B1 or c ; b or c =0 ==> done 288 00E5 20 F7 jr nz,chk ; if not done, loop 289 00E7 F1 pop af ; get completed check byte 290 00E8 C9 ret ; and return it 291 292 ;---------------------------------------------------------------------- 293 ; Subroutine: MOVE 294 ;----------------- 295 ; 296 ; Function: This routine moves the memory test program to 297 ; the disk buffer area, and pads the disk buffer ram 298 ; such that when a checksum is computed on the buffer 299  ; of system integrity. If the test passes, then the routine 247 ; will return, and the accumulator will be equal to zero. 248 ; If a bad checksum is computed, then execution will be 249 ; passed to memerr. 250 ; 251 00CA bufchk: ; set up pointers to test top of RAM 252 00CA 21 FC00 ld hl,diskbuf ; low address 253 00CD 01 03F8 ld bc,3f8h ; # of bytes to test 254 00D0 CD 00DC call chksum ; test diskbuf area 255 00D3 C8 ret z ; return if O.K. 256 00D4 11 0D07 ramerr: ld de,rambad ; point to rammsg 257 00D7 CD 01C3 call mesg ; print ram bad message 258 00DA 18 E0 jr memerr ; jmp to error 259 page Micro Decision ROM  ; then the accumulator will be zero upon return. 273 ; If the accumulator is non-zero, then the memory is bad. 274 ; The test used is a parity test, by column. The parity 275 ; is computed by xor'ing all the bytes together. The last 276 ; byte in the memory being tested is chosen to cause 277 ; correct parity to yield a 0 after the xor's. 278 ; 279 00DC AF chksum: xor a ; initialize checksum 280 00DD F5 push af ; because it's popped later 281 00DE F1 chk: pop af ; get current check byte value 282 00DF AE xor (hl) ; calculate new check byte 283 00E0 23 inc hl ; next location to test 284 00E1 0B dec bc ; decrement byte ; area, the result will be zero. 300 ; 301 00E9 move: ; set up to move prog to ram 302 00E9 21 0A3F ld hl,block ; from.... 303 00EC 11 FC00 ld de,diskbuf ; to.... 304 00EF 01 0100 ld bc,endblk-stblk ; how many... 305 00F2 ED B0 ldir ; move it!!!! 306 ; 307 00F4 01 02F7 ld bc,3f7h-endblk+stblk ; number of bytes to pad with 308 00F7 D5 push de ; save this 309 00F8 E1 pop hl ; get it for source of ldir 310 00F9 13 inc de ; dest for ldir 311 00FA 36 FF ld (hl), 0ffh ; initial padd 312 00FC ED B0 ldir ; walk up and fill 313 00FE 3A 0082 ld a,(ramchk) ; get checksum 314 0101 77 ld (hl),a write directroy 332 0002 wrual equ 2 ;write unallocatted 333 334 ; bits within the diskdef byte. 335 0006 den equ 6 336 0002 dsb equ 2 337 0007 vd equ 7 338 0005 tk80 equ 5 339 0018 sizmsk equ 18h 340 0040 denmsk equ 40h 341 342 ; bits within the flag byte: dflag. 343 0000 hstact equ 0 ;host active flag 344 0001 hstwrt equ 1 ;host written flag 345 0002 rsflag equ 2 ;read sector flag 346 0003 readop equ 3 ;read operation flag 347 348 ; offsets within the ramdaty ap storage 365 366 000D vmsgp equ 13 ;pointer to virt drive mesg. 367 000F vdrvp equ 15 ; " " " " in mesg. 368 369 0011 cdsk equ 17 ;current drive 370 0012 pdsk equ 18 ; 371 0013 vdsk equ 19 ;current virtual drive 372 ; 373 0014 dmaadr equ 20 ;dma addr. 374 ; 375 0016 conout equ 22 ;pointer to conout address Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-8 376 0018 conin equ 24 ;pointer to conin address 377 ; 378 001A mtab equ 26 ;pointer to mtab 379 0007 troff equ 7 ;offset to trac; set checksum 315 0102 C9 ret 316 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-7 317 318 319 ;---------------------------------------------------------------------- 320 ; More Equates 321 ;------------- 322 ; 323 ; i/o ports are: 324 00FA fdcstat equ 0fah 325 00FB fdcdata equ 0fbh 326 00F7 motor equ 0f7h 327 00F5 mtrchk equ 0f5h 328 00F7 tc equ 0f7h 329 330 0000 wrall equ 0 ;write allocatted 331 0001 wrdir equ 1 ;rea. 349 0000 sekdsk equ 0 ;seek disk 350 0001 sektrk equ 1 ;seek track 351 0002 seksec equ 2 ;seek sector 352 353 0003 sekhst equ 3 ;seksec converted to host 354 355 0004 unacnt equ 4 ;unalloc rec count 356 0005 unadsk equ 5 ;unalloc disk 357 0006 unatrk equ 6 ;unalloc track 358 0007 unasec equ 7 ;unalloc sector 359 0008 unamax equ 8 ;sectors per alloc. block 360 0009 sectrk equ 9 ;sectors per track 361 362 000A wrtype equ 10 ;write type 363 000B dflag equ 11 ;flag byte 364 000C trsec equ 12 ;temk in mtab 380 381 382 ; offsets within the ramdatx area. 383 0000 hstdsk equ 0 ;host disk 384 0001 hsttrk equ 1 ;host track 385 0002 hstsec equ 2 ;host sector 386 ; 387 0004 retry equ 4 ;retry count 388 ; 389 000C secsiz equ 12 ;two bytes which describe sector size 390 0003 seccnt equ 3 ;sector count 391 ; 392 000A ioadd equ 10 ;address of actual i/o code 393 ; 394 0005 hstbuf equ 5 ;pointer to data buffer 395 ; 396 0007 erflag equ 7 ;error flag 397 416 0000 hmbt equ 0 ;home bit for command 417 0003 spcmd equ 3 ;specify command 418 0004 sdstat equ 4 ;sense drive status command 419 0005 wrcmd equ 5 ;write command 420 0006 rdcmd equ 6 ;read command 421 0007 skcmd equ 7 ;root of seek & home command 422 0008 sicmd equ 8 ;sense int. command 423 424 0008 sekbt equ 8 ;seek bit for command 425 0007 stcnt equ 7 ;number of bytes returned by fdc 426 427 ; error codes 428 0001 wperr equ 1 ;write protect code 429 0002 skerr equ 2 ;seek error code 430 0005 nferr equ 5 ;not found code 431 0006  merr equ 0c0h ;master error mask 449 0020 exec equ 20h ;mask for exec bit 450 00F0 rdrdy equ 0f0h ;status for read byte 451 00B0 wrrdy equ 0b0h ;status for write byte 452 453 0013 pr40 equ 19 ;precomp bound for 40 tracks 454 0027 pr80 equ 39 ;precomp bound for 80 tracks 455 456 ; boot constants 457 FC00 dskbuf equ 0fc00h 458 FE00 bootbf equ dskbuf+200h 459 FF00 ramdat equ dskbuf+300h 460 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-10 461 462 463 ;------------------------------ ; 398 000E stadd equ 14 ;7 byte buffer for fdc status 399 ; 400 0008 phytrk equ 8 401 0009 phyhd equ 9 402 403 404 ; length of command followed by the command bytes. 405 0015 cmdcnt equ 21 406 0016 fdccmd equ cmdcnt+1 407 0018 cy equ cmdcnt+3 408 0019 hd equ cmdcnt+4 409 001A r equ cmdcnt+5 410 001B n equ cmdcnt+6 411 001C eot equ cmdcnt+7 412 001D gpl equ cmdcnt+8 413 001E dtl equ cmdcnt+9 414 0005 eotof equ 5 415 ;  ntrdy equ 6 ;not ready code 432 ; 433 0000 dout equ 0 434 ; 435 0030 asc0 equ 30h ;ascii 0 Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-9 436 0041 asca equ 41h ;ascii A 437 0049 asci equ 49h ;ascii I 438 0052 ascr equ 52h ;ascii R 439 440 0007 mrq equ 7 441 0005 exb equ 5 442 443 0003 mtrmsk equ 3 ;motor control bit mask 444 0007 mtrmsk1 equ 7 445 0010 trk0msk equ 10h ;on track 0 mask 446 447 0002 prec equ 2 ;precomp bit 448 00C0 ---------------------------------------- 464 ; cold boot loader 465 ;----------------- 466 ; 467 0103 CD 015D boot: call xfrdata ; transfer data tables to ram 468 0106 3A 0EEA ld a,(rmtab) ; get dskdef0 469 0109 E6 03 and mtrmsk ; mask for motor bits 470 010B CB 57 bit 2,a ; check for 3rd motor bit 471 010D 28 01 jr z,btok ; jmp if not 3rd motor bit 472 010F 0F rrca ; convert 3rd bit to 2nd bit 473 0110 4F btok: ld c,a ; save motor bit 474 0111 3A 0EEB ld a,(rmtab+1) ; get dskdef1 475 0114 E6 03 and mtrmsk ; mask for drive address 476 0116 47 ld b,a ; calc. physical drive address 477 0117 04 inc b 478 0118  jr z,nodsk ; jmp if time out 495 0133 DB F5 in a,(mtrchk) ; get status 496 0135 CB 57 bit 2,a ; check index bit 497 0137 20 F5 jr nz,ilop2 ; loop until zero 498 0139 18 0F jr aboot ; go boot 499 013B 11 0CB8 nodsk: ld de,bootmsg ; point to boot msg 500 013E CD 01C3 call mesg ; and print it 501 0141 CD 04C9 loop: call ciny ; get a key 502 0144 11 0EAB ld de,crlf ; point to lf 503 0147 CD 01C3 call mesg 504 014A CD 057F aboot: call hmok 505 014D CD 0392 call discio ;load boot 506 0150 DD 7E 07 ld a,(ix+erflag) ;get error byte 507 0153 B7 or a ;see if o.k. 508 0154 CA FE00 jp z,bootbf ;jmp to boot if no error 509 0157 11 0BFB bter: ld de,bterr 0170 C9 ret 527 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-12 528 529 530 ;---------------------------------------------------------------------- 531 ; serial port routines 532 ;--------------------- 533 ; 534 ; following are output routines for both serial ports. when serout is called, 535 ; it expects the character to output to be in the c register, and the b reg. 536 ; is to contain the port address for the serial port to be used. 537 ; 538 ; 539 ; serial output routines 540 0171  3E 08 ld a,8 479 011A 07 blop: rlca 480 011B 10 FD djnz blop 481 011D B1 or c ; or in motor bit 482 011E 11 6000 ld de,6000h ; set time count 483 0121 D3 F7 out (motor),a ; start drive 484 0123 1B ilop1: dec de ; decrement count 485 0124 7A ld a,d ; check if time out 486 0125 B3 or e 487 0126 28 13 jr z,nodsk ; jmp if time out 488 0128 DB F5 in a,(mtrchk) ; get status 489 012A CB 57 bit 2,a ; check index bit 490 012C 28 F5 jr z,ilop1 ; loop until nz 491 012E 1B ilop2: dec de ; decrement count 492 012F 7A ld a,d ; check if time out 493 0130 B3 or e 494 0131 28 08  ;boot error mesg. 510 015A C3 00BC jp memerr 511 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-11 512 513 514 ;---------------------------------------------------------------------- 515 ; transfer data 516 ;-------------- 517 518 015D xfrdata: 519 015D 21 0EB1 ld hl,romdatx ;get ready to move data areas 520 0160 11 FF00 ld de,ramdat ;into ram 521 0163 01 005D ld bc,datlng 522 0166 ED B0 ldir ;do move 523 524 0168 DD 21 FF00 ld ix,ramdat ;set ix & iy 525 016C FD 21 FF1F ld iy,ramdat+iyoff 526  ser2out: 541 0171 06 FF ld b,s2stat ;use port 2 542 0173 18 02 jr serout ; use general purpose output routine 543 544 0175 06 FD cnout: ld b,s1stat ; use console port for i/o 545 546 0177 78 serout: ld a,b ; switch port and char. registers 547 0178 41 ld b,c ; now b has character to output 548 0179 4F ld c,a ; now, c has port to use 549 550 017A chkstato: ; check output status 551 017A ED 78 in a,(c) ;console output routine 552 017C CB 47 bit 0,a ;see if rdy 553 017E 28 FA jr z,chkstato ;jmp if not rdy 554 555 0180 78 ld a,b ;output char.  0D dec c 573 0193 ED 78 in a,(c) ;get char. 574 0195 E6 7F and 7fh ;mask off parity 575 0197 C9 ret 576 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-13 577 578 579 ;---------------------------------------------------------------------- 580 ; parallel output routines 581 ;------------------------- 582 ; 583 ; centronics port driver 584 ; this routine outputs the character in register c to the centronics port. 585 ; after the character is output, the routine will monitor the ack bit from 586  F5 out (cstat),a ; strobe done 603 01A8 21 0040 ld hl,acktime ; load timeout value for ack 604 605 01AB DB F5 acklp: in a,(cstat) ; check ack bit 606 01AD CB 5F bit 3,a 607 01AF 28 07 jr z,ackok ; if cleared, return success flag 608 01B1 2B dec hl ; if not cleared, update timeer 609 01B2 7D ld a,l 610 01B3 B4 or h ; see if hl=0 => timeout 611 01B4 20 F5 jr nz,acklp ; if not timeout, keep looking 612 01B6 3D dec a ; if timeout, set acc. to 0ffh 613 01B7 C9 ret 614 01B8 AF ackok: xor a ; acknowledged, so set for printer 615 01B9 C9 ret ; ok, then return 616 page Micro Decision ROM Source (Rev  556 0181 0D dec c ; point to data port 557 0182 ED 79 out (c),a 558 0184 C9 ret 559 560 ;serial input routines 561 0185 ser2in: 562 0185 06 FF ld b,s2stat ;point to 2nd status port 563 0187 18 02 jr serin ;use general purpose input routine 564 565 0189 06 FD cnin: ld b,s1stat ;set up for 1st status port 566 018B 48 serin: ld c,b ;move port to use to c reg 567 018C chkstati: ; check input status 568 018C ED 78 in a,(c) ;serial port input routine 569 018E CB 4F bit 1,a ;see if rdy 570 0190 28 FA jr z,chkstati ;jmp if not rdy 571 572 0192  ; the port, and if no acknowledge is found within 1ms, the routine returns 587 ; with the acc. non zero. if the character is acknowledged, then the acc. 588 ; will be 0 upon return. 589 ; 590 0040 acktime equ 064 591 ; 592 0198 centout: 593 0198 DB F5 in a,(cstat) ; check printer rdy line 594 019A CB 67 bit 4,a 595 019C 20 FA jr nz,centout ; loop until printer ready 596 597 019E 79 ld a,c 598 019F D3 F4 out (cdata),a ; output char to cent. data port 599 01A1 3E 80 ld a,80h ; send strobe to printer 600 01A3 D3 F5 out (cstat),a 601 01A5 AF xor a 602 01A6 D32.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-14 617 618 619 ;---------------------------------------------------------------------- 620 ; message routines 621 ;----------------- 622 ; 623 ; Clear the console srceen and output a prompt 624 ;--------------------------------------------- 625 ; 1) The DE reg pair must be set to the start of the prompt string 626 ; 627 01BA 06 32 clrmsg: ld b,50 ;line count 628 01BC 3E 0A clrlp: ld a,lf 629 01BE CD 01CC call outcn 630 01C1 10 F9 djnz clrlp 631 632  650 01D0 FD 6E 16 ld l,(iy+conout) ;get conout addr in hl 651 01D3 FD 66 17 ld h,(iy+conout+1) 652 01D6 CD 01DD call cntjp 653 01D9 E1 pop hl 654 01DA D1 pop de 655 01DB C1 pop bc 656 01DC C9 ret 657 658 ; General Purpose Indirect vector 659 ;-------------------------------- 660 ; 661 01DD E9 cntjp: jp (hl) 662 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-15 663 664 665 ;---------------------------------------------------------------------- 666 ; rea FD 71 0A ld (iy+wrtype),c ;save write type 684 685 01F8 79 ld a,c ;see if unalloc 686 01F9 FE 02 cp wrual 687 01FB 20 18 jr nz,chkuna ;jmp if not 688 689 01FD FD 7E 08 ld a,(iy+unamax) ;a=init unalloc sec count 690 0200 FD 77 04 ld (iy+unacnt),a ;init. unalloc count. 691 692 0203 FD 7E 00 ld a,(iy+sekdsk) ;unadsk=sekdsk 693 0206 FD 77 05 ld (iy+unadsk),a 694 695 0209 FD 7E 01 ld a,(iy+sektrk) ;unatrk=sektrk 696 020C FD 77 06 ld (iy+unatrk),a 697 698 020F FD 7E 02 ld a,(iy+seksec) ;unasec=seksec 699 0212 FD 77 07 ld (iy+unasec),a 700  ; Output the message pointed to by the DE reg pair 633 ;------------------------------------------------- 634 ; 1) The message string must be terminated by a zero 635 ; 636 01C3 1A mesg: ld a,(de) 637 01C4 B7 or a 638 01C5 C8 ret z 639 01C6 CD 01CC call outcn 640 01C9 13 inc de 641 01CA 18 F7 jr mesg 642 643 ; Ouput a character to the current console device 644 ;------------------------------------------------ 645 ; 646 01CC 4F outcn: ld c,a 647 01CD C5 push bc 648 01CE D5 push de 649 01CF E5 push hl d a logical sector 667 ;---------------------- 668 ; 669 01DE FD 36 04 00 rdlsec: ld (iy+unacnt),0 ;clear unacnt 670 671 01E2 FD CB 0B DE set readop,(iy+dflag) ;set for read op 672 01E6 FD CB 0B D6 set rsflag,(iy+dflag) ;force read 673 674 01EA FD 36 0A 02 ld (iy+wrtype),wrual ;treat as unalloc 675 01EE C3 0256 jp rwoper 676 677 ;---------------------------------------------------------------------- 678 ; write a logical sector 679 ;----------------------- 680 ; 681 01F1 wrtlsec: 682 01F1 FD CB 0B 9E res readop,(iy+dflag) ;set to write 683 01F5  701 0215 FD 7E 04 chkuna: ld a,(iy+unacnt) ;any unalloc left? 702 0218 B7 or a 703 0219 28 33 jr z,alloc ;jmp if not 704 705 ; more unalloc remains. 706 021B FD 35 04 dec (iy+unacnt) ;dec unalloc count 707 708 021E FD 7E 00 ld a,(iy+sekdsk) ;same disk ? 709 0221 FD BE 05 cp (iy+unadsk) 710 0224 20 28 jr nz,alloc ;jmp if not 711 712 0226 FD 7E 01 ld a,(iy+sektrk) ;same track ? 713 0229 FD BE 06 cp (iy+unatrk) 714 022C 20 20 jr nz,alloc ;jmp if not 715 716 022E FD 7E 02 ld a,(iy+seksec) ;same sector ? 717 0231 FD BE 07 cp (iy+unasec) 718 0unacnt),0 ;clear unalloc count 734 0252 FD CB 0B D6 set rsflag,(iy+dflag) ;read needed 735 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-17 736 737 738 ;---------------------------------------------------------------------- 739 ; common routine section for read/write logical sectors 740 ;------------------------------------------------------ 741 ; 742 0256 DD 36 07 00 rwoper: ld (ix+erflag),0 ;clear error flag 743 025A FD 7E 00 ld a,(iy+sekdsk) ;get drive 744 025D CD 0642 call gdsk ;get pointer to diskdef 745 0260 23 inc hl 746 0261 7E ld a,(hl) ;a=dskdef1 747 0262 FD 5E 02mask 765 027D CB 2B s1024: sra e ;calc physical sector 766 027F CB 2B s512: sra e 767 0281 CB 2B s256: sra e 768 0283 1C s128: inc e 769 0284 FD 73 03 ld (iy+sekhst),e ;save physical sector 770 771 0287 78 ld a,b ;a=mask 772 0288 A2 and d ;mask sector 773 0289 FD 77 0C ld (iy+trsec),a ;save masked sector 774 775 028C FD CB 0B 46 bit hstact,(iy+dflag) ;host active ? 776 0290 FD CB 0B C6 set hstact,(iy+dflag) ;set host active 777 0294 28 22 jr z,filhst ;fill if not active 778 779 0296 FD 7E 00 ld a,(iy+sekdsk) ;same disk ? 780 0299 DD BE 00 cp (ix+hstdsk) 781 029C 20 10 234 20 18 jr nz,alloc ;jmp if not 719 720 ; sector is unalloc. 721 0236 FD 34 07 inc (iy+unasec) ;inc next unalloc sector Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-16 722 723 0239 FD 7E 09 ld a,(iy+sectrk) ;check for end of track 724 023C FD BE 07 cp (iy+unasec) 725 023F 30 07 jr nc,noovf ;jmp if not end of track 726 727 0241 FD 34 06 inc (iy+unatrk) ;inc track 728 0244 FD 36 07 01 ld (iy+unasec),1 ;sector 1 729 730 0248 FD CB 0B 96 noovf: res rsflag,(iy+dflag) ;no read needed. 731 024C 18 08 jr rwoper 732 733 024E FD 36 04 00 alloc: ld (iy+ ld e,(iy+seksec) ;get sector 748 0265 1D dec e ;dec sector 749 0266 53 ld d,e ;save sector 750 0267 E6 18 and sizmsk ;mask out size bits 751 752 0269 06 00 ld b,0 ;128 byte mask 753 026B FE 00 cp 0 ;see if 128 754 026D 28 14 jr z,s128 ;jmp if 128 755 756 026F 06 01 ld b,1 ;256 byte mask 757 0271 FE 08 cp 8 ;see if 256 758 0273 28 0C jr z,s256 ;jmp if 256 759 760 0275 06 03 ld b,3 ;512 byte mask 761 0277 FE 10 cp 10h ;see if 512 762 0279 28 04 jr z,s512 ;jmp if 512 763 764 027B 06 07 ld b,7 ;1024 byte jr nz,nomtch ;jmp if not 782 783 029E FD 7E 01 ld a,(iy+sektrk) ;same track ? 784 02A1 DD BE 01 cp (ix+hsttrk) 785 02A4 20 08 jr nz,nomtch ;jmp if not 786 787 02A6 FD 7E 03 ld a,(iy+sekhst) ;same sector ? 788 02A9 DD BE 02 cp (ix+hstsec) 789 02AC 28 2A jr z,match ;jmp if same 790 791 02AE AF nomtch: xor a ;a=no error status 792 02AF FD CB 0B 4E bit hstwrt,(iy+dflag) ;host written ? 793 02B3 C4 030E call nz,wrthst ;write host if needed 794 02B6 B7 or a ;check status Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-18 795 02B7 C0 ret nz ;return if error 796 797 add hl,hl ;calc 2**hl 814 02DE 29 add hl,hl 815 02DF 29 add hl,hl 816 02E0 29 add hl,hl 817 02E1 29 add hl,hl 818 02E2 29 add hl,hl 819 02E3 29 add hl,hl 820 821 02E4 DD 5E 05 ld e,(ix+hstbuf) ;de=> host buffer 822 02E7 DD 56 06 ld d,(ix+hstbuf+1) 823 02EA 19 add hl,de ;hl=> sector in buffer 824 02EB FD 5E 14 ld e,(iy+dmaadr) ;de=dma addr. 825 02EE FD 56 15 ld d,(iy+dmaadr+1) 826 02F1 01 0080 ld bc,128 ;bc=sector length 827 02F4 FD CB 0B 5E bit readop,(iy+dflag) ;read or write ? 828 02F8 3E 00 ld a,0 829 02FA C0 ret nz ;return if read 830 02FB FD CB 0B CE set hstwrt,(iy+dfl 847 ;---------------------------------------------------------------------- 848 ; write a physical sector 849 ;------------------------ 850 ; 851 030E 21 053D wrthst: ld hl,wrio ;get write address 852 0311 DD 75 0A ld (ix+ioadd),l ;put address in ramdatx 853 0314 DD 74 0B ld (ix+ioadd+1),h 854 855 0317 0E 05 ld c,wrcmd ;c=write command 856 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-20 857 858 859 ;---------------------------------------------------------------------- 860 ; routine common to rea 02B8 FD 7E 00 filhst: ld a,(iy+sekdsk) ;set host for xfer 798 02BB DD 77 00 ld (ix+hstdsk),a 799 02BE FD 7E 01 ld a,(iy+sektrk) 800 02C1 DD 77 01 ld (ix+hsttrk),a 801 02C4 FD 7E 03 ld a,(iy+sekhst) 802 02C7 DD 77 02 ld (ix+hstsec),a 803 02CA AF xor a ;a=no error status 804 02CB FD CB 0B 56 bit rsflag,(iy+dflag) ;need to read ? 805 02CF C4 0301 call nz,rdhst ;read 806 02D2 B7 or a ;check status 807 02D3 C0 ret nz ;return if error 808 809 02D4 FD CB 0B 8E res hstwrt,(iy+dflag) ;no pending write 810 02D8 FD 6E 0C match: ld l,(iy+trsec) ;get masked sector 811 02DB 26 00 ld h,0 812 813 02DD 29 ag) ;set write flag 831 02FF EB ex de,hl ;reverse direction 832 0300 C9 ret 833 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-19 834 835 836 ;---------------------------------------------------------------------- 837 ; read a physical sector 838 ;----------------------- 839 ; 840 0301 21 04E6 rdhst: ld hl,rdio ;get read address 841 0304 DD 75 0A ld (ix+ioadd),l ;put address in ramdatx 842 0307 DD 74 0B ld (ix+ioadd+1),h 843 844 030A 0E 06 ld c,rdcmd ;c=read commadn 845 030C 18 0B jr iohst ;go do i/o 846 d/write a physical sector 861 ;----------------------------------------------- 862 ; 863 0319 DD 7E 00 iohst: ld a,(ix+hstdsk) ;get host drive 864 031C CD 0642 call gdsk ;get pointer to dskdef 865 031F 23 inc hl 866 867 0320 7E ld a,(hl) ;a=dskdef1 868 0321 E6 40 and denmsk ;mask off density bit 869 0323 B1 or c ;or into command 870 0324 DD 77 16 ld (ix+fdccmd),a ;put in command buffer 871 0327 DD 36 15 09 ld (ix+cmdcnt),9 ;set command count 872 873 032B 3E 18 ld a,sizmsk ;get sector size bits 874 032D A6 and (hl) 875 032E 0F rrca ;right justify 876 032F 0F  16 03 ld d,3 ;de=size bytes for 1024 895 034E DD 70 1E stsiz: ld (ix+dtl),b ;set dtl 896 897 0351 DD CB 0D 7E bit 7,(ix+secsiz+1) ;see if non-standard block size 898 0355 20 06 jr nz,nstd ;jmp if non-standard 899 900 0357 DD 73 0C ld (ix+secsiz),e ;set size bytes 901 035A DD 72 0D ld (ix+secsiz+1),d 902 903 035D AF nstd: xor a ;assume side 0 & clear cy 904 035E CB 56 bit dsb,(hl) ;see if double sided 905 906 0360 DD 46 01 ld b,(ix+hsttrk) ;get host track 907 0363 DD 4E 02 ld c,(ix+hstsec) ;get host sector 908 909 0366 28 03 jr z,sside ;jmp if single sided 910 0368 CB 927 0385 11 0005 ld de,eotof ;offset to eot & gpl in mtab 928 0388 19 add hl,de ;add to mtab pointer 929 930 0389 7E ld a,(hl) ;set eot 931 038A DD 77 1C ld (ix+eot),a 932 933 038D 23 inc hl ;set gpl 934 038E 7E ld a,(hl) 935 038F DD 77 1D ld (ix+gpl),a 936 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-22 937 938 939 ; the ix area has now been set up 940 0392 DD 46 04 discio: ld b,(ix+retry) ;b=retry count 941 0395 16 03 ld d,3 942 943 rrca 877 0330 0F rrca 878 0331 DD 77 1B ld (ix+n),a ;save in command buffer 879 880 0334 06 80 ld b,80h ;b=dtl for 128 881 0336 11 0080 ld de,80h ;de=size bytes for 128 882 0339 FE 00 cp 0 ;see if 128 883 033B 28 11 jr z,stsiz ;jmp if 128 884 885 033D 06 FF ld b,0ffh ;b=dtl for 256,512 & 1024 886 033F 11 0000 ld de,0 ;de=size bytes for 256 887 0342 FE 01 cp 1 ;see if 256 888 0344 28 08 jr z,stsiz ;jmp if 256 889 890 0346 16 01 ld d,1 ;de=size bytes for 512 891 0348 FE 02 cp 2 ;see if 512 892 034A 28 02 jr z,stsiz 893 894 034C  18 rr b ;b=track cy=head 911 036A 17 rla ;get head bit in a 912 913 036B DD 77 19 sside: ld (ix+hd),a ;set head 914 036E 07 rlca 915 036F 07 rlca Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-21 916 0370 DD 77 09 ld (ix+phyhd),a 917 918 0373 DD 70 08 ld (ix+phytrk),b ;set track 919 0376 DD 70 18 ld (ix+cy),b 920 0379 DD 71 1A ld (ix+r),c ;set sector 921 922 037C 3E 03 ld a,3 ;mask out physical drive address 923 037E A6 and (hl) 924 037F DD B6 09 or (ix+phyhd) ;or in head bit 925 0382 DD 77 17 ld (ix+fdccmd+1),a ;put in command buffer 926  ; Start of Retry loop 944 0397 C5 dlop: push bc ;save retry count 945 0398 D5 push de ;save vfo pntr. 946 947 0399 CD 0583 call selsk ;selct drive and seek 948 949 039C FD E5 push iy ;save iy 950 039E CD 0422 call strtio ;start fdc 951 03A1 CD 0456 call dio ;go do i/o 952 03A4 FD E1 pop iy ;restore iy 953 954 03A6 06 07 ld b,stcnt ;set up and read 955 03A8 DD E5 push ix ;fdc status bytes 956 03AA E1 pop hl ;into status memory. 957 958 03AB 11 000E ld de,stadd 959 03AE 19 add hl,de ;hl=status memory 960 03AF CD 06B5 gstlp: ca8 979 03CD 3E 02 ld a,skerr ;if wrong track 980 03CF B9 cp c 981 03D0 CC 03FA call z,wngtrk ; home 982 983 03D3 3E 05 ld a,nferr ;see if not found 984 03D5 B9 cp c 985 03D6 CC 0409 call z,ntfnd 986 987 03D9 DD 7E 04 ld a,(ix+retry) ;home after 1/2 the retries 988 03DC 0F rrca 989 03DD 3C inc a 990 03DE B8 cp b 991 03DF CC 057F call z,hmok 992 993 03E2 10 B3 djnz dlop ;retry loop 994 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-23 995 996  1014 03FD C8 ret z 1015 1016 03FE CD 057F call hmok ;home 1017 0401 DD 7E 08 ld a,(ix+phytrk) 1018 0404 FE 03 cp 3 ;see if < track 3 1019 0406 D0 ret nc ;return if > track 2 1020 1021 0407 18 0A jr trck3 1022 1023 0409 DD 7E 08 ntfnd: ld a,(ix+phytrk) 1024 040C FE 03 cp 3 ;see if < track 3 1025 040E D0 ret nc ;return if > track 2 1026 1027 040F CD 056A call cnt 1028 0412 C8 ret z 1029 1030 0413 F5 trck3: push af ;save track 1031 0414 DD 36 08 03 ld (ix+phytrk),3 ;set to track 3 1032 0418 CD 0583 callll infdc ;wait for fdc 961 03B2 ED A2 ini ;get byte 962 03B4 20 F9 jr nz,gstlp 963 964 03B6 D1 skst: pop de ;restore vfo pntr. 965 03B7 C1 pop bc ;restore retry count 966 03B8 DD 7E 0E ld a,(ix+stadd) ;a=status0 967 03BB E6 C0 and merr ;check for error 968 03BD 28 35 jr z,dret1 ;return if no error 969 970 03BF CD 071C call ecode ;calc. error code 971 03C2 3E 01 ld a,wperr ;if write protect error 972 03C4 B9 cp c 973 03C5 28 1D jr z,nrtry 974 975 03C7 3E 06 ld a,ntrdy ;if not ready error 976 03C9 B9 cp c 977 03CA CC 056A call z,cnt 97 997 ; no retries or retries exhausted 998 03E4 DD 7E 07 nrtry: ld a,(ix+erflag) ; check erflag 999 03E7 FE FE cp 0feh ; feh => no error handling 1000 03E9 28 0A jr z,dret 1001 1002 03EB CD 0462 call edsp 1003 03EE 38 05 jr c,dret ;ret if 'a' (abort) 1004 1005 03F0 B7 or a ;see if 'r' (retry) 1006 03F1 C2 0392 jp nz,discio ;try again 1007 03F4 4F dret1: ld c,a ;else, 'i' (ignore) 1008 1009 03F5 DD 71 07 dret: ld (ix+erflag),c ;update error flag 1010 03F8 79 ld a,c 1011 03F9 C9 ret 1012 1013 03FA CD 056A wngtrk: call cnt  selsk ;seek to track 3 1033 1034 041B F1 pop af ;restore track 1035 041C DD 77 08 ld (ix+phytrk),a 1036 041F C3 057F jp hmok ;home 1037 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-24 1038 1039 1040 ;---------------------------------------------------------------------- 1041 ; start the disk controller 1042 ;-------------------------- 1043 ; 1044 0422 0E FB strtio: ld c,fdcdata ;set up to xfer fdc command 1045 0424 DD E5 push ix ;calc. addr. of command list 1046 0426 E1 pop hl ;and put in hl 1047 0427 11 0015 ld de,cmdcn3 DD 6E 0A ld l,(ix+ioadd) ;hl=io addr. 1065 0446 DD 66 0B ld h,(ix+ioadd+1) 1066 0449 E5 push hl ;save on stack 1067 044A FD E1 pop iy ;iy=i/o addr. 1068 1069 044C DD 6E 05 ld l,(ix+hstbuf) ;hl=dma addr. 1070 044F DD 66 06 ld h,(ix+hstbuf+1) 1071 1072 0452 C9 ret 1073 1074 0453 CB 7F dilp: bit mrq,a ;see if master req. 1075 0455 C0 ret nz 1076 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-25 1077 1078 1079 ;---------------------------------------------------------------------- 1080  d,(hl) 1100 1101 046E C5 push bc ;save status 1102 046F D5 push de ;save de 1103 0470 11 0BB0 ld de,dmesg ;basic err mesg. 1104 0473 CD 01C3 call mesg 1105 1106 0476 3E 41 ld a,asca ;get drive in ascii 1107 0478 DD 86 00 add a,(ix+hstdsk) 1108 047B CD 01CC call outcn ;display drive 1109 1110 047E 11 0EAE ld de,coln 1111 0481 CD 01C3 call mesg 1112 1113 0484 D1 pop de ;restore 1114 1115 0485 CD 01C3 call mesg 1116 0488 3E FF ld a,0ffh ;see if error message desired 1117 048A DD BE 07 cp (ix+erflag) 1118 048D 37 t ;offset to command list 1048 042A 19 add hl,de 1049 1050 042B 46 ld b,(hl) ;b=command list length 1051 042C 23 inc hl ;inc command list pntr. 1052 1053 042D CD 069F call rdy ;make sure fdc is ready 1054 0430 CD 06AC statlp: call outfdc ;wait for fdc 1055 0433 ED A3 outi ;write command byte 1056 0435 20 F9 jr nz,statlp ;loop 'til done 1057 1058 0437 DD 46 0C ld b,(ix+secsiz) ;set up regs. for i/o 1059 043A DD 5E 0D ld e,(ix+secsiz+1) 1060 043D CB BB res 7,e ;clear non-standard bit 1061 043F DD 56 03 ld d,(ix+seccnt) 1062 0442 15 dec d ;d=sector count -1 1063 1064 044 ; do the actual i/o routine 1081 ;-------------------------- 1082 ; 1083 0456 DB FA dio: in a,(fdcstat) 1084 0458 CB 6F bit exb,a ;see if executing 1085 045A 28 F7 jr z,dilp 1086 1087 045C D5 push de ;save de 1088 045D 11 0000 ld de,dout ;load time out count 1089 0460 FD E9 jp (iy) ;jmp to i/o 1090 1091 0462 79 edsp: ld a,c 1092 0463 07 rlca 1093 0464 5F ld e,a 1094 0465 16 00 ld d,0 1095 0467 21 0F0C ld hl,etab-2 1096 046A 19 add hl,de 1097 046B 5E ld e,(hl) 1098 046C 23 inc hl 1099 046D 56 ld scf ;simulate abort selection 1119 048E C4 04A3 call nz,ersp 1120 1121 0491 C1 pop bc ;c=status 1122 0492 C9 ret 1123 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-26 1124 1125 1126 ;---------------------------------------------------------------------- 1127 ; output the virtual drive message 1128 ;--------------------------------- 1129 ; 1130 0493 CD 01C3 virtm: call mesg ;print mesg. 1131 0496 CD 04C9 plop: call ciny ;get response 1132 0499 FE 0D cp 0dh ;see if cr 1133 049B 20 F9 jr nz,plop ;loop if not 11 eret: push af 1154 04BD 7B ld a,e 1155 04BE CD 01CC call outcn 1156 04C1 11 0EAB ld de,crlf 1157 04C4 CD 01C3 call mesg 1158 04C7 F1 pop af 1159 04C8 C9 ret 1160 1161 ;---------------------------------------------------------------------- 1162 ; get a character from the console 1163 ;--------------------------------- 1164 ; 1165 04C9 C5 ciny: push bc 1166 04CA E5 push hl 1167 04CB FD 6E 18 ld l,(iy+conin) ;hl=conin addr. 1168 04CE FD 66 19 ld h,(iy+conin+1) 1169 04D1 CD 01DD call cntjp 1170 04D4 E1 pop hl 1171 04D5 C1 pop b 1188 04E1 1B dec de ;dec time out count 1189 04E2 7B ld a,e ;see if timed out 1190 04E3 B2 or d 1191 04E4 28 2D jr z,tmout ;jmp if timed out 1192 1193 04E6 DB FA rdio: in a,(fdcstat) ;get status 1194 04E8 FE F0 cp rdrdy ;see if byte ready 1195 04EA 20 EB jr nz,rloop1 ;loop if byte not ready 1196 1197 04EC ED A2 rdsc: ini ;xfer 1st byte 1198 04EE D1 pop de ;get de 1199 04EF D5 push de ;save de 1200 04F0 7B rloop3: ld a,e ;see if last part of last sector 1201 04F1 B2 or d 1202 04F2 20 01 jr nz,rloop2 ;jmp if not last part 1203 04F4 05 dec b ;dec byte count if las34 1135 049D 11 0EAB dcrlf: ld de,crlf 1136 04A0 C3 01C3 jp mesg ;print cr & lf 1137 1138 04A3 11 0BC7 ersp: ld de,resm 1139 04A6 CD 01C3 call mesg 1140 04A9 CD 04C9 erlp: call ciny 1141 04AC E6 DF and 0dfh ;force upper case 1142 04AE 5F ld e,a 1143 04AF FE 41 cp asca ;see if "a" 1144 04B1 37 scf 1145 04B2 28 08 jr z,eret 1146 1147 04B4 FE 52 cp ascr ;see if "r" 1148 04B6 28 04 jr z,eret 1149 1150 04B8 D6 49 sub asci ;see if "i" 1151 04BA 20 ED jr nz,erlp ;try again 1152 1153 04BC F5 c 1172 1173 04D6 C9 ret 1174 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-27 1175 1176 1177 ;---------------------------------------------------------------------- 1178 ; read from the disk controller 1179 ;------------------------------ 1180 ; 1181 04D7 E6 20 rloop1: and exec ;see if still executing 1182 04D9 28 36 jr z,exdn ;jmp if done 1183 1184 04DB DB FA in a,(fdcstat) ;get status 1185 04DD FE F0 cp rdrdy ;see if byte ready 1186 04DF 28 0B jr z,rdsc ;jmp if 1st byte ready 1187 t 1204 04F5 FB rloop2: ei ;enable ints. 1205 04F6 76 halt ;wait for byte 1206 04F7 DB FA in a,(fdcstat) ;get status 1207 04F9 E6 20 and exec ;see if still executing 1208 04FB 28 14 jr z,exdn ;jmp if not 1209 1210 04FD ED A2 ini ;xfer byte 1211 04FF 20 F4 jr nz,rloop2 ;loop if more bytes 1212 0501 1D dec e ;dec msb of sector length 1213 0502 F2 04F0 jp p,rloop3 ;jmp if not end 1214 0505 D1 pop de ;restore sector size & count 1215 0506 15 dec d ;dec sector count 1216 0507 D5 push de 1217 0508 F2 04F0 jp p,rloop3 ;jmp if not end 1218 050B FB ei ;enable ints. 1219 050C 76 halt ; F7 ld c,motor ;init c reg to motor 1238 051C FD 7E 12 ld a,(iy+pdsk) ;a = physical disk 1239 051F 47 ld b,a 1240 0520 CB DF set 3,a 1241 0522 ED 79 out (c),a ;pulse ready line 1242 1243 0524 DB FA tmlp: in a,(fdcstat) ;get status of fdc 1244 0526 CB 6F bit exb,a ;see if executing 1245 0528 20 FA jr nz,tmlp ;loop if executing 1246 052A ED 41 out (c),b ;else pulse ready line 1247 052C C1 pop bc ;restore registers 1248 052D E9 jp (hl) ;execution done 1249 1250 ;---------------------------------------------------------------------- 1251 ; write data to the floppy disk controller 1252 1 ;loop if byte not ready 1269 1270 0543 ED A3 wrsc: outi ;xfer 1st byte 1271 1272 0545 D1 pop de ;get de 1273 0546 D5 push de ;save de 1274 1275 0547 7B wloop3: ld a,e ;see if last part of last sector 1276 0548 B2 or d 1277 0549 20 01 jr nz,wloop2 ;jmp if not last part 1278 054B 05 dec b ;dec byte count if last 1279 1280 054C FB wloop2: ei ;enable ints. 1281 054D 76 halt ;wait for byte 1282 054E DB FA in a,(fdcstat) ;get status 1283 0550 E6 20 and exec ;see if still executing 1284 0552 28 BD jr z,exdn ;jmp if not Micro Decision ROM Source (Rev 2wait for last byte 1220 050D DB F7 in a,(tc) ;stop fdc 1221 050F ED A2 ini ;xfer last byte 1222 1223 0511 D1 exdn: pop de 1224 0512 C9 ret 1225 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-28 1226 1227 1228 ;---------------------------------------------------------------------- 1229 ; time out handeler 1230 ;------------------ 1231 ; 1232 0513 D1 tmout: pop de 1233 0514 E1 pop hl 1234 0515 FD E1 pop iy 1235 0517 FD E5 push iy 1236 0519 C5 push bc 1237 051A 0E ;----------------------------------------- 1253 ; 1254 052E E6 20 wloop1: and exec ;see if still executing 1255 0530 28 DF jr z,exdn ;jmp if done 1256 1257 0532 DB FA in a,(fdcstat) ;get status 1258 0534 FE B0 cp wrrdy ;see if byte ready 1259 0536 28 0B jr z,wrsc ;jmp if 1st byte ready 1260 1261 0538 1B dec de ;dec time out count 1262 0539 7B ld a,e ;see if timed out 1263 053A B2 or d 1264 053B 28 D6 jr z,tmout ;jmp if timed out 1265 1266 053D DB FA wrio: in a,(fdcstat) ;get status 1267 053F FE B0 cp wrrdy ;see if byte ready 1268 0541 20 EB jr nz,wloop.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-29 1285 1286 0554 ED A3 outi ;xfer byte 1287 0556 20 F4 jr nz,wloop2 ;loop if more bytes 1288 1289 0558 1D dec e ;dec msb of sector length 1290 0559 F2 0547 jp p,wloop3 ;jmp if not end 1291 1292 055C D1 pop de ;restore sector size & count 1293 055D 15 dec d ;dec sector count 1294 055E D5 push de 1295 055F F2 0547 jp p,wloop3 ;jmp if not end 1296 1297 0562 FB ei ;enable ints. 1298 0563 76 halt ;wait for last byte 1299 1300 0564 DB F7 in a,(tc) ;stop fdc 1301 0566 ED A3 outi FD 36 01 00 hmsk: ld (iy+sektrk),0 ;set track to 0 1321 1322 057E C9 ret 1323 1324 057F 3E 00 hmok: ld a,hmbt ;set bit for home command 1325 0581 18 02 jr selhm 1326 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-30 1327 1328 1329 ;---------------------------------------------------------------------- 1330 ; select a drive 1331 ;--------------- 1332 ; 1333 0583 3E 08 selsk: ld a,sekbt ;set bit for seek command 1334 0585 C5 selhm: push bc ;save retry 1335 0586 D5 push de 1336  ld (iy+cdsk),a ;update current drive 1354 05A2 CB 7E bit vd,(hl) ;see if virtual 1355 1356 05A4 C5 push bc 1357 05A5 28 0F jr z,nvirt ;jmp if not virtual 1358 1359 05A7 FD BE 13 cp (iy+vdsk) ;new drive = vdsk ? 1360 05AA FD 77 13 ld (iy+vdsk),a ;updtae vdsk to new drive 1361 1362 05AD F5 push af ;save new drive 1363 05AE D5 push de 1364 05AF E5 push hl 1365 05B0 C4 062F call nz,virt ;call if new drive <> vdsk 1366 05B3 E1 pop hl ;restore regs. 1367 05B4 D1 pop de 1368 05B5 F1 pop af 1369 1370 05B6 CD 06E1 nvirt: call specfy ;set ne ;xfer last byte 1302 1303 0568 D1 pop de 1304 0569 C9 ret 1305 1306 056A 04 cnt: inc b 1307 056B 15 dec d 1308 056C C0 ret nz 1309 056D 06 01 ld b,1 1310 056F C9 ret 1311 1312 1313 ;---------------------------------------------------------------------- 1314 ; home the disk head 1315 ;------------------- 1316 ; 1317 0570 FD CB 0B 4E home: bit hstwrt,(iy+dflag) ;clear host active flag 1318 0574 20 04 jr nz,hmsk ;unless write is pending. 1319 0576 FD CB 0B 86 res hstact,(iy+dflag) 1320 057A  1337 0587 4F ld c,a 1338 0588 DD 7E 00 ld a,(ix+hstdsk) ;get new drive 1339 1340 058B F5 push af ;save new drive 1341 058C CD 0642 call gdsk ;get pointer to dskdef 1342 058F 7E ld a,(hl) ;get motor control bit 1343 0590 E6 07 and mtrmsk1 ;mask off motor bit 1344 0592 CB 57 bit 2,a 1345 0594 28 01 jr z,mtok 1346 0596 0F rrca 1347 0597 5F mtok: ld e,a ;e=motor control bit 1348 0598 23 inc hl ;hl=>to dskdef1 1349 0599 F1 pop af ;a=new drive 1350 1351 059A FD BE 11 cp (iy+cdsk) ;see if drive changed 1352 059D 28 1B jr z,same ;jmp if no change 1353 059F FD 77 11 w drive parameters 1371 05B9 C1 pop bc 1372 1373 05BA CB 76 same: bit den,(hl) ;check density 1374 05BC 28 0F jr z,single ;jmp if single 1375 1376 05BE 3E 13 double: ld a,pr40 ;40 track precomp bound 1377 05C0 CB 6E bit tk80,(hl) ;see if 80 track 1378 05C2 28 02 jr z,trk40 ;jmp if 40 track 1379 1380 05C4 3E 27 ld a,pr80 ;80 track precomp bound 1381 05C6 DD BE 08 trk40: cp (ix+phytrk) ;see if precomp 1382 05C9 30 02 jr nc,single ;jmp if no precomp 1383 1384 05CB CB D3 set prec,e ;turn on precomp 1385 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-31  out (motor),a 1405 05E2 FD 77 12 ld (iy+pdsk),a ;save motor byte 1406 1407 ; seek to the new track 1408 05E5 CD 0653 call gtrk ;get current track 1409 05E8 DD 7E 08 ld a,(ix+phytrk) ;a=new track 1410 05EB CB 59 bit 3,c ;see if home 1411 05ED 28 0A jr z,sk0 ;jmp if home 1412 1413 05EF B7 or a ;see if track zero 1414 05F0 20 04 jr nz,not0 ;jump if not track zero 1415 05F2 CB 99 res 3,c ;force home operation 1416 05F4 18 03 jr sk0 ;do home 1417 1418 05F6 BA not0: cp d ;new trk = old trk ? 1419 05F7 28 06 jr z,vskp ;jmp if trks. same 1420 1421 05F9 et 1440 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-32 1441 1442 1443 ;---------------------------------------------------------------------- 1444 ; find out if the heads homed 1445 ;---------------------------- 1446 ; 1447 060F CD 06AC hmchk: call outfdc ;wait for controller 1448 0612 3E 04 ld a,sdstat ;sense drive status command 1449 0614 D3 FB out (fdcdata),a ;out to fdc 1450 1451 0616 CD 06AC call outfdc ;wait for controller 1452 0619 3E 03 ld a,mtrmsk ;mask for drive select bits 1453 061B A6 and (hl) ;get drive select bits 1454 061C D1386 1387 1388 ; turn on the motors 1389 05CD DB F5 single: in a,(mtrchk) ;see if motor on 1390 05CF E6 03 and mtrmsk ;mask motor bits 1391 05D1 57 ld d,a ;save motor bits 1392 05D2 A3 and e ;nz if motor on, cy=0 1393 1394 05D3 F5 push af ;save flags 1395 05D4 7E ld a,(hl) ;get motor bits 1396 05D5 E6 03 and mtrmsk 1397 05D7 47 ld b,a 1398 05D8 04 inc b 1399 05D9 3E 08 ld a,8 1400 05DB 07 mloop: rlca 1401 05DC 10 FD djnz mloop 1402 05DE B2 or d 1403 05DF B3 or e ;turn on motors 1404 05E0 D3 F7  CD 06BE sk0: call seek 1422 05FC F1 pop af ;get flags 1423 1424 05FD 37 scf ;cy=1 for head settle 1425 05FE F5 push af ;save flags 1426 05FF F1 vskp: pop af ;restore flags 1427 1428 0600 C5 push bc 1429 0601 E5 push hl 1430 0602 CD 065B call wait ;wait for motor and/or head 1431 0605 E1 pop hl 1432 0606 C1 pop bc 1433 1434 0607 CB 59 bit 3,c ;see if home 1435 0609 CC 060F call z,hmchk ;call if home operation 1436 1437 060C D1 pop de 1438 060D C1 pop bc ;restore retry 1439 060E C9 r3 FB out (fdcdata),a ;out to fdc 1455 1456 061E CD 06B5 call infdc ;wait for controller 1457 0621 DB FB in a,(fdcdata) ;read status 1458 0623 E6 10 and trk0msk ;mask for track zero bit 1459 0625 C0 ret nz 1460 1461 0626 CD 06BE call seek ;home again 1462 0629 3E FF ld a,0ffh ;set z and cy for proper delays 1463 062B B7 or a 1464 062C 37 scf 1465 062D 18 2C jr wait 1466 1467 1468 ;---------------------------------------------------------------------- 1469 ; take care of virtual drive processing 1470 ;-----------------------------to mtab 1487 ;--------------------------------- 1488 ; 1489 0642 FD E5 gdsk: push iy ;get iy into hl 1490 0644 E1 pop hl ;calc. pionter to mtab for drive 1491 0645 11 001A ld de,mtab 1492 0648 19 add hl,de 1493 1494 0649 57 ld d,a 1495 064A 07 rlca ;mult. by 9 1496 064B 07 rlca 1497 064C 07 rlca 1498 064D 82 add a,d 1499 064E 5F ld e,a 1500 064F 16 00 ld d,0 1501 0651 19 add hl,de ;hl=mtab for drive 1502 1503 0652 C9 ret 1504 1505 ;---------------------------------521 ; wait in 4 ms increments 1522 ;------------------------ 1523 ; 1524 ; wait routine expects hl to point to dskdef1 in mtab. 1525 ; the z and the cy flags determine if motor and/or head settle 1526 ; delays are needed. 1527 ; if z=1 then motor delay is needed. 1528 ; if cy=1 then head settle delay is needed. 1529 ; delay time = 4ms. times the values in mtab. 1530 ; 1531 065B 23 wait: inc hl ;hl=> motor wait time 1532 065C FD 46 12 ld b,(iy+pdsk) ;get motor byte 1533 065F 0E F7 ld c,motor ;get motor port 1534 0661 56 ld d,(hl) ;hl=>wait time 1535 0662 1E 00 --------- 1471 ; 1472 062F 3C virt: inc a ;convert to ascii 1473 0630 CB F7 set 6,a 1474 1475 0632 FD 5E 0F ld e,(iy+vdrvp) 1476 0635 FD 56 10 ld d,(iy+vdrvp+1) ;de=pntr to vdrv 1477 0638 12 ld (de),a ;put vdrv in vmsg. 1478 0639 FD 5E 0D ld e,(iy+vmsgp) ;de=pntr to vmsg 1479 063C FD 56 0E ld d,(iy+vmsgp+1) 1480 1481 063F C3 0493 jp virtm 1482 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-33 1483 1484 1485 ;---------------------------------------------------------------------- 1486 ; set hl pair as a pointer ------------------------------------- 1506 ; load the current track into the d reg 1507 ;-------------------------------------- 1508 ; 1509 0653 E5 gtrk: push hl ;save mtab pointer 1510 0654 11 0007 ld de,troff ;offset to track 1511 0657 19 add hl,de ;add to hl 1512 1513 0658 56 ld d,(hl) ;d=current track 1514 1515 0659 E1 pop hl ;restore hl 1516 065A C9 ret 1517 1518 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-34 1519 1520 ;---------------------------------------------------------------------- 1 ld e,0 1536 0664 23 inc hl ;hl=>settle time 1537 0665 30 28 jr nc,wait1 ;jmp if no settle delay 1538 1539 0667 ED 5E im 2 ;change int. mode 1540 0669 3E 00 ld a,rom shr 8 and 0ffh ;set int table address for rom+7f 1541 066B ED 47 ld i,a 1542 066D 20 0C jr nz,wait2 ;jmp if no motor delay 1543 066F FB ei ;enable ints. 1544 0670 1B wlop1: dec de ;wait loop. dec count 1545 0671 7A ld a,d ;check if count is 0 1546 0672 B3 or e 1547 0673 28 08 jr z,wlop2 ;jmp if count = 0 1548 0675 0E F7 ld c,motor ;get motor port & time pad 1549 0677 ED 41 out (c),b ;keep motors running 1550 0679 18 F5 jr wlop1 ;loop 1551return if no motor delay needed 1568 1569 0690 ED 41 wlop3: out (c),b ;keep motors running 1570 0692 ED 41 out (c),b ;time pad 1571 0694 00 nop ; " " 1572 0695 1B dec de ;dec count 1573 0696 7A ld a,d 1574 0697 B3 or e ;see if count = 0 1575 0698 C2 0690 jp nz,wlop3 ;jmp if done 1576 069B C9 ret 1577 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-35 1578 1579 1580 ;---------------------------------------------------------------------- 1581 ; Check if the FDC is ready 1582 ;-------------------------- 1583  and 0c0h ;that it is ready to 1599 06B0 FE 80 cp 80h ;accept input 1600 06B2 20 F8 jr nz,outfdc ;loop if not ready 1601 06B4 C9 ret ;return when ready 1602 1603 ;---------------------------------------------------------------------- 1604 ; Hang until FDC input buffer is ready 1605 ;------------------------------------- 1606 ; 1607 06B5 DB FA infdc: in a,(fdcstat) ;wait for fdc to signal 1608 06B7 E6 C0 and 0c0h ;that it is ready to 1609 06B9 FE C0 cp 0c0h ;return output. 1610 06BB 20 F8 jr nz,infdc ;loop if not ready 1611 06BD C9 ret ;return when ready 1612 1613  1552 067B 56 wait2: ld d,(hl) ;get head settle delay 1553 067C FB ei 1554 067D ED 41 wlop2: out (c),b ;keep motors running 1555 067F 18 FC jr wlop2 ;jmp self 1556 1557 0681 ED 46 skint: im 0 ;set int mode back to 0 1558 0683 33 inc sp ;fix stack 1559 0684 33 inc sp 1560 0685 CD 070F call sintr ;clear int. 1561 0688 7A ld a,d ;compare settle time to whats left 1562 0689 BE cp (hl) ;of motor time. 1563 068A 30 04 jr nc,wlop3 ;jmp if motor bigger 1564 1565 068C 56 ld d,(hl) ;de=settle time 1566 068D 18 01 jr wlop3 1567 068F C0 wait1: ret nz ; ; 1584 069C CD 06F8 nrdy: call sint ;sense int. to clear seek flags 1585 069F DB FA rdy: in a,(fdcstat) ;see if any seek flags are set 1586 06A1 E6 0F and 0fh 1587 06A3 20 F7 jr nz,nrdy ;jump if any seek flags are set 1588 06A5 DB FA in a,(fdcstat) ;make sure fdc is ready 1589 06A7 CB 67 bit 4,a 1590 06A9 20 F4 jr nz,rdy 1591 06AB C9 ret 1592 1593 ;---------------------------------------------------------------------- 1594 ; Hang until FDC output buffer is empty 1595 ;-------------------------------------- 1596 ; 1597 06AC DB FA outfdc: in a,(fdcstat) ;wait for fdc to signal 1598 06AE E6 C0  ;---------------------------------------------------------------------- 1614 ; Seek Routine 1615 ;------------- 1616 ; 1617 06BE CD 06AC seek: call outfdc ;wait for fdc 1618 06C1 3E 07 ld a,skcmd ;root of seek & home command 1619 06C3 B1 or c ;or in bit to get home or seek 1620 06C4 D3 FB out (fdcdata),a ;output command 1621 06C6 CD 06AC call outfdc ;wait for fdc 1622 06C9 3E 03 ld a,mtrmsk ;get mask for ds 1623 06CB A6 and (hl) ;mask off ds 1624 06CC CB 59 bit 3,c ;see if home 1625 06CE 28 03 jr z,hd0 ;jmp if home 1626 06D0 DD B6 09 or (ix+phyhd) ;or in head bit 1627 06D3 D3 FB hd0: out (fdcdata),a ;output hd and ds 162 C:=FDC data port 1643 ; 1644 06E1 E5 specfy: push hl ;save hl 1645 06E2 23 inc hl ;move hl to specify parameters 1646 06E3 23 inc hl ;for current drive. 1647 06E4 23 inc hl 1648 06E5 CD 06AC call outfdc ;wait for fdc 1649 06E8 3E 03 ld a,spcmd ;specify command 1650 06EA D3 FB out (fdcdata),a 1651 06EC 01 02FB ld bc,tmpbc ;param. count 1652 06EF CD 06AC splp: call outfdc 1653 06F2 ED A3 outi 1654 06F4 20 F9 jr nz,splp 1655 1656 06F6 E1 pop hl 1657 06F7 C9 ret 1658 1659 ;---------------------------------------------------------------------- 1660  ;---------------------------------------------------------------------- 1677 ; Clear Interrupt status and update current track in MTAB 1678 ;-------------------------------------------------------- 1679 ; 1680 070F CD 06F8 sintr: call sint ;CLR irq status - check command valid 1681 0712 E5 push hl ;save hl & de 1682 0713 D5 push de 1683 0714 11 0005 ld de,troff-2 ;offset to current track in MTAB 1684 0717 19 add hl,de ;hl=>current track 1685 0718 77 ld (hl),a ;update current track 1686 0719 D1 pop de ;restore hl & de 1687 071A E1 pop hl 1688 071B C9 ret 1689 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-De8 06D5 CB 59 bit 3,c ;see if home 1629 06D7 C8 ret z ;ret if home 1630 1631 06D8 CD 06AC call outfdc ;wait for fdc 1632 06DB DD 7E 08 ld a,(ix+phytrk) ;get track 1633 06DE D3 FB out (fdcdata),a ;output track 1634 06E0 C9 ret 1635 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-36 1636 1637 1638 ;---------------------------------------------------------------------- 1639 ; Write the two bytes of the FDC specify command 1640 ;----------------------------------------------- 1641 ; 1642 02FB tmpbc equ (200h or fdcdata) ;B:=2, ; Do a Sense Interrupt Status Command 1661 ;------------------------------------ 1662 ; 1663 06F8 CD 06AC sint: call outfdc 1664 06FB 3E 08 ld a,sicmd ;sense int. stat. command 1665 06FD D3 FB out (fdcdata),a 1666 06FF CD 06B5 call infdc ;Read ST0 1667 0702 DB FB in a,(fdcdata) 1668 0704 E6 C0 and 0c0h ;only look at the interrupt code 1669 0706 FE 80 cp 80h ;If (invalid command was issued) 1670 0708 C8 ret z ; return 1671 1672 0709 CD 06B5 call infdc ;Else 1673 070C DB FB in a,(fdcdata) ; read the present track value 1674 070E C9 ret 1675 1676 c-81 PAGE 1-37 1690 1691 1692 ;---------------------------------------------------------------------- 1693 ; error code computation 1694 ;----------------------- 1695 ; 1) this routine uses the status that has been stored in stadd 1696 ; through stadd+2 to compute an error code. possible error 1697 ; codes are: 1698 ; 1699 ; write protect 1 1700 ; seek error 2 1701 ; data crc 3 1702 ; id crc 4 1703 ; not found 5 1704 ; drive not ready 6 1705 ; sync 7 1706  bit wp,(ix+stadd+1) ;see if wp 1727 0722 C0 ret nz 1728 1729 0723 0C inc c 1730 0724 DD CB 10 4E bit bce,(ix+stadd+2) ;see if seek error 1731 0728 C0 ret nz 1732 1733 0729 DD CB 10 66 bit wc,(ix+stadd+2) 1734 072D C0 ret nz 1735 1736 072E 0C inc c 1737 072F DD CB 10 6E bit dd,(ix+stadd+2) ;see if data crc 1738 0733 C0 ret nz 1739 1740 0734 0C inc c 1741 0735 DD CB 0F 6E bit der,(ix+stadd+1) ;see if id crc 1742 0739 C0 ret nz 1743 1744 073A 0C inc c 1745 073B DD CB 0F 7E bit en,(ix+stadd+1) ;see i 1764 0760 0C inc c 1765 0761 DD CB 0E 66 bit eq,(ix+stadd) ;see if equip. chk. 1766 0765 C0 ret nz 1767 1768 0766 0C inc c 1769 0767 DD CB 0E 7E bit ier,(ix+stadd) ;see if invalid command 1770 076B C0 ret nz 1771 1772 076C 0C inc c ;unknown error 1773 076D C9 ret 1774 1775 076E DS (ROM+7FCH-$),0FFH 1776 ;****************************************** 1777 ;This area must remain at locations 7fc-7ff 1778 ;******************************************' 1779 ; 1780 07FC 13 DB REVCMPT 1781 07FD 22  ; equipment check 8 1707 ; invalid command 9 1708 ; unknown error 10 1709 ; 1710 0001 wp equ 1 1711 0001 bce equ 1 1712 0004 wc equ 4 1713 0005 dd equ 5 1714 0007 en equ 7 1715 0002 nd equ 2 1716 0000 ma equ 0 1717 0006 cm equ 6 1718 0000 md equ 0 1719 0003 nr equ 3 1720 0004 ore equ 4 1721 0004 eq equ 4 1722 0005 der equ 5 1723 0007 ier equ 7 1724 1725 071C 0E 01 ecode: ld c,1 ;error root 1726 071E DD CB 0F 4Ef unreadable 1746 073F C0 ret nz 1747 0740 DD CB 0F 56 bit nd,(ix+stadd+1) 1748 0744 C0 ret nz Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-38 1749 0745 DD CB 0F 46 bit ma,(ix+stadd+1) 1750 0749 C0 ret nz 1751 074A DD CB 10 76 bit cm,(ix+stadd+2) 1752 074E C0 ret nz 1753 074F DD CB 10 46 bit md,(ix+stadd+2) 1754 0753 C0 ret nz 1755 1756 0754 0C inc c 1757 0755 DD CB 0E 5E bit nr,(ix+stadd) ;see if drive not rdy 1758 0759 C0 ret nz 1759 1760 075A 0C inc c 1761 075B DD CB 0F 66 bit ore,(ix+stadd+1) ;see if sync 1762 075F C0 ret nz 1763  DB REVCMP1 1782 07FE 24 db rev 1783 07FF DS 2,0FFH 1784 1785 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-39 1786 1787 ;---------------------------------------------------------------------- 1788 ; Subroutine: DIAGNOSE 1789 ;--------------------- 1790 ; 1791 ; This routine is used to test the various functional blocks of the hardware. 1792 ; It displays a menu, from which you can select the test to be performed. 1793 ; 1794 0801 diagnose: 1795 0801 11 0D41 ld de,diagmsg ; print diagnostics signon msg 1796 0809 3D notbp: dec a ; set base offset of 0 1812 082A 07 rlca ; calculate offset in dispatch table 1813 082B 4F ld c,a 1814 082C AF xor a 1815 082D 47 ld b,a ; bc = offset in dispatch table 1816 082E 21 083B ld hl,dsptch ; hl = base of dispatch table 1817 0831 09 add hl,bc ; hl = address of vector for selected 1818 ; diagnostic test 1819 0832 5E ld e,(hl) 1820 0833 23 inc hl 1821 0834 56 ld d,(hl) 1822 0835 EB ex de,hl 1823 1824 0836 CD 01DD call cntjp ; to indirect jump 1825 0839 18 C6 jr diagnose ; then return to menu 1826 083B dsptch: 1827 083B 084D routine: BPOLE 1841 ;------------------ 1842 ; 1843 ; This will print a barber-pole test pattern on the ports. The port 1844 ; to test is stored in location 'PORT'. 1 => serial port 1 1845 ; 2 => serial port 2 1846 ; 3 => centronics port 1847 ; 1848 084D 3E 20 bpole: ld a,20h ; initialize barberpole test 1849 084F 32 FFFD ld (bgnchar),a ; a = character to print 1850 0852 3E 5F prntlp: ld a,05fh ; b = number of characters before cr/lf 1851 0854 47 ld b,a 1852 0855 3A FFFD ld a,(bgnchar) ; get character to start with 1853 0858 CD 0880 outlp: call testout ; ou4 CD 01C3 call mesg ; and menu 1797 0807 CD 04C9 inlp: call ciny ; get test to run 1798 080A FE 31 cp '1' ; adjust and check if in range 1799 080C FA 0807 jp m,inlp ; between 1, and... 1800 080F FE 3A cp 3ah ; ... 9 1801 0811 F2 0807 jp p,inlp 1802 0814 F5 push af 1803 0815 CD 01CC call outcn ; output test number 1804 0818 11 0EAB ld de,crlf ; if valid #, send cr/lf 1805 081B CD 01C3 call mesg 1806 081E F1 pop af 1807 081F D6 30 sub '0' ; A = test number (1-9) 1808 0821 FE 04 cp 4 ; if bpole test, set up port 1809 0823 F2 0829 jp p,notbp ; don't set up port if not bpole test 1810 0826 32 FFFE ld (port),a ; set up port to use for bpole test 1811 082 dw bpole ; test 1 = bpole on serial port 1 1828 083D 084D dw bpole ; 2 = bpole on serial port 2 1829 083F 084D dw bpole ; 3 = bpole on centronics port 1830 0841 08A3 dw loopbk ; 4 = loop back test on serial port 2 1831 0843 08CD dw mtest ; 5 = memory test 1832 0845 0921 dw rwtest ; 6 = floppy r/w test 1833 0847 09C9 dw seektest ; 7 = floppy seek test 1834 0849 0A1A dw vfotest ; 8 = vfo test 1835 084B 0A3D dw diagboot ; boot system 1836 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-40 1837 1838 1839 ;---------------------------------------------------------------------- 1840 ; Subtput the character 1854 085B 05 dec b ; adjust character count 1855 085C 28 08 jr z,shift ; if end, change start for next line 1856 085E 3C inc a ; else, next character 1857 085F F2 0858 jp p,outlp ; send next character 1858 0862 3E 20 ld a,20h ; jump over control codes 1859 0864 18 F2 jr outlp ; then continue sending 1860 0866 CD 089E shift: call keystat ; see if a key has been typed 1861 0869 C0 ret nz ; if so, then end test 1862 086A 3E 0D ld a,cr ; send out cr, lf 1863 086C CD 0880 call testout ; output the character 1864 086F 3E 0A ld a,lf 1865 0871 CD 0880 call testout 1866 0874 3A FFFD ld a,(bgnchar) ; change starting character 1867 0877 3C inc a 10880 testout: 1883 0880 F5 push af 1884 0881 C5 push bc 1885 0882 4F ld c,a 1886 0883 3A FFFE ld a,(port) ; get port to test 1887 0886 FE 01 cp 1 ; see if port 1 1888 0888 20 05 jr nz,port2 ; if not, check if port 2 1889 088A CD 0175 call cnout ; if 1, test port 1 1890 088D 18 0C jr exitout ; restore, and return 1891 088F FE 02 port2: cp 2 ; see if test for port 2 1892 0891 20 05 jr nz,cent ; no? then centronics 1893 0893 CD 0171 call ser2out ; yes => use 2nd serial port 1894 0896 18 03 jr exitout ; then restore and return 1895 0898 CD 0198 cent: call centout ; must be centronics test 1896 089B exitout: 1897 089B C1 1913 08A3 DB FE loopbk: in a,(s2data) ; clear any character in buffer 1914 08A5 AF xor a ; starting character for test is null 1915 08A6 looptst: 1916 08A6 57 ld d,a ; character to look for 1917 08A7 4F ld c,a ; character to send in C 1918 08A8 CD 0171 call ser2out ; output char in C 1919 08AB CD 0185 call ser2in ; get char from port 2 to acc. 1920 08AE BA cp d ; did we get what we sent? 1921 08AF 20 0F jr nz,looperr ; jump if not 1922 08B1 CD 089E call keystat ; else, was console key hit? 1923 08B4 20 05 jr nz,loopgd 1924 08B6 7A ld a,d ; get next char to send 1925 08B7 3C inc a 1926 08B8 F2 08A6 jp p,looptst ; and send it 1927 08BB 11 0E49868 0878 FA 084D jp m,bpole ; if 80h, then re-start 1869 087B 32 FFFD ld (bgnchar),a 1870 087E 18 D2 jr prntlp ; then print next line 1871 1872 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-41 1873 1874 ;---------------------------------------------------------------------- 1875 ; Subroutine: TESTOUT 1876 ;-------------------- 1877 ; 1878 ; Output a character to a port, where port saved in memory location 'PORT' 1879 ; On entry, A = character to output. This routine calls the appropriate 1880 ; output handler. 1881 ; 1882  pop bc 1898 089C F1 pop af ; restore registers before return 1899 089D C9 ret 1900 089E keystat: 1901 089E DB FD in a,(s1stat) ; read console status 1902 08A0 CB 4F bit 1,a ; see if key hit 1903 08A2 C9 ret 1904 1905 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-42 1906 1907 ;---------------------------------------------------------------------- 1908 ; Subroutine: LOOPBK 1909 ;------------------- 1910 ; 1911 ; Perform a loop-back test on serial port 2. Test ends when a key is pressed. 1912 ;  loopgd: ld de,passed ; point to success mesg 1928 08BE 18 03 jr msgout ; and send message 1929 08C0 looperr: 1930 08C0 11 0E3F ld de,failed ; point to fail message 1931 08C3 CD 01C3 msgout: call mesg ; print message 1932 08C6 11 0E34 ld de,loopmsg 1933 08C9 CD 01C3 call mesg 1934 08CC C9 ret 1935 1936 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-43 1937 1938 ;---------------------------------------------------------------------- 1939 ; Subroutine: MTEST 1940 ;------------------ 1941 ; 1942 ; Perform memory test  ret ; else, return to test menu 1957 ; 1958 08EE AF clrerr: xor a ; clear errors and pass 1959 08EF 32 FFFE ld (mempass),a 1960 08F2 32 FFFD ld (errors),a 1961 08F5 C9 ret 1962 1963 08F6 3A FFFD incerr: ld a,(errors) ; increment error count 1964 08F9 3C inc a 1965 08FA 32 FFFD ld (errors),a 1966 08FD C9 ret 1967 1968 08FE prntpass: ; print pass info for test 1969 08FE 11 0E15 ld de,passmsg ; point to pass message 1970 0901 CD 01C3 call mesg ; print it 1971 0904 3A FFFE ld a,(mempass) ; get number of passes made 1972 0907 3C inc a ; increment by one 1973 09 ; writes a worst case data pattern to track 39 of a selected drive, 1990 ; afterwhich it goes into a loop reading the data continually until a key 1991 ; is pressed on the keyboard. If CRC errors occur during the ID, or DATA 1992 ; areas, the error count is incremented. After each pass, the pass number, 1993 ; and the total number of errors detected since starting the test, is printed. 1994 ; 1995 ; 1996 0921 CD 093E rwtest: call setup ;set up tables, get drive to test 1997 0924 DD 36 01 27 ld (IX+HSTTRK),39 ; set to test track 39 1998 0928 DD 36 03 05 ld (IX+SECCNT),5 ; set to read all five sectors 1999 092C CD 0974 call bldbuf ; build buffer of worst case data 2000 092F CD 08EE call clrecontinually, until a key is hit on keyboard. 1943 ; 1944 08CD 11 0C85 mtest: ld de,tstmsg ; print memory test msg 1945 08D0 CD 01C3 call mesg 1946 08D3 CD 08EE call clrerr ; clear error count and pass count 1947 08D6 21 0000 memlp: ld hl,0 ; lowest address to test 1948 08D9 01 FBFF ld bc,diskbuf-1 ; highest address to test 1949 08DC CD FC2A call memtest ; test memory 1950 08DF B7 or a ; test flags 1951 08E0 28 03 jr z,noerr ; if no errors, increment pass 1952 08E2 CD 08F6 call incerr ; else, increment error count 1953 08E5 CD 08FE noerr: call prntpass ; print pass info 1954 08E8 CD 089E call keystat ; see if key pressed 1955 08EB 28 E9 jr z,memlp ; keep testing if no key 1956 08ED C9 08 32 FFFE ld (mempass),a ; save it 1974 090B CD FCB3 call outbyte ; print it 1975 090E 11 0EAE ld de,coln 1976 0911 CD 01C3 call mesg 1977 0914 3A FFFD ld a,(errors) ; get number of errors found 1978 0917 CD FCB3 call outbyte ; print them 1979 091A 11 0E24 ld de,errnum ; and a message 1980 091D CD 01C3 call mesg 1981 0920 C9 ret 1982 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-44 1983 1984 1985 ;---------------------------------------------------------------------- 1986 ; RWTEST 1987 ;------- 1988 ; 1989 rr ; clear error count 2001 0932 CD 099B rwloop: call wrtbuf ; write data to disk 2002 0935 CD 09AC call rdbuf ; read data from disk 2003 0938 CD 089E call keystat ; check if key hit 2004 093B 28 F5 jr z,rwloop ; if no key hit, r/w again 2005 093D C9 ret 2006 2007 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-45 2008 2009 ;---------------------------------------------------------------------- 2010 ; SETUP 2011 ;------ 2012 ; 2013 ; moves the ramdatx and ramdaty ares to ram, and selects the drive to 2014 ; be used for the test. 2015 ii 2031 0961 CD 01CC call outcn ; tell which drive gets the diskette 2032 0964 11 0CDE ld de,rtrnmsg ; point to rest of message 2033 0967 CD 01C3 call mesg 2034 096A CD 04C9 call ciny ; get a character 2035 096D 11 0EAB ld de,crlf ; output a cr and lf 2036 0970 CD 01C3 call mesg 2037 0973 C9 ret 2038 2039 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-46 2040 2041 ;---------------------------------------------------------------------- 2042 ; BLDBUF 2043 ;------- 2044 ; 2045 ; build a buffer of worst case data. 2046  ; replicate pattern 2061 2062 0987 01 6DB6 ld bc,pat2 ; rest gets 2nd pattern 2063 098A 71 ld (hl),c 2064 098B 23 inc hl 2065 098C 70 ld (hl),b ; 2nd pattern set up 2066 098D 2B dec hl ; start for move 2067 098E 01 0C00 ld bc,0c00h ; 3k left to fill 2068 0991 ED B0 ldir ; fill it 2069 2070 0993 C1 pop bc ;restore pointer to buffer area 2071 0994 DD 71 05 ld (IX+HSTBUF),c ;set dma addr. for disk I/O 2072 0997 DD 70 06 ld (IX+HSTBUF+1),b ;set dma address 2073 099A C9 ret 2074 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-47 2075 2076  ; 2016 093E CD 015D setup: call xfrdata ; move ramdatx and ramdaty 2017 0941 11 0E53 ld de,drvmsg ; prompt for drive to use 2018 0944 CD 01C3 call mesg ; print prompt 2019 0947 CD 04C9 drvlp: call ciny ; get drive 2020 094A E6 DF and 0dfh ; force upper case 2021 094C D6 41 sub 41h ; test for valid drive 2022 094E 38 F7 jr c,drvlp 2023 0950 FE 04 cp 4 2024 0952 30 F3 jr nc,drvlp 2025 0954 DD 77 00 ld (IX+HSTDSK),a ; drive ok, so set up to use it 2026 0957 F5 push af 2027 0958 11 0E6E ld de,insrt ; tell them to insert a disk 2028 095B CD 01C3 call mesg 2029 095E F1 pop af ; get back drive 2030 095F C6 41 add a,41h ; turn to asc ; 2047 AA5F pat1 equ 0aa5fh ; worst case pattern 1 2048 6DB6 pat2 equ 6db6h ; worst case pattern 2 2049 8000 tstbuf equ 8000h ; use 8000h as start of dma address 2050 2051 0974 01 AA5F bldbuf: ld bc,pat1 ; get first worst case pattern 2052 0977 21 8000 ld hl,tstbuf ; point to test buf 2053 097A E5 push hl ; save testbuf 2054 097B 11 8002 ld de,tstbuf+2 ; point to dest. byte 2055 097E 71 ld (hl),c ; save 1st byte of worst case pattern 2056 097F 23 inc hl 2057 0980 70 ld (hl),b ; save 2nd byte of pattern 2058 0981 2B dec hl ; point to start for copy 2059 0982 01 0800 ld bc,800h ; copy 2k bytes 2060 0985 ED B0 ldir  2077 ;---------------------------------------------------------------------- 2078 ; WRTBUF 2079 ;------- 2080 ; 2081 ; sets up the error flag for disk I/O, and writes the buffer to disk. 2082 ; 2083 099B 11 0E96 wrtbuf: ld de,wrtmsg ; print Writing... 2084 099E CD 01C3 call mesg 2085 09A1 DD 36 07 FF ld (IX+ERFLAG),0FFh ; set type of error handling 2086 09A5 CD 030E call wrthst ; write the data 2087 09A8 CD 09C0 call tsterr ; see if any errors, if so inc errors 2088 09AB C9 ret ; else return to menu 2089 2090 ;---------------------------------------------------------------------- 20 DD 7E 07 tsterr: ld a,(IX+ERFLAG) ; check returned error status 2107 09C3 FE 00 cp 0 ; see if no errors 2108 09C5 C4 08F6 call nz,incerr ; else, increment error count 2109 09C8 C9 ret 2110 2111 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-48 2112 2113 ;---------------------------------------------------------------------- 2114 ; SEEKTEST 2115 ;--------- 2116 ; 2117 ; performs a 'butterfly' seektest continually until a key is 2118 ; pressed on the keyboard. 2119 ; 2120 09C9 seektest: 2121 09C9 CD 093E  C9 ret 2135 2136 ;---------------------------------------------------------------------- 2137 ; NXTRNG 2138 ;------- 2139 ; 2140 ; takes the b-c registers and adjusts them for the next track to seek 2141 ; to. For the butterfly pattern, the b register is incremented, and the c 2142 ; register is decremented. If the c register is decremented past zero, then 2143 ; it is time to change the direction for the seek. This is done by swapping 2144 ; the bc registers, and then re-adjusting them again. 2145 ; 2146 09ED 04 nxtrng: inc b ; increment track 2147 09EE 0D dec c 91 ; RDBUF 2092 ;------ 2093 ; 2094 ; does disk reads of a worst case pattern from track 39 of the selected 2095 ; drive. If CRC errors occur, they are logged, and a record is printed out 2096 ; after each pass of the read. 2097 ; 2098 09AC 11 0EA3 rdbuf: ld de,rdmsg ; print reading... 2099 09AF CD 01C3 call mesg 2100 09B2 DD 36 07 FF ld (IX+ERFLAG),0ffh ; set type of error handling 2101 09B6 CD 0301 call rdhst ; read the data 2102 09B9 CD 09C0 call tsterr ; see if any errors, if so inc errors 2103 09BC CD 08FE call prntpass 2104 09BF C9 ret ; else return to menu 2105 2106 09C0  call setup ; get disk to test, and select it 2122 09CC 06 00 ld b,0 ; starting outer track 2123 09CE 0E 27 ld c,39 ; starting inside track 2124 09D0 DD 36 05 00 ld (IX+HSTBUF),0 ; set DMA address for command 2125 09D4 DD 36 06 80 ld (IX+HSTBUF+1),80h ; at 8000h (arbitrary address) 2126 09D8 DD 36 03 01 ld (IX+SECCNT),1 ; only 1 sector needs to be read 2127 09DC CD 08EE call clrerr ; set error count to 0 2128 09DF C5 seeklp: push bc ; save seek ranges 2129 09E0 CD 09FD call tstseek ; seek the two tracks 2130 09E3 C1 pop bc ; get ranges back 2131 09E4 CD 09ED call nxtrng ; calculate next range 2132 09E7 CD 089E call keystat ; check for key input 2133 09EA 28 F3 jr z,seeklp ; if no key hit, test again 2134 09EC  ; decrement track 2148 09EF FA 09F3 jp m,swapbc ; if underflow, then it's time to swap 2149 09F2 C9 ret ; otherwise, adjustment is done 2150 2151 09F3 78 swapbc: ld a,b ; swap b-c pair, and readjust 2152 09F4 41 ld b,c 2153 09F5 4F ld c,a 2154 09F6 C5 push bc ; save range 2155 09F7 CD 08FE call prntpass ; print pass info only after complete 2156 ; pass has been made. inc # of passes 2157 09FA C1 pop bc ; get back range values 2158 09FB 18 F0 jr nxtrng ; swap done, so re-adjust bc 2159 2160 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-49 2161 2162 ror count if necessary 2176 0A0B C1 pop bc ; get other track to seek 2177 0A0C DD 71 01 ld (IX+HSTTRK),c ; set other track to seek 2178 0A0F DD 36 07 FF ld (IX+ERFLAG),0ffh ; set type of error handling 2179 0A13 CD 0301 call rdhst ; read the other sector 2180 0A16 CD 09C0 call tsterr ; inc error count if necessary 2181 0A19 C9 ret 2182 2183 ;---------------------------------------------------------------------- 2184 ; VFOTEST 2185 ;-------- 2186 ; 2187 ; tries to read track zero continually until a key is hit on the 2188 ; keyboard. It is used to check the VFO to see if it's in range. When 2189 ; pe page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-50 2205 2206 2207 2208 0A3D diagboot: 2209 0A3D F1 pop af ; bump a subroutine level 2210 0A3E C9 ret 2211 ; 2212 ;***************************************** 2213 ; This section of code is run at FC00h!!!! 2214 ;***************************************** 2215 ; 2216 0A3F block: 2217 .phase diskbuf 2218 ; 2219 FC00 stblk: 2220 FC00 DB F6 in a,(romctl) ; turn off rom 2221 FC02 3A 0000 ld a ;---------------------------------------------------------------------- 2163 ; TSTSEEK 2164 ;-------- 2165 ; 2166 ; seeks two tracks, keeping track of errors during the seek. If 2167 ; any errors occurred, then the error count is incremented. The tracks 2168 ; seeked are in the b-c pair upon entry. 2169 ; 2170 09FD tstseek: 2171 09FD C5 push bc ; save tracks being seeked 2172 09FE DD 70 01 ld (IX+HSTTRK),b ; set first track to seek 2173 0A01 DD 36 07 FF ld (IX+ERFLAG),0ffh ; set for error reporting/ no handling 2174 0A05 CD 0301 call rdhst ; read the sector 2175 0A08 CD 09C0 call tsterr ; increment errforming this test, error handling is completely turned off. 2190 ; 2191 0A1A vfotest: 2192 0A1A CD 015D call xfrdata ; move ramdatx, ramdaty 2193 0A1D AF xor a 2194 0A1E DD 77 00 ld (IX+HSTDSK),a ; select drive 'A' 2195 0A21 DD 77 01 ld (IX+HSTTRK),a ; track zero 2196 0A24 DD 36 03 01 ld (IX+SECCNT),1 ; set for one sector 2197 0A28 DD 36 05 00 ld (IX+HSTBUF),0 ; set DMA address 2198 0A2C DD 36 06 80 ld (IX+HSTBUF+1),80h 2199 0A30 DD 36 07 FE vfoadj: ld (IX+ERFLAG),0feh ; turn off error handling 2200 0A34 CD 0301 call rdhst ; do a read 2201 0A37 CD 089E call keystat ; look for a key 2202 0A3A 28 F4 jr z,vfoadj ; keep reading until a key is hit 2203 0A3C C9 ret 2204 ,(00) ; get value at loc. 0 2222 FC05 FE C3 cp 0c3h ; test if it's jp op code 2223 FC07 D3 F6 out (romctl),a ; turn on rom... 2224 FC09 20 03 jr nz,test ; if jp then warm boot 2225 FC0B C3 0047 jp warm ; and boot!!!! 2226 ; else, start testing system 2227 FC0E 11 0C85 test: ld de,tstmsg ; point to test msg. 2228 FC11 CD 01C3 call mesg ; print it 2229 FC14 21 0000 ld hl,0 ; low addr to test 2230 FC17 01 FBFF ld bc,diskbuf-1 ; highest to test 2231 FC1A CD FC2A call memtest ; test memory 2232 FC1D B7 or a ; test flags 2233 FC1E C2 00D4 jp nz,ramerr ; if memfail, then jump 2234 FC21 11 0CA9 ld de,romok ; point to memory ok message 2235 FC24 CD 01C3 call mesg ; and print it 2 last 2249 ; location to be tested. When an error is encountered, the 2250 ; routine will return a non-zero value in the accumulator. 2251 ; When no errors are found, the routine will return with 2252 ; the accumulator equal to zero. 2253 ; 2254 FC2A memtest: 2255 FC2A DB F6 in a,(romctl) ; turn off ROM 2256 FC2C 22 FD00 ld (smem),hl ; save start pointer 2257 FC2F 21 FCD2 ld hl,patlst ; point to test table 2258 FC32 56 testlp: ld d,(hl) ; get data to test 2259 FC33 23 inc hl 2260 FC34 CB 7E bit 7,(hl) ; check if end of table 2261 FC36 20 18 jr nz,pass ; if so, then passed 2262 FC38 5E ld e,(hl) ; get offset(0,1x,rdmem ; set for read 2278 FC58 2A FD00 testm: ld hl,(smem) ; get where to start 2279 FC5B 7B LD A,E ; get offset from start 2280 FC5C 85 ADD A,L ; compute actual starting 2281 FC5D 6F LD L,A ; address 2282 ; hl<==hl+offset 2283 FC5E 7C LD A,H ; 2284 FC5F CE 00 ADC A,0 2285 FC61 67 LD H,A 2286 2287 FC62 CD FC72 lp: call indjp ; indirect jump via ix 2288 FC65 23 INC HL ; skip two bytes 2289 FC66 23 INC HL 2290 FC67 23 INC HL 2291 FC68 78 LD A,B 2292 FC69 BC CP H 2293 FC6A D8 RET C 2294 FC6B 20 F5 jr NZ,lp ; if top not reached, keep 236 FC27 C3 0047 jp warm ; if ok, then go 2237 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-51 2238 2239 2240 ;---------------------------------------------------------------------- 2241 ; Subroutine: MEMTEST 2242 ;-------------------- 2243 ; 2244 ; Function: This routine performs a memory test on a block of memory. 2245 ; The block of memory may be of any size, and is determined 2246 ; by the values passed upon entry. 2247 ; When called, register pair HL points to the start of the 2248 ; block to be tested, and register pair BC points to the,2)& rd/wr 2263 FC39 CB 73 bit 6,e ; test if read or write 2264 FC3B CB B3 res 6,e ; reset the bit 2265 FC3D 23 inc hl 2266 FC3E E5 push hl ; save table pointer 2267 FC3F 28 05 jr z,fill ; 0==> fill memory 2268 FC41 CD FC54 call check ; 1==> check memory 2269 FC44 18 07 jr over 2270 FC46 DD 21 FC74 fill: ld ix,wrmem ; calculate start 2271 FC4A CD FC58 call testm ; test memory 2272 FC4D E1 over: pop hl ; restore table pointer 2273 FC4E 18 E2 jr testlp ; loop while not done 2274 FC50 AF pass: xor a ; set accumulator to pass 2275 FC51 D3 F6 out (romctl),a ; turn ROM back on 2276 FC53 C9 ret ; return success 2277 FC54 DD 21 FC76 check: ld igoing 2295 FC6D 79 LD A,C 2296 FC6E BD CP L Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-52 2297 FC6F D8 RET C 2298 FC70 18 F0 jr lp 2299 2300 FC72 DD E9 indjp: jp (ix) ; perform jump to wr or rd 2301 2302 FC74 72 wrmem: LD (HL),D ; write test value 2303 FC75 C9 ret 2304 2305 FC76 7E rdmem: ld a,(hl) ; get test value 2306 FC77 BA cp d 2307 FC78 20 01 jr nz,err 2308 FC7A C9 ret 2309 2310 FC7B D3 F6 ERR: out (romctl),a ; made error, so turn on ROM 2311 FC7D DB F5 in a,(0f5h) ; see if in diagnostics modred, 2328 ; followed by the data read from RAM, and what it expected to read. 2329 ; 2330 FC8A outhl: 2331 FC8A D5 push de 2332 FC8B 11 0D1A ld de,readmsg ; point to message 2333 FC8E CD 01C3 call mesg ; print it 2334 FC91 DB F6 in a,(romctl) ; get ROM out of the way 2335 FC93 7E ld a,(hl) ; get value read 2336 FC94 D3 F6 out (romctl),a ; turn ROM back on 2337 FC96 CD FCB3 call outbyte ; output it in hex 2338 FC99 11 0D24 ld de,expctmsg ; point to message 2339 FC9C CD 01C3 call mesg ; print it 2340 FC9F D1 pop de ; get back expected value 2341 FCA0 7A ld a,d 2342 FCA1 CD FCB3 call outbyte ; print expected value in h value 2359 FCB4 0F rrca ; get upper nibble 2360 FCB5 0F rrca 2361 FCB6 0F rrca 2362 FCB7 0F rrca 2363 FCB8 E6 0F and 0fh ; mask off the rest 2364 FCBA CD FCC4 call outasc ; print ascii hex digit 2365 FCBD F1 pop af ; get value back 2366 FCBE E6 0F and 0fh ; mask 2367 FCC0 CD FCC4 call outasc ; print ascii hex digit 2368 FCC3 C9 ret 2369 2370 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-54 2371 2372 ;---------------------------------------------------------------------- 2373 ; Subroutine: OUTASC 2374 e 2312 FC7F CB 6F bit 5,a 2313 FC81 CC FC8A call z,outhl ; output full error msg if in 2314 ; diagnostics mode 2315 FC84 F1 pop af 2316 FC85 F1 pop af 2317 FC86 F1 pop af 2318 FC87 3E FF LD A,0FFH 2319 FC89 C9 ret 2320 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-53 2321 2322 2323 ;---------------------------------------------------------------------- 2324 ; Subroutine: OUTHL 2325 ;------------------ 2326 ; 2327 ; This routine prints out the memory location at which the error occuex 2343 FCA4 11 0D2F ld de,rammsg ; point to ram error mesg 2344 FCA7 CD 01C3 call mesg ; print it, 2345 FCAA 7C ld a,h ; get high byte of address 2346 FCAB CD FCB3 call outbyte ; print it 2347 FCAE 7D ld a,l ; get low byte of address 2348 FCAF CD FCB3 call outbyte ; print it 2349 FCB2 C9 ret 2350 2351 ;---------------------------------------------------------------------- 2352 ; Subroutine: OUTBYTE 2353 ;-------------------- 2354 ; 2355 ; This will print the hex value of the accumulator. 2356 ; 2357 FCB3 outbyte: 2358 FCB3 F5 push af ; save;------------------- 2375 ; 2376 ; This routine outputs the lower nibble of the accumulator as a hex digit. 2377 ; 2378 FCC4 outasc: 2379 FCC4 FE 0A cp 0ah ; see if digit or alpha 2380 FCC6 FA FCCB jp m,num ; jump if digit 2381 FCC9 C6 07 add a,07h ; adjust for alpha 2382 FCCB C6 30 num: add a,30h ; convert to ascii 2383 FCCD 4F ld c,a 2384 FCCE CD 01CC call outcn ; print it 2385 FCD1 C9 ret 2386 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-55 2387 2388 2389 ;------------------------------------------------------------------- FCE2 00 02 db 00,wr or 2 2408 FCE4 00 42 db 00,rd or 2 2409 FCE6 00 40 db 00,rd or 0 2410 FCE8 FF 41 db 0ffh,rd or 1 2411 FCEA AA 00 db 0aah,wr or 0 2412 FCEC 55 02 db 55h,wr or 2 2413 FCEE AA 01 db 0aah,wr or 1 2414 FCF0 AA 41 db 0aah,rd or 1 2415 FCF2 55 01 db 55h,wr or 1 2416 FCF4 AA 40 db 0aah,rd or 0 2417 FCF6 55 00 db 55h,wr or 0 2418 FCF8 55 42 db 55h,rd or 2 2419 FCFA 55 41 db 55h,rd or 1 2420 FCFC 55 40 db 55h,rd or 0 2421 FCFE 00 80 db 00,80h ; msb=1 ==> end of pattern list 2422 ; 2423 FD00 SMEM equ $ 2424 FD00 endblk: 2425 B5D 44 61 74 61 CRM: DC 'Data error.' 2446 0B61 20 65 72 72 2447 0B65 6F 72 AE 2448 0B68 00 DB 0 2449 2450 0B69 4E 6F 74 20 URM: DC 'Not found.' 2451 0B6D 66 6F 75 6E 2452 0B71 64 AE 2453 0B73 00 DB 0 2454 2455 0B74 4C 6F 73 74 SYM: DC 'Lost data.' 2456 0B78 20 64 61 74 2457 0B7C 61 AE 2458 0B7E 00 DB 0 2459 2460 0B7F 44 72 69 76 NRM: DC 'Drive not ready.' 2461 0B83 65 20 6E 6F 2462 0B87 74 20 72 65 2463 0B8B 61 64 79 AE 2464 0B8F 00 DB 0 2465 2466 0B7F EQM EQU NRM 2467 --- 2390 ; MEMORY PATTERN TEST TABLE 2391 ;-------------------------- 2392 ; 2393 ; format is: 2394 ; 1st byte -- value to use (0-ffh) 2395 ; 2nd byte -- bit 6 r/w flag 0 => write 2396 ; 1 => read 2397 ; bits [0,1] offset (0,1,2) 2398 ; 2399 FCD2 FF 00 patlst: db 0ffh,wr or 0 2400 FCD4 00 01 db 00,wr or 1 2401 FCD6 FF 02 db 0ffh,wr or 2 2402 FCD8 00 41 db 00,rd or 1 2403 FCDA FF 42 db 0ffh,rd or 2 2404 FCDC FF 40 db 0ffh,rd or 0 2405 FCDE 00 00 db 00,wr or 0 2406 FCE0 FF 01 db 0ffh,wr or 1 2407 ; 2426 .dephase 2427 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-56 2428 2429 2430 ;---------------------------------------------------------------------- 2431 ; Messages 2432 ;--------- 2433 ; 2434 0B3F 57 72 6F 6E SKM: DC 'Wrong track.' 2435 0B43 67 20 74 72 2436 0B47 61 63 6B AE 2437 0B4B 00 DB 0 2438 2439 0B4C 57 72 69 74 WPM: DC 'Write protected.' 2440 0B50 65 20 70 72 2441 0B54 6F 74 65 63 2442 0B58 74 65 64 AE 2443 0B5C 00 DB 0 2444 2445 0 2468 0B90 49 6E 76 61 ICM: DC 'Invalid command.' 2469 0B94 6C 69 64 20 2470 0B98 63 6F 6D 6D 2471 0B9C 61 6E 64 AE 2472 0BA0 00 DB 0 2473 2474 0BA1 55 6E 6B 6E UNM: DC 'Unknown error.' 2475 0BA5 6F 77 6E 20 2476 0BA9 65 72 72 6F 2477 0BAD 72 AE 2478 0BAF 00 DB 0 2479 2480 0BB0 0A0D DMESG: DW 0A0DH 2481 0BB2 44 69 73 6B DC 'Disk error on drive ' 2482 0BB6 20 65 72 72 2483 0BBA 6F 72 20 6F 2484 0BBE 6E 20 64 72 2485 0BC2 69 76 65 A0 2486 0BC6 00 DB 0 Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-57 2487 2488 0BC7 0A0D 11 0C14 6B 65 74 74 2512 0C18 65 2E 00 2513 0C1B 0A0D RERR: DW 0A0DH 2514 0C1D 50 75 73 68 DC 'Push reset to try again. ' 2515 0C21 20 72 65 73 2516 0C25 65 74 20 74 2517 0C29 6F 20 74 72 2518 0C2D 79 20 61 67 2519 0C31 61 69 6E 2E 2520 0C35 A0 2521 0C36 00 DB 0 2522 0C37 0D 4D 69 63 signon: db cr,'Micro-Decision -- ROM Rev. ' 2523 0C3B 72 6F 2D 44 2524 0C3F 65 63 69 73 2525 0C43 69 6F 6E 20 2526 0C47 2D 2D 20 52 2527 0C4B 4F 4D 20 52 2528 0C4F 65 76 2E 20 2529 0C53 32 2E 34 0D db ((rev and 0f0h) shr 4)+asc0,'.',(rev and 0fh)+asc0,cr,lf 2530 0C57 0A 2531 0C58 43 6F 70 79 db 'Copyright 1982, 1983 Morrow Desr,lf,lf,0 2553 0CAD 72 79 20 4F 2554 0CB1 2E 4B 2E 0D 2555 0CB5 0A 0A 00 2556 0CB8 bootmsg: 2557 0CB8 49 6E 73 65 db 'Insert CP/M system diskette in Drive A' 2558 0CBC 72 74 20 43 2559 0CC0 50 2F 4D 20 2560 0CC4 73 79 73 74 2561 0CC8 65 6D 20 64 2562 0CCC 69 73 6B 65 2563 0CD0 74 74 65 20 2564 0CD4 69 6E 20 44 2565 0CD8 72 69 76 65 2566 0CDC 20 41 2567 0CDE rtrnmsg: 2568 0CDE 20 61 6E 64 db ' and press [RETURN] ',bell,0 2569 0CE2 20 70 72 65 2570 0CE6 73 73 20 5B 2571 0CEA 52 45 54 55 2572 0CEE 52 4E 5D 20 2573 0CF2 07 00 2574 0CF4 07 07 52 4F rommsg: db bell,bell,'ROM Memory error',0  RESM: DW 0A0DH 2489 0BC9 54 79 70 65 DC 'Type R to try again, A to abort, or I to ignore: ' 2490 0BCD 20 52 20 74 2491 0BD1 6F 20 74 72 2492 0BD5 79 20 61 67 2493 0BD9 61 69 6E 2C 2494 0BDD 20 41 20 74 2495 0BE1 6F 20 61 62 2496 0BE5 6F 72 74 2C 2497 0BE9 20 6F 72 20 2498 0BED 49 20 74 6F 2499 0BF1 20 69 67 6E 2500 0BF5 6F 72 65 3A 2501 0BF9 A0 2502 0BFA 00 DB 0 2503 2504 0BFB 0A BTERR: DB 0AH 2505 0BFC 45 72 72 6F DB 'Error on CP/M system diskette.',0 2506 0C00 72 20 6F 6E 2507 0C04 20 43 50 2F 2508 0C08 4D 20 73 79 2509 0C0C 73 74 65 6D 2510 0C10 20 64 69 73 25igns, Inc.',cr,lf,lf,0 2532 0C5C 72 69 67 68 2533 0C60 74 20 31 39 2534 0C64 38 32 2C 20 2535 0C68 31 39 38 33 2536 0C6C 20 4D 6F 72 2537 0C70 72 6F 77 20 2538 0C74 44 65 73 69 2539 0C78 67 6E 73 2C 2540 0C7C 20 49 6E 63 2541 0C80 2E 0D 0A 0A 2542 0C84 00 2543 0C85 54 65 73 74 tstmsg: db 'Testing memory -- please stand by: ',0 2544 0C89 69 6E 67 20 2545 0C8D 6D 65 6D 6F 2546 0C91 72 79 20 2D Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-58 2547 0C95 2D 20 70 6C 2548 0C99 65 61 73 65 2549 0C9D 20 73 74 61 2550 0CA1 6E 64 20 62 2551 0CA5 79 3A 20 00 2552 0CA9 4D 65 6D 6F romok: db 'Memory O.K.',c 2575 0CF8 4D 20 4D 65 2576 0CFC 6D 6F 72 79 2577 0D00 20 65 72 72 2578 0D04 6F 72 00 2579 0D07 07 07 52 41 rambad: db bell,bell,'RAM Memory error',0 2580 0D0B 4D 20 4D 65 2581 0D0F 6D 6F 72 79 2582 0D13 20 65 72 72 2583 0D17 6F 72 00 2584 0D1A readmsg: 2585 0D1A 07 07 0D 0A db bell,bell,cr,lf,'Read ',0 2586 0D1E 52 65 61 64 2587 0D22 20 00 2588 0D24 expctmsg: 2589 0D24 20 65 78 70 db ' expected ',0 2590 0D28 65 63 74 65 2591 0D2C 64 20 00 2592 0D2F 20 61 74 20 rammsg: db ' at RAM location ',0 2593 0D33 52 41 4D 20 2594 0D37 6C 6F 63 61 2595 0D3B 74 69 6F 6E 2596 0D3F 20 00 17 0D88 2D 50 6F 6C 2618 0D8C 65 20 70 61 2619 0D90 74 74 65 72 2620 0D94 6E 20 74 65 2621 0D98 73 74 0D 0A 2622 0D9C 33 29 20 43 db '3) Centronics port /',cr,lf 2623 0DA0 65 6E 74 72 2624 0DA4 6F 6E 69 63 2625 0DA8 73 20 70 6F 2626 0DAC 72 74 20 2F 2627 0DB0 0D 0A 2628 0DB2 34 29 20 4C db '4) Loop back on port 2',cr,lf 2629 0DB6 6F 6F 70 20 2630 0DBA 62 61 63 6B 2631 0DBE 20 6F 6E 20 2632 0DC2 70 6F 72 74 2633 0DC6 20 32 0D 0A 2634 0DCA 35 29 20 52 db '5) RAM test',cr,lf 2635 0DCE 41 4D 20 74 2636 0DD2 65 73 74 0D 2637 0DD6 0A 2638 0DD7 36 29 20 46 db '6) FDC R/W',cr,lf 2639 0DDB 44 43 20 52  so far.',0 2662 0E28 6F 72 73 20 2663 0E2C 73 6F 20 66 2664 0E30 61 72 2E 00 2665 0E34 loopmsg: 2666 0E34 6C 6F 6F 70 db 'loop test.',0 Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-60 2667 0E38 20 74 65 73 2668 0E3C 74 2E 00 2669 0E3F 0D 0A 46 61 failed: db cr,lf,'Failed ',0 2670 0E43 69 6C 65 64 2671 0E47 20 00 2672 0E49 0D 0A 50 61 passed: db cr,lf,'Passed ',0 2673 0E4D 73 73 65 64 2674 0E51 20 00 2675 0E53 45 6E 74 65 drvmsg: db 'Enter drive to test (A-D):',0 2676 0E57 72 20 64 72 2677 0E5B 69 76 65 20 2678 0E5F 74 6F 20 74 2679 0E63 65 73 74 20 2680 0E67 28 41 2D 44 2681 0E6B 29 3A 00 2597 0D41 diagmsg: 2598 0D41 0D 0A 44 69 db cr,lf,'Diagnostics Menu',cr,lf,lf 2599 0D45 61 67 6E 6F 2600 0D49 73 74 69 63 2601 0D4D 73 20 4D 65 2602 0D51 6E 75 0D 0A 2603 0D55 0A 2604 0D56 31 29 20 50 db '1) Port 1 \',cr,lf 2605 0D5A 6F 72 74 20 2606 0D5E 31 20 20 20 Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-59 2607 0D62 20 20 20 20 2608 0D66 20 20 20 5C 2609 0D6A 0D 0A 2610 0D6C 32 29 20 50 db '2) Port 2 > Barber-Pole pattern test',cr,lf 2611 0D70 6F 72 74 20 2612 0D74 32 20 20 20 2613 0D78 20 20 20 20 2614 0D7C 20 20 20 20 2615 0D80 3E 20 42 61 2616 0D84 72 62 65 72 26 2640 0DDF 2F 57 0D 0A 2641 0DE3 37 29 20 46 db '7) FDC seek test',cr,lf 2642 0DE7 44 43 20 73 2643 0DEB 65 65 6B 20 2644 0DEF 74 65 73 74 2645 0DF3 0D 0A 2646 0DF5 38 29 20 56 db '8) VFO test',cr,lf 2647 0DF9 46 4F 20 74 2648 0DFD 65 73 74 0D 2649 0E01 0A 2650 0E02 39 29 20 42 db '9) Boot',cr,lf,lf 2651 0E06 6F 6F 74 0D 2652 0E0A 0A 0A 2653 0E0C 45 6E 74 65 db 'Enter #:',0 2654 0E10 72 20 23 3A 2655 0E14 00 2656 0E15 passmsg: 2657 0E15 0D 0A 45 6E db cr,lf,'End of pass ',0 2658 0E19 64 20 6F 66 2659 0E1D 20 70 61 73 2660 0E21 73 20 00 2661 0E24 20 65 72 72 errnum: db ' errors2682 0E6E 0D 0A 49 6E insrt: db cr,lf,'Insert a formatted diskette in drive ',0 2683 0E72 73 65 72 74 2684 0E76 20 61 20 66 2685 0E7A 6F 72 6D 61 2686 0E7E 74 74 65 64 2687 0E82 20 64 69 73 2688 0E86 6B 65 74 74 2689 0E8A 65 20 69 6E 2690 0E8E 20 64 72 69 2691 0E92 76 65 20 00 2692 0E96 0D 0A 57 72 wrtmsg: db cr,lf,'Writing...',0 2693 0E9A 69 74 69 6E 2694 0E9E 67 2E 2E 2E 2695 0EA2 00 2696 0EA3 72 65 61 64 rdmsg: db 'reading',0 2697 0EA7 69 6E 67 00 2698 0EAB 0A0D CRLF: DW 0A0DH 2699 0EAD 00 DB 0 2700 2701 0EAE 3A A0 COLN: DC ': ' 2702 0EB0 00 DB 0 2703 00 RSECSZ: DW 0 2722 0EBF 0000 RSTADD: DW 0 2723 0EC1 0000 DW 0 2724 0EC3 0000 DW 0 2725 0EC5 00 DB 0 2726 0EC6 09 RCMDCT: DB 9 2727 0EC7 46 RCMDBF: DB 46H 2728 0EC8 00 DB 0 2729 0EC9 00 DB 0 2730 0ECA 00 DB 0 2731 0ECB 01 DB 1 2732 0ECC 03 DB 3 2733 0ECD 05 DB 5 2734 0ECE 1C DB 28 2735 0ECF FF DB 0FFH 2736 2737 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-62 2738 2739 001F IYOFF EQU $-ROMDATX 2740 ; 2741 0ED0  FF RCDSK: DB 0FFH 2763 0EE2 00 RPDSK: DB 0 2764 0EE3 00 RVDSK: DB 0 2765 ; 2766 0EE4 0000 RDMADR: DW 0 2767 0EE6 0175 ROUTP: DW CNOUT 2768 0EE8 0189 RINP: DW CNIN 2769 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-63 2770 2771 2772 ;---------------------------------------------------------------------- 2773 ; M-Tables 2774 ;--------- 2775 ; MTAB contains one 9 byte entry for each logical drive. 2776 ; The bytes of each entry are defined as follows: 2777 ; 2778 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-61 2704 2705 2706 ;---------------------------------------------------------------------- 2707 ;DATA TABLES 2708 ;----------- 2709 ; 2710 0EB1 ROMDATX: 2711 0EB1 00 RHSTDV: DB 0 2712 0EB2 00 RHSTTK: DB 0 2713 0EB3 01 RHSTSC: DB 1 2714 0EB4 01 RSECCT: DB 1 2715 0EB5 14 RRETRY: DB 20 2716 0EB6 FE00 RHSTBF: DW BOOTBF 2717 0EB8 00 RERFLG: DB 0 2718 0EB9 00 RPHYTK: DB 0 2719 0EBA 00 RPHYHD: DB 0 2720 0EBB 04E6 RIOADD: DW RDIO 2721 0EBD 00 ROMDATY: 2742 0ED0 00 RSEKDK: DB 0 2743 0ED1 00 RSEKTK: DB 0 2744 0ED2 00 RSEKSC: DB 0 2745 ; 2746 0ED3 00 RSEKHT: DB 0 2747 ; 2748 0ED4 00 RUNACT: DB 0 2749 0ED5 00 RUNADK: DB 0 2750 0ED6 00 RUNATK: DB 0 2751 0ED7 00 RUNASC: DB 0 2752 0ED8 00 RUNAMX: DB 0 2753 0ED9 00 RSECTK: DB 0 2754 ; 2755 0EDA 00 RWRTYP: DB 0 2756 0EDB 00 RDFLAG: DB 0 2757 0EDC 00 RTRSEC: DB 0 2758 ; 2759 0EDD 0000 RVMSGP: DW 0 2760 0EDF 0000 RVDRVP: DW 0 2761 ; 2762 0EE1 ; Byte 0 DSKDEF0: 2779 ; Bit 0-2 Motor control bit 2780 ; Bit 3-4 Double sided mode: 2781 ; 00=Even tracks on side 0, 2782 ; Odd tracks on side 1. 2783 ; 01=1st 40 (or 80) tracks 2784 ; on side 0, remaining 2785 ; tracks on side 1. 2786 ; 10=Both sides are treated 2787 ; as a single track with 2788 ; twice as many sectors. 2789 ; Bit 5-7 Unused. 2790 ; 2791 ; Byte 1 DSKDEF1: 2792 ; Bit 0-1 Physical drive address. 2793 ; Bit 2 Double sided drSRT/HUT 2810 ; Byte 5 = HLT/ND 2811 ; ND must be 1. 2812 ; 2813 ; Byte 6 EOT byte for FDC read or write commands. 2814 ; 2815 ; Byte 7 GPL byte for FDC read or write commands. 2816 ; 2817 ; Byte 8 Current track. 2818 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-64 2819 2820 2821 ; Drive 1 parameter table 2822 0EEA 01 RMTAB: DB 1 2823 0EEB D8 DB 0D8H 2824 0EEC 58 DB 88 2825 0EED 05 DB 5 2826 0EEE 6F DB 6FH 2827 0EEF H 2849 0F01 03 DB 3 2850 0F02 05 DB 5 2851 0F03 1C DB 28 2852 0F04 FF DB 0FFH 2853 2854 ; Drive 4 parameter table 2855 0F05 04 DB 4 2856 0F06 5B DB 5BH 2857 0F07 58 DB 88 2858 0F08 05 DB 5 2859 0F09 6F DB 6FH 2860 0F0A 03 DB 3 2861 0F0B 05 DB 5 2862 0F0C 1C DB 28 2863 0F0D FF DB 0FFH 2864 2865 page Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE 1-65 2866 2867 005D DATLNG EQU $-ROMDATX 2868 2869ive if = 1. 2794 ; Bit 3-4 Sector size: 2795 ; 00=128 2796 ; 01=256 2797 ; 10=512 2798 ; 11=1024. 2799 ; Bit 5 Tracks: 0=40; 1=80. 2800 ; Bit 6 Density: 0=single; 1=double. 2801 ; Bit 7 Virtual drive: 1=virtual. 2802 ; 2803 ; Byte 2 Motor on wait time in increments of 4 ms. 2804 ; 2805 ; Byte 3 Head settle time (after seek) in increments 2806 ; of 4 ms. 2807 ; 2808 ; Byte 4-5 The two parameter bytes for the FDC specify 2809 ; command: Byte 4 =  03 DB 3 2828 0EF0 05 DB 5 2829 0EF1 1C DB 28 2830 0EF2 FF DB 0FFH 2831 2832 ; Drive 2 parameter table 2833 0EF3 02 DB 2 2834 0EF4 59 DB 59H 2835 0EF5 58 DB 88 2836 0EF6 05 DB 5 2837 0EF7 6F DB 6FH 2838 0EF8 03 DB 3 2839 0EF9 05 DB 5 2840 0EFA 1C DB 28 2841 0EFB FF DB 0FFH 2842 2843 ; Drive 3 parameter table 2844 0EFC 04 DB 4 2845 0EFD 5A DB 5AH 2846 0EFE 58 DB 88 2847 0EFF 05 DB 5 2848 0F00 6F DB 6F  0F0E 0B4C ETAB: DW WPM 2870 0F10 0B3F DW SKM 2871 0F12 0B5D DW CRM 2872 0F14 0B5D DW CRM 2873 0F16 0B69 DW URM 2874 0F18 0B7F DW NRM 2875 0F1A 0B74 DW SYM 2876 0F1C 0B7F DW EQM 2877 0F1E 0B90 DW ICM 2878 0F20 0BA1 DW UNM 2879 2880 0F22 DS (ROM+0FFFH-$),0FFH 2881 2882 END Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE S Macros: Symbols: 014A ABOOT 01AB ACKLP 01B8 ACKOK 0040 ACKTIME 024E ALLOC 0030 ASC0 0041 ASCA 0049 ASCI 0052 ASCR 0001 BCE 0007 BELL FFFD BGNCHAR  000B DFLAG 0A3D DIAGBOOT 0D41 DIAGMSG 0801 DIAGNOSE 0453 DILP 0456 DIO 0392 DISCIO FC00 DISKBUF 0397 DLOP 0014 DMAADR 0BB0 DMESG 05BE DOUBLE 0000 DOUT 03F5 DRET 03F4 DRET1 0947 DRVLP 0E53 DRVMSG 0002 DSB FC00 DSKBUF 083B DSPTCH 001E DTL 071C ECODE 0462 EDSP 0007 EN FD00 ENDBLK 001C EOT 0005 EOTOF 0004 EQ 0B7F EQM 04BC ERET 0007 ERFLAG 04A9 ERLP FC7B ERR 0E24 ERRNUM FFFD ERRORS 04A3 ERSP 0F0E ETAB 0005 EXB 0511 EXDN 0020 EXEC 089B EXITOUT 0D24 EXPCTMSG 0E3F FAILED 0016 FDCCMD 00FB FDCDATA 0 MD 00BC MEMERR 08D6 MEMLP FFFE MEMPASS FC2A MEMTEST FFFF MEMTOP 00C0 MERR 01C3 MESG 05DB MLOOP 00F7 MOTOR 00E9 MOVE 0007 MRQ 08C3 MSGOUT 001A MTAB 08CD MTEST 0597 MTOK 00F5 MTRCHK 0003 MTRMSK 0007 MTRMSK1 001B N 0002 ND Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE S-1 0005 NFERR 013B NODSK 08E5 NOERR 02AE NOMTCH 0248 NOOVF 05F6 NOT0 0829 NOTBP 0003 NR 069C NRDY 0B7F NRM 03E4 NRTRY 035D NSTD 0409 NTFND 0006 NTRDY FCCB NUM 05B6 NVIRT 09ED NXTRNG 0004 ORE FCC4 OUTASC FCB3 OUTBYTE 01CC OUTCN  0974 BLDBUF 0A3F BLOCK 011A BLOP 0103 BOOT FE00 BOOTBF 0CB8 BOOTMSG 084D BPOLE 0157 BTER 0BFB BTERR 0110 BTOK 00CA BUFCHK 00F4 CDATA 0011 CDSK 0898 CENT 0198 CENTOUT FC54 CHECK 00DE CHK 018C CHKSTATI 017A CHKSTATO 00DC CHKSUM 0215 CHKUNA 04C9 CINY 08EE CLRERR 01BC CLRLP 01BA CLRMSG 0006 CM 0015 CMDCNT 0189 CNIN 0175 CNOUT 056A CNT 01DD CNTJP 0EAE COLN 0018 CONIN 0016 CONOUT 000D CR 0EAB CRLF 0B5D CRM 00F5 CSTAT 0018 CY 005D DATLNG 049D DCRLF 0005 DD 0006 DEN 0040 DENMSK 0005 DER  00FA FDCSTAT 02B8 FILHST FC46 FILL 0642 GDSK 001D GPL 03AF GSTLP 0653 GTRK 0019 HD 06D3 HD0 0000 HMBT 060F HMCHK 057F HMOK 057A HMSK 0570 HOME 0000 HSTACT 0005 HSTBUF 0000 HSTDSK 0002 HSTSEC 0001 HSTTRK 0001 HSTWRT 0B90 ICM 0007 IER 0123 ILOP1 012E ILOP2 08F6 INCERR FC72 INDJP 06B5 INFDC 0085 INITCTC 0053 INITUART 0807 INLP 0E6E INSRT 000A IOADD 0319 IOHST 001F IYOFF 089E KEYSTAT 000A LF 0141 LOOP 08A3 LOOPBK 08C0 LOOPERR 08BB LOOPGD 0E34 LOOPMSG 08A6 LOOPTST FC62 LP 0000 MA 02D8 MATCH 000  06AC OUTFDC FC8A OUTHL 0858 OUTLP FC4D OVER FC50 PASS 0E49 PASSED 0E15 PASSMSG AA5F PAT1 6DB6 PAT2 FCD2 PATLST 0012 PDSK 0009 PHYHD 0008 PHYTRK 0496 PLOP FFFE PORT 088F PORT2 0013 PR40 0027 PR80 0002 PREC 0852 PRNTLP 08FE PRNTPASS 001A R 0D07 RAMBAD 0082 RAMCHK FF00 RAMDAT 00D4 RAMERR 0D2F RAMMSG 0EE1 RCDSK 0EC7 RCMDBF 0EC6 RCMDCT 0040 RD 09AC RDBUF 0006 RDCMD 0EDB RDFLAG 0301 RDHST 04E6 RDIO 01DE RDLSEC 0EE4 RDMADR FC76 RDMEM 0EA3 RDMSG 00F0 RDRDY 04EC RDSC 069F RDY 0D1A READMSG 0003 READOP  0ED6 RUNATK 0EDF RVDRVP 0EE3 RVDSK 0EDD RVMSGP 0932 RWLOOP 0256 RWOPER 0EDA RWRTYP 0921 RWTEST 027D S1024 0283 S128 00FC S1DATA 00FD S1STAT 0281 S256 00FE S2DATA 00FF S2STAT 027F S512 05BA SAME 0004 SDSTAT 0003 SECCNT 000C SECSIZ 0009 SECTRK 06BE SEEK 09DF SEEKLP 09C9 SEEKTEST 0008 SEKBT 0000 SEKDSK 0003 SEKHST 0002 SEKSEC 0001 SEKTRK 0585 SELHM 0583 SELSK 0185 SER2IN 0171 SER2OUT 018B SERIN 0177 SEROUT 093E SETUP 0866 SHIFT 0008 SICMD 0C37 SIGNON 05CD SINGLE 06F8 SINT 070F SINTR 0018 SIZMSK 05F9 SK0 0007 SKCMD 0 0B69 URM 0007 VD 000F VDRVP 0013 VDSK 0A30 VFOADJ 0A1A VFOTEST 062F VIRT 0493 VIRTM 000D VMSGP 05FF VSKP 065B WAIT 068F WAIT1 067B WAIT2 0047 WARM 0004 WC 052E WLOOP1 054C WLOOP2 0547 WLOOP3 0670 WLOP1 067D WLOP2 0690 WLOP3 03FA WNGTRK 0001 WP 0001 WPERR 0B4C WPM 0000 WR 0000 WRALL 0005 WRCMD 0001 WRDIR 053D WRIO FC74 WRMEM 00B0 WRRDY 0543 WRSC 099B WRTBUF 030E WRTHST 01F1 WRTLSEC 0E96 WRTMSG 000A WRTYPE 0002 WRUAL 015D XFRDATA No Fatal error(s) ABOOT 498 504# ACKLP 605# 611 ACKOK 607 614# ACKTIME 5 0EB8 RERFLG 0C1B RERR 0BC7 RESM 0004 RETRY 0024 REV 0022 REVCMP1 0013 REVCMPT 0EB6 RHSTBF 0EB1 RHSTDV 0EB3 RHSTSC 0EB2 RHSTTK 0EE8 RINP 0EBB RIOADD 04D7 RLOOP1 04F5 RLOOP2 04F0 RLOOP3 0EEA RMTAB 0000 ROM 0081 ROMCHK 00F6 ROMCTL 0EB1 ROMDATX 0ED0 ROMDATY 0CF4 ROMMSG 0CA9 ROMOK 00AA ROMTST 0EE6 ROUTP 0EE2 RPDSK 0EBA RPHYHD 0EB9 RPHYTK 0EB5 RRETRY 0EB4 RSECCT 0EBD RSECSZ 0ED9 RSECTK 0ED0 RSEKDK 0ED3 RSEKHT 0ED2 RSEKSC 0ED1 RSEKTK 0002 RSFLAG 0EBF RSTADD 0CDE RTRNMSG 0EDC RTRSEC 0ED4 RUNACT 0ED5 RUNADK 0ED8 RUNAMX 0ED7 RUNASC 002 SKERR 0681 SKINT 0B3F SKM 03B6 SKST FD00 SMEM 0003 SPCMD 06E1 SPECFY 06EF SPLP 036B SSIDE 000E STADD 0026 START 0430 STATLP FC00 STBLK 0007 STCNT 0422 STRTIO 034E STSIZ 09F3 SWAPBC 0B74 SYM 00F7 TC FC0E TEST FC32 TESTLP FC58 TESTM 0880 TESTOUT 0005 TK80 Micro Decision ROM Source (Rev 2.4 - 1_Aug_83) MACRO-80 3.44 09-Dec-81 PAGE S-2 0524 TMLP 0513 TMOUT 02FB TMPBC 0413 TRCK3 0010 TRK0MSK 05C6 TRK40 0007 TROFF 000C TRSEC 8000 TSTBUF 09C0 TSTERR 0C85 TSTMSG 09FD TSTSEEK 0004 UNACNT 0005 UNADSK 0008 UNAMAX 0007 UNASEC 0006 UNATRK 0BA1 UNM !90# 603 ALLOC 703 710 714 718 733# ASC0 435# 2529 2529 ASCA 436# 1106 1143 ASCI 437# 1150 ASCR 438# 1147 BCE 1711# 1730 BELL 63# 2572 2574 2574 2579 2579 2585 2585 BGNCHAR 51# 1849 1852 1866 1869 BLDBUF 1999 2051# BLOCK 164 302 2216# BLOP 479# 480 BOOT 125 467# BOOTBF 458# 508 2716 BOOTMSG 499 2556# BPOLE 1827 1828 1829 1848# 1868 BTER 78 509# BTERR 509 2504# BTOK 471 473# BUFCHK 116 251# CDATA 59# 598 CDSK 369# 1351 1353 CENT 1892 1895# CENTOUT 80 592# 595 1895 CHECK 2268 2277# CHK 281# 288 CHKSTATI 567# 570 CHKSTATO 550# 553 CHKSUM 219 254 279# CHKUNA 687 701# CINY 501 1131 1140 1165# 1797 2019 2034 CLRERR 1946 1958# 2000 2127 CLRLP 628# 630 CLRMSG 113 627# CM 1717# 1751 CMDCNT 405# 406 407 408 409 410 411 412 413 871 1047 CNIN 565# 2768 CNOUT 544# 1889 2767 CNT 977 1013 1027 1306# CNT6 1826# DTL 413# 895 ECODE 970 1725# EDSP 1002 1091# EN 1714# 1745 ENDBLK 304 307 2424# EOT 411# 931 EOTOF 414# 927 EQ 1721# 1765 EQM 2466# 2876 ERET 1145 1148 1153# ERFLAG 396# 506 742 998 1009 1117 2085 2100 2106 2173 2178 2199 ERLP 1140# 1151 ERR 2307 2310# ERRNUM 1979 2661# ERRORS 53# 1960 1963 1965 1977 ERSP 1119 1138# ETAB 1095 2869# EXB 441# 1084 1244 EXDN 1182 1208 1223# 1255 1284 EXEC 449# 1181 1207 1254 1283 EXITOUT 1890 1894 1896# EXPCTMSG 2338 2588# FAILED 1930 2669# FDCCMD 406# 870 925 FDCDATA 325# 1044 1449 1454 1457 1620 1627 1633 1642 1650 1665 1667 1673 FDCSTAT 324# 1083 1184 1193 1206 1243 1257 1266 1282 1585 1588 1597 1607 FILHST 777 797# FILL 2267 2270# GDSK 744 864 1341 1489# GPL 412# 935 GSTLP 960# 962 GTRK 1408 1509# HD 408# 913 HD0 1625 1627# HMBT 416# 1324 HMCHK 1435 1447# HMOK 504 991 LOOPTST 1915# 1926 LP 2287# 2294 2298 MA 1716# 1749 MATCH 789 810# MD 1718# 1753 MEMERR 223 233# 258 510 MEMLP 1947# 1955 MEMPASS 52# 1959 1971 1973 MEMTEST 1949 2231 2254# MEMTOP 49# 50 51 52 53 MERR 448# 967 MESG 71 222 237 257 500 503 636# 641 1104 1111 1115 1130 1136 1139 1157 1796 1805 1931 1933 1945 1970 1976 1980 2018 2028 2033 2036 2084 2099 2228 2235 2333 2339 2344 MLOOP 1400# 1401 MOTOR 326# 483 1237 1404 1533 1548 MOVE 115 301# MRQ 440# 1074 MSGOUT 1928 1931# MTAB 378# 1491 MTEST 1831 1944# MTOK 1345 1347# MTRCHK 327# 488 495 1389 MTRMSK 443# 469 475 1390 1396 1452 1622 MTRMSK1 444# 1343 N 410# 878 ND 1715# 1747 NFERR 430# 983 NODSK 487 494 499# NOERR 1951 1953# NOMTCH 781 785 791# NOOVF 725 730# NOT0 1414 1418# NOTBP 1809 1811# NR 1719# 1757 NRDY 1584# 1587 NRM 2460# 2466 2874 NRTRY JP 652 661# 1169 1824 COLN 1110 1975 2701# CONIN 376# 1167 1168 CONOUT 375# 650 651 CR 61# 1862 2522 2529 2541 2554 2585 2598 2602 2608 2621 2626 2633 2636 2640 2644 2648 2651 2657 2669 2672 2682 2692 CRLF 502 1135 1156 1804 2035 2698# CRM 2445# 2871 2872 CSTAT 60# 593 600 602 605 CY 407# 919 DATLNG 521 2867# DCRLF 1135# DD 1713# 1737 DEN 335# 1373 DENMSK 340# 868 DER 1722# 1741 DFLAG 363# 671 672 682 730 734 775 776 792 804 809 827 830 1317 1319 DIAGBOOT 1835 2208# DIAGMSG 1795 2597# DIAGNOSE 124 1794# 1825 DILP 1074# 1085 DIO 951 1083# DISCIO 75 505 940# 1006 DISKBUF 48# 252 303 1948 2217 2230 DLOP 944# 993 DMAADR 373# 824 825 DMESG 1103 2480# DOUBLE 1376# DOUT 433# 1088 DRET 1000 1003 1009# DRET1 968 1007# DRVLP 2019# 2022 2024 DRVMSG 2017 2675# DSB 336# 904 DSKBUF 457# 458 459 DSPTCH 181 1016 1036 1324# HMSK 1318 1320# HOME 72 1317# HSTACT 343# 775 776 1319 HSTBUF 394# 821 822 1069 1070 2071 2072 2124 2125 2197 2198 HSTDSK 383# 780 798 863 1107 1338 2025 2194 HSTSEC 385# 788 802 907 HSTTRK 384# 784 800 906 1997 2172 2177 2195 HSTWRT 344# 792 809 830 1317 ICM 2468# 2877 IER 1723# 1769 ILOP1 484# 490 ILOP2 491# 497 INCERR 1952 1963# 2108 INDJP 2287 2300# INFDC 960 1456 1607# 1610 1666 1672 INITCTC 110 181# INITUART 111 137# INLP 1797# 1799 1801 INSRT 2027 2682# IOADD 392# 841 842 852 853 1064 1065 IOHST 845 863# IYOFF 525 2739# KEYSTAT 1860 1900# 1922 1954 2003 2132 2201 LF 62# 628 1864 2529 2541 2541 2554 2555 2585 2598 2602 2602 2609 2621 2627 2633 2636 2640 2645 2648 2651 2652 2657 2669 2672 2682 2692 LOOP 501# LOOPBK 1830 1913# LOOPERR 1921 1929# LOOPGD 1923 1927# LOOPMSG 1932 2665# ! 973 998# NSTD 898 903# NTFND 985 1023# NTRDY 431# 975 NUM 2380 2382# NVIRT 1357 1370# NXTRNG 2131 2146# 2158 ORE 1720# 1761 OUTASC 2364 2367 2378# OUTBYTE 1974 1978 2337 2342 2346 2348 2357# OUTCN 629 639 646# 1108 1155 1803 2031 2384 OUTFDC 1054 1447 1451 1597# 1600 1617 1621 1631 1648 1652 1663 OUTHL 2313 2330# OUTLP 1853# 1857 1859 OVER 2269 2272# PASS 2261 2274# PASSED 1927 2672# PASSMSG 1969 2656# PAT1 2047# 2051 PAT2 2048# 2062 PATLST 2257 2399# PDSK 370# 1238 1405 1532 PHYHD 401# 916 924 1626 PHYTRK 400# 918 1017 1023 1031 1035 1381 1409 1632 PLOP 1131# 1133 PORT 50# 1810 1886 PORT2 1888 1891# PR40 453# 1376 PR80 454# 1380 PREC 447# 1384 PRNTLP 1850# 1870 PRNTPASS 1953 1968# 2103 2155 R 409# 920 RAMBAD 256 2579# RAMCHK 163# 313 RAMDAT 459# 520 524 525 RAMERR 256# 2233 RAMMSG 2343 2592# RCDSK 2762# RCMDBF 2727# RCMDSK 2763# RPHYHD 2719# RPHYTK 2718# RRETRY 2715# RSECCT 2714# RSECSZ 2721# RSECTK 2753# RSEKDK 2742# RSEKHT 2746# RSEKSC 2744# RSEKTK 2743# RSFLAG 345# 672 730 734 804 RSTADD 2722# RTRNMSG 2032 2567# RTRSEC 2757# RUNACT 2748# RUNADK 2749# RUNAMX 2752# RUNASC 2751# RUNATK 2750# RVDRVP 2760# RVDSK 2764# RVMSGP 2759# RWLOOP 2001# 2004 RWOPER 675 731 742# RWRTYP 2755# RWTEST 1832 1996# S1024 765# S128 754 768# S1DATA 55# 121 S1STAT 56# 139 141 144 147 150 544 565 1901 S256 758 767# S2DATA 57# 1913 S2STAT 58# 140 142 145 148 151 541 562 S512 762 766# SAME 1352 1373# SDSTAT 418# 1448 SECCNT 390# 1061 1998 2126 2196 SECSIZ 389# 897 900 901 1058 1059 SECTRK 360# 723 SEEK 1421 1461 1617# SEEKLP 2128# 2133 SEEKTEST 1833 2120# SEKBT 424# 1333 SEKDSK 349# 692 708 743 779 797 SEKHST 353# 769 787 801 SEKSEC 351# 698 38# 1377 TMLP 1243# 1245 TMOUT 1191 1232# 1264 TMPBC 1642# 1651 TRCK3 1021 1030# TRK0MSK 445# 1458 TRK40 1378 1381# TROFF 379# 1510 1683 TRSEC 364# 773 810 TSTBUF 2049# 2052 2054 TSTERR 2087 2102 2106# 2175 2180 TSTMSG 1944 2227 2543# TSTSEEK 2129 2170# UNACNT 355# 669 690 701 706 733 UNADSK 356# 693 709 UNAMAX 359# 689 UNASEC 358# 699 717 721 724 728 UNATRK 357# 696 713 727 UNM 2474# 2878 URM 2450# 2873 VD 337# 1354 VDRVP 367# 1475 1476 VDSK 371# 1359 1360 VFOADJ 2199# 2202 VFOTEST 1834 2191# VIRT 1365 1472# VIRTM 1130# 1481 VMSGP 366# 1478 1479 VSKP 1419 1426# WAIT 1430 1465 1531# WAIT1 1537 1567# WAIT2 1542 1552# WARM 121# 235 2225 2236 WC 1712# 1733 WLOOP1 1254# 1268 WLOOP2 1277 1280# 1287 WLOOP3 1275# 1290 1295 WLOP1 1544# 1550 WLOP2 1547 1554# 1555 WLOP3 1563 1566 1569# 1575 WNGTRK 981 1013# WP 1710# 1726 WPERR 42CT 2726# RD 65# 2402 2403 2404 2408 2409 2410 2414 2416 2418 2419 2420 RDBUF 2002 2098# RDCMD 420# 844 RDFLAG 2756# RDHST 73 805 840# 2101 2174 2179 2200 RDIO 76 840 1193# 2720 RDLSEC 81 669# RDMADR 2766# RDMEM 2277 2305# RDMSG 2098 2696# RDRDY 450# 1185 1194 RDSC 1186 1197# RDY 1053 1585# 1590 READMSG 2332 2584# READOP 346# 671 682 827 RERFLG 2717# RERR 236 2513# RESM 1138 2488# RETRY 387# 940 987 REV 13# 1782 2529 2529 REVCMP1 12# 1781 REVCMPT 11# 1780 RHSTBF 2716# RHSTDV 2711# RHSTSC 2713# RHSTTK 2712# RINP 2768# RIOADD 2720# RLOOP1 1181# 1195 RLOOP2 1202 1204# 1211 RLOOP3 1200# 1213 1217 RMTAB 468 474 2822# ROM 45# 46 159 1540 1775 2880 ROMCHK 162# ROMCTL 54# 2220 2223 2255 2275 2310 2334 2336 ROMDATX 79 519 2710# 2739 2867 ROMDATY 109 2741# ROMMSG 221 2574# ROMOK 2234 2552# ROMTST 114 216# ROUTP 2767# RPD 716 747 SEKTRK 350# 695 712 783 799 1320 SELHM 1325 1334# SELSK 947 1032 1333# SER2IN 561# 1919 SER2OUT 540# 1893 1918 SERIN 563 566# SEROUT 542 546# SETUP 1996 2016# 2121 SHIFT 1855 1860# SICMD 422# 1664 SIGNON 112 2522# SINGLE 1374 1382 1389# SINT 1584 1663# 1680 SINTR 1560 1680# SIZMSK 339# 750 873 SK0 1411 1416 1421# SKCMD 421# 1618 SKERR 429# 979 SKINT 160 1557# SKM 2434# 2870 SKST 964# SMEM 2256 2278 2423# SPCMD 417# 1649 SPECFY 1370 1644# SPLP 1652# 1654 SSIDE 909 913# STADD 398# 958 966 1726 1730 1733 1737 1741 1745 1747 1749 1751 1753 1757 1761 1765 1769 START 70 107# STATLP 1054# 1056 STBLK 118 304 307 2219# STCNT 425# 954 STRTIO 950 1044# STSIZ 883 888 892 895# SWAPBC 2148 2151# SYM 2455# 2875 TC 328# 1220 1300 TEST 2224 2227# TESTLP 2258# 2273 TESTM 2271 2278# TESTOUT 1853 1863 1865 1882# TK80 3"8# 971 WPM 2439# 2869 WR 64# 2399 2400 2401 2405 2406 2407 2411 2412 2413 2415 2417 WRALL 330# WRCMD 419# 855 WRDIR 331# WRIO 77 851 1266# WRMEM 2270 2302# WRRDY 451# 1258 1267 WRSC 1259 1270# WRTBUF 2001 2083# WRTHST 74 793 851# 2086 WRTLSEC 82 681# WRTMSG 2083 2692# WRTYPE 362# 674 683 WRUAL 332# 674 686 XFRDATA 467 518# 2016 2192  WLOP3 1563 1566 1569# 1575 WNGTRK 981 1013# WP 1710# 1726 WPERR 42VD 337# 1354 VDRVP 367# 1475 1476 VDSK 371# 1359 1360 VFOADJ 2199# 2202 VFOTEST 1834 2191# VIRT 1365 1472# VIRTM 1130# 1481 VMSGP 366# 1478 1479 VSKP 1419 1426# WAIT 1430 1465 1531# WAIT1 1537 1567# WAIT2 1542 1552# WARM 121# 235 2225 2236 WC 1712# 1733 WLOOP1 1254# 1268 WLOOP2 1277 1280# 1287 WLOOP3 1275# 1290 1295 WLOP1 1544# 1550 WLOP2 1547 1554# 1555 WLOP3 1563 1566 1569# 1575 WNGTRK 981 1013# WP 1710# 1726 WPERR 42ß INDEX Version 3.0, Copyright (C) 1981, F. J. Greeb $1RPFBSTW=PV7MsUTH!< Ϳ ʁ q ###"< ^#V*< ~/w˜!9"F 1  !~ʸO#~ # ʸùy%~/ # ʸ~g!# ʸ~/ ʹ4# ~-ʏ>2 > y ͘~ /_*> # + 4# ͟ { 2W4# ͟ {2L >?2 2 9 Ϳ  Y 2  !;# ¿2       #~+:%~Ϳ A2 ## ʸ~*3# nø > ͘ ~Ϳ .n*c>?͘# ʸ~.nU# ʸB~.­# ʸ~*ʸ > ͘ ~Ϳ *Ÿ>?͘ø# ʸŽø   :WG<* " !:K&>,&"8 :K}!= = * " ! ": 2H :?5 : K:?R:H R<=_ ͂o*:  ":  ͂bƀ_: ʜ:L :Oª! ~*: 6# ~# ¶6* #" :S! 6- >?͘͘   ̈́ 2@ *2 ##"2 ++^#V* } +" k :K8  k *8 :@ <2@  ̈́ :@ O:> e e +) :Cv ^#v :Cʏ $_Ï ~ /0:?0W{_# ¡ a{  :C  ̈́ :H _*F INVALID FILE NAME $INVALID OPTION IGNORED $ $FILE ERROR DURING MODIFY $MODIFY FILE, CONFIRM (Y/N)? $ DIRECTORY - DRIVE $ FILES ( ENTRIES) K USED K FREE $ $W INDEX COM????????????Command format is INDEX /OPTION1/OPTION2 DRV:FILENAME.TYP Valid options are: R - Reset disk system before doing the index P - Direct out to printer rather than console F - Output a leading form feed B - Set brief mode, file sizes not reported S - Incluƀo&"D 2S }-##F#N#~#^#VA*..21 x20 y2/  O2. #"4 g)]", ! ": * }R+*: 6+6+~Ě*:  ": sO:1 ! ¨*:  N#F r+s*:  6 * "> *: *> }G+">  =# ! V:1 =!^#V:1  !! = N r+s*: 6* +" ! *:  6** )))))@ "2 * * "I " "> *2   ˜*> }+"> ʞs#r# * }+}"> "B *2 "@ 2K *@ ^#V#"@ ~#fo *@ ^#V++Fr+Ns##q#p2K # *> +"> }¼:K *B +}"> "B ²!"6 * "> !  ~*2S*> }+"> X~*H6 #6 #6 ###6K'* "> ! "@ *@ ~½*> }+"> *@ ^6 #V6 +++:0 OCzW{_ Ž:/ =ʢ:. ʱ)å*6 "6 *@  "@ d2K :K >0>0 <0 :K >02K x/Gy/O *  *I  *6  : o:S^y *D  ~# L > ͘o: i:H <=A2 _P*4 +|g}o |#DM!Қ • G:. ʴ)ê|/g}/o#*,  :G ̈́ * ̈́ *8 * _}2> "de system files in directory W - Set output width (32 to 255) T - Use following characters for title T- uses catalog disk name for title M - Modify any of the above options to the default V - Report version number U - Set user number for directory H - Print this help message For example, the command INDEX /B/R/S/M B:*.COM will set the brief mode, do a disk reset, and report all COM files on drive B, including system files (/S option). The /M sets these options as the default characteristics. See the documentation for full descriptions of the options. Hit any key to continue ... $ ON2 DRV:FILENAME.TYP Valid options are: R - Reset disk system before doing the index P - Direct out to printer rather than console F - Output a leading form feed B - Set brief mode, file sizes not reported S - Inclu##$$%%&&''