perm filename CREF.MAC[S,AIL] blob sn#038617 filedate 1973-05-01 generic text, type T, neo UTF8
COMMENT ⊗   VALID 00032 PAGES 
RECORD PAGE   DESCRIPTION
 00001 00001
 00004 00002		TITLE	CREF V002 - CROSS REFERENCE PROGRAM	19 AUG 67
 00006 00003	A=	0			ASCII MODE
 00007 00004	SETRPG:	IFN TMPCC <
 00009 00005	CREF:	SKIPA
 00010 00006	LSTSET:	PUSHJ	PP,NAME1	GET NEXT DEVICE
 00011 00007		MOVE	PP,[XWD -.PP,PPSET]
 00012 00008	MLON
 00015 00009	R0:
 00017 00010	SORT:	HRLI BYTEX,-HASH	SET UP FOR FIST SORT AOBJN
 00019 00011	OUTP:	SKIPN SX,LINKL
 00021 00012	FREAD:	PUSHJ PP,READ	GET CHARACTER COUNT
 00024 00013	DEFMAC:	SKIPA SX,[MACTBL]
 00028 00014	SETLAB:	PUSHJ PP,FREAD	GET LABEL
 00031 00015	SRCH:	MOVE BYTEX,AC0	GET SIXBIT
 00034 00016	GETVAL:	TLZN IO,IODEF
 00035 00017	TABOUT:	MOVEI	C,11
 00036 00018	XCEED:
 00037 00019	FINIS:	TLZN IO,IOEOF	END OF FILE SEEN?
 00039 00020	INSET:	PUSHJ	PP,NAME1	GET NEXT COMMAND NAME
 00041 00021	NAME1:	SETZB	ACDEV,ACFILE
 00043 00022	PROGNP:	JUMPL	PP,PROGN2	ERROR IF OUTPUT
 00044 00023	SWITCH:	PUSHJ	PP,TTYIN
 00046 00024		DEFINE	SETSW		(LETTER,INSTRUCTION) <
 00047 00025	TTYIN:	TLNE IO,IORPG
 00050 00026	ERRCE:	SKIPA	RC,[XWD [SIXBIT /CANNOT ENTER FILE@/],ACFILE]
 00051 00027	READ:	SOSG	INBUF+2		BUFFER EMPTY?
 00052 00028	DMPLST:	OUTPUT	LST,0		OUTPUT BUFFER
 00053 00029	LSTINI:	INIT	LST,AL		LIST IN ASCII LINE MODE
 00054 00030	SVJFF:	0
 00055 00031		END	CREF
 00056 00032
 00057 ENDMK
⊗;
	TITLE	CREF V002 - CROSS REFERENCE PROGRAM	19 AUG 67
SUBTTL -- WARNING::: THIS IS NOT DEC'S CREF!!

;RFS 9/30/70  PUT IN NIH CCL FEATURES.




EXTERNAL	JOBFF,	JOBREL,	JOBDDT,	JOBSYM
INTERNAL	CREF

STANSW==1
TMPCC==0		;ON FOR TEMPCORE UUO.....
AC0=	0
TEMP=	1
TEMP1=	2
WPL=	3
RC=	WPL
SX=	4
BYTEX=	5
BYTEM=	6
TX=	BYTEM
C=	7
CS=	10
LINE=	11
FLAG=	12
FREE=	13
SYMBOL=	14
TOP=	15
IO=	16
PP=	17
P=PP

.WPL=	↑D10
.LPP=	↑D53
.PP=	30

IOLST=	000001
IONCRF=	000002
IOPAGE=	000004
IOFAIL=	000010
IODEF=	000020
IOENDL=	000040
IORPG=	000100
IOTABS=	000200
IOEOF=	000400	;END OF FILE SEEN
IONLZ=	001000	;LEADING ZERO TEST
IOTB2=	002000	;FOR F4
IOLSTS==4000	;SAVE STATE OF IOLST
IOSAME==2000	;TO SYMBOLS WITH SAME NAME(PRINT BLOCKS)

IOSYM=	040000
IOMAC=	100000
IOOP=	200000
IODF2=	020000

%OP=	33
%MAC=	34
%LINE=	35
%SYM=	36
%EOF=	37	;MULTIPLE-PROGRAM BREAK CHARACTER
HASH=↑D101

XX=	-1
A=	0			;ASCII MODE
AL=	1			;ASCII LINE MODE

CTL=	0			;CONTROL DEVICE NUMBER
CHAR=	2			;INPUT DEVICE NUMBER
LST=	3			;LISTING DEVICE NUMBER
CTL2=	4		;RPG INPUT DEVICE NUMBER

;	COMMAND STRING ACCUMULATORS

ACDEV=	TEMP			;DEVICE
ACFILE=	TEMP1			;FILE
ACEXT=	LINE			;EXTENSION
ACDEL=	4			;DELIMITER
ACPNTR=	5			;BYTE POINTER

TIO=	6

TIORW=	1000
TIOLE=	2000
TIOCLD=	20000

OPDEF	RESET	[CALLI	 0]
OPDEF	DEVCHR	[CALLI	 4]
OPDEF	WAIT	[MTAPE	 0]
OPDEF	CORE	[CALLI	11]
OPDEF	UTPCLR	[CALLI	13]
SETRPG:	IFN TMPCC <
	SETZM TMPCOR#
	HRRZ	JOBFF
	HRLI	-200
	MOVEM	CTIBU2+1
	SOS	CTIBU2+1
	MOVSI	TEMP,(SIXBIT /CRE/)
	MOVEM	TEMP,CTIBU2
	MOVE	TEMP,[XWD 2,CTIBU2] ;READ AND DELETE CREF TEMP FILE.
	CALLI	TEMP,44		;SEE IF TEMPCORE IS THERE.
	JRST	TMPEOD		;NO
	ADD	0,TEMP
	MOVEM	0,JOBFF
	MOVEM	0,SVJFF
	IMULI	TEMP,5
	ADDI	TEMP,1		;CHARACTER COUNT
	MOVEM	TEMP,CTIBU2+2
	MOVEI	TEMP,700
	HRLM	TEMP,CTIBU2+1	;BYTE POINTER.
	SETOM	TMPCOR
	JRST	RPGQ
