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