INCPROC850
(George Source)
Macros used: BXL, CHAIN, GEOERR, MENDAREA, MFREEW, MHUNTW, MONOUT, OP, OUTPACK, OUTPARAM, OUTPARN, SEG, SEGENTRY, SETNCORE, STEPAGAIN, TOPFCB2, UNNORM, UP
- INCPROC850.txt
22FL ... SEG INCPROC,850,MIKE PUTNAM,INCDUMP 22^= # 23DW SEGENTRY K1INCPROC,X1INCPROC 24D6 # 24XQ # ENTERED FROM INCWRITE. 25CB # 25X2 # ON ENTRY:- 26BL # X4=INCR. NO. NOW PROVEN NOT OBSELETE 26W= # X7=POINTER TO INCR NO IN FINCPROC (RELATIVE TO FINCNOBS WORD) 27*W # X5=0 MEANS FILE NOT DUMPED BECAUSE OFFLINE 27TG # =1 MEANS FILE NOT DUMPED BECAUSE OPEN UNCLEANLY 28*6 # 28SQ # ADJUSTS FINCPROC BLOCK IF INCR. NOT PREVIOUSLY KNOWN NOT TO BE OBSOLE 29#B # ALSO :- 29S2 # IF FILE OPEN, OUTPUTS MON. FILE MESSAGE 2=?L # IF FILE OFF-LINE, OUTPUTS MON. FILE MESSAGE AND SETS UP A 2=R= # FABSNB BLOCKS FOR THE FILE & LEAVES THEM IN ACT. CHAIN 2?=W # (CHAINED IN ASCENDING NO. ORDER AFTER FINCPROC BLOCK) 2?QG # READY TO ISSUE RETRIEVE FOR IT. 2#=6 # 2B8L # WORD FINCRVLIM IN THE FINCPROC BLOCK IS SET UP WITH A LIMIT 2BN= # ON THE NUMBER OF RVS WHICH CAN BE ISSUED IN A DUMP 2C7W # THIS IS DECREMENTED EACH TIME A FABSNB IS SET UP AND/OR A 2CMG # RV ISSUED 2D76 # 2DLQ # 2F6B # CONSTANTS 2FL2 # 2G5L OP 20HOPEN 2GK= RT 20HBEING RETRIEVED 2H4W YR 20HYET TO BE RETRIEVED 2HJG # 2J46 # 2JHQ # 2K3B RVCHECK [UPDATES RV COUNT. IF LIMIT REACHED PREVIOUSLY 2KH2 [BRANCHES TO TOUT. IF LIMIT NOW REACHED OUTPUTS 2L2L [MESSAGE. 2LG= [CALLED ON X5,USES X6,MAY COORDINATE 2L^W [ON EXIT X2->FINCPROC 2MFG MHUNTW 2,FILE,FINCPROC 2M^6 LDX 6 FINCRVLIM(2) [GET LIMIT 2NDQ SBN 6 1 [DECR 2NYB BNG 6 TOUT [J IF ALREADY EXHAUSTED 2PD2 BNZ 6 RVOUT [J IF NOT YET EXHAUSTED 2PXL SBX 5 FX1 2QC= MONOUT INCRVLIM [OUTPUT MESSAGE 2QWW ADX 5 FX1 2RBG MHUNTW 2,FILE,FINCPROC 2RW6 RVOUT 2S*Q STO 6 FINCRVLIM(2) 2SKJ EXIT 5 0 2STB # 2T*2 SETFABS [SETS UP A FABSNB FOR THE FILE 2TSL [CALLED ON X6. ON EXIT X2>FABS. COORDINATES 2W#= SBX 6 FX1 2WRW SETNCORE 10,3,FILE,FABSNB [SET UP FABSNB FOR UNNORM & (IF FILE 2X?G LDN 0 10 [OFFLINE) FOR RETRIEVING FILE 2XR6 STO 0 A1(3) [SET REC. HEADER 2Y=Q TOPFCB2 2 [X2-> FCB OF DIR. 2YQB ADN 2 FME1 2^=2 ADN 3 A1+1 2^PL MOVE 2 3 [MOVE DIR. NAME TO FABSNB FROM FCB 329= STEPAGAIN 32NW MHUNTW 2,FILE,FABSNB 338G LDN 1 ELOC1N(3) 33N6 ADN 2 A1+4 347Q MOVE 1 5 [MOVE LOCAL NAME TO FABSNB FROM DIR. 34MB LDX 0 ELANN(3) [ ENTR 3572 STO 0 5(2) 35LL ADX 6 FX1 366= EXIT 6 0 36KW # 375G OUTFILE [OUTPUTS A FILE NAME AS A PARAMETER 37K6 [CALLED ON X6,COORDINATES 384Q ... SBX 6 FX1 3DBB SETNCORE CPDATA-A1+10,2,ADATA,CREADL [SET UP FOR UNNORM 3DW2 STOZ A1(2) [CURRENT COUNT OF CHARS =0 3F*L UNNORM [CONVERT CURRENT FILE NAME TO CHARS 3H#6 MHUNTW 1,ADATA,CREADL 3HRQ OUTPARAM A1(1),CPDATA,ADATA,CREADL [OUTPUT FILE NAME PARAMETER 3J?B MFREEW ADATA,CREADL 3J?M ... ADX 6 FX1 3J?^ EXIT 6 0 3J#J # 3J*7 # 3J*Q # 3JB* X1INCPROC 3JBY MHUNTW 1,FILE,FINCPROC [X1-> FINCPROC BLOCK 3JCH LDX 0 FINCNOBS(1) 3JD6 SBX 0 7 3JDP BNG 0 NTOBS [J IF INCR KNOWN ALREADY NO TO BE OBS 3JF# SMO FINCNOBS(1) 3JFC ...#UNS FPD 3JFG ... LDX 0 INCLISTS-1(1) [X0=INCR NO OF LAST STILL OBSOLETE 3JFK ...#UNS FPD 3JFN ...#SKI 3JFX LDX 0 FINCNOBS(1) [X0= INCR NO. OF LAST STILL OBSOLETE 3JGG SMO 7 [ 3JGK ...#UNS FPD 3JGN ... STO 0 INCLISTS-1(1) [SWAP INCR NO FOUND NOT TO BE OBS 3JGR ...#UNS FPD 3JGW ...#SKI 3JH5 STO 0 FINCNOBS(1) [SWAP INCR NO. FOUND NOT TO BE OBSOLE 3JHN SMO FINCNOBS(1) [ WITH LAST NO. IN STILL OBSOLETE LI 3JHR ...#UNS FPD 3JHW ... STO 4 INCLISTS-1(1) 3JH^ ...#UNS FPD 3JJ4 ...#SKI 3JJ? STO 4 FINCNOBS(1) 3JJW LDN 0 1 3JKF SBS 0 FINCNOBS(1) [REDUCE BY 1 NO. OF STILL OBSOLETE IN 3JL4 [INCR. IN LIST 3JLM NTOBS 3JM= OUTPACK 4,1,INCNUM [OUTPUT INCR. NO. PARAMETER 3JMT CALL 6 SETFABS [SET UP A FABSNB 3JND CALL 6 OUTFILE [OUTPUT FILENAME AS PARAM 3JP3 BZE 5 OFFLINE [J IF FILE OFFLINE 3JPL MFREEW FILE,FABSNB 3JQ9 OFFLINE 3JR2 LDN 6 OP(1) 3K=L BNZ 5 YOP [J IF FILE OPEN FOR WRITING 3KQ= LDN 6 RT(1) 3L9W MHUNTW 3,FILE,FINCPROC 3LPG LDX 0 FINCRVLIM(3) [GET COUNT OF RV' S ALLOWED 3M96 BNZ 0 YOP [J IF NOT YET EXHAUSTED 3MNQ LDN 6 YR(1) 3N8B YOP 3NN2 LDN 1 ACOMMUNE1(2) 3P7L LDX 0 6 3PM= MOVE 0 5 [SET UP AND OUTPUT "OPEN" OR 3Q6W OUTPARN 20,ACOMMUNE1 [ "BEING RETRIEVED" OR "Y-T-B-RVED" 3QLG [ AS 3RD PARAMETER 3R66 MONOUT INCPROCOPE [OUTPUT "INCR. %A NOT OBSOLETE - %B % 3RKQ BNZ 5 TEND [J IF FILE OPEN 3S5B CALL 5 RVCHECK [CHEXK RV LIM NOT EXCEEDED 3S=J ...#UNS FPD 3SCQ ...#SKI 3SK2 MHUNTW 2,FILE,FINC 3T4L LDX 5 INCRV(2) [X5= CURRENT NO. OF FILES TO RETRIEVE 3TJ= LDN 0 1 3W3W ADS 0 INCRV(2) [UPDATE COUNT OF FILES TO BE RETRIEVE 3WHG MHUNTW 3,FILE,FABSNB 3X36 #SKI K6INCPROC 3XGQ ( 3Y2B LDX 0 A1(3) 3YG2 SBN 0 10 3Y^L BZE 0 TEN 3^F= XFAB GEOERR BRIEFPM,INCFABSN [FABSNB NOT 10 WORDS LONG OR NON-FABS 3^YW TEN 42DG ) 42Y6 STO 4 A1(3) [REMEMBER INCR NO. WHEN FILE LAST DUM 43CQ [ (ILLEGAL USE OF FABSNB REC. HEADER 43XB [ BUT NOT WORTH KEEPING ANOTHER BLO 44C2 MHUNTW 2,FILE,FINCPROC 44WL BZE 5 YCHAIN [J IF 1ST FILE TO RETRIEVE 45B= NXFAB 45TW LDX 2 FPTR(2) [X2-> NEXT FABSNB 46*G #SKI K6INCPROC 46T6 ( 47#Q LDX 0 ATYPE(2) 47SB SRL 0 12 48#2 SBN 0 FILE+FABSNB 48RL BNZ 0 XFAB [GEOERR IF NON-FABSNB FOUND 49?= ) 49QW BXL 4 A1(2),YCHBEF [NEED TO CHAIN BEFORE THIS FABSNB 4==G BCT 5 NXFAB [J IF MORE FABSNB TO LOOK AT 4=Q6 YCHAIN 4?9Q CHAIN 3,2 [CHAIN FABSNB (FABSNBS KEPT IN ASCEND 4?PB [ INCR NO. ORDER AFTER FINCPROC BLOCK 4#92 TEND 4#NL UP 4*8= YCHBEF 4*MW LDX 2 BPTR(2) [X2-> BLOCK TO WHICH TO CHAIN NEW FAB 4B7G BRN YCHAIN 4BM6 # 4C6Q # 4FJW TOUT 4G4G MFREEW FILE,FABSNB 4GJ6 BRN TEND 4H3Q # 4HHB MENDAREA 30,K99INCPROC 4J32 # 4JGL #END ^^^^ ...76310226000300000000