Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

SUBTTL	SRTFOR - FORTRAN SUBROUTINE INTERFACE TO SORT ON TOPS-10
SUBTTL	L.R. JASPER/DMN/DZN/BRF	23-Jan-81
SEARCH COPYRT


;COPYRIGHT (C) 1975, 1985 BY DIGITAL EQUIPMENT CORPORATION
;ALL RIGHTS RESERVED
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
.COPYRIGHT

IFN FTOPS20,<PRINTX ? SRTFOR should not be present in TOPS-20 SORT/MERGE.>
IFN FTPRINT,<PRINTX [Entering SRTFOR.MAC]>

FTFORTRAN==1
FTCOBOL==0

LOWORG==<LOWLOC==0>		;[N07] SET DATA SECTION BASE TO ZERO
DEFINE	SEGMENT (A) <>		;ALL IN LOW SEGMENT

SUBTTL	SRTFOR TABLE OF CONTENTS


;                    Table of Contents for SRTFOR
;
;
;                             Section                             Page
;
;   1  SRTFOR - FORTRAN SUBROUTINE INTERFACE TO SORT ............   1
;   2  SRTFOR TABLE OF CONTENTS .................................   2
;   3  DEFINITIONS
;        3.1  AC Usage and Flags ................................   3
;        3.2  Impure Data .......................................   4
;   4  ENTRY POINT FROM FORTRAN .................................   5
;   5  SWITCH DEFINITIONS
;        5.1  SWTCHS Macro ......................................   6
;        5.2  Name Table ........................................   7
;        5.3  Dispatch Table ....................................   8
;   6  COMMAND SCANNER
;        6.1  Top Level .........................................   9
;        6.2  Control Routines ..................................  10
;        6.3  Build Token and Branch on its Type ................  12
;   7  SWITCH HANDLING
;        7.1  Uniqueness Switch Scanner .........................  13
;        7.2  /ALIGN, /ALPHANUMERIC, /ASCII, /BINARY, /NUMERIC ..  14
;        7.3  /PRIORITY:n, /CORE:n, /RANDOM, /FIXED, /FORTRAN ...  14
;        7.4  /COMP, /COMP1, /SIGNED, /UNSIGNED .................  15
;        7.5  /STANDARD, /DENSITY:n, /SEQUENTIAL, /VARIABLE .....  15
;        7.6  /COLLATE:x[:y] ....................................  16
;        7.7  /KEY:n:m:x ........................................  17
;        7.8  /FORMAT:xn.m ......................................  18
;        7.9  /RECORD:n, /TEMP, /ESTIMATE:n, /UNLOAD ............  19
;        7.10  /REWIND, /SUPPRESS:^n, /MERGE, /CHECK ............  19
;        7.11  /ERROR:^n, /FATAL:^n .............................  20
;   8  FILE SPEC SCANNING ROUTINES ..............................  21
;   9  SCAN INPUT ROUTINES - SIXBIT, Decimal, Octal, etc. .......  22
;  10  INDIRECT COMMAND FILE I/O ROUTINES .......................  23
;  11  ENDS. ....................................................  25
;  12  ERROR MESSAGES ...........................................  26
;  13  DUMMY ROUTINES FOR UNSUPPORTED FEATURES ..................  27

SUBTTL	DEFINITIONS -- AC Usage and Flags


;AC USAGE
;	T0=0		;USED TO ASSEMBLE CONTENTS OF T1
;	T1=1		;A VALUE RETURNED FROM SCNANNER(SWITCH NAME OR VALUE)
;	T2=2		;FLAGS DEFINING WHAT STOPPED THE SCAN
;	T3=3		;SCRATCH
;	T4=4		;SCRATCH
;	P1=5		;THE JSP POINTER
;	P2=6		;(FORTRAN) SCAN FLAGS
;	P3=7		;POINTER TO THE FD BLOCK BEING DEFINED
;	P4=10		;
;	F=11		;
;	U=12		;GLOBAL SCRATCH
;	J=13		;THE CURRENT DISPATCH ENTRY
;	R=14		;
;	S=15		;TYPE ARGUMENT CODE
;	L=16		;POINTER TO ARG BLOCK
;	P=17		;PUSH DOWN LIST POINTER

ENTRY	SORT
IFE FTOPS20,<
EXTERN	FUNCT.		;[C19]
>

DEFINE	ENDMODULE<
	$PURGE
	END>


;TOKEN FLAGS--THESE ARE IN P2
	SC.KEY==1B0		;WE'VE SEEN /KEY--DATA MODE SWITCHES ALLOWED
	SC.EQU==1B1		;WE'VE SEEN "="--NOW PROCESSING INPUT
	SC.FNE==1B2		;WE'VE SEEN A FILE NAME IN THIS SPEC
	SC.DEV==1B3		;WE'VE SEEN A DEVICE--USED WITH /TEMP
	SC.TMP==1B4		;WE'VE SEEN A /TEMP
	SC.NEG==1B5		;WE'VE SEEN A "-"--NEGATIVE /PRIORITY: VALUE PENDING

;TOKEN TERMINATOR FLAGS--THESE ARE IN T2. WHEN A TOKEN TERMINATOR CHARACTER
;IS SEEN (",", "=", ETC.), 1B<VALUE OF CHAR IN SIXBIT> IS SET. CHARACTERS NOT
;USED AS TERMINATORS HEREIN HAVE THEIR FLAG BITS TIME-SHARED WITH OTHER FLAGS.
;SOME OF THESE FLAGS ARE LISTED BELOW.
	EOL==1B0		;END OF LINE FLAG
	UPARO==1B22		;[347] ^ FLAG

SUBTTL	DEFINITIONS -- Impure Data

	SEGMENT	IMPURE			;[C20]

ATSFLG:	BLOCK 1
ATSFIL:	BLOCK 4				;[C19] ATS LOOKUP BLOCK
SRTPTR:	BLOCK 1				;[C20]
SRTCNT:	BLOCK 1				;[C20]
SAVPTR:	BLOCK 1				;[C20]
SAVCNT:	BLOCK 1				;[C20]
COMBUF:	BLOCK 200	;BUFFER FOR @COMAND FILE INPUT
SAVEP:	BLOCK 1
SAVEL:	BLOCK 1
ARGADR:	BLOCK 1
.NMUL:	BLOCK 4		;[C13] TEMP STORAGE FOR SWITCH VALUES
.NMUE=.-1		;[C13] LAST WORD OF .NMUL

	SEGMENT	LPURE			;[C20]

SUBTTL	ENTRY POINT FROM FORTRAN

BEGIN
  PROCEDURE	(PUSHJ	P,SORT)
	MOVEM	L,SAVEL
	MOVEM	P,SAVEP
	PUSHJ	P,CUTBAK		;CUT BACK CORE IF POSSIBLE
	JSP	P4,INITIALIZE
	PUSHJ	P,LOOP
	MOVE	P,SAVEP
	MOVE	L,SAVEL
	RETURN
END;

SUBTTL	SWITCH DEFINITIONS -- SWTCHS Macro

DEFINE SWTCHS<
	SRTARG	ALIGN,ALI,UDF
	SRTARG	ALPHANUMERIC,ALP,UDF
	SRTARG	ASCII,ASC,UDF
	SRTARG	BINARY,BIN,UDF
;;	SRTARG	BLOCKED,BLO,DEC
	SRTARG	CHECK,CHK,UDF
	SRTARG	COLLATE,COL,UDF
	SRTARG	COMP,CMP,UDF
	SRTARG	COMP1,CM1,UDF
;;	SRTARG	COMP3,CM3,UDF
	SRTARG	COMPUTATIONAL,COM,UDF	;;[213]
	SRTARG	CORE,COR,DEC
;;	SRTARG	EBCDIC,EBC,UDF
	SRTARG	ERROR,ERR,OCT
	SRTARG	FATAL,FAT,OCT
	SRTARG	FIXED,FIX,UDF
	SRTARG	FORMAT,FMT,UDF		;;[213]
	SRTARG	FORTRAN,FOR,UDF
;;	SRTARG	INDUSTRY,IND,UDF
	SRTARG	KEY,KEY,DEC
;;	SRTARG	LABEL,LAB,SIX
	SRTARG	LEAVES,LEA,DEC
	SRTARG	MAXTEMPFILES,MTF,DEC	;;[N20]
	SRTARG	MERGE,MRG,UDF
	SRTARG	NUMERIC,NUM,UDF
