{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: WLF862)}}
====== WLF862 ======
(George Source)
**Macros used:** [[george:macro:ALTLENGD|ALTLENGD]], [[george:macro:AND|AND]], [[george:macro:BACKSPACE|BACKSPACE]], [[george:macro:BC|BC]], [[george:macro:BSXD|BSXD]], [[george:macro:CLOSETOP|CLOSETOP]], [[george:macro:DELETE|DELETE]], [[george:macro:DO|DO]], [[george:macro:ELSE|ELSE]], [[george:macro:FI|FI]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GETSOUT|GETSOUT]], [[george:macro:HUNT2|HUNT2]], [[george:macro:IF|IF]], [[george:macro:LFRECNUM|LFRECNUM]], [[george:macro:MFREE|MFREE]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAME|NAME]], [[george:macro:OPENDIR|OPENDIR]], [[george:macro:OR|OR]], [[george:macro:READAGAIN|READAGAIN]], [[george:macro:REPEAT|REPEAT]], [[george:macro:REWIND|REWIND]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SKIP|SKIP]], [[george:macro:STEP|STEP]], [[george:macro:STEPAGAIN|STEPAGAIN]], [[george:macro:STEPWRITE|STEPWRITE]], [[george:macro:THAW|THAW]], [[george:macro:THAWWF|THAWWF]], [[george:macro:THEN|THEN]], [[george:macro:UP|UP]], [[george:macro:WHILE|WHILE]]
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