(NUMBER)
"LUIS MANUEL MEDINA

 INFORMATION SCIENCE
 CALIFORNIA INSTITUTE OF TECHNOLOGY

 UTILITY PROGRAMS FOR
 THE SOLO SYSTEM

 10 SEPTEMBER 1975"


"###########
#  PREFIX  #
###########"


CONST NL = '(:10:)';   FF = '(:12:)';   CR = '(:13:)';   EM = '(:25:)';

CONST PAGELENGTH = 512;
TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR;

CONST LINELENGTH = 132;
TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR;

CONST IDLENGTH = 12;
TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR;

TYPE FILE = 1..2;

TYPE FILEKIND = (EMPTY, SCRATCH, ASCII, SEQCODE, CONCODE);

TYPE FILEATTR = RECORD
                  KIND: FILEKIND;
                  ADDR: INTEGER;
                  PROTECTED: BOOLEAN;
                  NOTUSED: ARRAY (.1..5.) OF INTEGER
                END;

TYPE IODEVICE =
  (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE);

TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL);

TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE);

TYPE IORESULT =
  (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE,
   ENDFILE, ENDMEDIUM, STARTMEDIUM);

TYPE IOPARAM = RECORD
                 OPERATION: IOOPERATION;
                 STATUS: IORESULT;
                 ARG: IOARG
               END;

TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK);

TYPE ARGTAG =
  (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE);

TYPE POINTER = @BOOLEAN;

TYPE ARGTYPE = RECORD
                 CASE TAG: ARGTAG OF
                   NILTYPE, BOOLTYPE: (BOOL: BOOLEAN);
                   INTTYPE: (INT: INTEGER);
                   IDTYPE: (ID: IDENTIFIER);
                   PTRTYPE: (PTR: POINTER)
               END;

CONST MAXARG = 10;
TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE;

TYPE ARGSEQ = (INP, OUT);

TYPE PROGRESULT =
  (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR,
   HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR);

PROCEDURE READ(VAR C: CHAR);
PROCEDURE WRITE(C: CHAR);

PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN);
PROCEDURE CLOSE(F: FILE);
PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE);
PROCEDURE PUT(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE);
FUNCTION LENGTH(F: FILE): INTEGER;

PROCEDURE MARK(VAR TOP: INTEGER);
PROCEDURE RELEASE(TOP: INTEGER);

PROCEDURE IDENTIFY(HEADER: LINE);
PROCEDURE ACCEPT(VAR C: CHAR);
PROCEDURE DISPLAY(C: CHAR);

PROCEDURE READPAGE(VAR BLOCK: UNIV PAGE; VAR EOF: BOOLEAN);
PROCEDURE WRITEPAGE(BLOCK: UNIV PAGE; EOF: BOOLEAN);
PROCEDURE READLINE(VAR TEXT: UNIV LINE);
PROCEDURE WRITELINE(TEXT: UNIV LINE);
PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE);
PROCEDURE WRITEARG(S: ARGSEQ; ARG: ARGTYPE);

PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN);

PROCEDURE IOTRANSFER
  (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: UNIV PAGE);

PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM);

FUNCTION TASK: TASKKIND;

PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST;
              VAR LINE: INTEGER; VAR RESULT: PROGRESULT);


PROGRAM P(VAR PARAM: ARGLIST);


"#########
#  FILE  #
#########"


CONST

    "IMPLEMENTATION CONSTANTS"

    DISK_SIZE = 4800 "PAGES";
    PAGE_SIZE = 256 "WORDS";
    WORDSIZE = 16 "BITS";
    SETSIZE = 8 "WORDS";
    VIRTUALMACHINESIZE = 152; "PAGES"
    FIRSTPAGE = 152; "AFTER VIRTUAL MACHINE"

    "FREELIST PARAMETERS"

    CYLINDERSIZE = 24 "PAGES/CYLINDER";
    CYLINDERLIMIT = 23 "SIZE - 1";
    GROUPSIZE = 5 "CYLINDERS/GROUP";
    GROUPLIMIT = 4 "SIZE - 1";
    FIVECYLINDERSIZE = 120 "CYLINDERSIZE*GROUPSIZE";
    FIVECYLINDERLIMIT = 119 "SIZE - 1";
    FREEPAGESIZE = 31 "GROUPS/FREEPAGE";
    FREEPAGELIMIT = 30 "SIZE - 1";
    FREEPAGECONTENTS = 3720 "FIVECYLINDERSIZE * FREEPAGESIZE";
    FREELISTSIZE = 2 "PAGES IN CORE";
    FREELISTLIMIT = 1 "SIZE - 1";
    FREELISTFIRST = 152 "FIRSTPAGE";
    FREELISTLAST = 153 "FREELISTFIRST + FREELISTLIMIT, HAS TO BE LESS THAN
                        FREEPAGECONTENTS - 1";
    STANDARDGAP = 2; "IF NOT USING RK11, MODIFY ALSO FUNCTION SECTORGAP"

    "CATALOG PARAMETERS"

    MAPLENGTH = 255;
    CATPAGELENGTH = 16;
    CATADDRESS = 154 "FIRSTPAGE+FREELISTLENGTH";
    MAXDIGIT = 32767;
    ASCIIMAX = 127;

    "USEFUL CONSTANTS"

    NULL = 0; NOKEY = 0;
    NONAME = '            ';
    CATFILE = 1;

    "TELETYPE PARAMETERS"

    MAXTTYLINE = 70;


