.TITLE Temporary Driver loader ; ; Bob, ; ; The following code is an attempt to give you a temporary ; driver loader. It is somewhat course and has not been debugged. ; It is true that the old .DRINI routine could not possibly have ; loaded your database. The changes are in here..it is hardwired ; to a single ctb, single krb, and a single DCB. It requires a ; separate SCB per UCB and may work with your driver if I understand ; the configuration of your database. The number of UCBs is arbitrary ; as is the UCB table appended to the KRB. ; ; Unlike .DRINI, the following code attempts to provide the same ; driver interface that the actual system would have in PROLOD except ; that the autoconfigure is far simpler here and calls to $xxloa and support ; for $xxPAR isn't in this temporary. I hope that the textual comments ; will help you to better understand what happens when your driver is loaded ; though I do not have great expectations that this code will work first time ; through. Also, this could does not attempt to do offline and unload ; operations, and will not permit reuse of an already loaded database. Your ; driver can not use the 60 second online grace period and should return ; success immediately. I suspect that it does this now. ; ; I am including a sample driver database which I believes comes close ; to what you have (except obviously for the I/O function supported). ; It may be of great help in diagnosing your driver should that be needed. ; ; You will need to assemble and taskbuild this loader (and by implication) ; your driver as a task. Be sure to specify /-XH on the build command line. ; ; See the section below which discusses the interface..it is not plugged into ; the sample database though the comments reflect how it could be. ; ; Will be back first week in February..talk with you then. ; ; -- Tim Martin ; ;+ ; System macro requests ;- .MCALL DIR$,SPND$S,WIMP$S ; ; Tables ; SYSCNF: WIMP$S #GI.CFG,#CNFBF,#CNFBFS ; Get configuration table CNFBFS= 46./2 ; just enough to get slot device IDs and stat SLOT0=14. ; offset in configuration table buffer to slot 0 CNFBF: .BLKW CNFBFS ; buffer in which to place configuration table VEC=0 ; CNVINF table vector offset in an entry CSR=2 ; CNVINF table CSR offset in an entry CNVINF: .WORD 300/4 ; SLOT 0 .WORD 174000 .WORD 310/4 ; SLOT 1 .WORD 174200 .WORD 320/4 ; SLOT 2 .WORD 174400 .WORD 330/4 ; SLOT 3 .WORD 174600 .WORD 340/4 ; SLOT 4 .WORD 175000 .WORD 350/4 ; SLOT 5 .WORD 175200 ; ; Local variables. ; POLCTB::.BLKW 1 ; -> CTB in pre-loaded database ; (after load, in pool database) POLDCB::.BLKW 1 ; -> DCB in pool ;+ ; ; ICB template ; ;- ICB: .WORD 0 ; link word JSR R5,@#$INTSI ; call to interrupt save OURMAP: .WORD 0 ; bias of driver .BYTE PR4,0 ; priority and controller group ISR: .WORD 0 ; driver interrupt entry point .BLKW 2 ; slop ICBSZ=.-ICB .SBTTL Pseudo Loader powerfail and reconfiguration routines ;+ ; ; This section simulates the powerfail call that a driver receives ; immediately after having been loaded. ; ;- .PWRFL: MOV TSKTBL,R5 ; get dispatch table MOV D.VPWF(R5),R5 ; get powerfail entry point MOV POLCTB,R3 ; get address of CTB just loaded MOV L.KRB(R3),R2 ; get address of KRB CALL $SWSTK,10$ ; enter system state SEC ; indicate controller powerfail CALLR (R5) ; call driver at powerfail entry 10$: MOV POLDCB,R0 ; get address of DCB just loaded MOVB D.UNIT+1(R0),R1 ; calc number of UCBs w/SCBs present MOVB D.UNIT(R0),R2 ; SUB R2,R1 ; INC R2 ; 1 based MOV D.UCBL(R0),R1 ; get length of UCB MOV D.UCB(R0),R0 ; get first UCB address 15$: MOV U.SCB(R0),R4 ; get SCB address MOV S.KRB(R4),R3 ; is there a KRB BEQ 20$ ; if eq no, K.CON not available MOVB K.CON(R3),R3 ; else get it 20$: CALL $SWSTK,30$ ; enter system state CLC ;; c=0 ==> unit powerfail MOV R0,R5 ;; R5 ==> UCB CALLR (R5) ;; call driver at powerfail entry point ADD R1,R0 ; back at user state..point to next UCB 30$: SOB R2,15$ ; continue till there aren't anymore RETURN ; return to caller ;+ ; ; This section simulates a online operations -- ; ; THE DRIVER MUST RETURN IMMEDIATELY AND SUCCESSFULLY! ; ;- .ONL: CALL $SWSTK,100$ ; enter system state MOV POLCTB,R5 ; get CTB just loaded MOV L.KRB(R5),R4 ; get KRB address CLR R0 ; BISB K.VCT(R4),R0 ; get vector ASL R0 ; ASL R0 ; MOV R0,-(SP) ; save vector to plug on stack MOV TSKTBL,R4 ; ADD #D.VINT,R4 ; CMP L.NAM(R5),(R4)+ ; controller names match? BEQ 2$ ; if eq yes ok MOV #-8.,R0 ; indicate inconsistent DDT ctrllr name JMP REPER1 ; report it 2$: MTPS #PR7 ;;; raise priority MOV R4,-(SP) ;;; save pointer in controller info block 3$: TST (R4)+ ;;; at the end of controller info BNE 3$ MOV R5,(R4) ;;; setup CTB address in DDT ADD #L.KRB,(R4) ;;; ..which is actually pting to start of krbs ; ; do the following for each interrupt entry point ; 4$: MOV (SP),R3 ;;; restore ptr to interrupt entry points MOV (R3)+,ISR ;;; set up ISR BEQ 40$ ;;; if eq, done MOV R3,(SP) ;;; save it till done 5$: MOV #ICBSZ,R1 ;;; set up to allocate an ICB CALL @#$ALOCB ;;; allocate it BCC 10$ ;;; if cc successful MOV #-7,R0 ;;; set fatal error JMP REPER1 ;;; report it..shame we got so far too 10$: MOV L.LNK(R5),ICB ;;; save any existing ICBs MOV R0,L.LNK(R5) ;;; link in new ICB MOV R0,-(SP) ;;; save ptr to ICB MOV #ICB,R1 ;;; point to ICB template MOV #ICBSZ/2,R3 ;;; get number of words to copy 20$: MOV (R1)+,(R0)+ ;;; copy ICB into pool ;;; ICB pool = primary pool on non I&D or mP SOB R3,20$ ;;; loop till done MOV (SP)+,R0 ;;; get address of ICB TST (R0)+ ;;; point past link word MOV 2(SP),R1 ;;; get vector address MOV R0,(R1)+ ;;; plug vector MOV #PR7,(R1)+ ;;; assumes like rest of code, only one KRB MOV R1,2(SP) ;;; save location of next vector to plug BR 4$ ;;; go and plug another one 40$: ADD #4,SP ;;; clean stack MOV #1,$SCERR ;;; default to success for controller online MOV POLCTB,R3 ;;; get CTB address MOV L.KRB(R3),R2 ;;; get KRB CLC MOV R2,-(SP) ;;; save KRB address across onl call MOV TSKTBL,-(SP) ;;; get dispatch table address ADD #D.VKRB,(SP) ;;; point to KRB stat change entry point MOV @(SP),(SP) ;;; get the entry point BEQ 50$ ;;; if eq none specified (it's optional) CALL @(SP)+ ;;; call driver for controller online 50$: MOV (SP)+,R2 ;;; restore KRB address BIC #KS.OFL,K.STS(R2) ;;; mark controller online RETURN ;;; exit system state 100$: MOV TSKTBL,R5 ; get address of dispatch table ADD D.VUCB,R5 ; point to unit online entry point MOV (R5),R5 ; get entry point MOV POLDCB,R0 ; get address of DCB just loaded MOVB D.UNIT+1(R0),R1 ; calc number of UCBs w/SCBs present MOVB D.UNIT(R0),R2 ; SUB R2,R1 ; INC R2 ; 1 based MOV D.UCBL(R0),R1 ; get length of UCB MOV D.UCB(R0),R0 ; get first UCB address 115$: MOV U.SCB(R0),R4 ; get SCB address MOV S.KRB(R4),R3 ; is there a KRB BEQ 200$ ; if eq no, K.CON not available MOVB K.CON(R3),R3 ; else get it 200$: CALL $SWSTK,300$ ; enter system state CLC ;; c=0 ==> unit powerfail MOV #1,$SCERR ;; default to success MOV R0,R5 ;; R5 ==> UCB CALLR (R5) ;; call driver at powerfail entry point BICB #US.OFL,U.ST2(R0) ; mark unit online ADD R1,R0 ; back at user state..point to next UCB 300$: SOB R2,115$ ; continue till there aren't anymore RETURN ; all done finally! .SBTTL ERRORS - short and not all that kind of an err handler REPERR: CALL $SWSTK,REPER2 ;; into system state REPER1: MOV R0,@#0 ;; place error where it is visible REPER2: IOT ;; drop system here for debugging ;; no XDT will produce 300/2 bugcheck BR 5$ ;; no direct way out .SBTTL LOADRV - Pseudo driver load autoconfigure ; ; First, an attempt is made to autoconfigure the driver in a rather ; simplistic way. It is assumed that there is only one option board ; with the ID specified in L.DID present in the system and if K.VCT ; is non zero, then auto configure is completely circumvented since ; (only for this temporary loader!) it is assumed that the driver is ; already preconfigured with appropriate values in K.SLT,K.VCT,K.CSR, ; as well as L.DID. ; LOADRV: CALL $SWSTK,10$ ;; enter system state CLR @#0 ;; indicate indeterminate state MOV $TKTCB,R1 ;; get driver's TCB MOV T.PCB(R1),R1 ;; get driver's PCB TST P.HDR(R1) ;; sanity check to ensure xhr BEQ 5$ ;; if eq ok MOV #-1,R0 ;; return error accessably CALL REPER1 ;; bugcheck it now (or xdt) 5$: BIS #PS.FXD!PS.NSF,P.STAT(R1) ;; indicate fixed and no shuffle CALLR $ICHKP ;; load driver high to avoid ;; fragmenting GEN 10$: CALL $SWSTK,15$ ; back into system state MOV P.REL(R1),OURMAP ;; now that we're in high mem ;; save out mapping for later RETURN ;; return to user state ; ; First, let's find configure the driver ; 15$: DIR$ #SYSCNF ; get system configuration BCC 10$ ; if cc, got it MOV #-2,R0 ; report error JMP REPERR ; "get config tbl failed" MOV TSKCTB,R0 ; get address of CTB MOV L.DID(R0),R1 ; get device ID BIC #170000,R1 ; strip rev number BEQ 60$ ; if eq, assume config info ; is in K.VCT/k.slt/k.csr MOV #SLOT0,R2 ; point to logical slot zero ID MOV #8.,R3 ; there are eight slots to scan 20$: MOV (R2)+,-(SP) ; get ID BIC #170000,(SP) ; again strip off rev number CMP (SP)+,R1 ; is this the slot? BEQ 30$ ; if eq, found it TST (R2)+ ; point to next slot SOB R3,20$ ; scan next slot MOV #-3,R0 ; get error CALL REPERR ; report error slot not found 30$: SUB #SLOT0,R2 ; form slot number MOV L.KRB(R0),R3 ; point to KRB TSTB K.VCT(R3) ; vector specified? BEQ 60$ ; if eq yes bypass auto cnf CMPB K.VCT(R3),CNVINF+VEC(R2) ; is this the correct vector? BEQ 40$ ; if eq ok MOV #-4,R0 ; reprot error JMP REPERR ; "K.VCT inconsistent" ; this limited autoconfig can ; only handle one option slot ; module with the same ID! 40$: MOVB CNVINF+VEC(R2),K.VCT(R3) ; plug K.VCT TST K.CSR(R3) ; CSR specified? BEQ 50$ ; if eq no CMP K.CSR(R3),CNVINF+CSR(R2) ; same as what we think it is? BEQ 50$ ; if eq yes MOV #-5,R0 ; report error JMP REPERR ; "inconsistent K.CSR" 50$: MOV CNVINF+CSR(R2),K.CSR(R3) ; plug K.CSR ASR R2 ; calc slot number ASR R2 ; TSTB K.SLT(R3) ; slot specified? BEQ 60$ ; if eq no MOVB R2,K.SLT(R3) ; plug K.SLT 60$: ; JMP .DRINI ; fall through .SBTTL .DRINI - Pseudo Loadable Driver Initialization ;+ ; This routine is used to turn a task forming a pseudo-loadable driver ; into an actual driver. First it connects the driver to interrupts, ; loads the data base, performs relocation within the data base, ; connects the data base to the system data base, and then returns to ; the user. ; ; Restrictions: ; ; ; Modified from the original version created by John Covert.. ; ; This version has been modified to relocate multiple SCBs however, ; THE IMPLICATION IS THAT THERE MUST BE ONE SCB PER UCB ; =============== ; ; 1. There must be 1 and only 1 DCB, CTB, and option module else auto config ; could fail. ; 2. The highest unit number must be less than 128. ; 3. No multi-access support ; 4. Offline operations are not understood by this pseudo loader ; 5. Prior to calling this routine, the user's local data base must have ; all internal pointers initialized. Relocation will be done by the ; loader for the following fields: ; ; in the CTB: L.DCB, L.KRB ; in the KRB: K.OWN,K.CRQ+2 ; in the DCB: D.UCB ; each UCB: U.DCB, U.SCB, U.RED ; in the SCB: S.KRB,S.LHD+2 ; ; ; The loader will initialize the following pointers: ; ; L.LNK(CTB), D.LNK(DCB), D.DSP(DCB), D.PCB(DSP), S.KS5(SCB) ; ; ;- .DRINI: 40$: CALL $SWSTK,FINIT ; Go to system state MOV TSKDCB,R4 ;; R4 -> DCB MOV D.NAM(R4),R4 ;; R4 is device logical name ; ; Scan DCB chain looking for DCB's whose device name is that of ours. ; Current restrictions are that there can only be one, so if we find it, ; it must be us, and we can skip loading the database. ; MOV #$DEVHD,R0 ;; R0 -> DCB list head 50$: MOV @R0,R0 ;; R0 -> next DCB BEQ 60$ ;; Branch if no more DCB's CMP D.NAM(R0),R4 ;; Is it we? BNE 50$ ;; Branch if not. Continue search MOV #-9.,R0 ;; report error JMP REPER1 ;; "driver already loaded" RETURN ;; and return to caller ; ; We found no DCB with our name, so we can load ours into memory ; ; ; Allocate enough pool for the database ; 60$: MOV TSKDAT,R1 ;; R1 -> end of database SUB TSKEND,R1 ;; R1 = size in bytes MOV R1,R3 ;; Save a copy of the size CALL @#$ALOCB ;; Allocate pool space BCC 70$ ;; Branch if we got it MOV #-6,R0 ;; report error JMP REPER1 ;; "insufficient primary pool" 70$: ROR R3 ;; Convert byte size to word size MOV R0,R4 ;; R4 -> Pool copy of database MOV TSKDAT,R2 ;; R2 -> database SUB R2,R4 ;; R4 = relocation bias 80$: MOV (R2)+,(R0)+ ;; Copy database to pool, word by word SOB R3,80$ ;; Decrement word count ; ; Database, not yet relocated, is now in pool ; ; Begin relocations: ; MOV TSKCTB,R0 ;; R0 -> CTB in driver ADD R4,R0 ;; R0 -> CTB in pool MOV R0,POLCTB ;; Save the pool address ADD R4,L.DCB(R0) ;; Relocate the DCB address ADD R4,L.KRB(R0) ;; Relocate the KRB address MOV L.DCB(R0),POLDCB;; Remember the DCB address ;; Now start on the KRB MOV L.KRB(R0),R0 ;; R0 -> KRB TST K.OWN(R0) ;; static owner? BEQ 81$ ;; if eq no ADD R4,K.OWN(R0) ;; Relocate K.OWN ADD R4,K.CRQ+2(R0) ;; Relocate controller request queue 81$: MOV K.OFF(R0),R1 ;; point to ucb table if any BEQ 85$ ;; if eq no table 82$: CMP #-1,(R1) ;; at the end of table BEQ 85$ ;; if eq yes ADD R4,(R1)+ ;; relocate UCB BR 82$ ;; Now start on the DCB 85$: MOV POLDCB,R0 ;; R0 -> DCB ADD R4,D.UCB(R0) ;; Relocate the UCB address ;; Now handle each UCB MOVB D.UNIT+1(R0),R1 ;; R1 = highest unit number INC R1 ;; Make it 1 based MOVB D.UNIT(R0),R2 ;; R2 = lowest unit number SUB R2,R1 ;; R1 = number of UCB's for this controller MOV D.UCBL(R0),R2 ;; R2 = length of each UCB MOV D.UCB(R0),R0 ;; R0 -> first UCB 90$: ADD R4,U.DCB(R0) ;; Relocate the DCB address ADD R4,U.SCB(R0) ;; and the SCB address MOV U.SCB(R0),R3 ;; R3 -> SCB ADD R4,S.KRB(R3) ;; Relocate the KRB address MOV OURMAP,S.KS5(R3);; plug mapping into fork block ADD R4,S.LHD+2(R3) ;; relocate listhead ADD R4,U.RED(R0) ;; and the redirect -> ADD R2,R0 ;; R0 -> next UCB SOB R1,90$ ;; Loop ;; Now handle the SCB ; ; Link the DCB and CTB into the system chains ; MOV #$DEVHD,R3 ;; R3 -> start of DCB list 100$: MOV R3,R0 ;; R0 -> previous DCB MOV @R3,R3 ;; R3 -> next DCB MOV D.UCB(R3),R5 ;; R5 -> first UCB BIT #DV.PSE,U.CW1(R5);; Is it a pseudo device BEQ 100$ ;; Branch if not. Continue looking MOV POLDCB,R2 ;; R2 -> DCB in loaded database MOV R2,@R0 ;; Link our database as last non-pseudo device MOV R3,@R2 ;; Finish link MOV #$CTLST,R2 ;; R2 -> CTB listhead 110$: TST @R2 ;; Last one? BEQ 120$ ;; Branch if so MOV @R2,R2 ;; Else, R2 -> next CTB BR 110$ ;; and follow the chain some more 120$: MOV POLCTB,(R2) ;; Link CTB in at end ; ; At this point the data base is fully in pool. Now connect the driver ; to the database. ; 130$: MOV POLDCB,R0 ;; R0 -> DCB MOV TSKTBL,D.DSP(R0);; Point D.DSP at dispatch table MOV $TKTCB,R1 ;; point to out TCB MOV T.PCB(R1),R1 ;; R1 -> our PCB MOV R1,D.PCB(R0) ;; Point D.PCB at our partition RETURN ;; Leave system state FINIT: CALL .ONL ;; create ICBs and online controller and units CALL .PWRFL ;; powerfail the device to init CLC ; Assume success MOV POLDCB,R5 ; place DCB address in an RMDemo visible loc. MOV POLCTB,R4 ; ditto for CTB 10$: SPND$S ; suspend task level execution forever BR 10$ ; and don't resume ;+ ; ; INTERFACE -- The following five words contain the global symbols that PROLOD ; would have need to resolve. Since the loader is temporily built ; into the driver and the driver is running from a task region ; with a resident header, the symbol values will be taken from ; here. ; ; Errors: errors are reported in a rather crude fashion..the system ; is crashed for inspection. It is strongly suggested that ; XDT be used while debugging the driver.. ; ; Errors written to absolute location 0 (so that they are ; acessable after a bugcheck by micro ODT and are held in ; R0. All of these errors are treated as fatal: ; ; 0 - no explicit error detected ; -1 - this task was not built with /-xh, and will not function ; correctly ; -2 - configuration table failed ; -3 - no slot with specified L.DID ; -4 - K.VCT inconsistent ; -5 - K.CSR inconsistent ; -6 - insufficient pool to load driver's database ; -7 - insufficient pool to allocate ICBs ; -8 - bad controller name in DDT controller info section ; -9 - driver and database already loaded ; ;- TSKDAT: .WORD 0 ;$XXDAT TSKEND: .WORD 0 ;$XXEND TSKTBL: .WORD 0 ;$XXTBL TSKDCB: .WORD 0 ;$XXDCB TSKCTB: .WORD 0 ;$XXCTB ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; ; Your driver code is placed here ; ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; ; Your driver database is placed here ; ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; Here is a sample driver database similar to what I have imagined ; yours to be. ;+ ; SLU driver database ; ; This is an example database of an quad SLU driver. It has one ; controller and four lines each of which may have multiple I/O ; in progress concurrently. It is strictly a unit record device ; rather than a terminal (DV.TTY) device and only supports a few ; key I/O functions (those needed to test the example). ; ; The database contains a single DCB, four UCB/SCB pairs (note that ; it is possible with this type of driver to dispense with all but ; one of the SCBs in this type of driver given slightly more complex ; driver logic.), and a single CTB and KRB. ; ;- $XXDAT:: ; delimit loadable database ;+ ; XX DCB ;- $XXDCB::.WORD 0 ; D.LNK - link word .WORD .XX0 ; D.UCB - address of first UCB .ASCII /XX/ ; D.NAM - logical device name .BYTE 0,3 ; D.UNIT - low and high logical unit number .WORD XXFIN-XXST ; D.UCBL - UCB length in bytes .WORD $XXTBL ; D.DSP - addr. of driver dispatch table ; D.MSK - function code mask words 0-15. .WORD 161077 ;legal-kil,wlb,rlb,att,det,smc,fna,acr,acw,ace .WORD 30 ;cntrl-kil,att,det .WORD 160000 ;nop -acr,acw,ace (note:fna must be rejected) .WORD 0 ;acp -none ; - function code mask words 16.-31. .WORD 7 ;legal-dac,wvb,rvb, .WORD 0 ;cntrl- .WORD 1 ;nop -dac .WORD 0 ;acp - .WORD 0 ; D.PCB - address of driver region PCB .XX0: ; start of UCBs XXST: ; symbol marking start of UCB .WORD $XXDCB ; U.DCB - address of DCB .WORD .-2 ; U.RED - redirect pointer .BYTE 0 ; U.CTL - unit control .BYTE US.OFL ; U.STS - unit status .BYTE 0 ; U.UNIT - physical unit .BYTE 0 ; U.ST2 - unit status extension .WORD DV.REC ; U.CW1 - 1st characteristic word .WORD 0 ; U.CW2 - 2nd characteristic word (not used) .WORD 0 ; U.CW3 - 3rd characteristic word (not used) .WORD 80. ; U.CW4 - 4th characteristic word (buffer size) .WORD ..XX0 ; U.SCB - pointer to SCB .WORD 0 ; U.ATT - address of TCB of attached task .WORD 0 ; URDPKT - read packet pointer .WORD 0 ; UWRPKT - write packet pointer XXFIN=. ; symbol marking end of UCB (used to calc siz) ;+ ; second unit's UCB ;- .WORD $XXDCB ; U.DCB - address of DCB .WORD .-2 ; U.RED - redirect pointer .BYTE 0 ; U.CTL - unit control .BYTE US.OFL ; U.STS - unit status .BYTE 1 ; U.UNIT - physical unit .BYTE 0 ; U.ST2 - unit status extension .WORD DV.REC ; U.CW1 - 1st characteristic word .WORD 0 ; U.CW2 - 2nd characteristic word (not used) .WORD 0 ; U.CW3 - 3rd characteristic word (not used) .WORD 80. ; U.CW4 - 4th characteristic word (buffer size) .WORD ..XX1 ; U.SCB - pointer to SCB .WORD 0 ; U.ATT - address of TCB of attached task .WORD 0 ; URDPKT - read packet pointer .WORD 0 ; UWRPKT - write packet pointer ;+ ; third unit's UCB ;- .WORD $XXDCB ; U.DCB - address of DCB .WORD .-2 ; U.RED - redirect pointer .BYTE 0 ; U.CTL - unit control .BYTE US.OFL ; U.STS - unit status .BYTE 2 ; U.UNIT - physical unit .BYTE 0 ; U.ST2 - unit status extension .WORD DV.REC ; U.CW1 - 1st characteristic word .WORD 0 ; U.CW2 - 2nd characteristic word (not used) .WORD 0 ; U.CW3 - 3rd characteristic word (not used) .WORD 80. ; U.CW4 - 4th characteristic word (buffer size) .WORD ..XX2 ; U.SCB - pointer to SCB .WORD 0 ; U.ATT - address of TCB of attached task .WORD 0 ; URDPKT - read packet pointer .WORD 0 ; UWRPKT - write packet pointer ;+ ; fourth unit's UCB ;- .WORD $XXDCB ; U.DCB - address of DCB .WORD .-2 ; U.RED - redirect pointer .BYTE 0 ; U.CTL - unit control .BYTE US.OFL ; U.STS - unit status .BYTE 3 ; U.UNIT - physical unit .BYTE 0 ; U.ST2 - unit status extension .WORD DV.REC ; U.CW1 - 1st characteristic word .WORD 0 ; U.CW2 - 2nd characteristic word (not used) .WORD 0 ; U.CW3 - 3rd characteristic word (not used) .WORD 80. ; U.CW4 - 4th characteristic word (buffer size) .WORD ..XX3 ; U.SCB - pointer to SCB .WORD 0 ; U.ATT - address of TCB of attached task .WORD 0 ; URDPKT - read packet pointer .WORD 0 ; UWRPKT - write packet pointer ;+ ; first unit's associated SCB ;- ..XX0: .WORD 0 ; S.LHF - I/O request queue .WORD .-2 ; .WORD 0,0,0,0 ; S.FRK - fork block link,PC,R5,R4 .WORD 0 ; kisar5 mapping of forked process .WORD 0 ; S.PKT - current packet (not used) .BYTE 0 ; S.CTM - current timeout (not used) .BYTE 0 ; S.ITM - initial timeout (not used) .BYTE 0 ; S.STS - status .BYTE 0 ; S.ST3 - status .WORD 0 ; S.ST2 - status .WORD XXA ; S.KRB - address of associated KRB ;+ ; second unit's associated SCB ;- ..XX1: .WORD 0 ; S.LHF - I/O request queue .WORD .-2 ; .WORD 0,0,0,0 ; S.FRK - fork block link,PC,R5,R4 .WORD 0 ; kisar5 mapping of forked process .WORD 0 ; S.PKT - current packet (not used) .BYTE 0 ; S.CTM - current timeout (not used) .BYTE 0 ; S.ITM - initial timeout (not used) .BYTE 0 ; S.STS - status .BYTE 0 ; S.ST3 - status .WORD 0 ; S.ST2 - status .WORD XXA ; S.KRB - address of associated KRB ;+ ; third unit's associated SCB ;- ..XX2: .WORD 0 ; S.LHF - I/O request queue .WORD .-2 ; .WORD 0,0,0,0 ; S.FRK - fork block link,PC,R5,R4 .WORD 0 ; kisar5 mapping of forked process .WORD 0 ; S.PKT - current packet (not used) .BYTE 0 ; S.CTM - current timeout (not used) .BYTE 0 ; S.ITM - initial timeout (not used) .BYTE 0 ; S.STS - status .BYTE 0 ; S.ST3 - status .WORD 0 ; S.ST2 - status .WORD XXA ; S.KRB - address of associated KRB ;+ ; fourth unit's associated SCB ;- ..XX3: .WORD 0 ; S.LHF - I/O request queue .WORD .-2 ; .WORD 0,0,0,0 ; S.FRK - fork block link,PC,R5,R4 .WORD 0 ; kisar5 mapping of forked process .WORD 0 ; S.PKT - current packet (not used) .BYTE 0 ; S.CTM - current timeout (not used) .BYTE 0 ; S.ITM - initial timeout (not used) .BYTE 0 ; S.STS - status .BYTE 0 ; S.ST3 - status .WORD 0 ; S.ST2 - status .WORD XXA ; S.KRB - address of associated KRB ;+ ; CONTROLLER REQUEST BLOCK ;- .BYTE PR4 ; K.PRI - controller interrupt priority .BYTE 0 ; K.VEC - vector .BYTE 0 ; K.CON - controller index .BYTE 0 ; K.IOC - I/O activity on controller .WORD KS.OFL!KS.UCB ; K.STS - controller status XXA: .WORD 0 ; K.CSR - controller CSR .WORD UCBTB-XXA ; K.OFF - offset from KRB to UCB table .BYTE 3 ; K.HPU - highest physical unit .BYTE 0 ; - unused .WORD .XX0 ; K.OWN - UCB address of owner .WORD 0 ; K.CRQ - controller request queue (not used) .WORD .-2 ; .WORD 0 ; K.FRK - controller fork block (not used) UCBTB: .WORD .XX0 ; first physical unit owner .WORD .XX1 ; second physical unit owner .WORD .XX2 ; third physical unit owner .WORD .XX3 ; fourth physical unit owner .WORD -1 ; table delimiter ;+ ; XX Controller table ;- .WORD 0 ; L.DID - needs to be filled in before load ; attempt is made .WORD 0 ; L.ICB - link to first ICB $XXCTB:: ; global required to find CTB .WORD 0 ; L.LNK - link to next CTB .ASCII /XX/ ; L.NAM - generic controller name .WORD $XXDCB ; L.DCB - link to next DCB .BYTE 1 ; L.NUM - number of KRB entries .BYTE 0 ; L.STS - Controller table status .WORD XXA ; L.KRB - KRB table (1 entry) $XXEND:: ; global lable delimiting end of database ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ .END LOADRV