COMMENT FLOW BEGIN HEADING ITD SORT- VECTOR MATRIX...* 3000 TABLE$ 050 -------- ------------ ------- 100 :INPUT :->:RECORD[0] :..:V[0] :.. EXAMPLE OF VECTOR MATRIX 110 :RECORD:. ------------ ------- . ------- 120 :SOURCE:. ..:V[16]:.. 130 --------. ------------ ------- . ------- . 140 ->:RECORD[1] :..:V[1] :.. . 150 . ------------ ------- . ------- 160 . ..:V[24]:. 170 . ------------ ------- . -------. 180 ->:RECORD[2] :..:V[2] :.. . . 190 . ------------ ------- . ------- . . 200 . ..:V[17]:.. . 210 . ------------ ------- . ------ . 220 ->:RECORD[3] :..:V[3] :.. . 230 . ------------ ------- . -------- 240 . ..:V[28]:.. 250 . ------------ ------- . --------. 260 ->:RECORD[4] :..:V[4] :.. . . 270 . ------------ ------- . ------ . . 280 . ..:V[18]:.. . . 290 . ------------ ------- . ------- . . . 300 ->:RECORD[5] :..:V[5] :.. . . . 310 . ------------ ------- . -------. . 320 . ..:V[25]:. . 330 . ------------ ------- . ------- . 340 ->:RECORD[6] :..:V[6] :.. . . 350 . ------------ ------- .-------- . . 360 . ..:V[19]:.. . 370 . ------------ ------- . ------- . 380 ->:RECORD[7] :..:V[7] :.. . 390 . ------------ ------- . ------- 400 . ..:V[30]: 410 . ------------ ------- . ------- 420 ->:RECORD[8] :..:V[8] :.. . 430 . ------------ ------- . ------- . 440 . ..:V[20]:.. . 450 . ------------ ------- . ------- . . 460 ->:RECORD[9] :..:V[9] :.. . . 470 . ------------ ------- . ------- . 480 . ..:V[26]:. . 490 . ------------ ------- . -------. . 500 ->:RECORD[10]:..:V[10]:.. . . . 510 . ------------ ------- . ------- . . . 520 . ..:V[21]:.. . . 530 . ------------ ------- . ------- . . 540 ->:RECORD[11]:..:V[11]:.. . . 550 . ------------ ------- . ------- . 560 . ..:V[29]:.. 570 . ------------ ------- . ------- 580 ->:RECORD[12]:..:V[12]:.. . 590 . ----------- ------- . ------- . 600 . ..:V[22]:.. . 610 . ------------ ------- . ------- . . 620 ->:RECORD[13]:..:V[13]:.. . . 630 . ------------ ------- . -------. 640 . ..:V[27]:. 650 . ------------ ------- . ------- 660 ->:RECORD[14]:..:V[14]:.. . 670 . ------------ ------- . ------- . 680 . ..:V[23]:.. 690 . ------------ ------- . ------- 700 ->:RECORD[15]:..:V[15]:.. 710 ------------ ------- 720 % 730 END; 740 COMMENT FLOW BEGIN 750 HEADING ITD SORT-PHASE SUBROUTINE SECTION...* 760 ENTER* 3100 NOTE SUBROUTINE WAIT CHECKS FOR I/O COMPLETE..* 4000 WAIT: 5000 IS I/O COMPLETE BIT ON IN TOP-OF-STACK WORD 6000 YES GO EXIT* 7000 CALL MCP TO SUSPENDEND UNTIL I/O COMPLETE* 8000 EXIT: EXIT* 9000 COL* 10000 ENTER* 11100 NOTE SUBROUTINE RELEASETAPE CALS MCP TO DO I/O ON SORT-SCRATCH TAPES.* 11000 RELEASETAPE: 12000 SET RECORD/BLOCK COUNTER TO RECORDS/BLOCK.. 13000 (FIB[11] ~ TBO)* 14000 RESTORE TOP I/O DESCRIPTOR FROM FIB[16]* 15000 CALL MCP TO I/O BUFFER.. 16000 (MCP PERMUTES ALTERNATE BUFFER TO TOP I/O POSITION)* 17000 RTA: CALL WAIT TO CHECK FOR I/O COMPLETE ON 18000 TOP I/O DESCRIPTOR* 19000 DOES TOP I/O DESCRIPTOR INDICATE END-OF-FILE 20000 NO GO FXUP* 21000 CALL FILE-CONTROL TO DO REEL SWITCH* 22000 GO TO RTA* 23000 COL* FXUP: SAVE TOP I/O DESCRIPTOR IN FIB[16]* 24000 POINT TOP I/O DESCRIPTOR PLUS ONE WORD.. 25000 (NOTE: 1ST WORD OF EACH BLOCK IS A FLAG AS TO WHETHER 26000 THE BLOCK IS THE LAST BLOCK OF A STRING)* 27000 EXIT* 28000 COL* 29000 ENTER* 30000 NOTE SUBROUTINE TAPEWRITE BLOCKS SORT OUTPUT TAPES AND CALLS 31000 RELEASETAPE WHEN BUFFER IS FULL* 32000 TAPEWRITE: 33000 POINT PRFIB AT FIB FOR CURRENT OUTPUT TAPE* 34000 ADD 1 TO RECORD/STRING COUNTER IN FIB[9]* 35000 REDUCE RECORDS/BLOCK COUNTER IN FIB[11] BY 1* 36000 IS RECORDS/BLOCK COUNTER ZERO 37000 YES GO XPR* 38000 INDEX I/O DESCRIPTOR BY RECORD SIZE* 39000 GO EXIT* 40000 XPR: ZERO 1ST WORD IN BUFFER.. 42000 (FLAGS THIS BLOCK IS NOT LAST BLOCK IN STRINS)* 42100 CALL RELEASETAPE* 43000 EXIT: EXIT* 44000 COL* 45000 ENTER* 46000 NOTE SUBROUTINE WRITESTOPPER WRITES LAST BLOCK OF STRING AND DUMMY 47000 STRING BLOCKS* 48000 WRITESTOPPER: 49000 NOTE COT IS INDEX OF CURRENT OUTPUT TAPE* 49100 POINT PRFIB AT FIB FOR CURRENT OUTPUT TAPE* 50000 FIX FIRST WORD OF BUFFER AS FOLLOWS.. 51000 [3:15] ~ "DS".. 52000 [18:15]~ TBO-FIB[11] (NUMBER OF LEGITIMATE RECORDS IN 53000 THIS BLOCK).. 54000 [33:15]~FIB[9](NUMBER OF RECORDS IN STRING)* 55000 COUNT UP TN[COT] BY 1(STRINGS PER TAPE COUNTER)* 56000 CALL RELEASETAPE* 57000 EXIT* 58000 COL* 59000 ENTER* 59100 NOTE SUBROUTINE TO SET UP PROGRAMMERS SORTED OUTPUT MEDIA* 60000 OPENOUT: 61000 IS OUTPUT MEDIA A PROCEDURE NO GO XA* 62000 PASS OUTFIL TO CORE ALLOCATION TO GET STORAGE SPACE 63000 FOR ONE RECORD. OUTFIL WILL POINT AT THIS SPACE* 64000 IS CALLER COBOL NO GO EXIT* 65000 SET UP COBOL INPUT PROCEDURE LINKAGE* 66000 GO EXIT* 67000 XA: IS CALLER COBOL NO GO XB* 68000 POINT PRFIB AT OUTPUT FILES FIB* 69000 CALL COBOL FILE CONTROL TO OPEN FILE* 70000 SET DF TRUE IF FILE IS DISK* 71000 GO EXIT* 72000 XB: CALL ALGOL FILE CONTROL TO OPEN FILE* 73000 COL* 74100 EXIT: EXIT* 74000 COL* 75000 ENTER* 75100 NOTE SUBROUTINE SETUPTAPES INITIALIZES TAPES FOR DISTRIBUTION PASS* 76000 SETUPTAPES: 77000 ZERO ARRAYS TS,TC AND TN* 78000 NOTE TN[I] = NUMBER OF STRINGS ON TAPE[I].. 79000 TC[I] = NUMBER OF STRINGS DESIRED ON TAPE[I].. 80000 TS[I] = NEXT NUMBER IN FIBONACCI SERIES* 81000 INDICATE TAPE 1 IS CURRENT OUTPUT TAPE* 82000 SET UP 1ST SET IN FIBONACCI SERIES(TC[1]~1)* 83000 SET I TO 1* 84000 XA: POINT PRFIB AT FIB FOR TAPE[I]* 85000 PUT TAPE BLOCK SIZE IN FIB[18]* 86000 BOX IF I!1 SET FIB[18] TO MINUS* 87000 NOTE MCP WILL NOT ASSIGN BUFFERS TO FILES IF FIB[18] IS MINUS 88000 AT FILE OPEN TIME* 89000 BOX IF I!NT THEN CALL MCP TO OPEN FILE* 90000 NOTE WE ASSIGN TAPE UNITS TO ALL BUT THE LAST TAPE FILE.. 91000 ONLY TAPE[1] WILL HAVE CORE BUFFERS SINCE ITS FIB[18] 92000 WAS NOT MADE MINUS. THESE COMMON BUFFERS ARE SHARED BY 93000 ALL OTHER TAPES (SEE SUBROUTINE SELECT)* 94000 BOX IF I!NT CALL WAIT(WAIT FOR FILE TO BE OPENED)* 95000 BOX IF I=1 POINT IO DESCRIPTOR PAST FLAG WORD* 96000 IS I = NT (ALL TAPES SET UP) YES GO XB* 97000 I+1* 98000 GO XA* 99000 XB: POINT COIOD AT IO DESCRIPTOR OF CURRENT OUTPUT TAPE* 100000 EXIT* 101000 COL* 101100 COL* 102000 ENTER* 102100 NOTE SUBROUTINE GETROW CONTROLS DISK ALLOCATION* 103000 GETROW: 104000 RESET AMOUNT OF ROW LEFT BY ROW SIZE.. 105000 (ORL~ORS)* 106000 NOTE ORS IS DEFINED AS HEADER[8]* 106100 INDEX ROW INDEX TO NEXT ROW.. 107000 (ORI~ORI+1)* 107100 DOES INDEX POINT BEYOND LAST ROW YES GO GRA* 108000 IS DISK ADDRESS IN HEADER[ROW INDEX] = ZERO YES GO XA* 109000 XB: SET THIS ADDRESS INTO OCDA* 110000 GO EXIT* 111000 XA: CALL MCP TO ASSIGN DISK SPACE FOR THIS ROW* 112000 NOTE MCP WILL PUT 1ST ADDRESS OF ROW IN HEARDER[ROW INDEX] 113000 IF IT CAN FIND DISK SPACE FOR THE ROW.. IF IT CANNOT 114000 FIND SPACE HEADER[ROW INDEX] IS LEFT = 0* 115000 IS HEADER[ROW INDEX] = ZERO NO GO XB* 116000 GRA: 117000 NOTE DISK FILE OR DISK SPACE IS EXAUSTED* 118000 WAS TAPE BACKUP SPECIFIED YES GO XC* 119000 SPO IOR 84 AND TERMINATE* 120000 EXIT* 121000 COL* 121100 XC: IS THIS THE FIRST TIME WE RAN OUT OF DISK NO GO XD* 122000 CALL SETUPTAPES TO INITIALIZE DISK-TAPE MODE* 123000 XD: SET TM TO INDICATE DISK-TAPE MODE* 124000 SET DISKFULL TO TRUE* 125000 EXIT: EXIT* 126000 COL* 127000 ENTER* 127100 NOTE SUBROUTINE FORGETDISK RETURNS DISK STORAGE NO LONGER NEEDED* 127120 FORGETDISK: 127130 SET I TO 10(AREA ZERO INDEX)* 127140 XA: IS HEADER[I] ZERO YES GO XB* 127150 NOTE IF HEADER[I] ! 0 THEN DISK SPACE HAS BEEN ASSIGNED* 127160 CALL MCP TO RETURN DISK SPACE FOR AREA[I-10]* 127170 XB: INDEX I BY ONE* 127180 IS I = 30 NO GO XA* 127190 EXIT* 127200 COL* 127210 ENTER* 127220 NOTE SUBROUTINE INROW INDEXS EACH STRINGS DISK ADDRESS TO POINT AT THE 128000 NEXT BLOCK OF A STRING. WILL INDEX ACROSS A ROW IF NECESSARY* 129000 INROWCHECK: 130000 NOTE ISL IS THE NUMBER OF BLOCKS LEFT IN THE DISK AREA 131000 CONTAING THIS STRING* 132000 IS ISL = ZERO NO GO XA* 133000 COMPUTE NUMBER OF BLOCKS IN AREA.. 134000 (ISL~ (ORS DIV OD)|(OD DIV D)* 135000 POINT THIS STRINGS ROW INDEX AT NEXT ROW(AREA).. 136000 (IRC~IRC+1)* 137000 POINT THIS STRINGS DISK ADDRESS AT 1ST SEGMENT IN ROW.. 138000 (IDA~INHEAD[IRC])* 139000 GO EXIT* 140000 COL* 140100 XA: INDEX THIS STRINGS DISK ADDRESS BY SEGMENTS/BLOCK.. 141000 (IDA~IDA+D)* 142000 EXIT: EXIT* 143000 COL* 143100 ENTER* 143200 NOTE SUBROUTINE INREAD GETS RECORDS, ONE AT A TIME, FROM PROGRAMMERS 144000 INPUT* 145000 INREAD: HAS END-OF-FILE OCCURED YES GO RTNRD* 146000 INCOUNT +1* 147000 IS RECORD SOURCE AN INPUT PROCEDURE NO GO XA* 148000 IS CALLER COBOL NO GO XB* 149000 CALL COBOL INPUT PROCEDURE* 150000 NOTE COBOL WILL PLACE NEXT RECORD IN ARRAY INFIL OR SET 151000 ENDQ TO TRUE IF NO MORE RECORDS* 152000 EOF ~ ENDQ* 153000 GO TO RTNRD* 154000 XB: 155000 NOTE ALGOL INPUT PROCEDURE* 156000 CALL ALGOL INPUT PROCEDURE* 157000 NOTE ALGOL RETURNS A TRUE ON TOP-OF-STACK IF NO MORE RECORDS* 158000 EOF ~ TOP OF STACK* 159000 GO TO RTNRD* 160000 XA: 161000 NOTE RECORD SOURCE IS A FILE* 162000 IS CALLER COBOL NO GO XC* 163000 CALL COBOL READ ROUTINE.. (POINTS INFIL AT NEXT RECORD)* 164000 EOF ~ PARAMETER RETURNED BY COBOL READ* 165000 GO TO RTNRD* 166000 COL* 166100 XC: CALL ALGOL READ.. (POINTS INFIL AT NEXT RECORD)* 167000 EOF ~ TRUE IF PARAMETER RETURNED BY ALGOL READ 168000 IS LESS THE 0. (NO MORE RECORDS)* 169000 RTN: 170000 BOX IF EOF THEN POINT VECTOR[VLOW] AT HIGH KEY RECORD AND 171000 SET EOF FLAG IN BIT 5 OF VECTOR[VLOW]* 172000 EXIT* 173000 COL* 174000 ENTER* 174100 NOTE 174200 SUBROUTINE DISKWRITE BLOCKS AND WRITES RECORDS ON SCRATCH DISK AREA* 175000 DISKWRITE: IS WRITE BLOCK FLAG SET YES GO WRTBLOC* 176000 RECORD/STRING COUNTER PLUS ONE.. 177000 (ORC~ORC+1)* 178000 RECORD/BLOCK COUNTER MINUS ONE.. 179000 (OBC~OBC-1)* 180000 IS OBC=0 YES GO TO WRTBLOC* 181000 INDEX IO DESCRIPTOR TO POINT AT NEXT RECORD POSITION* 182000 GO TO RTNDW* 183000 WRTBLOC: 184000 NOTE MUST WRITE OUT BUFFER ON DISK* 185000 RESTORE RECORD/BLOCK COUNTER.. 186000 (OBC~TBO)* 187000 CONVERT DISK ADDRESS IN OCDA TO NUMERIC AND PUT THIS 188000 ADDRESS IN AS FIRST WORD IN BUFFER* 189000 POINT TOP I/O DESCRIPTOR AT DISK ADDRESS IN BUFFER.. 190000 (FROM FIB[16])* 190100 CALL MCP TO INITIATE I/O* 191000 NOTE MCP WILL PERMUTE I/O DESCRIPTORS SO ALTERNATE BUFFER IS 192000 NOW TOP* 193000 REDUCE AMOUNT-OF-AREA-LEFT COUNTER BY SEGMENTS/BLOCK.. 194000 (ORL~ORL-OD)* 195000 IS THERE ROOM FOR ANOTHER BLOCK.. 196000 (ORL>OD) YES GO XA* 197000 CALL GETROW* 198000 NOTE GETS DISK SPACE FOR NEXT AREA AND POINTS OCDA AT FIRST 199000 ADDRESS* 200000 GO XB* 201000 XA: INDEX OCDA BY SEGMENTS/BLOCK.. 202000 (OCDA~OCDA+OD)* 203000 XB: CALL WAIT TO INSURE I/O COMPLETE ON ALTERNATE BUFFER* 204000 SAVE TOP I/O DESCRIPTOR IN FIB[16]* 205000 POINT IO DESCRIPTOR PAST DISK ADDRESS IN FIRST 206000 WORD OF BUFFER* 206100 RTNDW: EXIT* 207000 COL* 208000 ENTER* 208100 NOTE 208200 SUBROUTINE DIST COMPUTES STRING DISTRIBUTION PATTERNS DESIRED ON SCRATCH 209000 OUTPUT TAPES* 210000 DIST: 211000 NOTE TM1= NUMBER OF TAPES MINUS ONE.. 212000 CTRL=INDEX OF CURRENT OUTPUT TAPE.. 213000 TS[I]= NUMBER OF STRINGS DESIRED ON EACH TAPE FOR CURRENT 214000 PASS.. 215000 TC[I]= NUMBER OF STRINGS DESIRED ON EACH TAPE FOR NEXT 216000 PASS.. 217000 TC[0]&TS[0] THRU TC[TM1]&TS[TM1] CONTAINS FIBONACCI 218000 NUMBERS* 219000 POINT AT NEXT TAPE WHICH SHOULD BE CONTROL TAPE.. 220000 (CTRL~ (CTRL MOD TM1)+1)* 221000 FOR EACH TAPE.. 222000 TS[I]~TC[I](CURRENT FIBONACCI NUMBER).. 223000 IF I!CTRL THEN TC[I]~TC[I]+TC[CTRL] (NEXT FIBONACCI 224000 NUMBER)* 225000 EXIT* 226000 COL* 227000 ENTER* 227100 NOTE 228000 SUBROUTINE SELECT DETERMINES WHICH TAPE THE NEXT STRING SHOULD BE 229000 WRITTEN ON* 230000 SELECT: 231000 REMEMBER CURRENT OUTPUT TAPE.. 232000 (X~COT)* 233000 SA: POINT COT AT NEXT TAPE IN SEQUENCE.. 234000 COT~COT+1* 235000 DOES COT POINT AT LAST TAPE NO GO XA* 236000 POINT COT AT FIRST TAPE.. 237000 (COT~1)* 238000 CALL DIST* 239000 NOTE THE NUMBER OF STRINGS ON EACH TAPE IS AS DESIRED SO CALL 240000 DIST TO COMPUTE NEW SET OF FIBONACCI NUMBERS* 241000 XA: IS COT=CTRL YES GO SA* 242000 MARK PRIOR OUTPUT TAPE AS REWOUND.. 243000 ZERO CORE ADDRESS OF PRIOR TAPES I/O DESCRIPTOR.. 244000 POINT CORE ADDRESS OF CURRENT OUTPUT TAPE AT THE 245000 TWO COMMON BUFFER AREAS.. 246000 (THE ABOVE IS DONE BY THE MCP VIA A SPECIAL COMUNICATE)* 247000 POINT COIOD AT LOCATION OF TOP I/O DESCRIPTOR OF 248000 CURRENT OUTPUT TAPE* 249000 INDEX I/O DESCRIPTOR PAST CONTROL WORD IN FIRST WORD 250000 OF BUFFER (SEE WRITESTOPPOR)* 251000 EXIT* 252000 COL* 253000 ENTER* 253100 NOTE SUBROUTINE WRITETAG WRITES DISK STRING TAG WORD IN FRONT OF EACH 254000 STRING ON DISK* 255000 WRITETAG: 256000 IS THERE ANYTHING IN BUFFER NO GO XA* 257000 SET WRITE BLOCK FLAG* 258000 CALL DISKWRITE* 259000 XA: SET TOP I/O DESCRIPTOR TO 30 WORD, 1 SEGEMENT WRITE* 260000 CONVERT DISK ADDRESS OF TAG IN LOSA TO NUMERIC AND PUT 261000 IN FIRST WORD OF BUFFER(BUFF[0])* 262000 IS DISK FULL NO GO XB* 263000 IS THERE ROOM IN CURRENT AREA FOR ANOTHER TAG WORD 264000 AND AT LEAST ONE BLOCK.. 265000 (ORL} OD+1) YES GO XB* 266000 CALL GETROW.. 267000 (WILL SET UP NEXT AREA)* 268000 XB: DEVELOP TAG WORD.. 269000 BUFF[1]~SRI (AREA IN WHICH STRING STARTED).. 270000 BUFF[2]~ORC (RECORDS IN STRING).. 271000 BUFF[3]~SRS (AMOUNT OF STRING IN AREA WHERE STRING 272000 STARTED,IN SEGMENTS)* 273000 IS INPUT SOURCE EXAUSTED YES GO XC* 274000 BUFF[4]~LOSA~OCDA (ADDRESS OF NEXT TAG)* 275000 GO TO XD* 276000 COL* 276100 XC: BUFF[4]~LOSA~0 (LAST TAG FLAG)* 277000 XD: OCDA~OCDA+1 (ADDRESS OF FIRST BLOCK OF NEXT STRING)* 278000 CALL MCP TO WRITE TAG ON DISK* 279000 STRING COUNTER PLUS 1* 280000 SAVE AREA WHERE NEXT STRING STARTS.. 281000 (SRI~ORI)* 282000 SAVE AMOUNT OF AREA LEFT.. 283000 (SRS~(ORL~ORL-1)* 284000 SET RECORD/STRING COUNTER TO 0.. 285000 (ORC~0)* 286000 CALL WAIT TO WAIT FOR I/O COMPLETE ON ALTERNATE AREA* 287000 EXIT* 288000 COL* 289000 ENTER* 289100 NOTE SUBROUTINE DISKREAD READS SCRATCH DISK INPUT AREA ON DISK-TO-DISK 290000 MERGE PASS* 291000 DISKREAD: 292000 POINT AT PSEUDO FIB FOR CURRENT STRING.. 293000 (BASE ~ DATA[VLOW])* 294000 NOTE BASE[0]=IBC (RECORDS LEFT IN BUFFER).. 295000 BASE[1]=IRL (RECORDS LEFT IN STRING).. 296000 BASE[2]=ISL (BLOCKS LEFT IN AREA).. 297000 BASE[3]=IDA (DISK ADDRESS OF NEXT BLOCK).. 298000 BASE[4]=IRC (INDEX OF AREA CONTAINING CURRENT STRING)* 299000 IS STRING EXAUSTED.. 300000 (IRL{0) NO GO XA* 301000 POINT VECTOR[VLOW] AT HIGH KEY RECORD* 302000 GO TO RTNDR* 303000 COL* 303100 XA: REDUCE RECORDS/STRING COUNTER BY 1* 304000 IS BUFFER EMPTY YES GO XB* 305000 INDEX VECTOR[VLOW] TO POINT AT NEXT RECORD IN BUFFER* 306000 GO TO RTNDR* 307000 COL* 307100 XB: RESTORE RECORD/BLOCK COUNTER.. 308000 (IBC~BF)* 309000 POINT Y AT BUFFER PAIR FOR THIS STRING.. 310000 (Y~2|VLOW)* 311000 CONVERT STRING DISK ADDRESS (IDA) TO NUMERIC AND PUT 312000 IN FIRST WORD OF BUFFER[Y]* 313000 CALL MCP TO DO READ ON BUFFER PAIR Y* 314000 CALL INROWCHK TO GET ADDRESS OF NEXT BLOCK* 315000 CALL WAIT TO WAIT FOR I/O COMPLETE ON ALTERNATE BUFFER* 316000 POINT I/O DESCRIPTOR[Y] PAST DISK ADDRESS IN BUFFER[Y]* 317000 POINT VECTOR[VLOW] AT FIRST RECORD IN BUFFER[Y]* 318000 RTNDR: EXIT* 319000 COL* 329100 COL* 320000 ENTER* 320100 NOTE SUBROUTINE WRITEOUT SELECTS FILE TO BE WRITEN DURING DISK-TAPE 321000 MERGE PHASE* 322000 WRITEOUT: 323000 IS THIS FINAL MERGE YES GO XB* 324000 IS THIS DISK-TAPE MERGE NO GO XA* 325000 CALL DISKWRITE (DISK-DISK MERGE)* 326000 GO EXIT* 327000 XA: CALL TAPEWRITE (DISK-TAPE MERGE)* 328000 GO EXIT* 329000 XB: 330000 NOTE FINAL MERGE TO PROGRAMMERS FINAL OUTPUT SOURCE* 331000 COUNT OUTCOUNT+1; 332000 IS OUTPUT A PROCEDURE NO GO XD* 333000 IS CALLER COBOL NO GO XC* 334000 INDICATE NO END-OF-FILE.. 335000 (ENDO~0)* 336000 CALL COBOL OUTPUT PROCEDURE.. 337000 (RECORD IS IN COMMON ARRAY OUTFIL)* 338000 GO EXIT* 339000 COL* 339100 XC: CALL ALGOL OUTPUT PROCEDURE PASSING EOF=FALSE AND OUTFIL.. 340000 (OUTFIL CONTAINS RECORD)* 341000 GO EXIT* 342000 XD: 343000 NOTE OUTPUT IS FILE* 344000 IS CALLER COBOL NO GO XE* 345000 CALL COBOL WRITE PASSING FILE OUTFIL* 346000 GO EXIT* 347000 XE: CALL ALGOL WRITE* 348000 IS OUTPUT FILE A DISK FILE.. 349000 (IS DF SET ) NO GO EXIT* 350000 DOES PARAMETER RETURNED FROM ALGOL WRITE INDICATE 351000 DISK OUTPUT FILE IS FULL NO GO EXIT* 352000 SPO IOR 83 AND TERMINATE* 353000 EXIT: EXIT* 354000 COL* 355000 ENTER* 355100 NOTE SUBROUTINE SUBMERGE SETS UP PSUDO FIB FOR STRING I IN DATA ROW I 356000 AND POINTS BUFFER PAIR I OF INFIL AT STRING I* 357000 SUBMERGE: 358000 NOTE GIVEN A MERGE FACTOR OF MS THERE ARE 2|MS BUFFERS FOR THE 359000 INPUT SCRATCH DISK FILE OR MS BUFFER PAIRS. THE MCP IS 360000 FAKED INTO THINKING THERE ARE MS FILES OF TWO BUFFERS EACH 361000 . THIS REQUIRES EACH BUFFER PAIR MUST HAVE A PSUEDO FIB 362000 SO THAT ACCESS TO RECORDS IN EACH STRING CAN BE CONTROLLED 363000 INDIVIDUALLY. ROW DATX [I] IS THE PSUDO FIB FOR STRING I. 364000 WE LOAD THE ROW DESCRIPTOR DATX [I] INTO BASE AND DEFINE.. 365000 IBC =BASE[0] (RECORDS LEFT IN BUFFER).. 366000 IRL =BASE[1] (RECORDS LEFT IN STRING).. 367000 ISL =BASE[2] (NUMBER OF BLOCKS OF STRING LEFT IN DISK 368000 AREA WHOSE INDEX IS IRC).. 369000 IDA =BASE[3] (DISK ADDRESS OF NEXT BLOCK).. 370000 IRC =BASE[4] =(INDEX OF AREA CONTING STRING).. 371000 BUFF = TOP I/O DESCRIPTOR FOR BUFFER PAIR I* 372000 POINT I AT STRING 0* 373000 XAA: IS THERE A STRING I YES GO XA* 374000 POINT VECTUR[I] AT HIGH KEY RECORD* 375000 ZERO RECORDS/STRING COUNTER.. 376000 (IRL~0)* 377000 GO TO XLOP* 378000 XA: POINT BASE AT PSUEDO FIB I.. 379000 (BASE ~ DATX[I])* 380000 SET Y TO INDEX OF BUFFER LOCATION OF BUFFER PAIR I.. 381000 (Y~2|I)* 382000 SET I/O DESCRIPTOR[Y] TO 30 WORD, ONE SEGMENT READ* 383000 POINT IDA AT ADDRESS OF TAG.. 384000 (IDA~LISA)* 385000 CONVERT IDA TO NUMERIC AND PUT IN FIRST WORD OF 386000 BUFFER[Y]* 387000 CALL MCP TO READ TAG.. 388000 (TAG IS READ INTO BUFFER[Y+1] AND WE WANT IT IN 389000 BUFFER[Y])* 390000 CALL WAIT FOR I/O COMPLETE ON BUFFER[Y]* 391000 INDEX IDA BY ONE (IDA IS NOW DISK ADDRESS OF FIRST 392000 BLOCK OF STRING I)* 393000 CONVERT IDA TO NUMERIC AND PUT IN FIRST WORD OF 394000 BUFFER[Y]* 395000 CALL MCP TO READ FIRST BLOCK OF STRING* 396000 NOTE MCP PERMUTES BUFFERS SO THAT BUFFER[Y] NOW CONTAINS TAG 397000 AND BUFFER[Y+1] CONTAINS BLOCK ONE* 398000 CALL WAIT FOR I/O COMPLETE ON BUFFER[Y]* 399000 POINT BUFF AT TAG SEGMENT IN BUFFER[Y]* 400000 SET PSUEDO FIB AS FOLLOWS.. 401000 IBC~BF (BF=RECORDS/BLOCK).. 402000 IRC~ BUFF[1] (INDEX OF AREA CONTAINING STRING).. 403000 IRL~ BUFF[2]-1 (RECORDS IN STRING).. 404000 ISL~ (BUFF[3] DIV OD)|(OD DIV D) (SEGMENTS LEFT IN AREA).. 405000 LISA ~BUFF[4] (ADDRESS OF NEXT TAG SEGMENT)* 406000 IS LISA = ZERO NO GO XB* 407000 SET EOF TO TRUE (NO MORE STRINGS)* 408000 XB: CALL INROWCHK (GETS ADDRESS OF BLOCK 2 TO IDA)* 409000 CONVERT IDA TO NUMERIC AND PUT IN FIRST WORD 410000 OF BUFFER[Y]* 411000 CALL MCP TO READ BLOCK 3* 412000 NOTE MCP PERMUTES SO THAT BLOCK #1 IS IN BUFFER[Y]* 413000 CALL INROWCHK (SETS IDA TO ADDRESS OF BLOCK # 3)* 414000 CALL WAIT FOR I/O COMPLETE ON BUFFER[Y]* 415000 POINT VECTOR[I] AT RECORD 1 IN BUFFER[Y]* 416000 XLOP: IS BUFFER PAIR MS SET UP YES GO XIT* 417000 I~I+1* 418000 GO TO XAA* 419000 XIT: EXIT* 420000 COL* 421000 ENTER* 421100 NOTE SUBROUTINE FIRSTSELECT DOES INITIAL SELECTION OF LOW RECORD* 422000 FIRSTSELECT: 423000 SET X TO 0* 424000 SET I TO MS-1* 425000 XA: INCREMENT I BY 1* 426000 PASS RECORDS POINTED AT BY VECTOR[X] AND VECTOR[X+1] TO 427000 CALLERS KEY COMPARE ROUTINE* 428000 IS RECORD POINTED AT BY VECTOR[X] "EARLIER-IN-SEQUENCE" 429000 (AS PER PARAMETER RETURNED BY KEY COMPARE ROUTINE) 430000 NO GO XB* 431000 VECTOR[I]~VECTOR[X+1]* 432000 GO XC* 433000 COL* 433100 XB: VECTOR[I]~VECTOR[X]* 434000 XC: INCREMENT X BY 2* 435000 IS X=STPP NO GO XA* 436000 NOTE STPP=SIZE OF VECTOR* 437000 VLOW ~V[I].[18:15]* 438000 NOTE VLOW IS NOW INDEX OF RECORD WHICH IS "NEXT-IN-SEQUENCE" 439000 RECORD* 440000 EXIT* 441000 COL* 442000 ENTER* 442100 NOTE SUBROUTINE LOWSELECT POINTS VLOW AT NEXT RECORD IN SEQUENCE* 443000 LOWSELECT: 444000 BOX IF VLOW IS EVEN SET X TO VLOW ELSE SET X TO 445000 NEXT EVEN NUMBER SMALLER THEN VLOW.. 446000 (X~VLOW AND (OCTAL 1777))* 447000 XA: 448000 I~ MS + X DIV 2 449000 (I~MS+X.[38:9])* 450000 CALL KEY COMPARE ROUTINE PASSING THE RECORDS POINTED AT 451000 BY VECTOR[X] AND VECTOR[X+1]* 452000 IS RECORD POINTED AT BY VECTOR[X] "EARLIER-IN-SEQUENCE" 453000 (AS PER THE PARAMETER RETURNED BY KEY COMPARE ROUTINE) 454000 NO GO XB* 455000 VECTOR[I]~VECTOR[X+1]* 456000 GO XC* 457000 COL* 457100 XB: VECTOR[I]~VECTOR[X]* 458000 XC: 459000 BOX IF I IS EVEN SET X TO I ELSE SET X TO 460000 NEXT LOWER EVEN VALUE OF I.. 461000 (X ~ VLOW AND (OCTAL 1777))* 462000 IS X=STPP NO GO XA* 463000 NOTE STPP = VECTOR SIZE* 464000 VLOW ~ V[I].[18:15]* 465000 NOTE VLOW NOW IS INDEX OF RECORD "NEXT-IN-SEQUENCE"* 466000 EXIT* 467000 COL* 468000 ENTER* 468100 SUBROUTINE SORTIT DEVELOPS STRINGS FROM PROGRAMMERS INPUT SOURCE 469000 PLACING THE STRINGS ON SCRATCH DISK* 470000 SORTIT: 471000 CALL MCP TO GET STORAGE FOR DATA ARRAY OF S+1 ROWS, EACH 472000 ROW TO HOLD ONE RECORD* 473000 CALL MCP TO GET STORAGE FOR VECTOR ARRAY. ONE ROW OF 474000 SIZE (2|S)-1* 475000 STPP ~(2|S)-1* 476000 CLEAR DATA ROW S* 477000 CALL HIVALU ROUTINE TO CREATE HIGH VALUE RECORD IN 478000 DATA ROW S* 479000 NOTE IF THIS IS NOT THE FIRST TIME SORIT WAS CALLED THEN TR INDICATES 480000 THE NUMBER OF RECORDS SAVED IN DISK AREA(ROW) 0* 481000 IS TR}0 NO GO XIPA* 482000 NOTE MUST LOAD DATA FROM DISK AREA 0* 483000 SET DISK OUTPUT FILE TO READ STATUS* 484000 CALL MCP TO OPEN FILE FOR INPUT(MCP WILL FILL BOTH 485000 BUFFERS WITH FIRST TWO BLOCKS)* 486000 CALL WAIT TO WAIT FOR FILE TO BE OPENED* 487000 OCDA ~OUTHEAD[10]+ 2|OD (DISK ADDRESS OF BLOCK # 3)* 488000 I~0 (POINT AT DATA ROW 0)* 489000 SET ORL=ORS (SIZE OF DISK AREA)* 490000 OBC~TBO (RECORDS/BLOCK)* 491000 XA: IS I0) NO GO XA* 608000 AC ~ TRUE* 609000 XA: IS CALLER COBOL OR MERGE ONLY REQUESTED NO GO XB* 610000 INCREMENT BLOCK COUNTER BY ONE* 611000 NOTE BY INCREMENTING BLOCK COUNTER, SORT CAN GET RID OF ANYTHING 612000 DELARED BY DOING "FALL-OUT-OF-BLOCK" COMMUNICATE* 613000 XB: R~ABS(R) (NEGATIVE RECORD SIZE FLAGS CALLER IS ALGOL)* 614000 MAKE DESCRIPTOR POINTING AT TAPE-TAPE MERGE SECTION 615000 (POLYMERGE) LOOK LIKE LABEL DESCRIPTOR* 616000 DECLARE ARRAYS TS,TC,TN (USED TO DEVELOP POLY PHASE 617000 DISTRIBUTION OF STRINGS ON TAPE)* 618000 IS MERGE ONLY FLAG (MF) ON YES GO POLYMERGE* 619000 IS INPUT DATA SOURCE A PROCEDURE NO GO XC* 620000 LISA~ 2|(INPUT BUFFER SIZE)* 621000 GO XD* 622000 COL* 622100 XC: LISA~0* 623000 XD: IS CORESIZE=0 NO GO XE* 624000 CORESIZE ~ 12000* 625000 XE: REDUCE CORESIZE BY THAT AMOUNT OF STORAGE KNOWN TO BE 626000 NEEDED.. (ABOUT 2000 WORDS PLUS INPUT BUFFER AREA)* 627000 ASSUME SORT AND MERGE MATRIX SIZE OF 512* 628000 LY: COMPUTE A MINIMUM BUFFER SIZE FOR DISK SUCH THAT.. 629000 MUST BE > 30.. 630000 MUST BE < 1023.. 631000 SHOULD BE SOME INTEGER MULTIPLE OF DISK SEGMENT SIZE.. 632000 MUST BE SOME INTEGER MULIPLE OF RECORD SIZE* 633000 LZ COMPUTE SCRATCH DISK INPUT BUFFER SIZE TO BE SOME INTEGER 634000 SIZE TO BE NO LESS THEN 150 WORDS IN LENGTH* 636000 COMPUT SCRATCH DISK OUTPUT BUFFER SIZE TO BE SOME MULTIPLE OF 637000 SCRATCH DISK INPUT BUFFER SIZE. SIZE TO BE NO LESS THEN 638000 450 WORDS* 639000 OCDA~CORESIZE-(2|SIZE OF SCRATCH DISK OUTPUT BUFFER).. 640000 OCDA IS NOW AMOUNT OF CORE LEFT FOR DATA AND VECTOR 641000 SORT ARRAYS* 642000 LOSA ~(OCDA-R) DIV 2|(SIZE OF SCRATCH DISK INPUT BUFFER).. 643000 (LOSA IS APPROXIMATE MERGE MATRIX SIZE)* 644000 IS LOSA < 2 NO GO XF* 645000 SET MERGE SIZE (M) TO 2* 646000 GO TO XG* 647000 XF: SET M TO SOME POWER-OF-TWO WHICH IS LARGEST POWER-OF-TWO 648000 THAT IS SMALLER THEN LOSA* 649000 XG: LOSA ~ (OCDA-R) DIV (R+3).. 650000 (LOSA IS APPROXIMATE SORT MATRIX SIZE)* 651000 IS LOSA < 2 NO GO XH* 652000 SET SORT MATRIX SIZE(S) TO 2* 653000 GO TO LX* 654000 XH: SET S TO THE LARGEST POWER-OF-TWO WHICH IS SMALLER 655000 THEN LOSA* 656000 LX: IS ACTUAL AMOUNT OF CORE USED LESS THEN AMOUNT AVAILABLE 658000 NO GO XI* 659000 PUSH UP BOTH INPUT AND OUTPUT SCRATCH DISK BUFFER SIZES 660000 SO ALL OF AVAILABLE CORE WILL BE USED.. 661000 (PUSH UP IS IN INCREMENTS OF MINIMUM BUFFER SIZE)* 662000 XI: COMPUTE D = SEGMENTS/DISK INPUT BUFFER* 663000 COMPUTE BF = RECORDS/DISK INPUT BUFFER* 664000 COMPUTE TBO= RECORDS/DISK OUTPUT BUFFER* 665000 IS DISKSIZE 0 NO GO XJ* 666000 SET DISKSIZE TO 600000 WORDS* 667000 XJ: COMPUTE DISK AREA (ROW) SIZE.. 668000 ROWSIZE = DISKSIZE DIV (BF|R|19)* 669000 INSURE ONE DISK AREA WILL HOLD ALL OF DATA ARRAY.. 670000 ADJUST AREA SIZE LARGER IF NECESSARY* 671000 SET Y TO DIFFERENCE BETWEEN INPUT AND OUTPUT DISK BLOCKING 672000 FACTORS.. 673000 Y~TBO DIV BF* 674000 ADJUST DISK AREA SIZE SO THAT EACH DISK AREA WILL HOLD 675000 SOME INTEGER NUMBER OF BLOCKS.. 676000 I.E. (AREA SIZE) MO0 Y MUST = 0* 677000 COMPUTE OD = SEGMENTS/DISK OUTPUT BUFFER* 678000 IN FIB FOR DISK OUTPUT FILE SET UP FOLLOWING.. 679000 INDICATE 20 AREAS.. 680000 AREA SIZE.. 681000 NUMBER OF BUFFERS = 2.. 682000 SORT FLAG.. 683000 SET RECORD SIZE = BLOCK SIZE = TBO|R.. 684000 INSURE FILE INDEX IS IN FIB[4]* 685000 CALL MCP TO OPEN DISK OUTPUT FILE* 686000 HAS TAPE BACK-UP BEEN REQUESTED YES XK* 687000 PUT SORT FLAG IN OUTPUT FILES HEADER [8]* 688000 NOTE WILL CAUSE MCP TO NOTIFY SORT OF "NO DISK" CONDITION INSTEAD 689000 OF OPERATOR* 690000 XK: CALL WAIT FOR FILE TO BE OPENED* 691000 SET MOREDATA TRUE* 692000 SET TR=-1 (FLAGS FIRST CALL ON SORTIT)* 693000 CALL GETROW TO GET SPACE FOR AREA 0* 694000 IS DISKFULL NO GO XL* 695000 SPO IOR 81 AND TERMINATE* 696000 NOTE NOT ENOUGH DISK TO DO DISK SORT* 697000 EXIT* 698000 XL: 699000 NOTE INITIALIZE INPUT DATA SOURCE* 700000 IS INPUT SOURCE A PROCEDURE NO GO XM* 701000 IS CALLER COBOL NO GO XN* 702000 SET UP COBOL PROCEDURE LINKAGE* 703000 XN: CALL MCP TO GET STORAGE FOR COMMON ARRAY INFIL* 704000 GO TO CALLSORT* 705000 XM: IS CALLER COBOL NO GO XO* 706000 CALL COBOL FILE CONTROL TO OPEN INFIL FOR INPUT* 707000 GO TO CALLSORT* 708000 XO: SET INFIL TO READ STATUS* 709000 CALL ALGOL READ (WHICH WILL OPEN INFIL AND READ FIRST 710000 RECORD) 711000 WAIT FOR FILE TO BE OPENED* 712000 COL* 713000 CALLSORT: CALL SORTIT (WILL SORT INPUT INTO STRINGS UNTIL INPUT 714000 IS EXAUSTED OR DISK IS FULL)* 715000 IS EOF SET NO GO XP* 716000 IS INPUT SOURCE A FILE NO GO XP* 717000 CLOSE INPUT FILE WITH LOCK* 718000 IS INCOUNT=0 NO GO XP* 719000 SPO IOR 86 AND TERMINATE* 720000 NOTE NO DATA TO SORT* 721000 EXIT* 722000 COL* 722100 XP: IS MOREDATA SET NO GO XT* 723000 NOTE SAVE CONTENTS OF DATA IN DISK AREA 0* 724000 SET OCDA AT DISK ADDRESS OF FIRST SEGMENT OF AREA 0* 725000 SET TR TO 0 (COUNTS RECORDS SAVED FROM DATA ON DISK)* 726000 OBC~ RECORDS/BLOCK (TB0)* 727000 ORL~ SIZE OF AREA (ORS)* 728000 SET I TO ZERO* 729000 XQ: IS I < S NO GO XS* 730000 IS EOI FLAG IN VECTOR[I] SET 731000 (VECTOR[I].[5:1]=1 IF DATA[I] CONTAINS GOOD RECORD) 732000 YES GO XR* 733000 TR~TR+1* 734000 MOVE RECORD FROM DATA[I] TO DISK OUTPUT BUFFER* 735000 RESET WRITE BLOCK FLAG* 736000 CALL DISKWRITE* 737000 XR: I~I+1* 738000 GO TO XQ* 739000 XS: SET WRITE BLOCK FLAG TRUE* 740000 CALL DISKWRITE* 741000 XT: SAVE EOF AND MOREDATA IN AC* 742000 RETURN CORE STORAGE FOR DATA AND VECTOR ARRAYS* 743000 STPP ~(MS|2)-2 (STPP=MERGE VECTOR ARRAY)* 744000 DECLARE DISK FILE INF AS HAVING.. 745000 2|M BUFFERS.. 746000 BUFFER SIZE = BF|R* 747000 NOTE WILL BECOME DISK INPUT FILE * 748000 BUILD A DESCRIPTOR OF SIZE 2|M POINTING AT FIRST BUFFER. 749000 PLACE IN ITOP.. 750000 (ITOP LOOKS LIKE MOTHER DESCRIPTOR WITH I/O DESCRIPTORS 751000 WORKING AS ROW DESCRIPTORS)* 752000 CALL MCP TO OPEN FILE* 753000 IS TAPE-BACKUP INDICATED NO GO XU* 754000 SET SORT FLAG IN THIS FILES HEADER[8]* 755000 XU: 756000 BOX IF MCP GOT DISK SPACE FOR AREA 0 OF THIS 757000 FILE CALL MCP TO RETURN IT* 758000 SET THIS FILES FIB TO INDICATE INPUT AND TWO BUFFERS.. 759000 (FAKES MCP INTO THINKING THIS IS M FILES OF 2 BUFFERS 760000 PER FILE)* 761000 CALL MCP TO GET CORE SPACE FOR VECTOR ARRAY.. 762000 ONE DIMENSION OF (2|M)-1 WORDS IN SIZE* 763000 CALL MCP TO GET STORAGE SPACE FOR DATA ARRAY.. 764000 M+1 DIMESIONS OF 5 WORDS EACH* 765000 NOTE EACH DATA ROW I IS PSUDEO FIB FOR BUFFER PAIR I* 766000 CALL MCP TO GET SPACE FOR HIGH-KEY RECORD* 767000 CALL HIVALU TO FILL HIGH-KEY RECORD* 768000 SET ALL (2|M) I/O DESCRIPTORS TO INPUT STATUS* 769000 COL* 770000 DKC: IS THIS DISK-ONLY MERGE NO GO TPAA* 771000 IS THIS FINAL MERGE YES GO DKF* 772000 CALL MCP TO RETURN DISK SPACE FOR OUTPUT DISK AREA 0.. 773000 (SPACE NOT NEEDED TO OVERLAY SORT PHASE DATA ARRAY)* 774000 EXCHANGE DISK INPUT AND DISK OUTPUT FILES DISK SPACE BY 775000 EXCHANGEING HEADERS, I.E. DISK INPUT FILE NOW POINTS AT 776000 SORTED STRINGS AND DISK OUTPUT FILE POINTS AT SCRATCH 777000 DISK SPACE)* 778000 SRI~ORI (NUMBER OF AREAS IN DISK INPUT AREA)* 779000 CALL MCP TO ASSIGN THE DISK SPACE FOR AREAS 1 THRU SRI 780000 FOR DISK OUTPUT FILE (IF NOT ALREADY ASSIGNED)* 781000 IS DISK FULL NO GO XUA* 782000 CALL FORGETDISK TO RETURN AREA JUST GOT* 782100 GO TO TPA* 782200 NOTE CAN DO DISK ONLY SORT-MERGE* 783000 XUA: POINT COIOD AT TOP I/O DESCRIPTOR OF DISK OUTPUT FILE* 786000 DKD: SET LOSA FROM OUTPUT FILE HEADER[11].. 787000 (ADDRESS OF 1ST TAG)* 788000 OCDA ~LOSA+1 (ADDRESS OF FIRST BLOCK TO BE WRITTEN)* 789000 POINT SRI AND ORI AT AREA 1* 790000 SET AMOUNT-OF-STRING-IN-AREA AND AMOUNT-OF-AREA-LEFT TO 791000 AREA SIZE LESS 1.. 792000 (SRS~ORL~ORS-1)* 793000 DKE: SET LISA AT DISK ADDRESS OF FIRST INPUT TAG.. 794000 (LISA~INHEAD[11])* 795000 SET MOREDATA TRUE* 796000 SET EOF AND DISKFULL TO FALSE* 797000 SET STRING COUNTER (ONS) TO ZERO* 798000 CALL SUBMERGE (POINTS EACH BUFFER PAIR IN INPUT FILE AT 799000 INPUT STRING)* 800000 CALL MERGIT (FOR DISK-ONLY MERGES ALL STRING FROM INPUT 801000 DISK AREA TO FEWER BUT LONGER STRINGS IN OUTPUT AREA. IF 802000 LESS THEN M STRINGS WHERE PRODUCED MERGEIT SETS FM TRUE)* 803000 IS FM SET YES GO TO TPC* 804000 SET MOREDATA FALSE* 805000 CALL WRITETAG (WRITES "LAST-STRING" TAG)* 806000 DKF: REVERSE DISK INPUT AND OUTPUT AREAS BY REVERSING FILE 807000 HEADERS* 808000 IS NUMBER OF STRINGS (ONS) IN (WHAT IS NOW INPUT AREA) 809000 MORE THAN THE NUMBER WHICH CAN BE MERGED IN ONE PASS 810000 YES GO DKD* 811000 SET FM TO TRUE* 812000 SET MERGE SIZE (MS) TO A POWER-OF-TWO WHICH IS JUST 813000 GREATER THEN THE NUMBER OF STRINGS ON DISK* 814000 STPP~ NEW MATRIX SIZE* 815000 CALL FILE CONTROL TO CLOSE DISK OUTPUT FILE* 816000 CALL OPENOUT TO SET UP PROGRAMMERS OUTPUT MEDIA* 817000 COIOD ~ OUTFIL* 818000 NOTE IF OUTPUT IS FILE COIOD POINTS AT BUFFER, IF PROCEDURE THEN 819000 COMMON ARRAY* 820000 GO TO DKE* 821000 COL* 822000 TPAA: 823000 NOTE DISK-TAPE MERGE* 824000 EXCHANGE DISK INPUT AND OUTPUT AREAS BY REVERSING 825000 HEADERS* 826000 TPA: CALL FILE CONTROL TO CLOSE DISK OUTPUT FILE* 827000 POINT LISA AT FIRST TAG IN INPUT FILE.. 828000 LISA ~ INHEAD[11]* 829000 SET MOREDATA TO TRUE* 830000 SET EOF AND DISKFULL TO FALSE* 831000 SET STRING COUNTER TO ZERO* 832000 TPB: DOES THEN CURRENT OUTPUT TAPE HAVE THE CORRECT NUMBER OF 833000 STRINGS WRITTEN ON IT.. 834000 (IS TN[COT]}TC[COT]) YES GO XV* 835000 CALL SELECT (POINTS AT ANOTHER TAPE)* 836000 GO TO TPB* 837000 XV: CALL SUBMERGE (POINTS EACH BUFFER PAIR OF INPUT FILE AT 838000 A STRING)* 839000 CALL MERGEIT (FOR DISK-TAPE MERGES M STRINGS TO ONE)* 840000 IS INPUT DISK FILE EMPTY (EOF SET ) NO GO TPB* 841000 REVERSE DISK INPUT AND OUTPUT AREAS BY EXCHANGING 842000 HEADERS* 843000 TPC: CALL MCP TO RETURN CORE SPACE FOR DATA ARRAY* 844000 CALL FORGETDISK TO RETURN DISK SPACE FOR INPUT DISK 844100 SCRATCH FILE* 844200 ZERO MY STACK POINTERS AT 845000 INHEAD,INFIB,BASE,ITOP AND BUFF (GOOFS OVERLAY IF 846000 I DONT)* 847000 DO FALL OUT OF BLOCK COMUNICATE TO RETURN EVERY THING 848000 ELSE SET UP FOR MERGING* 849000 IS FM SET YES GO WRAPUP* 850000 RESTORE EOF AND MOREDATA FROM AC* 851000 GO TO CALLSORT* 852000 COL* 852100 WRAPUP: 853000 CALL FORGETDISK TO RETURN DISK SPACE FOR OUTPUT DISK 853100 SCRATCH FILE* 853200 WAS THIS DISK-DISK MERGE YES 854000 GO TO POLYMERGE* 855000 NOTE POLYMERE DOES TAPE-TAPE MERGE* 856000 SORTDOE: CLOSE AND RELEASE DISK OUTPUT FILE* 857000 IS OUTPUT MEDIA A FILE NO GO XW* 858000 CLOSE PROGRAMMERS OUTPUT FILE WITH LOCK* 859000 BOX IF FILE IS DISK AND CALLER IS ALGOL MARK FILE 860000 AS PERMANENT FILE (ZERO FIB[8])* 861000 GO XX* 862000 XW: CALL OUTPUT PROCEDURE PASSING END-OF-FILE INDICATOR* 863000 XX: IS OUTCOUNT = INCOUNT YES GO XY* 864000 SPO OUTCOUNT,INCOUNT, IOR 82.. 865000 (RECORDS READ ! RECORDS SORTED)* 866000 DO FALL-OUT-OF-BLOCK COMMUNICATE TO RETURN EVERYTHING 867000 USED BY SORT* 868000 EXIT* 869000 END; 870000 COMMENT FLOW BEGIN 871000 HEADING SUBROUTINE SECTION TAPE-TAPE MERGE PHASE..* 873000 NOTE THE FOLLOWING SUBROUTINES ARE IDENTICIAL WITH SORT PHASE.. 874000 WAIT.. 875000 RELEASETAPE.. 876000 TAPEWRITE.. 877000 WRITESTOPPER.. 878000 OPENOUT.. 879000 FIRSTSELECT.. 880000 LOWSELECT..* 881000 COL* 882000 ENTER* 882100 NOTE SUBROUTINE TAPE READ READS TAPES PRODUCED BY DISK-TAPE MERGE* 883000 TAPEREAD: 884000 CIIOD ~ TP[VLOW+1] (TOP I/O DESCRIPTOR OF TAPE TO 885000 BE READ)* 886000 POINT PRFIB AT FIB FOR TAPE TO BE READ* 887000 RECORD COUNTER PLUS ONE (PRFIB[9])* 888000 IS BUFFER EMPTY (PRFIB[11]=0) NO GO XA* 889000 POINT VECTOR[VLOW] AT NEXT RECORD IN BUFFER* 890000 GO RTNDR* 891000 XA: Y~ FIRST WORD IN BUFFER* 892000 IS Y=0 YES GO XB* 893000 TRA: 894000 NOTE Y!0 FLAGS LAST BLOCK OF STRING OR DUMMY STRING* 895000 SET DF TRUE (FLAGS STRING EXAUSTED)* 896000 IS Y.[33:15] = PRFIB[9].[33:15] YES GO XB* 897000 SPO IOR 85 (NUMBER OF RECORDS PUT IN STRING DONT AGREE 898000 WITH NUMBER OF RECORDS READ BACK)* 899000 XB: CALL MCP TO READ NEXT BLOCK* 900000 TRX: CALL WAIT FOR I/O COMPLETE* 901000 IS I/O DESCRIPTOR MARKED AS PRESENT YES GO XC* 902000 CALL FILE CONTROL PASSING "SORT-INPUT" FLAG.. 903000 WILL DO REEL SWITCHING IF END-OF-REEL.. 904000 WILL SPO IOR 19 IF PARITY... 905000 WILL RETURN EOF=TRUE IF END OF FILE* 906000 IS EOF SET NO GO TRX* 907000 XC: IS EOF SET YES GO RTNDR* 908000 IS FIRST WORD IN BUFFER ZERO NO GO XD* 909000 SET BLOCK COUNTER FROM TBO (RECORDS/BLOCK)* 910000 GO XE* 911000 XD: SET BLOCK COUNTER FROM [18:15] OF FIRST WORD IN BUFFER* 912000 NOTE END OF STRING BLOCK MAY BE ONLY PARTIALLY FILLED* 913000 XE: POINT TOP I/O DESCRIPTOR PAST FIRST WORD IN BUFFER* 914000 IS DF (END-OF-STRING) SET YES GO RTNDR* 915000 IS BLOCK COUNTER ZERO YES GO TRA* 916000 POINT VECTOR[VLOW] AT FIRST RECORD IN BUFFER* 917000 RTNDR: IS EOF OR DF SET NO GO XIT* 918000 POINT VECTOR[VLOW] AT HIGH-KEY RECORD* 919000 SET DF AND EOF TO FALSE* 920000 XIT: EXIT* 921000 COL* 922000 ENTER* 922100 NOTE SUBROUTINE INREAD READS PROGRAMMERS MERGE FILES* 923000 INREAD: 924000 POINT CIIOD AT TAPE TO BE READ.. 925000 (CIIOD~TP[VLOW+1])* 926000 POINT PRFIB AT FIB OF FILE TO BE READ* 927000 IS CALLER COBOL NO GO XA* 928000 CALL COBOL READ* 929000 SET TC[VLOW] (EOF FLAG) TO PARAMETER COBOL READ RETURNS* 930000 GO XB* 931000 COL* 931100 XA: CALL ALGOL READ* 932000 SET TC[VLOW] (EOF FLAG) TO PARAMETER ALCOL READ RETURNS* 933000 XB: IS EOF SET (TC[VLOW]) YES GO XC* 934000 POINT CORE ADDRESS OF VECTOR[VLOW] AT CORE ADDRESS OF 935000 TOP I/O DESCRIPTOR* 936000 GO XIT* 937000 XC: POINT VECTOR[VLOW] AT HIGH-KEY RECORD* 938000 XIT: EXIT* 939000 COL* 939100 COL* 940000 ENTER* 940100 NOTE SUBROUTINE WRITEOUT SELECTS FILE TO BE WRITTEN DURING MERGE* 941000 WRITEOUT: 942000 IS THIS FINAL MERGE YES GO XA* 943000 CALL TAPEWRITE* 944000 NOTE WRITES ON SCRATCH MERGE TAPES* 945000 GO XIT* 946000 XA: 947000 NOTE WRITES ON PROGRAMMERS OUTPUT MEDIA* 948000 INCREMENT OUTCOUNT BY ONE* 949000 IS OUPUT MEDIA A PROCEDURE NO GO XB* 950000 CALL OUTPUT PROCEDURE* 951000 NOTE OUTPUT RECORD IS IN COMMON ARRAY OUTFIL* 952000 GO XIT* 953000 XB: 954000 NOTE OUTPUT MEDIA IS AS A FILE* 955000 IS CALLER COBOL NO GO XC* 956000 CALL COBOL WRITE ROUTINE PASSING FILE OUTFIL* 957000 GO XIT* 958000 XC: CALL ALGOL WRITE ROUTINE PASSING OUTFIL* 959000 IS OUTPUT FILE A DISK FILE NO GO XIT* 960000 DOES PARAMETER RETURNED BY ALGOL WRITE INDICATE 961000 DISK OUTPUT FILE IS FULL NO GO XIT* 962000 SPO IOR 83 AND TERMINATE* 963000 XIT: EXIT* 964000 COL* 965000 ENTER* 965100 NOTE SUBROUTINE MERGEIT MERGES M STRINGS (OR TAPES) TO A SINGLE STRING 966000 (OR TAPE)* 967000 MERGEIT: 968000 MIC: CALL FIRSTSELECT* 969000 GO MIE* 970000 MID: LOWSELECT* 971000 MIE: DOES VLOW POINT AT HIGH-KEY RECORD YES GO XB* 972000 MOVE RECORD POINTED AT BY VECTOR[VLOW] TO BUFFER 973000 POINTED AT BY COIOD* 974000 CALL WRITEOUT* 975000 IS THIS MERGE-ONLY NO GO XA* 976000 NOTE PROGRAMMER USING MERGE* 977000 CALL INREAD* 978000 GO MID* 979000 XA: 980000 NOTE TAPE-TAPE MERGE PORTION OF SORT* 981000 CALL TAPEREAD* 982000 GO MID* 983000 XB: IS ALL VECTOR[I] POINTING AT HIGH-KEY RECORD YES GO XIT* 984000 POINT VLOW AT I* 985000 GO MIE* 986000 XIT: EXIT* 987000 COL* 988000 END; 989000 BEGIN COMMENT FLOW 990000 HEADING TAPE-TAPE MERGE AND MERGE-ONLY SECTION* 992000 START: 993000 CUT STACK SO TOP-OF-STACK IS LOCATION OF CIIOD* 994000 NOTE THIS CODE IN ADDITION TO THE WAY MCP SETS UP STACK ON GO TO IN 995000 SORT SECTION RESULTS IN BOTH SECTIONS HAVING THE SAME STACK. 996000 THIS MEANS THAT ALL STACK DECARATIONS IN THESE TWO SECTIONS 997000 MUST BE IDENTICIAL AS TO NUMBER* 998000 SET TM1 TO NUMBER-OF-TAPES MINUS 1* 999000 SET MS(MATRIX SIZE) TO A POWER-OF-TWO WHICH IS EQUAL TO 1000000 OR GREATER THEN THE NUMBER OF TAPES TO BE MERGED* 1001000 IS THIS MERGE-ONLY NO GO XTTT* 1002000 NOTE MERGE ONLY* 1003000 POINT TP AT FIRST MERGE TAPE* 1004000 CALL MCP TO GET CORE STORAGE FOR VECTOR ARRAY. ONE 1005000 DIMESION OF SIZE (2|M)-1* 1006000 CALL MCP TO GET CORE STORGE FOR HIGH-KEY RECORD* 1007000 CALL HIVALU TO FILL HIGH-KEY RECORD* 1008000 SET VLOW TO ZERO* 1009000 XA: SET TAPE[VLOW+1] TO INPUT* 1010000 CALL FILE CONTROL TO OPEN TAPE[VLOW+1]* 1011000 IS TAPE[VLOW+1] OPTIONAL.. 1012000 (AS INDICATED BY MCP) NO GO XB* 1013000 SET EOF FLAG (TC[VLOW) TO TRUE* 1014000 GO XC* 1015000 XB: CALL WAIT FOR TAPE TO BE OPENED* 1016000 BOX IF CALLER IS COBOL CALL INREAD TO READ FIRST RECORD* 1017000 XC: ALL TAPES OPENED YES GO XD* 1018000 POINT VLOW AT NEXT TAPE* GO XA* 1019000 XD: SET I TO ZERO* 1020000 XDA: IS I > TM1 YES GO XE* 1021000 IS EOF FLAG SET FOR TAPE[I].. 1022000 (TC[I]=1) YES GO XE* 1023000 POINT VECTOR[I] AT HIGH-KEY RECORD* 1024000 GO XF* 1025000 COL* 1025100 XE: POINT VECTOR[I] AT FIRST RECORD IN BUFFER OF TAPE[I]* 1026000 IS I } MS-1 NO GO XDA* 1027000 CALL OPENOUT (OPENS PROGRAMMERS OUTPUT MEDIA)* 1028000 POINT COIOD AT OUTPUT AREA* 1029000 SET STPP TO SIZE OF VECTOR ARRAY* 1030000 CALL MERGEIT* 1031000 GO TO SORTDONE* 1032000 COL* 1033000 XTTT: 1034000 NOTE INITIALIZATION OF TAPE-TAPE MERGE AFTER DISK-TAPE SORT* 1035000 NOTE WRITE OUT DUMMY STRING TO GET PERFECT DISTRIBUTION ON EACH SCRATCH 1036000 MERGE TAPE* 1037000 POINT I AT LAST SCRATCH OUTPUT TAPE(INDEX IS COT)* 1038000 XTA: IS NUMBER OF STRINGS ON TAPE[I] = NUMBER DESIRED.. 1039000 (TN[I]=TC[I]) YES GO XTC* 1040000 IS I=COT YES GO XTB* 1041000 CALL MCP TO POINT COMMON BUFFERS AT TAPE[I] AND MAKE 1042000 TAPE[COT] LOOK LIKE REWOUND WITH NO BUFFERS* 1043000 SET COT = I* 1044000 COL* 1044100 XTB: CALL WRITESTOPPER TO WRITE DUMMY STRINGS ON TAPE[I] 1045000 UNTIL TAPE[I] CONTAINS TC[I] STRINGS* 1046000 XTC: IS TAPE JUST SET UP= TAPE[TM1] YES GO XTD* 1047000 POINT I AT NEXT TAPE* 1048000 GO TO XTA* 1049000 XTD: REWIND ALL SCRATCH TAPES* 1050000 CALL MCP TO GET STORAGE FOR VECTOR ARRAY. ONE DEMESTON 1051000 OF SIZE (2|M)-1* 1052000 POINT STPP AT SIZE OF VECTOR ARRAY* 1053000 CALL MCP TO GET STORAGE FOR HIGH-KEY RECORD* 1054000 CALL HIVALU TO FILL IN HIGH-KEY RECORD* 1055000 SET I TO ONE* 1056000 XTE: SET TAPE[I] TO INPUT* 1057000 CALL MCP TO OPEN TAPE[I]* 1058000 CALL WAIT FOR TAPE[I] TO BE OPENED* 1059000 POINT I/O DESCRIPTOR FOR TAPE[I] PAST TAG WORD 1060000 IN FIRST WORD OF BUFFER* 1061000 IS I = TM1 NO GO XTE* 1062000 TPB: SET FM TRUE* 1063000 SET FM FALSE IF ANY TAPE CONTAINS MORE THEN ONE STRING.. 1064000 (TN[I]>1)* 1065000 IS FM SET NO GO XTF* 1066000 CALL OPENOUT (SETS UP PROGRAMMERS OUTPUT MEDIA)* 1067000 POINT COIOD AT OUTPUT AREA* 1068000 GO TPE* 1069000 XTF: POINT COIOD AT TP[NT] (CURRENT OUTPUT TAPE)* 1070000 SET TAPE[NT] TO OUTPUT* 1071000 CALL MCP TO OPEN TAPE[NT]* 1072000 CALL WAIT FOR TAPE[NT] TO BE OPENED* 1073000 POINT I/O DESCRIPTOR PAST TAG WORD IN FIRST WORD OF 1074000 BUFFER* 1075000 TPE: SET I TO ZERO* 1076000 XTFA: IS I > TM1 NO GO XTG* 1077000 SET EOF TO TRUE* 1078000 GO TPF* 1079000 XTG: IS EOF BIT IN I/O DESCRIPTOR TP[I+1] ON NO GO XTH* 1080000 SET EOF TO TRUE 1081000 GO TPF* 1082000 XTH: X~ TAG WORD FROM FIRST WORD IN BUFFER OF TAPE[I+1]* 1083000 IS X=0 YES GO TPF* 1084000 IS X.[33:15] = 0.. 1085000 (DUMMY STRING) NO GO TPF* 1086000 SET EOF TO TRUE* 1087000 TPF: DOES TAPE CONTAIN ANY STRINGS YES GO XTJ* 1088000 XTI: POINT VECTOR[I] AT HIGH-KEY RECORD* 1089000 GO XTK* 1090000 XTJ: IS EOF SET YES GO XTI* 1091000 POINT VECTOR[I] AT FIRST RECORD IN BUFFER OF TAPE[I+1]* 1092000 XTK: IS I = MS-1 YES GO XTL* 1093000 I~I+1* 1094000 GO TO XTFA* 1095000 XTL: CALL MERGEIT* 1096000 NOTE HAVE MERGED ONE STRING OFF EACH TAPE* 1097000 IS FM SET YES GO TO SORTDONE* 1098000 WRITESTOPPER* 1099000 (TN[I] ~ TN[I]-1* 1100000 IS ANY TAPE EMPTY.. 1101000 (TN[I]=0) NO GO TPE* 1102000 NOTE TAPE EMPTY, I POINTS AT WHICH ONE* 1103000 REWIND CURRENT OUTPUT TAPE* 1104000 CLOSE AND PURGE THE EMPTY INPUT TAPE(TAPE[I])* 1105000 MOVE STRING COUNTER FROM TN[NT] TO TN[I]* 1106000 SET TN[NT] TO ZERO* 1107000 SET TAPE[NT] TO INPUT (WAS OUTPUT)* 1108000 DECREMENT STRING COUNTER FOR EACH TAPE BY 1* 1109000 CALL MCP TO OPEN TAPE[NT] (WAS OUTPUT NOW INPUT)* 1110000 CALL WAIT FOR TAPE TO BE OPENED* 1111000 INDEX I/O DESCRIPTOR PAST TAG WORD IN BUFFER* 1112000 EXCHANGE POINTERS AT TP[NT] AND TP[I] SO THAT TP[NT] 1113000 ALWAYS POINT AT THAT TAPE WHICH IS TO BE OUTPUT* 1114000 GO TO TPD* 1115000 COL* 1116000 SORTDONE: 1117000 IS THIS TAPE-TAPE MERGE FOR SORT NO GO XTN* 1118000 IS THIS MERGE-ONLY NO GO XTM* 1119000 CLOSE WITH LOCK ALL MERGE TAPES* 1120000 GO XTN* 1121000 XTM: CLOSE WITH PURGE ALL SORT SCRATCH TAPES* 1122000 CALL MCP TO CLOSE WITH RELEASE SCRATCH DISK OUTPUT FILE* 1123000 XTN: IS OUTPUT MEDIA A PROCEDURE NO GO XTO* 1124000 CALL OUTPUT PROCEDURE PASSING END-OF-SORT FLAG* 1125000 GO XTP* 1126000 XTO: CALL FILE CONTROL TO CLOSE-LOCK PROGRAMMERS OUTPUT FILE* 1127000 BOX IF CALLER IS ALGOL, MARK OUTPUT FILE AS PERMANENT.. 1128000 (ZERO FILES FIB[8])* 1129000 XTP: IS THIS MERGE ONLY YES GO XTQ* 1130000 IS OUTCOUNT = INCOUNT YES GO XTQ* 1131000 SPO IOR 82 PASSING INCOUNT AND OUTCOUNT* 1132000 XTQ: EXECUTE FALL-OUT-OF-BLOCK COMMUNICATE TO RETURN 1133000 MERGE CORE STORAGE* 1134000 EXIT* 1135000 END; 1136000 END* 1137000 COMMENT FLOW* QUIT*; 1138000