/ WPSR.PA - 278 MULTI KEY SORT

/			****************
/			* EDIT HISTORY *
/			****************
/
/ 025	EMcD	27-Sep-85	Add Dutch and Spanish Xlations (conditionalised)
/ 024	EMcD	14-Sep-85	Add Nordic Translations (conditionalised)
/ 023	EMcD	03-Sep-85	Fix bug induced by moving stuff in panel 
/				memory.
/ 022	RCME	25-Jun-85	Fix bug in 021 which caused errors on MC's in
/				numeric fields.
/ 021	RCME	03-APR-85	Sort multinational and tech characters
/				Accept dead key characters in field names
/
/ ---------------- All below refer to V2.0 and earlier -----------------------
/
/ 020	EJL	06-SEP-84	Allow pound sign for numeric data
/ 019	WCE	31-OCT-83	Change CHRCNT label to CHARCT for prefix change
/ 018	TCW	31-OCT-83	ADD TEXT "OUTPUT VOLUME FULL" FOR WINCHESTER
/ 017	WCE	17-AUG-83	Change HDRBUF label to HEADBF because of prefix
/				module definition of HDRBUF for WPFILS & EDIT

/ 017	HLP	29-AUG-83	Make Beep if don't hit Gold Menu
/				  when done
/ 016	DFB	12-MAY-83	Change collating sequence

/ 015	MJS	24-MAR-83	BUG FIX - algorithm at "TSTOK" was ok
/					  but the constant didn't allow
/					  that the values of the addresses
/					  were of active (valid) data
/					  not empty locations

/ 014	MJS	11-JUN-82	BUG FIX - to 'JMP E13' from within
/					  subroutine 'QUXEAL' if no more
/					  blocks remain to be allocated

/ 013	MJS	16-FEB-82	BUG FIX - to execute 'GET DENSITY' (via QURX)
/					  of system diskette at Gold MENU
/					  within 'WAITM' before reading the
/					  HOME block.
/
/				added	- Memory Reference Map
/
/				changed	- the 4 occurances of 'T2' within
/					  the MERGE to 'PEIOFFSET' because
/					  subroutine 'KEYSEARCH' uses 'T2'
/					  (and would clobber the value left
/					   by the MERGE)
/
/				renamed	- references to 'T2VAT' (used by
/					  the MERGE) to 'INVVAT'
/
/				renamed - references to 'OFFSET' (used by
/					  the MERGE) to 'HEADER'

/ 012	JRF	14-JAN-82	Improve RANDR2 for handling double density
/				header blocks.  Fix code for handling
/				justify bit in GETBNO and PUTBNO

/ 011	MJS	06-NOV-81	BUG FIX - numeric value fields are
/					  now ordered algebraically
/
/				AND	- changed cdf's and cif's to be
/					  absolute equates
/
/				AND	- MOVED THE 'XXSDFNBUFFER' FROM
/					  FIELD 5 (THIS FIELD) TO FIELD
/					  4 (THE BUFFER FIELD)

/ 010	EH	22-OCT-81	BUG FIX - FLAGGING ILLEGAL CHARS
/					  DURING SORT ON NUMERIC FIELDS

/ 009	MJS	16-OCT-81	BUG FIX - 2nd half of '0008' bug fix

/ 008	WCE	09-OCT-81	BUG FIX - GOLD HALT FOLLOWED BY GOLD
/					  MENU (REQUIRING SYSTEM DISK TO BE
/					  REPLACED) FOLLOWED BY RETURN
/					  DESTROYED SYSTEM DISK.


/ 007	DIM	3-SEPT-81	Merge Dutch forin changes

/ 006	GDH	26-AUG-81	WPFILS calling seq changes.

/ 005	DSS	17-APR-81	Addition of accented character
/				handling code for foreign systems.

/ 004	JM	11-MAR-81	Added CANADIAN text

/ 003	JM	09-MAR-81	Added DUTCH text

/ 002	JM	06-MAR-81	Added FRENCH text

/ 001	JM	06-MAR-81	Replaced all instances of '<' and
/				'>' within text statements with their
/				octal values of 74 and 76 so as to
/				allow foreign conditionals

/ WTSORT.PA

	FIELD 0
	*200
	JMP I	.+3
	JMP I	.+1
	7600
	RXLOAD
	*RXLDLS
	RXEWT=4
	RXEWT
	0
	RXQBLK=11
	RXQBLK
	.
/ ......................................

/ NOTE THAT THE 'CDF 20' WITHIN THE FOLLOWING LINE
/ DEFINES TO THE 'WRITE OUT TO THE FLOPPY CODE'
/ WHICH FIELD WITHIN [STERNO] THE EMEULATOR
/ CONTAINS THE PROGRAM TO BE WRITTEN OUT

/ 'WPCMND.PA' DEFINES THE (USER) FIELD
/ IN WHICH THE PROGRAM WILL EXECUTE

/ CONFUSING, ISN'T IT ?
	IFNDEF DECDEV <
	DLOSRT;	100;	CDF 20;	-DSOSRT
	>
	IFDEF DECDEV <
	DLOSRT;	100;	CDF 50;	-DSOSRT
	>

/ ......................................

	0

////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////	WPSRSL.PA	-	MULTIKEY SORT SELECTOR		\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

/ This memory reference map was added for the convenience of future	/a0013
/ developers requiring an overall view of system resource referencing	/a0013

/ FIELD 3	0000-5377	open
/		5400-6377	Merge 'INBLOCK'
/		6400-6777	Merge 'OUTBLOCK'
/		7000-7377	Random Read II 'READ DATA BUFFER'
/		7400-7777	Random Read II 'HEADER BLOCK BUFFER'
/
/ FIELD 4	0000-3427	'XXSDFNBUFFER'
/		3430-3577	open
/		3600-4027	'FNBUFFER'
/		4030-5777	open
/		6000-7777	'SCROLL's BUFFERS
/
/ FIELD 5	0000-7777	WPSR.PA executable code
/
/ FIELD 6	0000-appro-
/		aching-7777	'FNVBUFFER'
/
/		7775-appro-
/		aching-0000	'FNVARBUFFER'

/ ..............................................................................
/ ..............................................................................
/ .................							    ....
/ .... CAUTION .... THIS PROGRAM [ONLY] ASSEMBLES 'INTO' [STERNO::] FIELD 2 ....
/ .... CAUTION .... IT IS LOADED INTO [WP-278] FIELD 5 (USER FIELD 3) ..........
/ .... CAUTION .... AS DEFINED WITHIN 'WPCMND.PA' ..............................
/ .................							    ....
/ ..............................................................................
/ ..............................................................................


	IFNDEF DECDEV <
	FIELD	2
	>

	IFDEF DECDEV <
	FIELD	5
	>

/ PROGRAM LOCATIONS: T1, T2 AND T3 ARE USED (AT TIMES) FOR MORE THAN
/ JUST LOCAL TEMPORARY STORAGE ----- BE CAREFUL -----

/ -----------------------------------------------------------------
/ --------        THE FOLLOWING IS ORDER IMPORTANT         --------
/ --------        AND REFERRED TO IN::  'WPSRDF.PA'        --------
/ -----------------------------------------------------------------
	*SOTFL		/ 20-77 ARE USED FOR COMMON SYSTEM CONSTANTS
			/ (E.G. T1, T2, T3,  P177, ETCETERA.)

	0	/ F-3	/SOTFL,		- 'OUTPUT' DRIVE AND DOCUMENT NUMBER
	0	/ F-3	/SLSTFL,	- 'LIST' DRIVE AND DOCUMENT NUMBER
	0	/ F-3	/ORDER,		- SORT ORDER: XXX XXX XXX XXX
	0	/ F-3	/MMRETURN,	- RETURN ADDRESS TO MAIN MENU
    XXSDFNBUFFER/ F-4	/SDFNBUFFER,	- SPEC DOC KEY <FN> BUFFER ADDRESS
	SELECTOR/ F-5	/PARSELIST,	- STARTING ADDRESS OF THIS PROGRAM
	0	/ F-3	/DSKID,		- SYSTEM DISK ID: 0YY III III III
	0	/ F-3	/FTYPE,		- FIELD TYPE (ALP-NUM): TTT TTT TTT TTT
/ -----------------------------------------------------------------
/ --------           END OF ORDER IMPORTANT CODE           --------
/ -----------------------------------------------------------------

MKSVAT,	ZBLOCK	1	/ ADDRESS POINTING TO [VAT] WITHIN FNV TABLE


/ DEFINE THE cdf and cif INSTRUCTIONS ABSOLUTELY (to gain useable memory)/a0011
									/a0011
			CDFMNU=	6221					/a0011
			CIFMNU=	6222					/a0011
			CIFIOA=	CIFMNU					/a0011
			CDFEDT=	6231					/a0011
			CDFSDFN=6241					/a0011
			CDFMYF=	6251					/a0011
			CDFF06=	6261					/a0011
			CDFFNV=	CDFF06					/a0011
			CDFFNB=	CDFSDFN					/a0021

			PR3=6236					/A021

/D0011 USRFL0=	-30		/ USER FIELD 0 (PHYSICAL FIELD 2) A.K.A. 'MENU' FIELD
/D0011 USRFL1=	-20		/ USER FIELD 1 (PHYSICAL FIELD 3) A.K.A. 'EDITOR' FIELD
/D0011 /USRFL2=	-10	/ USER FIELD 2 (PHYSICAL FIELD 4) A.K.A. 'BUFFER' FIELD
/D0011 USRFL3=	0		/ USER FIELD 3 (PHYSICAL FIELD 5)
/D0011 USRFL4=	+10		/ USER FIELD 4 (PHYSICAL FIELD 6)
/D0011
/D0011 CDFMNU=	JMS .; XX; JMS CDFCIF; USRFL0+CDF	/ CDF TO THE 'MENU' FIELD
/D0011 CIFIOA=CIFMNU					/ DEFINED FOR CREF CONTINUITY
/D0011 						/
/D0011 CIFMNU=	JMS .; XX; JMS CDFCIF; USRFL0+CIF	/ CIF TO THE 'MENU' FIELD
/D0011 CDFFNV=CDFF06					/ DEFINED FOR CREF CONTINUITY
/D0011 						/
/D0011 CDFEDT=	JMS .; XX; JMS CDFCIF; USRFL1+CDF	/ CDF TO THE 'EDITOR' FIELD
/D0011 CDFF06=	JMS .; XX; JMS CDFCIF; USRFL4+CDF	/ CDF TO THE PHYSICAL FIELD #6
/D0011 CDFMYF=	JMS .; XX; JMS CDFCIF; USRFL3+CDF	/ CDF TO THE FIELD OF THIS PROGRAM

FNVBUFFER=	0	/ STARTS AT ADDRESS 0 OF FIELD: USRFL4
FNVARBUFFER=	7775	/ STARTS AT ADDRESS 7775 OF FIELD: USRFL4
			/ (NOTE THAT 'FNVARBUFFER' CAN BE 7774; 7773, ETC)
			/ (BUT NEVER 7776, OR 7777 BECAUSE OF 'ISZ'S IN 'TSTSIZE')
FNBUFFER=	4600	/ Starts at address 4600 of field 4
KCCRECORD=	4704	/ 2500 PRINTABLE CHARACTERS IS A 'LIST' RECORD SIZE
KCCFNSIZE=	FNSIZE	/ 30 PRINTABLE CHARACTERS IS A 'LIST' <FIELD NAME> SIZE
KCCVALUE=	74	/ 60 CHAR'S WITHIN 'VALUE' FIELD (OVER 60 IGNORED)

DCAFNV=	JMS I .; XFNVPSH/ CROSS DATA FIELDS FOR 'DCA I FNV' THEN BACK
DCAFNB= JMS I .; XFNBPSH/ Cross data fields for 'DCA I FN' then back	/a021
TADFNB= JMS I .; XFNBGET/ Cross data fields for 'TAD I FN' then back	/a021

SORTKEY, ZBLOCK	1	/ NUMBER OF KEY <FIELD NAME>S DEFINED WITHIN SPEC DOC
KEYNO,	 ZBLOCK	1	/ THE ABSOLUTE KEY # 'KKKK' FROM WITHIN 'FNKEYFOUND'
LABFLG,	 ZBLOCK	1	/ 0 MEANS NO < FOUND, XXX MEANS < FOUND
RECNUM,	 ZBLOCK	1	/ RECORD # BEING PARSED [1 TO 4095 TO 0 TO 4095 ETC.]
KEYFNTOTAL, ZBLOCK 1	/ TOTAL # OF RECORDS WITHIN THE LIST DOCUMENT
			/  CONTAINING ALL THE KEY <FIELD NAME>S
			/   DEFINED WITHIN THE SPECIFICATION DOCUMENT
SRBUGSWITCH, ZBLOCK 1	/ NOT = 0 MEANS WE'RE IN ERROR TYPEOUT ROUTINE
			/ HANDLE TEXT TO SCREEN APPROPRIATELY
CCFNSIZE,-KCCFNSIZE-1	/ <FIELD NAME> CHARACTER COUNTER [FNSIZE=30]
CCRECORD,-KCCRECORD-1	/ RECORD CHARACTER COUNTER [KCCRECORD=2500]
CCVALUE,-KCCVALUE-1	/ <FIELD NAME> 'VALUE' CHARACTER COUNTER
SFTSPC, 2040		/ Soft space value defined here to make room	/a021
CHARIN,	ZBLOCK	1	/ 12-BIT CHARACTER FROM 'ZRDNXCH': MMMMMCCCCCCC
CHR177,	ZBLOCK	1	/ 7-BIT CHARACTER FROM 'CHARIN': 00000CCCCCCC
DEADKEY,ZBLOCK	1	/ Flag inicating dead key processing status	/a021

/ . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
/ PROGRAM LOCATIONS:
/  T1RR, T2RR ARE RESERVED EXCLUSIVELY
/   FOR USE BY THE RANDOM READ UTILITY

/ THE RANDOM READ UTILITY IS A REWORKED VERSION OF RDFILP.PA
/  AND NO LONGER RESEMBLES RDFILP.PA THAT'S WHY IT'S NOT CALLED RDFILP
/   BUT IT WASN'T TOTALLY REWRITTEN
/    WHICH MEANS RDFILP USED PROGRAMM LOCATIONS: T1, T2

T1RR,	ZBLOCK	1
T2RR,	ZBLOCK	1
/ . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .

/ AUTO-INDEX REGISTER DEFINITIONS

FNV=	15	/ X5	/ FNV,	FNVBUFFER-1		/ OF FIELD: USRFL4
FN=	14	/ X4	/ FN,	FNBUFFER-1
SDFN=	13	/ X3	/ SDFN,	SDFNBUFFER-1
		/ X2
		/ X1
		/ X0

FNVAR,	FNVARBUFFER+1	/ THEN:  FNVARBUFFER, FNVARBUFFER-1, ETC.
/-----------------
	PAGE

/ THE SPECIFICATION DOCUMENT HAS BEEN PARSED SUCCESSFULLY BY A PREVIOUS PROGRAM
/ AND THE KEY <FIELD NAMES> TO SORT ON HAVE BEEN LOADED INTO THE SDFN BUFFER

/	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
/	!!!!                         !!!!
/	!!!! PARSE THE LIST DOCUMENT !!!!
/	!!!!                         !!!!
/	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

/ PARSE THE LIST DOCUMENT RECORD BY RECORD <FIELD NAME> BY <FIELD NAME>
/  LOOKING FOR KEY <FIELD NAME>S TO 'SORT ON'
/   AS DEFINED WITHIN THE SPECIFICATION DOCUMENT

SELECTOR,
	JMS	MRGSETUP	/ 'MERGE' AND 'ODG' MERGE RELATED PARAMATER SETUP
	JMS	SRWORKING	/ OUTPUT TO THE SCREEN:  'WORKING'

/ INITIALIZE SOME FLAGS

	DCA	FLAG40
	AC7777
	DCA	GETFIF

/ COPY THE CONTENTS OF PROGRAM LOCATIONS:

/  SOTFL, SLSTFL, ORDER, MMRETURN, DSKID, AND FTYPE

/   from the EDITOR FIELD into the same named locations of THIS FIELD

	CDFEDT
	TAD I	(SOTFL)
	DCA	SOTFL
	TAD I	(SLSTFL)
	DCA	SLSTFL
	TAD I	(ORDER)
	DCA	ORDER
	TAD I	(MMRETURN)
	DCA	MMRETURN
	TAD I	(DSKID)
	DCA	DSKID
	TAD I	(FTYPE)
	DCA	FTYPE
	CDFMYF
	AC7777			/AC = -1 BECAUSE (SDFNBUFFER) IS THE
	TAD	SDFNBUFFER	/ ADDRESS OF THE SDFN BUFFER ADDRESS
	DCA	SDFN
/\	JMP	.+1

/LOOK OUT CAUSE WE DROPPED HERE FROM ABOVE
/ ....... ... .. ... ... . .. . . .. ...  . .... .. .  . . . . .  . . . ..
/     ..  .. .. .. ...  ...  .  . ... . .  . . . . .  . ..... ..    .    .... .
/ . . ..   ...... ..... ...... . .  . . ..  ....  .   . . . ..    . .... . ...
/. ..  . ... . ... ......  . . .. . . . . . . . .  . . . . . .. .  .        ...
/ THIS PROGRAM IS CODED SO THAT MULTI-KEY SORT [UP TO 12 KEYS] IS TRANSPARENT
/  [ ACHIEVEING THAT TRANSPARENCY IS BY SCANNING THE CONTENTS OF THE SDFN BUFFER ]
/   [ FOR THE TERMINATORS [0] AND [-1] ]

	DCA	SORTKEY		/  START WITH (SORTKEY)=0, THEN:

/ TOTALING THE NUMBER OF TERMINATORS FOUND WITHIN THE SDFN BUFFER
/ RESULTS IN DEFINING [TO THIS PROGRAM] THE MAXIMUM KEY SORT [12 KEYS]

TSTSDFN,JMS	TADISDFN	/ POP A CHARACTER FROM THE SDFN BUFFER	/m0011
	SPA
	JMP	TSTOK		/      [-1] SDFN BUFFER TERMINATOR DETECTED
	SZA CLA
	JMP	TSTSDFN		/       FOR MORE POPS UNTIL A [-1] TERMINATOR
	ISZ	SORTKEY		/ [0] KEY <FN> TERMINATOR FOUND

