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