(George Source)
Macros used: ALTLEN, BC, BS, BXE, BXL, BXU, CHAIN, CLOSETOP, FREECORE, GEOERR, ISSUCOM, JMBAC, MENDAREA, MFREEW, MHUNT, MHUNTW, MONOUT, NAME, OPENINC, OUTINCS, OUTPARAM, OUTTSNS, READAGAIN, RV, SEG, SEGENTRY, SETNCORE, STEP, STEPWRITE, UNNORM, UP
22FL ... SEG INCRV,850,MIKE PUTNAM,INCDUMP 22^= # 23DW SEGENTRY K1INCRV,X1INCRV 23YG # 24D6 # THIS SEGMENT ISSUES RETRIEVES FOR ANY FILES NOT ON-LINE WHICH HAVE TH 24XQ ...# LAST RELIABLE DUMP ON PROCESSED INCREMENTS . 25CB ...# IF ALL TAPES FOR SUCH AN INCREMENT ARE WRONGED IT 26BL # LAUNCHES INTO A DIALOGUE WITH THE OPERATORS TO SEE IF THEY ARE EVER G 26W= ...# TO RIGHT A TAPE CONTAINING THIS INCR.. IF THEY ARE NOT, IT MARKS THE 27*W # INCR. AS OBSOLETE. ON ENTRY, THERE ARE FABSNB BLOCKS FOR EACH 27TG # FILE NEEDING RETRIEVING FROM OBSOLETE INCR. (PLUS A COUNT OF SUCH 28*6 # BLOCKS IN INCRV IN FINC BLOCK). 28SQ # 29#B ...NOTAPES 14HLOSE THE FILES 29S2 ...QUEST 36HQN 1,WILL A TAPE EVER BE AVAILABLE? 2=?L # 2=R= # SUBROUTINES 2?=W # 2?QG # TO LOOK AT THE NEXT BLOCK IN THE ACT. CHAIN & CHECK IT IS OF SPECI 2#=6 # TYPE (GEOERR INCBLOCK IF NOT) 2#PQ # ON ENTRY,X1-> BLOCK & LINK+1 CONTAINS BLOCK TYPE. X3 IS S/R LIN 2*9B # ON EXIT,X1-> NEXT BLOCK. USES X0. NO COORDINATION. 2*P2 # 2B8L NEXTBL 2BN= LDX 1 FPTR(1) 2C7W #SKI K6INCRV 2CMG ( 2D76 LDX 0 ATYPE(1) 2DLQ BXU 0 0(3),XWR [GEOERR IF WRONG BLOCK TYPE 2F6B ) 2FL2 EXIT 3 1 2G5L #SKI K6INCRV 2GK= XWR GEOERR BRIEFPM,INCBLOCK 2H4W # 2HJG # FINDS THE INCINDEX RECORD WHOSE NUMBER IS IN X5 & THEN STEPWRITES 2J46 # ON ENTRY,X5= INCR NO. TO FIND, INCINDEX OPEN IN GENERAL MODE. 2JHQ # X3 IS S/R LINK. 2K3B # ON EXIT, X1=FX1, X3-> RECORD JUST REWRITTEN. USES X0,X2,AWORK3. 2KH2 # MAY COORDINATE. 2L2L # 2LG= STEPWRITE 2L^W SBX 3 FX1 2MFG SMO FX2 2M^6 STO 3 AWORK3 [REMEMBER LINK IN AWORK3 2NDQ STEP 2NYB STEP 2PD2 #SKI K6INCRV 2PXL BZE 3 SEND [GEOERR INC NORV IF INCR NOT FOUND 2QC= BXU 5 AINCNOR(3),STEP [J IF NOT REQUIRED INCR RECORD 2QWW STEPWRITE 2RBG LDX 2 AWORK3(2) 2RW6 ADX 2 FX1 2S*Q EXIT 2 0 2STB # 2T*2 # 2TSL X1INCRV 2TXQ ...#UNS FPD 2W2W ... MHUNTW 1,FILE,FINCPROC 2W62 ...#UNS FPD 2W96 ...#SKI 2W#= MHUNTW 1,FILE,FINC 2WRW LDX 4 INCRV(1) [X4= COUNT OF FABSNBS FOR RETRIEVES 2X?G BZE 4 NORV [J IF NO RETRIEVES TO BE DONE 2XH# ... STOZ INCRV(1) [CLEAR COUNT OF RVS 2XR6 LDN 7 0 [ZEROISE COUNT OF APROC BLOCKS 2Y=Q OPENINC ,GENERAL [OPEN INCINDEX 2YQB MHUNTW 1,FILE,FABSNB [X1-> PST FABSNB 2^=2 LDN 6 1 [COUNT OF FABSNBS READ =1 2^PL NEXTINC 329= LDX 5 A1(1) [X5= INCR NO. IN FABSNB 32NW CALL 3 STEPWRITE [FIND & REWRITE INCR RECORD 338G ... LDX 2 AMTSR(3) [NO OF TAPES FOR INCREMENT 33N6 ... BZE 2 YTAPES [SHOULDNT HAPPEN THAT THERE ARE NONE 347Q ... [BUT IF SO IGNORE INCREMENT. 34MB ... LDX 1 3 [COPY PTR TO RECORD 3572 ...TAPECHECK 35LL ... JMBAC YTAPES,1,BMOPWRR,BMUSWRR [J IF TAPE NOT WRONGED 366= ... ADN 1 INCMAGLEN [UPDATE PTR TO GIVE NEXT TAPE 36KW ... BCT 2 TAPECHECK [LOOP IF MORE 38JB ADN 7 1 [UPDATE COUNT OF APROC BLOCKS 3942 READAGAIN 39HL MHUNTW 1,FILE,FRB 3=3= NAME 1,FILE,APROC [PRESERVE INCR RECORD AS PROC BLOCK 3=GW MHUNTW 2,FILE,FINCPROC 3?2G CHAIN 1,BPTR(2) [CHAIN APROC BEFORE FINCPROC BLOCK 3?G6 ...YTAPES 3?^Q MHUNTW 1,FILE,FABSNB [X1-> 1ST FAB SNB 3#FB LDN 2 1 [INITIALISE TEMP. COUNT OF FABSNBS RE 3#^2 OLDFAB [FIND FABSNB WHICH HAD REACHED 3*DL BXE 2 6,NEWFAB [J IF REACHED REQUIRED FABSNB 3*Y= ADN 2 1 3BCW CALL 3 NEXTBL [X1-> NEXT BLOCK(FABSNB) 3BXG #HAL +FILE+FABSNB,0 3CC6 BRN OLDFAB 3CWQ NEWFAB 3DBB BXE 6 4,NOFAB [J IF NO MORE FABSNBS TO LOOK AT 3DW2 ADN 6 1 [UPDATE COUNT OF FABSNBS LOOKED AT 3F*L CALL 3 NEXTBL [X1-> NEXT BLOCK(FABSNB) 3FT= #HAL +FILE+FABSNB,0 3G#W LDX 0 5 3GSG SBX 0 A1(1) 3H#6 BPZ 0 NEWFAB [J IF INCR NO. NOT HIGHER 3HRQ BRN NEXTINC 3J?B NOFAB 3JR2 CLOSETOP 3K=L # 3KQ= # 3L9W NGN 5 1 [INITIALISE INCR NO. IN NEXT APROC BL 3LPG BZE 7 NXTFAB [J IF NO APROC BLOCKS PRESENT 3M96 MHUNTW 2,FILE,APROC 3MNQ LDX 5 AINCNO(2) [X5= INCR NO. IN 1ST APROC BLOCK 3N8B NXTFAB 3NN2 MHUNTW 1,FILE,FABSNB 3P7L LDX 0 A1(1) 3PM= BXL 0 5,NOQUEST [J IF CAN ISSUE THIS RETRIEVE WITHOUT 3Q6W [ ASKING QUESTIONS 3QLG # 3R66 # 3RKQ SETNCORE 2,3,FLIB,FLINC 3S5B LDN 0 1 3SK2 STO 0 A1(3) [INITIALISED FLIB/FLINC 3T4L NEWINC 3TJ= LDX 0 ALOGLEN(3) 3W3W ADN 0 1 3WHG STO 0 ACOMMUNE1(2) 3X36 ALTLEN 3,ACOMMUNE1(2),FLIB,FLINC [LENGTHEN FLIB/FLINC BY 1 WORD 3XGQ MHUNTW 1,FLIB,FLINC 3Y2B LDN 0 1 3YG2 ADS 0 A1(1) [UPDATE REC HEADER 3Y^L SMO ALOGLEN(1) 3^F= STO 5 A1-1(1) [INSERT INCR NO. INTO FLIB/FLINC 3^YW SBN 7 1 [DECREASE COUNT OF APROC BLOCKS 42DG BZE 7 MNOPROC [J IF NO MORE APROC BLOCKS 42Y6 MHUNTW 1,FILE,APROC 43CQ LDX 2 1 [X2-> 1ST APROC 43XB CALL 3 NEXTBL [X1-> 2ND APROC 44C2 #HAL +FILE+APROC,0 44WL LDX 5 AINCNO(1) [X5= INCR NO. IN NEXT APROC BLOCK 45B= LDX 6 AMTS(2) [X6= NO. OF MTS IN 1ST APROC 45TW BXU 6 AMTS(1),MDIFF [J IF NO. OF MTS IN THE 2 RECORDS DIF 46*G M2ND 46T6 LDX 3 AMAG(1) [X3= NEXT MT IN 2ND APROC 47#Q LDX 0 AMTS(2) [X0= NO. OF MTS 47SB M1ST 48#2 BXE 3 AMAG(2),MFOU [J IF FOUND MT IN 1ST APROC 48RL ADN 2 INCMAGLEN [UPDATE POINTER 49?= BCT 0 M1ST [J IF MORE MTS TO SEARCH 49QW BRN MDIFF [1ST & 2ND APROCS DIFFERENT 4==G MFOU 4=Q6 MHUNTW 2,FILE,APROC [X2-> 1ST APROC 4?9Q ADN 1 INCMAGLEN [UPDATE POINTER IN 1ST APROC 4?PB BCT 6 M2ND [J IF MORE MTS TO COMPARE 4#92 MFREEW FILE,APROC [APROCS CONTAIN SAME MTS 4#NL MHUNTW 3,FLIB,FLINC 4*8= BRN NEWINC 4*MW MNOPROC 4B7G NGN 5 1 [NO MORE APROC BLOCKS 4BM6 MDIFF 4C6Q OUTINCS [OUTPUT AS PARAMETER INCR NOS. IN FLI 4CLB OUTTSNS [OUTPUT AS PARAM, TSNS IN 1ST APROC 4D62 ... MONOUT INCUSEFUL [TELL OPS INCS AND TAPES 4DLS ...# 4DN2 ...[ ****************************************** 4DP8 ...[ CSS SPECIAL TO INHIBIT THE QUESTION 4DQB ...[ TO PREVENT THEIR LOW QUALITY OPERATORS FROM 4DRJ ...[ ANSWERING NO UNNECESSARILY 4DSQ ...[ 4DTY ... SEGENTRY K80INCRV 4DX6 ... NULL [MACRO REPLACES THIS WITH 4DY# ... [BRN K81INCRV 4D^G ...# 4F2N ...[ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 4F3W ...# 4FHG ... MONOUT INCTAPESWR [WARN OPS OF SIGNIFIANCE OF QUESTION 4G36 ... SETNCORE 9+CPDATA-A1,2,ADATA,CREADL [DATA BLOCK FOR ISSUCOM 4GGQ ... LDN 0 36 4LF6 STO 0 A1(2) [SET CHAR. COUNT 4LYQ STOZ A1+1(2) [CLEAR 2ND HEADER WORD 4MDB ADN 1 QUEST 4MY2 ADN 2 CPDATA 4NCL ... MOVE 1 9 [MOVE QUESTION TO ADATA/CREADL BLOCK 4NX= ISSUCOM QUESTERR [ASK OPS: "WILL A TAPE BE AVAILABLE?" 4PBW MHUNT 2,APED,ADISPLAY [X2-> BLOCK WITH ANSWER IN 4PWG LDX 0 APEDDISM(2) 4QB6 BZE 0 WRANS 4QTQ LDCH 6 APEDDISM+1(2) [X6= 1ST CHAR. OF REPLY 4R*B SBN 6 #71 4RT2 BZE 6 REPYES [J IF ANSWER "Y........" 4R^= ... SBN 0 14 4S5G ... BNG 0 WRANS [J IF NOT ENOUGH CHARS TO BE CORRECT 4S9Q ... LDN 6 14 [NO OF CHARS TO CHECK 4SB2 ...TESTCHAR 4SG= ... LDCH 0 APEDDISM+1(2) [PICK UP CHAR OF REPLY 4SLG ... LDCH 3 NOTAPES(1) [CHAR OF 'LOSE THE FILES' 4SQQ ... BXU 0 3,WRANS [ERROR IF NOT SAME 4SX2 ... BCHX 2 £ [UPDATE MODS AND TEST NEXT CHAR 4T3= ... BCHX 1 £ [IF THERE IS ONE 4T7G ... BCT 6 TESTCHAR 4T?W OUTINCS [OUTPUT AS PARAM. LIST OF INCR NOS. 4TRG [ IN FLIB/FLINC 4W?6 STO 5 AWORK2(2) [REMEMBER INCR NO. IN NEXT APROC 4WQQ OUTTSNS [OUTPUT AS PARAM. LIST OF TSNS 4X=B [ IN FILE/APROC 4XQ2 MONOUT INCOBSMT2 ["INCREMENT%A %B OBSOLETE ON MT%C %D" 4Y9L OPENINC ,GENERAL 4YP= LDN 6 0 [INITIALISE POINTER DOWN FLIB/FLINC 4^8W BRN NXTINC 4^NG NFIND 5286 SMO 6 52MQ LDX 5 A1+1(2) [X5= NEXT INCR NO. 537B CALL 3 STEPWRITE [LOCATE & REWRITE INCRRECORD 53M2 BS 3,BIOBSR [SET "INCR ONSOLETE" BIT 546L BC 3,BIPRNOBSR [REMOVE "PROC BUT NOT OBSOLETE" BIT 54L= MHUNTW 1,FILE,FABSNB 555W LDX 2 4 [X2= NO. OF FABSNBS 55KG TINC 5656 LDX 0 A1(1) 56JQ SBX 0 5 574B BZE 0 RFRFAB [J IF FAB NB FOR THIS INCR 57J2 BPZ 0 NXTINC [J IF NO MORE FABSNBS FOR THIS INCR 583L TNXTFAB 58H= SBN 2 1 592W BZE 2 NXTINC [J IF NO MORE FABSNBS 59GG CALL 3 NEXTBL [X1-> NEXT FABSNB 5=26 #HAL +FILE+FABSNB,0 5=FQ BRN TINC 5=^B NXTINC 5?F2 MHUNTW 2,FLIB,FLINC 5?YL ADN 6 1 5#D= BXU 6 A1(2),NFIND [J IF MORE INCR RECS TO UPDATE 5#XW CLOSETOP 5*CG LDX 5 AWORK2(2) [X5=INCR NO. IN NEXT APROC 5*X6 BRN RFREE 5BBQ WRANS 5BLJ ... MHUNT 2,APED,ADISPLAY 5BWB OUTPARAM APEDDISM(2),APEDDISM+1,APED,ADISPLAY [SET "REPLY" AS PAR 5CB2 MFREEW APED,ADISPLAY 5CTL MONOUT ANOTVAL ["%A IS NOT A VALID ANSWER" 5D9* ... BRN MDIFF 5DK4 ... SEGENTRY K81INCRV 5DSW REPYES [ANSWER "YES" (X6=0) 5F#G MONOUT INCMTAV [TO OPS CONSOLE = 5FS6 [ "MAKE TAPE AVAILABLE NOW PLEASE" 5G?Q RFREE 5GRB MFREEW FLIB,FLINC 5H?2 MFREEW FILE,APROC 5HQL BRN TMORE 5J== RFRFAB 5JPW LDX 3 BPTR(1) [PRESERVE FABSNB POINTER 5K9G SMO FX2 [ & COUNT OF FABSNBS LOOKED AT 5KP6 STO 2 ACOMMUNE1 5L8Q FREECORE 1 [FREE FABSNB 5LNB LDX 2 ACOMMUNE1(2) 5M82 LDX 1 3 5MML SBN 4 1 [DECREASE COUNT OF FABSNBS 5N7= BRN TNXTFAB 5NLW # 5P6G # 5PL6 NOQUEST 5Q5Q LDN 0 10 5QKB STO 0 A1(1) [RESTORE FABSNB REC HEADER 5R52 RV [RETRIEVE FILE 5RJL SETNCORE CPDATA-A1+10,2,ADATA,CREADL [BLOCK FOR UNNORM 5S4= STOZ A1(2) [ZEROISE CHAR. COUNT 5SHW STOZ A1+1(2) [CLEAR 2ND RED-TAPE WORD 5T3G UNNORM 5TH6 MHUNTW 2,ADATA,CREADL 5W2Q OUTPARAM A1(2),CPDATA,ADATA,CREADL 5WGB MONOUT BEREST [O MON FILE "%A IS BEING RETRIEVED" 5X22 MFREEW ADATA,CREADL 5XFL MFREEW FILE,FABSNB 5X^= SBN 4 1 [DECREASE COUNT OF FABSNBS 5YDW TMORE 5YYG BNZ 4 NXTFAB [J IF MORE FABSNBS 5^D6 #SKI K6INCRV 5^XQ BNZ 7 SEND [GEOERR IF APROC BLOCKS REMAIN 62CB NORV 62X2 UP 63BL # 63W= QUESTERR 64*W #SKI K6INCRV 64TG GEOERR BRIEFPM,INCQUES2 [NO ERROR FROM QUESTION COMMAND 65*6 SEND 65SQ #SKI K6INCRV 66#B GEOERR BRIEFPM,INC NORV [END OF INCINDEX WITHOUT FINDING 66S2 [ ALL RETRIEVES 67?L # 67R= MENDAREA 40,K99INCRV 68=W # 68QG #END ^^^^ ...23141562001000000000