COREALLJ865
(George Source)
Macros used: BLOCKMOVE, BXL, COOR2, DERING, ENRING, FINDCORE, FINDPUC, FREECORE, GSCAN, NAME, SEGENTRY, TESTTP, UNLOCK, UP
- COREALLJ865.txt
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