{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: COREALLJ865)}}
====== COREALLJ865 ======
(George Source)
**Macros used:** [[george:macro:BLOCKMOVE|BLOCKMOVE]], [[george:macro:BXL|BXL]], [[george:macro:COOR2|COOR2]], [[george:macro:DERING|DERING]], [[george:macro:ENRING|ENRING]], [[george:macro:FINDCORE|FINDCORE]], [[george:macro:FINDPUC|FINDPUC]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GSCAN|GSCAN]], [[george:macro:NAME|NAME]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:TESTTP|TESTTP]], [[george:macro:UNLOCK|UNLOCK]], [[george:macro:UP|UP]]
22FL #SEG COREALLJ [RUTH PORTER CENT
22^= #OPT K0COREALLJ=0
23DW #OPT K6COREALLJ=100
23YG #OPT TRACE=K6COREALL
24D6 #LIS K0COREALLJ>K0COREALL
24XQ 8HCOREALLJ
25CB [THIS SEGMENT DOES ACTUAL MOVE OF PROGRAM FROM
25X2 [OLD POSITION TO NEW GOT BY COREALLF
26BL [
26W= SEGENTRY K1COREALLJ
27*W FINDCORE 3
27TG UNLOCK 3
28*6 LDX 1 3
28SQ STOZ ARINGNO(1)
29#B LDX 4 ACOMMUNE1(2)
29S2 ANDN 4 4 [NON ZERO IF OLD & NEW SITES OVERLAP
2=?L LDX 6 1
2=R= DERING 1 [DECHAIN THE BLOCK
2?=W LDX 1 ACOMMUNE2(2) [ADDRESS OF THE OLD SITE
2?QG LDX 5 ASIZE(1)
2#=6 LDX 7 ACOMMUNE4(2) [DISTANCE PROGRAM BEING MOVED
2#PQ LDX 2 1
2*9B UHUNT LDX 2 BPTR(2) [FIND THE PCA FROM AOBJPROG BLOCK
2*P2 LDCH 0 ATYPE(2)
2B8L SBN 0 APET/64
2BN= BNZ 0 UHUNT
2C7W SBS 7 ADTM(2) [UPDATE EXEC DATUM & LIMIT WORDS
2CMG SBS 7 ALMT(2)
2D76 SBS 7 ADATUM(2) [ AND GEORGE'S VERSION
2DLQ TESTTP 2,UTRUS [IF RCTP, X2-> THE TP PCA
2F6B BRN UNOTP
2FL2 UTRUS FINDPUC 2,2 [IF RCTP,FIND THE PUC PCA
2G5L SBS 7 ADTM(2)
2GK= SBS 7 ALMT(2)
2H4W SBS 7 ADATUM(2)
2HJG UNOTP
2J46 #SKI TRACE>99-99
2JHQ GSCAN JOBNO(2),PROGMOVD
2K3B SMO FX2
2KH2 LDX 1 ACOMMUNE2 [ADDRESS OF THE OLD SITE
2L2L LDX 2 6 [ADDRESS OF THE NEW SITE
2L5Q ...#UNS CA1D
2L8W ... LDX 3 CA1D
2L#2 ...#UNS CA1D
2LC6 ...#SKI
2LG= LDN 3 A1D
2L^W BLOCKMOVE [TRANSFER RED TAPE & RINGS
2MFG [ *** NB SIZE & LOGLEN OF NEW SITE OVERWRITTEN
2M^6 SMO FX2
2NDQ LDX 1 ACOMMUNE2 [ADDRESS OF OLD SITE
2NYB BNZ 4 ULAP [J IF OLD & NEW SITES OVERLAP
2PD2 NAME 1,AOBJPROG,BHCOPY [ ELSE RENAME OLD SITE
2PXL STOZ ARINGNO(1) [ SET RING WD-RINGS TRANSFERRED TO
2QC= [ NEW BLOCK BY BLOCKMOVE
2QWW ENRING 1,6 [ AND CHAIN AFTER NEW ONE
2RBG LDX 3 ACOMMUNE2(2) [ADDRESS OF OLD SITE
2RW6 LDX 4 6 [ADDRESS OF NEW SITE
2S*Q BRN UCOP
2STB ULAP LDX 2 6 [IF THERE IS OVERLAP, AMALGAMATE THE
2T*2 ADS 7 ASIZE(2) [ BLOCKS - ASSUMES AOBJPROG BLOCKS
2TSL ADS 7 ALOGLEN(2) [ HAVE NO FAG ENDS
2W#= LDX 3 1 [ADDRESS OF OLD SITE
2WRW LDX 4 6 [ADDRESS OF NEW SITE
2X?G LDX 1 FX1
2XR6 LDX 2 FX2
2XSN ...#UNS CA1D
2XW= ...(
2XXS ...UCOP ADX 3 CA1D
2X^B ... ADX 4 CA1D
2Y2Y ... SBX 5 CA1D
2Y4G ...)
2Y64 ...#UNS CA1D
2Y7L ...#SKI
2Y98 ...(
2Y=Q UCOP ADN 3 A1D
2YQB ADN 4 A1D
2^=2 SBN 5 A1D
2^FS ...)
2^PL CALL 7 UCOPY [COPY PROGRAM TO NEW SITE
329= LDX 0 ACOMMUNE1(2)
32NW ANDN 0 4
338G BNZ 0 UONEB [J IF BLOCKS WERE AMALGAMATED
33N6 LDX 1 ACOMMUNE2(2) [ELSE FREE OLD SITE
347Q BRN USUCX
34MB UONEB [WE FREE THE FAG END OF THE NEW SITE
3572 LDX 1 6 [ADDRESS OF NEW SITE
35LL LDX 7 ACOMMUNE4(2)
366= SBS 7 ALOGLEN(1)
36KW SBS 7 ASIZE(1) [DECREMENT BLOCK BY SIZE OF FAG END
375G ADX 1 ASIZE(1) [ ADDRESS OF FLAG END
37K6 STO 1 FPTR(1) [SET UP RED TAPE & FREE IT
384Q STO 1 BPTR(1)
38JB STO 7 ASIZE(1)
3942 STOZ AFLAG(1)
39HL STOZ ATYPE(1)
3=3= STOZ ARINGNO(1)
3=GW USUCX
3?2G FREECORE 1
3?G6 UP
3?^Q [UCOPY COPIES [X5] WORDS FROM X3 TO X4, COOR2-ING EVERY 2K
3#FB [ ENTERED X1=FX1,X2=FX2,X3,4,5 AS ABOVE , LINK X7
3#^2 [ EXIT X1=FX1,X2=FX2, NEXT WORD WOULD HAVE BEEN TRANSFERED FROM X3+X5 TO
3*DL [ X4+X5
3*Y= [
3BCW UCOPY SBX 7 FX1
3BXG UCOP1 LDN 0 4
3CC6 UCOP2 BXL 5 B513,UCOP3 [J IF < 513 WORDS STILL TO TRANSFER
3CWQ MOVE 3 0 [ELSE MOVE 512 WORDS
3DBB ADN 3 512
3DW2 ADN 4 512
3F*L SBN 5 512
3FT= BCT 0 UCOP2
3G#W COOR2 [TAKE A BREATHER EVERY 2K
3GSG BRN UCOP1
3H#6 UCOP3 SMO 5 [MOVE RESIDUE
3HRQ MOVE 3 0
3J?B ADX 7 FX1
3JR2 EXIT 7 0
3K=L #END
^^^^ ...641345260008