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