TMPEOD:>
	INIT CTL2,A
	SIXBIT /DSK/
	CTIBU2
	JRST CREF
IFN STANSW,<	MOVE C,[SIXBIT /QQCREF/]
		MOVEM C,CMDDIR>
IFE STANSW,<
	MOVEI	AC0,3
	CALLI	TEMP,30		;JOB NUMBER
	IDIVI	TEMP,12
	ADDI	TEMP+1,20
	LSHC	TEMP+1,-6
	SOJG	AC0,.-3
	HRRI	TEMP+2,(SIXBIT /CRE/)
	MOVEM	TEMP+2,CMDDIR
>
IFN STANSW,<	MOVSI C,(SIXBIT /RPG/)>
IFE STANSW,<	MOVSI C,(SIXBIT /TMP/)>
	MOVEM C,CMDDIR+1
	SETZM CMDDIR+3
	LOOKUP CTL2,CMDDIR
	JRST CREF
	INBUF CTL2,1
	MOVE C,JOBFF
	MOVEM C,SVJFF
RPGQ:	MOVSI IO,IOPAGE!IOSYM!IOMAC!IORPG
	JRST RETRPG
CREF:	SKIPA
	JRST SETRPG
	RESET
	MOVSI IO,IOPAGE!IOSYM!IOMAC
RETRPG:	SETZM	STCLR
	MOVE	0,[XWD STCLR,STCLR+1]
	BLT	0,ENDCLR
	MOVEI	PP,PPSET
	HLLOS UPLIN	;SET TO A LARGE NUMBER
	HLLOS	UPPLIM

CTLSET:	INIT	CTL,AL		;INITIALIZE USER CONSOLE
	SIXBIT	/TTY/
	XWD	CTOBUF,CTIBUF
	JRST	CTLSET		;TRY AGAIN IF ERROR
	INBUF	CTL,1		;INITIALIZE SINGLE CONTROL
	OUTBUF	CTL,1		;BUFFERS
	TLNE IO,IORPG
	JRST LSTSET
	PUSHJ	PP,CRLF		;OUTPUT CARRIAGE RETURN - LINE FEED
	MOVEI	C,"*"
	IDPB	C,CTOBUF+1
	OUTPUT	CTL,
	INPUT	CTL,
LSTSET:	PUSHJ	PP,NAME1	;GET NEXT DEVICE
	SKIPN	ACDEV
	MOVSI	ACDEV,(SIXBIT /LPT/)	;YES, SUPPLY LPT
	MOVEM	ACDEV,LSTDEV	;STORE DEVICE NAME
	MOVEM	ACFILE,LSTDIR	;STORE FILE NAME
	MOVEM	ACEXT,LSTDIR+1
	PUSHJ	PP,LSTINI	;INITIALIZE LISTING OUTPUT
	TLZE	TIO,TIORW	;REWIND REQUESTED?
	MTAPE	LST,1		;YES
	JUMPGE	CS,LSTSE3
	MTAPE	LST,17
	AOJL	CS,.-1
	WAIT	LST,
	STATO	LST,1B24
	MTAPE	LST,16
LSTSE3:	SOJG	CS,.-1

	TLNE	TIO,TIOCLD	;DIRECTORY CLEAR REQUESTED?
	UTPCLR	LST,		;YES, CLEAR IT
	OUTBUF	LST,2		;SET UP A TWO RING BUFFER
	ENTER	LST,LSTDIR	;SET UP DIRECTORY
	JRST	ERRCE		;ERROR
	MOVE	PP,[XWD -.PP,PPSET]
	PUSHJ	PP,INSET
	MOVEI FREE,BLKST-1	;SET UP THINGS FOR COMBG
	MOVEM FREE,BLKND

RECYCL:	HRRZ	FREE,JOBFF	;RETURN FOR MULTIPLE F4 PROGS
	ADDI	FREE,1
	TRZ	FREE,1

	SETZM FSTPNT#

	MOVEI	LINE,1
	CAMGE LINE,LOWLIN
	TLO IO,IOLST	;WE DON'T WANT LISTING YET
	PUSHJ PP,READ	;TEST FIRST CHARACTER
	CAIE C,%EOF	;PROGRAM BREAK?
	JRST M2A	;NO, PROCESS
	JRST M2		;YES, BYPASS
	JRST	M2

MLON
M1:	TLNN	IO,IOLST
	PUSHJ	PP,WRITE
M2:	PUSHJ	PP,READ
M2A:	CAIN C,177
	JRST FAILM
	CAIN C,12
	JRST M1
	CAIN C,15
	JRST FCKLF
	CAIG C,%EOF
	CAIGE C,%OP
	SKIPA
	JRST M2C
	TLZE IO,IOENDL
	JRST	[TLNE IO,IOLST
		JRST .+1
		PUSH PP,C
		MOVEI C,11
		PUSHJ PP,WRITE
		POP PP,C
		JRST .+1]
	JRST M1
M2C:	TLNE IO,IOFAIL
	JRST M1	;IGNORE IF FAIL
	TLZ IO,IOENDL
	TLO IO,IOTB2
	XCT	MTAB-%OP(C)
	JRST	M3
M2B:	CAMGE LINE,LOWLIN
	JRST TSTUP
	TLNN IO,IOLSTS
	TLZ IO,IOLST
TSTUP:	CAMLE LINE,UPLIN
	TLO IO,IOLST
	TLNN	IO,IOLST
	PUSHJ	PP,CNVRT
	TLNE IO,IOTABS
	JRST	[MOVEI C,11
		TLNN IO,IOLST
		PUSHJ PP,WRITE
		JRST .+1]
	AOJA LINE,M2

M3:	MOVEI	AC0,0
M4:	PUSHJ	PP,READ
	CAIGE C,40
	JRST M5A	;NOT SIXBIT
	LSH AC0,6
	SUBI C,40
	ANDI C,77	;AMKE SURE
	IOR AC0,C
	JRST	M4

M5A:	PUSHJ PP,M5
	JRST M2
	LSH AC0,6
M5:	TLNN AC0,770000	;ANY BITS IN HIGH CHR?
	JRST .-2	;JUSTIFY
	JUMPN	AC0,M6
ERROR:	HRROI	RC,[SIXBIT /IMPROPER INPUT DATA@/]
	JRST	ERRFIN

