/7	OVERLAY 23 (OVRS)
/	7-MAR-78	INSTALLED PATCH TO PREVENT HALT WHEN
/			EXPUNGING A MACRO
/	16-AUG-78	FIXED BUG IN EXPUNGE
/			CAN'T EXPUNGE .LISTWD OR .ENABWD
/	17-AUG-78	ALLOW > ON FIXTAB AND EXPUNGE STATEMENTS
	.INCLUDE MGLOB.MA
	.ASECT OVRS,LEVEL=2,OVERLAY=2
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1977 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
	.EXTERNAL ASEMLV,BACKUP,BRANCH,CREF,CRLF,DPRINT,ENTER,EOS,ERROR,EXPR
	.EXTERNAL FSCHEK,GETCHR,GETKAR,GETSYM,LETTER,LISTER,LOOKUP,ORIG,OUT,PARSYM
	.EXTERNAL PASS3,POP,PUSH,PUNBIT,PUTBIT,PUTSYM,PUXBIN,READLN,ROTL6,SCAN
	.EXTERNAL BUKETS,BUKFLG
	FIELD 4
	.GLOBAL ER2,ER3,ER221
	.GLOBAL $FIXTAB,$EXPUNGE
	*2000

	23		/OVERLAY NUMBER

/	FIXTAB DIRECTIVE

/	FIXTAB A,B,C,...
/	WORKS ON ALL PASSES. MAKES THE SPECIFIED SYMBOLS PERMANENT.
/	IF NO SYMBOLS SPECIFIED, THEN ALL DEFINED SYMBOLS BECOME PERMANENT
/	BUT ONLY ON PASS 1 (EXCEPT WHEN MODIFIED BY AN ENABLE EXPUNGE).

