	.IFUND %RSX
	.SYSID <	.TITLE	CREF >,<000 EDIT 126>
	.ENDC
	.IFDEF %RSX
	.TITLE	CREF XVM/RSX V1A000 EDIT 126
	.ENDC
/
/COPYRIGHT (C) 1976
/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
/
/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY
/ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH
/THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS
/SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY NOT BE PRO-
/VIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON
/EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO
/THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE
/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE
/WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COM-
/MITMENT BY DIGITAL EQUIPMENT CORPORATION.
/
/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
/OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
	.EJECT
/EDIT  #019	SK	31-AUG-72
/	020	SK	16-NOV-73	INCORPORATE ALL PATCHES TODATE.
/	021	JMW	17-DEC-74	TAKE OUT CONDITIONALIZATIONS AND
/					CODE UNNEEDED FOR DOS-15.
/ 	121	JMW	07/AUG/75	REMOVE X4K CODE AND MAKE RELOCATABLE.
/	122	JMW	11/SEPT/75	PASS ARGS FROM MACRO AT BOTTOM FREE CORE.
/	123	JMW	18/OCT/75	PUT IN RSX CONDITIONALS (AGAIN!!!).
/	124	JMW	03/NOV/75	CORRECTIONS TO RSX CONDITIONALIZATIONS.
/	125	JMW	06/NOV/75	CREF ALL ARGS TO MACRO CALLS.
/	126	JMW	06/MAY/76	RSX-SIMULATE .END IF NONE ON MAIN FILE.
/
/	CREF FOR XVM/DOS AND RSX.
/	CROSS REFERENCE PROGRAM FOR MACRO ELEMENTS: 3RD PASS FOR THE MACRO ASSEMBLER.
/
/	ASSEMBLY PARAMETERS:
/		NONE YIELDS THE STANDARD SYSTEM VERSION;
/		%BIN DEFINED GIVES A VERSION THAT IS A SUBROUTINE THAT RUNS WITH
/		  MACRO UNDER DDT.
/		%RSX PRODUCES THE RSX VERSION.  THERE ARE SEVERAL SUBCONDITIONALS
/		  HERE, FOR .DAT SLOT (LUN) ASSIGNMENTS MOSTLY.
/
/CREF IS LOADED AS A SYSTEM PROGRAM VIA THE READR COMMAND IN PATCH.
/
/	MAX CANGIANO.
/
SHAL=660000
IDX=ISZ
/
/
	.IFDEF %BIN	/(JMW:122)
	.GLOBL CREF	/(JMW:122)
	.ENDC
	.IFDEF %RSX
/
/	DEFAULT LUN ASSIGNMENTS.
/
	.IFUND DAT2
DAT2=14
	.ENDC
	.IFUND DAT3
DAT3=15
	.ENDC
	.IFUND DAT11
DAT11=17
	.ENDC
	.IFUND DAT12
DAT12=20
	.ENDC
	.IFUND DAT13
DAT13=21
	.ENDC
	.IFUND DAT14
DAT14=22
	.ENDC
	.GLOBL CREF,FILNMS,EXIT,IOERR
	.ENDC
	.TITLE MOVE PASS 2 ARGS