M6:	TDNE	IO,SX
	TLNE	IO,IONCRF
	POPJ PP,

	CAML	LINE,LOWLIM
	CAMLE	LINE,UPPLIM
	TDZA	FLAG,FLAG
	MOVSI	FLAG,(1B0)
	JRST SRCH
	POPJ PP,

MTAB:	MOVSI	SX,IOOP
	MOVSI	SX,IOMAC
	SKIPA	C,LINE
	MOVSI	SX,IOSYM
	JRST R0		;BREAK BETWEEN PROGRAMS

FCKLF:	TLNE IO,IOTABS!IOTB2
	TLO IO,IOENDL
	JRST M1
R0:
	SKIPE BYTEX,BLKST	;CHECK FOR FAIL BLOCK STRUCTURE
	PUSHJ PP,BLKPRN
	TLNN IO,IOSYM
	JRST NOSYM
	MOVEI BYTEX,SYMTBL
	PUSHJ P,SORT
	PUSHJ P,OUTP
NOSYM:	TLNN IO,IOMAC
	JRST NOMAC
	MOVEI BYTEX,MACTBL
	PUSHJ P,SORT
	PUSHJ P,OUTP
NOMAC:	TLNN IO,IOOP
	JRST FINIS
	MOVEI BYTEX,OPTBL
	PUSHJ P,SORT
	PUSHJ P,OUTP
	JRST FINIS

CNVRT:	MOVEI	TEMP,5
	MOVEI	TEMP1,0
CNVRT1:	IDIV	C,TABL(TEMP)
	ADD	TEMP1,C
	ADDI	C,40
	SKIPE	TEMP1
	ADDI	C,20
	PUSHJ	PP,WRITE
	MOVE	C,CS
	SOJGE	TEMP,CNVRT1
	POPJ	PP,

TABL:	DEC	1,10,100,1000,10000,100000

OUTASC:	MOVEI C,0
	LSHC C,6
	ADDI C,40
	PUSHJ P,WRITE0
	JUMPN CS,OUTASC	;ANY MORE TO PRINT?
	POPJ P,	;DONE
SORT:	HRLI BYTEX,-HASH	;SET UP FOR FIST SORT AOBJN
L2:	MOVEI SX,0
	EXCH SX,(BYTEX)		;GET FIRST TABLE ENTRY
	JUMPE SX,NXTENT		;NOTHING THERE
L3:	MOVEI C,-1(BYTEX)	;GET A POINTER FOR LINKING IN
	MOVE FLAG,(SX)
L1:	SKIPN TX,1(C)
	JRST INSRT	;AT END OF CHAIN SO PUT IT IN
	CAML FLAG,(TX)
	JRST CKEQ	;CHECK ON EQUALITY AND INSERT
L4:	MOVE C,TX
	JRST L1
CKEQ:	CAME FLAG,(TX)
	JRST INSRT	;NO THE SAME GO PUT IN
	MOVE FLAG,3(SX)
	MOVE FLAG,(FLAG)
	MOVE TEMP,3(TX)
	CAML FLAG,(TEMP)
	JRST INSRT
	MOVE FLAG,(SX)
	JRST L4
INSRT:	EXCH TX,1(SX)
	MOVEM SX,1(C)
	SKIPE SX,TX
	JRST L3
NXTENT:	AOBJN BYTEX,L2

	SETZM LINKL#	;NO PUT ALL SORTED CHAINS TOGETHER
TRY0:	SUBI BYTEX,HASH
	MOVSI C,400000
	HRLI BYTEX,-HASH
NXTSY:	SKIPN TX,(BYTEX)
	JRST TRYNXT
	CAMG C,(TX)
	JRST CKEQ2
TRYNXT:	AOBJN BYTEX,NXTSY
	CAMN C,[1B0]
	POPJ P,
	MOVE TX,(SX)
	MOVE FLAG,LINKL
	EXCH FLAG,1(TX)
	MOVEM FLAG,(SX)
	MOVEM TX,LINKL
	JRST TRY0
CKEQ2:	CAME C,(TX)
	JRST FND
	MOVE FLAG,3(TX)
	MOVE FLAG,(FLAG)
	MOVE TEMP,(SX)
	MOVE TEMP,3(TEMP)
	CAMGE FLAG,(TEMP)
	JRST TRYNXT
FND:	MOVE C,(TX)
	MOVE SX,BYTEX
	JRST TRYNXT
OUTP:	SKIPN SX,LINKL
CPOPJ:	POPJ P,	;NONE THERE
	TLO IO,IOPAGE
OUTPA:	SKIPL 2(SX)	;IGNORE SYMBOL?
	JRST LNKOUT	;YES
	PUSHJ P,LINOUT
	MOVE CS,(SX)
	PUSHJ P,OUTASC
	MOVE CS,(SX)
	MOVE TX,1(SX)
	CAMN CS,(TX)	;SAME SYMBOL NAME
	JRST ISBLK	;YES, PRINT BLOCK
	TLZN IO,IOSAME	;OR LAST OF SET THAT IS THE SAME?
	JRST NOBLK	;NO
	SKIPA
ISBLK:	TLO IO,IOSAME
DOBLK:	PUSHJ P,TABOUT
	MOVE CS,3(SX)
	MOVE CS,(CS)
	PUSHJ P,OUTASC
NOBLK:	PUSHJ P,OUTP1
LNKOUT:	SKIPN SX,1(SX)
	POPJ P,
	JRST OUTPA

OUTP1:	MOVEI FLAG,3(SX)
LINLP:	HLRZ FLAG,(FLAG)
	JUMPE FLAG,LAST
	HRRZ BYTEX,(FLAG)
	HRLI BYTEX,(POINT 6,0,5)
	ADDI BYTEX,1
	MOVE BYTEM,-1(BYTEX)
	PUSHJ P,OUTP2
	JRST LINLP
LAST:	HRRZ BYTEX,2(SX)
	HRLI BYTEX,(POINT 6,0,5)
	ADDI BYTEX,1
	MOVE BYTEM,-1(BYTEX)
OUTP2:	MOVEI LINE,0
R3:	PUSHJ P,GETVAL
	POPJ P,
	PUSHJ P,CNVRT
	JRST R3
