$MACRO $$TIM .ident /#@1/ ;internal witchcraft for setting date into ident fld $ENDM / setlab aed_driver ;more magic (for label generation) .title aed_driver ;+ ; ; The following sequence is necessary to build the driver from this ; file. First notice that the preprocessor mp.exe must be run to ; create a macro32 program. ; ; ; $mcr dr:[levy.mpvax]mp aedriver.mar=aedriver.mac/lm/nb/nl ; $macro aedriver.mar+sys$library:lib.mlb/library ; $link /notrace aedriver,aedriver.op/opt,sys$system:sys.stb/sel ; ; with aedriver.op containing only: ; ; base=0 ; ; ; Then the usual loading sequence is performed (for example:) ; (the below copies the driver into sysexe first) ; ; $set noon ; $pip [sysexe]aedriver.exe/nv=aedriver.exe ; $pip [sysexe]aedriver.exe/pu ; $MCR SYSGEN ; RELOAD AEDRIVER.EXE ; SHO /DEVICE=AEDRIVER ; CONNECT AEA0/VECTOR=%O120/CSR=%O764040/ADAPTER=3 ; SHO /DEVICE=AEDRIVER ; ; Some preprocessor notes: ; the ~ lines are necessary, means output exact ; needed with all dec macros and continuation lines ; the case stuff needs breaks like C ; the if then else fi or`s & and`s eval right to left ; index mode [] must be output with the ~ ; case gens brb and if ... fi gen brw's ; the bits is: bits[target,start,number] and can be on ; both sides, but always look at output code to be sure ; constants can be nnn or 0nnn to make # or #^o ; loop keys can be upto, downto, upthru, downthru, but the step ; parameter is necessary if using downto or downthru (step -n) ; comment semicolon must have whitespace between it and code ; ; Aed 512 driver. ; ; Disclaimer ; ; This driver handles (just barely) the aed 512 frame buffer. At the ; current writing, the author does not fully understand how the 512 ; really operates (I don't believe the designers do either) and thus ; I have little confidence in the ability of this driver to work ; very reliably. (it does however work on aed 512b.v88-91) ; ; Good luck! ; Eric Levy (jpl) ; 14-nov-81 ; ; The following are some Gotcha's on this device. ; When reading the csr, don't use bit test instructions since ; the READ will cause the csr status bits to go low. Also, after ; you read it and they were high, you must spin reading until they ; go low again - software does handshake. (Use movw to get csr, then ; you can check the bits with a bit test) ; ; Dma is really wierd. Sequence is: ; 1. set up status register (mem ext bits, interupt enable) ; 2. set up addr, then word count, then issue the command thru the ; csr (read/write direct, or read/write area of interest, or ; command list) ; 3. This is the catch, the FIRST interupt is immediate (almost) ; it means the command thru the csr was received, then when ; the word count goes to zero, the SECOND interupt hits. After ; this interupt hits send out the stop dma command (thru the csr) ; 4. Now one needs to wait for a THIRD interupt from the output of ; the stop dma command. ; 5. Under no circumstances should you ever read the csr or status ; register during the dma or you will screw it all up. ; ; 6. On command dma, there is need for a forced delay (fixed length) ; since their seems to be a glich in aed dma of commands. Also, the ; user should never dma a multiple byte command across two dma's ; and should always round the buffer up to an even number of bytes ; by issuing 1 more 27(decimal) nop command at the end. And, to ; insure that command dma works, the buffer should always be extended ; to two more commands of 27. This is because the wc to zero interupt ; only means wc=0 and NOT that the last commands have been executed. ; Using the 27's means that they should be executed very quickly and ; only a short delay in the driver is necessary. ; ; Note that device reset does not interupt, you must use the timeout. ; ; Don't forget that the exe$read/write routines lock memory via a ; BYTE count and the hardware needs a WORD count. ; ; The scd command must output first and then the word count ; but if output is pixel data, then reverse (word count then csr) ; ; I could not come up with any really clean cancel code. There ; especially appears to be problems when a dma of commands is ; canceled. In some cases it seems necessary to do busy waits ; for quite some time or else the device will hang up on the ; next user. There is a label maxbusywait which can be ; adjusted. The busywait routine (not the only user of the ; label) never spins with interupts disabled, but does run at ; fork level so it is a hog. I checked the maximum value ; (times thru the busy wait loop) and rarely saw it more than ; 100. Too little and things might not go right, (at 50 it ; definitely screwed up) ; ; Current hack is to NOT clear word count on a cancel as this ; seems to screw up sometimes and never did any good. ; ; On cancel i/o, as when the process is being aborted, we appear to ; enter the cancel i/o routine twice (dma operations at least) and ; the cancel dma and timeout dma each are activated once. I don't ; know why this happens, but in order to kill a dma we must send ; back the sda command. But if we do this during the dma itself we ; screw up the terminal. Setting the word count to zero ouselves did ; not work. The only thing that works nicely seems to be letting the ; cancel and timeout occur for dma and during timeout we actually do ; the stop dma after the dust has settled. ; ; After the above cancel nonsence was discovered, I decided that it ; would be best to not purge the data path twice, so the cleanup of ; dma checks the ucb flag doing_dma now; Release resources just once. ; ; ; This driver has many hacks and busy waits. In order to debug it ; it was necessary to provide a qio just to return internal ; counters. All the counters are lablels prefixed with num_ and ; never do anything other than help debug this driver. ; ; Conclusion: ; ; a. Use Unix; trash vms and its assembly language mentality ; b. Buy a better frame buffer ;- $CRBDEF ; Channel request block $DCDEF ; Device classes and types $DDBDEF ; Device data block $DEVDEF ; Device characteristics $IDBDEF ; Interrupt data block $IODEF ; I/O function codes $IPLDEF ; Hardware IPL definitions $IRPDEF ; I/O request packet $SSDEF ; System status codes $UCBDEF ; Unit control block $VECDEF ; Interrupt vector block ; ; Local symbols ; ; ; Argument list (AP) offsets for device-dependent QIO parameters ; ~p1 = 0 ; First QIO parameter ~p2 = 4 ; Second QIO parameter ~p3 = 8 ; Third QIO parameter ~p4 = 12 ; Fourth QIO parameter ~p5 = 16 ; Fifth QIO parameter ~p6 = 20 ; Sixth QIO parameter ; ; Other constants ; ~ ae_def_bufsiz = 1024 ; Default buffer size ~ ae_timeout_sec= 3 ; 3 second device timeout ~ ae_timeout_sec_dma= 5 ; 20 second device timeout for dma ~ ae_num_regs = 4 ; Device has 4 registers ~ ie = ^o100 ; interupt enable bit ~ ie = ^o100 ; interupt enable bit ~ io$_prgio = io$_access ; prgio function code ~ pbr = 27 ; handshake code back to aed ~ bassm = ^o40000 ; byte assembled bit in csr ~ busy = ^o100000 ; terminal busy bit in csr ~ maxbusywait = 500 ; maximum times in loop in busy waits ~ delay_time = 50 ; delay kludge ~ wrd = 70 ;write raster direct ~ rrd = 64 ;read " ~ sda = 27 ;stop direct ~ wda = 46 ;write direct aoi ~ rda = 47 ;read " ~ scd = 42 ;send commands ; 5432109876543210 ~ dmawrite = ^b0000001000000000 ~ dmaread = ^b0010001000000000 ; ; Definitions that follow the standard UCB fields ; ~ $DEFINI UCB ; Start of UCB definitions ~ .=UCB$K_LENGTH ; Position at end of UCB ~$DEF ucb$l_p2 ; The p2 parm .blkl 1 ~$DEF ucb$l_p3 ; The p3 parm .blkl 1 ~$DEF ucb$l_p4 ; The p4 parm .blkl 1 ~$DEF ucb$l_p5 ; The p5 parm .blkl 1 ~$DEF ucb$l_p6 ; The p6 parm .blkl 1 ~$DEF ucb$l_doingdma ; some data .blkl 1 ~$DEF UCB$K_AE_UCBLEN ; Length of extended UCB ; ; Bit positions for device-dependent status field in UCB ; ~ $VIELD UCB,0,<- ; Device status ~ ,- ; First bit ~ ,- ; Second bit ~ > ~ $DEFEND UCB ; End of UCB definitions ; ; Device register offsets from CSR address ; ~ $DEFINI AE ; Start of status definitions ~$DEF AE_gdcs ; Control/status .BLKW 1 ~$DEF AE_gdps ; interface setup .BLKW 1 ~$DEF AE_gdba ; Buffer address .BLKW 1 ~$DEF AE_gdwc ; Word count .BLKW 1 ~ $DEFEND AE ; End of device register ~ ; definitions. ; ; Driver prologue table ; ~ DPTAB - ; DPT-creation macro ~ END=AE_END,- ; End of driver label ~ ADAPTER=UBA,- ; Adapter type ~ UCBSIZE=,- ; Length of UCB ~ NAME=AEDRIVER ; Driver name ~ DPT_STORE INIT ; Start of load ~ ; initialization table ~ DPT_STORE UCB,UCB$B_FIPL,B,8 ; Device fork IPL ~ DPT_STORE UCB,UCB$B_DIPL,B,22 ; Device interrupt IPL ~ DPT_STORE UCB,UCB$L_DEVCHAR,L,<- ; Device characteristics ~ DEV$M_SHR!- ; available ~ DEV$M_AVL!- ; available ~ DEV$M_IDV!- ; input device ~ DEV$M_ODV> ; output device ~ DPT_STORE UCB,UCB$B_DEVCLASS,- ; Sample device class ~ B,DC$_realtime ~ DPT_STORE UCB,UCB$W_DEVBUFSIZ,W,- ; Default buffer size ~ AE_DEF_BUFSIZ ~ DPT_STORE REINIT ; Start of reload ~ ; initialization table ~ DPT_STORE DDB,DDB$L_DDT,D,AE$DDT ; Address of DDT ~ DPT_STORE CRB,CRB$L_INTD+4,D,- ; Address of interrupt ~ AE_INTERRUPT ; service routine ~ DPT_STORE CRB,- ; Address of controller ~ CRB$L_INTD+VEC$L_INITIAL,- ; initialization routine ~ D,AE_CONTROL_INIT ~ DPT_STORE CRB,- ; Address of device ~ CRB$L_INTD+VEC$L_UNITINIT,- ; unit initialization ~ D,AE_UNIT_INIT ; routine ~ DPT_STORE END ; End of initialization ~ ; tables ; ; Driver dispatch table ; ~ DDTAB - ; DDT-creation macro ~ DEVNAM=AE,- ; Name of device ~ START=AE_START,- ; Start I/O routine ~ FUNCTB=AE_FUNCTABLE,- ; FDT address ~ CANCEL=AE_CANCEL,- ; Cancel I/O routine ~ REGDMP=AE_REG_DUMP ; Register dump routine ; ; Function decision table ; ~AE_FUNCTABLE: ; FDT for driver ~ FUNCTAB ,- ; Valid I/O functions ~ ; Set device chars. ~ FUNCTAB , ; No buffered functions ~ FUNCTAB ae_fdt_routine1,- ; FDT read routine for ~ ; Set device chars. ~ FUNCTAB +EXE$READ,- ; FDT read routine for ~ ; and read physical. ~ FUNCTAB +EXE$WRITE,- ; FDT write routine for ~ ; and write physical. ~ FUNCTAB +EXE$SETMODE,- ; FDT set mode routine ~ ; set mode. ~ FUNCTAB +EXE$ZEROPARM,- ; FDT for zero parameters ~ ; for prgio ;++ ; AE_CONTROL_INIT, Readies controller for I/O operations ; ; Functional description: ; ; The operating system calls this routine in 3 places: ; ; at system startup ; during driver loading and reloading ; during recovery from a power failure ; ; Inputs: ; ; R4 - address of the CSR (controller status register) ; R5 - address of the IDB (interrupt data block) ; R6 - address of the DDB (device data block) ; R8 - address of the CRB (channel request block) ; ; Outputs: ; ; The routine must preserve all registers except R0-R3. ; ;-- ~AE_CONTROL_INIT: ; Initialize controller incl num_con_init ~ RSB ; Return ;++ ; AE_UNIT_INIT, Readies unit for I/O operations ; ; Functional description: ; ; The operating system calls this routine after calling the ; controller initialization routine: ; ; at system startup ; during driver loading ; during recovery from a power failure ; ; Inputs: ; ; R4 - address of the CSR (controller status register) ; R5 - address of the UCB (unit control block) ; ; Outputs: ; ; The routine must preserve all registers except R0-R3. ; ;-- ~AE_UNIT_INIT: ; Initialize unit incl num_init ; jsb g^ini$brk ~ BISW #UCB$M_ONLINE, - ~ UCB$W_STS(R5) ; Set unit online ~ RSB ; Return ;++ ; AE_FDT_ROUTINE1, FDT routine for prgio function ; ; Functional description: ; ; Put parameter 3 into the spare word in the ucb ; ; Inputs: ; ; R0-R2 - scratch registers ; R3 - address of the IRP (I/O request packet) ; R4 - address of the PCB (process control block) ; R5 - address of the UCB (unit control block) ; R6 - address of the CCB (channel control block) ; R7 - bit number of the I/O function code ; R8 - address of the FDT table entry for this routine ; R9-R11 - scratch registers ; AP - address of the 1st function dependent QIO parameter ; ; Outputs: ; ; The routine must preserve all registers except R0-R2, and ; R9-R11. ; ;-- ~AE_FDT_ROUTINE1: ; FDT routine1 movl p2(ap),ucb$l_p2(r5) ; save p2 word movl p3(ap),ucb$l_p3(r5) ; save p3 word movl p4(ap),ucb$l_p4(r5) ; save p4 word too movl p5(ap),ucb$l_p5(r5) ; save p5 word too movl p6(ap),ucb$l_p6(r5) ; save p6 word too RSB ; Return ;++ ; AE_START - Start a transmit, receive, set mode, or prgio operation ; ; Functional description: ; ; ; Functions supported ;------------------------------------------------------------------------------ ; io$_read dma read ;------------------------------------------------------------------------------ ; p1 p2 p3 ; -- -- -- ; buffer size dvma or aio command to issue ;------------------------------------------------------------------------------ ; io$_write dma write ;------------------------------------------------------------------------------ ; p1 p2 p3 ; -- -- -- ; buffer size dvma or aio command to issue ;------------------------------------------------------------------------------ ; io$_access (p1,p2 not used) programmed io functions ;------------------------------------------------------------------------------ ; p3 p4 ; -- -- ; Data going out 0 Normal parallel byte out ; ; ; Terminal # 1 Selects the terminal we want ; ; ; n.a. 2 Does a reset on selected terminal ; ; ; Data going out 3 Parallel byte out, then byte in, does ; the handshake, 2nd stat word has input ; ; n.a. 4 Gets input byte, does handshake, no ; interupts ; ; stat value 100 Returns stats values (for debugging) ; Stats are longwords at bottom of driver ; stored in driver itself. Most are ; num_xxx symbols (stats to estats) ;------------------------------------------------------------------------------ ; Inputs: ; ; R3 - address of the IRP (I/O request packet) ; R5 - address of the UCB (unit control block) ; ; Outputs: ; ; R0 - 1st longword of I/O status: contains status code and ; number of bytes transferred ; R1 - 2nd longword of I/O status: device-dependent ; ; The routine must preserve all registers except R0-R2 and R4. ; ;-- ~AE_START: ;Process an I/O packet incl num_start reqpchan ;Get the controller and r4 := csr movzwl irp$w_func(r3),r1 ;get entire function code movw r1,ucb$w_func(r5) ;save func in ucb extzv #io$v_fcode,#io$s_fcode,r1,r2 ;extract function field ifb r2 = #io$_writevblk or r2 = #io$_writelblk or r2 = #io$_writepblk bitl 1,ucb$l_p2(r5) ;is the count even if ne movl #ss$_badparam,r0 bits[r0,16,16] := 2 ;par number movzwl ucb$l_p2(r5),r1 ;and value reqcom fi incl num_dmas clrl r0 movw ucb$l_p2(r5),r0 ;get count if r0 = 0 clrl r1 movl #ss$_normal,r0 reqcom fi clrl r0 movb ucb$l_p3(r5),r0 ;get function code to use if r0 ne #wrd and r0 ne #wda and r0 ne #scd movl ucb$l_p3(r5),r1 movl #ss$_ivmode,r0 reqcom fi call dmasetup ;allocate resources call bsywait ;just in case dsbint ;disable interupts call dmaload ;load the dma unibus registers clrl r0 movb ucb$l_p3(r5),r0 ;get function code to use bisl #dmawrite,r0 movl r1,num_wc movl r0,num_csr ifb ucb$l_p3(r5) = #scd movw r0,(r4) ;output command first if scd movw r1,ae_gdwc(r4) ;and load wc to start it all else movw r1,ae_gdwc(r4) ;for pixels, reverse order movw r0,(r4) ; fi wfikpch ae_timeout_dma,#ae_timeout_sec_dma ;get first interupt dsbint ;prepare to wait again wfikpch ae_timeout_dma,#ae_timeout_sec_dma ;get second interupt clrl r0 movw ae_gdwc(r4),r0 if r0 ne 0 incl num_int3 movw num_wc,num_wcbefore fi iofork call bsywait ifb ucb$l_p3(r5) = #scd call delay fi dsbint ;prepare to wait again movw #sda,(r4) ;stop transfer wfikpch ae_timeout_dma,#ae_timeout_sec_dma iofork call bsywait movl irp$l_ucb(r3),r5 ;get ucb address for unit call dmacleanup call bsywait movw ae_gdps(r4),num_psdma movw ae_gdwc(r4),num_wcdma if num_wcdma ne 0 incl num_nzwc fi clrw ae_gdps(r4) ; disable interupts on aed movl #ss$_normal,r0 movzwl ucb$l_p2(r5),r1 reqcom elseifb r2 = #io$_readvblk or r2 = #io$_readlblk or r2 = #io$_readpblk bitl 1,ucb$l_p2(r5) ;is the count even if ne movl #ss$_badparam,r0 bits[r0,16,16] := 2 ;par number movzwl ucb$l_p2(r5),r1 ;and value reqcom fi incl num_dmas clrl r0 movw ucb$l_p2(r5),r0 ;get count if r0 = 0 clrl r1 movl #ss$_normal,r0 reqcom fi clrl r0 movb ucb$l_p3(r5),r0 ;get function code to use if r0 ne #rrd and r0 ne #rda movl ucb$l_p3(r5),r1 movw #ss$_ivmode,r0 reqcom fi call dmasetup ;allocate resources call bsywait ;just in case dsbint ;disable interupts call dmaload ;load the dma unibus registers clrl r0 movb ucb$l_p3(r5),r0 ;get function code to use bisl #dmaread,r0 movl r1,num_wc movl r0,num_csr movw r1,ae_gdwc(r4) ;for pixels in movw r0,(r4) ; wfikpch ae_timeout_dma,#ae_timeout_sec_dma ;get first interupt dsbint ;prepare to wait again wfikpch ae_timeout_dma,#ae_timeout_sec_dma ;get second interupt clrl r0 movw ae_gdwc(r4),r0 if r0 ne 0 incl num_int3 movw num_wc,num_wcbefore fi iofork call bsywait dsbint ;prepare to wait again movw #sda,(r4) ;stop transfer wfikpch ae_timeout_dma,#ae_timeout_sec_dma iofork call bsywait movl irp$l_ucb(r3),r5 ;get ucb address for unit call dmacleanup call bsywait movw ae_gdps(r4),num_psdma movw ae_gdwc(r4),num_wcdma if num_wcdma ne 0 incl num_nzwc fi clrw ae_gdps(r4) ; disable interupts on aed movl #ss$_normal,r0 movzwl ucb$l_p2(r5),r1 reqcom elseifb r2 eq #io$_prgio ;is it a prgio function clrl r2 ;just the low byte here movb ucb$l_p4(r5),r2 ;get the p4 value if r2 = 0 ;its a output byte loop for r2 = 1 to #maxbusywait movw (r4),r1 ;get csr bitw #busy,r1 ;is it busy if eq break fi next r2 if r2 gt #maxbusywait-1 movl #ss$_timeout,r0 ;and not successful code movl #-10,r1 reqcom ;and out we go fi clrb ucb$l_p3+1(r5) ; the saved p3 value is the byte dsbint ; disable all interupts bisw #ie,ae_gdps(r4) ; enable aed interupts movw ucb$l_p3(r5),(r4) ; output the word to the csr elseif r2 = 1 ; 1 means do the select this time movl ucb$l_p3(r5),r0 ;get the terminal(s) to select ;09876543210 bisl #^b11000000000,r0 ;add the select bit dsbint ; disable all interupts bisw #ie,ae_gdps(r4) ; enable aed interupts movw r0,(r4) ; output the select elseif r2 = 2 ; 2 means do a reset ;09876543210 bisl #^b01100000000,r0 ;add the select bit dsbint ; disable all interupts bisw #ie,ae_gdps(r4) ; enable aed interupts movw r0,(r4) ; output the reset ;but reset will timeout elseif r2 = 3 ;output then read back a byte loop for r2 = 1 to #maxbusywait movw (r4),r1 ;get csr bitw #busy,r1 ;is it busy if eq break fi next r2 if r2 gt #maxbusywait-1 movl #ss$_timeout,r0 ;and not successful code movl #-10,r1 reqcom ;and out we go fi clrb ucb$l_p3+1(r5) ; the saved p3 value is the byte dsbint ; disable all interupts bisw #ie,ae_gdps(r4) ; enable aed interupts movw ucb$l_p3(r5),(r4) ; output the word to the csr elseif r2 = 4 ;get parallel in, busy wait loop for r2 = 1 to #maxbusywait movw (r4),r1 ;do a read of the csr bitw #bassm,r1 ;is it ready if ne ;break if the bit is on (ready) break fi next r2 if r2 gt #maxbusywait-1 ;if we broke, r2 is small ; else, we went thru it all (timeout) ; return the csr value anyway movl #-2,r1 movl #ss$_timeout,r0 ;but a not successful code reqcom fi ;if no timeout then we loop for r2 = 1 to #maxbusywait ;must wait till it lowers again. movw (r4),r0 ;do a read of the csr bitw #bassm,r0 ;is it ready if eq ;eq means its low again break fi next r2 if r2 gt #maxbusywait-1 ;if we broke, r2 is small ; else, we went thru it all (timeout) ; return the csr value anyway movl #-3,r1 movl #ss$_timeout,r0 ;but a not successful code reqcom fi movw #pbr,(r4) ;send back the handshake code movl #ss$_normal,r0 ;and not successful code reqcom elseif r2 = 100 ;gather statistics (debugging) decl num_start ;don't count this entry in stats clrl r0 movb ucb$l_p3(r5),r0 ;get function code to use moval stats,r1 if r0 lt 0 or r0 ge #</4> movl r0,r1 movl #ss$_ivmode,r0 reqcom fi ~ movl (r1)[r0],r1 ;get the value movl #ss$_normal,r0 reqcom else movl r2,r1 movl #ss$_ivmode,r0 reqcom fi else incl num_badp1 ;note occurance movl #ss$_badparam,r0 ;and not successful code bits[r0,16,16] := 1 movl r2,r1 reqcom ;and out we go fi wait_for=. ;wait for programmed io interupts wfikpch ae_timeout,#ae_timeout_sec ; ; Well, after the above we just lost everything but r3 and r4 ; only dec could do this kind of bullshit ; r3 -> irp packet (this can get us to the ucb) ; r4 -> csr ; ; After a transfer completes successfully, ; return a success status code. ; movw #ie,ae_gdps(r4) ; enable interupts IOFORK movl irp$l_ucb(r3),r5 ;get ucb address for unit clrl r1 ;get the function code of request movb ucb$l_p4(r5),r1 select case r1 of ;depending on p4 case 0 or case 2 clrl r1 clrl r0 movw #ss$_normal,r0 ; load a success code into r0. call bsywait break case 1 r1 := ucb$l_p3(r5) ; return terminal number clrl r0 movw #ss$_normal,r0 ; load a success code into r0. break case 3 ;now return the byte for him movw (r4),r1 ;do a read of the csr ;if no timeout then we loop for r2 = 1 to #maxbusywait ;must wait till it lowers again. movw (r4),r0 ;do a read of the csr bitw #bassm,r0 ;is it ready if eq ;eq means its low again break fi next r2 if r2 gt #maxbusywait-1 movl #-6,r1 movl #ss$_timeout,r0 break fi movw #pbr,(r4) ;send back the handshake code movl #ss$_normal,r0 ;and successful code break default clrl r0 movl #-1,r1 ;so we can tell movw #ss$_normal,r0 break esac ; ; Call I/O postprocessing. ; COMPLETE_IO: ; Driver processing is finished. REQCOM ; Complete I/O. ; ; Dma setup ; input is context after entry to start io routine ; ; requests data path and sets up uba ; computes the unibus transfer address into low word of r1 ; moves the high 2 bits of the address into r2 ; dmasetup: push r3 push r4 push r5 reqdpr ;uba data path reqmpr ;uba map registers loaduba ;load em movl #1,ucb$l_doingdma(r5) movzwl ucb$w_boff(r5),r1 ;byte offset in 1st page of transfer movl ucb$l_crb(r5),r2 ;addr of crb insv crb$l_intd+vec$w_mapreg(r2),#9,#9,r1 ;insert page number extzv #16,#2,r1,r2 ;extract bits 17:16 of bus address pop r5 pop r4 pop r3 rsb ; ; Dma cleanup ; dmacleanup: pushr #^m clrl num_flag if ucb$l_doingdma(r5) ne 0 purdpr relmpr reldpr clrl ucb$l_doingdma(r5) else incl num_clean2 fi popr #^m rsb ; ; Dma register load ; input, r1 = address, r2 = addr ext bits r4 = csr address ; loads the address and enables interupts returns r1=word count dmaload: push r0 movw r1,ae_gdba(r4) ;set up the addr reg clrl r1 movzwl ucb$l_p2(r5),r1 ;get count in bytes ashl #-1,r1,r1 ;divide by two to get words mnegl r1,r1 ;get negative of count ;for loading into aed register ;;;; decl r1 ;plus one more (??) clrl r0 bits[r0,12,2] := r2 ;prepare interface setup movl #1,num_flag bisl #ie,r0 ; with addr ext and int enable bits movl r0,num_ps movw r0,ae_gdps(r4) ;and move em out pop r0 rsb ; ; Device timeout handling. Return an error status code. ; ae_timeout_dma: ; Timeout handling incl num_seq movl num_seq,num__tmo incl num_timeout_dma push r4 movl ucb$l_crb(r5),r4 ;get csr movl @crb$l_intd+vec$l_idb(r4),r4 movw ae_gdps(r4),num_pstmo movw #0,ae_gdwc(r4) ;try to zero word count movw #0,ae_gdps(r4) ; clear status, inhibit interupts movw ae_gdwc(r4),num_wctmo call bsywait movw #sda,(r4) ;send stop dma pop r4 setipl ucb$b_fipl(r5) ; Lower to driver fork IPL call dmacleanup movzwl #ss$_timeout,r0 ; Return error status. brw complete_io ; Call I/O postprocessing. ae_timeout: ; Timeout handling incl num_timeout push r4 movl ucb$l_crb(r5),r4 ;get csr movl @crb$l_intd+vec$l_idb(r4),r4 movw #0,ae_gdps(r4) ; clear status, inhibit interupts pop r4 setipl ucb$b_fipl(r5) ; Lower to driver fork IPL movzwl #ss$_timeout,r0 ; Return error status. brw complete_io ; Call I/O postprocessing. ;++ ; AE_INTERRUPT, Analyzes interrupts, processes solicited interrupts ; ; Functional description: ; ; The sample code assumes either ; ; that the driver is for a single-unit controller, and ; that the unit initialization code has stored the ; address of the UCB in the IDB; or ; ; that the driver's start I/O routine acquired the ; controller's channel with a REQPCHANL macro call, and ; then invoked the WFIKPCH macro to keep the channel ; while waiting for an interrupt. ; ; Inputs: ; ; 0(SP) - pointer to the address of the IDB (interrupt data ; block) ; 4(SP) - saved R0 ; 8(SP) - saved R1 ; 12(SP) - saved R2 ; 16(SP) - saved R3 ; 20(SP) - saved R4 ; 24(SP) - saved R5 ; 28(SP) - saved PSL (program status longword) ; 32(SP) - saved PC ; ; The IDB contains the CSR address and the UCB address. ; ; Outputs: ; ; The routine must preserve all registers except R0-R5. ; ;-- ~ae_interrupt: ; Service device interrupt incl num_seq movl num_seq,num__int incl num_interupts ~ movl @(sp)+,r4 ; Get address of IDB and remove ~ ; pointer from stack. ~ movl idb$l_owner(r4),r5 ; Get address of device owner's ~ ; UCB. if eq ; this was zero once, don't know how incl num_badint ; but it crashed us, so protect!! jmp unsol_interrupt ; if no owner, then bad news fi ~ movl idb$l_csr(r4),r4 ; Get address of device's CSR. ~ bbcc #ucb$v_int,- ; If device does not expect ~ ucb$w_sts(r5),- ; interrupt, dismiss it. ~ unsol_interrupt incl num_solic ; ; This is a solicited interrupt. Save ; the contents of the device registers in the UCB. ; ; ; Restore control to the main driver. ; ~restore_driver: ; Jump to main driver code. ~ movq ucb$l_fr3(r5),r3 ; Restore driver's R3 (use a ~ ; MOVQ to restore R3-R4). ~ jsb @ucb$l_fpc(r5) ; Call driver at interrupt ~ ; wait address. brw dismiss ;finish here ~unsol_interrupt: ; Dismiss unsolicited interrupt. decl num_unsol ; if flag ne 0 ;This was used to force crashes ; pushl #^xeeee ;before I hit on the idea of a status ; pushl #^xffff ;return qio ; movl #12,r1 ; movl @#12,r0 ; fi ; Dismiss the interrupt. ; dismiss: ~ popr #^m ; Restore R0-R5 ~ rei ; Return from interrupt. ;++ ; AE_CANCEL, Cancels an I/O operation in progress ; ; Functional description: ; ; This routine calls IOC$CANCELIO to set the cancel bit in the ; UCB status word if: ; ; the device is busy, ; the IRP's process ID matches the cancel process ID, ; the IRP channel matches the cancel channel. ; ; If IOC$CANCELIO sets the cancel bit, then this driver routine ; does device-dependent cancel I/O fixups. ; ; Inputs: ; ; R2 - negated value of the channel index number ; R3 - address of the current IRP (I/O request packet) ; R4 - address of the PCB (process control block) for the ; process canceling I/O ; R5 - address of the UCB (unit control block) ; ; Outputs: ; ; The routine must preserve all registers except R0-R3. ; ; The routine may set the UCB$M_CANCEL bit in UCB$W_STS. ; ;-- ~ae_cancel: ; Cancel an I/O operation ~ jsb g^ioc$cancelio ; Set cancel bit if appropriate. ~ bbc #ucb$v_cancel,- ; If the cancel bit is not set, ~ ucb$w_sts(r5),10$ ; just return. incl num_cancel ; ; Device-dependent cancel operations go next. ; movl ucb$l_crb(r5),r3 ;get csr movl @crb$l_intd+vec$l_idb(r3),r3 movw #0,ae_gdps(r3) ; clear status, inhibit interupts if ucb$l_doingdma(r5) ne 0 incl num_seq movl num_seq,num__can incl num_cancel_dma ; movw #0,ae_gdwc(r3) ;zero the word count (but it fucks up movw #scd,(r3) ; the current picture, so try this too) call dmacleanup ; fi ; ; Finally, the return. ; ~10$: ~ rsb ; Return ;++ ; AE_REG_DUMP, Dumps the contents of device registers to a buffer ; ; Functional description: ; ; Writes the number of device registers, and their current ; contents into a diagnostic or error buffer. ; ; Inputs: ; ; R0 - address of the output buffer ; R4 - address of the CSR (controller status register) ; R5 - address of the UCB (unit control block) ; ; Outputs: ; ; The routine must preserve all registers except R1-R3. ; ; The output buffer contains the current contents of the device ; registers. R0 contains the address of the next empty longword in ; the output buffer. ; ;-- ~ae_reg_dump: ; Dump device registers ~ rsb ; Return ;+ ; bsywait - do a busy wait on the csr - input r4 = csr address ; preserves all registers ; delay - just hang for delay_time units ; preserves all registers ;- delay: push r2 loop for r2 := 1 to #delay_time next r2 pop r2 rsb bsywait: incl num_seq movl num_seq,num__bsy push r2 push r1 clrl r1 loop for r2 = 1 to #maxbusywait movw (r4),r1 ;get csr movl r1,num_r1 bitw #busy,r1 ;is it busy if eq break fi next r2 if r2 gt 1 incl num_notready if r2 gt num_maxbsy movl r2,num_maxbsy fi fi pop r1 pop r2 rsb ; ; Local data for debugging ; ~ .ascii /Stat/ ;these lines ~ .ascii /Stat/ ~ .ascii /Stat/ ~ .long ^xaaaa ~ .long ^xaaaa ;are for crash dumps Stats: num_flag: .long 0 ;this one is used only for crash dumps num_interupts: .long 0 ;1 num_solic: .long 0 ;2 num_unsol: .long 0 ;3 num_dmas: .long 0 ;4 num_start: .long 0 ;5 num_cancel: .long 0 ;6 num_cancel_dma: .long 0 ;7 num_timeout: .long 0 ;8 num_timeout_dma: .long 0 ;9 num_con_init: .long 0 ;10 num_init: .long 0 ;11 num_wc: .long 0 ;12 num_csr: .long 0 ;13 num_ps: .long 0 ;14 num_pstmo: .long 0 ;15 num_wctmo: .long 0 ;16 num_badint: .long 0 ;17 num_wcdma: .long 0 ;18 at end of a dma, this is the wc register num_psdma: .long 0 ;19 and ps register num_badp1: .long 0 ;20 if we ever get this, there's a bug for sure num_clean2: .long 0 ;21 if we are in clean dma a second time num_wcafter: .long 0 ;22 word count after a dma interupt if not zero num_psafter: .long 0 ;23 ps after a dma interupt if >0 word cocnt num_wcbefore: .long 0 ;24 originals num_nzwc: .long 0 ;25 number of times this happens num_csafter: .long 0 ;26 csr after the interupt num_int3: .long 0 ;27 third interupt required num_seq: .long 0 ;28 sequence counter for trace num__tmo: .long 0 ;29 num__int: .long 0 ;30 num__can: .long 0 ;31 num__bsy: .long 0 ;32 num_notready: .long 0 ;33 num_maxbsy: .long 0 ;34 num_r1: .long 0 ;35 Estats: ~ .long ^xbbbb ~ .long ^xbbbb ~ .ascii /End End End End / ;for crash dumps ;++ ; Label that marks the end of the driver ;-- ~ae_end: ; Last location in driver ~ .end