MODULE LIO ;    (* Modifided LineIO, with column indentation on output*)
                (* ERV, 1989 *)
  IMPORT SYS;

CONST MaxBuffer = 4096 ;

TYPE  Buffer   = RECORD
                   handle : INTEGER;
                   n : INTEGER; (*index into bufdata*)
                   m : INTEGER; (*max amount read into bufdata*)
                   out : BOOLEAN; (*TRUE on output file*)
                   indent, column : INTEGER;
                   bufdata : ARRAY MaxBuffer OF CHAR ;
                   slop : LONGINT (*slop in case read file used for writing*)
                 END;

      Rider * = POINTER TO Buffer ;

      OpenProcTyp =
           PROCEDURE (VAR s:ARRAY OF CHAR; VAR handle:INTEGER; rw:INTEGER);



PROCEDURE * FileOpen(VAR s:ARRAY OF CHAR; VAR handle:INTEGER; rw:INTEGER);
(* rw = 0 for read, 1 for write, 2 for r/w  *)
BEGIN SYS.CODE(
  1EH,            (*  push ds  *)
  0C5H, 56H, 0CH, (*  lds dx,dword ptr [bp+12] ;file name *)
  8BH, 46H, 06H,  (*  mov ax,word ptr [bp+06 ] ; rw type *)
  0B4H, 3DH,      (*  mov ah,3Dh *)
  0CDH, 21H,      (*  int 21h    *)
  73H, 03H,       (*  jnc FOok   *)
  0B8H, 00H,00H,  (*  mov   ax,0 *)
                  (*FOok:        *)
  0C5H, 5EH, 08H, (*  lds bx,dword ptr[bp+8];handle  *)
  89H, 07H,       (*  mov word ptr[bx],ax     *)
  1FH)            (*  pop ds                  *)
END FileOpen;


PROCEDURE * FileCreate(VAR s:ARRAY OF CHAR; VAR handle:INTEGER; attr:INTEGER);
BEGIN SYS.CODE(
  1EH,            (*  push ds  *)
  0C5H, 56H, 0CH, (*  lds dx,dword ptr [bp+12] ;file name *)
  8BH, 4EH, 06H,  (*  mov cx,word ptr [bp+06] ; attr *)
  0B4H, 3CH,      (*  mov ah,3Ch *)
  0CDH, 21H,      (*  int 21h    *)
  73H, 03H,       (*  jnc FOok   *)
  0B8H, 00H,00H,  (*  mov   ax,0 *)
                  (*FOok:        *)
  0C5H, 5EH, 08H, (*  lds bx,dword ptr[bp+8];handle  *)
  89H, 07H,       (*  mov word ptr[bx],ax     *)
  1FH)            (*  pop ds                  *)
END FileCreate;

PROCEDURE * FileClose(handle:INTEGER);
BEGIN SYS.CODE(
  8BH, 5EH, 06H,   (*mov bx,word ptr[bp+6]*)
  0B4H, 3EH,       (*mov ah,3Eh           *)
  0CDH, 21H)       (*int 21h              *)
END FileClose;

PROCEDURE * FileRd(VAR buff:ARRAY OF BYTE;
                 handle:INTEGER; size:INTEGER; VAR read:INTEGER);
BEGIN SYS.CODE(
 1EH,              (*  push ds  *)
 0C5H, 56H, 0EH,   (*  lds dx,dword ptr [bp+14] ;buf ptr   *)
 8BH, 5EH, 0CH,    (*  mov bx,word ptr[bp+12]   ;handle    *)
 8BH, 4EH, 0AH,    (*  mov cx,word ptr[bp+10]  ;size      *)
 0B4H, 3FH,        (*  mov ah,3Fh ;read code              *)
 0CDH, 21H,        (*  int 21h                            *)
 73H, 02H,         (*  jnc RDok                           *)
 0F7H, 0D8H,       (*  neg ax ;neg 'read' means error code*)
                   (* RDok:                               *)
 0C5H, 5EH, 06H,   (*  lds bx,dword ptr[bp+6 ];read       *)
 89H, 07H,         (*  mov word ptr [bx],ax               *)
 1FH)              (*  pop ds                             *)
END FileRd;


PROCEDURE * FileWrt(VAR buff:ARRAY OF BYTE;
                 handle:INTEGER; size:INTEGER; VAR wrt:INTEGER);
