home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
pascal
/
compiler
/
pascal2
/
lib
/
iolib.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-11-03
|
29KB
|
939 lines
(*
* FileName: iolib.pas
* $Source: E:/usr/src/c-code/pascal/RCS/LIB/iolib.pas,v $
* $Author: wjw $
* $Date: 1993/11/03 15:55:00 $
* $Locker: wjw $
* $State: Exp $
* $Revision: 1.1 $
* Description:
D* Part of the runtime library which comes with PASCAL for OS/2
D*
*
* History:
* First created by Willem Jan Withagen ( wjw@eb.ele.tue.nl ),
* on Mon July 26 23:30:03 MET 1993
* Copyright:
* Copyright (c) 1993 by Willem Jan Withagen and
* Digital Information Systems group, TUE
* For copying and distribution information see the file COPYRIGHT.
*
*)
program iolib;
(* MODULE paslib; *)
(* Once this all will be transformed into the PASCAL runtime lib.
(* Currently it is included in every file being translated.
(* And it s being run through the preprocessor first, which does not know
(* about pascal comments. So be carefull with ''s.
(*
(* Notes/limitations:
(* OS/2:
(* Maybe I should know beter, but I''m using native OS/2 calls. (wjw)
(*
(* File I/O:
(* Although the compiler knows about files, currently the only files
(* known are output for writes, input for read. And these are hard coded
(* into the routines
(* The runtime lib itself can use file handle 2 as 'stderr'.
(*
(* Upon input we assume that input lines are less than 256 chars.
(* Otherwise routines will break.
(*
(* Standard routines:
(* The standard routines are Currently generated by the backend with TWO
(* leading $''s in the name. This means that here we should only use ONE,
(* the second one gets added by the compiler.
(*
(* Local Routines:
(* Routines to be used only in this module have a '_' prepended to their
(* name.
(*
(* Coding:
(* 1) I''m trying to code this a simple as possible. The reason for this is
(* that is library is also used to run the compiler testfiles. And if
(* things are hairy in the lib, then it is hard to figure out where the
(* real errors are. (And currently WITH-stat are not implemented, so
(* complex records do not serve any purpose.)
(* 2) Also is the alignment of local data done manually, since there is
(* still a bug(read not implemented) in the local allocation.
(* 3) Sets are neither implemented
(* 4) So are CASE-statements.
*)
#include "os2.inc"
const
_stdin = 0;
_in = 0;
_stdout = 1;
_out = 1;
_stderr = 2;
_error = 2;
_Boolean_Write_Size = 5;
_MAX_BUF = 256;
_MinInt = -2147483648;
_InitMagic = 168101130; (* 0xa55a5aa5 *)
#ifndef DEBUG_IOLIB
_fill_char = ' ';
#else
_fill_char = '.';
#endif
type
intp = ^integer;
_filebuf = array[1.._Max_buf] of char;
_bigbuf = array[1.._Max_buf] of char;
_filedescr = record
bufpoint :_word; (* By making this a pointer to the first
(* available item, file^ is still usuable
*)
handle :_word;
fname :_filename; (* The name of the file when opened.*)
namelen :_word;
bufstart :_word;
bufend :_word;
elemsize :_word;
fileopen :Boolean;
fileinp :Boolean;
filetxt :Boolean;
bufempty :Boolean;
bufeoln :Boolean;
bufeof :Boolean;
IsTTY :Boolean;
Initialised :_word; (* contains magic if it was already inited *)
(* Initialised means that there is a valid name in the descriptor *)
(* The buffer is always at the end that way is it possibe to
(* vary its size with the type it wants to write
*)
buffer :_filebuf;
end;
var
(* Files to operate on *)
_in_descr :_filedescr;
_out_descr :_filedescr;
_err_descr :_filedescr;
procedure _Int2Str(i: integer; Var buf :_bigbuf; Var size: _word); forward;
procedure ErrorLib(VAR s :_str; i :_word);
var
_rc :_word;
rcnt :_word;
buffer :_bigbuf;
begin
with _err_descr
do
begin
_rc := Dos32Write( handle, s, i, rcnt)
;Buffer[1] := CR
;Buffer[2] := LF
;_rc := Dos32Write( handle, Buffer, 2, rcnt)
end
end;
procedure ErrorLibCode(VAR s :_str; i :_word; code: _word);
var
_rc :_word;
rcnt :_word;
size :integer;
begin
with _err_descr
do
begin
;_rc := Dos32Write( handle, s, i, rcnt)
;_Int2Str(code, Buffer, size)
;_rc := Dos32Write( handle, Buffer, size, rcnt)
;Buffer[1] := CR
;Buffer[2] := LF
;_rc := Dos32Write( handle, Buffer, 2, rcnt)
end
end;
(* I/O *)
procedure $DumpHandle(VAR lfile :Text; f :_filedescr);
(* Dump the status of the file in 'f' on the list file 'lf'
*)
var
length :_word;
begin
with f
do
begin
(* bufpoint :_word; (* By making this a pointer to the first
(* available item, file^ is still usuable
*)
;writeln( 'handle = ', handle)
;writeln( 'fname = ', fname:namelen)
;writeln( 'buffer = |', buffer:bufend, '|')
;writeln( 'bufstart = ', bufstart)
;writeln( 'bufend = ', bufend )
;writeln( 'elemsize = ', elemsize)
;writeln( 'fileopen = ', fileopen)
;writeln( 'fileinp = ', fileinp )
;writeln( 'filetxt = ', filetxt )
;writeln( 'bufempty = ', bufempty)
;writeln( 'bufeoln = ', bufeoln )
;writeln( 'bufeof = ', bufeof )
;writeln( 'IsTTY = ', IsTTY )
end
end;
procedure _FlushWriteBuffer(VAR f :_filedescr);
(* Some thing might be in the buffer which still has to be written.
*)
var
_rc
,rcnt :_word;
begin
with f
do
begin
if (Bufstart < BufEnd)
then
begin
_rc := Dos32Write( handle, Buffer, Bufend-BufStart, rcnt)
;if _rc <> 0
then ErrorLibCode('Error in _FlushWriteBuffer ', 30, _rc)
;Bufstart := 1
;Bufend := Bufstart
;Bufpoint := $StrAddr(Buffer)
;Bufempty := True
end
end
end;
procedure $StdPut(VAR f :_filedescr);
var
_rc, rcnt :_word;
begin
with f
do
if filetxt
then
begin
if (Bufend < _MAX_BUF)
then
begin
Bufend := Bufend+1
;Bufpoint := BufPoint+1
;Bufempty := False
end
end
else
begin
(* Its a binary file *)
_rc := Dos32Write(handle, buffer, elemsize, rcnt)
end
end;
procedure $StdWriteBin(Var f :_filedescr; Var from :_str);
begin
(* First copy the current contents *)
$memcopy(from, f.buffer, f.elemsize)
(* Then put new data *)
;$StdPut(f)
end; (* $StdWriteBin *)
procedure $StdWriteln(Var f :_filedescr);
var
_rc :_word; (* the result of the latest OS operation *)
rcnt :_word;
begin
_FlushWriteBuffer(f)
;with f
do
begin
Buffer[1] := CR
;Buffer[2] := LF
;_rc := Dos32Write( f.handle, Buffer, 2, rcnt)
;if _rc <> 0
then ErrorLib('Error in StdWriteln ', 30)
end
end;
procedure _WriteSpace(Var f:_filedescr; SpaceSize: integer);
(* Write the requested number of spaces.
(* It could be done a little more efficient.
(* Note that it requires the buffer to be flushed first.
(* This is not done here.
(* It uses it''s own private buffer, since the file buffer
(* could be holding somethiing
*)
var
_rc : _word; (* the result of the latest OS operation *)
rcnt :_word;
count :integer;
locbuf :_bigbuf;
begin
with f
do
begin
;for count := 1 to SpaceSize
do locbuf[count] := ' '
;_rc := Dos32Write( handle, locBuf, SpaceSize, rcnt)
;if _rc <> 0
then ErrorLib('Error in _WriteSpace ', 30)
end
end;
procedure $StdWriteChar(Var f:_filedescr; c: char; WrtSize: integer);
(* Print the specified CHAR c on F.
(* It has to be printed in a WrtSize area.
(* [6.9.3.2] specifies that spaces should be added to the front of the written
(* character.
*)
var
_rc : _word; (* the result of the latest OS operation *)
rcnt :_word;
begin
_FlushWriteBuffer(f)
;if WrtSize <> 1
then
begin (* add spaces *)
;_WriteSpace(f,WrtSize-1)
end
;with f
do
begin
Buffer[1] := c
;_rc := Dos32Write( handle, Buffer, 1, rcnt)
;if _rc <> 0
then ErrorLib('Error in $StdWriteChar ', 30)
end
end;
procedure $StdWriteString(Var f:_filedescr; Var s: _str; StrSize, WrtSize: integer);
(* Print the specified string on F. The allocated size of the string is
(* StrSize.
(* It has to be printed in a WrtSize area.
(* [6.9.3.6] specifies that spaces should be added to the end of the written
(* string.
*)
var
_rc : _word; (* the result of the latest OS operation *)
rcnt :_word;
begin
_FlushWriteBuffer(f)
;if WrtSize <= StrSize
then
begin (* Use WrtSize since this is at most the actual string length *)
_rc := Dos32Write( f.handle, s, WrtSize, rcnt)
;if _rc <> 0
then ErrorLib('Error in $StdWriteString ', 30)
end
else
begin (* Give the full string, and add spaces *)
_rc := Dos32Write( f.handle, s, StrSize, rcnt)
;if _rc <> 0
then ErrorLib('Error in $StdWriteString ', 30)
;_WriteSpace(f,WrtSize-StrSize)
end
end;
procedure $StdWriteBoolean(Var f:_filedescr; b: boolean; WrtSize: integer);
(* Print the Boolean b c on F.
(* It has to be printed in a WrtSize area.
(* [6.9.3.5] specifies that spaces should be added to the front of the written
(* character.
*)
var
rcnt :_word;
begin
_FlushWriteBuffer(f)
;if WrtSize > _Boolean_Write_Size
then
begin (* add spaces *)
_WriteSpace(f,WrtSize-_Boolean_Write_Size)
end
(* Now write the string *)
;if b then $StdWriteString(f, 'True', 4 ,WrtSize)
else $StdWriteString(f, 'False', 5 ,WrtSize)
end; (* $StdWriteBoolean *)
procedure _Int2Str(i: integer; Var buf :_bigbuf; Var size: _word);
const
base = 10;
var
index (* point to where the next char has to be stored *)
,j : Integer;
Negative : Boolean;
begin
(* first, store backwards the character representation of Abs(I) in Buf *)
(* MinInt is a number value which can only be represented when it is
* negative. As such it is not possibe to use the algorithm below *)
size := 0
;if I = _MinInt
then
begin
Buf := '-2147483648'
;size := 11
end
else
begin
if I = 0
then
begin
index := _Max_buf-1
;Buf[_Max_buf] := '0'
end
else
begin
Negative := (I < 0)
;if Negative
then I := -I (* This doesn''t work if I is MinInt *)
;index := _Max_buf (* Start at the end of the buffer *)
;while I > 0 do
begin
Buf[index] := Chr (I MOD Base + Ord('0'))
;index := index - 1
;I := I DIV Base
end
;if Negative
then
(* Insert a leading minus *)
begin
Buf[index] := '-'
;index := index - 1
end
end
(* now, write it out
(* The first character is at Buf[index+1] uptil Buf[_Max_buf]
*)
;size := _Max_buf - index
;for j := 1 to size
do Buf[j] := Buf[index+j]
end
end; (* _Int2Str *)
procedure $StdWriteInt(Var f:_filedescr; i: integer; WrtSize: integer);
const
base = 10;
var
_rc : _word; (* the result of the latest OS operation *)
size : Integer;
rcnt : _word;
begin
_FlushWriteBuffer(f)
;_Int2Str(i, f.buffer, size)
;if size < WrtSize
then _WriteSpace(f,WrtSize-size)
;_rc := Dos32Write( f.handle, f.Buffer, size, rcnt)
;if _rc <> 0
then ErrorLibCode('Error in $StdWriteInteger ', 30, _rc)
end; (* $StdWriteInt *)
procedure _CheckBufEOLN(VAR f:_Filedescr); forward;
procedure _FillReadBuf(VAR f :_filedescr);
(* Read a line at the time into Buffer, but only when the last item is
(* consumed:
(* Bufempty OR (Bufstart = Bufend+1)
(* Do not care for CR/LF combinations. If they occur they should be truncated
(* to just CR.
*)
var
_rc : _word; (* the result of the latest OS operation *)
rcnt : _word;
begin
with f do
begin
if bufeof
then
begin
ErrorLib('File already at EOF ', 30)
;_rc := Dos32Exit(1,-1)
end
;if bufstart > bufend
then
begin
ErrorLib('File pointers are corrupt. ', 30)
;_rc := Dos32Exit(1,-1)
end
;if Bufempty OR (Bufstart = Bufend)
then
(* Need to read new data into buffer *)
begin
_rc := Dos32Read(handle, Buffer, _Max_buf, rcnt)
;if _rc <> 0
then ErrorLibCode('Error in _FillReadBuf ', 30, _rc)
;bufeof := rcnt = 0
;bufempty := rcnt = 0
;BufPoint := $StrAddr(Buffer)
;Bufstart := 1
;Bufend := Bufstart+rcnt
;_CheckBufEOLN(f)
end
end
end; (* _FillReadBuf(VAR f :_filedescr); *)
procedure _CheckBufEOLN(VAR f:_Filedescr);
(* Fix the current buffer contents.
(* If there is a CR/LF combination in the buffer make shure that the
(* f^ returns a ' '. and that eoln is set.
*)
begin
with f
do
begin
;bufeoln := (Buffer[Bufstart] = CR) OR (Buffer[Bufstart] = LF)
;if (bufeoln)
then
begin
BufStart := bufstart +1
;Bufpoint := bufpoint +1
;_FillReadBuf(f) (* Make shure there''s enough *)
;Buffer[Bufstart] := ' ' (* Kill the LF *)
end
end
end;
procedure $StdGet(VAR f :_filedescr);
(* Advance the pointer for the _filedescr.
(* Currently only implemented for Text files. (or files with byte size
(* elements.)
(* Note that $StdGet() will skip eoln''s without hesitation.
*)
var
_rc, rcnt :_word;
begin
;with f do
if filetxt
then
begin
Bufstart := Bufstart+1
;BufPoint := BufPoint+1
;_FillReadBuf(f)
;_CheckBufEOLN(f)
end
else
begin
(* Get from a binary file *)
_rc := Dos32Read(handle, buffer, elemsize, rcnt)
;if _rc <> 0
then ErrorLibCode('Error in StdGet for bin file. ', 30, _rc)
;bufeof := rcnt = 0
end
end; (* $StdGet(f :_filedescr); *)
procedure $StdReadBin(Var f :_filedescr; VAR dest :_str);
begin
(* First copy the current contents *)
$memcopy(f.buffer, dest, f.elemsize)
(* Then get new data *)
;$StdGet(f)
end; (* $StdReadBin *)
procedure $StdReadln(Var f :_filedescr);
(* Flush anything on the current line
(* including the current EOLN.
*)
var
rcnt :_word;
done :Boolean;
begin
with f do
begin
done := bufeoln OR bufeof
;while not done
do
begin
$StdGet(f)
;done := bufeoln OR bufeof
end
;if bufeoln
then
begin
(* Only need to go to the next character
(* That is sort of hard since the buffering requires the
(* next line to be entered as well. Maybe a diffentiation on
(* terminal input should be done. Especially if we''re going to
(* implement something as TURBO''s keypressed.
*)
$StdGet(f)
end
end
end;
function $StdEoln(Var f:_filedescr):Boolean;
begin
if not (f.bufeof or f.bufeoln)
then _FillReadBuf(f)
;$StdEoln := f.bufeoln;
end; (* $StdEoln *)
function $Stdeof(Var f:_filedescr):Boolean;
(* Check if it is really at end of file *)
begin
if f.filetxt AND not f.bufeof
then _FillReadBuf(f)
;$Stdeof := f.bufeof
end; (* $StdEoln *)
procedure $StdReadChar(Var f:_filedescr; Var c: char);
(* Read a character from 'f' into 'c'.
(* The end of line character gets treated like a ' '
*)
begin
(* Now copy the data into the request string *)
_FillReadBuf(f)
;c := f.buffer[f.bufstart]
;$StdGet(f)
end; (* $StdReadChar *)
procedure $StdReadString(Var f:_filedescr; Var s: _str; ReadSize: integer);
(* Read text from 'f' into 's'.
(* The maximum number to read is ReadSize characters.
(* If less than ReadSize characters are recieved,
(* OR the input buffer has EOLN
(* then the remainder of the buffer is filled with spaces
*)
var
count : integer;
begin
count := 1
;with f do
begin
_FillReadBuf(f)
(* Now copy the data into the request string *)
;while (count < ReadSize)
and not $Stdeoln(f)
and not $Stdeof(f)
do
begin
s[count] := buffer[bufstart]
;count := count+1
;$StdGet(f)
end
(* Fill the remainder with chr(0) chars *)
;while (count < Readsize)
do
begin
s[count] := chr(0)
;count := count+1
end
end
end; (* $StdReadString *)
procedure $StdReadInt(Var f:_filedescr; Var i: integer);
(* Read integer from 'f' into 'i'.
(* Characters are read from Buffer until it is exhausted or it is
(* not a digit any longer.
(* [6.9.1.c] if V is a variable-access possessing the interger-type (or
(* subrange thereof), read(f,v) shall cause the reading from f of a
(* sequence of charaters, Preceding spaces and end-of-lines shall be
(* skipped. It shall be an error if the rest of the sequence does not
(* form a signed-integer according to the the syntax of 6.5.1. Reading
(* shall cease as soon as the buffer-variable f^ does not have attributed
(* to it a character contained by the signed-integer. The value of the
(* signed-integer thus read shall be assignment-compatible with the type
(* possessed by V, and shall be attributed to v.
(* NB: In no circumstances is ReadInt allowed to skip EOLN or EOF after it
(* has found an initial part of the integer.
(*
*)
var
_rc : _word; (* the result of the latest OS operation *)
j : integer;
c : char;
Sign : integer;
begin
_FillReadBuf(f)
(* Set the default return value *)
;i := 0
;Sign := 1
(* Is there anything in the buffer? *)
;with f do
begin
;If NOT bufeof
then
begin
(* First skip white space *)
while (Buffer[BufStart] = ' ')
(* AND NOT bufeof *)
do
begin
$StdGet(f)
end
(* determine the sign *)
;if (Buffer[BufStart] = '-')
then Sign := -1
;if (Sign = -1) OR (Buffer[BufStart] = '+')
then
begin
$StdGet(f)
end
(* Now get the number *)
;if ('0' <= Buffer[BufStart]) AND (Buffer[BufStart] <= '9')
then
begin
(* Go get all numbers *)
i := (ord(Buffer[BufStart])-ord('0'))
;$StdGet(f)
;while ('0' <= Buffer[BufStart]) AND (Buffer[BufStart] <= '9')
do
begin
(* We ignore overflow *)
i := i*10 + (ord(Buffer[BufStart])-ord('0'))
;$StdGet(f)
end
end
else
begin
writeln('Buffer = |',Buffer[BufStart],'|')
;ErrorLib('No integer found ', 30 )
end
(* Now apply the sign *)
;i := i * Sign
end
else
ErrorLib('No integer found(EOF) ', 30 )
end
end;
procedure $StdAssign(Var f: _filedescr; name :_filename; maxstr :_word);
(* The PASCAL file 'f' has to be linked to the OS-file called 'name'
(* The maximumsize of the string is maxstr. But the name coudl either
(* be terminated by a ' ' or a '\0'
(* Only the file is not opened yet, since we don''t know what is going on
(* for reading or writting.
*)
var
_rc :_word;
i :integer;
ended :boolean;
begin
i:=1
;ended := false
;with f
do
while( NOT ended)
do
begin
fname[i] := name[i]
;ended := (name[i] = ' ') or (name[i] = chr(0)) or (i >= maxstr)
;I := I+1
end
(* Just terminate for OS/2 *)
;f.fname[i] := chr(0)
;f.namelen := i
;f.initialised := _InitMagic
;f.handle := -1
end;
procedure $StdReset(Var f: _filedescr;
name :_str; namesize :_word;
textfile :Boolean; size :_word
);
(* Open the file with the descriptor for reading, and start at the beginning
(* of the file.
*)
var
_rc :_word;
result :_word;
hdltype, dummy :_word;
begin
with f
do
begin
if (Initialised <> _InitMagic)
OR ( (handle <> _stdin)
AND (handle <> _stdout)
AND (handle <> _stderr))
then
begin
if initialised <> _InitMagic
then
begin
$memcopy(name,fname,namesize)
;namelen := namesize
end
else
begin
(* Make shure the file was closed, then open it.
(* but only if it was not one of the standard files
*)
if handle <> -1
then _rc := Dos32Close(handle)
end
;_rc := Dos32Open(fname,handle,result,0,FILE_NORMAL
,OPEN_ACTION_FAIL_IF_NEW+OPEN_ACTION_OPEN_IF_EXISTS
,OPEN_ACCESS_READONLY+OPEN_SHARE_DENYNONE
+OPEN_FLAGS_NOINHERIT+OPEN_FLAGS_SEQUENTIAL
,OPEN_NO_EA_BUF
)
;if(_rc <> 0)
then
writeln('StdReset(',__LINE__:1,'): Error in Dos32Open: rc = ', _rc)
else
begin
if initialised <> _InitMagic
then
begin
$memcopy(name,fname,namesize)
;namelen := namesize
end
;bufstart := 1
;bufpoint := $StrAddr(buffer)
;Bufend := bufstart
;Bufempty := True
;elemsize := size
;Fileopen := True
;FileTxt := textfile
;Bufeoln := False
;Bufeof := False
;_rc := Dos32QueryHType(handle,hdltype,dummy)
;isTTY := textfile AND
(HANDLE_TYPE_CHAR_DEV = $AndWord(hdltype,HANDLE_TYPE_DEV_MASK))
(* Is it allowed to prefetch the buffer ? *)
;if not isTTY
then
$StdGet(f)
;Initialised := _InitMagic
end
end
end
end;
procedure $StdRewrite(Var f: _filedescr;
name :_str; namesize :_word;
textfile :Boolean; size :_word
);
(* Open the file with the descriptor for writing, and start at the beginning
(* of the file.
*)
var
_rc :_word;
result :_word;
hdltype, dummy :_word;
begin
with f
do
begin
;if (Initialised <> _InitMagic)
OR ( (handle <> _stdin)
AND (handle <> _stdout)
AND (handle <> _stderr))
then
begin
if initialised <> _InitMagic
then
begin
$memcopy(name,fname,namesize)
;namelen := namesize
end
else
begin
(* Make shure the file was closed, then open it.
(* but only if it was not one of the standard files
*)
if handle <> -1
then _rc := Dos32Close(handle)
end
;_rc := Dos32open(fname,handle,result,0,FILE_NORMAL
,OPEN_ACTION_CREATE_IF_NEW+OPEN_ACTION_REPLACE_IF_EXISTS
,OPEN_ACCESS_WRITEONLY+OPEN_SHARE_DENYNONE
+OPEN_FLAGS_NOINHERIT+OPEN_FLAGS_SEQUENTIAL
,OPEN_NO_EA_BUF
)
;if(_rc <> 0)
then
writeln('StdReset(',__LINE__:1,'): Error in Dos32Open: rc = ', _rc)
else
with f
do
begin
;bufstart := 1
;bufpoint := $StrAddr(buffer)
;Bufend := bufstart
;Bufempty := True
;elemsize := size
;Fileopen := True
;Fileinp := False
;Filetxt := textfile
;Bufeoln := False
;Bufeof := False
;_rc := Dos32QueryHType(handle,hdltype,dummy)
;isTTY := textfile AND
(HANDLE_TYPE_CHAR_DEV = $AndWord(hdltype,HANDLE_TYPE_DEV_MASK))
end
end
end
end; (* StdRewrite *)
procedure _TextInit(VAR f :_filedescr; hdl :_word;
name :_str; namesize :_word;
forinput, opened :Boolean
);
(* Initialise the descriptor with handle 'hdl' as being a Text mode descriptor
(* Either for in/output as described by the second parameter
(* It could also be a file already opened by the system.
*)
var
_rc, hdltype, dummy :_word;
begin
with f do
begin
$memcopy(name,fname,namesize)
;namelen := namesize
;handle := hdl
;bufstart := 1
;Bufend := bufstart
;BufPoint := $StrAddr(buffer)
;elemsize := 1
;Bufempty := True
;Fileopen := opened
;fileinp := forinput
;filetxt := True
;Bufeoln := False
;Bufeof := False
(* This assumes that these handles are opened already *)
;_rc := Dos32QueryHType(hdl,hdltype,dummy)
;isTTY := HANDLE_TYPE_CHAR_DEV =
$AndWord(hdltype,HANDLE_TYPE_DEV_MASK)
;Initialised := _InitMagic
end
end;
(* Startup and Exit code *)
procedure $IOInit;
(* Initialise all kind of things which are in the STD-library.
*)
var
_rc : _word; (* the result of the latest OS operation *)
begin
(* No Errors yet *)
_rc := 0
(* _input.buf initialisation *)
;_TextInit(_in_descr, _stdin, 'input', 6, True, True )
(* Output initialisation *)
;_TextInit(_out_descr, _stdout, 'output', 7, False, True )
(* Error out initialisation *)
;_TextInit(_err_descr, _stderr, 'error', 6, False, True )
end;
procedure $IOExit;
(* Called when the User part of the program is done.
*)
var
_rc : _word; (* the result of the latest OS operation *)
begin
end;
begin
end.
(*
* $Log: iolib.pas,v $
* Revision 1.1 1993/11/03 15:55:00 wjw
* Started adminstration for the RUNTIME LIB
*
*
* First created by Willem Jan Withagen ( wjw@eb.ele.tue.nl ),
* on Mon July 26 23:30:03 MET 1993
*)