/ 
/
/COPYRIGHT (C) 1975
/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
/
/NON-RESIDENT PORTION
/
/COPYRIGHT 1971, DIGITAL EQUIPMENT CORP.
/		MAYNARD, MASS.
/
/		MAX CANGIANO
/		ED MARISON
/
/
/
/EDIT	#054	S.KRISH	9-FEB-73	MICLOG ACTIVE + $$ RTF DELIMITER BUG FIX
/	#055	S.KRISH	15-OCT-73	$CRT + $ADD BUG FIX
/	#057	E.KATZ	7-AUG-74	FIX BAD CONSTANT WHICH CAUSED
/					ASSEMBLY ERROR
/	#058	MJH	20-AUG-75	DISCLAIMER
/	#059	RKB	03-AUG-75	DELETE CODE WHICH	/RKB-059
/					CAUSED A TOP OF FORM	/RKB-059
/					PRIOR TO THE END OF JOB	/RKB-059
/					SUMMARY.		/RKB-059
/								/RKB-059
/	#060	RKB	11-OCT-75	CHANGE THE WAY OF DE-	/RKB-060
/					TECTING EXPANDED IOPS	/RKB-060
/					ERRORS TO MATCH NEW	/RKB-060
/					RESIDENT BOSS METHOD.	/RKB-060
/								/RKB-060
/ 061	04-NOV-75  R. K. BLACKETT	REMOVE THE .INIT FOR	/RKB-061
/					SETTING UP THE ^C ADDR	/RKB-061
/					AS ^C IS NO LONGER IGN-	/RKB-061
/					ORED.			/RKB-061
/					ALSO, ADD '000' IN HDNG	/RKB-061
/								/RKB-061
/
/
/BIT DEFINITIONS FOR .SCOM+52,.SCOM+34,
/.SCOM+75 AND THE AC.STA (STATUS) WORD IN THE
/ACCOUNTING FILE.
/
/.SCOM+52
/BIT0=1	BOSS15 MODE
/BIT1=1	CONTROL CARD READ BY USER.
/	5/7 ASCII IMAGE SAVED IN
/	THE 1'ST BLOCK OF NRBOSS
/BIT2=1	RESIDENT BOSS REACHED "EOF"
/	ON RUN TIME FILE (RTF)
/BIT3=1	USER EXCEEDED TIME ESTIMATE
/BIT4=1	I/O CAL TO GO TO TTY
/BIT5=1	TERMINAL IOPS ERROR BY USER
/BIT6=1	QDUMP TO BE GIVEN TO USER ON IOPS ERRORS
/BIT7=1	OPERATOR ABORT (CONTROL T)
/BIT8=1	JOB ACTIVE
/BIT9=1	EXIT FROM BOSS15 MODE
/BIT10=1 USER TRIED TO DO A .PUT
/	CORE WILL BE DUMPED
/	AND A LISTING GIVEN ON THE LP
/BIT11=1 USER TRIED TO DO A .GET
/BIT12	NOT DEFINED
/BIT13	NOT DEFINED
/BIT14-BIT16  .SYSLD ERROR NUMBER
/BIT17=1 JOB ABORT
	.EJECT
/
/AC.STA
/BITS IN THE AC.STA WORD OF ACCOUNTING
/FILE ENTIES IN GENERAL HAVE THE SAME
/MEANING AS IN .SCOM+52 WITH THE
/FOLLOWING EXCEPTIONS.
/
/BIT0=1	THE "RTF" HAD TO BE RUN WHEN
/	$END ON THE NEXT $JOB
/	CARD WAS READ.
/BIT4=1	ILLEGAL CONTROL CARD FOR ADD FILE
/BIT6=1	QDUMP GIVEN TO USER
/BIT8=1	"RTF" FILE WAS TOO LONG --- > 777(8)
/BIT9,12-15  NOT DEFINED
/BIT16=1	.SYSLD ERROR
/
/.SCOM+34 IS THE USERS ELAPSED TIME IN SECONDS.
/OPERATOR WAIT TIME IS NOT INCLUDED
/IN THIS TIME.
/
/
/.SCOM+75 IS USED TO KEEP COUNT OF THE
/NUMBER OF LINES IN THE "RTF" AND THE
/NUMBER OF LINES READ IN THE "RTF"
/BIT0-8= # OF LINES IN RTF
/BITS9-17= # OF LINES READ IN RTF
/
/
	.TITLE BANK BIT INITIALIZATION
	.ABS
	.LOC	20
CARD=.			/CONTROL CARD IMAGE
/
	.LOC	.+44
IOPSXX=.		/IOPS ERROR DATA
/
	.LOC	.+40
AC.ENT	0		/ACCOUNTING FILE INFORMATION
AC.ID	0
	0
	0
AC.DT	0
AC.TMI	0
AC.TMF	0
AC.DTM	0
AC.STA	0
/
ADDSTA	0		/ADD FILE INFORMATION
ADDFIL	.BLOCK	3
	.LOC	420
/
/STARTING ADDRESS
/
/BANK BIT INITIALIZATION, ONCE ONLY CODE
	JMS	.
	LAC	.-1
	AND	L60000		/TEMP.0=BANK MASK
	DAC	BANK
	LAW	-T1.SZE		/TEMP.1=SIZE OF TAB
	DAC	TEMP.1		/OF ADDRESSES TO BE
BBITS	LAC	T1.		/BANK BIT INITIALIZED
	ISZ	.-1
	TAD	BANK
	DAC	TEMP.2
	LAC*	TEMP.2
	TAD	BANK
	DAC*	TEMP.2
	ISZ	TEMP.1		/FINISHED?
	JMP	BBITS		/NO. LOOP.
	JMP	INITS		/YES. INITIALIZE DAT SLOTS
	.TITLE DATA, CONSTANTS, AND BUFFERS
