PROGRAM include (input, output);
  CONST

  (* standard file descriptors. subscripts in open, etc. *)
    (* these are not to be changed *)
    STDIN = 1;
    STDOUT = 2;
    STDERR = 3;

  (* other io-related stuff *)
    IOERROR = 0;  (* status values for open files *)
    IOAVAIL = 1;
    IOREAD = 2;
    IOWRITE = 3;
    MAXOPEN = 10; (* maximum number of open files *)

  (* universal manifest constants *)
    ENDFILE = -1;
    ENDSTR = 0;   (* null-terminated strings *)
    MAXSTR = 100; (* longest possible string *)

  (* ascii character set in decimal *)
    TAB = 9;
    NEWLINE = 10;
    BLANK = 32;

  TYPE
    character = -1..127;  (* byte-sized. ascii + other stuff *)
    string = ARRAY [1..MAXSTR] OF character;
    filedesc = IOERROR..MAXOPEN;
    ioblock = RECORD  (* to keep track of open files *)
      filevar: TEXT;
      mode: IOERROR..IOWRITE;
    END;

  VAR
    openlist : ARRAY [1..MAXOPEN] of ioblock; (* open files *)

{ getc (UCB) -- get one character from standard input }
function getc (var c : character) : character;
var
    ch : char;
begin
    if eof then
        c := ENDFILE
    else if eoln then begin
        readln;
        c := NEWLINE
    end
    else begin
        read(ch);
        c := ord(ch)
    end;
    getc := c
end;

{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ getcf (UCB) -- get one character from file }
function getcf (var c: character; fd : filedesc) : character;
var
	ch : char;
begin
	if (fd = STDIN) then
		getcf := getc(c)
	else if eof(openlist[fd].filevar) then
		c := ENDFILE
	else if eoln(openlist[fd].filevar) then begin
		read(openlist[fd].filevar, ch);
		c := NEWLINE
	end
	else begin
		read(openlist[fd].filevar, ch);
		c := ord(ch)
	end;
	getcf := c
end;

{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ getline (UCB) -- get a line from file }
function getline (var s : string; fd : filedesc;
		maxsize : integer) : boolean;
var
	i : integer;
	c : character;
begin
	i := 1;
	repeat
		s[i] := getcf(c, fd);
		i := i + 1
	until (c = ENDFILE) or (c = NEWLINE) or (i >= maxsize);
	if (c = ENDFILE) then	{ went one too far }
		i := i - 1;
	s[i] := ENDSTR;
	getline := (c <> ENDFILE)
end;

{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ equal -- test two strings for equality }
function equal (var str1, str2 : string) : boolean;
var
	i : integer;
begin
	i := 1;
	while (str1[i] = str2[i]) and (str1[i] <> ENDSTR) do
		i := i + 1;
	equal := (str1[i] = str2[i])
end;

(* message: print a message to STDERR. *)
PROCEDURE message (CONST s: shortstring);
BEGIN (* FPC standard error specific output: *)
  WRITELN(erroutput, s)
END;

(* error (FPC): Print an error to STDERR and halt. *)
PROCEDURE error(CONST s: shortstring);
BEGIN message(s);
  halt(1)
END;

{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ putc (UCB) -- put one character on standard output }
procedure putc (c : character);
begin
	if c = NEWLINE then
		writeln
	else
		write(chr(c))
end;

{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ putcf (UCB) -- put a single character on file fd }
procedure putcf (c : character; fd : filedesc);
begin
	if (fd = STDOUT) then
		putc(c)
	else if c = NEWLINE then
		writeln(openlist[fd].filevar)
	else
		write(openlist[fd].filevar, chr(c))
end;

{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ putstr (UCB) -- put out string on file }
procedure putstr (var s : string; f : filedesc);
var
	i : integer;
begin
	i := 1;
	while (s[i] <> ENDSTR) do begin
		putcf(s[i], f);
		i := i + 1
	end
end;

(*$i-*)
FUNCTION open (VAR name: string; mode: INTEGER): filedesc;
  VAR
    i: INTEGER;
    intname: shortstring; (* FPC shortstring *)
    found: BOOLEAN;

