(NUMBER)
" PER BRINCH HANSEN

  INFORMATION SCIENCE
  CALIFORNIA INSTITUTE OF TECHNOLOGY

  THE SOLO SYSTEM
  8 JUNE 1975"


"#############
#  IO TYPES  #
#############"


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;

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

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

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


"##########################
#  PROCESSQUEUE AND FIFO  #
##########################"


CONST PROCESSCOUNT = 7;
TYPE PROCESSQUEUE = ARRAY (.1..PROCESSCOUNT.) OF QUEUE;


TYPE FIFO =
CLASS(LIMIT: INTEGER);

VAR HEAD, TAIL, LENGTH: INTEGER;

FUNCTION ENTRY ARRIVAL: INTEGER;
BEGIN
  ARRIVAL:= TAIL;
  TAIL:= TAIL MOD LIMIT + 1;
  LENGTH:= LENGTH + 1;
END;

FUNCTION ENTRY DEPARTURE: INTEGER;
BEGIN
  DEPARTURE:= HEAD;
  HEAD:= HEAD MOD LIMIT + 1;
  LENGTH:= LENGTH - 1;
END;

FUNCTION ENTRY EMPTY: BOOLEAN;
BEGIN EMPTY:= (LENGTH = 0) END;

FUNCTION ENTRY FULL: BOOLEAN;
BEGIN FULL:= (LENGTH = LIMIT) END;

BEGIN HEAD:= 1; TAIL:= 1; LENGTH:= 0 END;


"#############
#  RESOURCE  #
#############"


TYPE RESOURCE =
MONITOR

VAR FREE: BOOLEAN; Q: PROCESSQUEUE; NEXT: FIFO;

PROCEDURE ENTRY REQUEST;
BEGIN
  IF FREE THEN FREE:= FALSE
    ELSE DELAY(Q(.NEXT.ARRIVAL.));
END;

PROCEDURE ENTRY RELEASE;
BEGIN
  IF NEXT.EMPTY THEN FREE:= TRUE
    ELSE CONTINUE(Q(.NEXT.DEPARTURE.));
END;

BEGIN FREE:= TRUE; INIT NEXT(PROCESSCOUNT) END;


"#################
#  TYPERESOURCE  #
#################"


TYPE TYPERESOURCE =
MONITOR

VAR FREE: BOOLEAN; Q: PROCESSQUEUE; NEXT: FIFO; HEADER: LINE;

PROCEDURE ENTRY REQUEST(TEXT: LINE; VAR CHANGED: BOOLEAN);
BEGIN
  IF FREE THEN FREE:= FALSE
    ELSE DELAY(Q(.NEXT.ARRIVAL.));
  CHANGED:= (HEADER <> TEXT);
  HEADER:= TEXT;
END;

PROCEDURE ENTRY RELEASE;
BEGIN
  IF NEXT.EMPTY THEN FREE:= TRUE
    ELSE CONTINUE(Q(.NEXT.DEPARTURE.));
END;

BEGIN
  FREE:= TRUE; HEADER(.1.):= NL;
  INIT NEXT(PROCESSCOUNT);
END;


"###############
#  TYPEWRITER  #
###############"


TYPE TYPEWRITER =
CLASS(DEVICE: IODEVICE);

CONST LINELIMIT = 80;
  CANCELCHAR = '(:127:)'; "RUBOUT"
  CANCELLINE = '(:21:)'; "CNTL-U"
  RETYPELINE = '(:18:)'; "CNTL-R"
           
PROCEDURE WRITECHAR(X: CHAR);
VAR PARAM: IOPARAM; C: CHAR;
BEGIN
  PARAM.OPERATION:= OUTPUT;
  C:= X;
  IO(C, PARAM, DEVICE);
END;

PROCEDURE ENTRY WRITE(TEXT: LINE);
VAR PARAM: IOPARAM;
    I:INTEGER; C: CHAR;
BEGIN
  PARAM.OPERATION:= OUTPUT;
  I:= 0;
  REPEAT
    I:= I + 1; C:= TEXT(.I.);
    IO(C, PARAM, DEVICE);
  UNTIL (C = NL) OR (I = LINELIMIT);
  IF C <> NL THEN WRITECHAR(NL);
END;

PROCEDURE ENTRY READ(VAR TEXT: LINE);
CONST BEL = '(:7:)';
VAR PARAM: IOPARAM;
    I: INTEGER; C: CHAR; L: INTEGER;
BEGIN
  WRITECHAR(BEL);
  PARAM.OPERATION:= INPUT;
  I:= 0;
  REPEAT
    IO(C, PARAM, DEVICE);
    IF C = CANCELLINE THEN
    BEGIN
      WRITECHAR('^');
      WRITECHAR('U');
      WRITECHAR(NL);
      I:= 0;
    END ELSE
    IF C = CANCELCHAR THEN
    BEGIN
      IF I > 0 THEN
      BEGIN
        WRITECHAR(TEXT(.I.));
        I:= I - 1;
      END
    END ELSE
    IF C = RETYPELINE THEN
    BEGIN
      WRITECHAR(NL);
      L := 0;
      IF I > 0 THEN
      BEGIN
        REPEAT
          L := L + 1;
          WRITECHAR(TEXT(.L.));
        UNTIL L = I;
      END;
    END ELSE
    BEGIN I:= I + 1; TEXT(.I.):= C END;
  UNTIL (C = NL) OR (I = LINELIMIT);
  IF C <> NL THEN
  BEGIN
    WRITECHAR(NL);
    TEXT(.LINELIMIT + 1.):= NL;
  END;
