!* RECORDFORMAT PARMF(INTEGER DEST,SRCE,P1,P2,P3,P4,P5,P6) !* !* Communications record format - extant from CHOPSUPE 22A onwards * !* RECORDFORMAT COMF(INTEGER OCPTYPE,SLIPL,SBLKS,SEPGS,NDISCS,DLVNADDR, C (INTEGER GPCTABSIZE,GPCA OR INTEGER DCUTABSIZE,DCUA), C INTEGER SFCTABSIZE,SFCA,SFCK,DIRSITE, C DCODEDA,SUPLVN,TOJDAY,DATE0,DATE1,DATE2, C TIME0,TIME1,TIME2,EPAGESIZE,USERS,CATTAD,SERVAAD, C BYTEINTEGER NSACS,RESV1,SACPORT1,SACPORT0, C NOCPS,RESV2,OCPPORT1,OCPPORT0,INTEGER ITINT,CONTYPEA, C (INTEGER GPCCONFA OR INTEGER DCUCONFA), C INTEGER FPCCONFA,SFCCONFA,BLKADDR,RATION, C (INTEGER SMACS OR INTEGER SCUS), C INTEGER TRANS,LONGINTEGER KMON, C INTEGER DITADDR,SMACPOS,SUPVSN,PSTVA,SECSFRMN,SECSTOCD, C SYNC1DEST,SYNC2DEST,ASYNCDEST,MAXPROCS,INSPERSEC,ELAPHEAD, C COMMSRECA,STOREAAD,PROCAAD,SFCCTAD,DRUMTAD,TSLICE,FEPS, C MAXCBT,PERFORMAD,SP1,SP2,SP3,SP4,SP5,SP6, C LSTL,LSTB,PSTL,PSTB,HKEYS,HOOT,SIM,CLKX,CLKY,CLKZ, C HBIT,SLAVEOFF,INHSSR,SDR1,SDR2,SDR3, C SDR4,SESR,HOFFBIT,BLOCKZBIT,BLKSHIFT,BLKSIZE,END) !* IF SSERIES=YES START RECORDFORMAT DDTFORM(INTEGER C SER, PTSM, PROPADDR, STICK, CAA, GRCB AD, C BYTE INTEGER LAST ATTN, DACTAD, HALF INTEGER HALFSPARE, C INTEGER LAST TCB ADDR, C STATE,IW1,CONCOUNT, SENSE1, SENSE2, SENSE3, SENSE4, C REPSNO, BASE, ID, DLVN, MNEMONIC, C STRING (6) LAB, BYTE INTEGER HWCODE, C INTEGER ENTSIZE, URCB AD, SENSDAT AD, LOGMASK, UASTE, C UA SIZE, UA AD, TIMEOUT,PROPS,STATS1,STATS2, C BYTEINTEGER QSTATE,PRIO,SP1,SP2, C INTEGER LQLINK,UQLINK,CURCYL,SEMA,TRLINK,SPARE) RECORDFORMAT TCBF(INTEGER CMD,STE,DATA LEN,DATA AD,NEXT TCB, C RESP,PRE0,PRE1,PRE2,PRE3,POST0,POST1,POST2,POST3) FINISH ELSE START RECORDFORMAT DDTFORM(INTEGER SER, PTS, PROPADDR, STICK, CCA, RQA, C LBA, ALA, STATE, IW1, CONCOUNT, SENSE1, SENSE2, SENSE3, C SENSE4, REPSNO, BASE, ID, DLVN, MNEMONIC, C STRING (6) LAB, BYTEINTEGER MECH, C INTEGER PROPS,STATS1,STATS2, C BYTEINTEGER QSTATE,PRIO,SP1,SP2, C INTEGER LQLINK,UQLINK,CURCYL,SEMA,TRLINK,CHFISA) RECORDFORMAT RQBFORM(INTEGER LSEGPROP,LSEGADDR,LBPROP,LBADDR,ALPROP,C ALADDR,W6,W7,W8) FINISH !* RECORDFORMAT PROPFORM(INTEGER TRACKS,CYLS,PPERTRK,BLKSIZE,TOTPAGES,C RQBLKSIZE,LBLKSIZE,ALISTSIZE,KEYLEN,SECTINDX) ! !* IF SSERIES=YES START RECORDFORMAT COUNTFORM(BYTEINTEGER ID,SD1,SD2,HFLG,C1,C2,H1,H2,SCTR, C KL,DL1,DL2) FINISH ELSE START RECORDFORMAT COUNTFORM(BYTEINTEGER HFLG,C1,C2,H1,H2,SCTR,KL,DL1,DL2) FINISH !* RECORDFORMAT LABFORM(BYTEINTEGERARRAY VOL(0:5),BYTEINTEGER S1,C S2,S3,S4,ACCESS,BYTEINTEGERARRAY RES(1:20),BYTEINTEGER C1,C2,C AC1,AC2,TPC1,TPC2,BF1,BF2,BYTEINTEGERARRAY POINTER(0:3), C IDENT(1:14)) CONSTINTEGER DISCSNO=X'00200000', C PDISCSNO=X'210000',RRSNO=X'220000' CONSTRECORD (COMF)NAME COM=X'80C00000' IF SSERIES=NO START CONSTINTEGER SD=X'58000000'; ! string desc. for ALE FINISH !* EXTERNALROUTINESPEC OPMESS2(INTEGER OPER,STRING (63) S) EXTERNALROUTINESPEC DUMPTABLE(INTEGER T,A,L) EXTERNALSTRING (8)FNSPEC STRINT(INTEGER N) EXTERNALROUTINESPEC PON(RECORD (PARMF)NAME P) EXTERNALROUTINESPEC PKMONREC(STRING (20)S,RECORD (PARMF)NAME P) SYSTEMROUTINESPEC ITOE(INTEGER AD,L) EXTERNALLONGINTEGERSPEC KMON EXTERNALROUTINE FORMAT(RECORD (PARMF)NAME P) !*********************************************************************** !* Formats a disc from data in the property table * !*********************************************************************** RECORD (COUNTFORM)NAME COUNT OWNRECORD (DDTFORM)NAME DDT OWNRECORD (PROPFORM)NAME PROP IF SSERIES=YES START OWNRECORD (TCBF)NAME INIT TCB,TCB OWNINTEGER HALF SIZE CONSTINTEGER FDS160=X'39' FINISH ELSE START RECORD (RQBFORM)NAME RQB FINISH OWNBYTEINTEGERARRAY DATA(0:159)=0(*) OWNINTEGER STATE,MNEM,SLOT,DSNO,OP OWNINTEGER TRACK,LTRACK,UTRACK,CYL,LCYL,UCYL,PPTRK,BUFFA,CDEX, C KEYLEN,BUFFSIZE CONSTINTEGER GETPAGE=X'50000',RETURNPAGE=X'60000' CONSTINTEGER SERVNO=X'260000'; ! formatter service no(38) SWITCH SW(0:5) INTEGER I,ACT,J,ALA,LBA,DATAPTR,WCKD,RDATA ACT=P_DEST&X'FFFF' IF KMON>>(SERVNO>>16)&1#0 THEN PKMONREC("Format:",P) IF ACT=0 AND STATE#0 THEN C OPMESS2(P_SRCE>>8&15,"Formatter busy") AND RETURN ->SW(STATE) SW(0): ! request BUFFSIZE=EPAGESIZE*1024 MNEM=P_P1; ! mnemonic of drive to be formatted CYL=P_P2; TRACK=P_P3 OP=P_SRCE>>8&15 P_DEST=DISCSNO+1 P_P1=M'FRMR' P_P2=SERVNO+2 P_SRCE=SERVNO+1 P_P3=MNEM PON(P) STATE=1; RETURN SW(1): ! device allocated IF P_P2=0 THEN OPMESS2(OP,"Formatter claim fails") C AND STATE=0 AND RETURN SLOT=P_P3 DDT==RECORD(INTEGER(COM_DITADDR+4*SLOT)) PROP==RECORD(DDT_PROPADDR) KEYLEN=PROP_KEYLEN DSNO=P_P2 !* ! Get a 4K buffer ! P_DEST=GET PAGE P_SRCE=SERVNO+1 PON(P) STATE=2 RETURN SW(2): ! page got CDEX=P_P2 BUFFA=P_P4 !* ! Initialise the buffer ! INTEGER(BUFFA)=M'EMAS' FOR I=BUFFA+4,4,BUFFA+BUFFSIZE-4 CYCLE INTEGER(I)=X'08CEF731' REPEAT !* ! Set up home address count (no key) and data fields for frmel ! IF CYL=-1 THEN LCYL=0 AND UCYL=PROP_CYLS-1 C ELSE LCYL=CYL>>16 AND UCYL=CYL&X'FFFF' IF TRACK=-1 THEN LTRACK=0 AND UTRACK=PROP_TRACKS-1 C ELSE LTRACK=TRACK>>16 AND UTRACK=TRACK&X'FFFF' ->FAIL UNLESS 0<=LTRACK<=UTRACK AND UTRACK<PROP_TRACKS AND C 0<=LCYL<=UCYL AND UCYL<PROP_CYLS PPTRK=PROP_PPERTRK !* IF SSERIES=YES START IF DDT_PROPS>>24>=FDS160 START PPTRK=PPTRK//2+1; ! _PPERTRK is really pages per 2 tracks HALF SIZE=PROP_BLKSIZE//2 FINISH ELSE HALF SIZE=0 INIT TCB==RECORD(DDT_UA AD) TCB==RECORD(DDT_UA AD+4*18) INIT TCB=0 TCB=0 INIT TCB_NEXT TCB=ADDR(TCB) INIT TCB_CMD=X'2C404081'; ! initialise: post&pre valid I=(ADDR(DATA(0))&X'7FFFFFFF')>>18 J=INTEGER (PST VA+8*I+4) J=J!(INTEGER(PST VA+8*I)>>29&2); ! transfer paged bit INIT TCB_STE=J TCB_STE=J INIT TCB_DATA LEN=22; ! 21 bytes for EDS80s, 18 for EDS100 & 200 INIT TCB_DATA AD=ADDR(DATA(0)) DATA(2)=X'FE'; ! mask no status DATA(4)=X'18'; ! seek cyl & haed DATA(12)=0 FINISH !* ! Set up the CCW to write home address and sector 0 on track 0 cyl 0 ! CYL=LCYL UNTIL CYL>UCYL CYCLE TRACK=LTRACK UNTIL TRACK>UTRACK CYCLE IF SSERIES=YES START DATA(5)=0; DATA(14)=0; ! sector 0 DATA(6)=CYL>>8 DATA(10)=CYL>>8 DATA(7)=CYL&255 DATA(11)=CYL&255 DATA(8)=TRACK DATA(13)=TRACK COUNT==RECORD(ADDR(DATA(24))) COUNT_SD1=0; COUNT_SD2=0 COUNT_C1=CYL>>8; COUNT_C2=CYL&255 COUNT_H2=TRACK; COUNT_HFLG=0 COUNT==RECORD(ADDR(DATA(32))) COUNT_C1=CYL>>8 COUNT_C2=CYL&255 COUNT_H1=0; COUNT_H2=TRACK COUNT_HFLG=0 COUNT_KL=0; COUNT_DL1=X'00' COUNT_DL2=80; COUNT_SCTR=0 FOR I=1,1,PPTRK CYCLE COUNT==RECORD(ADDR(DATA(32))+12*I) COUNT_C1=CYL>>8; COUNT_C2=CYL&255 COUNT_H2=TRACK COUNT_KL=0 IF HALF SIZE>0 AND ((TRACK&1=0 AND I=PPTRK) OR C (TRACK&1#0 AND I=1)) START COUNT_DL1<-HALF SIZE>>8; ! the odd half-block COUNT_DL2<-HALF SIZE FINISH ELSE START COUNT_DL1<-PROP_BLKSIZE>>8 COUNT_DL2<-PROP_BLKSIZE FINISH COUNT_SCTR=I REPEAT TCB_CMD=X'200040B3' TCB_DATA LEN=8+12+12*PPTRK TCB_DATA AD=ADDR(DATA(24)) TCB_RESP=0 INIT TCB_RESP=0 FINISH ELSE START ALA=DDT_ALA LBA=DDT_LBA RQB==RECORD(DDT_RQA) DATA(0)=0; DATAPTR=0 COUNT==RECORD(ADDR(DATA(DATAPTR))) COUNT_C1=CYL>>8; COUNT_C2=CYL&255 COUNT_H2=TRACK; COUNT_SCTR=0 COUNT_KL=0; COUNT_DL1=X'00' COUNT_DL2=80; COUNT_HFLG=0 WCKD=X'1300'; RDATA=X'1200' IF CYL=0 START WCKD=X'2B00' IF TRACK<18; ! overflow format RDATA=X'401200'; ! ignore length chk(frm oflow) FINISH INTEGER(LBA)=X'84000300'; ! lit,chain & write ha INTEGER(ALA)=SD+5; ! ha = 5 byte INTEGER(ALA+4)=ADDR(COUNT_HFLG) INTEGER(LBA+4)=X'88000B02';! oput,datachn & write s0 INTEGER(ALA+8)=SD+8; ! count=8 INTEGER(ALA+12)=ADDR(COUNT_C1) INTEGER(LBA+8)=X'84000B04';! oput &chain INTEGER(ALA+16)=SD+80; ! data (80) INTEGER(ALA+20)=BUFFA INTEGER(ALA+24)=SD+KEYLEN INTEGER(ALA+28)=BUFFA; ! al entry for sectn(n>1) INTEGER(ALA+32)=SD+BUFFSIZE INTEGER(ALA+36)=BUFFA DATAPTR=DATAPTR+9 LBA=LBA+12 ALA=ALA+40 FOR I=1,1,PPTRK CYCLE COUNT==RECORD(ADDR(DATA(DATAPTR))) COUNT_C1=CYL>>8; COUNT_C2=CYL&255 COUNT_H2=TRACK COUNT_SCTR=I COUNT_KL=KEYLEN COUNT_DL1<-PROP_BLKSIZE>>8 COUNT_DL2<-PROP_BLKSIZE INTEGER(LBA)=X'88000008'+WCKD+2*I;! write ckd+datchain INTEGER(ALA)=SD+8 INTEGER(ALA+4)=ADDR(COUNT_C1) IF KEYLEN#0 THEN START INTEGER(LBA+4)=X'88000006'+WCKD;! use prepared alist entries LBA=LBA+4 FINISH INTEGER(LBA+4)=X'84C00008'+WCKD LBA=LBA+8 ALA=ALA+8 DATAPTR=DATAPTR+9 REPEAT ! ! Now reread the track with skip set to check correctly written ! can use the original addres list entries ! UNLESS CYL=0 AND TRACK<18 START INTEGER(LBA)=X'24000200'; ! read &skip ha INTEGER(LBA+4)=X'28000A02';! read s0 INTEGER(LBA+8)=X'24000A04';! datachain for the data area LBA=LBA+12 FOR I=1,1,PPTRK CYCLE INTEGER(LBA)=X'28000008'+2*I!rdata;! read ckd +data chn IF KEYLEN#0 THEN START INTEGER(LBA+4)=X'28000006'!RDATA LBA=LBA+4 FINISH INTEGER(LBA+4)=X'24C00008'!RDATA LBA=LBA+8 REPEAT FINISH ! INTEGER(LBA-4)=INTEGER(LBA-4)&X'F3FFFFFF';! kill chaining ! RQB_W7=X'1E001300'; ! seek cyl & do chain RQB_W8=CYL<<16!TRACK; ! seek data FINISH P_DEST=DSNO P_SRCE=SERVNO+2 P_P1=CYL<<16!TRACK PON(P) STATE=3 RETURN ! SW(3): ! reply from disc IF P_P2#0 THEN START ; ! failure IF SSERIES=YES START DUMPTABLE(5,ADDR(INIT TCB),8*18) COUNT==RECORD(DATA(24)) COUNT_HFLG=2; ! defective track DATA(14)=0 COUNT==RECORD(DATA(32)) COUNT_DL1=0; COUNT_DL2=80 TCB_CMD=X'200040B3' TCB_DATA LEN=8+12 TCB_DATA AD=ADDR(DATA(24)) TCB_RESP=0 INIT TCB_RESP=0 FINISH ELSE START DATA(0)=2; ! defective track INTEGER(DDT_LBA+4)=X'80000300';! write ha FINISH P_DEST=DSNO P_SRCE=SERVNO+2 P_P1=M'FRME' STATE=4 PON(P) OPMESS2(OP,"CYL ".STRINT(CYL)." TRK ". C STRINT(TRACK)." FAULTY") RETURN FINISH SW(4): ! reply from flag track TRACK=TRACK+1 REPEAT CYL=CYL+1 REPEAT OPMESS2(OP,"Format complete") ->FINISH FAIL: OPMESS2(OP,"Formatter fails") FINISH: ! ! Return device P_DEST=DISCSNO+1 P_P3=SLOT STATE=0 P_P2=0 PON(P) P_DEST=RETURN PAGE P_SRCE=0; ! reply not wanted P_P2=CDEX PON(P); ! return the core page END EXTERNALROUTINE DLABEL(RECORD (PARMF)NAME P) !*********************************************************************** !* Labels a disc with a standard label * !*********************************************************************** RECORD (LABFORM)NAME LABEL RECORD (COUNTFORM)NAME COUNT RECORD (DDTFORM)NAME DDT RECORD (PROPFORM)NAME PROP IF SSERIES=YES START OWNRECORD (TCBF)NAME INITTCB,TCB OWNBYTEINTEGERARRAY VLAB(0:150)=0(71),X'40'(10),X'C5',X'40'(20), 0(8),0(3),40,X'40'(37) FINISH ELSE START RECORD (RQBFORM)NAME RQB OWNBYTEINTEGERARRAY VLAB(-70:80)=0(71),X'40'(10),X'C5',X'40'(20), 0(8),0(3),40,X'40'(37) FINISH OWNINTEGER STATE,MNEM,SLOT,DSNO,IPL,CDEX,BA,OP CONSTINTEGER GETPAGE=X'50000',RETURNPAGE=X'60000' OWNSTRING (6)VOLID CONSTINTEGER SERVNO=X'230000'; ! labeller service no(35) SWITCH SW(0:5) IF SSERIES=NO START INTEGER ALA,LBA FINISH INTEGER I,ACT,J ACT=P_DEST&X'FFFF' OP=P_SRCE>>8&15 IF ACT=0 AND STATE#0 THEN OPMESS2(OP,"LABELLER BUSY") AND RETURN ->SW(STATE) SW(0): ! request MNEM=P_P1; ! mnemonic of drive to be labelled VOLID<-STRING(ADDR(P_P2)) IPL=P_P4 P_DEST=DISCSNO+1 P_P1=M'LABR' P_P2=SERVNO+2 P_SRCE=SERVNO+1 P_P3=MNEM PON(P) STATE=1; RETURN SW(1): ! device allocated IF P_P2=0 THEN OPMESS2(OP,"Labeller claim fails") C AND STATE=0 AND RETURN SLOT=P_P3 DSNO=P_P2 IF IPL=0 THEN -> NOBUFF P_DEST=GETPAGE P_SRCE=SERVNO+1 STATE=2 PON(P) RETURN SW(2): ! page arrived CDEX=P_P2 BA=P_P4 NOBUFF: ! ! Set up home address count (no key) and data fields for label ! IF SSERIES=YES START STRING(ADDR(VLAB(70)))=VOLID LABEL==RECORD(ADDR(VLAB(71))) FINISH ELSE START STRING(ADDR(VLAB(0)))=VOLID LABEL==RECORD(ADDR(VLAB(1))) FINISH ITOE(ADDR(LABEL),6); ! vol id in ebcdic ! DDT==RECORD(INTEGER(COM_DITADDR+4*SLOT)) PROP==RECORD(DDT_PROPADDR) IF SSERIES=YES START INIT TCB==RECORD(DDT_UA AD) TCB==RECORD(DDT_UA AD+4*18) INIT TCB=0 TCB=0 INIT TCB_NEXT TCB=ADDR(TCB) INIT TCB_CMD=X'2C404081'; ! initialise: post valid ignr s&l I=(ADDR(VLAB(0))&X'7FFFFFFF')>>18 J=INTEGER (PST VA+8*I+4) J=J!(INTEGER(PST VA+8*I)>>29&2); ! transfer paged bit INIT TCB_STE=J TCB_STE=J INIT TCB_DATA LEN=22; ! 18 byte in initialise ! 21 bytes for EDS80s - see DISC INIT TCB_DATA AD=ADDR(VLAB(0)) VLAB(2)=X'FE'; ! mask no status VLAB(4)=X'20'; ! restore VLAB(12)=0 VLAB(5)=0; VLAB(14)=0 VLAB(6)=0; VLAB(10)=0 VLAB(7)=0; VLAB(11)=0 VLAB(8)=0; VLAB(13)=0 FINISH I=PROP_CYLS LABEL_C1=I>>8 LABEL_C2=I&255 LABEL_TPC2=PROP_TRACKS ! IF SSERIES=YES THEN COUNT==RECORD(ADDR(VLAB(59))) ELSE C COUNT==RECORD(ADDR(VLAB(-8))) COUNT_DL1=0; COUNT_DL2=80 ! ! Set up the CCW to write home address and sector 0 on track 0 cyl 0 ! IF SSERIES=YES START ! TCB_CMD=X'200040A3' ! TCB_DATA LEN=8+12+80 ! TCB_DATA AD=ADDR(VLAB(51)) TCB_CMD=X'20004013'; ! just write data TCB_DATA LEN=80 TCB_DATA AD=ADDR(VLAB(71)) TCB_RESP=0 INIT TCB_RESP=0 LABEL_POINTER(3)=X'40' IF IPL=0 THEN ->DCHN LABEL_POINTER(2)=8 LABEL_POINTER(3)=0; ! X800 pages for system on ipldisc DCHN: DUMPTABLE(1,ADDR(INITTCB),192) DUMPTABLE(2,ADDR(VLAB(0)),150) FINISH ELSE START ALA=DDT_ALA LBA=DDT_LBA RQB==RECORD(DDT_RQA) ! INTEGER(LBA)=X'84000300'; ! lit,chain & write ha INTEGER(ALA)=X'58000005'; ! ha = 5 byte INTEGER(ALA+4)=ADDR(COUNT_HFLG) INTEGER(LBA+4)=X'84000B02'; ! oput & write s0 INTEGER(ALA+8)=X'58000058'; ! count=8 data =80 INTEGER(ALA+12)=ADDR(COUNT_C1) LBA=LBA+8 ALA=ALA+16 LABEL_POINTER(3)=X'40' IF IPL=0 THEN ->DCHN LABEL_POINTER(2)=8 LABEL_POINTER(3)=0; ! X800 pages for system on ipldisc FOR I=1,1,PROP_PPERTRK CYCLE COUNT==RECORD(ADDR(COUNT)-10) COUNT_SCTR=I; COUNT_KL=0 COUNT_DL1<-PROP_BLKSIZE>>8 COUNT_DL2<-PROP_BLKSIZE INTEGER(LBA)=X'88002B00'+4*I; ! write sckd & datachn INTEGER(LBA+4)=X'84C02B02'+4*I INTEGER(ALA)=SD+8 INTEGER(ALA+4)=ADDR(COUNT_C1) INTEGER(ALA+8)=SD+1024*EPAGESIZE INTEGER(ALA+12)=BA LBA=LBA+8 ALA=ALA+16 REPEAT ! DCHN: INTEGER(LBA-4)=INTEGER(LBA-4)&X'F3FFFFFF' DUMPTABLE(1,ADDR(RQB),1024) DUMPTABLE(2,ADDR(VLAB(-40)),120) RQB_W7=X'1E001300'; ! seek cyl&hd§r0 & do chain RQB_W8=0; ! seek data FINISH P_DEST=DSNO P_SRCE=SERVNO+2 P_P1=M'LABW' PON(P) STATE=3 RETURN ! SW(3): ! reply from disc ->FAIL IF P_P2#0 OPMESS2(OP,"Labelled ok") ->FINISH FAIL: OPMESS2(OP,"Labeller fails") FINISH: ! ! Return device P_DEST=DISCSNO+1 P_P3=SLOT STATE=0 P_P2=-1; ! unload after labelling PON(P) P_DEST=RETURN PAGE P_SRCE=0; ! reply not wanted P_P2=CDEX PON(P) IF IPL#0 END EXTERNALROUTINE RANDREAD(RECORD (PARMF)NAME P) !*********************************************************************** !* Performs random paged transfers on an EMAS format disc * !*********************************************************************** RECORD (DDTFORM)NAME DDT RECORD (PROPFORM)NAME PROP ROUTINESPEC NEXT REQ INTEGERFNSPEC NEXTRAND OWNINTEGER BUSY,DEV,MAX,ITER,REQTYPE,OUTSTAND,RCONST,FAILS,CDEX,BA, C SLOT,OP OWNINTEGER ATONCE CONSTINTEGER GETPAGE=X'50000',RETURN PAGE=X'60000' INTEGER ACT,I SWITCH INACT(0:3); ! extras for buff claim & release ACT=P_DEST&X'FFFF' ->INACT(ACT) INACT(0): ! request IF BUSY#0 THEN C OPMESS2(P_SRCE>>8&15,"Rand read busy") AND RETURN OUTSTAND=0; BUSY=1; FAILS=0 SLOT=P_P1; ! DIT slot of dev to tested ITER=P_P2; ! no of reads ATONCE=P_P3; ! queue size REQTYPE=P_P4 OP=P_SRCE>>8&15 RCONST=P_P5!X'1010111' P_DEST=GET PAGE P_SRCE=RRSNO+1 PON(P); ! get a page RETURN INACT(1): ! page obtained CDEX=P_P2 BA=P_P4 DDT==RECORD(INTEGER(COM_DITADDR+4*SLOT)) DEV=DDT_DLVN PROP==RECORD(DDT_PROPADDR) MAX=PROP_PPERTRK*PROP_TRACKS*PROP_CYLS-DDT_BASE FOR I=1,1,ATONCE CYCLE NEXT REQ REPEAT RETURN INACT(2): ! reply IF P_P2#0 THEN FAILS=FAILS+1 OUTSTAND=OUTSTAND-1 ITER=ITER-1 ->FINISH IF ITER<=0 NEXT REQ UNLESS OUTSTAND>=ITER RETURN FINISH: ! report & return buffs BUSY=0 OPMESS2(OP,"Test ends-errs= ".STRINT(FAILS)) P_DEST=RETURN PAGE P_P2=CDEX P_SRCE=0; ! reply not wanted PON(P); ! return page RETURN ROUTINE NEXT REQ P_DEST=PDISCSNO+REQTYPE P_SRCE=RRSNO+2 P_P1=M'RAND' P_P2=DEV<<24!NEXTRAND P_P3=BA PON(P) OUTSTAND=OUTSTAND+1 END INTEGERFN NEXTRAND INTEGER I *LSS_RCONST *IMYD_65539 *STUH_B *AND_X'7FFFFFFF' *ST_I *ST_RCONST RESULT =I-(I//MAX)*MAX END END ENDOFFILE