(NUMBER)
"PER BRINCH HANSEN

 INFORMATION SCIENCE
 CALIFORNIA INSTITUTE OF TECHNOLOGY

 UTILITY PROGRAMS FOR
 THE SOLO SYSTEM

 18 MAY 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);



"##########################################################
#  LIST(WHAT: DETAIL; KIND: FILEKIND; WHERE: IDENTIFIER)  #
##########################################################"

"INSERT PREFIX HERE"

CONST

CATPAGELENGTH = 16;

MAXSET = 256;


TYPE

CATENTRY = RECORD
             ID: IDENTIFIER;
             ATTR: FILEATTR;
             KEY, SEARCHLENGTH: INTEGER
           END;

CATPAGE = ARRAY (.1..CATPAGELENGTH.) OF CATENTRY;

CATSET = ARRAY (.1..MAXSET.) OF CATENTRY;


VAR

OK: BOOLEAN; WHAT, KIND, WHERE: ARGTYPE;

ACTION: (LISTCATALOG, LISTFILES);
KINDSET: SET OF FILEKIND;

PAGENO: INTEGER; BLOCK: CATPAGE;

CATLENGTH: INTEGER;

TABLE: CATSET; TABLELENGTH: INTEGER;

ENTRIES, PAGES: INTEGER;

PROCEDURE WRITETEXT(TEXT: LINE);
VAR I: INTEGER; C: CHAR;
BEGIN
  I:= 0;
  REPEAT
    I:= I + 1;
    C:= TEXT(.I.);
    IF OK THEN WRITE(C)
          ELSE DISPLAY(C);
  UNTIL C = NL;
END;

PROCEDURE WRITEID(ID: IDENTIFIER);
VAR I: INTEGER;
BEGIN
  FOR I:= 1 TO IDLENGTH DO
    WRITE(ID(.I.));
  WRITE(' ');
END;

PROCEDURE WRITEKIND(KIND: FILEKIND);
BEGIN
  CASE KIND OF
    EMPTY:
      WRITEID('EMPTY       ');
    SCRATCH:
      WRITEID('SCRATCH     ');
    ASCII:
      WRITEID('ASCII       ');
    SEQCODE:
      WRITEID('SEQCODE     ');
    CONCODE:
      WRITEID('CONCODE     ')
  END;
END;

PROCEDURE WRITEPROTECT(PROTECT: BOOLEAN);
BEGIN
  IF PROTECT
    THEN WRITEID('PROTECTED   ')
    ELSE WRITEID('UNPROTECTED ');
END;

PROCEDURE WRITEINT(INT: INTEGER);
VAR NUMBER: ARRAY (.1..6.) OF CHAR;
    DIGIT, REM, I: INTEGER;
BEGIN
  DIGIT:= 0; REM:= INT;
  REPEAT
    DIGIT:= DIGIT + 1;
    NUMBER(.DIGIT.):=
      CHR(REM MOD 10 + ORD('0'));
    REM:= REM DIV 10;
  UNTIL REM = 0;
  FOR I:= 1 TO 6 - DIGIT DO
    WRITE(' ');
  FOR I:= DIGIT DOWNTO 1 DO
    WRITE(NUMBER(.I.));
  WRITE(' ');
END;

PROCEDURE ERROR(TEXT: LINE);
BEGIN
  WRITETEXT(TEXT);
  OK:= FALSE;
END;

PROCEDURE HELP;
BEGIN
  IF OK THEN
  BEGIN
    OK:= FALSE;
    WRITETEXT('TRY AGAIN(:10:)');
    WRITETEXT
      ('     LIST(WHAT: DETAIL; KIND: FILEKIND; WHERE: IDENTIFIER) (:10:)');
    WRITETEXT('USING(:10:)');
    WRITETEXT('     DETAIL = (CATALOG, FILES) (:10:)');
    WRITETEXT('     FILEKIND = (SCRATCH, ASCII, SEQCODE, CONCODE, ALL)(:10:)');
  END;
