.TITLE CREF
 
/ .... EDIT #05 .... 05 OCT. '70
 
/	COPYRIGHT 1970 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
/	PDP-9 OR PDP-15
/	ADVANCED MONITOR OR BACKGROUND/FOREGROUND
/	CROSS REFERENCE PROGRAM FOR MACRO
/	SOURCE ELEMENTS.
/	THIRD PASS FOR MACRO ASSEMBLY.
	
/	ASSEMBLY PARAMETRS:
/		ADVANCED MONITOR: NONE
/		BACGROUND/FOREGROUND: '%BF15'
 
/
/	MAX CANGIANO.
/
 
/THIS CODE MOVES UST TO TOP OF FREE CORE
/THEN IT MOVES UST BACK TO LOW CORE WITH
/EACH ENTRY INCREASED TO SIX WORDS
/THE SYMBOL NAME IS CONVERTED FROM RADIX 50
/TO .SIXBT
/
/MOVE UST TO TOP OF FREE CORE
/
	.ABS
	.LOC	15430
LTOPCR	LTOPCR-1
	JMS	.		/INITIALIZE BANK BITS
	LAC	.-1
	AND	L60000
	DAC	TAGPRO
	LAW	-T1SIZE
	DAC	DIVIDE
BBITS	LAC	LINBUF
	ISZ	.-1
	TAD	TAGPRO
	DAC	UNSQZE
	LAC*	UNSQZE
	TAD	TAGPRO
	DAC*	UNSQZE
	ISZ	DIVIDE
	JMP	BBITS
	LAC	MULTIN		/MULTIPLE INPUT?
	SNA
	JMP	.+3		/NO
	LAC	SKIP		/YES, FORCE ^P
	DAC	CP-2
INIT1	.INIT	-3,1,RSTRT
	.WRITE	-3,2,ENDP2,8
	.WAIT	-3
	.IFUND	CREFI
	XCT	EXPAGE		/EXTRA PAGE?
	SKP			/YES
	JMP	STARTP		/NO
	LAC	PAGBOT		/IF PAGBOT=PAGEND WE DON'T
	SAD	PAGEND		/WORRY ABOUT ENDUST
	JMP	.+4
	LAC*	SCM102
	DAC	BEGUST
	DAC	ENDUST
	LAC	PAGBOT		/MOVE PAGBOT-PAGTOP
	TAD	ML1
	DAC*	L10		/TO (ENDUST)-
	LAC	ENDUST		/(ENDUST+PAGTOP-PAGBOT+1)
	TAD	ML1
	DAC*	L11
	LAC	PAGTOP		/COMPUTE:
	CMA			/ -(PAGTOP-PAGBOT+1)
	ADD	PAGBOT
	TAD	ML1
	DAC	TEMP
	LAC*	10
	DAC*	11
	ISZ	TEMP
	JMP	.-3
	.ENDC
STARTP	LAC	USTSZE
	DAC	OVRL1
	TAD	OVRL1
	TAD	OVRL1
	CMA			/TOPCOR-USTSZE
	ADD	LTOPCR		/Y=TOPCORE-X
	DAC*	L10		/SAVE Y IN AIR 10
	DAC	OVRL1		/
	LAC	BEGUST		/GET BEGINNING OF UST
	TAD	ML1		/
	DAC*	L11		/STORE IT IN AIR 11
LOOP1	LAC*	11		/GET WORD FORM UST
	DAC*	10		/STORE IT IN HIGH CORE
	LAC*	L10		/ARE WE DONE?
	SAD	LTOPCR		/NO, CONTINUE
	JMP	.+2		/YES, EXIT
	JMP	LOOP1		/
/
/CONVERT SYMBOL NAMES FROM RADIX 50 TO SIXBT
/THEN EXPAND EACH ENTRY IN UST TO SIX WORDS
/AND MOVE THE EXPANDED ENTRY TO LOW CORE
/
	LAC*	SCM102
	TAD	ML1		/
	DAC*	L11		/IN AIR 11 (LOW CORE)
	LAC	OVRL1		/PUT BEGINNING OF MOVED UST
	DAC*	L10		/IN AIR 10 (HIGH CORE)
LOOP2	JMS	UNSQZE		/
	LAC*	10		/MOVE THREE WORDS
	DAC*	11		/DOWN TO LOW CORE
	LAC*	10		/
	DAC*	11		
	LAC*	10		/
	DAC*	11		/
	DZM*	11		/ZERO THE FOURTH WORD OF NEW ENTRY
	LAC	CNTRL		/GET CONTROL BITS
	DAC*	11		/DEPOSIT THEM IN THE FIFTH WORD OF THE
	DZM*	11		/NEW ENTRY, ZERO LAST WORD
	LAC*	L10		/ARE WE DONE?
	SAD	LTOPCR		/NO, CONTINUE
	JMP	ININPT		/YES, INIT INPUT
	JMP	LOOP2		/
UNSQZE	0			/CONVERT FROM RADIX 50 TO .SIXBT
	LAW	-2		/INTIALIZE WORD COUNTER
	DAC	USQCTR		/
	LAC*	L10		/PICK UP ADDRESS OF FIRST
	TAD	D1
	DAC	XR1		/WORD TO CONVERT
	LAC*	XR1		/PICK UP FIRST WORD TO CONVERT
	AND	L650S		/MASK IN BITS 0 AND 1
	JMP	COMMON		/
HALF2	LAC*	XR1		/PICK UP SECOND WORD TO CONVERT
	AND	L650S		/MASK IN BITS 0 AND 1
	CLL			/SHIFT TWO TO THE RIGHT
	RTR			/AND STORE THEM WITH BITS 0
	XOR	CNTRL		/AND 1 OF FIRST WORD TO
