(George Source)
Macros used: ACROSS, ALTLENG, BBUS, BC, BITDEFS, BS, BSXD, BXE, BXU, CHAIN, CLOSETOP, DELETE, DOWN, FON, FREECORE, GEOERR, HUNT2, HUNTMISB, HUNTW, INFORM, INSTPARA, JBC, JBS, LONGON, MBC, MENDAREA, MFREE, MFREEW, MHUNTW, MONOUT, NAME, OPENINC, OUTBLOCN, OUTINCS, OUTMOND, OUTNULL, OUTPACK, OUTPARAM, OUTPARN, OUTTSNS, PAIR, POP, READAGAIN, READBACK, REWRITE, SEG, SEGENTRY, SETBIT, SETNCORE, STEP, STEPAGAIN, STEPWRITE, TRACE, UP, VFREEW, VOP, WIND, XY
22FL ... SEG INCEND,864,FILESTORE,INCDUMP 22^= # 23DW SEGENTRY K1INCEND,X1INCEND 23SK ... SEGENTRY K2INCEND,(GEOERR) 248# ... SEGENTRY K3INCEND,X3INCEND 24D6 # 24XQ # CONSTANTS 25CB # 26BL MLANCOMP 4HC1 [LANGUAGE FOR COMPOSITE S/F 26W= NAMEINCR 12HGEORGE3DUMP [INCREMENT NAME 27*W SCLEANDAY 864000/K9*100 [NO. OF CLEANCTS IN DAY 27TG PFIN PAIR DTSTART,7 [END OF DUMP - DTA LINK PAIR 28*6 ...# 28SQ ...# AWORK1 SWITCH WORD - BIT DEFINITIONS (ALSO USED BY INCFIN) 29#B ...# 29S2 ... BITDEFS AWORK1,0,MBFINAL,MBEMS 2=?L ...#UNS AMTGR 2=R= ... BITDEFS AWORK1,2,MBPGENRES [ POTENTIALLY GENRESABLE 2?=W # 2?QG # SUBROUTINES 2#=6 # 2#PQ # THIS SUBR. FINS THE FLIB/FLINC BLOCK FOR ALTLENG. 2*9B SFINDFLINC 2*P2 MHUNTW 2,FLIB,FLINC 2B8L EXIT 1 0 2BN= # 2C7W # THIS DOES THE SAME WITH A FILE/FINTER BLOCK. 2CMG SFINDFINT 2D76 MHUNTW 2,FILE,FINTER 2DLQ EXIT 1 0 2F6B # 2FL2 # 2G5L # THIS SUBROUTINE SIMPLY DOES A STEPWRITE - WHOSE EXPANSION IS LENGTHY. 2GK= # ON ENTRY, X7 IS S/R LINK. 2H4W # ON EXIT, X1=FX1, X2=FX2, X3-> CURRENT RECORD. USES X0. MAY COORDINA 2HJG # 2J46 SWRITE 2JHQ SBX 7 FX1 2K3B STEPWRITE [ENSURE INFORMATION WRITTEN TO BS 2KH2 ADX 7 FX1 2L2L EXIT 7 0 2LG= # 2L^W # OPENS INCINDEX IN GENERAL MODE, DELETES ANY RECORDS NECESSARY IF CURR 2MFG # INCREMENT IS END-OF-BATCH AND ADJUSTS STATE WORD OF CURRENT INCR.. 2M^6 # CLOSES INCINDEX 2N6# ...# ALSO USED BY EMS ENTRY X2, WHICH ENTERS IT AT LABEL NOAPROC 2N?G ...# AND REQUIRES THAT INCINDEX BE LEFT OPEN 2NDQ # ON ENTRY, X5= CURRENT INCR. NO., X6= REPLY WORD. X4 IS S/R LIN 2NYB # ON EXIT, X1= FX1, X2= FX2, X5= CURRENT INCR. NO., X6= REPLY WORD. USE 2PD2 # ALSO USES X7 & AWORK4. 2PXL # 2QC= UPDATEINDEX 2QWW SBX 4 FX1 2RBG OPENINC ,GENERAL [OPEN INCINDEX (GENERAL MODE) 2RW6 STOZ AWORK4(2) [CLEAR "1ST RELIABLE INCR." WORD 2STB [MTS FOR WHICH BITNOWPR HAS TO BE SET 2T*2 QSTEP 2TSL STEP 2W#= #SKI K6INCEND 2WRW ( 2X?G BNZ 3 NOENDINC 2XR6 GEOERR BRIEFPM,INCINDEX [CANT FIND LAST INCR. REC. IN INCINDE 2Y=Q NOENDINC 2YQB ) 2^=2 BXE 5 AINCNOR(3),YLAST [J IF LAST INCR. 2^PL LDX 0 AWORK4(2) 329= BNZ 0 NORV [J IF PREVIOUS RELIABLE INCR EXISTS 32NW JBS NORV,3,BINSUITRVR [J IF INCR NOT SUITABLE FOR RETRIEVIN 338G LDX 0 AINCNOR(3) 33N6 STO 0 AWORK4(2) [AWORK4 = 1ST RELIABLE INCR. NO. 347Q NORV 34MB LDCT 0 #200 3572 ANDX 0 6 35LL BZE 0 QSTEP [J IF CURRENT INCR. NOT END OF BATCH 366= [ONLY REMOVE 'BEING REDUMPED' INCRS. 36KW [ END OF BATCH 36TN ... JBC QSTEP,,BATCHSTART 375G LDCT 0 #100 37K6 ANDX 0 6 384Q BZE 0 NOTOBS [J IF NOT GENERAL RESTOREABLE INCR. 38#J ... JBS OBS,3,BIOBSENT 38JB HUNTW 1,FILE,FINCPROC 3942 BNG 1 NOTOBS 39HL LDX 0 AINCNOR(3) [X0= NO. OF THIS INCR. 3=3= LDX 2 FINCNOBS(1) [X2= NO. OF STILL OBSOLETE INCRS. 3=GW BZE 2 NONEOBS [J IF NO INCREMENTS OBSOLETE 3?2G NFOUND 3?G6 SMO 2 3?^Q ... BXE 0 INCLISTS-1(1),OBS [J IF THIS INCR. OBSOLETE 3#FB BCT 2 NFOUND [J IF MORE INCR. NOS. TO SEARCH 3#^2 NONEOBS 3*DL LDX 2 FX2 3*Y= BRN NOTOBS 3BCW OBS 3BXG CALL 7 SWRITE [STEPWRITE 3CC6 BS 3,BIOBSR [MARK AS OBSOLETE 3CWQ BC 3,BIPRNOBSR [REMOVE PROC BUT NOT OBS BIT IF SET 3DBB READAGAIN 3DW2 MHUNTW 1,FILE,FRB 3F*L HUNTW 3,FILE,APROC 3FT= BNG 3 MAPROC [J IF 1ST NEWLY OBSOLETE INCR. 3G#W LDX 7 AMTS(1) 3GSG BXU 7 AMTS(3),MAPROC [J IF NO. OF TAPES DIFFERENT TO LAST 3H#6 [ NEWLY OBSOLETE INCR. 3HRQ MNEW 3J?B LDX 2 AMAG(1) [X2 = NEXT TSN IN NEW RECORD 3JR2 LDX 0 AMTS(3) [X0= NO. OF TAPES IN OLD RECORD 3K=L MOLD 3KQ= BXE 2 AMAG(3),MFOU [J IF TAPE FOUND 3L9W ADN 3 INCMAGLEN [UPDATE OLD RECORD POINTER 3LPG BCT 0 MOLD [J IF MORE TAPES TO SEARCH 3M96 MHUNTW 1,FILE,FRB [TAPES IN 3MNQ [RECORDS DIFFERENT SO SET UP NEW FLIN 3N8B [ & APROC 3NN2 MAPROC 3P7L NAME 1,FILE,APROC [NEW APROC 3PM= LDX 7 AINCNO(1) [NOTE INCR. NO. OF NEW RECORD 3Q6W SETNCORE 2,3,FLIB,FLINC [SET UP & INITIALISE NEW FLINC 3QLG LDN 0 1 3R66 STO 0 A1(3) 3RKQ BRN MEXTEND 3S5B MFOU 3SK2 MHUNTW 3,FILE,APROC 3T4L ADN 1 INCMAGLEN [UPDATE NEW RECORD POINTER 3TJ= BCT 7 MNEW [J IF MORE TAPES IN NEW RECORD 3W3W [ 3WHG [RECORDS ARE SAME SO INSERT INC. NO. 3X36 [EXISTING FLINC 3XGQ MHUNTW 1,FILE,FRB 3Y2B LDX 7 AINCNO(1) [X7= INCR. NO. TO INSERT 3YG2 FREECORE 1 3Y^L MHUNTW 3,FLIB,FLINC 3^F= MEXTEND 3^YW LDX 0 ALOGLEN(3) 42DG ADN 0 1 42Y6 STO 0 ACOMMUNE1(2) 43CQ ALTLENG 3,ACOMMUNE1(2),SFINDFLINC [LENGTHEN FLIB/FLINC BY 1 WORD 43XB MHUNTW 3,FLIB,FLINC 44C2 LDN 0 1 44WL ADS 0 A1(3) 45B= SMO ALOGLEN(3) 45TW STO 7 A1-1(3) [INSERT NEW INCR. NO. 46*G STEPAGAIN 46T6 NOTOBS 47#Q JBC QSTEP,3,BINSUITRVR [J IF INCR. SUITABLE FOR RETRIEVING 47SB [(ASSUMES THAT "NOT SUITABLE FOR RETR 48#2 [ BIT IS ONLY SET BY DUMPER WHEN IN 48RL [ SETS UP THE RECORD) 493D ... JBS QSTEP,3,BIUNFINR [DONT DELETE INCS BEING PRODUCED 49?= #SKI K6INCEND>99-99 49QW TRACE AINCNOR(3),INC DEL [NO. OF INCOMPLETE INCR. DELETED FROM 4==G DELETE [DELETE INCOMPLETE INCR. REC. 4=Q6 BRN QSTEP 4?9Q # 4?PB # IF THERE ARE NEWLY OBSOLETE INCRS.(I.E. FILE/APROC & FLIB/FLINC BLOCK 4#92 # ARE PRESENT), RE-CHAIN BLOCKS IN ASCENDING INCR. NO. ORDER & THEN PUT 4#NL # OUT "INCREMENT(S) N1,N2 OBSOLETE ON MT(S) T1 T2" MESSAGES 4*8= # 4*MW YLAST 4B7G HUNTW 3,FILE,APROC 4BM6 BNG 3 NOAPROC [J IF NO NEWLY OBSOLETE INCRS. 4C6Q NXTPROC 4CLB MHUNTW 2,FILE,FINCPROC 4D62 LDX 7 AINCNO(3) [NOTE INCR. NO. IN THIS APROC 4DKL CHAIN 3,2 [CHAIN FILE/APROC & FLIB/FLINC TO 4F5= MHUNTW 1,FLIB,FLINC [ FILE/FINCPROC BLOCK SO THAT REVER 4FJW CHAIN 1,3 [ ORDER OF FLINCS (OR APROCS) 4G4G MHUNTW 3,FILE,APROC 4GJ6 BXU 7 AINCNO(3),NXTPROC [J IF FOUND DIFFERENT APROC TO LAST T 4H3Q [& SO MORE BLOCKS TO RE-CHAIN 4HHB MOUT [NOW OUTPUT MESSAGES 4J32 OUTINCS [OUTPUT LIST OF INCREMENT NOS. 4JGL MFREEW FLIB,FLINC 4K2= OUTTSNS [OUTPUT LIST OF TSNS 4KFW MFREEW FILE,APROC 4K^G MONOUT INCOBSMT2 ["INCREMENT%A %B OBSOLETE ON MT%C %D 4LF6 HUNTW 3,FILE,APROC 4LYQ BPZ 3 MOUT [J IF MORE MESSAGES TO OUTPUT 4M4M ...# 4M8J ...# ENTRY 2 USES THIS SR ENTERING HERE 4M#F ...# 4MDB NOAPROC 4MJ? ... SETNCORE 0,3,FILE,FINTER [BLOCK TO HOLD LIST OF TSNS FOR 4MN8 ... [WHICH BIT BMNCURR NEEDS SETTING IN 4MS5 ... [MAGSTATE WORDS IN INCINDEX 4MY2 LDX 0 AWORK4(2) 4NCL BNZ 0 NOTONLY [J IF >1 RECORDS IN INCINDEX 4NX= STO 5 AWORK4(2) [AWORK4 = 1ST (ONLY) RELIABLE INCR. N 4PBW NOTONLY 4PWG CALL 7 SWRITE [STEPWRITE 4Q8X ... MBC 3,BIREDUMPR,BINSUITRVR,BIUNFINR[CLEAR REDUMP,NOT RETRIEVABLE 4QH# ... [AND UNFINISHED BITS 4QTQ LDCT 0 #240 4R*B ANDX 0 6 [IF B1 OR B3 SET IN REPLY WORD, 4RT2 ORS 0 AINCSTATER(3) [ SET THEM IN AINCSTAT 4S#L LDCT 1 #300 4SS= LDCT 0 #300 4T?W ANDX 0 6 [BOTH B1 & B2 OF REPLY WORD SET IF RE 4TRG SBX 0 1 [ I 4W?6 BNZ 0 STEPREWR [J IF NOT RESTOREABLE INCR. 4WQQ BS 3,BIGENRESR 4X=B [MARK AS SUIT FOR GEN RES 4XQ2 STEPREWR 4XQ3 ...#UNS AMTGR 4XQ4 ...( 4XQ5 ... JBS SGENRES,3,BIGENRESR [ IF NOT A RESTORABLE INCREMENT 4XQ6 ... BC 3,BIRESTBATR [ IT CAN'T BE LAST IN A BATCH 4XQ7 ...SGENRES 4XQ8 ...) 4XQ9 ...#UNS FPARTRES 4XQD ...( 4XQM ... BSXD 0,BINCWRFAIL [IF INCR WRITE FAILED MARK SO IN 4XQW ... ANDX 0 6 [INCINDEX 4XR5 ... BZE 0 NOTWRFAIL 4XR# ... BS 3,BIWFBREAKR 4XRH ...NOTWRFAIL 4XRQ ...) 4XS9 ...#UNS FNSAD2 4XWD ...( 4XXH ... JBC NOENDBAT,,BATCHSTART 4XYM ... JBC NOENDBAT,3,BIENDBATR 4Y2W ... BS ,BATCHFIN [ SET END OF BATCH BIT IN INCWORD 4Y55 ...NOENDBAT 4Y7# ...) 4Y9L ... HUNTW 1,FILE,FGET 4YP= BNG 1 NOFINCK 4^8W LDX 0 INCSIZE(1) 4^NG STO 0 AINCSIZER(3) [SIZE OF DUMP IN BS BLOCKS 5286 LDX 7 INCFILNUM(1) 52MQ LDCT 0 #100 537B ANDX 0 6 53M2 BZE 0 NGENRST [J IF NOT GEN RSTABLE 546L ADN 7 1 [ADD 1 FOR MASTER 54L= STO 7 INCFILNUM(1) 555W NGENRST 55KG STO 7 AINCFILESR(3) [NO OF FILES IN INCR 5656 LDX 0 INCBEGDUMP(1) 56JQ STO 0 AINCSTAT2R(3) [TIME TO DUMP INCR. (TOTAL TIME) 574B STOZ AINCSTAT4R(3) [CLEAR WORDS NOT USED 57J2 STOZ AINCSTAT1R(3) 583L NOFINCK 58H= LDX 5 AMTSR(3) [X5= NO. OF MTS 592W LDN 1 0 [SET COU^ER DOWN MT WORDS 59GG LDN 2 0 [CLEAR "EXTRA MT STATE BITS" WORD 5=26 SETBIT 1,2 ["LAST RELIABLE INCR. ON THIS MT" BIT 5=FQ [BIT BMLASTRV 5=^B BBUS 3,6,NOEOT [J IF NOT WRITE FAIL OR END OF TAPE 5?F2 SETBIT 5,2 [BIT BMNCURR - DUMPER WONT 5?YL [BE DUMPING ON THIS TAPE AGAIN 5#D= NOEOT 5#XW SMO 1 5*CG ORS 2 AMAGSTATER(3) [SET ANY BITS NECESSARY IN MT STATE W 5*X6 ADN 1 INCMAGLEN [UPDATE COUNTER DOWN MT WORD 5BBQ BCT 5 NOEOT [J IF MORE MT WORDS TO LOOK AT 5BWB # 5CB2 # IF HIT END-OF-TAPE OR WRITE FAIL, INSERT TSNS OF MTS INTO FINTER BLOC 5CTL # 5D*= BBUS 3,6,NOEOT1 [J IF NOT HIT END OF TAPE OR WRITE FA 5DSW LDX 5 AMTSR(3) [X5=NO. OF MTS IN THIS INCR. 5F#G MHUNTW 3,FILE,FINTER 5FS6 ALTLENG 3,5,SFINDFINT [LENGTHEN BLOCK FOR TSNS FOR WHICH 5G?Q [ "BMNCURR" NEEDS SETTING 5GRB STEPAGAIN [X3-> LAST RECORD 5H?2 MHUNTW 2,FILE,FINTER 5HQL ADN 2 A1 5J== LDN 1 AMAGR(3) [X1-> START OF MT WORDS IN LAST RECOR 5JPW NXFINT 5K9G LDX 0 0(1) 5KP6 STO 0 0(2) [INSERT TS IN FINTER BLOCK 5L8Q #SKI K6INCEND>99-99 5LNB TRACE 0,INCNOWPR [TSN OF MT NOT NOW NEEDING WPR 5M82 ADN 2 1 5MML ADN 1 INCMAGLEN [UPDATE MODIFIERS 5N7= BCT 5 NXFINT [J IF MORE TSNS TO INSERT 5NLW NOEOT1 5P6G LDX 2 FX2 5PL6 LDX 0 AWORK4(2) 5Q5Q BXE 0 AINCNOR(3),YFIRST [J IF NO RELIABLE PREVIOUS INCRS. 5QKB # 5R52 ...# NOW LOOK AT PREVIOUS (RELIABLE OR 'IN PROGRESS') RECORD AND 5RJL # 1) REMOVE BIT BMLASTRV FOR THOSE TAPES WHICH ARE IN LAST RECORD 5S4= # 2) SET IN FINTER BLOCK TSNS OF THOSE TAPES NOT PRESENT IN LAST RECO 5SHW # 5T3G READAGAIN [READ LAST RECORD AGAIN 5TH6 RBACK 5W2Q READBACK [READ LAST BUT ONE RECORD 5WGB MHUNTW 3,FILE,FRB 5WMJ ... JBS NRFREE,3,BIUNFIN [IGNORE NSUITRV BIT IF INCR IN 5WSQ ... [PROGRESS 5X22 JBS RFREE,3,BINSUITRV [J IF PREV.INC.NOT SUITABLE 5X9S ...NRFREE 5XFL NAME 3,FILE,FWB [X3-> PREVIOUS LAST RELIABLE RECORD 5X^= LDX 5 AMTS(3) [X5= NO. OF MTS IN LAST BUT ONE RECOR 5YDW BZE 5 NOCOMP [J IF NOT MTS 5YYG NXTMT 5^D6 MHUNTW 2,FILE,FRB [X2-> LAST RECORD 5^XQ LDX 0 AMAG(3) [X0= NEXT TSN IN LAST BUT ONE RECORD 62CB LDX 1 AMTS(2) [X1= NO. OF MTS IN LAST RECORD 62X2 MORETSNS 63BL BXE 0 AMAG(2),SAME [J IF FOUND TSN IN LAST RECORD 63W= ADN 2 INCMAGLEN [UPDATE MOD. IN LAST RECORD 64*W BCT 1 MORETSNS [J IF MORE TSNS TO LOOK AT 64TG LDX 2 FX2 65*6 STO 0 ACOMMUNE1(2) [KEEP TSN 65SQ MHUNTW 1,FILE,FWB 66#B SBX 3 1 [X3= MOD. DOWN LAST BUT ONE RECORD 66S2 STO 3 ACOMMUNE2(2) [KEEP MOD. 67?L STO 5 ACOMMUNE3(2) [KEEP NO. OF MTS MOD. IN LAST BUT ONE 67R= MHUNTW 3,FILE,FINTER 68=W LDX 5 ALOGLEN(3) 68QG ADN 5 1 69=6 ALTLENG 3,5,SFINDFINT [LENGTHEN FINTER BLOCK BY 1 WORD 69PQ MHUNTW 3,FILE,FINTER 6=9B LDX 0 ACOMMUNE1(2) 6=P2 SMO 5 6?8L STO 0 A1-1(3) [INSERT TSN AT END OF LIST 6?N= #SKI K6INCEND>99-99 6#7W TRACE 0,INCNOWPR [TSN OF TAPE NO LONGER NEEDING WPR 6#MG LDX 5 ACOMMUNE3(2) [RESTORE X5 6*76 MHUNTW 3,FILE,FWB 6*LQ ADX 3 ACOMMUNE2(2) [AMAG(3) IS LAST TSN DEALT WITH 6B6B [IN LAST BUT ONE RECORD 6BL2 UPDINC 6C5L ADN 3 INCMAGLEN [UPDATE MOD IN LAST BUT ONE RECORD 6CK= BCT 5 NXTMT [J IF MORE MTS 6D4W REWRITE [REWRITE LAST BUT ONE RECORD 6DJG BRN NOCOMP 6F46 SAME 6FHQ BC 3,BMLASTRV [REMOVE LAST RVABLE INCR FROM MT STAT 6G3B [ WORD IN LAST BUT ONE RECORD 6GH2 BRN UPDINC 6H2L RFREE 6HG= FREECORE 3 6H^W BRN RBACK 6JFG # 6J^6 # NOW (STARTING AT THE LAST BUT ONE RECORD IN INCINDEX), READ BACKWARDS 6KDQ # THROUGH INCINDEX SETTING BMNCURR (B5) IN THE AMAGSTATE WORDS OF THOSE 6KYB # MTS WITH THEIR TSN IN FINTER BLOCK. 6LD2 # FINISH WHEN EITHER 6LXL # 1) COME TO BEGINNING OF FILE 6MC= ...# OR 2) NO FINTER ENTRY AT ALL FOUND IN A COMPLETE INCREMENT RECORD. 6MWW # 6NBG NOCOMP 6NW6 MFREEW FILE,FRB 6P*Q MHUNTW 3,FILE,FWB [X3-> LAST BUT ONE RECORD 6PTB MARKWPR 6Q*2 MHUNTW 1,FILE,FINTER 6QSL LDX 2 ALOGLEN(1) 6R#= BZE 2 ZFINT [J IF NO TSNS TO MARK WITH BMNCURR 6RRW SMO FX2 6S?G STOZ ACOMMUNE1 [CLEAR "NON-CURRENT TSNS FOUND" MARKE 6SR6 TSN 6T=Q SMO 2 6TQB LDX 5 A1-1(1) [X5= NEXT TSN IN FINTER BLOCK 6W=2 LDX 0 AMTS(3) [X0= NO. OF MTS IN FWB 6WPL BZE 0 ZFINT [J IF NO MTS 6X9= TNXTSN 6XNW BXE 5 AMAG(3),TSNFOUND [J IF FOUND TSN 6Y8G ADN 3 INCMAGLEN [UPDATE MOD IN FWB 6YN6 BCT 0 TNXTSN [J IF MORE TSNS 6^7Q TESTFINT 6^MB MHUNTW 3,FILE,FWB 7272 BCT 2 TSN [J IF MORE TSNS FROM FINTER BLOCK 72BS ... JBS NZFINT,3,BINSUITRV 72LL SMO FX2 736= LDX 0 ACOMMUNE1 73KW BZE 0 ZFINT [J IF NO TSNS IN FINTER BLOCK IN THIS 745G [ (ASSUME WE HAVE NOW DEALT WITH ALL 74K6 [ RECORDS NECESSARY) 74SY ...NZFINT 754Q LDX 5 AINCNO(3) [X5= INCR. NO. OF THIS RECORD 75JB REWRITE [ENSURE BMNCURRS IN RECORD 7642 MFREEW FILE,FWB 76HL BXE 5 AWORK4(2),YFIRST [J IF NOW BACK TO 1ST INCR. IN INCIND 773= READBACK [READ PREVIOUS RECORD 77GW MHUNTW 3,FILE,FRB 782G NAME 3,FILE,FWB 78G6 BRN MARKWPR [GO & CHECK IF BMNCURRS TO BE INSERTE 78^Q [ IN THIS RECORD 79FB TSNFOUND 79^2 SMO FX2 7=DL STO 5 ACOMMUNE1 [SET NON-ZERO MARKER (MT PRESENT IN W 7=Y= [ BMNCURR IS NOW SET) 7?CW BS 3,BMNCURR [SET WILL NOT BE DUMPED ON BIT 7?XG BRN TESTFINT 7#C6 ZFINT 7#WQ FREECORE 3 [FREE FWB 7*BB YFIRST 7*W2 MFREEW FILE,FINTER 7*Y9 ... BBUS 2,6,NGRST 7B2D ... WIND 7B4M ... CALL 7 SWRITE [IF RESTABLE INCR SET 7B6W ... BS 3,BIFINALR [FINAL BIT IN LAST REC 7B95 ...NGRST 7B?# ... JBS NCLOSE,2,MBEMS [IF EMS ENTRY DONT CLOSE II 7B*L CLOSETOP [CLOSE INCINDEX 7BKD ...NCLOSE 7BT= ADX 4 FX1 7C#W EXIT 4 0 7CB7 ...# 7CCD ...# 7CDP ...# OUTPUTS A BLANK LINE TO THE MONFILE, CALLED ON X7, USES X4. 7CG2 ...# COORDINATES. 7CH? ...# 7CJJ ...OUTBLANK 7CKT ... SBX 7 FX1 7CM6 ... LDN 4 #40 7CNC ... OUTMOND 0,ACOMMUNE1,4 7CPN ... ADX 7 FX1 7CQ^ ... EXIT 7 0 7CSG # 7D#6 # 7DRQ # SETS UP A PARAMETER BLOCK READY FOR 'MONOUT' WITH INCR. NO. AS 1ST 7F?B # PARAMETER AND SERIAL NOS. (ON WHICH INCR. IS TO BE DUMPED) AS 2ND. 7FR2 ...# ON ENTRY, RELEVANT FINC BLOCK IS CALLED FGET. X4 IS S/R LINK. 7G=L # ON EXIT, X1=FX1, X2=FX2. USES X0, X3, X5, X6 & X7. 7GQ= SETMONOUT 7H9W SBX 4 FX1 7HPG ... MHUNTW 3,FILE,FGET [X3-> FGET BLOCK 7J96 LDX 5 INCCOPIES(3) [X5= NO. OF MTS TO DUMP ON 7JNQ LDX 3 INCNO(3) [X3= NO. OF THIS INCREMENT 7K8B OUTBLOCN 11 [GET PARAMETER BLOCK -SHOULD AMPLY CO 7KN2 [ MOST CASES 7L7L OUTPACK 3,1,INCNUM [INC.NO. TO PARAMETER BLOCK 7LM= SBN 5 1 7M6W BNZ 5 SPARAM [J IF >1 TAPE 7MLG OUTNULL [NULL PARAMETER 7N66 BRN PARASENT 7NKQ SPARAM 7P5B LDCT 0 #630 7PK2 STO 0 ACOMMUNE1(2) 7Q4L OUTPARN 1,ACOMMUNE1 [MAKE MT PLURAL 7QJ= PARASENT 7R3W MHUNTW 3,FILE,FGET [X3-> FGET BLOCK 7RHG MHUNTW 2,FILE,FQUAL [X2-> FQUAL BLOCK (USED SIMPLY AS A B 7S36 [ HERE) 7SGQ STOZ 1 [ZEROISE CHAR. COUNT 7T2B ... LDX 5 INCCOPIES(3) [NO OF MTS IN FINC(FGET) 7TG2 NXTSN 7WF= LDX 7 FGETSER(3) [X7 = NEXT TSN IN FGET 7WYW LDN 0 8 7XDG NXOCT 7XY6 LDN 6 0 7YCQ SLL 67 3 7YXB BNZ 6 NZERO [J IF DIGIT NON-ZERO 7^C2 BPZ 4 NONSIG [J IF DIGIT NON-SIGNIFICANT ZERO 7^WL NZERO 82B= ORX 4 GSIGN [ENSURE 'SIGNIFICANT DIGITS' MARKER S 82TW DCH 6 A1(2) [PUT CHAR. INTO FQUAL BLOCK 83*G BCHX 2 £ 83T6 ADN 1 1 [UPDATE COUNT OF CHARS. IN PARAMETER 84#Q NONSIG 84SB BCT 0 NXOCT [J IF MORE CHARS. TO EXTRACT 85#2 ERX 4 GSIGN 85RL LDN 6 #20 86?= DCH 6 A1(2) [INSER3 SPACE CHA$R. 86QW ADN 1 1 [UPDATE CHAR. COUNT 87=G BCHX 2 £ 87Q6 ... ADN 3 FGETLEN [UPDATE MOD DOWN FGET 889Q ... BCT 5 NXTSN [J IF MORE MTS IN FGET 88PB OUTPARAM 1,A1,FILE,FQUAL [PUT TSNS IN OUTPUT PARAMETER BLOCK 8992 ADX 4 FX1 89NL EXIT 4 0 8=8= # 8=MW # 8=RR ...# 8??C ...X1INCEND [ENTRY FROM INCSTART SEGMENT 8?R3 ...# THE DUMPING CODE HAS FINISHED. ONE OR BOTH OF THE INCRS =BHQ ...# BEING PRODUCED HAS BEEN COMPLETED FOR ONE REASON OR ANOTHER =C3B ...# WE LOOK AT EACH FINC IN TURN AND WIND UP THOSE WHICH HAVE =CH2 ...# BIT BINCFIN SET. =D2L ...# =DG= ... MFREE ADATA,CREADL =D^W ... MFREE FILE,FLOCNB =FFG ... BC 2,MBFINAL [SET 'FINAL INC NOT PRODUCED' =F^6 ... JBC NOFERUS2,,BFERUS [J IFNO FERUS SET UP =GDQ ... MHUNTW 3,FILE,FINC =GYB ... JBC WAITFER,3,BINCGENRES =HD2 ... JBC NOFERUS2,3,BINCFIN [ONLY FREE FERUS IF NOT STILL PRODUCIN =HXL ... [A RESTORABLE INCRMENT =JC= ...WAITFER =JWW ... POP WAITFER,,FERUSALT [WAIT TILL CAN ALTER THE FERUS =KBG ... BC ,BFERUS [CLEAR FERUS EXISTS BIT =KW6 ... HUNTMISB 3,FI,FERUS [X3->FERUS =L*Q ... FREECORE 3 [FREE IT =LTB ... VOP ,FERUSALT [RELEASE FERUS ALTERATION SEMA =M*2 ...NOFERUS2 =MSL ... LONGON ADUMPWT [RELEASE ACTS. 'WAITING FOR DUMPER TO =N#= ... [ FINISH INCREMENT' =NRW ... VFREEW FI,FINCCOPY =P?G ... MHUNTW 3,FILE,FABSNB [RENAME FABSNB FOR SAFTEYS SAKE =PR6 ... NAME 3,FI,FDUMPFAB [IN CASE SOMEONE FREES IT =Q=Q ... MHUNTW 3,FILE,FINC [X3->1ST FINC BLOCK =QQB ... JBS Y1ST,3,BINCFIN [J IF THIS INCR NEEDS WINDING UP =R=2 ... HUNT2 3,FILE,FINC,3 [OTHERWISE IT MUST BE THE 2ND =RPL ... JBC (GEOERR),3,BINCFIN =S9= ...Y1ST NAME 3,FILE,FGET [RENAME IT TO IDENTIFY IT =SNW ...# =T8G ...# WE HAVE LOCATED AN INCR WHICH IS TO BE FINISHED OFF. THE =TN6 ...# FINC HAS BEEN RENAMED A FGET BLOCK FOR EASE OF IDENTIFIACTION. =W7Q ...# WE UPDATE THE RECORD IN INCINDEX FOR THIS INCREMENT =WMB ...# =X72 ... LDX 0 CLEANCT =XLL ... SBX 0 INCBEGDUMP(3) =Y6= ... BPZ 0 NMIDNIGHT [J IF NOT DUMPED OVER MIDNIGHT =YKW ... SMO FX1 =^5G ... ADX 0 SCLEANDAY [ADD ON DAY'S WORTH OF CLEANCTS =^K6 ...NMIDNIGHT ?24Q ... STO 0 INCBEGDUMP(3) [TIME TAKEN TO DUMP ?2JB ... LDX 5 INCNO(3) [X5= CURRENT INCR. NO. ?342 ... LDX 6 INCREPLY(3) [X6= REPLY WORD FOR THIS INCR. ?3HL ... CALL 4 UPDATEINDEX [UPDATE INCINDEX ?43= ...# ?4GW ...# AND OUTPUT THE END OF INCREMENT MESSAGE TO ALL OPS CONSOLES ?52G ...# ?5G6 ... CALL 7 OUTBLANK [BLANK LINE TO MONFILE ?5^Q ... CALL 4 SETMONOUT [SET PARAMETER BLOCK FOR MONOUT ?6FB ... INFORM 3,INCFIN,1 [OUTPUT END OF INCR MESSAGE ?6^2 ...# ?D5^ ... MHUNTW 3,FILE,FGET [ ?D9W ...# ?DPG ...# IF THE INCREMENT WAS RESTORABLE WE NOW OUTPUT A MESSAGE SAYING SO ?F96 ...# ?FNQ ... LDCT 4 #300 ?G8B ... LDCT 2 #300 ?GN2 ... ANDX 4 INCREPLY(3) ?H7L ... SBX 4 2 ?HM= ... BNZ 4 NOTEOB [J IF NOT GENERAL RESTOREABLE INCR. ( ?J6W ... [ RESTOREABLE IF B1 & B2 OF REPLY WO ?JLG ... [ BOTH SET) ?K66 ... LDX 2 FX2 ?KKQ ... BS 2,MBFINAL [REMEMBER A FINAL INCREMENT HAS ?L5B ... [BEEN PRODUCED ?L*8 ... BC ,BTOTD [CLEAR TOTAL DUMP BIT ?LK2 ... CALL 4 SETMONOUT [SET PARAMETER BLOCK FOR MONOUT ?M4L ... MONOUT INCSUIT [PUT OUT 'SUITABLE FOR GENERAL RESTOR ?MJ= ... LONGON AFINDUMP [RELEASE ACTS. WAITING FOR GENERAL- ?MS4 ...NOTEOB ?N3W ... FON BSUJWT [RELEASE UNJAMMER (IF WAITING FOR DUM ?P36 ...#UNS JSKI28 ?PGQ ...( ?Q2B ...# ************************************************** ?QG2 ...# IP REDUMP CSS SPECIAL MOD ?Q^L ... SEGENTRY K98INCEND ?RF= ... BRN NOCSSMOD ?RYW ...XY 12HREDUMP ?SDG ...ZY GEOERR 1,REDUMP ?SY6 ... SEGENTRY K97INCEND ?TCQ ... LDX 6 INSTPARAM+1 ?TXB ... ADN 6 1 ?WC2 ... SMO FX1 ?WWL ... LDN 5 XY ?XB= ... INSTPARA ZY,5,6,NOCSSMOD ?XTW ...NOCSSMOD ?Y*G ... SEGENTRY K96INCEND ?YT6 ...# ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ?^#Q ...) ?^SB ...# #2#2 ...# SEGMENT INCFIN FINISHES OFF THE TIDYING UP OF INDIVIDUAL #2RL ...# INCREMENTS #3?= ...# #3QW ... DOWN INCFIN,1 [FINISH TIDYING UP INCR. #4=G ... CALL 7 OUTBLANK [BLANK LINE TO MONFILE #4CN ...#UNS IDC #4JW ...#SKI #4Q6 ... MFREEW FILE,FGET [FAREWELL TRUSTY FINC(FGET) #59Q ... HUNTW 3,FILE,FINC #5PB ... BNG 3 NOFINCS [J IF NO MORE INCS THAT MAY WANT #692 ... [TIDYING UP #6NL ... JBS Y1ST,3,BINCFIN [J IF MORE TIDYING NEEDED #78= ...NOFINCS #7MW ...# ****************************************************************** #87G ...# #8M6 ...# WE GO ACROSS TO INCFIN TO FINISH TIDYING UP INCREMENT #96Q ...# #9LB ... ACROSS INCFIN,2 #NQQ ...# #R8W ...# #RH? ...# THE SEGMENT OVERFLOWED AND THE CODE FOR THE K2 ENTRY POINT #RTN ...# HAS BEEN REMOVED TO INCCHECK #S86 ...# ENTRY 2. THE ONE PIECE OF THIS SEGMENT WHICH IS STILL NEEDED IS AN #SMQ ...# OCCASIONAL ENTRY TO SR UPDATEINDEX AT LABEL NOAPROC. THIS IS DONE #T7B ...# VIA ENTRY TO K3INCEND. #WL= ...# #X5W ...# #XKG ...# #Y56 ...X3INCEND #YJQ ... BS 2,MBEMS [SHOW EMS ENTRY #^4B ... LDN 4 UP [RELATIVISED RETUNR LINK #^J2 ... BRN NOAPROC #^RS ...UP UP *23L ...# *2H= ...# *32W ... MENDAREA 40,K99INCEND *3GG ...# *426 ...#END ^^^^ ...01252630000400000000