SUBTTL	Larry Samberg/LSS/JHT/JNG	28 MAR 77

;***Copyright 1973,1974,1975,1976,1977  Digital Equipment Corp., Maynard, MA.***


;ASSEMBLY AND LOADING INSTRUCTIONS
;	.COMPILE SPRINT
;	.LOAD QMANGR,SPRINT
;	.SSAVE SPRINT



	SEARCH	QSRMAC		;GET GALAXY SYMBOLS
	SEARCH	MACTEN,UUOSYM	;GET MACROS AND UUO SYMBOLS
IFN FTJSYS,<
	SEARCH	MONSYM
>  ;END IFN FTJSYS
	SEARCH	QPRM		;QUEUE SYSTEM SYMBOLS


	SALL			;SUPPRESS MACRO EXPANSIONS


;VERSION INFORMATION
	SPTVER==102		;MAJOR VERSION NUMBER
	SPTMIN==0		;MINOR VERSION NUMBER
	SPTEDT==2024		;EDIT LEVEL
	SPTWHO==0		;WHO LAST PATCHED

	%SPT==<BYTE (3)SPTWHO(9)SPTVER(6)SPTMIN(18)SPTEDT>


;STORE VERSION NUMBER IN JOBVER
	LOC	137
.JBVER::EXP	%SPT

	TWOSEG			;TWO SEGMENT PROGRAM
	RELOC	400000		;START IN HISEG
	..SEG==1		;FLAG FOR UP-DOWN MACROS
;THIS PAGE INSTALLED AS PART OF EDIT 1050 (START OF VERSION 2A)
;SO THAT MINOR VERSIONS APPEAR CORRECTLY IN THE TITLE & LOG FILES.

;DEFINE A MACRO TO CALL THE .NAME MACRO WITH THE RIGHT ARGS
;DEFINE THE .NAME MACRO TO BE WHAT YOU WANT, THEN CALL THIS MACRO.
;IT'S USED TO GENERATE SPRINT'S VERSION CORRECTLY

	DEFINE	.CLNAM<
	  DEFINE  .CLNM(LETTER,WHO)<
	    IRPC LETTER,<
	      IFE "A"-"'LETTER'"+SPTMIN-1,<
		STOPI
		IFIDN <LETTER><@>,<
		  IFE SPTWHO,< .NAME(\SPTVER,,\SPTEDT,)>
		  IFN SPTWHO,< .NAME(\SPTVER,,\SPTEDT,-WHO)>>
		IFDIF <LETTER><@>,<
		  IFE SPTWHO,< .NAME(\SPTVER,LETTER,\SPTEDT,)>
		  IFN SPTWHO,< .NAME(\SPTVER,LETTER,\SPTEDT,-WHO)>>>>>
	IFGE SPTMIN-^D26,< SPTMIN==0
	  PRINTX %MINOR VERSION TOO LARGE - IGNORED>
	IFGE SPTWHO-7,< SPTMIN== 
	  PRINTX %SPTWHO IS TOO LARGE - IGNORED>
	.CLNM(@ABCDEFGHIJKLMNOPQRSTUVWXYZ,\SPTWHO)
>

;NOW DEFINE A .NAME MACRO TO MAKE A TITLE

	DEFINE	.NAME(V,M,E,W)<
TITLE	SPRINT	DECsystem-10 SPooling PRocessor for INpuT - Version V'M'('E')'W
>

;NOW USE IT

	.CLNAM
;               TABLE OF CONTENTS FOR SPRINT
;
;
;                        SECTION                               PAGE
;    1. Revision History......................................   4
;    2. Symbol Naming Conventions.............................   5
;    3. Accumulator and Coding Conventions....................   6
;    4. Conditional Assembly Switches.........................   7
;    5. Conditional Assembly Parameters.......................   8
;    6. Symbol Definitions....................................   9
;    7. The Message Macro.....................................  14
;    8. Card Code Conversion Table Generation.................  17
;    9. Code Conversion Control Symbols.......................  23
;   10. TENEX JSYS OPDEFS.....................................  24
;   11. TOPS-10 - TENEX Compatibility Macros..................  25
;   12. Device Control Cells..................................  27
;   13. FILE-BLOCK Definitions................................  29
;   14. Prototype QUEUE Header................................  30
;   15. ACCT.SYS and AUXACC.SYS Table Definitions.............  31
;   16. Commonly Used Byte Pointers...........................  32
;   17. Lowsegment Storage Cells..............................  33
;   18. Entry and Initialization..............................  39
;   19. Operator Commands
;        19.1   Setup and Dispatch............................  45
;        19.2   HELP - PAUSE - GO.............................  47
;        19.3   EXIT..........................................  48
;        19.4   STOP - RESET - KILL...........................  49
;        19.5   TELL..........................................  50
;        19.6   WHAT..........................................  51
;        19.7   MCORE.........................................  53
;        19.8   MSGLVL........................................  54
;        19.9   START.........................................  55
;        19.10  Subroutines...................................  57
;   20. TTY INPUT ROUTINES....................................  58
;   21. LOOKUP/ENTER UUO Error Messages.......................  60
;   22. LUUO Handler..........................................  61
;   23. LOG File Handler......................................  67
;   24. Control File I/O......................................  70
;   25. Job Setup and Idle Loop...............................  71
;   26. Main Program Loop.....................................  73
;   27. Routine to OPEN the Input Device......................  76
;   28. Control Cards
;        28.1   Setup and Dispatch............................  78
;        28.2   $language.....................................  83
;        28.3   $DECK.........................................  86
;        28.4   $RELOC........................................  87
;        28.5   $INCLUDE......................................  88
;        28.6   $DATA.........................................  89
;        28.7   $EXECUTE......................................  90
;        28.8   $ERROR - $NOERROR - $DUMP - $EOJ..............  92
;        28.9   $MESSAGE......................................  93
;        28.10  $EOD..........................................  94
;        28.11  $MODE.........................................  95
;        28.12  $TOPS10.......................................  96
;        28.13  $SEQUENCE.....................................  97
;        28.14  $JOB..........................................  98
;   29. $JOB Card Subroutines................................. 101
;   30. $JOB Card Switch Subroutines.......................... 108
;   31. Fast-FORTRAN Stream Handler........................... 114
;   32. Routines To Finish Off a Job.......................... 121
;   33. Non-$JOB Card Switch Subroutines...................... 127
;   34. Control Card Common Subroutines....................... 129
;   35. FILE-BLOCK Manipulation Routines...................... 146
;   36. Scanners.............................................. 151
;   37. DUMMY ROUTINES TO READ ONE CHARACTER FROM CARD........ 164
;   38. Deck Stacking Routines................................ 165
;   39. Device Input Routines................................. 168
;   40. Error and Utility Routines for Device Input........... 174
;   41. User File Output Routines............................. 177
;   42. Input Device Monitor Interface........................ 178
;   43. Accounting File Handlers.............................. 180
;   44. Routines to SET and GET Search-List................... 198
;   45. Queue Manipulation Routines........................... 200
;   46. Core and Segment Handling Routines.................... 205
;   47. JOBINT Traps and Device Error Handler................. 208
;   48. Useful Routines....................................... 210
;   49. Operator Messages..................................... 214
;   50. DEVICE ERROR MESSAGES................................. 215
;   51. Miscellaneous Messages................................ 216
;   52. User Error Messages................................... 217
;MAINTENENCE EDITS - - VERSION 2A.
;;1050	(35) MAKE THIS VERSION 2A AND ADD A NEW VERSION MACRO.
;;	     UPDATE IN-CORE INDEX IF AUXACC.SYS CHANGES
;;	     ADD A MESSAGE TO INDICATE DOING SO [10-13175] (JNG).
;1051	(36) CLEAR INCREMENTAL DISK COUNTS BEFORE STORING REAL COUNTS.
;
;1052	(37) RELEASE UFD AND CTL CHANNELS WHEN THROUGH WITH THEM.
;	    SPR 14969
;
;1053	ZERO PROTECTION WORD(FILPRV) BEFORE CALLING FILENT IN $LANG
;	PROCESSING. ELSE, LEFT OVER PROTECTIONS FROM OTHER FILE CARDS
;	WILL BE IMPROPERLY REUSED.
;	     SPR 15269
;
;1054	EXTRANEOUS $CARDS IN HOPPER WITH OR WITHOUT LEGITIMATE JOB (S)
;	IN FRONT OF THEM CAUSE UNDESIRED 'SPTHPE' MESSAGE.  WHEN THE
;	EXTRA $CARD IS FOUND, SPRINT GOES TO NTAJOB TO CREATE 'SPRINT.ERROR'
;	AND THEN TO FLUSH TO CLEAR THE REST OF THE CARDS(IF ANY) UNTIL
;	THE NEXT JOB STARTER IS FOUND.  WHEN THE CDR IS EMPTY, TRAP TO
;	'INTLOC' WHICH WILL ISSUE 'SPTHPE' IF 'F.BUSY' IS ON.  'F.BUSY'
;	SHOULD BE CLEARED WHEN 'FLUSH' ENTERED, SINCE AN EMPTY READER
;	SATISFIES THE CONDITION 'FLUSH' REQUIRES.
;	SPR 15190
;
;1055	MSGLVL 'N1N' DOES NOT TYPE THE 'SPTIJC' (ILLEGAL JOB CARD)
;	MESSAGE. IT SHOULD.
;	SPR 15190
;
;1056	MAKE SPRINT RECOGNIZE ACCT.SYS VERSION 4
;
;1057	CLOSE LOCAL READER IF EOF (FROM EOF BUTTON) RECOGNIZED.
;	SETSTS DOESN'T CLEAR EOF CONDITION AND SPRINT LOOPS CONTINUALLY
;	THINKING IT IS GETTING EOF CONDITION.
;	SPR 15854
;
;1060	LACK OF ARGUMENT TO /IMAGE CAUSES NEXT SWITCH TO BE IGNORED
;	SPR 15913
;	 AREA: W$IMAG
;
;1061	SUPPORT ALTERNATE PUNCHES FOR 026 "?" AND ":". THEY 
;	CURRENTLY ARE ARBITRARY.
;	AREA: CDRAS2
;	 SPR 16095
;
;1062	NULLS ON ASCII INPUT DEVICES (MAGTAPE AND DISK) GET THROWN AWAY
;	BUT THE CHARACTER COUNT IS NOT UPDATED CAUSING JUNK TO GET INTO
;	FILE
;	SPR 16336
;	AREA: CDRAS9
;
;1063	JNG	24-Jul-75	SPR 16756
;	/SUPPRESS is not defaulted correctly on a $JOB card if
;	the default is /NOSUPPRESS.
;	Area: $JOB10
;
;1064	JNG	24-Jul-75	SPR 16706
;	Fix security problem with file protections.
;
;1065	JNG	27-Jul-75
;	Correct error recovery on CDR device errors.
;	Areas: CDRIN7
;
;1066	JNG	5-Aug-75
;	Do not CLOSE a local CDR on an EOF card, since CDRSRX
;	did not set IOEND and the CLOSE will cause data to be lost.
;	Areas affected: CDRIN
;
;1067	JNG	23-Sep-75	SPR 17442
;	Keep better track of whether or not we have valid accounting
;	indices in core, to recover from errors like ?BAD FORMAT FOR
;	ACCOUNTING FILE.
;
;1070	JNG	23-Oct-75
;	Prevent spurious ?ERROR READING ACCOUNTING FILE messages.
;	This was broken by edit 1067.
;
;1071	JNG	23-Oct-75	SPR 17598
;	Always put a %ERR line into the control file to prevent
;	unrequested dumps.
;2000	MAKE THIS VERSION 101, NOVEMBER, 1975
;;2001	REMOVE FTC AND DSF CONDITIONS
;;2002	ADD /JOBNAME SWITCH ON THE $JOB CARD
;2003	ADD A NEW ACTION CHARACTER TO GENERATE THE CORRECT MONITOR PROMPT
;2004	ADD LOTS OF TOPS20 CODE
;;2005	MAKE /OUTPUT TAKE NEW ARGUMENTS (LOG,NOLOG,ERROR).
;	DON'T SET DEFAULT VALUES, QUASAR WILL DO IT.
;	TAKE UNUSED SWITCHES AND CARDS OUT OF DISPATCH TABLES
;		FOR THE -20.
;	REMOVE /PUNCH SWITCH, INSIST ON /TPUNCH OR /CPUNCH.
;2006	CODE CLEANUP.  MAKE DEFAULT INPUT DEVICE PCDR0 ON -20.
;2007	MORE CODE CLEANUP.  PREPARE FOR 1B LOAD TEST.

;2010	MAKE THIS VERSION 102, JUNE 1976
;2011	FIX END-OF-FILE PROBLEM ON -20 AND REPLACE JSYSES WHICH HAVE
;	BEEN SUPERCEDED IN TOPS20 RELEASE 2.
;2012	ON -20, CONNECT SPRINT TO USERS DIRECTORY.  ON -10, USE
;	IN HIS BEHALF FILOP. TO CREATE FILES.
;2013	CLEAR THE AFTER PARAMETER WHEN QUEUEING UP ANYTHING BUT THE
;	CONTROL FILE.
;2014	ALLOW MULTIPLE $EOJ CARDS (WITHOUT GENERATING ERROR LOGS ETC.).
;	FIXUP USER VERIFICATION CODE ON -20.
;2015	FIX A NUMBER OF MINOR -20 PROBLEMS.
;2016	MORE OF EDIT 2015.
;2017	WITH NETSER, THERE IS NO NEED TO RELEASE THE CDR AFTER EACH EOF.
;2020	ON -10 SET MY PATH TO THE USER'S AND DO ALL LOOKUPS AND ENTERS
;	WITH RIBPPN=0.
;2021	SOME CODE CLEANUP.

;;FIRST FIELD-TEST RELEASE OF GALAXY VERSION 2, JANUARY 1977

;2022	SUPPRESS DOES NOT WORK WITH /WIDTH IF THERE ARE NON-BLANK
;	CHARACTERS PAST THE /WIDTH CHARACTER.
;2023	ON -20, READ DEVICE STATUS ON $EOJ AND EOF TO AVOID HANGING IN
;	I/O WAIT.

;;SECOND FIELD-TEST RELEASE OF GALAXY VERSION 2, MARCH 1977

;2024	REMOVE THE .REQUEST HELPER AND LOAD HELPER EXPLICITLY
;	SINCE THE ACCT.SYS INDEX GETS BUILT ON TOP OF IT OTHERWISE.

;[END REVISION HISTORY]


; (*)  DSBCL1 = DEC STANDARD BATCH CONTROL LANGUAGE - LEVEL 1
SUBTTL	Symbol Naming Conventions


COMMENT \
;^;=

For all system-wide symbols, C.MAC symbol definitions
are used.  Internal symbols are named as follows:

:General form:
:	x.yyyy	Full word storage

:   L.????	Lowsegment storage locations
:   H.????	Hisegment storage locations
:   F.????	Flags in Accumulator F
:   P.????	Byte-pointers
:   Q.????	Queue Parameter Area offsets
:   C.????	Control card images

:General form:
:	x$yyyy	Routine names of group 'x'

:   W$????	Switch handling routine.
:		???? is first four characters of switch name.
:   S$????	Scanner routine

:General form:
:	x%yyyy	18-bit constant

:   A%????	Conditional Assembly Parameters

:   .FB???	File-Block Offsets
:   .CC???	Device Control Cell Offsets
:   .IM???	Character images
:   .ASP??	Default Mode ASCII Characters
:   .ASS??	Non-Default Mode ASCII CHARACTERS
:   .A2???	ACCT.SYS Offsets
:   .AU???	AUXACC.SYS Offsets

:   CN.???	Card-Reader CONI bits
:   FB.???	Fields and bits in File-Blocks

All error messages are labeled xxx%, where xxx is the 3 character
code for the message.  In other words, the error message
"?SPTPWR Password is Required" is found at location
PWR%.

;--
\
SUBTTL	Accumulator and Coding Conventions


COMMENT \

	LEVEL A ROUTINES MAY USE P1-P4 AND T1-T5

	LEVEL B ROUTINES MAY USE T1-T4

	LEVEL C ROUTINES MAY USE T5
\
SUBTTL	Conditional Assembly Switches

;^;++




	ND	FTF10,1		;COMPILER TO CALL ON $FORTRAN AND $F4

;Bit 34 of FTF10 determines which compiler is used for
;the $F40 card, and bit 35 determines which compiler
;is used for the $FORTRAN card.  A 1 bit means use 
;FORTRAN-10, and a 0 bit means use F40.

	IFN FTJSYS,<FTRPPN==0>	;DON'T SAVE PPNS
	IFN FTJSYS,<FTFACT==0>  ;DON'T MAKE FACT ENTRIES


	ND	FTRPPN,-1	;CODE TO REMEMBER ACCOUNTING INFO
	IFE FTRPPN,<NPPNRM==0>	;DON'T GENERATE TABLE SPACE
	ND	NPPNRM,^D15	;ELSE REMEMBER THIS MANY
;If FTRPPN is non-zero, SPRINT wil remember the NPPNRM most recently
;used PPNs, thereby not needing to read ACCT.SYS on a match.  The
;cost in space is 6*NPPNRM words of table space in the lowseg, and
;approximately 50 words of code in the hisegment.


	ND	FTFACT,-1	;CODE TO DO ACCOUNTING
;If FTFACT is non-zero, SPRINT will generate FACT file entries
;-type 231

;--
SUBTTL	Conditional Assembly Parameters

;^;++

;;I/O PARAMETERS
	ND	A%LCBN,10		;NUMBER OF BUFFERS FOR LOCAL CDR
	ND	A%ODBN,2		;NUMBER OF BUFFERS FOR OTHER DEVS


;;BATCH JOB DEFAULTS
	ND	A%UNIQ,1		;DEFAULT UNIQUENESS


;;DEFAULTS FOR THE /ERROR SWITCH
	ND	A%HLER,^D100		;DEF NUMBER OF HOLLERITH ERRORS
	ND	A%ICER,5		;DEF NUMBER OF ILL BINARY CARDS
	ND	A%CSER,5		;DEF NUMBER OF CHECKSUM ERRORS


;;INTERNAL PARAMETERS
	ND	A%PDSZ,100		;PUSHDOWN STACK LENGTH
	ND	A%OMSG,100		;DEFAULT MSGLVL
	ND	A%NFLR,^D10		;NUMBER OF FILE-BLOCKS/CLUSTER
	ND	A%DFMD,0		;DEFAULT INPUT MODE
						; 0=ASCII
						; 1=026
						; 2=BCD
	ND	A%SPRS,0		;DEFAULT /SUPP-/NOSUPP
						; 0=/NOSUPPRESS
						; 1=/SUPPRESS

IFN FTUUOS,<
	XP	MONPRT,"."
	XP	DEFDSK,'DSK'
	XP	DEFIND,'CDR   '
>

IFN FTJSYS,<
	XP	MONPRT,"@"
	XP	DEFDSK,'PS '
	XP	DEFIND,'PCDR0 '
	XP	ER.ICC,0		;DONT ENABLE FOR ^C ON -20
>

;--
SUBTTL	Symbol Definitions

;ACCUMULATOR ASSIGNMENTS
	F=0			;FLAG REGISTER
	T1=1			;T1-T5 ARE UTITLITY ACS
	T2=2
	T3=3
	T4=4
	T5=5
	P1=6			;P1-P4 ARE PRESERVED ACS
	P2=7
	P3=10
	P4=11
	C=12			;INPUT/OUTPUT CHARACTER
	B=13			;UTILITY BYTE POINTER
	Q=14			;INDEX TO QUEUE PARAMETER AREA
	U1=15			;RESERVED FOR UUO HANDLER
	U2=16			;RESERVED FOR UUO HANDLER
	P=17			;PUSHDOWN POINTER


;I/O DEVICE CHANNELS
;  (SAVE 0 AND 17 FOR QMANGR)
;WARNING: DO NOT CHANGE CHANNEL DEFINITIONS FOR LOG AND CTL
;SINCE LUUO'S USE THESE DEFINITIONS FOR DESTINATION FIELD.

	CDR==1			;INPUT DEVICE
	LOG==2			;LOG FILE OUTPUT
	FIL==3			;USER FILE OUTPUT
	CTL==4			;CONTROL FILE OUTPUT
	UFD==5			;FOR LOOKING UP AND CREATING UFDS
	ACT==6			;FOR ACCOUNTING FILE (ACCT.SYS)
	AUX==7			;FOR AUXACC.SYS
	ACT1==10		;USED TO CHECK ACCT.SYS DATE
;LUUO DEFINITIONS
;  OP-CODE DEFINITIONS
	OPDEF	TELL	[001000,,0]	;WRITE ASCIZ STRING
	OPDEF	TELL6	[002000,,0]	;WRITE SIXBIT WORD
	OPDEF	CHR	[003000,,0]	;WRITE IMMEDIATE CHARACTER
	OPDEF	STAMP	[004000,,0]	;TIME STAMP LOG
	OPDEF	RAD10	[005000,,0]	;PRINT DECIMAL NUMBER
	OPDEF	RAD08	[006000,,0]	;PRINT OCTAL NUMBER

;DESTINATION OF UUO IS DETERMINED BY AC FIELD AS FOLLOWS:
	OPR==1		;TELL OPERATOR
	;LOG==2		;USER'S LOG FILE
	;CTL==4		;CONTROL FILE

	NAC==10		;SUPPRESS ACTION CHARACTERS ON TELL UUO

	BOTH==LOG+CTL
	ALL==LOG+CTL+OPR

;DESTINATION FIELD BITS RIGHT JUSTIFIED
	UU.OPR==1B35	;OPERATOR
	UU.LOG==1B34	;LOG FILE
	UU.CTL==1B33	;CONTROL FILE
	UU.NAC==1B32	;DON'T SUPPRESS 6BIT BLANKS
;FLAGS (IN ACCUMULATOR F)

	F.LCDR==1B0		;INPUT DEVICE IS - LOCAL CDR
	F.RCDR==1B1		;		 - REMOTE CDR
	F.DSK==1B2		;		 - DISK
	F.MTA==1B3		;		 - MAGTAPE
	F.IN==1B4		;INPUT UUO IS IN PROGRESS FOR CDR
	F.EOF==1B5		;EOF ENCOUNTERED ON INPUT
	F.NXT==1B6		;NEXT CARD ALREADY READ
	F.SPS==1B7		;SUPPRESS IS ON
	F.QOPR==1B8		;DON'T TYPE TO OPR IF MSGLVL=0XX
	F.HTOP==1B9		;I'VE GOT MY HISEG
	F.BUSY==1B10		;I'M BUSY NOW
	F.RES==1B11		;NOT START'ED
	F.STOP==1B12		;HE TYPED STOP
	F.IBRK==1B13		;BREAK SEEN ON TTY INPUT
	F.SHMG==1B14		;OPR WANTS SHORT MESSAGES
	F.FFOR==1B15		;FAST FORTRAN JOB RUNNING
	F.DER==1B16		;DEVICE ERROR FLAG
	F.DECK==1B17		;USER FILE BEING WRITTEN
	F.DEXT==1B18		;DEFERED EXIT
	F.DRES==1B19		;DEFERED RESET
	F.PAUS==1B20		;HE TYPED A PAUSE COMMAND
	F.PAS2==1B21		;THIS IS PASS2 ON THE JOB CARD
	F.IMG==1B22		;CURRENT DECK IS IMAGE
	F.BIN==1B23		;CURRENT DECK IS BINARY
	F.GTIN==1B24		;INPUT DEVICE IS OPEN
	F.QLOG==1B25		;DON'T TYPE ANYTHING TO LOG
	F.QCTL==1B26		;DON'T TYPE ANYTHING TO CTL
	F.KILL==1B27		;HE TYPED KILL
	F.BTCH==1B28		;SUBMIT JOB TO BATCH
	F.MAP==1B29		;/MAP WAS SPECIFIED
	F.FATE==1B30		;A FATAL ERROR WAS ENCOUNTERED
	F.JBI==1B31		;GOT A JOB-INT FOR THIS CARD ALREADY
	F.NEOF==1B32		;NO EOF SEEN FOR LAST JOB
	F.INHI==1B33		;INHIBIT INPUT FOR THIS CARD
	F.RSCN==1B34		;CHARACTER INPUT INHIBIT
	F.DOLR==1B35		;HE SAID /DOLLAR FOR THIS DECK

	F.IDEV==F.LCDR!F.RCDR!F.DSK!F.MTA	;MASK FOR INPUT DEV
	F.ICDR==F.LCDR!F.RCDR			;MASK FOR CDR
	F.DCOM==F.DEXT!F.DRES!F.PAUS		;DEFERED COMMAND


;CARD READER CONI BITS
	CN.PKF==1B20		;PICK FAILURE
	CN.RCK==1B21		;READ CHECK
	CN.CME==1B22		;CARD MOTION ERROR
	CN.STP==1B23		;STOP
	CN.HPE==1B25		;HOPPER EMPTY/STACKER FULL
	CN.TRB==1B27		;TROUBLE
	CN.DTM==1B28		;DATA MISSED
;USEFUL SYMBOLS
	IWPC==^D27		;IMAGE WORDS/CARD
	BWPC==^D26		;BINARY WORDS/CARD
	ACPC==^D80		;ASCII CHARS/CARD
	CPC==^D80		;COLUMNS/CARD

;IMPORTANT ASCII CHARACTER IMAGES
	.IMDOL==2102		;DOLLAR SIGN
	.IMEOF==7417		;END-OF-FILE
	.IM79==5		;7-9 PUNCH


;USEFUL ASCII CHARACTERS
	.ASSPC==40		;SPACE

;SOME RANDOM SYMBOLS
	.IOSIM==.IOIMG+IO.SIM
	.QSIZE==Q.LMOD+1	;SIZE OF INPUT QUEUE BLOCK
	SLLEN==^D36*3		;LENGTH OF A SEARCH LIST BLOCK
	PTLEN==12		;PATH EXTENSION TO S/L BLOCK
;MACRO DEFINITIONS


;MACRO TO RELOC TO HISEG
	DEFINE UP<
IFE ..SEG<XLIST
	LIT
	VAR
	RELOC
	..SEG==1
	LIST
	SALL
>>

;MACRO TO RELOC TO LOWSEG
	DEFINE DOWN<
IFE ..SEG-1<XLIST
	LIT
	RELOC
	..SEG==0
	LIST
	SALL
>>


;TURN OFF A BIT IN F
	DEFINE OFF(BIT)<
	TXZ	F,BIT
>

;TURN ON A BIT IN F
	DEFINE ON(BIT)<
	TXO	F,BIT
>
SUBTTL	The Message Macro

