RECORDFORMAT PARMF(INTEGER DEST, SRCE, P1, P2, P3, P4, P5, P6)
RECORDFORMAT SERVAF(INTEGER P, C)
EXTERNALINTEGERSPEC INPTR
EXTERNALINTEGERSPEC OUTPTR
CONSTINTEGER MASK=X'80FC3FFF'
EXTERNALINTEGERFNSPEC HANDKEYS
EXTERNALROUTINESPEC HOOT(INTEGER NUM)
EXTERNALROUTINESPEC GDC(RECORD (PARMF)NAME P)
IF SSERIES=NO START
EXTERNALINTEGERFNSPEC GPC INIT(INTEGER CA,PT,MODE)
FINISH
EXTERNALINTEGERFNSPEC SAFE IS READ(INTEGER ISAD,INTEGERNAME VAL)
EXTERNALROUTINESPEC GET PSTB(INTEGERNAME P0, P1)
EXTERNALROUTINESPEC SUP29
EXTERNALROUTINESPEC SUPPOFF(RECORD (SERVAF)NAME SERV, C
RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC DISC(RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC PDISC(RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC SLAVESONOFF(INTEGER J)
EXTERNALROUTINESPEC PKMONREC(STRING (20)TEXT,RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC WAIT(INTEGER MILLISECS)
!*
!* Communications record format - extant from CHOPSUPE 22B 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, C
(BYTEINTEGER SACPORT1,SACPORT0 OR BYTEINTEGER C
OCP1 SCU PORT,OCP0 SCU PORT), BYTEINTEGER C
NOCPS,SYSTYPE,OCPPORT1,OCPPORT0,INTEGER ITINT, C
(INTEGER CONTYPEA,GPCCONFA OR INTEGER DCU2HWNA,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,BYTEINTEGER DAPNO,DAPBLKS,DAPUSER,DAPSTATE, C
INTEGER DAP1,SP1,SP2,SP3,SP4, 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)
!*
CONSTRECORD (COMF)NAME COM=X'80C00000'
!------------------------------------------------------------------------
RECORDFORMAT GDCTF(BYTEINTEGER FLAGS,DEVTYPE,BUSY,LINK, C
INTEGER SP1,RESPONSE DEST,DEVENTA, C
(INTEGER CST,PTSM OR INTEGER UTAD,DSSMM),INTEGER MNEM, C
BYTEINTEGER MI,PR3,SERVRT,STATE)
CONSTINTEGER SLOTSIZE=32
RECORDFORMAT ENTFORM(INTEGER SER, PTSM, PROPADDR, C
TICKS SINCE, CAA, GRCB AD, LBA, ALA, STATE, RESP0, C
RESP1, SENSE1, SENSE2, SENSE3, SENSE4, REPSNO, BASE, C
ID, DLVN, MNEMONIC, ENTSIZE, PAW, USAW0, URCB AD, C
SENSDAT AD, LOGMASK, TRTAB AD, UA SIZE, UA AD, C
TIMEOUT, PROPS0, PROPS1)
OWNINTEGERARRAYFORMAT BF(0:127)
IF SSERIES=YES START
EXTERNALINTEGERFN PINT
RECORDFORMAT ISTF(INTEGER LNB,PSR,PC,SSR,SF,IT,IC)
RECORD (ISTF)NAME IST4,IST14
RECORD (ISTF) SAVE IST4,SAVE IST14
INTEGER SSR,LNB,PC,SF
INTEGER I,J,K
*LSS_(3); *ST_SSR; *USH_-26; *AND_3; *ST_I
I=X'80000000'!I<<18
IST4==RECORD(I+(4-1)*32)
IST14==RECORD(I+(14-1)*32)
I=0
SAVE IST4=IST4
SAVE IST14=IST14
*STLN_LNB
*STSF_SF
*JLK_<INT4>; *LSS_TOS ; *ST_PC
IST4_LNB=LNB
IST4_PSR=X'14FF01'
IST4_PC=PC
IST4_SSR=SSR
IST4_SF=SF
IST4_IT=X'7FFFFF'
IST4_IC=X'7FFFFF'
IST14=IST4
*JLK_<INT14>; *LSS_TOS ; *ST_PC
IST14_PC=PC
*LSS_SSR; *AND_X'FFFFDFF7'; *ST_(3); ! allow unit & peripheral ints.
WAIT(10)
->FINI
INT4:
*JLK_TOS
*LSS_TOS ; *LSS_TOS
*ST_I; !interrupt param
->FINI
INT14:
*JLK_TOS
*LSS_TOS ; *LSS_TOS
*ST_I
K=UT VA+(I&X'FFFF')*64; ! unit table entry
J=BYTEINTEGER(COM_DCU2HWNA+INTEGER(K+8)>>24)
J=J<<24!(INTEGER(K+8)>>8&255)
! h/w no./00/00/strm
K=I>>16&15; ! int. sub-class
IF K=0 THEN I=J!X'00208000' ELSE C { normal term }
IF K=1 THEN I=J!X'00208400' ELSE C { abterm }
IF K=4 THEN I=J!X'00204000' C { attention }
ELSE I=J!X'00201000' { control term }
FINI:
*LSS_SSR
*ST_(3)
IST4=SAVE IST4
IST14=SAVE IST14
RESULT =I
END
FINISH
!----------------------------------------------------------------
ROUTINE RESTART
EXTERNALROUTINESPEC CLOCK TO THIS OCP
ROUTINESPEC DOWAIT(INTEGER MASK)
IF SSERIES=YES START
EXTERNALROUTINESPEC DCU1 RECOVERY(INTEGER PARM)
EXTERNALINTEGERFNSPEC REALISE(INTEGER AD)
RECORDFORMAT TCBF(INTEGER CMD,STE,LEN,DATAD,NTCB,RESP, C
(BYTEINTEGER INIT MECH,INIT CMASK,INIT SMASK,INIT MODE,INIT FN,INIT SEG, C
HALFINTEGER INIT CYL,BYTEINTEGER INIT HEAD,INIT HDLIMIT, C
HALFINTEGER INIT SCYL,INIT SHEAD,BYTEINTEGER INIT SECT,INIT OFFSET C
OR INTEGER PRE0,PRE1,PRE2,PRE3), C
INTEGER POST0,POST1,POST2,POST3,POST4,POST5,POST6,POST7)
RECORDFORMAT CAF(INTEGER IAWA,SEMA)
RECORDFORMAT AIF(LONGINTEGER ACTW1,ACTW2,INTEGER ASLOAD,CONFL,CONFAD, C
PCWORDA,AWORDA,ACT0,ACT1,IPLDEV,BYTES)
RECORD (TCBF)NAME TCB
CONSTINTEGER TCBM=X'2F404000'
OWNINTEGER INIT=X'FC03'; ! 1600 BPI/PE
OWNINTEGERARRAY ACTIVATE(0:1)=X'10001400',0
INTEGER DCU1 RECOVERED,PSM,PCWORDA,AWORDA
CONSTINTEGER CONFIG SEG=49
FINISH ELSE START
RECORDFORMAT RQBF(INTEGER LFLAG,LSTBA,LBL,LBA,ALL,ALA,INIT)
RECORDFORMAT STRMF(INTEGER SAW0,SAW1,RESP0,RESP1)
RECORDFORMAT CAF(INTEGER MARK,PAW,PIW0,PIW1,CSAW0,CSAW1,CRESP0,C
CRESP1,RECORD (STRMF)ARRAY STRMS(0:15))
RECORDFORMAT AIF(LONGINTEGER ACTW1,ACTW2,INTEGER ASLOAD,WTIME)
RECORD (RQBF)NAME RQB
INTEGERNAME LBE,ALE1,ALE2
INTEGER PTSM,STRM,RESP0,RESP1
INTEGER SMARK,SENSE1,SENSE2,SENSE3,SENSE4,SRESP,GPC INITTED
INTEGER PT
CONSTINTEGER IPL=5
FINISH
RECORD (PARMF) P
RECORD (GDCTF)NAME GDCT
RECORD (ENTFORM)NAME D
RECORD (CAF)NAME CA
RECORDFORMAT SEG10F(INTEGER SYSERRP,STACK,LSTL,LSTB,PSTL,PSTB, C
HKEYS,INPTR,OUTPTR,BUFFLASTBYTE,OLDSE,OLDST,OLDLSTL,OLDLSTB,SBLKS, C
PASL,KQ,RQ1,RQ2,SA1,SA2,LONGINTEGER PARM,PARML,INTEGERARRAY BLOCKAD(0:127))
RECORDFORMAT STOREF(BYTEINTEGER FLAGS,USERS,HALFINTEGER C
LINK,BLINK,FLINK,INTEGER REALAD)
RECORDFORMAT AMTF(INTEGER DA,DDPUSERS,LINKLENOUTS)
CONSTINTEGER AMTASEG=21
CONSTRECORD (SEG10F)NAME SEG10=X'80000000'+10<<18
INTEGERARRAYNAME BLOCKAD
EXTRINSICINTEGER PARMASL, KERNELQ, RUNQ1, RUNQ2
CONSTRECORD (SERVAF)ARRAYNAME SERVA=SERVAAD
EXTRINSICLONGINTEGER PARMDES
LONGINTEGER A
INTEGER I,J,K,HKEYS,AMTK
!* AUTO IPL declarations
OWNRECORD (AIF) AI
CONSTINTEGER PSTLEN VA=PST VA+PST SEG*8
CONSTINTEGER APST=X'3F000'; ! safe place for PST
CONSTINTEGER APST VA=APST!X'81000000'
! establish clock in this OCP
CLOCK TO THIS OCP
SLAVESONOFF(0)
IF SSERIES=YES THEN DCU1 RECOVERED=0 ELSE GPC INITTED=0
!
! Seg 10 (which must be in SMAC0/SCU0-block0) is used at failure to pass
! info to the dump program. First 4 words are set up by system
! error routine (where appropiate)
!
AGN:
FOR I=0,4,8 CYCLE
J=INTEGER(ADDR(COM_PSTL)+I)
IF SAFE IS READ(J,K)=0 THEN START
INTEGER(X'81000000'+I)=K
INTEGER(X'80280010'+I)=K
FINISH
REPEAT
SEG10_INPTR=INPTR; ! for the printer buffer
SEG10_OUTPTR=OUTPTR
SEG10_BUFFLASTBYTE=MASK
SEG10_SBLKS=COM_SBLKS
BLOCKAD==ARRAY(COM_BLKADDR,BF)
FOR I=0,1,SEG10_SBLKS-1 CYCLE
SEG10_BLOCKAD(I)=BLOCKAD(I)
REPEAT
SEG10_PASL=PARMASL
SEG10_KQ=KERNELQ
SEG10_RQ1=RUNQ1
SEG10_RQ2=RUNQ2
SEG10_SA1=X'18000000'+SERVASIZE
SEG10_SA2=SERVAAD
SEG10_PARM=PARMDES
SEG10_PARML=0
HKEYS=HANDKEYS
P=0
IF SSERIES=YES START
PSM=HKEYS&X'FFFF'
IF HKEYS>>16=X'DCDC' START
IF DCU1 RECOVERED=0 START
! reset DCU1 in extremis only - better to dump to disc
DCU1 RECOVERED=PSM>>12; ! DCU h/w no.
UNLESS 0<DCU1 RECOVERED<=3 THEN DCU1 RECOVERED=-1
DCU1 RECOVERY(DCU1 RECOVERED)
->AGN
FINISH
HKEYS=HKEYS&X'FFFF'
FINISH
*LSS_(16); *USH_-24; *ST_PCWORDA; ! OCP SCU port
PCWORDA=PCWORDA<<22!X'60000010'; ! processor coupler address
P_P1=PSM>>4<<8!PSM&15; ! DSSxM
FINISH ELSE START
PTSM=HKEYS&X'FFFF'
P_P1=PTSM
FINISH
P_DEST=8; ! emergency allocate
GDC(P)
IF P_P1#0 START
PKMONREC("Claim dump MT fails:",P)
NEWLINE
->WRITEOUT
FINISH
D==RECORD(P_P3)
CA==RECORD(D_CAA)
IF SSERIES=YES START
TCB==RECORD(D_GRCB AD)
AWORDA=CA_IAWA; ! activate word address
*LB_PCWORDA; *MPSR_X'12'; *L_(0+B ); ! free CC (perhaps!)
J=0
I=PINT AND J=J+1 UNTIL I=0 OR J=100
ACTIVATE(0)=ADDR(TCB)
ACTIVATE(1)=3<<24!PSM>>4&X'FF'; !connect stream
A=LONGINTEGER(ADDR(ACTIVATE(0)))
I=100; ! for timeout
*LSD_A; *LB_AWORDA; *ST_(0+B )
CON: *MPSR_X'12'; *L_(0+B ); *MPSR_X'11'
*JAT_4,<CONOK>
I=I-1
IF I>0 START
*LB_AWORDA
*J_<CON>
FINISH
CONOK:
J=0
I=PINT AND J=J+1 UNTIL I#0 OR J=100
ACTIVATE(1)=ACTIVATE(1)&X'00FFFFFF'!1<<24; !start stream
TCB_CMD=TCBM!X'81'; ! initialise
TCB_STE=REALISE(ADDR(INIT)&X'FFFC0000')!1; !GLA STE
TCB_LEN=4
TCB_DATAD=ADDR(INIT)
INIT=(PSM&15)<<24!X'FC03'; ! mechanism,status mask & 1600 bpi
DOWAIT(X'C00000')
TCB_CMD=TCBM!X'238'; !rewind to BT (& skip data)
DOWAIT(X'C00000'); ! wait for term
J=0
I=PINT AND J=J+1 UNTIL I#0 OR J=100; !wait for BT sense
FINISH ELSE START
RQB==RECORD(D_GRCB AD)
CA_MARK=-1
LBE==INTEGER(RQB_LBA)
ALE1==INTEGER(RQB_ALA)
ALE2==INTEGER(RQB_ALA+4)
RQB_LFLAG=1<<18!X'C000'; ! LST 1 seg,note mech no,ACR=0
! and trusted chain
RQB_LSTBA=X'8080'
RQB_LBL=4; RQB_ALL=8
RQB_INIT=(PTSM&15)<<24!X'C003'; ! status mask&1600BPI
STRM=PTSM>>4&15
ALE1=X'58000000'+EPAGESIZE*1024
ALE2=X'81000000'
LBE=X'00F10800'; ! connect stream if nec
DOWAIT(X'C00000')
IF RESP0=0 OR RESP0>>16&X'41'=X'41' START ;! time out or CDE
IF GPC INITTED=0 THEN GPC INITTED=X'80000000'! C
GPC INIT(ADDR(CA),PTSM>>8,1) AND ->AGN
FINISH
LBE=X'80F03800'; ! rewind
DOWAIT(X'C00000'); ! wait for term(=rewnd starts)
! if ok wait for attn else sense
IF RESP0&X'800000'#0 THEN DOWAIT(X'80100000') ELSE START
SMARK=X'F1F1F1F1'; ! just a dump marker
SRESP=0
ALE1=X'5800000D'
ALE2=ADDR(SENSE1)
LBE=X'00F00400'
DOWAIT(X'C00000'); ! wait for sense term.
SRESP=RESP0; ! remember result
ALE1=X'58000000'+EPAGESIZE*1024;! reset ALE
ALE2=X'81000000'
FINISH
FINISH
WAIT(1000); ! wait about 1 sec
IF SSERIES=YES START ; ! read over label
TCB_CMD=TCBM!X'202'
TCB_LEN=4096
FINISH ELSE LBE=X'80F04200'
DOWAIT(X'C00000')
IF SSERIES=YES THEN TCB_CMD=TCBM!X'A3' ELSE LBE=X'80F02300'
DOWAIT(X'C00000'); ! write TM
IF SSERIES=YES THEN TCB_CMD=TCBM!X'83' ELSE LBE=X'80C00300'
FOR I=0,1,SEG10_SBLKS-1 CYCLE ; ! dump store in 4K blocks
IF SSERIES=YES THEN TCB_STE=BLOCKAD(I)!1
FOR J=0,4096,31*4096 CYCLE
IF SSERIES=YES THEN TCB_DATAD=J ELSE C
ALE2=X'81000000'+SEG10_BLOCKAD(I)+J
DOWAIT(X'C00000')
REPEAT
REPEAT
IF SSERIES=YES THEN TCB_CMD=TCBM!X'A3' ELSE LBE=X'80F02300'
DOWAIT(X'C00000'); ! write 2 TMs
DOWAIT(X'C00000')
IF SSERIES=YES THEN TCB_CMD=TCBM!X'258' ELSE LBE=X'80F01800'
{ X'80F03800' for rewind}
DOWAIT(X'C00000'); ! unload
WRITEOUT: ! writout updated pages
AMTK=LONGINTEGER(PST VA+8*AMTASEG)>>42&X'FF'+1
BEGIN
ROUTINESPEC ACCEPT DISC INTS
INTEGER STOREX,PONNED,POFFED,EPX,AMTX,VAD
RECORD (AMTF)ARRAYFORMAT AMTAF(1:AMTK*1024//12)
CONSTRECORD (STOREF)ARRAYNAME STORE=STORE0AD
RECORD (AMTF)ARRAYNAME AMTA
RECORD (STOREF)NAME ST
AMTA==ARRAY(X'80000000'+AMTASEG<<18+4*AMTK,AMTAF)
!
! Step 1 - remove old disc ints. & pageturn replies
!
POFFED=0; ACCEPT DISC INTS
POFFED=0; PONNED=0
CYCLE STOREX=1,1,COM_SEPGS
ST==STORE(STOREX)
IF ST_USERS>0 AND ST_FLAGS&8#0 START
ST_FLAGS=ST_FLAGS&X'F7';! remove written bit
VAD=ST_REALAD+X'81000000'
INTEGER(VAD)=INTEGER(VAD); ! on P series QSTOPs if store block has no power
! (otherwise FFs written to disc)
! on S series who knows??
AMTX=ST_BLINK
EPX=ST_FLINK
P_DEST=X'210002'
P_SRCE=X'80040005'; ! pageturn writeout
P_P1=M'DUMP'
P_P2=AMTA(AMTX)_DA+EPX
P_P3=VAD
PDISC(P)
PONNED=PONNED+1
IF PONNED&15=0 THEN ACCEPT DISC INTS
FINISH
REPEAT
!
! Last step - await the replies with a timeout
!
FOR STOREX=1,1,100 CYCLE
ACCEPT DISC INTS
EXIT IF POFFED>=PONNED
REPEAT
HOOT(40)
!
! Send a form feed to all LPs for tidy IPL
!
K=COM_GPCA+INTEGER(COM_GPCA+4)<<2; ! Base of DCU/GPC slots
FOR I=0,1,INTEGER(COM_GPCA+8) CYCLE
GDCT==RECORD(K+I*SLOTSIZE)
IF GDCT_MNEM>>8=M'LP' START
D==RECORD(GDCT_DEVENTA)
CA==RECORD(D_CAA)
IF SSERIES=YES AND GDCT_UTAD=0 START
! DCU1s only protem
AWORDA=CA_IAWA
TCB==RECORD(D_GRCB AD)
ACTIVATE(0)=ADDR(TCB)
ACTIVATE(1)=1<<24!GDCT_DSSMM>>8&255; ! start stream
TCB=0
TCB_CMD=X'2F404083'
TCB_STE=REALISE(ADDR(TCB)&X'FFFC0000')!1
TCB_LEN=1
TCB_DATAD=ADDR(TCB_PRE0)
TCB_PRE0=12<<24; ! form feed
DOWAIT(0); ! ignore fails
FINISH ELSE IF SSERIES=NO AND GDCT_STATE#5 START
PTSM=GDCT_PTSM&X'FFFF'
STRM=PTSM>>4&15
RQB==RECORD(D_GRCB AD)
CA_MARK=-1
LONGINTEGER(RQB_LBA)=X'04F1080082F0030C'; ! Connect & write FF
LONGINTEGER(RQB_ALA)=X'5800000481000000'; ! Valid descriptor
RQB_LFLAG=X'4000'
RQB_LBL=8
RQB_ALL=8
DOWAIT(X'C00000')
FINISH
FINISH
REPEAT
IF COM_SLIPL>=0 AND HKEYS>>16=0 THEN START
*IDLE_X'EEEE'
FINISH
!*
!*
!*
ROUTINE ACCEPT DISC INTS
RECORD (PARMF) P
IF SSERIES=YES START
CYCLE
I=PINT; ! peripheral & unit interrupts
EXIT IF I=0
P_DEST=X'300003'
P_SRCE=M'WOUT'
P_P1=I
GDC(P); ! all ints. to GDC
REPEAT
WHILE SERVA(32)_P&X'FFFFFF'#0 CYCLE ; ! send replies to DISC
SUPPOFF(SERVA(32),P)
IF P_SRCE=X'300003' THEN DISC(P)
REPEAT
FINISH ELSE START
INTEGER NFPCS,INF
RECORD (CAF)NAME CCA
NFPCS=INTEGER(COM_FPCCONFA)
RETURN IF NFPCS<=0
CYCLE I=1,1,NFPCS
INF=INTEGER(COM_FPCCONFA+4*I)
CCA==RECORD(X'80000000'+(INF&255)<<18)
IF CCA_PIW0#0 START ; ! int pending on this FPC
P_DEST=X'200003'
P_SRCE=M'WOUT'
P_P1=INF>>24; ! port&trunk
DISC(P)
HOOT(1)
FINISH
REPEAT
FINISH
WHILE SERVA(4)_P&X'FFFFFF'#0 CYCLE
SUPPOFF(SERVA(4),P)
IF P_P1=M'DUMP' THEN POFFED=POFFED+1
REPEAT
END
END
!
!* AUTO IPL
!
IF SSERIES=YES START
P=0
P_DEST=8
P_P1=COM_SLIPL<<16>>8; ! DSS00
GDC(P); ! locate IPL disc
IF P_P1#0 START
PKMONREC("IPL claim fails:",P)
*IDLE_X'A1A1'
FINISH
D==RECORD(P_P3)
TCB==RECORD(D_GRCB AD)
CA==RECORD(D_CAA)
AWORDA=CA_IAWA
! re-connect stream just in case
A=LENGTHENI(ADDR(TCB))<<32!3<<24!COM_SLIPL&255
*LSD_A; *LB_AWORDA; *ST_(0+B )
J=10
J=J-1 UNTIL PINT#0 OR J=0
AI_CONFL=INTEGER(PST VA+CONFIG SEG<<3)+X'80'; ! CFGT length
AI_CONFAD=INTEGER(PST VA+CONFIG SEG<<3+4); ! & real address
AI_PCWORDA=PCWORDA
AI_AWORDA=AWORDA
AI_ACT0=ADDR(TCB)
AI_ACT1=1<<24!COM_SLIPL&255
AI_IPLDEV=COM_SLIPL&X'FFFF'
FINISH ELSE START
J=INTEGER(COM_FPCCONFA)
IF J=0 START ; ! NO DFCS!!
*IDLE_X'A1A1'
FINISH
PT=COM_SLIPL>>4&255
STRM=COM_SLIPL&15
CYCLE I=1,1,J
K=INTEGER(COM_FPCCONFA+4*I)
IF K>>24=PT START ; ! THIS DFC
CA==RECORD(X'80000000'+(K&255)<<18)
->AIDEVOK
FINISH
REPEAT
*IDLE_X'A1A2'
AIDEVOK:
IF BASIC PTYPE=4 START ; ! CLEAR SAC INTERRUPTS
*LB_X'4014'; *LSS_(0+B ); *AND_X'FFFFFCFF'; *ST_(0+B )
*LSS_(X'4013'); *AND_X'FFFF7FFB'; *ST_(X'4013')
! DONT BROADCAST SE IN DUALS
FINISH ELSE START
I=X'FF'!!(X'88'>>(PT>>4))
*LSS_I; *ST_(X'600A'); ! OPEN PATH TO IPL SAC
*LSS_0; *ST_(X'6009'); ! DONT BROADCAST SE
FINISH
J=PT>>4; ! clear peripheral interrupts
I=J<<20!X'44000000'
*LB_I; *LSS_(0+B )
UNLESS COM_NSACS=1 START ; ! both SACS
I=(J!!1)<<20!X'44000000'
*LB_I; *LSS_(0+B )
FINISH
CA=0
CA_MARK=-1
CA_PAW=IPL<<24!STRM
AI_WTIME=250*15*COM_INSPERSEC; ! approx 15 secs
FINISH
AI_ACTW1=X'0004000000000028'; ! activate words
AI_ACTW2=0
IF COM_SLIPL<0 THEN AI_ASLOAD=COM_SLIPL<<1>>17 C
ELSE AI_ASLOAD=0; ! AUTO SLOAD parms
I=INTEGER(PSTLEN VA)&X'FF80'+128; ! move PST to safety
I=I!X'18000000'
*LDA_APSTVA; *LDTB_I
*LSS_PST VA; *LUH_I
*MV_L =DR
I=COM_PSTB; ! set new PSTB
*LB_I; *LSS_APST; *ST_(0+B )
J=ADDR(AI)
*LCT_J; ! address record AI
IF SSERIES=YES START
ACTIVATE(0)=AI_ACT0
ACTIVATE(1)=AI_ACT1
TCB=0; ! read VOL label
TCB_CMD=X'2040C012'
TCB_STE=1; ! to RA 0
TCB_LEN=80
TCB_INIT SMASK=X'FE'
TCB_INIT FN=X'20'; ! restore
DOWAIT(1)
! the next step should be to extract the pointer to & read the
! supervisor loader but until formats etc. are sorted we shall
! just read down CHOPSUPE.
AI_BYTES=55*4*1024; ! max CHOPSUPE size
TCB_CMD=X'2F40C006'; ! autoread
TCB_LEN=X'10000'; ! 64K
TCB_INIT MODE=X'40'; ! S byte only
TCB_INIT FN=X'3C'; ! restore (lest mech error) & seek
TCB_INIT HDLIMIT=5; ! max required for 64K
*LCT_J
*LXN_TCB+4
SIPL: *LB_(CTB +7); *MPSR_X'12'; *L_(0+B ); ! read PC words
*LSS_0; *ST_(XNB +5); ! TCB_RESP=0
*LSD_(CTB +9); *LB_(CTB +8); *ST_(0+B ); ! fire I/O
WAC: *MPSR_X'12'; *L_(0+B ); *MPSR_X'11'
*JAF_4,<WAC>; ! wait for accept
WRESP:
*LSS_(XNB +5); *JAT_4,<WRESP>; ! wait for response
*USH_-30; *JAT_4,<OK>; ! -> successful
*LSS_(XNB +5); *USH_-24; ! short block?
*ICP_X'98'; *JCC_8,<OK>; ! -> yes ok
*LDTB_X'18000038'; *STXN_TOS ; ! save failing TCB
*LDA_TOS ; *CYD_0
*LDA_X'81000020'; *MV_L =DR ; ! at RA 32
*LSS_X'2F404004'; *ST_(XNB +0); ! sense
*LSS_0; *ST_(XNB +3); ! to RA 0
*ST_(XNB +5)
*LSS_32; *ST_(XNB +2)
*LSD_(CTB +9); *LB_(CTB +8); *ST_(0+B )
*IDLE_X'A1A2'; ! IPL failed
OK:
*LSS_(XNB +0); *AND_X'FFFF7FFF'; *ST_(XNB +0); ! unset initialise
*LSS_(XNB +5); *AND_X'FFFF'; ! RBC
*IRSB_X'10000'; *ST_(XNB +5); ! bytes transferred
*IAD_(XNB +3); *ST_(XNB +3); ! increment address
*LSS_(XNB +5); *IRSB_(CTB +12); ! left to go
*JAF_5,<SIPLEND>; ! -> fini
*ST_(CTB +12)
*LSS_X'10000'; *ST_(XNB +2); ! next 64K
*ICP_(XNB +5); *JCC_8,<SIPL>; ! -> next read same CYL
! works ok provided blocks/cyl # 16,32 or 48
*LSS_(XNB +7); *IAD_1; *ST_(XNB +7); ! increment CYL
*LSS_(XNB +8); *AND_X'FFFFFF'; *IAD_1
*ST_(XNB +8); ! & SCYL
*LSS_0; *ST_(XNB +9); ! clear SHEAD,SECTOR
*LSS_(XNB +0); *OR_X'8000'; *ST_(XNB +0); ! initialise for re-seek
*J_<SIPL>; ! -> next I/O
SIPLEND:
*LDTB_X'28000004'; *LDA_X'81000000'; ! RA 0
*LSS_(CTB +11); *ST_(DR +2); ! IPLDEV
*LSS_(CTB +5); *ST_(DR +4); ! CFGT length
*LSS_(CTB +6); *ST_(DR +5); ! & address
*INCA_X'18'; ! to response word
FINISH ELSE START
*LDTB_X'28000004'; *LDA_X'81000018'; ! DR for CRESP0
I=X'40000800'!PT<<16
*LXN_CA+4; ! CA recbase
*LB_I; *LSS_1; *ST_(0+B ); ! send channel flag
*LB_(CTB +5); ! wait time
AWAIT:
*LSS_(XNB +6); *JAF_4,<ARESP>; ! WAIT FOR RESPONSE
*SBB_1; *JAF_12,<AWAIT>; ! OR 15 SECS (SEE FPC DOC 80010797)
*IDLE_X'A1A3'; ! IPL FAILS
ARESP:
*ST_(DR ); ! SET CRESP0
FINISH
*LSS_(CTB +4)
*INCA_X'A4'; ! ACC3 ('18'+'A4' = 'BC')
*ST_(DR ); ! AUTO SLOAD parms
IF SSERIES=NO AND BASIC PTYPE=4 START
*LB_X'50000'; ! wait for SAC port to be set in SIR
WSIR: *SBB_1; *JAF_12,<WSIR>
FINISH
*ACT_(CTB +0); ! enter DBOOT
*IDLE_X'A1A4'
!
ROUTINE DOWAIT(INTEGER MASK)
!***********************************************************************
!* Fires an I-O operation and waits for the reply. Any attentions *
!* are thrown away. Response words are left in globals *
!***********************************************************************
IF SSERIES=YES START
INTEGER I
LONGLONGREAL TCBP
UNLESS MASK<0 START
*LB_PCWORDA; !clear unwanted ints.
*MPSR_X'12'; *L_(0+B )
TCB_RESP=0
A=LONGINTEGER(ADDR(ACTIVATE(0)))
*LSD_A; *LB_AWORDA; *ST_(0+B )
CA: *MPSR_X'12'; *L_(0+B ); *MPSR_X'11'
*JAF_4,<CA>
WHILE TCB_RESP=0 CYCLE ; REPEAT
->FIREOK IF TCB_RESP>>30=0
->FIREOK IF TCB_RESP&X'FFFF'=0; ! no RBC
->FIREOK IF MASK=0; ! ignore fails
TCBP=LONGLONGREAL(ADDR(TCB_POST0))
I=TCB_RESP
*LB_I; *LSQ_TCBP
*JCC_0,<FIREOK>
*IDLE_X'EE10'
FIREOK:
RETURN
FINISH
*LB_PCWORDA; !wait for interrupt
*MPSR_X'12'
CI: *L_(0+B )
*JAT_4,<CI>
RETURN
FINISH ELSE START
INTEGER CHISA,COUNT
RECORD (STRMF)NAME STRMS
COUNT=15*250*COM_INSPERSEC
STRMS==CA_STRMS(STRM)
IF MASK<0 THEN MASK=MASK&X'7FFFFFFF' AND ->AGN
WAIT: *LXN_CA+4; *INCT_(XNB +0)
*JCC_8,<ON>
CYCLE CHISA=1,1,50
REPEAT
->WAIT
ON: CA_PAW=1<<24!strm; ! do stream request
CA_PIW0=0
STRMS_SAW0=1<<28!32; ! clear abnormal termination
STRMS_SAW1=ADDR(RQB)
STRMS_RESP0=0
STRMS_RESP1=0
CA_MARK=-1
CHISA=X'40000800'!(PTSM>>8<<16)
*LB_CHISA; *LSS_1; *ST_(0+B ); ! send channel flag
!
AGN: COUNT=COUNT-1 UNTIL (STRMS_RESP0#0 AND CA_MARK=-1) OR COUNT<0
!
GET: *LXN_CA+4; *INCT_(XNB +0); *JCC_7,<GET>
RESP0=STRMS_RESP0
RESP1=STRMS_RESP1
STRMS_RESP0=0
STRMS_RESP1=0
CA_PIW0=0
CA_MARK=-1
->AGN UNLESS RESP0&MASK#0 OR COUNT<0; ! normal or abnorml set
FINISH
END
!*
END ; ! RESTART
!
!------------------------------------------------------------------
EXTERNALROUTINE ENTER(INTEGER A, B)
!***********************************************************************
!* THIS ROUTINE IS ENTERED FROM THE BOOT LOADER BY ACTIVATE *
!* THE PARAMETERS A AND B ARE NO LONGER USED *
!***********************************************************************
RECORDFORMAT REGF(INTEGER LNB, PSR, PC, SSR, SF, IT, IC, LTB, XNB, C
B, DR0, DR1, A0, A1, A2, A3, LSTB0, LSTB1, PSTB0, PSTB1)
INTEGER SSNP1ADDR, THIS LNB, THIS SF, REACT PC, CURSTKAD
CONSTINTEGER RESSTKAD=X'80180000'
CONSTINTEGER REACTAD=X'81000080'; ! ADDRESS OF REGS FOR ACTIVATE
CONSTRECORD (REGF)NAME R=REACTAD
CONSTRECORD (REGF)NAME RESSSNP1=RESSTKAD+X'40000'
*STLN_THIS LNB
!
! COPY WORDS FROM ALTERNATE STACK SEGMENT TO RA WORD 32(DEC) IE. X80 BYTES
! WORK OUT ALT STACK SEG FROM CURRENT STACK FRONT
!
*STSF_THIS SF
CURSTKAD=THIS SF&X'FFFC0000'
SSNP1ADDR=CURSTKAD!X'00040000'
!
! COPY SUFFICIENT OF CURRENT STACK TO THE RESTART STACK (PUBLIC 6) TO
! ALLOW 'RESTART' TO BE CALLED ON IT.
!
A=THIS SF&X'3FFFF'
B=A!X'18000000'
*LSS_CURSTKAD; *LUH_B
*LDA_RESSTKAD; *LDTB_B
*MV_L =DR
!
! NOW SET UP RE-ACTIVATION WORDS FOR RE-ENTRY BELOW
!
*JLK_<ELAB>
*LSS_TOS
*ST_REACT PC
R_LNB=RESSTKAD!(THIS LNB&X'3FFFF')
R_PSR=X'0014FF01'
R_PC=REACT PC
R_SSR=X'01800FFF'; ! VA MODE PRIV AND ALL MASKED
R_SF=RESSTKAD!A
GET PSTB(R_PSTB0,R_PSTB1)
R_LSTB0=0; R_LSTB1=0; ! NO LST ON REACTIVATE
RESSSNP1=R; ! SECOND COPY IN NEXT SEG.
IF COM_OCP TYPE>=4 AND COM_SMACS&2#0 START
LONGINTEGER(X'81400000')=LONGINTEGER(REACTAD+X'48')
! PSTB TO SMAC1 FOR P4 HARDWARE
FINISH
SUP29
*IDLE_X'F003'
ELAB:
!
*JLK_TOS
! RE-ENTRY HERE FOR POST MORTEM
RESTART
*IDLE_X'F003'
! SHOULD NOT RETURN !
END ; ! ENTER
!
!
ENDOFFILE