1	ON ERROR GOTO 19000

	!		BDUMP.B2S

	!	Author:		Kelvin Smith
	!	Version:	02.00
	!	Last Edit:	05-Oct-88
	!
	!	Copyright (c) 1987, 1988, Financial Computer Systems, Inc.
	!
	!	BDUMP displays in both character and numeric format the
	! contents of a data file.  See the help message below, or the
	! documentation, for more information on how BDUMP works.
	!
	!	This program is provided as a service to the DEC community;
	! no warranty, express or implied, is made by the author or his
	! company regarding the function or fitness for any patricular
	! purpose of this program.  Please report any bugs to:
	!
	!	Kelvin Smith
	!	Financial Computer Systems, Inc.
	!	1 Strawberry Hill Ct.
	!	Stamford, CT  06902
	!	(203) 357-0504
	!
	!
	!	Edit log:
	!
	!	01.00	11/5/87		First working version.
	!
	!	02.00	10/5/88		Clean up for submission to DECUS.


900	MAP (INFIL)	WRD%(255%)
	MAP (INFIL)	WRD$(31%)  = 16%

	MAP (INFIL)	BYT$(511%) =  1%
	MAP (INFIL)	BY$(63%)   =  8%

	MAP (INFIL)	ALPHA$(7%) = 64%

	MAP (SPLIT)	RET$	= 30%	! Coming back from SYS(CHR$(12))

	MAP (SPLIT)	FILL$	=  4%, &
			PROG$	=  1%,	! Programmer # &
			PROJ$	=  1%,	! Project # &
			NAM1%,		! File name in RAD50 format &
			NAM2%,		!  continued... &
			TYP%,		! File type &
			FILL$	= 10%, &
			DISK$	=  2%,	! Disk type &
			UNIT$	=  1%,	! Unit number &
			UN.FLG$ =  1%	! Unit flag

990	GOSUB 10000					! Initialize

1000	LINPUT #1%, "BDUMP>"; CMD$
1010	CMD$ = EDIT$(CMD$, 32% + 16%)

	ST%  = 1%					! Assume full file
	STP% = 32767%
	SIZ% = 2%					! Assume word display
	WID% = 1%					! Normal width
	DEC% = 0%					! Octal standard

	S% = POS(CMD$, "/", 0%)
	IF S%
	   THEN FIL$ = LEFT(CMD$, S% - 1%)
		OPT$ = RIGHT(CMD$, S%)
	   ELSE FIL$ = CMD$
		OPT$ = ""
		ST%  = 1%				! Start with block 1

1100	GOTO 2000 UNLESS LEN(OPT$)
	I% = POS(OPT$, "/S", 0%)			! Start block number
	IF I%
	   THEN J% = POS(OPT$, "/", I% + 1%)
		J% = LEN(OPT$) + 1% UNLESS J%
		ST% = VAL%(SEG$(OPT$, I% + 3%, J% - 1%))
		OPT$ = LEFT(OPT$, I% - 1%) + RIGHT(OPT$, J%)

1200	I% = POS(OPT$, "/E", 0%)			! End block number
	IF I%
	   THEN J% = POS(OPT$, "/", I% + 1%)
		J% = LEN(OPT$) + 1% UNLESS J%
		STP% = VAL%(SEG$(OPT$, I% + 3%, J% - 1%))
		OPT$ = LEFT(OPT$, I% - 1%) + RIGHT(OPT$, J%)

1300	I% = POS(OPT$, "/B", 0%)			! List by bytes
	IF I%
	   THEN J% = POS(OPT$, "/", I% + 1%)
		J% = LEN(OPT$) + 1% UNLESS J%
		OPT$ = LEFT(OPT$, I% - 1%) + RIGHT(OPT$, J%)
		SIZ% = 1%

1400	I% = POS(OPT$, "/W", 0%)			! Wide listing
	IF I%
	   THEN J% = POS(OPT$, "/", I% + 1%)
		J% = LEN(OPT$) + 1% UNLESS J%
		OPT$ = LEFT(OPT$, I% - 1%) + RIGHT(OPT$, J%)
		WID% = 2%
		SIZ% = 1%				! Only by bytes

1500	I% = POS(OPT$, "/D", 0%)			! Use decimal
	IF I%
	   THEN J% = POS(OPT$, "/", I% + 1%)
		J% = LEN(OPT$) + 1% UNLESS J%
		OPT$ = LEFT(OPT$, I% - 1%) + RIGHT(OPT$, J%)
		DEC% = 1%

1600	I% = POS(OPT$, "/A", 0%)			! Alpha only--no #s
	IF I%
	   THEN J% = POS(OPT$, "/", I% + 1%)
		J% = LEN(OPT$) + 1% UNLESS J%
		OPT$ = LEFT(OPT$, I% - 1%) + RIGHT(OPT$, J%)
		SIZ% = 8%
		DEC% = 1%				! Always decimal