FREAD:	PUSHJ PP,READ	;GET CHARACTER COUNT
	PUSH	PP,TEMP
	MOVE TEMP1,C
	MOVEI	TEMP,(C)
	CAILE	TEMP1,6
	MOVEI	TEMP1,6
	MOVEI AC0,0
FM4:	PUSHJ PP,READ
	LSH AC0,6
	SUBI C,40
	ANDI C,77
	IOR AC0,C
	SOS	TEMP
	SOJG TEMP1,FM4
	JUMPE	TEMP,.+3
	PUSHJ	PP,READ
	SOJN	TEMP,.-2
	POP	PP,TEMP
	POPJ PP,

FAILM:	PUSHJ PP,READ	;IS THIS REALLY THE START?
	CAIE C,102
	JRST NOTINF
	TLZ IO,IOENDL	;INFORMATION WAS SEEN
	TLO IO,IOFAIL	;THIS IS FAIL
FM2:	PUSHJ PP,READ
	CAIN C,177	;POSSIBLE END?
	JRST TEND	;CHECK
	CAILE C,16	;IN RANGE?
	JRST ERROR
	XCT DTAB-1(C)
	JUMPE SX,FM2
	TLZE SX,IODF2	;DO WE WANT TO DEFINE IT?
	TLO IO,IODEF	;YES, SET FLAG
	PUSHJ PP,FREAD	;GET THE SYMBOL
FM6:	PUSHJ PP,M5	;GO ENTER SYYMBOL
	JRST FM2

NOTINF:	PUSH PP,C	;PUT IT OUT AS IT WAS READ
	MOVEI C,177
	TLNN IO,IOLST
	PUSHJ PP,WRITE
	POP PP,C
	JRST M1	;BACK INTO MAIN STREAM

TEND:	MOVE AC0,SVLAB	;IS THERE A LABEL TO PUT IN
	SETZM SVLAB
	MOVSI SX,IOSYM
	SKIPE AC0
	PUSHJ PP,M5
	PUSHJ PP,READ	;CHECK FOR END CHARACTER
	CAIN C,104
	JRST M2		;JUST EAT INFO BUT NO LINE NUMBER
	CAIN C,101
	TLO IO,IOTABS
	CAIE C,103
	CAIN C,101
	SKIPA
	JRST ERROR	;LOSE
	MOVE C,LINE	;SET UP TO ENTER
	JRST M2B

DTAB:	JRST SETLAB
	JRST DLAB
	MOVSI SX,IOOP
	MOVSI SX,IOOP!IODF2
	MOVSI SX,IOMAC
	MOVSI SX,IOMAC!IODF2
	SETZB SX,SVLAB
	JRST COMBIN
	JRST DEFSYM
	JRST ERROR
	JRST DEFMAC
	JRST ERROR
	JRST BBEG
	JRST BBEND
DEFMAC:	SKIPA SX,[MACTBL]
DEFSYM:	MOVEI SX,SYMTBL
	PUSHJ P,FREAD
	MOVE BYTEX,AC0
	IDIVI BYTEX,HASH
	MOVMS TX
	ADDI TX,(SX)
	SKIPN SX,(TX)
	JRST DEFBYP
DEFS1:	CAMN AC0,(SX)	;FIND SYMBOL
	JRST DEFFD
	SKIPE SX,1(SX)
	JRST DEFS1
	JRST DEFBYP	;NO FOUND
DEFFD:	PUSHJ P,FREAD	;NOW GET DEFINITION
	SKIPA
	LSH AC0,6
	TLNN AC0,770000
	JRST .-2
	MOVEM AC0,(SX)
	MOVE AC0,BLKND	;AND BLOCK
	HRRM AC0,3(SX)
	JRST FM2
DEFBYP:	PUSHJ P,FREAD
	JRST FM2
COMBIN:	PUSHJ P,FREAD	;GET FIRST
	MOVE BYTEX,AC0	;AND FINE
	IDIVI BYTEX,HASH
	MOVMS TX
	MOVEI SX,SYMTBL-1(TX)
CMB1:	MOVE TEMP,SX
	SKIPN SX,1(TEMP)
	JRST DEFBYP
	CAME AC0,(SX)
	JRST CMB1
	PUSHJ P,FREAD	;GET OTHER NAME
	MOVE BYTEX,AC0
	IDIVI BYTEX,HASH
	MOVMS TX
	MOVEI TEMP1,SYMTBL-1(TX)
CMB2:	MOVE TX,TEMP1
	SKIPN TEMP1,1(TX)
	JRST MOVSYM
	CAME AC0,(TEMP1)
	JRST CMB2
	LDB BYTEX,[POINT 17,2(TEMP1),17]	;GET LINE
	LDB AC0,[POINT 17,2(SX),17]
	CAML BYTEX,AC0	;AND SEE WHICH IS SMALLER
	JRST CMBOK	;SMALLER IS ONE TO DELETE
	MOVE AC0,2(SX)
	EXCH AC0,2(TEMP1)
	MOVEM AC0,2(SX)
	MOVE AC0,3(SX)
	EXCH AC0,3(TEMP1)
	MOVEM AC0,3(SX)
CMBOK:	MOVE BYTEX,FREE
	ADDI FREE,2
	CAML FREE,JOBREL
	PUSHJ P,XCEED
	MOVE AC0,2(SX)	;THIS CODE IS MAJIC
	HLL AC0,3(TEMP1)
	MOVEM AC0,(BYTEX)
	SKIPN 3(TEMP1)
	MOVEM BYTEX,3(TEMP1)
	MOVE C,3(SX)
	HLLM C,3(TEMP1)
	JUMPE C,[HRLM BYTEX,3(TEMP1)
		JRST .+2]
	HRLM BYTEX,(C)
CMB3:	MOVE TX,FSTPNT	;PUT DELETE BACK ON FREE
	EXCH TX,1(SX)	;AND LINK AROUND
	MOVEM SX,FSTPNT
	MOVEM TX,1(TEMP)
	JRST FM2
MOVSYM:	MOVE BYTEX,AC0	;GET THE SYMBOL NAME AGAIN
	IDIVI BYTEX,HASH
	MOVMS TX
	SKIPE TEMP1,FSTPNT	;GET A BLOCK
	JRST	[MOVE BYTEX,1(TEMP1)
		MOVEM BYTEX,FSTPNT
		JRST MOVS1]
	MOVE TEMP1,FREE
	ADDI FREE,4
	CAML FREE,JOBREL
	PUSHJ P,XCEED
