Google
 

Trailing-Edge - PDP-10 Archives - bb-d868c-bm_tops20_v4_2020_distr - language-sources/sprint.mac
There are 37 other files named sprint.mac in the archive. Click here to see a list.
TITLE	SPRINT  DECsystem-10/20 Control Card Interpreter
SUBTTL	Larry Samberg/LSS/JHT/JNG/WLH    2 October 79

;
;
;
;           COPYRIGHT (c) 1973,1974,1975,1976,1977,1978,1979 BY
;           DIGITAL EQUIPMENT CORPORATION, MAYNARD, MA.
;
;     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.

	SALL			;Generate clean listing

	SEARCH	GLXMAC		;Get GLXLIB symbols
	PROLOGUE(SPRINT)
	SEARCH	QSRMAC		;Get QUASAR symbols
	SEARCH	ORNMAC		;GET ORION SYMBOLS (WTO STUFF)

TOPS20	<SEARCH ACTSYM>
TOPS10	<SEARCH	ACCSYM>

; Version Information
	SPTVER==104		;Major Version Number
	SPTMIN==0		;Minor Version Number
	SPTEDT==4073		;Edit Level
	SPTWHO==0		;Who Last Patched

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

; Store Version number in JOBVER
	LOC	137
.JBVER::EXP	%SPT

	RELOC
;               TABLE OF CONTENTS FOR SPRINT
;
;
;                        SECTION                                   PAGE
;    1. Revision History..........................................   3
;    2. Conditional Assembly Switches And Parameters..............   4
;    3. Symbol Definitions........................................   5
;    4. Conditional Assembly Macros...............................   5
;    5. Card Code Conversion Table Generation.....................   7
;    6. FILE-BLOCK Definitions....................................  13
;    7. ACCT.SYS and AUXACC.SYS Table Definitions.................  14
;    8. Lowsegment Storage Cells..................................  15
;    9. NON-ZERO storage..........................................  20
;   10. Entry and Initialization..................................  21
;   11. Job Setup and Idle Loop...................................  23
;   12. Start up the job..........................................  26
;   13. $JOB Card.................................................  27
;   14. MAKCTL - Create the CTL File..............................  30
;   15. MAKLOG - Create the LOG File..............................  31
;   16. Main Program Loop.........................................  32
;   17. Control Cards
;        17.1   Setup and Dispatch................................  33
;        17.2   $LANGUAGE.........................................  40
;        17.3   $DECK - $CREATE...................................  43
;        17.4   $RELOC............................................  44
;        17.5   $INCLUDE..........................................  45
;        17.6   $DATA - $EXECUTE..................................  46
;        17.7   $DUMP - $MESSAGE..................................  48
;        17.8   BATCH Commands....................................  49
;        17.9   $EOD..............................................  50
;        17.10  $JOB..............................................  50
;        17.11  $EOJ..............................................  50
;        17.12  $SEQUENCE.........................................  50
;        17.13  $TOPS10 - $TOPS20.................................  51
;   18. $JOB Card Switch Subroutines..............................  52
;   19. Routines To Finish Off a Job..............................  57
;   20. ABORT  -  Routine to abort the current job................  58
;   21. SUMARY  -  Place summary lines in the LOG file............  61
;   22. DONE
;        22.1   Release the job...................................  61
;   23. Non-$JOB Card Switch Subroutines..........................  62
;   24. Process Control Card Switch...............................  64
;   25. SWTOCT - Process octal switch value.......................  65
;   26. SWTDEC - Process decimal switch value.....................  65
;   27. FILENT  -  Routine to open a user file....................  66
;   28. LOG File I/O Utilities....................................  67
;   29. Control File I/O Utilities................................  68
;   30. MAKFUN  -  Routine to create a default filename...........  69
;   31. CTLCRD - Routine to copy current card.....................  71
;   32. FBCLOD
;        32.1   File Block Clear LOaD bits........................  73
;   33. S$OCT  - S$DEC
;        33.1   Octal and decimal number scanners.................  74
;   34. S$SIX
;        34.1   Routine to scan off a sixbit word.................  75
;   35. S$ASCZ
;        35.1   Routine to scan an  ASCIZ  string.................  76
;   36. S$TIM
;        36.1   Routine to return a Time Specification............  78
;   37. S$DATE
;        37.1   Date-Time Scanner **UNDER RADIX-10**..............  79
;   38. S$FILE
;        38.1   Routine to scan off a filespec....................  83
;   39. S$FSPC
;        39.1   Routine to flush leading spaces...................  86
;   40. S$INCH
;        40.1   Routine to get a character........................  86
;   41. DUMMY Routines to read one character from card............  87
;   42. CDRCHR - Get a card character.............................  87
;   43. Deck Stacking Routines....................................  88
;   44. Read a card
;        44.1   CDRASC - in ASCII and 026.........................  91
;        44.2   CDRIMG - in IMAGE.................................  93
;        44.3   CDRBIN - in Checksummed Binary....................  94
;   45. INFAIL  -  Input failure from source file.................  96
;   46. FILERR  -  Error writing user file........................  96
;   47. Accounting File Handlers..................................  97
;   48. MAKPTH
;        48.1   Routine to create UFD and SFD on a STR............ 105
;   49. SETUFL
;        49.1   Routine to set UFD interlock...................... 107
;   50. DOACCT - Do all job accounting............................ 108
;   51. Error traps for accounting routines....................... 109
;   52. Routines to SET and GET Search-List....................... 111
;   53. QUASAR CREATE
;        53.1   QUEJOB - Create batch entry....................... 113
;        53.2   QUELOG - LOG file PRINT request................... 114
;        53.3   QUEFIL - User file request........................ 115
;        53.4   Utility subroutines............................... 116
;   54. $TEXT Utilities........................................... 117
;   55. - Interrupt System Database............................... 118
SUBTTL	Revision History

;	Edit	SPR #			Comment

;	4000	N/A		1) Make this SPRINT version 104 for
;				   GALAXY release 4.
;	4001	20-11339	1) Parenthesized  switches  on  the
;				   $COBOL  card  on  the  20  don't
;				   produce a reasonable error.
;	4002	10-24080	1) Don't put %ERR:: into CTL  file,
;				   so /OUTPUT:ERROR will work.
;	4003	N/A		1) If /TIME: is  the last thing  on
;				   the $JOB  card, give  the job  a
;				   default time instead of 72  plus
;				   hours.
;	4004	10-26239	1) Don't  create   UFD's   on   any
;				   structure with a  FCFS quota  of
;				   zero.
;	4005	10-25504	1) When SPRINT processes a job that
;				   doesn't have an AUXACC entry  it
;				   uses the  search list  from  the
;				   previous job. Make a null search
;				   list and  allow the  job to  die
;				   gracefully.
;	4006	N/A		1) Make   accounting    code   more
;				   efficient.
;	4007	N/A		1) Use PHASE/DEPHASE pseudo-ops  to
;				   define accounting records.
;				2) Replace L.ACC block with  CSHIDX
;				   word    and    SAVCHR.    Avoids
;				   confusion.
;				3) Remove   L.MTCH    symbol    and
;				   storage.  No longer needed.
;				4) Add QUASAR dispatch table.
;	4010	N/A		1) Process comment cards properly.
;	4011	N/A		1) Fix W$WIDT  routine to  properly
;				   save the width argument.
;	4012	N/A		1) Make job card area large  enough
;				   to  accomodate  full   80-column
;				   card plus a null for ASCIZ.
;				2) Make    SUPPRESS    and    WIDTH
;				   combination work correctly.
;				3) Allow   SPROUT's   header    and
;				   trailer cards  to  pass  through
;				   the system correctly.
;	4013	N/A		1) After processing  a  job-control
;				   card call the "default" suppress
;				   routine, ie.  don't  assume  the
;				   default condition is suppress.
;	4014	N/A		1) Start adding ASCII mode support
;	4015	N/A		1) Implement further 4014
;	4016	N/A		1) Do SETNAM  UUO  to  clear  JACCT
;				   bit.
;				2) Allow  for  wider  lines  in   a
;				   stream ASCII file.
;
;	4017	N/A		1) Make  TOPS10  name  switch  work
;				   again.
;	4020	N/A		1) Make   mode   change    switches
;				   illegal when interpreting  ASCII
;				   mode decks.
;
;	4021	N/A		1) References  to  .EQOWN converted
;				   to .EQOID (library change).
;	4022	N/A		1) Enter  switches  for  batch  log
;				   creation, operator  intervention
;				   and user notification.
;
;	4023	N/A		1) Update  IB  to  reflect  library
;				   change.
;
;	4024	N/A		1) Put in USAGE accounting.
;
;	4025	20-11860	1) USAGE  accounting.  Charge   the
;				   reading of cards to the user who
;				   is reading the cards not to  the
;				   operator.
;
;	4026	N/A		1) Don't  default  deletion  of the
;				   input "deck". only delete it  if
;				   either FP.SPL or FP.DEL is set.
;
;	4027	N/A		1) Create a new entry point for the
;				   FILENT  subroutine  calling   it
;				   FRCENT.   The  entry  point   is
;				   defined to  prevent the  library
;				   from doing the  CHKAC JSYS  when
;				   we're trying to write files into
;				   <SPOOL>.
;				2) Change the "ERROR" option to the
;				   OUTPUT  switch  to "ERRORS"(Note
;				   the plurality).
;				3) Improve error reporting.
;				4) Start  allowing for pass-thru of
;				   certain parameters in the EQ.
;				5) Change the  current  /WRITE  and
;				   /WRITE-LOG switches  to  /BATLOG
;				   and   /BATCH-LOG   respectively.
;				   The arguments SUPERSEDE,  APPEND
;				   AND SPOOL Will remain unchanged.
;				6) Do STR Accounting bypass.
;				7) "Remember"  the  AFTER parameter
;				   from  the NEXTJOB for the CREATE
;				   message.
;				8) Put IB.PRG back into the IB.
;				9) Make the USAGE entry list  work.
;				   Specifically,     remove     all
;				   references  to  immediate   mode
;				   data (US%IMM). Also, add entries
;				   that are  now  required  by  the
;				   USAGE JSYS that were missing.
;
;	4030	N/A		1) Get rid of all default  items in
;				   the USAGE Accounting list.
;				2) Make switches work on  $LANGUAGE
;				   card.  Problem  was  that  GTJFN
;				   bumped the byte pointer past the
;				   slash.     Solution    was    to
;				   decrement  the  BP   after   the
;				   GTJFN.
;
;	4031	N/A		1) Provide for machine  independent
;				   control files.
;	4032	N/A		1) Make $RELOCATABLE  card  illegal
;				   except   when  taken  from  card
;				   reader.
;				2) Suppress  Job  Information  when
;				   sending WTO's.
;	4033	N/A		1) Allow for multiple Job decks  to
;				   be  processed  in  a  single Job
;				   request.   This   affects    the
;				   current   processing   done   on
;				   detection of $EOJ, EOF and $JOB.
;	4034	N/A		1) Implement $LABEL card.
;				2) Modify the  $IF  card  logic  to
;                                  examine   the   first  non-blank
;                                  character following  the  CPAREN
;                                  and   if   it's  a  DOLLAR  then
;                                  convert it to the system  prompt
;                                  character,  ie.   make  the  $IF
;                                  card truly system independent.
;				3) Allow the $PASSWORD card  to  be
;                                  optional   when   the  specified
;                                  directory  on   the   job   card
;                                  matches      the     submitter's
;                                  directory.
;	4035			1) If   there   is   not   a  blank
;                                  character immediately  following
;                                  the language control card then a
;                                  filespec   error   will   result
;                                  because the GTJFN wonT "see" the
;                                  slash   character.    This   fix
;                                  should  finish  up  the problems
;                                  incurred  by  using  GTJFN  that
;                                  were started in edit 4030.
;	4036			1) Allow  "REQUEST  FOR CHECKPOINT"
;                                  messages  to   be   ignored   by
;                                  SPRINT.
;				2) Solve the problems involved with
;				   not   resetting   the   previous
;				   line's width when scanning blank
;				   cards.
;	4037	N/A		1) Handle  the  FP  in a  different
;				   way.
;	4040	N/A		1) Stop    connecting    to    user
;				   directories. Instead, expand all
;				   FD's.
;	4041	N/A		1) Do fixup to make the destination
;				   node the same as the originating
;				   node in the QUOLOG routine.
;	4042	N/A		1) Fix the null filespec problem on
;				   control  cards so that they give
;				   the  proper  error in the user's
;				   log file.
;	4043	N/A		1) Setup FILRFD block correctly.
;	4044	N/A		1) Fix blank card problem in CDRASC
;				   routine. Character count was not
;				   being cleared properly.
;	4045	N/A		1) Make  first   pass  at  allowing
;				   mixed-case     alphabetics    in
;				   control cards.
;	4046	N/A		1) Make SPRINT run on the 10.  This
;				   includes  fixups to handle MACRO
;				   Assembler incompatibilities.
;	4047	N/A		1) File  loading order wasn't being
;				   cleared  on  appropriate control
;				   cards.
;				2) Fix improper handling of CRLF on
;				   Stream ASCII FILES.
;	4050	N/A		3) Change the format of WTOJ's.
;	4051	N/A		1) Fix  manifestation  of  LOG file
;				   deletion  when  OUTPUT:NOLOG  is
;				   specified   and  the  job is not
;				   submitted to the input spooler.
;	4052	N/A		1) Provide  support  for  a  system
;				   independent   control   card  to
;				   stack  decks  into  the  control
;				   file, al la $TOPS10.
;	4053	N/A		1) Use S%TBLK routine for scanners.
;	4054	N/A		1) Continue edit 4053 (S%TBLK stuff).
;	4055	N/A		1) Fix bug in switch scanner(S$ASCZ).
;	4056	N/A		1) Report illegal switch arguments
;				   as well as illegal switches.
;				2) Don't log illegal control cards
;				   twice.
;	4057	N/A		1) Validate conditional in $IF card.
;	4060	N/A		1) Make S$ASCZ routine clear first
;				   word of storage area.
;	4061	N/A		1) Remove the S$SIX routine and
;				   instead use the S%SIXB routine
;				   in the library.
;	4062	N/A		1) Make $INCLUDE follow the same
;				   logic as the $language cards.
;	4063	N/A		1) When doing Usage accounting make
;				   that no extraneous bits appear in
;				   the sequence number entry.
;	4064	N/A		1) Set the FNDJOB flag sooner.
;	4065	N/A		1) Change error message for Invalid
;				   Password card.
;				2) Reset byte pointer in the ASCII
;				   card stacking routine, STASC.
;	4066	N/A		1) Minor fix to S$ASCZ routine.  Make
;				   it accept all digits, (0-9).
;	4067	N/A		1) Move Node from Next Job Message to WTOOBJ
;				   for Real Readers otherwise use default Node
;	4070	23-Aug-79	1) Queue up Log for User if Job Card is valid
;	4071	27-Aug-79	1) Stopcodes to ORION
;				2) On Null Jobname Use Funny name
;	4072	30-Aug-79	1) SET ONOD field on Creates to Quasar so
;				   Output will get located properly
;	4073	2-Oct-79	1) Include /TPUNCH /FEET /CPUNCH /CARDS on -20
SUBTTL	Conditional Assembly Switches And Parameters




	ND	NPPNRM,^D15	;ELSE REMEMBER THIS MANY
;SPRINT will  remember  the  NPPNRM  most  recently  used  PPN's,
;       thereby  not  needing  to  read ACCT.SYS on a match.  The
;       cost in space  is  6*NPPNRM  words  of  table  space  and
;       approximately 50 words of code.



;;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%DFMD,0		;DEFAULT INPUT MODE
						; 0=ASCII
						; 1=026
						; 2=BCD
	ND	A%SPRS,0		;DEFAULT /SUPP-/NOSUPP
						; 0=/NOSUPPRESS
						; 1=/SUPPRESS
	ND	.FCTFL,0		;#0=FACT FILE ACCOUNTING
					; 0=NO FACT FILE ACCOUNTING
SUBTTL	Symbol Definitions

;Accumulator assignments
	B==13			;UTILITY BYTE POINTER
	Q==14			;INDEX TO QUEUE PARAMETER AREA
	F==15			;FLAG REGISTER
	C==16			;INPUT/OUTPUT CHARACTER


;I/O Device channels

	UFD==5			;FOR LOOKING UP AND CREATING UFDS

SUBTTL	Conditional Assembly Macros
	DEFINE	$SUPPRESS,<IFN A%SPRS,>
	DEFINE	$NOSUPPRESS,<IFE A%SPRS,>

;MACRO TO SUPPRESS $WTO MACRO'S
;FLAGS (IN ACCUMULATOR F)

	F.FATE==1B27		;ABORTING DUE TO FATAL ERROR
	F.BTCH==1B28		;SUBMIT JOB TO BATCH
	F.MAP==1B29		;/MAP WAS SPECIFIED
	F.RSCN==1B34		;CHARACTER INPUT INHIBIT
	F.DOLR==1B35		;HE SAID /DOLLAR FOR THIS DECK

;USEFUL SYMBOLS
	IWPC==^D27		;IMAGE WORDS/CARD
	BWPC==^D26		;BINARY WORDS/CARD
	CPC==^D80		;COLUMNS/CARD
	SMA==^D133		;MAXIMUM LINE WIDTH FOR ASCII FILES

;IMPORTANT ASCII CHARACTER IMAGES
	.IMDOL==2102		;DOLLAR SIGN
	.IM79==5		;7-9 PUNCH


;SOME RANDOM SYMBOLS
	SLLEN==^D36*3		;LENGTH OF A SEARCH LIST BLOCK
	PTLEN==12		;PATH EXTENSION TO S/L BLOCK
	FIL.LN==3		;NUMBER OF FILES TO DELETE PER LINE
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.

;TABLE FIELD MASKS
	CODASC==0,,-1	;ASCII CHARACTER
	COD026==-1,,0	;026/BCD CHARACTER

;OFFSET TO GENERATE FOR HOLLERITH ERROR
	CODHER==100000	;WILL GENERATE A "\"

;ROW PUNCH DEFINITIONS
	..12==	20	;A 12 PUNCH
	..11==	10	;A 11 PUNCH
	..0==	4	;A 0 PUNCH
	..1==	40	;A 1 PUNCH
	..2==	100	;A 2 PUNCH
	..3==	140	;A 3 PUNCH
	..4==	200	;A 4 PUNCH
	..5==	240	;A 5 PUNCH
	..6==	300	;A 6 PUNCH
	..7==	340	;A 7 PUNCH
	..8==	2	;A 8 PUNCH
	..9==	1	;A 9 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


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 377,<
;	CTGEN(\K)
;	K==K+1>

	K==1
CODTBL:	XWD	" "," "			;SPACE IS A SPECIAL CASE
	XLIST

REPEAT 377,<CTGEN(\K)
	K==K+1>
	LIST

	XWD	"\","\"			;FOR HOLLERITH ERRORS
SUBTTL	FILE-BLOCK Definitions

	.FBFLG==0			;FLAGS
		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.SRH==1B22		;LOAD IN LIBRARY SEARCH MODE
	.FBFD==1			;BEGINNING OF THE FD
SUBTTL	ACCT.SYS and AUXACC.SYS Table Definitions


TOPS10	<
	PHASE	0
 ;ACCT.SYS VERSION 2
	.A2PPN:	BLOCK	1		;PROJECT-PROGRAMMER NUMBER
	.A2PSW:	BLOCK	1		;PASSWORD
	.A2PRV:	BLOCK	1		;PRIVILEGE WORD
	.A2NAM:	BLOCK	2		;USER NAME (2 WORDS)
	.A2TIM:	BLOCK	1		;TIMES MAY LOG IN
	.A2DEV:	BLOCK	0		;DEVICE MAY LOG IN ON
	.A3VMP:	BLOCK	1		;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:	BLOCK	1		;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
	PHASE	14
	.A2CNO:	BLOCK	1		;CHARGE NUMBER
	.A2DAT:	BLOCK	1		;EXPIRATION DATE
	DEPHASE


;AUXACC.SYS ENTRIES

	PHASE	0
	.AUBEG:	BLOCK	1		;FIRST WORD, ALWAYS CONTAINS -1
	.AUNUM:	BLOCK	1		;NUMBER OF WORDS FOLLOWING
					;THIS 1+ IS 5* THE NUMBER OF STRS
	.AUPPN:	BLOCK	1		;PROJECT-PROGRAMMER NUMBER
	.AUSTR:	BLOCK	1		;STRUCTURE NAME
	.AURSV:	BLOCK	1		;RESERVED QUOTA
	.AUFCF:	BLOCK	1		;FCFS QUOTA
	.AULGO:	BLOCK	1		;LOGOUT QUOTA
	.AUSTS:	BLOCK	1		;STATUS BITS
	  AU.RON==1B0			;READ-ONLY
	  AU.NOC==1B1			;NO-CREATE
	DEPHASE
>;; END OF TOPS10 CONDITIONAL CODE
SUBTTL	Lowsegment Storage Cells

L.PDL:	BLOCK	A%PDSZ		;PUSHDOWN LIST

; The  following  locations are not zeroed or reset with each
; new job.
LOWBEG:
IFE A%DFMD,<L.DMOD:>
IFN A%DFMD,<L.NMOD:>
L.CASC:	BLOCK	IWPC		;CURRENT CARD IN ASCII

IFE A%DFMD,<L.NMOD:>
IFN A%DFMD,<L.DMOD:>
L.C026:	BLOCK	IWPC		;CURRENT CARD IN 026

L.CLEN:	BLOCK	1		;CARD LENGTH IN BYTES
L.CSUP:	BLOCK	1		;SUPPRESSED CARD LENGTH
LINCHK:	BLOCK	1		;LINE CHECK FLAG FOR CDRASC

L.BP:	BLOCK	1		;STORED BYTE POINTER FOR $TEXT
L.FUN:	BLOCK	1		;RANDOM (?) NUMBER FOR FUNNY NAMES
	L.SLEN==40		;SYSNAM LENGTH
L.SYSN:	BLOCK	L.SLEN		;SYSNAM

L.FOB:	BLOCK	FOB.SZ		;"FILE OPEN BLOCK"
L.SAB:	BLOCK	SAB.SZ		;"SEND ARGUMENT BLOCK"
CSHIDX:	BLOCK	1		;CACHE INDEX
L.IFN:	BLOCK	1		;IFN FOR INPUT FILE
FNDJOB:	BLOCK	1		;SET UPON SUCCESSFULLY PROCESSING A $JOB CARD
CDRDEV:	BLOCK	1		;PHYSICAL READER FLAG

; Words remembered from the NEXTJOB Message.
L.EQCP:	BLOCK	EQXSIZ		;COPY OF WHOLE NEXTJOB EQ
	ACTSIZ==10		;DEFAULT SIZE ....MAY BE CHANGED
L.RDR:	BLOCK	1		;THE READER SPECIFIER
L.INF:	BLOCK	1		;COPY OF .FPINF WORD
L.DWID:	BLOCK	1		;CURRENT JOB'S DEFAULT WIDTH
TOPS10 <
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


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.ADAT:	BLOCK	1		;CREATION DATE-TIME OF LAST ACCT.SYS LOOKED AT
L.ASIZ:	BLOCK	1		;SIZE OF ACCT.SYS IN BLOCKS
L.APAG:	BLOCK	1		;ADDRESS OF FIRST PAGE OF ACCT INDICES
L.ANPG:	BLOCK	1		;NUMBER OF PAGES OF ACCT INDICES
L.XDAT:	BLOCK	1		;[1050] CREATION DATE-TIME OF AUXACC.SYS
L.BUF:	BLOCK	200		;UTILITY DISK BUFFER
L.ESIZ:	BLOCK	1		;ENTRY SIZE IN ACCT.SYS
L.MFPP:	BLOCK	1		;MFD PPN
L.AIFN:	BLOCK	1		;IFN FOR ACCT.SYS
L.XIFN:	BLOCK	1		;IFN FOR AUXACC.SYS
>  ;END TOPS10
; The following locations are zeroed at the beginning of  each
; job.

LOWZER:
L.BRK:	BLOCK	1		;LAST CHR FROM CARD WAS A BREAK

;Note that L.CHOL contains an appropriate  byte  pointer  to  the
;       current  card.   Therefore  the  right-HALF  contents  is
;       either L.CASC or  L.C026.  Note  also  that  the  initial
;       default BP is stored in L.DHOL.
L.CHOL:	BLOCK	1		;CURRENT CARD CODE BP
L.DHOL:	BLOCK	1		;DEFAULT CARD CODE BP
L.DPCR:	BLOCK	1		;$DUMP,,/CREF FLAG
L.FBCT:	BLOCK	1		;LOAD NUMBER FOR FILE BLOCKS
L.FBLN:	BLOCK	1		;LIST NAME FOR CREATED FILES
L.IMGT:	BLOCK	1		;IMAGE MODE TERMINATOR
L.JLOG:	BLOCK	1		;JOB GOT LOGGED IN (SORT OF)
L.LGDS:	BLOCK	1		;LOG FILE DISPOSITION
				;0=PRESERVE, ELSE DELETE
L.LOAD:	BLOCK	1		;SET TO -1 ON $DATA OR $EXEC CARD
L.LSW:	BLOCK	1		;THE LIST SWITCH
L.MODE:	BLOCK	1		;ADDRESS OF STACKING ROUTINE
L.NHOL:	BLOCK	1		;NUMBER OF HOLLERITH ERRORS
TRLCRD:	BLOCK	1		;NUMBER OF HEADER/TRAILER CARDS PASSED OVER
L.TFLG:	BLOCK	1		;[-1] IF LAST CARD READ WAS HEADER/TRAILER TYPE
L.QFN:	BLOCK	1		;USER SPECIFIED ARG TO /QUEUE:
L.SPRS:	BLOCK	1		;SUPPRESS FLAG (0=OFF)
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.UCHK:	BLOCK	1		;NUMBER OF CHKSUM ERRORS ALLOWED
L.UHOL:	BLOCK	1		;NUMBER HOLLERITH ERRORS ALLOWED
L.UIBC:	BLOCK	1		;NUMBER OF ILL BIN CARDS ALLOWED
L.WIDT:	BLOCK	1		;CARD WIDTH PARAMETER
L.SEQ:	BLOCK	1		;TMP STORAGE FOR SEQUENCE NUMBER
L.USER:	BLOCK	^D40/5		;STORAGE FOR /USER: SWITCH
L.PPN:	BLOCK	1		;STORAGE FOR /PPN: SWITCH
SAVCHR:	BLOCK	1		;SAVED QUOTE CHARACTER
REVDSP:	BLOCK	1		;$TOPS10/20 FLAG WORD
SYSIDP:	BLOCK	1		;SYSTEM INDEPENDENT JOB CARD FLAG
NOPSW:	BLOCK	1		;PASSWORD FLAG
LABADR:	BLOCK	10		;ROOM FOR TEMPORARY LABEL
TOPS10 <
L.CCHK:	BLOCK	1		;CHECKSUM FROM BINARY CARD
L.UFIN:	BLOCK	3		;UFD INTERLOCK BLOCK
>  ;END TOPS10

TOPS20 <
L.USNO:	BLOCK	1		;USER NUMBER
L.UDIN:	BLOCK	20		;GTDIR INFORMATION
L.UDIR:	BLOCK	14		;USER DIRECTORY STRING
L.UPSW:	BLOCK	10		;USER SPECIFIED PASSWORD
L.DPSW:	BLOCK	10		;ACTUAL PASSWORD FROM DIRECTORY
>  ;END IFN FTJSYS
L.DTM:	BLOCK	1		;DAYTIME
L.RTM:	BLOCK	1		;RUNTIME
JIBFLG:	BLOCK	1		;THE JIB FOR THE CURRENT JOB IS VALID


;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
CDRCNT:	BLOCK	1		;NUMBER OF CARDS READ - THIS JOB
DEKCRD:	BLOCK	1		;NUMBER OF CARDS READ - THIS DECK


FILFD:	BLOCK	FDXSIZ		;FD FOR USER FILE
FILIFN:	BLOCK	1		;IFN FOR OUTPUT FILE
FILOPN:	BLOCK	1		;-1 IF A FILE IS OPEN
FILSPC:	BLOCK	1		;-1 IF USER TYPED A FILESPEC

TOPS20 <
FILRFD:	BLOCK	FDXSIZ		;BLOCK FOR REL FILE FD
>  ;END IFN FTJSYS

CLFFD:	BLOCK	FDXSIZ		;BLOCK TO BUILD FD FOR LOG AND CTL
CTLIFN:	BLOCK	1		;IFN FOR CTL FILE
LOGIFN:	BLOCK	1		;IFN FOR LOG FILE
				;0=NOT OPEN, #0=OPEN
LOGPAG:	BLOCK	1		;LOG BUFFER PAGE ADDRESS
LOGCNT:	BLOCK	1		;COUNT OF BYTES LEFT IN BUFFER
LOGPTR:	BLOCK	1		;BYTE POINTER TO LOG BUFFER
JOBCRD:	BLOCK	SMA/5+1		;ROOM FOR JOB CARD

	LOWZSZ==.-LOWZER	;SIZE OF AREA TO ZERO ON EACH JOB


;Extended UUO Block


TOPS10 <
ELBLOK:	BLOCK	.RBAUT+1	;ARGUMENT COUNT
>  ;END TOPS10


LOWSIZ==.-LOWBEG	;SIZE OF LOWSEG AREA
SUBTTL	NON-ZERO storage

;THE HELLO MESSAGE FOR QUASAR
HELLO:	$BUILD	HEL.SZ
	  $SET(.MSTYP,MS.TYP,.QOHEL)	;FUNCTION
	  $SET(.MSTYP,MS.CNT,HEL.SZ)	;MESSAGE LENGTH
	  $SET(HEL.NM,,<SIXBIT /SPRINT/>)
	  $SET(HEL.FL,HEFVER,%%.QSR)	;QUASAR VERSION
	  $SET(HEL.NO,HENNOT,1)		;NUMBER OF OBJECT TYPES
	  $SET(HEL.NO,HENMAX,1)		;NUMBER OF STREAMS
	  $SET(HEL.OB,,.OTBIN)		;BATCH INPUT OBJECT
	$EOB
TOPS10	<INTVEC==VECTOR>
TOPS20	<INTVEC==LEVTAB,,CHNTAB>

SPTIB:	$BUILD	IB.SZ
	$SET	(IB.PRG,,%%.MOD)
	$SET	(IB.OUT,,T%TTY)
	$SET	(IB.PIB,,SPTPIB)
	$SET	(IB.INT,,INTVEC)
	$SET	(IB.FLG,IP.STP,1)	;STOPCODES TO ORION
	$EOB

; SPRINT PID BLOCK DEFINITION
SPTPIB:	$BUILD	(PB.MNS)
	$SET	(PB.HDR,PB.LEN,PB.MNS)
	$SET	(PB.FLG,IP.SPB,1)		;CHECK FOR IP.CFP
	$EOB

;THE RESPONSE-TO-SETUP MESSAGE FOR QUASAR
RSETUP:	$BUILD RSU.SZ
	$SET(.MSTYP,MS.TYP,.QORSU)	;RESPONSE TO SETUP
	$SET(.MSTYP,MS.CNT,RSU.SZ)	;MESSAGE SIZE
	$SET(RSU.TY,,.OTBIN)		;OBJECT TYPE
	$SET(RSU.CO,,%RSUOK)		;DUMMY SETUP CAN'T FAIL
	$EOB