COMMON	DAC	CNTRL		/CONVERT
	LAC*	XR1		/PICK UP WORD TO CONVERT
	AND	L157S		/AND MASK OUT BITS 0 AND 1
	DAC	OVRL1		/
	JMS	DIVIDE		/DIVIDE BY 3100 OCTAL TO
	LAC	OVRL1		/ISOLATE LEFTMOST CHARACTER
	LAC	L3100		/
	JMS	SIXBIT
	JMS	LFT12		/LEFTMOST BITS, THEN STORE
	DAC*	XR1		/IT BACK IN UST ENTRY
	JMS	DIVIDE		/DIVIDE BY 50 OCTAL TO
	LAC	OVRL1		/ISOLATE MIDDLE CHARACTER
	LAC	L50		/
	JMS	SIXBIT
	JMS	LFT6		/MOVE CHAR TO MIDDLE OF WORD
	XOR*	XR1		/COMBINE MIDDLE CHARACTER
	DAC*	XR1		/WITH LEFT CHARACTER
	LAC	OVRL1		/GET RIGHTMOST CHARACTER
	JMS	SIXBIT
	XOR*	XR1		/COMBINE RIGHT CHARACTER WITH
	DAC*	XR1		/OTHER TWO
	ISZ	XR1		/MOVE POINTER TO SECOND WORD
	ISZ	USQCTR		/OF SYMBOL NAME,IF WE HAVE ALREADY
	JMP	HALF2		/PROCESSED 2 WORDS RETURN, OTHERWISE
	JMP*	UNSQZE		/GO TO PROCESS SECOND WORD
SIXBIT	0
	DAC	QUO
	SNA
	JMP*	SIXBIT
	TAD	ML33
	SMA
	JMP	SIXBT2
	LAC	QUO
	JMP*	SIXBIT
SIXBT2	SZA
	JMP	SIXBT3
	LAC	AND%
	JMP*	SIXBIT
SIXBT3	SAD	D1
	JMP	SIXBT4
	LAC	QUO
	TAD	L23
	JMP*	SIXBIT
SIXBT4	LAC	DOT
	JMP*	SIXBIT
L23	23
L650S	600000
L60000	60000
L157S	177777
L3100	3100
AVLSPC=OPACK
LINENO=OWRITE
OPPRO=ADRPRO
FALPHA=ALPHA
ENDP2	004002
	0
	.ASCII	' END OF PASS 2'<15>
FRLAST	FRLAST-1		/LAST AVAILABLE REGISTER
CNTRLP	002002
	0
	.ASCII	'^P'<175>
/INITIALIZE NPUT
ININPT	LAC*	L11
	DAC	ENDUST
	TAD	D1
	DAC	AVLSPC
	LAC	FSWTCH
	SNA		/IS THERE A FILE ON DAT SLOT -14?
	JMP	INIT2		/NO
	LAC	CAL14		/YES, SET UP CALS TO -14.
	DAC	INIT5-2
	DAC	INIT3-2
	LAC	INIT7
	DAC	DBL
	DAC	INIT4-2
INIT7	.INIT	-14,0,RSTRT
	LAC	.-1
	SAD	L377
	JMP	RSTRT
	JMP	CP
CAL14	2764
INIT11	.CLOSE	-14
	DZM	FSWTCH
	LAC	CAL11
	DAC	INIT5-2
	DAC	INIT3-2
	LAC	CAL11P
	DAC	DBL
	DAC	INIT4-2
	LAC	FILE1%
	DAC	INIT4
	JMP	INIT2
CAL11	2767
CAL11P	767
FILE1%	FILENM
INIT2	.INIT	-11,0,RSTRT
	LAC	.-1
	SAD	L377
	JMP	RSTRT
CP	.WRITE	-3,2,CNTRLP,4
	JMP	.
RSTRT	CAL+767
	3
INIT4	FIL2NM
	CAL+2767		/READ IN FIRST LINE
	10
INIT5	SRCBUF
	-44
	.EJECT
/
/GENERAL FLOW
/
/START BY READING IN THE NEXT LINE
/
NXTLIN	JMS	DBLBUF		/GET NEXT LINE
	ISZ	LINENO		/UPDATE LINE NUMBER
	LAC	D5		/INITIALIZE VALUES FOR GETCHR
	DAC	GETPTR		/
	LAC	LINBF%		/INITIALIZE POINTER TO NEXT
	DAC	ADPCHR		/WORD PAIR IN LINE BUFFER
/
/START ANALYZING THE LINE
/
START	JMS	GETCHR		/GET NEXT CHARACTER
	JMS	FALPHA		/DO WE HAVE A TAG?
	JMS	TAGPRO		/YES
STOPS	SAD	TAB		/NO, DO WE HAVE A TAB?
	JMP	STOP		/YES, GO START OP-CODE
	SAD	SPACE		/NO, DO WE HAVE SPACES?
	JMP	STOP		/YES, GO START OP-CODE
	SAD	SEMICL		/NO, DO WE HAVE ;?
	JMP	START		/YES, SCAN NEW STATEMENT
	SAD	CR		/NO, DO WE HAVE A CR?
	JMP	NXTLIN		/YES, GET NEXT LINE
	SAD	SLASH		/NO, DO WE HAVE A /?
	JMP	NXTLIN		/YES, GET NEXT LINE
	JMS	GETCHR		/NO, GET NEXT CHARACTER
	JMP	STOPS		/CONTINUE
STOP	JMS	GETCHR		/GET NEXT CHARACTER
	SAD	SPACE		/PASS OVER BLANKS
	JMP	.-2		/
	JMS	FALPHA		/DO WE HAVE AN OP CODE?
	JMS	OPPRO		/YES
STADRS	SAD	TAB		/NO, TAB?
	JMP	STADR		/YES, GO START ADDRESS FIELD
	SAD	SPACE		/NO, IS IT A SPACE?
	JMP	STADR		/YES, GO START ADDRESS FIELD
	SAD	SEMICL		/NO, IS IT A ;?
	JMP	START		/YES, SCAN NEW STATEMNET
	SAD	CR		/NO, IS IT A CR?
	JMP	NXTLIN		/YES, GET NEXT LINE
	SAD	SLASH		/NO, IS IT A /?
	JMP	NXTLIN		/YES, GET NEW LINE
	JMS	GETCHR		/NO, GET NEW CHARACTER
	JMP	STADRS		/CONTINUE