END;

BEGIN END;


"#############
#  TERMINAL  #
#############"


TYPE TERMINAL =
CLASS(ACCESS: TYPERESOURCE);

VAR UNIT: TYPEWRITER;

PROCEDURE ENTRY READ(HEADER: LINE; VAR TEXT: LINE);
VAR CHANGED: BOOLEAN;
BEGIN
  ACCESS.REQUEST(HEADER, CHANGED);
  IF CHANGED THEN UNIT.WRITE(HEADER);
  UNIT.READ(TEXT);
  ACCESS.RELEASE;
END;

PROCEDURE ENTRY WRITE(HEADER, TEXT: LINE);
VAR CHANGED: BOOLEAN;
BEGIN
  ACCESS.REQUEST(HEADER, CHANGED);
  IF CHANGED THEN UNIT.WRITE(HEADER);
  UNIT.WRITE(TEXT);
  ACCESS.RELEASE;
END;

BEGIN INIT UNIT(TYPEDEVICE) END;


"###################
#  TERMINALSTREAM  #
###################"


TYPE TERMINALSTREAM =
CLASS(OPERATOR: TERMINAL);

CONST LINELIMIT = 80;

VAR HEADER: LINE; ENDINPUT: BOOLEAN;
    INP, OUT: RECORD COUNT: INTEGER; TEXT: LINE END;

PROCEDURE INITIALIZE(TEXT: LINE);
BEGIN
  HEADER:= TEXT;
  ENDINPUT:= TRUE;
  OUT.COUNT:= 0;
END;

PROCEDURE ENTRY READ(VAR C: CHAR);
BEGIN
  WITH INP DO
  BEGIN
    IF ENDINPUT THEN
    BEGIN
      OPERATOR.READ(HEADER, TEXT);
      COUNT:= 0;
    END;
    COUNT:= COUNT + 1;
    C:= TEXT(.COUNT.);
    ENDINPUT:= (C = NL);
  END;
END;

PROCEDURE ENTRY WRITE(C: CHAR);
BEGIN
  WITH OUT DO
  BEGIN
    COUNT:= COUNT + 1;
    TEXT(.COUNT.):= C;
    IF (C = NL) OR (COUNT = LINELIMIT) THEN
    BEGIN
      OPERATOR.WRITE(HEADER, TEXT);
      COUNT:= 0;
    END;
  END;
END;

PROCEDURE ENTRY RESET(TEXT: LINE);
BEGIN INITIALIZE(TEXT) END;

BEGIN INITIALIZE('UNIDENTIFIED:(:10:)') END;


"#########
#  DISK  #
#########"


TYPE DISK =
CLASS(TYPEUSE: TYPERESOURCE);

VAR OPERATOR: TERMINAL;

PROCEDURE TRANSFER(COMMAND: IOOPERATION;
  PAGEADDR: UNIV IOARG; VAR BLOCK: PAGE);
VAR PARAM: IOPARAM; RESPONSE: LINE;
BEGIN
  WITH PARAM, OPERATOR DO
  BEGIN
    OPERATION:= COMMAND;
    ARG:= PAGEADDR;
    IO(BLOCK, PARAM, DISKDEVICE);
    WHILE STATUS <> COMPLETE DO
    BEGIN
      WRITE('DISK:(:10:)', 'ERROR(:10:)');
      READ('PUSH RETURN(:10:)', RESPONSE);
      IO(BLOCK, PARAM, DISKDEVICE);
    END;
  END;
END;

PROCEDURE ENTRY READ(PAGEADDR: INTEGER; VAR BLOCK: UNIV PAGE);
BEGIN TRANSFER(INPUT, PAGEADDR, BLOCK) END;

PROCEDURE ENTRY WRITE(PAGEADDR: INTEGER; VAR BLOCK: UNIV PAGE);
BEGIN TRANSFER(OUTPUT, PAGEADDR, BLOCK) END;

BEGIN INIT OPERATOR(TYPEUSE) END;


"#########################
#  FILEMAP AND DISKFILE  #
#########################"


CONST MAPLENGTH = 255;
TYPE FILEMAP = RECORD
                 FILELENGTH: INTEGER;
                 PAGESET: ARRAY (.1..MAPLENGTH.) OF INTEGER
               END;


TYPE DISKFILE =
CLASS(TYPEUSE: TYPERESOURCE);

VAR UNIT: DISK; MAP: FILEMAP; OPENED: BOOLEAN;

ENTRY LENGTH: INTEGER;

FUNCTION INCLUDES(PAGENO: INTEGER): BOOLEAN;
BEGIN
  INCLUDES:= OPENED &
    (1 <= PAGENO) & (PAGENO <= LENGTH);
END;

PROCEDURE ENTRY OPEN(MAPADDR: INTEGER);
BEGIN
  UNIT.READ(MAPADDR, MAP);
  LENGTH:= MAP.FILELENGTH;
  OPENED:= TRUE;
END;

PROCEDURE ENTRY CLOSE;
BEGIN
  LENGTH:= 0;
  OPENED:= FALSE;
