00100		TITLE	CREF V002 - CROSS REFERENCE PROGRAM	19 AUG 67
00102	SUBTTL -- WARNING::: THIS IS NOT DEC'S CREF!!
00104	
00106	;RFS 9/30/70  PUT IN NIH CCL FEATURES.
00108	
00110	
00112	
00200	
00300	EXTERNAL	JOBFF,	JOBREL,	JOBDDT,	JOBSYM
00400	INTERNAL	CREF
00500	
00550	STANSW==0
00552	TMPCC==1		;ON FOR TEMPCORE UUO.....
00600	AC0=	0
00700	TEMP=	1
00800	TEMP1=	2
00900	WPL=	3
01000	RC=	WPL
01100	SX=	4
01200	BYTEX=	5
01300	BYTEM=	6
01400	TX=	BYTEM
01500	C=	7
01600	CS=	10
01700	LINE=	11
01800	FLAG=	12
01900	FREE=	13
02000	SYMBOL=	14
02100	TOP=	15
02200	IO=	16
02300	PP=	17
02400	P=PP
02500	
02600	.WPL=	↑D10
02700	.LPP=	↑D53
02800	.PP=	30
02900	
03000	IOLST=	000001
03100	IONCRF=	000002
03200	IOPAGE=	000004
03300	IOFAIL=	000010
03400	IODEF=	000020
03500	IOENDL=	000040
03600	IORPG=	000100
03700	IOTABS=	000200
03800	IOEOF=	000400	;END OF FILE SEEN
03900	IONLZ=	001000	;LEADING ZERO TEST
04000	IOTB2=	002000	;FOR F4
04100	IOLSTS==4000	;SAVE STATE OF IOLST
04200	IOSAME==2000	;TO SYMBOLS WITH SAME NAME(PRINT BLOCKS)
04300	
04400	IOSYM=	040000
04500	IOMAC=	100000
04600	IOOP=	200000
04700	IODF2=	020000
04800	
04900	%OP=	33
05000	%MAC=	34
05100	%LINE=	35
05200	%SYM=	36
05300	%EOF=	37	;MULTIPLE-PROGRAM BREAK CHARACTER
05400	HASH=↑D101
05500	
05600	XX=	-1
     

00100	A=	0			;ASCII MODE
00200	AL=	1			;ASCII LINE MODE
00300	
00400	CTL=	0			;CONTROL DEVICE NUMBER
00500	CHAR=	2			;INPUT DEVICE NUMBER
00600	LST=	3			;LISTING DEVICE NUMBER
00700	CTL2=	4		;RPG INPUT DEVICE NUMBER
00800	
00900	;	COMMAND STRING ACCUMULATORS
01000	
01100	ACDEV=	TEMP			;DEVICE
01200	ACFILE=	TEMP1			;FILE
01300	ACEXT=	LINE			;EXTENSION
01400	ACDEL=	4			;DELIMITER
01500	ACPNTR=	5			;BYTE POINTER
01600	
01700	TIO=	6
01800	
01900	TIORW=	1000
02000	TIOLE=	2000
02100	TIOCLD=	20000
02200	
02300	OPDEF	RESET	[CALLI	 0]
02400	OPDEF	DEVCHR	[CALLI	 4]
02500	OPDEF	WAIT	[MTAPE	 0]
02600	OPDEF	CORE	[CALLI	11]
02700	OPDEF	UTPCLR	[CALLI	13]
     

00100	SETRPG:	IFN TMPCC <
00102		SETZM TMPCOR#
00104		HRRZ	JOBFF
00106		HRLI	-200
00108		MOVEM	CTIBU2+1
00110		SOS	CTIBU2+1
00112		MOVSI	TEMP,(SIXBIT /CRE/)
00114		MOVEM	TEMP,CTIBU2
00116		MOVE	TEMP,[XWD 2,CTIBU2] ;READ AND DELETE CREF TEMP FILE.
00118		CALLI	TEMP,44		;SEE IF TEMPCORE IS THERE.
00120		JRST	TMPEOD		;NO
00122		ADD	0,TEMP
00124		MOVEM	0,JOBFF
00126		MOVEM	0,SVJFF
00128		IMULI	TEMP,5
00130		ADDI	TEMP,1		;CHARACTER COUNT
00132		MOVEM	TEMP,CTIBU2+2
00134		MOVEI	TEMP,700
00136		HRLM	TEMP,CTIBU2+1	;BYTE POINTER.
00138		SETOM	TMPCOR
00140		JRST	RPGQ
00142	TMPEOD:>
00144		INIT CTL2,A
00200		SIXBIT /DSK/
00300		CTIBU2
00400		JRST CREF
00500	IFN STANSW,<	MOVE C,[SIXBIT /QQCREF/]
00501			MOVEM C,CMDDIR>
00502	IFE STANSW,<
00504		MOVEI	AC0,3
00506		CALLI	TEMP,30		;JOB NUMBER
00508		IDIVI	TEMP,12
00510		ADDI	TEMP+1,20
00512		LSHC	TEMP+1,-6
00514		SOJG	AC0,.-3
00516		HRRI	TEMP+2,(SIXBIT /CRE/)
00518		MOVEM	TEMP+2,CMDDIR
00520	>
00700	IFN STANSW,<	MOVSI C,(SIXBIT /RPG/)>
00702	IFE STANSW,<	MOVSI C,(SIXBIT /TMP/)>
00800		MOVEM C,CMDDIR+1
00900		SETZM CMDDIR+3
01000		LOOKUP CTL2,CMDDIR
01100		JRST CREF
01300		INBUF CTL2,1
01400		MOVE C,JOBFF
01500		MOVEM C,SVJFF
01510	RPGQ:	MOVSI IO,IOPAGE!IOSYM!IOMAC!IORPG
01600		JRST RETRPG
     

00100	CREF:	SKIPA
00200		JRST SETRPG
00300		RESET
00400		MOVSI IO,IOPAGE!IOSYM!IOMAC
00500	RETRPG:	SETZM	STCLR
00600		MOVE	0,[XWD STCLR,STCLR+1]
00700		BLT	0,ENDCLR
00800		MOVEI	PP,PPSET
00900		HLLOS UPLIN	;SET TO A LARGE NUMBER
01000		HLLOS	UPPLIM
01100	
01200	CTLSET:	INIT	CTL,AL		;INITIALIZE USER CONSOLE
01300		SIXBIT	/TTY/
01400		XWD	CTOBUF,CTIBUF
01500		JRST	CTLSET		;TRY AGAIN IF ERROR
01600		INBUF	CTL,1		;INITIALIZE SINGLE CONTROL
01700		OUTBUF	CTL,1		;BUFFERS
01800		TLNE IO,IORPG
01900		JRST LSTSET
02000		PUSHJ	PP,CRLF		;OUTPUT CARRIAGE RETURN - LINE FEED
02100		MOVEI	C,"*"
02200		IDPB	C,CTOBUF+1
02300		OUTPUT	CTL,
02400		INPUT	CTL,
     