DEFNOD:	BLOCK	1		;SETUP DEFAULT NODE
WTOOBJ:	$BUILD	OBJ.SZ
	$SET(OBJ.TY,,.OTRDR)		;SAY I'M A READER
	$EOB

TOPS10 <
MONPRT:	EXP	"."
RELX:	SIXBIT/REL/

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

TOPS20 <
MONPRT:	EXP	"@"
RELX:	XWD	-1,[ASCIZ /REL/]
>	;END OF TOPS20 CONDITIONAL ASSEMBLY



;TBLUK table generation macro

	DEFINE	TB(TEXT,FLAGS),<
	XWD	[ASCIZ/TEXT/],FLAGS
>
SUBTTL	Entry and Initialization


SPRINT:	RESET				;RESET THE WORLD
	MOVE	P,[IOWD A%PDSZ,L.PDL]

TOPS10	<
	PJOB	S1,0			;TURN OFF JACCT BIT
	MOVSS	S1			;BY DOING APPROPRIATE
	HRRI	S1,.GTPRG		;GETTAB/SETNAM UUO SEQUENCE.
	MOVE	S1,[SIXBIT /SPRINT/]	;GETTAB FAILED, BEST GUESS
	SETNAM	S1,0			;JACCT BIT TURNED OFF
>;END TOPS10 CONDITIONAL ASSEMBLY
TOPS20	<
	HRRZI	S1,.MSIIC		;BYPASS MOUNT COUNTS
	MSTR				;DO THE FUNCTION
	ERJMP	.+1			;IGNORE FOR NOW (INSUFFICIENT PRIVILEGES)
>;END TOPS20 CONDITIONAL ASSEMBLY

	MOVEI	S1,IB.SZ		;GET IB SIZE
	MOVEI	S2,SPTIB		;GET ADDRESS
	$CALL	I%INIT			;AND INITIALIZE THE WORLD
	$CALL	I%ION			;ENABLE FOR INTERRUPTS
	MOVEI	S1,LOWSIZ		;SIZE OF DATA AREA
	MOVEI	S2,LOWBEG		;BEGINNING ADR
	$CALL	.ZCHNK			;ZERO IT
TOPS10 <
	PJOB	T1,0			;GET JOB NUMBER
	LSH	T1,12			;*1024
	MSTIME	T2,			;SO RESTART DOESN'T RESET US
	ADD	T1,T2			;MAKE A FUNNY NUMBER
	HRRM	T1,L.FUN		;AND STORE IT
	MOVEI	T3,4			;WORDS -1 IN SYSNAM
	MOVSI	T1,.GTCNF		;CNFTBL
SPT1:	MOVS	T2,T1			;TABLE #,,INDEX
	GETTAB	T2,0			;GET NAME
	  SETZ	T2,0			;THIS REALLY SHOULDN'T HAPPEN
	MOVEM	T2,L.SYSN(T1)		;STORE IT AWAY
	CAILE	T3,(T1)			;GOT ALL FIVE?
	AOJA	T1,SPT1			;NO, LOOP AROUND

	MOVX	S1,%LDMFD		;GETTAB TO MFD PPN
	GETTAB	S1,0			;GET IT
	  MOVX	S1,<XWD	1,1>		;DEFAULT
	MOVEM	S1,L.MFPP		;SAVE IT

	SETOM	L.AIFN			;SAY ACCOUNTING FILES NOT OPEN
	SETOM	L.XIFN			;..
	MOVEI	T1,L.SL1		;BLOCK TO HOLD S/L
	PUSHJ	P,GETSRC		;GO GET THE SEARCH LIST
>  ;END TOPS10
TOPS20 <
	MOVNI	S1,5			;GET RUNTIME FOR ENTIRE JOB
	RUNTM				;GET IT
	MOVE	S2,S1			;SAVE IT
	GTAD				;GET TIME AND DATE
	ADD	S2,S1			;ADD THEM TOGETHER
	HRRM	S2,L.FUN		;AND SAVE THE SEED
	MOVX	S1,'SYSVER'		;GET TABLE # AND LENGTH FOR SYSTEM NAME
	SYSGT				;GET IT
	HLRE	T1,S2			;GET -VE LENGTH IN T1
	MOVN	T1,T1			;AND MAKE IT POSITIVE
	CAILE	T1,L.SLEN-1		;BE A LITTLE DEFENSIVE
	MOVEI	T1,L.SLEN-1		;..
	HRLZ	S2,S2			;GET TABLE#,,0
SPT1:	MOVS	S1,S2			;GET INDEX,,TABLE
	GETAB				;DO THE GETTAB
	  SETZ	S1,			;STORE A NULL ON FAILURE
	MOVEM	S1,L.SYSN(S2)		;STORE THE WORD
	CAILE	T1,(S2)			;DONE?
	AOJA	S2,SPT1			;NO, LOOP
>  ;END IFN FTJSYS

	MOVX	S1,HEL.SZ		;LOAD THE SIZE
	MOVEI	S2,HELLO		;LOAD THE ADR OF THE MSG
	PUSHJ	P,SNDQSR		;SEND THE MESSAGE
	JRST	IDLE			;AND GO INTO THE IDLE LOOP
SUBTTL	Job Setup and Idle Loop

IDLE:	MOVE	P,[IOWD A%PDSZ,L.PDL]	;RESET THE STACK
	MOVEI	S1,LOWZSZ		;SIZE OF AREA TO ZERO
	MOVEI	S2,LOWZER		;ADDRESS OF FIRST WORD
	$CALL	.ZCHNK			;ZERO THE AREA
	SETZ	F,0			;CLEAR FLAG REGISTER
	$CALL	C%BRCV			;RECEIVE A MESSAGE
	JUMPF	IDLE			;NOTHING THERE, LOOP
	MOVE	T3,S1			;SAVE MDB ADR AWAY
	LOAD	T1,MDB.SI(T3),SI.FLG	;GET SPECIAL INDEX FLAG
	JUMPE	T1,MSGREL		;NONE THERE, NOT FROM QUASAR
	LOAD	T1,MDB.SI(T3),SI.IDX	;YES, GET THE INDEX
	CAXE	T1,SP.QSR		;FROM QUASAR?
	JRST	MSGREL			;NO, IGNORE IT

	LOAD	T1,MDB.MS(T3),MD.ADR	;GET ADDRESS OF THE MESSAGE
	LOAD	T2,.MSTYP(T1),MS.TYP	;GET MESSAGE TYPE

	MOVSI	T3,-MSGNUM		;MAKE AOBJN POINTER
IDLE.1:	HLRZ	S1,MSGDSP(T3)		;GET MESSAGE CODE
	HRRZ	S2,MSGDSP(T3)		;GET DISPATCH ADDRESS
	CAMN	S1,T2			;A MATCH?
	JRST	(S2)			;YUP, SURE IS
	AOBJN	T3,IDLE.1		;LOOP THRU
$WTOJ(^I/ABTSPR/,<Unknown Message Received^M^JMessage Type-Code is ^O/T2/ -- Message ignored>,WTOOBJ)
MSGREL:	$CALL	C%REL
	JRST	IDLE			;GET BACK INTO MAIN STREAM
;Here to process the NEXTJOB message
IDLNEX:	PUSHJ	P,CLRFOB		;CLEAR THE FOB
	SETZM	FNDJOB			;CLEAR $JOB CARD FLAG
	LOAD	S1,.EQLEN(T1),EQ.LOH	;GET LENGTH OF HEADER
	ADD	S1,T1			;POINT TO THE FP
IDLN.1:	LOAD	S2,.FPINF(S1)		;TAKE COPY OF FPINF WORD
	MOVEM	S2,L.INF		;..
	TXNE	S2,FP.PCR		;IS IT A REAL READER
	JRST	IDLN.2			;YES..
	MOVX	T2,.OTBIN		;DEFAULT OBJECT TYPE
	STORE	T2,WTOOBJ+OBJ.TY	;STORE IT
	GETLIM	T2,.EQLIM(T1),ONOD	;OUTPUT NODE FIELD
	STORE	T2,WTOOBJ+OBJ.ND	;STORE IT
	SETZM	CDRDEV			;SET NOT REAL READER ../READER
	JRST	IDLN.3			;CONTINUE ON
IDLN.2:	MOVX	T2,.OTRDR		;NO
	STORE	T2,WTOOBJ+OBJ.TY	;STORE IT
	GETLIM	T2,.EQLIM(T1),CNOD	;GET THE NODE NAME
	STORE	T2,WTOOBJ+OBJ.ND	;STORE IT
	SETOM	CDRDEV			;SET REAL READER FLAG
IDLN.3:	LOAD	S2,L.INF,FP.RCF		;GET SPECIFIED RECORDING MODE
	CAXN	S2,.FPFAI		;AUGMENTED IMAGE?
	MOVE	T2,[XWD CPC,^D18]	;WIDTH,,BYTE SIZE
	CAXE	S2,.FPFAS		;FIXED OR STREAM ASCII?
	CAXN	S2,.FPFSA
	MOVE	T2,[XWD SMA,^D7]	;WIDTH,,BYTE SIZE
	SKIPG	T2			;ONE OF THE ABOVE?
	JRST	[
	$WTOJ(^I/ABTSPR/,<Unknown Recording Mode specified (^D/S2/)>)
	JRST	RELJOB]
	HLRZM	T2,L.DWID		;STORE DEFAULT WIDTH
	STORE	T2,L.FOB+FOB.CW,FB.BSZ	;AND SAVE IT
	LOAD	S2,.FPLEN(S1),FP.LEN	;GET FP SIZE
	ADD	S1,S2			;AND POINT TO THE FD
	MOVEM	S1,L.FOB+FOB.FD		;AND STORE AWAY
IDLN.4:	MOVSI	S1,(T1)			;TAKE COPY OF EQ
	HRRI	S1,L.EQCP		;..
	BLT	S1,L.EQCP+EQXSIZ-1
	SKIPN	CDRDEV			;PHYSICAL READER?
	JRST	IDLN.5			;NO
	MOVEI	S1,10			;SETUP TO
	MOVEI	S2,L.EQCP+.EQACT	;CLEAR ACCOUNT STRING
	$CALL	.ZCHNK			;..
IDLN.5:	MOVEI	S1,FOB.MZ		;LENGTH OF THE BLOCK
	MOVEI	S2,L.FOB		;AND THE ADDRESS
	$CALL	F%IOPN			;OPEN THE FILE
	JUMPF	RELJOB			;???
	MOVEM	S1,L.IFN		;SAVE THE IFN

	$CALL	C%REL			;RELEASE THE MESSAGE

MLTJOB:	MOVE	T1,[POINT 7,L.DMOD]	;GET THE DEFAULT MODE
	MOVEM	T1,L.DHOL		;SAVE AS DEFAULT
	PUSHJ	P,STRTJB		;START UP THE JOB
	JRST	MAIN			;AND GET INTO THE MAIN LOOP
;Here to respond to a SETUP message
IDLSUP:	LOAD	S1,SUP.UN(T1)		;GET THE OBJECT
	STORE	S1,RSETUP+RSU.UN	;AND STORE IT
	STORE	S1,WTOOBJ+OBJ.UN
	LOAD	S1,SUP.NO(T1)		;GET THE NODE NUMBER
	STORE	S1,RSETUP+RSU.NO	;AND STORE IT
	STORE	S1,WTOOBJ+OBJ.ND
	MOVEM	S1,DEFNOD		;SAVE THE DEFAULT NODE
	MOVEI	S1,RSU.SZ		;LOAD THE SIZE
	MOVEI	S2,RSETUP		;AND THE ADDRESS
	PUSHJ	P,SNDQSR		;SEND IT OFF TO QUASAR
	JRST	MSGREL			;REENTER IDLE LOOP

;Here on receipt of some TEXT message
IDLTXT:	$STOP	(UTM,<Unexpected text message received from QUASAR^M^J	^T/.OHDRS+ARG.DA(T1)/>)


;DISPATCH ON MESSAGE TYPE
MSGDSP:	XWD	.QOSUP,IDLSUP		;SETUP
	XWD	.QONEX,IDLNEX		;NEXTJOB
	XWD	.QORCK,MSGREL		;REQUEST FOR CHECKPOINT
	XWD	MT.TXT,IDLTXT		;TEXT
MSGNUM==.-MSGDSP			;COUNT
SUBTTL	Start up the job

;STRTJB is called to start up the job.  the "EQ" page is acquired
;       and   initialized,  the  logfile  gets  its  introductory
;       messages, The first card is scanned for $JOB and JOB card
;       processing is done.

STRTJB:	$CALL	M%GPAG			;GET A PAGE
	MOVE	Q,S1			;PUT IT IN AC "Q"
	HRLI	S1,L.EQCP		;COPY SAVED EQ TO CREATE MESSAGE
	BLT	S1,EQXSIZ-1(Q)		;..
	MOVX	S1,.QOCRE		;LOAD "CREATE" CODE
	STORE	S1,.MSTYP(Q),MS.TYP	;STORE IT
	MOVX	S1,EQXSIZ		;LENGTH OF HEADER
	STORE	S1,.EQLEN(Q),EQ.LOH	;AND STORE IT
	MOVX	S1,.OTBAT		;BATCH OBJECT TYPE
	STORE	S1,.EQROB+.ROBTY(Q)	;STORE IT IN THE EQ
	MOVX	S1,%%.QSR		;REQUEST VERSION NUMBER
	STORE	S1,.EQLEN(Q),EQ.VRS	;STORE IT
	MOVEI	S1,2			;NUMBER OF FILES IN REQUEST
	STORE	S1,.EQSPC(Q),EQ.NUM	;AND STORE IT
	PUSHJ	P,FUNNY			;GET A FUNNY 4 CHARS
	TLO	S1,'JB '		;MAKE A JOB NAME
	STORE	S1,.EQJBB+JIB.JN(Q)	;YES, USE FUNNY NAME
	ZERO	.EQSEQ(Q),EQ.NOT	;CLEAR NOTIFY
	SKIPE	CDRDEV			;PHYSICAL READER?
	JRST	STRT.1			;YES
TOPS10<	SETZB	S1,S2			;CLEAR BOTH ACS
	DMOVEM	S1,.EQOWN(Q) 		;NO., CLEAR OWNER FIELD
>;END TOPS10
	JRST	STRT.2			;ALL SET NOW
STRT.1:	MOVX	S1,EQLMSZ		;GET THE LIMIT WORD BLOCK SIZE
	MOVEI	S2,.EQLIM(Q)		;GET THE LIMIT WORD ADDRESS
	PUSHJ	P,.ZCHNK		;ZERO THE LIMIT WORD BLOCK

STRT.2:	$CALL	M%GPAG			;GET A PAGE
	MOVEM	S1,LOGPAG		;SAVE PAGE ADDRESS
	HRLI	S1,(POINT 7)		;MAKE A BYTE POINTER
	MOVEM	S1,LOGPTR		;SAVE IT
	MOVX	S1,PAGSIZ*5		;GET NUMBER OF BYTES ALLOWED
	MOVEM	S1,LOGCNT		;STORE IT
	$TEXT(LOGTXT,<^M^J^I/STDAT/SPRINT version ^V/[EXP %SPT]/ ^T/L.SYSN/>)

	MOVE	S1,L.IFN		;GET THE IFN
	SETO	S2,0
	$CALL	F%FD			;BUILD AN FD
	SKIPE	CDRDEV			;PHYSICAL READER
	$TEXT(LOGTXT,<^I/STMSG/[Job Input from ^B/WTOOBJ/]>)
	SKIPN	CDRDEV			;PHYSICAL READER?
	$TEXT(LOGTXT,<^I/STMSG/[Job Input from file ^F/(S1)/]>)
	$CALL	L%CLST			;CREATE A LINKED LIST
	MOVEM	S1,L.FBLN		;AND SAVE THE LIST NAME
	MOVE	S1,L.DWID		;LOAD DEFAULT WIDTH
	MOVEM	S1,L.WIDT		;STORE
	SKIPN	@L.DHOL			;SEE IF WE ALREADY HAVE A JOB CARD
STRT.3:	PUSHJ	P,S$NXTC		;READ THE JOB CARD
	MOVEI	S1,1			;LOAD CARD COUNT
	MOVEM	S1,CDRCNT		;SAVE IT
	ILDB	S1,B			;GET THE FIRST CHARACTER
	CAIE	S1,"$"			;IS IT A DOLLAR SIGN?
	JRST	STRT.3			;NOPE
	MOVEI	S1,L.TNAM		;POINT TO STRING BLOCK
	PUSHJ	P,S$ASCZ		;READ THE KEYWORD IN
	MOVEI	S1,[XWD 1,1
			XWD [ASCIZ/JOB/],0]
	HRROI	S2,L.TNAM		;POINT TO STRING
	$CALL	S%TBLK			;GOBBLE IT UP
	TXNE	S2,TL%NOM!TL%AMB	;MATCH?
	JRST	STRT.3			;NOPE, LOOP
	PJRST	JOBLIN			;GO PROCESS JOB CARD
SUBTTL	$JOB Card


JOBLIN:	SETOM	FNDJOB			;REMEMBER WE FOUND A JOB CARD
	HRL	S1,L.DHOL		;SAVE THE $JOB
	HRRI	S1,JOBCRD		;CARD AWAY
	BLT	S1,JOBCRD+SMA/5		;FOR LATER
	PUSHJ	P,S$FSPC		;SCAN OFF BLANKS
	JUMPF	ILLJOB			;EOL MEANS BAD CARD
	CAIN	C,"/"			;FIRST ITEM A SWITCH?
	SETOM	SYSIDP			;YUP, SET SYS INDEPENDENT FLAG
	PUSHJ	P,JOBOS			;GET OPERATING SYSTEM DEP PART
	MOVEI	S1,A%HLER		;DEFAULT FOR /ERR:HOL
	MOVEM	S1,L.UHOL		;STORE IT
	MOVEI	S1,A%CSER		;DEFAULT FOR /ERR:CHKSUM
	MOVEM	S1,L.UCHK
	MOVEI	S1,A%ICER		;DEFAULT FOR /ERRO:IBC
	MOVEM	S1,L.UIBC		;AND STORE IT
	MOVEI	T1,SW.JOB		;LOAD $JOB SWITCHES
	PUSHJ	P,DOSWCH		;DO THE SWITCHES
	PUSHJ	P,JOBVER		;VERIFY JOB DATA
	PUSHJ	P,DOACCT		;CHECK ACCOUNTING
	LOAD	S1,L.SEQ,EQ.SEQ		;LOAD STORED SEQ #
	LOAD	S2,.EQSEQ(Q),EQ.SEQ	;GET USER SPECIFIED
	SKIPN	S2
	STORE	S1,.EQSEQ(Q),EQ.SEQ
	PUSHJ	P,MAKCTL		;MAKE THE CTL FILE
	PUSHJ	P,MAKLOG		;MAKE A LOG FILE
	SETOM	L.JLOG			;JOB IS LOGGED IN
	$RET

ILLJOB:	$TEXT(LOGTXT,<^I/FATAL/?SPTIFJ  ^I/ILLJ.1/>)
	JSP	B,JOBCER
ILLJ.1:	ITEXT(<Improperly formatted $JOB Card>)
TOPS20 <
JOBOS:	GTAD				;GET CURRENT DATE AND TIME
	MOVEM	S1,L.DTM		;AND STORE IT
	MOVX	S1,.FHSLF		;LOAD FORK HANDLE
	RUNTM				;GET RUNTIME
	MOVNM	S1,L.RTM		;AND STORE IT
	MOVEI	S1,.EQOWN(Q)		;LOAD ADDRESS OF BLOCK
	SKIPE	SYSIDP			;SYSTEM INDEPENDENT JOB CARD?
	$RET				;YES, RETURN
	TXO	F,F.RSCN		;SET RESCAN FLAG
	PUSHJ	P,S$ASCZ		;NO, GET A STRING
	$RET				;RETURN
>;END OF TOPS20 CONDITIONAL ASSEMBLY

JOBVER:	SKIPN	SYSIDP			;SYS INDEPENENCE?
	$RET				;NO, NORMAL
TOPS20	<
	SKIPN	L.USER			;USER NAME SPECIFIED?
	JRST	ILLJOB			;NO BOMBOUT!
	MOVSI	S1,L.USER		;PREPARE TO MOVE /USER
	HRRI	S1,.EQOWN(Q)		;NAME SPECIFIED
	BLT	S1,.EQOWN+7(Q)		;TO THE OWNER BLOCK
>
TOPS10	<
	SKIPN	S1,L.PPN		;GET SPECIFIED PPN
	JRST	ILLJOB			;GOTTA HAVE IT
	MOVEM	S1,.EQOID(Q)		;STORE IT
	MOVE	S1,L.USER
	MOVEM	S1,.EQOWN(Q)
	MOVE	S1,L.USER+1
	MOVEM	S1,.EQOWN+1(Q)
>
	$RET				;AND RETURN


TOPS10 <
JOBOS:	$CALL	.SAVE1			;SAVE P1
	MOVX	T1,%CNDTM		;CURRENT DATE/TIME
	GETTAB	T1,0			;GET IT
	SETO	T1,0			;ERROR
	MOVEM	T1,L.DTM		;SAVE IT FOR ACCOUNTING PURPOSES
	SETZ	T1,0			;CLEAR AN AC
	RUNTIM	T1,0			;GET OUR RUNTIME
	MOVNM	T1,L.RTM		;SAVE IT FOR RUNTIME COMPUTATION
	SKIPE	SYSIDP			;SYSTEM INDEPENDENT JOB CARD?
	$RET				;YES, RETURN
	MOVE	P1,B			;SAVE CURRENT BYTE POINTER
	TXO	F,F.RSCN		;RE-EAT
$JOB.1:	PUSHJ	P,W$JOBN		;NO, GET JOB NAME
	PUSHJ	P,GETPPN		;TRY READING IN THE PPN
	JUMPT	$JOB.2			;GO PROCESS IF OK
	JUMPE	P1,NOPPN		;IF 2ND TIME, PUNT
	MOVE	B,P1			;RESET THE BYTE POINTER
	SETZ	P1,0			;AND CLEAR A FLAG
	ADDI	B,<EXP L.NMOD-L.DMOD>	;POINT TO THE OTHER MODE
	MOVE	T1,[POINT 7,L.NMOD]	;MAKE THIS THE DEFAULT
	MOVEM	T1,L.DHOL		;FOR THE REST OF THE JOB
	JRST	$JOB.1			;AND LOOP

$JOB.2:	MOVE	T1,L.PPN		;GET THE PPN
	MOVEM	T1,.EQOID(Q)		;RELOCATE
	$RET				;RETURN
>  ;END TOPS10
NOPPN:	$TEXT(LOGTXT,<^I/FATAL/?SPTMPP  ^I/NOPP.1/>)
	JSP	B,JOBCER			;AND ABORT THE JOB
NOPP.1:	ITEXT(<Missing Project-Programmer Number on $JOB card>)

IPPNF:	$TEXT(LOGTXT,<^I/FATAL/?SPTBFP  ^I/IPPN.1/>)
	JSP	B,JOBCER			;ABORT THE JOB
IPPN.1:	ITEXT(<Bad format for Project-Programmer Number on $JOB card>)


GETPPN:	CAIE	C," "			;WAS BREAK CHAR A SPACE?
	JRST	GETP.1			;NO, CHECK FOR PPN OPENER
	PUSHJ	P,S$FSPC		;YES, FLUSH LEADING SPACES
	  JUMPF	NOPPN			;EOL, NO PPN SPECIFIED

GETP.1:	CAIE	C,"["			;OPEN SQUARE BRACKET?
	CAIN	C,"<"			;NO, OPEN ANGLE BRACKET?
	JRST	GETP.2			;A MATCH!!
	CAIN	C,"("			;CHECK OPEN PAREN
	JRST	GETP.2			;WIN!
	$RETF				;LOSE
GETP.2:	PUSHJ	P,S$OCT			;GET PROJECT NUMBER
	JUMPF	.RETF			;???
	HRLZM	T1,L.PPN		;SAVE PROJECT NUMBER
	CAIE	C,","			;BREAK ON COMMA?
	JRST	IPPNF			;NO, BAD FORMAT
	PUSHJ	P,S$OCT			;GET PROGRAMMER NUMBER
	JUMPT	GETP.3			;GOT A NUMBER!
	CAIE	C,"#"			;IS IT A WILDCARD?
	$RETF				;NO, BAD FORMAT
	PUSHJ	P,CDRCHR		;SKIP TO NEXT CHARACTER
	MSTIME	T1,			;GET RANDOM NUMBER (RANDOM?)
	TXO	T1,1B18			;MAKE IT GT 400000
	TXZ	T1,1B19!1B20		;FOLLOW CONVENTION
GETP.3:	HRRM	T1,L.PPN		;SAVE PROGRAMMER NUMBER
	CAIE	C," "			;WAS BREAK CHARACTER A SPACE?
	JRST	GETP.4			;NO, LOOK FOR CLOSER
	PUSHJ	P,S$FSPC		;YES, FLUSH SPACES
	  JUMPF	.RETF			;BAD FORMAT FOR PPN
GETP.4:	CAIE	C,"]"			;CLOSE SQUARE BRACKET?
	CAIN	C,">"			;OR CLOSE ANGLE BRACKET
	$RETT				;YES, WIN!!
	CAIE	C,")"			;FINALLY, CLOSE PAREN
	$RETF				;NO!!!!
	$RETT				;YES, RETURN
SUBTTL	MAKCTL - Create the CTL File

MAKCTL:
TOPS10 <
	MOVEI	S1,FDXSIZ		;GET LENGTH
	MOVEI	S2,CLFFD		;GET ADDRESS
	$CALL	.ZCHNK			;ZERO THE BLOCK
	LOAD	S1,.EQJBB+JIB.JN(Q)	;GET JOB NAME
	STORE	S1,CLFFD+.FDNAM		;AND STORE IT
	MOVSI	S1,'CTL'		;GET EXTENSION
	STORE	S1,CLFFD+.FDEXT		;AND STORE IT
	MOVEI	S1,FDMSIZ		;GET MINIMUM FD SIZE
	STORE	S1,CLFFD+.FDLEN,FD.LEN	;AND STORE IT
>  ;END TOPS10

TOPS20 <
	MOVE	S1,[POINT 7,CLFFD+.FDSTG]
	MOVEM	S1,L.BP			;STORE IT AWAY
	$TEXT	(DEPBP,<^T/L.UDIR/^W/.EQJBB+JIB.JN(Q)/.CTL^0>)
	HRRZ	S1,L.BP			;GET BP ADDRESS
	SUBI	S1,CLFFD-1		;COMPUTE SIZE
	STORE	S1,CLFFD+.FDLEN,FD.LEN	;AND STORE IT
>  ;END IFN FTJSYS


	PUSHJ	P,CLRFOB		;CLEAR THE FOB OUT
	MOVEI	S1,CLFFD		;GET ADDRESS OF THE FD
	MOVEM	S1,L.FOB+FOB.FD		;AND STORE IT
	MOVEI	S1,7			;GET THE BYTE SIZE
	STORE	S1,L.FOB+FOB.CW,FB.BSZ	;AND STORE IT
	MOVX	S1,FOB.MZ		;GET THE LENGTH OF THE FOB
	MOVEI	S2,L.FOB		;AND ITS ADDRESS
	$CALL	F%OOPN			;AND OPEN THE FILE
	JUMPF	MAKC.1			;JUMP IF IT FAILED
	MOVEM	S1,CTLIFN		;SAVE THE IFN
	POPJ	P,			;AND RETURN

MAKC.1:	MOVE	P1,S1			;RELOCATE THE ERROR CODE
	$TEXT(LOGTXT,<^I/FATAL/?SPTECC  ^I/MAKC.2/>)
	JSP	B,PROCER
MAKC.2:	ITEXT(<Error creating BATCH control (CTL) file, ^E/P1/>)
SUBTTL	MAKLOG - Create the LOG File

MAKLOG:
TOPS10 <
	MOVEI	S1,FDXSIZ		;GET LENGTH
	MOVEI	S2,CLFFD		;GET ADDRESS
	$CALL	.ZCHNK			;ZERO THE BLOCK
	LOAD	S1,.EQJBB+JIB.JN(Q)	;GET JOB NAME
	STORE	S1,CLFFD+.FDNAM		;AND STORE IT
	MOVSI	S1,'LOG'		;GET EXTENSION
	STORE	S1,CLFFD+.FDEXT		;AND STORE IT
	MOVEI	S1,FDMSIZ		;GET MINIMUM FD SIZE
	STORE	S1,CLFFD+.FDLEN,FD.LEN	;AND STORE IT
	GETLIM	S1,.EQLIM(Q),BLOG	;GET /BATLOG ARGUMENT
	CAXE	S1,%BSPOL		;SPOOLING SPECIFIED?
	JRST	MAKL.4			;NO, SO WE'RE ALL SET
	PUSHJ	P,FUNNY			;GENERATE 4-CHAR FUNNY NAME
	TLO	S1,'BL '		;MAKE IT BL????
	MOVEM	S1,CLFFD+.FDNAM		;STORE AS UNIQUE FILENAME
	MOVX	S1,<XWD 3,3>		;SPECIFY SPOOLING AREA
	MOVEM	S1,CLFFD+.FDPPN		;STORE AS OUTPUT PPN
>  ;END TOPS10

TOPS20 <
	PUSHJ	P,FUNNY			;CREATE A RANDOM FILENAME
	TLO	S1,'BL '		;MAKE IT 'BLXXXX'
	MOVE	T1,S1			;RELOCATE
	MOVE	S1,[POINT 7,CLFFD+.FDSTG]
	MOVEM	S1,L.BP			;STORE THE POINTER
	GETLIM	S1,.EQLIM(Q),BLOG	;GET /BATCH-LOG ARGUMENT
	CAXN	S1,%BSPOL		;SPOOLED?
$TEXT(DEPBP,<PS:^7/[OCT 74]/SPOOL^7/[OCT 76]/SPR-^O/L.USNO,RHMASK/-^W/T1/.LOG^0>)
	CAXE	S1,%BSPOL
	$TEXT(DEPBP,<^T/L.UDIR/^W/.EQJBB+JIB.JN(Q)/.LOG^0>)
	HRRZ	S1,L.BP			;GET BP ADDRESS
	SUBI	S1,CLFFD-1		;AND COMPUTE LENGTH
	STORE	S1,CLFFD+.FDLEN,FD.LEN	;AND STORE IT
>  ;END IFN FTJSYS


