EXTEND866
(George Source)
Macros used: ACROSS, ALTLEN, CAPCA, CHAIN, CHECKEXT, COOR3, FINMOVE, FOUTMOVE, FREECORE, GEOERR, ILLEGAL, MENDAREA, MFINDEXOF, MFINDSUX, MHUNTW, OLPFIN1, PAIR, REPMON, SEGENTRY, SETNCORE, TESTMON, TOPCA1, UNPLUG
- EXTEND866.txt
22FL ...#SEG EXTEND70 [FRANK BLUNDELL 22^= #LIS K0EXTEND 23DW 8HEXTEND 23YG # 24D6 # THIS ROUTINE ANALYZES MODE #500 PERI 24XQ # ON ENTRY CURRENT ACTIVITY IS AOLPT 25CB # X5 MODE (#500) 25X2 # X6 ADDITIVE BITS 26BL # 26W= # IF THE EXTENSION IS NULL REPLIES ARE SET AND PROGRAM IS 27*W # RESTARTED 27TG # 28*6 # IF THE OPERATION IS CONTRACT A SCRATCH FILE IT IS CARRIED 28SQ # OUT IN THIS CHAPTER 29#B # 29S2 # IF NEITHER OF ABOVE ROUTINE GOES ACROSS 2=?L # 2=R= SEGENTRY K1EXTEND,QK1EXTEND 2?=W #DEF XCA=EVENT2 2?QG XM1 #777777 2#=6 XLINK PAIR PERION,1 2#PQ # 2*9B XMON LDX 7 XCA(2) [GET CONTROL AREA ADDRESS 2*P2 TOPCA1 XLINK(1) [TO PCA 2B8L REPMON 1 REPORT MONITORING REQUIRED 2BN= # 2C7W # 2CMG XRV TOPCA1 XLINK(1) [RESERVATION VIOLATION 2D76 UNPLUG 2DLQ ILLEGAL NOCA 2F6B # 2FL2 # 2G5L QK1EXTEND 2GK= #SKI K6EXTEND>199-199 2H4W ( 2HJG SBN 5 #500 2J46 BZE 5 XAA 2JHQ GEOERR 1,EXTMODE 2K3B XAA 2KH2 ) 2L2L LDN 7 5 2LG= CHECKEXT XCA(2),7,XRV,APETADDR(2),W,XA,HLOCK1 2L^W XA 2MFG LDX 4 6 [SAVE X6 2M^6 LDCT 6 6 2NDQ ORX 6 EWCHAN(2) 2NYB LDN 5 BBEXTEND [TYPE OF MONITORING 2PD2 TESTMON APETADDR(2),5,6,XMON [CHECK IF MONITORING REQUIRED 2PXL LDX 6 4 [RESTORE X6 2QC= LDX 3 XCA(2) 2QWW LDN 4 EWORK1(2) 2RBG LDX 2 APETADDR(2) 2RW6 FOUTMOVE 2,3,4,7,HLOCK1 [MOVE CONTROL OUT TO CA WORDS OF 2S*Q [ACTIVITY 2STB LDX 2 FX2 2T*2 LDX 0 EXMODE(2) 2TSL SBN 0 #200 2W#= BNZ 0 XB [JUMP IF NOT OPEN FOR READING 2WRW LDCT 0 #400 2X?G ORN 0 5 [SET OPEN FOR READING REPLY 2XR6 STO 0 EWORK2(2) 2Y=Q BRN XBA 2YQB XB LDX 0 EWORK4(2) 2^=2 ADN 0 7 2^PL NGN 4 #10 329= ANDX 0 4 [ROUND UP TO MULTIPLE OF 8 32NW STO 0 AWORK1(2) [AND SAVE 338G BZE 0 XC 33N6 BPZ 0 YA [JUMP IF EXTEND 347Q XC MFINDEXOF 1,EXNUM(2) 34MB LDEX 0 FIP+5(1) 3572 BZE 0 XD [JUMP IF NO AREAS,NULL CONTRACTION 35LL SBN 0 1 366= SLL 0 1 36KW LDX 7 0 375G SLL 0 1 37K6 ADX 7 0 [X7 POINTER TO LAST CELL 384Q LDX 0 EXMODE(2) 38JB SBN 0 #400 3942 BNZ 0 XE [JUMP IF NOT EOF MODE 39HL SMO 7 3=3= LDX 0 FDCELLS-1(1) 3=GW TXL 0 FIP+10(1) 3?2G BCS XF [JUMP IF CONTRACTION WOULD REMOVE 3?G6 [EOF BUCKET 3?^Q XE NGX 4 AWORK1(2) 3#FB LDX 3 FIP+8(1) 3#^2 ANDN 3 #77 3*DL DVS 3 3 [CONVERT BLOCKS TO BUCKETS 3*Y= #SKI K6EXTEND>199-199 3BCW ( 3BXG BZE 3 XG 3CC6 GEOERR 1,EXTBUK 3CWQ XG 3DBB ) 3DW2 [X4=BUCKETS TO BE REMOVED 3F*L SMO 7 3FT= LDX 0 FDCELLS+5(1) 3G#W SMO 7 3GSG SBX 0 FDCELLS-1(1) [X0=BUCKETS IN LAST AREA 3H#6 TXL 4 0 3HRQ BCS XF [J IF TOO MANY BUCKETS IN AREA 3J?B LDCT 0 #200 3JR2 ANDX 0 EXMARK(1) 3K=L BNZ 0 ZA [J IF SCRATCH FILE 3KQ= # 3L9W # CONTRACT A PERMANENT FILE OR EXTEND 3LPG # SET UP DATA IN GEXD AND GO TO APPROPRIATE ROUTINE 3M96 # 3MNQ YA SETNCORE GEXDLENX,3,EWDAS,GEXD 3N8B STOZ A1(3) [GETCORE FOR GEXD 3NN2 LDN 0 A1(3) [AND ZEROIZE 3P7L LDN 1 A1+1(3) 3PM= MOVE 0 GEXDLENX-1 3PPT ...#UNS ES2 3PSD ...( 3PX3 ... LDX 0 EXTRAPS(2) [TRANSFER TRAPS RECORD TO 3P^L ... STO 0 EXOTRAP(3) [GEXD FOR EXTEND ROUTINES 3Q49 ...) 3Q6W LDX 0 EWCHAN(2) 3QLG STO 0 EXCHNL(3) [CHANNEL 3R66 LDX 0 XCA(2) 3RKQ STO 0 CNR(3) [CONTROL AREA ADDRESS 3S5B LDX 0 EXNUM(2) 3SK2 STO 0 CEFN(3) [EXOFILE NUMBER 3T4L LDX 0 EXMODE(2) 3TJ= STO 0 EOPMODE(3) [OPEN MODE 3W3W LDCT 1 #200 3WHG STO 1 EMARK(3) ['NOT #1500' MARKER 3X36 SRC 6 7 3XGQ ORS 6 EMARK(3) [SET ADDITIVE BITS 3Y2B SBN 0 #600 3YG2 BNZ 0 YB 3Y^L LDCT 0 #400 3^F= ORS 0 EMARK(3) [SCRATCH FILE BIT 3^YW YB LDX 0 AWORK1(2) 42DG STO 0 BREQ(3) [BLOCKS REQUIRED 42Y6 BNG 0 YC [JUMP IF CONTRACT 43CQ MFINDEXOF 1,EXNUM(2) 43XB LDX 0 ASUSN(1) 44C2 STO 0 HMUNIT(3) [HOME AREA SERIAL NO. 44WL STO 0 EOFUNIT(3) 45B= LDEX 0 FIP+5(1) 45TW BZE 0 YD [JUMP IF NO AREAS 46*G SBN 0 1 46T6 SLL 0 1 47#Q LDX 7 0 47SB SLL 0 1 [POINTER TO LAST CELL 48#2 ADX 7 0 48RL SMO 7 49?= LDX 0 FDCELLS(1) 49QW STO 0 EOFUNIT(3) [STORE EOF SERIAL NUMBER 4==G YD LDX 0 EWORK5(2) 4=Q6 BNG 0 YE [J IF -VE SERIAL NUMBER 4?9Q SMO FX1 4?PB ANDX 0 XM1 [AND TO 6 OCTAL DIGITS 4#92 YE STO 0 CSNTAB(3) [AND STORE 4#NL YC CHAIN 3,APETADDR(2) [CHAIN GEXD AFTER CPA 4*8= TOPCA1 XLINK(1) [LEAVE AOLPT LINK TO K1PERION 4*MW UNPLUG 4B7G CAPCA EWDAS,GEXD [TO CPA WITH GEXD 4BM6 MHUNTW 3,EWDAS,GEXD 4C6Q LDX 0 BREQ(3) 4CLB BNG 0 YF [JUMP IF CONTRACT 4D62 ACROSS SCEX,1 4DKL YF ACROSS CONTRACT,1 4F5= # 4FJW # 4G4G # 4GJ6 # 4H3Q # CONTRACT A SCRATCH FILE 4HHB # 4J32 ZA STO 7 AWORK2(2) [LAST AREA POINTER 4JGL MFINDEXOF 1,EXNUM(2) 4K2= LDN 5 0 [COUNT OF AREAS 4KFW LDN 6 0 [TO ACCUMULATE BUCKETS 4K^G LDEX 3 FIP+5(1) [AREAS ON FILE 4LF6 ZD BZE 3 ZC [J IF NO MORE AREAS 4LYQ SMO 7 4MDB LDX 0 FDCELLS+5(1) 4MY2 SMO 7 4NCL SBX 0 FDCELLS-1(1) [X0=BUCKETS IN THIS AREA 4NX= ADX 6 0 4PBW TXL 4 6 4PWG BCS ZB [J IF THIS WOULD BE TOO MUCH TO REMOV 4QB6 ADN 5 1 4QTQ TXU 4 6 [JUMP IF EXACTLY ENOUGH 4R*B BCC ZC 4RT2 SBN 7 6 [UPDATE POINTER 4S#L SBN 3 1 [AND COUNT 4SS= BRN ZD 4T?W ZB SBX 6 0 [SUBTRACT BUCKETS FROM LAST AREA 4TRG ZC NGS 6 EWORK3(2) [BUCKETS REMOVED FOR REPLY 4W?6 STO 5 AWORK3(2) [COUNT OF AREAS 4WQQ BZE 5 ZE [JUMP IF NONE 4X=B ZQ SMO AWORK2(2) 4XQ2 LDX 6 FDCELLS(1) [GET SERIAL NO. OF UNIT HOLDING AREA 4Y9L ZG MFINDSUX 3,6 [FIND ASTUC 4YP= LDXC 0 CSCRATCH(3) 4^8W BCC ZF [JUMP IF NOT LOCKED OUT 4^NG ... COOR3 #41 [WAIT FOR NEXT SPRING CLEAN 5286 MFINDEXOF 1,EXNUM(2) 52MQ BRN ZG 537B ZF SMO AWORK2(2) 53M2 LDX 6 FDCELLS+1(1) 546L MPY 6 HBLOCK(3) 54L= SMO AWORK2(2) 555W ADX 7 FDCELLS+2(1) [CALCULATE START BLOCK 55KG LDN 6 HSCRATCH(3) 5656 [LOOK FOR CELL IN SCRATCH LIST 56JQ #SKI K6EXTEND>199-199 574B ( 57J2 BNZ 0 ZH 583L GEOERR 1,EXTSCCNT 58H= ZH 592W ) 59GG ZJ SMO 6 5=26 TXU 7 0 5=FQ BCC ZK [J IF ENTRY FOUND 5=^B ADN 6 1 5?F2 BCT 0 ZJ 5?YL GEOERR 1,LOSTSCRA 5#D= ZK SBN 0 1 5#XW BZE 0 ZLA [J NO ENTRIES TO MOVE 5*CG ZL SMO 6 [MOVE UP REST OF LIST 5*X6 LDX 7 1 5BBQ SMO 6 5BWB STO 7 0 5CB2 ADN 6 1 5CTL BCT 0 ZL 5D*= ZLA 5DSW LDX 0 CSCRATCH(3) 5F#G SBN 0 1 [UPDATE SCRATCH COUNT 5FS6 STO 0 CSCRATCH(3) 5G?Q LDX 6 BACK1(3) 5GRB BPZ 6 ZM [JUMP IF NOT DEAD 5H?2 BNZ 0 ZM [OR IF STILL AREAS ON THIS UNIT 5HQL FREECORE 3 [OTHERWISE FREE DEAD ASTUC 5J== MFINDEXOF 1,EXNUM(2) 5JPW BRN ZP 5K9G ZM LDN 6 HSCRATCH+8-A1 5KP6 ADX 6 CSCRATCH(3) 5L8Q TXL 6 ALOGLEN(3) 5LNB ... BCC ZP [J IF LESS THAN 8 SPARE WORDS 5M82 LDCT 0 #400 [SET LOCKOUT 5MML ORS 0 CSCRATCH(3) 5MXD ... SBN 6 8 5N7= ALTLEN 3,6 [ALTER ASTUC 5NLW MFINDEXOF 1,EXNUM(2) [REFIND EXOF 5P6G SMO AWORK2(2) 5PL6 LDX 6 FDCELLS(1) 5Q5Q MFINDSUX 3,6 [AND ASTUC 5QKB LDCT 0 #400 5R52 ERS 0 CSCRATCH(3) [UNSET LOCKOUT 5RJL ZP LDN 0 6 5S4= SBS 0 AWORK2(2) 5SHW BCT 5 ZQ [JUMP IF ANY MORE 5T3G ZE LDX 0 AWORK3(2) 5TH6 LDX 4 ALOGLEN(1) 5W2Q SLL 0 1 5WGB SBX 4 0 5X22 SLL 0 1 5XFL SBX 4 0 [UPDATE LENGTH OF EXOF 5X^= LDX 3 1 5YDW ALTLEN 3,4 [ALTER LENGTH OF EXOF 5YYG MFINDEXOF 1,EXNUM(2) 5^D6 LDEX 0 FIP+5(1) 5^XQ SBX 0 AWORK3(2) 62CB DEX 0 FIP+5(1) [UPDATE COUNT OF FILE AREAS 62X2 BNZ 0 ZR [J IF SOME AREA LEFT 63BL XDA LDN 6 0 [REPLIES IF NO AREAS 63W= LDX 5 ASUSN(1) 64*W BRN ZS 64TG ZR LDEX 0 FIP+5(1) 65*6 SBN 0 1 65SQ SLL 0 1 66#B LDX 4 0 66S2 SLL 4 1 67?L ADX 4 0 [POINTER TO LAST CELL 67R= SMO 4 68=W LDX 5 FDCELLS(1) [EOF SERIAL NUMBER 68QG SMO 4 69=6 LDX 6 FDCELLS+5(1) 69PQ SBN 6 1 [LAST LBN 6=9B LDX 0 EXMODE(2) 6=P2 SBN 0 #400 6?8L BNZ 0 ZS [J IF NOT EOF MODE 6?N= SBX 6 FIP+10(1) [SUBTRACT EOF 6#7W ADN 6 1 6#MG BNZ 6 ZS [J IF NON-ZERO RESULT 6*76 LDX 5 ASUSN(1) [OTHERWISE CSN=HOME UNIT 6*LQ ZS STO 6 EWORK2(2) 6B6B STO 5 EWORK5(2) [STORE REPLIES 6BL2 XBA LDX 4 XCA(2) 6C5L LDN 3 EWORK1(2) 6CK= LDN 6 5 6D4W LDX 2 APETADDR(2) 6DJG FINMOVE 2,4,3,6,HLOCK1 [MOVE IN REPLIES 6F46 LDX 1 FX1 6FHQ OLPFIN1 XLINK(1) [END OF PERI 6G3B # 6GH2 # 6H2L XF STOZ EWORK3(2) [ZEROISE BUCKETS REMOVED 6HG= BRN ZR 6H^W # 6JFG # 6J^6 XD STOZ EWORK3(2) [ZEROISE BUCKETS REMOVED 6KDQ BRN XDA 6KYB # 6LD2 MENDAREA 30,K99EXTEND 6LXL #END ^^^^ ...12407714000100000000