00100	LSTSET:	PUSHJ	PP,NAME1	;GET NEXT DEVICE
00200		SKIPN	ACDEV
00300		MOVSI	ACDEV,(SIXBIT /LPT/)	;YES, SUPPLY LPT
00400		MOVEM	ACDEV,LSTDEV	;STORE DEVICE NAME
00500		MOVEM	ACFILE,LSTDIR	;STORE FILE NAME
00600		MOVEM	ACEXT,LSTDIR+1
00700		PUSHJ	PP,LSTINI	;INITIALIZE LISTING OUTPUT
00800		TLZE	TIO,TIORW	;REWIND REQUESTED?
00900		MTAPE	LST,1		;YES
01000		JUMPGE	CS,LSTSE3
01100		MTAPE	LST,17
01200		AOJL	CS,.-1
01300		WAIT	LST,
01400		STATO	LST,1B24
01500		MTAPE	LST,16
01600	LSTSE3:	SOJG	CS,.-1
01700	
01800		TLNE	TIO,TIOCLD	;DIRECTORY CLEAR REQUESTED?
01900		UTPCLR	LST,		;YES, CLEAR IT
02000		OUTBUF	LST,2		;SET UP A TWO RING BUFFER
02100		ENTER	LST,LSTDIR	;SET UP DIRECTORY
02200		JRST	ERRCE		;ERROR
     

00100		MOVE	PP,[XWD -.PP,PPSET]
00200		PUSHJ	PP,INSET
00300		MOVEI FREE,BLKST-1	;SET UP THINGS FOR COMBG
00400		MOVEM FREE,BLKND
00500	
00600	RECYCL:	HRRZ	FREE,JOBFF	;RETURN FOR MULTIPLE F4 PROGS
00700		ADDI	FREE,1
00800		TRZ	FREE,1
00900	
01000		SETZM FSTPNT#
01100	
01200		MOVEI	LINE,1
01300		CAMGE LINE,LOWLIN
01400		TLO IO,IOLST	;WE DON'T WANT LISTING YET
01500		PUSHJ PP,READ	;TEST FIRST CHARACTER
01600		CAIE C,%EOF	;PROGRAM BREAK?
01700		JRST M2A	;NO, PROCESS
01800		JRST M2		;YES, BYPASS
01900		JRST	M2
02000	
     

00100	MLON
00200	M1:	TLNN	IO,IOLST
00300		PUSHJ	PP,WRITE
00400	M2:	PUSHJ	PP,READ
00500	M2A:	CAIN C,177
00600		JRST FAILM
00700		CAIN C,12
00800		JRST M1
00900		CAIN C,15
01000		JRST FCKLF
01100		CAIG C,%EOF
01200		CAIGE C,%OP
01300		SKIPA
01400		JRST M2C
01500		TLZE IO,IOENDL
01600		JRST	[TLNE IO,IOLST
01700			JRST .+1
01800			PUSH PP,C
01900			MOVEI C,11
02000			PUSHJ PP,WRITE
02100			POP PP,C
02200			JRST .+1]
02300		JRST M1
02400	M2C:	TLNE IO,IOFAIL
02500		JRST M1	;IGNORE IF FAIL
02600		TLZ IO,IOENDL
02700		TLO IO,IOTB2
02800		XCT	MTAB-%OP(C)
02900		JRST	M3
03000	M2B:	CAMGE LINE,LOWLIN
03100		JRST TSTUP
03200		TLNN IO,IOLSTS
03300		TLZ IO,IOLST
03400	TSTUP:	CAMLE LINE,UPLIN
03500		TLO IO,IOLST
03600		TLNN	IO,IOLST
03700		PUSHJ	PP,CNVRT
03800		TLNE IO,IOTABS
03900		JRST	[MOVEI C,11
04000			TLNN IO,IOLST
04100			PUSHJ PP,WRITE
04200			JRST .+1]
04300		AOJA LINE,M2
04400	
04500	M3:	MOVEI	AC0,0
04600	M4:	PUSHJ	PP,READ
04700		CAIGE C,40
04800		JRST M5A	;NOT SIXBIT
04900		LSH AC0,6
05000		SUBI C,40
05100		ANDI C,77	;AMKE SURE
05200		IOR AC0,C
05300		JRST	M4
05400	
05500	M5A:	PUSHJ PP,M5
05600		JRST M2
05700		LSH AC0,6
05800	M5:	TLNN AC0,770000	;ANY BITS IN HIGH CHR?
05900		JRST .-2	;JUSTIFY
06000		JUMPN	AC0,M6
06100	ERROR:	HRROI	RC,[SIXBIT /IMPROPER INPUT DATA@/]
06200		JRST	ERRFIN
06300	
06400	M6:	TDNE	IO,SX
06500		TLNE	IO,IONCRF
06600		POPJ PP,
06700	
06800		CAML	LINE,LOWLIM
06900		CAMLE	LINE,UPPLIM
07000		TDZA	FLAG,FLAG
07100		MOVSI	FLAG,(1B0)
07200		JRST SRCH
07300		POPJ PP,
07400	
07500	MTAB:	MOVSI	SX,IOOP
07600		MOVSI	SX,IOMAC
07700		SKIPA	C,LINE
07800		MOVSI	SX,IOSYM
07900		JRST R0		;BREAK BETWEEN PROGRAMS
08000	
08100	FCKLF:	TLNE IO,IOTABS!IOTB2
08200		TLO IO,IOENDL
08300		JRST M1
     

00100	R0:
00200		SKIPE BYTEX,BLKST	;CHECK FOR FAIL BLOCK STRUCTURE
00300		PUSHJ PP,BLKPRN
00400		TLNN IO,IOSYM
00500		JRST NOSYM
00600		MOVEI BYTEX,SYMTBL
00700		PUSHJ P,SORT
00800		PUSHJ P,OUTP
00900	NOSYM:	TLNN IO,IOMAC
01000		JRST NOMAC
01100		MOVEI BYTEX,MACTBL
01200		PUSHJ P,SORT
01300		PUSHJ P,OUTP
01400	NOMAC:	TLNN IO,IOOP
01500		JRST FINIS
01600		MOVEI BYTEX,OPTBL
01700		PUSHJ P,SORT
01800		PUSHJ P,OUTP
01900		JRST FINIS
02000	
02100	CNVRT:	MOVEI	TEMP,5
02200		MOVEI	TEMP1,0
02300	CNVRT1:	IDIV	C,TABL(TEMP)
02400		ADD	TEMP1,C
02500		ADDI	C,40
02600		SKIPE	TEMP1
02700		ADDI	C,20
02800		PUSHJ	PP,WRITE
02900		MOVE	C,CS
03000		SOJGE	TEMP,CNVRT1
03100		POPJ	PP,
03200	
03300	TABL:	DEC	1,10,100,1000,10000,100000
03400	
03500	OUTASC:	MOVEI C,0
03600		LSHC C,6
03700		ADDI C,40
03800		PUSHJ P,WRITE0
03900		JUMPN CS,OUTASC	;ANY MORE TO PRINT?
04000		POPJ P,	;DONE
     