STADR	JMS	GETCHR		/GET NEXT CHARACTER
	SAD	SPACE		/PASS OVER BLANKS
	JMP	.-2		/
	SAD	PLUS		/PLUS SIGN?
	JMP	STCAL1		/YES
	SAD	MINUS		/NO, MINUS SIGN?
	JMP	STCAL1		/YES
	SAD	LPAREN		/NO, LEFT PARENTHESIS?
	JMP	STOP		/YES
	SAD	LESTHN		/NO, <?
	JMP	STCAL1		/YES
	SAD	QUOTES		/NO, QUOTES?
	JMP	STCAL1		/YES
	SAD	QUOTE		/NO,'?
	JMP	STCAL1		/YES
	JMS	NUMERC
	JMP	.+2
	JMS	FALPHA		/NO, IS IT ALPHABETIC?
	JMS	ADRPRO		/
	JMP	STCOMS		/
STCAL1	JMS	GETCHR		/
	JMP	STCAL1-5	/
STCOMS	SAD	TAB		/TAB?
	JMP	STCOM		/YES
	SAD	SPACE		/NO, IS IT BLANK?
	JMP	STCOM		/YES
	SAD	CR		/NO, CR?
	JMP	NXTLIN		/YES
	SAD	SEMICL		/NO, IS IT ;?
	JMP	START		/YES
STCOM	JMS	GETCHR		/
	SAD	SLASH		/IS IT SLASH?
	JMP	NXTLIN		/YES
	JMP	STCOMS		/NO
/
/
/
/DIVIDE SUBROUTINE
/CALLING SEQUENCE:
/
/	JMS	DIVIDE
/	LAC	LOW ORDER DIVIDEND
/	LAC	DIVISOR
/	RETURN	;QUOT. IN AC, REM. IN OVRL1
/
DIVIDE	0
	XCT*	DIVIDE		/FETCH LOW ORDER DIVIDEND
	DZM	OVRL1		/
	DAC	QUO		/STORE LOW ORDER DIVIDEND
	ISZ	DIVIDE		/
	XCT*	DIVIDE		/FETCH DIVISOR
	CMA			/TWO'S COMPLEMENT
	TAD	D1		/AC
	DAC	DVS		/SAVE DIVISOR
	ISZ	DIVIDE		/INCREMENT TO EXIT ADDRESS
	SNA			/DIVIDEND =0?
	JMP*	DIVIDE		/YES,EXIT WITH LINK =1
	LAW	-23		/SET UP COUNTER
	DAC	DV1		/SAVE COUNTER
	JMP	DV2		/START DIVISION
DV3	LAC	OVRL1		/FETCH DIVIDEND
	RAL			/ROTATE LEFT TO PICK UP NEXT BIT
	DAC	OVRL1		/STORE DIVIDEND
	TAD	DVS		/SUBTRACT DIVISOR FROM DIVIDEND
	SZL			/DIVIDEND GREATER THAN OR EQUAL TO DIVISOR
	DAC	OVRL1		/YES
DV2	LAC	QUO		/FETCH QUOTIENT
	RAL			/PICK UP QUOTIENT BIT FOR LINK
	DAC	QUO		/STORE NEW QUOTIENT
	ISZ	DV1		/FINISHED?
	JMP	DV3		/NO,CONTINUE
	JMP*	DIVIDE		/YES,RETURN
/END OF DIVIDE
	.EJECT
/POINTERS FROM PASS2
	.IFDEF	%BF15
FIL2NM=17710
	.ENDC
	.IFUND	%BF15
FIL2NM=17610
	.ENDC
FILENM=FIL2NM+3
FSWTCH=FILENM+3
BATCH=FSWTCH+1
USTSZE=BATCH+1
ENDUST=USTSZE+1
BEGUST=ENDUST+1
PAGTOP=BEGUST+1
PAGBOT=PAGTOP+1
PAGEND=PAGBOT+1
MACSZE=PAGEND+1
LDADDR=MACSZE+1
FSTBLK=LDADDR+1
EXPAGE=FSTBLK+1
LSTLIN=EXPAGE+1
LSTPGE=LSTLIN+1
MULTIN=LSTPGE+1
/POINTERS FROM CREFI
DCLOSE=17641
DSEEK=17640
DWRITE=17637
DSWCH=FSWTCH
DREAD=PAGTOP
DENTER=PAGBOT
TTYOUT=PAGEND
CTLC=EXPAGE
OVRL1	0
LINCNT	-67
/
/CHARACTER CONSTANTS
/	.OCT
SPACE	40
CHRTBL=.
TAB	11
SEMICL	73
CR	15
PLUS	53
MINUS	55
STAR	52
SLASH	57
AMPRS	46
EXCL	41
BSLASH	134
COMMA	54
AND%	45
DOT	56
LPAREN	50
LESTHN	74
QUOTES	42
QUOTE	47
EQUALS	75
NOSIGN	43
/
/DECIMAL CONSTANTS
/
	.DEC
D5	5
D2	2
D4	4
D1	1
D6	6
D3	3
D1000	1000
D100	100
D10	10
/
/INSTRUCTION CONSTANTS
/
I3	LAC	GETWDS
I4	SAD	CHRTBL-2
I5	SAD	CHRTBL+2
I8	DAC	GETWDS
IOTLIT	IOT
/
/OCTAL CONSTANTS AND MASKS
/
	.OCT
L7	7
L0	0
L77	77
L177	177
L377	377
L17	17
L6400	6400
L777	777
L100	100
L60	60
L10	10
ML100	-100
ML33	-33
ML60	-60
ML12	-12
ML1	-1
L37777	37777
L77777	77777
L40=SPACE
L11=TAB
L73=SEMICL
L15=CR
L57=SLASH
L53=PLUS
L55=MINUS
L52=STAR
L45=AND%
L211=EXCL
L134=BSLASH
L56=DOT
L50=LPAREN
L74=LESTHN
L42=QUOTES
L47=QUOTE
L75=EQUALS
L43=NOSIGN
L170	170
SCM102	102
L7%50S=IOTLIT
/
/CORE LOCATION POINTERS
/
LINBF%	LINBUF+1
SRCBF%	SRCBUF+1
/
/BUFFERS AND DATA WORDS
/
PACKS	.BLOCK	2
LINBUF	LTOPCR
	INIT13
	HR%
	LINBF%
	INIT12
	INIT7+2
	FRLAST
	SRCBF%
	INIT1+2
	INIT1+6
	INIT2+11
	INIT3
	INIT4
	INIT5
	INIT6
	FILE1%
	ERR1%
