Directory of image this file is from
This file as a plain text file
/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