00100	SORT:	HRLI BYTEX,-HASH	;SET UP FOR FIST SORT AOBJN
00200	L2:	MOVEI SX,0
00300		EXCH SX,(BYTEX)		;GET FIRST TABLE ENTRY
00400		JUMPE SX,NXTENT		;NOTHING THERE
00500	L3:	MOVEI C,-1(BYTEX)	;GET A POINTER FOR LINKING IN
00600		MOVE FLAG,(SX)
00700	L1:	SKIPN TX,1(C)
00800		JRST INSRT	;AT END OF CHAIN SO PUT IT IN
00900		CAML FLAG,(TX)
01000		JRST CKEQ	;CHECK ON EQUALITY AND INSERT
01100	L4:	MOVE C,TX
01200		JRST L1
01300	CKEQ:	CAME FLAG,(TX)
01400		JRST INSRT	;NO THE SAME GO PUT IN
01500		MOVE FLAG,3(SX)
01600		MOVE FLAG,(FLAG)
01700		MOVE TEMP,3(TX)
01800		CAML FLAG,(TEMP)
01900		JRST INSRT
02000		MOVE FLAG,(SX)
02100		JRST L4
02200	INSRT:	EXCH TX,1(SX)
02300		MOVEM SX,1(C)
02400		SKIPE SX,TX
02500		JRST L3
02600	NXTENT:	AOBJN BYTEX,L2
02700	
02800		SETZM LINKL#	;NO PUT ALL SORTED CHAINS TOGETHER
02900	TRY0:	SUBI BYTEX,HASH
03000		MOVSI C,400000
03100		HRLI BYTEX,-HASH
03200	NXTSY:	SKIPN TX,(BYTEX)
03300		JRST TRYNXT
03400		CAMG C,(TX)
03500		JRST CKEQ2
03600	TRYNXT:	AOBJN BYTEX,NXTSY
03700		CAMN C,[1B0]
03800		POPJ P,
03900		MOVE TX,(SX)
04000		MOVE FLAG,LINKL
04100		EXCH FLAG,1(TX)
04200		MOVEM FLAG,(SX)
04300		MOVEM TX,LINKL
04400		JRST TRY0
04500	CKEQ2:	CAME C,(TX)
04600		JRST FND
04700		MOVE FLAG,3(TX)
04800		MOVE FLAG,(FLAG)
04900		MOVE TEMP,(SX)
05000		MOVE TEMP,3(TEMP)
05100		CAMGE FLAG,(TEMP)
05200		JRST TRYNXT
05300	FND:	MOVE C,(TX)
05400		MOVE SX,BYTEX
05500		JRST TRYNXT
     

00100	OUTP:	SKIPN SX,LINKL
00200	CPOPJ:	POPJ P,	;NONE THERE
00300		TLO IO,IOPAGE
00400	OUTPA:	SKIPL 2(SX)	;IGNORE SYMBOL?
00500		JRST LNKOUT	;YES
00600		PUSHJ P,LINOUT
00700		MOVE CS,(SX)
00800		PUSHJ P,OUTASC
00900		MOVE CS,(SX)
01000		MOVE TX,1(SX)
01100		CAMN CS,(TX)	;SAME SYMBOL NAME
01200		JRST ISBLK	;YES, PRINT BLOCK
01300		TLZN IO,IOSAME	;OR LAST OF SET THAT IS THE SAME?
01400		JRST NOBLK	;NO
01500		SKIPA
01600	ISBLK:	TLO IO,IOSAME
01700	DOBLK:	PUSHJ P,TABOUT
01800		MOVE CS,3(SX)
01900		MOVE CS,(CS)
02000		PUSHJ P,OUTASC
02100	NOBLK:	PUSHJ P,OUTP1
02200	LNKOUT:	SKIPN SX,1(SX)
02300		POPJ P,
02400		JRST OUTPA
02500	
02600	OUTP1:	MOVEI FLAG,3(SX)
02700	LINLP:	HLRZ FLAG,(FLAG)
02800		JUMPE FLAG,LAST
02900		HRRZ BYTEX,(FLAG)
03000		HRLI BYTEX,(POINT 6,0,5)
03100		ADDI BYTEX,1
03200		MOVE BYTEM,-1(BYTEX)
03300		PUSHJ P,OUTP2
03400		JRST LINLP
03500	LAST:	HRRZ BYTEX,2(SX)
03600		HRLI BYTEX,(POINT 6,0,5)
03700		ADDI BYTEX,1
03800		MOVE BYTEM,-1(BYTEX)
03900	OUTP2:	MOVEI LINE,0
04000	R3:	PUSHJ P,GETVAL
04100		POPJ P,
04200		PUSHJ P,CNVRT
04300		JRST R3
     

00100	FREAD:	PUSHJ PP,READ	;GET CHARACTER COUNT
00200		PUSH	PP,TEMP
00300		MOVE TEMP1,C
00400		MOVEI	TEMP,(C)
00500		CAILE	TEMP1,6
00600		MOVEI	TEMP1,6
00700		MOVEI AC0,0
00800	FM4:	PUSHJ PP,READ
00900		LSH AC0,6
01000		SUBI C,40
01100		ANDI C,77
01200		IOR AC0,C
01300		SOS	TEMP
01400		SOJG TEMP1,FM4
01500		JUMPE	TEMP,.+3
01600		PUSHJ	PP,READ
01700		SOJN	TEMP,.-2
01800		POP	PP,TEMP
01900		POPJ PP,
02000	
02100	FAILM:	PUSHJ PP,READ	;IS THIS REALLY THE START?
02200		CAIE C,102
02300		JRST NOTINF
02400		TLZ IO,IOENDL	;INFORMATION WAS SEEN
02500		TLO IO,IOFAIL	;THIS IS FAIL
02600	FM2:	PUSHJ PP,READ
02700		CAIN C,177	;POSSIBLE END?
02800		JRST TEND	;CHECK
02900		CAILE C,16	;IN RANGE?
03000		JRST ERROR
03100		XCT DTAB-1(C)
03200		JUMPE SX,FM2
03300		TLZE SX,IODF2	;DO WE WANT TO DEFINE IT?
03400		TLO IO,IODEF	;YES, SET FLAG
03500		PUSHJ PP,FREAD	;GET THE SYMBOL
03600	FM6:	PUSHJ PP,M5	;GO ENTER SYYMBOL
03700		JRST FM2
03800	
03900	NOTINF:	PUSH PP,C	;PUT IT OUT AS IT WAS READ
04000		MOVEI C,177
04100		TLNN IO,IOLST
04200		PUSHJ PP,WRITE
04300		POP PP,C
04400		JRST M1	;BACK INTO MAIN STREAM
04500	
04600	TEND:	MOVE AC0,SVLAB	;IS THERE A LABEL TO PUT IN
04700		SETZM SVLAB
04800		MOVSI SX,IOSYM
04900		SKIPE AC0
05000		PUSHJ PP,M5
05100		PUSHJ PP,READ	;CHECK FOR END CHARACTER
05200		CAIN C,104
05300		JRST M2		;JUST EAT INFO BUT NO LINE NUMBER
05400		CAIN C,101
05500		TLO IO,IOTABS
05600		CAIE C,103
05700		CAIN C,101
05800		SKIPA
05900		JRST ERROR	;LOSE
06000		MOVE C,LINE	;SET UP TO ENTER
06100		JRST M2B
06200	
06300	DTAB:	JRST SETLAB
06400		JRST DLAB
06500		MOVSI SX,IOOP
06600		MOVSI SX,IOOP!IODF2
06700		MOVSI SX,IOMAC
06800		MOVSI SX,IOMAC!IODF2
06900		SETZB SX,SVLAB
07000		JRST COMBIN
07100		JRST DEFSYM
07200		JRST ERROR
07300		JRST DEFMAC
07400		JRST ERROR
07500		JRST BBEG
07600		JRST BBEND
     

