.Title TCPDriver TCP/UDP pseudo-device driver .Ident /V1.07/ .Sbttl Overview ;++ ; ; GDMR, April 1987. ; ; This pseudo-device back-to-back driver interfaces between the INet protocol ; handler process and user processes that want to make use of its facilities. ; There are two sides to the device: the user (units 1...) see a simple ; read/write interface, augmented to allow connections to be set up and ; terminated; while the master side of the interface (unit 0) sees additional ; information which allows for proper demultiplexing and servicing of user ; requests. ; ; The following function codes are accepted: ; ; IO$_ReadVBlk (general data transfer) ; P1 = address of buffer ; P2 = length of buffer ; ; IO$_WriteVBlk (general data transfer) ; P1 = address of buffer ; P2 = length of buffer ; P3 = extra data ; P6 = user unit-ID (master only) ; ; IO$_Create open/define connection to remote peer ; P1 = address of connect data ; P2 = size of connect data ; P5 = error status (master only) ; P6 = user unit-ID (master only) ; IO$M_Abort use provided error status ; If the master supplies connect data it is copied into the user's ; buffer to indicate the identity of the peer. ; ; IO$_WritEOF close connection ; P6 = user unit-ID (master only) ; ; IO$_ReadPrompt claim port ; P4 = allocated port (master only) ; P5 = error status (master only) ; P6 = user unit-ID (master only) ; IO$M_Qualified port should be "privileged" ; IO$M_Abort use provided error status ; The port actually allocated is returned as the second word of the IOSB. ; ; IO$_SetMode make (un)available ; P5 = error status (master only) ; P6 = user unit-ID (master only) ; IO$M_Mount make available ; IO$M_DMount make unavailable ; IO$M_Qualified (un)block writes (flow control) ; IO$M_Abort use provided error status ; ; The third word of the master's IOSB contains the user unit-ID of the ; corresponding unit, while the fourth word contains the user's IO request code. ; .Page ; ; Strategy: the "standard" entry is used only for read requests, with all other ; requests being processed in the FDT routine. When a request is issued the ; routine first checks whether there is a corresponding request pending on the ; master/user UCB: if so, then the request can complete immediately and both ; IRPs are dispatched for post-processing; otherwise, for a read the request ; is queued on "this" UCB, for a write the request is queued on "the other" ; UCB, while for anything else the request is either queued on "the other" UCB ; for user requests, or bounced for master requests. ; ; History: ; V1.07 Zap the write-IO bit when we cancel a slave's request, ; as otherwise we may end up overwriting a valid buffer. ; ; V1.06 For IO$_Write copy master's P3 into slave's IOSB+4. This ; will be used by UDP wild listen to return INet address of ; peer. It's a pity that QIOs into multiple user-buffers ; aren't documented.... ; ; V1.05 Re-check online and valid in start-IO routine for slave side: ; if the scheduler was feeling unco-operative it was possible ; for the check to succeed in the FDT routine but for the ; master to clear the slave down before the IRP reached the ; read-queue. The effect of this was that the read was hanging ; indefinitely because the master process didn't know about it. ; Note that this is only a problem for slave read requests: if ; the master goes away for any reason the mopping-up code executes ; above scheduler IPL; while any other slave requests will result ; in an IRP being queued first to the master side's read queue -- ; this may surprise the master slightly, but at least nothing ; will get lost. ; ; V1.04 Obscure timing loophole re slave process channel deassignment ; stopped up. ; ; V1.03 IPL/page-fault interaction in FDT routines fixed. ; ; V1.02 Flow control added (simple blocking/unblocking of slave ; UCBs) to allow master processes to enforce window control. ; ; V1.01 Initial service version. ;-- .Page .Sbttl Constant definitions ; Argument list offsets P1 = 0 ; 1st QIO parameter P2 = 4 ; 2nd QIO parameter P3 = 8 ; 3rd QIO parameter P4 = 12 ; 4th QIO parameter P5 = 16 ; 5th QIO parameter P6 = 20 ; 6th QIO parameter ; System constants .Library "Sys$Library:Lib" .Link "Sys$System:Sys.STb" /Selective_Search $DynDef ; Dynamic memory types $DDBDef ; Device data block $DPTDef ; Driver prologue table $IRPDef ; I/O request packet $UCBDef ; Unit control block $CRBDef ; Channel request block $VecDef ; Vector dispatch block $IDBDef ; Interrupt dispatch block (for UCB list) $PCBDef ; Process control block $JIBDef ; Job information block $ARBDef ; Access rights block $PrvDef ; Privilege definitions $IODef ; I/O function codes $SSDef ; System error codes $DCDef ; Device classes $DevDef ; Device types $PRDef ; Processor internal registers ; UCB extension $DefIni UCB,,UCB$K_Length $Def UCB$L_WriteQueue .BlkL 1 ; Pending write operations $Def UCB$L_ResponseQueue .BlkL 1 ; Pending responses (user) $Def UCB$L_BlockedQueue .BlkL 1 ; Pending write IRP queue $Def UCB$L_ZapCount .BlkL 1 ; Tally of pending UCBs going $Def UCB$Q_IOSB .BlkQ 1 ; Status code for fork $Def UCB$K_TCP_Length $DefEnd UCB .Page .Sbttl Driver tables ; Driver prologue table DPTab - End=TCP_End,- ; End of driver Adapter=NULL,- ; Pseudo-device UCBSize=UCB$K_TCP_Length,- ; UCB size (with extension) Name=TCPDRIVER ; Driver name for reload DPT_Store INIT ; Start of initialisation data DPT_Store UCB,UCB$B_FIPL,B,8 ; Fork IPL DPT_Store UCB,UCB$B_DIPL,B,8 ; "Device" IPL (same as fork) DPT_Store UCB,UCB$B_DevClass,B,DC$_SCom ; Communications device DPT_Store UCB,UCB$L_DevChar,L,- ; Device characteristics ; Output device DPT_Store REINIT ; Start of reinitialisation data DPT_Store DDB,DDB$L_DDT,D,TCP$DDT ; Driver dispatch table DPT_Store END ; End of prologue ; Driver dispatch table DDTab - DevNam=TCP,- ; Driver generic name FuncTb=TCP_FDT,- ; Function table Start=TCP_Start,- ; Start IO routine UnitInit=TCP_Init,- ; Initialisation routine Cancel=TCP_Cancel ; Cancel IO routine .Page ; Function decision table TCP_FDT: FuncTab ,- ; Valid functions ; Make available FuncTab ,- ; Buffered functions (everything) ; Make available FuncTab FDT_Read,- ; Read data request FuncTab FDT_Write,- ; Write data request FuncTab FDT_Close,- ; Close connection FuncTab FDT_Open,- ; Open/define connection FuncTab FDT_Claim,- ; Claim port FuncTab FDT_SetMode,- ; Make available/set AST FuncTab +Exe$SenseMode,- ; Find max units .Page .Sbttl Unit initialisation routine ;++ ; Unit initialisation routine. If this is unit 0 then mark it online ; (others will be marked online later on request from master). Copy the ; max number of units into UCB$L_DevDepend (so it can be picked up later). ; ; Inputs: ; R3 = address of CSR (irrelevant) ; R4 = ditto. ; R5 = address of UCB ; Registers: ; must preserve all except R0, R1, R2 ; Context: ; System context, IPL$_Power ;-- TCP_Init: ClrL UCB$L_WriteQueue(R5) ; Initialise ClrL UCB$L_ResponseQueue(R5) ; Initialise ClrL UCB$L_BlockedQueue(R5) ; Initialise ClrL UCB$L_ZapCount(R5) ; Initialise MovL UCB$L_CRB(R5),R0 ; Get CRB address MovL CRB$L_IntD+Vec$L_IDB(R0),R0 ; Get IDB address MovZWL IDB$W_Units(R0),UCB$L_DevDepend(R5) ; Note max units allowed TstW UCB$W_Unit(R5) ; Unit 0? BNeqU 10$ ; No, skip BiSL #UCB$M_OnLine,UCB$L_Sts(R5) ; Mark unit online 10$: RSb .Page .Sbttl FDT utility routines (Check_OnLine and Check_Opened) ;++ ; FDT online check. Tests whether UCB is marked online or not. Online state ; is manipulated by master. ; ; Inputs (as for FDT routines): ; R3 = address of IRP ; R4 = address of PCB ; R5 = address of UCB ; R6 = address of CCB ; R7 = fn code bit number ; R8 = FDT entry address ; AP = QIO P1 ; P1 = buffer address ; P2 = buffer size ; Registers: ; must preserve R3 .. R8 and AP, FP ; Context: ; Kernel mode, IPL$_ASTDel ;-- Check_OnLine: TstW UCB$W_Unit(R5) ; Master? BEql 99$ ; Yes, skip it all BBS #UCB$V_OnLine,UCB$L_Sts(R5),99$ ; On line, -> TstL (SP)+ ; Lose return address MovZWL #SS$_DevOffLine,R0 ; Error status Jmp G^Exe$AbortIO ; Bounce the request 99$: RSb ; OK, return to QIO processing .Page ;++ ; FDT opened check. Tests whether UCB is marked opened or not. Opened state ; is set by a successful completion of an open request. On line check is also ; done here (first). ; ; Inputs (as for FDT routines): ; R3 = address of IRP ; R4 = address of PCB ; R5 = address of UCB ; R6 = address of CCB ; R7 = fn code bit number ; R8 = FDT entry address ; AP = QIO P1 ; P1 = buffer address ; P2 = buffer size ; Registers: ; must preserve R3 .. R8 and AP, FP ; Context: ; Kernel mode, IPL$_ASTDel ;-- Check_Opened: TstW UCB$W_Unit(R5) ; Master? BEql 99$ ; Yes, skip it all BBC #UCB$V_OnLine,UCB$L_Sts(R5),66$ ; Off line, -> BBS #UCB$V_Valid,UCB$L_Sts(R5),99$ ; Opened, -> 66$: TstL (SP)+ ; Lose return address MovZWL #SS$_DevOffLine,R0 ; Error status Jmp G^Exe$AbortIO ; Bounce the request 99$: RSb ; OK, return to QIO processing .Page .Sbttl FDT routines (FDT_Read) ;++ ; FDT read routine. For user, wait if necessary for a write from the master ; and return the resulting data. For master, wait for any user requests, ; returning data, user's function code and user's unit number. If a wait is ; necessary, allocate a system buffer and send the request to the (standard) ; start-IO entry where it will be queued until something arrives. ; (In fact, at the moment we just queue everything for the start-IO routine ; regardless of whether or not there's anything pending.) ; ; Inputs: ; R3 = address of IRP ; R4 = address of PCB ; R5 = address of UCB ; R6 = address of CCB ; R7 = fn code bit number ; R8 = FDT entry address ; AP = QIO P1 ; P1 = buffer address ; P2 = buffer size ; Registers: ; must preserve R3 .. R8 and AP, FP ; Context: ; Kernel mode, IPL$_ASTDel ;-- FDT_Read: BSbW Check_Opened ; Validate device TstL P2(AP) ; Check transfer length BGtr 20$ ; +ve, -> MovZWL #SS$_BadParam,R0 ; -ve, error status Jmp G^Exe$AbortIO ; Bounce it 20$: MovQ P1(AP),R0 ; Buffer address, size JSb G^Exe$ReadChk ; Probe the buffer ; We should check here for pending zaps, write requests, etc... At the ; moment we just queue everything to the start IO routine. ; No writes pending, so we'll have to queue the request for later PushL R3 ; Preserve IRP address AddL3 #12,P2(AP),R1 ; Allow for header JSb G^Exe$BuffrQuota ; Check caller's quota BLBS R0,40$ ; OK, -> 30$: PopL R3 ; Restore IRP address Jmp G^Exe$AbortIO ; Bounce request 40$: JSb G^Exe$AllocBuf ; Allocate system buffer BLBC R0,30$ ; Failed, -> PopL R3 ; Restore IRP address MovL R2,IRP$L_SVAPTE(R3) ; Save buffer address MovW R1,IRP$W_BOff(R3) ; Save buffer size MovL PCB$L_JIB(R4),R0 ; Get JIB address SubL R1,JIB$L_BytCnt(R0) ; Deduct buffer from quota MovAB 12(R2),(R2)+ ; Note data start address MovL P1(AP),(R2) ; Note user buffer address Jmp G^Exe$QIODrvPkt ; Send IRP to the driver .Page .Sbttl FDT routines (FDT_Write) ;++ ; FDT write routine. Wait, if necessary, for a read request on "the other" ; UCB (for user, this is always unit 0; for master the unit is in P6). ; If a wait is necessary, allocate a system buffer and queue the IRP on the ; "other" WriteQueue. Note that we don't queue the IRP to a start-IO routine. ; Flow control: if the unit is blocked (IntType set) then package up the ; request and put it on the tail of our BlockedQueue, from whence it will ; be taken when the unit is unblocked again. ; ; Inputs: ; R3 = address of IRP ; R4 = address of PCB ; R5 = address of UCB ; R6 = address of CCB ; R7 = fn code bit number ; R8 = FDT entry address ; AP = QIO P1 ; P1 = buffer address ; P2 = buffer size ; P3 = extra data ; P6 = user unit-ID (master only) ; Registers: ; must preserve R3 .. R8 and AP, FP ; Context: ; Kernel mode, IPL$_ASTDel ;-- FDT_Write: BSbW Check_Opened ; Validate device TstL P2(AP) ; Check transfer length BGtr 20$ ; +ve, -> 10$: MovZWL #SS$_BadParam,R0 ; -ve, error status Jmp G^Exe$AbortIO ; Bounce it 20$: MovQ P1(AP),R0 ; Buffer address, size JSb G^Exe$WriteChk ; Probe the buffer MovL UCB$L_CRB(R5),R10 ; Get CRB address MovL CRB$L_IntD+Vec$L_IDB(R10),R9 ; Get IDB address TstW UCB$W_Unit(R5) ; Are we master? BEql 250$ ; Yes, -> MovL IDB$L_UCBLst(R9),R9 ; Get other (master) UCB address BrB 290$ ; -> 250$: CvtWL P6(AP),R0 ; Other unit-ID BLEq 10$ ; Dud, -> CmpW R0,CRB$W_RefC(R10) ; Valid? BGEq 10$ ; No, -> (remember unit 0) MovL IDB$L_UCBLst(R9)[R0],R9 ; Get other UCB address BEqlU 10$ ; Not configured, -> BBC #UCB$V_Online,UCB$L_Sts(R9),270$; Not turned on, -> BBS #UCB$V_Valid,UCB$L_Sts(R9),290$ ; Opened, -> 270$: MovZWL #SS$_DevOffLine,R0 ; Error status Jmp G^Exe$AbortIO ; Bounce it .Page ; Prepare our system buffer and fill it from our caller's buffer. We do this ; regardless of whether or not we could copy into the reader's buffer directly, ; as it's quicker than locking down our caller's buffer to avoid page faults. 290$: PushL R3 ; Preserve IRP address AddL3 #12,P2(AP),R1 ; Allow for header JSb G^Exe$BuffrQuota ; Check caller's quota BLBS R0,40$ ; OK, -> 30$: PopL R3 ; Restore IRP address Jmp G^Exe$AbortIO ; Bounce request 40$: JSb G^Exe$AllocBuf ; Allocate system buffer BLBC R0,30$ ; Failed, -> PopL R3 ; Restore IRP address MovL R2,IRP$L_SVAPTE(R3) ; Save buffer address MovW R1,IRP$W_BOff(R3) ; Save buffer size MovL PCB$L_JIB(R4),R0 ; Get JIB address SubL R1,JIB$L_BytCnt(R0) ; Deduct buffer from quota MovAB 12(R2),(R2)+ ; Note data start address MovL P1(AP),(R2) ; Note user buffer address MovW #IO$_WritePBlk,IRP$W_Func(R3) ; Note IO function code PushR #^M ; Preserve buffer, IRP, PCB, UCB MovC3 IRP$L_BCnt(R3),@P1(AP),8(R2) ; Copy in data PopR #^M ; Restore buffer, IRP, PCB, UCB MovL P3(AP),IRP$L_Media+4(R3) ; Note extra data ; Now, before we queue the IRP we have to check to see if there is a pending ; read -- if so, we can just complete everthing here without enqueueing. DsbInt UCB$B_FIPL(R5) ; Lock out others BBS #UCB$V_IntType,UCB$L_Sts(R5),55$; Blocked, -> BBC #UCB$V_Bsy,UCB$L_Sts(R9),59$ ; No pending read, -> TstL UCB$L_WriteQueue(R9) ; Anything else waiting? BEqlU 333$ ; No, -> copy in 59$: MovAL UCB$L_WriteQueue(R9),R0 ; Address of write listhead BrB 60$ ; -> 55$: MovAL UCB$L_BlockedQueue(R5),R0 ; Address of block listhead 60$: TstL (R0) ; Anything in list? BEqlU 70$ ; Nil, -> MovL (R0),R0 ; Next in list BrB 60$ ; Round again 70$: MovL R3,(R0) ; Enqueue IRP ClrL (R3) ; Zap forward pointer EnbInt ; Safe again Jmp G^Exe$QIOReturn ; All for now, back to caller .Page ; There was a read pending, so process it. 333$: MovL UCB$L_IRP(R9),R6 ; Other IRP MovL IRP$L_SVAPTE(R6),R7 ; Other buffer MovZWL #SS$_Normal,R0 ; Provisional success CmpL IRP$L_BCnt(R3),IRP$L_BCnt(R6) ; Compare lengths BLEq 101$ ; Write is shorter, -> MovZWL #SS$_BufferOvf,R0 ; Change to error status BrB 102$ ; Skip, -> 101$: MovL IRP$L_BCnt(R3),IRP$L_BCnt(R6) ; Note amount actually written 102$: PushR #^M ; Preserve interesting stuff MovC3 IRP$L_BCnt(R6),8(R2),12(R7) ; Copy data from our buffer PopR #^M ; Restore again InsV IRP$L_BCnt(R6),#16,#16,R0 ; Insert MovW UCB$W_Unit(R5),R1 ; Our unit-ID BEqlU 110$ ; We're master, -> InsV #IO$_WritePBlk,#16,#16,R1 ; Our request code BrB 111$ ; Rejoin common -> 110$: MovL IRP$L_Media+4(R3),R1 ; Restore extra data 111$: PushR #^M ; Preserve unit, IRP, PCB, UCB MovL R9,R5 ; Switch in other UCB BSbB 200$ ; Go and complete the other side PopR #^M ; Restore it all again EnbInt ; Safe again Jmp G^Exe$FinishIO ; All done 200$: MovQ R0,UCB$Q_IOSB(R5) ; Save status Fork ; Give us our own context MovQ UCB$Q_IOSB(R5),R0 ; Restore status ReqCom ; All done for other side .Page .Sbttl FDT routines (FDT_Open) ;++ ; FDT open routine. If we're the master side then we must have had a request ; from the user side which will now be queued for us, hence we can complete ; immediately. If not, then we bounce this IO. If we're the user side then ; we queue the request for the master to read -- this is similar to but not ; quite identical to the write FDT routine. Note that we have to claim a ; system buffer whether or not the master has a read pending, as we know that ; the response data will not be available immediately. If the user-side request ; completes successfully then mark the UCB valid to allow later reads and writes. ; ; Inputs: ; R3 = address of IRP ; R4 = address of PCB ; R5 = address of UCB ; R6 = address of CCB ; R7 = fn code bit number ; R8 = FDT entry address ; AP = QIO P1 ; P1 = buffer address ; P2 = buffer size ; P6 = user unit_ID (master only) ; Registers: ; must preserve R3 .. R8 and AP, FP ; Context: ; Kernel mode, IPL$_ASTDel ;-- FDT_Open: BSbW Check_OnLine ; Validate device TstW UCB$W_Unit(R5) ; Master? BNeq 5$ ; No, skip BrW 400$ ; -> Master side 5$: TstL P2(AP) ; Check transfer length BGtr 20$ ; +ve, -> MovZWL #SS$_BadParam,R0 ; -ve, error status Jmp G^Exe$AbortIO ; Bounce it 20$: MovQ P1(AP),R0 ; Buffer address, size JSb G^Exe$ReadChk ; Probe the buffer for modify PushL R3 ; Preserve IRP address AddL3 #12,P2(AP),R1 ; Allow for header JSb G^Exe$BuffrQuota ; Check caller's quota BLBS R0,40$ ; OK, -> 30$: PopL R3 ; Restore IRP address Jmp G^Exe$AbortIO ; Bounce request 40$: JSb G^Exe$AllocBuf ; Allocate system buffer BLBC R0,30$ ; Failed, -> PopL R3 ; Restore IRP address MovL R2,IRP$L_SVAPTE(R3) ; Save buffer address MovW R1,IRP$W_BOff(R3) ; Save buffer size MovL PCB$L_JIB(R4),R0 ; Get JIB address SubL R1,JIB$L_BytCnt(R0) ; Deduct buffer from quota MovAB 12(R2),(R2)+ ; Note data start address MovL P1(AP),(R2) ; Note user buffer address PushR #^M ; Preserve buffer, IRP, PCB, UCB MovC3 IRP$L_BCnt(R3),@P1(AP),8(R2) ; Copy in data PopR #^M ; Restore buffer, IRP, PCB, UCB .Page ; Find the master's UCB MovL UCB$L_CRB(R5),R10 ; Get CRB address MovL CRB$L_IntD+Vec$L_IDB(R10),R9 ; Get IDB address MovL IDB$L_UCBLst(R9),R9 ; Get other (master) UCB address ; Check to see if master has a pending read queued DsbInt UCB$B_FIPL(R5) ; Lock out others BBC #UCB$V_Bsy,UCB$L_Sts(R9),99$ ; Idle, -> TstL UCB$L_WriteQueue(R9) ; Anything else waiting? BEqlU 333$ ; No, -> copy ; No read pending or someone else waiting, so queue the request 99$: MovL IRP$L_ARB(R3),R0 ; Get ARB address ExtZV #Prv$V_SysPrv,#1,ARB$Q_Priv(R0),IRP$L_Media(R3) ; Extract privilege MovAL UCB$L_WriteQueue(R9),R0 ; Address of listhead 60$: TstL (R0) ; Anything in list? BEqlU 70$ ; Nil, -> MovL (R0),R0 ; Next in list BrB 60$ ; Round again 70$: MovL R3,(R0) ; Enqueue IRP ClrL (R3) ; Zap forward pointer EnbInt ; Safe again Jmp G^Exe$QIOReturn ; All for now, back to caller .Page ; There was a read pending, so process it. 333$: MovL UCB$L_IRP(R9),R6 ; Other IRP MovL IRP$L_SVAPTE(R6),R7 ; Other buffer MovZWL #SS$_Normal,R0 ; Provisional success CmpL IRP$L_BCnt(R3),IRP$L_BCnt(R6) ; Compare lengths BLEq 101$ ; Write is shorter, -> MovZWL #SS$_BufferOvf,R0 ; Change to error status BrB 102$ ; Skip, -> 101$: MovL IRP$L_BCnt(R3),IRP$L_BCnt(R6) ; Note amount actually written 102$: PushR #^M ; Preserve interesting stuff MovC3 IRP$L_BCnt(R6),8(R2),12(R7) ; Copy data PopR #^M ; Restore again InsV IRP$L_BCnt(R6),#16,#16,R0 ; Insert MovW UCB$W_Unit(R5),R1 ; Our unit-ID InsV IRP$W_Func(R3),#16,#16,R1 ; Our request code MovL IRP$L_ARB(R3),R2 ; Get ARB address BBC #Prv$V_SysPrv,ARB$Q_Priv(R2),111$ ; No SysPrv, skip -> BiSW #^X8000,R1 ; Inject "privilege" bit 111$: PushR #^M ; Preserve IRP, PCB, UCB MovL R9,R5 ; Switch in other UCB BSbB 200$ ; Go and complete the other side PopR #^M ; Restore it all again ; Now put our IRP on the end of our pending response queue BiCW #IO$M_FModifiers,IRP$W_Func(R3) ; Zap the function modifiers MovAL UCB$L_ResponseQueue(R5),R0 ; Address of listhead 160$: TstL (R0) ; Anything in list? BEqlU 170$ ; Nil, -> MovL (R0),R0 ; Next in list BrB 160$ ; Round again 170$: MovL R3,(R0) ; Enqueue IRP ClrL (R3) ; Zap forward pointer EnbInt ; Safe again Jmp G^Exe$QIOReturn ; All done for now 200$: MovQ R0,UCB$Q_IOSB(R5) ; Save status Fork ; Give us our own context MovQ UCB$Q_IOSB(R5),R0 ; Restore status ReqCom ; All done for other side .Page ; Master side processing 400$: CvtWL P6(AP),R0 ; User unit-ID BGtr 410$ ; +ve, -> 405$: MovZWL #SS$_BadParam,R0 ; Error status Jmp G^Exe$AbortIO ; Bounce the request 410$: MovL UCB$L_CRB(R5),R10 ; Get CRB address CmpW R0,CRB$W_RefC(R10) ; Valid unit? BGEq 405$ ; No, -> MovL CRB$L_IntD+Vec$L_IDB(R10),R9 ; Get IDB address MovL IDB$L_UCBLst(R9)[R0],R9 ; Get user's UCB address BEqlU 405$ ; Not configured, -> BBS #UCB$V_Online,UCB$L_Sts(R9),415$; Turned on, -> MovZWL #SS$_DevOffLine,R0 ; Error status Jmp G^Exe$AbortIO ; Bounce it ; Scan the other UCB looking for a "corresponding" request 415$: MovAL UCB$L_ResponseQueue(R9),R10 ; Queue header address 420$: MovL (R10),R11 ; Next IRP address BEqlU 405$ ; End, request not found, -> CmpW IRP$W_Func(R11),#IO$_Create ; Found our request? BEqlU 430$ ; Yes, break out MovL R11,R10 ; Next in list ... BrB 420$ ; ... and round again ; We've found our IRP, so we can validate the rest of the request 430$: BBC #IO$V_Abort,IRP$W_Func(R3),433$ ; Success completion, -> MovZWL P5(AP),R0 ; Use supplied status BrB 439$ ; -> send the reply 433$: TstL P2(AP) ; Any response data? BLss 405$ ; Dud, -> BGtr 500$ ; Yes, -> validate it MovZWL #SS$_Normal,R0 ; Success code BiSL #UCB$M_Valid,UCB$L_Sts(R9) ; Allow reads & writes ; No response data, so fill in the other details and complete 439$: MovL (R11),(R10) ; Unlink IRP BiCW #IRP$M_Func,IRP$W_Sts(R11) ; Inhibit data copy-out PushL R3 ; Save our IRP address PushL R5 ; Save our UCB address MovL R11,R3 ; Move in other IRP MovL IRP$L_UCB(R3),R5 ; Move in other UCB MovL R0,IRP$L_Media(R3) ; Completion status ClrL IRP$L_Media+4(R3) ; Nothing extra ClrL IRP$L_BCnt(R3) ; Nothing transferred JSb G^Com$Post ; Send it on its way PopL R5 ; Restore UCB PopL R3 ; Restore IRP MovZWL #SS$_Normal,R0 ; Success Jmp G^Exe$FinishIOC ; All done .Page ; There's some response data to copy in before we're through 500$: MovQ P1(AP),R0 ; Buffer address, length JSb G^Exe$WriteChk ; Probe it MovL (R11),(R10) ; Unlink the other IRP BiSL #UCB$M_Valid,UCB$L_Sts(R9) ; Allow reads & writes MovZWL #SS$_Normal,R9 ; Provisional success CmpL IRP$L_BCnt(R3),IRP$L_BCnt(R11) ; Compare buffer sizes BLEq 510$ ; Write is shorter, -> MovZWL #SS$_BufferOvF,R9 ; Error status BrB 520$ ; Skip, -> 510$: MovL IRP$L_BCnt(R3),IRP$L_BCnt(R11) ; Note amount actually written 520$: MovL IRP$L_SVAPTE(R11),R10 ; Get buffer address PushR #^M ; Preserve IRP, PCB, UCB MovC3 IRP$L_BCnt(R11),@P1(AP),12(R10) ; Copy data PopR #^M ; Restore IRP, PCB, UCB InsV IRP$L_BCnt(R11),#16,#16,R9 ; Inject transfer size MovL R9,IRP$L_Media(R11) ; Completion status ClrL IRP$L_Media+4(R11) ; No extra PushL R3 ; Save our IRP address PushL R5 ; Save our UCB address MovL R11,R3 ; Move in other IRP MovL IRP$L_UCB(R3),R5 ; Move in other UCB JSb G^Com$Post ; Send it on its way PopL R5 ; Restore UCB PopL R3 ; Restore IRP MovL R9,R0 ; Completion status Jmp G^Exe$FinishIOC ; All done. .Page .Sbttl FDT routines (FDT_Close) ;++ ; Indicate to the other side that a port is closing (by returning EndOfFile). ; Wait for a read if necessary. ; Flow control: blocking is done as for "ordinary" data-writes so as to ; preserve IRP sequencing. ; ; Inputs: ; R0 = address of FDT routine (irrelevant) ; R3 = address of IRP ; R4 = address of PCB ; R5 = address of UCB ; R6 = address of CCB ; R7 = fn code bit number ; R8 = FDT entry address ; AP = QIO P1 ; P6 = user unit-ID (master only) ; Registers: ; must preserve R3 .. R8 and AP, FP ; Context: ; Kernel mode, IPL$_ASTDel ;-- FDT_Close: BSbW Check_Opened ; Validate device MovL UCB$L_CRB(R5),R10 ; Get CRB address MovL CRB$L_IntD+Vec$L_IDB(R10),R9 ; Get IDB address TstW UCB$W_Unit(R5) ; Master? BEql 20$ ; Yes, -> MovL IDB$L_UCBLst(R9),R9 ; Get master's UCB BrB 30$ ; -> 20$: CvtWL P6(AP),R0 ; Other side's unit-ID BGtr 22$ ; OK, -> 21$: MovZWL #SS$_BadParam,R0 ; Error status Jmp G^Exe$AbortIO ; Bounce it 22$: CmpW R0,CRB$W_RefC(R10) ; Valid? BGeq 21$ ; No, -> MovL IDB$L_UCBLst(R9)[R0],R9 ; Get other UCB address BEqlU 21$ ; Not configured, -> BBC #UCB$V_OnLine,UCB$L_Sts(R9),25$ ; Turned off, -> BBS #UCB$V_Valid,UCB$L_Sts(R9),30$ ; Opened, -> 25$: MovZWL #SS$_DevOffLine,R0 ; Error status Jmp G^Exe$AbortIO ; Bounce it ; Can we complete this immediately (has the other side a read pending), or ; do we have to queue our request? 30$: DsbInt UCB$B_FIPL(R5) ; Lock out others BBS #UCB$V_IntType,UCB$L_Sts(R5),99$; Blocked, -> BBC #UCB$V_Bsy,UCB$L_Sts(R9),100$ ; Idle, -> TstL UCB$L_WriteQueue(R9) ; Anything else waiting? BNEqU 100$ ; Yes, let it in first .Page ; The other side has a pending read. Complete it with the appropriate ; status code (EndOfFile). MovZWL #SS$_EndOfFile,R0 ; Return end of file MovZWL UCB$W_Unit(R5),R1 ; Our unit number PushR #^M ; Save IRP, PCB, UCB MovL R9,R5 ; Switch in other UCB MovL UCB$L_IRP(R5),R3 ; Other IRP BiCW #IRP$M_Func,IRP$W_Sts(R3) ; Inhibit copy-out BSbB 200$ ; Go and complete the other side PopR #^M ; Restore IRP, PCB, UCB EnbInt ; Safe again MovZWL #SS$_Normal,R0 ; Success Jmp G^Exe$FinishIOC ; All done 200$: MovQ R0,UCB$Q_IOSB(R5) ; Save status Fork ; Give us our own context MovQ UCB$Q_IOSB(R5),R0 ; Restore status ReqCom ; All done for the other side ; The other side doesn't have any read pending or we're blocked, so we'll ; have to queue our IRP for later. 99$: MovAL UCB$L_BlockedQueue(R5),R0 ; Address of blocked listhead BrB 60$ ; -> 100$: MovAL UCB$L_WriteQueue(R9),R0 ; Address of write listhead 60$: TstL (R0) ; Anything in list? BEqlU 70$ ; Nil, -> MovL (R0),R0 ; Next in list BrB 60$ ; Round again 70$: MovL R3,(R0) ; Enqueue IRP ClrL (R3) ; Zap forward pointer EnbInt ; Safe again Jmp G^Exe$QIOReturn ; All for now, back to caller .Page .Sbttl FDT routines (FDT_Claim) ;++ ; Claim a port. Function code modifier IO$M_Qualified indicates that the port ; should be "privileged". The port allocated is returned as the second word ; of the IOSB. Similar to FDT_open, except that a buffer is not required. ; ; Inputs: ; R0 = address of FDT routine (irrelevant) ; R3 = address of IRP ; R4 = address of PCB ; R5 = address of UCB ; R6 = address of CCB ; R7 = fn code bit number ; R8 = FDT entry address ; AP = QIO P1 ; P6 = user unit-ID (master only) ; Registers: ; must preserve R3 .. R8 and AP, FP ; Context: ; Kernel mode, IPL$_ASTDel ;-- FDT_Claim: BSbW Check_OnLine ; Validate device TstW UCB$W_Unit(R5) ; Master? BNeq 5$ ; No, skip BrW 400$ ; -> Master side ; Find the master's UCB 5$: MovL UCB$L_CRB(R5),R10 ; Get CRB address MovL CRB$L_IntD+Vec$L_IDB(R10),R9 ; Get IDB address MovL IDB$L_UCBLst(R9),R9 ; Get other (master) UCB address ; Check to see if master has a pending read queued DsbInt UCB$B_FIPL(R5) ; Lock out others BBC #UCB$V_Bsy,UCB$L_Sts(R9),99$ ; Idle, -> TstL UCB$L_WriteQueue(R9) ; Anything else waiting? BEqlU 333$ ; No, -> ; No read pending or someone else waiting, so queue the request 99$: MovL IRP$L_ARB(R3),R0 ; Get ARB address ExtZV #Prv$V_SysPrv,#1,ARB$Q_Priv(R0),IRP$L_Media(R3) ; Extract privilege MovAL UCB$L_WriteQueue(R9),R0 ; Address of listhead 60$: TstL (R0) ; Anything in list? BEqlU 70$ ; Nil, -> MovL (R0),R0 ; Next in list BrB 60$ ; Round again 70$: MovL R3,(R0) ; Enqueue IRP ClrL (R3) ; Zap forward pointer EnbInt ; Safe again Jmp G^Exe$QIOReturn ; All for now, back to caller .Page ; There was a read pending, so process it. 333$: MovL UCB$L_IRP(R9),R6 ; Other IRP MovW UCB$W_Unit(R5),R1 ; Our unit-ID MovL IRP$L_ARB(R3),R0 ; Get our ARB address BBC #Prv$V_SysPrv,ARB$Q_Priv(R0),334$ ; No SysPrv, -> BiSW #^X8000,R1 ; Inject "privilege" bit 334$: InsV IRP$W_Func(R3),#16,#16,R1 ; Our request code MovZWL #SS$_Normal,R0 ; Success code PushR #^M ; Preserve IRP, PCB, UCB MovL R9,R5 ; Switch in other UCB MovL UCB$L_IRP(R5),R3 ; Other IRP BiCW #IRP$M_Func,IRP$W_Sts(R3) ; Inhibit copy-out BSbB 200$ ; Go and complete the other side PopR #^M ; Restore it all again ; Now put our IRP on the end of our pending response queue BiCW #IO$M_FModifiers,IRP$W_Func(R3) ; Zap the function modifiers MovAL UCB$L_ResponseQueue(R5),R0 ; Address of listhead 160$: TstL (R0) ; Anything in list? BEqlU 170$ ; Nil, -> MovL (R0),R0 ; Next in list BrB 160$ ; Round again 170$: MovL R3,(R0) ; Enqueue IRP ClrL (R3) ; Zap forward pointer EnbInt ; Safe again Jmp G^Exe$QIOReturn ; All done for now 200$: MovQ R0,UCB$Q_IOSB(R5) ; Save status Fork ; Give us our own context MovQ UCB$Q_IOSB(R5),R0 ; Restore status ReqCom ; All done for other side .Page ; Master side processing 400$: CvtWL P6(AP),R0 ; User unit-ID BGtr 410$ ; +ve, -> 405$: MovZWL #SS$_BadParam,R0 ; Error status Jmp G^Exe$AbortIO ; Bounce the request 410$: MovL UCB$L_CRB(R5),R10 ; Get CRB address CmpW R0,CRB$W_RefC(R10) ; Valid unit? BGEq 405$ ; No, -> MovL CRB$L_IntD+Vec$L_IDB(R10),R9 ; Get IDB address MovL IDB$L_UCBLst(R9)[R0],R9 ; Get user's UCB address BEqlU 405$ ; Not configured, -> BBS #UCB$V_OnLine,UCB$L_Sts(R9),415$; Turned on, -> MovZWL #SS$_DevOffLine,R0 ; Error status Jmp G^Exe$AbortIO ; Bounce it ; Scan the other UCB looking for a "corresponding" request 415$: DsbInt UCB$B_FIPL(R5) ; Lock out others MovAL UCB$L_ResponseQueue(R9),R10 ; Queue header address 420$: MovL (R10),R11 ; Next IRP address BEqlU 405$ ; End, request not found, -> CmpW IRP$W_Func(R11),#IO$_ReadPrompt ; Found our request? BEqlU 430$ ; Yes, break out MovL R11,R10 ; Next in list ... BrB 420$ ; ... and round again ; We've found our IRP, so fill in the other details and complete 430$: MovL (R11),(R10) ; Unlink IRP BBS #IO$V_Abort,IRP$W_Func(R3),435$ ; Error, -> MovW #SS$_Normal,IRP$L_Media(R11) ; Success status MovW P4(AP),IRP$L_Media+2(R11) ; Allocated port BrB 440$ ; -> send it 435$: MovZWL P5(AP),IRP$L_Media(R11) ; Error status 440$: ClrL IRP$L_Media+4(R11) ; Nothing extra ClrL IRP$L_BCnt(R11) ; Nothing transferred PushL R5 ; Save our UCB address MovL IRP$L_UCB(R11),R5 ; Move in other UCB PushL R3 ; Save our IRP address MovL R11,R3 ; Move in other IRP JSb G^Com$Post ; Send it on its way PopL R3 ; Restore IRP PopL R5 ; Restore UCB EnbInt ; Safe again MovZWL #SS$_Normal,R0 ; Success Jmp G^Exe$FinishIOC ; All done .Page .Sbttl FDT routines (FDT_SetMode) ;++ ; FDT setmode routine. Called by the master side to control the availability ; of the other UCBs. Two modifiers can be specified, one to mark the device ; unavailable and to bounce any pending requests, the other to mark the device ; available. If both are specified then making the device unavailable takes ; precedence over making it available. ; ; Inputs: ; R0 = address of FDT routine (irrelevant) ; R3 = address of IRP ; R4 = address of PCB ; R5 = address of UCB ; R6 = address of CCB ; R7 = fn code bit number ; R8 = FDT entry address ; AP = QIO P1 ; Registers: ; must preserve R3 .. R8 and AP, FP ; Context: ; Kernel mode, IPL$_ASTDel ;-- FDT_SetMode: TstW UCB$W_Unit(R5) ; Master? BEqlU 5$ ; Yes, -> MovZWL #SS$_IllIOFunc,R0 ; Only from master (meantime) Jmp G^Exe$AbortIO ; Bounce request 5$: CvtWL P6(AP),R0 ; "Other" unit-ID BGtr 10$ ; OK (so far), -> 7$: MovZWL #SS$_BadParam,R0 ; Error status Jmp G^Exe$AbortIO ; Bounce it 10$: MovL UCB$L_CRB(R5),R10 ; Get CRB address CmpW R0,CRB$W_RefC(R10) ; Too big? BGEq 7$ ; Yes, -> MovL CRB$L_IntD+Vec$L_IDB(R10),R9 ; Get IDB address MovL IDB$L_UCBLst(R9)[R0],R9 ; Get other UCB address BEqlU 7$ ; Not configured, -> ; Now test for each modifier in turn, branching as appropriate. BBS #IO$V_DMount,IRP$W_Func(R3),SetMode_unavailable BBS #IO$V_Mount,IRP$W_Func(R3),SetMode_available MovZWL #SS$_IllIOFunc,R0 ; No match, error Jmp G^Exe$AbortIO ; ... bounce it .Page ; Make "other" UCB available by setting the OnLine bit. ; Valid will be set when the UCB is opened. SetMode_available: BBS #IO$V_Qualified,IRP$W_Func(R3),20$ ; Unblock, -> BiSL #UCB$M_OnLine,UCB$L_Sts(R9) ; Device is now online BiCL #,- ; Not going away/blocked UCB$L_Sts(R9) MovZWL #SS$_Normal,R0 ; Success Jmp G^Exe$FinishIOC ; All done ; Unblock the other UCB -- clear the flag (IntType in Sts), and move the ; blocked queue to the master's pending write queue 20$: DsbInt UCB$B_FIPL(R5) ; Lock out others BiCL #UCB$M_IntType,UCB$L_Sts(R9) ; Unblock UCB TstL UCB$L_BlockedQueue(R9) ; Anything pending BEqlU 40$ ; No, -> MovAL UCB$L_WriteQueue(R5),R0 ; Head of our pending queue 25$: MovL (R0),R1 ; Address of first entry BEqlU 30$ ; No more, -> MovL R1,R0 ; Next in list BrB 25$ ; Round for next one, -> 30$: MovL UCB$L_BlockedQueue(R9),(R0) ; Append ClrL UCB$L_BlockedQueue(R9) ; Zap listhead BBC #UCB$V_Bsy,UCB$L_Sts(R5),40$ ; No pending read, -> PushR #^M ; Preserve IRP, UCB BSbB 50$ ; -> tickle read PopR #^M ; Restore IRP, UCB 40$: EnbInt ; Safe again MovZWL #SS$_Normal,R0 ; Success Jmp G^Exe$FinishIOC ; All done 50$: Fork ; Acquire our own context MovL UCB$L_IRP(R5),R3 ; Pending read IRP address BrW TCP_Start ; Kick the pending read .Page ; Make "other" UCB unavailable. If any requests are pending they are failed ; with the supplied error status (if any) or with SS$_Abort. SetMode_unavailable: DsbInt UCB$B_FIPL(R5) ; Lock out others for safety BBC #IO$V_Qualified,IRP$W_Func(R3),10$ ; Not just block, -> BiSL #UCB$M_IntType,UCB$L_Sts(R9) ; Block other UCB EnbInt ; Safe again MovZWL #SS$_Normal,R0 ; Success Jmp G^Exe$FinishIOC ; All done 10$: BiCL #,- UCB$L_Sts(R9) ; Device is not online PushL R3 ; Preserve our IRP PushL R5 ; Preserve our UCB MovL R9,R5 ; Switch in other UCB MovZWL #SS$_Abort,R10 ; Provisional status BBC #IO$V_Abort,IRP$W_Func(R3),100$ ; No status provided, skip -> MovZWL P5(AP),R10 ; Use supplied status ; Loop round the pending read queue 100$: BBCC #UCB$V_Bsy,UCB$L_Sts(R5),200$ ; No pending read, -> MovL UCB$L_IRP(R5),R3 ; Get active IRP MovL R10,IRP$L_Media(R3) ; Completion status ClrL IRP$L_Media+4(R3) ; No extra BiCW #IRP$M_Func,IRP$W_Sts(R3) ; Inhibit copy-out JSb G^Com$Post ; Send IRP on its way 110$: RemQue @UCB$L_IOQFL(R5),R3 ; Get head of pending queue BVS 200$ ; Queue was empty MovL R10,IRP$L_Media(R3) ; Completion status ClrL IRP$L_Media+4(R3) ; No extra BiCW #IRP$M_Func,IRP$W_Sts(R3) ; Inhibit copy-out JSb G^Com$Post ; Send IRP on its way BrB 110$ ; Round for the next one ; Loop round the pending write queue 200$: PushL R5 ; Save other UCB MovL UCB$L_WriteQueue(R5),R3 ; First entry in write queue BEqlU 300$ ; Empty, -> response queue 220$: MovL (R3),R11 ; Next entry in queue MovL R10,IRP$L_Media(R3) ; Completion status ClrL IRP$L_Media+4(R3) ; No extra MovL IRP$L_UCB(R3),R5 ; Switch in appropriate UCB BiCW #IRP$M_Func,IRP$W_Sts(R3) ; Inhibit copy-out JSb G^Com$Post ; Send IRP on its way MovL R11,R3 ; Get the next one BEqlU 300$ ; No more, -> reponse queue BrB 220$ ; ... and round again .Page ; Loop round the pending response queue 300$: PopL R5 ; Restore other UCB again MovL UCB$L_ResponseQueue(R5),R3 ; First entry in response queue BEqlU 600$ ; Empty, -> response queue 320$: MovL (R3),R11 ; Next entry in queue MovL R10,IRP$L_Media(R3) ; Completion status ClrL IRP$L_Media+4(R3) ; No extra BiCW #IRP$M_Func,IRP$W_Sts(R3) ; Inhibit copy-out JSb G^Com$Post ; Send IRP on its way MovL R11,R3 ; Get the next one BEqlU 600$ ; No more, -> blocked queue BrB 320$ ; ... and round again ; Loop round the blocked request queue 600$: MovL UCB$L_BlockedQueue(R5),R3 ; First entry in response queue BEqlU 400$ ; Empty, -> response queue 620$: MovL (R3),R11 ; Next entry in queue MovL R10,IRP$L_Media(R3) ; Completion status ClrL IRP$L_Media+4(R3) ; No extra BiCW #IRP$M_Func,IRP$W_Sts(R3) ; Inhibit copy-out JSb G^Com$Post ; Send IRP on its way MovL R11,R3 ; Get the next one BEqlU 400$ ; No more, -> response queue BrB 620$ ; ... and round again .Page ; Don't forget to scan the master's WriteQueue, returning anything from the ; other UCB 400$: PopL R5 ; Restore our UCB MovAL UCB$L_WriteQueue(R5),R11 ; Address of our WriteQueue head PushL R5 ; Save our UCB again MovL R9,R5 ; Switch in other UCB again 410$: MovL (R11),R3 ; First/next in queue BEqlU 500$ ; No more, -> CmpL IRP$L_UCB(R3),R5 ; Correct UCB? BNEqU 430$ ; No, skip -> MovL (R3),(R11) ; Unlink IRP MovL R10,IRP$L_Media(R3) ; Completion status ClrL IRP$L_Media+4(R3) ; No extra BiCW #IRP$M_Func,IRP$W_Sts(R3) ; Inhibit copy-out JSb G^Com$Post ; Send IRP on its way BrB 410$ ; Round for the next one 430$: MovL R3,R11 ; On to the next one ... BrB 410$ ; ... and round again ; Zap the queues, then back to our caller 500$: ClrL UCB$L_WriteQueue(R9) ; Zap ClrL UCB$L_ResponseQueue(R9) ; Zap ClrL UCB$L_BlockedQueue(R9) ; Zap PopL R5 ; Restore our UCB PopL R3 ; Restore our IRP EnbInt ; Safe again MovZWL #SS$_Normal,R0 ; Success code Jmp G^Exe$FinishIOC ; All done .Page .Sbttl Start IO routine ;++ ; Start IO routine, called if a read request was issued and there was no ; pending write request. In the usual case the routine will determine that ; there is still nothing to do and will return to its caller, the IO being ; actually performed by the corresponding FDT routine and the IO postprocessing. ; In "rare" cases it may be possible that a read request was queued "at the same ; time as" a write request and that by the time we get here there will be ; something pending for us to process. ; ; Inputs: ; R3 = address of IRP ; R5 = address of UCB ; Registers: ; must preserve all except R0, R1, R2, R4 ; Context: ; System context, fork IPL ;-- TCP_Start: ; First of all, check for any pending zaps. If there are any then we return ; this IRP with an appropriate status. We loop round the UCB list (UCB$L_Link) ; to find anything needing attending to. If we don't find anything then we ; just assume that the count field was wrong (perhaps because of the ; cancel IO routine) so we just zap the count. TstL UCB$L_ZapCount(R5) ; Anything to zap (slaves==0)? BLEq 333$ ; No, try for a read MovL R5,R4 ; Our Link field: we're UCB 0. 100$: MovL UCB$L_Link(R4),R4 ; Next UCB in chain BEqlU 333$ ; No more, -> BBSC #UCB$V_Unload,UCB$L_Sts(R4),110$; Going away, -> BrB 100$ ; Round for the next one -> 110$: DecL UCB$L_ZapCount(R5) ; One fewer now MovZWL #SS$_Hangup,R0 ; Error status MovW UCB$W_Unit(R4),R1 ; Other unit-ID InsV #IO$_Unload,#16,#16,R1 ; Inject "function code" BiCW #IRP$M_Func,IRP$W_Sts(R3) ; Inhibit copy-out ReqCom ; All done 333$: ClrL UCB$L_ZapCount(R5) ; Just in case... MovL UCB$L_WriteQueue(R5),R4 ; Head of pending write queue BNEqU 10$ ; Something to do, -> ; Before we can return to our caller, we have to check whether the reason that ; there was nothing to do was that we were cleared down by the master while ; our request was in flight. If we are the master then this doesn't apply! TstW UCB$W_Unit(R5) ; Are we master? BEqlU 339$ ; Yes, skip it all BBS #UCB$V_Valid,UCB$L_Sts(R5),339$ ; Not cleared, OK -> MovZWL #SS$_Abort,R0 ; Trouble... ClrL R1 ; Nothing extra ReqCom ; Send it back to caller 339$: RSb ; Have to wait, back to caller .Page ; There was a pending write for us of some kind. Decide what it was and ; switch to process it accordingly. Note that anything unexpected will result ; in both IRPs being posted back with BugCheck status. 10$: MovL (R4),UCB$L_WriteQueue(R5) ; Unlink pending IRP MovW IRP$W_Func(R4),R0 ; Obtain "other" function code CmpW R0,#IO$_WritePBlk ; Write? BNeqU 20$ ; No, -> BrB Start_Write 20$: CmpW R0,#IO$_WritEOF ; Close? BNeqU 21$ ; No, -> BrW Start_Close 21$: CmpW R0,#IO$_Create ; Open? BNeqU 22$ ; No, -> BrW Start_Open 22$: CmpW R0,#IO$_ReadPrompt ; Claim? BNeqU 23$ ; No, -> BrW Start_Claim 23$: ; ... fall through ; Unrecognised function code. Bounce both IRPs Start_BugCheck: PushL R5 ; Save "our" UCB MovZWL #SS$_BugCheck,IRP$L_Media(R4) ; Error status ClrL IRP$L_Media+4(R4) ; Nothing extra MovL R4,R3 ; Switch in IRP MovL IRP$L_UCB(R3),R5 ; Switch in other UCB JSb G^Com$Post ; Send it on its way PopL R5 ; Restore our UCB MovZWL #SS$_BugCheck,R0 ; Error status ClrL R1 ; Nothing extra ReqCom ; All done for this one .Page ; Process a write request from the other side. Start_Write: CmpL IRP$L_BCnt(R4),IRP$L_BCnt(R3) ; Compare transfer lengths BGtr 20$ ; Write is longer, -> MovZWL #SS$_Normal,R0 ; Success MovL IRP$L_BCnt(R4),IRP$L_BCnt(R3) ; Note actual length BrB 25$ ; -> common 20$: MovZWL #SS$_BufferOvf,R0 ; Overflow 25$: MovL IRP$L_SVAPTE(R4),R1 ; Source buffer address MovL IRP$L_SVAPTE(R3),R2 ; Destination buffer address PushR #^M ; Save useful stuff MovC3 IRP$L_BCnt(R3),12(R1),12(R2) ; Copy data PopR #^M ; Restore it all again ; Now construct our completion IOSB. We have completion status, transfer ; length, other unit-ID and other function code to assemble. ; R0 already contains the completion status. If the other side is the ; master we use its supplied P3 instead of unit/code for R1. InsV IRP$L_BCnt(R3),#16,#16,R0 ; Inject transfer count MovL IRP$L_UCB(R4),R1 ; Other UCB address MovW UCB$W_Unit(R1),R1 ; Other unit-ID BEqlU 28$ ; Master, -> InsV IRP$W_Func(R4),#16,#16,R1 ; Other function code BrB 29$ ; Rejoin common thread -> 28$: MovL IRP$L_Media+4(R4),R1 ; Restore supplied P3 ; R0 and R1 contain the completion status etc which we are going to return ; to both sides. First we send the other side back, then we send our own. 29$: PushR #^M ; Preserve useful stuff MovQ R0,IRP$L_Media(R4) ; Completion status MovL R4,R3 ; Switch in other IRP MovL IRP$L_UCB(R3),R5 ; Switch in other UCB JSb G^Com$Post ; Send it on its way PopR #^M ; Restore it all again ReqCom ; All done for us too ; Process a close request from the other side. Start_Close: PushL R5 ; Save "our" UCB MovZWL #SS$_Normal,R0 ; Completion status ClrL R1 ; Nothing extra MovL IRP$L_UCB(R4),R5 ; Switch in other UCB MovZWL UCB$W_Unit(R5),-(SP) ; Push other unit-ID MovL R4,R3 ; Switch in other IRP MovQ R0,IRP$L_Media(R3) ; Completion status JSb G^Com$Post ; Send it on its way PopL R1 ; Restore unit-ID (for IOSB) PopL R5 ; Restore our UCB MovL UCB$L_IRP(R5),R3 ; Get our IRP BiCW #IRP$M_Func,IRP$W_Sts(R3) ; Inhibit copy-out MovZWL #SS$_EndOfFile,R0 ; Success code ReqCom ; All done for this one .Page ; Process an open request from the other side. This one should only be on our ; write queue if we are the master. Start_Open: TstW UCB$W_Unit(R5) ; Master? BEqlU 10$ ; Yes, skip -> BrW Start_BugCheck 10$: CmpL IRP$L_BCnt(R4),IRP$L_BCnt(R3) ; Compare transfer lengths BGtr 20$ ; Write is longer, -> MovZWL #SS$_Normal,R0 ; Success MovL IRP$L_BCnt(R4),IRP$L_BCnt(R3) ; Note actual length BrB 25$ ; -> common 20$: MovZWL #SS$_BufferOvf,R0 ; Overflow 25$: MovL IRP$L_SVAPTE(R4),R1 ; Source buffer address MovL IRP$L_SVAPTE(R3),R2 ; Destination buffer address PushR #^M ; Save useful stuff MovC3 IRP$L_BCnt(R3),12(R1),12(R2) ; Copy data PopR #^M ; Restore it all again ; Before we tidy up and complete our request we have to enqueue the other ; IRP on its UCB's ResponseQueue. MovL IRP$L_UCB(R4),R1 ; Address of other UCB MovAL UCB$L_ResponseQueue(R1),R2 ; Address of queue header 30$: TstL (R2) ; Anything in queue BEqlU 35$ ; Nil, -> MovL (R2),R2 ; Next in list BrB 30$ ; ... and round again 35$: MovL R4,(R2) ; Add IRP to the tail ClrL (R4) ; Zap forward pointer ; Now construct our completion IOSB. We have completion status, transfer ; length, privilege, other unit-ID and other function code to assemble. ; R0 already contains the completion status. InsV IRP$L_BCnt(R3),#16,#16,R0 ; Inject transfer count MovW UCB$W_Unit(R1),R1 ; Other unit-ID InsV IRP$W_Func(R4),#16,#16,R1 ; Other function code TstL IRP$L_Media(R4) ; Privileged? BEqlU 40$ ; No, -> BiSW #^X8000,R1 ; Inject privilege 40$: ReqCom ; All done, back to caller .Page ; Process a claim request from the other side. This one should only be on our ; write queue if we are the master. Start_Claim: TstW UCB$W_Unit(R5) ; Master? BEqlU 10$ ; Yes, skip -> BrW Start_BugCheck ; The other IRP has to be taken off our WriteQueue and put on to its own ; ResponseQueue 10$: MovL IRP$L_UCB(R4),R1 ; Address of other UCB MovAL UCB$L_ResponseQueue(R1),R2 ; Address of queue header 30$: TstL (R2) ; Anything in queue BEqlU 35$ ; Nil, -> MovL (R2),R2 ; Next in list BrB 30$ ; ... and round again 35$: MovL R4,(R2) ; Add IRP to the tail ClrL (R4) ; Zap forward pointer ; Now construct our completion IOSB. We have completion status, privilege, ; other unit-ID and other function code to assemble. MovZWL #SS$_Normal,R0 ; Success MovW UCB$W_Unit(R1),R1 ; Other unit-ID InsV IRP$W_Func(R4),#16,#16,R1 ; Other function code BiCW #IO$M_FModifiers,IRP$W_Func(R4) ; Zap the function modifiers TstL IRP$L_Media(R4) ; Privileged? BEqlU 40$ ; No, -> BiSW #^X8000,R1 ; Inject privilege 40$: BiCW #IRP$M_Func,IRP$W_Sts(R3) ; Inhibit copy-out ReqCom .Page .Sbttl Cancel IO routine ;++ ; Cancel routine. If this is the master side then check to see if the refcount ; has gone to zero (the master has died) -- if so then we have to run around ; all the other UCBs returning any pending IRPs and marking the devices offline. ; If the master is still alive then just let any pending IO complete. If this ; isn't the master side then bounce anything with a matching PID and channel ; index. If the reference count has gone to zero then notify the master. ; ; Inputs: ; R2 = channel index number ; R3 = address of IRP ; R4 = address of PCB ; R5 = address of UCB ; R8 = reason code ; Registers: ; must preserve all except R0, R1, R2, R3 ; Context: ; Kernel mode, fork IPL ;-- TCP_Cancel: TstW UCB$W_Unit(R5) ; Master? BNeq 40$ ; No, skip -> BrW 700$ ; -> cancel the master side ; First of all, bounce anything on our ResponseQueue which matches for PID and ; channel index. 40$: PushL R11 ; Must preserve... MovAL UCB$L_ResponseQueue(R5),R11 ; Head of response queue 42$: MovL (R11),R3 ; Anything (more) in queue? BEqlU 90$ ; No, -> CmpL PCB$L_PID(R4),IRP$L_PID(R3) ; Same PID? BNeqU 46$ ; No, -> CmpW R2,IRP$W_Chan(R3) ; Same channel? BNeqU 46$ ; No, -> MovL (R3),(R11) ; Unlink it BiCW #IRP$M_Func,IRP$W_Sts(R3) ; Zap read bit MovZWL #SS$_Abort,IRP$L_Media(R3) ; Error status ClrL IRP$L_Media+4(R3) ; Nothing extra JSb G^Com$Post ; Send it on its way BrB 42$ ; Round again 46$: MovL R3,R11 ; On to the next one ... BrB 42$ ; ... and round again .Page ; Ditto for our BlockedQueue 90$: MovAL UCB$L_BlockedQueue(R5),R11 ; Head of response queue 92$: MovL (R11),R3 ; Anything (more) in queue? BEqlU 50$ ; No, -> CmpL PCB$L_PID(R4),IRP$L_PID(R3) ; Same PID? BNeqU 96$ ; No, -> CmpW R2,IRP$W_Chan(R3) ; Same channel? BNeqU 96$ ; No, -> MovL (R3),(R11) ; Unlink it BiCW #IRP$M_Func,IRP$W_Sts(R3) ; Zap read bit MovZWL #SS$_Abort,IRP$L_Media(R3) ; Error status ClrL IRP$L_Media+4(R3) ; Nothing extra JSb G^Com$Post ; Send it on its way BrB 92$ ; Round again 96$: MovL R3,R11 ; On to the next one ... BrB 92$ ; ... and round again ; Find the master's UCB and search its WriteQueue for anything from us. 50$: MovL UCB$L_CRB(R5),R0 ; CRB address MovL CRB$L_IntD+Vec$L_IDB(R0),R0 ; IDB address MovL IDB$L_UCBLst(R0),R0 ; Master's UCB address MovAL UCB$L_WriteQueue(R0),R11 ; Head of master's WriteQueue 62$: MovL (R11),R3 ; Anything (more) in queue? BEqlU 70$ ; No, -> CmpL PCB$L_PID(R4),IRP$L_PID(R3) ; Same PID? BNeqU 66$ ; No, -> CmpW R11,IRP$W_Chan(R3) ; Same channel? BNeqU 66$ ; No, -> MovL (R3),(R11) ; Unlink it BiCW #IRP$M_Func,IRP$W_Sts(R3) ; Zap read bit (not set anyway?) MovZWL #SS$_Abort,IRP$L_Media(R3) ; Error status ClrL IRP$L_Media+4(R3) ; Nothing extra JSb G^Com$Post ; Send it on its way BrB 62$ ; Round again 66$: MovL R3,R11 ; On to the next one ... BrB 62$ ; ... and round again 70$: PopL R11 ; Restore.... .Page ; Now check the UCB reference count. If it has gone to zero then we have to ; tell the master by forming a pseudo-IRP and queuing it. TstW UCB$W_RefC(R5) ; Anyone still around? BNEqU 500$ ; Yes, skip -> BrB 100$ ; No, so go and tell the master ; Finally, we deal with the pending read request if any. If it's from our ; channel then we have to complete it as though it were a normal completion ; in order that the next request on the queue (if any) is started. 500$: BBC #UCB$V_Bsy,UCB$L_Sts(R5),540$ ; Idle, -> MovL UCB$L_IRP(R5),R3 ; Get pending IRP CmpL PCB$L_PID(R4),IRP$L_PID(R3) ; Same PID? BNeqU 540$ ; No, -> CmpW R2,IRP$W_Chan(R3) ; Same channel? BNeqU 540$ ; No, -> BiCW #IRP$M_Func,IRP$W_Sts(R3) ; Zap read bit MovZWL #SS$_Abort,UCB$Q_IOSB(R5) ; Error status ClrL UCB$Q_IOSB+4(R5) ; Nothing extra PushL R4 ; Save PCB BSbB 550$ ; -> complete other side PopL R4 ; Restore PCB 540$: RSb ; Nothing more to do 550$: Fork ; Acquire our own context MovQ UCB$Q_IOSB(R5),R0 ; Restore status ReqCom .Page ; All channels to our UCB have now been deassigned, so we'll have to tell ; the master. Mark ourselves offline, etc, in order to avoid any nasty ; timing problems, then find its UCB again. 100$: BiCL #,- UCB$L_Sts(R5) ; Device is not online, etc PushL R4 ; Preserve our PCB MovL UCB$L_CRB(R5),R0 ; CRB address MovL CRB$L_IntD+Vec$L_IDB(R0),R0 ; IDB address MovL IDB$L_UCBLst(R0),R4 ; Master's UCB address TstW UCB$W_RefC(R4) ; Any master channels? BGtr 101$ ; Yes, carry on -> PopL R4 ; Restore PCB BrB 500$ ; -> tidy up 101$: BBC #UCB$V_Bsy,UCB$L_Sts(R4),200$ ; Nothing pending, -> TstL UCB$L_WriteQueue(R4) ; Anything else queued? BNeqU 200$ ; Yes, we'll have to wait MovZWL #SS$_Hangup,UCB$Q_IOSB(R4) ; Error status MovW UCB$W_Unit(R5),UCB$Q_IOSB+4(R4) ; Other unit-ID MovW #IO$_Unload,UCB$Q_IOSB+6(R4) ; Other "function code" PushL R5 ; Preserve our UCB MovL R4,R5 ; Switch in other UCB BSbB 150$ ; -> complete master PopL R5 ; Restore our UCB PopL R4 ; Restore our PCB BrW 500$ ; All done, back for current IRP 150$: Fork ; Acquire our own context MovQ UCB$Q_IOSB(R5),R0 ; Restore master's IOSB MovL UCB$L_IRP(R5),R3 ; Get our IRP BiCW #IRP$M_Func,IRP$W_Sts(R3) ; Inhibit copy-out ReqCom ; All done for master ; We'll have to wait. Bump the master's ZapCount and set Unload in our ; status field. The next time the master tries to do a read it'll notice and ; have a look for us. 200$: BiSL #UCB$M_Unload,UCB$L_Sts(R5) ; Note we've gone away IncL UCB$L_ZapCount(R4) ; Indicate something gone PopL R4 ; Restore our PCB BrW 500$ ; All done, back for current IRP .Page ; Master side cancel routine. Ignore it unless the master's reference count ; has gone to zero. If it has, then loop round all the UCBs bouncing everything ; in sight, and turn off all the online/valid bits. 700$: ; TstW UCB$W_RefC(R5) ; Everything gone? ; BEql 710$ ; Yes, -> ; RSb ; No, ignore it all ; Save everything useful, then for each UCB in turn (found by chaining down ; the Link field) return everything on all its queues with Hangup status. ; For all UCBs other than the master mark the unit offline and unavailable. 710$: PushR #^M ; Save everything of interest 720$: TstW UCB$W_Unit(R5) ; Master? BEql 730$ ; Yes, skip -> BiCL #,- UCB$L_Sts(R5) ; Device is not on line 730$: BSbB Cancel_UCB ; Bounce everything on this one MovL UCB$L_Link(R5),R5 ; Next one BNeqU 720$ ; Not the last, round again -> PopR #^M ; Restore it all again RSb ; All done ; Bounce everything on one UCB, the address of which is in R5. We have to ; save R5, but we can scribble elsewhere (it's been saved for us already). ; First deal with the pending read (if any) and loop round the read queue Cancel_UCB: BBCC #UCB$V_Bsy,UCB$L_Sts(R5),200$ ; No pending read, -> MovL UCB$L_IRP(R5),R3 ; Get active IRP MovZWL #SS$_Hangup,IRP$L_Media(R3) ; Error status ClrL IRP$L_Media+4(R3) ; No extra BiCW #IRP$M_Func,IRP$W_Sts(R3) ; Inhibit copy-out JSb G^Com$Post ; Send IRP on its way 110$: RemQue @UCB$L_IOQFL(R5),R3 ; Get head of pending queue BVS 200$ ; Queue was empty MovZWL #SS$_Hangup,IRP$L_Media(R3) ; Completion status ClrL IRP$L_Media+4(R3) ; No extra BiCW #IRP$M_Func,IRP$W_Sts(R3) ; Inhibit copy-out JSb G^Com$Post ; Send IRP on its way BrB 110$ ; Round for the next one .Page ; Loop round the pending write queue 200$: PushL R5 ; Save our UCB MovL UCB$L_WriteQueue(R5),R3 ; First entry in write queue BEqlU 300$ ; Empty, -> response queue 220$: MovL (R3),R4 ; Next entry in queue MovZWL #SS$_Hangup,IRP$L_Media(R3) ; Error status ClrL IRP$L_Media+4(R3) ; No extra BiCW #IRP$M_Func,IRP$W_Sts(R3) ; Inhibit copy-out MovL IRP$L_UCB(R3),R5 ; Switch in appropriate UCB JSb G^Com$Post ; Send IRP on its way MovL R4,R3 ; Get the next one BEqlU 300$ ; No more, -> response queue BrB 220$ ; ... and round again ; Loop round the pending response queue 300$: PopL R5 ; Restore our UCB MovL UCB$L_ResponseQueue(R5),R3 ; First entry in write queue BEqlU 500$ ; Empty, -> response queue 320$: MovL (R3),R4 ; Next entry in queue MovZWL #SS$_Hangup,IRP$L_Media(R3) ; Error status ClrL IRP$L_Media+4(R3) ; No extra BiCW #IRP$M_Func,IRP$W_Sts(R3) ; Inhibit copy-out JSb G^Com$Post ; Send IRP on its way MovL R4,R3 ; Get the next one BEqlU 500$ ; No more, -> response queue BrB 320$ ; ... and round again ; Loop round the blocked queue (not for the master (no blocked queue)). 500$: TstW UCB$W_Unit(R5) ; Master? BEql 400$ ; Yes, skip, -> MovL UCB$L_BlockedQueue(R5),R3 ; First entry in write queue BEqlU 400$ ; Empty, -> response queue 520$: MovL (R3),R4 ; Next entry in queue MovZWL #SS$_Hangup,IRP$L_Media(R3) ; Error status ClrL IRP$L_Media+4(R3) ; No extra BiCW #IRP$M_Func,IRP$W_Sts(R3) ; Inhibit copy-out JSb G^Com$Post ; Send IRP on its way MovL R4,R3 ; Get the next one BEqlU 400$ ; No more, -> response queue BrB 520$ ; ... and round again ; Finally, zap the queues and return 400$: ClrL UCB$L_WriteQueue(R5) ClrL UCB$L_ResponseQueue(R5) ClrL UCB$L_BlockedQueue(R5) RSb TCP_End: ; End of driver .End