TYPE

    "CLASS TELETYPE"

    TTYLINE = ARRAY (.1..MAXTTYLINE.) OF CHAR;

    "CLASS FREELIST"

    FIVECYLINDER = SET OF 0..FIVECYLINDERLIMIT;
    FREEPAGE = ARRAY (.0..FREEPAGELIMIT.) OF FIVECYLINDER;
    FREEONDISK = RECORD
                   FREEPAGEONDISK: FREEPAGE;
                   MISCELLANEOUS: ARRAY (.1..SETSIZE.) OF INTEGER
                 END;

    "CLASS CATALOG"

    FILEMAP = RECORD
                    FILELENGTH: INTEGER;
                    PAGESET: ARRAY (.1..MAPLENGTH.) OF INTEGER
              END;
    FILEINCORE = CATFILE..CATFILE;

    CATENTRY = RECORD
                   ID: IDENTIFIER;
                   ATTR: FILEATTR;
                   KEY, SEARCHLENGTH: INTEGER
                   END;
    CATPAGE = ARRAY (.1..CATPAGELENGTH.) OF CATENTRY;
    CATRESULT = (NAMING, CATFULL, DISKFULL, FILELIMIT, SUCCES, PROTECTION,
                 SYNTAX);

    "CLASS MANAGER"

    COMMANDTYPE = (REPLACE, CREATE, DELETE, RENAME, PROTECT, NOTHING);


VAR

    "CLASS FREELIST"

    FREELIST: RECORD
                   FIRST, FREEPAGES, PAGEINDEX: INTEGER;
                   CHANGED: BOOLEAN;
                   FREE: FREEPAGE
              END;
    GROUPSET, CYLINDERSET, EMPTYSET: FIVECYLINDER;
    CYLINDERMASK: ARRAY (.0..GROUPLIMIT.) OF FIVECYLINDER;
    PAGEPOINTER, PAGEBASE, GROUPPOINTER, GROUPBASE, CYLINDERPOINTER,
    CYLINDERBASE: INTEGER;
    "EACH POINTER POINTS TO AN ELEMENT INSIDE THE DATA STRUCTURES, EACH BASE
     GIVES THE NUMBER OF SECTORS BEFORE THE POINTED ELEMENT"
    DISPLACEMENT: INTEGER "EQUAL TO PAGEBASE+GROUPBASE";
    SECTOR, FIND, FOUND, CYLINDERGAP: INTEGER;

    "CLASS CATALOG"

    CAT: RECORD
                   INDEX: INTEGER;
                   CHANGED: BOOLEAN;
                   BLOCK: CATPAGE
              END;
    CATLENGTH: INTEGER;
    BUCKET: RECORD
                   NAME: IDENTIFIER;
                   START, LENGTH, INDEX: INTEGER
              END;

    "CLASS MANAGER"

    BADERROR: BOOLEAN;


"*****************
* TELETYPE CLASS *
*****************"


PROCEDURE WRITETEXT (TEXT: TTYLINE);
VAR I: INTEGER; C: CHAR;
BEGIN
  I := 1; C := TEXT(.1.);
  WHILE (C <> '#') & (I < MAXTTYLINE) DO
  BEGIN
    DISPLAY(C);
    I := I + 1; C := TEXT(.I.)
  END;
  DISPLAY(NL)
END;

PROCEDURE WRITEID (ID: IDENTIFIER);
VAR TEXT: TTYLINE; I: INTEGER;
BEGIN
  DISPLAY(NL);
  FOR I := 1 TO IDLENGTH DO TEXT(.I.) := ID(.I.);
  TEXT(.IDLENGTH + 1.) := '#';
  WRITETEXT(TEXT)
END;

PROCEDURE WRITEINT(INT: INTEGER);
VAR T: IDENTIFIER; REM, DIGIT, I, ZERO: INTEGER;
BEGIN
  REM := INT; DIGIT := 0; ZERO := ORD('0');
  REPEAT
    DIGIT := DIGIT + 1;
    T(.DIGIT.) := CHR(ABS(REM MOD 10) + ZERO);
    REM := REM DIV 10
  UNTIL REM = 0;
  DIGIT := DIGIT + 1;
  IF INT < 0 THEN T(.DIGIT.) := '-'
             ELSE T(.DIGIT.) := ' ';
  FOR I := DIGIT DOWNTO 1 DO DISPLAY(T(.I.));
  FOR I := DIGIT+1 TO IDLENGTH DO DISPLAY(' ')
END;

PROCEDURE HELP;
BEGIN
  WRITETEXT('TRY AGAIN#');
  WRITETEXT('     FILE(CREATE, ID, LENGTH, KIND, PROTECTED) #');
  WRITETEXT('     FILE(DELETE, ID)#');
  WRITETEXT('     FILE(PROTECT, ID, PROTECTED)#');
  WRITETEXT('     FILE(RENAME, OLDID, NEWID)#');
  WRITETEXT('     FILE(REPLACE, ID, LENGTH, KIND, PROTECTED)#');
  WRITETEXT('USING#');
  WRITETEXT('     ID, OLDID, NEWID: IDENTIFIER; #');
  WRITETEXT('     LENGTH: 1..255; #');
  WRITETEXT('     KIND: (SCRATCH, ASCII, SEQCODE, CONCODE); #');
  WRITETEXT('     PROTECTED: BOOLEAN; #')
END;


"*******************
* CLASS PARAMETERS *
*******************"