/
/ARGUMENTS NEEDED FROM MACRO ARE PASSED AT THE BOTTOM OF FREE CORE.
/
CREF=.
	.IFDEF %BIN
	0		/(JMW:122)SUBROUTINE TO MACRO UNDER DDT.
	.ENDC
	.IFDEF %RSX
	0		/ENTRY POINT FOR RSX CREF.
	LAC FILNMS	/GET STARTING LOCATION OF MACRO ARGS.
	AAC -1
	.ENDC
	.IFUND %RSX
	LAC* SCM102	/(JMW:122) MACRO HAS PUT 16 (8) ARGS AT C(102).
	.ENDC
	DAC* L10
	LAC (FIL2NM-1
	DAC* L11
	.IFUND %RSX
	LAW -16
	.ENDC
	.IFDEF %RSX
	LAW -20			/RSX HAS 2 MORE THAN DOS.
	.ENDC
	DAC TEMP
CREF1	LAC* 10
	DAC* 11
	ISZ TEMP
	JMP CREF1
	.TITLE MOVE USER SYMBOL TABLE.
/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
/
BEGIN	DZM	UPAROP
	.IFUND %RSX
	LAC	MULTIN		/MULTIPLE INPUT?
	SNA
	JMP	INIT1		/NO
	LAC	(SKP		/YES, FORCE ^P
	DAC	CP-2
	DAC	CP-4
	LAC*	SCM152
	SPA
	XOR	L20000
	DAC*	SCM152
INIT1	.INIT	-3,1,RSTRT.
	.WRITE	-3,2,ENDP2-2,8
	.WAIT	-3
	.ENDC
	.IFDEF %RSX
	LAC FIL2NM+2	/CHECK EXTENSION OF FILE NAME.
	SNA
	LAC SIXSRC	/ADD 'SRC' EXTENSION.
	DAC FIL2NM+2
	LAC FILENM+2
	SNA
	LAC SIXSRC	/SAME FOR PRIMARY FILE.
	DAC FILENM+2
INIT1	LAC VERPNT	/NEED TO OUTPUT TO TTY.
	SZA
	JMS ENDPAS	/YES - PRINT THE PASS 2 MESAGE.
	.ENDC
	LAC	USTSZE
	SNA			/IF SIZE OF UST IS 0,THERE ARE
	JMP	FINE		/NO SYMBOLS,THEREFORE EXIT
	.IFUND %RSX
	DAC	OVRL1
	TAD	OVRL1
	TAD	OVRL1
	CMA			/TOPCOR-USTSZE
	ADD* SCM103		/Y=TOPCORE-X.
	DAC*	L10		/SAVE Y IN AIR 10
	DAC	OVRL1		/
	LAC	BEGUST		/GET BEGINNING OF UST
	AAC -1
	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* SCM103		/NO, CONTINUE.
	JMP	.+2		/YES, EXIT
	JMP	LOOP1	
	.ENDC
	.IFDEF %RSX
	LAC BEGUST	/BEG OF THE UST.
	AAC -1
	DAC OVRL1
	LAC ENDPAR	/END OF THE PARTITION.
	AAC -1
	DAC ENDPAR
	DAC FRLAST	/END OF FREE CORE POINTER.
	.ENDC
/
/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
/
	.IFUND %RSX
	LAC*	SCM102
	.ENDC
	.IFDEF %RSX
	LAC ENDTSK	/POINTER TO END OF CREF.
	.ENDC
	AAC -1
	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?
	.IFUND %RSX
	SAD* SCM103		/NO, CONTINUE.
	.ENDC
	.IFDEF %RSX
	SAD ENDPAR		/(JMW:124)
	.ENDC
	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
	AAC 1
	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
	IDIV!SHAL
	3100
	DAC	OVRL1
	LACQ
	JMS	SIXBIT
	JMS	LFT12		/LEFTMOST BITS, THEN STORE
	DAC*	XR1		/IT BACK IN UST ENTRY
	LAC	OVRL1
	IDIV!SHAL
	50
	DAC	OVRL1
	LACQ
	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
	AAC -33
	SMA
	JMP	SIXBT2
	LAC	QUO
	JMP*	SIXBIT
SIXBT2	SZA
	JMP	SIXBT3
	LAC	AND%
	JMP*	SIXBIT
SIXBT3	SAD	(1
	JMP	SIXBT4
	LAC	QUO
	AAC 23
	JMP*	SIXBIT
SIXBT4	LAC	DOT
	JMP*	SIXBIT
L650S	600000
L157S	177777
AVLSPC=OPACK
LINENO=OWRITE
OPPRO=ADRPRO
FALPHA=ALPHA
	.IFDEF %RSX
	4002
	0
	.ENDC
ENDP2	.ASCII	' END OF PASS 2'<15>
FRLAST	FRLAST-1		/LAST AVAILABLE REGISTER
	.TITLE INITIALIZE INPUT.
/INITIALIZE INPUT
	.IFUND %RSX
ININPT	LAC*	L11
	DAC	ENDUST
	AAC 1
	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	INIT3-2
	LAC	INIT7
	DAC	DBL
	DAC	INIT4-2
INIT7	.INIT	-14,0,RSTRT
	LAW	-64
	TAD	.-2
	SPA
	JMP	CP
	JMP	RSTRT
CAL14	2764
CNTRLP	.ASCII	'^P'<175>
INIT11	.CLOSE	-14
	DZM	FSWTCH
	LAC	CAL11
	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
	LAW	-64
	TAD	.-2
	SMA
	JMP	RSTRT
CP=.
	LAC*	SCM152
	SPA
	XOR	L20000
	DAC*	SCM152
	ISZ	UPAROP
	.WRITE	-3,2,CNTRLP-2,4
	JMP	.
UPAROP	0
RSTRT.=.
	LAC	UPAROP
	SNA
	JMP	FINE
	DZM	UPAROP
RSTRT	CAL+767
	3
INIT4	FIL2NM
	.ENDC
	.IFDEF	%RSX
ININPT	LAC*	L11
	DAC	ENDUST
	TAD	(1
	DAC	AVLSPC
	LAC	FSWTCH
	SNA
	JMP	RSTRTA	/SKIP IF NOT F SWITCH
	LAC	(DAT14)	/SET UP TO READ DAT14
	DAC	READA	/SET IN CPB
	DAC	SEKLU	/SET IN SEEK
FILN2F	LAC	FIL2NM	/PICK UP THE FILE NAME
	DAC	SKFIL	/SET IT IN THE CPB REQUEST
	LAC	FIL2NM+1
	DAC	SKFIL+1
	LAC	FIL2NM+2
	DAC	SKFIL+2
	JMP	RSTRT
INIT11	CAL	CLOS14	/CLOSE LUN 14
RSTRTA	LAC	(DAT11)	/SET UP THE READ AND SEEK REQUESTS
	DAC	READA
	DAC	SEKLU
	LAC	FSWTCH	/CHECK TO SEE IF THERE ARE 2 FILES
	DZM	FSWTCH	/CLEAR THE F SWITCH
	SNA
	JMP	FILN2F	/IF NO 2 FILES THEN FILENAME IS IN FIL2NM
	LAC	FILENM	/SET UP THE FILE NAMES
	DAC	SKFIL
	LAC	FILENM+1
	DAC	SKFIL+1
	LAC	FILENM+2
	DAC	SKFIL+2
RSTRT	CAL	SEEKL
	CAL	WFEVR
	LAC	EVR	/PICK UP THE EVENT VARIABLE
	SMA		/IS TI LEGAL?
	JMP	NXTLIN	/GO LOOK AT THE NEXT LINE
	SAD	(-6)	/IS THE FILE NAME LEGAL?
	SKP
	JMS*	IOERR	/NO -- I/O ERROR
	LAC	SEKLU	/LUN OF I/O ERROR
	.ENDC
	.TITLE MAIN FLOW OF CREF.
/
/GENERAL FLOW
/
/START BY READING IN THE NEXT LINE
/
NXTLIN	JMS	DBLBUF		/GET NEXT LINE
	ISZ	LINENO		/UPDATE LINE NUMBER
	LAC	(5		/INITIALIZE 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
	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
	JMP	STCOMS		/NO
STOP	JMS	GETCHR		/GET NEXT CHARACTER
	SAD	SPACE		/PASS OVER BLANKS
	JMP	.-2		/
	JMS	FALPHA		/DO WE HAVE AN OP CODE?
	JMS	OPPRO		/YES
	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
	JMP	STADR+1		/NO
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	NOSIGN		/NO, VARIABLE?
	JMP	STCAL1		/YES.
	SAD	LPAREN		/NO, LEFT PARENTHESIS?
	JMP	STOP		/YES
	JMS	NUMERC
	JMP	.+2
	JMS	FALPHA		/NO, IS IT ALPHABETIC?
	JMS	ADRPRO		/
	JMP	STCOMS		/
STCAL1	JMS	GETCHR		/
	JMP	STCAL1-5	/
STCOMS	SAD	CR		/NO, CR?
	JMP	NXTLIN		/YES
	SAD	SEMICL		/NO, IS IT ;?
	JMP	START		/YES
	SAD	SLASH		/IS IT SLASH?
	JMP	NXTLIN		/YES
	JMS	GETCHR		/NO
	JMP	STCOMS		/LOOP
	.TITLE CONSTANTS, ETC.
/
OVRL1	0
LINCNT	-65
	.IFDEF %RSX
UPAROP	0
	.ENDC
/
/CHARACTER CONSTANTS
/	.OCT
SPACE	40
CHRTBL=.
TAB	11
SEMICL	73
CR	15
PLUS	53
MINUS	55
STAR	52
SLASH	57
AND%	45
DOT	56
LPAREN	50
EQUALS	75
NOSIGN	43
IOTLIT	IOT
/
/OCTAL CONSTANTS AND MASKS
/
	.OCT
L7	7
L13	13
L14	14
L77	77
L177	177
L17	17
L6400	6400
L60	60
L10	10
L37777	37777
L77777	77777
L20000	20000
	.IFUND %RSX
SCM102	102		/.SCOM+2.
SCM152	152
SCM103	103
	.ENDC
L40=SPACE
L11=TAB
L170	170
L7%50S=IOTLIT
/
/CORE LOCATION POINTERS
/
LINBF%	LINBUF+1
/
/PASS 2 ARGUMENTS	/(JMW:122)
/
FIL2NM	0
	0
	0
FILENM	0
	0
	0
FSWTCH	0
BATCH	0
	.IFDEF %RSX
VERPNT	0
ENDPAR	0
	.ENDC
USTSZE	0
ENDUST	0
BEGUST	0
LSTLIN	0
LSTPGE	0
MULTIN	0
/
/BUFFERS AND DATA WORDS
/
PACKS	.BLOCK	2
LINBUF	.BLOCK 43
RDLST	0
CHRHLD	0
CHRCNT	0
FLDSW=UNSIX
/
/ SHIFT ROUTINES
/
LFT4	0
	RTL!CLL
	RTL
	JMP*	LFT4
LFT6	0
	JMS	LFT4
	RTL
	JMP*	LFT6
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
LFT15=RT4
LFT12=RT7
/
CNTRL=LINBUF
USQCTR=LINBUF+1
XR1=LINBUF+2
QUO	0
TEMP	0
	.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		/SAVE CURRENT CHARACTER
	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
	JMS NUMERC	/NO, CHECK IF IT IS A NUMBER
	JMP CHKSYM	/YES, NOW CHECK IF THERE IS A SYMBOL
	JMP	NXTLIN		/NO
/
CHKSYM  JMS GETCHR
	JMS NUMERC	/CHECK IF CHARACTER IS A NUMBER
	JMP CHKSYM	/YES, LOOP
	JMS ADRDEL	/NO, CHECK IF NEXT CHAR. IS AN OPERATOR
	JMP TAGDIR+1	/YES, CHECK FOR SYMBOL
	JMP NXTLIN	/NO, GO TO NEXT LINE
/
TAGEND	JMS GETCHR	/EDIT #16
	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
	LAW	-1		/GET STARTING ADDR. OF UST
	.IFUND %RSX
	TAD*	SCM102		/
	.ENDC
	.IFDEF %RSX
	TAD ENDTSK		/END OF TASK.
	.ENDC
	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
	AAC 5			/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
	AAC 4			/TO NEXT SYMBOL
	JMP	SYMNXT		/
/
/SUBROUTINE TO MAKE NEW ENTRIES IN LINE # LIST
/AND TO READJUST LINKAGES AND POINTERS
/
SYMENT	LAC*	L10		/MOVE POINTER TO FOURTH WORD
	AAC 2			/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			/
	.IFUND %BIN		/(JMW:122)
	ADD	FRLAST		/
	.ENDC
	.IFDEF %BIN		/(JMW:122) IF RUNNING WITH DDT, DON'T WANT
	ADD* SCM103		/(JMW:122)  TO CLOBBER RETURN.
	.ENDC
	SMA			/ARE WE AT END OF FREE CORE?
	JMP*	SYMBOL		/NO, RETURN
	JMP	OUTPT1		/YES.
SYMFST	LAC	TEMP		/ADJUST LAST ENTRY POINTER
	AAC 1
	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	(6		/DO WE NEED THE SIXTH CHAR?
	JMP	GETNEW		/YES, GO DECODE 5 MORE CHARS.
	ISZ	.+1		/NO
GETCAC	LAC	.-.		/FETCH CHARACTER
	AND	L177		/MASK IT
	SAD	D10		/IGNORE LF,FF,VT
	JMP	GETCHR+1
	SAD	L13
	JMP	GETCHR+1
	SAD	L14
	JMP	GETCHR+1
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
	ALS	3
	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	(LAC GETWDS	/RESTORE GETWDS
	DAC	GETCAC		/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	(SAD CHRTBL-2	/SAD CHRTBL-2
	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	(SAD CHRTBL+2
	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	PAKJMP		/SELECT APPROPRIATE JUMP
	TAD	CHRCNT		/
	DAC	.+3		/
	LAC	CHRHLD		/FETCH CHARACTER
	AND	L77
	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
	AAC -100
	SPA			/IS CHAR.>100?
	JMP	NOALPH		/NO
	AAC -33			/YES
	SMA			/IS CHAR.<133?
NOALPH	ISZ	ALPHA		/NO
	LAC	CHRHLD		/YES, RESTORE CHARACTER
	JMP*	ALPHA		/RETURN TO LOC+1
/
/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
	AAC -60
	SPA			/IS CHARACTER>57?
	JMP	NONUM		/NO
	AAC -12		/YES
	SMA			/IS CHAR.<71?
NONUM	ISZ	NUMERC		/NO
	LAC	CHRHLD		/YES, RESTORE CHAR
	JMP*	NUMERC		/RETURN TO LOC+1
	.TITLE OUTPUT ROUTINES.
/
/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	LINBF%
	DAC*	L11
	LAC	ERR1%
	DAC*	L10
	LAC*	10
	DAC*	11
	ISZ	TEMP
	JMP	.-3
	JMS	OINIT
	LAC	LINBF%
	AAC 2
	AAC 10
	DAC	CHRCNT
	LAC	LINENO
	JMS	UNDEC
	JMS	OWRITE
/
/ NORMAL ENTRY TO OUTPUT ROUTINE.
/
OUTPT2=.
	JMS	LINHDR
	JMS	OINIT		/INITIALIZE OUTPUT BUFFERS.
	.IFUND %RSX
	LAC*	SCM102	
	.ENDC
	.IFDEF %RSX
	LAC ENDTSK
	.ENDC
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
	AAC 3			/DIRECT ASSIGNMENT
	DAC	UNOCTL
	LAC*	UNOCTL
	SMA
	DZM	OINIT
	ISZ	TEMP
	LAC*	TEMP
	JMS	UNOCTL
	LAC	TEMP		/
	AAC 2
	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
	AAC 5
	SAD	ENDUST		/ARE WE AT END OF UST?
	JMP	.+3
	AAC 1
	JMP	OUTST		/NO, CONTINUE.
	.IFUND %RSX
FINE	.CLOSE	-12
	.CLOSE	-11
	LAC	BATCH		/DO WE HAVE TO CALL MACRO
	SNA			/BACK IN?
	JMP EXIT		/NO.
	.IFUND %BIN
	.OVRLA MACR15
MACR15	.SIXBT /MACRO/
	.ENDC
	.IFDEF %BIN
	JMP* CREF
	.ENDC
EXIT	.EXIT
	.ENDC
	.IFDEF %RSX
FINE	CAL CLOS12		/CLOSE THE INPUT AND
	CAL CLOS11		/ OUTPUT FILES.
	JMP* CREF		/RETURN TO RESIDENT CODE.
	.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
	AAC 40
	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
	IDIV!SHAL
DTENTH	23420		/10000 DEC.
	DAC OVRL1
	LACQ
	JMS UNSEND
	LAC OVRL1
	IDIV!SHAL
	1750	/1000 DEC
	DAC	OVRL1
	LACQ
	JMS	UNSEND
	LAC	OVRL1
	IDIV!SHAL
	144
	DAC	OVRL1
	LACQ
	JMS	UNSEND
	LAC	OVRL1
	IDIV!SHAL
D10	12
	DAC	OVRL1
	LACQ
	JMS	UNSEND
	LAC	OVRL1
	JMS	UNSEND
	JMP*	UNDEC
UNSEND	0
	AAC 60
	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	(1
	SZA
	JMP	MACRO		/YES. TYPE 'MACRO.'
	LAC	UNDEC		/NO.
	AND	L77777
	DAC	UNDEC
DIRASG=.
	LAW	-6
	DAC	UPAROP
	LAC	UNDEC
	SKP
UNLOP	DAC	UNDEC
	AND	L7%50S
	JMS	LFT4
	JMS	UNSEND
	ISZ	OINIT
	LAC	UNDEC
	RTL
	RAL
	ISZ	UPAROP
	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 MACRO-3
MACR	.SIXBT	' MACRO'
/
/SUBROUTINE OINIT - INITIALIZES OUTPUT BUFFERS
/
OINIT	0
	LAW	-5
	DAC	GETPTR
	LAC (DAC GETWDS		/REINITIALIZE POINTER.
	DAC OPACK+2
	LAC	LINBF%
	DAC	CHRCNT
	LAW	-10	/8 LINE NUMBERS PER LINE
	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	(DAC GETWDS	/RESTORE DAC GETWDS
	DAC	OPACK+2		/
	ISZ	CHRCNT		/
	LAC	GETWDS+1	/FETCH FIRST CHARACTER
	JMS	RT6		/PACK IT
	RTR
	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	LFT6		/PACK IT
	RTL
	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	HDRLIN		/RESTORE HEADER WORD
	DAC	LINBUF
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
	LAC	LINCNT		/ARE WE AT NEW PAGE?
	SNA		/NO.
	JMS	LINHDR		/YES.
	.IFUND %RSX
	.WRITE -12,2,LINBUF,36
	.WAIT -12
	.ENDC
	.IFDEF %RSX
	CAL WROUT
	JMS WFEV		/WAIT FOR EVENT VARIABLE.
	.ENDC
	JMS	OINIT		/REINITIALIZE BUFFERS.
	ISZ	LINCNT
	JMP*	OWRITE
	JMP*	OWRITE		/RETURN
/
/ 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	-3
	DAC	ALPHA
	LAC	SPACE
	JMS	OPACK
	ISZ	ALPHA
	JMP	.-3
	.IFUND %RSX
	LAC	INIT4
	.ENDC
	.IFDEF %RSX
	LAC (SKFIL		/ADDRESS OF FILE NAME.
	.ENDC
	DAC	ALPHA
	LAC*	ALPHA
	JMS	UNSIX
	ISZ	ALPHA
	LAC*	ALPHA
	JMS	UNSIX
	LAC	SPACE
	JMS	OPACK
	.IFUND %RSX
	.WRITE -12,2,HDRLIN,36
	.WRITE -12,2,LNFEED,36
	.WAIT -12
	.ENDC
	.IFDEF %RSX
	CAL WRHDRL
	JMS WFEV	/WAIT FOR PRINT.
	CAL WRLNFD	/OUTPUT LF.
	JMS WFEV	/WAIT.
	.ENDC
	LAW	-65
	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
ADRCE1	JMS	GETCHR		/GET CHARACTER
	JMS	FALPHA		/IS IT ALPHABETIC?
	JMP	ADRCE		/YES
	JMS	NUMERC		/NO, IS IT NUMERIC?
	JMP	ADRCE		/YES
	SAD (54
	JMP ADRMOR
	SAD	NOSIGN		/NO, IS IT NUMBER SIGN?
	JMP	ADRCE1		/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	ADRNW1		/NO, LOOK FOR DELIMITER
ADRNEW	JMS	SYMBOL		/MAKE ENTRY
	JMS	GETCHR		/FETCH NEXT CHARACTER
	SAD (54
	JMP ADRMOR+1
ADRNW1	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
	.TITLE INPUT ROUTINES.
/
/SUBROUTINE DBLBUF
/
/ DOUBLE BUFFERED INPUT ROUTINE
/
DBLBUF	0			/
	.IFUND %RSX
	.READ -11,2,LINBUF,36
INIT3=.-2
DBL	.WAIT -11
	.ENDC
	.IFDEF %RSX
	CAL RDLIN		/READ A LINE FROM INPUT.
	CAL WFEVR		/WAIT.
	LAC EVR		/GET EVENT VARIABLE.
	SPA
	JMP IOER11		/I/O ERROR.
	.ENDC
	LAC	RDLST		/FETCH LAST WORD OF SRCBUF
	AND	IOTLIT		/AND FORCE LAST CHARACTER
	XOR	L6400		/TO BE A CR
	DAC	RDLST
	LAC	LINENO
	SAD	LSTLIN
	JMP	OUTPT2
	LAC	LINBUF		/
	AND	L17		/
	SAD	(6		/DID WE HIT AN EOT?
	JMP	EOTEOM
	SAD	(5		/NO, DID WE HIT AN EOF?
	JMP	EOTEOM
				/NO
	JMP*	DBLBUF		/RETURN
ADPCHR	0		/
EOTEOM	LAC	FSWTCH		/COME HERE IF WE HIT
	SZA			/AN EOT OR EOM
	JMP	INIT11
	.IFUND %RSX
	.CLOSE	-11		/NO. CLOSE FILES AND
	JMP CP			/(JMW:126) GO TYPE CTRL P FOR MORE INPUT.
	.ENDC
	.IFDEF %RSX
	CAL CLOS11
	JMP OUTPT2		/(JMW:126) DEFAULT .END.
	.EJECT
/
/
/	RSX I/O CPB'S AND I/O SUBROUTINES
/
/
CLOS11	3400	/CLOSE CPB
	EVA	/EVENT VARIABLE ADDRESS
	DAT11	/LUN SLOT
/
CLOS12	3400	/CLOSE CPB
	EVA	 /EVENT VARIABLE ADDRESS
	DAT12	/LUN SLOT
/
CLOS14	3400	/CLOSE CPB
	0	/EVENT VARIABLE ADDRESS
	DAT14
/
ENDPAS	0	/PRINT END OF PASS MESSAGE
	CAL	PA2MSG
	CAL	WFEVA	/WAIT FOR EVENT VARIABLE
	JMP*	ENDPAS	/RETURN
/
PA2MSG	2700	/WRITE CPB
	EVA	/EVENT VARIABLE ADDRESS
	DAT3	/LUN SLOT
	2	/MODE IOPS ASCII
	ENDP2-2	/BUFFER ADDRESS
/
SIXSRC	.SIXBT	/SRC/
/
/
WROUT	2700	/WRITE LINE
	EVA	/EVENT VARIABLE ADDRESS
	DAT12	/LUN SLOT
	2	/MODE
	LINBUF	/LINE BUFFER
/
/
SEEKL	3200	/SEEK REQUEST
	EVR	/EVENT VARIABLE ADDRESS
SEKLU	0	/LUN OF SEEK
SKFIL	.BLOCK	3	/FILE NAME
/
/
RDLIN	2600	/READ CPB
	EVR	/EVENT VARIABLE ADDRESS
READA	DAT11	/LUN SLOT
	2	/MODE
INIT3	LINBUF	/LINE BUFFER ADDRESS
	44	/MAX WORD COUNT
/
EVR	0	/EVENT VARIABLE FOR READ
/
WFEVR	20	/WAIT FOR READ
	EVR	/EVENT VARIABLE ADDRESS
/
WFEV	0	/WAIT FOR EVENT VARIABLE AND CHECK VALIDITY
	CAL	WFEVA
	LAC	EVA	/PICK UP THE EVENT VARIABLE
	SMA		/IS IT LEGAL?
	JMP*	WFEV	/YES RETURN
	JMS*	IOERR	/NO PRINT I/O ERROR MESSAGE
	LAC	(DAT12)	/LUN OF I/O ERROR
/
WFEVA	20	/WAIT FOR EVENT VARIABLE
	EVA	/EVENT VARIABLE ADDRESS
/
EVA	0	/EVENT VARIABLE
/
WRHDRL	2700	/WRITE HEADER LINE
	EVA	/EVENT VARIABLE ADDRESS
	DAT12	/LUN SLOT
	2	/MODE
	HDRLIN	/LINE BUFFER ADDRESS
/
WRLNFD	2700	/WRITE LINE FEED
	EVA	/EVENT VARIABLE ADDRESS
	DAT12	/LUN SLOT
	2	/MODE
	LNFEED	/LINE BUFFER ADDRESS
/
ENDTSK	.SIZE		/END OF CREF
IOER11	JMS*	IOERR	/GO REPORT I/O ERROR
	LAC	READA	/LUN OF I/O ERROR
/
RDCP	2600
	EVR	/READ ^P
	DAT2	/TDV INPUT DEVICE
	2	/IOPS ASCII
	LINBUF
/
/
	.ENDC
	.END CREF