MOVS1:	MOVE BYTEX,SYMTBL(TX)	;INSERT SYMBOL
	MOVEM BYTEX,1(TEMP1)
	MOVEM TEMP1,SYMTBL(TX)
	MOVEM AC0,(TEMP1)
	HRLI BYTEX,2(SX)
	HRRI BYTEX,2(TEMP1)
	BLT BYTEX,3(TEMP1)	;MOVE INFORMATION
	JRST CMB3	;AND GO DELETE OLD ONE
SETLAB:	PUSHJ PP,FREAD	;GET LABEL
	EXCH AC0,SVLAB	;CHANGE FOR OLD
	JUMPE AC0,FM2	;NO OLD, GO GET MORE
	MOVSI SX,IOSYM	;SET TO DEFINE
	JRST FM6

DLAB:	MOVE AC0,SVLAB	;USE LAST LABEL
	SETZM SVLAB
	JUMPE AC0,ERROR	;ERROR IF NONE THERE
	MOVSI SX,IOSYM
	TLO IO,IODEF
	JRST FM6

BBEG:	AOS TEMP,LEVEL	;GET CURRENT LEVEL
	MOVSI SX,0
	PUSHJ PP,COMBG	;GO INSER
	JRST FM2

BBEND:	MOVE TEMP,LEVEL	;CURRENT LEVEL
	MOVEI SX,1
	PUSHJ PP,COMBG
	SOS LEVEL	;RESET
	JRST FM2

COMBG:	PUSHJ PP,FREAD	;GET NAME
	SKIPA
	LSH AC0,6
	TLNN AC0,770000
	JRST .-2
	MOVE TEMP1,FREE
	ADDI FREE,4	;RESERVE 4 WORDS
	CAML FREE,JOBREL
	PUSHJ PP,XCEED	;OVERLAP
	MOVEM AC0,(TEMP1)	;SAVE NAME
	HRLZM TEMP,1(TEMP1)	;AND LEVEL
	MOVEM LINE,2(TEMP1)	;AND CURRENT LINE
	HRLM SX,2(TEMP1)
	MOVE TEMP,BLKND	;SAVE CURRENT POINTER
	HRRM TEMP1,1(TEMP)	;SET UP LINK
	MOVEM TEMP1,BLKND
	POPJ PP,

BLKPRN:	PUSHJ PP,LINOUT
	MOVE CS,@BLKND
	PUSHJ PP,OUTASC
	MOVEI C,11
	PUSHJ PP,WRITE
	MOVE CS,[SIXBIT /PROGRAM/]
	PUSHJ PP,OUTASC
	MOVEI C,"M"
	PUSHJ PP,WRITE
BLKP3:	PUSHJ PP,LINOUT
	HLRZ BYTEM,1(BYTEX)
	LSH BYTEM,-1
	JUMPE BYTEM,BLKP1
	PUSHJ PP,TABOUT
	SOJG BYTEM,.-1
BLKP1:	HLRZ BYTEM,1(BYTEX)
	HLRZ SX,2(BYTEX)
	TRNE BYTEM,1
	ADDI SX,4
	JUMPE SX,BLKP2
	MOVEI C," "
	PUSHJ PP,WRITE
	SOJG SX,.-1
BLKP2:	MOVE CS,(BYTEX)
	PUSHJ PP,OUTASC
	HLRZ SX,2(BYTEX)
	MOVNS SX
	ADDI SX,5
	SKIPA CS,(BYTEX)
	LSH CS,-6
	TRNN CS,77
	AOJA SX,.-2
	MOVEI C," "
	PUSHJ PP,WRITE
	SOJG SX,.-1
	HRRZ C,2(BYTEX)
	PUSHJ PP,CNVRT
	HRRZ BYTEX,1(BYTEX)
	JUMPN BYTEX,BLKP3
	TLO IO,IOPAGE
	POPJ PP,
SRCH:	MOVE BYTEX,AC0	;GET SIXBIT
	IDIVI BYTEX,HASH
	MOVMS TX
	TLNE SX,IOOP
	MOVEI TX,OPTBL(TX)	;SEARCH CORRECT ONE
	TLNE SX,IOMAC
	MOVEI TX,MACTBL(TX)
	TLNE SX,IOSYM
	MOVEI TX,SYMTBL(TX)
	SKIPN SX,(TX)
	JRST NTFND
SRCH1:	CAMN AC0,(SX)
	JRST STV10
	SKIPE SX,1(SX)
	JRST SRCH1
NTFND:	SKIPE SX,FSTPNT
	JRST	[MOVE BYTEX,1(SX)
		MOVEM BYTEX,FSTPNT	;RESET FREE STG
		JRST NTFND1]
	MOVE SX,FREE
	ADDI FREE,4	;GET A SPACE TO PUT NEW SYMBOL
	CAML FREE,JOBREL
	PUSHJ PP,XCEED
NTFND1:	MOVEM AC0,(SX)
	MOVE BYTEX,(TX)	;LINK INTO TABLE
	MOVEM BYTEX,1(SX)
	MOVEM SX,(TX)
	SETZM 3(SX)
	MOVE TX,FREE
	ADDI FREE,2
	CAML FREE,JOBREL
	PUSHJ PP,XCEED
	SETZM 1(TX)
	MOVEI BYTEX,1(TX)
	HRLI BYTEX,(POINT 6,0,5)
	MOVEI C,1
	TLNE IO,IODEF
	TRC C,3
	DPB C,[POINT 6,1(TX),5]
	MOVE C,LINE
	LSH C,1
	TLZN IO,IODEF
	IORI C,1
	HRLM LINE,2(SX)
	HRRM TX,2(SX)
	JRST STV12

STV10:	LDB	C,[POINT 17,2(SX),17]
	HRRZ TX,2(SX)
	CAME C,LINE
	JRST STV10A
	LDB TEMP,[POINT 6,1(TX),5]
	TLNN IO,IODEF
	JRST STV10B
	TROE TEMP,2
	POPJ PP,
	JRST STV10C
STV10B:	TROE TEMP,1
	POPJ PP,
	JRST STV10C