;;	SRTARG	PACKED,PAC,UDF
	SRTARG	PRIORITY,PRI,DEC
	SRTARG	RANDOM,RAN,UDF
	SRTARG	RECORD,REC,DEC
	SRTARG	REWIND,REW,UDF
	SRTARG	SEQUENTIAL,SEQ,UDF
	SRTARG	SIGNED,SIG,UDF
;;	SRTARG	SIXBIT,SIX,UDF
	SRTARG	STANDARD,STA,UDF	;;[213]
	SRTARG	STATISTICS,STS,UDF	;;[C20]
	SRTARG	SUPPRESS,SUP,UDF
	SRTARG	TEMP,EMP,UDF
	SRTARG	UNLOAD,UNL,UDF
	SRTARG	UNSIGNED,UNS,UDF
	SRTARG	VARIABLE,VAR,UDF

;;SWITCHES FROM SCAN
	SRTARG	DENSITY,DEN,DEC		;;[213]
	SRTARG	ESTIMATE,EST,DEC
;;	SRTARG	VERSION,VER,UDF

	SRTARG	,DEV,SIX		;;DISPATCH FOR DEV:
	SRTARG	,NAM,SIX		;;DISPATCH FOR FILE NAME
	SRTARG	,PPN,OCT		;;DISPATCH FOR PPN
	SRTARG	,ATS,SIX		;;FOR INDIRECT COMMAND FILE PROCESSING
>

SUBTTL	SWITCH DEFINITIONS -- Name Table

DEFINE	SRTARG(KEY,PROC,VAL)<
  IFNB <KEY>,<
	EXP	SIXBIT	/KEY/
  >
>

SO.SWT:	SWTCHS
SO.MAX==.-SO.SWT

SUBTTL	SWITCH DEFINITIONS -- Dispatch Table

DEFINE	SRTARG(KEY,PROC,VAL)<
  IFB <KEY>,<INX'PROC=.-SO.DSP>		;;DEFINE FILE SPEC DISPATCH OFFSETS
	XWD	SCN'VAL,SRT'PROC	;KEY
>

SO.DSP:	SWTCHS

SUBTTL	COMMAND SCANNER -- Top Level

BEGIN
  PROCEDURE (PUSHJ	P,SCAN)
  IF WE'RE PROCESSING AN INDIRECT FILE
	SKIPG	ATSFLG			;ARE WE PROCESSING INDIRECT COMMAND FILE?
	JRST	$T			;[213] NOPE, GO SCAN THE FORTRAN LITERAL
  THEN REINITIALIZE SORT
	MOVE	T1,SAVPTR		;[C20] RESTORE SCANNER POINTER AND COUNT
	MOVEM	T1,SRTPTR		;[C20]   ..
	MOVE	T1,SAVCNT		;[C20]   ..
	MOVEM	T1,SRTCNT		;[C20]   ..
	STORE	(T1,ZCOR,SEQNO,0)	;CLEAR DATA AREA
	MOVE	T3,TCBIDX
	MOVE	T4,MAXTMP
	MOVE	T1,[Z.BEG,,Z.BEG+1]	;SET UP TO ZERO SOME SORT LOCS TOO
	SETZM	Z.BEG
	BLT	T1,Z.END		;BLT TO ZEROES
	MOVEM	T3,TCBIDX
	MOVEM	T4,MAXTMP
	PUSHJ	P,GETJOB		;GET JOB NUMBER
	JSP	T4,CPUTST		;[202] SEE WHICH CPU WE HAVE
	PUSHJ	P,SSTATS		;[C20] SETUP STATS LOCS
	SETOM	P.BLKF
	SETOM	P.VARF
	JRST	$F			;[213] GO PICK UP FROM WHERE WE LEFT OFF
  ELSE JUST CHECK ARG LIST (INITIALIZATION ALREADY DONE)
	SETZM	SRTCNT			;[C20] [223] INITIALIZE CHAR CNT TO 'HUGE' NUMBER
	MOVE	L,SAVEL			;[C19] RESTORE L
	HLRE	T1,-1(L)		;[OK] PICK UP # OF ARGS.
	MOVMM	T1,FORCNT		;[C20] STORE NUMBER OF ACTUALS
	MOVEM	L,FORARG		;[C20] STORE ADDRESS OF ACTUALS
	HRRI	T1,@(L)			;[C20] GET ADDR OF FIRST ARG
	HRLI	T1,(POINT 7,)		;[C20] MAKE IN BYTE POINTER
	MOVEM	T1,SRTPTR		;[C20] SAVE IT
	SETOM	ATSFLG			;MARK NO @ SEEN...
  FI;
	SETOM	TEMPSW			;RESET FLAG(NOT SEEN) FOR /TEMP SWITCH
	PUSHJ	P,CLRANS		;SET UP SOME SPECIAL LOCS.
	SETZB	T2,P2			;[C20] [213] NO DELIMTERS PENDING
					;& ZAP FLAGS (INITIALIZE ALL CONDITIONS INSIDE SCANNER)
	PUSHJ	P,SCNSIT		;GO SCAN THE SORT COMMAND(LITERAL)
					;COMES BACK ON A NULL AND/OR
					;LF (IF PROCESSING INDIRECT COMMAND FILE)

	RETURN				;GOOD RETURN
END;

SUBTTL	COMMAND SCANNER -- Control Routines

;	FILE DESCRIPTOR/KEY BLOCKS ARE ALLOCATED VIA
;	THIS CODE. DATA IS STUFFED INTO THE REAL BLOCK.

BEGIN
  PROCEDURE (PUSHJ	P,ALLOUT)
	PUSH	P,T1			;SAVE THESE TEMPS
	PUSH	P,T2
	MOVEI	T1,S.LEN		;TOTAL SPACE NEEDED
	PUSHJ	P,GETSPC		;T1=ADDRESS
	  JRST	E$$NEC			;FAILED
	SETZM	S.SPC(T1)		;[OK] [213] ZERO POINTER TO NEXT BLOCK
	MOVE	P3,T1			;[C20] SET UP EFFECTIVE ADDR FOR SCANNER
	HRLZI	T2,1(T1)		;[OK] [202] SET ALL FILE SWITCHES TO -1
	HRRI	T2,2(T1)		;[OK] [202]   WHICH IS UNINITIALIZED STATE
	SETOM	1(T1)			;[OK] [202]   FOR SCAN SWITCHES
	BLT	T2,S.DEV-1(T1)		;[OK] [202]   ..
	MOVE	T2,F.OUZR		;PREVIOUS BLOCK (OR 0)
	MOVEM	T2,0(T1)		;[OK] LINK
	MOVEM	T1,F.OUZR		;NEW BLOCK
	POP	P,T2			;RESTORE THE TEMPS
	POP	P,T1
	RETURN
END;

BEGIN
  PROCEDURE (PUSHJ	P,ALLIN0)
	MOVEI	T1,S.LEN		;TOTAL SPACE NEEDED
	PUSHJ	P,GETSPC		;T1=ADDRESS
	  JRST	E$$NEC			;FAILED
	SETZM	S.SPC(T1)		;[OK] [213] ZERO POINTER TO NEXT BLOCK
	MOVE	P3,T1			;[C20] SAVE EFFECTIVE ADDR FOR SCAN CODE
	HRLZI	T2,1(T1)		;[OK] [202] SET ALL FILE SWITCHES TO -1
	HRRI	T2,2(T1)		;[OK] [202]   WHICH IS UNINITIALIZED STATE
	SETOM	1(T1)			;[OK] [202]   FOR SCAN SWITCHES
	BLT	T2,S.DEV-1(T1)		;[OK] [202]   ..
	HRRM	T1,ARGADR
	SETZ	T2,			;SET UP LIKE VIRGIN SCAN
	RETURN
END;


