DataMuseum.dk

top - metrics - download

    Length: 13952 (0x3680)
    Types: TextFile
    Names: »RECREATE.PLI«

└─⟦57f0389e8⟧ Bits:30005761 SW1611 Access Manager v. 1.0
    └─⟦this⟧ »RECREATE.PLI« 

TextFile

RECREATE:
	PROC OPTIONS (MAIN);

/* :::::::::::::::::::::::::::::::::::::::::::::::::::::::::

	RECREATE PROGRAM  VERSION 1.02  03/03/83
	   REQUIRES AM86BUF = 4844 (decimal) BYTES

   ::::::::::::::::::::::::::::::::::::::::::::::::::::::::: */


%REPLACE
	MAX_REC_LEN BY 1024,
	MAX_KEY_LEN BY 48,
	NAME_LEN BY 14,
	MAX_NO_KEYS BY 9,
	MAX_NO_KEY_PARTS BY 5;

%REPLACE
	YES BY 1,
	NO  BY 0,
	BUFFER_SIZE BY 4844,
	MAX_SORT BY 1500,
	MAX_SPACE BY 10000,
	END_DATA_FILE BY 53,
	INVALID_RECORD BY 52,
	CORRUPT_DATA BY 70,
	END_INDEX_FILE BY 23,
	CORRUPT_INDEX BY 40;

%INCLUDE 'AM86EXTR.PLI';

DCL
	(DRNL,DRNH,DEL_PTRL,DEL_PTRH,NO_DELL,NO_DELH,UTLL,UTLH) FIXED,
	(XFILE,NLOCK,FILE_NO,NO_SORT,DUMMY,NO_READ) FIXED,
	1 SORT_DRN(MAX_SORT),
		2 LSW FIXED,
		2 MSW FIXED,
	LINK(MAX_SORT) FIXED,
	KEYVAL(MAX_SPACE) CHAR(1),
	SPACES CHAR(MAX_KEY_LEN) STATIC INIT(
		'                                                '),
	INDEX_NAME(MAX_NO_KEYS) CHAR(NAME_LEN) VAR,
	(KEY_LEN,KEY_POS) (9,0:MAX_NO_KEY_PARTS) FIXED,
	(AUTO_SUFFIX,NO_KEY_PARTS,KEY_TYPE) (MAX_NO_KEYS) FIXED,
	BLANK_KEY_TO_NULL(MAX_NO_KEYS) CHAR(1);

DCL
	REC_PAR CHAR(NAME_LEN) VAR,
	REC_FILE FILE,
	(NO_DATA_FILES,NODE_SECTORS) FIXED,
	(TERMINAL,ERROPT,TIMOUT) FIXED,
	(NO_BUFFERS,NO_FILES,NO_KEYS,BUFFER_SPACE) FIXED;

DCL
	FILE_NAME CHAR(NAME_LEN) VAR,
	(REC_LEN,BEG_REC,KEY,PART) FIXED,
	INPBUF(MAX_REC_LEN) CHAR(1),
	INPBUF_PTR POINTER,
	1 LNKBUF BASED (LNKBUF_PTR),
		2 DEL_FLD CHAR(1),
		2 LSW FIXED,
		2 MSW FIXED,
	LNKBUF_PTR POINTER,
	1 HDRBUF BASED (HDRBUF_PTR),
		2 VAL(6) FIXED,
		2 FLG CHAR(1),
	HDRBUF_PTR POINTER,
	DEL_FLG CHAR(1),
	DEL_NUM FIXED(7) BASED (DEL_NUM_PTR),
	DEL_NUM_PTR POINTER,
	RET_CHR CHAR(1) STATIC INIT('^M'),
	DFILE FIXED;

PUT SKIP LIST ('Enter recreate parameter file name:');
GET LIST (REC_PAR);

OPEN FILE (REC_FILE) TITLE(REC_PAR);

GET FILE (REC_FILE) LIST (NO_DATA_FILES,NODE_SECTORS);

DEL_NUM_PTR = ADDR(DEL_FLG);
DEL_NUM = -1;
XFILE = 4;
NLOCK = 0;
TERMINAL = -1;
ERROPT = YES;
TIMOUT = 2;
TERMINAL = INTUSR(TERMINAL,ERROPT,TIMOUT);