END;

PROCEDURE ENTRY READ(PAGENO: INTEGER; VAR BLOCK: UNIV PAGE);
BEGIN
  IF INCLUDES(PAGENO) THEN
    UNIT.READ(MAP.PAGESET(.PAGENO.), BLOCK);
END;

PROCEDURE ENTRY WRITE(PAGENO: INTEGER; VAR BLOCK: UNIV PAGE);
BEGIN
  IF INCLUDES(PAGENO) THEN
    UNIT.WRITE(MAP.PAGESET(.PAGENO.), BLOCK);
END;

BEGIN
  INIT UNIT(TYPEUSE);
  LENGTH:= 0;
  OPENED:= FALSE;
END;


"######################
#  CATALOG STRUCTURE  #
######################"


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

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


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

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

CONST CATPAGELENGTH = 16;
TYPE CATPAGE = ARRAY (.1..CATPAGELENGTH.) OF CATENTRY;

CONST CATADDR = 154;


"##############
#  DISKTABLE  #
##############"


TYPE DISKTABLE =
CLASS(TYPEUSE: TYPERESOURCE;
      CATADDR: INTEGER);

VAR FILE: DISKFILE;
    PAGENO: INTEGER; BLOCK: CATPAGE;

ENTRY LENGTH: INTEGER;

PROCEDURE ENTRY READ(I: INTEGER; VAR ELEM: CATENTRY);
VAR INDEX: INTEGER;
BEGIN
  INDEX:= (I - 1) DIV CATPAGELENGTH + 1;
  IF PAGENO <> INDEX THEN
  BEGIN
    PAGENO:= INDEX;
    FILE.READ(PAGENO, BLOCK);
  END;
  ELEM:= BLOCK(.(I - 1) MOD CATPAGELENGTH + 1.);
END;

BEGIN
  INIT FILE(TYPEUSE);
  FILE.OPEN(CATADDR);
  LENGTH:= FILE.LENGTH * CATPAGELENGTH;
  PAGENO:= 0;
END;


"################
#  DISKCATALOG  #
################"


TYPE DISKCATALOG =
MONITOR(TYPEUSE: TYPERESOURCE;
        DISKUSE: RESOURCE; CATADDR: INTEGER);

VAR TABLE: DISKTABLE;

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 TABLE.LENGTH + 1;
  UNTIL (C = ' ') OR (I = IDLENGTH);
  HASH:= KEY;
END;

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

VAR KEY, MORE, INDEX: INTEGER; ELEM: CATENTRY;
BEGIN
  DISKUSE.REQUEST;
  KEY:= HASH(ID);
  TABLE.READ(KEY, ELEM);
  MORE:= ELEM.SEARCHLENGTH;
  INDEX:= KEY; FOUND:= FALSE;
  WHILE NOT FOUND & (MORE > 0) DO
  BEGIN
    TABLE.READ(INDEX, ELEM);
    IF ELEM.ID = ID THEN
    BEGIN ATTR:= ELEM.ATTR; FOUND:= TRUE END
    ELSE
    BEGIN
      IF ELEM.KEY = KEY THEN MORE:= MORE - 1;
      INDEX:= INDEX MOD TABLE.LENGTH + 1;
    END;
  END;
  DISKUSE.RELEASE;
END;

BEGIN INIT TABLE(TYPEUSE, CATADDR) END;


"#############
#  DATAFILE  #
#############"


TYPE DATAFILE =
CLASS(TYPEUSE: TYPERESOURCE; DISKUSE: RESOURCE;
      CATALOG: DISKCATALOG);

VAR FILE: DISKFILE; OPENED: BOOLEAN;

ENTRY LENGTH: INTEGER;

PROCEDURE ENTRY OPEN(ID: IDENTIFIER; VAR FOUND: BOOLEAN);
VAR ATTR: FILEATTR;
BEGIN
  CATALOG.LOOKUP(ID, ATTR, FOUND);
  IF FOUND THEN
  BEGIN
    DISKUSE.REQUEST;
    FILE.OPEN(ATTR.ADDR);
    LENGTH:= FILE.LENGTH;
    DISKUSE.RELEASE;
  END;
  OPENED:= FOUND;
END;

PROCEDURE ENTRY CLOSE;
BEGIN
  FILE.CLOSE;
  LENGTH:= 0;
  OPENED:= FALSE;
END;

PROCEDURE ENTRY READ(PAGENO: INTEGER; VAR BLOCK: UNIV PAGE);
BEGIN
  IF OPENED THEN
  BEGIN
    DISKUSE.REQUEST;
    FILE.READ(PAGENO, BLOCK);
    DISKUSE.RELEASE;
  END;
END;

PROCEDURE ENTRY WRITE(PAGENO: INTEGER; VAR BLOCK: UNIV PAGE);
BEGIN
  IF OPENED THEN
  BEGIN
    DISKUSE.REQUEST;
    FILE.WRITE(PAGENO, BLOCK);
    DISKUSE.RELEASE;
  END;
END;

BEGIN
  INIT FILE(TYPEUSE);
  LENGTH:= 0;
  OPENED:= FALSE;
END;


"###########################
#  PROGSTORE AND PROGFILE  #
###########################"


TYPE PROGSTATE = (READY, NOTFOUND, NOTSEQ, TOOBIG);

