! DRIVING EDSS VIA A DCU WRITTEN BY PDS DEC 78
!
%RECORDFORMAT PARMF(%INTEGER DEST,SRCE,P1,P2,P3,P4,P5,P6)
!* COMMUNICATIONS RECORD FORMAT - EXTANT FROM CHOPSUPE 18D ONWARDS *
! Alterations from above-mentioned record format, for the S-series, are
! as follows:
!     GPCTABSIZE  ->   DCUTABSIZE
!     GPCA        ->   DCUA
!     SMACS       ->   SCUS
!     GPCCONFA    ->   DCUCONFA
%RECORDFORMAT COMF(%INTEGER OCPTYPE,IPLDEV,SBLKS,SEPGS,NDISCS,  %C
         DDTADDR,DCUTABSIZE,DCUA,SFCTABSIZE,SFCA,SFCK,DIRSITE,  %C
         DCODEDA,SUPLVN,KLOKCORRECT,DATE0,DATE1,DATE2,  %C
         TIME0,TIME1,TIME2,EPAGESIZE,USERS,PROCMON,DQADDR,  %C
         SACPORT,OCPPORT,ITINT,CONTYPEA,DCUCONFA,FPCCONFA,SFCCONFA, %C
         BLKADDR,DPTADDR,SCUS,TRANS,%LONGINTEGER KMON,  %C
         %INTEGER SPDRQ,SMACPOS,SUPVSN,PSTVA,SECSFRMN,SECSTOCD, %C
         SYNC1DEST,SYNC2DEST,ASYNCDEST,MAXPROCS,INSPERSEC,ELAPHEAD, %C
         COMMSRECA,%INTEGERARRAY SP(0:13), %INTEGER  %C
         LSTL,LSTB,PSTL,PSTB,HKEYS,HOOT,SIM,CLKX,CLKY,CLKZ,  %C
         HBIT,SLAVEOFF,INHSSR,SDR1,SDR2,SDR3,  %C
         SDR4,SESR,HOFFBIT,S2,S3,S4,END)
%RECORDFORMAT TCBF(%INTEGER CMD,STE,DATA LEN,DATA AD,NEXT TCB, %C
   RESP,PRE0,PRE1,PRE2,PRE3,POST0,POST1,POST2,POST3)
%RECORDFORMAT DDTFORM(%INTEGER SER,PTS,PROPADDR,STATUS, %C
      CCA,RQA,LBA,ALA,STATE,PAW,IW2,SENSE1,SENSE2,SENSE3,SENSE4,%C
      REPSNO,BASE,ID,DLVN,MNEMONIC,%STRING(6)LAB, %BYTEINTEGER %C
      HWCODE,%INTEGER ENTSIZE,URCB AD,SENSDAT AD,LOGMASK,TRTABAD,%C
      UA SIZE,UA AD,TIMEOUT,PROPS0,PROPS1)
!
%RECORDFORMAT PROPFORM(%INTEGER TRACKS,CYLS,PPERTRK,BLKSIZE,TOTPAGES,%C
      RQBLKSIZE,LBLKSIZE,ALISTSIZE,KEYLEN,SECTINDX)
!
!
%RECORDFORMAT COUNTFORM(%BYTEINTEGER ID,TA1,TA2,HFLG,C1,C2,H1,H2, %C
         SCTR,KL,DL1,DL2)
!

%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 PDISCSNO=X'210000',RRSNO=X'220000'
%CONSTINTEGER PST VA=X'80040000'
%OWNRECORDNAME COM(COMF)
%EXTRINSICLONGINTEGER KMON
%CONSTINTEGER DCUSERV=X'300000',CLAIMDISC=X'00200001'
!
%EXTERNALROUTINESPEC OPMESS2(%INTEGER OPER,%STRING(63) S)
%EXTERNALROUTINESPEC DUMPTABLE(%INTEGER T,A,L)
%EXTERNALSTRING(8)%FNSPEC STRINT(%INTEGER N)
%EXTERNALROUTINESPEC PON(%RECORDNAME P)