BUFFER_SPACE = BUFFER_SIZE - 2 * 36;	/* assumes only one key file and 
					   one data file open at the same 
					   time.
					 */
NO_BUFFERS = DIVIDE(BUFFER_SPACE,NODE_SECTORS * 128 + 52,15);
IF NO_BUFFERS > 18 THEN NO_BUFFERS = 18;

NO_KEYS = 1;
NO_FILES = 1;
IF SETUP(NO_BUFFERS,NO_KEYS,NODE_SECTORS,NO_FILES) ü= 0 THEN
	DO;
	PUT SKIP LIST ('Illegal SETUP parameters.');
	CALL ABANDON();
	END;

DO DFILE = 1 TO NO_DATA_FILES;
	CALL REBUILD();
	PUT SKIP;
END;

PUT SKIP LIST ('Normal Termination.');
STOP;


ABANDON:
	PROC;

	PUT SKIP LIST ('Rebuild Aborted!');
	CLOSE FILE (REC_FILE);
	STOP;

END ABANDON;

INC_4_BYTE:
	PROC (LSW,MSW);
DCL
	(LSW,MSW) FIXED;

	LSW = LSW + 1;
	IF LSW = 0 THEN
		MSW = MSW + 1;
	RETURN;
END INC_4_BYTE;

REBUILD:
	PROC;
DCL
	REDO_DATA FIXED;

	GET FILE (REC_FILE) LIST (FILE_NAME,REC_LEN,NO_KEYS,BEG_REC);

	IF NO_KEYS > MAX_NO_KEYS THEN
		DO;
		PUT SKIP EDIT ('Error in ',REC_PAR,' for data file ',
			FILE_NAME,'More than ',MAX_NO_KEYS,
			' key files requested.')
			(4A,SKIP,A,F(2),A);
		CALL ABANDON();
		END;

	IF REC_LEN > MAX_REC_LEN THEN
		DO;
		PUT SKIP EDIT ('Error in ',REC_PAR,' for data file ',
			FILE_NAME,'Record length > ',MAX_REC_LEN)
			(4A,SKIP,A,F(7));
		CALL ABANDON();
		END;

	IF NO_KEYS > 0 THEN
		DO KEY = 1 TO NO_KEYS;
			GET FILE (REC_FILE) LIST (INDEX_NAME(KEY),
			   	KEY_LEN(KEY,0),KEY_TYPE(KEY),AUTO_SUFFIX(KEY),
			   	NO_KEY_PARTS(KEY),BLANK_KEY_TO_NULL(KEY));
			IF BLANK_KEY_TO_NULL(KEY) = 'y' THEN
			   	BLANK_KEY_TO_NULL(KEY) = 'Y';
			IF NO_KEY_PARTS(KEY) < 1 ø NO_KEY_PARTS(KEY) >
			   	MAX_NO_KEY_PARTS THEN CALL KEY_ERROR;
			GET FILE (REC_FILE) LIST ((KEY_POS(KEY,PART),KEY_LEN(
			   	KEY,PART) DO PART = 1 TO NO_KEY_PARTS(KEY)));
		END;

	REDO_DATA = REBUILD_DATA();

	IF REDO_DATA = 2 THEN
		PUT SKIP EDIT ('Data file ',FILE_NAME,' could not be locked.')
			 (3A);

	IF REDO_DATA = 3 THEN
		PUT SKIP EDIT ('Data file ',FILE_NAME,' is apparently empty.')
			(3A);

	IF REDO_DATA < 0 THEN
		PUT SKIP EDIT ('Unanticipated AM86 Error #',-REDO_DATA,
			' while processing ',FILE_NAME)
			(A,F(4),2A);

	IF REDO_DATA < 0 ø REDO_DATA > 1 THEN
		DO;
		PUT SKIP LIST ('No rebuild performed.');
		RETURN;
		END;

	CALL REBUILD_INDICES(REDO_DATA);

	PUT SKIP EDIT ('Rebuild for ',FILE_NAME,' completed.') (3A);
	RETURN;

