{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: IDFONLIN867)}}
====== IDFONLIN867 ======
(George Source)
**Macros used:** [[george:macro:CLOSE|CLOSE]], [[george:macro:FINDPEREC|FINDPEREC]], [[george:macro:FMOPG|FMOPG]], [[george:macro:HUNT2|HUNT2]], [[george:macro:IDFOPEN|IDFOPEN]], [[george:macro:IDFWRITE|IDFWRITE]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREEALL|MFREEALL]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MNAME|MNAME]], [[george:macro:MXB|MXB]], [[george:macro:OPEN|OPEN]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:UP|UP]], [[george:macro:UPPLUS|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