%SYSTEMROUTINESPEC ITOE(%INTEGER AD,L)
%EXTERNALROUTINESPEC PTREC(%RECORDNAME P)
%EXTERNALROUTINE FORMAT(%RECORDNAME P)
!***********************************************************************
!*    FORMATS A DISC FROM DATA IN THE PROPERTY TABLE                   *
!***********************************************************************
%RECORDSPEC P(PARMF)
%RECORDNAME COUNT(COUNTFORM)
%OWNRECORDNAME DDT(DDTFORM)
%OWNRECORDNAME INITTCB,TCB(TCBF)
%OWNRECORDNAME PROP(PROPFORM)
%OWNBYTEINTEGERARRAY DATA(0:48)
%OWNINTEGER STATE,MNEM,SLOT,DSNO,OP
%OWNINTEGER TRACK,LTRACK,UTRACK,CYL,LCYL,UCYL,PPTRK
%CONSTINTEGER SERVNO=X'260000';          ! FORMATTER SERVICE NO(38)
%SWITCH SW(0:7)
%INTEGER I,ACT,J,SECT
      ACT=P_DEST&X'FFFF'
      %IF KMON&LENGTHENI(1)<<X'26'#0 %THEN PRINTSTRING("FORMATTER: ") %C
         %AND PTREC(P)
      %IF ACT=0 %AND STATE#0 %THEN %C
         OPMESS2(P_SRCE>>8&15,'FORMATTER BUSY')  %AND %RETURN
      ->SW(STATE)
SW(0):                                  ! REQUEST
      COM==RECORD(X'80C00000')
      MNEM=P_P1;                        ! MNEMONIC OF DRIVE TO BE FORMATTED
      CYL=P_P2; TRACK=P_P3
      OP=P_SRCE>>8&15
      P_DEST=CLAIMDISC
      P_P1=MNEM
      P_P2=1;                          ! PON REPLIES
      P_SRCE=SERVNO+1
      P_P6=M'FRMR'
      PON(P)
      STATE=1; %RETURN
SW(1):                                  ! DEVICE ALLOCATED
      %IF P_P1#0 %THEN OPMESS2(OP,'FORMATTER CLAIM FAILS') %C
            %AND STATE=0 %AND %RETURN
      SLOT=P_P3
      DDT==RECORD(SLOT)
      PROP==RECORD(DDT_PROPADDR)
      DSNO=P_P2
      %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
!
! SET UP THE TCB MAPPINGS AND THE BITS OF THE TCBS AND INIT DATA
! THAT WILL NOT CHANGE THROUGOUT THE FORMATTING
!
      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=18;             ! 18 BYTE IN INITIALISE
      INIT TCB_DATA AD=ADDR(DATA(0))
      DATA(2)=X'FE';                    ! MASK NO STATUS
      DATA(4)=X'18';                    ! SEEK CYL & HAED
      DATA(12)=0
      CYL=LCYL
      %UNTIL CYL>UCYL %CYCLE
         TRACK=LTRACK
         %UNTIL TRACK>UTRACK %CYCLE
            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(20)))
            COUNT_C1=CYL>>8; COUNT_C2=CYL&255
            COUNT_H2=TRACK; COUNT_HFLG=0
            %IF CYL=0 %START
               COUNT_HFLG=X'20';        ! DUMP&IPL ALLOWED
            %FINISH
            COUNT==RECORD(DATA(28))
            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
            %CYCLE SECT=1,1,PPTRK
               COUNT==RECORD(ADDR(DATA(28))+12*SECT)
               COUNT_C1=CYL>>8; COUNT_C2=CYL&255
               COUNT_H2=TRACK
               COUNT_KL=0
               COUNT_DL1<-PROP_BLKSIZE>>8
               COUNT_DL2<-PROP_BLKSIZE
               COUNT_SCTR=SECT
            %REPEAT
            TCB_CMD=X'200040B3'
            TCB_DATA LEN=8+12+12*PPTRK
            TCB_DATA AD=ADDR(DATA(20))
            TCB_RESP=0
            INIT TCB_RESP=0
            P_DEST=DCUSERV+10;          ! EXECUTE CHAIN
            P_SRCE=SERVNO+1
            P_P1=ADDR(INIT TCB)
            P_P2=DSNO
            P_P4=M'FRM1'
            PON(P)
            STATE=2
            %RETURN
