PARIDF8
(George Source)
Macros used: CLOSETOP, COOR2, ERRORX, FREECORE, GEOERR, HUNTMISB, HUNTW, IDFOPEN, LTYPE, MENDAREA, MFREEALL, MXB, NAME, SEGENTRY, SPARANOX, UNIFREE, UP, UPPLUS
- PARIDF8.txt
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