PROCEDURE GETID (ARGNO: INTEGER; VAR IDIN: IDENTIFIER; VAR OK: BOOLEAN);
BEGIN
  WITH PARAM(.ARGNO.) DO
  BEGIN
    IF TAG <> IDTYPE THEN OK := FALSE
    ELSE
    BEGIN
      IDIN := ID;
      OK := TRUE
    END
  END
END;

PROCEDURE GETINT (ARGNO: INTEGER; VAR INTIN: INTEGER; VAR OK: BOOLEAN);
BEGIN
  WITH PARAM(.ARGNO.) DO
  BEGIN
    IF TAG <> INTTYPE THEN OK := FALSE
    ELSE
    BEGIN
      INTIN := INT;
      OK := TRUE
    END
  END
END;

PROCEDURE GETBOOL (ARGNO: INTEGER; VAR BOOLIN: BOOLEAN; VAR OK: BOOLEAN);
BEGIN
  WITH PARAM(.ARGNO.) DO
  BEGIN
    IF TAG <> BOOLTYPE THEN OK := FALSE
    ELSE
    BEGIN
      BOOLIN := BOOL;
      OK := TRUE
    END
  END
END;

PROCEDURE CHECKKIND (ID: IDENTIFIER; VAR KIND: FILEKIND; VAR OK: BOOLEAN);
BEGIN
  OK := TRUE;
  IF ID = 'SCRATCH     ' THEN KIND := SCRATCH ELSE IF
     ID = 'ASCII       ' THEN KIND := ASCII ELSE IF
     ID = 'SEQCODE     ' THEN KIND := SEQCODE ELSE IF
     ID = 'CONCODE     ' THEN KIND := CONCODE
     ELSE OK := FALSE
END;


"*************
* CLASS DISK *
*************"


PROCEDURE IOPAGE (VAR P: UNIV PAGE; ORDER: IOOPERATION; ADDRESS: UNIV IOARG);
VAR PARAM: IOPARAM; C: CHAR;
BEGIN
  WITH PARAM DO
  BEGIN
    OPERATION := ORDER;
    ARG := ADDRESS;
    REPEAT
      IOTRANSFER(DISKDEVICE, PARAM, P);
      IF STATUS <> COMPLETE THEN
      BEGIN
        WRITETEXT('DISK ERROR #');
        WRITETEXT('PUSH RETURN#');
        REPEAT ACCEPT(C) UNTIL C = NL
      END
    UNTIL (STATUS=COMPLETE)
  END
END;


"*****************
* CLASS FREELIST *
*****************"


PROCEDURE GETFREE (FREENO: INTEGER);
VAR FREEDUMMY: FREEONDISK;
BEGIN
  WITH FREELIST, FREEDUMMY DO
  IF FREENO <> PAGEINDEX THEN
  BEGIN
    IF CHANGED THEN
    BEGIN
      FREEPAGEONDISK := FREE;
      IOPAGE(FREEDUMMY, OUTPUT, FREELISTFIRST+PAGEINDEX)
    END;
    IOPAGE(FREEDUMMY, INPUT, FREELISTFIRST+FREENO);
    PAGEINDEX := FREENO;
    CHANGED := FALSE;
    FREE := FREEPAGEONDISK
  END
END;

PROCEDURE SETPARAMETERS (POINTER: INTEGER);
BEGIN
  GROUPPOINTER := POINTER DIV FIVECYLINDERSIZE;
  PAGEPOINTER := GROUPPOINTER DIV FREEPAGESIZE;
  PAGEBASE := PAGEPOINTER * FREEPAGECONTENTS;
  GROUPPOINTER := GROUPPOINTER MOD FREEPAGESIZE;
  GROUPBASE := GROUPPOINTER * FIVECYLINDERSIZE;
  DISPLACEMENT := PAGEBASE + GROUPBASE;
  SECTOR := POINTER MOD FIVECYLINDERSIZE;
  GETFREE(PAGEPOINTER);
  WITH FREELIST DO
  BEGIN
    CHANGED := TRUE "NOT YET, BUT SOON...";
    GROUPSET := FREE(.GROUPPOINTER.)
  END
END;

PROCEDURE INITREMOVE (START, TOTAL: INTEGER; VAR FINISH: BOOLEAN);
BEGIN
  CYLINDERMASK(.0.) := (.0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,
                         16, 17, 18, 19, 20, 21, 22, 23.);
  CYLINDERMASK(.1.) := (.24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36,
                         37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47.);
  CYLINDERMASK(.2.) := (.48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60,
                         61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71.);
  CYLINDERMASK(.3.) := (.72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84,
                         85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95.);
  CYLINDERMASK(.4.) := (.96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107,
                         108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118,
                         119.);
  SETPARAMETERS(START);
  CYLINDERPOINTER := SECTOR DIV CYLINDERSIZE;
  CYLINDERBASE := CYLINDERPOINTER * CYLINDERSIZE;
  FIND := TOTAL; FOUND := 0; CYLINDERGAP := 0;
  GROUPSET := GROUPSET - (.SECTOR.);
  CYLINDERSET := GROUPSET & CYLINDERMASK(.CYLINDERPOINTER.);
  FINISH := FALSE
END;

