(******************************************************************)
     (*                                                                *)
     (*  Copyright (c) 1978 Regents of the University of California.   *)
     (*  Permission to copy or distribute this software or documen-    *)
     (*  tation in hard or soft copy granted only by written license   *)
     (*  obtained from the Institute for Information Systems.          *)
     (*                                                                *)
     (******************************************************************)

 PROCEDURE EXECERROR;
 BEGIN
   WITH SYSCOM^ DO
     BEGIN
       IF XEQERR = 4 THEN
         BEGIN RELEASE(EMPTYHEAP);
           PL := '*STK OFLOW*';
           UNITWRITE(2,PL[1],LENGTH(PL));
           EXIT(COMMAND)
         END;
       BOMBP^.MSIPC := BOMBIPC;
       IF BUGSTATE <> 0 THEN
         BEGIN DEBUGGER; XEQERR := 0 END
       ELSE
         BEGIN RELEASE(EMPTYHEAP);
           GFILES[0] := INPUTFIB; GFILES[1] := OUTPUTFIB;
           BOMBIPC := IORESULT; FWRITELN(SYSTERM^);
           IF UNITABLE[SYSUNIT].UVID = SYVID THEN
             PRINTERROR(XEQERR,BOMBIPC)
           ELSE
             BEGIN
               WRITE(OUTPUT,'Exec err # ',XEQERR);
               IF XEQERR = 10 THEN
                 WRITE(OUTPUT,',',BOMBIPC)
             END;
           WRITELN(OUTPUT);
           IF NOT SPACEWAIT(TRUE) THEN EXIT(COMMAND)
         END
     END
 END (*EXECERROR*) ;

 FUNCTION CHECKDEL(CH: CHAR; VAR SINX: INTEGER): BOOLEAN;
 BEGIN CHECKDEL := FALSE;
   WITH SYSCOM^,CRTCTRL DO
     BEGIN
       IF CH = CRTINFO.LINEDEL THEN
         BEGIN CHECKDEL := TRUE;
           IF (BACKSPACE = CHR(0)) OR (ERASEEOL = CHR(0)) THEN
             BEGIN SINX := 1;
               WRITELN(OUTPUT,'<DEL')
             END
           ELSE
             BEGIN
               WHILE SINX > 1 DO
                 BEGIN SINX := SINX-1; WRITE(OUTPUT,BACKSPACE) END;
               WRITE(OUTPUT,ESCAPE,ERASEEOL)
             END
         END;
       IF CH = CRTINFO.CHARDEL THEN
         BEGIN CHECKDEL := TRUE;
           IF SINX > 1 THEN
             BEGIN SINX := SINX-1;
               IF BACKSPACE = CHR(0) THEN
                 IF CRTINFO.CHARDEL < ' ' THEN
                   WRITE(OUTPUT,'_')
                 ELSE (*ASSUME PRINTABLE*)
               ELSE
                 BEGIN
                   IF CRTINFO.CHARDEL <> BACKSPACE THEN
                     WRITE(OUTPUT,BACKSPACE);
                   WRITE(OUTPUT,' ',BACKSPACE)
                 END
             END
           ELSE
             IF CRTINFO.CHARDEL = BACKSPACE THEN
               WRITE(OUTPUT,' ')
         END
     END
 END (*CHECKDEL*) ;


 PROCEDURE PUTPREFIXED(WHICH:INTEGER; COMMANDCHAR:CHAR);
 BEGIN
   WITH SYSCOM^ DO
     IF COMMANDCHAR <> CHR(0) THEN
       BEGIN
         IF CRTCTRL.PREFIXED[WHICH] THEN
           WRITE(OUTPUT,CRTCTRL.ESCAPE);
         WRITE(OUTPUT,COMMANDCHAR);
         IF LENGTH(FILLER)>0 THEN
           WRITE(OUTPUT,FILLER);
       END;
 END;

 PROCEDURE HOMECURSOR;
 BEGIN
   PUTPREFIXED(4,SYSCOM^.CRTCTRL.HOME);
 END (*HOMECURSOR*) ;
	
 PROCEDURE CLEARSCREEN;
 BEGIN HOMECURSOR;
   WITH SYSCOM^,CRTCTRL DO
     BEGIN
       IF MISCINFO.HAS8510A THEN UNITCLEAR(3);
       IF ERASEEOS <> CHR(0) THEN
         PUTPREFIXED(3,ERASEEOS)
       ELSE
         PUTPREFIXED(6,CLEARSCREEN)
     END
 END (*CLEARSCREEN*) ;

 PROCEDURE CLEARLINE;
 BEGIN
   PUTPREFIXED(2,SYSCOM^.CRTCTRL.ERASEEOL)
 END (*CLEARLINE*) ;

 PROCEDURE PROMPT;
   VAR I: INTEGER;
 BEGIN HOMECURSOR;
   WITH SYSCOM^ DO
     BEGIN
       CLEARLINE;
       IF MISCINFO.SLOWTERM THEN
         BEGIN
           I := SCAN(LENGTH(PL),=':',PL[1]);
           IF I <> LENGTH(PL) THEN PL[0] := CHR(I+1)
         END
     END;
   WRITE(OUTPUT,PL)
 END (*PROMPT*) ;

 PROCEDURE FGOTOXY(*X,Y: INTEGER*);
 BEGIN (*ASSUME DATA MEDIA*)
   WITH SYSCOM^.CRTINFO DO
     BEGIN
       IF X < 0 THEN X := 0;
       IF X > WIDTH THEN X := WIDTH;
       IF Y < 0 THEN Y := 0;
       IF Y > HEIGHT THEN Y := HEIGHT
     END;
   WRITE(OUTPUT,CHR(30),CHR(X+32),CHR(Y+32))
 END (*GOTOXY*) ;

 FUNCTION GETCHAR(*FLUSH: BOOLEAN*);
   VAR CH: CHAR;
 BEGIN
   IF FLUSH THEN UNITCLEAR(1);
   IF INPUTFIB^.FEOF THEN EXIT(COMMAND);
   INPUTFIB^.FSTATE := FNEEDCHAR;
   READ(INPUT,CH);
   IF (CH >= 'a') AND (CH <= 'z') THEN
     CH := CHR(ORD(CH)-ORD('a')+ORD('A'));
   GETCHAR := CH
 END (*GETCHAR*) ;

 FUNCTION SPACEWAIT(*FLUSH: BOOLEAN*);
   VAR CH: CHAR;
 BEGIN
   REPEAT
     WRITE(OUTPUT,'Type <space>');
     IF NOT SYSCOM^.MISCINFO.SLOWTERM THEN
       WRITE(OUTPUT,' to continue');
     CH := GETCHAR(FLUSH);
     IF NOT EOLN(INPUT) THEN
       WRITELN(OUTPUT);
     CLEARLINE
   UNTIL (CH = ' ') OR (CH = SYSCOM^.CRTINFO.ALTMODE);
   SPACEWAIT := CH <> ' '
 END (*SPACEWAIT*) ;

 FUNCTION SCANTITLE(*FTITLE: STRING; VAR FVID: VID; VAR FTID: TID;
                     VAR FSEGS: INTEGER; VAR FKIND: FILEKIND*);
   VAR I,RBRACK: INTEGER; CH: CHAR; OK: BOOLEAN;
 BEGIN
   FVID := ''; FTID := '';
   FSEGS := 0; FKIND := UNTYPEDFILE;
   SCANTITLE := FALSE; I := 1;
   WHILE I <= LENGTH(FTITLE) DO
     BEGIN CH := FTITLE[I];
       IF CH <= ' ' THEN DELETE(FTITLE,I,1)
       ELSE
         BEGIN
           IF (CH >= 'a') AND (CH <= 'z') THEN
             FTITLE[I] := CHR(ORD(CH)-ORD('a')+ORD('A'));
           I := I+1
         END
     END;
   IF LENGTH(FTITLE) > 0 THEN
     BEGIN
       IF FTITLE[1] = '*' THEN
         BEGIN FVID := SYVID; DELETE(FTITLE,1,1) END;
       I := POS(':',FTITLE);
       IF I <= 1 THEN
         BEGIN
           IF LENGTH(FVID) = 0 THEN FVID := DKVID;
           IF I = 1 THEN DELETE(FTITLE,1,1)
         END
       ELSE
         IF I-1 <= VIDLENG THEN
           BEGIN
             FVID := COPY(FTITLE,1,I-1);
             DELETE(FTITLE,1,I)
           END;
       IF LENGTH(FVID) > 0 THEN
         BEGIN
           I := POS('[',FTITLE);
           IF I > 0 THEN I := I-1
           ELSE I := LENGTH(FTITLE);
           IF I <= TIDLENG THEN
             BEGIN
               IF I > 0 THEN
                 BEGIN FTID := COPY(FTITLE,1,I); DELETE(FTITLE,1,I) END;
               IF LENGTH(FTITLE) = 0 THEN OK := TRUE
               ELSE
                 BEGIN OK := FALSE;
                   RBRACK := POS(']',FTITLE);
                   IF RBRACK = 2 THEN OK := TRUE
                   ELSE
                     IF RBRACK > 2 THEN
                       BEGIN OK := TRUE; I := 2;
                         REPEAT CH := FTITLE[I];
                           IF CH IN DIGITS THEN
                             FSEGS := FSEGS*10+(ORD(CH)-ORD('0'))
                           ELSE OK := FALSE;
                           I := I+1
                         UNTIL (I = RBRACK) OR NOT OK;
                         IF (I = 3) AND (RBRACK = 3) THEN
                           IF FTITLE[I-1] = '*' THEN
                             BEGIN FSEGS := -1; OK := TRUE END
                       END
                 END;
               SCANTITLE := OK;
               IF OK AND (LENGTH(FTID) > 5) THEN
                 BEGIN
                   FTITLE := COPY(FTID,LENGTH(FTID)-4,5);
                   IF FTITLE = '.TEXT' THEN FKIND := TEXTFILE
                   ELSE
                   IF FTITLE = '.CODE' THEN FKIND := CODEFILE
                   ELSE
                   IF FTITLE = '.INFO' THEN FKIND := INFOFILE
                   ELSE
                   IF FTITLE = '.GRAF' THEN FKIND := GRAFFILE
                   ELSE
                   IF FTITLE = '.FOTO' THEN FKIND := FOTOFILE
                 END
             END
         END
     END
 END (*SCANTITLE*) ;

 (* VOLUME AND DIRECTORY HANDLERS *)

 FUNCTION FETCHDIR(FUNIT: UNITNUM): BOOLEAN;
   VAR LINX: DIRRANGE; OK: BOOLEAN; HNOW: INTEGER;
 BEGIN FETCHDIR := FALSE;
   WITH SYSCOM^,UNITABLE[FUNIT] DO
     BEGIN (*READ IN AND VALIDATE DIR*)
       IF GDIRP = NIL THEN NEW(GDIRP);
       UNITREAD(FUNIT,GDIRP^,SIZEOF(DIRECTORY),DIRBLK);
       OK := IORSLT = INOERROR;
       IF OK THEN
         WITH GDIRP^[0] DO
           BEGIN OK := FALSE; (*CHECK OUT DIR*)
             IF (DFIRSTBLK = 0) AND
                 (  (MISCINFO.USERKIND=BOOKER)
               OR ( (MISCINFO.USERKIND IN [AQUIZ,PQUIZ]) AND (DFKIND=SECUREDIR) )
                   OR ( (MISCINFO.USERKIND=NORMAL) AND (DFKIND=UNTYPEDFILE) ) )
               THEN
               IF (LENGTH(DVID) > 0) AND (LENGTH(DVID) <= VIDLENG) AND
                  (DNUMFILES >= 0) AND (DNUMFILES <= MAXDIR) THEN
                 BEGIN OK := TRUE; (*SO FAR SO GOOD*)
                   IF DVID <> UVID THEN
                     BEGIN (*NEW VOLUME IN UNIT...CAREFUL*)
                       LINX := 1;
                       WHILE LINX <= DNUMFILES DO
                         WITH GDIRP^[LINX] DO
                           IF (LENGTH(DTID) <= 0) OR
                              (LENGTH(DTID) > TIDLENG) OR
                              (DLASTBLK < DFIRSTBLK) OR
                              (DLASTBYTE > FBLKSIZE) OR
                              (DLASTBYTE <= 0) OR
                              (DACCESS.YEAR >= 100) THEN
                             BEGIN OK := FALSE; DELENTRY(LINX,GDIRP) END
                           ELSE
                             LINX := LINX+1;
                       IF NOT OK THEN
                         BEGIN (*MUST HAVE BEEN CHANGED...WRITEIT*)
                           UNITWRITE(FUNIT,GDIRP^,
                                 (DNUMFILES+1)*SIZEOF(DIRENTRY),DIRBLK);
                           OK := IORSLT = INOERROR
                         END
                     END
                 END;
             IF OK THEN
               BEGIN UVID := DVID; UEOVBLK := DEOVBLK;
                 TIME(HNOW,DLOADTIME)
               END
           END;
       FETCHDIR := OK;
       IF NOT OK THEN
         BEGIN UVID := ''; UEOVBLK := MMAXINT;
           RELEASE(GDIRP); GDIRP := NIL
         END
     END
 END (*FETCHDIR*) ;

 PROCEDURE WRITEDIR(*FUNIT: UNITNUM; FDIR: DIRP*);
   VAR HNOW,LNOW: INTEGER; OK: BOOLEAN; LDE: DIRENTRY;
 BEGIN
   WITH UNITABLE[FUNIT],FDIR^[0] DO
     BEGIN OK := (UVID = DVID) AND ((DFKIND = UNTYPEDFILE) OR
                                    (DFKIND = SECUREDIR));
       IF OK THEN
         BEGIN TIME(HNOW,LNOW);
           OK := (LNOW-DLOADTIME <= AGELIMIT) AND
                 ((LNOW-DLOADTIME) >= 0) AND
                     SYSCOM^.MISCINFO.HASCLOCK;
           IF NOT OK THEN
             BEGIN (*NO CLOCK OR TOO OLD*)
               UNITREAD(FUNIT,LDE,SIZEOF(DIRENTRY),DIRBLK);
               IF IORESULT = ORD(INOERROR) THEN
                 OK := DVID = LDE.DVID;
             END;

           IF OK THEN
             BEGIN (*WE GUESS ALL IS SAFE...WRITEIT*)
               DFIRSTBLK := 0;   (*DIRTY FIX FOR YALOE BUGS*)
               UNITWRITE(FUNIT,FDIR^,
                         (DNUMFILES+1)*SIZEOF(DIRENTRY),DIRBLK);
               OK := IORESULT = ORD(INOERROR);
               IF DLASTBLK = 10 THEN (*REDUNDANT AFTERTHOUGHT*)
                 UNITWRITE(FUNIT,FDIR^,
                           (DNUMFILES+1)*SIZEOF(DIRENTRY),6);
               IF OK THEN TIME(HNOW,DLOADTIME)
             END
         END;
       IF NOT OK THEN
         BEGIN SYSCOM^.IORSLT := ILOSTUNIT;
           UVID := ''; UEOVBLK := MMAXINT
         END
     END
 END (*WRITEDIR*) ;

 FUNCTION VOLSEARCH(*VAR FVID: VID; LOOKHARD: BOOLEAN; VAR FDIR: DIRP*);
   VAR LUNIT: UNITNUM; OK,PHYSUNIT: BOOLEAN; HNOW,LNOW: INTEGER;
 BEGIN VOLSEARCH := 0; FDIR := NIL;
   OK := FALSE; PHYSUNIT := FALSE;
   IF LENGTH(FVID) > 0 THEN
     BEGIN
       IF (FVID[1] = '#') AND (LENGTH(FVID) > 1) THEN
         BEGIN OK := TRUE;
           LUNIT := 0; HNOW := 2;
           REPEAT
             IF FVID[HNOW] IN DIGITS THEN
               LUNIT := LUNIT*10+ORD(FVID[HNOW])-ORD('0')
             ELSE OK := FALSE;
             HNOW := HNOW+1
           UNTIL (HNOW > LENGTH(FVID)) OR NOT OK;
           PHYSUNIT := OK AND (LUNIT > 0) AND (LUNIT <= MAXUNIT)
         END;
       IF NOT PHYSUNIT THEN
         BEGIN OK := FALSE; LUNIT := MAXUNIT;
           REPEAT
             OK := FVID = UNITABLE[LUNIT].UVID;
             IF NOT OK THEN LUNIT := LUNIT-1
           UNTIL OK OR (LUNIT = 0)
         END
     END;
   IF OK THEN
     IF UNITABLE[LUNIT].UISBLKD THEN
       WITH SYSCOM^ DO
         BEGIN OK := FALSE;  (*SEE IF GDIRP IS GOOD*)
           IF GDIRP <> NIL THEN
             IF FVID = GDIRP^[0].DVID THEN
               BEGIN TIME(HNOW,LNOW);
                 OK := LNOW-GDIRP^[0].DLOADTIME <= AGELIMIT
               END;
           IF NOT OK THEN
             BEGIN OK := PHYSUNIT;
               IF FETCHDIR(LUNIT) THEN
                 IF NOT PHYSUNIT THEN
                   OK := FVID = GDIRP^[0].DVID
             END
         END;
   IF NOT OK AND LOOKHARD THEN
     BEGIN LUNIT := MAXUNIT; (*CHECK EACH DISK UNIT*)
       REPEAT
         WITH UNITABLE[LUNIT] DO
           IF UISBLKD THEN
             IF FETCHDIR(LUNIT) THEN
               OK := FVID = UVID;
         IF NOT OK THEN LUNIT := LUNIT-1
       UNTIL OK OR (LUNIT = 0)
     END;
   IF OK THEN
     WITH UNITABLE[LUNIT] DO
       BEGIN VOLSEARCH := LUNIT;
         IF LENGTH(UVID) > 0 THEN FVID := UVID;
         IF UISBLKD AND (SYSCOM^.GDIRP <> NIL) THEN
           BEGIN FDIR := SYSCOM^.GDIRP;
             TIME(HNOW,FDIR^[0].DLOADTIME)
           END
       END
 END (*VOLSEARCH*) ;

 FUNCTION DIRSEARCH(*VAR FTID: TID; FINDPERM: BOOLEAN; FDIR: DIRP*);
   VAR I: DIRRANGE; FOUND: BOOLEAN;
 BEGIN DIRSEARCH := 0; FOUND := FALSE; I := 1;
   WHILE (I <= FDIR^[0].DNUMFILES) AND NOT FOUND DO
     BEGIN
       WITH FDIR^[I] DO
         IF DTID = FTID THEN
           IF FINDPERM = (DACCESS.YEAR <> 100) THEN
             BEGIN DIRSEARCH := I; FOUND := TRUE END;
       I := I+1
     END
 END (*DIRSEARCH*) ;

 PROCEDURE DELENTRY(*FINX: DIRRANGE; FDIR: DIRP*);
   VAR I: DIRRANGE;
 BEGIN
   WITH FDIR^[0] DO
     BEGIN
       FOR I := FINX TO DNUMFILES-1 DO
         FDIR^[I] := FDIR^[I+1];
       FDIR^[DNUMFILES].DTID := '';
       DNUMFILES := DNUMFILES-1
     END
 END (*DELENTRY*) ;

 PROCEDURE INSENTRY(*VAR FENTRY: DIRENTRY; FINX: DIRRANGE; FDIR: DIRP*);
   VAR I: DIRRANGE;
 BEGIN
   WITH FDIR^[0] DO
     BEGIN
       FOR I := DNUMFILES DOWNTO FINX DO
         FDIR^[I+1] := FDIR^[I];
       FDIR^[FINX] := FENTRY;
       DNUMFILES := DNUMFILES+1
     END
 END (*INSENTRY*) ;

 FUNCTION ENTERTEMP(VAR FTID: TID; FSEGS: INTEGER;
                       FKIND: FILEKIND; FDIR: DIRP): DIRRANGE;
   VAR I,LASTI,DINX,SINX: DIRRANGE; RT11ISH: BOOLEAN;
       SSEGS: INTEGER; LDE: DIRENTRY;

   PROCEDURE FINDMAX(CURINX: DIRRANGE; FIRSTOPEN,NEXTUSED: INTEGER);
     VAR FREEAREA: INTEGER;
   BEGIN
     FREEAREA := NEXTUSED-FIRSTOPEN;
     IF FREEAREA > FSEGS THEN
       BEGIN
         SINX := DINX; SSEGS := FSEGS;
         DINX := CURINX; FSEGS := FREEAREA
       END
     ELSE
       IF FREEAREA > SSEGS THEN
         BEGIN SSEGS := FREEAREA; SINX := CURINX END
   END (*FINDMAX*) ;

 BEGIN (*ENTERTEMP*)
   DINX := 0; LASTI := FDIR^[0].DNUMFILES;
   SINX := 0; SSEGS := 0;
   IF FSEGS <= 0 THEN
     BEGIN RT11ISH := FSEGS < 0;
       FOR I := 1 TO LASTI DO
         FINDMAX(I,FDIR^[I-1].DLASTBLK,FDIR^[I].DFIRSTBLK);
       FINDMAX(LASTI+1,FDIR^[LASTI].DLASTBLK,FDIR^[0].DEOVBLK);
       IF RT11ISH THEN
         IF FSEGS DIV 2 <= SSEGS THEN
           BEGIN FSEGS := SSEGS; DINX := SINX END
         ELSE FSEGS := (FSEGS+1) DIV 2
     END
   ELSE
     BEGIN I := 1;
       WHILE I <= LASTI DO
         BEGIN
           IF FDIR^[I].DFIRSTBLK-FDIR^[I-1].DLASTBLK >= FSEGS THEN
             BEGIN DINX := I; I := LASTI END;
           I := I+1
         END;
       IF DINX = 0 THEN
         IF FDIR^[0].DEOVBLK-FDIR^[LASTI].DLASTBLK >= FSEGS THEN
           DINX := LASTI+1
     END;
   IF LASTI = MAXDIR THEN DINX := 0;
   IF DINX > 0 THEN
     BEGIN
       WITH LDE DO
         BEGIN
           DFIRSTBLK := FDIR^[DINX-1].DLASTBLK;
           DLASTBLK := DFIRSTBLK+FSEGS;
           DFKIND := FKIND; DTID := FTID;
           DLASTBYTE := FBLKSIZE;
           WITH DACCESS DO
             BEGIN MONTH := 0; DAY := 0; YEAR := 100 END
         END;
       INSENTRY(LDE,DINX,FDIR)
     END;
   ENTERTEMP := DINX
 END (*ENTERTEMP*) ;

 (* FILE STATE HANDLERS *)

 PROCEDURE FINIT(*VAR F: FIB; WINDOW: WINDOWP; RECWORDS: INTEGER*);
 BEGIN
   WITH F DO
     BEGIN FSTATE := FJANDW;
       FISOPEN := FALSE; FEOF := TRUE;
       FEOLN := TRUE; FWINDOW := WINDOW;
       IF (RECWORDS = 0) OR (RECWORDS = -2) THEN
         BEGIN
           FWINDOW^[1] := CHR(0); FRECSIZE := 1;
           IF RECWORDS = 0 THEN FSTATE := FNEEDCHAR
         END
       ELSE
         IF RECWORDS < 0 THEN
           BEGIN FWINDOW := NIL; FRECSIZE := 0 END
         ELSE FRECSIZE := RECWORDS+RECWORDS
     END
 END (*FINIT*) ;

 PROCEDURE RESETER(VAR F:FIB);
   VAR BIGGER: BOOLEAN;
 BEGIN
   WITH F DO
      BEGIN FREPTCNT := 0;
         FEOLN := FALSE; FEOF := FALSE;
         IF FISBLKD THEN
           BEGIN BIGGER := FNXTBLK > FMAXBLK;
             IF BIGGER THEN FMAXBLK := FNXTBLK;
             IF FSOFTBUF THEN
               BEGIN
                 IF BIGGER THEN FMAXBYTE := FNXTBYTE
                 ELSE
                   IF FNXTBLK = FMAXBLK THEN
                     IF FNXTBYTE > FMAXBYTE THEN
                         BEGIN BIGGER := TRUE; FMAXBYTE := FNXTBYTE END;
                 IF FBUFCHNGD THEN
                   BEGIN FBUFCHNGD := FALSE; FMODIFIED := TRUE;
                     IF BIGGER THEN
                       FILLCHAR(FBUFFER[FNXTBYTE],FBLKSIZE-FNXTBYTE,0);
                     UNITWRITE(FUNIT,FBUFFER,FBLKSIZE,
                                     FHEADER.DFIRSTBLK+FNXTBLK-1);
                     IF BIGGER AND (FHEADER.DFKIND = TEXTFILE)
                         AND ODD(FNXTBLK) THEN
                       BEGIN FMAXBLK := FMAXBLK+1;
                         FILLCHAR(FBUFFER,FBLKSIZE,0);
                         UNITWRITE(FUNIT,FBUFFER,FBLKSIZE,
                                         FHEADER.DFIRSTBLK+FNXTBLK)
                       END
                   END;
                 FNXTBYTE := FBLKSIZE
               END;
             FNXTBLK := 0;
             IF FSOFTBUF AND (FHEADER.DFKIND = TEXTFILE) THEN
                 FNXTBLK := 2
           END
      END
 END (*RESETER*) ;

 PROCEDURE FOPEN(*VAR F: FIB; VAR FTITLE: STRING;
                  FOPENOLD: BOOLEAN; JUNK PARAM*);
   LABEL 1;
   VAR LDIR: DIRP; LUNIT: UNITNUM; LINX: DIRRANGE;
       LSEGS,NBYTES: INTEGER; LKIND: FILEKIND;
       OLDHEAP: ^INTEGER; SWAPPED: BOOLEAN;
       SAVERSLT: IORSLTWD; LVID: VID; LTID: TID;
 BEGIN SYSCOM^.IORSLT := INOERROR;
   WITH F DO
     IF FISOPEN THEN SYSCOM^.IORSLT := INOTCLOSED
     ELSE
       IF SCANTITLE(FTITLE,LVID,LTID,LSEGS,LKIND) THEN
         BEGIN (*GOT AN OK TITLE*)
           IF ORD(FOPENOLD) > 1 THEN (*OLD CODE SPECIAL CASE*)
             FOPENOLD := (ORD(FOPENOLD) = 2) OR (ORD(FOPENOLD) = 4);
           SWAPPED := FALSE;
           WITH SWAPFIB^ DO
             IF FISOPEN AND (SYSCOM^.GDIRP = NIL) THEN
               BEGIN MARK(OLDHEAP);
                 NBYTES := ORD(SYSCOM^.LASTMP)-ORD(OLDHEAP);
                 IF (NBYTES > 0) AND (NBYTES < SIZEOF(DIRECTORY)+400) THEN
                   BEGIN
                     NBYTES := ORD(OLDHEAP)-ORD(EMPTYHEAP);
                     IF (NBYTES > 0) AND (NBYTES > SIZEOF(DIRECTORY)) AND
                         (UNITABLE[FUNIT].UVID = FVID) THEN
                       BEGIN
                         UNITWRITE(FUNIT,EMPTYHEAP^,SIZEOF(DIRECTORY),
                                         FHEADER.DFIRSTBLK);
                         RELEASE(EMPTYHEAP); SWAPPED := TRUE
                       END
                   END
               END;
           LUNIT := VOLSEARCH(LVID,TRUE,LDIR);
           IF LUNIT = 0 THEN SYSCOM^.IORSLT := INOUNIT
           ELSE
             WITH UNITABLE[LUNIT] DO
               BEGIN (*OK...OPEN UP FILE*)
                 FISOPEN := TRUE; FMODIFIED := FALSE;
                 FUNIT := LUNIT; FVID := LVID;
                 FNXTBLK := 0; FISBLKD := UISBLKD;
                 FSOFTBUF := UISBLKD AND (FRECSIZE <> 0);
                 IF (LDIR <> NIL) AND (LENGTH(LTID) > 0) THEN
                   BEGIN (*LOOKUP OR ENTER FHEADER IN DIRECTORY*)
                     LINX := DIRSEARCH(LTID,FOPENOLD,LDIR);
                     IF FOPENOLD THEN
                       IF LINX = 0 THEN
                         BEGIN SYSCOM^.IORSLT := INOFILE; GOTO 1 END
                       ELSE FHEADER := LDIR^[LINX]
                     ELSE (*OPEN NEW FILE*)
                       IF LINX > 0 THEN
                         BEGIN SYSCOM^.IORSLT := IDUPFILE; GOTO 1 END
                       ELSE
                         BEGIN (*MAKE A TEMP ENTRY*)
                           IF LKIND = UNTYPEDFILE THEN LKIND := DATAFILE;
                           LINX := ENTERTEMP(LTID,LSEGS,LKIND,LDIR);
                           IF (LINX > 0) AND (LKIND = TEXTFILE) THEN
                             WITH LDIR^[LINX] DO
                               BEGIN
                                 IF ODD(DLASTBLK-DFIRSTBLK) THEN
                                   DLASTBLK := DLASTBLK-1;
                                 IF DLASTBLK-DFIRSTBLK < 4 THEN
                                   BEGIN DELENTRY(LINX,LDIR); LINX := 0 END
                               END;
                           IF LINX = 0 THEN
                             BEGIN SYSCOM^.IORSLT := INOROOM; GOTO 1 END;
                           FHEADER := LDIR^[LINX]; FMODIFIED := TRUE;
                           WRITEDIR(LUNIT,LDIR)
                         END
                   END
                 ELSE (*FHEADER NOT IN DIRECTORY*)
                   WITH FHEADER DO
                     BEGIN (*DIRECT UNIT OPEN, SET UP DUMMY FHEADER*)
                       DFIRSTBLK := 0; DLASTBLK := MMAXINT;
                       IF UISBLKD THEN DLASTBLK := UEOVBLK;
                       DFKIND := LKIND; DTID := '';
                       DLASTBYTE := FBLKSIZE;
                       WITH DACCESS DO
                         BEGIN MONTH := 0; DAY := 0; YEAR := 0 END
                     END;
                 IF FOPENOLD THEN
                   FMAXBLK := FHEADER.DLASTBLK-FHEADER.DFIRSTBLK
                 ELSE FMAXBLK := 0;
                 IF FSOFTBUF THEN
                   BEGIN
                     FNXTBYTE := FBLKSIZE; FBUFCHNGD := FALSE;
                     IF FOPENOLD THEN FMAXBYTE := FHEADER.DLASTBYTE
                     ELSE FMAXBYTE := FBLKSIZE;
                     WITH FHEADER DO
                       IF DFKIND = TEXTFILE THEN
                         BEGIN FNXTBLK := 2;
                           IF NOT FOPENOLD THEN
                             BEGIN (*NEW .TEXT, PUT NULLS IN FIRST PAGE*)
                               FILLCHAR(FBUFFER,SIZEOF(FBUFFER),0);
                               UNITWRITE(FUNIT,FBUFFER,FBLKSIZE,DFIRSTBLK);
                               UNITWRITE(FUNIT,FBUFFER,FBLKSIZE,DFIRSTBLK+1)
                             END
                         END
                   END;
                 IF FOPENOLD THEN FRESET(F)
                 ELSE RESETER(F); (*NO GET!*)
         1:      IF IORESULT <> ORD(INOERROR) THEN
                   BEGIN FISOPEN := FALSE; FEOF := TRUE; FEOLN := TRUE END
               END;
           IF SWAPPED THEN
             BEGIN RELEASE(OLDHEAP); SYSCOM^.GDIRP := NIL;
               SAVERSLT := SYSCOM^.IORSLT;
               UNITREAD(SWAPFIB^.FUNIT,EMPTYHEAP^,SIZEOF(DIRECTORY),
                                 SWAPFIB^.FHEADER.DFIRSTBLK);
               SYSCOM^.IORSLT := SAVERSLT
             END
         END
       ELSE SYSCOM^.IORSLT := IBADTITLE
 END (*FOPEN*) ;

 PROCEDURE FCLOSE(*VAR F: FIB; FTYPE: CLOSETYPE*);
   LABEL 1;
   VAR LINX,DUPINX: DIRRANGE; LDIR: DIRP; FOUND: BOOLEAN;
 BEGIN SYSCOM^.IORSLT := INOERROR;
   WITH F DO
     IF FISOPEN AND (FWINDOW <> SYSTERM^.FWINDOW) THEN
       BEGIN
         IF FISBLKD THEN
           WITH FHEADER DO
             IF LENGTH(DTID) > 0 THEN
               BEGIN (*FILE IN A DISK DIRECTORY...FIXUP MAYBE*)
                 IF FTYPE = CCRUNCH THEN
                   BEGIN FMAXBLK := FNXTBLK;
                     DACCESS.YEAR := 100; FTYPE := CLOCK;
                     IF FSOFTBUF THEN FMAXBYTE := FNXTBYTE
                   END;
                 RESETER(F);
                 IF FMODIFIED OR (DACCESS.YEAR = 100) OR (FTYPE = CPURGE) THEN
                   BEGIN (*HAVE TO CHANGE DIRECTORY ENTRY*)
                     IF FUNIT <> VOLSEARCH(FVID,FALSE,LDIR) THEN
                       BEGIN SYSCOM^.IORSLT := ILOSTUNIT; GOTO 1 END;
                     LINX := 1; FOUND := FALSE;
                     WHILE (LINX <= LDIR^[0].DNUMFILES) AND NOT FOUND DO
                       BEGIN (*LOOK FOR FIRST BLOCK MATCH*)
                         FOUND := (LDIR^[LINX].DFIRSTBLK = DFIRSTBLK) AND
                                  (LDIR^[LINX].DLASTBLK = DLASTBLK);
                         LINX := LINX + 1
                       END;
                     IF NOT FOUND THEN
                       BEGIN SYSCOM^.IORSLT := ILOSTFILE; GOTO 1 END;
                     LINX := LINX - 1; (*CORRECT OVERRUN*)
                     IF ((FTYPE = CNORMAL) AND (LDIR^[LINX].DACCESS.YEAR = 100))
                            OR (FTYPE = CPURGE) THEN
                         DELENTRY(LINX,LDIR)  (*ZAP FILE OUT OF EXISTANCE*)
                     ELSE
                       BEGIN (*WELL...LOCK IN A PERM DIR ENTRY*)
                         DUPINX := DIRSEARCH(DTID,TRUE,LDIR);
                         IF (DUPINX <> 0) AND (DUPINX <> LINX) THEN
                           BEGIN (*A DUPLICATE PERM ENTRY...ZAP OLD ONE*)
                             DELENTRY(DUPINX,LDIR);
                             IF DUPINX < LINX THEN LINX := LINX-1
                           END;
                         IF LDIR^[LINX].DACCESS.YEAR = 100 THEN
                           IF DACCESS.YEAR = 100 THEN
                             DACCESS := THEDATE
                           ELSE (*LEAVE ALONE...FILER SPECIAL CASE*)
                         ELSE
                           IF FMODIFIED AND (THEDATE.MONTH <> 0) THEN
                             DACCESS := THEDATE
                           ELSE
                             DACCESS := LDIR^[LINX].DACCESS;
                         DLASTBLK := DFIRSTBLK+FMAXBLK;
                         IF FSOFTBUF THEN DLASTBYTE := FMAXBYTE;
                         FMODIFIED := FALSE; LDIR^[LINX] := FHEADER
                       END;
                     WRITEDIR(FUNIT,LDIR)
                   END
               END;
         IF FTYPE = CPURGE THEN
           IF LENGTH(FHEADER.DTID) = 0 THEN
             UNITABLE[FUNIT].UVID := '';
 1:      FEOF := TRUE; FEOLN := TRUE; FISOPEN := FALSE
       END
 END (*FCLOSE*) ;