|
|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 14208 (0x3780)
Types: TextFile
Names: »RECREATE.SRC«
└─⟦57f0389e8⟧ Bits:30005761 SW1611 Access Manager v. 1.0
└─⟦this⟧ »RECREATE.SRC«
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;
PROCEDURE STOP;
VAR
DUMMY : INTEGER;
DPARM : BYTEPTR;
BEGIN
DUMMY := @BDOS86(0,DPARM);
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.
«eof»