/
/DATA AND CONSTANTS
/
SHAL=660000
ECLA=641000
IDX=ISZ
SCOM42	0
CRTFLG	0
TEMP.0	0
TEMP.1	0
TEMP.2	0
ARRAY	0
TCLOCK	0		/CURRENT VALUE OF TIME OUT CLOCK
MINS	0
SECS	0
MONTHS	MONTH.-1
GTPTR%	GT.PTR
GTSWP%	GTSWPD
NXTJB%	OPABRT
FLPARM	0
DFPARM	0
BANK	0
BPBLK	0
EXTFLG	0
RTPRNF	SKP
EOM	1006
EOF	1005
CARDP=.
T1.=.
	ADDFL%
	ENT.1+2
	WRT.8+2
	FST.2+2
	SEK.1+2
	RED.1+2
	MONTHS
	GTPTR%
	GTSWP%
	NXTJB%
	FST.1+2
	START+2
	ENT.2+2
	ENT.3+2
	A.0%
	(O.
	(U.0
	D.0%
	(COMND.
	KLJ57
	KLJ57+1
	KLJ57+2
	KLJ57+3
	KLJ57+4
	FST.3+2
	FST.4+2
	RND.1
	RTR.1
	RTR.2
	CRAFIL+2
	DEL.1+2
	CARDP%
	TERM%
	LDERR%
	EXPND%
	CARD%
	ACBUF%
	AC.ID%
	WRT.4+2
	WRT.6+2
	WRT.7+2
	WRT.9+2
	WRT.10+2
	WRT.11+2
	MAXFIL+2
	DMPPRC+2
	RD.1+2
	WRT.1+2
	RD.CRD+2
	TRAN.1+3
	NEWFIL+2
	OPENEW+2
T1.SZE=.-T1.
CARDP%	CARDP
CARD%	CARD
TERM%	TERM
ACBUF%	ACBUFF
AC.ID%	AC.ID
ADDFL%	ADDFIL
A.0%	A.0
D.0%	D.0
EXPND%	IOPSXX+4
RTFFLG=.
LNCNT	0
RPAREN	51
MONTH.	.SIXBT	/JAN/
	.SIXBT	/FEB/
	.SIXBT	/MAR/
	.SIXBT	/APR/
	.SIXBT	/MAY/
	.SIXBT	/JUN/
	.SIXBT	/JUL/
	.SIXBT	/AUG/
	.SIXBT	/SEP/
	.SIXBT	/OCT/
	.SIXBT	/NOV/
	.SIXBT	/DEC/
.MIC	.ASCII	/$MIC/
.JOB	.ASCII	/$JOB/
ZERO	60
ONE	61
TWO	62
THREE	63
FOUR	64
XCT	.SIXBT	/XCT/
L20001	20001
L60000	60000
LM0	400000
LM4	-4
LM10	-10
LM1001	776777
L10000	10000
L131	131
L2000	2000
L1000	1000
L1001	1001
L134	134
L147	147
L152	152
L156	156
L2	2
L4	4
L17	17
L106	106
L150	150
L30	30
L300	300
L466	466
L74	74
L7700	7700
HTAB	11
L141	141
L360S	606060
L7A50	700000
L177	177
L17777	17777
LM60	777720
L777	777
L60	60
L16	16
L200	200
L400	400
L4000	4000
L40000	40000
L1A50S	100000
L3A57S	377777
L6A50S	600000
	.EJECT
/
/ARRAY VARIABLES
/
A.0	.BLOCK	50	/CARD FIELD ARRAYS FOR
U.0	.BLOCK	12	/EXPANDED SUBSITUTION
I.	0		/A.0 THRU D.09 MUST
O.	.BLOCK	2	/BE IN SEQUENTIAL ORDER
D.0	.BLOCK	24
/
/SYSTEM DEFINED ARRAY VARIABLES
/
D.10	0		/UNUSED
	0
D.11	0		/SYSTEM DEVICE
	330000		/(CHANGED E.KATZ  EDIT 057)
D.12	0		/LOGIN UIC
	330000
D.13=.			/ <CR>
CR	15
	0
D.14=.			/ ALTMODE
L175=.
ALTMOD	175
	0
D.15	0		/UNUSED
	0
D.16	0		/UNUSED
	0
D.17	0		/UNUSED
	0
/
/
J.	0
A	101
ATSIGN	100
L100=ATSIGN
BINVAL	00
COLON	72
SEMCOL	73
QUOTE	47
D	104
DOLLAR	44
LPAREN	50
CLRBIT	605440		/MASK FOR .SCOM+52
L1	1
L12	12
L3	3
L5	5
L6	6
L77	77
L11	11
	.DEC
DL13	13
DL14	14
DL74	74
	.OCT
O	117
SPACE	40
L40=SPACE
STAR	52			/ASCII *
PERCNT	45			/ ASCII %
AMPAND	46			/ASCCII &
KSPACE	201004,020100		/XOR OF 5-5/7 ASCII SPACES
KCR	064000			/5/7 ASCII <CR>
TRMCHR	33
U	125
L2A50	200000
L142	142
	.EJECT
/
/THE SYSTEM LOADER WILL LEAVE THE THREE
/SYSTEM INFORMATION BLOCKS (SYSBLK,SGNBLK
/AND .RCOM) IN HIGH CORE STARTING AT
/LOCATION 16100 IN THE HIGHEST MEMORY BANK.
/
SGNBLK=17100
SYSDEV=SGNBLK+4		/.SIXBT 'DP'OR 'DK'
/
/
/SPECIAL CONTROL CARDS
/
END	.SIXBT	'END'
JOB	.SIXBT	'JOB'
CRT	.SIXBT	'CRT'
ADD	.SIXBT	'ADD'
/
SCR	.SIXBT	'SCR'
TMP	.SIXBT	'TMP'
TERM	.SIXBT	' TERMINAL ERROR '<33>
/
ACBUFF	.BLOCK	400	/USED FOR A/C FILE PROCESSING
			/AND PROCEEDURE FILE LINES
			/ARE READ INTO HERE
/
/.SYSLD ERRORS
/
LDERR%	.
	LDERR1
	LDERR2
	LDERR3
	LDERR4
	LDERR5
	LDERR6
LDERR1	007002
	0
	.ASCII	'LOAD ERROR - MEMORY OVERFLOW'<15>
LDERR2	007002
	0
	.ASCII	'LOAD ERROR - INPUT DATA ERROR'<15>
LDERR3	010002
	0
	.ASCII	'LOAD ERROR - UNRESOLVED GLOBALS'<15>
LDERR4	010002
	0
	.ASCII	'LOAD ERROR - ILLEGAL .DAT SLOT'<15>
LDERR5	006002
	0
	.ASCII	'LOAD ERROR - PROGRAM >4K'<15>
LDERR6	012002
	0
	.ASCII	'LOAD ERROR - NONEXISTANT SYSTEM PROGRAM'<15>
	.EJECT
/
/SOME SYSTEM MESSAGES AND FIXED RTF LINES
/
BOSSLN	003002
	0
	.ASCII	'BOSS'<15>					/RKB-061
DUMP	002002
	0
	.ASCII	'DUMP'<15>
ALL	002002
	0
	.ASCII	'ALL'<175>
PIPLN	002002
	0
	.ASCII	'PIP'<15>
FORMFD	002002
	0
	.ASCII	<14><15>
LPVTAB	002002
	0
	.ASCII	<13><15>
JOBHDR	010002
	0
	.ASCII	'XVM BATCH OPERATING SYSTEM V1A000'<15>		/RKB-061
ENDHDR	012002
	0
	.ASCII	'JOB I.D.'<11>'DATE'<11><11>'START TIME'
	.ASCII	<11>'END TIME'<11>'RUN TIME'<15>
GET.MG	006002
	0
	.ASCII	'ILLEGAL .GET BY USER'<15>
.PUTMG	005002
	0
	.ASCII	'USER DID A .PUT'<15>
/DIRECTOTY ENTRY BLOCKS
/
PRCFIL	.SIXBT	'PRCFILPRC'
COMND.	0
	.SIXBT	 '@@@PRC'
XCTCOM	0
	.SIXBT	'@@@XCT'
ACCFIL	.SIXBT	'ACCNTG001'
ALTFIL	.SIXBT	'ACCNTG002'
ALTEXT	2
	.TITLE INITIALIZE ALL I/O
/INITIALIZE ALL .DAT SLOTS
INITS=.
	LAC*	L156		/GET TIME OUT CLOCK
	DZM*	L156		/DISABLE IT
	DAC	TCLOCK		/SAVE ITS VALUE
/	.INIT -3,1,200000	/DISABLE ^C			/RKB-061
/				/(RKB-061) ABOVE LINE DELETED.	/RKB-061
/								/RKB-061
	LAC	NXTJB%		/SETUP ^T TO ABORT JOB
	XOR	LM0
	DAC	CTRLAD
	.INIT	-3,1,0
CTRLAD=.-2
	LAC*	L142		/CLEAR USER MODE BIT
	AND	LM2
	DAC	SCOM42		/SAVE STATE OF .SCOM+42
	AND	L3A57S		/SET MICLOG BIT
	XOR	LM0
	DAC*	L142		/UPDATE .SCOM+42
/	.USER	-14,CTP
	764
	23
CTP	.SIXBT	'CTP'
/	.USER	-15,CTP
	763
	23
	.SIXBT	'CTP'
/
DEL.1	.DLETE	-15,PRCFIL		/DELETE ALL FILES ON CTP
	SZA				/NAMED PRCFIL PRC (RUN TIME FILE)
	JMP	DEL.1
/
ENT.2	.ENTER	-15,PRCFIL	/OPEN OUTPUT FILE
	DZM	LNCNT		/INITIALIZE LINE COUNT
	LAC*	L141		/SAVE CURRENT UIC IN D.12
	DAC	D.12
	LAC	CTP		/FORCE CURRENT UIC TO BE 'CTP'
	DAC*	L141
	LAC	SYSDEV		/SET UP SYSTEM DEVICE
	DAC	D.11
	.TITLE CHECK .SCOM+52 FLAGS
/MAKE SURE WE ARE IN BOSS-15 MODE, ONCE ONLY CODE
	LAC*	L152
	SPA
	JMP	CKEOP
	LAC	LM0
	DAC*	L152
	JMP	NXTCRD
/
CKEOP	AND	L1		/HAS AN ABORT TAKEN PLACE
	SNA
	JMP	NEWRTF		/NO - THEREFORE THERE ARE NO ERRORS
	XOR	AC.STA		/SET BIT IN JOB STATUS
	AND	L1		/WORD IN A/C BUFFER
	XOR	AC.STA
	DAC	AC.STA
/
/IF RESIDENT BOSS REACHED END OF 'PRCFILPRC' IT'S A TERMINAL ERROR
	LAC*	L152
	AND	L1A50S
	SNA
	JMP	CK.GET
	XOR	AC.STA
	AND	L1A50S
	XOR	AC.STA
	DAC	AC.STA
	JMS	WRITE
	FILERR
/
/CHECK FOR .GET AND .PUT MACRO'S BY USER
/
CK.GET	LAC*	L152		/DID USER ISSUE A .PUT OR .GET
	AND	L300
	SNA
	JMP	CKIOPS		/NO -- GO CHECK FOR IOPS ERROR
	AND	L100		/YES -- WHICH ONE
	SNA
	JMP	U.PUT		/ITS A .PUT
	XOR	AC.STA		/SET BIT IN A/C BUFFER
	AND	L100
	XOR	AC.STA
	DAC	AC.STA
	JMS	WRITE
	GET.MG
	JMP	CKIOPS
	.EJECT
/
U.PUT	JMS	WRITE		/TELL USER ABOUT .PUT
	.PUTMG
	LAC	L200		/SET BIT IN A/C BUFFER
	XOR	AC.STA
	AND	L200
	XOR	AC.STA
	DAC	AC.STA
	LAC	L4000		/GIVE USER A DUMP LISTING
	JMP	GDUMP
/
/IF IOPS TERMINAL ERROR PRINT ERROR MESSAGE
CKIOPS	LAC*	L152
	AND	L10000
	SNA
	JMP	CKSYSL
	XOR	AC.STA
	AND	L10000
	XOR	AC.STA
	DAC	AC.STA
	LAC	CARDP%		/INITIALIZE OUTPUT BUFFER
	JMS	PK.FST
	LAC	TERM%		/PACK 'TERMINAL ERROR'
	JMS	GT.ONE
IOPS.0	JMS	TOASCI
	JMS	PK.CHR
	JMS	GT.OTR
	SAD	TRMCHR
LSKP	SKP
	JMP	IOPS.0
	LAC	IOPSXX		/PACK ERROR NUMBER
	AND	L777
	LRS!SHAL	6
	TAD	L60
	JMS	PK.CHR
	CLA
	LLS	3
	TAD	L60
	JMS	PK.CHR
	CLA
	LLS	3
	TAD	L60
	JMS	PK.CHR
	LAC	SPACE		/FOLLOWED BY SPACE
	JMS	PK.CHR
	LAC	IOPSXX+1	/PACK CONTENTS OF .MED
	LMQ
	LAW	-6
	DAC	TEMP.0
IOPS.1	CLA
	LLS	3
	TAD	L60
	JMS	PK.CHR
	ISZ	TEMP.0
	JMP	IOPS.1
	LAC	SPACE		/FOLLOWED BY SPACE
	JMS	PK.CHR
	LAC	IOPSXX+2	/EXPANDED ERROR?
	SAD	IOPSXX+1	/(RKB-060) YES, SKIP
	JMP	IOPS.3		/NO
	LAC	IOPSXX+3	/OUTPUT EXPANDED MESSAGE
	TCA
	MUL!SHAL
	3
	LACQ
	TCA
	DAC	TEMP.1
	LAC	EXPND%
	JMS	GT.ONE
IOPS.2	JMS	TOASCI
	JMS	PK.CHR
	JMS	GT.OTR
	ISZ	TEMP.1
	JMP	IOPS.2
IOPS.3	LAC	CR		/PACK CARRIAGE RETURN
	JMS	PK.CHR
	LAC	CHRCNT		/COMPUTE HEADER-WORD-PAIR
	TAD	L11
	IDIV!SHAL
	5
	LACQ
	SWHA
	TAD	L2
	DAC	CARDP
	JMS	WRITE
	CARDP
	LAC*	L152		/CORE DUMP REQUESTED?
	AND	L4000
	SNA
	JMP	CKSYSL		/NO
GDUMP	XOR	AC.STA
	AND	L4000
	XOR	AC.STA
	DAC	AC.STA
	JMP	DMPPRC		/BRING IN DUMP
/IF .SYSLD ERROR PRINT APPROPRIATE MESSAGE
CKSYSL	LAC*	L152
	AND	L16
	SNA
	JMP	CKTIME
	CLL!RAR
	TAD	LDERR%
	DAC	TEMP.0
	LAC*	TEMP.0
	DAC	.+2
	JMS	WRITE
	XX
	LAC	L2		/USE ONLY ONE BIT FOR .SYSLD ERRORS
	XOR	AC.STA
	AND	L2
	XOR	AC.STA
	DAC	AC.STA
/IF TIME ESTIMATE EXCEEDED PRINT ERROR AND END JOB
CKTIME	LAC*	L152
	AND	L40000
	SNA
	JMP	CKABRT
	XOR	AC.STA
	AND	L40000
	XOR	AC.STA
	DAC	AC.STA
	JMS	WRITE
	TM.MSG
	JMP	ENDJOB
TM.MSG	006002
	0
	.ASCII	'TIME ESTIMATE EXCEEDED'<15>
/OPERATOR ABORT IN NRBOSS
/SET BITS IN A/C FILE AND ABORT JOB
/
OPABRT	LAC	L1		/SET ABORT BIT
	XOR	AC.STA
	AND	L1
	XOR	AC.STA
	DAC	AC.STA
	LAC	L2000		/BIT FOR OPERATOR ABORT
	JMP	ABRTJ		/COMPLETE JOB ABORT
/
/IF CONTROL CHAR ABORT LOOK FOR $JOB
/AFTER SIGNING THIS GUY OUT
/
CKABRT	LAC*	L152
	AND	L2000
	SNA
	JMP	NEWRTF
ABRTJ	XOR	AC.STA
	AND	L2000
	XOR	AC.STA
	DAC	AC.STA
	JMS	WRITE
	ABRT.0
	JMP	ABRTJB
ABRT.0	004002
	0
	.ASCII	'OPERATOR ABORT'<15>
	.EJECT
FILERR	011002
	0
	.ASCII	/END OF RUN TIME FILE REACHED BY USER/<15>
	.TITLE $JOB CARD PROCESSING
/
/LOOK FOR $JOB CARD
/
NEWJOB	LAC*	L152		/JOB ACTIVE?
	AND	L1000
	SZA			/NO,SKIP.
	JMP	ENDJOB		/YES, CLOSE CURRENT JOB.
	DZM	AC.STA		/CLEAR OUT JOB RUN STATUS WORD
	DZM	TCLOCK		/MAKE SURE TIMEOUT CLOCK
				/WILL BE DISABLED UPON EXIT TO RNM
	LAC	L1000		/SET JOB ACTIVE FLAG.
	XOR*	L152
	DAC*	L152
	LAW	-11		/MOVE JOB I.D. INTO NEW
	DAC	TEMP.0		/ACCOUNTING INFORMATION
	LAC	AC.ID%		/BUFFER.
	JMS	PK.ONE
	LAC	A.0%
	JMS	GT.ONE
	SKP
LOOP.6	JMS	GT.OTR
	SAD	TRMCHR
	JMP	NEW.1
	JMS	PK.OTR
	ISZ	TEMP.0
	JMP	LOOP.6
	JMP	NEW.2
NEW.1	CLA			/BLANK FILL JOB I.D.
	JMS	PK.OTR
	ISZ	TEMP.0
	JMP	NEW.1
NEW.2	LAC*	L147		/ENTER DATE AND START
	DAC	AC.DT		/TIME INTO NEW ACCOUNTING
	LAC*	L150		/INFORMATION BUFFER.
	DAC	AC.TMI
	DZM*	L134		/START ELAPSED TIME CLOCK
/OUTPUT START JOB MESSAGE
JOBMES	JMS	WRITE		/FORM FEED.
	FORMFD
	JMS	WRITE		/ECHO $JOB CARD
	CARD
	JMS	WRITE		/SPACE DOWN MIDDLE OG PAGE.
	LPVTAB
	JMS	WRITE		/JOB BEGIN MESSAGE.
	JOBHDR
	JMS	SUBSTT
	JMP	EXIT		/MUST EXIT SO WE LOGIN THIS NEW GUY
/
OPNJOB	JMS	CHKCMD		/OPEN JOB PRC FILE
	JMP	NEWJOB		/PROCESS IT
/
	.TITLE LOOK FOR NEXT CONTROL CRAD
/
/A NEW RUN TIME FILE IS TO BE MADE UP.
/CHECK TO SEE IF WE SHOULD. IF NOT GO TO ENDJOB.
/
NEWRTF	LAC*	L152
	AND	L400
	SZA
	JMP	ENDJOB		/EXIT BOSS MODE
	LAC	AC.STA		/SHOULD JOB FINISH
	RCR			/JOB ABORT
	SZL
	JMP	ENDJOB		/YES -- CLOSE OUT JOB
	RTL			/END JOB FLAG UP
	SZL
	JMP	ENDJOB		/YES -- CLOSE OUT JOB
/	JMP	NXTCRD		*** DON'T NEED THIS INST NOW ***
/
/WE HAVE EXTINGUISHED THE PROC FILE LOOK
/FOR THE NEXT CONTROL CARD.
/
NXTCRD=.
	JMS	RDCARD		/GET CARD IMAGE
	JMS	DECARD		/DECODE CARD IMAGE
	JMP	NXTCRD		/CARD IMAGE NOT A CONTROL CARD
	JMP	PIPCRD		/ "	"   PIP CARD
	XCT	PIPSW		/WERE WE PROCESSING PIP COMMANDS
	JMS	CLSPIP		/YES -- FINISH UP THEN
	LAC	COMND.		/ "	"   CONTROL CARD
	SAD	JOB		/IS IT $JOB?
	JMP	NEWJOB		/YES, START NEW JOB.
	JMS	JOBACT		/IS JOB ACTIVE?
	LAC	COMND.
	SAD	END		/IS CARD $END?
	JMP	ENDJOB		/YES, END JOB.
	SAD	CRT		/$CRT?
	JMP	CRADFL		/YES,CREATE 'ADD'FILE.
	SAD	ADD		/$ADD?
	JMP	ENTADD		/YES,ENTER 'ADD' MODE.
	JMS	SUBSTT		/EXPAND PROCEDURE FILE.
	JMP	EXTPRC		/EXIT TO MONITOR
/
/SUBR. JOBACT -- CHECK TO SEE IF JOB IS ACTIVE
/
JOBACT	0
	LAC*	L152		/IS JOB ACTIVE BIT ON
	AND	L1000
	SZA
	JMP*	JOBACT		/YES -- RETURN TO CALLER
NEXT.	.CLOSE -14		/CLOSE PRC FILE FOR SKIPED OVER CMD
	JMP	NXTCRD		/READ NEXT CONTROL CARD
/
PIPCRD	JMS	JOBACT		/IS JOB ACTIVE
	XCT	PIPSW		/ARE WE IN PROCESS FOR PIP CMD'S
	JMP	PIPC.0		/YES -- OK CALL FOR PIP ALREADY MADE
WRT.4	.WRITE	-15,2,PIPLN,36	/WRITE LINE TO CALL PIP
	ISZ	LNCNT
	LAC	LNOP		/SET PIP SWITCH
	DAC	PIPSW
	SKP
/
PIPC.0	JMS	RTF.WT		/WRITE LINE IN RTF
	LAC	CARD%
	JMS	GT.FST		/PACK UP NEW PIP COMMAND
	JMS	GT.CHR		/SKIP OVER "$"
	LAC	CARDP%		/END LINE WITH <CR> SO PIP WILL STAY IN
	JMS	PK.FST		/AFTER EXECUTING COMMAND
PIPC.1	JMS	GT.CHR		/GET CHARACTER.
	SAD	CR		/IF CR, TERMINATE
	JMP	PIPC.2
	SAD	ALTMOD		/IF ALTMODE TERMINATE
	JMP	PIPC.2
	JMS	PK.CHR		/IF NEITHER, PACK CHARACTER.
	LAC	CHRCNT		/ALLOW ONLY 75(10) CHAR
	SAD	DL74
	JMP	PIPC.2		/GO PUT CR IN LINE
	JMP	PIPC.1		/LOOP.
/
PIPC.2	LAC	CR		/PACK CR TO TERMINATE
	JMS	PK.CHR
	JMP	NXTCRD		/GO GET NEXT COMMAND
/
/SUBROUTINE CLSPIP
/SEARCH THE CURRENT PIP COMMAND LINE
/(WHICH HAS NOT AS YET BEEN WRITTEN OUT TO THE RTF)
/FOR A CR AND REPLACE IT WITH AN ALTMODE
/SO THAT WE WILL EXIT BACK TO THE NRM AFTER
/EXECUTING THIS COMMAND.
/
CLSPIP	0
	LAC	CARDP%
	JMS	GT.FST
	LAC	CARDP%		/REPACK BUFFER INTO ITSELF
	JMS	PK.FST
PIPL.0	JMS	GT.CHR		/FIND <CR>
	SAD	CR
	JMP	PIPOUT		/CHANGE IT TO AN ALTMODE
	JMS	PK.CHR
	JMP	PIPL.0		/LOOP
/
PIPOUT	LAC	ALTMOD
	JMS	PK.CHR
	LAC	LSKP		/RESET PIP SWITCH
	DAC	PIPSW
	JMS	RTF.WT		/WRITE OUT LINE
	JMP*	CLSPIP		/EXIT
/
PIPSW	SKP
/
	.TITLE CREATE ADD FILE
CRADFL=.
	IDX	CRTFLG		/SET FLAG FOR DECODE SO THAT THE
				/PRC FILES ARE NOT OPENED
				/DUE TO THE FOLLOWING CONTROL CARDS
	 LAC	 CARDP%		 /PUT FILE NAME IN CARDP.
	JMS	CRTADD
	DZM	CARDP		/CLEAR OUT NAME.
	DZM	CARDP+1
	DZM	CARDP+2
	SAD	CR
	JMP	CR.CHK
	JMS	GT.CHR
CR.LOP	AND	L77
	SAD	CR
	JMP	CR.EXT		/YES, CHECK FILE NAME AND EXT.
	SAD	SPACE
	JMP	CR.EX0		/YES. SETUP FOR EXTENSION PROCESSING
	JMS	PK.OTR		/NO, PACK CHARACTER.
CR.C	JMS	GT.CHR		/UNPACK NEXT CHARACTER.
	ISZ	TEMP.0
	JMP	CR.LOP		/LOOP.
	JMP	CR.EXT		/YES, CHECK EXTENSION.
/
CR.EX0	LAC	CARDP%		/SETUP FOR EXTENSION PROCESSING
	JMS	EXTPR
	JMP	CR.C
/
CR.CHK	LAC	TMP
	DAC	CARDP
CR.EXT	LAC	CARDP+2		/WAS EXT ON CARD?
	SZA			/NO, ASSUME ONE.
	JMP	CR.OPN		/YES, OPEN FILE.
	LAC	ADD
	DAC	CARDP+2
CR.OPN	LAC	D.12		/USE USER'S U1C.
	DAC	CR.USR
/	.USER	-11,D.12
	767
	23
CR.USR	XX
	.INIT	-11,1
ENT.1	.ENTER	-11,CARDP	/OPEN FILE.
CR.CRD	JMS	RDCARD		/GET NEXT CARD.
	JMS	DECARD		/DECODE CARD IMAGE.
	JMP	CR.ERR		/ILLEGAL IMAGE FOR ADD FILE.
	JMP	CR.END
	LAC	COMND.		/CHECK FOR ILLEGAL COMMAND.
	SAD	CRT		/$CRT IS ILLEGAL.
	JMP	CR.ERR
	SAD	ADD		/$ADD IS ILLEGAL.
	JMP	CR.ERR
	SAD	JOB		/$JOB IS ILLEGAL.
	JMP	CR.ERR
WRT.8	.WRITE	-11,2,CARD,36	/COMMAND IS LEGAL.
	JMP	CR.CRD		/LOOP.
CR.END	LAC	CARD%		/$$?
	JMS	GT.FST
	JMS	GT.CHR
	JMS	GT.CHR
	SAD	DOLLAR
	SKP			/YES, CLOSE ADD FILE.
	JMP	WRT.8		/NO, CONTINUE
	.CLOSE	-11
	DZM	CRTFLG		/CLEAR FLAG FOR DECODE
	JMP	NXTCRD		/READ NEXT CARD
/
CR.ERR	JMS	WRITE		/OUTPUT ERROR MESSAGE.
	.CRMSG
	LAC	L20001		/SET BIT IN A/C FILE DATA
	XOR	AC.STA
	AND	L20001
	XOR	AC.STA
	DAC	AC.STA
	.CLOSE	-11
	DZM	CRTFLG		/CLEAR FLAG FOR DECODE
	JMP	ENDJOB
.CRMSG	007002
	0
	.ASCII	'ILLEGAL COMMAND FOR ADD FILE '<15>
	.TITLE ENTER ADD FILE MODE
ENTADD	DZM	ADDSTA		/ZERO LINE COUNT IN ADD FILE
	JMS	ADBITS		/SET ADD FILE BITS
	DZM	ADDFIL		/GET FILE NAME FROM
	DZM	ADDFIL+1	/CARD TO 'ADDFIL'.
	DZM	ADDFIL+2	/CLEAR OUT ADDFIL.
	LAC	ADDFL%		/START SIXBT PACKING
	JMS	CRTADD
	SAD	CR
	JMP	EN.CHK		/NO. ASSUME DEFAULT NAME
	JMS	GT.CHR
EN.LOP	AND	L77
	SAD	CR
	JMP	EN.EXT		/YES,CHECK FILE NAME AND EXT.
	SAD	SPACE
	JMP	EN.EX0		/YES. SETUP FOR EXTENSION PROCESSING
	JMS	PK.OTR		/NO,PACK CHARACTER.
EN.C	JMS	GT.CHR		/UNPACK NEXT CHARACTER
	ISZ	TEMP.0
	JMP	EN.LOP		/LOOP
	JMP	EN.EXT		/YES,CHECK EXTENSION.
/
EN.EX0	LAC	ADDFL%		/SETUP FOR EXTENSION PROCESSING
	JMS	EXTPR
	JMP	EN.C
/
EN.CHK	LAC	TMP
	DAC	ADDFIL
EN.EXT	LAC	ADDFIL+2	/WAS EXT ON CARD?
	SZA			/NO,ASSUME DEFAULT.
	JMP	NXTCRD		/YES,DONE.
	LAC	ADD
	DAC	ADDFIL+2
	JMP	NXTCRD		/DONE.
/
/SUBROUTINE EXTCHK
/THIS SUBROUTINE IS CALLED WHEN THE
/CURRENT .SIXBT CHAR IS 0.
/IF IT IS THE SEVENTH CHAR WE DON'T
/WANT TO PACK IT IN THE DIRECTORY ENTRY
/BLOCK BEING MADE UP.
/
/CALL	JMS	EXTCHK
/	RETURN AC=0 NOT 7'TH CHAR
/	RETURN AC=0 7'TH CHAR RETURN
/
EXTCHK	0
	LAC	TEMP.0
	SAD	LM4
	IDX	EXTCHK
	CLA
	JMP*	EXTCHK
/
/SUBROUTINE TO SETUP FOR FILENAME EXTENSION PROCESSING
/CALL		LAC BUFAD-2
/			JMS EXTPR
/		RETURN
/
EXTPR	0
	TAD	(2
	JMS	PK.ONE
	LAW	-3
	DAC	TEMP.0
	JMP*	EXTPR
/
/SUBROUTINE TO SET UP FOR $CRT OR $ADD
/
CRTADD	0
	JMS	PK.ONE
	LAW	-6		/SET MAX FILENAME CHAR COUNT
	DAC	TEMP.0
	LAC	GT.CUR
	AND	L77		/GET FIRST CHAR IN FILE NAME
	JMP*	CRTADD
/
/
	.TITLE DIRECT SUBSITUTION PROCESSING
/
/PROCESSING FOR DIRECT SUBSTITUTION PROCEEDURE FILES
/ALL CHARACTERS ON THE CONTROL CARD(S) EXCEPT FOR
/<CR>, ALTMODE, AMPERSAND AND SEMICOLON
/ARE TREATED AS DATA
/TO BE PLACED IN THE "RTF" UNDER THE CONTROL OF
/THE PROCEDURE FILE.  THIS EXCLUDES LEADING BLANKS.
/
/SEMICOLON (;)	FIELD DELIMITER OR IF FOLLOWED BY A
/		<CR> OR ALTMODE -SPACES IGNORED-
/		CONTINUATION CARD FLAG.
/
/
/<CR> AND ALTMODE FIELD DELIMITER EXCPET AS NOTED IN
/		NOTE ABOUT SEMICOLON (;) IE
/		CONTINUATION CARD
/
/AMPERSAND (&)	END THE CURRENT RTF LINE WITH A <CR>
/		AND WRITE IT OUT. START A NEW RTF LINE
/		WITH THE FIELD BEING PROCESSED NOT BEING
/		CHANGED. ** MAINLY FOR "CHAIN" WHICH
/		TAKES COMMAND INPUT IN LOGICAL LINES TERMINATED
/		WITH AN ALTMODE. AND PHYSICAL LINES
/		TERMINATED WITH A <CR>.
/
/
DIRSUB	JMS	JOBACT		/IS JOB ACTIVE
	JMS	CONTUE		/READ THRU ANY LEADING SPACES
	JMS	GTSWAP		/SWAP GT.CHR DATA
	XCT	PIPSW		/WERE WE PROCESSING PIP COMMANDS
	JMS	CLSPIP		/YES--CLOSE THEM OUT
	LAW	-1		/SET INITIAL VALUE OF ARRAY
	DAC	ARRAY
FILEIN	LAC	ACBUF%		/SET UP GT.CHR FOR PRC FILE LINE
	JMS	GT.FST
	LAC	CARDP%		/SET UP PACKING ROUTINE
	JMS	PK.FST
RDIRCT	JMS	RDPRC		/READ NEXT LINE IN PRC FILE
	JMP	EXTPRC		/EXIT TO NRM IF NEED BE (EOF RETURN)
/
RSETFG	DZM	FLPARM		/INITILIZE VARIABLE SEPERATOR
	DZM	DFPARM		/COUNTERS AND FLAGS AND
	LAC	LSKP		/DEFAULT FLAG
	DAC	RTPRNF
	DAC	DFLTFG
/
DIRNXT	JMS	GT.CHR		/GET NEXT CHARACTER
	SAD	ATSIGN		/DECODE IT
	JMP	VARSTR		/START OF A VARIABLE
	SAD	CR
	SKP
	SAD	ALTMOD
	JMP	WTLINE		/WRITE OUT LINE
	SAD	LPAREN
	JMP	DIRDFL		/START OF DEFAULT FIELD??
	SAD	RPAREN
	JMP	DIREDF		/END OF DEFAULT FIELD??
	SKP
/
CHRGET	LAC	GT.CUR		/GET CHAR.
CHROUT	JMS	PK.CHR		/PACK CHARACTER AWAY
	JMP	DIRNXT		/GET NEXT CHAR.
/
DIRDFL	LAC	FLPARM		/ANY (@) FOUND YET
	SNA
	JMP	CHRGET		/NO--PACK CHAR AWAY
	LAW	-1		/COUNT LEFT HAND PAREN
	TAD	DFPARM
	DAC	DFPARM
	JMP	DIRNXT		/GET NEXT CHARACTER
/
DIREDF	LAC	FLPARM		/ANY (@) FOUND YET
	SNA
	JMP	CHRGET		/NO--PACK CHAR AWAY
	LAC	LNOP		/SET RIGHT PAREN FOUND SW.
	DAC	RTPRNF
	ISZ	DFPARM		/ACCOUNT FOR RIGHT PAREN.
	NOP
DFLUSH	JMS	FLUSHV		/FLUSH REST OF VARIABLE
	JMP	RSETFG
/
WTLINE	LAC	FLPARM		/MAKE SURE ALL FIELD SEPERATORS
	SAD	DFPARM		/HAVE BEEN ACCOUNTED FOR.
	SZA
	JMP	ERRMSG		/ERROR
	LAC	GT.CUR		/GET TERMINATOR
	JMS	PK.CHR		/PACK IT AWAY
	JMS	RTF.WT		/WRITE OUT LINE IN RTF
	JMP	FILEIN		/PROCESS NEXT LINE IN FILE
/
VARSTR	LAW	-1		/START PROCESSING A VARIABLE
	TAD	FLPARM		/COUNT (@)
	DAC	FLPARM
	JMS	GT.CHR		/GET NEXT CHARACTER
	SAD	A		/DECODE IT
	JMP	DIRA		/ITS A
	SAD	D
	JMP	DIRD		/ITS D
	JMP	ERRMSG		/ITS ILLEGAL
/
DIRD	JMS	FBVALU		/GET ARRAY VALUE
	LAW	-12		/MUST BE .GT. OR .EQ. TO 10(10)
	TAD	BINVAL
	SPA
	JMP	ERRMSG
	TAD	LM10		/BUT .LT. OR .EQ. TO 17(10)
	SMA
	JMP	ERRMSG
	LAC	BINVAL		/CHECK FOR SPECIAL CHAR.
	SAD	DL13
	JMP	DIRCR		/CARRIAGE RETURN
	SAD	DL14
	JMP	DIRALT		/ALTMODE
	RCL
	TAD	D.0%		/CALCULATE ADDR OF ARRAY VARIABLE
	DAC	TEMP.0
	LAC*	TEMP.0		/IS ARRAY EMPTY
	SNA
	JMP	DIRNXT		/YES--GET DEFAULT
	LAW	-4		/PACK ARRAY CONTENTS INTO OUTPUT
	DAC	TEMP.2
	LAC	TEMP.0
	JMS	GT.ONE		/GET 1'ST SIXBT CHAR
	SKP
LOOP.8	JMS	GT.OTR		/GET NEXT SIXBT CHAR
	SAD	TRMCHR		/IS IT TERMINATOR
	JMP	DFLUSH		/DONE FLUSH REST OF VARIABLE
	JMS	TOASCI
	JMS	PK.CHR
	ISZ	TEMP.2		/ARE WE DONE
	JMP	LOOP.8
	JMP	DFLUSH		/YES--FLUSH REST OF VARIABLE
/
DIRCR	LAC	CR		/PACK <CR>
	SKP
DIRALT	LAC	ALTMOD		/PACK ALTMODE
	JMS	PK.CHR
	JMP	DFLUSH		/FLUSH REST OF VARIABLE
/
DIRA	JMS	FBVALU		/GET ARRAY VALUE
	LAC	ARRAY		/ARRAY VALUE MUST EQUAL (BINVAL)
	IAC			/ARRAY + 1
	SAD	BINVAL
	SKP
	JMP	ERRMSG		/ERROR
	DAC	ARRAY		/UPDATE ARRAY VALUE
	JMS	CDLINE		/GET FIELD FROM CARD
	XCT	DFLTFG		/IS DEFAULT FLAG UP
	JMP	DIRNXT		/YES--GET DEFAULT
	JMP	DFLUSH		/NO--FLUSH REST OF VARIABLE
/
DFLTFG	SKP
/
	.EJECT
/
/SUBROUTINE GTSWAP
/THIS SUBROUTINE SWAPS THE CURRENT DATA
/FOR SUBROUTINE GT.CHR WITH THAT
/CONTAINED IN ITS DATA SAVE AREA.
/
GTSWAP	0
	LAW	-7		/THERE ARE SEVEN
	DAC	TEMP.2		/DATA ITEMS
	LAC	GTPTR%		/GET START ADDR OF
	DAC	TEMP.1		/DATA IN GT.CHR
	LAC	GTSWP%		/GET ADDR OF DATA AREA
	DAC	TEMP.0		/IN GTSWAP
LOOP.9	LAC*	TEMP.0		/SWAP DATA
	PAX
	LAC*	TEMP.1
	DAC*	TEMP.0
	PXA
	DAC*	TEMP.1
	ISZ	TEMP.0
	ISZ	TEMP.1
	ISZ	TEMP.2		/ARE WE DONE
	JMP	LOOP.9		/LOOP
	JMP*	GTSWAP		/DONE
/
	.REPT	7
GTSWPD	0
/
	.EJECT
/
/SUBROUTINE CDLINE
/GET THE NEXT FIELD FROM THE CONTROL CARD
/AND PACK IT INTO OUTPUT BUFFER.  IF NEED
/BRING IN CONTINUATION CARD.  IF THE FIELD
/WAS EMPTY THE MAKE SURE DEFAULT FLAG IS SET
/IF (&) IS FOUND WRITE OUT CURRENT RTF
/LINE WITH A <CR> AND START NEW LINE.
/
CDLINE	0
	JMS	GTSWAP		/SWAP IN DATA FOR CARD IMAGE
	LAC	LNOP		/ "GT.CHR".
	DAC	DFLTFG		/SET DEFAULT FLAG.
	LAC	GT.CUR		/DO WE NEED TO GET A NEW CHAR.
	SZA
	JMP	CDECD		/NO--DECODE THIS ONE
CDCHR	JMS	GT.CHR
CDECD	SAD	CR
	SKP
	SAD	ALTMOD
	JMP	CDLOUT		/EXIT FROM ROUTINE
				/THIS IS THE END OF THE
				/LAST FIELD ON THE CARD
	SAD	AMPAND		/END RTF LINE ??
	JMP	CDNLIN		/YES!
	SAD	SEMCOL		/NO -- IS IT THE END OF THE FIELD
	JMP	CDCONT		/MAYBE CHECK FOR CONTINUATION CARD
	JMS	PK.CHR		/PACK CHARACTER
	LAC	LSKP		/RESET DEFAULT FLAG
	DAC	DFLTFG
	JMP	CDCHR		/GET NEXT CHAR.
/
CDCONT	JMS	CONTUE		/CHECK FOR CONTINUATION CARD
	SAD	LM1		/AC=-1 IF WE HAVE ONE
	JMP	CDCHR		/GER 1'ST CHAR ON NEW CARD
CDLOUT	JMS	GTSWAP		/EXIT FROM ROUTINE
	JMP*	CDLINE
/
CDNLIN	LAC	CR		/END LINE WITH <CR>
	JMS	PK.CHR
	JMS	RTF.WT		/WRITE IT OUT
	LAC	CARDP%		/START NEW LINE
	JMS	PK.FST
	JMP	CDCHR		/GET NEXT CHARACTER
/
	.TITLE DECODE CONTROL CARD
DECARD	0
	LAW	-1
	DAC	J.		/CLEAR ALL ARRAYS:
	DZM	COMND.		/A,D,U,O,COMMAND
	DZM	COMND.+1
	LAC	A.0%
	DAC	TEMP.0
LM111	LAW	-111
	DAC	TEMP.1
LOOP.3	DZM*	TEMP.0
	ISZ	TEMP.0
	ISZ	TEMP.1
	JMP	LOOP.3
	JMS	GT.CHR		/GET FIRST CHAR
	SAD	DOLLAR		/$?
	SKP
	JMP*	DECARD		/NO,RETURN 1
	JMS	GT.CHR		/YES, LOOK AT COMMAND FIELD.
	SAD	CR		/IS THERE ONE?
	JMP	EXIT		/NO!  GO XCT THE RTF
	JMP	CE.1		/YES.
/
/
RET.3A	JMS	CHKCMD		/GO CHECK COMMAND ECT.
RET.3	ISZ	DECARD		/RETURN 3, ALL DONE
	ISZ	DECARD
	JMP*	DECARD
CE.1	DAC	TEMP.0		/SAVE CHARACTER
	LAC	(COMND.
	JMS	PK.ONE		/RESET .SIXBT PACKING ROUTINE
	DZM	I.
PKCMND	LAC	TEMP.0
	JMS	PK.OTR		/PACK CHARACTER
	ISZ	I.		/UPDATE CHARACTER COUNTER.
GTCMND	JMS	GT.CHR		/GET NEXT CHARACTER
	DAC	TEMP.0
	SAD	SEMCOL		 /SEMCOL?
	JMP	OPTION		/YES, LOOK AT OPTION FIELD
	SAD	SPACE		/NO, SPACE?
	JMP	PIPCHK		/YES
	LAC	I.		/NO, DO WE HAVE 3 CHARS
	SAD	L3		/FOR COMMAND FIELD?
	SKP
	JMP	PKCMND		/NO, READ ON
	LAC	TEMP.0		/YES, WAS CHAR A
	SAD	CR		/CARRIAGE RETURN?
	JMP	RET.3A		/YES, EXIT.
	SAD	ALTMOD		/NO,WAS IT ALTMODE?
	JMP	RET.3A		/YES,EXIT
	JMP	GTCMND		/NO,FLUSH COMMAND FIELD
/
OPTION	LAC	L2		/SET ARRAY CODE FOR "U"
	DAC	ARRYCD
	DZM	I.
	JMS	GT.CHR		/GET FIRST CHAR IN OPTION FIELD
	DAC	TEMP.0		/IF IT'S SPACE THERE IS NONE.
	SAD	SPACE		/SPACE?
	JMP	CKDIRS		/YES,LOOK FOR VAR. FIELDS
	SAD	CR		/NO, ASSUME OPTION FIELD IF CHAR
	JMP	RET.3A		/IS NOT CR NOR ALTMODE
	SAD	ALTMOD
	JMP	RET.3A
	LAC	(O.		/RESET .SIXBT PACK ROUTINE
	JMS	PK.ONE
PKOPTN	LAC	TEMP.0
	JMS	PK.OTR		/PACK CURRENT CHAR
	ISZ	I.		/UPDATE CHAR COUNTER
GTOPTN	JMS	GT.CHR		/GET NEXT CHAR
	DAC	TEMP.0
	SAD	SPACE		/SPACE?
	JMP	CKCMDO		/YES, DONE WITH OPTION
	SAD	CR		/CR?
	JMP	CLOPTN		/YES, DONE WITH CARD
	SAD	ALTMOD		/ALTMODE?
	JMP	CLOPTN		/YES, DONE WITH CARD
	LAC	I.		/NO, DO WE HAVE 6 OPTION CHAR
	SAD	L6
	JMP	GTOPTN		/YES, LOOK FOR OPTION TERMINATOR
	JMP	PKOPTN		/NO, GET NEXT CHARACTER
CLOPTN	JMS	TRMSTR
	JMP	RET.3A		/EXIT
/
PIPCHK	LAC	I.		/IF COMMAND FIELD IS ONLY
	SAD	L1		/ONE CHAR LONG, ASSUME IT IS
	SKP			/A PIP COMMAND
	JMP	CKDIRS		/DON'T PUT TERMINATOR IN COMMAND FIELD
	ISZ	DECARD		/PIP CARD EXIT
	JMP*	DECARD
/
CKDIRS	JMS	CHKCMD		/CHECK COMMAND FOR DIRECT
	XCT	LEGALF		/SUBSITUTION. CMD IN LANG.
	JMP	RET.3		/NO CAN ONLY SHORTHAND CALL FOR EXECUTE
	XCT	EXPNSW		/DIRECT SUB ??
	JMP	VARFLD+1		/NO -- PROCESS AS USUAL
	JMP	DIRSUB		/PROCESS FOR DIRECT SUBSITUTION
/
CKCMDO	JMS	CHKCMD		/CHECK CMD. ECT.
	XCT	LEGALF		/CMD IN LANG.
	JMP	RET.3		/NO SHORTHAND CALL TO EXECUTE
	XCT	EXPNSW		/DIRECT SUB IS ILLEGAL
	SKP			/WITH OPTION FIELD
	JMP	BADCOM
/
VARFLD	JMS	TRMSTR
	DZM	I.		/INDICATE NO DATA PACKED IN ARRAY
	JMS	CONTUE		/SKP SPACES AND CHECK CONTINUATION
	DZM	ARRYCD		/SET ARRAY CODE FOR "A"
	DZM	EXTFLG
	ISZ	J.
	NOP
	SAD	SEMCOL
	JMP	VARFLD
	SAD	CR
	JMP	RET.3
	SAD	ALTMOD
	JMP	RET.3
	DAC	TEMP.0		/NO, SAVE CHAR FOR NOW.
	LAC	J.		/AT TEN FIELDS?
	SAD	L12
	JMP	RET.3		/YES, EXIT
	CLL!RAL			/NO
	RAL
	TAD	A.0%
	JMS	PK.ONE		/RESET .SIXBT PACK ROUTINE
	LAC	TEMP.0		/RETRIEVE CHARACTER.
CK1FLD	SAD	SEMCOL		 /SEMCOL?
	JMP	VARFLD		/YES, CLOSE FIELD
	SAD	COLON		/NO, COLON?
	JMP	CL2FLD		/YES, CLOSE FIELD
	SAD	LPAREN		/NO, LEFT PARENTHESIS?
	JMP	UICFLD		/YES
	SAD	CR		/NO, CR?
	JMP	CLEXIT		/YES
	SAD	ALTMOD		/NO, ALT MODE?
	JMP	CLEXIT		/YES
	LAC	I.		/I=10?
	SAD	L12
	JMP	GT1FLD		/YES, FLUSH FIELD
	LAC	EXTFLG
	SZA
	JMP	EXTFIL
GETEXT	LAC	TEMP.0		/NO, PACK CHAR
	JMS	PK.OTR
	ISZ	I.		/GET NEX CHAR
GT1FLD	JMS	GT.CHR
	SAD	SPACE
	JMP	SETEXT
	DAC	TEMP.0
	JMP	CK1FLD
/
CL2FLD	JMS	CONTUE		/GET NEXT CHAR
	SAD	SEMCOL
	JMP	VARFLD
	DAC	TEMP.0		/NO, SAVE IT
	JMS	TRMSTR		/CLOSE CURRENT FIELD
	LAC	J.
	RCL
	TAD	D.0%
	JMS	PK.ONE		/RESET .SIXBT PACK ROUTINE
	LAW	-1
	DAC	ARRYCD		/SET ARRAY CODE FOR "D"
	DZM	I.
	LAC	TEMP.0
CK2FLD	SAD	SEMCOL		 /SEMCOL?
	JMP	VARFLD		/YES
	SAD	LPAREN		/NO, LEFT PARENTHESIS?
	JMP	UICFLD		/YES
	SAD	CR		/NO, CR
	JMP	CLEXIT		/YES
	SAD	ALTMOD		/NO, ALTMODE?
	JMP	CLEXIT		/YES
	LAC	I.		/NO, IS I=4?
	SAD	L4
	JMP	GT2FLD		/YES.
	LAC	TEMP.0
	JMS	PK.OTR		/NO
	ISZ	I.
GT2FLD	JMS	GT.CHR		/GET CHAR
	DAC	TEMP.0		/SAVE IT
	JMP	CK2FLD		/LOOP AROUND
/
UICFLD	JMS	CONTUE		/GET NEXT CHAR
	SAD	SEMCOL
	JMP	VARFLD
	DAC	TEMP.0		/SAVE CHAR
	JMS	TRMSTR		/CLOSE FIELD
	LAC	(U.0
	TAD	J.
	JMS	PK.ONE		/RESET .SIXBT PACK ROUTINE
	LAC	L1
	DAC	ARRYCD		/SET ARRAY CODE FOR "U" FIELD
	DZM	I.
	LAC	TEMP.0		/LOOK AT CHAR
CKUIC	SAD	SEMCOL		 /SEMCOL?
	JMP	VARFLD		/YES, CLOSE FIELD
	SAD	RPAREN		/NO, RIGHT PARENTHESIS?
	JMP	CL1UIC		/YES
	SAD	CR
	JMP	CLEXIT
	SAD	ALTMOD
	JMP	CLEXIT
	LAC	I.
	SAD	L3
	JMP	GT1UIC
	LAC	TEMP.0
	JMS	PK.OTR
	ISZ	I.
GT1UIC	JMS	GT.CHR
	DAC	TEMP.0
	JMP	CKUIC
CL1UIC	JMS	TRMSTR
GT2UIC	JMS	CONTUE		/FLUSH THRU TILL SEMICOLON
	SAD	SEMCOL
	JMP	VARFLD+1
	SAD	CR
	JMP	RET.3
	SAD	ALTMOD
	JMP	RET.3
	JMP	GT2UIC
/
CLEXIT	JMS	TRMSTR
	JMP	RET.3
/
EXTFIL	LAW	-7
	TAD	I.
	SMA
	JMP	GT1FLD
	DAC	TEMP.1
	CLA
	JMS	PK.OTR
	ISZ	I.
	ISZ	TEMP.1
	JMP	.-4
	DZM	EXTFLG
	JMP	GETEXT
SETEXT	LAC	EXTFLG
	SNA
	LAC	L1
	DAC	EXTFLG
	JMP	GT1FLD
/
	.EJECT
/
/SUBROUTINE  TRMSTR
/STORES THE TERMINATION CHAR. IN ARRAYS IF
/I. (#OF ENTRIES IN ARRAY) DOES NOT =0
/OR MAX NUMBER FOR THE ARRAY.
/
/CALL	JMS	TRMSTR
/	RETURN
/
TRMSTR	0
	LAC	ARRYCD		/WHICH ARRAY
	SNA			/A=0,D=-1,U=1,O=2
	JMP	CHKA
	SPA
	JMP	CHKA		/D FIELD HANDLED SAME AS A FIELD
	SAD	L1
	JMP	CHKU		/U FIELD
/
CHKO	LAC	I.
	SNA
	JMP*	TRMSTR		/I.=0
	SAD	L6
	JMP*	TRMSTR		/I.=MAX#
/
PACKTM	LAC	TRMCHR
	JMS	PK.OTR		/PACK TERMINATOR AND EXIT
	JMP*	TRMSTR
/
CHKA	LAC	I.
	SNA
	JMP*	TRMSTR
	JMP	PACKTM
/
CHKU	LAC	I.
	SNA
	JMP*	TRMSTR
	SAD	L3
	JMP*	TRMSTR
	JMP	PACKTM
/
ARRYCD	0
/
	.EJECT
/
/SUBROUTINE CONTUE
/THIS SUBROUTINE CHECKS TO SEE IF A CONTINUATION
/CARD SHOULD FOLLOW THE CURRENT CARD, AND ALSO
/IT ALSO READS THRU SPACES ON THE CARD.
/IF A CONTINUATION CARD SHOULD FOLLOW THE ROUTINE
/EFFECTS THE READING OF THAT CARD AND CHECKS IT
/FOR THE PROPER FORMAT.
/
/UPON RETURN THE NEW CUURENT CHAR IS IN THE AC
/IF NO CONTINUATION CARD WAS READ.
/
/IF A CONTINUATION CARD WAS READ THE AC CONTAINS
/THE CURRENT CHAR IF WE ARE PROCESSING AN EXPANDED
/SUBSITUTION PROCEEDURE FILE. IF WE ARE PROCESSING
/A DIRECT SUBSITUTION PROCEEDURE FILE THE AC WILL
/BE MINUS ONE (-1), AND SUBROUTINE GT.CHR WILL BE
/SET UP TO GET THE CHAR IN COLUMN SIX (6).
/
/
CONTUE	0
	LAC	GT.CUR		/GET CURRENT CHAR
	SAD	CR		/IF CR OR ALTMODE
	JMP*	CONTUE		/LAST CHAR CAN NOT BE A (;)
	SAD	ALTMOD		/THEREFORE EXIT
	JMP*	CONTUE
/
RDTHRU	JMS	GT.CHR		/READ THRU SPACES
	SAD	SPACE
	JMP	RDTHRU
/
	SAD	CR		/IS NON-SPACE CHAR
	SKP			/A CR OR ALTMODE
	SAD	ALTMOD		/IF NOT JUST EXIT
	SKP			/WITH CHAR IN AC
	JMP*	CONTUE
/
	LAC	GT.LST		/IF LAST CHAR IS A
	SAD	SEMCOL		/SEMICOLON THEN A
	JMP	CT.CRD		/CONTINUATION CARD MUST FOLLOW
	LAC	GT.CUR		/GET CURRENT CHAR
	JMP*	CONTUE		/EXIT
/
CT.CRD	JMS	RDCARD		/READ IN CARD
	JMS	GT.CHR		/MUST BE CONTINUATION CARD
	SAD	DOLLAR		/IE. $* IN COL 1&2
	SKP
	JMP	ILLCRD		/ERROR
	JMS	GT.CHR
	SAD	STAR
	SKP
	JMP	ILLCRD		/ERROR
	LAC	CARD%		/CARD IS OK RESET 5/7 ASCII
	TAD	L2		/GET ROUTINE TO PICKUP COL 6
	JMS	GT.FST
	XCT	EXPNSW		/DIRECT SUBSITUTION FILE
	JMP	RDTHRU		/NO -- GO FETCH NEXT CHAR
	LAW	-1		/YES -- AC_-1
	JMP*	CONTUE		/EXIT
/
ILLCRD	JMS	WRITE		/GIVE ERROR MESSAGE AND
	BADCRD			/GO READ NEXT CONTROL CARD
	.CLOSE	-14
	JMP	NXTCRD
/
BADCRD	007002
	0
	.ASCII	/ILLEGAL COMMAND CARD SEQUENCE/<15>
/
	.TITLE EXPAND PROCEDURE FILE
SUBSTT	0
	XCT	LEGALF		/IS COMMAND IN LANGUAGE
	JMS	CHKXCT		/NO -- CHECK FOR CALL FOR EXECUTE
RDINPT	JMS	RDPRC		/READ NEXT LINE IN FILE
	JMP*	SUBSTT		/EOF RETURN -- DONE
ONWARD	LAC	CARDP%		/RESET 5/7 PACK ROUTINE
	JMS	PK.FST
	LAC	ACBUF%		/RESET 5/7 UNPACK ROUTINE
	JMS	GT.FST		/AND GET FIRST CHAR
/
TRYNXT	DZM	FLPARM		/CLEAR VARIABLE SEPERATOR
	DZM	DFPARM		/CLEAR DEFAULT SEPERATOR
	LAC	LSKP		/RESET RIGHT HAND PAREN
	DAC	RTPRNF		/FOUND SWITCH
	JMS	GT.CHR		/GET NEXT CHAR
	SAD	ATSIGN		/CHAR=@?
	JMP	DECODR		/YES, DECODE IT
	JMS	PK.CHR		/NO, PACK CHAR IN OUTPUT BUF
	SAD	CR		/WAS THAT A CARRIAGE RET
	JMP	WROUTP		/YES, WRITE OUTPUT LINE
	SAD	ALTMOD		/NO, MAYBE IT WAS ALTMODE
	SKP			/YES
	JMP	TRYNXT		/NO, GET NEXT CHAR
WROUTP=.
	JMS	RTF.WT		/WRITE LINE IN RTF
	JMP	RDINPT		/NO -- LOOK AT NEXT LINE
/
DECODR=.
	LAW	-1
	TAD	FLPARM
	DAC	FLPARM
	JMS	GT.CHR
	SAD	A		/IS IT A?
	JMP	ITSA		/YES, IT IS A
	SAD	D
	JMP	ITSD		/IT'S D
	SAD	U
	JMP	ITSU		/IT'S U
	SAD	O
	JMP	ITSO		/IT' O
/
/
ERRMSG	JMS	WRITE
	ILLPRC
	.CLOSE	-14
	JMP	NXTCRD
ILLPRC	005002
	0
	.ASCII	'ILLEGAL PROC FILE'<15>
/
/
ITSA	LAW	-12		/SET FIELD LENGTH INDEX
	DAC	TEMP.2
    JMS	    FBVALU	    /CONVERT NEXT TWO CHARS TO
LM13	LAW	-13		/A BINARY VALUE IN 'BINVAL'
	TAD	BINVAL		/IF BINVAL .LT.11 PRINT ERROR
	SMA			/MESSAGE
	JMP	ERRMSG
	LAC	BINVAL		/IF A (BINVAL) IS NULL GET
	CLL!RAL			/DEFAULT
	RAL
	TAD	A.0%
	DAC	TEMP.0
	LAC*	TEMP.0
	SNA
	JMP	DEFAUL		/DEFAULT
	LAC	TEMP.0
	JMS	GT.ONE		/RESET .SIXB UNPACK
	JMP	PACKER
/
/
ITSD	LAW	-4
	DAC	TEMP.2
    JMS	    FBVALU
LM21	LAW	-21
	TAD	BINVAL
	SMA
	JMP	ERRMSG
	LAC	BINVAL
	SAD	DL13		/CHECK FOR SPECIAL FIELDS
	JMP	GETCR
	SAD	DL14
	JMP	GETALT
	RCL
	TAD	D.0%
	DAC	TEMP.0
	LAC*	TEMP.0
	SNA
	JMP	DEFAUL
	LAC	TEMP.0
	JMS	GT.ONE
	JMP	PACKER
/
GETCR	LAC	CR	/PUT SPECIAL FIELD IN RTF
	SKP
GETALT	LAC	ALTMOD
	JMS	PK.CHR
	JMP	FSHVAR		/FLUSH REST OF VARIABLE
/
/
ITSU	LAW	-3
	DAC	TEMP.2
    JMS	    FBVALU
	LAW	-13
	TAD	BINVAL
	SMA
	JMP	ERRMSG
	LAC	BINVAL
	TAD	(U.0
	DAC	TEMP.0
	LAC*	TEMP.0
	SNA
	JMP	DEFAUL
	LAC	TEMP.0
	JMS	GT.ONE
	JMP	PACKER
/
/
ITSO	LAW	-6
	DAC	TEMP.2
	LAC	O.
	SNA
	JMP	DEFAUL
	LAC	(O.
	JMS	GT.ONE
	JMP	PACKER
SUBGET	JMS	GT.OTR
PACKER	SAD	TRMCHR
	JMP	FSHVAR		/FLUSH REST OF VARIABLE
	SNA
	JMP	SKPNLS
	JMS	TOASCI
	JMS	PK.CHR
	ISZ	TEMP.2		/AT END OF FIELD
	JMP	SUBGET
/
FSHVAR	JMS	FLUSHV		/YES -- FLUSH REST OF VARIABLE
	JMP	TRYNXT		/OK -- PROCESS NEXT LINE ELEMENT
/
SKPNLS	LAC	SPACE
	JMS	PK.CHR		/PACK 1 SPACE
SKPNUL	JMS	GT.OTR
	SZA			/IS IT A NULL?
	JMP	PACKER		/NO, PACK IT
	JMP	SKPNUL		/YES, IGNORE IT& GET ANOTHER CHAR.
/
DEFAUL	JMS	GT.CHR
	SAD	LPAREN
	JMP	DFAULT
	SAD	CR
	JMP	ERRMSG
	SAD	ALTMOD
	JMP	ERRMSG
	JMP	DEFAUL
DFAULT	LAW	-1		/ACCOUNT FOR "("
	TAD	DFPARM
	DAC	DFPARM
DFAU.0	JMS	GT.CHR
	SAD	ATSIGN
	JMP	DECODR
	SKP
DFAU.1	JMS	GT.CHR
	SAD	RPAREN
	JMP	DFAU.2		/START FLUSHING VARIABLE
	SAD	CR
	JMP	ERRMSG
	SAD	ALTMOD
	JMP	ERRMSG
	JMS	PK.CHR
	JMP	DFAU.1
/
DFAU.2	ISZ	DFPARM		/ACCOUNT FOR ")"
	NOP
	LAC	LNOP		/SET RIGHT PAREN FOUND SW
	DAC	RTPRNF
	JMP	FSHVAR		/FLUSH REST OF VARIABLE
/
	.TITLE SUBR'S RDPRC,FILTYP,CHKCMD,CHKXCT
/
/SUBROUTINE RDPRC
/READS A LINE FROM DAT -14
/AND TEST FOR (EOF) RETURN ONE
/LINE OK RETURN TWO
/IF READ ERROR IT GIVES ERROR MESSAGE
/AND READS NEXT CONTROL CARD
/CALL	JMS	RDPRC
/	EOF RETURN
/	NORMAL RETURN
RDPRC	0
RD.1	.READ	-14,2,ACBUFF,36 /READ INPUT FILE
	.WAIT	-14
	LAC	ACBUFF
	AND	L77		 /E.O.F OR INPUT READ ERROR ?
	SAD	L5
	JMP	RDEOF		/YES E.O.F
	AND	L60
	SNA
	JMP	NEWLIN		/NO - ITS A NEW LINE
	JMP	RDERR		/YES READ ERROR
/
RDEOF	.CLOSE	-14		/CLOSE INPUT FILE
	JMP*	RDPRC		
/
NEWLIN	IDX	RDPRC		/BUMP TO RETURN TWO
	JMP*	RDPRC
/
RDERR	JMS	WRITE
	BADRD
	JMP	NEXT.		/READ NEXT CARD
/
BADRD	006002
	0
	.ASCII	'PROC FILE READ ERROR'<15>
/
/SUBROUTIN FOR DECODING AND CHECKING THE
/1'ST LINE IN A PROCEEDURE FILE. THE 1'ST
/LINE IN A PROCEEDURE FILE IS THE FILE
/DESCRIPTION LINE AND IS IN THE FORM FO
/N;M;O;P.... WHERE N,M,... ARE INTERGERS.
/
/AT PRESENT ONLY 0,1,2,3,AND 4 ARE USED.
/	0=EXPADED SUBSITUTION  (DEFAULT IF "3" NOT GIVEN)
/	1=OPEN ENDED FILE -- RTF LEFT OPEN (DEFAULT IF "2" NOT GIVEN)
/	2=CLOSED ENDED FILE -- CLOSE RTF AND RUN
/	3=DIRECT SUBSITUTION
/	4=ECHO PRCFIL LINE ON LINE PRINTER  (TESTING PURPOSES)
/
/CURRENT ILLEGAL COMBINATIONS ARE AS FOLLOWS
/	0 AND 3
/	1 AND 2
/
FILTYP	0
	JMS	GTSWAP		/SWAP OUT GT.CHR DATA
	LAC	ACBUF%
	JMS	GT.FST		/SETUP 5/7 UNPACKING ROUTINE
	DZM	GIVE0		/SET DEFAULT NOT GIVEN INDICATORS
	DZM	GIVE1
	LAC	LNOP		/RESET FILE TYPE SWITCHS
	DAC	EXITSW		/NOP -- MEANS LEAVE RTF OPEN
	DAC	TESTSW		/NOP -- MEANS DON'T ECHO RTF LINE
	DAC	EXPNSW		/NOP -- MEANS EXPANDED SUBSITUTION
NXTPRM	JMS	GT.CHR		/GET PARAMETER AN DECODE IT
	SAD	ZERO
	JMP	SETEXP
	SAD	ONE
	JMP	SETOPN
	SAD	TWO
	JMP	SETRUN
	SAD	THREE
	JMP	SETDIR
	SAD	FOUR
	JMP	SETTST
	SAD	CR
	JMP	CHKSW
	SAD	ALTMOD
	JMP	CHKSW
	JMP	NXTPRM		/IGNORE CHARACTER
/
SETEXP	ISZ	GIVE0		/INDICATE "0" SPECIFIED
	JMP	NXTPRM
/
SETOPN	ISZ	GIVE1		/INDICATE "1" SPECIFIED
	JMP	NXTPRM
/
SETRUN	LAC	LSKP		/SET CLOSE AN RUN SW
	DAC	EXITSW
	JMP	NXTPRM
/
SETDIR	LAC	LSKP		/SET DIRECT SUBSITUTION SW
	DAC	EXPNSW
	JMP	NXTPRM
/
SETTST	LAC	LSKP		/SET LINE ECHO SWITCH (FOR TESTING)
	DAC	TESTSW
	JMP	NXTPRM
/
CHKSW	JMS	GTSWAP		/SWAP BACK GT.CHR DATA
	LAC	GIVE0		/CHECK FOR ILLEGAL
	SZA			/OPTION COMBINATIONS
	XCT	EXPNSW		/0-3 ILLEGAL
	SKP
	JMP	ERRMSG
	LAC	GIVE1
	SZA
	XCT	EXITSW		/1-2 ILLEGAL
	JMP*	FILTYP		/EXIT ALL IS OK
	JMP	ERRMSG
/
/
EXITSW	NOP
EXPNSW	NOP
TESTSW	NOP
GIVE0	0
GIVE1	0
/
	.EJECT
/
/SUBROUTINE CHKCMD
/THIS SUBROUTINE CHECKS TO SEE IF THE COMMAND
/IS IN THE BOSS LANGUAGE, AND IF SO SET "LEGALF"
/TO A SKP. IT ALSO OPENS,READS, AND DECODES
/THE I'ST LINE IN THE PRC FILE.
/
CHKCMD	0			/CHECK FOR CMD IN LANG
	LAC	LNOP		/AND SET FLAGS ECT. RESET
	DAC	LEGALF		/CMD FOUND FLAG.
	LAC	CRTFLG		/DON'T BOTHER CHECKING
	SZA			/IF WE ARE MAKING UP AN ADD FILE
	JMP*	CHKCMD
FST.1	.FSTAT	-14,COMND.	/IS INPUT FILE THERE?
	SNA
	JMP*	CHKCMD		/NOT IN LANG -- EXIT
START	.SEEK	-14,COMND.	/OPEN INPUT FILE.
	JMS	RDPRC		/READ FIRST LINE IN PRC FILE
	JMP	ERRMSG		/NO LINE ERROR
	JMS	FILTYP		/WHAT TYPE OF FILE IS THIS
	LAC	LSKP		/SET CMD FOUND FLAG
	DAC	LEGALF
	JMP*	CHKCMD		/EXIT
/
LEGALF	NOP
/
	.EJECT
/
/SUBROUTINE CHKXCT
/THIS SUBROUTINE CHECKS TO SEE IF THE
/USER HAS AN EXECUTE FILE ON HIS UFD
/BY THE NAME OF THE COMMAND.
/IF SO IT SETS UP TO CALL THE XCT PRC FILE
/IF NOT YOU GET  "ILLEGAL COMMAND"
/
CHKXCT	0			/CHECK TO SEE IF USER
	LAC	COMND.		/IS USING A SHORT HAND
	DAC	XCTCOM		/WAY TO EXECUTE AN XCT FILE
	LAC	D.12		/GET USERS UIC
	DAC	USER
/	.USER	-14,USERS UIC
	764
	23
USER	.SIXBT	'CTP'		/CHANGED TO USERS UIC
	.INIT	-14,0,0
FST.3	.FSTAT	-14,XCTCOM
	DAC	TEMP.0
/	.USER	-14,CTP //RESTORE BOSS UIC
	764
	23
	.SIXBT	'CTP'
	.INIT	-14,0,0
	LAC	TEMP.0		/DOES USER HAVE AN EXECUTE
	SNA			/ON HIS UFD -- SKP IF SO
	JMP	BADCOM
	LAC	XCT		/SETUP TO CALL IN XCT PRC
	DAC	COMND.
	LAC	XCTCOM		/GET FILE NAME AND PUT IN A00
	DAC	A.0
	LAC	TRMCHR		/PUT TERMINATOR IN A00
	ALS!SHAL	14
	DAC	A.0+1
	JMS	CHKCMD		/MAKE SURE XCT PRC IS IN LANG
	XCT	LEGALF
	SKP
	JMP*	CHKXCT		/EXIT
/
BADCOM	      JMS     WRITE	      /NO, WRITE ERROR MESSAGE
	ILLCMD
	JMP	NXTCRD
ILLCMD	005002
	0
	.ASCII	'ILLEGAL COMMAND'<15>
	.TITLE SUBR'S RTF.WT,FLUSHV
/
/SUBROUTINE RTF.WT
/THIS SUBROUTINE WRITES AND KEEPS COUNT OF HOW
/MANY LINES THERE ARE IN THE RTF
/IT ALSO ECHO THE LINE IF IN TEST
/MODE (CODE 4).
/
RTF.WT	0			/WRITE LINE IN RUN TIME FILE (RTF)
	ISZ	LNCNT		/COUNT LINE IN RTF
	LAC	CHRCNT		/COMPUTE HEADER WORD-PAIR
	TAD	L11		/COUNT:
	IDIV!SHAL			/   (CHRCNT+11)/5
	5
	LACQ
	SWHA
	TAD	L2		/TURN ON MODE BIT (.ASCII)
	DAC	CARDP
WRT.1	 .WRITE	 -15,2,CARDP,36	 /ALL DONE FOR THIS LINE
	.WAIT	-15
	XCT	TESTSW		/IN TEST MODE
	JMP*	RTF.WT		/NO -- EXIT
	JMS	WRITE		/YES -- ECHO LINE
	CARDP
	JMP*	RTF.WT		/EXIT
/
	.EJECT
/
/SUBROUTINE FLUSHV
/THIS SUBROUTINE FLUSHES THRU THE CURRENT VARIABLE
/BEING PROCESSED, AND CHECKS FOR ITS VALIDITY.
/
FLUSHV	0
FLUSH	JMS	GT.CHR
	SAD	ATSIGN		/FLUSH VARIABLE
	JMP	FLUSHF
	SAD	LPAREN		/FLUSH DEFAULT
	JMP	FLUSHD
	SAD	RPAREN		/END OF DEFAULT
	JMP	EDFAUL
	SAD	CR
	JMP	ERRMSG
	SAD	ALTMOD
	JMP	ERRMSG
	JMP	FLUSH		/KEEP FLUSHING
/
FLUSHD	XCT	RTPRNF		/"(" IS ILLEGAL IF A ")" HAS BEEN FOUND
	JMP	ERRMSG
	LAW	-1		/ACCOUNT FOR "("
	TAD	DFPARM
	DAC	DFPARM
	JMP	FLUSH		/KEEP FLUSHING
/
EDFAUL	ISZ	DFPARM		/ACCOUNT FOR ")"
LNOP	NOP
	LAC	LNOP		/SET ")" FOUND SW
	DAC	RTPRNF
	JMP	FLUSH		/KEEP FLUSHING
/
FLUSHF	XCT	RTPRNF		/IS IT A LEFT ON RIGHT "@"
	JMP	RTATS		/ITS A RIGHT HAND ATSIGN
	LAW	-1		/ACCOUNT FOR LEFT "@"
	TAD	FLPARM
	DAC	FLPARM
	JMP	FLUSH		/KEEP FLUSHING
/
RTATS	ISZ	FLPARM		/IS VARIABLE DONE
	JMP	FLUSH		/NO KEEP FLUSHING
	LAC	DFPARM		/YES -- ALL PAREN'S BETTER
	SZA			/BE ACCOUNTED FOR
	JMP	ERRMSG		/TO BAD
	JMP*	FLUSHV		/EXIT
	.TITLE END CURRENT JOB
/
ENDJOB=.
	LAC	RTFFLG		/ANYTHING IN RTF
	SNA
	JMP	CLSJOB		/NO - GO CLOSE OUT JOB
	LAC	COMND.
	SAD	JOB
	JMP	SAVCRD		/SAVE THE CARD IMAGE
RUNJOB	LAC	AC.STA		/SET FLAG TO FINISH JOB
	AND	L3A57S
	XOR	LM0
	DAC	AC.STA
	JMP	EXIT		/GO RUN RTF
/
SAVCRD	LAC*	L152		/SET BIT 1 IN .SCOM+52
	XOR	L2A50		/SO THAT THE CARD READER
	AND	L2A50		/WILL NOT READ ANY MORE CARDS
	XOR*	L152		/UNTILL WE ARE BACK IN NRBOSS
	DAC*	L152
	JMP	RUNJOB		/GO RUN THE JOB
/
CLSJOB	LAC*	L152		/JOB ACTIVE ??
	AND	L1000
	SNA
	JMP	CHKEXT		/NO -- DON'T GIVE END JOB MESG ECT.
	XOR*	L152		/YES -- CLEAR FLAG
	DAC*	L152		/
	LAC*	L150		/ENTER IN ACCOUNTING
	DAC	AC.TMF		/BUFFER TIME OF JOB COMPLETION.
	LAC*	L134		/GET USERS ELAPSED TIME
	DAC	AC.DTM
	.CLOSE	-14		/MAKE SURE PRC FILE IS CLOSED (JOB PRC)
/
/CALCULATE USER RUN TIME IN HH:MM:SS
/
	LAC	AC.DTM		/GET SECONDS
	CLL
	IDIV
	74
	DAC	SECS
	LACQ			/GET MINS
	IDIV
	74
	DAC	MINS
	LACQ			/GET HOURS
	ALS!SHAL	6
	TAD	MINS
	ALS	6
	TAD	SECS
	DAC	AC.DTM
/ENTER ACCOUNTING BUFFER IN ACCOUNTING FILE
/
/THE ACCOUNTING FILE IS A 10(DEC)-BLOCK RANDOM ACCESS
/FILE CALLED 'ACCNTG001'.  EACH BLOCK CONTAINS
/37(OCT) 8-WORD BUFFERS.  THE FORMAT OF EACH BUFFER IS
/
/	WORD1		JOB I.D.
/	WORD2		JOB I.D.
/	WORD3		JOB I.D.
/	WORD4		DATE (MMDDYY)
/	WORD5		START TIME (HHMMSS)
/	WORD6		FINISH TIME (HHMMSS)
/	WORD7		DELTA TIME (HHMMSS)
/	WORD8		JOB RUN TIME STATUS
/
/WHEN THE ACCOUNTING FILE 'ACCNTG001' IS EXAUSTED, IT IS
/RENAMED TO 'ACCNTG002' OR 'ACCNTG003', AND SO ON, UNTIL
/AN UNUSED FILE NAME IS FOUND. IF NO ACCOUNTING
/FILE EXISTS, IT IS ASSUMED THE FILE HAS BEEN
/PROCESSED, AND A NEW SERIES OF FILES IS STARTED.
/
FST.4	.FSTAT	-14,ACCFIL	/DOES AN ACCOUNTING FILE EXIST?
	SZA			/NO, START ONE
	JMP	HAVFIL		/YES, CONTINUE
CRAFIL	.ENTER	-14,ACCFIL		/OPEN FILE
	LAC	(176002		/CREATE HEADER
	DAC	ACBUFF
	LAW	-1		/SETUP BUFFER TO INDICATE EOF
	DAC	ACBUFF+2		/(176002,XXXXXX,777777)
	LAW	-12
	DAC	TEMP.0
WRT.7	.WRITE	-14,2,ACBUFF,256
	ISZ	TEMP.0
	JMP	WRT.7
	.CLOSE	-14
	DZM	AC.ENT
HAVFIL	LAC	AC.ENT		/GET #ENTRIES IN CURRENT FILE
	SAD	L466		/IS FILE COMPLETE?
	JMP	NEWFIL		/YES, START ANOTHER FILE.
	IDIV!SHAL			/DIVIDE NEW ENTRY # BY # OF
	37			/ENTRIES PER BLOCK.
	DAC	BPBLK		/SAVE BUFFER POSITION WITHIN BLOCK.
	LACQ			/GET BLOCK #.
	IAC
	DAC	IBLKNO		/SAVE IT IN INPUT. RTRAN.
	XOR	LM0		/BIT0=1 -- OUTPUT IN .RTRAN
	DAC	OBLKNO		/AND OUTPUT .RTRAN
/	.RAND	-14,ACCFIL	/OPEN FILE FOR RANDOM ACCESS.
	5764
	2
RND.1	ACCFIL
	0
/	.RTRAN	-14,0,BLKNO,ACBUFF,0,253
	4764			/READ BLOCK.
	2
IBLKNO	0
RTR.1	ACBUFF
	0
	777403
	.WAIT	-14
	LAC	BPBLK		/COMPUTE WORD POSITION WITHIN BLOCK.
	MUL!SHAL
	10
	LACQ
	TAD	ACBUF%		/RELOCATE IT IN BUFFER.
	DAC	TEMP.1
	LAC	AC.ID%		/MOVE NEW ENTRY IN BUFFER
	DAC	TEMP.2
	LAW	-10
	DAC	TEMP.0
LOOP.2	LAC*	TEMP.2
	DAC*	TEMP.1
	ISZ	TEMP.1
	ISZ	TEMP.2
	ISZ	TEMP.0
	JMP	LOOP.2
	LAW	17777		/777777 IN FIRST WORD OF
	DAC*	TEMP.1		/NEXT ENTRY MARKS END OF FILE.
/	.RTRAN	-14,1,BLKNO,ACBUFF,0,253
	4764			/WRITE BLOCK
	2
OBLKNO	0
RTR.2	ACBUFF
	0
	777403
	.CLOSE	-14		/CLOSE ACCOUNTING FILE.
	ISZ	AC.ENT		/UPDATE ACCNTNG FILE ENTRY COUNT.
	.EJECT
/
/
/OUTPUT JOB ENDED MESSAGE
/ENDJMG	JMS	WRITE		/SPACE TO TOP OF PAGE.		/RKB-059
/	FORMFD							/RKB-059
/								/RKB-059
/								/RKB-059
/ THE ABOVE TWO LINES WERE DELETED TO CAUSE LESS PAPER TO BE 	/RKB-059
/ THROWN AS PART OF THE BOSS RITUAL.				/RKB-059
/								/RKB-059
/								/RKB-059
ENDJMG	JMS	WRITE		/SPACE DOWN 20 LINES.		/RKB-059
	LPVTAB
	JMS	WRITE		/OUTPUT END-JOB MESSAGE
	ENDHDR			/HEADER.
	LAC	ACBUF%		/INITIALIZE OUTPUT BUFFER FOR
	JMS	PK.FST
/PACK JOB I.D.
	LAW	-11
	DAC	TEMP.0		/9 CHARACTERS.
	LAC	AC.ID%		/INITIALIZE INPUT BUFFER FOR
	JMS	GT.ONE		/SIXBT UNPACKING.
	SKP
LOOP.4	JMS	GT.OTR		/GET SIXBIT CHARACTER,
	JMS	TOASCI		/CONVERT IT TO ASCII,
	JMS	PK.CHR		/PACK IT,
	ISZ	TEMP.0		/CONTINUE.
	JMP	LOOP.4
	LAC	HTAB		/PACK TAB.
	JMS	PK.CHR
/PACK DATE
	LAC	AC.DT		/GET DATE,
	LRS	14		/ISOLATE MONTH FIELD.
	AND	L77		/PACK MONTH.
	TAD	MONTHS
	DAC	TEMP.0
	LAC*	TEMP.0
	JMS	PACKAC
	LAC	SPACE		/PACK SPACE.
	JMS	PK.CHR
	LAC	AC.DT		/GET DATE,
	LRS	6		/ISOLATE DAY FIELD.
	JMS	PKTWO		/PACK DAY.
	LAC	SPACE		/PACK SPACE.
	JMS	PK.CHR
	LAC	QUOTE		/PACK QUOTE (FOR YEAR).
	JMS	PK.CHR
	LAC	AC.DT		/GET DATE.
	AND	L77
	TAD	L106
	IDIV!SHAL
	12
	DAC	TEMP.0
	LACQ
	TAD	L60
	JMS	PK.CHR
	LAC	TEMP.0
	TAD	L60
	JMS	PK.CHR
	LAC	HTAB
	JMS	PK.CHR
/PACK TIME STARTED
	LAC	AC.TMI		/GET INITIAL TIME,
	JMS	PKTIME		/PACK IT IN BUFFER.
	LAC	HTAB
	JMS	PK.CHR
/PACK TIME ENDED
	LAC	AC.TMF		/GET FINAL TIME,
	JMS	PKTIME		/PACK IT IN OUTPUT BUFFER.
	LAC	HTAB
	JMS	PK.CHR
/PACK ELAPSED TIME
	LAC	AC.DTM		/GET DELTA-T,
	JMS	PKTIME		/PACK IT IN OUTPUT BUFFER.
	LAC	CR
	JMS	PK.CHR
/OUTPUT MESSAGE
	LAC	CHRCNT		/COMPUTE HEADER WORD OF
	TAD	L11		/ASCII OUTPUT BUFFER
	IDIV!SHAL
	5
	LACQ
	SWHA
	TAD	L2
	DAC	ACBUFF
	JMS	WRITE
	ACBUFF
	.CLOSE	6		/CLOSE PRINT FILE (BR-56)
/
/CHECK FOR VARIOUS EXITS
/
CHKEXT	LAC*	L152		/EXIT BOSS MODE
	AND	L400
	SZA
	JMP	EXBOS1		/YES
	LAC*	L152		/CLEAR OUT .SCOM+52
	AND	L6A50S
	DAC*	L152
	LAC	COMND.		/$JOB CARD
	SAD	JOB
	JMP	OPNJOB		/YES!
	JMP	NXTCRD		/NO--READ NEXT CARD
/
	.EJECT
/
/
/ROUTINE TO OUTPUT TIME STORED IN AC
/
PKTIME	0
	DAC	TEMP.2		/SAVE TIME.
	LRS	14		/ISOLATE HOURS.
	JMS	PKTWO		/PACK HOURS.
	LAC	COLON		/PACK COLON.
	JMS	PK.CHR
	LAC	TEMP.2		/ISOLATE MINUTES.
	LRS	6
	JMS	PKTWO		/PACK MINUTES.
	LAC	COLON		/PACK COLON.
	JMS	PK.CHR
	LAC	TEMP.2
	JMS	PKTWO		/PACK SECONDS.
	JMP*	PKTIME
/
/ROUTINE TO CONVERT OCTAL TO DECIMAL AND PACK
/TWO DIGITS STORED IN AC.
/
PKTWO	0
	AND	L77		/MASK TWO OCTAL DIGITS.
	IDIV			/DIVIDE BY 10-DECIMAL
	12
	DAC	TEMP.0		/SAVE REMAINDER (SECOND CHAR)
	LACQ			/PACK HIGH ORDER DIGIT.
	TAD	L60
	JMS	PK.CHR
	LAC	TEMP.0		/PACK LOW ORDER DIGIT.
	TAD	L60
	JMS	PK.CHR
	JMP*	PKTWO
/
/ROUTINE TO CONVERT 3 SIXBIT CHARS STORED IN AC
/TO ASCII CHARS AND PACKS THEM.
/
PACKAC	0
	LMQ
	LAW	-3
	DAC	TEMP.0
LOOP.5	LLS	6
	JMS	TOASCI
	JMS	PK.CHR
	ISZ	TEMP.0
	JMP	LOOP.5
	JMP*	PACKAC
/
	.EJECT
/
/FIND NEXT ACCOUNTING FILE
/CURRENT A/C FILE IS ALWAYS ACCNTG 001
/
/COMPLETED A/C FILES GO IN SEQUENTIAL ORDER
/FROM OLDEST TO NEWEST.
/
/	OLDEST		NEWEST
/	002,003,-----------NNN,001
/
NEWFIL	.FSTAT	-14,ALTFIL	/MAKE SURE NEW FILE
	SNA			/DOESN'T ALREADY EXIST.
	JMP	OPENEW		/IT DOESN'T, GO ON.
	LAC	ALTEXT		/IT DOES, CHANGE FILE
	SAD	L777		/CHECK OF MAX# OF FILES REACHED
	JMP	MAXFIL		/TELL OPERATOR OF PROBLEM
	IAC			/NAME AND TRY AGAIN.
	DAC	ALTEXT		/SAVE NEW EXTENSION
	SWHA!CLL			/COVERT OCTAL NUMBER
	LMQ			/TO .SIXBT
	LAW	-3
	DAC	TEMP.2		/SET INDEX
	ECLA!LLS	3		/START CONVERTING
LOOP.7	XOR	L60
	ISZ	TEMP.2
	SKP
	JMP	NEWF1		/DONE
	ALS	3
	LLS	3
	JMP	LOOP.7		/MAKE UP NEXT .SIXBT CHAR
/
NEWF1	DAC	ALTFIL+2
	JMP	NEWFIL
/
OPENEW	.RENAM	-14,ACCFIL	/RENAME FILE
	JMP	CRAFIL		/CREATE A NEW FILE.
/
MAXFIL	.WRITE	-3,2,ACTFIL,36	/THE MAX # OF A/C HAS BEEN REACHED!
WRT.11	.WRITE	-3,2,ACFIL1,36	/TELL OPERATOR
	.WAIT	-3
	JMP	ENDJMG		/FINISH UP ENDJOB
/
ACTFIL	011002
	0
	.ASCII /MAX NUMBER OF ACCOUNTING FILES REACHED/<15>
ACFIL1	010002
	0
	.ASCII /PLEASE PROCESS AND DELETE THEM/<15>
	.TITLE	BRING IN "DUMP"
/
/
DMPPRC	.WRITE	-15,2,DUMP,36	/WRITE OUT RTF LINES
	DZM	TCLOCK		/DISABLE TIMEOUT SO THAT
				/THE USER GETS COMPLETE DUMP
	IDX	LNCNT		/COUNT TWO LINES
	IDX	LNCNT
WRT.10	.WRITE	-15,2,ALL,36	/ "DUMP"  "ALL"
	JMP	EXIT		/RUN RTF NOW!
	.TITLE READ-CARDS ROUTINE
/
RDCARD	0
	LAC	ADDSTA		/READING ADD FILE?
	SPA			/NO, READ CARD.
	JMP	RD.ADD		/YES, READ ADD FILE.
RD.SAT	LAC*	L152
	AND	L2A50
	SNA
	JMP	RD.CRD
	XOR*	L152
	DAC*	L152
	JMP	RD.RET
RD.CRD	.READ	5,2,CARD,36
	.WAIT	5
RD.RET=.
	LAC	CARD		/CHECK FOR "EOM"
	SAD	EOM
	JMP	EXTBOS		/EXIT BOSS MODE
	SAD	EOF
	JMP	EXTBOS
/
	LAC	CRTFLG		/DON'T DELETE TRAILING
	SZA			/IF MAKING UP AN ADD FILE
	JMP	RD.CON
/
/DELETE TRAILING SPACES FROM CARD IMAGE
/IN 5/7 ASCII WORD PAIR INCREMENTS.
/AFTER WE GO THRU THIS CODE A MAX. OF
/4 TRAILING SPACES MAY REMAIN.
/
/LINE BUFFER IS ASSUMED TO BE IN THIS FORM
/
/ 0-1	HWP
/ 2-41	DATA
/ 42-43	APPENDED <CR>
/
	LAC	CARD%		/SETUP POINTER TO LAST 
	TAD	L40		/WORD PAIR IN BUFFER
NEXTPR	DAC	TEMP.0
	LAC*	TEMP.0		/XOR WORD PAIR
	IDX	TEMP.0		/TOGETHER
	XOR	KSPACE
	SAD*	TEMP.0		/COMPAIR WITH TEST VALUE
	SKP			/SKIP IF THE SAME
	JMP	LST.PR		/STORE <CR> IN BUFFER
	LAW	-3		/UPDATE POINTER
	TAD	TEMP.0
	JMP	NEXTPR		/GO CHECK NEXT PAIR
LST.PR	LAC*	TEMP.0
	LRS	1		/CHECK FOR SPACE
	AND	L177
	SAD	SPACE
	SKP
	JMP	CR.STR		/NO SPACES-PACK CR
/AFTER WE GO THR THIS CODE NO SPACES SHOULD REMAIN
	LAC*	TEMP.0
	LRS	1		/SHIFT 1 TO LOOK AT 5TH WORD
	AND	(777600
	XOR	CR		/GET RID OF SPACE AND PACK <CR>
	LLS	1		/SHIFT BACK AND STORE
	DAC*	TEMP.0
	LRS	10		/SHIFT 4TH WORD INTO BITS 11-17
	AND	L177
	SAD	SPACE		/IS IT A SPACE?
	SKP
	JMP	RD.CON		/NO,CONTINUE READING
	LAC*	TEMP.0		/YES, SHIFT BITS AND CHANGE
	LRS	10		/SPACE TO <CR>
	AND	(777600
	XOR	CR
	LLS	10		/SHIFT BACK TO PROPER POS. AND STORE
	DAC*	TEMP.0
	LRS	17		/SHIFT BITS 0-2 INTO 15-17
	AND	(7		/IS IT A 0?
	SZA
	JMP	RD.CON		/NO-CONTINUE READING
	LAW	-1		/YES-MIGHT BE A SPACE,GET FIRST 1/2
	TAD	TEMP.0		/OF WORD PAIR
	DAC	TEMP.0
	LAC*	TEMP.0
	AND	L17		/GET BITS 14-17 IN AC (1ST HALF OF WORD 3)
	SAD	L4		/IF IT'S A 4, THEN WORD 3 IS A SPACE
	SKP
	JMP	RD.CON		/NO SPACE, CONTINUE READING
	LAC*	TEMP.0
	AND	(777760		/CHANGE THE 4 TO A 1
	XOR	L1
	DAC*	TEMP.0
	IDX	TEMP.0		/GET 2ND 1/2 OF WORD PAIR
	LAC*	TEMP.0
	AND	(77777
	XOR	(500000		/STORE A 5 IN BITS 0-2
	DAC*	TEMP.0		/WORD 3 IS NOW A <CR>
	LAW	-1
	TAD	TEMP.0		/GET 1ST 1/2 OF WORD PAIR AGAIN
	DAC	TEMP.0
	LAC*	TEMP.0
	LRS	4		/SHIFT BITS TO SEE WORD 2
	AND	L177
	SAD	SPACE		/IS IT A SPACE?
	SKP			/YES, SKIP
	JMP	RD.CON		/NO-CONTINUE READING
	LAC*	TEMP.0
	LRS	4		/BITS INTO 11-17 (WORD 2)
	AND	(777600
	XOR	CR		/STORE <CR> AND SHIFT
	LLS	4		/BACK TO PROPER POSITION
	DAC*	TEMP.0		/CONTINUE READING-ALL SPACES GONE
CR.STR	LAC	KCR		/GET 5/7 ASCII <CR>
	IDX	TEMP.0		/BUMP TO 1'ST WORD OF NEXT WP
	DAC*	TEMP.0		/STORE IT
RD.CON	LAC	CARD+2		/CHECK FOR $MIC CARD
	SAD	.MIC
	SKP
	JMP	CKJOB
	LAW	-400
	AND	CARD+3
	SAD	.MIC+1
	JMP	NOECHO
/
CKJOB	LAC	CARD+2		/DON'T ECHO $JOB CARD NOW
	SAD	.JOB
	SKP
	JMP	WRT.2
	LAW	-400
	AND	CARD+3
	SAD	.JOB+1
	JMP	NOECHO
/
/
WRT.2	JMS	WRITE		/ECHO CARD
	CARD
NOECHO	LAC	CARD%
	JMS	GT.FST
	LAC	CARD%
	JMP*	RDCARD
	.EJECT
/
RD.ADD	LAC	D.12		/ONCE ONLY CODE TO
	DAC	RD.USR		/OPEN ADD FILE. USE
/	.USER	-11,D.12	/USER'S UIC.
	767
	23
RD.USR	XX
	.INIT	-11,0
FST.2	.FSTAT	-11,ADDFIL	/IS FILE THERE?
	SNA			/YES, SKIP.
	JMP	RD.ERR		/NOT THERE.
SEK.1	.SEEK	-11,ADDFIL	/OPEN FILE.
	LAC	ADDSTA		/SKIP OVER LINES ALREADY
	XOR	LM0		/READ.
	DAC	TEMP.0		/# LINES TO SKIP OVER.
	DZM	TEMP.1		/# LINES READ.
RD.CHK	LAC	TEMP.1		/ARE WE DONE?
	SAD	TEMP.0
	JMP	RD.GET		/YES, GO GET LINE.
	JMS	RD.ADL		/NO, SKIP ANOTHER LINE.
	SKP			/NORMAL RETURN
	JMP	R.ERR1		/EOF RETURN "DIFFERENT ADD FILE"
	ISZ	TEMP.1		/UPDATE LINE COUNT.
	JMP	RD.CHK		/LOOP.
/
RD.GET	LAC	TEMP.0		/RESTORE "ADDSTA"
	XOR	LM0
	DAC	ADDSTA
	LAC	.+2		/PATCH JMP AROUND ONCE
	DAC	RD.ADD		/ONLY CODE.
	JMP	.+1
	JMS	RD.ADL		/READ ADD FILE.
	JMP	RD.RET		/RETURN WITH NEW LINE
	JMP	RD.SAT		/RETURN EOF FOUND
/
/
RD.ADL	0
RED.1	.READ	-11,2,CARD,36
	IDX	ADDSTA		/COUNT LINE
	.WAIT	-11
	LAC	CARD		/EOF ??
	AND	L17
	SAD	L5
	SKP
	SAD	L6		/EOM ??
	SKP
	JMP*	RD.ADL		/NETHER
	.CLOSE	-11		/CLOSE INPUT FILE
	LAC	(JMP	RD.USR+1	/RESTORE ONCE ONLY
	DAC	RD.ADD
	JMS	ADBITS		/CLEAR OUT ADD FILE BITS
	IDX	RD.ADL		/BUMP TO EOF RETURN
	JMP*	RD.ADL
/
RD.ERR	JMS	WRITE
	.ADMSG
	JMP	AD.EXT
.ADMSG	005002
	0
	.ASCII 'NON-EXISTANT ADD FILE'<15>
/
R.ERR1	JMS	WRITE
	.ADIFF
AD.EXT	JMS	ADBITS		/CLEAR OUT ADD FILE BITS
	.CLOSE	-11
	JMP	NXTCRD
.ADIFF	005002
	0
	.ASCII	'DIFFERENT ADD FILE'<15>
/
/SUBROUTINE ADBITS
/COMPLEMENT THE BITS IN .SCOM+52 AND ADDSTA USED BY ADD
/FILE PROCESSING. CALLED 1'ST TIME TO SET BITS AND CALLED
/THE 2'ND TIME TO CLEAR THE BITS.
/
ADBITS	0
	LAC	ADDSTA
	XOR	LM0		/ADD FILE FLAG
	DAC	ADDSTA
	LAC*	L152
	XOR	L2A50		/FLAG FOR CARD READER IN .SCOM+52
	DAC*	L152
	JMP*	ADBITS
/
	.TITLE EXIT FROM NON-RES BOSS TO DOS-15 NRM
/
/PROCEEDURE FILE AND CONTROL CARD HAVE BEEN
/PROCESSED, AND THE RTF NOW CONTAINS THE RESULT
/OF THAT PROCESSING. DETERMINE WHAT ACTION TO TAKE NEXT
/BASED UPON THE 1'ST LINE IN THE PROCEEDURE FILE
/JUST PROCESSED.
/
EXTPRC	XCT	EXITSW
	JMP	NXTCRD		/READ NEXT CONTROL CARD
/	JMP	EXIT		** CLOSE RTF AND RUN **
/
EXIT	XCT	PIPSW		/CHECK FOR PIP CMD'S
	JMS	CLSPIP
	LAC	RTFFLG		/ANYTHING IN RTF
	SNA
	JMP	NXTCRD		/NO READ NEXT CARD
EXIT1	LAC	SCOM42		/SET BOSS-15 USER MODE ON.
	AND	LM2		/AND RESTORE .SCOM+42
	XOR	L1
	DAC*	L142
	LAC	D.12		/RESTORE CURRENT UIC.
	DAC*	L141
WRT.6	.WRITE	-15,2,BOSSLN,36
	ISZ	LNCNT
	LAC	LNCNT		/SET .SCOM+75 TO:
	SWHA			/  LEFT HALF - #LINES IN 'PRCFILPRC'
	DAC*	L175		/ RIGHT HALF - 000
	AND	L777		/CHECK FOR RTF TOO LONG
	SZA
	JMP	RTFERR		/IT IS TOO BAD
	.CLOSE	-15		/CLOSE 'PRCFILPRC'
	.CLOSE	-11		/CLOSE ADD FILE
/
/UPDATE 1'ST BLOCK OF BOSS15 (COMMUNICATION AERA)
/WITH THE 1'ST 400(8) WORDS OF BOSS15 IN CORE
/
	LAC*	L131		/GET POINTER TO OVERLAY TABLE
	TAD	L2		/SKIP OVER NAME
	DAC	TEMP.0
	LAC*	TEMP.0		/GET 1'ST BLK OF BOSS15
	DAC	TRAN.1+2		/PUT IT IN .TRAN
TRAN.1	.TRAN	-15,1,XX,CARD,256
	.WAIT	-15
	LAC	CLRBIT		/CLEAR VARIOUS BITS IN .SCOM+52
	AND*	L152
	DAC*	L152
	LAC	TCLOCK		/START UP TIME
	DAC*	L156		/OUT CLOCK
NRMEXT	      .EXIT
/
RTFERR	JMS	WRITE		/RTF IS TOO LONG
	RTFMSG			/TELL USER
ABRTJB	.CLOSE	-11
	.INIT	-15,1,0		/CLEAN UP THE DISK
ENT.3	.ENTER -15,PRCFIL
	DZM	LNCNT
	JMP	ENDJOB		/AND KILL HIS JOB
RTFMSG	006002
	0
	.ASCII	'RUN TIME FILE TOO LONG'<15>
	.EJECT
/
/EXIT FROM BOSS15 MODE
/
EXTBOS	LAW	-401
	AND*	L152
	XOR	L400
	DAC*	L152		/BIT 9 SET IN .SCOM+52
	XCT	PIPSW		/PIP CMD IN PROCESS
	JMS	CLSPIP		/YES CLOSE IT OUT
WRT.9	.WRITE	-15,2,LOGOUT,36	/LOG THIS GUY OUT BEFORE
	IDX	LNCNT
				/LEAVING BOSS15 MODE
	JMP	EXIT1		/GO RUN RTF
/
LOGOUT	003002
	0
	.ASCII	/LOGOUT/<15>
/
/
EXBOS1	.INIT	-15,1,0		/DELETE OPEN RTF
	DZM*	L134		/CLEAR OUT ALL BOSS REG'S AND BITS
	DZM*	L152
	DZM*	L175
	LAC (37762
	AND SCOM42
	DAC*	L142
	LAC	SCR		/LOG OUT OF SYSTEM
	DAC*	L141
	JMP	NRMEXT		/EXIT TO NRM
/
/
	.TITLE GENERAL UTILITY ROUTINES
/
/.SIXBT ROUTINES
/
/
/.SIXBT UNPACK ROUTINE
/
GT.ONE 0
	DAC	GT.PER		/BUFFER POINTER
LM1	LAW	-1		/CHARACTER COUNTER
	DAC	GT.3
	LAC	GT.ONE		/FAKE 'JMS GT.OTR' TO
	DAC	GT.OTR		/GET FIRST CHAR
	JMP	GT.OTR+1
GT.OTR 0
	ISZ	GT.3
	JMP	GT.SXB		/WORD STARTED
	LAC*	GT.PER		/NEED NEXT WORD
	ISZ	GT.PER
	DAC	GT.WR1		/SAVE CURRENT WORD
LM3	LAW	-3		/RESET CHARACTER COUNTER
	DAC	GT.3
GT.SXB	LAC	GT.WR1
	LMQ
	ALS	6
	DAC	GT.WR1
	LLS	6
	AND	L77		/MASK CHAR.
	JMP*	GT.OTR		/EXIT
GT.PER 0
GT.3	0
GT.WR1	0
/
	.EJECT
/
/.SIXBT PACK ROUTINE
/
PK.ONE	0
	DAC	PK.PER		/BUFFER POINTER
	LAW	-1		/CHARACTER COUNTER
	DAC	PK.3
	JMP*	PK.ONE		/EXIT
PK.OTR	0
	AND	L77
	ISZ	PK.3
	JMP	PK.SX1		/WORD STARTED
	ALS!SHAL	14		/JUSTIFIED
	DAC*	PK.PER		/PACK FIRST CHARACTER LEFT
	LAW	-3		/RESET CHAR COUNTER
	JMP	PK.XIT		/EXIT
PK.SX1	ISZ	PK.3
	JMP	PK.SX2
	XOR*	PK.PER		/PACK THIRD CHAR
	DAC*	PK.PER
	LAW	-1
	ISZ	PK.PER		/UPDATE POINTER TO NEW WORD
	JMP	PK.XIT		/EXIT
PK.SX2	ALS!SHAL	6	/PACK SECOND CHARACTER
	XOR*	PK.PER
	DAC*	PK.PER
LM2	LAW	-2		/RESET CHAR COUNTER
PK.XIT	DAC	PK.3		/EXIT
	JMP*	PK.OTR
PK.3	0
PK.PER	0
/
	.EJECT
/
/5/7 ASCII ROUTINES
/
/SUBROUTINE GT.FST,GT.CHR
/
/GT.FST-INITIALIZE 5/7 .ASCII UNPACKING. ON ENTRY
/AC CONTAINS ADDRESS OF LINE BUFFER TO BE
/UNPACKED.  ON RETURN AC CONTAINS A MINUS ONE (-1)
/GT.CHR-AFTER 5/7 .ASCII UNPACKING HAS BEEN
/INITIALIZED BY GT.FST, GT.CHR WILL RETURN
/SUBSEQUENT CHARACTERS IN AC.
/
GT.FST	0
	TAD	L2		/BUFFER POINTER
	DAC	GT.PTR
	LAW	-1		/CHARACTER COUNTER
	DAC	GT.5
	DZM	GT.CUR		/RESET CHAR VARIABLES
	DZM	GT.LST
	JMP*	GT.FST
/
GT.CHR	0
	ISZ	GT.5
	JMP	GT.MOR		/WORD PAIR STARTED
	LAC*	GT.PTR		/NEED NEXT PAIR
	ISZ	GT.PTR
	DAC	GT.WD1		/FIRST PART
	LAC*	GT.PTR
	ISZ	GT.PTR
	DAC	GT.WD2		/SECOND PART
	LAW	17773		/RESET CHARACTER COUNTER.
	DAC	GT.5
GT.MOR	LAW	17770		/SHIFT LOOP TO 7 1/2 TIMES
	DAC	GT.WD3
GT.LUP	LAC	GT.WD2
	RAL
	ISZ	GT.WD3
	JMP	GT.SHF
	AND	L177		/GOT CHARACTER
	SAD	SPACE		/IF SPACE DONT UPDATE GT.LST
	JMP	GT.EXT		/ON GT.CUR
	PAX			/SAVE TEMP.
	LAC	GT.CUR		/UPDATE GT.LST
	DAC	GT.LST
	PXA			/GET NEW CUURENT CHAR
	DAC	GT.CUR		/UPDATE GT.CUR
GT.EXT	JMP*	GT.CHR		/EXIT
GT.SHF	DAC	GT.WD2
	LAC	GT.WD1
	RAL
	DAC	GT.WD1
	JMP	GT.LUP		/BACK TO LOOP
/
GT.PTR	0
GT.5	0
GT.WD1	0
GT.CUR	0			/CURRENT CHAR.
GT.LST	0			/LAST NON SPACE CHAR
GT.WD2	0
GT.WD3	0
/
	.EJECT
/
/IOPS 5/7 ASCII PACKING ROUTINE
/
/INITIALIZE:
/	KL57 TO ZERO
/	KLPUTP TO BUFFER ADDRESS+2
/
PK.FST	0
	TAD	L2
	DAC	KLPUTP
	DZM	KL57
	DZM	CHRCNT
	LAW	-121		/PACK 80(10) CHAR MAX
	DAC	MAXCHR
	JMP*	PK.FST
PK.CHR	0
	ISZ	CHRCNT
	AND	L177
	DAC	KLCHR2
	ISZ	MAXCHR		/IS THIS THE 86(10)'TH CHAR.
	SKP
	JMP	LINERR		/GIVE ERROR MESSAGE
	CLL
	LAC	KL57		/CHAR POSITION.
	TAD	(JMP* KLJ57
	DAC	.+2
	LAC	KLCHR2
	XX			/MODIFIED JMP
KLJ57	KL571			/CHAR1
	KL572			/CHAR2
	KL573			/CHAR3
	KL574			/CHAR4
	KL575			/CHAR5
KL571	ALS!SHAL	13		/11 LEFT
KL571A	DZM*	KLPUTP		/CLEAR DATA WORD
	JMP	KLND57
KL572	ALS!SHAL	4		/4 LEFT
	JMP	KLND57
KL573	RTR			/3 RIGHT-1ST HALF
	RAR
	AND	L17
	XOR*	KLPUTP
	DAC*	KLPUTP
	ISZ	KLPUTP		/LAST WORD OF PAIR.
	LAC	KLCHR2		/2ND HALF
	ALS!SHAL	17	/15 LEFT
	JMP	KL571A
KL574	ALS!SHAL	10		/8 LEFT
	JMP	KLND57
KL575	RCL			/1 LEFT
	DZM	KL57		/RESET 5/7 COUNTER
	SKP
KLND57	ISZ	KL57
	XOR*	KLPUTP
	DAC*	KLPUTP
	LAC	KL57
	SNA
	ISZ	KLPUTP		/2ND WORD COMPLETE
	LAC	KLCHR2
	JMP*	PK.CHR		/EXIT.
KL57	0
KLPUTP	0
KLCHR2	0
CHRCNT	0
MAXCHR	-121
/
LINERR	JMS	WRITE		/LINE IS TOO LONG
	BADLIN
	.CLOSE	-14
	LAC	L1001		/SET BITS IN A/C STATUS REG
	XOR	AC.STA
	AND	L1001
	XOR	AC.STA
	DAC	AC.STA
	JMP	NXTCRD		/READ NEXT CARD
/
BADLIN	004002
	0
	.ASCII	/LINE TOO LONG/<15>
/
	.EJECT
/
/MISCELLANEOUS ROUTINES
/
/
/ ROUTINE TO CONVERT NEXT TWO CHARACTERS IN INPUT STRING
/ TO A BINARY VALUE LEFT IN BINVAL
/
FBVALU	0
	JMS	GT.CHR		/GET FIRST CHARACTER
	TAD	LM60		/ADJUST TO AN OCTAL VALUE
	MUL			/MULTIPLY IT BY 10 DEC AND STORE
	12			/IT IN BINVAL
	LACQ
	DAC	BINVAL
	JMS	GT.CHR		/NOW GET NEXT CHARACTER
	TAD	LM60		/ADJUST IT TO AN OCTAL VALUE
	TAD	BINVAL		/ADD IT TO BINVAL
	DAC	BINVAL		/AND STORE SUM BACK IN BINVAL
	JMP*	FBVALU		/ALL DONE, EXIT.
/
/ OUTPUT ROUTINE 'WRITE'
/
/ OUTPUTS TO LINE PRINTER ANY SPECIFIED ASCII LINE
/ CALLING SEQUENCE:
/	JMS	WRITE
/	BUFFER ADDRESS (BANK BIT INITIALIZED BY ROUTINE WRITE)
/	(RETURN)
/ BUFFER ADDRESS = ADDRESS OF ASCII LINE TO BE OUTPUT
/
WRITE	0
	LAC*	WRITE		/GET ASCII LINE ADDRESS
	AND	L17777		/BANK BIT INITIALIZE IT
	XOR	BANK
	DAC	.+3		/FORM .WRITE CAL
	.WRITE	6,2,XX,56
	.WAIT	6
	ISZ	WRITE		/ADJUST RETURN ADDRESS
	JMP*	WRITE		/EXIT
/
/ SUBROUTINE TOASCI
/
/ TOASCI CONVERTS A SIXBIT CHARACTER IN THE AC TO A
/ ASCII (7-BIT) CHARACTER, AND LEAVES THE CONVERTED
/ CHARACTER IN THE AC.	NULLS ARE MAPPED TO SPACES,
/ 01-37 ARE MAPPED TO 101-137 RESPECTIVELY, AND THE
/ OTHERS ARE LEFT UNCHANGED
/
TOASCI	0
	AND	L77
	SNA
	JMP	NULSPC
	XOR	SPACE
NULSPC	TAD	SPACE
	JMP*	TOASCI
	.END