T1SIZE=.-LINBUF
T2SIZE=44-T1SIZE
	.BLOCK	T2SIZE
SRCBUF	201004
	020100
	.BLOCK	41
RDLST	0
CHRHLD	0
CHRCNT	0
FLDSW=UNSIX
/
/ SHIFT ROUTINES
/
LFT4	0
	CLL
	RTL
	RTL
	JMP*	LFT4
LFT6	0
	JMS	LFT4
	RTL
	JMP*	LFT6
LFT8	0
	JMS	LFT6
	RTL
	JMP*	LFT8
RT3	0
	CLL!RAR
	RTR
	JMP*	RT3
RT4	0
	JMS	RT3
	RAR
	JMP*	RT4
RT5	0
	JMS	RT3
	RTR
	JMP*	RT5
RT6	0
	JMS	RT4
	RTR
	JMP*	RT6
RT7	0
	JMS	RT5
	RTR
	JMP*	RT7
RT8	0
	JMS	RT6
	RTR
	JMP*	RT8
RT15=LFT4
RT13=LFT6
RT11=LFT8
LFT16=RT3
LFT15=RT4
LFT14=RT5
LFT13=RT6
LFT12=RT7
LFT11=RT8
/
CNTRL=LINBUF
USQCTR=LINBUF+1
XR1=LINBUF+2
QUO=LINBUF+3
DVS=LINBUF+4
DV1=LINBUF+5
	.EJECT
/SUBROUTINE TAGPRO
/
/TAGPRO RECEIVES CONTROL IF THE FIRST CHARACTER
/OF A STATEMENT IS AN ALPHA OR DOT
/DIRECT ASSIGNMENTS ARE ALSO HANDLED HERE
/
TAGPRO	0			/
	DZM	FLDSW		/CLEAR FIELD SWITCH
	DZM	CHRCNT		/CLEAR CHARACTER COUNT
TAGCE	ISZ	CHRCNT		/INCREMENT CHARACTER COUNT
	DAC	CHRHLD
	LAC	CHRCNT		/
	SAD	L7		/DO WE HAVE SIX CHARACTERS?
	JMP	TAGEND		/YES, GO MAKE ENTRY
	JMS	PACKER		/NO, PACK CHARACTER
	JMS	GETCHR		/GET NEXT CHARACTER
	JMS	FALPHA		/IS IT ALPHABETIC?
	JMP	TAGCE		/YES
	JMS	NUMERC		/NO,NUMERIC?
	JMP	TAGCE		/YES
	JMS	TAGDEL		/NO, IS IT A LEGAL DELIMITER?
	JMP	TAGFND-1	/YES
	SAD	EQUALS		/NO, IS IT AN EQUAL SIGN
	JMP	TAGDIR		/YES, DIRECT ASSIGNMENT
	DAC	CHRHLD		/SAVE CHARACTER
TAGFND	JMS	SYMBOL		/MAKE ENTRY
	LAC	CHRHLD		/RESTORE CHARACTER
	JMP*	TAGPRO		/RETURN
TAGDIR	JMS	SYMBOL		/MAKE ENTRY
	JMS	GETCHR		/GET NEXT CHARACTER
	JMS	FALPHA		/IS IT ALAPHABETIC?
	JMS	ADRPRO		/YES, TREAT IT AS AN ADDRESS FIELD
	JMP	NXTLIN		/NO
TAGEND	JMS	GETCHR
	SAD	EQUALS
	JMP	TAGDIR
	JMS	TAGDEL
	JMP	TAGFND-1
	JMP	TAGEND
	.EJECT
/
/SUBROUTINE SYMBOL
/
/SUBROUTINE SYMBOL IS CALLED WHEN A SYMBOL
/IS FOUND
/PACKS AND PACKS+1+CONTAIN THE SYMBOL IN
/.SIXBIT REPRESENTATION
/FLDSW IS INTERROGATED TO FIND OUT IF
/WE ARE DEALING WITH A TAG SYMBOL
/LINE NO HAS THE LINE#IN WHICH THE SYMBOL
/IS REFERENCED
/A NEW ENTRY IS MADE IN THE LINE #TABLE
/
SYMBOL	0
	LAC*	SCM102		/GET STARTING ADDR. OF UST
	TAD	ML1		/
	DAC*	L10		/STORE IT IN AIR 10
SYMTST	LAC*	10		/GET 1ST WORD OF SYMBOL IN TABLE
	SAD	PACKS		/IS IT EQUAL TO OUR SYMBOL?
	JMP	SYMBEQ		/YES, TEST SECOND WORD
	LAC*	L10		/NO, MOVE POINTER UP
	TAD	D5		/TO NEXT SYMBOL
SYMNXT	DAC*	L10		/
	CMA			/ARE WE AT THE
	ADD	ENDUST		/END OF THE USER
	SPA			/SYMBOL TABLE?
	JMP*	SYMBOL		/YES, NO FIND RETURN
	JMP	SYMTST		/NO, TRY AGAIN
SYMBEQ	LAC*	10		/GET 2ND WORD OF SYMBOL IN TABLE
	SAD	PACKS+1		/IS IT EQUAL TO OUR SYMBOL
	JMP	SYMENT		/YES, GO MAKE LINE # ENTRY
	LAC*	L10		/NO, MOVE POINTER UP
	TAD	D4		/TO NEXT SYMBOL
	JMP	SYMNXT		/
