Google
 

Trailing-Edge - PDP-10 Archives - bb-d868b-bm_tops20_v3a_2020_dist - 3a-sources/d60spt.mac
There are 2 other files named d60spt.mac in the archive. Click here to see a list.
SUBTTL	Larry Samberg/LSS/JHT/JNG	24 AUG 77 (+EGF/JBS 24-MAY-77)


;ASSEMBLY AND LOADING INSTRUCTIONS
;	.COMPILE D60SPT
;	.LOAD D60QMR,HELPER,CSPMEM,CSPQSR,SBSCOM,D60SPT
;	.SSAVE D60SPT



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


	SALL			;SUPPRESS MACRO EXPANSIONS


;VERSION INFORMATION
	D6SVER==1		;MAJOR VERSION NUMBER
	D6SMIN==0		;MINOR VERSION NUMBER
	D6SEDT==3		;DN60 EDIT LEVEL
	D6SWHO==0		;WHO LAST PATCHED

	%D6S==<BYTE (3)D6SWHO(9)D6SVER(6)D6SMIN(18)D6SEDT>


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

	TWOSEG			;TWO SEGMENT PROGRAM
	RELOC	400000		;START IN HISEG
	..SEG==1		;FLAG FOR UP-DOWN MACROS



;COPYRIGHT (C) 1977, 1978 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;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'"+D6SMIN-1,<
		STOPI
		IFIDN <LETTER><@>,<
		  IFE D6SWHO,< .NAME(\D6SVER,,\D6SEDT,)>
		  IFN D6SWHO,< .NAME(\D6SVER,,\D6SEDT,-WHO)>>
		IFDIF <LETTER><@>,<
		  IFE D6SWHO,< .NAME(\D6SVER,LETTER,\D6SEDT,)>
		  IFN D6SWHO,< .NAME(\D6SVER,LETTER,\D6SEDT,-WHO)>>>>>
	IFGE D6SMIN-^D26,< D6SMIN==0
	  PRINTX %MINOR VERSION TOO LARGE - IGNORED>
	IFGE D6SWHO-7,< D6SMIN== 
	  PRINTX %SPTWHO IS TOO LARGE - IGNORED>
	.CLNM(@ABCDEFGHIJKLMNOPQRSTUVWXYZ,\D6SWHO)
>

;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
;		 (NOW OBSOLETE) /JBS
;
;
;                        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 RELEASE 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.
;
;1	DN60 ADDITIONS - LCG ADVANCED SOFTWARE GROUP
;	INCLUDES EDIT 2024 - REMOVING .REQUIRE FOR HELPER
;
;3	ADD /ACCOUNT SWITCH ON THE $JOB CARD.
;	INSERT CODE TO DO USAGE ACCOUNTING ON THE -20.