STV10A:	MOVEI TEMP,1
	TLNE IO,IODEF
	TRC TEMP,3
STV10C:	DPB TEMP,[POINT 6,1(TX),5]
STV10D:
	DPB	LINE,[POINT 17,2(SX),17]
	LSH LINE,1
	TLZN IO,IODEF
	IORI LINE,1
	LSH C,1
	SUBM	LINE,C
	LSH LINE,-1	;NOW ELIMINATE DEFINE BIT
	MOVE	BYTEX,0(TX)

STV12:	ORM	FLAG,2(SX)
	CAIGE	C,↑D32
	JRST	STV20
	MOVEM	PP,PPTEMP

STV14:	IDIVI	C,↑D32
	PUSH	PP,CS
	CAIL	C,↑D32
	JRST	STV14
STV16:	TRO	C,40
	PUSHJ	PP,STV20
	POP	PP,C
	CAME	PP,PPTEMP
	JRST	STV16

STV20:	TRNE	BYTEX,1
	CAML	BYTEX,[POINT 6,,16]
	JRST	STV22
	HRRM	FREE,0(BYTEX)
	MOVE	BYTEX,FREE
	HRLI	BYTEX,(POINT 6,,)
	ADDI	FREE,2
	CAML	FREE,JOBREL
	PUSHJ	PP,XCEED

STV22:	IDPB	C,BYTEX
	MOVEM	BYTEX,0(TX)
POPOUT:	POPJ	PP,
GETVAL:	TLZN IO,IODEF
	JRST GETV20
	MOVEI C,"#"
	PUSHJ PP,WRITE
GETV20:	CAMN	BYTEX,BYTEM
	POPJ	PP,
	AOS	0(PP)
	PUSHJ	PP,TABOUT
	MOVEI	C,0
GETV10:	TRNE	BYTEX,1
	CAML	BYTEX,[POINT 6,,16]
	JRST	GETV12
	MOVE	BYTEX,0(BYTEX)
	HRLI	BYTEX,(POINT 6,,)

GETV12:	ILDB	CS,BYTEX
	ROT	CS,-5
	LSHC	C,5
	JUMPN	CS,GETV10
	TRNN C,1	;SET DEFINED FLAG
	TLO IO,IODEF
	LSH C,-1
	ADDB	LINE,C
	POPJ	PP,
TABOUT:	MOVEI	C,11
	SOJGE	WPL,WRITE0
	PUSHJ	PP,LINOUT
	JRST	TABOUT

LINOUT:	SOSG	LPP
	TLO	IO,IOPAGE
	MOVEI	C,15
	PUSHJ	PP,WRITE
	MOVEI	C,12
	PUSHJ	PP,WRITE
	MOVEI	WPL,.WPL
	POPJ	PP,

WRITE0:	TLZN	IO,IOPAGE
	JRST	WRITE
	PUSH	PP,C
	MOVEI	C,14
	PUSHJ	PP,WRITE
	MOVEI	C,.LPP
	MOVEM	C,LPP
	POP	PP,C

WRITE:	SOSG	LSTBUF+2
	PUSHJ	PP,DMPLST
	IDPB	C,LSTBUF+1
	POPJ	PP,
XCEED:
	PUSH	PP,1
	HRRZ	1,JOBREL	;GET CURRENT TOP
	MOVEI	1,2000(1)
XCEED2:	HRROI	RC,[SIXBIT /INSUFFICIENT CORE@/]
	CORE	1,		;REQUEST MORE CORE
	JRST	ERRFIN		;ERROR, BOMB OUT
	POP	PP,1
	POPJ PP,

FINIS:	TLZN IO,IOEOF	;END OF FILE SEEN?
	JRST RECYCL	;NO, RECYCLE
	TLNE IO,IORPG
	JRST RPGFN
	PUSHJ	PP,CRLF
	PUSHJ	PP,CRLF
	MOVE C,FREE
	LSH	C,-↑D10
	ADDI	C,1
	IDIVI	C,↑D10
	JUMPE	C,FINIS1
	ADDI	C,"0"
	PUSHJ	PP,TYO
FINIS1:	MOVEI	C,"0"(CS)
	PUSHJ	PP,TYO
	HRROI	RC,[SIXBIT /K CORE@/]
	PUSHJ	PP,TYPMS1

RPGFN:	CLOSE	LST,
	PUSHJ	PP,TSTLST	;YES, TEST FOR ERRORS
	RELEAS	LST,
	CLOSE	CHAR,
	RELEAS	CHAR,
	TLNN IO,IORPG
	JRST	CREF		;RETURN FOR NEXT ASSEMBLY
	RELEAS CTL,0
	MOVE C,SVJFF
	MOVEM C,JOBFF
	MOVSI IO,IOPAGE!IOMAC!IOSYM!IORPG
RPGFN2:	PUSHJ PP,TTYIN
	CAIG C,15
	CAIGE C,12
	SKIPA
	JRST RPGFN2
	MOVSI C,70000
	ADDM C,CTIBU2+1
	AOS CTIBU2+2
	JRST RETRPG
INSET:	PUSHJ	PP,NAME1	;GET NEXT COMMAND NAME
	SKIPN	ACDEV
	MOVSI	ACDEV,(SIXBIT /DSK/)
	MOVEM	ACDEV,INDEV	;STORE DEVICE
	SKIPN	ACFILE
	MOVE	ACFILE,[SIXBIT /CREF/]
	MOVEM	ACFILE,INDIR	;STORE FILE IN DIRECTORY
	PUSHJ	PP,INDEVI
	TLZE	TIO,TIORW	;REWIND?
	MTAPE	CHAR,1		;YES
	JUMPGE	CS,INSET2
	MTAPE	CHAR,17
	MTAPE	CHAR,17
	AOJL	CS,.-1
	WAIT	CHAR,
	STATO	CHAR,1B24
	MTAPE	CHAR,16
INSET2:	SOJGE	CS,.-1

INSET3:	INBUF	CHAR,2
	JUMPN	ACEXT,INSET4	;TAKE USER'S EXTENSION IF NON-BLANK
IFN STANSW,<MOVSI ACEXT,(SIXBIT /LST/)	;STANFORD DEFLT.>
IFE STANSW,<	MOVSI	ACEXT,(SIXBIT /CRF/)>	;BLANK, TRY .TMP FIRST
	PUSHJ	PP,INSETI