FUNCTION SECTORGAP (CYLINDERGAP: INTEGER): INTEGER;
CONST LINEARMIN = 44;
VAR F: REAL; ABSGAP: INTEGER;
BEGIN
  IF CYLINDERGAP = 0 THEN SECTORGAP := STANDARDGAP
  ELSE
  BEGIN
    F := CONV(CYLINDERGAP);
    IF CYLINDERGAP < LINEARMIN THEN
      ABSGAP := TRUNC(5.388+F*(0.60186564+F*(-0.01681706+F*0.00018523)))
    ELSE ABSGAP := TRUNC(0.1*F+10.5);
    SECTORGAP := ABSGAP - STANDARDGAP
  END
END;

PROCEDURE SETFIRST;
VAR I: INTEGER;
BEGIN
  I := 0;
  WHILE NOT (I IN CYLINDERSET) DO I := I + 1;
  FREELIST.FIRST := I + DISPLACEMENT
END;

PROCEDURE GETCYLINDER (VAR MAP: FILEMAP; VAR FINISH: BOOLEAN);
BEGIN
  SECTOR := (SECTOR + SECTORGAP(CYLINDERGAP)) MOD CYLINDERSIZE + CYLINDERBASE;
  CYLINDERGAP := 0;
  WHILE (CYLINDERSET <> EMPTYSET) & (FIND > FOUND) DO
  BEGIN
    WHILE NOT (SECTOR IN CYLINDERSET) DO
      SECTOR := (SECTOR + 1) MOD CYLINDERSIZE + CYLINDERBASE;
    GROUPSET := GROUPSET - (.SECTOR.); CYLINDERSET := CYLINDERSET - (.SECTOR.);
    FOUND := FOUND + 1;
    MAP.PAGESET(.FOUND.) := SECTOR + DISPLACEMENT;
    SECTOR := (SECTOR + STANDARDGAP) MOD CYLINDERSIZE + CYLINDERBASE
  END;
  IF (FIND = FOUND) & (CYLINDERSET <> EMPTYSET) THEN
  BEGIN
    SETFIRST;
    FINISH := TRUE
  END
  ELSE FINISH := FALSE
END;

PROCEDURE MOVECYLINDER (DELTA: INTEGER);
BEGIN
  CYLINDERPOINTER := CYLINDERPOINTER + DELTA;
  IF CYLINDERPOINTER <= GROUPLIMIT THEN
  BEGIN
    CYLINDERBASE := CYLINDERPOINTER * CYLINDERSIZE;
    CYLINDERSET := GROUPSET & CYLINDERMASK(.CYLINDERPOINTER.);
    CYLINDERGAP := CYLINDERGAP + 1
  END
END;

PROCEDURE MOVEGROUP (DELTA: INTEGER);
BEGIN
  IF DELTA > 0 THEN FREELIST.FREE(.GROUPPOINTER.) := GROUPSET;
  GROUPPOINTER := GROUPPOINTER + DELTA;
  IF GROUPPOINTER <= FREEPAGELIMIT THEN
  BEGIN
    GROUPBASE := GROUPPOINTER * FIVECYLINDERSIZE;
    GROUPSET := FREELIST.FREE(.GROUPPOINTER.);
    DISPLACEMENT := PAGEBASE + GROUPBASE;
    CYLINDERPOINTER := 0; MOVECYLINDER(0)
  END
END;

PROCEDURE MOVEPAGE;
BEGIN
  PAGEPOINTER := PAGEPOINTER + 1;
  PAGEBASE := PAGEPOINTER * FREEPAGECONTENTS;
  GETFREE(PAGEPOINTER);
  GROUPPOINTER := 0; MOVEGROUP(0)
END;

PROCEDURE FINISHREMOVE (TOTAL: INTEGER);
BEGIN
  WITH FREELIST DO
  BEGIN
    FREEPAGES := FREEPAGES - TOTAL - 1;
    FREE(.GROUPPOINTER.) := GROUPSET;
    CHANGED := TRUE
  END
END;

PROCEDURE REMOVEPAGES (VAR MAP: FILEMAP; ADDR: INTEGER);
VAR FINISH: BOOLEAN;
BEGIN
  INITREMOVE(ADDR, MAP.FILELENGTH, FINISH);
  REPEAT "WITHIN THE FREELIST"
    REPEAT "WITHIN A FREEPAGE"
      REPEAT "WITHIN FIVE CYLINDERS GROUP"
        IF (CYLINDERSET <> EMPTYSET) THEN GETCYLINDER(MAP, FINISH);
        IF NOT FINISH THEN MOVECYLINDER(1)
      UNTIL (CYLINDERPOINTER > GROUPLIMIT) OR FINISH;
      IF NOT FINISH THEN MOVEGROUP(1)
    UNTIL (GROUPPOINTER > FREEPAGELIMIT) OR FINISH;
    IF NOT FINISH THEN MOVEPAGE
  UNTIL FINISH;
  FINISHREMOVE(MAP.FILELENGTH)
END;

PROCEDURE INITRELEASE (VAR MAP: FILEMAP; ADDR: INTEGER);
BEGIN
  WITH FREELIST, MAP DO
  BEGIN
    IOPAGE(MAP, INPUT, ADDR);
    SETPARAMETERS(ADDR);
    FIND := FILELENGTH; FOUND := 0;
    GROUPSET := GROUPSET OR (.SECTOR.);
    FREEPAGES := FREEPAGES + FILELENGTH + 1;
    IF ADDR < FIRST THEN FIRST := ADDR
  END
END;