CONST STORELENGTH1 = 40;
TYPE PROGSTORE1 =
  ARRAY (.1..STORELENGTH1.) OF PAGE;


TYPE PROGFILE1 =
CLASS(TYPEUSE: TYPERESOURCE; DISKUSE: RESOURCE;
      CATALOG: DISKCATALOG);

VAR FILE: DISKFILE;

ENTRY STORE: PROGSTORE1;

PROCEDURE ENTRY OPEN(ID: IDENTIFIER; VAR STATE: PROGSTATE);
VAR ATTR: FILEATTR; FOUND: BOOLEAN; PAGENO: INTEGER;
BEGIN
  CATALOG.LOOKUP(ID, ATTR, FOUND);
  WITH DISKUSE, FILE, ATTR DO
  IF NOT FOUND THEN
    STATE:= NOTFOUND ELSE
  IF KIND <> SEQCODE THEN
    STATE:= NOTSEQ ELSE
  BEGIN
    REQUEST;
    OPEN(ADDR);
    IF LENGTH <= STORELENGTH1 THEN
    BEGIN
      FOR PAGENO:= 1 TO LENGTH DO
        READ(PAGENO, STORE(.PAGENO.));
      STATE:= READY;
    END ELSE
      STATE:= TOOBIG;
    CLOSE;
    RELEASE;
  END;
END;

BEGIN
  INIT FILE(TYPEUSE);
END;


CONST STORELENGTH2 = 8;
TYPE PROGSTORE2 =
  ARRAY (.1..STORELENGTH2.) OF PAGE;


TYPE PROGFILE2 =
CLASS(TYPEUSE: TYPERESOURCE; DISKUSE: RESOURCE;
      CATALOG: DISKCATALOG);

VAR FILE: DISKFILE;

ENTRY STORE: PROGSTORE2;

PROCEDURE ENTRY OPEN(ID: IDENTIFIER; VAR STATE: PROGSTATE);
VAR ATTR: FILEATTR; FOUND: BOOLEAN; PAGENO: INTEGER;
BEGIN
  CATALOG.LOOKUP(ID, ATTR, FOUND);
  WITH DISKUSE, FILE, ATTR DO
  IF NOT FOUND THEN
    STATE:= NOTFOUND ELSE
  IF KIND <> SEQCODE THEN
    STATE:= NOTSEQ ELSE
  BEGIN
    REQUEST;
    OPEN(ADDR);
    IF LENGTH <= STORELENGTH2 THEN
    BEGIN
      FOR PAGENO:= 1 TO LENGTH DO
        READ(PAGENO, STORE(.PAGENO.));
      STATE:= READY;
    END ELSE
      STATE:= TOOBIG;
    CLOSE;
    RELEASE;
  END;
END;

BEGIN
  INIT FILE(TYPEUSE);
END;


"#############################
#  RESULTTYPE AND PROGSTACK  #
#############################"


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

TYPE ATTRINDEX =
  (CALLER, HEAPTOP, PROGLINE, PROGRESULT, RUNTIME);


TYPE PROGSTACK =
MONITOR

CONST STACKLENGTH = 5;

VAR STACK: ARRAY (.1..STACKLENGTH.) OF
           RECORD
             PROGID: IDENTIFIER;
             HEAPADDR: INTEGER
           END;
    TOP: 0..STACKLENGTH;

FUNCTION ENTRY SPACE: BOOLEAN;
BEGIN SPACE:= (TOP < STACKLENGTH) END;

FUNCTION ENTRY ANY: BOOLEAN;
BEGIN ANY:= (TOP > 0) END;

PROCEDURE ENTRY PUSH(ID: IDENTIFIER);
BEGIN
  IF TOP < STACKLENGTH THEN
  BEGIN
    TOP:= TOP + 1;
    WITH STACK(.TOP.) DO
    BEGIN
      PROGID:= ID;
      HEAPADDR:= ATTRIBUTE(HEAPTOP);
    END;
  END;
END;

PROCEDURE ENTRY POP
  (VAR LINE, RESULT: UNIV INTEGER);
CONST TERMINATED = 0;
BEGIN
  LINE:= ATTRIBUTE(PROGLINE);
  RESULT:= ATTRIBUTE(PROGRESULT);
  IF RESULT <> TERMINATED THEN
    SETHEAP(STACK(.TOP.).HEAPADDR);
  TOP:= TOP - 1;
END;

PROCEDURE ENTRY GET(VAR ID: IDENTIFIER);
BEGIN
  IF TOP > 0 THEN ID:= STACK(.TOP.).PROGID;
END;

BEGIN TOP:= 0 END;


"#########################
#  TASKKIND AND ARGTYPE  #
#########################"


TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK);

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

     ARGTYPE = RECORD
                 TAG: ARGTAG;
                 ARG: IDENTIFIER
               END;

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

TYPE ARGSEQ = (INP, OUT);


"##############
#  ARGBUFFER  #
##############"


TYPE ARGBUFFER =
MONITOR
VAR BUFFER: ARGTYPE; FULL: BOOLEAN;
    SENDER, RECEIVER: QUEUE;

PROCEDURE ENTRY READ(VAR ARG: ARGTYPE);
BEGIN
  IF NOT FULL THEN DELAY(RECEIVER);
  ARG:= BUFFER; FULL:= FALSE;
  CONTINUE(SENDER);