MAKL.4:	PUSHJ	P,CLRFOB		;CLEAR OUT THE FOB
	MOVEI	S1,CLFFD		;GET ADDRESS OF THE FD
	MOVEM	S1,L.FOB+FOB.FD		;AND STORE IT
	MOVEI	S1,7			;GET THE BYTE SIZE
	STORE	S1,L.FOB+FOB.CW,FB.BSZ	;AND STORE IT
	MOVEI	S1,2			;GET THE LENGTH OF THE FOB
	MOVEI	S2,L.FOB		;AND ITS ADDRESS
	MOVEI	T2,F%AOPN		;ASSUME APPEND MODE
	GETLIM	T1,.EQLIM(Q),BLOG	;GET /BATCH-LOG ARGUMENT
	CAXN	T1,%BSCDE		;SPECIFY SUPERSEDE?
	MOVEI	T2,F%OOPN		;YUP, SO DOIT!
	PUSHJ	P,(T2)			;CALL APPROPRIATE OPEN ROUTINE
	JUMPF	MAKL.1			;JUMP IF IT FAILED
	MOVEM	S1,LOGIFN		;SAVE THE IFN

	MOVE	S1,LOGIFN		;GET THE IFN
	MOVX	S2,PAGSIZ*5		;GET MAXIMUM BYTE COUNT
	SUB	S2,LOGCNT		;GET NUMBER TO PRINT
	MOVE	T1,LOGPAG		;GET ADDRESS OF LOG PAGE
	HRLZ	S2,S2			;GET COUNT,,0
	HRR	S2,T1			;GET COUNT,,ADDRESS
	$CALL	F%OBUF			;OUTPUT THE BUFFER
	MOVE	S1,LOGPAG		;GET THE PAGE ADDRESS
	$CALL	M%RPAG			;RELEASE IT
	SETZM	LOGPAG			;CLEAR THE PAGE NUMBER
	POPJ	P,			;AND RETURN

MAKL.1:	SKIPN	.EQOID(Q)		;GO THRU NOJOB ALREADY?
	JRST	MAKL.3			;YES, NOW WE CAN DIE
	MOVE	P1,S1			;RELOCATE ERROR CODE
	$TEXT(LOGTXT,<^I/FATAL/?SPTECL  ^I/MAKL.2/>)
	JSP	B,PROCER
MAKL.2:	ITEXT(<Error creating BATCH LOG file, ^E/P1/>)

MAKL.3:	$STOP(CCL,Cannot create a LOG)
SUBTTL	Main Program Loop


;This loop is reached after  successfully  processing  $SEQUENCE,
;       $JOB, and $PASSWORD cards.

MAIN:	MOVE	B,L.DHOL		;LOAD A BYTE POINTER
	ILDB	T1,B			;AND GET COLUMN 1
	CAIE	T1,"$"			;CONTROL CARD?
	PJRST	MAIN.3			;NO, MUST BE AN ERROR

	ILDB	T1,B			;GET SECOND COLUMN
	CAIL	T1,"a"			;CONVERT LOWER CASE
	CAIL	T1,"z"			; TO UPPER
	SKIPA				; IF NECESSARY
	TRZ	T1,40			;CONVERT CASING
	CAIL	T1,"A"			;SEE IF SECOND LETTER IS ALPHABETIC
	CAILE	T1,"Z"			;BETWEEN A AND Z
	 JRST	MAIN.2			;NO, EITHER A COMMENT OR AN ERROR
	PUSHJ	P,CONTRL		;PROCESS CONTROL CARD
	JRST	MAIN			;NO, READ THE NEXT CARD

MAIN.2:	PUSHJ	P,LOGCRD		;LOG THE CARD
	CAIE	T1,"!"			;EXCLAIM?
TOPS10 <
	CAIN	T1,";"			;OR SEMI?
	SKIPA				;YES, IT'S A COMMENT
>  ;END TOPS10
	JRST	ILLCRD			;NO, IT'S AN ERROR
	MOVX	T1,<"!">B6		;LOAD AN EXCLAIM
	MOVX	T2,177B6		;LOAD A MASK
	ANDCAM	T2,L.CASC		;TURN OFF CHAR 1
	IORM	T1,L.CASC		;AND MAKE IT AN EXCLAIM
	$TEXT(TXTCTL,<^T/L.CASC/^A>)
	PUSHJ	P,CDRASC		;READ THE NEXT CARD
	JRST	MAIN			;AND LOOP AROUND