PROCEDURE INITSHORTEN (VAR MAP: FILEMAP; ADDR, NEWLENGTH: INTEGER);
VAR I, P, OUTOFCYL: INTEGER;
BEGIN
  WITH FREELIST, MAP DO
  BEGIN
    IOPAGE(MAP, INPUT, ADDR);
    SETPARAMETERS(PAGESET(.NEWLENGTH+1.));
    FIND := FILELENGTH; FOUND := NEWLENGTH + 1;
    GROUPSET := GROUPSET OR (.SECTOR.);
    FREEPAGES := FREEPAGES + (MAPLENGTH - NEWLENGTH);
    OUTOFCYL := (SECTOR DIV CYLINDERSIZE +1) * CYLINDERSIZE + DISPLACEMENT;
    I := NEWLENGTH + 1;
    REPEAT
      P := PAGESET(.I.);
      IF P < FIRST THEN FIRST := P;
      I := I + 1
    UNTIL (P>=OUTOFCYL) OR (I>FILELENGTH);
    FILELENGTH := NEWLENGTH
  END
END;


PROCEDURE RELEASEGROUP (MAP: FILEMAP; VAR FINISH: BOOLEAN;
                        VAR NEXTOUT: INTEGER);
VAR DIFFERENCE: INTEGER; MORE: BOOLEAN;
BEGIN
  MORE := TRUE; FINISH := (FIND=FOUND);
  WHILE MORE & NOT FINISH DO
  BEGIN
    NEXTOUT := MAP.PAGESET(.FOUND + 1.);
    DIFFERENCE := NEXTOUT - DISPLACEMENT;
    IF DIFFERENCE <= FIVECYLINDERLIMIT THEN
    BEGIN
      GROUPSET := GROUPSET OR (.DIFFERENCE.);
      FOUND := FOUND + 1
    END
    ELSE MORE := FALSE;
    FINISH := (FIND = FOUND)
  END;
  FREELIST.FREE(.GROUPPOINTER.) := GROUPSET
END;

PROCEDURE RELEASEMAP(MAP: FILEMAP);
VAR FINISH: BOOLEAN; NEXTOUT: INTEGER;
BEGIN
  REPEAT
    RELEASEGROUP(MAP, FINISH, NEXTOUT);
    IF NOT FINISH THEN SETPARAMETERS(NEXTOUT)
  UNTIL FINISH
END;

 "FREELIST PRIMITIVES"

PROCEDURE INITFREE;
VAR FREEIN: FREEONDISK;
BEGIN
  IOPAGE(FREEIN, INPUT, FREELISTFIRST);
  WITH FREELIST, FREEIN DO
  BEGIN
    FIRST := MISCELLANEOUS(.1.);
    FREEPAGES := MISCELLANEOUS(.2.);
    PAGEINDEX := 0;
    CHANGED := FALSE;
    FREE := FREEPAGEONDISK
  END
END;

PROCEDURE FINISHFREE;
VAR FREEOUT: FREEONDISK;
BEGIN
  GETFREE(0);
  WITH FREELIST, FREEOUT DO
  BEGIN
    MISCELLANEOUS(.1.) := FIRST;
    MISCELLANEOUS(.2.) := FREEPAGES;
    FREEPAGEONDISK := FREE
  END;
  IOPAGE(FREEOUT, OUTPUT, FREELISTFIRST)
END;

PROCEDURE ALLOCATE (AMOUNT: INTEGER; VAR ADDR: INTEGER);
VAR MAP: FILEMAP;
BEGIN
  ADDR := FREELIST.FIRST;
  MAP.FILELENGTH := AMOUNT;
  REMOVEPAGES(MAP, ADDR);
  IOPAGE(MAP, OUTPUT, ADDR)
END;

PROCEDURE RELEASE (ADDR: INTEGER);
VAR MAP: FILEMAP;
BEGIN
  INITRELEASE(MAP, ADDR);
  RELEASEMAP(MAP)
END;

PROCEDURE SHORTEN (ADDR, NEWLENGTH: INTEGER);
VAR MAP: FILEMAP;
BEGIN
  IF NEWLENGTH < MAPLENGTH THEN
  BEGIN
  INITSHORTEN(MAP, ADDR, NEWLENGTH);
  RELEASEMAP(MAP);
  IOPAGE(MAP, OUTPUT, ADDR)
  END
END;

FUNCTION DISKSPACE (AMOUNT: INTEGER): BOOLEAN;
BEGIN
  DISKSPACE := (AMOUNT < FREELIST.FREEPAGES)
END;


"****************
* CLASS CATALOG *
****************"


PROCEDURE CATERROR (RESULT: CATRESULT);
BEGIN
  IF RESULT <> SUCCES THEN
  BEGIN
    CASE RESULT OF
      NAMING: WRITETEXT('NAME ERROR# ');
      CATFULL: WRITETEXT('CATALOG FULL# ');
      DISKFULL: WRITETEXT('DISK FULL#');
      FILELIMIT: WRITETEXT('FILE LIMIT# ');
      PROTECTION: WRITETEXT('FILE PROTECTED# ');
      SYNTAX: HELP
    END;
    BADERROR := TRUE
  END
END;

PROCEDURE READCATPAGE (I: INTEGER; VAR ELEM: CATENTRY);
VAR PAGENO: INTEGER;
BEGIN
  WITH CAT DO
  BEGIN
    PAGENO := (I - 1) DIV CATPAGELENGTH + 1;
    IF INDEX <> PAGENO THEN
    BEGIN
      INDEX := PAGENO;
      GET(CATFILE, INDEX, BLOCK)
    END;
    ELEM := BLOCK(.(I - 1) MOD CATPAGELENGTH + 1 .)
  END
