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

SUBTTL	SRTPRM - PARAMETER FILE FOR NEW SORT
SUBTTL	D.M.NIXON/DMN/DPL/DZN/BRF/DLC/CLRH	5-Jun-81



;COPYRIGHT (C) 1975, 1981 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.


CUSTVR==0		;CUSTOMER VERSION
DECVER==4		;DEC VERSION
DECMVR==3		;DEC MINOR VERSION
DECEVR==467		;DEC EDIT VERSION

V%SORT==:<CUSTVR>B2+<DECVER>B11+<DECMVR>B17+DECEVR

SUBTTL	TABLE OF CONTENTS FOR SRTPRM


;                    Table of Contents for SRTPRM
;
;
;                             Section                             Page
;
;   1  SRTPRM - PARAMETER FILE FOR NEW SORT .....................   1
;   2  TABLE OF CONTENTS FOR SRTPRM .............................   2
;   3  CONDITIONAL ASSEMBLY PARAMETERS ..........................   3
;   4  REVISION HISTORY .........................................   4
;   5  DEFINITIONS
;        5.1  Accumulators ......................................   5
;        5.2  Recording Modes ...................................   6
;        5.3  FORTRAN Interface .................................   7
;        5.4  Special Monitor Definitions .......................   8
;        5.5  Business Instruction Set OPcodes ..................   9
;        5.5  Extended Addressing OPcodes .......................  10
;        5.7  Prototype File Spec, MTA and Key Blocks ...........  11
;        5.8  File Control Block and File Flags .................  12
;        5.9  Tree Node and Record Blocks .......................  13
;        5.10 Segment Control - ISEGMENT and SEGMENT ............  14
;        5.11  Error Handling
;             5.11.1  $ERROR ....................................  16
;             5.11.2  $MORE .....................................  17
;             5.11.3  $CRLF, $CHAR, $DIE ........................  18
;        5.12  Structure Macros
;             5.12.1  Descriptions ..............................  19
;             5.12.2  BEGIN, PROCEDURE, RETURN, END .............  22
;             5.12.3  IF, THEN, ELSE, FI, CASE, ESAC ............  23
;             5.12.4  WHILE, UNTIL, FOR, Debugging Macro ........  24
;             5.12.5  Initialization And Temporary Labels .......  25

SUBTTL	CONDITIONAL ASSEMBLY PARAMETERS

;FTKL10			;KL INSTRUCTIONS ALLOWED
;FTKI10			;KI INSTRUCTIONS ALLOWED
;FTDEBUG		;DEBUGGING HELP
;FTOPS20		;TOPS20 JSYS CODE
;FTCOBOL		;COBOL INTERFACE CODE
;FTFORTRAN		;SEPARATE FORTRAN-10 INTERFACE
;FTVM			;[N21] VIRTUAL MEMORY VERSION
;FTPRINT		;[373] PRINT PROGRAM STRUCTURE NESTING LEVEL
;FTEXSZ			;[C13] KEY EXTRACT CODE AREA SIZE
;FSORTSZ		;SIZE OF FSORT - NOTE THIS CANNOT BE CALCULATED

IFNDEF FTOPS20,<FTOPS20==1>
IFN FTOPS20,<FTKL10==1
		FTVM==1			;[N21] ALWAYS VM ON TOPS-20
		FTFORTRAN==0>
IFNDEF FTKL10,<FTKL10==1>
IFN FTKL10,<FTKI10==1>
IFNDEF FTKI10,<FTKI10==1>
IFNDEF FTDEBUG,<FTDEBUG==0>
IFNDEF FTFORTRAN,<FTFORTRAN==0>
IFNDEF FTCOBOL,<FTCOBOL==0>
IFE FTKL10!FTKI10,<FTVM==0>		;[N21] ALWAYS NON-VM ON KA10
IFNDEF FTVM,<FTVM==0>			;[N21] DEFAULT IS OFF
IFNDEF FTPRINT,<FTPRINT==0>		;[373] DON'T PRINT NESTING BY DEFAULT
IFNDEF FTEXSZ,<FTEXSZ==2000>		;[C13] USE 1K FOR KEY EXTRACTION CODE
IFNDEF FSORTSZ,<FSORTSZ==36000>		;SIZE OF FSORT

IFN FTOPS20,<FTOPS10==0>
IFE FTOPS20,<FTOPS10==1>

SEARCH	MACTEN		;*** YES, MUST REALLY BE SEARCHED ON BOTH SYSTEMS ***
IFE FTOPS20,<SEARCH	UUOSYM,SCNMAC>
IFN FTOPS20,<SEARCH	MONSYM,MACSYM>
SALL

.DIRECTIVE	FLBLST, SFCOND
IFN FTKI10,<.DIRECTIVE	KI10>

SUBTTL	REVISION HISTORY


;VERSION 1
;1	FIRST FIELD TEST RELEASE
;2	SECOND FIELD TEST RELEASE
;3	FIX QA FOUND BUGS
;4	FIX BUG IF RUN OF MORE THAN 400000 RECORDS
;5	FIX RANDOM BIT 35'S IN ASCII OUTPUT FILE
;6	TEST FOR DEVICE NUL:
;7	DON'T ADD EXTRA BUFFERS IF IN USE BIT IS ON FOR ALL BUFFERS IN RING
;10	ADD EXTRA BUFFERS IN CORRECT SEQUENCE
;11	STRIP LEADING NULLS AND TERMINATORS CORRECTLY AND EFFICIENTLY
;12	WAIT FOR ALL CHANNELS NOT JUST CHAN 0
;13	DON'T READ ONE CHAR TOO MANY AT GETAVR
;14	RECORD COUNT WRITTEN ONE TOO HIGH ON SIXBIT MTA FILES
;15	CALCULATE ELAPSED TIME CORRECTLY OVER MIDNIGHT
;16	DON'T RETURN CORE IF SOMEONE ELSE INCREASED IT AFTER SORT
;17	CORRECTLY HANDLE VARIABLE LENGTH ASCII RECORDS LESS THAN 6 CHAR LONG
;20	GET TO STOPR. CORRECTLY ON FATAL ERROR


;VERSION 2
;100	IMPLEMENT VERSION 2 FEATURES (EBCDIC, COMP-3, VARIABLE LENGTH, ETC)
;101	FIX BUG INTRODUCED IN PUTSXR & GETSXR
;102	FIX BUGS IN EBCDIC AND COMP-3 CODE
;103	IMPROVE TENEX CODE
;104	FIX VARIABLE ASCII WITH NUMERIC KEYS

;SORT version 2(104) Released on TOPS-10.
;105	FORCE SIXBIT FILES TO BE VARIABLE
;106	SETUP PPN OR SFD CORRECTLY FOR NEXT INPUT FILE
;107	IGNORE NULL INPUT FILES
;110	SIMPLIFY HANDLING OF SEQUENCE NUMBERS
;111	MORE TOPS-20 IMPROVEMENTS
;112	DO ROUNDING CORRECTLY ON FLOATING POINT OUTPUT
;113	RENAME SINGLE TEMP FILE CORRECTLY IF FILE ALREADY EXISTS

;SORT version 2(113) Released on TOPS-20.
;114	ACCEPT R SORT (COMMAND LINE) I.E. DO A RESCAN
;115	FIX VARIOUS PROBLEMS WITH DEFAULT PATHS
;116	MAKE MULTI-REEL FILES WORK CORRECTLY
;117	FIX SRTSCN SO THAT BLOCKED SIXBIT FILES THAT TAKE ONLY 1 RUN COME OUT BLOCKED
;120	FIX KL-10 BIS WRITE OF FIXED LENGTH ASCII AND EBCDIC RECORDS
;121	ADD ERJMP AFTER MTOPR ON TOPS-20
;122	FIX LAST RECORD OF FIXED LENGTH EBCDIC FILE
;123	DON'T ZERO TOO MANY WORDS WHEN CLEARING OUTPUT BUFFER
;124	CORRECT OUTPUT EBCDIC BYTE POINTER FOR DUMMY OUTPUT
;125	DELETE TEMP FILE IF USER ROUTINE EXITS BEFORE END-OF-FILE
;126	CORRECT BIS COMPARE WHEN BYTE POINTER IS 36 BITS (EBCDIC OR SIXBIT)
;127	CORRECT KL10 INPUT FOR VARIABLE LEN ASCII
;130	FIX VAR LNGTH RECS WITH XTRCTED KEYS
;131	FIX JUNK WRITTEN AT END OF LAST BLOCK ON OUTPUT FILE.
;132	FIX NEGATION OF DOUBLE PRECISION SIGNED NUMERICS ON KA.
;133	FIX CODE GEN OF DOUBLE PRECISION COMPARE ON KA.
;134	TYPE ERROR MESSAGES FOR ALL CROSS-CPU POSSIBILITIES.
;135	REMOVE USE OF MTOPR'S UNTIL SORT IS COMPLETELY JSYS-IZED FOR TOPS20
;136	DON'T SHARE BUFFER RING WHEN OUTPUT CHAN IS CLOSED IN COBOL SORT
;137	CLEAR ^O ON TOPS20 INSTEAD OF SETTING IT ON FATAL MESSAGES.
;140	CHANGE CHANNEL ALLOCATION SO MORE FILES CAN BE OPENED BY COBOL USER
;141	HANDLE MULTIPLE CORE EXPANSIONS PROPERLY SO SHRINK IN COBOL WORKS
;142	CAUSE SIXBIT RUNNING ON KL-10 TO SORT PROPERLY IN ALL CASES.
;143	HANDLE /FIX, /VAR MORE CONSISTENTLY, AND ISSUE BETTER ERROR MESSAGE
;144	MAKE NUMERIC UNSIGNED EBCDIC USE EBCDIC ROUTINES INSTEAD OF SIXBIT ONES.
;145	CAUSE EBCDIC ALPHANUMERIC RUNNING ON KL-10 TO SORT PROPERLY IN ALL CASES.
;146	USE WORD OFFSET IN CNVGEN SO SORTS WITH MORE THAN 1 CONVERTED KEY WORK.
;147	FIX AND CLEAN UP HANDLING OF EXTRACTED WORD COUNT IN ASCII I/O ROUTINES.
;150	FIX AND CLEAN UP HANDLING OF EXTRACTED WORD COUNT IN EBCDIC I/O ROUTINES.
;151	MAKE SRTSNA AND SRTROS FATAL ERRORS RATHER THAN WARNINGS.
;152	MAKE SURE R (AND RSAV) NEVER GETS -1 IN LH, DUE TO @RSAV.
;153	FIX ASCII ALPHANUMERIC COMPARISONS ON KL (BIS).
;154	FIX MORE ASCII AND EBCDIC I/O WHEN FTKL10==1.