/*E11 -	MEANS THE VALUE WITHIN 'SORTKEY'
/	IS GREATER THAN THE VALUE THAT 'MAXKEY' IS EQUATED TO
/	[ 'MAXKEY' IS THE MAXIMUM NUMBER OF KEY <FIELD NAME>S ]
/       [ ALLOWED BY THIS PROGRAM TO SORT ON ]

	TAD	(-MAXKEY)	/  THE MAX # OF KEY <FN> PERMITTED TO SORT ON
	TAD	SORTKEY		/   THE # OF KEY <FN> DEFINED IN SPEC DOC
	SMA SZA CLA		/    SKIP NEXT IF (SORTKEY) <= #MAXKEY
	JMP	E11	/ E 11	/*-MEANS SPEC DOC DEFINED TO MANY KEYS TO SORT ON
	JMP	TSTSDFN		/     UNTIL [-1] TERMINATOR FOUND

/ THE ABSOLUTE NUMBER OF KEY <FIELD NAMES>
/  DEFINED WITHIN THE SPECIFICATION DOCUMENT
/   TO SORT ON IN ASCENDING OR DESCENDING ORDER
/    NOW RESIDES WITHIN PROGRAM LOCATION 'SORTKEY'

TSTOK,	CLA			/CLA CAUSE ENTRY WITH (AC) = [-1] SDFN TERMINATOR
	TAD	SLSTFL		/ 'LIST' DRIVE AND DOCUMENT NUMBER
	JMS	RDINIT		/  % RANDRD INITIALIZATION
	DCA	RECNUM		/   RECORD NUMBER [ INTERNAL ATTRIBUTE ]
	DCA	KEYFNTOTAL	/    KEY <FIELD NAME> TOTALATOR [0 MEANS NONE]

/ COMPUTE THE VOLUME OF 'SLUSH'
/  (THAT NO MANS LAND BETWEEN THE FNVAR TABLE AND FNV BUFFER)
/   FOR OPTIMUM DYNAMIC MEMORY UTILIZATION

	TAD	SORTKEY		/ 1; 12(10)
	CIA
	DCA	SLUSH		/ TEMP FOR COUNTING
	TAD	(4+1+2+3)/ 4	/  0; 0; 0; 0 (merge),
			/ +1	/  [-1] FNVAR term,
			/ +2	/  algorithm				/a015
			/ +3	/  (insurance)				/a015
	TAD	(KCCVALUE%2+4)	/   NUMBER OF SLOTS PER KEY WITHIN FNV BUFFER
	ISZ	SLUSH
	JMP	.-2		/    UNTIL (SLUSH)=0
	DCA	SLUSH		/ THIS IS THE REAL 'SLUSH'

NEXTPACKET,
	TAD	(FNVBUFFER-1)	/ ADDRESS-1 OF <FIELD NAME> VALUE BUFFER
	DCA	FNV
	TAD	(FNVARBUFFER+1)	/ ADDRESS+1 OF <FN> VALUE ADDRESS PER RECORD BUFFER
	DCA	FNVAR

/ !!!!!!!! PARSE A RECORD WITHIN THE LIST DOCUMENT !!!!!!!!

NEXTRECORD,
	TAD	(KEY01FNTOTAL-1)
	DCA	X0
	TAD	SORTKEY		/ # OF KEYS TO SORT ON DEFINED WITHIN SPEC DOC
	CIA			/  MAKE ITS NEGATIVE VALUE
	DCA	T2		/   [ T2 GETS 'ISZ'D TO ZERO ]
/ CLEAR PROGRAM LOCATIONS::	KEY01FNTOTAL THRU KEYNNFNTOTAL
/ PRIOR TO PROCESSING EACH RECORD OF THE LIST DOCUMENT
	DCA I	X0		/ CLEAR KEY01FNTOTAL, THEN KEY02..., THRU KEYNN...
	ISZ	T2
	JMP	.-2		/   UNTIL (T2)=0
	AC7777
	DCA I	X0		/ [-1] FLOATING TERM [MEANS END OF 'KEY--FN..' ADDRESSES

	TAD	FNV
	JMS	DCAVAR
	AC0003		/\ 'CLL' ALSO
	TAD	FNV
	DCA	HHH1ST

/ IF THE FNVAR BUFFER HAS FILLED UP
/  THEN SORT THE <FIELD NAME> 'VALUE' FIELDS
/   SELECTED THUS FAR
/    AND COME BACK HERE WHEN THAT SORT IS DONE

/	CLL		/\ FROM 'AC0003' ABOVE
	TAD	FNV		/ THIS ADDRESS --INCREMENTS--
	TAD	SLUSH
	SZL
	JMP	.+5
	CLL CIA
	TAD	FNVAR		/ THIS ADDRESS --DECREMENTS--
	SZL CLA			/ SKIP NEXT IF FNV/FNVAR BUFFERS FULL
	JMP	FNVARNOTFULL	/ THE FNVAR BUFFER IS NOT FULL NOT FULL
	AC7777
	JMS	DCAVAR
	JMS	SPDPRS		/ DISPLAY ON SCREEN THE # OF RECORDS SELECTED
 	JMS	SORT		/ ORDER THE CONTENTS OF THE FNVAR TABLE
	JMS	MERGE		/ COMBINE THE FNV BUFFER WITH ANY FNV PACKET
	JMP	NEXTPACKET	/

SLUSH,	ZBLOCK	1

FNVARNOTFULL,

/ ..............................................................................
	CIFSYS
	JSWAP			/ LET OTHER JOBS HAVE THE SPOT LIGHT
/ ..............................................................................

	TAD	(-KCCRECORD-1)
	DCA	CCRECORD	/ 2500 PRINTABLE CHARACTERS ALLOWED PER RECORD
	DCA	BORFLAG		/ 'BOR' FLAG = 0 MEANS WAITING FOR FIRST < OF RECORD
	TAD	RECNUM
	AND	(7)
	SNA CLA
	JMS	SRWORKING	/ OUTPUT THE TEXT: 'WORKING'
	JMP	PARSE

/ SUBROUTNE TO OUTPUT TO THE SCREEN THE NUMBER OF RECORDS SELECTED
/  WHICH IS THE NUMBER OF RECORDS WITHIN THE LIST DOCUMENT
/   THAT CONTAINED THE KEY <FIELD NAME>
/    DEFINED WITHIN THE SPEC DOC TO SORT ON

/ ALL TEXT OUTPUT::  WILL NOT BE ABOVE LINE #4, NOT BE ABOVE LINE #4
/ SO NOT TO WRITE OVER THE INFORMATION LEFT THERE BY THE SPEC DOC PARSER

SPDPRS,	XX
	CIFIOA		/ -IOA-
	JMS I	IOACAL
	  0			/
	  MSUMMARY		/ CONTROL AND TEXT STRING
	  0605			/ ^P - LINE / COLUMN
	  KEYFNTOTAL		/ !D
	  RECNUM		/ !D
	  1600			/ ^P
	JMP I	SPDPRS		/ EXIT

	PAGE

PARSE,

/ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
/ !!!!!                                                !!!!!
/ !!!!! PARSE A <FIELD NAME> WITHIN THE CURRENT RECORD !!!!!
/ !!!!!                                                !!!!!
/ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

NEXTFN,
LABSDFN,MQL			/ (MQ) <= (AC) <= ZERO [OR MMMMM0111100]; THEN CLA
	TAD	(-KCCFNSIZE-1)	/ <FIELD NAME> SIZE
	DCA	CCFNSIZE
	TAD	(-KCCVALUE-1)	/ <FIELD NAME> 'VALUE' FIELD SIZE
	DCA	CCVALUE
	TAD	(FNBUFFER-1)	/ ADDRESS-1 OF <FIELD NAME> HOLDING BUFFER
	DCA	FN
	CLA MQA			/ (AC) = (MQ)
PARSFN,	DCA	LABFLG		/ 0 MEANS WAITING FOR LAB; XXX MEANS LAB FOUND
UNTILAB,			/ UNTIL < LEFT ANGLE BRACKET
UNTILRAB,			/ UNTIL > RIGHT ANGLE BRACKET
NPCFN,
	AC0000			/AC FLAG = 0
	JMS	RD1FNCHAR	/ READ 1 <FIELD NAME> 12-BIT CHAR FROM LIST DOC
	  JMP	DISKEOF		/ ...LIST DOCUMENT DISK END OF FILE [NO MORE DATA]
	  JMP	.+3		/ ...THE CHARACTER READ IS NON-PRINTING
	  JMP	LAB		/ ...THE CHARACTER READ IS A < LEFT ANGLE BRACKET
	  JMP	RAB		/ ...THE CHARACTER READ IS A > RIGHT ANGLE BRACKET
				/ ... (AC) = THE CHARACTER READ

/ THE 12-BIT CONTENTS OF THE AC IS (PROBABLY) A CHAR OF THE <FIELD NAME>
/  OR TEXT PRIOR TO THE FIRST '<' OF THE FIRST <FIELD NAME>

	  AND	P177		/ MAKE 7-BIT ASCII STRIPPING MODE BITS
	DCA	T3		/ ...PROBABLY PART OF THE <FN>; TEMP SAVE IT

/ GET 'PARAMATERS' AT THE TIME THE FIRST 'REAL' CHARACTER FROM THE
/  LIST DOCUMENT IS DETECTED FOR USE IN THE 'ERROR' ROUTINE WHEN AN ERROR
/   IS DETECTED PRIOR TO THE FIRST LEFT '<' ANGLE BRACKET EVER.

	ISZ	GETFIF		/ SKIP NEXT IF 1ST 'REAL' CHAR EVER FROM DOC
	JMP	.+3		/ 1ST CHAR 'PARAMATERS' ALREADY GOTTEN
	AC7777
	JMS	GETBNO		/ get block #, char. offset, header block offset
	DCA	GETFIF		/ set flag = 0 (next time through don't GETBNO)
/\	JMP	.+1

/ TEXT MAY PRECEED THE FIRST < OF THE FIRST <FIELD NAME>
/ OF THE FIRST RECORD  +++ONLY+++  [THE RECORD NUMBER MUST = 1]

	TAD	LABFLG		/WAS A < FOUND EARLIER ?
	SZA CLA			/ SKIP NEXT MEANS WAITING FOR A <
	JMP	ISZCCFNSIZE	/  JMP WITH <FIELD NAME> CHAR STILL IN T3

/ .............................................................................
/*E2 - MEANS THERE IS TEXT (PRINTABLE CHARS.) BETWEEN RECORDS
/      OR THE <FIELD NAME> OF RECORD # GREATER THAN 1 IS MISSING A <

	TAD	T3		/ IS IT A NONPRINTING CHARACTER?
	TAD	(-41)
	SMA CLA			/ SKIP IF IT IS; WE DON'T CARE ABOUT NON-
				/ PRINTING CHARACTERS BETWEEN RECORDS
				/ (INCLUDING 'SPACES')
	TAD	RECNUM		/ IF RECNUM > 0 - THIS TEXT IS BETWEEN RECORDS
	SZA CLA
	JMP	E2	/ E 2	/*E2
	JMP	UNTILAB		/ IGNORE ALL CHARACTERS UNTIL A < IS FOUND
/ .............................................................................

/*E4 - MEANS THE <FIELD NAME> EXCEEDED 30 PRINTABLE CHARACTERS

ISZCCFNSIZE,
	TAD	DEADKEY		/ Check the dead key status		/a017
	SNA CLA			/ Is a dead key sequence current?	/a017
	ISZ	CCFNSIZE	/ No, INCREMENT <FIELD NAME> CHARACTER COUNT
	SKP
	JMP	E4	/ E 4	/*ERROR
/ .............................................................................

/ THE CHARACTER  +++IS+++  PART OF THE <FIELD NAME>

	TAD	T3		/GET BACK <FIELD NAME> CHARACTER HELD IN T3
	DCAFNB			/ SAVE IT IN THE <FIELD NAME> HOLDING BUFFER
	JMP	UNTILRAB	/  JMP TO GET ANOTHER CHAR OF THE <FN> UNTIL >

GETFIF,	0			/ GETFIrst character Flag 0 = get parameters
				/			  1 = don't get parameters

BORFLAG,0			/BEGINNING OF RECORD FLAG:
				/  0 MEANS WAITING FOR FIRST < OF THAT RECORD
				/  1 MEANS FOUND IT

/ . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
/ . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
/ . .                                                                       . .
/ . . A LEFT ANGLE BRACKET MEANING THE START OF A <FIELD NAME> WAS DETECTED . .
/ . .                                                                       . .
/ . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
/ . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .

/*E3 - MEANS (LABFLG) NOT = 0 BECAUSE TWO < WERE FOUND BEFORE A >

LAB,	CLA			/VECTORED WITH (AC)=CHAR FROM FNBUFFER
	TAD	LABFLG		/ (LABFLG) = 0 IF THIS IS THE < OF THE <FIELD NAME>
	SZA CLA			/  SKIP NEXT MEANS THIS < IS OK
	JMP	E3	/ E 3	/*  <FIELD NAME> CONTAINED AN EXTRA <

/ IF THIS < MEANS THE BEGINNING OF A RECORD (BOR)
/  NOT THE START OF A <FIELD NAME> WITHIN THE RECORD
/   THEN GET THE BLOCK # WHERE THE < WAS FOUND
/    AND THE MODE BITS AT THE DETECTION OF THE <
/     AND THE CHARACTER OFFSET OF THE < WITHIN THAT BLOCK #
/ ELSE JUST PARSE THE <FIELD NAME>
/  BECAUSE THIS IS NOT THE FIRST <FIELD NAME> OF THE RECORD

	TAD	BORFLAG		/DOES THE < FOUND MEAN BOR OR JUST A <FN> ?
	SZA CLA			/ SKIP NEXT IF < MEANS BEGINNING OF RECORD
	JMP	TAD1		/  JMP MEANS IT'S JUST A '<' OF A <FIELD NAME>
	ISZ	BORFLAG		/   TICKLE BORFLG SO WE DON'T DO THIS FOR EVERY <

/ GET:  'BLOCK #', 'CHARACTER OFFSET OF LAB <' AND 'PERFORMANCE ATTRIBUTES'

	AC7777
	JMS	GETBNO
	DCA	GETFIF	/ [0]
TAD1,	AC0001			/ MEANS '<' FOUND
	JMP	PARSFN		/ JMP TO PARSE THE <FIELD NAME> WHOSE < WAS JUST FOUND


/ . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
/ . A RIGHT ANGLE BRACKET WAS FOUND WHILE EXPECTING CHAR'S OF THE <FIELD NAME>.
/ . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .

/ IF NO CHARACTERS WERE DETECTED AFTER THE < AND BEFORE THE >
/  THEN THIS > IS A LIST DOC EOR DELIMITER <> NOT A <FIELD NAME> DELIMITER

RAB,	CLA			/CLA BECAUSE VECTORED WITH (AC)=CHAR FROM FNBUFFER
	TAD	CCFNSIZE	/ TEST THE NUMBER OF <FIELD NAME> CHAR PARSED
	TAD	(KCCFNSIZE+1)
	SZA CLA			/  SKIP NEXT MEANS THE > FOUND IS <> DELIMITER
	JMP	TST4KEY		/   JMP MEANS <FIELD NAME> DELIMITER > DETECTED
/*E2 - MEANS > DETECTED BEFORE <
	TAD	LABFLG
	SNA CLA
	JMP	E2	/ E 2	/* A > WAS FOUND BEFORE A <
/ . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
/ . . . .  A LIST DOCUMENT END OF RECORD DIAMOND <> HAS BEEN DETECTED . . . . .
/ . . . .  WHILE EXPECTING CHARACTERS OF THE <FIELD NAME>             . . . . .
/ . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
	ISZ	RECNUM		/UPDATE TOTAL RECORDS PROCESSED [1 TO NNNN]
	SKP
	ISZ	RECNUM
/ IF THIS RECORD CONTAINED ANY NON EXISTANT KEY <FIELD NAME>S
/  THEN FLAG IT (THEM) AS SUCH
/   OTHERWISE THE KEY <FIELD NAME> 'VALUE' FIELD
/    HAS BEEN PARSED [SEE 'TST4KEY']
/     AND STORED WITHIN THE <FIELD NAME> VALUE BUFFER 'FNVBUFFER'
/     (EVEN IF THE KEY <FIELD NAME> WAS BLANK)
	TAD	(KEY01FNTOTAL-1)
	DCA	X0
	TAD	SORTKEY
	CIA
	DCA	T3		/ FOR COUNTING
	TAD I	X0	/ K 1	/ PRIMARY KEY <FIELD NAME> INDICATOR
	SNA CLA			/ SKIP NEXT IF PRIMARY KEY <FN> 'EXISTANT'
	JMP	.+7		/ PRIMARY KEY <FN> NON EXISTANT
	ISZ	KEYFNTOTAL
	SKP
	ISZ	KEYFNTOTAL
	JMP	.+4
	TAD I	X0
	SNA CLA
	JMS	NOKEYFIELD
	ISZ	T3
	JMP	.-4
/\	JMP	.+1

/ IF THE RECORD CROSSED BLOCK BOUNDRIES
/  THEN MODIFY THE 'PERFORMANCE' ATTRIBUTE (BIT 0(R) FROM 0 TO 1)
/   (WHICH WAS PREVIOUSLY PUSHED INTO THE FNV BUFFER)
/    (BUT WHOSE ADDRESS POINTER -- THE POSITION WITHIN THE FNVBUFFER)
/     (IS BEING HELD WITHIN PROGRAM LOCATION 'HHH1ST')

	JMS	NEWHHH		/ --UPDATE-- 'PERFORMANCE' ATTRIBUTE

/ CLEAR THE 'MKSBIT' WITHIN THE 'VAT' MEANS END OF MKS (MULTI-KEY SORT) RECORD

	TAD	(-MKSBIT-1)
	CDFFNV
	AND I	MKSVAT	/ [VAT]
	DCA I	MKSVAT	/ [VAT]
	CDFMYF
	JMP	NEXTRECORD	/ JMP TO PARSE THE NEXT RECORD OF THE LIST DOCUMENT

/ .............................................................................
/ THE KEY <FIELD NAME> FOR THIS RECORD IS NON EXISTANT
/ .............................................................................

NOKEYFIELD,
	XX
	JMS	PSH3V
	TAD	(-KEY01FNTOTAL+1)
	TAD	X0
	TAD	(4000+MKSBIT)
	DCAFNV
	JMP I	NOKEYFIELD

/a021	The following code moved here from RD1CHR page to make room	/a021
/a021	for recognition of dead keys in field names.			/a021

/ get a character from the 'xxsdfnbuffer' (located in field 4)		/a0011
									/a0011
TADISDFN,	XX	/						/a0011
	CDFSDFN		/ CHANGE DATA FIELD TO FIELD #4			/a0011
	TAD I	SDFN	/ GET THE CHARACTER FROM THE 'XXSDFNBUFFER'	/a0011
	CDFMYF		/ CHANGE DATA FIELD BACK TO THIS FIELD		/a0011
	JMP I	TADISDFN/ AND EXIT					/a0011

/a021	--------------  End  of  moved  code  -----------------		/a021

	PAGE

/ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
/ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
/ !!!!                                                                    !!!!
/ !!!! THE FOLLOWING IS A PSEUDO IMAGE OF THE 'SDFNBUFFER' AND 'FNBUFFER' !!!!
/ !!!!                                                                    !!!!
/ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
/ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

/ ASCII REPRE-			ASCII REPRE-
/ SENTATION OF			SENTATION OF
/ KEY <FIELD NAME>S		A <FIELD NAME>
/ DEFINED WITHIN		USED WITHIN
/ THE SPEC DOC:			THE LIST DOC:

/SDFNBUFFER,    F		FNBUFFER,       F
/		I				I
/		E				E
/		L				L
/		D				D
/		N				N
/		A				A
/		M				M
/		E				E
/		[0]: SORTKEY=1			[0]
/		F
/		.
/		.
/		[0]: SORTKEY=2
/		.
/		[0]: SORTKEY=NN
/		[-1]: SDFN BUFFER TERMINATOR

/ A <FIELD NAME> FROM THE LIST DOCUMENT AFTER BEING PARSED
/  IS HELD WITHIN THE <FIELD NAME> BUFFER 'FNBUFFER'

/ THE KEY <FIELD NAME>S TO SORT ON IN ASCENDING OR DESCENDING ORDER
/  AS DEFINED WITHIN THE SORT SPECIFICATION DOCUMENT
/   HAVE BEEN PARSED BEFORE ENTRY INTO THIS PROGRAM
/    AND RESIDE WITHIN THE SDFN BUFFER
/     IN THE ORDER IN WHICH THEY WERE DEFINED WITHIN THE SPEC DOC

/ A <FIELD NAME> FROM THE LIST DOCUMENT [THE DOCUMENT TO BE SORTED]
/  HAS BEEN PARSED AND IS BEING HELD WITHIN THE 'FNBUFFER'

/	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
/	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
/	!!!!!                             !!!!!
/	!!!!! TEST FOR A KEY <FIELD NAME> !!!!!
/	!!!!!                             !!!!!
/	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
/	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

/ IF THE <FIELD NAME> USED IN THE LIST DOCUMENT
/  IS A KEY <FIELD NAME> DEFINED BY THE SPEC DOC
/   THEN INPUT [VIA JMS RD1VALUECHAR] THE <FIELD NAME> 'VALUE'
/    AND HOLD IT WITHIN THE <FIELD NAME> VALUE BUFFER [FNVBUFFER]
/     ELSE IGNORE ALL CHARACTERS UNTIL THE NEXT LEFT ANGLE BRACKET

TST4KEY,DCAFNB			/[0] IS THE 'FNBUFFER' TERMINATOR
	AC7777
	TAD	SDFNBUFFER
	DCA	SDFN

	TAD	(KEY01FNTOTAL-1)
	DCA	T1

TSTNEXTFN,
	ISZ	T1		/ POINTER TO: KEY01FNTOTAL, THEN KEY02..., THRU KEYNN...
	TAD	(FNBUFFER-1)
	DCA	FN
TSTNUFNCHAR,
	JMS	TADISDFN	/POP A <FN> CHAR DEFINED WITHIN THE SPEC DOC	/M0011
	SZA			/ SKIP NEXT IF [0] SDFN BUFFER TERMINATOR
	JMP	TSTSMA		/  JMP TO TEST FOR THE [-1] SDFN BUFFER TERMINATOR

	TADFNB			/POP A <FIELD NAME> CHAR USED WITHIN THE LIST DOC
	SZA CLA
	JMP	TSTNEXTFN	/ [0] OF SDFN, [NN] OF FN
	JMP	FNKEYFOUND	/  [0] OF SDFN, [0] OF FN MEANS THIS IS A KEY <FN>

/ THE CHARACTER JUST POPPED FROM THE SDFN BUFFER
/  IS  +++NOT+++  THE [0] TERMINATOR
/   IT MAY BE A <FIELD NAME> CHARACTER
/    OR IT MAY BE THE [-1] TERMINATOR

TSTSMA,	SMA			/SKIP NEXT IF [-1] FROM SDFN
	JMP	DOCIA		/ JMP TO DO A CIA CAUSE IT'S A <FN> CHAR

/ A CHARACTER OF THE <FIELD NAME> DEFINED WITHIN THE SPEC DOC
/  DID  +++NOT+++  COMPARE WITH A CHAR OF THE <FIELD NAME> USED WITHIN THE LIST DOC
/   THEREFORE IGNORE ALL CHAR'S RELATED TO THAT <FIELD NAME> 'VALUE'

/*E7 - MEANS A DISK EOF DETECTED AFTER > BUT BEFORE < OR <>

NOTKEYFN,
	AC0000
	JMS	RD1FNCHAR	/READ ONE 12-BIT CHARACTER FROM THE LIST DOCUMENT
	  JMP	E7	/ E 7	/ ... (AC)=0; LIST DOCUMENT END OF FILE [NO MORE DATA]
	  JMP	.-3		/ ...THE 'VALUE' CHARACTER IS NON-PRINTING [SO WHAT]
	  JMP	LABSDFN		/ ...THE 'VALUE' CHARACTER IS A < [START OF A <FIELD NAME>]
	  JMP	.-5		/ ...THE 'VALUE' CHARACTER IS A > [NOT LOOKING FOR THAT]
	  JMP	.-6		/ ...THE 'VALUE' CHARACTER IS PRINTABLE [WHO CARES]

/ THE CHARACTER POPPED FROM THE SDFN BUFFER
/  IS NOT THE [0] OR [-1] TERMINATORS
/   THEREFORE IT IS A CHARACTER OF THE <FIELD NAME>

DOCIA,	CIA			/NEGATE IT FOR COMPARISON LATER
	DCA	T2		/ TEMP SAVE
	TADFNB			/POP A <FIELD NAME> CHARACTER USED IN THE LIST DOC
	SNA
	JMP	NEXTSDFN	/ [0] OF FN BUFFER, [NN] OF SFDN

/ MATCHED 1 <FIELD NAME> CHARACTER [POPPED FROM THE SDFN BUFFER]
/  WITH 1 <FIELD NAME> CHARACTER [POPPED FROM THE FN BUFFER]
/  THEREFORE COMPARE A NEW <FIELD NAME> CHARACTER
	TAD	T2		/2'S COMP ADD SDFN CHAR WITH <FN> CHAR
	SNA CLA
	JMP	TSTNUFNCHAR	/ COMPARE A NEW <FIELD NAME> CHARACTER
/ <FIELD NAME> CHARACTERS DID NOT MATCH
/   MOVE DOWN TO THE NEXT [0] TERMINATOR WITHIN SDFN BUFFER
/    RESET TO THE TOP OF THE FN BUFFER

NEXTSDFN,
	JMS	TADISDFN	/					/m0011
	SPA
	JMP	NOTKEYFN	/ [-1] SDFN TERMINATOR FOUND, NOT A KEY <FIELD NAME>
	SZA CLA
	JMP	NEXTSDFN
	JMP	TSTNEXTFN	/ [0] OF SDFN MEANS THIS IS >NOT< A KEY <FN>

/ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
/ !!!!                                                       !!!!
/ !!!! THE FOLLOWING IS A PSEUDO IMAGE OF THE:               !!!!
/ !!!! 'FNVBUFFER', AND 'FNVARBUFFER' BUFFERS.               !!!!
/ !!!!                                                       !!!!
/ !!!! ---- NOTE THAT THEY OCCUPY THE SAME FIELD ----        !!!!
/ !!!!                                                       !!!!
/ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

/ PACKED 6-BIT ASCII REPRESENTATION OF THE 'VALUE' FIELD
/ FOR THE KEY <FIELD NAME> FOUND IN THE LIST (INPUT) DOCUMENT

/	 (FNV)
/  \/	 BUFFER,  BLOCKNO	:: APPLICABLE IF 1ST ENTRY FOR RECORD
/  \/		  LABOFFSET	:: APPLICABLE IF 1ST ENTRY FOR RECORD
/  \/		  PERFORMANCE	:: APPLICABLE IF 1ST ENTRY FOR RECORD
/  \/		  VAT		:: ALWAYS APPLICABLE
/  \/		  V A
/  \/		  L U
/  \/		  E F
/  \/		  I E
/  \/	 FNV +A,  L D
/  \/		  BLOCKNO	:: NOT APPLICABLE IF MULTI-KEY RECORD
/  \/		  LABOFFSET	:: NOT APPLICABLE IF MULTI-KEY RECORD
/  \/		  PERFORMANCE	:: NOT APPLICABLE IF MULTI-KEY RECORD
/  \/	 FNV +B,  #4000		:: ALWAYS APPLICABLE
/  \/		  BLOCKNO
/  \/		  LABOFFSET
/  \/		  PERFORMANCE
/  \/	 FNV +C,  #40KK
/  \/		  \\\\////
/  \/	(DUMMY),  0
/  \/		  0
/  \/		  0
/  \/		  0

/ MERGE FILLS-OUT THE 4 WORDS (THE 'DUMMY' ENTRY WITHIN 'FNVAR')
/  AFTER THE PREVIOUS (LAST VALAD) ENTRY WITH THE VALUE OF 0000
/   BECAUSE THE MERGE AND THE OUTPUT DOCUMENT GENERATOR
/    NEED TO KNOW THE END

/ ? ? ? ? ?   ? ? ?  ? ?? ? ? ??? ? ? ? ?? ?? ?? ? ? ? ???? ? ?? ? ? ? ?
/  ???? ? ? ? ? ? ? ? ? ???  ? ? ? ? ? ??? ? ? ? ? ? ? ? ?? ? ?  ? ???

/ THE PC-1 FOR EACH 'VALUE' FIELD ENTRY WITHIN THE 'FNV' BUFFER

/  /\		 [-1]
/  /\		 (DUMMY)
/  /\		 FNV+
/  /\		 FNV +E
/  /\		 FNV +D
/  /\		 FNV +C
/  /\		 FNV +B
/  /\	(FNVAR)  FNV +A
/  /\	BUFFER,  FNVBUFFER-1

/ BLOCKNO::	0  1  2  3  4  5  6  7  8  9 10 11
/		M1 M2  B  B  B  B  B  B  B  B  B  B
/
/ OFFSET::	0  1  2  3  4  5  6  7  8  9  10 11
/		M3 M4 M5 CO CO CO CO CO CO CO CO CO
/
/ PERFORMANCE::	0  1  2   3   4   5  6  7  8  9  10 11
/		R  -  HO  HO  HO  HO HO HO HO HO HO HO
/
/		R = 0 MEANS SINGLE BLOCK READ
/		R = 1 MEANS MULTIPLE BLOCK READ

/			-------------------------------------------
/ VAT MEANS:		!  0 1 2  !  3 4 5  !  6 7 8  !  9 10 11  !
/ (VALUE ATTRIBUTE)	!  X V V     V V V  !  S M K     K  K  K  !
/			-------------------------------------------
/
/ IF X = 0 THEN:  VVVVV = THE NUMBER OF 'VALUE' LOCATIONS USED WITHIN FNV BUFFER

/	   AND:       S = 0 MEANS EVEN NUMBER OF 'VVVVV' CHARACTERS
/			= 1 MEANS ODD NUMBER OF 'VVVVV' CHARACTERS

/	   AND:   KKKKK = THE NUMBER OF THE KEY
/
/ IF X = 4000 THEN:

/ THE #4000 MEANS:	  THE RECORD OF THE LIST DOCUMENT
/			  DID  +++NOT+++  CONTAIN ANY KEY <FIELD NAME>S
/			  AS DEFINED WITHIN THE SPECIFICATION DOCUMENT
/
/ THE #40KK MEANS:	  THE RECORD OF THE LIST DOCUMENT
/			  CONTAINED A  +++BLANK+++ 'VALUE' FIELD
/			  FOR KEY <FIELD NAME> NUMBER KK
/			  DEFINED WITHIN THE SPECIFICATION DOCUMENT

XBIT=	4000
VVVVV=	37
SBIT=	40
MKSBIT=	20
KKKK=	17

/ . . . . . . . . . . . . . . . . . . . . . . . . . . . .
/ A <FIELD NAME> DEFINED WITHIN THE SPECIFICATION DOCUMENT
/  [ BEING HELD WITHIN THE SDFN BUFFER ]
/   +++ IS THE SAME AS +++
/    A <FIELD NAME> USED WITHIN THE LIST DOCUMENT
/     [ AND BEING HELD WITHIN THE FN BUFFER ]
/ . . . . . . . . . . . . . . . . . . . . . . . . . . . .

/*E6 - MEANS THAT THIS <FIELD NAME> IS DUPLICATED WITHIN THE SAME RECORD

FNKEYFOUND,
	TAD I	T1		/SAME AS 'TAD KEY01FNTOTAL' THRU 'KEY--FNTOTAL'
	SZA CLA			/ SKIP NEXT OF NO PREVIOUS <FN> OF THIS NAME
	JMP	E6	/ E 6	/*  RECORD CONTAINS A DUPLICATE <FIELD NAME>
	ISZ I	T1		/+1 TO THE TOTAL # OF <FN> OF THIS NAME
/ A <FIELD NAME> DEFINED WITHIN THE SPECIFICATION DOCUMENT
/  IS THE SAME AS A <FIELD NAME> USED WITHIN THE LIST DOCUMENT
/   THEREFORE THE <FIELD NAME> USED WITHIN THE LIST DOCUMENT
/    IS A  +++KEY+++ <FIELD NAME>
	JMS	PSH3V		/PUSH INTO THE FNV BUFFER THE::
				/ BLOCK#, OFFSET, PERFORMANCE ATTRIBUTES OF THIS <KEY>
	TAD	(-KEY01FNTOTAL+1)
	TAD	T1
	DCA	KEYNO		/ SAVE IT FOR USE WITHIN 'NVFPROCESSOR'
	TAD	KEYNO
	DCAFNV		/ [VAT]	/ THE ABSOLUTE # OF THIS KEY <FN> WITHIN SDFN BUFFER
/\	JMP	.+1

/ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
/ !!!!!                                                        !!!!!
/ !!!!! GET THE 'VALUE' FIELD OF THE KEY <FIELD NAME> SELECTED !!!!!
/ !!!!!                                                        !!!!!
/ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

/ GET THE <FIELD NAME> 'VALUE' FIELD FOR THIS <FN>
/  AND PUSH IT INTO THE <FIELD NAME> VALUE BUFFER 'FNVBUFFER'
/ THE 1ST 60 PRINTABLE CHARACTERS UP TO A < OF THE NEXT <FN> OR <>
/   ARE PART OF A <FIELD NAME> 'VALUE' FIELD

GETFNVALUE,
	AC7776
	DCA	VALCOUNT	/ TWO 6-BIT ASCII 'VALUE' CHAR PER FNV SLOT
DCAPACK6BIT,
	BSW			/ AND PUT INTO HIGH ORDER BYTE OF THE WORD: CC00
	DCA	PACK6BIT	/ START WITH (PACK6BIT) CLEAR; IT'S MUCH CLEANER
	JMS	XRD1VALUECHAR	/ READ 1 'VALUE' FIELD CHARACTER
/ CONVERT (AC): MMMMMCCCCCCC  'LOWER CASE' CHARACTERS TO 'UPPER CASE'
	AND	P177		/ STRIP MODE BITS MAKING 7-BIT ASCII CHAR
	TAD	(-140)		/ MAKE 'LOWER CASE'
	SPA			/  'UPPER CASE'
	TAD	(140)		/ WHOOPS - NOT AN ALPHA CHARACTER
/ ONLY THE 1ST 60 CHARACTERS OF THE <FN> 'VALUE' FIELD ARE SORTED ON
/ ALL EXCESSIVE 'VALUE' FIELD CHARACTERS ARE IGNORED
	ISZ	CCVALUE
	JMP	ANDP77

/ 'VALUE' FIELD OVERFLOW

/ THE <FIELD NAME> 'VALUE' FIELD EXCEEDED 60 PRINTABLE CHARACTERS
/  WHICH IS NOT AN ERROR BUT MEANS ALL EXCESSIVE CHAR'S MUST BE IGNORED
/   BECAUSE THIS PROGRAM IS DESIGNED TO SORT ON ONLY THE 1ST 60 CHARS

	JMS	XRD1VALUECHAR	/ READ 1 'VALUE' FIELD CHARACTER
	  JMP	.-1		/  IGNORE THIS 'OVER 60' CHARACTER

/ THE CONTENTS OF THE AC IS A 12-BIT 'VALUE' CHARACTER: MMMMMCCCCCCC

ANDP77,	AND	P77		/MAKE THE 12-BIT CHARACTER 6-BIT
	JMS	NVFPROCESSOR	/ IF <:FN> THEN 'NVFPROCESSOR' CAPTURES MAIN-LINE
IFNDEF ITALIAN <
	TAD	(SBIT)    /ADD 40 TO CHAR (SET FROM ASCII TO 6 BIT SEQ) /A016
	AND	P77		/MASK OUT L/O 6 BITS			/A016
		>
	ISZ	VALCOUNT	/  +1 FROM 7776 TO 7777 TO 0
	JMP	DCAPACK6BIT	/   JMP TO GET ANOTHER CHARACTER

/ (VALCOUNT) WENT TO 0 MEANS GOT 2 PACKED 6-BIT <FN> 'VALUE' FIELD CHARACTERS

	TAD	PACK6BIT	/ CC00
	DCAFNV			/  PUSH THE TW0 6-BIT CHAR'S WITHIN THE FNV BUFFER
	JMP	GETFNVALUE	/   JMP TO GET MORE OF THE <FN> 'VALUE' TIL THE NEXT <

VALSTATUS,			/ 0 MEANS EVEN # OF 'VVVVV', 40 MEANS ODD
VALCOUNT,	-2		/ TWO 6-BIT 'VALUE' CHARACTERS PER 1 FNV BUFFER SLOT
PACK6BIT,	0		/ LOCAL TEMP WORK

/ . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
/ . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
/ . .                                                                     . .
/ . . A LEFT ANGLE BRACKET WAS DETECTED                                   . .
/ . . WHILE EXPECTING CHARACTERS OF THE 'VALUE' FIELD FOR THAT <FN>       . .
/ . . WHICH MEANS THIS MUST BE THE END OF THE <FIELD NAME> 'VALUE' FIELD  . .
/ . .                                                                     . .
/ . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
/ . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .

GOTALL,	CLA			/CLA CAUSE VECTOR HERE WITH (AC) = 12-BIT CHAR
	TAD	PACK6BIT	/ 0000 IF (VALCOUNT) = 7776; ELSE CC00 CAUSE = 7777
	ISZ	VALCOUNT
	JMP	.+3
	DCAFNV			/ PUSH CC00 INTO THE FNV BUFFER
	TAD	(SBIT)
	DCA	VALSTATUS

/ IF THERE WERE NO 'VALUE' CHARACTERS BETWEEN THE LAST > AND THIS <
/ THEN THIS KEY <FIELD NAME> HAS A  +++BLANK+++  'VALUE' FIELD

	AC0004
	TAD	FNVKEY		/ (AC) = ADDRESS OF THE [VAT]
	CIA			/   NEGATE FOR COMPARISON
	TAD	FNV		/    CURRENT ADRS OF FNV
	SNA
	JMP	FNVBLANK

/ THE 'VALUE' FIELD FOR THIS KEY <FIELD NAME> IS NOT BLANK
/
/ THE CONTENTS OF THE AC = THE NUMBER OF FNV BUFFER SLOTS
/ USED TO STORE THE VALUE FIELD

	BSW			/MOVE INTO HIGH BYTE:	0VVVVV 000000
	TAD	VALSTATUS	/ 0VVVVV S00000
	JMP	FNVOK		/ THE FIELD NAME IS OK

/ THE 'VALUE' FIELD FOR THIS <FIELD NAME> IS  +++BLANK+++
/  PUSH THE #40KK INTO THE FNV BUFFER SLOT
/   PREVIOUSLY RESERVED FOR THE 'VALUE ATTRIBUTE' ELEMENT (VAT)'

FNVBLANK,
	AC4000		/ XBIT

/ THE 'VALUE' FIELD FOR THIS <FIELD NAME> IS +++NOT+++ BLANK
/  PUSH THE #0V00 INTO THE FNV BUFFER SLOT
/   RESERVED FOR THE 'VALUE ATTRIBUTE' ELEMENT (VAT)

FNVOK,	CDFFNV
	TAD I	MKSVAT	/ [VAT]	/ (AC) = 40KK OR 0VKK
	TAD	(MKSBIT)/ MKSBIT
	DCA I	MKSVAT	/ [VAT]	/   PUT BACK INTO THE FNV BUFFER
	CDFMYF
	AC0001			/     MEANS '<' FOUND
	JMP	NEXTFN		/      JMP TO PARSE THE NEXT <FIELD NAME> OF THE LIST DOC

FNVKEY,	FNVBUFFER-1

/ PUSH INTO THE 'FNVBUFFER' THE ATTRIBUTES FOR THIS KEY <FN>; (OR NO KEY RECORD)
/ ....BLOCK #...., ....CHARACTER BYTE OFFSET...., ....PERFORMANCE....

PSH3V,	XX
	TAD	FNV		/ GET THE ADDRESS OF THE FNV BUFFER
	DCA	FNVKEY	/ FNVKEY
	TAD	BLOCKNO		/   GET BLOCK # WHEN THE < WAS DETECTED [AT 'LAB']
	DCAFNV			/    PUSH IT INTO THE FNV BUFFER
	TAD	LABOFFSET	/     GET CHAR OFFSET OF THE '<' WHEN IT WAS DETECTED
	DCAFNV			/      PUSH IT INTO THE FNV BUFFER TOO
	TAD	PERFORMANCE
	DCAFNV
	TAD	FNV		/ ADDRESS-1 OF [VAT]
	IAC
	DCA	MKSVAT	/ MKSVAT/ ADDRESS OF [VAT] WITHIN FNV TABLE
	JMP I	PSH3V

	PAGE

/ . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
/ . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
/ . . . .                                             . . . .
/ . . . . A DISK END OF FILE [EOF] HAS BEEN DETECTED  . . . .
/ . . . . WHILE EXPECTING CHAR'S OF THE <FIELD NAME>  . . . .
/ . . . .                                             . . . .
/ . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
/ . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .

/*E9  - MEANS NO RECORDS PROCESSED [INPUT DOC PROBABLY HAD ONLY TEXT]

DISKEOF,TAD	RECNUM
	SNA CLA
	JMP	E9	/ E 9	/*NO RECORDS PROCESSED

/*E7 - MEANS THIS DISK EOF DETECTED AFTER < BUT BEFORE >

	TAD	LABFLG
	SZA CLA
	JMP	E7	/ E 7	/*DISK EOF DETECTED AFTER < BUT BEFORE > OR <>

/*E10- MEANS NO RECORDS SELECTED [LIST DOC HAD NO KEY <FN>'S]

	TAD	KEYFNTOTAL
	SNA CLA
	JMP	E10	/ E 10	/*E10 - NO RECORDS SELECTED FOR SORT

/ SET A [-1] TERMINATOR INTO THE FNVAR BUFFER

	AC7777; JMS DCAVAR
/ DISPLAY ON THE SCREEN THE # OF RECORDS SELECTED OUT OF # PARSED

	JMS	SPDPRS		/ RECORDS SELECTED:  S OUT OF X
	JMS	SORT		/ SORT THE 'FNVAR' TABLE VIA THE 'FNV' TABLE
	JMS	MERGE		/ MERGE THAT TABLE WITH ANY FNV PACKETS
	JMS	ODG		/ TO THE OUTPUT DOCUMENT GENERATOR

/ IF WE GOT TO HERE
/  THEN WE ARE FINISHED:
/   SELECTING, SORTING, MERGING AND PRODUCING THE OUTPUT DOCUMENT

/ THEREFORE OUTPUT TO THE SCREEN THE MESSAGE: 'DONE'

	CIFIOA		/ -IOA-
	JMS I	IOACAL
	  0			/
	  MSRDONE		/ 'DONE'
	  1205			/ ^P

	JMP	NOERRORS

/ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
/ !!!!                                    !!!!
/ !!!! REPORT AN EXPLICIT ERROR CONDITION !!!!
/ !!!!                                    !!!!
/ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

E5CLA,	CLA; JMP E5	/ E 5

/ THE CONTENTS OF THE AC AT ENTRY TO 'E-' MUST = 0 FOR THE IAC'S TO WORK

E13A,	IAC			/ OUTPUT VOLUME FULL			/A018
E13,	IAC			/ output diskette full (no more blocks to alloc)	/a0014
E12P,	/IAC			/ EXTRA RADIX POINT ('.') FOUND
E12N,	/IAC			/ ILLEGAL PLACEMENT OF ('$') CURRENCY SYMBOL
E12M,	/IAC			/ EXTRA ('$') CURRENCY SYMBOL FOUND
E12L,	/IAC			/ EXTRA SIGN BUT FOUND
E12K,	/IAC			/ ILLEGAL PLACEMENT OF ('+') PLUS SIGN
E12J,	/IAC			/ EXTRA RIGHT ')' PAREN FOUND
E12I,	/IAC			/ '()' FOUND -- BACK TO BACK PARENS
E12H,	/IAC			/ NO '(' BEFORE ')'
E12G,	/IAC			/ SIGN '+' OR '-' PRECEEDED RIGHT ')' PAREN
E12F,	/IAC			/ ILLEGAL PLACEMENT OF LEFT '(' PAREN
E12E,	/IAC			/ '(' BUT NO ')' DETECTED BEFORE <CR>
E12D,	/IAC			/ UNKNOWN CHARACTER -- NOT 0 THRU 9 OR 'NATURAL'
E12C,	/IAC			/ TO MANY CHAR'S -- 'KWHOLE' OR 'KFRACTION' OVFL
E12B,	/IAC			/ ILLEGAL PLACEMENT OF MINUS '-' SIGN
E12A,	/IAC			/ ILLEGAL PLACEMENT OF RIGHT ')' PAREN
	IAC			/ (INVALAD NUMERIC VALUE FIELD SYNTAX)
E11,	IAC			/ SPEC DOC DEFINED TO MANY KEYS TO SORT ON
E10,	IAC			/ LIST DOC HAD NO KEY <FIELD NAME>S
E9,	IAC			/ LIST DOC HAD NO RECORDS TO PROCESS
E8,	IAC			/*ODG: UNEXPECTED DISK EOF
E7,	IAC			/ A DISK EOF DETECTED AFTER < BUT BEFORE > OR <>
E6,	IAC			/ DUPLICATE <FIELD NAME> WITHIN SAME RECORD
E5,	IAC			/ > DETECTED WITHIN <FIELD NAME> VALUE
E4,	IAC			/ <FIELD NAME> EXCEEDED 30 DECIMAL CHARACTERS
E3,	IAC			/ < DETECTED WITHIN A <FIELD NAME>
E2,	IAC			/ HAS TEXT PRECEEDING THE <FIELD NAME>
/E1,	IAC			/
E0,	TAD	(EMESTABLE)	/ RECORD EXCEEDED 2500 PRINTABLE CHARACTERS
	DCA	ERMEADRS

	JMS	SPDPRS		/ OUTPUT TO THE SCREEN: 'KEY RECORDS:  X OF Y

	CIFIOA		/ -IOA-
	JMS I	IOACAL
	  0			/
	  MERROR		/ ^S - CONTROL AND TEXT ADDRESS
	  1200			/ ^P
	  1300			/ ^P
ERMEADRS, (EMESTABLE)		/ !S - ADDRESS OF ADDRESS OF TEXT
	  1400			/ ^P
	  1600			/ ^P
/\	JMP	.+1

/DROP FROM ABOVE AND

/ OUTPUT TO THE SCREEN THE FIRST  >7<  LINES
/  OF THE RECORD BEING PROCESSED
/   WHEN THE ERROR WAS DETECTED

	TAD	BLOCKNO		/ BLOCK # OF INPUT DOC AT TIME OF ERROR
	DCA	EBNO
	TAD	LABOFFSET	/ OFFSET OF > AT TIME OF ERROR
	DCA	EOFF
	TAD	PERFORMANCE	/ HHH AT TIME OF ERROR
	CLL RAL
	STL RAR			/ FORCE 'MULTIPLE READ' MODE
	DCA	EHHH
	JMS	PUTBNO		/ 'PUT' THE NEXT 3 PARAMATERS INTO % RANDRD
EBNO,	  ZBLOCK 1
EOFF,	  ZBLOCK 1
EHHH,	  ZBLOCK 1
	  JMP	NO7LINES	 / CAN'T TYPE -7- LINES; JUST ERRORED TRYING TO GET THEM
	TAD	(-7)
	DCA	SRBUGSWITCH	/  >>7<< LINES

/ OUTPUT UP TO >>7<< LINES
/  OF THE RECORD BEING PROCESSED
/   AT THE TIME OF THE ERROR

SRLOOPE,AC0002			/'+2' FLAG FOR 'EORD1CHAR'
	  JMS	ERORD1CHAR	/ READ 1 CHAR FROM THE LIST DOCUMENT
	  JMP	SRERROR		/ ...RETURN TO HERE AT DISK EOF... (AC)=0
				/ ......(A DISK EOF COULD OCCUR)
				/ ......(BECAUSE  7  LINES OF DATA TO READ)
	  JMP	ERRCR		/ ...NON-PRINTING RETURNS HERE
				/ ......(IF IT IS A 'LF' THEN STUFF A 'CR')
	  NOP			/ ... < RETURNS HERE; (TYPE IT)
	  NOP			/ ... > RETURNS HERE; (TYPE IT)
	  JMS	TYPERD		/ ... 12-BIT CHAR DATA RETURNS HERE; (TYPE IT)
	JMP	SRLOOPE		/ GET NEXT CHARACTER

/ IF THE CHARACTER JUST READ FROM THE LIST DOCUMENT
/  (WHICH IS PART OF THE >7< LINES FOR OUTPUT
/   IS A 'LINE FEED' THEN OUTPUT A 'CARRIAGE RETURN'

ERRCR,	JMS	TYPERD		/ type nonprinting character
	TAD	CHR177		/ was character just typed a <lf>?
	TAD	(-LF)
	SNA CLA
	TAD	(CR)		/ yes - type a <cr>
	JMS	TYPERD		/ no - type a null character
	ISZ	SRBUGSWITCH	/ UPDATE TYPED LINE COUNT
	JMP	SRLOOPE		/ UNTIL UP TO  >>7<< LINES ARE ECHOED TO THE VT
NO7LINES,
SRERROR,DCA	SRBUGSWITCH	/ ZERO 'SRBUGSWITCH'
/\	JMP	.+1

NOERRORS,

/ IF WE DROPPED FROM ABOVE
/  THEN THE ODG SHOULD HAVE DEALLOCATED ALL MERGE SCRATCH BLOCKS (NATURALLY)
/   BUT BECAUSE THE MERGE CAN WRITE 'PARTIAL' BLOCKS (WITHIN THE CHAIN)
/    AND THE ODG IS DONE WHEN A '0' VAT IS FOUND
/     (NOT WHEN ALL BLOCKS ARE READ)
/      'JMS MRGEFRALL' ANYWAY TO BE SURE ALL BLOCKS ARE DEALLOCATED
/        ELSE RUNNING 'MC::VERIFY' COMMAND (FROM MAIN MENU)
/         WILL DETECT ALLOCATION ERRORS

	JMS	MRGEFRALL	/ DEALLOCATE ALL BLOCKS ALLOCATED BY:: MERGE

/ OUTPUT THE MESSAGE:: GOLD M TO THE SCREEN

	CIFIOA		/ -IOA-
	JMS I	IOACAL
	  0			/
	  MGOLD			/
	  2703			/ ^P
AOK1,	JMS	WAITM		/ WAIT FOR KEY 'GOLD M'			/C017
AOK,	JMP	AOK1		/ RETURN HERE IF NOT GOLD M		/C017
				/ RETURN HERE IF GOLD M
/ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
/SRABORT,CDIMNU			/ CDF CIF TO THE MENU FIELD
SRABORT,CDF CIF 20
/ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	JMP I	MMRETURN	/ BACK TO THE 'MAIN' MENU

/ SUBROUTINE TO OUTPUT TO THE SCREEN THE TEXT:  'SR:  WORKING'

SRWORKING,	XX
	JMS	TIMEOUT
	CIFIOA		/ -IOA-
	JMS I	IOACAL
	0
	MPROCESSING		/ ^S - CONTROL AND TEXT ADDRESS
	1205			/ ^P - LINE / COLUMN
	1600			/ ^P - LINE / COLUMN
	JMP I	SRWORKING

XRD1VALUECHAR,
	XX
/*E7 - MEANS A DISK EOF DETECTED AFTER > BUT BEFORE < OR <>
/*E5 - MEANS A > WAS DETECTED WITHIN THE 'VALUE' FIELD
/*E0 - MEANS RECORD EXCEEDED 2500 PRINTABLE CHARACTERS
	AC7777			/ '-1' FLAG FOR 'RD1VALUECHAR'
	JMS	RD1VALUECHAR	/  READ 1 'VALUE' 12-BIT CHARACTER FROM THE LIST DOCUMENT
	  JMP	E7	/ E 7	/*  (AC)=0; LIST DOCUMENT END OF FILE [NO MORE DATA]
	  JMP	.-3		/    THIS 'VALUE' CHAR IS NON-PRINTING [NO BIG DEAL]
	  JMP	GOTALL		/     THIS 'VALUE' CHAR IS '<' MEANS END OF VALUE FIELD
	  JMP	E5CLA	/ E 5	/* > DETECTED WITHIN THE <FIELD NAME> VALUE
	JMP I	XRD1VALUECHAR	/      12-BIT CHARACTER IS IN THE AC

	PAGE

/	AC????			/AC AT ENTRY IS A FLAG:: -1, 0, 1, 2
/	JMS	$$$$$$		/JMS IS THE CALL, (AC) AT EXIT = 12-BIT CHAR
/	   JMP	A		/    RETURN TO HERE WHEN A DISK EOF
/	   JMP	B		/    RETURN TO HERE WHEN A NON-PRINTING CHAR
/	   JMP	C		/    RETURN TO HERE WHEN A < LEFT ANGLE BRACKET
/	   JMP	D		/    RETURN TO HERE WHEN A > RIGHT ANGLE BRACKET
/	   JMP	E		/    RETURN TO HERE WHEN A <FIELD NAME> CHAR

/ SUBROUTINE TO READ 1 CHARACTER FROM THE LIST DOCUMENT FOR ERROR TYPEOUT.
/ (WITHOUT 'SCROLLING' THEM TO THE OUTPUT DOCUMENT

ERORD1CHAR,			/ ENTER HERE WITH THE AC = 0002
/ ----------------------------------------------------------------------------

/ SUBROUTINE TO READ 1 CHARACTER FROM THE LIST DOCUMENT
/  (FOR 'SCROLL'ING TO THE OUTPUT DOCUMENT)

ODGRDCHAR,			/ ENTER HERE WITH THE AC = 0001 MEANS IGNORE NOTHING
/ ----------------------------------------------------------------------------

/ SUBROUTINE TO READ 1 <FIELD NAME> 'VALUE' FIELD CHARACTER
/  FROM THE LIST DOC

RD1VALUECHAR,			/ ENTER HERE WITH THE AC = 7777
/ ----------------------------------------------------------------------------

/ SUBROUTINE TO READ 1 <FIELD NAME> CHARACTER FROM THE LIST DOCUMENT

RD1FNCHAR,			/ ENTER HERE WITH THE AC = 0000
/ ----------------------------------------------------------------------------
	XX
	JMS	RD1CHR		/'JMS' WITH (AC)=0000, 0001, 0002, OR 7777
	JMP I	RD1FNCHAR	/ 'JMP I' MEANS DISK EOF (OUT OF DATA) DETECTED
/ ENTRY TO HERE IS WITH THE AC = 7-BIT ASCII CHARACTER
	TAD	(-40)	/ -40
	SPA
	JMP	NPCCHAR		/ THE CHARACTER IS: NON-PRINTING

	TAD	(-34)	/ -74
	SNA
	JMP	LABCHAR		/ THE CHARACTER IS #74: A LEFT ANGLE BRACKET '<'

	TAD	(-2)	/ -76
	SNA CLA
	JMP	RABCHAR		/ THE CHARACTER IS #76: A RIGHT ANGLE BRACKET '>'
/\	JMP	.+1

/ DROP FROM ABOVE, AND
/ . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
/ IF THE MAIN-LINE IS THE SELECTOR
/  SIGNIFIED BY THE CONTENTS OF PROGRAM LOCATION 'RDFLAG' = 0 OR -1
/   THEN 'ISZ CCRECORD'

/*E0 - MEANS RECORD EXCEEDED 2500 PRINTABLE CHARACTERS
/    - (EXCLUDING '<'S AND '>'S)

	TAD	RDFLAG
	SMA SZA CLA
	JMP	.+4
	ISZ	CCRECORD
	SKP
	JMP	E0	/ E 0	/*RECORD EXCEEDS 2500 CHARACTERS
/ . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
	ISZ	RD1FNCHAR	/ THE CHAR IS PRINTABLE
RABCHAR,ISZ	RD1FNCHAR
LABCHAR,ISZ	RD1FNCHAR
NPCCHAR,ISZ	RD1FNCHAR

/ EXIT WITH (AC) = 12-BIT CHARACTER: MMMMMCCCCCCC

	CLA			/CLA CAUSE (AC) IS GARBAGE
	TAD	CHARIN		/ GET BACK THE 12-BIT CHARACTER (INCLUDING MODE BITS)
	JMP I	RD1FNCHAR	/  AND EXIT WITH IT IN THE AC

/ SUBROUTINE TO READ A CHARACTER FROM A DOCUMENT
/	JMS ZRDNXCH
/	   DISK END OF FILE RETURNS TO THIS PC WITH (AC) = 0
/	      ELSE RETURN TO THIS PC
ZRDNXCH,XX
	JMS	XXHLTFLG	/ TEST FOR THE GOLD HALT FLAG
	JMS	RDNXCH		/ % RANDRD READS 1 CHAR
	DCA	CHARIN		/ MMMMM CCCCCCC
	TAD	CHARIN		/ GET IT BACK
	AND	P177		/ STRIP OFF MODE BITS
	DCA	CHR177		/ SAVE 00000CCCCCCC
	TAD	CHARIN		/ GET IT BACK FOR EXIT
	SZA			/ SKIP NEXT IF NO MORE DATA
	ISZ	ZRDNXCH		/ 'ISZ' MEANS GOT DATA FROM INPUT DOC
	JMP I	ZRDNXCH		/

/SUBROUTINE TO READ ONE CHARACTER FROM THE INPUT DOCUMENT (EXIT WITH AC= 7-BIT ASCII)
/ AC AT ENTRY =-1: IGNORES ONLY: RULERS, JUSTIFYING SPACES AND LINE FEEDS
/ AC AT ENTRY = 0: IGNORE ALL BLANKS, TABS, RULERS, JUSTIFYING SPACES AND <LF>'S
/ AC AT ENTRY =+1: IGNORE NOTHING AND 'JMS ODGSCROLL' (CAUSE MAIN-LINE IS ODG)
/ AC AT ENTRY =+2: IGNORE NOTHING SO WE CAN OUTPUT THE CHARACTER TO THE SCREEN
/		   AS PART OF THE ERROR DETECTION AND REPORTING
RDFLAG,	ZBLOCK	1		/ HOLDS THE CONTENTS OF THE AC:: -1, 0, 1, 2

/CALLED WITH AC=FLAG
/   JMS RD1CHR
/      DISK EOF RETURN TO THIS PC [WITH THE AC = 0]
/         ELSE RETURN TO THIS PC [WITH AC = THE 7-BIT CHAR: 00000CCCCCCC]

RD1CHR,	XX
	DCA	RDFLAG		/ SAVE FLAG
RDNEXT,	JMS	ZRDNXCH		/ READ 1 CHAR
	 JMP I	RD1CHR		/ DISK END OF FILE [EOF]
	CLA
RDNOBUG,TAD	RDFLAG		/ Get the read type flag.		/a021
	SPA CLA			/ Is this a field value?		/a021
	JMP	SINGLE		/ Yes, CHECK FOR SINGLE ACCENTED CHARACTERS
RDNOB1,	TAD	CHR177		/ No, GET CHARACTER:: 00000CCCCCCC
	TAD	(-41)
	SPA CLA			/ SKIP NEXT IF THE CHARACTER IS PRINTABLE
	JMP	NPC
RD1EXIT,CLA
	DCA	FLAG40		/ PRINTABLE CHARACTERS RESET 'FLAG40'
NPCEXIT,TAD	CHR177		/ GET CHARACTER TO RETURN WITH
	ISZ	RD1CHR		/ +1 TO RETURN ADDRESS
RD1EOF,	JMP I	RD1CHR

/ NON PRINTING [SPECIAL] CHARACTER

NPC,	TAD	RDFLAG
	SMA SZA CLA		/ SKIP IF AC<= 0
	JMP	ODGSKP		/ 'JMP' BECAUSE MAINLINE IS 'ODG'
	TAD	CHR177		/ GET CHARACTER:: 00000CCCCCCC
/\	JMP	NOTODG
/ THE CHARACTER IS NON-PRINTING
/  AND THE MAINLINE IS  --NOT--  THE OUTPUT DOCUMENT GENERATOR (ODG)
NOTODG,	TAD	(-10)		/ CHECK FOR 'BEGIN DEAD'
	SZA			/ Is it a begin sequence introducer?	/m021
	JMP	NOTDEAD		/ No, deal with others			/a021
	CMA			/ Yes, set the dead flag.		/a021
	DCA	DEADKEY		/					/a021
	TAD	RDFLAG		/ Test the read type.			/a021
	SMA			/ Is it a field value read?		/a021
	JMP	RD1EXIT		/ No, exit with character as is.	/a021
	JMP	DEAD		/ Yes, JMP TO DEAD KEY SEQUENCE PROCESSOR
NOTDEAD,TAD	(10-40)		/					/A021
	SNA
	JMP	SPHANDLER	/ THE CHARACTER IS A:: SPACE (40) OR (2040)
	TAD	(40-12)
	SZA
	JMP	NOTLF		/ NOT A LINE FEED
	TAD	CHARIN		/ THE CHARACTER IS A:: LINE FEED (12)
	AND	(3000)		/ IS IT A WRAPPED LINE OR END OF PARAGRAPH?
	SZA CLA			/ SKIP IF: REGULAR LINE FEED
	JMP	WRAPHANDLER	/ IT'S WRAPPED OR E.O.P. - HANDLE IN SAME MANNER
	JMP	LFHANDLER	/ REGULAR LINE FEED

/ LOOKING FOR -1014 [START OF PRINTER CONTROL]
/ OR -1414 [END OF PRINTER CONTROL]

LPTCTRL,TAD	CHARIN		/ TEST FOR 'START OF PRINTER CONTROL'
	TAD	(-1014)
	SNA CLA
	JMP	SOPC		/ JMP BECAUSE 'START OF PRINTER CONTROL'
	TAD	RDFLAG
	SMA CLA
	JMP	ODGTST
	JMP	RD1EXIT
SOPC,
TILEND,	JMS	FLGTST
	JMS	ZRDNXCH		/ READ 1 CHARACTER FROM THE PROPER DOCUMENT
	  JMP I	RD1CHR		/ THIS 'JMP I' IF DISK EOF
	TAD	(-1414)		/ 'END OF PRINTER CONTROL' YET ?
	SZA CLA
	JMP	TILEND		/ KEEP LOOKING FOR 'END OF PRINTER CONTROL'
/\	JMP	ODGTST

/ IF THE CONTENTS OF PROGRAM LOCATION 'RDFLAG' =  +1
/  THEN THE OUTPUT DOCUMENT GENETATOR (ODG) IS IN CONTROL
/   THEREFORE 'SCROLL' THE CHARACTER TO THE OUTPUT DOCUMENT
/ ELSE JUST EXIT

ODGTST,	JMS	FLGTST		/ TEST THE CONTENTS OF 'RDFLAG'
	JMP	RDNEXT		/ 'JMP' TO READ THE NEXT CHARACTER

/ SUBROUTINE TO TEST THE CONTENTS OF PROGRAM LOCATION 'RDFLAG'

/  IF (RDFLAG) = +1 THEN 'SCROLL' THE CHARACTER TO THE OUTPUT DOCUMENT
/  IF (RDFLAG) = +2 THEN 'JMP NPCEXIT'

FLGTST,	XX
	TAD	RDFLAG
	SPA CLA			/					/m021
	JMP I	FLGTST		/ 'JMP I' BECAUSE AC IS MINUS
	AC7777			/ CHECK - IGNORE NOTHING EXCEPT RULERS IN/m021
				/ SPKRUL ROUTINE FOR ERROR TYPEOUT
	TAD	RDFLAG
	SZA CLA			/					/m021
	JMP	NPCEXIT		/ THE (RDFLAG) = +2
/ THE CONTENTS OF PROGRAM LOCATION 'RDFLAG' = +1
/  THEREFORE 'SCROLL' THE CHARACTER TO THE OUTPUT DOCUMENT
	TAD	CHARIN
	JMS	ODGSCROLL
	JMP I	FLGTST

/d021/ get a character from the 'xxsdfnbuffer' (located in field 4)		/a0011
/d021									/a0011
/d021TADISDFN,	XX	/						/a0011
/d021	CDFSDFN		/ CHANGE DATA FIELD TO FIELD #4			/a0011
/d021	TAD I	SDFN	/ GET THE CHARACTER FROM THE 'XXSDFNBUFFER'	/a0011
/d021	CDFMYF		/ CHANGE DATA FIELD BACK TO THIS FIELD		/a0011
/d021	JMP I	TADISDFN/ AND EXIT					/a0011

	PAGE

NOTLF,	IAC
	SNA CLA
	JMP	TABHANDLER	/ THE CHARACTER IS:: TAB (11)
ODGSKP,	TAD	CHR177
	TAD	(-16)	/ -16	/ Check for a start of ruler (16)	/m021
	SNA
	JMP	SKPRULER	/ THE CHARACTER IS:: START OF RULER (16)/m021
	IAC			/ Test for an End Dead character	/a021
	SNA			/ Is it End Dead (CR=15)?		/a021
	DCA	DEADKEY		/ Yes, zero the dead key sequence flag	/a021
	IAC		/ -14	/ Check for Form Feed (14)		/m021
	SNA CLA
	JMP	LPTCTRL		/ THE CHARACTER IS:: FORM FEED (14)	/m021
	JMP	ODGTST

END40,		IAC		/ +1
WRAPHANDLER,	IAC		/ +1
LFHANDLER,	IAC		/ +1
	JMP	IAC4

/ THE CONTENTS OF PROGRAM LOCATION 'CHARIN' = 11 WHICH IS A TAB
/ CONVERT THIS TAB TO A (2040) FOR OUTPUT VISUAL CONTINUITY

TABHANDLER,
	TAD	SFTSPC
	DCA	CHARIN
IAC4,	CMA
	DCA	FLAG40		/ -1, -2, -3, -4
	JMP	NPCEXIT		/ EXIT WITH THE CHARACTER IN THE AC

FLAG40,	ZBLOCK	1

SPHANDLER,			/ THE CHARACTER IS A SPACE (40) OR (2040)

	AC2000			/ TEST FOR THE SPACE TO BE (2040) 'JUSTIFYING'
	AND	CHARIN
	SNA CLA			/ SKIP NEXT IF A 'JUSTIFYING' SPACE (2040)
	JMP	NPCEXIT		/ EXIT 'RD1--CHAR' WITH THE AC=40

/ THE SPACE IS DEFINATELY A 'JUSTIFYING' (2040) SPACE

/ ... IS IT A [TAB] 'JUSTIFYING' SPACE ?

	TAD	FLAG40
	IAC
	SNA			/ SKIP NEXT IF (FLAG40) = '-1'
	JMP	NPCEXIT		/ EXIT 'RD1--CHAR' WITH THE AC=40

/ ... IS IT A 'JUSTIFYING SPACE' THAT FOLLOWS A NORMAL LINE FEED ?

	IAC
	SNA			/ SKIP NEXT IF (FLAG40) = '-2'
	JMP	SPHAN1		/ JUST IGNORE LEFT MARGIN JUSTIFY SPACES

/ ... IS IT A [WORD WRAP] OR [SOFT RETURN]

	IAC
	SNA			/ SKIP NEXT IF (FLAG40) = '-3'
	JMP	RDNEXT		/ IGNORE THE CHAR AND READ THE NEXT ONE

/ ... IS IT A [CENTERING] 'JUSTIFYING' SPACE ?

	IAC
	SNA CLA			/ SKIP NEXT IF (FLAG40) = '-4'
	JMP	NPCEXIT		/ EXIT 'RD1--CHAR' WITH THE AC=40

/ WE GOT HERE BECAUSE THE CONTENTS OF PROGRAM LOCATION (FLAG40) = 0

SPHAN1,	TAD	TOCTALJUSTIFY	/ JUSTIFYING SPACE COUNT
	SNA
	JMP	NPCEXIT		/ THE COUNT = 0 MEANS NO JUSTIFYING SPACES TO SKIP
	CIA			/ NEGATE IT
	DCA	T3
SPHAN2,	JMS	ZRDNXCH		/ READ NEXT CHARACTER
	  JMP	RD1EOF
	TAD	(-2040)		/ IS IT A SOFT SPACE?
	SZA CLA			/ SKIP NEXT IF A SOFT SPACE
	JMP	RDNOBUG		/ WE'VE FINISHED JUSTIFYING SPACES
				/  SO SEND THIS CHAR THROUGH REGULAR PROCESSING
	ISZ	T3		/ SOFT SPACE, COUNT OVERFLOW?
	JMP	SPHAN2		/ NO - GET THE NEXT CHARACTER UNTIL (T3) = 0
	JMP	END40		/ GO SETUP FLAG40 FOR NORMAL WORDWRAP SEQENCE

/++
/FUNCTIONAL DESCRIPTION:	SKPRUL - SKiP RULer
/
/	This routine will exam each ruler of the input document as it is
/	being read and calculate the proper number of left justify spaces to
/	ignore (due to the current left margin setting) while reading each
/	field name or value of a record.  It will save the left margin
/	justification value of the ruler just preceding the first record
/	in the list as this ruler is the default ruler for our output
/	document.  This routine also serves the purpose of ignoring all
/	rulers encounted during the typeout of an error message since the
/	characters that make up a ruler would appear as simply garbage to
/	the user.
/
/    SKPRUL PSUEDO CODE:
/
/	skprul: repeat
/10)		   if [not ignoring ruler for error typeout]
/		      go check for scrolling of character
/		   read ruler character
/15)		   if [character = "@ (forward ruler follows)]
/20)		      if [already entered record list]
/25)			 if [not in ODG]
/			    flag user - more than one ruler in list
/		      else
/30)			 clear octal value computed from previous ruler
/			 set flag (RULSEPDET) - ruler separator detected ("@)
/		   else
/40)		      if ["@ has been previously detected]
/45)			 get character
/			 if [left margin value character]
/55)			    compute it's octal value
/			 else
/60)			    reset ruler separator detected flag
/			    TOCTALJUSTIFY = TOCTALJUSTIFY - 1
/		   end if
/		if [first record in list not yet detected]
/		   set default OCTALJUSTIFY for ODG = TOCTALJUSTIFY
/65)		get character
/70)		until [character = end of ruler marker]
/75)		if [ignore ruler for error typeout]
/		   exit SKPRUL via RDNEXT (go read next character)
/		else
/		   exit SKPRUL via ODGTST (see if e.o.r. needs to be scrolled)
/
/CALLING SEQUENCE:	JMP	SKPRUL
/INPUT PARAMETERS:	none
/IMPLICIT INPUTS:	CHARIN, RULSEPDET, T2, OCTALJUSTIFY, TOCTALJUSTIFY,
/			SRBUGSWITCH, BORFLAG, RECNUM, P7700
/OUTPUT PARAMETERS:	none
/IMPLICIT OUTPUT:	RULSEPDET, OCTALJUSTIFY, T2, TOCTALJUSTIFY
/COMPLETION CODE:	none
/SIDE EFFECTS:		none
/--

SKPRUL,	TAD	SRBUGSWITCH	/ [10]	/ ignore ruler for error typeout?
	SNA CLA				/ skip: if so
	JMS	FLGTST			/ 'FLGTST' also 'SCROLLS' the (CHARIN)
	JMS	ZRDNXCH			/ read NEXT ruler character
	  JMP	RD1EOF			/ 'JMP' CAUSE DISK EOF

	TAD	P7700		/ [15]	/ (-100)is char. @ ?
	SZA CLA				/ skip if so
	JMP	SKPRU4			/ no it's not

	TAD	BORFLAG		/ [20]	
	TAD	RECNUM
	SNA CLA				/ SKIP NEXT IF 1ST '<' EVER DETECTED
	JMP	SKPRU3

	TAD	RDFLAG		/ [25]	
	SMA SZA CLA			/ skip if: not in ODG
	JMP	SKPRU7
	CIFIOA		/ -IOA-
	JMS I IOACAL
	  0				/
	  MULTIRULERERR			/
	  0705				/ ^P
	IFDEF CANADA <141>	/ IFDEF	/ ^Z ................................	/A004

SKPRU3,	DCA	TOCTALJUSTIFY	/ [30]	/ clear for new value
	ISZ	RULSEPDET		/ flag ruler forward/reverse separator detected
	JMP	SKPRU7

SKPRU4,	TAD	RULSEPDET	/ [40]	/ has @ been detected already?
	SNA CLA				/ skip if so
	JMP	SKPRU7

	TAD	CHARIN		/ [45]	/ get character back (IS IT AN ALPHA ?)
	TAD	P7700			/ (-100)is it a left margin value character?
	SMA CLA				/ skip if so
	JMP	SKPRU6			/ no - go reset RULSEPDET

	TAD	TOCTALJUSTIFY	/ [55]	
	CLL RTL
	RTL
	DCA	TOCTALJUSTIFY
	TAD	CHARIN
	AND	(17)			/ MAKE BCD
	JMP	SKPRU8

SKPRU6,	DCA	RULSEPDET	/ [60]	/ clear ruler separator detected flag
	AC7777
SKPRU8,	TAD	TOCTALJUSTIFY
	DCA	TOCTALJUSTIFY

	STL				/ LINK = 1
	TAD	BORFLAG			/ have we hit the first record yet?
	TAD	RECNUM
	SZA SNL CLA			/ skip: if not [SKIP IF EITHER OR AC=0, L=1]
	JMP	SKPRU7			/ yes - we've already got our default for ODG
	TAD	TOCTALJUSTIFY		/ save this left margin value for ODG default
	DCA	OCTALJUSTIFY

SKPRU7,	TAD	CHARIN		/ [70]	
	TAD	(-17)			/ end of ruler?
	SZA CLA				/ skip if so
	JMP	SKPRUL			/ go get next ruler character

	TAD	SRBUGSWITCH	/ [75]	/ ignore end of ruler for error typeout?
	SZA CLA				/ skip: if not
	JMP	RDNEXT			/ ignore e.o.r. for error typeout. get next char.
	JMP	ODGTST			/ back to normal processing

RULSEPDET,				/ 'RULER SEPERATOR DETECTOR'
	ZBLOCK	1			/ if <> 0 then the char. which separates forwrd
					/ and reverse ruler has been detected
OCTALJUSTIFY,
	ZBLOCK	1			/ holds octal number of justifying spaces that
					/ must be inserted pervious to the OUTPUT DOC-
					/ UMENT GENERATOR writing the first line of a
					/ record to the output document.
TOCTALJUSTIFY,
	ZBLOCK 1			/ holds octal number of justifying spaces that
					/ must be ignored as text while reading input
					/ document while in selector.
	PAGE

/ SUBROUTINE TO OUTPUT THE TIME TO THE SCREEN

TIMEOUT,XX
	CIFMNU
	JMS I	TIMCAL
	JMP I	TIMEOUT		/ RETURN THIS PC IF NO CHANGE
				/ RETURN THIS PC IF TIME CHANGED (NEXT SECOND)

/ . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
CNT27=INSERTJUST		/ NOTE THAT PROGRAM LOCATION 'INSERTJUST'
				/ IS USED AS A LOCAL COUNTER
/ . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .

	TAD	(-27)
	DCA	CNT27
	CDFMNU
	AC7777
	TAD I	(DATESP)
	CDFMYF
	DCA	X0
	TAD	(DATEST-1)
	DCA	X1
LOOP27,	CDFMNU
	TAD I	X0
	CDFMYF
	DCA I	X1
	ISZ	CNT27
	JMP	LOOP27

	CIFIOA		/ -IOA-
	JMS I	IOACAL
	  0			/
	  TDIO			/
	  0072			/ ^P
	  DATEST		/ ^A
	  1600			/ ^P
	JMP I	TIMEOUT

		/ 0072    / 1600
TDIO,	TEXT	'^P^A!L^P'

DATEST,	ZBLOCK	27

/++
/
/FUNCTIONAL DESCRIPTION:	INSERTJUST - INSERT JUSTification spaces
/
/	This routine will insert into the output document a given number of
/	justification spaces (as per OCTALJUSTIFY).
/
/    INSERTJUST PSEUDO CODE:
/
/	if [justification needed (OCTALJUSTIFY > 0)]
/	   set count to (1-OCTALJUSTIFY)
/	   repeat
/	      scroll justify-space to output document
/	      increment count
/	   until [count = 0]
/	return to caller
/
/CALLING SEQUENCE:	JMS	INSERTJUST
/INPUT PARAMETERS:	none
/IMPLICIT INPUTS:	OCTALJUSTIFY
/OUTPUT PARAMETERS:	none
/IMPLICIT OUTPUT:	T1
/COMPLETION CODE:	none
/SIDE EFFECTS:		none
/
/--

INSERTJUST,
	XX
	AC7776
	DCA	T2
JUSTAGAIN,
	TAD	(LF)
	JMS	ODGSCROLL
	TAD	OCTALJUSTIFY
	SNA
	JMP	NOJUSTIFY
	CIA
	DCA	T1
	TAD	(2040)
	JMS	ODGSCROLL
	ISZ	T1
	JMP	.-3
NOJUSTIFY,
	ISZ	T2
	JMP	JUSTAGAIN
/ ..............................................................................
	CIFSYS
	JSWAP			/ LET OTHER JOBS HAVE THE SPOT LIGHT
/ ..............................................................................
	JMP I	INSERTJUST

/....    ....    ....    ....    ....    ....    ....    ....    ....    ....
/    ....    ....    ....    ....    ....    ....    ....    ....    ....
/....    ....    ....    ....    ....    ....    ....    ....    ....    ....
/    ....    ....    ....    ....    ....    ....    ....    ....    ....

/ DONE

/ THE OUTPUT DOCUMENT GENERATOR
/  HAS TRANSFERRED THE ENTIRE CONTENTS
/   OF THE INPUT DOCUMENT TO THE OUTPUT DOCUMENT

ODGFINI,TAD	(207)		/ 'RULER' MODIFIED FLAG
	JMS	ODGSCROLL
	 CIFFIO								/M0006
	 FILEIO								/M0006
	 XDSKCL			/ CLOSES THE FILE OPENED BY XDSKIN
/	JMP I	ODG		/ EXIT THE OUTPUT DOCUMENT GENERATOR
	TAD	ODG
	DCA	.+2
	JMP I	.+1
	ZBLOCK	1

/....    ....    ....    ....    ....    ....    ....    ....    ....    ....
/    ....    ....    ....    ....    ....    ....    ....    ....    ....
/....    ....    ....    ....    ....    ....    ....    ....    ....    ....
/    ....    ....    ....    ....    ....    ....    ....    ....    ....

DCAVAR,	XX
	DCA	VARTMP
	AC7777
	TAD	FNVAR
	DCA	FNVAR
	TAD	VARTMP
	CDFFNV
	DCA I	FNVAR
	CDFMYF
	JMP I	DCAVAR

VARTMP,	ZBLOCK	1

/ SUBROUTINE TO PUSH 1 ELEMENT INTO THE FNV BUFFER

XFNVPSH,XX
	CDFFNV			/CHANGE DF TO THE 'EDITOR' FIELD
	DCA I	FNV		/ PUSH THE CONTENTS OF THE AC INTO THE FNV BUF
	CDFMYF			/  CHANGE DF BACK TO 'MY' FIELD
	JMP I	XFNVPSH		/   EXIT WITH THE AC = 0

/ --UPDATE-- THE 'PERFORMANCE' ATTRIBUTE WITHIN THE FNV BUFFER

NEWHHH,	XX
/	AC0000
	JMS	GETBNO
	TAD	PERFORMANCE
	CDFFNV
	DCA I	HHH1ST		/ REPLACE UPDATED 'PERFORMANCE' ATTRIBUTE
	CDFMYF
	JMP I	NEWHHH

HHH1ST,	FNVBUFFER+2		/ HOLDS ADDRESS POINTER INTO THE FNV TABLE
				/  FOR THE 1ST 'PERFORMANCE' ATTRIBUTE
				/   OF THE CURRENT RECORD

/ SUBROUTINE TO WAIT FOR THE USER TO TYPE A CHARACTER AT THE KEYBOARD	/A008
/ THIS ROUTINE IS ON THIS PAGE BECAUSE OF SPACE LIMITATIONS		/A008

GETCHR,	XX			/ GET CHARACTER FROM USER KEYBOARD	/A008
UNTILC,	CIFSYS			/ CHANGE TO SYS FIELD			/A008
	JSWAP			/ LET OTHER JOBS GET A CHANCE TO RUN	/A008
	JMS	TIMEOUT		/ OUTPUT THE TIME TO THE SCREEN		/A008
	CIFSYS			/ CHANGE TO SYS FIELD			/A008
	XLTIN			/ GO LOOK FOR A CHARACTER		/A008
	JMP	UNTILC		/ NONE STRUCK, GO WAIT SOME MORE	/A008
	JMP I	GETCHR		/ GOT IT, RETURN TO CALLER		/A008

	PAGE

/ SUBROUTINE TO TEST FOR THE 'GOLD' HALT FLAG
/
/	CALL:	JMS XXHLTFLG; RETURN PC (if no gold halt)
/
/ NOTE THAT THIS SUBROUTINE
/  IS CALLED FROM WITHIN 'ZRDNXCH'
/   WHICH IS USED BY EVERYONE ---EXCEPT--- THE MERGE
/    K E E P    I T    T H A T    W A Y
/ and from within 'WT1SCRATCH'
/  used --ONLY-- by the MERGE

XXHLTFLG,
	XX

/ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
/ THE FOLLOWING 3 INSTRUCTIONS HAVE NOTHING FUNCTIONAL TO DO WITH THE SORT
/ THEY ARE REQUIRED BECAUSE OF THE SYSTEM SHORT COMMINGS
/ AS A VECHICLE BY WHICH PRINTER ERRORS ARE REPORTED TO THE OPERATOR
	CIFPRT			/ TO THE 'PRINTER' FIELD
	JMS I	(FLABUZ)	/ FLASH AND BUZZ
	CLA
/ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +

	CDFSYS
	TAD I	HLTFLG
	CDFMYF
	SNA CLA
	JMP I	XXHLTFLG

/ IF THE MAIN-LINE CODE IS 'THE MERGE'
/  THEN OUTPUT THE MESSAGE ' - PLEASE WAIT'
/   BECAUSE WE'D HAVE A HELLUVA TIME TRYING TO CLEAN-UP
/    ANY SCRATCH BLOCKS ALLOCATED WITHIN THE MERGE

	TAD	MBUSY
	SNA CLA
	JMP	NOTMERGE
	CIFIOA		/ -IOA-
	JMS I	IOACAL
	  0			/
	  MSRWAIT		/
	  1220			/ ^P
	  1600			/ ^P
	JMP I	XXHLTFLG

/  THE USER AFTER TYPING  'GOLD HALT'  HAS THE OPTION TO:
/   PRESS 'RETURN' TO CONTINUE THE SR PACKAGE, OR
/    TYPE 'GOLD M' TO ABORT THE SR AND RETURN TO THE MAIN MENU

NOTMERGE,
	CIFIOA		/ -IOA-
	JMS I	IOACAL
	0
	MSRPAUSED
	1205			/ ^P
	2603			/ ^P
	2703			/ ^P
	JMS	SPDPRS
WAITMLOOP,
	JMS	WAITM		/ JMS TO WAIT FOR KEY 'GOLD M'
	JMP	TSTEDNWLN	/ RETURN TO THIS PC IF >not< GOLD M
/\	CIFIOA		/ -IOA-	/						/D009
/\	JMS I	IOACAL		/						/D009
/\	  0			/						/D009
/\	  MSRABORTED		/						/D009
/\	  1205			/ ^P						/D009
/\	IFDEF FRENCH <153>	/ ^Z ................................	/A002	/D009
/\	JMS	MRGEFRALL	/ DEALLOCATE ALL MERGE 'WORK' BLOCKS		/D009
	JMP	SRABORT		/ RETURN TO THIS PC IF 'GOLD M'

/ TEST FOR THE KEYBOARD INPUT 'NEW LINE' ALSO KNOWN AS KEY 'RETURN'

TSTEDNWLN,
	TAD	XLTINN		/ GET KEYBOARD INPUT
	TAD	(-EDNWLN)
	SZA CLA
/DEBUG	JMS	ODTIOA
	JMP	WAITMLOOP	/ REQUIRED WHEN 'JMS ODTIOA' IS COMMENTED OUT
	JMS	SRWORKING
	JMP I	XXHLTFLG

/ SUBROUTINE TO WAIT FOR A KEYBOARD INPUT:: GOLD M

/ CALL:	JMS WAITM; RETURN HERE IF >NOT< GOLD M; RETURN HERE IF GOLD M

WAITM,	XX
	JMS	GETCHR		/ GO GET A CHARACTER FROM THE USER	/A008
	DCA	XLTINN		/ SAVE CHARACTER FOR RETURN TEST	/M008
	TAD	XLTINN		/ RETRIEVE CHARACTER FOR GOLD MENU TEST	/M008
	TAD	(-EDMENU)	/ SUBTRACT VALUE FOR GOLD MENU		/M008
	SZA CLA			/ SKIP NEXT IF 'GOLD M'
	JMP	BEEP		/ BEEP IF NOT GOLD MENU			/C017
/ if the return pc is the address 'AOK'					/A009
/  then do not output the message 'aborted'				/A009
/   (or execute the 'jms mrgefrall')					/A009
/    because the 'jms' was already executed at address 'NOERRORS'	/A009
									/A009
	TAD	(-AOK)		/					/A009
	TAD	WAITM		/					/A009
	SNA CLA			/ SKIP NEXT IF RETURN PC IS not AOK	/A009
	JMP	CHKDSK		/					/A009
									/A009
	CIFIOA		/ -IOA-	/					/A009
	JMS I	IOACAL		/					/A009
	  0			/					/A009
	  MSRABORTED		/					/A009
	  1205			/ ^P					/A009
	IFDEF FRENCH <153>	/ ^Z ................................	/A002/A009
	JMS	MRGEFRALL	/ DEALLOCATE ALL MERGE 'WORK' BLOCKS	/A009
	JMP	CHKDSK		/					/A017

BEEP,	CIFIOA								/A017
	JMS I	IOACAL							/A017
		0							/A017
		ASCS		/ ASCII STRING				/A017
		BELASC		/ BELL ASCII STRING			/A017
	JMP I	WAITM		/ RETURN				/A017

ASCS,	TEXT	'^A'		/ ASCII SUBSTRING			/A017
BELASC,	7;0			/ BELL CODE WITH ZERO TERMINATOR	/A017

CHKDSK,	DCA	QDRV	/ 0	/ THE 'SYSTEM' IS ALWAYS DRIVE # 0
	TAD	(RXEDN)		/ 'GET DENSITY' COMMAND			/a0013
	DCA	QFNC		/ BECOMES FUNCTION CODE FOR QURX	/a0013
	JMS	QURX		/ AND EXECUTE THE 'GET DENSITY' COMMAND	/a0013
/ -----------------------------------------------------------------------------
/ . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
/ THIS IS THE ONLY (AND SHOULD BE THE ONLY)
/  REFERENCE WHERE DATA IS READ 'INTO'
/   THE 'OUTBLOCK' BUFFER

	AC0002			/ 'HOME' BLOCK DESIGNATION
	JMS	RD1BLOCK	/ READ THE HOME BLOCK OF THE SYSTEM DISKETTE
	  OUTBLOCK		/ INTO THE 'EDITOR' FIELD BUF ADDRESS 'OUTBLOCK'
/ . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
/ -----------------------------------------------------------------------------
/d0013	JMS	MGQDRV		/ RESET 'QDRV' TO THE OUTPUT DOCUMENT DRIVE #
	TAD	DSKID		/ 0YY NNN NNN NNN
	CDFEDT
	TAD	OUTBLOCK+5	/ SYSTEM DISKETTE ID WITHIN 'HOME' BLOCK
	CDFMYF
	AND	(777)
	SNA CLA
	JMP	GOLDM		/ JMP BECAUSE THE SYSTEM DISKETTE IS IN DRV #0
	CIFIOA		/ -IOA-	/
	JMS I	IOACAL		/
	  0			/
	  MREPLACE		/
	  2603			/ ^P
	CIFIOA		/ -ioa-	/					/a0013
	JMS I	IOACAL		/					/a0013
	  0			/					/a0013
	  MGOLD			/					/a0013
	  2703			/ ^P					/a0013
UNTILM,	JMS	GETCHR		/ GET A CHARACTER FROM THE USER		/A008
	TAD	(-EDMENU)	/ SUBTRACT VALUE FOR GOLD MENU		/A008
	SZA CLA			/ SKIP NEXT IF 'GOLD M'			/A008
	JMP	UNTILM		/ NOT GOLD MENU, GO GET NEXT CHARACTER	/A008
	JMP	CHKDSK		/ GO CHECK FOR THE CORRECT SYSTEM DISK	/A008

GOLDM,	ISZ	WAITM		/ POINT TO GOLD MENU RETURN LOCATION	/M008
	JMP I	WAITM		/ RETURN TO CALLER			/M008

XLTINN,	ZBLOCK	1		/ HOLDS THE KEYBOARD CHARACTER

/ SUBROUTINE TO OUTPUT 1 CHARACTER TO THE SCREEN
/  (enter with the ac = character)

TYPERD,	XX			/
	AND	P177		/ STRIP MODE BITS
	DCA	VTCHAR		/ save it for output via IOA
	CIFIOA		/ -IOA-	/
	JMS I	IOACAL		/
	  0			/
	  CA			/
	  VTCHAR		/ ^A - ADDRESS OF STRING
	JMP I	TYPERD		/
/
VTCHAR,	ZBLOCK	1		/ holds the ascii character for display
	0			/ this 0 is the ascii string terminator
CA,	TEXT	\^A\		/ this is the control string for IOA

/D011 / SUBROUTINE TO REPLACE THE 'CDF...' AND 'CIF...' [JMS] MAINLINE CODE
/D011 / WITH THE ACTUAL '6FFN' IOT
/D011
/D011 / THIS SUBROUTINE IS REQUIRED FOR MULTI-USER WPS-8 SYSTEMS
/D011
/D011 CDFCIF,	XX
/D011 	DCA	TAC		/ TEMPORARILY SAVE THE CONTENTS OF THE AC
/D011 	RAL
/D011 	DCA	TLINK		/ AND THE LINK
/D011 	RIF			/ 00F0: RIF GETS THE INSTRUCTION FIELD OF THIS PGM
/D011 	TAD	CDF0		/ 'TAD (CDF 0)'
/D011 	DCA	CNNCNN
/D011 CNNCNN,	.-.			/ 'CDF' SAME AS 'IF' OF THIS PROGRAM
/D011 	AC7776
/D011 	TAD	CDFCIF		/ TO GET THE ADRS OF THE ADRS OF THE MAIN LINE CALLER
/D011 	DCA	CNNCNN
/D011 	AC7777
/D011 	TAD I	CNNCNN		/ ADDRESS OF THE MAIN LINE CALLER
/D011 	DCA	CNNCNN
/D011 	RIF			/ 00F0:
/D011 	TAD I	CDFCIF		/ 'IF' 'ORED WITH CNN+USRFLX FOLLOWING JMS CIFCIF
/D011 	DCA I	CNNCNN		/ REPLACES THE MAINLINE JMS WITH THE IOT
/D011 	TAD	TLINK
/D011 	CLL RAR
/D011 	TAD	TAC
/D011 	JMP I	CNNCNN		/ JMP TO EXECUTE THAT IOT
/D011 TAC,	ZBLOCK	1		/ HOLDS THE AC FOR THE SUBROUTINE CDFCIF
/D011 TLINK,	ZBLOCK	1		/ HOLDS THE LINK FOR THE SUBROUTINE CDFCIF

	PAGE

/*****************************************************************************
/
/	The Field Name Buffer has been moved to field 4 and 		/a021
/	has been enlarged to enable it to accomodate up to 30		/a021
/	multinational and/or technical characters.			/a021
/
/*****************************************************************************

/ THE CONTENTS OF THE FN <FIELD NAME> BUFFER [LOADED VIA JMS RD1CHR]
/ REPRESENT AN ASCII <FIELD NAME> FROM A RECORD OF THE LIST DOCUMENT
/
/			ONE ASCII CHARACTER PER 12-BITS
/
/	FNBUFFER,       F
/			I
/			E
/			L
/			D
/			N
/			A
/			M
/			E
/			[0] FNBUFFER TERMINATOR

/d021	FNBUFFER,	ZBLOCK	KCCFNSIZE+1

/ -----------------------------------------
/ --THE FOLLOWING CODE IS ORDER IMPORTANT--
/ -----------------------------------------

/ 'KEY--FNTOTAL' COUNTERS ARE ORDER IMPORTANT
/   REPRESENTING 1 KEY <FIELD NAME> WITHIN A RECORD

/ SINGLE KEY SORT:	1 'KEY--FNTOTAL' COUNTER IS NEEDED:	KEY01FNTOTAL

/ 3 KEY SORT:		3 'KEY--FNTOTAL' COUNTERS ARE NEEDED:	KEY01FNTOTAL
/								KEY02FNTOTAL
/								KEY03FNTOTAL
/ N KEY SORT:		ETC.

KEY01FNTOTAL,	ZBLOCK 1
KEY02FNTOTAL,	ZBLOCK 1
KEY03FNTOTAL,	ZBLOCK 1
KEY04FNTOTAL,	ZBLOCK 1
KEY05FNTOTAL,	ZBLOCK 1
KEY06FNTOTAL,	ZBLOCK 1
KEY07FNTOTAL,	ZBLOCK 1
KEY08FNTOTAL,	ZBLOCK 1
KEY09FNTOTAL,	ZBLOCK 1
KEY10FNTOTAL,	ZBLOCK 1
KEY11FNTOTAL,	ZBLOCK 1
KEY12FNTOTAL,	ZBLOCK 1
/KEY13FNTOTAL,	ZBLOCK 1/ MUST EXPAND THE WORDS 'ORDER' AND 'FTYPE'
/KEY14FNTOTAL,	ZBLOCK 1
/KEY15FNTOTAL,	ZBLOCK 1/ MUST REDEFINE DATA STRUCTURE AND 'KKKK' WITHIN [VAT]

//////// KEEP GOING (REALISTICALLY NOW) UNTIL YOUR LITTLE HEART DESIRES ////////

MAXKEY=.-KEY01FNTOTAL	/ MAX # OF KEY <FIELD NAME>S TO SORT ON
			/ PERMITTED BY THIS PROGRAM

	-1		/ [-1] TERMINATOR				/m0013
			/  MAKING MULTI-KEY SORT [ UP TO NN KEYS ]
			/   INVISIBLE TO THIS PROGRAM
/ -----------------------------------------
/ --THE PREVIOUS CODE WAS ORDER IMPORTANT--
/ -----------------------------------------

/
/	ACCENTED CHARACTER PROCESSORS
/
/
/ THIS SERIES OF ROUTINES IS CURRENTLY USED TO CONVERT THE SINGLE AND
/ MULTI STROKE ACCENTED CHARACTERS PRESENT IN FOREIGN LANGUAGE SYSTEMS
/ TO A SINGLE CHARACTER TO BE USED IN THE SORT.
/
/ AT PRESENT, ANY ACCENTED CHARACTER IS TREATED AS IF IT HAD APPEARED
/ WITH NO ACCENT.  FOR EXAMPLE, AN ACCENT AGU 'A' WILL BE SORTED AS AN
/ 'A' WITH NO ACCENT.  THIS SCHEME MAY OR MAY NOT BE MODIFIED FOR FUTURE
/ RELEASES OF THE SOFTWARE.
/
/
/
/


/	DEAD KEY SEQUENCE PROCESSOR

DEAD,	JMS	ZRDNXCH		/ DEAL WITH DEAD KEY CHARACTERS IN THE	/A021
	JMP	RD1EOF		/ SORT COLLATING SEQUENCE.		/A021
	AND	P177		/ GET THE FIRST CHARACTER OF THE DEAD	/A021
	TAD	NEGSPC		/ SEQUENCE, MINUS MODE BITS, AND TEST	/A021
	SZA			/ IS IT A SPACE?			/A021
	JMP	DEDNRM		/ NO, IT IS A USER DEAD KEY SEQUENCE	/A021
	JMS	ZRDNXCH		/ YES, GET THE NEXT CHARACTER TO SEE	/A021
	JMP	RD1EOF		/ WHICH CHARACTER SET IT COMES FROM OR	/A021
				/ IF IT IS A HARD SPACE.		/A021
	AND	P177		/ GET THE CHARACTER WITHOUT MODE BITS	/A021
	TAD	NEGSPC		/ TEST FOR A HARD SPACE			/A021
	SNA			/ IS IT A HARD SPACE?			/A021
	JMP	DEDNRM		/ YES, OUTPUT SPACE			/A021
	TAD	DEDSPC		/ NO, GET CHARACTER BACK		/A021
	RAR			/ GET THE LSB INTO THE LINK		/A021
	SZL CLA			/ IS THIS A TECH OR LINE CHARACTER?	/A021
	JMP	DEADTL		/ YES, DEAL WITH IT			/A021
	JMS	ZRDNXCH		/ NO, GET THE MULTINATIONAL CHARACTER	/A021
	JMP	RD1EOF		/ CODE					/A021
	AND	P177		/ GET THE CODE SANS MODE BITS		/A021
/D023	RAL			/ DOUBLE IT				/A021
	TAD	(EQUTB)		/ ADD THE BASE ADDRESS OF THE EQUIVELENC/A021
	DCA	EQUTBA		/ TABLE IN PANEL AND SAVE IN THE PR3	/A021
	PR3			/ MAKE THE PANEL REQUEST TO GET THE	/A021
	5054			/ EQUIVELENCE CHARACTER		/M023	/A021
EQUTBA,	XX			/ ADDRESS IN EQUIVALENCE TABLE		/A021
	DCHAR1			/ THE EQUIVALENCE CHARACTER STORE	/A021
	-2			/ THE MINIMUM NO OF WORDS YOU CAN XFER	/A021
	-1			/ PR TERMINATOR				/A021
	JMP	DEDOUT		/ RETURN CHARACTER TO MAIN LOOP		/A021

DEADTL,	JMS	ZRDNXCH		/ GET THE TECHNICAL OR LINE DRAWING	/A021
	JMP	RD1EOF		/ CHARACTER				/A021
	DCA	DCHAR1		/ SAVE IT WHILE LOOKING FOR END DEAD	/A021
	JMP	DEDOUT

DEDNRM,	TAD	DEDSPC		/ RECONSTITUTE FIRST CHARACTER OF USER	/A021
	DCA	DCHAR1		/ DEAD KEY SEQUENCE			/A021

DEDOUT,	JMS	ZRDNXCH		/ GET A CHARACTER UNTIL END DEAD IS	/A021
	JMP	RD1EOF		/ SEEN.					/A021
	TAD	(-15)		/					/A021
	SZA CLA			/					/A021
	JMP	DEDOUT		/					/A021
	DCA	DEADKEY		/ ZERO THE DEAD KEY FLAG, AS END FOUND	/A022
SNGLXT,	TAD	DCHAR1		/ COPY THE CHARACTER TO THE RETURN	/A021
	DCA	CHARIN		/ RETURN VARIABLE			/A021
	TAD	DCHAR1		/ ALSO COPY INTO THE CHR177 VARIABLE	/A021
	AND	P177		/ AS THE MASKED VERSION			/A021
	DCA	CHR177		/					/A021
	JMP	RD1EXIT							/A021

//\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/

/	SINGLE ACCENTED CHARACTER PROCESSOR

SINGLE,	TAD	RDFLAG		/ CHECK MAINLINE CODE
	SMA SZA CLA		/ AC>0 MEANS 'ODG'
	JMP	RDNOB1		/ NO PROCESSING IF 'ODG'

	TAD	CHARIN		/ GET CHARACTER
	AND	(7600)		/ MASK OFF CHARACTER
	DCA	DCHAR1		/ SAVE MODE BITS

	TAD	CHARIN		/ GET CHARACTERS
	AND	P177		/ MASK OFF MODE BITS
	DCA	DCHAR2		/ SAVE CHARACTERS

	TAD	(TBL2)		/ GET TABLE ADDRESS
	DCA	DADDR1		/ SAVE IN TEMP POINTER


SNGLP1,	TAD I	DADDR1		/ GET TABLE ENTRY
	ISZ	DADDR1		/ INCREMENT POINTER
	SNA			/ CHECK FOR END OF TABLE
	JMP	RDNOB1		/ END OF TABLE DETECTED

	TAD	DCHAR2		/ CHECK FOR MATCH
	SNA CLA
	JMP	SINGL2		/ WE HAVE A MATCH

	ISZ	DADDR1		/ NO MATCH.  INCREMENT ADDRESS.
	JMP	SNGLP1		/ CONTINUE SEARCH


SINGL2,	TAD I	DADDR1		/ GET SUBSTITUTE CHARACTER
/D021	TAD	DCHAR1		/ RETRIEVE MODE BITS
/D021	DCA	CHARIN		/ SAVE NEW CHARACTER

/D021	JMP	RDNOB1		/ RETURN TO MAIN PROCESSING
	JMP	SNGLXT		/ EXIT VIA ROUTINE TO SAVE CHARS	/A021	

//\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/

/
/
/	TEMPORARY STORAGE
/
/

DCHAR1,	0			/ TEMP CHARACTER STORAGE
DCHAR2,	0			/ TEMP CHARACTER STORAGE

DADDR1,	0			/ TEMP ADDRESS POINTER
DEDSPC,	40			/ ASCII VALUE OF A SPACE		/A021
NEGSPC,	-40			/ NEGATIVE ASCII VALUE OF A SPACE	/A021
	EQUTB=SORTBL		/ COLLATING SEQUENCE EQUIVALENCE TABLE

//\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/

/
/
/	ACCENTED CHARACTER TABLES
/
/

TBL1,

IFDEF	ENGCAN	<

	-140			/ ACCENT GRAVE
	-136			/ CIRCUMFLEX
	-176			/ UMLAUT

	>

IFDEF	CANADA	<

	-140			/ ACCENT GRAVE
	-136			/ CIRCUMFLEX
	-176			/ UMLAUT

	>

IFDEF	FRENCH	<

	-136			/ ACCENT AGU
	-176			/ UMLAUT

	>


	0


TBL2,

IFDEF	ENGCAN	<

	-173;	141		/ AGU E

	>

IFDEF	CANADA	<

	-173;	141		/ AGU E

	>

IFDEF	FRENCH	<

	-100;	141		/ GRAVE A
	-173;	145		/ AGU E
	-174;	165		/ GRAVE U
	-175;	145		/ GRAVE E

	>

	0




PAGE


////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////	MERGE .PA	-	MULTI-KEY MERGE        		\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

/ MERGE SUBROUTINE
/  TO 'SET-UP' PARAMATERS FOR THE MERGE

MRGSETUP,
	XX
	TAD	(7401)		/ WPS-8 DOCUMENT BLOCK IDENTIFIER
	CDFEDT
	DCA I	(OUTBLOCK)	/   7401
	DCA I	(OUTBLOCK+1)	/   0
	CDFMYF
	DCA	FIRSTBLOCK	/   [0] MEANS NO SCRATCH CHAIN, YET
	JMP I	MRGSETUP

/ MERGE SUBROUTINE
/  TO SET THE DRIVE NUMBER WITHIN QURX:: 'QDRV'
/   IDENTICAL TO THE OUTPUT DOCUMENT DRIVE

MGQDRV,	XX
	TAD	SOTFL		/ DDDDNNNNNNNN
	AND	(7400)
	BSW
	CLL RTR
	DCA	QDRV
	JMP I	MGQDRV		/ EXIT QUQDRV

/ ALLOCATE (SETUP) THE 1ST BLOCK OF THE SCRATCH CHAIN; AND 'WTQBLK'

SETFIRSTBLOCK,
	XX
	JMS	QUXEAL		/ALLOCATE 1 SCRATCH BLOCK
	DCA	FIRSTBLOCK	/ TO BECOME THE 1ST IN A CHAIN OF SCRATCH BLOCKS
	TAD	FIRSTBLOCK
	DCA	WTQBLK		/ SETTING UP 'WTQBLK' WITH NEXT BLOCK # TO BE 'WRITTEN'
	JMP I	SETFIRSTBLOCK

FIRSTBLOCK,	ZBLOCK	1	/ 1ST BLOCK # OF THE SCRATCH CHAIN

SETINVLENGTH,	XX
	TAD	INVVAT		/					/m0013
	BSW
	AND	(VVVVV)
	CIA
	DCA	INVLENGTH
	TAD	(-4)
	TAD	INVLENGTH
	DCA	INLENGTH
	JMP I	SETINVLENGTH

/ ........................................
/THIS IS THE START OF THE MERGE; THEREFORE
/ ........................................

/ ENTRY TO HERE AFTER SORT HAS ORDERED THE FNVAR TABLE
/  BECAUSE THE FNV BUFFER - FNVAR TABLE VOLUME HAS FILLED-UP
/   OR AN INPUT DOCUMENT EOF OCCURED

MERGE,	XX			/ MERGE ENTRY PORT
	ISZ	MBUSY		/ [1] MEANS 'MERGE' IS THE MAIN-LINE
	TAD	(OUTBLOCK+HEADER)					/m0013
	DCA	OUTTOP		/ MAKES THE 'OUTBLOCK' BUFFER LOOK EMPTY
	TAD	(FNVARBUFFER+1)
	DCA	FNVAR		/ SET TO THE TOP OF THE (SORTED) RECORD POINTER LIST
	TAD	(INBLOCK)
	DCA	INFLADR		/ 'FLOATING' TOP ADDRESS OF 'INBLOCK' BUFF (SEE 'NEXTIN')

	JMS	MGQDRV		/ SET THE DRIVE # SAME AS OUTPUT DOC DRIVE #

/ FILL-OUT THE NEXT 4 WORDS WITHIN THE FNV BUFFER
/    BECAUSE 'ODG' LOOKS FOR THE CONTENTS OF 'VAT' = 0000
/     WHICH IS THE INTERNAL SIGNAL MEANING THE END OF THE FNV BUFFER

	DCAFNV			/ [0]
	DCAFNV			/ [0]
	DCAFNV			/ [0]
	DCAFNV			/ [0]

/ IF DISKETTE SCRATCH BLOCKS HAVE BEEN PREVIOUSLY ALLOCATED
/  (WHICH CONTAIN SORTED FNV BUFFER PACKETS)
/   THEN MERGE THE PRESENT CONTENTS OF THE FNV BUFFER
/    WITH THE SORTED FNV BUFFER PACKETS

	TAD	FIRSTBLOCK	/ 1ST BLOCK OF THE SCRATCH CHAIN
	SZA			/  SKIP NEXT MEANS [0] NO SCRATCH CHAIN YET
	JMP	MERGE2		/   MERGE THE FNV BUFFER WITH THE FNV PACKETS

/  WRITE-OUT THE CONTENTS
/   OF THE FNV BUFFER (AS PER THE SORTED ORDER OF THE FNVAR BUFFER)
/    INTO THE DISKETTE SCRATCH BLOCKS
/   WHICH WILL BE ALLOCATED AS NEEDED WITHIN 'WT1SCRATCH'

	JMS	SETFIRSTBLOCK	/ SET THE 1ST BLOCK OF THE SCRATCH CHAIN (AND 'WTQBLK')
/\	JMP	WTFNV		/ WRITE ALL (RECORDS) WITHIN THE FNV BUFFER		

/ ----------------
/ --END OF MERGE-- THE LOGICAL END OF THE INPUT BUFFER HAS BEEN FOUND
/ ----------------

/ WRITE-OUT THE CONTENTS OF THE FNV BUFFER IN THE SORTED ORDER OF THE FNVAR TABLE

/ THE DATA IS MOVED FROM THE FNVAR BUFFER TO THE OUTPUT BLOCK BUFFER
/  1 WORD AT A TIME VIA 'FXOUT'

WTFNV,	JMS	TADVAR	/ VTOP	/ GET A RECORD ADDRESS POINTER
ENDI,	JMS	WT1FNV
	JMP	.-2		/ UNTIL A 0 VAT FOUND
	JMS	FXOUT	/ 4-0'S
	ISZ	LENGTH
	JMP	.-2
	JMP	WTLASTOUT	/ WRITE THE FINAL (NOT NECESSARILY LAST) BLOCK

/ TRANSFER 1 RECORD'S WORTH OF DATA FROM THE FNV BUFFER TO THE OUTPUT BUFFER
/  (NOTE THAT THE POINTER TO THAT RECORD'S WORTH OF DATA WITHIN THE FNV BUFFER)
/   (WAS ALREADY POPPED FROM THE FNVAR TABLE WHICH MEANS THAT A 'JMS TADVAR')
/    (WAS EXECUTED SOME TIME PRIOR TO ENTERING 'WT1FNV')

/ JMS WT1FNV; RETURN HERE; BUT VAT=0 RETURNS HERE
WT1FNV,	XX
UNTIL0,	AC0003
	TAD	VTOP
	DCA	VVTOP
	JMS	GETVV	/ [VAT]
	DCA	WT1TMP	/ TEMP
	TAD	WT1TMP
	BSW
	AND	(VVVVV)
	CIA
	TAD	(-4)
	DCA	LENGTH	/ -VVVVV-4
	TAD	WT1TMP
	SNA CLA
	JMP	VAT0	/ VAT=0	/ EXIT IS TO RETURN+1
	JMS	FXOUT	/'QUXEAL'/ MOVE THE DATA FOR THIS RECORD
	ISZ	LENGTH		/  FROM THE FNV BUFFER TO THE OUTPUT BUFFER
	JMP	.-2		/   UNTIL ALL ELEMENTS MOVED
	TAD	WT1TMP
	AND	(MKSBIT)
	SZA CLA
	JMP	UNTIL0
	SKP
VAT0,	ISZ	WT1FNV	/RETURN+1
	JMP I	WT1FNV

WT1TMP,	ZBLOCK	1
LENGTH,	ZBLOCK	1

/ ----------------
/ --END OF MERGE-- THE LOGICAL END OF THE FNV BUFFER HAS BEEN FOUND
/ ----------------

IXOLOOP,JMS	INXOUT
ENDFNV,	TAD	INTOP
	TAD	PEIBLOCK	/ (-INBLOCK-400)
	SPA CLA			/ SKIP NEXT IF 'INPUT' BUFFER HAS BEEN EMPTIED
	JMP	IXOLOOP
	TAD	RDQBLK		/ GET NEXT BLOCK # TO BE 'READ'
/\	JMP	WTLASTOUT	/ AC = BLOCK # (NOT ZERO)

/ WRITE THE LAST SCRATCH BLOCK (COULD BE A PARTIAL BLOCK WITHIN THE CHAIN)
/  (NOTE THAT ENTRY WITH THE CONTENTS OF THE AC=0 MEANS AT THE END OF THE CHAIN)
/   (AND THAT WHEN THE AC IS NOT ZERO THAN WITHIN THE CHAIN)

WTLASTOUT,
	JMS	WT1SCRATCH	/ 'JMS' WITH (AC) = 0 MEANS --END OF CHAIN--
	DCA	MBUSY	/ [0]	/ CLEAR
	JMP I	MERGE

MBUSY,	ZBLOCK	1		/ =1 MEANS THE MAIN-LINE IS 'THE MERGE'

	PAGE

/ SCRATCH BLOCKS HAVE BEEN ALLOCATED
/  ON THE OUTPUT DOCUMENT DRIVE
/   THEREFORE [MERGE] THE CONTENTS OF THE FNV BUFFER
/    WITH THE CONTENTS OF THOSE SCRATCH BLOCKS
/     AS PER THE ORDER OF THE 'FNVAR' BUFFER

/ .............................................................................
/ 'NEXTIN' MUST BE THE ONLY GUY TO READ SCRATCH BLOCKS
/ .............................................................................

MERGE2,	DCA	RDQBLK			/ ENTERED WITH (AC) = 1ST BLOCK OF SCRATCH CHAIN
	JMS	SETFIRSTBLOCK	/'WTQBLK'/ 'JMS' MAKES A NEW ('1ST' BLOCK) SCRATCH CHAIN
/	TAD	(INBLOCK)	/ 'FYI'	/ (FOR YOUR INFORMATION)
/	DCA	INFLADR		/
	TAD	(INBLOCK)
	DCA	INTOP
	DCA	PEIOFFSET/ [0]	/					/m0013
	JMS	NEXTIN	/'RDQBLK'	/
NEWFNV,	JMS	TADVAR	/ SET 'VTOP'	/ FNVAR=FNVAR-1
NEWIN,	TAD	SORTKEY
	CIA
	DCA	XSORTKEY
	DCA	KEYID		/ 0
	TAD	ORDER
	JMP	.+3
NEWKEY,	TAD	SORTORDER
	CLL RAL
	DCA	SORTORDER
	ISZ	KEYID		/ 1; 14
/ .............................................................................
/ TO INCREASE THE PERFORMANCE OF A SINGLE KEY SORT ONLY::
/  IF THIS IS A SINGLE KEY SORT (THE CONTENTS OF 'SORTKEY' = 1)
/   THEN WE KNOW THE 'VAT' ADDRESS ALREADY
/    NO NEED TO 'KEYSEARCH'

	TAD	SORTKEY	/ 1; 14
	CLL RAR
	SZA CLA
	JMP	.+4		/ 'JMP' MEANS THIS IS A MULTI KEY SORT
	AC0003		/ [3]
	TAD	VTOP		/ (VTOP) PREVIOUSLY SET WITHIN 'TADVAR'
	JMP	.+3		/ 'JMP' TO 'DCA VVTOP'
	TAD	FNVAR
	JMS	KEYSEARCH	/ SEARCH FOR THE 'VAT' ADDRESS
	DCA	VVTOP		/ SAVE THE [VAT] SLOT ADDRESS WITHIN THE FNV FOR THIS KEY
/ .............................................................................
	JMS	GETVV	/ [VAT]
	SNA
	JMP	ENDFNV	/ [0]	/ ZERO [VAT] FOUND MEANS END IF FNV BUFFER
	BSW
	AND	(VVVVV)
	CIA
	DCA	VLENGTH	/ -VVVVV
/\	JMP	.+1

	TAD	INTOP
	DCA	INVTOP
SEARCH,	TAD	(3)
	TAD	INVTOP
	DCA	INVTOP
	JMS	GETINV	/ [VAT]
	SNA
	JMP	ENDI		/ END OF THE INPUT BUFFER FOUND [0 VAT]
	DCA	INVVAT		/					/m0013
	TAD	INVVAT		/					/m0013
	AND	(KKKK)
	CIA
	TAD	KEYID
	SNA CLA
	JMP	FOUND		/ KEY FOUND
	TAD	INVVAT		/					/m0013
	BSW
	AND	(VVVVV)
	SNA
	JMP	SEARCH	/ VVVVV=0
	CIA
	DCA	INVVAT		/					/m0013
	JMS	GETINV
	CLA
	ISZ	INVVAT		/					/m0013
	JMP	.-3
	JMP	SEARCH

INVVAT,	ZBLOCK	1		/					/m0013

FOUND,	JMS	SETINVLENGTH	/ SETUP 'INVLENGTH' (AND 'INLENGTH')
	TAD	VLENGTH
	TAD	INVLENGTH
	SNA CLA
	JMP	BOTH0		/ BOTH 'VVVVV'ALUES ARE NULL

	TAD	VLENGTH
	SNA CLA
	JMP	FNVWINS
	TAD	INVLENGTH
	SNA CLA
	JMP	INWINS
/\	JMP	VALCOMP

/ THE FNV VAT ELEMENT AND THE SCRATCH VAT ARE BOTH (+)
/  THEREFORE COMPARE THE 6-BIT VALUE CHARACTERS 2X2
/   AS 12-BIT WORDS
/    AND PUT THE WINNER TO THE 'OUT' BLOCK BUFFER

VALCOMP,JMS	GETVV		/ GET 1 ELEMENT FROM THE FNV BUFFER
	DCA	GETVV		/ SAVE IT USING 'GETV' AS TEMP STORAGE
	JMS	GETINV	/ [IN]	/ GET 1 ELEMENT FROM THE INPUT BUFFER
	CLL CIA
	TAD	GETVV	/ [FNV]
	SNA CLA
	JMP	.+4		/ BOTH 2X2 CHARACTERS ARE THE SAME
	SZL
	JMP	FNVWINS		/ 'FNV' BIGGER
	JMP	INWINS		/ 'IN' BIGGER

	ISZ	INVLENGTH	/ +1 TO THE INPUT 'V'ALUE COUNTER
	JMP	ISZVLENGTH	/

/ IN VALUE COUNTER OVERFLOW

	ISZ	VLENGTH		/ +1 TO THE FNV 'V'ALUE COUNTER
	JMP	FNVWINS		/ FNV HAS MORE TO GO SO IT'S THE WINNER

BOTH0,	ISZ	XSORTKEY
	JMP	NEWKEY
	JMP	INWINS

/ IN VALUE COUNTER DID NOT OVERFLOW

ISZVLENGTH,
	ISZ	VLENGTH		/ +1 TO THE FNV 'V'ALUE COUNTER
	JMP	VALCOMP		/ GET MORE 2X2 CHARACTERS

/ FNV VALUE COUNTER OVERFLOW

	JMP	INWINS		/ 'IN' HAS MORE DATA TO GO SO IT'S THE WINNER

VLENGTH,	ZBLOCK 1
INVLENGTH,	ZBLOCK 1
XSORTKEY,	ZBLOCK 1	/ THE NEGATIVE FROM 'SORTKEY'

	PAGE

/ TRANSFER THE RECORD ELEMENT WINNER
/  RESIDING WITHIN THE INPUT BUFFER
/   TO THE OUTPUT BUFFER

INWINS,	TAD	SORTORDER
	SMA CLA
	JMP	FNV2OUT
IN2OUT,	AC0003
	TAD	INTOP
	DCA	INVTOP
	JMS	GETINV	/ [VAT]
	DCA	INVVAT		/					m0013
	JMS	SETINVLENGTH	/ SETUP 'INLENGTH' (AND 'INVLENGTH')

IOLOOP,	TAD	INTOP
	TAD	PEIBLOCK
	SPA CLA
	JMP	JMSINXOUT
	TAD	(INBLOCK)
	DCA	INFLADR
	TAD	(INBLOCK)
	DCA	INTOP
	DCA	PEIOFFSET/ [0]	/					/m0013
	JMS	NEXTIN

JMSINXOUT,JMS	INXOUT	/ INTOP+1/ POP INPUT/PUSH OUTPUT
	ISZ	INLENGTH/-100;-4/ UNTIL (INLENGTH)=0
	JMP	IOLOOP		/ MEANS ALL KEYS FOR THAT RECORD MOVED

	TAD	INVVAT		/					/m0013
	AND	(MKSBIT)
	SNA CLA
	JMP	NEWIN
	JMP	IN2OUT		/ UNTIL 'VAT' MKS-BIT = 0

INLENGTH,	ZBLOCK 1

/ TRANSFER THE RECORD ELEMENT WINNER
/  RESIDING WITHIN THE FNV BUFFER
/   TO THE OUTPUT BUFFER

FNVWINS,TAD	SORTORDER
	SMA CLA
	JMP	IN2OUT
FNV2OUT,JMS	WT1FNV	/'FXOUT'/ (IMBEDDED 'JMP ENDFNV' WITHIN 'WT1FNV' IF VAT=0)
	JMP	NEWFNV		/ NORMAL RETURN FROM 'WT1FNV'
	JMP	ENDFNV	/ VAT=0	/ RETURN HERE WHEN THE VAT IS ZERO

/ POP AN ELEMENT FROM THE FNV BUFFER
/  AND PUSH IT INTO THE OUTPUT BLOCK BUFFER

FXOUT,	XX
	TAD	FXOUT
	DCA	INXOUT
	CDFFNV
	TAD I	VTOP
	ISZ	VTOP
	NOP
	JMP	XXXOUT

VTOP,	FNVBUFFER

/ POP AN ELEMENT FROM OF THE INPUT BLOCK BUFFER
/  AND PUSH IT INTO THE OUTPUT BLOCK BUFFER

INXOUT,	XX
	TAD	INTOP
	CIA
	TAD	INFLADR
	SZA CLA
	JMP	INXCDFEDT
	TAD	(HEADER)	/					/m0013
	TAD	INTOP
	DCA	INTOP
	AC7777
	TAD	INLENGTH
	DCA	INLENGTH
	JMP I	INXOUT
INXCDFEDT,
	CDFEDT
	TAD I	INTOP
	ISZ	INTOP
	SKP			/ 'SKP' IS FASTER THAN AN 'IOT'
XXXOUT,	CDFEDT
	DCA I	OUTTOP
	ISZ	OUTTOP
	CDFMYF
	TAD	OUTTOP
	TAD	(-OUTBLOCK-400)
	SPA CLA			/ SKIP NEXT IF 'OUTPUT' BUFFER FULL
	JMP I	INXOUT
	JMS	QUXEAL		/ ALLOCATE 1 DISK BLOCK
	JMS	WT1SCRATCH	/ OUTPUT BLOCK FILLED-UP
	JMP I	INXOUT

INTOP,	INBLOCK+HEADER		/					/m0013
OUTTOP,	OUTBLOCK+HEADER		/					/m0013

/ . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
/ INBLOCK, 7401				OUTBLOCK, 7401
/	   0					  0
/	   NEXT BNO   --CARRY-IT-OVER-->	  NEXT BNO	/ ALWAYS THE NEXT
/								/ BLOCK # TO READ
/	   [RESERVED]				  [RESERVED]
/
/	   DATA FROM READ			  DATA FOR WRITE
/ . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .

GETI2,	XX
	CDFEDT
	TAD I	(INBLOCK+2)
	CDFMYF
	JMP I	GETI2

GETI3,	XX
	CDFEDT
	TAD I	(INBLOCK+3)
	CDFMYF
	JMP I	GETI3

GETO2,	XX
	CDFEDT
	TAD I	(OUTBLOCK+2)
	CDFMYF
	JMP I	GETO2

PUTO2,	XX
	CDFEDT
	DCA I	(OUTBLOCK+2)
	CDFMYF
	JMP I	PUTO2

TADVAR,	XX
	AC7777
	TAD	FNVAR
	DCA	FNVAR		/ FNVARBUFFER, ..-1, ..-2, ..-3, ..ETC
	CDFFNV
	TAD I	FNVAR
	CDFMYF
	IAC
	DCA	VTOP
	JMP I	TADVAR

	PAGE

PEIBLOCK,-INBLOCK-400		/ (-#) FLOATING PHYSICAL END ADRS OF 'INBLOCK' BUFFER
SLOP=		KCCVALUE%2+4^MAXKEY&400
 IFZERO SLOP <SLOP=KCCVALUE%2+4^MAXKEY&377>
OUTBLOCK=	6400		/ OF THE 'EDITOR' FIELD
INBLOCK=	OUTBLOCK-400-SLOP/ OF THE 'EDITOR' FIELD
RDQBLK, ZBLOCK 1		/NEXT # TO BE READ

/ WE RAN OUT OF CHARACTERS FROM THE 'INBLOCK' BUFFER

NEXTIN,	XX
	TAD	RDQBLK		/GET THE BLOCK # TO BE READ
	JMS	RD1BLOCK	/ READ 1 SCRATCH BLOCK
INFLADR,  INBLOCK	/ FLOATS/  INTO MEMORY STARTING AT THE ADDRESS WITHIN 'INFLAD'
	TAD	RDQBLK
	JMS	QUXEFR		/ DEALLOCATE THE BLOCK JUST READ
	AC0002
	TAD	INFLADR
	DCA	T3		/ (INFLADR)+2
	CDFEDT
	TAD I	T3		/ 'NEXT' BLOCK # TO BE 'READ'
	DCA	RDQBLK		/ '--CARRY--IT--OVER-->'
	ISZ	T3		/ (INFLADR)+3
	TAD I	T3	/-400;-4/ NEGATIVE # OF 'VALAD' WORDS JUST READ
	CDFMYF
	TAD	PEIOFFSET/-400;0/ NEGATIVE OFFSET; ELSE 0; REMEMBER ?	/m0013
	TAD	(-INBLOCK)
	DCA	PEIBLOCK	/ '-INBLOCK-400-X'
	JMP I	NEXTIN

PUSHUP,	XX
	CDFEDT
UPLOOP,	TAD	T1
	TAD	PEIBLOCK
	SMA CLA
	JMP	.+6
	TAD I	T1
	DCA I	INFLADR
	ISZ	T1
	ISZ	INFLADR
	JMP	UPLOOP
	CDFMYF
	JMP I	PUSHUP

/ GET 1 ELEMENT FROM THE FNV BUFFER

GETVV,	XX
	CDFFNV
	TAD I	VVTOP
	CDFMYF
	ISZ	VVTOP
	NOP
	JMP I	GETVV

VVTOP,	FNVBUFFER+3

/ GET 1 ELEMENT FROM THE INPUT BUFFER

GETINV,	XX
INVLOOP,TAD	PEIBLOCK	/ (-INBLOCK-400)
	TAD	INVTOP
	SPA CLA
	JMP	TADINVTOP

/ THERE IS NO MORE DATA IN THE INPUT BUFFER TO GET VIA 'GETINV'
/  THEREFORE 'PUSHUP' ALL DATA BETWEEN (INTOP) AND (INVTOP)

	TAD	INTOP
	CIA
	TAD	INFLADR		/ (COULD BE '#INBLOCK')
	SNA
	JMP	MOVUP4		/ (INTOP) IS SAME AS (INFLADR)
	SPA CLA
	JMP	MOVTOP		/ (INTOP) IS GREATER THAN (INFLADR)

				/ (INTOP) IS LESS THAN (INFLADR)
	TAD	INFLADR
	TAD	(HEADER)/ [4]	/					/m0013
	DCA	T1
	JMS	PUSHUP		/ ... USING 'T1' ...
	TAD	(HEADER)/ [4]	/					/m0013
	TAD	PEIBLOCK
	DCA	PEIBLOCK
	TAD	(-HEADER)	/					/m0013
	TAD	INVTOP
	DCA	INVTOP
	SKP

MOVUP4,	TAD	(HEADER)	/					/m0013
MOVTOP,	TAD	INTOP
	DCA	T1
	TAD	T1
	CIA
	TAD	INVTOP
	TAD	(INBLOCK)
	DCA	INVTOP
	TAD	T1
	TAD	PEIBLOCK
	DCA	PEIOFFSET	/					/m0013
	TAD	(INBLOCK)
	DCA	INFLADR
	TAD	(INBLOCK)
	DCA	INTOP
	JMS	PUSHUP		/ ... USING 'T1' ...
	JMS	NEXTIN		/
	JMP	INVLOOP		/ BECAUSE (INVTOP) MAY STILL BE PAST (PEIBLOCK)

PEIOFFSET,
	ZBLOCK	1		/					/a0013

TADINVTOP,
	TAD	INVTOP
	CIA
	TAD	INFLADR
	SMA SZA
	JMP	INVCLA		/ (INVTOP) IS LESS THAN (INFLADR)
	SMA
	JMP	INVAC4		/ (INVTOP) IS SAME AS (INFLADR)
	TAD	(HEADER)	/					/m0013
	SPA SNA CLA
	JMP	INVCLA

/ (INVTOP) IS SAME AS (INFLADR) OR IS BETWEEN (INFLADR THRU INFLADR+header)

INVAC4,	TAD	(HEADER)/ [4]	/					/m0013
	TAD	INVTOP
	DCA	INVTOP
	JMP	INVLOOP
INVCLA,	CLA
	CDFEDT
	TAD I	INVTOP
	CDFMYF
	ISZ	INVTOP
	NOP
	JMP I	GETINV

INVTOP,	INBLOCK+HEADER+3	/ THE SAME AS (INTOP)+3			/m0013

/*****************************************************************************
/
/	Code here is inserted to access the new FNBUFFER, which now	/a021
/	resides in FIELD 4.  This has been moved to provide enough	/a021
/	room for upto 30 multinational or technical characters in the	/a021
/	field name.							/a021
/
/****************************************************************************

XFNBPSH,XX			/ Routine to put a character in FNBUFFER/a021
				/ at the address given in FN		/a021
	CDFFNB			/ Change to the FNBUFFER field		/a021
	DCA I	FN		/ Save the value via FN			/a021
	CDFMYF			/ Change back to my field		/a021
	JMP I	XFNBPSH		/ Return				/a021

XFNBGET,XX			/ Routine to get a character from the	/a021
				/ FNBUFFER at the address given in FN	/a021
	CDFFNB			/ Change to the FNBUFFER field		/a021
	TAD I	FN		/ Add the value pointed to by FN to AC	/a021
	CDFMYF			/ Change back to my field		/a021
	JMP I	XFNBGET		/ Return				/a021

	PAGE

HEADER=	4								/m0013

/ ...........................................................................
	/0	OUTBLOCK,	7401
	/1			0
	/2			NEXT BLOCK #
	/3			-# ('VALAD' VOLUME)
	/4			DATA
	/5			DATA
	/THRU 255 WORDS
/ ...........................................................................

/ WRITE 1 SCRATCH BLOCK

/  CALL::	AC????; JMS WT1SCRATCH

/ ENTER WITH THE CONTENTS OF THE (AC) = NEXT BLOCK # OF CHAIN, WHILE
/  THE CONTENTS OF PROGRAM LOCATION 'WTQBLK' = 'THIS' BLOCK # TO BE WRITTEN

WT1SCRATCH,
	XX
	JMS	PUTO2		/ NEW NEXT BLOCK (OF THE CHAIN)

/ CALCULATE THE USED VOLUME OF THE OUTPUT BUFFER
/  (INCLUDING THE 4 HEADER WORDS)
/   AND PLACE THAT N-E-G-A-T-E-D VALUE INTO 'OUTBLOCK+3'

	TAD	OUTTOP
	CIA
	TAD	(OUTBLOCK)
	CDFEDT
	DCA I	(OUTBLOCK+3)
	TAD	.-2		/ 'CDFEDT'
	CDFMYF
	DCA	QBFD		/ THE DATA ('EDITOR') FIELD OF THE DATA
	TAD	(OUTBLOCK)
	DCA	QBAD		/ TOP ADDRESS WITHIN THAT ('EDITOR') FIELD
	TAD	WTQBLK
	DCA	QBLK		/ THE BLOCK # TO BE WRITTEN WITH THAT DATA
	JMS	QUXEWT
	TAD	(OUTBLOCK+HEADER)					/m0013
	DCA	OUTTOP		/ (MAKES THE OUTPUT BLOCK BUFFER LOOK EMPTY)
	JMS	GETO2
	DCA	WTQBLK		/ THE NEXT BLOCK # TO BE WRITTEN

/ . . . . . . . . . . . . . . . . . . . . . . . . . .
	JMS	TIMEOUT		/ OUTPUT THE TIME TO THE SCREEN
	JMS	XXHLTFLG	/ TEST FOR 'GOLD HALT'
/ . . . . . . . . . . . . . . . . . . . . . . . . . .

	JMP I	WT1SCRATCH

WTQBLK,	ZBLOCK	1		/ PRESERVES THE BLOCK # TO BE WRITTEN 'NEXT'

/ MERGE SUBROUTINE
/  TO DEALLOCATE ALL BLOCKS ALLOCATED

/ ... THE DRIVE # MUST ALREADY BE SET WITHIN QDRV

MRGEFRALL,
	XX
FREEALL,TAD	FIRSTBLOCK	/ FIRST TIME EVER IS FIRST BLOCK OF THE SCRATCH CHAIN
	SNA
	JMP I	MRGEFRALL	/ 0 MEANS ALREADY FREED-UP THE LAST BLOCK ALLOCATED
	JMS	FREE1
	JMP	FREEALL		/ UNTIL ALL BLOCKS ALLOCATED HAVE BEEN FREED-UP

/ SUBROUTINE TO DEALLOCATE (FREE-UP) 1 DISKETTE SCRATCH BLOCK

/  ENTER WITH THE (AC) = BLOCK # TO DEALLOCATE AFTER THE READ IS COMPLETE

FREE1,	XX
	JMS	RD1BLOCK	/ 'READ' THE BLOCK (TO GET NEXT BLOCK # OF CHAIN)
	  INBLOCK		/   INTO A BUFFER CALLED 'INBLOCK' (OF 'EDITOR' FIELD)
	TAD	QBLK
	JMS	QUXEFR		/ 'OFFICALLY' DEALLOCATE VIA 'QURX::'
	JMS	GETI2		/ GET NEXT BLOCK # WITHIN CHAIN (0 MEANS NO MORE)
	SNA
	JMS	QUXERT		/ REWRITE' ALLOCATION BLOCK
	DCA	FIRSTBLOCK	/ AND MAKE IT THE NEW FIRST BLOCK OF THE CHAIN
	JMP I	FREE1


////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////	QURX  .PA	-	 SUBROUTINES TO QUEUE RXHAN	\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

/       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
/	!!!!!!!!                    !!!!!!!!
/	!!!!!!!!        QURX        !!!!!!!!
/	!!!!!!!!                    !!!!!!!!
/       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

QURX,	XX
	CIFSYS
	 ENQUE
	  QUBLK
QURXJWAIT,
	CIFSYS
	 JWAIT
	CLA
	TAD	QUQBLK+RXQCOD
	SNA CLA			/ CHANGE 'SNA CLA' TO 'SNA' WHEN DOING 'FNC+4000'
	JMP	QURXJWAIT

/ EXIT WITH THE (AC) MINUS MEANS A DISK ERROR WAS DETECTED BY THE DISK HARDWARE
/ [EXITING WITH THE (AC) MINUS WAS MADE POSSIBLE BY THE FUNCTION+4000]

/ EXIT WITH THE (AC) POS MEANS THE QURX COMPLETED SUCCESSFULLY

	JMP I	QURX

/	------------------------------------
/	--------  ORDER  IMPORTANT  --------
/	------------------------------------
QUBLK,	DSKQUE; 0; 0
QUQBLK,
QCOD,	0			/ R	ECCCCCCCCCCC:	COMPLETETION CODE
QFNC,	0			/ W	FFFFFFFFFFFF:	FUNCTION TO DO::

/ +2000 WITH A PHYSICAL OR	/ +4000 WITH ANY FUNCTION
/	LOGICAL WRITE 		/	MEANS THAT RXHAN WILL
/	MEANS THAT AFTER THE	/	RETURN PROGRAM CONTROL
/	FUNCTION IS COMPLETED	/	TO THE CALLING PROGRAM
/	RXHAN WILL ISSUE A	/	INSTEAD OF THE OPERATING SYSTEM
/	HARDWARE READ OF THE	/	UPON THE DETECTION
/	BLOCK JUST WRITTEN.	/	OF A DISK ERROR.
/				/
/	THE DATA OF THAT	/	THE CALLING PROGRAM WILL
/	BLOCK WILL BE READ	/	PROCESS THE ERROR.
/	INTO THE HARDWARE	/
/	SCRATCH PAD MEMORY.	/

    / RXERT=	0		/	:: RESET DIR AND ALLOC MEMORY BLOCK
    / RXEPR=	RXERT+1		/	:: PHYSICAL READ
    / RXEPW=	RXEPR+1		/	:: PHYSICAL WRITE
    / RXERD=	RXEPW+1		/	:: LOGICAL READ
    / RXEWT=	RXERD+1		/	:: LOGICAL WRITE
    / RXEAL=	RXEWT+1		/	:: ALLOCATE A BLOCK
    / RXEFR=	RXEAL+1		/	:: DEALLOCATE A BLOCK
    / RXEGF=	RXEFR+1		/	:: GET BLOCK # OF THE FIRST BLOCK [THE HDR]
				/	   FOR THE FILE # WITHIN QFNO
    / RXESF=	RXEGF+1		/	:: SET BLOCKNO TO FIRST BLOCK
    / RXESP=	RXESF+1		/	:: GET # OF FREE BLOCKS ON DISKETTE

QDN1,	0			/			DRIVE NAME WORD #1
QDN2,	0			/			DRIVE NAME WORD #2
QFNO,	0			/ R/W	0000NNNNNNNN:	FILE #
QID1,	0			/			PLASTIC ID
QSPC,	0			/ R	00##########:	# FREE BLOCKS ON DISKETTE
QCTL,	0			/			CONTROLLER BITS FOR PATCHING COMMANDS
QDRV,	0			/ W	MMMMMMMMDDDD:	MODE BITS FOR LCD; DRIVE #
QBLK,	0			/ R/W			BLOCK #
QRS1,	0			/*			RESERVED
QBAD,	0			/ W	AAAAAAAAAAAA:	ADDRESS OF READ/WRITE BUFFER
QBFD,	0			/ W	62F1:		CDF TO THE FIELD
				/			OF THE ADDRESS
				/			OF THE READ/WRITE BUFFER
				/			WITHIN QBAD
QTRK,	0			/			TRACK #
QSEC,	0			/			SECTOR #
/	-------------------------------------
/	-------- END ORDER IMPORTANT --------
/	-------------------------------------


/ QURX SUBROUTINE TO RESET ALLOCATION OR DIRECTORY BLOCK
/ ...THE DRIVE # MUST ALREADY BE SET WITHIN QDRV
/ EXIT WITH AC = 0

QUXERT,	XX
/	TAD	KRXERT
	DCA	QFNC		/ 0
	JMS	QURX
	JMP I	QUXERT

/ QURX SUBROUTINE TO GET THE # OF FREE BLOCKS REMAINING ON THE DISKETTE
/ ...THE DRIVE # MUST ALREADY BE SET WITHIN QDRV
/ EXIT WITH THE CONTENTS OF THE AC = THE NUMBER OF FREE BLOCK REMAINING

/ - HARDWARE ERROR WHILE TRYING TO GET AVAILABLE DISKETTE SPACE COULD OCCUR

QUXESP,	XX
	TAD	KRXESP		/ FUNCTION
	DCA	QFNC		/ INTO QUBLK
	JMS	QURX		/ JMS TO EXECUTE THE FUNCTION
	TAD	QSPC		/ GET THE # OF FREE BLOCK REMAINING
	JMP I	QUXESP		/ EXIT QUXESP

/ QURX SUBROUTINE TO DEALLOCATE 1 DISKETTE BLOCK

/ ENTERED WITH THE CONTENTS OF THE AC = THE BLOCK # TO BE DEALLOCATED
/ ...THE DRIVE # MUST BE ALREADY SET WITHIN QDRV
/ - HARDWARE ERROR WHILE TRYING TO DEALLOCATE 1 BLOCK COULD OCCUR

QUXEFR,	XX
	DCA	QBLK
/	TAD	KRXEFR
	AC0006
	DCA	QFNC
	JMS	QURX		/ JMS TO EXECUTE THE FUNCTION
	JMP I	QUXEFR		/ EXIT QUXEFR

/ QURX SUBROUTINE TO ALLOCATE 1 DISKETTE BLOCK
/ ...THE DRIVE # MUST BE ALREADY SET WITHIN QDRV
/ EXIT WITH THE CONTENTS OF THE AC = BLOCK # ALLOCATED

/ - HARDWARE ERROR WHILE TRYING TO ALLOCATE 1 BLOCK COULD OCCUR

QUXEAL,	XX
	TAD	KRXEAL
	DCA	QFNC
	JMS	QURX
	TAD	QBLK		/ BLOCK # ALLOCATED
	SNA			/					/a0014
	JMP	E13CKW		/ OUTPUT DISK/VOL FULL - CK WHICH ONE	/A018
/D018	JMP	E13	/error	/ OUTPUT DISKETTE FULL (no more blocks)	/a0014
	JMP I	QUXEAL		/ EXIT

/ QURX SUBROUTINE TO EXECUTE A LOGICAL READ OF 1 BLOCK

/ ...THE BLOCK # MUST ALREADY BE SET WITHIN QBLK
/ ...THE READ BUFFER ADDRESS MUST ALREADY BE SET WITHIN QBAD
/ ...THE DATA FIELD OF THAT READ BUFFER MUST ALREADY BE SET WITHIN QBFD
/ ...THE DRIVE # MUST BE ALREADY SET WITHIN QDRV

QUXERD,	XX
	TAD	QUXERD
	DCA	QUXEWT
/	TAD	KRXERD		/ LOGICAL READ FUNCTION
	AC0003
	JMP	QURDWT

/ QURX SUBROUTINE TO EXECUTE A LOGICAL WRITE OF 1 DISKETTE BLOCK

/ ...THE BLOCK # MUST ALREADY BE SET WITHIN QBLK
/ ...THE WRITE BUFFER ADDRESS MUST ALREADY BE SET WITHIN QBAD
/ ...THE DATA FIELD OF THAT WRITE BUFFER MUST ALREADY BE SET WITHIN QBFD
/ ...THE DRIVE # MUST BE ALREADY SET WITHIN QDRV

/ * - HARDWARE ERRORS COULD OCCUR ON THE DISK READ OR WRITE

QUXEWT,	XX
	TAD	KRXEWT		/ LOGICAL WRITE FUNCTION + 2000
QURDWT,	DCA	QFNC
	JMS	QURX		/ EXECUTE THE FUNCTION: KRXEWT(2004); KRXERD(3)
	JMP I	QUXEWT		/ EXIT QUEWT OR QUERD

/KRXERT,	RXERT		/ 0
KRXESP,	RXESP
/KRXEFR,	RXEFR		/ 6
KRXEAL,	RXEAL
/KRXERD,	RXERD		/ 3
KRXEWT,	RXEWT+2000

/ SUBROUTINE TO READ 1 DISKETTE BLOCK

/    TAD (BLOCK#); JMS RD1BLOCK; BUFFER; RETURN PC

RD1BLOCK,
	XX

/ ENTER WITH THE CONTENTS OF THE AC = TO THE BLOCK # TO BE READ

/*THE DRIVE NUMBER MUST ALREADY BE WITHIN QDRV

/ PC+1 IS THE BUFFER ADDRESS (ALWAYS IN THE 'EDITOR' FIELD)
/ PC+2 IS THE RETURN ADDRESS

	DCA	QBLK		/ BLOCK #
	TAD I	RD1BLOCK
	ISZ	RD1BLOCK
	DCA	QBAD		/ BUFFER ADDRESS
	CDFEDT
	TAD	.-1
	CDFMYF
	DCA	QBFD		/ BUFFER DATA FIELD (ALWAYS 'EDITOR' FIELD)
	JMS	QUXERD
	JMP I	RD1BLOCK

	PAGE

////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////	ODG   .PA	-	OUTPUT DOCUMENT GENERATOR	\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

/	**********************************************************************

/	*								     *
/	* NOTES: 1) INSERTJUST routine resides in SELECTOR due to lack of    *
/	*	   space IN ODG.					     *
/	**********************************************************************


/ 	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
/	!!!!!!!!                           !!!!!!!!
/	!!!!!!!! OUTPUT DOCUMENT GENERATOR !!!!!!!!
/	!!!!!!!!                           !!!!!!!!
/ 	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
/ LOGICAL READ ONE FNV BUFFER PACKET BLOCK
/  AND DEALLOCATE THAT BLOCK
/   THEN RANDOM READ THE INPUT DOCUMENT
/    STARTING AT THE BLOCK # AND CHARACTER OFFSET
/     SPECIFIED WITHIN THAT FNV BUFFER PACKET BLOCK CONTROL WORDS
/ OPEN THE OUTPUT DOCUMENT # DEFINED WITHIN PROGRAM LOCATION 'SOTFL'
/  FOR [TOP], [BOTTOM], OR [OVERWRITE] 'SCROLL'ING

ODG,	XX
/--	DCA	ODGCOUNT	/ 'OUTPUT' RECORD COUNTER
	TAD	FIRSTBLOCK	/ 1ST BLOCK OF A CHAIN OF SCRATCH BLOCKS
	JMS	FREE1		/ READ THE 1ST SCRATCH BLOCK OF THE CHAIN
	TAD	(INBLOCK+HEADER)					/m0013
	DCA	T1ODG
	TAD	SOTFL		/ OUTPUT DOCUMENT NAME & DRIVE
	  MQL			/ INTO THE MQL FOR 'XDSKIN'
	TAD	DSKID		/    0QQ DNN NNN NNN
	AND	K7000		/  QQ = (0) TOP, (1) BOT, (11) OVERWRITE
	CLL RAL			/    QQ0 000 000 000
	SNA
	JMP	.+4		/    'TOP'
	SMA CLA
	AC7776			/    'BOT'
	CMA			/    'OVR'
	  CIFFIO							/M0006
	  FILEIO							/M0006
	  XDSKIN		/ WANTS MQ; THEN AC (0) TOP, (1) BOT, (-1) OVERWRITE
/ OPEN THE INPUT DOCUMENT # DEFINED WITHIN PROGRAM LOCATION 'SLSTFL'
	TAD	SLSTFL		/ INPUT DOCUMENT NAME & DRIVE
	JMS	RDINIT		/ % RANDRD INITIALIZATION
/ TRANSFER ALL CHARACTERS TO THE OUTPUT DOCUMENT
/  FROM THE BEGINNING OF THE INPUT DOCUMENT
/   UNTIL THE FIRST '<' OF THE FIRST <FIELD NAME> IS DETECTED

ODGRD1,	AC0001
	JMS	ODGRDCHAR	/ READ 1 CHARACTER FROM THE INPUT DOCUMENT
	  JMP	E8		/*...UNEXPECTED DISK EOF
	  SKP			/ ...NON-PRINTING CHAR RETURNS HERE
	  JMP	ODGLAB		/ ... < RETURNS HERE
K7000,	  NOP			/ ... > RETURNS HERE
				/ ...12-BIT CHARACTER RETURNS HERE

/ BLINDLY 'SCROLL' ALL 12-BIT DATA
/  FROM THE BEGINNING OF THE INPUT DOCUMENT
/   UNTIL THE FIRST '<' IS DETECTED

	JMS	ODGSCROLL
	JMP	ODGRD1

/ ODG SUBROUTINE TO TRANSFER THE:
/  BLOCK #, CHARACTER OFFSET, PERFORMANCE (HHH), AND VAT
/   FROM THE 'INBLOCK' BUFFER TO INDIVIDUAL HOLDING LOCATIONS
/    FOR 'PUTBNO'

ODGPOP,	XX
	JMS	ODGFNV
	DCA	ODGBNO		/ SAVE THE BLOCK #
	JMS	ODGFNV
	DCA	ODGOFF		/ SAVE THE CHARACTER BYTE OFFSET
	JMS	ODGFNV
	DCA	ODGHHH		/ SAVE THE PERFORMANCE ACCELERATOR ATTRIBUTE
	JMS	ODGFNV		/ GET THE 'VAT' WHICH SHOULD NEVER = 0000
	SNA			/    XVV VVV SMK KKK
	JMP	ODGFINI		/ VAT=0000 MEANS AT END OF FNV TABLE

/ MOVE THE POINTER T1ODG OVER THE 'VALUE' CHARACTERS
/  WHICH WERE BROUGHT ALONG WITH THE READING OF THE BLOCK
/   BUT WHICH ARE NOT NEEDED HERE
/    [THEY WERE NEEDED ONLY FOR THE SORT AND EARLY PACKET MERGES]

	DCA	ODGVAT		/ TEMP SAVE THE WHOLE 'VAT'
	TAD	ODGVAT
	BSW			/      SMKKKK XVVVVV
	AND	(VVVVV)		/      000000 0VVVVV
	SNA
	JMP	ODGV0
	CIA
	DCA	T1
	JMS	ODGFNV
	CLA
	ISZ	T1
	JMP	.-3

/*E8 - MEANS ERROR FROM WITHIN 'PUTBNO' ROUTINE

ODGV0,	JMS	PUTBNO		/ SETUP RANDOM READ ATTRIBUTES:
ODGBNO,	ZBLOCK	1		/ ...BLOCK #
ODGOFF,	ZBLOCK	1		/ ...CHARACTER BYTE OFFSET
ODGHHH,	ZBLOCK	1		/ ...PERFORMANCE ATTRIBUTE
	  JMP	E8		/ SHOW ANY ERROR AS UNEXPECTED END OF FILE
	JMP I	ODGPOP

ODGVAT,	ZBLOCK	1		/ HOLDS THE WHOLE 'VAT': XVV VVV SMK KKK

/ A LEFT ANGLE BRACKET HAS BEEN FOUND
/  SIGNIFYING THE FIRST <FIELD NAME> OF THE FIRST RECORD
/   WHILE BLINDLY 'SCROLL'ING ALL 12-BIT DATA
/     FROM THE INPUT DOCUMENT TO THE OUTPUT DOCUMENT

ODGLAB,	CLA			/ CLA BECAUSE AC = '<' ASCII CODE
ODGNEXT,JMS	ODGPOP		/ GET THE:: BLOCK #, C-OFFSET, HHH, AND VAT

/  TRANSFER THE CONTENTS OF ONE RECORD
/   BETWEEN THE '<' AND THE '<>'
/    FROM THE INPUT DOCUMENT TO THE OUTPUT DOCUMENT

/*E8 - MEANS UNEXPECTED DISK END OF FILE (OUT OF DATA)

ODGRDNXCH,
	AC0001
	JMS	ODGRDCHAR
	  JMP	E8		/*...UNEXPECTED DISK EOF
	  JMP	.+3		/ ...NON-PRINTING CHAR RETURNS HERE
	  JMP	.+4		/ ... < RETURNS HERE
	  JMP	ODGRAB		/ ... > RETURNS HERE
	  JMS	ODGSCROLL	/ ... 12-BIT DATA: MMMMMCCCCCCC RETURNS HERE
	JMP	.+3		/ EACH CHAR (EXCEPT '<') CLEARS ODGFLAG
	JMS	ODGSCROLL	/ SCROLL THE '<' LEFT ANGLE BRACKET
	AC7777
	DCA	ODGFLAG		/ 0-MEANS WAITING FOR '<'; -1 MEANS FOUND IT
	JMP	ODGRDNXCH	/ UNTIL '<>' DETECTED

/ RIGHT ANGLE BRACKET '>' FOUND

/ IF THE CONTENTS OF PROGRAM LOCATION ODGFLAG = -1
/  THEN THIS '>' MEANS AN END OF RECORD DIAMOND '<>'
/   ELSE IT IS JUST A <FIELD NAME> DELIMITER

ODGRAB,	JMS	ODGSCROLL	/ SCROLL THE '>' TO THE OUTPUT DOCUMENT
	ISZ	ODGFLAG		/ SKIP NEXT IF (ODGFLAG) GOES TO 0
	JMP	ODGRDNXCH	/ JUST <FN> DELIMITER; MORE DATA IN RECORD TO MOVE
	JMS	INSERTJUST	/ INSERT 'RULER JUSTIFYING' SPACES

/ 'JMS TIMEOUT' DOESN'T EXECUTE WHEN 'ODGCOUNT' GOES TO ZERO - THAT'S O.K.

	ISZ	ODGCOUNT	/ OUTPUT TO THE SCREEN: 'RECORDS REPRODUCED: X'
	JMS	TIMEOUT		/ OUTPUT THE TIME TO THE SCREEN
	CIFIOA
	JMS I	IOACAL
	0
	MODG
	1005			/ ^P
ODGCOUNT,ZBLOCK	1		/ ^D
	1600			/ ^P


/\	JMP	.+1

/ WHEN THE RECORD HAS MULTIPLE KEYS (AND MULTIPLE ATTRIBUTES)
/  THE OUTPUT DOCUMENT GENERATOR TRANSFERS THE ENTIRE RECORD
/   USING THE FIRST BLOCK #, C-OFFSET, HHH, AND VAT ONLY (SKIPPING THE OTHERS)

	TAD	ODGVAT		/ GET THE WHOLE 'VAT': XVVVVVSMKKKK
	AND	(MKSBIT)	/  TEST THE MULTI-KEY SORT BIT (MKSBIT)
	SNA CLA			/   SKIP NEXT IF PART OF MULTI-KEY ATTRIBUTES
	JMP	ODGNEXT		/    JMP MEANS AT END OF MULTI-KEY RECORD
	JMS	ODGPOP		/     UNTIL A 'VAT' WITH 'MKSBIT' = 0 IS FOUND
	JMP	.-5		/ UNTIL 'MKSBIT' WITHIN THE 'VAT' = 0

ODGFLAG,ZBLOCK	1		/ 0 MEANS WAITING FOR >; -1 FOUND IT
T1ODG,	INBLOCK			/

/ ODG SUBROUTINE
/  TO GET THE NEXT VALUE FROM THE ELEMENT TABLE
/   POINTED TO BY THE ADDRESS WITHIN T1ODG

/  IF A 'TAD I T1ODG' EXAUSTS THE DATA WITHIN THE BUFFER
/   THEN READ AND DEALLOCATE (FREE-UP) ANOTHER SCRATCH BLOCK OF THE CHAIN

ODGFNV,	XX
	JMS	GETI3
	TAD	(-INBLOCK)
	TAD	T1ODG		/GET ADDRESS POINTER INTO THE FNV BUFFER
	SPA CLA			/  SKIP NEXT IF AT END OF 'INBLOCK' BUFFER LIMIT
	JMP	.+6		/   JMP CAUSE STILL WITHIN BUFFER ADDRESS LIMITS
	TAD	(INBLOCK+HEADER)					/m0013
	DCA	T1ODG		/      RESET WITH TOP OF 'INBLOCK' PHYSICAL ADDRESS
	JMS	GETI2
	JMS	FREE1		/ 'READ' 1 SCRATCH BLOCK THEN FREE IT UP
	JMP	ODGFNV+1
	CDFEDT
	TAD I	T1ODG		/EXIT 'ODGFNV' WITH THE (AC) = TO THE VALUE OF:
	CDFMYF			/ .......
	ISZ	T1ODG		/  .......
	JMP I	ODGFNV		/   'BLOCK #', 'OFFSET', 'PERFORMANCE', OR 'VAT'

/--	/ DONE
/--	
/--	/ THE OUTPUT DOCUMENT GENERATOR
/--	/  HAS TRANSFERRED THE ENTIRE CONTENTS
/--	/   OF THE INPUT DOCUMENT TO THE OUTPUT DOCUMENT
/--	
/--	ODGFINI,TAD	(207)		/ 'RULER' MODIFIED FLAG
/--		JMS	ODGSCROLL
/--		 CIFFIO
/--		 FILEIO
/--		 XDSKCL			/ CLOSES THE FILE OPENED BY XDSKIN
/--		JMP I	ODG		/ EXIT THE OUTPUT DOCUMENT GENERATOR
/--	

/ ODG SUBROUTINE
/  TO OUTPUT 1 CHARACTER TO THE OUTPUT DOCUMENT
/   VIA 'SCROLL' CROSS FIELD SYSTEM CALL

ODGSCROLL,
	XX
	CIFFIO								/M0006
	FILEIO								/M0006
	XPUTST
	JMP I	ODGSCROLL

	PAGE

/RANDR2.PA - RANDOM ACCESS DISKETTE READ
/
/++
/TITLE:		RANDR2.PA
/
/FACILITY:	WPS - 8
/
/ABSTRACT:	RANDR2 is used to random access read a WPS diskette
/		by the WPS SORT routine.  It is a modified copy of RDFILP.PA.
/
/ENVIRONMENT:	WPS278
/
/AUTHOR:	Joe Famularo WPD, CREATION DATE:	12/15/80
/		Pete Smith   WPD
/
/--
/
/Definitions:
/
	SCHCNT= 774 		/ BYTES PER BLOCK
	BOFSET= 2 		/ BYTE OFFSET IN BLOCK
/
	SCBKOF= 52 		/ OFFSET TO FIRST BLOCK PTR IN HEADER 1
/
	GETBY1=T1RR		/ FOR USE IN RDGTBY ROUTINE
/
	HO1354=1354		/ HEADER OFFSET OF EXTENTION HEADER 3	/A012
/
/ The following buffers reside in USER FIELD 1 (physical field 3)
/
	RDBUF=7000		/ read data buffer
/
	HEADBF=RDBUF+400	/ header block buffer			/M017
	HDBLEN=400		/ length of header block buffer (HEADBF) /M017
				/ in words
/
/

/*****************************************************************************
/  DESCRIPTION:	RDINIT
/
/	OPENS A FILE FOR READING.
/
/  INPUTS:	AC CONTAINS THE FILENAME
/
/  OUTPUTS:
/

/
RDINIT,	XX
	DCA	T1RR 		/ SAVE THE FILE NAME
	TAD	T1RR 		/ RECOVER IT
	AND	P377 		/ GET THE FILE NUMBER
	DCA	RDFQBK+RXQFNO 	/ WRITE THE FILE NUMBER
/
	TAD	T1RR 		/ RECOVER THE FILE NAME
	BSW
	RTR
	AND	(17) 		/ GET THE DRIVE NUMBER
	DCA	RDFQBK+RXQDRV 	/ WRITE THE DRIVE NUMBER
/
/	THIS CALL WILL DEPOSIT THE BLOCK NUMBER OF OUR FILE'S HEADER BLOCK
/	INTO RDFQBK+RXQBLK
/
	JMS	RDFIO
	RXEGF+4000
	HEADBF								/M017
/
	SMA CLA 		/ A NEGATIVE RETURN INDICATES AN ERROR
	TAD	RDFQBK+RXQBLK 	/ GET THE HEADER BLOCK NUMBER
RDINI2,	JMS	RDINI1 		/ INITITIALIZE SOME VARIABLES
/
	JMS	RDGETR 		/ GET THE FIRST HEADER EXTENSION
	DCA	RDHDRB+1 	/ SAVE ITS BLOCK NUMBER
/
	AC0001
	JMS	RDGETR 		/ GET THE SECOND HEADER EXTENSION
	DCA	RDHDRB+2 	/ SAVE ITS BLOCK NUMBER
/
	JMS	GETHDREXT	/ GET 3RD & 4TH HEADER EXTENTIONS	/A012
/
	JMP I	RDINIT 		/ AND RETURN

/*****************************************************************************
/  DESCRIPTION:	RDINI1
/
/	INITIALIZES A FEW VARIABLES FOR READING A FILE.
/
/  INPUTS:	AC = BLK # OF THE FILE'S HDR CTRL BLK, OR 0 IF NOT FOUND
/  OUTPUTS:
/
RDINI1,	XX
	DCA	RDHDRB 		/ SET HEADER BLOCK NUMBER
	AC7777
	DCA	RDCHNO 		/ INITIALIZE THE COUNT OF NUMBER OF CHARACTERS LEFT
				/ IN THE BUFFER
	AC7777
	DCA	HDRTNO 		/ INITIALIZE THE COUNT OF NUMBER OF BLOCK NUMBERS
				/ LEFT IN HEADER BLOCK BUFFER (HEADBF)	/M017
	TAD	(SCBKOF) 	/ INITIALIZE THE OFFSET OF THE FIRST BLOCK NUMBER
				/ IN THE HEADER BLOCK
	DCA	HDROFF
	DCA	RDMOD 		/ CLEAR THE MODE VALUES (USED IN SIX BIT TRANSLATION)
	DCA	RDMOD+1
	DCA	RDHDBN		/ SHOW HEADBF EMPTY OF A HEADER BLOCK	/M017
	DCA	LBLKLD		/ INIT LAST BLOCK LOADED LOCATION
	JMP I	RDINI1 		/ AND RETURN
/
/
/

/
/*****************************************************************************
/  DESCRIPTION:	RDNXCB
/
/	RETURNS THE NEXT BYTE FROM THE FILE
/
/  INPUTS:
/
/  OUTPUTS:
/

RDNXCB,	XX			/*** THIS IS AN EXTERNALLY DEFINED ENTRY POINT
/
RDNXC1,	CLA
	ISZ	RDCHNO 		/ INCREMENT THE NEGATIVE CHARACTER COUNT
	JMP	RDNXC3 		/ JUMP IF THERE ARE ANY CHARACTERS LEFT IN THE BUFFER
/
	ISZ	HDROFF 		/ INCREMENT THE OFFSET INTO HEADER BLOCK
	SKP
	JMP I	RDNXCB		/ TO SIMULATE EOF FOR SINGLE BLOCK READ
/
	TAD	HDROFF		/ HAS THE OFFSET BEEN INCREMENTED INTO	/A012
				/  HEADER EXTENTION POINTERS IN		/A012
				/  EXTENTION HEADER BLOCK 2?		/A012
	TAD	(-HO1354						/A012
	SZA CLA			/ SKIP IF: SO				/A012
	JMP	RDNXC4							/A012
	TAD	(HO1354+16	/ OFFSET HDROFF OVER THE POINTERS TO	/A012
				/  THE FIRST DATA BLOCK POINTER IN	/A012
				/  HEADER EXTENTION BLOCK 3.		/A012
	DCA	HDROFF							/A012
	JMP	RDNXC5							/A012
/
RDNXC4,	ISZ	HDRTNO 		/ ANY BLOCK NUMBERS LEFT IN HEADBF?	/M017
	JMP	RDNXC2 		/ SKIP IF SOME ARE LEFT
/
/	THERE ARE NO BLOCK NUMBERS IN HEADBF.  FILL THE BUFFER UP.	/M017
/
RDNXC5,	JMS	LDHDRB 		/ LOAD HEADER BLOCK BUFFER		/M012
	JMP I	RDNXCB		/ ERROR RETURN AC = 0
/
/	THERE ARE NO CHARACTERS.  READ THE NEXT BLOCK INTO THE BUFFER.
/
RDNXC2,	TAD	(-SCHCNT) 	/ RESET THE CHARACTER COUNT
	DCA	RDCHNO
	JMS	RDFBUF 		/ FILL THE BUFFER
	JMP I	RDNXCB 		/ ERROR OR EOF RETURN
/
/	NOW, READ THE NEXT BYTE FROM THE BUFFER
/
RDNXC3,	TAD	RDCHNO 		/ GET THE CHARACTER COUNT
	TAD	(SCHCNT) 	/ SUBTRACT FROM THE END OF THE BUFFER
	JMS	RDGTBY 		/ GET THE NEXT BYTE FROM THE BUFFER
	RDBUF+BOFSET
/
	SNA 			/ IS THE VALUE A NULL?
	JMP	RDNXC1 		/ JUMP TO GET A NEW ONE IF SO
	JMP I	RDNXCB 		/ ELSE, RETURN THE VALUE

/*****************************************************************************
/  DESCRIPTION:	RDFBUF
/
/	READS THE NEXT BLOCK INTO RDBUF
/
/  INPUTS:	IMPLICIT:  HDRPTR = BLK # TO BE READ
/
/  OUTPUTS:	AC = NEGATIVE IF AN ERROR WAS ENCOUNTERED
/		AC = POSITIVE IF OK
/
/		AT EOF
/		AC = 0, RDCHNO = 0

RDFBUF,	XX
	ISZ	HDRPTR 		/ INCREMENT THE POINTER INTO HEADER BLOCK BUFFER
	TAD	LBLKLD		/ GET NEGATIVE NUMBER OF THE LAST BLOCK LOADED
	CDFEDT			/ change df to user field 1 (physical field 3)
	TAD I	HDRPTR		/ GET THE NUMBER OF THE BLOCK WE WANT TO LOAD
	SNA CLA			/ ARE THEY THE SAME?
	JMP	RDFBL3		/ YES - DON'T BOTHER TO LOAD IT AGAIN
	TAD I	HDRPTR 		/ RECOVER THE NEXT BLOCK NUMBER
	SNA 			/ IS THERE ANOTHER BLOCK NUMBER?
	JMP	RDFBL1 		/ JUMP IF THERE ARE NO MORE
/
	CDFMYF			/ change df back to my field
	JMS	RDFIO 		/ READ THE NEXT BLOCK INTO RDBUF
	RXERD+4000
	RDBUF
/
	SPA CLA 		/ WAS THERE AN ERROR?
	JMP	RDFBL2 		/ JUMP IF SO
	CDFEDT			/ change df to user field 1 (physical field 3)
	TAD I	HDRPTR		/ GET BLOCK NUMBER OF THE BLOCK WE JUST LOADED
	CIA			/ MAKE IT NEGATIVE
	DCA	LBLKLD		/ SAVE IT
RDFBL3,	ISZ	RDFBUF 		/ MAKE A SKIP RETURN TO SHOW ALL IS WELL
	SKP
RDFBL1,	DCA	RDCHNO 		/ CLEAR CHARACTER COUNT TO SIGNAL EOF
	CDFMYF			/ change df back to my field
	JMP I	RDFBUF 		/ AND RETURN
/
/	THERE WAS AN ERROR READING A BLOCK.
/
RDFBL2,	JMS	RDINI1 		/ REINITIALIZE TO PREVENT READS
	JMP I	RDFBUF
/
LBLKLD,	0			/ NEGATIVE BLOCK NUMBER OF LAST BLOCK LOADED INTO RDBUFD
/
/
HDRPTR,	0 			/ POINTER INTO THE HEADER BLOCK BUFFER
HDROFF,	0 			/ OFFSET INTO HEADER BLOCK OF NEXT BLOCK NUMBER
HDRTNO,	0 			/ NUMBER OF ENTRIES LEFT IN HEADBF	/M017
RDMOD,	0 			/ MODES FOR DECODING 6-BIT
	0 			/ MODE SHIFT (40)/UNSHIFT (0)
RDCHNO,	0 			/ CHARACTER COUNT FOR RDBUF
/
/
	PAGE

/
/*****************************************************************************
/  DESCRIPTION:	RDNXC
/
/	RETURNS THE NEXT CHARACTER FROM THE FILE IN 6-BIT
/
/  INPUTS:
/  OUTPUTS:
/
RDNXC,	XX
	JMS	RDNXCB 		/ GET THE NEXT BYTE FROM THE FILE
	TAD	(-77) 		/ IS IT AN ESCAPE?
	SNA
	JMP	RDNXCX 		/ JUMP IF SO
	TAD	P77 		/ ELSE RESTORE THE CHARACTER
	JMP I	RDNXC 		/ AND RETURN IT
RDNXCX,	JMS	RDNXCB 		/ GET ANOTHER BYTE
	SMA SZA
	TAD	P7700 		/ SHOW IT IS AN ESCAPE CHARACTER
	JMP I	RDNXC 		/ AND RETURN IT
/
/
/

/
/++
/			GETHDREXT					/A012
/
/FUNTIONAL DESCRIPTION:	GET_HEADER_EXTENTIONS
/
/	THIS ROUTINE WILL LOAD THE ADDITIONAL HEADER BLOCK EXTENTION ADDRESSES
/	WHICH ARE USED BY A DOCUMENT THAT EXCEEDS 704 BLOCKS WHEN OPERATING IN
/	RX02 DOUBLE DENSITY, INTO THE RDHDRB BUFFER.  IT IS IMPORTANT TO NOTE
/	THAT AT THIS TIME GETHDREXT IS SET UP TO GO NO FURTHER THAN THE 4TH
/	HEADER EXTENTION SINCE THIS PROVIDES THE MAXIMUM NUMBER OF BLOCKS
/	POSSIBLE FOR RX02 DOUBLE DENSITY DOCUMENT FLOPPY.  IF RL BASED SYSTEM
/	IS DEVELOPED THAN THIS WILL NECESSITATE SLIGHT CHANGES TO GETHDREXT AS
/	WELL AS FURTHER MODIFICATIONS TO RANDR2.
/
/CALLING SEQUENCE:	JMS	GETHDREXT
/
/INPUT PARAMETERS:	AC = 0
/
/IMPLICIT INPUT:	RDHDRB+2, GETHD1
/
/OUTPUT PARAMETERS:	AC = 0
/
/IMPLICIT OUTPUT:	GETHD4, GETHD1, GETHD2
/
/COMPLETION CODE:	NONE
/SIDE EFFECTS:		NONE
/
/--
/
GETHDREXT,		/ ROUTINE TO GET HEADER BLOCK EXTENSIONS
	XX
	TAD	RDHDRB+2	/ IS THERE A 2ND HEADER EXTENTION?
	SNA CLA			/ SKIP IF: SO
	JMP	GETHD6		/  ELSE RETURN
/
	TAD	(RDHDRB+3	/ GET PTR TO 3RD HDR EXT IN RANDRD CTL BLK
	DCA	GETHD4		/ SAVE FOR AUTOINDEXING
/
	TAD	(HO1354		/ GET HEADER OFFSET OF EXT HEADER 3 POINTER
				/  (EXT HDR 2 [362])
	DCA	GETHD1		/
/
/
/***************************************************************************
/********************** YOUR ATTENTION PLEASE ******************************
/***************************************************************************
/ NUMBER OF POSSIBLE HEADERS MUST BE CHANGED FOR RL'S.  LOOP CONTROL IS
/ SET FOR -3 SO IF HEADER THAT IS BEYOND THE LIMITS OF AN RX02 (DOUBLE
/ DENSITY) DISKETTE IS CALLED WE'LL TERMINATE RDHDRB BUFFER AND RETURN.
/ THE MAXIMUM NUMBER OF BLOCKS ON A DOUBLE DENSITY FLOPPY IS 983. THIS MEANS
/ THAT THE MAXIMUM NUMBER OF HEADER BLOCKS NEEDED FOR A SINGLE DOCUMENT
/ WOULD BE THE MAIN HEADER BLOCK + 4 EXTENTION HEADERS.  RANDR2 ROUTINE WILL
/ NEED MODIFIICATION TO HANDLE ADDITIONAL HEADER BLOCKS BEYOND THE 4TH
/ EXTENTION HEADER WHICH MAY BE NEEDED FOR VERY LARGE DOCUMENTS ON AN RL.
/***************************************************************************
/***************************************************************************
/***************************************************************************

	AC7775			/ GET ITERATION COUNT FOR EXT HDRS 3 & 4
	DCA	GETHD2		/ SAVE THE COUNT

/**************************************************************************
/**************************************************************************
/**************************************************************************
/
GETHD3,	TAD	GETHD1		/ GET 3RD & 4TH EXT HDR BLK NUMS
	JMS	RDGETR
	SNA			/ SKIP IF: BLOCK NUMBER PRESENT
	JMP	GETHD5		/  ELSE ALL DONE
	DCA I	GETHD4		/ PUT BLK NBR INTO RDHDRB+X
/
	ISZ	GETHD1		/ POINT TO NEXT HDR BLK NBR
	ISZ	GETHD4		/ INC POINTER INTO RDHDRB BUFFER
	ISZ	GETHD2		/ EXCEEDED RX02 DOUBLE DENSITY EXTENTION
				/  HEADER LIMIT?
	JMP	GETHD3		/ NO- GO GET IT IF ITS THERE
/
GETHD5,	DCA I	GETHD4		/ TERMINATE RDHDRB BUFFER
GETHD6,	JMP I	GETHDREXT	/ RETURN
/
GETHD1,	0			/ POINTER TO HDR BLK NBRS IN HEADER EXT 2
GETHD2,	0			/ COUNTER FOR LOOP CONTROL
GETHD4,	0			/ POINTER INTO RDHDRB BUFFER
/
/
/

/
/****************************************************************************
/ DESCRIPTION: RDGTBY
/
/	Returns either the upper or lower byte
/	in RDBUF for conversion to seven bit ASCII.
/
/ INPUT:	AC = character count of RDBUF
/
/ OUTPUT:	6 bit COS-310 character
/
RDGTBY,	XX
	CLL RAR 		/ IF LINK = 0 GET UPPER BYTE
				/ IF LINK = 1 GET LOWER BYTE
/
	TAD I	RDGTBY 		/ GET RDBUF+OFFSET
	DCA	GETBY1
	ISZ	RDGTBY 		/ BUMP RETURN
	CDFEDT			/ change df to user field 1 (physical field 3)
	TAD I	GETBY1
	CDFMYF			/ change df back to my field
	SNL
	BSW 			/ SWAP BYTES IF UPPER BYTE NEEDED
	AND	P77
	JMP I	RDGTBY
/
	PAGE
/

/ MOVED RDGTBY								/M012
/***************************************************************************
/DESCRIPTION:	RDFIO
/
/	Submits diskette read to queue.
/
RDFIO,	XX
	DCA	RDFQBK+RXQBLK 	/ STORE BLOCK NUMBER
	TAD I	RDFIO 		/ GET FUNCTION CODE FROM CALLER
	DCA	RDFQBK+RXQFNC 	/ DEPOSIT IN QUEUE BLOCK
	ISZ	RDFIO 		/ BUMP TO RETURN ADDRESS
	TAD I	RDFIO		/ GET WHICH BUFFER ARE TO READ DATA INTO
	DCA	RDFQBK+RXQBAD	/ DEPOSIT IN QUEUE BLOCK
	ISZ	RDFIO
	CDFEDT			/ change df to user field 1 (physical field 3)
	TAD	.-1		/ get cdf instruction
	CDFMYF			/ change df back to my field
	DCA	RDFQBK+RXQBFD 	/ DEPOSIT IN QUEUE BLOCK
	CIFSYS 			/
	ENQUE 			/ SUBMIT TO QUEUE
	RDFQB 			/ 	PASSED PARAMETER
RDFIO1,	CIFSYS 			/ NOW
	JWAIT 			/ 	WAIT TIL DONE
	TAD	RDFQBK+RXQCOD 	/ DONE YET?
	SNA 			/ YES
	JMP	RDFIO1 		/ NO
	JMP I	RDFIO 		/ RETURN STATUS (AC = MINUS ON ERROR)
/
/*****************************************************************************
/  QUEUE REQUEST BLOCK
/
RDFQB,	DSKQUE
	0
	0 			/ QUEUE HEADER
RDFQBK,	0 			/ +RXQCOD	HANDLER STATUS (0 = NOT DONE)
	0 			/ +RXQFNC	RX FUNCTION REQUEST
	0 			/ +
	0 			/ +RXQFNO	FILE NUMBER
	0
	0
	0
	0
	0 			/ +RXQDRV	DRIVE NUMBER
	0 			/ +RXQBLK	BLK # BEING RETURNED
	0
	0			/ +RXQBAD	ADDRESS OF LOCAL BUFFER
	0 			/ +RXQBFD	"CDF" TO BUFFER FIELD
	0
	0
/
/

/*****************************************************************************
/  DESCRIPTION:	RDGETR
/
/	RETURNS THE BLOCK NUMBER ADDRESSED BY THE OFFSET WHICH IS
/	IN THE AC UPON CALL.
/
/  INPUTS:	AC = OFFSET IN RANDRD CTRL BLK CONTAINING REQUESTED BLK #
/
/  OUTPUTS:	AC = PHYSICAL BLOCK NUMBER
/		AC = 0  - NO HEADER BLOCK IN HEADBF			/M017
/

RDGETR,	XX
	DCA	.+2 		/ SAVE THE OFFSET IN THE CALL BELOW
RDGETA,	JMS	SCOFST 		/ THIS ROUTINE RETURNS:
				/ 1) THE ADDRESS IN HEADBF WHICH 	/M017
				/ CONTAINS A BLOCK NUMBER. SKIP RETURN
				/ 2) IF HEADER BLOCK IS PRESENTLY NOT IN
				/ "HEADBF", "RDHDBN"  POINTS TO "RDHDRB" /M017
				/ OR AN OFFSET WHERE THE BLOCK # IS STORED.
				/ RETURN AND READ THAT BLK

	0 			/ THE DESIRED OFFSET
	RDBFCB 			/ THE HEADER CONTROL BLOCK
/
	JMP	RDGTXR 		/ NORMAL RETURN MADE--JUMP TO HANDLE IT
/
	DCA	T1RR 		/ SAVE THE BLOCK NUMBER ADDRESS TO INDIRECT THROUGH
	CDFEDT			/ change df to user field 1 (physical field 3)
	TAD I	T1RR 		/ GET THE BLOCK NUMBER
	CDFMYF			/ change df back to my field
	JMP I	RDGETR 		/ RETURN IT
/
/	WE MUST LOAD THE HEADER BLOCK INTO THE BUFFER AND TRY AGAIN
/
RDGTXR,	TAD I	RDHDBN 		/ GET THE BLOCK NUMBER OF THE HEADER BLOCK
	SNA
	JMP	RDGTXZ 		/ JUMP IF NO HEADER BLOCK WAS SPECIFIED
/
	JMS	RDFIO 		/ READ THE HEADER BLOCK
	RXERD+4000
	HEADBF								/M017
/
	SMA CLA 		/ WAS THERE AN ERROR IN READING?
	JMP	RDGETA 		/ NO--LOOP TO GET THE BLOCK NUMBER
	DCA I	RDHDBN 		/ YES--CLEAR THE BLOCK NUMBER OF THE HEADER BLOCK
/
RDGTXZ,	DCA	RDHDBN 		/ CLEAR TO INDICATE NO HEADER BLOCK IS IN THE BUFFER
	JMP I	RDGETR 		/ AND RETURN

/*****************************************************************************
/  DESCRIPTION:	SCOFST
/
/  INPUTS:	CALL+1 =	DESIRED OFFSET
/		CALL+2 =	ADDR OF RANDRD CONTROL BLOCK
/		RDHDBN (IMPLICIT) = 0 IF BUFFER EMPTY OR HDR BLK
/
/  OUTPUTS:	RDHDBN (IMPLICIT) = ADDRESS CONTAINING EITHER HDR, EXT1, EXT2
/
SCOFST,	XX
	DCA	SCOFS1 		/ INIT REL BLK #
	TAD I	SCOFST		/ GET DESIRED OFFSET INTO HEADER BLOCKS
				/ UNTIL (OFFSET IS WITHIN A HEADER BLOCK'S BOUNDARY)
	TAD	(-376) 		/     COMPUTE REL BLK #
	ISZ	SCOFS1 		/     INC OFFSET INTO RDHDRB TABLE
	SMA 			/
	JMP	.-3		/ END UNTIL

	DCA	SCOFS2 		/ SAVE OFFSET-400
	ISZ	SCOFST		/ BUMP RETURN
	TAD I	SCOFST 		/ BUFCB PTR
	DCA	SCOFS3		/ STORE ADDRESS OF HEADER CONTROL BLOCK
	AC0001
	TAD	SCOFS3 		/ CUR BLK PTR PTR
	DCA	SCOFS4
	ISZ	SCOFST		/ BUMP RETURN
	TAD I	SCOFS4
	SNA
	JMP	SCOFSA 		/ READ IF CURR BLK 0 (BUFFER EMPTY OF HEADER BLOCK)
	CIA 			/ ELSE COMPARE WITH NEEDED PTR
	TAD	SCOFS1
	TAD	SCOFS4
	SNA CLA
	JMP	SCOFSB 		/ JUMP IF SAME (BLOCK ALREADY LOADED IN
				/ HEADBF AREA)				/M017
SCOFSA,	TAD	SCOFS1
	TAD	SCOFS4 		/ SET NEW BLK PTR
	DCA I	SCOFS4
	JMP I	SCOFST 		/ RETURN FOR READ
SCOFSB,	TAD	SCOFS2 		/ GET WORD OFFSET
	TAD	(400)
	TAD I	SCOFS3 		/ +BUFFER PTR
	ISZ	SCOFST 		/ BUMP FOR NORMAL RETURN
	JMP I	SCOFST 		/ RETURN WORD PTR
/
SCOFS1,	.-. 			/ OFFSET INTO RDHDRB TABLE 	1 --> RDHDRB
				/				2 --> RDHDRB+1
				/				3 --> RDHDRB+2
				/				ETC.
SCOFS2,	.-. 			/ WORD OFFSET - 400
SCOFS3,	.-. 			/ POINTS TO 1ST ENTRY IN RDFIL HDR CTRL BLK (RDBFCB)
SCOFS4,	.-.			/ POINTS TO RDHDRB
/

/
/	RANDRD CONTROL BLOCK
/
RDBFCB,	HEADBF 			/ HEADER BLOCK BUFFER ADDRESS		/M017
RDHDBN,	0 			/ POINTER TO CURRENT HEADER BLOCK NUMBER
RDHDRB,	0 			/ MAIN HEADER BLOCK NUMBER
	0 			/ 1ST HEADER BLOCK EXTENTION
	0 			/ 2ND HEADER BLOCK EXTENTION
	0			/ 3RD HEADER BLOCK EXTENTION		/A012
	0			/ 4TH HEADER BLOCK EXTENTION		/A012
	0			/ 5TH HEADER BLOCK EXTENTION		/A012
	0			/ 6TH HEADER BLOCK EXTENTION		/A012
	0			/ 7TH HEADER BLOCK EXTENTION		/A012
	0			/ 8TH HEADER BLOCK EXTENTION		/A012
	0			/ 9TH HEADER BLOCK EXTENTION		/A012
	0			/ 10TH HEADER BLOCK EXTENTION		/A012
	0			/ 11TH HEADER BLOCK EXTENTION		/A012
	0			/ 12TH HEADER BLOCK EXTENTION		/A012
	0			/ 13TH HEADER BLOCK EXTENTION		/A012
	0			/ 14TH HEADER BLOCK EXTENTION		/A012
	0			/ 15TH HEADER BLOCK EXTENTION		/A012
	0			/ 16TH HEADER BLOCK EXTENTION		/A012
	0 			/ HEADER BLOCK NUMBERS ENDED BY ZERO
/
/
	PAGE

/++
/			TNOPRT
/
/FUNTIONAL DESCRIPTION:	TNOPRT
/
/	Calculate and save count of header block entries (HDRTNO) that will
/	be found in the header block buffer (HEADBF).  Also calculate 	/M017
/	and save header buffer pointer (HDRPTR).
/
/   TNOPRT PSEUDO CODE:
/
/	calculate count of header block entries
/	save it
/	calculate header buffer pointer
/	save it
/	return to caller
/
/CALLING SEQUENCE:	JMS	TNOPRT
/
/INPUT PARAMETERS:	AC = header block offset value
/
/IMPLICIT INPUTS:	HDRTNO
/
/OUTPUT PARAMETERS:	none
/
/IMPLICIT OUTPUT:	HDRTNO, HDRPTR
/
/COMPLETION CODE:	none
/
/SIDE EFFECTS:		none
/
/--
/
TNOPRT,	XX
/
	TAD	(-376)		/ calculate count of header block entries
	SMA
	JMP	.-2
	DCA	HDRTNO		/ save it
/
	TAD	HDRTNO		/ calculate header buffer pointer
	TAD	(HDBLEN+HEADBF-1)	/ add header buffer length + value /M017
					/ of first address of header buffer - 1
	DCA	HDRPTR		/ save result in header buffer pointer
/
	JMP I	TNOPRT
/
/

/*****************************************************************************
/  DESCRIPTION:	RDNXCH
/
/	Reads the next character from the file and returns it in
/	seven bit ASCII along with it's mode bits.
/
/  INPUTS:
/
/  OUTPUTS:	AC = mode bits and seven bit ASCII character
/

RDNXCH,	XX
	TAD	RDCHNO 		/ IS THE COUNT CLEAR?
	SMA CLA
	JMP I	RDNXCH 		/ YES--EOF HAS BEEN REACHED. RETURN
/
/
RDNXH1,	JMS	RDNXC
	SNA
	JMP I	RDNXCH 		/ RETURN IF NONE
	JMS	XLTASC
	JMS	GETMOD
	RDMOD
	SNA
	JMP	RDNXH1 		/ DON'T RETURN NULLS
	JMP I	RDNXCH
/


XLTASC,	XX 			/ XLAT 6-BIT TO ASCII
				/ 1-73: NORMAL
				/ 74:	SHIFT
				/ 76:	UNSHIFT
				/ 7702-7777:	ESCAPE
/
/	OUTPUT:			 -(1-6):	MODE CHANGE (L=1 IF ON)
/				 0-200:		ASCII CHAR (L=1 IF ALPHA)
/
	SPA SNA
	JMP	XLTAS1 		/ ESCAPE
	TAD	(-74)
	SMA
	JMP	XLTAS2 		/ SHIFT-UNSHIFT
	TAD	(74-41)
XLTAS4,	CLL CML 		/ SET LINK FOR ALPHA
	TAD	(41+37) 	/ CLEAR LINK IF NOT ALPHA
	JMP I	XLTASC
XLTAS1,	TAD	(100-MAXESC)
	SMA
	CLA 			/ CHECK FOR OK
	TAD	(MAXESC+ESCTAB)
	DCA	T1RR
	TAD I	T1RR
	SPA
	JMP	XLTAS3
	TAD	(-100) 		/ ADJUST FOR ALPHA TEST
	JMP	XLTAS4
/
XLTAS2,	SNA CLA
	IAC
	CMA
XLTAS3,	CLL CML RAR
	JMP I	XLTASC
/
ESCTAB,	0
	0
	-3
	-4
	-5
	-6
	11
	10
	15
	-13
	-14
	12
	14
	-7
	-10
	-11
	-12
	0
	133 			/ [ - SHIFT
	134 			/ \ - RESERVED
	135 			/ ] - UNSHIFT
	136 			/ ^ - START OF 2 CHARACTER SPECIAL CODE
	137
	0 			/ NORMALLY 7 FOR NEED-WRAP CODE
	16
	17
	MAXESC=.-ESCTAB
	-16 			/ ERROR
/
/
GETMOD,	XX 			/ XLAT ESCAPES, ADD MODES TO ASCII
	MQL			/ TEMP HOLD CHAR. IN MQ
	TAD I	GETMOD 		/ GET ADDRESS OF RDMOD
	DCA	T1RR
	ISZ	GETMOD		/ BUMP RETURN
	MQA			/ GET CHAR. BACK FROM MQ
	SMA SZA
	JMP	GETMD1 		/ NORMAL ASCII
	SNA 			/ NULL CHARACTER ?
	JMP I	GETMOD		/ YES - RETURN
	IAC
	SNA
	ISZ	T1RR 		/ ADJUST T1RR IF SHIFT-UNSHIFT CHANGE
	TAD	(MODTAB)
	DCA	T2RR 		/ GET PTR
	TAD I	T2RR
	SPA
	JMP I	GETMOD 		/ RETURN QUICK IF ERROR
	CMA
	AND I	T1RR
	SNL
	TAD I	T2RR
	DCA I	T1RR 		/ SET NEW MODE
	JMP I	GETMOD
GETMD1,	TAD I	T1RR 		/ ADD MODE FLAGS
	ISZ	T1RR
	SZL
	TAD I	T1RR 		/ AND UNSHIFT
	JMP I	GETMOD
/
	-1 			/ ERROR
	2000			/ JUSTIFY
	1400			/ SUPERSCRIPT
	1000			/ SUBSCRIPT
	400			/ UNDERSCORE
	200			/ BOLD
	MODTAB=.
	40
/
	PAGE

/++
/			LDHDRB
/
/FUNTIONAL DESCRIPTION:	LDHDRB
/
/	Fills header block buffer with proper header block based on the header
/	offset value.  Then calculate and save count of header block entries
/	(HDRTNO) as well as the header buffer pointer (HDRPTR).
/
/   LDHDRB PSEUDO CODE:
/
/	get header offset value
/	load in corresponding header block
/	if [no error]
/	   get header offset
/	   calculate and save count of header block entries (HDRTNO) and header buffer pointer (HDRPTR)
/	   increment return pointer
/	return to caller
/
/CALLING SEQUENCE:	CALLER,   JMS	LDHDRB
/			CALLER+1, error	return
/
/INPUT PARAMETERS:	none
/
/IMPLICIT INPUTS:	HDROFF
/
/OUTPUT PARAMETERS:	none
/
/IMPLICIT OUTPUT:	HDRTNO, HDRPTR
/
/COMPLETION CODE:	none
/
/SIDE EFFECTS:		If we error when loading header block into header
/			buffer then we return immediately to caller+1.
/
/--
/
LDHDRB,	XX
	TAD	HDROFF 		/ get the offset
	JMS	RDGETR 		/ load proper header block into HEADBF	/M017
	SNA CLA			/ error ?
	JMP I	LDHDRB		/ yes - return
	ISZ	LDHDRB		/ no - bump return
	TAD	HDROFF
	JMS	TNOPRT		/ calculate and save count of header block entries (HDRTNO)
				/ calculate and save header buffer pointer (HDRPTR)
	JMP I	LDHDRB 		/ return
/
/

/++
/				GETBNO
/
/FUNCTIONAL DESCRIPTION:	GETBNO
/
/	Get mode, blocknumber, and offsets for WPSORT.  The GETBNO routine
/	takes current mode bit information, breaks it up and then combines
/	it in part with the address of the current block read as well as
/	with the offset character pointer for RDBUF as shown below.  Also
/	the offset into the header block which contained the physical block
/	number is aquired along with a flag which shows whether we did a
/	single or multiple block read during the reading of a record.  All
/	three parameters are held in  buffer locations.  They are restored
/	to RANDR2 through the use of the PUTBNO routine.
/
/   GETBNO PSEUDO CODE:
/
/10)	save input parameter
/20)	get block no. of current block read
/	if (called to get parameters of current record)
/40)	   scheme mode bits for 1st word
/	   merge mode bits
/	   save word in BLOCKNO
/
/	   scheme mode bits for 2nd word
/	   get offset character pointer for RDBUF
/	   mask 3 m.s.b.
/	   merge mode bits
/	   save word at LABOFFSET
/
/140)	   get offset into header block
/	   save word at PERFORMANCE
/160)	else (e.o.r. call)
/	   if (block number neq to block number at first call to routine)
/	      set m.s.b. of LABOFFSET
/190)	return to caller
/
/			  0 /1 /2 /3 /4 /5 /6 /7 /8 /9 /10/11/12
/			 ----------------------------------------
/	BLOCKNO,	|m1|m2| 	block number		 |
/			 ----------------------------------------
/	LABOFFSET,	|m3|m4|m5|offset char. pointer for RDBUF |
/			 ----------------------------------------
/	PERFORMANCE,	|sm|    offset into header block         |
/			 ----------------------------------------
/
/	 mode bits	m1 = shift/unshift
/			m2 = justify
/			m3 = super & subscript
/			m4 = underscore
/			m5 = bold
/
/	 block read - This bit is operated on if GETBNO called with AC = 0
/			sm = 0	single block read
/			     1	multiple block read
/
/CALLING SEQUENCE:	Aquire parameters of the record being read.
/
/		   1)	**** Use this call when beginning of record [<] is detected. ****
/
/				AC7777
/				JMS	GETBNO
/
/
/		   2)	We must check if the record being read was contained
/			within a single block or if more than one block had
/			to be read into RDBUF before reaching EOR.  This must
/			be recorded in order to read the complete record properly
/			by using the PUTBNO routine.  This is done by setting
/			bit 0 in PERFORMANCE if block numbers have changed
/			from the start of the record being read to its end.
/			When PERFORMANCE parameter is passed to PUTBNO routine
/			it is flagged whether a single or multiple block read
/			is necessary.
/			****Use this call after detecting e.o.r. or e.o.f.****
/
/				CLA
/				JMS	GETBNO
/
/INPUT PARAMETERS:	AC = -1	Get all three parameters
/			AC =  0	Check if block number being read now is
/				different from block read at beginning of
/				record. If so set m.s.b. in PERFORMANCE.
/
/IMPLICIT INPUTS:	RDFQBK+RXQBLK, RDCHNO, RDMOD, RDMOD+1, HDROFF, BLOCKNO,
/			PERFORMANCE, GPTEMP
/
/OUPUT PARAMETERS:	AC = 0
/
/IMPLICIT OUTPUT:	CALLER+1, CALLER+2, CALLER +3, BLOCKNO, LABOFFSET,
/			PERFORMANCE, GPTEMP
/
/COMPLETION CODE:	none
/
/SIDE EFFECTS:		1) In order to make room for the mode bits (3,4 & 5)
/			in the second word, the 3 m.s.b. are masked from
/			the offset char. pointer (RDCHNO).  Since RDCHNO's
/			limits are 7004 to 7777 the 3 m.s.b. must be reset
/			by the routine using this parameter before restor-
/			ing it to RDCHNO.
/
/--
/

GETBNO,	XX
/
/..10..
	DCA	GPTEMP		/ save pass number flag
/
/..20..
	TAD	RDFQBK+RXQBLK	/ get no. of current block
	ISZ	GPTEMP		/ get record's parameters?
	JMP	CHKPAS		/ no - do check e.o.r. for multi block read
	DCA	GPTEMP		/ hold block number while do mode bits
	TAD	RDMOD+1		/ get shift/unshift mode bit
	BSW			/ bit 0 gets bit 6
	MQL			/ hold result in MQ
	AC2000			/ GET JUSTIFY BIT			/M012
	AND	RDMOD							/M012
	MQA			/ MERGE WITH SHIFT/UNSHIFT		/M012
	MQL			/ HOLD IN MQ				/M012
	TAD	GPTEMP		/ merge block number with 2 mode bits
	MQA
	DCA	BLOCKNO		/ save word
/
/..40..
	TAD	RDMOD		/ get mode bits m3,m4, and m5
	RTL			/ bits 0,1,2 get 2,3,4
	AND	(7000)
	MQL			/ hold result in MQ
	AC7777			/ offset = offset - 1
	TAD	RDCHNO
	AND	(777)		/ mask to set mode bits
	MQA			/ merge mode bits
	DCA	LABOFFSET	/ save word
/
/..140..
	TAD	HDROFF		/ get offset into header block
	DCA	PERFORMANCE	/ save word
	JMP I	GETBNO		/ return to caller
/
/..160..
CHKPAS,	CIA			/ compare blk no. e.o.r. with blk no. beginning of record
	DCA	GPTEMP		/ hold -block number
	TAD	BLOCKNO		/ get block number beginning of record
	AND	(1777)		/ mask mode bits
	TAD	GPTEMP
	SZA CLA			/ are they same?
	AC4000			/ no - set flag showing multiple block read
	TAD	PERFORMANCE
	DCA	PERFORMANCE
/
/..190..
	JMP I	GETBNO		/ return to caller
/
/

/++
/				PUTBNO
/
/FUNCTIONAL DESCRIPTION:	PUTBNO
/
/	Insert mode, blocknumber, and offsets into RANDR2 for WPSORT.
/	The PUTBNO routine restores mode bits into RANDR2 and then
/	reads the proper header block into HEADBF.  The block specified
/	by BLOCKNO is read into the read buffer and the offset character
/	pointer (RDCHNO) is loaded so we can start reading characters from
/	that point on.  Thus we're able to accomplish random access reads
/	for use in sorting.
/
/   PUTBNO PSEUDO CODE:
/
/10)putbno: get parameters and save them
/20)	    restore mode bits
/30)	    if [single block read]
/40)	       calculate and save count of header block entries (HDRTNO)
/	       calculate and save header buffer pointer (HDRPTR)
/	       reset count of header block entries to -2 (HDRTNO)
/	       set header block offset to -1 (HDROFF)
/	       save value pointed to by header block buffer pointer
/	       place physical block number we want to read (BLOCKNO) in header buffer
/	       offset header block buffer pointer by -1
/	       read block just placed in header buffer into read buffer (RDBUF)
/	       escape putbno if (error)
/	       restore value saved to header buffer
/	    else
/150)	       set header block offset
/	       load header block, calculate and save count of header block entries (HDRTNO) and header buffer pointer (HDRPTR)
/	       escape putbno if (error)
/	       read block pointed to by header buffer pointer
/	       escape putbno if (error)
/200)	    set offset character pointer (RDCHNO)
/	    bump return pointer (no errors)
/220)	end putbno
/
/	return to caller
/
/
/CALLING SEQUENCE:	JMS	PUTBNO
/			 ----------------------------------------
/			|m1|m2| 	block number		 |
/			 ----------------------------------------
/			|m3|m4|m5|offset char. pointer for RDBUF |
/			 ----------------------------------------
/			|sm|       offset into header block      |
/			 ----------------------------------------
/			errror return
/			normal return
/
/
/	 mode bits	m1 = shift/unshift
/			m2 = justify
/			m3 = super & subscript
/			m4 = underscore
/			m5 = bold
/
/	 block read	sm = 0 - single block read
/			     1 - multiple block read
/
/INPUT PARAMETERS:	none
/
/IMPLICIT INPUTS:	CALLER+1, CALLER+2, LABOFFSET, BLOCKNO, HDROFF, HDBUFP
/
/OUTPUT PARAMETERS:	AC = 0
/
/IMPLICIT OUTPUT:	BLOCKNO, LABOFFSET, PERFORMANCE, RDMOD, RDMOD+1, RDCHNO,
/			HDROFF, HDBUFP
/
/COMPLETION CODE:	none
/
/SIDE EFFECTS:		Errors could occur (highly unlikely but nevertheless
/			possible) during execution of PUTBNO.  Upon detection
/			of any error we return to caller+4.
/
/--
/
PUTBNO,	XX
/
/..10..
	CLA CLL
	TAD I	PUTBNO		/ get mode & block no. from call + 1
	DCA	BLOCKNO		/ save it
	ISZ	PUTBNO		/ bump return
	TAD I	PUTBNO		/ get mode & char. offset pointer
	DCA	LABOFFSET	/ save it
	ISZ	PUTBNO		/ bump return
	TAD I	PUTBNO		/ get offset into header block
	DCA	PERFORMANCE	/ save it
/
/..20..
	ISZ	PUTBNO		/ bump return
	TAD	LABOFFSET	/ get 3 mode bits in char, offset pointer
	AND	(7000)
	RTR			/ place in proper bit position
	MQL			/ hold here until get justify bit
	AC2000			/ GET JUSTIFY BIT			/M012
	AND	BLOCKNO							/M012
	MQA			/ merge with 3 other mode bits
	DCA	RDMOD		/ restore mode bits
	AC4000			/ GET SHIFT/UNSHIFT MODE BIT		/M012
	AND	BLOCKNO							/M012
	BSW			/ place in proper bit position (bit 6)
	DCA	RDMOD+1		/ restore mode bit
/
/..30..
	TAD	PERFORMANCE	/ single block read?
	SPA			/
	JMP	PUTBN1		/ no - set up for multiple block read
/
/..40..
	JMS	TNOPRT		/ calculate and save header buffer pointer (HDRPTR)
/
	AC7776
	DCA	HDRTNO		/ reset count of header block entries to -2
/
	AC7777			/ set header block offset = -1 to simulate
				/ eof if we read beyond end of the block.
	DCA	HDROFF
/
	TAD	HDRPTR		/ get address pointed to by header pointer
	DCA	HDBUFP		/ save it
	CDFEDT			/ change df to user field 1 (physical field 3)
	TAD I	HDBUFP		/ get value in HEADBF			/M017
	DCA	GPTEMP		/ temp. save it
/
	TAD	BLOCKNO		/ get block number we want to read
	AND	(1777)		/ mask mode bits
	DCA I	HDBUFP		/ place in header buffer
	CDFMYF			/ change df back to my field
/
	AC7777			/ offset header buffer pointer by -1
	TAD	HDRPTR
	DCA	HDRPTR
/
	JMS	RDFBUF		/ read in block
	JMP I	PUTBNO		/ error or end of file return
/
	TAD	GPTEMP		/ restore value we saved to header buffer
	CDFEDT			/ change df to user field 1 (physical field 3)
	DCA I	HDBUFP
	CDFMYF			/ change df back to my field
/
	JMP	PUTBN2
/
/..150..
PUTBN1,	AND	P3777		/ mask multi/single block read flag
	DCA	HDROFF		/ set header block offset (HDROFF)
/
	JMS	LDHDRB		/ load header block buffer with header block
				/ that corresponds to this offset.
	JMP I	PUTBNO		/ error return - error caused in RDGETR
/
	JMS	RDFBUF		/ read block pointed to by HDRPTR
	JMP I	PUTBNO		/ error or end of file return
/
/..200..
PUTBN2,	TAD	LABOFFSET	/ setup and save RDBUF character counter
	AND	(777)		/ mask mode bits
	TAD	(7000)
	DCA	RDCHNO
	ISZ	PUTBNO		/ bump return
/
/..220..
	JMP I	PUTBNO		/ return to caller
/
HDBUFP,	0			/ temporary pointer into header block buffer
/
/
/Symbols shared by BOTH GETBNO and PUTBNO routines
/
BLOCKNO,	0		/ mode bits and block number
LABOFFSET,	0		/ mode bits and offset character pointer
PERFORMANCE,	0		/ multi/single block read flag & offset
				/ into header buffer
/
GPTEMP,	0			/ temp for GETBNO and PUTBNO routine
/
/
	PAGE
/

////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////	SHLSRT.PA	-	MULTI KEY SHELL SORT ALGORITHM	\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

SUBKEY,		ZBLOCK	1	/2; 14	/ THE 'SECONDARY' KEY(S)
SORTORDER,	ZBLOCK	1		/ FROM 'ORDER' FOR 'RAL'S LATER
BREAKADDRESS,	ZBLOCK	1		/ adrs 'KEY01FNTOTAL' - 'KEY12FNTOTAL'
BOTADR,		ZBLOCK	1		/ BOTTOM (LOGICAL ADDRESS) OF FNVAR LIST
TOPADR,		ZBLOCK	1		/ TOP (LOGICAL ADDRESS) OF FNVAR LIST

/ MULTI-KEY SORT PROCESSOR

SORT,	XX
	AC0002			/ 2	/ (because of '-1' and 'DUMMY' in list)
	TAD	FNVAR			/ PHYSICAL 'END' (BOTTOM) OF LIST
	DCA	BOTADR
	TAD	(FNVARBUFFER+1)		/ PHYSICAL 'START' (TOP) OF LIST + 1
	DCA	TOPADR
	TAD	(FNVARBUFFER+1)		/
	DCA	KEY01FNTOTAL		/
	TAD	(KEY01FNTOTAL)		/
	DCA	BREAKADDRESS		/
	TAD	ORDER			/ XXX XXX XXX XXX; (0/1 ASCENDING/ DESC)
	DCA	SORTORDER		/ FOR 'RAL'(S) LATER (IN 'XSORT')

/ ORDER (SORT) THE SEQUENCE OF THE 'FNVARTABLE'
/  AS PER THE 'VVVVVALUE' WITHIN THE 'FNVBUFFER'
/   for the 'PRIMARY' KEY (key #1)
/    USING SHELL'S SORTING METHOD

	AC0001			/ # 1	/ SORT THE 'PRIMARY' (#1) KEY
	  JMS	XSORT			/  (INITIALZES 'KEYID' TO KEY #1)
	TAD	SORTKEY		/	/
	CLL RAR				/
	SNA CLA				/
	JMP I	SORT		/EXIT	/ SINGLE KEY SORT COMPLETED

/ PARTITION (RECALCULATE) THE SIZE OF THE 'LSTADR'
/  TO THAT OF THE PRIMARY KEY ('THISKEY')
/   AND SORT ON KEY #2; ETC
/   (THEN ITERATIONS THRU KEY #MAXKEY)

	AC0002			/ 2	/ (because of '-1' and 'DUMMY' in list)
	TAD	FNVAR			/ PHYSICAL 'END' (BOTTOM) OF LIST
	DCA	BOTADR
	TAD	BOTADR			/ THE PHYSICAL (THEN LOGICAL) BOTTOM
	DCA	TOPADR			/   BECOMES THE 'LOGICAL' TOP
BREAKPRIMARY,
	JMS	TSTTOPADR		/ 'ISZ TOPADR'
	  JMP I	SORT		/ DONE	/ ONLY 1 MULTIKEY RECORD IN 'FNVARTABLE'
/\	JMP	.+1			/

	TAD	ORDER			/
	DCA	SORTORDER		/
	AC0001			/	/ CONTINUE SORTING KEYS #2 THRU #14
	DCA	SUBKEY		/SUBKEY=/  (BECAUSE PRIMARY KEY ALREADY SORTED)
BREAKSUB,
	TAD	SUBKEY		/	/ the PRIMARY key identification (#1)
	JMS	ADVANCE			/ ADVANCE TO A BREAK FOR THIS KEY
    CDFMYF /--------------------//CDF	/

/ THE 'VVVVV'ALUES ARE DIFFERENT (LOGICAL BREAK), OR
/  THE 'VAT'S ARE DIFFERENT (LOGICAL BREAK); OR
/   AT THE PHYSICAL TOP OF THE 'FNVARTABLE'

	TAD	TOPADR		/TOPADR	/ CONTAINS THE BREAK ADDRESS
	ISZ	BREAKADDRESS		/  SAVE IT INTO
	DCA I	BREAKADDRESS		/  'KEY02FNTOTAL THRU KEY12FNTOTAL'
	TAD	SORTORDER		/ GET THE SORTING 'ORDER'
	CLL RAL				/  FOR THE NEXT KEY (2 THRU 14)
	DCA	SORTORDER		/   (MAKING A WORKING MASTER)
	SZL				/     DON'T LOOSE THE LINK
	ISZ	SORTORDER		/     (BIT 0 IS HELD IN BIT 12--ETC.)
	ISZ	SUBKEY		/ +1	/
	TAD	SUBKEY		/ 1; 14	/ SORT THE LIST ON SECONDARY KEYS (2-14)
	  JMS	XSORT		/'SORT'	/  (UPDATING 'KEYID' TO THE NEXT KEY #)
	TAD	SORTKEY		/MAX#	/
	CIA				/
	TAD	SUBKEY			/ # OF CURRENT SUBKEY IN PROCESS
	SNA CLA				/
	JMP	NOMORESUBKEYS		/
	TAD	BOTADR		/	/ RESET 'TOPADR' WITH THE ADDRESS OF THE
	DCA	TOPADR			/ 'BOTTOM' OF THE LIST (DIDN'T MOVE YET)
JMSTSTTOPADR,
	JMS	TSTTOPADR		/
	  JMP	NOMORESUBKEYS	/ JUMP	/ IF DONE WITH THIS KEY (OR 1 KEY REC)
	JMP	BREAKSUB		/

NOMORESUBKEYS,
	TAD I	BREAKADDRESS		/ RESET 'TOPADR' WITH 'BREAK' ADDRESS
	DCA	TOPADR			/  OF THE SUB KEY (FROM A 'TOPADR')
	TAD	TOPADR			/   and  M  O  V  E  the bottom address
	DCA	BOTADR			/    TO BECOME THE 'NEW' LOGICAL BOTTOM
	AC7777			/ -1	/
	TAD	BREAKADDRESS		/
	DCA	BREAKADDRESS		/
	TAD	BREAKADDRESS		/
	TAD	(-KEY01FNTOTAL)		/
	SNA CLA				/
	JMP	BREAKPRIMARY		/ CONTINUE FORWARD SORT OF SUB KEYS

/ ALL SECONDARY KEYS IN THE FORWARD DIRECTION HAVE BEEN SORTED
/  BACKUP 1 SECONDARY KEY TO CONTINUS SORTING IN THE FORWARD DIRECTION
/   WHEN ALL SECONDARY KEYS HAVE BEEN SORTED TO THEIR RESPECTIVE
/    PRECEEDING SECONDARY KEYS FOR THIS PRIMARY KEY BREAK
/     (WHEN THE CONTENTS OF PROGRAM LOCATION 'BREAKADDRESS')
/     (EQUILS THE VALUE FOR THE ADDRESS 'KEY01FNTOTAL)
/     THEN FIND THE NEXT PRIMARY KEY BREAK
/        AND DO IT ALL OVER AGAIN

	AC7777			/ -1	/
	TAD	SUBKEY			/
	DCA	SUBKEY			/
	TAD	SORTORDER		/
	CLL RAR				/
	SZL				/
	TAD	(4000)		/ BIT 0	/
	DCA	SORTORDER		/
	JMP	JMSTSTTOPADR		/

TSTTOPADR,
	XX
	TAD I	BREAKADDRESS		/
	CIA
	ISZ	TOPADR
	TAD	TOPADR
	SPA CLA
	ISZ	TSTTOPADR
	JMP I	TSTTOPADR

/******************************************************************************
/
/	OUTPUT DISKETTE/VOLUME FULL - CK WHICH ONE IS IN USE AND USE CORRECT
/	TEXT STRING
/
/	CK FOR WINCHESTER DRIVE INSTALLED
/
/******************************************************************************

E13CKW,	CLA			/ CLEAR AC				/A018
	CDFMNU			/ MENU FIELD				/A018
	TAD	MUBUF+MNOPTN	/ FETCH OPTION WORD			/A018
	CDFMYF			/ BACK TO THIS FIELD			/A018
	DCA	SROPTN		/ SAVE VALUE				/A018
	AC0004			/ MASK VALUE FOR WINCHESTER DRIVE	/A018
	AND	SROPTN		/ IS WINNIE BIT SET ?			/A018
	SNA	CLA		/ YES - SKIP AND CONTINUE		/A018
	JMP	E13		/ NO - USE "DISKETTE			/A018
/
/****** - SYSTEM HAS WINCHESTER, CK WHICH DRIVE HAS THE OUTPUT DOC.	/A018
/
	TAD	SOTFL		/ FETCH DRIVE #				/A018
	AND	(7400)		/ MASK FOR DRIVE #			/A018
	BSW			/ SWAP					/A018
	CLL	RTR		/ DRIVE # INTO LOW 4 BITS		/A018
	DCA	SRDRVN		/ SAVE VALUE				/A018
	TAD	SRDRVN		/ CK FOR DRIVE 0			/A018
	SNA			/ NO - SKIP AND CONTINUE		/A018
	JMP	E13		/ YES - USE "DISKETTE			/A018
	TAD	(-1		/ IS IT 1 ?				/A018
	SZA	CLA		/ YES - SKIP AND CONTINUE		/A018
	JMP	E13A		/ NO - USE "VOLUME			/A018
	AC0010			/ MASK - VOLUME ASSIGNED TO DEVICE 1	/A018
	AND	SROPTN		/ IS VOLUME ASSIGNED ?			/A018
	SNA	CLA		/ YES - SKIP AND USE "VOLUME		/A018
	JMP	E13		/ NO - USE "DISKETTE			/A018
	JMP	E13A		/ USE "VOLUME				/A018
SROPTN,	0
SRDRVN,	0

	PAGE

/ MORE THAN 1 MULTI-KEY RECORD IS IN THE 'FNVARTABLE'

ADVANCE,XX				/

/ ENTER WITH THE CONTENTS OF THE ACCUMULATOR EQUIVALENT KEY #

	DCA	KEYID		/ RESET	/ (UPDATE) 'KEYID' USED BY 'KEYSEARCH'
	TAD	BOTADR
	 JMS	KEYSEARCH	/ (KEYID)
	  DCA	BOTVATADR		/ 'PREVIOUS' KEY'S [VAT] ADDRESS
LOOP,	TAD	TOPADR
	 JMS	KEYSEARCH	/ (KEYID)
	   DCA	TOPVATADR		/ 'THIS' KEY'S [VAT] ADDRESS
    CDFFNV /--------------------//CDF	/
	TAD I	BOTVATADR	/ [VAT]
	AND	(-MKSBIT-1)	/ 7757	/ X VVVVV S [0=M] KKKK
	DCA	T1
	TAD I	TOPVATADR	/ [VAT]
	AND	(-MKSBIT-1)
	CIA
	TAD	T1
	SZA CLA
	JMP I	ADVANCE			/ EXIT - DIFFERENT 'VAT'S
	TAD	BOTVATADR
	DCA	T1			/ 'T1' GETS 'ISZ'D
	TAD I	T1		/ [VAT]
	AND	(VVVVV^100)
	SNA
	JMP	NOVVVVV			/ 'VVVVV' = 0 MEANS NON-EXISTANT KEY
	BSW
	CIA
	DCA	T2		/-VVVVV
NEXTV,	ISZ	T1
	ISZ	TOPVATADR
	TAD I	T1		/ V V
	CIA
	TAD I	TOPVATADR	/ V V
	SZA CLA
	JMP I	ADVANCE			/ EXIT - DIFFERENT 'VVVVV'S
	ISZ	T2
	JMP	NEXTV
NOVVVVV,
    CDFMYF /--------------------//CDF	/

/ THE 'VVVVV'ALUES ARE STILL EQUAL
/  MOVE DOWN THE 'FNVARTABLE' UNTIL THE 'VVVVV'ALUES CHANGE
/   WHICH MEANS AT A PRIMARY KEY BREAK

	JMS	TSTTOPADR		/ 'ISZ TOPADR'
	  JMP I	ADVANCE			/ EXIT - AT 'TOPADR' OF LIST
	JMP	LOOP

BOTVATADR,	ZBLOCK	1		/ 'VAT' ADDRESS FOR THE 'BOTTOM' ELEMENT
TOPVATADR,	ZBLOCK	1		/ 'VAT' ADDRESS FOR THE 'TOP' ELEMENT

/ MULTI-KEY SORT SUBROUTINE TO
/  SEARCH FOR THE KEY # (WITHIN PROGRAM LOCATION 'KEYID')
/   WITHIN THE FNVAR LIST
/    STARTING AT THE LOGICAL ADDRESS WITHIN THE AC AT ENTRY
/     UNTIL THE KEY # IS FOUND, OR
/      UNTIL 'VAT' MKS-BIT = 0

KEYSEARCH,
	XX
	DCA	T1		/ WORK	/ SEARCH STARTING ADDRESS FROM AC
    CDFFNV /--------------------//CDF	/
	TAD I	T1		/ FNVAR	/ GET THE 'VAT' ADDRESS FOR THIS RECORD
KEYLOOP,TAD	(4)		/OFFSET	/ 'VAT' ADDRESS OFFSET
	DCA	T1
	TAD I	T1		/ [VAT]
	DCA	T2			/ XVV VVV SMK KKK
	TAD	T2
	AND	(KKKK)
	CIA
	TAD	KEYID
	SZA CLA
	JMP	.+4
KEYEND,
    CDFMYF /--------------------//CDF	/
	TAD	T1
	JMP I	KEYSEARCH	/ EXIT	/ WITH (AC) = 'VAT' ADDRESS OF KEY #
	TAD	T2
	AND	(MKSBIT)	/ M
	SNA CLA
	JMP	KEYEND		/ EXIT	/ BECAUSE MKS-BIT = 0
	TAD	T2		/ [VAT]
	BSW
	AND	(VVVVV)
	TAD	T1
	JMP	KEYLOOP			/ UNTIL KEY IS FOUND; OR M-BIT = 0

KEYID,	ZBLOCK	1		/ 1; 15

	PAGE

/    ** DESCIPTION
/
/		THIS PAGE CONTAINS THE SHELL SORT ALOGRITHM.  GIVEN THE
/		NUMBER OF ELEMENTS IN THE LSTADR TO BE SORTED, AN OPTIMUM
/		DISTANCE BETWEEN ELEMENTS IS CALCULATED.  ALL ELEMENTS
/		WHICH ARE SEPERATED BY THE CALCULATED "DISTANCE" MAKE UP
/		A PARTITION.  THE ELEMENTS IN THE PARTITION ARE SORTED.
/		AFTER A PARTITION IS SORTED THE DISTANCE IS RECOMPUTED,
/		AND NEW PARTITIONS ARE DEFINED USING THIS DISTANCE.  WHEN
/		VALUE OF DISTANCE EQUALS "1", THE SORT IS COMPLETED.
/
/    ** INPUT	- IMPLICIT -
/
/		COUNT	-Autoindex Register (FNVAR) contains the last address
/			in which FNV pointers are stored
/
/		LSTADR	-The starting address (-1) of the LSTADR to be sorted
/			Assumed to be FNVARBUFFER-1
/
/    ** OUTPUT
/
/		LSTADR	-The Input LSTADR in sorted order
/
/    ** LOCAL VARIABLES (TO THIS PAGE)
/
DISTNC,	0		/ The distance between elements in a partition
BOTINX,	0		/ An index to the botINXtom element in a partition
TOPINX,	0		/ An index to the topINX element in a partition
FREINX,	0		/ An index to the free element in a partition
BOTPTR,	ZBLOCK	1	/ Pointer (address) to the botINXtom element in a partition
TOPPTR,	ZBLOCK	1	/ Pointer (address) to the topINX element in a partition
FREPTR,	ZBLOCK	1	/ Pointer (address) to the free element in a partition
TOPTMP,	0		/ TOPTMPorary storage for the TOPINX element in a partition
EXCHNG,	0		/ A boolean, 0=FALSE, 1=TRUE
NUMELM,	0		/ Number of elements to be sorted (computed)
LSTADR,	ZBLOCK	1	/ The address (-1) of the LSTADR to be sorted

/ FIND INITIAL DISTANCE FOR SHELL's SORT
/ ..............................................................................
/	IF NUMELM<=1			(No need to sort if there
/	 THEN EXIT			(are "1" or less elements
/
/	DISTNC=1
/	 WHILE DISTNC<NUMELM
/	  DISTNC=DISTNC*2
/
/	DO "FIND HIBBARD VALUE"
/	 IF DISTNC=0			(Special case if number
/	  THEN DISTNC=1			(of elements is "2" then
/			 		(HIBBARD value would be "0"
/ ..............................................................................
/ (FALLS THROUGH TO "SORT THE PARTITIONS")

XSORT,	XX			/******	/ XSORT ENTRY POINT
	DCA	KEYID		/ KEY #	/ REQUIRED BY SUBROUTINE 'KEYSEARCH'
	TAD	SORTORDER	/ORDER	/ THE WORKING ORDER (ASC/DES)
	CLL RAL
	CLA
	TAD	K7430		/ 7430	/ 'SZL'
K7430,	SZL
	TAD	(SNL-SZL)	/ -10	/ 'SNL'
	DCA	ASCDSC
/ CALCULATE SIZE OF 'LSTADR' TO BE SORTED
	AC7777			/ -1
	TAD	BOTADR
	DCA	LSTADR
	TAD	LSTADR
	CMA
	TAD	TOPADR
	DCA	NUMELM
	AC7776			/ -2	/ CHECK NUMELM
	TAD	NUMELM
	SPA CLA				/ IS NUMELM <= 1
	JMP I	XSORT			/ YES, DONE
	AC0001			/ 1	/ NO
	DCA	DISTNC			/ DISTNC=1
DBLDIS,	TAD	NUMELM			/ IS DISTNC < NUMELM
	CLL CIA
	TAD	DISTNC
	SZL CLA				/ YES, SKIP IF AC < 0
	JMP	ORGDIS			/ NO, EXIT FROM WHILE LOOP
	TAD	DISTNC
	CLL RAL				/ DISTNC=DISTNC*2
	DCA	DISTNC
	JMP	DBLDIS			/ RESUME WHILE LOOP
ORGDIS,	JMS	FNDHIB			/ DO "FIND HIBBARD VALUE"
	TAD	DISTNC
	SNA
	IAC			/ +1
	DCA	DISTNC
/\	JMP	SHLSORT			/ FALLS THROUGH

/ .. SORT THE PARTITIONS .......................
/	WHILE DISTNC>0
/		BOTINX=1
/		TOPINX=BOTINX+DISTNC
/
/		WHILE TOPINX<=NUMELM
/			DO "ORDER THE PARTITION"
/			BOTINX=BOTINX+1
/			TOPINX=BOTINX+DISTNC
/
/		DISTNC=DISTNC+1
/		DO "FIND HIBBARD VALUE"
/ ..... (     SORT EXIT    ) ...................

SHLSORT,TAD	DISTNC		/ IS DISTNC > 0
	SPA SNA CLA	/ 7750	/ YES, SKIP IF AC > 0
	JMP I	XSORT		/ NO, DONE
	AC0001
	DCA	BOTINX		/ BOTINX=1
	TAD	BOTINX
	TAD	DISTNC
	DCA	TOPINX		/ TOPINX=BOTINX+DISTNC

PARTSRT,TAD	TOPINX		/ IS TOPINX <= NUMELM
	CIA
	TAD	NUMELM
	SPA CLA			/ YES, SKIP IF AC >= 0
	JMP	NXTDIS		/ NO, EXIT THE WHILE LOOP
/--	JMS	ORDPART		/ DO "ORDER THE PARTITION"

/ ..............ORDER THE PARTITION........................
/ TOPTMP=LSTADR(TOPINX)
/ FREINX=TOPINX
/ DO "COMPARE ELEMENTS"
/	WHILE BOTINX>DISTNC AND EXCHNG=TRUE	(Defined for an ascending sort)
/		BOTINX=BOTINX-DISTNC
/		DO "COMPARE ELEMENTS"
/ BOTINX=TOPINX-DISTNC		(Need to restore BOTINX since it may have)
/				(changed by 'secondary' compares)
/ ...... (RETURN TO "SORT THE PARTITIONS") .....

/--ORDPART,XX
	TAD	LSTADR
	TAD	TOPINX
	DCA	TOPPTR		/ CREATE "LSTADR(TOPINX)" POINTER
    CDFFNV /--------------------//CDF	/
	TAD I	TOPPTR
    CDFMYF /--------------------//CDF	/
	DCA	TOPTMP		/ TOPTMP=LSTADR(TOPINX)
	TAD	TOPINX
	DCA	FREINX		/ FREINX=TOPINX
	JMS	CMPELMT		/ DO "COMPARE ELEMENTS"

SCNDRY,	TAD	BOTINX		/ IS BOTINX > DISTNC
	CIA
	TAD	DISTNC
	SMA CLA			/ YES, SKIP IF AC < 0
	JMP	DONEORD		/ NO
	TAD	EXCHNG		/ IS EXCHNG TRUE
	SPA SNA CLA		/ YES
	JMP	DONEORD		/ NO
	TAD	DISTNC
	CIA
	TAD	BOTINX
	DCA	BOTINX		/ BOTINX=BOTINX-DISTNC
	JMS	CMPELMT		/ DO "COMPARE ELEMENTS"
	JMP	SCNDRY		/ STAY IN WHILE LOOP

DONEORD,TAD	DISTNC
	CIA
	TAD	TOPINX
	DCA	BOTINX		/ BOTINX=TOPINX-DISTNC
/--	JMP I	ORDPART
	ISZ	BOTINX		/ BOTINX+1
	NOP
	TAD	BOTINX
	TAD	DISTNC
	DCA	TOPINX		/ TOPINX=BOTINX+DISTNC
	JMP	PARTSRT		/ STAY IN INNER WHILE LOOP

NXTDIS,	ISZ	DISTNC		/ DISTNC+1
	NOP
	JMS	FNDHIB		/ DO "FIND HIBBARD VALUE"
	JMP	SHLSORT		/ STAY IN OUTER WHILE LOOP

/ .. COMPARE THE ELEMENTS ........................

/	EXCHNG=FALSE
/	DO EVALUATION
/	IF EXCHNG=TRUE
/	    THEN
/		LSTADR(FREINX)=LSTADR(BOTINX)
/		LSTADR(BOTINX)=TOPTMP
/		FREINX=BOTINX
/ ...... (RETURN TO "ORDER THE PARTITION") .......

CMPELMT,XX
	DCA	EXCHNG		/ EXCHNG=FALSE (0)
	TAD	LSTADR
	TAD	BOTINX
	DCA	BOTPTR		/ CREATE "LSTADR(BOTINX)" POINTER
	TAD	LSTADR
	TAD	FREINX
	DCA	FREPTR		/ CREATE "LSTADR(FREINX)" POINTER

	JMS	EVAL		/ COMPARE THE SORT FIELDS

	DCA	EXCHNG		/ SAVE EXCHANGE  INDICATOR
	TAD	EXCHNG		/ IS EXCHNG=TRUE
	SNA CLA			/ YES, SKIP IF AC <> 0
	JMP I	CMPELMT		/ NO
    CDFFNV /--------------------//CDF	/
	TAD I	BOTPTR
	DCA I	FREPTR		/ LSTADR(FREINX)=LSTADR(BOTINX)
	TAD	TOPTMP
	DCA I	BOTPTR		/ LSTADR(BOTINX)=TOPTMP
    CDFMYF /--------------------//CDF	/
	TAD	BOTINX
	DCA	FREINX		/ FREINX=BOTINX
	JMP I	CMPELMT

	PAGE

BOTDAT,	0		/ AN ADDRESS POINTER TO THE BOTINX DATA ELEMENT
FREDAT,	0		/ AN ADDRESS POINTER TO THE FREE DATA ELEMENT
BINVALID,0		/ A BOOLEAN (0=F, 1=T), TRUE = INVALID FIELD (BOTINX)
FINVALID,0		/ A BOOLEAN (0=F, 1=T), TRUE = INVALID FIELD (FREINX)
BOTCNT,	0		/ A COUNT OF THE NUMBER OF CHARACTERS IN BOTINX FIELD
FRECNT,	0		/ A COUNT OF THE NUMBER OF CHARACTERS IN FREE FIELD
CHARCT,	0		/ THE NUMBER OF CHARACTERS TO BE COMPARED
			/ EQUALS THE LESSER OF BOTCHR/FRECHR
/ ** INTEROGATE VAT **
/	SET INVALID FIELD INDICATORS & DETERMINE SORT FIELD LENGHTS
/	INVLD=FALSE
/	BOTDAT=(BOTPTR)+4	(ADDR = (ADDR OF REC] - 1)
/	FREDAT=(FREPTR)+4	(ADDR = (ADDR OF REC] - 1)
/	 IF (BOTDAT) IS INVALID
/	  THEN
/	   DO INVALD
/	   BINVALID = TRUE
/	   BOTCNT=(BOTDAT IS THE CHARACTER COUNT)
/
/	IF (FREDAT) IS INVALID
/	 THEN
/	 DO INVALD
/	 FINVALID = TRUE
/	 FRECNT=(FREDAT IS THE CHARACTER COUNT)
/
/ (FALL THROUGH TO "RESOLVE INVALID FIELD CONDITIONS")

EVAL,	XX			/ ENTRY POINT TO EVALUATION LOGIC
	TAD	SORTKEY
	CLL RAR
	SZA CLA
	JMP	EVALMKS		/ MULTI-KEY SORT
	TAD	BOTPTR
	DCA	BOTDAT
	TAD	FREPTR
	DCA	FREDAT
    CDFFNV /--------------------//CDF	/
	AC0004			/ ADDR = (ADDR OF REC) - 1
	TAD I	BOTDAT
	DCA	BOTDAT		/ BOTDAT=(BOTPTR)+4
	AC0004			/ ADDR = (ADDR OF REC) - 1
	TAD I	FREDAT
    CDFMYF /--------------------//CDF	/
	JMP	.+6		/ FREDAT=(FREPTR)+4
EVALMKS,TAD	BOTPTR
	 JMS 	KEYSEARCH
	   DCA	BOTDAT		/ 'VAT' ADDRESS OF RECORD ENTRY IN FNVTABLE
	TAD	FREPTR
	 JMS	KEYSEARCH
	   DCA	FREDAT
    CDFFNV /--------------------//CDF	/
	TAD I	BOTDAT	/ [VAT]
	BSW
	AND	(VVVVV)
	DCA	BOTCNT		/ BOTCNT=(BOTDAT -CHARACTER COUNT-)
	TAD I	FREDAT	/ [VAT]
	BSW
	AND	(VVVVV)
	DCA	FRECNT		/ FRECNT=(FREDAT -CHARACTER COUNT-)
    CDFMYF /--------------------//CDF	/
	TAD	BOTCNT	/ VVVVV
	SNA CLA
	AC0001		/ [1]	/ MEANS 'BOTINX' DATA FIELD IS INVALID
	DCA	BINVALID
	TAD	FRECNT	/ VVVVV
	SNA CLA
	AC0001		/ [1]	/ MEANS 'FRE' DATA FIELD IS INVALID
	DCA	FINVALID
/\	JMP	CKINVL

/ ** RESOLVE INVALID FIELD CONDITIONS **

/    IF THE "INVLD" FLAG WAS SET, CHECK WHICH FIELDS
/    WERE INVALID.  INVALID FIELDS ARE TREATED AS IF THEY
/    CONTAINED HIGH VALUES.  THEY GO TO THE BOTINX IN
/    ASCENDING SORTS, AND ON THE TOPINX IN DESCENDING SORTS.

/    THE COMPARISON ROUTINE WILL TAKE THE PROPER EXIT IF ONLY
/    ONE OF THE FIELDS WAS INVALID, AND IT WILL RETURN
/    IF BOTINXH WERE INVALID.  IN THIS CASE THE ELEMENTS ARE
/    IN ORDER, AND THE ROUTINE IS EXITED.

/		IF INVLD=TRUE
/		    THEN
/			DO COMPARISON	(OF 'BINVALID' VS 'FINVALID')
/			EXIT		(BOTINXH FIELDS WERE INVALID)
/
/		(FALL THROUGH TO "SET UP COMPARE LOOP COUNTER")


CKINVL,	TAD	BINVALID	/ IF INVLD=TRUE
	TAD	FINVALID
	SNA CLA			/ THEN
	JMP	SETLC		/ ELSE
	TAD	BINVALID
	CLL CIA
	TAD	FINVALID
	JMS	VALCMP		/ DO COMPARISON
	JMP I	EVAL		/ BOTH FIELS WERE INVALID

/ ** SET UP COMPARE LOOP COUNTER **

/	FIND THE LESSER OF FRECNT, BOTCNT.  THAT WILL BE THE NUMBER
/	OF CHARACTERS TO BE COMPARED.


/		CHARCT=FRECNT
/		IF BOTCNT<FRECNT
/		    THEN
/			CHARCT=BOTCNT
/
/		(FALL THROUGH TO "CHARACTER COMPARISON")

SETLC,	TAD	FRECNT
	DCA	CHARCT		/ CHARCT=FRECNT
	TAD	FRECNT		/ IF BOTCNT<FRECNT
	CIA
	TAD	BOTCNT
	SMA CLA			/ THEN, SKIP IF AC < 0
	JMP	CMPLOP		/ ELSE
	TAD	BOTCNT
	DCA	CHARCT		/ CHARCT=BOTCNT
/\	JMP	CMPLOP

/ ** CHARACTER COMPARISON **

/    UNPACK THE CHARACTERS OF THE SORT FIELD, AND COMPARE
/    UNTIL AN INEQUALITY IS FOUND, OR ONE STRING HAS BEEN
/    EXHAUSTED

/	RESET (CHRPTR, BOTDAT, FREDAT)
/
/	WHILE CHARCT>0
/		BOTCHR="UNPACK CHARACTER"(BOTINX)
/		FRECHR="UNPACK CHARACTER"(FRE)
/		DO COMPARISON		(OF BOTCHR VS FRECHR
/		CHARCT=CHARCT-1		(CHARACTERS WERE EQUAL)
/		IF CHRPTR=0
/		    THEN
/			CHRPTR=1
/		    ELSE
/			RESET (CHRPTR, BOTDAT, FREDAT)
/	(FALL THROUGH TO "COMMON EVALUATION EXITS")

CMPLOP,	ISZ	BOTDAT	/ V V
	NOP
	ISZ	FREDAT	/ V V
	NOP
	TAD	CHARCT		/ IF CHARCT > 0
	SPA SNA CLA		/ THEN, SKIP IF AC > 0
	JMP	CKEXCH		/ ELSE
    CDFFNV /--------------------//CDF	/
	TAD I	BOTDAT		/ BOTCHR="UNPACK CHARACTER"(BOTINX)
	CLL CIA
	TAD I	FREDAT		/ FRECHR="UNPACK CHARACTER"(FRE)
    CDFMYF /--------------------//CDF	/
	JMS	VALCMP		/ DO COMPARISON OF BOTCHR VS FRECHR
	AC7777		/ -1
	TAD	CHARCT
	DCA	CHARCT		/ CHARCT = CHARCT-1
	JMP	CMPLOP

/ COMPARE 2 VALUES
/  THIS ROUTINE IS USED FOR ALL COMPARISONS RELATING TO ORDER.
/ .............................................................................
/ FOR ASCENDING::		ASCDSC, SZL
/ .............................................................................
/
/		FOR INVLD FLD		FOR STRING LGTH		FOR CHARACTER
/		COMPARISON		COMPARISON		COMPARISON
/ RELATION	(VLD=0, INVLD=1)
/-----------------------------------------------------------------------------
/  A > B  |	EXCHG ELEMENTS	|	EXCHG ELEMENTS	|	EXCHG ELEMENTS
/	  |			|			|
/  A = B  |	RETURN TO RTN	|	RETURN TO RTN	|	RETURN TO RTN
/	  |			|			|
/  A < B  |	ORDER IS OK	|	ORDER IS OK	|	ORDER IS OK
/-----------------------------------------------------------------------------
/
/
/
/
/
/
/
/ .............................................................................
/ FOR DESCENDING::		ASCDSC, SNL
/ .............................................................................
/
/		FOR INVLD FLD		FOR STRING LGTH		FOR CHARACTER
/		COMPARISON		COMPARISON		COMPARISON
/ RELATION	(VLD=0, INVLD=1)
/-----------------------------------------------------------------------------
/  A < B  |	EXCHG ELEMENTS	|	EXCHG ELEMENTS	|	EXCHG ELEMENTS
/	  |			|			|
/  A = B  |	RETURN TO RTN	|	RETURN TO RTN	|	RETURN TO RTN
/	  |			|			|
/  A > B  |	ORDER IS OK	|	ORDER IS OK	|	ORDER IS OK
/-----------------------------------------------------------------------------


/ A:: IS 'BOT...'
/ B:: IS 'FRE...'


VALCMP,	XX
	SNA CLA
	JMP I	VALCMP		/ THE ELEMENTS ARE EQUAL
/...............................................................................
ASCDSC,	ZBLOCK	1		/ [ASC]ENDING = 'SZL' (7430); [DES]CENDING = 'SNL' (7420)
/...............................................................................
	JMP	EXCH		/ EXCHANGE THE ELEMENTS
	JMP I	EVAL		/ ELEMENTS ARE ORDERED

/	** COMMON EVALUATION EXITS **

/	CKEXCH-	IF THE FIELDS WERE EQUAL IN VALUE, THIS EXIT ROUTINE WILL
/		CHECK TO SEE IF THEY WERE EQUAL IN LENGTH.  DIFFERENCES IN
/		FIELD LENGTH DETERMINES ORDER.
/

CKEXCH,	TAD	BOTCNT			/ IF BOTCNT > FRECNT
	CIA; CLL
	TAD	FRECNT
	JMS	VALCMP			/ DO COMPARISON OF BOTCNT VS FRECNT
	SKP
EXCH,	AC0001				/ EXCHANGE THE ELEMENTS
	JMP I	EVAL			/ COUNTS WERE EQUAL

/ ........ FIND HIBBARD VALUE ........

/ DISTNC=DISTNC/2
/ DISTNC=DISTNC-1

FNDHIB,	XX
	TAD	DISTNC
	CLL RAR				/ DISTNC=DISTNC/2
	TAD	(-1)
	DCA	DISTNC			/ DISTNC=DISTNC-1
	JMP I	FNDHIB

	PAGE


////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////	NVFP  .PA	-	NUMERIC VALUE FIELD PARSER	\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

/ Numeric Value Field (NV) Parser

/ Subroutine to parse the <:FIELD NAME> 'value' field of a record
/  to determine its numeric (decimal) significence (and alignment)

/	IF the SELECTOR set (NVFFLAG)=7777
/	 (means <:FIELD NAME> not <FIELD NAME> was found)

/	THEN capture program control and
/	 parse the 'value' field of the record
/	  for its numeric (decimal) significence
/	   aligning [Kwhole] places to the left
/	    of the decimal point and [KFraction]
/	     places to the right of the point

/	ELSE exit with (AC) unchanged = 6-bit character at entry

/ Entry with the contents of the AC = the 6-bit character: 000000cccccc
/  FROM THE 'VALUE' FIELD OF THE RECORD
/
/ Exit from the nvfprocessor with a 'jmp i nvfprocessor'
/  (if no numeric fields specified in the specification doc)
/
/ else exit is with a 'jmp gotall'
/
/	JMS NVFPROCESSOR; return pc (if no numeric fields defined)

NVFPROCESSOR,
	XX			/
	DCA	T1NVF		/ Temporarily save the 6-bit char

/ IF THERE IS NO NUMERIC <:FN>
/  THAT MEANS THE CONTENTS OF 'FTYPE' = 0
/   THEN NO NEED TO EXECUTE THIS TEST
/ BUT IF THERE IS AT LEAST ONE <:FN>
/  THAT MEANS THE CONTENTS OF 'FTYPE' ARE NOT ZERO
/   THEN WE MUST EXECUTE THIS TEST LOOP
/    BECAUSE THE KEY # DON'T COME FROM THE INPUT DOC IN ORDER

	TAD	KEYNO
	CIA
	DCA	T2NVF
	TAD	FTYPE		/  TTT TTT TTT TTT
	SNA
	JMP	FTYPE0
	CLL RAL
	ISZ	T2NVF
	JMP	.-2
	SZL CLA
	JMP	NVFPARSE
FTYPE0,	TAD	T1NVF		/    Get back the AC at entry
	JMP I	NVFPROCESSOR	/     EXIT

/ <:FIELD NAME> was detected by the SELECTOR and (NVFFLAG) = 7777
/  therefore this 'value' field will be parsed for its decimal significence

NVFPARSE,
	TAD	(NVFBUFFER-1)	/ Holding buffer for ASCII character string
	DCA	X0		/  Auto-index register #1
	TAD	(-KWHOLE-1)
	DCA	NLCOUNT		/   left justification total (for ISZ)
	DCA	NVFJUSTIFICATION/    combined left and right justification
	DCA	NVFVAT		/     'NVF' VALUE ATTRIBUTE
	JMP	NVF1ST

/ Capture MAIN-LINE control to parse the 'value' field
/  Start the process then the first ascii character with
/   the code between 60 and 71 inclusive is detected
/  End the process when the first non-numeric character
/   is detected (except natural language characters)

IGNORE,
NEXTNVF,AC7777
	JMS	RD1VALUECHAR	/ Get a character of the 'value' field
	  JMP	E7		   /* Disk EOF should not have happened here
	  JMP	.-3		   /   ignore this non-printing character
	  JMP	NVFLAB		   /    JMP means '<' or start of '<>' detected
	  JMP	E5CLA		   /*    found '>' within value field
	  AND	P177		   /      AC=mmmmmccccccc (mask mmmmmODE bits)
	DCA	T1NVF		/  temporarily save the 7-bit character
NVF1ST,	TAD	T1NVF		/
	TAD	(-71)		/ minus ASCII numeric 9
	SMA SZA			/
	JMP	TSTNATURALS	/   JMP means character greater than ascii 9
	TAD	(11)		/ AC=-60
	SPA CLA			/
	JMP	TSTNATURALS	/   JMP means character NOT between 60-71

/ IF THE ASCII CHARACTER IS 61 THRU 71
/  THEN SET THE 'X' BIT IN THE 'NVFVAT'

	TAD	(-60)		/
	TAD	T1NVF		/
	SNA CLA			/ SKIP NEXT BECAUSE ASCII 1 THRU 9
	JMP	SAVENVF		/ JMP CAUSE ASCII 0
	TAD	NVFVAT		/
	AND	(-10-1)		/
	TAD	(10)		/ SETS THE 'X' BIT
	DCA	NVFVAT		/

/ This particular character from the 'value' field
/  is between the ASCII codes 60-71 (0-9) inclusive
/   therefore save it within the holding buffer
/    for alignment (padding within the FNV table) later

SAVENVF,AC0004			/ cannot have numbers following a ')'	/A0010
	AND	NVFVAT		/ do we have a ')' already?		/A0010
	SZA CLA								/A0010
	JMP	E12A		/ yes, means illegal placement of ')'	/A0010
	TAD	(1000)		/ cannot have numbers after trailing '-'/A0010
	AND	NVFVAT		/ is there a trailing '-'?		/A0010
	SZA CLA								/A0010
	JMP	E12B		/ yes, no numbers may follow...		/A0010
	TAD	T1NVF
	DCA I	X0		/ 'I' into the holding buffer
	ISZ	NVFJUSTIFICATION/  0-77 (will never overflow)
	ISZ	NVFCOUNT	/   +1 to the 'V'alue JUSTIFICATION total
	JMP	NEXTNVF
	JMP	E12C		/*    JMP means to many 'value' characters

/ This particular character from the 'value' field
/  is NOT between the ASCII codes 60-71 (0-9) inclusive
/   therefore test for imbedded Natural language characters:

/       - decimal point
/        - decimal comma
/         - plus sign
/          - minus sign (LEADING or TRAILING)
/           - left paren (implied minus sign)
/            - right paren
/             - space (LEADing's are ignored but IMBEDDED's are kept)
/              - decimal colon
/		- asterisk

TSTNATURALS,
	CLA			/ clean-up the AC
	TAD	(NATURALS-2)
	DCA	X1
NATLOOP,ISZ	X1
	TAD I	X1
	SNA
	JMP	E12D		/* - MEANS [0] TABLE TERMINATOR
	TAD	T1NVF
	SNA CLA
	JMP I	X1
	JMP	NATLOOP
NATURALS,
	-55; JMP AMINUS		/ minus sign
	-50; JMP ALPAREN	/ left paren
	-51; JMP ARPAREN	/ right paren
	-40; JMP ASPACE		/ space
	-53; JMP APLUS		/ plus sign
	-54; JMP IGNORE		/ (ignore ALPHA) comma
	-52; JMP IGNORE		/ (ignore ALPHA) asterisk

/ ........................................................................
/ CONDITIONALIZE the RADIX POINT and CURRENCY SYMBOL for NATURAL LANGUAGES

	-56; JMP APERIOD	/ period
	-44; JMP SPECIE		/ (ignore ALPHA) dollar sign
	-43; JMP SPECIE		/ (ignore ALPHA) pound sign		/ A20
/ ........................................................................

	0			/ TABLE TERMINATOR

	PAGE

/ A LEFT ANGLE BRACKET '<' HAS BEEN DETECTED
/  THEREFORE, ALIGN THE NUMERIC VALUE CHARACTERS
/   (BEING HELD WITHIN THE 'NVFBUFFER')
/     FOR DECIMAL SIGNIFICENCE
/     (PACK AS 6-BIT) INCLUDING LEADING AND TRAILING ZEROS IF APPLICABLE

NVFLAB, AC6000			/ CHECK FOR ')' FOLLOWING A '('		/A0010
	AND	NVFVAT		/ DO WE HAVE A '('?			/A0010
	TAD	(-6000)							/A0010
	SZA CLA								/A0010
	JMP	NVFL1		/ NO...					/A0010
	AC0004			/ YES, DO WE HAVE A MATCHING ')' ?	/A0010
	AND	NVFVAT							/A0010
	SNA CLA								/A0010
	JMP 	E12E		/ NO, UNMATCHED PARENS.			/A0010
NVFL1,	AC7776			/ COUNT OF -2
	DCA	VALCOUNT	/ USED FOR 6-BIT PACKING
	TAD	(NVFBUFFER-1)	/ ADDRESS-1 OF THE NVFBUFFER
	DCA	X0		/ AUTO-INDEX REGISTER
	TAD	NVFJUSTIFICATION/ LLLLLLRRRRRR
	SNA CLA			/ SKIP NEXT IF NO DIGITS 'LEFT OF' OR 'RIGHT OF'
	JMP	GOTALL		/ EXIT BECAUSE A 'BLANK' VALUE FIELD
	AC0001
	AND	NVFVAT
	SZA CLA
	JMP	.+4
	TAD	NVFJUSTIFICATION
	BSW
	DCA	NVFJUSTIFICATION
	TAD	NVFVAT		/ (N)UMERIC (V)ALUE (F)IELD (AT)TRIBUTE
	SPA CLA			/ SKIP NEXT IF + SIGN
	AC7776			/ THE DECIMAL SIGNIFICENCE IS NEGATIVE	/M0010
	TAD	(53)		/ THE DECIMAL SIGNIFICENCE IS POSITIVE
	JMS	NVFPACK		/ STUFF SIGN (- OR +) INTO (FNV)TABLE
	TAD	NVFJUSTIFICATION/ LLLLLLRRRRRR (L-LEFT OF, R-RIGHT OF)
	BSW			/ RRRRRRLLLLLL
	AND	P77		/ ACTUAL # DIGITS 'LEFT OF DECIMAL POINT'
	TAD	(-KWHOLE)	/ MAXIMUM # PLACES ALLOWED TO THE LEFT
	SZA			/ (AC) = DIFFERENCE BETWEEN ACTUAL AND MAXIMUM
	JMS	NVFPADZEROS	/ PAD LEADING 0'S (CAUSE ACTUAL LESS THAN MAX)
	TAD	NVFJUSTIFICATION/ LLLLLLRRRRRR
	BSW			/ RRRRRRLLLLLL
	AND	P77
	CIA			/ 2'S COMP OF ACTUAL # DIGITS 'LEFT OF'
	SZA			/ SKIP NEXT IF NO DIGITS LEFT OF DECIMAL POINT
	JMS	NVFFILL		/ STUFF THOSE DIGITS INTO THE (FNV)TABLE
/--	TAD	(KPERIOD)	/------
/--	JMS	NVFPACK		/------
	TAD	NVFJUSTIFICATION/ LLLLLLRRRRRR
	AND	P77		/ ACTUAL # DIGITS 'RIGHT OF DECIMAL POINT'
	CIA			/ 2'S COMP OF THAT NUMBER
	SZA			/ SKIP NEXT IF NO DIGITS 'RIGHT OF'
	JMS	NVFFILL		/ STUFF THOSE DIGITS INTO THE (FNV)TABLE
	TAD	NVFJUSTIFICATION/ LLLLLLRRRRRR
	AND	P77		/ ACTUAL # 'RIGHT OF'
	TAD	(-KFRACTION)	/ MAXIMUM # PLACES ALLOWED TO THE RIGHT
	SZA			/ SKIP NEXT IF ACTUAL=MAXIMUM
	JMS	NVFPADZEROS	/ PAD TRAILING 0'S (CAUSE ACTUAL LESS THAN MAX)
	JMP	GOTALL		/ EXIT

/ NVF SUBROUTINE to 'FIX' (correct by 9's complementing)		/A011
/  THE VALUE OF THE NUMERIC FIELD					/A011
/   (IF THE DECIMAL SIGNIFICENCE IS negative)				/A011
/    enabling negative value fields to sort algebraically		/A011
/									/A011
/		-9999.99						/A011
/		- 999.99						/A011
/		-  99.99						/A011
/		-   9.99						/A011
/		-    .99						/A011
/		-    .9							/A011
/		+    .99						/A011
/									/A011
/ BUT if the 'X' bit (within the NVFVAT = 0) is 0			/A011
/  then the nvf (numeric value field) is all zeros			/A011
/   so don't fix							/A011
/									/A011
NVFFIX,	XX			/					/A011
/									/A011
/ ENTER WITH THE AC = 6-BIT ASCII CHARACTER				/A011
/  IN THE RANGE OF 60 TO 71						/A011
/									/A011
	DCA	T1FIX		/ save the character (temporarily)	/A011
	TAD	NVFVAT		/ get the value attributes		/A011
	AND	(10)		/ mask the 'X' bit			/a011
	SNA CLA			/ skip next if 'X' bit set		/a011
	JMP	NVFNOFIX	/ jmp cause the nvf=00000000.000	/a011
	TAD	NVFVAT		/ get the attributes again		/a011
	SMA CLA			/ skip next if negative value		/a011
	JMP	NVFNOFIX	/ jmp cause the nvf is positive		/a011
	TAD	T1FIX		/ get back the 6-bit ascii at entry	/a011
	TAD	(-71)	/ -9	/ ... 9'S				/A011
	CIA			/ ... COMPLE-				/A011
	TAD	(60)	/ 0	/ ... MENT				/A011
	JMP I	NVFFIX		/ EXIT with the ac=1's compliment value	/a011
NVFNOFIX,
	TAD	T1FIX		/ get back the character at entry	/a011
	JMP I	NVFFIX		/ EXIT without complimenting		/a011

T1FIX,	ZBLOCK	1		/ holds the 6-bit temporarily		/a011

/ NVF SUBROUTINE TO PRECEED OR POSTCEED
/  (PAD) THE DECIMAL VALUE WITH LEADING OR TRAILING 0'S

NVFPADZEROS,	XX		/ ENTER WITH (AC) = 2'S COMP # OF PLACES TO PAD
	DCA	T1NVF		/ SAVE THAT 2'S COMP # FOR 'ISZ T1NVF' LATER
	TAD	(60)		/ ASCII ZERO (0)
	JMS	NVFFIX		/ FIX THE VALUE FOR NEGATIVE nvf's	/a011
	JMS	NVFPACK		/ 6-BIT PACK IT
	ISZ	T1NVF		/  UPDATE THE COUNT
	JMP	.-4		/   UNTIL (T1NVF) = 0
	JMP I	NVFPADZEROS	/ EXIT (PADDING COMPLETE)

/ NVF SUBROUTINE TO
/  TRANSFER THE 'LLLLLL' DIGITS TO THE LEFT OF THE DECIMAL POINT
/   (UNTIL THE CONTENTS OF PROGRAM LOCATION 'T1NVF'=0)
/    OR TO TRANSFER THE 'RRRRRR' DIGITS TO THE RIGHT OF THE DECIMAL POINT
/     (UNTIL THE CONTENTS OF PROGRAM LOCATION 'T1NVF'=0)

NVFFILL,	XX		/ ENTER WITH (AC) = 2'S COMP # OF DIGITS TO FILL
	DCA	T1NVF		/ SAVE FOR 'ISZ T1NVF' LATER
	TAD I	X0		/ 'LEFT' OR 'RIGHT' PLACED DIGITS
	JMS	NVFFIX		/ FIX THE VALUE FOR NEGATIVE nvf's	/a011
	JMS	NVFPACK		/ 6-BIT PACK EM
	ISZ	T1NVF		/  UPDATE THE COUNT
	JMP	.-4		/   UNTIL (T1NVF)=0
	JMP I	NVFFILL		/ DONE

/ NVF SUBROUTINE TO
/  STUFF THE CONTENTS OF THE AC (000000CCCCCC)
/   INTO THE (FNV)TABLE AS 6-BIT 'TEXT'

NVFPACK,XX			/ ENTER WITH THE (AC) = 6-BIT CHAR TO PACK
	ISZ	VALCOUNT	/ SKIP NEXT WHEN 2 CHAR'S READY FOR PACKING
	JMP	.+5		/ JMP MEANS POSITION 1ST OF 2 CHAR'S FOR PACKING
	TAD	PACK6BIT	/ PACK THIS 2ND CHAR WITH THE 1ST
	DCAFNV			/ STUFF INTO THE (FNV)TABLE
	AC7776			/ -2
	DCA	VALCOUNT	/ RESET THE COUNTER
	BSW			/ BSW MEANS POSITION THIS 1ST CHAR FOR PACKING
	DCA	PACK6BIT
	JMP I	NVFPACK

	PAGE

/ The character is a LEFT PAREN '('

ALPAREN,TAD	NVFJUSTIFICATION
	SZA CLA
	JMP	E12F		/* - means ILLEGAL PLACEMENT of '('
	AC6000
	AND	NVFVAT
	SZA CLA
	JMP	E12G		/* - means a '+' or '-' PRECEEDED '('
	AC6000
	JMP	SETNVF

/ The character is a RIGHT PAREN ')'

ARPAREN,AC6000
	AND	NVFVAT
	TAD	(-6000)
	SZA CLA
	JMP	E12H		/* - means no '(' before ')'
	TAD	NVFJUSTIFICATION
	SNA CLA
	JMP	E12I		/* - means '()'
	AC0004
	AND	NVFVAT
	SZA CLA
	JMP	E12J		/* - means extra ')'
	AC0004
	JMP	SETNVF


/ The character is a PLUS SIGN

/*E12 - means syntax error for extra (or illegal placement of) '+'

APLUS,  TAD	NVFJUSTIFICATION					/A0010
	SZA CLA								/A0010
	JMP	E12K		/* - means illegal placement of '+'     /A0010
	AC0002								/A0010
	AND	NVFVAT							/A0010
	SZA CLA								/A0010
	JMP	E12K		/* - means illegal placement of '+'     /A0010
	AC2000
	JMP	MINUS2							/M0010

/ The character is a MINUS SIGN

/*E12 - means syntax error for extra (or illegal placement of) '-'

AMINUS, TAD	NVFJUSTIFICATION/ |if NOT the first character		/A0010
	SZA CLA			/ |then					/A0010
	JMP	MINUS1		/ |    go set trailing '-' bit		/A0010
	AC0002			/ |else					/A0010
	AND	NVFVAT		/ |    |if previous '$'			/A0010
	SZA CLA			/ |    |then				/A0010
	JMP	E12B		/ |    |    illegal placement of '-'    /A0010
				/ |    |else				/A0010
	AC4000			/ |    |    set '-' sign bit		/A0010
	SKP			/					/A0010
MINUS1,	TAD	(5000)		/ set trailing '-' bit			/A0010
/ ..........................................................................
MINUS2,	MQL
/ ..........................................................................
	CLA								/A0010
	TAD	(7000)		/ check for previous SIGN		/M0010
	AND	NVFVAT
	SZA CLA
	JMP	E12L		/* - means extra SIGN found
/ ..........................................................................
	CLA MQA			/ 2000; or 4000
/ ..........................................................................
SETNVF,	TAD	NVFVAT
	DCA	NVFVAT
	JMP	NEXTNVF

/ The character is a CURRENCY SYMBOL

/ [conditionalized for natural languages]

SPECIE,	AC0002
	AND	NVFVAT
	SZA CLA
	JMP	E12M		/* - means extra currency (money) symbol
	TAD	NVFJUSTIFICATION					/A0010
	SZA CLA								/A0010
	JMP	E12N		/* - means illegal placement of '$'     /A0010
/	AC6000								/D0010
/	AND	NVFVAT							/D0010
/	SNA CLA								/D0010
/	JMP	E12		/* - means no 'sign' before symbol      /D0010
	AC0002
	JMP	SETNVF

/ The character is a SPACE ' '

ASPACE,	TAD	NVFJUSTIFICATION
	SNA CLA
	JMP	IGNORE		/ LEADING SPACE
/\	JMP	NVFEND		/ IMBEDDED SPACE TERMINATES NUMBER

/ This is the END of the numeric value field parse
/  IGNORE all characters until the next left angle bracket '<'

NVFEND,	AC7777
	JMS	RD1VALUECHAR	/ Get a character of the 'value' field
	  JMP	E7		   /* Disk EOF should not have happened here
	  JMP	.-3		   /   ignore this non-printing character
	  JMP	NVFLAB		   /    JMP means '<' or start of '<>' detected
	  JMP	E5CLA		   /*    found '>' within value field
	  JMP	.-6		   /      ignore this printable character

/ The character is a DECIMAL POINT '.' [RADIX SEPERATOR]

/*E12 - means syntax error for extra '.' (or illegal placement)

APERIOD,AC0001
	AND	NVFVAT
	SZA CLA
	JMP	E12P		/* - means extra '.' found
	ISZ	NVFVAT		/ set decimal point found indicator
	TAD	(-KWHOLE)
	TAD	NVFJUSTIFICATION
	TAD	(KFRACTION)
	SPA
	CLA
	TAD	(-KFRACTION-1)
	DCA	NRCOUNT
	TAD	NVFJUSTIFICATION
	BSW
	DCA	NVFJUSTIFICATION
	JMP	NEXTNVF

T1NVF,	ZBLOCK	1		/ TEMPorary holding register

/ .............................................................................
KWHOLE=		15		/ UP TO 13(10) places LEFT of DECIMAL
KFRACTION=	06		/ UP TO places RIGHT of DECIMAL
/ .............................................................................

/ HOLDing buffer for NUMERIC VALUE characters

/		SIGN, LLLLLL, RRRRRR, (-1) SLUSH
NVFBUFFER,ZBLOCK 1+KWHOLE+KFRACTION+1

				/
				/
				/
				/
				/
T2NVF,
NLCOUNT,
NRCOUNT,
NVFCOUNT,	-KWHOLE-1	/ then -KFRACTION-1

NVFJUSTIFICATION, 0		/ LLLLLL RRRRRR
NVFVAT,		ZBLOCK 1	/ S S S -  -  -  -  -  X R C D
				/______________________________
				/ 0 0 0 - (IMPLIED+)\  | | | |
				/ 0 1 0 - PLUS sign \  | | | 1	- DECIMAL POINT found
				/ 1 0 0 - MINUS sign\  | | 1	- CURRENCY SYMBOL found
				/		       | 1	- RIGHT PAREN found
				/		       0	- nvf=000.000
				/ 1 1 0 - LEFT PAREN\
				/    (implied MINUS)\
				/ 1 0 1 - trailing  \			/A0010
				/	       MINUS\			/A0010

	PAGE

////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////		WPSRTX.PA	-	TEXT       		\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////								\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\











/ THE SCREEN SIZE IS 24 LINES X 80 COLUMNS

/	* COLUMNS 0 THRU 79:
/	*
/	*0	   10	     20        30	 40	   50	     60	       70
/	*!	   !	     !	       !	 !	   !	     !	       !
/ LINES	*01234567890*********01234567890*********0*********0*********0*********0*********
/ 0-23:0							     DATE/TIME
/      1      X - INFORMATION LEFT BY SORT PARSER AND MENUS
/      2      X - INFORMATION LEFT BY SORT PARSER AND MENUS
/      3      X - INFORMATION LEFT BY SORT PARSER AND MENUS
/      4      X - INFORMATION LEFT BY SORT PARSER AND MENUS
/      5      BLANK LINE
/      6      Primary Key Records:  X OUT OF Y
/      7      Multiple ruler warning
/      8      Records output: Z
/      9      BLANK LINE
/     10 --------- OR, WORKING, PAUSED, ABORTED, DONE
/     11 --ERROR-- M1, THRU...
/     12 ---------
/     13      BLANK LINE
/      * ????????	LINES #14 THRU #21
/      * ????????	CONTAINS UP TO 7 LINES
/      * ????????	OF INFORMATION
/      * ????????	FROM THE LIST DOCUMENT
/      * ????????	IF AN ERROR WAS DETECTED
/      * ????????	WITHIN THE SELECTOR
/      * ????????	OR THE OUTPUT DOCUMENT GENERATOR
/     21      BLANK LINE
/     22    Press RETURN to continue, or
/     23    Press Gold MENU to return to MAIN MENU




/	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
/	!!!!!!!!                   !!!!!!!!
/	!!!!!!!!  TEXT FOR OUTPUT  !!!!!!!!
/	!!!!!!!!  TO THE SCREEN    !!!!!!!!
/	!!!!!!!!                   !!!!!!!!
/	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

		     / 1205		1600
MPROCESSING,	
IFDEF ENGLSH <	TEXT '^P^E&WORKING^P'				/M002
>/END ENGLSH							/A002
IFDEF ITALIAN < TEXT /^P^E&IN &CORSO/ >
IFDEF V30NOR  < TEXT '^P^E&AKTIV^P'>
IFDEF V30SWE  < TEXT '^P^E&BEARBETAR^P'>
IFDEF DUTCH   < TEXT '^P^E&BEZIG...^P'>
IFDEF SPANISH < TEXT '^P^E&TRABAJANDO^P'>

		     / 1220 (OCTAL)   1600
MSRWAIT,
IFDEF ENGLSH <	TEXT '^P - &PLEASE WAIT^P'			/M002
>/END ENGLSH							/A002
IFDEF ITALIAN < TEXT /^P - &PREGO ATTENDERE.../ >
IFDEF V30NOR < TEXT '^P - &VENT'>
IFDEF V30SWE < TEXT '^P - V\DNTA EN STUND^P'>
IFDEF DUTCH  < TEXT '^P - &EVEN GEDULD.^P'>
IFDEF SPANISH < TEXT '^P - &ESPERE^P'>


		     / 0605				1600
MSUMMARY,

IFDEF ENGLSH <	TEXT '^P&PRIMARY &KEY &RECORDS: ^L!D OUT OF !D^P'	/M002-MJS
>/END ENGLSH
IFDEF ITALIAN < TEXT /^P &CHIAVI &PRIMARIE: ^L!D DI !D^P/
>
IFDEF V30NOR < TEXT '^PPOSTER UTVALGT ETTER PRIM\FRN\XKKEL: ^L!D AV !D^P'>
IFDEF V30SWE < TEXT '^P&PRIM\DRA F\DLT MED SORTERINGSNYCKLAR: ^L!D AV !D'>
IFDEF DUTCH  < TEXT '^P&GESELECTEERDE GEGEVENSGROEPEN: ^L!D UIT !D^P'>
IFDEF SPANISH < TEXT '^P&REGISTROS &TECLA &PRIMARIA: ^L!D FUERA DE !D^P'>


		     / 1005			1600
MODG,
IFDEF ENGLSH <	TEXT '^P&RECORDS &REPRODUCED: ^L^D^P'		/M002
>/END ENGLSH							/A002
IFDEF ITALIAN < TEXT /^P&RECORDS &COPIATI: ^L^D^P/ 
>
IFDEF V30NOR < TEXT '^P&RECORD &REPRODUCED: ^L^D^P'>
IFDEF V30SWE < TEXT '^P&ANV\DNDA POSTER: ^L^D^P'>
IFDEF DUTCH  < TEXT '^P&VERWERKTE GEGEVENSGROEPEN: ^L^D^P'>
IFDEF SPANISH <TEXT '^P&REPRODUCCI\SN(ES) CONJUNTO(S): ^L^D^P'>
		     / 2603
MREPLACE,
IFDEF ENGLSH <	TEXT '^P^L-&REPLACE SYSTEM DISKETTE, THEN'	/M002
>/END ENGLSH							/A002
IFDEF ITALIAN < TEXT /^P^L-&INSERIRE IL DISCO SISTEMA,/ 
>
IFDEF V30NOR < TEXT '^P^L-&SETT SYSTEMDISKETTEN TILBAKE OG'>
IFDEF V30SWE < TEXT '^P^L-&S\DTT TILLBAKA SYSTEMDISETTEN OCH'>
IFDEF DUTCH < TEXT '^P^L-&ZET SYSTEEMDISKETTE TERUG.'>
IFDEF SPANISH <TEXT '^P^L-&CAMBIE DISKETTE SSISTEMA, LUEGO'>


		     / 1205
MSRDONE,
IFDEF ENGLSH <	TEXT '^P^E&DONE'				/M002
>/END ENGLSH							/A002
IFDEF ITALIAN < TEXT /^P^E&FINE/ 
>
IFDEF V30NOR < TEXT '^P^E&UTF\XRT'>
IFDEF V30SWE < TEXT '^P^E&F\DRDIGT'>
IFDEF DUTCH < TEXT '^P^E&KLAAR!!'>
IFDEF SPANISH <TEXT '^P^E&CUMPLIDO'>

		     / 1205
MSRABORTED,
IFDEF ENGLSH <	TEXT '^P^E&ABORTED'				/M002
>/END ENGLSH							/A002
IFDEF ITALIAN < TEXT /^P^E&INTERRUZIONE/ 
>
IFDEF V30NOR < TEXT '^P^E&AVBRUTT'>
IFDEF V30SWE < TEXT '^P^E&AVBRUTEN'>
IFDEF DUTCH < TEXT '^P^EAFGEBROKEN'>
IFDEF SPANISH <TEXT '^P^EABORTADO'>


IFDEF ENGLSH <							/A002
		     / 1205
MSRPAUSED,
	TEXT '^P^L&PAUSED '
	   *.-1
		     / 2603
		TEXT '^P-&PRESS &R&E&T&U&R&N TO CONTINUE, OR '
	   *.-1
		     / 2703
MGOLD,		TEXT '^P-&PRESS &GOLD &M&E&N&U TO RECALL THE &MAIN &MENU.'
>/END ENGLSH							/A002

IFDEF ITALIAN < 
MSRPAUSED,
	TEXT '^P^L&SOSPENSIONE '
	   *.-1
		     / 2603
		TEXT '^P-&PREMERE !&RITORNO PER CONTINUARE '
	   *.-1
		     / 2703
MGOLD,		
TEXT '^P-&PREMERE &ORO !&MENU PER RICHIAMARE IL &MENU &PRINCIPALE.'
>

IFDEF V30NOR <							/A002
		     / 1205
MSRPAUSED,
	TEXT '^P^L&MIDLERTIDIG STANS'
	   *.-1
		     / 2603
		TEXT '^P-&TRYKK P\E !&RETUR FOR \E FORTSETTE EL.'
	   *.-1
		     / 2703
MGOLD,		TEXT '^P-&TRYKK P\E &GULL !&MENY FOR \E F\E &HOVEDMENYEN.'
>/END V30NOR							/A002

IFDEF V30SWE <
MSRPAUSED,
	TEXT '^P^L&PAUS '
	   *.-1
		     / 2603
		TEXT '^P-&TRYCK P\E RETUR F\VR ATT FORTS\DTTA '
	   *.-1
		     / 2703
MGOLD,		TEXT '^P-&TILLBAKA TILL HUVUDMENYN: ANV\DND GULD MENY'
>/END V30SWE							/A002

IFDEF DUTCH <
MSRPAUSED,
	TEXT '^P^L&ONDERBROKEN'
	   *.-1
		     / 2603
		TEXT '^P-&DRUK OP !&RETURN OM VERDER TE GAAN. '
	   *.-1
		     / 2703
MGOLD,	TEXT '^P-&DRUK OP &GOUD !&MENU OM TERUG TE GAAN NAAR HET &HOOFDMENU.'
>
IFDEF SPANISH <
MSRPAUSED,
	TEXT '^P^L&PAUSA'
	   *.-1
		     / 2603
		TEXT '^P-&PULSE !& RETORNO PARA CONTINUAR, O'
	   *.-1
		     / 2703
MGOLD,	TEXT '^P-&PULSE &DORADA !&MENU PARA VOLVER AL &MEN\Z &PRINCIPAL.'
>

		     / 0705
MULTIRULERERR,
IFDEF ENGLSH <		TEXT '^P^L&WARNING - &LIST CONTAINS MULTIPLE RULERS'
>/END ENGLSH							/A002
IFDEF ITALIAN < TEXT /^P^L&ATTENZIONE - &PI\Y DI UN DESCRITTORE RIGA/ >

IFDEF V30NOR <
	TEXT '^P^L&ADVARSEL - &LISTEN INNEHOLDER FLERE FORMATERINGSLINJER'>
IFDEF V30SWE <
	TEXT '^P^L!&VARNING! - &REGISTRET INNEH\ELLER FLERA LINJALER'>
IFDEF DUTCH <
	TEXT '^P^L!&OPGELET - &BESTAND  HEEFT MEER DAN EEN REGELINDELING'>
IFDEF SPANISH <
	TEXT '^P^L!&ADVERTENCIA - &LA LISTA CONTIENE REGLAS M\ZLTIPLES'>


/	---------
/	--ERROR-- THE TEXT OF A SPECIFIC ERROR HERE.
/	---------

IFDEF ENGLSH <								/A002
		/1200		1300		1400	1600
MERROR,	TEXT	'^P^E---------^P--&E&R&R&O&R--&!S^P---------^P'
>/END ENGLSH
IFDEF ITALIAN <								/A002
		/1200		 1300	       1400	     1600
MERROR,	TEXT	'^P^E----------^P--!&ERRORE--&!S^P----------^P'
>
IFDEF V30NOR <
MERROR, TEXT    '^P^E----------^P--!&FEIL--&!S^P------------^P'
>
IFDEF V30SWE <
MERROR, TEXT	'^P^E----------^P--!&FEL--&!S^P-------------^P'
>
IFDEF DUTCH <								/A002
		/1200		1300		1400	1600
MERROR,	TEXT	'^P^E^P!&FOUT:&!S^P^P.'
>/END ENGLSH
IFDEF SPANISH <								/A002
		/1200		1300		1400	1600
MERROR,	TEXT	'^P^E---------^P--!&ERROR--&!S^P---------^P'
>/END ENGLSH




EMESTABLE,
	ME0	/ RECORD EXCEEDS 2500 CHARACTERS
/\	ME1	/ NONE
	ME2	/ FIELD NAME MISSING '<' OR TEXT BETWEEN RECORDS
	ME3	/ FIELD NAME CONTAINS EXTRA '<'
	ME4	/ FIELD NAME EXCEEDS 30 CHARACTERS
	ME5	/ KEY VALUE FIELD CONTAINS '>'
	ME6	/ RECORD CONTAINS DUPLICATE KEY
	ME7	/ LIST NOT TERMINATED WITH '<>'
	ME8	/ UNEXPECTED END OF FILE
	ME9	/ LIST CONTAINS ONLY TEXT
	ME10	/ PRIMARY KEY NOT FOUND
	ME11	/ TO MANY KEYS DEFINED
		/ (THIS IS A DEVELOPMENT ERROR MESSAGE)
		/ (WHICH THE END USER SHOULD NEVER SEE)
	ME12	/ INVALID NUMERIC SYNTAX
/	ME12A	/ INCORRECT PLACEMENT OF RIGHT PAREN ')'
/	ME12B	/ INCORRECT PLACEMT OF MINUS SIGN '-'
/	ME12C	/ TO MANY NUMERIC VALUE FIELD CHARACTERS
/	ME12D	/ UNKNOWN CHARACTER
/	ME12E	/ NO ')' AFTER '('
/	ME12F	/ INCORRECT PLACEMENT OF LEFT PAREN '('
/	ME12G	/ '+' OR '-' PRECEEDED '('
/	ME12H	/ NO '(' BEFORE ')'
/	ME12I	/ '()' DETECTED
/	ME12J	/ 'EXTRA ')' FOUND
/	ME12K	/ INCORRECT PLACEMENT OF PLUS SIGN '+'
/	ME12L	/ EXTRA SIGN (+ OR - OR IMPLIED MINUS) FOUND
/	ME12M	/ EXTRA CURRENCY SYMBOL FOUND
/	ME12N	/ INCORRECT PLACEMENT OF CURRENCY SYMBOL
/	ME12P	/ EXTRA RADIX POINT '.' FOUND
	ME13	/ output document diskette full				/a0014
	ME13A	/ OUTPUT DOCUMENT VOLUME FULL			/A018


ME0,
IFDEF ENGLSH <							/A002
	TEXT	\RECORD EXCEEDS 2500 CHARACTERS\
>/END ENGLSH							/A002
IFDEF ITALIAN < 
	TEXT /RECORD SUPERA 2500 CARATTERI/ >
IFDEF V30NOR <
	TEXT 'POST OVER 2500 TEGN'>
IFDEF V30SWE <
	TEXT '&POSTEN BEST\ER AV MER \DN 2500 TECKEN'>
IFDEF DUTCH <							/A002
	TEXT	\MEER DAN 2500 TEKENS IN GEGEVENSGROEP\
>/END DUTCH							/A002
IFDEF SPANISH <							/A002
	TEXT	'REGISTRO CON M\AS DE 2500 CARACTERES\
>/END SPANISH							/A002


ME2,
IFDEF ENGLSH <							/A002
	TEXT "FIELD NAME MISSING '"
	*.-1							/A001
	7447	/OPEN BRACKET,QUOTE				/A001
	TEXT	\ OR TEXT BETWEEN RECORDS\			/A001
>/END ENGLSH							/A002
IFDEF ITALIAN < 
	TEXT /MANCA CAMPO NOME '/
	*.-1
	7447
	TEXT / O TESTO TRA RECORDS/
 >
IFDEF V30NOR <							/A002
	TEXT	\FELTNAVN MANGLER '\				/M001
	*.-1							/A001
	7447	/OPEN BRACKET,QUOTE				/A001
	TEXT	\ EL. TEKST MELLOM POSTER\			/A001
>/END V30NOR							/A002
IFDEF V30SWE <							/A002
	TEXT	"&ETT F\DLTNAMN SAKNAS '"				/M001
	*.-1							/A001
	7447	/OPEN BRACKET,QUOTE				/A001
	TEXT	' ELLER OCKS\E HAR DU SKRIVIT TEXT MELLAN POSTERNA'	/A001
>/END V30SWE							/A002

	IFDEF DUTCH <
	TEXT	\ONTBREKENDE \				/M001
	*.-1
	4774
		TEXT /' OF TEKST TUSSEN GEGEVENSGROEPEN/
	>
	IFDEF SPANISH <						/A002
	TEXT "FALTA NOMBRE DE CAMPO '"
	*.-1							/A001
	7447	/OPEN BRACKET,QUOTE				/A001
	TEXT	\ O TEXTO ENTRE REGISTROS\			/A001
	>/END SPANISH						/A002
	

ME3,
IFDEF ENGLSH <							/A002
	TEXT	\FIELD NAME CONTAINS EXTRA \			/A001
	*.-1							/A001
	4774	/QUOTE,OPEN BRACKET				/A001
 	TEXT 	\'\						/A001
>/END ENGLSH							/A002
IFDEF ITALIAN < 
	TEXT /CAMPO NOME CONTIENE /
	*.-1
	4774
	TEXT	/'/
>
IFDEF V30NOR <							/A002
	TEXT	\FELTNAVN INNEHOLDER EKSTRA  \			/A001
	*.-1							/A001
	4774	/QUOTE,OPEN BRACKET				/A001
	TEXT 	\'\						/A001
>/END V30NOR							/A002
IFDEF V30SWE <							/A002
	TEXT	\&ETT F\DLTNAMN INNEH\ELLER EXTRA  \		/A001
	*.-1							/A001
	4774	/QUOTE,OPEN BRACKET				/A001
	TEXT 	\'\						/A001
>/END V30SWE							/A002
	IFDEF DUTCH <						/A002
	TEXT	\OVERBODIGE '\			/A001
	*.-1							/A001
	7447	/QUOTE,OPEN BRACKET				/A001
 	TEXT 	\ IN VELDNAAM\					/A001
	>/END DUTCH						/A002
	IFDEF SPANISH <						/A002
	TEXT	\NOMBRE DE CAMPO CONTIENE EXTRA \		/A001
	*.-1							/A001
	4774	/QUOTE,OPEN BRACKET				/A001
 	TEXT 	\'\						/A001
	>/END SPANISH						/A002

ME4,	
IFDEF ENGLSH <							/A002
	TEXT	\FIELD NAME EXCEEDS 30 CHARACTERS\
>/END ENGLSH							/A002
IFDEF ITALIAN < 
	TEXT /CAMPO NOME SUPERA 30 CARATTERI/ 
>
IFDEF V30NOR <							/A002
	TEXT	\FELTNAVN OVER 30 TEGN \
>/END V30NOR							/A002
IFDEF V30SWE <
	TEXT	'&F\DLTNAMNET BEST\ER AV MER \DN 30 TECKEN'>
IFDEF DUTCH <							/A002
	TEXT	\MEER DAN 30 TEKENS IN VELDNAAM\
>/END DUTCH							/A002
IFDEF SPANISH <							/A002
	TEXT	\NOMBRE DE CAMPO EXCEDE 30 CARACTERES\
>/END SPANISH							/A002

ME5,
IFDEF ENGLSH <							/A002
	TEXT	\KEY VALUE FIELD CONTAINS '\			/M001
	*.-1							/A001
	7647	/CLOSE BRACKET,QUOTE				/A001
	0000	/ZERO WORD TO END TEXT				/A001
>/END ENGLSH							/A002
IFDEF ITALIAN < 
	TEXT /CHIAVE CAMPO VALORE CONTIENE /
	*.-1
	7647
	0000 
>
IFDEF V30NOR <							/A002
	TEXT	"N\XKKELFELTET INNEHOLDER '"			/M001
	*.-1							/A001
	7647	/CLOSE BRACKET,QUOTE				/A001
	0000	/ZERO WORD TO END TEXT				/A001
>/END V30NOR							/A002
IFDEF V30SWE <							/A002
	TEXT	"&F\DLTET MED V\DRDEN F\VR SORTERINGSNYCKEL INNEH\ELLER  '" /M001
	*.-1							/A001
	7647	/CLOSE BRACKET,QUOTE				/A001
	0000	/ZERO WORD TO END TEXT				/A001
>/END V30SWE							/A002
IFDEF DUTCH <							/A002
	TEXT	\OVERBODIGE '\			/M001
	*.-1							/A001
	7647	/CLOSE BRACKET,QUOTE				/A001
	0000	/ZERO WORD TO END TEXT				/A001
>/END DUTCH							/A002
IFDEF SPANISH <							/A002
	TEXT	\CLAVE VALOR CAMPO CONTIENE '\			/M001
	*.-1							/A001
	7647	/CLOSE BRACKET,QUOTE				/A001
	0000	/ZERO WORD TO END TEXT				/A001
>/END SPANISH							/A002

ME6,
IFDEF ENGLSH <							/A002
	TEXT	\RECORD CONTAINS DUPLICATE KEY\
>/END ENGLSH							/A002
IFDEF ITALIAN < 
	TEXT /RECORD CONTIENE CHIAVE DUPLICATA/ 
>
IFDEF V30NOR <							/A002
	TEXT	"POST HAR TO N\XKKELFELTER"
>/END V30NOR							/A002
IFDEF V30SWE <
	TEXT '&POSTERN INNEH\ELLER IDENTISKA SORTRINGSNYCKLAR'>
IFDEF DUTCH <							/A002
	TEXT	\DUBBELE VELDNAAM IN GEGEVENSGROEP\
>/END DUTCH							/A002
IFDEF SPANISH <							/A002
	TEXT	\REGISTRO CONTIENE CLAVE DUPLICADA\
>/END SPANISH							/A002

ME7,
IFDEF ENGLSH <							/A002
	TEXT	\LIST NOT TERMINATED WITH '\			/A001
	*.-1							/A001
	7476	/OPEN BRACKET,CLOSE BRACKET			/A001
	TEXT	\'\						/A001
>/END ENGLSH							/A002

IFDEF ITALIAN < 
	TEXT /LISTA NON TERMINA CON '/
	*.-1
	7476
	TEXT /'/ 
>
IFDEF V30NOR <							/A002
	TEXT	"LISTE ER IKKE AVSLUTTET MED  '"		/A001
	*.-1							/A001
	7476	/OPEN BRACKET,CLOSE BRACKET			/A001
	TEXT	\'\						/A001
>/END V30NOR							/A002
IFDEF V30SWE <
	TEXT	\&REGISTERDOKUMENTET SLUTAR INTE MED '\		/A001
	*.-1							/A001
	7476	/OPEN BRACKET,CLOSE BRACKET			/A001
	TEXT	\'\						/A001
>/END V30SWE							/A002
IFDEF DUTCH <							/A002
	TEXT	\BESTAND NIET AFGESLOTEN MET  '\		/A001
	*.-1							/A001
	4774	/OPEN BRACKET,CLOSE BRACKET			/A001
	7647
	0000
>/END DUTCH							/A002
IFDEF SPANISH <							/A002
	TEXT	\LISTA NO TERMINA CON  '\			/A001
	*.-1							/A001
	7476	/OPEN BRACKET,CLOSE BRACKET			/A001
	TEXT	\'\						/A001
>/END SPANISH							/A002



ME8,	
IFDEF ENGLSH <							/A002
	TEXT	\UNEXPECTED END OF FILE\
>/END ENGLSH							/A002
IFDEF ITALIAN < 
	TEXT /FINE DEL DOCUMENTO INATTESA/ 
>
IFDEF V30NOR <							/A002
	TEXT	'UVENTET SLUTT P\E FIL'
>/END V30NOR							/A002
IFDEF V30SWE <
	TEXT '&DOKUMENTET HAR FELAKTIGT "!&SLUT"-KOMMANDO'>
	IFDEF DUTCH <	
	TEXT	\ONVERWACHT EINDE VAN BESTAND\ >/END DUTCH			/A002
IFDEF SPANISH <							/A002
	TEXT	'T\IRMINO DE FICHERO INESPERADO'
>/END SPANISH							/A002

ME9,	
IFDEF ENGLSH <							/A002
	TEXT	\LIST CONTAINS ONLY TEXT\
>/END ENGLSH							/A002
IFDEF ITALIAN < 
	TEXT /LISTA CONTIENE SOLO TESTO/ >
IFDEF V30NOR <							/A002
	TEXT	\LISTE INNEHOLDER BARE TEKST\
>/END V30NOR							/A002
IFDEF V30SWE <
	TEXT 'REGISTERDOKUMENTET INNEH\ELLER ENBART TEXT'>
IFDEF DUTCH <							/A002
	TEXT	\BESTAND BEVAT SLECHTS TEKST\
>/END DUTCH							/A002
IFDEF SPANISH <							/A002
	TEXT	'LISTA CONTIENE S\SLO TEXTO'
>/END SPANISH							/A002

ME10,	
IFDEF ENGLSH <							/A002
	TEXT	\PRIMARY KEY NOT FOUND\
>/END ENGLSH							/A002
IFDEF ITALIAN < 
	TEXT /CHIAVE PRIMARIA INESISTENTE/ 
>
IFDEF V30NOR <
	TEXT 'PRIM\FRN\XKKEL IKKE FUNNET'>
IFDEF V30SWE <
	TEXT '&F\VRSTA SORTERINGSNYCKELN KAN INTE HITTAS'>
IFDEF DUTCH <							/A002
	TEXT	\ONJUISTE SORTEERSPECIFICATIE\
>/END DUTCH							/A002
IFDEF SPANISH <							/A002
	TEXT	\NO SE ENCUENTRA CLAVE PRIMARIA\
>/END SPANISH							/A002

ME11,
IFDEF ENGLSH <							/A002
	TEXT	\TO MANY KEYS DEFINED\
>/END ENGLSH							/A002
IFDEF ITALIAN < 
	TEXT /TROPPE CHIAVI DEFINITE/ 
>

IFDEF V30NOR <
	TEXT 'FOR MANGE SORTERINGSN\XKLER'>
IFDEF V30SWE <
	TEXT '&F\VR M\ENGA SORTERINGSNYCKLAR \DR DEFINIERADE'>
IFDEF DUTCH <							/A002
	TEXT	\TE UITGEBREIDE SORTEERSPECIFICATIE\
>/END DUTCH							/A002
IFDEF SPANISH <							/A002
	TEXT	'SE DEFINEN MUCHAS CLAVES'
>/END SPANISH							/A002



ME12,

	IFDEF ENGLSH 	< TEXT \INVALID NUMERIC SYNTAX\>
	IFDEF ITALIAN 	< TEXT /NUMERO NON VALIDO/ >
	IFDEF V30NOR 	< TEXT 'UGYLDIG TALLANGIVELSE'>
	IFDEF V30SWE 	< TEXT '&FELAKTIG NUMERISK SYNTAX'>
	IFDEF DUTCH 	< TEXT 'ONJUISTE GEGEVENS IN NUMERIEK VELD'>
	IFDEF SPANISH 	< TEXT '\SINTAXIS NUM\IRICA INV\ALIDA'>


ME13,									/a0014

	IFDEF ENGLSH < TEXT \OUTPUT DISKETTE FULL\>			/a0014
	IFDEF ITALIAN < TEXT /ARCHIVIO DOCUMENTI USCITA PIENO/ >
	IFDEF V30NOR < TEXT 'DISKETT FOR UTDATA ER FULL'>
       IFDEF V30SWE < TEXT '&DISKETTEN D\DR DU VILL HA SLUTDOKUMENTET \DR FULL'>
	IFDEF DUTCH < TEXT '&BESTEMMINGSDISKETTE VOL'>
	IFDEF SPANISH < TEXT '&DISKETTE DE SALIDA LLENO'>



ME13A,	IFDEF ENGLSH < TEXT \OUTPUT VOLUME FULL\>			/A018
	IFDEF ITALIAN < TEXT /ARCHIVIO DOCUMENTI USCITA PIENO/ >
	IFDEF V30NOR < TEXT 'OMR\EDE FOR UTDATA ER FULLT'>
	IFDEF V30SWE < TEXT '&VOLYMEN D\DR DU VILL HA SLUTDOKUMENTET \DR FULL'>
	IFDEF DUTCH < TEXT '&BESTEMMINGSGEBIED VOL'>
	IFDEF SPANISH < TEXT '&VOLUMEN DE SALIDA LLENO'>


/ END WPSRTX.PA

/ ---------------------------------------------------------------------
/ !  !  I  M  P  O  R  T  A  N  T    N  O  T  I  C  E  !  !
/ ---------------------------------------------------------------------
/
/ THE 'XXSDFNBUFFER' IS LOCATED IN FIELD #4
/
/ THE 'XXSDFNBUFFER' IS FILLED BY THE SORT PARSER
/
/ THE BUFFER MAY BE MOVED ALMOST ANYWHERE IN THE FIELD
/  W/O ANY REDEFINITIONS IN THE SORT PARSER
/   HOWEVER, IF THIS BUFFER IS MOVED OUT OF THE FIELD
/    THEN THE APPROPRIATE 'CDFs' WITHIN THE PARSER MUST REFLECT THAT
/
/ ---------------------------------------------------------------------
/
/ THE 'XXSDFNBUFFER' HOLDS THE <FIELD NAME> TO BE SORTED
/ AS DEFINED WITHIN THE SPECIFICATION DOCUMENT

XXSDFNBUFFER=0			/ of FIELD #4				/M011

/	F
/	I
/	E
/	L
/	D
/	N
/	A
/	M
/	E
/	[0]			/ <FIELD NAME> SEPARATOR
/	F
/	I
/	.
/	.
/	[0]			/ <FIELD NAME> SEPARATOR
/	.
/	.
/	[0]
/	[-1]			/ XXSDFNBUFFER TERMINATOR
/
/
/ MAX # OF 'VVVVV'ALUE CHARS, TIMES 2, +1 [0 TERM], TIMES #MAXKEY, +1 [-1 TERM]
/
/D011	*KCCVALUE%2+1^MAXKEY+1+XXSDFNBUFFER

	PAGE