KEY_ERROR:
	PROC;

	PUT SKIP EDIT ('Error in ',REC_PAR,' for data file ',FILE_NAME,
		' with key file ',INDEX_NAME(KEY),
		'Number of key parts must satisfy -','1 <= # Parts <= ',
		MAX_NO_KEY_PARTS) (6A,SKIP,A,SKIP(2),A,F(3));
	CALL ABANDON();
END KEY_ERROR;

END REBUILD;

REBUILD_DATA:
	PROC RETURNS (FIXED);
DCL
	(TEMP,STATUS) FIXED;

	STATUS = 0;
	FILE_NO = -1;
	FILE_NO = OPNDAT(FILE_NO,XFILE,FILE_NAME,REC_LEN);

	IF ERRCOD() = END_DATA_FILE THEN
		DO;
		DUMMY = CLSDAT(FILE_NO);
		RETURN(3);
		END;

	IF ERRCOD() = CORRUPT_DATA THEN
		DO;
		STATUS = 1;
		FILE_NO = OPRDAT(FILE_NO,XFILE,FILE_NAME,REC_LEN);
		END;

	IF STATUS = 0 & ERRCOD() ü= 0 THEN
		DO;
		TEMP = ERRCOD();
		DUMMY = CLSDAT(FILE_NO);
		RETURN (-TEMP);
		END;

	IF LOKCOD() ü= 0 THEN
		DO;
		DUMMY = CLSDAT(FILE_NO);
		RETURN(2);
		END;

	IF BEG_REC = 0 THEN
		BEG_REC = DIVIDE(128 + REC_LEN -1,REC_LEN,15) + 1;
	INPBUF_PTR = ADDR(INPBUF(1));
	LNKBUF_PTR = INPBUF_PTR;
	HDRBUF_PTR = INPBUF_PTR;

	IF STATUS = 0 THEN
		DO;
		DUMMY = CLSDAT(FILE_NO);
		PUT SKIP EDIT ('No need to modify ',FILE_NAME) (2A);
		RETURN(0);
		END;

/*
	DATA FILE IS CORRUPTED. MUST BE REBUILT.
 */

	PUT SKIP EDIT ('Rebuilding data file ',FILE_NAME) (2A);

	DRNL = BEG_REC;
	DRNH = 0;
	DEL_PTRL = 0;
	DEL_PTRH = 0;
	NO_DELL = BEG_REC - 1;	/* allowance for header record(s)	*/
	NO_DELH = 0;

READ_LOOP:

	CALL SETDAT(DRNH);
	IF READAT(FILE_NO,DRNL,INPBUF_PTR) = END_DATA_FILE THEN
		GOTO END_OF_FILE;

	IF ERRCOD() ü= 0 THEN
		DO;
		TEMP = ERRCOD();
		DUMMY = CLSDAT(FILE_NO);
		RETURN(-TEMP);
		END;

	PUT SKIP EDIT (FILE_NAME,DRNL,DRNH) (A,2F(5));

	IF INPBUF(1) = DEL_FLG THEN
		DO;
		CALL WRITE_DELETE_LINK();
		CALL INC_4_BYTE(NO_DELL,NO_DELH);
		END;

	CALL INC_4_BYTE(DRNL,DRNH);
	GOTO READ_LOOP;

END_OF_FILE:

	PUT SKIP EDIT (FILE_NAME,' is reorganized. Now rebuild index files.')
		(2A);

	IF CLSDAT(FILE_NO) ü= 0 THEN
		DO;
		PUT SKIP EDIT (
			'Could not close data file (to recreate header)',
			FILE_NAME) (2A);
		CALL ABANDON();
		END;

	CALL RECREATE_HEADER();
	RETURN(1);


TEST:
	PROC (LSW,MSW) RETURNS (FLOAT);
DCL
	(LSW,MSW) FIXED,
	(TL,TH) FLOAT;

	TL = LSW;
	IF TL < 0 THEN
		TL = TL + 65536.;
	RETURN(TL + TH * 65536.);
END TEST;

WRITE_DELETE_LINK:
	PROC;

	LNKBUF.DEL_FLD = DEL_FLG;
	LNKBUF.LSW = DEL_PTRL;
	LNKBUF.MSW = DEL_PTRH;

	CALL SETDAT(DRNH);
	IF WRTDAT(FILE_NO,DRNL,LNKBUF_PTR) ü= 0 THEN
		DO;
		PUT SKIP EDIT ('Could not rewrite deleted record.',
			'Data file ',FILE_NAME,' (',DRNL,DRNH,')')
			(A,SKIP,3A,2F(6),A);
		CALL ABANDON();
		END;

	DEL_PTRL = DRNL;
	DEL_PTRH = DRNH;

	RETURN;
