!------HDR------- 17 DEC 79 --------------------------------------------
! offset of LH entry:
RECORDFORMAT HDRF(STRING (6) OWNER, BYTEINTEGER C
FLAG,SECTSI,ALNK,USE,IMARK, C 07
IUSE,BUSE,ISESSM,SURNAME, C 0C
IMAX,TMAX,BMAX,STKKB, C 10
INTEGER LNKSTART,CELSTART,FREEBYTES,TRYING, C 14
NAMSTART,NEXNAM,LOFDAD,TOP, C 24
DWSP,BWSP,SEMA,MSGSEMA, C 34
SEMANO,IINSTRS,BINSTRS,NKBOUT, C 44
DINSTRS,IPTRNS,BPTRNS,NKBIN, C 54
IMSECS,BMSECS,CHKSUM,ASEMA, C 64
BYTEINTEGER CODES,SIGMON,DEPTH,CONCURR, C 74
ACR,DIRVSN,MSGSPRIV,BATCHSS, C 78
BASEF,DELY,STARTF,ADRTELE, C 7C
LOGFILE,SPECIALSS,SPFF1,GPHOLDR, C 80
INTEGER USED AFDS,AFILES,AKB,USED FDS, C 84
FILES,TOTKB,ATOP,SPA0 ,DATE, C 94
MAXFILE,MAXKB,DIRMON, C A8
CHERFILES,CHERKB,CONNECTT,ARESTORES, C B4
ZASL,ZFREEC,ZNCELLS,TEMPKB, C C4
FILES0,FILES1,FILES2,FILES3, C D4
BNUTS,INUTS,XLNKST,XCELST, C E4
XTOP,XNAMST,ISTOP) F4
!
!------ENDHDR-----------------------------------------------------------
RECORDFORMAT FLF(INTEGER PGSNAM, BYTEINTEGER POOL, C
CODES2,CODES,ALNK,PLNK,ARCH,OWNP,CCT,EEP,SSBYTE,USE,SP15)
OWNBYTEINTEGERARRAYFORMAT LINKF(0:254)
OWNBYTEINTEGERARRAYFORMAT BAF(0:3)
OWNINTEGERARRAYFORMAT CELLF(0:254)
SYSTEMROUTINESPEC FILL(INTEGER START,LENGTH,PATTERN)
SYSTEMROUTINESPEC MOVE(INTEGER LEN,FROM,TO)
EXTERNALINTEGERFNSPEC DINDEX(STRING (6) USER, C
INTEGER FSYS,BITADDR,INDAD, INTEGERNAME LOPAGE,HIPAGE)
EXTERNALROUTINESPEC PROMPT(STRING (15) S)
EXTERNALROUTINESPEC DEFINE(STRING (255) S)
EXTERNALROUTINESPEC CLEAR(STRING (255) S)
OWNINTEGERARRAY BITMAP(0:8191)
OWNINTEGERARRAY INDEX(0:8191)
OWNINTEGERARRAY LASTLINE(0:7)
OWNINTEGERARRAY SECTCELLS(1:255)
OWNINTEGERARRAY LINKCOUNT(0:3)
OWNINTEGERARRAY MAP(0:31)
OWNINTEGERARRAY PERMCELLS(1:255)
CONSTSTRING (12)ARRAY SARCHIVE(-1:7)="ARCH "," WR CONN", C
" BACKUP"," CONN"," ARCH3"," ARCH4"," ARCH5"," ARCH6"," ARCHIVE"
CONSTSTRING (12)ARRAY SCODES(-1:7)="CODES "," UNAVA"," OFFER", C
" TEMPF"," VTEMP"," CHERS"," PRIVAT"," VIOLAT"," ARCH INHIB"
CONSTSTRING (12)ARRAY SCODES2(-1:7)="CODES2 "," WR CONN", C
" NEWGEN", " OLDGEN"," WS ALLOW"," COMMS MODE"," DISC ONLY", C
" STACK"," DEAD"
CONSTSTRING (51) MINUS= C
"---------------------------------------------------"
CONSTINTEGER TRUE=1
CONSTINTEGER FALSE=0
EXTERNALROUTINE PROBEINDEX(STRING (255) S)
ROUTINESPEC PRINTHEX(INTEGER NO,WIDTH)
ROUTINESPEC PRINTBIN(INTEGER NO,PL)
ROUTINESPEC TRACECHAIN(INTEGER LISTPOOL,PLINK,FILLCELLS, C
INTEGERARRAYNAME CELLS, INTEGERNAME CELLCOUNT)
ROUTINESPEC CHECKLINK(INTEGER POOL,PLINK,INTEGERNAME FLAG)
ROUTINESPEC DUMPBITMAP(INTEGER TYPE)
ROUTINESPEC TRACEBACK(INTEGER PLINK)
ROUTINESPEC OUTPERM(INTEGER I)
ROUTINESPEC CHECKBITMAP
ROUTINESPEC POOLLINK(INTEGER ROGUE,WORD,TYPE, INTEGERNAME FLAG)
ROUTINESPEC OUTBYTE(STRINGARRAYNAME NAMES, BYTEINTEGER BYTE)
ROUTINESPEC PRINTCHAIN(STRING (31) S, BYTEINTEGER PLINK, C
INTEGER PRINTREGARDLESS)
ROUTINESPEC ASK(STRING (15) TEXT,STRINGNAME T)
STRINGFNSPEC S2(INTEGER N)
STRINGFNSPEC PRINTDATE(INTEGER P)
RECORDNAME H(HDRF)
RECORDNAME FDESC(FLF)
BYTEINTEGERARRAYNAME LARR,TOTA,TOTB,FREEA,FREEB,WARN
INTEGERARRAYNAME CARR
INTEGER CUR,LOFDAD,SECTSI,NAMSTART,TOP,USEDFDS,NEXNAM,NAMOFF
INTEGER ADDRNAM,FILENO,CONFIDENT,CFLAG,BADNAME
INTEGER FLAG,INDAD,I,J,FLEN,SCOUNT,ACOUNT,FDPAGES,ONOFFER
INTEGER HIPAGE,LOPAGE,ADDR2,ACOUNT2,POOL,CELLCOUNT,DEAD
INTEGER TOTCELLSA,TOTFREEB,WARNING,GRANDTOT,CELSTART,PLFLAG,LNKSTART
INTEGER FATAL,ANYTHING,K,BAD
INTEGER LINESOFOUTPUT,II
INTEGER ZEROES,SAME,SUPPRESSPRINT
INTEGER GOOD1,GOOD3,CORRUPTDESCRIPTOR,DEADFILES,TOTALKB
INTEGER NCHERISHED,CHERISHEDKB,TEMPKBUSED
INTEGER FSYS,BITADDR
INTEGERARRAY TOTC,TOTD(0:3)
BYTEINTEGER LEN,CH
STRING (15) USER
STRING (11) OUTDEV,FILENAME
CONSTINTEGER FDSIZE=16
CONSTSTRING (31) COLONS="::::::::::::::::::::::::::::::
"
! ZERO ARRAYS AND INITIALISE VARS
ZEROES=FALSE
SAME=FALSE
SUPPRESSPRINT=FALSE
INDAD=ADDR(INDEX(0))
BITADDR=ADDR(BITMAP(0))
H==RECORD(INDAD)
FILL(32,ADDR(LASTLINE(0)),X'0F')
! UNLIKELY EVER TO OCCUR AS FIRST LINE OF INDEX
FILL(X'8000',INDAD,X'00')
FILL(16,ADDR(LINKCOUNT(0)),X'00')
FILL(128,ADDR(MAP(0)),X'00')
ASK("USER:",USER)
NEWLINE
PROMPT("FSYS:")
READ(FSYS)
SKIPSYMBOL
ASK("OUTPUT TO:",OUTDEV)
DEFINE("11,".OUTDEV.",500")
SELECTOUTPUT(11)
FLAG=DINDEX(USER,FSYS,BITADDR,INDAD,LOPAGE,HIPAGE)
IF FLAG#0 THEN START
SELECTOUTPUT(0)
CLEAR("11")
PRINTSTRING("** DINDEX FAILED ")
WRITE(FLAG,3)
NEWLINE
PRINTSTRING("** FATAL ERROR
**PROBEINDEX TERMINATES")
RETURN
FINISH
PRINTSTRING("****************************")
NEWLINE
PRINTSTRING("* PROBEINDEX VERSION 3.04 *")
NEWLINE
PRINTSTRING("****************************")
NEWLINES(2)
PRINTSTRING("0. FILE INDEX DUMP")
NEWLINE
PRINTSTRING(" ---- ----- ----")
NEWLINES(2)
LINESOFOUTPUT=(H_TOP+31)>>5-1
! MAXLINES OF OP DUMP, 32 BYTES/LINE, 0-LINESOFOUTPUT
CYCLE I=0,1,LINESOFOUTPUT
II=I<<3
SUPPRESSPRINT=TRUE IF SAME=TRUE
SAME=TRUE IF SAME=FALSE
CYCLE J=0,1,7
SAME=FALSE AND EXIT IF LASTLINE(J)#INDEX(II+J)
REPEAT
IF SAME=TRUE THEN START
ZEROES=TRUE IF LASTLINE(0)=0
FINISH ELSE START
ZEROES=FALSE IF ZEROES=TRUE
SUPPRESSPRINT=FALSE IF SUPPRESSPRINT=TRUE
FINISH
UNLESS SUPPRESSPRINT=TRUE THEN START
! PRINT RELATIVE ADDRESS
PRINTSTRING("(")
PRINTHEX(I<<5,8)
PRINTSTRING(") ")
IF SAME=TRUE THEN START
IF ZEROES=TRUE THEN PRINTSTRING("ZEROES") ELSE PRINTSTRING("SAME")
FINISH ELSE START
! PRINT HEX
CYCLE J=0,1,7
PRINTHEX(INDEX(II+J),8)
SPACES(2)
REPEAT
! PRINT CHAR REPRESENTATION
CYCLE J=0,1,31
CH=BYTEINTEGER(ADDR(INDEX(II))+J)
IF 32<=CH<=122 THEN PRINTSYMBOL(CH) ELSE PRINTSYMBOL(32)
REPEAT
FINISH
NEWLINE
FINISH
MOVE(32,ADDR(INDEX(II)),ADDR(LASTLINE(0)))
REPEAT
DEAD=FALSE; ! TO ENSURE CHECKLINK LOGS ANY LINKS USED BY LISTHEADS
BAD=FALSE
FATAL=FALSE
NEWLINES(2)
PRINTSTRING("1. FILE INDEX HEADER")
NEWLINE
PRINTSTRING(" ---- ----- ------")
NEWLINE
UNLESS H_TOP=X'800' OR (X'1000'<=H_TOP<=X'8000' AND C
H_TOP<<21=0 ) THEN START
PRINTSTRING("** CORRUPT INDEX SIZE ")
PRINTHEX(H_TOP,8)
NEWLINE
SELECTOUTPUT(0)
CLEAR("11")
PRINTSTRING("** CORRUPT INDEX SIZE
** FATAL ERROR
** PROBEINDEX TERMINATES")
RETURN
FINISH
! NEED SELF CONSISTENT VALUES OF LNKSTART,CELSTART AND
! NAMSTART TO GO ON. THESE ARE RELATED BY THE EQUATION
! (CELSTART-LNKSTART)<<2=NAMSTART-CELSTART
! SINCE THERE IS 1 BYTE LINK FOR EACH CELL WORD.
! SHOULD THIS NOT BE SATISFIED THEN LNKSTART CAN BE OBTAINED
! WITH 100% ACCURACY AS ADDR(H_ISTOP)-INDAD+4
! IF THIS IS ENOUGH THEN WELL AND GOOD. IF NOT THEN
! TOTAL CELLS CAN BE CALCULATED FROM SUMMING THE BYTE INTEGER
! COMPONENTS OF H_ZNCELLS (+1 FOR EACH X'FF' VALUE).
! THIS GRANDTOTAL CAN THEN BE ADDED TO LNKSTART TO CALCULATE
! BOTH CELSTART AND NAMSTART AND WILL OF COURSE SATISFY THE
! EQUATION. IF EITHER CELSTART OR NAMSTART AGREE WITH CALC. VALUES
! THEN ALL IS WELL. ANY PROBLEM WOULD ARISE IF EITHER OR BOTH
! CELSTART AND NAMSTART WERE CORRUPT AND ZNCELLS ALSO.
! IN THIS CASE THE SELF CONSISTENT VALUES WOULD BE WRONG.
! AS A CHECK LOOK AT THE BYTEINTEGER AT INDAD+NAMSTART+
! BYTEINTEGER(INDAD+NAMSTART)+1. THIS SHOULD BE FILENO FOR THE
! FIRST FILE. I.E. 0. IF NOT THEN PROBABLY INCORRECTLY ALIGNED
! ON THE INDEX SO GIVE UP.
LNKSTART=H_LNKSTART
CELSTART=H_CELSTART
NAMSTART=H_NAMSTART
FATAL=FALSE
IF H_TOP=X'800' THEN START
! THIS CODE TEMPORARY TO CIRCUMVENT THE 2K INDEX PROBLEM
! WHILE I THINK OF A BETTER WAY TO DO THINGS IN THIS SECTION.
LNKSTART=ADDR(H_ISTOP)-INDAD+4
! ALWAYS TRUE
IF LNKSTART#H_LNKSTART THEN C
PRINTSTRING("** LNKSTART CORRUPT - PROBEINDEX ASSIGNS NEW VALUE
")
! CALCULATE EXPECTED VALUES OF CELSTART AND NAMSTART FROM ZNCELLS
GRANDTOT=0
CYCLE I=0,1,3
ANYTHING=BYTEINTEGER(ADDR(H_ZNCELLS)+I)
GRANDTOT=GRANDTOT+ANYTHING
GRANDTOT=GRANDTOT+1 IF ANYTHING=X'FF'
REPEAT
ANYTHING=(GRANDTOT+3)&(¬3)
CELSTART=LNKSTART+ANYTHING
ANYTHING=(GRANDTOT*5+3)&(¬3)
NAMSTART=LNKSTART+(ANYTHING+15)&(¬15)
PRINTSTRING("CURRENT CALCULATED VALUES ARE:
<LNKSTART>: ")
PRINTHEX(LNKSTART,8)
NEWLINE
PRINTSTRING("<CELSTART>: ")
PRINTHEX(CELSTART,8)
NEWLINE
PRINTSTRING("<NAMSTART>: ")
PRINTHEX(NAMSTART,8)
NEWLINE
IF CELSTART#H_CELSTART OR NAMSTART#H_NAMSTART THEN START
PRINTSTRING("** INCONSISTENT VALUES OF CELSTART/NAMSTART/ZNCELLS
** CORRUPTION INDICATED
")
FATAL=TRUE
FINISH ELSE PRINTSTRING( C
"++ LNKSTART,CELSTART AND NAMSTART ARE SELF CONSISTENT")
NEWLINES(2)
FINISH ELSE START
UNLESS (CELSTART-LNKSTART)<<2=NAMSTART-CELSTART AND LNKSTART#0 C
THEN START
PRINTSTRING("** INCONSISTENT VALUES OF LNKSTART,CELSTART AND NAMSTART
** ATTEMPTING RECOVERY
")
LNKSTART=ADDR(H_ISTOP)-INDAD+4
! ALWAYS TRUE
IF LNKSTART#H_LNKSTART THEN C
PRINTSTRING("** LNKSTART CORRUPT - PROBEINDEX ASSIGNS NEW VALUE
")
IF (CELSTART-LNKSTART)<<2=NAMSTART-CELSTART THEN C
PRINTSTRING("++ RECOVERY SUCCESSFUL - PROBEINDEX CONTINUES
") ELSE START
! CALCULATE EXPECTED VALUES OF CELSTART AND NAMSTART FROM ZNCELLS
GRANDTOT=0
CYCLE I=0,1,3
ANYTHING=BYTEINTEGER(ADDR(H_ZNCELLS)+I)
GRANDTOT=GRANDTOT+ANYTHING
GRANDTOT=GRANDTOT+1 IF ANYTHING=X'FF'
REPEAT
CELSTART=LNKSTART+GRANDTOT
IF CELSTART#H_CELSTART THEN C
PRINTSTRING("** CELSTART CORRUPT - PROBEINDEX ASSIGNS NEW VALUE
")
NAMSTART=CELSTART+GRANDTOT<<2
IF NAMSTART#H_NAMSTART THEN C
PRINTSTRING("** NAMSTART CORRUPT - PROBEINDEX ASSIGNS NEW VALUE
")
PRINTSTRING("CURRENT VALUES ARE:
<LNKSTART>: ")
PRINTHEX(LNKSTART,8)
NEWLINE
PRINTSTRING("<CELSTART>: ")
PRINTHEX(CELSTART,8)
NEWLINE
PRINTSTRING("<NAMSTART>: ")
PRINTHEX(NAMSTART,8)
NEWLINE
IF CELSTART#H_CELSTART AND NAMSTART#H_NAMSTART THEN START
! CHECK ALIGNMENT ON INDEX
IF BYTEINTEGER(INDAD+NAMSTART+BYTEINTEGER(INDAD+NAMSTART)+1)#0 C
THEN FATAL=TRUE AND PRINTSTRING( C
"** NEW CALCULATED VALUES NOT CONSISTENT WITH INDEX CONTENTS
** RECOVERY FAILS
")
FINISH
IF FATAL=FALSE THEN PRINTSTRING("++ RECOVERY SUCCESSFUL
")
FINISH
FINISH ELSE PRINTSTRING( C
"++ LNKSTART,CELSTART AND NAMSTART ARE SELF CONSISTENT")
NEWLINES(2)
FINISH
IF FATAL=TRUE THEN START
PRINTSTRING("** PROBEINDEX TERMINATES")
SELECTOUTPUT(0)
CLEAR("11")
PRINTSTRING("** FATAL ERROR DETECTED
** INCONSISTENT LNKSTART,CELSTART AND NAMSTART
** PROBEINDEX TERMINATES")
RETURN
FINISH
LNKSTART=LNKSTART+INDAD
CELSTART=CELSTART+INDAD
NAMSTART=NAMSTART+INDAD
SPACES(78)
PRINTSTRING("OFFSET IN HEADER (HEX)
")
! CHECK FOR SENSIBLE USERNAME
! LENGTH BYTE
UNLESS BYTEINTEGER(INDAD)=6 THEN START
PRINTSTRING("** CORRUPT INDEX - LENGTH OF OWNER STRING IS ")
WRITE(BYTEINTEGER(INDAD),5)
NEWLINE
BAD=TRUE
FINISH
! NOW CHECK THAT USERNAME CONTAINS VALID CHARS
CYCLE I=1,1,6
CH=BYTEINTEGER(INDAD+I)
UNLESS 'A'<=CH<='Z' OR '0'<=CH<='9' THEN START
PRINTSTRING("** CORRUPT INDEX - ILLEGAL CHARACTER ")
PRINTHEX(CH,1)
PRINTSTRING(" IN USERNAME")
NEWLINE
BAD=TRUE IF BAD=FALSE
FINISH
REPEAT
PRINTSTRING("INDEX OWNER <OWNER>: ")
IF BAD=FALSE THEN PRINTSTRING(H_OWNER) ELSE C
PRINTHEX(INTEGER(INDAD),8) AND PRINTHEX(INTEGER(INDAD+4),8)
IF BAD=FALSE THEN SPACES(39) ELSE SPACES(29)
PRINTSTRING("0000")
NEWLINE
BAD=FALSE
PRINTSTRING("PROCESS LAST USED <DATE>: ")
PRINTSTRING(PRINTDATE(H_DATE))
SPACES(37)
PRINTHEX(ADDR(H_DATE)-INDAD,4)
NEWLINE
PRINTCHAIN("OWNER IS",H_SURNAME,TRUE)
PRINTCHAIN("DELIVERY INFO",H_DELY,TRUE)
PRINTCHAIN("ADDRESS/TELE NO",H_ADRTELE,FALSE)
PRINTCHAIN("GROUP HOLDER",H_GPHOLDR,FALSE)
PRINTCHAIN("WHOLE INDEX PERMISSIONS",H_ALNK,FALSE)
PRINTCHAIN("INTERACTIVE BASEFILE",H_BASEF,FALSE)
PRINTCHAIN("BATCH BASEFILE",H_BATCHSS,FALSE)
PRINTCHAIN("TEST SUBSYSTEM",H_SPECIALSS,FALSE)
PRINTCHAIN("DIR. PROC. MONITOR FILE",H_LOGFILE,FALSE)
PRINTCHAIN("STARTFILE",H_STARTF,FALSE)
! TEMP** PRINTCHAIN("SPARE LISTHEAD",H_SPFF1,FALSE)
PRINTSTRING("DIRECTOR VERSION <DIRVSN>: ")
WRITE(H_DIRVSN,4)
PRINTSTRING(" (255 = DEFAULT)")
SPACES(22)
PRINTHEX(ADDR(H_DIRVSN)-INDAD,4)
NEWLINE
! ABCDEFG
! NOW CHECK INDEX SIZE
! SHOULD BE 2K OR 4K<=SIZE<=32K : MUST BE MULTIPLE OF 1K
PRINTSTRING("INDEX SIZE <TOP>: ")
WRITE(H_TOP>>10,2)
PRINTSTRING(" K")
SPACES(40)
PRINTHEX(ADDR(H_TOP)-INDAD,4)
NEWLINE
PRINTSTRING(COLONS)
!******************************************
NEWLINES(2)
PRINTSTRING("PROCESS LIMIT INFORMATION
------- ----- -----------")
NEWLINE
PRINTSTRING("PROCESS ACR <ACR>: ")
WRITE(H_ACR,3)
PRINTSTRING(" (0 = DEFAULT)")
SPACES(20)
PRINTHEX(ADDR(H_ACR)-INDAD,4)
NEWLINE
PRINTSTRING("SECTION SIZE <SECTSI>: ")
WRITE(H_SECTSI,4)
SPACES(37)
PRINTHEX(ADDR(H_SECTSI)-INDAD,4)
NEWLINE
PRINTSTRING("PROCESSOR STACK (K) <STKKB>: ")
WRITE(H_STKKB,4)
PRINTSTRING(" (0 = DEFAULT)")
SPACES(20)
PRINTHEX(ADDR(H_STKKB)-INDAD,4)
NEWLINE
PRINTSTRING("ARCHIVE INDEX SIZE (BYTES) <ATOP>: ")
WRITE(H_ATOP,11)
SPACES(37)
PRINTHEX(ADDR(H_ATOP)-INDAD,4)
NEWLINE
PRINTSTRING("MAX FILE SIZE (K) <MAXFILE>: ")
WRITE(H_MAXFILE,11)
PRINTSTRING(" (0 = DEFAULT)")
SPACES(20)
PRINTHEX(ADDR(H_MAXFILE)-INDAD,4)
NEWLINE
PRINTSTRING("MAX FILE SPACE (K) <MAXKB>: ")
WRITE(H_MAXKB,11)
SPACES(37)
PRINTHEX(ADDR(H_MAXKB)-INDAD,4)
NEWLINE
PRINTSTRING("INTERACTIVE NUTS ASSIGNED <INUTS>: ")
WRITE(H_INUTS,11)
SPACES(37)
PRINTHEX(ADDR(H_INUTS)-INDAD,4)
NEWLINE
PRINTSTRING("BATCH NUTS ASSIGNED <BNUTS>: ")
WRITE(H_BNUTS,11)
SPACES(37)
PRINTHEX(ADDR(H_BNUTS)-INDAD,4)
NEWLINE
!******************************************
PRINTSTRING(COLONS)
NEWLINES(2)
PRINTSTRING("CURRENT STATUS OF FILES
------- ------ -- -----")
NEWLINE
PRINTSTRING("ON-LINE FILES <FILES>: ")
WRITE(H_FILES,11)
SPACES(28)
PRINTHEX(ADDR(H_FILES)-INDAD,4)
NEWLINE
PRINTSTRING("USED FILE DESCRIPTORS <USEDFDS>: ")
WRITE(H_USEDFDS,11)
SPACES(28)
PRINTHEX(ADDR(H_USEDFDS)-INDAD,4)
NEWLINE
PRINTSTRING("FREEBYTES IN INDEX <FREEBYTES>: ")
WRITE(H_FREEBYTES,11)
SPACES(28)
PRINTHEX(ADDR(H_FREEBYTES)-INDAD,4)
NEWLINE
PRINTSTRING("TOTAL KB <TOTKB>: ")
WRITE(H_TOTKB,11)
SPACES(28)
PRINTHEX(ADDR(H_TOTKB)-INDAD,4)
NEWLINE
PRINTSTRING("ARCHIVE FILES <AFILES>: ")
WRITE(H_AFILES,11)
SPACES(28)
PRINTHEX(ADDR(H_AFILES)-INDAD,4)
NEWLINE
PRINTSTRING("ARCHIVE INDEX FILE DESCRIPTORS <USEDAFDS>: ")
WRITE(H_USEDAFDS,11)
SPACES(28)
PRINTHEX(ADDR(H_USEDAFDS)-INDAD,4)
NEWLINE
PRINTSTRING("ARCHIVE INDEX E-PAGES <AKB>: ")
WRITE(H_AKB,11)
SPACES(28)
PRINTHEX(ADDR(H_AKB)-INDAD,4)
NEWLINE
PRINTSTRING("ON-LINE CHERISHED FILES <CHERFILES>: ")
WRITE(H_CHERFILES,11)
SPACES(28)
PRINTHEX(ADDR(H_CHERFILES)-INDAD,4)
NEWLINE
PRINTSTRING("KB CHERISHED FILES <CHERKB>: ")
WRITE(H_CHERKB,11)
SPACES(28)
PRINTHEX(ADDR(H_CHERKB)-INDAD,4)
NEWLINE
PRINTSTRING("ON-LINE TEMP FILESPACE USED (K) <TEMPKB>: ")
WRITE(H_TEMPKB,11)
SPACES(28)
PRINTHEX(ADDR(H_TEMPKB)-INDAD,4)
NEWLINE
PRINTSTRING("TYPE 0 ARCHIVE FILES <FILES0>: ")
WRITE(H_FILES0,11)
SPACES(28)
PRINTHEX(ADDR(H_FILES0)-INDAD,4)
NEWLINE
PRINTSTRING("TYPE 1 ARCHIVE FILES <FILES1>: ")
WRITE(H_FILES1,11)
SPACES(28)
PRINTHEX(ADDR(H_FILES1)-INDAD,4)
NEWLINE
PRINTSTRING("TYPE 2 ARCHIVE FILES <FILES2>: ")
WRITE(H_FILES2,11)
SPACES(28)
PRINTHEX(ADDR(H_FILES2)-INDAD,4)
NEWLINE
PRINTSTRING("TYPE 3 ARCHIVE FILES <FILES3>: ")
WRITE(H_FILES3,11)
SPACES(28)
PRINTHEX(ADDR(H_FILES3)-INDAD,4)
NEWLINE
PRINTSTRING(COLONS)
NEWLINES(2)
PRINTSTRING("CURRENT PROCESS ACTIVITY")
NEWLINE
PRINTSTRING("------- ------- --------")
NEWLINE
PRINTSTRING("CURR. ACTIVE PROCESSES")
NEWLINE
PRINTSTRING("INTERACTIVE <IUSE>: ")
WRITE(H_IUSE,4)
SPACES(41)
PRINTHEX(ADDR(H_IUSE)-INDAD,4)
NEWLINE
PRINTSTRING("BATCH <BUSE>: ")
WRITE(H_BUSE,4)
SPACES(41)
PRINTHEX(ADDR(H_BUSE)-INDAD,4)
NEWLINE
PRINTSTRING("CURRENT SESSION LENGTH (MIN) <ISESSM>: ")
WRITE(H_ISESSM,4)
PRINTSTRING(" (0 = DEFAULT)")
SPACES(26)
PRINTHEX(ADDR(H_ISESSM)-INDAD,4)
NEWLINE
PRINTSTRING("CONCURRENCY LIMITS (0 = SITE DEFAULT)")
NEWLINE
PRINTSTRING("INTERACTIVE <IMAX>: ")
WRITE(H_IMAX,4)
SPACES(41)
PRINTHEX(ADDR(H_IMAX)-INDAD,4)
NEWLINE
PRINTSTRING("BATCH <BMAX>: ")
WRITE(H_BMAX,4)
SPACES(41)
PRINTHEX(ADDR(H_BMAX)-INDAD,4)
NEWLINE
PRINTSTRING("TOTAL <TMAX>: ")
WRITE(H_TMAX,4)
SPACES(41)
PRINTHEX(ADDR(H_TMAX)-INDAD,4)
NEWLINE
PRINTSTRING(COLONS)
!************************************************
!**************************************************************
NEWLINES(2)
PRINTSTRING("MACHINE USAGE INFORMATION")
NEWLINE
PRINTSTRING("------- ----- -----------")
NEWLINE
PRINTSTRING("INTERACTIVE OCP TIME (MS) <IMSECS>: ")
WRITE(H_IMSECS,11)
SPACES(20)
PRINTHEX(ADDR(H_IMSECS)-INDAD,4)
NEWLINE
PRINTSTRING("BATCH OCP TIME (MS) <BMSECS>: ")
WRITE(H_BMSECS,11)
SPACES(20)
PRINTHEX(ADDR(H_BMSECS)-INDAD,4)
NEWLINE
PRINTSTRING("INTERACTIVE PAGETURNS <IPTRNS>: ")
WRITE(H_IPTRNS,11)
SPACES(20)
PRINTHEX(ADDR(H_IPTRNS)-INDAD,4)
NEWLINE
PRINTSTRING("BATCH PAGETURNS <BPTRNS>: ")
WRITE(H_BPTRNS,11)
SPACES(20)
PRINTHEX(ADDR(H_BPTRNS)-INDAD,4)
NEWLINE
PRINTSTRING("INTERACTIVE MACHINE INSTRUCTIONS (K) <IINSTRS>: ")
WRITE(H_IINSTRS,11)
SPACES(20)
PRINTHEX(ADDR(H_IINSTRS)-INDAD,4)
NEWLINE
PRINTSTRING("BATCH MACHINE INSTRUCTIONS (K) <BINSTRS>: ")
WRITE(H_BINSTRS,11)
SPACES(20)
PRINTHEX(ADDR(H_BINSTRS)-INDAD,4)
NEWLINE
PRINTSTRING("DIR. PROC. MACHINE INSTRUCTIONS (K) <DINSTRS>: ")
WRITE(H_DINSTRS,11)
SPACES(20)
PRINTHEX(ADDR(H_DINSTRS)-INDAD,4)
NEWLINE
PRINTSTRING("KBYTES SPOOLED IN <NKBIN>: ")
WRITE(H_NKBIN,11)
SPACES(20)
PRINTHEX(ADDR(H_NKBIN)-INDAD,4)
NEWLINE
PRINTSTRING("KBYTES SPOOLED OUT <NKBOUT>: ")
WRITE(H_NKBOUT,11)
SPACES(20)
PRINTHEX(ADDR(H_NKBOUT)-INDAD,4)
NEWLINE
PRINTSTRING("CUMULATIVE CONNECT TIME (S) <CONNECTT>: ")
WRITE(H_CONNECTT,12)
SPACES(20)
PRINTHEX(ADDR(H_CONNECTT)-INDAD,4)
NEWLINE
PRINTSTRING("CUMULATIVE FILES RESTORED FROM ARCHIVE <ARESTORES>: ")
WRITE(H_ARESTORES,12)
SPACES(20)
PRINTHEX(ADDR(H_ARESTORES)-INDAD,4)
NEWLINE
!************************************************************
PRINTSTRING(COLONS)
NEWLINES(2)
PRINTSTRING("LISTPOOL INFORMATION")
NEWLINE
PRINTSTRING("-------- -----------")
NEWLINE
PRINTSTRING("LISTPOOL 0 1 2 3")
NEWLINE
PRINTSTRING("TOTAL CELLS <ZNCELLS> ")
CYCLE I=0,1,3
WRITE(BYTEINTEGER(ADDR(H_ZNCELLS)+I),4)
REPEAT
SPACES(41)
PRINTHEX(ADDR(H_ZNCELLS)-INDAD,4)
NEWLINE
PRINTSTRING("FREE CELLS <ZFREEC> ")
CYCLE I=0,1,3
WRITE(BYTEINTEGER(ADDR(H_ZFREEC)+I),4)
REPEAT
SPACES(41)
PRINTHEX(ADDR(H_ZFREEC)-INDAD,4)
NEWLINE
PRINTSTRING("NEXT FREE (HEX) <ZASL> ")
CYCLE I=0,1,3
SPACES(3)
PRINTHEX(BYTEINTEGER(ADDR(H_ZASL)+I),2)
REPEAT
SPACES(41)
PRINTHEX(ADDR(H_ZASL)-INDAD,4)
NEWLINE
PRINTSTRING(COLONS)
NEWLINES(2)
PRINTSTRING("LISTHEAD AND BYTE OFFSET INFORMATION (HEX)")
NEWLINE
PRINTSTRING("-------- --- ---- ------ -----------")
NEWLINE
PRINTSTRING("WHOLE INDEX PERMISSION CELLS <ALNK>: ")
PRINTHEX(H_ALNK,2)
SPACES(26)
PRINTHEX(ADDR(H_ALNK)-INDAD,4)
NEWLINE
PRINTSTRING("SURNAME LISTHEAD <SURNAME>: ")
PRINTHEX(H_SURNAME,2)
SPACES(26)
PRINTHEX(ADDR(H_SURNAME)-INDAD,4)
NEWLINE
PRINTSTRING("BYTE OFFSET OF LINKS FOR POOL 0 <LNKSTART>: ")
PRINTHEX(H_LNKSTART,8)
SPACES(26)
PRINTHEX(ADDR(H_LNKSTART)-INDAD,4)
NEWLINE
PRINTSTRING("BYTE OFFSET OF CELLS FOR POOL 0 <CELSTART>: ")
PRINTHEX(H_CELSTART,8)
SPACES(26)
PRINTHEX(ADDR(H_CELSTART)-INDAD,4)
NEWLINE
PRINTSTRING("BYTE OFFSET OF FILENAME STORAGE AREA <NAMSTART>: ")
PRINTHEX(H_NAMSTART,8)
SPACES(26)
PRINTHEX(ADDR(H_NAMSTART)-INDAD,4)
NEWLINE
PRINTSTRING("BYTE OFFSET OF NEXT FILENAME <NEXNAM>: ")
PRINTHEX(H_NEXNAM,8)
SPACES(26)
PRINTHEX(ADDR(H_NEXNAM)-INDAD,4)
NEWLINE
PRINTSTRING("BYTE OFFSET OF NEXT FREE DESC. <LOFDAD>: ")
PRINTHEX(H_LOFDAD,8)
SPACES(26)
PRINTHEX(ADDR(H_LOFDAD)-INDAD,4)
NEWLINE
PRINTSTRING("LIST POOL 0 LISTHEAD OF BASEFILE <BASEF>: ")
PRINTHEX(H_BASEF,2)
PRINTSTRING(" (NULL => FIXED SITE)")
SPACES(3)
PRINTHEX(ADDR(H_BASEF)-INDAD,4)
NEWLINE
PRINTSTRING("LIST POOL 0 LISTHEAD OF DELY INFO <DELY>: ")
PRINTHEX(H_DELY,2)
SPACES(26)
PRINTHEX(ADDR(H_DELY)-INDAD,4)
NEWLINE
PRINTSTRING("LIST POOL 0 LISTHEAD OF ADRTELE <ADRTELE>: ")
PRINTHEX(H_ADRTELE,2)
SPACES(26)
PRINTHEX(ADDR(H_ADRTELE)-INDAD,4)
NEWLINE
PRINTSTRING("LIST POOL 0 LISTHEAD DIR. PROC. MONITOR FILE <LOGFILE>: ")
PRINTHEX(H_LOGFILE,2)
SPACES(26)
PRINTHEX(ADDR(H_LOGFILE)-INDAD,4)
NEWLINE
PRINTSTRING("LIST POOL 0 LISTHEAD TEST SUBSYSTEM <SPECIALSS>: ")
PRINTHEX(H_SPECIALSS,2)
SPACES(26)
PRINTHEX(ADDR(H_SPECIALSS)-INDAD,4)
NEWLINE
PRINTSTRING("LIST POOL 0 LISTHEAD OF GROUP HOLDER <GPHOLDER>: ")
PRINTHEX(H_GPHOLDR,2)
SPACES(26)
PRINTHEX(ADDR(H_GPHOLDR)-INDAD,4)
NEWLINE
PRINTSTRING("LIST POOL 0 LISTHEAD OF BATCH BASEFILE <BATCHSS>: ")
PRINTHEX(H_BATCHSS,2)
SPACES(26)
PRINTHEX(ADDR(H_BATCHSS)-INDAD,4)
NEWLINE
PRINTSTRING("LIST POOL 0 LISTHEAD OF STARTFILE <STARTF>: ")
PRINTHEX(H_STARTF,2)
SPACES(26)
PRINTHEX(ADDR(H_STARTF)-INDAD,4)
NEWLINE
PRINTSTRING("LIST POOL 0 SPARE LISTHEAD <SPFF1>: ")
PRINTHEX(H_SPFF1,2)
PRINTSTRING(" (SHOULD BE FF)")
SPACES(9)
PRINTHEX(ADDR(H_SPFF1)-INDAD,4)
NEWLINE
PRINTSTRING(COLONS)
!*****************************************************
NEWLINES(2)
PRINTSTRING("SEMAPHORE VALUES AND CHECKSUMS")
NEWLINE
PRINTSTRING("--------- ------ --- ---------")
NEWLINE
PRINTSTRING("INDEX SEMAPHORE NUMBER <SEMANO>: ")
PRINTHEX(H_SEMANO,8)
SPACES(37)
PRINTHEX(ADDR(H_SEMANO)-INDAD,4)
NEWLINE
PRINTSTRING("INDEX SEMAPHORE WORD <SEMA>: ")
PRINTHEX(H_SEMA,8)
SPACES(37)
PRINTHEX(ADDR(H_SEMA)-INDAD,4)
NEWLINE
PRINTSTRING("MESSAGE FILE SEMAPHORE WORD <MSGSEMA>: ")
PRINTHEX(H_MSGSEMA,8)
SPACES(37)
PRINTHEX(ADDR(H_MSGSEMA)-INDAD,4)
NEWLINE
PRINTSTRING("ARCHIVE INDEX CHECKSUM <CHKSUM>: ")
PRINTHEX(H_CHKSUM,8)
SPACES(37)
PRINTHEX(ADDR(H_CHKSUM)-INDAD,4)
NEWLINE
PRINTSTRING("ARCHIVE INDEX SEMAPHORE WORD <ASEMA>: ")
PRINTHEX(H_ASEMA,8)
SPACES(37)
PRINTHEX(ADDR(H_ASEMA)-INDAD,4)
NEWLINE
PRINTSTRING(COLONS)
NEWLINES(2)
PRINTSTRING("DIRECTOR MONITOR INFO")
NEWLINE
PRINTSTRING("-------- ------- ----")
NEWLINE
PRINTSTRING("DIRECTOR CALL BIT MASK <DIRMON>: ")
PRINTHEX(H_DIRMON,8)
SPACES(44)
PRINTHEX(ADDR(H_DIRMON)-INDAD,4)
NEWLINE
PRINTSTRING("SIGNAL MONITORING LEVEL <SIGMON>: ")
WRITE(H_SIGMON,4)
SPACES(44)
PRINTHEX(ADDR(H_SIGMON)-INDAD,4)
NEWLINE
PRINTSTRING("MONITOR DEPTH <DEPTH>: ")
WRITE(H_DEPTH,4)
SPACES(44)
PRINTHEX(ADDR(H_DEPTH)-INDAD,4)
NEWLINE
PRINTSTRING(COLONS)
!********************************************
NEWLINES(2)
PRINTSTRING("BYTE OFFSET OF LINKS FOR POOL 0 <XLNKST>: ")
PRINTHEX(H_XLNKST,8)
PRINTSTRING(" ** NOT USED **")
SPACES(9)
PRINTHEX(ADDR(H_XLNKST)-INDAD,4)
NEWLINE
PRINTSTRING("BYTE OFFSET OF CELLS FOR POOL 0 <XCELST>: ")
PRINTHEX(H_XCELST,8)
PRINTSTRING(" ** NOT USED **")
SPACES(9)
PRINTHEX(ADDR(H_XCELST)-INDAD,4)
NEWLINE
PRINTSTRING("BYTE OFFSET OF FILENAME STORAGE AREA <XNAMST>: ")
PRINTHEX(H_XNAMST,8)
PRINTSTRING(" ** NOT USED **")
SPACES(9)
PRINTHEX(ADDR(H_XNAMST)-INDAD,4)
NEWLINE
PRINTSTRING("INDEX SIZE <XTOP>: ")
PRINTHEX(H_XTOP,8)
PRINTSTRING(" ** NOT USED **")
SPACES(9)
PRINTHEX(ADDR(H_XTOP)-INDAD,4)
NEWLINE
PRINTSTRING("FLAG <FLAG>: ")
SPACES(14)
PRINTHEX(H_FLAG,2)
PRINTSTRING(" ** NOT USED **")
SPACES(9)
PRINTHEX(ADDR(H_FLAG)-INDAD,4)
NEWLINE
PRINTSTRING("USE <USE>: ")
SPACES(14)
PRINTHEX(H_USE,2)
PRINTSTRING(" ** NOT USED **")
SPACES(9)
PRINTHEX(ADDR(H_USE)-INDAD,4)
NEWLINE
PRINTSTRING("IMARK <IMARK>: ")
SPACES(14)
PRINTHEX(H_IMARK,2)
PRINTSTRING(" ** NOT USED **")
SPACES(9)
PRINTHEX(ADDR(H_IMARK)-INDAD,4)
NEWLINE
PRINTSTRING("TRYING <TRYING>: ")
SPACES(14)
PRINTHEX(H_TRYING,8)
PRINTSTRING(" ** NOT USED **")
SPACES(9)
PRINTHEX(ADDR(H_TRYING)-INDAD,4)
NEWLINE
PRINTSTRING("CODES <CODES>: ")
SPACES(14)
PRINTHEX(H_CODES,2)
PRINTSTRING(" ** NOT USED **")
SPACES(9)
PRINTHEX(ADDR(H_CODES)-INDAD,4)
NEWLINE
PRINTSTRING("CONCURR <CONCURR>: ")
SPACES(14)
PRINTHEX(H_CONCURR,2)
PRINTSTRING(" ** NOT USED **")
SPACES(9)
PRINTHEX(ADDR(H_CONCURR)-INDAD,4)
NEWLINE
PRINTSTRING("MSGSPRIV <MSGSPRIV>: ")
SPACES(14)
PRINTHEX(H_MSGSPRIV,2)
PRINTSTRING(" ** NOT USED **")
SPACES(9)
PRINTHEX(ADDR(H_MSGSPRIV)-INDAD,4)
NEWLINE
PRINTSTRING("SPARE WORD <SPA0>: ")
SPACES(14)
PRINTHEX(H_SPA0,8)
PRINTSTRING(" ** NOT USED **")
SPACES(9)
PRINTHEX(ADDR(H_SPA0)-INDAD,4)
NEWLINE
PRINTSTRING("RECORD FORMAT END MARKER <ISTOP>: ")
SPACES(14)
PRINTHEX(H_ISTOP,8)
SPACES(26)
PRINTHEX(ADDR(H_ISTOP)-INDAD,4)
NEWLINE
PRINTSTRING(COLONS)
NEWLINES(2)
!******************************
IF H_LOFDAD-H_NEXNAM=H_FREEBYTES THEN C
PRINTSTRING("++ LOFDAD,NEXNAM AND FREEBYTES INTERNALLY CONSISTENT
") ELSE C
PRINTSTRING("** LOFDAD,NEXNAM AND FREEBYTES NOT CONSISTENT
")
!:::::::::::::::::::::::::::::::::::::::::
FILENO=0; ! FILE NUMBER
NEXNAM=0; ! CUMULATIVE POINTER TO START OF NEXT FILENAME RELATIVE
! TO NAMSTART - CALC FROM FILENAME AREA INFO
CONFIDENT=TRUE; ! DESCRIBES HOW ACCURATE PROGRAM JUDGES NEXNAM TO BE
! TRUE == O.K., FALSE == UNLIKELY TO BE CORRECT
DEAD=FALSE; ! I.E. ALIVE
NEWLINES(2)
PRINTSTRING("2. FILE INDEX FILEINFO")
NEWLINE
PRINTSTRING(" ---- ----- --------")
NEWLINES(2)
! DUMPBITMAP(0)
TOP=INDAD+H_TOP
SECTSI=H_SECTSI
USEDFDS=H_USEDFDS
LOFDAD=INDAD+H_LOFDAD
CUR=TOP-FDSIZE
! MUST GET RELIABLE LOFDAD IF PROGRAM TO GO ON
! THERE ARE THREE EQUATIONS LINKING LOFDAD ETC.
! LOFDAD-NEXNAM=FREEBYTES 1.
! TOP-LOFDAD=USEDFDS*FDSIZE 2.
! AND 1+2
! TOP-NEXNAM=FREEBYTES+USEDFDS*FDSIZE 3.
UNLESS 0<=TOP-LOFDAD=USEDFDS*FDSIZE THEN START
! 2. HAS NOT BEEN SATISFIED IF HERE
PRINTSTRING("** EITHER OR BOTH LOFDAD AND USEDFDS CORRUPT
** PROBEINDEX INVESTIGATING
")
IF H_LOFDAD-H_NEXNAM=H_FREEBYTES THEN GOOD1=TRUE ELSE GOOD1=FALSE
IF H_TOP-H_NEXNAM=H_FREEBYTES+USEDFDS*FDSIZE THEN GOOD3=TRUE C
ELSE GOOD3=FALSE
IF GOOD1=FALSE AND GOOD3=FALSE THEN FATAL=TRUE AND C
PRINTSTRING("** PROBEINDEX CANNOT RESOLVE -WIDESPREAD CORRUPTION
** INVOLVING LOFDAD,USEDFDS,NEXNAM AND FREEBYTES
")
IF GOOD1=TRUE AND GOOD3=TRUE THEN FATAL=TRUE AND C
PRINTSTRING("** PROGRAM ERROR OR INCREDIBLE COINCIDENCE
** SEND O/P TO C MCCALLUM ERCC KB
")
IF FATAL=FALSE THEN START
IF GOOD3=TRUE THEN START
! USEDFDS IS O.K.
PRINTSTRING("** LOFDAD CORRUPT - ATTEMPTING RECOVERY
")
! RECALCULATE
LOFDAD=H_TOP-USEDFDS*FDSIZE
UNLESS LOFDAD-H_NEXNAM=H_FREEBYTES THEN START
FATAL=TRUE
PRINTSTRING("** RECOVERY FAILS - WIDESPREAD CORRUPTION
** FATAL ERROR
** PROBEINDEX TERMINATES")
FINISH ELSE LOFDAD=LOFDAD+INDAD AND C
PRINTSTRING("++ RECOVERY SUCCEEDS - PROBEINDEX CONTINUES
")
FINISH ELSE PRINTSTRING("** USEDFDS CORRUPT
")
! I.E. LOFDAD O.K.
FINISH
IF FATAL=TRUE THEN START
SELECTOUTPUT(0)
CLEAR("11")
PRINTSTRING("** FATAL ERROR
** NO CONSISTENT LOFDAD OBTAINABLE
** PROBEINDEX TERMINATES")
RETURN
FINISH
FINISH
DEADFILES=0
TOTALKB=0
NCHERISHED=0
CHERISHEDKB=0
TEMPKBUSED=0
CORRUPTDESCRIPTOR=FALSE
FILENAME=""
PRINTSTRING("FILENO NAME POOL OWNP EEP CCT ARCH USE ")
PRINTSTRING("CODES CODES2 PGS PLNK SECTIONS SSBYTE SP15 ALNK ")
PRINTSTRING("OFFERS/PRMS")
NEWLINES(2)
PRINTSTRING(MINUS.MINUS)
NEWLINE
WHILE CUR>=LOFDAD CYCLE
! GO ROUND THE FILES
CFLAG=FALSE; ! CONTAINS VALUE OF CONFIDENT CALCULATED BY THIS CYCLE
FDESC==RECORD(CUR)
FDPAGES=FDESC_PGSNAM>>16
NAMOFF=FDESC_PGSNAM&X'FFFF'
! NAMOFF IS NAME OFFSET FROM NAMSTART AS GIVEN BY CURRENT DESCRIPTOR
! NAMOFF AND NEXNAM SHOULD AGREE
IF NAMOFF#NEXNAM THEN START
PRINTSTRING("** INCONSISTENCY IN LOCATION OF CURRENT NAME DETECTED")
NEWLINE
IF CONFIDENT=TRUE THEN START
ADDRNAM=NAMSTART+NEXNAM
PRINTSTRING("** CORRUPTION SUSPECTED IN DESCRIPTOR")
NEWLINE
CORRUPTDESCRIPTOR=TRUE IF CORRUPTDESCRIPTOR=FALSE
FINISH ELSE ADDRNAM=NAMSTART+NAMOFF
FINISH ELSE ADDRNAM=NAMSTART+NEXNAM
! TRY TO GET FILENAME
! ******
! THERE ARE THREE HOOKS IN THE FILENAME AREA
! 1. LENGTH BYTE OF CURRENT FILENAME (L)
! 2. CURRENT FILE NO L+1 BYTES FURTHER
! 3. NEXT LENGTH BYTE L+2 BYTES ON
! IF CAN FIND ANY TWO OF THESE PROGRAM CAN CALCULATE AN
! ACCURATE NEXNAM FOR THE NEXT FILE
! ******
! TEST LENGTH BYTE
LEN=BYTEINTEGER(ADDRNAM)
IF 0<LEN<=11 THEN START
! IN RANGE THOUGH NOT NECESSARILY CORRECT
IF BYTEINTEGER(ADDRNAM+LEN+1)=FILENO THEN START
! FOUND EXPECTED FILE NO
MOVE(LEN+1,ADDRNAM,ADDR(FILENAME))
CFLAG=TRUE
FINISH ELSE START
PRINTSTRING("** INCONSISTENCY IN CURRENT FILENAME - ". C
"ATTEMPTING DIAGNOSIS AND RECOVERY")
NEWLINE
FINISH
FINISH ELSE PRINTSTRING("** ERROR - LENGTH BYTE OF ". C
"FILENAME OUT OF RANGE - TRYING TO RECOVER")
NEWLINE
IF CFLAG=FALSE THEN START
! LOOK FOR FILENO+NEXT LENGTH BYTE PATTERN
ADDR2=ADDRNAM+12
! MAX EXTENT OF A FIELD
CYCLE I=ADDRNAM,1,ADDR2
J=I
IF BYTEINTEGER(I)=FILENO AND 0<BYTEINTEGER(I+1)<=11 THEN START
CFLAG=TRUE
EXIT
PRINTSTRING("** PROBEINDEX DIAGNOSES CORRUPT LENGTH BYTE IN FILENAME")
NEWLINE
FINISH
REPEAT
IF CFLAG=FALSE AND 0<LEN<=11 AND 0<BYTEINTEGER(ADDRNAM+LEN+2)<=11 C
THEN START
! IF LENGTH IN RANGE LOOK AT EXPECTED ADDR OF NEXT LENGTH BYTE
! IF THIS LOOKS O.K. THEN FILENO PROB CORRUPT
! OTHER CASE VIZ. LEN O.K., FILENO O.K., NEXTLEN BAD WOULD
! HAVE APPEARED NORMAL IN THIS CYCLE
CFLAG=TRUE
PRINTSTRING("** PROBEINDEX DIAGNOSES CORRUPT FILENO ON CURRENT FILE")
NEWLINE
MOVE(LEN+1,ADDRNAM,ADDR(FILENAME))
FINISH
FINISH
IF CFLAG=FALSE THEN START
! DIRE PROBLEMS
PRINTSTRING("** ATTEMPT TO RECOVER FILENAME ABANDONED - ". C
"LARGE SCALE CORRUPTION INDICATED")
NEWLINE
PRINTSTRING("AREA CONTAINS: ")
CYCLE I=ADDRNAM,1,ADDR2
PRINTHEX(BYTEINTEGER(I),2)
REPEAT
SPACES(2)
CYCLE I=ADDRNAM,1,ADDR2
PRINTCH(BYTEINTEGER(I))
REPEAT
FINISH
! VALIDATE FILENAME IF ONE RETRIEVED
IF CFLAG=TRUE THEN START
! 1ST CHAR BADNAME=TRUE MEANS IT'S BAD
BADNAME=FALSE
CH=BYTEINTEGER(ADDR(FILENAME)+1)
UNLESS 'A'<=CH<='Z' OR CH='#' THEN START
PRINTSTRING("** FILENAME HAS ILLEGAL 1ST CHAR (HEX) - ")
PRINTHEX(CH,2)
NEWLINE
BADNAME=TRUE IF BADNAME=FALSE
FINISH
FLEN=LENGTH(FILENAME)
IF FLEN>1 THEN START
CYCLE I=2,1,FLEN
CH=BYTEINTEGER(ADDR(FILENAME)+I)
UNLESS 'A'<=CH<='Z' OR '0'<=CH<='9' OR CH='#' THEN START
PRINTSTRING("** FILENAME CHAR ")
WRITE(I,3)
PRINTSTRING(" ILLEGAL - (HEX) ")
PRINTHEX(CH,2)
NEWLINE
BADNAME=TRUE IF BADNAME=FALSE
FINISH
REPEAT
FINISH
FINISH ELSE FILENAME=" "
! NOW QUICK CHECKS ON OWNP,EEP AND POOL
! 0<=POOL<=3
POOL=FDESC_POOL&X'3'
IF POOL#FDESC_POOL THEN START
PRINTSTRING("** POOL VALUE OUT OF RANGE - USING POOL&X'3'")
NEWLINE
CORRUPTDESCRIPTOR=TRUE IF CORRUPTDESCRIPTOR=FALSE
FINISH
IF FDESC_OWNP&X'F'#FDESC_OWNP THEN START
PRINTSTRING("** OWNP OUT OF RANGE")
NEWLINE
CORRUPTDESCRIPTOR=TRUE IF CORRUPTDESCRIPTOR=FALSE
FINISH
! DON'T NEED TO USE OWNP AND EEP LATER SO MERELY REPORT IF CORRUPT
IF FDESC_EEP&X'F'#FDESC_EEP THEN START
PRINTSTRING("** EEP OUT OF RANGE")
NEWLINE
CORRUPTDESCRIPTOR=TRUE IF CORRUPTDESCRIPTOR=FALSE
FINISH
! IS IT A DEAD FILE?
DEAD=TRUE IF FDESC_CODES2&128=128
! NOW GET SECTIONS USED AND 1. CHECK AGAINST PGSNAM 2.CHECK PAGE LIMS
IF FDESC_PLNK#X'FF' THEN C
TRACECHAIN(POOL,FDESC_PLNK,TRUE,SECTCELLS,SCOUNT) ELSE SCOUNT=0
! UPDATE COUNT OF LINKS USED
LINKCOUNT(POOL)=LINKCOUNT(POOL)+SCOUNT IF DEAD=FALSE
IF SCOUNT#(FDPAGES+SECTSI-1)//SECTSI THEN START
UNLESS SCOUNT=0 THEN START
CORRUPTDESCRIPTOR=TRUE IF CORRUPTDESCRIPTOR=FALSE
PRINTSTRING("** PLIST WRONG LENGTH")
NEWLINE
IF CONFIDENT=TRUE THEN C
PRINTSTRING("** CAVEAT: DESCRIPTOR PGSNAM INTEGER SUSPECTED CORRUPT". C
" - PLIST MAY BE ACCURATE") AND NEWLINE
FINISH
FINISH
IF SCOUNT=0 AND DEAD=FALSE THEN C
PRINTSTRING("** FILE NOT DEAD - NO PAGES ASSIGNED
")
IF SCOUNT#0 AND DEAD=TRUE THEN C
PRINTSTRING("** WARNING - FILE DEAD, A/PLNK NOT NULL
")
! CHECK PAGE BOUNDS
IF SCOUNT#0 THEN START
CYCLE I=1,1,SCOUNT
UNLESS LOPAGE<=SECTCELLS(I)<=HIPAGE THEN START
PRINTSTRING("** SECTION ")
PRINTHEX(SECTCELLS(I),8)
PRINTSTRING(" OUT OF RANGE")
NEWLINE
CORRUPTDESCRIPTOR=TRUE IF CORRUPTDESCRIPTOR=FALSE
FINISH
REPEAT
FINISH
! NOW GET OFFERS/PERMISSIONS
IF FDESC_ALNK#X'FF' THEN C
TRACECHAIN(POOL,FDESC_ALNK,TRUE,PERMCELLS,ACOUNT) ELSE ACOUNT=0
! UPDATE LINKCOUNT
LINKCOUNT(POOL)=LINKCOUNT(POOL)+ACOUNT IF DEAD=FALSE
! THERE ARE TWO CELLS FOR EACH PERMISSION SO CHECK FOR ODD LENGTH
IF ACOUNT#0 THEN START
IF (ACOUNT>>1)<<1#ACOUNT THEN START
PRINTSTRING("** ACCESS LIST HAS ODD LENGTH")
NEWLINE
CORRUPTDESCRIPTOR=TRUE IF CORRUPTDESCRIPTOR=FALSE
FINISH
! FILE ON OFFER SHOULD HAVE LIST LENGTH OF TWO
IF FDESC_CODES&2=2 THEN ONOFFER=TRUE ELSE ONOFFER=FALSE
IF ONOFFER=TRUE AND ACOUNT#2 THEN START
PRINTSTRING("** FILE ON OFFER - ACCESS LIST # 2")
NEWLINE
CORRUPTDESCRIPTOR=TRUE IF CORRUPTDESCRIPTOR=FALSE
FINISH
IF ACOUNT>32 THEN START
PRINTSTRING("** ACCESS LIST TOO LONG ")
WRITE(ACOUNT,3)
PRINTSTRING(" CELLS (32 MAX)")
NEWLINE
CORRUPTDESCRIPTOR=TRUE IF CORRUPTDESCRIPTOR=FALSE
FINISH
! ACOUNT2 IS NO OF 2 CELL CHUNKS
ACOUNT2=ACOUNT>>1
ACOUNT2=ACOUNT2+1 IF ACOUNT2<<1#ACOUNT
FINISH ELSE ACOUNT2=0
IF DEAD=TRUE THEN DEADFILES=DEADFILES+1 ELSE START
TOTALKB=TOTALKB+FDPAGES<<2
IF FDESC_CODES&16=16 THEN START
NCHERISHED=NCHERISHED+1
CHERISHEDKB=CHERISHEDKB+FDPAGES<<2
FINISH ELSE START
IF FDESC_CODES&8=8 OR FDESC_CODES&4=4 THEN C
TEMPKBUSED=TEMPKBUSED+FDPAGES<<2
FINISH
FINISH
! NOW OUTPUT RESULTS
OUTBYTE(SARCHIVE,FDESC_ARCH)
OUTBYTE(SCODES,FDESC_CODES)
OUTBYTE(SCODES2,FDESC_CODES2)
WRITE(FILENO,3)
SPACES(3)
PRINTSTRING(FILENAME)
SPACES(12-LENGTH(FILENAME))
PRINTHEX(POOL,2)
SPACES(2)
WRITE(FDESC_OWNP,3)
WRITE(FDESC_EEP,3)
WRITE(FDESC_CCT,3)
SPACE
PRINTBIN(FDESC_ARCH,8)
WRITE(FDESC_USE,3)
SPACE
PRINTBIN(FDESC_CODES,8)
SPACE
PRINTBIN(FDESC_CODES2,8)
SPACE
PRINTHEX(FDPAGES,4)
SPACES(2)
PRINTHEX(FDESC_PLNK,2)
SPACES(2)
IF SCOUNT=0 THEN SPACES(8) ELSE PRINTHEX(SECTCELLS(1),8)
SPACES(3)
PRINTHEX(FDESC_SSBYTE,2)
SPACES(4)
PRINTHEX(FDESC_SP15,2)
SPACES(3)
PRINTHEX(FDESC_ALNK,2)
SPACES(2)
IF ACOUNT#0 THEN OUTPERM(1)
IF DEAD=TRUE THEN PRINTSTRING("** DEAD FILE")
NEWLINE
I=2
CYCLE
EXIT IF I>SCOUNT AND I>ACOUNT2
SPACES(77)
IF I>SCOUNT THEN SPACES(8) ELSE PRINTHEX(SECTCELLS(I),8)
SPACES(18)
IF I<=ACOUNT2 THEN OUTPERM(I)
NEWLINE
I=I+1
REPEAT
! OUTPUT COMPLETE
! NEXT CYCLE UPDATES
DEAD=FALSE IF DEAD=TRUE
FILENO=FILENO+1
CONFIDENT=CFLAG
NEXNAM=NEXNAM+LEN+2 IF CFLAG=TRUE; ! CANT ESTIMATE IT OTHERWISE
CUR=CUR-FDSIZE
REPEAT
! END OF INDEX CYCLE
! TEMP
! DUMPBITMAP(0)
NEWLINES(2)
PRINTSTRING("3. LINK USAGE AND CONSISTENCY CHECKING
---- ----- --- ----------- --------")
NEWLINES(2)
IF CORRUPTDESCRIPTOR=TRUE THEN C
PRINTSTRING("** WARNING - PROBEINDEX HAS REPORTED A CONDITION WHICH
MAY HAVE ARISEN FROM A CORRUPT DESCRIPTOR
- MAY AFFECT CERTAIN CONSISTENCY CHECKS") AND C
NEWLINES(2)
CUR=CUR+FDSIZE
PRINTSTRING("CALC BYTE OFFSET OF NEXT FREE DESC: ")
PRINTHEX(CUR-INDAD,8)
IF CUR-INDAD=H_LOFDAD THEN C
PRINTSTRING(" .... CONSISTENT WITH <LOFDAD>") ELSE C
PRINTSTRING(" ** INCONSISTENT WITH <LOFDAD> **")
NEWLINE
PRINTSTRING("CALC BYTE OFFSET OF NEXT FILENAME: ")
PRINTHEX(NAMSTART+NEXNAM-INDAD,8)
IF NAMSTART+NEXNAM-INDAD=H_NEXNAM THEN C
PRINTSTRING(" .... CONSISTENT WITH <NEXNAM>") ELSE C
PRINTSTRING(" ** INCONSISTENT WITH <NEXNAM> **")
NEWLINE
PRINTSTRING("CALC FREEBYTES IN INDEX: ")
WRITE(CUR-NEXNAM-NAMSTART,11)
IF CUR-NEXNAM-NAMSTART=H_FREEBYTES THEN C
PRINTSTRING(" .... CONSISTENT WITH <FREEBYTES>") ELSE C
PRINTSTRING(" ** INCONSISTENT WITH <FREEBYTES> **")
NEWLINE
PRINTSTRING("CALC USED FILE DESCRIPTORS: ")
WRITE(FILENO,11)
IF FILENO=H_USEDFDS THEN C
PRINTSTRING(" .... CONSISTENT WITH <USEDFDS>") ELSE C
PRINTSTRING(" ** INCONSISTENT WITH <USEDFDS> **")
NEWLINE
PRINTSTRING("CALC ON-LINE FILES: ")
WRITE(FILENO-DEADFILES,11)
IF FILENO-DEADFILES=H_FILES THEN C
PRINTSTRING(" .... CONSISTENT WITH <FILES>") ELSE C
PRINTSTRING(" ** INCONSISTENT WITH <FILES> **")
NEWLINE
PRINTSTRING("CALC TOTAL KB: ")
WRITE(TOTALKB,11)
IF TOTALKB=H_TOTKB THEN C
PRINTSTRING(" .... CONSISTENT WITH <TOTKB>") ELSE C
PRINTSTRING(" ** INCONSISTENT WITH <TOTKB> **")
NEWLINE
PRINTSTRING("CALC ON-LINE CHERISHED FILES: ")
WRITE(NCHERISHED,11)
IF NCHERISHED=H_CHERFILES THEN C
PRINTSTRING(" .... CONSISTENT WITH <CHERFILES>") ELSE C
PRINTSTRING(" ** INCONSISTENT WITH <CHERFILES> **")
NEWLINE
PRINTSTRING("CALC KB CHERISHED FILES: ")
WRITE(CHERISHEDKB,11)
IF CHERISHEDKB=H_CHERKB THEN C
PRINTSTRING(" .... CONSISTENT WITH <CHERKB>") ELSE C
PRINTSTRING(" ** INCONSISTENT WITH <CHERKB> **")
NEWLINE
PRINTSTRING("CALC ON-LINE TEMP FILESPACE USED :")
WRITE(TEMPKBUSED,11)
IF TEMPKBUSED=H_TEMPKB THEN C
PRINTSTRING(" .... CONSISTENT WITH <TEMPKB>") ELSE C
PRINTSTRING(" ** INCONSISTENT WITH <TEMPKB> **")
NEWLINES(3)
GRANDTOT=CELSTART-LNKSTART
GRANDTOT=GRANDTOT-GRANDTOT>>8
! TO EXCLUDE 256TH BYTE IN EACH POOL
TOTA==ARRAY(ADDR(TOTCELLSA),BAF)
TOTB==ARRAY(ADDR(H_ZNCELLS),BAF)
FREEA==ARRAY(ADDR(H_ZFREEC),BAF)
FREEB==ARRAY(ADDR(TOTFREEB),BAF)
WARN==ARRAY(ADDR(WARNING),BAF)
PRINTSTRING("POOL 0 1 2 3")
SPACES(65)
PRINTSTRING("0 1 2 3
")
NEWLINE
PRINTSTRING("TOTCELLS(A) ")
CYCLE J=0,1,3
IF GRANDTOT>255 THEN TOTA(J)=255 AND GRANDTOT=GRANDTOT-255 C
ELSE TOTA(J)<-GRANDTOT AND GRANDTOT=0
PRINTHEX(TOTA(J),4)
SPACES(3) IF J#3
REPEAT
PRINTSTRING(" CELSTART - LNKSTART")
NEWLINE
PRINTSTRING("TOTCELLS(B) ")
WARNING=0
CYCLE J=0,1,3
PRINTHEX(TOTB(J),4)
SPACES(3) IF J#3
WARN(J)=X'FF' IF TOTB(J)#TOTA(J)
REPEAT
PRINTSTRING(" ZNCELLS")
IF WARNING#0 THEN START
SPACES(20)
PRINTSTRING("- ** INCONSISTENT WITH TOTCELLS(A) ")
PRINTHEX(WARNING,8)
FINISH
NEWLINE
PRINTSTRING("FREECELLS(A) ")
CYCLE J=0,1,3
PRINTHEX(FREEA(J),4)
SPACES(3) IF J#3
REPEAT
PRINTSTRING(" ZFREEC")
NEWLINE
PRINTSTRING("FREECELLS(B) ")
WARNING=0
CYCLE J=0,1,3
TRACECHAIN(J,BYTEINTEGER(ADDR(H_ZASL)+J),FALSE,PERMCELLS,CELLCOUNT)
FREEB(J)<-CELLCOUNT
PRINTHEX(FREEB(J),4)
SPACES(3) IF J#3
WARN(J)=X'FF' IF FREEB(J)#FREEA(J)
REPEAT
PRINTSTRING(" ZASL LISTHEADS")
IF WARNING#0 THEN START
SPACES(13)
PRINTSTRING("- ** INCONSISTENT WITH FREECELLS(A) ")
PRINTHEX(WARNING,8)
FINISH
NEWLINE
PRINTSTRING("CELLS USED ")
CYCLE J=0,1,3
PRINTHEX(LINKCOUNT(J),4)
SPACES(3) IF J#3
REPEAT
PRINTSTRING(" CALCULATED")
NEWLINE
PRINTSTRING("TOTCELLS(C) ")
WARNING=0
CYCLE J=0,1,3
TOTC(J)=LINKCOUNT(J)+FREEA(J)
PRINTHEX(TOTC(J),4)
SPACES(3) IF J#3
WARN(J)=X'FF' IF TOTC(J)#TOTA(J)
REPEAT
PRINTSTRING(" FREECELLS(A) + CELLS USED")
IF WARNING#0 THEN START
PRINTSTRING(" - ** INCONSISTENT WITH TOTCELLS(A) ")
PRINTHEX(WARNING,8)
FINISH
NEWLINE
PRINTSTRING("TOTCELLS(D) ")
WARNING=0
CYCLE J=0,1,3
TOTD(J)=LINKCOUNT(J)+FREEB(J)
PRINTHEX(TOTD(J),4)
SPACES(3) IF J#3
WARN(J)=X'FF' IF TOTD(J)#TOTA(J)
REPEAT
PRINTSTRING(" FREECELLS(B) + CELLS USED ")
IF WARNING#0 THEN START
PRINTSTRING("- ** INCONSISTENT WITH TOTCELLS(A) ")
PRINTHEX(WARNING,8)
FINISH
NEWLINE
! FINALLY CHECK OUT BIT MAP
!TEMP
! DUMPBITMAP(0)
PLFLAG=0
CHECKBITMAP
IF PLFLAG=0 THEN NEWLINES(2) AND C
PRINTSTRING("ALL LINKS ARE CONSISTENT")
SELECTOUTPUT(0)
CLOSESTREAM(11)
CLEAR("11")
PRINTSTRING("PROBEINDEX TERMINATES NORMALLY")
RETURN
ROUTINE PRINTHEX(INTEGER I,PL)
! RESULT IS THE STRING OF HEX DIGITS REPRESENTING THE NUMBER I.
! THE SECOND PARAM, TO BE SET IN RANGE 1 TO 8, SPECIFIES LENGTH OF
! RESULT STRING.
INTEGER J,K,M,N
STRING (8) W
J=ADDR(W)
N=8-PL+1
CYCLE M=8,-1,N
K=I&15 + '0'
IF K>57 THEN K=K+7
BYTEINTEGER(J+M)=K
I=I>>4
REPEAT
J=J+N-1
BYTEINTEGER(J)=PL
PRINTSTRING(STRING(J))
RETURN
END ; ! PRINTHEX
ROUTINE CHECKLINK(INTEGER POOL,PLINK,INTEGERNAME FLAG)
INTEGER WORDNO,BITNO,LINKNO,PATTERN
FLAG=0
LINKNO=POOL*255+PLINK
WORDNO=LINKNO>>5
BITNO=LINKNO-WORDNO<<5
PATTERN=1<<(31-BITNO)
IF MAP(WORDNO)&PATTERN=PATTERN THEN START
! BIT ALREADY SET
PRINTSTRING("** DUPLICATE ENTRY - POOL ")
WRITE(POOL,3)
PRINTSTRING(" LINK ")
WRITE(PLINK,4)
NEWLINE
FLAG=1
RETURN
FINISH ELSE START
MAP(WORDNO)=MAP(WORDNO)!PATTERN IF DEAD=FALSE
FINISH
! SET BIT
RETURN
END ; ! OF CHECKLINK
ROUTINE DUMPBITMAP(INTEGER TYPE)
BYTEINTEGERARRAY MAPOUT(0:1023),BITCOUNT(0:3)
INTEGER I,J,M,MASK,L
BYTEINTEGERNAME K
MASK=X'80000000'
CYCLE I=0,1,31
M=MAP(I)
CYCLE J=0,1,31
K==BYTEINTEGER(ADDR(MAPOUT(I<<5+J)))
IF M&MASK=MASK THEN K='1' ELSE K='0'
M=M<<1
REPEAT
REPEAT
PRINTSTRING("<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
DUMPBITMAP CALLED
---------- ------
")
CYCLE I=0,1,3
PRINTSTRING("POOL ")
PRINTHEX(I,2)
NEWLINE
BITCOUNT(I)=0
CYCLE J=0,1,254
K==BYTEINTEGER(ADDR(MAPOUT(I*255+J)))
PRINTCH(K) IF TYPE=0
BITCOUNT(I)=BITCOUNT(I)+1 IF K='1'
IF TYPE=0 THEN START
L=J+1
IF (L>>4)<<4=L THEN START
IF (L>>6)<<6=L THEN NEWLINE ELSE SPACE
FINISH
FINISH
REPEAT
NEWLINE
PRINTSTRING("BITCOUNT ")
PRINTHEX(BITCOUNT(I),2)
NEWLINE
PRINTSTRING("LINKCOUNT ")
PRINTHEX(LINKCOUNT(I),2)
NEWLINES(2)
REPEAT
PRINTSTRING(">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
")
RETURN
END ; ! OF DUMPBITMAP
ROUTINE TRACECHAIN(INTEGER LISTPOOL,PLINK,FILLCELLS, C
INTEGERARRAYNAME CELLS, INTEGERNAME CELLCOUNT)
CELLCOUNT=0
LARR==ARRAY(LNKSTART+LISTPOOL<<8,LINKF)
CARR==ARRAY(CELSTART+LISTPOOL<<10,CELLF)
WHILE PLINK#X'FF' CYCLE
CHECKLINK(LISTPOOL,PLINK,FLAG)
IF FLAG#0 THEN START
PRINTSTRING("** LINK ALREADY USED - POOL ")
WRITE(LISTPOOL,3)
PRINTSTRING(" LINK ")
PRINTHEX(PLINK,2)
NEWLINE
TRACEBACK(PLINK)
RETURN
FINISH
CELLCOUNT=CELLCOUNT+1
CELLS(CELLCOUNT)=CARR(PLINK) IF FILLCELLS=TRUE
PLINK=LARR(PLINK)
REPEAT
RETURN
END ; ! OF TRACECHAIN
ROUTINE TRACEBACK(INTEGER PLINK)
ROUTINESPEC PRINTTRACEBACK(INTEGER ARRAYELEM)
BYTEINTEGERARRAY FIFOQ,CAMEFROM(0:254)
INTEGER ORIGIN,NEXTFREE,I,UPDATED,USED,J,NREFS
PRINTSTRING("** TRACEBACK ENTERED
")
ORIGIN=0
UPDATED=FALSE
FIFOQ(0)=PLINK
CAMEFROM(0)=X'FF'
NEXTFREE=1
USED=FALSE
WHILE ORIGIN#NEXTFREE CYCLE
NREFS=0
CYCLE I=0,1,254
IF LARR(I)=PLINK THEN START
! IS LINK ALREADY IN FIFOQ?
! IF SO HIT INFINITE LOOP
NREFS=NREFS+1
USED=FALSE
CYCLE J=0,1,NEXTFREE-1
USED=TRUE AND EXIT IF FIFOQ(J)=I
REPEAT
FIFOQ(NEXTFREE)=I
CAMEFROM(NEXTFREE)=ORIGIN
UPDATED=TRUE IF UPDATED=FALSE AND USED=FALSE
NEXTFREE=NEXTFREE+1 IF USED=FALSE
IF USED=TRUE THEN START
! REPORT LOOP
PRINTSTRING("** INFINITE LOOP
")
IF FIFOQ(ORIGIN)=FIFOQ(NEXTFREE) THEN START
PRINTSTRING("** LINK ")
PRINTHEX(I,2)
PRINTSTRING(" POINTING AT ITSELF
")
FINISH ELSE START
PRINTSTRING("** LOOP FORMED BY LINKS: ")
PRINTTRACEBACK(NEXTFREE)
FINISH
FINISH
FINISH
REPEAT
IF NREFS>1 THEN START
PRINTSTRING("** LINK ")
PRINTHEX(PLINK,2)
PRINTSTRING(" REFERENCED ")
WRITE(NREFS,4)
PRINTSTRING(" TIMES
")
FINISH
IF UPDATED=FALSE AND USED=FALSE THEN START
! HIT LISTHEAD
PRINTSTRING("** LISTHEAD IS: ")
PRINTHEX(PLINK,2)
NEWLINE
PRINTSTRING("** ROUTE FROM LISTHEAD: ")
PRINTTRACEBACK(ORIGIN)
FINISH
ORIGIN=ORIGIN+1
UPDATED=FALSE IF UPDATED=TRUE
PLINK=FIFOQ(ORIGIN)
! TEMP
! %CYCLE J=0,1,NEXTFREE-1
! PRINTHEX(CAMEFROM(J),2)
! %IF ((J+1)>>5)<<5=J+1 %THEN NEWLINE %ELSE SPACE
! %REPEAT
! NEWLINE
! %CYCLE J=0,1,NEXTFREE-1
! PRINTHEX(FIFOQ(J),2)
! %IF ((J+1)>>5)<<5=J+1 %THEN NEWLINE %ELSE SPACE
! %REPEAT
! NEWLINE
!
REPEAT
PRINTSTRING("** TRACEBACK COMPLETE
")
RETURN
ROUTINE PRINTTRACEBACK(INTEGER ARRAYELEM)
INTEGER FIRSTLINK,NEXTELEM
FIRSTLINK=FIFOQ(ARRAYELEM)
NEXTELEM=ARRAYELEM
J=1
CYCLE
PRINTHEX(FIFOQ(NEXTELEM),2)
IF (J>>5)<<5=J THEN NEWLINE ELSE SPACE
EXIT IF CAMEFROM(NEXTELEM)=X'FF'
EXIT IF FIFOQ(NEXTELEM)=FIRSTLINK AND J#1
J=J+1
NEXTELEM=CAMEFROM(NEXTELEM)
REPEAT
NEWLINE
RETURN
END ; ! OF PRINTTRACEBACK
END ; ! OF TRACEBACK
ROUTINE PRINTBIN(INTEGER I,PL)
! RESULT IS THE STRING OF BIN DIGITS REPRESENTING THE NUMBER I.
! THE SECOND PARAM, TO BE SET IN RANGE 1 TO 32, SPECIFIES LENGTH OF
! RESULT STRING.
INTEGER J,K,M,N
STRING (32) W
J=ADDR(W)
N=32-PL+1
CYCLE M=32,-1,N
K=I&1 + '0'
BYTEINTEGER(J+M)=K
I=I>>1
REPEAT
J=J+N-1
BYTEINTEGER(J)=PL
PRINTSTRING(STRING(J))
RETURN
END ; ! PRINTBIN
ROUTINE OUTPERM(INTEGER I)
! UNSCRAMBLES PERMISSIONS FROM PERMCELLS
INTEGER J,OUTSTART,PERMBYTE
OUTSTART=ADDR(PERMCELLS(I<<1-1)); ! START OF TWO CELL BLOCK
IF I<<1>ACOUNT THEN START
CYCLE J=0,1,3
PRINTCH(BYTEINTEGER(OUTSTART+J))
REPEAT
PRINTSTRING("** MISSING SECTION")
FINISH ELSE START
CYCLE J=0,1,7
PRINTCH(BYTEINTEGER(OUTSTART+J))
REPEAT
PERMBYTE=BYTEINTEGER(OUTSTART+7)&7
IF ONOFFER=TRUE THEN PRINTSTRING("OFFER") AND RETURN
IF PERMBYTE=0 THEN PRINTSTRING("NONE")
IF PERMBYTE&4=4 THEN PRINTSTRING("E")
IF PERMBYTE&2=2 THEN PRINTSTRING("W")
IF PERMBYTE&1=1 THEN PRINTSTRING("R")
IF PERMBYTE#BYTEINTEGER(OUTSTART+7) THEN START
PRINTSTRING("** CORRUPT PERM ")
PRINTHEX(PERMBYTE,2)
FINISH
FINISH
RETURN
END ; ! OF OUTPERM
ROUTINE CHECKBITMAP
INTEGER PATTERN,MASK,ROGUE,REM,I,J
PATTERN=X'FFFFFFFF'
GRANDTOT=CELSTART-LNKSTART
GRANDTOT=GRANDTOT-GRANDTOT>>8
J=GRANDTOT>>5
! NO OF COMPLETE WORDS IN MAP
CYCLE I=0,1,31
IF I<J THEN START
ROGUE=MAP(I)!!PATTERN
! BITS SET ONLY WHERE LINK MISSING
IF ROGUE#0 THEN POOLLINK(ROGUE,I,0,PLFLAG)
FINISH
IF I=J THEN START
REM=GRANDTOT-I<<5
MASK=PATTERN<<(32-REM)
! FOR BITS NOT SET THAT SHOULD BE
ROGUE=(MAP(I)&MASK)!!MASK
IF ROGUE#0 THEN POOLLINK(ROGUE,I,0,PLFLAG)
MASK=PATTERN!!MASK
! FOR BITS SET WHICH OUGHT NOT TO BE
ROGUE=MAP(I)&MASK
IF ROGUE#0 THEN POOLLINK(ROGUE,I,1,PLFLAG)
FINISH
IF I>J THEN START
ROGUE=MAP(I)&PATTERN
! BITS SET WHERE LINK USED THAT OUGHT NOT TO HAVE BEEN
IF ROGUE#0 THEN POOLLINK(ROGUE,I,1,PLFLAG)
FINISH
REPEAT
RETURN
END ; ! OF CHECKBITMAP
ROUTINE POOLLINK(INTEGER ROGUE,WORD,TYPE, INTEGERNAME FLAG)
INTEGER MASK,BIT,I,POOL,LINK
MASK=X'80000000'
CYCLE I=0,1,31
IF ROGUE&MASK=MASK THEN START
FLAG=1 IF FLAG=0
BIT=WORD<<5+I
POOL=BIT//255
LINK=BIT-POOL*255
PRINTSTRING("POOL ")
PRINTHEX(POOL,2)
PRINTSTRING(" LINK ")
PRINTHEX(LINK,2)
IF TYPE=0 THEN PRINTSTRING(" NOT ACCOUNTED FOR") ELSE C
PRINTSTRING(" USED BUT SHOULDNT HAVE BEEN")
NEWLINE
TRACEBACK(LINK) IF TYPE=1
FINISH
ROGUE=ROGUE<<1
REPEAT
RETURN
END ; ! OF POOLLINK
ROUTINE OUTBYTE(STRINGARRAYNAME NAMES, BYTEINTEGER BYTE)
INTEGER I
SPACES(15)
PRINTSTRING(NAMES(-1))
PRINTSTRING(" BITS SET:")
IF BYTE=0 THEN START
PRINTSTRING(" * NONE SET *")
NEWLINE
RETURN
FINISH
CYCLE I=0,1,7
IF BYTE&1=1 THEN PRINTSTRING(NAMES(I))
BYTE=BYTE>>1
REPEAT
NEWLINE
RETURN
END ; ! OF OUTBYTE
ROUTINE PRINTCHAIN(STRING (31) TEXT, BYTEINTEGER PLINK, C
INTEGER PRINTREGARDLESS)
INTEGER I,J,CELLCOUNT
IF PLINK#X'FF' OR PRINTREGARDLESS=TRUE THEN START
TRACECHAIN(0,PLINK,TRUE,PERMCELLS,CELLCOUNT)
PRINTSTRING(TEXT)
PRINTSTRING(" (")
WRITE(CELLCOUNT,3)
PRINTSTRING(" CELLS):")
SPACES(26-LENGTH(TEXT))
! SO THAT PRINTING STARTS AT COL 41
IF CELLCOUNT#0 THEN START
CYCLE I=1,1,CELLCOUNT
NEWLINE AND SPACES(40) IF I//21*21=I
CYCLE J=0,1,3
PRINTCH(BYTEINTEGER(ADDR(PERMCELLS(I))+J))
REPEAT
REPEAT
FINISH
NEWLINE
LINKCOUNT(0)=LINKCOUNT(0)+CELLCOUNT
FINISH
RETURN
END ; ! OF PRINTCHAIN
STRINGFN S2(INTEGER N)
!THIS FUNCTION RETURNS A TWO DIGIT DECIMAL VALUE FOR N
INTEGER TENS, UNITS
TENS = N//10
UNITS = N-10*TENS
RESULT = TOSTRING(TENS+'0').TOSTRING(UNITS+'0')
END ; !OF S2
STRINGFN PRINTDATE(INTEGER P)
RESULT =S2(P&X'1F')."/".S2(P>>5&X'F')."/".S2(P>>9&X'3F'+70)
END ; !OF PRINTDATE
ROUTINE ASK(STRING (15) TEXT, STRINGNAME T)
EXTERNALROUTINESPEC PROMPT(STRING (15) S)
ROUTINESPEC TRIM(STRINGNAME A)
BYTEINTEGER IN
T=""
NEWLINE
PROMPT(TEXT)
WHILE NEXTSYMBOL#X'0A' CYCLE
READSYMBOL(IN)
T=T.TOSTRING(IN)
REPEAT
SKIPSYMBOL
TRIM(T)
RETURN
ROUTINE TRIM(STRINGNAME A)
! REMOVES LEADING AND TRAILING SPACES, BUT NOT EMBEDDED SPACES.
WHILE CHARNO(A,LENGTH(A)) = ' ' C
THEN LENGTH(A) = LENGTH(A)-1
!REMOVE
!TRAILING SPACES
WHILE A -> (" ").A THEN CYCLE
REPEAT ; !REMOVE
!LEADING SPACES
END
END ; ! OF ASK
END ; ! OF PROBEINDEX
ENDOFFILE