BEGIN
  PROCEDURE (PUSHJ	P,ALLIN1)	;LINK INPUT SCAN BLOCK INTO PROPER LIST
	HRRZ	T1,ARGADR		;GET BACK BLOCK POINTER
  IF THIS IS A TEMP FILE SPEC
	TXNN	P2,SC.TMP		;IS THIS A TEMP FILE SPEC?
	JRST	$T			;NOPE - GO LINK INTO INPUT CHAIN(AT FRONT)
  THEN LINK INTO TEMP CHAIN AT END
	MOVEI	T2,F.TMZR		;YES, GET ADDR. OF LAST BLOCK
  $1%	HRRZ	T3,(T2)			;[C20] GET POINTER TO NEXT
	JUMPE	T3,$2			;[C20] NONE
	MOVE	T2,T3			;[C20] COPY IT
	JRST	$1			;TRY AGAIN
  $2%	MOVEM	T1,(T2)			;[OK] LINK IN(AT BACK)
	JRST	$F			;GO ALLOCATE SPACE FOR THE NEXT BLOCK
  ELSE LINK INTO INPUT CHAIN AT FRONT
	MOVE	T2,F.INZR		;PREVIOUS BLOCK(OR 0)
	MOVEM	T2,0(T1)		;[OK] LINK
	MOVEM	T1,F.INZR		;NEW BLOCK
  FI;
	PJRST	ALLIN0			;ALLOCATE SPACE FOR THE NEXT BLOCK
END;

SUBTTL	COMMAND SCANNER -- Build Token and Branch on its Type

;	T0	USED TO ASSEMBLE CONTENTS OF T1
;	T1	SWITCH DATUM
;	T2	END OF LINE(NULL) AND/OR DELIMITERS
;	P2	FLAGS
;	P3	POINTER TO FILE/KEY BLOCK
;	J	SWITCH INDEX
;	U	CONVERSION TO (INDEX FOR SCANNER)

SCNSIT:	SETZ	J,			;CLEAR THE SWITCH INDEX
	JUMPN	T2,SCNCHK		;IS THERE A DELIMETER PENDING?
SCNSWZ:	PUSHJ	P,SCNSIX		;NO, GO GET SOMETHING
	JUMPE	T1,SCNCHK		;IF NO DATUM, GO CHECK ON A SWITCH
	MOVEI	J,INXNAM		;ASSUME A FILE NAME
	TXZE	T2,<1B':'>		;IS THIS A DEVICE?
	MOVEI	J,INXDEV		;YES, PROCESS THE DEVICE NAME
	JRST	SCNSW6			;DATUM IS IN  AC T1

SCNCHK:	TXZE	T2,<1B'/'>		;CHECK FOR ANOTHER SWITCH
	JRST	SCNSWT			;WHAT IS IT?
	TXZE	T2,<1B','>		;IS DELIMETER A COMMA?
	JRST	COMMA			;YES, START NEW FILE SPEC
	TXZE	T2,<1B'='>		;IS DELIMITER AN EQUALS?
	JRST	EQUALS			;YES, GO DO SOME GOOD
	TXZN	T2,<1B'@'>		;INDIRECT COMMAND FILE SPEC.?
	JRST	IFEND			;NOPE, GO SEE IF THE END
	MOVEI	J,INXATS		;NO, SET UP TO HANDLE FILE NAME
	JRST	SCNSW5			;DISPATCH TO GET IT
IFEND:	TXZE	T2,EOL			;COULD BE THE END?
	JRST	ENDIT			;TH TH TH THATS ALL FOLKS
	TXZN	T2,1B19			;NOT FINISHED, CHECK FOR A[PPN]
	JRST	E$$UDL
	MOVEI	J,INXPPN		;GO PROCESS THE PPN,SFD
	JRST	SCNSW5			;DISPATCH TO GET PSEUDO SWITCH

EQUALS:	TXOE	P2,SC.EQU		;HAVE WE SEEN ANOTHER EQUALS
	JRST	E$$ONS			;YES, GIVE ERROR
	TXZN	P2,SC.FNE!SC.DEV	;NOPE - SEEN AN OUTPUT FILENAME OR DEVICE?
	JRST	E$$ONS			;ERROR - NO OUT FILENAME OR MULTI. =
	MOVE	T3,RECORD		;SEE IF SPECIFIED ON OUTPUT SIDE
	MOVEM	T3,RECOUT		;SAVE IN CASE ITS DIFFERENT ON OUTPUT
	SETOM	RECORD			;SET INPUT REC. SIZE AS NULL
	PUSHJ	P,ALLIN0		;ALLOCATE INPUT FILE DESCR. AREA(BLOCK)
	JRST	SCNSIT

COMMA:	TXNN	P2,SC.EQU		;HAVE WE SEEN AN EQUALS?
	JRST	E$$MOI
	TXZN	P2,SC.FNE!SC.DEV	;[350] HAVE WE SEEN AN INPUT FILENAME OR DEVICE?
	JRST	E$$INS			;DON'T ALLOW MULTIPLE OUTPUT SPECS
					;OR A COMMA AND NO FILENAME ENCOUNTERED
	PUSHJ	P,ALLIN1		;[350] GO FINISH FILE SPEC ALLOCATION
	TXZ	P2,SC.TMP!SC.DEV	;TURN OFF /TEMP SEEN, DEV: SEEN
					;SC.TMP IS USED TO KEY CORRECT BLOCK LINKING.
	JRST	SCNSIT

ENDIT:	TXZN	P2,SC.FNE!SC.DEV	;[350] ERROR IF NO FILE NAME OR DEVICE
	JRST	E$$INS			;ERROR- TELL EM
	PJRST	ALLIN1			;[350] FINISH UP LAST FILE SPEC. ALLOC.

SCNSWT:	TXNN	P2,SC.FNE!SC.DEV	;[350] [213] MUST HAVE SEEN A FILE SPEC
	JRST	E$$SFF			;[213] SWITCH IS NOT PROPERLY PLACED
	PUSHJ	P,SCNSIX		;GET SWITCH DATUM
	MOVE	T4,[XWD -SO.MAX,SO.SWT]	;GET THE SWITCH TABLE
	PUSHJ	P,SCNTBL		;SCAN THE TABLE
	  JRST	ERRUKS			;[213] UNKNOWN SWITCH
	HRRZ	J,T4			;[C20] GET THE SWITCH INDEX
SCNSW5:	HLRZ	U,SO.DSP(J)		;LOAD THE SWITCH ARGUMENT ROUTINE ADDR
	PUSHJ	P,(U)			;GET THE ARGUMENT FOR THE SWITCH
SCNSW6:	HRRZ	U,SO.DSP(J)		;LOAD THE SWITCH PROCESSOR ADDR
	PUSHJ	P,(U)			;PROCESS THE ARGUMENT
	JRST	SCNSIT			;PROCESS NEXT SWITCH

SUBTTL	SWITCH HANDLING -- Uniqueness Switch Scanner

;ENTRY
;	T0	SCRATCH
;	T1=	SIXBIT NAME TO SCAN FOR
;	T2=	NOT USED (CONTAINS FLAGS)
;	T3=	SCRATCH
;	T4=	-TABLE SIZE,,TABLE ADDRESS

;RETURN
;	T4=	THE INDEX INTO THE TABLE
;	NON-SKIP RETURN OF ENTRY NOT FOUND
;	SKIP RETURN OF FOUND IN THE TABLE

BEGIN
  PROCEDURE (PUSHJ	P,SCNTBL)
	PUSH	P,P1			;[C20] NEED AN AC, SAVE P1
	PUSH	P,T4			;SAVE THE ARGUMENT
	SETZ	T0,			;CLEAR THE FLAG WORD
	SETO	T3,			;SET UP A MASK
	LSH	T3,-6			;SHIFT MASK...LRJ
	TDNE	T1,T3			;CHECK MASK AGAINST SIGNIFICANT BYTES
	JUMPN	T3,.-2			;RETRY THE MASK TEST
  WHILE THERE ARE KEYWORDS TO CHECK
	BEGIN
	  IF USER'S KEYWORD MATCHES THE TABLE ENTRY
		HRRZ	P1,T4			;[C20] GET NEXT KEYWORD
		MOVE	P1,(P1)			;[C20]   ..
		ANDCAM	T3,P1			;[C20] TRUNCATE IT TO USER LENGTH
		CAME	P1,T1			;[C20] IS THIS THE SWITCH
		JRST	$F			;NO--GO TRY NEXT ONE
	  THEN CHECK FOR EXACT MATCH
		JUMPE	T0,.+2			;HAVE WE SEEN A ABRIV. SWITCH
		SETO	T0,			;YES, SET MULTI SWITCH FLAG
		HRR	T0,T4			;[C20] SAVE SWITCH INDEX IN ANY CASE
		HRRZ	P1,T4			;[C20] EXACT MATCH
		CAMN	T1,(P1)			;[C20]   ..
		JRST	[ANDI T0,-1		;YES--CLEAR MULTI FLAG
			 JRST $E]		;  AND QUIT NOW
	  FI;
		AOBJN	T4,$B			;REDUCE COUNT AND CONTINUE SEARCH
	END;
	MOVE	T4,T0			;GET THE ABS ADDRESS IN T4
	POP	P,T0			;GET THE ARGUMENT BACK
	JUMPLE	T4,$1			;ERROR ARGUMENT NOT IN TABLE
	SUB	T4,T0			;RELOCATE TO INDEX
	ANDI	T4,-1			;RIGHT HALF ONLY
  	AOS	-1(P)			;[C20] GIVE SKIP RETURN
  $1%	POP	P,P1			;[C20] RESTORE P1
	RETURN				;[C20]
