CONST STRING (15) VSN="18 Aug 83"
RECORD FORMAT PARMF(INTEGER DEST, SRCE, P1, P2, P3, P4, P5, P6)
RECORD FORMAT DDTFORM(INTEGER SER, PTS, PROPADDR, STATUS, CCA, RQA, LBA, ALA, STATE, IW1, IW2,
SENSE1, SENSE2, SENSE3, SENSE4, REPSNO, BASE, ID, DLVN, MNEMONIC, STRING (6) LAB,
BYTE INTEGER MECH)
!
RECORD FORMAT PROPFORM(INTEGER TRACKS, CYLS, PPERTRK, BLKSIZE, TOTPAGES, RQBLKSIZE, LBLKSIZE,
ALISTSIZE, KEYLEN, SECTINDX)
!
RECORD FORMAT RQBFORM(INTEGER LSEGPROP, LSEGADDR, LBPROP, LBADDR, ALPROP, ALADDR, W6, W7, W8)
!
RECORD FORMAT COUNTFORM(BYTE INTEGER HFLG, C1, C2, H1, H2, SCTR, KL, DL1, DL2)
!
! Record format and %CONST %RECORD %NAME UINF follows.
END OFLIST
RECORD FORMAT TMODEF(HALF INTEGER FLAGS1, FLAGS2, {.04} BYTE INTEGER PROMPTCHAR, ENDCHAR,
{.06} BYTE ARRAY BREAKBIT1(0:3) {%or %halfintegerarray BREAKBIT2(0:1))},
{.0A} BYTE INTEGER PADS, RPTBUF, LINELIMIT, PAGELENG,
{.0E} BYTE INTEGER ARRAY TABVEC(0:7), {.16} BYTE INTEGER CR, ESC, DEL, CAN, SP1, SP2,
SP3, SP4, SP5, SP6)
{length of this format is X20 bytes}
RECORD FORMAT UINFF(STRING (6) USER, STRING (31) JOBDOCFILE, {.28} INTEGER MARK, FSYS,
{.30} PROCNO, ISUFF, REASON, BATCHID, {.40} SESSICLIM, SCIDENSAD, SCIDENS, STARTCNSL,
{.50} AIOSTAT, SCT DATE, SYNC1 DEST, SYNC2 DEST, {.60} ASYNC DEST, AACCT REC, AIC REVS,
{.6C} STRING (15) JOBNAME, {.7C} STRING (31) BASEFILE, {.9C} INTEGER PREVIC,
{.A0} ITADDR0, ITADDR1, ITADDR2, ITADDR3, {.B0} ITADDR4, STREAM ID, DIDENT, SCARCITY,
{.C0} PREEMPTAT, STRING (11) SPOOLRFILE, {.D0} INTEGER FUNDS, SESSLEN, PRIORITY, DECKS,
{.E0} DRIVES, PART CLOSE, {.E8} RECORD (TMODEF) TMODES, {108} INTEGER PSLOT,
{10C} STRING (63) ITADDR, {14C} INTEGER ARRAY FCLOSING(0:3), INTEGER CLO FES,
{160} INTEGER OUTPUT LIMIT, DAPSECS, LONG INTEGER DAPINSTRS, {170} INTEGER OUT,
STRING (15) OUTNAME, {184} INTEGER HISEG, {188} STRING (31) FORK,
{1A8} INTEGER INSTREAM, OUTSTREAM, {1B0} INTEGER DIRVSN, INTEGER UEND)
CONST RECORD (UINFF) NAME UINF=9<<18
LIST
! This COMF record format taken from ERCC08.PCOMF on 19th Aug 1983
RECORD FORMAT CDRF(BYTE INTEGER DAPNO, DAPBLKS, DAPUSER, DAPSTATE, INTEGER DAP1, DAPBMASK)
RECORD FORMAT COMF(INTEGER OCPTYPE, SLIPL, SBLKS, SEPGS, NDISCS, DLVNADDR,
(INTEGER GPCTABSIZE, GPCA OR C
INTEGER DCUTABSIZE, DCUA), INTEGER SFCTABSIZE, SFCA, SFCK, DIRSITE, DCODEDA, SUPLVN, TOJDAY,
DATE0, DATE1, DATE2, TIME0, TIME1, TIME2, EPAGESIZE, USERS, CATTAD, SERVAAD,
BYTE INTEGER NSACS, RESV1, (BYTE INTEGER SACPORT1, SACPORT0 OR C
BYTE INTEGER OCP1 SCU PORT, OCP0 SCU PORT), BYTE INTEGER NOCPS, SYSTYPE, OCPPORT1,
OCPPORT0, INTEGER ITINT, (INTEGER CONTYPEA, GPCCONFA, FPCCONFA, SFCCONFA OR C
INTEGER DCU2HWNA, DCUCONFA, MIBA, SP0), INTEGER BLKADDR, RATION, (INTEGER SMACS OR C
INTEGER SCUS), INTEGER TRANS, LONG INTEGER KMON, INTEGER DITADDR, SMACPOS, SUPVSN, PSTVA,
SECSFRMN, SECSTOCD, SYNC1DEST, SYNC2DEST, ASYNCDEST, MAXPROCS, INSPERSEC, ELAPHEAD,
COMMSRECA, STOREAAD, PROCAAD, SFCCTAD, DRUMTAD, TSLICE, FEPS, MAXCBT, PERFORMAD,
RECORD (CDRF) ARRAY CDR(1:2), INTEGER LSTL, LSTB, PSTL, PSTB, HKEYS, HOOT, SIM, CLKX,
CLKY, CLKZ, HBIT, SLAVEOFF, INHSSR, SDR1, SDR2, SDR3, SDR4, SESR, HOFFBIT, BLOCKZBIT,
BLKSHIFT, BLKSIZE, END)
!
CONST INTEGER DISCSNO=X'00200000'
CONST INTEGER SD=X'58000000'; ! STRING DESRCPTR FOR ADDRSS LIST
!
EXTERNAL ROUTINE SPEC DOUT11(RECORD (PARMF) NAME P)
EXTERNAL ROUTINE SPEC DPON(RECORD (PARMF) NAME P)
EXTERNAL ROUTINE SPEC DPOFF(RECORD (PARMF) NAME P)
EXTERNAL ROUTINE SPEC PROMPT(STRING (15) S)
EXTERNAL ROUTINE SPEC UCSTRG(STRING NAME S)
EXTERNAL ROUTINE SPEC RDINT(INTEGER NAME I)
EXTERNAL STRING FN SPEC INTERRUPT
EXTERNAL ROUTINE SPEC TERMINATE
EXTERNAL ROUTINE FORMAT(STRING (63) S)
!***********************************************************************
!* FORMATS A DISC FROM DATA IN THE PROPERTY TABLE *
!***********************************************************************
STRING (8) FN SPEC STRHEX(INTEGER VALE)
RECORD (PARMF) P
RECORD (COUNTFORM) NAME COUNT
RECORD (DDTFORM) NAME DDT
RECORD (PROPFORM) NAME PROP
RECORD (RQBFORM) NAME RQB
RECORD (COMF) NAME COM
BYTE INTEGER ARRAY FORMAT DATAF(0:255)
BYTE INTEGER ARRAY NAME DATA
INTEGER STATE, MNEM, SLOT, DSNO
INTEGER TRACK, LTRACK, UTRACK, CYL COUNT, CYL, LCYL, UCYL, PPTRK, BUFFA, CDEX, SERVNO
CONST INTEGER GETPAGE=X'50000',RETURNPAGE=X'60000'
INTEGER I, ALA, LBA, DATAPTR, WCKD, RDATA, KEYLEN, BUFFSIZE
BUFFA=-1 {buffer page address; -1 if no page claimed}
COM==RECORD(X'80C00000')
BUFFSIZE=1024*COM_EPAGESIZE
PRINTSTRING("FORMAT vsn ".VSN)
NEWLINE
PROMPT("Device: ")
UCSTRG(S) WHILE LENGTH(S)#4
CYCLE I=0, 1, 3
BYTEINTEGER(ADDR(MNEM)+I)=CHARNO(S, I+1)
REPEAT
PROMPT("Lower cyl: ")
RDINT(LCYL)
IF LCYL>=0 THEN PROMPT("Upper cyl: ") AND RDINT(UCYL)
PROMPT("Lower track: ")
RDINT(LTRACK)
IF LTRACK>=0 THEN PROMPT("Upper track: ") AND RDINT(UTRACK)
SERVNO=UINF_SYNC1DEST
!
! CLAIM THE DISC FOR PRIVATE USE
!
P_DEST=DISCSNO+1
P_P2=SERVNO+2
P_SRCE=SERVNO+1
P_P3=MNEM
P_P1=M'FRMR'
DPON(P)
DPOFF(P) UNTIL P_P1=M'FRMR'
SLOT=P_P3
DSNO=P_P2
IF DSNO=0 START
PRINTSTRING("Formatter claim fails")
WRITE(DSNO, 1)
NEWLINE
RETURN
FINISH
DDT==RECORD(INTEGER(COM_DITADDR+SLOT*4))
PROP==RECORD(DDT_PROPADDR)
KEYLEN=PROP_KEYLEN
PRINTSTRING("Formatting with")
WRITE(PROP_BLKSIZE, 2)
PRINTSTRING(" byte blocks")
NEWLINE
IF LCYL=-1 THEN LCYL=0 AND UCYL=PROP_CYLS-1
IF LTRACK=-1 THEN LTRACK=0 AND UTRACK=PROP_TRACKS-1
UNLESS 0<=LTRACK<=UTRACK AND UTRACK<PROP_TRACKS AND 0<=LCYL<=UCYL AND UCYL<PROP_CYLS START
PRINTSTRING("FORMAT fails - invalid CYL/TRK params")
NEWLINE
->FINISH
FINISH
PPTRK=PROP_PPERTRK
NEWLINE
PRINTSTRING(" [ Interrupt to terminate only with Int:STOP ]")
NEWLINES(2)
!
! SET UP THE CCW TO WRITE HOME ADDRESS AND SECTOR 0 ON TRACK 0 CYL 0
!
CYL COUNT=0
CYL=LCYL
UNTIL CYL>UCYL CYCLE
IF CYL COUNT&7=0 START
! Free the page occasionally (and also come here first time) in case system is reconfiguring
IF BUFFA#-1 START
P_DEST=RETURN PAGE
P_SRCE=0; ! REPLY NOT WANTED
P_P2=CDEX
DPON(P); ! RETURN THE CORE PAGE
FINISH
! GET A 4K BUFFER
P_DEST=GET PAGE
P_SRCE=1
P_P1=M'FRMR'
DPON(P)
DPOFF(P) UNTIL P_P1=M'FRMR'
CDEX=P_P2
BUFFA=P_P4
! INITIALISE THE BUFFER
INTEGER(BUFFA)=M'EMAS'
CYCLE I=BUFFA+4, 4, BUFFA+BUFFSIZE-4
INTEGER(I)=X'08CEF731'
REPEAT
DATA==ARRAY(BUFFA+BUFFSIZE-256, DATAF)
FINISH
TRACK=LTRACK
UNTIL TRACK>UTRACK CYCLE
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_H1=0
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
COUNT_HFLG=X'20'; ! DUMP&IPL ALLOWED
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)
!
! THE PROBLEM OF INCONSISTENT BUFFER & BLOCK SIZES IS DIFFICULT
! IF ADDRESS LIST ENTRIES ARE SET TO BUFFER SIZE AND ID INFO TO
! THE BLOCKSIZE THEN ALL WILL WORK IF LENGTH CHECKS ARE SUPPRESSED
! THIS AVOIDS A PROPER FORMAT CHECK IF BUFFER SMALLER THAN BLOCKS
! BUT HAS NO OTHER ILL EFFECTS
!
INTEGER(ALA+32)=SD+BUFFSIZE
INTEGER(ALA+36)=BUFFA
DATAPTR=DATAPTR+9
LBA=LBA+12
ALA=ALA+40
CYCLE I=1, 1, PPTRK
COUNT==RECORD(ADDR(DATA(DATAPTR)))
COUNT_C1=CYL>>8; COUNT_C2=CYL&255
COUNT_H1=0
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; ! IGNRE LNG&SHRT BLKS(OLD FORMATS!)
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
CYCLE I=1, 1, PPTRK
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
P_DEST=DSNO
P_SRCE=SERVNO+2
P_P5=RQB_LSEGPROP
P_P6=RQB_LSEGADDR; ! TILL OUT18 PROVIDES THESE
P_P2=CYL<<16!TRACK
P_P1=M'FRMR'
DOUT11(P)
IF P_P2#0 THEN START ; ! FAILURE
PRINTSTRING("CYL ")
WRITE(CYL, 1)
PRINTSTRING(" TRK ")
WRITE(TRACK, 1)
PRINTSTRING(" faulty")
NEWLINE
PRINTSTRING(STRHEX(P_P3)." ")
CYCLE I=0, 4, 12
PRINTSTRING(STRHEX(INTEGER(P_P6+I))." ")
REPEAT
NEWLINE
DATA(0)=2; ! DEFECTIVE TRACK
INTEGER(DDT_LBA+4)=X'80000300'; ! WRITE HA
P_DEST=DSNO
P_SRCE=SERVNO+2
P_P1=M'FRME'
STATE=4
DPON(P)
DPOFF(P) UNTIL P_P1=M'FRME'
FINISH
TRACK=TRACK+1
REPEAT
IF CYL COUNT=0 THEN PRINTSTRING("Cylinders completed: ") AND NEWLINE
WRITE(CYL, 1)
IF (CYL COUNT+1)&15=0 OR CYL=UCYL THEN NEWLINE ELSE TERMINATE
S=INTERRUPT
IF S="STOP" OR S="stop" START
PRINTSTRING(" Formatter terminated")
NEWLINE
->FINISH
FINISH
CYL=CYL+1
CYL COUNT=CYL COUNT+1
REPEAT
NEWLINE
IF INTEGER(BUFFA)#M'EMAS' AND KEYLEN#0 THEN PRINTSTRING("FORMAT fails") ELSE C
PRINTSTRING("FORMAT complete")
NEWLINE
FINISH:
! RETURN DEVICE
P_DEST=DISCSNO+1
P_P3=SLOT
STATE=0
P_P2=0
DPON(P)
IF BUFFA#-1 START
P_DEST=RETURN PAGE
P_SRCE=0; ! REPLY NOT WANTED
P_P2=CDEX
DPON(P); ! RETURN THE CORE PAGE
FINISH
STRING (8) FN STRHEX(INTEGER VALUE)
STRING (8) S
CONST BYTE INTEGER ARRAY H(0:15)='0','1','2','3','4','5','6','7',
'8','9','A','B','C','D','E','F'
*LD_S; *LSS_8; *ST_(DR )
*INCA_1; *STD_ TOS ; *STD_ TOS
*LSS_0; *LUH_VALUE; *MPSR_X'24'; ! SET CC=1
*SUPK_ L =8
*LD_ TOS ; *ANDS_ L =8, 0, 15; ! FORCE ZONE CODE TO 0
*LSS_H+4; *LUH_X'18000010'
*LD_ TOS ; *TTR_ L =8
RESULT =S
END
END
END OF FILE