vishapoberon/compiler
1
0
Fork 0
mirror of https://github.com/vishapoberon/compiler.git synced 2026-04-05 23:22:25 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

ulmSys, ulmSysConversions

Browse source
This commit is contained in:
Norayr Chilingarian 2013-10-23 18:33:07 +04:00
parent ea1429795c
commit 60f0426d17
5 changed files with 900 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

7
makefile
View file

@ -154,8 +154,13 @@ stage6:
$(VOCSTATIC) -sP ulmIndirectDisciplines.Mod ulmStreamDisciplines.Mod
$(VOCSTATIC) -sP ulmIEEE.Mod ulmMC68881.Mod ulmReals.Mod
$(VOCSTATIC) -sP ulmPrint.Mod
$(VOCSTATIC) -sP ulmTexts.Mod ulmStrings.Mod ulmConstStrings.Mod
$(VOCSTATIC) -sP ulmTexts.Mod
$(VOCSTATIC) -sP ulmStrings.Mod ulmConstStrings.Mod
$(VOCSTATIC) -sP ulmConstStrings.Mod
$(VOCSTATIC) -sP ulmPlotters.Mod
$(VOCSTATIC) -sP ulmSysTypes.Mod
$(VOCSTATIC) -sP ulmSys.Mod
$(VOCSTATIC) -sP ulmSysConversions.Mod
stage7:
#objects := $(wildcard *.o)

316
src/lib/ulm/ulmSys.Mod Normal file
View file

