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