MAIN.3:	PUSHJ	P,LOGCRD		;OUTPUT THE CARD TO LOG
$TEXT (LOGTXT,<^I/FATAL/?SPTCNF	^I/MAIN.4/ - Card #^D/CDRCNT/>)
	JSP	B,CTLCER		;ABORT
MAIN.4:	ITEXT	(<Control Card not found when expected>)
SUBTTL	Control Cards  --  Setup and Dispatch


;CONTRL -- Routine to interpret and dispatch control cards
;
;CALL:
;	PUSHJ P,CONTRL
;	  RETURN HERE ALWAYS

CONTRL:	PUSHJ	P,$EOD			;CLOSE OUT FILE IN PROGRESS
	PUSHJ	P,W$DFMD		;SETUP DEFAULT HOLLERITH MODE
	PUSHJ	P,W$NODOLLAR		;RESET /NODOLLARS
	PUSHJ	P,W$LIST		;RESET /LIST
	$SUPPRESS <SETOM L.SPRS>
	$NOSUPPRESS <SETZM L.SPRS>
	MOVE	S1,L.DWID		;DEFAULT WIDTH
	STORE	S1,L.WIDT		;STORE IT
	PUSHJ	P,LOGCRD		;LOG THE CARD
	MOVE	B,L.DHOL		;GET THE BYTE POINTER
	IBP	B			;POINT PAST THE "$"
	TXZ	F,F.RSCN		;ALWAYS CLEAR RESCAN FLAG
	SETZM	L.BRK			;ALWAYS CLEAR BREAK FLAG
	MOVEI	S1,L.TNAM		;POINT TO BLOCK
	PUSHJ	P,S$ASCZ		;GATHER THE KEYWORD

	TXO	F,F.RSCN		;RESCAN THE BREAK LATER ON

	MOVEI	S1,TBCARD		;POINT TO TABLE
	HRROI	S2,L.TNAM		;POINT TO THIS KEYWORD
	$CALL	S%TBLK			;SEE IF WE KNOW ABOUT IT
	TXNE	S2,TL%NOM!TL%AMB	;DO WE?
	JRST	ILLCRD			;NO
	SUBI	S1,TBCARD+1		;COMPUTE INDEX
	MOVE	P1,CADRS(S1)		;GET DISPATCH ADDRESS
	TXNE	P1,CD.BTC		;THIS CARD NEED THE BATCH BIT?
	TXO	F,F.BTCH		;YES, TURN IT ON!
	TXNE	P1,CD.CLO		;CLEAR THE LOAD ORDER?
	PUSHJ	P,FBCLOD		;YUP!!
	PUSH	P,P1			;SAVE DISPATCH ADDRESS
	PUSHJ	P,(P1)			;DISPATCH TO CORRECT ROUTINE
	POP	P,P1			;RESTORE DISPATCH AC
	TXNE	P1,CD.RNC		;NEED TO READ NEXT CARD?
	PUSHJ	P,CDRASC		;YES, DO SO
	POPJ	P,0			;RETURN

ILLCRD:	$TEXT(LOGTXT,<^I/FATAL/?SPTICC  ^I/ILCMSG/  - card #^D/CDRCNT/>)
	JSP	B,CTLCER		;ABORT
ILCMSG:	ITEXT	(<Illegal control card>)
L.TNAM:	BLOCK	^D8		;ROOM FOR CONTROL CARD NAME
;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.RNC==1B2		;READ NEXT CARD
	CD.BTC==1B3		;THIS IS A SPECIAL BATCH CARD

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

DEFINE	CNAMES,<
	X	ALGOL,$ALGOL,CD.LAN
	X	BACKTO,$$BATCH,CD.BTC!CD.RNC!CD.BTC
	X	BLISS,$BLISS,CD.LAN
	X	CHKPNT,$$BATCH,CD.BTC!CD.RNC!CD.BTC
	X	COBOL,$COBOL,CD.LAN
	X	CREATE,$CREAT,0
	X	DATA,$DATA.,CD.BTC
TOPS10	<X	DECK,$DECK>
TOPS10	<X	DUMP,$DUMP,CD.BTC!CD.RNC>
	X	EOD,$EOD,CD.RNC
	X	EOJ,$EOJ
	X	ERROR,$$BATCH,CD.BTC!CD.RNC!CD.BTC
	X	EXECUTE,$EXECUTE,CD.BTC!CD.RNC
	X	FORTRAN,$FORTRAN,CD.LAN
	X	GOTO,$$BATCH,CD.BTC!CD.RNC!CD.BTC
	X	IF,$$IF,CD.BTC!CD.RNC
	X	INCLUDE,$INCLU,CD.CLO
	X	JOB,$JOB
	X	LABEL,$LABEL,CD.RNC!CD.BTC
	X	MACRO,$MACRO,CD.LAN
	X	MESSAGE,$MESS,CD.RNC
	X	NOERROR,$$BATCH,CD.BTC!CD.RNC!CD.BTC
	X	NOOPERATOR,$$BATCH,CD.BTC!CD.RNC!CD.BTC
	X	OPERATOR,$$BATCH,CD.BTC!CD.RNC!CD.BTC
	X	PASSWORD,$PASSW,CD.RNC
TOPS10	<X	RELOCATABLE,$RELOC,CD.CLO>
	X	REQUEUE,$$BATCH,CD.BTC!CD.RNC!CD.BTC
	X	REVIVE,$$BATCH,CD.BTC!CD.RNC!CD.BTC
	X	SEQUENCE,$SEQUE
	X	SILENCE,$$BATCH,CD.BTC!CD.RNC!CD.BTC
	X	SNOBOL,$SNOBOL,CD.LAN
	X	TOPS,$TOPNTV,CD.BTC
TOPS10	<X	TOPS10,$TOPNTV,CD.BTC>
TOPS10	<X	TOPS20,$TOPFGN,CD.BTC>
TOPS20	<X	TOPS10,$TOPFGN,CD.BTC>
TOPS20	<X	TOPS20,$TOPNTV,CD.BTC>
>  ;END DEF CNAMES
DEFINE X(A,B,C),<
	TB(A,0)>
TBCARD:	XWD	TB.SIZ,TB.SIZ
	CNAMES
	TB.SIZ==.-TBCARD-1
DEFINE	X(CARD,DISP,BITS<0>),<XALL
	EXP	DISP+BITS	; CARD
SALL>

CADRS:	CNAMES
;SWITCH TABLES

;VALID SWITCHES FOR ALL CARDS
;	Y	SWITCH NAME,DISPATCH ADR,VALID CARD FLAGS
;
;WHERE VALID CARD FLAGS ARE:
	SW.LAN==1B18		;LANGUAGE CARDS
	SW.DEC==1B20		;$DECK 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.MOD==1B28		;NON-ASCII MODE SPECIFIER

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

DEFINE SNAMES,<
	Y	026,SW.ALL!SW.MOD
	Y	ACCOUNT,SW.JOB
	Y	AFTER,SW.JOB
	Y	ASCII,SW.ALL!SW.MOD
	Y	ASSISTANCE,SW.JOB
TOPS20	<Y	<BATCH-LOG>,SW.JOB,BATCH>
TOPS10	<Y	BATLOG,SW.JOB,BATCH>
	Y	BCD,SW.ALL!SW.MOD
TOPS10	<Y	BINARY,SW.DEC!SW.DAT!SW.MOD>
	Y	CARDS,SW.JOB
TOPS10	<IFN INPCOR,<Y CORE,SW.JOB>>
	Y	CPUNCH,SW.DEC
	Y	CREF,SW.LAN
	Y	DEPEND,SW.JOB
	Y	DOLLARS,SW.ALL
	Y	ERRORS,SW.JOB!SW.MOD
	Y	FEET,SW.JOB
	Y	HOLLERITH,SW.JOB!SW.MOD
	Y	IMAGE,SW.DEC!SW.DAT!SW.MOD
	Y	JOBNAME,SW.JOB
	Y	LIST,SW.LAN
	Y	LOCATE,SW.JOB
	Y	LOGDISPOSITION,SW.JOB
	Y	MAP,SW.DAT!SW.EXE
TOPS10	<Y	NAME,SW.JOB>
	Y	NODOLLARS,SW.ALL
	Y	NOLIST,SW.LAN
	Y	NOMAP,SW.DAT!SW.EXE
	Y	NORESTARTABLE,SW.JOB
	Y	NOSUPPRESS,SW.ALL
	Y	OUTPUT,SW.JOB
	Y	PAGES,SW.JOB
TOPS10	<Y	PLOT,SW.DEC>
	Y	PPN,SW.JOB
	Y	PRINT,SW.DEC
	Y	PRIORITY,SW.JOB
TOPS10	<Y	PROTECT,SW.DEC>
	Y	RESTARTABLE,SW.JOB
	Y	SEARCH,SW.INC
	Y	SEQUENCE,SW.JOB
	Y	SUPPRESS,SW.ALL
	Y	TIME,SW.JOB
TOPS10	<Y	TPLOT,SW.JOB>
	Y	TPUNCH,SW.DEC
	Y	UNIQUE,SW.JOB
	Y	USER,SW.JOB
	Y	WIDTH,SW.ALL
>  ;END DEF SNAMES
DEFINE Y(A,B,C),<
	TB(A,0)
>

TBSWIT:	XWD	SW.SIZ,SW.SIZ
	SNAMES
	SW.SIZ==.-TBSWIT-1
	DEFINE	Y(A,B,C),<
	XALL
	IFB <C>,<XWD B,W$'A>
	IFNB <C>,<XWD B,W$'C>
	SALL>

;TABLE OF FORM:  XWD <VALID CARD FLAGS>,<DISPATCH ADDRESS>
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
;       definition is as follows:

;	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
	
TOPS10	<
	L	F40,F4 ,F40,R
>
	L	FORTRAN,FOR,FOR,R
>;END DEFINE LANGS
; Generate Entry Points

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

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

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

	K=0
LANCRD:	LANGS


;Now generate table of  Extension,,Compile switch

DEFINE L(A,B,C,D),<
TOPS10 <
	XWD	[SIXBIT /B/],<<SIXBIT /C/>_-^D18>
>  ;END TOPS10

TOPS20 <
	XWD	[XWD -1,[ASCII/B/]],<<SIXBIT /C/>_-^D18>
>;END OF TOPS20 CONDITIONAL ASSEMBLY
>;END DEFINE L

EXTTBL:	LANGS
$LANG:	MOVEM	T1,LANG.A		;SAVE THE INDEX
	MOVEI	S1,'LN'			;LOAD A PREFIX
	PUSHJ	P,MAKFUN		;AND MAKE A FUNNY NAME
	MOVE	T1,LANG.A		;GET THE INDEX BACK
	HLRZ	S2,EXTTBL(T1)		;GET ADR OF DEFAULT EXTENSION
	MOVE	S2,(S2)			;GET DEFAULT EXTENSION
	PUSHJ	P,S$FILE		;GET A FILESPEC

	MOVX	T1,FB.LDR!FB.DEL	;LOAD THE REL AND DELETE BOTH
	SKIPGE	LANG.A			;IS IT AN INTERPRETER?
	MOVX	T1,FB.DEL		;YES, JUST DELETE THE SOURCE
	SKIPE	FILSPC			;DID THE USER NAME IT?
	JRST	$LAN.1			;YES, HE SPECIFIED ONE
	PUSHJ	P,FILENT		;ENTER THE FILE
	JRST	$LAN.2			;MEET AT THE PASS

$LAN.1:	TXZ	T1,FB.DEL		;TURN OFF DELETE IF IT IS HIS
	PUSHJ	P,FBENT			;ENTER IT IN THE FILE-BLOCKS

$LAN.2:	HRRZ	T1,LANG.A		;GET LANGUAGE INDEX
$TEXT(TXTCTL,<^7/MONPRT/COMPILE /COMPILE/^W/EXTTBL(T1),RHMASK/ ^F/FILFD/^A>)

	PUSHJ	P,S$FSPC		;AND FLUSH LEADING SPACES
	JUMPF	$LAN.4			;EOL, GO SEND LISTING SWITCH
TOPS10 <
	CAIE	C,"("			;BEGINNING OF PROCESSOR SWITCH?
	JRST	$LAN.3			;NO, CHECK FOR SPRINT SWITCHES
	MOVEI	S1,"("			;LOAD AN OPEN PAREN
	PUSHJ	P,TXTCTL		;AND PRINT IT

	MOVEI	T1,")"			;LOAD THE BREAK CHARACTER
	PUSHJ	P,CTLCRD		;GO TRANSFER FROM CARD TO CTL
	MOVEI	S1,")"			;LOAD A CLOSE PAREN
	PUSHJ	P,TXTCTL		;AND PRINT IT
> ;END OF TOPS10 CONDITIONAL ASSEMBLY


$LAN.3:	MOVX	T1,SW.LAN		;VALID SWITCHES FOR LANG CARD
	PUSHJ	P,DOSWCH		;DO THE SWITCHES
$LAN.4:	$TEXT(TXTCTL,<^W/L.LSW/>)	;PRINT THE /LIST SWITCH
	SKIPN	FILSPC			;EXPLICIT FILENAME GIVEN?
	PJRST	@L.MODE			;NO, GO STACK THE DECK
	PUSHJ	P,CDRASC		;YES, READ NEXT CARD
	POPJ	P,0			;RETURN TO MAIN STREAM


LANG.A:	BLOCK	1			;SAVE LANGUAGE INDEX
SUBTTL	Control Cards  --  $DECK - $CREATE

$CREAT:	MOVEI	S1,'CR'			;GET THE PREFIX
	PUSHJ	P,MAKFUN		;MAKE A NAME
	JRST	$DEC.1			;AND SKIP ALTERNATE ENTRY

$DECK:	MOVEI	S1,'DK'			;GET THE PREFIX
	PUSHJ	P,MAKFUN		;MAKE A NAME
$DEC.1:	SETZ	S2,0			;NO EXTENSION
	PUSHJ	P,S$FILE		;GET A FILESPEC

	MOVX	T1,SW.DEC		;LEGAL SWITCHES
	PUSHJ	P,DOSWCH		;DO THE SWITCHES
	SETZ	T1,0			;NOTHING TO REMEMBER
	PUSHJ	P,FILENT		;ENTER THE FILE
	PJRST	@L.MODE			;AND GO STACK THE DECK
SUBTTL	Control Cards  --  $RELOC

TOPS10	<
$RELOC:	LOAD	S1,L.INF,FP.PCR		;GET JOB INFO
	JUMPE	S1,$REL.1		;TEST LEGALITY
	MOVEI	S1,'RL'			;LOAD A PREFIX
	PUSHJ	P,MAKFUN		;MAKE A FUNNY NAME
	MOVE	S2,RELX			;GET DEFAULT EXTENSION
	PUSHJ	P,S$FILE		;AND GET A FILESPEC
	PUSHJ	P,W$BINA		;FORCE A /BINARY
	MOVX	T1,FB.LOD		;LOAD ON NEXT $DATA OR $EXEC
	SKIPN	FILSPC			;IS IT USER-NAMED?
	TXO	T1,FB.DEL		;NO, DELETE AT THE END
	PUSHJ	P,FILENT		;ENTER THE FILE
	PJRST	@L.MODE			;AND DO STACK THE DECK

COMMENT	\
Here to complain about the improper use of the $RELOC card.
	This card is allowed only when the job was submitted via
	cards. To allow it from disk based jobs, eg. via /READER,
	implies the need for mixed mode files.
\
$REL.1:	$TEXT(LOGTXT,<^I/FATAL/?SPTRCI	^I/$REL.2/>)
	JSP	B,CTLCER		;FULLY ABORT
$REL.2:	ITEXT	(<Improper use of $RELOC>)
>;END OF TOPS10 CONDITIONAL ASSEMBLY
SUBTTL	Control Cards  --  $INCLUDE

COMMENT	\
The $INCLUDE card allows for an optional filespec.
	The logic imposed is similar to the $language card
	in that if a filespec is supplied the routine
	assumes the file already exists on disk and simply
	enters the file into the file blocks.  If no
	filespec is supplied, the routine generates its own,
	enters it into the file blocks, and then goes off to
	stack the deck which presumably follows.
\



$INCLU:	MOVEI	S1,'BL'			;DEFAULT PREFIX
	PUSHJ	P,MAKFUN		;FORM 'BL????'
	MOVE	S2,RELX			;DEFAULT EXTENSION
	PUSHJ	P,S$FILE		;READ OUT THE FILESPEC
	SETZM	L.SRH			;CLEAR SEARCH FLAG
	MOVX	T1,SW.INC		;VALID SWITCHES FOR $INCLUDE
	PUSHJ	P,DOSWCH		;SCAN OFF ANY SWITCHES
	SETOM	L.FBCT			;SET LOAD FLAG
	MOVX	T1,FB.LOD!FB.DEL	;SET LOAD AND DELETE BITS
	SKIPE	L.SRH			;DID HE SPECIFY /SEARCH?
	TXO	T1,FB.SRH		;SURE DID..
	SKIPE	FILSPC			;DID HE SPECIFY ANY FILESPEC?
	JRST	$INC.1			;YES
	LOAD	S1,L.INF,FP.PCR		;GET JOB INFO
	JUMPE	S1,$INC.E		;JUMP IF DECK DIDN'T COME FROM READER
	PUSHJ	P,FILENT		;NO, GO ENTER WITH FORMED FILESPEC
	PUSHJ	P,W$BINA		;FORCE A /BINARY FOR THE UPCOMING CARDS
	PJRST	@L.MODE			;GO STACK THE DECK

$INC.1:	TXZ	T1,FB.DEL		;CLEAR THE DELETE BIT
	PUSHJ	P,FBENT			;AND ENTER INTO THE FILE BLOCKS
	PUSHJ	P,CDRASC		;READ THE NEXT CARD
	$RETT				;RETURN

COMMENT	\
Here to complain about the improper use of the $INCLUDE
card.  This card is allowed only when the job was submitted
via cards. To allow it from disk based jobs, eg. via
/READER, implies the need for mixed mode files.
\
$INC.E:	$TEXT(LOGTXT,<^I/FATAL/?SPTIUI  ^I/$INC.F/>)
	JSP	B,CTLCER
$INC.F:	ITEXT (<Improper use of $INCLUDE>)
SUBTTL	Control Cards  --  $DATA - $EXECUTE

TOPS10 <
$DATA.:	MOVE	S1,[XWD FILFD,FILFD+1]	;SETUP A BLT POINTER
	SETZM	FILFD			;ZERO THE FIRST WORD
	BLT	S1,FILFD+FDXSIZ-1	;AND ZERO THE REST
	MOVSI	S1,'DSK'		;LOAD DEFAULT DEVICE
	STORE	S1,FILFD+.FDSTR		;STORE IT
	PUSHJ	P,FUNNY			;GET A FUNNY NAME
	HRLZM	S1,FILFD+.FDNAM		;SAVE 3 CHARACTER NAME
	MOVSI	S1,'CDR'		;DEFAULT EXTENSION IS CDR
	MOVEM	S1,FILFD+.FDEXT		;SAVE IT
	LOAD	S1,.EQOID(Q)		;GET OUR PPN
	STORE	S1,FILFD+.FDPPN		;AND STORE IT
	MOVX	S1,FDMSIZ		;GET MINIMUM SIZE
	STORE	S1,FILFD+.FDLEN,FD.LEN 	;AND STORE IT
	$TEXT(TXTCTL,<.SET CDR ^W/FILFD+.FDNAM,LHMASK/>)
>  ;END TOPS10

TOPS20 <
$DATA.:	SKIPE	.EQSIS(Q)		;GENERATE A NAME ALREADY?
	JRST	$DAT.1			;YES, CONTINUE ON
	PUSHJ	P,FUNNY			;NO, GET 4 FUNNY CHARS
	TLO	S1,'CD '		;MAKE IT CD????
	MOVEM	S1,.EQSIS(Q)		;SAVE IN CORRECT PLACE
$DAT.1:	MOVE	S1,[POINT 7,FILFD+.FDFIL]
	MOVEM	S1,L.BP			;SETUP BYTE POINTER
$TEXT(DEPBP,<PS:^7/[OCT 74]/SPOOL^7/[OCT 76]/CDR-^O/L.USNO,RHMASK/.^W/.EQSIS(Q)/^0>)
	MOVX	S1,FDXSIZ		;USE MAXIMUM SIZE
	STORE	S1,FILFD+.FDLEN,FD.LEN	;AND STORE IT
$TEXT(TXTCTL,<@SET CARD-READER-INPUT-SET (TO) ^W/.EQSIS(Q)/>)
>;END IFN FTJSYS

	MOVX	T1,SW.DAT		;LEGAL SWITCHES
	PUSHJ	P,DOSWCH		;DO THE SWITCHES

	TOPS20	<
	SETZB	T1,FILSPC		;CLEAR FLAGS 
	PUSHJ	P,FRCENT		;ENTER THE FILE INVOKING OUR PRIVILEGES
>;END TOPS20 CONDITIONAL ASSEMBLY

	TOPS10	<
	SETZM	FILSPC			;CLEAR FLAGS
	MOVX	T1,FB.DEL		;GET DELETE BIT
	PUSHJ	P,FILENT		;ENTER IT
>

	PUSHJ	P,EXECUT		;PUT IN THE EXECUTE LINE
	PJRST	@L.MODE			;AND DO THE STACKING


$EXECUTE:
	MOVX	T1,SW.EXE		;LEGAL SWITCHES
	PUSHJ	P,DOSWCH		;GET ANY SWITCHES
	PJRST	EXECUT			;AND GO PUT IN EXECUTE LINE
;Here  the $DATA and $EXECUTE cards merge to generate the EXECUTE
;       command in the control file.

EXECUT:	SKIPE	L.FBCT			;ANYTHING TO LOAD?
	JRST	EXEC.1			;YES, CONTINUE ON
	$TEXT(LOGTXT,<^I/STERR/%SPTNFT  No files to load>)
	POPJ	P,			;AND RETURN

EXEC.1:	SETOM	L.LOAD			;FLAG THAT WE ARE DOING A LOAD
	MOVEI	T1,[ASCIZ / /]		;POINT TO A BLANK
	TXZE	F,F.MAP			;DOES HE WANT A MAP?
	MOVEI	T1,[ASCIZ %/MAP:LPT:MAP %]
	$TEXT(TXTCTL,<^7/MONPRT/EXECUTE^T/0(T1)/^A>)
	MOVE	S1,L.FBLN		;GET THE LIST NAME
	$CALL	L%FIRST			;POSITION TO THE BEGINNING
	SKIPT				;SKIP IF OK
	$STOP(CFF,CAN'T FIND FILES TO LOAD)

	SETZ	T2,0			;FLAG NO FILESPECS TYPED
	JRST	EXEC.3			;ENTER LOOP WITH FIRST FILESPEC
EXEC.2:	MOVE	S1,L.FBLN		;GET LIST NAME
	$CALL	L%NEXT			;GET NEXT FILESPEC
	JUMPF	CTLEOL			
EXEC.3:	LOAD	T1,.FBFLG(S2)		;GET THE FILE FLAGS
	TXNN	T1,FB.LOD		;LOADABLE?
	JRST	EXEC.2			;NO, TRY THE NEXT
	SKIPE	T2			;TYPED SPEC YET?
	$TEXT	(TXTCTL,<,^A>)		;YUP, SO TYPE A COMMA
	$TEXT(TXTCTL,<^F/.FBFD(S2)/^A>)	;NO, JUST LOAD THE FILE
	TXNE	T1,FB.SRH		;LOAD IN LIBRARY SEARCH MODE?
	$TEXT(TXTCTL,</SEARCH^A>)	;YES
	SETO	T2,0			;SET FILE TYPED FLAG
	JRST	EXEC.2			;LOOP
SUBTTL	Control Cards  --  $DUMP - $MESSAGE

$DUMP:	HRROS	L.DPCR			;AND FLAG DUMP LINE NEEDED
	POPJ	P,			;AND RETURN


$PASSW:$TEXT(LOGTXT,<^I/STERR/%SPTEPF  Extra $PASSWORD card found - ignored>)
	POPJ	P,			;AND RETURN


$MESS:	SETZ	P1,0			;CLEAR WAIT-NOWAIT FLAG
	PUSHJ	P,S$FSPC		;IGNORE BLANKS
	TXZ	F,F.RSCN		;AND TURN OFF THE RESCAN BIT
	CAIE	C,"/"			;IS THERE A COMMAND SWITCH?
	JRST	$MES.1			;NO, NOWAIT IS DEFAULT
	MOVEI	S1,SWNAME		;POINT TO STRING BLOCK
	PUSHJ	P,S$ASCZ		;READ THE KEYWORD IN
	MOVEI	S1,$MES.3-1		;POINT TO THE TABLE
	HRROI	S2,SWNAME		;AND THE SPECIFIED KEYWORD
	$CALL	S%TBLK			;SEE IF IT'S THERE
	TXNE	S2,TL%NOM!TL%AMB	;MATCH?
	JRST	$MES.2			;NOPE, LOOP
	HRRZ	P1,(S1)			;GET ARGUMENT

$MES.1:	$TEXT(TXTCTL,<^7/MONPRT/PLEASE ^A>)
	SETZ	T1,0			;BREAK ON EOL
	PUSHJ	P,CTLCRD		;COPY THE REST OF THE CARD
	MOVEI	S1,.CHESC		;LOAD AN ESCAPE
	SKIPN	P1			;IS IT NOWAIT?
	PUSHJ	P,TXTCTL		;YES, PUT IN THE ESCAPE
	PJRST	CTLEOL			;PUT ON CRLF AND RETURN

$MES.2:	$TEXT(LOGTXT,<%SPTIMS  Illegal $MESSAGE switch, /NOWAIT assumed>)
	JRST	$MES.1			;AND CONTINUE ON

	XWD 2,2
$MES.3:	TB(NOWAIT,0)
	TB(WAIT,1)

SWNAME:	BLOCK	^D8			;ROOM FOR THE SWITCH
SUBTTL	Control Cards  --  BATCH Commands

;		$ERROR - $NOERROR - $IF
;		$BACKTO - $CHKPNT - $GOTO
;		$NOOPERATOR - $OPERATOR - $REQUEUE
;		$REVIVE - $SILENCE
;
;These commands are BATCH commands.   They  are  copied  directly
;       into  the  control  file  with  the  "$"  changed  to the
;       appropriate monitor prompt character.

$$BATCH:MOVE	S1,MONPRT		;GET THE MONITOR PROMPT
	ROT	S1,-7			;PUT IT IN BITS 1 THRU 6
	MOVX	S2,177B6		;MAKE A MASK FOR 1ST CHARACTER
	ANDCAM	S2,L.CASC		;MASK OUT THE FIRST CHARACTER
	IORM	S1,L.CASC		;AND MAKE IT WHAT WE WANT
	$TEXT(TXTCTL,<^T/L.CASC/^A>)
	POPJ	P,			;AND RETURN

$LABEL:	PUSHJ	P,S$FSPC		;STRIP BLANKS
	JUMPF	$LAB.1			;IF EOL, LOSE
	TXO	F,F.RSCN		;REREAD LAST CHARACTER
	MOVEI	S1,LABADR		;WHERE TO STORE ASCII LABEL
	PUSHJ	P,S$ASCZ		;READ IT
	$TEXT	(TXTCTL,<^T/LABADR/::>)	;WRITE LABEL INTO CTL FILE
	$RET				;AND SIMPLY RETURN
$LAB.1:	$TEXT	(LOGTXT,<^I/STERR/?SPTNLS  ^I/$LAB.2/>)
	JSP	B,CTLCER
$LAB.2:	ITEXT	(<No label specified on $LABEL Control Card>)

$$IF:	PUSHJ	P,S$FSPC		;IGNORE BLANKS
	SKIPF
	CAIE	C,"("			;PROPER DELIMITER?
	JRST	$$IF.1			;NO, FAIL
	MOVEI	S1,AR.NAM		;POINT TO ARGUMENT BLOCK
	PUSHJ	P,S$ASCZ		;GATHER THE ARGUMENT
	MOVEI	S1,$IF.A-1		;POINT TO ARG TABLE
	HRROI	S2,AR.NAM		;POINT TO STRING AGAIN
	$CALL	S%TBLK			;TRY FOR A MATCH
	CAIN	C,")"			;PROPER TERMINATOR?
	TXNE	S2,TL%NOM!TL%AMB	;VALID ARGUMENT?
	JRST	$$IF.3			;NO
	PUSHJ	P,S$FSPC		;SKIP OVER BLANKS
	JUMPF	$$IF.1			;??
	CAIE	C,"$"			;IS IT A BUCK?
	JRST	$$BATCH			;NO, NO HELP HERE
	MOVE	C,MONPRT		;YES, CONVERT TO SYSTEM PROMPT
	DPB	C,B			;PLANT IN PLACE

	MOVEI	S1,L.TNAM		;POINT TO STRING BLOCK
	PUSHJ	P,S$ASCZ		;SEE IF WE KNOW ABOUT THIS GUY

	MOVEI	S1,TBCARD		;POINT TO TABLE
	HRROI	S2,L.TNAM		;POINT TO THIS KEYWORD
	$CALL	S%TBLK			;SEE IF WE KNOW ABOUT IT
	TXNE	S2,TL%NOM!TL%AMB	;DO WE?
	JRST	$$IF.1			;NO
	SUBI	S1,TBCARD+1		;COMPUTE OFFSET
	MOVE	T1,S1			;RELOCATE
	MOVE	P1,CADRS(T1)		;GET DISPATCH ADDRESS
	TXNN	P1,CD.BTC		;SPECIAL BATCH CONTROL CARD?
	JRST	$$IF.1			;NO, LOSE
	JRST	$$BATCH			;GOOD, GO WRITE IT OUT

$$IF.1:	$TEXT	(LOGTXT,<^I/STERR/?SPTIMF  ^I/$$IF.2/>)
	JSP	B,CTLCER
$$IF.2:	ITEXT	(<Improper format for $IF control card>)

$$IF.3:	$TEXT(LOGTXT,<^I/STERR/?SPTIIC  ^I/$$IF.4/>)
	JSP	B,CTLCER
$$IF.4:	ITEXT(<Improper conditional in IF statement>)

	XWD	2,2
$IF.A:	TB	(ERROR,0)
	TB	(NOERROR,1)
SUBTTL	Control Cards  --  $EOD

$EOD:	MOVE	T1,L.DHOL		;LOAD THE DEFAULT BP
	MOVEM	T1,L.CHOL		;AND SAVE FOR THE NEXT CARD
	SKIPN	FILOPN			;IS THERE A DECK OPEN?
	POPJ	P,			;NO, SKIP BACK

	SETZM	FILOPN			;AND ZERO IT
	MOVE	S1,FILIFN		;GET THE IFN
	$CALL	F%REL			;AND RELEASE THE FILE
$TEXT(LOGTXT,<^I/STMSG/File ^F/FILFD/ created - ^D/DEKCRD/ cards read>)
	SKIPE	L.QFN			;NEED TO QUEUE THE FILE?
	PUSHJ	P,QUEFIL		;YES, DO IT
	POPJ	P,			;AND RETURN SUCCESS

SUBTTL	Control Cards  --  $JOB
SUBTTL	Control Cards  --  $EOJ

$JOB:
$EOJ:	PUSHJ	P,TRMJOB		;FINISH UP WITH THIS JOB
	MOVE	P,[IOWD A%PDSZ,L.PDL]	;RESET STACK
	MOVEI	S1,LOWZSZ		;CLEAR OUT IMPURE JOB DATA
	MOVEI	S2,LOWZER		;..
	$CALL	.ZCHNK
	SETZ	F,0			;CLEAR OUT FLAGS
	JRST	MLTJOB			;TRY REENTRY


SUBTTL	Control Cards  --  $SEQUENCE

$SEQUE:	PUSHJ	P,S$DEC			;GET DECIMAL SEQUENCE NUMBER
	SKIPT				;SKIP IF OK
	SETZ	T1,0			;ELSE LOAD A ZERO
	STORE	T1,.EQJBB+JIB.SQ(Q),EQ.SEQ
					;AND STORE THE SEQUENCE NUMBER
	SKIPN	T1			;WAS IT 0?
$TEXT(LOGTXT,<^I/STERR/%SPTISN  Illegal sequence number on $SEQUENCE card ignored>)
	POPJ	P,0			;RETURN
SUBTTL	Control Cards  --  $TOPS10 - $TOPS20

$TOPNTV: TDZA	T1,T1			;CLEAR FLAG FOR NATIVE MODE ENTRY
$TOPFGN: SETO	T1,0			;SET FOR "FOREIGN" MODE
	MOVEM	T1,REVDSP		;STORE
	MOVX	T1,SW.TOP		;VALID SWITCH BITS
	PUSHJ	P,DOSWCH		;DO THE SWITCHES

$TOP.1:	PUSHJ	P,CDRASC		;GET A CARD
	MOVE	B,L.CHOL		;GET THE BYTE POINTER
	ILDB	T1,B			;GET COLUMN 1
	CAIE	T1,"$"			;DOLLAR SIGN?
	JRST	$TOP.2			;NO, JUST WRITE IT OUT

	ILDB	T1,B			;GET COLUMN 2
	CAIL	T1,"a"			;CONVERT LOWER CASE
	CAIL	T1,"z"			; TO UPPER
	SKIPA				; IF NECESSARY
	TRZ	T1,40			;CONVERT CASING
	CAIL	T1,"A"			;CHECK FOR AN ALPHABETIC
	CAILE	T1,"Z"
	JRST	$TOP.2			;ITS NOT, JUST WRITE THE CARD
	JRST	$TOP.3			;IT IS, CHECK A FEW OTHER THINGS


$TOP.2:	SKIPE	REVDSP			;NATIVE MODE?
	JRST	$TOP.1			;NO, IGNORE THIS
	MOVE	S1,CTLIFN		;GET THE IFN
	HRL	S2,L.CLEN		;GET CURRENT LENGTH
	SKIPE	L.SPRS			;SUPPRESS ON?
	HRL	S2,L.CSUP		;YES, GET SUPPRESSED LENGTH
	HRR	S2,L.CHOL		;POINT TO THE CORRECT CARD
	$CALL	F%OBUF			;OUTPUT IT
	PUSHJ	P,CTLEOL		;AND PUT OUT AN EOL
	JRST	$TOP.1			;AND LOOP AROUND

$TOP.3:	TXNN	F,F.DOLR		;ARE WE STACKING /DOL?
	$RET				;NO, $<ALPHA> STOPS US THEN
	MOVEI	S1,AR.NAM		;POINT TO STRING BLOCK
	PUSHJ	P,S$ASCZ		;READ IN THE KEYWORD
	SKIPN	AR.NAM			;TEST FOR NULL
	JRST	$TOP.2			;IT'S NULL, JUST DUMP IT OUT
	MOVEI	S1,CTLCOD-1		;POINT TO TABLE
	HRROI	S2,AR.NAM		;POINT TO KEYWORD GATHERED
	$CALL	S%TBLK			;DO THE WORK
	TXNE	S2,TL%NOM!TL%AMB	;MATCH?
	JRST	$TOP.2			;NO, DUMP IT OUT
	$RET				;YES, RETURN

	XWD	3,3
CTLCOD:	TB(EOD,0)
	TB(EOJ,0)
	TB(JOB,0)
SUBTTL	$JOB Card Switch Subroutines


;/CARDS
W$CARD:	JSP	T1,SWTDEC		;HANDLE DECIMAL SWITCH VALUE
	XWD	0,777777		;MIN,MAX
	STOLIM	T1,.EQLIM(Q),SCDP	;INSTRUCTION TO STORE THE RESULTS

;/DEPEND
W$DEPE:	JSP	T1,SWTDEC		;DECIMAL VALUE
	XWD	0,177777		;MIN,MAX
	STOLIM	T1,.EQLIM(Q),DEPN	;INSTRUCTION TO STORE THE RESULTS

;/FEET
W$FEET:	JSP	T1,SWTDEC		;DECIMAL ARGUMENT
	XWD	0,777777		;MIN,MAX
	STOLIM	T1,.EQLIM(Q),SPTP	;INSTRUCTION TO STORE THE RESULTS

;/LOCATE
W$LOCA:	JSP	T1,SWTOCT		;HANDLE OCTAL SWITCH VALUE
	XWD	1,77			;MIN,MAX
	STOLIM	T1,.EQLIM(Q),ONOD	;INSTRUCTION TO STORE THE NODE NUMBER

;/PAGES
W$PAGE:	JSP	T1,SWTDEC		;DECIMAL ARGUMENT
	XWD	0,777777		;MIN,MAX
	STOLIM	T1,.EQLIM(Q),SLPT	;INSTRUCTION TO STORE THE RESULTS

;/JOBNAME
W$JOBN:	MOVEI	S1,AR.NAM		;POINT TO STORAGE
	PUSHJ	P,S$ASCZ		;READ IT IN
	HRROI	S1,AR.NAM		;POINT TO IT AGAIN
	$CALL	S%SIXB			;SIXBITIZE IT
	SKIPN	S2			;HAVE A NAME?
	$RETF				;NO..RETURN FALSE
	STORE	S2,.EQJBB+JIB.JN(Q)	;STORE THE JOBNAME
	$RETT				;AND RETURN

;/USER:USERNAME
W$USER:
TOPS20<
	MOVEI	S1,L.USER		;POINT TO TEMP. AREA
	PUSHJ	P,S$ASCZ		;LOAD THE STRING
>
TOPS10<
	MOVEI	S1,L.USER		;POINT TO TEMP. AREA
	PUSHJ	P,S$TENN		;GATHER SPECIFIED NAME
>
	$RETT				;RETURN

;/PPN:[PRJ,PRG]
W$PPN:	CAIN	C,":"			;COLON?
	PUSHJ	P,S$INCH		;GET THE BRACKET
	PUSHJ	P,GETPPN		;GO GET THE PPN
	$RETT				;RETURN
;/TIME
W$TIME:	PUSHJ	P,S$TIM			;GET A TIME-SPEC
	JUMPF	BADTAR			;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
	STOLIM	T1,.EQLIM(Q),TIME	;STORE AWAY
	$RETT


;/ERROR:CHK:IBC:HOL
W$ERRO:	PUSHJ	P,S$TIM			;GET WHAT LOOKS LIKE A TIME SPEC
	JUMPF	BADTAR			;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
	$RETT

BADTAR:	$TEXT	(LOGTXT,<^I/STERR/%SPTIAF  Illegal argument format on /^T/L.SNAM/ switch, ignored>)
	$RETT

;/HOLLERITH
W$HOLL:	MOVEI	S1,AR.NAM		;WHERE TO COPY THE STRING
	PUSHJ	P,S$ASCZ
	MOVEI	S1,W$HO.A-1		;POINT TO TABLE
	HRROI	S2,AR.NAM		;AND THE STRING
	$CALL	S%TBLK			;DO THE SEARCH
	TXNE	S2,TL%NOM!TL%AMB
	$RETF
	HRRZ	S1,(S1)			;GET THE ARGUMENT
	HRLI	S1,(POINT 7)		;MAKE IT COMPLETE BP
	STORE	S1,L.DHOL		;SAVE AS DEFAULT
	$RETT

	XWD	3,3
W$HO.A:	TB	(026,L.C026)
	TB	(ASCII,L.CASC)
	TB	(BCD,L.C026)

;/AFTER
W$AFTE:	PUSHJ	P,S$DATE		;GET A DATE TIME SPEC
	JUMPF	.RETF			;LOSE
	STORE	T1,.EQAFT(Q)		;STORE THE AFTER PARAM
	$RETT				;AND RETURN
TOPS10 <
;/NAME
W$NAME:	SETZM	.EQOWN(Q)		;CLEAR THE FIRST HALF
	SETZM	.EQOWN+1(Q)		; AND THE 2ND HALF OF THE USER NAME
	MOVE	T2,[POINT 6,.EQOWN(Q)]
	PUSHJ	P,S$FSPC		;FLUSH LEADING SPACES, AND LOAD CHAR
	JUMPF	.RETT			;JUST RETURN, EOL
	CAIE	C,42			;IS IT A DOUBLE QUOTE?
	CAIN	C,"'"			;OR A SINGLE QUOTE?
	  JRST	W$NA.3			;YES, GO GET QUOTED STRING
	JRST	W$NA.2			;JUMP INTO LOOP

W$NA.1:	PUSHJ	P,S$INCH		;GET A CHAR
	  JUMPF	.RETT			;EOL, RETURN
W$NA.2:	CAIN	C,"/"			;BEGINNING OF NEXT SWITCH
	$RETT				;YES, RETURN
	PUSHJ	P,W$NA.6		;DEPOSIT IT
	JRST	W$NA.1			;AND LOOP

;HERE ON A QUOTED STRING
W$NA.3:	MOVEM	C,SAVCHR		;SAVE QUOTE CHARACTER
W$NA.4:	PUSHJ	P,S$INCH		;GET A CHARACTER
	JUMPF	.RETT			;EOL, RETURN
	CAMN	C,SAVCHR		;IS IT A QUOTE?
	JRST	W$NA.5			;YES, GO COUNT IT
	PUSHJ	P,W$NA.6		;ELSE, DEPOSIT CHARACTER
	JRST	W$NA.4			;AND LOOP AROUND

W$NA.5:	PUSHJ	P,S$INCH		;GET NEXT CHARACTER
	JUMPF	.RETT			;EOL FINISHES US OFF
	CAME	C,SAVCHR		;IS IT A QUOTE?
	$RETT				;NO, WE DONE!!
	PUSHJ	P,W$NA.6		;YES!,PRINT A QUOTE
	JRST	W$NA.4			;AND LOOP AROUND

W$NA.6:	CAMN	T2,[XWD 600,.EQOWN+1(Q)];DONE?
	POPJ	P,0			;YES, NO-OP
	SUBI	C," "			;CONVERT TO 6BIT
	IDPB	C,T2			;DEPOSIT
	POPJ	P,0			;AND RETURN


IFN INPCOR,<
;/CORE
W$CORE:	PUSHJ	P,S$DEC			;GET DECIMAL ARGUMENT
	JUMPF	ILLSWA			;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:	STOLIM	T1,.EQLIM(Q),CORE	;STORE VALUE AWAY
	$RETT				;AND RETURN
>;END IFN INPCOR
>;END TOPS10
;/PRIO
W$PRIO:	JSP	T1,SWTDEC		;GET DECIMAL VALUE
	XWD	1,MXUPRI		;MIN,MAX
	STORE	T1,.EQSEQ(Q),EQ.PRI	;INSTR. TO STORE THE PRIORITY VALUE

;/RESTART
W$REST:	MOVX	T1,%EQRYE		;GET /REST:YES
	STOLIM	T1,.EQLIM(Q),REST	;AND STORE IT
	$RETT				;AND RETURN

;/NORESTART
W$NORE:	MOVX	T1,%EQRNO		;GET NOT-RESTART
	STOLIM	T1,.EQLIM(Q),REST	;STORE /RESTART VALUE
	$RETT				;AND RETURN

;/SEQUENCE
W$SEQU:	JSP	T1,SWTDEC		;GET DECIMAL ARGUMENT
	XWD	1,777777		;MIN,MAX
	STORE	T1,.EQSEQ(Q),EQ.SEQ	;INSTR. TO STORE THE SEQUENCE NUMBER

;/TPLOT
W$TPLO:	JSP	T1,SWTDEC		;GET DECIMAL ARGUMENT
	XWD	0,777777		;MIN,MAX
	STOLIM	T1,.EQLIM(Q),SPLT	;INSTR. TO STORE THE PLOTTER LIMITS

;/UNIQUE
W$UNIQ:	MOVEI	S1,AR.NAM		;WHERE TO COPY THE STRING
	PUSHJ	P,S$ASCZ
	MOVEI	S1,W$UN.A-1		;POINT TO TABLE
	HRROI	S2,AR.NAM		;AND THE STRING
	$CALL	S%TBLK			;DO THE SEARCH
	TXNE	S2,TL%NOM!TL%AMB
	$RETF
	HRRZ	S1,(S1)			;GET THE ARGUMENT
	STOLIM	S1,.EQLIM(Q),UNIQ
	$RETT

	XWD	5,5
W$UN.A:	TB	(0,0)
	TB	(1,1)
	TB	(2,2)
	TB	(NO,0)
	TB	(YES,1)
;/OUTPUT
W$OUTP:	MOVEI	S1,AR.NAM		;WHERE TO COPY THE STRING
	PUSHJ	P,S$ASCZ
	MOVEI	S1,W$OU.A-1		;POINT TO TABLE
	HRROI	S2,AR.NAM		;AND THE STRING
	$CALL	S%TBLK			;DO THE SEARCH
	TXNE	S2,TL%NOM!TL%AMB
	$RETF
	HRRZ	S1,(S1)			;GET THE ARGUMENT
	STOLIM	S1,.EQLIM(Q),OUTP
	$RETT

	XWD	4,4
W$OU.A:	TB	(ALWAYS,%EQOLG)
	TB	(ERRORS,%EQOLE)
	TB	(LOG,%EQOLG)
	TB	(NOLOG,%EQONL)
;	  DELETE
;/LOGDISP:KEEP
;	  PRESERVE
;Note that this switch(value) is not passed in the NEXTJOB message
;from QUASAR. The switch is only available on the JOB card and sets
;FP.DEL for the log file disposition.

W$LOGD:	MOVEI	S1,AR.NAM		;WHERE TO COPY THE STRING
	PUSHJ	P,S$ASCZ
	MOVEI	S1,W$LO.A-1		;POINT TO TABLE
	HRROI	S2,AR.NAM		;AND THE STRING
	$CALL	S%TBLK			;DO THE SEARCH
	TXNE	S2,TL%NOM!TL%AMB
	$RETF
	HRRZ	S1,(S1)			;GET THE ARGUMENT
	STORE	S1,L.LGDS		;STORE AS LOG DISPOSITION
	$RETT

	XWD	3,3
W$LO.A:	TB	(DELETE,1)
	TB	(KEEP,0)
	TB	(PRESERVE,0)

AR.NAM:	BLOCK	^D8		;ARGUMENT NAME


; /ACCOUNT:

W$ACCO:	MOVEI	S1,.EQACT(Q)		;POINT TO ACCT. BLOCK
	PUSHJ	P,S$ASCZ		;AND READ THE STRING INTO IT
	$RETT

;         YES
; /ASSIST:
;         NO
;
W$ASSI:	MOVEI	S1,AR.NAM		;WHERE TO COPY THE STRING
	PUSHJ	P,S$ASCZ
	MOVEI	S1,W$AS.A-1		;POINT TO TABLE
	HRROI	S2,AR.NAM		;AND THE STRING
	$CALL	S%TBLK			;DO THE SEARCH
	TXNE	S2,TL%NOM!TL%AMB
	$RETF
	HRRZ	S1,(S1)			;GET THE ARGUMENT
	STOLIM	S1,.EQLIM(Q),OINT
	$RETT

	XWD	2,2
W$AS.A:	TB	(NO,.OPINN)
	TB	(YES,.OPINY)

;        SUPERSEDE
; /BATLOG:APPEND
;        SPOOL

W$BATC:	MOVEI	S1,AR.NAM		;WHERE TO COPY THE STRING
	PUSHJ	P,S$ASCZ
	MOVEI	S1,W$BA.A-1		;POINT TO TABLE
	HRROI	S2,AR.NAM		;AND THE STRING
	$CALL	S%TBLK			;DO THE SEARCH
	TXNE	S2,TL%NOM!TL%AMB
	$RETF
	HRRZ	S1,(S1)			;GET THE ARGUMENT
	STOLIM	S1,.EQLIM(Q),BLOG
	$RETT

	XWD	3,3
W$BA.A:	TB	(APPEND,%BAPND)
	TB	(SPOOL,%BSPOL)
	TB	(SUPERSEDE,%BSCDE)
SUBTTL	Routines To Finish Off a Job

;ENDJOB is called when end-of-file is encountered on the input file.

ENDJOB:	SKIPE	L.JLOG			;SKIP IF JOB NOT LOGGED IN
	JRST	ENDJ.2			;IT WAS, CONTINUE ON
	SKIPE	FNDJOB			;DID WE FIND ANY $JOB CARDS?
	JRST	DONE			;YES, NO NEED TO COMPLAIN
	$TEXT(LOGTXT,<^I/FATAL/?SPTJNF  ^I/ENDJ.1/>)
	JSP	B,PROCER			;FINISH UP
ENDJ.1:	ITEXT(<$JOB card not found>)

ENDJ.2:	PUSHJ	P,TRMJOB		;FINISH UP THE JOB
	JRST	DONE			;AND RELEASE THE REQUEST


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

TRMJOB:	PUSHJ	P,$EOD			;END DECK IN PROGRESS IF ANY
	$TEXT(LOGTXT,<^I/STSUM/End of job encountered>)
	PUSHJ	P,SUMARY		;GIVE SUMMARY
	$TEXT(TXTCTL,<%FIN::>)
	MOVE	T1,L.DPCR		;GET DUMP AND CREF FLAGS
	SKIPGE	T1			;IS DUMP SIDE (LH) SET?
	$TEXT(TXTCTL,<^7/MONPRT/DUMP>)	;YES, SO ENTER DUMP COMMAND
	TRNE	T1,-1			;CREF?
	$TEXT(TXTCTL,<^7/MONPRT/CREF>)
	MOVEI	T1,FIL.LN		;NUMBER OF FILES PER LINE
	MOVE	S1,L.FBLN		;GET LIST NAME
	$CALL	L%FIRST			;POSITION TO THE BEGINNING
	JUMPF	TRMJ.3			;NOTHING THERE, DONE

TRMJ.1:	LOAD	T2,.FBFLG(S2),FB.DEL	;GET DELETE BIT
	JUMPE	T2,TRMJ.2		;JUMP IF NOT TO BE DELETED
	CAIN	T1,FIL.LN		;FIRST FILESPEC TYPED ON THIS LINE?
	$TEXT(TXTCTL,<^7/MONPRT/DELETE ^A>) ;YES, TYPE DELETE COMMAND
	CAIE	T1,FIL.LN		;INDICATE CONTINUATION IF
	$TEXT(TXTCTL,<,^A>)		;NOT THE FIRST
	$TEXT(TXTCTL,<^F/.FBFD(S2)/^A>)	;TYPE THE FILESPEC
	SOJG	T1,TRMJ.2		;JUMP IF ROOM FOR MORE
	PUSHJ	P,CTLEOL		;ELSE PUT IN A CRLF
	MOVEI	T1,FIL.LN		;RESET THE COUNT
TRMJ.2:	MOVE	S1,L.FBLN		;GET THE LIST NAME
	$CALL	L%NEXT			;GET THE NEXT FILE
	JUMPT	TRMJ.1			;LOOP BACK IF SUCCESSFUL
TRMJ.3:	CAIE	T1,FIL.LN		;ANYTHING ON THE LINE?
	PUSHJ	P,CTLEOL		;YES, TYPE A CRLF
	PUSHJ	P,DOFACT		;DO USAGE ACCOUNTING
	PUSHJ	P,QUEJOB		;SUBMIT THE JOB
	$RET				;AND FINISH UP
SUBTTL	ABORT  -  Routine to abort the current job

;ABORT is called upon detection of a fatal error.  ABORT  deletes
;       all  temp  files created by the job and queues up the log
;       file.

;	On entry AC B contains address of ITEXT.

JOBCER:	MOVEI	T1,[ITEXT(<Job Card Error>)]
	JRST	ABORT
PSWCER:	MOVEI	T1,[ITEXT(<Invalid Password Card>)]
	JRST	ABORT
CTLCER:	MOVEI	T1,[ITEXT(<Control Card Error>)]
	JRST	ABORT
ACTCER:	MOVEI	T1,[ITEXT(<Accounting Error>)]
	JRST	ABORT
PROCER:	MOVEI	T1,[ITEXT(<Input Spooling Processor Error>)]
ABORT:	MOVE	S1,L.IFN		;BUILD COMPLETE FD
	SETO	S2,0			;..
	$CALL	F%FD			;S1 CONTAINS ADDR OF FD
	SKIPN	JIBFLG			;IF NOT LOGGED IN DO THIS
	$WTOJ	(^I/(T1)/,<^R/.EQJBB(Q)/^M^J^T/JOBCRD/^I/(B)/>,WTOOBJ)
	SKIPE	JIBFLG			;IF LOGGED IN DO THIS
	$WTOJ	(^I/(T1)/,<^R/.EQJBB(Q)/^M^J^I/(B)/>,WTOOBJ)
	$TEXT	(LOGTXT,<^M^J^J^I/STSUM/Job Aborted due to fatal error>)
	TXO	F,F.FATE		;SET FATAL ERROR BIT
	PUSHJ	P,SUMARY		;GIVE THE SUMARY
	SKIPN	L.JLOG			;JOB LOGGED IN?
	JRST	ABOR.3			;NO, DO SPECIAL THINGS

	TXZ	F,F.BTCH		;NO BATCH JOB HERE
	MOVE	S1,CTLIFN		;GET THE CONTROL FILE IFN
	$CALL	F%RREL			;RELEASE AND ABORT
	PUSHJ	P,QUELOG		;QUEUE UP THE LOG FILE
	PUSHJ	P,DOFACT		;DO USAGE ACCOUNTING
	MOVE	S1,FILIFN		;PICK UP AN IFN
	SKIPE	FILOPN			;IS THERE A DECK OPEN?
	$CALL	F%RREL			;YES, GET RID OF IT
	SETZM	FILOPN			;AND CLEAR IFN
	MOVE	S1,L.FBLN		;GET THE LIST NAME
	$CALL	L%FIRST			;POSITION TO THE BEGINNING
	JUMPF	DONE			;DONE IF NONE

ABOR.1:	LOAD	S1,.FBFLG(S2),FB.DEL	;GET DELETE FLAG
	JUMPE	S1,ABOR.2		;JUMP IF NOT TO BE DELETED
	MOVEI	S1,.FBFD(S2)		;YES, GET ADDRESS OF THE FD
	MOVEM	S1,L.FOB+FOB.FD		;STORE IN THE FOB
	MOVEI	S1,^D36			;GET A RANDOM BYTE SIZE
	STORE	S1,L.FOB+FOB.CW,FB.BSZ	;AND STORE IT
	MOVEI	S1,2			;GET THE LENGTH
	MOVEI	S2,L.FOB		;GET THE ADR OF THE FOB
	$CALL	F%DEL			;DELETE THE FILE

ABOR.2:	MOVE	S1,L.FBLN		;GET THE LIST NAME
	$CALL	L%NEXT			;GET THE NEXT
	JUMPT	ABOR.1			;LOOP FOR MORE
	JRST	DONE			;ELSE DONE

ABOR.3:
TOPS10 <
	SETZM	.EQOID(Q)		;CLEAR THE PPN
	MOVX	T1,'SPRINT'		;MAKE AN INTERESTING NAME
	MOVX	T2,' ERROR'		;LIKE "SPRINT ERROR"
	DMOVEM	T1,.EQOWN(Q)		;AND STORE IT
	MOVEI	T1,L.SL1		;GET MY ORIG S/L
	PUSHJ	P,SETSRC		;AND SET IT
>;END TOPS10

;TOPS20 <
;	MOVEI	S1,10			;8 WORDS
;	MOVEI	S2,.EQOWN(Q)		;ADDRESS OF FIRST WORD
;	$CALL	.ZCHNK			;ZERO OUT THE OWNER NAME
;>;END OF TOPS20 CONDITIONAL ASSEMBLY

	PUSHJ	P,MAKLOG		;ENTER THE LOG FILE
	PUSHJ	P,QUELOG		;QUEUE IT UP
	JRST	DONE			;AND FINISH UP
TOPS20	<
DOFACT:	MOVX	S1,.FHSLF		;GET FORK HANDLE
	RUNTM				;GET RUNTIME
	ADDM	S1,L.RTM		;GET RUNTIME FOR THE JOB
	LOAD	S1,L.EQCP+.EQJBB+JIB.SQ,EQ.SEQ ;MAKE SURE SEQ. NUMBER
	STORE	S1,L.EQCP+.EQJBB+JIB.SQ	;WORD IS BARE...
	MOVEI	S1,.USENT		;WRITE AN ENTRY
	MOVEI	S2,ACTLST		;GET ADDRESS OF BLOCK
	USAGE				;ACCOUNT FOR THE WORLD
	  ERCAL	DOFA.1			;FAILED
	$RET				;AND RETURN


DOFA.1:	MOVX	S1,.FHSLF		;PREPARE TO GET THE ERROR
	JSYS	12			;GETER JSYS
	HRROI	S1,DOFA.3		;POINT TO BLOCK
	MOVEI	T1,^D60-1		;59 CHARS + NULL
	ERSTR				;GET THE ERROR STRING
	ERJMP	DOFA.2
DOFA.2:	$WTOJ(^I/ABTSPR/,<Accounting System Failure, ^E/[EXP -2]/>)
	$RET

DOFA.3:	BLOCK	^D60/5			;RESERVE nUFF ROOM FOR ERROR
>;END OF TOPS20 CONDITIONAL

TOPS10	<
DOFACT:	SETZ	T1,0			;CLEAR AN AC
	RUNTIM	T1,0			;GET OUR RUNTIME
	ADDM	T1,L.RTM		;PRODUCE THIS JOB'S RUNTIME

REPEAT 0,<			;;Until Barb implements it
	MOVEI	S1,.USENT		;WRITE AN ENTRY
	MOVEI	S2,ACTLST		;GET ADDRESS OF BLOCK
	USAGE				;ACCOUNT FOR THE WORLD
	$WTOJ(^I/ABTSPR/,Accounting System Failure)
> ;END OF REPEAT 0
	$RET				;AND RETURN
> ;END OF TOPS10 CONDITIONAL ASSEMBLY
ACTLST:	USENT.	(.UTINP,1,1)
	USACT.	(<-1,,L.EQCP+.EQACT>)	;ACCOUNT STRING
	USTXT.	(0)			;SYSTEM/OPERATOR TEXT
	USSRT.	(L.RTM)			;SPOOLER RUNTIME
	USSDR.	(0)			;DISK READS
	USSDW.	(0)			;DISK WRITES
	USJNM.	(L.EQCP+.EQJBB+JIB.JN)	;JOB NAME
	USQNM.	([SIXBIT /INP/])	;QUEUE NAME
	USSDV.	(L.EQCP+.EQJBB+JIB.JN)	;ACTUAL INPUT DEVICE
	USSSN.	(L.EQCP+.EQJBB+JIB.SQ)	;SEQUENCE NUMBER
	USSUN.	(CDRCNT)		;SPOOLER UNITS (CARDS)
	USCRT.	(L.DTM)			;DATE/TIME OF REQUEST
	USDSP.	([SIXBIT /BATCH/])	;DISPOSITION
	USPRI.	(0)			;PRIORITY

	USPNM.	([SIXBIT /SPRINT/])	;PROGRAM NAME (CALLER)
	USNM2.	(L.EQCP+.EQOWN)		;NAME OF USER
	0				;END OF LIST
SUBTTL	SUMARY  -  Place summary lines in the LOG file

SUMARY:	SETZ	T1,0			;CLEAR A COUNTER
SUMA.1:	SKIPE	@SUMTB1(T1)		;IS IT A ZERO?
	$TEXT(LOGTXT,<^I/STSUM/^D/@SUMTB1(T1)/ ^T/@SUMTB2(T1)/>)
	CAIGE	T1,.NMSMM-1		;GOT ALL THE SUMMARY MESSAGES?
	AOJA	T1,SUMA.1		;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:	[ASCIZ /Cards Read/]
	[ASCIZ /Hollerith Errors/]
	[ASCIZ /Illegal Binary Cards/]
	[ASCIZ /Binary Checksum Errors/]


SUBTTL	DONE  --  Release the job

DONE:	MOVE	S1,L.IFN
	MOVE	T1,L.INF		;GET THE .FPINF WORD
	MOVEI	S2,F%REL		;PREPARE FOR SIMPLE RELEASE
	TXNE	T1,FP.DEL!FP.SPL 	;DELETE IF EITHER SET
	MOVEI	S2,F%DREL		;DO THE DELETE AND RELEASE
	PUSHJ	P,(S2)			;..
	MOVE	S1,L.FBLN		;GET NAME OF FILE LIST
	$CALL	L%DLST			;AND DELETE THE LIST
RELJOB:	MOVX	S1,<XWD REL.SZ,.QOREL>	;FIRST WORD OF THE RELEASE
	STORE	S1,DONE.A+.MSTYP	;AND STORE IT
	LOAD	S1,L.EQCP+.EQITN	;GET THE JOB'S ITN
	STORE	S1,DONE.A+REL.IT	;AND STORE IT
	MOVX	S1,REL.SZ		;LENGTH OF MESSAGE
	MOVEI	S2,DONE.A		;AND LOCATION
	PUSHJ	P,SNDQSR		;SEND IT
	JRST	IDLE			;AND LOOP BACK

DONE.A:	BLOCK	REL.SZ			;BUILD THE RELEASE MESSAGE
SUBTTL	Non-$JOB Card Switch Subroutines

;/ASCII
IFE A%DFMD,<W$DFMD:>
W$ASCI:	SKIPA	T1,[POINT 7,L.CASC]	;LOAD ASCII MODE POINTER AND SKIP

;/026
IFN A%DFMD,<W$DFMD:>
W$BCD:
W$026:	MOVE	T1,[POINT 7,L.C026]	;LOAD 026 POINTER
	MOVEM	T1,L.CHOL		;AND SAVE FOR READ ROUTINE
	MOVEI	T1,STASC		;LOAD STACKING ROUTINE
	MOVEM	T1,L.MODE		;AND STORE FOR DISPATCH
	$RETT				;AND RETURN

;/BINARY
W$BINA:	MOVEI	T1,STBIN		;LOAD ROUTINE NAME
	MOVEM	T1,L.MODE		;AND STORE IT
	$RETT				;AND RETURN

;/IMAGE
W$IMAG:	MOVEI	T1,STIMG		;LOAD ROUTINE NAME
	MOVEM	T1,L.MODE		;STORE FOR DISPATCH
	CAIE	C,":"			;ANY ARGUMENT?
	 JRST	W$IMA1			; NO, TAKE DEFAULT
	PUSHJ	P,S$DEC
	SKIPG	T1			;WAS THERE AN ARG?
W$IMA1:	MOVEI	T1,2			;NO, MAKE IT 2
	MOVEM	T1,L.IMGT		;AND STORE IT
	$RETT				;AND RETURN

;/SUPPRESS - /NOSUPPRESS
W$NOSU:	SETZM	L.SPRS			;CLEAR THE SUPPRESS FLAG
	$RETT				;AND RETURN

W$SUPP:	SETOM	L.SPRS			;SET THE SUPPRESS FLAG
	$RETT				;AND RETURN

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

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

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

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

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

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

;/PRINT
W$PRIN:	MOVSI	T1,.OTLPT
	JRST	QSWRET

;/TPUNCH
W$TPUN:	MOVSI	T1,.OTPTP
	JRST	QSWRET

;/CPUNCH
W$CPUN:	MOVSI	T1,.OTCDP
	JRST	QSWRET

;/PLOT
W$PLOT:	MOVSI	T1,.OTPLT

QSWRET:	MOVEM	T1,L.QFN		;STORE DEVICE
	$RETT				;AND RETURN
SUBTTL	Process Control Card Switch

COMMENT	\
DOSWCH is called to process switches on a control card.

Call:			S1/  Valid switch bits

DOSWCH parses off each switch scans  the  switch  table  and
dispatches to the appropriate switch handler.
\

L.SNAM:	BLOCK	^D8			;ROOM FOR SWITCH

DOSWCH:	MOVEM	T1,DOSW.A		;VALID SWITCH BITS

DOSW.1:	CAIN	C,"/"			;DO WE HAVE A SLASH?
	JRST	DOSW.2			;YUP, CONTINUE
	PUSHJ	P,S$INCH		;NO, GET NEXT CHARACTER
	JUMPF	.RETT			;END OF CARD, RETURN
	JRST	DOSW.1			;AND LOOP
DOSW.2:	MOVEI	S1,L.SNAM		;PLACE TO STORE THE STRING
	PUSHJ	P,S$ASCZ		;GO GET IT
	MOVEI	S1,TBSWIT		;POINT TO TABLE
	HRROI	S2,L.SNAM		;POINT TO THE STRING
	$CALL	S%TBLK
	TXNE	S2,TL%NOM!TL%AMB	;VALID SWITCH?
	JRST	DOSW.5			;NO, COMPLAIN
	SUBI	S1,TBSWIT+1		;CALCULATE OFFSET
	MOVEI	T2,SADRS		;LOAD ADR OF DISPATCH TABLE
	ADD	T2,S1			;ADD IN THE OFFSET
	MOVE	T3,DOSW.A		;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	DOSW.6			;HE LOSES
	LOAD	S1,L.INF,FP.RCF		;GET OUR MODE
	CAXN	S1,.FPFAI		;AUGMENTED IMAGE?
	JRST	DOSW.3			;YES, ALL IS FINE
	TRNE	T2,SW.MOD		;NO, IS THIS A MODE CHANGE SWITCH?
	JRST	DOSW.6			;YES, SO IT'S ILLEGAL!
DOSW.3:	PUSHJ	P,(T1)			;WIN, DISPATCH!!!
	JUMPT	DOSW.1			;AND LOOP FOR NEXT SWITCH
	$TEXT	(LOGTXT,<^I/STERR/%SPTUSA  Unrecognized switch argument "^T/AR.NAM/" to /^T/L.SNAM/, ignored>)
	JRST	DOSW.1			;RECOVER

DOSW.5:	$TEXT(LOGTXT,<^I/STERR/%SPTURS  Unrecognized switch /^T/L.SNAM/, ignored>)
	JRST	DOSW.1			;AND LOOP AROUND

DOSW.6:	$TEXT(LOGTXT,<^I/STERR/%SPTISW  The /^T/L.SNAM/ switch ^A>)
$TEXT(LOGTXT,<is illegal on the $^T/L.TNAM/ card>)
	JRST	DOSW.1			;AND LOOP AROUND

DOSW.A:	BLOCK	1			;-TABLE Length,,TABLE ADDRESS
COMMENT	\
SWTOCT and SWTDEC are Routines  to  process  octal  and  decimal
       valued  switches.   Call  with  T1  containing address of
       2-word block as described below.

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

\

SUBTTL	SWTOCT - Process octal switch value
SWTOCT:	MOVEI	S1,S$OCT		;LOAD ROUTINE TO CALL
	MOVEI	S2,[ITEXT(<^O/T3/ and ^O/T4/>)]
	JRST	SWTNUM			;AND CONTINUE ON

SUBTTL	SWTDEC - Process decimal switch value
SWTDEC:	MOVEI	S1,S$DEC		;LOAD ROUTINE TO CALL
	MOVEI	S2,[ITEXT(<^D/T3/ and ^D/T4/>)]
					;AND FALL INTO SWTNUM

SWTNUM:	MOVEM	S2,SWTN.B		;SAVE THE ITEXT
	CAIN	C,"/"			;A SLASH SEEN?
	PJRST	ILLSWA			;YES, GIVE ERROR
	MOVEM	T1,SWTN.A		;SAVE CALLING ARGUMENT
	PUSHJ	P,(S1)			;GET ARGUMENT
	JUMPF	ILLSWA			;GARBAGE!

	MOVE	T2,SWTN.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
	  JRST	SWTN.1			;OUT OF RANGE
	XCT	1(T2)			;DEPOSIT THE ARGUMENT
	$RETT				;AND RETURN

SWTN.1:	$TEXT(LOGTXT,<^I/STERR/%SPTVMB  The value on the /^T/L.SNAM/ switch ^A>)
$TEXT(LOGTXT,<must be between ^I/@SWTN.B/, switch ignored>)
	$RETT				;AND RETURN


SWTN.A:	BLOCK	1			;TEMPORARY STORAGE
SWTN.B:	BLOCK	1			;TEMPORARY STORAGE

ILLSWA:	$TEXT(LOGTXT,<^I/STERR/%SPTISA  Illegal syntax for /^W/L.SWCH/ argument, switch ignored>)
	$RETF				;AND RETURN
SUBTTL	FILENT  -  Routine to open a user file

;FILENT is called with T1 containing the file-block bits.  FRCENT
;       is  called  with  the  same arguments as FILENT except we
;       invoke our privileges to write the file into <SPOOL>.

FRCENT:	TDZA	S1,S1			;LOAD ZERO FOR FLAG
FILENT:	SETO	S1,0			;SET FLAG FOR STANDARD ENTRY
	MOVEM	S1,L.FOB+FOB.US		;INITIALIZE THE FOB
	MOVEM	S1,L.FOB+FOB.CD		;..

	PUSHJ	P,CLRFOB		;CLEAR THE FOB
	SETZM	DEKCRD			;CLEAR THE CARD COUNT
	MOVEI	S1,FILFD		;LOAD ADDRESS OF THE FD
	MOVEM	S1,L.FOB+FOB.FD		;STORE IN OPEN BLOCK
	MOVEI	S1,7			;GET DEFAULT BYTE SIZE
	MOVE	S2,L.MODE		;GET THE MODE
	CAIE	S2,STBIN		;IS IT /BINARY
	CAIN	S2,STIMG		; OR /IMAGE?
	MOVEI	S1,^D36			;YES, USE 36 BIT BYTES
	STORE	S1,L.FOB+FOB.CW,FB.BSZ	;STORE IT
	MOVEI	S1,1			;LOAD A BIT
	SKIPE	FILSPC			;EXPLICIT FILENAME SUPPLIED?
	STORE	S1,L.FOB+FOB.CW,FB.NFO	;YES,IF FILE ALREADY EXISTS, FAIL
	SKIPN	L.FOB+FOB.US		;TEST WHETHER WE NEED TO
	JRST	FILE.1			; INVOKE OUR PRIVILEGES

TOPS10 <
	MOVE	S1,.EQOID(Q)		;GET THE PPN
	MOVEM	S1,L.FOB+FOB.US		;AND SAVE FOR ACCESS CHECK
>  ;END TOPS10

TOPS20 <
	HRROI	S1,.EQOWN(Q)		;POINT TO USER NAME
	MOVEM	S1,L.FOB+FOB.US		;STORE IT
	HRROI	S1,L.UDIR		;POINT TO CONNECTED DIRECTORY
	MOVEM	S1,L.FOB+FOB.CD		;AND STORE IT
>  ;END IFN FTJSYS

FILE.1:	MOVEI	S1,FOB.SZ		;GET ARGBLOCK LENGTH
	MOVEI	S2,L.FOB		;AND ARGBLOCK ADDRESS
	$CALL	F%OOPN			;OPEN THE FILE
	JUMPF	FILE.2			;JUMP IF WE LOSE
	MOVEM	S1,FILIFN		;ELSE, STORE THE IFN
	SETOM	FILOPN			;AND SET "FILE OPEN"
	PJRST	FBENT			;AND ENTER IN THE FILE BLOCKS

FILE.2:	MOVE	P1,S1			;RELOCATE ERROR CODE
	$TEXT(LOGTXT,<^I/FATAL/?SPTCCF  ^I/FILE.3/>)
	JSP	B,PROCER
FILE.3:	ITEXT(<Error creating file ^F/FILFD/, ^E/P1/>)
SUBTTL	LOG File I/O Utilities

LOGTXT:	SKIPG	LOGIFN			;IS THE LOG OPEN?
	JRST	LOGT.1			;NO, DEPOSIT CHAR IN BUFFER
	MOVE	S2,S1			;PUT CHARACTER IN S2
	MOVE	S1,LOGIFN		;GET THE IFN IN S1
	$CALL	F%OBYT			;OUTPUT THE CHARACTER
	JUMPT	.RETT			;RETURN IF ALL IS OK

	MOVE	P1,S1			;SAVE ERROR CODE
	MOVE	S1,LOGIFN		;GET LOGs HANDLE
	SETO	S2,0			;BUILD AN FD
	$CALL	F%FD
$WTOJ(<^I/ABTSPR/>,<Error writing user LOG file, [^E/P1/]^M^J^F/(S1)/>)
	$STOP(LS2,<Log File OUT Failed>)


LOGT.1:	SKIPN	LOGPAG			;HAS A PAGE BEEN SETUP?
	$STOP(LNI,LOG not initialized)
	JUMPE	S1,.RETT		;RETURN IF NULL
	SOSLE	LOGCNT			;ANY ROOM LEFT?
	IDPB	S1,LOGPTR		;YES, DEPOSIT A CHARACTER
	$RETT				;AND RETURN


LOGCLS:	MOVE	S1,LOGIFN		;GET THE IFN
	SETZM	LOGIFN			;LOG IS NOT OPEN!
	PJRST	F%REL			;AND RELEASE IT


LOGCRL:	$TEXT(LOGTXT,<^I/STERR/Card is: ^T/L.CASC/^A>)
	POPJ	P,			;AND RETURN


LOGCRD:	$TEXT(LOGTXT,<^I/STCRD/^T/L.CASC/^A>)	;TYPE THE CARD OUT
	POPJ	P,			;AND RETURN
SUBTTL	Control File I/O Utilities

TXTCTL:	MOVE	T1,S1			;RELOCATE CHARACTER
	LSH	T1,^D36-7		;SHIFT TO TOP 7 BITS
	MOVE	S2,[XWD 1,T1]		;MAKE POINTER
	PJRST	CTLSTR


CTLEOL:	MOVE	S2,[XWD 2,[BYTE (7) .CHCRT,.CHLFD]]
	PJRST	CTLSTR

CTLSTR:	MOVE	S1,CTLIFN
	$CALL	F%OBUF
	JUMPT	.RETT
	MOVE	P1,S1			;RELOCATE ERROR CODE
	$TEXT(LOGTXT,<^I/FATAL/?SPTEWC  ^I/CTLS.1/>)
	JSP	B,PROCER
CTLS.1:	ITEXT	(<Error writing BATCH control (CTL) file, ^E/P1/>)
SUBTTL	MAKFUN  -  Routine to create a default filename

;MAKFUN  is  called to create a default (Funny) filename for user
;       files.  MAKFUN is called with S1 containing a 2-character
;       prefix  for the filename (right-justified in SIXBIT).  It
;       returns with S1 containing:

;	On TOPS10, the default filename in SIXBIT.
;	On TOPS20, [POINT 7,FILENAME]


MAKFUN:	PUSH	P,S1			;SAVE S1
	PUSHJ	P,FUNNY			;MAKE FOUR RANDOM CHARACTERS
	POP	P,S2			;GET PREFIX BACK
	LSH 	S2,^D24			;MOVE IT OVER

TOPS10	<
	IOR	S1,S2			;OR IN THE FUNNY PART
>;END OF TOPS10 CONDITIONAL ASSEMBLY

TOPS20	<
	IOR	S2,S1			;OR IN THE FUNNY PART
	MOVE	S1,[POINT 7,MAKF.A]	;POINT TO THE BLOCK
	MOVEM	S1,L.BP			;STORE IT AWAY
	$TEXT(DEPBP,<^W/S2/^0>)
	MOVE	S1,[POINT 7,MAKF.A]	;RETURN THE ANSWER
>;END OF TOPS20 CONDITIONAL ASSEMBLY

	$RET				;RETURN

MAKF.A:	BLOCK	2			;BLOCK TO BUILD THE NAME
;FUNNY is a routine to make up a 4-character Funny Name. Returns the
;       four characters in SIXBIT, right justified  in  S1.   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.)

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

FUNLUP:	IDIVI	S1,^D36			;DIVIDE BY 36
	HRLM	S2,(P)			;STORE DIGIT ON STACK
	SKIPE	S1			;FINISHED?
	PUSHJ	P,FUNLUP		;NO, RECURSE
	MOVEI	S1,'000'		;PRE-LOAD S1
	HLRZ	S2,(P)			;LOAD A DIGIT
	ADDI	S2,20			;MAKE IT 6BIT
	CAILE	S2,31			;NUMERIC?
	ADDI	S2,7			;NO, ALPHABETIC, ADD OFFSET
	LSH	S1,6			;SHIFT OVER ACCUMULATED NAME
	IOR	S1,S2			;OR IN NEXT CHARACTER
	AOS	0(P)			;INCREMENT THE PC
	POPJ	P,			;AND SKIP BACK
SUBTTL	CTLCRD - Routine to copy current card

COMMENT	%
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:	PUSHJ	P,S$INCH		;GET A CHARACTER
	JUMPF	.RETT			;EOL, RETURN
	CAIN	C,(T1)			;CHECK FOR BREAK
	POPJ	P,			;GOT IT!! RETURN
	LDB	S1,B			;REREAD CHARACTER TO PRESERVE CASING
	PUSHJ	P,TXTCTL		;AND TYPE IT INTO CTL
	JRST	CTLCRD			;AND LOOP



; CLRFOB -- Routine to clear out the utility file open block

CLRFOB:	MOVX	S1,FOB.SZ		;FOB SIZE
	MOVEI	S2,L.FOB		;FOB ADDRESS
	$CALL	.ZCHNK			;ZERO IT
	$RETT				;AND RETURN
COMMENT	\
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.

CALL:
	PUSHJ P,FBENT
	  ALWAYS RETURN HERE

\

FBENT:	JUMPE	T1,.RETT		;IF BITS ARE ZERO, DON'T STORE ANYTHING
	$CALL	.SAVE2			;SAVE P1 AND P2
	MOVE	S1,L.FBLN		;GET THE LIST NAME
	$CALL	L%LAST			;POSITION TO THE END
	MOVEI	T2,FILFD		;LOAD ADDRESS OF THE FD
	PUSHJ	P,FBEN.2		;DO THAT ONE
	TXNN	T1,FB.LDR		;LOAD THE REL FILE?
	$RETT				;NO, RETURN
	SETOM	L.FBCT			;FLAG SOMETHING TO LOAD
	TXO	T1,FB.LOD		;AND SET THE LOAD FLAG

TOPS10 <
	MOVEI	T2,FILFD		;LOAD THE FD
	PUSHJ	P,FBEN.2		;AND COPY IT
	MOVSI	S2,'REL'		;LOAD AN EXTENSION
	STORE	S2,.FBFD+.FDEXT(S1)	;STORE IT
	$RETT				;AND RETURN
>  ;END TOPS10

TOPS20 <
	MOVEI	T2,FILRFD		;LOAD THE REL FD
	PUSHJ	P,FBEN.2		;SETUP THE FD
	$RETT				;AND RETURN
>;END IFN FTJSYS

FBEN.2:	MOVE	S1,L.FBLN		;GET THE LIST NAME
	LOAD	S2,.FDLEN(T2),FD.LEN	;GET THE LENGTH
	ADDI	S2,.FBFD		;ADD IN THE OVERHEAD
	$CALL	L%CENT			;CREATE AN ENTRY
	MOVE	S1,S2			;GET THE ADDRESS IN S1
	MOVEI	S2,.FBFD(S2)		;POINT TO THE FD
	HRL	S2,T2			;MAKE A BLT POINTER
	LOAD	T2,.FDLEN(T2),FD.LEN	;GET THE LENGTH
	ADD	T2,S1			;ADD IN THE DESTINATION
	BLT	S2,-1(T2)		;AND BLT THE ENTRY
	MOVEI	S2,1			;LOAD A FLAG
	TXNE	T1,FB.DEL		;IS DELETE ON?
	STORE	S2,.FBFLG(S1),FB.DEL	;YES, SET DELETE
	TXNE	T1,FB.LOD		;IS LOAD ON?
	STORE	S2,.FBFLG(S1),FB.LOD	;YES, SET IT
	TXNE	T1,FB.SRH		;IS SEARCH ON?
	STORE	S2,.FBFLG(S1),FB.SRH	;YUP!
	$RETT				;RETURN OK
SUBTTL	FBCLOD  -- File Block Clear LOaD bits

COMMENT	\
FBCLOD  is  called  on  each $LANGUAGE, $INCLUDE, and $RELOC
card. If the  current  remembered  files  have  been  loaded
(L.LOAD)  then  all  files are scanned and their "LOAD" bits
are cleared.
\

FBCLOD:	SKIPN	L.LOAD			;IS LOAD SET?
	$RETT				;NO, JUST RETURN
	SETZM	L.LOAD			;CLEAR THE LOAD WORD
	SETZM	L.FBCT			;CLEAR THE COUNTER
	MOVE	S1,L.FBLN		;GET THE LIST NAME
	$CALL	L%FIRST			;POSITION TO BEGINNING

FBCL.1:	ZERO	.FBFLG(S2),FB.LOD	;CLEAR THE LOAD FLAG
	$CALL	L%NEXT			;GET THE NEXT
	JUMPT	FBCL.1			;LOOP IF MORE
	$RETT				;ELSE, RETURN
SUBTTL	S$OCT  - S$DEC -- Octal and decimal number scanners.

COMMENT	\
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,[EXP 8]		;LOAD AN 8
S$DEC:	MOVEI	T2,12			;LOAD A 10
S$NUM:	SETZ	T1,0			;CLEAR THE ACCUMULATOR
	PUSHJ	P,S$FSPC		;FLUSH LEADING SPACES AND GET A CHAR
	JUMPF	S$NU.3			;EOL, RETURN -1
	CAIL	C,"0"			;CHECK RANGE
	CAILE	C,"0"-1(T2)
	$RETF				;FAIL RETURN
	JRST	S$NU.2			;OK, SKIP INTO LOOP

S$NU.1:	PUSHJ	P,S$INCH		;GET A CHARACTER
	JUMPF	.RETT			;EOL, RETURN OK
	CAIL	C,"0"			;CHECK THE RANGE
	CAILE	C,"0"-1(T2)
	$RETT				;NOT A NUMBER, JUST RETURN OK
S$NU.2:	IMULI	T1,(T2)			;SHIFT RADIX POINT OVER ONE
	ADDI	T1,-"0"(C)		;ADD IN THE NEXT DIGIT
	JRST	S$NU.1			;AND LOOP AROUND FOR THE NEXT DIGIT

S$NU.3:	SETO	T1,			;LOAD A -1
	$RETF				;AND FAIL
SUBTTL	S$ASCZ -- Routine to scan an  ASCIZ  string.

COMMENT	\
Routine continues scanning and loading characters into the 
specified block pointed to by S1 until either a terminating
character is found or more than 38 characters have been scanned.
A terminating character is any character other than one of the
following:	1) Alphabetic (upper or lower case)
		2) Numeric (0-9)
		3) Hyphen/Minus sign (Code=45 decimal)