END;

PROCEDURE ENTRY WRITE(ARG: ARGTYPE);
BEGIN
  IF FULL THEN DELAY(SENDER);
  BUFFER:= ARG; FULL:= TRUE;
  CONTINUE(RECEIVER);
END;

BEGIN FULL:= FALSE END;


"###############
#  LINEBUFFER  #
###############"


TYPE LINEBUFFER =
MONITOR
VAR BUFFER: LINE; FULL: BOOLEAN; SENDER, RECEIVER: QUEUE;

PROCEDURE ENTRY READ(VAR TEXT: LINE);
BEGIN
  IF NOT FULL THEN DELAY(RECEIVER);
  TEXT:= BUFFER; FULL:= FALSE;
  CONTINUE(SENDER);
END;

PROCEDURE ENTRY WRITE(TEXT: LINE);
BEGIN
  IF FULL THEN DELAY(SENDER);
  BUFFER:= TEXT; FULL:= TRUE;
  CONTINUE(RECEIVER);
END;

BEGIN FULL:= FALSE END;


"###############
#  PAGEBUFFER  #
###############"


TYPE PAGEBUFFER =
MONITOR
VAR BUFFER: PAGE; LAST, FULL: BOOLEAN;
    SENDER, RECEIVER: QUEUE;

PROCEDURE ENTRY READ(VAR TEXT: PAGE; VAR EOF: BOOLEAN);
BEGIN
  IF NOT FULL THEN DELAY(RECEIVER);
  TEXT:= BUFFER; EOF:= LAST; FULL:= FALSE;
  CONTINUE(SENDER);
END;

PROCEDURE ENTRY WRITE(TEXT: PAGE; EOF: BOOLEAN);
BEGIN
  IF FULL THEN DELAY(SENDER);
  BUFFER:= TEXT; LAST:= EOF; FULL:= TRUE;
  CONTINUE(RECEIVER);
END;

BEGIN FULL:= FALSE END;


"###############
#  CHARSTREAM  #
###############"


TYPE CHARSTREAM =
CLASS(BUFFER: PAGEBUFFER);

VAR TEXT: PAGE; COUNT: INTEGER; EOF: BOOLEAN;


PROCEDURE ENTRY READ(VAR C: CHAR);
BEGIN
  IF COUNT = PAGELENGTH THEN
  BEGIN
    BUFFER.READ(TEXT, EOF);
    COUNT:= 0;
  END;
  COUNT:= COUNT + 1;
  C:= TEXT(.COUNT.);
  IF C = EM THEN
  BEGIN
    WHILE NOT EOF DO BUFFER.READ(TEXT, EOF);
    COUNT:= PAGELENGTH;
  END;
END;

PROCEDURE ENTRY INITREAD;
BEGIN COUNT:= PAGELENGTH END;

PROCEDURE ENTRY WRITE(C: CHAR);
BEGIN
  COUNT:= COUNT + 1;
  TEXT(.COUNT.):= C;
  IF (COUNT = PAGELENGTH) OR (C = EM) THEN
  BEGIN
    BUFFER.WRITE(TEXT, FALSE); COUNT:= 0;
    IF C = EM THEN BUFFER.WRITE(TEXT, TRUE);
  END;
END;

PROCEDURE ENTRY INITWRITE;
BEGIN COUNT:= 0 END;

BEGIN END;


"###############
#  JOBPROCESS  #
###############"


TYPE JOBPROCESS =
PROCESS
  (TYPEUSE: TYPERESOURCE; DISKUSE: RESOURCE;
   CATALOG: DISKCATALOG; INBUFFER, OUTBUFFER: PAGEBUFFER;
   INREQUEST, INRESPONSE, OUTREQUEST, OUTRESPONSE: ARGBUFFER;
   STACK: PROGSTACK);

"PROGRAM DATA SPACE = " +16000

CONST MAXFILE = 2;
TYPE FILE = 1..MAXFILE;

VAR

OPERATOR: TERMINAL; OPSTREAM: TERMINALSTREAM;

INSTREAM, OUTSTREAM: CHARSTREAM;

FILES: ARRAY (.FILE.) OF DATAFILE;

CODE: PROGFILE1;

PROGRAM JOB(VAR PARAM: ARGLIST; STORE: PROGSTORE1);
ENTRY READ, WRITE, OPEN, CLOSE, GET, PUT, LENGTH,
  MARK, RELEASE, IDENTIFY, ACCEPT, DISPLAY, READPAGE,
  WRITEPAGE, READLINE, WRITELINE, READARG, WRITEARG,
  LOOKUP, IOTRANSFER, IOMOVE, TASK, RUN;

PROCEDURE CALL(ID: IDENTIFIER; VAR PARAM: ARGLIST;
  VAR LINE: INTEGER; VAR RESULT: RESULTTYPE);
VAR STATE: PROGSTATE; LASTID: IDENTIFIER;
BEGIN
  WITH CODE, STACK DO
  BEGIN
    LINE:= 0;
    OPEN(ID, STATE);
    IF (STATE = READY) & SPACE THEN
    BEGIN
      PUSH(ID);
      JOB(PARAM, STORE);
      POP(LINE, RESULT);
    END ELSE
    IF STATE = TOOBIG THEN RESULT:= CODELIMIT
                      ELSE RESULT:= CALLERROR;
    IF ANY THEN
    BEGIN GET(LASTID); OPEN(LASTID, STATE) END;
  END;
