{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: IDFASAT867)}}
====== IDFASAT867 ======
(George Source)
**Macros used:** [[george:macro:ALTLEN|ALTLEN]], [[george:macro:AND|AND]], [[george:macro:BXE|BXE]], [[george:macro:CHAIN|CHAIN]], [[george:macro:CLOSE|CLOSE]], [[george:macro:DOWN|DOWN]], [[george:macro:ERRORX|ERRORX]], [[george:macro:FI|FI]], [[george:macro:FINDPEREC|FINDPEREC]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:HUNT2|HUNT2]], [[george:macro:HUNTMISB|HUNTMISB]], [[george:macro:IDFOPEN|IDFOPEN]], [[george:macro:IDFWRITE|IDFWRITE]], [[george:macro:IF|IF]], [[george:macro:LFAT|LFAT]], [[george:macro:LGEOG|LGEOG]], [[george:macro:LTYPE|LTYPE]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREEALL|MFREEALL]], [[george:macro:MGETCELL|MGETCELL]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MSEARCH|MSEARCH]], [[george:macro:MXB|MXB]], [[george:macro:OPEN|OPEN]], [[george:macro:OUTNUM|OUTNUM]], [[george:macro:PARSORT|PARSORT]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:THEN|THEN]], [[george:macro:TRACE|TRACE]], [[george:macro:UP|UP]], [[george:macro:UPPLUS|UPPLUS]]
22FL #SEG IDFASAT8 [G CONSTANTINIDES
22PD ...# COPYRIGHT INTERNATIONAL COMPUTERS 1982
22^= #OPT K0IDFASAT=0
23DW #LIS K0IDFASAT>K0ALLGEO>K0GREATGEO>K0COMMAND>K0IDF
23YG 8HIDFASAT8
24D6 # ENTRY POINTS
24XQ SEGENTRY K10IDFASAT,Z10IDFASAT
25CB SEGENTRY K20IDFASAT,Z20IDFASAT
25X2 SEGENTRY K30IDFASAT,Z30IDFASAT
26BL MENDAREA 50,K100IDFASAT
26W= XILLUN +ILLUN [ILLEGAL UNIT NO
27*W XILLINE +ILLINE [ILLEGAL LINE NO
27TG XILLIDE +ILLIDE [ILLEGAL IDENTIFIER
28*6 XINTEM +INTERM [7020 TERM/INTERFACE NOT IN IDF
28SQ XJASSOCA +JASSOCA [ASSOCIATION ALREADY DEFINED
29#B XJASSOCB +JASSOCB [ONLY 3 ASSOCIATIONS ALLOWED
29S2 #
2=?L PARSORT [CPAR/JSCE MUST ALREADY EXIST
2=R= [AND IT MUST DESCRIBE AN IPB,UX,MPX
2?=W MHUNTW 3,CPAR,JSCE
2?QG LDX 1 JSCEP(3) [DEVICE LIST POINTER
2#=6 LGEOG 1,6 [GEOG NUMBER
2#PQ LDX 4 JSCEB(3) [LINE NO FOR MX,UX
2*9B BNG 4 XREMDEV [J IF REMOTE
2*P2 LDN 5 0
2B8L BRN XFINI [FINISHED
2BN= XREMDEV [NOTE THAT MOP WOULD BE REMOTE IN
2C7W SLL 4 1 [THIS CONTEXT
2CMG LDX 5 JSCEA(3)
2D76 BPZ 4 XONUXMX [J IF ON MX,UX
2DLQ LDCT 0 #400 [B0=1 TO INDICATE IPB
2F6B ORX 6 0 [GEOG NO
2FL2 ANDN 5 #7777 [IDENTIFIER NO
2G5L BRN XFINI
2GK= XONUXMX [MPX,UPX
2H4W SLL 5 6 [IDENT-INTERFACE NO
2HJG BZE 5 XNOID [JUST LINE
2J46 LDCT 0 #200 [B1=1 FOR MPX,UX IF IDENTIFIER
2JHQ ORX 6 0 [SPECIFIED
2K3B XNOID
2KH2 SRL 4 10
2L2L DCH 4 5 [LINE NO
2LG= XFINI STO 5 ACOMMUNE4(2)
2L^W STO 6 ACOMMUNE3(2)
2MFG LDX 1 FX1
2M^6 EXIT 7 0
2NDQ OPEN SBX 6 FX1 [OPEN IDF
2NNJ ... IDFOPEN XBRK
2PD2 ADX 6 FX1
2PXL EXIT 6 0
2Q7D ...XBRK UP
2QC= #
2QWW WRITECLOSE
2RBG SBX 7 FX1
2RW6 IDFWRITE
2S*Q BRN WR
2STB ZCLOSE
2T*2 SBX 7 FX1
2TSL MFREEALL FILE,FRRB
2W#= WR CLOSE
2WRW ADX 7 FX1
2X?G EXIT 7 0
2XR6 #
2Y=Q SELL SBX 7 FX1
2YQB MGETCELL 2,3
2^=2 ADX 7 FX1
2^PL EXIT 7 0
329= #
32NW SEARCH
338G SBX 6 FX1
33N6 MSEARCH 2,3,4
347Q SMO FX2
34MB LDX 0 ACOMMUNE1
3572 ADX 6 FX1
35LL EXIT 6 0
366= #
36KW RECFIND
375G LDX 2 FX2
37K6 REC HUNT2 2,FILE,FRRB
384Q TXU 6 BRECNO+A1(2)
38JB BCS REC
3942 ADN 2 A1
39HL EXIT 7 0
3=3= #
3=GW YREC BPZ 3 SAME [FIND CELL X3 POINTS TO
3?2G YREC1 SBX 6 FX1
3?G6 LDX 0 3
3?^Q SRL 0 9
3#FB ANDN 0 #7777
3#^2 LDX 2 FX2
3*DL STO 0 ACOMMUNE3(2)
3*Y= MXB 2
3BCW ADX 6 FX1
3BXG SAME ANDN 3 #777
3CC6 EXIT 6 0
3CWQ #
3DBB TRACE LDX 4 ACOMMUNE3(2) [UNIT NO
3DW2 LDX 5 ACOMMUNE4(2) [LINE/IDENTIFIER NO
3F*L TRAC2 SBX 7 FX1
3FT= LDX 0 ACOMMUNE2(2)
3G#W STO 0 AWORK2(2) [KEEP PROPERTY PARAMETER
3GSG CALL 6 OPEN
3H#6 BNG 4 T7900 [J.IF 7900
3HRQ LDN 3 BUNIT
3J?B CALL 6 SEARCH
3JR2 BZE 0 UINV [J.IF NOT FOUND-INVALID UNIT
3K=L LDN 3 BLINE(3)
3KQ= SLL 4 1 [MOVE UP B1(SET IF 7020 INFO. IN X5)
3L9W ANDX 4 GSIGN [AND ONLY KEEP B1
3LPG DCH 5 4 [LINE NO INTO X4
3M96 CALL 6 SEARCH
3MNQ BZE 0 MINV [J.IF NOT FOUND-INVALID LINE
3N8B BPZ 4 TR1 [J.IF NO IDENTIFIER
3NN2 SMO 2 [NOW KEEP X4 AS MARKER
3P7L LDX 3 BLINE(3)
3PM= TR3 BZE 3 TINV [J.FOR INVALID TERMINAL
3Q6W CALL 6 YREC
3QLG ADX 3 2
3R66 LDX 0 BNO(3) [IDENTIFIER/POLLING ADDRESS
3RKQ ERX 0 5
3S5B ANDX 0 HALFTOP [ONLY IDENTIFIER SIGNIFICANT
3SK2 BZE 0 TR2 [J.IF RIGHT IDENTIFIER
3T4L LDX 3 0(3)
3TJ= BRN TR3
3W3W TR2 ANDN 5 #7700 [MASK OUT INTERFACE NO
3WHG BZE 5 TR11 [J.IF INTERFACE NOT REQUIRED
3X36 SRL 5 6 [INTERFACE NO INTO CHAR3
3XGQ TR4 LDX 0 BTYPE(3)
3Y2B LDCH 6 0
3YG2 ERX 6 5
3Y^L BZE 6 TR11 [J.IF CORRECT INTERFACE
3^F= LDX 0 BTYPE+1(3)
3^YW LDCH 6 0 [CHECK POSSIBLE CONSOLE INTERFACE
42DG ERX 6 5
42Y6 BZE 6 TR11 [J.IF CORRECT INTERFACE
43CQ LDX 0 BTYPE+2(3)
43XB BNG 0 TINV [J.FOR INVALID TERMINAL INTERFACE
44C2 LDX 3 0(3)
44WL BNZ 3 TR5
45B= TGEO GEOERR 1,IDF7020 [SOMETHING UP WITH 7020'S IN IDF
45TW TR5 CALL 6 YREC
46*G ADX 3 2
46T6 BRN TR4
47#Q TR11 SBX 3 2
47SB TR1 ADX 7 FX1
48#2 EXIT 7 0 [ON EXIT X4 NEG IF 7020 IDENTIFIER EXISTED
48RL T7900 LDN 3 BIPB
49?= CALL 6 SEARCH
49QW BZE 0 UINV [J.FOR INVALID UNIT
4==G LDN 3 BLINE(3)
4=Q6 LDX 4 5
4?9Q CALL 6 SEARCH
4?PB BZE 0 RINV [J.FOR INVALID IDENTIFIER
4#92 BRN TR1
4#NL #
4*8= # ERRORS!!!!
4*MW UINV LDX 3 XILLUN(1) [ILLEGAL UNIT
4B7G ONVMA ANDN 4 #7777
4BM6 ONUM
4C45 ... OUTNUM 4,0
4C6Q YERC CALL 7 ZCLOSE
4CLB ERRORX 3
4CW8 ... UPPLUS 1
4DKL MINV LDX 3 XILLINE(1) [ILLEGAL LINE
4F5= BRN ONVMA
4FJW RINV LDX 3 XILLIDE(1) [ILLEGAL IDENTIFIER
4G4G BRN ONVMA
4GJ6 TINV LDX 3 XINTEM(1) [7020 TERM/INTERFACE NOT IN IDF
4H3Q BRN YERC
4HHB XERR LDX 3 XJASSOCA(1) [ASSOCIATION ALREADY DEFINED
4J32 BRN YERC
4JGL YERR LDN 4 ASSMAX [GOT 3 ASSFCIATIONS ALREADY
4K2= LDX 3 XJASSOCB(1)
4KFW BRN ONUM
4K^G #
4LF6 #
4LYQ Z10IDFASAT [MIDFAS ENTRY(ASSMAX MUST BE <4)
4MDB CALL 7 PARSORT
4MY2 LDX 0 ACOMMUNE1(2)
4NCL STO 0 AWORK1(2) [KEEP "BIT" WORD PARAMETER
4NX= CALL 7 TRACE [TRACE REQUIRED CELL
4PBW SMO 2
4PWG LDX 6 BASS(3)
4QB6 BNZ 6 NOMAK [J IF GOT ASSOCIATE CELL ALREADY
4QTQ LDN 3 BASS(3)
4R*B CALL 7 SELL [GET CELL FOR ASSOCIATES
4RT2 ADN 3 BTYPE(2)
4S#L LDN 1 0
4SS= TIDY SMO FX2
4T?W LDN 2 AWORK1
4TRG MOVE 2 2 [MOVE IN ASSOCIATIONS
4W?6 SBN 3 BTYPE(1)
4WQQ LDN 0 1 [FOR UPDATING COUNT OF ASSOCIATIONS
4X=B ADS 0 BNO(3)
4XQ2 WRITE CALL 7 WRITECLOSE
4X^S ... UPPLUS 2
4YP= NOMAK LDX 3 6
4^8W CALL 6 YREC
4^NG ADN 3 BTYPE(2) [X3 POINTS TO FIRST ASSOCIATE RECORD
5286 LDN 6 0 [USE X6 AS SWITCH-ZERO FOR PASS 1
52MQ ZIP LDN 7 ASSMAX [X7 IS COUNT OF MAX NO OF ASSOCIATES
537B SMO FX2
53M2 LDX 5 AWORK1 [NEW "BIT" WORD IN X5
546L ZOOP LDX 4 0(3) [IDF "BIT" WORD IN X4
54L= BNZ 4 ZA
555W BNZ 6 ZB [J.IF SWITCH SET INDICATING PASS 2
55KG LDCT 0 #200
5656 ORX 7 0 [SET B1 OF X7 AS MARKER
56JQ BRN UPDAT
574B ZB BNG 6 UPDAT
57J2 LDN 1 ASSMAX
583L SBX 1 7 [SO ASSOCIATIONS GO IN RIGHT PLACE
58H= SLL 1 1 [MULT.BY 2
592W BRN TIDY [TO PUT ASSOCIATION IN IDF
59GG ZA ORX 4 5
5=26 TXU 4 0(3)
5=FQ BCC XERR
5=^B ERX 4 5
5?F2 ANDX 4 HALFTOP
5?YL BNZ 4 UPDAT [J.IF COMMANDS DO NOT M&TCH
5#D= SMO FX2
5#XW LDX 0 AWORK2
5*CG TXU 0 1(3) [COMPARE PROPERTY NUMBERS
5*X6 BCC ZF [J.IF PROPS.SAME
5BBQ LDX 4 0(3) [AND IF PROPS DIFFER MAKE SURE-
5BWB ANDX 4 5 [PERIPHERALS DIFFER
5CB2 ANDN 4 #7777
5CTL BNZ 4 XERR ["ALREADY GOT THIS ASSOCIATION"
5D*= BRN UPDAT
5DSW ZF BZE 6 ZC [J IF PROPERTIES DIFFER
5F#G ORS 5 0(3) [OTHERWISE BUNG IN NEW ASSOCIATION
5FS6 BRN WRITE
5G?Q ZC ORX 7 GSIGN [SET B0 OF X7 AS MARKER
5GRB UPDAT ADN 3 2 [UPDATE IDF POINTER
5H?2 BCT 7 ZOOP
5HQL BPZ 7 ZD
5J== LDX 6 7 [MAKE SWITCH(X6) NEG
5JPW BRN ZE
5K9G ZD LDCT 0 #200
5KP6 ANDX 0 7
5L8Q BZE 0 YERR [ERROR-NO ROOM FOR THIS ASSOCIATION
5LNB LDX 6 0 [MAKE SWITCH(X6) POSITIVE
5M82 ZE SBN 3 2*ASSMAX [UPDATE X3 TO POINT TO FIRST ASSOC.
5MML BRN ZIP [J.FOR PASS 2
5N7= #
5NLW #
5P6G Z20IDFASAT [PUTCONS ENTRY
5PL6 CALL 7 PARSORT
5Q5Q LDX 4 ACOMMUNE3(2) [UNIT NO
5QKB STO 4 AWORK3(2) [USED FOR HUIDGE
5R52 BZE 4 OPCON [J.IF CENTRAC OPERATORS CONSOLE
5RJL LDX 5 ACOMMUNE4(2) [IDENTIFIER/LINE NO ETC.
5S4= STO 5 AWORK4(2) [USED FOR HUIDGE
5SHW BNG 4 P7900 [J.IF A 7900 DEVICE
5T3G CALL 7 TRAC2 [TRACE CELL
5TH6 BNG 4 P1 [J.IF 7020 CELL
5W2Q P4 CALL 7 ZCLOSE [ERROR ROUTE
5W=J ... UPPLUS 2
5X22 P1 ADX 3 2
5XFL LDCH 0 BTYPE(3)
5X^= SBN 0 3
5YDW BZE 0 P2 [J IF THIS CONSOLE OKAY
5YYG LDX 0 BTYPE+2(3)
5^D6 BNG 0 P4 [J TO ERROR IF THIS 7020 FINISHED
5^XQ LDX 3 0(3)
62CB BZE 3 TGEO [SOMETHING UP-SO GEOERR
62X2 CALL 6 YREC
63BL BRN P1
63W= OPCON LDX 5 ACOMMUNE2(2) [PROPERTY PARAMETER
64*W CALL 6 OPEN
64TG BRN P18
65*6 P7900 CALL 7 TRAC2 [TRACE CELL
65SQ ADX 3 2
66#B LDCH 0 BTYPE(3)
66S2 SBN 0 5
67?L BNZ 0 P4 [J.IF NOT 7023 CONSOLE TO ERROR
67R= P2 LDCT 0 #40
68=W ORS 0 BTYPE+1(3) [SET "THIS IS CLUSTER CONSOLE"BIT
68QG SBX 3 2
69=6 LDX 4 BRECNO(2) [RECORD NUMBER
69PQ SLL 4 9
6=9B ORX 4 3 [IDF POINTER(EXCEPT B0)TO CONSOLE
6=P2 LDN 6 0
6?8L CALL 7 RECFIND [FIND RECORD ZERO
6?N= SMO FX2
6#7W LDX 5 AWORK2 [PICK UP CONSOLE PROPERTY NUMBER
6#MG P18 LDX 6 BEXOT(2) [BASE OF CONSOLE PROPERTY CHAIN
6*76 LDN 3 BEXOT [IN CASE X6 IS ZERO
6*LQ BZE 6 P5
6B6B P7 LDX 3 6
6BL2 CALL 6 YREC
6C5L ADX 3 2
6CK= LDX 0 BNO(3) [NOW COMPARE PROPERTY NOS.
6D4W ERX 0 5
6DJG ANDX 0 BITS22LS [ONLY BOTTOM 22 BITS FOR PROP NO
6F46 BZE 0 P6 [J.IF NOS.ARE SIMILAR
6FHQ LDX 6 0(3)
6G3B BNZ 6 P7
6GH2 SBX 3 2
6H2L P5 CALL 7 SELL [GET NEW CONSOLE PROPERTY CELL
6HG= ADX 3 2
6H^W STO 5 BNO(3) [STORE PROPERTY NUMBER
6JFG P6 BZE 4 P8 [J IF OPS CONSOLE
6J^6 LDX 0 4 [OTHERWISE SEE IF B0 OF IDF POINTER-
6KDQ SRL 0 9 [MUST BE SET
6KYB TXU 0 BRECNO(2)
6LD2 BCC P8
6LXL ORX 4 GSIGN [SET B0
6MC= P8 LDX 7 BTYPE(3) [OLD CONSOLE IF NOT NEW CELL
6MWW STO 4 BTYPE(3) [STORE POINTER(OR ZERO)IN CELL
6NBG LDX 6 7 [SO X6 ONLY ZERO IF NEW CELL OR OLD CONSOLE WAS-
6NW6 [OPS CONS:OTHERWISE X6 POINTS TO OLD CONSOLE
6P*Q ANDX 5 BITS22LS [CONSOLE PROP.NUMBER
6PTB P13 HUNTMISB 2,APERI,CONSOLE [NOTE APERI/CONSOLE WAS CALLED-
6Q*2 [HUIDGE & HENCE LATER COMMENTS!
6QSL BZE 4 P20 [J.IF NEW CONSOLE IS OPS CONSOLE
6R#= BNG 2 P10 [J.IF NO HUIDGE BLOCK
6RRW LDX 3 2 [KEEX COPY OF X2LEAST X6>0
6S?G BNZ 6 P11 [J.IF NOT NEW CONSOLE-PROP(X6 SWITCH)
6SR6 LDN 0 2 [X0=2 IS USED AT P12
6T=Q LDX 7 ALOGLEN(2) [INVESTIGATE HUIDGE LENGTH
6TQB SBX 7 A1(2)
6W=2 SBX 7 0
6WPL BPZ 7 P12 [J.IF LENGTH OKAY
6X9= LDN 7 4 [MAKE CONSOLE BLOCK 4 WORDS LONGER
6XNW ADX 7 ALOGLEN(2)
6Y8G ALTLEN 3,7 [INCREASE APERI/CONSOLE BLOCK
6YN6 BRN P13
6^7Q # CREATE A APERI/CONSOLE BLK & CHAIN IT IN END OF MISC.CHAIN
6^MB P10 BNZ 6 UGEO
7272 ...P101 SETNCORE 4,1,APERI,CONSOLE
72LL LDX 2 BMISC+1
736= CHAIN 1,2
73KW LDX 2 BMISC+1
745G LDN 0 2
74K6 STO 0 A1(2)
754Q P12 LDX 3 2 [KEEP COPY OF POINTER TO HUIDGE
75JB ADS 0 A1(2) [COUNT OF NO.RELEVANT WORDS IN HUIDGE
7642 ADX 2 A1(2)
76HL STOZ A1-2(2) [ZEROIZE POSITION OF "OLD CONSOLE
773= [DESCRIPTION"AS THIS IS NEW ENTRY
77GW STOZ A1-1(2) [ZEROIZE LAST WORD
782G SBN 2 2
78G6 # NOW SET UP AND STORE NEW ENTRY IN APERI/CONSOLE BLOCK
78^Q P16 LDCT 0 #400
79FB LDX 1 FX2
79^2 ANDX 0 AWORK3(1)
7=DL ORX 5 0
7=Y= STO 5 A1-1(2)
7?CW BNG 0 P14
7?XG LDN 7 #7700 [MASK OUT INTERFACE NO.TO MAKE B0-11
7#C6 ORX 7 AWORK4(1) [2 CHAR IDENT & B12-23 LINE NO.
7#WQ ERN 7 #7700
7*BB P15 LDX 4 A1(2) [KEEP OLD CONSOLE'S DESCRIPTION-ZERO?
7*W2 STO 7 A1(2) [STORE NEW CONSOLE'S DESCRIPTION
7B*L # NOW FOLLOWS CODE TO SET/UNSET B1 OF CONS.PROP.NO.IN HUIDGE BLOCK
7BT= # FOR NEW AND OLD CONSOLE:NEW CONSOLE IS INVESIGATED FIRST
7C#W P25 LDX 2 3 [PTR TO HUIDGE INTO X2 & PRESERVE X3
7CSG LDN 5 0 [AS "CONSOLE NOT YET FOUND" SWITCH
7D#6 P23 TXU 7 A1+2(2) [COMPARE CONSOLES
7DRQ BCS P22 [J.IF DIFFERENT
7F?B BNZ 5 P24 [J.IF B1 IS TO BE SET IN HUIDGE BLK
7FR2 LDCT 5 #200 [OTHERWISE MAKE SURE B1 UNSET
7G=L ORS 5 A1+1(2)
7GQ= ERS 5 A1+1(2)
7H9W BRN P22
7HPG P24 ORS 5 A1+1(2) [SET B1 AS INDICATOR IN HUIDGE BLOCK
7J96 P22 ADN 2 2 [UPDATE X2 FOR NEXT HUIDGE INQUIRY
7JNQ LDX 0 A1+1(2)
7K8B BNZ 0 P23 [AND J.FOR NEXT HUIDGE INQUIRY
7KN2 P17 BZE 4 P26 [J.IF OLD CONSOLE NON-EXISTENT IN-
7L7L LDX 7 4 [HUIDGE OR DONE P25 CODE TWICE,OTHER
7LM= LDN 4 0 [WISE SET X4 ZERO &-
7M6W BRN P25 [J.TO DO P25 CODE AGAIN
7MLG # SEE IF "THIS IS CLUSTER CONSOLE" BIT IN IDF MUST BE UNSET
7N66 P26 BZE 6 P21 [J IF NEW CONS.PROP,OR OLD CONS.WAS OPS.CONSOLE
7NKQ BNZ 5 P21 [J.IF CONS.STILL USED-DO NOT UNSET
7P5B P17A LDX 3 6 [OTHERWISE UNSET"THIS IS CLUSTER-
7PK2 CALL 6 YREC1 [CONSOLE"BIT USING IDF POINTER IN X6
7Q4L LDCT 0 #40
7QJ= SMO 2
7R3W ERS 0 BTYPE+1(3) [UNSET BIT
7RHG P21 CALL 7 WRITECLOSE
7RR# ... UPPLUS 3
7SGQ P14 LDN 7 #777
7T2B ANDX 7 AWORK3(1) ["AND" OUT GEOG.NO & MOVE UP GEOG.NO.
7TG2 SLL 7 12
7T^L ORX 7 AWORK4(1)
7WF= BRN P15
7WYW P20 BZE 6 P21 [J.IF OLD CONSOLE WAS OPERATORS OR-
7XDG [THIS IS NEW CONSOLE PROP & DO NOWT
7XY6 BPZ 2 P19
7XYK ...#
7X^4 ...# ENTRY TO THIS POINT MEANS THINGS DONT MATCH BETWEEN THE IDF AND TH
7X^H ...# APERI-CONSOLE BLOCK. IT IS POSSIPLE FOR A CONSOLE PROPERTY TO BE
7Y22 ...# FOR A PERIPHERAL NOT CURRENTLY ON THE INSTALLATION, HOWEVER A REQU
7Y2F ...# HAS BEEN RECIEVED FOR THE PROPERTY TO HAVE A DIFFERENT CONSOLE. T
7Y2Y ...# SITUATION IS CATERED FOR BY THE FOLLOWING CODE.
7Y3C ...# ENTRY FROM:- P10,P11 OR P20
7Y3W ...# VALUES ON ENTRY - X6 = IDF PTR. TO OLD CONSOLE CELL
7Y4* ...# X4 = IDF PTR. LESS B0 OF NEW CONSOLE CELL OR ZER
7Y4S ...# X2 = PTR. TO APERI-CONSOLE BLK
7Y5? ...# OR
7Y5Q ...# NEGATIVE NO BLOCK
7Y69 ...UGEO LDX 1 4 [SV X4 IN X1
7Y6N ... LDX 5 6 [SV X6 IN X5
7Y77 ... LDX 3 6 [LD. PTR. TO OLD CONSOLE
7Y7L ... CALL 6 YREC1 [HUNT BLK.
7Y85 ... SMO 2
7Y8J ... LDX 6 BNUMB(3)
7Y93 ... SLL 6 1
7Y9G ... BNG 6 UGEO1 [J. IDENTIFIER CELL
7Y9^ ... SMO 2
7Y=D ... LDX 4 4(3) [LD. WD. CONTAIN GEOG.NO. OF UNIT
7Y=X ... SRL 4 6
7Y?B ... LDN 3 BUNIT [LD. BASE OF UNIT CHAIN
7Y?T ... BRN UGEO2
7Y## ...UGEO1 SMO 2
7Y#R ... LDX 4 BTYPE(3) [LD. GEOG.NO.
7Y*= ... LDN 3 BIPB [LD. BASE OF UNIT CHAIN-7900
7Y*P ...UGEO2 ANDN 4 #777 [MASK OUT GEOG. NO.
7YB8 ... LDN 6 0
7YBM ... CALL 7 RECFIND [FIND RECORD ZERO
7YC6 ... LDX 7 1
7YCK ... CALL 6 SEARCH [SEARCH FOR UNIT CELL
7YD4 ... LDX 1 7
7YDH ... SMO 3
7YF2 ... LDX 0 BNUMB(2)
7YFF ... SLL 0 1
7YFY ... BNG 0 UGEO3 [J. IF UNIT WRONG
7YGC ...UGEOE GEOERR 1,HUIDGE [FAILED - SOMETHING A MISS
7YGW ...UGEO3 SMO 2
7YH* ... LDX 7 BTYPE(3) [LD. DEVICE TYPE OF IDF UNIT
7YHS ... SRC 7 6
7YJ? ... ANDN 7 #77 [MASK OUT DEVICE TYPE
7YJQ ... FINDPEREC 3,APGEOG,4 [FIND DEVICE LIST
7YK9 ... BNG 3 UGEO4 [J. GEOG. NO. DEVICE LIST NOT FOUND
7YKN ... LTYPE 3,4 [X4 = DEVICE TYPE
7YL7 ... BXE 2 7,UGEOE [J. SOMETHING WRONG
7YLL ...UGEO4 LDX 6 4 [RE-LOAD VALUE OF X6
7YM5 ... SMO FX2
7YMJ ... LDX 5 AWORK2
7YN3 ... ANDX 5 BITS22LS [RE-LOAD CONSOLE PROP.NO.
7YNG ... LDX 4 1 [RE-LOAD IDF PTR. NEW CONSOLE CELL.
7YN^ ...UGEO5 HUNTMISB 2,APERI,CONSOLE [HUNT APERI-CONSOLE
7YPD ... BNG 2 P101 [J. TO SET UP A BLOCK
7YPX ... BZE 4 P17A [J. NEW CONSOLE = OPERATORS
7YQB ... LDN 0 2
7YQT ... LDX 7 ALOGLEN(2) [INVESTIGATE LENGTH OF BLOCK
7YR# ... SBX 7 A1(2)
7YRR ... SBX 7 0
7YS= ... BPZ 7 P12 [J. ENOUGH ROOM.
7YSP ... LDN 7 4 [INCREASE LENGTH OF APERI-CONSOLE
7YT8 ... ADX 7 ALOGLEN(2)
7YTM ... ALTLEN 2,7 [ALTER LENGTH OF BLK
7YW6 ... BRN UGEO5 [J. BACK TO RE-HUNT
7YXB P19 LDX 1 2 [EXTRA COPY OF POINTER INTO X1:NEED-
7^C2 LDX 7 A1(1) [IT ANYWAY & SO MAY FREECORE
7^WL SBN 7 4
82B= BNZ 7 P3
82TW FREECORE 1 [& IF IT WILL BE EMPTY FREE IT!
83*G BRN P17A
83T6 P3 SBX 7 ALOGLEN(1) [OTHERWISE PREPARE X7 FOR ALTLEN-
84#Q ADN 7 16 [TEST(ONLY ALTLEN IF 16 WORDS SPARE).
84SB LDX 3 2 [YET ANOTHER COPY OF HUIDGE POINTER
85#2 P11 ADN 2 2 [NOW HUNT DOWN HUIDGE BLOCK
85RL LDX 0 BITS22LS
86?= ANDX 0 A1-1(2) [PROPERTY NUMBER CONTAINED IN X5
86QW BZE 0 UGEO [SOMETHING UP!
87=G TXU 0 5 [COMPARE
87Q6 BCS P11 [& J.IF NOT THIS ONE
889Q BNZ 4 P16 [J.IF NEW CONSOLE NOT OPERATORS
88PB # THIS CODING DEALS WITH CASE WHEN THE NEW CONSOLE IS OPERATORS
8992 LDX 4 A1(2) [PICK UP OLD CONSOLE DESCRIPTION
89NL LDN 2 A1-1(2)
8=8= LDN 0 2
8=MW SBS 0 A1(1)
8?7G ADX 1 A1(1)
8?M6 LDN 1 A1-1(1)
8#6Q MOVE 1 2
8#LB STOZ 0(1)
8*62 BPZ 7 P17 [DON'T ALTER LENGTH
8*KL LDX 7 A1(3)
8B5= ALTLEN 3,7 [MAKE APERI/CONSOLE SMALLER
8BJW BRN P17
8C4G #
8CJ6 #
8D3Q Z30IDFASAT [IDFAT ENTRY(ATTMAX MUST BE <7)
8DHB CALL 7 PARSORT
8F32 [MPX OR IPB -JUST GEOG NO
8FGL LDX 0 ACOMMUNE1(2) [KEEP WORD INDICATING WHETHER THIS-
8G2= STO 0 AWORK1(2) [IS A CONSOLE PROPERTY
8GFW CALL 7 TRACE [FIND DEVICE CELL
8G^G SMO FX2
8HF6 LDX 5 AWORK1 [RESCUE INDICATOR WORD
8HYQ BPZ 5 Q3 [J.IF NOT CONSOLE PROP
8JDB LDX 0 BRECNO(2) [OTHERWISE KEEP POINTER TO DEVICE CEL
8JY2 SLL 0 9
8KCL ORX 0 3
8KX= SMO FX2
8LBW STO 0 AWORK4 [STORE POINTER IN AWORK4
8LWG Q3 SMO 2
8MB6 LDX 6 BATT(3) [ATTRIBUTION POINTER
8MTQ SMO FX2
8N*B LDX 7 JSOURCE3
8NT2 BNZ 7 Q20 [J.IF NOT CENTRAL
8P#L SMO FX2
8PS= LDX 0 JSOURCE2
8Q?W BNG 0 Q17 [J.IF NOT LOCAL OPS.CONSOLE
8Q*9 ...Q20
8QBJ ... LDX 1 2
8QCX ... ADX 1 3
8QF= ... SMO FX2
8QGK ... LDX 0 AWORK2
8QK? ... SLL 0 1
8QLL ... IF 0,PZ [ TEMPORARY
8QM^ ... AND BS,1,IDF7502LP [ 7502 LP
8QP# ... THEN
8QPJ ... LDX 0 BRECNO(2)
8QPS ... SLL 0 9
8QQ4 ... ORX 3 0 [MAKE FULL IDF PTR FOR YREC1..
8QQ# ...[ NOTE BIT 0 NOT VALID
8QQM ... DOWN FORMLOOP,1
8QS2 ... IF REP2,WRONG
8QT* ... THEN
8QWN ... CALL 7 ZCLOSE
8QY3 ... UPPLUS 1
8Q^B ... [-------
8R2P ... FI
8R44 ... CALL 6 YREC1 [ REFIND IDENTIFIER CELL
8R5C ... SMO 2
8R6Q ... LDX 6 BATT(3)
8R85 ... FI
8R9D ... BNZ 6 QNMAK [J.IF ATTRIBUTION CELL ALREADY EXISTS
8R?6 BNZ 7 Q17 [ERROR WROOG CLUSTER
8RQQ LDN 3 BATT(3) [OTHERWISE MAKE ONE
8S=B CALL 7 SELL
8SQ2 ADX 3 2
8T9L Q5 LDN 0 1
8TP= ADS 0 BNO(3) [UPDATE COUNT OF ATTRIBUTIONS
8W8W LDX 0 BTYPE(3) [PICK UP CONSOLE PROP WORD
8WNG BNG 5 Q1 [J.IF NEW PROP.IS CONSOLE PROPERTY
8X86 BZE 0 Q2 [OTHERWISE ADJUST X3 TO INDICATE-
8XMQ LDN 0 1 [WHERE NEW PROPERTY IS TO GO IN CELL.
8Y7B Q2 ADX 3 BNO(3)
8YM2 SBX 3 0
8^6L Q4 SMO FX2
8^L= LDX 4 AWORK2 [PICK UP NEW PROPERTY
925W STO 4 BTYPE(3) [STORE NEW PROPERTY IN CELL
92KG BNG 5 QCONS [J.TO UPDATE CONSOLE CHAIN IF NEC.
9356 QXIT
93JQ LFAT
944B CALL 7 WRITECLOSE [OTHERWISE FINISH
94#8 ... UPPLUS 6
953L Q1 BZE 0 Q4 [J.IF NO CONSOLE PROP.YET ATTRIBUTED
95H= CALL 7 ZCLOSE [ALREADY GOT CONSOLE PROP SO ERROR
95R4 ... UPPLUS 3
96GG QNMAK LDX 3 6
9726 CALL 6 YREC [FIND ATTRIBUTION CELL
97FQ ADX 3 2
97^B BRN Q14
98F2 Q17 CALL 7 ZCLOSE
98NS ... UPPLUS 5
99D= Q14 BNG 5 Q18 [IF CONSOLE PROP.DON'T CHECK PRIOR-
99XW SMO FX2 [ATTRIBUTIONS:OTHERWISE CHECK THIS-
9=CG LDX 4 AWORK2 [IS A NEW ATTRIBUTION
9=X6 ANDX 4 BITS22LS
9?BQ LDN 7 5 [COUNT OF POSSIBLE ATTRIBUTIONS
9?WB Q16 SMO 7
9#B2 LDX 0 BTYPE(3) [PICK UP AN ATTRIBUTION(OR ZERO)
9#TL ERX 0 4
9**= ANDX 0 BITS22LS
9*SW BNZ 0 Q15 [J.IF DIFFERENT ATTRIBUTION
9B#G CALL 7 ZCLOSE [OTHERWISE ERROR
9BJ# ... UPPLUS 4
9C?Q Q15 SBN 7 1
9CRB BNZ 7 Q16 [J.FOR NEXT COMPARISON
9D?2 Q18 LDX 0 BNO(3)
9DQL SBN 0 ATTMAX
9F== BNG 0 Q5 [J.IF ROOM FOR ANOTHER ATTRIBUTION
9FPW CALL 7 ZCLOSE [OTHERWISE ERROR
9F^N ... UPPLUS 2
9GP6 QCONS [UPDATE CONSOLE CHAIN
9H8Q ANDX 4 BITS22LS [CLEAR OUT TOP 2 BITS
9HNB LDN 6 0
9J82 CALL 7 RECFIND [FIND RECORD ZERO
9JML LDX 3 BEXOT(2) [CONSOLE PROPERTY CHAIN BASE
9K7= BNZ 3 Q6
9KLW QGEO GEOERR 1,CLUSTERC [ERROR CONSOLE PROP.NOT FOUND
9L6G Q6 CALL 6 YREC
9LL6 ADX 3 2
9M5Q LDX 5 BNO(3)
9MKB ANDX 5 BITS22LS
9N52 TXU 4 5 [COMPARE PROPERTY NUMBERS
9NJL BCC Q7 [J.IF SAME
9P4= LDX 3 0(3)
9PHW BNZ 3 Q6 [J.FOR NEXT CONSOLE PROP
9Q3G BRN QGEO
9QH6 Q7 LDX 5 3(3) [GOT CONSOLE PROP SO GET NO.OF ATTRIB
9R2Q LDN 0 1
9RGB ADS 0 3(3) [UPDATE NO OF ATTRIB
9S22 SBN 5 3
9SFL BNG 5 Q8 [J.IF ROOM IN FIRST CELL
9S^= ADN 3 4 [OTHERWISE MAKE X3 POINT TO FORWARD-
9TDW BNZ 5 Q9 [PTR & J.IF SUBSID CELL MUST EXIST
9TYG Q11 SBX 3 2 [MAKE SUBSID.CELL
9WD6 CALL 7 SELL
9WXQ ADN 3 1(2)
9XCB BRN Q10 [J.TO FILL IN ATTRIB.PTR
9XX2 Q9 LDX 3 0(3)
9YBL BZE 3 QGEO [ERROR!
9YW= CALL 6 YREC
9^*W ADX 3 2
9^TG SBN 5 7
=2*6 BZE 5 Q11 [J.TO MAKE NEW SUBSID.CELL
=2SQ BPZ 5 Q9 [J.TO FIND NEXT SUBSID CELL
=3#B Q8 ADN 5 8
=3S2 ADX 3 5 [NOW X3 PTS TO POSITION WHERE-
=4?L Q10 SMO FX2 [ATTRIB.PTR IS TO BE PLACED
=4R= LDX 0 AWORK4
=5=W LDX 7 0 [NOW SEE IF B0 OF IDF PTR NEED BE SET
=5QG SRL 7 9
=6=6 TXU 7 BRECNO(2)
=6PQ BCC Q12 [J.IF B0 NEED NOT BE SET
=79B ORX 0 GSIGN
=7P2 Q12
=88L STO 0 0(3)
=8N= BRN QXIT [ALL DONE!
=97W #END
^^^^ ...05720347000100000000