xref: /original-bsd/usr.bin/pascal/libpc/unixio.i (revision a1c2194a)
1 (*
2  * Copyright (c) 1979 The Regents of the University of California.
3  * All rights reserved.
4  *
5  * %sccs.include.redist.c%
6  *
7  *	@(#)unixio.i	1.2 (Berkeley) 04/12/91
8  *)
9 
10 const
11 sccsid = '@(#)unixio.i 1.2 04/12/91';
12 
13 type
14 fileptr = record
15 	cnt :integer
16 	end;
17 
18 function TELL(
19 var	fptr :text)
20 {returns} :fileptr;
21 
22 var
23 filesize, headsize, tailsize :integer;
24 result :fileptr;
25 
26 begin
27 tailsize := 0;
28 while not eof(fptr) do begin
29 	get(fptr);
30 	tailsize := tailsize + 1
31 	end;
32 filesize := 0;
33 reset(fptr);
34 while not eof(fptr) do begin
35 	get(fptr);
36 	filesize := filesize + 1
37 	end;
38 reset(fptr);
39 for headsize := 1 to filesize - tailsize do
40 	get(fptr);
41 result.cnt := headsize;
42 TELL := result
43 end;
44 
45 procedure SEEK(
46  var	fptr :text;
47  var	cnt :fileptr);
48 
49 var
50 i :integer;
51 
52 begin
53 reset(fptr);
54 for i := 1 to cnt.cnt do
55 	get(fptr)
56 end;
57 
58 procedure APPEND(
59  var	fptr :text);
60 
61 var
62 tmp :text;
63 
64 begin
65 rewrite(tmp);
66 reset(fptr);
67 while not eof(fptr) do begin
68 	if eoln(fptr) then
69 		writeln(tmp)
70 	else
71 		write(tmp, fptr^);
72 	get(fptr)
73 	end;
74 reset(tmp);
75 rewrite(fptr);
76 while not eof(tmp) do begin
77 	if eoln(tmp) then
78 		writeln(fptr)
79 	else
80 		write(fptr, tmp^);
81 	get(tmp)
82 	end
83 end;
84