END;

PROCEDURE ENTRY READ(VAR C: CHAR);
BEGIN INSTREAM.READ(C) END;

PROCEDURE ENTRY WRITE(C: CHAR);
BEGIN OUTSTREAM.WRITE(C) END;

PROCEDURE ENTRY OPEN
(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN);
BEGIN FILES(.F.).OPEN(ID, FOUND) END;

PROCEDURE ENTRY CLOSE(F: FILE);
BEGIN FILES(.F.).CLOSE END;

PROCEDURE ENTRY GET(F: FILE; P: INTEGER; VAR BLOCK: PAGE);
BEGIN FILES(.F.).READ(P, BLOCK) END;

PROCEDURE ENTRY PUT(F: FILE; P: INTEGER; VAR BLOCK: PAGE);
BEGIN FILES(.F.).WRITE(P, BLOCK) END;

FUNCTION ENTRY LENGTH(F: FILE): INTEGER;
BEGIN LENGTH:= FILES(.F.).LENGTH END;

PROCEDURE ENTRY MARK(VAR TOP: INTEGER);
BEGIN TOP:= ATTRIBUTE(HEAPTOP) END;

PROCEDURE ENTRY RELEASE(TOP: INTEGER);
BEGIN SETHEAP(TOP) END;

PROCEDURE ENTRY IDENTIFY(HEADER: LINE);
BEGIN OPSTREAM.RESET(HEADER) END;

PROCEDURE ENTRY ACCEPT(VAR C: CHAR);
BEGIN OPSTREAM.READ(C) END;

PROCEDURE ENTRY DISPLAY(C: CHAR);
BEGIN OPSTREAM.WRITE(C) END;

PROCEDURE ENTRY READPAGE(VAR BLOCK: PAGE; VAR EOF: BOOLEAN);
BEGIN INBUFFER.READ(BLOCK, EOF) END;

PROCEDURE ENTRY WRITEPAGE(BLOCK: PAGE; EOF: BOOLEAN);
BEGIN OUTBUFFER.WRITE(BLOCK, EOF) END;

PROCEDURE ENTRY READLINE(VAR TEXT: LINE);
BEGIN END;

PROCEDURE ENTRY WRITELINE(TEXT: LINE);
BEGIN END;

PROCEDURE ENTRY READARG(S: ARGSEQ; VAR ARG: ARGTYPE);
BEGIN
  IF S = INP THEN INRESPONSE.READ(ARG)
             ELSE OUTRESPONSE.READ(ARG);
END;

PROCEDURE ENTRY WRITEARG(S: ARGSEQ; ARG: ARGTYPE);
BEGIN
  IF S = INP THEN INREQUEST.WRITE(ARG)
             ELSE OUTREQUEST.WRITE(ARG);
END;

PROCEDURE ENTRY LOOKUP
(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN);
BEGIN CATALOG.LOOKUP(ID, ATTR, FOUND) END;

PROCEDURE ENTRY IOTRANSFER
(DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: PAGE);
BEGIN
  IF DEVICE = DISKDEVICE THEN
  BEGIN
    DISKUSE.REQUEST;
    IO(BLOCK, PARAM, DEVICE);
    DISKUSE.RELEASE;
  END ELSE
    IO(BLOCK, PARAM, DEVICE);
END;

PROCEDURE ENTRY IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM);
BEGIN IO(PARAM, PARAM, DEVICE) END;

FUNCTION ENTRY TASK: TASKKIND;
BEGIN TASK:= JOBTASK END;

PROCEDURE ENTRY RUN
(ID: IDENTIFIER; VAR PARAM: ARGLIST;
 VAR LINE: INTEGER; VAR RESULT: RESULTTYPE);
BEGIN CALL(ID, PARAM, LINE, RESULT) END;

PROCEDURE INITIALIZE;
VAR I: INTEGER; PARAM: ARGLIST;
    LINE: INTEGER; RESULT: RESULTTYPE;
BEGIN
  INIT OPERATOR(TYPEUSE), OPSTREAM(OPERATOR),
    INSTREAM(INBUFFER), OUTSTREAM(OUTBUFFER);
  INSTREAM.INITREAD; OUTSTREAM.INITWRITE;
  FOR I:= 1 TO MAXFILE DO
    INIT FILES(.I.)(TYPEUSE, DISKUSE, CATALOG);
  INIT CODE(TYPEUSE, DISKUSE, CATALOG);
  WITH PARAM(.2.) DO
  BEGIN TAG:= IDTYPE; ARG:= 'CONSOLE     ' END;
  CALL('DO          ', PARAM, LINE, RESULT);
  OPERATOR.WRITE('JOBPROCESS:(:10:)', 'TERMINATED (:10:)');
END;

BEGIN INITIALIZE END;


"##############
#  IOPROCESS  #
##############"


TYPE IOPROCESS =
PROCESS
  (TYPEUSE: TYPERESOURCE; DISKUSE: RESOURCE;
   CATALOG: DISKCATALOG; SLOWIO: LINEBUFFER;
   BUFFER: PAGEBUFFER; REQUEST, RESPONSE: ARGBUFFER;
   STACK: PROGSTACK; IOTASK: TASKKIND);

