(*$M-*)
TYPE
  TEXT = FILE OF CHAR;
  INTFILE = FILE OF INTEGER;
  OBJECTRECORD = RECORD
                   LEN: INTEGER;
                   VALUE: ARRAY [1..25] OF INTEGER
                 END;
  LINEBUFF = ARRAY [1..80] OF CHAR;
  ALFA = PACKED ARRAY [1..ALFALENG] OF CHAR;
 
 
 
      PROCEDURE WRITOFILE ( VAR REC: OBJECTRECORD ;
                VAR PDPOBJ: TEXT;
                VAR OUTPUTHGH: INTFILE );
      VAR
	I,PDPWORD,CHECKSUM: INTEGER ;
	PROCEDURE PUTOBJ ( FCODE: INTEGER ) ;
	 BEGIN
	  IF FCODE < 0
	  THEN PDPWORD := FCODE + 100000B
	  ELSE PDPWORD := FCODE;
	  OUTPUTHGH^ := PDPWORD MOD 256 ;
	  CHECKSUM := CHECKSUM + OUTPUTHGH^ ; PUT( OUTPUTHGH ) ;
	  OUTPUTHGH^ := PDPWORD DIV 256 ;
	  IF FCODE < 0
	  THEN OUTPUTHGH^ := OUTPUTHGH^ + 200B;
	  CHECKSUM := CHECKSUM + OUTPUTHGH^ ; PUT ( OUTPUTHGH ) ;
	 END ;
       BEGIN
	CHECKSUM := 0 ;
	WITH REC DO
	 BEGIN
	  PUTOBJ(1) ;   PUTOBJ( 2*LEN+4 ) ;
	  FOR I := 1 TO LEN DO PUTOBJ(VALUE[I] ) ;
	  OUTPUTHGH^ := (-CHECKSUM ) MOD 256 ;   PUT ( OUTPUTHGH ) ;
          OUTPUTHGH^ := 0;   PUT( OUTPUTHGH ) ;
	  LEN := 1
	 END
       END;
 
  PROCEDURE READFILEIDENTIFIER( VAR FSWL,FSWO,FSWC: BOOLEAN;
              VAR FILENAME: ALFA ;
              VAR PDPOBJ:TEXT;  VAR OUTPUTHGH: INTFILE;
              VAR INPUT: TEXT;  VAR OUTPUT: TEXT;  VAR CODE: TEXT );
 
  VAR
    BUFFER,DEVICE: PACKED ARRAY[1:6] OF CHAR;
    I,J,K,IMAX,UFD,OCVAL,CHINX: INTEGER;      CH,STATUS: CHAR;
    ERROR,NEWSTATUS: BOOLEAN;
 
    PROCEDURE OPERAND;
 
      PROCEDURE SETSTATUS;
       BEGIN
	IF CH # ' '
	THEN
	 BEGIN
	   CASE CH OF
	    ':'  : ERROR := STATUS # ' ';
	    '.'  : ERROR := NOT (STATUS IN [' ',':']);
	    '['  : ERROR := NOT (STATUS IN [' ',':','.']);
	    ','  : ERROR := STATUS # '[';
	    ']'  : ERROR := STATUS # ',';
	    OTHERS:ERROR := TRUE
	   END;
	  IF NOT ERROR
	  THEN
	   BEGIN
	    NEWSTATUS := TRUE; STATUS := CH
	   END
	 END
       END;
      %SETSTATUS\
 
      PROCEDURE NEXTCH;
       BEGIN
	IF NOT EOLN(TTY)
	THEN
	 BEGIN
          READ(TTY,CH);
	  IF  CH = '.'
	  THEN FILENAME := '          '
	 END
	ELSE
	 CASE STATUS OF
	  ' '   : CH := '.';
	  ':'   : CH := '.';
	  '.'   : CH := '[';
	  ']'   : CH := ' ';
	  OTHERS:
		  BEGIN
		   ERROR := TRUE;  CH := ' '
		  END
	 END
       END;
      %NEXTCH\
 
      PROCEDURE READCHAR;
       BEGIN
	I := I + 1;
	IF I > IMAX
	THEN ERROR := TRUE
	ELSE BUFFER[I] := CH
       END;
      %READCHAR\
 
      PROCEDURE READOCTAL;
       BEGIN
	IF CH IN ['0'..'7']
	THEN
	OCVAL := OCVAL * 10B + ORD(CH) - ORD('0')
	ELSE ERROR := TRUE
       END;
      % READOCTAL\
 
     BEGIN   %OPERAND\
       REPEAT
	NEXTCH;
	IF CH IN ['A'..'Z','0'..'9']
	THEN
	 IF STATUS IN ['[',',']
	 THEN READOCTAL
	 ELSE READCHAR
	ELSE SETSTATUS
       UNTIL NEWSTATUS OR ERROR
     END;
    %OPERAND\
 
   BEGIN   %READFILEIDENTIFIER\
     LOOP     % IF FILE NOT FOUND \
       LOOP   % IF INVALID SPECIFICATION \
	FILENAME := '      PAS '; BUFFER := '      '; DEVICE := 'DSK   ';
	CH := ' '; STATUS := ' '; ERROR := FALSE; NEWSTATUS := FALSE;
	UFD := 0; I := 0; IMAX := 6; OCVAL := 0;
 
	 REPEAT
	  OPERAND;
	  IF NOT ERROR
	  THEN
	   BEGIN
	     CASE STATUS OF
	      ':' :
		   IF I > 0
		   THEN DEVICE := BUFFER;
	      '.' :
		    BEGIN
		     FOR J := 1 TO I DO FILENAME[J] := BUFFER[J];
                     K := I + 1 ;
		     IMAX := 3
		    END;
	      '[' :
		    BEGIN
		     IF IMAX = 3
		     THEN K := 6
		     ELSE K := 0;
		     IF I > 0
		     THEN FOR J := 1 TO IMAX DO
		     FILENAME[K + J] := BUFFER[J];
		     IMAX := 6
		    END;
	      ',' : UFD := OCVAL * 1000B*1000B;
	      ']' : UFD := UFD + OCVAL
	     END;
	    I := 0; BUFFER := '      '; OCVAL := 0; NEWSTATUS := FALSE
	   END
	 UNTIL ERROR OR EOLN(TTY) OR (STATUS = ']');
        EXIT IF NOT ERROR;
         WRITELN(TTY,'INVALID FILE SPECIFICATION, REENTER');
         WRITE(TTY,'*');  BREAK;  READLN(TTY);
        END;
 
       RESET(INPUT,FILENAME  ,0,UFD,DEVICE  );
       EXIT IF NOT EOF(INPUT);
 
        WRITELN(TTY,'FILE ',FILENAME,' NOT FOUND, REENTER');
        WRITE(TTY,'*');  BREAK;  READLN(TTY);
       END;
 
           FILENAME[7] := 'O';  FILENAME[8] := 'B';  FILENAME[9] := 'J';
           REWRITE(OUTPUTHGH,FILENAME,0,0,'DSK   ');
           FILENAME[7] := 'L';  FILENAME[8] := 'S';  FILENAME[9] := 'T';
           REWRITE(OUTPUT,FILENAME,0,0,'DSK   ');
           FILENAME[7] := 'C';  FILENAME[8] := 'X';  FILENAME[9] := 'P';
   END     %READFILEIDENTIFIER\ ;
 
  PROCEDURE WTTERR( N: INTEGER );
   BEGIN   WRITE( TTY, 'ERROR IN LINE ', N:6, ':')
   END;
 
  PROCEDURE WTTINT( N: INTEGER );
   BEGIN   WRITE( TTY, N:5 )
   END;
 
  PROCEDURE WTTEOL;
   BEGIN   WRITELN( TTY );
   END;
 
  PROCEDURE WTTHEAD( VAR DAY: ALFA; VAR TIM: ALFA );
  VAR I: INTEGER;   D: PACKED ARRAY[1..9] OF CHAR;
   BEGIN   WRITELN( TTY, 'PASCAL  V4  APR-77');
    D := DATE;  FOR I := 1 TO 9 DO DAY[I] := D[I];
   END;
 
  PROCEDURE WTTSTAT( E: BOOLEAN; P,H,D,T: INTEGER );
  VAR   M,N: INTEGER;   S: PACKED ARRAY [0..2] OF CHAR;
   BEGIN   IF E THEN S := '***' ELSE S := 'NO ';
    WRITELN( TTY, S, ' ERROR DETECTED');
    WRITELN( TTY, 'TOTAL PROGRAM SIZE:         ', P:7:O );
    WRITELN( TTY, 'OUTERMOST DATA SIZE:        ', D:7:O );
    WRITELN( TTY, 'RESERVED STACK & HEAP SIZE: ', H:7:O );
    M := T MOD 60000;   N := M MOD 1000;
    WRITELN( TTY, 'RUNTIME: ',T DIV 60000:3, ':', M DIV 1000:2, '.', N:3 );
   END.