(George Source)
Macros used: CLOSE, FINDPEREC, FMOPG, HUNT2, IDFOPEN, IDFWRITE, MENDAREA, MFREEALL, MHUNTW, MNAME, MXB, OPEN, SEG, SEGENTRY, SETNCORE, SETUPCORE, UP, UPPLUS
22FL SEG IDFONLIN,,JOHN BAILEY 22PD ...# COPYRIGHT INTERNATIONAL COMPUTERS 1982 22^= #OPT K0IDFONLIN=0 23DW #LIS K0IDFONLIN>K0ALLGEO>K0GREATGEO>K0COMMAND>K0IDF 23YG SEGENTRY K1IDFONLIN,XIDF1 24D6 SEGENTRY K2IDFONLIN,XIDF2 24XQ SEGENTRY K3IDFONLIN,XIDF3 254Y ...#UNS AV7900S 25=6 ...XMASK #01040000 [B5 AND B9 25CB OPEN SBX 6 FX1 25X2 ... IDFOPEN XBRK 26BL ADX 6 FX1 26W= EXIT 6 0 2764 ...XBRK UP 27*W RECFIND 27TG LDX 2 FX2 28*6 REC HUNT2 2,FILE,FRRB 28SQ TXU 3 BRECNO+A1(2) 29#B BCS REC 29S2 ADN 2 A1 2=?L EXIT 6 0 2=R= YREC [X3 CONTAINS FORWARD POINTER:X2 POINTS TO CURRENT RECORD 2?=W [ON EXIT X2 IS RECORD POINTER & X3 IS CELL POINTER 2?QG BPZ 3 SAME 2#=6 SBX 6 FX1 2#PQ LDX 0 3 2*9B SRL 0 9 2*P2 ANDN 0 #7777 2B8L LDX 2 FX2 2BN= STO 0 ACOMMUNE3(2) 2C7W MXB 2 2CMG ADX 6 FX1 2D76 SAME ANDN 3 #777 2DLQ EXIT 6 0 2F6B WRITECLOSE 2FL2 SBX 6 FX1 2G5L IDFWRITE 2GK= BRN ZCL 2H4W ZCLOSE 2HJG SBX 6 FX1 2J46 MFREEALL FILE,FRRB 2JHQ ZCL 2K3B CLOSE 2KH2 ADX 6 FX1 2L2L EXIT 6 0 2LG= XIDF2 2L^W LDN 3 BIPB [BASE OF UNIT CHAIN 2MFG BRN UN 2M^6 XIDF1 2NDQ LDN 3 BUNIT [BASE OF UNIT CHAIN 2NYB UN LDX 4 ACOMMUNE2(2) [PICK UP REQUIRED DEVICE TYPE 2PD2 CALL 6 OPEN [OPEN IDF 2PXL BRN UN3 2QC= UN2 CALL 6 YREC 2QWW SMO 2 2RBG LDX 6 BTYPE(3) 2RW6 SRL 6 18 2S*Q TXU 6 4 2STB BCC UN1 2T*2 UN3 SMO 2 2TSL LDX 3 0(3) 2W#= BNZ 3 UN2 2WJ4 ...Z1 2WRW CALL 6 ZCLOSE 2X?G ONE UPPLUS 1 2XB# ...UN1 SMO FX2 2XF6 ... LDX 5 ACOMMUNE1 2XHY ... BNG 5 UN4 2XLQ ... SMO 2 2XPJ ... LDX 6 BTYPE(3) 2XSB ... ANDN 6 #7777 2XX8 ... TXU 5 6 2Y22 ... BCS UN3 2Y4S ...UN4 2Y7L ... LDCT 6 #700 2Y=Q SMO 2 2YQB ANDX 6 BNUMB(3) [MASK OUT MOP/WRONG/ONLINE BITS 2YTL ... BZE 6 UN1A 2YYW ... BNG 5 UN3 2^46 ... BRN Z1 2^7B ...UN1A 2^=P ...#UNS CRAMP 2^?D ...( 2^#7 ...# 2^#W ...# THIS CODE IS NECESSARY AS DURING MOP ON,,NS 2^*K ...# THE MOPPED ON MARKER IS UNSET FOR A TIME WHILE 2^B# ...# THE 'BEING MOPPED ON' MARKER IS LEFT SET 2^C3 ...# 2^CQ ... SMO 2 2^DF ... LDCH 5 BTYPE(3) 2^F8 ... SBN 5 #30 [CHECK IF IPB 2^FX ... BNZ 5 UN5 [J IF NOT TO ONLINE UNIT 2^GL ... SMO 2 2^H* ... LDEX 5 BTYPE(3) [PICK UP GEOGRAPHIC NUMBER 2^J4 ... FMOPG 1,5,IPB [FIND AMOP/IPBIN 2^J6 ...#UNS AV7900S 2^J8 ...( 2^J9 ... SMO FX1 2^J= ... LDX 7 XMASK [CHECK IF 'BEING MOPPED ON' MARKER OR 2^J# ... ['IPB IS A VIRTUAL 7900' MARKER IS 2^JB ...) 2^JD ...#UNS AV7900S 2^JG ...#SKI 2^JR ... LDCT 7 #10 [CHECK IF 'BEING MOPPED ON' MARKER 2^KG ... ANDX 7 IPBSW(1) [SET.IF IT IS,CANNOT 2^KP ... BZE 7 UN5 2^KY ... SMO FX2 2^L7 ... LDX 5 ACOMMUNE1 2^LB ... BNG 5 UN3 2^LK ... BRN Z1 2^LY ...UN5 2^MM ...# 2^NB ...) 2^PL ADX 3 2 [X3 IS ABSOLUTE POINTER TO UNIT CELL 329= LDCT 6 #100 32NW ORS 6 BNUMB(3) [SET ONLINE BIT 338G LDX 6 BTYPE(3) 33N6 ANDN 6 #777 347Q SMO FX2 34MB STO 6 ACOMMUNE1 [STORE GEOG NO OF UNIT ONLINE 3572 CALL 6 WRITECLOSE 35LL FINDPEREC 1,APGEOG,ACOMMUNE1(2) 366= STO 1 ACOMMUNE1(2) 36KW TWO UPPLUS 2 375G XIDF3 37K6 SMO FX2 384Q LDX 3 ACOMMUNE2 38JB CALL 6 OPEN [OPEN IDF 3942 SMO FX2 39HL STOZ ACOMMUNE1 [AS NAME IN CPB/CUNI BLOCK 3=3= MNAME 2,3 3=GW SMO FX2 3?2G LDX 7 ACOMMUNE1 3?G6 BNZ 7 P1 [J.IF NAME OKAY 3?^Q CALL 6 ZCLOSE 3#FB BRN TWO [NAME NOT OKAY 3#^2 P1 SMO 2 3*DL LDX 5 4(3) 3*Y= BPZ 5 P2 [J.IF NOT ALREADY ONLINE 3BCW CALL 6 ZCLOSE 3BXG BRN ONE [ONLINE ALREADY 3CC6 P2 LDX 1 FX2 3CWQ LDCT 6 #400 3DBB SMO 2 3DW2 ORS 6 4(3) [SET ONLINE BIT 3F*L LDX 4 3 [CELL POINTER 3FT= STO 3 AWORK3(1) [CELL POINTER FOR NOT UPDATING 3G#W LDX 3 BRECNO(2) 3GSG STO 3 AWORK4(1) 3H#6 ANDN 5 #7777 [NO OF LINES ON CONCEPTUAL-NEVER ZERO 3HRQ SMO 4 3J?B LDX 0 6(2) 3JR2 BNG 0 P8 [J. IPB. 3K=L SETUPCORE 5,1,IDF,CONCEP 3KQ= P9 3L9W CALL 6 RECFIND [REC NO IN X3 ON ENTRY 3LPG LDX 3 4 [PRESERVED CELL PTR. 3M96 ADX 3 2 3MNQ LDX 3 7(3) [FORWARD PTR. FROM BASE CELL 3N8B CALL 6 YREC 3NN2 ADX 3 2 3P7L LDX 0 0(3) [LD. USER NAME 3PM= BZE 0 XNUSER [J.NO USER NAME 3Q6W SETNCORE 10,1,FILE,FABSNB [SETUP A FILE/FABSNB. 3QLG LDX 3 AWORK4(2) 3R66 CALL 6 RECFIND [HUNT FOR CONCEPTUAL NAME CELL. 3RKQ SMO FX2 3S5B LDX 3 AWORK3 3SK2 STOZ A1+7(1) 3T4L STOZ A1+8(1) 3TJ= STOZ A1+9(1) 3W3W ADX 3 2 3WHG LDN 6 1(3) 3X36 LDN 7 A1+4(1) 3XGQ MOVE 6 3 [MOVE IN CONCEPTUAL NAME. 3Y2B LDX 3 7(3) [LD. USER NAME PTR 3YG2 CALL 6 YREC [HUNT FOR CELL 3Y^L ADX 3 2 3^F= MHUNTW 1,FILE,FABSNB [REHUNT FILE FABSNB. 3^YW LDN 6 0(3) 42DG LDN 7 A1+1(1) 42Y6 MOVE 6 3 [MOVE IN USER NAME. 43CQ LDN 0 10 43XB STO 0 A1(1) [STORE NEW COUNT. 44C2 XNUSER 44WL LDX 3 7(3) [FORWARD PTR. FROM USER NAME CELL. 45B= CALL 6 YREC 45TW LDX 0 BRECNO(2) [LD. REC.NO. 46*G SMO FX2 46T6 STO 0 AWORK1 [PRESERVE REC.NO. 47#Q SMO FX2 47SB STO 3 AWORK2 [CURRENT 48#2 BNG 5 P9A 48RL LDN 7 A1 [LD. PTR. TO POSITION IN BLOCK 49?= P9B LDN 4 0 49QW P7 ADX 3 2 [X3 IS ABSOLUTE POINTER 4==G SMO 4 4=Q6 LDX 3 0(3) [LINE CELL POINTER FROM CONCEP.CELL 4?9Q BNZ 3 P3 [J.IF LINE HAS BEEN ATTACHED TO 4?PB BNG 5 P10 [J. IPB CONCEPTUAL 4#92 [THIS LINE OF CONCEP. 4#NL LDN 6 0 4*8= BRN P4 4*MW P3 CALL 6 YREC [LOCATE LINE CELL 4B7G ADX 3 2 4BM6 LDX 6 BNUMB(3) 4C6Q BNG 6 P5 [J.IF MOPPED ON 4CBJ ...P3A 4CLB LDX 1 FX2 4D62 LDX 3 AWORK4(1) 4DKL CALL 6 RECFIND [TO FIND- 4F5= LDX 3 AWORK3(1) [CONCEPTUAL CELL 4FJW LDCT 6 #400 4G4G SMO 2 4GJ6 ERS 6 4(3) [UNSET CONCEPTUAL ONLINE BIT 4H3Q CALL 6 ZCLOSE 4HHB BRN ONE 4J32 P5 BNG 5 P11 [J. IPB CONCEPTUAL 4JGL LDX 6 BTYPE(3) 4K2= SRC 6 9 [X6 IS B0-B8,UNIT NO:B9-B15,DEV.TYPE 4KFW ORX 6 BNO(3) [ADD IN B18-B23,LINE NO 4K^G P4 MHUNTW 1,IDF,CONCEP 4LF6 SMO 7 4LYQ STO 6 0(1) 4MDB BCT 5 P6 [J.IF MORE LINES 4MY2 P6A CALL 6 WRITECLOSE 4NCL UPPLUS 3 4NX= P6 ADN 7 1 [UPDATE BLOCK POINTER 4PBW LDX 1 FX2 4PWG LDX 3 AWORK1(1) [REC NO OF CONCEP.CELL 4QB6 CALL 6 RECFIND [BACK TO CONCEP.CELL 4QTQ LDX 3 AWORK2(1) 4R*B ADN 4 1 [UPDATE POINTER TO LINE WORD IN 4RT2 [CONCEP.CELL 4S#L LDN 0 7 4SS= TXU 4 0 4T?W BCS P7 [J.FOR NEXT LINE-IN SAME CELL 4TRG SMO 2 4W?6 LDX 3 7(3) 4WQQ CALL 6 YREC [GET SUB. CONCEPTUAL CELL 4X=B LDX 1 FX2 4XQ2 STO 3 AWORK2(1) [NEW CELL POINTER 4Y9L LDX 6 BRECNO(2) 4YP= STO 6 AWORK1(1) [NEW RECORD NO 4^8W LDN 4 0 [UPDATE LINE POINTER 4^NG BRN P7 [J.FOR NEXT LINE 5286 P8 LDX 6 5 52MQ SMO 4 537B LDX 7 6(2) 53M2 SLL 6 1 546L ADN 6 2 54L= SETUPCORE 6,1,IDF,CONCEP1 [SET UP IPB BLOCK. 555W LDCT 0 #400 55KG ADX 5 0 5656 ANDN 7 #7777 56JQ SBN 7 1 574B STO 7 A1+1(1) 57J2 BRN P9 [J. BACK TO CONTINUE DOWN MAIN PATH. 583L P9A LDN 7 A1+2 58H= BRN P9B 592W P10 LDN 6 0 [LD. DUMMY ENTRIES 59GG LDN 2 0 5=26 BRN P12 5=FQ P11 LDCH 6 BTYPE(3) [LD. DEVICE TYPE 5=^B SLL 6 12 5?F2 ADX 6 BNO(3) [ADD IN IDENTIFIER NO. 5?YL LDX 3 BTYPE(3) [LD. GEO.NO. 5#D= ANDN 3 #777 5#XW FMOPG 2,3,IPB [HUNT FOR AMOP/IPB 5*54 ... BNG 2 P3A [IF NO AMOP, UNIT NOT ON INSTN 5*== ... [SO CANNOT ONLINE CONCEPTUAL 5*CG P12 MHUNTW 1,IDF,CONCEP1 [HUNT BLOCK. 5*X6 SMO 7 5BBQ STO 2 0(1) 5BWB SMO 7 5CB2 STO 6 1(1) [STORE TWO VALUES 5CTL ADN 7 1 5D*= ANDN 5 #7777 5DSW BCT 5 P14 5F#G BRN P6A 5FS6 P14 ADX 5 GSIGN 5G?Q BRN P6 5GRB # 5H?2 MENDAREA 25,K99IDFONLIN 5HQL # 5J== #END ^^^^ ...63675137000200000000