"PROGRAM DATA SPACE = " +2000

TYPE FILE = 1..1;

VAR

OPERATOR: TERMINAL; OPSTREAM: TERMINALSTREAM;

IOSTREAM: CHARSTREAM; IOFILE: DATAFILE;

CODE: PROGFILE2;

PROGRAM DRIVER(VAR PARAM: ARGLIST; STORE: PROGSTORE2);
ENTRY READ, WRITE, OPEN, CLOSE, GET, PUT, LENGTH,
  MARK, RELEASE, IDENTIFY, ACCEPT, DISPLAY, READPAGE,
  WRITEPAGE, READLINE, WRITELINE, READARG, WRITEARG,
  LOOKUP, IOTRANSFER, IOMOVE, TASK, RUN;

PROCEDURE CALL(ID: IDENTIFIER; VAR PARAM: ARGLIST;
  VAR LINE: INTEGER; VAR RESULT: RESULTTYPE);
VAR STATE: PROGSTATE; LASTID: IDENTIFIER;
BEGIN
  WITH CODE, STACK DO
  BEGIN
    LINE:= 0;
    OPEN(ID, STATE);
    IF (STATE = READY) & SPACE THEN
    BEGIN
      PUSH(ID);
      DRIVER(PARAM, STORE);
      POP(LINE, RESULT);
    END ELSE
    IF STATE = TOOBIG THEN RESULT:= CODELIMIT
                      ELSE RESULT:= CALLERROR;
    IF ANY THEN
    BEGIN GET(LASTID); OPEN(LASTID, STATE) END;
  END;
END;

PROCEDURE ENTRY READ(VAR C: CHAR);
BEGIN IOSTREAM.READ(C) END;

PROCEDURE ENTRY WRITE(C: CHAR);
BEGIN IOSTREAM.WRITE(C) END;

PROCEDURE ENTRY OPEN
(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN);
BEGIN IOFILE.OPEN(ID, FOUND) END;

PROCEDURE ENTRY CLOSE(F: FILE);
BEGIN IOFILE.CLOSE END;

PROCEDURE ENTRY GET(F: FILE; P: INTEGER; VAR BLOCK: PAGE);
BEGIN IOFILE.READ(P, BLOCK) END;

PROCEDURE ENTRY PUT(F: FILE; P: INTEGER; VAR BLOCK: PAGE);
BEGIN IOFILE.WRITE(P, BLOCK) END;

FUNCTION ENTRY LENGTH(F: FILE): INTEGER;
BEGIN LENGTH:= IOFILE.LENGTH END;

PROCEDURE ENTRY MARK(VAR TOP: INTEGER);
BEGIN TOP:= ATTRIBUTE(HEAPTOP) END;

PROCEDURE ENTRY RELEASE(TOP: INTEGER);
BEGIN SETHEAP(TOP) END;

PROCEDURE ENTRY IDENTIFY(HEADER: LINE);
BEGIN OPSTREAM.RESET(HEADER) END;

PROCEDURE ENTRY ACCEPT(VAR C: CHAR);
BEGIN OPSTREAM.READ(C) END;

PROCEDURE ENTRY DISPLAY(C: CHAR);
BEGIN OPSTREAM.WRITE(C) END;

PROCEDURE ENTRY READPAGE(VAR BLOCK: PAGE; VAR EOF: BOOLEAN);
BEGIN BUFFER.READ(BLOCK, EOF) END;

PROCEDURE ENTRY WRITEPAGE(BLOCK: PAGE; EOF: BOOLEAN);
BEGIN BUFFER.WRITE(BLOCK, EOF) END;

PROCEDURE ENTRY READLINE(VAR TEXT: LINE);
BEGIN SLOWIO.READ(TEXT) END;

PROCEDURE ENTRY WRITELINE(TEXT: LINE);
BEGIN SLOWIO.WRITE(TEXT) END;

PROCEDURE ENTRY READARG(S: ARGSEQ; VAR ARG: ARGTYPE);
BEGIN REQUEST.READ(ARG) END;

PROCEDURE ENTRY WRITEARG(S: ARGSEQ; ARG: ARGTYPE);
BEGIN RESPONSE.WRITE(ARG) END;

PROCEDURE ENTRY LOOKUP
(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN);
BEGIN CATALOG.LOOKUP(ID, ATTR, FOUND) END;

PROCEDURE ENTRY IOTRANSFER
(DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: PAGE);
BEGIN
  IF DEVICE = DISKDEVICE THEN
  BEGIN
    DISKUSE.REQUEST;
    IO(BLOCK, PARAM, DEVICE);
    DISKUSE.RELEASE;
  END ELSE
    IO(BLOCK, PARAM, DEVICE);
END;

PROCEDURE ENTRY IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM);
BEGIN IO(PARAM, PARAM, DEVICE) END;

FUNCTION ENTRY TASK: TASKKIND;
BEGIN TASK:= IOTASK END;

PROCEDURE ENTRY RUN
(ID: IDENTIFIER; VAR PARAM: ARGLIST;
 VAR LINE: INTEGER; VAR RESULT: RESULTTYPE);
BEGIN CALL(ID, PARAM, LINE, RESULT) END;


