{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: EXTEND866)}}
====== EXTEND866 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ALTLEN|ALTLEN]], [[george:macro:CAPCA|CAPCA]], [[george:macro:CHAIN|CHAIN]], [[george:macro:CHECKEXT|CHECKEXT]], [[george:macro:COOR3|COOR3]], [[george:macro:FINMOVE|FINMOVE]], [[george:macro:FOUTMOVE|FOUTMOVE]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:ILLEGAL|ILLEGAL]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFINDEXOF|MFINDEXOF]], [[george:macro:MFINDSUX|MFINDSUX]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:OLPFIN1|OLPFIN1]], [[george:macro:PAIR|PAIR]], [[george:macro:REPMON|REPMON]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:TESTMON|TESTMON]], [[george:macro:TOPCA1|TOPCA1]], [[george:macro:UNPLUG|UNPLUG]]
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