;VERSION 3
;200	Implement stand-alone merge.
;	Implement COBOL merge.
;	Implement FORTRAN interface.
;	Start to implement collating sequence.

;SORT version 3(200) Released.
;201	Separate MODE into MODE for keys and IOMODE for I/O to avoid confusion.
;202	Fix Ill UUO and defaulting of /FIX, /VAR, /SEQ, /RAN, /BIN, /COMP and /FORMAT.
;203	Fix FORTRAN binary data files of all flavors.
;204	Change SIXBIT input to ignore zero words.
;205	Fix handling of tapes in sort case.
;206	Turn on FTOPS20 conditional for TOPS-20 SORT.
;207	Write .TMP files variable length in COBOL SORT.
;210	Check forgotten case in edit 131 so files are not padded with zeros.
;211	Make sure the last I/O channel is freed before returning in FORTRAN SORT.
;212	Fix random errors on second command to SORT when using /TEMP.
;213	Fix major incompatibilities in FORTRAN SORT's command scanner.
;214	Skip .TMP structures if OPEN or ENTER fails.
;215	Fix tape label checking in stand-alone SORT.
;216	Fix handling of line-sequenced ASCII files in KL case.
;217	Fix edit 207 so data record gets copied after the keys.
;220	Fix illegal instruction when handling tapes in FORTRAN SORT.
;221	Stop FORTRAN SORT from expanding more and more on TOPS-20.
;222	Fix DECODE errors when using /FORMAT.
;223	See that R gets initialized in SCAN in SRTFOR for ? I/O to unassigned channel.
;224	Fix SRTTFC and I/O to unassigned channel errors in SRTCBL on early ENDS. calls.


;VERSION 4
;300	JSYSize SORT.
;301	Allow input and output to have different blocking factors (QAR 20-00136).
;302	Fix bugs found from second field test tape.

;SORT/MERGE version 4(302) Released
;303	Fix compares of two character EBCDIC alphanumeric keys in the middle of a word.
;304	Fix ?SRTRIE errors on EBCDIC fixed-length files.
;305	On TOPS-20, fix blocking factor problems.
;306	On TOPS-10 binary sort, MAXKEY not set up caused divide by 0.
;307	Double precision unsigned comparison routine fixes.
;310	Var. length file with random line terminators fix.
;311	Fix SIXBIT alphanumeric compares of 6 chars starting on a word boundary.
;312	Fix performance bug when sorting blocked files.
;313	Fix SRTRBP errors during merge phase of a sort.
;314	Re-insert line that got lost out of edit 305.
;315	Fix definition of RETSKP to fix undefined RSKP labels.
;316	Fix various bad output files and ill mem refs in FORTRAN binary files.
;317	Clear junk in buffer header word of OPEN block
;320	Clean up FUNCT. after SORT (FSLOC.)
;321	Fix further blocking factor problems on TOPS-20, when blocks are huge.
;322    SIXBIT, word boundary, six char. length sign compare fix
;323	Fix loop when SORT has exactly enough memory but thinks it doesn't.
;324    SIXBIT blocked file  (generates only one temp file)   IO error
;325	TOPS-20,  ASCII MERGE loop  and SIXBIT nulls  fix
;326	TOPS-20  Allow multiple input files in SORT
;327	Fix merges when one or more input files are null, or more than MAXTMP files.
;330	FORTRAN SORT BINARY /COMP and non COMP fix
;331	Edit 327 broke sorts. Make RETRN. still return if not a merge.
;332	EDIT 322 broke SORT for SIXBIT alphanumeric files SORTED on .GT. 1 KEY.
;333	Default /LABELS: to STANDARD as documented on TOPS-20.

;SORT version 4A(333) with edit 337 released with COBOL-74 version 12.
;334	Fix expanding memory too much when LOGIN/CORE:n is used (e.g., BATCH).
;335	Use new form of JSYS names, NAME%, to solve global symbol conflicts.
;336	Clean up TOPS-20 command scanner - remove noise words from switches and /RMS.
;337	Really fix sorts back after edits 327 and 331.
;340	Fix /COLLATE loop on KA and KI
;341	ASCII records .EQ. /RECORD error message
;342	SIXBIT unblocked files which create only one .TMP  fix
;343	S/A SORT problem with GETTAB return of 0
;344	TOPS-20 SIXBIT blocked file can lose records
;345	MERGE problems closing out file too soon- E327 331 337
;346	S/A SORT problems with multiple command lines. Restore .JBFF
;347	Fix FORTRAN command scanner to process /SWITCH:^N correctly
;350	Fix FORTRAN command scanner to process DEV:/TEMP correctly
;351	Fix errors with /SUPRES, /FATAL, /ERROR, /LEAVES, /FORMAT
;352	Fix FORTRANs problems with SFDs and PPNs
;353	Fix TOPS-10 labeled tapes, /REWIND, and I/O error messages.
;354	Fix COBOL merge when called from non-resident COBOL overlay.
;355	On TOPS-10 scan /COLLATE:FILE:file-spec correctly (allow SFDs, etc.).
;356	In COBOL SORT, clear low segment data in case second call.
;357	On TOPS-20 print more information on certain fatal errors.
;360	On TOPS-20 convert DATE UUO to ODCNV% JSYS
;361	Allocate KEY extraction and compare space in high segment.
;362	Make SRTRNI message fatal.
;363	Make /SUPPRESS:INFORMATION suppress final messages from S/A SORT.
;364	Fix more FORTRAN SORT ill mem ref problems
;365	Merge last development work for SORT %4A into maintenance sources.
;366	On TOPS-20, write last word if it is the first word in a buffer.
;367	EBCDIC variable length fix for SRTRTI
;370	Fix truncated records if extracted keys and temp files are necessary.
;371	Make sure output buffers are cleared before output starts
;372	On TOPS-20, fix /BLOCKED:n to default properly.
;373	Add debugging facility for the structure macros, and fix bugs it finds.
;374	On TOPS-10, improve error messages SRTIRE and SRTOWE for temporary files.
;375	On TOPS-20, fix looping with multiple /KEY:s, broken by 372.
;376	On TOPS-20, properly reinitialize on a new line to prevent PDL overflows, etc.
;377	On TOPS-20, fix ?SRTOPN errors on multiple commands after edit 376.
;400	On TOPS-20, fix truncation of SIXBIT files after edit 366.
;401	On TOPS-20, fix SRTCCN errors when using magtapes.
;402	Skip non-existent records in FORTRAN RANDOM files instead of issuing ?SRTFCI.
;403	Fix EBCDIC alphanumeric comparisons similar to /KEY:8:2 and /KEY:8:4.
;404	Fix TOPS-10 SRTMUF errors when ASSIGN ALL DSK,etc. is used
;405	Fix TOPS-20 '?SRTNEC' for large files bug
;406	Fix ILL MEM REF or inability to generate tape labels caused by clobbering X.DVCH in STOPB
;407	Bad sorts for unblocked tape files- 10. Wrong recsize.
;410	Wrong record size from Fortran binary sorts with /NUMERIC
;411	Fix LOOKUP error msg loop when CCL and entry fails
;412	Non specified commands default to ASCII. Message when found otherwise.
;413	FORTRAN-10 problem with multiple key SORTs - SRTCGC msg
;414	Fix further problems after edit 353 with end-of-tape processing.
;415	COBOL SORT Address check when one .TMP file is created 
;416	/LEAVES causes no. of records to be reported, not no. leaves in tree
;417	Rec. trunc. message wrong. It reports characters not records.
;420	SORT-20 gives ?SRTAWP when outputting fix SIXBIT to tape
;421	SORT-20 allowed /ALI/BIN. Fix.
;422	SORT-20 now allows /DENSITY:6250
;423	SIXBIT SORTs that create only one .TMP file have output truncated
;424	TOPS-10 will not allow a unit to be temp device (DSKN0:)
;425	Edit 411 neglected to delete the TMPCOR file. Call SCAN and del it.
;426	Give error on SORT-20 allowing more than one /SUPPRESS
;427	Not all data was zeroed at new command (e.g. /LEAVES) on -20.
;430	A typo in edit 400 causes an ILL MEM REF to occur. Edit 366 is also needed.
;431	SORT calculates incorrect info for FOROTS DECODE arg block on /FORMAT
;432	SORT-10 does not allow a lowercase arg for /FORMAT-?SRTFSA occurs
;433	COBOL SORT's comparison rout. write locks  hi-seg pg on TOPS-20.
	;Make TOPS-10 code compatable.
