{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: PARIDF8)}}
====== PARIDF8 ======
(George Source)
**Macros used:** [[george:macro:CLOSETOP|CLOSETOP]], [[george:macro:COOR2|COOR2]], [[george:macro:ERRORX|ERRORX]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:HUNTMISB|HUNTMISB]], [[george:macro:HUNTW|HUNTW]], [[george:macro:IDFOPEN|IDFOPEN]], [[george:macro:LTYPE|LTYPE]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREEALL|MFREEALL]], [[george:macro:MXB|MXB]], [[george:macro:NAME|NAME]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SPARANOX|SPARANOX]], [[george:macro:UNIFREE|UNIFREE]], [[george:macro:UP|UP]], [[george:macro:UPPLUS|UPPLUS]]
22FL #SEG PARIDF8 [A.C.PUTMAN
22^= #OPT K0PARIDF=0
23DW #LIS K0PARIDF>K0PARSORT>K0IDF>K0COMMAND>K0ALLGEO
23YG 8HPARIDF
24D6 #
24XQ # THIS SEGMENT VALIDATES THE CONTENTS OF CPAR/CPCT AND CPAR/ARPB
25CB # BLOCKS IN THE IDF. IT IS ENTERED FROM SEGMENT PARSORT, AND
25X2 # PERFORMS THE FOLLOWING TASKS:-
26BL #
26W= # FOR CPAR/CPCT BLOCKS, THE CONSOLE PROPERTY ATTRIBUTED
27*W # TO THE DEVICE IS STORED IN JSCEC,AND THE CLUSTERING
27TG # IS CHECKED
28*6 #
28SQ # FOR CPAR/AIPB BLOCKS, THE EXISTENCE OF THE IDENTIFIER
29#B # IS CHECKED, THEN AS FOR CPAR/CPCT BLOCKS
29S2 #
29^8 ...# AWORK1 PARAMETER OPTION WORD
2=6B ...# AWORK3 =0 INDICATES PRESENCE OF VALID PARAMETERS
2=?L #
2=R= #
2?=W SEGENTRY K1PARIDF,X1PARIDF
2?QG #
2#=6 #
2#PQ #PAGE
2*9B ZILLINO +ILLINO [ILLEGAL LINE NUMBER
2*P2 ZJNOPER +JNOPER [NOT ON INSTALLATRON
2B8L ZNOCLUS +INOCLUS [NOT IN CORRECT CLUSTER
2BN= # CONVERSION TABLE FOR IDF PERIPHERAL TYPES
2C7W XCONFIG [7900 CONFIGURATION REPORT
2CMG +24 [ 7071
2D76 +24 [ 5 TRACK T/W
2DLQ +14 [ 7153 AVDU
2F6B TYPE7020 [ PLUS PCT TYPES FROM HERE
2FL2 +2 [ 7021 LP
2G5L +3 [ 7022 CR
2GK= +63 [ 7023 T/W
2H4W +0 [ 7024 TR
2HJG +1 [ 7025 CR
2J46 #
2JHQ # * * *
2K3B # * * **
2KH2 # ** *
2L2L # * * *
2LG= # * * ***
2L^W #
2MFG X1PARIDF
2M^6 #
2NDQ # AT THIS STAGE IN THE PROCEEDINGS WE HAVE A STRIDE (WHICH MAY BE OF
2NYB # ZERO LENGTH) OF CPAR/JSCE BLOCKS (LOCAL PERIPHERALS), CPAR/CPCT BLOCKS
2PD2 # (PCT PERIPHERALS), AND CPAR/AIPB BLOCKS (IPB IDENTIFIERS), ALL MIXED
2PXL # IN ANY ORDER. THIS SECTION OF THE CODE CHECKS THE PERIPHERAL DEFINED
2QC= # IN THE CPAR BLOCK WITH THE CURRENT STATE OF THE IDF.
2QWW #
2RBG IDFOPEN XBRK [OPEN THE IDF
2RW6 LDX 1 2 [POINTER TO A1 OF FILE/FRRB
2S3# ... LDN 0 1
2S6R ... SMO FX2
2S== ... STO 0 AWORK3 [SET VALID PARAMS. INDICATOR
2S*Q BRN PASSONE [FIRST TIME THROUGH - BRANCH
2STB NEXTPARAM
2T*2 LDN 5 0 [SUBSEQUENT PASSES - RELOCATE
2TSL CALL 7 NEWREC [IDF BASE CELL
2W#= PASSONE
2WRW LDX 2 FX2
2X?G LDX 2 FX2 [EXIT 1
2XR6 CALL 7 SHUNTPCT
2Y=Q BNG 3 NOW4IPB [BR IF NO MORE PCT PARAMETERS
2YQB LDEX 4 JSCEB(3) [LOAD GEOGRAPHIC NO OF UNIT
2^=2 LDXC 5 BUNIT(1) [LOAD BASE OF UNIT CHAIN
2^PL BCC N1 [BR IF UNIT CELL IN THIS RECORD
329= N0 CALL 7 NEWREC [GET POINTER TO NEW FILE/FRRB
32NW N1
338G BZE 5 ZAZOOM [BR IF UNIT NOT FOUND IN IDF
33N6 LDEX 5 5 [DISPLACEMENT PART OF IDF POINTER
347Q SMO 5
34MB LDEX 0 BTYPE(1) [LOAD GEOG NO FOR THIS CELL
3572 TXU 0 4
35LL BCC UNITCELL [BR IF RIGHT CELL FOUND
366= SMO 5
36KW LDXC 5 0(1) [LOAD POINTER DOWN UNIT CHAIN
375G BCS N0 [BR IF CELL IN DIFFERENT RECORD
37K6 BRN N1
384Q UNITCELL [CORRECT UNIT CELL FOUND
38JB CALL 7 SHUNTPCT [RELOCATE CPAR/CPCT BLOCK
3942 LDX 4 JSCEB(3)
39HL SRL 4 9 [LINE NUMBER
3=3= ANDN 4 #77
3=GW SMO 5
3?2G LDXC 5 BLINE(1) [LOAD BASE OF LINE CHAIN
3?G6 BCC N2
3?^Q N3
3#FB CALL 7 NEWREC
3#^2 N2
3*DL BZE 5 NOLINE [BR IF LINE CELL NOT FOUND
3*Y= LDEX 5 5
3BCW SMO 5
3BXG LDX 0 BNO(1) [LOAD LINE NUMBER
3CC6 TXU 0 4
3CWQ BCC SLINECELL [BR IF CORRECT CELL FOUND
3DBB SMO 5
3DW2 LDXC 5 0(1) [LOAD POINTER DOWN LINE CHAIN
3F*L BCS N3
3FT= BRN N2
3G#W SLINECELL [CORRECT LINE CELL FOUND
3GSG CALL 7 SHUNTPCT
3H#6 LDX 4 JSCEA(3)
3HRQ BNZ 4 TERMINAL [BR IF TERMINAL SPECIFIED
3J?B SMO 5
3JR2 LDXC 5 BATT(1) [LOAD POINTER TO ATTRIBUTION CELL
3K=L BCC N4
3KQ= CALL 7 NEWREC
3L9W N4 BZE 5 NOATTS [BR IF LINE HAS NO ATTRIBUTIONS
3LPG ANDN 5 #777
3M96 SMO 5
3MNQ LDX 5 BTYPE(1) [CONSOLE PROPERTY WORD
3N8B BRN SCLUSTER [BR TO CHECK CLUSTERING
3NN2 TERMINAL [TERMINAL SPECIFIED
3P7L LDX 6 4 [PRESERVE TERM/INT NO.
3PM= SRL 4 6 [ISOLATE TERMINAL IDENTIFIER
3Q6W SMO 5
3QLG LDXC 5 BLINE(1) [LOAD BASE OF 7020 CHAIN
3R66 BCC N5
3RKQ N6
3S5B CALL 7 NEWREC
3SK2 N5
3T4L BZE 5 NOTER
3TJ= ANDN 5 #777
3W3W SMO 5
3WHG LDX 0 BNO(1)
3X36 SRL 0 12 [2 CHAR TERMINAL IDENTIFIER
3XGQ TXU 0 4
3Y2B BCC X7020CELL [BR IF A 7020 CELL MATCH FOUND
3YG2 SMO 5
3Y^L LDXC 5 0(1)
3^F= BCS N6
3^YW BRN N5 [ELSE TRY NEXT ONE
42DG X7020CELL
42Y6 LDCH 4 6 [LOAD INTERFACE NO SPECIFIED
43CQ BNZ 4 N9 [BR IF INTERFACE SPECIFIED
43XB LDN 5 0
44C2 BRN SCLUSTER [ESLE NO ATTS - DO CLUSTERING
44WL N9 SMO 5
45B= LDX 6 BTYPE(1)
45TW LDCH 6 6 [ISOLATE INTERFACE NO
46*G TXU 6 4
46T6 BCC XINT [BR IF RIGHT 7020 CELL
47#Q SMO 5
47SB LDCH 0 3(1)
48#2 ANDN 0 4
48RL BZE 0 N7 [BR IF NOT CLUSTER CONSOLE CELL
49?= SMO 5
49QW LDX 0 3(1)
4==G ANDN 0 #77 [INT NO OF OTHER HALF OF CONSOLE
4=Q6 TXU 0 4
4?9Q BCC XINT [BR IF MATCH NOW FOUND
4?PB N7 SMO 5
4#92 LDXC 0 4(1)
4#NL BCS NOTINTIDF [BR IF NO MORE CELLS FOR THIS 7020
4*8= SMO 5
4*MW LDXC 5 0(1) [LOAD POINTER TO NEXT CELL
4B7G BCC N8
4BM6 CALL 7 NEWREC
4C6Q N8 BZE 5 ZAZOOM [FUNNY IDF
4CLB ANDN 5 #777
4D62 BRN N9
4DKL XINT [CORRECT CELL FOUND
4F5= SMO 5
4FJW LDCH 6 BTYPE(1) [LOAD DEVICE TYPE
4G4G ADX 6 FX1
4GJ6 SMO 6
4H3Q LDX 6 TYPE7020-1 [CONVERT TO "LOCAL" DEVICE TYPE
4HHB CALL 7 SHUNTPCT
4J32 DCH 6 JSCEA(3) [STORE DEVICE TYPE IN CPAR BLOCK
4JGL SMO 5
4K2= LDXC 5 BATT(1) [LOAD POINTER TO ATTRIBUTION CELL
4KFW BCC N10
4K^G CALL 7 NEWREC
4LF6 N10
4LYQ BZE 5 SCLUSTER [BR TO CHECK CLUSTERING
4MDB ANDN 5 #777
4MY2 SMO 5
4NCL LDX 5 BTYPE(1) [CONSOLE PROPERTY WORD
4NX= BRN SCLUSTER [BR TO CHECK CLUSTERING
4PBW #
4PWG # THAT'S ALL FOR PCT PARAMETERS
4QB6 #
4QTQ # NOW FOR IPB IDENTIFIERS
4R*B #
4RT2 NOW4IPB
4S#L CALL 7 SHUNTIPB [FIND NEXT CPAR/AIPB BLOCK
4SS= BNG 3 SCLOSE [BR TO CLOSE IDF IF NO MORE TO DO
4T?W LDEX 4 JSCEB(3) [GEOG NO OF IPB (IF SPECIFIED)
4TRG LDX 6 JSCEA(3)
4W?6 ANDN 6 #7777 [IDENTIFIER NO
4WQQ LDN 5 0
4X=B CALL 7 NEWREC [ALWAYS EXITS +1
4XQ2 SEVEN +7 [NEVER OBEYED
4Y9L LDXC 5 BIPB(1) [BASE OF IPB CHAIN
4YP= BCC P1
4^8W P2
4^NG CALL 7 NEWREC
5286 P1
52MQ BZE 5 P88 [BR IF IPB NOT FOUND
537B ANDN 5 #777
53M2 SMO 5
546L LDX 0 0(1) [LOAD FPTR DOWN IPB CHAIN
54L= STO 0 AWORK4(2) [STORE IN AWORK4
555W SMO 5
55KG LDEX 7 BTYPE(1) [IPB GEOGRAPHIC NUMBER
5656 BNZ 4 P1A [BR IF SPECIFIC IPB WANTED
56JQ STO 6 AWORK2(2) [PRESERVE X6
574B CALL 6 XFINDPEREC [ELSE CHECK THIS ONE EXISTS
57J2 SMO FX2
583L LDX 6 AWORK2 [THEN RESTORE X6
58H= BNG 2 P7 [AND BR IF NOT
592W LTYPE 2,0 [IGNORE THIS IPB IF NOT ON
59GG SBN 0 #30
5=26 BNZ 0 P7 [ INSTALLATION
5=FQ LDX 2 FX2
5=^B BRN TRIDENT [BR TO SEARCH IDENTIFIER CHAIN
5?F2 P1A
5?YL TXU 7 4
5#D= BCC TRIDENT [BR IF CORRECT CELL FOUND
5#XW P3 SMO 5
5*CG LDXC 5 0(1) [OTHERWISE TRY NEXT ONE
5*X6 BCS P2
5BBQ BRN P1
5BWB TRIDENT [SEARCH DOWN IDENTIFIER CHAIN
5CB2 NGNC 0 1 [SET C
5CTL SMO 5
5D*= TXL 6 5(1) [TEST X6 AGAINST LARGEST IDENTIFIER
5DSW BCS P4 [BR IF FIT POSSIBLE
5F#G BNZ 4 NOUNITIDF [BR IF SPECIFIC IPB MENTIONED
5FS6 BRN P3 [BR TO TRY NEXT IPB
5G?Q P4
5GRB SMO 5
5H?2 LDXC 5 BLINE(1) [POINTER TO IDENTIFIER CHAIN
5HQL BCC P5
5J== P6
5JPW CALL 7 NEWREC
5K9G P5 BZE 5 P7 [BR IF IDENTIFIER NOT FOUND
5KP6 ANDN 5 #777
5L8Q SMO 5
5LNB TXU 6 BNO(1)
5M82 BCC TRANSMOGRIF [BR IF CORRECT IDENTIFIER CELL FOUND
5MML SMO 5
5N7= LDXC 5 0(1) [ELSE LOAD NEXT ONE
5NLW BCS P6
5P6G BRN P5
5PL6 P7
5Q5Q BNZ 4 NOUNITIDF [BR IF I NOT FOUND ON SPECIFIED UNIT
5QKB LDX 2 FX2
5R52 LDXC 5 AWORK4(2) [POINTER TO NEXT IPB CELL
5RJL BNZ 5 P2 [CARRY ON IF MORE IPB(S)
5S4= P88 [IPB NOT FOUND IN IDF
5SHW BZE 4 NOUNITIDF [BR IF NOT ESSENTIAL
5T3G BRN ZAZOOM
5TH6 TRANSMOGRIF
5W2Q BNZ 4 P8 [BR IF IPB SPECIFIED
5WGB SMO 5
5X22 LDEX 4 BTYPE(1) [ELSE REMEMBER IT
5XFL P8
5X^= SMO 5
5YDW LDCH 6 BTYPE(1) [LOAD BASIC DEVICE TYPE
5YYG ADX 6 FX1
5^D6 SMO 6 [CONVERT CONFIGURATION REPORT TYPE
5^XQ LDX 6 XCONFIG [TO BASIC DEVICE TYPE
62CB SMO 5
62X2 LDXC 5 BATT(1) [PTR TO ATTRIBUTION CELL
63BL BCC P9
63W= CALL 7 NEWREC
64*W P9
64TG BZE 5 P10
65*6 ANDN 5 #777
65SQ SMO 5
66#B LDX 5 BTYPE(1) [CONSOLE PROPERTY ATTRIBUTION WORD
66S2 P10
67?L CALL 7 SHUNTIPB [RELOCATE CPAR/AIPB BLOCK
67R= DCH 6 JSCEA(3) [BASIC DEVICE TYPE
68=W LDX 0 JSCEP(3)
68QG BNZ 0 P12 [BR IF IPB ALREADY LOCATED
69=6 DEX 4 JSCEB(3) [IPB GEOG NO
69PQ LDX 7 4
6=9B LDX 1 3
6=P2 CALL 6 XFINDPEREC [FIND IPB DEVICE LIST
6?8L BNG 2 P7 [BR IF NOT ON INSTALLATION
6?N= LTYPE 2,0
6#7W SBN 0 #30 [BR IF IPB NOT ON INSTALLATION
6#MG BNZ 0 P7
6*76 BNG 2 P7 [BR IF NOT ON INSTALLATION
6*LQ STO 2 JSCEP(3) [STORE DEVICE LIST POINTER
6B6B LDX 2 FX2
6BL2 P12
6C5L SCLUSTER [CHECK CLUSTERING
6CK= NOATTS
6CQD ... LDX 0 JSOURCE2(2)
6CXL ... BNG 0 SC1A
6D4S ... SLL 0 12
6D=2 ... BZE 0 OK
6DC8 ...SC1A
6DNC ... LDCT 0 #400
6DS# ... ANDX 0 JSOURCE2(2)
6DY9 ... BZE 0 SCMOP
6F27 ... BZE 5 NOTOK
6F46 HUNTMISB 1,APERI,CONSOLE [FIND HUIDGE BLOCK
6FHQ BNG 1 NOTOK [ERROR - NO NOMINATED CONSOLES
6G3B LDX 4 A1(1) [NO OF SIGNIFICANT WORDS
6GH2 SBN 4 2
6H2L LDCT 0 #200
6HG= ANDX 0 JSOURCE2(2)
6H^W BZE 0 SC1 [BR IF PCT CONSOLE
6JFG LDX 6 JSOURCE2(2)
6J^6 SLL 6 15
6KDQ SRL 6 3 [GEOG NO TO B0-11
6KYB LDX 0 JSOURCE1(2) [IDENTIFIER IN B12-23 OF B0
6LD2 BRN SC2
6LXL SC1
6MC= LDX 6 JSOURCE1(2) [TERMINAL IDENTIFIER TO B0-11
6MWW SLL 6 6
6NBG LDX 0 JSOURCE2(2)
6NW6 SRL 0 9
6P*Q ANDN 0 #777 [LINE NO TO B15-23
6PTB SC2 [CONSTRUCT X6 TO LOOK LIKE 1ST WORD
6Q*2 DSA 0 6 [OF HUIDGE ENTRY
6QSL STO 5 ACOMMUNE1(2) [X5 CONTAINS PROPERTY NO
6R#= LDX 0 BITS22LS
6RRW ANDS 0 ACOMMUNE1(2) [REMOVE B0,1
6S?G SC3
6SR6 SMO 4
6T=Q LDX 0 A1-1(1) [CONSOLE PROPERTY NUMBER
6TQB ANDX 0 BITS22LS
6W=2 TXU 0 ACOMMUNE1(2)
6WPL BCC THISONE [BR IF THIS IS THE NOM CONSOLE
6X9= SBN 4 1
6XNW BCT 4 SC3
6Y8G BRN NOCLUSIDF [NOT FOUND IN HUIDGE - ERROR
6YN6 THISONE
6^7Q SMO 4 [RIGHT PROPERTY .... BUT
6^MB TXU 6 A1(1)
7272 BCS NOCLUSIDF [... BR IF WRONG CONSOLE
72LL OK
736= CALL 7 SHUNTPCT [LOCATE CPAR/CPCT BLOCK
73KW NGN 7 1
745G BPZ 3 SC4 [BR IF PCT DEVICE
74K6 CALL 7 SHUNTIPB [ELSE LOCATE CPAR/AIPB
754Q SC4
75JB STO 5 JSCEC(3) [STORE CONSOLE PROPERTY NO
7642 NAME 3,CPAR,JSCE [AND RENAME BLOCK
76?S ... STOZ AWORK3(2) [VALID PARAMETER
76HL BNG 7 NEXTPARAM [BR IF WAS A PCT BLOCK
773= BRN NOW4IPB [BR IF IPB
773H ...SCMOP
773J ...
773K ... LDN 6 #400
773L ... ANDX 6 AWORK1(2)
773M ... BZE 6 OK
773N ... BZE 5 NOTOK
773S ... ANDX 5 BITS22LS
7745 ... STO 5 AWORK2(2)
774B ... LDX 6 JSOURCE1(2)
774M ... ANDN 6 #777
774Y ... LDN 5 0
7759 ... CALL 7 NEWREC
775G ... NULL
775R ... LDXC 5 BIPB(1)
7764 ... BCC SCM1
776* ...SCM2 CALL 7 NEWREC
776L ...SCM1 BZE 5 ZAZOOM
776Q ... ANDN 5 #777
776X ... SMO 5
7778 ... LDEX 7 BTYPE(1)
777F ... TXU 7 6
777Q ... BCC SCM3
7783 ... ANDN 5 #777
778# ... SMO 5
778K ... LDXC 5 0(1)
778W ... BCS SCM2
7797 ... BRN SCM1
779D ...SCM3
779P ... LDX 6 JSOURCE2(2)
77=2 ... ANDN 6 #7777
77=? ... SMO 5
77=J ... LDXC 5 BLINE(1)
77=T ... BCC SCM5
77?6 ...SCM6 CALL 7 NEWREC
77?C ...SCM5 BZE 5 ZAZOOM
77?N ... ANDN 5 #777
77?^ ... SMO 5
77#= ... TXU 6 BNO(1)
77#H ... BCC SCM7
77#S ... SMO 5
77*5 ... LDXC 5 0(1)
77*B ... BCS SCM6
77*M ... BRN SCM5
77*Y ...SCM7
77B9 ... SMO 5
77BG ... LDXC 5 BATT(1)
77BR ... BCC SCM8
77C4 ... CALL 7 NEWREC
77C* ...SCM8 BZE 5 NOTOK
77CL ... ANDN 5 #777
77CX ... SMO 5
77D8 ... LDX 5 BTYPE(1)
77DF ... ANDX 5 BITS22LS
77DQ ... TXU 5 AWORK2(2)
77F3 ... BCC OK
77F# ...
77GW NOTOK
782G NOCLUSIDF [INVALID CLUSTERING
78G6 CALL 7 SHUNTPCT [LOCATE CPCT BLOCK
78^Q NGN 7 1
79FB BPZ 3 SC5 [BR IF FOUND
79^2 CALL 7 SHUNTIPB [ELSE LOCATE AIPB BLOCK
7=DL SC5
7=Y= LDX 0 AWORK1(2)
7?CW ANDN 0 BNOCLUS
7?XG BZE 0 WRONGCLUS [BR TO REPORT ERROR IF WANTED
7#C6 LDCT 0 #600 [AND SET CLUSTER CHECK FAILED
7#WQ ORS 0 JSCEP(3) [MARKER
7*BB BRN SC4 [AND CARRY ON
7*W2 SCLOSE
7B*L LDX 0 AWORK1(2)
7BT= ANDN 0 BIDF
7C6L ... BZE 0 XFRCL [BR IF IDF NOT TO BE LEFT OPEN
7CD2 ... LDX 0 AWORK3(2)
7CPB ... BZE 0 UPPLUS1 [BR IF A VALID PARAM. EXISTS
7D2Q ...XFRCL MFREEALL FILE,FRRB [FREE ALL IDF CORE BLOCKS
7D#6 CLOSETOP [CLOSE THE IDF
7DRQ UPPLUS1
7F?B UPPLUS 1 [AND ESCAPE
7FR2 XBRK
7G=L UP [BREAK-IN WHILE OPENING THE IDF
7GQ= #
7H9W ZAZOOM
7HPG GEOERR 1,IDF TWIT
7J96 #
7JNQ WRONGCLUS [ INVALID CLUSTERING
7K8B LDX 1 FX1
7KN2 LDX 6 ZNOCLUS(1)
7L7L REPORT
7LM= CALL 7 SHUNTPCT [RELOCATE APPROPRIATE BLOCK
7M6W BNG 3 SHUNTIPB
7MLG LDX 4 JSCEQ(3)
7N66 SRL 4 12 [PARAMETER NUMBER
7NKQ FREECORE 3
7P5B LDN 5 0 [ANALYSIS LEVEL ZERO
7PK2 SPARANOX 4,5 [REACCESS PARAMETER
7Q4L ERRORX 6 [SEND ERROR MESSAGE
7QJ= UNIFREE [AND FREE CPB/CUNI BLOCK
7R3W BRN NEXTPARAM
7RHG NOUNITIDF
7S36 NOTINTIDF
7SGQ NOTER
7T2B LDX 1 FX1
7TG2 LDX 6 ZJNOPER(1)
7T^L BRN REPORT
7WF= NOLINE [ILLEGAL LINE NUMBER
7WYW LDX 1 FX1
7XDG LDX 6 ZILLINO(1)
7XY6 BRN REPORT
7YCQ #
7YXB XFINDPEREC
7^C2 # SUBROUTINES PUTS DEVICE LIST POINTER OF DEVICE WHOSE GEOG NO IS
7^WL # IN X7 IN X2.
82B= # LINK IN X6
82FB ...#UNS AV7900S
82JG ... FINDPERE 2,APGEOG,7,,AV7900 [FIND DEVICE LIST.(INCLUDE V7900 DLS)
82ML ...#UNS AV7900S
82QQ ...#SKI
82TW FINDPERE 2,APGEOG,7
83*G BRN (6)
83T6 #
84#Q NEWREC
84SB # THIS SUBROUTINE SWITCHES X1 TO POINT TO A NEW RECORD OF THE IDF
85#2 # THE RECORD IS READ DOWN INTO CORE IF NECESSARY
85RL # ON ENTRY, X5 CONTAINS THE CELL POINTER WITH B0 CLEARED. ON EXIT, X1
86?= # POINTS AT THE CELL SPECIFIED BY X5
86QW # LINK IN X7
87=G SBX 7 FX1
87Q6 COOR2 [HAVE A REST
889Q #
88PB # THIS IS PUT IN BECAUSE WE COULD OBEY AN AWFUL LOT OF INSTRUCTIONS
8992 # BEFORE CO-ORDINATING IN THE NORMAL COURSE OF AFFAIRS
89NL #
8=8= LDX 0 5
8=MW SRL 0 9 [RECORD NO REQUIRED
8?7G STO 0 ACOMMUNE3(2)
8?M6 LDX 1 FX2
8#6Q MXB 1 [GET POINTER TO NEW RECORD
8#LB ADX 7 FX1
8*62 EXIT 7 1 [EXIT+1 IF OK
8*KL SHUNTPCT
8B5= # HUNT CPAR/APCT BLOCK ON X3
8BJW # LINK IN X7
8C4G HUNTW 3,CPAR,CPCT
8CJ6 BRN (7)
8D3Q #
8DHB SHUNTIPB
8F32 # HUNT CPAR/AIPB BLOCK ON X3
8FGL # LINK IN X7
8G2= HUNTW 3,CPAR,AIPB
8GFW BRN (7)
8G^G #
8HF6 MENDAREA 45,K100PARIDF
8HYQ #END
^^^^ ...13165452000800000000