END;

FUNCTION HASH (ID: IDENTIFIER): INTEGER;
VAR KEY, I: INTEGER; C: CHAR;
BEGIN
  KEY := 1;
  I := 0;
  REPEAT
    I := I+1;
    C := ID(.I.);
    IF C <> ' ' THEN KEY := KEY * ORD(C) MOD CATLENGTH + 1
  UNTIL (C=' ') OR (I=IDLENGTH);
  HASH := KEY
END;

PROCEDURE GETCAT (I: INTEGER);
VAR PAGENO: INTEGER;
BEGIN
  WITH CAT DO
  BEGIN
    PAGENO := (I-1) DIV CATPAGELENGTH + 1;
    IF INDEX <> PAGENO THEN
    BEGIN
      IF CHANGED THEN PUT(CATFILE, INDEX, BLOCK);
      INDEX := PAGENO;
      GET(CATFILE, INDEX, BLOCK);
      CHANGED := FALSE
    END
  END
END;

PROCEDURE READCAT (I: INTEGER; VAR ELEM: CATENTRY);
BEGIN
  WITH CAT DO
  BEGIN
    GETCAT(I);
    ELEM := BLOCK(.(I-1) MOD CATPAGELENGTH + 1.)
  END
END;

PROCEDURE WRITECAT (I: INTEGER; ELEM: CATENTRY);
BEGIN
  WITH CAT DO
  BEGIN
    GETCAT(I);
    BLOCK(.(I-1) MOD CATPAGELENGTH + 1.) := ELEM;
    CHANGED := TRUE
  END
END;

PROCEDURE INITBUCKET (ID: IDENTIFIER);
VAR ELEM: CATENTRY;
BEGIN
  WITH BUCKET DO
  BEGIN
    START := HASH(ID);
    READCAT(START, ELEM);
    NAME := ELEM.ID;
    LENGTH := ELEM.SEARCHLENGTH;
    INDEX := START
  END
END;

PROCEDURE SEARCHOLD (ID: IDENTIFIER);
VAR MORE: INTEGER; FOUND: BOOLEAN; ELEM: CATENTRY;
BEGIN
  INITBUCKET(ID);
  WITH BUCKET DO IF ID <> NAME THEN
  BEGIN
    MORE := LENGTH;
    INDEX := START MOD CATLENGTH + 1;
    FOUND := FALSE;
    WHILE (MORE>0) & NOT FOUND DO
    BEGIN
      READCAT(INDEX, ELEM);
      NAME := ELEM.ID;
      IF ID = NAME THEN FOUND := TRUE
      ELSE
      BEGIN
        IF ELEM.KEY = START THEN MORE := MORE - 1;
        INDEX := INDEX MOD CATLENGTH + 1
      END
    END
  END
END;

PROCEDURE SEARCHNEW (ID: IDENTIFIER);
VAR MORE: INTEGER; FOUND: BOOLEAN; ELEM: CATENTRY;
BEGIN
  INITBUCKET(ID);
  WITH BUCKET DO IF NAME <> NONAME THEN
  BEGIN
    MORE := CATLENGTH;
    INDEX := START MOD CATLENGTH + 1;
    FOUND := FALSE;
    WHILE (MORE > 0) & NOT FOUND DO
    BEGIN
      READCAT(INDEX, ELEM);
      NAME := ELEM.ID;
      IF NAME = NONAME THEN FOUND := TRUE
      ELSE
      BEGIN
        MORE := MORE - 1;
        INDEX := INDEX MOD CATLENGTH + 1
      END
    END
  END
END;

 "CATALOG PRIMITIVES"

PROCEDURE INITCAT;
VAR FOUND: BOOLEAN;
BEGIN
  OPEN(CATFILE, 'CATALOG     ', FOUND);
  WITH CAT DO
  BEGIN
    INDEX := 0;
    CHANGED := FALSE
  END
END;

PROCEDURE FINISHCAT;
BEGIN
  WITH CAT DO
  BEGIN
    IF CHANGED THEN PUT(CATFILE, INDEX, BLOCK);
    CLOSE(CATFILE)
  END
END;

FUNCTION CATSPACE (ID: IDENTIFIER): BOOLEAN;
BEGIN
  SEARCHNEW(ID);
  CATSPACE := (BUCKET.NAME = NONAME)
END;

FUNCTION CONTAINS (ID: IDENTIFIER): BOOLEAN;
BEGIN
  SEARCHOLD (ID);
  WITH BUCKET DO CONTAINS := (NAME=ID) & (ID<>NONAME)
END;

PROCEDURE READATTR (ID: IDENTIFIER; VAR ATTR: FILEATTR);
VAR ELEM: CATENTRY;
BEGIN
  SEARCHOLD(ID);
  WITH BUCKET DO
  BEGIN
    READCAT(INDEX, ELEM);
    ATTR := ELEM.ATTR
  END
END;

PROCEDURE WRITEATTR (ID: IDENTIFIER; ATTR: FILEATTR);
VAR ELEM: CATENTRY;
BEGIN
  SEARCHOLD(ID);
  WITH BUCKET DO
  BEGIN
    READCAT(INDEX, ELEM);
    ELEM.ATTR := ATTR;
    WRITECAT(INDEX, ELEM)
  END
END;

