home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / oberon / io.mod < prev    next >
Text File  |  1991-02-24  |  6KB  |  182 lines
  1. MODULE IO;      (* ERV, 1989/91 *)
  2.   IMPORT SYS:=SYSTEM;
  3.  
  4. PROCEDURE Put(VAR s:ARRAY OF CHAR);
  5. BEGIN
  6.  SYS.CODE(
  7.  0B4H, 09H,     (*mov ah,09H  *)
  8.  1EH,           (*push ds     *)
  9.  0C5H, 56H, 04H,(*lds dx,dword ptr [bp+4] ;fetch ptr to buffer *)
  10.  0CDH, 21H,     (*int 21h  *)
  11.  1FH            (*pop ds   *)
  12.  )
  13. END Put;
  14.  
  15. PROCEDURE WL * ;
  16. CONST cr = 0AX; lf = 0DX;
  17. VAR s1:ARRAY 6 OF CHAR;
  18. BEGIN
  19.   s1[0] := cr;  s1[1] := lf;  s1[2] := "$";  Put(s1)
  20. END WL;
  21.  
  22. PROCEDURE WSv * (VAR s:ARRAY OF CHAR);
  23. VAR i:INTEGER;
  24. BEGIN
  25.  i := ORD(s[0]);  i := i * 3 ;  i := i ;
  26.   i := 0;
  27.   WHILE s[i] # 00X DO INC(i) END;
  28.   s[i] := "$" ;  Put(s);  s[i] := 00X
  29. END WSv;
  30.  
  31. PROCEDURE WS * (s:ARRAY OF CHAR);
  32. BEGIN WSv(s)
  33. END WS;
  34.  
  35. PROCEDURE Wch * (ch:CHAR);
  36. VAR s:ARRAY 4 OF CHAR;
  37. BEGIN s[0] := ch;  s[1] := 0X; WSv(s)
  38. END Wch;
  39.  
  40. PROCEDURE ItoS * (i:INTEGER; VAR s:ARRAY OF CHAR);
  41. VAR j,k:INTEGER;
  42.     arr:ARRAY 10 OF INTEGER;
  43. BEGIN
  44.   k := 0;
  45.   IF i < 0 THEN s[0] := "-";  i := -i; j := 1  ELSE j := 0 END;
  46.   WHILE i > 0 DO
  47.     arr[k] := i MOD 10;  INC(k);
  48.     i := i DIV 10
  49.   END;
  50.   IF k = 0 THEN s[0] := "0";  j := 1
  51.   ELSE
  52.     WHILE k > 0 DO
  53.       DEC(k); s[j] := CHR(arr[k] + ORD("0") );
  54.       INC(j)
  55.     END
  56.   END;
  57.   s[j] := 00X
  58. END ItoS;
  59.  
  60. PROCEDURE WI * (x:INTEGER);
  61. VAR s:ARRAY 16 OF CHAR;
  62. BEGIN
  63.   ItoS(x,s); WSv(s)
  64. END WI;
  65.  
  66. PROCEDURE RCh * (VAR ch:CHAR);
  67. BEGIN SYS.CODE(
  68.   0B4H, 01H,         (* mov  ah,01h  *)
  69.   0CDH, 21H,         (* int  21h     *)
  70.   0C4H, 5EH, 06H,    (* les  bx,dword ptr [bp+6] *)
  71.   26H, 88H, 07H)     (* mov  es:[bx],al       ;return byte *)
  72. END RCh;
  73.  
  74. PROCEDURE RS * (VAR s:ARRAY OF CHAR);
  75. CONST maxbuf = 80;
  76. TYPE ibuf = ARRAY maxbuf OF CHAR;
  77. VAR ib:ibuf;  i,j,k:INTEGER;
  78.   PROCEDURE RB(VAR s:ibuf);
  79.   BEGIN SYS.CODE(
  80.     0B4H, 0AH,      (*mov ah,0Ah *)
  81.     1EH,            (*push ds    *)
  82.     0C5H, 56H, 04H, (*lds dx,dword ptr [bp+4] *)
  83.                     (*   ;fetch ptr to buffer, char[0] is len allowed *)
  84.                     (*   ; and char[1] is len returned to caller      *)
  85.     0CDH, 21H,      (*int 21h    *)
  86.     1FH)            (*pop ds     *)
  87.   END RB;
  88. BEGIN (*RS*)
  89.   ib[0] := CHR(maxbuf - 2);  ib[1] := 00X;
  90.   RB(ib);  WL;
  91.   i := ORD(ib[1]);  j := 2;  k := 0;
  92.   WHILE i > 0 DO
  93.     s[k] := ib[j];  INC(k); INC(j); DEC(i)
  94.   END;
  95.   s[k] := 00X
  96. END RS;
  97.  
  98. PROCEDURE FileOpen * (VAR s:ARRAY OF CHAR; VAR handle:INTEGER; rw:INTEGER);
  99. BEGIN SYS.CODE(
  100.   1EH,            (*  push ds  *)
  101.   0C5H, 56H, 0CH, (*  lds dx,dword ptr [bp+12] ;file name *)
  102.   8BH, 46H, 06H,  (*  mov ax,word ptr [bp+06 ] ; rw type *)
  103.   0B4H, 3DH,      (*  mov ah,3Dh *)
  104.   0CDH, 21H,      (*  int 21h    *)
  105.   73H, 03H,       (*  jnc FOok   *)
  106.   0B8H, 00H,00H,  (*  mov   ax,0 *)
  107.                   (*FOok:        *)
  108.   0C5H, 5EH, 08H, (*  lds bx,dword ptr[bp+8];handle  *)
  109.   89H, 07H,       (*  mov word ptr[bx],ax     *)
  110.   1FH)            (*  pop ds                  *)
  111. END FileOpen;
  112.  
  113.  
  114. PROCEDURE FileCreate * (VAR s:ARRAY OF CHAR; VAR handle:INTEGER; attr:INTEGER);
  115. BEGIN SYS.CODE(
  116.   1EH,            (*  push ds  *)
  117.   0C5H, 56H, 0CH, (*  lds dx,dword ptr [bp+12] ;file name *)
  118.   8BH, 4EH, 06H,  (*  mov cx,word ptr [bp+06] ; attr *)
  119.   0B4H, 3CH,      (*  mov ah,3Ch *)
  120.   0CDH, 21H,      (*  int 21h    *)
  121.   73H, 03H,       (*  jnc FOok   *)
  122.   0B8H, 00H,00H,  (*  mov   ax,0 *)
  123.                   (*FOok:        *)
  124.   0C5H, 5EH, 08H, (*  lds bx,dword ptr[bp+8];handle  *)
  125.   89H, 07H,       (*  mov word ptr[bx],ax     *)
  126.   1FH)            (*  pop ds                  *)
  127. END FileCreate;
  128.  
  129. PROCEDURE FileClose * (handle:INTEGER);
  130. BEGIN SYS.CODE(
  131.   8BH, 5EH, 06H,   (*mov bx,word ptr[bp+6]*)
  132.   0B4H, 3EH,       (*mov ah,3Eh           *)
  133.   0CDH, 21H)       (*int 21h              *)
  134. END FileClose;
  135.  
  136. PROCEDURE FileRd * (VAR buff:ARRAY OF SYS.BYTE;
  137.                  handle:INTEGER; size:INTEGER; VAR read:INTEGER);
  138. BEGIN SYS.CODE(
  139.  1EH,              (*  push ds  *)
  140.  0C5H, 56H, 0EH,   (*  lds dx,dword ptr [bp+14] ;buf ptr   *)
  141.  8BH, 5EH, 0CH,    (*  mov bx,word ptr[bp+12]   ;handle    *)
  142.  8BH, 4EH, 0AH,    (*  mov cx,word ptr[bp+10]  ;size      *)
  143.  0B4H, 3FH,        (*  mov ah,3Fh ;read code              *)
  144.  0CDH, 21H,        (*  int 21h                            *)
  145.  73H, 02H,         (*  jnc RDok                           *)
  146.  0F7H, 0D8H,       (*  neg ax ;neg 'read' means error code*)
  147.                    (* RDok:                               *)
  148.  0C5H, 5EH, 06H,   (*  lds bx,dword ptr[bp+6 ];read       *)
  149.  89H, 07H,         (*  mov word ptr [bx],ax               *)
  150.  1FH)              (*  pop ds                             *)
  151. END FileRd;
  152.  
  153.  
  154. PROCEDURE FileWrt * (VAR buff:ARRAY OF SYS.BYTE;
  155.                  handle:INTEGER; size:INTEGER; VAR wrt:INTEGER);
  156. BEGIN SYS.CODE(
  157.  1EH,              (*  push ds  *)
  158.  0C5H, 56H, 0EH,   (*  lds dx,dword ptr [bp+14] ;buf ptr   *)
  159.  8BH, 5EH, 0CH,    (*  mov bx,word ptr[bp+12]   ;handle    *)
  160.  8BH, 4EH, 0AH,    (*  mov cx,word ptr[bp+10]  ;size      *)
  161.  0B4H, 40H,        (*  mov ah,40h ;write code             *)
  162.  0CDH, 21H,        (*  int 21h                            *)
  163.  73H, 02H,         (*  jnc RDok                           *)
  164.  0F7H, 0D8H,       (*  neg ax ;neg 'read' means error code*)
  165.                    (* RDok:                               *)
  166.  0C5H, 5EH, 06H,   (*  lds bx,dword ptr[bp+6 ];wrt        *)
  167.  89H, 07H,         (*  mov word ptr [bx],ax               *)
  168.  1FH)              (*  pop ds                             *)
  169. END FileWrt;
  170.  
  171. PROCEDURE ChangeFileMode * (VAR fn:ARRAY OF CHAR; attr:INTEGER);
  172. BEGIN SYS.CODE(
  173.   1EH,            (*push ds      *)
  174.   0C5H, 56H, 08H, (*lds dx,dword ptr[bp+8] ;fn *)
  175.   0B8H, 01H, 43H, (*mov ax,4301H               *)
  176.   8BH, 4EH, 06H,  (*mov cx,word ptr [bp+6] ;attr*)
  177.   0CDH, 21H,      (*int 21h *)
  178.   1FH)            (*pop ds  *)
  179. END ChangeFileMode;
  180.  
  181. END IO.
  182.