Update tools to v2.

This commit is contained in:
David Brown 2016-06-16 16:31:59 +01:00
parent ce855c93c8
commit 8b0bd9c675
8 changed files with 1742 additions and 86 deletions

139
src/tools/HeapDump/HeapDump.Mod Executable file
View file

@ -0,0 +1,139 @@
MODULE HeapDump;
IMPORT SYSTEM, Heap, Console;
PROCEDURE -wc(c: CHAR); BEGIN Console.Char(c) END wc;
PROCEDURE -ws(s: ARRAY OF CHAR); BEGIN Console.String(s) END ws;
PROCEDURE -wi(i: LONGINT); BEGIN Console.Int(i, 1) END wi;
PROCEDURE -wl; BEGIN Console.Ln(); Console_Flush() END wl;
PROCEDURE th(h: LONGINT);
VAR i, d: INTEGER; s: ARRAY 20 OF CHAR;
BEGIN
IF h = 0 THEN ws("0H"); RETURN END;
i := 0;
WHILE (h # 0) DO
d := SHORT(h MOD 16); h := SYSTEM.LSH(h, -4);
IF d < 10 THEN s[i] := CHR(d + ORD("0")) ELSE s[i] := CHR(d - 10 + ORD("a")) END;
INC(i)
END;
WHILE i > 0 DO DEC(i); wc(s[i]) END;
wc("H");
END th;
PROCEDURE DumpType(type: LONGINT);
TYPE
typename = POINTER TO ARRAY 24 OF CHAR;
pointers = POINTER TO ARRAY 10000 OF LONGINT;
VAR
tag, next, level, blksz, m: LONGINT;
module: Module;
name: typename;
ptr: pointers;
i: INTEGER;
BEGIN
SYSTEM.GET(type - SZL, tag);
SYSTEM.GET(type, next);
SYSTEM.GET(type + SZL, level);
SYSTEM.GET(type + 2*SZL, m); module := SYSTEM.VAL(Module, m);
name := SYSTEM.VAL(typename, type + 3*SZL);
SYSTEM.GET(type + 20*SZL + 24, blksz);
ptr := SYSTEM.VAL(pointers, type + 21*SZL + 24);
ws("tag "); th(tag);
ws(", level "); wi(level,1);
ws(", blksz "); th(blksz);
ws(", name "); ws(module.name); wc("."); ws(name^);
ws(", pointers: ");
i := 0; WHILE ptr[i] >= 0 DO wi(ptr[i],1); wc(" "); INC(i) END;
wi(ptr[i],1);
END DumpType;
PROCEDURE DumpTypes(types: LONGINT);
BEGIN
WHILE types # 0 DO
ws(" TYPE at: "); th(types); ws(": "); DumpType(types); wl;
SYSTEM.GET(types, types);
END
END DumpTypes;
PROCEDURE DumpModules;
VAR m: Module; t: LONGINT;
BEGIN
m := SYSTEM.VAL(Module, modules);
WHILE m # NIL DO
ws(" Module "); ws(m.name); ws(", refcnt "); wi(m.refcnt,1); wl;
DumpTypes(m.types);
m := m.next;
END
END DumpModules;
PROCEDURE DumpChunks;
VAR
chunk, nextchunk, chunkend: LONGINT;
block, blocktag, blocksize, blocksizeviatag, blocksentinel, blocknext: LONGINT;
type: LONGINT;
reserved, ptr: LONGINT;
BEGIN
chunk := heap;
WHILE chunk # 0 DO
SYSTEM.GET(chunk + nextChnkOff, nextchunk);
SYSTEM.GET(chunk + endOff, chunkend);
ws(" Chunk at "); th(chunk);
ws(", chunk end "); th(chunkend);
ws(", next chunk "); th(nextchunk);
wl;
block := chunk + blkOff;
WHILE block < chunkend DO
SYSTEM.GET(block+tagOff, blocktag);
SYSTEM.GET(block+sizeOff, blocksize);
SYSTEM.GET(block+sntlOff, blocksentinel);
SYSTEM.GET(block+nextOff, blocknext);
ws(" Block at "); th(block);
ws(", tag "); th(blocktag);
IF (ODD(blocktag)) THEN ws(" (marked)"); DEC(blocktag) END;
SYSTEM.GET(blocktag, blocksizeviatag);
SYSTEM.GET(blocktag - SZL, reserved);
SYSTEM.GET(blocktag + SZL, ptr);
(*ws(", size "); th(blocksize); *)
ws(", size via tag "); th(blocksizeviatag);
(*ws(", sentinel "); th(blocksentinel); *)
(*ws(", next block "); th(blocknext); *)
ws(", .reserved "); th(reserved);
ws(", .ptr[0] "); th(ptr);
(* The following test attempts to distinguish between blocks
allocated by NEW (whose tag points to a full type descriptor)
and those allocated by SYSTEM.NEW (whose tag points only to a
size and a dummy ptr list sentinel).
It is a safe test in that only full type descriptors have a
non-empty ptr list, but it means we will fail to report the
type of RECORDs that contain no pointers.
*)
IF ptr >= 0 THEN
type := blocktag - (20*SZL + 24);
ws(", type at "); th(type); wl;
ws(" TYPE: "); DumpType(type);
END;
wl;
INC(block, blocksizeviatag);
END;
chunk := nextchunk
END
END DumpChunks;
PROCEDURE Dump*;
BEGIN
Heap.Lock;
ws("Module and type dump."); wl; DumpModules; wl; wl;
ws("Heap chunk and block dump."); wl; DumpChunks; wl;
Heap.Unlock;
END Dump;
END HeapDump.

View file

@ -1,8 +1,8 @@
MODULE BrowserCmd; (* RC 29.10.93 *) (* object model 4.12.93, command line version jt 4.4.95 *)
IMPORT
OPM, OPS, OPT, OPV,
Texts := Texts0, Console, Args;
IMPORT
OPM, OPS, OPT, OPV, Texts, Console, Platform;
CONST
OptionChar = "-";
@ -100,6 +100,7 @@ MODULE BrowserCmd; (* RC 29.10.93 *) (* object model 4.12.93, command line ver
Ws(obj^.conval^.ext^)
| NilTyp:
Ws("NIL")
ELSE (* Ignore other forms *)
END ;
Wch(";"); Wln
| Typ:
@ -128,6 +129,7 @@ MODULE BrowserCmd; (* RC 29.10.93 *) (* object model 4.12.93, command line ver
Wch('"');
END ;
Wch(";"); Wln
ELSE (* Ignore other modes *)
END
END ;
Objects(obj^.right, mode)
@ -201,7 +203,9 @@ MODULE BrowserCmd; (* RC 29.10.93 *) (* object model 4.12.93, command line ver
Ws("(* size: "); Wi(typ^.size); Ws(" align: "); Wi(typ^.align);
Ws(" nofm: "); Wi(typ^.n); Ws(" *)")
END
ELSE (* Ignore other comps *)
END
ELSE (* Ignore other froms *)
END
END Wstruct;
@ -277,13 +281,13 @@ MODULE BrowserCmd; (* RC 29.10.93 *) (* object model 4.12.93, command line ver
VAR T, dummyT: Texts.Text; S, vname, name: OPS.Name; R: Texts.Reader; ch: CHAR;
s: ARRAY 1024 OF CHAR; i: INTEGER;
BEGIN
option := 0X; Args.Get(1, S);
IF Args.argc > 2 THEN
IF S[0] = OptionChar THEN option := S[1]; Args.Get(2, S)
ELSE Args.Get(2, vname); option := vname[1]
option := 0X; Platform.GetArg(1, S);
IF Platform.ArgCount > 2 THEN
IF S[0] = OptionChar THEN option := S[1]; Platform.GetArg(2, S)
ELSE Platform.GetArg(2, vname); option := vname[1]
END
END ;
IF Args.argc >= 2 THEN
IF Platform.ArgCount >= 2 THEN
Ident(S, name);
NEW(T); Texts.Open(T, "");
OPT.Init(name, {}); OPT.SelfName := "AvoidErr154"; WModule(name, T); OPT.Close;

447
src/tools/make/configure.c Normal file
View file

@ -0,0 +1,447 @@
// Test platform supportability and establish build configuration:
//
// Writes the configuration parameters to these two files:
//
// Configuration.Mod - settings to compile into the compiler binary
// Configuration.make - makefile variable settings for this configuration
//
// Derived from vocparam.c originally by J. Templ 23.6.95
#define O_VER 1.2 // Version number to be reported by compiler.
#define O_NAME voc // Compiler name used for binary, install dir and references in text.
// #define LARGE // Define this to get 32 bit INTEGER and 64 bit longints even on 32 bit platforms.
#include "SYSTEM.h"
#ifdef _WIN32
#define strncasecmp _strnicmp
#else
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
#include <sys/utsname.h>
#include <unistd.h>
#endif
#include <stdlib.h>
#include <stdio.h>
#include <time.h>
#include <string.h>
void fail(char *msg) {fprintf(stderr, "Error: %s\n", msg); exit(1);}
void assert(int truth, char *complaint) {if (!truth) fail(complaint);}
char builddate[256];
char installdir[256];
char versionstring[256];
char osrelease[1024];
char cwd[1024];
char ldconfig[1024]; // Command(s) to update OS shared library config
char libspec[1024];
#define macrotostringhelper(s) #s
#define macrotostring(s) macrotostringhelper(s)
char *version = macrotostring(O_VER);
char *objext = ".o";
char *objflag = " -o ";
char *linkflags = " -L\"";
char *oname = NULL; // From O_NAME env var if present, or O_NAME macro otherwise.
char *dataModel = NULL;
char *compiler = NULL;
char *cc = NULL;
char *os = NULL;
char *platform = NULL;
char *binext = NULL;
char *staticlink = NULL; // Static compilation option - none on darwin / windows.
int alignment = 0;
int addressSize = 0;
int intsize = 0;
int bsd = 0;
int termux = 0;
void ParseOsRelease(FILE *fd) {
while (fgets(osrelease, sizeof(osrelease), fd) != NULL) {
if (strncasecmp(osrelease, "id=", 3) == 0) {
int i=3;
while (osrelease[i] == '"') {i++;}
int j=i;
while (osrelease[j] > '"') {j++;}
if (j>i) {
osrelease[j] = 0;
os = osrelease + i;
}
break;
}
}
fclose(fd);
}
void determineLinuxVariant() {
FILE *fd = NULL;
os = "linux";
if ((fd = fopen("/etc/os-release", "r"))) {ParseOsRelease(fd); return;}
// Hack for centos without /etc/os-release
if ((fd = fopen("/etc/centos-release", "r"))) {os = "centos"; fclose(fd); return;}
// Hack to detect running in termux in android
if ((fd = fopen("/data/data/com.termux/files/usr/bin/bash", "r"))) {os = "termux"; staticlink = ""; termux = 1; fclose(fd); return;}
}
void determineOS() {
#ifdef _WIN32
os = "windows"; platform = "windows"; binext = ".exe"; staticlink = "";
#else
os = "unknown"; platform = "unix"; binext = ""; staticlink = "-static";
struct utsname sys;
if (uname(&sys)<0) fail("Couldn't get sys name - uname() failed.");
if (strncasecmp(sys.sysname, "cygwin", 6) == 0) {os = "cygwin"; binext = ".exe";}
else if (strncasecmp(sys.sysname, "linux", 5) == 0) {determineLinuxVariant();}
else if (strncasecmp(sys.sysname, "freebsd", 5) == 0) {os = "freebsd"; bsd = 1;}
else if (strncasecmp(sys.sysname, "openbsd", 5) == 0) {os = "openbsd"; bsd = 1;}
else if (strncasecmp(sys.sysname, "darwin", 5) == 0) {os = "darwin"; staticlink = "";}
else {
fprintf(stderr, "\n\n** Unrecognised utsname.sysname '%s' returned by uname().\n", sys.sysname);
fprintf(stderr, "** Please add a test for this OS in src/buildtools/configure.c\n");
fprintf(stderr, "** in function determineOS() near line %d.\n\n", __LINE__-3);
fail("Unrecognised OS architecture name (sysname) returned by uname.");
}
#endif
}
void determineCCompiler() {
snprintf(libspec, sizeof(libspec), " -l %s", oname);
#if defined(__MINGW32__)
compiler = "mingw";
if (sizeof (void*) == 4) {
cc = "i686-w64-mingw32-gcc -g";
} else {
cc = "x86_64-w64-mingw32-gcc -g";
}
#elif defined(__clang__)
compiler = "clang";
cc = "clang -fPIC -g";
#elif defined(__GNUC__)
compiler = "gcc";
if (strncasecmp(os, "cygwin", 6) == 0) {
// Avoid cygwin specific warning that -fPIC is ignored.
cc = "gcc -g";
} else {
cc = "gcc -fPIC -g";
}
#elif defined(_MSC_VER)
compiler = "MSC";
cc = "cl /nologo";
objext = ".obj";
objflag = " -Fe";
linkflags = " -link -libpath:\"";
snprintf(libspec, sizeof(libspec), " lib%s.lib", oname);
#else
fail("Unrecognised C compiler.");
#endif
}
void determineInstallDirectory() {
char *env = getenv("INSTALLDIR");
if (env) {
strncpy(installdir, env, sizeof(installdir));
} else {
#if defined(_MSC_VER) || defined(__MINGW32__)
if (sizeof (void*) == 8) {
snprintf(installdir, sizeof(installdir), "%s\\%s", getenv("ProgramFiles"), oname);
} else {
snprintf(installdir, sizeof(installdir), "%s\\%s", getenv("ProgramFiles(x86)"), oname);
}
#if defined(__MINGW32__)
int i; for(i=0; installdir[i]; i++) if (installdir[i] == '\\') installdir[i] = '/';
#endif
#else
if (bsd) {
snprintf(installdir, sizeof(installdir), "/usr/local/share/%s", oname);
} else if (termux) {
snprintf(installdir, sizeof(installdir), "/data/data/com.termux/files/opt/%s", oname);
} else {
snprintf(installdir, sizeof(installdir), "/opt/%s", oname);
}
#endif
}
}
void determineLdconfig() { // Generate appropriate ldconfig command for this OS
if (bsd) {
snprintf(ldconfig, sizeof(ldconfig), "ldconfig -m \"%s/lib\"", installdir);
} else {
snprintf(
ldconfig, sizeof(ldconfig),
"if echo \"%s/lib\" >/etc/ld.so.conf.d/lib%s.conf; then ldconfig; fi",
installdir, oname
);
}
}
void determineBuildDate() {
time_t t = time(0);
strftime(builddate, sizeof(builddate), "%Y/%m/%d", localtime(&t));
}
struct {char ch; CHAR x;} c;
struct {char ch; BOOLEAN x;} b;
struct {char ch; SHORTINT x;} si;
struct {char ch; INTEGER x;} i;
struct {char ch; LONGINT x;} li;
struct {char ch; SET x;} s;
struct {char ch; REAL x;} r;
struct {char ch; LONGREAL x;} lr;
struct {char ch; void* x;} p;
struct {char ch; void (*x)();} f;
struct {char ch; int x;} in;
struct {char ch; long x;} lo;
struct {char ch; long long x;} ll;
struct {char ch; char x[1];} a1;
struct {char ch; char x[2];} a2;
struct {char ch; char x[4];} a4;
struct {char ch; char x[8];} a8;
struct s1 {char ch;}; struct {char ch; struct s1 x;} s1;
struct s2 {char ch[2];}; struct {char ch; struct s2 x;} s2;
struct s4 {char ch[4];}; struct {char ch; struct s4 x;} s4;
struct s8 {char ch[8];}; struct {char ch; struct s8 x;} s8;
struct {char ch;} rec0;
struct {char x[65];} rec2;
// Pass any parameter to configure and it will report sizes and alignments
// instead of generating configuration files.
void ReportSizesAndAlignments() {
printf("Type Size Align\n");
printf("CHAR %4zd %4td\n", sizeof(CHAR), (char*)&c.x - (char*)&c);
printf("BOOLEAN %4zd %4td\n", sizeof(BOOLEAN), (char*)&b.x - (char*)&b);
printf("SHORTINT %4zd %4td\n", sizeof(SHORTINT), (char*)&si.x - (char*)&si);
printf("INTEGER %4zd %4td\n", sizeof(INTEGER), (char*)&i.x - (char*)&i);
printf("LONGINT %4zd %4td\n", sizeof(LONGINT), (char*)&li.x - (char*)&li);
printf("SET %4zd %4td\n", sizeof(SET), (char*)&s.x - (char*)&s);
printf("REAL %4zd %4td\n", sizeof(REAL), (char*)&r.x - (char*)&r);
printf("LONGREAL %4zd %4td\n", sizeof(LONGREAL), (char*)&lr.x - (char*)&lr);
printf("void* %4zd %4td\n", sizeof(void*), (char*)&p.x - (char*)&p);
printf("int %4zd %4td\n", sizeof(int), (char*)&in.x - (char*)&in);
printf("long %4zd %4td\n", sizeof(long), (char*)&lo.x - (char*)&lo);
printf("long long %4zd %4td\n", sizeof(long long), (char*)&ll.x - (char*)&ll);
printf("char[1] %4zd %4td\n", sizeof(a1.x), (char*)&a1.x - (char*)&a1);
printf("char[2] %4zd %4td\n", sizeof(a2.x), (char*)&a2.x - (char*)&a2);
printf("char[4] %4zd %4td\n", sizeof(a4.x), (char*)&a4.x - (char*)&a4);
printf("char[8] %4zd %4td\n", sizeof(a8.x), (char*)&a8.x - (char*)&a8);
printf("struct s1 %4zd %4td\n", sizeof(struct s1), (char*)&s1.x - (char*)&s1);
printf("struct s2 %4zd %4td\n", sizeof(struct s2), (char*)&s2.x - (char*)&s2);
printf("struct s4 %4zd %4td\n", sizeof(struct s4), (char*)&s4.x - (char*)&s4);
printf("struct s8 %4zd %4td\n", sizeof(struct s8), (char*)&s8.x - (char*)&s8);
}
#define MIN(a,b) (((a)<(b)) ? (a) : (b))
void determineCDataModel() {
addressSize = sizeof(void*);
alignment = (char*)&lr.x - (char*)&lr; // Base alignment measure on largest type.
if (addressSize == 4 && sizeof(int) == 4) dataModel = "ILP32"; // Unix/Linux and modern Win32
else if (addressSize == 8 && sizeof(long) == 4) dataModel = "LLP64"; // Windows/mingw 64 bit
else if (addressSize == 8 && sizeof(long) == 8) dataModel = "LP64"; // Unix/Linux 64 bit
else fail("Unsupported combination of address size and int/long size.");
// Check for supported address sie and alignment
if (addressSize == 4) {
assert(alignment == 4 || alignment == 8, "Aligment neither 4 nor 8 when address size is 4.");
} else {
assert(addressSize == 8, "Address size neither 4 nor 8.");
assert(alignment == 8, "Alignemnt not 8 when address size is 8.");
}
// Define 'LARGE' to get 32 bit INTEGER and 64 bit LONGINT even on 32 bit systems.
// Note that plenty of the library source files do not expect this.
#ifdef LARGE
intsize = 4;
#else
intsize = (addressSize == 4) ? 2 : 4;
#endif
}
void testSystemDotH() {
/* test the __ASHR macro */
assert(__ASHR(-1, 1) == -1, "ASH(-1, -1) # -1.");
assert(__ASHR(-2, 1) == -1, "ASH(-2, -1) # -1.");
assert(__ASHR(0, 1) == 0, "ASH(0, 1) # 0.");
assert(__ASHR(1, 1) == 0, "ASH(1, 1) # 0.");
assert(__ASHR(2, 1) == 1, "ASH(2, 1) # 1.");
/* test the __SETRNG macro */
long x = 0;
long y = sizeof(SET)*8 - 1;
assert(__SETRNG(x, y) == -1, "SETRNG(0, MAX(SET)) != -1.");
/* test string comparison for extended ascii */
{char a[10], b[10];
a[0] = (CHAR)128; a[1] = 0;
b[0] = 0;
assert(__STRCMP(a, b) >= 0, "__STRCMP(a, b) with extended ascii charcters; should be unsigned.");
}
// Check the sizes of the Oberon basic types as defined in SYSTEM.h.
// By design all but INTEGER and LONGINT are fixed across all supported platfroms.
assert(sizeof(CHAR) == 1, "Size of CHAR not 1.");
assert(sizeof(BOOLEAN) == 1, "Size of BOOLEAN not 1.");
assert(sizeof(SHORTINT) == 1, "Size of SHORTINT not 1.");
assert(sizeof(INTEGER) == 2
|| sizeof(INTEGER) == 4, "Size of INTEGER neither 2 nor 4 bytes.");
assert(sizeof(LONGINT) == 4
|| sizeof(LONGINT) == 8, "Size of LONGINT neither 4 nor 8 bytes.");
assert(sizeof(SET) == sizeof(LONGINT), "Size of SET differs from size of LONGINT.");
assert(sizeof(REAL) == 4, "Size of REAL not 4 bytes.");
assert(sizeof(LONGREAL) == 8, "Size of LONGREAL not 8 bytes.");
assert(sizeof(f.x) == sizeof(p.x), "Size of function pointer differs from size of data pointer.");
assert((alignment == 4) || (alignment == 8), "Alignment of LONGINT neither 4 nor 8 bytes.");
assert(((char*)&c.x - (char*)&c) == 1, "Alignment of CHAR not 1.");
assert(((char*)&b.x - (char*)&b) == 1, "Alignment of BOOLEAN not 1.");
assert(((char*)&si.x - (char*)&si) == 1, "Alignment of SHORTINT not 1.");
//assert(((char*)&i.x - (char*)&i) == 4, "Alignment of INTEGER not 4 bytes.");
assert(((char*)&r.x - (char*)&r) == 4, "Alignment of REAL not 4 bytes.");
assert(((char*)&lr.x - (char*)&lr) >= 4, "Alignment of LONGREAL less than 4 bytes.");
assert(((char*)&s.x - (char*)&s) == MIN(alignment, sizeof(SET)), "Alignment of SET differs from alignmnet of LONGINT.");
assert(((char*)&p.x - (char*)&p) == addressSize, "Alignment of data pointer differs from address size.");
assert(((char*)&f.x - (char*)&f) == addressSize, "Alignment of data pointer differs from address size.");
assert(sizeof(rec0) == 1, "CHAR wrapped in record aligns differently to CHAR alone.");
assert(sizeof(rec2) == 65, "CHAR array wrapped in record aligns differently to CHAR array alone.");
assert(sizeof(LONGINT) >= sizeof(p.x), "LONGINT should have at least the same size as data pointers.");
assert(sizeof(LONGINT) >= sizeof(f.x), "LONGINT should have at least the same size as function pointers.");
if (((sizeof(rec2)==65) == (sizeof(rec0)==1)) && ((sizeof(rec2)-64) != sizeof(rec0)))
printf("error: unsupported record layout sizeof(rec0) = %lu sizeof(rec2) = %lu\n", (long)sizeof(rec0), (long)sizeof(rec2));
x = 1;
assert(*(char*)&x == 1, "C compiler does not store multibyte numeric values in little-endian order.");
}
void writeMakeParameters() {
FILE *fd = fopen("Configuration.Make", "w");
if (fd == NULL) fail("Couldn't create Configuration.make.");
fprintf(fd, "OLANGDIR=%s\n", cwd);
fprintf(fd, "COMPILER=%s\n", compiler);
fprintf(fd, "OS=%s\n", os);
fprintf(fd, "VERSION=%s\n", version);
fprintf(fd, "ONAME=%s\n", oname);
fprintf(fd, "DATAMODEL=%s\n", dataModel);
fprintf(fd, "INTSIZE=%d\n", intsize);
fprintf(fd, "ADRSIZE=%d\n", addressSize);
fprintf(fd, "ALIGNMENT=%d\n", alignment);
fprintf(fd, "INSTALLDIR=%s\n", installdir);
fprintf(fd, "PLATFORM=%s\n", platform);
fprintf(fd, "BINEXT=%s\n", binext);
fprintf(fd, "COMPILE=%s\n", cc);
fprintf(fd, "STATICLINK=%s\n", staticlink);
fprintf(fd, "LDCONFIG=%s\n", ldconfig);
fclose(fd);
}
void writeConfigurationMod() {
FILE *fd = fopen("Configuration.Mod", "w");
if (fd == NULL) fail("Couldn't create Configuration.Mod.");
fprintf(fd, "MODULE Configuration;\n");
fprintf(fd, "CONST\n");
fprintf(fd, " name* = '%s';\n", oname);
fprintf(fd, " versionLong* = '%s';\n", versionstring);
fprintf(fd, " intsize* = %d;\n", intsize);
fprintf(fd, " addressSize* = %d;\n", addressSize);
fprintf(fd, " alignment* = %d;\n", alignment);
fprintf(fd, " objext* = '%s';\n", objext);
fprintf(fd, " objflag* = '%s';\n", objflag);
fprintf(fd, " linkflags* = '%s';\n", linkflags);
fprintf(fd, " libspec* = '%s';\n", libspec);
fprintf(fd, " compile* = '%s';\n", cc);
fprintf(fd, " dataModel* = '%s';\n", dataModel);
fprintf(fd, " installdir* = '%s';\n", installdir);
fprintf(fd, " staticLink* = '%s';\n", staticlink);
fprintf(fd, "END Configuration.\n");
fclose(fd);
}
int main(int argc, char *argv[])
{
oname = getenv("ONAME"); if (!oname) oname = macrotostring(O_NAME);
if (argc>1) {
ReportSizesAndAlignments();
exit(0);
}
getcwd(cwd, sizeof(cwd));
int i; for (i=0; cwd[i]; i++) if (cwd[i]=='\\') cwd[i]='/';
determineOS();
determineCCompiler();
determineCDataModel();
determineBuildDate();
determineInstallDirectory();
determineLdconfig();
testSystemDotH();
snprintf(versionstring, sizeof(versionstring),
"%s [%s] for %s %s on %s",
version, builddate, compiler, dataModel, os);
writeConfigurationMod();
writeMakeParameters();
printf("Configuration: %s\n", versionstring);
return 0;
}

372
src/tools/make/vishap.make Normal file
View file

@ -0,0 +1,372 @@
# DO NOT RUN THIS MAKEFILE DIRECTLY.
#
# Always use the makefile in the root of the enlistment. This makefile
# depends on up to date configuration files generated by the root makefile.
# Gnu make has the make initial directory in CURDIR, BSD make has it in .CURDIR.
ROOTDIR = $(CURDIR)$(.CURDIR)
include ./Configuration.Make
FLAVOUR = $(OS).$(DATAMODEL).$(COMPILER)
BUILDDIR = build/$(FLAVOUR)
VISHAP = $(ONAME)$(BINEXT)
# Default make target - explain usage
usage:
@echo ""
@echo Do not run this makefile directly, always run the makefile in
@echo the root of the enlistment.
clean:
rm -rf $(BUILDDIR)
rm -f $(VISHAP)
# Assemble: Generate the Vishap Oberon compiler binary by compiling the C sources in the build directory
assemble:
@printf "\nmake assemble - compiling Oberon compiler c source:\n"
@printf " VERSION: %s\n" "$(VERSION)"
@printf " Target characeristics:\n"
@printf " PLATFORM: %s\n" "$(PLATFORM)"
@printf " OS: %s\n" "$(OS)"
@printf " BUILDDIR: %s\n" "$(BUILDDIR)"
@printf " INSTALLDIR: %s\n" "$(INSTALLDIR)"
@printf " Oberon characteristics:\n"
@printf " INTSIZE: %s\n" "$(INTSIZE)"
@printf " ADRSIZE: %s\n" "$(ADRSIZE)"
@printf " ALIGNMENT: %s\n" "$(ALIGNMENT)"
@printf " C compiler:\n"
@printf " COMPILER: %s\n" "$(COMPILER)"
@printf " COMPILE: %s\n" "$(COMPILE)"
@printf " DATAMODEL: %s\n" "$(DATAMODEL)"
cd $(BUILDDIR) && $(COMPILE) -c SYSTEM.c Configuration.c Platform.c Heap.c
cd $(BUILDDIR) && $(COMPILE) -c Console.c Strings.c Modules.c Files.c
cd $(BUILDDIR) && $(COMPILE) -c Reals.c Texts.c vt100.c errors.c
cd $(BUILDDIR) && $(COMPILE) -c OPM.c extTools.c OPS.c OPT.c
cd $(BUILDDIR) && $(COMPILE) -c OPC.c OPV.c OPB.c OPP.c
cd $(BUILDDIR) && $(COMPILE) $(STATICLINK) Vishap.c -o $(ROOTDIR)/$(VISHAP) \
SYSTEM.o Configuration.o Platform.o Heap.o Console.o Strings.o Modules.o Files.o \
Reals.o Texts.o vt100.o errors.o OPM.o extTools.o OPS.o OPT.o \
OPC.o OPV.o OPB.o OPP.o
@printf "$(VISHAP) created.\n"
compilerfromsavedsource:
@echo Populating clean build directory from bootstrap C sources.
@mkdir -p $(BUILDDIR)
@cp bootstrap/$(PLATFORM)-$(ADRSIZE)$(ALIGNMENT)/* $(BUILDDIR)
@make -f src/tools/make/vishap.make -s assemble
translate:
# Make sure we have an oberon compiler binary: if we built one earlier we'll use it,
# otherwise use one of the pre-prepared sets of C sources in the bootstrap directory.
if [ ! -e $(VISHAP) ]; then make -f src/tools/make/vishap.make -s compilerfromsavedsource; fi
@printf "\nmake translate - translating compiler source from Oberon to C:\n"
@printf " PLATFORM: %s\n" $(PLATFORM)
@printf " INTSIZE: %s\n" $(INTSIZE)
@printf " ADRSIZE: %s\n" $(ADRSIZE)
@printf " ALIGNMENT: %s\n" $(ALIGNMENT)
@mkdir -p $(BUILDDIR)
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../Configuration.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/system/Platform$(PLATFORM).Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfFapx -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/system/Heap.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/system/Console.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/library/v4/Strings.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/library/v4/Modules.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfFx -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/system/Files.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/library/v4/Reals.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/library/v4/Texts.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/library/misc/vt100.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/compiler/errors.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/compiler/OPM.cmdln.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/compiler/extTools.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfFx -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/compiler/OPS.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/compiler/OPT.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/compiler/OPC.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/compiler/OPV.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/compiler/OPB.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SsfF -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/compiler/OPP.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ssfm -B$(INTSIZE)$(ADRSIZE)$(ALIGNMENT) ../../src/compiler/Vishap.Mod
cp src/system/*.[ch] $(BUILDDIR)
@printf "$(BUILDDIR) filled with compiler C source.\n"
browsercmd:
@printf "\nMaking symbol browser\n"
@cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -fSm ../../src/tools/browser/BrowserCmd.Mod
@cd $(BUILDDIR); $(COMPILE) BrowserCmd.c -o showdef \
Platform.o Texts.o OPT.o Heap.o Console.o SYSTEM.o OPM.o OPS.o OPV.o \
Files.o Reals.o Modules.o vt100.o errors.o Configuration.o Strings.o \
OPC.o
FORCE:
testcoordinator: FORCE
@rm -f testcoordinator.exe testclient.exe
@make -f src/tools/make/vishap.make -s testtools
testtools:
@printf "\nMaking test coordinator\n"
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -SfFs ../../src/tools/testcoordinator/IP.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Sfsm ../../src/tools/testcoordinator/TestCoordinator.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Sfsm ../../src/tools/testcoordinator/TestClient.Mod
cd $(BUILDDIR); $(COMPILE) -c IP.c
cd $(BUILDDIR); $(COMPILE) TestCoordinator.c -o $(ROOTDIR)/testcoordinator \
Platform.o SYSTEM.o Heap.o Console.o Strings.o IP.o
cd $(BUILDDIR); $(COMPILE) TestClient.c -o $(ROOTDIR)/testclient \
Platform.o SYSTEM.o Heap.o Console.o Strings.o IP.o
# install: Use only after a successful full build. Installs the compiler
# and libraries in /opt/$(ONAME).
# May require root access.
install:
@printf "\nInstalling into \"$(INSTALLDIR)\"\n"
@rm -rf "$(INSTALLDIR)"
@mkdir -p "$(INSTALLDIR)/bin" "$(INSTALLDIR)/include" "$(INSTALLDIR)/sym" "$(INSTALLDIR)/lib"
@cp $(BUILDDIR)/*.h "$(INSTALLDIR)/include/"
@cp $(BUILDDIR)/*.sym "$(INSTALLDIR)/sym/"
@cp $(VISHAP) "$(INSTALLDIR)/bin/$(VISHAP)"
@-cp $(BUILDDIR)/showdef$(BINEXT) "$(INSTALLDIR)/bin"
@cp $(BUILDDIR)/lib$(ONAME).* "$(INSTALLDIR)/lib/"
@if which ldconfig >/dev/null 2>&1; then $(LDCONFIG); fi
@printf "\nNow add $(INSTALLDIR)/bin to your path, for example with the command:\n"
@printf "export PATH=\"$(INSTALLDIR)/bin:\$$PATH\"\n"
@printf "\n"
uninstall:
@printf "\nUninstalling from \"$(INSTALLDIR)\"\n"
rm -rf "$(INSTALLDIR)"
rm -f /etc/ld.so.conf/lib$(ONAME)
if which ldconfig >/dev/null 2>&1; then ldconfig; fi
v4:
@printf "\nMaking v4 library\n"
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/v4/Args.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/v4/Printer.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/v4/Sets.Mod
ooc2:
@printf "\nMaking ooc2 library\n"
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc2/ooc2Strings.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc2/ooc2Ascii.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc2/ooc2CharClass.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc2/ooc2ConvTypes.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc2/ooc2IntConv.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc2/ooc2IntStr.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc2/ooc2Real0.Mod
ooc:
@printf "\nMaking ooc library\n"
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocLowReal.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocLowLReal.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocRealMath.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocOakMath.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocLRealMath.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocLongInts.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocComplexMath.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocLComplexMath.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocAscii.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocCharClass.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocStrings.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocConvTypes.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocLRealConv.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocLRealStr.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocRealConv.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocRealStr.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocIntConv.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocIntStr.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocMsg.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocSysClock.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocTime.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocChannel.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocStrings2.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocRts.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocFilenames.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocTextRider.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocBinaryRider.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocJulianDay.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocFilenames.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocwrapperlibc.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocC$(DATAMODEL).Mod
oocX11:
@printf "\nMaking oocX11 library\n"
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/oocX11/oocX11.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/oocX11/oocXutil.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/oocX11/oocXYplane.Mod
ulm:
@printf "\nMaking ulm library\n"
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmObjects.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmPriorities.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmDisciplines.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmServices.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmSys.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmSYSTEM.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmEvents.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmProcess.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmResources.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmForwarders.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmRelatedEvents.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmTypes.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmStreams.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmStrings.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmSysTypes.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmTexts.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmSysConversions.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmErrors.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmSysErrors.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmSysStat.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmASCII.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmSets.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmIO.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmAssertions.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmIndirectDisciplines.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmStreamDisciplines.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmIEEE.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmMC68881.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmReals.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmPrint.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmWrite.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmConstStrings.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmPlotters.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmSysIO.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmLoader.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmNetIO.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmPersistentObjects.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmPersistentDisciplines.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmOperations.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmScales.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmTimes.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmClocks.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmTimers.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmConditions.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmStreamConditions.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmTimeConditions.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmCiphers.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmCipherOps.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmBlockCiphers.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmAsymmetricCiphers.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmConclusions.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmRandomGenerators.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmTCrypt.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ulm/ulmIntOperations.Mod
pow32:
@printf "\nMaking pow library\n"
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/pow/powStrings.Mod
misc:
@printf "\nMaking misc library\n"
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/system/Oberon.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/misc/crt.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/misc/Listen.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/misc/MersenneTwister.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/misc/MultiArrays.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/misc/MultiArrayRiders.Mod
s3:
@printf "\nMaking s3 library\n"
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethBTrees.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethMD5.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethSets.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethZlib.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethZlibBuffers.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethZlibInflate.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethZlibDeflate.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethZlibReaders.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethZlibWriters.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethZip.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethRandomNumbers.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethGZReaders.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethGZWriters.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethUnicode.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethDates.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethReals.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/s3/ethStrings.Mod
librarybinary:
@printf "\nMaking lib$(ONAME)\n"
# Remove objects that should not be part of the library
rm -f $(BUILDDIR)/vishap.o
# Note: remining compiler files are retained in the library allowing the building
# of utilities like BrowserCmd.Mod (aka showdef).
# Make static library
ar rcs "$(BUILDDIR)/lib$(ONAME).a" $(BUILDDIR)/*.o
# Make shared library
@cd $(BUILDDIR) && $(COMPILE) -shared -o lib$(ONAME).so *.o
library: v4 ooc2 ooc ulm pow32 misc s3 librarybinary
confidence:
@printf "\n\n--- Confidence tests ---\n\n"
cd src/test/confidence/hello; ./test.sh "$(INSTALLDIR)"
if [ "$(PLATFORM)" != "windows" ] ; then cd src/test/confidence/signal; ./test.sh "$(INSTALLDIR)"; fi
cd src/test/confidence/lola; ./test.sh "$(INSTALLDIR)"
cd src/test/confidence/arrayassignment; ./test.sh "$(INSTALLDIR)"
@printf "\n\n--- Confidence tests passed ---\n\n"
# auto: A full build started from a central machine running TestCoordinator.
auto:
@make -f src/tools/make/vishap.make -s clean
@make -f src/tools/make/vishap.make -s translate
@make -f src/tools/make/vishap.make -s assemble
@make -f src/tools/make/vishap.make -s testtools
while cmd=$$(./testclient -w "$(FLAVOUR)"); do $$cmd 2>&1 | ./testclient -s "$(FLAVOUR)"; done

View file

@ -0,0 +1,283 @@
MODULE IP;
IMPORT SYSTEM, Platform, Console;
CONST
FDcount- = 1024; (* Number of FDs in FD set *)
TYPE
SocketAddress* = RECORD
length-: LONGINT;
buf: ARRAY 28 OF SYSTEM.BYTE; (* Sufficient for IPv4 and IPv6. *)
END;
FDset* = ARRAY 128 OF SYSTEM.BYTE; (* Exposes C fd_set *)
InAddr = POINTER TO InAddrDesc;
InAddrDesc = RECORD
addr: ARRAY 128 OF SYSTEM.BYTE;
next: InAddr
END;
VAR
v4-: LONGINT; (* AF_INET *)
v6-: LONGINT; (* AF_INET6 *)
Stream-: LONGINT; (* SOCK_STREAM *)
Datagram-: LONGINT; (* SOCK_DGRAM *)
(* Testing *)
addr: InAddr;
err: Platform.ErrorCode;
PROCEDURE -AAincludetypes "#include <sys/types.h>";
PROCEDURE -AAincludetime "#include <sys/time.h>";
PROCEDURE -AAincludesocket "#include <sys/socket.h>";
PROCEDURE -AAincludeselect "#include <sys/select.h>";
PROCEDURE -AAincludenetdb "#include <netdb.h>";
PROCEDURE -AICANONNAME (): LONGINT "AI_CANONNAME";
PROCEDURE -AIPASSIVE (): LONGINT "AI_PASSIVE ";
PROCEDURE -AFUNSPEC (): LONGINT "AF_UNSPEC";
PROCEDURE -AFINET (): LONGINT "AF_INET";
PROCEDURE -AFINET6 (): LONGINT "AF_INET6";
PROCEDURE -SOCKSTREAM (): LONGINT "SOCK_STREAM";
PROCEDURE -SOCKDGRAM (): LONGINT "SOCK_DGRAM";
PROCEDURE -NINUMERICHOST(): LONGINT "NI_NUMERICHOST";
PROCEDURE -NINUMERICSERV(): LONGINT "NI_NUMERICSERV";
PROCEDURE -EAISYSTEM (): LONGINT "EAI_SYSTEM";
PROCEDURE -EAIFAIL (): LONGINT "EAI_FAIL";
(* Console output convenience APIs *)
PROCEDURE cs (s: ARRAY OF CHAR); BEGIN Console.String(s) END cs;
PROCEDURE csl(s: ARRAY OF CHAR); BEGIN Console.String(s); Console.Ln END csl;
PROCEDURE ci (i,w: LONGINT); BEGIN Console.Int(i,w) END ci;
PROCEDURE ch (i: LONGINT); BEGIN Console.Hex(i) END ch;
PROCEDURE cc (c: CHAR); BEGIN Console.Char(c) END cc;
PROCEDURE cl (); BEGIN Console.Ln END cl;
PROCEDURE hex(i: INTEGER): CHAR;
BEGIN IF i < 10 THEN RETURN CHR(i+48) ELSE RETURN CHR(i+55) END END hex;
PROCEDURE cb (b: SYSTEM.BYTE);
VAR v: INTEGER;
BEGIN
v := SYSTEM.VAL(INTEGER, b); cc(hex(v DIV 16)); cc(hex(v MOD 16));
END cb;
PROCEDURE -getnameinfo(sa, salen, flags: LONGINT; VAR host, serv: ARRAY OF CHAR): INTEGER
"(INTEGER)getnameinfo((const struct sockaddr*)sa, salen, host, host__len, serv, serv__len, flags)";
PROCEDURE WriteSocketAddress*(s: SocketAddress);
VAR host, service: ARRAY 4096 OF CHAR; IPv6: BOOLEAN;
BEGIN
IPv6 := s.length > 20; (* IPv4 len = 16, IPv6 len = 28 *)
IF getnameinfo(SYSTEM.ADR(s.buf), s.length, NINUMERICHOST(), host, service) >= 0 THEN
IF IPv6 THEN cc('[') END; cs(host); IF IPv6 THEN cs("]:") ELSE cc(':') END;
cs(service)
END
END WriteSocketAddress;
PROCEDURE SameAddress*(s1, s2: SocketAddress): BOOLEAN;
(* True if same IP address, independent of port number *)
VAR host1, host2, service: ARRAY 4096 OF CHAR; i: INTEGER; result: BOOLEAN;
BEGIN
result := getnameinfo(SYSTEM.ADR(s1.buf), s1.length, NINUMERICHOST(), host1, service) >= 0;
IF result THEN result := getnameinfo(SYSTEM.ADR(s2.buf), s2.length, NINUMERICHOST(), host2, service) >= 0 END;
cs("host1: '"); cs(host1); cs("', host2: '"); cs(host2); csl("'.");
IF result THEN
i := 0;
WHILE (host1[i] # 0X) & (host2[i] # 0X) & (host1[i] = host2[i]) DO INC(i) END;
result := host1[i] = host2[i]
END;
RETURN result;
END SameAddress;
PROCEDURE -aiFlags (p: LONGINT): LONGINT "(LONGINT)((struct addrinfo*)p)->ai_flags";
PROCEDURE -aiFamily (p: LONGINT): LONGINT "(LONGINT)((struct addrinfo*)p)->ai_family";
PROCEDURE -aiSocketType(p: LONGINT): LONGINT "(LONGINT)((struct addrinfo*)p)->ai_socktype";
PROCEDURE -aiProtocol (p: LONGINT): LONGINT "(LONGINT)((struct addrinfo*)p)->ai_protocol";
PROCEDURE -aiAddrLen (p: LONGINT): LONGINT "(LONGINT)((struct addrinfo*)p)->ai_addrlen";
PROCEDURE -aiSockAddr (p: LONGINT): LONGINT "(LONGINT)((struct addrinfo*)p)->ai_addr";
PROCEDURE -aiCanonName (p: LONGINT): LONGINT "(LONGINT)((struct addrinfo*)p)->ai_canonname";
PROCEDURE -aiNext (p: LONGINT): LONGINT "(LONGINT)((struct addrinfo*)p)->ai_next";
PROCEDURE -caddrinfo(family, socktype, protocol, flags: LONGINT) "struct addrinfo ai={flags,family,socktype,protocol,0}";
PROCEDURE -caddrinfoptr "struct addrinfo *pai";
PROCEDURE -getaddrinfo(host, service: LONGINT): INTEGER
"(INTEGER)getaddrinfo((char*)host, (char*)service, &ai, &pai)";
PROCEDURE -pai(): LONGINT "(LONGINT)pai";
PROCEDURE -freeaddrinfo(addrinfo: LONGINT) "freeaddrinfo((struct addrinfo*)addrinfo)";
(* To get a local receiving address, past host as an empty string. *)
PROCEDURE Lookup*(host, service: ARRAY OF CHAR; family, socktype: LONGINT; VAR addr: SocketAddress): Platform.ErrorCode;
VAR addrinfo, hostptr, flags: LONGINT; result: Platform.ErrorCode;
BEGIN
IF host[0] = 0X THEN
hostptr := 0; flags := AIPASSIVE();
ELSE
hostptr := SYSTEM.ADR(host); flags := 0;
END;
caddrinfo(family, socktype, 0, flags);
caddrinfoptr;
result := getaddrinfo(hostptr, SYSTEM.ADR(service));
IF result = EAISYSTEM() THEN RETURN Platform.Error() END;
(* Return getaddrinfo specific reslts as negative numbers to avoid clash with OS error codes. *)
IF result # 0 THEN RETURN -ABS(result) END;
addrinfo := pai(); addr.length := aiAddrLen(addrinfo);
IF (addrinfo = 0) OR (addr.length <= 0) THEN RETURN SHORT(-ABS(EAIFAIL())) END;
ASSERT(addr.length <= LEN(addr.buf));
SYSTEM.MOVE(aiSockAddr(addrinfo), SYSTEM.ADR(addr.buf), addr.length);
freeaddrinfo(addrinfo);
RETURN result;
END Lookup;
PROCEDURE -socket(domain, type, protocol: LONGINT): LONGINT
"(LONGINT)socket((int)domain, (int)type, (int)protocol)";
PROCEDURE Socket*(domain, type: LONGINT; VAR fd: LONGINT): Platform.ErrorCode;
BEGIN
fd := socket(domain, type, 0); (* No supported domain needs a non-zero protocol *)
IF fd < 0 THEN RETURN Platform.Error() END;
RETURN 0;
END Socket;
PROCEDURE -bind(sockfd: LONGINT; addr, addrlen: LONGINT): INTEGER
"(INTEGER)bind((int)sockfd, (const struct sockaddr*)addr, (socklen_t)addrlen)";
PROCEDURE Bind*(sockfd: LONGINT; address: SocketAddress): Platform.ErrorCode;
BEGIN
IF bind(sockfd, SYSTEM.ADR(address.buf), address.length) < 0 THEN RETURN Platform.Error() END;
RETURN 0;
END Bind;
PROCEDURE -listen(sockfd, backlog: LONGINT): INTEGER
"(INTEGER)listen((int)sockfd, (int)backlog)";
PROCEDURE Listen*(sockfd, backlog: LONGINT): INTEGER;
BEGIN RETURN listen(sockfd, backlog)
END Listen;
PROCEDURE -accept(sockfd: LONGINT; addr, addrlen: LONGINT): LONGINT
"(LONGINT)accept((int)sockfd, (struct sockaddr*)addr, (socklen_t*)addrlen)";
PROCEDURE Accept*(sockfd: LONGINT; VAR address: SocketAddress; VAR newfd: LONGINT): Platform.ErrorCode;
BEGIN
address.length := LEN(address.buf);
newfd := accept(sockfd, SYSTEM.ADR(address.buf), SYSTEM.ADR(address.length));
IF newfd < 0 THEN RETURN Platform.Error() END;
RETURN 0
END Accept;
PROCEDURE -connect(sockfd, addr, length: LONGINT): INTEGER
"(INTEGER)connect((int)sockfd, (struct sockaddr*)addr, (socklen_t)length)";
PROCEDURE Connect*(sockfd: LONGINT; addr: SocketAddress): Platform.ErrorCode;
BEGIN
IF connect(sockfd, SYSTEM.ADR(addr.buf), addr.length) < 0 THEN RETURN Platform.Error() END;
RETURN 0;
END Connect;
PROCEDURE -recvfrom(sockfd, buf, buflen, flags, saddr: LONGINT; socklen: LONGINT): INTEGER
"(INTEGER)recvfrom((int)sockfd, (void*)buf, (size_t)buflen, (int)flags, (struct sockaddr*)saddr, (socklen_t*)socklen)";
PROCEDURE ReceiveFrom*(
sockfd: LONGINT;
VAR buf: ARRAY OF SYSTEM.BYTE; VAR length: LONGINT;
flags: LONGINT;
VAR sockaddr: SocketAddress
): Platform.ErrorCode;
BEGIN
sockaddr.length := LEN(sockaddr.buf);
length := recvfrom(
sockfd,
SYSTEM.ADR(buf), LEN(buf),
flags,
SYSTEM.ADR(sockaddr.buf), SYSTEM.ADR(sockaddr.length)
);
IF length < 0 THEN RETURN Platform.Error() END;
RETURN 0;
END ReceiveFrom;
PROCEDURE -sendto(sockfd, buf, len, flags, addr, addrlen: LONGINT): LONGINT
"(LONGINT)sendto((int)sockfd, (void*)buf, (size_t)len, (int)flags, (struct sockaddr*)addr, (socklen_t)addrlen)";
PROCEDURE SendTo*(sockfd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE; buflen, flags: LONGINT; addr: SocketAddress): Platform.ErrorCode;
BEGIN
IF sendto(sockfd, SYSTEM.ADR(buf), buflen, flags, SYSTEM.ADR(addr.buf), addr.length) < 0 THEN
RETURN Platform.Error()
ELSE
RETURN 0
END
END SendTo;
PROCEDURE -FDZERO(VAR fds: FDset) "FD_ZERO((fd_set*)fds)";
PROCEDURE ZeroFDs*(VAR fds: FDset); BEGIN FDZERO(fds) END ZeroFDs;
PROCEDURE -FDCLR(i: LONGINT; VAR fds: FDset) "FD_CLR((int)i, (fd_set*)fds)";
PROCEDURE ClearFD*(i: LONGINT; VAR fds: FDset); BEGIN FDCLR(i, fds) END ClearFD;
PROCEDURE -FDSET(i: LONGINT; VAR fds: FDset) "FD_SET((int)i, (fd_set*)fds)";
PROCEDURE SetFD*(i: LONGINT; VAR fds: FDset); BEGIN FDSET(i, fds) END SetFD;
PROCEDURE -FDISSET(i: LONGINT; VAR fds: FDset): INTEGER "(INTEGER)FD_ISSET((int)i, (fd_set*)fds)";
PROCEDURE FDisSet*(i: LONGINT; VAR fds: FDset): BOOLEAN;
BEGIN RETURN FDISSET(i, fds) # 0 END FDisSet;
PROCEDURE -SizeofFdSet(): LONGINT "(LONGINT)sizeof(fd_set)";
PROCEDURE -timeval(ms: LONGINT) "struct timeval tv = {ms/1000, (ms%1000)*1000}";
PROCEDURE -select(socketLimit: LONGINT; VAR read, write, except: FDset): LONGINT
"select((int)socketLimit, (fd_set*)read, (fd_set*)write, (fd_set*)except, &tv)";
PROCEDURE Select*(socketLimit: LONGINT; VAR read, write, except: FDset; ms: LONGINT; VAR readycount: LONGINT): Platform.ErrorCode;
BEGIN
timeval(ms);
readycount := select(socketLimit, read, write, except);
IF readycount < 0 THEN readycount := 0; RETURN Platform.Error() END;
RETURN 0
END Select;
BEGIN
ASSERT(SIZE(FDset) >= SizeofFdSet());
v4 := AFINET();
v6 := AFINET6();
Stream := SOCKSTREAM();
Datagram := SOCKDGRAM();
END IP.

View file

@ -0,0 +1,219 @@
MODULE TestClient;
IMPORT IP, Platform, Console, Strings, SYSTEM;
CONST
ServerName = "gan.brownsmeet.com";
ServerPort = "2055";
TYPE
LineBuffer = RECORD
text: ARRAY 4096 OF CHAR;
length: INTEGER;
CR: BOOLEAN
END;
VAR
Socket: Platform.FileHandle;
Server: IP.SocketAddress;
Param: ARRAY 1024 OF CHAR;
Buffer: LineBuffer;
(* Console output convenience APIs *)
PROCEDURE cs(s: ARRAY OF CHAR);
(* Oberon07 compatible variant of Console.String (LEN(s) safe). *)
VAR i: LONGINT;
BEGIN
i := 0; WHILE (i<LEN(s)) & (s[i] # 0X) DO Console.Char(s[i]); INC(i) END
END cs;
PROCEDURE ci (i,w: LONGINT); BEGIN Console.Int(i,w) END ci;
PROCEDURE cl; BEGIN cs(Platform.nl) END cl;
PROCEDURE csl(s: ARRAY OF CHAR); BEGIN cs(s); cl END csl;
PROCEDURE ErrorCheck(err: Platform.ErrorCode; msg: ARRAY OF CHAR);
BEGIN
IF err # 0 THEN
csl("exit;");
cs(msg); ci(err,1); cl; HALT(1);
END
END ErrorCheck;
(* Line buffer output APIs *)
PROCEDURE InitBuffer;
BEGIN
Buffer.text := '';
Buffer.length := 0;
Buffer.CR := FALSE;
END InitBuffer;
PROCEDURE AddChar(c: CHAR);
BEGIN IF Buffer.length < LEN(Buffer.text) THEN Buffer.text[Buffer.length] := c; INC(Buffer.length) END
END AddChar;
PROCEDURE AddString(s: ARRAY OF CHAR);
VAR i: LONGINT;
BEGIN i := 0;
WHILE (Buffer.length < LEN(Buffer.text)) & (i < LEN(s)) & (s[i] # 0X) DO
Buffer.text[Buffer.length] := s[i];
INC(Buffer.length);
INC(i)
END
END AddString;
PROCEDURE FlushLine;
VAR i: INTEGER;
BEGIN
AddChar(0AX); Buffer.text[LEN(Buffer.text)-1] := 0AX; (* Force EOLN even on overflow *)
ErrorCheck(Platform.Write(Socket, SYSTEM.ADR(Buffer.text), Buffer.length), "Failed to write log to network: ");
ErrorCheck(Platform.Write(Platform.StdOut, SYSTEM.ADR(Buffer.text), Buffer.length), "Failed to write log to stdout: ");
InitBuffer
END FlushLine;
PROCEDURE TwoDigits(i: LONGINT);
BEGIN AddChar(CHR(48 + i DIV 10 MOD 10)); AddChar(CHR(48 + i MOD 10));
END TwoDigits;
PROCEDURE Timestamp;
VAR t, d: LONGINT;
BEGIN
AddString(Param); AddChar(' ');
Platform.GetClock(t,d);
TwoDigits(ASH(t, -12)); AddChar('.');
TwoDigits(ASH(t, -6) MOD 64); AddChar('.');
TwoDigits(t MOD 64); AddString(': ');
END Timestamp;
PROCEDURE LogCharacter(c: CHAR);
BEGIN
IF Buffer.length = 0 THEN Timestamp END;
IF Buffer.CR OR (c = 0AX) THEN FlushLine END;
CASE c OF
0DX: Buffer.CR := TRUE
| 0AX:
ELSE AddChar(c)
END
END LogCharacter;
PROCEDURE FlushLog;
BEGIN IF (Buffer.length # 0) OR Buffer.CR THEN FlushLine END
END FlushLog;
(* Debugging ... *)
PROCEDURE ec(c: CHAR); VAR err: Platform.ErrorCode;
BEGIN err := Platform.Write(Platform.StdErr, SYSTEM.ADR(c), 1) END ec;
PROCEDURE es(s: ARRAY OF CHAR); VAR i: INTEGER;
BEGIN i := 0; WHILE (i < LEN(s)) & (s[i] # 0X) DO ec(s[i]); INC(i) END END es;
PROCEDURE esl(s: ARRAY OF CHAR); BEGIN es(s); es(Platform.nl) END esl;
PROCEDURE eu(l: LONGINT); (* Unsigned (i.e. positive) integer *)
BEGIN IF l>10 THEN eu(l DIV 10) END; ec(CHR(ORD('0') + (l MOD 10))) END eu;
PROCEDURE ei(l: LONGINT);
BEGIN IF l<0 THEN ec('-'); l := -l END; eu(l) END ei;
PROCEDURE ConnectSocket;
VAR err: Platform.ErrorCode;
BEGIN
err := IP.Connect(Socket, Server);
WHILE Platform.ConnectionFailed(err) OR Platform.TimedOut(err) DO
es("Waiting for coordinator, error code: "); ei(err); esl(".");
Platform.Delay(30000);
err := IP.Connect(Socket, Server);
END;
ErrorCheck(err, "Couldn't connect to server: ");
END ConnectSocket;
PROCEDURE LogStdIn;
VAR i, n: LONGINT; inbuf: ARRAY 8192 OF CHAR;
BEGIN
ConnectSocket;
ErrorCheck(Platform.ReadBuf(Platform.StdIn, inbuf, n), "Failure reading standard input: ");
InitBuffer;
WHILE n > 0 DO
i := 0;
WHILE i < n DO LogCharacter(inbuf[i]); INC(i) END;
ErrorCheck(Platform.ReadBuf(Platform.StdIn, inbuf, n), "Failure reading standard input: ");
END;
FlushLog;
END LogStdIn;
PROCEDURE SendString(s: ARRAY OF CHAR);
BEGIN
ErrorCheck(Platform.Write(Socket, SYSTEM.ADR(s), Strings.Length(s)),
"Failed to write string to socket: ");
END SendString;
PROCEDURE SendStrings(s1, s2: ARRAY OF CHAR);
VAR buf: ARRAY 4096 OF CHAR;
BEGIN COPY(s1, buf); Strings.Append(s2, buf); SendString(buf)
END SendStrings;
PROCEDURE Continue;
BEGIN ConnectSocket; SendStrings("-continue ", Param)
END Continue;
PROCEDURE Wait;
VAR buf: ARRAY 64 OF CHAR; n: LONGINT; err: Platform.ErrorCode; waiting: BOOLEAN;
BEGIN
waiting := TRUE;
WHILE waiting DO
ConnectSocket; SendStrings("-wait ", Param);
ErrorCheck(Platform.ReadBuf(Socket, buf, n), "Failed to read command from test coordinator: ");
waiting := n <= 0 (* n=0 => coordinator was terminated *)
END;
IF n < LEN(buf) THEN buf[n] := 0X END;
es("Received command: '"); es(buf); esl("'.");
csl(buf);
IF buf = "exit" THEN Platform.Exit(1) END
END Wait;
PROCEDURE Help;
BEGIN
cl;
csl("TestClient - test log client"); cl;
csl("usage:"); cl;
csl(" command | TestClient -s id - Send command output identified by id.");
csl(" TestClient -w id - wait until TestClient -c runs somewhere.");
csl(" TestClient -c - continue all pending TestClient -w commands.");
Platform.Exit(0);
END Help;
PROCEDURE ParseParameters;
VAR option: ARRAY 1024 OF CHAR;
BEGIN
IF Platform.ArgCount > 1 THEN Platform.GetArg(1, option) END;
IF Platform.ArgCount = 3 THEN Platform.GetArg(2, Param) END;
IF (Platform.ArgCount = 3) & (option = "-w") THEN Wait
ELSIF (Platform.ArgCount = 3) & (option = "-c") THEN Continue
ELSIF (Platform.ArgCount = 3) & (option = "-s") THEN LogStdIn
ELSE Help
END
END ParseParameters;
BEGIN
ErrorCheck(IP.Socket(IP.v4, IP.Stream, Socket), "Couldn't create sender socket: ");
ErrorCheck(IP.Lookup(ServerName, ServerPort, IP.v4, IP.Stream, Server),
"Couldn't lookup server socket address: ");
ParseParameters;
ErrorCheck(Platform.Close(Socket), "Couldn't close socket: ")
END TestClient.

View file

@ -0,0 +1,270 @@
MODULE TestCoordinator;
(*
Listens for client test machines, telling them when to start tests and recording
status and log data that they send.
Also listens to command machine that says when to start a new set of tests.
*)
IMPORT IP, Platform, SYSTEM, Console, Strings;
CONST
ListenPort = "2055";
CoIdle = 0;
CoConnected = 1;
CoUnderway = 2;
CoWaiting = 3;
TYPE
Connection = POINTER TO ConnectionState;
ConnectionState = RECORD
fd: LONGINT; (* Socket descriptor *)
state: INTEGER; (* CoIdle / CoConnected / CoWaiting *)
file: Platform.FileHandle;
text: ARRAY 4096 OF CHAR;
length: INTEGER;
CR: BOOLEAN;
END;
VAR
MaxSocket: LONGINT;
Listener: LONGINT;
Connections: ARRAY IP.FDcount OF Connection;
(* Console output convenience APIs *)
PROCEDURE cs (s: ARRAY OF CHAR);
(* Oberon07 compatible variant of Console.String (LEN(s) safe). *)
VAR i: LONGINT;
BEGIN
i := 0; WHILE (i<LEN(s)) & (s[i] # 0X) DO Console.Char(s[i]); INC(i) END;
END cs;
PROCEDURE ci(i,w: LONGINT); BEGIN Console.Int(i,w) END ci;
PROCEDURE ch(i: LONGINT); BEGIN Console.Hex(i) END ch;
PROCEDURE cc(c: CHAR); BEGIN Console.Char(c) END cc;
PROCEDURE cl; BEGIN cs(Platform.nl) END cl;
PROCEDURE csl(s: ARRAY OF CHAR); BEGIN cs(s); cl END csl;
PROCEDURE ErrorCheck(err: Platform.ErrorCode; msg: ARRAY OF CHAR);
(* OS API wrapper for when no error is expected. *)
BEGIN IF err # 0 THEN cs(msg); ci(err,1); cl; HALT(1) END
END ErrorCheck;
(* Connection management APIs *)
PROCEDURE InitConnection(fd: LONGINT);
VAR co: Connection;
BEGIN
IF Connections[fd] = NIL THEN NEW(Connections[fd]) END;
co := Connections[fd];
co.fd := fd;
co.state := CoConnected;
co.file := 0;
co.text := '';
co.length := 0;
co.CR := FALSE;
END InitConnection;
PROCEDURE OpenLogFile(co: Connection);
VAR filename: ARRAY 1024 OF CHAR; i: INTEGER;
BEGIN
ASSERT(co.file = 0);
i := 0;
WHILE (i < LEN(co.text)) & (i < LEN(filename)-1) & (co.text[i] # ' ') & (co.text[i] # 0X) DO
filename[i] := co.text[i]; INC(i);
END;
IF i = 0 THEN filename := "unnamed" ELSE filename[i] := 0X END;
cs("Connected to "); cs(filename); cs(" build on fd "); ci(co.fd,1); csl(".");
Strings.Append(".log", filename);
IF Platform.Absent(Platform.OldRW(filename, co.file)) THEN
ErrorCheck(Platform.New(filename, co.file), "Couldn't create log file: ")
ELSE
ErrorCheck(Platform.Seek(co.file, 0, Platform.SeekEnd), "Couldn't position exisiting log file at end: ")
END;
END OpenLogFile;
PROCEDURE FlushLine(co: Connection);
BEGIN
IF co.file = 0 THEN OpenLogFile(co) END;
ErrorCheck(Platform.Write(co.file, SYSTEM.ADR(co.text), co.length), "Failed to write to log file: ");
ErrorCheck(Platform.Write(co.file, SYSTEM.ADR(Platform.nl), Strings.Length(Platform.nl)), "Failed to write to log file: ");
co.length := 0;
co.CR := FALSE;
END FlushLine;
PROCEDURE lc(co: Connection; c: CHAR);
BEGIN
(* IF (co.length = 0) & ~co.CR THEN <do something at start of line time> END; *)
IF co.CR OR (c = 0AX) THEN FlushLine(co) END;
CASE c OF
0DX: co.CR := TRUE
| 0AX:
ELSE co.text[co.length] := c; INC(co.length)
END
END lc;
PROCEDURE ls(co: Connection; s: ARRAY OF CHAR);
VAR i: LONGINT;
BEGIN i := 0; WHILE (i < LEN(s)) & (s[i] # 0X) DO lc(co, s[i]); INC(i) END
END ls;
PROCEDURE AcceptConnection;
VAR
Them: IP.SocketAddress;
fd: LONGINT;
BEGIN
ErrorCheck(IP.Accept(Listener, Them, fd), "Accept failed: ");
IF fd > MaxSocket THEN MaxSocket := fd END;
InitConnection(fd);
(* TODO: Set fd as non-blocking: O_NONBLOCK and fcntl(). *)
END AcceptConnection;
PROCEDURE Continue(co: Connection; param: ARRAY OF CHAR);
VAR msg: ARRAY 10 OF CHAR; err: Platform.ErrorCode;
BEGIN
cs("Starting fd "); ci(co.fd,1); cl;
msg := "Go.";
ErrorCheck(Platform.Write(co.fd, SYSTEM.ADR(param), Strings.Length(param)), "Couldn't send continue message: ");
ErrorCheck(Platform.Close(co.fd), "Couldn't close waiting socket: ");
co.fd := 0;
co.state := CoIdle;
END Continue;
PROCEDURE ParseWord(buf: ARRAY OF CHAR; VAR i: INTEGER; VAR word: ARRAY OF CHAR);
VAR j: INTEGER;
BEGIN
END ParseWord;
PROCEDURE Command(co: Connection; buf: ARRAY OF CHAR);
VAR cmd, param: ARRAY 1024 OF CHAR; i,j: INTEGER;
BEGIN
i := 0;
(* The command is everything up to the first space *)
WHILE (i<LEN(buf)) & (buf[i] = ' ') DO INC(i) END;
j := 0;
WHILE (i<LEN(buf)) & (j<LEN(cmd)) & (ORD(buf[i]) > 32) DO
cmd[j] := buf[i]; INC(i); INC(j)
END;
IF j < LEN(cmd) THEN cmd[j] := 0X END;
(* The parameter is everything else (except leading spaces). *)
WHILE (i<LEN(buf)) & (buf[i] = ' ') DO INC(i) END;
j := 0;
WHILE (i<LEN(buf)) & (j<LEN(param)) & (buf[i] # 0X) DO
param[j] := buf[i]; INC(i); INC(j)
END;
IF j < LEN(param) THEN param[j] := 0X END;
IF cmd = "-wait" THEN
co.state := CoWaiting; cs(param); cs(" waiting on fd "); ci(co.fd,1); csl(".");
ELSIF cmd = "-continue" THEN
i := 0;
WHILE i < MaxSocket DO
IF (Connections[i] # NIL) & (Connections[i].state = CoWaiting) THEN
Continue(Connections[i], param)
END;
INC(i)
END
ELSE
ls(co, buf)
END
END Command;
PROCEDURE DataReceived(co: Connection; VAR buf: ARRAY OF CHAR; n: LONGINT);
BEGIN
IF co # NIL THEN
IF n < LEN(buf) THEN buf[n] := 0X END;
IF (co.state = CoConnected) & (buf[0] = '-') THEN
Command(co, buf)
ELSE
co.state := CoUnderway; ls(co, buf)
END
END
END DataReceived;
PROCEDURE ConnectionClosed(co: Connection);
BEGIN
IF co # NIL THEN
IF co.state = CoWaiting THEN cs("fd "); ci(co.fd,1); csl(" closed.") END;
ErrorCheck(Platform.Close(co.fd), "Failed to close connection: ");
co.fd := 0;
IF co.length > 0 THEN FlushLine(co) END;
IF co.file # 0 THEN
ErrorCheck(Platform.Close(co.file), "Failed to close connection log file: ");
END;
co.state := CoIdle;
co.file := 0;
END
END ConnectionClosed;
PROCEDURE Cycle;
VAR
Us: IP.SocketAddress;
err: Platform.ErrorCode;
n: LONGINT;
rbuf: ARRAY 4100 OF CHAR;
i: LONGINT;
waitcount: LONGINT;
readFDs: IP.FDset;
noFDs: IP.FDset;
co: Connection;
BEGIN
IP.ZeroFDs(noFDs);
ErrorCheck(IP.Socket(IP.v4, IP.Stream, Listener), "Couldn't create listener socket: ");
ErrorCheck(IP.Lookup("", ListenPort, IP.v4, IP.Stream, Us), "Couldn't lookup our own socket address: ");
ErrorCheck(IP.Bind (Listener, Us), "Bind failed: ");
ErrorCheck(IP.Listen(Listener, 10), "Listen failed: ");
csl("Test coordinator listening for test clients.");
MaxSocket := Listener;
LOOP
(* Prepare select parameters *)
IP.ZeroFDs(readFDs);
IP.SetFD(Listener, readFDs);
i := 0; WHILE i <= MaxSocket DO
co := Connections[i];
IF (co # NIL) & (co.state >= CoConnected) THEN IP.SetFD(i, readFDs) END;
INC(i) END;
(* Wait for some fd to need servicing, or 60 seconds. *)
ErrorCheck(IP.Select(MaxSocket+1, readFDs, noFDs, noFDs, 60000, waitcount), "Wait for next service activity failed: ");
IF waitcount > 0 THEN
i := 0;
WHILE i <= MaxSocket DO
IF IP.FDisSet(i, readFDs) THEN
IF i = Listener THEN
AcceptConnection;
ELSE
ErrorCheck(Platform.ReadBuf(i, rbuf, n), "ReadBuf failed: ");
IF n = 0 THEN
ConnectionClosed(Connections[i]); (* Client has closed the connection in an orderly manner. *)
ELSE
DataReceived(Connections[i], rbuf, n)
END
END
END;
INC(i)
END
END
END;
err := Platform.Close(Listener)
END Cycle;
BEGIN
Cycle;
END TestCoordinator.

View file

@ -1,78 +0,0 @@
/* J. Templ 23.6.95
this program tests and outputs important characteristics of
the C compiler and SYSTEM.h file used to compile it.
The output of this program is accepted by voc as file voc.par.
% cc vocparam.c; a.out > voc.par
*/
#include "SYSTEM.h"
#include "stdio.h"
struct {CHAR ch; CHAR x;} c;
struct {CHAR ch; BOOLEAN x;} b;
struct {CHAR ch; SHORTINT x;} si;
struct {CHAR ch; INTEGER x;} i;
struct {CHAR ch; LONGINT x;} li;
struct {CHAR ch; SYSTEM_INT8 x;} i8;
struct {CHAR ch; SYSTEM_INT16 x;} i16;
struct {CHAR ch; SYSTEM_INT32 x;} i32;
struct {CHAR ch; SYSTEM_INT64 x;} i64;
struct {CHAR ch; SET x;} s;
struct {CHAR ch; REAL x;} r;
struct {CHAR ch; LONGREAL x;} lr;
struct {CHAR ch; void *x;} p;
struct {CHAR ch; void (*x)();} f;
struct {CHAR ch;} rec0;
struct {CHAR ch; LONGREAL x;} rec1;
struct {char x[65];} rec2;
int main()
{
long x, y;
/* get size and alignment of standard types */
printf("CHAR %lu %lu\n", sizeof(CHAR), (char*)&c.x - (char*)&c);
printf("BOOLEAN %lu %lu\n", sizeof(BOOLEAN), (char*)&b.x - (char*)&b);
printf("SHORTINT %lu %lu\n", sizeof(SHORTINT), (char*)&si.x - (char*)&si);
printf("INTEGER %lu %lu\n", sizeof(INTEGER), (char*)&i.x - (char*)&i);
printf("LONGINT %lu %lu\n", sizeof(LONGINT), (char*)&li.x - (char*)&li);
printf("SET %lu %lu\n", sizeof(SET), (char*)&s.x - (char*)&s);
printf("REAL %lu %lu\n", sizeof(REAL), (char*)&r.x - (char*)&r);
printf("LONGREAL %lu %lu\n", sizeof(LONGREAL), (char*)&lr.x - (char*)&lr);
printf("PTR %lu %lu\n", sizeof p.x, (char*)&p.x - (char*)&p);
printf("PROC %lu %lu\n", sizeof f.x, (char*)&f.x - (char*)&f);
printf("RECORD %d %lu\n", (sizeof rec2 == 65) == (sizeof rec0 == 1), sizeof rec2 - 64);
x = 1;
printf("ENDIAN %hhd %d\n", *(char*)&x, 0);
printf("SYSTEM.INT8 %lu %lu\n", sizeof(SYSTEM_INT8), (char*)&i8.x - (char*)&i8);
printf("SYSTEM.INT16 %lu %lu\n", sizeof(SYSTEM_INT16), (char*)&i16.x - (char*)&i16);
printf("SYSTEM.INT32 %lu %lu\n", sizeof(SYSTEM_INT32), (char*)&i32.x - (char*)&i32);
printf("SYSTEM.INT64 %lu %lu\n", sizeof(SYSTEM_INT64), (char*)&i64.x - (char*)&i64);
if (sizeof(CHAR)!=1) printf("error: CHAR should have size 1\n");
if (sizeof(BOOLEAN)!=1) printf("error: BOOLEAN should have size 1\n");
if (sizeof(SHORTINT)!=1) printf("error: SHORTINT should have size 1\n");
if (sizeof(long)!=sizeof p.x) printf("error: LONGINT should have the same size as pointers\n");
if (sizeof(long)!=sizeof f.x) printf("error: LONGINT should have the same size as function pointers\n");
if (((sizeof rec2 == 65) == (sizeof rec0 == 1)) && ((sizeof rec2 - 64) != sizeof rec0))
printf("error: unsupported record layout sizeof rec0 = %lu sizeof rec2 = %lu\n", sizeof rec0, sizeof rec2);
/* test the __ASHR macro */
if (__ASHR(-1, 1) != -1) printf("error: ASH(-1, -1) # -1\n");
if (__ASHR(-2, 1) != -1) printf("error: ASH(-2, -1) # -1\n");
if (__ASHR(0, 1) != 0) printf("error: ASH(0, 1) # 0\n");
if (__ASHR(1, 1) != 0) printf("error: ASH(1, 1) # 0\n");
if (__ASHR(2, 1) != 1) printf("error: ASH(2, 1) # 1\n");
/* test the __SETRNG macro */
x = 0; y = sizeof(SET)*8 - 1;
if (__SETRNG(x, y) != -1) printf("error: SETRNG(0, MAX(SET)) != -1\n");
/* test string comparison for extended ascii */
{char a[10], b[10];
a[0] = (CHAR)128; a[1] = 0;
b[0] = 0;
if (__STRCMP(a, b) < 0) printf("error: __STRCMP(a, b) with extended ascii charcters; should be unsigned\n");
}
}