BEGIN SYS.CODE(
 1EH,              (*  push ds  *)
 0C5H, 56H, 0EH,   (*  lds dx,dword ptr [bp+14] ;buf ptr   *)
 8BH, 5EH, 0CH,    (*  mov bx,word ptr[bp+12]   ;handle    *)
 8BH, 4EH, 0AH,    (*  mov cx,word ptr[bp+10]  ;size      *)
 0B4H, 40H,        (*  mov ah,40h ;write code             *)
 0CDH, 21H,        (*  int 21h                            *)
 73H, 02H,         (*  jnc RDok                           *)
 0F7H, 0D8H,       (*  neg ax ;neg 'read' means error code*)
                   (* RDok:                               *)
 0C5H, 5EH, 06H,   (*  lds bx,dword ptr[bp+6 ];wrt        *)
 89H, 07H,         (*  mov word ptr [bx],ax               *)
 1FH)              (*  pop ds                             *)
END FileWrt;



PROCEDURE Open(VAR s:ARRAY OF CHAR; VAR r:Rider; VAR result:INTEGER;
               mode:INTEGER; Proc : OpenProcTyp );
(* result = 0 for ok, 1 for failure *)
BEGIN
  NEW(r);  r.handle := 0;  r.n := 0 ;  r.m := 0;  r.out := mode > 0 ;
  Proc(s, r.handle, mode);
  IF r.handle # 0 THEN result := 0 ELSE result := 1 END;
  r.indent := 0;  r.column := 0
END Open;

PROCEDURE OpenRead * (s:ARRAY OF CHAR; VAR r:Rider; VAR result:INTEGER);
BEGIN Open(s,r,result,0,FileOpen)
END OpenRead;

PROCEDURE OpenWrite * (s:ARRAY OF CHAR; VAR r:Rider; VAR result:INTEGER);
BEGIN Open(s,r,result,1,FileOpen)
END OpenWrite;

PROCEDURE OpenCreate * (s:ARRAY OF CHAR; VAR r:Rider; VAR result:INTEGER);
BEGIN Open(s,r,result,20H,FileCreate)
END OpenCreate;

PROCEDURE FillBuff(r:Rider);
BEGIN
  FileRd( r.bufdata, r.handle, MaxBuffer, r.m );
  r.n := 0;
  IF r.m < 0 (* end of file, probably *) THEN r.bufdata[0] := 0X END
END FillBuff;

PROCEDURE ReadLn * (r:Rider; VAR s:ARRAY OF CHAR);
(*fixed 8/22/90 -- buffer filling problems *)
VAR i,j:INTEGER;  ch:CHAR;
BEGIN
  s[0] := 00X ;
  IF ~r.out THEN
    i := 0; j := LEN(s,1) - 1 ;
    IF j > 0 THEN
        REPEAT
          IF r.n >= r.m THEN FillBuff(r) END;
          ch := r.bufdata[r.n] ;
          s[i] := ch ; INC(i);  INC(r.n)
        UNTIL (i = j) OR (ch = 0DX);
        IF ch = 0DX THEN DEC(i); (*user never sees the cr *)
          INC(r.n); (*skip linefeed*)
          IF r.n > r.m THEN FillBuff(r); INC(r.n) END; (*lf in next buffer*)
        END;
        IF i = 0 THEN s[0] := " "; i := 1 END; (*null line is 1 blank to caller*)
        s[i] := 0X  (*make sure string terminated*)
    END
  END
END ReadLn;


PROCEDURE DumpBuff(r:Rider);
VAR i:INTEGER;
BEGIN
  IF r.n > 0 THEN
     IF r.out THEN FileWrt(r.bufdata, r.handle, r.n, i) END;
     r.n := 0
  END
END DumpBuff;

PROCEDURE Writev * (r:Rider; VAR s:ARRAY OF CHAR);
VAR i,j:INTEGER; ch:CHAR;
BEGIN
  i := r.n ;   j := 0 ;
  WHILE s[j] # 00X DO
    IF i >= MaxBuffer THEN DumpBuff(r); i := 0 END;
    r.bufdata[i] := s[j] ;
    INC(i); INC(j); INC(r.column)
  END ;
  r.n := i
END Writev;


PROCEDURE WriteLn * (r:Rider);
VAR i:INTEGER; s:ARRAY 256 OF CHAR;
BEGIN
  r.bufdata[r.n] := 0DX;  r.bufdata[r.n + 1] := 0AX ;  INC(r.n, 2); (*CR/LF*)
  DumpBuff(r);  r.column := 0;
  IF r.indent > 0 THEN
   i := 0;  WHILE i < r.indent DO s[i] := " "; INC(i) END;
   s[i] := 0X;
   Writev(r,s)  (*indent the next line*)
  END
