Pascal [Rev 3.0M 6/ 4/84] DUMBO.TEXT 28-Jun-89 17:44:30 Page 1 1:D 0 (* sccs info: @(#) dumbo 8.1 84/05/04 00:17:01 *) 2:S 3:D 0 $modcal, debug off, range off, ovflcheck off, stackcheck off, callabs off$ 4:S 5:D 0 $search 'MISCASM', 'BRDECS', 'SR', 'GPIO'$ 6:S 7:D 0 (***************************************************************************) 8:D 0 (* *) 9:D 0 (* **** * * * * **** *** *) 10:D 0 (* * * * * ** ** * * * * *) 11:D 0 (* * * * * * * * * * * * *) 12:D 0 (* * * * * * * * **** * * *) 13:D 0 (* * * * * * * * * * * *) 14:D 0 (* * * * * * * * * * * *) 15:D 0 (* **** *** * * **** *** *) 16:D 0 (* *) 17:D 0 (***************************************************************************) 18:S 19:D 0 module ddDUMBO; 20:S 21:D 1 import 22:D 1 miscasm, brdecs, sr, gp; 23:S 24:D 1 export 25:D 1 function controllersID(cardID: unsgn8; HPIBident: signed16): boolean; 26:D 1 procedure setdevicename(var device_name: string255); 27:D 1 procedure controller_init; 28:D 1 procedure unit_init; 29:D 1 procedure deviceread(bufptr: anyptr; length, start_addr: integer); 30:S 31:D 1 implement {ddDUMBO} 32:S 33:D 1 const 34:D 1 maxtries = 10; 35:D 1 password = -20857; 36:S 37:D 1 type 38:D 1 gptr_type = ^gpiotype; 39:S 40:D 1 errors = (noerror, nopower, dooropen, nodisc, badcommand, norecord, 41:D 1 notrack, badcheckword, dataoverrun, badverify); 42:S 43:D 1 primarycommands = (readblock, verifyblock, writeblock, settracksector); 44:S 45:D 1 fd = {floppy disc command & status structure} 46:D 1 packed record case integer of 47:D 1 -1: (w: signed16); 48:D 1 0: (case primary: primarycommands of 49:D 1 readblock, verifyblock, writeblock: 50:D 1 (drv: 0..3; nrecords: 0..4095); 51:D 1 settracksector: 52:D 1 (driv: 0..3; track: 0..127; sector: 0..31)); 53:D 1 1: (pad: 0..15; errcode: errors; p2, transfercomplete, 54:D 1 seekcomplete, notready, writeprotected, dooropened: boolean; 55:D 1 drve: 0..3); 56:D 1 end; Pascal [Rev 3.0M 6/ 4/84] DUMBO.TEXT 28-Jun-89 17:44:30 Page 2 57:D 1 $page$ 58:S 59:D 1 function controllersID(cardID: unsgn8; HPIBident: signed16): boolean; 60:C 2 begin {controllersID} 61:C 2 if cardID=hp98622 then 62:C 3 with gptr_type(cardADR)^ do 63:C 4 controllersID := (not sti1) and (not sti0) and (intlevel in [1,2]) 64:C 4 else 65:C 3 controllersID := false; 66:C 2 end; {controllersID} 67:S 68:S 69:D 1 procedure setdevicename(var device_name: string255); 70:C 2 begin {setdevicename} 71:C 2 device_name := 'HP9885'; 72:C 2 end; {setdevicename} 73:S 74:S 75:D 1 function status(var gpio: gpiotype; unit: unsgn8): fd; 76:D 2 const 77:D 2 request_status = fd 78:D 2 [ primary: settracksector, driv: 0, track: 127, sector: 31 ]; 79:D 2 var 80:D -2 2 opcode: fd; 81:C 2 begin {status} 82:C 2 gpiowordout(gpio, password); {issue password} 83:C 2 opcode := request_status; 84:C 2 opcode.driv := unit; 85:C 2 gpiowordout(gpio, opcode.w); {issue request status command} 86:C 2 gpiowordout(gpio, 0); {clear output regs & request data word} 87:C 2 status.w := gpiowordin(gpio); 88:C 2 end; {status} 89:S 90:S 91:D 1 procedure controller_init; 92:D 2 var 93:D -4 2 gptr: gptr_type; 94:D -6 2 status_word: fd; 95:C 2 begin {controller_init} 96:C 2 gptr := cardADR; 97:C 2 if gptr^.psts or not gptr^.ready then 98:C 3 escape(ec_no_device); {9885 uses opposite psts logic sense} 99:C 2 gpioclear(gptr^); 100:C 2 if gptr^.psts or not gptr^.ready then 101:C 3 escape(ec_no_device); {9885 uses opposite psts logic sense} 102:C 2 status_word := status(gptr^, 3); {don't destroy other units' disc changed bit!} 103:C 2 with status_word do {validate it} 104:C 3 if (pad<>0) or not(errcode in [noerror..nodisc]) or p2 or (drve<>3) then 105:C 4 begin {Whoops! It must not be a 9885!!!} 106:C 4 gpioclear(gptr^); 107:C 4 escape(ec_no_device); 108:C 4 end; {then} 109:C 2 end; {controller_init} Pascal [Rev 3.0M 6/ 4/84] DUMBO.TEXT 28-Jun-89 17:44:30 Page 3 110:D 1 $page$ 111:S 112:D 1 procedure unit_init; 113:D 2 var 114:D -4 2 gptr: gptr_type; 115:D -8 2 opcode, status_word: fd; 116:C 2 begin {unit_init} 117:C 2 with f_area^ do 118:C 3 begin 119:C 3 if not controllersID(cardID, -1) 120:C 4 or (m_msus.un>3) {trick: interprets vn/un byte as a single number!!!} 121:C 4 or not booleans.dma_p then 122:C 4 escape(ec_no_device); 123:C 3 gptr := cardADR; 124:C 3 gptr^.r3 := 0; {setup gpio card} 125:C 3 gptr^.r7 := 0; 126:C 3 status_word := status(gptr^, m_msus.un); 127:C 3 with status_word do {check for "drive not present"} 128:C 4 if (errcode=nodisc) {"drive not present" or "door closed with no medium"} 129:C 5 and not dooropened then {differentiates above two cases if first access after reset} 130:C 5 escape(ec_no_device); 131:C 3 end; {with} 132:C 2 end; {unit_init} 133:S 134:S 135:D 1 procedure deviceread(bufptr: anyptr; length, start_addr: integer); 136:D 2 var 137:D -4 2 gptr: gptr_type; 138:D -8 2 status_word, opcode: fd; 139:D -14 2 tries, records, dummy: signed16; 140:D -18 2 transfers: integer; 141:D 2 procedure clear_and_escape(ec_value: signed16); 142:C 3 begin {clear_and_escape} 143:C 3 gpioclear(gptr^); 144:C 3 escape(ec_value); 145:C 3 end; {clear_and_escape} 146:C 2 begin {deviceread} 147:C 2 gptr := cardADR; 148:C 2 length := (length+1) div 2; {convert to number of 16 bit words} 149:C 2 tries := 0; 150:C 2 while length>0 do 151:C 3 begin 152:C 3 try 153:C 4 gpiowordout(gptr^, password); 154:C 4 opcode.primary := settracksector; 155:C 4 opcode.driv := f_area^.m_msus.un; 156:C 4 opcode.track := start_addr div 30; 157:C 4 opcode.sector := start_addr mod 30; 158:C 4 gpiowordout(gptr^, opcode.w); 159:S 160:C 4 if length<=65536 161:C 5 then transfers := length 162:C 5 else transfers := 65536; 163:C 4 records := (transfers+127) div 128; 164:S 165:C 4 gpiowordout(gptr^, password); 166:C 4 opcode.primary := readblock; 167:C 4 {opcode.driv already assigned above} 168:C 4 opcode.nrecords:= records; 169:S Pascal [Rev 3.0M 6/ 4/84] DUMBO.TEXT 28-Jun-89 17:44:30 Page 4 170:C 4 gpiodmain(gptr^, opcode.w, bufptr, transfers); 171:C 4 gptr^.r3 := 0; {disable the gpio card} 172:C 4 dummy := dma0_disarm; {disarm the dma channel} 173:S 174:C 4 recover 175:C 4 begin 176:C 4 gptr^.r3 := 0; {disable the gpio card} 177:C 4 dummy := dma0_disarm; {disarm the dma channel} 178:C 4 if (escapecode<>ec_bad_error_state) then clear_and_escape(escapecode) 179:C 5 end; 180:S 181:C 3 with gptr^ do 182:C 4 begin 183:C 4 r7 := 1; {set the end of transfer bit} 184:C 4 Wdata := 0; {clear bidirectional buffer for reading status} 185:C 4 setpctl := 0; {request the status word} 186:C 4 status_word.w := gpiowordin(gptr^); {save the status word} 187:C 4 r7 := 0; {clear the end of transfer bit} 188:C 4 end; {with} 189:S 190:C 3 with status_word do 191:C 4 case errcode of 192:S 193:C 5 noerror: begin 194:C 5 if notready or (not seekcomplete) or (not transfercomplete) then 195:C 6 clear_and_escape(ec_bad_error_state); 196:C 5 tries := 0; 197:C 5 start_addr := start_addr+records; 198:C 5 length := length-transfers; 199:C 5 bufptr := addr(charptr(bufptr)^,transfers*2) 200:C 5 end; 201:S 202:C 5 nopower: escape(ec_no_device); 203:S 204:C 5 dooropen, 205:C 5 nodisc: escape(ec_no_medium); 206:S 207:C 5 notrack: escape(ec_read_error); 208:S 209:C 5 norecord, 210:C 5 badcheckword: begin 211:C 5 tries := tries+1; 212:C 5 if tries>=maxtries then 213:C 6 escape(ec_read_error) 214:C 6 end; 215:S 216:C 5 dataoverrun: escape(ec_bad_hardware); 217:S 218:C 5 otherwise clear_and_escape(ec_bad_error_state); 219:S 220:C 5 end; {case} 221:C 3 end; {while} 222:C 2 end; {deviceread} 223:S 224:S 225:C 1 end. {DUMBO} 226:S 227:S No errors. No warnings. ***** Nonstandard language features enabled *****