|
|
1.1 ! root 1: (* Copyright (c) 1979 Regents of the University of California *) ! 2: ! 3: const ! 4: sccsid = '@(#)unixio.i 1.1 6/17/81'; ! 5: ! 6: type ! 7: fileptr = record ! 8: cnt :integer ! 9: end; ! 10: ! 11: function TELL( ! 12: var fptr :text) ! 13: {returns} :fileptr; ! 14: ! 15: var ! 16: filesize, headsize, tailsize :integer; ! 17: result :fileptr; ! 18: ! 19: begin ! 20: tailsize := 0; ! 21: while not eof(fptr) do begin ! 22: get(fptr); ! 23: tailsize := tailsize + 1 ! 24: end; ! 25: filesize := 0; ! 26: reset(fptr); ! 27: while not eof(fptr) do begin ! 28: get(fptr); ! 29: filesize := filesize + 1 ! 30: end; ! 31: reset(fptr); ! 32: for headsize := 1 to filesize - tailsize do ! 33: get(fptr); ! 34: result.cnt := headsize; ! 35: TELL := result ! 36: end; ! 37: ! 38: procedure SEEK( ! 39: var fptr :text; ! 40: var cnt :fileptr); ! 41: ! 42: var ! 43: i :integer; ! 44: ! 45: begin ! 46: reset(fptr); ! 47: for i := 1 to cnt.cnt do ! 48: get(fptr) ! 49: end; ! 50: ! 51: procedure APPEND( ! 52: var fptr :text); ! 53: ! 54: var ! 55: tmp :text; ! 56: ! 57: begin ! 58: rewrite(tmp); ! 59: reset(fptr); ! 60: while not eof(fptr) do begin ! 61: if eoln(fptr) then ! 62: writeln(tmp) ! 63: else ! 64: write(tmp, fptr^); ! 65: get(fptr) ! 66: end; ! 67: reset(tmp); ! 68: rewrite(fptr); ! 69: while not eof(tmp) do begin ! 70: if eoln(tmp) then ! 71: writeln(fptr) ! 72: else ! 73: write(fptr, tmp^); ! 74: get(tmp) ! 75: end ! 76: end;
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.