;CALL IS:
;	MSG(CODE,TYPE,CRLF,BODY)
;
;WHERE
;	CODE		Is the three letter error code
;	TYPE		is one of:
;		E	Error (?)
;		W	Warning (%)
;		M	Message ([)
;
;	CRLF		is either (Y) to append a <CR> or (N)
;	BODY		is the message itself
;

;FIRST A MACRO TO GENERATE AN ASCIZ STRING WITH A CRLF TACKED ON
	DEFINE ASCIC(STRING),<
	XLIST
	ASCIZ \STRING
\
	LIST
	SALL>

;DEFINE MACRO TO GENERATE ASCIZ STRING WITHOUT CRLF
	DEFINE ASCIN(STRING),<
	XLIST
	ASCIZ	\STRING\
	LIST
	SALL
>

;THE MSG MACRO LIVES ON THE NEXT PAGE BECAUSE OF IT'S SIZE
;NOW THE MSG MACRO

DEFINE	MSG(CODE,TYPE,CRLF,BODY),<
	XLIST
	IFDIF <TYPE> <E>,<
	IFDIF <TYPE> <W>,<
	IFDIF <TYPE> <M>,<
	PRINTX	?ILLEGAL .TYPE. ARGUMENT TO MSG MACRO - CODE
	PASS2
	END>>>
	IFDIF <CRLF> <Y>,<
	IFDIF <CRLF> <N>,<
	PRINTX	?ILLEGAL .CRLF. ARGUMENT TO MSG MACRO - CODE
	PASS2
	END>>
	IF1 <
	IFDEF CODE'% ,<
	PRINTX	?MULTIPLY DEFINED ERROR MNEMONIC - CODE
	PASS2
	END>>
CODE'%:	BLOCK	0		;;DEFINE THE STARTING LOCATION

	IFIDN <TYPE> <E>,<
	IFIDN <CRLF> <Y>,<
	ASCIC(?SPT'CODE' 'BODY)
	XLIST
>
	IFIDN <CRLF> <N>,<
	ASCIZ \?SPT'CODE' 'BODY\
>>
	IFIDN <TYPE> <W>,<
	IFIDN <CRLF> <Y>,<
	ASCIC(%SPT'CODE' 'BODY)
	XLIST
>
	IFIDN <CRLF> <N>,<
	ASCIZ \%SPT'CODE' 'BODY\
>>
	IFIDN <TYPE> <M>,<
	IFIDN <CRLF> <Y>,<
	ASCIC([SPT'CODE' 'BODY)
	XLIST
>
	IFIDN <CRLF> <N>,<
	ASCIZ \[SPT'CODE' 'BODY\
>>
	LIST
	SALL
>
;THE LMSG CALLS THE MESSAGE MACRO, AND THEN GENERATES A
;	TWO LINE ROUTINE TO PRINT THE ERROR IN THE LOG.

DEFINE LMSG(CODE,TYPE,CRLF,BODY),<
	XLIST
	MSG(CODE,TYPE,CRLF,BODY)
	XLIST
E$'CODE: MOVEI T1,CODE'%
	PJRST	LOGERR
	LIST
	SALL
>

;NOW DEFINE THE MACROS TO GENERATE EITHER MSG OR LMSG DEPENDING
;	ON THE OPERATING SYSTEM.

DEFINE UMSG(CODE,TYPE,CRLF,BODY),<
IFN FTUUOS,<
		MSG(CODE,TYPE,CRLF,BODY)
	>>

DEFINE ULMSG(CODE,TYPE,CRLF,BODY),<
IFN FTUUOS,<
		LMSG(CODE,TYPE,CRLF,BODY)
	>>

DEFINE JMSG(CODE,TYPE,CRLF,BODY),<
IFN FTJSYS,<
		MSG(CODE,TYPE,CRLF,BODY)
	>>

DEFINE JLMSG(CODE,TYPE,CRLF,BODY),<
IFN FTJSYS,<
		LMSG(CODE,TYPE,CRLF,BODY)
	>>
SUBTTL	Card Code Conversion Table Generation

;CALL IS:
;	CODE(.COD,.P026,.PASC,.K)
;
;WHERE
;	.COD		iS the ASCII character or it's
;			octal equivalent.
;	.P026		is the 026 punch code
;	.PASC		is the ASCII punch code
;	.K		is non-blank if .COD is the
;			octal equivalent of the character.


;ROW PUNCH DEFINITIONS
	..9==	200	;A 9 PUNCH
	..12==	100	;A 12 PUNCH
	..11==	40	;A 11 PUNCH
	..0==	20	;A 0 PUNCH
	..8==	10	;A 8 PUNCH
	..1==	1	;A 1 PUNCH
	..2==	2	;A 2 PUNCH
	..3==	3	;A 3 PUNCH
	..4==	4	;A 4 PUNCH
	..5==	5	;A 5 PUNCH
	..6==	6	;A 6 PUNCH
	..7==	7	;A 7 PUNCH


;THE MACRO FOLLOWS
DEFINE CODE(.COD,.P026,.PASC,.K),<
	XLIST
	IF1 <
		.T026==0
		.TASC==0
		IRP .P026,<
			.T026==.T026+..'.P026
		>
		IRP .PASC,<
			.TASC==.TASC+..'.PASC
		>

		IFB <.K>,<
			.OCOD==<".COD">B17
			SETSPI(\.T026,.OCOD)
			.OCOD==".COD"
			SETSPI(\.TASC,.OCOD)
		>

		IFNB <.K>,<
			.OCOD==<.COD>B17
			SETSPI(\.T026,.OCOD)
			SETSPI(\.TASC,.COD)
		>
	>
	LIST
	SALL
>

;MACRO TO GENERATE SPIXXX SYMBOL AND DEFINE IT

DEFINE SETSPI(.A,.B),<
	IFNDEF SPI'.A,<SPI'.A==0>

	IFN <<SPI'.A>&777777>,<
		IFN <.B&777777>,<
			PRINTX  ?MULT. DEF. CARD CODE - .A
			PASS2
			END
	>>

	IFN <<SPI'.A>&<777777>B17>,<
		IFN <.B&<777777>B17>,<
			PRINTX  ?MULT. DEF. CARD CODE - .A
			PASS2
			END
	>>

	SPI'.A==SPI'.A+.B
>
;NOW, GENERATE THE SPIXXX SYMBOLS FOR THE CARD CODES

;DIGITS
	CODE(0,<0>,<0>)
	CODE(1,<1>,<1>)
	CODE(2,<2>,<2>)
	CODE(3,<3>,<3>)
	CODE(4,<4>,<4>)
	CODE(5,<5>,<5>)
	CODE(6,<6>,<6>)
	CODE(7,<7>,<7>)
	CODE(8,<8>,<8>)
	CODE(9,<9>,<9>)

;UPPER-CASE ALPHABETICS
	CODE(A,<12,1>,<12,1>)
	CODE(B,<12,2>,<12,2>)
	CODE(C,<12,3>,<12,3>)
	CODE(D,<12,4>,<12,4>)
	CODE(E,<12,5>,<12,5>)
	CODE(F,<12,6>,<12,6>)
	CODE(G,<12,7>,<12,7>)
	CODE(H,<12,8>,<12,8>)
	CODE(I,<12,9>,<12,9>)
	CODE(J,<11,1>,<11,1>)
	CODE(K,<11,2>,<11,2>)
	CODE(L,<11,3>,<11,3>)
	CODE(M,<11,4>,<11,4>)
	CODE(N,<11,5>,<11,5>)
	CODE(O,<11,6>,<11,6>)
	CODE(P,<11,7>,<11,7>)
	CODE(Q,<11,8>,<11,8>)
	CODE(R,<11,9>,<11,9>)
	CODE(S,<0,2>,<0,2>)
	CODE(T,<0,3>,<0,3>)
	CODE(U,<0,4>,<0,4>)
	CODE(V,<0,5>,<0,5>)
	CODE(W,<0,6>,<0,6>)
	CODE(X,<0,7>,<0,7>)
	CODE(Y,<0,8>,<0,8>)
	CODE(Z,<0,9>,<0,9>)
;LOWER CASE ALPHABETICS
	CODE(141,<12,0,1>,<12,0,1>,O)
	CODE(142,<12,0,2>,<12,0,2>,O)
	CODE(143,<12,0,3>,<12,0,3>,O)
	CODE(144,<12,0,4>,<12,0,4>,O)
	CODE(145,<12,0,5>,<12,0,5>,O)
	CODE(146,<12,0,6>,<12,0,6>,O)
	CODE(147,<12,0,7>,<12,0,7>,O)
	CODE(150,<12,0,8>,<12,0,8>,O)
	CODE(151,<12,0,9>,<12,0,9>,O)
	CODE(152,<12,11,1>,<12,11,1>,O)
	CODE(153,<12,11,2>,<12,11,2>,O)
	CODE(154,<12,11,3>,<12,11,3>,O)
	CODE(155,<12,11,4>,<12,11,4>,O)
	CODE(156,<12,11,5>,<12,11,5>,O)
	CODE(157,<12,11,6>,<12,11,6>,O)
	CODE(160,<12,11,7>,<12,11,7>,O)
	CODE(161,<12,11,8>,<12,11,8>,O)
	CODE(162,<12,11,9>,<12,11,9>,O)
	CODE(163,<11,0,2>,<11,0,2>,O)
	CODE(164,<11,0,3>,<11,0,3>,O)
	CODE(165,<11,0,4>,<11,0,4>,O)
	CODE(166,<11,0,5>,<11,0,5>,O)
	CODE(167,<11,0,6>,<11,0,6>,O)
	CODE(170,<11,0,7>,<11,0,7>,O)
	CODE(171,<11,0,8>,<11,0,8>,O)
	CODE(172,<11,0,9>,<11,0,9>,O)

;CONTROL CHARACTERS
	CODE(1,<12,9,1>,<12,9,1>,O)
	CODE(2,<12,9,2>,<12,9,2>,O)
	CODE(3,<12,9,3>,<12,9,3>,O)
	CODE(4,<9,7>,<9,7>,O)
	CODE(5,<0,9,8,5>,<0,9,8,5>,O)
	CODE(6,<0,9,8,6>,<0,9,8,6>,O)
	CODE(7,<0,9,8,7>,<0,9,8,7>,O)
	CODE(10,<11,9,6>,<11,9,6>,O)
	CODE(11,<12,9,5>,<12,9,5>,O)
	CODE(12,<0,9,5>,<0,9,5>,O)
	CODE(13,<12,9,8,3>,<12,9,8,3>,O)
	CODE(14,<12,9,8,4>,<12,9,8,4>,O)
	CODE(15,<12,9,8,5>,<12,9,8,5>,O)
	CODE(16,<12,9,8,6>,<12,9,8,6>,O)
	CODE(17,<12,9,8,7>,<12,9,8,7>,O)
	CODE(20,<12,11,9,8,1>,<12,11,9,8,1>,O)
	CODE(21,<11,9,1>,<11,9,1>,O)
	CODE(22,<11,9,2>,<11,9,2>,O)
	CODE(23,<11,9,3>,<11,9,3>,O)
	CODE(24,<9,8,4>,<9,8,4>,O)
	CODE(25,<9,8,5>,<9,8,5>,O)
	CODE(26,<9,2>,<9,2>,O)
	CODE(27,<0,9,6>,<0,9,6>,O)
	CODE(30,<11,9,8>,<11,9,8>,O)
	CODE(31,<11,9,8,1>,<11,9,8,1>,O)
	CODE(32,<9,8,7>,<9,8,7>,O)
;MORE CONTROL CHARACTERS AND OTHER SPECIAL CHARACTERS
	CODE(33,<0,9,7>,<0,9,7>,O)
	CODE(34,<11,9,8,4>,<11,9,8,4>,O)
	CODE(35,<11,9,8,5>,<11,9,8,5>,O)
	CODE(36,<11,9,8,6>,<11,9,8,6>,O)
	CODE(37,<11,9,8,7>,<11,9,8,7>,O)

	CODE(<!>,<12,8,7>,<12,8,7>)
	CODE(42,<0,8,5>,<8,7>,O)
	CODE(<#>,<0,8,6>,<8,3>)
	CODE(<$>,<11,8,3>,<11,8,3>)
	CODE(<%>,<0,8,7>,<0,8,4>)
	CODE(<&>,<11,8,7>,<12>)
	CODE(<'>,<8,6>,<8,5>)
	CODE(<(>,<0,8,4>,<12,8,5>)
	CODE(<)>,<12,8,4>,<11,8,5>)
	CODE(<*>,<11,8,4>,<11,8,4>)
	CODE(<+>,<12>,<12,8,6>)
	CODE(<,>,<0,8,3>,<0,8,3>)
	CODE(<->,<11>,<11>)
	CODE(<.>,<12,8,3>,<12,8,3>)
	CODE(</>,<0,1>,<0,1>)

	CODE(<:>,<11,8,2>,<8,2>)
	CODE(<;>,<0,8,2>,<11,8,6>)
	CODE(74,<12,8,6>,<12,8,4>,O)
	CODE(<=>,<8,3>,<8,6>)
	CODE(76,<11,8,6>,<0,8,6>,O)
	CODE(<?>,<12,8,2>,<0,8,7>)
	CODE(<@>,<8,4>,<8,4>)

	CODE(133,<11,8,5>,<12,8,2>,O)
	CODE(<\>,<8,7>,<0,8,2>)
	CODE(135,<12,8,5>,<11,8,2>,O)
	CODE(<^>,<8,5>,<11,8,7>)
	CODE(137,<8,2>,<0,8,5>,O)
	CODE(140,<8,1>,<8,1>,O)

	CODE(173,<12,0>,<12,0>,O)
	CODE(174,<12,11>,<12,11>,O)
	CODE(175,<11,0>,<11,0>,O)
	CODE(176,<11,0,1>,<11,0,1>,O)
	CODE(177,<12,9,7>,<12,9,7>,O)
;NOW GENERATE THE CODE CONVERSION TABLE

	DOWN

DEFINE CTGEN(K),<
	IF1 <
		IFNDEF SPI'K,<SPI'K==<"\",,"\">>

		IFE <SPI'K & 777777>,<
			SPI'K==SPI'K+"\">
		IFE <SPI'K & <777777>B17>,<
			SPI'K==SPI'K+<"\"B17>>
	>

	.XCREF
	EXP	SPI'K
	.CREF
>

;THE TABLE GENERATION IS XLISTED BECAUSE OF SIZE, FOR THOSE OF YOU
;READING THE ASSEMBLY LISTING, THE FOLLOWING IS XLISTED:
;
;REPEAT 400,<
;	CTGEN(\K)
;	K==K+1>

	K==0
CODTBL:
	XLIST
REPEAT 400,<
	CTGEN(\K)
	K==K+1>
	LIST
SUBTTL	Code Conversion Control Symbols


CODTYP:	SIXBIT	/ASCII/
	SIXBIT	/026/
	SIXBIT	/BCD/

	.NMCTY==.-CODTYP

	H%ASC==0
	H%026==1
	H%BCD==2

;DEFINITIONS OF BYTE-POINTER SYMBOLS
	..PASC==<POINT 7,CODTBL(C),35>
	..P026==<POINT 7,CODTBL(C),17>
	..PBCD==<POINT 7,CODTBL(C),17>

;NOW THE BYTE POINTERS (BASED ON AC C)
P.COD:
P.ASC:	EXP	..PASC
P.026:	EXP	..P026
P.BCD:	EXP	..PBCD

;NOW GENERATE THE DEFAULT BYTE POINTER
IFE A%DFMD-H%ASC,<P.DFBP==P.ASC>
IFE A%DFMD-H%026,<P.DFBP==P.026>
IFE A%DFMD-H%BCD,<P.DFBP==P.BCD>


;NOW GENERATE THE NON-DEFAULT BYTE POINTER
IFE A%DFMD-H%ASC,<P.NDBP==P.026>
IFE A%DFMD-H%026,<P.NDBP==P.ASC>
IFE A%DFMD-H%BCD,<P.NDBP==P.ASC>
SUBTTL	TOPS-10 - TENEX Compatibility Macros

;MACRO TO READ A CHARACTER FROM THE TELETYPE

	DEFINE	TTYI(CH),<
	XLIST
IFE FTJSYS,<
	INCHWL	CH
>
IFN FTJSYS,<
IFE CH-T1,<
	PBIN
>
IFN CH-T1,<
	SKIPA
	JRST	.+4
	EXCH	CH,T1
	PBIN
	EXCH	CH,T1
>>
	LIST
	SALL
>


;MACRO TO TYPE A CHARACTER ON THE TELETYPE

	DEFINE	TTYO(CH),<
	XLIST
IFE FTJSYS,<
	OUTCHR	CH
>
IFN FTJSYS,<
IFE CH-T1,<
	PBOUT
>
IFN CH-T1,<
	SKIPA
	JRST	.+4
	EXCH	CH,T1
	PBOUT
	EXCH	CH,T1
>>
	LIST
	SALL
>
	DOWN

;STAMP MESSAGES
STDAT:	SIXBIT / STDAT/
STMSG:	SIXBIT / STMSG/
STERR:	SIXBIT / STERR/
STCRD:	SIXBIT / STCRD/
STSUM:	SIXBIT / STSUM/
STOPR:	SIXBIT / STOPR/


;IMPORTANT CONTROL CARD IMAGES


C.JOB:
C.END:	ASCII	/$JOB/
C.SEQ:	ASCII	/$SEQ/
	.NMJCR==.-C.JOB
C.EOJ:	ASCII	/$EOJ/
C.EOD:	ASCII	/$EOD/
	.NMDEN==.-C.END
C.MODE:	ASCII	/$MOD/
SUBTTL	Device Control Cells


;	!=======================================================!
;	!                      DEVICE NAME                      !
;	!-------------------------------------------------------!
;	!                       FILENAME                        !
;	!-------------------------------------------------------!
;	!                       EXTENSION                       !
;	!-------------------------------------------------------!
;	!                  PPN OR PATH POINTER                  !
;	!-------------------------------------------------------!
;	!                                                       !
;	/                      PATH BLOCK                       /
;	/                                                       /
;	/                       (8 WORDS)                       /
;	!                                                       !
;	!-------------------------------------------------------!
;	!                  BUFFER RING HEADER                   !
;	!-------------------------------------------------------!
;	!                  BUFFER BYTE POINTER                  !
;	!-------------------------------------------------------!
;	!                   BUFFER BYTE COUNT                   !
;	!=======================================================!

;Control Cell Indices
	.CCDEV==0	;DEVICE
	.CCNAM==1	;FILE NAME
	.CCEXT==2	;EXTENSION
	.CCPPN==3	;PPN OR XWD 0,ADR OF PATH
	.CCPTH==4	;PATH BLOCK
	.CCEND==13	;END OF FILESPEC BLOCK
	.CCBHD==14	;BUFFER RING HEADER
	.CCBBP==15	;BUFFER BYTE POINTER
	.CCBBC==16	;BUFFER BYTE COUNT

	DEFINE DEVBUF(..DEV),<
..DEV'BRH:	BLOCK	0
..DEV'BH:	BLOCK	1
..DEV'BP:	BLOCK	1
..DEV'BC:	BLOCK	1
>

	DEFINE DEVCEL(.DEV),<
DEV'.DEV:	BLOCK	0
.DEV'DEV:	BLOCK	1
.DEV'NAM:	BLOCK	1
.DEV'EXT:	BLOCK	1
.DEV'PPN:	BLOCK	1
.DEV'PTH:	BLOCK	10
	DEVBUF(.DEV)
>
;NOW GENERATE THE DEVICE CONTROL CELLS

DEVBEG:	BLOCK	0		;BEGINNING OF DEVICE CONTROL CELLS

	DEVCEL(CDR)		;FOR THE INPUT DEVICE

CDROPN:	BLOCK	3		;INPUT DEVICE OPEN BLOCK
CDRBUF:	BLOCK	1		;ADDRESS OF INPUT DEVICE BUFFERS
CDRBFN:	BLOCK	1		;NUMBER OF INPUT DEVICE BUFFERS
CDRJFF:	BLOCK	1		;JOBFF AFTER ALLOCATING BUFFERS
CDRCNT:	BLOCK	1		;NUMBER OF CARDS READ - THIS JOB
DEKCRD:	BLOCK	1		;NUMBER OF CARDS READ - THIS DECK

	DEVBUF(LOG)		;BUFFER RING HEADER FOR LOG FILE

LOGAD:	BLOCK	1		;XWD BUFN,BUFFER ADR
LOGIOW:	BLOCK	2		;LOG FILE IOWD

	DEVBUF(CTL)		;CTL FILE BUFFER RING HEADER

	DEVCEL(FIL)		;FOR THE USER'S CURRENT FILE

	FILSTS==FILPTH		;LH=-1 IF NQC FILE, RH=#SFD IN PATH
				;FIRST WORD OF PATH BLOCK
FILPRV:	BLOCK	1		;PRIVILEGE AND PROTECTION WORD
FILOFF:	BLOCK	1		;JOBFF BEFORE BUILDING BUFFERS
FILNFF:	BLOCK	1		;JOBFF AFTER BUILDING BUFFERS
DEKBLK:	BLOCK	1		;NUMBER OF BLOCKS WRITTEN - THIS DECK

	DEVEND==.-1		;END OF CONTROL CELLS
SUBTTL	FILE-BLOCK Definitions



;	!=======================================================!
;	!                  FILE-STRUCTURE NAME                  !
;	!-------------------------------------------------------!
;	!                       FILENAME                        !
;	!-------------------------------------------------------!
;	!         EXTENSION         !LR!LD!DL!DR!SR! LOAD ORDER !
;	!-------------------------------------------------------!
;	!       PROJECT-PROGRAMMER NUMBER OR PATH POINTER       !
;	!=======================================================!


;		SYMBOL DEFINITIONS

	.FBDEV==0		;FILE STRUCTURE NAME
	.FBNAM==1		;FILENAME
	.FBEXT==2		;FILE-EXTENSION,,STATUS BITS

		FB.LDR==1B18	;LOAD FILENAME.REL ON $DATA($EX)
		FB.LOD==1B19	;LOAD FILENAME.EXT ON $DATA($EX)
		FB.DEL==1B20	;DEL THIS FILE ON .DEL LINE
		FB.DLR==1B21	;DEL THIS FILE AND REL ON .DEL LINE
		FB.SRH==1B22	;LOAD IN LIBRARY SEARCH MODE
		FB.ORD==777B35	;LOAD ORDER

	.FBPPN==3		;PPN OR PATH POINTER


	FBSIZE==4		;NUMBER OF WORDS/BLOCK
SUBTTL	ACCT.SYS and AUXACC.SYS Table Definitions


;ACCT.SYS VERSION 2
	.A2PPN==0	;PROJECT-PROGRAMMER NUMBER
	.A2PSW==1	;PASSWORD
	.A2PRV==2	;PRIVILEGE WORD
	.A2NAM==3	;USER NAME (2 WORDS)
	.A2TIM==5	;TIMES MAY LOG IN
	.A2DEV==6	;DEVICE MAY LOG IN ON
	.A3VMP==6	;VIRTUAL MEMORY PARAMETERS
	  A3.PPL==777B8	;PHYSICAL PAGE LIMIT
	  A3.VPL==777B17;VIRTUAL PAGE LIMIT
	  A3.IRQ==777B26;IPCF RECEIVE QUOTA
	  A3.IXQ==777B35;IPCF XMIT QUOTA
	.A2PRF==7	;PROFILE WORD
	  A2.LOC==1B26	;MAY LOGIN LOCAL
	  A2.ROP==1B27	;MAY LOGIN REMOTE OPR
	  A2.DST==1B28	;MAY LOGIN DATASET
	  A2.RTY==1B29	;MAY LOGIN REMOTE TTY
	  A2.SBT==1B30	;MAY LOGIN AS SUBJOB OF BATCH JOB
	  A2.BTC==1B31	;MAY LOGIN AS BATCH JOB
	  A2.TNM==1B32	;NAME REQUIRED UNDER T/S
	  A2.BNM==1B33	;NAME REQUIRED UNDER BATCH
	  A2.TPS==1B34	;PASSWORD NEEDED FOR T/S
	  A2.BPS==1B35	;PASSWORD NEEDED FOR BATCH
	.A2CNO==14	;CHARGE NUMBER
	.A2DAT==15	;EXPIRATION DATE


;AUXACC.SYS ENTRIES

	.AUBEG==0	;FIRST WORD, ALWAYS CONTAINS -1
	.AUNUM==1	;NUMBER OF WORDS FOLLOWING
			;THIS 1+ IS 5* THE NUMBER OF STRS
	.AUPPN==2	;PROJECT-PROGRAMMER NUMBER
	.AUSTR==3	;STRUCTURE NAME
	.AURSV==4	;RESERVED QUOTA
	.AUFCF==5	;FCFS QUOTA
	.AULGO==6	;LOGOUT QUOTA
	.AUSTS==7	;STATUS BITS
	  AU.RON==1B0	;READ-ONLY
	  AU.NOC==1B1	;NO-CREATE
SUBTTL	Commonly Used Byte Pointers

	DOWN


P.ASBP:	POINT	7,L.CARD
P.IMBP:	POINT	12,L.CARD
P.LPRT:	POINT	9,T3,8
P.PROT:	POINT	9,L.UUBK+.RBPRV,8
P.UAC:	POINT	4,.JBUUO,12
P.UOP:	POINT	9,.JBUUO,8
P.CL1A:	POINT	7,L.CARD,6
P.CL2A:	POINT	7,L.CARD,13
SUBTTL	Lowsegment Storage Cells

;SAVEGET BLOCK
;THESE LOCATIONS ARE STORED AT INITIALIZATION TIME AND ARE
;USED AS GETSEG BLOCK WHEN GETSEG'ING THE HISEGMENT.

L.SGDV:	BLOCK	1		;DEVICE FROM GET-RUN
L.SGNM:	BLOCK	1		;FILE NAME FROM GET-RUN
L.SGLW:	BLOCK	2		;LOW EXT FROM GET-RUN
L.SGPP:	BLOCK	2		;PPN FROM GET-RUN

;IOWD FOR ACCOUNTING FILE READS
L.ACIO:	IOWD	200,L.BUF
	0

LOWBEG:
;THE FOLLOWING LOCATIONS ARE NOT ZEROED OR RESET WITH EACH NEW JOB

L.CARD:	BLOCK	IWPC		;CURRENT CARD

L.ADAT:	BLOCK	1		;CREATION DATE-TIME OF LAST ACCT.SYS LOOKED AT
L.ASIZ:	BLOCK	1		;SIZE OF ACCT.SYS IN BLOCKS
L.XDAT:	BLOCK	1		;[1050] CREATION DATE-TIME OF AUXACC.SYS
L.BUF:	BLOCK	200		;UTILITY DISK BUFFER
L.CBLK:	BLOCK	1		;KEEPS TRACK OF WHATS IN L.BUF
L.CHOL:	BLOCK	1		;CURRENT CARD CODE BP
L.CMD:	BLOCK	1		;CURRENT OPR COMMAND
L.CNST:	BLOCK	1		;STATION # OF CENTRAL SITE
L.CRBC:	BLOCK	1		;SAVED BYTE COUNT ON INPUT
L.CRBP:	BLOCK	1		;SAVE BYTE POINTER ON INPUT
L.CRLC:	BLOCK	1		;CODE USED FOR LAST CARD READ
L.DHOL:	BLOCK	1		;DEFAULT CARD CODE BP
L.FFA:	BLOCK	1		;[OPR] PPN
L.FUN:	BLOCK	1		;RANDOM (?) NUMBER FOR FUNNY NAMES
L.HTOP:	BLOCK	1		;FLAG FOR CHKOPR TO RELEASE HISEG
L.INTB:	BLOCK	4		;JOBINT BLOCK
L.IPC:	BLOCK	1		;INTERRUPTED PC STORED HERE
L.JFSC:	BLOCK	1		;JIFSEC IS HERE (60 OR 50)
L.LOC:	BLOCK	1		;WHERE TO LOCATE JOB
L.MCOR:	BLOCK	1		;MAX ALLOWABLE CORE
L.MFPP:	BLOCK	1		;MFD PPN
L.MSGL:	BLOCK	1		;MSGLVL FLAGS FOR OPR
L.MYPP:	BLOCK	1		;PPN SPRINT IS RUNNING UNDER
L.MYST:	BLOCK	1		;NUMBER OF STATION RUNNING SPRINT
L.PDL:	BLOCK	A%PDSZ		;PUSHDOWN LIST
L.PPR:	BLOCK	1		;PRESERVED PROTECTION CODE
L.PRIV:	BLOCK	1		;-1 MEANS I'M [1,2] OR [100+S,2]
L.SAC:	BLOCK	20		;AC SAVE AREA DURING GETSEG
L.SCIN:	BLOCK	1		;ADR OF INPUT ROUTINE FOR SCANNERS
L.SCLN:	BLOCK	1		;ADR OF NEXT RECORD RTN FOR SCANNERS
L.SPBP:	BLOCK	1		;SUPPRESS BYTE POINTER
L.SVPT:	BLOCK	1		;STORE USER WRITE-PROTECT BIT
L.SYSN:	BLOCK	15		;SYSNAM
L.UNIS:	BLOCK	1		;DEFAULT UNIQUENESS
IFN FTJSYS,<
L.MYNM:	BLOCK	10		;MY USER STRING
L.SL1:	BLOCK	12		;MY ORIGINAL CONNECTED DIR
L.SL2:	BLOCK	12		;USER'S CONNECTED DIR
L.JFN:	BLOCK	1		;JFN OF INPUT DEVICE
L.OFF:	BLOCK	1		;-1 IF DEVICE IS OFF LINE
L.ARGS:	BLOCK	2		;ARG BLOCK FOR THE MTOPR
>  ;END IFN FTJSYS

IFN FTUUOS,<
L.SL1:	BLOCK	SLLEN		;SAVE MY S/L ON INITIALIZATION
	BLOCK	PTLEN		;PATH BLOCK EXTENSION
L.SL2:	BLOCK	SLLEN		;CURRENT S/L (USER'S)
	BLOCK	PTLEN		;PATH BLOCK EXTENSION
>  ;END IFN FTUUOS


IFN FTRPPN,<
L.PPTB:	BLOCK	NPPNRM		;PPN TABLE
L.PSTB:	BLOCK	NPPNRM		;PASSWORDS
L.AUTB:	BLOCK	NPPNRM		;XWD WORD #,BLOCK # FOR AUXACC
L.PRTB:	BLOCK	NPPNRM		;PROFILE WORD
L.UNTB:	BLOCK	NPPNRM		;FIRST HALF OF USER NAME
L.U2TB:	BLOCK	NPPNRM		;SECOND HALF OF USER NAME

L.RPRG:	BLOCK	1		;REPLACEMENT REGISTER FOR TABLE
L.MTCH:	BLOCK	1		;SET NON-ZERO IF CURRENT JOB HAS A MATCH
>
;THE FOLLOWING LOCATIONS ARE ZEROED AT THE BEGINNING OF EACH JOB

LOWZER:
L.ACC:	BLOCK	3		;CHKACC UUO BLOCK
L.BRK:	BLOCK	1		;LAST CHR FROM CARD WAS A BREAK
L.CCNT:	BLOCK	1		;COLUMN COUNTER (DOWN)
L.CCHK:	BLOCK	1		;CHECKSUM FROM BINARY CARD
L.CNAM:	BLOCK	1		;NAME OF CURRENT CONTROL CARD
L.DEKN:	BLOCK	1		;CURRENT DECK NUMBER
L.DPCR:	BLOCK	1		;$DUMP,,/CREF FLAG
L.FBCT:	BLOCK	1		;LOAD NUMBER FOR FILE BLOCKS
L.FBFN:	BLOCK	1		;FBFND KEEPS A COUNTER HERE
L.FILN:	BLOCK	1		;FILE BLOCKS USE COUNT
L.FILR:	BLOCK	FBSIZE*A%NFLR	;PREALLOCATED FILE BLOCKS
L.FLOP:	BLOCK	.FOPPN+1	;FILOP BLOCK
L.FNNM:	BLOCK	1		;SECOND PART OF SPOOLED CDR NAME
L.IMGT:	BLOCK	1		;IMAGE MODE TERMINATOR
L.IWRD:	BLOCK	1		;NO. OF WORDS READ ON IMG OR BIN CARD
L.LANG:	BLOCK	1		;LANGUAGE CARD INDEX
L.LOAD:	BLOCK	1		;SET TO -1 ON $DATA OR $EXEC CARD
L.NHOL:	BLOCK	1		;NUMBER OF HOLLERITH ERRORS
L.NTRY:	BLOCK	1		;NUMBER OF TIMES I TRIED TO GET CDR
L.QFN:	BLOCK	1		;USER SPECIFIED ARG TO /QUEUE:
L.SRH:	BLOCK	1		;FLAG FOR /SEARCH SWITCH
L.SWCH:	BLOCK	1		;NAME OF CURRENT SWITCH
L.TCHK:	BLOCK	1		;TOTAL NUMBER OF CHKSUM ERRORS
L.THOL:	BLOCK	1		;TOTAL NUMBER OF HOLLER ERRORS
L.TIBC:	BLOCK	1		;TOTAL NUMBER OF ILLEGAL BIN CARDS
L.UFIN:	BLOCK	3		;UFD INTERLOCK BLOCK
L.WIDT:	BLOCK	1		;CARD WIDTH PARAMETER

IFN FTJSYS,<
L.UNAM:	BLOCK	10		;USER NAME
L.USNO:	BLOCK	1		;USER NUMBER
L.UDIN:	BLOCK	15		;GTDIR INFORMATION
L.UPSW:	BLOCK	10		;USER SPECIFIED PASSWORD
L.DPSW:	BLOCK	10		;ACTUAL PASSWORD FROM DIRECTORY
L.LONG:	BLOCK	40		;HOLD LONG FILE NAME FOR SPOOLED FILES
L.COMP:	BLOCK	12		;BLOCK FOR COMPAT UUO
>  ;END IFN FTJSYS

;THESE LOCATIONS ARE FILLED BY THE DATE-TIME SCANNERS
L.HRS:	BLOCK	1		;HOURS
L.MIN:	BLOCK	1		;MINUTES
L.SEC:	BLOCK	1		;SECONDS
L.DAY:	BLOCK	1		;DAY
L.MON:	BLOCK	1		;MONTH
L.YRS:	BLOCK	1		;YEAR

	LOWZND==.-1
;THE FOLLOWING LOCATIONS ARE PRESET TO CONTAIN A DEFAULT VALUE
;AT THE BEGINNING OF EACH JOB.

;EACH LOCATION HAS A CORRESPONDING HISEGMENT LOCATION WHICH CONTAINS
;THE DEFAULT VALUE, AND THE HISEG BLOCK IS BLT'ED INTO THE LOWSEG
;BLOCK BEFORE EACH NEW JOB.


	DEFINE LOCS,<
	PR	LSW,'/LIST'
	PR	UCHK,A%CSER
	PR	UHOL,A%HLER
	PR	UIBC,A%ICER
>

	DEFINE PR(A,B),<
	UP
	XALL
H.'A:	EXP	B		;;SET HISEG LOCATION
	DOWN
	XALL
L.'A:	EXP	0		;;ALLOCATED LOWSEG LOCATION
	SALL
>

	UP
PREHGH:
	DOWN
PRELOW:
	LOCS

	UP
	PREHND==.-1
	DOWN
	PRELND==.-1

L.QUE:	BLOCK	.QSIZE		;PRIMARY QUEUE PARAMETER AREA
				;THIS IS SETUP SEPARATELY BY THE
				;SETQUE ROUTINE.
;Extended UUO Block


L.UUBK:
RIBCNT:	BLOCK	1		;ARGUMENT COUNT
	RP.NSE==400000		;NON-SUPERCEDING ENTER BIT
RIBPPN:	BLOCK	1		;PROJECT-PROGRAMMER NUMBER
RIBNAM:	BLOCK	1		;FILNAME
RIBEXT:	BLOCK	1		;EXTENSION
RIBPRV:	BLOCK	1		;PROTECTION-DATE-TIME
RIBSIZ:	BLOCK	1		;LENGTH OF FILE IN WORDS
RIBVER:	BLOCK	1		;FILE'S VERSION
RIBSPL:	BLOCK	1		;SPOOLED FILENAME
RIBEST:	BLOCK	1		;ESTIMATED LENGTH
RIBALC:	BLOCK	1		;ALLOCATION
RIBPOS:	BLOCK	1		;POSITION TO ALLOCATE
RIBFT1:	BLOCK	1		;DEC NON-PROV FUT ARG
RIBNCA:	BLOCK	1		;NON-PRIV CUSTOMER ARG
RIBMTA:	BLOCK	1		;TAPE LABEL
RIBDEV:	BLOCK	1		;LOGICAL UNIT NAME
RIBSTS:	BLOCK	1		;FILE STATUS BITS
	RP.NQC==2000		;NO QUOTA CHARGE FILE
RIBELB:	BLOCK	1		;ERROR LOGICAL BLOCK
RIBEUN:	BLOCK	1		;ERROR UNIT AND LENGTH
RIBQTF:	BLOCK	1		;FCFS LOGGED-IN QUOTA
RIBQTO:	BLOCK	1		;LOGGED-OUT QUOTA
RIBQTR:	BLOCK	1		;RESERVED QUOTA
RIBUSD:	BLOCK	1		;BLOCK IN USE
RIBAUT:	BLOCK	1		;AUTHOR'S PPN


	LOWEND==.-1
;Fact Entry Block

IFN FTFACT,<

L.FACT:	EXP	.FACT		;DAEMON FACT FUNCTION

L.FHDR:	EXP	<231>B8+.FSIZE	;HEADER TYPE 231 LENGTH=13
L.FPPN:	BLOCK	1		;USER'S PPN
L.FDAT:	BLOCK	1		;DATE-TIME (FILLED IN BY DAEMON)
L.FQUE:	'IN    '		;QUE-STATION-APR SERIAL NUMBER
L.FRTM:	BLOCK	1		;RUNTIME
L.FKCT:	BLOCK	1		;KCT
L.FDRD:	BLOCK	1		;DISK READS
L.FDWT:	BLOCK	1		;DISK WRITES
L.FPDV:	BLOCK	1		;PHYSICAL INPUT DEVICE
L.FSEQ:	BLOCK	1		;SEQUENCE NUMBER
L.FWRK:	BLOCK	1		;WORK DONE BY SPRINT
				;BIT 0=1 BATCH INPUT REQ CREATED
				;     =0 BATCH INPUT REQ NOT CREATED
				;BITS 18-35 = CARDS READ
	.FSIZE==.-L.FHDR	;SIZE OF BLOCK



;BYTE POINTERS
P.FSTA:	POINT	6,L.FQUE,17	;STATION NUMBER
P.FJOB:	POINT	9,L.FHDR,17	;JOB NUMBER
P.FTTY:	POINT	12,L.FHDR,29	;TTY NUMBER
> ;END OF IFN FTFACT
SUBTTL	Entry and Initialization

	UP

SPRINT:	SKIPA			;SKIP CCL ENTRY
SPTCCL:	OUTSTR	CCL%		;NO CCL START

IFN FTUUOS,<
	MOVEM	.SGNAM,L.SGNM	;SAVE MY FIRST NAME
	MOVEM	.SGLOW,L.SGLW	;LAST NAME
	JUMPE	.SGNAM,[OUTSTR NHS%
			EXIT]	;DIDN'T "RUN" ME
>  ;END IFN FTUUOS
SPT1:	RESET			;RESET THE WORLD
	MOVE	T1,[PUSHJ P,UUO0]
	MOVEM	T1,.JB41##	;LUUO DISPATCH ADDRESS
	MOVE	P,[LOWBEG,,LOWBEG+1]
	CLEARM	LOWBEG		;ZAP FIRST STORAGE CELL
	BLT	P,LOWEND	;ZAP THE REST OF THEM
	MOVE	P,[DEVBEG,,DEVBEG+1]
	CLEARM	DEVBEG		;PREPARE TO ZAP DEVICE CELLS
	BLT	P,DEVEND	;ZAP!
	MOVEI	P,1		;PREPARE TO ZAP ACS
	CLEAR	F,
	BLT	P,P		;ZAP THEM ALL

	MOVE	P,[IOWD A%PDSZ,L.PDL]
	ON	F.HTOP		;I'VE GOT MY HISEG
	MOVEI	T1,RESTRT	;LOW-SEG START ADDRESS
	HRRM	T1,.JBSA	;FOR 'START' WITHOUT MY HISEG
	PUSHJ	P,GTTABS	;DO ALL THE GETTABS

IFN FTUUOS,<
	CLEARM	L.PRIV		;ASSUME NO PRIVS
	MOVE	T1,L.MYPP	;GET MY PPN
	CAMN	T1,L.FFA	;AM I OPR?
	JRST	IAMPRV		;I AM PRIV'ED
	MOVS	T2,L.MYST	;MY STATION,,0
	ADD	T2,[100,,2]	;GET OPR FOR MY STATION
	CAME	T1,T2		;AM I HIM?
	JRST	SPT1A		;NO, NO PRIVS
	PJOB	T1,		;YES, GET MY JOB NUMBER
	MOVNS	T1		;GET NEGATIVE JOB NUMBER
	JOBSTS	T1,		;GET MY JOBSTS
	  CLEAR	T1,		;ASSUME NO JACCT
	TXNN	T1,JB.UJC	;DO I HAVE JACCT ON?
	JRST	[TELL OPR,ROM%
		 EXIT]		;NO, DIE!!
IAMPRV:	SETOM	L.PRIV		;I'M PRIVELEGED!!!
>  ;END IFN FTUUOS
SPT1A:	MOVE	T1,[4,,INTLOC]	;SETUP JOBINT BLOCK
	MOVEM	T1,L.INTB
	MOVE	T1,[ER.MSG+ER.ICC+ER.IDV+ER.QEX]
	MOVEM	T1,L.INTB+1	;ENABLE BITS
	CLEARM	L.INTB+2	;CLEAR THE REST
	CLEARM	L.INTB+3
	MOVEI	T1,L.INTB	;GET ADDRESS OF BLOCK
	MOVEM	T1,.JBINT	;AND PUT IT WHERE MONITOR CAN FIND IT
	PJOB	T1,		;GET JOB NUMBER

IFN FTFACT,<
	DPB	T1,P.FJOB	;STORE IN FACT BLOCK
	MOVE	T1,L.JFSC	;GET JIFSEC BIT
	MOVEI	T2,^D60		;ASSUME 60 JIFS/SEC
	TXNE	T1,ST%CYC	;IS 50 CYCLE BIT SET?
	MOVEI	T2,^D50		;YES, USE 50
	MOVEM	T2,L.JFSC	;AND STORE IT
>

	LSH	T1,12		;*1024
	MSTIME	T2,		;SO RESTART DOESN'T RESET US
	TLZ	T2,-1		;ZAP LH
	ADD	T1,T2		;MAKE A FUNNY NUMBER
	MOVEM	T1,L.FUN	;AND STORE IT

IFN FTUUOS,<
	MOVEI	T3,4		;WORDS -1 IN SYSNAM
	MOVSI	T1,.GTCNF	;CNFTBL
SPT2:	MOVS	T2,T1		;TABLE #,,INDEX
	GETTAB	T2,		;GET NAME
	  CLEAR	T2,		;THIS REALLY SHOULDN'T HAPPEN
	MOVEM	T2,L.SYSN(T1)	;STORE IT AWAY
	CAILE	T3,(T1)		;GOT ALL FIVE?
	AOJA	T1,SPT2		;NO, LOOP AROUND
>  ;END IFN FTUUOS
IFN FTJSYS,<
	SETO	T1,		;MY JOB
	HRROI	T2,T4		;STORE 1 WORD IN T4
	MOVEI	T3,.JIUNO	;AND THE WORD IS MY USER NUMBER
	GETJI			;GET IT!!
	  JFCL			;WE'LL LOSE LATER
	HRROI	T1,L.MYNM	;PLACE TO STORE STRING
	MOVE	T2,T4		;DIRECTORY NUMBER
	DIRST			;CONVERT IT TO A STRING
	  HALT	.		;LOSE!!

	MOVX	T1,'SYSVER'	;GET TABLE # AND LENGTH FOR SYSTEM NAME
	SYSGT			;GET IT
	HLRE	T3,T2		;GET -VE LENGTH IN T3
	MOVN	T3,T3		;AND MAKE IT POSITIVE
	HRLZ	T2,T2		;GET TABLE#,,0
SPT2:	MOVS	T1,T2		;GET INDEX,,TABLE
	GETAB			;DO THE GETTAB
	  SETZ	T1,		;STORE A NULL ON FAILURE
	MOVEM	T1,L.SYSN(T2)	;STORE THE WORD
	CAILE	T3,(T2)		;DONE?
	AOJA	T2,SPT2		;NO, LOOP
>  ;END IFN FTJSYS

	SETZM	L.MCOR		;AND SAVE IT
	MOVEI	T2,A%UNIQ	;GET DEFAULT UNIQUENESS
	EXCH	T2,L.UNIS	;STORE IT AND LOAD LIMLVL
	MOVEI	T1,A%UNIQ	;GET DEFAULT UNIQUENESS AGAIN
	CAIE	T1,.QIUSD	;UNIQUE SUB DIRECTORY??
	JRST	SPT3		;NO, SKIP CHECK
	SKIPN	T1		;YES,IS LIMLVL=0?
	SOS	L.UNIS		;YES, MAKE DEFAULT = 1

SPT3:	MOVE	T1,L.PPR	;GET STANDARD PROTECTION
	TLNN	T1,700000	;IS OWNER PROT =0?
	TLO	T1,100000	;YES, MAKE IT ONE
	MOVEM	T1,L.PPR	;AND RE-STORE IT

IFN FTUUOS,<
	SKIPL	L.PRIV		;SKIP IF I'M PRIVILEGED
	JRST	SPT5		;ELSE SKIP ACCT.SYS LOOKUP	
	OPEN	ACT,H.OSTS	;OPEN UP CHANNEL 'ACT'
	  JRST	NOACCT		;GUESS NOT
	OPEN	ACT1,H.OSTS	;AND CHANNEL ACT1
	  JRST	NOACCT		;STRANGE!!
	OPEN	AUX,H.OSTS	;AND CHANNEL AUX
	  JRST	NOACCT		;ITS GETTING STRANGER
>  ;END IFN FTUUOS
SPT5:	MOVEI	T1,L.SL1	;BLOCK TO HOLD S/L
	PUSHJ	P,GETSRC	;GO GET THE SEARCH LIST
	ON	F.RES		;SET RESET STATE
	MOVEI	T1,A%OMSG	;GET DEFAULT MSGLVL
	PUSHJ	P,SETMSG	;AND SET IT
	CHR	OPR,"/"		;GIVEM A START
	PUSHJ	P,OPER		;GET COMMANDS
	JRST	SETUP		;RETURN HERE ON 'START'
;GTTABS  --  Routine to do all GETTABS for initialization.
;	Routine is driven by three tables generated by the TABS
;	macro.  The first table contains the argument to GETTAB, the
;	second contains defaults to use on failure, and the third contains
;	an instruction which is executed to store the results.

GTTABS:	MOVSI	T2,-.NMTAB		;MAKE AOBJN POINTER
GTTAB1:	MOVE	T1,GTAB1(T2)		;GET AN ARGUMENT
	GETTAB	T1,			;DO THE GETTAB
	  MOVE	T1,GTAB2(T2)		;FAIL!! USE DEFAULT
	XCT	GTAB3(T2)		;STORE THE RESULT
	AOBJN	T2,GTTAB1		;AND LOOP
	POPJ	P,			;RETURN WHEN DONE

;THE ARGUMENTS TO THE TABS MACRO ARE:
;	1) ARGUMENT TO GETTAB
;	2) DEFAULT VALUE
;	3) INSTRUCTION TO STORE RESULT
;	     (NOTE: MACRO EXPANSION GENERATES THE CORRECT AC FIELD
;		    THEREFORE IT SHOULD BE BLANK IN THE ARGUMENT)

DEFINE TABS,<
	T	<%LDSTP>,<57B8>,<MOVEM L.PPR>
	T	<%LDFFA>,<1,,2>,<MOVEM L.FFA>
	T	<%LDMFD>,<1,,1>,<MOVEM L.MFPP>
	T	<%LDSFD>,<0>,<MOVEM L.UNIS>
	T	<-1,,.GTLOC>,<0>,<MOVEM L.MYST>
	T	<0,,.GTLOC>,<0>,<MOVEM L.CNST>
	T	<-1,,.GTPPN>,<0>,<MOVEM L.MYPP>
	T	<-2,,.GTDEV>,<'DSK   '>,<MOVEM L.SGDV>
	T	<-2,,.GTPPN>,<0>,<MOVEM L.SGPP>
IFN FTFACT,<
	T	<%CNSER>,<0>,<HRRM L.FQUE>
	T	<%CNSTS>,<0>,<MOVEM L.JFSC>
>  ;END OF IFN FTFACT
>  ;END OF TABS MACRO
DEFINE T(A,B,C),<
	EXP	<A>
>

GTAB1:	TABS
	.NMTAB==.-GTAB1

DEFINE T(A,B,C),<
	EXP	<B>
>

GTAB2:	TABS

DEFINE T(A,B,C),<
	EXP	<C> + <T1>B12
>

GTAB3:	TABS
SUBTTL	Operator Commands  --  Setup and Dispatch

;HERE TO PROCESS OPERATOR INTERACTIVE COMMANDS.
;CALLED WITH A PUSHJ.
;IF SPRINT IS ACTIVE, RETURN IN VIA POPJ, IF NOT
;ROUTINE LOOPS UNTIL START OR CONTINUE IS TYPED.

OPER:	OFF	F.IBRK		;TURN OFF BREAK FLAG
	MOVEI	T1,TTYIN	;GET INPUT ROUTINE
	MOVEM	T1,L.SCIN	;AND STORE IT FOR SCANNERS
	MOVEI	T1,CONTTY	;TTY CONTINUATION ROUTINE
	MOVEM	T1,L.SCLN	;AND STORE IT
	PUSHJ	P,S$SIX		;GET A COMMAND
	  JRST	OPER5		;THERE ISN'T ONE?
	JUMPE	T1,OPER1	;NULL COMMAND, CLEAN UP AND RETURN
	MOVEM	T1,L.CMD	;SAVE THE COMMAND
	MOVEI	T2,COMTAB	;ADDRESS OF COMMAND TABLE
	HRLI	T2,-.NMCOM	;AND TABLE LENGTH
	PUSHJ	P,UNIQ6		;GET A UNIQUE COMMAND
	  JRST	OPER4		;COMMAND NOT UNIQUE
	PUSHJ	P,@DISTAB(T1)	;DISPATCH COMMAND

OPER1:	PUSHJ	P,TTYBRK	;EAT THE REST OF THE LINE
	TXNN	F,F.RES!F.STOP	;ARE WE STOPPED OR RESET?
	JRST	OPER2		;NO, CHECK FOR PAUSE
	CHR	OPR,"/"		;YES, TYPE A SLASH
	JRST	OPER		;AND LOOP FOR A COMMAND

OPER2:	TXNN	F,F.PAUS	;ARE WE PAUSED?
	JRST	OPER3		;NO, TYPE A SMASH
	TXNE	F,F.BUSY	;YES, ARE WE IN A JOB?
	JRST	OPER3		;YES, DON'T PAUSE NOW!
	CHR	OPR,"/"		;NO, PAUSE NOW
	JRST	OPER		;AND GO GET A COMMAND

OPER3:	CHR	OPR,"!"		;TYPE AN EXCLAMATION POINT
	POPJ	P,		;AND RETURN

OPER4:	TELL	OPR,ILC%	;ILLEGAL COMMAND
	SKIPA			;SKIP THE OTHER ERROR
OPER5:	TELL	OPR,CER%	;COMMAND ERROR
	JRST	OPER1		;AND CONTINUE
;COMMANDS AND COMMAND DISPATCH TABLE

	DEFINE NAMES,<
	X	KILL,KILCOM
	X	STOP,STPCOM
	X	PAUSE,PSECOM
	X	WHAT,WHTCOM
	X	GO,GOCOM
	X	TELL,TELCOM
	X	START,STCOM
	X	HELP,HLPCOM
	X	MCORE,MCRCOM
	X	RESET,RSTCOM
	X	MSGLVL,MSGCOM
	X	EXIT,EXTCOM
	X	ST,STCOM
>
	DEFINE	X(A,B),<
	<SIXBIT /A/>>
COMTAB:	NAMES
	.NMCOM==.-COMTAB

	DEFINE	X(A,B),<
	EXP	B>

DISTAB:	NAMES
SUBTTL	Operator Commands  --  HELP - PAUSE - GO

;HLPCOM -- HELP COMMAND
;	CALLS HELPER TO TYPE OUT SPRINT.HLP
HLPCOM:	MOVE	T1,['SPRINT']	;THAT'S ME!!
	PJRST	.HELPR##	;CALL THE HELPER AND RETURN



;PSECOM -- PAUSE COMMAND
;	SETS F.PAUS AND RETURNS
PSECOM:	TXNN	F,F.RES		;DON'T SET PAUSE IF WE ARE RESET
	ON	F.PAUS		;SET F.PAUSE
	POPJ	P,		;AND RETURN




;GOCOM -- GO COMMAND
;	CONTINUE AFTER STOP OR PAUSE

GOCOM:	TXNN	F,F.RES		;ARE WE IN RESET STATE
	JRST	GOCOM1		;NO, CONTINUE
	TELL	OPR,NST%	;YES, TELL HIM WE'RE NOT STARTED
	POPJ	P,		;AND RETURN

GOCOM1:	OFF	F.STOP!F.PAUS	;TURN OFF CAUSE
	TXNN	F,F.BUSY	;BUSY?
	POPJ	P,		;RETURN
	STAMP	STOPR		;GIVE LOG A STAMP
	TELL	LOG,CBO%	;CONTINUED BY OPERATOR
	POPJ	P,		;AND RETURN
SUBTTL	Operator Commands  --  EXIT

;EXTCOM -- EXIT COMMAND
;	IF WE ARE BUSY, DEFER EXIT UNTIL WE ARE DONE
;	ELSE, MONRET -- DO A RESTART OF SPRINT IN CONT IS GIVEN

EXTCOM:	TXNE	F,F.BUSY	;ARE WE BUSY
	JRST	EXTCM1		;YES, DEFER THE COMMAND
	PUSHJ	P,TTYBRK	;CLEAR TTY INPUT
	MOVEI	T1,L.SL1	;MY ORIGINAL S/L
	PUSHJ	P,SETSRC	;RESET IT
	RESET			;RESET ALL I/O
	MONRT.			;AND RETURN TO MONITOR
	JRST	SPT1		;FOR A CONTINUE

EXTCM1:	ON	F.DEXT		;SET DEFERED EXIT
	PJRST	GOIFST		;AND GO IF STOPPED, ELSE RETURN
SUBTTL	Operator Commands  --  STOP - RESET - KILL


;STPCOM -- STOP COMMAND
;	SETS F.STOP AND RETURNS
STPCOM:	TXNE	F,F.RES		;IS RESET SET?
	POPJ	P,		;YES, JUST RETURN
	ON	F.STOP		;SET STOP FLAG
	TXNN	F,F.BUSY	;BUSY?
	POPJ	P,		;NO, RETURN
	STAMP	STOPR		;STAMP THE LOG
	TELL	LOG,SBO%	;STOPPED BY OPERATOR
	POPJ	P,		;AND RETURN


;RSTCOM -- RESET COMMAND
;	IF SPRINT IS BUSY, DEFER UNTIL IDLE, OTHERWISE DO A RESTART
RSTCOM:	TXNE	F,F.BUSY	;ARE WE BUSY?
	JRST	RSTCM1		;YES, TELL HIM
	TELL	OPR,RSTMSG	;TELL HIM WE'RE RESETING
	PUSHJ	P,TTYBRK	;CLEAR THE LINE
	MOVEI	T1,L.SL1	;PRIME SEARCH LIST
	PUSHJ	P,SETSRC	;SET IT
	JRST	SPT1		;AND RESET!!

RSTCM1:	ON	F.DRES		;SET DEFERED RESET
	PJRST	GOIFST		;AND GO IF STOPPED, ELSE RETURN



;KILCOM -- KILL COMMAND
;	IF JOB IS IN PROGRESS, SET F.KILL AND RETURN
;	OTHERWISE GIVE OPR AN ERROR MESSAGE
KILCOM:	TXNE	F,F.BUSY	;ARE WE BUSY?
	JRST	KILCM1		;YES, GO DO IT
	MOVEI	T1,NJA%		;NO, LOAD NJA MESSAGE
	PJRST	TYPONM		;TYPE SPTNJA "ON DEV" AND RETURN

KILCM1:	ON	F.KILL		;ELSE SET KILL
	PJRST	GOIFST		;GO IT STOPPED, ELSE JUST RETURN
SUBTTL	Operator Commands   --  TELL

;TELCOM -- TELL COMMAND
;	STAMPS LOG WITH STOPR STAMP AND TYPES THE OPERATORS MESSAGE
;	INTO THE LOG FILE.  REPLACES THE OPERATORS BREAK CHARACTER
;	BY A CRILIF TO KEEP THE LOG NEAT.

TELCOM:	TXNE	F,F.BUSY	;ARE WE BUSY?
	JRST	TELCM1		;YES, CONTINUE
	MOVEI	T1,NJA%		;NO, LOAD ADDRESS OF MESSAGE
	PJRST	TYPONM		;AND TYPE A MESSAGE AND RETURN

TELCM1:	TXNN	F,F.FFOR	;FAST-FORTRAN JOB?
	JRST	TELCM2		;NO, ALL IS OKAY
	TELL	OPR,ICF%	;FF JOBS HAVE NO LOG FILE
	POPJ	P,		;AND RETURN

TELCM2:	STAMP	STOPR		;STAMP THE LOG

TELCM3:	PUSHJ	P,.SCIN		;GET A CHARACTER
	  JRST	TELCM4		;EOL FINALLY!!
	CHR	LOG,(C)		;TYPE THE CHARACTER INTO THE LOG
	JRST	TELCM3		;AND LOOP

TELCM4:	TELL	LOG,CRLF	;FINISH THE LINE
	POPJ	P,		;AND RETURN
SUBTTL	Operator Commands  --  WHAT

;WHTCOM -- WHAT COMMAND
;	TYPES STATUS OF SPRINT TO OPR IN THE FORM:
;
;	SPRINT JOB RUNNING ON CDR0
;	SEQ:3  USER:LARRYSAMBERG  PPN:77,77  JOB:TEST
;	CARD #334 -- CARD #10 IN DECK #2
;
;GIVES SIMILAR INFORMATION FOR FAST-FORTRAN JOBS

WHTCOM:	SETOM	L.NTRY		;CAUSE CDR BUSY MESSAGE
	TXNE	F,F.BUSY	;AM I DOING ANYTHING?
	JRST	WHTCM1		;YES, TELL HIM
	MOVEI	T1,IDLMSG	;LOAD ADDRESS OF IDLE MESSAGE
	PUSHJ	P,TYPONM	;AND TYPE IT + ON DEV:
	JRST	WHTCM3		;CHECK FOR OPERATOR INTERVENTION

WHTCM1:	MOVEI	T1,CDJMSG	;SPRINT JOB
	TXNE	F,F.FFOR	;FAST FORTRAN JOB?
	MOVEI	T1,FFJMSG	;YUP
	TELL	OPR,(T1)	;TELL OPR
	TXNE	F,F.FFOR	;FAST FORTRAN JOB?
	JRST	WHTCM2		;YES, SKIP QUEUE INFO
	TELL6	OPR,['SEQ:']
	RAD10	OPR,Q.SEQ(Q)	;SEQUENCE NUMBER
	TELL	OPR,[ASCIZ / USER:/]

IFN FTUUOS,<
	TELL6	OPR,Q.USER(Q)		;USERS FIRST NAME
	TELL6	OPR,Q.USER+1(Q)		;USERS SECOND NAME
	TELL	OPR,[ASCIZ /  PPN:/]	;GET SET FOR PPN
	HLRZ	T3,Q.PPN(Q)		;GET PROJECT NUMBER
	RAD08	OPR,T3			;AND TYPE IT
	CHR	OPR,","			;COMMA
	HRRZ	T3,Q.PPN(Q)		;AND PROGRAMMER NUMBER
	RAD08	OPR,T3			;AND TYPE IT
>  ;END IFN FTUUOS

IFN FTJSYS,<
	TELL	OPR,L.UNAM		;GIVE THE NAME
>  ;END IFN FTJSYS

	TELL	OPR,[ASCIZ /  JOB:/]
	TELL6	OPR,Q.JOB(Q)
	TELL	OPR,CRLF	;JOB NAME <>
WHTCM2:	TELL	OPR,WHTMSG	;CARD INFORMATION
	TXNE	F,F.DECK	;ARE WE IN A DECK?
	TELL	OPR,HOL3%	;YES, GIVE DECK INFO
	TELL	OPR,CRLF	;AND A CRLF
WHTCM3:	TXNN	F,F.BUSY	;ARE WE BUSY?
	JRST	WHTCM4		;NO, DON'T CHECK FOR DEVICE PROBLEMS
	TXNN	F,F.DER!F.JBI	;ANY DEVICE PROBLEMS?
	JRST	WHTCM4		;NO
	TELL	OPR,DNR%	;YES, TELL HIM
	JRST	WHTCM6		;TYPE OIR AND RETURN
WHTCM4:	TXNE	F,F.STOP	;STOP ON?
	JRST	WHTCM6		;YES, TELL HIM
	TXNE	F,F.PAUS	;IS PAUSE ON?
	TXNN	F,F.BUSY	;YES, IS BUSY ON TOO?
	POPJ	P,		;PAUSE IS ZERO, RETURN
WHTCM6:	TELL	OPR,OIR%	;TELL HIM TO INTERVENE
	POPJ	P,		;AND RETURN
SUBTTL	Operator Commands  --  MCORE

;MCRCOM -- MCORE COMMAND
;ROUTINE TO SET JOBS' CORE LIMIT.  SET TO DEFAULT AT INITIALIZATION
;	AND CHANGED VIA MCORE XX COMMAND.  XX IS ASSUMED TO
;	BE A DECIMAL NUMBER OF K UNLESS IMMEDIATELY FOLLOWED BY
;	THE LETTER 'P' IN WHICH CASE IT IS DECIMAL PAGES.  AN
;	ARGUMENT OF 0 OR A NULL ARGUMENT RESETS IT TO DEFAULT.

MCRCOM:	PUSHJ	P,S$DEC		;GET DECIMAL ARGUMENT
	  JRST	MCRCM1		;EOL OR JUNK
	JUMPE	T1,MCRCM2	;ZERO IMPLIES DEFAULT
	LSH	T1,^D10		;CONVERT K TO WORDS
	CAIE	C,"K"		;CHECK FOR SUFFIX
	CAIN	C," "		;EITHER K OR SPACE IMPLIES K
	  JRST	MCRCM3		;GOT ONE OF THEM, GO STORE ANSWER
	CAIE	C,"P"		;ONLY OTHER CHOICE IS "P"
	PJRST	JUNK		;LOSE!!
	LSH	T1,-1		;DIVIDE BY 2
	JRST	MCRCM3		;AND STORE ANSWER

MCRCM1:	PJUMPE	T1,JUNK		;EOL RETURNS A -1
MCRCM2:	MOVEI	T1,0		;LOAD THE DEFAULT
MCRCM3:	MOVEM	T1,L.MCOR	;STORE THE ANSWER
	POPJ	P,		;AND RETURN
SUBTTL	Operator Commands  --  MSGLVL

;MSGCOM - MSGLVL COMMAND
;ROUTINE TO SET LEVEL AND VERBOSITY OF OPERATOR MESSAGES.
;	COMMAND IS 'MSGLVL ABC' WHERE:
;
;	A=0	TYPE SHORT MESSAGES TO OPR
;	 =1	TYPE FULL-LENGTH MESSAGES TO OPR
;
;	B=0	SUPPRESS ERROR CARD OUTPUT
;	 =1	TYPE THE FIRST FATAL ERROR CARD OF EACH JOB
;
;	C=0	TYPE NO CARDS TO OPERATOR
;	 =1	TYPE EACH $JOB CARD TO OPERATOR
;	 =2	TYPE EACH $-CARD TO OPERATOR
;	 =3	TYPE EACH CARD TO OPERATOR


MSGCOM:	PUSHJ	P,S$OCT		;GET AN OCTAL NUMBER
	  SKIPA			;ITS EITHER EOL OR JUNK
	JRST	SETMSG		;ITS OK, GO DO IT
	PJUMPE	T1,JUNK		;T1=0 MEANS JUNK!
	MOVEI	T1,A%OMSG	;T1=-1 MEANS EOL, USE DEFAULT


SETMSG:	CAIGE	T1,100		;GREATER THAN OR EQUAL 100
	TXOA	F,F.SHMG	;NO, SHORT MESSAGES
	OFF	F.SHMG		;YES, LONG MESSAGES
	LDB	T2,[POINT 3,T1,32]
	CLEAR	T3,		;GET 'B' (OF ABC) INTO T2, CLEAR T3
	SKIPE	T2		;B=0?
	TLO	T3,1B18		;NO, SET FLAG
	HLLM	T3,L.MSGL	;AND STORE
	ANDI	T1,7		;AND DOWN TO LAST DIGIT
	HRRM	T1,L.MSGL	;AND STORE THAT TOO
	POPJ	P,		;AND RETURN
SUBTTL	Operator Commands  --  START


STCOM:	TXNE	F,F.RES		;ARE WE ALREADY START'ED
	JRST	STCOMA		;NO, KEEP GOING
	TELL	OPR,STD%	;YES, ALREADY STARTED
	POPJ	P,		;AND RETURN

STCOMA:	MOVEI	T1,DEVCDR	;ADDRESS OF DEVICE CONTROL CELLS
	PUSHJ	P,CLRCEL	;CLEAR THEM!!
	PUSHJ	P,S$FILE	;GET A FILESPEC
	  JRST	STCOME		;GO TELL HIM ABOUT ERROR
	MOVE	P1,CDRDEV	;GET DEVICE NAME
	JUMPN	P1,STCOMB	;IS DEVICE=0
	MOVX	P1,DEFIND	;YES, USE DEFAULT INPUT DEVICE
	SKIPE	CDRNAM		;IS FILENAME NULL?
	MOVSI	P1,'DSK'	;NO, USE DISK AS DEFAULT
STCOMB:	DEVNAM	P1,		;FIND REAL NAME
	  JRST	STCOMF		;NO SUCH DEVICE?
	MOVEM	P1,CDRDEV	;SAVE DEVICE NAME
	MOVEM	P1,CDROPN+1	;AND STORE IN OPEN BLOCK

IFN FTFACT,<
	MOVEM	P1,L.FPDV	;STORE DEVICE IN FACT BLOCK
>

	DEVTYP	P1,UU.PHY	;GET TYPE BITS
	  JRST	STCOMF		;STRANGE?
IFN FTUUOS,<
	TXNE	P1,TY.SPL	;DEVICE SPOOLED?
	TELL	OPR,SPL%
>  ;END IFN FTUUOS
	TXNE	P1,TY.IN	;CAN IT DO INPUT?
	JRST	STCOM1		;YUP!!
	TELL	OPR,CDI%
	POPJ	P,		;AND RETURN

STCOM1:	LDB	P2,[POINT 6,P1,35]
	CAIN	P2,.TYCDR	;GET DEVICE CODE INTO P2 AND TEST
	ON	F.ICDR		;IT'S A CDR!!!
	CAIN	P2,.TYDSK	;DISK?
	ON	F.DSK		;YES!!
	CAIN	P2,.TYMTA	;MAGTAPE?
	ON	F.MTA		;YES!!
	TXNN	P1,TY.SPL	;WAS IT SPOOLED?
	JRST	STCOM2		;NO
	OFF	F.ICDR		;YES, TURN OFF CDR
	ON	F.DSK		;AND TURN ON DSK
;START COMMAND CONTINUED

STCOM2:	TXNN	F,F.IDEV	;IS THERE AN INPUT DEVICE?
	ON	F.DSK		;NO, MAKE IT LIKE A DSK
	MOVEI	T1,.IOASL	;JUST IN CASE ITS A DISK
	TXNN	F,F.ICDR	;IS IT A CDR?
	JRST	STCOM5		;NO, HANDLE MAGTAPES AND DSKS

IFN FTUUOS,<
	MOVE	P1,CDRDEV	;YES, GET DEVICE NAME
	WHERE	P1,		;WHERE IS IT
	  CLEAR	P1,		;WHERE FAILS MEANS CENTRAL
	SKIPE	P1		;STATION 0?
	JRST	STCOM3		;NO,DO THE COMPARE
	OFF	F.RCDR		;YES, ITS LOCAL!!
	MOVEI	T1,.IOSIM	;GET SUPER-IMAGE MODE
	JRST	STCOM5		;STORE IO-MODE AND RETURN

STCOM3:	CAME	P1,L.CNST	;SEE IF IT MATCHES CENTRAL STATION
	TXZA	F,F.LCDR	;NO, ITS REMOTE
	TXZ	F,F.RCDR	;YES, ITS LOCAL
	MOVEI	T1,.IOSIM	;GET SUPERIMAGE
	TXNN	F,F.LCDR	;IS IT LOCAL?
	MOVEI	T1,.IOIMG	;NO, LOAD IMAGE
	JRST	STCOM5		;STORE MODE AND RETURN
>  ;END IFN FTUUOS

IFN FTJSYS,<
	TXNE	P1,TY.SPL	;IS IT SPOOLED?
	TELL	OPR,SPL%	;YES, TELL HIM
	OFF	F.LCDR		;MAKEIT LOOK LIKE A REMOTE CDR
	MOVEI	T1,.IOIMG	;LOAD THE MODE
	JRST	STCOM5		;AND CONTINUE
>  ;END IFN FTJSYS
STCOM5:	TXO	T1,UU.PHS	;TURN ON PHYSICAL ONLY BIT
	MOVEM	T1,CDROPN	;STORE MODE IN OPEN BLOCK
	MOVEI	T1,CDROPN	;GET ADDRESS OF OPEN BLOCK
	DEVSIZ	T1,		;GET BUFFER SIZE
	  JRST	STCOMF		;SHOULDN'T HAPPEN
	MOVEI	T2,A%LCBN	;NUMBER OF LOCAL CDR BUFFERS
	TXNN	F,F.LCDR	;IS IT A LOCAL CDR?
	MOVEI	T2,A%ODBN	;NO, LOAD ALTERNATE NUMBER OF BUFFERS
	SKIPN	T2		;IS BUF NUM = 0?
	HLRZ	T2,T1		;YES, USE MONITOR DEFAULT FOR THIS DEVICE
	MOVEM	T2,CDRBFN	;SAVE NUMBER OF BUFFERS
	TLZ	T1,-1		;ZAP LH OF T1
	IMUL	T1,T2		;AMOUNT=BUFFERSIZE*BUFFERNUMBER
	TXNN	F,F.RCDR	;IS IT REMOTE?
	JRST	STCOM6		;NO.
	PUSH	P,T1		;ELSE SAVE T1
	MOVE	T1,.JBFF	;LOAD JOBFF
	IORI	T1,777		;OR UP TO A PAGE
	ADDI	T1,1		;AND BREAK A BOUNDARY
	SUB	T1,.JBFF	;GET THE DIFFERENCE
	PUSHJ	P,EXPND		;AND WASTE THE SPACE
	POP	P,T1		;RESTORE BUFFER SIZE
STCOM6:	PUSHJ	P,EXPND		;GET THE CORE
	MOVEM	T1,CDRBUF	;SAVE ADDRESS OF BUFFERS
	MOVE	T1,.JBFF	;GET CURRENT JOBFF
	MOVEM	T1,CDRJFF	;AND SAVE IT FOR LATER
	OFF	F.RES!F.DCOM!F.STOP

IFN FTUUOS,<
	SKIPGE	L.PRIV		;ARE WE PRIVILEGED?
	PJRST	BILDAC		;YES, BUILD ACCT.SYS INDEX AND RETURN
>  ;END IFN FTUUOS
	POPJ	P,		;NO, JUST RETURN



STCOMF:	MOVEI	T1,NSD%		;NO SUCH DEVICE
STCOME:	TELL	OPR,(T1)	;TELL HI WHAT IT WAS
	POPJ	P,		;AND RETURN
SUBTTL	Operator Commands -- Subroutines

;^;+TYPONM -- Routine to type to the operator the message pointed
;	to by T1, followed by "on dev" if an input device has
;	been specified.
;-;#2


TYPONM:	TELL	OPR,(T1)	;TYPE THE MESSAGE TO THE OPERATOR
	SKIPE	CDRDEV		;IS THERE A DEVICE??
	TELL	OPR,ONMSG	;YES, TYPE "ON DEV:"
	TELL	OPR,CRLF	;TYPE A CRLF
	POPJ	P,		;AND RETURN


;+JUNK -- Routine to type "Command Error" message to the
;	operator, and return.
;-;#2

JUNK:	TELL	OPR,CER%	;TYPE THE MESSAGE
	POPJ	P,		;AND RETURN


;+DODEF -- Routine to process deferred commands.
;-;#2

DODEF:	TXZE	F,F.DEXT	;DEFERRED EXIT?
	JRST	EXTCOM		;YES, DO THE EXIT
	TXZE	F,F.DRES	;DEFERRED RESET?
	JRST	RSTCOM		;YES, DO THE RESET
	TELL	OPR,PSEMSG	;MUST BE PAUSE
	SKIPE	CDRDEV		;ANY DEVICE?
	TELL	OPR,ONMSG	;YES, TYPE IT
	TELL	OPR,CCRLF	;AND A ]<CRLF>
	PUSHJ	P,PSECOM	;DO THE PAUSE
	PJRST	OPER		;AND GO WAIT!!


;+GOIFST -- Routine called by commands which do an automatic
;	GO if SPRINT is STOPed.  If F.STOP
;	is on, finish command off via GOCOM, else just return.
;-

GOIFST:	TXNE	F,F.STOP	;IS STOP ON?
	PJRST	GOCOM		;YES, GIVE A GO!
	POPJ	P,		;NO, JUST RETURN
SUBTTL	TTY INPUT ROUTINES

;TTYIN -- ROUTINE TO RETURN ONE CHARACTER FROM THE TELETYPE IN AC C.
;	IGNORES NULLS, CONVERTS TABS AND CR TO A SPACE, CONVERTS
;	LOWER CASE TO UPPER CASE.
;
;CALL:
;	PUSHJ P,TTYIN
;	  RETURN HERE IF THIS CHARACTER IS END-OF-LINE
;	  RETURN HERE OTHERWISE

TTYIN:	TTYI	C		;GET A CHARACTER
	JUMPE	C,.-1		;IGNORE A NULL
	CAIE	C,.CHTAB	;CONVERT TABS
	CAIN	C,.CHCRT	; AND CARRIAGE RETURNS
	MOVEI	C,.ASSPC	;TO SPACE
	CAIL	C,141		;SEE IF IT IS LOWER CASE
	CAILE	C,172		; LC RANGE IS 141-172
	SKIPA			;NOT LOWER CASE
	SUBI	C,.ASSPC	;IT IS, MAKE IT UC
	CAILE	C,.CHESC	;GREATER THAN ESCAPE?
	PJRST	.POPJ1		;YES, RETURN WITH A SKIP

	PUSHJ	P,ISBRK		;IS IT A BREAK?
	  POPJ	P,		;YUP!
	PJRST	.POPJ1		;NO, SKIP BACK


;CONTTY -- TTY CONTINUATION ROUTINE
;	CONTTY PRINTS "#" ON TTY, FLUSHES TILL END OF LINE, AND
;	AND SKIPS BACK.

CONTTY:	MOVEI	T1,"#"		;LOAD A #
	TTYO	T1		;AND TYPE IT
	PUSHJ	P,TTYBRK	;FLUSH A COMMENT IF NEXESSARY
	OFF	F.IBRK		;SET NO BREAK 
	PJRST	.POPJ1		;AND SKIP BACK
;ISBRK -- ROUTINE TO DETERMINE IF THE CHARACTER IN AC C IS A
;	BREAK CHARACTER.
;
;CALL:
;	PUSHJ P,ISBRK
;	  RETURN HERE IF IT IS A BREAK
;	  RETURN HERE OTHERWISE

ISBRK:	MOVSI	T5,-.NMBRK	;SETUP AOBJN POINTER

ISBRK1:	CAMN	C,BRKTBL(T5)	;COMPARE TO TABLE
	  JRST	ISBRK2		;IT MATCHES!!
	AOBJN	T5,ISBRK1	;LOOP AROUND
	PJRST	.POPJ1		;NOT A BREAK, SKIP BACK

ISBRK2:	ON	F.IBRK		;IT IS A BREAK!!
	CAIE	C,.CHCNC	;WAS IT CONTROL C?
	CAIN	C,.CHCNZ	;OR CONTROL Z?
	  SKIPA			;YES!!
	POPJ	P,		;NO, RETURN
	MOVSI	T5,ER.ICC	;GET CONTR-C INTERCEPT BIT
	MOVEM	T5,L.INTB+3	;AND STORE IT
	MOVEI	T5,.POPJ	;PLACE TO GO ON RETURN
	MOVEM	T5,L.INTB+2	;AND STORE
	JRST	INTLOC		;WE'VE JUST SIMULATED ^C INTERCEPT!!

;BRKTBL -- TABLE OF BREAK CHARACTERS

BRKTBL:	EXP	.CHLFD		;LINE-FEED
	EXP	.CHESC		;ESCAPE
	EXP	.CHFFD		;FORM-FEED
	EXP	.CHVTB		;VERTICAL TAB
	EXP	.CHBEL		;BELL
	EXP	.CHCNZ		;CONTROL Z
	EXP	.CHCNC		;CONTROL C
	.NMBRK==.-BRKTBL


;TTYBRK -- ROUTINE TO FLUSH THE TTY UNTIL EOL
;
;CALL:
;	PUSHJ P,TTYBRK
;	  ALWAYS RETURN HERE

TTYBRK:	TXNE	F,F.IBRK	;GOT A BREAK ALREADY?
	POPJ	P,		;YES, RETURN

TTYBR1:	TTYI	C		;GET A CHARACTER
	PUSHJ	P,ISBRK		;BREAK?
	  POPJ	P,		;YES, RETURN
	JRST	TTYBR1		;LOOP AROUND

SUBTTL	LOOKUP/ENTER UUO Error Messages

UUOMSG:	[ASCIZ /File Not Found/]
	[ASCIZ /No UFD/]
	[ASCIZ /Protection Failure/]
	[ASCIZ /File Being Modified/]
	[ASCIZ /Already Existing Filename/]
	0
	[ASCIZ /RIB or UFD Error/]
	0
	0
	[ASCIZ /Device Not Available/]
	[ASCIZ /No Such Device/]
	0
	[ASCIZ /No Room or Quota Exceeded/]
	[ASCIZ /Write Locked/]
	[ASCIZ /Not Enough Table Space/]
	0
	[ASCIZ /Block Not Free/]
	0
	[ASCIZ /Cannot Supersede Directory/]
	[ASCIZ /SFD Not Found/]
	[ASCIZ /Search List Empty/]
	[ASCIZ /SFD Level Too Deep/]
	[ASCIZ /No Create on All Strs/]
	0

	.NMUUM==.-<UUOMSG+1>
	[ASCIZ /Unknown UUO Error/]
SUBTTL	LUUO Handler

COMMENT /
;^;++
		LUUO Handler

Output to all files except the user's decks is done via LUUOs.
The format of the LUUOs is:

		LUUO  DEST,ADR

where LUUO is one of the following.

LUUO	OP-CODE		ACTION

TELL	   1		Print the ASCIZ string starting
			at ADR.

TELL6	   2		Print the 6 Sixbit characters in ADR.

CHR	   3		Print the number ADR as an ASCII
			character.

STAMP	   4		Place a timestamp in the LOG with the
			message contained in ADR.

RAD10	   5		Print contents of ADR in decimal.

RAD08	   6		Print contents of ADR in octal.
;--;=

The DEST field specifies the destination of the
message.  The destination may be:

	OPR		Send to the operator
	LOG		Send to the LOG file
	CTL		Send to the CTL file
	BOTH		Send to the CTL & LOG file
	ALL		All three

One additional specification in the DEST field may
be NAC which inhibits the translation of Action Characters
on the TELL UUO.

;--

/

	DOWN


;UUO0 -- LUUO HANDLER IS CALLED VIA PUSHJ IN .JB41, AND
;	RETURNS WITH POPJ.  UUO ROUTINES MAY USE ACS U1 AND
;	U2 FREELY.  UUO HANDLER IS RECURSIVE, BUT ANY UUO ROUTINE
;	WHICH EXECUTES LUUOS MUST SAVE U1 AND U2 FIRST.  THESE
;	ARE SAVED BY CALLER INSTEAD OF CALLEE SINCE STAMP IS THE
;	ONLY UUO WHICH USES IT.

UUO0:	PUSH	P,T1		;WE NEED TWO MORE ACS
	PUSH	P,T2

UUO1:	LDB	U1,P.UOP	;GET OP-CODE
	LDB	U2,P.UAC	;GET AC FIELD (DESTINATION)
	CAILE	U1,.NMUUO	;ONE THAT WE KNOW ABOUT?
	  JRST	UUOERR		;ILLEGAL UUO
	HRRZ	T1,.JBUUO	;GET E FIELD
	CAIN	T1,T1		;IS THE EFFEC ADR T1?
	MOVEI	T1,-1(P)	;YES, POINT TO PSEUDO-T1
	CAIN	T1,T2		;OR, IS IT T2?
	MOVEI	T1,0(P)		;YES, POINT TO PSEUDO-T2
	TXNE	F,F.QLOG	;QUIET LOG FILE?
	TXZ	U2,UU.LOG	;YES!!
	TXNE	F,F.QCTL	;QUIET CTL FILE?
	TXZ	U2,UU.CTL	;YES!!
	PUSHJ	P,@UUODIS-1(U1)	;DISPATCH UUO
	POP	P,T2		;RETURN TO HERE AND RESTORE T2
	PJRST	T1POPJ		;RESTORE T1 AND RETURN TO USER


UUOERR:	PUSHJ	P,GETHGH	;GET THE HISEG
	TELL	OPR,ILU%	;FATAL ERROR
	JRST	ABEND		;AND GO BYE-BYE

;UUO DISPATCH TABLE
UUODIS:	EXP	MSGOUT		;TELL UUO
	EXP	SIXOUT		;TELL6 UUO
	EXP	CHROUT		;CHR UUO
	EXP	TIMSTP		;STAMP UUO
	EXP	DECOUT		;RAD10 UUO
	EXP	OCTOUT		;RAD08 UUO

	.NMUUO==.-UUODIS
MSGOUT:	HRLI	T1,440700	;POINTER TO ASCIZ STRING
MSGOU1:	ILDB	U1,T1		;GET A CHARACTER
	TXNE	U2,UU.NAC	;INHIBIT ACTION CHARACTERS?
	JRST	MSGOU2		;YES
	CAIN	U1,"^"		;ACTION CHARACTER?
	PUSHJ	P,ACTCHR	;YES GO PROCESS
				;RETURNS HERE WITH NEXT PRINT CHAR
MSGOU2:	JUMPE	U1,.POPJ	;NULL MEANS END-OF-STRING
	PUSHJ	P,CHROU1	;PRINT THE CHARACTER
	JRST	MSGOU1		;AND LOOP FOR NEXT CHARACTER


SIXOUT:	HRLI	T1,440600	;MAKE 6BIT BYTE POINTER
SIXOU1:	ILDB	U1,T1		;GET A CHARACTER
	ADDI	U1,.ASSPC	;MAKE IT ASCII
	CAIE	U1,.ASSPC	;IS IT A SPACE?
	PUSHJ	P,CHROU1	;NO, PRINT IT
	TLNE	T1,770000	;FINISHED?
	JRST	SIXOU1		;NO, LOOP AROUND FOR ANOTHER
	POPJ	P,		;FINISHED

OCTOUT:	SKIPA	U1,.POPJ	;LOAD AN 8
DECOUT:	MOVEI	U1,12		;LOAD A 10
	MOVE	T1,(T1)		;GET NUMBER INTO T1
NUMOUT:	IDIVI	T1,(U1)		;DIVIDE BY RADIX
	HRLM	T2,(P)		;SAVE REMAINDER
	SKIPE	T1		;ARE WE DONE?
	PUSHJ	P,NUMOUT	;NO, RECURSE
	HLRZ	U1,(P)		;GET LAST CHARACTER
	ADDI	U1,"0"		;MAKE IT ASCII
	PUSHJ	P,CHROU1	;PRINT IT
	POPJ	P,		;UNWIND



CHROUT:	MOVE	U1,T1		;GET THE CHARACTER
CHROU1:	TXNE	U2,UU.LOG	;GO TO LOG?
	PUSHJ	P,LOGOUT	;YES, PRINT IT
	TXNE	U2,UU.CTL	;GO TO CTL FILE
	PUSHJ	P,CTLOUT	;YUP, PRINT IT THERE
	TXNN	U2,UU.OPR	;TO OPERATOR?
	POPJ	P,		;NO, RETURN
	TXNE	F,F.SHMG	;DOES OPR WANT SHORT MESSAGES
	TXNN	F,F.QOPR	;YES, ARE WE PAST THE SHORT PART?
	TTYO	U1		;NO, PRINT THE CHARACTER
	POPJ	P,		;RETURN
;^;+ACTCHR -- Routine to handle Action Characters.
;	Action Characters are any characters which follow an "^"
;	in an ASCIZ string printed by a TELL UUO.  They
;	cause certain extra information to be printed out, or flip a bit
;	to determine message length for the operator.
;-;#1
;CALL:
;	PUSHJ P,ACTCHR
;	  RETURN HERE WITH NEXT PRINTABLE CHARACTER IN U1
;
;:Action Characters are:
;:	^0	Print "CDRCNT" in decimal
;:	^1	Print "DEKCRD" in decimal
;:	^2	Print "DEKBLK" in decimal
;:	^3	Print "L.DEKN" in decimal
;:	^4	Complement F.QOPR bit
;:	^5	Print "CDRDEV" in 6bit
;:	^6	Print "FILDEV" in 6bit
;:	^7	Print "L.SWCH" in 6bit
;:	^9	Print "L.CNAM" in 6bit
;:	^A	Print "L.NHOL" in decimal
;:	^B	Print "FILNAM" in 6bit
;:	^C	Print "FILEXT" in 6bit
;:	^D	Print "FILDEV" in 6bit
;:	^E	Print First SFD in path in 6bit
;:	^F	Print T3 in octal
;:	^G	Print "L.CMD" in 6bit
;:	^H	Print "L.QFN" in 6bit
;:	^I	Print the monitor prompt character
;:	^J	Print jobname in 6bit
;:	^K	Print L.FNNM in 6bit
;#5


ACTCHR:	ILDB	U1,T1		;GET ACTION CHARACTER
	CAIL	U1,"A"		;IS IT A LETTER?
	SUBI	U1,"A"-"9"-1	;YES, MAKE LETTERS FOLLOW NUMBERS
	SUBI	U1,"0"		;MAKE A BINARY NUMBER
	SKIPL	U1		;LESS THAN 0 IS ILLEGAL
	CAILE	U1,.NMACT	;GREATER THAN ACTNUM IS ILLEGAL
	  JRST	UUOERR		;TELL HIM

	PUSH	P,U2		;SAVE U2
	LSH	U2,^D23		;PUT DESTINATION IN AC FIELD
	MOVE	U1,ACTTBL(U1)	;GET THE SPECIAL ACTION
	TLNE	U1,700000	;IT IS A UUO?
	SKIPA	U2,U1		;NO, GOT OPERATION INTO U2
	IOR	U2,U1		;YES, OR IN DESTINATION
	XCT	U2		;DO THE ACTION
	POP	P,U2		;RESTORE U2
	ILDB	U1,T1		;GET THE NEXT CHARACTER
	CAIN	U1,"^"		;ANOTHER ACTION CHARACTER
	JRST	ACTCHR		;YES, LOOP AROUND
	POPJ	P,		;NO - RETURN
ACTTBL:	RAD10	CDRCNT		;^0
	RAD10	DEKCRD		;^1
	RAD10	DEKBLK		;^2
	RAD10	L.DEKN		;^3
	TXC	F,F.QOPR	;^4
	TELL6	CDRDEV		;^5
	TELL6	FILDEV		;^6
	TELL6	L.SWCH		;^7
	CHR	(C)		;^8
	TELL6	L.CNAM		;^9
	RAD10	L.NHOL		;^A
	TELL6	FILNAM		;^B
	TELL6	FILEXT		;^C
	TELL6	FILDEV		;^D
	TELL6	Q.IDDI+1(Q)	;^E
	RAD08	T3		;^F
	TELL6	L.CMD		;^G
	TELL6	L.QFN		;^H
	CHR	MONPRT		;^I
	TELL6	Q.JOB(Q)	;^J
	TELL6	L.FNNM		;^K

	.NMACT==.-ACTTBL
;:TIMSTP -- Routine to place a TIMESTAMP in the LOG file.
;:
;:TIMESTAMP is of the form:
;:	HH:MM:SS<SPACE>STxxx<TAB>
;:
;&Where HH:MM:SS is the current time, and STxxx is the
;&	stamp specified as the effective address of
;&	the STAMP UUO.
;&
;:STAMPS are:
;:	STDAT -- DATE,SYSTEM NAME,SPRINT VERSION,DEVICE
;:	STMSG -- ANY SPRINT NON-ERROR MESSAGE
;:	STERR -- ANY SPRINT ERROR MESSAGE
;:	STCRD -- ANY SPRINT CONTROL CARD
;:	STOPR -- ANY ACTION BY OR MESSAGE FROM THE OPERATOR
;:	STSUM -- SUMMARY AT THE END


TIMSTP:	PUSH	P,T1		;SAVE STAMP ADDRESS
	MSTIME	T1,		;GET TIME OF DAY

	IDIV	T1,[15567200]	;DIV BY #MS/HR =1000*60*60 (DEC)
	CAIGE	T1,^D10		;GREATER THAN 10?
	CHR	LOG,"0"		;NO, PAD IT
	RAD10	LOG,T1		;PRINT THE HOURS

	MOVE	T1,T2		;GET THE REMAINDER INTO T1
	CHR	LOG,":"		;PUT IN A COLON
	IDIVI	T1,165140	;DIV BY #MS/MIN =1000*60 (DEC)
	CAIGE	T1,^D10		;GREATER THAN 10?
	CHR	LOG,"0"		;NO, PAD IT
	RAD10	LOG,T1		;AND PRINT THE NUMBER
	CHR	LOG,":"		;AND A COLON

	MOVE	T1,T2		;GET REMAINDER INTO T1
	IDIVI	T1,^D1000	;DIV BY #MS/SEC
	CAIGE	T1,^D10		;CHECK FOR PADDING
	CHR	LOG,"0"		;PAD IT
	RAD10	LOG,T1		;PRINT SECS

	POP	P,T1		;GET THE STAMP BACK
	CHR	LOG,.ASSPC	;PRINT A SPACE
	TELL6	LOG,(T1)	;PRINT IT
	CHR	LOG,.CHTAB	;TAB
	POPJ	P,		;AND RETURN
SUBTTL	LOG File Handler

COMMENT /
;^;=
Since numerous timing problems exist as to where and when
to create the LOG file, the LOG is handled differently
from the CTL File.

At the top of the main program loop, LOGINI is called
to initalized various parameters for the LOG, and put in the
introductory message.  At this time, the LOG is neither
OPENed nor ENTER'ed, and this is flagged by location
LOGBH containing 0.  All messages typed-in the
LOG are deposited in the buffer.  When the buffer is full
and the LOG is not ENTER'ed, another buffer
is tacked on the end.  Once the LOG is ENTER'ed, the
output routine uses all the buffers that have been allocated, and outputs
them normally when they are full.  At the end, the remaining characters
in the buffer are written out.

The LOG is handled this way since it is desirable
to put messasges in the LOG (e.g. $JOB card, switch
errors etc.) before it is ENTER'ed (which must be done after
the PPN and Password have been verified).

;--
/
LOGOUT:	SOSG	LOGBC		;DECREMENT BYTE COUNT AND SKIP IF ROOM
	PUSHJ	P,LOGUUO	;NO ROOM
	IDPB	U1,LOGBP	;DEPOSIT THE BYTE
	POPJ	P,		;AND RETURN

LOGUUO:	PUSH	P,U1		;SAVE U1
	SKIPL	LOGBH		;IS THE LOG OPEN AND ENTERED?
	JRST	LOGUU1		;NO, APPEND ON ANOTHER BUFFER
	OUT	LOG,LOGIOW	;OUTPUT THE BUFFER
	  SKIPA			;NO ERROR
	JRST	IOERR		;ERROR!!

	HRRZ	U1,LOGAD	;GET START ADR OF BUFFER
	HRLI	U1,440700	;AND MAKE A BYTE POINTER
	MOVEM	U1,LOGBP	;AND STORE IT
	HLRZ	U1,LOGAD	;GET NUMBER OF BUFFERS
	IMULI	U1,1200		;CONVERT TO # OF CHARS
	MOVEM	U1,LOGBC	;STORE BYTE COUNT
	PJRST	U1POPJ		;RESTORE U1 AND RETURN

;HERE IF WE RUN OUT OF SPACE BEFORE THE LOG IS OPEN, ADD IN A NEW BUFFER

LOGUU1:	MOVSI	U1,1		;GET XWD 1,,0
	ADDM	U1,LOGAD	;MAKE 1 MORE BUFFER
	PUSH	P,T1		;SAVE T1
	MOVEI	T1,200		;GET NUMBER OF WORDS PER BUFFER
	PUSHJ	P,EXPND		;AND GET THE CORE
	POP	P,T1		;RESTORE T1
	MOVEI	U1,1200		;GET # CHARS / BUFFER
	MOVEM	U1,LOGBC	;GIVE ME SOME MORE ROOM
	HLLZ	U1,LOGAD	;GET XWD BUFN,,0
	IMUL	U1,[-200]	;CONVERT TO -VE WORDS
	HRR	U1,LOGAD	;GET START ADR
	SUBI	U1,1		;MINUS 1
	MOVEM	U1,LOGIOW	;STORE IOWD
	CLEARM	LOGIOW+1	;AND SET END-OF-COMMAND-LIST
U1POPJ:	POP	P,U1		;RESTORE U1
	POPJ	P,		;AND RETURN
;CLSLOG IS CALLED TO WRITE OUT WHAT'S IN THE BUFFER AND CLOSE
;THE LOG FILE OFF.  IT'S IN THE HISEG SINCE IT'S ONLY CALLED BY THE
;HISEG QUEUE ROUTINES.

	UP

CLSLOG:	TELL	LOG,CRLF	;PUT IN A FINAL CRLF
	HLRZ	T1,LOGAD	;GET NUMBER OF BUFFERS
	IMULI	T1,1200		;GET TOTAL NUMBER OF CHARS
	SUB	T1,LOGBC	;SUBTRACT WHATS LEFT
	CLEAR	T3,		;MAKE A NULL FOR FINISHING THE LAST WORD
	IDIVI	T1,5		;AND CONVERT TO WORDS
	JUMPE	T2,CLSLG1	;JUMP IF DIVISION IS EXACT
	AOS	T1		;ELSE COUNT THE PARTIAL WORD
	JRST	.(T2)		;AND FILL IN THE LAST WORD WITH NULLS
	IDPB	T3,LOGBP	;REM=1 DEPOSIT 4 NULLS
	IDPB	T3,LOGBP	;REM=2 DEPOSIT 3 NULLS
	IDPB	T3,LOGBP	;REM=3 DEPOSIT 2 NULLS
	IDPB	T3,LOGBP	;REM=4 DEPOSIT 1 NULL
CLSLG1:	JUMPE	T1,CLSLG2	;JUMP TO THE "RELEAS" IF ZERO.
	MOVNS	T1		;GET NEGATIVE WORDS
	HRLM	T1,LOGIOW	;AND STORE IN IOWD WORD
	OUT	LOG,LOGIOW	;DO THE OUTPUT
	  SKIPA			;SKIP IF IT WINS
	JRST	IOERR		;PUNT IF IT LOSES

IFN FTJSYS,<
	MOVE	T1,[3,,T2]	;3 ARGS STARTING IN T2
	MOVE	T2,[LOG,,5]	;CHANNEL,,FUNCTION
	MOVE	T3,[POINT 7,L.QUE+Q.LSTR]
	MOVE	T4,[111110,,1]	;JFNS FLAGS
	COMPT.	T1,		;CONVERT NAME TO STRING
	  JRST	CLSLG2		;NO, STRING (I HOPE)
	MOVX	T1,1B15		;MAGIC TEMP FLAG FOR STRING
	IORM	T1,Q.LMOD(Q)	;SET IT FOR QMANGR
>  ;END IFN FTJSYS

CLSLG2:	RELEAS	LOG,		;RELEAS THE LOG
	CLEARM	LOGBH		;TURN OFF "OPENED AND ENTERED" FLAG
	CLEARM	LOGBC		;FORCE BUFFER CREATION

	POPJ	P,		;AND RETURN

	DOWN			;AND DOWN WE GO
SUBTTL	Control File I/O

CTLOUT:	SOSG	CTLBC		;ANY ROOM?
	PUSHJ	P,CTLUUO	;NO, DUMP SOME
	IDPB	U1,CTLBP	;DEPOSIT BYTE
	POPJ	P,		;AND RETURN

CTLUUO:	OUT	CTL,		;THIS ONE IS EASY
	  POPJ	P,		;WIN!

IOERR:	TELL	OPR,IOE%	;IOERROR
	JRST	ABEND		;UNRECOVERABLE
SUBTTL	Job Setup and Idle Loop

SETUP:	OFF	F.FATE!F.KILL!F.EOF	;CLEAR SOME BITS
	TXNE	F,F.GTIN	;DO I HAVE THE CDR?
	  JRST	SETUP1		;YES, CONTINUE
	PUSHJ	P,GETIND	;NO, GET INPUT DEVICE
	  JRST	IDLE		;CAN'T GET IT, TRY AGAIN LATER

SETUP1:	MOVE	T1,P.DFBP	;GET THE DEFAULT MODE
	MOVEM	T1,L.DHOL	;SAVE AS DEFAULT
	MOVEM	T1,L.CHOL	;SAVE FOR READ ROUTINE
	TXZE	F,F.NXT		;GOT NEXT CARD ALREADY?
	JRST	SETUP2		;YES, SKIP THE INPUT
SETUPR:	PUSHJ	P,CDRASC	;GET A CARD
	  JRST	IDLE		;JOBINT!!  (OR AN EXTRA EOF CARD)

SETUP2:	MOVE	T1,L.SPBP	;GET SUPPRESS BYTE POINTER
	CAMN	T1,P.CL1A	;ALL BLANKS?
	JRST	SETUPR		;YES, SKIP THIS CARD
	ON	F.BUSY		;I'M BUSY
	PUSHJ	P,SETLOW	;SETUP LOWSEG STORAGE
	PUSHJ	P,MAIN		;GO DO A JOB
	OFF	F.BUSY!F.KILL!F.FATE  ;NOT BUSY
	MOVE	T1,CDRJFF	;RECLAIM ALL BUT CDR BUFFERS
	PUSHJ	P,SHRINK	;AND SHRINK BACK
	TXZN	F,F.EOF		;WAS EOF SEEN?
	JRST	SETUP3		;NO, SKIP DSK CHECK
	TXNE	F,F.DSK!F.MTA	;IS INPUT DEVICE A DSK OR MTA?
SETRES:	ON	F.DRES		;YES, DUMMY UP A RESET
SETUP3:	TXNN	F,F.DCOM	;ANY DEFERRED COMMANDS?
	JRST	SETUP		;NO, JUST LOOP AROUND
	PUSHJ	P,GETHGH	;YES, GET THE HISEG
	PUSHJ	P,DODEF		;AND DO THE COMMANDS
	JRST	SETUP		;GO LOOP AGAIN

IDLE:	TXNN	F,F.ICDR	;IS INPUT FROM CARD-READER?
	JRST	SETRES		;NO, DO A RESET
	TXZE	F,F.EOF		;WAS IT AN EXTRA EOF?
	JRST	SETUP		;YES, TRY AGAIN
	PUSHJ	P,RELHGH	;RELEAS THE HISEG
	RELEAS	CDR,		;GET RID OF INPUT DEVICE
	OFF	F.GTIN		;AND CLEAR GTIN FLAG
	MOVE	T1,CDRJFF	;LOAD "LOGICAL" TOP OF CORE
	PUSHJ	P,SHRINK	;AND SHRINK TO IT
	PUSHJ	P,HIBR10	;GO SLEEP
	PUSHJ	P,CHKOPR	;SEE IF OPR SAID SOMETHING
	JRST	SETUP		;AND TRY FOR ANOTHER JOB
;RESTRT -- PROGRAM RESTART ROUTINE
;	THE ADDRESS OF THIS ROUTINE IS PLACED IN .JBSA
;	AT INITIALIZATION TIME TO ALLOW THE USER TO TYPE
;	'^C ^C START' TO SPRINT WHETHER OR NOT THE HISEG IS
;	IN CORE.

RESTRT:	PUSHJ	P,GETHGH	;GET THE HISEG
	JRST	SPT1		;RESTART!!


;SETLOW -- ROUTINE TO SETUP LOWSEGMENT STORAGE FOR EACH JOB

SETLOW:	PUSHJ	P,GETHGH	;GET MY HISEG
	MOVE	T1,[LOWZER,,LOWZER+1]
	CLEARM	LOWZER		;FIRST ALL THE PRE-ZEROED LOCS
	BLT	T1,LOWZND	;ZAP!
	MOVE	T1,[PREHGH,,PRELOW]
	BLT	T1,PRELND	;AND THEN ALL THE PRE-SET LOCS
	POPJ	P,
SUBTTL	Main Program Loop

COMMENT \
;^;=
		Main Program Loop

The main program loop is entered with the first card in the line
buffer L.CARD.  This card was read by the SETUP routine while
polling the card-reader for input.  Flow of control is as follows:
;--;++

    ------------------------            ------------------------
   /SEE IF CARD IS VALID   /           /   FLUSH AND CREATE    /
   /   JOB STARTER         /----NO---->/     SPTERR.LOG        /
   ------------------------            ------------------------ 
               !
               V
    ------------------------
-->/      GET A CARD       /<-----------------------
^  ------------------------                        ^
!              !                                   !
!              V                                   !
!   -------------------------            ------------------------
!  /  START WITH A $ ?      /----NO---->/PUT CARD IN CTL FILE   /<--
!  -------------------------            ------------------------   ^
!              !                                                   !
!              V                                                   !
!   ------------------------                                       !
!  /GET SECOND COLUMN      /                                       !
!  ------------------------                                        !
!              !                                                   !
!              V                                                   !
!   ------------------------                                       !
!  /IS IT A LETTER (A-Z) ? /-------NO-------------------------------
!  ------------------------
!              !
!              V
!   ------------------------
!  / DISPATCH CONTROL CARD /
!  ------------------------
!              !
!              V
!   ------------------------             -----------------------
!  /EOF SEEN OR KILL TYPED?/----YES---->/FINISH OFF JOB & RET  /
!  ------------------------             -----------------------
!              !
!              V
!   ------------------------             -----------------------
^--/FATAL ERROR DETECTED?  /----YES---->/GO ABORT JOB & RET    /
   ------------------------             -----------------------
;--
\
;MAIN -- MAIN PROGRAM LOOP

MAIN:	PUSHJ	P,GETHGH	;GET THE HISEGMENT
	PUSHJ	P,LOGINI	;INITIALIZE THE LOG FILE
	PUSHJ	P,STRTJB	;SEE IF WHAT WE JUST READ WAS A REASONABLE
				; WAY OF STARTING A JOB
	  JRST	NTAJOB		;I GUESS NOT
	TXZE	F,F.FATE!F.FFOR ;DID WE LOSE, OR IS IT A FFS JOB?
	POPJ	P,		;YES JUST RETURN

MAIN0:	PUSHJ	P,RELHGH	;GET RID OF HISEG
MAIN1:	PUSHJ	P,CDRASC	;GET A CARD
	  PJRST	ENDJOB		;END OF FILE = END OF JOB
MAIN1A:	PUSHJ	P,FSUPR		;SUPRESS TRAILING BLANKS
	LDB	T1,P.CL1A	;GET COLUMN 1
	CAIE	T1,"$"		;CONTROL CARD?
	JRST	MAIN6		;NO, MUST BE AN ERROR

	LDB	T1,P.CL2A	;GET SECOND COLUMN
	CAIL	T1,"A"		;SEE IF SECOND LETTER IS ALPHABETIC
	CAILE	T1,"Z"		;BETWEEN A AND Z
	 JRST	MAIN5		;NO, EITHER A COMMENT OR AN ERROR
	PUSHJ	P,CONTRL	;PROCESS CONTROL CARD
	  PJRST	MAIN4		;HE LOSES
	TXNE	F,F.EOF		;EOF ENCOUNTERED SOMEWHERE?
	  PJRST	ENDJOB		;YUP, FINISH IT OFF
	TXNE	F,F.KILL	;WAS KILL TYPED?
	  PJRST	KILJOB		;YES, DO IT!!
	TXNE	F,F.FATE	;DID HE GET A FATAL ERROR?
	  PJRST	ABORT		;YES, KILL HIM
	TXZE	F,F.NXT		;GOT NEXT CARD ALREADY?
	JRST	MAIN1A		;YES, SKIP THE READ
	JRST	MAIN1		;AND GO READ ANOTHER

MAIN4:	TXZE	F,F.NEOF	;DID HE FORGET EOF
	POPJ	P,		;YES, RETURN
	PJRST	ABORT		;NO, HE JUST LOST

MAIN5:	CAIE	T1,"!"		;EXCLAIM?
IFN FTUUOS,<
	CAIN	T1,";"		;OR SEMI?
	SKIPA			;YES, IT'S A COMMENT
>  ;END IFN FTUUOS
	JRST	MAIN6		;NO, IT'S AN ERROR
	STAMP	STCRD		;STAMP THE LOG
	TELL	LOG!NAC,L.CARD	;PUT IT IN THE LOG
	MOVX	T1,<"!">B6	;LOAD AN EXCLAIM
	MOVX	T2,177B6	;LOAD A MASK
	ANDCAM	T2,L.CARD	;TURN OFF CHAR 1
	IORM	T1,L.CARD	;AND MAKE IT AN EXCLAIM
	TELL	CTL!NAC,L.CARD	;AND WRITE THE COMMENT INTO CTL FILE
	JRST	MAIN1		;AND LOOP AROUND

MAIN6:	PUSHJ	P,ILLCRD	;GIVE THE MESSAGE
	PJRST	ABORT		;AND ABORT HIM
;HERE TO CHECK THE FIRST CARD OF A DECK TO SEE IF ITS WHAT I WANT
;RETURNS NON-SKIP IF CARD ISN'T A STARTER, AND SKIP IF IT WAS,
;WITH F.FATE ON IF AN ERROR OCCURED.

STRTJB:	MOVEI	T1,1		;LOAD A ONE
	MOVEM	T1,CDRCNT	;AND SAVE AS CARD COUNT
	MOVE	T1,L.CARD	;LOAD FIRST FIVE CHARACTERS
	TRZ	T1,377		;ZAP THE LAST CHARACTER
	CLEAR	T2,		;PLACE FOR DISPATCH ADDRESS
	CAMN	T1,C.JOB	;JOB CARD?
	MOVEI	T2,$JOB		;YES, LOAD ADR OF JOB CARD ROUTINE
	CAMN	T1,C.SEQ	;SEQUENCE CARD?
	MOVEI	T2,$SEQ		;YES, HANDLE $SEQ CARD
	CAMN	T1,C.EOJ	;IS IT AN $EOJ CARD?
	MOVEI	T2,.POPJ	;YES, CAUSE A PLAIN RETURN
	PJUMPE	T2,.POPJ	;RETURN IF NO MATCH
	PUSHJ	P,(T2)		;DISPATCH
	  ON	F.FATE		;AN ERROR WAS FOUND
	MOVE	T1,P.DFBP	;GET DEFAULT BYTE POINTER
	MOVEM	T1,L.CHOL	;AND STORE IT
	PJRST	.POPJ1		;SKIP BACK


;HERE WHEN THE FIRST CARD OF A DECK IS NOT WHAT I WANT. I.E., NOT
;A $SEQ OR $JOB.
;CREATE A LOG FILE CALLED SPTERR.LOG AND QUEUE IT TO THE OPR.

NTAJOB:	PUSHJ	P,SETQUE	;SETUP QUEUE AREA
	LDB	T1,[POINT 4,CDRDEV,23]
	LDB	T2,[POINT 4,CDRDEV,29] ;GET  1ST AND 2ND DIG OF PHYS CDR
	SKIPN	T2		;SECOND DIGIT 0?
	EXCH	T1,T2		;YES, MAKE IT 0N
	LSH	T1,6		;MOVEIT OVER 6 BITS
	TRO	T1,2020(T2)	;MAKE IT SIXBIT NN
	IOR	T1,['SPTE  ']	;AND THE REST OF THE NAME
	MOVEM	T1,Q.LNAM(Q)	;MAKE IT THE LOG-FILE NAME
	PUSHJ	P,NOJOB		;MAKE THE LOG FILE
	STAMP	STERR		;STAMP AN ERROR
	TELL	LOG,IJC%	;ILL JOB CARD
	TELL	LOG,[ASCIZ /	Card= /]
	TELL	LOG!NAC,L.CARD	;PUT THE FIRST CARD IN
;[1055] NTAJOB+21 1/2 JHT 3/5/75
	SKIPL	L.MSGL		;DOES OPR WANT TO SEE THIS?
	  JRST	NTAJB1		;  NO, PROCEED
	TELL	OPR,IJC%	;YES, GIVE 'ILLEGAL JOB CARD'
	TXNE	F,F.SHMG	;TEST LONG AND SHORT OF IT
	  JRST	NTAJB1		;  NOT INTERESTED IN DETAIL
	TELL	OPR,[ASCIZ /	Card= /]
	TELL	OPR,L.CARD	;GIVE HIM THE FIRST CARD
NTAJB1:	PUSHJ	P,FLUSH		;FLUSH 'EM
	PJRST	QUELOG		;AND QUE THE LOG
SUBTTL	Routine to OPEN the Input Device

;GETIND -- ROUTINE TO OPEN THE INPUT DEVICE
;	ENTER WITH THE DEVICE CONTROL CELLS LOADED WITH THE
;	NECESSARY INFORMATION, DEVNAM,DEVMOD...
;
;CALL:
;	PUSHJ P,GETIND
;	  RETURN HERE IF DEVICE CAN'T BE OPENED
;	  RETURN HERE WITH DEVICE OPEN ON CHANNEL CDR
;
;IF INPUT FILE IS NOT READABLE (FNF OR PROT FAIL) GETIND CAUSES SPRINT
;TO GO BACK INTO RESET STATE.

GETIND:	MOVEI	T3,CDRBH	;INPUT BUFFER RING HEADER
	MOVEM	T3,CDROPN+2	;SAVE IN OPEN BLOCK
	OPEN	CDR,CDROPN	;OPEN THE DEVICE
	  JRST	GTIND9		;CAN'T DO IT

	ON	F.GTIN		;I'VE GOT IT

IFN FTJSYS,<
	MOVE	T1,[1,,T2]	;1 ARG IN T2
	MOVE	T2,[CDR,,10]	;CHANNEL,,FUNCTION
	COMPT.	T1,		;GET THE JFN OF THE DEVICE
	  JFCL
	MOVEM	T1,L.JFN	;AND SAVE IT
>  ;END IFN FTJSYS

	SETOM	L.NTRY		;CLEAR NTRY FLAG
	MOVE	T1,CDRBUF	;LOAD ADDRESS OF BUFFERS
	MOVE	T2,CDRBFN	;LOAD NUMBER OF BUFFERS
	EXCH	T1,.JBFF	;FAKE OUT THE MONITOR
	INBUF	CDR,(T2)	;GET THE BUFFERS ALLOCATED
	MOVEM	T1,.JBFF	;SAVE JOBFF AGAIN
	TXNE	F,F.LCDR!F.MTA	;IS IT LOCAL CDR OR MTA?
	PJRST	.POPJ1		;YES, RETURN SUCCESSFULLY
	TXNE	F,F.DSK		;IS IT A DSK?
	JRST	GTIN1A		;YES, GO DO THE LOOKUP
	MOVSI	T1,1400		;MUST BE REMOTE CDR, LOAD BYTE SIZE
	MOVEM	T1,CDRBP	;SIZE IN BYTE-POINTER
	PJRST	.POPJ1		;AND RETURN
GTIN1A:	MOVE	T1,CDRNAM	;GET INPUT FILENAME
	MOVE	T2,CDREXT	;GET INPUT FILE EXTENSION
	CLEAR	T3,
	MOVE	T4,CDRPPN	;GET PPN OR PATH BLOCK
	LOOKUP	CDR,T1		;LOOKUP THE FILE
	  JRST	GTIND8		;FNF??

	SKIPN	T2,CDRPPN	;GET INPUT FILE'S PPN
	MOVE	T2,L.MYPP	;USE MINE INSTEAD
	TLNE	T2,-1		;IS IT XWD 0,ADR
	JRST	GTIN1B		;NO, ITS A PPN
	MOVE	T2,2(T2)	;GET PPN FROM PATH BLOCK
;**;[1064] CHANGE @ GTIN1B	JNG	24-Jul-75
GTIN1B:	LDB	T1,P.LPRT	;GET FILES PROTECTION
	HRLI	T1,.ACRED	;GET ACCESS CODE
	MOVE	T3,L.MYPP	;[1064] GET MY PPN
	MOVE	T4,CDRDEV	;GET DEVICE NAME
	DEVPPN	T4,		;GET A PPN FOR IT
	  MOVE	T4,L.MYPP	;DEFAULT TO MY OWN
	CAME	T4,L.MYPP	;IS IT MINE?
	MOVE	T2,T4		;NO, USE IT
	MOVEI	T4,T1		;LOAD ADR OF CHKACC BLOCK
	CHKACC	T4,		;DO THE CHKACC
	  CLEAR	T4,		;IF CHKACC LOSES, HE WINS
	JUMPE	T4,.POPJ1	;WIN!! I CAN READ IT
	MOVEI	T1,ERPRT%	;PROTECTION FAILURE
	JRST	GTIN8A		;CLEAN UP AND WAIT

GTIND8:	HRRZ	T1,T2		;GET ERROR CODE
GTIN8A:	PUSHJ	P,ENTERO	;TYPE ENTER/LOOKUP ERROR
	JRST	SPT1		;AND RESET THE WHOLE WORLD

GTIND9:	AOSG	L.NTRY		;DON'T KEEP TYPING TO HIM
	TELL	OPR,[ASCIZ /[Device ^5 is Not Available]
/]
	POPJ	P,		;AND RETURN
SUBTTL	Control Cards  --  Setup and Dispatch


;CONTRL -- ROUTINE TO INTERPRET AND DISPATCH CONTROL CARDS
;
;CALL:
;	PUSHJ P,CONTRL
;	  RETURN HERE ON FATAL ERROR
;	  RETURN HERE OTHERWISE

CONTRL:	PUSHJ	P,$EOD		;CLOSE OUT FILE IN PROGRESS
	  JFCL			;WON'T GET HERE
	MOVEI	T1,DEVFIL	;LOAD ADR OF DEVICE CELLS
	PUSHJ	P,CLRCEL	;AND CLEAR THEM
	MOVEI	T1,CDRCHR	;ROUTINE TO LOAD A BYTE
	MOVEM	T1,L.SCIN	;STORE IT
	MOVEI	T1,CDRNXT	;ROUTINE TO GET A RECORD
	MOVEM	T1,L.SCLN	;AND STORE IT
	MOVE	B,P.CL1A
	CLEARM	L.CNAM		;CLEAR FOR NEXT TIME
	PUSHJ	P,S$SIX		;PICK-UP KEYWORD
	  JRST	ILLCRD		;ILLEGAL CONTROL CARD
	ON	F.RSCN		;RESCAN THE BREAK LATER ON
	MOVEM	T1,L.CNAM	;IN CASE OF ERROR NOW!
	MOVEI	T2,CARDS	;TABLE OF LEGAL KEYWORDS
	HRLI	T2,-.NMCCR	;XWD -TABLE LENGTH,TABLE ADR
	PUSHJ	P,UNIQ6		;GET A MATCH
	  JRST	ILLCRD		;NO MATCH
	MOVE	P1,CARDS(T1)	;GET CARD NAME
	MOVEM	P1,L.CNAM	;AND SAVE IT
	MOVE	P1,CADRS(T1)	;GET DISPATCH ADDRESS
	TLNE	P1,(CD.BTC)	;THIS CARD NEED THE BATCH BIT?
	ON	F.BTCH		;YES, TURN IT ON!
	TLNE	P1,(CD.CLO)	;CLEAR THE LOAD ORDER?
	PUSHJ	P,FBCLOD	;YUP!!
	TLZ	P1,-1		;ZAP ALL THE BITS
	CAIE	P1,NOEOF	;IS CARD FOR NEXT JOB,
	CAIN	P1,PASCRD	;OR IS IT A PASSWORD CARD?
	PJRST	(P1)		;YES, DON'T PRINT IT INTO LOG, DISPATCH
	STAMP	STCRD		;STAMP THE LOG
	TELL	LOG!NAC,L.CARD	;AND PRINT THE CARD
	HRRZ	T1,L.MSGL	;GET MSGLVL
	CAIN	T1,2		;WANT TO SEE ALL CONTROL CARDS?
	TELL	OPR!NAC,L.CARD	;YES, SHOW HIM
	PJRST	(P1)		;DISPATCH TO CORRECT ROUTINE

ILLCRD:	STAMP	STCRD		;CARD STAMP
	TELL	LOG!NAC,L.CARD	;AND THE CARD
	MOVEI	T1,ICC%		;ADDRESS OF MESSAGE
	PJRST	LOGERR		;PRINT IT AND RETURN
;DEFINE TABLE OF CONTROL CARD NAMES
;	X	CARD,DISPATCH ADR,DISPATCH BITS
;
;WHERE DISPATCH BITS ARE:
	CD.BTC==1B0		;THIS CARDS TURNS THE BATCH BIT ON
	CD.CLO==1B1		;CLEAR LOAD ORDER ON THIS CARD

	CD.LAN==CD.BTC!CD.CLO	;DISPATCH BITS FOR ALL $LANG CARDS


DEFINE	CNAMES,<
	X	FORTRAN,$FORTRAN,CD.LAN,
	X	COBOL,$COBOL,CD.LAN,
	X10	DECK,$DECK,,
	X	CREATE,$CREAT,,
	X10	F40,$F40,CD.LAN,
	X	MACRO,$MACRO,CD.LAN,
	X	MODE,$MODE,,
	X	DATA,$DATA,CD.BTC,
	X	EOD,$EOD,,
	X	ALGOL,$ALGOL,CD.LAN,
	X	BLISS,$BLISS,CD.LAN,
	X	EXECUTE,$EXEC,CD.BTC,
	X10	RELOCATABLE,$RELOC,CD.CLO,
	X10	DUMP,$DUMP,CD.BTC,
	X	SNOBOL,$SNOBOL,CD.LAN,
	X	ERROR,$ERROR,CD.BTC,
	X	NOERROR,$NOERR,CD.BTC,
	X	INCLUDE,$INCL,CD.CLO,
	X	JOB,NOEOF,,
	X	SEQUENCE,NOEOF,,
	X	PASSWORD,PASCRD,,
	X	EOJ,$EOJ,,
	X	MESSAGE,$MESS,,
	X10	TOPS10,$TOPS,CD.BTC,

IFN FTJSYS,<
	X	TOPS20,$TOPS,CD.BTC,
>
>
DEFINE	X(A,B,C),<
	XLIST
	<SIXBIT	/A/>
	LIST
	SALL>

DEFINE X10(A,B,C),<
	IFN FTUUOS,<
		X(A,B,C)
	>
>

CARDS:	CNAMES
	.NMCCR==.-CARDS

DEFINE	X(..A,..B,..C),<
	XLIST
	EXP	..B+..C
	LIST
	SALL>

DEFINE X10(..A,..B,..C),<
	IFN FTUUOS,<
		X(..A,..B,..C)
	>
>

CADRS:	CNAMES
;SWITCH TABLES

;VALID SWITCHES FOR ALL CARDS EXCEPT $JOB CARD
;	Y	SWITCH NAME,DISPATCH ADR,VALID CARD FLAGS
;
;WHERE VALID CARD FLAGS ARE:
	SW.LAN==1B18		;LANGUAGE CARDS
	SW.DEC==1B20		;$DECK CARD
	SW.MOD==1B21		;$MODE CARD
	SW.DAT==1B22		;$DATA CARD
	SW.EXE==1B24		;$EXECUTE CARD
	SW.INC==1B25		;$INCLUDE CARD
	SW.JOB==1B26		;$JOB CARD
	SW.TOP==1B27		;$TOPS10 CARD

	SW.ALL==SW.LAN!SW.DEC!SW.MOD!SW.DAT!SW.TOP

	DEFINE SNAMES,<
	Y	ASCII,SW.ALL
	Y10	026,SW.ALL
	Y10	BCD,SW.ALL
	Y10	BINARY,SW.DEC!SW.DAT
	Y	IMAGE,SW.DEC!SW.DAT
	Y	SUPPRESS,SW.ALL
	Y	NOSUPPRESS,SW.ALL
	Y	WIDTH,SW.ALL
	Y	SEARCH,SW.INC
	Y	PRINT,SW.DEC
	Y10	CPUNCH,SW.DEC
	Y10	TPUNCH,SW.DEC
	Y10	PLOT,SW.DEC
	Y	NOLIST,SW.LAN
	Y	CREF,SW.LAN
	Y	MAP,SW.DAT!SW.EXE
	Y	LIST,SW.LAN
	Y	NOMAP,SW.DAT!SW.EXE
	Y	DOLLAR,SW.ALL
	Y	NODOLLAR,SW.ALL
	Y10	PROTECT,SW.DEC
>
	DEFINE	Y10(A,B),<
	IFN FTUUOS,<
	Y(A,B)
>>

	DEFINE	Y(A,B),<
	XALL
	<SIXBIT	/A/>
	SALL>

SWTCH:	SNAMES
	.NMSW==.-SWTCH

	DEFINE	Y(A,B),<
	XLIST
	XWD	B,W$'A
	LIST
	SALL>

SADRS:	SNAMES
SUBTTL	Control Cards  --  $language

;The LANGS macro is used to define all the $language
;	cards which will be accepted by SPRINT.  The format
;	for each language in the macro is:
;
;	L	<entry-point>,<default-extension>,<COMPIL switch>,<code>
;
;where <code> is one of:
;
;	I	Interpreter -- No REL file
;	R	Compiler -- Generates a REL file


DEFINE	LANGS,<

	L	$SNOBOL,SNO,SNO,I
	L	$BLISS,BLI,BLI,R
	L	$ALGOL,ALG,ALG,R
	L	$COBOL,CBL,COB,R
	L	$MACRO,MAC,MAC,R
	
IFN FTUUOS,<
IFN FTF10&1,<
	L	$FORTRAN,FOR,F10,R
>
IFE FTF10&1,<
	L	$FORTRAN,F4 ,F40,R
>
IFN FTF10&2,<
	L	$F40,FOR,F10,R
>
IFE FTF10&2,<
	L	$F40,F4 ,F40,R
>
>

IFN FTJSYS,<
	L	$FORTRAN,FOR,FOR,R
>
>  ;END DEFINE LANGS
;GENERATE ENTRY POINTS

DEFINE L(A,B,C,D),<

	IFIDN <D> <R> ,<
A:	HRRZI	T1,K
	JRST	$LANG
	K=K+1>

	IFIDN <D> <I> ,<
A:	HRROI	T1,K
	JRST	$LANG
	K=K+1>
>

	K=0
LANCRD:	LANGS


;NOW GENERATE TABLE OF  EXTENSION,,COMPILE SWITCH

DEFINE L(A,B,C,D),<
	<SIXBIT /B/>(<SIXBIT /C/>)
>

EXTTBL:	LANGS
$LANG:	MOVEM	T1,L.LANG	;SAVE THE INDEX
	HLLZ	T2,EXTTBL(T1)	;GET THE DEFAULT EXTENSION
	MOVEM	T2,FILEXT	;AND SAVE IT

	PUSHJ	P,GETFS		;GET A FILESPEC
	  POPJ	P,		;FILESPEC ERROR
	MOVEI	T1,'LN'		;GET 2 CHAR PREFIX
	PUSHJ	P,MAKFUN	;AND DO FUNNY NAME STUFF

	SKIPL	FILSTS		;FUNNY NAMED?
	JRST	$LANG2		;NO, HE SPECIFIED ONE
	MOVX	T1,FB.LDR!FB.DLR;LOAD THE REL AND DELETE BOTH
	SKIPGE	L.LANG		;IS IT AN INTERPRETER?
	MOVX	T1,FB.DEL	;YES, JUST DELETE THE SOURCE
	SETZM	FILPRV		;CLEAR PROTECTION
	PUSHJ	P,FILENT	;ENTER THE FILE
	  POPJ	P,		;LOSE...
	JRST	$LANG3		;MEET AT THE PASS

$LANG2:	MOVX	T1,FB.LDR	;LOAD THE REL FILE
	SKIPGE	L.LANG		;UNLESS ITS AN INTERPRETER
	CLEAR	T1,		;IN WHICH CASE DON'T DO ANYTHING
	PUSHJ	P,FBENT		;ENTER IT IN THE FILE-BLOCKS

$LANG3:	TELL	CTL,CLINE	;PUT IN FIRST PART OF COMPILE LINE
	HRRZ	T1,L.LANG	;GET LANGUAGE INDEX
	HRLZ	T1,EXTTBL(T1)	;GET COMPIL SWITCH
	TELL6	CTL,T1		;AND SEND IT
	CHR	CTL,.ASSPC	;AND A SPACE
	MOVEI	T1,DEVFIL	;ADDRESS OF FILE-DEVICE CELLS
	PUSHJ	P,TFLCTL	;AND TYPE A FILESPEC

	ON	F.RSCN		;RESCAN LAST CHARACTER
	PUSHJ	P,.SCFLS	;AND FLUSH LEADING SPACES
	  JRST	$LANG8		;EOL, GO SEND LISTING SWITCH
	CAIE	C,"("		;BEGINNING OF PROCESSOR SWITCH?
	JRST	$LANG7		;NO, GO CHECK FOR SPRINT SWITCHES
	CHR	CTL,"("		;YES, SEND THE OPEN PAREN

	MOVEI	T1,")"		;LOAD THE BREAK CHARACTER
	PUSHJ	P,CTLCRD	;GO TRANSFER FROM CARD TO CTL
	  JFCL			;IGNORE EOL (RECOVER FROM USER ERROR)
	CHR	CTL,")"		;TYPE THE BREAK

$LANG7:	MOVEI	T1,SW.LAN	;VALID SWITCHES FOR LANGUAGE CARD
	PUSHJ	P,SETSWC	;DO THE SWITCHES
$LANG8:	TELL6	CTL,L.LSW	;PRINT THE LISTING SWITCH
	TELL	CTL,CRLF	;TYPE A CRILIF
	SETOM	L.LANG		;SET THE LANGUAGE FLAG FOR $EOD ROUTINE
	SKIPL	FILSTS		;IS IT FUNNY NAMED?
	PJRST	.POPJ1		;NO, JUST RETURN
	PJRST	STDECK		;YES, GO STACK THE DECK
SUBTTL	Control Cards  --  $DECK - $CREATE

$CREAT:	PUSHJ	P,GETFS		;GET A FILESPEC
	  POPJ	P,		;ERROR IN FILESPEC??
	MOVEI	T1,'CR'		;TWO CHARACTER PREFIX
	JRST	$DECK1		;AND FALL IN-LINE


$DECK:	PUSHJ	P,GETFS		;GET A FILESPEC
	  POPJ	P,		;ERROR IN FILESPEC??
	MOVEI	T1,'DK'		;TWO CHAR PREFIX
$DECK1:	CLEARM	FILPRV		;STANDARD PROT
	PUSHJ	P,MAKFUN	;AND MAKE A FUNNY NAME IF NECESSARY

	MOVEI	T1,SW.DEC	;LEGAL SWITCHES
	PUSHJ	P,SETSWC	;DO THE SWITCHES
	HRRZS	FILSTS		;JUST IN CASE
	CLEAR	T1,		;NOTHING TO REMEMBER
	PUSHJ	P,FILENT	;ENTER THE FILE
	  POPJ	P,		;LOSE BIGLY
	CLEARM	L.LANG		;SET THE NO-LANG FLAG FOR $EOD ROUTINE
	PJRST	STDECK		;AND GO STACK THE DECK
SUBTTL	Control Cards  --  $RELOC


$RELOC:	MOVSI	T1,'REL'	;GET DEFAULT EXTENSION
	MOVEM	T1,FILEXT	;AND SAVE IT
	PUSHJ	P,GETFS		;GET A FILESPEC
	  POPJ	P,		;FILESPEC ERROR
	MOVEI	T1,'RL'		;LOAD 2 CHARACTER PREFIX
	PUSHJ	P,MAKFUN	;AND MAKE A FUNNY NAME IF NECESSARY

$REL1:	MOVEI	T1,FB.LOD	;LOAD ON NEXT $DATA OR $EXEC
	SKIPGE	FILSTS		;USER-NAMED FILE?
	TXO	T1,FB.DEL	;NAME, DELETE AT THE END
	ON	F.BIN		;SET BINARY FLAG
	PUSHJ	P,FILENT	;ENTER THE FILE AND CREATE FILE-BLOCK
	  POPJ	P,		;SOME KIND OF ERROR
	PJRST	STDECK		;AND DO STACK THE DECK
SUBTTL	Control Cards  --  $INCLUDE


$INCL:	MOVSI	T1,'REL'	;LOAD DEFAULT EXTENSION
	MOVEM	T1,FILEXT	;AND SAVE IT
	PUSHJ	P,GETFS		;GET A FILESPEC
	  POPJ	P,		;FILESPEC ERROR
	MOVE	P1,FILNAM	;GET THE FILENAME
	MOVEI	T1,FSR%		;LOAD FSR ERROR MESSAGE
	PJUMPE	P1,LOGERR	;?FILESPEC REQUIRED

$INCL1:	CLEARM	L.SRH		;CLEAR THE SEARCH FLAG
	MOVEI	T1,SW.INC	;LOAD VALID SWITCH BITS
	PUSHJ	P,SETSWC	;AND SEARCH FOR THE SWITCH
	MOVEI	T1,FB.LOD	;LOAD THE "LOAD" BIT
	SKIPE	L.SRH		;WAS /SEARCH SPECIFIED?
	MOVEI	T1,FB.LOD!FB.SRH;YES, USE "LOAD" AND "SEARCH" BITS
	PUSHJ	P,FBENT		;GO REMEMBER THE FILE
	PJRST	.POPJ1		;AND RETURN SUCCESS
SUBTTL	Control Cards  --  $DATA

$DATA:	PUSHJ	P,GETFS		;GET A FILESPEC
	  POPJ	P,		;FILESPEC ERROR
	SKIPE	FILNAM		;IS IT UNNAMED?
	JRST	$DATA1		;NO, SKIP THIS STUFF
	PUSHJ	P,FUNNY		;GET A FUNNY NAME
	HRLZM	T1,FILNAM	;SAVE 3 CHARACTER NAME
	MOVSI	T1,'CDR'	;DEFAULT EXTENSION IS CDR
	MOVEM	T1,FILEXT	;SAVE IT
	HRROS	FILSTS		;MARK IT AS NQC

$DATA1:	MOVEI	T1,SW.DAT	;LEGAL SWITCHES
	PUSHJ	P,SETSWC	;DO THE SWITCHES

$DATA2:	CLEAR	T1,		;CLEAR FB BITS
	SKIPGE	FILSTS		;IS IT NQC?
	MOVEI	T1,FB.DEL	;YES SET DELETE BIT
IFN FTJSYS,<
	SKIPGE	FILSTS		;IS IT FUNNY NAMED?
	JRST	$DATA5		;YES, HANDLE SPECIAL CASE
>  ;END IFN FTJSYS
	PUSHJ	P,FILENT	;ENTER THE FILE
	  POPJ	P,		;BAD THING?
	SKIPL	FILSTS		;IS IT A NO-CHARGE FILE?
	JRST	$DATA3		;NO, GO STACK
	TELL	CTL,SETCDR	;SET CDR LINE

$DATA3:	SKIPN	L.FBCT		;ANYTHING TO LOAD?
	JRST	$DATA4		;NO, NOTHING TO LOAD
	PUSHJ	P,EXECUT	;PUT IN THE EXECUTE LINE
	  JFCL			;NO ERROR RETURN
	PJRST	STDECK		;AND DO THE STACKING

$DATA4:	STAMP	STERR		;STAMP THE LOG
	TELL	LOG,NFT%	;TELL HIM NOTHING TO LOAD
	PJRST	STDECK		;AND STACK THE DECK

IFN FTJSYS,<
$DATA5:	SKIPE	L.FNNM			;GENERATE A NAME ALREADY?
	JRST	$DAT5A			;YES, CONTINUE ON
	PUSHJ	P,FUNNY			;NO, GET 4 FUNNY CHARS
	LSH	T1,^D12			;AND LEFT JUSTIFY THEM
	MOVEM	T1,Q.DEAD(Q)		;SAVE IN DEADLINE WORD (HACK)
	MOVEM	T1,L.FNNM		;SAVE FOR LATER
	TELL	CTL,SETCDR		;AND PUT SET COMMAND IN CTL
$DAT5A:	MOVE	T2,[ASCII /PS:<S/]
	MOVEM	T2,L.LONG
	MOVE	T2,[ASCII /POOL>/]
	MOVEM	T2,L.LONG+1
	MOVE	T2,[ASCII /CDR-/]
	MOVEM	T2,L.LONG+2
	MOVE	T1,[POINT 7,L.LONG+2,27] ;SETUP TO BUILD THE REST OF THE STRING
	HRRZ	T3,L.USNO		;GET THE USER NUMBER
	PUSHJ	P,$DATA6		;CONVERT TO STRING
	JRST	$DATA7			;AND CONTINUE ON

$DATA6:	IDIVI	T3,10			;DIVIDE BY 8
	PUSH	P,T4			;PUSH THE REMAINDER
	SKIPE	T3			;DONE YET?
	PUSHJ	P,$DATA6		;NO, RECURSE
	POP	P,T3			;GET BACK A DIGIT
	ADDI	T3,"0"			;CONVERT TO ASCII
	IDPB	T3,T1			;DEPOSIT IT INTO STRING
	POPJ	P,			;AND RETURN

$DATA7:	MOVEI	T3,"."			;LOAD A DOT
	IDPB	T3,T1			;AND DEPOSIT IT
	MOVE	T2,[POINT 6,Q.JOB(Q)]	;POINT TO THE JOB NAME
	PUSHJ	P,$DATA8		;DEPOSIT IN STRING
	MOVE	T2,[POINT 6,L.FNNM]	;POINT TO SUFFIX
	PUSHJ	P,$DATA8		;AND DEPOSIT IT ALSO
	JRST	$DATA9			;CONTINUE ON

$DATA8:	ILDB	T3,T2			;GET A CHARACTER
	JUMPE	T3,.POPJ		;NULL, DONE
	ADDI	T3,40			;CONVERT 6BIT TO ASCII
	IDPB	T3,T1			;DEPOSIT IT
	TLNE	T2,770000		;AM I DONE?
	JRST	$DATA8			;NO, LOOP SOME
	POPJ	P,			;DONE, RETURN

$DATA9:	MOVEI	T3,0			;LOAD A NULL
	IDPB	T3,T1			;TERMINATE THE STRING
	MOVE	T2,[FIL,,1]		;ARG,,FUNCTION (CHANNEL,,FNC)
	MOVEM	T2,L.COMP		;STORE IN THE BLOCK
	MOVX	T2,GJ%FOU!GJ%SHT	;LOAD GTJFN FLAGS
	MOVEM	T2,L.COMP+1		;STORE SECOND ARG
	MOVE	T2,[POINT 7,L.LONG]	;LOAD STRING POINTER
	MOVEM	T2,L.COMP+2		;STORE AS 3RD ARG
	MOVX	T1,7B5			;USE 7BIT BYTE
	TXNE	F,F.IMG!F.BIN		;UNLESS BINARY FILE
	MOVX	T1,44B5			;THEN USE 36 BIT BYTES
	TXO	T1,OF%WR		;SET WRITE FLAG
	MOVEM	T1,L.COMP+3		;SAVE IT
	MOVEI	T1,.IOASL		;LOAD ASCII LINE MODE
	TXNE	F,F.IMG!F.BIN		;IS IT BINARY MODE?
	MOVEI	T1,.IOBIN		;YES USE THAT INSTEAD
	MOVEM	T1,L.COMP+4		;SAVE OPEN MODE
	SETZM	L.COMP+5		;CLEAR 6TH ARG
	MOVEI	T2,FILBH		;GET ADR OF BUFFER RING HHDR
	MOVEM	T2,L.COMP+6		;AND STORE 7TH ARG
	SETZM	L.COMP+7		;0 THE LAST ARG
	MOVE	T1,[10,,L.COMP]		;ARG FOR COMPT.
	COMPT.	T1,			;AND ENTER THE FILE
	  HALT
	MOVE	T1,.JBFF		;GET JOBFF BEFORE BUFFERS
	MOVEM	T1,FILOFF		;SAVE IT AWAY
	OUTBUF	FIL,2			;ALLOCATE BUFFERS
	MOVE	T1,.JBFF		;GET JOBFF
	MOVEM	T1,FILNFF		;SAVE JOBFF AFTER BUFFERS
	JRST	$DATA3			;AND CONTINUE IN LINE
>  ;END IFN FTJSYS
SUBTTL	Control Cards  --  $EXECUTE

$EXEC:	SKIPN	L.FBCT		;ANYTHING TO LOAD?
	JRST	$EXEC1		;NO, TELL HIM AND RETURN

	MOVEI	T1,SW.EXE	;LEGAL SWITCHES
	PUSHJ	P,SETSWC	;GET ANY SWITCHES
	PJRST	EXECUT		;AND GO PUT IN EXECUTE LINE

$EXEC1:	STAMP	STERR		;ERROR STAMP
	TELL	LOG,NFT%	;NO FILES TO LOAD
	PJRST	.POPJ1		;AND RETURN
;HERE THE $DATA AND $EXECUTE CARDS MERGE TO GENERATE THE
;EXECUTE COMMAND IN THE CONTROL FILE.

EXECUT:	SETOM	L.LOAD		;FLAG THAT WE ARE DOING A LOAD
	TELL	CTL,ELINE	;PUT IN THE BEGINNING OF THE LINE
	TXZE	F,F.MAP		;WAS /MAP SPECIFIED
	TELL	CTL,[ASCIN(/MAP:LPT:MAP)]
	CHR	CTL,.ASSPC	;AND A SPACE
	CLEAR	T1,		;CLEAR ARG TO FBFND

EXECT1:	PUSHJ	P,FBFND		;LOOP TO GET INDICES OF LOADABLE FILES
	JUMPE	T1,EXECT2	;DONE, GO PRINT THEM
	HRRZ	T2,.FBEXT(T1)	;GET STATUS BITS
	TRNN	T2,FB.LOD!FB.LDR;LOADABLE?
	JRST	EXECT1		;NO, LOOP FOR THE REST
	ANDI	T2,FB.ORD	;AND DOWN TO LOAD ORDER
	MOVEM	T1,L.UUBK(T2)	;SAVE FILE BLOCK ADDRESS
	JRST	EXECT1		;AND LOOP AROUND

EXECT2:	MOVEI	P1,1		;GET STARTING INDEX

EXECT3:	MOVE	P2,L.UUBK(P1)	;GET A FILE TO LOAD
	CAIE	P1,1		;FIRST FILE?
	CHR	CTL,","		;NO, PRINT A COMMA
	MOVEI	T1,.FBDEV(P2)	;LOAD ADDRESS OF FILESPEC 
	MOVE	P4,.FBEXT(P2)	;GET STATUS BITS
	MOVSI	P3,'REL'	;LOAD POSSIBLE EXTENSION
	TRNE	P4,FB.LDR	;LOAD THIS GUY'S REL?
	MOVEM	P3,.FBEXT(P2)	;YES, SAVE REL EXTENSION
	PUSHJ	P,TFLCTL	;TYPE THE FILESPEC INTO THE CTL FILE
	MOVEM	P4,.FBEXT(P2)	;RESTORE STATUS BITS AND EXTENSION
	TRNE	P4,FB.SRH	;LOAD IN LIBRARY SEARCH MODE?
	TELL	CTL,[ASCIZ "/SEARCH"]
	CAMGE	P1,L.FBCT	;GOT THEM ALL?
	AOJA	P1,EXECT3	;NO, LOOP FOR THE REST
	TELL	CTL,CRLF	;YES, PUT IN A CRILIF
	PJRST	.POPJ1		;AND RETURN
SUBTTL	Control Cards  --  $ERROR - $NOERROR - $DUMP - $EOJ

$ERROR:	TELL	CTL,[ASCIZ /^IIF(ERROR) /]
	JRST	$NOER1		;PUT IN REST OF LINE


$NOERR:	TELL	CTL,[ASCIZ /^IIF(NOERROR) /]


$NOER1:	CLEAR	T1,		;BREAK ON EOL
	PUSHJ	P,CTLCRD	;COPY REST OF CARD
	  JFCL			;IGNORE THIS
$NOER2:	TELL	CTL,CRLF	;CRILIF
	PJRST	.POPJ1		;AND RETURN



$DUMP:	HRROS	L.DPCR		;AND FLAG DUMP LINE NEEDED
	PJRST	.POPJ1		;AND SKIP BACK



$EOJ:	ON	F.NEOF		;MAKE ALL THE RIGHT THINGS HAPPEN

IFN FTJSYS,<
	PUSHJ	P,TSTOFF	;CHECK OFF-LINE
>  ;END IFN FTJSYS
	PJRST	ENDJOB		;AND FINISH HIM OFF
SUBTTL	Control Cards  --  $MESSAGE

$MESS:	CLEAR	P1,		;CLEAR WAIT-NOWAIT FLAG
	OFF	F.RSCN		;AND TURN OFF THE RESCAN BIT
	CAIE	C,"/"		;IS THERE A COMMAND SWITCH?
	JRST	$MESS1		;NO, NOWAIT IS DEFAULT
	PUSHJ	P,S$SIX		;YES, GET THE SWITCH
	  PJRST	E$ICS		;ILLEGAL COMMAND SWITCH
	MOVE	T2,[-2,,['NOWAIT'
			 'WAIT  ']]
	PUSHJ	P,UNIQ6		;GET UNIQUE MATCH
	  PJRST	E$ICS		;GUESS NOT!!
	MOVE	P1,T1		;SAVE INDEX AS THE FLAG

$MESS1:	TELL	CTL,[ASCIN(^IMESSAGE )]
	CLEAR	T1,		;BREAK ON EOL
	PUSHJ	P,CTLCRD	;COPY THE REST OF THE CARD
	  JFCL
	SKIPN	P1		;IS IT NOWAIT?
	CHR	CTL,.CHESC	;YES, PUT IN AN ESCAPE!!
	TELL	CTL,CRLF	;PUT IN A CRILIF
	PJRST	.POPJ1		;AND SKIP BACK
SUBTTL	Control Cards  --  $EOD

$EOD:	OFF	F.IMG!F.BIN!F.DOLR
	MOVE	T1,L.DHOL	;LOAD THE DEFAULT BP
	MOVEM	T1,L.CHOL	;AND SAVE FOR THE NEXT CARD
	PUSHJ	P,W$LIST	;GO RESET THE LIST SWITCH
	TXZN	F,F.DECK	;IS THERE A DECK OPEN?
	PJRST	.POPJ1		;NO, SKIP BACK

	TXNE	F,F.FATE	;IS THERE A FATAL ERROR?
	JRST	$EOD3		;YES, DON'T CREATE THE DECK
	SKIPL	L.LANG		;IS IT A $DECK CARD?
	JRST	$EOD1		;YES, HE CAN CREATE A NULL FILE
	SKIPN	DEKCRD		;ANY CARDS WRITTEN?
	JRST	$EOD3		;NO, GO TELL HIM
$EOD1:	STAMP	STMSG		;MESSAGE STAMP
	RELEAS	FIL,		;OTHERWISE CLOSE IT
	MOVE	T1,FILNFF	;GET JOBFF AFTER BUFFERS
	CAME	T1,.JBFF	;ANYTHING BUILT ABOVE IT?
	JRST	$EOD2		;YES, DON'T RECLAIM SPACE
	MOVE	T1,FILOFF	;NO, GET JOBFF BEFORE BUFFERS
	MOVEM	T1,.JBFF	;SAVE IT
				;DON'T SHRINK CORE HERE, SINCE WE WILL
				;EITHER START A NEW DECK OR END THE JOB.

$EOD2:	TELL	LOG,[ASCIZ /File  /]

IFN FTJSYS,<
	SKIPN	L.LONG			;IS THIS A SPOOLED CDR FILE?
	JRST	$EOD2A			;NO, CONTINUE ON
	TELL	LOG,L.LONG		;YES, TYPE THE NAME
	SETZM	L.LONG			;CLEAR WORD FOR NEXT TIME
	JRST	$EOD2B			;AND CONTINUE ON
$EOD2A:> ;END IFN FTJSYS

	MOVEI	T1,DEVFIL	;BASE ADR OF FILE CONTROL CELLS
	PUSHJ	P,TFLLOG	;TYPE FILESEPC INTO THE LOG
IFN FTUUOS,<
	TELL	LOG,[ASCIZ /  Created - ^1 Cards Read - ^2 Blocks Written
/]
>  ;END IFN FTUUOS

IFN FTJSYS,<
$EOD2B:	TELL	LOG,[ASCIZ / Created - ^1 Cards Read
/]
>  ;END IFN FTJSYS
	SKIPE	L.QFN		;NEED TO QUEUE THE FILE?
	PUSHJ	P,QUEFIL	;YES, DO IT
	PJRST	.POPJ1		;AND SKIP BACK

$EOD3:	STAMP	STMSG		;MESSAGE STAMP
	TELL	LOG,[ASCIZ /No File Created
/]
	CLOSE	FIL,CL.RST	;DO A CLOSE RESET
	PJRST	.POPJ1		;AND SKIP BACK
SUBTTL	Control Cards  --  $MODE

$MODE:	MOVEI	T1,SW.MOD	;GET LEGAL SWITCHES
	PUSHJ	P,SETSWC	;DO SWITCHES
	PJRST	.POPJ1		;AND SKIP BACK

;DOMODE -- HERE TO DO A $MODE CARD IN THE MIDDLE OF
;	STACKING A DECK.

DOMODE:	STAMP	STCRD		;STAMP THE LOG
	TELL	LOG,L.CARD	;AND TELL HIM THE CARD
	MOVE	B,[POINT 7,L.CARD+1]
	PUSHJ	P,$MODE		;DO THE MODE STUFF
	  JFCL			;IT SHOULDN'T
	POPJ	P,		;AND CONTINUE STACKING
SUBTTL	Control Cards  --  $TOPS10 - $TOPS20

$TOPS:	MOVEI	T1,SW.TOP		;VALID SWITCH BITS
	PUSHJ	P,SETSWC		;DO THE SWITCHES

$TOPS1:	PUSHJ	P,CDRASC		;GET A CARD
	  JRST	$TOPS6			;EOF!
	TXNE	F,F.FATE		;ERROR?
	POPJ	P,			;YES, RETURN
	LDB	T1,P.CL1A		;GET THE FIRST COLUMN
	CAIE	T1,"$"			;DOLLAR SIGN?
	JRST	$TOPS3			;NO, JUST WRITE IT OUT

$TOPS2:	LDB	T1,P.CL2A		;GET COLUMN 2
	CAIL	T1,"A"			;CHECK FOR AN ALPHABETIC
	CAILE	T1,"Z"
	JRST	$TOPS3			;ITS NOT, JUST WRITE THE CARD
	JRST	$TOPS4			;IT IS, CHECK A FEW OTHER THINGS


$TOPS3:	PUSHJ	P,SUPRES		;SUPPRESS THE CARD
	TELL	CTL!NAC,L.CARD		;WRITE THE CARD INTO CTL FILE
	JRST	$TOPS1			;AND LOOP AROUND

$TOPS4:	TXNN	F,F.DOLR		;ARE WE STACKING /DOL?
	JRST	$TOPS6			;NO, $<ALPHA> STOPS US THEN
	MOVE	T1,L.CARD		;GET FIRST FIVE CHARS
	TRZ	T1,377			;AND DOWN TO 4
	HRLZI	T2,-.NMDEN		;AND SETUP AN AOBJN POINTER

$TOPS5:	CAMN	T1,C.END(T2)		;CHECK LIST OF TERMINATORS
	JRST	$TOPS6			;FOUND ONE!!
	AOBJN	T2,$TOPS5		;LOOP!
	JRST	$TOPS3			;NOT A TERMINATOR

$TOPS6:	TXNN	F,F.EOF			;EOF HIT?
	TXOA	F,F.NXT			;NO, TURN ON NEXT, AND SKIP
	OFF	F.NXT			;YES, TURN OFF NEXT
	PJRST	.POPJ1			;AND SKIP BACK

SUBTTL	Control Cards  --  $SEQUENCE

	UP

$SEQ:	MOVEI	T1,CDRCHR	;ADDRESS OF CHARACTER ROUTINE
	MOVEM	T1,L.SCIN	;FOR THE SCANNERS
	MOVEI	T1,CDRNXT	;ADDRESS OF RECORD ROUTINE
	MOVEM	T1,L.SCLN	;FOR THE SCANNERS
	MOVE	B,P.CL1A
	PUSHJ	P,S$SIX		;SKIP OVER "SEQUENCE"
	  JFCL			;IGNORE THAT
	PUSHJ	P,SETQUE	;SETUP QUEUE AREA
	STAMP	STCRD		;STAMP THE LOG
	TELL	LOG!NAC,L.CARD	;AND WRITE OUT THE SEQUENCE CARD
	PUSHJ	P,S$DEC		;GET DECIMAL SEQUENCE NUMBER
	  SKIPA			;BAD ARGUMENT
	JRST	$SEQ1		;GOOD ARGUMENT
	MOVEI	T1,UCO%		;TYPE THE UCO ERROR
	PUSHJ	P,LOGER1	;SEND IT TO THE LOG AND SKIP
$SEQ1:	MOVEM	T1,Q.SEQ(Q)	;AND STORE THE SEQUENCE WORD
	PUSHJ	P,CDRASC	;GET NEXT CARD
	  POPJ	P,		;EOF NOW?
	MOVE	T1,L.CARD	;GET THE FIRST WORD
	TRZ	T1,377		;ZAP THE LAST 8 BITS
	CAME	T1,C.JOB	;IS IT A JOB CARD?
	  PJRST	FLUSH		;NO!!, FLUSH EVERYTHING
	PJRST	$JOB1		;YES, GO HANDLE JOB CARD
SUBTTL	Control Cards  --  $JOB


$JOB:	MOVEI	T1,CDRCHR	;ADDRESS OF CHARACTER ROUTINE
	MOVEM	T1,L.SCIN	;FOR SCANNERS
	MOVEI	T1,CDRNXT	;ADDRESS OF RECORD ROUTINE
	MOVEM	T1,L.SCLN	;FOR SCANNERS
	PUSHJ	P,SETQUE	;SETUP QUEUE AREA

$JOB1:	OFF	F.PAS2		;CLEAR PASS2 FLAG
	PUSHJ	P,FSUPR		;SUPPRESS THE TRAILING BLANKS
	HRRZ	T1,L.MSGL	;GET OPR MSG LEVEL
	CAIE	T1,2		;DOES HE WANT TO SEE ALL $ CARDS?
	CAIN	T1,1		;DOES HE WANT TO SEE ALL $JOB CARDS?
	TELL	OPR!NAC,L.CARD	;YES, SHOW HIM!!
	CLEARM	L.LOC		;LOCATE HIM HERE

IFN FTFACT,<
	MOVE	T1,L.MYST	;LOAD MY STATION NUMBER
	DPB	T1,P.FSTA	;STORE THE STATION
	CLEAR	T1,		;FOR MY JOB
	RUNTIM	T1,		;GET MY RUNTIME
	IDIVI	T1,^D10		;CONVERT MS TO CS
	MOVNM	T1,L.FRTM	;AND STORE -VE
	HRROI	T1,.GTKCT	;GET KCT'S
	GETTAB	T1,		;GET IT
	  CLEAR	T1,		;SO WHAT
	MOVNM	T1,L.FKCT	;AND STORE IT
	HRROI	T1,.GTRCT	;GETTAB TO DISK READS
	GETTAB	T1,		;GET IT
	  CLEAR	T1,		;OH WELL
	TLZ	T1,777700	;[1051] CLEAR INCREMENTAL READS
	MOVNM	T1,L.FDRD	;STORE IT
	HRROI	T1,.GTWCT	;DISK WRITES
	GETTAB	T1,		;GET IT
	  CLEAR	T1,
	TLZ	T1,777700	;[1051] CLEAR INCREMENTAL WRITES
	MOVNM	T1,L.FDWT	;AND STORE THEM
>;END OF IFN FTFACT

$JOB2:	STAMP	STCRD		;STAMP THE LOG
	TELL	LOG!NAC,L.CARD	;AND TYPE THE JOB CARD
	MOVE	B,[POINT 7,L.CARD+1]
IFN FTUUOS,<
	PUSHJ	P,S$SIX		;NO, GET JOB NAME
	JFCL
	JUMPN	T1,$JOB3	;THERE WAS A NAME!!
>  ;END IFN FTUUOS
	PUSHJ	P,FUNNY		;NO NAME, MAKE A FUNNY ONE
	TLO	T1,'JB '	;JB????
$JOB3:	MOVEM	T1,Q.JOB(Q)	;JOB NAME
	MOVEM	T1,Q.CNAM(Q)	;CONTROL FILE NAME
	MOVEM	T1,Q.LNAM(Q)	;LOG FILE NAME
IFN FTUUOS,<
;START LOOKING FOR PROJECT-PROGRAMMER NUMBER

	CAIE	C,.ASSPC	;WAS BREAK CHAR A SPACE?
	JRST	$JOB5		;NO, CHECK FOR PPN OPENER
	PUSHJ	P,.SCFLS	;YES, FLUSH LEADING SPACES
	  JRST	NOPPN		;EOL, NO PPN SPECIFIED

$JOB5:	CAIE	C,"["		;OPEN SQUARE BRACKET?
	CAIN	C,"<"		;NO, OPEN ANGLE BRACKET?
	JRST	$JOB6		;A MATCH!!
	CAIN	C,"("		;CHECK OPEN PAREN
	JRST	$JOB6		;WIN!

	TXNE	F,F.ICDR	;IS THIS A CDR?
	TXOE	F,F.PAS2	;YES, IS THIS PASS2?
	JRST	NOPPN		;NOT CDR OR PASS2
	CAIN	C,"/"		;IS IT THE BEGINNING OF A SWITCH?
	JRST	NOPPN		;YES, NO PPN ON CARD
	ON	F.INHI		;TURN ON "INHIBIT INPUT"
	MOVE	T1,P.NDBP	;GET NON-DEFAULT MODE BP
	CAMN	T1,L.CRLC	;DID WE USE IT ON PASS1?
	MOVE	T1,P.DFBP	;YES, SET DEFAULT
	MOVEM	T1,L.CHOL	;AND SAVE THE OTHER
	PUSHJ	P,CDRASC	;AND RE-READ THE CARD
	  HALT	.		;***CAN'T HAPPEN***
	JRST	$JOB2		;AND TRY AGAIN

$JOB6:	PUSHJ	P,S$OCT		;GET PROJECT NUMBER
	  PJRST	IPPNF		;???
	HRLZM	T1,Q.PPN(Q)	;SAVE PROJECT NUMBER
	CAIE	C,","		;BREAK ON COMMA?
	JRST	IPPNF		;NO, BAD FORMAT
	PUSHJ	P,S$OCT		;GET PROGRAMMER NUMBER
	  SKIPA			;NO NUMBER THERE, CHECK WILDCARD
	JRST	$JOB7		;GOT A NUMBER!!
	CAIE	C,"#"		;IS IT A WILDCARD?
	JRST	IPPNF		;NO, BAD FORMAT
	PUSHJ	P,@L.SCIN	;SKIP TO NEXT CHARACTER
	  JFCL			;IGNORE EOL
	MSTIME	T1,		;GET RANDOM NUMBER (RANDOM?)
	TXO	T1,1B18		;MAKE IT GT 400000
	TXZ	T1,1B19!1B20	;FOLLOW CONVENTION
$JOB7:	HRRM	T1,Q.PPN(Q)	;SAVE PROGRAMMER NUMBER
	CAIE	C,.ASSPC	;WAS BREAK CHARACTER A SPACE?
	JRST	$JOB8		;NO, LOOK FOR CLOSER
	PUSHJ	P,.SCFLS	;YES, FLUSH SPACES
	  JRST	IPPNF		;BAD FORMAT FOR PPN
$JOB8:	CAIE	C,"]"		;CLOSE SQUARE BRACKET?
	CAIN	C,">"		;OR CLOSE ANGLE BRACKET
	JRST	$JOB9		;YES, WIN!!
	CAIE	C,")"		;FINALLY, CLOSE PAREN
	JRST	IPPNF		;NO!!!!
;NOW DO SOME CHECKING, AND GET THE SWITCHES AND ACCOUNTING INFO

$JOB9:	SKIPE	L.PRIV		;AM I GOD?
	JRST	$JOB10		;YES!!
	MOVE	T1,L.MYPP	;NO, GET MY PPN
	CAME	T1,Q.PPN(Q)	;IS THE JOB MINE?
	JRST	NOTYRS		;NO, TELL HIM
	HRROI	T1,.GTNM1	;FIRST HALF OF USER NAME
	GETTAB	T1,		;GET IT
	  CLEAR	T1,		;GUESS IT AINT THERE
	MOVEM	T1,Q.USER(Q)	;SAVE IT
	HRROI	T1,.GTNM2	;AND THE SECOND HALF
	GETTAB	T1,		;GET IT
	  CLEAR	T1,		;OH WELL,
	MOVEM	T1,Q.USER+1(Q)	;AND SAVE IT
>  ;END IFN FTUUOS

IFN FTJSYS,<
	MOVEI	T1,L.UNAM	;LOAD ADDRESS OF BLOCK
	PUSHJ	P,S$STRG	;GET A STRING
	SETZM	Q.USER(Q)
	SETZM	Q.USER+1(Q)
	MOVE	T1,[POINT 7,L.UNAM]
	MOVE	T2,[POINT 6,Q.USER(Q)]	;POINT TO QUEUE AREA
	MOVEI	T3,^D12			;LOAD A COUNT
$JOB9:	ILDB	T4,T1			;GET A CHARACTER
	JUMPE	T4,$JOB10		;DONE IF NULL
	SUBI	T4,40			;CONVERT TO 6BIT
	IDPB	T4,T2			;DEPOSIT IT
	SOJG	T3,$JOB9		;AND LOOP
>  ;END IFN FTJSYS

$JOB10:
IFE A%SPRS,<
	TXZ	F,F.SPS		;[1063] RESET /SUPPRESS ON $JOB CARD
>
IFN A%SPRS,<
	TXO	F,F.SPS		;[1063] RESET /SUPPRESS ON $JOB CARD
>
	MOVE	T1,[-.NMJSW,,JSWTCH]
	MOVE	T2,[SW.JOB,,JADRS] ;VAL SW BITS,,DIS ADR
	PUSHJ	P,DOSWCH	;DO THE SWITCHES
	PUSHJ	P,STLPQ		;GET LPTSXX (ONLY USE THE SXX)
	HRRM	T1,Q.DEV(Q)	;AND STORE IT
	PUSHJ	P,DOACCT	;CHECK ACCOUNTING
	  PJRST	BADACT		;LOSE BIG!!
IFN FTUUOS,<
	MOVSI	T1,Q.IDDI(Q)	;ADDRESS OF USER'S PATH
	HRRI	T1,Q.CDIR(Q)	;FOR CTL FILE
	BLT	T1,Q.CDIR+5(Q)	;BLITTTTT
	MOVSI	T1,Q.IDDI(Q)	;AND AGAIN ADDRESS OF PATH
	HRRI	T1,Q.LDIR(Q)	;FOR LOG FILE
	BLT	T1,Q.LDIR+5(Q)	;BLLLIITTTTTT
>  ;END IFN FTUUOS
	PUSHJ	P,MAKCTL	;MAKE EVERYTHING
	TXNE	F,F.FATE	;IS FATE ON?
	PJRST	BADACT		;YES, GO ABORT JOB
	PJRST	.POPJ1		;WIN!!
SUBTTL	$JOB Card Subroutines

;^;+SETQUE  -- Routine to Setup the QUEUE parameter area.
;	SETQUE BLTs the prototype QUEUE header into the parameter
;	area, clears the rest, and sets the default uniqueness.  Also
;	initially  loads AC Q with the base address of the queue AREA.
;-;#2

SETQUE:	MOVEI	Q,L.QUE		;LOAD BASE ADDRESS OF PARAMETER AREA
	MOVE	T1,[L.QUE,,L.QUE+1]
	SETZM	L.QUE		;CLEAR THE FIRST WORD OF TE QUEUE AREA
	BLT	T1,Q.LMOD(Q)	;AND ZERO THE REST OF THE BLOCK
	MOVX	T1,<<%QOSPT>B29+.QORCR+2B23>
	MOVEM	T1,Q.OPR(Q)	;SETUP THE OPR WORD
	MOVX	T1,<BYTE (9) .QIHED,Q.FMOD+1 (18) 2>
	MOVEM	T1,Q.LEN(Q)	;AND SAVE Q.LEN WORD
	MOVSI	T1,'INP'	;GET QUEUE NAME
	MOVEM	T1,Q.DEV(Q)	;AND SAVE IT
	MOVE	T1,L.UNIS	;GET DEFAULT UNIQUESS
	SKIPGE	L.PRIV		;AM I PRIVILEGED?
	JRST	SETQU1		;YES, ALLOW /UNI:2
	CAIN	T1,.QIUSD	;NO, IS IT RUN IN UNIQUE SFD?
	SOS	T1		;YES, CHANGE IT TO UNIQUE:1
SETQU1:	DPB	T1,P.UNI	;DEPOSIT IT
	MOVE	T1,L.MCOR	;GET CORE LIMIT
	HRLM	T1,Q.ILIM(Q)	;STORE IN QUEUE REQUEST
	MOVSI	T1,'LOG'	;LOG FILE EXTENSION
	MOVEM	T1,Q.LEXT(Q)	;STORE IT
	MOVSI	T1,'CTL'	;CONTROL FILE EXTENSION
	MOVEM	T1,Q.CEXT(Q)	;STORE IT
	MOVX	T1,<QF.LOG!QF.NFH+111001>	;GET FMOD BITS
	MOVEM	T1,Q.LMOD(Q)	;FOR LOG FILE
	TXZ	T1,QF.LOG	;TURN OFF LOG-BIT
	MOVEM	T1,Q.CMOD(Q)	;AND STORE FOR CTL FILE
	POPJ	P,		;AND RETURN
;SPECIAL CASE ROUTINES

IFN FTUUOS,<
NOPPN:	SKIPE	L.PRIV		;AM I GOD?
	JRST	NOPPN1		;YES, LOSE BIG
	MOVE	T1,L.MYPP	;USE MY PPN
	MOVEM	T1,Q.PPN(Q)	;AND SAVE IT
	JRST	$JOB9		;AND CONTINUE PARSING JOB CARD

NOPPN1:	MOVEI	T1,IPP%		;ADDRESS OF MESSAGE
	JRST	NOLOG		;AND DO SOMETHING ABOUT IT


IPPNF:	MOVEI	T1,IFP%		;ADDRESS OF BAD FORMAT MESSAGE
	JRST	NOLOG		;AND LOSE GRACEFULLY

NOTYRS:	TELL	OPR,NYP%	;TELL THE OPERATOR FIRST
	MOVEI	T1,NYP%		;NOT YOUR PPN
>  ;END IFN FTUUOS
				;FALL INTO NOLOG ROUTINE


NOLOG:	PUSHJ	P,LOGERR	;LOG THE ERROR
BADACT:	PUSHJ	P,NOJOB		;ENTER THE LOG
	PJRST	ABORT		;AND ABORT THE JOB
;+LOGINI -- Routine to initialize the LOG file.  LOGINI
;	initializes all the I/O flags and pointers, and puts the
;	STDAT introductory message in.
;-;#2

LOGINI:	CLEARM	LOGBH		;FLAG THAT OPEN AND ENTER HAVEN'T BEEN DONE
	CLEARM	LOGBC		;FORSE BUFFER CREATION
	MOVE	T1,.JBFF	;GET ADDRESS FOR FIRST BUFFER
	MOVEM	T1,LOGAD	;AND STORE IT
	HRLI	T1,440700	;MAKE A BYTE POINTER
	MOVEM	T1,LOGBP	;AND STORE IT

;PUT IN INITIAL STUFF
	TELL	LOG,CRLF	;START WITH A CRILIF
	STAMP	STDAT		;INTRODUCTION
	DATE	T1,		;GET THE DATE
	IDIVI	T1,^D31		;GET DAY-1 IN T2
	ADDI	T2,1		;MAKE IT DAY-0
	RAD10	LOG,T2		;AND PRINT IT
	IDIVI	T1,^D12		;GET MONTH-1 IN T2
	TELL6	LOG,MONTAB(T2)	;AND PRINT MONTH NAME
	ADDI	T1,^D64		;AND OFFSET FOR YEAR
	RAD10	LOG,T1		;AND PRINT IT
	CHR	LOG,.ASSPC	;AND A SPACE
	TELL	LOG!NAC,L.SYSN	;PRINT SYSNAM
	TELL	LOG,SPTNAM	;PRINT MY NAME
	POPJ	P,		;AND RETURN
;NOJOB -- ROUTINE TO INITALIZE THE PARAMETER AREA SO WE CAN QUEUE
;	A LOG FILE WHICH HAS LOST ITS JOB.

NOJOB:	MOVE	T1,Q.LNAM(Q)	;GET LOG FILE NAME
	MOVEM	T1,Q.JOB(Q)	;SAVE AS JOB NAME
	MOVSI	T1,DEFDSK	;GET DSK
	MOVEM	T1,Q.LSTR(Q)	;SAVE FOR LOG
	MOVEI	T1,.QFDDE	;LOAD /DISP:DEL
	DPB	T1,[POINTR(Q.LMOD(Q),QF.DSP)]

IFN FTUUOS,<
	MOVE	T1,L.MYPP	;USE MY PPN
	MOVEM	T1,Q.PPN(Q)	;PUT IT THERE
	MOVSI	T1,L.SL1+SLLEN+.PTPPN
	HRRI	T1,Q.LDIR(Q)	;POINTER TO BLT PATH
	BLT	T1,Q.LDIR+5(Q)	;LOG GOES IN MY PATH
>  ;END IFN FTUUOS

IFN FTJSYS,<
	MOVEI	T1,L.MYNM	;POINT TO MY NAME
	MOVEM	T1,Q.PPN(Q)	;STORE FOR THE LOG REQUEST
>  ;END IFN FTJSYS

	MOVEI	T1,L.SL1	;GET MY ORIG S/L
	PUSHJ	P,SETSRC	;AND SET IT
	SKIPE	Q.USER(Q)	;IS THERE A NAME?
	PJRST	MAKLOG		;YES, USE IT
	MOVE	T1,['SPRINT']	;ELSE USE 'SPRINT ERROR'
	MOVE	T2,[' ERROR']
	MOVEM	T1,Q.USER(Q)	;SAVE FIRST HALF
	MOVEM	T2,Q.USER+1(Q)	;AND SECOND HALF
	PJRST	MAKLOG		;ENTER THE LOG AND RETURN
;ROUTINES TO CREATE CTL AND LOG FILES

MAKCTL:	PUSHJ	P,CLRUUO	;CLEAR THE UUO BLOCK
	MOVE	T1,Q.CNAM(Q)	;GET CTL FILE NAME
	MOVEM	T1,RIBNAM	;SAVE IN UUO BLOCK
	MOVE	T1,Q.CEXT(Q)	;EXTENSION
	MOVEM	T1,RIBEXT	;SAVE
	SETZM	RIBPPN		;DEFAULT PPN
	MOVE	T1,L.PPR	;GET PRESERVED PROTECTION
	MOVEM	T1,RIBPRV	;AND STORE IT
	MOVEI	T1,.RBSTS	;NUMBER OF UUO ARGS
	MOVEM	T1,RIBCNT	;STORE IT
	MOVEI	T1,RP.NQC	;GET NQC BIT
	MOVEM	T1,RIBSTS	;AND SAVE IT
	MOVEI	T1,.IOASL	;OPEN LOG IN ASCII-LINE MODE
	MOVSI	T2,DEFDSK	;USE DSK FOR NOW
	MOVSI	T3,CTLBH	;BUFFER-RING HEADER
	OPEN	CTL,T1		;OPEN IT UP
	  JRST	CNTOPN		;CAN'T DO IT
	ENTER	CTL,L.UUBK	;ENTER IT
	  JRST	CNTENT		;CAN'T DO IT
	MOVE	T1,RIBDEV	;GET REAL DEVICE
	MOVEM	T1,Q.CSTR(Q)	;AND SAVE IT
				;AND FALL INTO LOG FILE MAKER
MAKLOG:	PUSHJ	P,CLRUUO	;CLEAR UUO BLOCK
	MOVE	T1,Q.LNAM(Q)	;GET LOG FILE NAME
	MOVEM	T1,RIBNAM	;STORE IT
	MOVE	T1,Q.LEXT(Q)	;EXTENSION
	MOVEM	T1,RIBEXT	;AND STORE IT ALSO
	SETZM	RIBPPN		;SET DEFAULT PPN
	MOVEI	T1,.RBSTS	;NUMBER OF UUO ARGUMENTS
	MOVEM	T1,RIBCNT	;SO FILSER KNOWS
	MOVEI	T1,.IODMP	;DUMP MODE
	MOVSI	T2,DEFDSK	;GET THE CORRECT DEVICE
	CLEAR	T3,		;NO BUFFERS
	OPEN	LOG,T1		;OPEN THE LOG
	  JRST	CNTOPN		;I CAN'T
	LOOKUP	LOG,L.UUBK	;LOOKUP THE LOG
	  JFCL			;OH WELL, GUESS WE CREATE IT
MAKLG1:	MOVEI	T2,RP.NQC	;NQC BIT
	MOVEM	T2,RIBSTS	;AND SET IT
	ENTER	LOG,L.UUBK	;ENTER THE LOG
	  JRST	CNTENT		;I CAN'T DO THAT
	MOVE	T1,RIBSIZ	;GET FILE-SIZE
	ADDI	T1,^D127	;COUNT THE PARTIAL BLOCK
	IDIVI	T1,^D128	;AND CONVERT TO BLOCKS
	USETO	LOG,1(T1)	;SET THE BLOCK NUMBER
	SETOM	LOGBH		;AND FLAG THAT IT'S ENTERED
	MOVE	T1,RIBDEV	;GET THE DEVICE
	MOVEM	T1,Q.LSTR(Q)	;AND SAVE IT
	POPJ	P,		;AND RETURN


;LOG AND CTL FILE ERROR ROUTINES


CNTOPN:	TELL	OPR,COD%
	JRST	ABEND

CNTENT:	HRRZ	T3,RIBEXT	;GET ERROR CODE
	STAMP	STERR		;STAMP THE ERROR
	TELL	OPR!LOG,CCC%
	TELL	OPR!LOG,@UUOMSG(T3)	;UUO ERROR MESSAGE
	TELL	OPR!LOG,CRLF	;CRLF
	MOVE	T1,RIBPPN	;GET RIBPPN
	CAMN	T1,L.MYPP	;MY PPN?
	JRST	ABEND		;YES, LOSE
	ON	F.FATE		;TURN ON FATE
	POPJ	P,		;AND RETURN
;JOB CARD SWITCHES

	DEFINE JNAMES,<
	Y	AFTER,SW.JOB
	Y10	CARDS,SW.JOB
	Y10	CORE,SW.JOB
	Y10	CHARGE,SW.JOB
	Y10	DEADLINE,SW.JOB
	Y	DEPEND,SW.JOB
	Y	ERROR,SW.JOB
	Y10	FEET,SW.JOB
	Y10	HOLLERITH,SW.JOB
	Y	JOBNAME,SW.JOB
	Y10	LOCATE,SW.JOB
	Y	LOGDISP,SW.JOB
	Y10	NAME,SW.JOB
	Y	OUTPUT,SW.JOB
	Y	PAGES,SW.JOB
	Y	PRIORITY,SW.JOB
	Y	RESTART,SW.JOB
	Y	NORESTART,SW.JOB
	Y	SEQUENCE,SW.JOB
	Y	TIME,SW.JOB
	Y10	TPLOT,SW.JOB
	Y	UNIQUE,SW.JOB
>

	DEFINE	Y10(A,B),<
	IFN FTUUOS,<
	Y	A,B
	>>

	DEFINE Y(A,B),<
	XLIST
	<SIXBIT /A/>
	LIST
	SALL>

JSWTCH:	JNAMES

	.NMJSW==.-JSWTCH

	DEFINE Y(A,B),<
	XLIST
	XWD	B,W$'A
	LIST
	SALL>

JADRS:	JNAMES
SUBTTL	$JOB Card Switch Subroutines


;/CARDS
W$CARD:	PJSP	T1,SWTDEC	;HANDLE DECIMAL SWITCH VALUE
	XWD	0,777777	;MIN, MAX
	POINTR(Q.ILM2(Q),QM.CDP);POINTER TO RESULTS

;/CORE
W$CORE:	PUSHJ	P,S$DEC		;GET DECIMAL ARGUMENT
	  PJRST	E$USV		;GARBAGE!!
	JUMPE	T1,.POPJ	;USE DEFAULT IF ZERO
	CAIE	C,"P"		;DID HE SPECIFY PAGES?
	ASH	T1,1		;NO, MULTIPLY BY 2
	ASH	T1,11		;AND BY 2**9
W$COR1:	HRLM	T1,Q.ILIM(Q)	;STORE IT
	POPJ	P,		;AND RETURN

;/DEPEND
W$DEPE:	PJSP	T1,SWTDEC	;DECIMAL VALUE
	XWD	0,177777	;MIN,MAX
	POINTR(Q.IDEP(Q),QI.DEP);WHERE TO PUT RESULTS

;/FEET
W$FEET:	PJSP	T1,SWTDEC	;DECIMAL ARGUMENT
	XWD	0,777777	;MIN,MAX
	POINTR(Q.ILM3(Q),QM.PTP);POINTER TO RESULTS

;/LOCATE
W$LOCA:	PJSP	T1,SWTOCT	;HANDLE OCTAL SWITCH VALUE
	XWD	1,77		;MIN,MAX
	POINT	18,L.LOC,35	;PUT IT IN L.LOC

;/PAGES
W$PAGE:	PJSP	T1,SWTDEC	;DECIMAL ARGUMENT
	XWD	0,777777	;MIN,MAX
	POINTR(Q.ILM2(Q),QM.LPT);POINTER TO USE FOR SWITCH VALUE

;/CHARGE
W$CHAR:	PUSHJ	P,S$SIX		;GET SIXBIT ARGUMENT
	  PJRST	E$MSV		;MISSING SWITCH VALUE
	MOVEM	T1,Q.CNO(Q)	;STORE IN Q.CNO
	POPJ	P,		;AND RETURN

;/JOBNAME
W$JOBN:	PUSHJ	P,S$SIX		;GET SIXBIT VALUE
	  PJRST	E$MSV		;NOT THERE?
	MOVEM	T1,Q.JOB(Q)	;STORE IT
	MOVEM	T1,Q.CNAM(Q)	;SAVE AS CTL FILE NAME
	MOVEM	T1,Q.LNAM(Q)	;AND AS LOG FILE NAME
	POPJ	P,		;AND RETURN
;/TIME
W$TIME:	PUSHJ	P,S$TIM		;GET A TIME-SPEC
	  JRST	E$USV		;SOMETHING ILLEGAL
	MOVEI	T1,^D3600	;START CONVERTING TO SECS
	IMULM	T1,L.HRS	;SEC/HRS
	MOVEI	T1,^D60		;SEC/MIN
	IMUL	T1,L.MIN
	ADD	T1,L.HRS	;AND ADD THEM UP
	ADD	T1,L.SEC	;ADD IN SECONDS
	HRRM	T1,Q.ILIM(Q)	;STORE AWAY
	POPJ	P,


;/ERROR:CHK:IBC:HOL
W$ERRO:	PUSHJ	P,S$TIM		;GET WHAT LOOKS LIKE A TIME SPEC
	  JRST	E$USV		;GIVE  ERROR MESSAGE
	MOVE	T1,L.HRS	;GET HRS
	MOVEM	T1,L.UCHK	;AND MAKE IT CHKSUM ERRORS
	MOVE	T1,L.MIN	;GET MINUTES
	MOVEM	T1,L.UIBC	;AND MAKE IT ILL BIN CARDS
	MOVE	T1,L.SEC	;AND GET SECONDS
	MOVEM	T1,L.UHOL	;AND MAKE THEM HOLLERITH ERRORS
	POPJ	P,		;AND RETURN

;/HOLLERITH
W$HOLL:	PUSHJ	P,S$SIX		;GET A SIXBIT ARGUMENT
	  PJRST	E$MSV		;MISSING ARGUMENT
	MOVE	T2,[-.NMCTY,,CODTYP]
	PUSHJ	P,UNIQ6		;GET A UNIQ MATCH
	  PJRST	E$USV		;VALUE OUT OF RANGE
	MOVE	T1,P.COD(T1)	;GET THE RIGHT BYTE-POINTER
	MOVEM	T1,L.DHOL	;SAVE AS DEFAULT
	MOVEM	T1,L.CHOL	;AND FOR NEXT CARD
	POPJ	P,		;AND RETURN
;/NAME
W$NAME:	MOVE	T2,[POINT 6,Q.USER(Q)]
	PUSHJ	P,.SCFLS	;FLUSH LEADING SPACES, AND LOAD CHAR
	  POPJ	P,		;JUST RETURN - EOL
	CAIE	C,42		;IS IT A DOUBLE QUOTE?
	CAIN	C,"'"		;OR A SINGLE QUOTE?
	  JRST	W$NAM4		;YES, GO GET QUOTED STRING
	JRST	W$NAM2		;JUMP INTO LOOP

W$NAM1:	PUSHJ	P,.SCIN		;GET A CHAR
	  POPJ	P,		;EOL, RETURN
W$NAM2:	CAIN	C,"/"		;BEGINNING OF NEXT SWITCH
	POPJ	P,		;YES, RETURN
	PUSHJ	P,W$NAM9	;DEPOSIT IT
	JRST	W$NAM1		;AND LOOP

;HERE ON A QUOTED STRING
W$NAM4:	MOVEM	C,L.ACC+1	;SAVE QUOTE CHARACTER
W$NAM5:	PUSHJ	P,.SCIN		;GET A CHARACTER
	  POPJ	P,		;EOL, RETURN
	CAMN	C,L.ACC+1	;IS IT A QUOTE?
	JRST	W$NAM6		;YES, GO COUNT IT
	PUSHJ	P,W$NAM9	;ELSE, DEPOSIT CHARACTER
	JRST	W$NAM5		;AND LOOP AROUND

W$NAM6:	PUSHJ	P,.SCIN		;GET NEXT CHARACTER
	  POPJ	P,		;EOL FINISHES US OFF
	CAME	C,L.ACC+1	;IS IT A QUOTE?
	  POPJ	P,		;NO, WE DONE!!
	PUSHJ	P,W$NAM9	;YES!,PRINT A QUOTE
	JRST	W$NAM5		;AND LOOP AROUND

W$NAM9:	CAMN	T2,[600,,Q.USER+1(Q)]	;DONE?
	POPJ	P,		;YES, NO-OP
	SUBI	C,.ASSPC	;CONVERT TO 6BIT
	IDPB	C,T2		;DEPOSIT
	POPJ	P,		;AND RETURN
;/PRIO
W$PRIO:	PJSP	T1,SWTDEC	;GET DECIMAL VALUE
	XWD	0,76		;MIN,MAX
	POINTR(Q.PRI(Q),QP.PRI)	;WHERE TO PUT IT

;/RESTART
W$REST:	MOVSI	T1,(QI.NRS)	;GET THE NORESTART BIT
	ANDCAM	T1,Q.IDEP(Q)	;TURN IT OFF
	POPJ	P,		;AND RETURN

;/NORESTART
W$NORE:	MOVSI	T1,(QI.NRS)	;GET NOT-RESTART BIT
	IORM	T1,Q.IDEP(Q)	;SET IT
	POPJ	P,		;AND RETURN

;/SEQUENCE
W$SEQU:	PJSP	T1,SWTDEC	;GET DECIMAL ARGUMENT
	XWD	0,777777	;MIN,MAX
	POINT	18,Q.SEQ(Q),35	;WHERE TO PUT IT

;/TPLOT
W$TPLO:	PJSP	T1,SWTDEC	;GET DECIMAL ARGUMENT
	XWD	0,777777	;MIN,MAX
	POINTR(Q.ILM3(Q),QM.PLT);POINTER FOR RESULTS

;/UNIQUE
W$UNIQ:	PJSP	T1,SWTDEC	;GET DECIMAL ARGUMENT
	XWD	0,2		;MIN,MAX
P.UNI:	POINTR(Q.IDEP(Q),QI.UNI);POINTER TO RESULTS

;/OUTPUT
W$OUTP:	PUSHJ	P,S$SIX		;GET SIXBIT ARG
	  PJRST	E$MSV		;GIVE ERROR
	MOVE	T2,[-3,,['NOLOG '
			 'LOG   '
			 'ERROR ']]
	PUSHJ	P,UNIQ6		;GET UNIQUE MATCH
	  PJRST	E$USV		;BAD SWITCH VALUE
	MOVE	T1,[EXP %EQONL,%EQOLG,%EQOLE](T1)
	DPB	T1,[POINTR(Q.IDEP(Q),QI.OUT)]
	POPJ	P,		;AND RETURN

;/LOGDISP
W$LOGD:	PUSHJ	P,S$SIX		;GET SIXBIT ARGUMENT
	  PJRST	E$MSV		;MISSING SWITCH VALUE
	MOVE	T2,[-2,,['PRESER'
			 'DELETE']]
	PUSHJ	P,UNIQ6		;GET UNIQUE MATCH
	  PJRST	E$USV		;UNRECOGNIZED SWITCH VALUE
	MOVE	T1,[EXP .QFDPR,.QFDDE](T1)
	DPB	T1,[POINTR(Q.LMOD(Q),QF.DSP)] ;DEPOSIT THE CODE
	POPJ	P,		;AND RETURN
;/AFTER
W$AFTE:	PUSHJ	P,.SCDT		;GET DATE-TIME SPEC
	  PJRST	E$BDT		;BAD FORMAT
	MOVEM	T1,Q.AFTR(Q)	;STORE IN QUEUE REQUEST
	POPJ	P,		;AND RETURN


;/DEADLINE
W$DEAD:	PUSHJ	P,.SCDT		;GET A DATE-TIME SPEC
	  PJRST	E$BDT		;BAD FORMAT
	MOVEM	T1,Q.DEAD(Q)	;SAVE IT
	POPJ	P,		;AND RETURN
	DOWN

;NOEOF -- THIS ROUTINE IS CALLED BY CONTRL WHEN A $JOB, $SEQUENCE,
;	CARD IS FOUND IN A DECK.  NOEOF ASSUMES
;	AN EOF CARD WAS FORGOTTEN, PLACES A MESSAGE IN THE
;	LOG, SETS F.NXT AND F.NEOF.  TAKES ERROR RETURN
;	(NON-SKIP) WHICH WILL GET US UP TO MAIN PROGRAM LOOP.

NOEOF:	STAMP	STERR		;STAMP THE LOG
	TELL	LOG,NEF%	;PLACE A MESSAGE THERE
	ON	F.NXT!F.NEOF	;SET SOME BITS
	PJRST	ENDJOB		;AND FINISH HIM OFF


;HERE, IF AN EXTRANEOUS PASSWORD CARD IS FOUND.  TELL USER JUST THAT!

PASCRD:	MOVEI	T1,EPF%		;EXTRANEOUS PASSWORD
	PJRST	LOGER1		;LOG IT AND SKIP BACK
SUBTTL	Routines To Finish Off a Job

;^;+ENDJOB -- Routine to finish off a job normally.
;	Puts CREF, DUMP, DELETE lines into CTL file,
;	and goes off to queue up the job.
;-;#2

ENDJOB:	PUSHJ	P,$EOD		;END DECK IN PROGRESS IF ANY
	  JFCL			;NO ERROR RETURN FOR $EOD
	STAMP	STSUM		;A SUMMARY LINE
	TELL	LOG,[ASCIZ /End of Job Encountered
/]
	PUSHJ	P,SUMARY	;GIVE SUMMARY
;**;[1071] Insert @ ENDJOB+6L	JNG	23-Oct-75
	TELL	CTL,ERRLIN	;[1071] ALWAYS PUT %ERR INTO CTL FILE
	MOVE	T1,L.DPCR	;GET DUMP AND CREF FLAGS
	SKIPGE	T1		;IS DUMP SIDE (LH) SET?
	TELL	CTL,DUMLIN	;YUP!
	TRNE	T1,-1		;CREF?
	TELL	CTL,CRFLIN	;YES
	CLEARB	P1,P2		;CLEAR A FLAG AND A COUNTER
	CLEARB	T1,P3		;CLEAR ARGUMENT TO FBFND

ENDJB1:	MOVE	T1,P3		;LOAD THE LAST VALUE RETURNED
	PUSHJ	P,FBFND		;GET A FILE
	JUMPE	T1,ENDJB4	;GO TYPE CRLF WHEN DONE
	MOVE	P3,T1		;SAVE THE ADDRESS
	MOVE	P4,.FBEXT(T1)	;GET THE EXTENSION WORD
	TRNN	P4,FB.DEL!FB.DLR;IS IT DELETABLE?
	JRST	ENDJB1		;NO, GET NEXT FILE
	JUMPN	P2,ENDJB2	;HAVE WE PRINTED DELETE COMMAND YET?
	SETO	P2,		;NO, FLAG THAT WE ARE
	TELL	CTL,DELLIN	;PUT IN DELETE LINE
	SKIPA			;SKIP COMMA FIRST TIME THRU

ENDJB2:	CHR	CTL,","		;PUT IN A COMMA
	MOVE	T1,P3		;LOAD THE ADDRESS
	PUSHJ	P,TFLCTL	;TYPE FILESPEC INTO CTL
	MOVSI	T1,'REL'	;GET REL EXTENSION
	HLLM	T1,.FBEXT(P3)	;STORE IT
	TRZE	P4,FB.DLR	;DEL THIS GUY'S REL?
	AOJA	P1,ENDJB2	;YES, INCR NUMBER PRINTED, AND DO REL
ENDJB3:	CAIGE	P1,5		;TYPED 6 YET?
	AOJA	P1,ENDJB1	;NO, LOOP SOME MORE
	CLEARB	P1,P2		;SETUP TO PRINT THE NEXT LINE
	TELL	CTL,CRLF	;PUT IN A CRILIF
	JRST	ENDJB1		;AND KEEP LOOPING

ENDJB4:	SKIPE	P2		;ANYTHING ON THE LINE?
	TELL	CTL,CRLF	;YES, FINISH IT OFF
	PUSHJ	P,QUEJOB	;QUEUE UP THE JOB
	PJRST	DOFACT		;AND DO THE FACT FILE STUFF
;+KILJOB -- Routine to Kill off a job due to KILL command.
;	Just puts a message in the LOG  and calls ABORT.
;-;#2
KILJOB:	STAMP	STOPR		;OPR ACTION CAUSED IT
	TELL	LOG,ABO%	;ABORTED BY OPERATOR
	JRST	ABORT1		;AND CLEAN UP AFTER "ME"
;+ABORT -- Routine to abort a job.  Puts necessary messages
;	in the LOG, deletes temp files, and flushes to EOJ.
;-;#2
ABORT:	ON	F.FATE		;TURN ON THE FATE BIT
	STAMP	STSUM		;GIVE A SUMMARY
	TELL	LOG,[ASCIZ /Job Aborted due to Fatal Error
/]
	SKIPL	L.MSGL		;DO OPR WANT TO SEE FATAL CARD?
	JRST	ABORT1		;NO, DON'T SHOW HIM
	MOVE	T1,L.CARD	;YES, GET FIRST FIVE CHARS
	TRZ	T1,377		;ZAP LAST 8 BITS
	MOVEI	T2,T1		;GET ADDRESS OF MESSAGE (MAYBE)
	CAME	T1,[ASCII /$PAS/] ;DOES IT LOOK LIKE A PASSWORD CARD?
	MOVEI	T2,L.CARD	;NO, TYPE ENTIRE CARD OUT
	TELL	OPR!NAC,(T2)	;DO IT!!!

ABORT1:	OFF	F.BTCH!F.DECK	;NO BATCH JOB HERE NOR A DECK
	PUSHJ	P,SUMARY	;GIVE SUMMARY
	CLOSE	CTL,CL.RST	;RESET THE CTL FILE
	CLOSE	FIL,CL.RST	;RESET THE USER'S FILE
	PUSHJ	P,QUELOG	;QUEUE THE LOG FILE TO LPT
	PUSHJ	P,DOFACT	;AND CHARGE HIM

	MOVEI	T1,16		;DUMP MODE
	MOVEM	T1,L.ACC	;USE AS OPEN BLOCK
	CLEARM	L.ACC+1		;  "       "
	CLEARB	T1,L.ACC+2	;  "       " & CLEAR ARG TO FBFND

ABORT2:	PUSHJ	P,FBFND		;GET A FILE
	PJUMPE	T1,FLUSH	;NO MORE, DONE
	MOVE	P1,.FBEXT(T1)	;GET EXTENSION AND STATUS WORD
	TRNN	P1,FB.DEL!FB.DLR;IS IT DELETABLE?
	JRST	ABORT2		;NO, DON'T WORRY ABOUT IT
	MOVE	P1,.FBNAM(T1)	;GET FILENAME
	MOVE	P2,.FBDEV(T1)	;GET DEVICE
	CAMN	P2,L.ACC+1	;SAME AS LAST TIME?
	JRST	ABORT3		;YES, SKIP OPEN
	MOVEM	P2,L.ACC+1	;STORE STR NAME
	OPEN	FIL,L.ACC	;OPEN THE CHANNEL
	  JRST	ABORT2		;I REALLY DON'T CARE

ABORT3:	HLLZ	P2,.FBEXT(T1)	;LOAD EXTENSION
	CLEAR	P3,

IFN FTUUOS,<
	MOVEI	P4,Q.IDDI-2(Q)	;GET USER'S PATH
>  ;END IFN FTUUOS

	LOOKUP	FIL,P1		;LOOK IT UP
	  JRST	ABORT2		;CAN'T WORRY ABOUT IT
	CLEARB	P1,P2		;ZAP NAME
	RENAME	FIL,P1		; FOR DELETE UUO
	  JFCL			;IT'S NOT IMPORTANT
	JRST	ABORT2		;JUST KEEP LOOPING
;ROUTINE TO DO ACCOUNTING AT THE END OF A JOB

	UP

IFE FTFACT,<
DOFACT:	POPJ	P,>

IFN FTFACT,<
DOFACT:	SETO	T1,		;FOR OUR TTY NUMBER
	GETLCH	T1		;GET IT'S LICH
	DPB	T1,P.FTTY	;AND STORE IN ENTRY
	MOVE	T1,Q.PPN(Q)	;GET USER'S PPN
	MOVEM	T1,L.FPPN	;STORE IT
	CLEAR	T1,		;CLEAR FOR RUNTIME
	RUNTIM	T1,		;GET RUNTIME
	IDIVI	T1,^D10		;CONVERT MS TO CS
	ADDM	T1,L.FRTM	;ADD IN
	HRROI	T1,.GTKCT	;GET TAB TO KCTS
	GETTAB	T1,		;GET TAB IT
	  CLEAR	T1,		;LOSE
	ADD	T1,L.FKCT	;ADD IT IN
	IMULI	T1,^D100	;MULITPLY BY 100
	IDIV	T1,L.JFSC	;AND DIVIDE BY JIFSEC
	MOVEM	T1,L.FKCT	;AND STORE KCORE-CENTISECS
	HRROI	T1,.GTRCT	;DISK READS
	GETTAB	T1,		;GET THEM
	  CLEAR	T1,		;LOSE
	TLZ	T1,777700	;[1051] CLEAR INCREMENTAL READS
	ADDM	T1,L.FDRD	;ADD THEM IN
	HRROI	T1,.GTWCT	;DISK WRITES
	GETTAB	T1,		;AND THEM ALSO
	  CLEAR	T1,		;LOSE
	TLZ	T1,777700	;[1051] CLEAR INCREMENTAL WRITES
	ADDM	T1,L.FDWT	;ADD THEM IN
	MOVE	T1,Q.SEQ(Q)	;GET USER'S SEQUENCE NUMBER
	MOVEM	T1,L.FSEQ	;SAVE IT
	MOVE	T1,CDRCNT	;GET CDRCNT
	TXNE	F,F.BTCH	;ARE WE SUBMITTING BATCH JOB?
	TXO	T1,1B0		;YES, SET THE BIT
	MOVEM	T1,L.FWRK	;AND SAVE # CARDS READ
	MOVE	T1,[.FSIZE+1,,L.FACT]	;POINTER FOR THE DAEMON
	DAEMON	T1,		;LIKE MAGIC!!!!
	  SKIPA			;NOT GOOD ENOUGH THOUGH
	POPJ	P,		;WIN AND RETURN

	TELL	OPR,DUF%	;GIVE AN ERROR
	RAD08	OPR,T1		;AND THE ERROR CODE
	TELL	OPR,CRLF	;AND A CRLF
	POPJ	P,		;AND RETURN

	MSG(DUF,W,N,DAEMON UUO Failed - Code )

> ;END OF IFN FTFACT

	DOWN
;+SUMARY -- Routine to give summary statistics at the end of
;	a job.  Stamps with STSUM.  The routine is driven
;	by two tables, SUMTB1 and SUMTB2.  SUMTB1 contains
;	a list of addresses of locations to be printed
;	in decimal, and SUMTB2 contains a list of addresses
;	of messages.
;-;#2

SUMARY:	CLEAR	T1,		;CLEAR A COUNTER
SUMAR1:	SKIPN	@SUMTB1(T1)	;IS IT A ZERO?
	JRST	SUMAR2		;YES, DON'T TYPE IT
	STAMP	STSUM		;SUMMARY STAMP
	RAD10	LOG,@SUMTB1(T1)	;TYPE THE NUMBER
	CHR	LOG,.ASSPC	;AND A SPACE
	TELL	LOG,@SUMTB2(T1)	;AND THE MESSAGE
SUMAR2:	CAIGE	T1,.NMSMM-1	;GOT ALL THE SUMMARY MESSAGES?
	AOJA	T1,SUMAR1	;NO, LOOP AROUND FOR THE NEXT ONE
	POPJ	P,		;YES, RETURN!

SUMTB1:	EXP	CDRCNT		;NUMBER OF CARDS READ
	EXP	L.THOL		;NUMBER OF HOLLERITH ERRORS
	EXP	L.TIBC		;NUMBER OF ILLEGAL BINARY CARDS
	EXP	L.TCHK		;NUMBER OF CHECKSUM ERRORS

	.NMSMM==.-SUMTB1

SUMTB2:	[ASCIC(Cards Read)]
	[ASCIC(Hollerith Errors)]
	[ASCIC(Illegal Binary Cards)]
	[ASCIC(Binary Checksum Errors)]
;+FLUSH -- Routine to flush the input stream until the next
;	EOF, or $EOJ, $JOB, $SEQ.
;-
;CALL:
;	PUSHJ P,FLUSH
;	  RETURN HERE ALWAYS

FLUSH:	TXNE	F,F.EOF		;IS EOF ON?
	POPJ	P,		;YES, JUST RETURN
;[1054] FLUSH 1 1/2 JHT 3/5/75
	OFF	F.NXT!F.BUSY	;TURN THESE OFF
	PUSHJ	P,CDRASC	;GET A CARD
	  POPJ	P,		;EOF, RETURN
	MOVE	T1,L.CARD	;GET FIRST 5 CHARACTERS OF CARD
	TRZ	T1,377		;ZAP LAST 8 BITS
	CAMN	T1,C.EOJ	;EOJ CARD?
	POPJ	P,		;YES, RETURN
	ON	F.NXT		;IF WE MATCH, WE'VE GOT NEXT CARD
	MOVSI	T2,-.NMJCR	;NUMBER OF POSSIBLE START CARDS
FLUSH1:	CAMN	T1,C.JOB(T2)	;MATCH?
	POPJ	P,		;YUP, RETURN
	AOBJN	T2,FLUSH1	;LOOP
	JRST	FLUSH		;AND, LOOP
SUBTTL	Non-$JOB Card Switch Subroutines

;/ASCII
W$ASCI:	OFF	F.IMG!F.BIN
	MOVE	T1,P.ASC	;LOAD ASCII MODE POINTER
	MOVEM	T1,L.CHOL	;AND SAVE FOR READ ROUTINE
	POPJ	P,		;TURN EVERYTHING OFF, AND RETURN

;/026
W$BCD:
W$026:	OFF	F.IMG!F.BIN	;TURN THESE OFF
	MOVE	T1,P.026	;LOAD 026 POINTER
	MOVEM	T1,L.CHOL	;AND SAVE FOR READ ROUTINE
	POPJ	P,		;AND RETURN

;/BINARY
W$BINA:	OFF	F.IMG		;TURN THESE OFF
	ON	F.BIN		;TURN THIS ON
	POPJ	P,		;AND RETURN

;/IMAGE
W$IMAG:	OFF	F.BIN		;"   "
	ON	F.IMG		;"   "
;[1060] W$IMAG + 1 1/2
	CAIE	C,":"		;ANY ARGUMENT?
	 JRST	W$IMA1		; NO, TAKE DEFAULT
	PUSHJ	P,S$DEC
	  JFCL
	SKIPG	T1		;WAS THERE AN ARG?
W$IMA1:	MOVEI	T1,2		;NO, MAKE IT 2
	MOVEM	T1,L.IMGT	;AND STORE IT
	POPJ	P,		;AND RETURN

;/SUPPRESS - /NOSUPPRESS
W$NOSU:	TXZA	F,F.SPS		;CLEAR SUPPRESS FLAG
W$SUPP:	ON	F.SPS		;SET SUPPRESS FLAG
	POPJ	P,		;AND RETURN

;/LIST - /NOLIST
W$LIST:	SKIPA	T1,[SIXBIT "/LIST"]
W$NOLI:	CLEAR	T1,		;CLEAR THE LISTING SWITCH
	MOVEM	T1,L.LSW	;STORE IT
	POPJ	P,		;AND RETURN

;/SEARCH
W$SEAR:	SETOM	L.SRH		;SET THE SEARCH FLAG
	POPJ	P,		;AND RETURN

;/PROTECT
W$PROT:	PJSP	T1,SWTOCT	;GET OCTAL SWITCH VALUE
	XWD	000,777		;MIN,MAX
	POINT	9,FILPRV,8	;WHERE TO PUT IT
;/CREF
W$CREF:	MOVE	T1,[SIXBIT "/CREF"]
	MOVEM	T1,L.LSW	;STORE /CREF SWITCH
	HLLOS	L.DPCR		;FLAG IT FOR LATER
	POPJ	P,		;AND RETURN

;/WIDTH
W$WIDT:	PJSP	T1,SWTDEC	;GET DECIMAL ARGUMENT
	XWD	1,^D80		;MIN,MAX
	POINT	18,L.WIDT,35	;POINTER TO RESULTS

;/MAP - /NOMAP
W$NOMA:	TXZA	F,F.MAP		;TURN OFF MAP BIT
W$MAP:	ON	F.MAP		;TURN ON A BIT
	POPJ	P,		;AND RETURN

;/DOLLAR - /NODOLLAR
W$NODO:	TXZA	F,F.DOLR	;TURN OFF DOLLAR BIT
W$DOLL:	TXO	F,F.DOLR	;TRUN ON DOLLAR BIT
	POPJ	P,		;RETURN

;/PRINT
W$PRIN:	MOVSI	T1,'LPT'
	JRST	QSWRET

;/TPUNCH
W$TPUN:	MOVSI	T1,'PTP'
	JRST	QSWRET

;/CPUNCH
W$CPUN:	MOVSI	T1,'CDP'
	JRST	QSWRET

;/PLOT
W$PLOT:	MOVSI	T1,'PLT'

QSWRET:	MOVEM	T1,L.QFN	;STORE DEVICE
	POPJ	P,		;AND RETURN
SUBTTL	Control Card Common Subroutines

COMMENT /
;^;++

	Control Card Common Subroutines


The following routines are used by many of the Control Card
processors.

Routines are:

	GETFS	Get a filespec