END WRITE_DELETE_LINK;

RECREATE_HEADER:
	PROC;
DCL
	TEMP FIXED,
	HDR_FILE FILE;

	OPEN FILE (HDR_FILE) TITLE(FILE_NAME) DIRECT UPDATE ENV(F(128));

	DRNL = DRNL - 1;
	IF DRNL = 0 THEN
		DRNH = DRNH - 1;	/* DRN = file size */

	HDRBUF.VAL(5) = DRNL;
	HDRBUF.VAL(6) = DRNH;

	DRNL = DRNL - NO_DELL;
	DRNH = DRNH - NO_DELH;		/* DRN = file utl */
	IF TEST(DRNL,DRNH) > TEST(HDRBUF.VAL(5),HDRBUF.VAL(6)) THEN
		DRNH = DRNH - 1;
	HDRBUF.VAL(3) = DRNL;
	HDRBUF.VAL(4) = DRNH;

	HDRBUF.VAL(1) = DEL_PTRL;
	HDRBUF.VAL(2) = DEL_PTRH;

	HDRBUF.FLG = ASCII(0);
	DO TEMP = 14 TO 128;
		INPBUF(TEMP) = ' ';
	END;

	WRITE FILE (HDR_FILE) FROM (HDRBUF) KEYFROM(0);

	CLOSE FILE (HDR_FILE);
	RETURN;
END RECREATE_HEADER;
	
END REBUILD_DATA;

REBUILD_INDICES:
	PROC (REDO_DATA);
DCL
	(KEY_NO,KEY,TEMP,REDO_DATA) FIXED;

	IF NO_KEYS < 1 THEN RETURN;

	FILE_NO = -1;
	FILE_NO = OPNDAT(FILE_NO,XFILE,FILE_NAME,REC_LEN);
	IF ERRCOD() ü= 0 ø LOKCOD() ü= 0 THEN
		DO;
		PUT SKIP EDIT ('Could not attempt index rebuild.',
			'Error/Lock Codes...',ERRCOD(),LOKCOD())
			(A,SKIP,A,2F(5));
		DUMMY = CLSDAT(FILE_NO);
		RETURN;
		END;

	DO KEY = 1 TO NO_KEYS;
		KEY_NO = -1;
		KEY_NO = OPNIDX(KEY_NO,INDEX_NAME(KEY),KEY_LEN(KEY,0),
			KEY_TYPE(KEY),AUTO_SUFFIX(KEY));

		IF ERRCOD() = 0 & REDO_DATA = 0 THEN
			DO;
			TEMP = NOKEYS(KEY_NO);
			IF TEMP ü= 0 ø DATVAL() ü= 0 THEN
				DO;
				PUT SKIP EDIT (INDEX_NAME(KEY),' is OK as is.',
				' No rebuild performed.') (3A);
				GOTO SKIP_INDEX;
				END;
			END;

		IF ERRCOD() ü= 0 & ERRCOD() ü= CORRUPT_INDEX & ERRCOD() ü=
		    END_INDEX_FILE THEN
			DO;
			PUT SKIP LIST ('Unanticipated Error with ');
			CALL KEY_ERROR();
			GOTO SKIP_INDEX;
			END;

		IF ERRCOD() = CORRUPT_INDEX THEN
			KEY_NO = OPRIDX(KEY_NO,INDEX_NAME(KEY),KEY_LEN(KEY,0),
				KEY_TYPE(KEY),AUTO_SUFFIX(KEY));

		IF ERAIDX(KEY_NO) ü= 0 THEN
			DO;
			PUT SKIP LIST ('Could not erase old ');
			CALL KEY_ERROR();
			GOTO SKIP_INDEX;
			END;

		KEY_NO = -1;
		KEY_NO = OPNIDX(KEY_NO,INDEX_NAME(KEY),KEY_LEN(KEY,0),
			KEY_TYPE(KEY),AUTO_SUFFIX(KEY));
		IF ERRCOD() ü= 0 THEN
			DO;
			PUT SKIP LIST ('Could not re-open ');
			CALL KEY_ERROR();
			GOTO SKIP_INDEX;
			END;

		CALL SORT_SETUP(KEY);
		CALL SORT_READ(KEY,KEY_NO);

