!***********************************************************************
!*
!* Object file analysis program
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!* Constants
!*
!***********************************************************************
!
CONSTANTINTEGER NO = 0, YES = 1
CONSTANTINTEGER SSOBJFILETYPE = 1
CONSTANTINTEGER OUTSTREAM = 80; ! For all output
CONSTANTBYTEINTEGERARRAY HEX(0:15) = C
'0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
CONSTANTSTRING (1) SNL = "
"
CONSTANTSTRING (8) NONE = " None"
!
CONSTANTINTEGER MAXPARMS = 63
CONSTANTSTRING (9)ARRAY PARMS(0:MAXPARMS) = C
"","I8","L8","R8",
""(4),
"MAXDICT",""(5),"MINSTACK",""(17),
"QUOTES","NOLIST","NODIAG","STACK",
"NOCHECK","NOARRAY","NOTRACE","PROFILE",
"IMPS","INHIBIOF","ZERO","XREF",
"LABELS","LET","CODE","ATTR",
"OPT","MAP","DEBUG","FREE",
"DYNAMIC","","EBCDIC","NOLINE",
""(2),"PARMZ","PARMY",
"PARMX","MISMATCH",""(2)
!
CONSTANTINTEGER MAXLISTNAME = 15
CONSTANTSTRING (60)ARRAY LISTNAME(0:MAXLISTNAME) = C
"No of listheads",
"Listhead of procedure entries",
"No of entries and refs",
"No of relocations",
"Listhead of data entries",
"Load address of code (bound files)",
"Load address gla (bound files) / listhead for misc data",
"Listhead of static procedure references",
"Listhead of dynamic procedure references",
"Listhead of data references",
"Load address of initialised stack (bound files)",
"Listhead of single word - code or data - refs",
"Offset of file history",
"Listhead of multiple initialisation requests",
"Listhead of blocks of relocation requests",
"Offset of OMF diagnostic records"
!
CONSTANTINTEGER MAXAREANAME = 7
CONSTANTSTRING (4)ARRAY AREANAME(1:MAXAREANAME) = C
"CODE"," GLA"," PLT"," SST"," UST","ICMN","ISTK"
!
!
!***********************************************************************
!*
!* Record and array formats
!*
!***********************************************************************
!
RECORDFORMAT FDF(INTEGER LINK,DSNUM,BYTEINTEGER STATUS,ACCESSROUTE,C
VALID ACTION,CUR STATE,BYTEINTEGER MODE OF USE,C
MODE,FILE ORG,DEV CODE,BYTEINTEGER REC TYPE,FLAGS,C
LM,RM,INTEGER ASVAR,AREC,RECSIZE,MINREC,MAXREC,C
MAXSIZE,LASTREC,CONAD,CURREC,CUR,END,TRANSFERS,C
DARECNUM,CURSIZE,DATASTART,STRING (31) IDEN)
RECORDFORMAT OFMF(INTEGER N,CODESTART,CODELENGTH,CODEPROP,GLASTART,C
GLALENGTH,GLAPROP,PLTSTART,PLTLENGTH,PLTUSE,C
SSTSTART,SSTLENGTH,SSTPROP,USTSTART,USTLENGTH,C
USTPROP,INITCMNSTART,INITCMNLENGTH,INITCMNPROP,C
INITSTACKSTART,INITSTACKLENGTH,INITSTACKPROP)
RECORDFORMAT OHF(INTEGER DATAEND,DATASTART,FILESIZE,FILETYPE,SUM,C
DATETIME,LDA,OFM)
RECORDFORMAT RF(INTEGER CONAD,FILETYPE,DATASTART,DATAEND)
!
RECORDFORMAT LD1F(INTEGER LINK,LOC,STRING (31) IDEN)
RECORDFORMAT LD4F(INTEGER LINK,DISP,L,A,STRING (31) IDEN)
RECORDFORMAT LD78F(INTEGER LINK,REFLOC,STRING (31) IDEN)
RECORDFORMAT LD9F(INTEGER LINK,REFARRAY,L,STRING (31) IDEN)
RECORDFORMAT LD11F(INTEGER LINK,REFLOC,STRING (31) IDEN)
RECORDFORMAT LD13F(INTEGER LINK,A,DISP,LEN,REP,ADDR)
RECORDFORMAT LD14F(INTEGER LINK,N,TABLESTART)
!
OWNINTEGERARRAYFORMAT LDATAAF(0:15)
!
!
!***********************************************************************
!*
!* Subsystem references
!*
!***********************************************************************
!
SYSTEMROUTINESPEC CONNECT(STRING (31) FILE,INTEGER MODE,HOLE,C
PROT,RECORD (RF)NAME R,INTEGERNAME FLAG)
SYSTEMROUTINESPEC DEFINE(INTEGER CHAN,STRING (31) IDEN,C
INTEGERNAME AFD,FLAG)
SYSTEMSTRINGFUNCTIONSPEC FAILUREMESSAGE(INTEGER MESS)
SYSTEMINTEGERFUNCTIONSPEC IOCP(INTEGER EP,PARM)
SYSTEMINTEGERMAPSPEC MAPSSFD(INTEGER DSNUM)
SYSTEMROUTINESPEC MOVE(INTEGER LENGTH,FROM,TO)
EXTERNALINTEGERFUNCTIONSPEC OUTPOS
SYSTEMINTEGERFUNCTIONSPEC PARMAP
SYSTEMROUTINESPEC PHEX(INTEGER N)
SYSTEMROUTINESPEC SETFNAME(STRING (63) S)
SYSTEMROUTINESPEC SETPAR(STRING (255) S)
EXTERNALROUTINESPEC SET RETURN CODE(INTEGER I)
SYSTEMSTRINGFUNCTIONSPEC SPAR(INTEGER N)
EXTERNALINTEGERFUNCTIONSPEC UINFI(INTEGER ENTRY)
SYSTEMSTRING (8)FUNCTIONSPEC UNPACKDATE(INTEGER P)
SYSTEMSTRING (8)FUNCTIONSPEC UNPACKTIME(INTEGER P)
!
!
!***********************************************************************
!*
!* Service routines
!*
!***********************************************************************
!
ROUTINE BOX(STRING (31) S)
! Prints a string enclosed in a box.
STRING (35) BAR
!
BAR = "***********************************"
LENGTH(BAR) = LENGTH(S) + 4
PRINTSTRING(BAR.SNL)
PRINTSTRING("* ".S." *".SNL)
PRINTSTRING(BAR)
NEWLINES(2)
END ; ! of BOX
!
!
ROUTINE PRINTPARMS(LONGINTEGER P)
! Decodes and prints PARM settings.
INTEGER I,FOUND
!
FOUND = NO
FOR I = 0,1,MAXPARMS CYCLE
IF P & 1 # 0 THEN START
IF PARMS(I) # "" THEN START ; ! Ignore blank parms
IF FOUND = NO THEN START
FOUND = YES
FINISH ELSE PRINTSYMBOL(',')
PRINTSTRING(PARMS(I))
FINISH
FINISH
P = P >> 1
REPEAT
IF FOUND = NO THEN PRINTSTRING("DEFAULTS")
END ; ! of PRINTPARMS
!
!
ROUTINE PRINT8PLUS24(INTEGER N)
! Prints an integer in the form 'BASE+DISPLACEMENT', as used by the
! loader.
INTEGER I,AREA
!
AREA = N >> 24
IF 0 < AREA <= MAXAREANAME THEN START
PRINTSTRING(AREANAME(AREA))
FINISH ELSE START
PRINTSYMBOL('@')
WRITE(AREA,2)
FINISH
PRINTSYMBOL('+')
FOR I = 20,-4,0 CYCLE
PRINTSYMBOL(HEX((N>>I) & X'F'))
REPEAT
END ; ! of PRINT8PLUS24
!
!
ROUTINE TAB(INTEGER N)
! Prints spaces up to a specified column.
SPACE WHILE OUTPOS < N
END ; ! of TAB
!
!
ROUTINE OUTI(STRING (255) S,INTEGER POS,I)
! Prints a string and a decimal integer, aligned to specified columns.
PRINTSTRING(S.":")
SPACE WHILE OUTPOS < POS - 6
WRITE(I,6)
NEWLINE
END ; ! of OUTI
!
!
ROUTINE OUTHI(STRING (255) S,INTEGER POS,I)
! Prints a string and a hexadecimal integer, aligned to specified
! columns.
PRINTSTRING(S.":")
SPACE WHILE OUTPOS < POS
PHEX(I)
NEWLINE
END ; ! of OUTHI
!
!
ROUTINE CLOSESTREAM(INTEGER CHAN)
! Special version of CLOSESTREAM - will work on stream numbers outwith
! the normal range, and will not fail if the stream is not defined.
INTEGER FLAG
!
FLAG = IOCP(16,CHAN); ! Ignore flag
END ; ! of CLOSESTREAM
!
!
ROUTINE CLEARSTREAM(INTEGER CHAN)
! Clears out a channel definition. Does not give an error if the stream
! was not defined.
RECORD (FDF)NAME F
!
IF MAPSSFD(CHAN) # 0 THEN START
F == RECORD(MAPSSFD(CHAN))
IF F_STATUS = 0 THEN START
F_DSNUM = 0; ! Mark descriptor as free
MAPSSFD(CHAN) = 0; ! Clear pointer
FINISH
FINISH
END ; ! of CLEARSTREAM
!
!
INTEGERFUNCTION LISTCOUNT(INTEGER LINK,CONAD)
! Counts the number of entries attached to a specified list head.
INTEGER RES
!
RES = 0
WHILE LINK # 0 CYCLE
RES = RES + 1
LINK = INTEGER(CONAD+LINK)
REPEAT
RESULT = RES
END ; ! of LISTCOUNT
!
!
!***********************************************************************
!*
!* O B J A N A L
!*
!***********************************************************************
!
EXTERNALROUTINE OBJANAL(STRING (255) S)
INTEGERARRAYNAME LDATA
STRING (31) FILE,OUT
INTEGER CONAD,LINK,REFARRAY,PAGEWIDTH,AOFM,RRCOUNT,RELAD,NS,TYPE,RECAD
INTEGER I,J,FLAG,AFD
LONGINTEGER LONGTYPE
SWITCH HIST(1:8)
RECORD (RF) RR
RECORD (FDF)NAME F
RECORD (LD1F)NAME L1
RECORD (LD4F)NAME L4
RECORD (LD78F)NAME L7
RECORD (LD9F)NAME L9
RECORD (LD11F)NAME L11
RECORD (LD13F)NAME L13
RECORD (LD14F)NAME L14
RECORD (OFMF)NAME OFM
RECORD (OHF)NAME H
!
SETPAR(S)
IF 1 # PARMAP # 3 THEN START
FLAG = 263; ! Wrong number of parameters
-> ERR
FINISH
FILE = SPAR(1)
OUT = SPAR(2)
OUT = ".OUT" IF OUT = ""
IF OUT = ".OUT" THEN START
PAGEWIDTH = UINFI(15); ! Interactive terminal width
PAGEWIDTH = 72 IF PAGEWIDTH = 72; ! Keep to reasonable value
FINISH ELSE PAGEWIDTH = 132
DEFINE(OUTSTREAM,OUT,AFD,FLAG)
-> ERR IF FLAG # 0
F == RECORD(AFD)
F_MAXSIZE = 1024 << 10
SELECTOUTPUT(OUTSTREAM)
!
CONNECT(FILE,1,0,0,RR,FLAG)
-> ERR IF FLAG # 0
IF RR_FILETYPE # SSOBJFILETYPE THEN START
SETFNAME(FILE)
FLAG = 267; ! Invalid filetype
-> ERR
FINISH
CONAD = RR_CONAD
H == RECORD(CONAD)
LDATA == ARRAY(CONAD+H_LDA,LDATAAF)
AOFM = CONAD + H_OFM
OFM == RECORD(AOFM)
!
PRINTSTRING("File: ".FILE.SNL)
OUTHI("Total size (including header)",35,RR_DATAEND)
OUTHI("Offset of Load Data",35,H_LDA)
OUTHI("Offset of Object File Map",35,H_OFM)
NEWLINE
!
BOX("Load Data")
FOR I = 0,1,LDATA(0) CYCLE
WRITE(I,2)
SPACES(3)
PHEX(LDATA(I))
IF I <= MAXLISTNAME THEN START
SPACES(3)
PRINTSTRING(LISTNAME(I))
FINISH
NEWLINE
REPEAT
NEWLINE
!
BOX("Object File Map")
PRINTSTRING(" Offset Length Attributes".SNL.SNL)
FOR I = 1,1,OFM_N CYCLE
J = AOFM + 4 + 12*(I - 1)
WRITE(I,2)
SPACES(3)
PHEX(INTEGER(J))
SPACES(5)
PHEX(INTEGER(J+4))
SPACES(5)
PHEX(INTEGER(J+8))
IF I <= MAXAREANAME THEN START
SPACES(3)
PRINTSTRING(AREANAME(I))
FINISH
NEWLINE
REPEAT
NEWLINES(2)
OUTI("Number of procedure entries",50,LISTCOUNT(LDATA(1),CONAD))
OUTI("Number of data entries",50,LISTCOUNT(LDATA(4),CONAD))
OUTI("Number of static procedure references",50,C
LISTCOUNT(LDATA(7),CONAD))
OUTI("Number of dynamic procedure references",50,C
LISTCOUNT(LDATA(8),CONAD))
OUTI("Number of data references",50,LISTCOUNT(LDATA(9),CONAD))
OUTI("Number of single word references",50,LISTCOUNT(LDATA(11),CONAD))
OUTI("Number of multiple initialisation blocks",50,C
LISTCOUNT(LDATA(13),CONAD))
OUTI("Number of relocation request blocks",50,C
LISTCOUNT(LDATA(14),CONAD))
RRCOUNT = 0
LINK = LDATA(14)
WHILE LINK # 0 CYCLE
L14 == RECORD(CONAD+LINK)
RRCOUNT = RRCOUNT + L14_N
LINK = L14_LINK
REPEAT
OUTI("Total number of relocation requests",50,RRCOUNT)
NEWLINES(3)
!
BOX("Procedure Entries")
IF LDATA(1) # 0 THEN START
PRINTSTRING(C
"Entry Name Location of Entry Descriptor")
NEWLINES(2)
LINK = LDATA(1)
WHILE LINK # 0 CYCLE
L1 == RECORD(CONAD+LINK)
PRINTSTRING(L1_IDEN)
IF L1_LOC & X'80000000' # 0 THEN PRINTSTRING("(Main Entry)")
TAB(35)
PRINT8PLUS24(L1_LOC & X'7FFFFFFF')
NEWLINE
LINK = L1_LINK
REPEAT
FINISH ELSE PRINTSTRING(NONE)
NEWLINES(3)
!
BOX("Data Entries")
IF LDATA(4) # 0 THEN START
PRINTSTRING(C
"Entry Name Area Offset Length")
NEWLINES(2)
LINK = LDATA(4)
WHILE LINK # 0 CYCLE
L4 == RECORD(LINK+CONAD)
PRINTSTRING(L4_IDEN)
TAB(35)
PRINT8PLUS24((L4_A<<24)!L4_DISP)
WRITE(L4_L,6)
NEWLINE
LINK = L4_LINK
REPEAT
FINISH ELSE PRINTSTRING(NONE)
NEWLINES(3)
!
BOX("Static procedure references")
IF LDATA(7) # 0 THEN START
PRINTSTRING(C
"Name Location of Descriptor")
NEWLINES(2)
LINK = LDATA(7)
WHILE LINK # 0 CYCLE
L7 == RECORD(LINK+CONAD)
PRINTSTRING(L7_IDEN)
TAB(35)
PRINT8PLUS24(L7_REFLOC)
NEWLINE
LINK = L7_LINK
REPEAT
FINISH ELSE PRINTSTRING(NONE)
NEWLINES(3)
!
BOX("Dynamic procedure references")
IF LDATA(8) # 0 THEN START
PRINTSTRING(C
"Name Location of Descriptor")
NEWLINES(2)
LINK = LDATA(8)
WHILE LINK # 0 CYCLE
L7 == RECORD(LINK+CONAD)
PRINTSTRING(L7_IDEN)
TAB(35)
PRINT8PLUS24(L7_REFLOC)
NEWLINE
LINK = L7_LINK
REPEAT
FINISH ELSE PRINTSTRING(NONE)
NEWLINES(3)
!
BOX("Data references")
IF LDATA(9) # 0 THEN START
PRINTSTRING(C
"Name Length Pointers")
NEWLINES(2)
LINK = LDATA(9)
WHILE LINK # 0 CYCLE
L9 == RECORD(CONAD+LINK)
PRINTSTRING(L9_IDEN)
IF L9_REFARRAY & X'80000000' # 0 THEN START
PRINTSTRING(" (Common Block)")
FINISH
TAB(35)
WRITE(L9_L,6)
TAB(45)
REFARRAY = CONAD + L9_REFARRAY & X'7FFFFFFF'
FOR I = REFARRAY + 4,4,REFARRAY + 4*INTEGER(REFARRAY) CYCLE
IF OUTPOS > PAGEWIDTH - 11 THEN START
NEWLINE
TAB(45)
FINISH
PRINT8PLUS24(INTEGER(I))
SPACES(2)
REPEAT
NEWLINE
LINK = L9_LINK
REPEAT
FINISH ELSE PRINTSTRING(NONE)
NEWLINES(3)
!
BOX("Single word references")
IF LDATA(11) # 0 THEN START
PRINTSTRING(C
"Entry Location")
NEWLINES(2)
LINK = LDATA(11)
WHILE LINK # 0 CYCLE
L11 == RECORD(LINK+CONAD)
PRINTSTRING(L11_IDEN)
TAB(35)
PRINT8PLUS24(L11_REFLOC)
NEWLINE
LINK = L11_LINK
REPEAT
FINISH ELSE PRINTSTRING(NONE)
NEWLINES(3)
!
BOX("Multiple initialisation blocks")
IF LDATA(13) # 0 THEN START
PRINTSTRING(C
"Fill area with byte from address Repeat")
NEWLINES(2)
LINK = LDATA(13)
WHILE LINK # 0 CYCLE
L13 == RECORD(LINK+CONAD)
PRINT8PLUS24((L13_A << 24)!L13_DISP)
IF L13_LEN = 1 THEN START
TAB(15)
PRINTSYMBOL(HEX((L13_ADDR >> 4) & X'F'))
PRINTSYMBOL(HEX(L13_ADDR & X'F'))
FINISH ELSE START
TAB(23)
PHEX(L13_ADDR)
FINISH
TAB(35)
PHEX(L13_REP)
NEWLINE
LINK = L13_LINK
REPEAT
FINISH ELSE PRINTSTRING(NONE)
NEWLINES(3)
!
BOX("Relocation Request Blocks")
IF LDATA(14) # 0 THEN START
PRINTSTRING(C
"Relocate INTEGER(AREASTART(1)+OFFSET(1)) by AREASTART(2)+OFFSET(2)")
NEWLINES(2)
LINK = LDATA(14)
WHILE LINK # 0 CYCLE
L14 == RECORD(CONAD+LINK)
RELAD = ADDR(L14_TABLESTART)
FOR I = 1,1,L14_N CYCLE
IF OUTPOS + 21 > PAGEWIDTH THEN NEWLINE
PRINT8PLUS24(INTEGER(RELAD)); ! AREALOC
SPACES(2)
PRINT8PLUS24(INTEGER(RELAD+4));!BASELOC
SPACES(6)
RELAD = RELAD + 8
REPEAT
LINK = L14_LINK
NEWLINES(2)
REPEAT
FINISH ELSE PRINTSTRING(NONE)
NEWLINES(3)
!
BOX("File History")
IF LDATA(12) # 0 THEN START
RECAD = CONAD + LDATA(12)
NS = 0
WHILE BYTEINTEGER(RECAD) # 0 CYCLE
TYPE = BYTEINTEGER(RECAD)
EXIT UNLESS 1 <= TYPE <= 8
SPACES(NS) UNLESS TYPE = 7
!
-> HIST(BYTEINTEGER(RECAD))
!
HIST(1): ! Name of source file
PRINTSTRING("Source : ".STRING(RECAD+1))
-> NEXT
!
HIST(2): ! PARM setting
PRINTSTRING("Parms set : ")
MOVE(8,RECAD+2,ADDR(LONGTYPE))
PRINTPARMS(LONGTYPE)
-> NEXT
!
HIST(3): ! Start of linked object
PRINTSTRING("Components : ")
NS = NS + 3; ! For indentation
-> NEXT
!
HIST(4): ! Name of object file
NEWLINE
SPACES(NS)
PRINTSTRING("Object : ".STRING(RECAD+1))
-> NEXT
!
HIST(5): ! Date linked
MOVE(4,RECAD+2,ADDR(I))
PRINTSTRING("Linked : ".UNPACKDATE(I)." at ".UNPACKTIME(I))
-> NEXT
!
HIST(6): ! Date compiled
MOVE(4,RECAD+2,ADDR(I))
PRINTSTRING("Last altered: ".UNPACKDATE(I)." at ".UNPACKTIME(I))
-> NEXT
!
HIST(7): ! End of linked object
NS = NS - 3
SPACES(NS)
PRINTSTRING("END")
-> NEXT
!
HIST(8): ! Any text
I = RECAD + 2; ! Start of text
J = RECAD + 1 + BYTEINTEGER(RECAD + 1)
! End of text
WHILE I <= J CYCLE
PRINTSYMBOL(BYTEINTEGER(I))
IF BYTEINTEGER(I) = NL THEN SPACES(NS)
I = I + 1
REPEAT
-> NEXT
!
NEXT:
NEWLINE
RECAD = RECAD + 2 + BYTEINTEGER(RECAD+1)
! Point to next item
REPEAT
FINISH ELSE PRINTSTRING(NONE)
!
SELECTOUTPUT(0)
CLOSESTREAM(OUTSTREAM)
CLEARSTREAM(OUTSTREAM)
SET RETURN CODE(0)
STOP
!
ERR:
SELECTOUTPUT(0)
CLOSESTREAM(OUTSTREAM)
CLEARSTREAM(OUTSTREAM)
PRINTSTRING(SNL."OBJANAL fails -".FAILUREMESSAGE(FLAG))
SET RETURN CODE(FLAG)
STOP
END ; ! of OBJANAL
! This version deals with LIST11 type references
! Not dealt with currently are LIST13
! (multiple initialisation) and LIST15 (OMF diagnostic records).
! C. McC. 17/2/81
ENDOFFILE