END;

SUBTTL	SWITCH HANDLING -- /ALIGN, /ALPHANUMERIC, /ASCII, /BINARY, /NUMERIC
SUBTTL	SWITCH HANDLING -- /PRIORITY:n, /CORE:n, /RANDOM, /FIXED, /FORTRAN

SRTALI:	MOVEI	T3,1			;SET UP A +1 VALUE
	MOVEM	T3,ALIGN		;AND PUT IT IN APPROPR. LOC.
	POPJ	P,

SRTALP:	MOVX	T3,RM.ALP		;[213] SET UP /ALPHANUMERIC DATA MODE
	PJRST	STUFMD			;[213]   AND STORE IT

SRTASC:	MOVX	T3,RM.ASC		;[213] SET UP /ASCII RECORDING MODE BIT
	PJRST	STFMD1			;[213]   AND STORE IT

SRTBIN:	MOVX	T3,RM.BIN		;[213] SET UP /BINARY RECORDING MODE BIT
	PJRST	STFMD1			;[213]   AND STORE IT

SRTNUM:	MOVX	T3,RM.NUM		;[213] SET UP /NUMERIC DATA MODE
	PJRST	STUFMD			;[213]   AND STORE IT

SRTPRI:	JUMPN	T1,CHK3			;IF T1 IS NOT = 0(FROM LAST SCAN)
					;THEN IT CONTAINS A NUMBER(PRIORITY)
	TXZE	T2,<1B'+'>		;OTHERWISE MUST LOOK AT T2 FOR
					;SIGN OF ARGUMENT
	JRST	PRIARG			;IT WAS A +
	TXZN	T2,<1B'-'>		;IS IT A -
	JRST	E$$PRI			;BETTER BE - CAUSE IF NOT ITS AN ERROR
	TXO	P2,SC.NEG		;MARK THAT WE SAW A -
PRIARG:	PUSHJ	P,SCNDEC		;STILL HAVE TO GET PRIO. NUMBER
CHK3:	CAILE	T1,3			;CANT BE MORE THAN THREE
	JRST	E$$PRI			;BUT IT SURE WAS...
	MOVEM	T1,PRIORI		;MARK AND RECORD PRIORITY SPECIFIED
	TXZE	P2,SC.NEG		;DOES IT HAVE TO BE A NEGATIVE NUMBER?
	MOVNM	T1,PRIORI		;DO IT
	POPJ	P,			;RETURN TO SCANNER

SRTCOR:	TRZN	T2,1			;[213] P OR K TYPED AFTER ARG?
	JRST	STFCOR			;[213] NO--STORE /CORE ARG AS IS
	CAIN	T0,'P'			;[213] P TYPED?
	LSH	T1,<POW2 (1000)>	;[213] YES--CONVERT TO PAGES
	CAIN	T0,'K'			;[213] K TYPED?
	LSH	T1,<POW2 (2000)>	;[213] YES--CONVERT TO K CORE
STFCOR: MOVEM	T1,CORSIZ		;STUFF CORE SIZE REQUESTED
	POPJ	P,			;RETURN TO SCANNER

SRTRAN: SRTFIX:
	SETZM	S.VARI(P3)		;[C20] MARK FIXED LENGTH RECORDS
	SKIPGE	P.VARF			;[202] SEEN A DEFAULT YET?
	SETZM	P.VARF			;[202] NO--DEFAULT TO /FIX
	POPJ	P,			;RETURN TO SCANNER(SCNSIT)

SRTFOR:	MOVX	T3,RM.FOR		;[213] SET UP /FORTRAN FILE MODE
	PJRST	STFMD1			;[213]   AND STORE IT

SUBTTL	SWITCH HANDLING -- /COMP, /COMP1, /SIGNED, /UNSIGNED
SUBTTL	SWITCH HANDLING -- /STANDARD, /DENSITY:n, /SEQUENTIAL, /VARIABLE
SUBTTL	SWITCH HANDLING -- /STATISTICS:<yes or no>

SRTCMP: SRTCM1: SRTCOM:
	MOVX	T3,RM.COM		;[213] SET UP /COMP/COMP1 DATA MODE
	PJRST	STUFMD			;[202,213]   AND STORE IT

SRTSIG:	MOVX	T3,RM.SGN		;[213] SET UP /SIGNED DATA MODE
	PJRST	STUFMD			;[213]   AND STORE IT

SRTUNS:	MOVX	T3,RM.UNS		;[213] SET UP /UNSIGNED DATA MODE
	PJRST	STUFMD			;[213]   AND STORE IT

SRTSTA:	MOVEI	T3,1			;[213] MARK STANDARD-ASCII TAPE
	MOVEM	T3,S.STDA(P3)		;[C20] [213]   AND STORE IT
	POPJ	P,			;[213] DONE

SRTSTS:	TXZN	T2,<1B':'>		;[C20] ARGUMENT SPECIFIED?
	SKIPA	T1,[SIXBIT /YES/]	;[C20] NO, ASSUME YES
	PUSHJ	P,SCNSIX		;[C20] YES, GET IT
	SETO	T3,			;[C20] ASSUME NOTHING
	LSH	T1,-^D<36-6>		;[C20] USE ONLY FIRST CHARACTER
	CAIN	T1,'Y'			;[C20] A YES?
	MOVEI	T3,1			;[C20] YES, REMEMBER IT
	CAIN	T1,'N'			;[C20] A NO?
	MOVEI	T3,0			;[C20] YES, REMEMBER IT
	JUMPL	T3,E$$USV		;[C20] UNKNOWN SWITCH VALUE
	MOVEM	T3,STATSW		;[C20] STORE SWITCH VALUE
	POPJ	P,			;[C20] DONE

SRTDEN:	MOVE	T3,[-5,,1]		;[213] SET TO LOOP THRU VALID DENSITIES
  WHILE THERE ARE DENSITIES TO CHECK
	BEGIN
		CAME	T1,[DEC 200,556,800,1600,6250]-1(T3) ;[OK] [213] CHECK NEXT DENSITY
		AOBJN	T3,$B			;[213] NO GOOD--CHECK NEXT IF ANY
	END;
	JUMPGE	T3,E$$IDS		;[213] IF +, AOBJN FELL THROUGH
	HRRZS	T3			;[C20] [213] CONSTRUCT TAPOP. DENSITY ARG
	DPB	T3,[POINTR (S.MOD(P3),FX.DEN)] ;[C20] [213] AND SAVE IN SCAN BLOCK
	POPJ	P,

SRTSEQ: SRTVAR:
	MOVEI	T3,1			;SET UP A +1
	MOVEM	T3,S.VARI(P3)		;[C20] MARK VARIABLE RECORDS USED
	SKIPGE	P.VARF			;[202] DEFAULT SEEN YET?
	MOVEM	T3,P.VARF		;[202] NO--DEFAULT TO /VARIABLE
	POPJ	P,

STUFMD:	TXNN	P2,SC.KEY		;[213] DATA MODE SWITCHES MUST FOLLOW /KEY
	JRST	E$$DFK			;[213] ERROR OTHERWISE
STFMD1:	IORM	T3,MODE			;[213] SET DATA MODE IN CURRENT KEY
	IORM	T3,MODEM		;[213] SET DATA MODE IN CUMULATIVE MASK
	POPJ	P,			;[213] DONE

SUBTTL	SWITCH HANDLING -- /COLLATE:x[:y]

