home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / oberon / lineio.mod < prev    next >
Text File  |  1991-02-24  |  7KB  |  221 lines
  1. MODULE LineIO ;         (* ERV, 1989/91 *)
  2.   IMPORT SYS:=SYSTEM;
  3.  
  4. CONST MaxBuffer = 4096 ;
  5.  
  6. TYPE  Buffer   = RECORD
  7.                    handle : INTEGER;
  8.                    n : INTEGER; (*index into bufdata*)
  9.                    m : INTEGER; (*max amount read into bufdata*)
  10.                    out : BOOLEAN; (*TRUE on output file*)
  11.                    bufdata : ARRAY MaxBuffer OF CHAR ;
  12.                    slop : LONGINT (*slop in case read file used for writing*)
  13.                  END;
  14.  
  15.       Rider * = POINTER TO Buffer ;
  16.  
  17.       OpenProcTyp =
  18.            PROCEDURE (VAR s:ARRAY OF CHAR; VAR handle:INTEGER; rw:INTEGER);
  19.  
  20.  
  21. PROCEDURE * FileOpen(VAR s:ARRAY OF CHAR; VAR handle:INTEGER; rw:INTEGER);
  22. (* rw = 0 for read, 1 for write, 2 for r/w  *)
  23. BEGIN SYS.CODE(
  24.   1EH,            (*  push ds  *)
  25.   0C5H, 56H, 0CH, (*  lds dx,dword ptr [bp+12] ;file name *)
  26.   8BH, 46H, 06H,  (*  mov ax,word ptr [bp+06 ] ; rw type *)
  27.   0B4H, 3DH,      (*  mov ah,3Dh *)
  28.   0CDH, 21H,      (*  int 21h    *)
  29.   73H, 03H,       (*  jnc FOok   *)
  30.   0B8H, 00H,00H,  (*  mov   ax,0 *)
  31.                   (*FOok:        *)
  32.   0C5H, 5EH, 08H, (*  lds bx,dword ptr[bp+8];handle  *)
  33.   89H, 07H,       (*  mov word ptr[bx],ax     *)
  34.   1FH)            (*  pop ds                  *)
  35. END FileOpen;
  36.  
  37.  
  38. PROCEDURE * FileCreate(VAR s:ARRAY OF CHAR; VAR handle:INTEGER; attr:INTEGER);
  39. BEGIN SYS.CODE(
  40.   1EH,            (*  push ds  *)
  41.   0C5H, 56H, 0CH, (*  lds dx,dword ptr [bp+12] ;file name *)
  42.   8BH, 4EH, 06H,  (*  mov cx,word ptr [bp+06] ; attr *)
  43.   0B4H, 3CH,      (*  mov ah,3Ch *)
  44.   0CDH, 21H,      (*  int 21h    *)
  45.   73H, 03H,       (*  jnc FOok   *)
  46.   0B8H, 00H,00H,  (*  mov   ax,0 *)
  47.                   (*FOok:        *)
  48.   0C5H, 5EH, 08H, (*  lds bx,dword ptr[bp+8];handle  *)
  49.   89H, 07H,       (*  mov word ptr[bx],ax     *)
  50.   1FH)            (*  pop ds                  *)
  51. END FileCreate;
  52.  
  53. PROCEDURE * FileClose(handle:INTEGER);
  54. BEGIN SYS.CODE(
  55.   8BH, 5EH, 06H,   (*mov bx,word ptr[bp+6]*)
  56.   0B4H, 3EH,       (*mov ah,3Eh           *)
  57.   0CDH, 21H)       (*int 21h              *)
  58. END FileClose;
  59.  
  60. PROCEDURE * FileRd(VAR buff:ARRAY OF SYS.BYTE;
  61.                  handle:INTEGER; size:INTEGER; VAR read:INTEGER);
  62. BEGIN SYS.CODE(
  63.  1EH,              (*  push ds  *)
  64.  0C5H, 56H, 0EH,   (*  lds dx,dword ptr [bp+14] ;buf ptr   *)
  65.  8BH, 5EH, 0CH,    (*  mov bx,word ptr[bp+12]   ;handle    *)
  66.  8BH, 4EH, 0AH,    (*  mov cx,word ptr[bp+10]  ;size      *)
  67.  0B4H, 3FH,        (*  mov ah,3Fh ;read code              *)
  68.  0CDH, 21H,        (*  int 21h                            *)
  69.  73H, 02H,         (*  jnc RDok                           *)
  70.  0F7H, 0D8H,       (*  neg ax ;neg 'read' means error code*)
  71.                    (* RDok:                               *)
  72.  0C5H, 5EH, 06H,   (*  lds bx,dword ptr[bp+6 ];read       *)
  73.  89H, 07H,         (*  mov word ptr [bx],ax               *)
  74.  1FH)              (*  pop ds                             *)
  75. END FileRd;
  76.  
  77.  
  78. PROCEDURE * FileWrt(VAR buff:ARRAY OF SYS.BYTE;
  79.                  handle:INTEGER; size:INTEGER; VAR wrt:INTEGER);
  80. BEGIN SYS.CODE(
  81.  1EH,              (*  push ds  *)
  82.  0C5H, 56H, 0EH,   (*  lds dx,dword ptr [bp+14] ;buf ptr   *)
  83.  8BH, 5EH, 0CH,    (*  mov bx,word ptr[bp+12]   ;handle    *)
  84.  8BH, 4EH, 0AH,    (*  mov cx,word ptr[bp+10]  ;size      *)
  85.  0B4H, 40H,        (*  mov ah,40h ;write code             *)
  86.  0CDH, 21H,        (*  int 21h                            *)
  87.  73H, 02H,         (*  jnc RDok                           *)
  88.  0F7H, 0D8H,       (*  neg ax ;neg 'read' means error code*)
  89.                    (* RDok:                               *)
  90.  0C5H, 5EH, 06H,   (*  lds bx,dword ptr[bp+6 ];wrt        *)
  91.  89H, 07H,         (*  mov word ptr [bx],ax               *)
  92.  1FH)              (*  pop ds                             *)
  93. END FileWrt;
  94.  
  95.  
  96.  
  97. PROCEDURE Open(VAR s:ARRAY OF CHAR; VAR r:Rider; VAR result:INTEGER;
  98.                mode:INTEGER; Proc : OpenProcTyp );
  99. (* result = 0 for ok, 1 for failure *)
  100. BEGIN
  101.   NEW(r);  r.handle := 0;  r.n := 0 ;  r.m := 0;  r.out := mode > 0 ;
  102.   Proc(s, r.handle, mode);
  103.   IF r.handle # 0 THEN result := 0 ELSE result := 1 END
  104. END Open;
  105.  
  106. PROCEDURE OpenRead * (s:ARRAY OF CHAR; VAR r:Rider; VAR result:INTEGER);
  107. BEGIN Open(s,r,result,0,FileOpen)
  108. END OpenRead;
  109.  
  110. PROCEDURE OpenWrite * (s:ARRAY OF CHAR; VAR r:Rider; VAR result:INTEGER);
  111. BEGIN Open(s,r,result,1,FileOpen)
  112. END OpenWrite;
  113.  
  114. PROCEDURE OpenCreate * (s:ARRAY OF CHAR; VAR r:Rider; VAR result:INTEGER);
  115. BEGIN Open(s,r,result,20H,FileCreate)
  116. END OpenCreate;
  117.  
  118. PROCEDURE FillBuff(r:Rider);
  119. BEGIN
  120.   FileRd( r.bufdata, r.handle, MaxBuffer, r.m );
  121.   r.n := 0
  122. END FillBuff;
  123.  
  124. PROCEDURE ReadLn * (r:Rider; VAR s:ARRAY OF CHAR);
  125. VAR i,j,k:INTEGER;  ch:CHAR;
  126. BEGIN
  127.   s[0] := 00X ;
  128.   IF ~r.out THEN
  129.     IF r.n >= r.m THEN FillBuff(r) END;
  130.     i := 0; j := LEN(s,1) - 1 ;
  131.     k := r.m - r.n ;
  132.     IF k > j THEN k := j END;
  133.     ch := r.bufdata[r.n];
  134.     WHILE (i < k) & (ch # 0DX) DO
  135.       s[i] := ch;  INC(i);  INC(r.n);  ch := r.bufdata[r.n]
  136.     END;
  137.     IF ch = 0DX (*carriage return*) THEN
  138.       INC(r.n, 2); (*pass CR/LF sequence*)
  139.       IF i = 0 THEN s[0] := " "; i := 1 END  (*nul line is 1 blank to caller*)
  140.     END;
  141.     s[i] := 00X
  142.   END
  143. END ReadLn;
  144.  
  145.  
  146. PROCEDURE DumpBuff(r:Rider);
  147. VAR i:INTEGER;
  148. BEGIN
  149.   IF r.n > 0 THEN
  150.      IF r.out THEN FileWrt(r.bufdata, r.handle, r.n, i) END;
  151.      r.n := 0
  152.   END
  153. END DumpBuff;
  154.  
  155. PROCEDURE WriteLn * (r:Rider);
  156. BEGIN
  157.   r.bufdata[r.n] := 0DX;  r.bufdata[r.n + 1] := 0AX ;  INC(r.n, 2); (*CR/LF*)
  158.   DumpBuff(r)
  159. END WriteLn;
  160.  
  161.  
  162. PROCEDURE Writev * (r:Rider; VAR s:ARRAY OF CHAR);
  163. VAR i,j:INTEGER; ch:CHAR;
  164. BEGIN
  165.   i := r.n ;   j := 0 ;
  166.   WHILE s[j] # 00X DO
  167.     IF i >= MaxBuffer THEN DumpBuff(r); i := 0 END;
  168.     r.bufdata[i] := s[j] ;
  169.     INC(i); INC(j)
  170.   END ;
  171.   r.n := i
  172. END Writev;
  173.  
  174. PROCEDURE Write * (r:Rider; s:ARRAY OF CHAR);
  175. BEGIN Writev(r,s)
  176. END Write;
  177.  
  178. PROCEDURE WriteCh * (r:Rider; ch:CHAR);
  179. VAR s:ARRAY 4 OF CHAR;
  180. BEGIN s[0] := ch;  s[1] := 00X;  Writev(r,s)
  181. END WriteCh;
  182.  
  183.  
  184. PROCEDURE Close * (VAR r:Rider);
  185. BEGIN
  186.  IF r.out & (r.n > 0) THEN WriteLn(r) END;
  187.  FileClose(r.handle);  r := NIL
  188. END Close;
  189.  
  190.  
  191. PROCEDURE WriteHex * (r:Rider; li:LONGINT);
  192. VAR i,j,b0,b1,b2,b3:INTEGER;
  193.   PROCEDURE TwoDig(n:INTEGER);
  194.   VAR c,x:INTEGER;  buf:ARRAY 2 OF INTEGER;
  195.   BEGIN c := 0;
  196.     REPEAT x := n MOD 16;  n := n DIV 16;
  197.       IF x > 10 THEN x := x+ORD("A")-10 ELSE x := x+ORD("0") END;
  198.       buf[c] := x; INC(c)
  199.     UNTIL c = 2;
  200.     REPEAT DEC(c); WriteCh(r,CHR(buf[c])) UNTIL c = 0
  201.   END TwoDig;
  202. BEGIN
  203.   b2:= SYS.HI(li);  b3 := SYS.LO(li);
  204.   b0 := SYS.HI(b2);  b1 := SYS.LO(b2);  b2 := SYS.HI(b3);  b3 := SYS.LO(b3);
  205.   IF b0 >= 0A0H THEN WriteCh(r,"0") END;
  206.   IF (b0 # 0) OR (b1 # 0) THEN TwoDig(b0); TwoDig(b1)
  207.   ELSIF b2 >= 0A0H THEN WriteCh(r,"0")
  208.   END;
  209.   TwoDig(b2); TwoDig(b3); WriteCh(r,"H")
  210. END WriteHex;
  211.  
  212. PROCEDURE WriteInt * (r:Rider; li:LONGINT);
  213. VAR i:INTEGER; buf:ARRAY 30 OF INTEGER;
  214. BEGIN i := 0;  IF li < 0 THEN li := -li;  WriteCh(r,"-") END;
  215.   REPEAT buf[i] := SHORT(li MOD 10);  li := li DIV 10; INC(i) UNTIL li = 0;
  216.   REPEAT DEC(i); WriteCh(r, CHR(buf[i] + ORD("0"))) UNTIL i = 0
  217. END WriteInt;
  218.  
  219.  
  220. END LineIO.
  221.