Call:
	PUSHJ P,S$ASCZ
	  ALWAYS RETURN HERE
\

S$ASCZ:	HRR	T1,S1			;RELOCATE CALLING ARGUMENT
	HRLI	T1,(POINT 7)		;MAKE A BYTE POINTER
	SETZB	T2,(T1)			;AND CLEAR A COUNTER

S$AS.1:	PUSHJ	P,S$INCH		;GET A CHARACTER
	JUMPF	S$AS.3			;EOL OR SOMETHING LIKE THAT
	MOVE	S1,C			;RELOCATE
	TRZ	S1,40			;CONVERT LC TO UC
	CAIL	S1,"A"			;ALPHABETIC?
	CAILE	S1,"Z"
	SKIPA				;NO
	JRST	S$AS.2			;OK
	CAIL	C,"0"			;NUMERIC?
	CAILE	C,"9"
	SKIPA				;NO
	JRST	S$AS.2			;OK
	CAIE	C,"-"
	JRST	S$AS.3			;LOSE
S$AS.2:	IDPB	C,T1			;ELSE DEPOSIT THE CHAR
	CAIGE	T2,^D38			;GOT ENUF?
	AOJA	T2,S$AS.1		;NO, GET SOMEMORE
S$AS.3:	SETZ	T2,0			;LOAD NULL
	IDPB	T2,T1			;DEPOSIT IT
	$RET				;AND RETURN
TOPS10	<
S$TENN:	HRR	T1,S1			;RELOCATE THE POINTER
	HRLI	T1,(POINT 6)		;MAKE SIXBIT BYTE PTR
	SETZ	T2,0			;CLEAR COUNTER
