home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / oberon / lio.mod < prev    next >
Text File  |  1991-02-24  |  9KB  |  285 lines
  1. MODULE LIO ;    (* Modifided LineIO, with column indentation on output*)
  2.                 (* ERV, 1989/91 *)
  3.   IMPORT SYS:=SYSTEM;
  4.  
  5. CONST MaxBuffer = 4096 ;
  6.  
  7. TYPE  Buffer   = RECORD
  8.                    handle : INTEGER;
  9.                    n : INTEGER; (*index into bufdata*)
  10.                    m : INTEGER; (*max amount read into bufdata*)
  11.                    out : BOOLEAN; (*TRUE on output file*)
  12.                    indent, column : INTEGER;
  13.                    bufdata : ARRAY MaxBuffer OF CHAR ;
  14.                    slop : LONGINT (*slop in case read file used for writing*)
  15.                  END;
  16.  
  17.       Rider * = POINTER TO Buffer ;
  18.  
  19.       OpenProcTyp =
  20.            PROCEDURE (VAR s:ARRAY OF CHAR; VAR handle:INTEGER; rw:INTEGER);
  21.  
  22.  
  23.  
  24. PROCEDURE * FileOpen(VAR s:ARRAY OF CHAR; VAR handle:INTEGER; rw:INTEGER);
  25. (* rw = 0 for read, 1 for write, 2 for r/w  *)
  26. BEGIN SYS.CODE(
  27.   1EH,            (*  push ds  *)
  28.   0C5H, 56H, 0CH, (*  lds dx,dword ptr [bp+12] ;file name *)
  29.   8BH, 46H, 06H,  (*  mov ax,word ptr [bp+06 ] ; rw type *)
  30.   0B4H, 3DH,      (*  mov ah,3Dh *)
  31.   0CDH, 21H,      (*  int 21h    *)
  32.   73H, 03H,       (*  jnc FOok   *)
  33.   0B8H, 00H,00H,  (*  mov   ax,0 *)
  34.                   (*FOok:        *)
  35.   0C5H, 5EH, 08H, (*  lds bx,dword ptr[bp+8];handle  *)
  36.   89H, 07H,       (*  mov word ptr[bx],ax     *)
  37.   1FH)            (*  pop ds                  *)
  38. END FileOpen;
  39.  
  40.  
  41. PROCEDURE * FileCreate(VAR s:ARRAY OF CHAR; VAR handle:INTEGER; attr:INTEGER);
  42. BEGIN SYS.CODE(
  43.   1EH,            (*  push ds  *)
  44.   0C5H, 56H, 0CH, (*  lds dx,dword ptr [bp+12] ;file name *)
  45.   8BH, 4EH, 06H,  (*  mov cx,word ptr [bp+06] ; attr *)
  46.   0B4H, 3CH,      (*  mov ah,3Ch *)
  47.   0CDH, 21H,      (*  int 21h    *)
  48.   73H, 03H,       (*  jnc FOok   *)
  49.   0B8H, 00H,00H,  (*  mov   ax,0 *)
  50.                   (*FOok:        *)
  51.   0C5H, 5EH, 08H, (*  lds bx,dword ptr[bp+8];handle  *)
  52.   89H, 07H,       (*  mov word ptr[bx],ax     *)
  53.   1FH)            (*  pop ds                  *)
  54. END FileCreate;
  55.  
  56. PROCEDURE * FileClose(handle:INTEGER);
  57. BEGIN SYS.CODE(
  58.   8BH, 5EH, 06H,   (*mov bx,word ptr[bp+6]*)
  59.   0B4H, 3EH,       (*mov ah,3Eh           *)
  60.   0CDH, 21H)       (*int 21h              *)
  61. END FileClose;
  62.  
  63. PROCEDURE * FileRd(VAR buff:ARRAY OF SYS.BYTE;
  64.                  handle:INTEGER; size:INTEGER; VAR read:INTEGER);
  65. BEGIN SYS.CODE(
  66.  1EH,              (*  push ds  *)
  67.  0C5H, 56H, 0EH,   (*  lds dx,dword ptr [bp+14] ;buf ptr   *)
  68.  8BH, 5EH, 0CH,    (*  mov bx,word ptr[bp+12]   ;handle    *)
  69.  8BH, 4EH, 0AH,    (*  mov cx,word ptr[bp+10]  ;size      *)
  70.  0B4H, 3FH,        (*  mov ah,3Fh ;read code              *)
  71.  0CDH, 21H,        (*  int 21h                            *)
  72.  73H, 02H,         (*  jnc RDok                           *)
  73.  0F7H, 0D8H,       (*  neg ax ;neg 'read' means error code*)
  74.                    (* RDok:                               *)
  75.  0C5H, 5EH, 06H,   (*  lds bx,dword ptr[bp+6 ];read       *)
  76.  89H, 07H,         (*  mov word ptr [bx],ax               *)
  77.  1FH)              (*  pop ds                             *)
  78. END FileRd;
  79.  
  80.  
  81. PROCEDURE * FileWrt(VAR buff:ARRAY OF SYS.BYTE;
  82.                  handle:INTEGER; size:INTEGER; VAR wrt:INTEGER);
  83. BEGIN SYS.CODE(
  84.  1EH,              (*  push ds  *)
  85.  0C5H, 56H, 0EH,   (*  lds dx,dword ptr [bp+14] ;buf ptr   *)
  86.  8BH, 5EH, 0CH,    (*  mov bx,word ptr[bp+12]   ;handle    *)
  87.  8BH, 4EH, 0AH,    (*  mov cx,word ptr[bp+10]  ;size      *)
  88.  0B4H, 40H,        (*  mov ah,40h ;write code             *)
  89.  0CDH, 21H,        (*  int 21h                            *)
  90.  73H, 02H,         (*  jnc RDok                           *)
  91.  0F7H, 0D8H,       (*  neg ax ;neg 'read' means error code*)
  92.                    (* RDok:                               *)
  93.  0C5H, 5EH, 06H,   (*  lds bx,dword ptr[bp+6 ];wrt        *)
  94.  89H, 07H,         (*  mov word ptr [bx],ax               *)
  95.  1FH)              (*  pop ds                             *)
  96. END FileWrt;
  97.  
  98.  
  99.  
  100. PROCEDURE Open(VAR s:ARRAY OF CHAR; VAR r:Rider; VAR result:INTEGER;
  101.                mode:INTEGER; Proc : OpenProcTyp );
  102. (* result = 0 for ok, 1 for failure *)
  103. BEGIN
  104.   NEW(r);  r.handle := 0;  r.n := 0 ;  r.m := 0;  r.out := mode > 0 ;
  105.   Proc(s, r.handle, mode);
  106.   IF r.handle # 0 THEN result := 0 ELSE result := 1 END;
  107.   r.indent := 0;  r.column := 0
  108. END Open;
  109.  
  110. PROCEDURE OpenRead * (s:ARRAY OF CHAR; VAR r:Rider; VAR result:INTEGER);
  111. BEGIN Open(s,r,result,0,FileOpen)
  112. END OpenRead;
  113.  
  114. PROCEDURE OpenWrite * (s:ARRAY OF CHAR; VAR r:Rider; VAR result:INTEGER);
  115. BEGIN Open(s,r,result,1,FileOpen)
  116. END OpenWrite;
  117.  
  118. PROCEDURE OpenCreate * (s:ARRAY OF CHAR; VAR r:Rider; VAR result:INTEGER);
  119. BEGIN Open(s,r,result,20H,FileCreate)
  120. END OpenCreate;
  121.  
  122. PROCEDURE FillBuff(r:Rider);
  123. BEGIN
  124.   FileRd( r.bufdata, r.handle, MaxBuffer, r.m );
  125.   r.n := 0;
  126.   IF r.m < 0 (* end of file, probably *) THEN r.bufdata[0] := 0X END
  127. END FillBuff;
  128.  
  129. PROCEDURE ReadLn * (r:Rider; VAR s:ARRAY OF CHAR);
  130. (*fixed 8/22/90 -- buffer filling problems *)
  131. VAR i,j:INTEGER;  ch:CHAR;
  132. BEGIN
  133.   s[0] := 00X ;
  134.   IF ~r.out THEN
  135.     i := 0; j := LEN(s,1) - 1 ;
  136.     IF j > 0 THEN
  137.         REPEAT
  138.           IF r.n >= r.m THEN FillBuff(r) END;
  139.           ch := r.bufdata[r.n] ;
  140.           s[i] := ch ; INC(i);  INC(r.n)
  141.         UNTIL (i = j) OR (ch = 0DX);
  142.         IF ch = 0DX THEN DEC(i); (*user never sees the cr *)
  143.           INC(r.n); (*skip linefeed*)
  144.           IF r.n > r.m THEN FillBuff(r); INC(r.n) END; (*lf in next buffer*)
  145.         END;
  146.         IF i = 0 THEN s[0] := " "; i := 1 END; (*null line is 1 blank to caller*)
  147.         s[i] := 0X  (*make sure string terminated*)
  148.     END
  149.   END
  150. END ReadLn;
  151.  
  152.  
  153. PROCEDURE DumpBuff(r:Rider);
  154. VAR i:INTEGER;
  155. BEGIN
  156.   IF r.n > 0 THEN
  157.      IF r.out THEN FileWrt(r.bufdata, r.handle, r.n, i) END;
  158.      r.n := 0
  159.   END
  160. END DumpBuff;
  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); INC(r.column)
  170.   END ;
  171.   r.n := i
  172. END Writev;
  173.  
  174.  
  175. PROCEDURE WriteLn * (r:Rider);
  176. VAR i:INTEGER; s:ARRAY 256 OF CHAR;
  177. BEGIN
  178.   r.bufdata[r.n] := 0DX;  r.bufdata[r.n + 1] := 0AX ;  INC(r.n, 2); (*CR/LF*)
  179.   DumpBuff(r);  r.column := 0;
  180.   IF r.indent > 0 THEN
  181.    i := 0;  WHILE i < r.indent DO s[i] := " "; INC(i) END;
  182.    s[i] := 0X;
  183.    Writev(r,s)  (*indent the next line*)
  184.   END
  185. END WriteLn;
  186.  
  187.  
  188. PROCEDURE Write * (r:Rider; s:ARRAY OF CHAR);
  189. BEGIN Writev(r,s)
  190. END Write;
  191.  
  192. PROCEDURE WriteCh * (r:Rider; ch:CHAR);
  193. VAR s:ARRAY 4 OF CHAR;
  194. BEGIN s[0] := ch;  s[1] := 00X;  Writev(r,s)
  195. END WriteCh;
  196.  
  197.  
  198. PROCEDURE IndentToHere * (r:Rider);
  199. BEGIN  r.indent := r.column
  200. END IndentToHere;
  201.  
  202. PROCEDURE IndentOff * (r:Rider);
  203. BEGIN r.indent := 0
  204. END IndentOff;
  205.  
  206. PROCEDURE GetIndent * (r:Rider; VAR in:INTEGER);
  207. BEGIN in := r.indent
  208. END GetIndent;
  209.  
  210. PROCEDURE SetIndent * (r:Rider; in:INTEGER);
  211. BEGIN r.indent := in
  212. END SetIndent;
  213.  
  214.  
  215. PROCEDURE Close * (VAR r:Rider);
  216. BEGIN
  217.  IF r.out & (r.n > 0) THEN WriteLn(r) END;
  218.  FileClose(r.handle);  r := NIL
  219. END Close;
  220.  
  221.  
  222. PROCEDURE WriteHex * (r:Rider; li:LONGINT);
  223. VAR i,j,b0,b1,b2,b3:INTEGER;
  224.   PROCEDURE TwoDig(n:INTEGER);
  225.   VAR c,x:INTEGER;  buf:ARRAY 2 OF INTEGER;
  226.   BEGIN c := 0;
  227.     REPEAT x := n MOD 16;  n := n DIV 16;
  228.       IF x > 10 THEN x := x+ORD("A")-10 ELSE x := x+ORD("0") END;
  229.       buf[c] := x; INC(c)
  230.     UNTIL c = 2;
  231.     REPEAT DEC(c); WriteCh(r,CHR(buf[c])) UNTIL c = 0
  232.   END TwoDig;
  233. BEGIN
  234.   b2:= SYS.HI(li);  b3 := SYS.LO(li);
  235.   b0 := SYS.HI(b2);  b1 := SYS.LO(b2);  b2 := SYS.HI(b3);  b3 := SYS.LO(b3);
  236.   IF b0 >= 0A0H THEN WriteCh(r,"0") END;
  237.   IF (b0 # 0) OR (b1 # 0) THEN TwoDig(b0); TwoDig(b1)
  238.   ELSIF b2 >= 0A0H THEN WriteCh(r,"0")
  239.   END;
  240.   TwoDig(b2); TwoDig(b3); WriteCh(r,"H")
  241. END WriteHex;
  242.  
  243. PROCEDURE WriteInt * (r:Rider; li:LONGINT);
  244. VAR i:INTEGER; buf:ARRAY 30 OF INTEGER;
  245. BEGIN i := 0;  IF li < 0 THEN li := -li;  WriteCh(r,"-") END;
  246.   REPEAT buf[i] := SHORT(li MOD 10);  li := li DIV 10; INC(i) UNTIL li = 0;
  247.   REPEAT DEC(i); WriteCh(r, CHR(buf[i] + ORD("0"))) UNTIL i = 0
  248. END WriteInt;
  249.  
  250.  
  251. PROCEDURE * GetDateTime(VAR Y, M, D, h, m : INTEGER;
  252.                         handle:INTEGER);
  253. VAR date, time, hours : INTEGER;
  254. BEGIN SYS.CODE(
  255.  0B4H, 57H,
  256.  0B0H, 00H,
  257.  8BH, 5EH, 06H,
  258.  0CDH, 21H,     (* DOS function 57H: get file date/time *)
  259.  89H, 56H, 0FCH,
  260.  89H, 4EH, 0FAH,
  261.  
  262.  8BH, 46H, 0FAH,    (*  mov ax,word ptr [bp-6] ; get hh/mm value*)
  263.  0B1H, 0BH,         (*  mov cl,11                                *)
  264.  0D3H, 0E8H,        (*  shr ax,cl     ;isolate h                 *)
  265.  89H, 46H, 0F8H,    (*  mov word ptr [bp-8],ax                   *)
  266.  8BH, 46H, 0FAH,    (*  mov ax,word ptr [bp-6]                   *)
  267.  25H, 0E0H, 07H,    (*  and ax,0000011111100000b                 *)
  268.  0B1H, 05H,         (*  mov cl,5                                 *)
  269.  0D3H, 0E8H,        (*  shr ax,cl                                *)
  270.  89H, 46H, 0FAH     (*  mov word ptr[bp-6],ax                    *)
  271. );
  272.  Y := date DIV 512 ;   Y := Y + 1980 ; (*DOS year starts in 1980 *)
  273.  M := (date MOD 512) DIV 32 ;
  274.  D := date MOD 32;
  275.  h := hours;
  276.  m := time
  277. END GetDateTime;
  278.  
  279. PROCEDURE FileDate * (VAR Y,M,D,h,m:INTEGER; r:Rider);
  280. BEGIN GetDateTime(Y,M,D,h,m,r.handle)
  281. END FileDate;
  282.  
  283.  
  284. END LIO.
  285.