m3tohtml/src/DBWr.m3


 Copyright (C) 1992, Digital Equipment Corporation                         
 All rights reserved.                                                      
 See the file COPYRIGHT for a full description.                            
                                                                           
 Last modified on Thu Apr  7 16:17:52 PDT 1994 by kalsow                   

UNSAFE MODULE DBWr;

IMPORT FS, File, OSError, Text;

CONST BIG = 16_1000000; (* 2^24 => 16M *)
TYPE BigPtr = UNTRACED REF ARRAY [0..BIG-1] OF File.Byte;

CONST BufSize = 4096;
TYPE BufPtr = UNTRACED REF ARRAY [0..BufSize-1] OF File.Byte;

REVEAL
  T = T_ BRANDED OBJECT
    file: File.T;
    buf : ARRAY [0..BufSize-1] OF CHAR;
    ptr : BufPtr;
    len : INTEGER;
  OVERRIDES
    init     := Init;
    put_int  := PutInt;
    put_line := PutLine;
    close    := Close;
  END;

PROCEDURE Init (t: T;  path: TEXT): T =
  <*FATAL OSError.E*>
  BEGIN
    t.file := FS.OpenFile (path);
    t.ptr  := ADR (t.buf[0]);
    t.len  := 0;
    RETURN t;
  END Init;

PROCEDURE PutInt (t: T;  i: INTEGER) =
  VAR digits: ARRAY [0..BITSIZE(INTEGER)] OF CHAR;  next := LAST (digits);
  BEGIN
    digits[next] := '\n';  DEC (next);
    REPEAT
      digits [next] := VAL (i MOD 10 + ORD ('0'), CHAR);  DEC (next);
      i := i DIV 10;
    UNTIL (i = 0);
    PutBuf (t, SUBARRAY (digits, next+1, LAST (digits) - next));
  END PutInt;

VAR newline := ARRAY [0..0] OF CHAR { '\n' };

PROCEDURE PutLine (t: T;  txt: TEXT) =
  VAR
    b := NEW (REF ARRAY OF CHAR, Text.Length(txt));
  BEGIN
    Text.SetChars(b^, txt);
    PutBuf (t, b^);
    PutBuf (t, newline);
  END PutLine;

PROCEDURE PutBuf (t: T;  READONLY buf: ARRAY OF CHAR) =
  <*FATAL OSError.E*>
  VAR
    len   := NUMBER (buf);
    empty := NUMBER (t.buf) - t.len;
    ptr: BigPtr;
  BEGIN
    IF (len > empty) THEN
      IF (t.len > 0) THEN t.file.write (SUBARRAY (t.ptr^, 0, t.len)); END;
      t.len := 0;
      empty := NUMBER (t.buf);
    END;

    IF (len > empty) THEN
      ptr := ADR (buf[0]);
      t.file.write (SUBARRAY (ptr^, 0, len));
    ELSE
      SUBARRAY (t.buf, t.len, len) := buf;
      INC (t.len, len);
    END;
  END PutBuf;

PROCEDURE Close (t: T) =
  <*FATAL OSError.E *>
  BEGIN
    IF (t.len > 0) THEN t.file.write (SUBARRAY (t.ptr^, 0, t.len)); END;
    t.file.close ();
  END Close;

BEGIN
END DBWr.