TENN.1:	PUSHJ	P,S$INCH		;FETCH A CHARACTER
	JUMPF	TENN.3			;ERROR
	CAIE	C," "			;SPACE OR SLASH?
	CAIN	C,"/"
	JRST	TENN.3			;YES
	CAIE	C,""""			;QUOTE CHARACTER?
	JRST	TENN.2			;NO
	JUMPE	T2,TENN.1
TENN.2:	CAIL	C,"a"
	CAILE	C,"z"
	SKIPA
	TRZ	C,40			;CONVERT TO UPPER CASE
	SUBI	C,40			;SIXBITIZE
	IDPB	C,T1
	CAIGE	T2,^D12
	AOJA	T2,TENN.1
TENN.3:	SETZ	T2,0			;LOAD NULL
	IDPB	T2,T1			;DEPOSIT IT
	$RET				;AND RETURN
>
SUBTTL	S$TIM -- Routine to return a Time Specification

COMMENT	\
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.

CALL:
	PUSHJ P,S$TIM
	  RETURN HERE IF TOO MANY ARGS SPECIFIED (# IN T1)
	  RETURN HERE OTHERWISE
\

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

S$TML:	PUSHJ	P,S$DEC			;GET A DECIMAL NUMBER
	SKIPT				;SKIP ON VALID NUMBER READ
	SETZ	T1,0			;MAKE IT ZERO
	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,(P1)			;SAVE IT
	SOS	P1			;POINTER FOR NEXT ARG
	POPJ	P,			;AND UNWIND
SUBTTL	S$DATE -- Date-Time Scanner **UNDER RADIX-10**.

COMMENT	%
.SCDT  is  called  by  the  /DEADLINE and /AFTER switches to
parse a date-time specification.

Legal date-time specifications are of the form:

	[+[HH:[MM]]]
	[[DD-MMM]-YY]
	[[[DD-MMM]-YY] [HH:[MM]]]

For  all  month  specifications  (MMM) a 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.

Note: This routine is only good until 1999
%

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

S$DATE:	MOVE	T1,[XWD L.HRS,L.HRS+1]
	SETZM	L.HRS			;SETUP TO CLEAR RESULTS
	BLT	T1,L.YRS		;AND DO IT!

	PUSHJ	P,S$INCH		;GET A CHARACTER
	JUMPF	DATERR			;FAIL ON 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
	JRST	DATERR			;NO, LOSE
DATE.1:	TXO	F,F.RSCN		;SET TO REREAD CHARACTER
	PUSHJ	P,S$DEC			;GET A DECIMAL NUMBER
	JUMPF	DATERR			;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
	JUMPF	DATERR			;LOSE
	MOVEM	T1,L.SEC		;SAVE THEM
	JRST	MAKDT			;AND MAKE A DATE
.SCDTR:	PUSHJ	P,S$TIM			;GET A TIME SPEC
	JUMPF	DATERR			;FAIL RETURN
	SKIPE	L.HRS			;ONLY WANT 2 ARGS
	JRST	DATERR			;HE'S TOO ACCURATE
	MSTIME	T1,			;GET NOW!!
	IDIV	T1,[EXP 1000*3600]
	ADDM	T1,L.MIN		;ADD IN HRS
	IDIVI	T2,60000		;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,S$INCH		;GET NEXT CHAR
	JUMPF	DATERR			;FAIL ON EOL
	TXO	F,F.RSCN		;RESCAN THE CHARACTER
	TRNN	C,^O100			;ALPHABETIC?
	JRST	.SCDA3			;ITS NOT, MUST BE NUMBER
	MOVEI	S1,AR.NAM		;POINT TO STORAGE BLOCK
	PUSHJ	P,S$ASCZ		;TAKE A COPY
	MOVEI	S1,MONTAB-1		;POINT TO TABLE
	MOVEI	S2,AR.NAM		;AND THE ARGUMENT
	$CALL	S%TBLK			;TRY FOR A MATCH
	TXNE	S2,TL%NOM!TL%AMB	;VALID DATE ARG?
	JRST	DATERR			;NO, FAIL
	HRRZ	T1,(S1)			;GET MONTH NUMBER (1-12)

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

.SCDA3:	PUSHJ	P,S$DEC			;GET THE MONTH NUMBER
	JUMPF	DATERR			;BAD FORMAT??
	CAIL	T1,1			;MAKE SURE ITS 1-12
	CAILE	T1,12
	JRST	DATERR			;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
	JUMPF	DATERR			;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,S$FSPC		;FLUSH LEADING SPACES
	JUMPF	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
	JRST	DATERR			;NO???
	JRST	DATE.1			;YES, GET A TIME
MAKDT:	SKIPE	L.YRS			;DATE SPECIFIED?
	JRST	MAKD.2			;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
	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	MAKD.1			;MOST DEFINITELY, GO ADD A DAY
	CAME	T1,L.MIN		;IS IT LT OR EQ
	JRST	MAKD.2			;ITS LT, DON'T ADD A DAY
	CAMG	T2,L.SEC		;ARE THE MINUTES PAST
	JRST	MAKD.2			;NO, ALL IS WELL
MAKD.1:	MOVEI	T3,24			;GOING TO INCREMENT BY 24 HOURS
	ADDM	T3,L.MIN		;AND DO IT
MAKD.2:	MOVE	T1,L.MIN		;GET HOURS
	IMULI	T1,60			;AND MAKE MINUTES
	ADD	T1,L.SEC		;ADD MINUTES
	SETZ	T2,0			;FOR LOW HALF
	ASHC	T1,-17			;MULT BY 2**18
	DIVI	T1,60*24		;DIVIDE BY MIN/DAY
	MOVEM	T1,L.SEC		;AND STORE

	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
	$RETT				;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*****

DATERR:	$TEXT(LOGTXT,<^I/STERR/^I/DTR1/,  switch ignored>)
	$RETF			;AND FAIL
DTR1:	ITEXT	(<%SPTBDT  Bad date/time on /^W/L.SWCH/>)

	XWD	^D12,^D12		;CONTROL WORD FOR TBLUK
MONTAB:	TB(JANUARY,^D1)
	TB(FEBRUARY,^D2)
	TB(MARCH,^D3)
	TB(APRIL,^D4)
	TB(MAY,^D5)
	TB(JUNE,^D6)
	TB(JULY,^D7)
	TB(AUGUST,^D8)
	TB(SEPTEMBER,^D9)
	TB(OCTOBER,^D10)
	TB(NOVEMBER,^D11)
	TB(DECEMBER,^D12)
SUBTTL	S$FILE -- Routine to scan off a filespec.

; Call with S1 containing the default file name (in SIXBIT  on
; the -10, ASCII byte pointer on the -20)

; Call with S2 containing the default extension  (same  format
; as name)

;	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

TOPS10 <
S$FILE:	SETZB	T4,FILSPC		;CLEAR SPEC FLAGS AND WORD
	SETZM	FILFD			;CLEAR THE FIRST WORD OF FD BLOCK
	MOVE	T1,[FILFD,,FILFD+1]
	BLT	T1,FILFD+FDXSIZ-1	 ;CLEAR OUT THE FD
	MOVSI	T1,'DSK'		;GET DEFAULT DEVICE
	STORE	T1,FILFD+.FDSTR		;STORE IT
	LOAD	T1,.EQOID(Q)		;GET USERS PPN
	STORE	T1,FILFD+.FDPPN		;AND STORE IT
	STORE	S1,FILFD+.FDNAM		;STORE THE DEFAULT NAME
	STORE	S2,FILFD+.FDEXT		;STORE THE DEFAULT EXTENSION
	MOVEI	S1,FDMSIZ		;ASSUME NO SFDS
	STORE	S1,FILFD+.FDLEN,FD.LEN;STORE THE INITIAL LENGTH

S$FIL1:	PUSHJ	P,S$FSPC		;SCAN OFF SPACES
	TXO	F,F.RSCN		;SET APPROPRIATE FLAG
	MOVEI	S1,AR.NAM		;POINT TO ARGUMENT BLOCK
	PUSHJ	P,S$ASCZ		;GO GET IT
	HRROI	S1,AR.NAM		;POINT TO THE BLOCK AGAIN
	$CALL	S%SIXB			;SIXBITIZE
	SKIPN	T1,S2			;RELOCATE AND TEST ARGUMENT
	JRST	S$FIL4			;EOL - SUCCESS RETURN
	JUMPF	S$FIL2			;NOT ALPHANUMERIC

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

S$FIL3:	CAIN	C,"."			;EXTENSION COMING?
	JRST	S$EXT			;YES, DO IT!
	CAIE	C,"["			;DIRECTORY SPEC COMING?
	CAIN	C,74			;ACCEPT EITHER DELIMETER
	JRST	S$DIR			;YES,  GO GET IT
	CAIN	C," "			;A BLANK?
	JRST	S$FIL1			;YES, TRY SOME MORE
S$FIL4:	TXNE	T4,SC.NAM		;DID WE FIND A NAME?
	SETOM	FILSPC			;YES, SET THE FLAG
	$RETT				;AND RETURN TRUE

S$DEV:	JUMPE	T1,S$FIL5		;NULL DEVICE?
	TXOE	T4,SC.DEV		;SET DEV FLAG AND SKIP IF NOT DUPLICATE
	JRST	S$FIL5			;DUPLICATE DEVICE
	MOVEM	T1,FILFD+.FDSTR		;STORE DEVICE NAME
	JRST	S$FIL1			;AND LOOP FOR MORE STUFF
S$EXT:	TXOE	T4,SC.EXT		;SET EXT FLAG AND SKIP IF 1ST ONE
	JRST	S$FIL5			;NOT THE FIRST TIME!
	MOVEI	S1,AR.NAM		;POINT TO ARGUMENT BLOCK
	PUSHJ	P,S$ASCZ		;GO GET IT
	HRROI	S1,AR.NAM		;POINT TO THE BLOCK AGAIN
	$CALL	S%SIXB			;SIXBITIZE
	HLLZM	S2,FILFD+.FDEXT		;STORE THE EXTENSION
	JRST	S$FIL3			;AND LOOP FOR MORE

S$DIR:	TXOE	T4,SC.DIR		;DO WE HAVE A DIRECTORY ALREADY?
	JRST	S$FIL5			;YES, LOSE
	PUSHJ	P,S$OCT			;GET AN OCTAL NUMBER
	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	S$FIL5			;IT ISN'T, ITS GARBAGE
	PUSHJ	P,S$INCH		;GET NEXT CHARACTER
	JUMPF	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,FILFD+.FDPPN		;SAVE PROJECT NUMBER
	PUSHJ	P,S$OCT			;GET PROG
	HRRM	T1,FILFD+.FDPPN		;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	S$FIL5			;NO, MORE GARBAGE
	MOVEI	P2,FILFD+.FDPAT		;POINT TO FIRST SFD

S$DIR3:	MOVEI	S1,AR.NAM		;POINT TO ARGUMENT BLOCK
	PUSHJ	P,S$ASCZ		;GO GET IT
	HRROI	S1,AR.NAM		;POINT TO THE BLOCK AGAIN
	$CALL	S%SIXB			;SIXBITIZE
	JUMPF	S$FIL5			;LOSE BIG
	MOVEM	S2,(P2)			;STORE SFD IN PATH BLOCK
	INCR	FILFD+.FDLEN,FD.LEN	;INCREMENT THE COUNT FIELD
	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	S$FIL5			;NO, LOSE
	LOAD	T1,FILFD+.FDLEN,FD.LEN	;GET THE LENGTH
	CAIGE	T1,FDXSIZ		;GREATER THAN MAX?
	AOJA	P2,S$DIR3		;NO, WIN
	JRST	S$FIL5			;YES, NESTING TO DEEP

S$FIL5:	$TEXT(LOGTXT,<^I/FATAL/?SPTFSE  ^I/S$ERR5/>)
	JSP	B,CTLCER		;ABORT
S$ERR5:	ITEXT	(<File specification error on $^T/L.TNAM/ card>)
>;END TOPS10
TOPS20 <

S$FILE:	SETZM	FILSPC			;CLEAR SPEC FOUND FILE
	DMOVE	T1,S1			;SAVE THE ARGUMENTS
	MOVEI	S1,.GJCPC+1		;BLOC SIZE
	MOVEI	S2,SFIL.A		;BLOCK ADDRESS
	$CALL	.ZCHNK			;ZERO OUT THE GTJFN BLOCK
	MOVEM	T1,SFIL.A+.GJNAM	;SAVE DEFAULT NAME
	MOVEM	T2,SFIL.A+.GJEXT	;SAVE DEFAULT EXTENSION
	MOVX	S1,GJ%OFG!GJ%XTN	;"JUST PARSE" FLAG
	MOVEM	S1,SFIL.A+.GJGEN	;SAVE IT
	MOVX	S1,<XWD .NULIO,.NULIO>	;GET NUL IO DEVICE
	MOVEM	S1,SFIL.A+.GJSRC	;FOR ADDITIONAL SOURCE
	HRROI	S1,[ASCIZ /PS/]		;GET DEFAULT DEVICE
	MOVEM	S1,SFIL.A+.GJDEV	;STORE IT
	HRROI	S1,.EQOWN(Q)		;POINT TO DIRECTORY
	MOVEM	S1,SFIL.A+.GJDIR	;STORE
	MOVX	S1,G1%NLN+2		;SHORT FILENAMES AND 2 WRDS FOLLOWING
	MOVEM	S1,SFIL.A+.GJF2		;AND STORE IT
	HRROI	S1,FILRFD		;BYTE POINTER FOR USER TYPED
	MOVEM	S1,SFIL.A+.GJCPP	;AND STORE IT
	MOVEI	S1,<FDXSIZ*5>		;AND A BYTE COUNT
	MOVEM	S1,SFIL.A+.GJCPC	;AND STORE IT
	SETZM	FILRFD			;CLEAR THE WORD
	MOVEI	S1,SFIL.A		;LOAD ADDRESS OF BLOCK
	MOVE	S2,B			;RELOCATE BP
	PUSHJ	P,S$FSPC		;SKIP OVER BLANKS
	SETO	S2,0			;INDICATE TASK
	ADJBP	S2,B			;READJUST BP
	GTJFN				;GET THE FILE SPEC
	  JRST	S$FIL2			;LOSE??
	SETO	B,0			;SETUP TO DECREMENT
	ADJBP	B,S2			;THE RETURNED BP
	MOVE	S2,S1			;PUT JFN IN S2
	MOVX	S1,177B6		;PREPARE TO CLEAR TERMINATING CHARACTER
	ANDCAM	S1,FILRFD		;CLEAR IT OUT
	SKIPE	S1,FILRFD		;TEST FOR NULL
	CAMN	S1,[BYTE (7) 0,.CHLFD] ;AND ALSO CRLF
	SKIPA
	SETOM	FILSPC			;HE TYPED A FILENAME
	SETZM	FILRFD			;CLEAR THE FIRST WORD
	HRROI	S1,FILFD+.FDSTG		;POINT TO STRING BLOCK
	MOVX	T1,<XWD 221100,JS%PAF>	;GET THE FIELDS WE WANT
	JFNS				;GET THE FILESPEC BACK
	TLZ	S1,-1			;ZAP LEFT HALF OF BP
	SUBI	S1,FILFD+.FDSTG-3	;GET LENGTH (WITH SOME SLOP)
	STORE	S1,FILFD+.FDLEN,FD.LEN	;STORE IN PRIME FD
	STORE	S1,FILRFD+.FDLEN,FD.LEN	;AND REL FILE FD
	MOVE	S1,S2			;GET THE JFN BACK
	RLJFN				;RELEASE IT
	JFCL				;IGNORE THE ERROR RETURN
	MOVE	S1,[XWD FILFD,FILRFD]	;PREPARE TO TAKE
	BLT	S1,FILRFD+FDXSIZ-1	;COPY OF FD
	MOVE	S1,[POINT 7,FILRFD+.FDSTG];AND START SEARCH
	ILDB	T1,S1			;FOR THE DOT
	CAIE	T1,"."			;FOUND?
	JRST	.-2			;NO, KEEP GOING
	MOVEM	S1,L.BP			;SAVE POINTER FOR $TEXT
	$TEXT	(DEPBP,<REL^0>)		;AND REPLACE THE EXTENSION
	$RET				;AND RETURN

S$FIL1:	RLJFN				;RELEASE THE FILE
	JFCL				;IGNORE ANY ERROR
S$FIL2:	$TEXT(LOGTXT,<^I/FATAL/?SPTFSE  ^I/S$ERR2/>)
	JSP	B,CTLCER		;ABORT
S$ERR2:	ITEXT	(<File specification error on $^T/L.TNAM/ card>)

SFIL.A:	BLOCK	.GJCPC+1		;DEFAULT JFN BLOCK
>;END IFN FTJSYS
SUBTTL	S$FSPC -- Routine to flush leading spaces

;Useful scanning routines


;Call:
;	PUSHJ P,S$FSPC
;	  Return here otherwise with first significant char in C

S$FSPC:	PUSHJ	P,S$INCH		;GET A CHARACTER
	JUMPF	.RETF			;FAIL, EOL
	CAIN	C," "			;A SPACE?
	JRST	S$FSPC			;YES, LOOP
	$RETT				;NO, RETURN SUCCESS


SUBTTL	S$INCH -- Routine to get a character

; Routine  to  call  the  get  a  character  routine  for  the
; scanners.  Checks for continuation characters, comments etc.
;
;Call:
;	PUSHJ	P,S$INCH
;	  Return here with character in C
;	(Returns FALSE on EOL else TRUE)

S$INCH:	TXZE	F,F.RSCN		;RESCANNING THIS CHAR?
	$RETT				;YES, RETURN TRUE
	PUSHJ	P,CDRCHR		;CALL CALLER'S ROUTINE
	JUMPF	.RETF			;FAIL ON EOL
	CAIE	C,"!"			;START COMMENT FIELD?
	CAIN	C,";"			;EITHER TYPE!!
	POPJ	P,			;YES, SAME AS EOL
	CAIE	C,"-"			;OR CONTINUATION MARK?
	$RETT				;NO, RETURN WITH A CHARACTER
	PUSH	P,B			;SAVE BYTE POINTER
S$IN.1:	PUSHJ	P,CDRCHR		;GET ANOTHER CHARACTER
	JUMPF	S$IN.2			;EOL MEANS IT WAS A CONTINUATION
	CAIE	C,"!"			;SO DOES A COMMENT
	CAIN	C,";"			; EITHER TYPE OF COMMENT
	JRST	S$IN.2			;SO GO GET IT
	CAIN	C," "			;IS IT A BLANK?
	JRST	S$IN.1			;YES, LOOP FOR NON-BLANK
	POP	P,B			;ITS NOT A CONTINUATION
	MOVEI	C,"-"			;SO RESTORE THE HYPHEN
	$RETT				;RETURN SUCCESS

S$IN.2:	POP	P,B			;BRING STACK INTO PHASE
	PUSHJ	P,S$NXTC		;GET NEXT RECORD
	JRST	S$INCH			;NOPE, TRY AGAIN
SUBTTL	DUMMY Routines to read one character from card

COMMENT	%
CDRCHR -- Routine to  load  one  byte  from  card  (L.CASC).
Converts  tabs  and  CR  to spaces, and lower to upper case.
Assumes AC B contains a correct byte pointer

Call:
	PUSHJ P,CDRCHR
	Returns FALSE if EOL else TRUE
%

SUBTTL	CDRCHR - Get a card character
CDRCHR:	SKIPE	L.BRK			;WAS LAST CHARACTER A BREAK?
	$RETF				;YES, FAIL RETURN
	ILDB	C,B			;GET A CHARACTER
	CAIN	C,.CHCRT		;IGNORE CR'S
	JRST	.-2			;GET NEXT CHARACTER
	CAIN	C,.CHTAB		;DO FIXUP ON TABS
	MOVEI	C," "			;YES, MAKE A SPACE
	CAIN	C,.CHLFD		;LINEFEED?
	  JRST	CDRCH1			;YES, SET BREAK FLAG A NON-SKIP BACK
	CAIL	C,"a"			;CHECK FOR LOWER CASE
	CAILE	C,"z"			; I.E. "A"-"Z"
	$RETT				;NO, RETURN
	SUBI	C,40			;MAKE IT UPPER CASE
	$RETT				;AND RETURN

CDRCH1:	SETOM	L.BRK			;SET BREAK FLAG
	MOVEI	C," "			;MAKE BREAK CHAR LOOK LIKE A SPACE
	$RETF				;AND FAIL


; S$NXTC  --  Routine  to get a record for scanners reads in a
; card and prints it into the LOG, since it is a control card.
;
;Call:
;	PUSHJ	P,CDRNXT
;	  Return here otherwise

S$NXTC:	$CALL	.SAVET			;SAVE T REGS
	MOVE	S1,L.DWID		;LOAD DEFAULT WIDTH
	MOVEM	S1,L.WIDT		;SAVE IT
	PUSHJ	P,CDRASC		;GET A CARD
	PUSHJ	P,LOGCRD		;TYPE THE CARD
	MOVE	B,[POINT 7,L.DMOD]
	$RETT				;LOAD NEW BP AND RETURN
SUBTTL	Deck Stacking Routines

; Routine to stack a user's Hollerith  (ASCII  or  026)  file.
; Stacks until a control card or an input EOF is found.

STASC:	PUSHJ	P,CDRASC		;GET ASCII CARD IMAGE
	MOVE	B,L.CHOL		;GET THE DEFAULT BYTE POINTER
	ILDB	T1,B			;GET AND COLUMN 1
	CAIE	T1,"$"			;DOLLAR SIGN?
	JRST	STAS.2			;NO, TREAT AS DATA
	ILDB	T1,B			;GET COLUMN 2
	CAIL	T1,"a"			;CONVERT LOWER CASE
	CAIL	T1,"z"			; TO UPPER
	SKIPA				; IF NECESSARY
	TRZ	T1,40			;CONVERT CASING
	CAIL	T1,"A"			;CHECK FOR ALPHABETIC
	CAILE	T1,"Z"			;BETWEEN A AND Z
	JRST	STAS.1			;NOT A CONTROL CARD, CHECK OTHERS
	JRST	STAS.3			;CONTROL CARD

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

STAS.2:	MOVE	S1,FILIFN		;GET THE IFN
	HRL	S2,L.CLEN		;GET NUMBER OF BYTES,,0
	SKIPE	L.SPRS			;SUPPRESS FLAG ON?
	HRL	S2,L.CSUP		;YES, SO GET SUPPRESSED LENGTH
	HRR	S2,L.CHOL		;AND THE LOCATION
	$CALL	F%OBUF			;WRITE OUT THE BUFFER
	JUMPF	FILERR			;AND LOSE?
	MOVE	S1,FILIFN		;GET THE IFN
 	MOVE	S2,[2,,[BYTE (7) .CHCRT,.CHLFD]]
 	$CALL	F%OBUF			;PUT IN A CRLF
	JUMPF	FILERR			;AND LOSE
	AOS	DEKCRD			;COUNT THE CARD
	JRST	STASC			;AND GO AROUND FOR ANOTHER

STAS.3:	TXNN	F,F.DOLR		;IS /DOLLARS ON?
	$RET				;NO, $<ALPHA> STOPS US THEN
	MOVE	C,T1			;RELOCATE LAST CHARACTER
	TXO	F,F.RSCN		;SET RESCAN FLAG
	MOVEI	S1,AR.NAM		;POINT TO STRING BLOCK
	PUSHJ	P,S$ASCZ		;READ IN THE KEYWORD
	SKIPN	AR.NAM			;TEST FOR NULL
	JRST	STAS.2			;IT'S NULL, JUST DUMP IT OUT
	MOVEI	S1,CTLCOD-1		;POINT TO TABLE
	HRROI	S2,AR.NAM		;POINT TO KEYWORD GATHERED
	$CALL	S%TBLK			;DO THE WORK
	TXNE	S2,TL%NOM!TL%AMB	;MATCH?
	JRST	STAS.2			;NO, DUMP IT OUT
	$RET				;YES, RETURN
;STIMG -- Routine to transfer User's IMAGE mode deck to disk.
;	Deck ends on CDR-EOF or Image Terminator.

STIMG:	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

STIM.1:	PUSHJ	P,CDRIMG		;GET IMAGE MODE CARD
	LDB	T2,P.CL1I		;GET IMAGE COLUMN 1
	CAIE	T2,7777			;FULLY LACED?
	JRST	STIM.2			;NO, NOT END OF DECK
	LDB	T2,T1			;YES, GET SPECIFIED TERM COLUMN
	CAIN	T2,7777			;FULLY LACED?
	JRST	STIM.3			;YES, CHECK ALL OTHER COLS FOR ZEROES

STIM.2:	AOS	DEKCRD			;INCREMENT CARD COUNT
	MOVE	S1,FILIFN		;GET THE IFN
	HRL	S2,L.CLEN		;GET COUNT,,0
	HRR	S2,L.CASC		;GET COUNT,,ADR
	$CALL	F%OBUF			;WRITE OUT THE CARD
	JUMPT	STIM.1			;AND LOOP IF OK
	JRST	FILERR			;ELSE GIVE UP

STIM.3:	PUSH	P,L.CASC		;SAVE FIRST WORD
	PUSH	P,(T1)			;AND WORD WITH TERMINATOR
	SETZ	T3,0			;CLEAR A COUNTER
	DPB	T3,P.CL1I		;ZERO OUT FIRST COLUMN
	DPB	T3,T1			;AND TERMINATOR COLUMN

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

	POP	P,(T1)			;RESTORE TERMINATOR COLUMN
	POP	P,L.CASC		;AND FIRST COLUMN
	PUSHJ	P,CDRASC		;READ A CARD
	POPJ	P,			;AND END THE DECK

STIM.5:	POP	P,(T1)			;RESTORE TERMINATOR COLUMN
	POP	P,L.CASC		;RESTORE FIRST COLUMN
	JRST	STIM.2			;ITS A DATA CARD!!
TOPS10 <

COMMENT	\
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).
\

STBIN:	PUSHJ	P,CDRBIN		;GET A CARD
	JUMPF	STBI.1
	AOS	DEKCRD			;INCREMENT CARD COUNT
	MOVE	S1,FILIFN		;GET THE IFN
	HRL	S2,L.CLEN		;GET COUNT,,0
	HRR	S2,L.CHOL		;GET COUNT,,ADR
	$CALL	F%OBUF			;WRITE OUT THE CARD
	JUMPT	STBIN			;AND LOOP IF OK
	JRST	FILERR			;ELSE GIVE UP

STBI.1:	PUSHJ	P,CDRASC		;READ A CARD
	$RETT
>;END TOPS10

TOPS20 <
STBIN:	$STOP(TSB,Tried stacking binary cards)
>;END IFN FTJSYS


;BYTE POINTERS FOR STIMG AND STBIN
P.ICOL:	POINT	12,L.CASC,35		;THIRD BYTE OF WORD
P.CL1I:	POINT	12,L.CASC,11		;FIRST BYTE OF WORD
	POINT	12,L.CASC,23		;SECOND BYTE OF WORD
	POINT	12,L.CASC,35		;THIRD BYTE OF WORD
SUBTTL	Read a card  --  CDRASC - in ASCII and 026

CDRASC:	$CALL	.SAVET			;SAVE THE T REGS
	SETZM	TRLCRD			;CLEAR HEADER/TRAILER CARD COUNT
	SETZM	L.CSUP			;CLEAR SUPPRESSED LENGTH
	SETZM	L.CLEN			;CLEAR ACTUAL LENGTH
CDRA.A:	SETZM	L.TFLG			;CLEAR HEADER/TRAILER FLAG
	TXZ	F,F.RSCN		;CLEAR RESCAN BIT
	SETZM	L.BRK			;CLEAR BREAK FLAG
	SETZM	L.NHOL			;CLEAR  # OF HOL ERRORS
	SETZM	LINCHK			;CLEAR FLAG
	LOAD	S1,L.INF,FP.RCF
	MOVSS	S1			;PUT CODE IN LEFT HALF
	MOVSI	T1,-MODCNT		;MAKE AOBJN POINTER
TOPSRC:	MOVE	T2,MODTBL(T1)		;GET TABLE ITEM
	HRR	S1,MODTBL(T1)		;PLANT THIS ADDRESS FOR COMPARE
	CAMN	S1,T2			;MATCH?
	JRST	(S1)			;YUP, BRANCH
	AOBJN	T1,TOPSRC		;LOOP FOR ALL
	$STOP	(URM,<Unknown Recording Mode(^O/S1,LHMASK/) Error in NEXTJOB Message>)
CDR.AI:	MOVE	S1,L.IFN		;GET THE IFN
	$CALL	F%CHKP			;GET CURRENT POSITION
	ADDI	S1,CPC			;POINT TO NEXT CARD
	MOVEM	S1,CDRA.F		;STORE TO POSITION LATER
	MOVEI	T1,1			;START THE COUNTER
	MOVE	T2,[POINT 7,L.CASC]
	MOVE	T3,[POINT 7,L.C026]

CDRA.B:	MOVE	S1,L.IFN		;GET THE IFN
	$CALL	F%IBYT			;GET A BYTE
	JUMPF	INFAIL			;???
	TXNE	S2,1B20			;WAS IT A HOLLERITH ERROR?
	JRST	CDRA.G			;YES
CDRA.C:	MOVE	S1,S2
	LSHC	S1,-2
	LSH	S1,-7
	LSHC	S1,2
	LOAD	S2,CODTBL(S1),CODASC
	IDPB	S2,T2
	LOAD	S2,CODTBL(S1),COD026
	CAIN	S2,173			;ALTERNATE "?"?
	MOVEI	S2,77			;YES, MAKE IT REAL "?"
	CAIN	S2,175			;ALTERNATE ":"?
	MOVEI	S2,72			;YES, MAKE IT REAL ":"
	IDPB	S2,T3			;DEPOSIT CHARACTER IN BUFFER
	CAIE	S2,40			;IS IT A SPACE?
	MOVEM	T1,L.CSUP		;NO, COUNT IT
	MOVEM	T1,L.CLEN		;SAVE CURRENT LENGTH
	CAMGE	T1,L.WIDT		;GOT THEM ALL?
	AOJA	T1,CDRA.B		;NO, LOOP

	MOVEI	S1,.CHCRT		;LOAD A CR
	IDPB	S1,T2			;STORE IN ONE
	IDPB	S1,T3			;STORE IN THE OTHER
	MOVEI	S1,.CHLFD		;LOAD A LF
	IDPB	S1,T2			;STORE IN ONE
	IDPB	S1,T3			;STORE IN THE OTHER
CDRA.D:	MOVE	S1,L.IFN		;GET THE IFN
	MOVE	S2,CDRA.F		;GET POSITION OF NEXT CARD
	$CALL	F%POS			;AND POSITION IT
	JUMPT	CDRA.E			;JUMP IF OK
	MOVE	S1,L.IFN		;ELSE, GET THE IFN
	SETO	S2,			;SET EOF
	$CALL	F%POS			;AND SET EOF FOR NEXT TIME
CDRA.E:	AOS	CDRCNT			;ONE MORE!
	SKIPN	L.NHOL			;ANY HOLLERITH ERRORS?
	JRST	CDRA.I			;NO, PREPARE TO RETURN

$TEXT(LOGTXT,<^I/STERR/%SPTHOL  ^D/L.NHOL/ Hollerith errors in card #^D/CDRCNT/>)
	AOS	DEKCRD			;GIVE THE CORRECT COUNT
	SKIPE	FILIFN			;ARE WE IN A DECK?
	PUSHJ	P,CARDID		;YES, GIVE CARD INFO
	SOS	DEKCRD			;BRING COUNT INTO PHASE AGAIN
	PUSHJ	P,LOGCRL		;IDENTIFY THE 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
	$TEXT(LOGTXT,<^I/FATAL/?SPTTMH  ^I/CDR.E1/>)
	JSP	B,PROCER
CDR.E1:	ITEXT	(<Too many Hollerith errors>)

CDRA.F:	BLOCK	1			;STORAGE FOR THE POSITION

CDRA.G:	ANDI	S2,7777			;CHECK FIRST COLUMN OF CARD
	CAXE	S2,3776			;LOOK LIKE A HEADER CARD?
	JRST	CDRA.H			;NO
	MOVE	S1,L.IFN		;YES, BUT MAKE SURE
	$CALL	F%IBYT
	JUMPF	INFAIL
	ANDI	S2,7777
	CAXE	S2,7777			;NOW, IS IT REALLY?
	JRST	[AOS L.NHOL
		JRST CDRA.H]
	AOS	TRLCRD			;BY GEORGE IT IS!
	SETOM	L.TFLG			;SET FLAG
	JRST	CDRA.D			;AND FINISH UP THIS CARD
CDRA.H:	AOS	L.NHOL			;COUNT HOLLERITH ERROR
	MOVEI	S2,CODHER		;LOAD UP STANDARD ERROR CODE
	JRST	CDRA.C			;AND CONTINUE PROCESSING

CDRA.I:	SKIPE	L.TFLG			;FLAG SET?
	JRST	[MOVE	S1,L.DWID
		MOVEM	S1,L.WIDT
		JRST	CDRA.A]
	SKIPN	TRLCRD			;ANY TRAILER CARDS PASSED OVER?
	POPJ	P,0			;RETURN
	SKIPE	FILIFN
$TEXT	(LOGTXT,<^I/STSUM/^D/TRLCRD/ Header/Trailer cards ignored in file ^F/FILFD/>)
	SKIPN	FILIFN
$TEXT	(LOGTXT,<^I/STSUM/^D/TRLCRD/ Header/Trailer cards ignored>)
	POPJ	P,0
CDR.SA:	MOVE	T2,[POINT 7,L.CASC]
	MOVEI	T1,1			;SET CHARACTER COUNT
CDRA.K:	PUSHJ	P,CDRA.L
	JUMPL	S2,FINLIN		;BREAK OUT ON EOL
	IDPB	S2,T2
	CAXE	S2,40
	MOVEM	T1,L.CSUP
	MOVEM	T1,L.CLEN
	CAMGE	T1,L.WIDT
	AOJA	T1,CDRA.K
FINLIN:	SKIPL	LINCHK			;DID WE FIND EOL?
	PUSHJ	P,CDRA.N		;FLUSH REMAINDER FOR LINE
	MOVEI	S2,.CHCRT
	IDPB	S2,T2
	MOVEI	S2,.CHLFD
	IDPB	S2,T2
	SETZ	S2,0
	IDPB	S2,T2
	JRST	CDRA.E

CDRA.L:	SETO	S2,0			;LOAD A NULL
	SKIPE	LINCHK			;FOUND EOL ALREADY?
	$RETT				;YUP, JUST RETURN
CDRA.M:	MOVE	S1,L.IFN		;NO, LOAD THE FILE HANDLE
	$CALL	F%IBYT			;AND GET A BYTE
	JUMPF	INFAIL			;TOO BAD!
	CAXN	S2,.CHCRT		;IS IT A CARRIAGE RETURN?
	JRST	CDRA.M			;YES, JUST IGNORE IT
	CAXE	S2,.CHLFD		;HOW 'BOUT A LINEFEED?
	$RETT				;NO, RETURN
	SETOM	LINCHK			;YES, SET EOL
	JRST	CDRA.L			;AND RETURN A BLANK

CDR.FA:
$WTOJ(^I/ABTSPR/,<Unsupported Recording Mode specified (^O/[EXP .FPFAS]/)>)
	JRST	RELJOB
MODTBL:	XWD	.FPFAI,CDR.AI		;AUGMENTED IMAGE
	XWD	.FPFSA,CDR.SA		;STREAM ASCII
	XWD	.FPFAS,CDR.FA		;FIXED ASCII
MODCNT==.-MODTBL			;COUNT FOR AOBJN

CDRA.N:	PUSHJ	P,CDRA.L		;GET THE NEXT CHARACTER
	SKIPL	LINCHK			;DONE?
	JRST	CDRA.N			;NO, LOOP
	POPJ	P,0			;YES, RETURN
SUBTTL	Read a card  --  CDRIMG - in IMAGE

; CDRIMG -- Routine to read one card in Image mode.

;CALL:
;	PUSHJ P,CDRIMG
;	RETURN HERE ALWAYS
;
;	ON NORMAL RETURN 'L.CASC' CONTAINS CARD IMAGE IN
;	12-BIT PACKED BYTES.

CDRIMG:	$CALL	.SAVET			;SAVE T1 THRU T4
	MOVEI	T1,CPC			;GET COLUMNS/CARD
	MOVE	T2,[POINT ^D12,L.CASC]	;SETUP BYTE POINTER

CDRIM1:	MOVE	S1,L.IFN		;GET THE IFN
	$CALL	F%IBYT			;GET A BYTE
	JUMPF	INFAIL			;IO ERROR
	IDPB	S1,T2			;DEPOSIT THE BYTE
	SOJG	T1,CDRIM1		;AND LOOP

	MOVEI	T1,IWPC			;LOAD # IMAGE WORD/CARD
	MOVEM	T1,L.CLEN		;STORE IN COUNT WORD
	AOS	CDRCNT			;ONE MORE!!
	POPJ	P,			;AND RETURN
SUBTTL	Read a card  --  CDRBIN - in Checksummed Binary

TOPS10 <
; 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.CASC'
;
; ON NORMAL RETURN BINARY IS PACKED IN 12-BIT PACKED BYTES  IN
; LINE BUFFER 'L.CASC', AND L.CLEN IS SET TO WORD COUNT.

CDRBIN:	MOVE	S1,L.IFN		;GET THE IFN
	$CALL	F%IBYT			;GET COLUMN 1
	JUMPF	INFAIL			;???
	ANDI	S1,7777			;GET RID OF AUGMENTATION
	TRC	S1,.IM79		;REVERSE ROWS 7 AND 9
	TRCE	S1,.IM79		;WERE THEY BOTH ON?
	JRST	CDRB.5			;NOPE!!
	LSH	S1,-6			;RIGHT JUSTIFY WORD COUNT
	MOVEM	S1,L.CLEN		;AND STORE IT

	MOVE	S1,L.IFN		;GET THE IFN
	$CALL	F%IBYT			;GET COLUMN 2
	ANDI	S1,7777			;GET RID OF EXTRA STUFF
	MOVEM	S1,L.CCHK		;AND STORE THE CHECK SUM

	MOVEI	T1,^D78			;NUMBER OF COLUMNS LEFT TO READ
	MOVE	T2,L.CLEN		;NUMBER OF SIGNIFICANT WORDS
	IMULI	T2,3			;CONVERT TO COLUMNS

CDRB.1:	MOVE	S1,L.IFN		;GET THE IFN
	$CALL	F%IBYT			;GET A COLUMN
	JUMPF	INFAIL			;LOSE, I GUESS
	IDPB	S1,B			;DEPOSIT IT
	SOJ	T1,			;DECREMENT COUNT OF COLMNS
	SOJG	T2,CDRB.1		;AND LOOP FOR SIGNIFICANT ONES

CDRB.2:	SOJL	T1,CDRB.3		;DID WE GET ALL 80?
	MOVE	S1,L.IFN		;GET THE IFN
	$CALL	F%IBYT			;GET A COLUMN
	JUMPF	INFAIL			;AND LOSE
	JRST	CDRB.2			;AND LOOP FOR THEM ALL
;HERE TO CHECK CHECKSUM AND RETURN
CDRB.3:	AOS	CDRCNT			;COUNT ANOTHER CARD
	MOVN	T4,L.CLEN		;GET NEG WORD COUNT
	HRLZ	T4,T4			;PUT IN LEFT HALF
	ADDI	T4,L.CASC		;MAKE AOBJN POINTER
	SETZ	T3,0			;ACCUMULATE CHECKSUM HERE

CDRB.4:	ADD	T3,(T4)			;ADD A WORD
	AOBJN	T4,CDRB.4		;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
	TXZE	T3,77B23		; 
	AOS	T3
	CAMN	T3,L.CCHK		;DOES IT MATCH CHECKSUM ON CARD
	POPJ	P,			;YUP, RETURN
$TEXT(LOGTXT,<^I/STERR/%SPTBCK  Binary checksum error in card #^D/CDRCNT/>)
	PUSHJ	P,CARDID		;AND CARD INFO
	AOS	T3,L.TCHK		;INCREMENT ERROR COUNT AND LOAD
	CAMG	T3,L.UCHK		;COMPARE AGAINST MAX
	$RETT				;STILL LEGAL
	$TEXT(LOGTXT,<^I/FATAL/?SPTTMC  ^I/CDR4.E/>)
	JSP	B,PROCER			;AND ABORT THE JOB
CDR4.E:	ITEXT	(<Too many binary checksum errors>)

CDRB.5:	CAIN	S2,.IMDOL		;IS COLUMN 1 AN DOLLAR SIGN?
	PJRST	CDRB.6			;YES, CONVERT IT
$TEXT(LOGTXT,<%SPTIBC  Illegal binary card, card #^D/CDRCNT/>)
	PUSHJ	P,CARDID		;WHERE THE CARD IS
	AOS	T3,L.TIBC		;INCREMENT COUNT
	CAMG	T3,L.UIBC		;GREATER THAN ALLOWABLE?
	PJRST	CDRB.6			;NO, JUST IGNORE CARD
	$TEXT(LOGTXT,<^I/FATAL/?SPTTMB  ^I/CDR5.E/>)
	JSP	B,PROCER		;AND DIE
CDR5.E:	ITEXT	(<Too many illegal binary cards>)

CDRB.6:	MOVE	S1,L.IFN		;BACKUP A BYTE
	MOVE	S1,L.IFN		;GET THE HANDLE
	$CALL	F%CHKP			;AND DETERMINE WHERE WE ARE
	JUMPF	INFAIL			;LOSE
	MOVEI	S2,-1(S1)		;BACK OFF BY ONE
	MOVE	S1,L.IFN		;DO'IT AGAIN
	$CALL	F%POS			;POSITION FOR REREAD OF LAST BYTE
	JUMPF	INFAIL			;LOSE
	$RETF
>;END TOPS10
SUBTTL	INFAIL  -  Input failure from source file

INFAIL:	CAIN	S1,EREOF$		;IS IT END OF FILE?
	JRST	ENDJOB			;YES, GOOD-BYE
	$TEXT(LOGTXT,<^I/FATAL/?SPTERI  ^I/INFA.1/>)
	JSP	B,PROCER
INFA.1:	ITEXT	(<Error reading input file>)


SUBTTL	FILERR  -  Error writing user file

FILERR:	MOVE	P1,S1			;RELOCATE ERROR CODE
	$TEXT(LOGTXT,<^I/FATAL/?SPTEWF  ^I/FLER.1/>)
	JSP	B,PROCER			; 
FLER.1:	ITEXT	(<Error writing file ^F/FILFD/, ^E/P1/>)


;HERE TO TYPE OUT  "CARD 3 IN FILE FOO.BAR"
CARDID:	$TEXT(LOGTXT,<^I/STERR/- Card #^D/DEKCRD/ in file ^F/FILFD/>)
	POPJ	P,			;AND RETURN
SUBTTL	Accounting File Handlers


TOPS10 <
;***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.
/

	.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

;FD FOR SYS:AUXACC.SYS
AUXFD:	$BUILD	FDMSIZ
	$SET	(.FDLEN,FD.LEN,FDMSIZ)
	$SET (.FDSTR,,<SIXBIT/SYS/>)
	$SET	(.FDNAM,,<SIXBIT/AUXACC/>) ;FILENAME
	$SET	(.FDEXT,,<SIXBIT/SYS/>)	;EXTENSION
	$SET	(.FDPPN,,0)		;PPN
	$EOB

;FD FOR SYS:ACCT.SYS
ACTFD:	$BUILD	(FDMSIZ)		;FD SIZE
	$SET	(.FDLEN,FD.LEN,FDMSIZ)	; 
	$SET (.FDSTR,,<SIXBIT/SYS/>)
	$SET	(.FDNAM,,<SIXBIT/ACCT/>) ;FILENAME
	$SET	(.FDEXT,,<SIXBIT/SYS/>)	;EXTENSION
	$SET	(.FDPPN,,0)		;PPN
	$EOB
;BILDAC -- Routine to build in-core ACCT.SYS index
;	and AUXACC.SYS Index.

BILDAC:	PUSHJ	P,LKACC			;GO CHECK FOR ACCT.SYS CHANGE
	JUMPT	.POPJ			;TABLES ARE CURRENT

;GET RECORD SIZE STORED IN FIRST WORD OF ACCOUNTING FILE
	MOVE	S1,L.AIFN		;GET ACCOUNTING IFN
	SETZ	S2,0			;POINT TO FIRST WORD
	$CALL	F%POS			;POSITION
	JUMPF	ACTERR			;IN CASE IT FAILS
	MOVE	S1,L.AIFN		;GET OUR IFN AGAIN
	$CALL	F%IBYT			;GET FIRST WORD FOR ENTRY SIZE
	JUMPF	ACTERR			;FAILED?
	HRRZM	S2,L.ESIZ		;SAVE ENTRY SIZE

;ALLOCATE CORE FOR THE PARALLEL TABLES
	MOVE	S1,L.ASIZ		;GET THE SIZE OF THE FILE
	ASH	S1,2			;DOUBLE IT (FOR AUXACC INDEX)
	ADDI	S1,777			;FORCE THE DIVIDE TO ROUND UP
	IDIVX	S1,PAGSIZ		;CONVERT IT TO PAGES
	MOVEM	S1,L.ANPG		;SAVE NUMBER OF PAGES
	$CALL	M%AQNP			;GET THE CORE
	PG2ADR	S1			;CONVERT TO AN ADDRESS
	MOVEM	S1,L.APAG		;SAVE THE PAGE ADDRESS

	MOVEI	T2,200			;CALCULATE SIZE OF
	IDIV	T2,L.ESIZ		;RECORD RESIDUE (IT'S IN T3)
	MOVEI	T1,1			;POINT TO FIRST PPN RECORD IN FILE
	MOVE	T2,L.APAG		;LOAD TABLE ADDRESS
BILD.1:	MOVE	S1,L.AIFN		;GET IFN FOR ACCT.SYS
	MOVE	S2,T2			;CALCULATE THE BEGINNING
	SUB	S2,L.APAG		;BYTE POINTER FOR THE
	IMULI	S2,200			;APPROPRIATE PAGE.
	ADDI	S2,(T1)			;ADD IN COMPUTED OFFSET
	$CALL	F%POS			;POSITION TO IT
	MOVE	S1,L.AIFN		;GET IFN AGAIN
	$CALL	F%IBYT			;GET PPN OF THIS RECORD
	JUMPF	[CAXE	S1,EREOF$
		JRST	ACTERR
		JRST	BILAUX	]
	SKIPN	S2			;TEST FOR NULL
	MOVX	S2,.INFIN		;MAKE IT A LARGE NUMBER THEN
	MOVEM	S2,(T2)			;STORE IN TABLE
	SUB	T1,T3			;COMPUTE OFFSET FOR NEXT PAGE
	SKIPGE	T1			;DON'T LET IT GO NEGATIVE THOUGH
	ADD	T1,L.ESIZ		;FIX IT UP IF IT DID
	AOJA	T2,BILD.1		;LOOP AROUND

		;FALL THRU INTO BILAUX ROUTINE
BILAUX:	MOVE	T2,L.APAG		;MAKE T2 POINT TO ACCT TABLE
	SUBI	T2,1			;MAKE AUX AND ACT TABLES PARALLEL
	MOVE	T1,L.ASIZ		;GET THE SIZE OF ACCT TABLE
	ADD	T1,L.APAG		;MAKE T1 POINT TO AUXACC TABLE
	MOVEI	T4,-1(T1)		;END OF TABLE MARKER
	MOVE	S1,L.XIFN		;GET THE IFN
	SETZB	S2,P2			;INDICATE FIRST BYTE
	$CALL	F%POS			;AND POSITION
BILAU0:	PUSHJ	P,AUXSCN		;GET NEXT AUXACC ENTRY
BILAU1:	MOVEM	P2,(T1)			;SAVE BYTE POINTER
	AOS	T2			;INCREMENT ACCT INDEX
	CAML	T2,T4			;DONE?
	$RETT				;YUP
BILAU2:	CAML	T2,L.APAG		;DON'T DO COMPARE IF FIRST ENTRY
	CAML	S2,(T2)			;AUXACC ENTRY .LT. ACCT?
	AOJA	T1,BILAU1		;NO, INCREMENT AUXACC PTR
BILAU3:	MOVEM	P2,(T1)			;SAVE BYTE POINTER IN AUXACC TABLE
	PUSHJ	P,AUXSCN		;GET NEXT AUXACC ENTRY
	SKIPT
	MOVX	S2,.INFIN		;MAKE IT A LARGE PPN
	JRST	BILAU2			;AND REENTER LOOP

COMMENT	\
AUXSCN - Routine to scan for the beginning of an entry. First word of
each  entry  contains  a  -1.  On  return  P1  =  count  of STR words
following.  The PPN is returned in S2. P2 contains the relative  file
byte  position  of  this  AUXACC entry. Note, it always points to the
[-1] word.
\

AUXSCN:	MOVE	S1,L.XIFN		;GET OUR IFN
	$CALL	F%IBYT			;GET THE NEXT WORD
	JUMPF	AUXERR			;ERROR
	CAME	S2,[-1]			;BEGINNING OF NEXT ENTRY?
	JRST	AUXSCN			;NO, KEEP GOIN'
	MOVE	S1,L.XIFN		;GET THE IFN
	$CALL	F%CHKP			;DETERMINE OUR POSITION
	MOVEI	P2,-1(S1)		;POINT TO THE [-1]
	MOVE	S1,L.XIFN		;GET OUR IFN AGAIN
	$CALL	F%IBYT			;GET THE SIZE
	MOVE	P1,S2			;RELOCATE IT
	MOVE	S1,L.XIFN		;THE IFN
	$CALL	F%IBYT			;GET THE PPN
	JUMPF	AUXERR			;FALSE RETURN ALWAYS AN ERROR
	$RETT
;LKACC -- Routine to determine whether ACCT.SYS has changed

;CALL:
;	PUSHJ P,LKACC
;	Returns FALSE if table must be rebuilt else TRUE

LKACC:	MOVEI	P1,1			;PREPARE AN INDEX
	SKIPL	L.AIFN			;FIRST TIME THRU?
	JRST	LKAC.2			;NO, SEE IF INCORE TABLES VALID

;Here to reopen accounting files  and  rebuild  the  in-core
;indeces
LKAC.1:	MOVE	S1,[EXP AUXFD
		    EXP ACTFD](P1)	;POINT TO PROPER FD
	PUSHJ	P,ACTOPN		;AND OPEN THE FILE
	MOVEM	S1,@[L.XIFN
		     L.AIFN](P1)	;SAVE THE IFN
	MOVX	S2,FI.CRE		;GET THE CREATION DATE
	$CALL	F%INFO			;..
	MOVEM	S1,@[L.XDAT
		     L.ADAT](P1)	;SAVE IT
	SOJGE	P1,LKAC.1		;LOOP FOR BOTH FILES
	MOVE	S1,L.AIFN		;DETERMINE SIZE OF ACCT.SYS
	MOVX	S2,FI.SIZ
	$CALL	F%INFO			; 
	IDIVI	S1,200
	SKIPE	S2			;ROUND UP
	AOS	S1		;..
	MOVEM	S1,L.ASIZ		;SAVE IT
	MOVE	T1,[XWD L.PPTB,L.PPTB+1] ;ZERO REMEMBERED
	SETZM	L.PPTB			;ENTRIES
	BLT	T1,L.PPTB+NPPNRM-1	;..
	$RETF

;HERE TO DETERMINE IF IN-CORE TABLES ARE VALID
LKAC.2:	JUMPL	P1,.RETT		;WE'RE DONE
	MOVE	S1,[EXP AUXFD
		    EXP ACTFD](P1)	;OPEN FILE ON TMP CHANNEL
	PUSHJ	P,ACTOPN		;..
	MOVE	P2,S1			;RELOCATE IFN FOR LATER
	MOVX	S2,FI.CRE		;GET THE CREATION DATE
	$CALL	F%INFO			;..
	EXCH	S1,P2			;XCHANGE AC'S FOR RELEASE
	PUSHJ	P,F%RREL		;RELEASE TMP CHANNEL
	CAMN	P2,@[EXP L.XDAT
		     EXP L.ADAT](P1)	;INCORE INDECES VALID?
	SOJA	P1,LKAC.2		;LOOP FOR BOTH FILES
	MOVEI	P1,1			;SETUP INDEX
	JRST	LKAC.1			;REBUILD INDECES
COMMENT	\
Routine to open either of the accounting  files  for  input.
The data mode is binary and any failures stopcode.
\

ACTOPN:	PUSH	P,S1			;SAVE ADDRESS OF THE FD
	PUSHJ	P,CLRFOB		;ZERO THE FOB BLOCK
	POP	P,S1			;RESTORE ADR OF FD
	STORE	S1,L.FOB+FOB.FD		;SAVE IT IN THE FOB
	MOVEI	S1,^D36			;LOAD THE BYTE SIZE
	STORE	S1,L.FOB+FOB.CW,FB.BSZ	;STORE IT
	MOVX	S1,FOB.MZ		;SIZE OF THE FOB
	MOVEI	S2,L.FOB		;STORE IT
	$CALL	F%IOPN			;OPEN THE FILE
	JUMPT	.RETT			;RETURN ON SUCCESSFUL OPEN
	JRST	NOACCT			;GO STOPCODE
COMMENT	%
SRHACC  --  Routine  to search ACCT.SYS for a PPN. Call SRHACC
with the PPN in .EQOID. If the entry is found, S1 contains the
index into the cache.

Call:
	PUSHJ P,SRHACC
	  Return here if entry not found
	  Return here otherwise
%

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

	MOVSI	S1,-NPPNRM		;SETUP AOBJN POINTER
	CAMN	T1,L.PPTB(S1)		;START COMPARING DOWN THE TABLE
	JRST	[TLZ	S1,-1
		$RETT		]	;A MATCH!
	AOBJN	S1,.-2			;KEEP LOOPING
	MOVN	T2,L.ASIZ		;GET SIZE OF ACCT.SYS
	HRLZS	T2			;PUT IN LH FOR AOBJN POINTER
	HRR	T2,L.APAG		;AND LOAD START ADDRESS OF TABLE

SRHA.1:	CAMGE	T1,(T2)			;LOOK FOR A BIGGER ENTRY
	JRST	SRHA.2			;FOUND ONE THAT'S BIGGER
	AOBJN	T2,SRHA.1		;LOOP FOR ENTIRE TABLE

SRHA.2:	MOVEI	T2,(T2)			;ISOLATE ADDRESS PORTION
	SUB	T2,L.APAG		;CONVERT TO RELATIVE INDEX
	SUBI	T2,1			;ADJUST FOR RELATIVE BYTE
	HRRZM	T2,CSHIDX		;SAVE IT AWAY
	HRRZ	T3,T2			;TAKE A COPY
	IMULI	T2,200			;COMPUTE BYTE NUMBER
	ASH	T3,7			;GET NUMBER OF WORDS BEFORE THIS BLOCK
	IDIV	T3,L.ESIZ		;DIVIDE BY ENTRY SIZE
	SUBI	T4,1			;ALLOW FOR THE FORMAT WORD
	MOVNS	T4			;AND NEGATE
	SKIPGE	T4			;MAKE SURE IT'S POSITVIVE
	ADD	T4,L.ESIZ		;IT IS NOW!

SRHA.4:	MOVE	S1,L.AIFN		;GET OUR FILE HANDLE
	HRRZ	S2,T2			;CALCULATE BYTE POSITION
	ADDI	S2,(T4)			;OF NEXT RECORD
	$CALL	F%POS			;AND CAUSE POSITIONING TO HAPPEN
	JUMPF	ACTERR			;BOO!
	MOVE	S1,L.AIFN		;GET OUR IFN AGAIN.........
	$CALL	F%IBYT			;AND JUMP ON THE NEXT BYTE
	JUMPF	ACTERR
	CAMN	S2,T1			;THIS THE ONE WE'RE LOOKIN' FOR?
	JRST	SRHA.5			;SURE IS
	ADD	T4,L.ESIZ		;STEP TO THE NEXT
	CAIG	T4,177			;AND MAKE SURE WE DON'T JUMP THE BLOCK BOUNDARY
	JRST	SRHA.4			;JUMP
	$RETF				;FALL OVER!

SRHA.5:	ADDI	T2,(T4)			;POINT TO CURRENT RECORD
	MOVSI	T4,-SRHATX		;OUTER LOOP CONTROL
	JRST	SRHA.7			;SAVE THE PPN WE'VE GOT

SRHA.6:	MOVE	S1,L.AIFN		;GET THE IFN
	HLRZ	S2,SRHATB(T4)
	ADDI	S2,(T2)			;COMPUTE RELATIVE BYTE POSITION
	$CALL	F%POS			;AND POSITION TO IT
	JUMPF	ACTERR			;BLAH!
	MOVE	S1,L.AIFN		;THE INFAMOUS IFN AGAIN
	$CALL	F%IBYT			;GET THE BYTE
	JUMPF	ACTERR			;OR AT LEAST TRY
SRHA.7:	HRRZ	S1,SRHATB(T4)		;GET STORAGE ADDRESS
	ADD	S1,L.RPRG		;COMPUTE WHERE TO STORE DATUM
	MOVEM	S2,(S1)			;AND STORE IT AWAY
	AOBJN	T4,SRHA.6		;LOOP APPROPRIATELY
	MOVE	S1,L.RPRG		;LOAD CURRENT REPLACEMENT INDEX
	SETZM	L.AUTB(S1)		;CLEAR AUXACC POINTER
	$RETT				;AND RETURN TO SEQUENCE

;NOTE THAT THIS TABLE SHOULD NOT BE CHANGED AS TO ORDER
;AND POSITION OF .A2PPN ENTRY.
SRHATB:	XWD	.A2PPN,L.PPTB		;PPN
	XWD	.A2PSW,L.PSTB		;PASSWORD
	XWD	.A2NAM,L.UNTB		;FIRST HALF OF NAME
	XWD	.A2NAM+1,L.U2TB		;SECOND HALF
	XWD	.A2PRF,L.PRTB		;PROFILE
SRHATX==.-SRHATB			;SIZE OF TABLE
COMMENT	\
SRHAUX  --  Routine  to search AUXACC.SYS. Starts searching at
word specified by  in-core  index.  Returns  "TRUE"  if  entry
found,  with  the  second  word  .AUNUM in P1 and next call to
RDAUX will get first STR name.
Enter with S1=Replacement register index.

Caution:  The loops in this routine are strangely nested, read
it slowly.
\

SRHAUX:	MOVE	P3,S1			;SAVE REPL. REG. FOR LATER
	SKIPE	T1,L.AUTB(S1)		;IS THIS A WINNER?
	JRST	SRHU.1			;YUP, WE'VE GOT ALL WE NEED
	MOVE	T1,CSHIDX		;GET SAVED INDEX INTO TABLE
	ADD	T1,L.APAG		;GET THE APPROPRIATE
	ADD	T1,L.ASIZ		;AUXACC
	MOVE	T1,(T1)			;ENTRY.
SRHU.1:	MOVE	S1,L.XIFN		;POSITION TO THE
	HRRZ	S2,T1			;APPROPRIATE BYTE
	$CALL	F%POS			; 
	JUMPF	AUXERR
	MOVE	T2,.EQOID(Q)		;GET USER'S PPN
	TRNE	T2,1B18			;FUNNY NUMBER?
	HRRI	T2,777776		;YES, GET STANDARD FLAG FOR IT
	JRST	SRHU.3			;AND JUMP INTO THE LOOP

SRHU.2:	HLRZ	T3,S2			;GET ENTRIES PROJ # IN T3
	HLRZ	T1,T2			;GET USER'S  PROJ # IN T1
	CAMN	T1,T3			;ARE THEY THE SAME PROJECT?
	JRST	SRHU.4			;YES, CHECK IT OUT
	CAMG	T1,T3			;NO, IT USER'S BIGGER?
	$RETF				;NO, USER'S IS SMALLER, ENTRY IS
					; NOT THERE.

SRHU.3:	PUSHJ	P,AUXSCN		;GET THE NEXT ENTRY
	MOVEM	P2,L.AUTB(P3)		;SAVE THE AUXACC POINTER
	JUMPF	.RETF			;EOF, NO ENTRY!!
	CAMN	S2,T2			;EXACT MATCH?
	PJRST	SRHU.6			;YES, HOW LUCKY
	JRST	SRHU.2			;NO, LOOP TILL WE GET THERE

SRHU.4:	TRC	S2,-1			;TRICK THE PROG NUMBER
	TRCN	S2,-1			;TRICK BACK AGAIN
	PJRST	SRHU.6			;ALL 1'S IS WILDCARD, RETURN
	JRST	SRHU.3			;AND LOOP

SRHU.6:	MOVE	S1,.EQOID(Q)		;GET REAL PPN
	TRNE	S1,1B18			;FUNNY NUMBER?
	HRRI	S1,-2			;YES
	MOVE	S2,L.RPRG		;GET REPL REG AGAIN
	CAME	S1,L.PPTB(S2)		; 
	$RETT				; 

;Routine to increment the replacement register
	AOS	T1,L.RPRG		;INCREMENT AND LOAD
	IDIVI	T1,NPPNRM		;DIVIDE BY MAX
	MOVEM	T2,L.RPRG		;STORE RESULT MOD NPPNRM
	$RETT				;AND SKIP BACK
COMMENT	%
MAKSL -- Routine To Generate a Search List Call  with  RDAUX
ready  to read user's first structure name and P1 containing
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.
%

MAKSL:	$CALL	.SAVE1			;SAVE P1
	MOVEI	P3,L.SL2+1		;WHERE TO START STORING ARGS

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

MAKS.1:	MOVE	S1,L.XIFN		;GET THE IFN
	$CALL	F%IBYT			;GET THE STRUCTURE NAME
	JUMPF	AUXERR
	MOVEM	S2,(P3)			;STORE STRUCTURE NAME
	SETZM	1(P3)			;2ND WORD OF TRIPLET IS 0
	PUSH	P,P3			;SAVE P3
	PUSHJ	P,MAKPTH		;MAKE UFD AND SFD
	POP	P,P3			;RESTORE P3
	  JUMPF	MAKS.3			;MAKPTH SAYS DON'T USE THIS ONE
	MOVE	S1,L.XIFN		;GET THE IFN
	$CALL	F%IBYT			;GET THE STATUS BITS
	JUMPF	AUXERR
	MOVEM	S2,2(P3)		;STORE THEM
MAKS.2:	ADDI	P3,3			;POINT TO NEXT ENTRY
	SKIPA
MAKS.3:	SOS	T3			;ONE LESS FOR STRUUO
	SOJG	T4,MAKS.1		;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,.EQPAT(Q)		;SETUP TO BLT THE PATH
	BLT	T2,SLLEN+.PTPPN+5(T1)	;BLT THE FULL PATH
	MOVX	T2,.PTSCN		;/NOSCAN
	MOVEM	T2,L.SL2+SLLEN+.PTSWT	;STORE SWITCH
	PJRST	SETSRC			;SET THE S/L, PATH  AND RETURN
SUBTTL	MAKPTH -- Routine to create UFD and SFD on a STR.

COMMENT	\
MAKPTH -- Routine to create UFD and SFD on a STR. Call with S2
containing structure name.

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:	MOVE	P1,[ELBLOK,,ELBLOK+1]
	SETZM	ELBLOK			;CLEAR THE FIRST WORD
	BLT	P1,ELBLOK+.RBAUT 	;CLEAR THE WHOLE UUO BLOCK
	MOVX	P1,.IODMP		;USE DUMP MODE
	MOVE	P2,S2			;GET STR NAME
	MOVEM	P2,L.UFIN+1		;SAVE FOR STRUUO TO LOCK UFD
	SETZ	P3,0			;NO BUFFERS
	OPEN	UFD,P1			;OPEN THE CHANNEL
	  JRST	MAKP.5			;CAN'T DO IT

	MOVEI	P1,.RBAUT		;START SETTING UP UUOBLK
	MOVEM	P1,ELBLOK		;FIRST WORD
	MOVE	P1,.EQOID(Q)		;HIS PPN IS FILENAME
	MOVEM	P1,ELBLOK+.RBNAM 	;STORE IT
	MOVEM	P1,L.UFIN+2		;SAVE FOR STRUUO TO LOCK UFD
	MOVSI	P1,'UFD'
	MOVEM	P1,ELBLOK+.RBEXT 	;STORE EXTENSION
	MOVE	P1,L.MFPP		;PUT IT IN MFDPPN
	MOVEM	P1,ELBLOK+.RBPPN
	MOVE	S1,L.XIFN		;GET THE IFN
	$CALL	F%IBYT			;READ AND IGNORE RSVD QUOTA
	JUMPF	AUXERR			;ERROR
	MOVE	S1,L.XIFN		;GET THE IFN
	$CALL	F%IBYT			;READ THE FCFS QUOTA
	JUMPF	AUXERR			;ERROR
	MOVEM	S2,ELBLOK+.RBQTF 	;AND STORE IT
	MOVE	S1,L.XIFN		;IFN
	$CALL	F%IBYT			;READ THE LOG-OUT QUOTA
	JUMPF	AUXERR			;ERROR
	MOVEM	S2,ELBLOK+.RBQTO 	;STORE THAT
	MOVX	S2,RP.DIR		;GET DIRECTORY BIT
	MOVEM	S2,ELBLOK+.RBSTS 	;SAVE AS FILE STATUS

	SKIPN	ELBLOK+.RBQTF		;NO LOGGED IN QUOTA?
	JRST	MAKP.4			;YES, THEN DON'T MAKE A UFD
	SKIPN	P1,.EQPAT+1(Q)		;GET SFD NAME FOR LATER
	JRST	MAKP.1			;NO PATH
	MOVSI	P2,'SFD'		;THE EXTENSION
	SETZ	P3,0
	MOVE	P4,.EQOID(Q)		;AND USER'S PPN
MAKP.1:	PUSHJ	P,SETUFL	;SET THE UFD INTERLOCK
	LOOKUP	UFD,ELBLOK		;LOOKUP THE UFD
	  JRST	MAKP.2			;IT'S NOT THERE! GO ENTER IT
	JRST	MAKP.3			;ITS THERE, GO MAKE AN SFD
MAKP.2:	ENTER	UFD,ELBLOK		;ENTER THE UFD
	  JRST	MAKP.3			;MAYBE ITS THERE!, GO TRY FOR SFD
	USETO	UFD,2			;MAKE 1 BLOCK

MAKP.3:	CLOSE	UFD,			;CLOSE UFD OFF
	JUMPE	P1,MAKP.4		;[1052] RETURN IF NO SFD
	ENTER	UFD,P1			;ENTER THE SFD
	  JFCL				;DON'T WORRY NOW
MAKP.4:	RELEASE	UFD,			;[1052] RELEASE CHANNEL
	$RETT				;AND RETURN

MAKP.5:	MOVEI	P1,.UBKS-1		;SETUP TO READ THE REST OF THE ENTRY
MAKP.6:	MOVE	S1,L.XIFN		;IFN
	$CALL	F%IBYT			;READ THE WORD
	JUMPF	AUXERR			;ERROR
	SOJG	P1,MAKP.6		;AND LOOP
	$RETF				;AND RETURN
SUBTTL	SETUFL -- Routine to set UFD interlock

COMMENT	\
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:	MOVX	T1,.FSULK		;LOCK CODE
	MOVEM	T1,L.UFIN		;STORE IN STRUUO BLOCK
	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:	POP	P,T1			;LOAD RETURN ADDRESS
	PUSHJ	P,(T1)			;CALL HIM BACK
	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:	MOVX	T1,.FSUCL		;UNLOCK CODE
	MOVEM	T1,L.UFIN		;STORE IT
	MOVE	T2,[3,,L.UFIN]
	STRUUO	T2,			;DO THE UUO
	$STOP(CCI,Cant clear UFD Interlock)
	POPJ	P,0			;OK, RETURN
SUBTTL	DOACCT - Do all job accounting

COMMENT	\
DOACCT -- Routine to setup and do all  the  accounting  for  a
job.   Call with the PPN in .EQOID.  Does all the ACCT.SYS and
AUXACC stuff, checks the Password, and sets the Search-List.
\

DOACCT:	MOVE	T1,.EQOID(Q)		;GET THE PPN
	MOVEM	T1,.EQPAT(Q)		;STORE IN PATH BLOCK
	GETLIM	T2,.EQLIM(Q),UNIQ	;GET THE UNIQUENESS
	SETZ	S1,0			;FOR PATCH SPEC.
	CAXE	T2,%EQUYE		;UNIQUE SFD?
	JRST	DO10.A			;NO, CONTINUE
	PUSHJ	P,FUNNY			;MAKE A FUNNY NAME
	TLO	S1,'SF '		;AND MAKE AN OBVIOUS NAME
DO10.A:	MOVEM	S1,.EQPAT+1(Q)		;AND STORE IN THE PATH BLOCK

	PUSHJ	P,SRHACC		;SEARCH FOR THE PPN
	JUMPF	DO10E1			;IT'S NOT THERE!!

	HRRZ	P1,S1			;RELOCATE THE INDEX
	MOVE	T1,L.PRTB(P1)		;GET THE PROFILE WORD
	TXNN	T1,A2.BTC		;CAN IT LOGIN AS BATCH JOB?
	  PJRST	DO10E3			;GUESS NOT!!
	TXNN	T1,A2.BPS		;DOES IT NEED A PASSWORD?
	JRST	DO10.F			;NO, CONTINUE
	PUSHJ	P,CDRASC		;YES, GET A CARD
	MOVE	B,L.DHOL		;GET THE HOLLERITH BP
	ILDB	T1,B			;GET THE FIRST CHARACTER
	CAIE	T1,"$"			;IS IT A $?
	JRST	PSWCTL			;NO, LOSE
	MOVEI	S1,L.TNAM		;POINT TO BLOCK
	PUSHJ	P,S$ASCZ		;COPY THE STRING
	SKIPN	L.TNAM			;TEST FOR NULL ARG
	JRST	DO10.B			;IT IS
	MOVEI	S1,[XWD	1,1
			TB(PASSWORD,0)]
	HRROI	S2,L.TNAM		;POINT TO ARG
	$CALL	S%TBLK
	TXNN	S2,TL%NOM!TL%AMB	;MATCH?
	JRST	DO10.C			;YUP
DO10.B:	MOVE	T1,L.PPN		;GET SPECIFIED PPN
	CAMN	T1,L.EQCP+.EQOID	;SAME AS SUBMITTER?
	JRST	DO10.F			;SURE IS!
	JRST	DOAC.6			;NOPE, BLOW IT OUT
DO10.C:	$TEXT(LOGTXT,<^I/STCRD/$PASSWORD>)
	SETZ	T1,0			;CLEAR FOR RESULT
	MOVE	T3,[POINT 6,T1]		;POINTER FOR RESULT
DO10.D:	ILDB	C,B			;LOOP FOR PASSWORD, GET A CHAR
	SUBI	C,40			;CONVERT TO SIXBIT
	SKIPGE	C			;WAS IT A CONTROL CHAR?
	JRST	DO10.E			;YES, STOP LOOPING
	IDPB	C,T3			;DEPOSIT A CHAR
	TXNE	T3,77B5			;GOT SIX CHARACTERS?
	JRST	DO10.D			;NO, LOOP SOME MORE
DO10.E:	CAME	T1,L.PSTB(P1)		;SEE IF A GOOD PASSWORD
	PJRST	DOAC.6			;LOSE!!
DO10.F:	MOVE	T1,L.PRTB(P1)		;GET THE PROFILE WORD
	TXNN	T1,A2.BNM		;NAME REQURED FOR BATCH?
	JRST	DO10.G			;NO, CONTINUE
	SKIPN	L.UNTB(P1)		;YES, SEE IF ACCT ENTRY IS ZERO
	SKIPE	L.U2TB(P1)		;CHECK SECOND WORD
	SKIPA				;NON-ZERO
	JRST	DO10.H			;ZERO!!, DON'T CHECK
	MOVE	T1,.EQOWN(Q)		;GET FIRST HALF GIVEN
	CAME	T1,L.UNTB(P1)		;MATCH?
	  PJRST	DO10E5			;NO, ERROR
	MOVE	T1,.EQOWN+1(Q)		;GET SECOND HALF
	CAME	T1,L.U2TB(P1)		;MATCH??
	  PJRST	DO10E5			;NO!
	JRST	DO10.H			;ITS OK!!
DO10.G:	SKIPE	.EQOWN(Q)		;DID HE SPECIFY NAME SWITCH?
	JRST	DO10.H			;YES, DON'T PUT IN OFFICIAL NAME
	MOVE	T1,L.UNTB(P1)		;GET FIRST HALF
	MOVEM	T1,.EQOWN(Q)		;STORE IT
	MOVE	T1,L.U2TB(P1)		;GET SECOND HALF
	MOVEM	T1,.EQOWN+1(Q)		;AND STORE IT

DO10.H:	SKIPN	.EQACT(Q)		;ANY ACCOUNT STRING SPECIFIED?
	JRST	DO10.J			;NO, SKIP THIS TEST ENTIRELY
	$CALL	M%GPAG			;GET A PAGE
	MOVE	S2,S1			;RELOCATE ADDRESS
	MOVX	S1,UGVAL$		;VALIDATION CODE
	STORE	S1,UV$TYP(S2)		;STORE AS MESSAGE TYPE
	ZERO	UV$ACK(S2)		;FOR NOW CLEAR ACKNOWLEDGEMENT CODE
	MOVE	S1,L.PPN		;GET PPN FOR USER
	STORE	S1,UV$PPN(S2)		;STORE IN VALIDATION MESSAGE
	HRLI	T1,.EQACT(Q)		;RELOCATE SPECIFIED
	HRRI	T1,UV$ACT(S2)		; ACCOUNT STRING
	BLT	T1,UV$ACE-1(S2)		;..
	ZERO	UV$ACE(S2)		;TERMINATE THE MESSAGE WITH NULL
	MOVX	S1,PAGSIZ		;GET THE SIZE
	PUSHJ	P,SNDACD		;SEND TO ACTDAE
DO10.I:	$CALL	C%BRCV			;WAIT FOR AN ANSWER
	LOAD	T1,MDB.SP(S1)		;GET SENDER'S PID
	LOAD	T2,MDB.MS(S1),MD.ADR	;GET ADDRESS OF MESSAGE
	LOAD	T2,UC$RES(T2)		;GET THE ANSWER
	CALL	C%REL			;RELEASE THE MESSAGE
	CAME	T1,L.SAB+SAB.PD		;IS IT FROM ACTDAE?
	JRST	DO10.I			;NO, IGNORE IT
	CAXE	T2,UGTRU$		;TRUE?
	JRST	DOAC.5			;FAIL
DO10.J:	$TEXT(LOGTXT,<^I/STMSG/[SPTBJD  Batch job's directory is [^A>)
	$TEXT(LOGTXT,<^O/.EQPAT(Q),LHMASK/,^O/.EQPAT(Q),RHMASK/^A>)
	SKIPE	.EQPAT+1(Q)		;ARE THERE ANY?
	$TEXT(LOGTXT,<,^W/.EQPAT+1(Q)/>)
	$TEXT(LOGTXT,<]>)

	PUSHJ	P,CDRASC		;READ NEXT CARD
	MOVX	T1,.FSDSL		;STRUUO CODE
	SETOB	T2,T3			;MY JOB, MY PPN
	MOVX	T4,DF.SRM		;DELETE ALL STRUCTURES
	MOVE	S1,[4,,T1]		;ARG TO STRUUO
	STRUUO	S1,0			;ZAP THE S/L
	  JFCL				;CAN'T SAY WE DIDN'T TRY!
	MOVE	S1,P1			;LOAD REPL. REG.
	PUSHJ	P,SRHAUX		;GET SEARCH AUXACC
	JUMPT	MAKSL			;MAKE SEARCH LIST AND UFD'S
	$TEXT(LOGTXT,<^I/STERR/%SPTNAU  No AUXACC entry>)
	POPJ	P,			;AND RETURN

SNDACD:	STORE	S1,L.SAB+SAB.LN		;STORE THE LENGTH
	STORE	S2,L.SAB+SAB.MS		;AND THE ADDRESS
	MOVX	S1,%SIACT		;GET ACCOUNTING
	GETTAB	S1,0			;DAEMON'S PID
	HALT
	STORE	S1,L.SAB+SAB.PD		;STORE IT
	ZERO	L.SAB+SAB.SI
	MOVEI	S1,SPTPIB		;POINT TO THE PIB
	STORE	S1,L.SAB+SAB.PB		;STORE IT IN THE SAB
	MOVX	S1,SAB.SZ
	MOVEI	S2,L.SAB
	$CALL	C%SEND			;SEND MESSAGE TO ACTDAE
	JUMPT	.RETT
	$STOP	(ASF,ACTDAE Send Failed)

DO10E1:	$TEXT(LOGTXT,<^I/FATAL/?SPTIPN  ^I/DO10E2/>)
	JSP	B,ACTCER			;AND DIE
DO10E2:	ITEXT	(<Invalid directory specification - ^U/.EQOID(Q)/ on Job card>)

DO10E3:	$TEXT(LOGTXT,<^I/FATAL/?SPTPNB  ^I/DO10E4/>)
	JSP	B,ACTCER			; 
DO10E4:	ITEXT	(<Specified PPN may not run BATCH jobs>)

DO10E5:	$TEXT(LOGTXT,<^I/FATAL/?SPTIUN  ^I/DO10E6/>)
	JSP	B,JOBCER			; 
DO10E6:	ITEXT	(<Illegal or missing User Name>)
SUBTTL	Error traps for accounting routines

NOACCT:	$STOP(CRA,Cant read accounting files)
ACTERR:
	$WTOJ(^I/ABTSPR/,<Error Reading System Accounting Files^M^JError was ^E/[-1]/, File was ^F/ACTFD/>,WTOOBJ)
ACTSTP:	$STOP(ERA,Error reading accounting files)
AUXERR:	$WTOJ(^I/ABTSPR/,<Error Reading System Accounting Files^M^JError was ^E/[-1]/, File was ^F/AUXFD/>,WTOOBJ)
	JRST	ACTSTP
BADFOR:	$STOP(BFA,Bad format in accounting files)

PSWCTL:	$TEXT	(LOGTXT,<^I/STERR/  ^I/PSWC.1/>)
	JSP	B,CTLCER		;ABORT
PSWC.1:	ITEXT	(<Card following $JOB card not a control card>)

>;END TOPS10 (FROM WAY-WAY BACK)
TOPS20 <
COMMENT	\
DOACCT  --  Routine  to setup and do all accounting for a job.
Call with User name string in L.UNAM.
\

DOACCT:	MOVX	S1,RC%EMO		;EXACT MATCH ONLY
	HRROI	S2,.EQOWN(Q)		;POINT TO STRING
	RCUSR				;CONVERT IT
	TXNE	S1,RC%NOM		;MATCH?
	JRST	DOAC.3			;NO, TELL HIM
	SETOM	JIBFLG			;SAY JIB IS VALID
	MOVEM	T1,L.USNO		;SAVE RETURNED INFO
	MOVEM	T1,.EQOID(Q)		;SAVE THE OWNER ID
	MOVE	S1,[POINT 7,L.UDIR]	;LOAD A BYTE POINTER
	MOVEM	S1,L.BP			;STORE IT
	$TEXT(DEPBP,<PS:^7/[74]/^T/.EQOWN(Q)/^7/[76]/^0>)
	PUSHJ	P,CDRASC		;GET THE NEXT CARD
	MOVE	B,L.DHOL		;GET THE HOLLERITH BP
	ILDB	T1,B			;GET THE FIRST CHARACTER
	CAIE	T1,"$"			;IS IT A $?
	JRST	MAIN.3			;NO, LOSE
	MOVEI	S1,L.TNAM		;POINT TO BLOCK
	PUSHJ	P,S$ASCZ		;TAKE A COPY
	SKIPN	L.TNAM			;TEST FOR NULL ARGUMENT RETURN
	JRST	DOAC.2			;CONTINUE VALIDATION
	MOVEI	S1,[XWD 1,1
			TB(PASSWORD,0)]
	HRROI	S2,L.TNAM		;POINT TO KEYWORD
	$CALL	S%TBLK
	TXNE	S2,TL%NOM!TL%AMB	;MATCH?
	JRST	DOAC.2			;NO
	$TEXT(LOGTXT,<^I/STCRD/$PASSWORD>)
	MOVEI	S1,L.UPSW		;POINT TO A BLOCK
	PUSHJ	P,S$ASCZ		;AND GET THE STRING
	PUSHJ	P,CDRASC		;ALWAYS READ THE NEXT CARD
DOAC.1:	MOVX	S1,RC%EMO		;EXACT MATCH
	HRROI	S2,L.UDIR		;POINT TO THE STRING
	RCDIR				;GET DIRECTORY NUMBER
	TXNE	S1,RC%NOM		;BETTER BE A MATCH!!
	JRST	DOAC.3			;NO??
	MOVE	S1,T1			;COPY DIR NO INTO S1
	MOVEI	S2,L.UDIN		;POINT TO GTDIR BLOCK

	HRROI	T1,.EQACT(Q)		; 
	SKIPN	.EQACT(Q)		; 
	MOVEM	T1,L.UDIN+.CDDAC	; 
	MOVEI	T1,.CDDAC+1		; 
	MOVEM	T1,L.UDIN+.CDLEN	; 

	HRROI	T1,L.DPSW		;AND PLACE TO STORE PSW
	GTDIR				;GET DIRECTORY INFO
	ERJMP	DOAC.3			;LOSE?
	MOVE	S1,[XWD L.DPSW,L.UPSW]	;SET UP TO TRANSFER
	SKIPE	NOPSW			;PASSWORD IF FLAG SET
	BLT	S1,L.UPSW+7		;ITs SET
	HRROI	S1,L.UPSW		;POINT TO USER STRING
	HRROI	S2,L.DPSW		;POINT TO CORRECT ONE
	$CALL	S%SCMP			;STRING COMPARE ROUTINE
	JUMPN	S1,DOAC.6		;JUMP IF NO MATCH
	MOVE	S1,L.USNO
	HRROI	S2,.EQACT(Q)		; 
	SKIPE	.EQACT(Q)		; 
	VACCT				; 
	ERJMP	DOAC.5			; 
	$RET				;RETURN

DOAC.2:	SKIPE	CDRDEV			;PHYSICAL READER?
	JRST	MSGIMP			;GENERATE AN ERROR
	HRROI	S1,L.EQCP+.EQOWN	;COMPARE DIRECTORIES
	HRROI	S2,.EQOWN(Q)		;..
	PUSHJ	P,S%SCMP		;..
	JUMPN	S1,MSGIMP		;JUMP IF DIFFERENT
	SETOM	NOPSW			;SET PASSWORD FLAG
	JRST	DOAC.1			;BACK INTO PHASE

DOAC.3:	$TEXT(LOGTXT,<^I/FATAL/?SPTUUN  ^I/DOA.3A/>)
	JSP	B,JOBCER
DOA.3A:	ITEXT	(<Unrecognized User Name "^T/.EQOWN(Q)/" on the $JOB card>)

>;END TO TOPS20 CONDITIONAL ASSEMBLY

MSGIMP:	$TEXT(LOGTXT,<^I/FATAL/?SPTIMP  ^I/DOA.4A/>)
	JSP	B,ACTCER			; 
DOA.4A:	ITEXT	(<Incorrect or missing Password card>)

DOAC.5:	$TEXT(LOGTXT,<^I/FATAL/?SPTIAS  ^I/DOA.5A/>)
	JSP	B,ACTCER			; 
DOA.5A:	ITEXT	(<Illegal Account String "^T/.EQACT(Q)/">)

DOAC.6:	$TEXT(LOGTXT,<^I/FATAL/?SPTIMP  ^I/DOA.4A/>)
	JSP	B,PSWCER			; 
DOA.6A:	ITEXT	(<Specified password incorrect for user>)
SUBTTL	Routines to SET and GET Search-List

TOPS10 <

COMMENT	\
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!                               !
;	!=====================================!
;--
;GETSRC -- Routine to return current search list

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

GETS.1:	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
GETS.2:	MOVSI	T2,3			;3 WORD ARGUMENT
	HRRI	T2,(T1)			;STARTING THERE
	JOBSTR	T2,			;DO IT,
	  JRST	GETS.4			;LOSE BIG!!
	SKIPN	T2,(T1)			;GET THE ANSWER
	  JRST	GETS.3			;ZERO MEANS WE'RE DONE
	AOJE	T2,GETS.3		;SO DOES -1
	AOJA	T3,GETS.1		;ELSE LOOP AROUND

GETS.3:	POP	P,T1			;RESTORE T1
	MOVEM	T3,(T1)			;SAVE STR COUNT
	MOVEI	T1,SLLEN(T1)		;POINT TO PATH BLOCK
	MOVX	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
GETS.4:	$STOP(CRS,Cant read searchlist)
	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
	MOVX	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
	  JRST	SETSR1			;LOSE BIG!!
	POP	P,(T1)			;RESTORE FIRST WORD OF BLOCK
	MOVEI	T1,SLLEN(T1)		;GET POINTER TO PATH BLOCK
	MOVX	T2,.PTFSD		;FUNC TO SET PATH
	MOVEM	T2,.PTFCN(T1)		;STORE IT
	HRLI	T1,PTLEN		;PUT THE LENGTH IN
	PATH.	T1,			;SET THE PATH
SETSR1:	$STOP(CSS,Cant set searchlist)
	POPJ	P,			;AND RETURN

>;END TOPS10
SUBTTL	QUASAR CREATE  --  QUEJOB - Create batch entry

QUEJOB:	TXZN	F,F.BTCH		;IS THE BATCH BIT SET?
	JRST	QUEJ.1			;NO, JUST PRINT THE LOG FILE
	GETLIM	S1,L.EQCP+.EQLIM,CNOD	;GET READER STATION NAME
	SKIPE	CDRDEV			;PHYSICAL READER INPUT
	STOLIM	S1,.EQLIM(Q),ONOD	;THEN MAKE IT THE DESTINATION NODE ALSO
TOPS20<
	MOVE	S1,[POINT 7,.EQCON(Q)]	;FILL OUT CONNECTED DIRECTORY
	MOVEM	S1,L.BP			;..
	$TEXT	(DEPBP,<PS:^7/[74]/^T/.EQOWN(Q)/^7/[76]/^0>)
>
	$TEXT(LOGTXT,<^I/STSUM/Batch job submitted>)
	MOVE	S1,CTLIFN		;GET THE CONTROL FILE IFN
	MOVEI	S2,EQXSIZ(Q)		;AND WHERE TO PUT IT
	PUSHJ	P,INCFIL		;INCLUDE IN THE MESSAGE
	MOVX	T1,FP.DEL		;GET DELETE BIT
	IORM	T1,.FPINF(S1)		;AND SET IT
	MOVE	S1,LOGIFN		;GET THE LOG IFN
	PUSHJ	P,INCFIL		;AND INCLUDE IT
	SUB	S2,Q			;SUB START TO GET LENGTH
	STORE	S2,.MSTYP(Q),MS.CNT	;STORE TOTAL MESSAGE LENGTH
	MOVX	T1,FP.FLG		;GET LOG FILE BIT
TOPS20	<
	SKIPE	L.LGDS			;/DISP:DEL?
	TXO	T1,FP.DEL		;YES, SET THE BIT
	GETLIM	S2,.EQLIM(Q),BLOG	;GET BATCH-LOG ARG
	CAXN	S2,%BSPOL		;SPOOLED?
	TXO	T1,FP.SPL		;YUP
	IORM	T1,.FPINF(S1)		;AND STORE IT
	MOVX	T1,%BAPND		;LOAD APPEND CODE
	CAXN	S2,%BSCDE		;SUPERSEDE?
>
TOPS10	<
	GETLIM	S2,.EQLIM(Q),BLOG
	CAXE	S2,%BSPOL
	SKIPE	L.LGDS			;/DISP:DEL?
	TXO	T1,FP.DEL		;YES, SET THE BIT
	IORM	T1,.FPINF(S1)		;AND STORE IT
	MOVX	T1,%BAPND		;LOAD APPEND CODE
>;END TOPS10 CONDITIONAL ASSEMBLY
	STOLIM	T1,.EQLIM(Q),BLOG	;YES, MAKE IT APPEND
	PUSHJ	P,LOGCLS		;CLOSE THE LOG FILE
	MOVE	S1,CTLIFN		;GET THE CTL IFN
	$CALL	F%REL			;RELEASE IT
	MOVX	S1,PAGSIZ		;LOAD THE MESSAGE SIZE
	MOVE	S2,Q			;AND THE ADDRESS
	PJRST	SNDQSR			;SEND THE MESSAGE

QUEJ.1:	MOVE	S1,CTLIFN		;GET CTL FILE IFN
	$CALL	F%RREL			;ABORT THE FILE
$TEXT(LOGTXT,<^I/STSUM/No Batch job submitted>)
	JRST	QUELOG			;AND QUEUE UP THE LOG FILE
SUBTTL	QUASAR CREATE  --  QUELOG - LOG file PRINT request


QUELOG:	GETLIM	S1,.EQLIM(Q),OUTP	;GET THE /OUTPUT SWITCH
	TXNN	F,F.FATE		;WAS THERE A FATAL ERROR?
	CAXE	S1,%EQOLE		;NO, DID HE WANT LOG ON ERROR ONLY?
	SKIPA				;FATAL ERROR, ALWAYS GIVE LOG
	JRST	QUEL.3			;OUTPUT:ERROR, BUT NO ERROR

$TEXT(LOGTXT,<^I/STSUM/LOG file submitted for printing>)
	MOVE	S1,LOGIFN		;GET THE LOG FILE IFN
	MOVEI	S2,EQXSIZ(Q)		;AND WHERE TO PUT IT
	PUSHJ	P,INCFIL		;INCLUDE THE LOG FILE
	SUB	S2,Q			;SUBT START ADR FOR LENGTH
	STORE	S2,.MSTYP(Q),MS.CNT	;AND STORE MESSAGE LENGTH
	MOVX	S2,FP.FLG		;GET LOG FILE BIT
	GETLIM	T1,.EQLIM(Q),BLOG	;GET BATCH-LOG ARG
	CAXN	T1,%BSPOL		;SPOOLED?
	TXO	S2,FP.SPL		;YUP, TRANSFER THAT INFO
	SKIPE	L.LGDS			;CHECK DISPOSITION
	TXO	S2,FP.DEL		;DELETE IT
	IORM	S2,.FPINF(S1)		;AND SET THE BITS
	PUSHJ	P,LOGCLS		;CLOSE THE LOG FILE
	MOVX	S1,.OTLPT		;LOAD THE PRINTER OBJECT
	STORE	S1,.EQROB+.ROBTY(Q)	;STORE AS DESIRED DESTINATION
	SKIPN	CDRDEV			;REAL READER ?
	JRST	QUEL.1			;NO..
	GETLIM	S1,L.EQCP+.EQLIM,CNOD	;GET THE ORIGINATING NODE
	JRST	QUEL.2			;GO ON
QUEL.1:	GETLIM	S1,.EQLIM(Q),ONOD	;GET THE OUTPUT FIELD
	SKIPN	S1			;NON-ZERO 
	MOVE	S1,DEFNOD		;NO..GET DEFAULT NODE
QUEL.2:	STORE	S1,.EQROB+.ROBND(Q)	;YES, STORE AS DESTINATION NODE
	MOVX	S1,EQLMSZ		;LOAD A COUNT
	MOVEI	S2,.EQLIM(Q)		;AND AN ADDRESS
	$CALL	.ZCHNK			;ZERO THE LIMIT WORDS
	MOVX	S1,'SPRINT'		;MIGHT AS WELL PUT IN A NOTE
	STOLIM	S1,.EQLIM(Q),NOT1	;STORE 1ST HALF
	MOVX	S1,' LOG  '		; TO MAKE IT EASIER FOR HIM
	STOLIM	S1,.EQLIM(Q),NOT2	;STORE 2ND HALF
	MOVEI	S1,^D15			;LOAD A SMALL PAGE LIMIT
	STOLIM	S1,.EQLIM(Q),OLIM	;STORE OUTPUT LIMIT
	ZERO	.EQAFT(Q)		; DITTO DITTO
	MOVEI	T1,1			;LOAD NUMBER OF FILES
	STORE	T1,.EQSPC(Q),EQ.NUM	;AND STORE IT
	MOVX	S1,PAGSIZ		;SEND A PAGE
	MOVE	S2,Q			;STARTING THERE
	PJRST	SNDQSR			;AND SEND THE MESSAGE

QUEL.3:	GETLIM	S2,.EQLIM(Q),BLOG	;GET BATCH-LOG ARG
	MOVEI	T1,F%REL		;ASSUME STANDARD CLOSE
	CAXE	S2,%BSPOL		;IF ITs SPOOLED
	SKIPE	L.LGDS			;OR DISP:DELETE
	MOVEI	T1,F%RREL		;THEN DELETE IT
	MOVE	S1,LOGIFN		;GET THE IFN IN ANY CASE
	PUSHJ	P,(T1)			;CALL APPROPRIATE ROUTINE
	SETZM	LOGIFN			;CLEAR OUT THE IFN
	MOVE	S1,Q			;GET PAGE ADDRESS
	PJRST	M%RPAG			;RELEASE PAGE AND RETURN
SUBTTL	QUASAR CREATE  --  QUEFIL - User file request

QUEFIL:	$CALL	M%ACQP			;GET A FREE PAGE
	MOVE	T1,S1			;SAVE THE PAGE NUMBER
	PG2ADR	T1			;AND MAKE AN ADDRESS
	MOVS	T2,Q			;GET ADR OF JOB PAGE
	HRR	T2,T1			;AND THE NEW PAGE
	BLT	T2,EQHSIZ-1(T1)		;AND BLT THE HEADER
	HLLZ	S1,L.QFN		;GET THE DEVICE
	STORE	S1,.EQROB+.ROBTY(T1)	;AND STORE IT
	MOVX	S1,EQLMSZ		;LOAD BLOCK LENGTH
	MOVEI	S2,.EQLIM(T1)		;AND BLOCK ADDRESS
	$CALL	.ZCHNK			;AND ZERO THE BLOCK
	MOVE	S1,FILIFN		;GET THE IFN
	MOVEI	S2,EQHSIZ(T1)		;AND WHERE TO PUT IT
	PUSHJ	P,INCFIL		;INCLUDE THE FILE
	SUB	S2,T1			;SUBTRACT START ADDRESS
	STORE	S2,.MSTYP(T1),MS.CNT	;STORE MESSAGE SIZE
	MOVEI	S1,1			;LOAD NUMBER OF FILES
	STORE	S1,.EQSPC(T1),EQ.NUM	;AND STORE IT
	MOVEI	S1,EQHSIZ		;LOAD CREATE HEADER SIZE
	STORE	S1,.EQLEN(T1),EQ.LOH	;AND STORE IT
	MOVX	S1,PAGSIZ		;SEND A PAGE
	MOVE	S2,T1			;GET THE ADDRESS
	PJRST	SNDQSR			;AND SEND IT
SUBTTL	QUASAR CREATE  -- Utility subroutines


;SNDQSR -- Routine to send a message to QUASAR

;	Call with	S1/ length
;			S2/ address

SNDQSR:	STORE	S1,L.SAB+SAB.LN		;STORE THE LENGTH
	STORE	S2,L.SAB+SAB.MS		;AND THE ADDRESS
	MOVEI	S1,SP.QSR		;GET SPECIAL INDEX
	TXO	S1,SI.FLG		;FLAG IT
	MOVEM	S1,L.SAB+SAB.SI		;STORE IT
	MOVEI	S1,SAB.SZ		;GET SAB SIZE
	MOVEI	S2,L.SAB		;GET SAB ADDRESS
	$CALL	C%SEND			;SEND THE MESSAGE
	JUMPT	.POPJ			;RETURN IF OK
					;ELSE GIVE A SEND FAILURE

;Here when a send to QUASAR fails
SNDFAI:	$STOP(QSF,QUASAR send failed)


; INCFIL  --  Include a file into a CREATE message

;Call with S1 containing the IFN
;	   S2 containing the adr of the 1st FD WORD
; Creates FP and FD and returns S1 containing the  address  of
; the FP and S2 containing the address of the first free word.

INCFIL:	MOVE	T1,S2			;SAVE FP ADDRESS
	MOVEI	S2,FPMSIZ		;GET FP SIZE
	STORE	S2,.FPLEN(T1),FP.LEN	;STORE IT
	MOVEI	S2,1			;GET A STARTING POINT
	STORE	S2,.FPFST(T1)		;STORE IT
	STORE	S2,.FPINF(T1),FP.FCY	;AND A COPIES FIELD
	SETO	S2,			;GET FULL FILESPEC
	$CALL	F%FD			;GET FROM GLXFIL
	LOAD	S2,.FDLEN(S1),FD.LEN	;GET THE LENGTH OF THE FD
	HRL	S1,S1			;START MAKING A BLT POINTER
	HRRI	S1,FPMSIZ(T1)		;POINT TO WHERE TO PUT IT
	ADDI	S2,FPMSIZ(T1)		;POINT TO THE NEXT FP
	BLT	S1,-1(S2)		;BLT THE FD
	MOVE	S1,T1			;GET RETURN AC
	POPJ	P,			;AND RETURN
SUBTTL	$TEXT Utilities


; Routine to deposit the  character  in  S1  (as  called  from
; $TEXT) according to the Byte-Pointer in L.BP

DEPBP:	IDPB	S1,L.BP			;DEPOSIT THE BYTE
	$RETT				;AND RETURN TRUE


FATAL:	ITEXT(<^M^J^J^C/[-1]/ STERR	>)


STDAT:	ITEXT(<^C/[-1]/ STDAT	>)
STMSG:	ITEXT(<^C/[-1]/ STMSG	>)
STERR:	ITEXT(<^C/[-1]/ STERR	>)
STCRD:	ITEXT(<^C/[-1]/ STCRD	>)
STSUM:	ITEXT(<^C/[-1]/ STSUM	>)

ABTSPR:	ITEXT	(<Input Spooling Processor Error>)
SUBTTL - Interrupt System Database

TOPS10 <
VECTOR:	BLOCK	4			;START OF VECTOR BLOCK
>  ;END TOPS10 CONDITIONAL

TOPS20 <
LEVTAB:	EXP	LEV1PC			;WHERE TO STORE LEVEL 1 INT PC
	EXP	LEV2PC			;WHERE TO STORE LEVEL 2 INT PC
	EXP	LEV3PC			;WHERE TO STORE LEVEL 3 INT PC

LEV1PC:	BLOCK	1			;LVL 1 INTERRUPT PC STORED HERE
LEV2PC:	BLOCK	1			;LVL 2 INTERRUPT PC STORED HERE
LEV3PC:	BLOCK	1			;LVL 3 INTERRUPT PC STORED HERE

CHNTAB:	BLOCK	^D36			;A NULL INTERRUPT DISPATCH TABLE

>  ;END TOPS20 CONDITIONAL assembly



	END	SPRINT