;434	Fix multi-reel tape problem with EOT on TOPS-10.
;435	Fix a -20 SIXBIT blk bug; rewrite some code efficiently.
	; cleanup- spelling, table contents for v4B
;***	Add METERing code.

;SORT/MERGE version 4B(435) released.
;436	Point to output file on rename of single temp file.
;437	Fix -20 bug with SIXBIT unblocked files SRTJFO,SRTCCF.
;440	Fix Fixed EBCDIC with odd number of bytes in file.
;441	Fix reformatted buffer pool memory allocation.
;442	Fix problem with EBCDIC record descriptor word corruption.
;443	Eliminate sequence number overflow warning (%SRTSNO) and associated
;	      instability.
;444	Fix a TOPS-20 bug in which SOUT garbages output containing nulls.
;445	Fix a TOPS-10 bug by clearing .RBALC in ENTER block.
;446	Fix a 10/20 EBCDIC bug in SRTCMP which garbaged COMP-3 Key extraction.
;447	Fix the /NOCREATE bit in GENSTR routine.
;450	Allow explicit ALPHANUMERIC keys with EBCDIC.
;451	Not required in SORT 4C (part of edit C18).
;452	Not required in SORT 4C.
;453	Make TOPS-20 HELP command look in HLP: instead of SYS:.
;454	On TOPS-20 don't clear MRGSW (in CLRANS) after setting it.
;455	Save T4 in ERRRTI (see also C28).
;456	Not required in SORT 4C.
;457	Allow TOPS-20 SORT to CONTINUE after "?QUOTA EXCEEDED OR DISK FULL" message.
;460	Build the collating table (COLBUF) correctly for SIXBIT files when the
;	 user specifies his own collating sequence.
;461	Correct the calculation of MINKEY when there are extracted keys.
;462	First character of a collating sequence specified in a file is lost.
;463	On TOPS-20 close the TAKE and LOG files when SORT exits if a TAKE file was being processed.
;464	On TOPS-20 fix edit 457 to put out "$" before the error message for batch.
;	Also fix the continue after PMAP failure so that pages are not lost.
;465	On TOPS-20 fix the calculation of the number of bytes written to the output file.
;466	Not required in SORT 4C.
;467	Allow the space character to be specified using the quote facility
;	in an alternate collating sequence file.

;C01	Implement MTA switches on TOPS-20.
;C02	Fix MTA double buffering on TOPS-20.
;C03	Fix MTA last record in file processing.
;C04	Fix lower case labels.
;C05	Fix default buffer space allocations on TOPS-20.
;C06	Fix MTA blocking.
;C07	Fix MTA EOT processing.
;C08	Fix MTA labeling.
;C09	Implement defaulting of /BLOCKED:1 and /INDUSTRY for EBCDIC MTAs.
;C10	Change default TAKE log file to NUL: on TOPS-20.
;C11	Implement /POSITION:
;C12	Support automatic MTA labeling on TOPS-20.
;C13	Remove FOROTS hack and correct memory management.
;C14	Remove hacks for MACRO-10 negative relocation deficiency.
;C15	Renamed to EDIT 447.
;C16	Renamed to EDIT 450.
;C16	Allow explicit ALPHANUMERIC keys with EBCDIC.
;C17	Fix BLOCKING HACK on TOPS-20.
;C18	Use BIG disk buffers on TOPS-10.
;C19	Change as many UUO's to FILOP. UUO's as possible for new features.
;C20	Clean up code to allow SORT-10/20 to run in a non-zero memory SECTION.
;C21	Fix memory reallocation bug in SORT-10.
;C22	Fix problem with unlabeled magnetic tapes through MOUNTR in SORT-20.
;C23	Fix problem with determining high segment size in SORT-10.
;C24	Fix problem with PHYSICAL LIMIT 0 in SORT-10.
;C25	Support for new PULSAR label types in SORT-10.
;C26	Fix bug concerning .TMP files and no UFD's in SORT-10.
;C27	Renamed to EDIT 444.
;C28	Fix record truncation on input destroying ACs (see also EDIT 455).
;C29	Fix default memory for SORT-10 on KI's and KL's.

;N01	Some minor code bumming.
;N02	Give error message if not enought input files for MERGE.
;N03	Change .LINK pseudo-op number to avoid conflict with COBOL-74 /R
;N04	Fix COBOL SORT on KA-10 to assemble correctly again.
;N05	Give file not found message as early as possible to avoid unnecessary memory expansion.
;N06	Reset CORSTK if an error occurs in SCAN (TOPS-10 only).
;N07	Fix edit C29 to work for COBOL SORT (TOPS-10 only).
;N08	More fixes to DEFCOR to account for VMDDT and V/M limits (TOPS-10 only).
;N09	Fix calculation of number of temp files on TOPS-10.
;N10	Delete FTCOL feature test switch, the code is always generated.
;N11	Add switches NOCRLF, AFTER-ADVANCING, and BEFORE-ADVANCING.
;N12	If TOPS-10 7-series monitor use FILOP.s for all I/O operations.
;N13	On TOPS-20 don't turn on page creation interupt if RMS turned it off.
;N14	On TOPS-10 bypass protection check if job is [1,2] or JACCT.
;N15	Fix read from NUL: device on TOPS-20.
;N16	Fix bug with very large keys using more than FTEXSX space.
;N17	Use extended channels if TOPS-10 7.01.
;N18	Fix bad sort for SIXBIT key /K:n:3 where n is a multiple of 6.
;N19	Return /ERROR-CODE in 3 ASCII chars. rather than 6 SIXBIT ones.
;N20	On TOPS-10 increase number of temp files to 26 if extended channels available.
;N21	On TOPS-10 put segmentation back the way it was, put new code under FTVM conditional.
;N22	On TOPS-10 fix default core allocation "off by one" bug causing not enough core error.
;N23	Make SORT with double precision COMP keys work again.
;N24	Make FILOP. DELETE work in both 7.01 and 7.02 (problem with FO.UOC bit).
;N25	Allow either " or ' to delimit quoted characters in COLLATING sequence.
;N26	On TOPS-20 fix bug with multiple input files on magtape.
;N27	Fix memory allocation in SORT for very large FORTRAN programs.

;SORT/MERGE version 4C(???) released.

SUBTTL	DEFINITIONS -- Accumulators


	.XCREF			;[373] DON'T FILL CREF WITH USELESS SYMBOLS

	EF=0			;END OF FILE STATUS
	T0=0			;USED IN EXTRACT ROUTINES
	T1=1			;TEMPORARY
	T2=2
	T3=3
	T4=4
	P1=5			;PRESERVED
	P2=6
	P3=7
	P4=10
	F=11			;FILE PTR
	U=12			;GENERAL AOBJN PTR
	J=13			;2ND RECORD PTR
	R=14			;1ST RECORD PTR
	S=15			;NODE PTR
	L=16			;EXTERN ARG-LIST PTR
	P=17			;PUSHDOWN PTR

	.XCREF	EF,T0,T1,T2,T3,T4,P1,P2,P3,P4,F,U,J,R,S,L,P
	.CREF

PGSIZ==1000			;SIZE OF ONE PAGE
PGMSK==PGSIZ-1			;[365] MASK FOR TESTING PAGE ALIGNMENT
PDLEN==100			;SIZE OF STACK
IFE FTOPS20,<
MX.T15==^D15			;[N20] MAXIMUM NUMBER OF TEMP FILES IF NO EXTENDED CHANS.
>
MX.TMP==^D26			;ONE FOR EACH LETTER OF THE ALPHABET
U.CHN==3			;NUMBER OF CHANNELS TO TRY TO LEAVE TO USER
MX.INP==^D100			;MAX NUMBER OF INPUT FILES
MX.OUT==^D20			;MAX NUMBER OF OUTPUT FILES
MAXXSZ==^D100			;MAX KEY SIZE TO TRY OPTIMAL COMPARISONS
STCKSZ==100			;[N06] SIZE OF CORSTK

SUBTTL	DEFINITIONS -- Recording Modes


RM.ASC==1B0			;ASCII - DISPLAY-7
RM.SIX==1B1			;SIXBIT - DISPLAY-6
RM.EBC==1B2			;EBCDIC - DISPLAY-9
RM.BIN==1B3			;BINARY - 36 BIT
RM.ALP==1B4			;ALPHANUMERIC
RM.COM==1B5			;COMPUTATIONAL
RM.NUM==1B6			;NUMERIC
RM.PAC==1B7			;PACKED - COMP-3
RM.SGN==1B8			;SIGNED
RM.UNS==1B9			;UNSIGNED
RM.FPA==1B16			;FLOATING POINT
RM.FOR==1B17			;FORTRAN DATA FILE

