{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: INCRV850)}}
====== INCRV850 ======
(George Source)
**Macros used:** [[george:macro:ALTLEN|ALTLEN]], [[george:macro:BC|BC]], [[george:macro:BS|BS]], [[george:macro:BXE|BXE]], [[george:macro:BXL|BXL]], [[george:macro:BXU|BXU]], [[george:macro:CHAIN|CHAIN]], [[george:macro:CLOSETOP|CLOSETOP]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:ISSUCOM|ISSUCOM]], [[george:macro:JMBAC|JMBAC]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MONOUT|MONOUT]], [[george:macro:NAME|NAME]], [[george:macro:OPENINC|OPENINC]], [[george:macro:OUTINCS|OUTINCS]], [[george:macro:OUTPARAM|OUTPARAM]], [[george:macro:OUTTSNS|OUTTSNS]], [[george:macro:READAGAIN|READAGAIN]], [[george:macro:RV|RV]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:STEP|STEP]], [[george:macro:STEPWRITE|STEPWRITE]], [[george:macro:UNNORM|UNNORM]], [[george:macro:UP|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