BEGIN
  PROCEDURE	(PUSHJ	P,SRTCOL)	;[355] PROCESS /COLLATE SWITCH
	PUSHJ	P,SCNSIX		;[355] GET SWITCH ARG
	JUMPE	T1,E$$CND		;[355] NULL SWITCH ARGUMENT ILLEGAL
	MOVE	T4,[-COL.L,,COL.T]	;[355] SEARCH TABLE FOR SWITCH VALUE
	PUSHJ	P,SCNTBL		;[355]   ..
	  JRST	E$$CND			;[355] NOT THERE--ERROR
	ADDI	T4,1			;[C20] [355] GET INDEX VALUE
  CASE COLSW OF ASCII, EBCDIC, FILESPEC, LITERAL, ADDRESS
	HRLI	T4,(IFIW)		;[C20]   ..
	MOVEM	T4,COLSW		;[355] STORE IT
	JRST	@[IFIWS <$C,$C,$1,$2,$3>]-1(T4) ;[C20] [355] DISPATCH

  $1%	PUSH	P,P2			;[355] SAVE CURRENT BLOCK AND FLAGS
	PUSH	P,P3			;[C20]   ..
	MOVX	P2,SC.EQU		;[C20] [355] SET UP NEW BLOCK AND FLAGS
	MOVEI	P3,COLSCN		;[C20]   ..
	ZERO	(T1,COLSCN,S.LEN)	;[355] CLEAR TEMP SCAN BLOCK
	PUSHJ	P,SCNSIX		;[355] GET FILE SPEC
	  IF WE GOT A DEVICE SPECIFICATION
		TXZN	T2,<1B':'>		;[355] VERIFY SWITCH ARGUMENT SEPARATOR
		JRST	$F			;[355] NOT THERE
	  THEN CHECK AND REMEMBER IT, AND READ FILE NAME
		JUMPE	T1,E$$NDV		;[355] NULL DEVICE ILLEGAL
		MOVEM	T1,S.DEV(P3)		;[C20] [355] SAVE DEVICE NAME
		TXO	P2,SC.DEV		;[355] REMEMBER WE GOT ONE
		PUSHJ	P,SCNSIX		;[355] GO GET FILE NAME
	  FI;
	JUMPE	T1,E$$CFS		;[355] NULL FILE NAME ILLEGAL TOO
	PUSHJ	P,SRTNAM		;[355] HANDLE NAME AND EXTENSION
	  IF A PATH WAS SPECIFIED
		TXZN	T2,1B19			;[355] LEFT SQUARE BRACKET?
		JRST	$F			;[355] NO--NO PATH
	  THEN PARSE IT
		PUSHJ	P,SCNOCT	;[355] READ PROJECT
		PUSHJ	P,SRTPPN	;[355] READ REST OF PATH
	  FI;
	POP	P,P3			;[C20] [355] RESTORE SCANNING FLAGS AND BLOCK
	POP	P,P2			;[C20]   ..
	RETURN				;[355] DONE HERE

  $2%	ILDB	T1,SRTPTR		;[C20] [355] GET DELIMITER OF STRING
	MOVE	T4,[POINT 7,COLITB]	;WHERE TO STORE LITERAL
	  WHILE CHARACTERS IN LITERAL
		BEGIN
			ILDB	T2,SRTPTR		;[C20] [355] GET CHAR
			CAMN	T2,T1			;[355] AT END?
			SETZ	T2,			;[355] YES, END WITH NUL
			IDPB	T2,T4			;[355] STORE  CHAR
			JUMPN	T2,$B			;[355] LOOP
		END;
	RETURN				;[355] DONE

  $3%	PUSHJ	P,SCNOCT		;[355] GET THE ADDRESS
	TXZE	T2,UPARO		;[355] FORMAL ARG?
	PUSHJ	P,PUPARO		;YES, PARSE THE ^
	MOVEM	T1,COLADR		;[C20] STORE THE ADDRESS
	RETURN				;[355] DONE

  ESAC;
	RETURN				;[355] DONE
END;

SUBTTL	SWITCH HANDLING -- /KEY:n:m:x

;	THIS CODE HANDLES /KEY(NOTE ACCUMULATOR ASSIGNMENTS!!)
;
;	T1 = KEY DATUM
;	T2 = KEY DATUM DELIMITER
;	T3 = POINTER TO KEY BLOCK
;	T4 = SCRATCH