ADV.B==0			;WRITE RECORD BEFORE ADVANCING (COBOL-68 DEFAULT).
ADV.A==1			;WRITE RECORD AFTER ADVANCING (COBOL-74 DEFAULT).

;INDEX BITS FOR RECORDING MODE. XX IS A MACRO THAT GETS REDEFINED AT VARIOUS
;TIMES. 1ST ARG IS DISPATCH ADDRESS AND 2ND ARG IS ONE OF THE FOLLOWING:
;
;	A - ALWAYS EXTRACT KEYS
;	C - CONDITIONALLY EXTRACT KEYS DEPENDING UPON COLLATING SEQ. FLAG
;	N - NEVER EXTRACT KEYS

DEFINE IXMODE,<
XX	(ALS,C)			;ALPHANUMERIC LOGICAL SIXBIT
XX	(ALA,C)			;ALPHANUMERIC LOGICAL ASCII
XX	(ALE,C)			;ALPHANUMERIC LOGICAL EBCDIC
XX	(NSS,A)			;NUMERIC SIGNED SIXBIT
XX	(NSA,A)			;NUMERIC SIGNED ASCII
XX	(NSE,A)			;NUMERIC SIGNED EBCDIC
XX	(NUS,A)			;NUMERIC UNSIGNED SIXBIT
XX	(NUA,A)			;NUMERIC UNSIGNED ASCII
XX	(NUE,A)			;NUMERIC UNSIGNED EBCDIC
XX	(CSS,N)			;COMPUTATIONAL SIGNED SIXBIT
XX	(CSA,N)			;COMPUTATIONAL SIGNED ASCII
XX	(CSE,N)			;COMPUTATIONAL SIGNED EBCDIC
XX	(CUS,N)			;COMPUTATIONAL UNSIGNED SIXBIT
XX	(CUA,N)			;COMPUTATIONAL UNSIGNED ASCII
XX	(CUE,N)			;COMPUTATIONAL UNSIGNED EBCDIC
XX	(C3S,A)			;COMP-3 SIGNED
XX	(C3U,A)			;COMP-3 UNSIGNED
XX	(CSB,N)			;COMPUTATINAL SIGNED BINARY
XX	(CUB,N)			;COMPUTATIONAL UNSIGNED BINARY
XX	(NSB,N)			;[330] NONCOMP SIGNED BINARY
XX	(NUB,N)			;[330] NONCOMP UNSIGNED BINARY
XX	(FPA,A)			;FLOATING POINT ASCII
>

;GENERATE INDEX
ZZ==0
DEFINE XX(A,B)<
IX.'A==ZZ
ZZ==ZZ+1
>
IXMODES

SUBTTL	DEFINITIONS -- FORTRAN Interface


;FORTRAN BINARY LSCW'S

S.LSCW==001000			;START
C.LSCW==002000			;CONTINUE
E.LSCW==003000			;END

;FORTRAN DATA TYPES

TP%UDF==0			;UNDEFINED TYPE
TP%LOG==1			;LOGICAL
TP%INT==2			;INTEGER
TP%REA==4			;REAL
TP%OCT==6			;OCTAL
TP%LBL==7			;LABEL OR ADDRESS
TP%DOR==10
TP%DOT==12
TP%COM==14
TP%LIT==17			;ASCIZ TEXT (LITERAL STRING)

;FORTRAN IOLST. FUNCTIONS

OPDEF	DATA.[1B8]		;CONVERT SINGLE DATA ELEMENT
OPDEF	SLIST.[2B8]		;CONVERT AN ENTIRE ARRAY
OPDEF	FIN.[4B8]		;IMPLIED CALL TO FIN.

;FUNCT. ARGUMENTS

F.GAD==1			;GET CORE AT SPECIFIC ADDRESS
F.COR==2			;GET CORE AT ANY ADDRESS
F.RAD==3			;RETURN CORE AT ADDRESS
F.GCH==4			;GET CHANNEL ARGUMENT
F.RCH==5			;RETURN CHANNEL NUMBER
F.GOT==6			;GET CORE FROM OTS LIST
F.ROT==7			;RETURN CORE TO OTS LIST
F.CBC==12			;CUT BACK CORE (SHRINK)

SUBTTL	DEFINITIONS -- Special Monitor Definitions


;MACRO TO DEFINE AN OPDEF BUT SUPPRESS ITS TYPEOUT FROM DDT.

DEFINE SOPDEF(OP,VAL)<			;;[373]
  OPDEF OP[VAL]				;;[373] DEFINE THE OPCODE
  .NODDT OP				;;[373] SUPPRESS ITS TYPEOUT FROM DDT
>

;EXIT TO MONITOR--NOTE THAT BOTH OF THESE ARE CONTINUABLE!

IFE FTOPS20,<OPDEF MONRET[MONRT.]>
IFN FTOPS20,<OPDEF MONRET[HALTF%]>

;OTHER USEFUL OPDEFS

DEFINE	FASTSKIP<JRST	.+2>		;FASTEST SKIP--DON'T USE IN LITERALS
IFE FTKL10,<OPDEF	NOOP[JFCL]>	;FASTEST NO-OP ON KA10/KI10
IFN FTKL10,<OPDEF	NOOP[TRN]>	;FASTEST NO-OP ON KL10

SOPDEF	CALL,<PUSHJ P,>			;[373] JUST IN CASE
SOPDEF	RET,<POPJ P,>			;[373]   ..
OPDEF	CALLRET[JUMPA 16,]		;[373] MAKE DDT KNOW THE DIFFERENCE
OPDEF	PJRST[JUMPA 17,]		;[373]   PJRST AND JRST, ETC.
OPDEF	RETSKP[CALLRET CPOPJ1]		;[373]   ..

;MACRO TO ZERO A BLOCK OF MEMORY. AC IS A TEMPORARY ACCUMULATOR, BLOCK
;AND LENGTH ARE THE ADDRESS AND LENGTH OF THE BLOCK.

DEFINE ZERO(AC,BLOCK,LENGTH)<		;;[355]
  SETZM BLOCK				;;[355] ZERO FIRST WORD
  MOVE AC,[<BLOCK>,,<BLOCK+1>]		;;[355] ZERO REST OF BLOCK
  BLT AC,<BLOCK>+<LENGTH>-1		;;[355]   ..
>

;DEFINE DMOVE, DMOVE, DMOVN FOR KA10 IF NECESSARY, REMEMBERING REAL DEFINITIONS

IF1,<
SOPDEF	.DMOVE,<DMOVE>			;[373] SAVE DEF OF REAL DMOVE INSTR
SOPDEF	.DMOVM,<DMOVEM>			;[373]   AND DMOVEM TOO
SOPDEF	.DMOVN,<DMOVN>			;[C13]   AND DMOVN TOO
>
IFE FTKI10!FTKL10,<			;ASSEMBLE ONLY IF KA10
 DEFINE DMOVE(AC,M)<
  IFL <Z M>-<	@>,<			;;[OK]
	MOVE	AC,M
	MOVE	AC+1,1+M
  >
  IFGE <Z M>-<@>,<			;;[OK]
	MOVEI	AC+1,M
	MOVE	AC,(AC+1)		;;[OK]
	MOVE	AC+1,1(AC+1)		;;[OK]
  >
 >

 DEFINE DMOVEM(AC,M)<
	MOVEM	AC,M
	MOVEM	AC+1,1+M
 >

 DEFINE DMOVN(AC,M)<			;[C13]
	DMOVE	AC,M			;[C13]
	DFN	AC,AC+1			;[C13]
 >					;[C13]
>;END IFE FTKI10!FTKL10

;MACROS TO TYPE STRINGS AND CHARACTERS

DEFINE	TYPE(MESSAGE)<
 IFE FTOPS20,<
	OUTSTR	[ASCIZ \MESSAGE\]
 >
 IFN FTOPS20,<
	HRROI	T1,[ASCIZ \MESSAGE\]
	PSOUT%				;;[335]
 >
>

DEFINE	TYPEC(ACC)<
 IFE FTOPS20,<
	OUTCHR	ACC
 >
 IFN FTOPS20,<
  IFN <ACC>-T1,<
	HRRZ	T1,ACC
  >
	PBOUT%				;;[335]

 >
>

;MACRO TO CLEAR CTRL/O. NOTE THAT IT POTENTIALLY DESTROYS T1 AND T2.

DEFINE	CLEARO<
 IFE FTOPS20,<
	SKPINL				;;ANY INPUT OPERATION CLEARS ^O
	  JFCL
 >
 IFN FTOPS20,<
	MOVEI	T1,.PRIOU		;;READ JFN MODE WORD
	RFMOD%				;[335] ;  ..
	TXZE	T2,TT%OSP		;;TURN OFF OUTPUT-SUPPRESS
	SFMOD%				;[335] ;  ..
 >
>

;MONITOR TYPE GETTAB. NOTE THAT THIS GETTAB IS SIMULATED ON TOPS-20 WITHOUT
;CALLING IN THE COMPATIBILITY PACKAGE.

%CNMNT==112,,11			;CONFIGURATION GETTAB
CN%MNT==77B23			;MASK FOR MONITOR TYPE