PROCEDURE INCLUDE (ID: IDENTIFIER; ATTR: FILEATTR);
VAR ELEM: CATENTRY;
BEGIN
  SEARCHNEW(ID);
  WITH BUCKET DO
  BEGIN
    READCAT(INDEX, ELEM);
    ELEM.ID := ID;
    ELEM.ATTR := ATTR;
    ELEM.KEY := START;
    WRITECAT(INDEX,ELEM);
    READCAT(START, ELEM);
    ELEM.SEARCHLENGTH := ELEM.SEARCHLENGTH + 1;
    WRITECAT(START, ELEM)
  END
END;

PROCEDURE EXCLUDE (ID: IDENTIFIER);
VAR ELEM: CATENTRY;
BEGIN
  SEARCHOLD(ID);
  WITH BUCKET DO
  BEGIN
    READCAT(INDEX, ELEM);
    ELEM.ID := NONAME;
    ELEM.KEY := NOKEY;
    WRITECAT(INDEX, ELEM);
    READCAT(START, ELEM);
    ELEM.SEARCHLENGTH := ELEM.SEARCHLENGTH - 1;
    WRITECAT(START, ELEM)
  END
END;


"******************
* CLASS SECRETARY *
******************"


PROCEDURE CREATENEXT (ID: IDENTIFIER; SIZE: INTEGER; NEWKIND: FILEKIND;
                      PROTECTION: BOOLEAN);
VAR ATTR: FILEATTR;
BEGIN
  WITH ATTR DO
  BEGIN
    READATTR('NEXT        ',ATTR);
    SHORTEN(ADDR, SIZE);
    KIND := NEWKIND;  PROTECTED := PROTECTION;
    INCLUDE(ID, ATTR);
    ALLOCATE(MAPLENGTH, ADDR);
    KIND := SCRATCH;
    PROTECTED := TRUE;
    WRITEATTR('NEXT        ', ATTR)
  END
END;

PROCEDURE MOVENEXT;
VAR ATTR: FILEATTR;
BEGIN
  WITH ATTR DO
  BEGIN
    READATTR('NEXT        ', ATTR);
    EXCLUDE('NEXT        ');
    RELEASE(ADDR);
    ALLOCATE(MAPLENGTH, ADDR);
    INCLUDE('NEXT        ', ATTR)
  END
END;

PROCEDURE CREATEIT (ID: IDENTIFIER; SIZE: INTEGER; KIND: FILEKIND;
                    PROTECTION: BOOLEAN; VAR RESULT: CATRESULT);
BEGIN
  IF CONTAINS(ID) THEN RESULT := NAMING
    ELSE IF NOT CATSPACE(ID) THEN RESULT := CATFULL
      ELSE IF (SIZE<1) OR (SIZE>MAPLENGTH) THEN RESULT := FILELIMIT
        ELSE IF NOT DISKSPACE(SIZE) THEN RESULT := DISKFULL
          ELSE
          BEGIN
            RESULT := SUCCES;
            CREATENEXT(ID, SIZE, KIND, PROTECTION)
          END
END;

PROCEDURE REPLACEIT (ID: IDENTIFIER; SIZE: INTEGER; KIND: FILEKIND;
                     PROTECT: BOOLEAN; VAR RESULT: CATRESULT);
VAR ATTR: FILEATTR; MAP: FILEMAP;
BEGIN
  IF NOT CONTAINS(ID) THEN RESULT := NAMING
    ELSE IF (SIZE<1) OR (SIZE>MAPLENGTH) THEN RESULT := FILELIMIT
      ELSE WITH ATTR DO
      BEGIN
        READATTR(ID, ATTR);
        IF PROTECTED THEN RESULT := PROTECTION
        ELSE
        BEGIN
          IOPAGE(MAP, INPUT, ADDR);
          IF NOT DISKSPACE(SIZE-MAP.FILELENGTH-1) THEN RESULT := DISKFULL
          ELSE
          BEGIN
            EXCLUDE(ID);
            RELEASE(ADDR);
            CREATENEXT(ID, SIZE, KIND, PROTECT);
            RESULT := SUCCES
          END
        END
      END
END;

PROCEDURE PROTECTIT (ID: IDENTIFIER; PROTECTION: BOOLEAN;
                     VAR RESULT: CATRESULT);
VAR ATTR: FILEATTR;
BEGIN
  IF NOT CONTAINS(ID) THEN RESULT := NAMING
    ELSE
    BEGIN
      READATTR(ID, ATTR);
      ATTR.PROTECTED := PROTECTION;
      WRITEATTR(ID, ATTR);
      RESULT := SUCCES
    END
END;

PROCEDURE DELETEIT (ID: IDENTIFIER; VAR RESULT: CATRESULT);
VAR ATTR: FILEATTR;
BEGIN
  IF NOT CONTAINS(ID) THEN RESULT := NAMING
    ELSE WITH ATTR DO
    BEGIN
      READATTR(ID, ATTR);
      IF PROTECTED THEN RESULT := PROTECTION
      ELSE
      BEGIN
        EXCLUDE(ID);
        RELEASE(ADDR);
        MOVENEXT;
        RESULT := SUCCES
      END
    END
END;

PROCEDURE RENAMEIT (OLDID, NEWID: IDENTIFIER; VAR RESULT: CATRESULT);
VAR ATTR: FILEATTR;
BEGIN
  IF CONTAINS(NEWID) OR NOT CONTAINS(OLDID) THEN RESULT := NAMING
    ELSE WITH ATTR DO
    BEGIN
      READATTR(OLDID, ATTR);
      IF ATTR.PROTECTED THEN RESULT := PROTECTION
      ELSE
      BEGIN
        EXCLUDE(OLDID);
        INCLUDE(NEWID, ATTR);
        RESULT := SUCCES
      END
    END