BEGIN
  PROCEDURE (PUSHJ	P,SRTKEY)
	TXO	P2,SC.KEY		;NOTE THAT WE HAVE SEEN A KEY SPEC.
	MOVE	T4,MODE			;GET MODE
	SKIPE	T3,LSTKEY		;PTR(TOPREVIOUS KEY - SKIPS IF ZERO
	MOVEM	T4,KY.MOD(T3)		;[OK] STORE MODE FOR PREVIOUS KEY
	SETZM	MODE			;[202] START OUT WITH NO MODES
	PUSH	P,T1			;SAVE SCANNER ACS FROM GETSPC
	PUSH	P,T2			;
	MOVX	T1,KY.LEN		;GET ENOUGH SPACE TO HOLD KEY BLOCK
	PUSHJ	P,GETSPC		;HOLD THE KEY INFO
	  JRST	E$$NEC			;FAILED
	MOVE	T3,T1			;USE T3 INSTEAD(HOLDS POINTER TO BLOCK)
	POP	P,T2
	POP	P,T1			;GET BACK SCAN ACS(DATUM)
  IF THIS IS THE FIRST KEY SWITCH
	SKIPE	FSTKEY			;FIRST TIME
	JRST	$T			;NOT THE FIRST BLOCK - CHAIN IT
  THEN INITIALIZE THE KEY LIST
	MOVEM	T3,FSTKEY		;INITIALIZE LIST
	JRST	$F			;
  ELSE JUST PLACE AT END OF LIST
	MOVE	T4,LSTKEY		;[C20] CHAIN INTO LIST
	MOVEM	T3,(T4)			;[C20]
  FI;
	MOVEM	T3,LSTKEY		;POINT TO NEW END
	SETZM	KY.NXT(T3)		;[OK] CLEAR FORWARD POINTER
	SOJL	T1,E$$KOR		;CHECK FOR INVALID REL. TO 0
	MOVEM	T1,KY.INI(T3)		;[OK] STORE INITIAL BYTE
	CAIE	T0,':'			;LENGTH TO FOLLOW
	JRST	E$$KLR			;ERROR
	PUSHJ	P,SCNDEC		;GET KEY LENGTH
	JUMPE	T1,E$$KLR		;ERROR - ZERO NOT VALID EITHER
	MOVE	T3,LSTKEY		;POINT TO BLOCK
	MOVEM	T1,KY.SIZ(T3)		;[OK] STORE KEY LENGTH
	MOVX	T4,RM.ASC!RM.BIN!RM.SIX!RM.EBC;
	ANDM	T4,MODE			;ONLY BITS WE CARE ABOUT
	SETZM	KY.ORD(T3)		;[OK] SET DEFAULT TO BE ASCENDING
	CAIE	T0,':'			;ORDER FOLLOWING?
	RETURN				;DONE THEN
	PUSHJ	P,SCNSIX		;GO GET 'A' OR 'D'
	LSH	T1,-^D30		;RIGHT JUSTIFY IT
	MOVE	T3,LSTKEY		;POINT TO KEY BLOCK
	SKIPE	T1			;
	CAIN	T1,'A'			;ASCENDING?
	RETURN				;YES--DONE THEN
	CAIE	T1,'D'			;DESCENDING?
	JRST	E$$KAI			;NO--ERROR THEN
	SETOM	KY.ORD(T3)		;[OK] YES--CHANGE TO DESCENDING
	RETURN				;DONE
END;

SUBTTL	SWITCH HANDLING -- /FORMAT:xn.m

BEGIN
  PROCEDURE (PUSHJ	P,SRTFMT)
	TXNN	T2,<1B':'>		;/FORMAT TERMINATOR A ':'?
	JRST	E$$FSA			;NO
	PUSH	P,P1			;[C13] SAVE A PERM AC
	MOVE	P1,[POINT 6,.NMUL]	;[C13] LOAD UP DESTINATION PTR
  $1%	PUSHJ	P,SCNSIX		;[C13] GET A SIXBIT WORD
	MOVE	T0,[POINT 6,T1]		;[C13] TRANSFER SIXBIT WORD
	MOVEI	T3,6			;[C13]   ..
  $2%	ILDB	T4,T0			;[C13]   ..
	JUMPE	T4,$3			;[C13]   ..
	CAMN	P1,[POINT 6,.NMUE,35-6]	;[C13]   ..
	JRST	E$$FSA			;[C13]   ..
	IDPB	T4,P1			;[C13]   ..
	SOJG	T3,$2			;[C13]   ..
  $3%	TXZE	T2,<1B'.'>		;[C13] A PERIOD?
	MOVEI	T4,'.'			;[C13] YES
	TXZE	T2,<1B'+'>		;[C13] A PLUS?
	MOVEI	T4,'+'			;[C13] YES
	TXZE	T2,<1B'-'>		;[C13] A MINUS?
	MOVEI	T4,'-'			;[C13] YES
	JUMPN	T2,$4			;[C13] FINISH UP IF ANYTHING ELSE
	CAMN	P1,[POINT 6,.NMUE,35-6]	;[C13] STORE IT
	JRST	E$$FSA			;[C13]   ..
	IDPB	T4,P1			;[C13]   ..
	JRST	$1			;[C13] LOOP AROUND
  $4%	SETZ	T3,			;[C13] TERMINATE WITH NULL BYTE
	IDPB	T3,P1			;[C13]   ..
	POP	P,P1			;[C13] RESTORE PERM AC
	PUSH	P,T2			;[C13] SAVE DELIMITER
	PUSHJ	P,USRFMT		;[C13] PROCESS FORMAT
	POP	P,T2			;[C13] RESTORE DELIMITER
	RETURN				;DONE
END;

SUBTTL	SWITCH HANDLING -- /RECORD:n, /TEMP, /ESTIMATE:n, /UNLOAD
SUBTTL	SWITCH HANDLING -- /REWIND, /SUPPRESS:^n, /MERGE, /CHECK

SRTREC:	JUMPLE	T1,E$$RSR		;WAS IT SPECIFIED
	CAMLE	T1,RECORD		;USED THE LARGEST RECORD SIZE
	MOVEM	T1,RECORD		;GIVEN BY ANY /RECORD SWITCH
	POPJ	P,

SRTEMP:	TXNE	P2,SC.FNE		;ERROR IF FILE NAME WAS SEEN
	JRST	E$$FNT
	TXNE	P2,SC.DEV		;HAVE WE SEEN A DEVICE?
	JRST	SETEMP			;YES, NO NEED FOR DEFAULT
	MOVSI	T4,'DSK'		;SET DSK AS DEFAULT TMP DEVICE
	MOVEM	T4,S.DEV(P3)		;[C20]  PUT IT AWAY
SETEMP:	TXNE	P2,SC.EQU		;ERROR IF NOT PROCESSING INPUT SPEC.
	TXOE	P2,SC.TMP		;SET /TEMP SEEN
	JRST	E$$FMO
	SETZM	TEMPSW			;MAKING TEMPSW 0 IS SUFFICIENT
	POPJ	P,			;RETURN TO SCANNER(SCNSIT)

SRTEST:	TXNE	P2,SC.EQU		;OUTPUT SIDE?
	JRST	E$$FMI			;NOPE - SWITCH NOT VALID FOR INPUT SIDE
	MOVEM	T1,S.EST(P3)		;[C20] PUT AWAY USER FILE SIZE EST.
	POPJ	P,

SRTUNL:	HRRZI	T3,1			;SET UP A +1
	MOVEM	T3,S.UNL(P3)		;[C20] MARK THE UNLOAD
	POPJ	P,			;RETURN SCANNER

SRTREW:	HRRZI	T3,1			;SET UP A +1
	MOVEM	T3,S.REW(P3)		;[C20] MARK THE REWIND
	POPJ	P,			;RETURN TO SCANNER

SRTSUP:	PUSHJ	P,SCNSIX		;GET SWITCH ARG
	JUMPE	T1,E$$SVR
	MOVE	T4,[-SUP.L,,SUP.T]
	PUSHJ	P,SCNTBL		;LOOK FOR ARG
	  JRST	E$$USV
	ADDI	T4,1			;[C20] GET INDEX VALUE
	MOVEM	T4,SUPFLG		;STORE IT
	POPJ	P,

SRTMRG:	MOVEI	T1,1			;SET UP THE +1
	MOVEM	T1,MRGSW		;SIGNAL MERGE REQUIRED (RATHER THAN SORT)
	POPJ	P,

SRTCHK:	MOVEI	T1,1			;SET UP THE +1
	MOVEM	T1,WSCSW		;SIGNAL MERGE SEQUENCE CHECK REQUIRED
	POPJ	P,

SUBTTL	SWITCH HANDLING -- /ERROR:^n, /FATAL:^n

SRTERR:	TXZE	T2,UPARO		;FORMAL ARG?
	PUSHJ	P,PUPARO		;YES, PARSE THE ^
	MOVEM	T1,ERRADR		;[C20]
	POPJ	P,

SRTFAT:	TXZE	T2,UPARO		;FORMAL ARG?
	PUSHJ	P,PUPARO		;YES, PARSE THE ^
	MOVEM	T1,FERCOD		;[C20]
	POPJ	P,

PUPARO:	PUSHJ	P,SCNDEC		;GET THE ACTUAL
	CAILE	T1,1			;[C20] IS IT IN RANGE
	CAMLE	T1,FORCNT		;[C20]   ..
	JRST	E$$FEA			;NO
	ADD	T1,FORARG		;[C20] ADD IN BASE
	XMOVEI	T1,@-1(T1)		;[OK] GET THE ACTUAL
	POPJ	P,

SRTLEA:	MOVEM	T1,NUMRCB		;STORE NO. OF LEAVES
	MOVEM	T1,LEAVES		;[N11] ALSO SIGNAL /LEAVES SEEN
	POPJ	P,

SRTMTF:	CAIL	T1,3			;[N20] ALLOW 3 TO
	CAILE	T1,MX.TMP		;[N20] MAX. FILES
	JRST	E$$MTE			;[N20]
	SKIPE	XCHNO.			;[N20] UNLESS NO EXTRA CHANNELS
	JRST	HAVXCH			;[N20]
	CAILE	T1,MX.T15		;[N20] IN WHICH CASE ONLY ALLOW ORIGINAL 15
	JRST	E$$MTE			;[N20]
HAVXCH:	MOVEM	T1,MAXTMP		;[N20] STORE IT
	POPJ	P,			;[N20]

SUBTTL	FILE SPEC SCANNING ROUTINES

SRTDEV:	TXOE	P2,SC.DEV		;HAVE WE SEEN DEV: BEFORE
	JRST	E$$DDV			;YES, AN ERROR
	TXNN	P2,SC.EQU		;IS IT AN OUTPUT DEVICE?
	PUSHJ	P,ALLOUT		;YES, SET UP THE ONLY FD BLOCK
	MOVEM	T1,S.DEV(P3)		;[C20] SAVE THE DEVICE NAME
	POPJ	P,			;RETURN TO THE SWITCH SCANNER

SRTNAM:	TXOE	P2,SC.DEV		;HAS A DEV BEEN SPECIFIED?
	JRST	STFNAM			;YES, DONT HAVE TO SET UP DEVICE
	TXNN	P2,SC.EQU		;IS IT AN OUTPUT FILE NAME?
	PUSHJ	P,ALLOUT		;YES, AND SINCE NO DEVICE WE SET UP THE FD BLOCK
	MOVSI	T4,'DSK'		;SET UP DSK AS DEFAULT DEVICE
	MOVEM	T4,S.DEV(P3)		;[C20] PUT IT IN FILE BLOCK
STFNAM:	TXO	P2,SC.FNE		;SET NAME ENCOUNTERED
	MOVEM	T1,S.NAME(P3)		;[C20] SAVE THE FILE NAME
	SETOM	S.NAMM(P3)		;[C20] ONES A MASK
	TXZN	T2,<1B'.'>		;IS THERE AN EXTENSION FOLLOWING
	POPJ	P,
SRTEXT:	PUSHJ	P,SCNSIX		;YES, GET THE EXTENSION
	HLLOM	T1,S.EXT(P3)		;[C20]
	POPJ	P,			;RETURN TO SWITCH SCANNER

SRTPPN:	TXZN	T2,<1B','>		;CHECK FOR A COMMA
	PJRST	SCNDLM			;NO COMMA - ERROR
	JUMPG	T2,SCNDLM		;NO COMMA - ERROR
	HRLZ	T4,T1			;SAVE PROJECT NUMBER
	PUSHJ	P,SCNOCT		;GET PROGRAMMER NUMBER
	TXZ	T2,<1B21>		;CLEAR RIGHT BRACKET
	TXNN	T2,<1B','>		;ALLOW , AFTER PPN (FOR SFD'S)
	JUMPG	T2,SCNDLM		;ILLEGAL DELIMITER
	HRR	T4,T1			;SAVE PROGRAMMER NUMBER
	MOVEM	T4,S.DIR(P3)		;[C20] SAVE THE PPN
	SETOM	S.DIRM(P3)		;[C20] SET MASK TO -1
	MOVX	T1,FX.DIR		;[352] ALSO SET THE BIT THAT SCAN
	IORM	T1,S.MOD(P3)		;[C20] [352] WOULD HAVE SET WHEN PPN SEEN
	TXZN	T2,<1B','>		;[352] COMMA DELIMETER?
	POPJ	P,			;[352] NO.SO NO SFD
	PUSH	P,P3			;[C20] [352] SAVE CURRENT BLOCK
	HRLI	P3,-.FXLND+1		;[C20] [352] FORM SFD AOBJN POINTER
SRTSFD:	PUSHJ	P,SCNSIX		;[352] GET SFD NAME
	MOVEM	T1,S.SFD(P3)		;[C20] [352] SORE SFD NAME
	SETOM	S.SFD+1(P3)		;[C20] [352] AND MASK
	TXZE	T2,<1B21>		;[352] TEST FOR "}"
	JRST	SRTSFE			;[352] YES AND ENDED CORRECTLY
	TXNN	T2,<1B','>		;[352] MORE SFDS TO FOLLOW
	JRST	SCNDL1			;[352] NO. GIVE ERROR
	ADDI	P3,1			;[C20] [352] ACCOUNT FOR MASK
	AOBJN	P3,SRTSFD		;[C20] [352] GET NEXT SFD
	$ERROR	(?,SFD,<SFD depth greater than 5>)	;[352]
SRTSFE:	POP	P,P3			;[C20] [352] RESTORE BLOCK
	POPJ	P,

SUBTTL	SCAN INPUT ROUTINES - SIXBIT, Decimal, Octal, etc.
SCNDL1:	POP	P,P3			;[C20] [352] GET STACK RIGHT
SCNDLM:	MOVEI	T2,1			;SET ILLEGAL DELIMITER
SCNUDF:
SCNNER:	POPJ	P,			;DUMMY ENTRY POINT
SCNSIX:	MOVSI	T2,(POINT 6)		;SET SIXBIT BYTE POINTER
	AOJA	T2,SCNCON		;SET BYTE POINTER TO T1 ADDRESS
SCNOCT:	SKIPA	T2,[10]			;SET OCTAL SCAN MODE
SCNDEC:	MOVEI	T2,12			;SET DECIMAL SCAN MODE
SCNCON:	SETZ	T1,			;[C20] CLEAR THE OUTPUT WORD
SCNSI1:	SOSN	SRTCNT			;[C20] SKIP IF BUFFER NOT EMPTY
SCNSIZ:	PUSHJ	P,GETCOM		;GET ANOTHER DISK BLOCK OF COMMANDS
	ILDB	T0,SRTPTR		;[C20] LOAD ASCII CHARACTER
	SKIPG	ATSFLG			;ONLY IF WE ARE DOING @COMMAND
	JRST	SCNSI9			;NOPE,TREAT AS STRAIGHT LITERAL
	CAIN	T0,15			;IS CHAR. A CR?
	JRST	SCNSI1			;YES, JUST EAT IT
	CAIE	T0,12			;IS CHAR. A LF?
	JRST	SCNSI9			;NO, GO DO AS USUAL
	MOVX	T2,EOL			;MARK US FINISHED WITH THIS LINE
SCNSI8:	MOVE	T0,SRTPTR		;[C20] SAVE SCANNER'S POINTER AND COUNT
	MOVEM	T0,SAVPTR		;[C20]   ..
	MOVE	T0,SRTCNT		;[C20]   ..
	MOVEM	T0,SAVCNT		;[C20]   ..
	ILDB	T0,SRTPTR		;[C20] SEE IF THE NEXT BYTE IS NULL
	JUMPN	T0,CPOPJ		;RETURN THERE IS ANOTHER COMMAND
	SOSN	SRTCNT			;[C20] ANY CHARS LEFT IN BUFFER?
	PUSHJ	P,GETCOM		;NO, GET ANOTHER BUFFER
	SKIPE	ATSFLG			;ZEROED ON EOF
	JRST	SCNSI8			;GO FOR MORE
	MOVX	T2,EOL			;SET END OF LINE FLAG
	POPJ	P,			;RETURN

SCNSI9:	JUMPE	T0,SCNSI7		;QUIT ON A NULL
	CAIN	T0,11			;IS THIS CHAR. A TAB??
	JRST	SCNSI1			;YES, JUST EAT IT
	TRC	T0,140			;INVERT CONTROL AND SHIFT BITS
	TRNN	T0,140			;LOWER CASE ALPHA CHARACTER
	IORI	T0,40			;YES, SET TO UPPER CASE
	ANDCMI	T0,100			;SET TO SIXBIT AND CLEAR HIGH ORDER BIT
	CAIL	T0,'0'			;CHECK FOR CHARACTER RANGE
	CAILE	T0,'Z'			;IS THE A ALPHA NUMBERIC CHARACTER
	JRST	SCNSI2			;NO, CHECK FOR DELIMITER
	CAIGE	T0,'A'			;CHECK FOR ALPHA CHARACTER
	CAIG	T0,'9'			;CHECK FOR NUMBERIC
	JRST	SCNSI3			;YES ALPHA NUMBERIC CHARACTER
SCNSI2:	JUMPE	T0,SCNSI1		;CHECK FOR A BLANK CHARACTER
					;IGNORE BLANKS ALWAYS
	CAILE	T0,'Z'			;IS DELIMITER IN THE 7X GROUP
	ANDCMI	T0,50			;YES PUT IN THE 2X GROUP
	MOVSI	T2,400000		;MAKE A 1 BIT FLAG FOR DELIMETER
	JRST	SCNSI4			;MAKE THE FLAG
SCNSI7:	MOVSI	T2,400000		;MAKE A 1 BIT FLAG FOR THE DELIMITER
SCNSI4:	MOVN	T3,T0			;SET THE SHIFT COUNT
	LSH	T2,(T3)			;[OK] SET THE FLAG FOR THE DELIMITER
	POPJ	P,			;RETURN TO CALLER
SCNSI3:	TLNN	T2,-1			;CHECK FOR DIGIT MODE
	JRST	SCNSI6			;YES, GO TO DIGIT ROUTINE
	TLNE	T2,760000		;ALPHA/DIGIT ANY ROOM FOR OUTPUT
	IDPB	T0,T2			;YES, DEPOSIT BYTE
	JRST	SCNSI1			;RETURN FOR NEXT
SCNSI6:	CAIL	T0,+20(T2)		;[OK] IS DIGIT IN RANGE (OCTAL/DECIMAL)
	JRST	SCNDLM			;RETURN IMPOSSIBLE DELIMITER
	IMUL	T1,T2			;[C20] IN RANGE MAKE ROOM FOR NEW DIGIT
	ANDI	T0,17			;MAKE A BINARY DIGIT
	ADD	T1,T0			;ACCUMULATE THE SUM
	JRST	SCNSI1			;RETURN FOR NEXT DIGIT

SUBTTL	INDIRECT COMMAND FILE I/O ROUTINES

;	PROCESS AND SET UP FOR INDIRECT COMMAND FILE
;	I.E TAKE COMMAND(S) FROM DISK FILE INSTEAD OF ARGS.

SRTATS:	TXNE	P2,SC.FNE!SC.EQU	;FILE NAME OR EQUALS SEEN?
	JRST	E$$IIF			;YES, AN ERROR WHEN PROC. @
	JUMPE	T1,E$$IIF		;ERROR IF NO FILE NAME SPECIFIED
	MOVEM	T1,ATSFIL		;[C19] SAVE IND. FILE NAME
	SETZM	ATSFIL+1		;[C19] [213] ASSUME NULL EXTENSION
	TXZN	T2,<1B'.'>		;IS THERE AN EXTENSION?
	JRST	CHKEND			;NO, SEE IF END OF ARGUMENT
	PUSHJ	P,SCNSIX		;YES, GET EXTENSION
	JUMPE	T1,E$$IIF		;ERROR IF NO EXTENSION
	HLLZM	T1,ATSFIL+1		;[C19] SAVE LEFT HALF OF EXTENSION
CHKEND:	TXZN	T2,EOL			;END OF ARGUMENT?
	JRST	E$$IIF			;NOPE, JUNK AFTER @FILNAM.EXT
	MOVN	T2,MAXTMP		;[C19] GET MAX TEMP FILE NUMBER
	HRLZM	T2,TCBIDX		;[C19] MAKE AOBJ PTRAND PLACE IT APPROPRIATELY
	PUSHJ	P,GETCHN		;[C19] GET A CHANNEL
	  JRST	E$$NEH			;[C19] FAILED
	HRRZM	T1,ATSFLG		;REMEMBER CHANNEL  WERE USING
	DPB	T1,[POINT 4,XIN,12]	;SET UP AC FOR IN UUO
	DPB	T1,[POINT 4,XSTATZ,12]	;SET UP AC IN STATZ UUO
	DPB	T1,[POINT 4,XGETSTS,12]	;SET UP AC IN GETSTS UUO
	HRLS	T1			;[C19] BUILD FILOP. BLOCK, GET CHANNEL
	HRRI	T1,.FORED		;[C19] GET READ FUNCTION
	TXO	T1,FO.PRV		;[N14] BYPASS CHECKS IF [1,2] OR JACCT
	MOVEM	T1,FLPARG+.FOFNC	;[C19] STORE THEM
	.DMOVE	T1,[.IODMP		;[C19] GET DUMP MODE
		SIXBIT /DSK/]		;[C19] AND DEVICE (DSK ONLY!)
	.DMOVM	T1,FLPARG+.FOIOS	;[C19] STORE THEM
	SETZM	FLPARG+.FOBRH		;[C19] NO BUFFERS
	SETZM	FLPARG+.FONBF		;[C19]   ..
	HRRZI	T1,ATSFIL		;[C19] GET LOOKUP BLOCK ADDRESS
	MOVEM	T1,FLPARG+.FOLEB	;[C19] STORE IT
LOOKAT:	SETZM	ATSFIL+2		;[C19] CLEAN UP ATS LOOKUP BLOCK
	SETZM	ATSFIL+3		;[C19]   ..
	MOVE	T1,[.FOLEB+1,,FLPARG]	;[C19] DO READ FILOP.
	FILOP.	T1,			;[C19]   ..
	  SKIPA				;[C19] FAILED
	JRST	GETCOM			;[C19] OK
	CAIE	T1,ERFNF%		;[C19] FILE NOT FOUND?
	JRST	ERRFUF			;[C19] NO
	HLRZ	T1,ATSFIL+1		;[C19] GET LAST FILE EXTENSION
	JUMPE	T1,[MOVEI T1,'CCL' 	;[C19] IF NOT NULL THEN TRY CCL
		HRLZM	T1,ATSFIL+1	;[C19]   ..
		JRST	LOOKAT]		;[C19]   ..
	CAIN	T1,'CCL'		;[C19] IF NOT CCL THEN TRY CMD
	JRST	[MOVEI T1,'CMD' 	;[C19]   ..
		HRLZM	T1,ATSFIL+1	;[C19]   ..
		JRST	LOOKAT]		;[C19]   ..
	JRST	ERRFUF			;[C19]  GIVE UP

GETCOM:	MOVEI	T2,5*^D128		;[C20] CHAR CNT FOR ONE DSK BLOCK
	MOVEM	T2,SRTCNT		;[C20]   ..
	MOVE	T2,[POINT 7,COMBUF]	;[C20] SET PTR TO POINT AT DUMP INPUT
	MOVEM	T2,SRTPTR		;[C20]   BUFFER FOR SCANNER
	SETZB	T4,T2			;SET UP TO MAKE IOWD, INPUT AND RETURN
	HRRZI	T3,COMBUF-1		;GET POINTER TO BUFFER
	HRLI	T3,-200			;FINISH MAKING IOWD, ASK FOR A BLOCK
  IF 7-SERIES MONITOR
	SKIPN	M7.00			;[N12] 7-SERIES?
	JRST	$T			;[N12] NO
  THEN USE FILOP. FOR ALL I/O
	HRLZ	T2,ATSFLG		;[N12] GET CHANNEL
	HRRI	T2,.FOINP		;[N12] INPUT FUNCTION
	MOVEM	T2,FLPARG+.FOFNC	;[N12] TWO ARGS FOR DUMP MODE
	MOVEM	T3,FLPARG+.FOIOS	;[N12] IOWD
	MOVE	T2,[2,,FLPARG]		;[N12]
	FILOP.	T2,			;[N12]
	  FASTSKIP			;[N12] ERROR, T2 = STATUS
	POPJ	P,			;[N12] OK
	TXNN	T2,IO.EOT		;[N12] EOF?
	JRST	E$$IEC			;[N12] NO, GIVE ERROR MESSAGE
XCLOSE:	PUSH	P,T1			;[C19] SAVE T1
	MOVE	T1,ATSFLG		;[C19] RELEASE CHANNEL
	PUSHJ	P,RELCHN		;[C19]   ..
	POP	P,T1			;[C19] RESTORE T1
	SETZM	ATSFLG			;TURN OFF @ FLAG WORD
	POPJ	P,

  ELSE USE OLD I/O UUOs
XIN:	IN	,T3			;INPUT A DISK BLOCK OF COMMAND(S)
	  POPJ	P,			;NOW GO PROCESS IT
XSTATZ:	STATZ	,IO.EOT			;CHECK IF END OF FILE?
	JRST	XCLOSE			;YES, CLOSE UP THE FILE
XGETST:	GETSTS	,T4			;NOT AN EOF, WHAT WAS IT?
	JRST	E$$IEC			;OUTPUT STATUS WITH ERROR MESSAGE
  FI;

SUBTTL	ENDS.

BEGIN
  PROCEDURE	(PUSHJ	P,ENDS.)
	PUSHJ	P,RELSPC		;[C13] RELEASE ANY RETAINED MEMORY
	MOVE	T1,INPREC		;NUMBER OF RECORDS SORTED
	CAME	T1,OUTREC		;SAME NUMBER AS WE OUTPUT?
	PUSHJ	P,E$$RNI		;RECORD NUMBER INCONSISTENT
	PUSHJ	P,STATS			;[C20] TYPE STATISTICS IF NECESSARY
	RETURN
END;

SUBTTL	ERROR MESSAGES
E$$SVR:	$ERROR	(?,SVR,<Switch value required.>)
E$$USV:	$ERROR	(?,USV,<Unknown switch value.>)
E$$UDL:	$ERROR	(?,UDL,<Unknown delimiter.>)
E$$MOI:	$ERROR	(?,MOI,<Multiple output specs are illegal.>)
ERRUKS:	PUSH	P,T1
	$ERROR	(?,UKS,<Unknown switch />,+)
	POP	P,T1
	$MORE	(SIXBIT,T1)
	$DIE
E$$FMO:	$ERROR	(?,FMO,<File switches illegal in output file.>)
E$$DDV:	$ERROR	(?,DDV,<Double device illegal>)
E$$SFF:	$ERROR	(?,SFF,<Switches must follow file specs.>)
E$$IDS:	$ERROR	(?,IDS,<Illegal /DENSITY: value specified.>)
E$$FMI:	$ERROR	(?,FMI,<Output switch illegal in input file.>)
E$$DFK:	$ERROR	(?,DFK,<Data mode switches must follow a /KEY switch.>)
E$$IIF:	$ERROR	(?,IIF,<Illegal indirect file spec.>)
E$$IEC:	$ERROR	(?,IEC,<Input error from indirect command file.>)
E$$NDV:	$ERROR	(?,NDV,<Null device illegal.>)

SUBTTL	DUMMY ROUTINES FOR UNSUPPORTED FEATURES

GETSXR: GETEBR: PUTSXR: PUTEBR:
C3SEXT: C3UEXT: NSEEXT: NSSEXT: NUEEXT: NUSEXT:
ALSGEN: ALEGEN: CSSGEN: CSEGEN: CUEGEN: CUSGEN: NSEGEN: NSSGEN:
C3SKLX: C3UKLX: NSEKLX: NUEKLX: NSSKLX: NUSKLX:
	HALT

;DUMMY ROUTINES

CHKLBL: WRTEND: WRTLBL:
	POPJ	P,