END WriteLn;


PROCEDURE Write * (r:Rider; s:ARRAY OF CHAR);
BEGIN Writev(r,s)
END Write;

PROCEDURE WriteCh * (r:Rider; ch:CHAR);
VAR s:ARRAY 4 OF CHAR;
BEGIN s[0] := ch;  s[1] := 00X;  Writev(r,s)
END WriteCh;


PROCEDURE IndentToHere * (r:Rider);
BEGIN  r.indent := r.column
END IndentToHere;

PROCEDURE IndentOff * (r:Rider);
BEGIN r.indent := 0
END IndentOff;

PROCEDURE GetIndent * (r:Rider; VAR in:INTEGER);
BEGIN in := r.indent
END GetIndent;

PROCEDURE SetIndent * (r:Rider; in:INTEGER);
BEGIN r.indent := in
END SetIndent;


PROCEDURE Close * (VAR r:Rider);
BEGIN
 IF r.out & (r.n > 0) THEN WriteLn(r) END;
 FileClose(r.handle);  r := NIL
END Close;


PROCEDURE WriteHex * (r:Rider; li:LONGINT);
VAR i,j,b0,b1,b2,b3:INTEGER;
  PROCEDURE TwoDig(n:INTEGER);
  VAR c,x:INTEGER;  buf:ARRAY 2 OF INTEGER;
  BEGIN c := 0;
    REPEAT x := n MOD 16;  n := n DIV 16;
      IF x > 10 THEN x := x+ORD("A")-10 ELSE x := x+ORD("0") END;
      buf[c] := x; INC(c)
    UNTIL c = 2;
    REPEAT DEC(c); WriteCh(r,CHR(buf[c])) UNTIL c = 0
  END TwoDig;
BEGIN
  b2:= SYS.HI(li);  b3 := SYS.LO(li);
  b0 := SYS.HI(b2);  b1 := SYS.LO(b2);  b2 := SYS.HI(b3);  b3 := SYS.LO(b3);
  IF b0 >= 0A0H THEN WriteCh(r,"0") END;
  IF (b0 # 0) OR (b1 # 0) THEN TwoDig(b0); TwoDig(b1)
  ELSIF b2 >= 0A0H THEN WriteCh(r,"0")
  END;
  TwoDig(b2); TwoDig(b3); WriteCh(r,"H")
END WriteHex;

PROCEDURE WriteInt * (r:Rider; li:LONGINT);
VAR i:INTEGER; buf:ARRAY 30 OF INTEGER;
BEGIN i := 0;  IF li < 0 THEN li := -li;  WriteCh(r,"-") END;
  REPEAT buf[i] := SHORT(li MOD 10);  li := li DIV 10; INC(i) UNTIL li = 0;
  REPEAT DEC(i); WriteCh(r, CHR(buf[i] + ORD("0"))) UNTIL i = 0
END WriteInt;


PROCEDURE * GetDateTime(VAR Y, M, D, h, m : INTEGER;
                        handle:INTEGER);
VAR date, time, hours : INTEGER;
BEGIN SYS.CODE(
 0B4H, 57H,
 0B0H, 00H,
 8BH, 5EH, 06H,
 0CDH, 21H,     (* DOS function 57H: get file date/time *)
 89H, 56H, 0FCH,
 89H, 4EH, 0FAH,

 8BH, 46H, 0FAH,    (*  mov ax,word ptr [bp-6] ; get hh/mm value*)
 0B1H, 0BH,         (*  mov cl,11                                *)
 0D3H, 0E8H,        (*  shr ax,cl     ;isolate h                 *)
 89H, 46H, 0F8H,    (*  mov word ptr [bp-8],ax                   *)
 8BH, 46H, 0FAH,    (*  mov ax,word ptr [bp-6]                   *)
 25H, 0E0H, 07H,    (*  and ax,0000011111100000b                 *)
 0B1H, 05H,         (*  mov cl,5                                 *)
 0D3H, 0E8H,        (*  shr ax,cl                                *)
 89H, 46H, 0FAH     (*  mov word ptr[bp-6],ax                    *)
);
 Y := date DIV 512 ;   Y := Y + 1980 ; (*DOS year starts in 1980 *)
 M := (date MOD 512) DIV 32 ;
 D := date MOD 32;
 h := hours;
 m := time
END GetDateTime;

PROCEDURE FileDate * (VAR Y,M,D,h,m:INTEGER; r:Rider);
BEGIN GetDateTime(Y,M,D,h,m,r.handle)
END FileDate;


END LIO.