SKIP_INDEX:

		DUMMY = CLSIDX(KEY_NO);
	END;

	DUMMY = CLSDAT(FILE_NO);
	RETURN;

KEY_ERROR:
	PROC;

	PUT SKIP EDIT (INDEX_NAME(KEY),' Error:  #',ERRCOD(),'Index not rebuilt.')
		(2A,F(4),SKIP,A);
	RETURN;
END KEY_ERROR;

SPACE:
	PROC (FLDLEN) RETURNS (CHAR(MAX_KEY_LEN) VAR);
DCL
	FLDLEN FIXED;

	RETURN(SUBSTR(SPACES,1,FLDLEN));
END SPACE;

SORT_SETUP:
	PROC (KEY);
DCL
	KEY FIXED;

	NO_SORT = DIVIDE(MAX_SPACE - MAX_KEY_LEN,KEY_LEN(KEY,0) + 1,15);
	IF NO_SORT > MAX_SORT THEN
		NO_SORT = MAX_SORT;
	RETURN;
END SORT_SETUP;

PUT_KEYVAL:
	PROC (I,KEY);
DCL
	KEY_VALUE CHAR(MAX_KEY_LEN) VAR,
	(I,KEY) FIXED;

DCL
	TMP_I FIXED,
	TMPBUF CHAR(MAX_KEY_LEN) BASED (TMP_VALUE_PTR),
	TMP_VALUE CHAR(MAX_KEY_LEN) VAR BASED(TMP_VALUE_PTR),
	TMP_VALUE_PTR POINTER;

	KEY_VALUE = '';
	DO TMP_I = 1 TO NO_KEY_PARTS(KEY);
		TMP_VALUE_PTR = ADDR(INPBUF(KEY_POS(KEY,TMP_I)));
		KEY_VALUE = KEY_VALUE øø SUBSTR(TMPBUF,1,
			KEY_LEN(KEY,TMP_I));
	END;

	IF BLANK_KEY_TO_NULL(KEY) = 'Y' & KEY_VALUE = SPACE(LENGTH(
	    KEY_VALUE)) THEN	
		KEY_VALUE = '';

	TMP_I = (I - 1) * (KEY_LEN(KEY,0) + 1) + 1;
	TMP_VALUE_PTR = ADDR(KEYVAL(TMP_I));
	TMP_VALUE = KEY_VALUE;
	RETURN;
END PUT_KEYVAL;

GET_KEYVAL:
	PROC (I,KEY) RETURNS (CHAR(MAX_KEY_LEN) VAR);
DCL
	(I,KEY) FIXED,
	TMP_I FIXED,
	TMP_VALUE CHAR(MAX_KEY_LEN) VAR BASED(TMP_VALUE_PTR),
	TMP_VALUE_PTR POINTER;
			
	TMP_I = (I - 1) * (KEY_LEN(KEY,0) + 1) + 1;
	TMP_VALUE_PTR = ADDR(KEYVAL(TMP_I));
	RETURN(TMP_VALUE);
END GET_KEYVAL;


ENTRY_ERROR:
	PROC (KEY_NO,LSW,MSW);
DCL
	(KEY_NO,LSW,MSW) FIXED;

	PUT SKIP EDIT (' Error:  #',ERRCOD(),' (rec#',LSW,MSW,')')
		(A,F(4),A,2F(6),A);
	PUT SKIP LIST ('during index rebuild.');
	DUMMY = CLSDAT(FILE_NO);
	DUMMY = ERAIDX(KEY_NO);
	CALL ABANDON();
END ENTRY_ERROR;

SORT_READ:
	PROC (KEY,KEY_NO);
DCL
	(KEY,KEY_NO,END_FILE,TEMP) FIXED;

	DRNL = BEG_REC;
	DRNH = 0;
	END_FILE = NO;

PUT LIST (SPACE(20),RET_CHR);

