IDENT SORT,FETS,SORT
ABS
SST
ENTRY SORT
ENTRY MFL=
ENTRY SSM=
SYSCOM B1 DEFINE (B1) = 1
*COMMENT SORT - FILE SORT ROUTINE.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
TITLE SORT - FILE SORT ROUTINE
SPACE 4
*** SORT - FILE SORT ROUTINE
* W.T. SACKETT 71/03/01.
*
* SORT READS THE INPUT FILE IN SEGMENTS, SORTS THEM AND MERGES
* RESULT WITH THE PREVIOUSLY SORTED PORTION OF THE FILE.
* THE SORT IS BASED ON THE FIRST *NC* (DEFAULT = 5) CHARACTERS
* OF THE LINE NUMBER FOR EACH LINE. THE LINE NUMBER ENTERED
* LAST BEING THE CORRECTION LINE, REPLACING ANY LINES HAVING
* THE SAME LINE NUMBER. A LINE NUMBER FOLLOWED BY AN EMPTY
* LINE IS CONSIDERED A LINE DELETE.
* NOTES 1) LINE NUMBER, ONE BLANK, CARRAIGE RETURN IS ALSO
* CONSIDERED A LINE DELETE. 2) A LINE NUMBER HAVING MORE THAN
* *NC* CHARACTERS IS NOT CHECKED FOR LINE DELETE SO TO DELETE
* SUCH LINES TYPE ONLY *NC* CHARACTERS THEN CARRAIGE RETURN.
* 3) DIRECT ACCESS FILES MAY BE SORTED.
SPACE 4
*** COMMAND CALL.
*
* SORT,I. I = NAME OF INPUT FILE TO BE SORTED.
*
* OR, SORT,I,NC=N. IN WHICH CASE THE SORT IS DONE ONLY ON
* THE FIRST N ( .LE. 10 ) CHARACTERS OF THE LINE NUMBER.
* IF NO NC PARAMETER IS SPECIFIED N IS ASSUMED TO BE 5.
SPACE 4
*** DAYFILE MESSAGES.
*
* * NO LINE NUMBER ON SORT FILE.* = SOME LINE ON INPUT FILE
* IS MISSING A LINE NUMBER. CAN ALSO MEAN A LINE WAS TOO LONG,
* (160 CHARACTER MAX LINE SIZE). SORT FILE IS NOT REWRITTEN.
*
* * INCORRECT SORT PARAMETER.* = SORT COMMAND IS INCORRECT.
*
* * EMPTY SORT INPUT FILE.*
*
* * INCORRECT WRITE ON READ ONLY FILE.* (CIO ERROR 03) = DIRECT
* ACCESS INPUT FILE WAS NOT ATTACHED IN WRITE MODE.
*
* * RESERVED FILE NAME.* - FILE NAME SPECIFIED ON *SORT*
* CONTROL CARD IS RESERVED FOR USE BY THE EDITOR (ZZZZZG0,
* ZZZZZG1).
SPACE 4,10
*CALL COMCMAC
*CALL COMCCMD
*CALL COMSREM
SPACE 4,10
ORG 110B
FETS BSS 0
** ASSEMBLY CONSTANTS.
DAF CON 0 FILE TYPE FLAG (0 = DIRECT ACCESS)
ELAD CON 0 ADDRESS OF PARTIAL LINE
ELCH CON 0 NUMBER OF WORDS IN PARTIAL LINE
LS CON -1 LAST LINE NUMBER ON MERGE FILE (ZZZZZG1)
NC CON 5 NUMBER OF DIGITS TO SORT ON
NMZZZG1 VFD 42/0LZZZZZG1,18/15B
BUFL EQU 2001B LENGTH OF SCRATCH *CIO* BUFFERS
WL EQU VXLL/5+1 WORKING BUFFER LENGTH
SPACE 4
** FET DEFINITIONS.
ZZZZZG1 RFILEB G1BUF,BUFL,(FET=7)
ZZZZZG0 RFILEB G0BUF,BUFL,(FET=7)
I RFILEB IBUF,1,(FET=7)
RPB SPACE 4,10
* *REPRIEVE* PARAMETER BLOCK.
RPB BSS 0
VFD 36/0,12/RPBL,12/0
VFD 30/0,30/PIT
BSSZ 7
BSSZ 16 EXCHANGE PACKAGE
RPBL EQU *-RPB
TITLE MAIN PROGRAM.
SPACE 4
SORT SB1 1
RJ PRS PRESET SORT
EQ SOR2 READ FILE
SOR1 WRITE ZZZZZG0 FLUSH SORTED DATA
SA3 I+1
SX6 X3
SA6 A3+B1 RESET IN AND OUT TO FIRST
SA6 A6+B1
SA3 ELCH
ZR X3,SOR2 IF NO PARTIAL LINE IN LAST SEGMENT
SA4 ELAD MOVE PARTIAL LINE TO START OF INPUT BUFFER
WRITEW I,X4,X3
SOR2 READEI I,R NEXT SEGMENT FROM INPUT
RECALL ZZZZZG0
SA1 X2
LX1 59-20 CHECK IF NAME IS ZZZZZG1
PL X1,SOR3 IF ZZZZZG0 ALREADY HAS ITS OWN FNT NAME
SA4 ZZZZZG0+6
RENAME ZZZZZG0,ZZZZZG1
RECALL ZZZZZG0
BX6 X4 RESTORE RANDOM ADDRESS
SA6 A4+
SOR3 RJ ELK CHECK END OF BUFFER FOR END OF LINE
SA1 I+2 READ *IN*
SA2 A1+B1 READ *OUT*
BX3 X2-X1
NZ X3,SOR4 IF DATA READ
SA4 GLTA
ZR X4,ERR1 IF EMPTY FILE
EQ SOR5 CHECK FOR EOI
SOR4 RJ GLT GENERATE LINE NUMBER TABLE
RJ MER MERGE ZZZZZG1 AND I TO ZZZZZG0
SOR5 SA1 I
LX1 59-9
PL X1,SOR1 IF NOT *EOI* ON INPUT FILE
WRITER ZZZZZG0,R
SA1 DAF
ZR X1,SOR6 IF INPUT FILE WAS DIRECT ACCESS
SA4 X2+6
RENAME X2,I
RECALL X2
BX6 X4 RESTORE RANDOM ADDRESS
SA6 A4
EQ SOR8 END
SOR6 REWIND X2,R COPY ZZZZZG0 TO INPUT
READEI X2
SA0 PRS FWA OF WORKING BUFFER
REWIND I,R
SOR7 READW ZZZZZG0,PRS,BUFL-1
SB7 B6-PRS NUMBER OF WORDS TRANSFERRED
SX2 I
BX5 X1
WRITEW X2,A0,B7
PL X5,SOR7 IF COPY NOT COMPLETE
WRITER X2 EMPTY BUFFER
SOR8 MESSAGE =0,1 CLEAR *MS1W* MESSAGE
RETURN ZZZZZG1
ENDRUN
ERR MESSAGE (=C* NO LINE NUMBER ON SORT FILE.*),,R
EQ ERR2 ABORT
ERR1 MESSAGE (=C* EMPTY SORT INPUT FILE.*),,R
ERR2 REWIND I
ABORT
TITLE SUBROUTINES.
GLT SPACE 4
** GLT - GENERATE LINE NUMBER TABLE.
*
*T 1/ ,40/ CONVERTED NUMBER ,18/ BUFFER ADDRESS ,1/D
* D = NULL (DELETE) LINE FLAG (SET FOR DELETE)
*
* MAIN LOOP IS IN STACK ON 6600.
*
* ENTRY (X1) = *IN*.
* (X2) = *OUT*.
*
* EXIT (X0) = FWA OF LINE NUMBER TABLE.
* (GLTA) = 1.
*
* USES A - 2, 3, 4, 6, 7.
* B - ALL.
* X - ALL.
*
* CALLS SST.
GLT SUBR ENTRY/EXIT
SX6 B1
SA6 GLTA SET DATA READ FLAG
SB7 X1 SET STARTING ADDRESS OF LINE NUMBERS
SA2 X2 GET FIRST LINE
MX5 48
BX3 X3-X3
SA4 NC NUMBER OF DIGITS TO SORT ON
BX6 X6-X6
SB4 -1R+ (B4) = -1R+
SB5 X4+B1
NX7,B3 X3 INITIALIZE (X7)=0, (B3)=48
BX1 X2
SB6 B3-B5 (B6) = 48-*NC*-1
MX0 54
SB5 -1R0 (B5) = -1R0
SA7 B7+ PRESET LINE NUMBER TABLE BUFFER ADDRESS
GLT1 IX6 X6+X3 ACCUMULATE LINE NUMBER
LX1 6
BX3 -X0*X1 GET NEXT CHARACTER
SX7 X3+B4 CHECK IF NOT ALPHANUMERIC
BX1 X0*X1 CLEAR CHARACTER BEING PROCESSED
SX3 X3+B5 CHECK IF ALPHABETIC
LX6 4 NOTE - LINE NUMBER CONVERTED TO HEXADECIMAL
BX7 -X7+X3
SB3 B3-B1 COUNT CHARACTER
PL X7,GLT1 LOOP IF NUMERIC
LX6 18-4
LT B3,B6,GLT4 IF OVER MAX NUMBER OF DIGITS TO SORT
ZR X1,GLT5 IF POSSIBLE NULL LINE
GLT2 SX7 A2 SET BUFFER ADDRESS
BX6 X6+X7 BUILD TABLE ENTRY
LX7 X6,B1
SA7 A7+B1 STORE LINE NUMBER TABLE ENTRY
GLT3 BX6 -X5*X2
SA2 A2+B1 READ NEXT WORD
NZ X6,GLT3 IF NOT END OF LINE
BX1 X2
NX3,B3 X6 RE-INITIALIZE (X3)=0, (B3)=48
NZ X2,GLT1 LOOP TO END OF BUFFER
SX0 B7+B1 SET ADDRESS OF LINE NUMBER TABLE
SB2 A2
SA6 A7+B1 SET TERMINATOR
SX1 A6-B7 SET TABLE LENGTH
NE B2,B7,ERR IF END OF BUFFER NOT REACHED
RJ SST= SORT TABLE
EQ GLTX EXIT
GLT4 AX6 4 PROCESS ONLY *NC* DIGITS
SB3 B3+B1
LT B3,B6,GLT4 IF STILL NOT LESS THAN *NC* DIGITS
MX7 42
BX6 X7*X6 MASK OFF EXCESS DIGITS
EQ GLT2 LOOP
GLT5 SX7 X3+1R0
SX1 X3+1R0-1R LAST CHARACTER BLANK CONSIDERED A DELETE
ZR X7,GLT6 IF PROBABLE DELETE LINE
NZ X1,GLT2 IF NOT DELETE
GLT6 SB2 B3-38
GE B2,B1,GLT7 IF LINE NUMBER LESS THAN 9 DIGITS
SA3 A2+B1
ZR X3,GLT7 IF LINE DELETE
LX3 6
PL B2,GLT2 IF 9 DIGITS
SX7 1R PROCESS 10 DIGIT LINE NUMBERS
BX7 X3-X7
NZ X7,GLT2 IF NOT DELETE
GLT7 MX1 1 SET DELETE FLAG
BX6 X6+X1
EQ GLT2 LOOP
GLTA CON 0 DATA READ FLAG
EJECT
SPACE 4
** MER - MERGE LAST SORTED SEGMENT WITH NEW INPUT USING DATA
* FROM LINE NUMBER TABLE TO WRITE TO ZZZZZG0.
*
* ENTRY (X0) = FIRST WORD ADDRESS OF LINE NUMBER TABLE.
* (LS) = -1 ON FIRST ENTRY SO NO MERGE IS DONE AFTER
* PROCESSING THE FIRST LINE NUMBER TABLE.
*
* USES ALL REGISTERS
MER SUBR ENTRY/EXIT
* GET M, LINE NUMBER FROM GLT TABLE FOR FILE TO BE MERGED,
* AND CHECK FOR ZERO LINE NUMBERS OR LINES WITHOUT NUMBERS.
SA5 X0 FIRST ENTRY IN LINE NUMBER TABLE
MX0 41
SA1 LS LAST LINE NUMBER ON FILE PREVIOUSLY SORTED
BX6 X0*X5
NZ X6,MER2 IF NO ZERO LINE NUMBERS
SA2 A5
MER1 LX2 59-0
SA3 X2 GET LINE FROM INPUT BUFFER
AX3 54
SA2 A2+B1 GET NEXT LINE NUMBER TABLE ENTRY
SX4 X3-1R0
NZ X4,ERR IF NO LINE NUMBER ON LINE
BX6 X0*X2
ZR X6,MER1 IF LINE NUMBER = 0
SA5 A2-B1 RESET A5
MER2 LX5 59-0
SA0 X5 (A0) = BUFFER ADDRESS OF LINE M
PL X5,MER3 IF NOT NULL LINE
SA0 -1 LINE DELETE FLAG
MX7 1
BX5 X7-X5 WIPE OUT SIGN EXTENSION
MER3 AX5 18 (X5) = M, LINE NUMBER FOR MERGE FILE
IX4 X1-X5
NG X4,MERA IF LINE NUMBER > LAST LINE NUMBER
SA3 NMZZZG1
WRITER ZZZZZG0 EMPTY ZZZZZG0 BUFFER
REWIND X2,R
BX6 X3
SA6 X2 ZZZZZG0 FNT NAME ZZZZZG1
SA3 ZZZZZG1+B1 SET IN=OUT=FIRST FOR ZZZZZG1
SX6 X3
SA6 A3+B1
SA6 A6+B1
READ A3-B1 READ ZZZZZG1
* GET LINE NUMBER, S, FROM ZZZZZG1 AND WRITE LINE TO WS
MER4 READC ZZZZZG1,WS
NZ X1,MER12 IF EOR ON ZZZZZG1
SA2 WS GET LINE
MX0 0
SB3 B0
SA4 NC
SB5 -1R+
MX7 54 LINE NUMBER MASK
SB6 X4
MER5 LX2 6
BX3 -X7*X2 NEXT CHARACTER
SB3 B3+B1 COUNT CHARACTER
BX0 X0+X1 ACCUMULATE LINE NUMBER
SX1 X3-1R0
SX3 X3+B5
BX3 -X3+X1 CHECK IF NUMERIC
BX2 X7*X2 CLEAR CHARACTER BEING PROCESSED
LX0 4 MULTIPLY BY 16( TO PUT IN GLT FORM)
PL X3,MER5 GET REST OF LINE NUMBER
MER6 AX0 4 PROCESS ONLY *NC* DIGITS
SB3 B3-B1
GT B3,B6,MER6 IF STILL MORE THAN *NC* CHARACTERS
MER7 IX4 X5-X0 M - S
NG X4,MER8 IF M>S
ZR X4,MER4 M = S SO READ NEXT S
SA3 LS LAST LINE NUMBER ON LAST SORTED SEGMENT
IX4 X3-X5
NG X4,MER11 IF M>LS
WRITEC ZZZZZG0,WS TRANSFER LINE S OF ZZZZZG1 TO ZZZZZG0
EQ MER4
* CHECK LINE NUMBER AND MERGE.
MER8 SB7 A0 BUFFER ADDRESS FOR MERGE FILE
BX4 X5
SA5 A5+B1 GET NEXT M
LX5 59-0
ZR X5,MER10 IF END OF LINE NUMBER TABLE
SA0 X5 BUFFER ADDRESS
PL X5,MER9 IF NO LINE DELETE
SA0 -B1 LINE DELETE FLAG
MX7 1 REMOVE SIGN EXTENSION
BX5 X7-X5
MER9 AX5 18 NEXT M TO X5
BX2 X5-X4 CHECK IF SAME LINE NUMBERS
ZR X2,MER8 IF SAME, DELETE EARLIER LINE
NG B7,MER7 IF LINE DELETE REQUIRED
WRITEC ZZZZZG0,B7 TRANSFER LINE M TO ZZZZZG0
EQ MER7 CHECK NEXT LINE
* DUMP REST OF ZZZZZG1 TO ZZZZZG0.
MER10 NG B7,MER11 IF NULL LINE
WRITEC ZZZZZG0,B7 WRITE LAST LINE OF LINE NUMBER TABLE
MER11 WRITEC ZZZZZG0,WS WRITE NEXT LINE FROM ZZZZZG1
READC ZZZZZG1,WS
ZR X1,MER11 IF NOT EOR ON SORTED SEGMENT
* DUMP OF LINE NUMBER TABLE TO ZZZZZG0.
MER12 ZR X5,MER14 IF END OF LINE NUMBER TABLE
MERA SB7 A0
BX0 X5 CHECK MERGE
SA5 A5+B1 NEXT LINE FROM LINE NUMBER TABLE
LX5 59-0
SA0 X5 BUFFER ADDRESS
PL X5,MER13 IF NO LINE DELETE
SA0 -B1 LINE DELETE FLAG
MX7 1 REMOVE SIGN EXTENSION
BX5 X7-X5
MER13 AX5 18 NEXT M TO X5
BX3 X5-X0
ZR X3,MER12 IF SAME LINE NUMBER
NG B7,MER12 IF LINE DELETE
WRITEC ZZZZZG0,B7 TRANSFER LINE M TO ZZZZZG0
EQ MER12 DUMP REST OF TABLE
* EXIT.
MER14 BX6 X0
SA3 LS LAST LINE NUMBER FROM PREVIOUS SEGMENT
IX4 X6-X3
NG X4,MERX IF LAST LINE MERGED < LS
SA6 A3
EQ MERX EXIT
EJECT
SPACE 4
** ELK - END OF LINE CHECK
*
* WHEN MERGING THE LAST READ MAY HAVE LEFT A PARTIAL LINE IN
* THE INPUT BUFFER. ELK SAVES THE PARTIAL LINE IN WE.
*
* EXIT (ELCH) = NUMBER OF WORDS IN PARTIAL LINE.
* (ELAD) = ADDRESS OF BEGINNING OF PARTIAL LINE.
ELK2 BX7 X4
SA7 A4 RESET *IN* IN I
SX7 A6
BX6 X5
SA6 ELCH
SA7 ELAD STORE ADDRESS OF PARTIAL LINE
ELK SUBR ENTRY/EXIT
SA2 I
LX2 59-9 CHECK IF LAST READ
NG X2,ELKX IF LAST READ
SB4 WE+WL
SA4 A2+2 IN
MX2 -12
MX5 0
ELK1 SA3 X4-1 GET LINE FROM BUFFER
BX6 -X2*X3
ZR X6,ELK2 IF END OF LIN FOUND
BX6 X3
SA6 B4-B1 STORE FROM BOTTOM UP
SB4 B4-B1
SX5 X5+B1 NUMBER OF WORDS TRANSFERRED
SX6 B4-WE-1
SX4 X4-1
PL X6,ELK1 GET REST OF LINE
EQ ERR IF LINE TOO LONG - ERROR EXIT
PIT SPACE 4,10
** PIT PROCESS TERMINAL INTERRUPTS.
*
* ENTRY TERMINAL INTERRUPT SENSED.
*
* EXIT TERMINAL INTERRUPT IGNORED.
*
* MACROS REPRIEVE.
PIT BSS 0
REPRIEVE RPB,RESUME,200B RESUME PROCESSING
SPACE 4
* COMMON DECKS.
*CALL COMCSST
*CALL COMCLFM
*CALL COMCCIO
*CALL COMCSYS
*CALL COMCRDC
*CALL COMCWTC
*CALL COMCRDW
*CALL COMCWTW
SPACE 4
USE BUFFERS
WS EQU * WORKING STORAGE FOR ZZZZZG0 AND ZZZZZG1
WE EQU *+WL PARTIAL LINE BUFFER
G1BUF EQU WE+WL BUFFER FOR ZZZZZG1
G0BUF EQU G1BUF+BUFL BUFFER FOR ZZZZZG0
IBUF EQU G0BUF+BUFL BUFFER FOR I
MFL= EQU 14000B SORT NOMINAL FL
SSM= EQU 0 SUPRESS MEMORY CLEAR
TITLE PRESET.
PRS SPACE 4
** PRESET.
*
* ENTRY (A0) = FIELD LENGTH.
* ARGR = ADDRESS OF INPUT FILE NAME LEFT JUST ZERO FILL
*
* EXIT FETS INITIALIZED.
PRS SUBR ENTRY/EXIT
REPRIEVE RPB,SET,200B SET *REPRIEVE* PROCESSING
SA0 A0-100B ADJUST FL TO ALLOW FOR *CLB=* DATA
SA1 ARGR SET SORT FILE NAME
MX5 42
BX1 X5*X1 MASK OFF FILE NAME
SA3 =7LZZZZZG0
BX7 X3-X1
ZR X7,PRS4 IF MATCHES SCRATCH FILE NAME ZZZZZG0
SA3 =7LZZZZZG1
BX7 X3-X1
ZR X7,PRS4 IF MATCHES SCRATCH FILE NAME ZZZZZG1
PRS1 SA3 =7LZZZZZG0
SX5 B1
BX7 X3+X5
SA7 ZZZZZG1 ZZZZZG1 ALWAYS HAS FNT NAME OF ZZZZZG0
SX1 MFL= ENSURE FIELD LENGTH FOR LOCAL FILE TESTING
SX4 A0 FIELD LENGTH
IX6 X4-X1
PL X6,PRS2 IF SUFFICIENT MEMORY AVAILABLE
SX4 X1+
MEMORY ,,,X1 INSURE SPACE FOR BUFFERS
PRS2 SA3 I+2 IN
IX7 X4-X3
AX2 X7,B1 SET LIMIT = REMAINING FIELD LENGTH/2
IX7 X2+X3
SA1 ARGR STORE FILE NAME IN INPUT FET
BX6 X1+X5
SA6 I
SA7 A6+4 INPUT LIMIT
SA4 ACTR
SB4 X4
REWIND A6 REWIND INPUT FILE
STATUS X2,P CHECK FILE TYPE
SA1 I+5
MX0 -6
BX7 X7-X7
AX1 6
BX2 -X0*X1
SA7 I+6 CLEAR RANDOM INDEX
SX6 X2-PMFT
SA6 DAF DIRECT ACCESS FILE FLAG
RETURN ZZZZZG0
EQ B4,B1,PRSX IF ONE PARAMETER
SA3 ARGR+B1 CHECK NEXT ARGUMENT
LX3 12
SA5 A3+B1 GET NUMBER OF DIGITS
SX2 X3-3R=NC
NZ X2,PRS3 IF NOT NUMBER OF DIGITS PARAMETER
SB7 -1 SET DECIMAL CONVERSION
RJ DXB CONVERT DISPLAY TO BINARY
NZ X4,PRS3 IF ERROR ENCOUNTERED
SA6 NC NUMBER OF DIGITS TO SORT ON
ZR X6,PRS3 IF NC = 0
SX4 X6-11
PL X4,PRS3 IF NC GREATER THAN 10 DIGITS
EQ PRSX RETURN
PRS3 MESSAGE (=C* INCORRECT SORT PARAMETER.*),,R
ABORT
PRS4 MESSAGE (=C* RESERVED FILE NAME.*),,R
ABORT
SPACE 4
* PRESET COMMON DECKS.
*CALL COMCDXB
SPACE 4
END