;[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


	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

	ND	FTJOBQ,-1	 ;ENABLE SPRINT TO READ FROM THE "JOB" QUEUE.



;--
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
IFN FTJOBQ,<
.MYSTA::BLOCK	1		;D60QMR KNOWN THIS NAME FOR STATION NUMBER
> ;(LOCATE UUO DOESN'T WORK IN TOPS-20
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
>

IFN FTJOBQ,<
;
; WHEN READING 026 CARDS FROM AN IBM 3780, THE IBM 3780'S CARD
;  READER ASSUMES THEY ARE EBCDIC CARDS AND THE DN60
;  TRANSLATES THAT EBCDIC TO ASCII.  THUS THE FILE THAT IS GIVEN
;  TO SPRINT HAS SOME INCORRECT CHARACTERS.  SINCE SPRINT IS THE
;  FIRST PROGRAM TO KNOW THAT THE TRANSLATION HAS BEEN WRONG
;  (BY SCANNING THE JOB CARD) SPRINT MUST TRANSLATE THIS "NEARLY
;  RIGHT" ASCII TO "RIGHT" ASCII.  SPRINT DOES THIS IF THE
;  FOLLOWING CELL IS SET NON-ZERO.
;
L.2629:	BLOCK	1		;-1 TO CONVERT 026 ASCII TO REAL (029) ASCII.
;
> ;END OF IFN FTJOBQ
;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	20		;GTDIR INFORMATION
L.ACNT:	BLOCK	10		;ACCOUNT STRING
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
L.RTM:	BLOCK	1		;STORE RUNTIME
L.DTM:	BLOCK	1		;STORE DAYTIME
L.TBLK:	BLOCK	1		;TOTAL NUMBER OF BLOCKS WRITTEN
>  ;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
IFN FTJOBQ,<
	SETZ	T1,		;LET CSPQSR DO THE PSISER WORK
	PUSHJ	P,CSPINI##	;INITIALIZE MEMORY MANAGEMENT, ETC.
	MOVEI	T1,HEAP		;INITIALIZE HEAP SPACE
	MOVEM	T1,HEAPTR
>
;
;			CONTINUED ON NEXT PAGE
;
;
; CONTINUE WITH INITIALIZATION
;
	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
IFN FTJOBQ,<
	SKIPE	JOBQUE		;ARE WE RUNNING TO THE JOB QUEUE?
	PUSHJ	P,JOBXIT	;YES, SAY "GOODBY" TO QUASAR
>
	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?
STCOMD:	MOVSI	P1,'DSK'	;NO, USE DISK AS DEFAULT
STCOMB:	DEVNAM	P1,		;FIND REAL NAME
IFE	FTJOBQ,<
	  JRST	STCOMF		;NO SUCH DEVICE?
>;END IFE FTJOBQ
IFN	FTJOBQ,<
	JRST	[	CLEARM	JOBQUE		;ASSUME NOT USING JOB QUE
			MOVE	P1,CDRDEV	;DEVNAM WIPED THIS
			CAME	P1,[SIXBIT \JOBQUE\]
			  JRST	STCOMF		;NOT READING FROM JOB QUE
			PUSHJ P,JOBINI		;INITIALIZE QUASAR INTERFACE
			SETOM	JOBQUE		;READING FROM JOB QUE
			JRST	STCOMD]		; PRETEND DISK
>;END IFN FTJOBQ
	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
;
; HERE IF ALL IS WELL.
;
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:
IFN	FTJOBQ,<
	SKIPN	JOBQUE		;ALLOW NON PHYSICAL
>;END IFN FTJOBQ
	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
IFE FTJOBQ,<
	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
IFE FTJOBQ,<
	MOVE	T1,.JBFF	;GET CURRENT JOBFF
>
IFN FTJOBQ,<
	MOVE	T1,HEAPTR	;GET CURRENT HEAP POINTER
>
	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
IFN	FTJOBQ,<
	SETZM	JOBLMT		;INIT CARDS EXCEEDED COUNTER
	SETOM	L.NTRY		;NO RETRYS
>;END IFN FTJOBQ
	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
IFE	FTJOBQ,<
	  JRST	IDLE		;JOBINT!!  (OR AN EXTRA EOF CARD)
>;END IFE FTJOBQ
IFN	FTJOBQ,<
	JRST	[TXNE	F,F.EOF	;EOF?
		 SKIPN	JOBQUE	;USING JOB QUE?
		JRST	IDLE	;NOT EOF OR NOT USING JOB QUE
		JRST	SETJDN]	;GO RELEASE THE QUE ENTRY
>;END IFN FTJOBQ
;
; PROCESS CARDS
;
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
IFN	FTJOBQ,<
	SETZM	L.2629		;ASSUME 029 ALWAYS
>;END IFN FTJOBQ
	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
IFN	FTJOBQ,<
	SKIPE	JOBQUE		;USING JOB QUE?
	  JRST	SETJDN		;GO RELEASE AND IDLE IF NECESSARY
>;END IFN FTJOBQ
	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:
IFN	FTJOBQ,<
	SKIPE	JOBQUE		;READING FROM "JOB" QUE
	  JRST	IDLEJQ		;YES, SO NO DUMMY RESET
>;END IFN FTJOBQ
	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
;
; COME HERE AT END OF A JOB FROM THE 'JOB' QUEUE
;
IFN	FTJOBQ,<

SETJDN:	TXZN	F,F.EOF		;AT EOF?
	JRST	SETUP		;NO, MAYBE ANOTHER JOB TO PROCESS
	PUSHJ	P,JOBREL	;RELEASE THIS QUEUE ENTRY AND DISPOSE OF FILE
	RELEAS	CDR,		;RELEASE DEVICE
	OFF	F.GTIN		;FLAG ITS GONE
	TXNN	F,F.DCOM	;DEFFERED COMMAND?
	  JRST	IDLEJQ		;NO, ENTER JOB IDLE LOOP
	PUSHJ	P,GETHGH	;MAKE SURE I HAVE MY HIGH SEG
	PUSHJ	P,DODEF		;GO DO THE DEFFERRED COMMAND
IDLEJQ:	PUSHJ	P,RELHGH	;GET RID OF MY HIGH SEG
	MOVX	T1,<HB.RTL+^D60000> ;WAIT FOR TYPEIN OR 1 MIN
	HIBER	T1,		;WAIT
	  JFCL			;OH WELL
	PUSHJ	P,CHKOPR	;PROCESS OPR TYPEIN, IF ANY
	JRST	SETUP		;AND TRY FOR ANOTHER JOB
>;END IFN FTJOBQ
;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
IFE	FTJOBQ,<
	  PJRST	ENDJOB		;END OF FILE = END OF JOB
>;END IFE FTJOBQ
IFN	FTJOBQ,<
	  JRST	[	SKIPL	JOBLMT	;CARD LIMIT EXCEEDED?
			  PJRST	ENDJOB	;NO
			PJRST	ABORT1 ]	;YES
>;END IFN FTJOBQ
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
IFN	FTJOBQ,<
	SKIPGE	JOBLMT		;CARD LIMIT EXCEEDED
	  JRST	ABORT1		;YES
>;END IFN FTJOBQ
	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
IFN	FTJOBQ,<
	SKIPE	JOBQUE		;USING THE JOB QUE?
	 SKIPL	JOBLMT		;YES, LIMIT EXCEEDED?
	  SKIPA			;ALL IS OK
	   POPJ	P,		;JOB LIMIT EXCEEDED
>;END IFN FTJOBQ
	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:
IFN	FTJOBQ,<
	SKIPN	JOBQUE		;ARE WE USING JOB QUE?
	  JRST	GETNJB		;NO
	TXNE	F,F.DCOM	;ANY DEFFERED COMMANDS?
	  POPJ	P,		;YES, DON'T CALL THE QMANGR
	PUSHJ	P,JOBGET	;NO, GET A JOB
	 POPJ	P,		;THERE IS NONE.
GETNJB:
>;END IFN FTJOBQ
	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
IFN FTJOBQ,<
	SKIPN	JOBQUE		;ARE WE READING FROM THE JOB QUEUE?
	JRST	SPT1		;NO.
	PUSHJ	P,JOBREL	;YES, RELEASE CURRENT JOB
	RELEAS	CDR,		;RELEASE INPUT DEVICE
	OFF	F.GTIN		;WE NO LONGER HAVE DEVICE
	POPJ	P,		; AND GIVE ERROR RETURN.
>
IFE FTJOBQ,<
	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
IFE FTJOBQ,<
	CAME	T1,.JBFF	;ANYTHING BUILT ABOVE IT?
>
IFN FTJOBQ,<
	CAME	T1,HEAPTR	;ANYTHING IN THE HEAP ABOVE IT?
>
	JRST	$EOD2		;YES, DON'T RECLAIM SPACE
	MOVE	T1,FILOFF	;NO, GET JOBFF BEFORE BUFFERS
IFE FTJOBQ,<
	MOVEM	T1,.JBFF	;SAVE IT
>
IFN FTJOBQ,<
	PUSHJ	P,SHRINK	;RECLAIM SPACE
>
				;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
IFE	FTJOBQ,<
	  JRST	$TOPS6			;EOF!
>;END IFE FTJOBQ
IFN	FTJOBQ,<
	  JRST	[	SKIPL	JOBLMT	;CARD LIMIT EXCEEDED?
			  JRST	$TOPS6	;NO
			POPJ	P, ]	;YES
>;END IFN FTJOBQ
	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,<
IFN FTUUOS,<
	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 IFN FTUUOS
IFN FTJSYS,<
	GTAD			;GET TIME AND DATE
	MOVEM	T1,L.DTM	;STORE IT
	MOVX	T1,.FHSLF	;GET FORK HANDLE
	RUNTM			;GET CURRENT RUNTIME
	MOVNM	T1,L.RTM	;STORE IT
>  ;END IFN FTJSYS
>;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!
IFN	FTJOBQ,<
	SKIPE	JOBQUE		;USING THE JOB QUE?
	 SKIPE	L.2629		;YES, ARE WE ALREADY IN 026 MODE?
	  JRST	$JOBNQ		;NOT THE JOB QUE OR JOB QUE + TRY 026
	SETOM	L.2629		;NOW FLAG IN 026 CONVERT MODE
	MOVE	B,[POINT 7,L.CARD,34]	;CONVERT EVERYTHING AFTER $JOB
$JOB26:	LDB	C,B		;GET A CHAR FROM CARD JUST READ
	PUSHJ	P,C2629		;COVERT FROM 026 TO ASCII
	CAIN	C,12		;AT THE END?
	  JRST	$JOB2		;YES, RUN THROUGH AGAIN TRYING
				; THE CONVERT FROM 026 TO ASCII
	DPB	C,B		;PUT THE CHAR BACK INTO L.CARD
	IBP	B		;SET FOR THE NEXT CHAR
	JRST	$JOB26		;LOOP CONVERTING THE CARD
$JOBNQ:
>;END IFN FTJOBQ

	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		;FORCE BUFFER CREATION
IFE FTJOBQ,<
	MOVE	T1,.JBFF	;GET ADDRESS FOR FIRST BUFFER
>
IFN FTJOBQ,<
	MOVE	T1,HEAPTR	;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
IFN	FTJOBQ,<
	SKIPE	JOBQUE		;READING FROM THE JOB QUEUE?
	  JRST	LOGIN2		;YES
>;END IFN FTJOBQ
	TELL	LOG,SPTNAM	;PRINT MY NAME
	POPJ	P,		;AND RETURN
IFN	FTJOBQ,<
LOGIN2:	TELL	LOG,SPTNMJ	;PRINT MY NAME
	STAMP	STMSG		;
	TELL	LOG,[ASCIN(Job: )]
	TELL6	LOG,JOBJOB+.EQJOB ;GIVE THE JOB NAME
	TELL	LOG,[ASCIN(  Seq: )]
	LOAD	T1,JOBJOB+.EQSEQ,EQ.SEQ ;GET SEQUENCE NUMBER
	RAD10	LOG,T1		;GIVE THE SEQ NUMBER
	TELL	LOG,CRLF	;GIVE A FINAL CRLF
	POPJ	P,		;NOW RETURN TO CALLER
>;END IFN FTJOBQ
;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
IFN FTJOBQ,<
	PUSH	P,.JBFF##	;SAVE JOBFF
	MOVE	T1,HEAPTR	;ALLOCATE BUFFERS IN THE HEAP
	MOVEM	T1,.JBFF##
	MOVEI	T1,2*203	;SIZE OF 2 BUFFERS
	PUSHJ	P,EXPND		;ALLOCATE ROOM IN THE "HEAP"
	OUTBUF	CTL,2		;ONLY USE 2 BUFFERS AS
				; THE "HEAP" IS A FIXED SIZE
	MOVE	T1,.JBFF##	;NEW END OF HEAP
	MOVEM	T1,HEAPTR
	POP	P,.JBFF##	;RESTORE JOBFF
>;END IFN FTJOBQ
				;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
IFN FTJSYS,<
	Y	ACCOUNT,SW.JOB
>  ;END IFN FTJSYS
>

	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
IFN FTJSYS,<
W$ACCOUNT:
	MOVEI	T1,L.ACNT	;POINT TO ACCOUNT BLOCK
	PUSHJ	P,S$STRG	;GET THE STRING
	MOVEI	T1,L.ACNT	;POINT TO ACCOUNT BLOCK
	MOVEM	T1,Q.CNO(Q)	;STORE AWAY FOR QMANGR
	POPJ	P,		;AND RETURN
>  ;END IFN FTJSYS
	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,<
IFN FTUUOS,<
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 IFN FTUUOS
IFN FTJSYS,<

DOFACT:	MOVX	T1,.FHSLF		;GET FORK HANDLE
	RUNTM				;GET RUNTIME
	ADDM	T1,L.RTM		;GET RUNTIME FOR THE JOB
	MOVE	T1,L.TBLK		;GET NUMBER OF BLOCKS WRITTEN
	ADDI	T1,3			;ROUND IT UP
	IDIVI	T1,4			;CONVERT TO PAGES
	MOVEM	T1,L.TBLK		;STORE IT
	MOVEI	T1,.USENT		;WRITE AN ENTRY
	MOVEI	T2,ACTLST		;GET ADDRESS OF BLOCK
	USAGE				;ACCOUNT FOR THE WORLD
	ERCAL	[TELL OPR,[ASCIZ /?SPTUJF  USAGE JSYS FAILED
/]
		POPJ	P,]		;RETURN FROM ERCAL
	POPJ	P,			;AND RETURN
ACTLST:	USENT.	(.UTINP,1,1)
	USJNO.	(-1)
	USTAD.	(-1)
	USTRM.	(-1)
	USLNO.	(-1)
	USPNM.	(<SIXBIT /D60SPT/>,US%IMM)
	USPVR.	(%D6S,US%IMM)
	USAMV.	(-1)
	USNOD.	(-1)
	USACT.	(<-1,,L.ACNT>)
	USSRT.	(L.RTM)
	USSDR.	(0,US%IMM)
	USSDW.	(L.TBLK)
	USJNM.	(Q.JOB(Q))
	USQNM.	(<SIXBIT /INP/>,US%IMM)
	USSDV.	(CDRNAM)
	USSSN.	(Q.SEQ(Q))
	USSUN.	(CDRCNT)
	USCRT.	(L.DTM)
	USDSP.	(<SIXBIT /BATCH/>,US%IMM)
	USTXT.	(<-1,,[ASCIZ / /]>)
	USPRI.	(0,US%IMM)
	0				;END OF LIST
>  ;END OF IFN FTJSYS

> ;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
	LOGERR	Type an error message into the LOG file
	SETSWC	Set-up to call DOSWCH
	SFDSET	Routine to setup PPN for ENTER-LOOKUP
	DOSWCH	Process Switches
	FNDSWC	Routine to scan for a slash
	SWTOCT	Routine to process octal value switches
	SWTDEC	Routine to process decimal value switches
	FILENT	ENTER a user file
	CHKENT	CHKACC an ENTER
	ENTERT	Process ENTER errors
	MAKFUN	Routine to setup default filespecs
	FUNNY	Funny Name Generator
	STDECK	Routine to call the correct stacking routine
	CTLCRD	Routine to copy from current card to CTL file.

;--;^
/
;+GETFS -- Routine to read a filespec from Control Card.
;GETFS assumes that the filespec should be stored in the file
;	device control cells.  Sets the default device to DSK, and
;	fills in default PPN from Q.PPN if necessary.
;-;#2

;  !-------------------------------------------------------!
;  !                      GETFS (B)                        !
;  !                 +1 IF FILESPEC ERROR                  !
;  !                     +2 OTHERWISE                      !
;  !-------------------------------------------------------!


GETFS:	MOVEI	T1,DEVFIL	;DEVICE CONTROL CELLS
	MOVSI	T2,DEFDSK	;DSK IS DEFAULT DEVICE
	MOVEM	T2,.CCDEV(T1)	;SAVE IT
	PUSHJ	P,S$FILE	;GET THE FILESPEC
	  PJRST	LOGERR		;FILESPEC ERROR

GETFS1:	MOVE	T1,FILDEV	;GET THE SPECIFIED DEVICE
	DEVCHR	T1,		;GET CHARACTERISTICS
	TXNN	T1,DV.DSK	;IS IT A DISK?
	JRST	GETFS6		;NO, TELL HIM HE LOSES
	SKIPN	FILPPN		;SKIP IF DIRECTORY WAS SPECIFIED
	JRST	.POPJ1		;ELSE, JUST RETURN
	MOVE	T2,FILPTH+2	;GET PPN FROM PATH BLOCK
	MOVE	T1,Q.PPN(Q)	;GET DEFAULT PPN
	TLNN	T2,-1		;WAS PROJECT NUMBER SPECIFIED
	HLLM	T1,FILPTH+2	;NO, DEFAULT IT
	TRNN	T2,-1		;WAS PROGRAMMER NUMBER SPECIFIED
	HRRM	T1,FILPTH+2	;NO, DEFAULT IT TOO
	PJRST	.POPJ1		;AND RETURN


GETFS6:	MOVEI	T1,DND%		;DEVICE NOT A DISK
	JRST	LOGERR		;AND LOG THE ERROR
;+LOGERR -- Routine to type an error message into the LOG.
;	Call with T1 containing the address of the message.
;	LOGERR stamps the LOG and prints the message.  If
;	the first character of the message is a "?", set
;	F.FATE bit.
;-;#2

;  !-------------------------------------------------------!
;  !                    LOGERR - LOGER1 (B)                !
;  !                     +1  IF LOGERR                     !
;  !                     +2  IF LOGER1                     !
;  !=======================================================!
;  !   AC    !        CALLED        !       RETURNED       !
;  !-------------------------------------------------------!
;  !   T1    !  ADDRESS OF MESSAGE  !         ---          !
;  !-------------------------------------------------------!


LOGER1:	AOS	(P)		;SET FOR SKIP RETURN
LOGERR:	STAMP	STERR		;ERROR STAMP
	TELL	LOG,(T1)	;PRINT THE MESSAGE
	LDB	T1,[POINT 7,0(T1),6]
	CAIN	T1,"?"		;IS THE FIRST CHARACTER A QUESTION MARK?
	ON	F.FATE		;YES, SET FATAL ERROR BIT
	POPJ	P,		;AND RETURN
;+SETSWC -- Routine to setup for and call DOSWCH to search
;	the non-$JOB card switch table.  Sets up the ACs
;	and calls DOSWCH.
;-;#2

;  !-------------------------------------------------------!
;  !                        SETSWC (B)                     !
;  !                      +1   ALWAYS                      !
;  !                      +2   NEVER                       !
;  !=======================================================!
;  !   AC    !        CALLED        !       RETURNED       !
;  !-------------------------------------------------------!
;  !   T1    !  VALID SWITCH BITS   !         ---          !
;  !-------------------------------------------------------!


SETSWC:	MOVS	T2,T1		;GET XWD VALID SW BITS,0
	HRRI	T2,SADRS	;GET XWD VAL SW BITS,DISTAB ADR
	MOVE	T1,[-.NMSW,,SWTCH]
	PJRST	DOSWCH		;AND CALL DOSWCH
;+DOSWCH -- Routine to process switches.  Call with T1 con-
;	taining -table length,,table address and T2 containing
;	valid switch bits,,dispatch table address.
;-;#2

;  !-------------------------------------------------------!
;  !                       DOSWCH (B)                      !
;  !                      +1  ALWAYS                       !
;  !                      +2  NEVER                        !
;  !=======================================================!
;  !   AC    !        CALLED        !       RETURNED       !
;  !-------------------------------------------------------!
;  !   T1    !-LENGTH,,TABLE ADDRESS!         ---          !
;  !-------------------------------------------------------!
;  !   T2    !SW. BITS,,DISP TBL ADR!         ---          !
;  !-------------------------------------------------------!

DOSWCH:	MOVEM	T1,DOSW.A	;SAVE -TABLEN,,TABADR
	MOVEM	T2,DOSW.B	;SAVE BITS,,DISPADR

DOSWC1:	PUSHJ	P,FNDSWC	;GO FIND A SWITCH
	  POPJ	P,		;EOL, RETURN
	PUSHJ	P,S$SIX		;GET SWITCH NAME
	  JRST	DOSWC2		;ILLEGAL CHARACTER
	MOVEM	T1,L.SWCH	;SAVE WHAT WE'VE GOT
	MOVE	T2,DOSW.A	;LOAD -TABLEN,,TABADR
	PUSHJ	P,UNIQ6		;GET A UNIQUE MATCH
	  JRST	DOSWC3		;SOME CASE!
	HRRZ	T2,DOSW.A	;GET SWITCH TABLE ADDRESS
	ADD	T2,T1		;ADD IN THE OFFSET
	MOVE	T2,(T2)		;GET FULL SWITCH NAME
	MOVEM	T2,L.SWCH	;AND SAVE IT
	HRRZ	T2,DOSW.B	;GET ADR OF DISPATCH TABLE
	ADD	T2,T1		;ADD IN THE OFFSET
	HLRZ	T3,DOSW.B	;GET VALID SWITCH BITS
	HRRZ	T1,(T2)		;LOAD ADR OF SWITCH HANDLER
	HLRZ	T2,(T2)		;LOAD VALID BITS FOR THIS SWITCH
	TRNN	T2,(T3)		;TEST THE BITS FOR LEGALITY
	JRST	DOSWC4		;HE LOSES
	PUSHJ	P,(T1)		;WIN, DISPATCH!!!
	JRST	DOSWC1		;AND LOOP FOR NEXT SWITCH

DOSWC2:	SKIPA	T1,[EXP UCO%]	;LOAD ADR OF UCO MESSAGE
DOSWC3:	MOVEI	T1,URS%		;LOAD ADR OF URS MESSAGE
	PUSHJ	P,LOGERR	;LOG THE MESSAGE
	JRST	DOSWC1		;AND LOOP AROUND

DOSWC4:	PUSHJ	P,E$ISW		;ILLEGAL SWITCH
	JRST	DOSWC1		;AND LOOP AROUND

DOSW.A:	BLOCK	1		;-TABLE LENGTH,,TABLE ADDRESS
DOSW.B:	BLOCK	1		;VALID SWITCH BITS,,DISPATCH TABLE ADR
;+FNDSWC -- Routine to scan for a "/" to begin the next
;	switch.
;-;#2

;  !-------------------------------------------------------!
;  !                       FNDSWC (B)                      !
;  !                  +1  ON END-OF-LINE                   !
;  !        +2  WITH BEGINNING OF NEXT SWITCH FOUND        !
;  !-------------------------------------------------------!


FNDSWC:	CAIN	C,"/"		;GOT ONE ALREADY?
	PJRST	.POPJ1		;YES, SKIP BACK
FNDSW1:	PUSHJ	P,.SCIN		;GET A CHARACTER
	  POPJ	P,		;EOL, RETURN
	CAIN	C,"/"		;A SLASH?
	PJRST	.POPJ1		;YES, SKIP BACK
	JRST	FNDSW1		;NO, LOOP
;+SWTOCT - SWTDEC -- Routines to process octal and decimal
;	valued switches.  Call with T1 containing address
;	of 2-word block as described below.
;-;#1

;:  !=======================================================!
;:  !       MINIMUM VALUE       !       MAXIMUM VALUE       !
;:  !-------------------------------------------------------!
;:  !                BYTE POINTER FOR RESULT                !
;:  !=======================================================!

;  !-------------------------------------------------------!
;  !                   SWTDEC - SWTOCT (B)                 !
;  !                      +1  ALWAYS                       !
;  !                      +2  NEVER                        !
;  !=======================================================!
;  !   AC    !        CALLED        !       RETURNED       !
;  !-------------------------------------------------------!
;  !   T1    !ADR OF TWO WORD BLOCK !         ---          !
;  !-------------------------------------------------------!

SWTOCT:	CAIN	C,"/"		;BREAK ON A SLASH?
	  PJRST	E$MSV		;YES, MISSING VALUE!!
	MOVEM	T1,SWT.A	;SAVE CALLING ARGUMENT
	PUSHJ	P,S$OCT		;GET OCTAL ARGUMENT
	  PJRST	E$USV		;GARBAGE
	JRST	SWTNUM		;OK, GO HANDLE THINGS

SWTDEC:	CAIN	C,"/"		;A SLASH SEEN?
	  PJRST	E$MSV		;YES, GIVE ERROR
	MOVEM	T1,SWT.A	;SAVE CALLING ARGUMENT
	PUSHJ	P,S$DEC		;GET DECIMAL ARGUMENT
	  PJRST	E$USV		;GARBAGE!

SWTNUM:	MOVE	T2,SWT.A	;LOAD POINTER TO ARG BLOCK
	HLRZ	T3,(T2)		;GET MINIMUM VALUE
	HRRZ	T4,(T2)		;GET MAXIMUM VALUE
	CAML	T1,T3		;CHECK RANGE
	CAMLE	T1,T4
	  PJRST	E$SOR		;OUT OF RANGE
	DPB	T1,1(T2)	;DEPOSIT THE ARGUMENT
	POPJ	P,		;AND RETURN


SWT.A:	BLOCK	1		;TEMPORARY STORAGE
;^;+FILENT -- Routine to setup User's Files.
;	Called to ENTER a user's files in the
;	correct place.  Call with accumulator T1 con-
;	taining the File Block Bits.  ENTERS tHE FILE,
;	causes the file to be remembered in the FILE BLOCKS.
;-;#2
;CALL:
;	PUSHJ P,FILENT
;	  RETURN HERE ON ERROR
;	  RETURN HERE OTHERWISE

FILENT:	MOVEM	T1,FILE.A		;SAVE FILE BLOCK BITS
	MOVSI	T1,FIL			;LOAD THE CHANNEL
	IOR	T1,[FO.PRV+.FOCRE]	;FILOP STUFF
	SKIPL	FILSTS			;IS THIS A UNIQUE NAME?
	HRRI	T1,.FOWRT		;NO, USE WRITE, NOT CREATE
	MOVEM	T1,L.FLOP+.FOFNC	;SAVE IT
	MOVEI	T1,.IOASL		;LOAD ASCII MODE
	TXNE	F,F.IMG!F.BIN		;IS IT IMAGE OR BINARY?
	MOVEI	T1,.IOBIN		;YES, LOAD BINARY
	MOVEM	T1,L.FLOP+.FOIOS	;SAVE IT
	MOVE	T1,FILDEV		;GET THE DEVICE
	MOVEM	T1,L.FLOP+.FODEV	;STORE IT
	MOVSI	T1,FILBH		;LOAD OBUF,,0
	MOVEM	T1,L.FLOP+.FOBRH	;STORE IT
	PUSHJ	P,CLRUUO		;CLEAR THE UUOBLK
	MOVE	T2,FILNAM		;GET FILENAME
	MOVEM	T2,RIBNAM		;PUT IN UUO BLOCK
	MOVE	T2,FILEXT		;AND THE EXTENSION
	MOVEM	T2,RIBEXT		;AND STORE IT
	MOVE	T2,FILPRV		;GET PROTECTION
	MOVEM	T2,RIBPRV		;AND STORE IT
	MOVE	T2,FILPPN		;GET FILE'S PPN
	MOVEM	T2,RIBPPN		;AND SAVE IT
	MOVEI	T2,.RBSTS		;GET LENGTH OF UUO BLOCK
	MOVEM	T2,RIBCNT		;AND STORE IT
	MOVEI	T1,RP.NQC		;GET NQC BIT
	SKIPGE	FILSTS			;IS IT AN NQC FILE?
	MOVEM	T1,RIBSTS		;YES, SET IT
IFE	FTJOBQ,<
	MOVSI	T1,-1			;USE DEFAULT # OF BUFFERS
>;END IFE FTJOBQ
IFN	FTJOBQ,<
	MOVSI	T1,2			;USE ONLY 2 BUFFERS AS THE
					; "HEAP" IS A FIXED SIZE.
>;END IFN FTJOBQ
	MOVEM	T1,L.FLOP+.FONBF	;STORE IT
	MOVEI	T1,L.UUBK		;LOAD ADDRESS OF LOOKUP BLOCK
	MOVEM	T1,L.FLOP+.FOLEB	;STORE IT
	SETZM	L.FLOP+.FOPAT		;CLEAR PATH WORD
IFE FTJOBQ,<
	MOVE	T1,.JBFF		;GET JOBFF BEFORE BUFFER
>;END IFE FTJOBQ
IFN FTJOBQ,<
	MOVE	T1,HEAPTR		;GET HEAP POINTER BEFORE BUFFER
	MOVEM	T1,FILOFF		;REMEMBER FIRST FREE IN "HEAP"
					; SO WE CAN SHRINK BACK
	EXCH	T1,.JBFF##		;PUT BUFFERS THERE
>;END IFN FTJOBQ
IFE	FTJOBQ,<
	MOVEM	T1,FILOFF		;SAVE
>;END IFE FTJOBQ
IFN	FTJOBQ,<
	MOVEI	T1,2*203		;SIZE OF 2 BUFFERS
	PUSHJ	P,EXPND			;MAKE ROOM IN THE "HEAP"
>;END IFN FTJOBQ

				;FILENT IS CONTINUED ON THE NEXT PAGE
				;CONTINUED FROM PREVIOUS PAGE

IFN FTUUOS,<
	MOVE	T1,Q.PPN(Q)		;GET USER'S PPN
	MOVEM	T1,L.FLOP+.FOPPN	;SAVE FOR CHKACC
	MOVE	T1,[.FOPPN+1,,L.FLOP]	;FILOP POINTER
	FILOP.	T1,			;DO IT
	  JRST	FILEN2			;PROBLEM?
	MOVE	T1,.JBFF##		;GET JOBFF
	MOVEM	T1,FILNFF		;SAVE AS NEW JOBFF
IFN FTJOBQ,<
	EXCH	T1,HEAPTR		;AND AS NEW TOP OF HEAP
	MOVEM	T1,.JBFF##		;RESTORE OLD JOBFF
>
	MOVE	T1,FILE.A		;GET FILE BLOCK BITS
	PUSHJ	P,FBENT			;ENTER IN FILE BLOCKS
	PJRST	.POPJ1			;AND RETURN
>  ;END IFN FTUUOS

IFN FTJSYS,<
	OPEN	FIL,L.FLOP+.FOIOS	;OPEN THE I/O CHANNEL
	  JRST	[MOVEI T1,ERNSD%	;NO SUCH DEVICE
		 JRST  FILEN2]		;AND LOSE
	SKIPL	FILSTS			;IS IT NON-SUPER FILE?
	JRST	FILENC			;NO, JUST ENTER IT
	MOVEI	T1,ERAEF%		;LOAD POSSIBLE ERROR CODE
	LOOKUP	FIL,L.UUBK		;NO, LOOK IT UP
	  JRST	FILENB			;FAILED, HOPE ITS FNF
	HRRZM	T1,RIBEXT		;LOOKUP WON, SO LOSE

;			;CONTINUED ON NEXT PAGE
;
; CONTINUATION OF FILENT
;
FILENB:	HRRZ	T1,RIBEXT		;GET THE ERROR CODE
	JUMPN	T1,FILEN2		;LOSE IF NO FNF
FILENC:	ENTER	FIL,L.UUBK		;ENTER THE FILE
	  JRST	FILEN2			;LOSE!
	MOVE	T1,[1,,T2]		;SETUP ARG FOR COMPT.
	MOVE	T2,[FIL,,10]		;CHANNEL,,FUNCTION
	COMPT.	T1,			;GET FILE'S JFN
	  JRST	FILEN2			;LOSE BIG
	MOVEM	T1,L.COMP+.CKAUD	;SAVE THE JFN OF THE FILE
	MOVX	T1,.CKACN		;GET ACCESS DESIRED
	MOVEM	T1,L.COMP+.CKAAC	;SAVE IT
	HRROI	T1,L.UNAM		;STRING POINTER TO USER
	MOVEM	T1,L.COMP+.CKALD	;SAVE IT
	HRROI	T1,L.SL2		;POINTER TO CONNECTED DIR
	MOVEM	T1,L.COMP+.CKACD	;SAVE IT
	SETZM	L.COMP+.CKAEC		;NO CAPABILITIES
	MOVX	T1,<CK%JFN+.CKAUD+1>	;ARG FOR CHKACC
	MOVEI	T2,L.COMP		;ADDRESS OF BLOCK
	CHKAC				;DO IT!
	  SETZ	T1,			;FAIL
	PJUMPE	T1,FILEND		;JUMP IF NO ACCESS
	OUTBUF	FIL,2			;ELSE, MAKE BUFFERS
	MOVE	T1,.JBFF		;GET JOBFF
	MOVEM	T1,FILNFF		;SAVE NEW JOBFF
	MOVE	T1,FILE.A		;GET FILE BLOCK BITS
	PUSHJ	P,FBENT			;ENTER FILE IN FB
	PJRST	.POPJ1			;AND RETURN


FILEND:	CLOSE	FIL,CL.RST		;DO A CLOSE RESET
	MOVEI	T1,ERPRT%		;LOAD A PROTECTION FAIL
	JRST	FILEN2			;AND GO LOSE
>  ;END IFN FTJSYS

FILEN2:	CAIE	T1,ERAEF%		;ALREADY EXISTING FILE?
	JRST	ENTERT			;NO, LOSE
	LDB	T1,[POINT 6,FILNAM,11]	;GET CODE
	CLEARM	FILNAM			;CLEAR THE WORD
	PUSHJ	P,MAKFUN		;MAKE A NEW NAME
	MOVE	T1,FILE.A		;LOAD FILE BLOCK BITS
	JRST	FILENT			;AND TRY AGAIN



FILE.A:	BLOCK	1			;SAVE FB FLAGS
;+ENTERR - ENTERT - ENTERO -- Routine to put together an ENTER
;	error and send it to the correct place.  Entry points are:
;-
;:ENTERR - send message to both OPR and LOG
;:ENTERT - send message to the LOG
;:ENTERO - send message to the OPR
;#2

;  !-------------------------------------------------------!
;  !              ENTERR - ENTERT - ENTERO (B)             !
;  !                      +1  ALWAYS                       !
;  !                      +2  NEVER                        !
;  !=======================================================!
;  !   AC    !        CALLED        !       RETURNED       !
;  !-------------------------------------------------------!
;  !   T1    !    UUO ERROR CODE    !         ---          !
;  !-------------------------------------------------------!


ENTERT:	TXOA	F,F.QOPR	;QUIET THE OPER
ENTERO:	ON	F.QLOG		;QUIET THE LOG

ENTERR:	TXOE	F,F.SHMG	;TURN OF SHMG AND MULTIPLX ITS STATE WITH FATE
	ON	F.FATE		;TURN ON FATAL ERROR BIT
	PUSHJ	P,GETHGH	;UUO ERROR MESSAGES ARE IN HISEG
	STAMP	STERR		;ERROR STAMP
	SKIPL	T1		;LT 0?
	CAILE	T1,.NMUUM	;OR GREATER THAN MAX?
	MOVEI	T1,.NMUUM+1	;YES, USE UUU ERROR
	MOVE	T3,T1		;PUT CODE IN T3 FOR ^F ACTION CHAR
	TELL	LOG!OPR,LKE%	;PRINT ENTER ERROR MESSAGE
	TELL	LOG!OPR,@UUOMSG(T1)	;PRINT UUO MESSAGE
	TELL	LOG!OPR,CRLF	;A CRLF
	OFF	F.QOPR!F.QLOG	;REVIVE ALL
	TXON	F,F.FATE	;TURN ON FATAL ERROR BIT
	OFF	F.SHMG		;IF IT WAS OFF TURN OFF SHORT MESSAGES
	POPJ	P,		;AND RETURN
;+MAKFUN -- Routine to setup up a default filespec.
;	Call with T1 containing the 2 character prefix
;	right justified.
;	Generates funnyname.ext if necessary and sets the
;	NQC flag.
;-;#2

;  !-------------------------------------------------------!
;  !                       MAKFUN (B)                      !
;  !                      +1  ALWAYS                       !
;  !                      +2  NEVER                        !
;  !=======================================================!
;  !   AC    !        CALLED        !       RETURNED       !
;  !-------------------------------------------------------!
;  !   T1    !    2 CHAR PREFIX     !         ---          !
;  !-------------------------------------------------------!


MAKFUN:	SKIPE	FILNAM		;IS THERE A FILE NAME?
	POPJ	P,		;YES, JUST RETURN
	PUSH	P,T1		;SAVE THE PREFIX
	PUSHJ	P,FUNNY		;GET LAST FOUR CHARACTERS
	POP	P,T3		;GET THE PREFIX BACK
	ROT	T3,-^D12	;LEFT JUSTIFY IT
	IOR	T1,T3		;INCLUSIVE OR IT IN
	MOVEM	T1,FILNAM	;SAVE THE FILNAM
	HRROS	FILSTS		;SET THE NQC FLAG
	POPJ	P,		;AND RETURN
;+FUNNY -- Routine to make up a 4 character Funny Name.
;	Returns the four characters in 6bit right justified in T1.
;	The names consist of the letters A-Z and the digits 0-9.
;
;The algorithm used is to first AOS location L.FUN and use this
;	as a pseudo-random number.  Dividing this by 36^4 and using
;	the remainder as a 4-digit number base 36.  (See FILUUO in the
;	TOPS10 Monitor.)
;-;#2

;  !-------------------------------------------------------!
;  !                        FUNNY (B)                      !
;  !                      +1  ALWAYS                       !
;  !                      +2  NEVER                        !
;  !=======================================================!
;  !   AC    !        CALLED        !       RETURNED       !
;  !-------------------------------------------------------!
;  !   T1    !         ---          ! 4 CHARS RT JUSTIFIED !
;  !-------------------------------------------------------!


FUNNY:	AOS	T1,L.FUN	;GET NEXT FUNNY NUMBER
	IDIV	T1,[^D1679616]	;DIVIDE BY 36^4
	MOVM	T1,T2		;AND LOAD THE REMAINDER
	PUSHJ	P,FUNLUP	;MAKE A NAME
	  JFCL			;IGNORE THE SKIP
	TLZ	T1,777700	;MAKE SURE ITS ONLY 4 CHARS
	POPJ	P,		;AND RETURN

FUNLUP:	IDIVI	T1,^D36		;DIVIDE BY 36
	HRLM	T2,(P)		;STORE DIGIT ON STACK
	SKIPE	T1		;FINISHED?
	PUSHJ	P,FUNLUP	;NO, RECURSE
	MOVEI	T1,'000'	;PRE-LOAD T1
	HLRZ	T2,(P)		;LOAD A DIGIT
	ADDI	T2,20		;MAKE IT 6BIT
	CAILE	T2,31		;NUMERIC?
	ADDI	T2,7		;NO, ALPHABETIC, ADD OFFSET
	LSH	T1,6		;SHIFT OVER ACCUMULATED NAME
	IOR	T1,T2		;OR IN NEXT CHARACTER
	PJRST	.POPJ1		;AND UNWIND
;+STDECK  -- Routine to call the correct stacking routine.
;	STDECK determines which of the stacking routines
;	to call, ASCII, IMAGE or BINARY, by checking the mode
;	flags in F.  Before returning, it correctly sets F.NXT
;	flag if necessary.
;-;#2

;  !-------------------------------------------------------!
;  !                       STDECK (B)                      !
;  !                      +1  NEVER                        !
;  !                      +2  ALWAYS                       !
;  !-------------------------------------------------------!


STDECK:	ON	F.DECK		;TURN ON THE STACKING FLAG
	TXNN	F,F.IMG		;IS IT AN IMAGE DECK?
	JRST	STDEK1		;NO, CHECK OTHERS
	PUSHJ	P,STIMG		;YES, CALL IMAGE STACKER
	JRST	STDEK4		;AND RETURN

STDEK1:	TXNN	F,F.BIN		;IS IT A BINARY DECK?
	JRST	STDEK2		;NO, CHECK OTHERS
	PUSHJ	P,STBIN		;YES, CALL BINARY STACKER
	JRST	STDEK3		;AND RETURN

STDEK2:	PUSHJ	P,STASC		;GO STACK AN ASCII DECK

STDEK3:	TXNN	F,F.EOF		;IS EOF SET?
	TXOA	F,F.NXT		;NO, SO SET F.NXT
STDEK4:	OFF	F.NXT		;EOF IS SET, SO CLEAR F.NXT
	PJRST	.POPJ1		;AND SKIP BACK
;+CTLCRD -- Routine to copy the remainder of the current card
;	(up to a specified break character) into the control
;	file.  Call with T1 containing the desired break
;	character (zero if break on eol is desired).  Returns
;	with break character in accumulator C.  Break character
;	is NOT written in control file.
;-

;  !-------------------------------------------------------!
;  !                       CTLCRD (B)                      !
;  !                +1  IF EOF ENCOUNTERED                 !
;  !               +2  IF BREAK ENCOUNTERED                !
;  !=======================================================!
;  !   AC    !        CALLED        !       RETURNED       !
;  !-------------------------------------------------------!
;  !   T1    ! BREAK CHARACTER OR 0 !      UNCHANGED       !
;  !-------------------------------------------------------!


CTLCRD:	PUSHJ	P,.SCIN		;GET A CHARACTER
	  POPJ	P,		;EOL, RETURN
	CAIN	C,(T1)		;CHECK FOR BREAK
	  PJRST	.POPJ1		;GOT IT!! RETURN
	CHR	CTL,(C)		;TYPE IT INTO CTL
	JRST	CTLCRD		;AND LOOP
SUBTTL	FILE-BLOCK Manipulation Routines


COMMENT /
;^;=
!		The FILE BLOCKS

The FILE BLOCKS are a set of four word blocks which are used to
store information about files which should be remembered by SPRINT
for one reason or another.  The entries in each word are as follows:

	Word 0	File Structure Name
	Word 1	File Name
	Word 2	Filename Extension ,, Status Bits
	Word 3	File's real PPN


The FILE BLOCKS are allocated in clusters with A%NFLR blks per cluster.
The first cluster is preallocated starting at location L.FILR.  The
last FILE BLOCK in a cluster is used as a link to the next
cluster if more space is needed.  The link contains  0,,-1 in the
0th word, and the address of the next cluster in the 1st word.


The 'load order' field is set for each file which is to be loaded
on the next $DATA or $EXECUTE card.  This is done so that the
files are loaded in the order specified by the user, which is 
important especially for files loaded in library search mode.

Routines are:
	FBENT	Enter a file into the FILE BLOCKS
	FBFND	Find files in the FILE BLOCKS
	FBLNK	Link in a new cluster of FILE BLOCKS
	FBCLOD	Clear the load order for a new set of files
;--;^
/
;+FBENT -- Routine to place a file in the FILE BLOCKS.
;FBENT uses the information in the file device cells (i.e.
;FILDEV, FILNAM,..) to fill in the FILE BLOCK.  Call with the
;FILE BLOCK flags in T1.  FBENT will set the load order for
;the file if necessary.
;-;#3
;CALL:
;	PUSHJ P,FBENT
;	  ALWAYS RETURN HERE

FBENT:	PJUMPE	T1,.POPJ	;IF BITS ARE ZERO, DON'T STORE ANYTHING
	MOVEI	T2,L.FILR	;GET ADDRESS OF FIRST FILE BLOCK
	CLEAR	T3,		;CLEAR A COUNTER

FBENT1:	SKIPN	.FBNAM(T2)	;IS IT FREE?
	JRST	FBENT3		;YES, GO FILL IT IN
	ADDI	T2,FBSIZE	;INCREMENT INDEX
	CAIGE	T3,A%NFLR-2	;SEE IF WE HAVE HIT THE LAST ONE
	AOJA	T3,FBENT1	;NO, LOOP SOME MORE

FBENT2:	MOVE	T3,.FBDEV(T2)	;IS THERE ANOTHER CLUSTER?
	CAIE	T3,-1		;YES IF IT IS  0,,-1
	PUSHJ	P,FBLNK		;NO, GO CREATE ONE
	CLEAR	T3,		;CLEAR THE COUNTER
	MOVE	T2,.FBNAM(T2)	;LOAD NEW BASE ADDRESS
	JRST	FBENT1		;AND KEEP LOOPING

FBENT3:	CLEAR	T4,		;CLEAR FOR LOAD ORDER IF NECESSARY
	TXNE	T1,FB.LOD!FB.LDR;WILL THIS BE LOADED?
	AOS	T4,L.FBCT	;YES, GET NEXT NUMBER
	ADD	T1,T4		;ADD INTO STATUS BITS
	HLL	T1,FILEXT	;GET THE EXTENSION IN THERE
	MOVEM	T1,.FBEXT(T2)	;AND STORE IT
	SKIPN	T1,FILDEV	;GET STR NAME
	MOVSI	T1,DEFDSK	;DSK IF 0
	MOVEM	T1,.FBDEV(T2)	;AND SAVE IT
	MOVE	T1,FILNAM	;GET FILENAME
	MOVEM	T1,.FBNAM(T2)	;SAVE THAT
	MOVE	T1,FILPPN	;AND FINALLY PPN
	JUMPE	T1,FBENT4	;DON'T CHECK FOR PATH IF ZERO
	TLNE	T1,-1		;IS LEFT HALF 0?
	JRST	FBENT4		;NO, ITS A PPN
	MOVEI	T1,10		;YES, LETS ALLOCATE A PATH BLOCK
	PUSHJ	P,EXPND		;AND EXPAND CORE, RET: T1=ADR OF BLOCK
	MOVSI	T3,FILPTH	;FROM
	HRRI	T3,(T1)		;TO,
	BLT	T3,7(T1)	;BLT!!!
FBENT4:	MOVEM	T1,.FBPPN(T2)	;STORE IT
	AOS	L.FILN		;INCREMENT NUMBER OF USED FILEBLOCKS
	POPJ	P,		;AND RETURN
;+FBFND -- Routine to Scan the FILE BLOCKS.
;	IF FBFND is called with 0 in T1, it will return in T1
;	the address of the first in-use FILE BLOCK.  If this
;	Address is used as the argument to FBFND, the address
;	of the next in-use FILE BLOCK will be returned.  When
;	all FILE BLOCKs have been scanned, 0 is  returned in T1.
;-;#3

;  !-------------------------------------------------------!
;  !                        FBFND (B)                      !
;  !                      +1  ALWAYS                       !
;  !                      +2  NEVER                        !
;  !=======================================================!
;  !   AC    !        CALLED        !       RETURNED       !
;  !-------------------------------------------------------!
;  !   T1    !          0           !ADR OF NEXT FILE BLOCK!
;  !         ! OR ADR OF A FILE BLK !         OR 0         !
;  !-------------------------------------------------------!


FBFND:	JUMPN	T1,FBFND1	;JUMP IF ARG IS NOT 0
	MOVE	T2,L.FILN	;GET TOTAL NUMBER IN-USE
	MOVEM	T2,L.FBFN	;SAVE IT
	MOVEI	T1,L.FILR-FBSIZE;GET STARTING ADDRESS LESS INCREMENT

FBFND1:	SOSGE	L.FBFN		;LAST ONE FOUND?
	JRST	FBFND5		;YES, RETURN 0

FBFND2:	ADDI	T1,FBSIZE	;POINT TO NEXT FILE BLOCK
FBFND3:	SKIPN	.FBNAM(T1)	;IN-USE?
	JRST	FBFND2		;NO, GET NEXT ONE
	MOVE	T2,.FBDEV(T1)	;GET DEVICE
	CAIE	T2,-1		;0,,-1 MEANS ITS A LINK
	POPJ	P,		;ITS NOT, RETURN ADDRESS
	MOVE	T1,.FBNAM(T1)	;GET ADDRESS OF NEXT CLUSTER
	JRST	FBFND3		;AND LOOP WITHOUT INCREMENTING 1ST TIME

FBFND5:	CLEAR	T1,		;END OF SCAN
	POPJ	P,		;RETURN
;+FBLNK -- Routine to link up a new FILE BLOCK cluster.
;	Call with T2 containing the address of the last FILE
;	BLOCK in the last cluster.
;-;#3
;CALL:
;	PUSHJ P,FBLNK
;	  ALWAYS RETURN HERE

FBLNK:	PUSH	P,T1		;SAVE T1
	MOVEI	T1,<FBSIZE*A%NFLR>	;LOAD SIZE OF DESIRED BLOCK
	PUSHJ	P,EXPND		;GET BLOCK OF DESIRED SIZE (ZEROED)
	MOVEM	T1,.FBNAM(T2)	;SAVE LINK ADDRESS
	MOVEI	T1,-1		;LOAD 0,,-1
	MOVEM	T1,.FBDEV(T2)	;FLAG END OF CHUNK
	PJRST	T1POPJ		;RESTORE T1 AND RETURN
;+FBCLOD -- Routine to reset the load order.
;	FBCLOD is called on the first $language, $RELOC
;	or $INCLUDE card after a $DATA or $EXECUTE card.
;	It resets the load order, clears the load bits in
;	the currently used FILE BLOCKS, and deletes entries
;	which are no longer needed.
;-

;  !-------------------------------------------------------!
;  !                       FBCLOD (B)                      !
;  !                      +1  ALWAYS                       !
;  !                      +2  NEVER                        !
;  !-------------------------------------------------------!


FBCLOD:	SKIPN	L.LOAD		;IS LOAD SET?
	POPJ	P,		;NO, JUST RETURN
	CLEARB	T1,L.LOAD	;CLEAR THE LOAD FLAG, AND T1
	CLEARM	L.FBCT		;CLEAR THE LOAD ORDER WORD

FBCLD1:	PUSHJ	P,FBFND		;GET AN ENTRY
	PJUMPE	T1,.POPJ	;RETURN WHEN DONE
	HRRZ	T2,.FBEXT(T1)	;GET STATUS FLAGS
	TRNN	T2,FB.LOD!FB.LDR;WAS IT LOADED?
	JRST	FBCLD1		;NO, LOOP AROUND FOR THE NEXT ONE
	TRZ	T2,FB.LOD!FB.LDR!FB.SRH!FB.ORD
	HRRM	T2,.FBEXT(T1)	;CLEAR ALL THE LOAD BITS AND RESTORE STATUS
	JUMPN	T2,FBCLD1	;IF THERE ARE STILL BITS SET, LOOP FOR
				; ANOTHER
	CLEARM	.FBDEV(T1)	;OTHERWISE, RECLAIM THE ENTRY
	CLEARM	.FBEXT(T1)
	CLEARM	.FBNAM(T1)
	CLEARM	.FBPPN(T1)
	SOS	L.FILN		;DECREMENT USE COUNT
	JRST	FBCLD1		;AND LOOP AROUND FOR NEXT ONE
SUBTTL	Scanners


COMMENT /
;^;=
		Scanners


All the scanners are called with location L.SCIN containing the
address of a get-a-character routine from the desired source of
input, and location L.SCLN containing the address of a get next
record routine.

It should be assumed that all scanners use T1 through T5, even
though some don't use all of them.

The scanners are:
	S$DEC	Return a decimal number
	S$OCT	Return an octal number
	S$SIX	Return a sixbit word
	S$STRG	Return an ASCIZ string
	S$TIM	Return a time specification
	.SCDT	Return a date-time specification
	S$FILE	Return a file-specification

Scanner utility routines are:
	UNIQ6	Return index of unique table match
	.SCFLS	Flush leading spaces
	.SCIN	Get the next valid character

;--
/
;^;+S$OCT - S$DEC  -- Octal and decimal number scanners.
;	Returns scanned number in T1.  Skip returns if at
;	least one digit was found.  Non-skip return is taken if the
;	first character was not a digit.  On a non-skip return, if
;	T1 contains -1, then an end of line was seen while scanning
;	for the first character.
;--

S$OCT:	SKIPA	T2,S$NUM1	;LOAD AN 8
S$DEC:	MOVEI	T2,12		;LOAD A 10
S$NUM:	CLEAR	T1,		;CLEAR THE ACCUMULATOR
	PUSHJ	P,.SCFLS	;FLUSH LEADING SPACES AND GET A CHAR
	  JRST	S$NUM4		;EOL, RETURN -1
	CAIL	C,"0"		;CHECK RANGE
	CAILE	C,"0"-1(T2)
S$NUM1:	  POPJ	P,8		;NOT IN RANGE
	JRST	S$NUM3		;OK, SKIP INTO LOOP

S$NUM2:	PUSHJ	P,.SCIN		;GET A CHARACTER
	  PJRST	.POPJ1		;EOL, RETURN.
	CAIL	C,"0"		;CHECK THE RANGE
	CAILE	C,"0"-1(T2)
	  PJRST	.POPJ1		;ITS NOT A NUMBER
S$NUM3:	IMULI	T1,(T2)		;SHIFT RADIX POINT OVER ONE
	ADDI	T1,-"0"(C)	;ADD IN THE NEXT DIGIT
	JRST	S$NUM2		;AND LOOP AROUND FOR THE NEXT DIGIT

S$NUM4:	SETO	T1,		;LOAD A -1
	POPJ	P,		;AND TAKE ERROR RETURN
;+S$SIX -- Routine to scan off a sixbit word.
;	Returns with T1 containing the first six alphanumeric
;	characters from the input source, and T3 containing the number
;	of characters returned.  Returns next character in C.
;-;#2
;CALL:
;	PUSHJ P,S$SIX
;	  RETURN HERE IF 1ST CHAR WAS NOT A-Z 0-9 OR SPACE
;	  RETURN HERE OTHERWISE

S$SIX:	CLEARB	T1,T3		;T1 GETS RESULTS T3 GETS COUNT
	MOVE	T4,[POINT 6,T1]	;A BYTE POINTER FOR RESULTS
	PUSHJ	P,.SCFLS	;FLUSH LEADING SPACES
	  PJRST	.POPJ1		;EOL!
	JRST	S$SIX3		;FALL INTO LOOP WITH 1ST CHAR

S$SIX1:	PUSHJ	P,.SCIN		;GET A CHARACTER
	  JRST	S$SIX5		;NO MORE
S$SIX3:	CAIL	C,"A"		;CHECK FOR ALPHA
	CAILE	C,"Z"
	  SKIPA			;ITS NOT, TRY 0-9
	JRST	S$SIX4		;GOT AN ALPHA
	CAIL	C,"0"		;TRY FOR NUMBERIC
	CAILE	C,"9"
	  JRST	S$SIX5		;NOT, RETURN
S$SIX4:	SUBI	C,.ASSPC	;MAKE IT 6BIT
	PUSHJ	P,S$SIX6	;DEPOSIT IT
	JRST	S$SIX1		;AND LOOP

S$SIX5:	PJUMPE	T3,.POPJ	;NON-SKIP IF LOST ON 1ST CHAR
	PJRST	.POPJ1		;ELSE SKIP BACK

S$SIX6:	TLNN	T4,770000	;GOT SIX ALREADY?
	POPJ	P,		;YUP DON'T DEPOSIT MORE
	IDPB	C,T4		;ELSE, STORE CHAR
	AOJA	T3,.POPJ	;INCR COUNT AND RETURN
;+S$STRG -- Routine to scan an ASCIZ string.
;	Call with T1 containing the address of an 8 word
;	block to store the string.  String terminates on a blank, or
;	after the 39th character.
;-;#2
;CALL:
;	PUSHJ P,S$STRG
;	  ALWAYS RETURN HERE

S$STRG:	HRLI	T1,440700	;MAKE A BYTE POINTER
	CLEAR	T2,		;AND CLEAR A COUTNER

S$STR1:	PUSHJ	P,.SCIN		;GET A CHARACTER
	  JRST	S$STR2		;EOL OR SOMETHING LIKE THAT
	CAIN	C," "		;IS THIS OUR BREAK?
	JRST	S$STR2		;YES, DEPOSIT THE NULL AND RETURN
	IDPB	C,T1		;ELSE DEPOSIT THE CHAR
	CAIGE	T2,^D38		;GOT ENUF?
	AOJA	T2,S$STR1	;NO, GET SOMEMORE

S$STR2:	MOVEI	C,0		;LOAD NULL
	IDPB	C,T1		;DEPOSIT IT
	POPJ	P,		;AND RETURN
	UP

;+S$TIM -- Routine to return a Time Specification
;S$TIM scans a string of the form  hh:mm:ss and returns
;	L.HRS, L.MIN, L.SEC updated.  No range checking
;	is done so 120 may be used instead of 2:0.
;-;#2
;CALL:
;	PUSHJ P,S$TIM
;	  RETURN HERE IF TOO MANY ARGS SPECIFIED (# IN T1)
;	  RETURN HERE OTHERWISE

S$TIM:	CLEARM	L.HRS		;CLEARM ANSWERS
	CLEARM	L.MIN		;BEFORE WE ASK THE QUESTIONS
	CLEARM	L.SEC
	MOVEI	T5,L.SEC	;ADDRESS FOR LAST ARGUMENT
	MOVNI	T4,3		;-VE NUMBER OF LEGAL ARGS
	PUSHJ	P,S$TML		;GO SCAN SOME
	JUMPLE	T4,.POPJ1	;WIN BIG
	ADDI	T4,3		;CONVERT TO NUMBER OF ARGS
	POPJ	P,		;ANY NOTIFY THAT HE LOSES

S$TML:	PUSHJ	P,S$DEC		;GET A DECIMAL NUMBER
	  JFCL
	HRLM	T1,(P)		;SAVE IT ON THE STACK
	AOJG	T4,S$TL1	;AOS COUNT AND AVOID RUNAWAY RECURSION
	CAIN	C,":"		;BREAK ON COLON?
	PUSHJ	P,S$TML		;YES, RECURSE
S$TL1:	JUMPG	T4,.POPJ	;AUTOMATICALLY UNWIND IF TOO MANY ARGS
	HLRZ	T1,(P)		;GET AN ARGUMENT
	MOVEM	T1,(T5)		;SAVE IT
	SOS	T5		;POINTER FOR NEXT ARG
	POPJ	P,		;AND UNWIND


	DOWN
	UP

;+.SCDT -- Date-Time Scanner.
;	.SCDT is called by the /DEADLINE and /AFTER
;	switches to parse a date-time specification.
;-;#2
;
;Legal date-time specifications are of the form:
;
;	[+[HH:[MM]]]
;	[[DD-MMM]-YY]
;	[[[DD-MMM]-YY] [HH:[MM]]]
;
;FOR ALL MONTH SPECIFICATIONS (MMM) AN NUMBER OR THE MONTH NAME WILL
;	BE ACCEPTED.
;FOR ALL YEAR SPECFICATIONS (YY) THE CENTURY NEED NOT BE SPECIFIED,
;	I.E. 1973 OR 73 MAY BE SPECIFIED.
;
;NOTE - IN THIS ROUTINE, L.MIN HOLDS HOURS AND L.SEC HOLDS MINUTES.
;     - THIS ROUTINE IS ONLY GOOD UNTIL 1999

	RADIX	10		;*****NOTE WELL*****

.SCDT:	MOVE	T1,[L.HRS,,L.HRS+1]
	CLEARM	L.HRS		;SETUP TO CLEAR RESULTS
	BLT	T1,L.YRS	;AND DO IT!

	PUSHJ	P,.SCIN		;GET A CHARACTER
	  POPJ	P,		;EOL!!
	CAIN	C,"+"		;PLUS?
	JRST	.SCDTR		;YES, GET RELATIVE TIME
	CAIL	C,"0"		;CHECK TO BE SURE ITS A DIGIT
	CAILE	C,"9"		;0-9
	  POPJ	P,		;NO, LOSE
.SCDT0:	ON	F.RSCN		;SET TO REREAD CHARACTER
	PUSHJ	P,S$DEC		;GET A DECIMAL NUMBER
	  POPJ	P,		;LOSE BIG!!
	CAIN	C,"-"		;BACK ON A HYPHEN?
	JRST	.SCDAT		;YES, GET A DATE!!

.SCTMA:	CAIN	C,":"		;COLON?
	JRST	.SCTA1		;YES, GET MORE TIME
	MOVEM	T1,L.SEC	;SAVE WHAT WE HAVE AS MINUTES
	JRST	MAKDT		;AND GO PUT IT ALL TOGETHER
.SCTA1:	MOVEM	T1,L.MIN	;SAVE T1
	PUSHJ	P,S$DEC		;GET MINUTES
	  POPJ	P,		;???
	MOVEM	T1,L.SEC	;SAVE THEM
	JRST	MAKDT		;AND MAKE A DATE
.SCDTR:	PUSHJ	P,S$TIM		;GET A TIME SPEC
	  POPJ	P,		;HE LOSES
	SKIPE	L.HRS		;ONLY WANT 2 ARGS
	  POPJ	P,		;HE'S TOO ACCURATE
	MSTIME	T1,		;GET NOW!!
	IDIV	T1,[^D1000*^D3600]
	ADDM	T1,L.MIN	;ADD IN HRS
	IDIVI	T2,^D60000	;GET MINUTES
	ADDM	T2,L.SEC	;ADD IT IN
	JRST	MAKDT		;AND GO MAKE A DATE-TIME

.SCDAT:	MOVEM	T1,L.DAY	;SAVE 1ST ARG AS DAY
	PUSHJ	P,.SCIN		;GET NEXT CHAR
	  POPJ	P,		;LOSE!
	ON	F.RSCN		;RESCAN THE CHARACTER
	TRNN	C,^O100		;ALPHABETIC?
	  JRST	.SCDA3		;ITS NOT, MUST BE NUMBER
	PUSHJ	P,S$SIX		;IT IS, GET MONTH NAME
	  POPJ	P,		;??
	HRRI	T1,'-  '	;START MAKING IT LOOK LIKE TABLE
	LSH	T1,-6		; WHICH IS '-MON- '
	TLO	T1,'-  '
	MOVSI	T2,-12		;SETUP AOBJN POINTER
.SCDA1:	CAMN	T1,MONTAB(T2)	;DO A COMPARE
	JRST	.SCDA2		;A MATCH!!
	AOBJN	T2,.SCDA1	;AND LOOP
	POPJ	P,		;NO MONTH THAT I'VE HEARD OF

.SCDA2:	HRRM	T2,L.MON	;AND STORE IT
	JRST	.SCDA4		;JOIN-UP AT THE PASS

.SCDA3:	PUSHJ	P,S$DEC		;GET THE MONTH NUMBER
	  POPJ	P,		;BAD FORMAT??
	CAIL	T1,1		;MAKE SURE ITS 1-12
	CAILE	T1,12
	POPJ	P,		;NOPE
	SOS	T1		;MAKE IT MONTH -1
	MOVEM	T1,L.MON	;AND STORE IT

.SCDA4:	CAIE	C,"-"		;SEE IF YR COMING
	JRST	.SCDA6		;NO,
	PUSHJ	P,S$DEC		;YES, GET IT
	  POPJ	P,		;BAD NUMBER??
	CAIG	T1,99		;DID HE SPECIFY A CENTURY?
	JRST	.SCDA5		;NO,
	SUBI	T1,1900		;YES, MAKE IT YEARS SINCE 1900
.SCDA5:	SUBI	T1,64		;MAKE IT YEARS SINCE 1964
	MOVEM	T1,L.YRS	;AND STORE THEM
	JRST	.SCDA7		;AND FINISH UP

.SCDA6:	DATE	T1,		;GET THE DATE
	IDIVI	T1,12*31	;GET THE YEAR-1964
	MOVEM	T1,L.YRS	;AND STORE IT

.SCDA7:	CAIN	C,"/"		;SWITCH COMING?
	JRST	MAKDT		;YES, SETTLE FOR WHAT WE HAVE
	PUSHJ	P,.SCFLS	;FLUSH LEADING SPACES
	  JRST	MAKDT		;EOL!
	CAIN	C,"/"		;NOW A SWITCH?
	JRST	MAKDT		;YES!
	CAIL	C,"0"		;NO, SEE IF IT LOOKS LIKE A TIME
	CAILE	C,"9"		;WHICH IMPLIES A DIGIT
	POPJ	P,		;NO???
	JRST	.SCDT0		;YES, GET A TIME
MAKDT:	SKIPE	L.YRS		;DATE SPECIFIED?
	JRST	MAKDT4		;YES, SKIP ALL THIS
	DATE	T1,		;NO GET THE DATE
	IDIVI	T1,12*31	;GET YEAR-1964 IN T1
	IDIVI	T2,31		;GET MON-1 IN T2 AND DAY-1 IN T3
	ADDI	T3,1		;MAKE A DAY
	MOVEM	T2,L.MON	;SAVE THE MONTH
	MOVEM	T3,L.DAY	;SAVE THE DAY
MAKDT1:	MOVEM	T1,L.YRS	;SAVE THE YEAR
	MSTIME	T1,		;ELSE, GET THE TIME
	IDIV	T1,[3600*1000]	;GET HOURS IN T1
	IDIVI	T2,60000	;AND MINUTES IN T2
	CAMLE	T1,L.MIN	;ARE WE PAST WHAT HE SPEC'ED
	JRST	MAKDT3		;MOST DEFINITELY, GO ADD A DAY
	CAME	T1,L.MIN	;IS IT LT OR EQ
	JRST	MAKDT4		;ITS LT, DON'T ADD A DAY
	CAMG	T2,L.SEC	;ARE THE MINUTES PAST
	JRST	MAKDT4		;NO, ALL IS WELL
MAKDT3:	MOVEI	T3,24		;GOING TO INCREMENT BY 24 HOURS
	ADDM	T3,L.MIN	;AND DO IT
MAKDT4:	MOVE	T1,L.MIN	;GET HOURS
	IMULI	T1,60		;AND MAKE MINUTES
	ADD	T1,L.SEC	;ADD MINUTES
	CLEAR	T2,		;FOR LOW HALF
	ASHC	T1,-17		;MULT BY 2**18
	DIVI	T1,60*24	;DIVIDE BY MIN/DAY
	MOVEM	T1,L.SEC	;AND STORE
MAKDT5:	MOVE	T1,L.YRS	;GET YEARS - 1964
	MOVE	T3,L.MON	;AND THE MONTH - 1
	ADDI	T1,3		;GET <YEAR-1964>+3 (FOR LY IN 1964)
	SOS	T4,L.DAY	;AND GET THE DAY - 1
	ADD	T4,DATTBL(T3)	;ADD DAYS TO THE BEGINNING OF MONTH
	IDIVI	T1,4		;GET LEAP YEARS SINCE 1964
	ADDI	T4,<1964-1859>*365+<1964-1859>/4+<31-18>+31(T1)
				;<1964-1859>*365 = DAYS SINCE 1/1/1859
				;<1964-1859>/4 = LEAP YEARS SINCE 1/1/59
				;<31-18> = 11/30/1859 - 11/18/1859
				;31 = DAYS IN DECEMBER 1859
				;T1 CONTAINS LEAP YEARS SINCE 1964
	AOS	T4		;ASSUME THIS IS A LEAP YEAR
	CAIL	T3,2		;IF ITS JAN OR FEB
	CAIE	T2,3		;OR ITS NOT A LEAP YEAR
	SOS	T4		;NO EXTRA DAY
	MOVE	T1,L.YRS	;GET THE YEAR - 1964
	IMULI	T1,365		;DAYS SINCE 1/1/64
	ADD	T4,T1		;ADD THEM IN
	MOVS	T1,T4		;GET DAYS IN LH
	ADD	T1,L.SEC	;ADD THE TIME
	PJRST	.POPJ1		;AND RETURN WITH DATE-TIME

DATTBL:	EXP	0,31,59,90,120,151,181
	EXP	212,243,273,304,334

	RADIX	8		;*****BACK TO RADIX 8*****
	DOWN
;+S$FILE -- Routine to scan off a filespec.
;	Call with T1 containing the address of the appropriate
;	device control cells.
;
;If some part of the filespec is not given, the corresponding
;	location is returned unchanged, so defaults can be
;	filled in before calling.
;-;#3
;CALL:
;	PUSHJ P,S$FILE
;	  RETURN HERE ON ERROR WITH T1 CONTAINING ADR OF ERROR MESSAGE
;	  RETURN HERE ON SUCCESS

;	FILESPEC FLAGS KEPT IN T5
	SC.DIR==1B0		;DIRECTORY WAS FOUND
	SC.DEV==1B1		;DEVICE WAS FOUND
	SC.NAM==1B2		;NAME WAS FOUND
	SC.EXT==1B3		;EXTENSION WAS FOUND

S$FILE:	HRRZ	T5,T1		;FOR FLAGS,,ADDRESS
	CLEARM	.CCPTH(T5)	;CLEAR THE FILE STATUS WORD

S$FIL1:	PUSHJ	P,S$SIX		;GET FIRST ATOM
	  JRST	S$FIL2		;NOT ALPHANUMERIC
	JUMPE	T1,.POPJ1	;EOL - SUCCESS RETURN

S$FIL2:	CAIN	C,":"		;DEVICE SPECIFIED?
	JRST	S$DEV		;YUP, GO DO IT
	JUMPE	T1,S$FIL3	;NULL CANT BE FILENAME
	TXOE	T5,SC.NAM	;SET NAME FLAG AND SKIP IF 1ST ONE
	JRST	.SCFE1		;TWO NAMES ARE ILLEGAL
	MOVEM	T1,.CCNAM(T5)	;STORE FILENAME

S$FIL3:	CAIN	C,"."		;EXTENSION COMING?
	JRST	S$EXT		;YES, DO IT!
IFN FTUUOS,<
	CAIE	C,"["		;DIRECTORY SPEC COMING?
	CAIN	C,74		;ACCEPT EITHER DELIMETER
	JRST	S$DIR		;YES,  GO GET IT
>  ;END IFN FTUUOS
	CAIN	C," "		;A BLANK?
	JRST	S$FIL1		;YES, TRY SOME MORE
	PJRST	.POPJ1		;NO, TAKE SUCCESS RETURN

S$DEV:	JUMPE	T1,.SCFE3	;NULL DEVICE?
	TXOE	T5,SC.DEV	;SET DEV FLAG AND SKIP IF NOT DUPLICATE
	JRST	.SCFE4		;DUPLICATE DEVICE
	MOVEM	T1,.CCDEV(T5)	;STORE DEVICE NAME
	JRST	S$FIL1		;AND LOOP FOR MORE STUFF
S$EXT:	TXOE	T5,SC.EXT	;SET EXT FLAG AND SKIP IF 1ST ONE
	JRST	.SCFE2		;NOT THE FIRST TIME!
	PUSHJ	P,S$SIX		;GET EXTENSION
	  JFCL			;NOT A VALID CHAR, STORE NULL
	MOVEM	T1,.CCEXT(T5)	;STORE THE EXTENSION
	JRST	S$FIL3		;AND LOOP FOR MORE

IFN FTUUOS,<
S$DIR:	TXOE	T5,SC.DIR	;DO WE HAVE A DIRECTORY ALREADY?
	JRST	.SCFE8		;YES, LOSE
	MOVEI	T1,.CCPTH(T5)	;LOAD ADDRESS OF PATH BLOCK
	MOVEM	T1,.CCPPN(T5)	;STORE IN PPN WORD
	PUSHJ	P,S$OCT		;GET AN OCTAL NUMBER
	  JFCL
	JUMPN	T1,S$DIR1	;WE'VE GOT PROJ, GET PROG
	CAIN	C,","		;SEE IF NULL PROJ NUMBER
	JRST	S$DIR1		;IT IS, GET PROG NUMBER
	CAIE	C,"-"		;SEE IF DEFAULT DIRECTORY
	JRST	.SCFE5		;IT ISN'T, ITS GARBAGE
	PUSHJ	P,.SCIN		;GET NEXT CHARACTER
	  JRST	S$FIL1		;EOL, LOOP FOR MORE FILSPEC STUFF
	CAIN	C,","		;IS IT A COMMA
	MOVEI	C,"-"		;YES, MAKE IT GARBAGE CHARACTER
	JRST	S$DIR2		;AND MAKE SURE DIRECTORY IS CLOSED OFF

S$DIR1:	HRLM	T1,.CCPTH+2(T5)	;SAVE PROJECT NUMBWR
	PUSHJ	P,S$OCT		;GET PROG
	  JFCL
	HRRM	T1,.CCPTH+2(T5)	;SAVE PROGRAMMER NUMBER

S$DIR2:	CAIE	C,"]"		;THE END
	CAIN	C,76		;ONE WAY OR ANOTHER
	  JRST	S$FIL1		;YES, GO BACK TO THE BEGINNING
	CAIE	C,","		;MORE TO COME?
	JRST	.SCFE5		;NO, MORE GARBAGE
	MOVEI	P2,.CCPTH+3(T5)	;POINT TO FIRST SFD

S$DIR3:	PUSHJ	P,S$SIX		;GET SFD NAME
	  JRST	.SCFE5		;LOSE BIG
	MOVEM	T1,(P2)		;STORE IN PATH BLOCK
	AOS	.CCPTH(T5)	;INCREMENT 1ST WORD OF PATH BLOCK
	CAIE	C,"]"		;DONE YET?
	CAIN	C,76		;OR THIS WAY
	JRST	S$FIL1		;AND BACK TO THE BEGINNING FOR MORE FILESPEC
	CAIE	C,","		;TERMINATED BY ","
	  JRST	.SCFE5		;NO, LOSE
	MOVE	T3,P2		;GET CURRENT ADR
	SUBI	T3,.CCPTH(T5)	;SUBRACT BEGGINGING ADR
	CAIGE	T3,10		;GREATER THAN MAX?
	AOJA	P2,S$DIR3	;NO, WIN
	JRST	.SCFE7		;YES, NESTING TO DEEP
>  ;END IFN FTUUOS
;ERROR ROUTINES FOR FILE-SPEC SCANNER


.SCFE1:	MOVEI	T1,DFN%
	POPJ	P,		;LOAD ERROR MESSAGE ADR AND RETURN

.SCFE2:	MOVEI	T1,DEX%		;ERROR MSG ADDRESS
	POPJ	P,		;RETURN

.SCFE3:	MOVEI	T1,NDV%		;ERROR MSG ADDRESS
	POPJ	P,		;AND RETURN

.SCFE4:	MOVEI	T1,DDV%		;ERROR MSG ADDRESS
	POPJ	P,		;AND RETURN

.SCFE5:	MOVEI	T1,IDS%		;ERROR MSG ADDRESS
	POPJ	P,

.SCFE7:	MOVEI	T1,SND%		;ERROR MESSAGE ADDRESS
	POPJ	P,		;AND GOTO FAIL RETURN

.SCFE8:	MOVEI	T1,DDI%		;ERROR MESSAGE ADDRESS
	POPJ	P,		;AND RETURN
;UNIQ6 -- ROUTINE TO RETURN INDEX OF UNIQUE 6BIT MATCH
;
;CALL WITH T1 CONTAINING 6BIT WORD
;	   T2 CONTAINING XWD -TABLE LENGTH,TABLE ADR
;	   T3 CONTAINING NUMBER OF CHARACTERS INPUT
;
;CALL:
;	PUSHJ P,UNIQ6
;	  RETURN HERE IF NO MATCH, OR NON-UNIQUE MATCH
;	  RETURN HERE OTHERWISE WITH T1 CONTAINING INDEX
;
;ON NON-SKIP RETURN T1 STILL HAS 6BIT WORD.
UNIQ6:	MOVE	T3,MSKTBL-1(T3)	;GET MASK FOR CHARACTERS
	MOVEM	T3,UNIQ.A	;SAVE THE MASK
	HRRZM	T2,UNIQ.B	;SAVE START ADR OF TABLE
	CLEAR	T3,		;CLEAR UNIQUENESS BITS

UNIQ.1:	MOVE	T4,(T2)		;GET TABLE ENTRY
	CAMN	T1,T4		;EXACT MATCH?
	JRST	UNIQ.3		;YES, WIN!
	TDZ	T4,UNIQ.A	;MASK OUT CHARS NOT TYPED
	CAME	T1,T4		;MATCH NOW?
	JRST	UNIQ.2		;NO, LOOP AROUND FOR ENTIRE TABLE
	TROE	T3,1		;SET FIRST OCCURENCE
	TROA	T3,2		;IT WAS SET, SET SECOND OCCUR
	HRLI	T3,(T2)		;SAVE INDEX OF FIRST OCCUR
UNIQ.2:	AOBJN	T2,UNIQ.1	;AND LOOP AROUND

	TRNE	T3,2		;TWO OR MORE MATCHES?
	POPJ	P,		;YES, LOSE
	TRNN	T3,1		;DID WE GET ONE?
	POPJ	P,		;NO, LOSE AGAIN
	MOVS	T2,T3		;GET INDEX INTO T2

UNIQ.3:	HRRZ	T1,T2		;GET MATCH ADDRESS
	SUB	T1,UNIQ.B	;GET ABSOLUTE OFFSET
	PJRST	.POPJ1		;AND SKIP BACK

MSKTBL:	7777777777		;1 CHARACTER
	77777777		;2 CHARACTERS
	777777			;3
	7777			;4
	77			;5
	0			;6


UNIQ.A:	BLOCK	1		;FIRST TEMP
UNIQ.B:	BLOCK	1		;SECOND TEMP
;USEFUL SCANNING ROUTINES

;.SCFLS -- ROUTINE TO FLUSH LEADING SPACES
;
;CALL:
;	PUSHJ P,.SCFLS
;	  RETURN HERE IF END-OF-LINE WAS ENCOUNTERED
;	  RETURN HERE OTHERWISE WITH FIRST SIGNIFICANT CHAR IN C

.SCFLS:	PUSHJ	P,.SCIN		;GET A CHARACTER
	  POPJ	P,		;END-OF-LINE
	CAIN	C,.ASSPC	;A SPACE?
	JRST	.SCFLS		;YES, LOOP
	PJRST	.POPJ1		;NO, RETURN


;.SCIN -- ROUTINE TO CALL THE GET A CHARACTER ROUTINE FOR THE
;	SCANNERS.  CHECKS FOR CONTINUATION CHARACTERS, COMMENTS ETC.
;
;CALL:
;	PUSHJ	P,.SCIN
;	  RETURN HERE ON END-OF-LINE
;	  RETURN HERE OTHERWISE WITH CHARACTER IN C

.SCIN:	TXZE	F,F.RSCN	;RESCANNING THIS CHAR?
	PJRST	.POPJ1		;YES, JUST RETURN
	PUSHJ	P,@L.SCIN	;CALL CALLER'S ROUTINE
	  POPJ	P,		;EOL
	CAIE	C,"!"		;START COMMENT FIELD?
	CAIN	C,";"		;EITHER TYPE!!
	POPJ	P,		;YES, SAME AS EOL
	CAIE	C,"-"		;OR CONTINUATION MARK?
	PJRST	.POPJ1		;NO, SKIP BACK WITH CHARACTER
	PUSH	P,B		;SAVE BYTE POINTER
.SCIN1:	PUSHJ	P,@L.SCIN	;GET ANOTHER CHARACTER
	  JRST	.SCIN2		;EOL MEANS IT WAS A CONTINUATION
	CAIE	C,"!"		;SO DOES A COMMENT
	CAIN	C,";"		; EITHER TYPE OF COMMENT
	  JRST	.SCIN2		;SO GO GET IT
	CAIN	C," "		;IS IT A BLANK?
	JRST	.SCIN1		;YES, LOOP FOR NON-BLANK
	POP	P,B		;ITS NOT A CONTINUATION
	MOVEI	C,"-"		;SO RESTORE THE HYPHEN
	PJRST	.POPJ1		;AND RESTORE BP AND SKIP BACK

.SCIN2:	POP	P,B		;BRING STACK INTO PHASE
	PUSHJ	P,@L.SCLN	;GET NEXT RECORD
	  POPJ	P,		;THATS THE END
	JRST	.SCIN		;NOPE, TRY AGAIN
SUBTTL	DUMMY ROUTINES TO READ ONE CHARACTER FROM CARD

;CDRCHR -- ROUTINE TO LOAD ONE BYTE FROM CARD (L.CARD).
;	CONVERTS TABS AND CR TO SPACES, AND LOWER TO UPPER
;	CASE. ASSUMES AC B CONTAINS A CORRECT BYTE POINTER
;
;CALL:
;	PUSHJ P,CDRCHR
;	  RETURN HERE  IF THIS IS EOL
;	  RETURN HERE OTHERWISE

CDRCHR:	SKIPE	L.BRK		;WAS LAST CHARACTER A BREAK?
	POPJ	P,		;YES, JUST RETURN
	ILDB	C,B		;GET A CHARACTER
	CAIE	C,.CHTAB	;TAB?
	CAIN	C,.CHCRT	;NO, CARRIAGE RETURN?
	MOVEI	C,.ASSPC	;YES, MAKE A SPACE
	CAIN	C,.CHLFD	;LINEFEED?
	  JRST	CDRCH1		;YES, SET BREAK FLAG A NON-SKIP BACK
	CAIL	C,141		;CHECK FOR LOWER CASE
	CAILE	C,172		; I.E. 141-172
	PJRST	.POPJ1		;NO, RETURN
	SUBI	C,40		;MAKE IT UPPER CASE
	PJRST	.POPJ1		;AND RETURN

CDRCH1:	SETOM	L.BRK		;SET BREAK FLAG
	MOVEI	C,.ASSPC	;MAKE BREAK CHAR LOOK LIKE A SPACE
	POPJ	P,		;AND NON-SKIP BACK


;CDRNXT -- ROUTINE TO GET A RECORD FOR SCANNERS
;	READS IN A CARD AND PRINTS IT INTO THE
;	LOG, SINCE IT IS A CONTINUATION OF A CONTROL CARD.
;
;CALL:
;	PUSHJ	P,CDRNXT
;	  RETURN HERE ON EOF
;	  RETURN HERE OTHERWISE

CDRNXT:	PUSH	P,T1		;SAVE T1
	MOVE	T1,[T2,,L.SAC+2];BLT POINTER
	BLT	T1,L.SAC+T5	;SAVE T2-T2
	PUSHJ	P,CDRASC	;GET A CARD
	  POPJ	P,		;END-OF-FILE
	STAMP	STCRD		;STAMP THE LOG
	TELL	LOG!NAC,L.CARD	;TYPE THE CARD
	MOVE	B,[POINT 7,L.CARD]
	MOVE	T1,[L.SAC+T2,,T2]
	BLT	T1,T5		;RESTORE T2-T5
	POP	P,T1		;RESTORE T1
	PJRST	.POPJ1		;LOAD A NEW BP, AND RETURN
SUBTTL	Deck Stacking Routines
;^;+STASC -- Routine to transfer User's ASCII or 026 Deck to disk.
;	Deck ends on CDR-EOF or a control card (except $MODE).
;-;#3
;CALL:
;	PUSHJ P,STASC
;	  RETURN HERE ALWAYS
;
;F.EOF WILL BE SET IF INPUT EOF TERMINATED TRANSFER.
;IF LOCATION DEKCRD IS RETURNED ZERO, NO FILE WAS CREATED.

STASC:	CLEARM	DEKCRD		;CLEAR CARD COUNTER
	CLEARM	DEKBLK		;CLEAR BLOCK COUNTER
	AOS	L.DEKN		;START NEW DECK

STASC1:	PUSHJ	P,CDRASC	;GET ASCII CARD IMAGE
	  POPJ	P,		;EOF ENCOUNTERED

	TXNE	F,F.FATE!F.KILL	;ANY STOP CONDITION?
	POPJ	P,		;YES, STOP!!
	LDB	T1,P.CL1A	;GET ASCII COLUMN 1
	CAIE	T1,"$"		;DOLLAR SIGN?
	JRST	STASC3		;NO, TREAT AS DATA
	LDB	T1,P.CL2A	;GET ASCII COLUMN 2
	CAIL	T1,"A"		;CHECK FOR ALPHABETIC
	CAILE	T1,"Z"		;BETWEEN A AND Z
	JRST	STASC2		;NOT A CONTROL CARD, CHECK OTHERS
	JRST	STASC7		;CONTROL CARD -- CHECK $MODE

STASC2:	TXNE	F,F.DOLR	;IS /DOLLARS ON?
	JRST	STASC3		;YES, DON'T TRIM ANYTHING OFF!
	MOVSI	T2,774000	;MASK FOR FIRST ASCII CHARACTER
	CAIN	T1,"$"		;IS SECOND CHARACTER A "$"?
	ANDCAM	T2,L.CARD	;TURN OFF FIRST "$"

STASCF:				;ENTRY POINT FOR FFJOB
STASC3:	PUSHJ	P,SUPRES	;DO SUPPRESS AND WIDTH
	PUSHJ	P,WRTASC	;WRITE THE CARD
	AOS	DEKCRD		;COUNT THE CARD
	JRST	STASC1		;AND GO AROUND FOR ANOTHER

STASC7:	MOVE	T1,L.CARD	;GET FIRST 5 CHARACTERS
	TRZ	T1,377		;AND IT DOWN TO 4 CHARACTERS
	CAME	T1,C.MODE	;$MODE CARD?
	JRST	STASC8		;NOPE, CHECK FOR END OF DECK
	PUSHJ	P,DOMODE	;GO CHANGE MODE
	JRST	STASC1		;AND CONTINUE STACKING

STASC8:	TXNN	F,F.DOLR	;IS /DOLLARS ON?
	POPJ	P,		;NO, END THE DECK
	HRLZI	T2,-.NMDEN	;NUMBER OF DECK ENDERS
STASC9:	CAMN	T1,C.END(T2)	;COMPARE
	POPJ	P,		;MATCH!! RETURN
	AOBJN	T2,STASC9	;AND LOOP AROUND
	JRST	STASC3		;NO MATCH, ITS PART OF THE DECK!
;+STIMG -- Routine to transfer User's IMAGE mode deck to disk.
;	Deck ends on CDR-EOF or Image Terminator.
;-;#3
;CALL:
;	PUSHJ P,STIMG
;	  RETURN HERE ALWAYS
;
;F.EOF WILL BE SET IF INPUT EOF TERMINATED TRANSFER.
;LOCATION DEKCRD IS RETURNED ZERO IF NO FILE WAS CREATED.

STIMG:	TXNN	F,F.ICDR	;IS CDR INPUT?
	PJRST	E$AMO		;NO, TELL HIM
	CLEARM	DEKCRD		;CLEAR CARD COUNTER
	CLEARM	DEKBLK		;CLEAR BLOCK COUNTER
	AOS	L.DEKN		;NEW DECK
	MOVE	T1,L.IMGT	;GET IMAGE MODE TERM COLUMN
	IDIVI	T1,3		;GET WORD IN T1, BYTE # IN T2
	ADD	T1,P.ICOL(T2)	;MAKE BYTE POINTER TO CORRECT COLUMN

STIMG1:	PUSHJ	P,CDRIMG	;GET IMAGE MODE CARD
	  POPJ	P,		;END OF FILE
	TXNE	F,F.FATE!F.KILL	;A STOP CONDITION?
	POPJ	P,		;YES, STOP!!
	LDB	T2,P.CL1I	;GET IMAGE COLUMN 1
	CAIE	T2,7777		;FULLY LACED?
	JRST	STIMG3		;NO, NOT END OF DECK
	LDB	T2,T1		;YES, GET SPECIFIED TERM COLUMN
	CAIN	T2,7777		;FULLY LACED?
	JRST	STIMG5		;YES, CHECK ALL OTHER COLS FOR ZEROES

STIMG3:	PUSHJ	P,WRTIMG	;WRITE THE CARD
	AOS	DEKCRD		;COUNT THE CARD
	JRST	STIMG1		;LOOP AROUND FOR ANOTHER CARD

STIMG5:	PUSH	P,L.CARD	;SAVE FIRST WORD
	PUSH	P,(T1)		;AND WORD WITH TERMINATOR
	CLEAR	T3,		;CLEAR A COUNTER
	DPB	T3,P.CL1I	;ZERO OUT FIRST COLUMN
	DPB	T3,T1		;AND TERMINATOR COLUMN

STIMG6:	SKIPE	L.CARD(T3)	;WORD ZERO?
	JRST	STIMG7		;NOT, NOT A TERMINATOR
	CAIGE	T3,IWPC-1	;LOOP FOR 27 WORDS
	AOJA	T3,STIMG6	;AND AROUND WE GO

	POP	P,(T1)		;RESTORE TERMINATOR COLUMN
	POP	P,L.CARD	;AND FIRST COLUMN
	POPJ	P,		;AND END THE DECK

STIMG7:	POP	P,(T1)		;RESTORE TERMINATOR COLUMN
	POP	P,L.CARD	;RESTORE FIRST COLUMN
	JRST	STIMG3		;ITS A DATA CARD!!
IFN FTUUOS,<

;+STBIN -- Routine to transfer user's BINARY mode deck.  Deck
;	ends on CDR-EOF or a control card.  Special check is made
;	to insure that a null file is not created.  The CDR input
;	routine CDRBIN is called.  CDRBIN does all the
;	checksumming and 7-9 checking and will decide whether it is a
;	control card (which will trap as an illegal binary card).
;-
;CALL:
;	PUSHJ P,STBIN
;	  RETURN HERE ALWAYS
;
;F.EOF WILL BE SET IF INPUT EOF TERMINATED TRANSFER.
;LOCATION DEKCRD IS RETURNED ZERO IF NO FILE WAS CREATED.

STBIN:	TXNN	F,F.ICDR	;IS CDR INPUT DEVICE?
	PJRST	E$AMO		;NO, TELL HIM
	CLEARM	DEKCRD		;CLEAR CARD COUNT
	CLEARM	DEKBLK		;CLEAR BLOCK COUNT
	AOS	L.DEKN		;START NEW DECK

STBIN1:	PUSHJ	P,CDRBIN	;GET A CARD
	  POPJ	P,		;EOF OR CONTROL CARD
	TXNE	F,F.FATE!F.KILL	;ANY STOP CONDITION?
	POPJ	P,		;YES, STOP NOW

	PUSHJ	P,WRTIMG	;WRITE OUT THE CARD
	AOS	DEKCRD		;COUNT IT
	JRST	STBIN1		;AND LOOP AROUND FOR ANOTHER
>  ;END IFN FTUUOS


IFN FTJSYS,<
STBIN:	PJRST	E$BNS		;BINARY NOT SUPPORTED
>  ;END IFN FTJSYS

;BYTE POINTERS FOR STIMG AND STBIN
P.ICOL:	POINT	12,L.CARD,35	;THIRD BYTE OF WORD
P.CL1I:	POINT	12,L.CARD,11	;FIRST BYTE OF WORD
	POINT	12,L.CARD,23	;SECOND BYTE OF WORD
	POINT	12,L.CARD,35	;THIRD BYTE OF WORD
SUBTTL	Device Input Routines

;^;+CDRASC -- Routine to read one logical ASCII record (card) from
;	the input device.  If device is DSK or MTA read in ASCII
;	mode.  If device is a local CDR read in Super-image
;	mode and convert to ASCII.  If device is remote CDR
;	read in image mode, convert to superimage, and then to ASCII.
;-;#3
;CALL:
;	PUSHJ P,CDRASC
;	  RETURN HERE ON INPUT EOF 
;	  RETURN HERE OTHERWISE
;
;ON NORMAL RETURN (SKIP), INTERNAL BUFFER 'L.CARD' WILL HAVE ASCIZ RECORD.
;JOBINT INTERRUPT WILL CAUSE NON-SKIP RETURN TO BE TAKEN IF F.BUSY
;IS OFF.

CDRASC:	MOVE	B,P.ASBP	;SETUP BYTE POINTER TO 'L.CARD'
	OFF	F.RSCN		;CLEAR RESCAN BIT
	CLEARM	L.BRK		;CLEAR BREAK FLAG
	MOVE	T3,P.CL1A	;POINT TO 1ST COLUMN
	MOVEM	T3,L.SPBP	;FOR SUPPRESS
	SKIPN	T1,L.WIDT	;GET WIDTH PARAMETER
	MOVEI	T1,^D80		;USE 80 IF NULL
	MOVEM	T1,L.CCNT	;AND SET DOWN COUNTER FOR THIS CARD
	TXNN	F,F.LCDR	;LOCAL CDR?
	JRST	CDRAS5		;NO, GO HANDLE OTHER THINGS

	TXZE	F,F.INHI	;INHIBIT THIS INPUT?
	JRST	.+3		;YES
	PUSHJ	P,CDRIN		;GET A CARD
	  POPJ	P,		;EOF
	MOVE	T4,L.CRBP	;GET SAVED BYTE-POINTER
	MOVEM	T4,CDRBP	;AND SAVE IT
	CLEARB	T4,L.NHOL	;CLEAR A COUNTER, AND # OF HOL ERRORS
	MOVSI	T4,-ACPC	;SETUP LOOP COUNTER (AOBJN)
	HRR	T4,CDRBP	;GET ADDRESS OF DATA WORD-1
	ADDI	T4,1		;POINT TO FIRST DATA WORD
	MOVE	T3,L.CHOL	;AND LOAD THE BYTE POINTER
	MOVEM	T3,L.CRLC	;SAVE FOR CHECK

CDRAS1:	MOVEI	C,.ASSPC	;TRY FOR MOST OBVIOUS FIRST
	SKIPN	T5,(T4)		;WAS IT A SPACE?
	JRST	CDRAS2		;YES, WIN!
	JUMPL	T5,[MOVEI C,"\"
		    AOS   L.NHOL
		    JRST  CDRAS2];HOLLERITH ERROR!!
	HLRZ	C,T5		;GET SUPER HALF
	LDB	C,T3		;AND GET THE CHARACTER
;[1061] CDRAS1+5 1/2
	CAME	T3,P.026	;IS MODE 026?
	 JRST	CDRAS2		;NO
	CAIN	C,173		;ALTERNATE "?"?
	 MOVEI	C,77		;YES, MAKE IT REAL "?"
	CAIN	C,175		;ALTERNATE ":"?
	 MOVEI	C,72		;YES, MAKE IT REAL ":"
CDRAS2:	IDPB	C,B		;DEPOSIT CHARACTER IN BUFFER
	SOSL	L.CCNT		;PAST /WIDTH?
	CAIN	C,.ASSPC	;NO, WAS IT A SPACE?
	AOBJN	T4,CDRAS1	;YES, JUST LOOP
	MOVEM	B,L.SPBP	;NO, SAVE BP FOR SUPPRESS
	AOBJN	T4,CDRAS1	;AND LOOP FOR A FULL CARD

CDRAS3:	MOVE	T1,B		;LOAD T1 WITH BP
	PUSHJ	P,DEPEOL	;AND DEPOSIT <CR-LF-NULL>
	SKIPE	L.NHOL		;ANY HOLLERITH ERRORS?
	PUSHJ	P,TELHOL	;YUP, GO TELL HIM
	JRST	CDRA10		;CHECK IF OPR WANTS TO SEE, AND RETURN
CDRAS5:	TXNN	F,F.RCDR	;REMOTE CDR?
	JRST	CDRAS8		;NO GO HANDLE ASCII DEVICES

;HERE HANDLE REMOTE CARD READERS

	TXZE	F,F.INHI	;INHIBIT INPUT?
	JRST	.+3		;YES
	PUSHJ	P,CDRIN		;GET A CARD
	  POPJ	P,		;EOF -- RETURN
	MOVE	T5,L.CRBC	;GET SAVED BYTE COUNT
	MOVEM	T5,CDRBC	;AND SAVE IT
	MOVE	T5,L.CRBP	;GET SAVED BYTE POINTER
	MOVEM	T5,CDRBP	;AND SAVE IT
	CLEARM	L.NHOL		;CLEAR # OF HOLLERITH ERRORS
	MOVE	T5,L.CHOL	;AND LOAD THE BYTE POINTER
	MOVEM	T5,L.CRLC	;AND SAVE IT

CDRAS6:	SOSGE	CDRBC		;COUNT DOWN (YES, SOSGE IS CORRECT)
	JRST	CDRAS3		;DONE, PUT CRLF-NULL ON AND RETURN
	ILDB	T3,CDRBP	;GET 12-BIT IMAGE
IFN FTJSYS,<
	ANDI	T3,7777		;AND OUT THE GARBAGE
>  ;END IFN FTJSYS
	MOVEI	C,40		;CHECK FOR SPACE
	JUMPE	T3,CDRAS7	;WIN!!
	CLEARB	C,T4		;CLEAR THESE TO BUILD SUPER-IMG

;HERE BUILD SUPER-IMAGE FROM IMAGE
	LSHC	T3,-11		;SPLIT IMAGE BET T3 AND T4
	LSH	T3,4		;LEAVE SOME ROOM
	TRO	C,(T3)		;THIS IS PART OF IT
	LSH	T4,-1		;BIT NUMBER CORRESPONDS WITH
				; COLUMN NUMBER
	TLZE	T4,(1B8)	;GET BIT 8
	TRO	C,1B32		;AND SET IT IF IT WAS SET
	TLZE	T4,(1B9)	;DO THE SAME FOR BIT 9
	TRO	C,1B28		;  "     "         " "
	MOVE	T3,T4		;COPY OVER FOR JFFO
	JFFO	T3,.+1		;SEE IF ANY COLUMN LIT!!
	ADDI	C,(T4)		;FINISH UP LAST 3 BITS (COL 1-7)
	LSH	T3,1(T4)	;CHECK FOR HOLLERITH ERROR
	SKIPE	T3		;BETTER BE ZERO!!
	JRST	[MOVEI  C,"\"
		 AOS    L.NHOL
		 JRST   CDRAS7]	;HOLLERITH ERROR
	LDB	C,T5		;AND GET ASCII CODE

CDRAS7:	IDPB	C,B		;DEPOSIT IT
	SOSL	L.CCNT		;PAST /WIDTH?
	CAIN	C,.ASSPC	;NO, WAS IT A SPACE?
	JRST	CDRAS6		;YES, JUST LOOP
	MOVEM	B,L.SPBP	;NO, SAVE BYTE-POINTER FOR SUPPRESS
	JRST	CDRAS6		;AND LOOP FOR ANOTHER CHAR
;HERE TO HANDLE ASCII INPUT DEVICES

CDRAS8:	SOSLE	CDRBC		;ANYTHING LEFT IN BUFFER?
	JRST	CDRAS9		;YUP, GO PROCESS
	PUSHJ	P,CDRIN		;NO, GET ANOTHER BUFFER FUL
	  POPJ	P,		;EOF
	SOS	CDRCNT		;BUFFERS DON'T EQUAL CARDS HERE

CDRAS9:	ILDB	C,CDRBP		;GET A CHARACTER
;[1062] CDRAS9 + 1
	JUMPE	C,CDRAS8		;IGNORE NULLS
IFN	FTJOBQ,<
	SKIPE	L.2629		;SEE IF IN 026 MODE (THIS WILL ONLY GET
				; SET NON-0 WHEN USING JOBQUE)
	  PUSHJ	P,C2629		;CONVERT FROM 026 TO 029
>;END IFN FTJOBQ
	IDPB	C,B		;DEPOSIT IT INTO 'L.CARD'
	CAIN	C,.CHCRT	;CARRIAGE RETURN?
	JRST	CDRAS8		;YES, JUST LOOP AROUND
	CAIN	C,.CHLFD	;LINE-FEED?
	JRST	CDRAS0		;YES, FINISH UP
	SOSL	L.CCNT		;PAST /WIDTH?
	CAIN	C,.ASSPC	;NO, WAS IT A SPACE?
	JRST	CDRAS8		;YES, LOOP
	MOVEM	B,L.SPBP	;NO, SAVE BYTE POINTER FOR SUPPRESS
	JRST	CDRAS8		;YES, GET ANOTHER CHARACTER

;HERE ON END-OF-LINE
CDRAS0:	CLEAR	C,		;MAKE A NULL
	IDPB	C,B		;MAKE ASCII STRING ASCIZ STRING
	AOS	CDRCNT		;ONE MORE CARD
IFN	FTJOBQ,<
	SKIPE	JOBQUE		;USING JOB QUE?
	 SOSL	JOBLMT		;SEE IF OVER LIMIT YET
	  JRST	CDRA10		;NOT JOB QUE OR NOT OVER LIMIT
	ON	F.EOF!F.FATE	;OVER LIMIT  SO FATAL ERROR
				; AND EOF (THIS MAKE OTHER ROUTINES DO
				;  THE RIGHT THING)
	STAMP	STSUM		;
	TELL	LOG,[ASCIZ \Job Aborted due to Card Limit exceeded
\]
	SKIPL	LOGBH		;IS LOG FILE OPEN?
	  PUSHJ	P,NTAJOB	;NO, CALL THIS TO OPEN IT
>;END IFN FTJOBQ

CDRA10:	HRRZ	C,L.MSGL	;GET MSGLVL
	CAIN	C,3		;DOES OPR WANT TO SEE EVERY CARD?
	TELL	OPR!NAC,L.CARD	;YES, TELL HIM
	PJRST	.POPJ1		;AND RETURN
IFN	FTJOBQ,<

;HERE TO CONVERT FROM 026 TO 029
;
C2629:	MOVE	T4,C		;GET THE CHARACTER
	IDIVI	T4,5		;FIGURE INDEX INTO THE TABLE
	LDB	C,[POINT 7,C26TAB(T4),6
		POINT	7,C26TAB(T4),13
		POINT	7,C26TAB(T4),20
		POINT	7,C26TAB(T4),27
		POINT	7,C26TAB(T4),34](T5)	;CONVERT THE CHAR
	POPJ	P,		;RETURN WITH CONVERTED CHAR IN C

C26TAB:	BYTE(7)0,1,2,3,4		;0 - 4
	BYTE(7)5,6,7,10,11		;5 - 11
	BYTE(7)12,13,14,15,16		;12 - 16
	BYTE(7)17,20,21,22,23		;17 - 23
	BYTE(7)24,25,26,27,30		;24 - 30
	BYTE(7)31,32,33,34,35		;31 - 35
	BYTE(7)36,37,40,41,134		;36 - 42
	BYTE(7)75,44,50,53,136		;43 - 47
	BYTE(7)135,133,52,74,54		;50 - 54
	BYTE(7)55,56,57,60,61		;55 - 61
	BYTE(7)62,63,64,65,66		;62 - 66
	BYTE(7)67,70,71,137,76		;67 - 73
	BYTE(7)51,47,43,45,100		;74 - 100
	BYTE(7)101,102,103,104,105	;101 - 105
	BYTE(7)106,107,110,111,112	;106 - 112
	BYTE(7)113,114,115,116,117	;113 - 117
	BYTE(7)120,121,122,123,124	;120 - 124
	BYTE(7)125,126,127,130,131	;125 - 131
	BYTE(7)132,77,73,72,46		;132 - 136
	BYTE(7)42,140,141,142,143	;137 - 143
	BYTE(7)144,145,146,147,150	;144 - 150
	BYTE(7)151,152,153,154,155	;151 - 155
	BYTE(7)156,157,160,161,162	;156 - 162
	BYTE(7)163,164,165,166,167	;163 - 167
	BYTE(7)170,171,172,77,174	;170 - 174
	BYTE(7)72,176,177,0,0		;175 - 177

>;END IFN FTJOBQ
;+CDRIMG -- Routine to read one card in Image mode.
;	Handles local and remote CDRs separately.
;-;#3
;CALL:
;	PUSHJ P,CDRIMG
;	  RETURN HERE ON EOF OR IMAGE TERMINATOR
;	  RETURN HERE OTHERWISE
;
;	ON NORMAL RETURN 'L.CARD' CONTAINS CARD IMAGE IN
;	12-BIT PACKED BYTES.

CDRIMG:	PUSHJ	P,CDRIN		;GET A CARD
	  POPJ	P,		;END-OF-FILE

IFN FTUUOS,<
	TXNN	F,F.LCDR	;LOCAL CDR?
	JRST	CDRIM2		;NO, GO HANDLE REMOTE CDR

	HRRZ	T4,CDRBH+1	;GET ADDRES OF 1ST DATA WORD-1
	MOVE	B,P.IMBP	;LOAD BYTE POINTER TO CARD
	HRLZI	T5,-CPC		;AOBJN POINTER FOR 80 COLUMNS

CDRIM1:	AOJ	T4,		;POINT TO NEXT DATA WORD
	HRRZ	C,(T4)		;GET 12-BIT SIDE OF WORD
	IDPB	C,B		;DEPOSIT IT INTO 'CARD'
	AOBJN	T5,CDRIM1	;LOOP AROUND FOR ALL COLUMNS
	JRST	CDRIM4		;GO TAKE COMMON RETURN

;HERE FOR REMOTE CDRS

CDRIM2:	HRLZ	T5,CDRBH+1	;GET ADR OF FIRST DATA WORD -1
	HRRI	T5,L.CARD-1	;GET DESTINATION ADR -1
	AOBJN	T5,.+1		;SOURCE,,DESTIMATION FOR BLT
	MOVEI	T4,L.CARD+IWPC-1;LAST PLACE TO BLT TO
	BLT	T5,(T4)		;ALL IN ONE FELL SWOOP
>  ;END IFN FTUUOS

IFN FTJSYS,<
	MOVE	B,P.IMBP	;LOAD BYTE-POINTER TO CARD
	HRLZI	T5,-CPC		;MAKE A 80 COLUMN AOBJN POINTER

CDRIM1:	ILDB	C,CDRBP		;GET A COLUMN
	IDPB	C,B		;DEPOSIT
	AOBJN	T5,CDRIM1	;AND LOOP
	JRST	CDRIM4		;DONE, RETURN
>  ;END IFN FTJSYS

;COMMON RETURN
CDRIM4:	MOVEI	T5,IWPC		;SETUP NUMBER OF WORDS
	MOVEM	T5,L.IWRD	;STORE IT
	PJRST	.POPJ1		;AND SKIP BACK
IFN FTUUOS,<
;+CDRBIN -- Routine to read a Binary mode card.
;	Reads each card and checks for a 7-9 punch, stores the
;	word count and checksum from card.  Computes checksum
;	and checks against punched checksum.  If no 7-9 punch
;	is found, checks for a control card, and if found takes
;	non-skip return else an error is put out.
;-
;CALL:
;	PUSHJ P,CDRBIN
;	  RETURN HERE ON EOF OR CONTROL CARD
;	  RETURN  HERE WITH BINARY IN 'L.CARD'
;
;ON NORMAL RETURN BINARY IS PACKED IN 12-BIT PACKED BYTES IN
;LINE BUFFER 'L.CARD', AND L.IWRD IS SET TO WORD COUNT.

CDRBIN:	PUSHJ	P,CDRIN		;GET A CARD
	  POPJ	P,		;END-OF-FILE

	MOVE	B,P.IMBP	;LOAD IMAGE MODE BYTE POINTER TO 'CARD'
	HRRZ	T5,CDRBP	;GET ADDRESS OF DATA WORD -1
	AOS	T5		;POINT TO DATA
	HRRZ	C,(T5)		;GET FIRST DATA WORD (IF LOCAL CDR)
	TXNN	F,F.LCDR	;IS IT LOCAL?
	ILDB	C,CDRBP		;NO, GET FIRST BYTE IN IMAGE
	TRC	C,.IM79		;REVERSE ROWS 7 AND 9
	TRCE	C,.IM79		;WERE THEY BOTH ON?
	JRST	NO79		;NOPE!!
	LSH	C,-6		;RIGHT JUSTIFY WORD COUNT
	MOVEM	C,L.IWRD	;AND STORE IT

	HRRZ	C,1(T5)		;GET NEXT COLUMN (IF LOCAL)
	TXNN	F,F.LCDR	;IS IT LOCAL?
	ILDB	C,CDRBP		;NO  LOAD NEXT COLUMN
	MOVEM	C,L.CCHK	;THIS IS THE CHECKSUM
	TXNN	F,F.LCDR	;LOCAL CDR?
	JRST	CDRBI5		;NO, HANDLE REMOTES DEVICE DEPENDENTLY
;BINARY INPUT FOR LOCAL CDRS
	MOVE	T4,L.IWRD	;GET WORD COUNT
	IMULI	T4,-3		;MAKE INTO NEGATIVE COLUMNS
	HRLZS	T4		;PUT IN LH
	ADDI	T4,2(T5)	;ADD IN ADR OF 1ST DATA WORD

CDRBI1:	HRRZ	C,(T4)		;GET A 12-BIT IMAGE
	IDPB	C,B		;DEPOSIT IN LINE BUFFER
	AOBJN	T4,CDRBI1	;AND LOOP FOR ALL COLUMNS
	JRST	CDRBI7		;CHECK CHECKSUM AND RETURN



;HERE FOR REMOTE CDRS
CDRBI5:	MOVE	T4,L.IWRD	;GET NUMBER OF WORDS
	IMULI	T4,-3		;MAKE NEG COL COUNT
	HRLZS	T4		;AND MAKE AOBJN POINTER

CDRBI6:	ILDB	C,CDRBP		;GET A BYTE
	IDPB	C,B		;DEPOSIT IT
	AOBJN	T4,CDRBI6	;AND LOOP AROUND



;HERE TO CHECK CHECKSUM AND RETURN
CDRBI7:	MOVN	T4,L.IWRD	;GET NEG WORD COUNT
	HRLZ	T4,T4		;PUT IN LEFT HALF
	ADDI	T4,L.CARD	;MAKE AOBJN POINTER
	CLEAR	T3,		;ACCUMUALTE CHECKSUM HERE

CDRBI8:	ADD	T3,(T4)		;ADD A WORD
	AOBJN	T4,CDRBI8	;GET ALL WORDS
	LSHC	T3,-30		;THIS ALGORITHM IS USED BY UUOCON
	LSH	T4,-14		; ROUTINE CKS12 TO COMPUTE A
	ADD	T3,T4		; 12 BIT FOLDED CHECKSUM
	LSHC	T3,-14
	LSH	T4,-30
	ADD	T3,T4
	TRZE	T3,770000
	AOS	T3
	CAMN	T3,L.CCHK	;DOES IT MATCH CHECKSUM ON CARD
	PJRST	.POPJ1		;YUP, SKIP BACK
	STAMP	STERR		;STAMP THE ERROR
	TELL	LOG,BCK%	;GIVE HIM A WARNING
	TELL	LOG,HOL3%	;AND CARD INFO
	TELL	LOG,CRLF
	AOS	T3,L.TCHK	;INCREMENT ERROR COUNT AND LOAD
	CAMG	T3,L.UCHK	;COMPARE AGAINST MAX
	PJRST	.POPJ1		;STILL LEGAL
	MOVEI	T1,TMC%		;ADR OF MESSAGE
	PJRST	LOGERR		;LOG AND RETURN

>  ;END IFN FTUUOS
SUBTTL	Error and Utility Routines for Device Input

;^;+TELHOL -- Routine to tell user about Hollerith errors in the
;	current card.  Called at the end of card-translation if
;	L.NHOL is non-zero.  Tells the user how many errors and
;	shows him the card.  Also detects 'Too Many Hollerith
;	Errors' condition.
;-;#3
;CALL:
;	PUSHJ P,TELHOL
;	  RETURN HERE ALWAYS

TELHOL:	TXNE	F,F.FATE	;WAS THERE A FATAL ERROR?
	POPJ	P,		;YES, SKIP THIS STUFF
	STAMP	STERR		;STAMP THE LOG
	TELL	LOG,HOL%	;HOLLERITH ERROR
	AOS	DEKCRD		;GIVE THE CORRECT COUNT
	TXNE	F,F.DECK	;ARE WE IN A DECK?
	TELL	LOG,HOL3%	;YES GIVE CARD IN DECK MESSAGE
	TELL	LOG,CRLF	;AND A CRILIF
	SOS	DEKCRD		;BRING COUNT INTO PHASE AGAIN
	STAMP	STERR		;STAMP
TELHL1:	TELL	LOG,[ASCIZ /	Card= /]
	TELL	LOG!NAC,L.CARD	;AND TYPE THE OFFENDING CARD
	MOVE	T1,L.NHOL	;GET NUMBER OF ERRORS
	ADDB	T1,L.THOL	;ADD TO TOTAL
	CAMG	T1,L.UHOL	;GREATER THAN ALLOWABLE?
	POPJ	P,		;NO, ALL IS WELL
	MOVEI	T1,TMH%		;TOO MANY HOLLERITH ERRORS
	PJRST	LOGERR		;AND LOG THE ERROR
;+SUPRES -- Routine to implement /WIDTH and /SUPPRESS switches.
;	SUPRES first processes WIDTH if set, by placing
;	the sequence <CR-LF-NULL> after the nth character, where
;	n is the argument to /WIDTH. Then SUPPRESS is
;	done by placing the same sequence following the last non-blank
;	character of the card, using the byte-pointer saved in L.SPBP.
;	Call FSUPR to force suppression only.
;-;#3
;CALL:
;	PUSHJ	P,SUPRES
;	  ALWAYS RETURN HERE

SUPRES:	SKIPN	T1,L.WIDT	;LOAD THE WIDTH AND SKIP IF NOT ZERO
	JRST	SUPRS2		;ZERO, GO DO SUPPRESS
	IDIVI	T1,5		;CONVERT CHARACTERS TO WORDS
	ADDI	T1,L.CARD	;ADD IN BASE ADDRESS
	ADD	T1,WIDTBL(T2)	;MAKE IT A BYTE POINTER

SUPRS1:	PUSHJ	P,DEPEOL	;DEPOSIT THE EOL

SUPRS2:	TXNN	F,F.SPS		;IS SUPPRESS ON?
	POPJ	P,		;NO, RETURN
FSUPR:	MOVE	T1,L.SPBP	;YES, LOAD THE BYTE-POINTER
	PJRST	DEPEOL		;AND GO DEPOSIT AN EOL

WIDTBL:	POINT	7,0
	POINT	7,0,6
	POINT	7,0,13
	POINT	7,0,20
	POINT	7,0,27

;+DEPEOL -- Routine to deposit <CR-LF-NULL> according
;	to the byte-pointer in T1.  Call with T1 containing a
;	byte-pointer to the byte before the CR (ie so IDPB
;	can be done).
;-;#2
;CALL:
;	PUSHJ P,DEPEOL
;	  ALWAYS RETURN HERE

DEPEOL:	MOVEI	C,.CHCRT	;LOAD A CARRIAGE RETURN
	IDPB	C,T1		;DEPOSIT IT
	MOVEI	C,.CHLFD	;A LINE-FEED
	IDPB	C,T1		;DEPOSIT IT
	MOVEI	C,0		;A NULL
	IDPB	C,T1		;DEPOSIT IT
	POPJ	P,		;AND RETURN
IFN FTUUOS,<
;+NO79 -- Routine called when a BINARY card has no 7-9 punch in
;	column 1.  If column 1 is a "$" in ASCII, converts the
;	card to ASCII and POPJ's back with control card.
;	Otherwise, gives a warning and ignores the card by reading
;	reading the next, unless the TMB condition holds,
;	in which case we notify the user, and punt.
;-;#2

NO79:	CAIE	C,.IMDOL	;IS COLUMN 1 AN DOLLAR SIGN?
	JRST	NO798		;NO, ILL BIN CARD

	TXNE	F,F.LCDR	;IS IT A LOCAL CDR?
	JRST	NO791		;YES, GO RETRANSLATE
	MOVEI	T1,1400		;OTHERWISE FIX UP CDRBP A LITTLE
	HRLM	T1,CDRBP	;RESET LEFT HALF,
	SOS	CDRBP		;AND SOS RIGHT HALF

NO791:	ON	F.INHI		;INHIBIT ANOTHER INPUT
	PUSHJ	P,CDRASC	;CONVERT TO ASCII
	  HALT			;EOF CAN'T POSSIBLY HAPPEN
	POPJ	P,		;AND RETURN

;HERE IF COLUMN 1 IS NOT A DOLLAR SIGN

NO798:	STAMP	STERR		;STAMP THE LOG
	TELL	LOG,IBC%	;ILLEGAL BINARY CARD
	TELL	LOG,HOL3%	;WHERE IS IT
	TELL	LOG,CRLF	;AND CRLF
	AOS	T3,L.TIBC	;INCREMENT COUNT
	CAMG	T3,L.UIBC	;GREATER THAN ALLOWABLE?
	JRST	CDRBIN		;NO, JUST IGNORE CARD
	MOVEI	T1,TMB%		;TOO MANY ILL BIN CARDS
	PJRST	LOGERR		;LOG IT!!
>  ;END IFN FTUUOS
SUBTTL	User File Output Routines

;WRTASC -- ROUTINE TO PLACE ASCII LINE IN 'L.CARD' INTO DSK
;	OUTPUT BUFFER TO USER'S FILE.
;
;CALL:
;	PUSHJ P,WRTASC
;	  ALWAYS RETURN HERE

WRTASC:	MOVE	B,P.ASBP	;POINT TO 'L.CARD'
WRTAS1:	ILDB	C,B		;GET A CHARACTER
	JUMPE	C,WRTAS1	;IGNORE NULLS
	SOSG	FILBC		;ANYMORE ROOM IN DSK BUFFER?
	PUSHJ	P,FILUUO	;NO, DUMP IT AND ADVANCE
	IDPB	C,FILBP		;DEPOSIT CHARACTER
	CAIE	C,.CHLFD	;EOL?
	JRST	WRTAS1		;NO, GET ANOTHER CHARACTER
	POPJ	P,		;DONE, RETURN


;WRTIMG -- ROUTINE TO PLACE IMAGE OR BINARY CARD DATA INTO USER'S
;	DISK FILE.  WRITES THE NUMBER OF WORDS SPECIFIED IN
;	LOCATION L.IWRD.
;
;CALL:
;	PUSHJ P,WRTIMG
;	  ALWAYS RETURN HERE

WRTIMG:	MOVN	T4,L.IWRD	;GET NEGATIVE WORD COUNT
	HRLZS	T4		;PUT IT IN LEFT HALF
	ADDI	T4,L.CARD	;ADDRESS OF DATA

WRTIM1:	SOSG	FILBC		;ANY ROOM IN DSK BUFFER
	PUSHJ	P,FILUUO	;NO, DUMP IT
	MOVE	C,(T4)		;GET A DATA WORD
	IDPB	C,FILBP		;DEPOSIT IT IN BUFFER
	AOBJN	T4,WRTIM1	;LOOP FOR ALL OF THEM
	POPJ	P,		;AND RETURN


;HERE TO DO THE OUTPUT UUO
FILUUO:	AOS	DEKBLK		;INCREMENT THE BLOCK COUNTER
IFN FTJSYS,<
	AOS	L.TBLK		;INCREMENT TOTAL BLOCKS WRITTEN
>  ;END IFN FTJSYS
	OUT	FIL,		;DO THE UUO
	  POPJ	P,		;WIN!!
	MOVEI	T1,EWF%		;ERROR WRITING FILE
	PJRST	LOGERR		;LOG IT
SUBTTL	Input Device Monitor Interface

;CDRIN -- ROUTINE TO DO INPUT UUO FROM INPUT DEVICE.
;	CDRIN INCREMENTS CDRCNT
;
;CALL:
;	PUSHJ P,CDRIN
;	  RETURN HERE ON END OF FILE
;	  RETURN HERE OTHERWISE

CDRIN:	PUSHJ	P,CHKOPR	;SEE IF THE OPR WANTS SOMETHING

IFN FTJSYS,<
	SKIPE	L.OFF		;WAS IT OFF-LINE?
	PUSHJ	P,TSTOFF	;YES, CHECK NOW
	SKIPE	L.OFF		;IS IT OFF-LINE?
	POPJ	P,		;YES, RETURN
>  ;END IFN FTJSYS
	ON	F.IN		;FLAG INPUT UUO IN PROGRESS
	IN	CDR,		;GET A CARD
	JRST	CDRINA		;WIN!!
	OFF	F.IN		;TURN OFF UUO IN PROGRESS BIT
	STATZ	CDR,IO.EOF	;I/O ERROR, CHECK FOR EOF
	JRST	INEOF		;ITS AN EOF!!
	JRST	CDRIN2		;NOT EOF, DO SOME ANALYSIS

CDRINA:	STATO	CDR,IO.SYN	;IS SYNCH ON?
	JRST	CDRIN0		;NO, CONTINUE NORMALLY
	PUSH	P,T1		;SAVE T1
	JRST	CDRIN7		;AND CHECK FOR BAD DATA

CDRIN0:	OFF	F.IN		;TURN OFF THE UUO FLAG
	TXNN	F,F.ICDR	;IS IT A CDR?
	JRST	CDRIN1		;NO, DSK OR MTA
	MOVE	C,CDRBC		;GET THE BYTE COUNT
	MOVEM	C,L.CRBC	;SAVE IT
	MOVE	C,CDRBP		;WE'VE GOT TO HANDLE EOF
	MOVEM	C,L.CRBP	;AND SAVE BYTE POINTER ALSO
	ILDB	C,C		;GET FIRST CHARACTER
	ANDI	C,7777		;GET RID OF ANY GARBAGE
	CAIN	C,.IMEOF	;EOF?
	JRST	INEOF		;YES, SET FLAG AND RETURN
CDRIN1:	AOS	CDRCNT		;INCREMENT CARD COUNT
	OFF	F.DER!F.JBI	;CLEAR THE DEVICE ERROR FLAG
	PJRST	.POPJ1		;AND SKIP BACK

;HERE ON INPUT EOF
INEOF:	ON	F.EOF		;SET EOF FLAG
	PUSH	P,T1		;SAVE T1
	GETSTS	CDR,T1		;GET CHANNEL STATUS
	TXZE	T1,IO.EOF	;TURN OFF THE EOF BIT, SKIP IF TWAS OFF
	CLOSE	CDR,		;CLEAR IODEND
	SETSTS	CDR,(T1)	;AND RE-SET THE STATUS

IFN FTJSYS,<
	PUSHJ	P,TSTOFF	;CHECK THE OFF-LINE
>  ;END IFN FTJSYS
	PJRST	T1POPJ		;AND RETURN
CDRIN2:	STATZ	CDR,IO.DER	;DEVICE ERROR IS ALL I UNDERSTAND
	TXNN	F,F.ICDR	;IT IS, IS IT A CDR?
	JRST	INERR		;NO, I CAN'T DO ANYTHING

CDRIN3:	PUSH	P,T1		;SAVE T1

IFN FTJSYS,<
	TELL	OPR,RCK%	;READ CHECK
	JRST	CDRIN6		;AND CONTINUE ON
>  ;END IFN FTJSYS
	MOVEI	T1,CDR		;GET CDR CHANNEL NUMBER
	DEVSTS	T1,		;GET DEVICE STATUS
	  JRST	CDRIN5		;MAKE UP A MESSAGE
	TXNE	T1,CN.RCK	;READ CHECK?
	TELL	OPR,RCK%	;YES, TELL HIM
	TXNE	T1,CN.CME	;CARD MOTION?
	TELL	OPR,CME%	;YUP!!
	TXNE	T1,CN.DTM	;OR DATA MISSED?
	TELL	OPR,DTM%	;YOU BET!
	SKIPA			;AND RESET LAST CARD
CDRIN5:	TELL	OPR,DVE%	;A CARD-READER ERROR
CDRIN6:	TELL	OPR,RLC%	;RESET LAST CARD
	ON	F.DER		;SET THIS FOR THE JOBINT ROUTINE
	MOVE	T1,CDROPN	;GET THE IO MODE
	SETSTS	CDR,IO.SYN(T1)	;AND SET THE STATUS AND SYNCHONIZE
CDRIN7:	MOVE	T1,CDRBH	;GET THE ADR OF CURRENT BUFFER
	MOVE	T1,-1(T1)	;GET THE BUFFER STATUS
	TXNE	T1,IO.DER	;IS THIS THE BAD BUFFER?
	JRST	CDRIN8		;YES, FIX THINGS UP AND IGNORE IT
;**;[1065] CHANGE @ CDRIN7+4	JNG	27-Jul-75
	MOVE	T1,@CDRBH	;[1065] GET LINK WORD OF CURRENT BUFFER
	SKIPGE	(T1)		;[1065] IS NEXT BUFFER NOT IN USE?
	JRST	[POP  P,T1
		 JRST CDRIN0]	;NO, THIS BUFFER "MUST" BE GOOD!
CDRIN8:	MOVE	T1,CDROPN	;GET IO MODE
	SETSTS	CDR,(T1)	;SET THE STATUS
	POP	P,T1		;RESTORE T1
	JRST	CDRIN		;AND RE-DO THE UUO




;HERE FOR AN UNRECOVERABLE INPUT ERROR
INERR:	GETSTS	CDR,T1		;GET THE DEVICE STATUS
	TELL	OPR,UIE%	;UNRECOVERABLE INPUT ERROR
	RAD08	OPR,T1		;STATUS
	JRST	ABEND		;AND DIE
IFN FTJSYS,<
TSTOFF:	SETZM	L.OFF		;ASSUME ITS ON-LINE
	PUSH	P,T1		;SAVE T1
	PUSH	P,T2		;SAVE T2
	PUSH	P,T3		;SAVE T3
	MOVE	T1,L.JFN	;GET THE JFN
	MOVX	T2,.MORST	;READ STATUS
	MOVEI	T3,2		;LEN OF ARG BLOCK
	MOVEM	T3,L.ARGS	;STORE IT
	MOVEI	T3,L.ARGS	;GET ADR OF ARG BLOCK
	MTOPR			;DO THE READ STATUS
	  ERJMP	TSTOF1		;LOSE?
	MOVE	T3,L.ARGS+1	;GET THE STATUS
	TXNE	T3,MO%OL	;IS IT OFF-LINE?
	SETOM	L.OFF		;YES, SET THE FLAG

TSTOF1:	POP	P,T3		;RESTORE T3
	POP	P,T2		;RESTORE T2
	POP	P,T1		;RESTORE T1
	POPJ	P,		;AND RETURN
>  ;END IFN FTJSYS
SUBTTL	Accounting File Handlers

	UP

IFN FTUUOS,<
;***THIS CONDITIONAL CONTINUES FOR APPROXIMATELY 18 PAGES**
;		IT TERMINATES AFTER INPAUX ROUTINE


COMMENT /
;^;=
		Accounting File Handlers

The Accounting File Handlers are a set of routines which manipulate
the ACCT.SYS and AUXACC.SYS files.

The routines are:

	BILDAC	Build In-core Index
	SRHACC	Search ACCT.SYS
	SRHAUX	Search AUXACC.SYS
	MAKSL	Generate Search List
	MAKPTH	Make UFD and SFD's
	SETUFL	Routine to Set UFD Interlock
	DOACCT	Setup all accounting for a specific job

The accounting file index consists of two parallel tables.  The first
table contains the first PPN in each block of ACCT.SYS.  The
second table contains XWD word #,block # for the corresponding
entry in AUXACC.SYS.
;--;^

The following hiseg variable locations are used to store information
about the tables, and effect the necessary interlocks.
/

	.HWFRMT			;SWITCH TO OLD FORMAT LISTING
H.IDX:	BLOCK	1		;0=NO INDEX EXISTS, -1=INDEX EXISTS
H.LOCK:	-1			;GE ZERO=INDEX BEING BUILT
				;-1 MEANS LOCK IS AVAILABLE
H.ASIZ:	BLOCK	1		;LENGTH OF TABLE. =SIZE OF ACCT.SYS
				;IN BLOCKS
H.ADAT:	BLOCK	1		;CREATION DATE-TIME OF ACCT
H.XDAT:	BLOCK	1		;[1050] CREATION DATE-TIME OF AUXACC
H.ESIZ:	BLOCK	1		;ENTRY SIZE

;DUMP MODE OPEN BLOCK FOR 'SYS
H.OSTS:	EXP	.IODMP		;DUMP MODE
H.OSYS:	SIXBIT	/SYS/		;SYS
H.OBRH:	EXP	0		;NO BUFFER HEADER


	.AFMT2==2		;OUR ACCT.SYS FORMAT
	.AFMT3==3		;NEW VM ACCT.SYS FORMAT
	.AFMT4==4		;[1056] SCHED AND ENQ/DEQ ACCT.SYS
	.UFMT==0		;OUR AUXACC.SYS FORMAT
	.UBKS==5		;WORDS/STR IN AUXACC

	.MFRMT			;BACK TO NEW FORMAT LISTING
;BILDAC -- Routine to build in-core ACCT.SYS index
;	and AUXACC.SYS Index.

BILDAC:	PUSHJ	P,LKACC		;GO CHECK FOR ACCT.SYS CHANGE
	JRST	BILDC2		;IT CHANGED, GO BUILD THE INDEX
	PJRST	SLEEPR		;WAIT FOR IT TO BE BUILT, AND RETURN

BILDC2:	USETI	ACT,1		;START FROM THE BEGINNING
	PUSH	P,.JBINT	;SAVE JOBINT LOCATIONS
	CLEARB	T1,.JBINT	;DISABLE INTERUPTS
	SETUWP	T1,		;WRITE-ENABLE THE HISEG
	JFCL			;???
	MOVEM	T1,L.SVPT	;SAVE THE OLD SETTING
	AOSN	H.LOCK		;GET THE INTERLOCK
	JRST	BILDC3		;GOT IT!!
	PUSHJ	P,SLEEPR	;GO WAIT FOR IT
	JRST	BILDRT		;AND GO RETURN
;[1067] HERE WITH THE INTERLOCK AND WRITE PROTECT OFF. DO THE REBUILD.

;**;[1067] Insert @ BILDC3	JNG	23-Sep-75
BILDC3:	SETZM	H.IDX		;[1067] CERTAINLY NO INDEX IN CORE NOW
	SKIPE	H.ADAT		;[1050] IF NOT THE FIRST TIME...
	TELL	OPR,RAI%	;[1050] SAY WE'RE REBUILDING
	MOVE	T1,L.ADAT	;GET THE CREATION DATE
	MOVEM	T1,H.ADAT	;AND SAVE IT IN HISEG
	MOVE	T1,L.XDAT	;[1050] GET AUXACC'S CREATION DATE
	MOVEM	T1,H.XDAT	;[1050] AND REMEMBER IT IN HIGH-SEG
	MOVE	T1,L.ASIZ	;GET BACK THE SIZE
	MOVEM	T1,H.ASIZ	;STORE IN HISEG
	ASH	T1,2		;DOUBLE SIZE FOR AUXACC INDEX
	MOVEI	T2,H.TABL	;GET ADDRESS OF THE TABLE
	ADD	T1,T2		;ADD THE LENGTH
	HRLZS	T1		;SWAP IT
	CORE	T1,		;AND GET THE CORE
	  JRST	NOCORE		;LOSE BIGLY
BILDC4:	PUSHJ	P,RDACCT	;READ FIRST BLOCK
	  JRST	ACTERR		;ERROR NOW?
	MOVE	C,L.BUF		;GET FIRST WORD
	HRRZM	C,H.ESIZ	;SAVE ENTRY SIZE
	HLRZS	C		;SWAP HALVES
	CAIL	C,.AFMT2	;IS VERSION 2,3, OR 4?
	CAILE	C,.AFMT4	
	  JRST	BADFOR		;NO, LOSE
	MOVEI	T1,200		;SIZE OF ENTRY
	IDIV	T1,H.ESIZ	;DIVIDE BY ENTRY SIZE
	MOVEI	T1,H.TABL	;GET ADDRESS OF TABLE
	MOVEI	T3,1		;AND INITIAL OFFSET

BILDC5:	SKIPN	C,L.BUF(T3)	;GET FIRST PPN OF BLOCK
	HRLOI	C,377777	;IF ZERO,MAKE IT BIG NUMBER
	CAMG	C,-1(T1)	;MAKE SURE ITS BIGGER THAN LAST ONE
	JRST	BADFOR		;BAD FORMAT FOR ACCT SYS
 	MOVEM	C,(T1)		;SAVE IN THE TABLE
	SUB	T3,T2		;SUBTRACT OFFSET FOR NEXT BLOCK
	SKIPGE	T3
	ADD	T3,H.ESIZ	;KEEP IT NON-NEGATIVE
	PUSHJ	P,RDACCT	;READ NEXT BLOCK
	  SKIPA			;EOF
	AOJA	T1,BILDC5	;AND LOOP FOR THIS BLOCK
BILDC6:	GETSTS	ACT,T1		;GET CHANNEL STATUS
	TXZ	T1,IO.EOF	;CLEAR EOF FLAG
	SETSTS	ACT,(T1)	;AND RESET STATUS

;NOW BUILD AUXACC INDEX
BILAUX:	MOVEI	T1,1		;SET TO READ FIRST BLOCK
	MOVEM	T1,L.ACC+1	;STORE BLOCK NUMBER
	PUSHJ	P,INPAUX	;GO READ THE BLOCK
	CLEARM	L.ACC+2		;CLEAR WORD TO READ
	SETO	T2,		;POINT T2 TO -1ST ENTRY IN ACT TABLE
	MOVEI	T1,H.TABL	;BEGINNING OF TABLE
	ADD	T1,H.ASIZ	;PLUS SIZE=ADR OF AUX TABLE

BILAU0:	PUSHJ	P,AUXSCN	;GET FIRST AUX ENTRY
	  JRST	ACTERR		;THAT'S IMPOSSIBLE

BILAU1:	PUSHJ	P,BILAUS	;SAVE AUXACC ENTRY IN TABLE
	AOS	T2		;POINT TO NEXT ACT ENTRY
	CAML	T2,H.ASIZ	;GOT LAST ACCT.SYS ENTRY?
	JRST	BILAU6		;YES, RESET EOF AND RETURN

BILAU2:	CAML	U1,H.TABL(T2)	;IS AUX .LT. ACT ?
	AOJA	T1,BILAU1	;NO, GET NEXT ACT ENTRY

BILAU3:	PUSHJ	P,BILAUS	;SAVE CURRENT ENTRY
	PUSHJ	P,AUXSCN	;GET NEXT AUXACC ENTRY
	  HRLOI	U1,377777	;MAKE A MOBY PPN
	JRST	BILAU2		;LOOP BACK AGAIN
BILAU6:	GETSTS	AUX,T1		;GET CHANNEL STATUS
	TXZ	T1,IO.EOF	;TURN OFF EOF BIT
	SETSTS	AUX,(T1)	;SET IT BACK


BILDRT:	SETOM	H.IDX		;INDEX EXISTS
	SETOM	H.LOCK		;UNLOCK
	MOVE	T1,L.SVPT	;GET STATE OF UWP
	SETUWP	T1,		;AND SET UWP
	  JFCL			;DON'T CRY NOW
	POP	P,.JBINT	;RE-ENABLE INTERUPTS
	MOVE	T1,[HB.SWP+1]	;SETUP TO HIBER AND SWAP OUT IMMEDITELY
	PJRST	HIBR		;AND HIBER FOR A MILLISEC


;SUBROUTINE TO STORE WORD#,,BLOCK# FOR CURRENT
;	AUXACC ENTRY AT (T1)

BILAUS:	MOVE	T5,L.ACC+1	;GET BLOCK NUMBER
	MOVE	T4,L.ACC+2	;GET WORD NUMBER
	SUBI	T4,3		;BACK UP TO [-1] WORD
	JUMPGE	T4,BILAS1	;JUMP IF IN CURRENT BLOCK
	ADDI	T4,200		;OFFSET TO LAST BLOCK
	SOS	T5		;NUMBER OF LAST BLOCK
BILAS1:	HRL	T5,T4		;GET W#,,B#
	MOVEM	T5,(T1)		;PUT IN TABLE
	POPJ	P,		;AND RETURN
;LKACC -- ROUTINE TO DETERMINE WHETHER ACCT.SYS HAS CHANGED
;
;CALL:
;	PUSHJ P,LKACC
;	  RETURN HERE IF TABLE MUST BE REBUILT
;	  RETURN HERE IF NOT

;**;[1067] Insert @ LKACC	JNG	23-Sep-75
LKACC:	SKIPN	H.IDX			;[1067] INDEX IN CORE?
;**;[1070] Change @ LKACC	JNG	23-Oct-75
	PJRST	LKACC2			;[1067] NO, GO REBUILD
	MOVE	T1,[SIXBIT /ACCT/]	;FILENAME
	MOVSI	T2,'SYS'		;EXTENSION
	CLEARB	T3,T4
	CLOSE	ACT1,			;CLOSE IF PREVIOUSLY OPENED
	LOOKUP	ACT1,T1			;LOOKUP ACCT.SYS
	  JRST	NOACCT			;???
	MOVE	T5,T3			;GET CREATION INFO
;[1050] LKACC+7,JNG,12/4/74
	TLZ	T5,777740		;[1050] GET TIME AND LOW-DATE
	CAME	T5,H.ADAT		;[1050] CHECK AGAINST PREVIOUS
	JRST	LKACC2			;[1050] GO REBUILD
;**;[1067] Delete @ LKACC+12	JNG	23-Sep-75
	MOVE	T1,[SIXBIT/AUXACC/]	;[1050] NAME
	MOVSI	T2,'SYS'		;[1050] EXTENSION
	CLEARB	T3,T4			;[1050] 2 MORE WORDS
	CLOSE	ACT1,			;[1050] CLEAR THE CHANNEL
	LOOKUP	ACT1,T1			;[1050] FIND AUXACC.SYS
	  JRST	NOACCT			;[1050] NOT THERE???
	MOVE	T5,T3			;[1050] GET TIME WORD
	TLZ	T5,777740		;[1050] CLEAR EXTRANEOUS BITS
	CAME	T5,H.XDAT		;[1050] SAME AS BEFORE??
	JRST	LKACC2			;[1050] NO....GO REBUILD
;**;[1067] Change @ LKACC+26	JNG	23-Sep-75
	AOS	(P)			;[1067] YES, NO NEED TO REBUILD
	SKIPE	L.ADAT			;[1067] BUT UNLESS WE'VE DONE
	SKIPN	L.XDAT			;[1067] BOTH LOOKUPS ONCE...
	JRST	LKACC2			;[1067] WE NEED TO GO DO THEM
	POPJ	P,			;[1067] ALL OK, JUST RETURN
;HERE IF WE MUST LOOKUP ACCOUNTING FILES TO GET NEW VERSIONS

;**;[1067] Delete @ LKACC2-1	JNG	23-Sep-75
LKACC2:	MOVE	T1,[SIXBIT/ACCT/]	;[1050] A GOOD NAME
	MOVSI	T2,'SYS'		;[1050] STANDARD EXTENSION
	CLEARB	T3,T4			;SETUP TO LOOK AGAIN
	CLOSE	ACT,
	LOOKUP	ACT,T1			;LOOK IT UP FOR REAL
	  JRST	NOACCT			;??
	HLRE	T1,T4			;GET SIZE INTO T1
	JUMPGE	T1,LKACC1		;JUMP IF IN +BLOCKS
	SUBI	T1,^D127		;ACCOUNT FOR PARTIAL BLOCK
	IDIV	T1,[-^D128]		;CONVERT TO BLOCKS
LKACC1:	MOVEM	T1,L.ASIZ		;AND SAVE IT
;[1050] LKACC1+1,JNG,12/4/74
	TLZ	T3,777740		;[1050] GET DATE-TIME OF ACCT
	MOVEM	T3,L.ADAT		;[1050] AND SAVE IT.
	MOVE	T1,[SIXBIT /AUXACC/]	;RE FIND AUXACC
	MOVSI	T2,'SYS'
	CLEARB	T3,T4
	CLOSE	AUX,			;CLOSE OUT PREVIOUS VERSION
	LOOKUP	AUX,T1			;LOOKUP NEW VERSION
	  JRST	NOACCT			;NOT THERE?
;[1050] LKACC1+11,JNG,12/4/74
	TLZ	T3,777740		;[1050] GET LATEST CREATION TIME
	MOVEM	T3,L.XDAT		;[1050] AND STORE IT AWAY.

IFN FTRPPN,<
	MOVSI	T1,L.PPTB		;LETS BLT THE CACHE TO 0
	HRRI	T1,L.PPTB+1
	CLEARM	L.PPTB			;THATS THE FIRST WORD
	BLT	T1,L.PPTB+NPPNRM-1	;AND THE REST
>
	POPJ	P,			;[1050] GO REBUILD
;+SRHACC -- Routine to search ACCT.SYS for a PPN.
;Call SRHACC with the PPN in Q.PPN.  If
;entry is found, return with entire entry in the UUO block,
;L.UUBK, starting at RIBCNT.
;-;#3
;CALL:
;	PUSHJ P,SRHACC
;	  RETURN HERE IF ENTRY NOT FOUND
;	  RETURN HERE OTHERWISE

SRHACC:	PUSHJ	P,BILDAC	;GO BUILD AN INDEX IF NECESSARY
SRHAC0:	MOVE	T1,Q.PPN(Q)	;GET THE PPN
	TRNE	T1,1B18		;IS IT A WILDCARD PPN?
	HRRI	T1,-2		;YES, USE STANDARD FLAG (P,,-2)

IFN FTRPPN,<
	MOVSI	T2,-NPPNRM	;SETUP AOBJN POINTER
	CAMN	T1,L.PPTB(T2)	;START COMPARING DOWN THE TABLE
	JRST	SRHAC9		;A MATCH!!
	AOBJN	T2,.-2		;KEEP LOOPING
>

	MOVN	T2,H.ASIZ	;GET SIZE OF ACCT.SYS
	HRLZS	T2		;PUT IN LH FOR AOBJN POINTER
	HRRI	T2,H.TABL	;AND LOAD START ADDRESS OF TABLE

SRHAC1:	CAMGE	T1,(T2)		;LOOK FOR A BIGGER ENTRY
	JRST	SRHAC2		;FOUND ONE THAT'S BIGGER OR EQUAL
	AOBJN	T2,SRHAC1	;LOOP FOR ENTIRE TABLE

SRHAC2:	SUBI	T2,H.TABL+1	;SUBTRACT THE START ADDDRESS OF TABLE
				;AND BACK UP A BLOCK
	USETI	ACT,1(T2)	;AND SET THE BLOCK NUMBER FOR A READ
	HRRZM	T2,L.ACC	;SAVE INDEX INTO TABLE

;NOW FIND THE FIRST ENTRY IN THAT BLOCK
SRHAC4:	HRRZ	T3,T2		;COPY OVER THE ENTRY NUMBER (BLK-1)
	MOVE	T5,H.ESIZ	;WE'RE GONNA USE THIS
	ASH	T3,7		;GET NUMBER OF WORDS BEFORE THIS BLOCK
	IDIV	T3,T5		;DIVIDE BY ENTRY SIZE
	SUBI	T4,1		;SUBTRACT 1 FOR FORMAT WORD
	MOVNS	T4		;AND NEGATE
	SKIPGE	T4		;SKIP IF GE 0
	ADD	T4,T5		;ELSE MAKE IT POSITIVE
	PUSHJ	P,RDACCT	;READ THE BLOCK
	  JRST	ACTERR		;I/O ERROR
SRHAC5:	MOVE	T2,L.BUF(T4)	;GET THE PPN FROM TABLE
	CAMN	T2,T1		;IS IT THE RIGHT ONE?
	JRST	SRHAC6		;YUP, FOUND IT
	ADD	T4,T5		;POINT TO THE NEXT ONE
	CAIG	T4,177		;STILL IN THIS BLOCK?
	JRST	SRHAC5		;YES, KEEP LOOPING
	POPJ	P,		;IT'S NOT THERE!!!
SRHAC6:	MOVEI	T2,200		;LOAD SIZE OF A BLOCK
	SUB	T2,T4		;SUBTRACT INDEX INTO THIS BLOCK
	CAMGE	T2,T5		;IS ENTIRE ENTRY IN THIS BLOCK?
	JRST	SRHAC7		;NO, SPLIT ACROSS TWO BLOCKS

	MOVSI	T1,L.BUF(T4)	;START ADDRESS FOR BLT
	HRRI	T1,L.UUBK	;DESTINATION ADDRESS FOR BLT
	BLT	T1,L.UUBK-1(T5)	;BLT THE ENTRY INTO UUO BLOCK
	JRST	SRHAC8		;REMEMBER ACCT.SYS IF FTRPPN IS ON, AND
				;SKIP BACK

SRHAC7:	MOVSI	T1,L.BUF(T4)	;STARTING ADDRESS
	HRRI	T1,L.UUBK	;DESTINATION ADDRESS
	BLT	T1,L.UUBK-1(T2)	;BLT THAT MANY WORDS FROM THIS BLOCK
	MOVSI	T1,L.BUF	;START AT TOP OF NEXT BLOCK
	HRRI	T1,L.UUBK(T2)	;START WHERE THE LAST BLT LEFT OFF
	PUSHJ	P,RDACCT	;READ THE NEXT BLOCK
	  JRST	ACTERR		;I/O ERROR?
	BLT	T1,L.UUBK-1(T5)	;BLT THE REST
	JRST	SRHAC8		;SAVE ACCT STUFF IF FTRPPN IS ON
IFN FTRPPN,<
SRHAC8:	MOVEI	T4,L.UUBK	;LOAD ADDRESS OF STORED ENTRY
	MOVE	T1,L.RPRG	;LOAD THE REPLACEMENT REGISTER
	MOVE	T2,.A2PPN(T4)	;GET THE PPN
	MOVEM	T2,L.PPTB(T1)	;SAVE IT
	MOVE	T2,.A2PSW(T4)	;GET THE PASSWORD
	MOVEM	T2,L.PSTB(T1)	;SAVE IT
	MOVE	T2,.A2PRF(T4)	;GET PROFILE WORD
	MOVEM	T2,L.PRTB(T1)	;SAVE IT
	MOVE	T2,.A2NAM(T4)	;FIRST HALF OF USER NAME
	MOVEM	T2,L.UNTB(T1)	;SAVE IT
	MOVE	T2,.A2NAM+1(T4)	;SECOND HALF OF USER NAME
	MOVEM	T2,L.U2TB(T1)	;SAVE IT
	PJRST	.POPJ1		;AND SKIP BACK

SRHAC9:	MOVEI	T4,L.UUBK	;LOAD ADDRESS OF STORAGE BLOCK
	MOVEM	T1,.A2PPN(T4)	;SAVE THE PPN
	MOVE	T1,L.PSTB(T2)	;GET PASSWORD
	MOVEM	T1,.A2PSW(T4)	;AND SAVE IT
	MOVE	T1,L.PRTB(T2)	;GET PROFILE WORD
	MOVEM	T1,.A2PRF(T4)	;STORE IT
	MOVE	T1,L.UNTB(T2)	;GET FIRST HALF OF USER NAME
	MOVEM	T1,.A2NAM(T4)	;STORE IT
	MOVE	T1,L.U2TB(T2)	;AND THE SECOND HALF
	MOVEM	T1,.A2NAM+1(T4)	;AND STORE THAT
	MOVE	T1,L.AUTB(T2)	;GET ENTRY LOCATION IN AUXACC
	MOVEM	T1,L.ACC	;STORE IT
	MOVEM	T2,L.MTCH	;FLAG A MATCH
	TLZ	T2,-1		;ZAP THE LH OF T2
	CAME	T2,L.RPRG	;IS THIS NEXT TO BE REPLACED?
	PJRST	.POPJ1		;NO, JUST RETURN
	PJRST	INCRPR		;YES, INCRMENT REPLACEMENT REGISTER
				;AND RETURN
> ;END OF IFN FTRPPN


IFE FTRPPN,<
SRHAC8:	PJRST	.POPJ1		;SKIP BACK
>  ;END OF IFE FTRPPN
;+SRHAUX -- Routine to search AUXACC.SYS.
;	Starts searching at word specified by in-core index.
;	Returns "skip" if entry found, with the second word
;	.AUNUM in U2 and next call to RDAUX will
;	get first str name.
;-;#3
;CAUTION: THE LOOPS IN THIS ROUTINE ARE STRANGELY NESTED, READ IT
;	SLOWLY.

SRHAUX:	MOVE	T1,L.ACC	;GET SAVED INDEX INTO TABLE

IFN FTRPPN,<
	SKIPE	L.MTCH		;IS THIS A WINNER?
	JRST	SRHAU0		;YUP, WE'VE GOT ALL WE NEED
>

	ADD	T1,H.ASIZ	;MOVE INTO AUXACC TABLE
	MOVE	T1,H.TABL(T1)	;AND GET ENTRY
SRHAU0:	HLRZM	T1,L.ACC+2	;SAVE # OF WORD TO RETURN
	HRRZM	T1,L.ACC+1	;SAVE # OF CURRENT BLOCK
	PUSHJ	P,INPAUX	;GO READ THE BLOCK

	MOVE	T2,Q.PPN(Q)	;GET USER'S PPN
	TRNE	T2,1B18		;FUNNY NUMBER?
	HRRI	T2,777776	;YES, GET STANDARD FLAG FOR IT
	JRST	SRHAU2		;AND JUMP INTO THE LOOP

SRHAU1:	HLRZ	T3,U1		;GET ENTRIES PROJ # IN T3
	HLRZ	T1,T2		;GET USER'S  PROJ # IN T1
	CAMN	T1,T3		;ARE THEY THE SAME PROJECT?
	JRST	SRHAU3		;YES, CHECK IT OUT
	CAMG	T1,T3		;NO, IT USER'S BIGGER?
	POPJ	P,		;NO, USER'S IS SMALLER, ENTRY IS NOT THERE

SRHAU2:	PUSHJ	P,AUXSCN	;GET THE NEXT ENTRY
	  POPJ	P,		;EOF, NO ENTRY!!
	PJUMPE	U1,SRHAU4	;NO ENTRY?
	CAMN	U1,T2		;EXACT MATCH?
	PJRST	SRHAU5		;YES, HOW LUCKY
	JRST	SRHAU1		;NO, LOOP TILL WE GET THERE

SRHAU3:	TRC	U1,-1		;TRICK THE PROG NUMBER
	TRCN	U1,-1		;TRICK BACK AGAIN
	PJRST	SRHAU5		;ALL 1'S IS WILDCARD, RETURN
	JRST	SRHAU2		;AND LOOP
IFN FTRPPN,<
SRHAU4:	MOVE	T1,L.RPRG	;LOAD THE REPLACEMENT REGISTER
	SKIPN	L.MTCH		;WAS THIS A MATCH
	CLEARM	L.PPTB(T1)	;NO, CLEAR THE PPN WORD
	POPJ	P,		;RETURN

SRHAU5:	SKIPE	L.MTCH		;WAS THIS A MATCH?
	PJRST	.POPJ1		;YES, JUST SKIP BACK
	MOVEI	T1,L.AUTB	;NO, ADDRESS OF AUX STORE TABLE
	ADD	T1,L.RPRG	;ADD THE REPLACEMENT REGISTER
	PUSHJ	P,BILAUS	;STORE THE CURRENT WORD,,BLOCK
				;AND FALL INTO INCREMENT ROUTINE

;ROUTINE TO INCREMENT THE REPLACMENT REGISTER
INCRPR:	AOS	T1,L.RPRG	;INCREMENT AND LOAD
	IDIVI	T1,NPPNRM	;DIVIDE BY MAX
	MOVEM	T2,L.RPRG	;STORE RESULT MOD NPPNRM
	PJRST	.POPJ1		;AND SKIP BACK
> ;END OF IFN FTRPPN


IFE FTRPPN,<
SRHAU4:	POPJ	P,
SRHAU5:	PJRST	.POPJ1
>  ;END OF IFE FTRPPN
;+MAKSL -- Routine To Generate a Search List
;	Call with RDAUX ready to read user's first structure
;	name and U2 containg number of words from .AUNUM.
;	Calls MAKPTH to setup UFD and SFD
;	and if MAKPTH says it's OK, put the structure
;	in my Search List.
;-;#3

MAKSL:	MOVEI	T1,.FSDSL	;STRUUO CODE
	SETOB	T2,T3		;MY JOB, MY PPN
	MOVX	T4,DF.SRM	;DELETE ALL STRUCTURES
	MOVE	T5,[4,,T1]	;ARG TO STRUUO
	STRUUO	T5,		;ZAP THE S/L
	  JFCL			;CAN'T SAY WE DIDN'T TRY!
	MOVEI	T5,L.SL2+1	;WHERE TO START STORING ARGS

	MOVE	U1,U2		;COPY WORD COUNT INTO U1
	IDIVI	U1,.UBKS	;CONVERT TO # STRS
	MOVE	T4,U1		;A COUNTER
	MOVE	T3,U1		;LATER ARGUMENT TO STRUUO

MAKSL1:	PUSHJ	P,RDAUX		;GET STRUCTURE NAME
	  JRST	ACTERR		;ITS SUPPOSED TO BE THERE
	MOVEM	U1,(T5)		;STORE STRUCTURE NAME
	CLEARM	1(T5)		;2ND WORD OF TRIPLET IS 0
	PUSHJ	P,MAKPTH	;MAKE UFD AND SFD
	  JRST	MAKSL4		;MAKPTH SAYS DON'T USE THIS ONE
	PUSHJ	P,RDAUX		;GET STATUS BITS
	  JRST	ACTERR		;??
	MOVEM	U1,2(T5)	;STORE THEM
MAKSL2:	ADDI	T5,3		;POINT TO NEXT ENTRY
	SKIPA
MAKSL4:	SOS	T3		;ONE LESS FOR STRUUO
	SOJG	T4,MAKSL1	;AND LOOP FOR THEM ALL

	MOVEM	T3,L.SL2	;SAVE NUM OF STRS
	MOVEI	T1,L.SL2	;LOAD ADDRESS OF BLOCK
	MOVEI	T2,SLLEN+.PTPPN(T1)	;POINT TO PATH BLOCK
	HRLI	T2,Q.IDDI(Q)		;SETUP TO BLT THE PATH
	BLT	T2,SLLEN+.PTPPN+5(T1)	;BLT THE FULL PATH
	MOVEI	T2,<.PTSCN>B35		;/NOSCAN
	MOVEM	T2,L.SL2+SLLEN+.PTSWT	;STORE SWITCH
	PJRST	SETSRC		;SET THE S/L, PATH  AND RETURN
;+MAKPTH -- Routine to create UFD and SFD on a str.
;	Call with U1 containing structure name.
;-;#3
;CALL:
;	PUSHJ P,MAKPTH
;	  RETURN HERE IF CAN'T DO IT (AUXACC IS SCANNED TILL NEXT ENTRY)
;	  RETURN HERE NORMALLY
;NON-SKIP RETURN IMPLIES THAT STR SHOULD NOT BE PUT IN S/L

MAKPTH:	PUSHJ	P,CLRUUO	;CLEAR THE UUO BLOCK
	MOVEI	P1,.IODMP	;USE DUMP MODE
	MOVE	P2,U1		;GET STR NAME
	MOVEM	P2,L.UFIN+1	;SAVE FOR STRUUO TO LOCK UFD
	CLEAR	P3,		;NO BUFFERS
	OPEN	UFD,P1		;OPEN THE CHANNEL
	  JRST	MAKPT8		;CAN'T DO IT

	MOVEI	P1,.RBAUT	;START SETTING UP UUOBLK
	MOVEM	P1,RIBCNT	;FIRST WORD
	MOVE	P1,Q.PPN(Q)	;HIS PPN IS FILENAME
	MOVEM	P1,RIBNAM	;STORE IT
	MOVEM	P1,L.UFIN+2	;SAVE FOR STRUUO TO LOCK UFD
	MOVSI	P1,'UFD'
	MOVEM	P1,RIBEXT	;STORE EXTENSION
	MOVE	P1,L.MFPP	;PUT IT IN MFDPPN
	MOVEM	P1,RIBPPN
	PUSHJ	P,RDAUX		;READ RESERVED QUOTA
	  JRST	ACTERR		;ERROR
	PUSHJ	P,RDAUX		;IGNORE RSVD QTA GET FCFS QUOTA
	  JRST	ACTERR		;??
	MOVEM	U1,RIBQTF	;AND STORE IT
	PUSHJ	P,RDAUX		;GET LOG-OUT QUOTA
	  JRST	ACTERR		;??
	MOVEM	U1,RIBQTO	;STORE THAT
	MOVX	U1,RP.DIR	;GET DIRECTORY BIT
	MOVEM	U1,RIBSTS	;PUT INTO RIBSTS

	SKIPN	P1,Q.IDDI+1(Q)	;GET SFD NAME FOR LATER
	JRST	MAKPT1		;NO PATH
	MOVSI	P2,'SFD'	;THE EXTENSION
	CLEAR	P3,
	MOVE	P4,Q.PPN(Q)	;AND USER'S PPN
MAKPT1:	PUSHJ	P,SETUFL	;SET THE UFD INTERLOCK
	LOOKUP	UFD,L.UUBK	;LOOKUP THE UFD
	  JRST	MAKPT2		;IT'S NOT THERE! GO ENTER IT
	JRST	MAKPT4		;ITS THERE, GO MAKE AN SFD
MAKPT2:	ENTER	UFD,L.UUBK	;ENTER THE UFD
	  JRST	MAKPT4		;MAYBE ITS THERE!, GO TRY FOR SFD
	USETO	UFD,2		;MAKE 1 BLOCK

MAKPT4:	CLOSE	UFD,		;CLOSE UFD OFF
	PJUMPE	P1,MAKPT5	;[1052] RETURN IF NO SFD
	ENTER	UFD,P1		;ENTER THE SFD
	  JFCL			;DON'T WORRY NOW
MAKPT5:	RELEASE	UFD,		;[1052] RELEASE CHANNEL
	PJRST	.POPJ1		;AND RETURN

MAKPT8:	MOVEI	P1,.UBKS-1	;SETUP TO READ THE REST OF THE ENTRY
MAKP81:	PUSHJ	P,RDAUX		;READ A WORD
	  JRST	ACTERR		;ERROR
	SOJG	P1,MAKP81	;AND LOOP
	POPJ	P,		;AND RETURN
;SETUFL -- ROUTINE TO SET UFD INTERLOCK
;SETUFL WORKS AS A CO-ROUTINE WITH ITS CALLER.  IF IT IS CALLED,
;	IT SETS THE INTERLOCK AND CALLS THE CALLER, SO WHEN THE
;	CALLER RETURNS THE INTERLOCK IS CLEARED FIRST.

;THIS IS USED SO THAT THE INTERLOCK IS CLEARED BEFORE RETURNING AND
;JOBINT IS RESTORED.

SETUFL:	MOVEI	T1,.FSULK	;LOCK CODE
	MOVEM	T1,L.UFIN	;STORE IN STRUUO BLOCK
	MOVE	T1,.JBINT	;LOAD JOBINT
	CLEARM	.JBINT		;DISABLE ^C WHILE WE HAVE INTERLOCK
	EXCH	T1,(P)		;SAVE JOBINT ADR AND LOAD RET PC
	MOVEM	T1,1(P)		;SAVE RET PC 1 PAST P
	MOVEI	T1,^D100	;NO. TIMES TO TRY INTERLOCK

SETUF1:	MOVE	T2,[3,,L.UFIN]	;LOAD ARG TO STRUUO
	STRUUO	T2,		;DO THE UUO
	  SKIPA			;IT FAILED
	JRST	SETUF2		;WIN, RETURN (SORT OF)
	MOVEI	T2,1		;SLEEP FOR 1 SEC
	SLEEP	T2,		;ZZZ
	SOJG	T1,SETUF1	;AND TRY AGAIN
				;FORGET IT!!

SETUF2:	PUSHJ	P,@1(P)		;RETURN TO USER
	JRST	CLRUFL		;HERE IF HE POPJ'ED
	AOS	-1(P)		;HERE IF HE .POPJ1'ED

				;AND FALL INTO CLRUFL

;CLRUFL -- ROUTINE TO CLEAR UFD INTERLOCK

CLRUFL:	MOVEI	T1,.FSUCL	;UNLOCK CODE
	MOVEM	T1,L.UFIN	;STORE IT
	MOVE	T2,[3,,L.UFIN]
	STRUUO	T2,		;DO THE UUO
	  SKIPA			;CANT??
	JRST	CLRUF1		;OK, RETURN
	TELL	OPR,CCI%	;CAN'T CLEAR IT
	JRST	ABEND		;AND DIE

CLRUF1:	POP	P,.JBINT	;RESTORE JOBINT
	POPJ	P,		;AND RETURN
;+DOACCT -- Routine to setup and do all the accounting for a
;	job.  Call with the PPN in Q.PPN.  Does all
;	the ACCT.SYS and AUXACC stuff, checks the Password,
;	and sets the Search-List.
;-
;CALL:
;	PUSHJ P,DOACCT
;	  RETURN HERE ON ERROR (T1 CONTAINS ADDRESS OF ERROR MESSAGE)
;	  RETURN HERE OTHERWISE

DOACCT:	MOVE	T1,Q.PPN(Q)	;GET THE PPN
	MOVEM	T1,Q.IDDI(Q)	;STORE IN PATH BLOCK

IFN FTRPPN,<
	CLEARM	L.MTCH		;NO MATCH YET ON THIS ONE
>

	CLEAR	T1,		;TO CLEAR Q.IDDI+1
	LDB	T2,P.UNI	;GET THE UNIQUENESS
	CAIE	T2,.QIUSD	;UNIQUE SFD?
	JRST	DOACC0		;NO, CONTINUE
	PUSHJ	P,FUNNY		;MAKE A FUNNY NAME
	TLO	T1,'SF '	;AND MAKE AN OBVIOUS NAME
DOACC0:	MOVEM	T1,Q.IDDI+1(Q)	;AND STORE IN THE PATH BLOCK
	SKIPL	L.PRIV		;IS ME PRIVILEGED?
	PJRST	.POPJ1		;NO, JUST RETURN

DOACC1:	PUSHJ	P,SRHACC	;SEARCH FOR THE PPN
	  PJRST	E$IPP		;ITS NOT THERE!!
	MOVEI	T2,L.UUBK	;LOAD INDEX REGISTER

DOACC2:	MOVE	T1,.A2PRF(T2)	;GET THE PROFILE WORD
	TXNN	T1,A2.BTC	;CAN IT LOGIN AS BATCH JOB?
	  PJRST	E$CLB		;GUESS NOT!!
	TXNN	T1,A2.BPS	;DOES IT NEED A PASSWORD?
	JRST	DOACC4		;NO, CONTINUE
	PUSHJ	P,CDRASC	;YES, GET A CARD
	  PJRST	E$PWR		;EOF!!
	MOVE	B,[POINT 7,L.CARD,6]
	PUSHJ	P,S$SIX		;GET THE KEYWORD
	  PJRST	E$PWR		;BAD ONE!!
	HLRZS	T1		;SWAP HALVES
	CAIE	T1,'PAS'	;SEE IF PART OF PASSWORD
	  PJRST	E$PWR		;NOPE!!
	CLEAR	T1,		;CLEAR FOR RESULT
	MOVE	T3,[POINT 6,T1]	;POINTER FOR RESULT
DOACC3:	ILDB	C,B		;LOOP FOR PASSWORD, GET A CHAR
	SUBI	C,40		;CONVERT TO SIXBIT
	SKIPGE	C		;WAS IT A CONTROL CHAR?
	JRST	DOAC3A		;YES, STOP LOOPING
	IDPB	C,T3		;DEPOSIT A CHAR
	TLNE	T3,770000	;GOT SIX CHARS?
	JRST	DOACC3		;NO, LOOP SOME MORE
DOAC3A:	CAME	T1,.A2PSW(T2)	;SEE IF A GOOD PASSWORD
	  PJRST	E$IPP		;LOSE!!
DOACC4:	MOVE	T1,.A2PRF(T2)	;GET THE PROFILE WORD
	TXNN	T1,A2.BNM	;NAME REQURED FOR BATCH?
	JRST	DOAC4A		;NO, CONTINUE
	SKIPN	.A2NAM(T2)	;YES, SEE IF ACCT ENTRY IS ZERO
	SKIPE	.A2NAM+1(T2)	;CHECK SECOND WORD
	SKIPA			;NON-ZERO
	JRST	DOACC5		;ZERO!!, DON'T CHECK
	MOVE	T1,Q.USER(Q)	;GET FIRST HALF GIVEN
	CAME	T1,.A2NAM(T2)	;MATCH?
	  PJRST	E$IPP		;NO, ERROR
	MOVE	T1,Q.USER+1(Q)	;GET SECOND HALF
	CAME	T1,.A2NAM+1(T2)	;MATCH??
	  PJRST	E$IPP		;NO!
	JRST	DOACC5		;ITS OK!!
DOAC4A:	SKIPE	Q.USER(Q)	;DID HE SPECIFY NAME SWITCH?
	JRST	DOACC5		;YES, DON'T PUT IN OFFICIAL NAME
	MOVE	T1,.A2NAM(T2)	;GET FIRST HALF
	MOVEM	T1,Q.USER(Q)	;STORE IT
	MOVE	T1,.A2NAM+1(T2)	;GET SECOND HALF
	MOVEM	T1,Q.USER+1(Q)	;AND STORE IT

DOACC5:	HRRZ	T3,Q.PPN(Q)	;GET PROGRAMMER NUMBER
	TRNN	T3,1B18		;FUNNY NUMBER?
	JRST	DOACC6		;NO, CONTINUE
	STAMP	STMSG		;YES, STAMP LOG
	TELL	LOG,PRG%	;AND TELL HIM WHAT IT IS

DOACC6:	SKIPN	Q.IDDI+1(Q)	;IS THERE AN SFD?
	JRST	DOACC7		;NO
	STAMP	STMSG		;YES, STAMP THE LOG
	TELL	LOG,SFD%	;YES, TELL HIM

DOACC7:	PUSHJ	P,SRHAUX	;GET SEARCH AUXACC
	  JRST	DOACC8		;NO ENTRY!!
	PUSHJ	P,MAKSL		;MAKE SEARCH LIST AND UFDS
	PJRST	.POPJ1		;AND RETURN

DOACC8:	MOVEI	T1,NAU%		;NO AUXACC ENTRY
	PJRST	LOGER1		;LOG THE MSG AND SKIP BACK
;VARIOUS AND SUNDRY ROUTINES FOR THE ACCOUNTING

;RDACCT -- ROUTINE TO READ A BLOCK

RDACCT:	SETOM	L.CBLK		;INVALIDATE THE BUFFER FOR AUXACC'ERS
	IN	ACT,L.ACIO
	PJRST	.POPJ1		;INPUT AND RETURN SUCCESFULLY
	POPJ	P,		;LOSE


;SLEEPR -- Routine to sleep waiting for ACCT.SYS index to be
;	built.

SLEEPR:	SKIPE	H.IDX		;IS THERE AN INDEX?
	POPJ	P,		;YES, RETURN
	MOVEI	T2,5		;LOAD LOOP COUNTER
SLEEP1:	MOVEI	T1,2		;# OF MILLISECS TO SLEEP EACH TIME
	PUSHJ	P,HIBR		;AND DO THE HIBERNATE
	SKIPE	H.IDX		;DOES IT EXIST?
	POPJ	P,		;YES, RETURN
	SOJG	T2,SLEEP1	;NO, LOOP FOR ANOTHER SLEEP
	POPJ	P,		;GET IMPATIENT AND RETURN ANYWAY!!

;ERRORS

NOACCT:	TELL	OPR,CRA%
	JRST	ABEND


NOCORE:	TELL	OPR,NCA%
	JRST	ABEND

ACTERR:	TELL	OPR,ERA%
	JRST	ABEND

BADFOR:	TELL	OPR,BFA%
	JRST	ABEND
;ROUTINES TO READ AUXACC.SYS

;RDAUX -- ROUTINE TO RETURN THE NEXT WORD IN U1

RDAUX:	MOVE	U1,L.ACC+2	;GET INDEX OF NEXT WORD
	CAIE	U1,200		;NEED NEXT BLOCK?
	JRST	RDAUX1		;NO, ITS IN THIS BLOCK
	CLEARB	U1,L.ACC+2	;RESET COUNTS
	PUSH	P,T1		;SAVE T1
	AOS	T1,L.ACC+1	;INCREMENT BLOCK NUMBER AND LOAD
	PUSHJ	P,INPAUX	;GO READ THE BLOCK
	POP	P,T1		;RESTORE T1
	STATZ	AUX,IO.EOF!IO.DTE!IO.DER
	POPJ	P,		;SOME ERROR

RDAUX1:	MOVE	U1,L.BUF(U1)	;GET THE WORD
	AOS	L.ACC+2		;INCREMENT COUNT
	PJRST	.POPJ1		;AND RETURN SUCESS

;AUXSCN -- ROUTINE TO SCAN FOR THE BEGINNING OF AN ENTRY
;	FIRST WORD OF AN ENTRY CONTAINS -1.
;	READS NEXT WORD AFTER THE -1 AND RETURNS IT (COUNT) IN U2.
;	READS THIRD WORD (PPN) AND RETURNS IT IN U1.

AUXSCN:	PUSHJ	P,RDAUX		;READ A WORD
	  POPJ	P,		;EOF
	CAME	U1,[-1]		;IS IT -1?
	JRST	AUXSCN		;NO, KEEP LOOKING
	PUSHJ	P,RDAUX		;READ THE COUNT WORD
	  POPJ	P,		;EOF?
	MOVE	U2,U1		;AND SAVE IN U1
	PJRST	RDAUX		;READ PPN WORD AND RETURN


;INPAUX -- ROUTINE TO DO USETI-INPUT FOR AUXACC.  TRIES TO
;	AVOID DOING IT, BY CHECKING L.CBLK TO SEE IF THE
;	BUFFER CONTAINS WHAT WE WANT ALREADY.
;	CALL WITH T1 CONTAINING BLOCK NUMBER

INPAUX:	SKIPGE	L.CBLK		;AN ACCT.SYS READ SETOMS THIS WORD
	JRST	INPAU1		;WE'VE GOT TO READ
	CAMN	T1,L.CBLK	;IS THE BLOCK RIGHT?
	POPJ	P,		;YES!!

INPAU1:	HRRZM	T1,L.CBLK	;SAVE IT FOR NEXT CHECK
	USETI	AUX,(T1)	;USETI
	INPUT	AUX,L.ACIO	;INPUT THE BLOCK
	POPJ	P,		;AND RETURN

>  ;END IFN FTUUOS (FROM WAY-WAY BACK)
IFN FTJSYS,<
;+DOACCT -- Routine to setup and do all accounting for a job.
;	Call with User name string in L.UNAM.
;-
;CALL:
;	PUSHJ P,DOACCT
;	  RETURN HERE ON ERROR
;	  RETURN HERE OTHERWISE

DOACCT:	MOVX	T1,RC%EMO		;EXACT MATCH ONLY
	HRROI	T2,L.UNAM		;POINT TO STRING
	RCUSR				;CONVERT IT
	TXNE	T1,RC%NOM		;NO MTACH?
	JRST	E$IDP			;YES, TELL HIM
	MOVEM	T3,L.USNO		;SAVE RETURNED INFO

	MOVE	T1,[ASCII/PS:</]	;START BUILDING DIRECTORY
	MOVEM	T1,L.SL2
	MOVE	T1,[POINT 7,L.UNAM]	;POINT USER NAME
	MOVE	T2,[POINT 7,L.SL2,27]	;POINT TO DIRECTORY BLOCK

DOACC3:	ILDB	T3,T1			;GET A CHARACTER
	JUMPE	T3,DOACC4		;DONE ON NULL
	IDPB	T3,T2			;DEPOSIT IT
	JRST	DOACC3			;LOOP

DOACC4:	MOVEI	T3,">"			;CLOSE DIRECTORY
	IDPB	T3,T2			;STORE IT
	MOVEI	T3,0			;AND TERMINATE WITH
	IDPB	T3,T2			; A NUL

	PUSHJ	P,CDRASC		;GET THE NEXT CARD
	  PJRST	E$PWR			;NOT THERE!!
	MOVE	B,[POINT 7,L.CARD,6]	;SKIP THE $
	PUSHJ	P,S$SIX			;GET THE KEYWORD
	  PJRST	E$PWR			;NONE?
	HLRZS	T1			;GET FIRST 3 CHARS
	CAIE	T1,'PAS'		;IS IT PASSWORD?
	  PJRST	E$PWR			;NO, LOSE
	MOVEI	T1,L.UPSW		;POINT TO A BLOCK
	PUSHJ	P,S$STRG		;AND GET THE STRING
	MOVX	T1,RC%EMO		;EXACT MATCH
	HRROI	T2,L.SL2		;POINT TO THE STRING
	RCDIR				;GET DIRECTORY NUMBER
	TXNE	T1,RC%NOM		;BETTER BE A MATCH!!
	JRST	E$IDP			;NO??
	MOVE	T1,T3			;COPY DIR NO INTO T1
	MOVEI	T2,L.UDIN		;POINT TO GTDIR BLOCK
	MOVEI	T3,.CDDAC+1		;LOAD LENGTH OF BLOCK
	MOVEM	T3,L.UDIN+.CDLEN	;STORE IT
	HRROI	T3,L.ACNT		;POINTER TO ACCOUNT BLOCK
	SKIPN	Q.CNO(Q)		;DID HE SAY /ACCOUNT?
	MOVEM	T3,L.UDIN+.CDDAC	;NO, GET DEFAULT ACCOUNT
	HRROI	T3,L.DPSW		;AND PLACE TO STORE PSW
	GTDIR				;GET DIRECTORY INFO
	ERJMP	E$IDP			;LOSE?
	MOVEI	T1,L.ACNT		;POINT TO ACCOUNT BLOCK
	MOVEM	T1,Q.CNO(Q)		;YES, STORE IT FOR QMANGR
	SKIPE	L.ACNT			;IS THERE AN ACCOUNT NOW?
	JRST	DOAC.9			;YES, CONTINUE ON
	SETO	T1,			;MY JOB
	HRROI	T2,L.ACNT		;THE BLOCK
	GACCT				;AND GET MY ACCOUNT
DOAC.9:	MOVE	T1,[POINT 7,L.UPSW]	;POINT TO USER STRING
	MOVE	T2,[POINT 7,L.DPSW]	;POINT TO CORRECT ONE
				;DOACCT IS CONTINUED ON NEXT PAGE
				;CONTINUED FROM PREVIOUS PAGE

DOACC1:	ILDB	T3,T1			;GET A CHAR FROM ONE
	ILDB	T4,T2			;GET A CHAR FROM THE OTHER
	CAME	T3,T4			;COMPARE
	  PJRST	E$IDP			;NOPE!
	CAIE	T3,0			;GOT THE NULL?
	JRST	DOACC1			;NO, KEEP LOOPING
DOACC2:	MOVE	T1,L.USNO		;GET USER NUMBER
	HRROI	T2,L.ACNT		;AND POINT TO ACCOUNT STRING
	SKIPE	Q.CNO(Q)		;DID HE GIVE ONE?
	VACCT				;YES. VERIFY IT
	ERJMP	E$IAS			;LOSE!!
	MOVE	T1,[3,,T2]		;SETUP AC FOR COMPT.
	MOVEI	T2,3			;GET FUNCTION DIR--PPN
	SETZ	T3,			;RETURN PPN HERE
	HRROI	T4,L.SL2		;POINT TO DIRECTORY STRING
	COMPT.	T1,			;GET THE PPN
	  PJRST	E$IDP			;LOSE
	MOVEM	T3,Q.IDDI(Q)		;SAVE AS PATH
	MOVEI	T1,L.UNAM		;POINT TO USER NAME
	MOVEM	T1,Q.PPN(Q)		;AND STORE FOR QMANGR
	MOVEI	T1,L.SL2		;POINT TO CONNECTED DIR
	PUSHJ	P,SETSRC		;CONNECT ME
	PJRST	.POPJ1			;AND RETURN
>  ;END IFN FTJSYS
SUBTTL	Routines to SET and GET Search-List

IFN FTUUOS,<



;^;+GETSRC and SETSRC are used to get and set SPRINT's
;	search list.  Both are called with T1 containing the address
;	of a block as described below.  GETSRC reads the current
;	search list and returns it in the specified block.  SETSRC
;	sets the search-list from the contents of the block.

;	Following the searchlist block is a block for the PATH.
;	GETSRC reads SPRINT's current PATH into this
;	block, and SETSRC sets the PATH from the block.
;-
;CALLS:
;	MOVEI T1,ADR OF BLOCK
;	PUSHJ P,GETSRC (OR SETSRC)
;	  ALWAYS RETURN HERE
;++

;THE FORMAT OF THE BLOCK IS AS FOLLOWS:

;	!-------------------------------------!
;	!        NUMBER OF STRUCTURES         !
;	!=====================================!
;	!          FILE STRUCTURE #1          !
;	!-------------------------------------!
;	!                  0                  !
;	!-------------------------------------!
;	!RO!NC!                               !
;	!=====================================!
;	!          FILE STRUCTURE #2          !
;	!-------------------------------------!
;	!                  0                  !
;	!-------------------------------------!
;	!RO!NC!                               !
;	!=====================================!
;	!                                     !
;	/                  .                  /
;	/                  .                  /
;	/                  .                  /
;	!                                     !
;	!=====================================!
;	!          FILE STRUCTURE #N          !
;	!-------------------------------------!
;	!                  0                  !
;	!-------------------------------------!
;	!RO!NC!                               !
;	!=====================================!
;--
	DOWN

;GETSRC -- ROUTINE TO RETURN CURRENT SEARCH LIST


GETSRC:	PUSH	P,T1		;SAVE ADDRESS OF BLOCK
	AOS	T1		;SKIP OVER FIRST WORD FOR COUNT
	CLEAR	T3,		;CLEAR TO COUNT STRS
	SETOM	(T1)		;CLEAR TO GET FIRST STR
	JRST	GETSR2		;AND JUMP INTO LOOP

GETSR1:	MOVE	T2,(T1)		;GET RESULT OF LAST JOBSTR
	ADDI	T1,3		;POINT TO NEXT 3 WORDS
	MOVEM	T2,(T1)		;AND USE AS ARGUMENT TO NEXT JOBSTR
GETSR2:	MOVSI	T2,3		;3 WORD ARGUMENT
	HRRI	T2,(T1)		;STARTING THERE
	JOBSTR	T2,		;DO IT,
	  HALT .		;???
	SKIPN	T2,(T1)		;GET THE ANSWER
	  JRST	GETSR4		;ZERO MEANS WE'RE DONE
	AOJE	T2,GETSR4	;SO DOES -1
	AOJA	T3,GETSR1	;ELSE LOOP AROUND

GETSR4:	POP	P,T1		;RESTORE T1
	MOVEM	T3,(T1)		;SAVE STR COUNT
	MOVEI	T1,SLLEN(T1)	;POINT TO PATH BLOCK
	HRROI	T2,.PTFRD	;FUNC TO READ MY PATH
	MOVEM	T2,.PTFCN(T1)	;STORE IT
	SETZM	.PTSWT(T1)	;CLEAR FLAGS
	HRLI	T1,PTLEN	;LOAD THE LENGTH
	PATH.	T1,		;READ THE PATH
	  HALT	.		;??
	POPJ	P,		;AND RETURN

;SETSRC -- ROUTINE TO SET SEARCH LIST

SETSRC:	SKIPN	(T1)		;ARGUMENT BLOCK CLEAR?
	POPJ	P,		;YES, RETURN
	PUSH	P,(T1)		;SAVE FIRST WORD OF BLOCK
	MOVEI	T2,.FSSRC	;SET S/L FUNCTION
	EXCH	T2,(T1)		;SWAP THEM
	IMULI	T2,3		;3 WORDS/STR
	AOS	T2		;PLUS FUNCTION WORD
	MOVSS	T2		;PUT IN LH
	HRRI	T2,(T1)		;ADR OF BLOCK
	STRUUO	T2,		;DO IT
	  HALT .		;??
	POP	P,(T1)		;RESTORE FIRST WORD OF BLOCK
	MOVEI	T1,SLLEN(T1)	;GET POINTER TO PATH BLOCK
	HRROI	T2,.PTFSD	;FUNC TO SET PATH
	MOVEM	T2,.PTFCN(T1)	;STORE IT
	HRLI	T1,PTLEN	;PUT THE LENGTH IN
	PATH.	T1,		;SET THE PATH
	  HALT	.		;??
	POPJ	P,		;AND RETURN

>  ;END IFN FTUUOS
IFN FTJSYS,<

;ON TOPS20, BOTH ROUTINES ARE CALLED WITH T1 CONTAINING THE
;	ADDRESS OF A BLOCK.  GETSRC WILL RETURN THE CURRENT
;	CONNECTED DIRECTORY STRING, AND SETSRC SETS THE
;	CURRENT DIRECTORY.

GETSRC:	PUSH	P,T1			;SAVE BLOCK ADDRESS
	HRROI	T2,T4			;-1,,T4 (1 WORD IN T4)
	SETO	T1,			;MY JOB
	MOVEI	T3,.JIDNO		;RETURN MY DIRECTORY NUMBER
	GETJI				;GET IT
	ERJMP	SETS.1			;LOSE!!
	POP	P,T1			;GET ADDRESS BACK
	TLO	T1,-1			;MAKE A POINTER
	MOVE	T2,T4			;GET DIRECTORY NUMBER
	DIRST				;CONVERT TO STRING
	ERJMP	SETS.1			;LOSE!!
	POPJ	P,			;WIN AND RETURN

SETSRC:	HRRO	T3,T1			;POINT TO THE STRING
	SETZ	T4,			;NO PASSWORD
	SETO	T5,			;MY JOB
	MOVE	T1,[AC%CON+3]		;CONNECT
	MOVEI	T2,T3			;AND ADR OF BLOCK
	ACCES				;CONNECT
	ERJMP	SETS.1			;LOSE?
	POPJ	P,			;WIN!!

SETS.1:	HALT	.			;LOSE

>  ;END IFN FTJSYS
SUBTTL	Queue Manipulation Routines

COMMENT /
;^;++
		Queue Manipulation Routines

Manipulation of the queues is handled by 3 pair of routines:

	QUEJOB -- QJOBH
	QUELOG -- QLOGH
	QUEFIL -- QFILH

The first routine in each pair, is a dummy routine which is
in the lowseg, which is used to call the second routine which is in
the hiseg.

The routines are as follows:

QUEJOB - QJOBH	Submit current job to Batch
QUELOG - QLOGH	Submit LOG file for printing
QUEFIL - QFILH	Submit user's file to the proper queue

;--;^
/
	DOWN

;+These routines are dummy routines which are used for calling
;	the various queueing routines which are in the high-segment.
;
;QUEJOB and QUELOG keep the hisegment around since
;	this is the end of a job and we need the hiseg for the
;	next job.
;



;QUEJOB is used to queue up a batch job at the successful
;completion of a job.
;

QUEJOB:	PUSHJ	P,GETHGH		;GET THE HISEG
	PJRST	QJOBH			;AND CALL THE QJOB ROUTINE



;QUELOG is used to job have the log-file queued, usually when
;a job is aborted.
;

QUELOG:	PUSHJ	P,GETHGH		;GET THE HISEG
	PJRST	QLOGH			;AND CALL THE QLOG ROUTINE



;QUEFIL is used to queue a user's file as the result of
;a /QUEUE switch on a $DECK card.
;-;#7

QUEFIL:	PUSHJ	P,GETHGH		;GET THGE HISEG
	PUSHJ	P,QFILH			;CALL THE CORRECT ROUTINE
	PJRST	RELHGH			;RELEAS THE HISEG AND RETURN
	UP
;+These are the actual hiseg queue manipulation routines.
;
;QJOBH -- Routine to Create an Input Queue Request if
;	F.BTCH is set.  If not, Queue up the LOG file.
;


QJOBH:	TXZN	F,F.BTCH	;IS THE BATCH BIT SET?
	JRST	QJOBH1		;NO, JUST PRINT THE LOG FILE
	STAMP	STSUM		;YES, SUMMARY STAMP
	TELL	LOG,[ASCIZ /Batch Input Request Created
/]
	PUSHJ	P,CLSLOG	;RELEAS THE LOG FILE

IFN FTJSYS,<
	MOVE	T1,[3,,T2]	;3 ARGS IN T2
	MOVE	T2,[CTL,,5]	;CHANNEL,,FUNCTION
	MOVE	T3,[POINT 7,L.QUE+Q.CSTR]
	MOVE	T4,[111110,,1]	;JFNS FLAGS
	COMPT.	T1,		;DO IT
	  JRST	QJOBH0		;NO STRING
	MOVX	T1,1B15		;MAGIC QMANGR STRING FLAG
	IORM	T1,Q.CMOD(Q)	;STORE IT
>  ;END IFN FTJSYS

QJOBH0:	RELEAS	CTL,		;RELEAS THE CTL FILE
	LDB	T1,P.UNI	;LOAD THE UNIQUENESS
	AOS	T1		;CONVERT TO INTERNAL FORM
	DPB	T1,P.UNI	;AND RESTORE IT
	MOVE	T1,[.QSIZE,,L.QUE]
IFE FTJOBQ,<
	PJRST	.QUEER##	;PUSHSEG TO QMANGR AND RETURN
>
IFN FTJOBQ,<
	PUSH	P,.JBREL##	;SAVE JOBREL
	PUSH	P,.JBFF##	; AND SAVE JOBFF
	MOVE	T2,.JBREL##	;POINT JOBFF
	ADDI	T2,1		; TO THE TOP OF USED CORE
	MOVEM	T2,.JBFF##	;TO AVOID CSPMEM'S PAGES
	PUSHJ	P,.QUEER##	;CALL QMANGR
	POP	P,.JBFF##	;RESTORE JOBFF
	POP	P,T1		;RESTORE JOBREL
	CORE	T1,
	 JFCL			;WE TRIED!
	POPJ	P,		;RETURN.
>

QJOBH1:	STAMP	STSUM		;SUMMARY STAMP
	TELL	LOG,[ASCIZ /No Batch Input Request Created
/]
				;AND FALL THRU TO QUEUE THE LOG FILE
;QLOGH -- Routine to Create a Print Request for the
;	LOG File.
;

QLOGH:	CLOSE	CTL,CL.RST	;DELETE THE CTL FILE
;[1052] QLOGH 1/2 JHT 2/13/75
	RELEASE	CTL,		;[1052] RELEASE THE CHANNEL
	STAMP	STSUM		;STAMP THE LOG
	TELL	LOG,[ASCIZ /LOG File Submitted for Printing
/]
	PUSHJ	P,CLSLOG	;CLOSE THE LOG FILE
	MOVSI	T1,Q.LSTR(Q)	;ADDRESS OF LOG FILE BLOCK
	HRRI	T1,Q.OSTR(Q)	;TO BE MOVED DOWN A LITTLE
	BLT	T1,Q.OMOD(Q)		;ZAP
	PUSHJ	P,STLPQ		;SET STATION GENERIC NAME FOR LPT
	MOVEM	T1,Q.DEV(Q)	;AND STORE IT
	MOVE	T1,[BYTE (9) Q.ONOT+1,Q.FMOD+1 (18) 1]
	MOVEM	T1,Q.LEN(Q)	;NEW QUEUE PARAMETERS
	SETZM	Q.OSIZ(Q)	;SET DEFAULT LIMIT
	CLEARM	Q.OFRM(Q)	;CLEARM OUT FORMS TYPE
	CLEARM	Q.ONOT(Q)	;AND ANNOTATION
	SETZM	Q.AFTR(Q)	;CLEAR THE AFTER PARAMETER
	MOVE	T1,[Q.OMOD+1,,L.QUE]
IFE FTJOBQ,<
	PJRST	.QUEER##	;AND CALL THE MANAGER
>
IFN FTJOBQ,<
	PUSH	P,.JBREL##	;SAVE JOBREL
	PUSH	P,.JBFF##	; AND SAVE JOBFF
	MOVE	T2,.JBREL##	;POINT JOBFF TO TOP OF CORE
	ADDI	T2,1
	MOVEM	T2,.JBFF##	; TO AVOID CSPMEM'S PAGES
	PUSHJ	P,.QUEER##	;CALL QMANGR
	POP	P,.JBFF##	;RESTORE JOBFF
	POP	P,T1		;RESTORE JOBREL
	CORE	T1,
	 JFCL
	POPJ	P,		;RETURN.
>
;QFILH -- Routine to submit user's file to the correct queue.
;-


QFILH:	MOVEI	T1,Q.OMOD+1	;LOAD ADDRESS OF BLOCK
	PUSHJ	P,EXPND		;GET NEEDED CORE
	MOVE	T2,T1		;GET OLD JOBFF AS INDEX TO QUEUE AREA
	MOVEI	T3,(T2)		;SETUP DESTINATION FOR BLT
	HRLI	T3,(Q)		;SETUP SOURCE POINTER FOR BLT
	BLT	T3,Q.USER+1(T2)	;SETUP QUEUE HEADER WITH A BLT
	PUSHJ	P,STLPQ		;SET STATION GENERIC NAME FOR LPT
	HLL	T1,L.QFN	;PUT DEVICE IN LEFT HALF
	MOVEM	T1,Q.DEV(T2)	;AND STORE IT
QFILH1:	MOVE	T1,[BYTE (9) Q.ONOT+1,Q.FMOD+1 (18) 1]
	MOVEM	T1,Q.LEN(T2)	;STORE Q.LEN WORD
	MOVE	T1,RIBDEV	;GET DEVICE
	MOVEM	T1,Q.OSTR(T2)	;AND STORE IT
	MOVE	T1,FILNAM	;AND FILE NAME
	MOVEM	T1,Q.ONAM(T2)	;AND STORE IT
	HLLZ	T1,FILEXT	;GET THE EXTENSION
	MOVEM	T1,Q.OEXT(T2)	;AND STORE IT
	MOVSI	T1,FILPTH+2	;ADDRESS OF DIRECTORY BLOCK
	SKIPN	FILPTH+2	;IS IT DEFAULT?
	MOVSI	T1,Q.IDDI(Q)	;YES, GET THE REAL PATH
	HRRI	T1,Q.ODIR(T2)	;PLACE TO PUT IT
	BLT	T1,Q.ODIR+5(T2)	;AND PUT IT THERE
	MOVE	T1,[010000111101] ;FMOD BITS
	MOVEM	T1,Q.OMOD(T2)	;STORE THEM
	HRRZ	T1,DEKBLK	;GET BLKS*COP
	MOVEM	T1,Q.OSIZ(T2)	;AND STORE IT
	SETZM	Q.AFTR(Q)	;CLEAR THE AFTER PARAMETER
;
;			CONTINUED ON NEXT PAGE
;
;
; NOW CALL THE QMANGR
;
	MOVSI	T1,Q.OMOD+1	;LENGTH OF REQUEST
	HRRI	T1,(T2)		;ADDRESS OF BLOCK
IFN FTJOBQ,<
	PUSH	P,.JBREL##	;SAVE JOBREL
	PUSH	P,.JBFF##	; AND SAVE JOBFF
	MOVE	T3,.JBREL##	;POINT JOBFF TO TOP OF CORE
	ADDI	T3,1		; TO AVOID PUTTING BUFFERS
	MOVEM	T3,.JBFF##	; OVER CSPMEM'S PAGES
>
	PUSHJ	P,.QUEER##	;CALL THE MANAGER
IFN FTJOBQ,<
	POP	P,.JBFF##	;RESTORE JOBFF
	POP	P,T1		;RESTORE JOBREL
	CORE	T1,
	 JFCL
>
	HLLZS	L.QFN		;ZAP RH OF L.QFN
	STAMP	STMSG		;STAMP THE LOG
	TELL	LOG,FST%	;FILE SUBMITTED MESSAGE
	CLEARM	L.QFN		;CLEAR QUEUE WORD
	MOVE	T1,T2		;GET JOBFF TO SHRINK TO
	PJRST	SHRINK		;SHRINK AND RETURN
;STLPQ -- ROUTINE TO GENERATE STATION GENERIC NAME FOR LPT

STLPQ:	PUSH	P,T2		;SAVE T2
	MOVE	T1,L.LOC	;GET STATION NUMBER
	JUMPE	T1,STLPQ1	;JUST USE LPT IF ZERO
	IDIVI	T1,8		;SPLIT DIGITS
	LSH	T1,6		;SHIFT FIRST DIGIT OVER
	TRO	T1,'S00'(T2)	;PUT BACK TOGETHER
STLPQ1:	HRLI	T1,'LPT'	;GET GENERIC NAME
	POP	P,T2		;RESTORE T2
	POPJ	P,		;AND RETURN
IFN	FTJOBQ,<

SUBTTL	SUBROUTINES TO MANIPULATE THE 'JOB' QUEUE
;
; THIS SECTION CONTAINS SUBROUTINES TO MANIPULATE THE 'JOB' QUEUE.
;  THESE ARE IN SUPPORT OF THE DNT60 PROJECT.
;
; THE SUBROUTINES ARE AS FOLLOWS:
;
;	JOBINI		INITIALIZATION
;	JOBGET		GET AN ENTRY
;	JOBREL		RELEASE THAT ENTRY
;	JOBXIT		EXIT
;
; MUCH OF THIS CODE WAS TAKEN FROM LPTSPL AND ADAPTED TO
;  THE SPRINT ENVIRONMENT.
;
; DATA
;
	DOWN
;
JOBQUE:	BLOCK	1		;SET NON-ZERO IF WE ARE USING 
				; THE 'JOB' QUEUE
JOBMSG:	BLOCK	15		;PLACE TO BUILD MSGS TO QUASAR
JOBJOB:	BLOCK	1000		;DESCRIPTION OF JOB BEING PROCESSED
JOBLMT:	BLOCK	1		;LIMIT OF NUMBER OF CARDS IN THIS JOB
;
;
; SUBROUTINE TO INITIALIZE THE INTERFACE TO THE JOB QUEUE.
;  THIS IS CALLED BY THE 'START JOBQUE' COMMAND.
;
	UP
;
JOBINI:	MOVX	T1,<HEL.SZ,,.QOHEL>
	MOVEM	T1,JOBMSG	;PREPARE TO SAY 'HELLO' TO QUASAR
	MOVX	T1,'SPRINT'	;PROGRAM NAME
	MOVEM	T1,JOBMSG+HEL.NM
	MOVX	T1,'JOB000'	;SCHEDULING DEVICE
	MOVE	T2,L.MYST	;GET STATION NUMBER
	DPB	T2,[POINT 3,T1,29] ;PUT IN DEVICE NAME
	LSH	T2,-3
	DPB	T2,[POINT 3,T1,23]
	MOVEM	T1,JOBMSG+HEL.SD
	MOVEM	T1,JOBMSG+HEL.PD ; AND PROCESSING DEVICE
	MOVX	T1,FRMNOR	;ALWAYS USE NORMAL FORMS
	MOVEM	T1,JOBMSG+HEL.I1
	MOVX	T1,<^D100000,,0> ;MLIMIT,,NXTJOB
	MOVEM	T1,JOBMSG+HEL.I2
	SETZM	JOBMSG+HEL.I3	;UNUSED WORD
	MOVX	T1,%%.QSR+HELFRZ+HELSCH 
				;VERSION NUMBER + FROZEN FORMS
				; + SCHEDULING
	MOVEM	T1,JOBMSG+HEL.ST
	MOVE	T1,L.MYST	;MY STATION NUMBER
	STORE	T1,JOBMSG+HEL.ST,HELDSN
	MOVEI	T3,JOBMSG	;SEND THE MESSAGE
	PUSHJ	P,SNDQSR##
	POPJ	P,		;RETURN TO START COMMAND PROCESSOR
;
;
; SUBROUTINE TO GET A JOB FROM THE JOB QUEUE.  SKIP RETURN IF
;  A JOB IS PRESENT WITH ALL OF THE SPRINT FILE PARMS
;  FILLED IN FROM THE REQUEST.
;
	DOWN
;
JOBGET:	PUSH	P,.JBREL##	;SAVE JOBREL
JOBGTX:	PUSHJ	P,CSPRCV##	;RECEIVE A MESSAGE (IF ANY)
	JUMPE	T1,JOBGT2	;NONE.
	LOAD	T2,.MSTYP(T1),MS.TYP ;GET MESSAGE TYPE
	CAIN	T2,.QONEX	;IS THIS A JOB TO DO?
	JRST	JOBGT1		;YES.
	JUMPGE	T1,JOBGTX	;NO, IF NOT PAGED, JUST IGNORE.
	HRRZ	B,T1		;GET PAGE NUMBER
	ADR2PG	B
	PUSHJ	P,M$RELP	;RELEASE THE PAGE
				; (REG B IN SPRINT IS AP IN CSPQSR)
	JRST	JOBGTX		;TRY FOR ANOTHER.
;
; HERE WHEN WE HAVE A JOB.
;
JOBGT1:	HRRZ	B,T1		;COPY ADDRESS OF MSG INTO B
	LOAD	T2,.MSTYP(T1),MS.CNT ;GET LENGTH
	HRLZS	T1		;PUT CSPQSR'S ADDRESS IN LH
	HRRI	T1,JOBJOB	;PUT MY ADDRESS IN RH
	BLT	T1,JOBJOB-1(T2)	;COPY DATA TO LOW CORE
	ADR2PG	B		;SET UP B TO RELEASE PAGE
	PUSHJ	P,M$RELP##	;RELEASE THE PAGE
;
;			CONTINUED ON NEXT PAGE
;
;
; HERE WHEN THE REQUEST HAS BEEN COPIED INTO SPRINT.
;  EXTRACT THE FILE INFO AND SCATTER IT AROUND FOR SPRINT.
;  NOTE THAT ONLY THE FIRST FILE IS PROCESSED.
;
	MOVE	T3,[XWD CDRPTH,CDRPTH+1]
	SETZM	CDRPTH		;CLEAR OUT PATH BLOCK
	BLT	T3,CDRPTH+7
	SETZM	CDRNAM		;CLEAR OUT NAME
	SETZM	CDREXT		; AND EXTENSION
	SETZM	CDRPPN		; AND PPN
	LOAD	T1,JOBJOB+.EQLEN,EQ.LOH ;POINT TO FP
	LOAD	T2,JOBJOB+.FPSIZ(T1),FP.FHD
	ADD	T2,T1		;POINT TO FD
IFN FTUUOS,<
	MOVE	T3,JOBJOB+.FDNAM(T2)
	MOVEM	T3,CDRNAM	;STORE FILE NAME
	HLLZ	T3,JOBJOB+.FDEXT(T2)
	MOVEM	T3,CDREXT	;STORE EXTENSION
	MOVEI	T3,CDRPTH+2
	HRLI	T3,JOBJOB+.FDPPN(T2)
	LOAD	T4,JOBJOB+.FPSIZ(T1),FP.FFS
	ADDI	T4,-FDMSIZ
	BLT	T3,CDRPTH+2(T4)	;COPY SPECIFIED PATH INTO SPRINT
	MOVEI	T3,CDRPTH
	SKIPN	CDRPTH+3
	MOVE	T3,CDRPTH+2
	MOVEM	T3,CDRPPN	;STORE PPN
	SKIPN	T3,JOBJOB+.FDSTR(T2)
> ;END OF IFN FTUUOS
;
;
; HERE TO GET TOPS-10 SYTLE INFO OUT OF THE TOPS-20
;  FILE DESCRIPTOR.  THE ALTERNATIVE IS TO COMPLETELY
;  JSYS-IZE SPRINT.
;
IFN FTJSYS,<
	MOVX	T1,<POINT 7,.FDSTG>
	ADDI	T1,JOBJOB(T2)	;BUILD POINTER TO FILE STRING
	PUSH	P,T1		;SAVE POINTER FOR STPPN
JOBGT4:	ILDB	T2,T1		;GET CHARACTER
	CAIE	T2,76		;END OF USER'S NAME?
	 JRST	JOBGT4		;NO, WAIT FOR IT
	PUSH	P,T1		;SAVE POINTER TO END OF NAME
	MOVE	T3,[POINT 6,CDRNAM]
JOBGT6:	ILDB	T2,T1		;GET CHARACTER OF FILE NAME
	JUMPE	T2,JOBGT7	;END OF STRING
	CAIN	T2,"."		;END OF NAME?
	 JRST	JOBGT5		;YES, GO DO EXTENSION
	SUBI	T2,40		;CONVERT TO SIXBIT
	IDPB	T2,T3		;BUILD NAME
	JRST	JOBGT6
;
; HERE WHEN THE NAME IS COMPLETE.  BUILD EXTENSION.
;
JOBGT5:	MOVE	T3,[POINT 6,CDREXT]
JOBGT8:	ILDB	T2,T1		;GET CHARACTER FROM STRING
	JUMPE	T2,JOBGT7	;END OF STRING
	CAIN	T2,"."		;END OF EXTENSION?
	 JRST	JOBGT7		;YES, DONE WITH STRING
	SUBI	T2,40		;NO, CONVERT TO SIXBIT
	IDPB	T2,T3		;ACCUMULATE EXTENSION
	JRST	JOBGT8		;DO THE REST
;
; HERE WHEN WE HAVE THE EXTENSION AND NAME STORED.  GET THE PPN.
;
JOBGT7:	SETZ	T2,		;STORE A NULL AFTER NAME...
	POP	P,T1		;GET POINTER TO END OF NAME
	IDPB	T2,T1		;TERMINATE STRING AT END OF NAME
	POP	P,T1		;GET POINTER TO STRING
	STPPN			;COMPUTE A PPN
	 ERJMP	JOBGT9		;ERROR, IGNORE NAME
	MOVEM	T2,CDRPPN	;STORE PPN
JOBGT9:	
> ;END OF IFN FTJSYS
;
;
; NOW STORE STRUCTURE.  THE UUOS CASE SKIPS THE FIRST INSTRUCTION
;  IF IT HAS A STRUCTURE NAME FROM THE FD.
;
	MOVSI	T3,'DSK'
	MOVEM	T3,CDRDEV	;STORE DEVICE NAME
	MOVEM	T3,CDROPN+1	; TWICE
	LOAD	T3,JOBJOB+.EQLM2,EQ.PGS
	MOVEM	T3,JOBLMT	;STORE CARD LIMIT
	HLRZ	T4,JOBJOB+.EQJOB ;GET LH OF JOB NAME
	MOVE	T3,L.MYST	;GET OUR OWN STATION
	CAIE	T4,<'CDR'>	;IS JOB FROM D60SPL?
	JRST	JOBGT3		;NO.  DONT SET LOCATION.
	LDB	T3,[POINT 3,JOBJOB+.EQJOB,29]
	LDB	T4,[POINT 3,JOBJOB+.EQJOB,23]
	DPB	T4,[POINT 3,T3,32] ;BUILD STATION NUMBER
JOBGT3:	MOVEM	T3,.MYSTA	;PASS STATION NUMBER TO QMANGR
	AOS	-1(P)		;SKIP RETURN
JOBGT2:	PUSHJ	P,M$CLNC##	;DESTROY ALL UNUSED PAGES
	POP	P,T1		;RESTORE JOBREL
	CORE	T1,
	 JFCL
	POPJ	P,		;RETURN.
;
;
; SUBROUTINE TO RELEASE THE CURRENT JOB AND DISPOSE OF THE FILE.
;
	DOWN
;
JOBREL:	SKIPN	JOBJOB		;IS THERE A CURRENT JOB?
	POPJ	P,		;NO.
	LOAD	T1,JOBJOB+.EQLEN,EQ.LOH ;POINT TO FP
	LOAD	T2,JOBJOB+.FPSIZ(T1),FP.FHD
	ADD	T2,T1		;POINT TO FD
	LOAD	T3,JOBJOB+.FPINF(T1) ;GET THE INFO WORD
	TXNE	T3,FP.SPL	;SPOOLED (UNLIKELY!)
	JRST	JOBRL1		;YES, DELETE IT.
	TXNE	T3,FP.IGN	;IS IT IGNORED?
	JRST	JOBRL2		;YES.
	TXNN	T3,FP.DEL	;IS IT /DELETE?
	JRST	JOBRL2		;NO.
	TXNE	T3,FP.FLG	;YES, IS IT THE LOG FILE?
	TXNE	T3,FP.FCY	;YES, IS IT /COPIES:0?
	SKIPA			;NO, NORMAL FILE.
	JRST	JOBRL1		;YES, DELETE IT.
JOBRL1:	SETZB	T1,T2		;DELETE THE FILE
	SETZB	T3,T4
	RENAME	CDR,T1		;TELL FILSER TO DELETE THE FILE
	 JFCL			;WE TRIED...
JOBRL2:	MOVX	T1,<REL.SZ,,.QOREL>
	MOVEM	T1,JOBMSG	;SET UP FOR RELEASE MESSAGE
	LOAD	T1,JOBJOB+.EQITN ;INTERNAL TASK NAME
	STORE	T1,JOBMSG+REL.IT
	MOVEI	T3,JOBMSG	; (SPRINT REG T3 = CSPQSR REG T1)
	PUSHJ	P,SNDQSR##	;RELEASE THE ENTRY
	POPJ	P,		;WE ARE DONE.
;
;
; SUBROUTINE TO EXIT FROM COMMUNICATION WITH QUASAR.
;  I.E., TELL QUASAR 'GOODBY'.
;
	UP
;
JOBXIT:	MOVX	T1,<HEL.SZ,,.QOHEL>
	MOVEM	T1,JOBMSG	;PREPARE TO SAY 'GOODBY' TO QUASAR
	MOVX	T1,'SPRINT'	;PROGRAM NAME
	MOVEM	T1,JOBMSG+HEL.NM
	MOVX	T1,'JOB000'	;SCHEDULING DEVICE
	MOVE	T2,L.MYST	;GET STATION NUMBER
	DPB	T2,[POINT 3,T1,29] ;PUT IN DEVICE NAME
	LSH	T2,-3
	DPB	T2,[POINT 3,T1,23]
	MOVEM	T1,JOBMSG+HEL.SD
	MOVEM	T1,JOBMSG+HEL.PD ; AND PROCESSING DEVICE
	MOVX	T1,FRMNOR	;ALWAYS USE NORMAL FORMS
	MOVEM	T1,JOBMSG+HEL.I1
	MOVX	T1,<^D100000,,0> ;MLIMIT,,NXTJOB
	MOVEM	T1,JOBMSG+HEL.I2
	SETZM	JOBMSG+HEL.I3	;UNUSED WORD
	MOVX	T1,%%.QSR+HELFRZ+HELSTC+HELBYE 
				;VERSION NUMBER + FROZEN FORMS
				; + STATUS CHANGE + EXITING
	MOVEM	T1,JOBMSG+HEL.ST
	MOVE	T1,L.MYST	;MY STATION NUMBER
	STORE	T1,JOBMSG+HEL.ST,HELDSN
	MOVEI	T3,JOBMSG	;SEND THE MESSAGE
	PUSHJ	P,SNDQSR##
	POPJ	P,		;RETURN TO EXIT COMMAND PROCESSOR
;
>;END IFN FTJOBQ
SUBTTL	Core and Segment Handling Routines

	DOWN

;^;+SHRINK -- Routine to return core.  SHRINK is called
;	with the desired JOBFF in T1.  SHRINK tries to
;	avoid doing the CORE UUO.
;-;#2


;  !-------------------------------------------------------!
;  !                       SHRINK (C)                      !
;  !                      +1  ALWAYS                       !
;  !                      +2  NEVER                        !
;  !=======================================================!
;  !   AC    !        CALLED        !       RETURNED       !
;  !-------------------------------------------------------!
;  !   T1    !    DESIRED JOBFF     !         ---          !
;  !-------------------------------------------------------!


SHRINK:
IFE FTJOBQ,<
	MOVEM	T1,.JBFF	;SAVE JOBFF
	IORI	T1,777		;IOR UP TO A PAGE BOUNDARY
	CAMN	T1,.JBREL	;EQUAL TO JOBREL?
	POPJ	P,		;YES, DON'T DO CORE UUO.
	CORE	T1,		;GIVE BACK THE CORE
	  JFCL			;IGNORE THE ERROR
	POPJ	P,		;AND RETURN
>
IFN FTJOBQ,<
;
; IN THE JOBQUE VERSION, CORE IS ALLOCATED FROM THE "HEAP"
;  TO AVOID CONFLICT WITH CSPMEM AND IPCF PAGE PASSING.
;
	MOVEM	T1,HEAPTR	;STORE NEW HEAP POINTER
	POPJ	P,		; AND RETURN.
>
;+EXPND -- Routine to get some core.  EXPND is called with the
;	size of the desired block in T1, and returns with
;	T1 containing the address of a zeroed block of the
;	desired size.  If a CORE UUO is necessary and fails,
;	a CEC error is given to the operator, and SPRINT
;	aborts.
;-;#2

;  !-------------------------------------------------------!
;  !                        EXPND (C)                      !
;  !                      +1   ALWAYS                      !
;  !                      +2   NEVER                       !
;  !=======================================================!
;  !   AC    !        CALLED        !       RETURNED       !
;  !-------------------------------------------------------!
;  !   T1    !    SIZE OF BLOCK     !   ADDRESS OF BLOCK   !
;  !-------------------------------------------------------!


EXPND:
IFE FTJOBQ,<
	PUSH	P,.JBFF		;SAVE JOBFF (AS ADR OF RETURNED BLOCK)
	ADDB	T1,.JBFF	;UPDATE JOBFF
	CAMG	T1,.JBREL	;DID WE BREAK INTO A NEW PAGE?
	  JRST	EXPND1		;NO, DON'T DO CORE UUO
	CORE	T1,		;YES!
	  SKIPA			;CAN'T DO IT!!!
	JRST	EXPND1		;CORE UUO WON
	TELL	OPR,CEC%	;ISSUE AND ERROR MESSAGE
	JRST	ABEND		;AND ABEND

EXPND1:	MOVE	T1,(P)		;LOAD ADDRESS OF BLOCK
	CLEARM	(T1)		;CLEAR THE FIRST WORD
	HRLS	T1		;MAKE IT ADR,,ADR
	ADDI	T1,1		;MAKE IT ADR,,ADR+1 (BLT POINTER)
	EXCH	T2,.JBFF	;GET NEW JOBFF
	BLT	T1,-1(T2)	;BLT THE BLOCK TO ZEROES
	EXCH	T2,.JBFF	;RESTORE T2 AND JOBFF
	PJRST	T1POPJ		;RETURN WITH T1 CONTAINING ADR OF BLOCK
>
IFN FTJOBQ,<
;
; IN THE JOBQUE VERSION, CORE IS ALLOCATED FROM THE "HEAP".
;
	PUSH	P,HEAPTR	;SAVE HEAP POINTER
	ADDB	T1,HEAPTR	;UPDATE HEAP POINTER
	CAIGE	T1,HEAEND	;REACHED END OF HEAP?
	JRST	EXPND1		;NO, WE ARE OK.
	TELL	OPR,CEC%	;CORE EXHAUSTED
	JRST	ABEND		; AND ABEND.
;
; HERE IF THE HEAP IS NOT EXHAUSTED.
;
EXPND1:	MOVE	T1,(P)		;LOAD ADDRESS OF BLOCK
	SETZM	(T1)		;CLEAR THE FIRST WORD
	HRLS	T1		;BUILD BLT CONTROL WORD
	ADDI	T1,1		; TO CLEAR THE BLOCK
	EXCH	T2,HEAPTR	;SAVE T2 AND GET END OF BLOCK +1
	BLT	T1,-1(T2)	;CLEAR THE BLOCK
	EXCH	T2,HEAPTR	;RESTORE T2 AND HEAPTR
	PJRST	T1POPJ		;RETURN WITH T1 = ADDR OF BLOCK
;
; HERE IS THE HEAP AND ITS CONTROL WORD.
;
HEAPTR:	BLOCK	1		;POINTER TO FIRST FREE WORD
HEAP:	BLOCK	2000		;THE HEAP ITSELF
HEAEND:	BLOCK	0		;CAN'T USE MORE THAN THIS.
>
;GETHGH -- ROUTINE TO GET SPRINT HISEGMENT.
;
;CALL:
;	PUSHJ P,GETHGH
;	  RETURN HERE ALWAYS
;
;GETHGH USES THE HISEGMENT CALLED FOR ON THE ORIGINAL GET-RUN COMMAND.

IFN FTUUOS,<
GETHGH:	TXNE	F,F.HTOP	;DO I HAVE IT ALREADY?
	  POPJ	P,		;YES, JUST RETURN

	PUSH	P,T1		;SAVE THIS
	MOVEI	T1,L.SAC	;BLT PNTR TO AC SAVE AREA
	BLT	T1,L.SAC+P	;SAVE ALL ACS
	MOVEI	T1,L.SGDV	;ADDRESS OF SAVEGET BLOCK
	GETSEG	T1,		;GET THE SEGMENT
	  HALT .		;ITS GOT TO BE THERE
	MOVSI	T1,L.SAC	;BLT POINTER FROM AC SAVE AREA
	BLT	T1,P		;RESTORE ALL ACS
	ON	F.HTOP		;WE'VE GOT ONE!!
	PJRST	T1POPJ		;RESTORE T1 AND RETURN


;RELHGH -- ROUTINE TO RELEASE HISEGMENT
;
;CALL:
;	PUSHJ P,RELHGH
;	  RETURN HERE ALWAYS

RELHGH:	TXNN	F,F.HTOP	;IS IT GONE ALREADY?
	  POPJ	P,		;YUP, JUST RETURN
	PUSH	P,T1		;SAVE T1
	MOVSI	T1,1		;SET HISEG SIZE TO 1 WORD
	CORE	T1,		;DELETE HISEG
	  POPJ	P,		;BE A GOOD LOSER
	OFF	F.HTOP		;I NO LONGER HAVE IT
	PJRST	T1POPJ		;RESTORE T1 AND RETURN
>  ;END IFN FTUUOS

IFN FTJSYS,<
RELHGH:
GETHGH:	POPJ	P,		;THEY ARE BOTH DUMMIES
>  ;END IFN FTJSYS
SUBTTL	JOBINT Traps and Device Error Handler

INTLOC:	PUSH	P,T1		;SAVE T1
	MOVE	T1,L.INTB+3	;GET ERROR BITS,,CHN
	TLNE	T1,ER.ICC	;CONTROL-C INTERCEPT?
	JRST	ICCINT		;YUP, HANDLE IT
	TLNE	T1,ER.QEX	;QUOTA EXCEEDED?
	JRST	QTAEX		;YUP GO DO IT
				;OTHERWISE ASSUME DEVICE OK ERROR

	TLZ	T1,-1		;GET 0,,CHN IN T1
	TXNN	F,F.JBI		;HAVE WE BEEN HERE BEFORE?
	  JRST	INTLC1		;NO, CONTINUE
	TXNE	F,F.BUSY	;IS BUSY ON?
	JRST	DEVWAT		;YES, GO THE NORMAL ROUTE
	JRST	INTIDL		;NO, GO THE SPECIAL ROUTE
INTLC1:	TXNE	F,F.DER		;WAS THERE A DEVICE ERROR?
	JRST	DEVWAT		;YES, WAIT SOME MORE AND TRY AGAIN

	ON	F.JBI		;FLAG THAT WE'VE BEEN HERE
	TXNE	F,F.LCDR	;SKIP IF NOT LOCAL CDR
	DEVSTS	T1,		;GET CONI WORD
	  JRST	INTLC2		;GIVE A GENERAL MESSAGE
	TXNE	T1,CN.RCK!CN.DTM!CN.CME
	  JRST	INTRET		;CATCH THESE ON INPUT ERROR
	TXNE	T1,CN.PKF	;PICK FAILURE?
	TELL	OPR,PKF%	;YES, TELL HIM
	TXNN	F,F.BUSY	;IS BUSY SET?
	  JRST	INTIDL		;NO, JUST POLLING
	TXNE	T1,CN.HPE	;HOPPER EMPTY/STACKER FULL?
	TELL	OPR,HPE%	;YUP!!
	TXNE	T1,CN.STP	;STOP PUSHED?
	JRST	INTLC3		;YES, ?DEV NOT READY
	JRST	DEVWAT		;NO, WAIT AND RETURN
INTLC2:	TXNN	F,F.BUSY	;IS BUSY SET?
	JRST	INTIDL		;NO, JUST POLLING
INTLC3:	TELL	OPR,DNR%	;YES, DEVICE NOT READY
	JRST	DEVWAT		;SLEEP AND TRY AGAIN
;HERE FOR CONTROL-C INTERCEPT
ICCINT:	PUSH	P,T2		;SAVE T2
	PUSH	P,T3		;AND T3
	MOVEI	T1,L.SL2	;PLACE TO PUT CURRENT S/L
	PUSHJ	P,GETSRC	;GET IT
	MOVEI	T1,L.SL1	;TO RESET BACK TO ORIGINAL S/L
	PUSHJ	P,SETSRC	;SET IT
	MONRT.			;GO TO MONMOD
	MOVEI	T1,L.SL2	;S/L BLOCK BEFORE THE MONRET
	PUSHJ	P,SETSRC	;SET IT THERE
	POP	P,T3		;RESTORE T3
	POP	P,T2		;AND T2
	JRST	INTRET		;LET HIM CONTINUE

;HERE FOR QUOTA EXCEEDED
QTAEX:	PUSHJ	P,E$QTA		;GO TYPE THE ERROR INTO THE LOG
	JRST	INTIDL		;RE-ENABLE AND POPJ

DEVWAT:	PUSHJ	P,HIBR10	;SLEEP FOR 10 SECONDS
INTRET:	MOVE	T1,L.INTB+2	;GET RETURN PC
	MOVEM	T1,L.IPC	;AND SAVE IT
	MOVEI	T1,CDRIN	;LOAD ADDRESS OF CDR INPUT ROUTINE
	TXZE	F,F.IN		;CDR INPUT UUO IN PROGRESS?
	MOVEM	T1,L.IPC	;YES, SAVE THE ADDRESS SO CHKOPR IS
				; CALLED
INTRT1:	CLEARM	L.INTB+2	;RE-ENABLE INTERRUPT
	CLEARM	L.INTB+3
	POP	P,T1		;AND T1
	JRST	@L.IPC		;AND RETURN FROM WHENCE WE CAME


;HERE IF JOBINT ON CDR WITH F.BUSY OFF.  HOPEFULLY CAUSED BY
;ROUTINE POLLING THE CDR. THIS ROUTINE REENABLES THE INTERRUPT
;AND POPJ'S BACK WHICH WILL PROPAGATE BACK TO THE TOP LEVEL.

INTIDL:	CLEARM	L.INTB+2	;REENABLE THE INTERRUPTS
	CLEARM	L.INTB+3
	PJRST	T1POPJ		;RESTORE T1 AND RETURN
SUBTTL	Useful Routines

;^;+TELFIL -- Routine to print a filespec into the LOG and/or
;	CTL files.  The filespec is of the form:
;
;:	DSKB:FILE.EXT[P,PN,SFD1,...,SFDN]
;:
;Call TFLLOG to type filespec into the LOG,
;	TFLCTL for the CTL file, or TELFIL for
;	both.
;-;#3
;CALL:
;	MOVEI T1,BASE ADR OF DEVICE CONTROL CELLS
;	PUSHJ P,TELFIL (OR TFLLOG OR TFLCTL)
;	  ALWAYS RETURN HERE

TFLLOG:	TXOA	F,F.QCTL	;QUIET THE CTL FILE
TFLCTL:	TXO	F,F.QLOG	;QUIET THE LOG

TELFIL:	TELL6	BOTH,.CCDEV(T1)	;TYPE THE DEVICE NAME
	CHR	BOTH,":"	;COLON
	TELL6	BOTH,.CCNAM(T1)	;TYPE THE FILENAME
	CHR	BOTH,"."	;DOT
	HLLZ	T5,.CCEXT(T1)	;GET THE EXTENSION
	TELL6	BOTH,T5		;AND TYPE IT
	SKIPN	.CCPPN(T1)	;ANY PPN?
	JRST	TELFL4		;NO, RETURN
	CHR	BOTH,"["	;START PPN SPEC
	HLRZ	T5,.CCPPN(T1)	;GET PROJECT NUMBER
	JUMPE	T5,TELFL1	;0 MEANS PATH SPEC
	RAD08	BOTH,T5		;TYPE PROJECT NUMBER
	CHR	BOTH,","
	HRRZ	T5,.CCPPN(T1)	;GET PROGRAMMER NUMBER
	RAD08	BOTH,T5		;AND TYPE IT
	JRST	TELFL3		;CLOSE OFF

TELFL1:	HRRZ	T1,.CCPPN(T1)	;LOAD PATH BLOCK ADDRESS
	HLRZ	T5,2(T1)	;GET PROJECT NUMBER
	SKIPE	T5		;PROJ=0?
	RAD08	BOTH,T5		;AND TYPE IT
	CHR	BOTH,","	;COMMA,
	HRRZ	T5,2(T1)	;GET PROGRAMMER NUMBER
	SKIPE	T5		;PROGRAMER = 0?
	RAD08	BOTH,T5		;AND TYPE IT
	MOVEI	T5,3(T1)	;SETUP LOOP COUNT STARTING AT PTHBLK + 3
TELFL2:	SKIPN	(T5)		;IS THERE AN SFD?
	JRST	TELFL3		;AND FINISH OFF
	CHR	BOTH,","	;YES, TYPE ","
	TELL6	BOTH,(T5)	;AND SFD-NAME
	CAIGE	T5,7(T1)	;ONLY THIS MANY SFDS
	AOJA	T5,TELFL2	;AND LOOP AROUND FOR ANOTHER
TELFL3:	CHR	BOTH,"]"	;CLOSE OFF PPN SPEC
TELFL4:	OFF	F.QLOG!F.QCTL	;TURN THEM BACK ON
	POPJ	P,		;AND RETURN
;+HIBR -- Routine to HIBER for a given time.  Call
;	with desired HIBER time in milliseconds in T1.
;	Automatically sets the "wake on TTY input" bit.
;	Call HIBR10 to hibernate for 10 seconds.
;-;#3

;  !-------------------------------------------------------!
;  !                        HIBR (C)                       !
;  !                      +1  ALWAYS                       !
;  !                      +2  NEVER                        !
;  !=======================================================!
;  !   AC    !        CALLED        !       RETURNED       !
;  !-------------------------------------------------------!
;  !   T1    !   SLEEP TIME IN MS   !         ---          !
;  !-------------------------------------------------------!


HIBR10:	MOVEI	T1,^D10000	;10000 MILLISECONDS
HIBR:	TXO	T1,HB.RTL	;SET THE WAKE BIT
	HIBER	T1,		;AND SLEEP!!
	  JFCL			;NOTHING WE CAN DO!!
	POPJ	P,		;AND RETURN
;+CHKOPR -- Routine to see if the Operator has typed anything,
;	and if so process it.
;-
;CALL:
;	PUSHJ P,CHKOPR
;	  ALWAYS RETURN HERE

CHKOPR:	SKPINL			;A LINE IN?
	POPJ	P,		;NO, RETURN

	CLEARM	L.HTOP		;ASSUME WE DON'T HAVE HISEG
	TXNE	F,F.HTOP	;DO WE HAVE IT?
	SETOM	L.HTOP		;YES, FLAG IT
	PUSHJ	P,GETHGH	;GET THE HISEG
	PUSH	P,L.SCIN	;SAVE ADDRESS OF CURRENT SCANERRS
	PUSH	P,L.SCLN	;DITTO
	PUSHJ	P,OPER		;GET THE COMMAND AND DO IT
	POP	P,L.SCLN	;RESTORE SCANNER ADRS
	POP	P,L.SCIN	;DITTO
	SKIPL	L.HTOP		;DID WE HAVE THE HISEG?
	PUSHJ	P,RELHGH	;YES, RELEASE THE HISEG
	POPJ	P,		;AND RETURN


;CLRCEL -- ROUTINE TO CLEAR DEVICE CONTROL CELLS
;	CALL WITH T1 CONTAINING BASE ADDRESS
CLRCEL:	MOVSI	T5,.CCDEV(T1)	;SOURCE ADDRESS
	HRRI	T5,.CCDEV+1(T1)	;DEST ADDRESS
	CLEARM	.CCDEV(T1)	;PREPARE TO ZAP
	BLT	T5,.CCEND(T1)	;ZAP!!
	POPJ	P,		;AND RETURN


;ROUTINE TO CLEAR THE EXTENDED UUO BLOCK
CLRUUO:	MOVE	T5,[RIBCNT,,RIBCNT+1]
	CLEARM	RIBCNT		;CLEAR FIRST WORD
	BLT	T5,RIBAUT	;AND THE REST
	POPJ	P,		;AND RETURN
ABEND:	MOVEI	T1,L.SL1	;ADR OF PRIME S/L
	PUSHJ	P,SETSRC	;SET IT
	EXIT			;AND EXIT


.POPJ1:	AOS	(P)
.POPJ:	POPJ	P,8

T1POPJ:	POP	P,T1
	POPJ	P,


CRLF:	BYTE (7) .CHCRT,.CHLFD,0
CCRLF:	BYTE (7) "]",.CHCRT,.CHLFD,0


MONTAB:	SIXBIT /-Jan-/
	SIXBIT /-Feb-/
	SIXBIT /-Mar-/
	SIXBIT /-Apr-/
	SIXBIT /-May-/
	SIXBIT /-Jun-/
	SIXBIT /-Jul-/
	SIXBIT /-Aug-/
	SIXBIT /-Sep-/
	SIXBIT /-Oct-/
	SIXBIT /-Nov-/
	SIXBIT /-Dec-/
SUBTTL	Operator Messages
	UP

	MSG(NST,W,Y,^4SPRINT is not START'ed^4)

	MSG(STD,W,Y,^4SPRINT is already START'ed^4 on ^5)

	MSG(NSD,E,Y,No Such Device "^5")

	MSG(NJA,W,N,^4No Jobs Active^4 )

	MSG(ICF,E,Y,^4Command is Illegal for a Fast FORTRAN Job^4)



	MSG(CER,E,Y,^4Command Error - Retype Line^4)

	MSG(ILC,E,Y,^4"^G" is an Illegal Command^4)

	MSG(CCL,W,Y,CCL Entry is Not Supported)

	MSG(SPL,W,Y,Device ^5 is Spooled)

	MSG(CDI,E,Y,Device ^5 Can't Do Input)

	MSG(OIR,M,Y,^4Operator Interaction Required^4])

	MSG(RAI,M,Y,Rebuilding Accounting Indices])	;[1050]

;THE FOLLOWING ARE UNRECOVERABLE ERRORS.  SPRINT WILL EXIT AFTER
;TYPING THEM TO THE OPERATOR.

	MSG(IOE,E,Y,I/O Error Writing LOG or CTL File)
	MSG(CRA,E,Y,Can't Read Accounting File)
	MSG(NCA,E,Y,No Core for ACCT.SYS Index)
	MSG(ERA,E,Y,Error Reading Accounting File)
	MSG(BFA,E,Y,Bad Format for Accounting File)
	MSG(ILU,E,Y,Illegal LUUO in SPRINT)
	MSG(COD,E,Y,Can't OPEN the DSK)
	MSG(CCC,E,N,Can't create CTL or LOG File -)
	MSG(CEC,E,Y,Can't Expand Core)
	MSG(CCI,E,Y,Can't Clear UFD Interlock)
	MSG(NHS,E,Y,No High Segment - Type R SPRINT)
	MSG(CEF,E,Y,Can't ENTER Fast-FORTRAN File)
	MSG(ROM,E,Y,Remote OPR must run System SPRINT)
SUBTTL	DEVICE ERROR MESSAGES
	DOWN


	DEFINE	DEVR%%,<

	XLIST


PKF%:	ASCIZ /%SPTPKF ^4PICK FAILURE^4 on ^5
^4	Check the next card and press the RESET button
^4/

HPE%:	ASCIZ /%SPTHPE ^4HOPPER EMPTY or STACKER FULL^4 on ^5
^4	Correct and press the RESET button
^4/


	LIST
	SALL
>

DEVR.%:	DEVR%%

	MSG(RLC,M,Y,Reset the last card and press the RESET button])
	MSG(RCK,W,Y,READ CHECK on ^5)
	MSG(CME,W,Y,CARD-MOTION Error on ^5)
	MSG(DTM,W,Y,DATA MISSED Error on ^5)
	MSG(DVE,W,Y,Input Device Error on ^5)
	MSG(DNR,M,Y,^4Input Device^4 ^5 Not Ready])
	MSG(UIE,E,N,Unreocverable Input Device Error - Status )
SUBTTL	Miscellaneous Messages

;FOR THE LOG
	DOWN

HOL3%:	ASCIN( - Card #^1 in Deck #^3)

;FOR THE OPERATOR
	UP

IDLMSG:	ASCIN(SPRINT is Idle )

CDJMSG:	ASCIC(SPRINT Job Running on ^5)

FFJMSG:	ASCIC(Fast FORTRAN Job Running on ^5)


RSTMSG:	ASCIC([SPRINT is RESET])

WHTMSG:	ASCIN(Card #^0)

PSEMSG:	ASCIN([SPRINT is PAUSEing )

ONMSG:	ASCIN(on ^5)

;FOR THE CTL FILE
	DOWN

CLINE:	ASCIN(^ICOMPIL /COMP/)

ELINE:	ASCIN(^IEXECUT /REL)

DELLIN:	ASCIN(%FIN::^IDELETE )

;**;[1071] Replace @ DUMLIN	JNG	23-Oct-75
DUMLIN:	ASCIC(^IDUMP)			;[1071]

ERRLIN:	ASCIC(%ERR::)			;[1071]

CRFLIN:	ASCIC(%FIN::^ICREF)

IFN FTUUOS,<
SETCDR:	ASCIC(.SET CDR ^B)
>  ;END IFN FTUUOS

IFN FTJSYS,<
SETCDR:	ASCIC(@SET CARD-READER-INPUT-SET (TO) ^J^K)
>  ;END IFN FTJSYS
SUBTTL	User Error Messages
	DOWN

	MSG(TMH,E,Y,Too Many Hollerith Errors)
	MSG(ABO,E,Y,Job Aborted By Operator)
	MSG(ICC,E,Y,Illegal Control Card $^9 -- Card #^0)
	MSG(TMC,E,Y,Too Many Binary Checksum Errors)
	MSG(BCK,W,N,Binary Checksum Error on Card #^0)
	MSG(NEF,W,Y,No End-Of-File Card Found - EOF Assumed)
	MSG(IBC,W,N,Illegal Binary Card - Card #^0)
	MSG(TMB,E,Y,Too Many Illegal Binary Cards)
	LMSG(UCO,W,Y,Unexpected Character(s) "^8" on Control Card - Ignored)
	LMSG(QTA,E,Y,Quota Exceeded on ^D Writing User File)
	MSG(DND,E,Y,Device ^6 is not a Disk)
	LMSG(DNA,E,Y,Device ^6 is Not Available)
	MSG(NFT,W,Y,No Files To Load)
	MSG(FSR,E,Y,Filespec Required on $INCLUDE Card)
	MSG(HOL,W,N,^A Hollerith Errors in Card #^0)
	MSG(EPF,W,Y,Extraneous Password Card Found - Ignored)
	MSG(EWF,E,Y,Error Writing File)
	MSG(URS,W,Y,/^7 is an Unrecognized Switch - Ignored)
	LMSG(ISW,W,Y,/^7 is not legal on the $^9 Card - Ignored)
	LMSG(AMO,E,Y,ASCII Mode Only on non-CDR Devices)
	LMSG(USV,W,Y,Unrecognized Switch Value on the /^7 switch - Switch Ignored)
	LMSG(SOR,W,Y,Switch value out of range on the /^7 switch - Switch Ignored)
	LMSG(MSV,W,Y,Missing Switch Value on the /^7 switch - Switch Ignored)
	LMSG(ICS,E,Y,Illegal Command Switch on the $^9 card)
;FILESPEC ERRORS
	MSG(DFN,E,Y,Double Filename Illegal)
	MSG(DEX,E,Y,Double Extension Illegal)
	MSG(NDV,E,Y,Null Device Illegal)
	MSG(DDV,E,Y,Double Device Illegal)
	MSG(IDS,E,Y,Illegal Directory Specification)
	MSG(SND,E,Y,SFD Nesting Too Deep)
	MSG(DDI,E,Y,Double Directory Illegal)


	UP

	ULMSG(IPP,E,Y,Incorrect PPN or Password or Name)
	ULMSG(CLB,E,Y,Can't Login as a Batch Job)
	MSG(SBO,M,Y,Job Stopped By Operator])
	MSG(CBO,M,Y,Job Continued By Operator])
	UMSG(IFP,E,Y,Illegal Format for PPN)
	UMSG(NYP,E,Y,Specified PPN is Not Yours)
	LMSG(PWR,E,Y,Password is Required)
	UMSG(PRG,M,Y,Unique Programmer Number is ^F])
	UMSG(SFD,M,Y,Unique SFD is ^E])
	UMSG(NAU,W,Y,No AUXACC Entry)
	MSG(FST,M,Y,File Submitted To ^H Queue])
	LMSG(BDT,W,Y,Bad Date-Time Specification on /^7 Switch - Ignored)
	MSG(LKE,E,N,LOOKUP/ENTER Error (^F) - )
	JLMSG(IDP,E,Y,Incorrect Directory or Password)
	JLMSG(IAS,E,Y,Invalid Account Specified)
	MSG(IJC,E,Y,Illegal JOB Card)
	JLMSG(BNS,E,Y,Binary Cards Not Supported)
	UP

;NOW, MY NAME

	DEFINE	.NAME(V,M,E,W)<
ASCIZ /	SPRINT Version V'M'('E')'W Running on ^5
/
>
SPTNAM:	.CLNAM		;[1050] CALL THE NAME MACRO

IFN FTJOBQ,<
	DEFINE	.NAME(V,M,E,W)<
ASCIZ /	SPRINT Version V'M'('E')'W Reading from the JOB queue
/
>
SPTNMJ:	.CLNAM		;CALL THE NAME MACRO
>


;*****CAUTION*****
;THE IN-CORE ACCT.SYS TABLE IS BUILT STARTING AT LOCATION H.TABL.
;	IT "MUST" BE THE VERY LAST THING IN THE HISEGMENT
H.FILL:	BLOCK	1		;FILL FOR ACCT.SYS CONSISTENCY CHECK
H.TABL:	BLOCK	0
	END SPRINT