conststring (28) vsn="Vsn 29E - 9th May 1984"
systemintegerfnspec iocp(integer ep, add)
systemroutinespec print mess(integer flag)
recordformat finf(integer conad, filetype, datastart, dataend)
systemroutinespec connect(string (31) s,
integer acc, maxb, prot, record (finf)name r, integername flag)
systemroutinespec disconnect(string (31) file, integername flag)
systemroutinespec change file size(string (31) file,
integer newsize, integername flag)
systemroutinespec outfile(string (31) file,
integer length, maxbytes, protection,
integername conad, flag)
systemroutinespec destroy(string (31) s, integername flag)
systemroutinespec e to i(integer addr, length)
systemroutinespec move(integer l, f, t)
systemroutinespec fill(integer l, f, t)
externalstringfnspec uinfs(integer type)
externalroutinespec deliver(string (255) s)
externalroutinespec prompt(string (15) s)
externalroutinespec define(string (63) s)
externalroutinespec open tape(integer no, mode, rlev,
string (6) tape, integername flag)
externalroutinespec close tape(integer no, integername flag)
externalroutinespec read page( c
integer no, chap, address, integername flag)
constinteger max blks = 32; !MAX STORE BLOCKS PER SMAC I.E. 128K BLOCKS
constinteger max smacs = 16; !MAX SMACS PER REMOTE STORE NUMBER
constinteger max rss = 4; !MAX REMOTE STORE NUMBERS
constinteger avail = x'80000000'; !PAGE/SEGMENT AVAILABLE BIT IN PAGE/SEGMENT TABLES
constinteger paged = x'40000000'; !PAGED BIT IN SEGMENT TABLE
constinteger shared = x'40000000'; !SHARED BIT IN SEGMENT TABLE
constinteger slaved = x'20000000'; !SLAVED BIT IN SEGMENT TABLE
constinteger referenced = x'20000000'; !REFERENCED BIT IN PAGE/SEGMENT TABLES
constinteger written = x'10000000'; !WRITTEN TO BIT IN PAGE/SEGMENT TABLES
constinteger fixed = 1; !FIXED BIT IN PAGE/SEGMENT TABLES
constinteger e page size = 4; !NUMBER OF 1K PAGES IN AN EXTENDED PAGE
constinteger store block size = x'20000'; !128K
constinteger request reject = 2; !TAPE REJECTS TRANSFER REQUEST
constinteger eot = 4; !END OF TAPE FLAG
constinteger not assigned = x'80808080'
constinteger segment size = x'40000'; !NUMBER OF BYTES IN A SEGMENT I.E. 256K
constinteger public = x'80000000'; !PUBLIC BIT IN A VIRTUAL ADDRESS
constinteger initial global stack seg = 4; !SEGMENT NUMBER OF INITIAL GLOBAL CONTROLLER STACK
constinteger global gla seg = 9; !SEGMENT NUMBER OF GLOBAL CONTROLLER GLA
constinteger diag info seg = 10; !SEGMENT NUMBER OF DIAGNOSTIC INFO FOR DUMP ANALYSIS
constinteger amta seg = 21; !ACTIVE MEMORY TABLE SEGMENT
constinteger amtdd seg = 22; !ACTIVE MEMORY STORE/DRUM INDEX TABLE
constinteger comms area start = 48; !START SEGMENT OF COMMUNICATIONS AREAS
constinteger comms area end = 62; !END OF COMMUNICATIONS SEGMENTS
conststring (1) snl = "
"
conststring (10) yes = " YES "
conststring (10) no = " NO "
conststring (4) array ocp type(0:15,0:1) = c
"????"(2),"2960","2970","2980","2972","2976","????"(9),
"????","2950","2956","2966","2988","????"(*)
!*
!* 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,DAPBMASK,SP1,SP2,SP3, 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 (S1)
! 2 = 2960 (P2) or 2956 (S2)
! 3 = 2970 (P3) or 2966 (S3)
! 4 = 2980 (P4)
! 5 = 2972 or non-interleaved 2976 (P4/1)
! 6 = Interleaved 2976 (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.
! SYSTYPE System infrastructure:
! 0 = SMAC based
! 1 = SCU based (SCU1)
! 2 = SCU based (SCU2)
! 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.
! DAPNO SMAC number for the DAP
! DAPBLKS The number of 128K blocks in DAP
! DAPUSER The PROCESS currently holding the DAP
! DAPSTATE The state of the DAP
! DAP1 DAP control fields
! DAPBMASK Bit map of currently allocated DAP blocks
! SP1->SP3 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.
!
recordformat frf(integer ca, filetype, datastart, dataend)
recordformat fhf(integer end, start, size, type, spare1,
datetime, string (7) tape)
recordformat segtf(integer ste1, ste2)
!%recordformat oldseg10f(%integer syserr, stack, s5, s6, pstl, pstb, %c
! hand keys, in ptr, out ptr, buff last byte, s1, s2, s3, s4, store %c
! blocks, %integerarray block ad(0:63), %integer parm asl, kq, rq1, %c
! rq2, %longinteger sa, parm, parml)
recordformat seg10f(integer syserr, stack, s5, s6, pstl, pstb,
hand keys, in ptr, out ptr, buff last byte, s1, s2, s3, s4, store c
blocks, integer parm asl, kq, rq1, rq2, longinteger sa, parm, parml,
integerarray block ad(0:127))
recordformat servf(integer p, l)
constinteger servf size = 8
recordformat procf(string (6) user,
byteinteger incar, category, p4top4, runq, active,
integer actw0, lstad, lamtx, stack, status)
constinteger procf size =32
recordformat entform(integer ser,pts,propaddr,stick,caa,rqa,
(integer x0,lta or integer lba,ala),integer state,iw1,concount,
sense1,sense2,sense3,sense4,repsno,base,id,dlvn,mnemonic,
string (6) lab, byteinteger mech,
integer x1,x2,x3,p qaddr,x4,x5,x6,x7,x8,x9,x10,s qaddr)
recordformat qform(byteinteger qstate,prio,sp1,sp2,
integer lqlink, uqlink, curcyl, sema, trlink)
constinteger p buffad=14,s buffad=56
recordformat statef(integerarray word(0:s buffad))
recordformat gpctf(integer a, b, c, entad, e, gptsm, mnemonic,
f)
recordformat comms recf( c
integer index addr, next free buffer, queued stream head,
queued streams tail)
!***********************************************************************
!* *
!* THESE FUNCTIONS ALL USE A PACKED FORMAT OF DATE AND TIME OF THE *
!* FOLLOWING FORM. BITS ARE NUMBERED FROM 31 (MOST SIGNIFICANT) TO *
!* 0 (LEAST SIGNIFICANT) *
!* BITS USE *
!* 31-26 YEAR-70 (VALID FOR 1970-2033) *
!* 25-22 MONTH *
!* 21-17 DAY *
!* 16-12 HOUR *
!* 11- 6 MINUTE *
!* 5- 0 SECOND *
!* *
!***********************************************************************
systemstring (8)fnspec unpackdate(integer p)
systemstring (8)fnspec unpacktime(integer p)
stringfn h to s(integer value, places)
!**********************************************************************
!* *
!* TURNS AN INTEGER INTO A HEXADECIMAL STRING OF GIVEN LENGTH *
!* *
!**********************************************************************
string (8) s
integer i
constbyteintegerarray h(0 : 15) = c
'0', '1', '2', '3', '4', '5',
'6', '7', '8', '9',
'A', 'B', 'C', 'D', 'E', 'F'
i = 64-4*places
*ld_s; *lss_places; *st_(dr )
*inca_1; *std_ tos ; *std_ tos
*lss_value; *luh_0; *ush_i
*mpsr_x'24'; ! SET CC=1
*supk_ l = 8
*ld_ tos ; *ands_ l = 8, 0, 15
*lss_h+4; *luh_x'18000010'
*ld_ tos ; *ttr_ l = 8
result = s
end ; !OF STRINGFN H TO S
string (15) fn i to s(integer n)
!**********************************************************************
!* *
!* TURNS AN INTEGER INTO A STRING USES MACHINE CODE *
!* *
!**********************************************************************
string (16) s
integer d0, d1, d2, d3
*lss_n; *cdec_0
*ld_s; *inca_1; ! PAST LENGTH BYTE
*cpb_b ; ! SET CC=0
*supk_l =15,0,32; ! UNPACK 15 DIGITS SPACE FILL
*std_d2; ! FINAL DR FOR LENGTH CALCS
*jcc_8,<waszero>; ! N=0 CASE
*lsd_tos ; *st_d0; ! SIGN DESCRIPTOR STKED BY SUPK
*ld_s; *inca_1
*mvl_l =15,15,48; ! FORCE IN ISO ZONE CODES
if n < 0 then byteinteger(d1) = '-' and d1 = d1-1
byteinteger(d1) = d3-d1-1
result = string(d1)
waszero:
result = "0"
end ; !OF STRINGFN I TO S
routine dump(integer start, finish, conad, integername above)
!**********************************************************************
!* *
!* DUMPS AREA SPECIFIED BY START AND FINISH IN HEXADECIMAL *
!* ACCEPTS PARAMETERS AS START, FINISH OR AS START,LENGTH WITH CONAD *
!* SPECIFYING THE ACTUAL ADDRESS OF THE AREA BEING DUMPED *
!* *
!* ABOVE: >0 ON ENTRY - FIRST LINE NOT PRINTED IF = OLDLINE. *
!* =0 ON ENTRY - FIRST LINE ALWAYS PRINTED. *
!* <0 ON ENTRY - TERMINATING CALL. CAUSES 'ABOVE' MESSAGE *
!* TO BE OUTPUT (NO OF TIMES = -ABOVE). *
!**********************************************************************
constbyteintegerarray table(0 : 255) = c
'_'(32),
' ','!','"','#','$','%','&','''','(',
')','*','+',',','-','.','/','0','1',
'2','3','4','5','6','7','8','9',':',
';','<','=','>','?','@','A','B','C',
'D','E','F','G','H','I','J','K','L',
'M','N','O','P','Q','R','S','T','U',
'V','W','X','Y','Z','[','¬',']','^',
'_','`','a','b','c','d','e','f','g',
'h','i','j','k','l','m','n','o','p',
'q','r','s','t','u','v','w','x','y',
'z','{','|','}','~','_'(129)
string (255) s
integer i, j, actual start, adt0, ads
owninteger oldline
if above<0 start ; ! Terminating call.
above = -above; ads=0
-> printline
finish
finish = start+finish-1 if finish < start
!MUST MEAN START, LENGTH
start = start&x'FFFFFFFC'
finish = ((finish+4)&x'FFFFFFFC')-1
return if finish < start
actual start = start
conad = conad&x'FFFFFFFC'
adt0 = addr(table(0))
ads = addr(s)
if above#0 start
! Compare start of given area with OLDLINE area.
*lda_start
*ldtb_x'18000020'
*cyd_0
*lda_oldline
*cps_ l = dr
*jcc_7, < printline >
above = above + 1
start = start+32
->loop
finish
printline:
if above # 0 start
spaces(50)
if above = 1 then print string(" LINE ") c
else print string(i to s(above)." LINES ")
print string("AS ABOVE".snl)
above = 0
return if ads=0; ! ABOVE<0 call
finish
s = "(".h to s(conad+(start-actual start),8).") "
for i = start,4,start+28 cycle
s = s.h to s(integer(i),8)." "
repeat
s = s." *"
! %CYCLE I = START,1,START+31
! J = BYTEINTEGER(I)
! %UNLESS 32 <= J < 127 %THEN J = '_'
! S = S.TO STRING(J)
! %REPEAT
i = adt0
j = ads + 96
*ldtb_x'18000020'
*lda_start
*cyd_0
*lda_j
*mv_l =dr
*lb_32
*ldtb_x'18000000'
*ldb_b
*lda_j
*lss_i
*luh_x'18000100'
*ttr_l =dr
length(s) = 127
s = s."*".snl
i = iocp(15,ads)
start = start + 32
loop:
while start <= finish cycle
*lda_start; !CHECK IF SAME AS PREVIOUS LINE
*ldtb_x'18000020'
*cyd_0
*inca_-32
*cps_ l = dr
*jcc_7, < printline >
above = above+1
start = start+32
repeat
oldline = start
end ; ! OF DUMP
integerfn s to i(stringname s)
!**********************************************************************
!* *
!* TURNS A STRING INTO AN INTEGER *
!* *
!**********************************************************************
string (25) p
integer total, sign, ad, i, j, hex
hex = 0; total = 0; sign = 1
ad = addr(p); p = ""
a: if s-> p.(" ").s and p="" then ->a
s = p." ".s and p = "" unless p=""
if length(s)>1 and charno(s,1)='-' then s = substring(s,2,length(s)) C
and sign = -1
if length(s)>1 and charno(s,1)&95='X' then s = substring(s,2,length(s)) c
and hex = 1 and ->a
p = s
unless s -> p.(" ").s then s = ""
i = 1
while i <= byteinteger(ad) cycle
j = byte integer(i+ad)
-> fault unless '0' <= j <= '9' or (hex # 0 c
and 'A' <= j <= 'F')
if hex = 0 then total = 10*total c
else total = total<<4+9*j>>6
total = total+j&15; i = i+1
repeat
if hex # 0 and i > 9 then -> fault
if i > 1 then result = sign*total
fault:
s = p.s
result = not assigned
end ; !OF INTEGERFN S TO I
routine read line(stringname line)
!***********************************************************************
!* *
!* READS A LINE OF TEXT TERMINATED BY A NEWLINE. SKIPPING LEADING *
!* NEWLINES AND SPACES. *
!* *
!***********************************************************************
integer sym
line = ""
skip symbol while next symbol = ' ' or next symbol = nl
read symbol(sym); sym = sym-32 if 'a'<=sym<='z'
while sym # nl cycle
line = line.to string(sym)
read symbol(sym); sym = sym-32 if 'a'<=sym<='z'
repeat
end ; !OF ROUTINE READ LINE
externalroutine print dump(string (63) file)
!**********************************************************************
!* *
!* PRINTS A STORE DUMP OF AN EMAS 2900 SYSTEM *
!* THE STORE OF THE SYSTEM DUMPED SHOULD BE IN THE FILE AS SPECIFIED *
!* OR IF THE FILE IS NULL THE DEFAULT FILE "DUMPFILE" IS PRINTED. *
!* OPTIONS ARE INPUT BY THE USER TO SELECT AREAS TO BE DUMPED OR *
!* TABLES TO BE PRINTED. *
!* *
!**********************************************************************
recordformat dsegf(integer ocp, addr, length)
record (segtf)arrayformat segtaf(0 : 320)
record (dsegf)array dump segs(1 : 100)
recordformat lstf(integer lstb, lstl, procno)
record (lstf)array lst(0:3)
record (segtf)arrayname public segment table
record (segtf)arrayname local segment table
record (comf)name com
record (seg10f)name seg10
record (segtf)name segment
record (fhf)name file header
record (frf)r
integerarray store map(0 : (max rss*max smacs*max blks)-1)
integername lstl, lstb
integer flag, conad, endad, caddr, i, j, k, n segs, pstl, pstb
integer rsn, smacn, blkn, failing pc, failocp
constbyteintegerarray ssfp(-2:3)=255,255,12,14,16,18
byteintegerarrayformat ssfpf(0:3)
byteintegerarrayname stack seg for port; ! maps onto ssfp
integer system type; ! byte from com_systype
! 0 = SMAC based, >0 = SCU based
string (63) delivery, old delivery, stk, gla, s, outfile,
dump anal, carea, amtab, photo, store arr, summary
integerfn contiguous address(integer raddr)
!**********************************************************************
!* *
!* TAKES A 2900 REAL ADDRESS AND CONVERTS IT TO A CONTIGUOUS ADDRESS *
!* I.E. A STORE DUMP ADDRESS WITH NO HOLES IN IT *
!* *
!**********************************************************************
integer rsn, smacn, blkn, i
result = not assigned if raddr = not assigned
rsn = (raddr)>>26&3; !CALCULATE REMOTE STORE NUMBER
smacn = (raddr)>>22&x'F'; !CALCULATE SMAC NUMBER
blkn = (raddr)>>17&x'1F'; !CALCULATE BLOCK WITHIN SMAC
! NUMBER
i = store map(blkn+smacn*max blks+rsn*max blks*max smacs)
result = not assigned if i = not assigned
i = i+raddr&x'1FFFF'
result = not assigned unless conad <= i <= endad
result = i
end ; !OF INTEGERFN CONTIGUOUS ADDRESS
integerfn real address(integer vaddr)
!**********************************************************************
!* *
!* TAKES A 2900 VIRTUAL ADDRESS AND CONVERTS IT TO REAL ADDRESS *
!* WORKS FOR PUBLIC/LOCAL, PAGED/UNPAGED SEGMENTS. ACCESS TO THE *
!* PUBLIC SEGMENT TABLE AND THE LOCAL SEGMENT TABLE IS REQUIRED. *
!* *
!**********************************************************************
record (segtf)name segment
integerarrayformat ptaf(0 : 255)
integerarrayname page table
integername page
integer seg no, page no, caddr
seg no = (vaddr&x'7FFC0000')>>18
!GET THE SEGMENT NUMBER FROM THE ADDRESS
if vaddr&public # 0 start
!IS IT A PUBLIC ADDRESS
result = not assigned unless 0 <= seg no <= pstl
!CHECK RANGE OF SEGMENT NUMBER
segment == public segment table(seg no)
!MAP ONTO SEGMENT TABLE
finish else start ; !IT IS A LOCAL ADDRESS
result = not assigned unless 0 <= seg no <= lstl
!CHECK RANGE OF SEGMENT NUMBER
segment == local segment table(seg no)
!MAP ONTO LOCAL SEGMENT TABLE
finish
result = not assigned if segment_ste2&avail = 0 c
or vaddr&x'3FF80' > segment_ste1&x'3FF80'
!CHECK AVAILABILITY AND LENGTH OF SEGMENT
result = segment_ste2&x'FFFFF80'+vaddr&x'3FFFF' c
if segment_ste1&paged = 0
!RETURN REAL ADDRESS IF SEGMENT IS NOT A PAGED SEGMENT
caddr = contiguous address(segment_ste2&x'FFFFFF8')
result = not assigned if caddr = not assigned
page table == array(caddr,ptaf)
!FIND ADDRESS IN DUMP OF PAGE TABLE
page no = (vaddr&x'3FC00')>>10
!CALCULATE PAGE NUMBER
page == page table(page no); !MAP ONTO PAGE TABLE ENTRY
result = not assigned if page&avail = 0
!CHECK IF PAGE IS IN STORE
result = page&x'FFFFC00'+vaddr&x'3FF'
!RETURN REAL ADDRESS
end ; !OF INTEGERFN REAL ADDRESS
routine findlst(integer ocp,procaad,maxprocs)
!***************************************************************************
!* *
!* Finds LSTB, LSTL, PROCNO for given OCP. Information is stored *
!* in LST(OCP). *
!* *
!***************************************************************************
integer add, procno
record (procf)name proc
add = contiguous address(real address(public!ocp<<18))
! Address of IST for this OCP.
-> notav if add = not assigned
procno = integer(add + 12*32 -4)
-> notav unless 1 <= procno <= maxprocs
! Process no of process on this OCP at time of failure.
! Now access the process list to find relevant LSTL, LSTB.
add = not assigned
add = contiguous address(real address(procaad+procno*procf size)) c
unless procaad = 0
-> notav if add = not assigned
proc == record(add)
lst(ocp)_lstl = (proc_actw0&x'7FFC0000')>>18
lst(ocp)_lstb = proc_lstad
lst(ocp)_procno = procno
return
notav:
lst(ocp)_lstl=-1
lst(ocp)_lstb = 0
lst(ocp)_procno=0
end ; ! FINDLST.
routine setlst(integer ocp)
!****************************************************************************
!* *
!* Sets up the local segment table pointers LSTL, LSTB, LOCAL SEGMENT *
!* TABLE (for use by the address translation functions) for the *
!* specified OCP. *
!* *
!****************************************************************************
integer caddr
lstl == lst(ocp)_lstl
lstb == lst(ocp)_lstb
return if lstl = -1; ! Local segment table not available.
caddr = contiguous address(lstb)
local segment table == array(caddr, segtaf)
end ; ! SETLST.
integerfn dumpfile address(integer virtual address)
result = contiguous address(real address(virtual address))
end ; ! DUMPFILE ADDRESS.
routine heading(string (132) title, integer width, ul)
!**********************************************************************
!* *
!* Prints out TITLE centred with respect to WIDTH columns, and *
!* underlines on next line with UL character (unless 0) *
!* *
!**********************************************************************
integer gap
gap = (width-length(title))>>1
spaces(gap)
printstring(title.snl)
return if ul = 0
spaces(gap)
gap = length(title)
printch(ul) and gap=gap-1 while gap>0
newline
end ; ! HEADING.
routine print page table(integer ptaddr, ptl)
!**********************************************************************
!* *
!* PRINTS THE PAGE TABLE AT THE SPECIFIED ADDRESS AND LENGTH *
!* *
!**********************************************************************
integerarrayformat ptaf(0 : ptl)
integerarrayname page table
string (255) s, t
integer page, header printed, i, l
if ptaddr # not assigned and 0 <= ptl <= 255 start
page table == array(ptaddr,ptaf)
header printed = 0
page = 0
while page <= ptl cycle
l = ptl-page+1
l = e page size if l > e page size
if page table(page)&avail # 0 start
if header printed = 0 start
header printed = 1
newline
heading("PAGE TABLE", 74, '-')
print string( c
" E PAGE PAGE RSN SMAC BLK R ". c
"ADDR FIXED REFERENCED WRITTEN ".snl)
finish
s = i to s(page//epage size)
s = " ".s while length(s) < 15
s = s." X".h to s(page,2)
s = s." ".h to s((page table(page)>>26)&3,1) c
." ".h to s((page table(page)>>22)&x'F',1 c
)." ".h to s((page table(page)>>17)&x'1F' c
,2)." ".h to s(page table(page)& c
x'FFFFFFC',7)." "
t = " "
for i = 0,1,l-1 cycle
if page table(page+i)&fixed # 0 c
then t = t."Y" else t = t."N"
repeat
t = t." " while length(t) < 8
s = s.t
t = " "
for i = 0,1,l-1 cycle
if page table(page+i)&referenced # 0 c
then t = t."Y" else t = t."N"
repeat
t = t." " while length(t) < 8
s = s.t
t = " "
for i = 0,1,l-1 cycle
if page table(page+i)&written # 0 c
then t = t."Y" else t = t."N"
repeat
s = s.t.snl
i = iocp(15,addr(s))
finish
page = page+l
repeat
finish else start
newline
heading("PAGE TABLE", 74,'-')
spaces(30)
print string("N O T V A L I D".snl)
finish
newline
end ; !OF ROUTINE PRINT PAGE TABLE
routine photograph(integer type)
!**********************************************************************
!* *
!* Dumps the photograph (position is processor-dependent), then *
!* gives a formatted version of the photograph. *
!* *
!* TYPE = 0 No photo wanted *
!* TYPE = 1 Look for photograph (by use of System Int Par) *
!* TYPE = 2 Photo on FPN 2, SMAC 0 *
!* TYPE = 3 Photo on FPN 3, SMAC 0 *
!* *
!**********************************************************************
dynamicroutinespec print photograph(integer start addr, dummy, seip,
ocptype, dateaddr, timeaddr, mode, integerfn dumpfile address,
routine setlst)
integer fpn, ip, photoad, photolength, above, dummy
return unless 1<=type<=3
ip = seg10_syserr
if system type>0 start ; ! S series
printstring("S series photograph area:")
newlines(3)
if (ip>>18)&1=1 start
printstring("No photograph available.".snl)
finishelsestart
above=0
dump(contiguous address(real address(x'81000100')),512,x'81000100',above)
finish
newpage
return
finish
if com_ocptype=0 start
printstring("COM_OCPTYPE not set - photo unavailable".snl)
newpage
return
finish
if type>1 start
! If TYPE = 2 or 3, construct IP.
ip = 0 if ip<0
ip = ip!(type<<29)!x'20000'
finish
fpn=ip>>29; ! Failing port no.
photoad=-1
if ip > 0 start
if com_ocptype=2 start ; ! P2.
if ip&x'40000'=0 start
photoad = x'81000100'
if ip & x'10000' = 0 then start
photolength = x'1540'; ! Full photo (including mini-photo)
else
photolength = x'100'; ! Mini-photo only
if fpn=3 and photoad#-1 then photoad=photoad+x'100'
! 2nd site used in this case
finish
finish
finish else c
if com_ocptype=3 start ; ! P3.
photolength = x'700'; ! X'700' bytes for P3.
photoad=x'81000100' if ip&x'40000'=0; ! Photo was taken.
if fpn=3 and photoad#-1 then photoad=photoad+photolength
! 2nd site used in this case.
finishelsestart
! P4 (2980), P4/1 (2972 or 2976) (COM_OCPTYPE = 4, 5 or 6).
if com_ocptype = 4 then photolength = x'1400' else c
photolength = x'800'
unless ip&x'30000' = 0 start ; ! If =0, no photograph was taken.
if ip&x'30000'=x'30000' then photoad=x'81400100' else c
photoad=x'81000100'
! Photograph in SMAC1 if both bits set in IP. (See Hardware Note 5.)
photoad = photoad+ x'1800' if com_nocps>1 and fpn=3
! 2nd site used in this case.
finish
finish
finish
newlines(5)
if photoad=-1 then printstring("No photograph") and newpage elsestart
printstring("Photograph on SMAC".h to s(photoad>>22&1,1).":")
newlines(3)
if contiguous address(real address(photoad)) = not assigned c
then printstring("Photograph address invalid: ".h to s(photoad,8). c
snl) and newpage else start
above = 0
dump(contiguous address(real address(photoad)),photolength,
photoad,above)
newpage; newlines(2)
photoad = contiguous address(real address(photoad))
print photograph(photoad,dummy,ip,com_ocptype,addr(com_date0)+3,
addr(com_time0)+3,0,dumpfile address, setlst)
finish
finish
end ; ! Of %ROUTINE PHOTOGRAPH.
routine print segment table(integer stb, stl, start seg)
!**********************************************************************
!* *
!* PRINTS THE SEGMENT TABLE AT THE SPECIFIED ADDRESS AND LENGTH *
!* START SEG IS ADDED TO THE SEGMENT NUMBER TO ALLOW PRINTING OF *
!* LOCAL AND PUBLIC SEGMENTS. IF THE SEGMENT IS PAGED THE APPROPRIATE*
!* PAGE TABLE IS PRINTED. *
!* *
!**********************************************************************
record (segtf)arrayformat segtaf(0 : stl)
record (segtf)arrayname segment table
record (segtf)name segment
string (255) s
integer seg, header printed, i
if stb # not assigned and stl > 0 start
!CHECK VALID
segment table == array(stb,segtaf)
header printed = 0
for seg = 0,1,stl cycle
segment == segment table(seg)
if segment_ste2&avail # 0 start
!IS SEGMENT AVAILABLE
if header printed = 0 start
header printed = 1
print string( c
" SEGMENT V ADDR RSN SMAC BLK R ADDR " c
." SIZE PAGED")
print string( c
" SLAVED FIXED REFERENCED WRITTEN ". c
"APF".snl)
finish
s = i to s(seg)
s = " ".s while length(s) < 3
s = s." (X".h to s(seg,2).") "
s = s.h to s((seg+start seg)<<18,8)." ". c
h to s((segment_ste2>>26)&3,1)." ". c
h to s((segment_ste2>>22)&x'F',1)." ". c
h to s((segment_ste2>>17)&x'1F',2)." ". c
h to s(segment_ste2&x'FFFFFFC',7)." ". c
h to s(segment_ste1&x'3FF80'+x'80',5)
if segment_ste1&paged # 0 then s = s.yes c
else s = s.no
if segment_ste1&slaved # 0 then s = s.no c
else s = s.yes
if segment_ste2&fixed # 0 then s = s.yes c
else s = s.no
unless segment_ste2&shared = 0 c
and segment_ste1&paged # 0 start
if segment_ste2&referenced # 0 c
then s = s.yes else s = s.no
if segment_ste2&written # 0 c
then s = s." ".yes else s = s." ".no
finish else s = s." NOT APPLICABLE "
if (segment_ste1>>28)&1 # 0 c
then s = s."E" else s = s." "
s = s." W".h to s(((segment_ste1)>>24)&x'F',1)
s = s." R".h to s(((segment_ste1)>>20)&x'F',1)
s = s.snl
i = iocp(15,addr(s))
if segment_ste1&paged # 0 start
!IS IT A PAGED SEGMENT
print page table(contiguous address(segment_ c
ste2&x'FFFFFFC'),(segment_ste1&x'3FF80'+ c
x'80'-1)>>10)
header printed = 0
finish
finish
repeat
finish else print string( c
" ". c
" N O T V A L I D".snl)
end ; !OF ROUTINE PRINT SEGMENT TABLE
routine print queues(integer last parm cell, parma,
serva0, max serv, parm asl, kernelq, runq1, runq2,
elapsed int q, crecaddr)
!***********************************************************************
!* *
!* PRINTS THE SERVICE REQUESTS IN THE VARIOUS SYSTEM QUEUES. ALSO *
!* PRINTS THE FREE LIST WHICH WHEN READ IN REVERSE ORDER GIVES A *
!* HISTORY OF THE MOST RECENTLY PROCESSED SERVICES. *
!* *
!*********************************************************************
integerarrayformat siaf(0 : 3*com_max procs-1)
byteintegerarray used services(0 : max serv)
byteintegerarray used cells(0 : last parm cell)
integerarrayname stream index
record (servf)name serv
record (comms recf)name comms rec
integer i, j, servaa
routinespec print store array(integer address, length, pitonly)
routinespec print disc device table(integer dlvnaddr, ditaddr)
routinespec print buffer header
routinespec print stream header
routinespec print parm header
routinespec print parm cell(integer l, integername f)
routinespec print q(integer pointer)
routinespec print list(integer pointer)
routinespec print linear list(integer pointer, end)
for i = 1,1,last parm cell cycle
used cells(i) = 0
repeat
for i = 1,1,max serv cycle
used services(i) = 0
repeat
if com_storeaad#0 and com_sepgs#0 and store arr = "YES" start
heading("STORE ARRAY",120,'-')
print store array(com_storeaad,com_sepgs-1,0)
newpage
finish
if com_ndiscs>0 start
heading("DISC DEVICE TABLE",120,'-')
newlines(2)
print disc device table(contiguous address(real address c
(com_dlvnaddr)),contiguous address(real address(com_ditaddr)))
newpage
finish
heading("EXECUTING SERVICES",120,'-')
j=0; ! "EXECUTING SERVICE FOUND" FLAG
servaa = serva0
for i=1,1,max serv-1 cycle
servaa = servaa + servf size
serv == record(contiguous address(real address(servaa)))
if serv_p&x'40000000'#0 start
j=1
printstring(snl.snl."SN0 X".h to s(i,3).snl)
if serv_p&x'3FFFFFFF'#0 start
print parm header
print list(serv_p&x'3FFFFFFF')
finish
used services(i) = 1
finish
repeat
if j=0 then printstring(snl.snl.snl."None")
newlines(5)
if kernel q = 0 start
heading("KERNEL Q EMPTY",120,'-')
finishelsestart
heading("KERNEL Q X".h to s(kernel q,3),120,'-')
newline
print q(kernelq)
finish
newlines(5)
if run q1=0 start
heading("RUN QUEUE 1 EMPTY",120,'-')
finishelsestart
heading("RUN QUEUE 1 X".h to s(run q1,3),120,'-')
newline
print q(run q1)
finish
newlines(5)
if run q2=0 start
heading("RUN QUEUE 2 EMPTY",120,'-')
finishelsestart
heading("RUN QUEUE 2 X".h to s(run q2,3),120,'-')
newline
print q(run q2)
finish
newlines(5)
heading("OTHER QUEUED MESSAGES",120,'-')
servaa = serva0
for i = 1,1,max serv-1 cycle
servaa = servaa + servf size
serv == record(contiguous address(real address(servaa)))
if serv_p&x'3FFFFFFF' # 0 c
and used services(i) = 0 start
print string(snl.snl."SNO X".h to s(i,3))
if serv_p < 0 then print string(" INHIBITED")
newline
print parm header
print list(serv_p&x'3FFFFFFF')
finish
repeat
newlines(5)
heading("ELAPSED INT QUEUE",120,'-')
if elapsed int q # 0 start
print parm header
print linear list(elapsed int q,0)
finish
if crecaddr # 0 start
comms rec == record(contiguous address(real address( c
crecaddr)))
stream index == array(contiguous address(real address c
(comms rec_index addr)),siaf)
newlines(5)
heading("COMMS CONTROLLER FREE BUFFERS",120,'-')
if comms rec_next free buffer # x'F0F0' start
print buffer header
print linear list(comms rec_next free buffer,
x'F0F0')
finish
newlines(5)
heading("QUEUED COMMS STREAMS",120,'-')
if comms rec_queued stream head # x'F0F0' start
print string("STREAM ")
print stream header
i = comms rec_queued stream head
cycle
if stream index(i) # x'F0F0' start
!STREAM ALLOCATED
write(i,4)
space
print parm cell(stream index(i),j)
j = contiguous address(real address(parma+36 c
*stream index(i)+32))
i = integer(j)
exit if i = x'F0F0';!END OF QUEUED STREAMS
finish else start
print string("STREAM ".i to s(i). c
" HAS NO DESCRIPTOR".snl)
finish
repeat
finish
newlines(5)
heading("COMMUNICATIONS STREAMS",120,'-')
print string("STREAM ")
print stream header
for i = 0,1,3*com_max procs-1 cycle
if stream index(i) # x'F0F0' start ; !STREAM ALLOCATED
write(i,4)
space
print parm cell(stream index(i),j)
j = contiguous address(real address(parma+36* c
stream index(i)+32))
if j # not assigned start
j = integer(j)
if j # x'F0F0' and byteinteger( c
contiguous address(real address(parma+36 c
*stream index(i)+4))) # 9 start
!BUFFER ALLOCATED
print string("BUFFER ")
print buffer header
spaces(6)
print parm cell(j,j)
finish
finish
finish
repeat
finish
newlines(5)
heading("PARM ASL",114,'-')
if parm asl # 0 start
print parm header
print list(parm asl)
finish
if store arr # "YES" start
! Print out cells attached to store array (i.e. those in PIT lists).
! (These have not been printed already as the store array has not been printed.)
newlines(5)
heading("CELLS ATTACHED TO STORE ARRAY",114,'-')
newlines(2)
print store array(com_storeaad,com_sepgs-1,1)
finish
newlines(5)
heading("CELLS NOT QUEUED",114,'-')
print parm header
for i = 1,1,last parm cell cycle
print parm cell(i,j) if used cells(i) = 0
repeat
routine print stream header
printstring( c
"PARMCELL SNO XSNO S M A D LENGTH OWNER CALLER ")
print string(" AMTINDEX START CURSOR LINK". c
snl)
end
routine print buffer header
printstring( c
"PARMCELL STRMNO EXTSTRNO AMTX OFFSET LENGTH ")
print string(" R ADDR SPARE0 SPARE1 LINK". c
snl)
end
routine print parm header
printstring( c
"POSITION DEST SRCE P1 P2 P3")
print string( c
" P4 P5 P6 LINK".snl)
end
routine print q(integer pointer)
! See Supervisor Note 9.
integer link, ad, i
return if pointer = 0
link = pointer
for i= 1,1,64 cycle
servaa = serva0 + servf size*link
ad = contiguous address(real address(servaa))
if ad=not assigned start
printstring("Queue corrupt: link = ".h to s(link,3). c
", Virtual address = ".h to s(servaa,8).snl)
return
finish
serv == record(ad)
print string(snl.snl."SNO X".h to s(link,3))
link = serv_l
if serv_p < 0 then print string( c
" INHIBITED")
if serv_p&x'40000000' # 0 c
then print string(" EXECUTING")
newline
if serv_p&x'3FFFFFFF' # 0 start
print parm header
print list(serv_p&x'3FFFFFFF')
used services(link) = 1
finish
exit if link=pointer or link=0
repeat
end ; !OF ROUTINE PRINT Q
routine print parm cell(integer pointer,
integername flag)
integer first, last, address, pos, i
address = parma+36*pointer
first = contiguous address(real address(address))
-> error if first = not assigned
last = contiguous address(real address(address+32))
-> error if last = not assigned
used cells(pointer) = 1
write(pointer,7)
spaces(6)
if last = first+32 start
for i = first,4,first+28 cycle
print string(h to s(integer(i),8)." ")
repeat
write(integer(last),7); spaces(4)
for i = first+8,1,first+31 cycle
if ' ' < byteinteger(i) < 127 c
then print ch(byteinteger(i)) else space
repeat
finish else start
for i = 0,4,28 cycle
pos = contiguous address(real address(address+i))
-> error if pos = not assigned
print string(h to s(integer(pos),8)." ")
repeat
write(integer(last),7); spaces(4)
for i = 8,1,31 cycle
pos = contiguous address(real address(address+i))
-> error if pos = not assigned
if ' ' < byteinteger(pos) < 127 c
then print ch(byteinteger(pos)) else space
repeat
finish
newline
flag = imod(integer(first)); return
error: flag = -1
end ; !OF ROUTINE PRINT PARM CELL
routine print list(integer pointer)
integer link, pos, flag
link = pointer
until link = pointer cycle
pos = contiguous address(real address(parma+36*link+32))
-> error if pos = not assigned or pos&3#0
link = integer(pos)
unless 0<=link<=last parm cell start
printstring("Invalid link value: ".itos(link).snl)
return
finish
if link = 0 or used cells(link) # 0 start
print string("LIST HAS BECOME CIRCULAR AT THIS POINT".snl)
exit
finish
print parm cell(link,flag)
-> error if flag < 0
repeat
return
error:
print string("Parm cell".itos(link)." is not word-aligned, or has an invalid address".snl)
end ; !OF ROUTINE PRINT LIST
routine print linear list(integer head, end)
integer pos, flag
while head # end cycle
if head = 0 or used cells(head) # 0 start
print string( c
"LIST HAS BECOME CIRCULAR AT THIS POINT".snl)
exit
finish
print parm cell(head,flag)
! flag returns imod of dest or -1 if error.
if flag>>16 = 12 start ; ! Dpon - print cell.
printstring("Dpon:".snl)
print parm cell(flag&x'FFFF', flag)
newline
finish
-> error if flag < 0
pos = contiguous address(real address(parma+36* c
head+32))
-> error if pos = not assigned
head = integer(pos)
repeat
return
error:
print string("PARM CELL"); write(head,2)
print string(" HAS AN INVALID ADDRESS".snl)
end ; !OF ROUTINE PRINT LINEAR LIST
routine print store array(integer address, length, pitonly)
recordformat storef(byteinteger flags, users,
halfinteger link, blink, flink, integer realad)
constinteger storef size = 12
record (storef)name store
integerarray store copy(1:3)
integer i, j, k, add
return if address=0; ! Store array not set up yet - still at CHOPSUPE stage.
if pitonly = 0 start
print string(" FLAGS:
BIT 0 : DISC TRANSFER IN PROGRESS(1)/NOT IN PROGRESS(0)
BIT 1 : DISC INPUT(0)/OUTPUT(1)
BIT 2 : DRUM TRANSFER IN PROGRESS(1)/NOT IN PROGRESS(0)
BIT 3 : DRUM INPUT(0)/OUTPUT(1)" c
.snl)
print string(" BIT 4 : WRITTEN TO MARKER
BIT 5 : TYPE (0:DISC ONLY, 1:DISC & DRUM)
BIT 6 : MAKE NEW
BIT 7 : RECAPTURABLE" c
.snl.snl)
store == record(contiguous address(real address(address)))
print string("STORE ARRAY SEMAPHORE X".h to s(store_ c
realad,8).snl)
newline
finish
for i = 1,1,2 cycle
print string( c
"INDEX REALADDR FLAGS USERS BLINK FLINK AMT/DRUMINDEX")
spaces(10)
repeat
newline
i = -1; j = -1
while j<length cycle
i = i+1
add = address+i*storef size
if add&4095>4087 start ; ! Record straddles epage boundary.
for k = 1,1,3 cycle
store copy(k) = integer(contiguous address(real address(add)))
add = add+4
repeat
store == record(addr(store copy(1)))
finishelse store == record(contiguous address(real address(add)))
continue if i>0 and store_realad=0
j = j+1
if pitonly=0 or store_flags&x'C0' = x'80' c
or store_flags&x'30' = x'20' start
write(i,4)
print string(" X".h to s(store_realad,8))
print string(" X".h to s(store_flags,2))
write(store_users,5)
write(store_blink,5)
write(store_flink,5)
finish
if store_flags&x'C0' = x'80' c
or store_flags&x'30' = x'20' start
print string(snl."PIT LIST".snl)
print parm header
print linear list(store_link,0)
finish else start
if pitonly = 0 start
write(store_link&x'7FFF',8)
if store_link&x'8000' # 0 c
then print symbol('D') else space
if j&1 = 1 then newline else spaces(15)
finish
finish
repeat
newline
end ; !OF ROUTINE PRINT STORE ARRAY
routine print disc device table(integer dlvnaddr, ditaddr)
routine print disc header
printstring(" POSITION DEST FAULTS ")
printstring(" REQTYPE IDENT CYLINK COREADDR CYLINDER ")
printstring(" TRKSET STOREX REQLINK".snl)
end ; ! of print disc header.
routine print disc q(integer head, linkdisp, extra q)
routine print disc cell(integer pointer, integername flag)
constinteger dec=1, hex=2, skip=3
switch sw(dec:skip)
constbyteintegerarray types(1:12) = c
hex, dec, skip(2), dec, hex, dec, hex, dec, hex(2), dec
constbyteintegerarray lengths(1:12) = 4, 1(4), 4(7)
integer first, last, address, pos, i, contig, subfield
address = parma + 36*pointer
first = contiguous address(real address(address))
->error if first=not assigned
last = contiguous address(real address(address+32))
->error if last=not assigned
used cells(pointer) = 1
spaces(11); write(pointer,7); spaces(2)
if last = first+32 then contig=1 else contig=0
i = 0; ! rel posn in record
subfield = 0; ! item within record, described by arrays lengths and types.
while i<36 cycle
subfield = subfield+1
if contig=1 then pos = first+i else pos = c
contiguous address(real address(address+i))
->error if pos=not assigned
->sw(types(subfield))
sw(hex): ! 4 bytes assumed.
printstring(h to s(integer(pos),8)." ")
i = i+4
continue
sw(dec): ! 1 or 4 bytes.
if lengths(subfield)=1 start
write(byteinteger(pos),7); space
i = i+1
finishelsestart
write(integer(pos),7); space
i = i+4
finish
continue
sw(skip):
i = i + lengths(subfield)
repeat
newline
flag = 0
return
error:
newline
flag = -1
end ; ! of print disc cell.
integer pos, flag
! Start of code for print disc q.
while head#0 cycle
if used cells(head)#0 start
printstring("Error: pointing at cell already printed out,")
write(head,1); newline
exit
finish
print disc cell(head, flag)
->error if flag#0
if extra q=1 start
pos = contiguous address(real address(parma + 36*head + 12))
->error if pos=not assigned
if integer(pos)#0 start
! There are further transfers on this cylinder.
printstring(" Further transfers on this cylinder:".snl)
print disc q(integer(pos), 12, 0); ! 12 is the link displacement.
finish
finish
pos = contiguous address(real address(parma+36*head+linkdisp))
->error if pos=not assigned
head = integer(pos)
repeat
return
error:
printstring("Parm cell"); write(head,1)
printstring(" has an invalid link address.".snl)
end ; ! of %routine print disc q.
integer i, j, printhead
integerarrayformat ditf(0:99)
integerarrayname dit
byteintegerarrayformat dlvnaf(0:99)
byteintegerarrayname dlvna
record (entform)name ddte
record (qform)name ddtq
conststring (8)array sstate(-1:15) = c
" ", " DEAD ", " CONNIS ", " RLABIS ", " DCONNIS", " AVAIL ",
" PAGTIS ", " PAGSIS ", " INOP ", " RRLABIS", " PTISLGP", " PAVAIL ",
" PCLAIMD", " PTRANIS", " PSENIS ", " SPTRNIS", " RLABSIS"
! Start of code for print disc device table.
if dlvnaddr=not assigned or ditaddr=not assigned start
printstring("COM_DLVNADDR or COM_DITADDR not assigned.".snl.snl)
return
finish
dlvna == array(dlvnaddr,dlvnaf)
dit == array(ditaddr,ditf)
printhead = 1
for i = 0,1,99 cycle
continue if dlvna(i)>250
j = contiguous address(real address(dit(dlvna(i))))
if j=0 or j=not assigned start
printstring("DIT array not set up. FSYS, DIT index:")
write(i,2); printsymbol(',')
write(dlvna(i),2); newline
finish
ddte == record(j)
if system type=0 then ddtq==record(addr(ddte_p qaddr)) c
else ddtq==record(addr(ddte_s qaddr))
if printhead=1 start
printstring("FSYS PTS CAA RQA LBA/iden ALA/TLA ")
printstring("STATE CONCOUNT MNEM LAB CURCYL".snl)
printhead = 0
finish
write(i,2); spaces(7); ! FSYS number.
printstring(htos(ddte_pts,8)." ".htos(ddte_caa,8)." ".htos(ddte_rqa,8). c
" ".htos(ddte_lba,8)." ".htos(ddte_ala,8)." ")
j = ddte_state; j = -1 unless 0<=j<=15
printstring(sstate(j)." ")
write(ddte_concount,6); spaces(5)
printch(byteinteger(addr(ddte_mnemonic)+j)) for j=0,1,3; spaces(4)
printstring(ddte_lab); spaces(6-length(ddte_lab))
write(ddtq_curcyl,7); newline
if ddtq_trlink#0 start
printstring(" DISC TRANSFERS IN PROGRESS".snl)
printhead = 1
print disc header
print disc q(ddtq_trlink,32,0)
finish
if ddtq_uqlink#0 start
printstring(" UPPER QUEUE OF PENDING DISC TRANSFERS".snl)
print disc header
printhead = 1
print disc q(ddtq_uqlink,32,1)
finish
if ddtq_lqlink#0 start
printstring(" LOWER QUEUE OF PENDING DISC TRANSFERS".snl)
print disc header
printhead = 1
print disc q(ddtq_lqlink,32,1)
finish
newline
repeat
end ; ! of %routine print disc device table.
end ; !OF ROUTINE PRINT QUEUES
routine print process table(integer address, max procs)
! PROCESS INFORMATION ARRAY DECS ETC.
conststring (22) array status(0 : 31) = c
" Holding semaphore",
" On a page fault",
" Background",
" De-allocating AMT",
" AMT lost",
" More time on fly",
" More pages on fly",
" Snoozing",
" LC stack read fail",
" LC stack snoozed",
" Claimed (part of) DAP",
""(21)
record (procf)name proc
integer proc no, add, i, flag
add = not assigned
add = contiguous address(real address(address)) unless address=0
if add # not assigned start
print string( c
" USER INC CAT P4-P4 RUNQ ACTIVE ". c
"ACTW0 LOCSTKAD LOC AMTX STACKSEG STATUS". c
snl)
for proc no = 1,1,max procs cycle
address = address + procf size
add = contiguous address(real address(address))
exit if add = not assigned
proc == record(add)
if proc_user # "" start
write(proc no,3)
if length(proc_user)=6 then c
print string(" ".proc_user) else c
printstring(" ERROR")
write(proc_incar,3)
write(proc_category,3)
write(proc_p4top4,5)
write(proc_runq,4)
write(proc_active,6)
print string(" X".h to s(proc_actw0,8 c
)." X".h to s(proc_lstad,8)." X". c
h to s(proc_lamtx,8)." X".h to s( c
proc_stack,8))
flag = 0
for i = 0,1,31 cycle
if proc_status&1<<i # 0 start
printch(';') if flag=1
flag = 1
print string(status(i))
finish
repeat
newline
finish
repeat
finish
if add = not assigned then print string("X".h to s(address,8). c
" IS NOT A VALID ADDRESS".snl)
end ; !OF ROUTINE PRINT PROCESS TABLE
routine print ist(integer port)
!********************************************************************
!* *
!* PRINTS THE INTERRUPT STEERING TABLE FOR THE OCP ON THE *
!* SPECIFIED PORT. *
!* *
!********************************************************************
integer i, j, add, hi ist
conststring (22) array type(1 : 14) = c
" SYSTEM ERROR ",
" EXTERNAL ",
" MULTIPROCESSOR ",
" PERIPHERAL ",
" VIRTUAL STORE ",
" INTERVAL TIMER ",
" PROGRAM ERROR ",
" SYSTEM CALL ",
" OUT ",
" EXTRA CODE ",
" EVENT PENDING ",
" INSTRUCTION COUNTER ",
" PRIMITIVE ",
" UNIT "
add = contiguous address(real address(public!port<<18))
print string(" SEGMENT X".h to s(public!port<<18,8))
if add # not assigned start
if system type=0 then hi ist=12 else hi ist=14
newlines(2)
spaces(25)
print string( c
"SSN/LNB PSR PC SSR ". c
" SSN/SF IT IC CTB ".snl)
for i = 1,1,hi ist cycle
write(i,2)
print string(type(i))
for j = 1,1,8 cycle
print string(h to s(integer(add),8)." ")
add = add+4
repeat
newline
repeat
finish else print string(" NOT VALID".snl)
end ; !OF ROUTINE PRINT IST
routine print text(integer out, in, end)
!**********************************************************************
!* *
!* PRINTS A CYCLIC BUFFER STARTING AT 'OUT' AND FINISHING AT 'IN' *
!* 'END' IS THE LAST BYTE IN THE CYCLIC BUFFER STARTING ON A SEGMENT *
!* BOUNDARY. *
!* *
!**********************************************************************
integer caddr, begin, mess
if out&x'FFFC0000' = in&x'FFFC0000' = end&x'FFFC0000' start
!ALL IN SAME SEG
begin = end&x'FFFC0000'; !STARTS ON A SEGMENT BOUNDARY
caddr = contiguous address(real address(out))
if in&(epage size<<10 -1)<=63 start
in=in&(¬(epage size<<10-1))-1
in=end if in&x'FFFC0000' # end&x'FFFC0000'
! SET IN TO END OF BUFFER IF ADJUSTMENT HAS MOVED IT INTO
! PREVIOUS SEGMENT.
finish
mess = 0; ! Error message flag.
while out # in cycle
if caddr = not assigned start
printstring("Page containing X".htos(out,8). c
" not available.".snl) and mess=1 if mess=0
finishelsestart
print ch(byteinteger(caddr)) if byteinteger(caddr) # 0
finish
out = out+1
out = begin if out > end
!CHECK IF VIRTUAL ADDRESS CROSSES PAGE BOUNDARY
if out&(epage size<<10-1) = 0 start
out = out+64
caddr = contiguous address(real address(out))
mess = 0
finishelsestart
caddr = caddr+1 unless caddr = not assigned
finish
repeat
finish else print string("INVALID BUFFER POINTERS".snl)
end ; !OF ROUTINE PRINT TEXT
integerfn segment length(integer vaddr)
!**********************************************************************
!* *
!* RETURNS THE NUMBER OF BYTES FROM 'VADDR' TO END OF SEGMENT. *
!* *
!**********************************************************************
record (segtf)name segment
integer seg no, length
seg no = (vaddr&x'7FFC0000')>>18
if vaddr&public # 0 start
result = not assigned unless 0 <= seg no <= pstl
segment == public segment table(seg no)
finish else start
result = not assigned unless 0 <= seg no <= lstl
segment == local segment table(seg no)
finish
length = segment_ste1&x'3FF80'+x'80'
result = not assigned if segment_ste2&avail = 0 c
or vaddr&x'3FFFF' >= length
result = length-vaddr&x'3FFFF'
end ; !OF INTEGERFN SEGMENT LENGTH
routine dump seg(integer vaddr, length)
!**********************************************************************
!* *
!* DUMPS 'LENGTH' BYTES FROM 'VADDR'. WORKS FOR PAGED/UNPAGED *
!* SEGMENTS *
!* *
!**********************************************************************
integer actual length, saddr, eaddr, end, above
actual length = segment length(vaddr)
! Note: actual length from VADDR to end of segment.
if actual length # not assigned start ; !CHECK VADDR IN SEGMENT
above = 0; ! Used when calling DUMP.
length = actual length if actual length < length
print string(snl.snl."DUMP OF ".i to s(length)." (X". c
h to s(length,8).")"." BYTES FROM"." X".h to s( c
vaddr,8).snl)
until length <= 0 cycle
end = vaddr&(-(epage size<<10))+(epage size<<10)-1; ! Next epage boundary.
end = vaddr+length-1 if end-vaddr > length
saddr = contiguous address(real address(vaddr))
eaddr = contiguous address(real address(end))
if eaddr # not assigned c
and saddr # not assigned c
and saddr # eaddr then dump(saddr,end-vaddr,
vaddr,above) else printstring("X".h to s(vaddr,8). c
" TO X".h to s(end,8)." NOT AVAILABLE".snl.snl)
length = length-(end-vaddr)-1
vaddr = end+1
repeat
if above#0 then above=-above and dump(saddr,saddr,saddr,above)
finish else print string(snl.snl."X".h to s(vaddr,8). c
" IS NOT A VALID ADDRESS".snl)
end ; !OF ROUTINE DUMP SEG
routine print active memory table( c
integer amtaa, amtaa len, amtdda, amtdda len)
!********************************************************************
!* *
!* PRINTS THE ACTIVE MEMORY TABLE SPECIFYING THE STORE OR DRUM *
!* INDEX FOR EACH PAGE. *
!* *
!********************************************************************
integer maxamtak
maxamtak = com_maxprocs//2//epagesize*epagesize
recordformat amtf(integer da,halfinteger ddp,users,link,
byteinteger len,outs)
! DA : DISC ADDRESS
! DDP : AMTDD POINTER
! LINK : COLLISION LINK
! USERS : NO OF USERS OF PAGES OF THIS BLOCK
! LEN : BLOCK LENGTH IN EPAGES
! OUTS : NO OF PAGE-OUTS OF PAGES IN THIS BLOCK IN PROGRESS
constinteger amtflen = 12
! %RECORD(AMTF)%ARRAYFORMAT AMTAF(1 : MAXAMTAK<<10//AMTFLEN)
! %RECORD(AMTF)%ARRAYNAME AMTA
record (amtf)name amt
integer maxamtddk
maxamtddk = com_maxprocs//epagesize*epagesize
constinteger ddflen = 2
! %HALFINTEGERARRAYFORMAT AMTDDF(1:MAXAMTDDK<<10//DDFLEN)
! %HALFINTEGERARRAYNAME AMTDD
! EACH %HALF %INTEGER : NEW EPAGE(1) / STOREX-DRUMTX(1) / ?X(14)
integer max amt size, max amtdd size, scaddr, sc, fcaddr, i, j,
ddp, l, users, outs, daddr, drumtad0
if amtaa len # not assigned start
if amtdda len # not assigned start
amtaa = amtaa+maxamtak<<2; !VIRTUAL ADDRESS OF START OF AMT
amtdda = amtdda+maxamtddk<<2; !VIRTUAL ADDRESS OF START OF AMTDD
max amt size = (amtaa len-maxamtak<<2)//amtflen
max amtdd size = (amtdda len-maxamtddk<<2)//ddflen
print string( c
"INDEX DISCADDR LINK USE L O AMTDDP")
for i = 1,1,16 cycle
write(i,5)
repeat
newline
spaces(36)
for i=17,1,32 cycle
write(i,5)
repeat
newline
for i = 1,1,max amt size cycle
scaddr = contiguous address(real address(amtaa+ c
amtflen*(i-1)))
fcaddr = contiguous address(real address(amtaa c
+amtflen*i-1))
exit if scaddr = not assigned c
or fcaddr = not assigned
unless integer(scaddr) = 0 or (integer(scaddr)=x'FF000000' c
and amtab#"FULL") start
!IGNORE ZERO DISC ADDRESS UNLESS "FULL" EXPLICITLY REQUESTED.
write(i,4); space
print string(h to s(integer(scaddr),8))
!DISCADDRESS
if fcaddr = scaddr+amtflen-1 start
!CONTIGUOUS IN STORE
amt == record(scaddr)
ddp = amt_ddp
write(amt_link,4)
write(amt_users,3)
users = amt_users
write(amt_len,2)
l = amt_len
write(amt_outs,2)
outs = amt_outs
finish else start
scaddr = contiguous address(real address( c
amtaa+amtflen*(i-1)+4))
ddp = halfinteger(scaddr)
scaddr = contiguous address(real address( c
amtaa+amtflen*(i-1)+6))
write(halfinteger(scaddr),4)
scaddr = contiguous address(real address( c
amtaa+amtflen*(i-1)+8))
users = halfinteger(scaddr)
write(users,3)
scaddr = contiguous address(real address( c
amtaa+amtflen*(i-1)+10))
write(byteinteger(scaddr),2); ! L
l = byteinteger(scaddr)
outs = byteinteger(fcaddr)
write(outs,2)
finish
if users > 0 or outs > 0 start
write(ddp,6)
if ddp <= max amtdd size start
drumtad0 = contiguous address(real address(com_drumtad))
for j = ddp,1,ddp+l-1 cycle
newline and spaces(36) if j = ddp+16
scaddr = contiguous address( c
real address(amtdda+(j-1)* c
ddflen))
sc = halfinteger(scaddr)
if sc&x'BFFF' # x'BFFF' start
if sc&x'3FFF' # x'3FFF' start
if sc&x'4000'#0 start
!DRUM TABLE.
daddr= drumtad0 + (sc&x'3FFF')<<1
if halfinteger(daddr)&x'3FFF' # x'3FFF' c
then write(halfinteger(daddr)&x'3FFF',4) c
and print symbol('B') else c
write(sc&x'3FFF',4) and printsymbol('D')
finishelsestart
write(sc&x'3FFF',4)
printsymbol('S')
finish
finish else print string( c
" NO")
finish else print string( c
" NEW")
repeat
finish else print string(" DDP?")
finish
newline
finish
repeat
finish else print string("AMTDDA NOT VALID".snl)
finish else print string("AMTA NOT VALID".snl)
end ; !OF ROUTINE PRINT ACTIVE MEMORY TABLE
!*********************************************
!* _*
!*_THIS ROUTINE RECODES FROM HEX INTO NEW *
!*_RANGE ASSEMBLY CODE. *
!* _*
!*********************************************
routine ncode(integer start, finish, ca)
routinespec primary decode
routinespec secondary decode
routinespec tertiary decode
routinespec decompile
conststring (5) array ops(0 : 127) = c
" ","JCC ","JAT ","JAF "," "," "," ","OBS ",
"VAL ","CYD ","INCA ","MODD ","PRCL ","J ","JLK ","CALL ",
"ADB ","SBB ","DEBJ ","CPB ","SIG ","MYB ","VMY ","CPIB ",
"LCT ","MPSR ","CPSR ","STCL ","EXIT ","ESEX ","OUT ","ACT ",
"SL ","SLSS ","SLSD ","SLSQ ","ST ","STUH ","STXN ","IDLE ",
"SLD ","SLB ","TDEC ","INCT ","STD ","STB ","STLN ","STSF ",
"L ","LSS ","LSD ","LSQ ","RRTC ","LUH ","RALN ","ASF ",
"LDRL ","LDA ","LDTB ","LDB ","LD ","LB ","LLN ","LXN ",
"TCH ","ANDS ","ORS ","NEQS ","EXPA ","AND ","OR ","NEQ ",
"PK ","INS ","SUPK ","EXP ","COMA ","DDV ","DRDV ","DMDV ",
"SWEQ ","SWNE ","CPS ","TTR ","FLT ","IDV ","IRDV ","IMDV ",
"MVL ","MV ","CHOV ","COM ","FIX ","RDV ","RRDV ","RDVD ",
"UAD ","USB ","URSB ","UCP ","USH ","ROT ","SHS ","SHZ ",
"DAD ","DSB ","DRSB ","DCP ","DSH ","DMY ","DMYD ","CBIN ",
"IAD ","ISB ","IRSB ","ICP ","ISH ","IMY ","IMYD ","CDEC ",
"RAD ","RSB ","RRSB ","RCP ","RSC ","RMY ","RMYD "," "
integer k, kp, kpp, n, opcode, flag, insl, dec, h, q, ins,
kppp, pc, all, r addr
constintegerarray hx(0 : 15) = c
'0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
pc = 0
all = finish-start
newline
while pc < all cycle
flag = 0
h = 0
dec = 0
raddr = contiguous address(real address(start+pc))
if raddr = not assigned start
print string("PC X".h to s(start+pc,8). c
" NOT VALID".snl)
return
finish
move(4,raddr,addr(ins))
opcode = ins>>25<<1
if ops(opcode>>1) = " " start
insl = 16
flag = 1
finish else start
if 2 <= opcode <= 8 then tertiary decode c
else start
if x'8' <= opcode>>4 <= x'B' c
and opcode&x'F' < 7 then secondary decode c
else primary decode
finish
finish
decompile
print string(" <--------- FAILING PC") c
if pc+start = failing pc
pc = pc+insl>>3
newline
repeat
!***********************************************************************
!*_ROUTINE TO INTERPRET PRIMARY FORMAT INSTRUCTION
routine primary decode
dec = 1
k = ins<<7>>30
n = ins<<9>>25
unless k = 3 then start
insl = 16
return
finish
kp = ins<<9>>30
kpp = ins<<11>>29
if kpp < 6 then insl = 32 and n = ins&x'3FFFF' c
else start
unless ins&x'30000' = 0 c
then printstring(" RES. FIELD #0
")
insl = 16
finish
end ; ! PRIMARY DECODE
!***********************************************************************
!*_ROUTINE TO INTERPRET SECONDARY FORMAT INSTRUCTIONS
routine secondary decode
dec = 2
h = ins<<7>>31
q = ins<<8>>31
n = ins<<9>>25
if q = 1 then insl = 32 else insl = 16
end ; ! SECONDARY DECODE
!***********************************************************************
!*_ROUTINE TO INTERPRET TERTIARY FORMAT INSTRUCTIONS
routine tertiary decode
dec = 3
kppp = ins<<11>>29
if kppp > 5 then insl = 16 else insl = 32
n = ins&x'3FFFF'
if insl = 16 and ins<<14>>16 # 0 c
then printstring(" 2 LS BITS #0
")
end ; ! TERTIARY DECODE
!***********************************************************************
!*_ROUTINE TO INTERPRET CURRENT INSTRUCTION
routine decompile
integer i, j
conststring (12) array pop(0 : 31) = c
"N ","*** ","(LNB+N) ","(XNB+N) ",
"(PC+N) ","(CTB+N) ","TOS ","B ",
"@DR,N ","*** ","@DR,(LNB+N) ","@DR,(XNB+N) ",
"@DR,(PC+N) ","@DR,(CTB+N) ","@DR,TOS ","*** ",
"ISN ","*** ","@(LNB+N) ","@(XNB+N) ",
"@(PC+N) ","@(CTB+N) ","@TOS ","@DR ",
"ISB ","*** ","@(LNB+N),B ","@(XNB+N),B ",
"@(PC+N),B ","@(CTB+N),B ","@(TOS+B) ","@(DR+B) "
conststring (12) array top(0 : 7) = c
c
"N ","@DR,N ","(LNB+N) ","(XNB+N) ",
"(PC+N) ","(CTB+N) ","@DR ","@DR,B "
j = pc+ca
print string(h to s(j,8)." ")
for i = 3,-1,0 cycle
j = (ins>>(8*i))&x'FF'
if 32 <= j <= 95 then printsymbol(j) c
else print string(".")
exit if i = 2 and insl = 16
repeat
if insl = 16 then print string(" ".h to s( c
ins>>16,4)) else print string(" ".h to s(ins,8))
return if flag = 1
printstring(" ".ops(opcode>>1)." ")
if dec = 1 then start ; ! PRIMARY FORMAT
if k < 3 then start
if k = 1 then printstring("(LNB+N) X")
if k = 2 then printstring("@(LNB+N) X")
if k = 0 then printstring(" X")
if k = 0 then start
if n>>6 = 1 then n = -(n!x'FFFFFF80') c
and print string("-")
finish
printsymbol(hx((n>>4)&7))
printsymbol(hx(n&15))
finish else start
printstring(pop(kp*8+kpp))
if insl = 32 then start
printstring("X")
if (kp = 0 and kpp = 0) or kpp = 4 c
then start
if (n>>16) > 1 then n = -(n! c
x'FFFC0000') and print string("-")
finish
printsymbol(hx((n>>16)&3))
print string(h to s(n,4))
finish
finish
finish
if dec = 2 then start ; ! SECONDARY FORMAT
printstring(" X")
printsymbol(hx((ins>>20)&7))
printsymbol(hx((ins>>16)&15))
if insl = 32 then start
! MASK
printstring(" X")
printsymbol(hx((ins>>12)&15))
printsymbol(hx((ins>>8)&15))
! LITERAL/FILLER
printstring(" X")
printsymbol(hx((ins>>4)&15))
printsymbol(hx(ins&15))
printstring(" H=")
write(h,1)
finish
finish
if dec = 3 then start ; ! TERTIARY FORMAT
printstring(top(kppp))
if insl = 32 then start
! M FIELD
printstring("X")
printsymbol(hx((ins>>21)&15))
printstring(" X")
if kppp = 0 or kppp = 4 then start
if (n>>16) > 1 then n = -(n!x'FFFC0000') c
and print string("-")
finish
printsymbol(hx((n>>16)&3))
print string(h to s(n,4))
finish
finish
end ; ! DECOMPILE
end ; ! NCODE
routine print opers(integer table addr)
conststring (14) array res pic title(1 : 4) = c
" OPER LOG " , "PROCESS LIST", "SPOOLR PICTURE", "VOLUMS PICTURE"
integerarray res pic ad(1 : 4)
integerarrayformat ift(0 : 1023)
integerarrayname table
record (gpctf)name g
record (entform)name device entry
record (statef)name state
string (40) line
integer last slot, gbase, device no, line addr, base, i,
k, a1, a2, l1, l2, page pos
if table addr # not assigned start
table addr = contiguous address(real address(integer( c
table addr)))
if table addr # not assigned start
table == array(table addr,ift)
line addr = addr(line)+1
byteinteger(line addr-1) = 40
newlines(2)
printstring("Resident Pictures:")
res pic ad(1) = contiguous address(real address( c
table(41)))
res pic ad(2) = contiguous address(real address( c
table(42)))
res pic ad(3) = contiguous address(real address( c
table(43)+2048))
if res pic ad(3) = not assigned then res pic ad(4)= c
not assigned else res pic ad(4) = res pic ad(3)+1024
for i = 1,2,3 cycle
newlines(3)
spaces(31); printstring(res pic title(i))
spaces(45); printstring(res pic title(i+1))
newlines(2)
l1 = 0; l2 = 0
l1 = integer(res pic ad(i)) unless res pic ad(i) = not assigned
a1 = res pic ad(i)+8
l2 = integer(res pic ad(i+1)) unless res pic ad(i+1) = not assigned
a2 = res pic ad(i+1)+8
while l1 > 0 or l2 > 0 cycle
if l1 > 0 start
spaces(17)
move(40,a1,line addr); etoi(line addr,40)
printstring(line)
l1 = l1-41; ! Remaining length of picture.
a1 = a1+41; ! Next line of picture.
finish else spaces(57)
if l2 > 0 start
spaces(17)
move(40,a2,line addr); etoi(line addr,40)
printstring(line)
l2 = l2-41
a2 = a2+41
finish
newline
repeat
newlines(6)
repeat
last slot = table(2)
gbase = table addr+table(1)<<2
page pos = 0
for device no = 0,1,9 cycle
for i = 0,1,last slot cycle
g == record(gbase)
if g_mnemonic = m'OP0'!DEVICE NO START
device entry == record(contiguous address( c
real address(g_entad)))
continue if device entry_state=0
state == record(contiguous address( c
real address(device entry_state)))
if system type=0 then k=p buffad else k=s buffad
base = contiguous address(real address( c
state_word(k)))
newpage if page pos&1 =0
page pos = page pos + 1
newlines(5); spaces(53)
printstring("OPER ".itos(device no).snl. c
snl)
for k = 0,1,23 cycle
move(40,base,line addr)
etoi(line addr,40)
spaces(36); printstring(line.snl)
base = base+41
repeat
exit ; ! I.e. if OP0n found, go to next device no.
finish
gbase = gbase+32
repeat
repeat
return
finish
finish
print string("Cannot display opers - address not valid". C
snl)
end ; !OF ROUTINE PRINT OPERS
*mpsr_x'2180'
! Suppresses integer overflow.
printstring(vsn.snl)
outfile = ".LP" unless file -> file.(",").outfile
define("1,".outfile.",1023")
file = "DUMPFILE" unless file # ""
connect(file,0,0,0,r,flag)
if flag = 0 start ; !CONNECTED DUMP FILE
file header == record(r_ca)
j = file header_end-file header_start
for i = 1,-1,0 cycle
select output(i)
newlines(10) and spaces(24) if i = 1
print string("Dump is of ".i to s(j>>10)."K from ".file header_tape." read on ".unpackdate c
(file header_datetime)." AT ".unpacktime(file header_datetime).snl)
if j&(store block size-1)#0 start
printstring("****WARNING: Dump does not contain a whole number of ".itos(store block size>>10))
printstring("K store blocks****".snl)
finish
repeat
if substring(outfile,1,3) = ".LP" start
prompt("DELIVER TO:")
read line(delivery)
finish
conad = r_ca+file header_start
endad = r_ca + file header_end
pstl = (integer(conad)&x'7FFC0000')>>18
!PST LENGTH AT REAL ADDRESS 0
pstb = integer(conad+4); ! Real address of the PSTB is at real address 4
printstring(snl.snl."PSTB real address =")
write(pstb,1)
printstring(", PSTL =")
write(pstl,1); newline
if pstb=0 or pstl=0 start
printstring(snl.snl."Dump analysis cannot start".snl.snl)
return
finish
public segment table == array(conad+pstb,segtaf)
segment == public segment table(diag info seg)
!SEGMENT CONTAINS DIAGNOSTIC INFO
seg10 == record(conad+segment_ste2&x'FFFFF80')
!SEGMENT MUST BE IN SMAC 0 BLOCK 0 AND BE AVAILABLE
k = seg10_store blocks
if k>128 start
printstring("Seg10_store blocks corrupt (=")
write(k,1)
printstring("), Dump cannot continue.".snl.snl)
return
finish
! Now assign array 'store map' to relate store blocks to their
! contiguous addresses. There are 0 -> seg10_store blocks store blocks.
for i = 0,1,max blks*max smacs*max rss-1 cycle
store map(i) = not assigned
repeat
j = conad; !CONNECT ADDRESS OF STORE MAP
for i = 0,1,k-1 cycle
rsn = seg10_block ad(i)>>26&3
smacn = seg10_block ad(i)>>22&x'F'
blkn = seg10_block ad(i)>>17&x'1F'
store map(blkn+smacn*max blks+rsn*max smacs*max blks) = j
j = j+store block size; !ADD IN 128K THE SIZE OF A BLOCK
repeat
!* THE ARRAY STORE MAP NOW HOLDS THE CONTIGUOUS ADDRESS OF EACH AVAILABLE STORE BLOCK
!* (The contiguous address is the address in the virtual memory of the process
!* running the DUMP routine.)
caddr = contiguous address(real address(public! c
comms area start<<18))
com == record(caddr)
system type=com_systype
if system type=0 then stack seg for port==array(addr(ssfp(-2)),ssfpf) c
else stack seg for port==array(addr(ssfp(0)),ssfpf)
if seg10_syserr < -1 then failocp = seg10_syserr&3 else c
if seg10_syserr>0 then failocp = seg10_syserr>>29 else c
failocp=com_ocpport0
findlst(failocp,com_procaad,com_maxprocs)
setlst(failocp) ; ! This is the default setting for local seg. table.
if com_nocps = 2 then findlst(failocp!!1,com_procaad,com_maxprocs)
prompt("MAINLOG .OUT?:")
read line(summary)
if summary="Y" or summary="YES" start ; ! SUMMARY TO TERMINAL
printstring("Main log ......
")
print text(seg10_out ptr,seg10_in ptr,
seg10_buff last byte)
printstring("
..... end of mainlog
")
finish
prompt("DUMP ANALYSIS:")
read line(dump anal)
if dump anal = "FULL" or dump anal = "F" start
dump anal = "YES"
photo = "YES"
store arr = "YES"
amtab = "FULL"
stk = "YES"
gla = "YES"
carea = "YES"
finish else start
if dumpanal="Y" or dumpanal="YES" start
prompt("PHOTO:")
read line(photo)
prompt("STORE ARR:")
read line(store arr)
store arr = "YES" if store arr = "Y" or store arr = "FULL" c
or store arr = "F"
prompt("AMT:")
read line(amtab)
amtab="FULL" if amtab="F"
amtab="YES" if amtab="Y"
finish
prompt("STKS:")
read line(stk)
prompt("GLA:")
read line(gla)
prompt("COMMS AREAS:")
read line(carea)
finish
if com_nocps=2 then prompt("OCP ADDR LNGTH:") else c
prompt("ADDR LENGTH:")
n segs = 0
cycle
read line(s)
exit if s = "ST" or s = "STOP" or s = "END" c
or s = ".END" or s = "N" or s = "NO"
if com_nocps=2 start
i=s to i(s)
unless i=failocp or i=failocp!!1 then i=failocp
dump segs(n segs +1)_ocp = i
finish else dump segs(n segs +1)_ocp = failocp
dump segs(n segs+1)_addr = s to i(s)
if s = "*" then dump segs(n segs+1)_length = c
segment size else dump segs(n segs+1)_length = c
s to i(s)
if dump segs(n segs+1)_addr = not assigned c
or dump segs(n segs+1)_length = not assigned c
then print string("ADDRESS LENGTH?".snl) c
else n segs = n segs+1
repeat
select output(1)
newline
spaces(24)
print string("DUMP OF A ")
print string("DUAL OCP ") if com_nocps = 2
i=system type
i=1 if i>0
print string(ocp type(com_ocp type&15,i)." TAKEN ON ".string( c
addr(com_date0)+3)." AT ".string(addr(com_time0)+3). c
snl.snl)
spaces(24)
print string("EMAS SUPERVISOR ".string(addr(com_supvsn) c
)." LOADED FROM FSYS ".i to s(com_suplvn). c
" CHOPSUPE IPL FROM ".h to s(com_slipl,3). c
" DIRECTOR SITE X".h to s(com_dcodeda,8).snl)
newlines(4)
spaces(18)
print string("SYSTEM ERROR PARAMETER ")
if seg10_syserr >= 0 then printstring("X".htos(seg10_syserr,8)) c
else printstring(itos(seg10_syserr))
print string(" STACK X".h to s(seg10_stack,8))
print string(" HAND KEYS X".h to s(seg10_hand keys,8). c
snl)
caddr = contiguous address(real address(seg10_stack+1<<18))
newlines(4)
heading("REGISTERS",110,'-')
newline
unless caddr = not assigned or seg10_syserr < 0 start
spaces(15)
printstring( c
"SSN/LNB PSR PC SSR ". c
" SSN/SF IT IC CTB ".snl)
spaces(15)
for i = 0,4,28 cycle
print string(h to s(integer(caddr+i),8)." ")
repeat
newlines(3)
spaces(15)
print string( c
" XNB B DR0 DR1 ". c
" A0 A1 A2 A3".snl)
spaces(15)
for i = 32,4,60 cycle
printstring(h to s(integer(caddr+i),8)." ")
repeat
newlines(3)
spaces(15)
printstring(" XTRA1 XTRA2".snl.snl)
spaces(15)
if integer(caddr+8)>>18 = integer(caddr+64)>>18 c
then failing pc = integer(caddr+64) c
else failing pc = integer(caddr+8)
for i = 64,4,68 cycle
print string(h to s(integer(caddr+i),8)." ")
repeat
newline
finish else start
failing pc = 0
spaces(30)
print string("CANNOT PRINT REGISTERS ")
if caddr = not assigned c
then print string("SSN+1 X".h to s(seg10_stack+1<< c
18,8)." NOT VALID".snl) c
else print string("NO SYSTEM ERROR".snl)
finish
newpage
if dump anal = "YES" or dump anal = "Y" start
i = charno(photo,1); i = i-32 if 'a'<=i<='z'
j = 0
j = 1 if i='Y' or i='F'
j = 2 if i='2'
j = 3 if i='3'
j = -2 if i='B'
while j#0 cycle
heading("PHOTOGRAPH",128,'-')
newlines(2)
photograph(imod(j))
if j>0 then j=0 else j=3
repeat
heading("PUBLIC SEGMENT TABLE (X".h to s(pstb,8).")",96,'-')
newlines(2)
print segment table(conad+pstb,pstl,8192)
newpage
heading("LOCAL SEGMENT TABLE (OCP ON PORT ".itos(failocp). c
") (X".h to s(lstb,8).")",96,'-')
newlines(2)
if lstb # 0 then caddr = contiguous address(lstb) c
else lstl = -1
print segment table(caddr,lstl,0)
newpage
if com_nocps = 2 start
setlst(failocp!!1)
heading("LOCAL SEGMENT TABLE (OCP ON PORT ".itos(failocp!!1). c
") (X".h to s(lstb,8).")",96,'-')
newlines(2)
if lstb # 0 then caddr = contiguous address(lstb) c
else lstl = -1
print segment table(caddr,lstl,0)
newpage
setlst(failocp)
finish
heading("OPER DISPLAYS",115,'-')
newline
print opers(contiguous address(real address(public! c
comms area start<<18+7<<2)))
newpage
heading("INTERRUPT STEERING TABLE FOR OCP ON PORT ". c
i to s(failocp),102,'-')
newline
print ist(failocp)
if com_nocps = 2 start ; !MULTI OCP
newlines(5)
heading("INTERRUPT STEERING TABLE FOR OCP ON PORT ". c
i to s(failocp!!1),102,'-')
newline
! Note: IST is in a global segment - no need to reset LST variables.
print ist(failocp!!1)
finish
newpage
heading("PROCESS TABLE",86,'-')
newline
print process table(com_procaad,com_max procs)
newpage
heading("MAIN LOG",116,'-')
newline
print text(seg10_out ptr,seg10_in ptr,seg10_ c
buff last byte)
newpage
if failing pc # 0 start
heading("CODE AROUND FAILING PC X". c
h to s(failing pc,8),55,'-')
newline
ncode(failing pc-128,failing pc+128,failing pc-128)
newpage
finish
!PRINT LOCAL CONTROLLER STACK
heading("LOCAL CONTROLLER STACK (OCP ON PORT ".itos(failocp). c
")",128,'-')
heading("PROCESS NO. ".itos(lst(failocp)_procno),128,'-') if c
lst(failocp)_procno #0
newline
dump seg(0,segment size); ! Stack segment is at virtual address 0.
newpage
!NOW PRINT LOCAL CONTROLLER SSN+1
heading("LOCAL CONTROLLER SSN+1 (OCP ON PORT ".itos(failocp). c
")",128,'-')
heading("PROCESS NO. ".itos(lst(failocp)_procno),128,'-') if c
lst(failocp)_procno #0
newline
dump seg(1<<18,segment size); ! SSN+1 is second segment in local segment table.
newpage
if com_nocps=2 start
setlst(failocp!!1)
heading("LOCAL CONTROLLER STACK (OCP ON PORT ".itos(failocp!!1). c
")",128,'-')
heading("PROCESS NO. ".itos(lst(failocp!!1)_procno),128,'-') if c
lst(failocp!!1)_procno #0
newline
dump seg(0,segment size); ! Stack segment is at virtual address 0.
newpage
!NOW PRINT LOCAL CONTROLLER SSN+1
heading("LOCAL CONTROLLER SSN+1 (OCP ON PORT ".itos(failocp!!1). c
")",128,'-')
heading("PROCESS NO. ".itos(lst(failocp!!1)_procno),128,'-') if c
lst(failocp!!1)_procno #0
newline
dump seg(1<<18,segment size); ! SSN+1 is second segment in local segment table.
newpage
setlst(failocp)
finish
i = integer(addr(seg10_parm)+4)
j=integer(contiguous address(real address(i+8)))-1
j=64 if j<64
k=com_asyncdest+com_max procs
k=64 if k<64
print queues(j,i,integer(addr(seg10_sa)+4),k,seg10_parm asl,
seg10_kq,seg10_rq1,seg10_rq2,com_elaphead,com_commsreca)
newpage
if amtab="YES" or amtab="FULL" start
heading("ACTIVE MEMORY TABLE",132,'-')
newline
print active memory table(public!amta seg<<18,
segment length(public!amta seg<<18),public! c
amtdd seg<<18,segment length(public!amtdd seg<<18))
newpage
finish
finish ; ! OF DUMP ANAL SECTION.
if stk = "Y" or stk = "YES" start
heading("INITIAL GLOBAL CONTROLLER STACK",128,'-')
newline
dump seg(public!initial global stack seg<<18,
segment size)
newpage
heading("INITIAL GLOBAL CONTROLLER SSN+1",128,'-')
newline
dump seg(public!(initial global stack seg+1)<<18,
segment size)
newpage
heading("GLOBAL CONTROLLER STACK FOR OCP ON PORT ". c
itos(com_ocpport0),128,'-')
newline
dump seg(public!stack seg for port(com_ocpport0)<<18,
segment size)
newpage
heading("GLOBAL CONTROLLER SSN+1 FOR OCP ON PORT ". c
i to s(com_ocpport0),128,'-')
newline
dump seg(public!(stack seg for port(com_ocpport0)+1)<<18,
segment size)
newpage
if com_nocps = 2 start ; !MULTI OCP
heading("GLOBAL CONTROLLER STACK FOR OCP ON PORT ". c
itos(com_ocpport1),128,'-')
newline
dump seg(public!stack seg for port(com_ocpport1)<<18,
segment size)
newpage
heading("GLOBAL CONTROLLER SSN+1 FOR OCP ON PORT ". c
i to s(com_ocpport1),128,'-')
newline
dump seg(public!(stack seg for port(com_ocpport1)+1)<<18,
segment size)
newpage
finish
finish ; ! STACKS
if gla = "Y" or gla = "YES" start
heading("GLOBAL CONTROLLER GLA",128,'-')
newline
dump seg(public!global gla seg<<18,segment size)
newpage
finish
if carea = "Y" or carea = "YES" start
heading("COMMUNICATIONS AREAS",128,'-')
newline
for i = public!comms area start<<18,1<<18,public! c
comms area end<<18 cycle
dump seg(i,segment size)
repeat
newpage
finish
if n segs > 0 start
heading("REQUESTED AREAS",128,'-')
newline
i = 0
while i < n segs cycle
i = i+1
if com_nocps=2 start
printstring(snl.snl."OCP ON PORT ".itos(dump segs(i)_ocp))
finish
setlst(dump segs(i)_ocp)
dump seg(dump segs(i)_addr,dump segs(i)_length)
repeat
finish
newpage
if substring(outfile,1,3) = ".LP" start
old delivery = uinfs(2); !GET CURRENT DELIVERY
length(delivery) = 31 if length(delivery) > 31
!TRIM IF TOO BIG
deliver(delivery)
finish
select output(0)
close stream(1); !OUTPUT FILE
deliver(old delivery) if substring(outfile,1,3) = ".LP"; !RESET DELIVERY
finish else print mess(flag); !FAILED TO CONNECT DUMPFILE
end ; !OF ROUTINE PRINT DUMP
externalroutine read dump(string (63) tape)
!**********************************************************************
!* READS AN EMAS 2900 STORE DUMP INTO A FILE AND CALLS THE PRINT DUMP *
!* *
!* *
!**********************************************************************
record (fhf)name file header
string (23) file, out
integer conad, flag, page, max file size, file increment
if tape-> tape.(",").file start
if file-> file.(",").out start
file = "DUMPFILE" if file=""
finish else out = ".LP"
finish else file = "DUMPFILE" and out = ".LP"
if 1 <= length(tape) <= 6 start ; !CHECK TAPE NAME
destroy(file,flag)
max file size = 1024*epage size*2 + (1024*1024)*12; ! 1 EPAGE (FOR HEADER) + 12 MBYTE + 1 EPAGE
outfile(file,1024*1024+1024*epage size,max file size,0,conad,flag)
!CREATE A 1 MEG + 1 EPAGE FILE IN A 12 MEG + 2 EPAGE GAP
file increment = 1024*256 - 1024*epage size
! FIRST FILE INCREMENT - 1 EPAGE LESS THAN 1/4 MBYTE
if flag = 0 start ; !FILE CREATED OK
open tape(1,3,5,tape,flag); !OPEN TAPE 1 READ, LEVEL5 RECOVERY
if flag = 0 start
file header == record(conad)
file header_end = 1024*e page size
file header_start = 1024*e page size
file header_tape = tape
conad = conad+1024*e page size
page = 0
cycle
page = page+1
read page(1,1,conad,flag); !READ PAGE TAPE 1, CHAPTER 1
if flag # 0 start
print string("READ PAGE ".i to s(page). c
" FAILS ".i to s(flag).snl) if flag # eot
exit if flag = eot or flag = request reject or flag = -1
{ -1 = address validation fails }
fill(1024*e page size,conad,0)
!ZERO PAGE
print string("PAGE ".i to s(page). c
" FILLED WITH ZEROS".snl)
finish
file header_end = file header_end+1024*epage size
if file header_end = file header_size start
file header_size = file header_size+file increment
file increment = 1024*256; ! 1/4 MBYTE (APART FROM FIRST TIME)
change file size(file,file header_size,flag)
if flag # 0 start
print mess(flag)
exit
finish
finish
conad = conad+1024*epage size
repeat
page = page-1
print string(i to s(page)." ".i to s(e page size) c
."K BLOCKS READ FROM ".tape.snl)
close tape(1,flag)
print string("CLOSE ".tape." FAILS ".i to s(flag). c
snl) if flag # 0
file header_size = (file header_end+1024* c
epage size-1)&(-1024*epage size)
change file size(file,file header_end,flag)
print mess(flag) if flag # 0
disconnect(file,flag)
print mess(flag) if flag # 0
print dump(file.",".out)
finish else start
print string("OPEN ".tape." FAILS ".i to s(flag). c
snl)
destroy(file,flag)
print mess(flag) if flag # 0
finish
finish else print mess(flag)
finish else print string(tape." NOT A VALID TAPE NAME". c
snl)
end ; !OF ROUTINE READDUMP
endoffile