INSET4:	PUSHJ	PP,INSETI
	JUMPE	ACEXT,ERRCF	;ERROR IF ZERO
	POPJ	PP,

INSETI:	HLLM	ACEXT,INDIR+1	;STORE EXTENSION
	LOOKUP	CHAR,INDIR
	TDZA	ACEXT,ACEXT	;CLEAR EXTENSION IF NOT FOUND
	AOS	0(PP)		;SKIP-RETURN IF FOUND
	POPJ	PP,
NAME1:	SETZB	ACDEV,ACFILE
	SETZB	ACEXT,ACDEL
	SETZB	TIO,CS

NAME3:	MOVSI	ACPNTR,(POINT 6,AC0)	;SET POINTER
	TDZA	AC0,AC0		;CLEAR SYMBOL

SLASH:	PUSHJ	PP,SW0
GETIOC:	PUSHJ	PP,TTYIN	;GET INPUT CHARACTER
	CAIN	C,"/"
	JRST	SLASH
	CAIN	C,"("
	JRST	SWITCH
	CAIN	C,":"
	JRST	DEVICE
	CAIN	C,"."
	JRST	NAME
	CAIE	C,"←"
	CAIG	C,15
	JRST	TERM
	CAIN	C,"["
	JRST	PROGNP		;GET PROGRAMER NUMBER PAIR
	SUBI	C,40		;CONVERT TO 6-BIT
	TLNE	ACPNTR,770000	;HAVE WE STORED SIX BYTES?
	IDPB	C,ACPNTR	;NO, STORE IT
	JRST	GETIOC		;GET NEXT CHARACTER

DEVICE:	SKIPA	ACDEV,AC0	;DEVICE NAME
NAME:	MOVE	ACFILE,AC0	;FILE NAME
	MOVE	ACDEL,C		;SET DELIMITER
	JRST	NAME3		;GET NEXT SYMBOL

TERM:	CAIE	ACDEL,":"	;IF PREVIOUS DELIMITER
	CAIN ACDEL,0		;ASSUME FILE NAME IF NOTHING ELSE
	MOVE	ACFILE,AC0	;SET FILE
	CAIN	ACDEL,"."	;IF PERIOD,
	HLLZ	ACEXT,AC0	;SET EXTENSION
	POPJ	PP,		;EXIT
PROGNP:	JUMPL	PP,PROGN2	;ERROR IF OUTPUT
ERRCM:	HRROI	RC,[SIXBIT /COMMAND ERROR@/]
	JRST	ERRFIN

PROGN1:	HRLZM	RC,INDIR+3	;COMMA, STORE LEFT HALF
PROGN2:	MOVEI	RC,0		;CLEAR AC
PROGN3:	PUSHJ	PP,TTYIN
	CAIN	C,","
	JRST	PROGN1		;STORE LEFT HALF
	HRRM	RC,INDIR+3	;ASSUME TERMINAL
	CAIN	C,"]"
	JRST	GETIOC		;YES, RETURN TO MAIN SCAN
	LSH	RC,3		;SHIFT PREVIOUS RESULT
	ADDI	RC,-"0"(C)	;ADD IN NEW NUMBER
	JRST	PROGN3		;GET NEXT CHARACTER
SWITCH:	PUSHJ	PP,TTYIN
	CAIL	C,"0"
	CAILE	C,"9"
	JRST	SWIT1
	PUSHJ	PP,GETLIM
	CAIE	C,","
	JRST	SWIT2
	MOVEM	RC,LOWLIM
	PUSHJ	PP,TTYIN
	PUSHJ	PP,GETLIM
	CAIE	C,")"
	JRST	ERRCM
	MOVEM	RC,UPPLIM
	CAMGE	RC,LOWLIM
	TLO	IO,IONCRF
	JRST	GETIOC

SWIT2:	CAIN C,")"
	JRST GETIOC
	MOVE FREE,RC
	PUSHJ PP,SW1
	JRST SWITCH

SWIT1:	CAIN	C,")"
	JRST	GETIOC
	PUSHJ	PP,SW1
	PUSHJ	PP,TTYIN
	JRST	SWIT1

GETLIM:	TDZA	RC,RC
GETLI1:	PUSHJ	PP,TTYIN
	CAIL	C,"0"
	CAILE	C,"9"
	POPJ	PP,
	IMULI	RC,↑D10
	ADDI	RC,-"0"(C)
	JRST	GETLI1

SW0:	PUSHJ	PP,TTYIN
SW1:	MOVEI	C,-"A"(C)	;CONVERT FROM ASCII TO NUMERIC
	CAILE	C,"Z"-"A"	;WITHIN BOUNDS?
	JRST	ERRCM		;NO, ERROR
	MOVE	RC,[POINT 4,BYTAB]
	IBP	RC
	SOJGE	C,.-1		;MOVE TO PROPER BYTE
	LDB	C,RC		;PICK UP BYTE
	JUMPE	C,ERRCM		;TEST FOR VALID SWITCH
	CAIG	C,SWTABT-SWTAB	;LEGAL ON SOURCE?
	JUMPL	PP,ERRCM	;NO, TEST FOR SOURCE
	XCT	SWTAB-1(C)	;EXECUTE INSTRUCTION
	POPJ	PP,		;EXIT
	DEFINE	SETSW		(LETTER,INSTRUCTION) <
	INSTRUCTION
J=	<"LETTER"-"A">-↑D9*<I=<"LETTER"-"A">/↑D9>
	SETCOD	\I,J>

	DEFINE	SETCOD		(I,J)
	<BYTAB'I=BYTAB'I!<.-SWTAB>B<4*J+3>>

BYTAB0=	0			;INITIALIZE TABLE
BYTAB1=	0
BYTAB2=	0

SWTAB:
	SETSW	Z,<TLO	TIO,TIOCLD	>
SWTABT:
	SETSW	A,<ADDI	CS,1		>
	SETSW	B,<SUBI	CS,1		>
	SETSW	K,<TLZ	IO,IOSYM	>
	SETSW	L,<MOVEM FREE,LOWLIN>
	SETSW	M,<TLZ	IO,IOMAC	>
	SETSW	O,<TLO	IO,IOOP		>
	SETSW	S,<TLO	IO,IOLST!IOLSTS	>
	SETSW	T,<TLO	TIO,TIOLE	>
	SETSW	U,<MOVEM FREE,UPLIN>
	SETSW	W,<TLO	TIO,TIORW	>

