2!		PROGRAM		: BPCRF1
5!		VERSION		: V10.1
6!		EDIT		: A
7!		EDIT DATE	: 10-MAY-91
10	EXTEND
11	! &
	&
	&
	!		  C O P Y R I G H T &
	&
	&
  !		      Copyright (C) 1977, 1991 by &
  !	        Digital Equipment Corporation, Maynard, Mass. &
  !	&
  !	&
  !	This software is furnished under a license and may be used and &
  !	copied  only  in accordance with the terms of such license and &
  !	with the  inclusion  of  the  above  copyright  notice.   This &
  !	software  or  any  other copies thereof may not be provided or &
  !	otherwise made available to any other person.  No title to and &
  !	ownership of the software is hereby transferred. &
  !	&
  !	The information in this software is subject to change  without &
  !	notice  and should not be construed as a commitment by Digital &
  !	Equipment Corporation. &
  !	&
  !	DIGITAL assumes no responsibility for the use  or  reliability &
  !	of its software on equipment that is not supplied by DIGITAL. &
  !	&
  !******************************************************************* &
	&

20	! &
	&
	&
	!	M O D I F I C A T I O N    H I S T O R Y &
	&
	&

21	! VER/ED	EDIT DATE	REASON &
	! &
	! 9.5/REG	25-JAN-88	QUE TO PBS IF OPSER $QUE IS MISSING &
	&

100	! &
	&
	&
	!	G E N E R A L    D E S C R I P T I O N &
	&
	&

110	! BPCREF GENERATES A CROSS-REFERENCE LISTING OF BASIC-PLUS I &
	! COMPILED PROGRAMS.  EACH USE OF A VARIABLE IS INDICATED &
	! IN ONE OF THREE USAGE TYPES: &
	! 	" "	REFERENCE &
	! 	"@"	DESTRUCTIVE REFERENCE &
	! 	"#"	DEFINITION IN A "DEF FN" OR "DIM" STATEMENT. &
	! WHEN RUN, CREF REQUESTS INPUT AND OUTPUT FILES, AND THE &
	! LINE-WIDTH OF THE OUTPUT FILE.  THE DEFAULT EXTENSIONS ARE: &
	! 	.BAC	COMPILED INPUT FILE &
	!	.BAS	SOURCE INPUT FILE (OPTIONAL) &
	! 	.CRF	OUTPUT FILE &
	! IT IS BEYOND THE SCOPE OF THIS DOCUMENT TO DESCRIBE THE &
	! INTERNAL FORMAT OF BASIC-PLUS. &
	! &
	!
120	! &
	&
	!	A R R A Y   D I M E N S I O N I N G &

121	! &
	! IF YOU HAVE "MAXIMUM MEMORY EXCEEDED" ERRORS, YOU CAN &
	! REDIMENSION THE ARRAYS AS FOLLOWS: &
	! &
	! VAR$(), HEAD%(), TAIL%(), ADDR%() &
	!	THESE ARE IN-CORE ARRAYS USED TO STORE VARIABLE &
	!	NAMES, HASH KEYS, AND POINTERS TO REFERENCES. &
	!	BIGGER DIMENSIONS = MORE VARIABLES AND A GREATER &
	!	CHANCE OF "MAXIMUM MEMORY EXCEEDED". &
	!	THE DIMENSION + 1 MUST BE PRIME &
	!	THE DIMENSION - 1 SHOULD BE PRIME &
	!	AFTER REDIMENSIONING, CHANGE THE DEFINITION OF &
	!	VARIABLE HSIZE1% IN BPCREF.BAS. &
	! &
	! LINE.CORE%(), NEXT.CORE%() &
	!	THESE FORM AN IN-CORE BUFFER FOR REFERENCES. &
	!	BIGGER DIMENSIONS = A FASTER PROGRAM AND A GREATER &
	!	CHANCE OF "MAXIMUM MEMORY EXCEEDED". &
	!	SMALLER DIMENSIONS = A SLOWER PROGRAM (MORE DISK I/O) &
	!	AND THE POSSIBLITY OF CREFFING MORE (LONGER) VARIABLES. &
	!	IF THE DIMENSION IS LESS THAN 512, YOU WILL HAVE A VERY &
	!	SLOW PROGRAM.  IT MAY BE ZERO. &
	!	AFTER REDIMENSIONING, CHANGE THE DEFINITION OF VARIABLE &
	!	CORESIZE% IN THIS PROGRAM. &
	! &
	! IF YOU RUN OVER, TRY CHANGING LINE.CORE AND NEXT.CORE TO 768 &
	! AND/OR LOWERING THE NUMBER OF VARIABLES. &
	! CONSIDER ALSO SHORTENING THE VARIABLES IN YOUR PROGRAMS. &
	! MAYBE THEN, YOUR PROGRAM WON'T RUN OVER, TOO. &
	! &

300	! &
	&
	&
	!	I / O    C H A N N E L S &
	&
	&

301!	CHANNEL #		USED FOR &
   !
310!		1		FILE TO CREF &
	!	2		FILE TO CREF &
	!	3		OUTPUT FILE &
	!	4		SCRATCH AND COMMUNICATION FILE &
	!	5		SCRATCH FILE &
	!	6		INPUT SOURCE (IF USED) &

800	! &
	&
	&
	!	F U N C T I O N / S U B R O U T I N E    D E S C . &
	&
	&

801!	FUNCTION/SUBROUTINE		USE &
   !
810!		FNB0%(A%)		READ A BYTE AT ADDRESS A% &
   !		FNB1%(A%)		READ A BYTE AT ADDRESS A% &
   !		FNFREF%(A%,R%)		SEARCH FOR A FUNCTION REFERENCE &
   !		FNSETREF%(ADDR%,REF%)	INSERT A REFERENCE &
   !		FNIPC%(A%)		READ WORD AT A%+PROGRAM COUNTER &
   !		FNLREF%(I%)		INSERT A LINE NUMBER REFERENCE &
   !		FNP0$(Q%)		PRINT-USING EMULATOR &
   !		FNP1$(Q)		PRINT-USING EMULATOR &
   !		FNSETNAME%(ADDR%)	PUT A VALUE IN THE HASH-TABLE &
   !		FNSEARCH%(A%)		LOCATE A% IN THE HASH-TABLE &
   !		FNUNDEFINED		DUMMY FUNCTION FOR CREF PRINTOUT &
   !		FNVREF%(A%,R%)		ADD A VARIABLE-REFERENCE &
   !		FNW0%(A%)		READ A WORD AT ADDRESS A% &
   !		FNW1%(A%)		READ A WORD AT ADDRESS A% &

900	! &
	&
	&
	!	D I M E N S I O N    S T A T E M E N T S &
	&
	&

910	DIM  ADDR%(420), HEAD%(420), TAIL%(420), VAR$(420) &
		! VARIABLE TABLES (TABLE DIMENSION + 1 MUST BE PRIME) &
		! ADDR%()	STORES VARIABLE LOCATION FOR SEARCH &
		! HEAD%()	HEAD OF THE REFERENCE CHAIN &
		! TAIL%()	TAIL OF THE REFERENCE CHAIN &
		! VAR$()	STORES VARIABLE NAMES FOR SORTING &

920	DIM LINE.CORE%(1024), NEXT.CORE%(1024) &
		! LINE.CORE%()	LINE NUMBER REFERRED TO   (IN-CORE) &
		! NEXT.CORE%()	POINTER TO NEXT REFERENCE (IN-CORE) &
		! EDIT THE DIMENSION (AND THE DEFINITION OF VARIABLE &
		! CORESIZE% AT LINE 1110) TO INCREASE THE SPACE &
		! AVAILABLE FOR VARIABLE NAMES.  CURRENTLY, THERE IS &
		! ENOUGH ROOM FOR 250 VARIABLES, EACH 10 BYTES LONG. &

930	DIM #1%, P0%(32767)\ DIM #2%, P1%(32767) &
	\ DIM #4%, LINE.DISK%(8191)\ DIM #5%, NEXT.DISK%(8191) &
		! VIRTUAL ARRAYS FOR COMPILED CODE AND REFERENCE LISTS &
		! P0%(), P1%()	REFERENCE TO COMPILED BASIC-PLUS &
		! LINE.DISK%()	LINE NUMBER REFERRED TO (ON-DISK) &
		! NEXT.DISK%()	POINTER TO NEXT REFERENCE (ON-DISK) &
		! NOTE: THE PROGRAM DESIGN REQUIRES THE TABLE LIMIT &
		! THE ON-DISK ARRAYS ARE OPENED ONLY WHEN NEEDED. &

940	DIM REFTYPE$(3), CODETYPE%(255), S.IZE(2,3) &
		! INTERNAL TABLES: &
		! CODETYPE%()		INSTRUCTION TYPE CODE &
		! HEAD%()		HEAD OF REFERENCE CHAIN &
		! TAIL%()		TAIL OF REFERENCE CHAIN &
		! REFTYPE$()		MAPS REFERENCE TYPE &
		! S.IZE()		PROGRAM SIZE VALUES &

950	DIM #4%, COMM.CODE%(255%), COMM$(7)=64, COMM(1), COMM%(10) &
		! COMMUNICATION ARRAY FOR PASSING PARAMETERS &
		! COMM.CODE%()	PASSES CODE TABLE &
		! COMM$()	PASSES FILE NAMES AND STRINGS &
		! COMM()	PASSES TIME(0) AND TIME(1) &
		! COMM%()	PASSES FLAGS &

960!	DIM CPU(10), WALL(10), PHASE$(10) &
		! TIMING ARRAYS: &
		! CPU()		CPU TIME &
		! WALL()	CLOCK TIME &
		! PHASE$()	WHAT'S HAPPENING &
	&

999	! &
	&
	&
	! 	M A I N    C O D I N G    A R E A &
	&
	&

1000	! &
	&
	! 	G E T   P A R A M E T E R S   A N D   S E T U P &
	&

1010	VERSION$="V10.1-A" &
		! SET VERSION NUMBER &

1020	IF E0% <> 1% THEN &
	  PRINT IF CCPOS(0%) &
	  \ PRINT "BPCRF1	"; VERSION$; "	"; FNERR$(0%) &
	  \ PRINT "?Please run BPCREF"\ GOTO 32767 &

1100	! &
	&
	!	G E T   D A T A   F R O M   B P C R E F &
	&

1110	ON ERROR GOTO 19000 &
	\ CORESIZE% = 1024% &
	\ REFSIZE% = 8191% &
		! CORESIZE%	REF% < CORESIZE% MEANS "IN-CORE" &
		! REFSIZE%	TOTAL TABLE SIZE (REFSIZE% < 8192%) &

1120	NULL$ = "" &
	\ OPEN SYS(CHR$(7%)) FOR INPUT AS FILE 4% &
	\ CODETYPE%(Q%) = COMM.CODE%(Q%) FOR Q% = 0% TO 255% &
	\ BACFILE$	= COMM$(0%) &
	\ BASFILE$	= COMM$(1%) &
	\ LSTFILE$	= COMM$(2%) &
	\ TM1FILE$	= COMM$(3%) &
	\ TM2FILE$	= COMM$(4%) &
	\ PROG.NAME$	= COMM$(5%) &
	\ QCOMMAND$	= COMM$(6%) + COMM$(7%) &
	\ CLOCKTIME	= COMM(0%) &
	\ CPUTIME	= COMM(1%) &
	\ PAGESIZE%	= COMM%(0%) &
	\ LINESIZE%	= COMM%(1%) &
	\ QSWITCH%	= COMM%(2%) &
	\ HSWITCH%	= COMM%(3%) &
	\ HSIZE1%	= COMM%(4%) &
	\ CSWITCH%	= COMM%(5%) &
	\ GLOW%		= COMM%(6%) &
	\ GHIGH%	= COMM%(7%) &
	\ LLOW%		= COMM%(8%) &
	\ LHIGH%	= COMM%(9%) &
	\ DEBUG%	= COMM%(10%) &
	\ IF DEBUG% THEN PRINT "DEBUG ";\ STOP &
		! SETUP THE VARIABLES DEFINED IN GLCREF &
	&

1200	! &
	&
	!	O P E N   F I L E S   A N D   S E T U P &

1210	ON ERROR GOTO 1250\ JUNK$=SYS(CHR$(6%)+CHR$(-21%)+CHR$(255%)) &
	\ JUNK$ = BACFILE$\ OPEN BACFILE$ FOR INPUT AS FILE 1% &
	\ BACSIZE%=SWAP%(CVT$%(MID(SYS(CHR$(12%)),13%,2%))) + 1% &
	\ OPEN BACFILE$ FOR INPUT AS FILE 2% &
	\ JUNK$ = LSTFILE$\ OPEN LSTFILE$ FOR OUTPUT AS FILE 3% &
	\ JUNK$ = BASFILE$ &
	\ OPEN BASFILE$ FOR INPUT AS FILE 6% IF BASFILE$ <> NULL$ &
	\ JUNK$ = TM2FILE$ &
	\ OPEN TM2FILE$ FOR OUTPUT AS FILE 5%, CLUSTERSIZE -8%, FILESIZE 8% &
	\ KILL TM1FILE$\ KILL TM2FILE$ &
	\ ON ERROR GOTO 19000\ JUNK$=SYS(CHR$(6%)+CHR$(-21%)+CHR$(0%)) &
	\ GOTO 1260 &
		! OPEN ALL FILES, DROPPING PRIVILEGES TO DO SO &

1250	PRINT "?Can't open "; JUNK$; " -- "; FNERR$(ERR) &
	\ RESUME 19080 &
		! SORRY ABOUT THAT &

1260	SP% = FNW0%(514%)\ Q% = FNB0%(SP%+1%) &
	\ IF (BACSIZE% AND 3%) <> 0% &
			OR Q% < 1% OR Q% > 4% THEN &
	  PRINT "?"; BACFILE$; " is not a compiled BASIC-PLUS program" &
	  \ GOTO 19080 &
		! SP%		COMPILED-PROGRAM STACK POINTER &
		! MAKE SURE THE FILE SIZE IS CORRECT &
		! AND THAT THE COMPILED-CODE VERSION ID IS OK &

1270	LINESIZE7% = LINESIZE% - 7% &
	\ WIDEVAR% = 5%\ HSIZE2% = HSIZE1% - 2%\ HTABSIZE% = HSIZE1% - 1% &
	\  MISSEDREFS%, MISSEDVARS%, VARINDEX%, NOTHASHED%, VBYTES%, PTEST%, &
		NINSERTS%, NLINES%, NREFS%, NOPS%, ERRFLAG% = 0% &
 !	\ PHASE% = 0%\ CTIME=CPUTIME\ WTIME=CLOCKTIME &
		! INITIALIZE ALL THE COUNTERS: &
		! WIDEVAR%	THE LONGEST VARIABLE NAME &
		! HSIZE2%	REHASH HASHER (SHOULD BE PRIME) &
		! HTABSIZE%	HASH TABLE DIMENSION &
		! LINESIZE%	OUTPUT FILE LINE WIDTH &
		! MISSEDREFS%	REFERENCES MISSED (TABLE TOO SMALL) &
		! MISSEDVARS%	VARIABLES MISSED (VAR$ TOO SMALL) &
		! NINSERTS%	NUMBER OF VARIABLES IN HASH TABLE &
		! NLINES%	NUMBER OF BASIC-PLUS STATEMENTS &
		! NREFS%	NUMBER OF VARIABLE REFERENCES &
		! NOPS%		NUMBER OF BASIC-PLUS CODE OP'S &
		! NOTHASHED%	HASH-TABLE OVERFLOW COUNTER &
		! VARINDEX%	NUMBER OF VARIABLES IN SORT TABLE &
		! VBYTES%	NUMBER OF BYTES USED FOR VARIABLE STORAGE &
		! ERRFLAG%	ERROR OCCURRED - CAUSES LOOP EXIT &
		! CLOCKTIME	TOTAL (WALL-CLOCK) TIME USED &
		! CPUTIME	CPU TIME USED &
		! &
	&

1300	! &
	&
	!	I N I T I A L I Z E   F O R   C O L L E C T I O N &

1310	RESTORE &
	\ READ REFTYPE$(Q%) FOR Q% = 0% TO 3% &
	\ ADDR%(Q%),HEAD%(Q%) = 0% FOR Q% = 0% TO HTABSIZE% &
	\ VAR$(Q%) = NULL$ FOR Q% = 0% TO HTABSIZE% &
	\ PAGEHEAD$ = "Cross Reference Listing of "+PROG.NAME$+" on " &
		+DATE$(0%)+" at "+TIME$(0%) &
	\ PAGEPOS% = PAGESIZE%\ PAGE% = 0% &
	\ LF$=CHR$(10%)\ PREDEFINED$, FF$ = NULL$ &
	\ WHILE 1% &
	  \ READ VAR%, VAR$\ GOTO 1320 IF VAR% = 0% &
	  \ STOP IF FNSETNAME%(VAR%) < 0%\ VAR$(HLOC%) = VAR$ &
	  \ PREDEFINED$ = PREDEFINED$ + VAR$ + "\" &
	\ NEXT &
		! INITIALIZE HASH TABLE AND PAGE COUNTERS &
		! THEN PRINT HEADING NICELY CENTERED &
		! NOTE: NO <FF> BEFORE FIRST PAGE &
		! PAGE%		PAGE WE'RE PRINTING &
		! PAGEHEAD$	HEADING LINE TEXT &
		! PAGEPOS%	CURRENT LINE ON THE PAGE &
		! PAGESIZE%	MAXIMUM LINES PER PAGE &
		! LF$		LINE-FEED CHARACTER &
		! FF$		CHR$(12%) AFTER FIRST NEW PAGE &
		! PREDEFINED$	LIST OF WIRED-IN VARIABLES &

1320	SPDA% = FNW0%(SP%+28%) &
	\ SPTA%,SCTH% = FNW0%(SP%+30%)\ FPULEN% = FNB0%(SP%+38%) &
	\ FPUOFF% = 4%+2%*FPULEN%-2%\ VARTAB% = SPDA%+1214% &
		! GET POINTERS TO COMPILED CODE AREA: &
		! SPDA%		START OF DATA AREA (HAS VARIABLES) &
		! SPTA%		START OF TEXT AREA (HAS CODE ELEMENTS) &
		! SCTH%		START OF CODE (FIRST LINE HEADER) &
		! FPULEN%	LENGTH OF FLOATING-POINT DATA &
		! FPUOFF%	OFFSET IN VARIABLE DEFINITION FOR REALS &
		! VARTAB%	BASE OF THE VARIABLE TABLE &
		! &
		! NOTE ON BASIC-PLUS INTERNAL STORAGE: &
		! ALL DATA IS REFERENCED BY OFFSET FROM A FIXED HEADER: &
		! AS THE PROGRAM GROWS IN SIZE, THE TEXT AND DATA AREAS &
		! GROW INDEPENDENTLY.  WITHIN EACH MAJOR AREA (DATA AND TEXT) &
		! THERE ARE TWO TYPES OF DATA:  FIXED-LENGTH HEADERS &
		! AND (OPTIONAL) VARIABLE-LENGTH DATA ITEMS (SUCH AS &
		! STRINGS).  FOR EXAMPLE, A GOTO REFERENCE POINTS &
		! TO THE CODE LINE HEADER (SPTA% + ADDR%) WHICH, IN &
		! TURN, POINTS TO THE CODE LINE (SPTA% + POINTER%). &
		! VARIABLE REFERENCES POINT TO DATA ITEMS AT &
		! (SPDA% + ADDR%).  THIS IS USUALLY THE VALUE OF &
		! THE DATUM.  ONE EXCEPTION IS THE REFERENCE TO &
		! A FUNCTION WHICH WILL EITHER BE TO THE VALUE &
		! (FNX = 0) OR TO THE FUNCTION ENTRY (Y = FNX(Z)). &
		! &

2000	! &
	&
	!	C O P Y   S O U R C E   F I L E &

2010	GOTO 3000 IF BASFILE$ = NULL$ &
	\ ON ERROR GOTO 2100\ GOSUB 12400 &
	\ WHILE 1% &
	  \ GET #6%\ FSIZE% = RECOUNT\ FSTART% = 0% &
		! SETUP FOR COPYING -- PRINT AN INITIAL HEADING &
		! AND, FOR ALL BLOCKS, GET A BLOCK AND INITIALIZE &
		! COUNTERS: &
		! FSIZE%	RECORD SIZE &
		! FSTART%	LAST BYTE NOT TO LOOK AT (OR <FF>) &