$FIXTAB,JMS I QQSCAN	/IGNORE BLANKS
	TAD CHAR
	TAD (-76
	SZA CLA
	JMS I QQEOS	/ANY ARGS?
	JMP FIXALL	/NO, FIX ALL SYMBOLS
FXT2,	JMS I QQLETTER	/YES, FIX LIST
	JMP ER221	/NOT A LETTER, ERROR
	JMS I QQPARSYM	/GET IDENTIFIER
	JMS I QQLOOKUP	/LOOK HIM UP
	JMS I QQENTER	/ENTER HIM IF NOT THERE
	JMS I QQGETSYM	/GET INFO ON GUY
	TAD FLAG
	AND (6777
	TAD (1000	/SET PERM BIT
	DCA FLAG
	JMS I QQPUTSYM	/PUT INFO BACK
	JMS I QQSCAN	/IGNORE SPACES
	TAD CHAR
	TAD (-76
	SZA CLA
	JMS I QQEOS	/AT END OF LINE?
	JMP I (PSEUDB	/YES
	TAD CHAR	/NO
	TAD (-54
	SZA CLA
ER221,	JMS I QQERROR	/MISSING COMMA
	JMS I QQGETCHR
	JMS I QQSCAN
	JMP FXT2
/	FIX ALL SYMBOLS

FIXALL,	STA
	TAD PASS
	SZA CLA
	JMP I (PSEUDB
	TAD (BUKETS-1
	DCA BUKPTR	/GET SET TO GO THROUGH BUCKETS
	TAD (-77
	DCA KNT
FIX2,	ISZ BUKPTR	/GO TO NEXT BUCKET
	TAD I BUKPTR	/GET POINTER
FIX3,	CDF 0
	SNA
	JMP FIX4	/END OF CHAIN
	DCA SYMNUM	/HAVE A NEW CHUNK POINTER
	TAD SYMNUM
	JMS I (CNVADR
	DCA LPTR
	TAD LPTR
	TAD (5
	DCA TEMP	/POINT TO FLAG WORD
	TAD I TEMP
	AND (6777
	TAD (1000	/SET PERM BIT
	DCA I TEMP	/STORE IT BACK
	TAD I LPTR	/GET PTR TO NEXT CHUNK
	JMP FIX3

FIX4,	ISZ KNT
	JMP FIX2
	JMP I (PSEUDB	/DONE

BUKPTR,	0
/	EXPUNGE ALL REGULAR SYMBOLS.
/	PASS 1 ONLY (INDEPENDENT OF .ENABLE).
/	DOES NOT EXPUNGE LSD ENTRIES, MACROS, DIRECTIVES, ETC.

DOALL,	STA
	TAD PASS
	SZA CLA		/WHAT PASS IS THIS?
	JMP I (PSEUDB	/NOT PASS 1 - IGNORE THIS DIRECTIVE
	TAD (BUKETS-1	/PASS 1
	DCA BKPTR	/GET READY TO GO THROUGH THE BUCKETS
	TAD (-77
	DCA KNT
DO2,	ISZ BKPTR	/GO TO NEXT BUCKET
	DCA OLDNUM	/NOTE THAT FACT BY 0 IN 'OLDNUM'
	TAD I BKPTR	/GET POINTER
DO5,	CDF 0
	SNA
	JMP DO6		/END OF CHAIN
	DCA SYMNUM	/SAVE NEW CHUNK POINTER
	TAD SYMNUM
	JMS I (CNVADR
	DCA LPTR
	RDF
	SNA CLA
	JMP K$		/CAN'T EXPUNGE .LISTWD
	TAD LPTR
	TAD (5
	DCA TEMP	/POINT TO FLAG WORD
	TAD I TEMP	/LOOK AT FLAG WORD
	AND QQ77
	SNA CLA		/WHAT KIND OF SYMBOL HAVE WE HERE?
	JMP DO4		/A REGULAR SYMBOL - EXPUNGE IT
K$:	TAD SYMNUM	/NOT A REGULAR SYMBOL - KEEP IT
	DCA OLDNUM	/THIS BECOMES NEW PREVIOUS CHUNK
	TAD I LPTR	/GET PTR TO NEXT CHUNK
	JMP DO5

/CURRENT CHUNK IS TO BE EXPUNGED

DO4,	TAD I LPTR	/GET PTR TO NEXT CHUNK
	DCA TEMPC	/SAVE IT
	TAD FREEPTR
	DCA I LPTR	/LINK THIS CHUNK ONTO BEGINNING
	TAD SYMNUM	/OF FREE LIST
	DCA FREEPTR
	CDF 0
	TAD OLDNUM	/POINT PREVIOUS CHUNK TO NEXT ONE
	SZA
	JMP .+3
	TAD BKPTR
	SKP
	JMS I (CNVADR
	DCA LPTR
	TAD TEMPC
	DCA I LPTR
	TAD I LPTR
	JMP DO5

DO6,	ISZ KNT		/LAST BUCKET?
	JMP DO2		/NO
	JMP I (PSEUDB	/YES, DONE

TEMPC,	0
OLDNUM,	0		/HOLDS PTR TO PREVIOUS CHUNK
			/OR 0 MEANING PREVIOUS PTR WAS IN BUCKET POINTED TO BY BKPTR
BKPTR,	0		/POINTS INTO BUCKETS
	PAGE
/	EXPUNGE DIRECTIVE

$EXPUNGE,DCA XFLAG
	TAD I (ENABWD
	RTL		/EXPUNGE BIT TO SIGN
	SPA CLA		/IS EXPUNGE ENABLED TO WORK ON ALL PASSES?
	JMP PUNGE	/YES
	STA		/NO, ONLY ON PASS 1
	TAD PASS	/IN THAT CASE,
	SZA CLA		/WHAT PASS IS THIS?
	ISZ XFLAG	/NOT PASS 1 - NOTE THAT EXPUNGE SHOULD NOT WORK
			/BUT DO SYNTAX CHECKING ANYHOW
PUNGE,	JMS I QQSCAN	/IGNORE BLANKS
	TAD CHAR
	TAD (-76
	SZA CLA
	JMS I QQEOS	/ANY ARGS?
	JMP I (DOALL	/NO, EXPUNGE ALL REGULAR SYMBOLS
PUNG2,	JMS I QQLETTER	/YES, EXPUNGE JUST THOSE SYMBOLS MENTIONED
	JMP ER2		/NOT A LETTER, ERROR
	JMS I QQPARSYM	/GET IDENTIFIER
	JMS I QQLOOKUP	/LOOK HIM UP
	JMP PUNG3	/NOT THERE - FINE
	TAD XFLAG
	SZA CLA
	JMP PUNG3	/DO NOTHING IF WRONG PASS
	JMS I QQGETSYM	/GET INFO ON GUY
	TAD SYMNUM
	AND QQ7000
	SNA CLA
	JMP ER2		/CAN EXPUNGE SPECIAL SYMBOL IN FIELD 0
	TAD FLAG	/LOOK AT FLAG
	AND (74
	SZA CLA
	JMP ER2		/NOT ALLOWED TO EXPUNGE A GLOBAL (MEMBER OF LSD)
	STA		/OR A SECT NAME
	TAD FLAG
	AND QQ7
	SNA CLA
	CLA		/*** DO SPECIAL STUFF TO EXPUNGE A MACRO
	DCA SYMVAL
	DCA FLAG
	DCA SYMSCT
	DCA QUAL
	JMS I QQPUTSYM	/0 MAIN ENTRIES
	TAD FREEPTR
	DCA XTEMP
	TAD SYMNUM
	DCA FREEPTR
	TAD SYMNUM	/DELETE SYMBOL TABLE ENTRY
	JMS I (CNVADR
	DCA XPTR
	TAD I XPTR	/GET NEXT ITEM IN CHAIN
	DCA XSAV	/SAVE IT
	DCA I XPTR	/PRETEND THIS IS END OF CHAIN
	ISZ XPTR
	ISZ XPTR
	ISZ XPTR
	ISZ I XPTR
	CDF 0
	JMS I QQLOOKUP	/TRY TO LOOK UP SYMBOL AGAIN
	SKP		/MUST FAIL
	HLT		/A PHYSICAL IMPOSSIBILITY
/NOW SYMNUM POIINTS TO PREVIOUS CHUNK
/HOWEVER, IF BUKFLG IS NOT 0, THEN LPTR IS A
/12-BIT POINTER IN FIELD 0
	TAD I (BUKFLG
	SZA CLA
	JMP BUK
	TAD SYMNUM
	JMS I (CNVADR
	DCA LPTR
BUK,	TAD XSAV
	DCA I LPTR
/	CDF 0
/FREEPTR IS ORIGINAL SYMNUM
	TAD FREEPTR
	JMS I (CNVADR
	DCA XPTR
	TAD XTEMP
	DCA I XPTR
	CDF 0
PUNG3,	JMS I QQSCAN	/IGNORE SPACES
	TAD CHAR
	TAD (-76
	SZA CLA
	JMS I QQEOS	/AT END OF LINE?
	JMP I (PSEUDB	/YES
	TAD CHAR	/NO
	TAD (-54	/CHECK FOR COMMA
	SZA CLA
ER3,	JMS I QQERROR	/MISSING COMMA - PRETEND IT WAS ONE
	JMS I QQGETCHR	/PASS UP COMMA
	JMS I QQSCAN	/AND BLANKS
	JMP PUNG2	/GET NEXT NAME TO BE EXPUNGED

XFLAG,	0		/1 MEANS DON'T EXPUNGE ON THIS PASS
XTEMP,	0
XPTR,	0
XSAV,	0

ER2,	JMS I QQERROR
	JMP PUNG3
	PAGE