home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / compiler / pascal2 / lib / wrtlib.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1993-11-03  |  4.4 KB  |  133 lines
  1. (*
  2.  * FileName:   wrtlib.pas
  3.  * $Source: E:/usr/src/c-code/pascal/RCS/LIB/wrtlib.pas,v $
  4.  * $Author: wjw $
  5.  * $Date: 1993/11/03 15:55:06 $
  6.  * $Locker: wjw $
  7.  * $State: Exp $
  8.  * $Revision: 1.1 $
  9.  * Description:
  10. D*      Part of the runtime library which comes with PASCAL for OS/2
  11. D*      
  12.  *
  13.  * History:
  14.  *      First created by Willem Jan Withagen ( wjw@eb.ele.tue.nl ),
  15.  *                    on Mon July 26 23:30:03 MET 1993
  16.  * Copyright:
  17.  *      Copyright (c) 1993 by Willem Jan Withagen and 
  18.  *                      Digital Information Systems group, TUE
  19.  *      For copying and distribution information see the file COPYRIGHT.
  20.  *
  21.  *)
  22.  
  23. program wrtlib;
  24. (* MODULE paslib; *)
  25.  
  26. (* Once this all will be transformed into the PASCAL runtime lib.
  27. (* Currently it is included in every file being translated.
  28. (* And it s being run through the preprocessor first, which does not know
  29. (* about pascal comments. So be carefull with ''s.
  30. (*
  31. (* Notes/limitations:
  32. (*   OS/2:
  33. (*      Maybe I should know beter, but I''m using native OS/2 calls. (wjw)
  34. (*
  35. (*   File I/O:
  36. (*      Although the compiler knows about files, currently the only files 
  37. (*      known are output for writes, input for read. And these are hard coded
  38. (*      into the routines
  39. (*      The runtime lib itself can use file handle 2 as 'stderr'.
  40. (*       
  41. (*      Upon input we assume that input lines are less than 256 chars.
  42. (*      Otherwise routines will break.
  43. (*
  44. (*   Standard routines:
  45. (*      The standard routines are Currently generated by the backend with TWO
  46. (*      leading $''s in the name. This means that here we should only use ONE,
  47. (*      the second one gets added by the compiler.
  48. (*
  49. (*   Local Routines:
  50. (*      Routines to be used only in this module have a '_' prepended to their
  51. (*      name. 
  52. (*
  53. (*   Coding:
  54. (*   1) I''m trying to code this a simple as possible. The reason for this is 
  55. (*      that is library is also used to run the compiler testfiles. And if 
  56. (*      things are hairy in the lib, then it is hard to figure out where the 
  57. (*      real errors are. (And currently WITH-stat are not implemented, so 
  58. (*      complex records do not serve any purpose.)
  59. (*   2) Also is the alignment of local data done manually, since there is
  60. (*      still a bug(read not implemented) in the local allocation.
  61. (*   3) Sets are neither implemented
  62. (*   4) So are CASE-statements.
  63.  *)
  64. const
  65.     _in                 = 0;
  66.     _out                = 1;
  67.     _error              = 2;
  68.     _Boolean_Write_Size = 5;
  69.     _Max_buf            = 256;
  70. type
  71.     _str  = array [1..8] of char;  (* Make it bigger than the default non copy 
  72.                                    (* REF value *)
  73.     word = integer;
  74. var 
  75.     _WBuf : array [1.._Max_buf] of char;
  76.     
  77. (* Used parts of OS/2 *)    
  78. FUNCTION  Dos32Write( fhdl: word;      (* Handle to write to *)
  79.                       str: _str;       (* String to write *)
  80.                       cnt: word;       (* Number of bytes to write *)
  81.                       VAR  rcnt: word  (* Actual number written *)
  82.                       ):word; external;
  83.                       
  84. FUNCTION  Dos32Read ( fhdl: word;      (* Handle to read from *)
  85.                       str: _str;       (* String to read into *)
  86.                       cnt: word;       (* Number of bytes to read *)
  87.                       VAR  rcnt: word  (* Actual number read *)
  88.                       ):word; external;
  89.                       
  90. (* And somethings coded in assembler *)
  91.           (* Copy a piece of memory, but it should not overlap *)
  92. procedure $memcopy(VAR source, dest :_str; size :word ); external;
  93.  
  94. (* The most simple part of the library.
  95. (* Getting this to compile right allow testing of a large part of the 
  96. (* test files 
  97. (* They don''t need an extra '$', since they get called straight from the
  98. (* pascal code.
  99.  *)
  100. procedure WrtWrong;
  101. var
  102.     _rc  :word;
  103.     rcnt :word;
  104. begin
  105.      _WBuf := 'wrong'
  106.     ;_WBuf[6] := chr(13)
  107.     ;_WBuf[7] := chr(10)
  108.     ;_rc := Dos32Write( _out, _WBuf, 7, rcnt)
  109. end;
  110.  
  111. procedure WrtOke;
  112. var
  113.     _rc  :word;
  114.     rcnt :word;
  115. begin
  116.      _WBuf := 'oke'
  117.     ;_WBuf[4] := chr(13)
  118.     ;_WBuf[5] := chr(10)
  119.     ;_rc := Dos32Write( _out, _WBuf, 5, rcnt)
  120. end;
  121.  
  122. begin
  123. end.
  124. (*
  125.  * $Log: wrtlib.pas,v $
  126.  * Revision 1.1  1993/11/03  15:55:06  wjw
  127.  * Started adminstration for the RUNTIME LIB
  128.  *
  129.  *
  130.  *      First created by Willem Jan Withagen ( wjw@eb.ele.tue.nl ),
  131.  *                    on Mon July 26 23:30:03 MET 1993
  132.  *)
  133.