/
/SUBROUTINE TO MAKE NEW ENTRIES IN LINE # LIST
/AND TO READJUST LINKAGES AND POINTERS
/
TEMP=USQCTR
SYMENT	LAC*	L10		/MOVE POINTER TO FOURTH WORD
	TAD	D2		/OF HEADER
	DAC*	L10
	DAC	TEMP		/
	LAC	FLDSW		/GET FIELD INDICATOR
	SNA!CLL			/IS IT A TAG FIELD?
	STL			/YES, SET LINK TO ONE
	LAC*	TEMP		/GET ADDRESS OF LAST ENTRY
	SNA			/ARE THERE ANY ENTRIES?
	JMP	SYMFST		/NO, TREAT FIRST ENTRY AS SPECIAL
	LAC	LINENO		/YES, FETCH CURRENT LINE NO.
	DAC*	AVLSPC		/PLACE IT IN NEW WNTRY
	LAC*	TEMP		/SAVE ADRESS OF LAST ENTRY
	DAC	PACKS		/IN PACKS TEMPORARILY
	ISZ	PACKS		/PACKS POINTS TO WORD 2 OF LAST ENTRY
	LAC*	PACKS		/NOW FETCH IT
	XOR	AVLSPC		/OR-IN FORWARD POINTER TO
	DAC*	PACKS		/NEW ENTRY
	LAC	AVLSPC		/READJUST POINTER TO LAST
	DAC*	TEMP		/ENTRY
	ISZ	AVLSPC		/MOVE AVAILABLE SPACE POINTER
	CLA!RAR			/TURN ON BIT 0 IF THIS IS
	DAC*	AVLSPC		/A FIELD SWITCH
	ISZ	AVLSPC		/
	LAC	AVLSPC		/COMPUTE: FRLAST-AVLSPC
	CMA			/
	ADD	FRLAST		/
	SPA			/ARE WE AT END OF FREE CORE?
	.IFDEF	CREFI
	JMP	OUTPT1
	.ENDC
	.IFUND	CREFI
	SKP
	.ENDC
	JMP*	SYMBOL		/NO, RETURN
	.IFUND	CREFI
	XCT	EXPAGE		/EXTRA PAGE?
SKIP	SKP			/YES
	JMP	OUTPT1		/NO
	LAC	PAGEND		/RSSET AVAILABLE SPACE
	DAC	AVLSPC		/AND LAST FREE REGISTER
	LAC	PAGTOP		/POINTERS
	TAD	ML1
	DAC	FRLAST
	LAC	SKIP		/MAKE SURE THERE IS
	DAC	EXPAGE		/ONLY ONE EXTRA PAGE
	JMP*	SYMBOL
	.ENDC
SYMFST	LAC	TEMP		/ADJUST LAST ENTRY POINTER
	TAD	D1		/
	DAC*	TEMP		/
	ISZ	TEMP		/
	LAC*	TEMP		/ENTER LINE NO. IN HEADER
	XOR	LINENO		/
	DAC*	TEMP		/
	ISZ	TEMP		/
	CLA!RAR			/TURN ON TAG FLAG
	DAC*	TEMP		/
	JMP*	SYMBOL		/RETURN
	.EJECT
/
/SUBROUTINE GETCHR
/
/THIS SUBROUTINE ALWAYS RETURNS THE NEXT
/CHARACTER FROM LINBUF IN THE AC, IN 1-BIT ASCII
/
GETCHR	0			/
	ISZ	GETPTR		/FETCH CHAR POINTER
	LAC	GETPTR		/
	SAD	D6		/DO WE NEED THE SIXTH CHAR?
	JMP	GETNEW		/YES, GO DECODE 5 MORE CHARS.
	ISZ	.+1		/NO
	LAC	.-.		/FETCH CHARACTER
	AND	L177		/MASK IT
GETWDS	JMP*	GETCHR		/
	0			/CHAR1
	0			/CHAR2
	0			/CHAR3
	0			/CHAR4
	0			/CHAR5
GETPTR	5			/INITIAL VALUE
GETNEW	ISZ	ADPCHR		/GET WORD 1 TO BE UNPACKED
	LAC*	ADPCHR
	JMS	RT4		/SHIFT IT 4 BITS RIGHT
	DAC	GETWDS+2	/SAVE SECOND CHARACTER
	JMS	RT7		/SHIFT AC 7 BITS RIGHT
	DAC	GETWDS+1	/SAVE FIRST CHARACTER
	LAC*	ADPCHR
	RTL
	RAL
	AND	L170		/MASK OFF LAST DIGIT
	DAC	GETWDS+3	/SAVE HALF1 OF CHAR3
	ISZ	ADPCHR		/
	LAC*	ADPCHR		/GET WORD2 TO BE UNPACKED
	RAR			/SHIFT 1 RIGHT
	DAC	GETWDS+5	/SAVE FIFTH CHARACTER
	JMS	RT7		/SHIFT AC 7 BITS RIGHT
	DAC	GETWDS+4	/SAVE FOURTH CHARACTER
	JMS	RT7		/SHIFT 7 MORE BITS
	AND	L7		/LEAVE IN ONLY 3 RIGHT BITS
	XOR	GETWDS+3	/
	DAC	GETWDS+3	/SAVE THIRD CHARACTER
	LAC	I3		/RESTORE GETWDS
	DAC	GETWDS-2	/ADDRESS
	DZM	GETPTR		/RESTORE GETPTR
	JMP	GETCHR+1	/
/
/SUBROUTINE TAGDEL
/
/RETURNS TO LOC+1 IF CHARACTER IN AC IS:
/	SPACE, TAB, ;, CR, /
/RETURNS TO LOC+2 OTHERWISE
/
TAGDEL	0
	DAC	CHRHLD
	LAW	-4
	DAC*	L10
	LAC	I4		/SAD CHRTBL-1
	DAC	TAGMP
	LAC	CHRHLD
	ISZ	.+1
TAGMP	SAD	.-.
	JMP*	TAGDEL
	ISZ*	L10
	JMP	.-4
	ISZ	TAGDEL
	JMP*	TAGDEL
ADRDEL	0		/
	DAC	CHRHLD
	LAW	-10
	DAC*	L10
	LAC	ADRDEL
	DAC	TAGDEL
	LAC	I5		/SAD CHRTB+3
	JMP	TAGMP-3		/
/
/SUBROUTINE PACKER
/
/PACKER PACKS .SIXBT CHARACTERS IN PACKS AND
/PACKS+1, CHRCHT HAS THE POSITION TO PACK
/THE CHARACTER IN
/
PACKER	0			/
	LAC	CHRHLD
	AND	L77		/MASK OFF ASCII BIT
	DAC	CHRHLD		/SAVE CHARACTER
	LAC	PAKJMP		/SELECT APPROPRIATE JUMP
	TAD	CHRCNT		/
	DAC	.+2		/
	LAC	CHRHLD		/FETCH CHARACTER
	XCT	.-.		/
PAKJMP	XCT	.		/JUMP TABLE
	JMP	PACK1		/
	JMP	PACK2		/
	JMP	PACK3		/
	JMP	PACK4		/
	JMP	PACK5		/
	JMP	PACK6		/