00100	DEFMAC:	SKIPA SX,[MACTBL]
00200	DEFSYM:	MOVEI SX,SYMTBL
00300		PUSHJ P,FREAD
00400		MOVE BYTEX,AC0
00500		IDIVI BYTEX,HASH
00600		MOVMS TX
00700		ADDI TX,(SX)
00800		SKIPN SX,(TX)
00900		JRST DEFBYP
01000	DEFS1:	CAMN AC0,(SX)	;FIND SYMBOL
01100		JRST DEFFD
01200		SKIPE SX,1(SX)
01300		JRST DEFS1
01400		JRST DEFBYP	;NO FOUND
01500	DEFFD:	PUSHJ P,FREAD	;NOW GET DEFINITION
01600		SKIPA
01700		LSH AC0,6
01800		TLNN AC0,770000
01900		JRST .-2
02000		MOVEM AC0,(SX)
02100		MOVE AC0,BLKND	;AND BLOCK
02200		HRRM AC0,3(SX)
02300		JRST FM2
02400	DEFBYP:	PUSHJ P,FREAD
02500		JRST FM2
02600	COMBIN:	PUSHJ P,FREAD	;GET FIRST
02700		MOVE BYTEX,AC0	;AND FINE
02800		IDIVI BYTEX,HASH
02900		MOVMS TX
03000		MOVEI SX,SYMTBL-1(TX)
03100	CMB1:	MOVE TEMP,SX
03200		SKIPN SX,1(TEMP)
03300		JRST DEFBYP
03400		CAME AC0,(SX)
03500		JRST CMB1
03600		PUSHJ P,FREAD	;GET OTHER NAME
03700		MOVE BYTEX,AC0
03800		IDIVI BYTEX,HASH
03900		MOVMS TX
04000		MOVEI TEMP1,SYMTBL-1(TX)
04100	CMB2:	MOVE TX,TEMP1
04200		SKIPN TEMP1,1(TX)
04300		JRST MOVSYM
04400		CAME AC0,(TEMP1)
04500		JRST CMB2
04600		LDB BYTEX,[POINT 17,2(TEMP1),17]	;GET LINE
04700		LDB AC0,[POINT 17,2(SX),17]
04800		CAML BYTEX,AC0	;AND SEE WHICH IS SMALLER
04900		JRST CMBOK	;SMALLER IS ONE TO DELETE
05000		MOVE AC0,2(SX)
05100		EXCH AC0,2(TEMP1)
05200		MOVEM AC0,2(SX)
05300		MOVE AC0,3(SX)
05400		EXCH AC0,3(TEMP1)
05500		MOVEM AC0,3(SX)
05600	CMBOK:	MOVE BYTEX,FREE
05700		ADDI FREE,2
05800		CAML FREE,JOBREL
05900		PUSHJ P,XCEED
06000		MOVE AC0,2(SX)	;THIS CODE IS MAJIC
06100		HLL AC0,3(TEMP1)
06200		MOVEM AC0,(BYTEX)
06300		SKIPN 3(TEMP1)
06400		MOVEM BYTEX,3(TEMP1)
06500		MOVE C,3(SX)
06600		HLLM C,3(TEMP1)
06700		JUMPE C,[HRLM BYTEX,3(TEMP1)
06800			JRST .+2]
06900		HRLM BYTEX,(C)
07000	CMB3:	MOVE TX,FSTPNT	;PUT DELETE BACK ON FREE
07100		EXCH TX,1(SX)	;AND LINK AROUND
07200		MOVEM SX,FSTPNT
07300		MOVEM TX,1(TEMP)
07400		JRST FM2
07500	MOVSYM:	MOVE BYTEX,AC0	;GET THE SYMBOL NAME AGAIN
07600		IDIVI BYTEX,HASH
07700		MOVMS TX
07800		SKIPE TEMP1,FSTPNT	;GET A BLOCK
07900		JRST	[MOVE BYTEX,1(TEMP1)
08000			MOVEM BYTEX,FSTPNT
08100			JRST MOVS1]
08200		MOVE TEMP1,FREE
08300		ADDI FREE,4
08400		CAML FREE,JOBREL
08500		PUSHJ P,XCEED
08600	MOVS1:	MOVE BYTEX,SYMTBL(TX)	;INSERT SYMBOL
08700		MOVEM BYTEX,1(TEMP1)
08800		MOVEM TEMP1,SYMTBL(TX)
08900		MOVEM AC0,(TEMP1)
09000		HRLI BYTEX,2(SX)
09100		HRRI BYTEX,2(TEMP1)
09200		BLT BYTEX,3(TEMP1)	;MOVE INFORMATION
09300		JRST CMB3	;AND GO DELETE OLD ONE
     

