;
;
;		S Y M D M P . C M D
;
;	Read an object or symbol table file and dump symbol values.
;

.; SYMDMP.CMD is a command file that reads a .OBJ or .STB file,
.; and displays the symbols it finds there.

.; Turn on the ICP features we need:

	.ENABLE SUBSTITUTION

.; Initialize various variables:

	.SETN O$ZERO 14
	.SETS S$FF "'O$ZERO%V'"		! Formfeed character.
	.SETN O$ZERO 0			! Constant zero.
	.SETN D$CURL 60.		! Current line on page.
	.SETN D$MAXL 60.		! Maximum lines per page.
	.SETN D$INCR 1.			! Lines to count per output line.
	.SETS S$DASH "-"		! Constant "-" for tests.
	.SETS S$NO "NO"			! Constant "NO" for tests.
	.SETS S$FIL P1			! Input file name.
	.SETS S$OUT P2			! Output file name.
	.SETS S$MCR ""
	.IF S$MCR <> "MCR"	.SETS S$MCR "MCR "

.; Define and initialize the command switches:

	.SETF V$SP	! Define /SP (spool) and assume false.
	.SETT V$BR	! Define /BR (page break) and assume true.

.; Determine processing mode (interactive or command line):

	.IF P1 = ""	.GOTO PROMPT

.; Get the file specs, from either MCR or DCL syntax:

	.IF P2 <> ""	.GOTO SWIEXT
	.PARSE P1 "=" S$OUT S$FIL
	.IF S$FIL <> ""	.GOTO SWIEXT
	.SETS S$FIL S$OUT
	.SETS S$OUT ""

.; Peel the switches off the file specifications:

.SWIEXT:.PARSE S$FIL "/" S$FIL S$SWIT
	.PARSE S$OUT "/" S$OUT S$JUNK
	.SETS S$SWIT "/"+S$SWIT+"/"+S$JUNK

.; Parse the switches:

.SWITLP:
	.IF S$SWIT = ""	.GOTO PROCES

.; Peel the next switch off, and get its arguments:

	.PARSE S$SWIT "/" S$SWX S$SWIT
	.PARSE S$SWX ":" S$SWX S$SWP

.; Figure out whether it is asserted or negated:

	.SETT L$ASRT
	.IF S$SWX = ""	.GOTO SWITLP
	.IF S$DASH = S$SWX[1:1]	.GOTO SWITNM
	.IF S$NO <> S$SWX[1:2]	.GOTO SWITAS
	.SETS S$SWX S$SWX[2:*]
.SWITNM:.SETS S$SWX S$SWX[2:*]
	.SETF L$ASRT
.SWITAS:.SETS S$SWX S$SWX[1:2]

.; See if this switch has a corresponding V$sw symbol:

	.TEST S$SWX
	.IFF <ALPHAN>		.GOTO SWIBAD
	.IFNDF V$'S$SWX'	.GOTO SWIBAD

.; Dispatch the rest based on the symbol type:

	.TEST V$'S$SWX'
	.GOTO SWIT'<SYMTYP>'

.; Logical symbol. Set its value to switch polarity:

.SWIT0:	.IF S$SWP <> ""	.GOTO SWINPR
	.SETL V$'S$SWX' L$ASRT
	.GOTO SWITLP

.; Numeric symbol. Set its value to switch parameter:

.SWIT2:	.IFF L$ASRT	.GOTO SWINNG
	.TEST S$SWP
	.IFF <NUMBER>	.GOTO SWIIVP
	.SETN V$'S$SWX' 'S$SWP'
	.GOTO SWITLP

.; String symbol. Set its value to switch parameter:

.SWIT4:	.IFF L$ASRT	.GOTO SWINNG
	.SETS V$'S$SWX' S$SWP
	.GOTO SWITLP

.; Syntax error section for switch parser:

.SWIBAD:; Error - Switch /'S$SWX' is invalid.
	.EXIT
.SWINPR:; Error - Switch /'S$SWX' may not have parameters.
	.EXIT
.SWINNG:; Error - Switch /'S$SWX' may not be negated.
	.EXIT
.SWIIVP:; Error - Switch /'S$SWX' has an invalid argument.
	.EXIT

.; Interactive section. Prompt for everything:

.PROMPT:.DISABLE LOWERCASE
	.ASKS S$FIL What file name
	.ASKS [::"TI:"] S$OUT What output file name
	.ASK [V$BR] V$BR Do you want page breaks and titles
	.ASK [V$SP] V$SP Shall I spool your output file
	.ENABLE LOWERCASE

.; Open the files:

.PROCES:.IF S$OUT = ""	.SETS S$OUT "TI:"
	.OPENR 'S$FIL'
	.OPEN #1 'S$OUT'
	.IFF V$BR	.SETN D$CURL 0.
	.IFF V$BR	.SETN D$INCR 0.

.; Read the next record:

.RDLP:
	.READ S$REC
	.IFT <EOF>	.GOTO CLOS

.; Strip off the first two bytes, and convert to numeric:

	.SETS S$B0 S$REC[1:1]
	.SETS S$B1 S$REC[2:2]
	.SETN O$W ('S$B1%V'&377)*400+('S$B0%V'&377)

.; Record type 2 signals end of items of interest:

	.IF O$W = 2	.GOTO CLOS

.; Record type 1 is what we want. Loop for others:

	.IF O$W <> 1	.GOTO RDLP

.; Strip off the record type:

	.SETS S$REC S$REC[3:*]

.; Process each symbol in the record:

.SYLP:
	.IF S$REC = ""	.GOTO RDLP

