(George Source)
Macros used: ACROSS, BACKWAIT, BC, BS, BWZ, BXE, BXGE, BXL, BXU, CHAIN, COOR1, CORRUPTB, DCA, DOWN, FFINDEXB, FINDACTFB, FPUT, FREECORE, GEOERR, HUNT2, HUNT2OPT, HUNTMISB, HUNTW, JBC, JBS, JBSS, JMBC, JMBS, KEYRECI, LOCKC, MENDAREA, MFREEW, MHUNTW, MONOUT, NAME, OUTNULL, OUTPACKX, READ, READAGAIN, READAUTO, READB, REWIND, SEG, SEGENTRY, SETNCORE, SFCA, TOPFCA2, TOPFCB, TOPFCB2, TRACEIF, UNLOCK, UP, UPPLUS
22FL ... SEG INCMON,850,MIKE PUTNAM,INCDUMP 22^= # 23DW SEGENTRY K1INCMON,X1INCMON 23YG SEGENTRY K2INCMON,X2INCMON 243L ... SEGENTRY K3INCMON,X3INCMON 246Q ... SEGENTRY K4INCMON,X4INCMON 249W ... SEGENTRY K5INCMON,X5INCMON 24*2 ... SEGENTRY K7INCMON,X7INCMON 24D6 # 24XQ # ENTRY 1 DUMPS THE TOP FILE OPEN. 25CB # ENTRY 2 DUMPS A FILE USING BSTS, IT ASSUMES THAT A FILE/ENT, 25X2 # BSTB/FULLB (=BLOCKS REC) , AND IF NEC A FILE/FINTER1 (=INDEX REC) 26BL # ARE AVAILABLE. THE SUP DIR MUST BE OPEN, TO STOP COPYFILE 26W= # BOTH ENTRIES THEN SET UP THE PARAMETERS FOR THE FILDUMPED MESSAGE 27*W # WHILE DUMPING AN INDEXED FILE, A COUNT IS KEPT 27TG # OF THE SPACE THE FILE WOULD OCCUPY AFTER COMPRESSION. 282N ...# ENTRY 3 WRITES A SENTINEL 287W ...# ENTRY 4 CALLS SUBROUTINES UPDATEQUAL AND WRITESFS 28*6 # 28SQ # CALLED FROM INCWRITE 29#B # 29S2 ...# ON ENTRY, 2=?L # AWORK3=0 OR INDEX NO 2=R= # DURING DUMPING:- 2?=W # X4=0 IF FILE OPEN FOR DUMPING 2?QG # =NO OF READS ISSUED +1 IF FILE BEING READ VIA BSTS 2#=6 # X6=NO OF BLOCKS WRITTEN TO TAPE 2#PQ # AWORK1=FILE SIZE 2*9B # AWORK2=COUNT OF BLOCKS AFTER COMPRESSION 2*P2 # AWORK3=-1 RANDOM 2B8L # =0 SERIAL,NOT INDEXED 2BN= # =INDEX NO. IF INDEXED 2C7W # AWORK4=HIGHEST KEY ENCOUNTERED SO FAR 2CMG # X7=SPACE LEFT IN CURRENT COMPRESSED BLOCK 2D76 # (SAVED IN INCWORK, EXCEPT WHEN PROCESSING A BLOCK) 2DLQ # 2F6B SEGENTRY INCREADLIM 2FL2 5 [DEFAULT VALUE 2G5L NCLEANDAY 864000/K9*100 [A DAY'S CLEANCTS 2G*D ...MLANCOMP 4HC1 2GK= # 2H4W # 2HJG # SUBROUTINES:- 2J46 # 2JHQ # "SUBNULL" OUTPUTS A NULL PARAMETER TO THE GMON/ASET BLOCK. 2K3B # CALLED ON X7 AND COORDINATES. 2KH2 # 2L2L # "SUBPACKX" OUTPUTS A PARAMETER TO THE GMON/ASET BLOCK USING 2LG= # OUTPACKX. CALLED ON X7 AND COORDINATES. 2L^W # ON ENTRY, X4=ADDRESS OF WORD FROM WHICH TO TO TAKE VALUE 2MFG # X5=ADDRESS OF WORD CONTAINING LENGTH OF PARAMETER 2M^6 # X6=ADDRESS OF WORD CONTAINING PDC. 2NDQ # 2NYB # "SFINDFRB" LOCATES THE FRB FOR LOCKC. 2PD2 # LEAVES X2->FRB, CALLED ON X1. 2PXL # 2QC= # "WAIT" WAITS FOR A PREVIOUS MT TRANSFER TO COMPLETE. 2QWW # IN THE CLOSED FILE CASE, IT RENAMES THE FRB A BSTB/BFREEW IF THERE 2RBG # ARE MORE READS TO BE ISSUED. 2RW6 # IN ALL OTHER CASES IT FREES THE FRB. 2S*Q # IF A FAIL OR EOT OCCURRED, IT UPDATES THE COUNTS, AND GOES UP. 2STB # IF A BSTB/BFREEW EXISTS TO BE REFILLED IT EXITS 7 0 WITH X3->IT. 2T*2 # OTHERWISE IT EXITS 7 1. 2TSL # ON ENTRY,X1->FINC BLOCK,X3->FRB. CALLED ON X7. 2W#= # ON EXIT ,X1->FINC BLOCK. 2WRW # 2X?G # "UPDCOUNTS" UPDATES THE TIMES AND COUNTS IN THE FINC BLOCK. 2XR6 # ON ENTRY, X1->FINC BLOCK, X6=BLOCKS WRITTEN COUNT. 2Y=Q # CALLED ON X7. 2YQB # ON EXIT,X1->FINC BLOCK,X6=COUNT. 2^=2 # THE FULLB & FINTER1 BLOCKS WILL BE FREED, AND AWORK4 2^PL # WILL CONTAIN THE RESIDENCE NO FOR LATER USE BY OUTPACK CODE 329= # 32NW # 338G # "READBSTS" ISSUES AUTONOMOUS READS FOR A CLOSED FILE. 33N6 # THE NO. OF BUFFERS USED IS SET BY THE WORD INCREADLIM, WHICH CAN 347Q # BE ALTERED BY RESTORE TIME MACRO 34MB # ON ENTRY, X3->A BUFFER BLOCK CURRENTLY NAMED BSTB/BFREEW. 3572 # THE CORE UNJAMMER FREES THESE BLOCKS, SO WE MUST NOT COORDINATE 35LL # BETWEEN NAMING THE BUFFER BSTB/BFREEW AND ENTERING READBSTS. 366= # 36KW # 36LM ...# "XLOCFINC" SETS X1-> FINC FOR THE CURRENT INCREMENT. USES 36MD ...# ACOMMUNE2 36N9 ...# 36P2 ...# 36PR ...XLOCFINC 36QJ ... SMO FX2 36R* ... STO 0 ACOMMUNE2 [SAVE LINK 36S6 ... MHUNTW 1,FILE,FINC 36SX ...#UNS FPD 36TN ...( 36WF ... JBC NFLINC,,BFILEINC 36X= ... HUNT2 1,FILE,FINC,1 36Y3 ...NFLINC 36YS ...) 36^K ... SMO FX2 372B ... LDX 0 ACOMMUNE2 3737 ... EXIT 0 0 373Y ...# 374P ...# 375G SUBNULL 37K6 SBX 7 FX1 384Q OUTNULL 38JB ADX 7 FX1 3942 EXIT 7 0 39HL # 3=3= SUBPACKX 3=GW SBX 7 FX1 3?2G OUTPACKX 4,5,6 3?G6 ADX 7 FX1 3?^Q EXIT 7 0 3#FB # 3#^2 SFINDFRB 3*DL MHUNTW 2,FILE,FRB 3*Y= EXIT 1 0 3BCW # 3BXG WAIT 3CC6 SBX 7 FX1 3CWQ LDX 2 FX2 3DBB LDEX 0 INCACT(1) [GET COUNT OF RUNNING DUMPER ACTS 3DW2 SBN 0 1 [REMOVE DUMPER'S OWN COUNT 3F*L DEX 0 INCACT(1) [PUT IT BACK- LEAVING ANY FAIL OR EOT 3FKD LDX 5 CLEANCT [TIME STARTED WAIT FOR MT 3FT= BZE 0 NOWAIT [J IF ALL DTA'S ENDED 3G#W COOR1 [WAIT TILL KICKED BY LAST DTA 3GSG NOWAIT 3H#6 BZE 4 NBFREEW [J IF FILE OPEN 3HRQ LDX 0 AWORK1(2) 3J?B BXL 0 4,NBFREEW [J IF ALL READS ISSUED 3JR2 NAME 3,BSTB,BFREEW [NAME BUFFER BSTB BFREEW 3K=L UNLOCK 3 [UNLOCK IT 3KQ= BRN YBFREEW 3L9W NBFREEW 3LPG FREECORE 3 3M96 ADN 7 1 [NO BFREEW SO EXIT 1 3MNQ YBFREEW 3M^H ... CALL 0 XLOCFINC 3N=# LDX 0 CLEANCT 3N#= SBX 0 5 [TIME WAITING FOR TAPE 3NB8 BPZ 0 NMIDNIGHT2 [J IF MIDNIGHT NOT OCCURRED 3ND6 SMO FX1 3NG4 ADX 0 NCLEANDAY [ADD A DAYS CLEANCTS 3NJ2 NMIDNIGHT2 3NKY ADS 0 INCMTWAIT(1) [UPDATE TIME WAITING FOR MTS 3NN2 LDX 0 INCACT(1) 3P7L BZE 0 NEOT [J IF NO EOT OR FAIL 3PM= CALL 7 UPDCOUNTS [UPDATE COUNTS ETC. 3PPT ... LDX 0 AWORK3(2) 3PQ* ...#UNS FNSAD 3PQT ... SBN 0 1 3PR* ...#UNS FNSAD 3PRT ...#STR 3PSD ... SBN 0 2 [IF FILE AN INDEXED VSF 3PX3 ... BNG 0 NOTVSF1 [J IF NOT 3P^L ... DOWN INCVFCHK,4 [ABANDON FILE DEPENDENT CHECKING 3Q2F ...#UNS FNSAD 3Q3# ... NULL [ NEVER OBEYED - ALWAYS COMES UPPLUS 1 HERE 3Q49 ...NOTVSF1 3Q** ... BRN MTEOT [EOT OR FAIL EXIT PATH 3QLG NEOT 3R66 ADX 7 FX1 3RKQ EXIT 7 0 3S5B # 3SK2 UPDCOUNTS 3T4L NGX 0 AWORK3(2) 3TJ= BPZ 0 NSYS [J IF NOT INDEXED 3W3W ADS 6 INCSYSSIZE(1) [UPDATE CURRENT SYSTEM FILES SIZE 3WHG LDX 0 AWORK2(2) 3X36 ADS 0 INCCMPSIZE(1) [UPDATE COMPRESSED SYSTEM FILE SIZE 3XGQ NSYS 3Y2B LDX 0 CLEANCT [GET TIME 3YG2 SBX 0 INCTIMING(1) [CALCULATE TIME TAKEN 3Y^L BPZ 0 NMIDNIGHT [J IF NOT DUMPED OVER MIDNIGHT 3^F= SMO FX1 3^YW ADX 0 NCLEANDAY [ADD A DAY'S CLEANCTS 42DG NMIDNIGHT 42Y6 STO 0 AWORK2(2) [REMEMBER TI E 43CQ ADS 0 INCTIMEFILE(1) [ADD TO TIME DUMPING FILES 43XB ADS 6 INCSIZE(1) [ADD TO SIZE OF DUMP 44C2 ADS 6 INCBLNUM(1) [ADD TO BLOCK COUNT INCL. SENTINALS 44WL BNZ 4 NFCB4 [J IF FILE NOT OPEN 45B= TOPFCB2 3 [X3->FCB 45TW LDX 5 BSPRE(3) [RESID NO 46*G BRN RESID 46T6 NFCB4 47#Q MHUNTW 3,BSTB,FULLB [BLOCKS REC 47SB LDX 5 A1+1(3) [RESID NO 48#2 FREECORE 3 [FREE REC 48RL NGX 0 AWORK3(2) 49?= BPZ 0 RESID [J IF NO INDEX REC 49QW MFREEW FILE,FINTER1 4==G RESID 4=Q6 STO 5 AWORK4(2) [STORE RESID NO 4?9Q EXIT 7 0 4?PB # 4#92 READBSTS 4#NL SBX 7 FX1 4*8= MHUNTW 1,BSTB,FULLB 4*MW SMO 4 4B7G LDX 5 A1+1(1) [GET NEXT BLOCK NO 4B=L ...#UNS JSKI33 4B*Q ... READAUTO FAIL+BUSE,BSBS,,A1+1(1),EX5 [ISSUE READ 4BDW ...#UNS JSKI33 4BJ2 ...#SKI 4BM6 READAUTO BUSE,BSBS,,A1+1(1),EX5 [ISSUE READ 4C6Q ADN 4 1 [INCREMENT NEXT BLOCK POINTER 4CLB ... CALL 0 XLOCFINC [REHUNT THE FINC BLOCK 4D62 ADX 7 FX1 4DKL EXIT 7 0 4DKN ...# 4DKQ ...# 4DKS ...XFDUMPCOM [ GETS POINTER IN X1 TO FI FDUMPCOM 4DKW ... SMO FX2 4DKY ... STO 0 ACOMMUNE1 [ SAVE LINK 4DL2 ... HUNTMISB 1,FI,FDUMPCOM [ FIND FDUMPCOM IN MISCELLAN. CHAIN 4DL4 ... SMO FX2 4DL6 ... LDX 0 ACOMMUNE1 4DL8 ... EXIT 0 0 4DL= ...# 4DL# ...SFINDQUAL [S/R USED TO LOCATE FQUAL BLOCK FOR LOCKC 4DLB ... [X2 -> BLOCK . CALLED ON X1 4DLD ... MHUNTW 2,FILE,FQUAL 4DLG ... EXIT 1 0 4DLJ ...# 4DLL ...# 4DLN ...TIMESTART [SR TO START TIMING A DELAY FOR STATS. 4DLQ ... [CALLED ON X7. ON EXIT X1->FINC 4DLS ... CALL 0 XLOCFINC [X1->FINC 4DLW ... LDX 0 CLEANCT 4DLY ... STO 0 INCTIMING(1) 4DM2 ... EXIT 7 0 4DM4 ...# 4DM6 ...# 4DM8 ...TIMEND [SR TO WIND UP TIMING OF DELAY FOR STATS. 4DM= ... [CALLED ON X7,ON EXIT X1->FINC,X0=TIME 4DM# ... CALL 0 XLOCFINC [X1->FINC 4DMB ... LDX 0 CLEANCT 4DMD ... SBX 0 INCTIMING(1) 4DMG ... BPZ 0 NMIDN [J IF IT DIDNT HAPPEN OVER MIDNIGHT 4DMJ ... SMO FX1 4DML ... ADX 0 NCLEANDAY [ADD A DAYS CLEANCTS 4DMN ...NMIDN 4DMQ ... EXIT 7 0 4DMS ...# 4DMW ...# 4DMY ...RESTARTDATA [SETS UP A RESTART POINT FOR RESTORABLE INCREMENT OF 4DN2 ... [DUMP, UNLESS ONE IS ALREADY EXTANT 4DN4 ... SBX 4 FX1 4DN6 ... HUNTW 3,FI,FDUMPFAB 4DN8 ... BPZ 3 RSTEXIT 4DN= ... DOWN INCEOT,8 4DN# ...RSTEXIT 4DNB ... ADX 4 FX1 4DND ... EXIT 4 0 4DNG ...# 4DNJ ...# 4DNL ...# 4DNN ...RESTARTFREE [FREES ALL RESTART BLOCKS SET UP BY RESTARTDATA 4DNQ ... [CALLED ON X4 4DNS ... HUNTW 3,FI,FDUMPFAB 4DNW ... BNG 3 (4) 4DNY ... FREECORE 3 4DP2 ... BRN RESTARTFREE 4DP4 ...# 4DP6 ...# 4DP8 ...WRITESFS [WRITES SUB-FILE SENTINEL TO THE MTS (TAPE-MARK 4DP= ... [& QUALIFIER BLOCK). 4DP# ...# ON ENTRY, QUAL. BLOCK MUST HAVE BEEN SET UP. X4 IS S/R LINK. 4DPB ...# ON EXIT, X1->FINC BLOCK,X2=FX2,X3->FQUAL BLOCK 4DPD ...# USES X0,X1,X5,X7,ACOMMUNE1, AND INCTIMING 4DPG ... SBX 4 FX1 4DPJ ... LDX 2 FX2 4DPL ... CALL 7 TIMESTART [START TIMING DELAY IN WRITING SFS 4DPN ... LDN 0 5 [SHOW TM WANTED 4DPQ ... STO 0 ACOMMUNE1(2) 4DPS ... DOWN MTDUMP,2 [WRITE ONE 4DPW ... CALL 1 SFINDQUAL [X2->FQUAL 4DPY ... LOCKC 2,SFINDQUAL [LOCK IT 4DQ2 ... MHUNTW 3,FILE,FQUAL [X3->FQUAL 4DQ4 ... LDN 0 ESENTYP(3) [BASE OF TRANSFER 4DQ6 ... STO 0 ACOMMUNE3(2) 4DQ8 ... LDN 0 1 [WRITE MODE 4DQ= ... STO 0 ACOMMUNE1(2) 4DQ# ... LDN 0 20 [LENGTH OF TRANSFER 4DQB ... STO 0 ACOMMUNE2(2) 4DQD ... DOWN MTDUMP,2 [WRITE QUALIFIER 4DQG ... LDX 5 ESENTYP(3) [GET SENT TYPE FOR LATER USE 4DQJ ... UNLOCK 3 [UNLOCK FQUAL BLOCK 4DQL ... CALL 7 TIMEND [COMPUTE TIME TAKEN 4DQN ... ADS 0 INCTIMESENT(1) [ADD TO "TIME WRITING SENTINELS" COUN 4DQQ ... LDN 0 1 4DQS ... ADS 0 INCBLNUM(1) [UPDATE COUNT OF BLOCKS (INCLUDING 4DQW ... [ SENTINELS) IN INCR. 4DQY ... LDCT 0 #200 [IF SENT WAS START OF INCREMENT (IE X 4DR2 ... ANDX 0 ESENB(3) [WE EXIT IGNORING TAPE EVENTS - THESE 4DR4 ... BNZ 0 NEOT2 [WILL BE DEALT WITH ON X1 ENTRY 4DR6 ... LDX 7 INCACT(1) [NOW WE DEAL WITH ANY FAIL OR EOT 4DR8 ... BNG 7 MTEOT [IF FAIL OCCURRED, JUMP INTO INCEOT 4DR= ... BPZ 5 NOTESFS [J IF THAT WASNT AN ESFS 4DR# ... LDX 5 AWORK1(2) [GET ITS FILE NUMBER (STILL IN AWORK1 4DRB ... BZE 5 NOTESFS [J IF WAS ZERO E OF COMP SF 4DRC ... JBS NOTESFS,1,BINCRFAIL [NO MESSAGE IF CORRUPT FILE 4DRD ... MONOUT FILDUMPED [JUST DUMPED A FILE,OUTPUT MESSAGE 4DRG ... CALL 0 XLOCFINC [X1->FINC 4DRJ ...NOTESFS 4DRL ... BZE 7 NEOT2 [J IF NO EOT OCCURRED 4DRN ... JBC MTEOT,1,BINCEOT [J IF EOT OR FAIL NOT OCCURRED BEFORE 4DRQ ...NEOT2 4DRS ... ADX 4 FX1 4DRW ... EXIT 4 0 4DRY ...# 4DS2 ...SETESFS [SETS UP WORD A1(ESF SENT),WORD A1+1 & ZEROISES LOCAL NAM 4DS4 ... [OF QUALIFIER BLOCK. 4DS6 ... [ON ENTRY, X6= NO. OF BLOCKS WRITTEN SINCE LAST SENTINEL. 4DS8 ... [ X4 IS S/R LINK. 4DS= ... [ON EXIT, X3->QUALIFIER BLOCK, X6= NO. OF BLOCKS WRITTEN. 4DS# ... [ USES X0 & X1. 4DSB ... MHUNTW 3,FILE,FQUAL [X3-> FQUAL BLOCK 4DSD ... LDCT 0 #400 4DSG ... STO 0 ESENTYP(3) [SET 'END OF SUBFILE SENTINEL' 4DSJ ... STOZ ESENBP(3) [ZEROISE WORD 1 OF SENTINEL 4DSL ... LDN 0 ESENBP(3) 4DSN ... LDN 1 ESENBP+1(3) 4DSQ ... MOVE 0 18 [ZEROISE REST OF SENTINEL 4DSS ... SMO FX2 4DSW ... LDX 0 AWORK1 [SET BLOCK NO. IN ESFS SAME AS IN BSF 4DSY ... STO 0 ESENFN(3) 4DT2 ... STO 6 ESENBP(3) [SET UP NO. OF BLOCKS WRITTEN 4DT4 ... EXIT 4 0 4DT6 ...# 4DT8 ...# 4DT= ...# INSERTS 'NO. OF BLOCKS IN FILE' INTO WORD ESENCT OF QUALIFIER BLOCK, 4DT# ...# SPECIAL RESIDENCE NO. IN ESENAL IF ON A SPECIAL RESIDENCE, SETS 4DTB ...# FSIZE FENDBUCK & FVERSION INTO ESEN17,ESEN10 & ESEN11 RESPECTIVELY, S 4DTD ...# FILE NUMBER IN ESENFN & LOCAL NAME IN ESENLOC1-ESENFG & ESENLAN AND, 4DTG ...# IF A DIRECTORY, SETS B0 OF ESENB & INSERTS USER NAME IN ESENUSE1-3. 4DTJ ...# ON ENTRY, X4 IS S/R LINK. 4DTL ...# ON EXIT,X1->FINC BLOCK,X2->FCB,X3->FQUAL BLOCK 4DTN ...# X6=NO. OF BLOCKS TO BE DUMPED. USES X0 4DTQ ...UPDATEQUAL 4DTS ... TOPFCB 2 [X2-> FCB OF FILE BEING DUMPED 4DTW ... MHUNTW 3,FILE,FQUAL [X3-> QUALIFIER BLOCK 4DTY ... LDX 6 FBLMOD(2) 4DW2 ... SBN 6 FBLKS-A1 4DW4 ... LDX 0 FETM(2) 4DW6 ... STO 0 ESENTM(3) [SET TYPE/MODE 4DW8 ... LDX 0 FSIZE(2) 4DW= ... STO 0 ESEN17(3) [SET SIZE (OR MAX. SIZE) 4DW# ... LDX 0 FENDBUCK(2) 4DWB ... STO 0 ESEN10(3) [ LAST BUCKET WRITTEN, ETC., 4DWD ... LDX 0 FVERSION(2) 4DWG ... STO 0 ESEN11(3) [ & VERSION NO. 4DWJ ... LDN 0 FLOC1(2) 4DWL ... LDN 1 ESENLOC1(3) 4DWN ... MOVE 0 5 [SET UP LOCAL NAME OF FILE FROM FCB 4DWQ ... LDX 0 FLAN(2) 4DWS ... STO 0 ESENLAN(3) [ AND LANGUAGE 4DWW ... LDN 0 1 4DWY ... STO 0 ESENRL(3) [SET REEL NO., GEN. NO. & LANG. FOR A 4DX2 ... STO 0 ESENFG(3) 4DX4 ... SMO FX1 4DX6 ... LDX 0 MLANCOMP 4DX8 ... STO 0 ESENLAN(3) 4DX= ... LDX 0 BSPRE(2) 4DX# ... LDX 5 0 4DXB ... SBN 0 48 4DXD ... BPZ 0 SPECIAL [J IF ON A SPECIAL RESI&ENCE 4DXG ... LDN 5 0 [CLEAR SPECIAL RESIDENCE NO. 4DXJ ...SPECIAL 4DXL ... LDCT 7 #400 [ESENB VALUEFOR DIRS 4DXN ...# 4DXQ ...# THE FOLLOWING CODE IS ALSO EXECUTED BY THE CODE WHICH SETS UP 4DXS ...# THE QUAL BLOCK FOR FILES. 4DXW ...# ON ENTRY,X2->FCB,X3->FQUAL,X5=SPEC RESID WORD,X6=SIZE,X7=ESENB VALUE 4DXY ...# 4DY2 ...UPDCOMMON 4DY4 ... LDN 0 6 4DY6 ... STO 0 ESENTYP(3) [SET START OF S/F SENT. WORD 4DY8 ... STOZ ESEN1(3) [CLEAR WORDS NOT OTHERWISE UPDATED 4DY= ... STOZ ESEND2(3) [ 4DY# ... STO 7 ESENB(3) 4DYB ... STO 6 ESENCT(3) [SET 'NO. OF BLOCKS IN FILE' 4DYD ... STO 5 ESENAL(3) 4DYG ... LDN 0 FME1(2) [USER NAME OF DIR. 4DYJ ... LDN 1 ESENUSE1(3) 4DYL ... MOVE 0 3 [SET USER NAME IN QUALIFIER BLOCK 4DYN ... CALL 0 XLOCFINC [X1->FINC 4DYQ ... LDX 0 INCBLNUM(1) 4DYS ... SMO FX2 4DYW ... STO 0 AWORK1 [REMEMBER BLOCK NO. IN THIS INCR 4DYY ... STO 0 ESENFN(3) [SET IT UP IN QUAL BLOCK 4D^2 ... EXIT 4 0 4D^4 ...# 4D^6 ...# 4F5= # 4FJW # 4G4G # 4GJ6 X1INCMON [DUMPING AN OPEN FILE 4GJ= ... MHUNTW 1,FILE,FINC 4GJB ... JBC SENTOK,1,BINCCMPSENT [J IF NO COMPOS S/F WRITTEN 4GJG ... LDN 6 0 4GJL ... STOZ AWORK1(2) [CLEAR FILE NUMBER WORD 4GJQ ... CALL 4 SETESFS 4GJW ... CALL 4 WRITESFS [WRITE ESFS 4GK2 ...SENTOK 4GK6 ... TOPFCB2 2 4GK= ... TRACEIF K6INCWRITE,199,299,FME1(2),USER 4GKB ... TRACEIF K6INCWRITE,199,299,COMM(2),PASS3 4GKG ... BC 2,BFCORE [DONT KEEP USAGE BLOCKS 4GKL ... REWIND [REWIND THE DIR 4GKQ ... CALL 4 UPDATEQUAL [SET UP BSFS FROM FCB 4GKW ... CALL 4 WRITESFS [WRITE IT 4GL2 ... LDN 0 INDEXDIR [INDEX NO FOR A DIR 4GL6 ... STO 0 AWORK3(2) [SET UP AWORK3 AS EXPECTED BY DUMPER 4GLP ...#UNS FNSAD 4GP# ...( 4GRX ... DOWN INCVFCHK,1 [ SET UP DIRECTORY CHECKING 4GWG ... NULL [ NEVER OBEYED - ALWAYS COMES UPPLUS 1 HERE 4G^5 ...) 4H3Q LDN 4 0 [SET 'FILE OPEN' MARKER 4HHB TOPFCB2 3 [X3->FCB 4J32 JBS SERIAL,3,BFSER [J IF SERAL 4JGL NOTSER 4K2= NGN 7 1 4KFW STO 7 AWORK3(2) [AWRORK3 -VE MEANS NOT SERIAL 4K^G SERIAL 4LF6 ... CALL 0 XLOCFINC [X1->FINC 4LYQ LDX 0 CLEANCT 4MDB STO 0 INCTIMING(1) [REMEMBER TIME 4MY2 STOZ INCWORK(1) [ZERO SPACE LEFT IN CURRENT 4NCL [COMPRESSED BLOCK COUNT. 4NX= STOZ AWORK2(2) [ZERO COMPRESSED BLOCK SIZE 4PBW STOZ AWORK4(2) [ZERO PRVIOUS KEY WORD 4PWG STO 6 AWORK1(2) [STORE SIZE OF FILE 4QB6 LDN 6 0 [ZERO BLOCKS WRITTEN COUNT 4QTQ READB 4R*B BXE 6 AWORK1(2),READBEND [J IF END OF FILE 4RK8 LDX 5 CLEANCT [SAVE TIME WE STARTED WAIT FOR BS 4RT2 BNZ 4 NFCB [J IF FILE NOT OPEN 4S#L READB [READ Z BLOCK OF FILE 4SS= MHFINC 4T53 ... CALL 0 XLOCFINC [X1->FINC 4T*S LDX 0 CLEANCT [COMPUTE TIME WAITED FOR BS 4TCQ SBX 0 5 4TFN BPZ 0 NMIDNIGHT3 [J IF MIDNIGHT NOT OCCURRED 4THL SMO FX1 4TKJ ADX 0 NCLEANDAY [ADD A DAYS CLEANCTS 4TMG NMIDNIGHT3 4TPD ADS 0 INCBSWAIT(1) [UPDATE TIME WAITING FOR BS 4TRG BZE 6 SFIRST [J IF 1ST BLOCK OF FILE 4W?6 CALL 7 WAIT [WAIT FOR LAST TRANSFER TO COMPLETE 4WQQ CALL 7 READBSTS [IF FILE CLOSED, AND MORE READS 4X=B [ISSUE NEXT READ 4XQ2 SFIRST 4Y9L MHUNTW 3,FILE,FRB [X3->NEW FRB 4YP= LDX 0 AWORK3(2) 4^8W BNG 0 WROUT [J IF NOT SERIAL- NO CHECKS 4^NG LDX 7 INCWORK(1) [GET COUNT OF SPACE LEFT 5286 [IN CURRENT COMPRESSED BLOCK 52MQ 537B # IF THE FILE IS SERIAL, WE CHECK THAT THE RECORD HEADERS 53M2 # ARE VALID AND THAT THEIR SUM DOES NOT EXCEED THE SIZE OF A BS BLOCK 546L # 54L= # IF IT IS INDEXED, WE ALSO CHECK THAT THE KEYS ARE IN ASCENDING ORDER 555W # AND THAT THE KEY FOR A BLOCK IS EQUAL TO THE HIGHEST KEY FOUND SO FAR 55KG # 5656 STOZ ACOMMUNE1(2) [ZEO DISTANCE DOWN BLOCK 56JQ ADN 3 A1 [X3->1ST REC 574B TAGAIN 57J2 LDX 0 FRH(3) 583L BPZ 0 NDUM [J IF NOT ADUMMY REC 58H= ANDX 0 BRHMASK 592W BNZ 0 XDUD [H IF ILLEGAL BITS IN REC HEADER 59GG LDEX 0 FRH(3) 5=26 BRN YDUM 5=FQ NDUM 5=^B NGX 5 AWORK3(2) 5?F2 BPZ 5 YDUM [J IF NOT INDEXED FILE 5?YL SBX 7 0 [SUBTRACT FROM CT OF SPACE LEFT 5#D= [IN CURRENT COMPR BLOCK 5#XW BPZ 7 YDUM [J IF NOT OVER FULL 5*CG LDN 7 1 5*X6 ADS 7 AWORK2(2) [INCR. COMPRESSED SIZE 5BBQ LDN 7 GSBS-1 [RESET SPACE AVAIL CT 5BWB SBX 7 0 5CB2 YDUM 5CTL BZE 0 XINDCHECK [J IF END OF BLOCK 5D*= ADX 0 ACOMMUNE1(2) 5DSW STO 0 ACOMMUNE1(2) [UPDATE DISTANCE DOWN BLOCK 5F#G BXGE 0 BSBS,XDUD [J IF OFF END OF BLOCK 5FS6 KEYRECI AWORK3(2),,3,NOKEY,5 [X5=KEY IF ANY 5G?Q BXL 5 AWORK4(2),XDIR [J IF LESS THAN PREV KEY 5GRB STO 5 AWORK4(2) [REMEMBER AS 'PREVIOUS KEY' 5H?2 NOKEY 5HQL LDEX 0 FRH(3) 5J== ADX 3 0 [X3=NEXT REC 5JPW BRN TAGAIN 5K9G XINDCHECK 5K*Y ... LDX 0 AWORK3(2) [ 5KGB ... BZE 0 NINDCH [J IF NOT INDEXED FILE 5KH= ...#UNS FNSAD 5KJ6 ... SBN 0 1 5KK2 ...#UNS FNSAD 5KKW ...#STR 5KLS ... SBN 0 2 5KR= ... BNG 0 NOTVSF2 [J IF NOT A DIR 5KXN ... DOWN INCVFCHK,2 [PERFORM FILE DEPENDENT VSF CHECKS 5K^7 ...#UNS FNSAD 5L2L ... BRN MTEOT [ ERROR DETECTED 5L46 ...NOTVSF2 5L8Q BNZ 4 NFCB2 [J IF FILE NOT OPEN 5LNB TOPFCA2 3 [X3->FCA 5M82 FFINDEXB 3,3 [X3->INDEX BLOCK 5MML XINDEX 5N7= SMO 6 5NLW LDX 0 INDEXREC(3) [X0=KEY FOR BLOCK 5P6G BXU 0 AWORK4(2),XDIR [J IF NOT = LAST KEY FOUND 5PL6 NINDCH 5Q5Q ... CALL 0 XLOCFINC 5QKB STO 7 INCWORK(1) [SAVE CT OF SPACE LEFT IN 5R52 [CURRENT COMPRESSED BLOCK 5RJL WROUT 5RKH ...#UNS FPD 5RLD ...( 5RM* ... CALL 1 SFINDFRB 5RN= ... LOCKC 2,SFINDFRB [LOCK BUFFER 5RP7 ... MHUNTW 3,FILE,FRB 5RQ4 ... LDN 0 A1(3) [START OF TRANSFER ADDR 5RQ^ ... STO 0 ACOMMUNE3(2) 5RRW ... LDN 0 1 [MODE OF TRANSFER 5RSR ... STO 0 ACOMMUNE1(2) 5RTN ... LDN 0 GSBS [LENGTH OF TRANSFER 5RWK ... STO 0 ACOMMUNE2(2) 5RXG ... DOWN MTDUMP,3 [INITIATE AUTONOMOUS TRANSFER 5RYC ...) 5R^# ...#UNS FPD 5S29 ...#SKI 5S36 ...( 5S4= LDX 5 INCCOPIES(1) [X5=NO. OF DTA'S 5SHW LDN 0 1 5T3G STO 5 INCACT(1) [NO. OF RUNNING DUMPERS ACTS 5TH6 ADS 0 INCACT(1) [+1 FOR DUMPER ITSELF 5W2Q CALL 1 SFINDFRB [X2->FRB 5WGB LOCKC 2,SFINDFRB [LOCK IT DOWN 5X22 MHUNTW 3,FILE,FRB [X3->FRB 5XFL S10 5X^= FINDACTFB 2,,ACTDOC,ADUMPT,,BPTR [X2->NEXT DTA 5YDW LDN 0 1 5YYG DCA ,STO,0,MODE [SET UP MODE 5^D6 LDN 0 GSBS 5^XQ DCA ,STO,0,COUNT [COUNT 62CB LDN 0 A1(3) 62X2 DCA ,STO,0,CTSA [START ADDRESS 63BL SMO FX2 63W= STO 2 ACOMMUNE1 [REMEMBER ADDR OF DTA 64*W FPUT [KICK IT 64TG LDX 2 ACOMMUNE1(2) 65*6 BCT 5 S10 65JY ...) 65SQ ADN 6 1 [INCR COUNT OF BLOCKS WRITTEN 66#B LDX 2 FX2 66S2 BRN READB [GO FOR ANOTHER FILE BLOCK 67?L 67R= XDUD 68=W XDIR 68?P ...#UNS JSKI33 68#J ...( 68*C ... MHUNTW 3,FILE,FRB [X3->FRB OF CORRUPT BLOCK 68B= ... LDX 5 BACK1(3) [RESID NO FOR CORRUPT FILE HANDLER 68C5 ... LDX 3 BACK2(3) [LIKEWISE BLOCK NO. 68CY ... CORRUPTB 5,3 [INVOKE CORRUPT FILE MECHANISM 68DR ... [CORRUPTB WILL GEOERR IF IT 68FL ... DOWN INCEOT,5 [IS A DIRECTORY OTHERWISE WE MARK 68GF ... CALL 0 XLOCFINC [THE FILE 'TO-BE-CLOSEABANDONED' 68H# ... BRN WROUT [AND CARRY ON DUMPING IT WITHOUT 68J7 ... [FURTHER CHECKS AND WITHOUT UPDATING 68K2 ... [THE DIRECTORY ENTRY. THIS MAINTAINS 68KT ... [THE DUMPTAPE FORMAT 68LN ...) 68MH ...#UNS JSKI33 68NB ...#SKI 68P9 ...( 68QG BNZ 4 NFCB3 [FILE NOT OPEN=J 69=6 MHUNTW 1,FILE,FRB 69PQ NAME 1,FILE,FURB 6=9B SFCA ,2,2 [X2->FSTACK 6=P2 CHAIN 1,2 [CHAIN BLOCK IN FILE CHAIN FOR PM 6?8L NFCB3 6?N= SMO FX2 6#7W NGX 0 AWORK3 6#MG BNG 0 XDDIR [J IF INDEXED 6#X# ... DOWN INCEOT,4 [OUTPUT WARNING MESSAGE 6*76 ... CALL 7 UPDCOUNTS [UPDATE COUNTS ETC 6*BY ... BRN MTEOT [EXIT BY EOT PATH 6*LQ XDDIR 6B6B GEOERR BRIEFPM,DUD DIR 6BL2 6BNK ...) 6BR8 # 6BYB # 6C5L X2INCMON [DUMPING A CLOSED FILE 6C5S ... READAGAIN [GET A FILE/ENT BLOCK 6C62 ... MHUNTW 3,FILE,FRB 6C68 ... NAME 3,FILE,ENT [X3->FILE/ENT BLOCK 6C6B ... JBC NFLINC2,,BPARALLEL [J IF NOT TO BE WRITTEN TO 2ND INC 6C6J ... JMBS NFLINCP,3,BEALLINCS,BEREVERE 6C6Q ... BS ,BFILEINC [SET FILE ONLY INCR MARKER 6C6Y ... BRN NOSENT2 [NO COMP SF XENT NEEDED 6C76 ...# 6C7# ...# IF THE FILE IS TO BE DUMPED ON THE RESTORABLE INCR OF A PARALLEL 6C7G ...# DUMP WE MUST RECORD THE FACT, AS A TAPE EVENT ON THE FILE ONLY INC 6C7N ...# MAY MAKE IT NECESSARY TO BACKSPACE THE RESTORABLE INCR AND 6C7W ...# DEUPDATE THE DIRENT. 6C84 ...# 6C8= ...NFLINCP 6C8D ... CALL 4 RESTARTDATA 6C8L ...NFLINC2 6C8S ... MHUNTW 1,FILE,FINC 6C92 ... BS 1,BINCTERMINL [ PASS 2 NOT IN VAIN 6C98 ... JBC NOSENT2,1,BINCGENRES [J IF NOT POT GEN RES 6C9B ... JBSS NOSENT2,1,BINCCMPSENT [J IF COMP S/F SENT ALREADY 6C9J ... CALL 4 UPDATEQUAL 6C9Q ... CALL 4 WRITESFS [WRITE ONE 6C9Y ...NOSENT2 6C=6 ...# 6C=# ...# WE ARE GOING TO HAVE TO DUMP THE FILE USING BACKREADS 6C=G ...# FIRST WE HAVE TO SET UP THE QUAL BLOCK FROM THE FILE/ENT 6C=N ...# 6C=W ...# 6C?4 ... MHUNTW 1,FILE,ENT 6C?= ... TRACEIF K6INCWRITE,199,299,ELOC1(1),INCCFILE 6C?D ... MHUNTW 3,FILE,FQUAL [X3->FQUAL BLOCK 6C?L ... LDX 0 ETM(1) 6C?S ... STO 0 ESENTM(3) [TYPE/MODE 6C#2 ... LDEX 0 EINF3(1) 6C#8 ... STO 0 ESEN17(3) [MAX SIZE 6C#B ... LDX 0 EENDBUCK(1) 6C#J ... STO 0 ESEN10(3) [LAST BUCKET WRITTEN ETC 6C#Q ... LDX 0 EVERSION(1) 6C#Y ... STO 0 ESEN11(3) [VERSION NO. 6C*6 ... LDN 4 ELOC1(1) 6C*# ... LDN 5 ESENLOC1(3) 6C*G ... MOVE 4 5 [MOVE ACROSS LOCAL NAME ETC 6C*N ... LDX 0 ELAN(1) 6C*W ... STO 0 ESENLAN(3) [LANGUAGE 6CB4 ... LDN 7 0 [ESENB VALUE FOR FILES 6CB= ... LDN 5 #77 6CBD ... ANDX 5 EALLOC(1) [RESID NO IF ALLOCATED 6CBL ... JMBC NREV,1,BEREVERE,BESERIAL [J IF NOT SERIAL AND REVERED 6CBS ...# 6CC2 ...# IN THE SERIAL REVERED CASE, WE MUST DUMP ONLY THOSE BLOCKS WRITTEN 6CC8 ...# TO BACKING STORE. THE CODE TO DO THE FINDING OUT IS IN INCEOT. 6CCB ...# 6CCJ ... DOWN INCEOT,2 [LEAVES NO OF BLOCKS IN ACOMMUNE1 6CCQ ... MHUNTW 3,FILE,FQUAL 6CCY ... LDX 6 ACOMMUNE1(2) 6CD6 ... BRN REV 6CD# ...NREV 6CDG ... LDX 6 ECOPS(1) 6CDN ... SRL 6 15 6CDW ...REV 6CF4 ... TOPFCB 2 [X2->FCB OF SUP DIR 6CF= ... CALL 4 UPDCOMMON [CARRY OUT UPDATING COMMON WITH DIRS 6CFD ... CALL 4 WRITESFS [WRITE THE BSFS 6CFL ... READ [GET BLOCKS REC 6CFS ... MHUNTW 3,FILE,FRB 6CG2 ... NAME 3,BSTB,FULLB [CALL IT A FULLB BLOCK 6CG8 ... BWZ AWORK3(2),WRITEF [J IF NOT INDEXED 6CGB ... READ [GET INDEX RECORD 6CGJ ... MHUNTW 3,FILE,FRB 6CGQ ... NAME 3,FILE,FINTER1 6CGY ...WRITEF 6CK= LDN 4 1 [SET FILE NOT OPEN 6CMT ... LDX 0 AWORK3(2) 6CQD ... SBN 0 2 [IS IT A VSF 6CT3 ... BNG 0 NOTVSF3 6CXL ... DOWN INCVFCHK,1 [INITIALISE FILE DEPENDENT CHECKING 6CYF ...#UNS FNSAD 6C^# ... NULL [ NEXER OBEYED - ALWAYS COMES UPPLUS 6D29 ...NOTVSF3 6D4W BZE 6 NULLFILE2 6DJG LDX 5 6 6F46 BXL 5 INCREADLIM(1),READLOOP 6FHQ LDX 5 INCREADLIM(1) 6G3B READLOOP [X5 =MIN(INCREADLIM,FILE SIZE) 6GH2 [WE NOW SET UP THAT MANY BUFFERS AND 6H2L [START FILLING THEM 6HG= STO 5 AWORK1(2) 6H^W SETNCORE GSBS,3,BSTB,BFREEW [SET UP BUFFER 6JFG CALL 7 READBSTS [ISSUE READ 6J^6 LDX 5 AWORK1(2) 6KDQ BCT 5 READLOOP 6KYB NULLFILE2 6LD2 MHUNTW 3,FILE,ENT 6LXL JBS SERIAL,3,BESERIAL 6MC= BRN NOTSER 6MGB # 6MKG # THIS CODE IMPLEMENTS THE WAIT FOR A BS BLOCK WHEN WE ARE 6MNL # DUMPING A CLOSED FILE VIA BSTS DIRECT. 6MRQ # 6MWW NFCB 6NBG MHUNTW 1,BSTB,FULLB [X1->BLOCKS REC 6NW6 SMO 6 6P*Q LDX 7 A1+2(1) [X7=BLOCK NO 6PTB BACKWAIT ,A1+1(1),7 [WAIT FOR END OF TRANSFER 6PX# ...#UNS JSKI33 6P^= ...( 6Q38 ... JBC NOFAIL,2,EXDUMPFAIL [J IF NO FAILED TRANSFERS 6Q3M ... MHUNTW 1,BSTB,FULLB 6Q47 ... CORRUPTB A1+1(1),7 [INVOKE CORRUPT FILE MECHANISM 6Q56 ... DOWN INCEOT,5 6Q74 ... [MARK FILE TO BE CLOSEAB'D 6Q92 ...NOFAIL 6Q=Y ...) 6Q*2 MHUNTW 1,BSTB,FULLB [GET BLOCK NO AGAIN IN CASE 6QSL SMO 6 [BSTS HAS CHANGED IT COS OF 6R#= LDX 7 A1+2(1) [WRITE FAIL BY SOMEONE ACCESSING IT 6RRW XFINDBL 6S?G HUNT2OPT 2,BSTB,BREAD [X2->NEXTBREAD 6SR6 BPZ 2 XFOUND [J IF FOUND ONE 6T=Q GEOERR BRIEFPM,INCBLALT [LOG. BLOCK NO. IN FILE OVERWRITTEN 6TQB XFOUND 6W=2 BXU 7 BACK2(2),XFINDBL [J IF NOT THE ONE 6WPL NAME 2,FILE,FRB [NAME IT A FRB 6X9= LDX 2 FX2 6XNW BRN MHFINC 6Y8G NFCB2 6YN6 MHUNTW 3,FILE,FINTER1 [X3->INDEX REC 6^7Q BRN XINDEX 6^MB 7272 # THE FOLLOWING CODE SETS UP THE PARAMS FOR THE MESSAGE 72LL # DETAILS ARE:- 1) USERNAME 736= # 2) LOCALNAME 73KW # 3) GENERATION NO. 745G # 4) LANGUAGE 74K6 # 5) SIZE IN BLOCKS 754Q # 6) TYPE/MODE OF FILE 75JB # 7) BLOCK NUMBER WITHIN THIS INCREMENT 7642 # 8) TIME TO DUMP IN 1/5 SECS. 76HL # 9) NUMBER OF THE F/S RESIDENCE HOLDING THE FILE. 773= # 77GW # 782G READBEND [END OF FILE 78G6 ... CALL 0 XLOCFINC 78^Q BZE 6 NULLFILE [J IF NOTHING WRITTEN 79FB CALL 7 WAIT [WAIT IF NEC. 79^2 NULL [EXIT PATH NOT USED HERE 7=DL NULLFILE 7=Y= CALL 7 UPDCOUNTS [UPDATE THE COUNTS 7?2T ... LDX 0 AWORK3(2) 7?3* ...#UNS FNSAD 7?3T ... SBN 0 1 7?4* ...#UNS FNSAD 7?4T ...#STR 7?5D ... SBN 0 2 [IS FILE INDEXED VSF 7?83 ... BNG 0 NOTVSF4 [J IF NOT 7?=L ... DOWN INCVFCHK,3 7??F ...#UNS FNSAD 7?#* ... BRN MTEOT [ ERROR DETECTED 7?*9 ...NOTVSF4 7?CW 7?K4 ... CALL 0 XLOCFINC 7?Q= ... JBS NOMESS,1,BINCRFAIL 7?XG MHUNTW 3,FILE,FQUAL [X3->FILE/FQUAL 7#C6 LDN 5 3 [PARAM LENGTH 7#WQ LDN 6 JPDUSERNAME [PDC 7*BB LDN 4 ESENUSE1(3) [USERNAME 7*W2 CALL 7 SUBPACKX [PUT OUT USERNAME 7B*L 7BT= MHUNTW 3,FILE,FQUAL [X3->FILE/FQUAL 7C#W LDX 0 ESENB(3) 7CSG BPZ 0 PNOTDIR [J IF IT ISN'T A DIR. 7D#6 CALL 7 SUBNULL [NO LOCAL NAME 7DRQ CALL 7 SUBNULL [NO .GEN 7F?B CALL 7 SUBNULL [NO LANG. 7FR2 BRN PSIZE 7G=L 7GQ= PNOTDIR 7H9W LDN 4 ESENLOC1(3) [LOCAL NAME 7HPG LDN 6 JPDLOCNAME [PDC 7J96 CALL 7 SUBPACKX [PUT OUT LOCAL NAME 7JNQ 7K8B MHUNTW 3,FILE,FQUAL [X3->FILE/FQUAL 7KN2 LDN 4 ESENFG(3) [GEN NO 7L7L LDN 5 1 [RESET PARAM LENGTH 7LM= LDN 6 JPDGENNUM [PDC 7M6W CALL 7 SUBPACKX 7MLG 7N66 MHUNTW 3,FILE,FQUAL [X3->FILE/FQUAL 7NKQ LDN 4 ESENLAN(3) [LANG. 7P5B LDN 6 JPDLANGUAGE [PDC 7PK2 CALL 7 SUBPACKX [PUT OUT LANGUAGE 7Q4L 7QJ= PSIZE 7R3W LDN 5 1 [RESET PARAM LENGTH FROM DY PATH 7RHG LDN 4 AWORK1(2) [BLOCK COU T 7S36 LDN 6 JPDBLOCKCT [BLOCK COUNT 7SGQ CALL 7 SUBPACKX [PUT OUT SIZE 7T2B 7TG2 MHUNTW 3,FILE,FQUAL [X3->FILE/FQUAL 7T^L LDX 0 ESENB(3) 7WF= BNG 0 PNULL [J IF DIR 7WYW LDX 0 ESENTM(3) [TYPE/MODE 7XDG BNZ 0 PTM [J IF NONZERO TM 7XY6 PNULL 7YCQ CALL 7 SUBNULL [PUT OUT NOTHING IF ZERO TM 7YXB BRN PBLNUM 7^C2 PTM 7^WL LDN 4 ESENTM(3) 82B= LDN 6 JPDOCTA 82TW CALL 7 SUBPACKX [PUT OUT T/M 83*G 83T6 PBLNUM 84#Q MHUNTW 3,FILE,FQUAL [X3->FILE/FQUAL 84SB LDN 4 ESENFN(3) [BLOCK NO 85#2 LDN 6 JPDNUMA 85RL CALL 7 SUBPACKX [PUT OUT BLOCK NO 86?= 86QW LDN 4 AWORK2(2) [TIME TO DUMP 87=G LDN 6 JPDNUMB 87Q6 CALL 7 SUBPACKX 889Q 88PB LDN 4 AWORK4(2) 8992 LDN 6 JPDNUMC 89NL CALL 7 SUBPACKX [PUT OUT RESID NO 8=8= 8=#Y ...#UNS FPD 8=FL ...( 8=L# ... JBC NPLL,,BPARALLEL 8=R2 ... CALL 0 XLOCFINC [IN PLLL MODE OUTPUT INCR NO 8=XN ... LDN 4 INCNO(1) 8?4B ... LDN 6 JPDINCNUM 8?94 ... CALL 7 SUBPACKX 8?*Q ...NPLL 8?GD ...) 8?GN ...NOMESS 8?GY ... MHUNTW 3,FILE,FQUAL 8?HD ... LDX 0 ESENFN(3) 8?HY ... STO 0 AWORK1(2) [RESET AWORK1 FOR WRITESFS 8?JD ... LDX 6 ESENCT(3) [AND X6 FOR SETESFS 8?JY ... CALL 4 SETESFS 8?KD ... CALL 4 WRITESFS 8?KY ... LDX 0 AWORK1(2) [PASS NEW VALUE OF AWORK1 8?LD ... STO 0 ACOMMUNE1(2) [TO INCWRITE 8?M6 UPPLUS 1 [NORMAL EXIT 8?MB ...X3INCMON 8?ML ... CALL 4 WRITESFS 8?MW ... UP 8?N6 ...# 8?NB ...X4INCMON 8?NL ... CALL 4 UPDATEQUAL 8?NW ... CALL 4 WRITESFS 8?P6 ... UPPLUS 1 8?PB ...X5INCMON [ENTRY TO WRITE EIS 8?PL ... CALL 4 RESTARTFREE [ENSURE ALL RESTAR DATA FORGOTTEN 8?PW ... BC ,BFILEINC [ENSURE WRITESFS PICKS UP 1ST FINC 8?Q6 ...NEXTFINC 8?QB ... LDN 6 0 [ZERO FILE SIZE 8?QL ... STOZ AWORK1(2) [ZERO FILE NUMBER 8?QW ... CALL 4 SETESFS [SET UP ESFS 8?R6 ... CALL 0 XLOCFINC 8?RB ... JBC YEOTS,1,BINCFIN [J IF INC NOT TO BE WOUND UP 8?RL ... JBSS YEOIS,1,BINCEOIS [J IF END INC SENT ALREADY WRITTEN 8?RW ... LDCT 7 #200 [SHOW EI SENT 8?S6 ... JMBC NOREST,1,BINCENDBAT,BINCGENRES[J IF NOT SUIT FOR GEN RES 8?SB ... LDCT 7 #600 [MARK AS GEN RESTOREABLE 8?SL ...NOREST 8?SW ... STO 7 ESENGR(3) 8?T6 ... CALL 4 WRITESFS [WRITE E1S 8?TB ...YEOIS 8?TL ... JBSS YEOTS,1,BINCEOTS [J IF END OF TAPE SENT ALREADY WRITTE 8?TW ... MHUNTW 3,FILE,FQUAL 8?W6 ... LDN 0 7 8?WB ... STO 0 ESENTYP(3) [SET ETS 8?WL ... STOZ ESENGR(3) [CLEAR GENRES WORD 8?WW ... CALL 4 WRITESFS 8?X6 ...#UNS IDC 8?XB ...( 8?XL ...# 8?XW ...# WE NOW BACKSPACE BACK OVER END OF TAPE SENTINEL 8?Y6 ...# SO THAT TAPE IS CORRECTLY POSITIONED FOR NEXT INCREMENT,IF 8?YB ...# IT USES THIS TAPE WITHOUT REWINDING 8?YL ...# 8?YW ... LDN 3 2 [ COUNT OF BACKSPACES 8?^6 ...YBSPACE2 8?^B ... LDN 0 3 [ SET UP APPROPRIATE MODE 8?^L ... STO 0 ACOMMUNE1(2) 8?^W ... DOWN MTDUMP,2 [ DOWN TO FIRE OFF PERIS 8#26 ... BCT 3 YBSPACE2 [ BACK FOR NEXT PERI 8#2B ... CALL 0 XLOCFINC [ GET POINTER TO FINC AGAIN 8#2L ...) 8#2W ...YEOTS 8#36 ... JBC NOPLL,,BPARALLEL [J IF NOT IN PL MODE 8#3B ... JBSS NOPLL,,BFILEINC [J IF NOT SECOND FINC 8#3L ... HUNT2 1,FILE,FINC [X1-> 2ND FINC 8#3W ... JBS NEXTFINC,1,BINCFIN [IF INCR TO BE WOUND UP JUMP BACK 8#46 ...NOPLL 8#4B ... BC ,BDUMPING [ SHOW NO LONGER DUMPING 8#4L ... CALL 0 XFDUMPCOM 8#4Q ... BNG 1 NOFDUMPFR 8#4W ... FREECORE 1 [ FREE FDUMPCOM BLOCK 8#56 ... MFREEW FI,INDEXCHK 8#5= ...NOFDUMPFR 8#5B ... UP 8#5L ...X7INCMON 8#5W ...MTEOT 8#66 ... ACROSS INCEOT,1 8#6Q # 8#LB MENDAREA 20,K99INCMON 8*62 # 8*KL #END ^^^^ ...53526321001000000000