00100	SETLAB:	PUSHJ PP,FREAD	;GET LABEL
00200		EXCH AC0,SVLAB	;CHANGE FOR OLD
00300		JUMPE AC0,FM2	;NO OLD, GO GET MORE
00400		MOVSI SX,IOSYM	;SET TO DEFINE
00500		JRST FM6
00600	
00700	DLAB:	MOVE AC0,SVLAB	;USE LAST LABEL
00800		SETZM SVLAB
00900		JUMPE AC0,ERROR	;ERROR IF NONE THERE
01000		MOVSI SX,IOSYM
01100		TLO IO,IODEF
01200		JRST FM6
01300	
01400	BBEG:	AOS TEMP,LEVEL	;GET CURRENT LEVEL
01500		MOVSI SX,0
01600		PUSHJ PP,COMBG	;GO INSER
01700		JRST FM2
01800	
01900	BBEND:	MOVE TEMP,LEVEL	;CURRENT LEVEL
02000		MOVEI SX,1
02100		PUSHJ PP,COMBG
02200		SOS LEVEL	;RESET
02300		JRST FM2
02400	
02500	COMBG:	PUSHJ PP,FREAD	;GET NAME
02600		SKIPA
02700		LSH AC0,6
02800		TLNN AC0,770000
02900		JRST .-2
03000		MOVE TEMP1,FREE
03100		ADDI FREE,4	;RESERVE 4 WORDS
03200		CAML FREE,JOBREL
03300		PUSHJ PP,XCEED	;OVERLAP
03400		MOVEM AC0,(TEMP1)	;SAVE NAME
03500		HRLZM TEMP,1(TEMP1)	;AND LEVEL
03600		MOVEM LINE,2(TEMP1)	;AND CURRENT LINE
03700		HRLM SX,2(TEMP1)
03800		MOVE TEMP,BLKND	;SAVE CURRENT POINTER
03900		HRRM TEMP1,1(TEMP)	;SET UP LINK
04000		MOVEM TEMP1,BLKND
04100		POPJ PP,
04200	
04300	BLKPRN:	PUSHJ PP,LINOUT
04400		MOVE CS,@BLKND
04500		PUSHJ PP,OUTASC
04600		MOVEI C,11
04700		PUSHJ PP,WRITE
04800		MOVE CS,[SIXBIT /PROGRAM/]
04900		PUSHJ PP,OUTASC
05000		MOVEI C,"M"
05100		PUSHJ PP,WRITE
05200	BLKP3:	PUSHJ PP,LINOUT
05300		HLRZ BYTEM,1(BYTEX)
05400		LSH BYTEM,-1
05500		JUMPE BYTEM,BLKP1
05600		PUSHJ PP,TABOUT
05700		SOJG BYTEM,.-1
05800	BLKP1:	HLRZ BYTEM,1(BYTEX)
05900		HLRZ SX,2(BYTEX)
06000		TRNE BYTEM,1
06100		ADDI SX,4
06200		JUMPE SX,BLKP2
06300		MOVEI C," "
06400		PUSHJ PP,WRITE
06500		SOJG SX,.-1
06600	BLKP2:	MOVE CS,(BYTEX)
06700		PUSHJ PP,OUTASC
06800		HLRZ SX,2(BYTEX)
06900		MOVNS SX
07000		ADDI SX,5
07100		SKIPA CS,(BYTEX)
07200		LSH CS,-6
07300		TRNN CS,77
07400		AOJA SX,.-2
07500		MOVEI C," "
07600		PUSHJ PP,WRITE
07700		SOJG SX,.-1
07800		HRRZ C,2(BYTEX)
07900		PUSHJ PP,CNVRT
08000		HRRZ BYTEX,1(BYTEX)
08100		JUMPN BYTEX,BLKP3
08200		TLO IO,IOPAGE
08300		POPJ PP,
     

00100	SRCH:	MOVE BYTEX,AC0	;GET SIXBIT
00200		IDIVI BYTEX,HASH
00300		MOVMS TX
00400		TLNE SX,IOOP
00500		MOVEI TX,OPTBL(TX)	;SEARCH CORRECT ONE
00600		TLNE SX,IOMAC
00700		MOVEI TX,MACTBL(TX)
00800		TLNE SX,IOSYM
00900		MOVEI TX,SYMTBL(TX)
01000		SKIPN SX,(TX)
01100		JRST NTFND
01200	SRCH1:	CAMN AC0,(SX)
01300		JRST STV10
01400		SKIPE SX,1(SX)
01500		JRST SRCH1
01600	NTFND:	SKIPE SX,FSTPNT
01700		JRST	[MOVE BYTEX,1(SX)
01800			MOVEM BYTEX,FSTPNT	;RESET FREE STG
01900			JRST NTFND1]
02000		MOVE SX,FREE
02100		ADDI FREE,4	;GET A SPACE TO PUT NEW SYMBOL
02200		CAML FREE,JOBREL
02300		PUSHJ PP,XCEED
02400	NTFND1:	MOVEM AC0,(SX)
02500		MOVE BYTEX,(TX)	;LINK INTO TABLE
02600		MOVEM BYTEX,1(SX)
02700		MOVEM SX,(TX)
02800		SETZM 3(SX)
02900		MOVE TX,FREE
03000		ADDI FREE,2
03100		CAML FREE,JOBREL
03200		PUSHJ PP,XCEED
03300		SETZM 1(TX)
03400		MOVEI BYTEX,1(TX)
03500		HRLI BYTEX,(POINT 6,0,5)
03600		MOVEI C,1
03700		TLNE IO,IODEF
03800		TRC C,3
03900		DPB C,[POINT 6,1(TX),5]
04000		MOVE C,LINE
04100		LSH C,1
04200		TLZN IO,IODEF
04300		IORI C,1
04400		HRLM LINE,2(SX)
04500		HRRM TX,2(SX)
04600		JRST STV12
04700	
04800	STV10:	LDB	C,[POINT 17,2(SX),17]
04900		HRRZ TX,2(SX)
05000		CAME C,LINE
05100		JRST STV10A
05200		LDB TEMP,[POINT 6,1(TX),5]
05300		TLNN IO,IODEF
05400		JRST STV10B
05500		TROE TEMP,2
05600		POPJ PP,
05700		JRST STV10C
05800	STV10B:	TROE TEMP,1
05900		POPJ PP,
06000		JRST STV10C
06100	STV10A:	MOVEI TEMP,1
06200		TLNE IO,IODEF
06300		TRC TEMP,3
06400	STV10C:	DPB TEMP,[POINT 6,1(TX),5]
06500	STV10D:
06600		DPB	LINE,[POINT 17,2(SX),17]
06700		LSH LINE,1
06800		TLZN IO,IODEF
06900		IORI LINE,1
07000		LSH C,1
07100		SUBM	LINE,C
07200		LSH LINE,-1	;NOW ELIMINATE DEFINE BIT
07300		MOVE	BYTEX,0(TX)
07400	
07500	STV12:	ORM	FLAG,2(SX)
07600		CAIGE	C,↑D32
07700		JRST	STV20
07800		MOVEM	PP,PPTEMP
07900	
08000	STV14:	IDIVI	C,↑D32
08100		PUSH	PP,CS
08200		CAIL	C,↑D32
08300		JRST	STV14
08400	STV16:	TRO	C,40
08500		PUSHJ	PP,STV20
08600		POP	PP,C
08700		CAME	PP,PPTEMP
08800		JRST	STV16
08900	
09000	STV20:	TRNE	BYTEX,1
09100		CAML	BYTEX,[POINT 6,,16]
09200		JRST	STV22
09300		HRRM	FREE,0(BYTEX)
09400		MOVE	BYTEX,FREE
09500		HRLI	BYTEX,(POINT 6,,)
09600		ADDI	FREE,2
09700		CAML	FREE,JOBREL
09800		PUSHJ	PP,XCEED
09900	
10000	STV22:	IDPB	C,BYTEX
10100		MOVEM	BYTEX,0(TX)
10200	POPOUT:	POPJ	PP,
     