SW(2):                                  ! REPLY FROM DCU: REQUEST ACCEPTED
            ->FAIL %UNLESS P_P1=0;      ! UNLESS REJECTED
            STATE=3; %RETURN
SW(3):                                  ! REPLY FROM WRITE HA &S0
            %IF ACT#2 %THEN %START;    ! FAILURE
               DUMPTABLE(5,ADDR(INIT TCB),8*18)
               COUNT==RECORD(DATA(20))
               COUNT_HFLG=2;               ! DEFECTIVE TRACK
               DATA(14)=0
               COUNT==RECORD(DATA(28))
               COUNT_DL1=0; COUNT_DL2=80
               TCB_CMD=X'200040B3'
               TCB_DATA LEN=8+12
               TCB_DATA AD=ADDR(DATA(20))
               TCB_RESP=0
               INIT TCB_RESP=0
               P_DEST=DCUSERV+10
               P_SRCE=SERVNO+1
               P_P1=ADDR(INIT TCB)
               P_P2=DSNO
               P_P4=M'FGTK'
               STATE=4
               PON(P)
               OPMESS2(OP,'CYL '.STRINT(CYL).' TRK '. %C
                  STRINT(TRACK).' FAULTY')
               %RETURN
SW(4):                                  ! REPLY FROM DCU FLAGTRK ACCEPTED
               ->FAIL %UNLESS P_P1=0
               STATE=5; %RETURN
            %FINISH
SW(5):                                  ! 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=DCU SERV+5
      P_SRCE=X'80000001'!SERVNO
      P_P1=MNEM
      STATE=0
      PON(P)
%END
%EXTERNALROUTINE DLABEL(%RECORDNAME P)
!***********************************************************************
!*    LABELS A DISC WITH A STANDARD LABEL                              *
!***********************************************************************
%RECORDSPEC P(PARMF)
%RECORDNAME LABEL(LABFORM)
%RECORDNAME HA,COUNT(COUNTFORM)
%RECORDNAME DDT(DDTFORM)
%RECORDNAME PROP(PROPFORM)
%OWNRECORDNAME INITTCB,TCB(TCBF)
%OWNBYTEINTEGERARRAY VLAB(0:150)=0(71),X'40'(10),X'C5',X'40'(20),
                  0(8),0(3),40,X'40'(37)
%OWNINTEGER STATE,MNEM,SLOT,DSNO,IPL,OP
%OWNSTRING(6)VOLID
%CONSTINTEGER SERVNO=X'230000';         ! LABELLER SERVICE NO(35)
%SWITCH SW(0:5)
%INTEGER I,ACT,J
      ACT=P_DEST&X'FFFF'
      %IF KMON&LENGTHENI(1)<<35#0 %THEN %C
         PRINTSTRING("LABELLER:") %AND PTREC(P)
      %IF ACT=0 %AND STATE#0 %THEN %C
         OPMESS2(P_SRCE>>8&15,'LABELLER BUSY') %AND %RETURN
      ->SW(STATE)
SW(0):                                  ! REQUEST
      COM==RECORD(X'80C00000')
      MNEM=P_P1;                        ! MNEMONIC OF DRIVE TO BE LABELLED
      VOLID<-STRING(ADDR(P_P2))
      IPL=P_P4
      OP=P_SRCE>>8&15
      P_DEST=CLAIMDISC
      P_P1=MNEM
      P_P2=1;                          ! PON REPLIES
      P_SRCE=SERVNO+1
      P_P6=M'LABR'
      PON(P)
      STATE=1; %RETURN