SORT_LOOP:

	IF END_FILE = YES THEN
		DO;
		PUT SKIP EDIT (INDEX_NAME(KEY),' is rebuilt.') (2A);
		RETURN;
		END;

	NO_READ = 0;

DATA_LOOP:

	CALL SETDAT(DRNH);
	TEMP = READAT(FILE_NO,DRNL,INPBUF_PTR);

	IF TEMP = END_DATA_FILE ø TEMP = INVALID_RECORD THEN
		DO;
		END_FILE = YES;
		GOTO BUILD_INDEX;
		END;

	IF TEMP ü= 0 THEN
		DO;
		PUT SKIP EDIT ('Could not read ',FILE_NAME) (2A);
		CALL ENTRY_ERROR(KEY_NO,DRNL,DRNH);
		END;

	IF INPBUF(1) = DEL_FLG THEN GOTO SKIP_RECORD;

PUT SKIP EDIT (FILE_NAME,DRNL,DRNH) (A,2F(6));

	NO_READ = NO_READ + 1;
	CALL PUT_KEYVAL(NO_READ,KEY);
	SORT_DRN(NO_READ).LSW = DRNL;
	SORT_DRN(NO_READ).MSW = DRNH;

SKIP_RECORD:

	CALL INC_4_BYTE(DRNL,DRNH);
	IF NO_READ < NO_SORT THEN
		GOTO DATA_LOOP;

BUILD_INDEX:

PUT LIST (SPACE(20),RET_CHR);

	CALL SORT_INDEX(KEY,KEY_NO,NO_READ);
	GOTO SORT_LOOP;

SORT_INDEX:
	PROC (KEY,KEY_NO,NO_READ);
DCL
	KEY_VALUE CHAR(MAX_KEY_LEN) VAR,
	(KEY,KEY_NO,NO_READ,I,RET_CODE) FIXED;

	IF NO_READ = 0 THEN RETURN;

	CALL SORT_KEYVAL(KEY,NO_READ);

	I = LINK(0);

INDEX_LOOP:

	IF I = 0 THEN RETURN;

	KEY_VALUE = GET_KEYVAL(I,KEY);
	CALL SETDAT(SORT_DRN(I).MSW);
	RET_CODE = ADDKEY(KEY_NO,FILE_NO,NLOCK,KEY_VALUE,SORT_DRN(I).LSW);
	IF ERRCOD() ü= 0 THEN
		DO;
		PUT SKIP EDIT ('Could not enter key value in ',
			INDEX_NAME(KEY)) (2A);
		CALL ENTRY_ERROR(KEY_NO,SORT_DRN(I).LSW,SORT_DRN(I).MSW);
		END;

	IF RET_CODE ü= 1 THEN
		DO;
		PUT SKIP EDIT ('WARNING...ADDKEY Return Code: ',RET_CODE)
			(A,F(4));
		PUT SKIP EDIT ('while processing record #',SORT_DRN(I).LSW,
			SORT_DRN(I).MSW,' for ',INDEX_NAME(KEY))
			(A,2F(6),2A);
		END;

PUT SKIP EDIT (INDEX_NAME(KEY),SORT_DRN(I).LSW,SORT_DRN(I).MSW)
	(A,2F(6));

	I = LINK(I);
	GOTO INDEX_LOOP;

SORT_KEYVAL:
	PROC (KEY,NO_READ);
DCL
	KEY_VALUE CHAR(MAX_KEY_LEN) VAR,
	(KEY,NO_READ,J,P,Q) FIXED;

	LINK(0) = NO_READ;
	LINK(NO_READ) = 0;

	IF NO_READ < 2 THEN RETURN;

	DO J = NO_READ TO 1 BY -1;
		P = LINK(0);
		Q = 0;
		KEY_VALUE = GET_KEYVAL(J,KEY);
L3:
		IF KEY_VALUE < GET_KEYVAL(P,KEY) THEN GOTO L5;
L4:
		Q = P;
		P = LINK(Q);
		IF P > 0 THEN GOTO L3;
L5:
		LINK(Q) = J;
		LINK(J) = P;
	END;
	RETURN;
END SORT_KEYVAL;

END SORT_INDEX;

END SORT_READ;

END REBUILD_INDICES;
	
END;
«eof»