00100	GETVAL:	TLZN IO,IODEF
00200		JRST GETV20
00300		MOVEI C,"#"
00400		PUSHJ PP,WRITE
00500	GETV20:	CAMN	BYTEX,BYTEM
00600		POPJ	PP,
00700		AOS	0(PP)
00800		PUSHJ	PP,TABOUT
00900		MOVEI	C,0
01000	GETV10:	TRNE	BYTEX,1
01100		CAML	BYTEX,[POINT 6,,16]
01200		JRST	GETV12
01300		MOVE	BYTEX,0(BYTEX)
01400		HRLI	BYTEX,(POINT 6,,)
01500	
01600	GETV12:	ILDB	CS,BYTEX
01700		ROT	CS,-5
01800		LSHC	C,5
01900		JUMPN	CS,GETV10
02000		TRNN C,1	;SET DEFINED FLAG
02100		TLO IO,IODEF
02200		LSH C,-1
02300		ADDB	LINE,C
02400		POPJ	PP,
     

00100	TABOUT:	MOVEI	C,11
00200		SOJGE	WPL,WRITE0
00300		PUSHJ	PP,LINOUT
00400		JRST	TABOUT
00500	
00600	LINOUT:	SOSG	LPP
00700		TLO	IO,IOPAGE
00800		MOVEI	C,15
00900		PUSHJ	PP,WRITE
01000		MOVEI	C,12
01100		PUSHJ	PP,WRITE
01200		MOVEI	WPL,.WPL
01300		POPJ	PP,
01400	
01500	WRITE0:	TLZN	IO,IOPAGE
01600		JRST	WRITE
01700		PUSH	PP,C
01800		MOVEI	C,14
01900		PUSHJ	PP,WRITE
02000		MOVEI	C,.LPP
02100		MOVEM	C,LPP
02200		POP	PP,C
02300	
02400	WRITE:	SOSG	LSTBUF+2
02500		PUSHJ	PP,DMPLST
02600		IDPB	C,LSTBUF+1
02700		POPJ	PP,
     

00100	XCEED:
00200		PUSH	PP,1
00300		HRRZ	1,JOBREL	;GET CURRENT TOP
00400		MOVEI	1,2000(1)
00500	XCEED2:	HRROI	RC,[SIXBIT /INSUFFICIENT CORE@/]
00600		CORE	1,		;REQUEST MORE CORE
00700		JRST	ERRFIN		;ERROR, BOMB OUT
00800		POP	PP,1
00900		POPJ PP,
01000	
     

00100	FINIS:	TLZN IO,IOEOF	;END OF FILE SEEN?
00200		JRST RECYCL	;NO, RECYCLE
00300		TLNE IO,IORPG
00400		JRST RPGFN
00500		PUSHJ	PP,CRLF
00600		PUSHJ	PP,CRLF
00700		MOVE C,FREE
00800		LSH	C,-↑D10
00900		ADDI	C,1
01000		IDIVI	C,↑D10
01100		JUMPE	C,FINIS1
01200		ADDI	C,"0"
01300		PUSHJ	PP,TYO
01400	FINIS1:	MOVEI	C,"0"(CS)
01500		PUSHJ	PP,TYO
01600		HRROI	RC,[SIXBIT /K CORE@/]
01700		PUSHJ	PP,TYPMS1
01800	
01900	RPGFN:	CLOSE	LST,
02000		PUSHJ	PP,TSTLST	;YES, TEST FOR ERRORS
02100		RELEAS	LST,
02200		CLOSE	CHAR,
02300		RELEAS	CHAR,
02400		TLNN IO,IORPG
02500		JRST	CREF		;RETURN FOR NEXT ASSEMBLY
02600		RELEAS CTL,0
02700		MOVE C,SVJFF
02800		MOVEM C,JOBFF
02900		MOVSI IO,IOPAGE!IOMAC!IOSYM!IORPG
03000	RPGFN2:	PUSHJ PP,TTYIN
03100		CAIG C,15
03200		CAIGE C,12
03300		SKIPA
03400		JRST RPGFN2
03500		MOVSI C,70000
03600		ADDM C,CTIBU2+1
03700		AOS CTIBU2+2
03800		JRST RETRPG
     

00100	INSET:	PUSHJ	PP,NAME1	;GET NEXT COMMAND NAME
00200		SKIPN	ACDEV
00300		MOVSI	ACDEV,(SIXBIT /DSK/)
00400		MOVEM	ACDEV,INDEV	;STORE DEVICE
00500		SKIPN	ACFILE
00600		MOVE	ACFILE,[SIXBIT /CREF/]
00700		MOVEM	ACFILE,INDIR	;STORE FILE IN DIRECTORY
00800		PUSHJ	PP,INDEVI
00900		TLZE	TIO,TIORW	;REWIND?
01000		MTAPE	CHAR,1		;YES
01100		JUMPGE	CS,INSET2
01200		MTAPE	CHAR,17
01300		MTAPE	CHAR,17
01400		AOJL	CS,.-1
01500		WAIT	CHAR,
01600		STATO	CHAR,1B24
01700		MTAPE	CHAR,16
01800	INSET2:	SOJGE	CS,.-1
01900	
02000	INSET3:	INBUF	CHAR,2
02100		JUMPN	ACEXT,INSET4	;TAKE USER'S EXTENSION IF NON-BLANK
02102	IFN STANSW,<MOVSI ACEXT,(SIXBIT /LST/)	;STANFORD DEFLT.>
02200	IFE STANSW,<	MOVSI	ACEXT,(SIXBIT /CRF/)>	;BLANK, TRY .TMP FIRST
02300		PUSHJ	PP,INSETI
02400	INSET4:	PUSHJ	PP,INSETI
02500		JUMPE	ACEXT,ERRCF	;ERROR IF ZERO
02600		POPJ	PP,
02700	
02800	INSETI:	HLLM	ACEXT,INDIR+1	;STORE EXTENSION
02900		LOOKUP	CHAR,INDIR
03000		TDZA	ACEXT,ACEXT	;CLEAR EXTENSION IF NOT FOUND
03100		AOS	0(PP)		;SKIP-RETURN IF FOUND
03200		POPJ	PP,
     