BEGIN i := 1;
  WHILE (name[i] <> ENDSTR) DO BEGIN
    intname[i] := CHR(name[i]); i := i + 1
  END;
  intname[0] := CHR(i - 1);
  (* Find a free slot in openlist. *)
  open := IOERROR;
  found := FALSE;
  i := 1;
  WHILE (i <= MAXOPEN) AND (NOT found) DO BEGIN
    IF (openlist[i].mode = IOAVAIL) THEN BEGIN
      openlist[i].mode := mode;
      assign(openlist[i].filevar, intname);
      IF (mode = IOREAD) THEN
        RESET(openlist[i].filevar)
      ELSE
        REWRITE(openlist[i].filevar);
      open := i; found := TRUE
    END;
    i := i + 1
  END;
  IF (ioresult <> 0) THEN open := IOERROR
END;
(*$i-*)

{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ mustopen -- open file or die }
function mustopen (var name : string; mode : integer)
		: filedesc;
var
	fd : filedesc;
begin
	fd := open(name, mode);
	if (fd = IOERROR) then begin
		putstr(name, STDERR);
		error(': can''t open file')
	end;
	mustopen := fd
end;

{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ length -- compute length of string }
function length (var s : string) : integer;
var
	n : integer;
begin
	n := 1;
	while (s[n] <> ENDSTR) do
		n := n + 1;
	length := n - 1
end;

{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ close (UCB) -- release file descriptor slot for open file }
procedure xclose (fd : filedesc);
begin
		if (fd > STDERR) and (fd <= MAXOPEN) then begin
		flush(openlist[fd].filevar);    { in case buffered }
		openlist[fd].mode := IOAVAIL
	end
end;

{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ include -- replace #include "file" by contents of file }
procedure include;
var
	incl : string;	{ value is '#include' }

	{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
	{ finclude -- include file desc f }
	procedure finclude (f : filedesc);
	var
		line, str : string;
		loc, i : integer;
		f1 : filedesc;

		{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
		{ getword -- get word from s[i] into out }
		function getword (var s : string; i : integer;
				 var out : string) : integer;
		var
			j : integer;
		begin
			while (s[i] in [BLANK, TAB, NEWLINE]) do
				i := i + 1;
			j := 1;
			while (not (s[i] in [ENDSTR,BLANK,TAB,NEWLINE])) do begin
				out[j] := s[i];
				i := i + 1;
				j := j + 1
			end;
			out[j] := ENDSTR;
			if (s[i] = ENDSTR) then
				getword := 0
			else
				getword := i
		end;

	begin
		while (getline(line, f, MAXSTR)) do begin
			loc := getword(line, 1, str);
			if (not equal(str, incl)) then 
				putstr(line, STDOUT)
			else begin
				loc := getword(line, loc, str);
				str[length(str)] := ENDSTR;	{ remove quotes }
				for i := 1 to length(str) do
					str[i] := str[i+1];
				f1 := mustopen(str, IOREAD);
				finclude(f1);
				xclose(f1)
			end
		end
	end;

begin
	{ setstring(incl, '#include'); }
		incl[1] := ord('#');
		incl[2] := ord('i');
		incl[3] := ord('n');
		incl[4] := ord('c');
		incl[5] := ord('l');
		incl[6] := ord('u');
		incl[7] := ord('d');
		incl[8] := ord('e');
		incl[9] := ENDSTR;
	finclude(STDIN)
end;

PROCEDURE initio;
  VAR
    i: filedesc;
BEGIN
  openlist[STDIN].mode := IOREAD;
  openlist[STDOUT].mode := IOWRITE;
  openlist[STDERR].mode := IOWRITE;

  (* Connect STDERR to user's terminal. *)
  assign(openlist[STDERR].filevar, ''); (* FPC specific. *)
  REWRITE(openlist[STDERR].filevar);
  FOR i := STDERR+1 TO MAXOPEN DO
    openlist[i].mode := IOAVAIL;
END;

BEGIN (* main program *)
  initio; include
END.