!*
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