From 89029e7753071b7de735e949c46b2875438fda0e Mon Sep 17 00:00:00 2001 From: Norayr Chilingarian Date: Wed, 23 Oct 2013 18:33:07 +0400 Subject: [PATCH] ulmSys, ulmSysConversions Former-commit-id: 60f0426d1787354a0de8f5b8f78eb0695dcc9eac --- makefile | 7 +- src/lib/ulm/ulmSys.Mod | 316 ++++++++++++++++ src/lib/ulm/ulmSysConversions.Mod | 574 ++++++++++++++++++++++++++++++ src/lib/ulm/ulmSysTypes.Mod | 6 +- src/lib/ulm/ulmTexts.Mod | 2 +- 5 files changed, 900 insertions(+), 5 deletions(-) create mode 100644 src/lib/ulm/ulmSys.Mod create mode 100644 src/lib/ulm/ulmSysConversions.Mod diff --git a/makefile b/makefile index f3dfec32..6309201d 100644 --- a/makefile +++ b/makefile @@ -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) diff --git a/src/lib/ulm/ulmSys.Mod b/src/lib/ulm/ulmSys.Mod new file mode 100644 index 00000000..ab2d2d70 --- /dev/null +++ b/src/lib/ulm/ulmSys.Mod @@ -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. + diff --git a/src/lib/ulm/ulmSysConversions.Mod b/src/lib/ulm/ulmSysConversions.Mod new file mode 100644 index 00000000..2af8eedf --- /dev/null +++ b/src/lib/ulm/ulmSysConversions.Mod @@ -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. diff --git a/src/lib/ulm/ulmSysTypes.Mod b/src/lib/ulm/ulmSysTypes.Mod index 28ea36d7..b7a0fedf 100644 --- a/src/lib/ulm/ulmSysTypes.Mod +++ b/src/lib/ulm/ulmSysTypes.Mod @@ -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. diff --git a/src/lib/ulm/ulmTexts.Mod b/src/lib/ulm/ulmTexts.Mod index 660c20c4..a4214fcd 100644 --- a/src/lib/ulm/ulmTexts.Mod +++ b/src/lib/ulm/ulmTexts.Mod @@ -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)