{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: READFALE866)}}
====== READFALE866 ======
(George Source)
**Macros used:** [[george:macro:ASSMESS|ASSMESS]], [[george:macro:BFCBX|BFCBX]], [[george:macro:BS|BS]], [[george:macro:BSON|BSON]], [[george:macro:BXE|BXE]], [[george:macro:BXL|BXL]], [[george:macro:BXU|BXU]], [[george:macro:CHAIN|CHAIN]], [[george:macro:COOR3|COOR3]], [[george:macro:DATUMBLK|DATUMBLK]], [[george:macro:DOWN|DOWN]], [[george:macro:FCAJO|FCAJO]], [[george:macro:FFCA|FFCA]], [[george:macro:FINDJOBQ|FINDJOBQ]], [[george:macro:FSHCODE|FSHCODE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:HUNT2J|HUNT2J]], [[george:macro:HUNTW|HUNTW]], [[george:macro:INFORM|INFORM]], [[george:macro:JBC|JBC]], [[george:macro:JBS|JBS]], [[george:macro:JMBC|JMBC]], [[george:macro:JOBLOCK|JOBLOCK]], [[george:macro:LFBITSET|LFBITSET]], [[george:macro:LFNTOGEOG|LFNTOGEOG]], [[george:macro:LGEOG|LGEOG]], [[george:macro:MAPBCH|MAPBCH]], [[george:macro:MFREE|MFREE]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MONOUT|MONOUT]], [[george:macro:NAMETOP|NAMETOP]], [[george:macro:OUTBLOCN|OUTBLOCN]], [[george:macro:OUTPACK|OUTPACK]], [[george:macro:PSTAC|PSTAC]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:TRACEIF|TRACEIF]], [[george:macro:TRANSBEG|TRANSBEG]], [[george:macro:UP|UP]], [[george:macro:VFREE|VFREE]]
22FL SEG READFALE,866
22^= #
23DW SEGENTRY K1READFALE,Z1READFALE
23YG SEGENTRY K2READFALE,Z2READFALE
24D6 #
24XQ # THIS SEGMENT IS ENTERED ACROSS FROM READFAIL TO COMPLETE
25CB # THE HANDLING OF CORRUPT FILES
25X2 # AWORK1 INDICATES ENTRY POINT TO READFAIL
26BL [ B0 SET TRANFAIL CASE
26W= [ B1 SET CHAPTER FILE
27*W [ B2 SET NON-AUTONOMOUS TRANSFER
27TG [ B3 SET BMAP ENTRY
28*6 [ B4 SET GEOERR ENTRY POINT (5)
28SQ [ B16 SET SWAP FILE FAIL
29#B [ AWORK2 IS RESIDENCE NUMBER FROM PARAMETER
29S2 [ IF CHAPTER FAIL THEN = 1 IF SCF, = 0 OTHERWISE.
2=?L [ AWORK3 IS BLOCK NUMBER FROM PARAMATER
2=R= [ AWORK4 HAS BITS SET INDICATING VARIOUS THINGS
2?=W [ BIT 0 SET FILE IS VITAL SYSTEM FILE
2?QG [ BI T 1 SET LISTFILE ACTIVITY
2#=6 [ BIT 2 SET CONTENTS OF BLOCK ALREADY OUTPUT
2#PQ [ BIT 23 SET 2ND HALF OF BLOCK OUTPUT
2*9B [ X7 CONTAINS DEPTH OF FILE , X6 IS SUBROUTINE LINK
2*P2 [ X2->CURENT ACTIVITY X3->ACTIVITY ISSUING TRANFAIL
2B8L [
2BN= XMASK #00077777
2C7W XGEN #60000000 [ACTIVITY BLOCK TYPE
2CMG XFRB #44600000
2D76 XFAILED +4
2DLQ 4HHAS
2F6B 4HFAIL
2FL2 4HED
2G5L XCORRUPT +4
2GK= 4HIS C
2H4W 4HORRU
2HJG 4HPT
2J46 XASWAP +ASWAPFILE
2JHQ XFWBGOUT
2K3B HUNT2J 2,GOUT,INFO,3,MHUNT
2KH2 LDX 3 2
2L2L BRN MM
2LG= MHUNT
2L^W HUNT2J 3,GOUT,GUPDATE,3,MN
2MFG MM
2M^6 EXIT 6 0
2NDQ MN
2NYB [
2PD2 [ ****
2PXL [ CANT FIND CORRECT GOUT/GUPDATE BLOCK
2QC= [ ****
2QWW [
2RBG GEOERR 1,REMOTE
2RW6 XSUBMESS
2S*Q SBX 6 FX1
2STB REHUNT
2T*2 MHUNT 2,GMON,AOUT
2TSL LDX 3 A1(2)
2W#= ADN 3 3
2WRW SRL 3 2
2X?G OUTPACK A1+2(2),0(3),VARCHAR,REHUNT [OUTPACK SUBMESS
2XR6 ADX 6 FX1
2Y=Q EXIT 6 0
2YQB [ THIS OUTPUTS THE CORRUPT BLOCK IN TWO PARTS TO SYSTEM JOURNAL
2^=2 SJBLOCK1
2^PL LDCT 0 #100
329= ANDX 0 AWORK4(2)
32NW BNZ 0 SEXIT [J IF BLOCK ALREADY OUTPUT
338G SJBLOCK
33N6 LDCT 0 #100
347Q ORS 0 AWORK4(2) [INDICATE BLOCK OUTPUT
34MB LDN 3 1
3572 SBX 4 FX1
35LL TRACEIF K6READFAIL,199,999,4,SJBLOCK
366= XOUTPAC
36KW CALL 6 XMESS [ OUTPUT BLK AND RES NO (X5->FDA)
375G CALL 6 XOUT [OUTPACK PART NUMBER
37K6 CALL 6 XGETBREAD [ X3-> BSTB/BREAD BLOCK
384Q LDX 1 5 [ -> FDA (SET UP BY XMESS ROUTINE)
38JB LDX 5 ALOGLEN(3) [ BLOCK SIZE
3942 TRACEIF K6READFAIL,199,999,1,FDA PTR
39HL TRACEIF K6READFAIL,199,999,5,BLK SIZE
3=3= DATUMBLK AWORK3(2),1,5 [ CALCULATE HARDWARE ADDR
3=GW LDX 3 1
3?2G TRACEIF K6READFAIL,199,999,3,HARD ADD
3?G6 OUTPACK 3,1,OCTB [ HARDWARE ADDRESS
3?^Q TRACEIF K6READFAIL,199,999,5,BLK SIZE
3#FB OUTPACK 5,1,NUMC [ BLOCK SIZE
3#^2 [
3*DL TRYAGAIN
3*Y= CALL 6 XGETBREAD [ X3-> BSTB/BREAD BLOCK
3BCW LDN 0 1
3BXG ANDX 0 AWORK4(2)
3CC6 BZE 0 PTRFIRST [J IF NOT OUTPUT FIRST HALF
3CWQ ADN 3 256
3DBB PTRFIRST
3DW2 ADN 3 A1 [X2->1ST HALF OF BLK
3F*L OUTPACK 0(3),256,VAROCT,TRYAGAIN [OUTPACK HALF OF BLOCK
3FT= MONOUT BLOKRUPT,,NONAUT,IGOPTRACE
3G#W LDN 0 1
3GSG ANDX 0 AWORK4(2)
3H#6 BNZ 0 SEXIT2 [J IF BOTH HALVES OUTPUT
3HRQ LDN 0 1
3J?B ORS 0 AWORK4(2) [INDICATE 2ND HALF BEING OUTPUT
3JR2 LDN 3 2
3K=L BRN XOUTPAC [RETURN FOR MESSAGE OUTPUT
3KQ= SEXIT2
3L9W ADX 4 FX1
3LPG SEXIT
3M96 EXIT 4 0
3MNQ [ THIS ROUTINE SETS UP FIRST PART OF MESSAGE TO OPS CONSOLE AND SYSTEM J
3N8B [ WE OUTPACK 4 OF THE PARAMS HERE :-
3NN2 [ BLOCK NUMBER, RESIDENCE NUMBER, UNIT NUMBER AND CSN.
3P7L [ EXITING WITH A POINTER TO THE FILE DESCRIPTION ARE
3PM= [ IN THE FDTABLE IN X5 FOR THE
3Q6W [ SJBLOCK ROUTINE.
3QLG XMESS
3R66 SBX 6 FX1
3RKQ TRACEIF K6READFAIL,199,999,6,XMESS
3S5B
3SK2 OUTBLOCN 27 [ 27 WORD GMON.ASET
3T4L OUTPACK AWORK3(2),1,OCTA [PACK BLK NO PARAM
3TJ= OUTPACK AWORK2(2),1,NUMA [PACK RES NO PARAM
3W3W LDCT 0 #200
3WHG ANDX 0 AWORK1(2)
3X36 BZE 0 PLFN
3XGQ STO 6 GEN0
3Y2B CALL 6 PICUPACT
3YG2 LDX 6 GEN0
3Y^L LDX 2 ACOMMUNE8(3)
3^F= LGEOG ,2
3^YW BRN PLFN1
42DG PLFN
42Y6 LFNTOGEOG 2,AWORK2(2)
43CQ PLFN1
43XB OUTPACK 2,1,GEOPER [ UNIT NUMBER PARAM
44C2 LDCT 0 #200
44WL ANDX 0 AWORK1(2)
45B= BZE 0 XNOTCH [ NOT CHAPTER FAIL
45TW LDX 1 BINDEX [ CCTABLE POINTER
46*G LDX 0 AWORK2(2) [ 1 IF SCF
46T6 BZE 0 XCCTP [ NOT SCF
47#Q [ STEP OVER FIRST FDA
47SB LDCH 0 A1(1)
48#2 SBN 0 #32 [ EDS 60/30
48RL BZE 0 XXEDS
49?= LDCH 0 A1(1)
49QW SBN 0 #6 [ EDS 8
4==G BZE 0 XXEDS
4=Q6 ADN 1 3 [ H/S DRUM
4?9Q BRN XCCTP
4?PB XXEDS
4#92 ADN 1 6
4#NL BRN XCCTP
4*8=
4*MW XNOTCH
4B7G [ TO GET TO CSN FROM RESIDENCE NUMBER ( THERE SHOULD BE A MACRO TO DO TH
4BM6
4C6Q LDX 1 AWORK2(2)
4CLB SLL 1 1
4D62 ADX 1 ALFTP [ BSTB.ALFTABLE POINTER
4DKL LDX 1 A1(1)
4F5= ANDN 1 #7777
4FJW ADX 1 AFDTP [ BSTB.FDTABLE POINTER
4G4G XCCTP
4GJ6 LDX 5 1 [ PTR TO FDTABLE FOR SJBLOCK ROUTINE
4H3Q LDCH 0 A1(1) [ TYPE OF DEVICE
4HHB SBN 0 #32 [ EDS 30 OR EDS 60
4J32
4JGL BZE 0 XEDS [ J IF EDS DEVICE
4K2= LDCH 0 A1(1)
4KFW SBN 0 #6 [ EDS 8
4K^G BZE 0 XEDS [ EDS DEVICE
4LF6 [ NON EDS DEVICE
4LYQ [ DEFAULT TO ZERO CSN
4MDB LDN 2 0
4MY2 BRN XHSDRUM
4NCL XEDS
4NX= LDX 2 A1+5(1) [ CSN
4PBW [ X1 CONTAINS THE CSN
4PWG XHSDRUM
4QB6 OUTPACK 2,1,CSN [ CSN OF DISC
4QTQ LDCT 0 #100
4R*B ANDX 0 AWORK4(2)
4RT2 BNZ 0 SEXIT1 [J IF ENTERED FOR SJBLOCK
4S#L BRN XOUTPACK3
4SS= XOUTPACK2
4T?W SBX 6 FX1
4TRG XOUTPACK3
4W?6 LDX 0 AWORK1(2)
4WQQ BNZ 0 XFAIL [J IF TRANFAIL ACT
4X=B LDN 3 XCORRUPT(1)
4XQ2 BRN XOUTPACK1
4Y9L XFAIL
4YP= LDN 3 XFAILED(1)
4^8W BRN XOUTPACK1
4^NG XOUTPACK
5286 SBX 6 FX1 [2ND ENTRY TO SUBROUTINE
52MQ XOUTPACK1
537B OUTPACK 0(3),V,VARCHAR [PACK "HAS FAILED","IS CORRUPT "PARAM
53M2 [ OR FILENAME FOR SUBMESSAGE.
546L SEXIT1
54L= ADX 6 FX1
555W EXIT 6 0
55KG XOUT
5656 SBX 6 FX1
56JQ OUTPACK 3,1,NUMB [RELATIVE BLOCK NO IN FILE
574B ADX 6 FX1
57J2 EXIT 6 0
583L
58H= [ THIS ROUTINE GETS X3->CURRENT ACTIVITY OR THE ACTIVITY ISSUING THE TR
592W [ IN THE TRANFAIL CASE
59GG [ X6 = LINK
5=26 PICUPACT
5=FQ LDX 2 FX2
5=^B LDXC 0 AWORK1(2)
5?F2 BCC X3FX2 [J IF NOT TRANFAIL ENTRY
5?YL LDCT 0 #040
5#D= ANDX 0 AWORK1(2)
5#XW BNZ 0 X3FX2 [ BMAP TRANFAIL
5*CG LDX 3 BSCHANAD(2) [X2->Q BLOCK
5*X6 SBN 3 CHAINADD
5BBQ LDX 0 ATYPE(3)
5BWB SBX 0 BSP10
5CB2 BNZ 0 X [ NOT A BSTB/BQBLK
5CTL OUTINF
5D*= LDX 3 BPTR(3) [X2->ACTIVITY
5DSW LDX 0 ATYPE(3)
5F#G TXL 0 CACT
5FS6 BCS OUTINF
5G?Q X
5GRB EXIT 6 0
5H?2 X3FX2
5HQL LDX 3 FX2
5J== EXIT 6 0
5JPW [ THIS ROUTINE GETS A POINTER IN X3
5K9G [ TO THE CORRECT BSTB/BREAD BLOCK.
5KP6 [ X6 = LINK.
5L8Q XGETBREAD
5LNB STO 6 GEN0 [ STORE LINK
5M82 CALL 6 PICUPACT [X3->ACTIVITY ISSUING TRANSFER
5MML NXTBL
5N7= LDX 3 FPTR(3) [X3->NEXT BLOCK IN ACT.CH.
5NLW LDX 0 ATYPE(3)
5P6G BXE 0 BJREAD,XCHRES [J IF BSTB/BREAD
5PL6 BXE 0 XFRB(1),XCHRES
5Q5Q BXL 0 XGEN(1),NXTBL [J IF NOT ACTIVITY BLOCK
5QKB CALL 0 ZGEOERR4 [ NO BREAD
5R52 XCHRES
5RJL LDX 0 BACK1(3)
5S4= BXU 0 AWORK2(2),NXTBL [J IF NOT CORRECT RES NO
5SHW LDX 0 BACK2(3)
5T3G BXU 0 AWORK3(2),NXTBL [J IF NOT CORRECT BLK NO
5TH6 LDX 6 GEN0
5W2Q EXIT 6 0
5WGB [ ROUTINE TO RENAME CORRECT FLOUR BLOCK A BREAD BLOCK.
5X22 [ IF WE CAN'T FIND THE FLOUR BLOCK THEN IT MAY BE BECAUSE WE HAVE DONE
5XFL [ A SETCORE TRANSFER, SO WE DON'T BOTHER TO GEOERR SINCE IF SOMETHING IS
5X^= [ WRONG THEN THE ACCESS ROUTINES WILL GEOERR ANYWAY.
5YDW [ (ONLY CALLED IN THE CASE OF TRANFAILS)
5YYG [ X4 = LINK, GEOERRS IF NO FLOUR BLOCK THERE.
5^D6 RNFLOUR
5^XQ CALL 6 PICUPACT
62CB RNFLOOP
62X2 HUNT2J 3,BSTB,FLOUR,3,RNEXIT [ EXIT IF WE CANT FIND THE BLOCK
63BL LDX 0 BACK2(3)
63W= BXU 0 AWORK3(2), RNFLOOP [ NOT RIGHT BLOCK NO
64*W LDX 0 BACK1(3)
64TG BXU 0 AWORK2(2),RNFLOOP [ NOT RIGHT RESIDENCE NO
65*6 STOZ A1(3) [ ENSURE BLOCK IS VALID !
65SQ NAMETOP 3,BSTB,BREAD
66#B RNEXIT
66S2 EXIT 4 0
67?L [ ROUTINE TO WAIT 2 MINS X6 = LINK
67R= WAIT2M
68=W BSON EMSBIT,WAITXIT [ BACKMAP !
68QG LDN 3 120/FONINTP
69=6 SBX 6 FX1
69PQ Y
6=9B COOR3 #62
6=P2 BCT 3 Y
6?8L ADX 6 FX1
6?N= WAITXIT
6#7W EXIT 6 0
6#MG
6*76 [ THIS ROUTINE IS CALLED BEFORE A GEOERR TO ENSURE THAT
6*LQ [ THE CORRUPT BLOCK IS ON THE FILE CHAIN.
6B6B [ X7 = DEPTH OF CORRUPT FILE, X3-> ACTIVITY
6BL2 [ X4=LINK.
6C5L SYSFGEO
6CK= LDX 1 3
6D4W LDX 2 3
6DJG LDX 3 7 [ DEPTH
6F46 FFCA [ X2-> FCA
6FHQ PSTAC 3,2 [ X3->FSTACK BLK
6G3B LDX 2 FX2
6GH2 SYSFLOOP
6H2L LDX 1 FPTR(1) [ NEXT BLOCK IN ACTIVITY CHAIN
6HG= LDX 0 ATYPE(1)
6H^W TXL 0 CACT [ REACHED NEXT ACTIVITY
6JFG BCC SYSFXIT [ EXIT
6J^6 LDX 0 BACK1(1) [ RES NO
6KDQ BXU 0 AWORK2(2),SYSFLOOP
6KYB LDX 0 BACK2(1) [ BLOCK NO
6LD2 BXU 0 AWORK3(2),SYSFLOOP
6LXL [ X1 NOW POINTS TO CORRECT BSTB/BREAD BLOCK SO WE RENAME IT A
6MC= [ FILE/FURB SO THAT PM PRINTS IT OUT CORRECTLY & RECHAIN IT
6MWW [ ONTO THE FILE CHAIN AT THE CORRECT PLACE.
6NBG NAMETOP 1,FILE,FURB
6NW6 CHAIN 1,3
6P*Q SYSFXIT
6PTB EXIT 4 0
6Q*2 # MAIN ENTRY POINT
6QSL Z1READFALE
6R#= LDXC 0 AWORK4(2)
6RRW BCS XEND [J IF V S F
6S?G CALL 6 PICUPACT [X3->ACTIVITY ISSUING TRANSFER
6SR6 LDCH 0 ATYPE(3)
6T=Q SBN 0 CPAT/64
6TQB BNZ 0 NOCPAT
6W=2 JBS XDUMPER,3,EXDUMPER
6WPL NOCPAT
6X9= LDCH 0 ATYPE(3)
6XNW SBN 0 ACTLF/64
6Y8G BZE 0 XLIST [J IF LISTFILE
6YN6 LDX 6 JOBNO(3)
6^7Q BZE 6 XEND [J IF ZERO JOB NO.
6^MB JOBLOCK 6,1
7272 LDN 0 3
72LL ANDX 0 JPRIV(1)
736= BZE 0 XUSER [J IF NOT SYSTEM ISSUED/STARTED
73KW XEND
745G LDXC 0 AWORK1(2)
74K6 BCS ZTRFAIL
754Q CALL 4 SJBLOCK1 [OUTPUT BLK TO SJ
75JB ZTRFAIL
7642 LDCT 0 #040
76HL ANDX 0 AWORK1(2)
773= BZE 0 ZGEOERR3 [ J - IF NOT BMAP ENTRY TO GEOERR SFC
77GW BRN UP5 [ IN THE CASE OF BMAP JUST GO UP
782G
78G6 ZGEOERR3
78^Q CALL 6 WAIT2M [ WAIT 2MINS
79FB CALL 6 PICUPACT
79^2 CALL 4 SYSFGEO [ CHAIN CORRUPT BLK TO FILE CHAIN
7=DL [
7=Y= [ ****
7?CW [ VITAL SYSTEM FILE (VSF) IS CORRUPT.
7?XG [ A VERY POPULAR GEOERR !
7#C6 [ ****
7#WQ [
7*BB GEOERR 1,SFCORRUP
7*W2 XDUMPER
7B*L TRACEIF K6READFAIL,199,999,3,DUMPFAIL
7BT= BS 3,EXDUMPFAIL [SET CLOSEAB MARK FOR DUMPER
7C#W LDX 0 AWORK1(2)
7CSG BNZ 0 UP [J IF TRANFAIL
7D#6 CALL 4 SJBLOCK
7DRQ BRN UP5
7F?B UP
7FR2 CALL 4 RNFLOUR [ RENAME FLOUR BLOCK
7G=L UP5
7GQ= BRN UP1
7H9W XUSER
7HPG LDX 5 JOBNO(3) [X5=JOB NO
7J96 LDN 0 #200
7JNQ ANDX 0 AWORK1(2)
7K8B BNZ 0 PFRF [J IF SWAP FILE
7KN2 CALL 6 XSUBMESS [ASSEMBLE MESSAGE
7L7L CALL 6 XOUTPACK2 [ASSEMBLE MESSAGE---FAILED/CORRUPT
7LM= BRN USERTOG
7M6W [
7MLG [ ****
7N66 [ CANNOT FIND JOB BLOCK OF JOB NUMBER X6
7NKQ [ ****
7P5B [
7PK2 ZGEOERR6
7Q4L GEOERR 1, NO JOB
7QJ= PFRF
7R3W SMO FX1
7RHG LDX 6 XASWAP
7S36 ASSMESS 6
7SGQ CALL 6 XSUBMESS [ASSEMBLE MESSAGE----PROG FILE READ F
7T2B USERTOG
7TG2 [
7T^L [ OBTAIN A POINTER TO THE JOB'S CPAT TO TEST
7WF= [ WHETHER WE HAVE ALREADY SET THE ABANDON MARKER
7WYW [ IN THIS JOB.
7XDG [
7XY6 LDX 6 5 [ JOB NUMBER
7YCQ TRACEIF K6READFAIL,199,999,6,JOB NO
7YXB FINDJOBQ 3,6,ZGEOERR6 [ X3-> JOB BLK
7^C2 FCAJO 3 [ X3-> CPA BLK
7^WL JBS YFREE,3,BRREADFAIL [ ALREADY BEING ABANDONED
82B= FSHCODE AORB
82TW (
83*G MHUNTW 1,GMON,ASET [PTR TO GMON/ASET BLOCK
83T6 CHAIN 1,2 [CHAIN AFTER CURRENT ACTIVITY
84#Q )
84SB [ JOB NUMBER IN X6 FOR PROCONTX
85#2 DOWN PROCONTX,18 [DOWN TO ABANDON JOB
85RL BRN UPPLUS2
86?= BRN UPPLUS1
86QW BRN UPPLUS2
87=G YFREE
87Q6 MFREE GMON,ASET
889Q ... LDCT 0 #100
88PB ERS 0 CLONG1(2)
8992 UPPLUS2
89NL TRACEIF K6READFAIL,199,999,3,JOBABAND
8=8= LDN 0 #200
8=MW ANDX 0 AWORK1(2)
8?7G BZE 0 XLIST1 [J IF NOT SWAP FILE
8?M6 LDX 3 BSCHANAD(2)
8#6Q SBN 3 CHAINADD
8#LB LDX 1 ATYPE(3)
8*62 SBX 1 BSP10 [ BSTB.BQBLK
8*KL LDN 0 BOBJ+BSET+BPAGE [ OBJECT PROG, SETCORE OR PAGE
8B5= BNZ 1 QBLKBA1
8BJW ANDX 0 ATRAN(3)
8C4G BNZ 0 NOTLOOK
8CJ6 BRN YESLOOK
8D3Q QBLKBA1
8DHB ANDX 0 BA1(3)
8F32 BNZ 0 NOTLOOK
8FGL YESLOOK
8G2= CALL 4 RNFLOUR [ RENAME FLOUR BLOCK
8GFW NOTLOOK
8G^G BRN UP1
8HF6 UPPLUS1
8HYQ COOR3 #62 [JOB NOT ABANDONABLE:WAIT
8JDB BRN USERTOG [AND TRY AGAIN
8JY2 XLIST
8KCL LDCT 0 #200
8KX= ORS 0 AWORK4(2) [SET LISTFILE MARKER
8LBW TRACEIF K6READFAIL,199,999,3,LISTFAIL
8LWG LFBITSET M,3
8MB6 XLIST1
8MTQ CALL 6 PICUPACT
8N*B LDX 2 3 [X2->ACT ISSUING TRANFAIL OR CURRENT
8NT2 LDX 3 7 [X3=DEPTH
8P#L FFCA [X2->FCA
8PS= LDX 4 FREADBLOCK(2)
8Q?W SBN 4 BSPRE [ BLK NO RELATIVE TO BSPRE
8QRG BS 2,BAJABAND [SET UP ABANDON MARKER
8R?6 PSTAC 2,2
8RQQ BFCBX 2,2 [X2->FCB
8S=B FSHCODE B,XFSHBFCB
8SQ2 (
8T9L LDX 6 BACK2(2) [REMEMBER FCB NUMBER OF REQUIRED FCB
8TP= XFSHBFCB
8W8W )
8WNG BS 2,BFCLOSEAB [SET CLOSE ABANDON MARKER
8X86 LDX 3 2 [ -> FCB
8XMQ JMBC NOTCAREF,2,BFCARE [ J-NOT CAREFULLY OPEN FILE
8Y7B FSHCODE B,XFSHBFMAPP
8YM2 (
8^6L # THERE MAY NOT BE A FILE/FMAPP BLOCK IN MACHINE B SO WE MUST FIRST
8^L= # FOR ITS EXISTENCE BEFORE OBEYING THE 'MAPBCH' MACRO, SINCE THIS
925W # WILL LOOP IF THE FILE/FMAPP BLOCK DOES NOT EXIST.
92KG XFMAPP
9356 LDX 2 FPTR(2) [PTR TO NEXT BLOCK ON FILE CHAIN
93JQ BXE 2 CXFI,NOTCAREF [J IF REACHED END-OF-CHAIN
944B LDX 0 ATYPE(2) [TYPE OF BLOCK
94J2 BXE 0 FILEPLUSFCB,NOTCAREF [J IF REACHED NEXT FILE/FCB BLOCK
953L BXU 0 FFSFMAPP,XFMAPP [J IF NOT REQUIRED FILE/FMAPP BLOCK
95H= XFSHBFMAPP
962W )
96GG MAPBCH 4,3 [ CHECKS BIT IN FMAPP BLK
9726 BNZ 0 NOTOFFLINE [ J IF SWAPPED BLOCK
97FQ [
97^B [ IF THE FILE IS OPEN CAREFULLY AND THE CORRUPT OR FAILING
98F2 [ BLOCK IN THE FILE IS A SWAPPED BLOCK THEN WE ONLY
98YL [ CLOSEABANDON THE FILE AND DO NOT THROW IT OFFLINE.
99D= [
99XW NOTCAREF
9=CG BS 3,BFCLOSEABOF [ THROW FILE OFFLINE
9=X6 NOTOFFLINE
9?BQ FSHCODE B,XFSHBTRAN
9?WB (
9#B2 # BITS 'BFCLOSEAB' (AND POSSIBLY 'BFCLOSEABOF') MUST BE SET IN BOTH
9#TL # MACHINES
9**= # BUT WE DON'T NEED TO WAIT FOR THEM SO AUTONOMOUS SUPERVISORY TRANSBEG
9*SW TRANSBEG FSHREADFAIL,RITEFAIL,9,NOBLOCKS,,ACOMMUNE4,,SUP,AUT
9B#G XFSHBTRAN
9BS6 )
9C?Q LDX 2 FX2
9CRB LDXC 0 AWORK1(2)
9D?2 BCS YTRAFAI [J IF TRANFAIL
9DQL CALL 4 SJBLOCK1 [OUTPUT CORRUPT BLOCK
9F== YTRAFAI
9FPW LDCT 0 #200
9G9G ANDX 0 AWORK4(2)
9GP6 BZE 0 PTFSTACK [J IF NOT LISTFILE
9H8Q ERS 0 AWORK4(2)
9HNB OUTBLOCN 23 [ SET UP 23 WORD GMON.ASET
9J82 MHUNTW 3,ADATA,CREADL
9JML ADN 3 CPDATA-1
9K7= OUTPACK 0(3),V,ENTRANT [OUTPACK ENTRANT NAME
9KLW CALL 6 PICUPACT
9L6G CALL 6 XFWBGOUT
9LL6 OUTPACK GUSER(3),3,USERNAME [OUTPACK USER NAME
9M5Q CALL 6 PICUPACT
9MKB CALL 6 XFWBGOUT
9N52 OUTPACK GJOBN(3),3,JOBNAME
9NJL INFORM 2,CORRUPTLF,1,,NONAUT [OUTPUT COTRUPT L F MESSAGE
9P4= PTFSTACK
9PHW CALL 6 PICUPACT
9Q3G LDX 2 3
9QH6 LDX 3 7
9R2Q FFCA [X2->FCA
9RGB PSTAC 1,2 [X1->FSTACK
9S22 BFCBX 3,1
9S9S ... JBC NSER,3,BFSER
9SFL ... NGS 1 FREADWORD(2)
9SPD ...NSER LDX 4 FREADBLOCK(2)
9S^= STO 3 6
9TDW SMO FX1
9TYG LDX 5 XMASK
9WD6 ANDX 5 ARINGNO(1) [X5=NO OF ELEMENTS IN FCA
9WXQ SBN 5 2
9XCB BNG 5 NXPA [J IF ONLY ONE ELEMENT
9XX2 ADN 5 2
9YBL ADN 1 A1 [X1->FIRST ELEMENT
9YW= XCHECAB
9^*W JBS XDECRECT,1,BAJABAND [J IF ALREADY DEALT WITH
9^TG BS 1,BAJABAND [SET ABANDON MARKER
=2*6 LDCT 0 #774
=2SQ ANDX 0 FGENERAL1(1)
=3#B BZE 0 XDECRECT [J IF FILE NOT OPEN
=3S2 JBC NBLOCK,3,BFSER [J IF NOT SERIAL FILE
=4?L BXU 4 FREADBLOCK(1),NBLOCK[J IF THIS ELEMENT NOT READING OUR BL
=4R= NGS 1 FREADWORD(1)
=5=W NBLOCK
=5QG LDX 3 1
=6=6 ROUNDAG
=6PQ LDX 3 FPTRF(3)
=79B SMO FBACKPOINT(3)
=7P2 LDX 0 ATYPE(3)
=88L SMO FX1
=8N= BXL 0 XGEN,ROUNDAG
=97W ADX 3 FBACKPOINT(3)
=9MG BRN NOCPAT
==76 XDECRECT
==LQ ADN 1 FELLEN [X1->NEXT ELEMENT
=?6B BCT 5 XCHECAB [ NEXT FSTACK ELT
=?L2 [
=#5L [ WE HAVE ABANDONED ALL JOBS WITH THIS FILE OPEN
=#K= [
=*4W NXPA
=*JG LDX 2 FX2
=B46 LDX 1 6
=BHQ LDXC 0 AWORK1(2)
=C3B BCS SBREAD [J IF TRANFAIL
=CH2 HUNTW 2,BSTB,BREAD
=D2L BPZ 2 SERIAL [J IF FOUND
=DG= ZGEOERR4
=D^W [
=FFG [ ****
=F^6 [ CANT FIND BSTB/BREAD BLOCK
=GDQ [ ****
=GYB [
=HD2 GEOERR 1,NO BREAD
=HXL SBREAD
=JC= CALL 4 RNFLOUR [ RENAME FLOUR BLK
=JWW SERIAL
=KBG JBC UP1,1,BFSER [J IF FILE NOT SERIAL
=KW6 STOZ A1(2) [ ZEROISE BLOCK
=L*Q NGS 1 CMOD(1) [NEGATE CMOD
=LTB UP1
=M*2 VFREE GMON,AOUT
=MSL VFREE ADATA,CREADL
=N#= #SKI K6READFAIL>999-999
=NRW CALL 6 WAIT2M [ ****** FRIG TO WAIT ******
=P?G UP
=PR6 #
=Q=Q # SECOND ENTRY POINT
=QQB Z2READFALE
=R=2 CALL 6 PICUPACT
=RPL BRN XUSER
=S9= #
=SNW #END
^^^^ ...504247400003