PACK1	DZM	PACKS		/PLACE BLANKS IN PACKS AND
	DZM	PACKS+1		/PACKS+1
	JMS	RT7		/MOVE CHAR TO LEFTMOST POS
	JMP	PACK3		/
PACK2	JMS	LFT6		/MOVE CHARACTER TO MIDDLE POSITION
PACK3	XOR	PACKS		/
	DAC	PACKS		/
	JMP*	PACKER		/RETURN
PACK4	JMS	RT7		/MOVE CHARACTR TO LEFTMOST POSITION
	JMP	PACK6		/
PACK5	JMS	LFT6		/MOVE CHARACTDR TO MIDDLE POSITION
PACK6	XOR	PACKS+1		/
	DAC	PACKS+1		/
	JMP*	PACKER		/RETURN
/
/SUBROUTINE ALPHA
/
/ALPHA LOOKS AT THE CHARACTER IN THE AC AND
/RETURNS TO LOC+1 IF IT IS ALPHABETIC , %, OR .,
/TO LOC+2 OTHERWISE
/
ALPHA	0			/
	SAD	AND%		/IS CHARACTER %?
	JMP*	ALPHA		/YES, RETURN TO LOC+1
	SAD	DOT
	JMP*	ALPHA
	DAC	CHRHLD		/NO, SAVE CHARACTER
	TAD	ML100		/
	SPA			/IS CHAR.>100?
	JMP	NOALPH		/NO
	TAD	ML33		/YES
	SMA			/IS CHAR.<133?
	JMP	NOALPH		/NO
	LAC	CHRHLD		/YES, RESTORE CHARACTER
	JMP*	ALPHA		/RETURN TO LOC+1
NOALPH	ISZ	ALPHA		/RETURN TO LOC+2
	JMP	.-3		/
/
/SUBROUTINE NUMERC
/
/NUMERC LOOKS AT THE CHARACTER IN THE AC AND
/RETURNS TO LOC+1 IF IT IS NUMERIC TO LOC+2
/OTHERWISE
/
NUMERC	0			/
	DAC	CHRHLD		/SAVE CHARACTER
	TAD	ML60		/
	SPA			/IS CHARACTER>57?
	JMP	NONUM		/NO
	TAD	ML12		/YES
	SMA			/IS CHAR.<71?
	JMP	NONUM		/NO
	LAC	CHRHLD		/YES, RESTORE CHAR
	JMP*	NUMERC		/RETURN TO LOC+1
NONUM	ISZ	NUMERC		/RETURN TO LOC+2
	JMP	.-3		/
	.EJECT
/
/SUBROUTINE OUTPUT
/
/AT THE END OF THE SOURCE SCAN OUTPUT IS
/CALLED TO GENERATE OUTPUT
/
OFLAG=DBLBUF			/LINE FULL FLAG
ERR1%	ERRLIN-1
ERRLIN	.ASCII	'CORE EXHAUSTED AT LINE   '
/
/ ENTER HERE IN CASE WE EXHAUSTED CORE.
/
OUTPT1=.
	LAW	-12
	DAC	TEMP
	LAC	SRCBF%
	DAC*	L11
	LAC	ERR1%
	DAC*	L10
	LAC*	10
	DAC*	11
	ISZ	TEMP
	JMP	.-3
	JMS	OINIT
	LAC	SRCBF%
	TAD	D2
	TAD	L10
	DAC	CHRCNT
	LAC	LINENO
	JMS	UNDEC
	JMS	OWRITE
/
/ NORMAL ENTRY TO OUTPUT ROUTINE.
/
OUTPT2=.
	JMS	LINHDR
	JMS	OINIT		/INITIALIZE OUTPUT BUFFERS
	LAC*	SCM102		/
OUTST	DAC	PACKS+1		/
	DAC	TEMP		/
	LAC*	TEMP		/GET SYMBOL WORD 1
	JMS	UNSIX		/CONVERT IT TO 5/7 ASCII
	ISZ	TEMP		/
	LAC*	TEMP		/GET SYMBOL WORD 2
	JMS	UNSIX		/CONVERT IT TO 5-7 ASCII
	LAC	SPACE		/PACK-IN A SPACE
	JMS	OPACK		/
	LAC	TEMP		/ONLY 5 CHARACTERS IF NOT A
	TAD	D3		/DIRECT ASSIGNMENT
	DAC	UNOCTL
	LAC*	UNOCTL
	SMA
	DZM	OINIT
	ISZ	TEMP
	LAC*	TEMP
	JMS	UNOCTL
	LAC	TEMP		/
	TAD	D2
	DAC	TEMP		/
	LAC*	TEMP		/GET FIRST LINE NUMBER
	AND	L37777		/
OLOOP	JMS	UNDEC		/CONVERT LINE # AND PACK IT
	ISZ	TEMP		/
	LAC*	TEMP		/FETCH FORWARD POINTER
	SMA
	JMP	OUTCE1
	AND	L77777
	DAC*	TEMP
	LAC	STAR
	JMS	OPACK
	LAC*	TEMP
OUTCE	SNA			/ARE WE DONE FOR THIS SYMBOL?
	JMP	ONEXT		/YES, LOOK AT NEXT SYMBOL
	DAC	TEMP
	LAC	SPACE
	JMS	OPACK
	LAC*	TEMP		/GET LINE#
	ISZ	OFLAG		/IS LINE FULL?
	JMP	OLOOP		/NO
	JMS	OWRITE		/YES
	LAW	-16		/
	DAC	PACKS		/
	LAC	SPACE		/PACK 7 SPACES AT BEGINNING
	JMS	OPACK		/OF NEW LINE
	ISZ	PACKS		/
	JMP	.-3		/
	JMP	OLOOP-2		/
OUTCE1	DAC	UNDEC
	LAC	SPACE
	JMS	OPACK
	LAC	UNDEC
	JMP	OUTCE