@ -0,0 +1,316 @@
(* DO NOT EDIT! Generated by Sys.pl. *)
MODULE ulmSys;
CONST
(* nisyscall = 0; *) statfs* = 99;
exit* = 1; fstatfs* = 100;
fork* = 2; ioperm* = 101;
read* = 3; socketcall* = 102;
write* = 4; syslog* = 103;
open* = 5; setitimer* = 104;
close* = 6; getitimer* = 105;
waitpid* = 7; newstat* = 106;
creat* = 8; newlstat* = 107;
link* = 9; newfstat* = 108;
unlink* = 10; uname* = 109;
execve* = 11; iopl* = 110;
chdir* = 12; vhangup* = 111;
time* = 13; idle* = 112;
mknod* = 14; vm86old* = 113;
chmod* = 15; wait4* = 114;
lchown* = 16; swapoff* = 115;
(* nisyscall = 17; *) sysinfo* = 116;
stat* = 18; ipc* = 117;
lseek* = 19; fsync* = 118;
getpid* = 20; sigreturn* = 119;
mount* = 21; clone* = 120;
oldumount* = 22; setdomainname* = 121;
setuid* = 23; newuname* = 122;
getuid* = 24; modifyldt* = 123;
stime* = 25; adjtimex* = 124;
ptrace* = 26; mprotect* = 125;
alarm* = 27; sigprocmask* = 126;
fstat* = 28; createmodule* = 127;
pause* = 29; initmodule* = 128;
utime* = 30; deletemodule* = 129;
(* nisyscall = 31; *) getkernelsyms* = 130;
(* nisyscall = 32; *) quotactl* = 131;
access* = 33; getpgid* = 132;
nice* = 34; fchdir* = 133;
(* nisyscall = 35; *) bdflush* = 134;
sync* = 36; sysfs* = 135;
kill* = 37; personality* = 136;
rename* = 38; (* nisyscall = 137; *)
mkdir* = 39; setfsuid* = 138;
rmdir* = 40; setfsgid* = 139;
dup* = 41; llseek* = 140;
pipe* = 42; getdents* = 141;
times* = 43; select* = 142;
(* nisyscall = 44; *) flock* = 143;
brk* = 45; msync* = 144;
setgid* = 46; readv* = 145;
getgid* = 47; writev* = 146;
signal* = 48; getsid* = 147;
geteuid* = 49; fdatasync* = 148;
getegid* = 50; sysctl* = 149;
acct* = 51; mlock* = 150;
umount* = 52; munlock* = 151;
(* nisyscall = 53; *) mlockall* = 152;
ioctl* = 54; munlockall* = 153;
fcntl* = 55; schedsetparam* = 154;
(* nisyscall = 56; *) schedgetparam* = 155;
setpgid* = 57; schedsetscheduler* = 156;
(* nisyscall = 58; *) schedgetscheduler* = 157;
olduname* = 59; schedyield* = 158;
umask* = 60; schedgetprioritymax* = 159;
chroot* = 61; schedgetprioritymin* = 160;
ustat* = 62; schedrrgetinterval* = 161;
dup2* = 63; nanosleep* = 162;
getppid* = 64; mremap* = 163;
getpgrp* = 65; setresuid* = 164;
setsid* = 66; getresuid* = 165;
sigaction* = 67; vm86* = 166;
sgetmask* = 68; querymodule* = 167;
ssetmask* = 69; poll* = 168;
setreuid* = 70; nfsservctl* = 169;
setregid* = 71; setresgid* = 170;
sigsuspend* = 72; getresgid* = 171;
sigpending* = 73; prctl* = 172;
sethostname* = 74; rtsigreturn* = 173;
setrlimit* = 75; rtsigaction* = 174;
getrlimit* = 76; rtsigprocmask* = 175;
getrusage* = 77; rtsigpending* = 176;
gettimeofday* = 78; rtsigtimedwait* = 177;
settimeofday* = 79; rtsigqueueinfo* = 178;
getgroups* = 80; rtsigsuspend* = 179;
setgroups* = 81; pread* = 180;
oldselect* = 82; pwrite* = 181;
symlink* = 83; chown* = 182;
lstat* = 84; getcwd* = 183;
readlink* = 85; capget* = 184;
uselib* = 86; capset* = 185;
swapon* = 87; sigaltstack* = 186;
reboot* = 88; sendfile* = 187;
oldreaddir* = 89; (* nisyscall = 188; *)
oldmmap* = 90; (* nisyscall = 189; *)
munmap* = 91; vfork* = 190;
truncate* = 92; (* nisyscall = 191; *)
ftruncate* = 93; mmap2* = 192;
fchmod* = 94; truncate64* = 193;
fchown* = 95; ftruncate64* = 194;
getpriority* = 96; stat64* = 195;
setpriority* = 97; lstat64* = 196;
(* nisyscall = 98; *) fstat64* = 197;
ncalls* = 198;
namelen* = 20;
TYPE
Name* = ARRAY namelen OF CHAR;
VAR
name*: ARRAY ncalls OF Name;
BEGIN
name[0] := "NOSYS";
name[1] := "exit";
name[2] := "fork";
name[3] := "read";
name[4] := "write";
name[5] := "open";
name[6] := "close";
name[7] := "waitpid";
name[8] := "creat";
name[9] := "link";
name[10] := "unlink";
name[11] := "execve";
name[12] := "chdir";
name[13] := "time";
name[14] := "mknod";
name[15] := "chmod";
name[16] := "lchown";
name[17] := "NOSYS";
name[18] := "stat";
name[19] := "lseek";
name[20] := "getpid";
name[21] := "mount";
name[22] := "oldumount";
name[23] := "setuid";
name[24] := "getuid";
name[25] := "stime";
name[26] := "ptrace";
name[27] := "alarm";
name[28] := "fstat";
name[29] := "pause";
name[30] := "utime";
name[31] := "NOSYS";
name[32] := "NOSYS";
name[33] := "access";
name[34] := "nice";
name[35] := "NOSYS";
name[36] := "sync";
name[37] := "kill";
name[38] := "rename";
name[39] := "mkdir";
name[40] := "rmdir";
name[41] := "dup";
name[42] := "pipe";
name[43] := "times";
name[44] := "NOSYS";
name[45] := "brk";
name[46] := "setgid";
name[47] := "getgid";
name[48] := "signal";
name[49] := "geteuid";
name[50] := "getegid";
name[51] := "acct";
name[52] := "umount";
name[53] := "NOSYS";
name[54] := "ioctl";
name[55] := "fcntl";
name[56] := "NOSYS";
name[57] := "setpgid";
name[58] := "NOSYS";
name[59] := "olduname";
name[60] := "umask";
name[61] := "chroot";
name[62] := "ustat";
name[63] := "dup2";
name[64] := "getppid";
name[65] := "getpgrp";
name[66] := "setsid";
name[67] := "sigaction";
name[68] := "sgetmask";
name[69] := "ssetmask";
name[70] := "setreuid";
name[71] := "setregid";
name[72] := "sigsuspend";
name[73] := "sigpending";
name[74] := "sethostname";
name[75] := "setrlimit";
name[76] := "getrlimit";
name[77] := "getrusage";
name[78] := "gettimeofday";
name[79] := "settimeofday";
name[80] := "getgroups";
name[81] := "setgroups";
name[82] := "oldselect";
name[83] := "symlink";
name[84] := "lstat";
name[85] := "readlink";
name[86] := "uselib";
name[87] := "swapon";
name[88] := "reboot";
name[89] := "oldreaddir";
name[90] := "oldmmap";
name[91] := "munmap";
name[92] := "truncate";
name[93] := "ftruncate";
name[94] := "fchmod";
name[95] := "fchown";
name[96] := "getpriority";
name[97] := "setpriority";
name[98] := "NOSYS";
name[99] := "statfs";
name[100] := "fstatfs";
name[101] := "ioperm";
name[102] := "socketcall";
name[103] := "syslog";
name[104] := "setitimer";
name[105] := "getitimer";
name[106] := "newstat";
name[107] := "newlstat";
name[108] := "newfstat";
name[109] := "uname";
name[110] := "iopl";
name[111] := "vhangup";
name[112] := "idle";
name[113] := "vm86old";
name[114] := "wait4";
name[115] := "swapoff";
name[116] := "sysinfo";
name[117] := "ipc";
name[118] := "fsync";
name[119] := "sigreturn";
name[120] := "clone";
name[121] := "setdomainname";
name[122] := "newuname";
name[123] := "modifyldt";
name[124] := "adjtimex";
name[125] := "mprotect";
name[126] := "sigprocmask";
name[127] := "createmodule";
name[128] := "initmodule";
name[129] := "deletemodule";
name[130] := "getkernelsyms";
name[131] := "quotactl";
name[132] := "getpgid";
name[133] := "fchdir";
name[134] := "bdflush";
name[135] := "sysfs";
name[136] := "personality";
name[137] := "NOSYS";
name[138] := "setfsuid";
name[139] := "setfsgid";
name[140] := "llseek";
name[141] := "getdents";
name[142] := "select";
name[143] := "flock";
name[144] := "msync";
name[145] := "readv";
name[146] := "writev";
name[147] := "getsid";
name[148] := "fdatasync";
name[149] := "sysctl";
name[150] := "mlock";
name[151] := "munlock";
name[152] := "mlockall";
name[153] := "munlockall";
name[154] := "schedsetparam";
name[155] := "schedgetparam";
name[156] := "schedsetscheduler";
name[157] := "schedgetscheduler";
name[158] := "schedyield";
name[159] := "schedgetprioritymax";
name[160] := "schedgetprioritymin";
name[161] := "schedrrgetinterval";
name[162] := "nanosleep";
name[163] := "mremap";
name[164] := "setresuid";
name[165] := "getresuid";
name[166] := "vm86";
name[167] := "querymodule";
name[168] := "poll";
name[169] := "nfsservctl";
name[170] := "setresgid";
name[171] := "getresgid";
name[172] := "prctl";
name[173] := "rtsigreturn";
name[174] := "rtsigaction";
name[175] := "rtsigprocmask";
name[176] := "rtsigpending";
name[177] := "rtsigtimedwait";
name[178] := "rtsigqueueinfo";
name[179] := "rtsigsuspend";
name[180] := "pread";
name[181] := "pwrite";
name[182] := "chown";
name[183] := "getcwd";
name[184] := "capget";
name[185] := "capset";
name[186] := "sigaltstack";
name[187] := "sendfile";
name[188] := "NOSYS";
name[189] := "NOSYS";
name[190] := "vfork";
name[191] := "NOSYS";
name[192] := "mmap2";
name[193] := "truncate64";
name[194] := "ftruncate64";
name[195] := "stat64";
name[196] := "lstat64";
name[197] := "fstat64";
END ulmSys.

