.TITLE	SYMBOL
/
/   4 AUG 74 (JAS) OUTPUT A ZERO ADDRESS FOR SUBROUTINES & FUNCTIONS
/  17 SEP 73 (PDH) CHANGE DEVICE NUMBER REFERENCES TO SYMBOLIC
/   5 SEP 73 (PDH) ADD START ADDRESSES OF OTABLE & STATEMENT CODE
/   4 SEP 73 (PDH) PUT HEADING OVER SYMBOL TABLE COLUMNS
/   2 AUG 73 (PDH) REMOVE FORM FEED FROM BEGINNING OF OUTPUT
/
	.GLOBL SYMBOL
	.GLOBL G.SCAN,G.STPC,G.PACK,NUMS,G.CVRT,G.MOVE,G.OCTL
	.GLOBL GETADR,PAIRCT
	.GLOBL MODPTR,BITPTR,PTABLE,D,D1,PNAME,PNAM1,PNAM2,KIND
	.GLOBL	%TABLE,%START
/
/ THIS SUBPROGRAM GIVES A LISTING OF THE VARIABLES, STATEMENT NUMBERS,
/ AND COMMON BLOCKS IN THE SYMBOL TABLE. THIS LISTING IS OPTIONAL AND
/ GIVES RELEVENT INFORMATION ABOUT EACH OF THESE ELEMENTS.
/
/
/
/
/ THIS TABLE IS USED FOR TYPING OUT THE MODE OF VARIABLES
MODTAB	.ASCII 'L    '	/ LOGICAL
	.ASCII 'I*2  '	/ SINGLE INTEGER
	.ASCII 'I*4  '	/ DOUBLE INTEGER
	.ASCII 'UNK  '	/ UNKOWN NUMERIC
	.ASCII 'R*4  '	/ SINGLE REAL
	.ASCII 'R*8  '	/ DOUBLE REAL
	.ASCII 'NIN  '	/ NON-INTEGER
	.ASCII 'DNI  '	/ DOUBLE NON-INTEGER
	.ASCII 'C*8  '	/ SINGLE COMPLEX
	.ASCII 'UNC  '	/ UNDEFINED COMPLEX
	.ASCII 'C*16 '	/ DOUBLE COMPLEX
/
AY=101		/ ASCII 'A'
SPACE=040	/ ASCII & SIXBIT ' '
CAR=015		/ ASCII CARRIAGE RETURN
DOT=056		/ ASCII & SIXBIT '.'
EF=106		/ ASCII 'F'
ZRO=60		/ ASCII & SIXBIT '0'
/
CARAGE	.DSA	064000	/ ASCII 'CARRIAGE RETURN' IN 1ST CHAR
DOLLAR	.SIXBT <0><0><224>	/ ASCII & SIXBIT '$'
/
/ THIS TABLE CONTAINS ASCII DESCRIPTORS ABOUT WHETHER THE VARIABLE
/ IS DEFINED AND USED OR NOT.
DFNTAB	.ASCII 'UND,UNU   '	/ UNDEFINED,UNUSED
	.ASCII 'UND,USD   '	/ UNDEFINED,USED
	.ASCII 'DEF,UNU   '	/ DEFINED,UNUSED
	.ASCII 'DEF,USD   '	/ DEFINED,USED
/
FUNCT	.ASCII '(F)'<215>	/ SIGNIFIES A FUNCTION
/
/ MESSAGE TO BE PRINTED OUT AT START OF SYMBOL TABLE LISTING.
SYMMES	12002		/ 10 WORD PAIRS IN THE RECORD
	0
	.ASCII	'**** SYMBOL TABLE F'
PRTYPE	.BLOCK	6	/ EITHER 'OR MAIN/LINE' OR 'OR SUBPROGRAM'
PRNAME	.BLOCK	4	/ PROGRAM NAME
/
/
/ PROGRAM TYPES FOR INSERTION IN ABOVE MESSAGE
TMAIN	.ASCII 'OR MAIN/LINE  '
TSUB	.ASCII 'OR SUBPROGRAM '
/
/
/ MESSAGE TO BE PRINTED OUT AT THE END OF A SYMBOL TABLE LISTING
TRAILR	6002; 0
	.ASCII '**** END OF SYMBOL TABLE'<15>
/
/
/ THIS SUBROUTINE PROVIDES BLANK LINES FOR VERTICAL SPACING.
SKIP	XX
	.WRITE	LP,2,BLINE,0
	JMP*	SKIP
/
/ MESSAGE TO SKIP A LINE
BLINE	2002; 0; .ASCII ' '<15>
/
/ MESSAGE TO EJECT TO TOP OF PAGE
EJECT	2002; 0; .ASCII <14><15>
/
/
/
/ THE FOLLOWING ARE ASCII DESCRIPTIONS TYPED OUT TO IDENTIFY EACH TYPE
VAR	VARND-.*400+2
	0
	.ASCII	'   VARIABLE    TYPE  OTABLE ADDR  PROG ADDR  '
	.ASCII	' STATUS   SIZE/F  COMMON NAME'<15>
VARND=.
/
STA	STAND-.*400+2
	0
	.ASCII '    STATEMENT NUMBERS'<15>
STAND=.
/
COMM	COMMND-.*400+2
	0
	.ASCII '    COMMON BLOCK NAMES'<215>
COMMND=.
/
/
/
FUNBIT=4000
/
/ THE FOLLOWING BUFFER IS USED TO PRINT OUT THE SYMBOL TABLE
/ LINES.
HEADER	.BLOCK	2
	.ASCII '     '
BUFFER	.BLOCK 40
/
/
/ THIS SUBROUTINE SETS UP THE AUTO-INDEX REGISTER FOR SCANNING
/ THE PTABLE.
/
SETUP	XX
	LAW	-1
	TAD*	PTABLE	/ POINT AUTO-INDEX TO TOP OF PTABLE
	DAC*	(AUTO12
	JMP*	SETUP
/
/
/ THIS SUBROUTINE ADDS SPACES WHERE NECESSARY.
/
SPACER	XX
	DAC	CNTR
ANOTHR	LAC	(SPACE
	JMS*	G.PACK
	ISZ	CNTR
	JMP	ANOTHR
	JMP*	SPACER
/
/
/ THIS SUBROUTINE PRINTS OUT THE LINE.
OUTPUT	XX
	.WRITE	LP,2,HEADER,0
	.WAIT	LP
	JMP*	OUTPUT
/
/
/
/ SCAN PTABLE FOR ALL VARIABLES, STATEMENT NUMBERS AND COMMON
/ BLOCK NAMES.
/
SYMBOL	XX
	LAC	(TMAIN
	DAC	TEMP
	LAC*	KIND
	SAD	(MAINK
	JMP	MOVEP	/ PROGRAM IS MAIN/LINE, INSERT 'OR MAIN/LINE'
	LAC	(TSUB
	DAC	TEMP
/ MOVE THE PROGRAM TYPE DESCRIPTER INTO THE BUFFER
MOVEP	LAW	-6
	JMS*	G.MOVE
	TAD	TEMP
	TAD	(PRTYPE
/
/ MOVE PROGRAM NAME
	LAC*	PNAME
	DAC	PRNAME
	LAC*	PNAM1
	DAC	PRNAME+1
	LAC*	PNAM2
	XOR	(000320	/ INSERT CARRIAGE RETURN
	DAC	PRNAME+2
/
/ PRINT OUT THE HEADING
HWRITE	.WRITE	LP,2,SYMMES,0
/
/
/ DO THE VARIABLES FIRST
/
	JMS	SETUP
	JMS	SKIP
	.WRITE	LP,2,VAR,0
	LAC	(BUFFER
	JMS*	G.STPC		/SET UP PACKING ROUTINE
	LAW	-24
	JMS	SPACER		/ 20 (DEC) SPACES AT START OF LINE
	LAC*	%TABLE		/GET RELATIVE START ADDRESS OF OTABLE
	JMS*	G.OCTL		/CONVERT TO ASCII
	LAW	-4
	JMS	SPACER
	LAC*	%START		/GET RELATIVE ADDRESS OF
	TAD	(1		/START OF INTERPRETIVE CODE
	JMS*	G.OCTL		/CONVERT TO ASCII
	JMP	OUT		/FINISH LINE & PRINT
/
/  LOOP RETURNS HERE TO SEARCH FOR VARIABLES
/
VBLE	LAC	(VARIAB	/ WANT VARIABLES
	JMS*	G.SCAN	/ GO SCAN PTABLE
	JMP	VARBLE	/ RETURNS HERE WHEN VARIABLE FOUND
/
/ DO THE STATEMENT NUMBERS SECOND
/
	JMS	SETUP	/ RETURNS HERE ON END OF PTABLE
	JMS	SKIP
	.WRITE	LP,2,STA,0
STATES	LAC	(STNUM	/ WANT STATEMENT NUMBER
	JMS*	G.SCAN	/ GO SCAN TABLE
	JMP	STATE	/ RETURN HERE WHEN STATEMENT NUMBER FOUND
/
/ DO THE COMMON BLOCK NAMES LAST
/
	JMS	SETUP	/ RETURN HERE ON END OF PTABLE
	JMS	SKIP
	.WRITE	LP,2,COMM,0
COMN	LAC	(COMNAM	/ WANT COMMON BLOCK NAMES
	JMS*	G.SCAN	/ GO SCAN TABLE
	JMP	COMMON	/ RETURN HERE WHEN COMMON NAMES ARE FOUND
/
/
/ PRINT OUT THE TRAILING MESSAGE
	JMS	SKIP	/ RETURN HERE ON END OF PTABLE
TWRITE	.WRITE	LP,2,TRAILR,0
	.WRITE	LP,2,EJECT,0
	JMP*	SYMBOL
/
/
/
/ STORAGE LOCATIONS
CNTR;COUNT;CONTRL;DPOINT;IND;OT1;OT2;STORE;TEMP;BASE;CPOINT
	.EJECT
/
/
/
/
/ A VARIABLE WAS FOUND !!
VARBLE	DAC	DPOINT	/ SAVE POINTER TO DTABLE
	DAC*	MODPTR
	DAC*	(AUTO11
	TAD	(3
	DAC	CONTRL	/ POINTS TO CONTROL BITS
	DAC*	BITPTR
	TAD	(1
	DAC	CPOINT
	LAC	(BUFFER
	JMS*	G.STPC	/ SET UP PACKING ROUTINE
	JMS	PICK	/ CONVERT NAME TO 5/7 ASCII
	LAW	-4
	JMS	SPACER
/
/ PICK UP MODE
	LAC*	DPOINT
	AND	(37	/ REMOVE ADDRESS
	SAD	(CHARM	/ SIPHON OFF CHARACTER VARIABLES
	JMP	CHRVAR
	CLL
	RAL		/ EACH DESCRIPTOR CONTAINS 2 WORDS
	TAD	(MODTAB-3	/ SO MULTIPLY BY 2 AND ADD START ADDRESS
	DAC*	(AUTO11
	LAC*	AUTO11
	DAC	BUFFER+4	/ INSERT IN THE OUTPUT BUFFER
	LAC*	AUTO11
	DAC	BUFFER+5
/
	LAC	(BUFFER+6
	JMS*	G.STPC	/ SET UP PACKING ROUTINE
	LAW	-5
	JMS	SPACER	/ ADD FIVE SPACES
/
/ GET RELATIVE AND ABSOLUTE OTABLE ADDRESSES
JNADR	JMS	OTADRS	/ GET ADDRESSES
/
/ PICK UP ASSIGNED ADDRESS
/
	LAC*	CONTRL		/ WHAT SORT OF SYMBOL ARE WE LOOKING AT?
	AND	(FUNBIT		/ IS IT A FUNCTION (OR SUBROUTINE)?
	SNA!CLA			/ YES.  OUTPUT ADDRESS = 0
	LAC*	OT1
	AND	(077777
	JMS*	G.OCTL
	LAW	-4
	JMS	SPACER
/
/ CHECK IF VARIABLE IS DEFINED AND USED OR NOT
	JMS	STATUS
	.DSA	DFINED
	.DSA	USED
	LAW	-4
	JMS*	G.MOVE	/ MOVE FOUR WORDS & INSERT IN BUFFER
	TAD	IND	/ FROM
	TAD	(BUFFER+20	/ TO
	LAC	(BUFFER+24	/ SET UP PACKING ROUTINE IN CASE
	JMS*	G.STPC	/ THERE IS MORE INFO TO PRINT.
	LAC	(014000	/ BASIC 14 WORD PAIRS
	DAC	BASE
/
/TEST FOR FUNCTION
	LAC*	CONTRL
	AND	(FUNBIT
	SNA		/ IS IT A FUNCTION
	JMP	DIMTST
	LAC	FUNCT
	DAC	BUFFER+24
	LAC	FUNCT+1
	DAC	BUFFER+25
	LAC	(014000
	JMP	OUT2
/
/
/ TEST FOR DIMENSIONS
DIMTST	LAC*	CONTRL
	AND	(DIMENS
	SZA		/ DOES VARIABLE HAVE DIMENSIONS
	JMP	YEP	/ YES.
	LAW	-11	/ NO. SET SPACE COUNT IN CASE OF COMMON
	JMP	COMCR	/ NAME.
YEP	LAC	(6-5	/ CONVERT 5 PLACES
	DAC*	NUMS
	LAW	-2
	TAD	OT2
	DAC	TEMP
	LAC*	TEMP
	AND	(077777
	CLL		/ PRINT LEADING ZEROS
	JMS*	G.CVRT	/ CONVERT TO DECIMAL ASCII & PACK IT.
	LAW	-4	/ SET SPACE COUNT IN CASE OF COMMON NAME
/ TEST IF VARIABLE IS IN COMMON
/
COMCR	DAC	IND	/ STORE SPACING COUNT
	LAC*	OT1	/ GET FIRST WORD OF OTABLE
	AND	(700000	/ LEAVE TYPE INDICATOR
	SAD	(200000	/ IS IT IN COMMON OR EQUIV'D TO COMMON
	SKP
	JMP	OUT	/ NO. NOT EITHER
	LAC	IND	/ YES IT DOES, APPLY THE SPACES THEN.
	JMS	SPACER
	LAC*	OT2	/ YES. GET DTABLE ADDRESS
	DAC*	(AUTO11	/ POINT AUTO-INDEX TO COMMON NAME-1
	LAC	(016000
	DAC	BASE
	LAC	(BUFFER+30
	JMS*	G.STPC
	JMS	PICK	/ CONVERT TO 5/7 ASCII & INSERT IN BUFFER
/
OUT	LAC	(CAR
	JMS*	G.PACK	/ INSERT CARRIAGE RETURN
	LAC*	PAIRCT	/ GET WORD PAIR COUNT
	LLS	11
	TAD	BASE
OUT2	DAC	HEADER
	JMS	OUTPUT
	JMP	VBLE
/
/
/ HAVE A CHARACTER VARIABLE, INSERT THE MODE AND SIZE AS:
/       CH*SIZE     (0<SIZE<=256)
CHRVAR	LAC	(103	/ ASCII 'C'
	JMS*	G.PACK
	LAC	(110	/ ASCII 'H'
	JMS*	G.PACK
	LAC	(052	/ ASCII '*'
	JMS*	G.PACK
	LAC	(6-3	/ CONVERT 3 PLACES
	DAC*	NUMS
	CLL		/ THROW AWAY LEADING ZEROS
	LAC*	CPOINT	/ GET CHARACTER SIZE
	JMS*	G.CVRT	/ CONVERT AND PACK IT.
	LAW	-4
	JMS	SPACER
	JMP	JNADR	/ GO JOIN THE MAIN STREAM
/
/ A STATEMENT NUMBER WAS FOUND !!
STATE	DAC	DPOINT
	DAC	CONTRL
	DAC*	(AUTO10
	LAC	(BUFFER
	JMS*	G.STPC	/ SET UP PACKING ROUTINE
	LAC	(6-5	/ CONVERT FIVE PLACES
	DAC*	NUMS
	LAC*	AUTO10
	SPA
	JMP	STATES	/ INTERNAL STATEMENT NUMBERS ARE NEGATIVE
	JMS*	G.CVRT	/ DON'T PRINT INTERNAL STATEMENT NUMBERS
	LAW	-5
	JMS	SPACER	/ ADD FIVE SPACES
/
/ CHECK IF STATEMENT NUMBER IS ON A FORMAT STATEMENT
	LAC*	DPOINT
	AND	(FORM
	SNA		/ IS STATEMENT ON A FORMAT
	JMP	NOTFOR	/ NO
	LAC	(EF	/ YES. ITS ON A FORMAT, INSERT 'F'
	SKP
NOTFOR	LAC	(SPACE	/ NO. ITS NOT ON FORMAT, INSERT SPACE
	JMS*	G.PACK
	LAW	-4
	JMS	SPACER	/ ADD FOUR SPACES
/
/ PICK UP RELATIVE AND ABSOLUTE OTABLE ADDRESSES
	JMS	OTADRS	/ GET ADDRESSES
/
/ CHECK IF STATEMENT NUMBER IS DEFINED AND USED OR NOT
	JMS	STATUS
	.DSA	NON.EX!.EXC!FORM
	.DSA	.IOPUT!DO.S!TRAN.
	LAW	-4
	JMS*	G.MOVE	/ MOVE FOUR WORDS TO BUFFER
	TAD	IND		/ FROM
	TAD	(BUFFER+12	/ TO
	LAC	CARAGE	/ INSERT CARAGE RETURN
	DAC	BUFFER+16
	LAC	(012000
	DAC	HEADER
	JMS	OUTPUT	/ PRINT OUT LINE
	JMP	STATES	/ GO GET NEXT STATEMENT NUMBER
	.EJECT
/
/
/
/
/ THIS SECTION LOOKS AFTER COMMON NAMES IN THE SYMBOL TABLE
COMMON	DAC	DPOINT
	DAC*	(AUTO11
/
/ PICK UP COMMON NAME AND CONVERT TO 5/7 ASCII
	LAC	(BUFFER
	JMS*	G.STPC	/ SET UP PACKING ROUTINE
	JMS	PICK
	LAW	-4
	JMS	SPACER	/ FILL OUT WORD PAIR WITH SPACES
/
/ PICK UP COMMON SIZE AND CONVERT
	LAC*	DPOINT	/ GET COMMON SIZE
	JMS*	G.CVRT	/ CONVERT TO DECIMAL ASCII
/
/ INSERT CARRIAGE RETURN AND PRINT
	LAC	(CAR
	JMS*	G.PACK
	DAC	BUFFER+6
	JMS	OUTPUT
	JMP	COMN
/
/
/
/
/
/
/
PICK	XX
	LAW	-2
	DAC	COUNT
/
NXTWRD	LAW	-3
	DAC	CNTR
	LAC*	AUTO11
	DAC	STORE
/
NXTCHR	LAC	STORE
	RTL;	RTL;	RTL;	/ ROTATE SIX TO LEFT
	DAC	STORE	/ SAVE FOR NEXT TIME
	RAL		/ SHIFT REMAINING BIT INTO AC17.
	AND	(77	/ TRIM TO SIXBIT BITS
	SNA		/ IS IT A BLANK ?
	JMP	BLANK	/ YES.
	SAD	(DLR	/ IS IT '$'
	JMP	DOLL
	SAD	(POINT	/ IS IT '.' IE .BLANK
	JMP	DOT1	/ YES.
	TAD	(-DLR
	SMA
	JMP	NUM
/
LETTER	TAD	(DLR-AA+AY	/ IT IS A LETTER BY DEFAULT
	JMP	PUT
NUM	TAD	(DLR-ZERO+ZRO
	JMP	PUT
BLANK	LAC	(SPACE	/ LOAD SPACE
	JMP	PUT
DOT1	LAC	(DOT	/ LOAD DOT FOR PRINTING
	JMP	PUT
DOLL	LAC	DOLLAR
PUT	JMS*	G.PACK
/
	ISZ	CNTR
	JMP	NXTCHR
	ISZ	COUNT
	JMP	NXTWRD
	JMP*	PICK
/
/
/
/ GET RELATIVE OTABLE ADDRESS
OTADRS	XX
	LAC*	DPOINT
	CLL
	LRS	6
	JMS*	G.OCTL	/ (GEARS)
	LAW	-4
	JMS	SPACER
/
/ GET ABSOLUTE OTABLE ADDRESS
	LAC*	DPOINT
	JMS*	GETADR	/ (CALCP)
	DAC	OT1	/ SET UP OTABLE POINTERS FOR LATER
	TAD	(-1
	DAC	OT2
	JMP*	OTADRS
/
/
/ FIGURE OUT IF VARIABLE IS DEFINED AND USED OR NOT
STATUS	XX
	LAC*	CONTRL
	AND*	STATUS	/ AND CONTROL BIT
	ISZ	STATUS
	SZA		/ IS IT DEFINED ?
	LAC	(10	/ YES. INDEX TO 2ND HALF OF TABLE
	DAC	IND	/ IF NOT IND_0. STAY IN 1ST HALF
	LAC*	CONTRL	/ GET CONTROL BITS AGAIN
	AND*	STATUS	/ TRY OTHER CONTROL BITS
	ISZ	STATUS
	SZA		/ IS VARIABLE USED ?
	LAC	(4	/ YES. WANT 2ND ASCII DESCRIPTOR
	TAD	IND	/ IF NOT WANT 1ST ASCII CODE, IND_IND+0
	TAD	(DFNTAB	/ ADD START ADDRESS OF TABLE FOR ENTRY
	DAC	IND
	JMP*	STATUS
/
	.END