Trailing-Edge
-
PDP-10 Archives
-
decus_20tap4_198111
-
decus/20-0122/xpl.lib
There are 2 other files named xpl.lib in the archive. Click here to see a list.
DECLARE COUNT_COMPACT FIXED; /* COMPACTIFY CALLS */
COMPACTIFY:
PROCEDURE;
DECLARE I FIXED, J FIXED, K FIXED, L FIXED, ND FIXED;
DECLARE DX_SIZE LITERALLY '500';
DECLARE TRIED FIXED;
DECLARE DX (DX_SIZE) FIXED;
DECLARE TC FIXED, BC FIXED, DELTA FIXED;
DECLARE LOWER_BOUND FIXED INITIAL (0);
COUNT_COMPACT = COUNT_COMPACT + 1;
TRIED = 0;
DO WHILE 1;
/* FIRST WE MUST SET THE LOWER BOUND OF THE COLLECTABLE AREA */
IF LOWER_BOUND = 0 THEN LOWER_BOUND = FREEBASE;
ND = - 1;
/* FIND THE COLLECTABLE DESCRIPTORS */
DO I = 0 TO NDESCRIPT;
IF (DESCRIPTOR(I) & "FFFFF") >= LOWER_BOUND THEN
DO;
ND = ND + 1;
IF ND > DX_SIZE THEN
DO; /* WE HAVE TOO MANY COLLECTABLE STRINGS */
OUTPUT = '* * * NOTICE FROM COMPACTIFY: DISASTERIOUS ST
RING OVERFLOW. JOB ABANDONED. * * *';
OUTPUT, OUTPUT, OUTPUT = ''; /* CLEAR THE BUFFERS */
CALL EXIT;
END;
DX(ND) = I;
END;
END;
IF ND >= 0 THEN
DO;
/* SORT IN ASCENDING ORDER */
K, L = ND;
DO WHILE K <= L;
L = - 1;
DO I = 1 TO K;
L = I - 1;
IF (DESCRIPTOR(DX(L))&"FFFFF")>(DESCRIPTOR(DX(I))&"FFFFF") THEN
DO;
J = DX(L); DX(L) = DX(I); DX(I) = J;
K = L;
END;
END;
END;
/* MOVE THE ACTIVE STRINGS DOWN */
/* FIRST MAKE SURE THAT LOWER_BOUND ISN'T IN THE MIDDLE
OF SOME STRING */
IF TRIED = 0 THEN /* FIRST TIME AROUND, OR FULL TRY? */
DO;
LOWER_BOUND = DESCRIPTOR(DX(0)) & "FFFFF";
END;
FREEPOINT = LOWER_BOUND;
TC, DELTA = 0;
BC = 1; /* SETUP INITIAL CONDITION */
DO I = 0 TO ND;
J = DESCRIPTOR(DX(I));
IF (J & "FFFFF") - 1 > TC THEN
DO;
IF DELTA > 0 THEN
DO K = BC TO TC;
COREBYTE (K-DELTA) = COREBYTE (K);
END;
FREEPOINT = FREEPOINT + TC - BC + 1;
BC = J & "FFFFF";
DELTA = BC - FREEPOINT;
END;
DESCRIPTOR(DX(I)) = J - DELTA;
L = (J & "FFFFF") + SHR (J,27) - 1;
IF TC < L THEN TC = L;
END;
DO K = BC TO TC;
COREBYTE(K-DELTA) = COREBYTE (K);
END;
FREEPOINT = FREEPOINT + TC - BC + 1;
END;
IF FREELIMIT - FREEPOINT < 256 THEN
DO;
IF TRIED THEN
DO;
OUTPUT = '* * * NOTICE FROM COMPACTIFY: INSUFFICIENT STRING
SPACE. JOB ABANDONED. * * *';
OUTPUT, OUTPUT, OUTPUT = ''; /* FLUSH BUFFERS */
CALL EXIT; /* FORCE ABEND */
END;
ELSE
DO;
LOWER_BOUND = 0; /* FORCE COMPLETE GARBAGE COLLECTION */
TRIED = 1;
END;
END;
ELSE
DO;
LOWER_BOUND = FREEPOINT;
RETURN;
END;
END; /* OF THE DO WHILE 1 LOOP */
/* THE HOPE IS THAT WE WON'T HAVE TO COLLECT ALL THE STRINGS EVERY TIME */
END COMPACTIFY;