574
src/lib/ulm/ulmSysConversions.Mod Normal file
View file

@ -0,0 +1,574 @@
(* Ulm's Oberon Library
Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
----------------------------------------------------------------------------
Ulm's Oberon Library is free software; you can redistribute it
and/or modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either version
2 of the License, or (at your option) any later version.
Ulm's Oberon Library is distributed in the hope that it will be
useful, but WITHOUT ANY WARRANTY; without even the implied warranty
of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
----------------------------------------------------------------------------
E-mail contact: oberon@mathematik.uni-ulm.de
----------------------------------------------------------------------------
$Id: SysConversi.om,v 1.2 1997/07/30 09:38:16 borchert Exp $
----------------------------------------------------------------------------
$Log: SysConversi.om,v $
Revision 1.2 1997/07/30 09:38:16 borchert
bug in ReadConv fixed: cv.flags was used but not set for
counts > 1
Revision 1.1 1994/02/23 07:58:28 borchert
Initial revision
----------------------------------------------------------------------------
AFB 8/90
adapted to linux cae 02/01
----------------------------------------------------------------------------
*)
MODULE ulmSysConversions;
(* convert Oberon records to/from C structures *)
IMPORT Events := ulmEvents, Objects := ulmObjects, Priorities := ulmPriorities, Streams := ulmStreams, Strings := ulmStrings,
SYS := SYSTEM, SysTypes := ulmSysTypes, Texts := ulmTexts;
TYPE
Address* = SysTypes.Address;
Size* = Address;
(* format:
Format = Conversion { "/" Conversion } .
Conversion = [ Factors ] ConvChars [ Comment ] .
Factors = Array | Factor | Array Factor | Factor Array .
Array = Integer ":" .
Factor = Integer "*" .
ConvChars = OberonType CType | Skip CType | OberonType Skip .
OberonType = "a" | "b" | "c" | "s" | "i" | "l" | "S" .
CType = "a" | "c" | "s" | "i" | "l" .
Integer = Digit { Digit } .
Digit = "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9" .
Skip = "-" .
Comment = "=" { AnyChar } .
AnyChar = (* all characters except "/" *) .
Oberon data types:
a: Address
b: BYTE
B: BOOLEAN
c: CHAR
s: SHORTINT
i: INTEGER
l: LONGINT
S: SET
C data types:
a: char *
c: /* signed */ char
C: unsigned char
s: short int
S: unsigned short int
i: int
I: unsigned int
u: unsigned int
l: long int
L: unsigned long int
example:
conversion from
Rec =
RECORD
a, b: INTEGER;
c: CHAR;
s: SET;
f: ARRAY 3 OF INTEGER;
END;
to
struct rec {
short a, b;
char c;
int xx; /* to be skipped on conversion */
int s;
int f[3];
};
or vice versa:
"2*is=a,b/cc=c/-i=xx/Si=s/3:ii=f"
The comments allow to give the field names.
*)
CONST
(* conversion flags *)
unsigned = 0; (* suppress sign extension *)
boolean = 1; (* convert anything # 0 to 1 *)
TYPE
Flags = SET;
Event* = POINTER TO EventRec;
EventRec* =
RECORD
(Events.EventRec)
format*: Events.Message;
END;
ConvStream = POINTER TO ConvStreamRec;
ConvStreamRec =
RECORD
fmt: Texts.Text;
char: CHAR;
eof: BOOLEAN;
(* 1: Oberon type
2: C type
*)
type1, type2: CHAR; length: INTEGER; left: INTEGER;
offset1, offset2: Address;
size1, size2: Address; elementsleft: INTEGER; flags: Flags;
END;
Format = POINTER TO FormatRec;
FormatRec* =
RECORD
(Objects.ObjectRec)
offset1, offset2: Address;
size1, size2: Address;
flags: Flags;
next: Format;
END;
VAR
badformat*: Events.EventType;
PROCEDURE Error(cv: ConvStream; msg: ARRAY OF CHAR);
VAR
event: Event;
BEGIN
NEW(event);
event.type := badformat;
event.message := "SysConversions: ";
Strings.Concatenate(event.message, msg);
Strings.Read(event.format, cv.fmt);
Events.Raise(event);
cv.eof := TRUE;
cv.char := 0X;
cv.left := 0;
cv.elementsleft := 0;
END Error;
PROCEDURE SizeError(msg, format: ARRAY OF CHAR);
VAR
event: Event;
BEGIN
NEW(event);
event.type := badformat;
event.message := "SysConversions: ";
Strings.Concatenate(event.message, msg);
COPY(format, event.format);
Events.Raise(event);
END SizeError;
PROCEDURE NextCh(cv: ConvStream);
BEGIN
cv.eof := cv.eof OR ~Streams.ReadByte(cv.fmt, cv.char) OR (cv.char = 0X);
IF cv.eof THEN
cv.char := 0X;
END;
END NextCh;
PROCEDURE IsDigit(ch: CHAR) : BOOLEAN;
BEGIN
RETURN (ch >= "0") & (ch <= "9")
END IsDigit;
PROCEDURE ReadInt(cv: ConvStream; VAR i: INTEGER);
BEGIN
i := 0;
REPEAT
i := 10 * i + ORD(cv.char) - ORD("0");
NextCh(cv);
UNTIL ~IsDigit(cv.char);
END ReadInt;
PROCEDURE Open(VAR cv: ConvStream; format: ARRAY OF CHAR);
BEGIN
NEW(cv);
Texts.Open(SYS.VAL(Streams.Stream, cv.fmt));
Strings.Write(cv.fmt, format);
cv.left := 0; cv.elementsleft := 0;
cv.offset1 := 0; cv.offset2 := 0;
cv.eof := FALSE;
NextCh(cv);
END Open;
PROCEDURE Close(VAR cv: ConvStream);
BEGIN
IF ~Streams.Close(cv.fmt) THEN END;
END Close;
PROCEDURE ScanConv(cv: ConvStream;
VAR type1, type2: CHAR;
VAR length: INTEGER) : BOOLEAN;
VAR
i: INTEGER;
factor: INTEGER;
BEGIN
IF cv.left > 0 THEN
type1 := cv.type1;
type2 := cv.type2;
length := cv.length;
DEC(cv.left);
RETURN TRUE
END;
IF cv.char = "/" THEN
NextCh(cv);
END;
IF cv.eof THEN
RETURN FALSE
END;
factor := 0; length := 0;
WHILE IsDigit(cv.char) DO
ReadInt(cv, i);
IF i <= 0 THEN
Error(cv, "integer must be positive"); RETURN FALSE
END;
IF cv.char = ":" THEN
IF length # 0 THEN
Error(cv, "multiple length specification"); RETURN FALSE
END;
length := i;
NextCh(cv);
ELSIF cv.char = "*" THEN
IF factor # 0 THEN
Error(cv, "multiple factor specification"); RETURN FALSE
END;
factor := i; cv.left := factor - 1;
NextCh(cv);
ELSE
Error(cv, "factor or length expected"); RETURN FALSE
END;
END;
type1 := cv.char; NextCh(cv);
type2 := cv.char; NextCh(cv);
IF cv.left > 0 THEN
cv.type1 := type1; cv.type2 := type2; cv.length := length;
END;
IF cv.char = "=" THEN (* comment *)
REPEAT
NextCh(cv);
UNTIL cv.eof OR (cv.char = "/");
END;
RETURN TRUE
END ScanConv;
PROCEDURE Align(VAR offset: Address; boundary: Address);
BEGIN
IF SYS.VAL (INTEGER, offset) MOD SYS.VAL (INTEGER, boundary) # 0 THEN
offset := SYS.VAL (INTEGER, offset) + (SYS.VAL (INTEGER, boundary) - SYS.VAL (INTEGER, offset) MOD SYS.VAL (INTEGER, boundary));
END;
END Align;
PROCEDURE ReadConv(cv: ConvStream;
VAR offset1, offset2: Address;
VAR size1, size2: Address;
VAR flags: Flags) : BOOLEAN;
VAR
type1, type2: CHAR;
length: INTEGER;
align: BOOLEAN;
boundary: INTEGER;
BEGIN
IF cv.elementsleft > 0 THEN
DEC(cv.elementsleft);
(* Oberon type *)
IF size1 > SIZE(SYS.BYTE) THEN
Align(cv.offset1, SIZE(INTEGER));
END;
offset1 := cv.offset1; cv.offset1 := SYS.VAL (INTEGER, cv.offset1) + size1;
size1 := cv.size1; size2 := cv.size2; flags := cv.flags;
IF (size1 > 0) & (cv.elementsleft = 0) THEN
Align(cv.offset1, SIZE(INTEGER));
END;
(* C type *)
IF size2 > 1 THEN
Align(cv.offset2, 2);
END;
offset2 := cv.offset2; cv.offset2 := SYS.VAL (INTEGER, cv.offset2) + SYS.VAL (INTEGER, size2);
RETURN TRUE
END;
IF ScanConv(cv, type1, type2, length) THEN
flags := {};
(* Oberon type *)
CASE type1 OF
| "a": size1 := SIZE(Address); INCL(flags, unsigned);
| "b": size1 := SIZE(SYS.BYTE); INCL(flags, unsigned);
| "B": size1 := SIZE(BOOLEAN); INCL(flags, boolean);
| "c": size1 := SIZE(CHAR); INCL(flags, unsigned);
| "s": size1 := SIZE(SHORTINT);
| "i": size1 := SIZE(INTEGER);
| "l": size1 := SIZE(LONGINT);
| "S": size1 := SIZE(SET); INCL(flags, unsigned);
| "-": size1 := 0;
ELSE Error(cv, "bad Oberon type specifier"); RETURN FALSE
END;
IF size1 > 0 THEN
IF length > 0 THEN
Align(cv.offset1, SIZE(INTEGER));
ELSIF size1 > SIZE(SYS.BYTE) THEN
Align(cv.offset1, SIZE(INTEGER));
END;
END;
offset1 := cv.offset1; cv.offset1 := SYS.VAL (INTEGER, cv.offset1) + size1;
(* C type *)
CASE type2 OF
| "a": size2 := 4; 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 := 4; (* long int *)
| "L": size2 := 4; INCL(flags, unsigned); (* long int *)
| "-": size2 := 0;
ELSE Error(cv, "bad C type specifier"); RETURN FALSE
END;
IF size2 > 1 THEN
Align(cv.offset2, size2);
END;
offset2 := cv.offset2; cv.offset2 := SYS.VAL (INTEGER, cv.offset2) + SYS.VAL (INTEGER, size2);
cv.size1 := size1; cv.size2 := size2;
IF length > 0 THEN
cv.elementsleft := length - 1;
cv.flags := flags;
END;
RETURN TRUE
ELSE
RETURN FALSE
END;
END ReadConv;
PROCEDURE Convert(from, to: Address; ssize, dsize: Address; flags: Flags);
TYPE
Bytes = ARRAY 8 OF CHAR;
Pointer = POINTER TO Bytes;
VAR
dest, source: Pointer;
dindex, sindex: INTEGER;
nonzero: BOOLEAN;
fill : CHAR;
BEGIN
IF ssize > 0 THEN
dest := SYS.VAL(Pointer, to);
source := SYS.VAL(Pointer, from);
dindex := 0; sindex := 0;
IF boolean IN flags THEN
nonzero := FALSE;
WHILE ssize > 0 DO
nonzero := nonzero OR (source[sindex] # 0X);
INC(sindex); ssize := SYS.VAL (INTEGER, ssize) - 1;
END;
IF dsize > 0 THEN
IF nonzero THEN
dest[dindex] := 1X;
ELSE
dest[dindex] := 0X;
END;
dsize := dsize - 1; INC (dindex);
END;
WHILE dsize > 0 DO
dest[dindex] := 0X;
dsize := SYS.VAL (INTEGER, dsize) - 1; INC(dindex);
END;
ELSE
WHILE (dsize > 0) & (ssize > 0) DO
dest[dindex] := source[sindex];
ssize := SYS.VAL (INTEGER, ssize) - 1;
dsize := dsize - 1;
INC(dindex); INC(sindex);
END;
IF dsize > 0 THEN
(* sindex has been incremented at least once because
* ssize and dsize were greater than 0, i.e. sindex-1
* is a valid inex. *)
fill := 0X;
IF ~(unsigned IN flags) & (source[sindex-1] >= 080X) THEN
fill := 0FFX;
END;
END;
WHILE dsize > 0 DO
dest[dindex] := fill;
dsize := SYS.VAL (INTEGER, dsize) - 1; INC(dindex);
END;
END;
END;
END Convert;
PROCEDURE ByAddrToC*(from, to: Address; format: ARRAY OF CHAR);
VAR
cv: ConvStream;
offset1, offset2, size1, size2: Address;
flags: Flags;
BEGIN
Open(cv, format);
WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO
Convert(from + offset1, to + offset2, size1, size2, flags);
END;
Close(cv);
END ByAddrToC;
PROCEDURE ByAddrFromC*(from, to: Address; format: ARRAY OF CHAR);
VAR
cv: ConvStream;
offset1, offset2, size1, size2: Address;
flags: Flags;
BEGIN
Open(cv, format);
WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO
Convert(from + offset2, to + offset1, size2, size1, flags);
END;
Close(cv);
END ByAddrFromC;
PROCEDURE CSize*(format: ARRAY OF CHAR) : Size;
(* returns the size of the C-structure described by `format' *)
VAR
cv: ConvStream;
offset1, offset2, size1, size2: Address;
size: Address;
flags: Flags;
BEGIN
Open(cv, format);
WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO END;
Close(cv);
size := offset2 + size2;
Align(size, 2);
RETURN size
END CSize;
PROCEDURE OberonSize*(format: ARRAY OF CHAR) : Size;
(* returns the size of the Oberon-structure described by `format' *)
VAR
cv: ConvStream;
offset1, offset2, size1, size2: Address;
size: Address;
flags: Flags;
BEGIN
Open(cv, format);
WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO END;
Close(cv);
size := offset1 + size1;
Align(size, SIZE(INTEGER));
RETURN size
END OberonSize;
PROCEDURE ToC*(VAR from, to: ARRAY OF SYS.BYTE; format: ARRAY OF CHAR);
BEGIN
IF OberonSize(format) > LEN(from) THEN
SizeError("Oberon record is too small", format); RETURN
END;
IF CSize(format) > LEN(to) THEN
SizeError("C structure is too small", format); RETURN
END;
ByAddrToC(SYS.ADR(from), SYS.ADR(to), format);
END ToC;
PROCEDURE FromC*(VAR from, to: ARRAY OF SYS.BYTE; format: ARRAY OF CHAR);
BEGIN
IF OberonSize(format) > LEN(to) THEN
SizeError("Oberon record is too small", format); RETURN
END;
IF CSize(format) > LEN(from) THEN
SizeError("C structure is too small", format); RETURN
END;
ByAddrFromC(SYS.ADR(from), SYS.ADR(to), format);
END FromC;
PROCEDURE Compile*(VAR fmt: Format; format: ARRAY OF CHAR);
(* translate format into an internal representation
which is later referenced by fmt;
ByFmtToC and ByFmtFromC are faster than ToC and FromC
*)
VAR
cv: ConvStream;
offset1, offset2, size1, size2: Address;
flags: Flags;
element: Format;
head, tail: Format;
BEGIN
Open(cv, format);
head := NIL; tail := NIL;
WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO
NEW(element);
element.offset1 := offset1;
element.offset2 := offset2;
element.size1 := size1;
element.size2 := size2;
element.flags := flags;
element.next := NIL;
IF tail # NIL THEN
tail.next := element;
ELSE
head := element;
END;
tail := element;
END;
fmt := head;
Close(cv);
END Compile;
PROCEDURE ByFmtAndAddrToC*(from, to: Address; format: Format);
VAR
offset1, offset2, size1, size2: Address;
flags: Flags;
BEGIN
WHILE format # NIL DO
Convert(from + format.offset1, to + format.offset2,
format.size1, format.size2, format.flags);
format := format.next;
END;
END ByFmtAndAddrToC;
PROCEDURE ByFmtAndAddrFromC*(from, to: Address; format: Format);
VAR
offset1, offset2, size1, size2: Address;
flags: Flags;
BEGIN
WHILE format # NIL DO
Convert(from + format.offset2, to + format.offset1,
format.size2, format.size1, format.flags);
format := format.next;
END;
END ByFmtAndAddrFromC;
PROCEDURE ByFmtToC*(VAR from, to: ARRAY OF SYS.BYTE; format: Format);
BEGIN
ByFmtAndAddrToC(SYS.ADR(from), SYS.ADR(to), format);
END ByFmtToC;
PROCEDURE ByFmtFromC*(VAR from, to: ARRAY OF SYS.BYTE; format: Format);
BEGIN
ByFmtAndAddrFromC(SYS.ADR(from), SYS.ADR(to), format);
END ByFmtFromC;
BEGIN
Events.Define(badformat);
Events.SetPriority(badformat, Priorities.liberrors);
END ulmSysConversions.

6
src/lib/ulm/ulmSysTypes.Mod
View file

@ -28,9 +28,9 @@
----------------------------------------------------------------------------
*)
MODULE SysTypes;
MODULE ulmSysTypes;
IMPORT Types;
IMPORT Types := ulmTypes;
TYPE
Address* = Types.Address;
@ -67,4 +67,4 @@ MODULE SysTypes;
IdType = INTEGER; (* idPid .. idLwpid *)
*)
END SysTypes.
END ulmSysTypes.

2
src/lib/ulm/ulmTexts.Mod
View file

@ -57,7 +57,7 @@ MODULE ulmTexts;
cont: ARRAY bufsize OF Byte;
next: BufferLink;
END;
Text = POINTER TO TextRec;
Text* = POINTER TO TextRec;
TextRec* =
RECORD
(Streams.StreamRec)