SW(1):                                  ! DEVICE ALLOCATED
      %IF P_P1#0 %THEN OPMESS2(OP,'LABELLER CLAIM FAILS') %C
            %AND STATE=0 %AND %RETURN
      SLOT=P_P3
      DSNO=P_P2
!
! SET UP HOME ADDRESS COUNT (NO KEY) AND DATA FIELDS FOR LABEL
!
      STRING(ADDR(VLAB(70)))=VOLID
      LABEL==RECORD(ADDR(VLAB(71)))
      ITOE(ADDR(LABEL),6);              ! VOL ID IN EBCDIC
!      LABEL_ACCESS=X'C5';               ! C'E' FOR EMAS FILE SYTEMS
!
      DDT==RECORD(SLOT)
      PROP==RECORD(DDT_PROPADDR)
      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=18;             ! 18 BYTE IN INITIALISE
      INIT TCB_DATA AD=ADDR(VLAB(0))
      VLAB(2)=X'FE';                    ! MASK NO STATUS
      VLAB(4)=X'18';                    ! SEEK CYL & HAED
      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
      I=PROP_CYLS
      LABEL_C1=I>>8
      LABEL_C2=I&255
      LABEL_TPC2=PROP_TRACKS
!
      HA==RECORD(ADDR(VLAB(51)))
      COUNT==RECORD(ADDR(VLAB(59)))
      COUNT_DL1=0; COUNT_DL2=80
      %IF IPL#0 %THEN HA_HFLG=X'20';      ! STORE DUMP&IPL ALLOWED
!
! SET UP THE TCB TO WRITE HOME ADDRESS AND SECTOR 0 ON TRACK 0 CYL 0
!
      TCB_CMD=X'200040A3'
      TCB_DATA LEN=8+12+80
      TCB_DATA AD=ADDR(HA)
      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)
      P_DEST=DCUSERV+10
      P_SRCE=SERVNO+2
      P_P1=ADDR(INIT TCB)
      P_P2=DSNO
      P_P4=M'LABW'
      PON(P)
      STATE=3
      %RETURN
!
SW(3):                                  ! REPLY FROM DCU
      ->FAIL %UNLESS P_P1=0;            ! UNLESS CHAIN STARTED
      STATE=4; %RETURN
SW(4):                                  ! TERMINATION INT
      ->FAIL %IF ACT#2
      OPMESS2(OP,'LABELLED OK')
      ->FINISH
FAIL: OPMESS2(OP,'LABELLER FAILS')
      DUMPTABLE(3,ADDR(INIT TCB),96)
      %RETURN
FINISH:
!
! RETURN DEVICE
      P_DEST=DCU SERV+5
      P_SRCE=X'80000001'!SERVNO
      P_P1=MNEM
      STATE=0
      PON(P)
%END
%EXTERNALROUTINE RANDREAD(%RECORDNAME P)
!***********************************************************************
!*    PERFORMS RANDOM PAGED TRANSFERS ON AN EMAS FORMAT DISC           *
!***********************************************************************
%RECORDSPEC P(PARMF)
%RECORDNAME DDT(DDTFORM)
%RECORDNAME PROP(PROPFORM)
%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
      COM==RECORD(X'80C00000')
      OUTSTAND=0; BUSY=1; FAILS=0
      SLOT=P_P1;                        ! DTT 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_DDTADDR+4*SLOT))
      DEV=DDT_DLVN
      PROP==RECORD(DDT_PROPADDR)
      MAX=PROP_PPERTRK*PROP_TRACKS*PROP_CYLS-DDT_BASE
      %CYCLE I=1,1,ATONCE
         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