WLF862
(George Source)
Macros used: ALTLENGD, AND, BACKSPACE, BC, BSXD, CLOSETOP, DELETE, DO, ELSE, FI, FREECORE, GETSOUT, HUNT2, IF, LFRECNUM, MFREE, MHUNTW, NAME, OPENDIR, OR, READAGAIN, REPEAT, REWIND, SEGENTRY, SKIP, STEP, STEPAGAIN, STEPWRITE, THAW, THAWWF, THEN, UP, WHILE
- WLF862.txt
22FL #OPT K0WLF = 0 22^= #LIS K0WLF 23DW #SEG WLF 23YG 8HWLF 24D6 [ 24XQ SEGENTRY K1WLF,WLFK1 [ STOPLIST END OF :SYSTEM.OUTPUT ACTION 25CB SEGENTRY K2WLF,WLFK2 [ LF SCHEDULER DELETE ENTRY 25X2 [ 26BL [ 26W= [************************************************************ 27*W [ 27TG [ PRESET DATA 28*6 [ 28SQ [************************************************************ 29#B [ 29S2 [ 2=?L #DEF WGOUTKEY1 = GOUTKEY1 - A1 2=R= #DEF WGOUTKEY2 = GOUTKEY2 - A1 2?=W #DEF WGMODE = GMODE - A1 2?QG WORKFILE 12HWORKFILE 2#=6 [ 2#PQ [ 2*9B [************************************************************ 2*P2 [ 2B8L SFILECOMP 2BN= [ 2C7W [************************************************************ 2CMG [ 2D76 [ SUBROUTINE TO COMPARE A FABSNB WITH A FILE RECORD. 2DLQ [ FGN ONLY CHECKED IF SET IN FABSNB 2F6B [ 2FL2 [ LINK X6 MUST BE PRESERVED THROUGHOUT 2G5L [ 2GK= [ ENVIRONMENT REQUIRED:- 2H4W [ X2 -> 10 WD FABSNB 2HJG [ X3 -> FILE RECORD = FABSNB ANY LENGTH BUT ONLY ONE LOCAL NAME 2J46 [ 2JHQ [ ENVIRONMENT CHANGES:- 2K3B [ X2, X3, X5 DESTROYED 2KH2 [ X0 = 0 IF MATCHED, 1 IF DIDN'T 2L2L [ 2L#H ... LDX 4 0(3) 2LLD ... SBN 4 10 2LY* ... ADX 3 4 [ POINT TO LAST 10 WORDS 2M=? ... IF EITHER,+A1+8(2),ZE [ IF GEN. NO. NOT TO BE CHECKED 2MMG ... OR +A1+8(2),E,8(3) [ GENERATION NO. MATCHES 2N4P ... AND +A1+9(2),E,9(3) [ LANGUAGE CODE MATCHES 2NFY ... LDN 5 3 2NX7 ... WHILE +A1+4(2),E,4(3) [ NAMES MATCH 2P#B ... DO 2PPK ... ADN 2 1 2Q6S ... ADN 3 1 2QJ3 ... REPEAT CT 5 2Q^= ... AND 5,ZE [ FILENAME MATCH 2R2= ... SBN 3 3 2R3= ... IF 4,NZ [ LONG FILE/FABSNB 2R4= ... THEN 2R5= ... SBN 3 2 [ TWO EXTRA WORDS ON ADDTIONAL USERNAMES 2R6= ... FI 2R7= ... LDN 5 3 2R8= ... WHILE +A1+1-3(2),E,1(3) [ NAMES MATCH 2R9= ... DO 2R== ... ADN 2 1 2R?= ... ADN 3 1 2R#= ... REPEAT CT 5 2R*= ... AND 5,ZE [ USERNAME MATCH 2RBG THEN 2RW6 LDN 0 0 2S*Q ELSE 2STB LDN 0 1 2T*2 FI 2TSL EXIT 6 0 2W#= [ 2WRW [************************************************************ 2X?G [ 2XR6 STEPWRITE 2Y=Q [ 2YQB [************************************************************ 2^=2 [ 2^PL [ 329= [ ENSURE ALTERED RECORD IN :SYSTEM.OUTPUT IS WRITTEN AWAY 32NW [ 338G [ X3 -> ALTERED RECORD 33N6 [ ACCS X0,X2 USED - LINK X5 347Q [ 34MB STEPWRITE 3572 EXIT 5 0 35LL [ 366= [ 36KW [************************************************************ 375G [ 37K6 STHAW 384Q [ 38JB [************************************************************ 3942 [ 39HL [ 3=3= [ THAW FILE IN BLOCK <- X2 3=GW [ 3?2G [ LINK X6 3?G6 [ 3?^Q SBX 6 FX1 3#FB NAME 2,FILE,FABSNB 3#^2 LDX 1 FX1 3*DL IF +A1+1(2),E,WORKFILE(1) [ USERNAME IS WORKFILE 3*Y= AND +A1+2(2),E,WORKFILE+1(1) 3BCW AND +A1+3(2),E,WORKFILE+2(1) 3BXG THEN 3CC6 THAWWF STHAW1 [ J IF NO FILE/FCB FOR WORKFILE 3CWQ ELSE 3DBB STHAW1 3DW2 OPENDIR (GEOERR),GENERAL,ERASING 3F*L STHAW2 3FT= THAW STHAW2 3G#W CLOSETOP 3GSG MFREE FILE,ENT 3H#6 FI 3HRQ MFREE FILE,FABSNB 3J?B ADX 6 FX1 3JR2 EXIT 6 0 3JRC ...[ 3JRS ...[ 3JS9 ...[************************************************************ 3JSL ...[ 3JT3 ...SHORTFABS 3JTD ...[ 3JTT ...[************************************************************ 3JW= ...[ 3JWM ...[ 3JX4 ...[ CHECKS THAT THE FIRST FILE/FRB, WHICH IS IN FABSNB 3JXF ...[ FORMAT, IS A TEN-WORD ONE. IF NOT, IT IS SHORTENED ON 3JXW ...[ THE ASSUMPTION THAT ALL FABSNBS IN :SYSTEM.OUTPUT HAVE 3JY? ...[ USERNAME, LOCALNAME AS THEIR LAST TWO ELEMENTS. 3JYN ...[ 3J^5 ...[ LINK X4 3J^G ...[ X0,1,3 CORRUPTED 3J^X ...[ 3K2# ... SBX 4 FX1 3K2P ... MHUNTW 3,FILE,FRB 3K36 ... LDEX 0 HDREC(3) 3K3H ... SBN 0 10 3K3Y ... IF 0,NZ 3K4* ... THEN 3K4Q ... LDN 0 HDREC(3) 3K57 ... ADX 0 HDREC(3) 3K5J ... SBN 0 11 [X0 -> PENULTIMATE ELEMENT 3K5^ ... LDN 1 HDREC+1(3) 3K6B ... MOVE 0 3 [MOVE UP USERNAME 3K6R ... ADN 0 5 3K78 ... ADN 1 3 3K7K ... MOVE 0 6 [MOVE UP LOCALNAME 3K82 ... LDN 0 10 3K8C ... DEX 0 HDREC(3) 3K8S ... ALTLENGD 3,10 [SHORTEN BLOCK 3K99 ... FI 3K9L ... ADX 4 FX1 3K=3 ... EXIT 4 0 3K=L [ 3KQ= [ 3L9W [************************************************************ 3LPG [ 3M96 SEARCH 3MNQ [ 3N8B [************************************************************ 3NN2 [ 3P7L [ 3PM= [ 3Q6W [ SEARCH FOR ENTRY WHICH IS PART OF SAME 3QLG [ MULTIFILE LISTING AS CURRENT ENTRY 3R66 [ AND MAKE IT THE LAST ELEMENT 3RKQ [ THAWING MAIN AND( IF NOT MATCH FOUND ) SETUP FILES 3S5B [ 3SK2 [ LINK X7 - ALSO USED BY LISTFILE SCHEDULER VIA ENTRY POINT 4 3SM9 ...[ ON ENTRY, LAST RECORD READ MUST BE AN INFO RECORD 3SPD ...[ AWORK1 WILL HOLD NUMBER OF RECORDS IN ENTRY 3SRM ...[ AWORK2 WILL HOLD NUMBER OF RECORDS FROM CURRENT TO NEXT HEADER 3STW ...[ AWORK3 WILL HOLD FGN OF MAIN FILE 3SY5 ...[ AWORK4 WILL HOLD MAIN KEYS 3T2# ...[ MAIN FILE FABSNB IS LEFT IN A FILE-FRB ON EXIT 3T4L [ 3TJ= SBX 7 FX1 3W3W STEPAGAIN 3WHG ... BSXD 5,BLFRPROPREC 3X36 ... ANDX 5 WGMODE(3) [ X5 NONZERO IF PROPERTY RECORD 3XGQ LDX 0 WGOUTKEY1(3) 3Y2B STO 0 AWORK4(2) [ SAVE MAIN KEY 3YG2 LFRECNUM 1,WGMODE(3) 3Y^L SBN 1 1 3^F= SKIP ,0(1) [ TO SETUP FILE RECORD 3^YW READAGAIN [ SETUP FILE DES. 428N ... CALL 4 SHORTFABS [ ENSURE IT IS A TEN-WD FABSNB 42DG DELETE 42Y6 READAGAIN [ MAIN FILE DES. 437Y ... CALL 4 SHORTFABS [ ENSURE IT IS TEN-WD TOO 43CQ MHUNTW 1,FILE,FRB 43XB LDX 0 A1+8(1) 44C2 STO 0 AWORK3(2) [ SAVE GENERATION FOR THAW 44WL STOZ A1+8(1) [ CLEAR GENERATION NO. FOR COMPARISON 45B= DELETE 45TW IF 5,NZ [ PROPERTY RECORD 46*G THEN 46T6 DELETE 47#Q FI 47SB DELETE 48#2 REWIND 48RL STEP 49?= LDN 6 #40 [ URGENCY A-1 49QW WHILE 6,NZ [ NOT FOUND ANOTHER ELEMENT OF MULTIFILE 4==G AND 3,NZ [ NOT END OF FILE 4=Q6 ADN 6 1 [ INCREMENT URGENCY 4?9Q LDN 0 #73 4?PB AND 6,L,0 [ URGENCY A -> Z 4#NL DCH 6 AWORK4(2) [ NEW MAIN KEY 4*8= LDN 5 0 [ SUB KEY 4*MW GETSOUT ,AWORK4(2),5 [ FIND ENTRY FROM SAME JOB 4*XN ... STEPAGAIN 4B7G ... AND 3,NZ 4BC# ... DO 4BM6 LDCH 0 WGOUTKEY1(3) 4C6Q IF 0,E,6 [ SAME URGENCY FOUND 4CLB THEN 4D62 WHILE 3,NZ [ NOT END OF FILE 4DKL AND +WGOUTKEY1(3),E,AWORK4(2) [ ENTRY FOR SAME JOB 4GJ6 ... LFRECNUM 6,WGMODE(3) 4H3Q ... STO 6 AWORK1(2) [ RECORDS IN THIS ENTRY 4K#L ... STO 6 AWORK2(2) [ RECORDS TILL NEXT ENTRY 4K*4 ... IF BS,3,BLFRMULTI [ MULTIFILE ELEMENT 4K*G ... AND BS,3,BLFRNLASTEL [ NOT LAST ELEMENT 4K*Y ... AND BS,3,BLFRSETUP [ SETUP FILE 4KBB ... IF BS,3,BLFRPROPREC [ PROPERTY RECORD 4KBS ... THEN 4KC= ... LDN 0 1 4KCN ... SBS 0 AWORK2(2) 4KD6 ... STEP [ OVER IT 4KDJ ... FI 4KF2 ... LDN 0 1 4KFD ... SBS 0 AWORK2(2) 4KFW STEP [ OVER MAIN RECORD 4K^G MHUNTW 2,FILE,FRB [ MAIN FILE DES. FOR LAST EL. 4LF6 CALL 6 SFILECOMP 4LYQ AND 0,ZE [ SAME AS MAIN FILE IN ENTRY 4MDB STEP 4MKJ ... LDN 0 1 4MQQ ... SBS 0 AWORK2(2) 4MY2 MHUNTW 2,FILE,FRB 4NCL HUNT2 2,FILE,FRB,2 [ SETUP FILE DES. FOR LAST EL. 4NX= CALL 6 SFILECOMP 4PBW AND 0,ZE [ SAME AS SETUP FILE IN ENTRY 4PWG THEN 4QB6 LDN 6 0 [ FOUND 4QTQ ELSE 4R*B LDX 2 FX2 4RT2 LDCH 6 AWORK4(2) [ RESET URGENCY - NOT FOUND 4S#L FI 4SS= AND 6,NZ [ NOT ANOTHER ELEMENT OF MULTIFILE 4T?W DO 4THN ... LDX 1 AWORK2(2) 4TRG ... IF 1,NZ 4W3# ... THEN 4W?6 ... SKIP ,0(1) [ ENTRY 4WGY ... FI 4WQQ REPEAT 4X=B ELSE 4XQ2 SBN 0 1 4Y9L LDX 6 0 [ MAKE URGENCY FOUND NEXT ONE SCANNED 4YP= FI 4^8W REPEAT 4^NG IF 6,ZE [ ANOTHER ELEMENT OF SAME MULTIFILE FOUND 5286 ... THEN [ WE HAVE JUST READ SETUP LINE OF ENTRY 52MQ LDX 2 FX2 537B ... LDX 6 AWORK1(2) 53M2 SBN 6 1 546L DO 54L= BACKSPACE [ TO MAIN RECORD 555W REPEAT CT 6 55KG STEPAGAIN 5656 BC 3,BLFRNLASTEL [ SET AS LAST ELEMENT 56JQ CALL 5 STEPWRITE [ WRITE BLOCK AWAY 574B MHUNTW 2,FILE,FRB 57J2 HUNT2 2,FILE,FRB 583L FREECORE 2 [ DO NOT THAW SETUP FILE 58H= ELSE 592W MHUNTW 2,FILE,FRB 59GG HUNT2 2,FILE,FRB 5=26 CALL 6 STHAW [ THAW SETUP FILE 5=FQ FI 5=^B ADX 7 FX1 5?F2 EXIT 7 0 5?YL [ 5#D= [ 5#XW ...[ WW WW W 5*CG [ WW WW WW 5*X6 [ WW WW WWW 5BBQ [ WWWW WW 5BWB [ WWWWW WW 5CB2 [ WW WW WW 5CTL [ WW WW WW 5D*= [ WW WW WW 5DSW [ 5F#G [ 5FS6 WLFK1 5G?Q [ 5GRB [ 5H?2 [************************************************************ 5HQL [ 5J== [ STOPLIST END OF :SYSTEM.OUTPUT ACTION 5JPW [ 5K9G [************************************************************ 5KP6 [ 5L8Q [ 5LNB WHILE TRUE 5M82 MHUNTW 1,FILE,FTAB 5MML AND +FTREAD(1),L,FTAPP(1) [ MORE TABS 5N7= DO 5NLW LDN 0 2 [ TAB TO LAST ELEMENT OF MULTIFILE ENTRY 5P6G ADS 0 FTREAD(1) 5PL6 ADX 1 FTREAD(1) 5Q5Q GETSOUT ,A1(1),A1+1(1) 5QKB CALL 7 SEARCH 5R52 MHUNTW 2,FILE,FRB 5RJL SMO FX2 5S4= LDX 0 AWORK3 5SHW STO 0 A1+8(2) [ RESET GENERATION 5T3G CALL 6 STHAW [ THAW MAIN FILE 5TH6 REPEAT 5W2Q UP 5WGB [ 5X22 [ 5XFL [ WW WW WWWWW 5X^= [ WW WW WW WW 5YDW [ WW WW WW 5YYG [ WWWW WW 5^D6 [ WWWWW WWWWW 5^XQ [ WW WW WW 62CB [ WW WW WW 62X2 [ WW WW WWWWWWWW 63BL [ 63W= [ 64*W WLFK2 64TG [ 65*6 [ 65SQ [************************************************************ 66#B [ 66S2 [ LF SCHEDULER DELETING ENTRY FROM :SYSTEM.OUTPUT 67?L [ 67R= [************************************************************ 68=W [ 68QG [ 69=6 STEPAGAIN 69PQ IF MBAS,3,BLFRMULTI,BLFRSETUP [ MULTIFILE AND SETUP FILE 6=9B AND BC,3,BLFRNLASTEL [ LAST ELEMENT OF MULTIFILE 6=P2 THEN 6?8L CALL 7 SEARCH 6?N= MFREE FILE,FRB 6#7W ELSE 6#MG LFRECNUM 7,GMODE-A1(3) 6*76 LDX 1 7 6*LQ SBN 1 1 6*T2 ... IF 1,NZ [ MORE THAN ONE RECORD IN ENTRY 6B3= ... THEN [ SKIP SO DELETE IN REVERSE ORDER 6B9G ... SKIP ,0(1) 6BCQ ... FI 6BL2 DO [ DELETE ENTRY 6C5L DELETE 6CK= REPEAT CT 7 6D4W FI 6DJG UP 6F46 [ 6FHQ #END ^^^^ ...652614430006