END;


"******************
* CLASS ASSISTANT *
******************"


PROCEDURE INITFILES;
BEGIN
  INITCAT;
  CATLENGTH := LENGTH(CATFILE)*CATPAGELENGTH;
  INITFREE
END;

PROCEDURE REPLACEFILE;
VAR ID: IDENTIFIER; OK, PROTECTION: BOOLEAN; SIZE: INTEGER;
    KIND: FILEKIND; RESULT: CATRESULT; IDKIND: IDENTIFIER;
BEGIN
  GETID(3, ID, OK);
  IF OK THEN GETINT(4, SIZE, OK);
  IF OK THEN GETID(5, IDKIND, OK);
  IF OK THEN CHECKKIND(IDKIND, KIND, OK);
  IF OK THEN GETBOOL(6, PROTECTION, OK);
  IF OK THEN REPLACEIT(ID, SIZE, KIND, PROTECTION, RESULT)
    ELSE RESULT := SYNTAX;
  CATERROR(RESULT)
END;

PROCEDURE CREATEFILE;
VAR ID: IDENTIFIER; OK, PROTECTION: BOOLEAN; SIZE: INTEGER;
    KIND: FILEKIND; RESULT: CATRESULT; IDKIND: IDENTIFIER;
BEGIN
  GETID(3, ID, OK);
  IF OK THEN GETINT(4, SIZE, OK);
  IF OK THEN GETID(5, IDKIND, OK);
  IF OK THEN CHECKKIND(IDKIND, KIND, OK);
  IF OK THEN GETBOOL(6, PROTECTION, OK);
  IF OK THEN CREATEIT(ID, SIZE, KIND, PROTECTION, RESULT)
    ELSE RESULT := SYNTAX;
  CATERROR(RESULT)



END;

PROCEDURE PROTECTFILE;
VAR ID: IDENTIFIER; PROTECTION, OK: BOOLEAN; RESULT: CATRESULT;
BEGIN
  GETID(3, ID, OK);
  IF OK THEN GETBOOL(4, PROTECTION, OK);
  IF OK THEN PROTECTIT(ID, PROTECTION, RESULT)
    ELSE RESULT := SYNTAX;
  CATERROR(RESULT)
END;

PROCEDURE DELETEFILE;
VAR ID: IDENTIFIER; RESULT: CATRESULT; OK: BOOLEAN; ARG: IDENTIFIER;
BEGIN
  GETID(3, ID, OK);
  IF NOT OK THEN RESULT := SYNTAX
    ELSE DELETEIT(ID, RESULT);
  CATERROR(RESULT)
END;

PROCEDURE RENAMEFILE;
VAR OLDID, NEWID: IDENTIFIER; OK: BOOLEAN; ARG: IDENTIFIER;
    RESULT: CATRESULT;
BEGIN
  GETID(3, OLDID, OK);
  IF OK THEN GETID(4, NEWID, OK);
  IF NOT OK THEN RESULT := SYNTAX
    ELSE RENAMEIT(OLDID, NEWID, RESULT);
  CATERROR(RESULT)
END;

PROCEDURE SAVEFILES;
BEGIN
  FINISHCAT; FINISHFREE
END;

PROCEDURE GIVEANSWER (RESULT: BOOLEAN);
BEGIN
  WITH PARAM(.1.) DO
  BEGIN
    TAG := BOOLTYPE;
    BOOL := RESULT
  END
END;

PROCEDURE FINISH;
BEGIN
  SAVEFILES;
  GIVEANSWER(NOT BADERROR)
END;

PROCEDURE COMPLAIN;
BEGIN
  CATERROR(SYNTAX);
  BADERROR := TRUE
END;

FUNCTION COMMAND: COMMANDTYPE;
VAR OK, ERROR: BOOLEAN; ID: IDENTIFIER;
BEGIN
  ERROR := FALSE;
  GETID(2, ID, OK);
  IF OK THEN
  IF ID = 'REPLACE     ' THEN COMMAND := REPLACE ELSE IF
     ID = 'CREATE      ' THEN COMMAND := CREATE ELSE IF
     ID = 'DELETE      ' THEN COMMAND := DELETE ELSE IF
     ID = 'RENAME      ' THEN COMMAND := RENAME ELSE IF
     ID = 'PROTECT     ' THEN COMMAND := PROTECT
     ELSE ERROR := TRUE;
  IF ERROR OR NOT OK THEN COMMAND := NOTHING
END;


"****************
* CLASS MANAGER *
****************"


PROCEDURE INITIALIZE;
VAR I: INTEGER; K: FILEINCORE;
BEGIN
  IDENTIFY('FILE:(:10:)');
  BADERROR := FALSE;
  EMPTYSET := (. .);
  INITFILES
END;


BEGIN
  IF TASK = JOBTASK THEN
  BEGIN
    INITIALIZE;
    CASE COMMAND OF
      REPLACE: REPLACEFILE;
      CREATE: CREATEFILE;
      DELETE: DELETEFILE;
      RENAME: RENAMEFILE;
      PROTECT: PROTECTFILE;
      NOTHING: COMPLAIN
    END;
    FINISH
  END
  ELSE GIVEANSWER(FALSE)
END.