00100	NAME1:	SETZB	ACDEV,ACFILE
00200		SETZB	ACEXT,ACDEL
00300		SETZB	TIO,CS
00400	
00500	NAME3:	MOVSI	ACPNTR,(POINT 6,AC0)	;SET POINTER
00600		TDZA	AC0,AC0		;CLEAR SYMBOL
00700	
00800	SLASH:	PUSHJ	PP,SW0
00900	GETIOC:	PUSHJ	PP,TTYIN	;GET INPUT CHARACTER
01000		CAIN	C,"/"
01100		JRST	SLASH
01200		CAIN	C,"("
01300		JRST	SWITCH
01400		CAIN	C,":"
01500		JRST	DEVICE
01600		CAIN	C,"."
01700		JRST	NAME
01800		CAIE	C,"←"
01900		CAIG	C,15
02000		JRST	TERM
02100		CAIN	C,"["
02200		JRST	PROGNP		;GET PROGRAMER NUMBER PAIR
02300		SUBI	C,40		;CONVERT TO 6-BIT
02400		TLNE	ACPNTR,770000	;HAVE WE STORED SIX BYTES?
02500		IDPB	C,ACPNTR	;NO, STORE IT
02600		JRST	GETIOC		;GET NEXT CHARACTER
02700	
02800	DEVICE:	SKIPA	ACDEV,AC0	;DEVICE NAME
02900	NAME:	MOVE	ACFILE,AC0	;FILE NAME
03000		MOVE	ACDEL,C		;SET DELIMITER
03100		JRST	NAME3		;GET NEXT SYMBOL
03200	
03300	TERM:	CAIE	ACDEL,":"	;IF PREVIOUS DELIMITER
03400		CAIN ACDEL,0		;ASSUME FILE NAME IF NOTHING ELSE
03500		MOVE	ACFILE,AC0	;SET FILE
03600		CAIN	ACDEL,"."	;IF PERIOD,
03700		HLLZ	ACEXT,AC0	;SET EXTENSION
03800		POPJ	PP,		;EXIT
     

00100	PROGNP:	JUMPL	PP,PROGN2	;ERROR IF OUTPUT
00200	ERRCM:	HRROI	RC,[SIXBIT /COMMAND ERROR@/]
00300		JRST	ERRFIN
00400	
00500	PROGN1:	HRLZM	RC,INDIR+3	;COMMA, STORE LEFT HALF
00600	PROGN2:	MOVEI	RC,0		;CLEAR AC
00700	PROGN3:	PUSHJ	PP,TTYIN
00800		CAIN	C,","
00900		JRST	PROGN1		;STORE LEFT HALF
01000		HRRM	RC,INDIR+3	;ASSUME TERMINAL
01100		CAIN	C,"]"
01200		JRST	GETIOC		;YES, RETURN TO MAIN SCAN
01300		LSH	RC,3		;SHIFT PREVIOUS RESULT
01400		ADDI	RC,-"0"(C)	;ADD IN NEW NUMBER
01500		JRST	PROGN3		;GET NEXT CHARACTER
     

00100	SWITCH:	PUSHJ	PP,TTYIN
00200		CAIL	C,"0"
00300		CAILE	C,"9"
00400		JRST	SWIT1
00500		PUSHJ	PP,GETLIM
00600		CAIE	C,","
00700		JRST	SWIT2
00800		MOVEM	RC,LOWLIM
00900		PUSHJ	PP,TTYIN
01000		PUSHJ	PP,GETLIM
01100		CAIE	C,")"
01200		JRST	ERRCM
01300		MOVEM	RC,UPPLIM
01400		CAMGE	RC,LOWLIM
01500		TLO	IO,IONCRF
01600		JRST	GETIOC
01700	
01800	SWIT2:	CAIN C,")"
01900		JRST GETIOC
02000		MOVE FREE,RC
02100		PUSHJ PP,SW1
02200		JRST SWITCH
02300	
02400	SWIT1:	CAIN	C,")"
02500		JRST	GETIOC
02600		PUSHJ	PP,SW1
02700		PUSHJ	PP,TTYIN
02800		JRST	SWIT1
02900	
03000	GETLIM:	TDZA	RC,RC
03100	GETLI1:	PUSHJ	PP,TTYIN
03200		CAIL	C,"0"
03300		CAILE	C,"9"
03400		POPJ	PP,
03500		IMULI	RC,↑D10
03600		ADDI	RC,-"0"(C)
03700		JRST	GETLI1
03800	
03900	SW0:	PUSHJ	PP,TTYIN
04000	SW1:	MOVEI	C,-"A"(C)	;CONVERT FROM ASCII TO NUMERIC
04100		CAILE	C,"Z"-"A"	;WITHIN BOUNDS?
04200		JRST	ERRCM		;NO, ERROR
04300		MOVE	RC,[POINT 4,BYTAB]
04400		IBP	RC
04500		SOJGE	C,.-1		;MOVE TO PROPER BYTE
04600		LDB	C,RC		;PICK UP BYTE
04700		JUMPE	C,ERRCM		;TEST FOR VALID SWITCH
04800		CAIG	C,SWTABT-SWTAB	;LEGAL ON SOURCE?
04900		JUMPL	PP,ERRCM	;NO, TEST FOR SOURCE
05000		XCT	SWTAB-1(C)	;EXECUTE INSTRUCTION
05100		POPJ	PP,		;EXIT
     

00100		DEFINE	SETSW		(LETTER,INSTRUCTION) <
00200		INSTRUCTION
00300	J=	<"LETTER"-"A">-↑D9*<I=<"LETTER"-"A">/↑D9>
00400		SETCOD	\I,J>
00500	
00600		DEFINE	SETCOD		(I,J)
00700		<BYTAB'I=BYTAB'I!<.-SWTAB>B<4*J+3>>
00800	
00900	BYTAB0=	0			;INITIALIZE TABLE
01000	BYTAB1=	0
01100	BYTAB2=	0
01200	
01300	SWTAB:
01400		SETSW	Z,<TLO	TIO,TIOCLD	>
01500	SWTABT:
01600		SETSW	A,<ADDI	CS,1		>
01700		SETSW	B,<SUBI	CS,1		>
01800		SETSW	K,<TLZ	IO,IOSYM	>
01900		SETSW	L,<MOVEM FREE,LOWLIN>
02000		SETSW	M,<TLZ	IO,IOMAC	>
02100		SETSW	O,<TLO	IO,IOOP		>
02200		SETSW	S,<TLO	IO,IOLST!IOLSTS	>
02300		SETSW	T,<TLO	TIO,TIOLE	>
02400		SETSW	U,<MOVEM FREE,UPLIN>
02500		SETSW	W,<TLO	TIO,TIORW	>
02600	
02700	BYTAB:
02800		+BYTAB0
02900		+BYTAB1
03000		+BYTAB2
     

