(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);


"##########################
#  TAPE(VAR OK: BOOLEAN)  #
##########################"


"INSERT PREFIX HERE"

VAR OK: BOOLEAN;

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

PROCEDURE TAPEERROR(RESULT: IORESULT);
BEGIN
  CASE RESULT OF
    INTERVENTION:
      WRITETEXT('INSPECT(:10:)');

    TRANSMISSION:
      WRITETEXT('ERROR(:10:)');

    FAILURE:
      WRITETEXT('FAILURE(:10:)');

    ENDMEDIUM:
      WRITETEXT('ENDMEDIUM(:10:)')
  END;
  OK:= FALSE;
END;

PROCEDURE MOVETAPE(WHERE: IOARG; VAR RESULT: IORESULT);
VAR PARAM: IOPARAM;
BEGIN
  WITH PARAM DO
  BEGIN
    OPERATION:= MOVE;
    ARG:= WHERE;
    IOMOVE(TAPEDEVICE, PARAM);
    RESULT:= STATUS;
  END;
END;

PROCEDURE TRANSFERTAPE
(HOW: IOOPERATION; VAR BLOCK: PAGE; VAR RESULT: IORESULT);
VAR PARAM: IOPARAM;
BEGIN
  WITH PARAM DO
  BEGIN
    OPERATION:= HOW;
    IOTRANSFER(TAPEDEVICE, PARAM, BLOCK);
    RESULT:= STATUS;
  END;
END;

PROCEDURE RECOVER;
VAR STEP, MAXSTEP: INTEGER; RESULT: IORESULT;
BEGIN
  STEP:= 0; MAXSTEP:= 10;
  REPEAT
    STEP:= STEP + 1;
    MOVETAPE(BACKSPACE, RESULT);
    CASE RESULT OF
      COMPLETE, ENDFILE: ;

      INTERVENTION, TRANSMISSION, FAILURE, ENDMEDIUM:
        BEGIN TAPEERROR(RESULT); MAXSTEP:= STEP END;

      STARTMEDIUM:
        MAXSTEP:= STEP
    END
  UNTIL STEP = MAXSTEP;
  WHILE OK & (STEP > 1) DO
  BEGIN
    STEP:= STEP - 1;
    MOVETAPE(UPSPACE, RESULT);
    CASE RESULT OF
      COMPLETE, ENDFILE: ;

      INTERVENTION, TRANSMISSION, FAILURE, ENDMEDIUM:
        TAPEERROR(RESULT)
    END;
  END;
END;

PROCEDURE READTAPE(VAR BLOCK: PAGE; VAR EOF: BOOLEAN);
CONST MAXTIMES = 3;
VAR TIMES: INTEGER; RESULT: IORESULT; DONE: BOOLEAN;
BEGIN
  TIMES:= 0;
  REPEAT
    TIMES:= TIMES + 1;
    TRANSFERTAPE(INPUT, BLOCK, RESULT);
    CASE RESULT OF
      COMPLETE:
        BEGIN EOF:= FALSE; DONE:= TRUE END;

      ENDFILE:
        BEGIN EOF:= TRUE; DONE:= TRUE END;

      INTERVENTION, TRANSMISSION, FAILURE, ENDMEDIUM:
        BEGIN
          IF TIMES < MAXTIMES
            THEN RECOVER
            ELSE TAPEERROR(RESULT);
          EOF:= FALSE; DONE:= NOT OK;
        END
    END
  UNTIL DONE;
END;

PROCEDURE WRITETAPE(VAR BLOCK: PAGE);
CONST MAXTIMES = 3;
VAR TIMES: INTEGER; RESULT: IORESULT; DONE: BOOLEAN;
BEGIN
  TIMES:= 0;
  REPEAT
    TIMES:= TIMES + 1;
    TRANSFERTAPE(OUTPUT, BLOCK, RESULT);
    CASE RESULT OF
      COMPLETE:
        DONE:= TRUE;

      INTERVENTION, TRANSMISSION, FAILURE, ENDMEDIUM:
        BEGIN
          IF TIMES < MAXTIMES
            THEN RECOVER
            ELSE TAPEERROR(RESULT);
          DONE:= NOT OK;
        END
    END
  UNTIL DONE;
END;

PROCEDURE WRITEMARK;
CONST MAXTIMES = 3;
VAR TIMES: INTEGER; RESULT: IORESULT; DONE: BOOLEAN;
BEGIN
  TIMES:= 0;
  REPEAT
    TIMES:= TIMES + 1;
    MOVETAPE(WRITEEOF, RESULT);
    CASE RESULT OF
      COMPLETE, ENDFILE:
        DONE:= TRUE;

      INTERVENTION, TRANSMISSION, FAILURE, ENDMEDIUM:
        BEGIN
          IF TIMES < MAXTIMES
            THEN RECOVER
            ELSE TAPEERROR(RESULT);
          DONE:= NOT OK;
        END
    END
  UNTIL DONE;
END;

PROCEDURE INITIALIZE;
BEGIN
  IDENTIFY('TAPE:(:10:)');
  OK:= TRUE;
END;

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

PROCEDURE TAPEINPUT;
VAR BLOCK: PAGE; EOF: BOOLEAN;
BEGIN
  INITIALIZE;
  REPEAT
    READTAPE(BLOCK, EOF);
    WRITEPAGE(BLOCK, EOF);
  UNTIL NOT OK OR EOF;
  IF NOT EOF THEN WRITEPAGE(BLOCK, TRUE);
  TERMINATE;
END;

PROCEDURE TAPEOUTPUT;
VAR BLOCK: PAGE; EOF: BOOLEAN;
BEGIN
  INITIALIZE;
  READPAGE(BLOCK, EOF);
  WHILE OK & NOT EOF DO
  BEGIN
    WRITETAPE(BLOCK);
    READPAGE(BLOCK, EOF);
  END;
  WHILE NOT EOF DO READPAGE(BLOCK, EOF);
  IF OK THEN WRITEMARK;
  TERMINATE;
END;

BEGIN
  IF TASK = INPUTTASK THEN
    TAPEINPUT ELSE
  IF TASK = OUTPUTTASK THEN
    TAPEOUTPUT;
END.
                                                                                                                                                                                                                                                                         