2020	  FIELD #6%, FSTART% AS JUNK$, FSIZE%-FSTART% AS JUNK$ &
	  \ FPOS% = INSTR(1%, JUNK$, FF$) &
	  \ IF FPOS% = 0% &
	      THEN GOSUB 12800 &
	      ELSE FIELD #6%, FSTART% AS JUNK$, &
				FPOS%-1% AS JUNK$ &
		\ GOSUB 12800\ GOSUB 12300 &
		\ FSTART% = FSTART% + FPOS%\ GOTO 2020 &
		! FOR EACH BLOCK IN THE FILE: &
		! MAP (WHATEVER'S LEFT OF) THE ENTIRE RECORD, &
		! IF THERE IS NO <FF>, PRINT IT AND FALL THROUGH FOR &
		! THE NEXT RECORD.  IF A <FF> IS SEEN, PRINT THE &
		! FIRST PIECE, THEN A NEW PAGE, THEN REMAP THE REST &
		! OF THE BUFFER AND TRY AGAIN, EVENTUALLY WE'RE DONE &

2030	NEXT &
		! FOR THE WHOLE SHEBANG &

2100	GOTO 19000 IF ERR <> 11% &
	\ RESUME 2110 &

2110	CLOSE 6% &
		! THAT'S ALL WE NEED TO DO &
	&

3000	! &
	&
	!	S C A N   S Y M B O L   T A B L E &
	&

3010	 FOR LETTER% = 65% TO 90% &
	  \ W% = (LETTER% - 65%)*2% + VARTAB% &
	  \ Q% = FNW1%(W%)\ GOTO 3300 UNLESS Q% &
	  \ W%, W1% = W% + Q% &
		! FOR ALL LETTERS OF THE ALPHABET &
		! GET THE BASE OF THE LIST OF VARIABLES BEGINNING &
		! WITH THIS LETTER.  (IF NONE, GO FOR ANOTHER LETTER). &
		! OK, SETUP W% (-> LETTER'S CHAIN) AND &
		! W1% (-> VARIABLE'S VARIOUS TYPES) AND GO... &

3020	  VARNAME$ = CHR$(LETTER%) &
	  \ WHILE 1% &
	    \ W1% = W1% - 1%\ Q% = FNB0%(W1%)\ VBYTES% = VBYTES% + 1% &
	    \ GOTO 3030 IF (Q% AND 128%) &
	    \ VARNAME$ = VARNAME$ + CHR$(Q%) IF Q% &
	  \ NEXT &
		! VARNAME$	ENTIRE VARIABLE NAME &

3030	  VAR$ = VARNAME$\ VBYTES% = VBYTES% + (W1% AND 1%) &
	\ W1% = W1% AND -2%\ TYPE% = FNB0%(W1%) &
	  \ IF		TYPE% AND 8% THEN VALOFFSET% = 28% &
	    ELSE IF	TYPE% AND 4% THEN VALOFFSET% = 08% &
	    ELSE IF	TYPE% AND 2% THEN VALOFFSET% = FPUOFF% &
	    ELSE			  VALOFFSET% = 04% &
		! TYPE%		VARIABLE TYPE &
		! VALOFFSET%	OFFSET TO VARIABLE VALUE &
		! TYPE CODES ARE AS FOLLOWS: &
		!	 1	INTEGER &
		!	 2	REAL &
		!	 4	STRING &
		!	 8	ARRAY &
		!	16	FUNCTION &

3040	  VBYTES% = VBYTES% + VALOFFSET% + 2% &
	  \ VAR$ = "FN"+VAR$	IF TYPE% AND 16% &
	  \ VAR$ = VAR$+"%"	IF TYPE% AND 1% &
	  \ VAR$ = VAR$+"$"	IF TYPE% AND 4% &
	  \ IF TYPE% AND 8% THEN &
	      VAR$ = VAR$+"("+NUM1$(FNW0%(W1%-6%)) &
	      \ VAR$ = VAR$+","+NUM1$(FNW0%(W1%-4%)) IF FNW0%(W1%-4%) &
	      \ VAR$ = VAR$+")"\ Q% = FNB0%(W1%-18%) &
	      \ IF Q% THEN &
		  VAR$ = VAR$+"="+NUM1$(2%*FNW0%(W1%-8%)) IF TYPE% AND 4% &
		  \ VAR$ = VAR$+", #"+NUM1$(Q%/2%) &
		! FINISH OFF VARIABLE NAME, DEPENDING ON TYPE &
		! GET DIMENSIONS, STRING LENGTH AND CHANNEL &
		! VBYTES%	AMOUNT OF VARIABLE STORAGE &
		! VAR$		FULLY PREPARED VARIABLE NAME &
	&

3100	! &
	&
	! 	G O T   T H E   V A R I A B L E   N A M E &

3110	  WIDEVAR% = LEN(VAR$) IF LEN(VAR$) > WIDEVAR% &
	  \ Q% = FNSETNAME%(W1% - VALOFFSET% - SPDA%) &
	  \ IF Q% >= 0% THEN VAR$(HLOC%) = VAR$ &
	    ELSE PRINT #3%, "Multiply defined "; VAR$; IF Q% = -1% &
	      \ PRINT #3%, "No room to process "; VAR$; IF Q% = -2% &
	      \ GOSUB 12400 &
		! STORE THE VARIABLE NAME &

3200	  Q% = FNW0%(W1%-2%)\ IF Q% THEN W1% = Q%+W1%-1%\ GOTO 3030 &
		! ANOTHER VARIABLE WITH THIS NAME AND DIFFERENT TYPE? &

3210	  Q% = FNW0%(W%    )\ IF Q% THEN W%,W1% = Q%+W%\  GOTO 3020 &
		! ANOTHER VARIABLE WITH THIS FIRST LETTER? &

3300	NEXT LETTER% &
	\ WIDEVAR% = WIDEVAR% + 3% &
	\ VARNAME$ = SPACE$(WIDEVAR%) &
		! FINISH PROCESSING THE VARIABLE TABLE &
		! WIDEVAR%	WIDTH OF VARIABLE FIELD &
		! VARNAME$	VARIABLE NAME BUFFER &

4000	! &
	&
	! 	F I N D   A L L   V A R I A B L E   R E F E R E N C E S &
	&

4010	CODEHEAD% = SCTH% &
		! INITIALIZE FOR VARIABLE SCAN &
		! CODEHEAD%	-> CODE LINE HEADER &

4020	T% = FNW0%(CODEHEAD%) &
	\ GOTO 4200 IF (T% = 0%) OR (ERRFLAG% AND 2%) &
	\ CODEHEAD% = CODEHEAD%+T% &
	\ T% = FNB0%(CODEHEAD%+9%)\ GOTO 4020 IF T% = 4% OR T% = 5% &
	\ LINENO% = FNW0%(CODEHEAD%+10%) &
	\ ENDCODE%   = FNW0%(CODEHEAD%+04%)\ GOTO 4020 UNLESS ENDCODE% &
	\ CODE%,IPC% = FNW0%(CODEHEAD%+02%)+CODEHEAD% &
	\ CODEOFFSET% = 0%\ NLINES% = NLINES%+1% &
	\ IF T% = 1% THEN &
	    NEXTCODE% = FNVREF%(W%,3%) FOR W% = 2% TO ENDCODE%-3% STEP 2% &
	    \ GOTO 4020 &
		! NEW LINE SETUP - NOTHING TO DO IF DATA OR REMARK &
		! DO A DIMENSION STATEMENT IF WE SHOULD (T% = 1%) &
		! &
		! VARIABLE USAGE: &
		! CODEHEAD%	POINTER TO LINE HEADER &
		! CODE%		POINTER TO START OF CODE FOR THIS LINE &
		! CODEOFFSET%	WHERE WE ARE WITHIN THE LINE &
		! IPC%		"PROGRAM COUNTER" WITHIN CODE &
		! ENDCODE%	OFFSET TO END OF THIS LINE'S CODE &
		! LINENO%	CURRENT STATEMENT'S LINE NUMBER &
		! NEXTCODE%	OFFSET TO NEXT CODE BYTE &
		! &
		! LINE HEADER FORMAT: &
		! 0	OFFSET TO NEXT LINE &
		! 2	OFFSET TO FIRST CODE BYTE &
		! 4	OFFSET PAST END OF CODE FOR THIS LINE &
		! 9	LINE TYPE FLAG &
		! 10	LINE NUMBER &

4040	IPC% = CODE% + CODEOFFSET%\ NOPS% = NOPS% + 1% &
	\ ON CODETYPE%(FNB1%(IPC%)) GOSUB &
	    10100,10200,10300,10400,10500,10600,10700,10800,10900, &
	    10100,10600,10100,10100,11400,11500,11500,11700,11800,11900 &
		! JUMP ON STATEMENT TYPE &

4050	CODEOFFSET% = CODEOFFSET%+NEXTCODE%+1% &
	\ IF CODEOFFSET% >= ENDCODE% THEN 4020 ELSE 4040 &
		! STEP POINTER TO NEXT PUSH-POP CODE OR &
		! GOTO NEXT STATEMENT &
	&
	&

4200	! &
	&
	!	C O M P R E S S   V A R $   T A B L E &

4210	VARINDEX% = -1% &
	\ FOR Q% = 0% TO HTABSIZE% &
	  \ IF (LEN(VAR$(Q%)) > 0%) AND HEAD%(Q%) THEN &
	    VARINDEX% = VARINDEX% + 1% &
	    \ VAR$(VARINDEX%) = VAR$(Q%) &
	    \ TAIL%(VARINDEX%) = HEAD%(Q%) &
		! REMOVE EMPTY SLOTS &
		! NOTE -- THE HASH TABLE IS NOW AS FOLLOWS: &
		! VAR$(1..VARINDEX%)	VARIABLE NAMES &
		! TAIL%(1..VARINDEX%)	POINTERS TO REF LIST &
		! ADDR%(1..HSIZE1%)	HASH KEY TABLE &
		! HEAD%(1..HSIZE1%)	POINTERS TO REF LIST &
		! THIS IS NECESSARY SO WE CAN SORT VARIABLES, GETTING &
		! REFERENCES FROM TAIL%(); WHILE STILL LOOKING UP &
		! LINE NUMBERS, GETTING THEIR REFERENCES FROM HEAD%(). &

4220	NEXT Q% &
	&

5000	! &
	&
	!	S O R T   T H E   V A R I A B L E   T A B L E &

5010	GAP% = VARINDEX% + 1% &
		! SETUP FOR A SHELL SORT.  THE VARIABLES ARE: &
		! GAP%		COMPARISON "DISTANCE" &
		! TOPINDEX%	HOW HIGH TO LOOK FOR A SWITCH &
		! I%		COMPARE VAR$(I%) &
		! J%		WITH    VAR$(J%) &
		! FLAG%		SET IF THERE WAS AN EXCHANGE &

5020	WHILE GAP% > 1% &
	  \ GAP% = GAP% / 2%\ TOPINDEX% = VARINDEX% - GAP%\ FLAG% = -1% &
		! SETUP FOR THE NEXT PASS THROUGH THE TABLE &

5030	  WHILE FLAG% &
	    \ FLAG% = 0% &
		! ASSUME WE'LL MAKE IT THIS TIME &

5040	    FOR I% = 0% TO TOPINDEX% &
	      \ J% = I% + GAP% &
	      \ IF VAR$(I%) > VAR$(J%) THEN &
		  FLAG% = -1% &
		  \ VAR$ = VAR$(I%)\ VAR$(I%) = VAR$(J%)\ VAR$(J%) = VAR$ &
		  \ TAIL% = TAIL%(I%)\ TAIL%(I%) = TAIL%(J%)\ TAIL%(J%) = TAIL% &
		! IF OUT OF ORDER, EXCHANGE IT AND SET THE FLAG &

5050	    NEXT I% &
		! LOOK AT THE WHOLE TABLE &

5060	  NEXT &
		! UNTIL IT IS IN ORDER &

5070	NEXT &
		! UNTIL THE GAP IS CLOSED &

5100	! &
	&
	!	P R I N T   C R O S S - R E F E R E N C E S &

5110	GOSUB 12600 IF CSWITCH% &
	\ PTEST% = 1%\ GOSUB 12600 IF GLOW% > 0% OR GHIGH% < 32767% &
	\ PTEST% = 2%\ GOSUB 12600 IF LLOW% > 0% OR LHIGH% < 32767% &
	\ PTEST% = 0% &
		! DO THE VARIOUS PRINTOUTS &

7000	! &
	&
	!	P R I N T   S T A T I S T I C S &
	&

7010	GOSUB 12300 IF PAGEPOS% + 10% > PAGESIZE% &
	\ GOSUB 12400\ GOSUB 12400 &
	\ CLOCKTIME=CLOCKTIME-86400. IF CLOCKTIME>TIME(0%) &
	\ CLOCKTIME%,CLOCKTIME = TIME(0%) - CLOCKTIME &
	\ CPUTIME%,CPUTIME = (TIME(1%) - CPUTIME)/10. &
	\ PRINT #3%, FNP0$(VARINDEX%+1%+MISSEDVARS%); " Variables  "; &
			FNP0$(NREFS%);	" References "; &
			FNP0$(NLINES%);	" Statements " &
	\ PRINT #3%,	FNP0$(VBYTES%);	" Name bytes "; &
			FNP0$(NOPS%);	" Code bytes" &
	\ PRINT #3%,	FNP0$(CLOCKTIME%); " Total time "; &
			FNP0$(CPUTIME%);	" CPU time" &
	\ PRINT #3%, FNP0$(MISSEDVARS%); " Missed variables" &
			IF MISSEDVARS% > 0% &
	\ PRINT #3%, FNP0$(MISSEDREFS%); " Missed references" &
			IF MISSEDREFS% > 0% &
	\ PRINT #3%, FNP0$(NOTHASHED%); " Variables missed because"; &
				" of hash-table overflow" &
			IF NOTHASHED% > 0% &
		!SOME STATISTICS &

7020	Q%=0%\ Q0%=SPDA%\ GOSUB 12200\ Q%=1%\ Q0%=SPTA%\ GOSUB 12200 &
	\ S.IZE(0%,0%)=S.IZE(0%,0%)+512%+FNW0%(SP%+26%)-SP% &
	\ S.IZE(0%,2%)=S.IZE(0%,2%)+FNW0%(SP%+26%) &
	\ S.IZE(2%,Q%)=S.IZE(0%,Q%)+S.IZE(1%,Q%) FOR Q%=0% TO 3% &
	\ PRINT #3%\ PRINT #3%, "K-Words Reserved      Used      Free" &
	\ FOR Q%=0% TO 2% &
	  \ Q1=(S.IZE(Q%,0%)-S.IZE(Q%,1%))/2048.0 &
	  \ Q2=(S.IZE(Q%,2%)-S.IZE(Q%,3%))/2048.0 &
	  \ PRINT #3%, MID("  Data  Code Total",Q%*6%+1%,6%); &
		FNP1$(Q2); FNP1$(Q1); FNP1$(Q2-Q1) &
	\ NEXT Q% &
		! THE ABOVE UNREADABLE CODE COLLECTS PARTITION &
		! SIZE DATA, COMPUTES FREE SPACE, AND PRINTS IT. &
		! THE ALGORITHM IS LEFT AS AN EXERCISE FOR THE READER &

7050 !	PRINT #3%\ PRINT #3%, "      Clock time  CPU time" &
     !	\ PRINT #3%, "      ";  FNP1$(WALL(JUNK%)); FNP1$(CPU(JUNK%)); &
     !				"  "; PHASE$(JUNK%) &
     !			FOR JUNK% = 1% TO PHASE% &
		! PRINT TIMINGS IF THEY ARE COLLECTED &

7060	CLOSE 1%,2%,3%,4%,5% &
	\ IF QSWITCH% = 0% &
	  THEN GOTO 31200 IF ASCII(RIGHT(QCOMMAND$,LEN(QCOMMAND$))) = 255% &
	    \  GOTO 32767 &
		! DONE, CLOSE FILES AND EXIT UNLESS CHAINING &

7070	DETACH.FLAG%=(ASCII(RIGHT(QCOMMAND$,LEN(QCOMMAND$)))=255%) &
	\ DELETE.FLAG%=INSTR(1%,QCOMMAND$,"/DE") &
		! GET FLAGS WE WILL NEED &
	\ Z$=QCOMMAND$+"/" &
		! PUT A "/" AT THE END OF THE STRING FOR PROGRAMMING EASE &
	\ L%=LEN(Z$) &
		! GET THE LENGTH IF THE STRING &
	\ P1%=INSTR(1%,Z$,"=")+1% &
		! POINT P1 PAST THE END OF THE JOB NAME &
	\ P2%=INSTR(P1%,Z$,"/") &
		! POINT P2 PAST THE END OF THE FILE NAME &
	\ F$=CVT$$(MID(Z$,P1%,P2%-P1%),4%) &
		! GET THE FILE NAME &

7100	VF$=SYS(CHR$(6%)+CHR$(-10%)+F$) &
	\ VFN$=MID(VF$,5%,8%) &
	\ VFD$=MID(VF$,23%,4%) &
		! FSS THE FILE NAME AND PULL OUT THE GOOD PARTS &
	\ DEL%=(4% AND (DELETE.FLAG%<>0%)) &
		! SET UP A COUPLE OF USEFUL SWITCHES &
	\ V$=	CHR$(6%)+CHR$(-28%)	! OLD SPOOL SYS CALL &
		+CVT%$(SWAP%(0%))	! ZERO &
		+VFN$			! FILE NAME &
		+STRING$(4%,0%)		! SPOOL DEVICE NAME &
		+CVT%$(SWAP%(0%))	! ZERO &
		+CVT%$(SWAP%(		! FLAGS &
				16384%	!	PBS SPOOLER &
			OR 	DEL% ))	!	/DELETE AFTER PRINT &
		+CVT%$(SWAP%(0%))	! ZERO &
		+VFD$			! PRINT FILE DEVICE NAME &
		+STRING$(4%,0%)		! ZERO &

7110	ON ERROR GOTO 7130 &
		! TRAP ERRORS &
	\ Q$ = SYS(QCOMMAND$) &
	\ CHAIN "$QUE" LINE 31000% &
		! QUE AWAY IF QUEUING REQUESTED &
		! NOTE: ENTER $QUE.BAC AT "CHAIN ENTRY" &

7120	RETRY.COUNT%=RETRY.COUNT%+1% &
		! INCREMENT THE RETRY COUNT &
	\ V1$=SYS(V$) &
		! TRY THE SPOOL SYS CALL &
	\ GOTO 32767 UNLESS DETACH.FLAG%=255% &
		! LEAVE QUIETLY IF WE ARE NOT DETACHED &
	\ GOTO 31200 &
		! COMMIT HARI KARI IF WE ARE DETACHED &

7130	IF (ERR=4%) OR (ERR=32%) THEN &
		ON ERROR GOTO 0 IF RETRY.COUNT%>10% &
		\ RESUME 7120 &
	! PENDING SPOOL MESSAGES ARE AT MESSAGE MAX, OR &
	! NO SMALL BUFFERS AVAILABLE -- &
	! TRY AGAIN UP TO 10 TIMES, THEN GIVE UP &

7140	IF ERR=5% THEN &
		ON ERROR GOTO 0 IF RETRY.COUNT%>10% &
	\	RESUME 7160 &

7150	ON ERROR GOTO 0 &

7160	IF DETACH.FLAG%=0% THEN PRINT &
		"%OPSER Spooling Package not available," &
	\	PRINT "Queueing ";F$; &
	\	PRINT "/DELETE"; IF DELETE.FLAG%<>0% &
	\	PRINT " to Print/Batch Services..." &

7170	GOTO 7120 &
	! &
	! CAN'T FIND OPSER SPOOLER ACTIVE, &
	! IN WHICH CASE SWITCH SPOOLING PACKAGES (FROM OPSER TO PBS OR &
	! VICE-VERSA) AND TRY AGAIN.  AFTER 10 TRIES, GIVE UP. &
	&

10000	! &
	&
	!	S U B R O U T I N E S &
	&
	! SUBROUTINES TO PROCESS EACH BASIC-PLUS &
	! OPERATION TYPE.  NOTE THAT THE TYPE CODES &
	! STORED ARE THE "ACTUAL" TYPES + 2 TO QUICKEN &
	! THE "ON ... GOSUB" STATEMENT &
	! ACTUAL TYPES ARE DEFINED IN "PPCODE.MAT" &
	! &

10100	PRINT #I%, "?Unknown compiled code"; FNB1%(IPC%); "at line";LINENO% &
		FOR I%=0% TO 3% STEP 3%		!1	BAD CODE &

10200	NEXTCODE%=0%\ RETURN			!2	NO ARGS &

10300	NEXTCODE%=FNVREF%(1%,0%)\ RETURN	!3	1 NON-DES REF &

10400	NEXTCODE%=FNVREF%(1%,2%)\ RETURN	!4	1 DES REF &

10500	NEXTCODE%=FNLREF%(1%)\ RETURN		!5	LINE NUMBER &

10600	NEXTCODE%=2%\ RETURN			!6	CONSTANT IGNORED &

10700	W1%=FNB1%(IPC%+1%) &
	\ NEXTCODE%=FNLREF%(W%)	FOR W%=W1% TO 2% STEP -2% &
	\ NEXTCODE%=W1%+1%\ RETURN		!7	ON-GOTO LINES &

10800	NEXTCODE%=FNVREF%(1%,0%)+FNVREF%(3%,2%) &
	\ RETURN				!8	2 REF'S &

10900	NEXTCODE%=FNVREF%(1%,0%)+FNVREF%(3%,0%) &
		+FNVREF%(5%,2%)\ RETURN		!9	3 REF'S &

11400	NEXTCODE%=FNFREF%(1%,3%) &
	\ W%=FNW1%(FNI%(1%)+SPDA%+2%)\ W1%=2% &
	\ WHILE W% AND 3% &
	  \ W1%=W1%+2%\ W%=W%/4% &
	\ NEXT &
	\ NEXTCODE%=FNVREF%(W%,1%) FOR W%=W1% TO 4% STEP -2% &
	\ NEXTCODE%=W1%+1%\ RETURN		!14	FUNCTION DEF &
		! THE ABOVE COUNTS THE NUMBER OF FORMAL PARAMETERS &
		! IN THE FUNCTION DEFINITION (EACH IS TYPE-CODED IN &
		! TWO BITS), AND COLLECTS EACH FORMAL PARAMETER &

11500	NEXTCODE%=6%\ RETURN			!15,16	FOR, INT. MODIF. &

11700	NEXTCODE%=FNVREF%(1%,0%)+4%\ RETURN	!17	EXTERNAL NEXT &

11800	NEXTCODE%=3%\ RETURN			!18	SKIP TO FUN EXIT &

11900	NEXTCODE%=FNFREF%(1%,0%)\ RETURN	!19	FUN CALL &

12000	! &
	&
	!	S U B R O U T I N E S &

12100	! &
	&
	!	C O L L E C T   U N D E F I N E D   V A R I A B L E S &

12110	NONDEFINED$ = NONDEFINED$ + VAR$ + "\" &
			UNLESS INSTR(1%, PREDEFINED$, VAR$+"\") &
		! ADD IT TO THE LIST IF IT'S REALLY UNDEFINED &

12120	RETURN &

12200	! &
	&
	!	C O L L E C T   P R O G R A M    S I Z E S &

12210	S.IZE(Q%,Q1%)=FNW0%(Q0%+Q1%+Q1%+6%) FOR Q1%=0% TO 3% &
	\ RETURN &
		! THIS SUBROUTINE IS CALLED TO EXTRACT SIZE &
		! INFORMATION FROM THE SPDA AND SPTA HEADERS &
		! THE ALGORITHM (WHICH I DON'T UNDERSTAND) IS &
		! IDENTICAL TO THAT USED BY THE BASIC-PLUS &
		! GARBAGE-COLLECTION ROUTINE. &
	&

12300	! &
	&
	!	P R I N T   < N E W   P A G E > &

12310	PAGEPOS% = PAGESIZE% UNLESS PAGEPOS% = 4% &
		! GET A NEW PAGE UNLESS WE'VE JUST DONE ONE, &
		! AND FALL THROUGH TO ... &

12400	! &
	&
	!	P R I N T   < C R > < L F > &

12410	COLUMN% = 0% &
	\ PRINT #3%\ PAGEPOS% = PAGEPOS%+1% &
	\ GOTO 12490 UNLESS ((PAGEPOS% >= PAGESIZE% - 2%) AND PTEST%) &
			OR PAGEPOS% >= PAGESIZE% &
	\ PAGEPOS% = 4%\ PRINT #3%, FF$;\ FF$ = CHR$(12%) &
	\ IF HSWITCH% THEN PAGE% = PAGE%+1% &
	   \ PRINT #3%, TAB((LINESIZE% - LEN(PAGEHEAD$) - 9%)/2%); &
			PAGEHEAD$; TAB(LINESIZE%-8%); "Page"; PAGE% &
	   \ PRINT #3% &
		! COUNT LINES, WHEN WE REACH THE BOTTOM, SKIP TO &
		! THE TOP AND RESET THE COUNTER &
		! IF, OF COURSE, WE SHOULD DO ANYTHING AT ALL &

12420	IF PTEST% = 1% &
	  THEN PRINT #3%, TAB((LINESIZE%-40%)/2%); &
			"Global range is";GLOW%;"to";GHIGH% &
	    \ PRINT #3% &
		! PRINT THE GLOBAL RANGE HEADER IF NECESSARY &

12430	IF PTEST% = 2% &
	  THEN PRINT #3%, TAB((LINESIZE%-40%)/2%); &
			"Local range is";LLOW%;"to";LHIGH% &
	    \ PRINT #3% &
		! PRINT THE LOCAL RANGE HEADER IF NECESSARY &

12490	RETURN &

12500	! &
	&
	!	C O L L E C T   T I M I N G S &

12510 !	PHASE% = PHASE% + 1% &
      !	\ WALL(PHASE%) = TIME(0%) - WTIME &
      !	\ CPU(PHASE%) = (TIME(1) - CTIME)/10. &
      !	\ WTIME = TIME(0)\ CTIME = TIME(1) &
      !	\ RETURN &
		! STEP TIMING PHASE AND COLLECT THE ELAPSED TIME &
	&

12600	! &
	&
	!	P R I N T   R E F E R E N C E S &

12610	NONDEFINED$ = NULL$\ PAGEPOS% = PAGESIZE% IF PAGEPOS% > 4% &
	\ CODEHEAD% = SCTH%\ OLDLINE% = -32767% + 1% &
	\ WHILE FNW0%(CODEHEAD%) &
	  \ CODEHEAD% = CODEHEAD% + FNW0%(CODEHEAD%) &
	  \ LINENO% = FNW0%(CODEHEAD% + 10%) &
	  \ GOTO 12630 IF OLDLINE% = LINENO%\ OLDLINE% = LINENO% &
	  \ VAR$ = "# " + FNP0$(LINENO%) &
	  \ Q% = FNSEARCH%(LINENO%+LINENO%+1%) &
	  \ IF HFOUND% THEN &
	      GOSUB 12100 IF (FNW0%(CODEHEAD%+4%) = 0%) AND LINENO% &
	      \ Q% = FNPRINT%(HEAD%(HLOC%)) &
		! STARTING ON A NEW PAGE: &
		! FIRST DO LINE NUMBER REFERENCES STARTING AT THE TOP &
		! FOR EACH LINE OF CODE, CHECK FOR REFERENCE &
		! TO NON-EXISTANT LINES AND PRINT THE REFERENCES &
		! THE REFERENCE TO "CODEHEAD%+4%" TRAPS DUMMY LINES &
		! SOME LINE NUMBERS APPEAR TWICE IN THE CODE.  THUS, &
		! WE REMEMBER THE FACT THAT WE'VE PRINTED IT ALREADY &
		! IN OLDLINE%. &
		! CODEHEAD%	POINTS TO THIS LINE OF CODE &
		! OLDLINE%	LINE NUMBER JUST PRINTED &

12630	NEXT &
		! PRINT THEM ALL &

12640	FOR HLOC% = 0% TO VARINDEX% &
	  \ VAR$ = VAR$(HLOC%) &
	  \ GOSUB 12100 IF FNPRINT%(TAIL%(HLOC%)) &
		! PRINT VARIABLES, TOO &

12650	NEXT HLOC% &
	\ GOSUB 12400\ GOSUB 12400 &
	\ GOTO 12690 IF NONDEFINED$ = NULL$\ GOSUB 12400\ GOSUB 12400 &
	\ PRINT #3%, "Please check that the following variables"; &
			" have been referenced properly:" &
	\ COLUMN% = 0% &
	\ FOR Q1% = 1% STEP 0% WHILE Q1% < LEN(NONDEFINED$) &
	  \ Q0% = INSTR(Q1%,NONDEFINED$,"\") &
	  \ GOSUB 12400 IF COLUMN% + WIDEVAR% >= LINESIZE% &
	  \ PRINT #3%, MID(NONDEFINED$, Q1%, Q0%-Q1%); &
			SPACE$(WIDEVAR% - (Q0% - Q1%)); &
	  \ COLUMN% = COLUMN% + WIDEVAR%\ Q1% = Q0% + 1% &
		! PRINT THE ONCE-ONLY STUFF &

12660	NEXT Q1% &
		! AND FINISH WITH BLANK LINES &

12690	RETURN &
		! THAT DOES THE PRINTING &
	&
	&

12800	! &
	&
	!	P R I N T   S O U R C E   B U F F E R &
	&
	! THIS SUBROUTINE PRINTS THE SOURCE BUFFER (JUNK$) &
	! WHILE COUNTING LINES.  IT FORCES A FORM-FEED IF &
	! THE PAGE IS FULL. &

12810	LSTART%, LFPOS% = 0% &
		! LSTART%	JUST BEFORE THE CURRENT LINE &
		! LFPOS%	THE POSITION OF THE LINE-FEED &

12820	LFPOS% = INSTR(LFPOS%+1%, JUNK$, LF$) &
	\ IF LFPOS% = 0% THEN &
	    PRINT #3%, RIGHT(JUNK$, LSTART%+1%); &
	    \ RETURN &
		! LOOK FOR (ANOTHER) LINE-FEED.  IF THERE IS NONE, &
		! PRINT THE (REST) OF THE BUFFER AND RETURN &

12830	PAGEPOS% = PAGEPOS% + 1% &
	\ IF PAGEPOS% > PAGESIZE% THEN &
	    PRINT #3%,  MID(JUNK$, LSTART%+1%, LFPOS%-LSTART%-1%); &
	    \ GOSUB 12400\ LSTART% = LFPOS% &
		! GOT A LINE-FEED.  COUNT IT.  IF WE'RE AT THE &
		! BOTTOM OF THE PAGE, PRINT THE LEFT SIDE, THEN &
		! DO A <CR><LF> (WHICH MAKES THE NEW PAGE HAPPEN) &
		! FINALLY, RESET THE CURRENT BUFFER START &

12840	GOTO 12820 &
		! AROUND AND AROUND WE GO &
	&

13000	! &
	&
	!	F U N C T I O N S &
	&
	! VARIABLE REFERENCE ROUTINES.  FNFREF%, FNCREF%, AND FNVREF% &
	! ARE CALLED TO STORE A REFERENCE TO LINENO%. &
	! FNFREF% AND FNVREF% ALSO SPECIFY THE REFERENCE TYPE: &
	!	R% = 0%		READ REFERENCE (OR JUST A GOTO) &
	!	R% = 1%		DEFINITION (DIM OR DEF STATEMENT) &
	!	R% = 2%		DESTRUCTIVE (WRITE) REFERENCE &
	!	R% = 3%		FUNNY DEFINITION (VIRTUAL ARRAY) (?) &
	! ALL ROUTINES RETURN THE VALUE 2% TO HELP SETUP NEXTCODE%. &
	! &

13100	DEF* FNFREF%(A%,R%) = FNSETREF%(FNI%(A%)+4%,R%) &
		! &
	&
		! F N F R E F % ( A % , R % ) &
	&
		!	SPECIAL REFERENCE FOR FUNCTION CALLS AND &
		!	FUNCTION DEFINITIONS &
		! &

13200	DEF* FNLREF%(A%) &
		! &
	&
		! F N L R E F % ( A % ) &
	&
		!	LINE NUMBER REFERENCE FOR GOSUB, GOTO, &
		!	OR ON ERROR GOTO STATEMENTS &
		! &

13210	A%=FNI%(A%)\ A%=FNW0%(A%+SPTA%+10%) IF A% &
	\ FNLREF% = 2% &
	\ IF FNSETNAME%(A%+A% OR 1%) = -2% THEN &
	  GOSUB 12400\ PRINT #3%, "No room to process";A%; &
	  \ GOTO 13290 &
		! IF THE REFERENCE ISN'T TO LINE ZERO, GET &
		! THE LINE NUMBER WE'RE REFERRING TO. &
		! INSERT THE VARIABLE IF NEEDED, PRINT MESSAGE IF FULL &

13220	FNLREF%=FNSETREF%(A%+A% OR 1%, 0%) &
		! INSERT A REFERENCE TO LINE A% FROM LINENO% &

13290	FNEND &

13300	DEF* FNVREF%(A%,R%) = FNSETREF%(FNI%(A%), R%) &
		! &
	&
		! F N V R E F % ( A % , R % ) &
	&
		!	AN ORDINARY VARIABLE REFERENCE OR &
		!	A REFERENCE TO A FUNCTION'S VALUE. &
		! &
	&
	&

13500	! &
	&
	!	H A S H   T A B L E   R O U T I N E S &

13510	DEF* FNSEARCH%(ADDR%) &
		! &
	&
		! F N S E A R C H % ( A D D R % ) &
	&
		!	SEARCH THE HASH TABLE FOR ADDR% WHICH &
		!	MUST BE NON-ZERO. RETURN THE TABLE INDEX &
		!	(ALSO IN HLOC%).  SET FLAG HFOUND% TO ZERO &
		!	IF ADDR% WASN'T FOUND.  IF THE TABLE IS FULL, &
		!	PRINT AN ERROR MESSAGE AND SET ERRFLAG%. &

13610	REHASH% = (ADDR% XOR SWAP%(ADDR%)) AND 32767% &
	\ HLOC%,FIRST% = REHASH%-(REHASH%/HSIZE1%)*HSIZE1% &
	\ REHASH%      = REHASH%-(REHASH%/HSIZE2%)*HSIZE2% + 1% &
		! HASH/REHASH SETUP &
		! HLOC%		PROBE LOCATION &
		! REHASH%	USED TO GENERATE SUCCESSIVE PROBES &
		! FIRST%	CHECK THAT WE DON'T FILL UP &

13620	HFOUND% = ADDR%(HLOC%) &
	\ IF HFOUND% = ADDR% OR HFOUND% = 0% THEN &
	  FNSEARCH% = HLOC%\ GOTO 13650 &
		! LOOK AT THIS LOCATION &

13630	HLOC% = HLOC% - REHASH%\ HLOC% = HLOC% + HSIZE1% IF HLOC% < 0% &
	\ GOTO 13620 IF HLOC% <> FIRST% &
		! NOT HERE, GET A NEW PROBE UNLESS WE'RE FULL UP. &

13640	HFOUND% = 0%\ HLOC%,FNSEARCH% = -1% &
	\ IF (ERRFLAG% AND 1%) = 0% THEN &
	  ERRFLAG% = ERRFLAG% OR 1% &
	  \ PRINT #3%, "Variable table is full after"; &
			NINSERTS%; " Inserts"; &
	  \ PRINT #3%, " at line"; LINENO%; IF LINENO% &
	  \ GOSUB 12400\ PRINT "%Variable table full" &
		! PRINT THE BAD NEWS &

13650	FNEND &
	&

13700	DEF* FNSETREF%(ADDR%,REFTYPE%) &
		! &
	&
		! F N S E T R E F % ( A D D R % , R E F T Y P E % ) &
	&
		!	INSERT A REFERENCE (OF TYPE REFTYPE%) TO &
		!	LINENO% FOR WHATEVER ADDR% DESCRIBES.  IF &
		!	ADDR% IS NOT ALREADY IN THE HASH TABLE, IT &
		!	WILL BE ADDED.  FNSETREF% ALWAYS RETURNS 2% &
		!	TO PROPERLY INCREMENT NEXTCODE%.  AN ERROR &
		!	MESSAGE WILL BE PRINTED (AND ERRFLAG% SET) &
		!	IF THE REFERENCE TABLE IS FULL. &

13710	FNSETREF% = 2%\ Q% = FNSEARCH%(ADDR%) &
	\ GOTO 13790 IF HFOUND% = 0% &
		! SEARCH FOR THE VARIABLE,EXIT IF NOT THERE &

13720	NREFS% = NREFS% + 1% &
	\ IF NREFS% > REFSIZE% THEN MISSEDREFS% = MISSEDREFS%+1% &
	  \ GOTO 13790 IF MISSEDREFS% <> 1%\ ERRFLAG% = ERRFLAG% OR 2% &
	  \ PRINT #3%, "More than";REFSIZE%; &
			" References at line";LINENO%; &
	  \ GOSUB 12400\ PRINT "%Reference table full" &
	  \ GOTO 13790 &
		! STEP REFERENCE COUNTER, ERROR MESSAGE IF TROUBLE &

13740	Q% = NREFS% + NREFS%\ Q% = Q% + Q% &
	\ IF NREFS% >= CORESIZE% THEN &
	  LINE.DISK%(NREFS%-CORESIZE%) = LINENO% &
	  \ NEXT.DISK%(NREFS%-CORESIZE%) = REFTYPE% &
	  \ GOTO 13760 &
		! SET Q% TO NREFS% * 4% (WITHOUT FLOATING CONVERSION) &
		! IF ON-DISK, UPDATE THE ON-DISK ARRAYS. &
		! ELSE ... &

13750	  LINE.CORE%(NREFS%) = LINENO% &
	  \ NEXT.CORE%(NREFS%) = REFTYPE% &
		! STILL IN CORE, UPDATE THE IN-CORE TABLES &

13760	IF HEAD%(HLOC%) = 0% &
	  THEN HEAD%(HLOC%),TAIL%(HLOC%) = NREFS% &
	  ELSE TAIL% = TAIL%(HLOC%)\  TAIL%(HLOC%) = NREFS% &
	    \ IF TAIL% >= CORESIZE% &
	      THEN NEXT.DISK%(TAIL%-CORESIZE%) = &
			NEXT.DISK%(TAIL%-CORESIZE%) + Q% &
	      ELSE NEXT.CORE%(TAIL%) = NEXT.CORE%(TAIL%) + Q% &
		! IF THIS IS THE FIRST REFERENCE, SETUP A NEW CHAIN, &
		! ELSE, EXTEND THE CHAIN AND UPDATE THE PROPER ARRAY. &

13790	FNEND &
	&

13800	DEF* FNSETNAME%(ADDR%) &
		! &
	&
		! F N S E T N A M E % ( A D D R % ) &
	&
		!	INSERT ADDR% IN THE HASH TABLE.  RETURN: &
		!	-1%	MULTIPLY-DEFINED (ALREADY INSERTED) &
		!	-2%	HASH-TABLE IS FULL &
		!	>= 0%	NOT FOUND, HLOC% IS WHERE TO INSERT IT. &
		! &

13810	IF FNSEARCH%(ADDR%) < 0% &
	  THEN FNSETNAME% = -2% &
	    \ NOTHASHED% = NOTHASHED% + 1% UNLESS (ADDR% AND 1%) &
	    \ GOTO 13890 &
		! LOOK FOR THE ARGUMENT, STEP "MISSED" COUNTER &
		! IF WE'RE FULL AND IT'S A REAL VARIABLE &

13820	IF HFOUND% &
	  THEN FNSETNAME% = -1% &
	  ELSE FNSETNAME% = HLOC%\ ADDR%(HLOC%) = ADDR% &
	    \ NINSERTS% = NINSERTS% + 1% &
		! SET RETURN VALUE AND PUT ADDR% IN HASH &

13890	FNEND &
	&

14000	! &
	&
	!	G E T   D A T A   F R O M   . B A C   F I L E &
	&
	! WHILE THE DICTATES OF STRUCTURED PROGRAMMING WOULD SEEM &
	! TO SUGGEST THAT ONLY ONE ROUTINE (FNW0%) ACTUALLY ACCESS &
	! THE DATA, THIS IS A LESS EFFICIENT SOLUTION THAN THE &
	! ONE CHOSEN: &
	!    TWO SEPERATE COPIES (P0%() AND P1%()) OF THE .BAC &
	!	FILE ARE KEPT, ACCESSED BY FNW0% AND FNW1% TO KEEP &
	!	TWO DISTINCT BLOCKS IN CORE, THUS LOWERING THE &
	!	CHANCE OF BLOCK FAULTS. &
	! &
	!   THE CODE TO ACCESS DATA HAS BEEN DUPLICATED TO ELIMINATE &
	!	THE OVERHEAD OF FUNCTION CALLS. &
	! &

14100	DEF* FNW0%(A%) = P0%(A%/2% - 256%) &
		! &
	&
		! F N W 0 % ( A % ) &
	&
		!	GET A WORD GIVEN ITS ADDRESS &

14200	DEF* FNW1%(A%) = P1%(A%/2% - 256%) &
		! &
	&
		! F N W 1 % ( A % ) &
	&
		!	GET A WORD GIVEN ITS ADDRESS &

14300	DEF* FNB0%(A%) &
		! &
	&
		! F N B 0 % ( A % ) &
	&
		!	GET A BYTE GIVEN IT'S ADDRESS &

14310	Q% = P0%(A%/2% - 256%) &
	\ IF A% AND 1% &
	    THEN FNB0% = SWAP%(Q%) AND 255% &
	    ELSE FNB0% = Q% AND 255% &
		! GET THE CORRECT PIECE OF THE ACTION &

14320	FNEND &
	&

14400	DEF* FNB1%(A%) &
		! &
	&
		! F N B 1 % ( A % ) &
	&
		!	GET A BYTE GIVEN IT'S ADDRESS &

14410	Q% = P1%(A%/2% - 256%) &
	\ IF A% AND 1% &
	    THEN FNB1% = SWAP%(Q%) AND 255% &
	    ELSE FNB1% = Q% AND 255% &
		! GET THE CORRECT PIECE OF THE ACTION &

14420	FNEND &

14500	DEF* FNI%(A%) &
		! &
	&
		! F N I % ( A % ) &
	&
		!	GET A WORD RELATIVE TO THE CURRENT &
		!	INTERNAL PROGRAM COUNTER.  NOTE THAT THE &
		!	IPC IS A BYTE COUNTER.  THUS TWO WORDS &
		!	MAY HAVE TO BE MERGED. &

14510	A% = A% + IPC%\ Q% = A%/2% - 256% &
	\ IF A% AND 1% &
	    THEN FNI%	= (P1%(Q%) AND -256%) + (P1%(Q%+1%) AND 255%) &
	    ELSE FNI%	= SWAP%(P1%(Q%)) &
		! COMPILE THE WORD &

14520	FNEND &
	&

14600	DEF* FNP0$(Q%) &
		! &
	&
		! F N P 0 $ ( Q % ) &
	&
		!	PRINT-USING EMULATOR.  RETURN Q% RIGHT-JUSTIFIED &
		!	IN A FIVE BYTE FIELD. &
		! &

14610	Q$=NUM1$(Q%)\ FNP0$=SPACE$(5%-LEN(Q$))+Q$ &
		! CONVERT THE VALUE &

14620	FNEND &

14700	DEF* FNP1$(Q) &
		! &
	&
		! F N P 1 $ ( Q ) &
	&
		!	PRINT-USING EMULATOR.  RETURN Q RIGHT-JUSTIFIED &
		!	IN A 10-BYTE FIELD WITH TWO DECIMAL PLACES. &
		! &

14710	Q$=NUM1$(INT(Q*100.0 + .5)/100.0 + .001) &
	\ FNP1$=SPACE$(11%-LEN(Q$))+LEFT(Q$,INSTR(1%,Q$,".")+2%) &
		! CONVERT IT &

14720	FNEND &
	&

15000	! &
	&
	!	P R I N T   V A R I A B L E   R E F E R E N C E S &

15010	DEF* FNPRINT%(REFHEAD%) &
		! &
	&
		! F N P R I N T % ( R E F H E A D % ) &
	&
		! FNPRINT% IS CALLED TO PRINT REFERENCES TO VAR$. &
		! REFHEAD% POINTS TO THE REFERENCE CHAIN. &
		! FNPRINT% RETURNS -1% IF IT DOESN'T THINK THE &
		! REFERENCE IS CORRECTLY DEFINED. &
		! IT DOES NOTHING (AND RETURNS ZERO) IF NO &
		! PRINTING IS DESIRED &

15020	HEAD% = REFHEAD% &
	\ FNPRINT%, RWFLAGS% = 0% &
	\ GOTO 15100 UNLESS PTEST% &
		! START FOR "SHOULD WE PRINT IT" SEARCH &
		! ALWAYS PRINT FULL CREF &

15030	WHILE HEAD% &
	\ GOSUB 15300 &
	\ IF PTEST% = 2% &
	    THEN GOTO 15490 IF LINEREF% < LLOW% OR LINEREF% > LHIGH% &
	    ELSE RWFLAGS% = RWFLAGS% OR 1% &
			IF LINEREF% < GLOW% OR LINEREF% > GHIGH% &
		\ RWFLAGS% = RWFLAGS% OR 2% &
			IF LINEREF% >= GLOW% AND LINEREF% <= GHIGH% &
		! LOOK AT THIS ONE, EXIT &
		! IF LOCAL AND SOME REFERENCE'S GLOBAL &
		! IF GLOBAL, SET LOCAL/GLOBAL FLAG &

15040	NEXT &
	\ GOTO 15490 IF ((PTEST% = 1%) AND (RWFLAGS% <> 3%)) &
		! SCANNED THE CHAIN, EXIT IF NOT PRINTING &
		! THIS GLOBAL REFERENCE &
	&

15100	! &
	&
	!	P R I N T   T H E   R E F E R E N C E S &

15120	HEAD% = REFHEAD%\ RWFLAGS% = 0%\ LSET VARNAME$ = VAR$ &
	\ PAGEPOS% = PAGESIZE% IF PAGEPOS% + 3% > PAGESIZE% &
	\ COLUMN% = LINESIZE% &
	\ RWFLAGS% = 4% UNLESS INSTR(1%, VAR$, "(") &
	\ RWFLAGS% = 3% IF INSTR(1%, VAR$, "#") &
		! CLEAR THE VARIABLE FOR THE UNDEFINED LINE TEST &
		! AND MAKE THE VARIABLE NAME PRINT ON A NEW LINE &
		! VARNAME$	NAME FILLED OUT TO VARSIZE% LENGTH &
		! COLUMN%	WHERE WE ARE ON THE LINE &
		! RWFLAGS%	BIT-ENCODED DEFINITION TEST: &
		!		1	READ-REFERENCE &
		!		2	WRITE-REFERENCE &
		!		4	DEFINITION (IF DIMENSIONED) &
		!		ALL BITS MUST BE SET &

15130	WHILE HEAD% &
	  \ GOSUB 15300\ Q% = NEXTREF% AND 3% &
	  \ RWFLAGS% = RWFLAGS% OR 1% IF Q% = 0% &
	  \ RWFLAGS% = RWFLAGS% OR 2% IF Q% = 1% OR Q% = 2% &
	  \ RWFLAGS% = RWFLAGS% OR 4% IF Q% = 3% &
	  \ IF COLUMN% >= LINESIZE7% THEN GOSUB 12400 &
	      \ PRINT #3%, VARNAME$;\ COLUMN% = WIDEVAR% &
		\ LSET VARNAME$ = "" &
		! GET THE REFERENCE, DETERMINE IT'S TYPE AND &
		! PRINT A NEW LINE IF NECESSARY &

15140	  PRINT #3%, " ";  FNP0$(LINEREF%); REFTYPE$(Q%); &
	  \ COLUMN% = COLUMN% + 7% &

15160	NEXT &
	\ FNPRINT% = (RWFLAGS% <> 7%) &
	\ GOTO 15490 &
		! SET "ERRONEOUS REFERENCE" FLAG IF NEEDED &
		! AND EXIT &
	&

15300	! &
	&
	!	G E T   N E X T   R E F E R E N C E   S U B R O U T I N E &

15310	IF HEAD% >= CORESIZE% THEN &
	  NEXTREF% = NEXT.DISK%(HEAD%-CORESIZE%) &
	  \ LINEREF% = LINE.DISK%(HEAD%-CORESIZE%) &
	  \ GOTO 15350 &
		! NEW REFERENCE TO PRINT.  IF IT'S ON-DISK, &
		! GET THE DISK DATUM, ELSE ... &

15320	  NEXTREF% = NEXT.CORE%(HEAD%) &
	  \ LINEREF% = LINE.CORE%(HEAD%) &
		! GET THE DATUM FROM THE CORE-ARRAY &

15350	HEAD% = (NEXTREF% / 4%) AND 8191% &
		! NOW SET THE HEAD FOR THE NEXT ONE &

15390	RETURN &

15490	FNEND &
	&

16000	! &
	&
	!	D U M M Y   V A R I A B L E S &
	&
	!	THE FOLLOWING DUMMY FUNCTION ATTEMPTS TO FORCE &
	!	"UNDEFINED VARIABLE" ERRORS.  IT MAY BE DELETED &
	!	WHEN YOU TRUST THE PROGRAM. &

16010!	DEF* FNUNDEFINED(UNDEFINED1, UNDEFINED2) &
		! AN UNDEFINED FUNCTION AND PARAMETER &

16020!	UNDEFINED2, UNDEFINED3, UNDEFINED4(0) &
     !			 = LINE.16030.IS.UNDEFINED + UNDEFINED4(0) &
     !	\ GOTO 16030 &
		! SOME UNDEFINED REFERENCES &

16090!	FNEND &
		! THAT'S IT
19000	! &
	&
	!	F A T A L   E R R O R S   C O M E   H E R E &

19010	RESUME 19020 &

19020	E0% = ERR\ E1% = ERL &
	\ ON ERROR GOTO 0 &
	\ PRINT "BPCRF1 ";VERSION$; "	?Fatal error"; E0%; &
			"at line"; E1%; " -- "; FNERR$(E0%) &

19080	STOP IF DEBUG% &
	\ CLOSE Q% FOR Q% = 0% TO 12% &

19090	GOTO 32767 &
		! CAN'T DO MORE &

19900	DEF* FNERR$(Q%) &
		= CVT$$(RIGHT(SYS(CHR$(6%)+CHR$(9%)+CHR$(Q%)),3%),4%) &
		! &
	&
		! F N E R R $ ( Q % ) &
	&
		!	RETURN THE SYSTEM ERROR MESSAGE FOR Q% &
		! &
	&

20000	! &
	&
	!	D A T A   T A B L E S &
	&

20010	DATA	" ","#","@","#" &

22000	! &
	! RESERVED WORD TABLE. THE TABLE MUST END WITH THE ENTRY: &
	!	DATA	0,"" &
	! &

22010	DATA	-24,DET,	-60,ERL,	-26,ERR, &
		-58,LINE,	-30,NUM,	-34,NUM2, &
		-16,PI,		-54,RECOUNT,	-62,STATUS, &
	       	  0,"" &

31000	! &
	&
	!	C H A I N   E N T R Y &

31010	E0% = 1%\ GOTO 1000 &
		! WE'RE EXPECTING AN ENTRANCE HERE &

31100	! &
	&
	!	R E T U R N   F R O M   $ Q U E   P R O G R A M &

31110	JUNK$ = SYS(CHR$(7%)) &
	\ PRINT "?Couldn't queue file -- "; &
			MID(JUNK$,2%,INSTR(3%,JUNK$,CHR$(13%))-2%) &
				IF ASCII(JUNK$) <> 0% &
	\ GOTO 32767 IF ASCII(RIGHT(JUNK$,LEN(JUNK$))) <> 255% &
		! RETRIEVE CORE COMMON AND PRINT ERROR MESSAGE IF ANY &
		! EXIT IF DELETE FLAG IS CLEARED &

31200	! &
	&
	!	K I L L   M Y S E L F &

31210	ON ERROR GOTO 31250 &
	\ JUNK$ = SYS(CHR$(6%) + CHR$(8%) &
			+ CHR$(ASCII(SYS(CHR$(6%)+CHR$(9%)))/2%) &
			+ STRING$(23%,0%) + CHR$(0%) + CHR$(255%)) &
		! IT IS A FAR, FAR BETTER THING I DO TODAY, &
		! THAN I HAVE DONE BEFORE ... &
	&

31250	PRINT "?Unable to kill BPCREF job" &
	\ RESUME 32767 &
		! APPARENTLY NOT FAR ENOUGH &

32767	END