IFN FTOPS20,<
CSTKLN==50			;LENGTH OF CORE ALLOCATOR STACK
>

;CPU TYPES

KA.CPU==0
KI.CPU==1
KL.CPU==2

SUBTTL	DEFINITIONS -- Business Instruction Set OPcodes


;DEFINE BIS OPCODES--MACRO KNOWS THEM BUT DDT DOESN'T YET

	OPDEF	CMPSL	[CMPSL]		;COMPARE STRINGS, SKIP IF LESS
	OPDEF	CMPSE	[CMPSE]		;COMPARE STRINGS, SKIP IF EQUAL
	OPDEF	CMPSLE	[CMPSLE]	;COMPARE STRINGS, SKIP IF LESS OR EQUAL
	OPDEF	CMPSGE	[CMPSGE]	;COMPARE STRINGS, SKIP IF GREATER OR EQUAL
	OPDEF	CMPSN	[CMPSN]		;COMPARE STRINGS, SKIP IF NOT EQUAL
	OPDEF	CMPSG	[CMPSG]		;COMPARE STRINGS, SKIP IF GREATER
	OPDEF	EDIT	[EDIT]		;PROCESS STRING ACCORDING TO MINI-PROGRAM PATTERN
	OPDEF	CVTDBO	[CVTDBO]	;CONVERT DECIMAL TO BINARY BY OFFSET
	OPDEF	CVTDBT	[CVTDBT]	;CONVERT DECIMAL TO BINARY BY TRANSLATION
	OPDEF	CVTBDO	[CVTBDO]	;CONVERT BINARY TO DECIMAL BY OFFSET
	OPDEF	CVTBDT	[CVTBDT]	;CONVERT BINARY TO DECIMAL BY TRANSLATION
	OPDEF	MOVSO	[MOVSO]		;MOVE STRING WITH BYTE OFFSET
	OPDEF	MOVST	[MOVST]		;MOVE STRING WITH BYTE TRANSLATION
	OPDEF	MOVSLJ	[MOVSLJ]	;MOVE STRING UNMODFIED WITH LEFT JUSTIFICATION
	OPDEF	MOVSRJ	[MOVSRJ]	;MOVE STRING UNMODIFIED WITH RIGHT JUSTIFICATION

	OPDEF	ADJBP	[ADJBP]		;ADJUST BYTE POINTER

S.FLAG==1B0				;SIGNIFICANCE FLAG
N.FLAG==1B1				;NON-ZERO FLAG
M.FLAG==1B2				;MINUS FLAG

E.SBIT==400000				;SET S AND N FLAGS
E.ABRT==100000				;ABORT EDIT (NO SKIP)
E.MCLR==200000				;CLEAR M FLAG
E.MSET==300000				;SET M FLAG

SUBTTL	DEFINITIONS -- Extended Addressing Instruction Set OPcodes


;DEFINE EXTENDED ADDRESSING OPCODES

	OPDEF	XMOVEI	[SETMI]		;[C20]
	OPDEF	XHLLI	[HLLI]		;[C20]
	OPDEF	XJRSTF	[JRST 5,]	;[C20]
	SOPDEF	IFIW,	<1B0>		;[C20]
	DEFINE	IFIWS(A),<IRP <A>,<IFIW	A>>	;[C20]

SUBTTL	DEFINITIONS -- Prototype File Spec, MTA and Key Blocks


	LOC	0
X.NXT:!	BLOCK	1		;POINTER TO NEXT
IFE FTOPS20,<			;ONLY WANT THESE ON TOPS10
X.OPN:!	BLOCK	3		;[215] OPEN BLOCK FOR FILE
X.DVSZ:!BLOCK	1		;DEVSIZ UUO
X.DVCH:!BLOCK	1		;DEVCHR UUO
X.RIB:!	BLOCK	.RBALC+1	;[215] LAST NEEDED + COUNT WORD
X.PTH:!	BLOCK	.PTMAX		;[215] SFDS
>;END IFE FTOPS20
IFN FTOPS20,<			;ONLY WANT THESE ON TOPS20
X.DVCH:!BLOCK	1		;WORD RETURNED BY DVCHR JSYS
X.JFN:!	BLOCK	1		;JFN OF FILE (UNTIL COPIED TO FCB)
X.FLGM:!BLOCK	1		;FLAG MASK WORD
X.RIB:!	BLOCK	2		;SIXBIT NAME, EXT, FOR LABEL CHECKING
X.PAR:!	BLOCK	1		;[C01] PARITY
>;END IFN FTOPS20
X.DEN:!	BLOCK	1		;[215] DENSITY FOR TAPOP.
X.REEL:!BLOCK	1		;[215] REEL NUMBER FOR MULTI-REEL FILES
X.FLG:!	BLOCK	1		;[215] HOLDS FLAGS UNTIL MOVED TO FILFLG
X.BLKF:!BLOCK	1		;BLOCKING FACTOR
X.LABL:!BLOCK	1		;LABEL TYPE
X.POSI:!BLOCK	1		;[C11] /POSITION VALUE, <0 = NO POSITIONING
				;[C11]  1B1=1 INDICATES BACKSPACE
LN.X==.-X.NXT
	RELOC

IFN FTOPS20,<

;WORDS IN X.RIB TO HOLD SIXBIT FILENAME, EXT, FOR TAPE LABELS

.RBNAM==0
.RBEXT==1
>

;PROTOTYPE DATA BLOCK FOR MULTIPLE OUTPUT MTA SPECS

	LOC	0
OM.NXT:!BLOCK	1		;LINK TO NEXT
OM.DEV:!BLOCK	1		;DEVICE
OM.LEN==.-OM.NXT
	RELOC

;PROTOTYPE DATA BLOCK FOR KEYS

	LOC	0
KY.NXT:!BLOCK	1		;LINK TO NEXT
KY.INI:!BLOCK	1		;INITIAL BYTE POSITION
KY.SIZ:!BLOCK	1		;SIZE OF KEY IN BYTES OR DIGITS
KY.ORD:!BLOCK	1		;ASCENDING OR DESCENDING
KY.MOD:!BLOCK	1		;MODE OF KEY
KY.FMT:!BLOCK	3		;[C13] FORMAT IF FPA
				;[C13] KY.FMT+0 = FIELD WIDTH (-1=FREE FORMAT)
				;[C13] KY.FMT+1 = DECIMAL PLACES
				;[C13] KY.FMT+2 = SCALING FACTOR
				;[C13]            1B0=1 INDICATES DOUBLE PRECISION
KY.LEN==.-KY.NXT
	RELOC

SUBTTL	DEFINITIONS -- File Control Block and File Flags


;FILE DEPENDENT FLAGS IN FILFLG

FI.VAR==1B0			;VARIABLE LENGTH RECORDS
FI.IND==1B1			;INDUSTRY COMPATIBLE MODE
FI.STA==1B2			;STANDARD ASCII
FI.REW==1B3			;REWIND BEFORE USE
FI.UNL==1B4			;UNLOAD AFTER USE
FI.ATO==1B5			;[215] TAPE LABEL PROCESSOR IS HANDLING LABELS
FI.EOT==1B6			;[215] END-OF-TAPE FOR MULTI-REEL FILE
FI.MTA==1B7			;FILE IS ON A MAGTAPE
FI.DSK==1B8			;FILE IS ON DISK
FI.BF2==1B9			;SECOND (MAGTAPE) BUFFER IN USE
FI.OUT==1B10			;FILE IS AN OUTPUT FILE
FI.TMP==1B15			;THIS IS A TEMP FILE

;FILE CONTROL BLOCK

	LOC	0
FILSIZ:!BLOCK	1		;SIZE OF FILE IN RECORDS
FILRUN:!BLOCK	0		;RUN NUMBER (LHS)
FILNAM:!BLOCK	1		;FILE NAME INDEX (RHS)
IFN FTOPS20,<
FILEOF:!BLOCK	1		;EOF COUNTER (IN BYTES)
FILPGN:!BLOCK	1		;JFN,,NEXT PAGE TO READ
>
DFBLEN==.			;LENGTH OF DORMANT BLOCK
IFN FTOPS20,<
FILBF2:!BLOCK	1		;[C02] WHERE SECOND MAGTAPE BUFFER STARTS
FILHBW:!BLOCK	1		;[C03] MTA HARDWARE BYTES PER WORD
>
IFE FTOPS20,<
FILCHN:!BLOCK	1		;[C19] FILE CHANNEL
FILHDR:!BLOCK	1		;BUFFER HEADER
>				;END IFE FTOPS20
FILPTR:!BLOCK	1		;POINTER TO NEXT WORD IN CURRENT BUFFER
FILCNT:!BLOCK	1		;BUFFER COUNT
FILBUF:!BLOCK	1		;(TOPS10) WHERE BUFFERS START (BUFPTR)
				;(TOPS20) BUFFER SIZE (PGS),,1ST PAGE
				;(TOPS20)   EXCEPT MAGTAPE, WHICH HAS:
				;(TOPS20)   BUF SIZE (WORDS),,1ST WORD