1700	I% = POS(OPT$, "/H", 0%)			! Help
	IF I%
	   THEN PRINT "BDUMP command format:"
		PRINT " OUTFILE=INFILE/OPTIONS"
		PRINT " If no =, output is to KB:"
		PRINT " If no OUTFILE, but = is present, output to INFILE.LST"
		PRINT " Default OUTFILE type is also .LST"
		PRINT
		PRINT "BDUMP switch options:"
		PRINT " /A - 64-character alpha lines only (decimal offsets)"
		PRINT " /B - Show numeric output by bytes"
		PRINT " /D - Use decimal numbering (default: octal)"
		PRINT " /E:n - End at block n"
		PRINT " /S:n - Start at block n"
		PRINT " /W - Print 16 bytes across (requires 88 columns)"
		PRINT
		PRINT "In ASCII output, nulls are represented by underscores"
		PRINT " and other control characters are represented by dots."
		PRINT
		PRINT "Octal block numbers plus offsets give ODT addresses."
		PRINT " (Example: Block 000002, Offset 340 = address 2340)"
		GOTO 1000

1999	IF LEN(OPT$)					! Something still here
	   THEN PRINT "Illegal switch:"; OPT$
		GOTO 1000

2000	I% = POS(FIL$, "=", 0%)				! An output file?
	IF I%
	   THEN OUT$ = LEFT(FIL$, I% - 1%)
		FIL$ = RIGHT(FIL$, I% + 1%)
		OUT$ = LEFT(FIL$, POS(FIL$, ".", 0%) - 1%) UNLESS LEN(OUT$)
		OUT$ = OUT$ + ".LST" UNLESS POS(OUT$, ".", 0%) ! Def: .LST
		OPEN OUT$  FOR OUTPUT AS FILE #3%
	   ELSE OPEN "KB:" FOR OUTPUT AS FILE #3%

2050	OPEN FIL$ FOR INPUT AS FILE #2%, MAP INFIL, MODE 8192%	! Read only
	RET$ = SYS(CHR$(12%))				! Return info
	IF (ASCII(UN.FLG$) AND 1% + 2%) = 3%
	   THEN FILNAM$ = DISK$ + NUM1$(ASCII(UNIT$))
	   ELSE FILNAM$ = "SY"

2060	FILNAM$ = FILNAM$ + ":" &
		+ "[" + NUM1$(ASCII(PROJ$)) &
		+ "," + NUM1$(ASCII(PROG$)) &
		+ "]" + RAD$(NAM1%) + RAD$(NAM2%) &
		+ "." + RAD$(TYP%)

	GET #2%, BLOCK ST%
	BLK% = ST%

2100  UNTIL EOF% OR BLK% > STP%

	PRINT #3%
	PRINT #3%, FILNAM$; "  Block"; BLK%;
	IF DEC%
	   THEN PRINT #3%
	   ELSE PRINT #3%, "("; FNOCTAL$(BLK% - 1%); ")"
		! Octal is one less to give proper offset for ODT.

2102	FOR I% = 0% TO 511% STEP 8% * WID% * SIZ%
		IF DEC%
		   THEN PRINT #3% USING "###/ ", I%;
		   ELSE PRINT #3%,RIGHT(FNOCTAL$(I%), 4%); "/ ";

2105		FOR J% = I% TO I% + (8% * WID% * SIZ%) - 1% STEP SIZ%
			IF SIZ% = 1%
			   THEN PRINT #3%, FNBYTE.OCTAL$(BYT$(J%)); " ";
			   ELSE &
			IF SIZ% = 2%
			   THEN PRINT #3%, FNOCTAL$(WRD%(J% / 2%)); " ";
2110		NEXT J%
		PRINT #3%, "*";
		IF SIZ% = 1%
		   THEN IF WID% = 1%
			   THEN PRINT #3%, XLATE(BY$(I% / 8%), X.TABLE$);
			   ELSE PRINT #3%, XLATE(BY$(I% / 8%), X.TABLE$); &
					   XLATE(BY$(I% / 8% + 1%), X.TABLE$);
		   ELSE &
		IF SIZ% = 2%
		   THEN IF WID% = 1%
			   THEN PRINT #3%, XLATE(WRD$(I% / 16%), X.TABLE$);
			   ELSE PRINT #3%, XLATE(WRD$(I% / 16%), X.TABLE$); &
					   XLATE(WRD$(I% / 16%+1%), X.TABLE$);
		   ELSE &
		IF SIZ% = 8%				! Alpha only
		   THEN PRINT #3%, XLATE(ALPHA$(I% / 64%), X.TABLE$);

2120		PRINT #3%, "*"
	NEXT I%
	PRINT #3%
	BLK% = BLK% + 1%
	GET #2%, BLOCK BLK%