ONEXT	JMS	OWRITE		/WRITE LINE
	LAC	PACKS+1		/MOVE POINTER TO NEXT SYMBOL
	TAD	D5		/
				/
	SAD	ENDUST		/ARE WE AT END OF UST?
	JMP	.+3
	TAD	D1
	JMP	OUTST		/NO, CONTINUE
	.CLOSE	-12
	.CLOSE	-11
	LAC	BATCH		/DO WE HAVE TO CALL MACRO
	SZA			/BACK IN?
	JMP	.+3		/YES.
	.EXIT
	.IFUND	%BF15
	LAC	FSTBLK
	DAC	17637
	LAC	MACSZE
	DAC	17641
	LAC	LDADDR
	DAC	17640
	TAD	D1
	DAC*	L0
	JMP	17663
	.ENDC
	.IFDEF	%BF15
	LAC	FSTBLK
	DAC	17772
	LAC	MACSZE
	DAC	17774
	LAC	LDADDR
	TAD	D1
	DAC	17773
	AND	(17777
	XOR	(600000
	DAC	17777
	JMP	17770
	.ENDC
	.EJECT
/
/SUBROUTINE UNSIX - 
/
/ CONVERTS CONTENTS OF AC FROM .SIXBT TO
/ .ASCII AND PACKS RESULT IN BUFFER.
/
UNSIX1=ININPT
UNSIX	0
	DAC	UNSIX1
	JMS	LFT6
	RAL
	JMS	UNDO
	LAC	UNSIX1
	JMS	RT6
	JMS	UNDO
	LAC	UNSIX1
	JMS	UNDO
	JMP*	UNSIX
UNDO	0
	AND	L77
	SNA
	LAC	SPACE
	XOR	L40
	TAD	L40
	JMS	OPACK
	JMP*	UNDO
/
/SUBROUTINE UNDEC - 
/
/ CONVERTS CONTENTS OF AC FROM BINARY TO
/ DECIMAL AND PACKS RESULT IN BUFFER.
/
UNDEC	0			/
	DZM	OINIT		/FLAG LEADING ZEROS
	DAC	OVRL1		/
	JMS	DIVIDE
	LAC	OVRL1
	LAC	D1000
	JMS	UNSEND
	JMS	DIVIDE
	LAC	OVRL1
	LAC	D100
	JMS	UNSEND
	JMS	DIVIDE
	LAC	OVRL1
	LAC	D10
	JMS	UNSEND
	LAC	OVRL1
	JMS	UNSEND
	JMP*	UNDEC
UNSEND	0
	TAD	L60
	SAD	L60
	JMP	.+4
	ISZ	OINIT
	JMS	OPACK
	JMP*	UNSEND
	CLA
	SAD	OINIT
	JMP	.+3
	LAC	L60
	JMP	UNSEND+5
	LAC	SPACE
	JMP	UNSEND+5
/
/ SUBROUTINE UNOCTAL
/
/ CONVERTS CONTENTS OF AC FROM BINARY TO
/ OCTAL}
/
UNOCTL	0
	DAC	UNDEC
	LAC	OINIT		/OINIT=0 IF NOT
	SZA			/DIRECT ASSIGNMENT
	JMP	DIRASG		/IN THIS CASE PRINT
	LAC	UNDEC		/ONLY 5 CHARACTERS
	JMS	LFT4		/IS VARIABLE NAME A MACRO NAME?
	AND	D1
	SZA
	JMP	MACRO		/YES. TYPE 'MACRO.'
	LAC	UNDEC		/NO.
	AND	L77777
	DAC	UNDEC
DIRASG=.
	LAW	-6
	DAC	DIVIDE
	LAC	UNDEC
	SKP
UNLOP	DAC	UNDEC
	AND	L7%50S
	JMS	LFT4
	JMS	UNSEND
	ISZ	OINIT
	LAC	UNDEC
	RTL
	RAL
	ISZ	DIVIDE
	JMP	UNLOP
	LAC	SPACE
	JMS	OPACK
	JMP*	UNOCTL
MACRO	LAC	MACR		/PRINT 'MACRO' INSTEAD OF
	JMS	UNSIX		/OCTAL VALUE
	LAC	MACR+1
	JMS	UNSIX
	JMP*	UNOCTL
MACR	.SIXBT	' MACRO'
/
/SUBROUTINE OINIT - INITIALIZES OUTPUT BUFFERS
/
OINIT	0
	LAW	-5
	DAC	GETPTR
	LAC	SRCBF%
	DAC	CHRCNT
	LAW	-11
	DAC	OFLAG
	JMP*	OINIT
/
/SUBROUTINE OPACK - PACKS OUTPUT BUFFER
/
OPACK	0			/
	ISZ	.+1		/STORE CHARACTER
	DAC	GETWDS		/
	ISZ	GETPTR		/DO WE HAVE 5 CHARS?
	JMP*	OPACK		/NO, RETURN
	LAW	-5		/YES, PACK THEM
	DAC	GETPTR		/RESTORE GETPTR
	LAC	I8		/RESTORE DAC GETWDS
	DAC	OPACK+2		/
	ISZ	CHRCNT		/
	LAC	GETWDS+1	/FETCH FIRST CHARACTER
	JMS	RT8		/PACK IT
	DAC	GETWDS+1	/
	LAC	GETWDS+2	/FETCH SECOND CHAR
	JMS	LFT4		/PACK IT
	XOR	GETWDS+1	/
	DAC	GETWDS+1	/
	LAC	GETWDS+3	/FETCH THIRD CHAR. (LEFT HALF)
	JMS	RT3		/PACK IT
	AND	L17		/
	XOR	GETWDS+1	/
	DAC*	CHRCNT		/FIRST 5/7 ASCII WORD
	LAC	GETWDS+3	/FETCH THIRD CHAR. (RIGHT HALF)
	AND	L7
	JMS	LFT15
	DAC	GETWDS+2	/
	LAC	GETWDS+4	/GET FOURTH CHARACTER
	JMS	LFT8		/PACK IT
	XOR	GETWDS+2	/
	DAC	GETWDS+2	/
	LAC	GETWDS+5	/GET FIFTH CHARACTER
	RAL			/PACK IT
	XOR	GETWDS+2	/
	ISZ	CHRCNT		/
	DAC*	CHRCNT		/SECOND 5/7 ASCII WORD
	JMP*	OPACK		/RETURN
/
/SUBROUTINE OWRITE
/
/ WRITES OUTPUT LINES
/
OWRITE	0
	LAC	HEADER		/RESTORE HEADER WORD
	DAC	SRCBUF
CRFILL	LAC	CR		/MAKE SURE THERE IS A 'CR'
	JMS	OPACK		/AT THE END OF THE LINE.
	LAW	-5		/CLOSE OUT BUFFER
	SAD	GETPTR
	SKP
	JMP	CRFILL
	DZM	SRCBUF+1
	LAC	LINCNT		/ARE WE AT NEW PAGE?
	SNA		/NO.
	JMS	LINHDR		/YES.
	CAL+2766		/WRITE
	11			/
INIT6	SRCBUF
	-44			/
	CAL+766
	12
	JMS	OINIT		/REINITIALIZE BUFFERS
	ISZ	LINCNT
	JMP*	OWRITE
	JMP*	OWRITE		/RETURN
HEADER	022002
/
/ SUBROUTINE LINHDR
/
/ PRINTS HEADER LINE WITH PAGE NUMBER
/ AT THE TOP OF EACH NEW PAGE.
/
LINHDR	0
	ISZ	LSTPGE
	JMS	OINIT
	LAC	HR%
	DAC	CHRCNT
	LAC	LSTPGE
	JMS	UNDEC
	LAW	-4
	DAC	ALPHA
	LAC	SPACE
	JMS	OPACK
	ISZ	ALPHA
	JMP	.-3
	LAC	INIT4
	DAC	ALPHA
	LAC*	ALPHA
	JMS	UNSIX
	ISZ	ALPHA
	LAC*	ALPHA
	JMS	UNSIX
	LAC	SPACE
	JMS	OPACK
	CAL+2766
	11
INIT12	HDRLIN
	-44
	CAL+2766
	11
INIT13	LNFEED
	-44
	CAL+766
	12
	LAW	-67
	DAC	LINCNT
	JMP*	LINHDR
HDRLIN	022002
	0
	.ASCII	<14>'PAGE               CROSS REFERENCE'<15>
	.LOC	.-1
HR%	HDRLIN+3
LNFEED	002002
	0
	.ASCII	<12><15>
	.LOC	.-1
	.EJECT
/
/SUBROUTINE ADRPRO
/
/ADRPRO PROCESSES AN ADDRESS FIELD
/
ADRPRO	0		/
	ISZ	FLDSW
	DZM	CHRCNT		/CLEAR CHARACTER COUNT
ADRCE	ISZ	CHRCNT		/INCREMENT CHARACTER COUNT
	DAC	CHRHLD
	LAC	CHRCNT		/
	SAD	L7		/DO WE HAVE SIX CHARACTERS?
	JMP	ADRNEW		/YES, FOUND SYMBOL, BUT LOOK FOR DEL
	JMS	PACKER		/NO, PACK CHARACTER
	JMS	GETCHR		/GET CHARACTER
	JMS	FALPHA		/IS IT ALPHABETIC?
	JMP	ADRCE		/YES
	JMS	NUMERC		/NO, IS IT NUMERIC?
	JMP	ADRCE		/YES
	SAD	NOSIGN		/NO, IS IT NUMBER SIGN?
	JMP	.-6		/YES, IGNORE IT
	JMS	ADRDEL		/NO, IS IT +, -,*?
	JMP	ADRMOR		/HAVE SYMBOL BUT MAY HAVE MORE
	JMS	TAGDEL		/NO, IS IT SPACE,TAB,;,CR,/?
	JMP	ADRLST		/YES, LAST SYMBOL
	JMP	ADRNEW		/DON'T HAVE SYMB. BUT MAY HAVE MORE
ADRLST	DAC	CHRHLD		/SAVE CHARACTER
	JMS	SYMBOL		/MAKE ENTRY
	LAC	CHRHLD		/RESTORE CHARACTER
	JMP*	ADRPRO		/RETURN
ADRMOR	JMS	SYMBOL		/MAKE ENTRY
	JMS	GETCHR		/GET NEXT CHARACTER
	JMS	FALPHA		/IS IT ALPHABETIC?
	JMP	ADRCE-1		/YES
	JMP	.+3		/NO, LOOK FOR DELIMITER
ADRNEW	JMS	SYMBOL		/MAKE ENTRY
	JMS	GETCHR		/FETCH NEXT CHARACTER
	JMS	TAGDEL		/IS IT A DELIMITER?
	JMP*	ADRPRO		/YES, RETURN
	JMS	ADRDEL		/NO, IS IT AN OPERATOR?
	JMP	ADRMOR+1	/YES, LOOK FOR SYMBOL
	JMP	ADRNEW+1	/NO, CONTINUE
	.EJECT
/
/SUBROUTINE DBLBUF
/
/ DOUBLE BUFFERED INPUT ROUTINE
/
DBLBUF	0			/
DBL	CAL+767			/WAIT FOR SOURCE
	12			/
	LAC	LINENO
	SAD	LSTLIN
	JMP	OUTPT2
	LAC	SRCBUF		/
	AND	L17		/
	SAD	D6		/DID WE HIT AN EOT?
	JMP	EOTEOM
	SAD	D5		/NO, DID WE HIT AN EOF?
	JMP	EOTEOM
	LAW	-42		/NO, MOVE SRCBUF TO LINBUF
	DAC	TEMP		/
	LAC	SRCBF%		/
	DAC*	L10		/
	LAC	LINBF%		/
	DAC*	L11		/
	LAC*	10		/
	DAC*	11		/
	ISZ	TEMP		/
	JMP	.-3		/
	CAL+2767		/READ A LINE
	10			/
INIT3	SRCBUF			/
	-44			/
	LAC	RDLST		/FETCH LAST WORD OF SRCBUF
	AND	IOTLIT		/AND FORCE THE LAST CHARACTER
	XOR	L6400		/TO BE A CR
	DAC	RDLST		/
	JMP*	DBLBUF		/RETURN
ADPCHR	0		/
EOTEOM	LAC	FSWTCH		/COME HERE IF WE HIT
	SZA			/AN EOT OR EOM
	JMP	INIT11
	LAC	LINENO		/HAVE WE PROCESSED ALL INPUT?
	SAD	LSTLIN
	JMP	OUTPT2		/YES.
	.CLOSE	-11		/NO. CLOSE FILES AND
	JMP	CP		/GO TYPE ^P FOR MORE INPUT.
 .END