00100	TTYIN:	TLNE IO,IORPG
00200		JRST RPGIN
00300		ILDB	C,CTIBUF+1	;GET CHARACTER
00400	TTYIN2:	CAIE	C," "		;SKIP BLANKS
00500		CAIN	C,"	"	;AND TABS
00600		JRST	TTYIN
00700		POPJ	PP,		;NO, EXIT
00800	
00900	TYPMSG:	PUSHJ	PP,CRLF		;MOVE TO NEXT LINE
01000	TYPMS1:	HLRE	CS,RC		;GET FIRST MESSAGE
01100		JUMPL	CS,TYPM1	;BRANCH IF NEGATIVE
01200		PUSHJ	PP,TYPM2	;TYPE MESSAGE
01300	TYPM1:	HRRZ	CS,RC		;GET SECOND HALF
01400		PUSHJ	PP,TYPM2
01500	
01600	CRLF:	MOVEI	C,15		;OUTPUT CARRIAGE RETURN
01700		PUSHJ	PP,TYO
01800		MOVEI	C,12		;AND LINE FEED
01900	
02000	TYO:	SOSG	CTOBUF+2	;BUFFER FULL?
02100		OUTPUT	CTL,0		;YES, DUMP IT
02200		IDPB	C,CTOBUF+1	;STORE BYTE
02300		CAIE	C,14		;FORM FEED?
02400		CAIN	C,12		;OR LINE FEED?
02500		OUTPUT	CTL,0		;YES
02600		POPJ	PP,		;AND EXIT
02700	
02800	TYPM2:	MOVSI	C,(1B0)		;ANTICIPATE REGISTER WORD
02900		CAIG	CS,17		;IS IT?
03000		MOVEM	C,1(CS)		;YES, STORE TERMINATOR
03100		HRLI	CS,(POINT 6,,)	;FORM BYTE POINTER
03200	
03300	TYPM3:	ILDB	C,CS		;GET A SIXBIT BYTE
03400		CAIN	C,40		;"@"?
03500		JRST	TYO		;YES, TYPE SPACE AND EXIT
03600		ADDI	C,40		;NO, FORM 7-BIT ASCII
03700		PUSHJ	PP,TYO		;OUTPUT CHARACTER
03800		JRST	TYPM3
03900	
04000	RPGIN:	SOSG CTIBU2+2
04100		JRST CKRPGI
04200	RPGIN1:	IBP CTIBU2+1
04300		MOVE C,@CTIBU2+1
04400		TRNN C,1
04500		JRST RPGIN2
04600		AOS CTIBU2+1
04700		MOVNI C,5
04800		ADDM C,CTIBU2+2
04900		JRST RPGIN
05000	RPGIN2:	LDB C,CTIBU2+1
05100		JUMPE C,RPGIN
05200		JRST TTYIN2
05300	CKRPGI:	IFN TMPCC,<
05302		SKIPE	TMPCOR
05304		CALLI 12		;ALL DONE.
05306	>
05308		IN CTL2,0
05400		JRST RPGIN1
05500		STATO CTL2,740000
05600		JRST RPGCK2
05700		HRROI RC,[SIXBIT /ERROR READING COMMAND FILE@/]
05800		JRST ERRFIN
05900	RPGCK2:	SETZM CMDDIR
06000		SETZM CMDDIR+3	;GET RID OF PPN
06100		RENAME CTL2,CMDDIR
06200		HALT
06300		CALLI 12
     

00100	ERRCE:	SKIPA	RC,[XWD [SIXBIT /CANNOT ENTER FILE@/],ACFILE]
00200	
00300	ERRCF:	MOVE	RC,[XWD [SIXBIT /CANNOT FIND@/],ACFILE]
00400	
00500	ERRFIN:	PUSHJ	PP,TYPMSG
00600		RELEAS	CTL,
00700		JRST	CREF
     

00100	READ:	SOSG	INBUF+2		;BUFFER EMPTY?
00200		JRST	READ3		;YES
00300	READ1:	ILDB	C,INBUF+1	;PLACE CHARACTER IN C
00400		JUMPE C,READ
00500		POPJ	PP,
00600	
00700	READ3:	INPUT	CHAR,0		;GET NEXT BUFFER
00800		STATO	CHAR,762000	;ERROR?
00900		JRST	READ1		;NO, GET CHARACTER
01000		TLO IO,IOEOF	;FLAG EOF SEEN
01100		STATO	CHAR,742000
01200		JRST	R0
01300		MOVE	AC0,INDEV
01400		MOVSI	RC,[SIXBIT /INPUT ERROR ON DEVICE@/]
01500		JRST	ERRFIN
     

00100	DMPLST:	OUTPUT	LST,0		;OUTPUT BUFFER
00200	TSTLST:	STATO	LST,740000	;ANY ERRORS?
00300		POPJ	PP,		;NO, EXIT
00400		MOVE	AC0,LSTDEV
00500	ERRLST:	MOVSI	RC,[SIXBIT /DATA ERROR DEVICE@/]
00600		JRST	ERRFIN
     

00100	LSTINI:	INIT	LST,AL		;LIST IN ASCII LINE MODE
00200	LSTDEV:	BLOCK	1
00300		XWD	LSTBUF,0
00400		JRST	EINIT		;ERROR EXIT
00500		POPJ	PP,		;GOOD EXIT
00600	
00700	INDEVI:	INIT	CHAR,A
00800	INDEV:	BLOCK	1
00900		XWD	0,INBUF
01000	INDEVE:	SKIPA	ACDEV,INDEV	;ERROR, SKIP AND SET ACDEV
01100		POPJ	PP,
01200	EINIT:	MOVE	RC,[XWD ACDEV,[SIXBIT /NOT AVAILABLE@/]]
01300		JRST	ERRFIN
     

00100	SVJFF:	0
00200	CTIBU2:	BLOCK 3
00300	CMDDIR:	BLOCK 4
00400	STCLR:
00500	PPSET:	BLOCK	.PP
00600	
00700	CTIBUF:	BLOCK	3
00800	CTOBUF:	BLOCK	3
00900	
01000	INBUF:	BLOCK	3
01100	
01200	INDIR:	BLOCK	4
01300	
01400	LSTBUF:	BLOCK	3
01500	LSTDIR:	BLOCK	4
01600	LPP:	BLOCK	1
01700	
01800	PPTEMP:	BLOCK	1
01900	OPTBL:	BLOCK HASH
02000	SYMTBL:	BLOCK HASH
02100	MACTBL:	BLOCK HASH
02200	
02300	LOWLIN:	BLOCK 1
02400	LOWLIM:	BLOCK	1
02500	UPPLIM:	BLOCK	1
02600	UPLIN:	BLOCK 1
02700	LEVEL:	0
02800	SVLAB:	0
02900	BLKST:	0
03000	BLKND:	0
03100	
03200	ENDCLR=	.-1
     

00100		END	CREF