PROCEDURE INITIALIZE;
VAR PARAM: ARGLIST; LINE: INTEGER; RESULT: RESULTTYPE;
BEGIN
  INIT OPERATOR(TYPEUSE), OPSTREAM(OPERATOR),
    IOSTREAM(BUFFER),
    IOFILE(TYPEUSE, DISKUSE, CATALOG),
    CODE(TYPEUSE, DISKUSE, CATALOG);
  IF IOTASK = INPUTTASK THEN IOSTREAM.INITWRITE
                        ELSE IOSTREAM.INITREAD;
  CALL('IO          ', PARAM, LINE, RESULT);
  OPERATOR.WRITE('IOPROCESS: (:10:)', 'TERMINATED (:10:)');
END;

BEGIN INITIALIZE END;


"################
#  CARDPROCESS  #
################"


TYPE CARDPROCESS =
PROCESS
  (TYPEUSE: TYPERESOURCE; BUFFER: LINEBUFFER);

VAR OPERATOR: TERMINAL; TEXT: LINE;
    PARAM: IOPARAM; OK: BOOLEAN;
BEGIN
  INIT OPERATOR(TYPEUSE);
  PARAM.OPERATION:= INPUT;
  CYCLE
    REPEAT
      IO(TEXT, PARAM, CARDDEVICE);
      CASE PARAM.STATUS OF
        COMPLETE:
          OK:= TRUE;
        INTERVENTION, FAILURE:
          BEGIN OK:= FALSE; WAIT END;
        TRANSMISSION:
          BEGIN
            OPERATOR.WRITE('CARDS: (:10:)', 'ERROR(:10:)');
            OK:= FALSE;
          END
      END;
    UNTIL OK;
    BUFFER.WRITE(TEXT);
  END;
END;


"###################
#  PRINTERPROCESS  #
###################"


TYPE PRINTERPROCESS =
PROCESS
  (TYPEUSE: TYPERESOURCE; BUFFER: LINEBUFFER);

VAR OPERATOR: TERMINAL; PARAM: IOPARAM;
    TEXT: LINE;

BEGIN
  INIT OPERATOR(TYPEUSE);
  PARAM.OPERATION:= OUTPUT;
  CYCLE
    BUFFER.READ(TEXT);
    IO(TEXT, PARAM, PRINTDEVICE);
    IF PARAM.STATUS <> COMPLETE THEN
    BEGIN
      OPERATOR.WRITE('PRINTER: (:10:)', 'INSPECT(:10:)');
      REPEAT
        WAIT;
        IO(TEXT, PARAM, PRINTDEVICE);
      UNTIL PARAM.STATUS = COMPLETE;
    END;
  END;
END;


"##################
#  LOADERPROCESS  #
##################"

TYPE LOADERPROCESS=
PROCESS(DISKUSE: RESOURCE);

CONST SOLOADDR = 24;
VAR PARAM: IOPARAM;

PROCEDURE INITIALIZE(PAGENO: UNIV IOARG);
BEGIN
  WITH PARAM DO
  BEGIN
    OPERATION:= CONTROL;
    ARG:= PAGENO;
  END;
END;

BEGIN
  INITIALIZE(SOLOADDR);
  "AWAIT BEL SIGNAL"
  IO(PARAM, PARAM, TYPEDEVICE);
  "LOAD SOLO SYSTEM"
  DISKUSE.REQUEST;
  IO(PARAM, PARAM, DISKDEVICE);
  DISKUSE.RELEASE;
END;

"####################
#  INITIAL PROCESS  #
####################"


VAR

TYPEUSE: TYPERESOURCE;

DISKUSE: RESOURCE; CATALOG: DISKCATALOG;

INBUFFER, OUTBUFFER: PAGEBUFFER;

CARDBUFFER, PRINTERBUFFER: LINEBUFFER;

INREQUEST, INRESPONSE, OUTREQUEST, OUTRESPONSE: ARGBUFFER;

INSTACK, OUTSTACK, JOBSTACK: PROGSTACK;

READER: CARDPROCESS; WRITER: PRINTERPROCESS;

PRODUCER, CONSUMER: IOPROCESS; MASTER: JOBPROCESS;


WATCHDOG: LOADERPROCESS;

BEGIN
  INIT
    TYPEUSE, DISKUSE,
    CATALOG(TYPEUSE, DISKUSE, CATADDR),
    INBUFFER, OUTBUFFER,
    CARDBUFFER, PRINTERBUFFER,
    INREQUEST, INRESPONSE, OUTREQUEST, OUTRESPONSE,
    INSTACK, OUTSTACK, JOBSTACK,
    READER(TYPEUSE, CARDBUFFER),
    WRITER(TYPEUSE, PRINTERBUFFER),
    PRODUCER(TYPEUSE, DISKUSE, CATALOG, CARDBUFFER,
      INBUFFER, INREQUEST, INRESPONSE, INSTACK, INPUTTASK),
    CONSUMER(TYPEUSE, DISKUSE, CATALOG, PRINTERBUFFER,
      OUTBUFFER, OUTREQUEST, OUTRESPONSE, OUTSTACK, OUTPUTTASK),
    MASTER(TYPEUSE, DISKUSE, CATALOG, INBUFFER, OUTBUFFER,
      INREQUEST, INRESPONSE, OUTREQUEST, OUTRESPONSE,
      JOBSTACK),
    WATCHDOG(DISKUSE);
END.