FILBPB:!BLOCK	1		;[C18] BYTES PER BUFFER ACCORDING TO I/O MODE
FILBLK:!BLOCK	1		;FILE BLOCKING FACTOR
FILBPK:!BLOCK	1		;[C17] FILE BLOCK SIZE IN BYTES
FILKCT:!BLOCK	1		;[C17] FILE BLOCK BYTE COUNT
FILFLG:!BLOCK	1		;SEE FI.??? FLAGS ABOVE
FILXBK:!BLOCK	1		;[215] POINTER TO X.???? BLOCK FOR FILE
FCBLEN==.			;SIZE OF FCB
	RELOC

SUBTTL	DEFINITIONS -- Tree Node and Record Blocks


;PROTOTYPE NODE FOR RECORD TREE

	LOC	0
RN.RUN:!			;RUN NUMBER (LHS)
RN.LSR:!BLOCK	1		;PTR. TO LOSE (RHS)
RN.FI:!				;PTR. TO INTERNAL NODE FATHER (LHS)
RN.FE:!	BLOCK	1		;PTR. TO EXTERNAL NODE FATHER (RHS)
RN.SEQ:!			;SEQUENCE # ON SORT PHASE (LHS)
RN.FCB:!			;PTR TO FCB ON MERGE PHASE (LHS)
RN.REC:!BLOCK	1		;PTR. TO RECORD $ KEYS (RHS)
RN.LEN==.			;LENGTH
	RELOC


;PROTOTYPE RECORD BLOCK

	LOC	0
RC.CNT:!BLOCK	1		;BYTE COUNT
RC.KEY:!BLOCK	1		;FIRST DATA WORD
	RELOC

;TYPE OF INPUT 

T.SIX==0			;SIXBIT
T.ASC==1			;ASCII
T.EBC==2			;EBCDIC

;FLAGS FOR LEFT SIDE OF P1 DURING CNVTDB

FL.SGN==1B0			;VALUE IS SIGNED
FL.DP==1B1			;VALUE IS 2 WORDS

LED.SG==(3)			;LEADING SIGN MASK
LED.PL==(1)			;LEADING +
LED.MI==(2)			;LEADING -

;SPECIAL FLAGS IN CONVERSION TABLES
CF.S==1B0			;SPECIAL FLAG
CF.N==1B1			;NEGATIVE SIGN
CF.P==1B2			;PLUS SIGN
CF.L==1B3			;LEADING CHARACTER (TAB SPACE)
CF.Z==1B4			;NUL
CF.O==1B5			;OVERPUNCHED NEGATIVE
CF.I==1B6			;ILLEGAL CHAR


IFN FTOPS20,<
;NUMBER OF RECORDS TO ADD TO MINIMUM CORE SIZE  FOR "DEFCOR"
NRECS==^D1000
>

SUBTTL	DEFINITIONS -- Segment Control - ISEGMENT and SEGMENT


;SEGMENT ORIGINS

IFE FTKI10!FTKL10,<
	HIORG==400000			;[C20] [C13] ORGIN OF PROGRAM
	LOWORG==0			;[C20] [C13] ORIGIN OF DATA
>

IFN FTKI10!FTKL10,<
	HIORG==600000			;[C20] [C13] ORIGIN OF PROGRAM
 IFN FTVM,<
	LOWORG==674000			;[C20] [361] ORIGIN OF DATA
 >
 IFE FTVM,<
	LOWORG==0			;[N21] ORIGIN OF DATA
 >
>

	HILOC==HIORG			;[C13] COUNTER USED BY SEGMENT MACRO
	LOWLOC==LOWORG			;[C13] COUNTER USED BY SEGMENT MACRO

DEFINE	ISEGMENT<
 IFE FTOPS20,<
  IFE FTCOBOL!FTFORTRAN,<;;		ONLY IN STAND-ALONE SORT
	TWOSEG	HILOC
	RELOC	HILOC
	%SEG%==1
  >
  IFN FTCOBOL!FTFORTRAN,<
	RELOC	LOWLOC
	%SEG%==0
  >
 >
 IFN FTOPS20,<
	TWOSEG	HILOC
	RELOC	HILOC
	%SEG%==1
 >
 DEFINE ISEGMENT<>
>

DEFINE	SEGMENT(N)<
 ISEGMENT
 %NSEG%==-1			;;[C20]
 IFIDN <N><IMPURE>,<%NSEG%==0>	;;[C20]
 IFIDN <N><LPURE>,<		;;[C20]
  IFE FTVM,<%NSEG%==0>		;;[N21]
  IFN FTVM,<%NSEG%==1>		;;[N21]
 >
 IFIDN <N><HPURE>,<%NSEG%==1>	;;[C20]
 IFL %NSEG%,<PRINTX ? BAD ARGUMENT TO SEGMENT MACRO: <N>>
 IFE %NSEG%,<			;;[C20]
  IFG %SEG%,<
   XLIST;;				DUMP PENDING LITERALS
   LIT
   LIST
   HILOC==.
  >
  IFN %SEG%,<
   IFE FTVM,<			;;[N21] [C20]
    RELOC	LOWLOC
    %SEG%==0
   >
   IFN FTVM,<			;;[N21] [C20]
    LOC		0
    PHASE	LOWLOC
    %SEG%==-1
   >
  >
 >
  IFN %NSEG%,<			;;[C20]
   IFLE %SEG%,<
    XLIST;;				DUMP PENDING LITERALS
    LIT
    LIST
    LOWLOC==.
    IFN FTVM,<			;;[N21] [C20]
     DEPHASE
    >
    RELOC HILOC
    %SEG%==1
   >
  >
>

DEFINE	POW2(N)<<^L1-^L<N>>>

S.LNK==2			;[N03] [427] NO. FOR .LINK AND .LNKEND PSEUDO-OPS
;.LINK DATA BLOCK
	LOC	0
Z.NXT:!	BLOCK	1		;[427] POINTER TO NEXT BLOCK
Z.ADD:!	BLOCK	1		;[427] FIRST ,, LAST DATA to zero
	RELOC

SUBTTL	DEFINITIONS -- Error Handling -- $ERROR