2200  NEXT

	IF EOF%
	   THEN PRINT #3%, "End of file."
	   ELSE PRINT #3%, "Block"; STP%; "reached."

2999	GOTO 32767


10000	!	Initialization routines

	! Put here because it's needed for both run & CCL entry.

	OPEN "KB:" FOR INPUT AS FILE #1%

	X.TABLE$ = X.TABLE$ + CHR$(I%) FOR I% = 32% TO 126%
	X.TABLE$ = "_" + STRING$(31%, 46%) + X.TABLE$ + "." &
		 + "." + STRING$(31%, 46%) + X.TABLE$ + "." ! With parity set

	! Show a null as an underscore. This makes intermittent control
	! characters in the midst of nulls stand out rather than blend in.
	! A null with parity set, however, isn't really a null in the same
	! way, so mark it as a standard control character.

	RETURN


15000	DEF FNOCTAL$(F.NUM%)

	IF DEC%						! Decimal output
	   THEN F.I$ = FORMAT$(32768. + (F.NUM% EQV 32767%), "#####")
		GOTO 15090				! Use unsigned integer

15005	IF F.NUM% < 0%
	   THEN F.I$ = "1"
	   ELSE IF F.NUM% = 0%				! Optimize for 0
		   THEN F.I$ = "000000"
			GOTO 15090
		   ELSE F.I$ = "0"

15010	! The following lines essentially emulate a bit roll, then
	! chop off groups of three bits.  CHR$(x% + 48%) is considerably
	! faster than NUM1$(x%) for single-digit numbers.
	F.I$ = F.I$ + CHR$( (((F.NUM% AND 16384%) <> 0%) AND 4%) &
			   +(((F.NUM% AND  8192%) <> 0%) AND 2%) &
			   +(((F.NUM% AND  4096%) <> 0%) AND 1%) + 48%) &
		    + CHR$( (((F.NUM% AND  2048%) <> 0%) AND 4%) &
			   +(((F.NUM% AND  1024%) <> 0%) AND 2%) &
			   +(((F.NUM% AND   512%) <> 0%) AND 1%) + 48%) &
		    + CHR$( (((F.NUM% AND   256%) <> 0%) AND 4%) &
			   +(((F.NUM% AND   128%) <> 0%) AND 2%) &
			   +(((F.NUM% AND    64%) <> 0%) AND 1%) + 48%) &
		    + CHR$( (((F.NUM% AND    32%) <> 0%) AND 4%) &
			   +(((F.NUM% AND    16%) <> 0%) AND 2%) &
			   +(((F.NUM% AND     8%) <> 0%) AND 1%) + 48%) &
		    + CHR$(   (F.NUM% AND     7%)		 + 48%)

15090	FNOCTAL$ = F.I$
	FNEND

15100	DEF FNBYTE.OCTAL$(F.NUM$)			! Just three digits
	F.NUM% = ASCII(F.NUM$)
	IF DEC%
	   THEN F.I$ = FORMAT$(F.NUM%, "###")
		GOTO 15190

15110	F.I$ = CHR$( (((F.NUM% AND 128%) <> 0%) AND 2%) &
		    +(((F.NUM% AND  64%) <> 0%) AND 1%) + 48%) &
	     + CHR$( (((F.NUM% AND  32%) <> 0%) AND 4%) &
		    +(((F.NUM% AND  16%) <> 0%) AND 2%) &
		    +(((F.NUM% AND   8%) <> 0%) AND 1%) + 48%) &
	     + CHR$(   (F.NUM% AND   7%)		+ 48%)

15190	FNBYTE.OCTAL$ = F.I$
	FNEND


19000	! Error handler

	IF ERR = 11% AND ERL = 2120%
	   THEN EOF% = -1%
		RESUME 2200

19010	IF ERR = 52% AND ERL < 2000%
	   THEN PRINT "?Illegal number for switch argument."
		IF CCL%
		   THEN RESUME 32767
		   ELSE RESUME 1000

19020	IF ERR = 5% AND ERL = 2000%
	   THEN PRINT "?No such file: "; FIL$
		IF CCL%
		   THEN RESUME 32767
		   ELSE RESUME 1000

19999	ON ERROR GOTO 0


30000	!	CCL entry point

	ON ERROR GOTO 19000
	GOSUB 10000					! Initialize

	CCL$ = SYS(CHR$(7%))				! Get CCL command
	I% = POS(CCL$, " ", 0%)
	IF I% = 0%					! No filename given
	   THEN 1000 &
	   END IF

	CMD$ = RIGHT(CCL$, I% + 1%)			! Strip off CCL
	CCL% = -1%					! Note where we came
	GOTO 1010					! Do it

32767	CLOSE #1%, #2%, #3%
	END