END;

PROCEDURE INITCAT;
VAR FOUND: BOOLEAN;
BEGIN
  OPEN(1, 'CATALOG     ', FOUND);
  CATLENGTH:= LENGTH(1) * CATPAGELENGTH;
  PAGENO:= 0;
END;

PROCEDURE READCAT(ELEMNO: INTEGER; VAR ELEM: CATENTRY);
VAR INDEX: INTEGER;
BEGIN
  INDEX:= (ELEMNO - 1) DIV CATPAGELENGTH + 1;
  IF PAGENO <> INDEX THEN
  BEGIN
    PAGENO:= INDEX;
    GET(1, PAGENO, BLOCK);
  END;
  ELEM:= BLOCK(.(ELEMNO - 1) MOD CATPAGELENGTH + 1.);
END;

PROCEDURE TERMCAT;
BEGIN CLOSE(1) END;

PROCEDURE PARTITION(VAR TABLE: CATSET;
  FIRST,LAST: INTEGER; VAR MIDDLE: INTEGER);
VAR I: INTEGER; MIDDLE_ELEM, TEMP: CATENTRY;
BEGIN
  I:= FIRST; MIDDLE:= LAST;
  MIDDLE_ELEM:= TABLE(.LAST.);
  WHILE I < MIDDLE DO
  IF TABLE(.I.).ID <= MIDDLE_ELEM.ID THEN
    I:= I + 1 ELSE
  BEGIN
    MIDDLE:= MIDDLE - 1;
    IF TABLE(.MIDDLE.).ID < MIDDLE_ELEM.ID THEN
    BEGIN
      TEMP:= TABLE(.I.);
      TABLE(.I.):= TABLE(.MIDDLE.);
      TABLE(.MIDDLE.):= TEMP;
    END;
  END;
  TABLE(.LAST.):= TABLE(.MIDDLE.);
  TABLE(.MIDDLE.):= MIDDLE_ELEM;
END;

PROCEDURE QUICKSORT(VAR TABLE: CATSET;
  LEFT, RIGHT: INTEGER);
VAR MIDDLE: INTEGER;
BEGIN
  IF LEFT < RIGHT THEN
  BEGIN
    PARTITION(TABLE, LEFT, RIGHT, MIDDLE);
    QUICKSORT(TABLE, LEFT, MIDDLE - 1);
    QUICKSORT(TABLE, MIDDLE + 1, RIGHT);
  END;
END;

PROCEDURE SORT_CATALOG;
VAR NO: INTEGER; THIS: CATENTRY;
BEGIN
  TABLELENGTH:= 0;
  INITCAT;
  FOR NO:= 1 TO CATLENGTH DO
  BEGIN
    READCAT(NO, THIS);
    IF THIS.ID <> '            ' THEN
    BEGIN
      TABLELENGTH:= TABLELENGTH + 1;
      TABLE(.TABLELENGTH.):= THIS;
    END;
  END;
  TERMCAT;
  QUICKSORT(TABLE, 1, TABLELENGTH);
END;

PROCEDURE BEFORE;
BEGIN
  WRITETEXT('SOLO SYSTEM FILES(:10:)');
  WRITE(NL);
  ENTRIES:= 0;
  PAGES:= 0;
END;

PROCEDURE EXAMINE1(THIS: CATENTRY);
VAR ATTR: FILEATTR; FOUND: BOOLEAN; FILELENGTH: INTEGER;
BEGIN
  WITH THIS, ATTR DO
  IF KIND IN KINDSET THEN
  BEGIN
    OPEN(2, ID, FOUND);
    FILELENGTH:= LENGTH(2);
    CLOSE(2);
    ENTRIES:= ENTRIES + 1;
    PAGES:= PAGES + FILELENGTH;
    IF ACTION = LISTFILES THEN
      WRITEINT(ENTRIES + 1);
    WRITEID(ID);
    WRITEKIND(KIND);
    WRITEPROTECT(PROTECTED);
    WRITEINT(FILELENGTH);
    WRITETEXT('PAGES(:10:)');
  END;