.; The symbol name is 6 RAD-50 characters; extract it from the
.;		4 bytes it is stored in, and convert to ASCII:

	.SETS S$B0 S$REC[1:1]
	.SETS S$B1 S$REC[2:2]
	.SETN O$W ('S$B1%V'&377)*400+('S$B0%V'&377)
	.SETS S$SYM "'O$W%X'"
	.SETS S$B0 S$REC[3:3]
	.SETS S$B1 S$REC[4:4]
	.SETN O$W ('S$B1%V'&377)*400+('S$B0%V'&377)
	.SETS S$SYM "'S$SYM''O$W%X'"

.; The flags byte is stored in binary; extract it:

	.SETS S$B0 S$REC[5:5]
	.SETN O$FLG 'S$B0%V'&377

.; The symbol type is stored in a binary byte; extract it:

	.SETS S$B1 S$REC[6:6]
	.SETN O$TYP 'S$B1%V'&377

.; The symbol value is stored as a binary word; Extract it:

	.SETS S$B0 S$REC[7:7]
	.SETS S$B1 S$REC[10:10]
	.SETN O$B0 'S$B0%V'&377
	.SETN O$B1 'S$B1%V'&377
	.SETN O$VAL O$B1*400+O$B0

.; Strip the current symbol out of the record:

	.SETS S$REC S$REC[11:*]
	.SETS S$REM ""

.; Dispatch according to the type byte:

	.IF O$TYP > 10	.GOTO BADTYP
	.GOTO TYP'O$TYP'

.; Unrecognized type:

.BADTYP:.SETS S$TYP "Unrecognized"
	.SETS S$REM "Symbol type = 'O$TYP'"
	.GOTO TYPX

.; Type 0 = module name definition (from .TITLE):

.TYP0:	.SETS S$TYP "Module name"
	.GOTO TYPX

.; Type 1 = CSECT definition:

.TYP1:	.SETS S$TYP "CSECT name"
	.GOTO TYPX

.; Type 2 = Local symbol name:

.TYP2:	.SETS S$TYP "Internal symbol name"
	.GOTO TYPX

.; Type 3 = Transfer address (from .EXIT label):

.TYP3:	.SETS S$TYP "Transfer address"
	.GOTO TYPX

.; Type 4 = Global symbol name; interpret flags into remarks 
.;		field:

.TYP4:	.SETS S$TYP "Global symbol name"
	.IF O$ZERO <> O$FLG&1	.SETS S$REM "'S$REM',WEAK"
	.IF O$ZERO <> O$FLG&4	.SETS S$REM "'S$REM',LIBR"
	.IF O$ZERO = O$FLG&10	.SETS S$REM "'S$REM',REF"
	.IF O$ZERO <> O$FLG&10	.SETS S$REM "'S$REM',DEF"
	.IF O$ZERO = O$FLG&40	.SETS S$REM "'S$REM',ABS"
	.IF O$ZERO <> O$FLG&40	.SETS S$REM "'S$REM',REL"
	.SETS S$REM S$REM[2:*]
	.GOTO TYPX

.; Type 5 = PSECT definition (from .PSECT); interpret
.;	attributes from flag byte into remarks field:

.TYP5:	.SETS S$TYP "PSECT name"
	.IF O$ZERO <> O$FLG&1	.SETS S$REM "'S$REM',SAVE"
	.IF O$ZERO <> O$FLG&2	.SETS S$REM "'S$REM',LIBR"
	.IF O$ZERO = O$FLG&4	.SETS S$REM "'S$REM',CON"
	.IF O$ZERO <> O$FLG&4	.SETS S$REM "'S$REM',OVR"
	.IF O$ZERO = O$FLG&20	.SETS S$REM "'S$REM',RW"
	.IF O$ZERO <> O$FLG&20	.SETS S$REM "'S$REM',RO"
	.IF O$ZERO = O$FLG&40	.SETS S$REM "'S$REM',ABS"
	.IF O$ZERO <> O$FLG&40	.SETS S$REM "'S$REM',REL"
	.IF O$ZERO = O$FLG&100	.SETS S$REM "'S$REM',LCL"
	.IF O$ZERO <> O$FLG&100	.SETS S$REM "'S$REM',GBL"
	.IF O$ZERO = O$FLG&200	.SETS S$REM "'S$REM',I"
	.IF O$ZERO <> O$FLG&200	.SETS S$REM "'S$REM',D"
	.SETS S$REM S$REM[2:*]
	.GOTO TYPX

.; Type 6 = Version identifier (from .IDENT):

.TYP6:	.SETS S$TYP "Version identifier"
	.GOTO TYPX

.; Type 7 = Virtual array definition:

.TYP7:	.SETS S$TYP "Virtual array name"
	.GOTO TYPX

.; Type 10 = Completion routine declaration:

.TYP10:	.SETS S$TYP "Completion routine name"
	.GOTO TYPX

.; Output code for all types:

.TYPX:	.SETN D$CURL D$CURL+D$INCR
	.IF D$CURL <= D$MAXL	.GOTO TYPXX

.; Emit header if needed:

	.DATA #1 'S$FF'          Symbol dump of file 'S$FIL'
	.DATA #1  
	.DATA #1    Symbol Description     Name  Flg  Value   Remarks
	.DATA #1  
	.SETN D$CURL 5.

.; Emit the individual record:

.TYPXX:	.DATA #1  'S$TYP%R23' 'S$SYM%L6' 'O$FLG%R3Z' 'O$VAL%R6Z' 'S$REM'
	.GOTO SYLP

.; All done; close files and exit:

.CLOS:	.CLOSE
	.CLOSE #1
	.IFT V$SP	'S$MCR'PIP 'S$OUT'/SP
	.EXIT