BYTAB:
	+BYTAB0
	+BYTAB1
	+BYTAB2
TTYIN:	TLNE IO,IORPG
	JRST RPGIN
	ILDB	C,CTIBUF+1	;GET CHARACTER
TTYIN2:	CAIE	C," "		;SKIP BLANKS
	CAIN	C,"	"	;AND TABS
	JRST	TTYIN
	POPJ	PP,		;NO, EXIT

TYPMSG:	PUSHJ	PP,CRLF		;MOVE TO NEXT LINE
TYPMS1:	HLRE	CS,RC		;GET FIRST MESSAGE
	JUMPL	CS,TYPM1	;BRANCH IF NEGATIVE
	PUSHJ	PP,TYPM2	;TYPE MESSAGE
TYPM1:	HRRZ	CS,RC		;GET SECOND HALF
	PUSHJ	PP,TYPM2

CRLF:	MOVEI	C,15		;OUTPUT CARRIAGE RETURN
	PUSHJ	PP,TYO
	MOVEI	C,12		;AND LINE FEED

TYO:	SOSG	CTOBUF+2	;BUFFER FULL?
	OUTPUT	CTL,0		;YES, DUMP IT
	IDPB	C,CTOBUF+1	;STORE BYTE
	CAIE	C,14		;FORM FEED?
	CAIN	C,12		;OR LINE FEED?
	OUTPUT	CTL,0		;YES
	POPJ	PP,		;AND EXIT

TYPM2:	MOVSI	C,(1B0)		;ANTICIPATE REGISTER WORD
	CAIG	CS,17		;IS IT?
	MOVEM	C,1(CS)		;YES, STORE TERMINATOR
	HRLI	CS,(POINT 6,,)	;FORM BYTE POINTER

TYPM3:	ILDB	C,CS		;GET A SIXBIT BYTE
	CAIN	C,40		;"@"?
	JRST	TYO		;YES, TYPE SPACE AND EXIT
	ADDI	C,40		;NO, FORM 7-BIT ASCII
	PUSHJ	PP,TYO		;OUTPUT CHARACTER
	JRST	TYPM3

RPGIN:	SOSG CTIBU2+2
	JRST CKRPGI
RPGIN1:	IBP CTIBU2+1
	MOVE C,@CTIBU2+1
	TRNN C,1
	JRST RPGIN2
	AOS CTIBU2+1
	MOVNI C,5
	ADDM C,CTIBU2+2
	JRST RPGIN
RPGIN2:	LDB C,CTIBU2+1
	JUMPE C,RPGIN
	JRST TTYIN2
CKRPGI:	IFN TMPCC,<
	SKIPE	TMPCOR
	CALLI 12		;ALL DONE.
>
	IN CTL2,0
	JRST RPGIN1
	STATO CTL2,740000
	JRST RPGCK2
	HRROI RC,[SIXBIT /ERROR READING COMMAND FILE@/]
	JRST ERRFIN
RPGCK2:	SETZM CMDDIR
	SETZM CMDDIR+3	;GET RID OF PPN
	RENAME CTL2,CMDDIR
	HALT
	CALLI 12
ERRCE:	SKIPA	RC,[XWD [SIXBIT /CANNOT ENTER FILE@/],ACFILE]

ERRCF:	MOVE	RC,[XWD [SIXBIT /CANNOT FIND@/],ACFILE]

ERRFIN:	PUSHJ	PP,TYPMSG
	RELEAS	CTL,
	JRST	CREF
READ:	SOSG	INBUF+2		;BUFFER EMPTY?
	JRST	READ3		;YES
READ1:	ILDB	C,INBUF+1	;PLACE CHARACTER IN C
	JUMPE C,READ
	POPJ	PP,

READ3:	INPUT	CHAR,0		;GET NEXT BUFFER
	STATO	CHAR,762000	;ERROR?
	JRST	READ1		;NO, GET CHARACTER
	TLO IO,IOEOF	;FLAG EOF SEEN
	STATO	CHAR,742000
	JRST	R0
	MOVE	AC0,INDEV
	MOVSI	RC,[SIXBIT /INPUT ERROR ON DEVICE@/]
	JRST	ERRFIN
DMPLST:	OUTPUT	LST,0		;OUTPUT BUFFER
TSTLST:	STATO	LST,740000	;ANY ERRORS?
	POPJ	PP,		;NO, EXIT
	MOVE	AC0,LSTDEV
ERRLST:	MOVSI	RC,[SIXBIT /DATA ERROR DEVICE@/]
	JRST	ERRFIN
LSTINI:	INIT	LST,AL		;LIST IN ASCII LINE MODE
LSTDEV:	BLOCK	1
	XWD	LSTBUF,0
	JRST	EINIT		;ERROR EXIT
	POPJ	PP,		;GOOD EXIT

INDEVI:	INIT	CHAR,A
INDEV:	BLOCK	1
	XWD	0,INBUF
INDEVE:	SKIPA	ACDEV,INDEV	;ERROR, SKIP AND SET ACDEV
	POPJ	PP,
EINIT:	MOVE	RC,[XWD ACDEV,[SIXBIT /NOT AVAILABLE@/]]
	JRST	ERRFIN
SVJFF:	0
CTIBU2:	BLOCK 3
CMDDIR:	BLOCK 4
STCLR:
PPSET:	BLOCK	.PP

CTIBUF:	BLOCK	3
CTOBUF:	BLOCK	3

INBUF:	BLOCK	3

INDIR:	BLOCK	4

LSTBUF:	BLOCK	3
LSTDIR:	BLOCK	4
LPP:	BLOCK	1

PPTEMP:	BLOCK	1
OPTBL:	BLOCK HASH
SYMTBL:	BLOCK HASH
MACTBL:	BLOCK HASH

LOWLIN:	BLOCK 1
LOWLIM:	BLOCK	1
UPPLIM:	BLOCK	1
UPLIN:	BLOCK 1
LEVEL:	0
SVLAB:	0
BLKST:	0
BLKND:	0

ENDCLR=	.-1
	END	CREF