;Error messages in SORT are handled via the $ERROR macro below. Four standard
;types of messages are handled, as shown below.
;
;	TYPE			CALL				RESULTING MESSAGE
;
;	Informative		$ERROR	([,xxx,<Text>)		[SRTxxx Text]
;	Warning			$ERROR	(%,xxx,<Text>)		%SRTxxx Text
;	Fatal			$ERROR	(?,xxx,<Text>)		?SRTxxx Text
;	Operator intervention	$ERROR	($,xxx,<Text>)		$SRTxxx Text
;
;For fatal error messages, $ERROR automatically generates a call to the $DIE
;macro to abort the sort, possibly returning error information for the FORTRAN
;user.
;
;Error messages which contain text that is a function of run-time parameters are
;handled by specifying '+' as the fourth argument to $ERROR, then using the
;$MORE or $CHAR macros as needed, and finishing with $CRLF. In this case, the
;final message disposition must be performed by manually calling $DIE for fatal
;errors.
;
;When some alternate cleanup should be done on fatal errors, a fifth argument
;may be specified. This is the address to transfer control to after printing the
;message. Note that this is only applicable if '+' was not specified as the
;fourth argument. If it was, then an explicit JRST may be used in place of the
;final $DIE macro.
;
;The label of $ERROR macros is E$$xxx by convention; in fact, the macro now
;generates this label automatically. If an error message routine must do some
;preliminary computations before calling $ERROR, then the actual error routine
;label should be ERRxxx.

DEFINE	$ERROR (Q,CODE,TEXT,MORE,CONT)<
	...SQB==0
E$$'CODE:	MOVE	T1,['SRT',,''CODE'']
 IFB <MORE>,<
  IFDIF <Q><[>,<
	MOVE	T2,["Q",,[ASCIZ	\TEXT
\]]
  >
  IFIDN <Q><[>,<
	MOVE	T2,["Q",,[ASCIZ \TEXT]
\]]
  >
 >
 IFNB <MORE>,<
	MOVE	T2,["Q",,[ASCIZ	\TEXT\]]
  IFIDN <Q><[>,<
	...SQB==1
  >
 >
	PUSHJ	P,%ERMSG
 IFNB <CONT>,<
	JRST	CONT			;;[372]
 >
 IFB <CONT>,<
  IFB <MORE>,<
   IFIDN <Q><?>,<
  	JRST	DIE
   >
  >
 >
>

SUBTTL	DEFINITIONS -- Error Handling -- $MORE


;$MORE is used following a call to $ERROR with '+' as the fourth argument.
;Thus, a sample call might be:
;
;	E$$SNR:	$ERROR	([,SNR,<Sorted >,+)
;		$MORE	(DECIMAL,OUTREC)
;		$MORE	(TEXT,< records.>)
;		$CRLF

DEFINE	$MORE (TYPE,DATA)<
 IFIDN <TYPE><OCTAL>,<
  IFDIF <DATA><T1>,<
	MOVE	T1,DATA
  >
	PUSHJ	P,%TOCTW
 >
 IFIDN <TYPE><DECIMAL>,<
  IFDIF <DATA><T1>,<
	MOVE	T1,DATA
  >
	PUSHJ	P,%TDECW
 >
 IFIDN <TYPE><TEXT>,<
  IFDIF <DATA><T1>,<
	MOVEI	T1,[ASCIZ \DATA\]
  >
	PUSHJ	P,%TSTRG
 >
 IFIDN <TYPE><SIXBIT>,<
  IFDIF <DATA><T1>,<
	MOVE	T1,DATA
  >
	PUSHJ	P,%TSIXN
 >
 IFIDN <TYPE><ASCII>,<
  IFDIF <DATA><T1>,<
	MOVEI	T1,DATA
  >
	PUSHJ	P,%TSTRG
 >
 IFIDN <TYPE><FILESPEC>,<
  IFDIF <DATA><T2>,<
	HRRZ	T2,DATA			;;[C20]
  >
  IFE FTOPS20,<
	MOVEI	T1,X.OPN-X.RIB(T2)	;;[OK]
  >
	PUSHJ	P,%TOLEB
 >
 IFIDN <TYPE><CORE>,<
  IFDIF <DATA><T1>,<
	MOVE	T1,DATA
  >
	PUSHJ	P,%TCORW
 >
>

SUBTTL	DEFINITIONS -- Error Handling -- $CRLF, $CHAR, $DIE


DEFINE	$CRLF<
 IFN ...SQB,<
	PUSHJ	P,%TRBRK
	...SQB==0
 >
	PUSHJ	P,%TCRLF
>
...SQB==0

DEFINE	$CHAR(CHAR)<
 IFDIF <CHAR><T1>,<
	MOVEI	T1,CHAR
 >
	PUSHJ	P,%TCHAR
>

DEFINE	$DIE<
	JRST	DIE
>

DEFINE	KEYZ (A,B)<
	A'.L==0
 IRP B,<
	A'.L==A'.L+1
	A'B==A'.L
 >
>

SUBTTL	DEFINITIONS -- Structure Macros -- Descriptions


;Program structuring macros are used throughout SORT to help enforce clean
;coding practices. There are several classes of macros available for different
;purposes. These are all described below.
;
;Note that all macros except the local label ones and PROCEDURE take an
;arbitrary comment as an argument.
;
;BEGIN, END And Local Labels.
;
;The BEGIN and END macros define the scope of a source code block. Within the
;block, special local labels are available if necessary, but the additional
;structuring macros below should be preferentially used where possilbe. Local
;label references are of the form $n, where n is 0 to 7 (don't be fooled by the
;RADIX 10 before the call to $TEMPORARY). Local label definitions are of the
;form $n%, and should be indented 2 spaces from the local left margin. Also,
;within a BEGIN - END block, $B may be used as a label for the beginning of the
;block and $E for the end. Thus, a sample block might be:
;
;BEGIN					;BEGINNING OF OUTER BLOCK
;	JRST	$E			;JUMPS TO SECOND END
;  $1%	JRST	$B			;JUMPS TO FIRST BEGIN
;	BEGIN				;BEGINNING OF INNER BLOCK
;		JRST	$1		;JUMPS TO SECOND $1%
;		JRST	$E		;JUMPS TO FIRST END
;	  $1%	JRST	$B		;JUMPS TO SECOND BEGIN
;	END				;END OF INNER BLOCK
;	JRST	$1			;JUMPS TO FIRST $1%
;  	JRST	$B			;JUMPS TO FIRST BEGIN
;END;					;END OF OUTER BLOCK
;
;PROCEDURE And RETURN.
;
;These macros declare the entry and exits of a procedure. The first argument to
;PROCEDURE is the instruction used to call the procedure. Currently, this must
;be one of <PUSHJ P>, <JSP T4> or <JSP P4>. The second argument is the name of
;the procedure, or an IRP-style list of names. RETURN then generates the proper
;returning instruction whenever it is used in that procedure. Finally,
;procedures should be declared inside of a BEGIN - END block, with the PROCEDURE
;macro indented 2 spaces from the local left margin, and RETURN indented with
;the surrounding code. An example is:
;
;BEGIN
;  PROCEDURE (PUSHJ P,DOTHIS)
;	PUSHJ	P,DOTHAT
;	<code to do THIS>
;	RETURN
;END;

;IF, THEN, ELSE And FI.
;
;These macros implement the common IF statement construct. Between the IF and
;THEN macros should be the code to determine which case is true. Control should
;fall through to the THEN if the condition is true. Control should fall into the
;ELSE (or FI if no ELSE segment) or pass to the label $T ($F if no ELSE segment)
;if the condition is false. The THEN code segment should end by transfering
;control to the FI or the label $F. Each of these macros should be indented 2
;spaces from the local left margin, and the IFs may be nested up to a depth of
;7. Some examples are:
;
;  IF WE CAN DO IT		  IF WE CAN DO THIS		  IF WE WANT ONE
;	<code to tell>			<code to tell>			MOVE	T1,NUMBER
;	JRST	$F			JRST	$T			CAIN T1,1
;  THEN DO IT			  THEN DO THIS			  THEN GET IT
;	<code to do it>			<code to do THIS>		SKIPA	T1,['ONE   ']
;  FI;					JRST	$F		  ELSE GET TWO
;				  ELSE DO THAT				MOVE	T1,['TWO   ']
;					<code to do THAT>	  FI;
;				  FI;
;
;CASE And ESAC.
;
;These macros define the range of a selecting statement. Each code segment
;should have a local label at its beginning, and an indexed JRST is then used to
;transfer control to the correct code segment. Each segment should transfer
;control to the label $C, or, for the last segment, fall through to the ESAC.
;The CASE, ESAC and the local labels should all be indented 2 spaces from the
;local left margin. One example is:
;
;  CASE DEVICE TYPE OF (.TYDSK, .TYMTA, .TYTTY)
;	MOVE	T1,DEVICE
;	DEVTYP	T1,
;	  JRST	ERROR
;	LDB	T1,[POINTR T1,TY.DEV]
;	CAILE	T1,.TYTTY			;RANGE CHECK
;	JRST	$C				;OUT OF RANGE
;	JRST	@[IFIWS <$1,$C,$2,$3>](T1)
;
;  $1%	<handle DSK:>
;	JRST	$C
;
;  $2%	<handle MTA:>
;	JRST	$C
;
;  $3%	<handle TTY:>
;;	JRST	$C
;
;ESAC;

;WHILE, UNTIL And FOR.
;
;These are null macros used in conjunction with BEGIN and END to better indicate
;the operation of loops. If used, they should be indented two spaces from the
;local left margin. An example:
;
;  WHILE MORE TO DO
;	BEGIN
;		JUMPE	T1,$E
;		<do some more>
;		SOJA	T1,$B
;	END;

SUBTTL	DEFINITIONS -- Structure Macros -- BEGIN, PROCEDURE, RETURN, END



DEFINE	BEGIN<
 IFG $.NST-9,<PRINTX ? BEGIN-END nesting too deep>
 $PRNST (\$.PNST,<BEGIN>)
 $.PNST=$.PNST+1
 ..R..==..R.._3+..R..&7
 ..E..==..E.._3
 $.NST==$.NST+1
 $INITIAL \<$.NST>
 $.LAB=$.LAB_4
>

DEFINE	PROCEDURE (HOW,WHERE)<
 $PRNST (\$.PNST,<PROCEDURE WHERE>)
 IRP WHERE,<WHERE:>
 IFE <<HOW>-<PUSHJ	P>>,<..R..==..R..&<^-7>+1> ;;[365] ALLOW EITHER SPACES
 IFE <<HOW>-<JSP	P4>>,<..R..==..R..&<^-7>+2> ;;[365]   OR TABS AS
 IFE <<HOW>-<JSP	T4>>,<..R..==..R..&<^-7>+3> ;;[365]   SEPARATORS
>

DEFINE RETURN<
 IFE ..R..&7,<PRINTX ? Illegal RETURN code>
 IFE ..R..&7-1,<POPJ	P,>
 IFE ..R..&7-2,<JRST	(P4)>		;;[OK]
 IFE ..R..&7-3,<JRST	(T4)>		;;[OK]
>

DEFINE END<
 IF2,<	ZZ==1
  REPEAT <$.LAB&17>,<
   $REMOVE	%,\<$.NST>,\<$.ORG+ZZ>
   ZZ==ZZ+1
  >
 >
 $UPDATE \<$.NST>
 $.LAB==$.LAB_-4
 ..R..==..R.._-3
 IFN ..E..&7,<
  $LABEL E,\<$.NST>,\<$.END+1>
 >
 ..E..==..E.._-3
 IFL $.NST,<PRINTX ? BEGIN-END nesting underflow>
 $.PNST=$.PNST-1
 $PRNST (\$.PNST,<END>)
 $.NST==$.NST-1
 IFGE $.NST,<
  $REINIT \<$.NST>
 >
>

DEFINE $REMOVE (J,K,L)<
 PURGE J'K'L
>

SUBTTL	DEFINITIONS -- Structure Macros -- IF, THEN, ELSE, FI, CASE, ESAC


DEFINE	IF<
 IFG $.INST-5,<PRINTX ? IF nesting too deep>
 $PRNST (\$.PNST,<IF>)
 $.PNST=$.PNST+1
 $.INST==$.INST+1
 ..F..==..F.._3
 ..T..==..T.._3
 $IFINITIAL \<$.INST>
REMARK>
DEFINE	THEN<
 $.PNST=$.PNST-1
 $PRNST (\$.PNST,<THEN>)
 $.PNST=$.PNST+1
REMARK>

DEFINE	ELSE<
 $.PNST=$.PNST-1
 $PRNST (\$.PNST,<ELSE>)
 $.PNST=$.PNST+1
 IFN ..T..&7,<
  $.THN==$.THN+1
  $LABEL T,\<$.INST>,\<$.THN>
  $THNUPDATE \<$.INST>
 >
REMARK>

DEFINE	FI<
 IFN ..F..&7,<
  $.IF==$.IF+1
  $LABEL F,\<$.INST>,\<$.IF>
  $IFUPDATE \<$.INST>
 >
 ..F..==..F.._-3
 ..T..==..T.._-3
 IFL $.INST,<PRINTX ? IF nesting underflow>
 $.PNST=$.PNST-1
 $PRNST (\$.PNST,<FI>)
 $.INST==$.INST-1
 IFGE $.INST,<
  $IFINITIAL \<$.INST>
>>
DEFINE	CASE<
 IFGE $.CNST-9<PRINTX ? CASE nesting overflow>
 $PRNST (\$.PNST,<CASE>)
 $.PNST=$.PNST+1
 $.CNST==$.CNST+1
 $CASEINITIAL \<$.CNST>
REMARK>

DEFINE	ESAC<
 $.CASE==$.CASE+1
 $LABEL C,\<$.CNST>,\<$.CASE>
 IF2,<$REMOVE C,\<$.CNST>,\<$.CASE>>
 $CASEUPDATE \<$.CNST>
 IFL $.CNST,<PRINTX ? CASE nesting underflow>
 $.PNST=$.PNST-1
 $PRNST (\$.PNST,<ESAC>)
 $.CNST==$.CNST-1
 $CASEINITIAL \<$.CNST>
REMARK>

SUBTTL	DEFINITIONS -- Structure Macros -- WHILE, UNTIL, FOR, Debugging Macro


DEFINE	WHILE<REMARK>
DEFINE	UNTIL<REMARK>
DEFINE	FOR<REMARK>

.XCREF					;[373] KEEP $PRNST OUT OF CREF

IFE FTPRINT,<
  DEFINE $PRNST<REMARK>			;;[373] DO NOTHING IF NOT REQUESTED
>
IFN FTPRINT,<
  DEFINE $PRNST(N,MSG)<			;;[373] PRINT CURRENT NEST LEVEL
    IFL <N>,<				;;[373] RECURSION STOPS HERE
      PRINTX MSG
    >
    IFGE <N>,<				;;[373] RECURSION ADDS INDENTATION
      $PRNST (\<<N>-1>,<!  MSG>)	;;[373]   ..
    >
  >
>

.XCREF	$PRNST				;[373] ALWAYS KEEP IT OUT OF CREF
.CREF					;[373]

DEFINE $PRCHK(N)<			;;[373] COMPLAIN IF NESTING LEVEL WRONG
  IFN <<N>+1>,<PRINTX ? Nesting level mismatch, value = N>
>

SUBTTL	DEFINITIONS -- Structure Macros -- Initialization And Temporary Labels


;DEFINE TEMPORARY LABELS. THEY EXIST ONLY BETWEEN BEGIN AND END.

DEFINE $TEMPORARY(M,D)<
  .XCREF		;;[373] DON'T FILL THE CREF WITH JUNK

  ..R..=0
  ..E..=0
  ..F..=0
  ..T..=0
  ..C..=0
  $.IF=0
  $.THN=0
  $.END=0
  $.ORG=0		;;ORIGIN OF LABEL
  $.LAB=0		;;MAX. LABEL SPECIFIED
  $.CASE=0		;;CASE STATEMENT
  $.NST=-1		;;NESTING DEPTH
  $.INST=-1		;;IF NESTING DEPTH
  $.CNST=-1		;;[215] CASE NESTING DEPTH
  $.PNST=-1		;;[373] PROGRAM NESTING DEPTH

  DEFINE $TEMP(N)<
    .XCREF				;;[373]
    DEFINE $'N'%<
      $LABEL %,\<$.NST>,\<$.ORG+N>
      IFG N-$.LAB&17,<$.LAB==$.LAB&<-1_4>+N>
    >
    ;;DO NOT ADD CRLF'S TO THIS MACRO, OR IT WON'T WORK
    DEFINE $'N<$REFERENCE %,\<$.NST>,\<$.ORG+N>>
    .XCREF $'N'%,$'N			;;[373]
    .CREF				;;[373]
  >

  DEFINE $NEST(N)<
    .XCREF				;;[373]
    $.ORG'N=0
    $.END'N=0
    $.BEG'N=0
    $.IF'N=0
    $.THN'N=0
    $.CAS'N=0		;;[215]
    .XCREF $.ORG'N,$.END'N,$.BEG'N,$.IF'N,$.THN'N,$.CAS'N ;[373]
    .CREF				;;[373]
  >

  ZZ=0
  REPEAT M,<
    ZZ=ZZ+1
    $TEMP \ZZ
  >

  ZZ=0
  REPEAT D,<
    $NEST \ZZ
    ZZ=ZZ+1
  >

  PURGE ZZ

  DEFINE $INITIAL(N)<
    $.ORG=$.ORG'N
    $.END=$.END'N
    $.BEG'N=.
  >

  DEFINE $REINIT(N)<
    $.ORG=$.ORG'N
    $.END=$.END'N
  >

  DEFINE $UPDATE(N)<
    $.ORG'N=$.ORG'N+$.LAB&17
    IFN ..E..&7,<
      $.END'N=$.END'N+1
    >
  >

  DEFINE $IFINITIAL(N)<
    $.IF=$.IF'N
    $.THN=$.THN'N
  >

  DEFINE $IFUPDATE(N)<
    $.IF'N=$.IF'N+1
  >

  DEFINE $THNUPDATE(N)<
    $.THN'N=$.THN'N+1
  >

  DEFINE $CASEINITIAL(N)<
    $.CASE=$.CAS'N
  >

  DEFINE $CASEUPDATE(N)<
    $.CAS'N=$.CAS'N+1
  >

  DEFINE $LABEL(J,K,L)<
    .XCREF				;;[373] KEEP HIDDEN LOCAL LABELS OUT OF CREF
    IF1,<PURGE J'K'L>;;BUG IN MACRO 50
    J'K'L:!
    .XCREF J'K'L			;;[373] KEEP THESE OUT OF THE CREF
    .CREF				;;[373]
  >

;;DO NOT ADD CRLF'S TO THIS MACRO OR IT WILL NOT WORK.
  DEFINE $REFERENCE(J,K,L)<J'K'L>

  .XCREF ..R..,..E..,..F..,..T..,..C..,$.IF,$.THN,$.END,$.ORG,$.LAB,$.CASE,$.NST
  .XCREF $.INST,$.CNST,$.PNST,$TEMP,$NEST,$INITIAL,$REINIT,$UPDATE,$IFINITIAL
  .XCREF $IFUPDATE,$THNUPDATE,$CASEINITIAL,$CASEUPDATE,$LABEL,$REFERENCE
  .CREF
>

DEFINE	$B,<$BEG \<$.NST>>
DEFINE	$BEG (N)<$.BEG'N>

DEFINE $E,<$REFERENCE E,\<$.NST>,\<$.END+1>
 ..E..==..E..!1
>
DEFINE	$F,<$REFERENCE F,\<$.INST>,\<$.IF+1>
 ..F..==..F..!1
>
DEFINE	$T,<$REFERENCE T,\<$.INST>,\<$.THN+1>
 ..T..==..T..!1
>

;DO NOT ADD CRLF'S TO THIS MACRO, OR IT WON'T WORK
DEFINE	$C,<$REFERENCE C,\<$.CNST>,\<$.CASE+1>>

DEFINE	$PURGE,<
	$PRCHK	\$.PNST			;;[373] MAKE SURE NESTING MATCHES
	PURGE	END
	PURGE	...SQB,..R..,..E..,..F..,..T..,..C..,ZZ
	PURGE	$.LAB,$.NST,$.END,$.IF,$.THN,$.INST,$.ORG,$.CASE,$.CNST,$.PNST
	PURGE	$.BEG0,$.BEG1,$.BEG2,$.BEG3,$.BEG4,$.BEG5,$.BEG6,$.BEG7,$.BEG8,$.BEG9
	PURGE	$.CAS0,$.CAS1,$.CAS2,$.CAS3,$.CAS4,$.CAS5,$.CAS6,$.CAS7,$.CAS8,$.CAS9
	PURGE	$.END0,$.END1,$.END2,$.END3,$.END4,$.END5,$.END6,$.END7,$.END8,$.END9
	PURGE	$.IF0,$.IF1,$.IF2,$.IF3,$.IF4,$.IF5,$.IF6,$.IF7,$.IF8,$.IF9
	PURGE	$.ORG0,$.ORG1,$.ORG2,$.ORG3,$.ORG4,$.ORG5,$.ORG6,$.ORG7,$.ORG8,$.ORG9
	PURGE	$.THN0,$.THN1,$.THN2,$.THN3,$.THN4,$.THN5,$.THN6,$.THN7,$.THN8,$.THN9
>

;NOW GENERATE THEM MAX = 10 FOR NOW
	RADIX	10
$TEMPORARY (10,10)
	RADIX	8