mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-06 06:22:25 +00:00
Update library source to V2.
This commit is contained in:
David Brown
parent
4245c6e8b3
commit
7bdc53145e
46 changed files with 3141 additions and 3349 deletions
|
|
@ -20,7 +20,7 @@ email Patrick.Hunziker@unibas.ch
|
|||
MODULE MultiArrayRiders; (** Patrick Hunziker, Basel, **)
|
||||
(** Implements an array rider access mechanism for multidimensional arrays of arbitrary
|
||||
dimensions defined in MultiArrays*)
|
||||
IMPORT MultiArrays, Out:= Console, Input := Kernel;
|
||||
IMPORT MultiArrays, Out := Console, Input := Platform;
|
||||
CONST (** behaviour of array rider at end of array line;
|
||||
not yet completely implemented.
|
||||
The seemingly more exotic variants are especially useful in image processing *)
|
||||
|
|
|
|||
|
|
@ -40,7 +40,7 @@ Patrick Hunziker,Basel.
|
|||
email Patrick.Hunziker@unibas.ch
|
||||
*)
|
||||
(** Version 0.9, 19.1.2001 *)
|
||||
IMPORT Out:= Console, Input:= Kernel; (* Import only needed for Demo purposes *)
|
||||
IMPORT Out := Console, Input := Platform; (* Import only needed for Demo purposes *)
|
||||
|
||||
TYPE
|
||||
SIntPtr* = POINTER TO ARRAY OF SHORTINT;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
MODULE crt;
|
||||
|
||||
IMPORT vt100, Unix, Console,
|
||||
IMPORT vt100, Platform, Console,
|
||||
Strings; (* strings to remove later ? *)
|
||||
|
||||
CONST
|
||||
|
|
@ -28,11 +28,6 @@ CONST
|
|||
(* Add-in for blinking *)
|
||||
Blink* = 128;
|
||||
|
||||
TYPE
|
||||
PFdSet = POINTER TO Unix.FdSet;
|
||||
|
||||
VAR tmpstr : ARRAY 23 OF CHAR;
|
||||
|
||||
PROCEDURE EraseDisplay*;
|
||||
BEGIN
|
||||
vt100.ED(2);
|
||||
|
|
@ -58,16 +53,8 @@ VAR tmpstr : ARRAY 23 OF CHAR;
|
|||
vt100.DECTCEMh;
|
||||
END cursoron;
|
||||
|
||||
PROCEDURE Delay*( ms : INTEGER);
|
||||
VAR i : LONGINT;
|
||||
tv : Unix.Timeval;
|
||||
pfd : PFdSet;
|
||||
BEGIN
|
||||
tv.sec := 0;
|
||||
tv.usec := ms * 1000;
|
||||
pfd := NIL;
|
||||
i := Unix.Select(0, pfd^, pfd^, pfd^, tv);
|
||||
END Delay;
|
||||
PROCEDURE Delay*(ms: INTEGER);
|
||||
BEGIN Platform.Delay(ms) END Delay;
|
||||
|
||||
PROCEDURE GotoXY* (x, y: INTEGER);
|
||||
BEGIN
|
||||
|
|
|
|||
|
|
@ -1,5 +1,8 @@
|
|||
(* $Id: C.Mod,v 1.9 1999/10/03 11:46:01 ooc-devel Exp $ *)
|
||||
MODULE oocC;
|
||||
|
||||
(* ILP32 model *)
|
||||
|
||||
(* Basic data types for interfacing to C code.
|
||||
Copyright (C) 1997-1998 Michael van Acken
|
||||
|
||||
|
|
@ -18,8 +21,7 @@ MODULE oocC;
|
|||
59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
*)
|
||||
|
||||
IMPORT
|
||||
SYSTEM;
|
||||
IMPORT SYSTEM;
|
||||
|
||||
(*
|
||||
These types are intended to be equivalent to their C counterparts.
|
||||
|
|
@ -28,39 +30,33 @@ Unix they should be fairly safe.
|
|||
*)
|
||||
|
||||
TYPE
|
||||
char* = CHAR;
|
||||
signedchar* = SHORTINT; (* signed char *)
|
||||
shortint* = INTEGER; (* short int *)
|
||||
int* = LONGINT;
|
||||
set* = SET; (* unsigned int, used as set *)
|
||||
longint* = LONGINT; (* long int *)
|
||||
(*longset* = SYSTEM.SET64; *) (* unsigned long, used as set *)
|
||||
longset* = SET;
|
||||
address* = LONGINT;
|
||||
float* = REAL;
|
||||
double* = LONGREAL;
|
||||
char* = CHAR; (* 8 bits *)
|
||||
signedchar* = SHORTINT; (* 8 bits *)
|
||||
shortint* = RECORD a,b: SYSTEM.BYTE END; (* 16 bits *)
|
||||
int* = LONGINT; (* 32 bits *)
|
||||
set* = LONGINT; (* 32 bits *)
|
||||
longint* = LONGINT; (* 32 bits on ILP32 (64 bits is 'long long') *)
|
||||
(*longset* = SET; n/a *) (* 64 bit SET *)
|
||||
address* = LONGINT; (* 32 bits *)
|
||||
float* = REAL; (* 32 bits *)
|
||||
double* = LONGREAL; (* 64 bits *)
|
||||
|
||||
enum1* = int;
|
||||
enum2* = int;
|
||||
enum4* = int;
|
||||
|
||||
(* if your C compiler uses short enumerations, you'll have to replace the
|
||||
declarations above with
|
||||
enum1* = SHORTINT;
|
||||
enum2* = INTEGER;
|
||||
enum4* = LONGINT;
|
||||
(*
|
||||
enum2* = int;
|
||||
enum4* = int;
|
||||
*)
|
||||
|
||||
FILE* = address; (* this is acually a replacement for `FILE*', i.e., for a pointer type *)
|
||||
sizet* = longint;
|
||||
uidt* = int;
|
||||
gidt* = int;
|
||||
FILE* = address; (* this is acually a replacement for `FILE*', i.e., for a pointer type *)
|
||||
sizet* = longint; (* 32 bits in i686 *)
|
||||
uidt* = int;
|
||||
gidt* = int;
|
||||
|
||||
|
||||
TYPE (* some commonly used C array types *)
|
||||
charPtr1d* = POINTER TO ARRAY OF char;
|
||||
charPtr2d* = POINTER TO ARRAY OF charPtr1d;
|
||||
intPtr1d* = POINTER TO ARRAY OF int;
|
||||
intPtr1d* = POINTER TO ARRAY OF int;
|
||||
|
||||
TYPE (* C string type, assignment compatible with character arrays and
|
||||
string constants *)
|
||||
|
|
|
|||
|
|
@ -1,5 +1,8 @@
|
|||
(* $Id: C.Mod,v 1.9 1999/10/03 11:46:01 ooc-devel Exp $ *)
|
||||
MODULE oocC;
|
||||
|
||||
(* LP64 model *)
|
||||
|
||||
(* Basic data types for interfacing to C code.
|
||||
Copyright (C) 1997-1998 Michael van Acken
|
||||
|
||||
|
|
@ -18,8 +21,7 @@ MODULE oocC;
|
|||
59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
*)
|
||||
|
||||
IMPORT
|
||||
SYSTEM;
|
||||
IMPORT SYSTEM;
|
||||
|
||||
(*
|
||||
These types are intended to be equivalent to their C counterparts.
|
||||
|
|
@ -28,42 +30,37 @@ Unix they should be fairly safe.
|
|||
*)
|
||||
|
||||
TYPE
|
||||
char* = CHAR;
|
||||
signedchar* = SHORTINT; (* signed char *)
|
||||
shortint* = RECORD a,b : SYSTEM.BYTE END; (* 2 bytes on x64_64 *) (* short int *)
|
||||
int* = INTEGER;
|
||||
set* = INTEGER;(*SET;*) (* unsigned int, used as set *)
|
||||
longint* = LONGINT; (* long int *)
|
||||
longset* = SET; (*SYSTEM.SET64; *) (* unsigned long, used as set *)
|
||||
address* = LONGINT; (*SYSTEM.ADDRESS;*)
|
||||
float* = REAL;
|
||||
double* = LONGREAL;
|
||||
char* = CHAR; (* 8 bits *)
|
||||
signedchar* = SHORTINT; (* 8 bits *)
|
||||
shortint* = RECORD a,b: SYSTEM.BYTE END; (* 16 bits *)
|
||||
int* = INTEGER; (* 32 bits *)
|
||||
set* = INTEGER; (* 32 bits *)
|
||||
longint* = INTEGER; (* 32 bits *)
|
||||
longset* = SET; (* 64 bits *)
|
||||
address* = LONGINT; (* 64 bits *)
|
||||
float* = REAL; (* 32 bits *)
|
||||
double* = LONGREAL; (* 64 bits *)
|
||||
|
||||
enum1* = int;
|
||||
enum2* = int;
|
||||
enum4* = int;
|
||||
|
||||
(* if your C compiler uses short enumerations, you'll have to replace the
|
||||
declarations above with
|
||||
enum1* = SHORTINT;
|
||||
enum2* = INTEGER;
|
||||
enum4* = LONGINT;
|
||||
(*
|
||||
enum2* = int;
|
||||
enum4* = int;
|
||||
*)
|
||||
|
||||
FILE* = address; (* this is acually a replacement for `FILE*', i.e., for a pointer type *)
|
||||
FILE* = address; (* this is acually a replacement for `FILE*', i.e., for a pointer type *)
|
||||
sizet* = longint;
|
||||
uidt* = int;
|
||||
gidt* = int;
|
||||
uidt* = int;
|
||||
gidt* = int;
|
||||
|
||||
|
||||
TYPE (* some commonly used C array types *)
|
||||
charPtr1d* = POINTER TO ARRAY OF char;
|
||||
charPtr2d* = POINTER TO ARRAY OF charPtr1d;
|
||||
intPtr1d* = POINTER TO ARRAY OF int;
|
||||
intPtr1d* = POINTER TO ARRAY OF int;
|
||||
|
||||
TYPE (* C string type, assignment compatible with character arrays and
|
||||
string constants *)
|
||||
string* = POINTER (*[CSTRING]*) TO ARRAY OF char;
|
||||
string* = POINTER TO ARRAY OF char;
|
||||
|
||||
TYPE
|
||||
Proc* = PROCEDURE;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,8 @@
|
|||
(* $Id: C.Mod,v 1.9 1999/10/03 11:46:01 ooc-devel Exp $ *)
|
||||
MODULE oocC;
|
||||
|
||||
(* LP64 model *)
|
||||
|
||||
(* Basic data types for interfacing to C code.
|
||||
Copyright (C) 1997-1998 Michael van Acken
|
||||
|
||||
|
|
@ -18,8 +21,7 @@ MODULE oocC;
|
|||
59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
*)
|
||||
|
||||
IMPORT
|
||||
SYSTEM;
|
||||
IMPORT SYSTEM;
|
||||
|
||||
(*
|
||||
These types are intended to be equivalent to their C counterparts.
|
||||
|
|
@ -28,42 +30,37 @@ Unix they should be fairly safe.
|
|||
*)
|
||||
|
||||
TYPE
|
||||
char* = CHAR;
|
||||
signedchar* = SHORTINT; (* signed char *)
|
||||
shortint* = RECORD a,b : SYSTEM.BYTE END; (* 2 bytes on x64_64 *) (* short int *)
|
||||
int* = INTEGER;
|
||||
set* = INTEGER;(*SET;*) (* unsigned int, used as set *)
|
||||
longint* = LONGINT; (* long int *)
|
||||
longset* = SET; (*SYSTEM.SET64; *) (* unsigned long, used as set *)
|
||||
address* = LONGINT; (*SYSTEM.ADDRESS;*)
|
||||
float* = REAL;
|
||||
double* = LONGREAL;
|
||||
char* = CHAR; (* 8 bits *)
|
||||
signedchar* = SHORTINT; (* 8 bits *)
|
||||
shortint* = RECORD a,b: SYSTEM.BYTE END; (* 16 bits *)
|
||||
int* = INTEGER; (* 32 bits *)
|
||||
set* = INTEGER; (* 32 bits *)
|
||||
longint* = LONGINT; (* 64 bits *)
|
||||
longset* = SET; (* 64 bits *)
|
||||
address* = LONGINT; (* 64 bits *)
|
||||
float* = REAL; (* 32 bits *)
|
||||
double* = LONGREAL; (* 64 bits *)
|
||||
|
||||
enum1* = int;
|
||||
enum2* = int;
|
||||
enum4* = int;
|
||||
|
||||
(* if your C compiler uses short enumerations, you'll have to replace the
|
||||
declarations above with
|
||||
enum1* = SHORTINT;
|
||||
enum2* = INTEGER;
|
||||
enum4* = LONGINT;
|
||||
(*
|
||||
enum2* = int;
|
||||
enum4* = int;
|
||||
*)
|
||||
|
||||
FILE* = address; (* this is acually a replacement for `FILE*', i.e., for a pointer type *)
|
||||
FILE* = address; (* this is acually a replacement for `FILE*', i.e., for a pointer type *)
|
||||
sizet* = longint;
|
||||
uidt* = int;
|
||||
gidt* = int;
|
||||
uidt* = int;
|
||||
gidt* = int;
|
||||
|
||||
|
||||
TYPE (* some commonly used C array types *)
|
||||
charPtr1d* = POINTER TO ARRAY OF char;
|
||||
charPtr2d* = POINTER TO ARRAY OF charPtr1d;
|
||||
intPtr1d* = POINTER TO ARRAY OF int;
|
||||
intPtr1d* = POINTER TO ARRAY OF int;
|
||||
|
||||
TYPE (* C string type, assignment compatible with character arrays and
|
||||
string constants *)
|
||||
string* = POINTER (*[CSTRING]*) TO ARRAY OF char;
|
||||
string* = POINTER TO ARRAY OF char;
|
||||
|
||||
TYPE
|
||||
Proc* = PROCEDURE;
|
||||
|
|
|
|||
|
|
@ -162,6 +162,7 @@ BEGIN
|
|||
ELSE
|
||||
RETURN strWrongFormat;
|
||||
END;
|
||||
ELSE (* Ignore unrecognised class *)
|
||||
END;
|
||||
prev:=class; INC(index)
|
||||
END;
|
||||
|
|
|
|||
|
|
@ -231,6 +231,7 @@ BEGIN
|
|||
IF decExp THEN DEC(nexp) END;
|
||||
END
|
||||
| Conv.invalid, Conv.terminator: EXIT
|
||||
ELSE (* Ignore unrecognised class *)
|
||||
END;
|
||||
prev:=class; INC(index)
|
||||
END;
|
||||
|
|
@ -285,6 +286,7 @@ BEGIN
|
|||
IF decExp THEN DEC(nexp) END;
|
||||
END
|
||||
| Conv.invalid, Conv.terminator: EXIT
|
||||
ELSE (* Ignore unrecognised class *)
|
||||
END;
|
||||
prev:=class; INC(index)
|
||||
END;
|
||||
|
|
|
|||
|
|
@ -182,6 +182,7 @@ BEGIN
|
|||
IF decExp THEN DEC(nexp) END;
|
||||
END
|
||||
| Conv.invalid, Conv.terminator: EXIT
|
||||
ELSE (* Ignore unrecognised class *)
|
||||
END;
|
||||
prev:=class; INC(index)
|
||||
END;
|
||||
|
|
@ -254,6 +255,7 @@ BEGIN
|
|||
IF decExp THEN DEC(nexp) END;
|
||||
END
|
||||
| Conv.invalid, Conv.terminator: EXIT
|
||||
ELSE (* Ignore unrecognised class *)
|
||||
END;
|
||||
prev:=class; INC(index)
|
||||
END;
|
||||
|
|
|
|||
|
|
@ -1,78 +1,67 @@
|
|||
MODULE oocRts; (* module is written from scratch by noch to wrap around Unix.Mod and Args.Mod and provide compatibility for some ooc libraries *)
|
||||
IMPORT Args, Unix, Files, Strings := oocStrings(*, Console*);
|
||||
IMPORT Args, Platform, Files, Strings := oocStrings(*, Console*);
|
||||
CONST
|
||||
pathSeperator* = "/";
|
||||
|
||||
VAR i : INTEGER;
|
||||
b : BOOLEAN;
|
||||
str0 : ARRAY 128 OF CHAR;
|
||||
VAR
|
||||
i: INTEGER;
|
||||
b: BOOLEAN;
|
||||
str0: ARRAY 128 OF CHAR;
|
||||
|
||||
PROCEDURE System* (command : ARRAY OF CHAR) : INTEGER;
|
||||
(* Executes `command' as a shell command. Result is the value returned by
|
||||
the libc `system' function. *)
|
||||
BEGIN
|
||||
RETURN Unix.System(command)
|
||||
|
||||
END System;
|
||||
BEGIN RETURN Platform.System(command) END System;
|
||||
|
||||
PROCEDURE GetEnv* (VAR var: ARRAY OF CHAR; name: ARRAY OF CHAR): BOOLEAN;
|
||||
(* If an environment variable `name' exists, copy its value into `var' and
|
||||
return TRUE. Otherwise return FALSE. *)
|
||||
BEGIN
|
||||
RETURN Args.getEnv(name, var);
|
||||
END GetEnv;
|
||||
BEGIN RETURN Platform.getEnv(name, var) END GetEnv;
|
||||
|
||||
|
||||
PROCEDURE GetUserHome* (VAR home: ARRAY OF CHAR; user: ARRAY OF CHAR);
|
||||
(* Get the user's home directory path (stored in /etc/passwd)
|
||||
or the current user's home directory if user="". *)
|
||||
VAR
|
||||
f : Files.File;
|
||||
r : Files.Rider;
|
||||
str, str1 : ARRAY 1024 OF CHAR;
|
||||
found, found1 : BOOLEAN;
|
||||
p, p1, p2 : INTEGER;
|
||||
f : Files.File;
|
||||
r : Files.Rider;
|
||||
str, str1 : ARRAY 1024 OF CHAR;
|
||||
found, found1 : BOOLEAN;
|
||||
p, p1, p2 : INTEGER;
|
||||
BEGIN
|
||||
f := Files.Old("/etc/passwd");
|
||||
Files.Set(r, f, 0);
|
||||
|
||||
REPEAT
|
||||
Files.ReadLine(r, str);
|
||||
|
||||
(* Console.String(str); Console.Ln;*)
|
||||
|
||||
Strings.Extract(str, 0, SHORT(LEN(user)-1), str1);
|
||||
(* Console.String(str1); Console.Ln;*)
|
||||
|
||||
IF Strings.Equal(user, str1) THEN found := TRUE END;
|
||||
|
||||
UNTIL found OR r.eof;
|
||||
|
||||
IF found THEN
|
||||
found1 := FALSE;
|
||||
Strings.FindNext(":", str, SHORT(LEN(user)), found1, p); p2 := p + 1;
|
||||
Strings.FindNext(":", str, p2, found1, p); p2 := p + 1;
|
||||
Strings.FindNext(":", str, p2, found1, p); p2 := p + 1;
|
||||
Strings.FindNext(":", str, p2, found1, p); p2 := p + 1;
|
||||
Strings.FindNext(":", str, p2, found1, p1);
|
||||
Strings.Extract(str,p+1,p1-p-1, home);
|
||||
(*Console.String(home); Console.Ln;*)
|
||||
ELSE
|
||||
(* current user's home *)
|
||||
found1 := GetEnv(home, "HOME");
|
||||
(*Console.String("not found"); Console.Ln; Console.String (home); Console.Ln;*)
|
||||
END
|
||||
f := Files.Old("/etc/passwd");
|
||||
Files.Set(r, f, 0);
|
||||
|
||||
REPEAT
|
||||
Files.ReadLine(r, str);
|
||||
(* Console.String(str); Console.Ln;*)
|
||||
Strings.Extract(str, 0, SHORT(LEN(user)-1), str1);
|
||||
(* Console.String(str1); Console.Ln;*)
|
||||
found := Strings.Equal(user, str1)
|
||||
UNTIL found OR r.eof;
|
||||
|
||||
IF found THEN
|
||||
found1 := FALSE;
|
||||
Strings.FindNext(":", str, SHORT(LEN(user)), found1, p); p2 := p + 1;
|
||||
Strings.FindNext(":", str, p2, found1, p); p2 := p + 1;
|
||||
Strings.FindNext(":", str, p2, found1, p); p2 := p + 1;
|
||||
Strings.FindNext(":", str, p2, found1, p); p2 := p + 1;
|
||||
Strings.FindNext(":", str, p2, found1, p1);
|
||||
Strings.Extract(str,p+1,p1-p-1, home);
|
||||
(*Console.String(home); Console.Ln;*)
|
||||
ELSE
|
||||
(* current user's home *)
|
||||
found1 := GetEnv(home, "HOME");
|
||||
(*Console.String("not found"); Console.Ln; Console.String (home); Console.Ln;*)
|
||||
END
|
||||
END GetUserHome;
|
||||
|
||||
BEGIN
|
||||
(* test *)
|
||||
(*
|
||||
i := System("ls");
|
||||
b := GetEnv(str0, "HOME");
|
||||
IF b THEN Console.String(str0); Console.Ln END;
|
||||
|
||||
GetUserHome(str0, "noch");
|
||||
*)
|
||||
(* test *)
|
||||
(*
|
||||
i := System("ls");
|
||||
b := GetEnv(str0, "HOME");
|
||||
IF b THEN Console.String(str0); Console.Ln END;
|
||||
GetUserHome(str0, "noch");
|
||||
*)
|
||||
END oocRts.
|
||||
|
|
|
|||
|
|
@ -1,110 +1,15 @@
|
|||
MODULE oocSysClock;
|
||||
IMPORT Unix;
|
||||
IMPORT SYSTEM, Platform;
|
||||
|
||||
CONST
|
||||
maxSecondParts* = 999; (* Most systems have just millisecond accuracy *)
|
||||
|
||||
zoneMin* = -780; (* time zone minimum minutes *)
|
||||
zoneMax* = 720; (* time zone maximum minutes *)
|
||||
|
||||
localTime* = MIN(INTEGER); (* time zone is inactive & time is local *)
|
||||
unknownZone* = localTime+1; (* time zone is unknown *)
|
||||
|
||||
(* daylight savings mode values *)
|
||||
unknown* = -1; (* current daylight savings status is unknown *)
|
||||
inactive* = 0; (* daylight savings adjustments are not in effect *)
|
||||
active* = 1; (* daylight savings adjustments are being used *)
|
||||
|
||||
TYPE
|
||||
(* The DateTime type is a system-independent time format whose fields
|
||||
are defined as follows:
|
||||
|
||||
year > 0
|
||||
month = 1 .. 12
|
||||
day = 1 .. 31
|
||||
hour = 0 .. 23
|
||||
minute = 0 .. 59
|
||||
second = 0 .. 59
|
||||
fractions = 0 .. maxSecondParts
|
||||
zone = -780 .. 720
|
||||
*)
|
||||
DateTime* =
|
||||
RECORD
|
||||
year*: INTEGER;
|
||||
month*: SHORTINT;
|
||||
day*: SHORTINT;
|
||||
hour*: SHORTINT;
|
||||
minute*: SHORTINT;
|
||||
second*: SHORTINT;
|
||||
summerTimeFlag*: SHORTINT; (* daylight savings mode (see above) *)
|
||||
fractions*: INTEGER; (* parts of a second in milliseconds *)
|
||||
zone*: INTEGER; (* Time zone differential factor which
|
||||
is the number of minutes to add to
|
||||
local time to obtain UTC or is set
|
||||
to localTime when time zones are
|
||||
inactive. *)
|
||||
END;
|
||||
|
||||
|
||||
PROCEDURE CanGetClock*(): BOOLEAN;
|
||||
(* Returns TRUE if a system clock can be read; FALSE otherwise. *)
|
||||
VAR timeval: Unix.Timeval; timezone: Unix.Timezone;
|
||||
l : LONGINT;
|
||||
BEGIN
|
||||
l := Unix.Gettimeofday(timeval, timezone);
|
||||
IF l = 0 THEN RETURN TRUE ELSE RETURN FALSE END
|
||||
END CanGetClock;
|
||||
(*
|
||||
PROCEDURE CanSetClock*(): BOOLEAN;
|
||||
(* Returns TRUE if a system clock can be set; FALSE otherwise. *)
|
||||
*)
|
||||
(*
|
||||
PROCEDURE IsValidDateTime* (d: DateTime): BOOLEAN;
|
||||
(* Returns TRUE if the value of `d' represents a valid date and time;
|
||||
FALSE otherwise. *)
|
||||
*)
|
||||
|
||||
|
||||
(*
|
||||
PROCEDURE SetClock* (userData: DateTime);
|
||||
(* If possible, sets the system clock to the values of `userData'. *)
|
||||
*)
|
||||
(*
|
||||
PROCEDURE MakeLocalTime * (VAR c: DateTime);
|
||||
(* Fill in the daylight savings mode and time zone for calendar date `c'.
|
||||
The fields `zone' and `summerTimeFlag' given in `c' are ignored, assuming
|
||||
that the rest of the record describes a local time.
|
||||
Note 1: On most Unix systems the time zone information is only available for
|
||||
dates falling within approx. 1 Jan 1902 to 31 Dec 2037. Outside this range
|
||||
the field `zone' will be set to the unspecified `localTime' value (see
|
||||
above), and `summerTimeFlag' will be set to `unknown'.
|
||||
Note 2: The time zone information might not be fully accurate for past (and
|
||||
future) years that apply different DST rules than the current year.
|
||||
Usually the current set of rules is used for _all_ years between 1902 and
|
||||
2037.
|
||||
Note 3: With DST there is one hour in the year that happens twice: the
|
||||
hour after which the clock is turned back for a full hour. It is undefined
|
||||
which time zone will be selected for dates refering to this hour, i.e.
|
||||
whether DST or normal time zone will be chosen. *)
|
||||
*)
|
||||
PROCEDURE CanGetClock*(): BOOLEAN; BEGIN RETURN TRUE END CanGetClock;
|
||||
|
||||
PROCEDURE GetTimeOfDay* (VAR sec, usec: LONGINT): LONGINT;
|
||||
(* PRIVAT. Don't use this. Take Time.GetTime instead.
|
||||
Equivalent to the C function `gettimeofday'. The return value is `0' on
|
||||
success and `-1' on failure; in the latter case `sec' and `usec' are set to
|
||||
zero. *)
|
||||
VAR timeval: Unix.Timeval; timezone: Unix.Timezone;
|
||||
l : LONGINT;
|
||||
BEGIN
|
||||
l := Unix.Gettimeofday (timeval, timezone);
|
||||
IF l = 0 THEN
|
||||
sec := timeval.sec;
|
||||
usec := timeval.usec;
|
||||
ELSE
|
||||
sec := 0;
|
||||
usec := 0;
|
||||
END;
|
||||
RETURN l;
|
||||
Platform.GetTimeOfDay(sec, usec); RETURN 0;
|
||||
END GetTimeOfDay;
|
||||
|
||||
END oocSysClock.
|
||||
|
|
|
|||
23
src/library/ooc/oocwrapperlibc.Mod
Executable file
23
src/library/ooc/oocwrapperlibc.Mod
Executable file
|
|
@ -0,0 +1,23 @@
|
|||
MODULE oocwrapperlibc;
|
||||
IMPORT SYSTEM, Platform;
|
||||
|
||||
|
||||
PROCEDURE -includeStdio() "#include <stdio.h>";
|
||||
|
||||
PROCEDURE system*(cmd : ARRAY OF CHAR);
|
||||
VAR r: INTEGER;
|
||||
BEGIN
|
||||
r := Platform.System(cmd)
|
||||
END system;
|
||||
|
||||
|
||||
PROCEDURE -sprntf(s, t0, t1, t2: ARRAY OF CHAR): INTEGER
|
||||
"sprintf((char*)s, (char*)t0, (char*)t1, (char*)t2)";
|
||||
|
||||
PROCEDURE sprintf*(VAR s: ARRAY OF CHAR; template0: ARRAY OF CHAR; template1: ARRAY OF CHAR; template2: ARRAY OF CHAR);
|
||||
VAR r : INTEGER;
|
||||
BEGIN
|
||||
r := sprntf(s, template0, template1, template2);
|
||||
END sprintf;
|
||||
|
||||
END oocwrapperlibc.
|
||||
|
|
@ -124,7 +124,7 @@ VAR
|
|||
positive: BOOLEAN;
|
||||
prev, class: Conv.ScanClass;
|
||||
|
||||
PROCEDURE LessOrEqual (VAR high: ARRAY OF CHAR; start, end: INTEGER): BOOLEAN;
|
||||
PROCEDURE LessOrEqual (VAR high: ARRAY OF CHAR; start, end: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
i: INTEGER;
|
||||
BEGIN (* pre: index-start = maxDigits *)
|
||||
|
|
@ -176,6 +176,7 @@ BEGIN
|
|||
ELSE
|
||||
RETURN strWrongFormat;
|
||||
END;
|
||||
ELSE (* Ignore unrecognised class *)
|
||||
END;
|
||||
prev:=class; INC(index)
|
||||
END;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
MODULE oocX11;(* [INTERFACE "C";
|
||||
LINK LIB "X11" ADDOPTION LibX11Prefix, LibX11Suffix END];*)
|
||||
LINK LIB "X11" ADDOPTION LibX11Prefix, LibX11Suffix END];*)
|
||||
|
||||
IMPORT
|
||||
C := oocC, SYSTEM;
|
||||
|
|
@ -8,6 +8,7 @@ CONST
|
|||
XPROTOCOL* = 11; (* current protocol version *)
|
||||
XPROTOCOLREVISION* = 0; (* current minor version *)
|
||||
|
||||
|
||||
TYPE
|
||||
ulongmask* = C.longset;
|
||||
(*uintmask* = C.set;*)
|
||||
|
|
@ -46,11 +47,11 @@ TYPE
|
|||
CONST
|
||||
None* = 0; (* universal null resource or null atom *)
|
||||
ParentRelative* = 1; (* background pixmap in CreateWindow
|
||||
and ChangeWindowAttributes *)
|
||||
and ChangeWindowAttributes *)
|
||||
CopyFromParent* = 0; (* border pixmap in CreateWindow
|
||||
and ChangeWindowAttributes
|
||||
special VisualID and special window
|
||||
class passed to CreateWindow *)
|
||||
and ChangeWindowAttributes
|
||||
special VisualID and special window
|
||||
class passed to CreateWindow *)
|
||||
PointerWindow* = 0; (* destination window in SendEvent *)
|
||||
InputFocus* = 1; (* destination window in SendEvent *)
|
||||
PointerRoot* = 1; (* focus window in SetInputFocus *)
|
||||
|
|
@ -67,96 +68,96 @@ CONST
|
|||
(* Input Event Masks. Used as event-mask window attribute and as arguments
|
||||
to Grab requests. Not to be confused with event names. *)
|
||||
CONST
|
||||
NoEventMask* = {};
|
||||
KeyPressMask* = {0};
|
||||
KeyReleaseMask* = {1};
|
||||
ButtonPressMask* = {2};
|
||||
ButtonReleaseMask* = {3};
|
||||
EnterWindowMask* = {4};
|
||||
LeaveWindowMask* = {5};
|
||||
PointerMotionMask* = {6};
|
||||
PointerMotionHintMask* = {7};
|
||||
Button1MotionMask* = {8};
|
||||
Button2MotionMask* = {9};
|
||||
Button3MotionMask* = {10};
|
||||
Button4MotionMask* = {11};
|
||||
Button5MotionMask* = {12};
|
||||
ButtonMotionMask* = {13};
|
||||
KeymapStateMask* = {14};
|
||||
ExposureMask* = {15};
|
||||
VisibilityChangeMask* = {16};
|
||||
StructureNotifyMask* = {17};
|
||||
ResizeRedirectMask* = {18};
|
||||
SubstructureNotifyMask* = {19};
|
||||
NoEventMask* = {};
|
||||
KeyPressMask* = {0};
|
||||
KeyReleaseMask* = {1};
|
||||
ButtonPressMask* = {2};
|
||||
ButtonReleaseMask* = {3};
|
||||
EnterWindowMask* = {4};
|
||||
LeaveWindowMask* = {5};
|
||||
PointerMotionMask* = {6};
|
||||
PointerMotionHintMask* = {7};
|
||||
Button1MotionMask* = {8};
|
||||
Button2MotionMask* = {9};
|
||||
Button3MotionMask* = {10};
|
||||
Button4MotionMask* = {11};
|
||||
Button5MotionMask* = {12};
|
||||
ButtonMotionMask* = {13};
|
||||
KeymapStateMask* = {14};
|
||||
ExposureMask* = {15};
|
||||
VisibilityChangeMask* = {16};
|
||||
StructureNotifyMask* = {17};
|
||||
ResizeRedirectMask* = {18};
|
||||
SubstructureNotifyMask* = {19};
|
||||
SubstructureRedirectMask* = {20};
|
||||
FocusChangeMask* = {21};
|
||||
PropertyChangeMask* = {22};
|
||||
ColormapChangeMask* = {23};
|
||||
OwnerGrabButtonMask* = {24};
|
||||
FocusChangeMask* = {21};
|
||||
PropertyChangeMask* = {22};
|
||||
ColormapChangeMask* = {23};
|
||||
OwnerGrabButtonMask* = {24};
|
||||
|
||||
(* Event names. Used in "type" field in XEvent structures. Not to be
|
||||
confused with event masks above. They start from 2 because 0 and 1
|
||||
are reserved in the protocol for errors and replies. *)
|
||||
CONST
|
||||
KeyPress* = 2;
|
||||
KeyRelease* = 3;
|
||||
ButtonPress* = 4;
|
||||
ButtonRelease* = 5;
|
||||
MotionNotify* = 6;
|
||||
EnterNotify* = 7;
|
||||
LeaveNotify* = 8;
|
||||
FocusIn* = 9;
|
||||
FocusOut* = 10;
|
||||
KeymapNotify* = 11;
|
||||
Expose* = 12;
|
||||
GraphicsExpose* = 13;
|
||||
NoExpose* = 14;
|
||||
KeyPress* = 2;
|
||||
KeyRelease* = 3;
|
||||
ButtonPress* = 4;
|
||||
ButtonRelease* = 5;
|
||||
MotionNotify* = 6;
|
||||
EnterNotify* = 7;
|
||||
LeaveNotify* = 8;
|
||||
FocusIn* = 9;
|
||||
FocusOut* = 10;
|
||||
KeymapNotify* = 11;
|
||||
Expose* = 12;
|
||||
GraphicsExpose* = 13;
|
||||
NoExpose* = 14;
|
||||
VisibilityNotify* = 15;
|
||||
CreateNotify* = 16;
|
||||
DestroyNotify* = 17;
|
||||
UnmapNotify* = 18;
|
||||
MapNotify* = 19;
|
||||
MapRequest* = 20;
|
||||
ReparentNotify* = 21;
|
||||
ConfigureNotify* = 22;
|
||||
CreateNotify* = 16;
|
||||
DestroyNotify* = 17;
|
||||
UnmapNotify* = 18;
|
||||
MapNotify* = 19;
|
||||
MapRequest* = 20;
|
||||
ReparentNotify* = 21;
|
||||
ConfigureNotify* = 22;
|
||||
ConfigureRequest* = 23;
|
||||
GravityNotify* = 24;
|
||||
ResizeRequest* = 25;
|
||||
CirculateNotify* = 26;
|
||||
GravityNotify* = 24;
|
||||
ResizeRequest* = 25;
|
||||
CirculateNotify* = 26;
|
||||
CirculateRequest* = 27;
|
||||
PropertyNotify* = 28;
|
||||
SelectionClear* = 29;
|
||||
PropertyNotify* = 28;
|
||||
SelectionClear* = 29;
|
||||
SelectionRequest* = 30;
|
||||
SelectionNotify* = 31;
|
||||
ColormapNotify* = 32;
|
||||
ClientMessage* = 33;
|
||||
MappingNotify* = 34;
|
||||
LASTEvent* = 35; (* must be bigger than any event # *)
|
||||
SelectionNotify* = 31;
|
||||
ColormapNotify* = 32;
|
||||
ClientMessage* = 33;
|
||||
MappingNotify* = 34;
|
||||
LASTEvent* = 35; (* must be bigger than any event # *)
|
||||
|
||||
(* Key masks. Used as modifiers to GrabButton and GrabKey, results of
|
||||
QueryPointer, state in various key-, mouse-, and button-related events. *)
|
||||
CONST
|
||||
ShiftMask* = {0};
|
||||
LockMask* = {1};
|
||||
ShiftMask* = {0};
|
||||
LockMask* = {1};
|
||||
ControlMask* = {2};
|
||||
Mod1Mask* = {3};
|
||||
Mod2Mask* = {4};
|
||||
Mod3Mask* = {5};
|
||||
Mod4Mask* = {6};
|
||||
Mod5Mask* = {7};
|
||||
Mod1Mask* = {3};
|
||||
Mod2Mask* = {4};
|
||||
Mod3Mask* = {5};
|
||||
Mod4Mask* = {6};
|
||||
Mod5Mask* = {7};
|
||||
|
||||
(* modifier names. Used to build a SetModifierMapping request or
|
||||
to read a GetModifierMapping request. These correspond to the
|
||||
masks defined above. *)
|
||||
CONST
|
||||
ShiftMapIndex* = 0;
|
||||
LockMapIndex* = 1;
|
||||
ShiftMapIndex* = 0;
|
||||
LockMapIndex* = 1;
|
||||
ControlMapIndex* = 2;
|
||||
Mod1MapIndex* = 3;
|
||||
Mod2MapIndex* = 4;
|
||||
Mod3MapIndex* = 5;
|
||||
Mod4MapIndex* = 6;
|
||||
Mod5MapIndex* = 7;
|
||||
Mod1MapIndex* = 3;
|
||||
Mod2MapIndex* = 4;
|
||||
Mod3MapIndex* = 5;
|
||||
Mod4MapIndex* = 6;
|
||||
Mod5MapIndex* = 7;
|
||||
|
||||
(* button masks. Used in same manner as Key masks above. Not to be confused
|
||||
with button names below. *)
|
||||
|
|
@ -270,14 +271,14 @@ CONST
|
|||
BadMatch* = 8; (* parameter mismatch *)
|
||||
BadDrawable* = 9; (* parameter not a Pixmap or Window *)
|
||||
BadAccess* = 10; (* depending on context:
|
||||
- key/button already grabbed
|
||||
- attempt to free an illegal
|
||||
cmap entry
|
||||
- attempt to store into a read-only
|
||||
color map entry.
|
||||
- attempt to modify the access control
|
||||
list from other than the local host.
|
||||
*)
|
||||
- key/button already grabbed
|
||||
- attempt to free an illegal
|
||||
cmap entry
|
||||
- attempt to store into a read-only
|
||||
color map entry.
|
||||
- attempt to modify the access control
|
||||
list from other than the local host.
|
||||
*)
|
||||
BadAlloc* = 11; (* insufficient resources *)
|
||||
BadColor* = 12; (* no such colormap *)
|
||||
BadGC* = 13; (* parameter not a GC *)
|
||||
|
|
@ -630,9 +631,9 @@ CONST
|
|||
$XFree86: xc/lib/X11/Xlib.h,v 3.2 1994/09/17 13:44:15 dawes Exp $ *)
|
||||
|
||||
(*
|
||||
* Xlib.h - Header definition and support file for the C subroutine
|
||||
* interface library (Xlib) to the X Window System Protocol (V11).
|
||||
* Structures and symbols starting with "" are private to the library.
|
||||
* Xlib.h - Header definition and support file for the C subroutine
|
||||
* interface library (Xlib) to the X Window System Protocol (V11).
|
||||
* Structures and symbols starting with "" are private to the library.
|
||||
*)
|
||||
|
||||
CONST
|
||||
|
|
@ -706,10 +707,10 @@ TYPE
|
|||
linewidth*: C.int; (* line width *)
|
||||
linestyle*: C.int; (* LineSolid, LineOnOffDash, LineDoubleDash *)
|
||||
capstyle*: C.int; (* CapNotLast, CapButt,
|
||||
CapRound, CapProjecting *)
|
||||
CapRound, CapProjecting *)
|
||||
joinstyle*: C.int; (* JoinMiter, JoinRound, JoinBevel *)
|
||||
fillstyle*: C.int; (* FillSolid, FillTiled,
|
||||
FillStippled, FillOpaeueStippled *)
|
||||
FillStippled, FillOpaeueStippled *)
|
||||
fillrule*: C.int; (* EvenOddRule, WindingRule *)
|
||||
arcmode*: C.int; (* ArcChord, ArcPieSlice *)
|
||||
tile*: Pixmap; (* tile pixmap for tiling operations *)
|
||||
|
|
@ -1118,9 +1119,9 @@ TYPE
|
|||
xroot*, yroot*: C.int; (* coordinates relative to root *)
|
||||
mode*: C.int; (* NotifyNormal, NotifyGrab, NotifyUngrab *)
|
||||
detail*: C.int; (*
|
||||
* NotifyAncestor, NotifyVirtual, NotifyInferior,
|
||||
* NotifyNonlinear,NotifyNonlinearVirtual
|
||||
*)
|
||||
* NotifyAncestor, NotifyVirtual, NotifyInferior,
|
||||
* NotifyNonlinear,NotifyNonlinearVirtual
|
||||
*)
|
||||
samescreen*: Bool; (* same screen flag *)
|
||||
focus*: Bool; (* boolean focus *)
|
||||
state*: uintmask; (* key or button mask *)
|
||||
|
|
@ -1137,10 +1138,10 @@ TYPE
|
|||
window*: Window; (* window of event *)
|
||||
mode*: C.int; (* NotifyNormal, NotifyGrab, NotifyUngrab *)
|
||||
detail*: C.int; (*
|
||||
* NotifyAncestor, NotifyVirtual, NotifyInferior,
|
||||
* NotifyNonlinear,NotifyNonlinearVirtual, NotifyPointer,
|
||||
* NotifyPointerRoot, NotifyDetailNone
|
||||
*)
|
||||
* NotifyAncestor, NotifyVirtual, NotifyInferior,
|
||||
* NotifyNonlinear,NotifyNonlinearVirtual, NotifyPointer,
|
||||
* NotifyPointerRoot, NotifyDetailNone
|
||||
*)
|
||||
END;
|
||||
XFocusInEvent* = XFocusChangeEvent;
|
||||
XFocusOutEvent* = XFocusChangeEvent;
|
||||
|
|
@ -1431,7 +1432,7 @@ TYPE
|
|||
display*: DisplayPtr; (* Display the event was read from *)
|
||||
window*: Window; (* unused *)
|
||||
request*: C.int; (* one of MappingModifier, MappingKeyboard,
|
||||
MappingPointer *)
|
||||
MappingPointer *)
|
||||
firstkeycode*: C.int; (* first keycode *)
|
||||
count*: C.int; (* defines range of change w. firstkeycode*)
|
||||
END;
|
||||
|
|
@ -1950,6 +1951,13 @@ TYPE
|
|||
XErrorHandler* = PROCEDURE (display: DisplayPtr; errorevent: XErrorEventPtr): C.int;
|
||||
XIOErrorHandler* = PROCEDURE (display: DisplayPtr);
|
||||
XConnectionWatchProc* = PROCEDURE (dpy: DisplayPtr; clientdate: XPointer; fd: C.int; opening: Bool; watchdata: XPointerPtr1d);
|
||||
|
||||
|
||||
PROCEDURE -aincludexlib "#include <X11/Xlib.h>";
|
||||
PROCEDURE -aincludexutil "#include <X11/Xutil.h>";
|
||||
PROCEDURE -aincludexresource "#include <X11/Xresource.h>";
|
||||
|
||||
|
||||
(*
|
||||
PROCEDURE XLoadQueryFont* (
|
||||
display: DisplayPtr;
|
||||
|
|
@ -1987,7 +1995,7 @@ PROCEDURE -XCreateImage* (
|
|||
height: C.int;
|
||||
bitmapPad: C.int;
|
||||
bytesPerLine: C.int): XImagePtr
|
||||
"(long)XCreateImage(display, visual, depth, format, offset, data, width, height, bitmapPad, bytesPerLine)";
|
||||
"(oocX11_XImagePtr)XCreateImage((struct _XDisplay*)display, (Visual*)visual, depth, format, offset, (char*)data, width, height, bitmapPad, bytesPerLine)";
|
||||
(*
|
||||
PROCEDURE XInitImage* (
|
||||
image: XImagePtr): Status;
|
||||
|
|
@ -2017,8 +2025,7 @@ PROCEDURE XGetSubImage* (
|
|||
* X function declarations.
|
||||
*)
|
||||
*)
|
||||
PROCEDURE -XOpenDisplay* (name: ARRAY OF C.char): DisplayPtr
|
||||
"(long)XOpenDisplay(name)";
|
||||
PROCEDURE -XOpenDisplay* (name: ARRAY OF C.char): DisplayPtr "(oocX11_DisplayPtr)XOpenDisplay((char*)name)";
|
||||
|
||||
PROCEDURE OpenDisplay* (name: ARRAY OF C.char): DisplayPtr;
|
||||
BEGIN
|
||||
|
|
@ -2101,7 +2108,7 @@ PROCEDURE -XCreateGC* (
|
|||
d: Drawable;
|
||||
valueMask: ulongmask;
|
||||
VAR values: XGCValues): GC
|
||||
"(long)XCreateGC(display, d, valueMask, values)";
|
||||
"(oocX11_GC)XCreateGC((struct _XDisplay*)display, d, valueMask, (XGCValues *)values)";
|
||||
(*
|
||||
PROCEDURE XGContextFromGC* (
|
||||
gc: GC): GContext;
|
||||
|
|
@ -2140,7 +2147,7 @@ PROCEDURE -XCreateSimpleWindow* (
|
|||
borderWidth: C.int;
|
||||
border: C.longint;
|
||||
background: C.longint): Window
|
||||
"(long)XCreateSimpleWindow(display, parent, x, y, width, height, borderWidth, border, background)";
|
||||
"(long)XCreateSimpleWindow((struct _XDisplay*)display, parent, x, y, width, height, borderWidth, border, background)";
|
||||
(*
|
||||
PROCEDURE XGetSelectionOwner* (
|
||||
display: DisplayPtr;
|
||||
|
|
@ -2240,7 +2247,7 @@ PROCEDURE XEHeadOfExtensionList* (
|
|||
PROCEDURE -XRootWindow* (
|
||||
display: DisplayPtr;
|
||||
screen: C.int): Window
|
||||
"(long)XRootWindow(display, screen)";
|
||||
"(long)XRootWindow((struct _XDisplay*)display, screen)";
|
||||
(*
|
||||
PROCEDURE XDefaultRootWindow* (
|
||||
display: DisplayPtr): Window;
|
||||
|
|
@ -2250,7 +2257,7 @@ PROCEDURE XRootWindowOfScreen* (
|
|||
PROCEDURE -XDefaultVisual* (
|
||||
display: DisplayPtr;
|
||||
screen: C.int): VisualPtr
|
||||
"(long)XDefaultVisual(display, screen)";
|
||||
"(oocX11_VisualPtr)XDefaultVisual((struct _XDisplay*)display, screen)";
|
||||
(*
|
||||
PROCEDURE XDefaultVisualOfScreen* (
|
||||
screen: ScreenPtr): VisualPtr;
|
||||
|
|
@ -2263,12 +2270,12 @@ PROCEDURE XDefaultGCOfScreen* (
|
|||
PROCEDURE -XBlackPixel* (
|
||||
display: DisplayPtr;
|
||||
screen: C.int): C.longint
|
||||
"(long)XBlackPixel(display, screen)";
|
||||
"(long)XBlackPixel((struct _XDisplay*)display, screen)";
|
||||
|
||||
PROCEDURE -XWhitePixel* (
|
||||
display: DisplayPtr;
|
||||
screen: C.int): C.longint
|
||||
"(long)XWhitePixel(display, screen)";
|
||||
"(long)XWhitePixel((struct _XDisplay*)display, screen)";
|
||||
(*
|
||||
PROCEDURE XAllPlanes* (): C.longint;
|
||||
PROCEDURE XBlackPixelOfScreen* (
|
||||
|
|
@ -2296,7 +2303,7 @@ PROCEDURE XScreenOfDisplay* (
|
|||
*)
|
||||
PROCEDURE -XDefaultScreenOfDisplay* (
|
||||
display: DisplayPtr): ScreenPtr
|
||||
"(long)XDefaultScreen(display)";
|
||||
"(long)XDefaultScreen((struct _XDisplay*)display)";
|
||||
(*
|
||||
PROCEDURE XEventMaskOfScreen* (
|
||||
screen: ScreenPtr): C.longint;
|
||||
|
|
@ -2523,7 +2530,7 @@ PROCEDURE XClearWindow* (
|
|||
|
||||
PROCEDURE -XCloseDisplay* (
|
||||
display: DisplayPtr)
|
||||
"XCloseDisplay(display)";
|
||||
"XCloseDisplay((struct _XDisplay*)display)";
|
||||
|
||||
|
||||
(*
|
||||
|
|
@ -2577,7 +2584,7 @@ PROCEDURE XDefaultDepthOfScreen* (
|
|||
*)
|
||||
PROCEDURE -XDefaultScreen* (
|
||||
display: DisplayPtr): C.int
|
||||
"(int)XDefaultScreen(display)";
|
||||
"(int)XDefaultScreen((struct _XDisplay*)display)";
|
||||
(*
|
||||
PROCEDURE XDefineCursor* (
|
||||
display: DisplayPtr;
|
||||
|
|
@ -2591,11 +2598,11 @@ PROCEDURE XDeleteProperty* (
|
|||
PROCEDURE -XDestroyWindow* (
|
||||
display: DisplayPtr;
|
||||
w: Window)
|
||||
"XDestroyWindow(display, w)";
|
||||
"XDestroyWindow((struct _XDisplay*)display, w)";
|
||||
|
||||
|
||||
PROCEDURE -XDestroyImage* (image : XImagePtr)
|
||||
"XDestroyImage(image)";
|
||||
"XDestroyImage((struct _XDisplay*)image)";
|
||||
|
||||
(*
|
||||
PROCEDURE XDestroySubwindows* (
|
||||
|
|
@ -2614,7 +2621,7 @@ PROCEDURE XDisplayCells* (
|
|||
PROCEDURE -XDisplayHeight* (
|
||||
display: DisplayPtr;
|
||||
screen: C.int): C.int
|
||||
"(int)XDisplayHeight(display, screen)";
|
||||
"(int)XDisplayHeight((struct _XDisplay*)display, screen)";
|
||||
(*
|
||||
PROCEDURE XDisplayHeightMM* (
|
||||
display: DisplayPtr;
|
||||
|
|
@ -2630,7 +2637,7 @@ PROCEDURE XDisplayPlanes* (
|
|||
PROCEDURE -XDisplayWidth* (
|
||||
display: DisplayPtr;
|
||||
screennumber: C.int): C.int
|
||||
"(int)XDisplayWidth(display, screen)";
|
||||
"(int)XDisplayWidth((struct _XDisplay*)display, screen)";
|
||||
(*
|
||||
PROCEDURE XDisplayWidthMM* (
|
||||
display: DisplayPtr;
|
||||
|
|
@ -2690,7 +2697,7 @@ PROCEDURE -XDrawPoint* (
|
|||
gc: GC;
|
||||
x: C.int;
|
||||
y: C.int)
|
||||
"XDrawPoint(display, d, gc, x, y)";
|
||||
"XDrawPoint((struct _XDisplay*)display, d, (struct _XGC*)gc, x, y)";
|
||||
(*
|
||||
PROCEDURE XDrawPoints* (
|
||||
display: DisplayPtr;
|
||||
|
|
@ -2758,7 +2765,7 @@ PROCEDURE XEnableAccessControl* (
|
|||
PROCEDURE -XEventsQueued* (
|
||||
display: DisplayPtr;
|
||||
mode: C.int): C.int
|
||||
"(int)XEventsQueued(display, mode)";
|
||||
"(int)XEventsQueued((struct _XDisplay*)display, mode)";
|
||||
(*
|
||||
PROCEDURE XFetchName* (
|
||||
display: DisplayPtr;
|
||||
|
|
@ -2797,7 +2804,7 @@ PROCEDURE -XFillRectangle* (
|
|||
y: C.int;
|
||||
width: C.int;
|
||||
height: C.int)
|
||||
"XFillRectangle(display, d, gc, x, y, width, height)";
|
||||
"XFillRectangle((struct _XDisplay*)display, d, (struct _XGC*)gc, x, y, width, height)";
|
||||
(*
|
||||
PROCEDURE XFillRectangles* (
|
||||
display: DisplayPtr;
|
||||
|
|
@ -2808,7 +2815,7 @@ PROCEDURE XFillRectangles* (
|
|||
*)
|
||||
PROCEDURE -XFlush* (
|
||||
display: DisplayPtr)
|
||||
"XFlush(display)";
|
||||
"XFlush((struct _XDisplay*)display)";
|
||||
(*
|
||||
PROCEDURE XForceScreenSaver* (
|
||||
display: DisplayPtr;
|
||||
|
|
@ -3016,13 +3023,13 @@ PROCEDURE XMapSubwindows* (
|
|||
PROCEDURE -XMapWindow* (
|
||||
display: DisplayPtr;
|
||||
w: Window)
|
||||
"XMapWindow(display, w)";
|
||||
"XMapWindow((struct _XDisplay*)display, w)";
|
||||
|
||||
PROCEDURE -XMaskEvent* (
|
||||
display: DisplayPtr;
|
||||
mask: ulongmask;
|
||||
VAR event: XEvent)
|
||||
"XMaskEvent(display, mask, event)";
|
||||
"XMaskEvent((struct _XDisplay*)display, mask, (union _XEvent*)event)";
|
||||
|
||||
(*
|
||||
PROCEDURE XMaxCmapsOfScreen* (
|
||||
|
|
@ -3045,7 +3052,7 @@ PROCEDURE XMoveWindow* (
|
|||
PROCEDURE -XNextEvent* (
|
||||
display: DisplayPtr;
|
||||
VAR event: XEvent)
|
||||
"XNextEvent(display, event)";
|
||||
"XNextEvent((struct _XDisplay*)display, (union _XEvent*)event)";
|
||||
(*
|
||||
PROCEDURE XNoOp* (
|
||||
display: DisplayPtr);
|
||||
|
|
@ -3091,7 +3098,7 @@ PROCEDURE -XPutImage* (
|
|||
dstY: C.int;
|
||||
width: C.int;
|
||||
height: C.int)
|
||||
"XPutImage(display, d, gc, image, srcX, srcY, dstX, dstY, width, height)";
|
||||
"XPutImage((struct _XDisplay*)display, d, (struct _XGC*)gc, (struct _XImage*)image, srcX, srcY, dstX, dstY, width, height)";
|
||||
(*
|
||||
PROCEDURE XQLength* (
|
||||
display: DisplayPtr): C.int;
|
||||
|
|
@ -3254,7 +3261,7 @@ PROCEDURE -XSelectInput* (
|
|||
display: DisplayPtr;
|
||||
window: Window;
|
||||
eventMask: ulongmask)
|
||||
"XSelectInput(display, window, eventMask)";
|
||||
"XSelectInput((struct _XDisplay*)display, window, (long)eventMask)";
|
||||
(*
|
||||
PROCEDURE XSendEvent* (
|
||||
display: DisplayPtr;
|
||||
|
|
@ -3441,7 +3448,7 @@ PROCEDURE -XStoreName* (
|
|||
display: DisplayPtr;
|
||||
window: Window;
|
||||
name: ARRAY OF C.char)
|
||||
"XStoreName(display, window, name)";
|
||||
"XStoreName((struct _XDisplay*)display, window, (char*)name)";
|
||||
(*
|
||||
PROCEDURE XStoreNamedColor* (
|
||||
display: DisplayPtr;
|
||||
|
|
|
|||
|
|
@ -32,8 +32,14 @@ VAR
|
|||
initialized: BOOLEAN; (* first call to Open sets this to TRUE *)
|
||||
image: X11.XImagePtr;
|
||||
map: POINTER TO ARRAY OF ARRAY OF SET;
|
||||
|
||||
|
||||
|
||||
PROCEDURE -aincludexlib "#include <X11/Xlib.h>";
|
||||
PROCEDURE -aincludexutil "#include <X11/Xutil.h>";
|
||||
PROCEDURE -aincludexresource "#include <X11/Xresource.h>";
|
||||
|
||||
|
||||
PROCEDURE Error (msg: ARRAY OF CHAR);
|
||||
BEGIN
|
||||
Out.String ("Error: ");
|
||||
|
|
@ -70,6 +76,7 @@ PROCEDURE Dot* (x, y, mode: INTEGER);
|
|||
X11.XDrawPoint (display, window, fg, x, H-1-y)
|
||||
| erase:
|
||||
X11.XDrawPoint (display, window, bg, x, H-1-y)
|
||||
ELSE
|
||||
END;
|
||||
X11.XFlush (display);
|
||||
END
|
||||
|
|
@ -135,44 +142,43 @@ PROCEDURE Key* (): CHAR;
|
|||
PROCEDURE Open*;
|
||||
(* Initializes the drawing plane. *)
|
||||
VAR
|
||||
screen: C.int;
|
||||
parent: X11.Window;
|
||||
bgColor, fgColor: C.longint;
|
||||
screen: C.int;
|
||||
parent: X11.Window;
|
||||
bgColor: C.longint;
|
||||
fgColor: C.longint;
|
||||
gcValue: X11.XGCValues;
|
||||
event: X11.XEvent;
|
||||
x, y: INTEGER;
|
||||
tmpstr : string;
|
||||
(*tmpint : INTEGER;*)
|
||||
scrn : C.int;
|
||||
vis : X11.VisualPtr;
|
||||
event: X11.XEvent;
|
||||
x, y: INTEGER;
|
||||
tmpstr: string;
|
||||
scrn : C.int;
|
||||
vis : X11.VisualPtr;
|
||||
BEGIN
|
||||
|
||||
IF ~initialized THEN
|
||||
initialized := TRUE;
|
||||
|
||||
tmpstr[0] := 0X;
|
||||
(*display := X11.XOpenDisplay (NIL);*)
|
||||
display := X11.XOpenDisplay (tmpstr);
|
||||
display := X11.XOpenDisplay(tmpstr);
|
||||
(*display := X11.OpenDisplay (NIL);*)
|
||||
IF (display = NIL) THEN
|
||||
Error ("Couldn't open display")
|
||||
Error("Couldn't open display")
|
||||
ELSE
|
||||
screen := X11.XDefaultScreen (display);
|
||||
screen := X11.XDefaultScreen(display);
|
||||
X := 0; Y := 0;
|
||||
W := SHORT (X11.XDisplayWidth (display, screen));
|
||||
H := SHORT (X11.XDisplayHeight (display, screen));
|
||||
H := SHORT (X11.XDisplayHeight(display, screen));
|
||||
(* adjust ratio W:H to 3:4 [for no paritcular reason] *)
|
||||
IF (W > 3*H DIV 4) THEN
|
||||
W := 3*H DIV 4
|
||||
END;
|
||||
parent := X11.XRootWindow (display, screen);
|
||||
fgColor := X11.XBlackPixel (display, screen);
|
||||
bgColor := X11.XWhitePixel (display, screen);
|
||||
window := X11.XCreateSimpleWindow (display, parent, 0, 0,
|
||||
parent := X11.XRootWindow(display, screen);
|
||||
fgColor := X11.XBlackPixel(display, screen);
|
||||
bgColor := X11.XWhitePixel(display, screen);
|
||||
window := X11.XCreateSimpleWindow(display, parent, 0, 0,
|
||||
W, H, 0, 0, bgColor);
|
||||
X11.XStoreName (display, window, "XYplane");
|
||||
X11.XSelectInput (display, window, X11.KeyPressMask+X11.ExposureMask);
|
||||
X11.XMapWindow (display, window);
|
||||
X11.XStoreName(display, window, "XYplane");
|
||||
X11.XSelectInput(display, window, X11.KeyPressMask+X11.ExposureMask);
|
||||
X11.XMapWindow(display, window);
|
||||
X11.XFlush (display);
|
||||
(*tmpint := W + ((*sizeSet*)32-1);
|
||||
tmpint := tmpint DIV 32(*sizeSet*);*)
|
||||
|
|
@ -184,16 +190,16 @@ PROCEDURE Open*;
|
|||
END
|
||||
END;
|
||||
|
||||
scrn := X11.XDefaultScreen (display);
|
||||
vis := X11.XDefaultVisual (display, scrn);
|
||||
image := X11.XCreateImage (display,
|
||||
scrn := X11.XDefaultScreen(display);
|
||||
vis := X11.XDefaultVisual(display, scrn);
|
||||
image := X11.XCreateImage (display,
|
||||
(*X11.XDefaultVisual (display, X11.XDefaultScreen (display)),*)
|
||||
vis,
|
||||
(*1, X11.XYBitmap, 0, SYSTEM.ADR (map^), W, H, sizeSet, 0);*)
|
||||
1, X11.ZPixmap, 0, SYSTEM.ADR (map^), W, H, (*sizeSet*)32, 0);
|
||||
1, X11.ZPixmap, 0, SYSTEM.VAL(C.address,SYSTEM.ADR(map^)), W, H, (*sizeSet*)32, 0);
|
||||
|
||||
(* wait until the window manager gives its ok to draw things *)
|
||||
X11.XMaskEvent (display, X11.ExposureMask, event);
|
||||
X11.XMaskEvent(display, X11.ExposureMask, event);
|
||||
|
||||
(* create graphic context to draw resp. erase a point *)
|
||||
gcValue. foreground := fgColor;
|
||||
|
|
@ -208,7 +214,7 @@ PROCEDURE Open*;
|
|||
END
|
||||
END Open;
|
||||
|
||||
PROCEDURE Close*;
|
||||
PROCEDURE Close*;
|
||||
|
||||
BEGIN
|
||||
(* X11.XDestroyImage(image);
|
||||
|
|
|
|||
|
|
@ -359,7 +359,7 @@ PROCEDURE -XLookupString* (
|
|||
VAR keysymReturn: X.KeySym;
|
||||
(*VAR statusInOut(*[NILCOMPAT]*): XComposeStatus): C.int*)
|
||||
VAR statusInOut(*[NILCOMPAT]*): C.longint): C.int
|
||||
"(int)XLookupString(eventStruct, bufferReturn, bytesBuffer, keysymReturn, statusInOut)";
|
||||
"(int)XLookupString((XKeyEvent*)eventStruct, bufferReturn, bytesBuffer, (KeySym*)keysymReturn, (XComposeStatus*)statusInOut)";
|
||||
(*
|
||||
PROCEDURE XMatchVisualInfo* (
|
||||
display: X.DisplayPtr;
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load diff
|
|
@ -1105,6 +1105,7 @@ MODULE ethBTrees; (** portable *) (* ejz, *)
|
|||
CASE T.class OF
|
||||
LInt: WriteLIntPage(T, p(LIntPage))
|
||||
|Str: WriteStrPage(T, p(StrPage))
|
||||
ELSE
|
||||
END
|
||||
END;
|
||||
p := p.next
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@ Refer to the "General ETH Oberon System Source License" contract available at: h
|
|||
|
||||
MODULE ethRandomNumbers; (** portable *)
|
||||
(* Random Number Generator, page 12 *)
|
||||
IMPORT Math := oocOakMath, Oberon := Kernel, SYSTEM;
|
||||
IMPORT Math := oocOakMath, Oberon := Platform, SYSTEM;
|
||||
|
||||
VAR Z, t, d: LONGINT;
|
||||
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@ Implemented by Bernd Moesli, Seminar for Applied Mathematics,
|
|||
Swiss Federal Institute of Technology Z…rich.
|
||||
*)
|
||||
|
||||
IMPORT SYSTEM;
|
||||
IMPORT SYSTEM, Platform, Configuration;
|
||||
|
||||
(* Bernd Moesli
|
||||
Seminar for Applied Mathematics
|
||||
|
|
@ -33,6 +33,7 @@ IMPORT SYSTEM;
|
|||
7.11.1995 jt: dynamic endianess test
|
||||
22.01.97 pjm: NaN stuff (using quiet NaNs only to avoid traps)
|
||||
05.01.98 prk: NaN with INF support
|
||||
17.02.16 dcb: Adapt for 32 bit INTEGER and 64 bit LONGINT.
|
||||
*)
|
||||
|
||||
VAR
|
||||
|
|
@ -45,55 +46,109 @@ VAR
|
|||
(** Returns the shifted binary exponent (0 <= e < 256). *)
|
||||
PROCEDURE Expo* (x: REAL): LONGINT;
|
||||
BEGIN
|
||||
RETURN ASH(SYSTEM.VAL(LONGINT, x), -23) MOD 256
|
||||
IF SIZE(INTEGER) = 4 THEN
|
||||
RETURN SHORT(ASH(SYSTEM.VAL(INTEGER, x), -23)) MOD 256
|
||||
ELSIF SIZE(LONGINT) = 4 THEN
|
||||
RETURN SHORT(ASH(SYSTEM.VAL(LONGINT, x), -23)) MOD 256
|
||||
ELSE Platform.Halt(-15);
|
||||
END
|
||||
END Expo;
|
||||
|
||||
(** Returns the shifted binary exponent (0 <= e < 2048). *)
|
||||
PROCEDURE ExpoL* (x: LONGREAL): LONGINT;
|
||||
VAR i: LONGINT;
|
||||
BEGIN
|
||||
SYSTEM.GET(SYSTEM.ADR(x) + H, i); RETURN ASH(i, -20) MOD 2048
|
||||
IF SIZE(LONGINT) = 8 THEN
|
||||
RETURN ASH(SYSTEM.VAL(LONGINT, x), -50) MOD 256
|
||||
ELSE
|
||||
SYSTEM.GET(SYSTEM.ADR(x) + H, i); RETURN ASH(i, -20) MOD 2048
|
||||
END
|
||||
END ExpoL;
|
||||
|
||||
(** Sets the shifted binary exponent. *)
|
||||
PROCEDURE SetExpo* (e: LONGINT; VAR x: REAL);
|
||||
VAR i: LONGINT;
|
||||
PROCEDURE SetExpo* (e: INTEGER; VAR x: REAL);
|
||||
VAR i: INTEGER; l: LONGINT;
|
||||
BEGIN
|
||||
SYSTEM.GET(SYSTEM.ADR(x), i);
|
||||
i:= ASH(ASH(ASH(i, -31), 8) + e MOD 256, 23) + i MOD ASH(1, 23);
|
||||
SYSTEM.PUT(SYSTEM.ADR(x), i)
|
||||
IF SIZE(LONGINT) = 4 THEN
|
||||
SYSTEM.GET(SYSTEM.ADR(x), l);
|
||||
l := ASH(ASH(ASH(l, -31), 8) + e MOD 256, 23) + l MOD ASH(1, 23);
|
||||
SYSTEM.PUT(SYSTEM.ADR(x), l)
|
||||
ELSIF SIZE(INTEGER) = 4 THEN
|
||||
SYSTEM.GET(SYSTEM.ADR(x), i);
|
||||
i := SHORT(ASH(ASH(ASH(i, -31), 8) + e MOD 256, 23) + i MOD ASH(1, 23));
|
||||
SYSTEM.PUT(SYSTEM.ADR(x), i)
|
||||
ELSE Platform.Halt(-15)
|
||||
END
|
||||
END SetExpo;
|
||||
|
||||
(** Sets the shifted binary exponent. *)
|
||||
PROCEDURE SetExpoL* (e: LONGINT; VAR x: LONGREAL);
|
||||
VAR i: LONGINT;
|
||||
VAR i: INTEGER; l: LONGINT;
|
||||
BEGIN
|
||||
SYSTEM.GET(SYSTEM.ADR(x) + H, i);
|
||||
i:= ASH(ASH(ASH(i, -31), 11) + e MOD 2048, 20) + i MOD ASH(1, 20);
|
||||
SYSTEM.PUT(SYSTEM.ADR(x) + H, i)
|
||||
IF SIZE(LONGINT) = 4 THEN
|
||||
SYSTEM.GET(SYSTEM.ADR(x) + H, l);
|
||||
l := ASH(ASH(ASH(l, -31), 11) + e MOD 2048, 20) + l MOD ASH(1, 20);
|
||||
SYSTEM.PUT(SYSTEM.ADR(x) + H, l)
|
||||
ELSIF SIZE(INTEGER) = 4 THEN
|
||||
SYSTEM.GET(SYSTEM.ADR(x) + H, i);
|
||||
i := SHORT(ASH(ASH(ASH(i, -31), 11) + e MOD 2048, 20) + i MOD ASH(1, 20));
|
||||
SYSTEM.PUT(SYSTEM.ADR(x) + H, i)
|
||||
ELSE Platform.Halt(-15)
|
||||
END
|
||||
END SetExpoL;
|
||||
|
||||
(** Convert hexadecimal to REAL. *)
|
||||
PROCEDURE Real* (h: LONGINT): REAL;
|
||||
VAR x: REAL;
|
||||
BEGIN SYSTEM.PUT(SYSTEM.ADR(x), h); RETURN x
|
||||
BEGIN
|
||||
IF SIZE(LONGINT) = 4 THEN
|
||||
SYSTEM.PUT(SYSTEM.ADR(x), h)
|
||||
ELSIF SIZE(INTEGER) = 4 THEN
|
||||
SYSTEM.PUT(SYSTEM.ADR(x), SYSTEM.VAL(INTEGER, h))
|
||||
ELSE Platform.Halt(-15)
|
||||
END;
|
||||
RETURN x
|
||||
END Real;
|
||||
|
||||
(** Convert hexadecimal to LONGREAL. h and l are the high and low parts.*)
|
||||
PROCEDURE RealL* (h, l: LONGINT): LONGREAL;
|
||||
VAR x: LONGREAL;
|
||||
BEGIN SYSTEM.PUT(SYSTEM.ADR(x) + H, h); SYSTEM.PUT(SYSTEM.ADR(x) + L, l); RETURN x
|
||||
BEGIN
|
||||
IF SIZE(LONGINT) = 4 THEN
|
||||
SYSTEM.PUT(SYSTEM.ADR(x) + H, h);
|
||||
SYSTEM.PUT(SYSTEM.ADR(x) + L, l)
|
||||
ELSIF SIZE(INTEGER) = 4 THEN
|
||||
SYSTEM.PUT(SYSTEM.ADR(x) + H, SYSTEM.VAL(INTEGER, h));
|
||||
SYSTEM.PUT(SYSTEM.ADR(x) + L, SYSTEM.VAL(INTEGER, l))
|
||||
ELSE Platform.Halt(-15)
|
||||
END;
|
||||
RETURN x
|
||||
END RealL;
|
||||
|
||||
(** Convert REAL to hexadecimal. *)
|
||||
PROCEDURE Int* (x: REAL): LONGINT;
|
||||
VAR i: LONGINT;
|
||||
BEGIN SYSTEM.PUT(SYSTEM.ADR(i), x); RETURN i
|
||||
VAR i: INTEGER; l: LONGINT;
|
||||
BEGIN
|
||||
IF SIZE(LONGINT) = 4 THEN
|
||||
SYSTEM.PUT(SYSTEM.ADR(l), x); RETURN l
|
||||
ELSIF SIZE(INTEGER) = 4 THEN
|
||||
SYSTEM.PUT(SYSTEM.ADR(i), x); RETURN i
|
||||
ELSE Platform.Halt(-15)
|
||||
END
|
||||
END Int;
|
||||
|
||||
(** Convert LONGREAL to hexadecimal. h and l are the high and low parts. *)
|
||||
PROCEDURE IntL* (x: LONGREAL; VAR h, l: LONGINT);
|
||||
BEGIN SYSTEM.GET(SYSTEM.ADR(x) + H, h); SYSTEM.GET(SYSTEM.ADR(x) + L, l)
|
||||
VAR i: INTEGER;
|
||||
BEGIN
|
||||
IF SIZE(LONGINT) = 4 THEN
|
||||
SYSTEM.GET(SYSTEM.ADR(x) + H, h);
|
||||
SYSTEM.GET(SYSTEM.ADR(x) + L, l)
|
||||
ELSIF SIZE(INTEGER) = 4 THEN
|
||||
SYSTEM.GET(SYSTEM.ADR(x) + H, i); h := i;
|
||||
SYSTEM.GET(SYSTEM.ADR(x) + L, i); l := i
|
||||
ELSE Platform.Halt(-15)
|
||||
END
|
||||
END IntL;
|
||||
|
||||
(** Returns 10^e (e <= 308, 308 < e delivers IEEE-code +INF). *)
|
||||
|
|
@ -112,8 +167,9 @@ END Ten;
|
|||
|
||||
(** Returns the NaN code (0 <= c < 8399608) or -1 if not NaN/Infinite. *)
|
||||
PROCEDURE NaNCode* (x: REAL): LONGINT;
|
||||
VAR e: LONGINT;
|
||||
BEGIN
|
||||
IF ASH(SYSTEM.VAL(LONGINT, x), -23) MOD 256 = 255 THEN (* Infinite or NaN *)
|
||||
IF Expo(x) = 255 THEN (* Infinite or NaN *)
|
||||
RETURN SYSTEM.VAL(LONGINT, x) MOD 800000H (* lowest 23 bits *)
|
||||
ELSE
|
||||
RETURN -1
|
||||
|
|
@ -123,7 +179,7 @@ END NaNCode;
|
|||
(** Returns the NaN code (0 <= h < 1048576, MIN(LONGINT) <= l <= MAX(LONGINT)) or (-1,-1) if not NaN/Infinite. *)
|
||||
PROCEDURE NaNCodeL* (x: LONGREAL; VAR h, l: LONGINT);
|
||||
BEGIN
|
||||
SYSTEM.GET(SYSTEM.ADR(x) + H, h); SYSTEM.GET(SYSTEM.ADR(x) + L, l);
|
||||
IntL(x, h, l);
|
||||
IF ASH(h, -20) MOD 2048 = 2047 THEN (* Infinite or NaN *)
|
||||
h := h MOD 100000H (* lowest 20 bits *)
|
||||
ELSE
|
||||
|
|
@ -131,37 +187,6 @@ BEGIN
|
|||
END
|
||||
END NaNCodeL;
|
||||
|
||||
(** Returns TRUE iff x is NaN/Infinite. *)
|
||||
PROCEDURE IsNaN* (x: REAL): BOOLEAN;
|
||||
BEGIN
|
||||
RETURN ASH(SYSTEM.VAL(LONGINT, x), -23) MOD 256 = 255
|
||||
END IsNaN;
|
||||
|
||||
(** Returns TRUE iff x is NaN/Infinite. *)
|
||||
PROCEDURE IsNaNL* (x: LONGREAL): BOOLEAN;
|
||||
VAR h: LONGINT;
|
||||
BEGIN
|
||||
SYSTEM.GET(SYSTEM.ADR(x) + H, h);
|
||||
RETURN ASH(h, -20) MOD 2048 = 2047
|
||||
END IsNaNL;
|
||||
|
||||
(** Returns NaN with specified code (0 <= l < 8399608). *)
|
||||
PROCEDURE NaN* (l: LONGINT): REAL;
|
||||
VAR x: REAL;
|
||||
BEGIN
|
||||
SYSTEM.PUT(SYSTEM.ADR(x), (l MOD 800000H) + 7F800000H);
|
||||
RETURN x
|
||||
END NaN;
|
||||
|
||||
(** Returns NaN with specified code (0 <= h < 1048576, MIN(LONGINT) <= l <= MAX(LONGINT)). *)
|
||||
PROCEDURE NaNL* (h, l: LONGINT): LONGREAL;
|
||||
VAR x: LONGREAL;
|
||||
BEGIN
|
||||
h := (h MOD 100000H) + 7FF00000H;
|
||||
SYSTEM.PUT(SYSTEM.ADR(x) + H, h);
|
||||
SYSTEM.PUT(SYSTEM.ADR(x) + L, l);
|
||||
RETURN x
|
||||
END NaNL;
|
||||
(*
|
||||
PROCEDURE fcr(): SET;
|
||||
CODE {SYSTEM.i386, SYSTEM.FPU}
|
||||
|
|
@ -192,33 +217,29 @@ BEGIN
|
|||
IF Kernel.copro THEN setfcr(s) END
|
||||
END SetFCR;
|
||||
*)
|
||||
|
||||
PROCEDURE RealX (h, l: LONGINT; adr: LONGINT);
|
||||
BEGIN SYSTEM.PUT(adr + H, h); SYSTEM.PUT(adr + L, l);
|
||||
BEGIN
|
||||
IF SIZE(LONGINT) = 4 THEN
|
||||
SYSTEM.PUT(adr + H, h); SYSTEM.PUT(adr + L, l);
|
||||
ELSIF SIZE(INTEGER) = 4 THEN
|
||||
SYSTEM.PUT(adr + H, SYSTEM.VAL(INTEGER, h));
|
||||
SYSTEM.PUT(adr + L, SYSTEM.VAL(INTEGER, l));
|
||||
ELSE Platform.Halt(-15)
|
||||
END
|
||||
END RealX;
|
||||
|
||||
PROCEDURE InitHL;
|
||||
VAR (*i: LONGINT; dmy: INTEGER;*) littleEndian: BOOLEAN;
|
||||
BEGIN
|
||||
(*DefaultFCR := (FCR() - {0,2,3,10,11}) + {0..5,8,9};
|
||||
SetFCR(DefaultFCR);
|
||||
|
||||
dmy := 1; i := SYSTEM.ADR(dmy);
|
||||
SYSTEM.GET(i, littleEndian); (* indirection via i avoids warning on SUN cc -O *)*)
|
||||
littleEndian := TRUE; (* endianness will be set for each architecture -- noch *)
|
||||
IF littleEndian THEN H := 4; L := 0 ELSE H := 0; L := 4 END
|
||||
END InitHL;
|
||||
|
||||
BEGIN InitHL;
|
||||
RealX(03FF00000H, 0, SYSTEM.ADR(tene[0]));
|
||||
RealX(040240000H, 0, SYSTEM.ADR(tene[1])); (* 1 *)
|
||||
RealX(040590000H, 0, SYSTEM.ADR(tene[2])); (* 2 *)
|
||||
RealX(0408F4000H, 0, SYSTEM.ADR(tene[3])); (* 3 *)
|
||||
RealX(040C38800H, 0, SYSTEM.ADR(tene[4])); (* 4 *)
|
||||
RealX(040F86A00H, 0, SYSTEM.ADR(tene[5])); (* 5 *)
|
||||
RealX(0412E8480H, 0, SYSTEM.ADR(tene[6])); (* 6 *)
|
||||
RealX(0416312D0H, 0, SYSTEM.ADR(tene[7])); (* 7 *)
|
||||
RealX(04197D784H, 0, SYSTEM.ADR(tene[8])); (* 8 *)
|
||||
RealX(041CDCD65H, 0, SYSTEM.ADR(tene[9])); (* 9 *)
|
||||
RealX(03FF00000H, 000000000H, SYSTEM.ADR(tene[0]));
|
||||
RealX(040240000H, 000000000H, SYSTEM.ADR(tene[1])); (* 1 *)
|
||||
RealX(040590000H, 000000000H, SYSTEM.ADR(tene[2])); (* 2 *)
|
||||
RealX(0408F4000H, 000000000H, SYSTEM.ADR(tene[3])); (* 3 *)
|
||||
RealX(040C38800H, 000000000H, SYSTEM.ADR(tene[4])); (* 4 *)
|
||||
RealX(040F86A00H, 000000000H, SYSTEM.ADR(tene[5])); (* 5 *)
|
||||
RealX(0412E8480H, 000000000H, SYSTEM.ADR(tene[6])); (* 6 *)
|
||||
RealX(0416312D0H, 000000000H, SYSTEM.ADR(tene[7])); (* 7 *)
|
||||
RealX(04197D784H, 000000000H, SYSTEM.ADR(tene[8])); (* 8 *)
|
||||
RealX(041CDCD65H, 000000000H, SYSTEM.ADR(tene[9])); (* 9 *)
|
||||
RealX(04202A05FH, 020000000H, SYSTEM.ADR(tene[10])); (* 10 *)
|
||||
RealX(042374876H, 0E8000000H, SYSTEM.ADR(tene[11])); (* 11 *)
|
||||
RealX(0426D1A94H, 0A2000000H, SYSTEM.ADR(tene[12])); (* 12 *)
|
||||
|
|
@ -231,35 +252,35 @@ BEGIN InitHL;
|
|||
RealX(043E158E4H, 060913D00H, SYSTEM.ADR(tene[19])); (* 19 *)
|
||||
RealX(04415AF1DH, 078B58C40H, SYSTEM.ADR(tene[20])); (* 20 *)
|
||||
RealX(0444B1AE4H, 0D6E2EF50H, SYSTEM.ADR(tene[21])); (* 21 *)
|
||||
RealX(04480F0CFH, 064DD592H, SYSTEM.ADR(tene[22])); (* 22 *)
|
||||
RealX(04480F0CFH, 0064DD592H, SYSTEM.ADR(tene[22])); (* 22 *)
|
||||
|
||||
RealX(031FA18H, 02C40C60DH, SYSTEM.ADR(ten[0])); (* -307 *)
|
||||
RealX(04F7CAD2H, 03DE82D7BH, SYSTEM.ADR(ten[1])); (* -284 *)
|
||||
RealX(09BF7D22H, 08322BAF5H, SYSTEM.ADR(ten[2])); (* -261 *)
|
||||
RealX(0E84D669H, 05B193BF8H, SYSTEM.ADR(ten[3])); (* -238 *)
|
||||
RealX(0134B9408H, 0EEFEA839H, SYSTEM.ADR(ten[4])); (* -215 *)
|
||||
RealX(018123FF0H, 06EEA847AH, SYSTEM.ADR(ten[5])); (* -192 *)
|
||||
RealX(01CD82742H, 091C6065BH, SYSTEM.ADR(ten[6])); (* -169 *)
|
||||
RealX(0219FF779H, 0FD329CB9H, SYSTEM.ADR(ten[7])); (* -146 *)
|
||||
RealX(02665275EH, 0D8D8F36CH, SYSTEM.ADR(ten[8])); (* -123 *)
|
||||
RealX(02B2BFF2EH, 0E48E0530H, SYSTEM.ADR(ten[9])); (* -100 *)
|
||||
RealX(02FF286D8H, 0EC190DCH, SYSTEM.ADR(ten[10])); (* -77 *)
|
||||
RealX(034B8851AH, 0B548EA4H, SYSTEM.ADR(ten[11])); (* -54 *)
|
||||
RealX(0398039D6H, 065896880H, SYSTEM.ADR(ten[12])); (* -31 *)
|
||||
RealX(03E45798EH, 0E2308C3AH, SYSTEM.ADR(ten[13])); (* -8 *)
|
||||
RealX(0430C6BF5H, 026340000H, SYSTEM.ADR(ten[14])); (* 15 *)
|
||||
RealX(047D2CED3H, 02A16A1B1H, SYSTEM.ADR(ten[15])); (* 38 *)
|
||||
RealX(04C98E45EH, 01DF3B015H, SYSTEM.ADR(ten[16])); (* 61 *)
|
||||
RealX(0516078E1H, 011C3556DH, SYSTEM.ADR(ten[17])); (* 84 *)
|
||||
RealX(05625CCFEH, 03D35D80EH, SYSTEM.ADR(ten[18])); (* 107 *)
|
||||
RealX(05AECDA62H, 055B2D9EH, SYSTEM.ADR(ten[19])); (* 130 *)
|
||||
RealX(05FB317E5H, 0EF3AB327H, SYSTEM.ADR(ten[20])); (* 153 *)
|
||||
RealX(064794514H, 05230B378H, SYSTEM.ADR(ten[21])); (* 176 *)
|
||||
RealX(06940B8E0H, 0ACAC4EAFH, SYSTEM.ADR(ten[22])); (* 199 *)
|
||||
RealX(06E0621B1H, 0C28AC20CH, SYSTEM.ADR(ten[23])); (* 222 *)
|
||||
RealX(072CD4A7BH, 0EBFA31ABH, SYSTEM.ADR(ten[24])); (* 245 *)
|
||||
RealX(077936214H, 09CBD3226H, SYSTEM.ADR(ten[25])); (* 268 *)
|
||||
RealX(07C59A742H, 0461887F6H, SYSTEM.ADR(ten[26])); (* 291 *)
|
||||
RealX(00031FA18H, 02C40C60DH, SYSTEM.ADR(ten[0])); (* -307 *)
|
||||
RealX(004F7CAD2H, 03DE82D7BH, SYSTEM.ADR(ten[1])); (* -284 *)
|
||||
RealX(009BF7D22H, 08322BAF5H, SYSTEM.ADR(ten[2])); (* -261 *)
|
||||
RealX(00E84D669H, 05B193BF8H, SYSTEM.ADR(ten[3])); (* -238 *)
|
||||
RealX(0134B9408H, 0EEFEA839H, SYSTEM.ADR(ten[4])); (* -215 *)
|
||||
RealX(018123FF0H, 06EEA847AH, SYSTEM.ADR(ten[5])); (* -192 *)
|
||||
RealX(01CD82742H, 091C6065BH, SYSTEM.ADR(ten[6])); (* -169 *)
|
||||
RealX(0219FF779H, 0FD329CB9H, SYSTEM.ADR(ten[7])); (* -146 *)
|
||||
RealX(02665275EH, 0D8D8F36CH, SYSTEM.ADR(ten[8])); (* -123 *)
|
||||
RealX(02B2BFF2EH, 0E48E0530H, SYSTEM.ADR(ten[9])); (* -100 *)
|
||||
RealX(02FF286D8H, 00EC190DCH, SYSTEM.ADR(ten[10])); (* -77 *)
|
||||
RealX(034B8851AH, 00B548EA4H, SYSTEM.ADR(ten[11])); (* -54 *)
|
||||
RealX(0398039D6H, 065896880H, SYSTEM.ADR(ten[12])); (* -31 *)
|
||||
RealX(03E45798EH, 0E2308C3AH, SYSTEM.ADR(ten[13])); (* -8 *)
|
||||
RealX(0430C6BF5H, 026340000H, SYSTEM.ADR(ten[14])); (* 15 *)
|
||||
RealX(047D2CED3H, 02A16A1B1H, SYSTEM.ADR(ten[15])); (* 38 *)
|
||||
RealX(04C98E45EH, 01DF3B015H, SYSTEM.ADR(ten[16])); (* 61 *)
|
||||
RealX(0516078E1H, 011C3556DH, SYSTEM.ADR(ten[17])); (* 84 *)
|
||||
RealX(05625CCFEH, 03D35D80EH, SYSTEM.ADR(ten[18])); (* 107 *)
|
||||
RealX(05AECDA62H, 0055B2D9EH, SYSTEM.ADR(ten[19])); (* 130 *)
|
||||
RealX(05FB317E5H, 0EF3AB327H, SYSTEM.ADR(ten[20])); (* 153 *)
|
||||
RealX(064794514H, 05230B378H, SYSTEM.ADR(ten[21])); (* 176 *)
|
||||
RealX(06940B8E0H, 0ACAC4EAFH, SYSTEM.ADR(ten[22])); (* 199 *)
|
||||
RealX(06E0621B1H, 0C28AC20CH, SYSTEM.ADR(ten[23])); (* 222 *)
|
||||
RealX(072CD4A7BH, 0EBFA31ABH, SYSTEM.ADR(ten[24])); (* 245 *)
|
||||
RealX(077936214H, 09CBD3226H, SYSTEM.ADR(ten[25])); (* 268 *)
|
||||
RealX(07C59A742H, 0461887F6H, SYSTEM.ADR(ten[26])); (* 291 *)
|
||||
|
||||
eq[0]:= {0, 3, 4, 5, 9, 16, 23, 25, 26, 28, 31};
|
||||
eq[1]:= {2, 5, 6, 8, 9, 10, 11, 12, 13, 14, 15, 17, 18, 19, 20, 21, 23, 24, 25, 27, 28, 29, 30, 31};
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@ MODULE ethStrings; (** portable *) (* ejz, *)
|
|||
(** Strings is a utility module that provides procedures to manipulate strings.
|
||||
Note: All strings MUST be 0X terminated. *)
|
||||
|
||||
IMPORT Oberon, Texts, Dates := ethDates, Reals := ethReals;
|
||||
IMPORT Texts, Dates := ethDates, Reals := ethReals;
|
||||
|
||||
CONST
|
||||
CR* = 0DX; (** the Oberon end of line character *)
|
||||
|
|
|
|||
|
|
@ -486,6 +486,7 @@ BEGIN
|
|||
ELSE
|
||||
res := DataError
|
||||
END
|
||||
ELSE
|
||||
END;
|
||||
IF res = Ok THEN
|
||||
Files.Close(Files.Base(dst));
|
||||
|
|
|
|||
|
|
@ -257,6 +257,7 @@ PROCEDURE SetDataType(VAR stream: Stream);
|
|||
VAR
|
||||
n, ascii, bin: LONGINT;
|
||||
BEGIN
|
||||
n := 0; ascii := 0; bin := 0;
|
||||
WHILE n < 7 DO INC(bin, LONG(stream.lnode[n].freqOrCode)); INC(n) END;
|
||||
WHILE n < 128 DO INC(ascii, LONG(stream.lnode[n].freqOrCode)); INC(n) END;
|
||||
WHILE n < Literals DO INC(bin, LONG(stream.lnode[n].freqOrCode)); INC(n) END;
|
||||
|
|
|
|||
|
|
@ -777,6 +777,7 @@ MODULE ethZlibInflate; (** eos **)
|
|||
s.block.state := BlkBad; s.res.code := DataError;
|
||||
Flush(s);
|
||||
EXIT
|
||||
ELSE
|
||||
END
|
||||
|
||||
| BlkLens: (* read length of uncompressed block *)
|
||||
|
|
@ -890,6 +891,7 @@ MODULE ethZlibInflate; (** eos **)
|
|||
| 18: (* repeat code length 0 for 11-138 times, using another 7 bits *)
|
||||
IF ~Need(s, node.bits+7) THEN EXIT END;
|
||||
Dump(s, node.bits); cnt := 11 + s.buf MOD 128; Dump(s, 7); len := 0
|
||||
ELSE
|
||||
END;
|
||||
IF s.block.index + cnt > s.block.nlit + s.block.ndist THEN
|
||||
SetMsg(s.res, "invalid bit length repeat");
|
||||
|
|
@ -1125,6 +1127,7 @@ MODULE ethZlibInflate; (** eos **)
|
|||
| InfBad: (* error in stream *)
|
||||
stream.res.code := DataError;
|
||||
EXIT
|
||||
ELSE
|
||||
END
|
||||
END
|
||||
END
|
||||
|
|
|
|||
|
|
@ -520,6 +520,7 @@ MODULE ulmConstStrings;
|
|||
| Streams.fromStart: realpos := cnt;
|
||||
| Streams.fromPos: realpos := s.pos + cnt;
|
||||
| Streams.fromEnd: realpos := s.string.length + cnt;
|
||||
ELSE
|
||||
END;
|
||||
IF (realpos < 0) OR (realpos > s.string.length) THEN
|
||||
RETURN FALSE
|
||||
|
|
|
|||
|
|
@ -375,6 +375,7 @@ MODULE ulmEvents;
|
|||
ptr := ptr.next;
|
||||
END;
|
||||
psys.currentPriority := oldPriority;
|
||||
ELSE (* Explicitly ignore unhandled even type reactions *)
|
||||
END;
|
||||
END CallHandlers;
|
||||
|
||||
|
|
|
|||
|
|
@ -647,6 +647,7 @@ MODULE ulmPersistentObjects;
|
|||
ELSE
|
||||
form := incrF;
|
||||
END;
|
||||
ELSE
|
||||
END;
|
||||
IF mode DIV 4 MOD 2 > 0 THEN
|
||||
INC(form, sizeF);
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load diff
|
|
@ -64,43 +64,43 @@ MODULE ulmResources;
|
|||
TYPE
|
||||
StateChange* = SHORTINT; (* terminated..communicationResumed *)
|
||||
State = SHORTINT; (* alive, unreferenced, or alive *)
|
||||
(* whether objects are stopped or not is maintained separately *)
|
||||
(* whether objects are stopped or not is maintained separately *)
|
||||
Event* = POINTER TO EventRec; (* notification of state changes *)
|
||||
EventRec* =
|
||||
RECORD
|
||||
(Events.EventRec)
|
||||
change*: StateChange; (* new state *)
|
||||
resource*: Resource;
|
||||
END;
|
||||
RECORD
|
||||
(Events.EventRec)
|
||||
change*: StateChange; (* new state *)
|
||||
resource*: Resource;
|
||||
END;
|
||||
|
||||
TYPE
|
||||
Key* = POINTER TO KeyRec;
|
||||
KeyRec* =
|
||||
RECORD
|
||||
(Objects.ObjectRec)
|
||||
valid: BOOLEAN;
|
||||
resource: Resource;
|
||||
END;
|
||||
RECORD
|
||||
(Objects.ObjectRec)
|
||||
valid: BOOLEAN;
|
||||
resource: Resource;
|
||||
END;
|
||||
|
||||
TYPE
|
||||
List = POINTER TO ListRec;
|
||||
ListRec =
|
||||
RECORD
|
||||
resource: Resource;
|
||||
next: List;
|
||||
END;
|
||||
RECORD
|
||||
resource: Resource;
|
||||
next: List;
|
||||
END;
|
||||
Discipline = POINTER TO DisciplineRec;
|
||||
DisciplineRec =
|
||||
RECORD
|
||||
(Disciplines.DisciplineRec)
|
||||
state: State; (* alive, unreferenced, or terminated *)
|
||||
stopped: BOOLEAN; (* may be TRUE, if alive or unreferenced *)
|
||||
refcnt: LONGINT; (* # of Attach - # of Detach *)
|
||||
eventType: Events.EventType; (* may be NIL *)
|
||||
dependants: List; (* list of resources which depends on us *)
|
||||
dependsOn: Resource; (* we depend on this resource *)
|
||||
key: Key; (* attach key for dependsOn *)
|
||||
END;
|
||||
RECORD
|
||||
(Disciplines.DisciplineRec)
|
||||
state: State; (* alive, unreferenced, or terminated *)
|
||||
stopped: BOOLEAN; (* may be TRUE, if alive or unreferenced *)
|
||||
refcnt: LONGINT; (* # of Attach - # of Detach *)
|
||||
eventType: Events.EventType; (* may be NIL *)
|
||||
dependants: List; (* list of resources which depends on us *)
|
||||
dependsOn: Resource; (* we depend on this resource *)
|
||||
key: Key; (* attach key for dependsOn *)
|
||||
END;
|
||||
VAR
|
||||
discID: Disciplines.Identifier;
|
||||
|
||||
|
|
@ -120,27 +120,27 @@ MODULE ulmResources;
|
|||
noch
|
||||
*)
|
||||
IF ~Disciplines.Seek(resource, discID, SYSTEM.VAL(Disciplines.Discipline, disc)) THEN (* noch *)
|
||||
NEW(disc); disc.id := discID;
|
||||
disc.state := alive; disc.refcnt := 0;
|
||||
disc.eventType := NIL;
|
||||
disc.dependants := NIL; disc.dependsOn := NIL;
|
||||
Disciplines.Add(resource, disc);
|
||||
NEW(disc); disc.id := discID;
|
||||
disc.state := alive; disc.refcnt := 0;
|
||||
disc.eventType := NIL;
|
||||
disc.dependants := NIL; disc.dependsOn := NIL;
|
||||
Disciplines.Add(resource, disc);
|
||||
END;
|
||||
END GetDisc;
|
||||
|
||||
PROCEDURE GenEvent(resource: Resource; change: StateChange);
|
||||
VAR
|
||||
disc: Discipline;
|
||||
event: Event;
|
||||
disc: Discipline;
|
||||
event: Event;
|
||||
BEGIN
|
||||
GetDisc(resource, disc);
|
||||
IF disc.eventType # NIL THEN
|
||||
NEW(event);
|
||||
event.type := disc.eventType;
|
||||
event.message := "Resources: state change notification";
|
||||
event.change := change;
|
||||
event.resource := resource;
|
||||
Events.Raise(event);
|
||||
NEW(event);
|
||||
event.type := disc.eventType;
|
||||
event.message := "Resources: state change notification";
|
||||
event.change := change;
|
||||
event.resource := resource;
|
||||
Events.Raise(event);
|
||||
END;
|
||||
END GenEvent;
|
||||
|
||||
|
|
@ -149,24 +149,24 @@ MODULE ulmResources;
|
|||
PROCEDURE Unlink(dependant, resource: Resource);
|
||||
(* undo DependsOn operation *)
|
||||
VAR
|
||||
dependantDisc, resourceDisc: Discipline;
|
||||
prev, member: List;
|
||||
dependantDisc, resourceDisc: Discipline;
|
||||
prev, member: List;
|
||||
BEGIN
|
||||
GetDisc(resource, resourceDisc);
|
||||
IF resourceDisc.state = terminated THEN
|
||||
(* no necessity for clean up *)
|
||||
RETURN
|
||||
(* no necessity for clean up *)
|
||||
RETURN
|
||||
END;
|
||||
GetDisc(dependant, dependantDisc);
|
||||
|
||||
prev := NIL; member := resourceDisc.dependants;
|
||||
WHILE member.resource # dependant DO
|
||||
prev := member; member := member.next;
|
||||
prev := member; member := member.next;
|
||||
END;
|
||||
IF prev = NIL THEN
|
||||
resourceDisc.dependants := member.next;
|
||||
resourceDisc.dependants := member.next;
|
||||
ELSE
|
||||
prev.next := member.next;
|
||||
prev.next := member.next;
|
||||
END;
|
||||
|
||||
(* Detach reference from dependant to resource *)
|
||||
|
|
@ -176,28 +176,29 @@ MODULE ulmResources;
|
|||
|
||||
PROCEDURE InternalNotify(resource: Resource; change: StateChange);
|
||||
VAR
|
||||
disc: Discipline;
|
||||
event: Event;
|
||||
dependant: List;
|
||||
disc: Discipline;
|
||||
event: Event;
|
||||
dependant: List;
|
||||
BEGIN
|
||||
GetDisc(resource, disc);
|
||||
CASE change OF
|
||||
| communicationResumed: disc.stopped := FALSE;
|
||||
| communicationStopped: disc.stopped := TRUE;
|
||||
| terminated: disc.stopped := FALSE; disc.state := terminated;
|
||||
ELSE (* Explicitly ignore unhandled values of change *)
|
||||
END;
|
||||
GenEvent(resource, change);
|
||||
|
||||
(* notify all dependants *)
|
||||
dependant := disc.dependants;
|
||||
WHILE dependant # NIL DO
|
||||
InternalNotify(dependant.resource, change);
|
||||
dependant := dependant.next;
|
||||
InternalNotify(dependant.resource, change);
|
||||
dependant := dependant.next;
|
||||
END;
|
||||
|
||||
(* remove dependency relation in case of termination, if present *)
|
||||
IF (change = terminated) & (disc.dependsOn # NIL) THEN
|
||||
Unlink(resource, disc.dependsOn);
|
||||
Unlink(resource, disc.dependsOn);
|
||||
END;
|
||||
END InternalNotify;
|
||||
|
||||
|
|
@ -205,16 +206,16 @@ MODULE ulmResources;
|
|||
|
||||
PROCEDURE TakeInterest*(resource: Resource; VAR eventType: Events.EventType);
|
||||
(* return resource specific event type for state notifications;
|
||||
eventType is guaranteed to be # NIL even if
|
||||
the given resource is already terminated
|
||||
eventType is guaranteed to be # NIL even if
|
||||
the given resource is already terminated
|
||||
*)
|
||||
VAR
|
||||
disc: Discipline;
|
||||
disc: Discipline;
|
||||
BEGIN
|
||||
GetDisc(resource, disc);
|
||||
IF disc.eventType = NIL THEN
|
||||
Events.Define(disc.eventType);
|
||||
Events.Ignore(disc.eventType);
|
||||
Events.Define(disc.eventType);
|
||||
Events.Ignore(disc.eventType);
|
||||
END;
|
||||
eventType := disc.eventType;
|
||||
END TakeInterest;
|
||||
|
|
@ -222,93 +223,93 @@ MODULE ulmResources;
|
|||
PROCEDURE Attach*(resource: Resource; VAR key: Key);
|
||||
(* mark the resource as being used until Detach gets called *)
|
||||
VAR
|
||||
disc: Discipline;
|
||||
disc: Discipline;
|
||||
BEGIN
|
||||
GetDisc(resource, disc);
|
||||
IF disc.state IN {terminated, unreferenced} THEN
|
||||
key := NIL;
|
||||
key := NIL;
|
||||
ELSE
|
||||
INC(disc.refcnt); NEW(key); key.valid := TRUE;
|
||||
key.resource := resource;
|
||||
INC(disc.refcnt); NEW(key); key.valid := TRUE;
|
||||
key.resource := resource;
|
||||
END;
|
||||
END Attach;
|
||||
|
||||
PROCEDURE Detach*(resource: Resource; key: Key);
|
||||
(* mark the resource as unused; the returned key of Attach must
|
||||
be given -- this allows to check for proper balances
|
||||
of Attach/Detach calls;
|
||||
the last Detach operation causes a state change to unreferenced
|
||||
be given -- this allows to check for proper balances
|
||||
of Attach/Detach calls;
|
||||
the last Detach operation causes a state change to unreferenced
|
||||
*)
|
||||
VAR
|
||||
disc: Discipline;
|
||||
disc: Discipline;
|
||||
BEGIN
|
||||
IF (key # NIL) & key.valid & (key.resource = resource) THEN
|
||||
GetDisc(resource, disc);
|
||||
IF disc.state # terminated THEN
|
||||
key.valid := FALSE; DEC(disc.refcnt);
|
||||
IF disc.refcnt = 0 THEN
|
||||
GenEvent(resource, unreferenced);
|
||||
disc.state := unreferenced;
|
||||
IF disc.dependsOn # NIL THEN
|
||||
Unlink(resource, disc.dependsOn);
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
GetDisc(resource, disc);
|
||||
IF disc.state # terminated THEN
|
||||
key.valid := FALSE; DEC(disc.refcnt);
|
||||
IF disc.refcnt = 0 THEN
|
||||
GenEvent(resource, unreferenced);
|
||||
disc.state := unreferenced;
|
||||
IF disc.dependsOn # NIL THEN
|
||||
Unlink(resource, disc.dependsOn);
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
END Detach;
|
||||
|
||||
PROCEDURE Notify*(resource: Resource; change: StateChange);
|
||||
(* notify all interested parties about the new state;
|
||||
only valid state changes are accepted:
|
||||
- Notify doesn't accept any changes after termination
|
||||
- unreferenced is generated conditionally by Detach only
|
||||
- communicationResumed is valid after communicationStopped only
|
||||
valid notifications are propagated to all dependants (see below);
|
||||
only valid state changes are accepted:
|
||||
- Notify doesn't accept any changes after termination
|
||||
- unreferenced is generated conditionally by Detach only
|
||||
- communicationResumed is valid after communicationStopped only
|
||||
valid notifications are propagated to all dependants (see below);
|
||||
*)
|
||||
VAR
|
||||
disc: Discipline;
|
||||
event: Event;
|
||||
dependant: List;
|
||||
disc: Discipline;
|
||||
event: Event;
|
||||
dependant: List;
|
||||
BEGIN
|
||||
IF change # unreferenced THEN
|
||||
GetDisc(resource, disc);
|
||||
IF (disc.state # terminated) & (disc.state # change) &
|
||||
((change # communicationResumed) OR disc.stopped) THEN
|
||||
InternalNotify(resource, change);
|
||||
END;
|
||||
GetDisc(resource, disc);
|
||||
IF (disc.state # terminated) & (disc.state # change) &
|
||||
((change # communicationResumed) OR disc.stopped) THEN
|
||||
InternalNotify(resource, change);
|
||||
END;
|
||||
END;
|
||||
END Notify;
|
||||
|
||||
PROCEDURE DependsOn*(dependant, resource: Resource);
|
||||
(* states that `dependant' depends entirely on `resource' --
|
||||
this is usually the case if operations on `dependant'
|
||||
are delegated to `resource';
|
||||
only one call of DependsOn may be given per `dependant' while
|
||||
several DependsOn for one resource are valid;
|
||||
DependsOn calls implicitly Attach for resource and
|
||||
detaches if the dependant becomes unreferenced;
|
||||
all other state changes propagate from `resource' to
|
||||
`dependant'
|
||||
this is usually the case if operations on `dependant'
|
||||
are delegated to `resource';
|
||||
only one call of DependsOn may be given per `dependant' while
|
||||
several DependsOn for one resource are valid;
|
||||
DependsOn calls implicitly Attach for resource and
|
||||
detaches if the dependant becomes unreferenced;
|
||||
all other state changes propagate from `resource' to
|
||||
`dependant'
|
||||
*)
|
||||
VAR
|
||||
dependantDisc, resourceDisc: Discipline;
|
||||
member: List;
|
||||
dependantDisc, resourceDisc: Discipline;
|
||||
member: List;
|
||||
BEGIN
|
||||
GetDisc(resource, resourceDisc);
|
||||
IF resourceDisc.state <= unreferenced THEN
|
||||
(* do not create a relationship to dead or unreferenced objects
|
||||
but propagate a termination immediately to dependant
|
||||
*)
|
||||
IF resourceDisc.state = terminated THEN
|
||||
Notify(dependant, resourceDisc.state);
|
||||
END;
|
||||
RETURN
|
||||
(* do not create a relationship to dead or unreferenced objects
|
||||
but propagate a termination immediately to dependant
|
||||
*)
|
||||
IF resourceDisc.state = terminated THEN
|
||||
Notify(dependant, resourceDisc.state);
|
||||
END;
|
||||
RETURN
|
||||
END;
|
||||
|
||||
GetDisc(dependant, dependantDisc);
|
||||
IF dependantDisc.dependsOn # NIL THEN
|
||||
(* don't accept changes *)
|
||||
RETURN
|
||||
(* don't accept changes *)
|
||||
RETURN
|
||||
END;
|
||||
dependantDisc.dependsOn := resource;
|
||||
|
||||
|
|
@ -320,10 +321,10 @@ MODULE ulmResources;
|
|||
|
||||
PROCEDURE Alive*(resource: Resource) : BOOLEAN;
|
||||
(* returns TRUE if the resource is not yet terminated
|
||||
and ready for communication (i.e. not communicationStopped)
|
||||
and ready for communication (i.e. not communicationStopped)
|
||||
*)
|
||||
VAR
|
||||
disc: Discipline;
|
||||
disc: Discipline;
|
||||
BEGIN
|
||||
GetDisc(resource, disc);
|
||||
RETURN ~disc.stopped & (disc.state IN {alive, unreferenced})
|
||||
|
|
@ -331,10 +332,10 @@ MODULE ulmResources;
|
|||
|
||||
PROCEDURE Stopped*(resource: Resource) : BOOLEAN;
|
||||
(* returns TRUE if the object is currently not responsive
|
||||
and not yet terminated
|
||||
and not yet terminated
|
||||
*)
|
||||
VAR
|
||||
disc: Discipline;
|
||||
disc: Discipline;
|
||||
BEGIN
|
||||
GetDisc(resource, disc);
|
||||
RETURN disc.stopped
|
||||
|
|
@ -343,7 +344,7 @@ MODULE ulmResources;
|
|||
PROCEDURE Terminated*(resource: Resource) : BOOLEAN;
|
||||
(* returns TRUE if the resource is terminated *)
|
||||
VAR
|
||||
disc: Discipline;
|
||||
disc: Discipline;
|
||||
BEGIN
|
||||
GetDisc(resource, disc);
|
||||
RETURN disc.state = terminated
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
MODULE ulmSYSTEM;
|
||||
IMPORT SYSTEM, Unix, Sys := ulmSys;
|
||||
IMPORT SYSTEM, Platform, Sys := ulmSys;
|
||||
|
||||
TYPE pchar = POINTER TO ARRAY 1 OF CHAR;
|
||||
pstring = POINTER TO ARRAY 1024 OF CHAR;
|
||||
pstatus = POINTER TO Unix.Status;
|
||||
(* pstatus = POINTER TO Platform.Status; *)
|
||||
|
||||
TYPE bytearray* = ARRAY SIZE(LONGINT) OF SYSTEM.BYTE; (* need this because voc does not convert implicitly LONGINT to ARRAY OF BYTE; -- noch *)
|
||||
pbytearray* = POINTER TO bytearray;
|
||||
|
|
@ -52,16 +52,16 @@ TYPE pchar = POINTER TO ARRAY 1 OF CHAR;
|
|||
PROCEDURE UNIXCALL*(syscall: LONGINT; VAR d0, d1: LONGINT; (* in ulm version both LONGINT and INTEGER are 4 byte size *)
|
||||
arg1, arg2, arg3: LONGINT) : BOOLEAN;
|
||||
VAR
|
||||
n : LONGINT;
|
||||
ch : CHAR;
|
||||
pch : pchar;
|
||||
pstr : pstring;
|
||||
pst : pstatus;
|
||||
n: LONGINT;
|
||||
ch: CHAR;
|
||||
pch: pchar;
|
||||
pstr: pstring;
|
||||
h: Platform.FileHandle;
|
||||
(* pst : pstatus; *)
|
||||
BEGIN
|
||||
|
||||
IF syscall = Sys.read THEN
|
||||
d0 := Unix.Read(SHORT(arg1), arg2, arg3);
|
||||
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
|
||||
RETURN Platform.Read(arg1, arg2, arg3, n) = 0;
|
||||
(*NEW(pch);
|
||||
pch := SYSTEM.VAL(pchar, arg2);
|
||||
ch := pch^[0];
|
||||
|
|
@ -75,44 +75,48 @@ TYPE pchar = POINTER TO ARRAY 1 OF CHAR;
|
|||
END;
|
||||
*)
|
||||
ELSIF syscall = Sys.write THEN
|
||||
d0 := Unix.Write(SHORT(arg1), arg2, arg3);
|
||||
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
|
||||
RETURN Platform.Write(arg1, arg2, arg3) = 0;
|
||||
(*NEW(pch);
|
||||
pch := SYSTEM.VAL(pchar, arg2);
|
||||
n := Write(SYSTEM.VAL(LONGINT, pch), 1);
|
||||
IF n # 1 THEN RETURN FALSE ELSE RETURN TRUE END
|
||||
*)
|
||||
ELSIF syscall = Sys.open THEN
|
||||
pstr := SYSTEM.VAL(pstring, arg1);
|
||||
d0 := Unix.Open(pstr^, SHORT(arg3), arg2);
|
||||
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
|
||||
pstr := SYSTEM.VAL(pstring, arg1);
|
||||
IF SYSTEM.VAL(SET, arg3) * {0,1} # {} THEN
|
||||
RETURN Platform.OldRW(pstr^, d0) = 0
|
||||
ELSE
|
||||
RETURN Platform.OldRO(pstr^, d0) = 0
|
||||
END
|
||||
ELSIF syscall = Sys.close THEN
|
||||
d0 := Unix.Close(SHORT(arg1));
|
||||
IF d0 = 0 THEN RETURN TRUE ELSE RETURN FALSE END
|
||||
RETURN Platform.Close(arg1) = 0
|
||||
ELSIF syscall = Sys.lseek THEN
|
||||
d0 := Unix.Lseek(SHORT(arg1), arg2, SHORT(arg3));
|
||||
IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END
|
||||
RETURN Platform.Seek(arg1, arg2, SYSTEM.VAL(INTEGER, arg3)) = 0
|
||||
(*
|
||||
ELSIF syscall = Sys.ioctl THEN
|
||||
d0 := Unix.Ioctl(SHORT(arg1), SHORT(arg2), arg3);
|
||||
d0 := Platform.Ioctl(arg1, arg2, arg3);
|
||||
RETURN d0 >= 0;
|
||||
ELSIF syscall = Sys.fcntl THEN
|
||||
d0 := Unix.Fcntl (SHORT(arg1), SHORT(arg2), arg3);
|
||||
d0 := Platform.Fcntl (arg1, arg2, arg3);
|
||||
RETURN d0 >= 0;
|
||||
ELSIF syscall = Sys.dup THEN
|
||||
d0 := Unix.Dup(SHORT(arg1));
|
||||
d0 := Platform.Dup(arg1);
|
||||
RETURN d0 > 0;
|
||||
ELSIF syscall = Sys.pipe THEN
|
||||
d0 := Unix.Pipe(arg1);
|
||||
d0 := Platform.Pipe(arg1);
|
||||
RETURN d0 >= 0;
|
||||
ELSIF syscall = Sys.newstat THEN
|
||||
pst := SYSTEM.VAL(pstatus, arg2);
|
||||
pstr := SYSTEM.VAL(pstring, arg1);
|
||||
d0 := Unix.Stat(pstr^, pst^);
|
||||
d0 := Platform.Stat(pstr^, pst^);
|
||||
RETURN d0 >= 0
|
||||
ELSIF syscall = Sys.newfstat THEN
|
||||
pst := SYSTEM.VAL(pstatus, arg2);
|
||||
d0 := Unix.Fstat(SHORT(arg1), pst^);
|
||||
d0 := Platform.Fstat(arg1, pst^);
|
||||
RETURN d0 >= 0;
|
||||
*)
|
||||
ELSE
|
||||
HALT(99);
|
||||
END
|
||||
|
||||
END UNIXCALL;
|
||||
|
|
|
|||
|
|
@ -403,6 +403,7 @@ MODULE ulmScales;
|
|||
(* abs - abs or rel - rel *)
|
||||
restype := relative;
|
||||
END;
|
||||
ELSE
|
||||
END;
|
||||
ASSERT(ok); (* invalid operation *)
|
||||
END; END;
|
||||
|
|
|
|||
|
|
@ -115,6 +115,7 @@ MODULE ulmStreamConditions;
|
|||
| write: IF Streams.OutputWillBeBuffered(condition.stream) THEN
|
||||
RETURN TRUE
|
||||
END;
|
||||
ELSE
|
||||
END;
|
||||
msg.operation := condition.operation;
|
||||
msg.errors := errors;
|
||||
|
|
|
|||
|
|
@ -632,6 +632,7 @@ MODULE ulmStreams;
|
|||
| linebuf: nbuf := 1;
|
||||
| onebuf: nbuf := 1;
|
||||
| bufpool: nbuf := s.bufpool.maxbuf;
|
||||
ELSE (* Explicitly ignore unhandled values of s.bufmode *)
|
||||
END;
|
||||
END GetBufferPoolSize;
|
||||
|
||||
|
|
|
|||
|
|
@ -336,17 +336,17 @@ MODULE ulmSysConversions;
|
|||
|
||||
(* C type *)
|
||||
CASE type2 OF
|
||||
| "a": size2 := 8; INCL(flags, unsigned); (* char* *)
|
||||
| "c": size2 := 1; (* /* signed */ char *)
|
||||
| "C": size2 := 1; INCL(flags, unsigned); (* unsigned char *)
|
||||
| "s": size2 := 2; (* short int *)
|
||||
| "S": size2 := 2; INCL(flags, unsigned); (* unsigned short int *)
|
||||
| "i": size2 := 4; (* int *)
|
||||
| "I": size2 := 4; INCL(flags, unsigned); (* unsigned int *)
|
||||
| "u": size2 := 4; INCL(flags, unsigned); (* unsigned int *)
|
||||
| "l": size2 := 8; (* long int *)
|
||||
| "L": size2 := 8; INCL(flags, unsigned); (* long int *)
|
||||
| "-": size2 := 0;
|
||||
| "a": size2 := SIZE(Address); INCL(flags, unsigned); (* char* *)
|
||||
| "c": size2 := 1; (* /* signed */ char *)
|
||||
| "C": size2 := 1; INCL(flags, unsigned); (* unsigned char *)
|
||||
| "s": size2 := 2; (* short int *)
|
||||
| "S": size2 := 2; INCL(flags, unsigned); (* unsigned short int *)
|
||||
| "i": size2 := 4; (* int *)
|
||||
| "I": size2 := 4; INCL(flags, unsigned); (* unsigned int *)
|
||||
| "u": size2 := 4; INCL(flags, unsigned); (* unsigned int *)
|
||||
| "l": size2 := 8; (* long int *)
|
||||
| "L": size2 := 8; INCL(flags, unsigned); (* long int *)
|
||||
| "-": size2 := 0;
|
||||
ELSE Error(cv, "bad C type specifier"); RETURN FALSE
|
||||
END;
|
||||
IF size2 > 1 THEN
|
||||
|
|
|
|||
|
|
@ -59,14 +59,14 @@ MODULE ulmSysIO;
|
|||
closeonexec* = { 0 };
|
||||
|
||||
(* Fcntl requests *)
|
||||
dupfd* = 0; (* duplicate file descriptor *)
|
||||
getfd* = 1; (* get file desc flags (close-on-exec) *)
|
||||
setfd* = 2; (* set file desc flags (close-on-exec) *)
|
||||
getfl* = 3; (* get file flags *)
|
||||
setfl* = 4; (* set file flags (ndelay, append) *)
|
||||
getlk* = 5; (* get file lock *)
|
||||
setlk* = 6; (* set file lock *)
|
||||
setlkw* = 7; (* set file lock and wait *)
|
||||
dupfd* = 0; (* duplicate file descriptor *)
|
||||
getfd* = 1; (* get file desc flags (close-on-exec) *)
|
||||
setfd* = 2; (* set file desc flags (close-on-exec) *)
|
||||
getfl* = 3; (* get file flags *)
|
||||
setfl* = 4; (* set file flags (ndelay, append) *)
|
||||
getlk* = 5; (* get file lock *)
|
||||
setlk* = 6; (* set file lock *)
|
||||
setlkw* = 7; (* set file lock and wait *)
|
||||
setown* = 8; (* set owner (async IO) *)
|
||||
getown* = 9; (* get owner (async IO) *)
|
||||
setsig* = 10; (* set SIGIO replacement *)
|
||||
|
|
@ -80,263 +80,267 @@ MODULE ulmSysIO;
|
|||
Whence* = LONGINT;
|
||||
|
||||
PROCEDURE OpenCreat*(VAR fd: File;
|
||||
filename: ARRAY OF CHAR; options: SET;
|
||||
protection: Protection;
|
||||
errors: RelatedEvents.Object;
|
||||
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
|
||||
filename: ARRAY OF CHAR; options: SET;
|
||||
protection: Protection;
|
||||
errors: RelatedEvents.Object;
|
||||
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
|
||||
(* the filename must be 0X-terminated *)
|
||||
VAR
|
||||
d0, d1: (*INTEGER*)LONGINT;
|
||||
d0, d1: (*INTEGER*)LONGINT;
|
||||
BEGIN
|
||||
interrupted := FALSE;
|
||||
LOOP
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.open, d0, d1,
|
||||
SYS.ADR(filename), SYS.VAL(LONGINT, options), protection) THEN
|
||||
fd := d0;
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
IF d0 = SysErrors.intr THEN
|
||||
interrupted := TRUE;
|
||||
END;
|
||||
IF (d0 # SysErrors.intr) OR ~retry THEN
|
||||
SysErrors.Raise(errors, d0, Sys.open, filename);
|
||||
RETURN FALSE
|
||||
END;
|
||||
END;
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.open, d0, d1,
|
||||
SYS.ADR(filename), SYS.VAL(LONGINT, options), protection) THEN
|
||||
fd := d0;
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
IF d0 = SysErrors.intr THEN
|
||||
interrupted := TRUE;
|
||||
END;
|
||||
IF (d0 # SysErrors.intr) OR ~retry THEN
|
||||
SysErrors.Raise(errors, d0, Sys.open, filename);
|
||||
RETURN FALSE
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
END OpenCreat;
|
||||
|
||||
PROCEDURE Open*(VAR fd: File;
|
||||
filename: ARRAY OF CHAR; options: SET;
|
||||
errors: RelatedEvents.Object;
|
||||
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
|
||||
filename: ARRAY OF CHAR; options: SET;
|
||||
errors: RelatedEvents.Object;
|
||||
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
|
||||
(* the filename must be 0X-terminated *)
|
||||
BEGIN
|
||||
RETURN OpenCreat(fd, filename, options, 0, errors, retry, interrupted)
|
||||
END Open;
|
||||
|
||||
PROCEDURE Close*(fd: File;
|
||||
errors: RelatedEvents.Object;
|
||||
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
|
||||
errors: RelatedEvents.Object;
|
||||
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
|
||||
VAR
|
||||
d0, d1: LONGINT;
|
||||
a0, a1 : LONGINT; (* just to match UNIXCALL interface *)
|
||||
d0, d1: LONGINT;
|
||||
a0, a1 : LONGINT; (* just to match UNIXCALL interface *)
|
||||
BEGIN
|
||||
interrupted := FALSE;
|
||||
a0 := 0; a1 := 0; (* Initialised to disable compiler warning. *)
|
||||
LOOP
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.close, d0, d1, fd, a0, a1) THEN
|
||||
(*IF ulmSYSTEM.UNIXCALL(Sys.close, d0, d1, fd) THEN*)
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
IF d0 = SysErrors.intr THEN
|
||||
interrupted := TRUE;
|
||||
END;
|
||||
IF (d0 # SysErrors.intr) OR ~retry THEN
|
||||
SysErrors.Raise(errors, d0, Sys.close, "");
|
||||
RETURN FALSE
|
||||
END;
|
||||
END;
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.close, d0, d1, fd, a0, a1) THEN
|
||||
(*IF ulmSYSTEM.UNIXCALL(Sys.close, d0, d1, fd) THEN*)
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
IF d0 = SysErrors.intr THEN
|
||||
interrupted := TRUE;
|
||||
END;
|
||||
IF (d0 # SysErrors.intr) OR ~retry THEN
|
||||
SysErrors.Raise(errors, d0, Sys.close, "");
|
||||
RETURN FALSE
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
END Close;
|
||||
|
||||
PROCEDURE Read*(fd: File; buf: Address; cnt: Count;
|
||||
errors: RelatedEvents.Object;
|
||||
retry: BOOLEAN; VAR interrupted: BOOLEAN) : Count;
|
||||
errors: RelatedEvents.Object;
|
||||
retry: BOOLEAN; VAR interrupted: BOOLEAN) : Count;
|
||||
(* return value of 0: EOF
|
||||
-1: I/O error
|
||||
>0: number of bytes read
|
||||
-1: I/O error
|
||||
>0: number of bytes read
|
||||
*)
|
||||
VAR
|
||||
d0, d1: LONGINT;
|
||||
d0, d1: LONGINT;
|
||||
BEGIN
|
||||
interrupted := FALSE;
|
||||
LOOP
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.read, d0, d1, fd, buf, cnt) THEN
|
||||
RETURN d0
|
||||
ELSE
|
||||
IF d0 = SysErrors.intr THEN
|
||||
interrupted := TRUE;
|
||||
END;
|
||||
IF (d0 # SysErrors.intr) OR ~retry THEN
|
||||
SysErrors.Raise(errors, d0, Sys.read, "");
|
||||
RETURN -1
|
||||
END;
|
||||
END;
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.read, d0, d1, fd, buf, cnt) THEN
|
||||
RETURN d0
|
||||
ELSE
|
||||
IF d0 = SysErrors.intr THEN
|
||||
interrupted := TRUE;
|
||||
END;
|
||||
IF (d0 # SysErrors.intr) OR ~retry THEN
|
||||
SysErrors.Raise(errors, d0, Sys.read, "");
|
||||
RETURN -1
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
END Read;
|
||||
|
||||
PROCEDURE Write*(fd: File; buf: Address; cnt: Count;
|
||||
errors: RelatedEvents.Object;
|
||||
retry: BOOLEAN; VAR interrupted: BOOLEAN) : Count;
|
||||
errors: RelatedEvents.Object;
|
||||
retry: BOOLEAN; VAR interrupted: BOOLEAN) : Count;
|
||||
(* return value of -1: I/O error
|
||||
>=0: number of bytes written
|
||||
>=0: number of bytes written
|
||||
*)
|
||||
VAR
|
||||
d0, d1: LONGINT;
|
||||
d0, d1: LONGINT;
|
||||
BEGIN
|
||||
interrupted := FALSE;
|
||||
LOOP
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.write, d0, d1, fd, buf, cnt) THEN
|
||||
RETURN d0
|
||||
ELSE
|
||||
IF d0 = SysErrors.intr THEN
|
||||
interrupted := TRUE;
|
||||
END;
|
||||
IF (d0 # SysErrors.intr) OR ~retry THEN
|
||||
SysErrors.Raise(errors, d0, Sys.write, "");
|
||||
RETURN -1
|
||||
END;
|
||||
END;
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.write, d0, d1, fd, buf, cnt) THEN
|
||||
RETURN d0
|
||||
ELSE
|
||||
IF d0 = SysErrors.intr THEN
|
||||
interrupted := TRUE;
|
||||
END;
|
||||
IF (d0 # SysErrors.intr) OR ~retry THEN
|
||||
SysErrors.Raise(errors, d0, Sys.write, "");
|
||||
RETURN -1
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
END Write;
|
||||
|
||||
PROCEDURE Seek*(fd: File; offset: Count; whence: Whence;
|
||||
errors: RelatedEvents.Object) : BOOLEAN;
|
||||
errors: RelatedEvents.Object) : BOOLEAN;
|
||||
VAR
|
||||
d0, d1: LONGINT;
|
||||
d0, d1: LONGINT;
|
||||
BEGIN
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.lseek, d0, d1, fd, offset, whence) THEN
|
||||
RETURN TRUE
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
SysErrors.Raise(errors, d0, Sys.lseek, "");
|
||||
RETURN FALSE
|
||||
SysErrors.Raise(errors, d0, Sys.lseek, "");
|
||||
RETURN FALSE
|
||||
END;
|
||||
END Seek;
|
||||
|
||||
PROCEDURE Tell*(fd: File; VAR offset: Count;
|
||||
errors: RelatedEvents.Object) : BOOLEAN;
|
||||
errors: RelatedEvents.Object) : BOOLEAN;
|
||||
VAR
|
||||
d0, d1: LONGINT;
|
||||
d0, d1: LONGINT;
|
||||
BEGIN
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.lseek, d0, d1, fd, 0, fromPos) THEN
|
||||
offset := d0;
|
||||
RETURN TRUE
|
||||
offset := d0;
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
SysErrors.Raise(errors, d0, Sys.lseek, "");
|
||||
RETURN FALSE
|
||||
SysErrors.Raise(errors, d0, Sys.lseek, "");
|
||||
RETURN FALSE
|
||||
END;
|
||||
END Tell;
|
||||
|
||||
PROCEDURE Isatty*(fd: File) : BOOLEAN;
|
||||
CONST
|
||||
sizeofStructTermIO = 18;
|
||||
tcgeta = 00005405H;
|
||||
sizeofStructTermIO = 18;
|
||||
tcgeta = 00005405H;
|
||||
VAR
|
||||
d0, d1: LONGINT;
|
||||
buf: ARRAY 32 OF SYS.BYTE; (* Should be more than sufficient *)
|
||||
d0, d1: LONGINT;
|
||||
buf: ARRAY 32 OF SYS.BYTE; (* Should be more than sufficient *)
|
||||
BEGIN
|
||||
(* following system call fails for non-tty's *)
|
||||
RETURN ulmSYSTEM.UNIXCALL(Sys.ioctl, d0, d1, fd, tcgeta, SYS.ADR(buf))
|
||||
END Isatty;
|
||||
|
||||
PROCEDURE Fcntl*(fd: File; request: INTEGER; VAR arg: LONGINT;
|
||||
errors: RelatedEvents.Object;
|
||||
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
|
||||
errors: RelatedEvents.Object;
|
||||
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
|
||||
VAR
|
||||
d0, d1: LONGINT;
|
||||
d0, d1: LONGINT;
|
||||
BEGIN
|
||||
interrupted := FALSE;
|
||||
LOOP
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.fcntl, d0, d1, fd, request, arg) THEN
|
||||
arg := d0;
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
IF d0 = SysErrors.intr THEN
|
||||
interrupted := TRUE;
|
||||
END;
|
||||
IF (d0 # SysErrors.intr) OR ~retry THEN
|
||||
SysErrors.Raise(errors, d0, Sys.fcntl, "");
|
||||
RETURN FALSE
|
||||
END;
|
||||
END;
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.fcntl, d0, d1, fd, request, arg) THEN
|
||||
arg := d0;
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
IF d0 = SysErrors.intr THEN
|
||||
interrupted := TRUE;
|
||||
END;
|
||||
IF (d0 # SysErrors.intr) OR ~retry THEN
|
||||
SysErrors.Raise(errors, d0, Sys.fcntl, "");
|
||||
RETURN FALSE
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
END Fcntl;
|
||||
|
||||
PROCEDURE FcntlSet*(fd: File; request: INTEGER; flags: SET;
|
||||
errors: RelatedEvents.Object;
|
||||
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
|
||||
errors: RelatedEvents.Object;
|
||||
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
|
||||
VAR
|
||||
d0, d1: LONGINT;
|
||||
d0, d1: LONGINT;
|
||||
BEGIN
|
||||
interrupted := FALSE;
|
||||
LOOP
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.fcntl, d0, d1, fd, request, SYS.VAL(LONGINT, flags)) THEN
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
IF d0 = SysErrors.intr THEN
|
||||
interrupted := TRUE;
|
||||
END;
|
||||
IF (d0 # SysErrors.intr) OR ~retry THEN
|
||||
SysErrors.Raise(errors, d0, Sys.fcntl, "");
|
||||
RETURN FALSE
|
||||
END;
|
||||
END;
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.fcntl, d0, d1, fd, request, SYS.VAL(LONGINT, flags)) THEN
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
IF d0 = SysErrors.intr THEN
|
||||
interrupted := TRUE;
|
||||
END;
|
||||
IF (d0 # SysErrors.intr) OR ~retry THEN
|
||||
SysErrors.Raise(errors, d0, Sys.fcntl, "");
|
||||
RETURN FALSE
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
END FcntlSet;
|
||||
|
||||
PROCEDURE FcntlGet*(fd: File; request: INTEGER; VAR flags: SET;
|
||||
errors: RelatedEvents.Object) : BOOLEAN;
|
||||
errors: RelatedEvents.Object) : BOOLEAN;
|
||||
VAR
|
||||
d0, d1: LONGINT;
|
||||
d0, d1: LONGINT;
|
||||
BEGIN
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.fcntl, d0, d1, fd, request, 0) THEN
|
||||
ulmSYSTEM.WMOVE(SYS.ADR(d0), SYS.ADR(flags), 1);
|
||||
RETURN TRUE
|
||||
ulmSYSTEM.WMOVE(SYS.ADR(d0), SYS.ADR(flags), 1);
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
SysErrors.Raise(errors, d0, Sys.fcntl, "");
|
||||
RETURN FALSE
|
||||
SysErrors.Raise(errors, d0, Sys.fcntl, "");
|
||||
RETURN FALSE
|
||||
END;
|
||||
END FcntlGet;
|
||||
|
||||
PROCEDURE Dup*(fd: File; VAR newfd: File;
|
||||
errors: RelatedEvents.Object) : BOOLEAN;
|
||||
errors: RelatedEvents.Object) : BOOLEAN;
|
||||
VAR
|
||||
d0, d1: LONGINT;
|
||||
a0, a1: LONGINT;
|
||||
d0, d1: LONGINT;
|
||||
a0, a1: LONGINT;
|
||||
BEGIN
|
||||
a0 := 0; a1 := 0; (* Initialised to disable compiler warning. *)
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.dup, d0, d1, fd, a0, a1) THEN
|
||||
newfd := d0;
|
||||
RETURN TRUE
|
||||
newfd := d0;
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
SysErrors.Raise(errors, d0, Sys.dup, "");
|
||||
RETURN FALSE
|
||||
SysErrors.Raise(errors, d0, Sys.dup, "");
|
||||
RETURN FALSE
|
||||
END;
|
||||
END Dup;
|
||||
|
||||
PROCEDURE Dup2*(fd, newfd: File; errors: RelatedEvents.Object) : BOOLEAN;
|
||||
VAR
|
||||
d0, d1: LONGINT;
|
||||
a0, a1: LONGINT;
|
||||
fd2: File;
|
||||
interrupted: BOOLEAN;
|
||||
d0, d1: LONGINT;
|
||||
a0, a1: LONGINT;
|
||||
fd2: File;
|
||||
interrupted: BOOLEAN;
|
||||
BEGIN
|
||||
a0 := 0; a1 := 0; (* Initialised to disable compiler warning. *)
|
||||
fd2 := newfd;
|
||||
(* handmade close to avoid unnecessary events *)
|
||||
IF ~ulmSYSTEM.UNIXCALL(Sys.close, d0, d1, newfd, a0, a1) THEN END;
|
||||
IF Fcntl(fd, dupfd, fd2, errors, TRUE, interrupted) THEN
|
||||
IF fd2 = newfd THEN
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
RETURN Close(fd2, errors, TRUE, interrupted) & FALSE
|
||||
END;
|
||||
IF fd2 = newfd THEN
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
RETURN Close(fd2, errors, TRUE, interrupted) & FALSE
|
||||
END;
|
||||
ELSE
|
||||
RETURN FALSE
|
||||
RETURN FALSE
|
||||
END;
|
||||
END Dup2;
|
||||
|
||||
PROCEDURE Pipe*(VAR readfd, writefd: File;
|
||||
errors: RelatedEvents.Object) : BOOLEAN;
|
||||
errors: RelatedEvents.Object) : BOOLEAN;
|
||||
VAR
|
||||
d0, d1: LONGINT;
|
||||
a0, a1: LONGINT;
|
||||
fds : ARRAY 2 OF (*File*)INTEGER; (* it needs int pipefd[2], and int is 4 bytes long on x86_64 -- noch *)
|
||||
d0, d1: LONGINT;
|
||||
a0, a1: LONGINT;
|
||||
fds : ARRAY 2 OF (*File*)INTEGER; (* it needs int pipefd[2], and int is 4 bytes long on x86_64 -- noch *)
|
||||
BEGIN
|
||||
a0 := 0; a1 := 0; (* Initialised to disable compiler warning. *)
|
||||
IF ulmSYSTEM.UNIXCALL(Sys.pipe, d0, d1, SYS.ADR (fds), a0, a1) THEN
|
||||
readfd := fds[0]; writefd := fds[1];
|
||||
RETURN TRUE
|
||||
readfd := fds[0]; writefd := fds[1];
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
SysErrors.Raise(errors, d0, Sys.pipe, "");
|
||||
RETURN FALSE
|
||||
SysErrors.Raise(errors, d0, Sys.pipe, "");
|
||||
RETURN FALSE
|
||||
END;
|
||||
END Pipe;
|
||||
|
||||
|
|
|
|||
|
|
@ -45,42 +45,42 @@ MODULE ulmSysStat;
|
|||
CONST
|
||||
(* file mode:
|
||||
bit 0 = 1<<0 bit 31 = 1<<31
|
||||
|
||||
|
||||
user group other
|
||||
3 1 1111 11
|
||||
1 ... 6 5432 109 876 543 210
|
||||
+--------+------+-----+-----+-----+-----+
|
||||
| unused | type | sst | rwx | rwx | rwx |
|
||||
+--------+------+-----+-----+-----+-----+
|
||||
+--------+------+-----+-----+-----+-----+
|
||||
| unused | type | sst | rwx | rwx | rwx |
|
||||
+--------+------+-----+-----+-----+-----+
|
||||
*)
|
||||
|
||||
type* = {12..15};
|
||||
prot* = {0..8};
|
||||
|
||||
(* file types; example: (stat.mode * type = dir) *)
|
||||
reg* = {15}; (* regular *)
|
||||
dir* = {14}; (* directory *)
|
||||
chr* = {13}; (* character special *)
|
||||
fifo* = {12}; (* fifo *)
|
||||
blk* = {13..14}; (* block special *)
|
||||
symlink* = {13, 15}; (* symbolic link *)
|
||||
socket* = {14, 15}; (* socket *)
|
||||
reg* = {15}; (* regular *)
|
||||
dir* = {14}; (* directory *)
|
||||
chr* = {13}; (* character special *)
|
||||
fifo* = {12}; (* fifo *)
|
||||
blk* = {13..14}; (* block special *)
|
||||
symlink* = {13, 15}; (* symbolic link *)
|
||||
socket* = {14, 15}; (* socket *)
|
||||
|
||||
(* special *)
|
||||
setuid* = 11; (* set user id on execution *)
|
||||
setgid* = 10; (* set group id on execution *)
|
||||
savetext* = 9; (* save swapped text even after use *)
|
||||
setuid* = 11; (* set user id on execution *)
|
||||
setgid* = 10; (* set group id on execution *)
|
||||
savetext* = 9; (* save swapped text even after use *)
|
||||
|
||||
(* protection *)
|
||||
uread* = 8; (* read permission owner *)
|
||||
uwrite* = 7; (* write permission owner *)
|
||||
uexec* = 6; (* execute/search permission owner *)
|
||||
gread* = 5; (* read permission group *)
|
||||
gwrite* = 4; (* write permission group *)
|
||||
gexec* = 3; (* execute/search permission group *)
|
||||
oread* = 2; (* read permission other *)
|
||||
owrite* = 1; (* write permission other *)
|
||||
oexec* = 0; (* execute/search permission other *)
|
||||
uread* = 8; (* read permission owner *)
|
||||
uwrite* = 7; (* write permission owner *)
|
||||
uexec* = 6; (* execute/search permission owner *)
|
||||
gread* = 5; (* read permission group *)
|
||||
gwrite* = 4; (* write permission group *)
|
||||
gexec* = 3; (* execute/search permission group *)
|
||||
oread* = 2; (* read permission other *)
|
||||
owrite* = 1; (* write permission other *)
|
||||
oexec* = 0; (* execute/search permission other *)
|
||||
|
||||
(* example for "r-xr-x---": (read + exec) * (owner + group) *)
|
||||
owner* = {uread, uwrite, uexec};
|
||||
|
|
@ -92,136 +92,98 @@ MODULE ulmSysStat;
|
|||
rwx* = prot;
|
||||
|
||||
TYPE
|
||||
StatRec* = (* result of stat(2) and fstat(2) *)
|
||||
RECORD
|
||||
device*: SysTypes.Device; (* ID of device containing
|
||||
a directory entry for this file *)
|
||||
inode*: SysTypes.Inode; (* inode number *)
|
||||
nlinks*: LONGINT(*INTEGER*); (* number of links *)
|
||||
mode*: SET; (* file mode; see mknod(2) *)
|
||||
uid*: INTEGER; (* user id of the file's owner *)
|
||||
gid*: INTEGER; (* group id of the file's group *)
|
||||
rdev*: SysTypes.Device; (* ID of device
|
||||
this entry is defined only for
|
||||
character special or block
|
||||
special files
|
||||
*)
|
||||
size*: SysTypes.Offset; (* file size in bytes *)
|
||||
blksize*: LONGINT; (* preferred blocksize *)
|
||||
blocks*: LONGINT; (* # of blocks allocated *)
|
||||
atime*: SysTypes.Time; (* time of last access *)
|
||||
mtime*: SysTypes.Time; (* time of last data modification *)
|
||||
ctime*: SysTypes.Time; (* time of last file status change *)
|
||||
END;
|
||||
StatRec* = RECORD (* result of stat(2) and fstat(2) *)
|
||||
device*: SysTypes.Device; (* ID of device containing a directory entry
|
||||
for this file *)
|
||||
inode*: SysTypes.Inode; (* inode number *)
|
||||
mode*: SET; (* file mode; see mknod(2) *)
|
||||
nlinks*: LONGINT; (* number of links *)
|
||||
uid*: LONGINT; (* user id of the file's owner *)
|
||||
gid*: LONGINT; (* group id of the file's group *)
|
||||
rdev*: SysTypes.Device; (* ID of device. this entry is defined only for
|
||||
character special or block special files *)
|
||||
size*: SysTypes.Offset; (* file size in bytes *)
|
||||
|
||||
(* Blocks and blksize are not available on all platforms.
|
||||
blksize*: LONGINT; (* preferred blocksize *)
|
||||
blocks*: LONGINT; (* # of blocks allocated *)
|
||||
*)
|
||||
|
||||
atime*: SysTypes.Time; (* time of last access *)
|
||||
mtime*: SysTypes.Time; (* time of last data modification *)
|
||||
ctime*: SysTypes.Time; (* time of last file status change *)
|
||||
END;
|
||||
|
||||
(* StatRec* = (* result of stat(2) and fstat(2) *)
|
||||
RECORD
|
||||
device*: SysTypes.Device; (* ID of device containing
|
||||
a directory entry for this file *)
|
||||
inode*: SysTypes.Inode; (* inode number *)
|
||||
nlinks*: LONGINT; (* number of links *)
|
||||
mode*: INTEGER(*SET*); (* file mode; see mknod(2) *)
|
||||
uid*: INTEGER; (* user id of the file's owner *)
|
||||
gid*: INTEGER; (* group id of the file's group *)
|
||||
pad0: INTEGER;
|
||||
rdev*: SysTypes.Device; (* ID of device
|
||||
this entry is defined only for
|
||||
character special or block
|
||||
special files
|
||||
*)
|
||||
size*: SysTypes.Offset; (* file size in bytes *)
|
||||
blksize*: LONGINT; (* preferred blocksize *)
|
||||
blocks*: LONGINT; (* # of blocks allocated *)
|
||||
atime*: SysTypes.Time; (* time of last access *)
|
||||
atimences* : LONGINT;
|
||||
mtime*: SysTypes.Time; (* time of last data modification *)
|
||||
mtimensec* : LONGINT;
|
||||
ctime*: SysTypes.Time; (* time of last file status change *)
|
||||
ctimensec* : LONGINT;
|
||||
unused0*, unused1*, unused2*: LONGINT;
|
||||
END;
|
||||
*)
|
||||
(* Linux kernel struct stat (2.2.17)
|
||||
struct stat {
|
||||
unsigned short st_dev;
|
||||
unsigned short __pad1;
|
||||
unsigned long st_ino;
|
||||
unsigned short st_mode;
|
||||
unsigned short st_nlink;
|
||||
unsigned short st_uid;
|
||||
unsigned short st_gid;
|
||||
unsigned short st_rdev;
|
||||
unsigned short __pad2;
|
||||
unsigned long st_size;
|
||||
unsigned long st_blksize;
|
||||
unsigned long st_blocks;
|
||||
unsigned long st_atime;
|
||||
unsigned long __unused1;
|
||||
unsigned long st_mtime;
|
||||
unsigned long __unused2;
|
||||
unsigned long st_ctime;
|
||||
unsigned long __unused3;
|
||||
unsigned long __unused4;
|
||||
unsigned long __unused5;
|
||||
};
|
||||
*)
|
||||
|
||||
CONST
|
||||
statbufsize = 144(*64*); (* see <sys/stat.h> *) (* sizeof struct stat gives us 144 on x86_64 and 88 or x86; -- noch *)
|
||||
TYPE
|
||||
UnixStatRec = ARRAY statbufsize OF SYS.BYTE;
|
||||
CONST
|
||||
statbufconv =
|
||||
(*"is=dev/-s=pad1/ll=ino/Ss=mode/4*is=nlink+uid+gid+rdev/-s=pad2/ll=size/2*ll=blksize,blocks/il=atime/-l/il=mtime/-l/il=ctime/3*-l";*)
|
||||
"lL=dev/lL=ino/lL=nlink/Su=mode/2*iu=uid+gid/-i=pad0/lL=rdev/ll=size/2*ll=blksize,blocks/lL=atime/-l/lL=mtime/-l/lL=ctime/3*-l"; (* noch *)
|
||||
VAR
|
||||
statbuffmt: SysConversions.Format;
|
||||
PROCEDURE -Aincludesysstat '#include <sys/stat.h>';
|
||||
PROCEDURE -Aerrno '#include <errno.h>';
|
||||
|
||||
PROCEDURE Stat*(path: ARRAY OF CHAR; VAR buf: StatRec;
|
||||
errors: RelatedEvents.Object) : BOOLEAN;
|
||||
VAR
|
||||
d0, d1, d2: LONGINT;
|
||||
origbuf: UnixStatRec;
|
||||
PROCEDURE -structstats "struct stat s";
|
||||
PROCEDURE -statdev(): LONGINT "(LONGINT)s.st_dev";
|
||||
PROCEDURE -statino(): LONGINT "(LONGINT)s.st_ino";
|
||||
PROCEDURE -statmode(): LONGINT "(LONGINT)s.st_mode";
|
||||
PROCEDURE -statnlink(): LONGINT "(LONGINT)s.st_nlink";
|
||||
PROCEDURE -statuid(): LONGINT "(LONGINT)s.st_uid";
|
||||
PROCEDURE -statgid(): LONGINT "(LONGINT)s.st_gid";
|
||||
PROCEDURE -statrdev(): LONGINT "(LONGINT)s.st_rdev";
|
||||
PROCEDURE -statsize(): LONGINT "(LONGINT)s.st_size";
|
||||
PROCEDURE -statatime(): LONGINT "(LONGINT)s.st_atime";
|
||||
PROCEDURE -statmtime(): LONGINT "(LONGINT)s.st_mtime";
|
||||
PROCEDURE -statctime(): LONGINT "(LONGINT)s.st_ctime";
|
||||
|
||||
(* Blocks and blksize are not available on all platforms.
|
||||
PROCEDURE -statblksize(): LONGINT "(LONGINT)s.st_blksize";
|
||||
PROCEDURE -statblocks(): LONGINT "(LONGINT)s.st_blocks";
|
||||
*)
|
||||
|
||||
PROCEDURE -fstat(fd: LONGINT): INTEGER "fstat(fd, &s)";
|
||||
PROCEDURE -stat (n: ARRAY OF CHAR): INTEGER "stat((char*)n, &s)";
|
||||
|
||||
PROCEDURE -err(): INTEGER "errno";
|
||||
|
||||
PROCEDURE Stat*(path: ARRAY OF CHAR; VAR buf: StatRec; errors: RelatedEvents.Object): BOOLEAN;
|
||||
BEGIN
|
||||
IF uSYS.UNIXCALL(Sys.newstat, d0, d1, SYS.ADR(path), SYS.ADR(origbuf), d2) THEN
|
||||
SysConversions.ByFmtFromC(origbuf, buf, statbuffmt);
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
SysErrors.Raise(errors, d0, Sys.newstat, path);
|
||||
RETURN FALSE
|
||||
END;
|
||||
structstats;
|
||||
IF stat(path) < 0 THEN SysErrors.Raise(errors, err(), Sys.newstat, path); RETURN FALSE END;
|
||||
buf.device := SYS.VAL(SysTypes.Device, statdev());
|
||||
buf.inode := SYS.VAL(SysTypes.Inode, statino());
|
||||
buf.mode := SYS.VAL(SET, statmode());
|
||||
buf.nlinks := statnlink();
|
||||
buf.uid := statuid();
|
||||
buf.gid := statgid();
|
||||
buf.rdev := SYS.VAL(SysTypes.Device, statrdev());
|
||||
buf.size := SYS.VAL(SysTypes.Offset, statsize());
|
||||
(* Blocks and blksize are not available on all platforms.
|
||||
buf.blksize := statblksize();
|
||||
buf.blocks := statblocks();
|
||||
*)
|
||||
buf.atime := SYS.VAL(SysTypes.Time, statatime());
|
||||
buf.mtime := SYS.VAL(SysTypes.Time, statmtime());
|
||||
buf.ctime := SYS.VAL(SysTypes.Time, statctime());
|
||||
RETURN TRUE;
|
||||
END Stat;
|
||||
(* commented temporarily, it is used only in FTPUnixDirLister module *) (*
|
||||
PROCEDURE Lstat*(path: ARRAY OF CHAR; VAR buf: StatRec;
|
||||
errors: RelatedEvents.Object) : BOOLEAN;
|
||||
VAR
|
||||
d0, d1: INTEGER;
|
||||
origbuf: UnixStatRec;
|
||||
|
||||
PROCEDURE Fstat*(fd: SysTypes.File; VAR buf: StatRec; errors: RelatedEvents.Object): BOOLEAN;
|
||||
BEGIN
|
||||
IF SYS.UNIXCALL(Sys.newlstat, d0, d1, SYS.ADR(path), SYS.ADR(origbuf)) THEN
|
||||
SysConversions.ByFmtFromC(origbuf, buf, statbuffmt);
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
SysErrors.Raise(errors, d0, Sys.newlstat, path);
|
||||
RETURN FALSE
|
||||
END;
|
||||
END Lstat;
|
||||
*)
|
||||
PROCEDURE Fstat*(fd: SysTypes.File; VAR buf: StatRec;
|
||||
errors: RelatedEvents.Object) : BOOLEAN;
|
||||
VAR
|
||||
d0, d1, d2: LONGINT;
|
||||
origbuf: UnixStatRec;
|
||||
BEGIN
|
||||
IF uSYS.UNIXCALL(Sys.newfstat, d0, d1, fd, SYS.ADR(origbuf), d2) THEN
|
||||
SysConversions.ByFmtFromC(origbuf, buf, statbuffmt);
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
SysErrors.Raise(errors, d0, Sys.newfstat, "");
|
||||
RETURN FALSE
|
||||
END;
|
||||
structstats;
|
||||
IF fstat(SYS.VAL(LONGINT, fd)) < 0 THEN SysErrors.Raise(errors, err(), Sys.newfstat, ""); RETURN FALSE END;
|
||||
buf.device := SYS.VAL(SysTypes.Device, statdev());
|
||||
buf.inode := SYS.VAL(SysTypes.Inode, statino());
|
||||
buf.mode := SYS.VAL(SET, statmode());
|
||||
buf.nlinks := statnlink();
|
||||
buf.uid := statuid();
|
||||
buf.gid := statgid();
|
||||
buf.rdev := SYS.VAL(SysTypes.Device, statrdev());
|
||||
buf.size := SYS.VAL(SysTypes.Offset, statsize());
|
||||
(* Blocks and blksize are not available on all platforms.
|
||||
buf.blksize := statblksize();
|
||||
buf.blocks := statblocks();
|
||||
*)
|
||||
buf.atime := SYS.VAL(SysTypes.Time, statatime());
|
||||
buf.mtime := SYS.VAL(SysTypes.Time, statmtime());
|
||||
buf.ctime := SYS.VAL(SysTypes.Time, statctime());
|
||||
RETURN TRUE;
|
||||
END Fstat;
|
||||
|
||||
BEGIN
|
||||
SysConversions.Compile(statbuffmt, statbufconv);
|
||||
|
||||
END ulmSysStat.
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load diff
|
|
@ -229,6 +229,7 @@ MODULE ulmTexts;
|
|||
| Streams.fromStart: pos := count;
|
||||
| Streams.fromPos: pos := count + s.pos;
|
||||
| Streams.fromEnd: pos := count + s.len;
|
||||
ELSE
|
||||
END;
|
||||
IF (pos >= 0) & (pos <= s.len) THEN
|
||||
s.pos := pos;
|
||||
|
|
|
|||
|
|
@ -200,6 +200,7 @@ MODULE ulmTimes;
|
|||
| epochUnit: value := measure.timeval.epoch;
|
||||
| secondUnit: value := measure.timeval.second;
|
||||
| usecUnit: value := measure.timeval.usec;
|
||||
ELSE
|
||||
END;
|
||||
END; END;
|
||||
END InternalGetValue;
|
||||
|
|
@ -212,6 +213,7 @@ MODULE ulmTimes;
|
|||
| epochUnit: measure.timeval.epoch := value;
|
||||
| secondUnit: measure.timeval.second := value;
|
||||
| usecUnit: measure.timeval.usec := value;
|
||||
ELSE
|
||||
END;
|
||||
Normalize(measure.timeval);
|
||||
END; END;
|
||||
|
|
@ -274,6 +276,7 @@ MODULE ulmTimes;
|
|||
CASE op OF
|
||||
| Scales.add: Add(op1.timeval, op2.timeval, result.timeval);
|
||||
| Scales.sub: Sub(op1.timeval, op2.timeval, result.timeval);
|
||||
ELSE
|
||||
END;
|
||||
END;
|
||||
END; END;
|
||||
|
|
@ -283,25 +286,28 @@ MODULE ulmTimes;
|
|||
|
||||
PROCEDURE ReturnVal(val1, val2: Scales.Value) : INTEGER;
|
||||
BEGIN
|
||||
IF val1 < val2 THEN
|
||||
RETURN -1
|
||||
ELSIF val1 > val2 THEN
|
||||
RETURN 1
|
||||
ELSE
|
||||
RETURN 0
|
||||
END;
|
||||
IF val1 < val2 THEN
|
||||
RETURN -1
|
||||
ELSIF val1 > val2 THEN
|
||||
RETURN 1
|
||||
ELSE
|
||||
RETURN 0
|
||||
END;
|
||||
END ReturnVal;
|
||||
|
||||
BEGIN
|
||||
WITH op1: ReferenceTime DO WITH op2: ReferenceTime DO
|
||||
IF op1.timeval.epoch # op2.timeval.epoch THEN
|
||||
RETURN ReturnVal(op1.timeval.epoch, op2.timeval.epoch)
|
||||
ELSIF op1.timeval.second # op2.timeval.second THEN
|
||||
RETURN ReturnVal(op1.timeval.second, op2.timeval.second)
|
||||
ELSE
|
||||
RETURN ReturnVal(op1.timeval.usec, op2.timeval.usec)
|
||||
END;
|
||||
END; END;
|
||||
WITH op1: ReferenceTime DO
|
||||
WITH op2: ReferenceTime DO
|
||||
IF op1.timeval.epoch # op2.timeval.epoch THEN
|
||||
RETURN ReturnVal(op1.timeval.epoch, op2.timeval.epoch)
|
||||
ELSIF op1.timeval.second # op2.timeval.second THEN
|
||||
RETURN ReturnVal(op1.timeval.second, op2.timeval.second)
|
||||
ELSE
|
||||
RETURN ReturnVal(op1.timeval.usec, op2.timeval.usec)
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
RETURN 0;
|
||||
END Compare;
|
||||
|
||||
(* ========= initialization procedures ========================== *)
|
||||
|
|
|
|||
|
|
@ -50,34 +50,32 @@ MODULE ulmTypes;
|
|||
IMPORT SYS := SYSTEM;
|
||||
|
||||
TYPE
|
||||
Address* = (*SYS.PTR*) LONGINT (*SYS.ADDRESS*);
|
||||
Address* = LONGINT (*SYS.ADDRESS*);
|
||||
(* ulm compiler can accept
|
||||
VAR p : SYSTEM.ADDRESS; // SYSTEM.PTR in ETH and V4 versions
|
||||
...
|
||||
p := SYSTEM.ADR(something);
|
||||
and this is how it is used in ulm oberon system library,
|
||||
while SYSTEM.ADR returns LONGINT in ETH and V4 versions.
|
||||
Thus I leave it as LONGINT for now, before coming up with better solution -- noch *)
|
||||
UntracedAddress* = POINTER[1] TO UntracedAddressDesc; (*SYS.UNTRACEDADDRESS;*)
|
||||
...
|
||||
p := SYSTEM.ADR(something);
|
||||
and this is how it is used in ulm oberon system library,
|
||||
while SYSTEM.ADR returns LONGINT in ETH and V4 versions.
|
||||
Thus I leave it as LONGINT for now, before coming up with better solution -- noch *)
|
||||
|
||||
UntracedAddress* = POINTER[1] TO UntracedAddressDesc; (*SYS.UNTRACEDADDRESS;*)
|
||||
UntracedAddressDesc* = RECORD[1] END;
|
||||
|
||||
intarr64 = ARRAY 8 OF SYS.BYTE; (* to emulate int16 on x86_64; -- noch *)
|
||||
intarr16 = ARRAY 2 OF SYS.BYTE;
|
||||
|
||||
Count* = LONGINT;
|
||||
Size* = Count;
|
||||
Byte* = SYS.BYTE;
|
||||
|
||||
Count* = LONGINT;
|
||||
Size* = Count;
|
||||
Byte* = SYS.BYTE;
|
||||
IntAddress* = LONGINT;
|
||||
Int8* = SHORTINT;
|
||||
Int16* = intarr16(*INTEGER*); (* we don't have 16 bit integer in x86_64 version of voc *)
|
||||
Int32* = INTEGER;
|
||||
Real32* = REAL;
|
||||
Real64* = LONGREAL;
|
||||
Int8* = SHORTINT;
|
||||
Int16* = INTEGER; (* No real 16 bit integer type *)
|
||||
Int32* = INTEGER;
|
||||
Real32* = REAL;
|
||||
Real64* = LONGREAL;
|
||||
|
||||
CONST
|
||||
bigEndian* = 0; (* SPARC, M68K etc *)
|
||||
bigEndian* = 0; (* SPARC, M68K etc *)
|
||||
littleEndian* = 1; (* Intel 80x86, VAX etc *)
|
||||
byteorder* = littleEndian; (* machine-dependent constant *)
|
||||
byteorder* = littleEndian; (* machine-dependent constant *)
|
||||
TYPE
|
||||
ByteOrder* = SHORTINT; (* bigEndian or littleEndian *)
|
||||
|
||||
|
|
@ -93,21 +91,17 @@ MODULE ulmTypes;
|
|||
|
||||
PROCEDURE ToInt8*(int: LONGINT) : Int8;
|
||||
BEGIN
|
||||
RETURN SHORT(SHORT(int))
|
||||
RETURN SYS.VAL(SHORTINT, int)
|
||||
END ToInt8;
|
||||
|
||||
PROCEDURE ToInt16*(int: LONGINT; VAR int16: Int16)(* : Int16*);
|
||||
VAR longintarr : intarr64;
|
||||
PROCEDURE ToInt16*(int: LONGINT) : Int16;
|
||||
BEGIN
|
||||
(*RETURN SYS.VAL(Int16, int)*)
|
||||
longintarr := SYS.VAL(intarr64, int);
|
||||
int16[0] := longintarr[0];
|
||||
int16[1] := longintarr[1]; (* this will work for little endian -- noch *)
|
||||
RETURN SYS.VAL(Int16, int)
|
||||
END ToInt16;
|
||||
|
||||
PROCEDURE ToInt32*(int: LONGINT) : Int32;
|
||||
BEGIN
|
||||
RETURN SHORT(int)
|
||||
RETURN SYS.VAL(INTEGER, int)
|
||||
END ToInt32;
|
||||
|
||||
PROCEDURE ToReal32*(real: LONGREAL) : Real32;
|
||||
|
|
|
|||
|
|
@ -3,63 +3,29 @@ MODULE Args; (* jt, 8.12.94 *)
|
|||
(* command line argument handling for voc (jet backend) *)
|
||||
|
||||
|
||||
IMPORT SYSTEM;
|
||||
|
||||
IMPORT Platform;
|
||||
|
||||
TYPE
|
||||
ArgPtr = POINTER TO ARRAY 1024 OF CHAR;
|
||||
ArgVec = POINTER TO ARRAY 1024 OF ArgPtr;
|
||||
|
||||
VAR argc-: INTEGER; argv-: LONGINT;
|
||||
(*PROCEDURE -includestdlib() "#include <stdlib.h>";*)
|
||||
PROCEDURE -externgetenv() "extern char *getenv(const char *name);"; (* took this from stdlib.h*)
|
||||
PROCEDURE -Argc(): INTEGER "SYSTEM_argc";
|
||||
PROCEDURE -Argv(): LONGINT "(long)SYSTEM_argv";
|
||||
PROCEDURE -getenv(var: ARRAY OF CHAR): ArgPtr
|
||||
"(Args_ArgPtr)getenv(var)";
|
||||
VAR
|
||||
argc-: LONGINT;
|
||||
argv-: LONGINT;
|
||||
|
||||
PROCEDURE Get*(n: INTEGER; VAR val: ARRAY OF CHAR);
|
||||
VAR av: ArgVec;
|
||||
BEGIN
|
||||
IF n < argc THEN av := SYSTEM.VAL(ArgVec, argv); COPY(av[n]^, val) END
|
||||
END Get;
|
||||
|
||||
PROCEDURE GetInt*(n: INTEGER; VAR val: LONGINT);
|
||||
VAR s: ARRAY 64 OF CHAR; k, d, i: LONGINT;
|
||||
BEGIN
|
||||
s := ""; Get(n, s); i := 0;
|
||||
IF s[0] = "-" THEN i := 1 END ;
|
||||
k := 0; d := ORD(s[i]) - ORD("0");
|
||||
WHILE (d >= 0 ) & (d <= 9) DO k := k*10 + d; INC(i); d := ORD(s[i]) - ORD("0") END ;
|
||||
IF s[0] = "-" THEN d := -d; DEC(i) END ;
|
||||
IF i > 0 THEN val := k END
|
||||
END GetInt;
|
||||
PROCEDURE Get* (n: INTEGER; VAR val: ARRAY OF CHAR); BEGIN Platform.GetArg(n, val) END Get;
|
||||
PROCEDURE GetInt*(n: INTEGER; VAR val: LONGINT); BEGIN Platform.GetIntArg(n, val) END GetInt;
|
||||
PROCEDURE Pos* (s: ARRAY OF CHAR): INTEGER; BEGIN RETURN Platform.ArgPos(s) END Pos;
|
||||
|
||||
PROCEDURE Pos*(s: ARRAY OF CHAR): INTEGER;
|
||||
VAR i: INTEGER; arg: ARRAY 256 OF CHAR;
|
||||
BEGIN
|
||||
i := 0; Get(i, arg);
|
||||
WHILE (i < argc) & (s # arg) DO INC(i); Get(i, arg) END ;
|
||||
RETURN i
|
||||
END Pos;
|
||||
PROCEDURE GetEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR);
|
||||
BEGIN Platform.GetEnv(var, val) END GetEnv;
|
||||
|
||||
PROCEDURE GetEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR);
|
||||
VAR p: ArgPtr;
|
||||
BEGIN
|
||||
p := getenv(var);
|
||||
IF p # NIL THEN COPY(p^, val) END
|
||||
END GetEnv;
|
||||
PROCEDURE getEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR): BOOLEAN;
|
||||
BEGIN RETURN Platform.getEnv(var, val) END getEnv;
|
||||
|
||||
PROCEDURE getEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR): BOOLEAN;
|
||||
VAR p: ArgPtr;
|
||||
BEGIN
|
||||
p := getenv(var);
|
||||
IF p # NIL THEN
|
||||
COPY(p^, val);
|
||||
RETURN TRUE
|
||||
ELSE
|
||||
RETURN FALSE
|
||||
END
|
||||
END getEnv;
|
||||
|
||||
BEGIN argc := Argc(); argv := Argv()
|
||||
BEGIN
|
||||
argc := Platform.ArgCount;
|
||||
argv := Platform.ArgVector;
|
||||
END Args.
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@ MODULE Modules; (* jt 6.1.96 *)
|
|||
(* access to list of modules and commands, based on ETH Oberon *)
|
||||
|
||||
|
||||
IMPORT SYSTEM, Console;
|
||||
IMPORT SYSTEM, Console, Heap;
|
||||
|
||||
CONST
|
||||
ModNameLen* = 20;
|
||||
|
|
@ -37,10 +37,10 @@ MODULE Modules; (* jt 6.1.96 *)
|
|||
|
||||
|
||||
PROCEDURE -modules*(): Module
|
||||
"(Modules_Module)SYSTEM_modules";
|
||||
"(Modules_Module)Heap_modules";
|
||||
|
||||
PROCEDURE -setmodules*(m: Module)
|
||||
"SYSTEM_modules = m";
|
||||
"Heap_modules = m";
|
||||
|
||||
|
||||
PROCEDURE Append(VAR a: ARRAY OF CHAR; b: ARRAY OF CHAR);
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
MODULE Printer; (*UNIX version: JT 11.5.90, RC 2.7.93, JS 29.4.94, JT 14.4.95 *)
|
||||
|
||||
IMPORT SYSTEM, Files, Unix, Kernel;
|
||||
IMPORT SYSTEM, Files, Platform;
|
||||
|
||||
CONST
|
||||
N = 20;
|
||||
|
|
@ -608,9 +608,6 @@ END;
|
|||
REPEAT ch := s2[j]; s1[i] := ch; INC(i); INC(j) UNTIL ch = 0X
|
||||
END Append;
|
||||
|
||||
PROCEDURE -system(cmd: ARRAY OF CHAR)
|
||||
"system(cmd)";
|
||||
|
||||
PROCEDURE Close*;
|
||||
CONST bufSize = 4*1024;
|
||||
VAR
|
||||
|
|
@ -645,7 +642,7 @@ END;
|
|||
cmd := "lp -c -s ";
|
||||
IF PrinterName # "Pluto" THEN Append(cmd, "-d "); Append(cmd, PrinterName) END ;
|
||||
Append(cmd, " "); Append(cmd, printFileName);
|
||||
system(cmd);
|
||||
i := Platform.System(cmd);
|
||||
Files.Delete(printFileName, res);
|
||||
END;
|
||||
Files.Set(bodyR, NIL, 0);
|
||||
|
|
|
|||
|
|
@ -2,12 +2,9 @@ MODULE Reals;
|
|||
(* JT, 5.2.90 / RC 9.12.91 conversion between reals and strings for HP-700, MB 9.12.91, JT for Ofront, 16.3. 95*)
|
||||
|
||||
IMPORT S := SYSTEM;
|
||||
(* getting rid of ecvt -- noch
|
||||
PROCEDURE -ecvt (x: LONGREAL; ndigit, decpt, sign: LONGINT): LONGINT
|
||||
"(LONGINT)ecvt (x, ndigit, decpt, sign)";
|
||||
*)
|
||||
|
||||
PROCEDURE Ten*(e: INTEGER): REAL;
|
||||
VAR r, power: LONGREAL;
|
||||
VAR r, power: LONGREAL;
|
||||
BEGIN r := 1.0;
|
||||
power := 10.0;
|
||||
WHILE e > 0 DO
|
||||
|
|
@ -17,6 +14,7 @@ MODULE Reals;
|
|||
RETURN SHORT(r)
|
||||
END Ten;
|
||||
|
||||
|
||||
PROCEDURE TenL*(e: INTEGER): LONGREAL;
|
||||
VAR r, power: LONGREAL;
|
||||
BEGIN r := 1.0;
|
||||
|
|
@ -29,166 +27,90 @@ MODULE Reals;
|
|||
END
|
||||
END TenL;
|
||||
|
||||
|
||||
PROCEDURE Expo*(x: REAL): INTEGER;
|
||||
BEGIN
|
||||
RETURN SHORT(ASH(S.VAL(LONGINT, x), -23) MOD 256)
|
||||
RETURN SHORT(ASH(S.VAL(INTEGER, x), -23) MOD 256)
|
||||
END Expo;
|
||||
|
||||
|
||||
PROCEDURE ExpoL*(x: LONGREAL): INTEGER;
|
||||
VAR h: LONGINT;
|
||||
VAR i: INTEGER; l: LONGINT;
|
||||
BEGIN
|
||||
S.GET(S.ADR(x)+4, h);
|
||||
RETURN SHORT(ASH(h, -20) MOD 2048)
|
||||
IF SIZE(INTEGER) = 4 THEN
|
||||
S.GET(S.ADR(x)+4, i); (* Fetch top 32 bits *)
|
||||
RETURN SHORT(ASH(i, -20) MOD 2048)
|
||||
ELSIF SIZE(LONGINT) = 4 THEN
|
||||
S.GET(S.ADR(x)+4, l); (* Fetch top 32 bits *)
|
||||
RETURN SHORT(ASH(l, -20) MOD 2048)
|
||||
ELSE HALT(98)
|
||||
END
|
||||
END ExpoL;
|
||||
|
||||
PROCEDURE SetExpo*(e: INTEGER; VAR x: REAL);
|
||||
CONST expo = {1..8};
|
||||
BEGIN
|
||||
x := S.VAL(REAL, S.VAL(SET, x) - expo + S.VAL(SET, ASH(LONG(e), 23)))
|
||||
END SetExpo;
|
||||
|
||||
PROCEDURE SetExpoL*(e: INTEGER; VAR x: LONGREAL);
|
||||
CONST expo = {1..11};
|
||||
VAR h: SET;
|
||||
BEGIN
|
||||
S.GET(S.ADR(x)+4, h);
|
||||
h := h - expo + S.VAL(SET, ASH(LONG(e), 20));
|
||||
S.PUT(S.ADR(x)+4, h)
|
||||
END SetExpoL;
|
||||
|
||||
PROCEDURE Reverse0 (VAR str : ARRAY OF CHAR; start, end : INTEGER);
|
||||
(* Reverses order of characters in the interval [start..end]. *)
|
||||
VAR
|
||||
h : CHAR;
|
||||
BEGIN
|
||||
WHILE start < end DO
|
||||
h := str[start]; str[start] := str[end]; str[end] := h;
|
||||
INC(start); DEC(end)
|
||||
END
|
||||
END Reverse0;
|
||||
(* these functions ⇅ necessary to get rid of ecvt -- noch *)
|
||||
PROCEDURE IntToStr*(int: LONGINT; VAR str: ARRAY OF CHAR);
|
||||
(* Converts the value of `int' to string form and copies the possibly truncated
|
||||
result to `str'. *)
|
||||
VAR
|
||||
b : ARRAY 21 OF CHAR;
|
||||
s, e: INTEGER;
|
||||
maxLength : SHORTINT; (* maximum number of digits representing a LONGINT value *)
|
||||
BEGIN
|
||||
IF SIZE(LONGINT) = 4 THEN maxLength := 11 END;
|
||||
IF SIZE(LONGINT) = 8 THEN maxLength := 20 END;
|
||||
(* build representation in string 'b' *)
|
||||
IF int = MIN(LONGINT) THEN (* smallest LONGINT, -int is an overflow *)
|
||||
IF SIZE(LONGINT) = 4 THEN
|
||||
b := "-2147483648";
|
||||
e := 11
|
||||
ELSE (* SIZE(LONGINT) = 8 *)
|
||||
b := "-9223372036854775808";
|
||||
e := 20
|
||||
END
|
||||
ELSE
|
||||
IF int < 0 THEN (* negative sign *)
|
||||
b[0] := "-"; int := -int; s := 1
|
||||
ELSE (* no sign *)
|
||||
s := 0
|
||||
END;
|
||||
e := s; (* 's' holds starting position of string *)
|
||||
REPEAT
|
||||
b[e] := CHR(int MOD 10+ORD("0"));
|
||||
int := int DIV 10;
|
||||
INC(e)
|
||||
UNTIL int = 0;
|
||||
b[e] := 0X;
|
||||
Reverse0(b, s, e-1);
|
||||
END;
|
||||
COPY(b, str) (* truncate output if necessary *)
|
||||
END IntToStr;
|
||||
|
||||
PROCEDURE Convert*(x: REAL; n: INTEGER; VAR d: ARRAY OF CHAR);
|
||||
VAR i, k: LONGINT;
|
||||
BEGIN IF x < 0 THEN x := -x END;
|
||||
i := ENTIER(x); k := 0;
|
||||
(* Convert LONGREAL: Write positive integer value of x into array d.
|
||||
The value is stored backwards, i.e. least significant digit
|
||||
first. n digits are written, with trailing zeros fill.
|
||||
On entry x has been scaled to the number of digits required. *)
|
||||
PROCEDURE ConvertL*(x: LONGREAL; n: INTEGER; VAR d: ARRAY OF CHAR);
|
||||
VAR i, j, k: LONGINT;
|
||||
BEGIN
|
||||
IF x < 0 THEN x := -x END;
|
||||
k := 0;
|
||||
|
||||
IF (SIZE(LONGINT) < 8) & (n > 9) THEN
|
||||
(* There are more decimal digits than can be held in a single LONGINT *)
|
||||
i := ENTIER(x / 1000000000.0D0); (* The 10th and higher digits *)
|
||||
j := ENTIER(x - (i * 1000000000.0D0)); (* The low 9 digits *)
|
||||
(* First generate the low 9 digits. *)
|
||||
IF j < 0 THEN j := 0 END;
|
||||
WHILE k < 9 DO
|
||||
d[k] := CHR(j MOD 10 + 48); j := j DIV 10; INC(k)
|
||||
END;
|
||||
(* Fall through to generate the upper digits *)
|
||||
ELSE
|
||||
(* We can generate all the digits in one go. *)
|
||||
i := ENTIER(x);
|
||||
END;
|
||||
|
||||
WHILE k < n DO
|
||||
d[k] := CHR(i MOD 10 + 48); i := i DIV 10; INC(k)
|
||||
END
|
||||
END ConvertL;
|
||||
|
||||
|
||||
PROCEDURE Convert*(x: REAL; n: INTEGER; VAR d: ARRAY OF CHAR);
|
||||
BEGIN ConvertL(x, n, d)
|
||||
END Convert;
|
||||
(* experimental, -- noch
|
||||
PROCEDURE Convert0*(x: REAL; n: INTEGER; VAR d: ARRAY OF CHAR);
|
||||
VAR i, j, k: LONGINT;
|
||||
str : ARRAY 32 OF CHAR;
|
||||
BEGIN
|
||||
(* IF x = MIN(LONGREAL) THEN x := MAX(LONGREAL) END;*)
|
||||
IF x < 0 THEN x := -x END;
|
||||
i := ENTIER(x);
|
||||
IF i < 0 THEN i := -i END;
|
||||
IntToStr(i, str);
|
||||
IF n >= LEN(d) THEN n := SHORT(LEN(d)) - 1 END;
|
||||
d[n] := 0X;
|
||||
j := n - 1 ;
|
||||
IF j < 0 THEN j := 0 END;
|
||||
k := 0;
|
||||
REPEAT
|
||||
d[j] := str[k];
|
||||
DEC(j);
|
||||
INC(k);
|
||||
UNTIL (str[k] = 0X) OR (j < 0);
|
||||
|
||||
WHILE j >= 0 DO d[j] := "0"; DEC(j) END ;
|
||||
END Convert0;
|
||||
*)
|
||||
(* this seem to work -- noch *)
|
||||
PROCEDURE ConvertL*(x: LONGREAL; n: INTEGER; VAR d: ARRAY OF CHAR);
|
||||
VAR i, j, k: LONGINT;
|
||||
str : ARRAY 32 OF CHAR;
|
||||
PROCEDURE ToHex(i: INTEGER): CHAR;
|
||||
BEGIN
|
||||
(* IF x = MIN(LONGREAL) THEN x := MAX(LONGREAL) END;*)
|
||||
IF x < 0 THEN x := -x END;
|
||||
i := ENTIER(x);
|
||||
IF i < 0 THEN i := -i END;
|
||||
IntToStr(i, str);
|
||||
IF n >= LEN(d) THEN n := SHORT(LEN(d)) - 1 END;
|
||||
d[n] := 0X;
|
||||
j := n - 1 ;
|
||||
IF j < 0 THEN j := 0 END;
|
||||
k := 0;
|
||||
REPEAT
|
||||
d[j] := str[k];
|
||||
DEC(j);
|
||||
INC(k);
|
||||
UNTIL (str[k] = 0X) OR (j < 0);
|
||||
IF i < 10 THEN RETURN CHR(i+48)
|
||||
ELSE RETURN CHR(i+55) END
|
||||
END ToHex;
|
||||
|
||||
WHILE j >= 0 DO d[j] := "0"; DEC(j) END ;
|
||||
END ConvertL;
|
||||
(* getting rid of ecvt -- noch
|
||||
PROCEDURE ConvertL*(x: LONGREAL; n: INTEGER; VAR d: ARRAY OF CHAR);
|
||||
VAR decpt, sign: INTEGER; i: LONGINT; buf: LONGINT;
|
||||
BEGIN
|
||||
(*x := x - 0.5; already rounded in ecvt*)
|
||||
buf := ecvt(x, n+2, S.ADR(decpt), S.ADR(sign));
|
||||
i := 0;
|
||||
WHILE i < decpt DO S.GET(buf + i, d[n - i -1]); INC(i) END ; (* showdef was crashing here on oocLowLReal.sym because of ecvt *)
|
||||
i := n - i - 1;
|
||||
WHILE i >= 0 DO d[i] := "0"; DEC(i) END ;
|
||||
END ConvertL;
|
||||
*)
|
||||
PROCEDURE Unpack(VAR b, d: ARRAY OF S.BYTE);
|
||||
VAR i, k: SHORTINT; len: LONGINT;
|
||||
BEGIN i := 0; len := LEN(b);
|
||||
WHILE i < len DO
|
||||
k := SHORT(ORD(S.VAL(CHAR, b[i])) DIV 16);
|
||||
IF k > 9 THEN d[i*2] := k + 55 ELSE d[i*2] := k + 48 END ;
|
||||
k := SHORT(ORD(S.VAL(CHAR, b[i])) MOD 16);
|
||||
IF k > 9 THEN d[i*2+1] := k + 55 ELSE d[i*2+1] := k + 48 END ;
|
||||
INC(i)
|
||||
(* Convert Hex *)
|
||||
PROCEDURE ConvertH*(y: REAL; VAR d: ARRAY OF CHAR);
|
||||
TYPE pc4 = POINTER TO ARRAY 4 OF CHAR;
|
||||
VAR p: pc4; i: INTEGER;
|
||||
BEGIN
|
||||
p := S.VAL(pc4, S.ADR(y)); i := 0;
|
||||
WHILE i<4 DO
|
||||
d[i*2] := ToHex(ORD(p[i]) DIV 16);
|
||||
d[i*2+1] := ToHex(ORD(p[i]) MOD 16)
|
||||
END
|
||||
END Unpack;
|
||||
|
||||
PROCEDURE ConvertH* (y: REAL; VAR d: ARRAY OF CHAR);
|
||||
BEGIN Unpack(y, d)
|
||||
END ConvertH;
|
||||
|
||||
PROCEDURE ConvertHL* (x: LONGREAL; VAR d: ARRAY OF CHAR);
|
||||
BEGIN Unpack(x, d)
|
||||
(* Convert Hex Long *)
|
||||
PROCEDURE ConvertHL*(y: LONGREAL; VAR d: ARRAY OF CHAR);
|
||||
TYPE pc8 = POINTER TO ARRAY 8 OF CHAR;
|
||||
VAR p: pc8; i: INTEGER;
|
||||
BEGIN
|
||||
p := S.VAL(pc8, S.ADR(y)); i := 0;
|
||||
WHILE i<8 DO
|
||||
d[i*2] := ToHex(ORD(p[i]) DIV 16);
|
||||
d[i*2+1] := ToHex(ORD(p[i]) MOD 16)
|
||||
END
|
||||
END ConvertHL;
|
||||
|
||||
|
||||
END Reals.
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
MODULE Sets0;
|
||||
MODULE Sets;
|
||||
|
||||
IMPORT Out := Console;
|
||||
IMPORT Texts;
|
||||
|
||||
CONST (*size* = 32;*)
|
||||
size* = MAX(SET) + 1;
|
||||
|
|
@ -114,7 +114,7 @@ BEGIN
|
|||
i := 0; WHILE i < LEN(s1) DO s := s1[i] * s2[i]; s3[i] := s; INC(i) END
|
||||
END Intersect;
|
||||
|
||||
(*
|
||||
|
||||
PROCEDURE Print*(VAR f: Texts.Writer; s: ARRAY OF SET; w, indent: INTEGER);
|
||||
VAR col, i, max: INTEGER;
|
||||
BEGIN
|
||||
|
|
@ -133,27 +133,5 @@ BEGIN
|
|||
END ;
|
||||
Texts.Write(f, "}")
|
||||
END Print;
|
||||
*)
|
||||
|
||||
PROCEDURE Write*(s: ARRAY OF SET; w, indent: INTEGER);
|
||||
VAR col, i, max: INTEGER;
|
||||
BEGIN
|
||||
i := 0; col := indent; max := SHORT(LEN(s)) * size;
|
||||
Out.Char("{");
|
||||
WHILE i < max DO
|
||||
IF In(s, i) THEN
|
||||
IF col + 4 > w THEN
|
||||
Out.Ln;
|
||||
col := 0; WHILE col < indent DO Out.Char(" "); INC(col) END
|
||||
END ;
|
||||
Out.Int(i, 3); Out.Char(",");
|
||||
INC(col, 4)
|
||||
END ;
|
||||
INC(i)
|
||||
END ;
|
||||
Out.Char("}")
|
||||
END Write;
|
||||
|
||||
|
||||
|
||||
END Sets0.
|
||||
END Sets.
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
MODULE Texts0; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91**) (* << RC, MB, JT *)
|
||||
MODULE Texts; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91**) (* << RC, MB, JT *)
|
||||
IMPORT
|
||||
Files := Files0, Modules, Reals;
|
||||
Files, Modules, Reals;
|
||||
|
||||
(*--- insert field e: Elem into Texts.Scanner and change Texts.Scan to set it in case of class=6 *)
|
||||
(* this module is for bootstrapping voc, use Texts instead *)
|
||||
|
||||
|
||||
CONST
|
||||
Displaywhite = 15;
|
||||
|
|
@ -12,7 +12,7 @@ MODULE Texts0; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
|
|||
(**FileMsg.id**)
|
||||
load* = 0; store* = 1;
|
||||
(**Notifier op**)
|
||||
replace* = 0; insert* = 1; delete* = 2;
|
||||
replace* = 0; insert* = 1; delete* = 2; unmark* = 3;
|
||||
(**Scanner.class**)
|
||||
Inval* = 0; Name* = 1; String* = 2; Int* = 3; Real* = 4; LongReal* = 5; Char* = 6;
|
||||
|
||||
|
|
@ -20,7 +20,7 @@ MODULE Texts0; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
|
|||
|
||||
TYPE
|
||||
FontsFont = POINTER TO FontDesc;
|
||||
FontDesc = RECORD
|
||||
FontDesc = RECORD
|
||||
name: ARRAY 32 OF CHAR;
|
||||
END ;
|
||||
|
||||
|
|
@ -72,8 +72,10 @@ MODULE Texts0; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
|
|||
head: Run
|
||||
END;
|
||||
|
||||
Notifier* = PROCEDURE (T: Text; op: INTEGER; beg, end: LONGINT);
|
||||
TextDesc* = RECORD
|
||||
len*: LONGINT;
|
||||
notify*: Notifier;
|
||||
head, cache: Run;
|
||||
corg: LONGINT
|
||||
END;
|
||||
|
|
@ -112,7 +114,7 @@ MODULE Texts0; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
|
|||
org, span: LONGINT;
|
||||
mod, proc: ARRAY 32 OF CHAR
|
||||
END;
|
||||
|
||||
|
||||
VAR
|
||||
new*: Elem;
|
||||
del: Buffer;
|
||||
|
|
@ -200,7 +202,7 @@ MODULE Texts0; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
|
|||
PROCEDURE ElemBase* (E: Elem): Text;
|
||||
BEGIN RETURN E.base
|
||||
END ElemBase;
|
||||
|
||||
|
||||
PROCEDURE ElemPos* (E: Elem): LONGINT;
|
||||
VAR u: Run; pos: LONGINT;
|
||||
BEGIN u := E.base.head.next; pos := 0;
|
||||
|
|
@ -281,6 +283,7 @@ MODULE Texts0; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
|
|||
len := B.len; v := B.head.next;
|
||||
Merge(T, u, v); Splice(un, v, B.head.prev, T);
|
||||
INC(T.len, len); B.head.next := B.head; B.head.prev := B.head; B.len := 0;
|
||||
IF T.notify # NIL THEN T.notify(T, insert, pos, pos+len) END
|
||||
END Insert;
|
||||
|
||||
PROCEDURE Append* (T: Text; B: Buffer);
|
||||
|
|
@ -288,6 +291,7 @@ MODULE Texts0; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
|
|||
BEGIN pos := T.len; len := B.len; v := B.head.next;
|
||||
Merge(T, T.head.prev, v); Splice(T.head, v, B.head.prev, T);
|
||||
INC(T.len, len); B.head.next := B.head; B.head.prev := B.head; B.len := 0;
|
||||
IF T.notify # NIL THEN T.notify(T, insert, pos, pos+len) END
|
||||
END Append;
|
||||
|
||||
PROCEDURE Delete* (T: Text; beg, end: LONGINT);
|
||||
|
|
@ -299,6 +303,7 @@ MODULE Texts0; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
|
|||
Splice(del.head, un, v, NIL);
|
||||
Merge(T, u, vn); u.next := vn; vn.prev := u;
|
||||
DEC(T.len, end - beg);
|
||||
IF T.notify # NIL THEN T.notify(T, delete, beg, end) END
|
||||
END Delete;
|
||||
|
||||
PROCEDURE ChangeLooks* (T: Text; beg, end: LONGINT; sel: SET; fnt: FontsFont; col, voff: SHORTINT);
|
||||
|
|
@ -313,6 +318,7 @@ MODULE Texts0; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
|
|||
IF u.next = un THEN u := un; un := un.next ELSE u.next := un; un.prev := u END
|
||||
END;
|
||||
Merge(T, u, un); u.next := un; un.prev := u;
|
||||
IF T.notify # NIL THEN T.notify(T, replace, beg, end) END
|
||||
END ChangeLooks;
|
||||
|
||||
|
||||
|
|
@ -327,23 +333,7 @@ MODULE Texts0; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
|
|||
Files.Set(R.rider, u(Piece).file, u(Piece).org + R.off)
|
||||
END
|
||||
END OpenReader;
|
||||
(*
|
||||
PROCEDURE Read* (VAR R: Reader; VAR ch: CHAR);
|
||||
VAR u: Run;
|
||||
BEGIN u := R.run; R.fnt := u.fnt; R.col := u.col; R.voff := u.voff; INC(R.off);
|
||||
IF u IS Piece THEN Files.Read(R.rider, ch); R.elem := NIL;
|
||||
IF (ch = 0AX) & u(Piece).ascii THEN ch := CR END (* << LF to CR *)
|
||||
ELSIF u IS Elem THEN ch := ElemChar; R.elem := u(Elem)
|
||||
ELSE ch := 0X; R.elem := NIL; R.eot := TRUE
|
||||
END;
|
||||
IF R.off = u.len THEN INC(R.org, u.len); u := u.next;
|
||||
IF u IS Piece THEN
|
||||
WITH u: Piece DO Files.Set(R.rider, u.file, u.org) END
|
||||
END;
|
||||
R.run := u; R.off := 0
|
||||
END
|
||||
END Read;
|
||||
*)
|
||||
|
||||
PROCEDURE Read* (VAR R: Reader; VAR ch: CHAR);
|
||||
VAR u: Run; pos: LONGINT; nextch: CHAR;
|
||||
BEGIN u := R.run; R.fnt := u.fnt; R.col := u.col; R.voff := u.voff; INC(R.off);
|
||||
|
|
@ -351,8 +341,8 @@ MODULE Texts0; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
|
|||
IF (ch = 0AX) & u(Piece).ascii THEN ch := CR (* << LF to CR *)
|
||||
ELSIF (ch = CR) & u(Piece).ascii THEN (* << CR LF to CR *)
|
||||
pos := Files.Pos(R.rider); Files.Read(R.rider, nextch);
|
||||
IF nextch = 0AX THEN INC(R.off) ELSE Files.Set(R.rider, u(Piece).file, pos) END
|
||||
END
|
||||
IF nextch = 0AX THEN INC(R.off) ELSE Files.Set(R.rider, u(Piece).file, pos) END
|
||||
END
|
||||
ELSIF u IS Elem THEN ch := ElemChar; R.elem := u(Elem)
|
||||
ELSE ch := 0X; R.elem := NIL; R.eot := TRUE
|
||||
END;
|
||||
|
|
@ -364,7 +354,6 @@ MODULE Texts0; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
|
|||
END
|
||||
END Read;
|
||||
|
||||
|
||||
PROCEDURE ReadElem* (VAR R: Reader);
|
||||
VAR u, un: Run;
|
||||
BEGIN u := R.run;
|
||||
|
|
@ -462,7 +451,7 @@ MODULE Texts0; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
|
|||
k := ORD(d[j]) - 30H; INC(j);
|
||||
IF (i-j = 7) & (k >= 8) THEN DEC(k, 16) END ;
|
||||
WHILE j < i DO k := k*10H + (ORD(d[j]) - 30H); INC(j) END ;
|
||||
IF neg THEN S.i := -k ELSE S.i := k END
|
||||
IF neg THEN S.i := -k ELSE S.i := k END
|
||||
ELSIF ch = "." THEN (*read real*)
|
||||
Read(S, ch); h := i;
|
||||
WHILE ("0" <= ch) & (ch <= "9") DO d[i] := ch; INC(i); Read(S, ch) END ;
|
||||
|
|
@ -474,7 +463,7 @@ MODULE Texts0; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
|
|||
IF negE THEN
|
||||
IF e <= 308 THEN y := y / Reals.TenL(e) ELSE y := 0 END
|
||||
ELSIF e > 0 THEN
|
||||
IF e <= 308 THEN y := Reals.TenL(e) * y ELSE HALT(40) END
|
||||
IF e <= 308 THEN y := Reals.TenL(e) * y ELSE HALT(40) END
|
||||
END ;
|
||||
IF neg THEN y := -y END ;
|
||||
S.class := 5; S.y := y
|
||||
|
|
@ -557,11 +546,18 @@ MODULE Texts0; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
|
|||
END WriteString;
|
||||
|
||||
PROCEDURE WriteInt* (VAR W: Writer; x, n: LONGINT);
|
||||
VAR i: INTEGER; x0: LONGINT;
|
||||
a: ARRAY 11 OF CHAR;
|
||||
VAR
|
||||
i: INTEGER; x0: LONGINT;
|
||||
a: ARRAY 22 OF CHAR;
|
||||
BEGIN i := 0;
|
||||
IF x < 0 THEN
|
||||
IF x = MIN(LONGINT) THEN WriteString(W, " -2147483648"); RETURN
|
||||
IF x = MIN(LONGINT) THEN
|
||||
IF SIZE(LONGINT) = 4 THEN
|
||||
WriteString(W, " -2147483648")
|
||||
ELSE
|
||||
WriteString(W, " -9223372036854775808")
|
||||
END;
|
||||
RETURN
|
||||
ELSE DEC(n); x0 := -x
|
||||
END
|
||||
ELSE x0 := x
|
||||
|
|
@ -576,7 +572,7 @@ MODULE Texts0; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
|
|||
|
||||
PROCEDURE WriteHex* (VAR W: Writer; x: LONGINT);
|
||||
VAR i: INTEGER; y: LONGINT;
|
||||
a: ARRAY 10 OF CHAR;
|
||||
a: ARRAY 20 OF CHAR;
|
||||
BEGIN i := 0; Write(W, " ");
|
||||
REPEAT y := x MOD 10H;
|
||||
IF y < 10 THEN a[i] := CHR(y + 30H) ELSE a[i] := CHR(y + 37H) END;
|
||||
|
|
@ -680,14 +676,22 @@ MODULE Texts0; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
|
|||
REPEAT Write(W, " "); DEC(n) UNTIL n <= maxD;
|
||||
(*there are 2 <= n <= maxD digits to be written*)
|
||||
IF x < 0 THEN Write(W, "-"); x := -x ELSE Write(W, " ") END;
|
||||
|
||||
(* Scale e to be an exponent of 10 rather than 2 *)
|
||||
e := SHORT(LONG(e - 1023) * 77 DIV 256);
|
||||
IF e >= 0 THEN x := x / Reals.TenL(e) ELSE x := Reals.TenL(-e) * x END ;
|
||||
IF x >= 10.0D0 THEN x := 0.1D0 * x; INC(e) END ;
|
||||
IF x >= 10.0D0 THEN x := 0.1D0 * x; INC(e) END;
|
||||
|
||||
(* Scale x to the number of digits requested *)
|
||||
x0 := Reals.TenL(n-1); x := x0*x + 0.5D0;
|
||||
IF x >= 10.0D0*x0 THEN x := 0.1D0 * x; INC(e) END ;
|
||||
|
||||
(* Generate the mantissa digits of x *)
|
||||
Reals.ConvertL(x, n, d);
|
||||
|
||||
DEC(n); Write(W, d[n]); Write(W, ".");
|
||||
REPEAT DEC(n); Write(W, d[n]) UNTIL n = 0;
|
||||
|
||||
Write(W, "D");
|
||||
IF e < 0 THEN Write(W, "-"); e := -e ELSE Write(W, "+") END;
|
||||
Write(W, CHR(e DIV 100 + 30H)); e := e MOD 100;
|
||||
|
|
@ -767,7 +771,7 @@ MODULE Texts0; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
|
|||
u.next := T.head; T.head.prev := u; T.cache := T.head; T.corg := 0;
|
||||
Files.ReadLInt(msg.r, T.len); Files.Set(r, f, Files.Pos(msg.r) + T.len)
|
||||
END Load0;
|
||||
|
||||
|
||||
PROCEDURE Load* (VAR r: Files.Rider; T: Text);
|
||||
CONST oldTag = -4095;
|
||||
VAR tag: INTEGER;
|
||||
|
|
@ -865,8 +869,9 @@ MODULE Texts0; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
|
|||
u := u.next
|
||||
END;
|
||||
r := msg.r;
|
||||
IF T.notify # NIL THEN T.notify(T, unmark, 0, 0) END
|
||||
END Store;
|
||||
|
||||
|
||||
PROCEDURE Close* (T: Text; name: ARRAY OF CHAR);
|
||||
VAR f: Files.File; r: Files.Rider; i, res: INTEGER; bak: ARRAY 64 OF CHAR;
|
||||
BEGIN
|
||||
|
|
@ -877,4 +882,4 @@ MODULE Texts0; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91*
|
|||
END Close;
|
||||
|
||||
BEGIN del := NIL; NEW(FontsDefault); FontsDefault.name := "Syntax10.Scn.Fnt"
|
||||
END Texts0.
|
||||
END Texts.
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue