00100	(*$E+*)
00110	PROGRAM DUMMY, WRITOFILE, READFILEIDENTIFIER, SWITCHINIT,
00120		HEAPMARK, HEAPRELEASE, WTTERR, WTTINT, WTTEOL,
00130		WTTSTAT, WTTHEAD, SAVEFDB, UNSAVEFDB, COPYSTP, COPYCTP;
00140	
00170	
00200	TYPE
00300	  TEXT = FILE OF CHAR;
00400	  INTFILE = FILE OF INTEGER;
00500	  OBJECTRECORD = RECORD
00600	                   LEN: INTEGER;
00700	                   VALUE: ARRAY [1..25] OF INTEGER
00800	                 END;
00900	  LINEBUFF = ARRAY [1..80] OF CHAR;
00910	  STR9 = PACKED ARRAY [1..9] OF CHAR;
01010	  INTP = ^ INTEGER;
01020	  BOOLARR = PACKED ARRAY ['A'..'Z'] OF BOOLEAN;
01100	
01200	
01300	
01400	      PROCEDURE WRITOFILE ( VAR REC: OBJECTRECORD ;
01500	                VAR PDPOBJ: TEXT;
01600	                VAR OUTPUTHGH: INTFILE );
01700	      VAR
01800		I,PDPWORD,CHECKSUM: INTEGER ;
01900		PROCEDURE PUTOBJ ( FCODE: INTEGER ) ;
02000		 BEGIN
02100		  IF FCODE < 0
02200		  THEN PDPWORD := FCODE + 100000B
02300		  ELSE PDPWORD := FCODE;
02400		  OUTPUTHGH^ := PDPWORD MOD 256 ;
02500		  CHECKSUM := CHECKSUM + OUTPUTHGH^ ; PUT( OUTPUTHGH ) ;
02600		  OUTPUTHGH^ := PDPWORD DIV 256 ;
02700		  IF FCODE < 0
02800		  THEN OUTPUTHGH^ := OUTPUTHGH^ + 200B;
02900		  CHECKSUM := CHECKSUM + OUTPUTHGH^ ; PUT ( OUTPUTHGH ) ;
03000		 END ;
03100	       BEGIN
03200		CHECKSUM := 0 ;
03300		WITH REC DO
03400		 BEGIN
03500		  PUTOBJ(1) ;   PUTOBJ( 2*LEN+4 ) ;
03600		  FOR I := 1 TO LEN DO PUTOBJ(VALUE[I] ) ;
03700		  OUTPUTHGH^ := (-CHECKSUM ) MOD 256 ;   PUT ( OUTPUTHGH ) ;
03800	          OUTPUTHGH^ := 0;   PUT( OUTPUTHGH ) ;
03900		  LEN := 1
04000		 END
04100	       END;
04200	
04300	  PROCEDURE READFILEIDENTIFIER( VAR FDL,FPW,FLW: INTEGER; VAR FSWON,FSWOFF: BOOLARR;
04400	              VAR FILENAME: STR9 ;
04500	              VAR PDPOBJ:TEXT;  VAR OUTPUTHGH: INTFILE;
04600	              VAR INPUT: TEXT;  VAR OUTPUT: TEXT;  VAR CODE: TEXT );
04700	
04800	  VAR
04900	    BUFFER,DEVICE: PACKED ARRAY[1:6] OF CHAR;
05000	    I,J,K,IMAX,UFD,OCVAL,CHINX: INTEGER;      CH,STATUS: CHAR;
05100	    ERROR,NEWSTATUS: BOOLEAN;
05110	
05112	      PROCEDURE NEXTCH;
05114	       BEGIN
05116		IF NOT EOLN(TTY)
05118		THEN
05120		 BEGIN
05122	          READ(TTY,CH);
05124		  IF  CH = '.'
05126		  THEN FILENAME := '         '
05128		 END
05130		ELSE
05132		 CASE STATUS OF
05134		  ' '   : CH := '.';
05136		  ':'   : CH := '.';
05138		  '.'   : CH := '[';
05140		  ']'   : CH := ' ';
05142		  OTHERS:
05144			  BEGIN
05146			   ERROR := TRUE;  CH := ' '
05148			  END
05150		 END
05152	       END;
05154	      %NEXTCH\
05200	
05300	    PROCEDURE OPERAND;
05400	
05500	      PROCEDURE SETSTATUS;
05600	       BEGIN
05700		IF CH <> ' '
05800		THEN
05900		 BEGIN
06000		   CASE CH OF
06100		    ':'  : ERROR := STATUS <> ' ';
06200		    '.'  : ERROR := NOT (STATUS IN [' ',':']);
06300		    '['  : ERROR := NOT (STATUS IN [' ',':','.']);
06400		    ','  : ERROR := STATUS <> '[';
06500		    ']'  : ERROR := STATUS <> ',';
06510	            '/'  : ERROR := NOT (STATUS IN [' ',':','.',']']);
06600		    OTHERS:ERROR := TRUE
06700		   END;
06800		  IF NOT ERROR
06900		  THEN
07000		   BEGIN
07100		    NEWSTATUS := TRUE; STATUS := CH
07200		   END
07300		 END
07400	       END;
07500	      %SETSTATUS\
09900	
10000	      PROCEDURE READCHAR;
10100	       BEGIN
10200		I := I + 1;
10300		IF I > IMAX
10400		THEN ERROR := TRUE
10500		ELSE BUFFER[I] := CH
10600	       END;
10700	      %READCHAR\
10800	
10900	      PROCEDURE READOCTAL;
11000	       BEGIN
11100		IF CH IN ['0'..'7']
11200		THEN
11300		OCVAL := OCVAL * 10B + ORD(CH) - ORD('0')
11400		ELSE ERROR := TRUE
11500	       END;
11600	      % READOCTAL\
11700	
11800	     BEGIN   %OPERAND\
11900	       REPEAT
12000		NEXTCH;
12100		IF CH IN ['A'..'Z','0'..'9']
12200		THEN
12300		 IF STATUS IN ['[',',']
12400		 THEN READOCTAL
12500		 ELSE READCHAR
12600		ELSE SETSTATUS
12700	       UNTIL NEWSTATUS OR ERROR
12800	     END;
12900	    %OPERAND\
13000	
13100	   BEGIN   %READFILEIDENTIFIER\
13200	     LOOP     % IF FILE NOT FOUND \
13300	       LOOP   % IF INVALID SPECIFICATION \
13400		FILENAME := '      PAS'; BUFFER := '      '; DEVICE := 'DSK   ';
13500		CH := ' '; STATUS := ' '; ERROR := FALSE; NEWSTATUS := FALSE;
13600		UFD := 0; I := 0; IMAX := 6; OCVAL := 0;
13700	
13800		 REPEAT
13900		  OPERAND;
14000		  IF NOT ERROR
14100		  THEN
14200		   BEGIN
14300		     CASE STATUS OF
14400		      ':' :
14500			   IF I > 0
14600			   THEN DEVICE := BUFFER;
14700		      '.' :
14800			    BEGIN
14900			     FOR J := 1 TO I DO FILENAME[J] := BUFFER[J];
15000	                     K := I + 1 ;
15100			     IMAX := 3
15200			    END;
15300		      '[' :
15400			    BEGIN
15500			     IF IMAX = 3
15600			     THEN K := 6
15700			     ELSE K := 0;
15800			     IF I > 0
15900			     THEN FOR J := 1 TO IMAX DO
16000			     FILENAME[K + J] := BUFFER[J];
16100			     IMAX := 6
16200			    END;
16300		      ',' : UFD := OCVAL * 1000B*1000B;
16400		      ']' : UFD := UFD + OCVAL
16500		     END;
16600		    I := 0; BUFFER := '      '; OCVAL := 0; NEWSTATUS := FALSE
16700		   END
16800		 UNTIL ERROR OR EOLN(TTY) OR (STATUS = ']') OR (STATUS = '/');
16805		 WHILE STATUS = '/' DO
16810		  BEGIN
16815		   NEXTCH;   STATUS := CH;
16820		   IF CH = 'P' THEN READ(TTY,FPW)
16825		   ELSE IF CH = 'Q' THEN READ(TTY,FLW)
16830		   ELSE IF CH = 'A' THEN READ(TTY,FDL)
16835		   ELSE
16840		    BEGIN   NEXTCH;
16845		     IF STATUS IN ['A'..'Z'] THEN
16850		      IF CH = '+' THEN FSWON[STATUS] := TRUE
16855		      ELSE IF CH = '-' THEN FSWOFF[STATUS] := TRUE
16860		      ELSE
16865		       BEGIN   ERROR := TRUE;
16870			WRITELN(TTY,'SWITCH ERROR:  /',STATUS,CH);
16875		       END
16880		    END;
16885		   NEXTCH;   STATUS := CH;
16890		  END;
16900	        EXIT IF NOT ERROR;
17000	         WRITELN(TTY,'INVALID FILE SPECIFICATION, REENTER');
17100	         WRITE(TTY,'*');  BREAK;  READLN(TTY);
17200	        END;
17300	
17400	       RESET(INPUT,FILENAME  ,0,UFD,DEVICE  );
17500	       EXIT IF NOT EOF(INPUT);
17600	
17700	        WRITELN(TTY,'FILE ',FILENAME,' NOT FOUND, REENTER');
17800	        WRITE(TTY,'*');  BREAK;  READLN(TTY);
17900	       END;
18000	
18100	           FILENAME[7] := 'O';  FILENAME[8] := 'B';  FILENAME[9] := 'J';
18200	           REWRITE(OUTPUTHGH,FILENAME,0,0,'DSK   ');
18300	           FILENAME[7] := 'L';  FILENAME[8] := 'S';  FILENAME[9] := 'T';
18400	           REWRITE(OUTPUT,FILENAME,0,0,'DSK   ');
18500	           FILENAME[7] := 'C';  FILENAME[8] := 'X';  FILENAME[9] := 'P';
18600	   END     %READFILEIDENTIFIER\ ;
18700	
18705	PROCEDURE SWITCHINIT(VAR FDL,FPW,FLW: INTEGER;
18710		VAR EIS,FIS,FPP,LIST,PRCODE,CONDCOMP,WARNINGS,RUNTMCHECK,
18715		HEAPCHECK,MAIN: BOOLEAN;  VAR HEADER: ALFA );
18720	 BEGIN
18725	  FDL := 3  % ALL POSSIBLE \;
18730	  FPW := 55;   FLW := 120;
18735	  EIS := FALSE;  FIS := FALSE;  FPP := FALSE;
18740	  HEAPCHECK := TRUE;  RUNTMCHECK := TRUE;  LIST := TRUE;
18745	  CONDCOMP := TRUE;  WARNINGS := TRUE;  PRCODE := FALSE;
18750	  MAIN := TRUE;
18755	  HEADER := '5.0       ';
18760	 END;
18765	
18770	PROCEDURE HEAPMARK( VAR M: INTP );
18775	 BEGIN   NEW(M);
18780	 END;
18785	
18790	PROCEDURE HEAPRELEASE( M: INTP );
18795	 BEGIN   DISPOSE(M)
18797	 END;
18798	
18799	
18800	  PROCEDURE WTTERR( N: INTEGER );
18900	   BEGIN   WRITE( TTY, 'ERROR IN LINE ', N:6, ':')
19000	   END;
19100	
19200	  PROCEDURE WTTINT( N: INTEGER );
19300	   BEGIN   WRITE( TTY, N:5 )
19400	   END;
19500	
19600	  PROCEDURE WTTEOL;
19700	   BEGIN   WRITELN( TTY );
19800	   END;
19900	
20000	  PROCEDURE WTTHEAD( VAR HDR,DAY,TIM: ALFA );
20100	  VAR I: INTEGER;
20200	   BEGIN   WRITELN( TTY, 'PASCAL  PDP-11  VERSION ',HDR);
20300	    DATE( DAY );   TIME( TIM );
20310	    WRITELN(TTY,DAY,TIM);
20400	   END;
20500	
20600	  PROCEDURE WTTSTAT( E: BOOLEAN; P,H,D,T: INTEGER );
20700	  VAR   M,N: INTEGER;   S: PACKED ARRAY [0..2] OF CHAR;
20800	   BEGIN   IF E THEN S := '***' ELSE S := 'NO ';
20900	    WRITELN( TTY, S, ' ERROR DETECTED');
21000	    WRITELN( TTY, 'TOTAL PROGRAM SIZE:         ', P:7:O );
21100	    WRITELN( TTY, 'OUTERMOST DATA SIZE:        ', D:7:O );
21200	    WRITELN( TTY, 'RESERVED STACK & HEAP SIZE: ', H:7:O );
21300	    M := T MOD 60000;   N := M MOD 1000;
21400	    WRITELN( TTY, 'RUNTIME: ',T DIV 60000:3, ':', M DIV 1000:2, '.', N:3 );
21500	   END;
21600	
21610	PROCEDURE SAVEFDB ( VAR A,B,C,D: INTEGER );
21620	  BEGIN   WRITELN(TTY);
21630	    WRITELN(TTY,'***** INCLUDE NOT IMPLEMENTED ON DEC-10 *****');
21640	  END;
21650	
21660	PROCEDURE UNSAVEFDB ( VAR A,B: INTEGER );   BEGIN   END;
21670	
21680	PROCEDURE COPYSTP ( P: INTEGER );   BEGIN   END;
21690	
21700	PROCEDURE COPYCTP ( P: INTEGER );   BEGIN   END;
21710	
21720	
21730	BEGIN   (* DUMMY *)
21740	
21800	END.