END;

PROCEDURE AFTER;
BEGIN
  WRITEINT(ENTRIES);
  WRITETEXT('ENTRIES(:10:)');
  WRITEINT(PAGES);
  WRITETEXT('PAGES(:10:)');
  WRITE(EM);
END;

PROCEDURE EXAMINE2(THIS: CATENTRY);
VAR ATTR: FILEATTR; FOUND: BOOLEAN;
    PAGENO: INTEGER; BLOCK: PAGE;
    ARG: ARGTYPE;
BEGIN
  WITH THIS, ATTR DO
  IF KIND IN KINDSET THEN
  BEGIN
    WRITEARG(OUT, WHERE);
    OPEN(2, ID, FOUND);
    FOR PAGENO:= 1 TO LENGTH(2) DO
    BEGIN
      GET(2, PAGENO, BLOCK);
      WRITEPAGE(BLOCK, FALSE);
    END;
    WRITEPAGE(BLOCK, TRUE);
    CLOSE(2);
    READARG(OUT, ARG);
  OK:= OK & ARG.BOOL;
  END;
END;

PROCEDURE SCAN_CATALOG;
VAR NO: INTEGER; ARG: ARGTYPE;
BEGIN
  WRITEARG(OUT, WHERE);
  BEFORE;
  FOR NO:= 1 TO TABLELENGTH DO
    EXAMINE1(TABLE(.NO.));
  AFTER;
  READARG(OUT, ARG);
  OK:= ARG.BOOL;
  IF ACTION = LISTFILES THEN
  FOR NO:= 1 TO TABLELENGTH DO
    EXAMINE2(TABLE(.NO.));
END;

PROCEDURE INITIALIZE;
VAR ATTR: FILEATTR; FOUND: BOOLEAN;
BEGIN
  IDENTIFY('LIST:(:10:)');
  OK:= TRUE;
  WHAT:= PARAM(.2.);
  WITH WHAT DO
  IF TAG <> IDTYPE THEN HELP ELSE
  IF ID = 'CATALOG     ' THEN
    ACTION:= LISTCATALOG ELSE
  IF ID = 'FILES       ' THEN
    ACTION:= LISTFILES ELSE
    HELP;
  KIND:= PARAM(.3.);
  WITH KIND DO
  IF TAG <> IDTYPE THEN HELP ELSE
  IF ID = 'SCRATCH     ' THEN
    KINDSET:= (.SCRATCH.) ELSE
  IF ID = 'ASCII       ' THEN
    KINDSET:= (.ASCII.) ELSE
  IF ID = 'SEQCODE     ' THEN
    KINDSET:= (.SEQCODE.) ELSE
  IF ID = 'CONCODE     ' THEN
    KINDSET:= (.CONCODE.) ELSE
  IF ID = 'ALL         ' THEN
    KINDSET:= (.SCRATCH, ASCII, SEQCODE, CONCODE.) ELSE
    HELP;
  WHERE:= PARAM(.4.);
  WITH WHERE DO
  IF TAG <> IDTYPE THEN HELP ELSE
  BEGIN
    LOOKUP(ID, ATTR, FOUND);
    IF NOT FOUND THEN
      ERROR('OUTPUT FILE UNKNOWN(:10:)') ELSE
    IF ATTR.KIND <> SEQCODE THEN
      ERROR('OUTPUT FILE MUST BE SEQCODE(:10:)');
  END;
END;

PROCEDURE TERMINATE;
VAR ARG: ARGTYPE;
BEGIN
  WITH PARAM(.1.) DO
  BEGIN TAG:= BOOLTYPE; BOOL:= OK END;
END;


BEGIN
  IF TASK = JOBTASK THEN
  BEGIN
    INITIALIZE;
    IF OK THEN
    BEGIN
      SORT_CATALOG;
      SCAN_CATALOG;
    END;
    TERMINATE;
  END;
END.