PROGRAM RECREATE;

(* :::::::::::::::::::::::::::::::::::::::::::::::::::::::::

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

   ::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

CONST
	MAX_REC_LEN = 1024;
	YES = 1;
	NO  = 0;
	MAX_KEY_LEN = 48;
	NAME_LEN = 14;
	MAX_NO_KEYS = 9;
	MAX_KEY_PARTS = 5;
	BUFFER_SIZE = 4844;
	MAX_SORT = 1200;
	MAX_SPACE = 8000;
	END_DATA_FILE = 53;
	INVALID_RECORD = 52;
	CORRUPT_DATA = 70;
	END_INDEX_FILE = 23;
	CORRUPT_INDEX = 40;

TYPE
	BYTEPTR = ^BYTE;
	KEYSTR = STRING[MAX_KEY_LEN];
	KEYPTR = ^KEYSTR;
	NAMSTR = STRING[NAME_LEN];
	CHRARY = ARRAY[1..MAX_KEY_LEN] OF CHAR;

	KEYCHR = RECORD
    		LEN : BYTE;
		STR : CHRARY;
	END;

	BUFFER = RECORD
		CHRFLD : ARRAY[1..MAX_REC_LEN] OF CHAR;
	END;

	BUFFER_PTR = ^BUFFER;

	LNKBUF = RECORD
		DEL_FLD : CHAR;
		DEL_LNK : ARRAY[0..1] OF INTEGER;
	END;

	LNKPTR = ^LNKBUF;

	HDRREC = ARRAY[1..64] OF INTEGER;

	LONG_INT = RECORD
		LSW : INTEGER;
		MSW : INTEGER;
	END;

	HDRFIL = FILE OF HDRREC;
		

VAR
	DRNL,DRNH,DEL_PTRL,DEL_PTRH,NO_DELL,NO_DELH,UTLL,UTLH: INTEGER;
	END_LOOP,FILE_VAL,XFILE,NLOCK,FILE_NO,NO_SORT,DUMMY,NO_READ: INTEGER;
	SORT_DRN : ARRAY[1..MAX_SORT] OF LONG_INT;
	LINK : ARRAY[0..MAX_SORT] OF INTEGER;
	KEYVAL : ARRAY[1..MAX_SPACE] OF CHAR;
	SPACES : KEYSTR;
	INDEX_NAME : ARRAY[1..MAX_NO_KEYS] OF NAMSTR;
	KEY_LEN,KEY_POS: ARRAY[1..9,0..MAX_KEY_PARTS] of INTEGER;
	AUTO_SUFFIX,NO_KEY_PARTS,KEY_TYPE: ARRAY[1..MAX_NO_KEYS] OF INTEGER;
	BLANK_KEY_TO_NULL : ARRAY[1..MAX_NO_KEYS] OF CHAR;

	REC_PAR : NAMSTR;
	REC_FILE : TEXT;
	NO_DATA_FILES,NODE_SECTORS: INTEGER;
	TERMINAL,ERROPT,TIMOUT: INTEGER;
	NO_BUFFERS,NO_FILES,NO_KEYZ,BUFFER_SPACE: INTEGER;

	FILE_NAME : NAMSTR;
	REC_LEN,BEG_REC: INTEGER;
	INPBUF : BUFFER;
	LINK_BUF : LNKBUF;
	INPBUF_PTR : BUFFER_PTR;
	LNKBUF_PTR : LNKPTR;

	DEL_FLG : CHAR;
	DEL_BYT : BYTE;
	RET_CHR : CHAR;
	RET_BYT : BYTE;
	DFILE : INTEGER;

{$I AM86EXTR.PSC}

EXTERNAL FUNCTION @BDOS86(FUNC:INTEGER; PARM:BYTEPTR) : INTEGER;

(*$P*)
PROCEDURE STOP;

VAR
	DUMMY : INTEGER;

	BEGIN
	DUMMY := @BDOS86(0, NIL);
	END;{STOP}
	
PROCEDURE ABANDON;
	BEGIN
	WRITELN('Rebuild Aborted!');
	CLOSE(REC_FILE,FILE_VAL);
	STOP;
	END;{ABANDON}


PROCEDURE INC_4_BYTE(VAR LSW,MSW:INTEGER);
	BEGIN
	LSW := LSW + 1;
	IF LSW = 0 THEN
		MSW := MSW + 1;
	END;{INC_4_BYTE}

FUNCTION TEST(LSW,MSW : INTEGER) : REAL;

VAR
	TL,TH : REAL;
	
	BEGIN
	TL := LSW;
	IF TL < 0 THEN
		TL := TL + 65536.0;
	TEST := TL + TH * 65536.0;
	END;{TEST}

PROCEDURE WRITE_DELETE_LINK;

	BEGIN
	LINK_BUF.DEL_FLD := DEL_FLG;
	LINK_BUF.DEL_LNK[0] := DEL_PTRL;
	LINK_BUF.DEL_LNK[1] := DEL_PTRH;

	SETDAT(DRNH);
	IF WRTDAT(FILE_NO,DRNL,LNKBUF_PTR) <> 0 THEN
		BEGIN
		WRITELN('Could not rewrite deleted record.');
		WRITELN('Data file ',FILE_NAME,' (',DRNL,' ',DRNH,')');
		ABANDON;
		END;

	DEL_PTRL := DRNL;
	DEL_PTRH := DRNH;

	END;{WRITE_DELETE_LINK}

PROCEDURE RECREATE_HEADER;

VAR
	TEMP : INTEGER;
	HDRBUF : HDRFIL;

	BEGIN
	ASSIGN (HDRBUF,FILE_NAME);
	RESET(HDRBUF);

	DRNL := DRNL - 1;
	IF DRNL = -1 THEN
		DRNH := DRNH - 1;	(* DRN = file size *)

	HDRBUF^[5] := DRNL;
	HDRBUF^[6] := DRNH;

	DRNL := DRNL - NO_DELL;
	DRNH := DRNH - NO_DELH;		(* DRN = file utl *)
	IF TEST(DRNL,DRNH) > TEST(HDRBUF^[5],HDRBUF^[6]) THEN
		DRNH := DRNH - 1;
	HDRBUF^[3] := DRNL;
	HDRBUF^[4] := DRNH;

	HDRBUF^[1] := DEL_PTRL;
	HDRBUF^[2] := DEL_PTRH;

	FOR TEMP := 7 TO 64 DO
		HDRBUF^[TEMP] := 0;

	SEEKWRITE(HDRBUF,0);

	CLOSE (HDRBUF,TEMP);
	END;{RECREATE_HEADER}
	
FUNCTION RBLD_DATA : INTEGER;

VAR
	TEMP,STATUS : INTEGER;

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

	IF ERRCOD = END_DATA_FILE THEN
		BEGIN
		RBLD_DATA := 3;
		DUMMY := CLSDAT(FILE_NO);
		EXIT;
		END;

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

	IF (STATUS = 0) AND (ERRCOD <> 0) THEN
		BEGIN
		TEMP := ERRCOD;
		DUMMY := CLSDAT(FILE_NO);
		RBLD_DATA := -TEMP;
		END
	ELSE IF LOKCOD <> 0 THEN
		BEGIN
		RBLD_DATA := 2;
		DUMMY := CLSDAT(FILE_NO);
		END
	ELSE
		BEGIN
		IF BEG_REC = 0 THEN
			BEG_REC := (128 + REC_LEN -1) DIV REC_LEN + 1;
		INPBUF_PTR := ADDR(INPBUF);
		LNKBUF_PTR := ADDR(LINK_BUF);

		IF STATUS = 0 THEN
			BEGIN
			DUMMY := CLSDAT(FILE_NO);
			RBLD_DATA := 0;
			WRITELN('No need to modify ',FILE_NAME);
			END
ELSE (* DATA FILE IS CORRUPTED. MUST BE REBUILT. *)

	BEGIN
	WRITELN('Rebuilding data file ',FILE_NAME);

	DRNL := BEG_REC;
	DRNH := 0;
	DEL_PTRL := 0;
	DEL_PTRH := 0;
	NO_DELL := BEG_REC - 1;
	NO_DELH := 0;

	SETDAT(DRNH);
	WHILE  READAT(FILE_NO,DRNL,INPBUF_PTR) = 0 DO
		BEGIN

		WRITE(FILE_NAME,' ',DRNL,' ',DRNH,RET_CHR);

		IF INPBUF.CHRFLD[1] = DEL_FLG THEN
			BEGIN
			WRITE_DELETE_LINK;
			INC_4_BYTE(NO_DELL,NO_DELH);
			END;

		INC_4_BYTE(DRNL,DRNH);
		SETDAT(DRNH);
		END;


	IF ERRCOD <> END_DATA_FILE THEN
		BEGIN
		TEMP := ERRCOD;
		DUMMY := CLSDAT(FILE_NO);
		RBLD_DATA := -TEMP;
		END

	ELSE
		BEGIN
		WRITELN(FILE_NAME,' is reorganized. Now rebuild index files.');

		IF CLSDAT(FILE_NO) <> 0 THEN
			BEGIN
			WRITELN(
			'Could not close data file (to recreate header)',
			FILE_NAME);
			ABANDON;
			END;

		RECREATE_HEADER;
		RBLD_DATA := 1;
		END;

	END;
		END;
	END;{RBLD_DATA}

PROCEDURE KEY_ERROR(KEY : INTEGER);

	BEGIN
	WRITELN(INDEX_NAME[KEY],' Error:  #',ERRCOD);
	WRITELN('Index not rebuilt.');
	END;{KEY_ERROR}

PROCEDURE SORT_SETUP(KEY : INTEGER);

	BEGIN
	NO_SORT := (MAX_SPACE - MAX_KEY_LEN) DIV (KEY_LEN[KEY,0] + 1);
	IF NO_SORT > MAX_SORT THEN
		NO_SORT := MAX_SORT;
	END;{SORT_SETUP}

PROCEDURE PUT_KEYVAL(I,KEY : INTEGER);

VAR
	CHRPTR : ^KEYCHR;
	TMPCHR : ^CHRARY;
	TMPKEY,KEY_VALUE : KEYSTR;
	TMP_I : INTEGER;
	TMP_VALUE : KEYPTR;

	BEGIN
	KEY_VALUE := '';
	CHRPTR := ADDR(TMPKEY);

	FOR TMP_I := 1 TO NO_KEY_PARTS[KEY] DO
		BEGIN
		TMPCHR := ADDR(INPBUF.CHRFLD[KEY_POS[KEY,TMP_I]]);
		CHRPTR^.STR := TMPCHR^;
		CHRPTR^.LEN := KEY_LEN[KEY,TMP_I];
		KEY_VALUE := CONCAT(KEY_VALUE,TMPKEY);
		END;

	IF BLANK_KEY_TO_NULL[KEY] = 'Y' THEN
		BEGIN
		TMPKEY := COPY(SPACES,1,LENGTH(KEY_VALUE));
		IF TMPKEY = KEY_VALUE THEN
			KEY_VALUE := '';
		END;

	TMP_I := (I - 1) * (KEY_LEN[KEY,0] + 1) + 1;
	TMP_VALUE := ADDR(KEYVAL[TMP_I]);
	TMP_VALUE^ := KEY_VALUE;
	END;{PUT_KEYVAL}

PROCEDURE GET_KEYVAL(I,KEY : INTEGER; VAR RESULT : KEYSTR);

VAR
	TMP_I : INTEGER;
	TMPPTR : KEYPTR;
			
	BEGIN
	TMP_I := (I - 1) * (KEY_LEN[KEY,0] + 1) + 1;
	TMPPTR := ADDR(KEYVAL[TMP_I]);
	RESULT := TMPPTR^;
	END;{GET_KEYVAL}


PROCEDURE ENTRY_ERROR(KEY_NO,LSW,MSW : INTEGER);

	BEGIN
	WRITELN(' Error:  #',ERRCOD,' (rec#',LSW,' ',MSW,')');
	WRITELN('during index rebuild.');
	DUMMY := CLSDAT(FILE_NO);
	DUMMY := ERAIDX(KEY_NO);
	ABANDON;
	END;{ENTRY_ERROR}

PROCEDURE SORT_KEYVAL(KEY,NO_READ : INTEGER);

VAR
	TMPKEY,KEY_VALUE : KEYSTR;
	J,P,Q : INTEGER;
LABEL
	333;

	BEGIN
	LINK[0] := NO_READ;
	LINK[NO_READ] := 0;

	IF NO_READ > 1 THEN
		BEGIN
		FOR J := NO_READ DOWNTO 1 DO
			BEGIN
			P := LINK[0];
			Q := 0;
			GET_KEYVAL(J,KEY,KEY_VALUE);
333:
			GET_KEYVAL(P,KEY,TMPKEY);
			IF KEY_VALUE < TMPKEY THEN 
				BEGIN
				LINK[Q] := J;
				LINK[J] := P;
				END
			ELSE
				BEGIN
				Q := P;
				P := LINK[Q];
				IF P > 0 THEN
					 GOTO 333
				ELSE
					BEGIN
					LINK[Q] := J;
					LINK[J] := P;
					END;
				END;
			END;
		END;
	END;{SORT_KEYVAL}

PROCEDURE SORT_INDEX(KEY,KEY_NO,NO_READ : INTEGER);

VAR
	KEY_VALUE : KEYSTR;
	I,RET_CODE : INTEGER;

      BEGIN
      IF NO_READ <> 0 THEN
	BEGIN
	SORT_KEYVAL(KEY,NO_READ);

	I := LINK[0];

	WHILE  I <> 0 DO
		BEGIN
		GET_KEYVAL(I,KEY,KEY_VALUE);
		SETDAT(SORT_DRN[I].MSW);
		RET_CODE := ADDKEY(KEY_NO,FILE_NO,NLOCK,KEY_VALUE,
			SORT_DRN[I].LSW);
		IF ERRCOD <> 0 THEN
			BEGIN
			WRITE('Could not enter key value in ',INDEX_NAME[KEY]);
			ENTRY_ERROR(KEY_NO,SORT_DRN[I].LSW,SORT_DRN[I].MSW);
			END;

		IF RET_CODE <> 1 THEN
			BEGIN
			WRITELN('WARNING...ADDKEY Return Code: ',RET_CODE);
			WRITELN('while processing record #',SORT_DRN[I].LSW,
				' ',SORT_DRN[I].MSW,' for ',INDEX_NAME[KEY]);
			END;

WRITE(INDEX_NAME[KEY],' ',SORT_DRN[I].LSW,' ',SORT_DRN[I].MSW,RET_CHR);

		I := LINK[I];
		END;
     	END;
      END;{SORT_INDEX}

PROCEDURE SORT_READ(KEY,KEY_NO : INTEGER);

VAR
	END_FILE,TEMP : INTEGER;

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

WRITE(SPACES,RET_CHR);

    WHILE END_FILE = NO DO
	BEGIN
	NO_READ := 0;
	END_LOOP := 0;

	WHILE END_LOOP < NO_SORT DO
		BEGIN
		SETDAT(DRNH);
		TEMP := READAT(FILE_NO,DRNL,INPBUF_PTR);

		IF (TEMP = END_DATA_FILE) OR (TEMP = INVALID_RECORD) THEN
			BEGIN
			END_FILE := YES;
			END_LOOP := NO_SORT;
			END

		ELSE IF TEMP <> 0 THEN
			BEGIN
			WRITELN('Could not read ',FILE_NAME);
			ENTRY_ERROR(KEY_NO,DRNL,DRNH);
			END
		ELSE
			BEGIN

			IF INPBUF.CHRFLD[1] <> DEL_FLG THEN 
				BEGIN

WRITE(FILE_NAME,' ',DRNL,' ',DRNH,RET_CHR);

				NO_READ := NO_READ + 1;
				END_LOOP := NO_READ;
				PUT_KEYVAL(NO_READ,KEY);
				SORT_DRN[NO_READ].LSW := DRNL;
				SORT_DRN[NO_READ].MSW := DRNH;
				END;

			INC_4_BYTE(DRNL,DRNH);
			END;
		END;

WRITE (SPACES,RET_CHR);

	SORT_INDEX(KEY,KEY_NO,NO_READ);
	END;

	WRITELN(INDEX_NAME[KEY],' is rebuilt.');
	END;{SORT_READ}

PROCEDURE RBLD_INDICES(REDO_DATA : INTEGER);

VAR
	KEY_NO,KEY,TEMP : INTEGER;
LABEL
	111;

    BEGIN
    IF NO_KEYZ >= 1 THEN
      BEGIN
      FILE_NO := -1;
      FILE_NO := OPNDAT(FILE_NO,XFILE,FILE_NAME,REC_LEN);
      IF (ERRCOD <> 0) OR (LOKCOD <> 0) THEN
	BEGIN
	WRITELN('Could not attempt index rebuild.');
	WRITELN('Error/Lock Codes...',ERRCOD,' ',LOKCOD);
	END

      ELSE
	BEGIN
	FOR KEY := 1 TO NO_KEYZ DO
		BEGIN
		KEY_NO := -1;
		KEY_NO := OPNIDX(KEY_NO,INDEX_NAME[KEY],KEY_LEN[KEY,0],
			KEY_TYPE[KEY],AUTO_SUFFIX[KEY]);

		IF (ERRCOD = 0) AND (REDO_DATA = 0) THEN
			BEGIN
			TEMP := NOKEYS(KEY_NO);
			IF (TEMP <> 0) OR (DATVAL <> 0) THEN
				BEGIN
				WRITELN(INDEX_NAME[KEY],' is OK as is.',
				' No rebuild performed.');
				GOTO 111;
				END;
			END;

		IF (ERRCOD <> 0) AND (ERRCOD <> CORRUPT_INDEX) AND (ERRCOD <>
		    END_INDEX_FILE) THEN
			BEGIN
			WRITE('Unanticipated Error with ');
			KEY_ERROR(KEY);
			GOTO 111;
			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
			BEGIN
			WRITE('Could not erase old ');
			KEY_ERROR(KEY);
			GOTO 111;
			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
			BEGIN
			WRITE('Could not re-open ');
			KEY_ERROR(KEY);
			GOTO 111;
			END;

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

111:

		DUMMY := CLSIDX(KEY_NO);
		END;
	END;
      DUMMY := CLSDAT(FILE_NO);
      END;
    END;{RBLD_INDICES}


PROCEDURE RBLD;

VAR
	KEY,PART,REDO_DATA : INTEGER;

PROCEDURE PART_ERROR;
	BEGIN
	WRITELN('Error in ',REC_PAR,' for data file ',FILE_NAME,
		' with key file ',INDEX_NAME[KEY]);
	WRITELN('Number of key parts must satisfy -');
	WRITELN('1 <= # Parts <= ',MAX_KEY_PARTS);
	ABANDON;
	END;{PART_ERROR}

	BEGIN
	READLN(REC_FILE,FILE_NAME);
	READLN(REC_FILE,REC_LEN,NO_KEYZ,BEG_REC);

	IF NO_KEYZ > MAX_NO_KEYS THEN
		BEGIN
		WRITELN('Error in ',REC_PAR,' for data file ',
			FILE_NAME,' More than ',MAX_NO_KEYS,
			' key files requested.');
		ABANDON;
		END;

	IF REC_LEN > MAX_REC_LEN THEN
		BEGIN
		WRITELN('Error in ',REC_PAR,' for data file ',
			FILE_NAME,'. Record length > ',MAX_REC_LEN);
		ABANDON;
		END;

	IF NO_KEYZ > 0 THEN
		FOR KEY := 1 TO NO_KEYZ DO
			BEGIN
			READLN(REC_FILE,INDEX_NAME[KEY]);
			READLN(REC_FILE,KEY_LEN[KEY,0],KEY_TYPE[KEY],
				AUTO_SUFFIX[KEY],NO_KEY_PARTS[KEY]);
			READLN(REC_FILE,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) OR (NO_KEY_PARTS[KEY] >
			   	MAX_KEY_PARTS) THEN PART_ERROR;
			FOR PART := 1 TO NO_KEY_PARTS[KEY] DO
				READLN(REC_FILE,KEY_POS[KEY,PART],KEY_LEN[
			   	KEY,PART]);
			END;

	REDO_DATA := RBLD_DATA;

	IF REDO_DATA = 2 THEN
		WRITELN('Data file ',FILE_NAME,' could not be locked')
	ELSE IF REDO_DATA = 3 THEN
		WRITELN('Data file ',FILE_NAME,' is apparently empty.')
	ELSE IF REDO_DATA < 0 THEN
		WRITELN('Unanticipated AM86 Error #',-REDO_DATA,
		    ' while processing ',FILE_NAME);

	IF (REDO_DATA < 0) OR (REDO_DATA > 1) THEN
		WRITELN('No rebuild performed.')
	ELSE
		BEGIN
		RBLD_INDICES(REDO_DATA);
		WRITELN('Rebuild for ',FILE_NAME,' completed.');
		END;
END; {RBLD}

BEGIN
WRITE('Enter recreate parameter file name:');
READLN(REC_PAR);

ASSIGN(REC_FILE,REC_PAR);
RESET(REC_FILE);
IF IORESULT = 255 THEN
	BEGIN
	WRITELN('Could not open parameter file.');
	STOP;
	END;

READLN(REC_FILE,NO_DATA_FILES,NODE_SECTORS);

DEL_BYT := 255;
RET_BYT := 13;
DEL_FLG := DEL_BYT;
RET_CHR := RET_BYT;
XFILE := 4;
NLOCK := 0;
TERMINAL := -1;
ERROPT := YES;
TIMOUT := 2;
(*         123456789012345678901234567890123456789012345678        *)
SPACES := '                                                ';
TERMINAL := INTUSR(TERMINAL,ERROPT,TIMOUT);

BUFFER_SPACE := BUFFER_SIZE - 62 - 190;	(* assumes only one key file and 
					   one data file open at the same 
					   time. *)

NO_BUFFERS := BUFFER_SPACE DIV (NODE_SECTORS * 128 + 60);

NO_KEYZ := 1;
NO_FILES := 1;
IF SETUP(NO_BUFFERS,NO_KEYZ,NODE_SECTORS,NO_FILES) <> 0 THEN
	BEGIN
	WRITELN('Illegal SETUP parameters.');
	ABANDON;
	END;

FOR DFILE := 1 TO NO_DATA_FILES DO
	BEGIN
	RBLD;
	WRITELN;
	END;

WRITELN('Normal Termination.');

END.