%RECORDFORMAT PARMF(%INTEGER DEST, SRCE, P1, P2, P3, P4, P5, P6)
%RECORDFORMAT SERVAF(%INTEGER P, C)
%EXTRINSICINTEGER INPTR
%EXTRINSICINTEGER OUTPTR
%CONSTINTEGER MASK=X'80FC3FFF'
%EXTERNALINTEGERFNSPEC HANDKEYS
%EXTERNALROUTINESPEC HOOT(%INTEGER NUM)
%EXTERNALINTEGERFNSPEC GPC INIT(%INTEGER CA,PT,MODE)
%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 GPC(%RECORD(PARMF)%NAME P)
%EXTERNALROUTINESPEC SLAVESONOFF(%INTEGER J)
%EXTERNALROUTINESPEC PKMONREC(%STRING(20)TEXT,%RECORD(PARMF)%NAME P)
!* Communications record format - extant from CHOPSUPE 21D 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)
!
! This format describes "The Communication Record" which is kept
! locked in store at Public address X'80C00000'. It is readable at
! all ACR levels but writeable at ACR 1 only. Its purpose is to describe
! the hardware on which the EMAS System is running. Each entry is now
! described in more detail:-
!
! OCPTYPE The 2900 Processor on this configuration as follows
! 1 = 2950 or S1
! 2 = 2960 or P2
! 3 = 2970 or P3
! 4 = 2980 or P4
! 5 = 2972 or non-interleaved 2976 (P4/1)
! 6 = Interleaved 2976 or P4/1
!
! SLIPL bit 0 is set to 1 to force an AUTO IPL from RESTART.
! bits 1-15 are the SLOAD lvn & site >>4.
! (equivalent to the handkey settings for AUTO IPL).
! bits 16-31 are thehe port/trunk/stream(or DCU/stream) of the
! device used at IPL time.
! SBLKS The no of 128k blocks of main store present
! SEPGS The no of extended pages for paging(ie not including
! any pages occupied by resident code & data).
! NDISCS Then number of EDS drives avaliable
! DLVNADDR The address of an array which maps disc lvns to
! their ddt slots.
! GPCTABSIZE The size in bytes of the GPC (or DCU) table
! GPCA The address of the GPC (or DCU) table
! SFCTABSIZE The size of the SFC(ie DRUM) table
! SFCA The address of the SFC table
! SFCK The number of (useable) 1K page frames of Drum store
! available for paging.(0 = No drum configuration)
! DIRSITE The Director site address(eg X200) no longer reqd?
! DCODEDA The Disc Address of the Director (expressed as
! SUPLVN<<24!DIRSITE)
! SUPLVN The logical volume no of the disc from which the
! Sytem was "SLOADED". Various System components (eg
! DIRECT, VOLUMS will page from here
!
! TOJDAY Todays (Julien) day number.
! DATE0} These three integers define the current date(updated at
! DATE1} at 2400) as a character string such that
! DATE2} the length byte is in the bottom of DATE0
!
! TIME0} These three integers define the clock time as a string
! TIME1} in the same format as for DATE. The time is updated
! TIME2} about every 2 seconds
!
! EPAGESIZE The number of 1K pages combined together to make up
! the logical "Extended Page" used in Emas.Currently=4
! USERS The number of user processes (foreground+background)
! currently in existence.Includes DIRECT,VOLUMS&SPOOLR
! CATTAD Address of maxcat followed by category table.
! SERVAAD The address of the service array SERVA.
! NSACS The number of sacs found at grope time
! SACPORT1} Holds the Port no of the Store Access Controller(s)
! SACPORT0} found at grope time. SACPORT0 was used to IPL system.
! NOCPS The number of OCPS found at grope time.
! OCPPORT1} Hold the Port no of the OCPs found at grope time.
! OCPPORT0} OCPPORT0 was used to IPL the system.
! ITINT The Interval Timer interval in microsecs. Varies
! between different members of the range
! CONTYPEA The address of a 31 byte area containing the codes
! of the controllers in port-trunk order. Codes are:-
! 0 = Not relevant to EMAS
! 1 = SFC1
! 2 = FPC2
! 3 = GPC1
!
! GPCCONFA} These three variables each point to a word array
! FPCCONFA} containing controller data. The first word in each
! SFCCONFA} case says how many controllers on the system. The
! remainder have Port&Trunk in top byte and Public
! segment no of comms segment in bottom byte. For GPCS
! the Public Seg no is apparently omitted!
! BLKADDR The address of first element of a word array bounds
! (1:SBLKS) containing the real address of each 128K
! block of main store. Real addresses are in the form
! RSN/SMAC NO/Address in SMAC
! RATION Information maintained by DIRECT concerning access
! rationing. Bytes from left indicate scarcity,
! pre-empt point, zero and interactive users
! respectively
! SMACS Bits 0-15 are a map of SMACS in use by the system.
! 2**16 bit set if SMAC0 in use etc.
! Bits 16-31 are a map of SMACS found at grope time.
! 2**0 bit set if SMAC0 found etc.
! TRANS The address of a 768 byte area containing 3 translate
! tables. The first is ISO to EBCDIC, the second the
! exact converse & the third is ISO to ISO with
! lower to upper case conversion.
! KMON A 64 bit bitmask controlling monitoring of Kernel
! services. Bit 2**n means monitor service n. Bits can
! be set by Operator command KMON.
! DITADDR Disc index table address. The address of first
! element of an array(0:NDISCS-1) containing the address
! of the disc device entries.
! SMACPOS The no of places that the Smac no must be left
! shifted to be in the right position to access
! a Smac image store location. Incredibly this varies
! between the 2980 and others!!
! SUPVSN The Supervisor id no as a three char string eg 22A
! PSTVA The virtual address of the Public Segment table which
! is itself a Public segment. All other information
! about PST can be found by looking at its own PST entry
! SECSFRMN The no of Seconds since midnight. Updated as for TIME
! SECSTOCD The number of seconds to System closedown if positive
! If zero or negative no close down time has yet been
! notified. Updated as for TIME
! SYNC1DEST} These are the service nos N2,N3 & N4 for process
! SYNC2DEST} parameter passing described in Supervisor Note 1
! ASYNCDEST}
! MAXPROCS The maximum number of paged processes that the
! Supervisor is configured to run. Also the size
! of the Process array.
! INSPERSECS The number of instructions the OCP executes in 1
! second divided by 1000(Approx average for EMAS)
! ELAPHEAD The head of a linked list of param cells holding
! service with an elapsed interval interrupt request
! outstanding
! COMMSRECA The address of an area containing details of the
! Communication streams.(private to COMMS Control)
! STOREAAD The address of first element of the store record array
! bounds (0:SEPGS-1)
! PROCAAD The address of first element of the process record
! array bounds(0:MAXPROCS)
! SFCCTAB} The addresses of two private tables provided by grope
! DRUMTAD} for use by the routine DRUM. They give details of
! the SFCS and DRUMS found on the system
! TSLICE Time slice in microsecs. Supervisor has to allow for
! differences in interval timer speeds accross the range
! FEPS Bits 0-15 are a map of FEPs found at grope time.
! 2**16 bit set if FE0 found etc.
! Bits 16-31 are a map of currently available FEPs.
! 2**0 bit set if FE0 available etc.
! MAXCBT Maximum cbt entry
! PERFORMAD Address of record holding timing information and counts
! for performance analysis.
! SP1->SP6 Spare locations
! LSTL}
! LSTB}
! PSTL}
! PSTB} These are the image store addresses for the following
! HKEYS} control registers:-
! HOOT} Local Segment Table Limit & Base
! SIM } Public Segment Table Limit & Base
! CLKX} Handkeys,Hooter System Interrupt Mask Register
! CLKY} and the clock X,Y & Z Registers
! CLKZ}
! HBIT A bit pattern that when ORed into Control Register
! "HOOT" operates the Hooter.(0=Hooterless machine)
! SLAVEOFF A bit pattern (top 16 bits) and Image store address
! in bottom 16 bits. ORing the top 16 bits(after
! shifting) into the image store will stop all slaving of
! operands but not instructions
! INHSSR A bit pattern and image location as for SLAVEOFF.
! ORing the bits into the location will switch off
! reporting of successful system retry
! SDR1}
! SDR2} The image store addresses of SMAC internal registers
! SDR3} needed by the Engineers after Smac errors have
! SDR4} occurred
! SESR}
! HOFFBIT A bit pattern that when ORed into a Smac Engineers
! status register will stop reporting of error
! from that Smac
!
! BLOCKZBIT A bit pattern indicating the position of
! the block zero bit in the SMAC config register.
!
! BLKSHIFT Indicates which way to shift the BLOCKZBIT mask
! to correspond with subsequent store blocks.
!
! BLKSIZE Store block size.
!
%CONSTRECORD(COMF)%NAME COM=X'80C00000'
!------------------------------------------------------------------------
%RECORDFORMAT GPCTF(%BYTEINTEGER FLAGS,DEVTYPE,BUSY,LINK, %C
%INTEGER SP1,RESPONSE DEST,DEVENTA,CST,PTSM,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:63)
!----------------------------------------------------------------
%ROUTINE RESTART
%ROUTINESPEC DOWAIT(%INTEGER MASK)
%RECORD(PARMF) Q, P
%RECORDFORMAT RQBF(%INTEGER LFLAG, LSTBA, LBL, LBA, ALL, ALA, %C
INIT)
%RECORDFORMAT STRMF(%INTEGER SAW0, SAW1, RESP0, RESP1)
%RECORDFORMAT CAF(%INTEGER MARK, PAW, PIW0, PIW1, CSAW0, CSAW1 %C
, CRESP0, CRESP1, %RECORD(STRMF)%ARRAY STRMS(0:15))
%RECORDFORMAT SEG10F(%INTEGER SYSERRP,STACK,LSTL,LSTB,PSTL,PSTB, %C
HKEYS,INPTR,OUTPTR,BUFFLASTBYTE,OLDSE,OLDST,OLDLSTL,OLDLSTB,SBLKS, %C
%INTEGERARRAY BLOCKAD(0:63),%INTEGER PASL,KQ,RQ1,RQ2,SA1,SA2, %C
%LONGINTEGER PARM,PARML)
%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
%RECORD(GPCTF)%NAME GPCT
%RECORD(ENTFORM)%NAME DEV
%RECORD(CAF)%NAME CA
%RECORD(RQBF)%NAME RQB
%INTEGERNAME LBE, ALE1, ALE2
%INTEGERARRAYNAME BLOCKAD
%EXTRINSICINTEGER PARMASL, KERNELQ, RUNQ1, RUNQ2
%CONSTRECORD(SERVAF)%ARRAYNAME SERVA=SERVAAD
%EXTRINSICLONGINTEGER PARMDES
%LONGINTEGER TEMP
%INTEGER PTSM, I, J, K, STRM, RESP0, RESP1,HKEYS, AMTK
%INTEGER SMARK, SENSE1, SENSE2, SENSE3, SENSE4, SRESP, GPC INITTED
!* AUTO IPL DECLARATIONS
%RECORDFORMAT AIF(%LONGINTEGER ACTW1,ACTW2,%INTEGER WTIME,ASLOAD)
%OWNRECORD(AIF) AI
%CONSTINTEGER PSTLEN VA=PST VA+PST VA>>18&X'1FFF'*8
%CONSTINTEGER APST=X'3F000'; ! SAFE PLACE FOR PST
%CONSTINTEGER APST VA=APST!X'81000000'
%INTEGER PT
%CONSTINTEGER IPL=5
SLAVESONOFF(0)
P=0; GPC INITTED=0
!
! SEG 10 (WHICH MUST BE IN SMAC0-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:
%CYCLE I=0,4,8
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)
%CYCLE I=0,1,SEG10_SBLKS-1
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
PTSM=HKEYS&X'FFFF'
%IF PTSM=0 %AND HKEYS#0 %THEN ->WRITEOUT
!
! ALLOCATE TAPE DECK USING EMERGENCY ALLOCATE (ACT=8)
!
Q=0
Q_DEST=8; Q_P1=PTSM
Q_SRCE=X'80360000'
GPC(Q)
%IF Q_P1#0 %THEN %START
PKMONREC("CLAIM DUMPMT FAILS",Q)
NEWLINE
->WRITEOUT
%FINISH
DEV==RECORD(Q_P3)
CA==RECORD(DEV_CAA)
RQB==RECORD(DEV_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'
!
! RECONNECT THE STREAM IN CASE . KY SAYS THIS DOES NO HARM
!
LBE=X'00F10800'; ! CONNECT STREAM IF NEC
DOWAIT(X'C00000')
%IF RESP0=0 %OR RESP0>>16=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
!
! SKIP BACK TO BT
!
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'80F00400'
DOWAIT(X'C00000'); ! WAIT FOR SENSE TERM.
SRESP=RESP0; ! REMEMBER RESULT
ALE1=X'58000000'+EPAGESIZE*1024;! RESET ALE
ALE2=X'81000000'
%FINISH
%CYCLE I=1,1,500*COM_INSPERSEC
%REPEAT; ! WAIT ABOUT 1 SEC WITHOUT USING
! RTC WHICH COULD BE DOWN(IN DUALS)
!
! NOW SKIP FORWARD 1 BLOCK
!
LBE=X'80F04200'
DOWAIT(X'C00000')
!
! NOW WRITE 1 TAPE MARK
!
LBE=X'80F02300'
DOWAIT(X'C00000')
!
! NOW DUMP STORE AS 4K BLOCKS
!
LBE=X'80C00300'
%CYCLE I=0,1,SEG10_SBLKS-1
%CYCLE J=0,EPAGESIZE*1024,1024*(128-EPAGESIZE)
ALE2=X'81000000'+SEG10_BLOCKAD(I)+J
DOWAIT(X'C00000')
%REPEAT
%REPEAT
!
! WRITE 2 TAPE MARKS
!
LBE=X'80F02300'
DOWAIT(X'C00000')
DOWAIT(X'C00000')
!
!
! UNLOAD AND FLASH THE TAPE!
LBE=X'80F01800'; ! TO REWIND USE X'80F03800'
DOWAIT(X'C00000')
WRITEOUT: ! WRITOUT UPDATED PAGES
! ON HANDKEY OPTION FOR TESTING
AMTK=LONGINTEGER(X'80040000'+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)
!
! STEP1 REMOVE OLD DISC INTS AND PAGETRURN 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);! QSTOPS IF STOREBLK HAS NO POWER
! OTHERWISE FFS WRITTEN TO DISC
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
!
%CYCLE STOREX=1,1,10000
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 GPC slots
%FOR I=0,1,INTEGER(COM_GPCA+8) %CYCLE
GPCT==RECORD(K+I*SLOTSIZE)
%IF GPCT_MNEM>>8=M'LP' %START
PTSM=GPCT_PTSM&X'FFFF'
%IF COM_NSACS=1 %AND PTSM>>12#COM_SACPORT0 %THEN %CONTINUE; ! SAC gone
STRM=PTSM>>4&15
DEV==RECORD(GPCT_DEVENTA)
CA==RECORD(DEV_CAA)
RQB==RECORD(DEV_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
%REPEAT
%IF COM_SLIPL>=0 %AND HKEYS>>16=0 %THEN %START
*IDLE_X'EEEE'
%FINISH
%ROUTINE ACCEPT DISC INTS
%RECORD(PARMF) P
%INTEGER NFPCS,I,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
%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
!
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_ACTW1=X'0004000000000028'; ! ACTIVATE WORDS
AI_ACTW2=0
AI_WTIME=250*15*COM_INSPERSEC; ! APPROX 15 SECS
%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)
I=X'40000800'!PT<<16
J=ADDR(AI)
*LDTB_X'28000004'; ! DR FOR CRESP0
*LDA_X'81000018'
*LCT_J; ! ADDRESS RECORD AI
*LXN_CA+4; ! CA RECBASE
*LB_I; *LSS_1; *ST_(0+%B); ! SEND CHANNEL FLAG
*LB_(%CTB+4); ! 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
*LSS_(%CTB+5)
*INCA_X'A4'; ! ACC3 ('18'+'A4' = 'BC')
*ST_(%DR); ! AUTO SLOAD parms
*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 *
!***********************************************************************
%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
%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