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

__DUP val params only when they could be written.

Browse source
This commit is contained in:
Dave Brown 2019-11-22 14:30:12 +00:00
parent 5cbbec255c
commit 37d7270824
196 changed files with 997 additions and 1891 deletions
Download patch file Download diff file Expand all files Collapse all files

4
bootstrap/unix-44/Compiler.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspamS */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspamS */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -89,7 +89,7 @@ static void Compiler_PropagateElementaryTypeSizes (void)
OPT_sintobj->typ = OPT_sinttyp; OPT_sintobj->typ = OPT_sinttyp;
OPT_intobj->typ = OPT_inttyp; OPT_intobj->typ = OPT_inttyp;
OPT_lintobj->typ = OPT_linttyp; OPT_lintobj->typ = OPT_linttyp;
switch (OPM_LongintSize) { switch (OPM_SetSize) {
case 4: case 4:
OPT_settyp = OPT_set32typ; OPT_settyp = OPT_set32typ;
break; break;

4
bootstrap/unix-44/Configuration.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -19,6 +19,6 @@ export void *Configuration__init(void)
__DEFMOD; __DEFMOD;
__REGMOD("Configuration", 0); __REGMOD("Configuration", 0);
/* BEGIN */ /* BEGIN */
__MOVE("2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 76); __MOVE("2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 76);
__ENDMOD; __ENDMOD;
} }

2
bootstrap/unix-44/Configuration.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Configuration__h #ifndef Configuration__h
#define Configuration__h #define Configuration__h

16
bootstrap/unix-44/Files.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -123,7 +123,6 @@ static void Files_Assert (BOOLEAN truth)
static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode) static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode)
{ {
__DUP(s, s__len, CHAR);
Out_Ln(); Out_Ln();
Out_String((CHAR*)"-- ", 4); Out_String((CHAR*)"-- ", 4);
Out_String(s, s__len); Out_String(s, s__len);
@ -145,14 +144,11 @@ static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode)
} }
Out_Ln(); Out_Ln();
__HALT(99); __HALT(99);
__DEL(s);
} }
static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS name__len, CHAR *dest, ADDRESS dest__len) static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS name__len, CHAR *dest, ADDRESS dest__len)
{ {
INT16 i, j, ld, ln; INT16 i, j, ld, ln;
__DUP(dir, dir__len, CHAR);
__DUP(name, name__len, CHAR);
ld = Strings_Length(dir, dir__len); ld = Strings_Length(dir, dir__len);
ln = Strings_Length(name, name__len); ln = Strings_Length(name, name__len);
while ((ld > 0 && dir[__X(ld - 1, dir__len)] == '/')) { while ((ld > 0 && dir[__X(ld - 1, dir__len)] == '/')) {
@ -177,14 +173,11 @@ static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS
j += 1; j += 1;
} }
dest[__X(i, dest__len)] = 0x00; dest[__X(i, dest__len)] = 0x00;
__DEL(dir);
__DEL(name);
} }
static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *name, ADDRESS name__len) static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *name, ADDRESS name__len)
{ {
INT16 i, n; INT16 i, n;
__DUP(finalName, finalName__len, CHAR);
if (finalName[0] == '/') { if (finalName[0] == '/') {
__COPY(finalName, name, name__len); __COPY(finalName, name, name__len);
} else { } else {
@ -219,7 +212,6 @@ static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *na
i += 1; i += 1;
} }
name[__X(i, name__len)] = 0x00; name[__X(i, name__len)] = 0x00;
__DEL(finalName);
} }
static void Files_Deregister (CHAR *name, ADDRESS name__len) static void Files_Deregister (CHAR *name, ADDRESS name__len)
@ -227,7 +219,6 @@ static void Files_Deregister (CHAR *name, ADDRESS name__len)
Platform_FileIdentity identity; Platform_FileIdentity identity;
Files_File osfile = NIL; Files_File osfile = NIL;
INT16 error; INT16 error;
__DUP(name, name__len, CHAR);
if (Platform_IdentifyByName(name, name__len, &identity, Platform_FileIdentity__typ) == 0) { if (Platform_IdentifyByName(name, name__len, &identity, Platform_FileIdentity__typ) == 0) {
osfile = (Files_File)Files_files; osfile = (Files_File)Files_files;
while ((osfile != NIL && !Platform_SameFile(osfile->identity, identity))) { while ((osfile != NIL && !Platform_SameFile(osfile->identity, identity))) {
@ -246,7 +237,6 @@ static void Files_Deregister (CHAR *name, ADDRESS name__len)
} }
} }
} }
__DEL(name);
} }
static void Files_Create (Files_File f) static void Files_Create (Files_File f)
@ -334,7 +324,6 @@ INT32 Files_Length (Files_File f)
Files_File Files_New (CHAR *name, ADDRESS name__len) Files_File Files_New (CHAR *name, ADDRESS name__len)
{ {
Files_File f = NIL; Files_File f = NIL;
__DUP(name, name__len, CHAR);
__NEW(f, Files_FileDesc); __NEW(f, Files_FileDesc);
f->workName[0] = 0x00; f->workName[0] = 0x00;
__COPY(name, f->registerName, 256); __COPY(name, f->registerName, 256);
@ -343,7 +332,6 @@ Files_File Files_New (CHAR *name, ADDRESS name__len)
f->len = 0; f->len = 0;
f->pos = 0; f->pos = 0;
f->swapper = -1; f->swapper = -1;
__DEL(name);
return f; return f;
} }
@ -1082,14 +1070,12 @@ static void Files_Finalize (SYSTEM_PTR o)
void Files_SetSearchPath (CHAR *path, ADDRESS path__len) void Files_SetSearchPath (CHAR *path, ADDRESS path__len)
{ {
__DUP(path, path__len, CHAR);
if (Strings_Length(path, path__len) != 0) { if (Strings_Length(path, path__len) != 0) {
Files_SearchPath = __NEWARR(NIL, 1, 1, 1, 1, ((ADDRESS)((Strings_Length(path, path__len) + 1)))); Files_SearchPath = __NEWARR(NIL, 1, 1, 1, 1, ((ADDRESS)((Strings_Length(path, path__len) + 1))));
__COPY(path, Files_SearchPath->data, Files_SearchPath->len[0]); __COPY(path, Files_SearchPath->data, Files_SearchPath->len[0]);
} else { } else {
Files_SearchPath = NIL; Files_SearchPath = NIL;
} }
__DEL(path);
} }
static void EnumPtrs(void (*P)(void*)) static void EnumPtrs(void (*P)(void*))

2
bootstrap/unix-44/Files.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Files__h #ifndef Files__h
#define Files__h #define Files__h

6
bootstrap/unix-44/Heap.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -151,7 +151,6 @@ SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs)
INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len) INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len)
{ {
Heap_Module m, p; Heap_Module m, p;
__DUP(name, name__len, CHAR);
m = (Heap_Module)(ADDRESS)Heap_modules; m = (Heap_Module)(ADDRESS)Heap_modules;
while ((m != NIL && __STRCMP(m->name, name) != 0)) { while ((m != NIL && __STRCMP(m->name, name) != 0)) {
p = m; p = m;
@ -163,14 +162,11 @@ INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len)
} else { } else {
p->next = m->next; p->next = m->next;
} }
__DEL(name);
return 0; return 0;
} else { } else {
if (m == NIL) { if (m == NIL) {
__DEL(name);
return -1; return -1;
} else { } else {
__DEL(name);
return m->refcnt; return m->refcnt;
} }
} }

2
bootstrap/unix-44/Heap.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */
#ifndef Heap__h #ifndef Heap__h
#define Heap__h #define Heap__h

37
bootstrap/unix-44/Modules.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -100,33 +100,28 @@ INT16 Modules_ArgPos (CHAR *s, ADDRESS s__len)
{ {
INT16 i; INT16 i;
CHAR arg[256]; CHAR arg[256];
__DUP(s, s__len, CHAR);
i = 0; i = 0;
Modules_GetArg(i, (void*)arg, 256); Modules_GetArg(i, (void*)arg, 256);
while ((i < Modules_ArgCount && __STRCMP(s, arg) != 0)) { while ((i < Modules_ArgCount && __STRCMP(s, arg) != 0)) {
i += 1; i += 1;
Modules_GetArg(i, (void*)arg, 256); Modules_GetArg(i, (void*)arg, 256);
} }
__DEL(s);
return i; return i;
} }
static INT16 Modules_CharCount (CHAR *s, ADDRESS s__len) static INT16 Modules_CharCount (CHAR *s, ADDRESS s__len)
{ {
INT16 i; INT16 i;
__DUP(s, s__len, CHAR);
i = 0; i = 0;
while ((i < s__len && s[__X(i, s__len)] != 0x00)) { while ((i < s__len && s[__X(i, s__len)] != 0x00)) {
i += 1; i += 1;
} }
__DEL(s);
return i; return i;
} }
static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len) static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
{ {
INT16 i, j; INT16 i, j;
__DUP(s, s__len, CHAR);
i = 0; i = 0;
j = Modules_CharCount(d, d__len); j = Modules_CharCount(d, d__len);
while (s[__X(i, s__len)] != 0x00) { while (s[__X(i, s__len)] != 0x00) {
@ -135,13 +130,11 @@ static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
j += 1; j += 1;
} }
d[__X(j, d__len)] = 0x00; d[__X(j, d__len)] = 0x00;
__DEL(s);
} }
static void Modules_AppendPart (CHAR c, CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len) static void Modules_AppendPart (CHAR c, CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
{ {
INT16 i, j; INT16 i, j;
__DUP(s, s__len, CHAR);
i = 0; i = 0;
j = Modules_CharCount(d, d__len); j = Modules_CharCount(d, d__len);
if ((j > 0 && d[__X(j - 1, d__len)] != c)) { if ((j > 0 && d[__X(j - 1, d__len)] != c)) {
@ -154,69 +147,54 @@ static void Modules_AppendPart (CHAR c, CHAR *s, ADDRESS s__len, CHAR *d, ADDRES
j += 1; j += 1;
} }
d[__X(j, d__len)] = 0x00; d[__X(j, d__len)] = 0x00;
__DEL(s);
} }
static BOOLEAN Modules_IsOneOf (CHAR c, CHAR *s, ADDRESS s__len) static BOOLEAN Modules_IsOneOf (CHAR c, CHAR *s, ADDRESS s__len)
{ {
INT16 i; INT16 i;
__DUP(s, s__len, CHAR);
if (c == 0x00) { if (c == 0x00) {
__DEL(s);
return 0; return 0;
} }
i = 0; i = 0;
while ((s[__X(i, s__len)] != c && s[__X(i, s__len)] != 0x00)) { while ((s[__X(i, s__len)] != c && s[__X(i, s__len)] != 0x00)) {
i += 1; i += 1;
} }
__DEL(s);
return s[__X(i, s__len)] == c; return s[__X(i, s__len)] == c;
} }
static BOOLEAN Modules_IsAbsolute (CHAR *d, ADDRESS d__len) static BOOLEAN Modules_IsAbsolute (CHAR *d, ADDRESS d__len)
{ {
__DUP(d, d__len, CHAR);
if (d[0] == 0x00) { if (d[0] == 0x00) {
__DEL(d);
return 0; return 0;
} }
if (Modules_IsOneOf(d[0], (CHAR*)"/\\", 3)) { if (Modules_IsOneOf(d[0], (CHAR*)"/\\", 3)) {
__DEL(d);
return 1; return 1;
} }
if (d[__X(1, d__len)] == ':') { if (d[__X(1, d__len)] == ':') {
__DEL(d);
return 1; return 1;
} }
__DEL(d);
return 0; return 0;
} }
static void Modules_Canonify (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len) static void Modules_Canonify (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
{ {
__DUP(s, s__len, CHAR);
if (Modules_IsAbsolute(s, s__len)) { if (Modules_IsAbsolute(s, s__len)) {
__COPY(s, d, d__len); __COPY(s, d, d__len);
} else { } else {
__COPY(Platform_CWD, d, d__len); __COPY(Platform_CWD, d, d__len);
Modules_AppendPart('/', s, s__len, (void*)d, d__len); Modules_AppendPart('/', s, s__len, (void*)d, d__len);
} }
__DEL(s);
} }
static BOOLEAN Modules_IsFilePresent (CHAR *s, ADDRESS s__len) static BOOLEAN Modules_IsFilePresent (CHAR *s, ADDRESS s__len)
{ {
Platform_FileIdentity identity; Platform_FileIdentity identity;
__DUP(s, s__len, CHAR);
__DEL(s);
return Platform_IdentifyByName(s, s__len, &identity, Platform_FileIdentity__typ) == 0; return Platform_IdentifyByName(s, s__len, &identity, Platform_FileIdentity__typ) == 0;
} }
static void Modules_ExtractPart (CHAR *s, ADDRESS s__len, INT16 *i, CHAR *p, ADDRESS p__len, CHAR *d, ADDRESS d__len) static void Modules_ExtractPart (CHAR *s, ADDRESS s__len, INT16 *i, CHAR *p, ADDRESS p__len, CHAR *d, ADDRESS d__len)
{ {
INT16 j; INT16 j;
__DUP(s, s__len, CHAR);
__DUP(p, p__len, CHAR);
j = 0; j = 0;
while ((s[__X(*i, s__len)] != 0x00 && !Modules_IsOneOf(s[__X(*i, s__len)], p, p__len))) { while ((s[__X(*i, s__len)] != 0x00 && !Modules_IsOneOf(s[__X(*i, s__len)], p, p__len))) {
d[__X(j, d__len)] = s[__X(*i, s__len)]; d[__X(j, d__len)] = s[__X(*i, s__len)];
@ -227,15 +205,12 @@ static void Modules_ExtractPart (CHAR *s, ADDRESS s__len, INT16 *i, CHAR *p, ADD
while (Modules_IsOneOf(s[__X(*i, s__len)], p, p__len)) { while (Modules_IsOneOf(s[__X(*i, s__len)], p, p__len)) {
*i += 1; *i += 1;
} }
__DEL(s);
__DEL(p);
} }
static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len) static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
{ {
INT16 i, j; INT16 i, j;
CHAR part[1024]; CHAR part[1024];
__DUP(s, s__len, CHAR);
i = 0; i = 0;
j = 0; j = 0;
while ((i < 2 && Modules_IsOneOf(s[__X(i, s__len)], (CHAR*)"/\\", 3))) { while ((i < 2 && Modules_IsOneOf(s[__X(i, s__len)], (CHAR*)"/\\", 3))) {
@ -250,7 +225,6 @@ static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
Modules_AppendPart('/', part, 1024, (void*)d, d__len); Modules_AppendPart('/', part, 1024, (void*)d, d__len);
} }
} }
__DEL(s);
} }
typedef typedef
@ -306,7 +280,6 @@ Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len)
Heap_Module m = NIL; Heap_Module m = NIL;
CHAR bodyname[64]; CHAR bodyname[64];
Heap_Command body; Heap_Command body;
__DUP(name, name__len, CHAR);
m = Modules_modules(); m = Modules_modules();
while ((m != NIL && __STRCMP(m->name, name) != 0)) { while ((m != NIL && __STRCMP(m->name, name) != 0)) {
m = m->next; m = m->next;
@ -321,14 +294,12 @@ Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len)
Modules_Append(name, name__len, (void*)Modules_resMsg, 256); Modules_Append(name, name__len, (void*)Modules_resMsg, 256);
Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256); Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256);
} }
__DEL(name);
return m; return m;
} }
Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len) Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len)
{ {
Heap_Cmd c = NIL; Heap_Cmd c = NIL;
__DUP(name, name__len, CHAR);
c = mod->cmds; c = mod->cmds;
while ((c != NIL && __STRCMP(c->name, name) != 0)) { while ((c != NIL && __STRCMP(c->name, name) != 0)) {
c = c->next; c = c->next;
@ -336,7 +307,6 @@ Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len
if (c != NIL) { if (c != NIL) {
Modules_res = 0; Modules_res = 0;
Modules_resMsg[0] = 0x00; Modules_resMsg[0] = 0x00;
__DEL(name);
return c->cmd; return c->cmd;
} else { } else {
Modules_res = 2; Modules_res = 2;
@ -346,7 +316,6 @@ Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len
Modules_Append((CHAR*)".", 2, (void*)Modules_resMsg, 256); Modules_Append((CHAR*)".", 2, (void*)Modules_resMsg, 256);
Modules_Append(name, name__len, (void*)Modules_resMsg, 256); Modules_Append(name, name__len, (void*)Modules_resMsg, 256);
Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256); Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256);
__DEL(name);
return NIL; return NIL;
} }
__RETCHK; __RETCHK;
@ -356,7 +325,6 @@ void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all)
{ {
Heap_Module m = NIL, p = NIL; Heap_Module m = NIL, p = NIL;
INT32 refcount; INT32 refcount;
__DUP(name, name__len, CHAR);
m = Modules_modules(); m = Modules_modules();
if (all) { if (all) {
Modules_res = 1; Modules_res = 1;
@ -374,7 +342,6 @@ void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all)
Modules_res = 1; Modules_res = 1;
} }
} }
__DEL(name);
} }
static void Modules_errch (CHAR c) static void Modules_errch (CHAR c)
@ -386,13 +353,11 @@ static void Modules_errch (CHAR c)
static void Modules_errstring (CHAR *s, ADDRESS s__len) static void Modules_errstring (CHAR *s, ADDRESS s__len)
{ {
INT32 i; INT32 i;
__DUP(s, s__len, CHAR);
i = 0; i = 0;
while ((i < s__len && s[__X(i, s__len)] != 0x00)) { while ((i < s__len && s[__X(i, s__len)] != 0x00)) {
Modules_errch(s[__X(i, s__len)]); Modules_errch(s[__X(i, s__len)]);
i += 1; i += 1;
} }
__DEL(s);
} }
static void Modules_errint (INT32 l) static void Modules_errint (INT32 l)

2
bootstrap/unix-44/Modules.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Modules__h #ifndef Modules__h
#define Modules__h #define Modules__h

277
bootstrap/unix-44/OPB.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -27,6 +27,7 @@ static void OPB_CheckProc (OPT_Struct x, OPT_Object y);
static void OPB_CheckPtr (OPT_Node x, OPT_Node y); static void OPB_CheckPtr (OPT_Node x, OPT_Node y);
static void OPB_CheckRealType (INT16 f, INT16 nr, OPT_Const x); static void OPB_CheckRealType (INT16 f, INT16 nr, OPT_Const x);
static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp); static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp);
static void OPB_CheckWrite (OPT_Node x);
static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y); static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y);
export void OPB_Construct (INT8 class, OPT_Node *x, OPT_Node y); export void OPB_Construct (INT8 class, OPT_Node *x, OPT_Node y);
static void OPB_Convert (OPT_Node *x, OPT_Struct typ); static void OPB_Convert (OPT_Node *x, OPT_Struct typ);
@ -101,9 +102,6 @@ OPT_Node OPB_NewLeaf (OPT_Object obj)
} }
node->obj = obj; node->obj = obj;
node->typ = obj->typ; node->typ = obj->typ;
if ((((obj->mode == 1 && __IN(obj->typ->comp, 0x0c, 32))) && obj->typ->sysflag != 0)) {
node->readonly = 1;
}
return node; return node;
} }
@ -359,16 +357,16 @@ void OPB_Field (OPT_Node *x, OPT_Object y)
} }
} }
static struct TypTest__58 { static struct TypTest__59 {
OPT_Node *x; OPT_Node *x;
OPT_Object *obj; OPT_Object *obj;
BOOLEAN *guard; BOOLEAN *guard;
struct TypTest__58 *lnk; struct TypTest__59 *lnk;
} *TypTest__58_s; } *TypTest__59_s;
static void GTT__59 (OPT_Struct t0, OPT_Struct t1); static void GTT__60 (OPT_Struct t0, OPT_Struct t1);
static void GTT__59 (OPT_Struct t0, OPT_Struct t1) static void GTT__60 (OPT_Struct t0, OPT_Struct t1)
{ {
OPT_Node node = NIL; OPT_Node node = NIL;
OPT_Struct t = NIL; OPT_Struct t = NIL;
@ -381,54 +379,54 @@ static void GTT__59 (OPT_Struct t0, OPT_Struct t1)
t1 = t1->BaseTyp; t1 = t1->BaseTyp;
} }
if (t1 == t0 || t0->form == 0) { if (t1 == t0 || t0->form == 0) {
if (*TypTest__58_s->guard) { if (*TypTest__59_s->guard) {
OPB_BindNodes(5, NIL, &*TypTest__58_s->x, NIL); OPB_BindNodes(5, NIL, &*TypTest__59_s->x, NIL);
(*TypTest__58_s->x)->readonly = (*TypTest__58_s->x)->left->readonly; (*TypTest__59_s->x)->readonly = (*TypTest__59_s->x)->left->readonly;
} else { } else {
node = OPT_NewNode(11); node = OPT_NewNode(11);
node->subcl = 16; node->subcl = 16;
node->left = *TypTest__58_s->x; node->left = *TypTest__59_s->x;
node->obj = *TypTest__58_s->obj; node->obj = *TypTest__59_s->obj;
*TypTest__58_s->x = node; *TypTest__59_s->x = node;
} }
} else { } else {
OPB_err(85); OPB_err(85);
} }
} else if (t0 != t1) { } else if (t0 != t1) {
OPB_err(85); OPB_err(85);
} else if (!*TypTest__58_s->guard) { } else if (!*TypTest__59_s->guard) {
if ((*TypTest__58_s->x)->class == 5) { if ((*TypTest__59_s->x)->class == 5) {
node = OPT_NewNode(11); node = OPT_NewNode(11);
node->subcl = 16; node->subcl = 16;
node->left = *TypTest__58_s->x; node->left = *TypTest__59_s->x;
node->obj = *TypTest__58_s->obj; node->obj = *TypTest__59_s->obj;
*TypTest__58_s->x = node; *TypTest__59_s->x = node;
} else { } else {
*TypTest__58_s->x = OPB_NewBoolConst(1); *TypTest__59_s->x = OPB_NewBoolConst(1);
} }
} }
} }
void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard) void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
{ {
struct TypTest__58 _s; struct TypTest__59 _s;
_s.x = x; _s.x = x;
_s.obj = &obj; _s.obj = &obj;
_s.guard = &guard; _s.guard = &guard;
_s.lnk = TypTest__58_s; _s.lnk = TypTest__59_s;
TypTest__58_s = &_s; TypTest__59_s = &_s;
if (OPB_NotVar(*x)) { if (OPB_NotVar(*x)) {
OPB_err(112); OPB_err(112);
} else if ((*x)->typ->form == 11) { } else if ((*x)->typ->form == 11) {
if (((*x)->typ->BaseTyp->comp != 4 && (*x)->typ != OPT_sysptrtyp)) { if (((*x)->typ->BaseTyp->comp != 4 && (*x)->typ != OPT_sysptrtyp)) {
OPB_err(85); OPB_err(85);
} else if (obj->typ->form == 11) { } else if (obj->typ->form == 11) {
GTT__59((*x)->typ->BaseTyp, obj->typ->BaseTyp); GTT__60((*x)->typ->BaseTyp, obj->typ->BaseTyp);
} else { } else {
OPB_err(86); OPB_err(86);
} }
} else if (((((*x)->typ->comp == 4 && (*x)->class == 1)) && obj->typ->comp == 4)) { } else if (((((*x)->typ->comp == 4 && (*x)->class == 1)) && obj->typ->comp == 4)) {
GTT__59((*x)->typ, obj->typ); GTT__60((*x)->typ, obj->typ);
} else { } else {
OPB_err(87); OPB_err(87);
} }
@ -437,7 +435,7 @@ void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
} else { } else {
(*x)->typ = OPT_booltyp; (*x)->typ = OPT_booltyp;
} }
TypTest__58_s = _s.lnk; TypTest__59_s = _s.lnk;
} }
void OPB_In (OPT_Node *x, OPT_Node y) void OPB_In (OPT_Node *x, OPT_Node y)
@ -501,13 +499,13 @@ static void OPB_CheckRealType (INT16 f, INT16 nr, OPT_Const x)
x->intval = -1; x->intval = -1;
} }
static struct MOp__28 { static struct MOp__29 {
struct MOp__28 *lnk; struct MOp__29 *lnk;
} *MOp__28_s; } *MOp__29_s;
static OPT_Node NewOp__29 (INT8 op, OPT_Struct typ, OPT_Node z); static OPT_Node NewOp__30 (INT8 op, OPT_Struct typ, OPT_Node z);
static OPT_Node NewOp__29 (INT8 op, OPT_Struct typ, OPT_Node z) static OPT_Node NewOp__30 (INT8 op, OPT_Struct typ, OPT_Node z)
{ {
OPT_Node node = NIL; OPT_Node node = NIL;
node = OPT_NewNode(11); node = OPT_NewNode(11);
@ -522,9 +520,9 @@ void OPB_MOp (INT8 op, OPT_Node *x)
INT16 f; INT16 f;
OPT_Struct typ = NIL; OPT_Struct typ = NIL;
OPT_Node z = NIL; OPT_Node z = NIL;
struct MOp__28 _s; struct MOp__29 _s;
_s.lnk = MOp__28_s; _s.lnk = MOp__29_s;
MOp__28_s = &_s; MOp__29_s = &_s;
z = *x; z = *x;
if (z->class == 8 || z->class == 9) { if (z->class == 8 || z->class == 9) {
OPB_err(126); OPB_err(126);
@ -538,7 +536,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
z->conval->intval = OPB_BoolToInt(!OPB_IntToBool(z->conval->intval)); z->conval->intval = OPB_BoolToInt(!OPB_IntToBool(z->conval->intval));
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__29(op, typ, z); z = NewOp__30(op, typ, z);
} }
} else { } else {
OPB_err(98); OPB_err(98);
@ -570,7 +568,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
} }
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__29(op, typ, z); z = NewOp__30(op, typ, z);
} }
} else { } else {
OPB_err(97); OPB_err(97);
@ -591,7 +589,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
} }
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__29(op, typ, z); z = NewOp__30(op, typ, z);
} }
} else { } else {
OPB_err(111); OPB_err(111);
@ -603,7 +601,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
z->conval->intval = (INT16)__CAP(__CHR(z->conval->intval)); z->conval->intval = (INT16)__CAP(__CHR(z->conval->intval));
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__29(op, typ, z); z = NewOp__30(op, typ, z);
} }
} else { } else {
OPB_err(111); OPB_err(111);
@ -616,7 +614,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
z->conval->intval = OPB_BoolToInt(__ODD(z->conval->intval)); z->conval->intval = OPB_BoolToInt(__ODD(z->conval->intval));
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__29(op, typ, z); z = NewOp__30(op, typ, z);
} }
} else { } else {
OPB_err(111); OPB_err(111);
@ -629,7 +627,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
f = 8; f = 8;
} }
if (z->class < 7 || f == 8) { if (z->class < 7 || f == 8) {
z = NewOp__29(op, typ, z); z = NewOp__30(op, typ, z);
} else { } else {
OPB_err(127); OPB_err(127);
} }
@ -638,7 +636,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
case 25: case 25:
if ((f == 4 && z->class == 7)) { if ((f == 4 && z->class == 7)) {
if ((0 <= z->conval->intval && z->conval->intval <= -1)) { if ((0 <= z->conval->intval && z->conval->intval <= -1)) {
z = NewOp__29(op, typ, z); z = NewOp__30(op, typ, z);
} else { } else {
OPB_err(219); OPB_err(219);
} }
@ -655,7 +653,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
} }
} }
*x = z; *x = z;
MOp__28_s = _s.lnk; MOp__29_s = _s.lnk;
} }
static void OPB_CheckPtr (OPT_Node x, OPT_Node y) static void OPB_CheckPtr (OPT_Node x, OPT_Node y)
@ -742,65 +740,65 @@ static void OPB_CheckProc (OPT_Struct x, OPT_Object y)
} }
} }
static struct ConstOp__13 { static struct ConstOp__14 {
OPT_Node *x; OPT_Node *x;
INT16 *f; INT16 *f;
OPT_Const *xval, *yval; OPT_Const *xval, *yval;
struct ConstOp__13 *lnk; struct ConstOp__14 *lnk;
} *ConstOp__13_s; } *ConstOp__14_s;
static INT16 ConstCmp__14 (void); static INT16 ConstCmp__15 (void);
static INT16 ConstCmp__14 (void) static INT16 ConstCmp__15 (void)
{ {
INT16 res; INT16 res;
switch (*ConstOp__13_s->f) { switch (*ConstOp__14_s->f) {
case 0: case 0:
res = 9; res = 9;
break; break;
case 1: case 3: case 4: case 1: case 3: case 4:
if ((*ConstOp__13_s->xval)->intval < (*ConstOp__13_s->yval)->intval) { if ((*ConstOp__14_s->xval)->intval < (*ConstOp__14_s->yval)->intval) {
res = 11; res = 11;
} else if ((*ConstOp__13_s->xval)->intval > (*ConstOp__13_s->yval)->intval) { } else if ((*ConstOp__14_s->xval)->intval > (*ConstOp__14_s->yval)->intval) {
res = 13; res = 13;
} else { } else {
res = 9; res = 9;
} }
break; break;
case 5: case 6: case 5: case 6:
if ((*ConstOp__13_s->xval)->realval < (*ConstOp__13_s->yval)->realval) { if ((*ConstOp__14_s->xval)->realval < (*ConstOp__14_s->yval)->realval) {
res = 11; res = 11;
} else if ((*ConstOp__13_s->xval)->realval > (*ConstOp__13_s->yval)->realval) { } else if ((*ConstOp__14_s->xval)->realval > (*ConstOp__14_s->yval)->realval) {
res = 13; res = 13;
} else { } else {
res = 9; res = 9;
} }
break; break;
case 2: case 2:
if ((*ConstOp__13_s->xval)->intval != (*ConstOp__13_s->yval)->intval) { if ((*ConstOp__14_s->xval)->intval != (*ConstOp__14_s->yval)->intval) {
res = 10; res = 10;
} else { } else {
res = 9; res = 9;
} }
break; break;
case 7: case 7:
if ((*ConstOp__13_s->xval)->setval != (*ConstOp__13_s->yval)->setval) { if ((*ConstOp__14_s->xval)->setval != (*ConstOp__14_s->yval)->setval) {
res = 10; res = 10;
} else { } else {
res = 9; res = 9;
} }
break; break;
case 8: case 8:
if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) < 0) { if (__STRCMP(*(*ConstOp__14_s->xval)->ext, *(*ConstOp__14_s->yval)->ext) < 0) {
res = 11; res = 11;
} else if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) > 0) { } else if (__STRCMP(*(*ConstOp__14_s->xval)->ext, *(*ConstOp__14_s->yval)->ext) > 0) {
res = 13; res = 13;
} else { } else {
res = 9; res = 9;
} }
break; break;
case 9: case 11: case 12: case 9: case 11: case 12:
if ((*ConstOp__13_s->xval)->intval != (*ConstOp__13_s->yval)->intval) { if ((*ConstOp__14_s->xval)->intval != (*ConstOp__14_s->yval)->intval) {
res = 10; res = 10;
} else { } else {
res = 9; res = 9;
@ -808,11 +806,11 @@ static INT16 ConstCmp__14 (void)
break; break;
default: default:
OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstCmp, f = ", 37); OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstCmp, f = ", 37);
OPM_LogWNum(*ConstOp__13_s->f, 0); OPM_LogWNum(*ConstOp__14_s->f, 0);
OPM_LogWLn(); OPM_LogWLn();
break; break;
} }
(*ConstOp__13_s->x)->typ = OPT_booltyp; (*ConstOp__14_s->x)->typ = OPT_booltyp;
return res; return res;
} }
@ -822,13 +820,13 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
OPT_Const xval = NIL, yval = NIL; OPT_Const xval = NIL, yval = NIL;
INT64 xv, yv; INT64 xv, yv;
BOOLEAN temp; BOOLEAN temp;
struct ConstOp__13 _s; struct ConstOp__14 _s;
_s.x = &x; _s.x = &x;
_s.f = &f; _s.f = &f;
_s.xval = &xval; _s.xval = &xval;
_s.yval = &yval; _s.yval = &yval;
_s.lnk = ConstOp__13_s; _s.lnk = ConstOp__14_s;
ConstOp__13_s = &_s; ConstOp__14_s = &_s;
f = x->typ->form; f = x->typ->form;
g = y->typ->form; g = y->typ->form;
xval = x->conval; xval = x->conval;
@ -1055,37 +1053,37 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
} }
break; break;
case 9: case 9:
xval->intval = OPB_BoolToInt(ConstCmp__14() == 9); xval->intval = OPB_BoolToInt(ConstCmp__15() == 9);
break; break;
case 10: case 10:
xval->intval = OPB_BoolToInt(ConstCmp__14() != 9); xval->intval = OPB_BoolToInt(ConstCmp__15() != 9);
break; break;
case 11: case 11:
if (__IN(f, 0x0a84, 32)) { if (__IN(f, 0x0a84, 32)) {
OPB_err(108); OPB_err(108);
} else { } else {
xval->intval = OPB_BoolToInt(ConstCmp__14() == 11); xval->intval = OPB_BoolToInt(ConstCmp__15() == 11);
} }
break; break;
case 12: case 12:
if (__IN(f, 0x0a84, 32)) { if (__IN(f, 0x0a84, 32)) {
OPB_err(108); OPB_err(108);
} else { } else {
xval->intval = OPB_BoolToInt(ConstCmp__14() != 13); xval->intval = OPB_BoolToInt(ConstCmp__15() != 13);
} }
break; break;
case 13: case 13:
if (__IN(f, 0x0a84, 32)) { if (__IN(f, 0x0a84, 32)) {
OPB_err(108); OPB_err(108);
} else { } else {
xval->intval = OPB_BoolToInt(ConstCmp__14() == 13); xval->intval = OPB_BoolToInt(ConstCmp__15() == 13);
} }
break; break;
case 14: case 14:
if (__IN(f, 0x0a84, 32)) { if (__IN(f, 0x0a84, 32)) {
OPB_err(108); OPB_err(108);
} else { } else {
xval->intval = OPB_BoolToInt(ConstCmp__14() != 11); xval->intval = OPB_BoolToInt(ConstCmp__15() != 11);
} }
break; break;
default: default:
@ -1094,7 +1092,7 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
OPM_LogWLn(); OPM_LogWLn();
break; break;
} }
ConstOp__13_s = _s.lnk; ConstOp__14_s = _s.lnk;
} }
static void OPB_Convert (OPT_Node *x, OPT_Struct typ) static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
@ -1157,15 +1155,15 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
(*x)->typ = typ; (*x)->typ = typ;
} }
static struct Op__38 { static struct Op__39 {
INT16 *f, *g; INT16 *f, *g;
struct Op__38 *lnk; struct Op__39 *lnk;
} *Op__38_s; } *Op__39_s;
static void NewOp__39 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y); static void NewOp__40 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y);
static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y); static BOOLEAN strings__42 (OPT_Node *x, OPT_Node *y);
static void NewOp__39 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y) static void NewOp__40 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
{ {
OPT_Node node = NIL; OPT_Node node = NIL;
node = OPT_NewNode(12); node = OPT_NewNode(12);
@ -1176,28 +1174,28 @@ static void NewOp__39 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
*x = node; *x = node;
} }
static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y) static BOOLEAN strings__42 (OPT_Node *x, OPT_Node *y)
{ {
BOOLEAN ok, xCharArr, yCharArr; BOOLEAN ok, xCharArr, yCharArr;
xCharArr = (__IN((*x)->typ->comp, 0x0c, 32) && (*x)->typ->BaseTyp->form == 3) || *Op__38_s->f == 8; xCharArr = (__IN((*x)->typ->comp, 0x0c, 32) && (*x)->typ->BaseTyp->form == 3) || *Op__39_s->f == 8;
yCharArr = (__IN((*y)->typ->comp, 0x0c, 32) && (*y)->typ->BaseTyp->form == 3) || *Op__38_s->g == 8; yCharArr = (__IN((*y)->typ->comp, 0x0c, 32) && (*y)->typ->BaseTyp->form == 3) || *Op__39_s->g == 8;
if ((((xCharArr && *Op__38_s->g == 3)) && (*y)->class == 7)) { if ((((xCharArr && *Op__39_s->g == 3)) && (*y)->class == 7)) {
OPB_CharToString(*y); OPB_CharToString(*y);
*Op__38_s->g = 8; *Op__39_s->g = 8;
yCharArr = 1; yCharArr = 1;
} }
if ((((yCharArr && *Op__38_s->f == 3)) && (*x)->class == 7)) { if ((((yCharArr && *Op__39_s->f == 3)) && (*x)->class == 7)) {
OPB_CharToString(*x); OPB_CharToString(*x);
*Op__38_s->f = 8; *Op__39_s->f = 8;
xCharArr = 1; xCharArr = 1;
} }
ok = (xCharArr && yCharArr); ok = (xCharArr && yCharArr);
if (ok) { if (ok) {
if ((*Op__38_s->f == 8 && (*x)->conval->intval2 == 1)) { if ((*Op__39_s->f == 8 && (*x)->conval->intval2 == 1)) {
(*x)->typ = OPT_chartyp; (*x)->typ = OPT_chartyp;
(*x)->conval->intval = 0; (*x)->conval->intval = 0;
OPB_Index(&*y, OPB_NewIntConst(0)); OPB_Index(&*y, OPB_NewIntConst(0));
} else if ((*Op__38_s->g == 8 && (*y)->conval->intval2 == 1)) { } else if ((*Op__39_s->g == 8 && (*y)->conval->intval2 == 1)) {
(*y)->typ = OPT_chartyp; (*y)->typ = OPT_chartyp;
(*y)->conval->intval = 0; (*y)->conval->intval = 0;
OPB_Index(&*x, OPB_NewIntConst(0)); OPB_Index(&*x, OPB_NewIntConst(0));
@ -1213,11 +1211,11 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
OPT_Struct typ = NIL; OPT_Struct typ = NIL;
BOOLEAN do_; BOOLEAN do_;
INT64 val; INT64 val;
struct Op__38 _s; struct Op__39 _s;
_s.f = &f; _s.f = &f;
_s.g = &g; _s.g = &g;
_s.lnk = Op__38_s; _s.lnk = Op__39_s;
Op__38_s = &_s; Op__39_s = &_s;
z = *x; z = *x;
if (((z->class == 8 || z->class == 9) || y->class == 8) || y->class == 9) { if (((z->class == 8 || z->class == 9) || y->class == 8) || y->class == 9) {
OPB_err(126); OPB_err(126);
@ -1338,7 +1336,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp; typ = OPT_undftyp;
} }
if (do_) { if (do_) {
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
} }
break; break;
case 2: case 2:
@ -1357,7 +1355,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
OPB_err(102); OPB_err(102);
typ = OPT_undftyp; typ = OPT_undftyp;
} }
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
break; break;
case 3: case 3:
do_ = 1; do_ = 1;
@ -1380,7 +1378,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp; typ = OPT_undftyp;
} }
if (do_) { if (do_) {
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
} }
break; break;
case 4: case 4:
@ -1398,7 +1396,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
OPB_err(104); OPB_err(104);
typ = OPT_undftyp; typ = OPT_undftyp;
} }
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
break; break;
case 5: case 5:
if (f == 2) { if (f == 2) {
@ -1408,7 +1406,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
} }
} else if ((y->class == 7 && OPB_IntToBool(y->conval->intval))) { } else if ((y->class == 7 && OPB_IntToBool(y->conval->intval))) {
} else { } else {
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
} }
} else if (f != 0) { } else if (f != 0) {
OPB_err(94); OPB_err(94);
@ -1431,7 +1429,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
} }
} }
if (do_) { if (do_) {
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
} }
break; break;
case 7: case 7:
@ -1440,7 +1438,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp; typ = OPT_undftyp;
} }
if ((f != 4 || y->class != 7) || y->conval->intval != 0) { if ((f != 4 || y->class != 7) || y->conval->intval != 0) {
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
} }
break; break;
case 8: case 8:
@ -1451,7 +1449,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
} }
} else if ((y->class == 7 && !OPB_IntToBool(y->conval->intval))) { } else if ((y->class == 7 && !OPB_IntToBool(y->conval->intval))) {
} else { } else {
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
} }
} else if (f != 0) { } else if (f != 0) {
OPB_err(95); OPB_err(95);
@ -1459,16 +1457,16 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
} }
break; break;
case 9: case 10: case 9: case 10:
if (__IN(f, 0x1aff, 32) || strings__41(&z, &y)) { if (__IN(f, 0x1aff, 32) || strings__42(&z, &y)) {
typ = OPT_booltyp; typ = OPT_booltyp;
} else { } else {
OPB_err(107); OPB_err(107);
typ = OPT_undftyp; typ = OPT_undftyp;
} }
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
break; break;
case 11: case 12: case 13: case 14: case 11: case 12: case 13: case 14:
if (__IN(f, 0x79, 32) || strings__41(&z, &y)) { if (__IN(f, 0x79, 32) || strings__42(&z, &y)) {
typ = OPT_booltyp; typ = OPT_booltyp;
} else { } else {
OPM_LogWLn(); OPM_LogWLn();
@ -1477,7 +1475,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
OPB_err(108); OPB_err(108);
typ = OPT_undftyp; typ = OPT_undftyp;
} }
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
break; break;
default: default:
OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", 32); OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", 32);
@ -1487,7 +1485,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
} }
} }
*x = z; *x = z;
Op__38_s = _s.lnk; Op__39_s = _s.lnk;
} }
void OPB_SetRange (OPT_Node *x, OPT_Node y) void OPB_SetRange (OPT_Node *x, OPT_Node y)
@ -1672,6 +1670,19 @@ static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo)
{ {
} }
static void OPB_CheckWrite (OPT_Node x)
{
if (x->readonly) {
OPB_err(76);
}
while (__IN(x->class, 0x74, 32)) {
x = x->left;
}
if ((x != NIL && x->obj != NIL)) {
x->obj->written = 1;
}
}
void OPB_StPar0 (OPT_Node *par0, INT16 fctno) void OPB_StPar0 (OPT_Node *par0, INT16 fctno)
{ {
INT16 f; INT16 f;
@ -1697,9 +1708,7 @@ void OPB_StPar0 (OPT_Node *par0, INT16 fctno)
if (OPB_NotVar(x)) { if (OPB_NotVar(x)) {
OPB_err(112); OPB_err(112);
} else if (f == 11) { } else if (f == 11) {
if (x->readonly) { OPB_CheckWrite(x);
OPB_err(76);
}
f = x->typ->BaseTyp->comp; f = x->typ->BaseTyp->comp;
if (__IN(f, 0x1c, 32)) { if (__IN(f, 0x1c, 32)) {
if (f == 3) { if (f == 3) {
@ -1855,8 +1864,8 @@ void OPB_StPar0 (OPT_Node *par0, INT16 fctno)
OPB_err(112); OPB_err(112);
} else if (f != 4) { } else if (f != 4) {
OPB_err(111); OPB_err(111);
} else if (x->readonly) { } else {
OPB_err(76); OPB_CheckWrite(x);
} }
break; break;
case 15: case 16: case 15: case 16:
@ -1865,8 +1874,8 @@ void OPB_StPar0 (OPT_Node *par0, INT16 fctno)
} else if (x->typ->form != 7) { } else if (x->typ->form != 7) {
OPB_err(111); OPB_err(111);
x->typ = OPT_settyp; x->typ = OPT_settyp;
} else if (x->readonly) { } else {
OPB_err(76); OPB_CheckWrite(x);
} }
break; break;
case 17: case 17:
@ -1978,13 +1987,13 @@ void OPB_StPar0 (OPT_Node *par0, INT16 fctno)
*par0 = x; *par0 = x;
} }
static struct StPar1__53 { static struct StPar1__54 {
struct StPar1__53 *lnk; struct StPar1__54 *lnk;
} *StPar1__53_s; } *StPar1__54_s;
static OPT_Node NewOp__54 (INT8 class, INT8 subcl, OPT_Node left, OPT_Node right); static OPT_Node NewOp__55 (INT8 class, INT8 subcl, OPT_Node left, OPT_Node right);
static OPT_Node NewOp__54 (INT8 class, INT8 subcl, OPT_Node left, OPT_Node right) static OPT_Node NewOp__55 (INT8 class, INT8 subcl, OPT_Node left, OPT_Node right)
{ {
OPT_Node node = NIL; OPT_Node node = NIL;
node = OPT_NewNode(class); node = OPT_NewNode(class);
@ -1999,9 +2008,9 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
INT16 f, L; INT16 f, L;
OPT_Struct typ = NIL; OPT_Struct typ = NIL;
OPT_Node p = NIL, t = NIL; OPT_Node p = NIL, t = NIL;
struct StPar1__53 _s; struct StPar1__54 _s;
_s.lnk = StPar1__53_s; _s.lnk = StPar1__54_s;
StPar1__53_s = &_s; StPar1__54_s = &_s;
p = *par0; p = *par0;
f = x->typ->form; f = x->typ->form;
switch (fctno) { switch (fctno) {
@ -2017,7 +2026,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
OPB_err(111); OPB_err(111);
} }
} }
p = NewOp__54(19, fctno, p, x); p = NewOp__55(19, fctno, p, x);
p->typ = OPT_notyp; p->typ = OPT_notyp;
} }
break; break;
@ -2028,7 +2037,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval >= (INT64)__ASHL(p->typ->size, 3)))) { if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval >= (INT64)__ASHL(p->typ->size, 3)))) {
OPB_err(202); OPB_err(202);
} }
p = NewOp__54(19, fctno, p, x); p = NewOp__55(19, fctno, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2053,7 +2062,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
p = p->left; p = p->left;
x->conval->intval += 1; x->conval->intval += 1;
} }
p = NewOp__54(12, 19, p, x); p = NewOp__55(12, 19, p, x);
p->typ = OPT_linttyp; p->typ = OPT_linttyp;
} else { } else {
p = x; p = x;
@ -2069,13 +2078,11 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
if (OPB_NotVar(x)) { if (OPB_NotVar(x)) {
OPB_err(112); OPB_err(112);
} else if ((__IN(x->typ->comp, 0x0c, 32) && x->typ->BaseTyp->form == 3)) { } else if ((__IN(x->typ->comp, 0x0c, 32) && x->typ->BaseTyp->form == 3)) {
if (x->readonly) { OPB_CheckWrite(x);
OPB_err(76);
}
t = x; t = x;
x = p; x = p;
p = t; p = t;
p = NewOp__54(19, 18, p, x); p = NewOp__55(19, 18, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2101,7 +2108,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
} }
p->obj = NIL; p->obj = NIL;
} else { } else {
p = NewOp__54(12, 17, p, x); p = NewOp__55(12, 17, p, x);
p->typ = p->left->typ; p->typ = p->left->typ;
} }
} else { } else {
@ -2132,9 +2139,9 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
OPB_err(111); OPB_err(111);
} else { } else {
if (fctno == 22) { if (fctno == 22) {
p = NewOp__54(12, 27, p, x); p = NewOp__55(12, 27, p, x);
} else { } else {
p = NewOp__54(12, 28, p, x); p = NewOp__55(12, 28, p, x);
} }
p->typ = p->left->typ; p->typ = p->left->typ;
} }
@ -2151,7 +2158,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
x = p; x = p;
p = t; p = t;
} }
p = NewOp__54(19, fctno, p, x); p = NewOp__55(19, fctno, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2161,7 +2168,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
if (x->class == 8 || x->class == 9) { if (x->class == 8 || x->class == 9) {
OPB_err(126); OPB_err(126);
} else if (f == 4) { } else if (f == 4) {
p = NewOp__54(12, 26, p, x); p = NewOp__55(12, 26, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2191,7 +2198,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
if (x->class == 8 || x->class == 9) { if (x->class == 8 || x->class == 9) {
OPB_err(126); OPB_err(126);
} else if (f == 4) { } else if (f == 4) {
p = NewOp__54(19, 30, p, x); p = NewOp__55(19, 30, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2237,7 +2244,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
break; break;
} }
*par0 = p; *par0 = p;
StPar1__53_s = _s.lnk; StPar1__54_s = _s.lnk;
} }
void OPB_StParN (OPT_Node *par0, OPT_Node x, INT16 fctno, INT16 n) void OPB_StParN (OPT_Node *par0, OPT_Node x, INT16 fctno, INT16 n)
@ -2356,7 +2363,7 @@ static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpa
f = atyp->comp; f = atyp->comp;
ftyp = ftyp->BaseTyp; ftyp = ftyp->BaseTyp;
atyp = atyp->BaseTyp; atyp = atyp->BaseTyp;
if (((fvarpar || sysflag != 0) && ftyp == OPT_bytetyp)) { if (ftyp == OPT_bytetyp) {
if (!__IN(f, 0x0c, 32) || !((__IN(atyp->form, 0x1e, 32) && atyp->size == 1))) { if (!__IN(f, 0x0c, 32) || !((__IN(atyp->form, 0x1e, 32) && atyp->size == 1))) {
if (__IN(18, OPM_Options, 32)) { if (__IN(18, OPM_Options, 32)) {
OPB_err(-301); OPB_err(-301);
@ -2426,9 +2433,7 @@ void OPB_Param (OPT_Node ap, OPT_Object fp)
} else { } else {
OPB_CheckLeaf(ap, 0); OPB_CheckLeaf(ap, 0);
} }
if (ap->readonly) { OPB_CheckWrite(ap);
OPB_err(76);
}
if (fp->typ->comp == 3) { if (fp->typ->comp == 3) {
OPB_DynArrParCheck(fp->typ, ap->typ, 1); OPB_DynArrParCheck(fp->typ, ap->typ, 1);
} else if ((fp->typ->comp == 4 && ap->typ->comp == 4)) { } else if ((fp->typ->comp == 4 && ap->typ->comp == 4)) {
@ -2540,9 +2545,7 @@ void OPB_Assign (OPT_Node *x, OPT_Node y)
OPB_err(56); OPB_err(56);
} }
OPB_CheckAssign((*x)->typ, y); OPB_CheckAssign((*x)->typ, y);
if ((*x)->readonly) { OPB_CheckWrite(*x);
OPB_err(76);
}
if ((*x)->typ->comp == 4) { if ((*x)->typ->comp == 4) {
if ((*x)->class == 5) { if ((*x)->class == 5) {
z = (*x)->left; z = (*x)->left;

2
bootstrap/unix-44/OPB.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPB__h #ifndef OPB__h
#define OPB__h #define OPB__h

14
bootstrap/unix-44/OPC.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -141,7 +141,6 @@ static void OPC_Str1 (CHAR *s, ADDRESS s__len, INT32 x)
{ {
CHAR ch; CHAR ch;
INT16 i; INT16 i;
__DUP(s, s__len, CHAR);
ch = s[0]; ch = s[0];
i = 0; i = 0;
while (ch != 0x00) { while (ch != 0x00) {
@ -153,7 +152,6 @@ static void OPC_Str1 (CHAR *s, ADDRESS s__len, INT32 x)
i += 1; i += 1;
ch = s[__X(i, s__len)]; ch = s[__X(i, s__len)];
} }
__DEL(s);
} }
static INT16 OPC_Length (CHAR *s, ADDRESS s__len) static INT16 OPC_Length (CHAR *s, ADDRESS s__len)
@ -727,12 +725,10 @@ static void OPC_DefineType (OPT_Struct str)
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, ADDRESS y__len) static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, ADDRESS y__len)
{ {
INT16 i; INT16 i;
__DUP(y, y__len, CHAR);
i = 0; i = 0;
while ((*x)[__X(i + 1, 256)] == y[__X(i, y__len)]) { while ((*x)[__X(i + 1, 256)] == y[__X(i, y__len)]) {
i += 1; i += 1;
} }
__DEL(y);
return y[__X(i, y__len)] == 0x00; return y[__X(i, y__len)] == 0x00;
} }
@ -1466,7 +1462,7 @@ void OPC_EnterProc (OPT_Object proc)
} }
var = proc->link; var = proc->link;
while (var != NIL) { while (var != NIL) {
if ((var->typ->comp == 2 && var->mode == 1)) { if ((((var->written && var->typ->comp == 2)) && var->mode == 1)) {
OPC_BegStat(); OPC_BegStat();
if (var->typ->strobj == NIL) { if (var->typ->strobj == NIL) {
OPM_Mark(200, var->typ->txtpos); OPM_Mark(200, var->typ->txtpos);
@ -1482,7 +1478,7 @@ void OPC_EnterProc (OPT_Object proc)
} }
var = proc->link; var = proc->link;
while (var != NIL) { while (var != NIL) {
if ((((__IN(var->typ->comp, 0x0c, 32) && var->mode == 1)) && var->typ->sysflag == 0)) { if ((((((var->written && __IN(var->typ->comp, 0x0c, 32))) && var->mode == 1)) && var->typ->sysflag == 0)) {
OPC_BegStat(); OPC_BegStat();
if (var->typ->comp == 2) { if (var->typ->comp == 2) {
OPM_WriteString((CHAR*)"__DUPARR(", 10); OPM_WriteString((CHAR*)"__DUPARR(", 10);
@ -1632,7 +1628,7 @@ void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet)
} }
var = proc->link; var = proc->link;
while (var != NIL) { while (var != NIL) {
if ((((var->typ->comp == 3 && var->mode == 1)) && var->typ->sysflag == 0)) { if ((((((var->written && var->typ->comp == 3)) && var->mode == 1)) && var->typ->sysflag == 0)) {
if (indent) { if (indent) {
OPC_BegStat(); OPC_BegStat();
} else { } else {
@ -1752,7 +1748,6 @@ static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l)
{ {
INT32 i; INT32 i;
INT16 c; INT16 c;
__DUP(s, s__len, CHAR);
OPM_Write('"'); OPM_Write('"');
i = 0; i = 0;
while (i < l) { while (i < l) {
@ -1773,7 +1768,6 @@ static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l)
i += 1; i += 1;
} }
OPM_Write('"'); OPM_Write('"');
__DEL(s);
} }
void OPC_Case (INT64 caseVal, INT16 form) void OPC_Case (INT64 caseVal, INT16 form)

2
bootstrap/unix-44/OPC.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPC__h #ifndef OPC__h
#define OPC__h #define OPC__h

25
bootstrap/unix-44/OPM.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -27,7 +27,7 @@ export INT16 OPM_AddressSize;
static INT16 OPM_GlobalAlignment; static INT16 OPM_GlobalAlignment;
export INT16 OPM_Alignment; export INT16 OPM_Alignment;
export UINT32 OPM_GlobalOptions, OPM_Options; export UINT32 OPM_GlobalOptions, OPM_Options;
export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize; export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize, OPM_SetSize;
export INT64 OPM_MaxIndex; export INT64 OPM_MaxIndex;
export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
export BOOLEAN OPM_noerr; export BOOLEAN OPM_noerr;
@ -112,9 +112,7 @@ void OPM_LogW (CHAR ch)
void OPM_LogWStr (CHAR *s, ADDRESS s__len) void OPM_LogWStr (CHAR *s, ADDRESS s__len)
{ {
__DUP(s, s__len, CHAR);
Out_String(s, s__len); Out_String(s, s__len);
__DEL(s);
} }
void OPM_LogWNum (INT64 i, INT64 len) void OPM_LogWNum (INT64 i, INT64 len)
@ -129,16 +127,13 @@ void OPM_LogWLn (void)
void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len) void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len)
{ {
__DUP(vt100code, vt100code__len, CHAR);
if ((Out_IsConsole && !__IN(16, OPM_Options, 32))) { if ((Out_IsConsole && !__IN(16, OPM_Options, 32))) {
VT100_SetAttr(vt100code, vt100code__len); VT100_SetAttr(vt100code, vt100code__len);
} }
__DEL(vt100code);
} }
void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len) void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len)
{ {
__DUP(modname, modname__len, CHAR);
OPM_LogWStr((CHAR*)"Compiling ", 11); OPM_LogWStr((CHAR*)"Compiling ", 11);
OPM_LogWStr(modname, modname__len); OPM_LogWStr(modname, modname__len);
if (__IN(18, OPM_Options, 32)) { if (__IN(18, OPM_Options, 32)) {
@ -154,7 +149,6 @@ void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len)
OPM_LogWNum(__ASHL(OPM_Alignment, 3), 1); OPM_LogWNum(__ASHL(OPM_Alignment, 3), 1);
} }
OPM_LogW('.'); OPM_LogW('.');
__DEL(modname);
} }
INT64 OPM_SignedMaximum (INT32 bytecount) INT64 OPM_SignedMaximum (INT32 bytecount)
@ -183,7 +177,6 @@ INT16 OPM_Integer (INT64 n)
static void OPM_ScanOptions (CHAR *s, ADDRESS s__len) static void OPM_ScanOptions (CHAR *s, ADDRESS s__len)
{ {
INT16 i; INT16 i;
__DUP(s, s__len, CHAR);
i = 1; i = 1;
while (s[__X(i, s__len)] != 0x00) { while (s[__X(i, s__len)] != 0x00) {
switch (s[__X(i, s__len)]) { switch (s[__X(i, s__len)]) {
@ -263,7 +256,6 @@ static void OPM_ScanOptions (CHAR *s, ADDRESS s__len)
} }
i += 1; i += 1;
} }
__DEL(s);
} }
BOOLEAN OPM_OpenPar (void) BOOLEAN OPM_OpenPar (void)
@ -338,7 +330,7 @@ BOOLEAN OPM_OpenPar (void)
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" -O2 Original Oberon / Oberon-2: 8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET.", 95); OPM_LogWStr((CHAR*)" -O2 Original Oberon / Oberon-2: 8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET.", 95);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95); OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER and SET, 64 bit LONGINT.", 95);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95); OPM_LogWStr((CHAR*)" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95);
OPM_LogWLn(); OPM_LogWLn();
@ -410,21 +402,25 @@ void OPM_InitOptions (void)
OPM_ShortintSize = 1; OPM_ShortintSize = 1;
OPM_IntegerSize = 2; OPM_IntegerSize = 2;
OPM_LongintSize = 4; OPM_LongintSize = 4;
OPM_SetSize = 4;
break; break;
case 'C': case 'C':
OPM_ShortintSize = 2; OPM_ShortintSize = 2;
OPM_IntegerSize = 4; OPM_IntegerSize = 4;
OPM_LongintSize = 8; OPM_LongintSize = 8;
OPM_SetSize = 4;
break; break;
case 'V': case 'V':
OPM_ShortintSize = 1; OPM_ShortintSize = 1;
OPM_IntegerSize = 4; OPM_IntegerSize = 4;
OPM_LongintSize = 8; OPM_LongintSize = 8;
OPM_SetSize = 8;
break; break;
default: default:
OPM_ShortintSize = 1; OPM_ShortintSize = 1;
OPM_IntegerSize = 2; OPM_IntegerSize = 2;
OPM_LongintSize = 4; OPM_LongintSize = 4;
OPM_SetSize = 4;
break; break;
} }
__MOVE(OPM_InstallDir, OPM_ResourceDir, 1024); __MOVE(OPM_InstallDir, OPM_ResourceDir, 1024);
@ -492,7 +488,6 @@ static void OPM_MakeFileName (CHAR *name, ADDRESS name__len, CHAR *FName, ADDRES
{ {
INT16 i, j; INT16 i, j;
CHAR ch; CHAR ch;
__DUP(ext, ext__len, CHAR);
i = 0; i = 0;
for (;;) { for (;;) {
ch = name[__X(i, name__len)]; ch = name[__X(i, name__len)];
@ -509,7 +504,6 @@ static void OPM_MakeFileName (CHAR *name, ADDRESS name__len, CHAR *FName, ADDRES
i += 1; i += 1;
j += 1; j += 1;
} while (!(ch == 0x00)); } while (!(ch == 0x00));
__DEL(ext);
} }
static void OPM_LogErrMsg (INT16 n) static void OPM_LogErrMsg (INT16 n)
@ -1050,28 +1044,23 @@ static BOOLEAN OPM_IsProbablyInstallDir (CHAR *s, ADDRESS s__len)
{ {
CHAR testpath[4096]; CHAR testpath[4096];
Platform_FileIdentity identity; Platform_FileIdentity identity;
__DUP(s, s__len, CHAR);
__COPY(OPM_InstallDir, testpath, 4096); __COPY(OPM_InstallDir, testpath, 4096);
Strings_Append((CHAR*)"/lib/lib", 9, (void*)testpath, 4096); Strings_Append((CHAR*)"/lib/lib", 9, (void*)testpath, 4096);
Strings_Append((CHAR*)"voc", 4, (void*)testpath, 4096); Strings_Append((CHAR*)"voc", 4, (void*)testpath, 4096);
Strings_Append((CHAR*)"-O2.a", 6, (void*)testpath, 4096); Strings_Append((CHAR*)"-O2.a", 6, (void*)testpath, 4096);
if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) { if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
__DEL(s);
return 0; return 0;
} }
__COPY(OPM_InstallDir, testpath, 4096); __COPY(OPM_InstallDir, testpath, 4096);
Strings_Append((CHAR*)"/2/include/Oberon.h", 20, (void*)testpath, 4096); Strings_Append((CHAR*)"/2/include/Oberon.h", 20, (void*)testpath, 4096);
if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) { if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
__DEL(s);
return 0; return 0;
} }
__COPY(OPM_InstallDir, testpath, 4096); __COPY(OPM_InstallDir, testpath, 4096);
Strings_Append((CHAR*)"/2/sym/Files.sym", 17, (void*)testpath, 4096); Strings_Append((CHAR*)"/2/sym/Files.sym", 17, (void*)testpath, 4096);
if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) { if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
__DEL(s);
return 0; return 0;
} }
__DEL(s);
return 1; return 1;
} }

4
bootstrap/unix-44/OPM.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPM__h #ifndef OPM__h
#define OPM__h #define OPM__h
@ -9,7 +9,7 @@
import CHAR OPM_Model[10]; import CHAR OPM_Model[10];
import INT16 OPM_AddressSize, OPM_Alignment; import INT16 OPM_AddressSize, OPM_Alignment;
import UINT32 OPM_GlobalOptions, OPM_Options; import UINT32 OPM_GlobalOptions, OPM_Options;
import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize; import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize, OPM_SetSize;
import INT64 OPM_MaxIndex; import INT64 OPM_MaxIndex;
import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
import BOOLEAN OPM_noerr; import BOOLEAN OPM_noerr;

2
bootstrap/unix-44/OPP.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16

2
bootstrap/unix-44/OPP.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPP__h #ifndef OPP__h
#define OPP__h #define OPP__h

2
bootstrap/unix-44/OPS.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16

2
bootstrap/unix-44/OPS.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPS__h #ifndef OPS__h
#define OPS__h #define OPS__h

4
bootstrap/unix-44/OPT.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -77,7 +77,7 @@ typedef
OPS_Name name; OPS_Name name;
BOOLEAN leaf; BOOLEAN leaf;
INT8 mode, mnolev, vis, history; INT8 mode, mnolev, vis, history;
BOOLEAN used, fpdone; BOOLEAN used, fpdone, written;
INT32 fprint; INT32 fprint;
OPT_Struct typ; OPT_Struct typ;
OPT_Const conval; OPT_Const conval;

4
bootstrap/unix-44/OPT.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPT__h #ifndef OPT__h
#define OPT__h #define OPT__h
@ -55,7 +55,7 @@ typedef
OPS_Name name; OPS_Name name;
BOOLEAN leaf; BOOLEAN leaf;
INT8 mode, mnolev, vis, history; INT8 mode, mnolev, vis, history;
BOOLEAN used, fpdone; BOOLEAN used, fpdone, written;
INT32 fprint; INT32 fprint;
OPT_Struct typ; OPT_Struct typ;
OPT_Const conval; OPT_Const conval;

2
bootstrap/unix-44/OPV.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16

2
bootstrap/unix-44/OPV.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPV__h #ifndef OPV__h
#define OPV__h #define OPV__h

2
bootstrap/unix-44/Out.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16

2
bootstrap/unix-44/Out.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Out__h #ifndef Out__h
#define Out__h #define Out__h

11
bootstrap/unix-44/Platform.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -209,22 +209,18 @@ typedef
BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len) BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len)
{ {
EnvPtr__83 p = NIL; EnvPtr__83 p = NIL;
__DUP(var, var__len, CHAR);
p = (EnvPtr__83)(ADDRESS)Platform_getenv(var, var__len); p = (EnvPtr__83)(ADDRESS)Platform_getenv(var, var__len);
if (p != NIL) { if (p != NIL) {
__COPY(*p, val, val__len); __COPY(*p, val, val__len);
} }
__DEL(var);
return p != NIL; return p != NIL;
} }
void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len) void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len)
{ {
__DUP(var, var__len, CHAR);
if (!Platform_getEnv(var, var__len, (void*)val, val__len)) { if (!Platform_getEnv(var, var__len, (void*)val, val__len)) {
val[0] = 0x00; val[0] = 0x00;
} }
__DEL(var);
} }
void Platform_SetInterruptHandler (Platform_SignalHandler handler) void Platform_SetInterruptHandler (Platform_SignalHandler handler)
@ -280,8 +276,6 @@ void Platform_Delay (INT32 ms)
INT16 Platform_System (CHAR *cmd, ADDRESS cmd__len) INT16 Platform_System (CHAR *cmd, ADDRESS cmd__len)
{ {
__DUP(cmd, cmd__len, CHAR);
__DEL(cmd);
return Platform_system(cmd, cmd__len); return Platform_system(cmd, cmd__len);
} }
@ -358,16 +352,13 @@ INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *iden
INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ) INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ)
{ {
__DUP(n, n__len, CHAR);
Platform_structstats(); Platform_structstats();
if (Platform_stat(n, n__len) < 0) { if (Platform_stat(n, n__len) < 0) {
__DEL(n);
return Platform_err(); return Platform_err();
} }
(*identity).volume = Platform_statdev(); (*identity).volume = Platform_statdev();
(*identity).index = Platform_statino(); (*identity).index = Platform_statino();
(*identity).mtime = Platform_statmtime(); (*identity).mtime = Platform_statmtime();
__DEL(n);
return 0; return 0;
} }

2
bootstrap/unix-44/Platform.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Platform__h #ifndef Platform__h
#define Platform__h #define Platform__h

2
bootstrap/unix-44/Reals.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16

2
bootstrap/unix-44/Reals.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Reals__h #ifndef Reals__h
#define Reals__h #define Reals__h

21
bootstrap/unix-44/Strings.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -42,7 +42,6 @@ INT16 Strings_Length (CHAR *s, ADDRESS s__len)
void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__len) void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__len)
{ {
INT16 n1, n2, i; INT16 n1, n2, i;
__DUP(extra, extra__len, CHAR);
n1 = Strings_Length(dest, dest__len); n1 = Strings_Length(dest, dest__len);
n2 = Strings_Length(extra, extra__len); n2 = Strings_Length(extra, extra__len);
i = 0; i = 0;
@ -53,7 +52,6 @@ void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__
if ((i + n1) < dest__len) { if ((i + n1) < dest__len) {
dest[__X(i + n1, dest__len)] = 0x00; dest[__X(i + n1, dest__len)] = 0x00;
} }
__DEL(extra);
} }
void Strings_Insert (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len) void Strings_Insert (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len)
@ -112,16 +110,13 @@ void Strings_Delete (CHAR *s, ADDRESS s__len, INT16 pos, INT16 n)
void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len) void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len)
{ {
__DUP(source, source__len, CHAR);
Strings_Delete((void*)dest, dest__len, pos, pos + Strings_Length(source, source__len)); Strings_Delete((void*)dest, dest__len, pos, pos + Strings_Length(source, source__len));
Strings_Insert(source, source__len, pos, (void*)dest, dest__len); Strings_Insert(source, source__len, pos, (void*)dest, dest__len);
__DEL(source);
} }
void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHAR *dest, ADDRESS dest__len) void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHAR *dest, ADDRESS dest__len)
{ {
INT16 len, destLen, i; INT16 len, destLen, i;
__DUP(source, source__len, CHAR);
len = Strings_Length(source, source__len); len = Strings_Length(source, source__len);
destLen = __SHORT(dest__len, 32768) - 1; destLen = __SHORT(dest__len, 32768) - 1;
if (pos < 0) { if (pos < 0) {
@ -129,7 +124,6 @@ void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHA
} }
if (pos >= len) { if (pos >= len) {
dest[0] = 0x00; dest[0] = 0x00;
__DEL(source);
return; return;
} }
i = 0; i = 0;
@ -140,19 +134,14 @@ void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHA
i += 1; i += 1;
} }
dest[__X(i, dest__len)] = 0x00; dest[__X(i, dest__len)] = 0x00;
__DEL(source);
} }
INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos) INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos)
{ {
INT16 n1, n2, i, j; INT16 n1, n2, i, j;
__DUP(pattern, pattern__len, CHAR);
__DUP(s, s__len, CHAR);
n1 = Strings_Length(s, s__len); n1 = Strings_Length(s, s__len);
n2 = Strings_Length(pattern, pattern__len); n2 = Strings_Length(pattern, pattern__len);
if (n2 == 0) { if (n2 == 0) {
__DEL(pattern);
__DEL(s);
return 0; return 0;
} }
i = pos; i = pos;
@ -163,15 +152,11 @@ INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len,
j += 1; j += 1;
} }
if (j == n2) { if (j == n2) {
__DEL(pattern);
__DEL(s);
return i; return i;
} }
} }
i += 1; i += 1;
} }
__DEL(pattern);
__DEL(s);
return -1; return -1;
} }
@ -241,7 +226,6 @@ void Strings_StrToReal (CHAR *s, ADDRESS s__len, REAL *r)
INT16 p, e; INT16 p, e;
REAL y, g; REAL y, g;
BOOLEAN neg, negE; BOOLEAN neg, negE;
__DUP(s, s__len, CHAR);
p = 0; p = 0;
while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') { while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') {
p += 1; p += 1;
@ -295,7 +279,6 @@ void Strings_StrToReal (CHAR *s, ADDRESS s__len, REAL *r)
y = -y; y = -y;
} }
*r = y; *r = y;
__DEL(s);
} }
void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r) void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r)
@ -303,7 +286,6 @@ void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r)
INT16 p, e; INT16 p, e;
LONGREAL y, g; LONGREAL y, g;
BOOLEAN neg, negE; BOOLEAN neg, negE;
__DUP(s, s__len, CHAR);
p = 0; p = 0;
while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') { while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') {
p += 1; p += 1;
@ -357,7 +339,6 @@ void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r)
y = -y; y = -y;
} }
*r = y; *r = y;
__DEL(s);
} }

2
bootstrap/unix-44/Strings.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Strings__h #ifndef Strings__h
#define Strings__h #define Strings__h

8
bootstrap/unix-44/Texts.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -1031,13 +1031,11 @@ void Texts_WriteLn (Texts_Writer *W, ADDRESS *W__typ)
void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, ADDRESS s__len) void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, ADDRESS s__len)
{ {
INT16 i; INT16 i;
__DUP(s, s__len, CHAR);
i = 0; i = 0;
while (s[__X(i, s__len)] >= ' ') { while (s[__X(i, s__len)] >= ' ') {
Texts_Write(&*W, W__typ, s[__X(i, s__len)]); Texts_Write(&*W, W__typ, s[__X(i, s__len)]);
i += 1; i += 1;
} }
__DEL(s);
} }
void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n) void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n)
@ -1548,7 +1546,6 @@ void Texts_Open (Texts_Text T, CHAR *name, ADDRESS name__len)
Texts_Piece p = NIL; Texts_Piece p = NIL;
CHAR tag, version; CHAR tag, version;
INT32 hlen; INT32 hlen;
__DUP(name, name__len, CHAR);
f = Files_Old(name, name__len); f = Files_Old(name, name__len);
if (f == NIL) { if (f == NIL) {
f = Files_New((CHAR*)"", 1); f = Files_New((CHAR*)"", 1);
@ -1593,7 +1590,6 @@ void Texts_Open (Texts_Text T, CHAR *name, ADDRESS name__len)
T->cache = T->head; T->cache = T->head;
T->corg = 0; T->corg = 0;
} }
__DEL(name);
} }
static struct Store__39 { static struct Store__39 {
@ -1762,7 +1758,6 @@ void Texts_Close (Texts_Text T, CHAR *name, ADDRESS name__len)
Files_Rider r; Files_Rider r;
INT16 i, res; INT16 i, res;
CHAR bak[64]; CHAR bak[64];
__DUP(name, name__len, CHAR);
f = Files_New(name, name__len); f = Files_New(name, name__len);
Files_Set(&r, Files_Rider__typ, f, 0); Files_Set(&r, Files_Rider__typ, f, 0);
Files_Write(&r, Files_Rider__typ, 0xf0); Files_Write(&r, Files_Rider__typ, 0xf0);
@ -1780,7 +1775,6 @@ void Texts_Close (Texts_Text T, CHAR *name, ADDRESS name__len)
bak[__X(i + 4, 64)] = 0x00; bak[__X(i + 4, 64)] = 0x00;
Files_Rename(name, name__len, bak, 64, &res); Files_Rename(name, name__len, bak, 64, &res);
Files_Register(f); Files_Register(f);
__DEL(name);
} }
static void EnumPtrs(void (*P)(void*)) static void EnumPtrs(void (*P)(void*))

2
bootstrap/unix-44/Texts.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Texts__h #ifndef Texts__h
#define Texts__h #define Texts__h

12
bootstrap/unix-44/VT100.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -87,44 +87,37 @@ void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len)
static void VT100_EscSeq0 (CHAR *letter, ADDRESS letter__len) static void VT100_EscSeq0 (CHAR *letter, ADDRESS letter__len)
{ {
CHAR cmd[9]; CHAR cmd[9];
__DUP(letter, letter__len, CHAR);
__COPY(VT100_CSI, cmd, 9); __COPY(VT100_CSI, cmd, 9);
Strings_Append(letter, letter__len, (void*)cmd, 9); Strings_Append(letter, letter__len, (void*)cmd, 9);
Out_String(cmd, 9); Out_String(cmd, 9);
__DEL(letter);
} }
static void VT100_EscSeq (INT16 n, CHAR *letter, ADDRESS letter__len) static void VT100_EscSeq (INT16 n, CHAR *letter, ADDRESS letter__len)
{ {
CHAR nstr[2]; CHAR nstr[2];
CHAR cmd[7]; CHAR cmd[7];
__DUP(letter, letter__len, CHAR);
VT100_IntToStr(n, (void*)nstr, 2); VT100_IntToStr(n, (void*)nstr, 2);
__COPY(VT100_CSI, cmd, 7); __COPY(VT100_CSI, cmd, 7);
Strings_Append(nstr, 2, (void*)cmd, 7); Strings_Append(nstr, 2, (void*)cmd, 7);
Strings_Append(letter, letter__len, (void*)cmd, 7); Strings_Append(letter, letter__len, (void*)cmd, 7);
Out_String(cmd, 7); Out_String(cmd, 7);
__DEL(letter);
} }
static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, ADDRESS letter__len) static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, ADDRESS letter__len)
{ {
CHAR nstr[2]; CHAR nstr[2];
CHAR cmd[7]; CHAR cmd[7];
__DUP(letter, letter__len, CHAR);
VT100_IntToStr(n, (void*)nstr, 2); VT100_IntToStr(n, (void*)nstr, 2);
__COPY(VT100_CSI, cmd, 7); __COPY(VT100_CSI, cmd, 7);
Strings_Append(letter, letter__len, (void*)cmd, 7); Strings_Append(letter, letter__len, (void*)cmd, 7);
Strings_Append(nstr, 2, (void*)cmd, 7); Strings_Append(nstr, 2, (void*)cmd, 7);
Out_String(cmd, 7); Out_String(cmd, 7);
__DEL(letter);
} }
static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len) static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len)
{ {
CHAR nstr[5], mstr[5]; CHAR nstr[5], mstr[5];
CHAR cmd[12]; CHAR cmd[12];
__DUP(letter, letter__len, CHAR);
VT100_IntToStr(n, (void*)nstr, 5); VT100_IntToStr(n, (void*)nstr, 5);
VT100_IntToStr(m, (void*)mstr, 5); VT100_IntToStr(m, (void*)mstr, 5);
__COPY(VT100_CSI, cmd, 12); __COPY(VT100_CSI, cmd, 12);
@ -133,7 +126,6 @@ static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len)
Strings_Append(mstr, 5, (void*)cmd, 12); Strings_Append(mstr, 5, (void*)cmd, 12);
Strings_Append(letter, letter__len, (void*)cmd, 12); Strings_Append(letter, letter__len, (void*)cmd, 12);
Out_String(cmd, 12); Out_String(cmd, 12);
__DEL(letter);
} }
void VT100_CUU (INT16 n) void VT100_CUU (INT16 n)
@ -239,11 +231,9 @@ void VT100_DECTCEMh (void)
void VT100_SetAttr (CHAR *attr, ADDRESS attr__len) void VT100_SetAttr (CHAR *attr, ADDRESS attr__len)
{ {
CHAR tmpstr[16]; CHAR tmpstr[16];
__DUP(attr, attr__len, CHAR);
__COPY(VT100_CSI, tmpstr, 16); __COPY(VT100_CSI, tmpstr, 16);
Strings_Append(attr, attr__len, (void*)tmpstr, 16); Strings_Append(attr, attr__len, (void*)tmpstr, 16);
Out_String(tmpstr, 16); Out_String(tmpstr, 16);
__DEL(attr);
} }

2
bootstrap/unix-44/VT100.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef VT100__h #ifndef VT100__h
#define VT100__h #define VT100__h

10
bootstrap/unix-44/extTools.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -31,8 +31,6 @@ static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRES
{ {
INT16 r, status, exitcode; INT16 r, status, exitcode;
extTools_CommandString fullcmd; extTools_CommandString fullcmd;
__DUP(title, title__len, CHAR);
__DUP(cmd, cmd__len, CHAR);
if (__IN(18, OPM_Options, 32)) { if (__IN(18, OPM_Options, 32)) {
Out_String((CHAR*)" ", 3); Out_String((CHAR*)" ", 3);
Out_String(cmd, cmd__len); Out_String(cmd, cmd__len);
@ -66,8 +64,6 @@ static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRES
Modules_Halt(exitcode); Modules_Halt(exitcode);
} }
} }
__DEL(title);
__DEL(cmd);
} }
static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len) static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len)
@ -84,19 +80,16 @@ static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len)
void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len) void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len)
{ {
extTools_CommandString cmd; extTools_CommandString cmd;
__DUP(moduleName, moduleName__len, CHAR);
extTools_InitialiseCompilerCommand((void*)cmd, 4096); extTools_InitialiseCompilerCommand((void*)cmd, 4096);
Strings_Append((CHAR*)"-c ", 4, (void*)cmd, 4096); Strings_Append((CHAR*)"-c ", 4, (void*)cmd, 4096);
Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096); Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096);
Strings_Append((CHAR*)".c", 3, (void*)cmd, 4096); Strings_Append((CHAR*)".c", 3, (void*)cmd, 4096);
extTools_execute((CHAR*)"C compile: ", 12, cmd, 4096); extTools_execute((CHAR*)"C compile: ", 12, cmd, 4096);
__DEL(moduleName);
} }
void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len) void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len)
{ {
extTools_CommandString cmd; extTools_CommandString cmd;
__DUP(additionalopts, additionalopts__len, CHAR);
extTools_InitialiseCompilerCommand((void*)cmd, 4096); extTools_InitialiseCompilerCommand((void*)cmd, 4096);
Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096); Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096);
Strings_Append((CHAR*)".c ", 4, (void*)cmd, 4096); Strings_Append((CHAR*)".c ", 4, (void*)cmd, 4096);
@ -116,7 +109,6 @@ void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN stati
Strings_Append((CHAR*)"", 1, (void*)cmd, 4096); Strings_Append((CHAR*)"", 1, (void*)cmd, 4096);
} }
extTools_execute((CHAR*)"C compile and link: ", 21, cmd, 4096); extTools_execute((CHAR*)"C compile and link: ", 21, cmd, 4096);
__DEL(additionalopts);
} }

2
bootstrap/unix-44/extTools.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef extTools__h #ifndef extTools__h
#define extTools__h #define extTools__h

4
bootstrap/unix-48/Compiler.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspamS */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspamS */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -89,7 +89,7 @@ static void Compiler_PropagateElementaryTypeSizes (void)
OPT_sintobj->typ = OPT_sinttyp; OPT_sintobj->typ = OPT_sinttyp;
OPT_intobj->typ = OPT_inttyp; OPT_intobj->typ = OPT_inttyp;
OPT_lintobj->typ = OPT_linttyp; OPT_lintobj->typ = OPT_linttyp;
switch (OPM_LongintSize) { switch (OPM_SetSize) {
case 4: case 4:
OPT_settyp = OPT_set32typ; OPT_settyp = OPT_set32typ;
break; break;

4
bootstrap/unix-48/Configuration.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -19,6 +19,6 @@ export void *Configuration__init(void)
__DEFMOD; __DEFMOD;
__REGMOD("Configuration", 0); __REGMOD("Configuration", 0);
/* BEGIN */ /* BEGIN */
__MOVE("2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 76); __MOVE("2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 76);
__ENDMOD; __ENDMOD;
} }

2
bootstrap/unix-48/Configuration.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Configuration__h #ifndef Configuration__h
#define Configuration__h #define Configuration__h

16
bootstrap/unix-48/Files.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -123,7 +123,6 @@ static void Files_Assert (BOOLEAN truth)
static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode) static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode)
{ {
__DUP(s, s__len, CHAR);
Out_Ln(); Out_Ln();
Out_String((CHAR*)"-- ", 4); Out_String((CHAR*)"-- ", 4);
Out_String(s, s__len); Out_String(s, s__len);
@ -145,14 +144,11 @@ static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode)
} }
Out_Ln(); Out_Ln();
__HALT(99); __HALT(99);
__DEL(s);
} }
static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS name__len, CHAR *dest, ADDRESS dest__len) static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS name__len, CHAR *dest, ADDRESS dest__len)
{ {
INT16 i, j, ld, ln; INT16 i, j, ld, ln;
__DUP(dir, dir__len, CHAR);
__DUP(name, name__len, CHAR);
ld = Strings_Length(dir, dir__len); ld = Strings_Length(dir, dir__len);
ln = Strings_Length(name, name__len); ln = Strings_Length(name, name__len);
while ((ld > 0 && dir[__X(ld - 1, dir__len)] == '/')) { while ((ld > 0 && dir[__X(ld - 1, dir__len)] == '/')) {
@ -177,14 +173,11 @@ static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS
j += 1; j += 1;
} }
dest[__X(i, dest__len)] = 0x00; dest[__X(i, dest__len)] = 0x00;
__DEL(dir);
__DEL(name);
} }
static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *name, ADDRESS name__len) static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *name, ADDRESS name__len)
{ {
INT16 i, n; INT16 i, n;
__DUP(finalName, finalName__len, CHAR);
if (finalName[0] == '/') { if (finalName[0] == '/') {
__COPY(finalName, name, name__len); __COPY(finalName, name, name__len);
} else { } else {
@ -219,7 +212,6 @@ static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *na
i += 1; i += 1;
} }
name[__X(i, name__len)] = 0x00; name[__X(i, name__len)] = 0x00;
__DEL(finalName);
} }
static void Files_Deregister (CHAR *name, ADDRESS name__len) static void Files_Deregister (CHAR *name, ADDRESS name__len)
@ -227,7 +219,6 @@ static void Files_Deregister (CHAR *name, ADDRESS name__len)
Platform_FileIdentity identity; Platform_FileIdentity identity;
Files_File osfile = NIL; Files_File osfile = NIL;
INT16 error; INT16 error;
__DUP(name, name__len, CHAR);
if (Platform_IdentifyByName(name, name__len, &identity, Platform_FileIdentity__typ) == 0) { if (Platform_IdentifyByName(name, name__len, &identity, Platform_FileIdentity__typ) == 0) {
osfile = (Files_File)Files_files; osfile = (Files_File)Files_files;
while ((osfile != NIL && !Platform_SameFile(osfile->identity, identity))) { while ((osfile != NIL && !Platform_SameFile(osfile->identity, identity))) {
@ -246,7 +237,6 @@ static void Files_Deregister (CHAR *name, ADDRESS name__len)
} }
} }
} }
__DEL(name);
} }
static void Files_Create (Files_File f) static void Files_Create (Files_File f)
@ -334,7 +324,6 @@ INT32 Files_Length (Files_File f)
Files_File Files_New (CHAR *name, ADDRESS name__len) Files_File Files_New (CHAR *name, ADDRESS name__len)
{ {
Files_File f = NIL; Files_File f = NIL;
__DUP(name, name__len, CHAR);
__NEW(f, Files_FileDesc); __NEW(f, Files_FileDesc);
f->workName[0] = 0x00; f->workName[0] = 0x00;
__COPY(name, f->registerName, 256); __COPY(name, f->registerName, 256);
@ -343,7 +332,6 @@ Files_File Files_New (CHAR *name, ADDRESS name__len)
f->len = 0; f->len = 0;
f->pos = 0; f->pos = 0;
f->swapper = -1; f->swapper = -1;
__DEL(name);
return f; return f;
} }
@ -1082,14 +1070,12 @@ static void Files_Finalize (SYSTEM_PTR o)
void Files_SetSearchPath (CHAR *path, ADDRESS path__len) void Files_SetSearchPath (CHAR *path, ADDRESS path__len)
{ {
__DUP(path, path__len, CHAR);
if (Strings_Length(path, path__len) != 0) { if (Strings_Length(path, path__len) != 0) {
Files_SearchPath = __NEWARR(NIL, 1, 1, 1, 1, ((ADDRESS)((Strings_Length(path, path__len) + 1)))); Files_SearchPath = __NEWARR(NIL, 1, 1, 1, 1, ((ADDRESS)((Strings_Length(path, path__len) + 1))));
__COPY(path, Files_SearchPath->data, Files_SearchPath->len[0]); __COPY(path, Files_SearchPath->data, Files_SearchPath->len[0]);
} else { } else {
Files_SearchPath = NIL; Files_SearchPath = NIL;
} }
__DEL(path);
} }
static void EnumPtrs(void (*P)(void*)) static void EnumPtrs(void (*P)(void*))

2
bootstrap/unix-48/Files.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Files__h #ifndef Files__h
#define Files__h #define Files__h

6
bootstrap/unix-48/Heap.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -151,7 +151,6 @@ SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs)
INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len) INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len)
{ {
Heap_Module m, p; Heap_Module m, p;
__DUP(name, name__len, CHAR);
m = (Heap_Module)(ADDRESS)Heap_modules; m = (Heap_Module)(ADDRESS)Heap_modules;
while ((m != NIL && __STRCMP(m->name, name) != 0)) { while ((m != NIL && __STRCMP(m->name, name) != 0)) {
p = m; p = m;
@ -163,14 +162,11 @@ INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len)
} else { } else {
p->next = m->next; p->next = m->next;
} }
__DEL(name);
return 0; return 0;
} else { } else {
if (m == NIL) { if (m == NIL) {
__DEL(name);
return -1; return -1;
} else { } else {
__DEL(name);
return m->refcnt; return m->refcnt;
} }
} }

2
bootstrap/unix-48/Heap.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */
#ifndef Heap__h #ifndef Heap__h
#define Heap__h #define Heap__h

37
bootstrap/unix-48/Modules.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -100,33 +100,28 @@ INT16 Modules_ArgPos (CHAR *s, ADDRESS s__len)
{ {
INT16 i; INT16 i;
CHAR arg[256]; CHAR arg[256];
__DUP(s, s__len, CHAR);
i = 0; i = 0;
Modules_GetArg(i, (void*)arg, 256); Modules_GetArg(i, (void*)arg, 256);
while ((i < Modules_ArgCount && __STRCMP(s, arg) != 0)) { while ((i < Modules_ArgCount && __STRCMP(s, arg) != 0)) {
i += 1; i += 1;
Modules_GetArg(i, (void*)arg, 256); Modules_GetArg(i, (void*)arg, 256);
} }
__DEL(s);
return i; return i;
} }
static INT16 Modules_CharCount (CHAR *s, ADDRESS s__len) static INT16 Modules_CharCount (CHAR *s, ADDRESS s__len)
{ {
INT16 i; INT16 i;
__DUP(s, s__len, CHAR);
i = 0; i = 0;
while ((i < s__len && s[__X(i, s__len)] != 0x00)) { while ((i < s__len && s[__X(i, s__len)] != 0x00)) {
i += 1; i += 1;
} }
__DEL(s);
return i; return i;
} }
static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len) static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
{ {
INT16 i, j; INT16 i, j;
__DUP(s, s__len, CHAR);
i = 0; i = 0;
j = Modules_CharCount(d, d__len); j = Modules_CharCount(d, d__len);
while (s[__X(i, s__len)] != 0x00) { while (s[__X(i, s__len)] != 0x00) {
@ -135,13 +130,11 @@ static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
j += 1; j += 1;
} }
d[__X(j, d__len)] = 0x00; d[__X(j, d__len)] = 0x00;
__DEL(s);
} }
static void Modules_AppendPart (CHAR c, CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len) static void Modules_AppendPart (CHAR c, CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
{ {
INT16 i, j; INT16 i, j;
__DUP(s, s__len, CHAR);
i = 0; i = 0;
j = Modules_CharCount(d, d__len); j = Modules_CharCount(d, d__len);
if ((j > 0 && d[__X(j - 1, d__len)] != c)) { if ((j > 0 && d[__X(j - 1, d__len)] != c)) {
@ -154,69 +147,54 @@ static void Modules_AppendPart (CHAR c, CHAR *s, ADDRESS s__len, CHAR *d, ADDRES
j += 1; j += 1;
} }
d[__X(j, d__len)] = 0x00; d[__X(j, d__len)] = 0x00;
__DEL(s);
} }
static BOOLEAN Modules_IsOneOf (CHAR c, CHAR *s, ADDRESS s__len) static BOOLEAN Modules_IsOneOf (CHAR c, CHAR *s, ADDRESS s__len)
{ {
INT16 i; INT16 i;
__DUP(s, s__len, CHAR);
if (c == 0x00) { if (c == 0x00) {
__DEL(s);
return 0; return 0;
} }
i = 0; i = 0;
while ((s[__X(i, s__len)] != c && s[__X(i, s__len)] != 0x00)) { while ((s[__X(i, s__len)] != c && s[__X(i, s__len)] != 0x00)) {
i += 1; i += 1;
} }
__DEL(s);
return s[__X(i, s__len)] == c; return s[__X(i, s__len)] == c;
} }
static BOOLEAN Modules_IsAbsolute (CHAR *d, ADDRESS d__len) static BOOLEAN Modules_IsAbsolute (CHAR *d, ADDRESS d__len)
{ {
__DUP(d, d__len, CHAR);
if (d[0] == 0x00) { if (d[0] == 0x00) {
__DEL(d);
return 0; return 0;
} }
if (Modules_IsOneOf(d[0], (CHAR*)"/\\", 3)) { if (Modules_IsOneOf(d[0], (CHAR*)"/\\", 3)) {
__DEL(d);
return 1; return 1;
} }
if (d[__X(1, d__len)] == ':') { if (d[__X(1, d__len)] == ':') {
__DEL(d);
return 1; return 1;
} }
__DEL(d);
return 0; return 0;
} }
static void Modules_Canonify (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len) static void Modules_Canonify (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
{ {
__DUP(s, s__len, CHAR);
if (Modules_IsAbsolute(s, s__len)) { if (Modules_IsAbsolute(s, s__len)) {
__COPY(s, d, d__len); __COPY(s, d, d__len);
} else { } else {
__COPY(Platform_CWD, d, d__len); __COPY(Platform_CWD, d, d__len);
Modules_AppendPart('/', s, s__len, (void*)d, d__len); Modules_AppendPart('/', s, s__len, (void*)d, d__len);
} }
__DEL(s);
} }
static BOOLEAN Modules_IsFilePresent (CHAR *s, ADDRESS s__len) static BOOLEAN Modules_IsFilePresent (CHAR *s, ADDRESS s__len)
{ {
Platform_FileIdentity identity; Platform_FileIdentity identity;
__DUP(s, s__len, CHAR);
__DEL(s);
return Platform_IdentifyByName(s, s__len, &identity, Platform_FileIdentity__typ) == 0; return Platform_IdentifyByName(s, s__len, &identity, Platform_FileIdentity__typ) == 0;
} }
static void Modules_ExtractPart (CHAR *s, ADDRESS s__len, INT16 *i, CHAR *p, ADDRESS p__len, CHAR *d, ADDRESS d__len) static void Modules_ExtractPart (CHAR *s, ADDRESS s__len, INT16 *i, CHAR *p, ADDRESS p__len, CHAR *d, ADDRESS d__len)
{ {
INT16 j; INT16 j;
__DUP(s, s__len, CHAR);
__DUP(p, p__len, CHAR);
j = 0; j = 0;
while ((s[__X(*i, s__len)] != 0x00 && !Modules_IsOneOf(s[__X(*i, s__len)], p, p__len))) { while ((s[__X(*i, s__len)] != 0x00 && !Modules_IsOneOf(s[__X(*i, s__len)], p, p__len))) {
d[__X(j, d__len)] = s[__X(*i, s__len)]; d[__X(j, d__len)] = s[__X(*i, s__len)];
@ -227,15 +205,12 @@ static void Modules_ExtractPart (CHAR *s, ADDRESS s__len, INT16 *i, CHAR *p, ADD
while (Modules_IsOneOf(s[__X(*i, s__len)], p, p__len)) { while (Modules_IsOneOf(s[__X(*i, s__len)], p, p__len)) {
*i += 1; *i += 1;
} }
__DEL(s);
__DEL(p);
} }
static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len) static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
{ {
INT16 i, j; INT16 i, j;
CHAR part[1024]; CHAR part[1024];
__DUP(s, s__len, CHAR);
i = 0; i = 0;
j = 0; j = 0;
while ((i < 2 && Modules_IsOneOf(s[__X(i, s__len)], (CHAR*)"/\\", 3))) { while ((i < 2 && Modules_IsOneOf(s[__X(i, s__len)], (CHAR*)"/\\", 3))) {
@ -250,7 +225,6 @@ static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
Modules_AppendPart('/', part, 1024, (void*)d, d__len); Modules_AppendPart('/', part, 1024, (void*)d, d__len);
} }
} }
__DEL(s);
} }
typedef typedef
@ -306,7 +280,6 @@ Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len)
Heap_Module m = NIL; Heap_Module m = NIL;
CHAR bodyname[64]; CHAR bodyname[64];
Heap_Command body; Heap_Command body;
__DUP(name, name__len, CHAR);
m = Modules_modules(); m = Modules_modules();
while ((m != NIL && __STRCMP(m->name, name) != 0)) { while ((m != NIL && __STRCMP(m->name, name) != 0)) {
m = m->next; m = m->next;
@ -321,14 +294,12 @@ Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len)
Modules_Append(name, name__len, (void*)Modules_resMsg, 256); Modules_Append(name, name__len, (void*)Modules_resMsg, 256);
Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256); Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256);
} }
__DEL(name);
return m; return m;
} }
Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len) Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len)
{ {
Heap_Cmd c = NIL; Heap_Cmd c = NIL;
__DUP(name, name__len, CHAR);
c = mod->cmds; c = mod->cmds;
while ((c != NIL && __STRCMP(c->name, name) != 0)) { while ((c != NIL && __STRCMP(c->name, name) != 0)) {
c = c->next; c = c->next;
@ -336,7 +307,6 @@ Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len
if (c != NIL) { if (c != NIL) {
Modules_res = 0; Modules_res = 0;
Modules_resMsg[0] = 0x00; Modules_resMsg[0] = 0x00;
__DEL(name);
return c->cmd; return c->cmd;
} else { } else {
Modules_res = 2; Modules_res = 2;
@ -346,7 +316,6 @@ Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len
Modules_Append((CHAR*)".", 2, (void*)Modules_resMsg, 256); Modules_Append((CHAR*)".", 2, (void*)Modules_resMsg, 256);
Modules_Append(name, name__len, (void*)Modules_resMsg, 256); Modules_Append(name, name__len, (void*)Modules_resMsg, 256);
Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256); Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256);
__DEL(name);
return NIL; return NIL;
} }
__RETCHK; __RETCHK;
@ -356,7 +325,6 @@ void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all)
{ {
Heap_Module m = NIL, p = NIL; Heap_Module m = NIL, p = NIL;
INT32 refcount; INT32 refcount;
__DUP(name, name__len, CHAR);
m = Modules_modules(); m = Modules_modules();
if (all) { if (all) {
Modules_res = 1; Modules_res = 1;
@ -374,7 +342,6 @@ void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all)
Modules_res = 1; Modules_res = 1;
} }
} }
__DEL(name);
} }
static void Modules_errch (CHAR c) static void Modules_errch (CHAR c)
@ -386,13 +353,11 @@ static void Modules_errch (CHAR c)
static void Modules_errstring (CHAR *s, ADDRESS s__len) static void Modules_errstring (CHAR *s, ADDRESS s__len)
{ {
INT32 i; INT32 i;
__DUP(s, s__len, CHAR);
i = 0; i = 0;
while ((i < s__len && s[__X(i, s__len)] != 0x00)) { while ((i < s__len && s[__X(i, s__len)] != 0x00)) {
Modules_errch(s[__X(i, s__len)]); Modules_errch(s[__X(i, s__len)]);
i += 1; i += 1;
} }
__DEL(s);
} }
static void Modules_errint (INT32 l) static void Modules_errint (INT32 l)

2
bootstrap/unix-48/Modules.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Modules__h #ifndef Modules__h
#define Modules__h #define Modules__h

277
bootstrap/unix-48/OPB.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -27,6 +27,7 @@ static void OPB_CheckProc (OPT_Struct x, OPT_Object y);
static void OPB_CheckPtr (OPT_Node x, OPT_Node y); static void OPB_CheckPtr (OPT_Node x, OPT_Node y);
static void OPB_CheckRealType (INT16 f, INT16 nr, OPT_Const x); static void OPB_CheckRealType (INT16 f, INT16 nr, OPT_Const x);
static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp); static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp);
static void OPB_CheckWrite (OPT_Node x);
static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y); static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y);
export void OPB_Construct (INT8 class, OPT_Node *x, OPT_Node y); export void OPB_Construct (INT8 class, OPT_Node *x, OPT_Node y);
static void OPB_Convert (OPT_Node *x, OPT_Struct typ); static void OPB_Convert (OPT_Node *x, OPT_Struct typ);
@ -101,9 +102,6 @@ OPT_Node OPB_NewLeaf (OPT_Object obj)
} }
node->obj = obj; node->obj = obj;
node->typ = obj->typ; node->typ = obj->typ;
if ((((obj->mode == 1 && __IN(obj->typ->comp, 0x0c, 32))) && obj->typ->sysflag != 0)) {
node->readonly = 1;
}
return node; return node;
} }
@ -359,16 +357,16 @@ void OPB_Field (OPT_Node *x, OPT_Object y)
} }
} }
static struct TypTest__58 { static struct TypTest__59 {
OPT_Node *x; OPT_Node *x;
OPT_Object *obj; OPT_Object *obj;
BOOLEAN *guard; BOOLEAN *guard;
struct TypTest__58 *lnk; struct TypTest__59 *lnk;
} *TypTest__58_s; } *TypTest__59_s;
static void GTT__59 (OPT_Struct t0, OPT_Struct t1); static void GTT__60 (OPT_Struct t0, OPT_Struct t1);
static void GTT__59 (OPT_Struct t0, OPT_Struct t1) static void GTT__60 (OPT_Struct t0, OPT_Struct t1)
{ {
OPT_Node node = NIL; OPT_Node node = NIL;
OPT_Struct t = NIL; OPT_Struct t = NIL;
@ -381,54 +379,54 @@ static void GTT__59 (OPT_Struct t0, OPT_Struct t1)
t1 = t1->BaseTyp; t1 = t1->BaseTyp;
} }
if (t1 == t0 || t0->form == 0) { if (t1 == t0 || t0->form == 0) {
if (*TypTest__58_s->guard) { if (*TypTest__59_s->guard) {
OPB_BindNodes(5, NIL, &*TypTest__58_s->x, NIL); OPB_BindNodes(5, NIL, &*TypTest__59_s->x, NIL);
(*TypTest__58_s->x)->readonly = (*TypTest__58_s->x)->left->readonly; (*TypTest__59_s->x)->readonly = (*TypTest__59_s->x)->left->readonly;
} else { } else {
node = OPT_NewNode(11); node = OPT_NewNode(11);
node->subcl = 16; node->subcl = 16;
node->left = *TypTest__58_s->x; node->left = *TypTest__59_s->x;
node->obj = *TypTest__58_s->obj; node->obj = *TypTest__59_s->obj;
*TypTest__58_s->x = node; *TypTest__59_s->x = node;
} }
} else { } else {
OPB_err(85); OPB_err(85);
} }
} else if (t0 != t1) { } else if (t0 != t1) {
OPB_err(85); OPB_err(85);
} else if (!*TypTest__58_s->guard) { } else if (!*TypTest__59_s->guard) {
if ((*TypTest__58_s->x)->class == 5) { if ((*TypTest__59_s->x)->class == 5) {
node = OPT_NewNode(11); node = OPT_NewNode(11);
node->subcl = 16; node->subcl = 16;
node->left = *TypTest__58_s->x; node->left = *TypTest__59_s->x;
node->obj = *TypTest__58_s->obj; node->obj = *TypTest__59_s->obj;
*TypTest__58_s->x = node; *TypTest__59_s->x = node;
} else { } else {
*TypTest__58_s->x = OPB_NewBoolConst(1); *TypTest__59_s->x = OPB_NewBoolConst(1);
} }
} }
} }
void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard) void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
{ {
struct TypTest__58 _s; struct TypTest__59 _s;
_s.x = x; _s.x = x;
_s.obj = &obj; _s.obj = &obj;
_s.guard = &guard; _s.guard = &guard;
_s.lnk = TypTest__58_s; _s.lnk = TypTest__59_s;
TypTest__58_s = &_s; TypTest__59_s = &_s;
if (OPB_NotVar(*x)) { if (OPB_NotVar(*x)) {
OPB_err(112); OPB_err(112);
} else if ((*x)->typ->form == 11) { } else if ((*x)->typ->form == 11) {
if (((*x)->typ->BaseTyp->comp != 4 && (*x)->typ != OPT_sysptrtyp)) { if (((*x)->typ->BaseTyp->comp != 4 && (*x)->typ != OPT_sysptrtyp)) {
OPB_err(85); OPB_err(85);
} else if (obj->typ->form == 11) { } else if (obj->typ->form == 11) {
GTT__59((*x)->typ->BaseTyp, obj->typ->BaseTyp); GTT__60((*x)->typ->BaseTyp, obj->typ->BaseTyp);
} else { } else {
OPB_err(86); OPB_err(86);
} }
} else if (((((*x)->typ->comp == 4 && (*x)->class == 1)) && obj->typ->comp == 4)) { } else if (((((*x)->typ->comp == 4 && (*x)->class == 1)) && obj->typ->comp == 4)) {
GTT__59((*x)->typ, obj->typ); GTT__60((*x)->typ, obj->typ);
} else { } else {
OPB_err(87); OPB_err(87);
} }
@ -437,7 +435,7 @@ void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
} else { } else {
(*x)->typ = OPT_booltyp; (*x)->typ = OPT_booltyp;
} }
TypTest__58_s = _s.lnk; TypTest__59_s = _s.lnk;
} }
void OPB_In (OPT_Node *x, OPT_Node y) void OPB_In (OPT_Node *x, OPT_Node y)
@ -501,13 +499,13 @@ static void OPB_CheckRealType (INT16 f, INT16 nr, OPT_Const x)
x->intval = -1; x->intval = -1;
} }
static struct MOp__28 { static struct MOp__29 {
struct MOp__28 *lnk; struct MOp__29 *lnk;
} *MOp__28_s; } *MOp__29_s;
static OPT_Node NewOp__29 (INT8 op, OPT_Struct typ, OPT_Node z); static OPT_Node NewOp__30 (INT8 op, OPT_Struct typ, OPT_Node z);
static OPT_Node NewOp__29 (INT8 op, OPT_Struct typ, OPT_Node z) static OPT_Node NewOp__30 (INT8 op, OPT_Struct typ, OPT_Node z)
{ {
OPT_Node node = NIL; OPT_Node node = NIL;
node = OPT_NewNode(11); node = OPT_NewNode(11);
@ -522,9 +520,9 @@ void OPB_MOp (INT8 op, OPT_Node *x)
INT16 f; INT16 f;
OPT_Struct typ = NIL; OPT_Struct typ = NIL;
OPT_Node z = NIL; OPT_Node z = NIL;
struct MOp__28 _s; struct MOp__29 _s;
_s.lnk = MOp__28_s; _s.lnk = MOp__29_s;
MOp__28_s = &_s; MOp__29_s = &_s;
z = *x; z = *x;
if (z->class == 8 || z->class == 9) { if (z->class == 8 || z->class == 9) {
OPB_err(126); OPB_err(126);
@ -538,7 +536,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
z->conval->intval = OPB_BoolToInt(!OPB_IntToBool(z->conval->intval)); z->conval->intval = OPB_BoolToInt(!OPB_IntToBool(z->conval->intval));
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__29(op, typ, z); z = NewOp__30(op, typ, z);
} }
} else { } else {
OPB_err(98); OPB_err(98);
@ -570,7 +568,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
} }
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__29(op, typ, z); z = NewOp__30(op, typ, z);
} }
} else { } else {
OPB_err(97); OPB_err(97);
@ -591,7 +589,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
} }
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__29(op, typ, z); z = NewOp__30(op, typ, z);
} }
} else { } else {
OPB_err(111); OPB_err(111);
@ -603,7 +601,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
z->conval->intval = (INT16)__CAP(__CHR(z->conval->intval)); z->conval->intval = (INT16)__CAP(__CHR(z->conval->intval));
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__29(op, typ, z); z = NewOp__30(op, typ, z);
} }
} else { } else {
OPB_err(111); OPB_err(111);
@ -616,7 +614,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
z->conval->intval = OPB_BoolToInt(__ODD(z->conval->intval)); z->conval->intval = OPB_BoolToInt(__ODD(z->conval->intval));
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__29(op, typ, z); z = NewOp__30(op, typ, z);
} }
} else { } else {
OPB_err(111); OPB_err(111);
@ -629,7 +627,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
f = 8; f = 8;
} }
if (z->class < 7 || f == 8) { if (z->class < 7 || f == 8) {
z = NewOp__29(op, typ, z); z = NewOp__30(op, typ, z);
} else { } else {
OPB_err(127); OPB_err(127);
} }
@ -638,7 +636,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
case 25: case 25:
if ((f == 4 && z->class == 7)) { if ((f == 4 && z->class == 7)) {
if ((0 <= z->conval->intval && z->conval->intval <= -1)) { if ((0 <= z->conval->intval && z->conval->intval <= -1)) {
z = NewOp__29(op, typ, z); z = NewOp__30(op, typ, z);
} else { } else {
OPB_err(219); OPB_err(219);
} }
@ -655,7 +653,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
} }
} }
*x = z; *x = z;
MOp__28_s = _s.lnk; MOp__29_s = _s.lnk;
} }
static void OPB_CheckPtr (OPT_Node x, OPT_Node y) static void OPB_CheckPtr (OPT_Node x, OPT_Node y)
@ -742,65 +740,65 @@ static void OPB_CheckProc (OPT_Struct x, OPT_Object y)
} }
} }
static struct ConstOp__13 { static struct ConstOp__14 {
OPT_Node *x; OPT_Node *x;
INT16 *f; INT16 *f;
OPT_Const *xval, *yval; OPT_Const *xval, *yval;
struct ConstOp__13 *lnk; struct ConstOp__14 *lnk;
} *ConstOp__13_s; } *ConstOp__14_s;
static INT16 ConstCmp__14 (void); static INT16 ConstCmp__15 (void);
static INT16 ConstCmp__14 (void) static INT16 ConstCmp__15 (void)
{ {
INT16 res; INT16 res;
switch (*ConstOp__13_s->f) { switch (*ConstOp__14_s->f) {
case 0: case 0:
res = 9; res = 9;
break; break;
case 1: case 3: case 4: case 1: case 3: case 4:
if ((*ConstOp__13_s->xval)->intval < (*ConstOp__13_s->yval)->intval) { if ((*ConstOp__14_s->xval)->intval < (*ConstOp__14_s->yval)->intval) {
res = 11; res = 11;
} else if ((*ConstOp__13_s->xval)->intval > (*ConstOp__13_s->yval)->intval) { } else if ((*ConstOp__14_s->xval)->intval > (*ConstOp__14_s->yval)->intval) {
res = 13; res = 13;
} else { } else {
res = 9; res = 9;
} }
break; break;
case 5: case 6: case 5: case 6:
if ((*ConstOp__13_s->xval)->realval < (*ConstOp__13_s->yval)->realval) { if ((*ConstOp__14_s->xval)->realval < (*ConstOp__14_s->yval)->realval) {
res = 11; res = 11;
} else if ((*ConstOp__13_s->xval)->realval > (*ConstOp__13_s->yval)->realval) { } else if ((*ConstOp__14_s->xval)->realval > (*ConstOp__14_s->yval)->realval) {
res = 13; res = 13;
} else { } else {
res = 9; res = 9;
} }
break; break;
case 2: case 2:
if ((*ConstOp__13_s->xval)->intval != (*ConstOp__13_s->yval)->intval) { if ((*ConstOp__14_s->xval)->intval != (*ConstOp__14_s->yval)->intval) {
res = 10; res = 10;
} else { } else {
res = 9; res = 9;
} }
break; break;
case 7: case 7:
if ((*ConstOp__13_s->xval)->setval != (*ConstOp__13_s->yval)->setval) { if ((*ConstOp__14_s->xval)->setval != (*ConstOp__14_s->yval)->setval) {
res = 10; res = 10;
} else { } else {
res = 9; res = 9;
} }
break; break;
case 8: case 8:
if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) < 0) { if (__STRCMP(*(*ConstOp__14_s->xval)->ext, *(*ConstOp__14_s->yval)->ext) < 0) {
res = 11; res = 11;
} else if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) > 0) { } else if (__STRCMP(*(*ConstOp__14_s->xval)->ext, *(*ConstOp__14_s->yval)->ext) > 0) {
res = 13; res = 13;
} else { } else {
res = 9; res = 9;
} }
break; break;
case 9: case 11: case 12: case 9: case 11: case 12:
if ((*ConstOp__13_s->xval)->intval != (*ConstOp__13_s->yval)->intval) { if ((*ConstOp__14_s->xval)->intval != (*ConstOp__14_s->yval)->intval) {
res = 10; res = 10;
} else { } else {
res = 9; res = 9;
@ -808,11 +806,11 @@ static INT16 ConstCmp__14 (void)
break; break;
default: default:
OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstCmp, f = ", 37); OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstCmp, f = ", 37);
OPM_LogWNum(*ConstOp__13_s->f, 0); OPM_LogWNum(*ConstOp__14_s->f, 0);
OPM_LogWLn(); OPM_LogWLn();
break; break;
} }
(*ConstOp__13_s->x)->typ = OPT_booltyp; (*ConstOp__14_s->x)->typ = OPT_booltyp;
return res; return res;
} }
@ -822,13 +820,13 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
OPT_Const xval = NIL, yval = NIL; OPT_Const xval = NIL, yval = NIL;
INT64 xv, yv; INT64 xv, yv;
BOOLEAN temp; BOOLEAN temp;
struct ConstOp__13 _s; struct ConstOp__14 _s;
_s.x = &x; _s.x = &x;
_s.f = &f; _s.f = &f;
_s.xval = &xval; _s.xval = &xval;
_s.yval = &yval; _s.yval = &yval;
_s.lnk = ConstOp__13_s; _s.lnk = ConstOp__14_s;
ConstOp__13_s = &_s; ConstOp__14_s = &_s;
f = x->typ->form; f = x->typ->form;
g = y->typ->form; g = y->typ->form;
xval = x->conval; xval = x->conval;
@ -1055,37 +1053,37 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
} }
break; break;
case 9: case 9:
xval->intval = OPB_BoolToInt(ConstCmp__14() == 9); xval->intval = OPB_BoolToInt(ConstCmp__15() == 9);
break; break;
case 10: case 10:
xval->intval = OPB_BoolToInt(ConstCmp__14() != 9); xval->intval = OPB_BoolToInt(ConstCmp__15() != 9);
break; break;
case 11: case 11:
if (__IN(f, 0x0a84, 32)) { if (__IN(f, 0x0a84, 32)) {
OPB_err(108); OPB_err(108);
} else { } else {
xval->intval = OPB_BoolToInt(ConstCmp__14() == 11); xval->intval = OPB_BoolToInt(ConstCmp__15() == 11);
} }
break; break;
case 12: case 12:
if (__IN(f, 0x0a84, 32)) { if (__IN(f, 0x0a84, 32)) {
OPB_err(108); OPB_err(108);
} else { } else {
xval->intval = OPB_BoolToInt(ConstCmp__14() != 13); xval->intval = OPB_BoolToInt(ConstCmp__15() != 13);
} }
break; break;
case 13: case 13:
if (__IN(f, 0x0a84, 32)) { if (__IN(f, 0x0a84, 32)) {
OPB_err(108); OPB_err(108);
} else { } else {
xval->intval = OPB_BoolToInt(ConstCmp__14() == 13); xval->intval = OPB_BoolToInt(ConstCmp__15() == 13);
} }
break; break;
case 14: case 14:
if (__IN(f, 0x0a84, 32)) { if (__IN(f, 0x0a84, 32)) {
OPB_err(108); OPB_err(108);
} else { } else {
xval->intval = OPB_BoolToInt(ConstCmp__14() != 11); xval->intval = OPB_BoolToInt(ConstCmp__15() != 11);
} }
break; break;
default: default:
@ -1094,7 +1092,7 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
OPM_LogWLn(); OPM_LogWLn();
break; break;
} }
ConstOp__13_s = _s.lnk; ConstOp__14_s = _s.lnk;
} }
static void OPB_Convert (OPT_Node *x, OPT_Struct typ) static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
@ -1157,15 +1155,15 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
(*x)->typ = typ; (*x)->typ = typ;
} }
static struct Op__38 { static struct Op__39 {
INT16 *f, *g; INT16 *f, *g;
struct Op__38 *lnk; struct Op__39 *lnk;
} *Op__38_s; } *Op__39_s;
static void NewOp__39 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y); static void NewOp__40 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y);
static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y); static BOOLEAN strings__42 (OPT_Node *x, OPT_Node *y);
static void NewOp__39 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y) static void NewOp__40 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
{ {
OPT_Node node = NIL; OPT_Node node = NIL;
node = OPT_NewNode(12); node = OPT_NewNode(12);
@ -1176,28 +1174,28 @@ static void NewOp__39 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
*x = node; *x = node;
} }
static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y) static BOOLEAN strings__42 (OPT_Node *x, OPT_Node *y)
{ {
BOOLEAN ok, xCharArr, yCharArr; BOOLEAN ok, xCharArr, yCharArr;
xCharArr = (__IN((*x)->typ->comp, 0x0c, 32) && (*x)->typ->BaseTyp->form == 3) || *Op__38_s->f == 8; xCharArr = (__IN((*x)->typ->comp, 0x0c, 32) && (*x)->typ->BaseTyp->form == 3) || *Op__39_s->f == 8;
yCharArr = (__IN((*y)->typ->comp, 0x0c, 32) && (*y)->typ->BaseTyp->form == 3) || *Op__38_s->g == 8; yCharArr = (__IN((*y)->typ->comp, 0x0c, 32) && (*y)->typ->BaseTyp->form == 3) || *Op__39_s->g == 8;
if ((((xCharArr && *Op__38_s->g == 3)) && (*y)->class == 7)) { if ((((xCharArr && *Op__39_s->g == 3)) && (*y)->class == 7)) {
OPB_CharToString(*y); OPB_CharToString(*y);
*Op__38_s->g = 8; *Op__39_s->g = 8;
yCharArr = 1; yCharArr = 1;
} }
if ((((yCharArr && *Op__38_s->f == 3)) && (*x)->class == 7)) { if ((((yCharArr && *Op__39_s->f == 3)) && (*x)->class == 7)) {
OPB_CharToString(*x); OPB_CharToString(*x);
*Op__38_s->f = 8; *Op__39_s->f = 8;
xCharArr = 1; xCharArr = 1;
} }
ok = (xCharArr && yCharArr); ok = (xCharArr && yCharArr);
if (ok) { if (ok) {
if ((*Op__38_s->f == 8 && (*x)->conval->intval2 == 1)) { if ((*Op__39_s->f == 8 && (*x)->conval->intval2 == 1)) {
(*x)->typ = OPT_chartyp; (*x)->typ = OPT_chartyp;
(*x)->conval->intval = 0; (*x)->conval->intval = 0;
OPB_Index(&*y, OPB_NewIntConst(0)); OPB_Index(&*y, OPB_NewIntConst(0));
} else if ((*Op__38_s->g == 8 && (*y)->conval->intval2 == 1)) { } else if ((*Op__39_s->g == 8 && (*y)->conval->intval2 == 1)) {
(*y)->typ = OPT_chartyp; (*y)->typ = OPT_chartyp;
(*y)->conval->intval = 0; (*y)->conval->intval = 0;
OPB_Index(&*x, OPB_NewIntConst(0)); OPB_Index(&*x, OPB_NewIntConst(0));
@ -1213,11 +1211,11 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
OPT_Struct typ = NIL; OPT_Struct typ = NIL;
BOOLEAN do_; BOOLEAN do_;
INT64 val; INT64 val;
struct Op__38 _s; struct Op__39 _s;
_s.f = &f; _s.f = &f;
_s.g = &g; _s.g = &g;
_s.lnk = Op__38_s; _s.lnk = Op__39_s;
Op__38_s = &_s; Op__39_s = &_s;
z = *x; z = *x;
if (((z->class == 8 || z->class == 9) || y->class == 8) || y->class == 9) { if (((z->class == 8 || z->class == 9) || y->class == 8) || y->class == 9) {
OPB_err(126); OPB_err(126);
@ -1338,7 +1336,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp; typ = OPT_undftyp;
} }
if (do_) { if (do_) {
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
} }
break; break;
case 2: case 2:
@ -1357,7 +1355,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
OPB_err(102); OPB_err(102);
typ = OPT_undftyp; typ = OPT_undftyp;
} }
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
break; break;
case 3: case 3:
do_ = 1; do_ = 1;
@ -1380,7 +1378,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp; typ = OPT_undftyp;
} }
if (do_) { if (do_) {
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
} }
break; break;
case 4: case 4:
@ -1398,7 +1396,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
OPB_err(104); OPB_err(104);
typ = OPT_undftyp; typ = OPT_undftyp;
} }
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
break; break;
case 5: case 5:
if (f == 2) { if (f == 2) {
@ -1408,7 +1406,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
} }
} else if ((y->class == 7 && OPB_IntToBool(y->conval->intval))) { } else if ((y->class == 7 && OPB_IntToBool(y->conval->intval))) {
} else { } else {
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
} }
} else if (f != 0) { } else if (f != 0) {
OPB_err(94); OPB_err(94);
@ -1431,7 +1429,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
} }
} }
if (do_) { if (do_) {
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
} }
break; break;
case 7: case 7:
@ -1440,7 +1438,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp; typ = OPT_undftyp;
} }
if ((f != 4 || y->class != 7) || y->conval->intval != 0) { if ((f != 4 || y->class != 7) || y->conval->intval != 0) {
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
} }
break; break;
case 8: case 8:
@ -1451,7 +1449,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
} }
} else if ((y->class == 7 && !OPB_IntToBool(y->conval->intval))) { } else if ((y->class == 7 && !OPB_IntToBool(y->conval->intval))) {
} else { } else {
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
} }
} else if (f != 0) { } else if (f != 0) {
OPB_err(95); OPB_err(95);
@ -1459,16 +1457,16 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
} }
break; break;
case 9: case 10: case 9: case 10:
if (__IN(f, 0x1aff, 32) || strings__41(&z, &y)) { if (__IN(f, 0x1aff, 32) || strings__42(&z, &y)) {
typ = OPT_booltyp; typ = OPT_booltyp;
} else { } else {
OPB_err(107); OPB_err(107);
typ = OPT_undftyp; typ = OPT_undftyp;
} }
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
break; break;
case 11: case 12: case 13: case 14: case 11: case 12: case 13: case 14:
if (__IN(f, 0x79, 32) || strings__41(&z, &y)) { if (__IN(f, 0x79, 32) || strings__42(&z, &y)) {
typ = OPT_booltyp; typ = OPT_booltyp;
} else { } else {
OPM_LogWLn(); OPM_LogWLn();
@ -1477,7 +1475,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
OPB_err(108); OPB_err(108);
typ = OPT_undftyp; typ = OPT_undftyp;
} }
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
break; break;
default: default:
OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", 32); OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", 32);
@ -1487,7 +1485,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
} }
} }
*x = z; *x = z;
Op__38_s = _s.lnk; Op__39_s = _s.lnk;
} }
void OPB_SetRange (OPT_Node *x, OPT_Node y) void OPB_SetRange (OPT_Node *x, OPT_Node y)
@ -1672,6 +1670,19 @@ static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo)
{ {
} }
static void OPB_CheckWrite (OPT_Node x)
{
if (x->readonly) {
OPB_err(76);
}
while (__IN(x->class, 0x74, 32)) {
x = x->left;
}
if ((x != NIL && x->obj != NIL)) {
x->obj->written = 1;
}
}
void OPB_StPar0 (OPT_Node *par0, INT16 fctno) void OPB_StPar0 (OPT_Node *par0, INT16 fctno)
{ {
INT16 f; INT16 f;
@ -1697,9 +1708,7 @@ void OPB_StPar0 (OPT_Node *par0, INT16 fctno)
if (OPB_NotVar(x)) { if (OPB_NotVar(x)) {
OPB_err(112); OPB_err(112);
} else if (f == 11) { } else if (f == 11) {
if (x->readonly) { OPB_CheckWrite(x);
OPB_err(76);
}
f = x->typ->BaseTyp->comp; f = x->typ->BaseTyp->comp;
if (__IN(f, 0x1c, 32)) { if (__IN(f, 0x1c, 32)) {
if (f == 3) { if (f == 3) {
@ -1855,8 +1864,8 @@ void OPB_StPar0 (OPT_Node *par0, INT16 fctno)
OPB_err(112); OPB_err(112);
} else if (f != 4) { } else if (f != 4) {
OPB_err(111); OPB_err(111);
} else if (x->readonly) { } else {
OPB_err(76); OPB_CheckWrite(x);
} }
break; break;
case 15: case 16: case 15: case 16:
@ -1865,8 +1874,8 @@ void OPB_StPar0 (OPT_Node *par0, INT16 fctno)
} else if (x->typ->form != 7) { } else if (x->typ->form != 7) {
OPB_err(111); OPB_err(111);
x->typ = OPT_settyp; x->typ = OPT_settyp;
} else if (x->readonly) { } else {
OPB_err(76); OPB_CheckWrite(x);
} }
break; break;
case 17: case 17:
@ -1978,13 +1987,13 @@ void OPB_StPar0 (OPT_Node *par0, INT16 fctno)
*par0 = x; *par0 = x;
} }
static struct StPar1__53 { static struct StPar1__54 {
struct StPar1__53 *lnk; struct StPar1__54 *lnk;
} *StPar1__53_s; } *StPar1__54_s;
static OPT_Node NewOp__54 (INT8 class, INT8 subcl, OPT_Node left, OPT_Node right); static OPT_Node NewOp__55 (INT8 class, INT8 subcl, OPT_Node left, OPT_Node right);
static OPT_Node NewOp__54 (INT8 class, INT8 subcl, OPT_Node left, OPT_Node right) static OPT_Node NewOp__55 (INT8 class, INT8 subcl, OPT_Node left, OPT_Node right)
{ {
OPT_Node node = NIL; OPT_Node node = NIL;
node = OPT_NewNode(class); node = OPT_NewNode(class);
@ -1999,9 +2008,9 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
INT16 f, L; INT16 f, L;
OPT_Struct typ = NIL; OPT_Struct typ = NIL;
OPT_Node p = NIL, t = NIL; OPT_Node p = NIL, t = NIL;
struct StPar1__53 _s; struct StPar1__54 _s;
_s.lnk = StPar1__53_s; _s.lnk = StPar1__54_s;
StPar1__53_s = &_s; StPar1__54_s = &_s;
p = *par0; p = *par0;
f = x->typ->form; f = x->typ->form;
switch (fctno) { switch (fctno) {
@ -2017,7 +2026,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
OPB_err(111); OPB_err(111);
} }
} }
p = NewOp__54(19, fctno, p, x); p = NewOp__55(19, fctno, p, x);
p->typ = OPT_notyp; p->typ = OPT_notyp;
} }
break; break;
@ -2028,7 +2037,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval >= (INT64)__ASHL(p->typ->size, 3)))) { if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval >= (INT64)__ASHL(p->typ->size, 3)))) {
OPB_err(202); OPB_err(202);
} }
p = NewOp__54(19, fctno, p, x); p = NewOp__55(19, fctno, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2053,7 +2062,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
p = p->left; p = p->left;
x->conval->intval += 1; x->conval->intval += 1;
} }
p = NewOp__54(12, 19, p, x); p = NewOp__55(12, 19, p, x);
p->typ = OPT_linttyp; p->typ = OPT_linttyp;
} else { } else {
p = x; p = x;
@ -2069,13 +2078,11 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
if (OPB_NotVar(x)) { if (OPB_NotVar(x)) {
OPB_err(112); OPB_err(112);
} else if ((__IN(x->typ->comp, 0x0c, 32) && x->typ->BaseTyp->form == 3)) { } else if ((__IN(x->typ->comp, 0x0c, 32) && x->typ->BaseTyp->form == 3)) {
if (x->readonly) { OPB_CheckWrite(x);
OPB_err(76);
}
t = x; t = x;
x = p; x = p;
p = t; p = t;
p = NewOp__54(19, 18, p, x); p = NewOp__55(19, 18, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2101,7 +2108,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
} }
p->obj = NIL; p->obj = NIL;
} else { } else {
p = NewOp__54(12, 17, p, x); p = NewOp__55(12, 17, p, x);
p->typ = p->left->typ; p->typ = p->left->typ;
} }
} else { } else {
@ -2132,9 +2139,9 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
OPB_err(111); OPB_err(111);
} else { } else {
if (fctno == 22) { if (fctno == 22) {
p = NewOp__54(12, 27, p, x); p = NewOp__55(12, 27, p, x);
} else { } else {
p = NewOp__54(12, 28, p, x); p = NewOp__55(12, 28, p, x);
} }
p->typ = p->left->typ; p->typ = p->left->typ;
} }
@ -2151,7 +2158,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
x = p; x = p;
p = t; p = t;
} }
p = NewOp__54(19, fctno, p, x); p = NewOp__55(19, fctno, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2161,7 +2168,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
if (x->class == 8 || x->class == 9) { if (x->class == 8 || x->class == 9) {
OPB_err(126); OPB_err(126);
} else if (f == 4) { } else if (f == 4) {
p = NewOp__54(12, 26, p, x); p = NewOp__55(12, 26, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2191,7 +2198,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
if (x->class == 8 || x->class == 9) { if (x->class == 8 || x->class == 9) {
OPB_err(126); OPB_err(126);
} else if (f == 4) { } else if (f == 4) {
p = NewOp__54(19, 30, p, x); p = NewOp__55(19, 30, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2237,7 +2244,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
break; break;
} }
*par0 = p; *par0 = p;
StPar1__53_s = _s.lnk; StPar1__54_s = _s.lnk;
} }
void OPB_StParN (OPT_Node *par0, OPT_Node x, INT16 fctno, INT16 n) void OPB_StParN (OPT_Node *par0, OPT_Node x, INT16 fctno, INT16 n)
@ -2356,7 +2363,7 @@ static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpa
f = atyp->comp; f = atyp->comp;
ftyp = ftyp->BaseTyp; ftyp = ftyp->BaseTyp;
atyp = atyp->BaseTyp; atyp = atyp->BaseTyp;
if (((fvarpar || sysflag != 0) && ftyp == OPT_bytetyp)) { if (ftyp == OPT_bytetyp) {
if (!__IN(f, 0x0c, 32) || !((__IN(atyp->form, 0x1e, 32) && atyp->size == 1))) { if (!__IN(f, 0x0c, 32) || !((__IN(atyp->form, 0x1e, 32) && atyp->size == 1))) {
if (__IN(18, OPM_Options, 32)) { if (__IN(18, OPM_Options, 32)) {
OPB_err(-301); OPB_err(-301);
@ -2426,9 +2433,7 @@ void OPB_Param (OPT_Node ap, OPT_Object fp)
} else { } else {
OPB_CheckLeaf(ap, 0); OPB_CheckLeaf(ap, 0);
} }
if (ap->readonly) { OPB_CheckWrite(ap);
OPB_err(76);
}
if (fp->typ->comp == 3) { if (fp->typ->comp == 3) {
OPB_DynArrParCheck(fp->typ, ap->typ, 1); OPB_DynArrParCheck(fp->typ, ap->typ, 1);
} else if ((fp->typ->comp == 4 && ap->typ->comp == 4)) { } else if ((fp->typ->comp == 4 && ap->typ->comp == 4)) {
@ -2540,9 +2545,7 @@ void OPB_Assign (OPT_Node *x, OPT_Node y)
OPB_err(56); OPB_err(56);
} }
OPB_CheckAssign((*x)->typ, y); OPB_CheckAssign((*x)->typ, y);
if ((*x)->readonly) { OPB_CheckWrite(*x);
OPB_err(76);
}
if ((*x)->typ->comp == 4) { if ((*x)->typ->comp == 4) {
if ((*x)->class == 5) { if ((*x)->class == 5) {
z = (*x)->left; z = (*x)->left;

2
bootstrap/unix-48/OPB.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPB__h #ifndef OPB__h
#define OPB__h #define OPB__h

14
bootstrap/unix-48/OPC.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -141,7 +141,6 @@ static void OPC_Str1 (CHAR *s, ADDRESS s__len, INT32 x)
{ {
CHAR ch; CHAR ch;
INT16 i; INT16 i;
__DUP(s, s__len, CHAR);
ch = s[0]; ch = s[0];
i = 0; i = 0;
while (ch != 0x00) { while (ch != 0x00) {
@ -153,7 +152,6 @@ static void OPC_Str1 (CHAR *s, ADDRESS s__len, INT32 x)
i += 1; i += 1;
ch = s[__X(i, s__len)]; ch = s[__X(i, s__len)];
} }
__DEL(s);
} }
static INT16 OPC_Length (CHAR *s, ADDRESS s__len) static INT16 OPC_Length (CHAR *s, ADDRESS s__len)
@ -727,12 +725,10 @@ static void OPC_DefineType (OPT_Struct str)
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, ADDRESS y__len) static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, ADDRESS y__len)
{ {
INT16 i; INT16 i;
__DUP(y, y__len, CHAR);
i = 0; i = 0;
while ((*x)[__X(i + 1, 256)] == y[__X(i, y__len)]) { while ((*x)[__X(i + 1, 256)] == y[__X(i, y__len)]) {
i += 1; i += 1;
} }
__DEL(y);
return y[__X(i, y__len)] == 0x00; return y[__X(i, y__len)] == 0x00;
} }
@ -1466,7 +1462,7 @@ void OPC_EnterProc (OPT_Object proc)
} }
var = proc->link; var = proc->link;
while (var != NIL) { while (var != NIL) {
if ((var->typ->comp == 2 && var->mode == 1)) { if ((((var->written && var->typ->comp == 2)) && var->mode == 1)) {
OPC_BegStat(); OPC_BegStat();
if (var->typ->strobj == NIL) { if (var->typ->strobj == NIL) {
OPM_Mark(200, var->typ->txtpos); OPM_Mark(200, var->typ->txtpos);
@ -1482,7 +1478,7 @@ void OPC_EnterProc (OPT_Object proc)
} }
var = proc->link; var = proc->link;
while (var != NIL) { while (var != NIL) {
if ((((__IN(var->typ->comp, 0x0c, 32) && var->mode == 1)) && var->typ->sysflag == 0)) { if ((((((var->written && __IN(var->typ->comp, 0x0c, 32))) && var->mode == 1)) && var->typ->sysflag == 0)) {
OPC_BegStat(); OPC_BegStat();
if (var->typ->comp == 2) { if (var->typ->comp == 2) {
OPM_WriteString((CHAR*)"__DUPARR(", 10); OPM_WriteString((CHAR*)"__DUPARR(", 10);
@ -1632,7 +1628,7 @@ void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet)
} }
var = proc->link; var = proc->link;
while (var != NIL) { while (var != NIL) {
if ((((var->typ->comp == 3 && var->mode == 1)) && var->typ->sysflag == 0)) { if ((((((var->written && var->typ->comp == 3)) && var->mode == 1)) && var->typ->sysflag == 0)) {
if (indent) { if (indent) {
OPC_BegStat(); OPC_BegStat();
} else { } else {
@ -1752,7 +1748,6 @@ static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l)
{ {
INT32 i; INT32 i;
INT16 c; INT16 c;
__DUP(s, s__len, CHAR);
OPM_Write('"'); OPM_Write('"');
i = 0; i = 0;
while (i < l) { while (i < l) {
@ -1773,7 +1768,6 @@ static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l)
i += 1; i += 1;
} }
OPM_Write('"'); OPM_Write('"');
__DEL(s);
} }
void OPC_Case (INT64 caseVal, INT16 form) void OPC_Case (INT64 caseVal, INT16 form)

2
bootstrap/unix-48/OPC.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPC__h #ifndef OPC__h
#define OPC__h #define OPC__h

25
bootstrap/unix-48/OPM.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -27,7 +27,7 @@ export INT16 OPM_AddressSize;
static INT16 OPM_GlobalAlignment; static INT16 OPM_GlobalAlignment;
export INT16 OPM_Alignment; export INT16 OPM_Alignment;
export UINT32 OPM_GlobalOptions, OPM_Options; export UINT32 OPM_GlobalOptions, OPM_Options;
export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize; export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize, OPM_SetSize;
export INT64 OPM_MaxIndex; export INT64 OPM_MaxIndex;
export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
export BOOLEAN OPM_noerr; export BOOLEAN OPM_noerr;
@ -112,9 +112,7 @@ void OPM_LogW (CHAR ch)
void OPM_LogWStr (CHAR *s, ADDRESS s__len) void OPM_LogWStr (CHAR *s, ADDRESS s__len)
{ {
__DUP(s, s__len, CHAR);
Out_String(s, s__len); Out_String(s, s__len);
__DEL(s);
} }
void OPM_LogWNum (INT64 i, INT64 len) void OPM_LogWNum (INT64 i, INT64 len)
@ -129,16 +127,13 @@ void OPM_LogWLn (void)
void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len) void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len)
{ {
__DUP(vt100code, vt100code__len, CHAR);
if ((Out_IsConsole && !__IN(16, OPM_Options, 32))) { if ((Out_IsConsole && !__IN(16, OPM_Options, 32))) {
VT100_SetAttr(vt100code, vt100code__len); VT100_SetAttr(vt100code, vt100code__len);
} }
__DEL(vt100code);
} }
void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len) void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len)
{ {
__DUP(modname, modname__len, CHAR);
OPM_LogWStr((CHAR*)"Compiling ", 11); OPM_LogWStr((CHAR*)"Compiling ", 11);
OPM_LogWStr(modname, modname__len); OPM_LogWStr(modname, modname__len);
if (__IN(18, OPM_Options, 32)) { if (__IN(18, OPM_Options, 32)) {
@ -154,7 +149,6 @@ void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len)
OPM_LogWNum(__ASHL(OPM_Alignment, 3), 1); OPM_LogWNum(__ASHL(OPM_Alignment, 3), 1);
} }
OPM_LogW('.'); OPM_LogW('.');
__DEL(modname);
} }
INT64 OPM_SignedMaximum (INT32 bytecount) INT64 OPM_SignedMaximum (INT32 bytecount)
@ -183,7 +177,6 @@ INT16 OPM_Integer (INT64 n)
static void OPM_ScanOptions (CHAR *s, ADDRESS s__len) static void OPM_ScanOptions (CHAR *s, ADDRESS s__len)
{ {
INT16 i; INT16 i;
__DUP(s, s__len, CHAR);
i = 1; i = 1;
while (s[__X(i, s__len)] != 0x00) { while (s[__X(i, s__len)] != 0x00) {
switch (s[__X(i, s__len)]) { switch (s[__X(i, s__len)]) {
@ -263,7 +256,6 @@ static void OPM_ScanOptions (CHAR *s, ADDRESS s__len)
} }
i += 1; i += 1;
} }
__DEL(s);
} }
BOOLEAN OPM_OpenPar (void) BOOLEAN OPM_OpenPar (void)
@ -338,7 +330,7 @@ BOOLEAN OPM_OpenPar (void)
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" -O2 Original Oberon / Oberon-2: 8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET.", 95); OPM_LogWStr((CHAR*)" -O2 Original Oberon / Oberon-2: 8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET.", 95);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95); OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER and SET, 64 bit LONGINT.", 95);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95); OPM_LogWStr((CHAR*)" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95);
OPM_LogWLn(); OPM_LogWLn();
@ -410,21 +402,25 @@ void OPM_InitOptions (void)
OPM_ShortintSize = 1; OPM_ShortintSize = 1;
OPM_IntegerSize = 2; OPM_IntegerSize = 2;
OPM_LongintSize = 4; OPM_LongintSize = 4;
OPM_SetSize = 4;
break; break;
case 'C': case 'C':
OPM_ShortintSize = 2; OPM_ShortintSize = 2;
OPM_IntegerSize = 4; OPM_IntegerSize = 4;
OPM_LongintSize = 8; OPM_LongintSize = 8;
OPM_SetSize = 4;
break; break;
case 'V': case 'V':
OPM_ShortintSize = 1; OPM_ShortintSize = 1;
OPM_IntegerSize = 4; OPM_IntegerSize = 4;
OPM_LongintSize = 8; OPM_LongintSize = 8;
OPM_SetSize = 8;
break; break;
default: default:
OPM_ShortintSize = 1; OPM_ShortintSize = 1;
OPM_IntegerSize = 2; OPM_IntegerSize = 2;
OPM_LongintSize = 4; OPM_LongintSize = 4;
OPM_SetSize = 4;
break; break;
} }
__MOVE(OPM_InstallDir, OPM_ResourceDir, 1024); __MOVE(OPM_InstallDir, OPM_ResourceDir, 1024);
@ -492,7 +488,6 @@ static void OPM_MakeFileName (CHAR *name, ADDRESS name__len, CHAR *FName, ADDRES
{ {
INT16 i, j; INT16 i, j;
CHAR ch; CHAR ch;
__DUP(ext, ext__len, CHAR);
i = 0; i = 0;
for (;;) { for (;;) {
ch = name[__X(i, name__len)]; ch = name[__X(i, name__len)];
@ -509,7 +504,6 @@ static void OPM_MakeFileName (CHAR *name, ADDRESS name__len, CHAR *FName, ADDRES
i += 1; i += 1;
j += 1; j += 1;
} while (!(ch == 0x00)); } while (!(ch == 0x00));
__DEL(ext);
} }
static void OPM_LogErrMsg (INT16 n) static void OPM_LogErrMsg (INT16 n)
@ -1050,28 +1044,23 @@ static BOOLEAN OPM_IsProbablyInstallDir (CHAR *s, ADDRESS s__len)
{ {
CHAR testpath[4096]; CHAR testpath[4096];
Platform_FileIdentity identity; Platform_FileIdentity identity;
__DUP(s, s__len, CHAR);
__COPY(OPM_InstallDir, testpath, 4096); __COPY(OPM_InstallDir, testpath, 4096);
Strings_Append((CHAR*)"/lib/lib", 9, (void*)testpath, 4096); Strings_Append((CHAR*)"/lib/lib", 9, (void*)testpath, 4096);
Strings_Append((CHAR*)"voc", 4, (void*)testpath, 4096); Strings_Append((CHAR*)"voc", 4, (void*)testpath, 4096);
Strings_Append((CHAR*)"-O2.a", 6, (void*)testpath, 4096); Strings_Append((CHAR*)"-O2.a", 6, (void*)testpath, 4096);
if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) { if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
__DEL(s);
return 0; return 0;
} }
__COPY(OPM_InstallDir, testpath, 4096); __COPY(OPM_InstallDir, testpath, 4096);
Strings_Append((CHAR*)"/2/include/Oberon.h", 20, (void*)testpath, 4096); Strings_Append((CHAR*)"/2/include/Oberon.h", 20, (void*)testpath, 4096);
if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) { if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
__DEL(s);
return 0; return 0;
} }
__COPY(OPM_InstallDir, testpath, 4096); __COPY(OPM_InstallDir, testpath, 4096);
Strings_Append((CHAR*)"/2/sym/Files.sym", 17, (void*)testpath, 4096); Strings_Append((CHAR*)"/2/sym/Files.sym", 17, (void*)testpath, 4096);
if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) { if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
__DEL(s);
return 0; return 0;
} }
__DEL(s);
return 1; return 1;
} }

4
bootstrap/unix-48/OPM.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPM__h #ifndef OPM__h
#define OPM__h #define OPM__h
@ -9,7 +9,7 @@
import CHAR OPM_Model[10]; import CHAR OPM_Model[10];
import INT16 OPM_AddressSize, OPM_Alignment; import INT16 OPM_AddressSize, OPM_Alignment;
import UINT32 OPM_GlobalOptions, OPM_Options; import UINT32 OPM_GlobalOptions, OPM_Options;
import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize; import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize, OPM_SetSize;
import INT64 OPM_MaxIndex; import INT64 OPM_MaxIndex;
import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
import BOOLEAN OPM_noerr; import BOOLEAN OPM_noerr;

2
bootstrap/unix-48/OPP.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16

2
bootstrap/unix-48/OPP.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPP__h #ifndef OPP__h
#define OPP__h #define OPP__h

2
bootstrap/unix-48/OPS.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16

2
bootstrap/unix-48/OPS.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPS__h #ifndef OPS__h
#define OPS__h #define OPS__h

4
bootstrap/unix-48/OPT.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -77,7 +77,7 @@ typedef
OPS_Name name; OPS_Name name;
BOOLEAN leaf; BOOLEAN leaf;
INT8 mode, mnolev, vis, history; INT8 mode, mnolev, vis, history;
BOOLEAN used, fpdone; BOOLEAN used, fpdone, written;
INT32 fprint; INT32 fprint;
OPT_Struct typ; OPT_Struct typ;
OPT_Const conval; OPT_Const conval;

4
bootstrap/unix-48/OPT.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPT__h #ifndef OPT__h
#define OPT__h #define OPT__h
@ -55,7 +55,7 @@ typedef
OPS_Name name; OPS_Name name;
BOOLEAN leaf; BOOLEAN leaf;
INT8 mode, mnolev, vis, history; INT8 mode, mnolev, vis, history;
BOOLEAN used, fpdone; BOOLEAN used, fpdone, written;
INT32 fprint; INT32 fprint;
OPT_Struct typ; OPT_Struct typ;
OPT_Const conval; OPT_Const conval;

2
bootstrap/unix-48/OPV.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16

2
bootstrap/unix-48/OPV.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPV__h #ifndef OPV__h
#define OPV__h #define OPV__h

2
bootstrap/unix-48/Out.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16

2
bootstrap/unix-48/Out.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Out__h #ifndef Out__h
#define Out__h #define Out__h

11
bootstrap/unix-48/Platform.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -209,22 +209,18 @@ typedef
BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len) BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len)
{ {
EnvPtr__83 p = NIL; EnvPtr__83 p = NIL;
__DUP(var, var__len, CHAR);
p = (EnvPtr__83)(ADDRESS)Platform_getenv(var, var__len); p = (EnvPtr__83)(ADDRESS)Platform_getenv(var, var__len);
if (p != NIL) { if (p != NIL) {
__COPY(*p, val, val__len); __COPY(*p, val, val__len);
} }
__DEL(var);
return p != NIL; return p != NIL;
} }
void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len) void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len)
{ {
__DUP(var, var__len, CHAR);
if (!Platform_getEnv(var, var__len, (void*)val, val__len)) { if (!Platform_getEnv(var, var__len, (void*)val, val__len)) {
val[0] = 0x00; val[0] = 0x00;
} }
__DEL(var);
} }
void Platform_SetInterruptHandler (Platform_SignalHandler handler) void Platform_SetInterruptHandler (Platform_SignalHandler handler)
@ -280,8 +276,6 @@ void Platform_Delay (INT32 ms)
INT16 Platform_System (CHAR *cmd, ADDRESS cmd__len) INT16 Platform_System (CHAR *cmd, ADDRESS cmd__len)
{ {
__DUP(cmd, cmd__len, CHAR);
__DEL(cmd);
return Platform_system(cmd, cmd__len); return Platform_system(cmd, cmd__len);
} }
@ -358,16 +352,13 @@ INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *iden
INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ) INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ)
{ {
__DUP(n, n__len, CHAR);
Platform_structstats(); Platform_structstats();
if (Platform_stat(n, n__len) < 0) { if (Platform_stat(n, n__len) < 0) {
__DEL(n);
return Platform_err(); return Platform_err();
} }
(*identity).volume = Platform_statdev(); (*identity).volume = Platform_statdev();
(*identity).index = Platform_statino(); (*identity).index = Platform_statino();
(*identity).mtime = Platform_statmtime(); (*identity).mtime = Platform_statmtime();
__DEL(n);
return 0; return 0;
} }

2
bootstrap/unix-48/Platform.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Platform__h #ifndef Platform__h
#define Platform__h #define Platform__h

2
bootstrap/unix-48/Reals.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16

2
bootstrap/unix-48/Reals.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Reals__h #ifndef Reals__h
#define Reals__h #define Reals__h

21
bootstrap/unix-48/Strings.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -42,7 +42,6 @@ INT16 Strings_Length (CHAR *s, ADDRESS s__len)
void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__len) void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__len)
{ {
INT16 n1, n2, i; INT16 n1, n2, i;
__DUP(extra, extra__len, CHAR);
n1 = Strings_Length(dest, dest__len); n1 = Strings_Length(dest, dest__len);
n2 = Strings_Length(extra, extra__len); n2 = Strings_Length(extra, extra__len);
i = 0; i = 0;
@ -53,7 +52,6 @@ void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__
if ((i + n1) < dest__len) { if ((i + n1) < dest__len) {
dest[__X(i + n1, dest__len)] = 0x00; dest[__X(i + n1, dest__len)] = 0x00;
} }
__DEL(extra);
} }
void Strings_Insert (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len) void Strings_Insert (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len)
@ -112,16 +110,13 @@ void Strings_Delete (CHAR *s, ADDRESS s__len, INT16 pos, INT16 n)
void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len) void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len)
{ {
__DUP(source, source__len, CHAR);
Strings_Delete((void*)dest, dest__len, pos, pos + Strings_Length(source, source__len)); Strings_Delete((void*)dest, dest__len, pos, pos + Strings_Length(source, source__len));
Strings_Insert(source, source__len, pos, (void*)dest, dest__len); Strings_Insert(source, source__len, pos, (void*)dest, dest__len);
__DEL(source);
} }
void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHAR *dest, ADDRESS dest__len) void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHAR *dest, ADDRESS dest__len)
{ {
INT16 len, destLen, i; INT16 len, destLen, i;
__DUP(source, source__len, CHAR);
len = Strings_Length(source, source__len); len = Strings_Length(source, source__len);
destLen = __SHORT(dest__len, 32768) - 1; destLen = __SHORT(dest__len, 32768) - 1;
if (pos < 0) { if (pos < 0) {
@ -129,7 +124,6 @@ void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHA
} }
if (pos >= len) { if (pos >= len) {
dest[0] = 0x00; dest[0] = 0x00;
__DEL(source);
return; return;
} }
i = 0; i = 0;
@ -140,19 +134,14 @@ void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHA
i += 1; i += 1;
} }
dest[__X(i, dest__len)] = 0x00; dest[__X(i, dest__len)] = 0x00;
__DEL(source);
} }
INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos) INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos)
{ {
INT16 n1, n2, i, j; INT16 n1, n2, i, j;
__DUP(pattern, pattern__len, CHAR);
__DUP(s, s__len, CHAR);
n1 = Strings_Length(s, s__len); n1 = Strings_Length(s, s__len);
n2 = Strings_Length(pattern, pattern__len); n2 = Strings_Length(pattern, pattern__len);
if (n2 == 0) { if (n2 == 0) {
__DEL(pattern);
__DEL(s);
return 0; return 0;
} }
i = pos; i = pos;
@ -163,15 +152,11 @@ INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len,
j += 1; j += 1;
} }
if (j == n2) { if (j == n2) {
__DEL(pattern);
__DEL(s);
return i; return i;
} }
} }
i += 1; i += 1;
} }
__DEL(pattern);
__DEL(s);
return -1; return -1;
} }
@ -241,7 +226,6 @@ void Strings_StrToReal (CHAR *s, ADDRESS s__len, REAL *r)
INT16 p, e; INT16 p, e;
REAL y, g; REAL y, g;
BOOLEAN neg, negE; BOOLEAN neg, negE;
__DUP(s, s__len, CHAR);
p = 0; p = 0;
while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') { while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') {
p += 1; p += 1;
@ -295,7 +279,6 @@ void Strings_StrToReal (CHAR *s, ADDRESS s__len, REAL *r)
y = -y; y = -y;
} }
*r = y; *r = y;
__DEL(s);
} }
void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r) void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r)
@ -303,7 +286,6 @@ void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r)
INT16 p, e; INT16 p, e;
LONGREAL y, g; LONGREAL y, g;
BOOLEAN neg, negE; BOOLEAN neg, negE;
__DUP(s, s__len, CHAR);
p = 0; p = 0;
while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') { while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') {
p += 1; p += 1;
@ -357,7 +339,6 @@ void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r)
y = -y; y = -y;
} }
*r = y; *r = y;
__DEL(s);
} }

2
bootstrap/unix-48/Strings.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Strings__h #ifndef Strings__h
#define Strings__h #define Strings__h

8
bootstrap/unix-48/Texts.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -1031,13 +1031,11 @@ void Texts_WriteLn (Texts_Writer *W, ADDRESS *W__typ)
void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, ADDRESS s__len) void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, ADDRESS s__len)
{ {
INT16 i; INT16 i;
__DUP(s, s__len, CHAR);
i = 0; i = 0;
while (s[__X(i, s__len)] >= ' ') { while (s[__X(i, s__len)] >= ' ') {
Texts_Write(&*W, W__typ, s[__X(i, s__len)]); Texts_Write(&*W, W__typ, s[__X(i, s__len)]);
i += 1; i += 1;
} }
__DEL(s);
} }
void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n) void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n)
@ -1548,7 +1546,6 @@ void Texts_Open (Texts_Text T, CHAR *name, ADDRESS name__len)
Texts_Piece p = NIL; Texts_Piece p = NIL;
CHAR tag, version; CHAR tag, version;
INT32 hlen; INT32 hlen;
__DUP(name, name__len, CHAR);
f = Files_Old(name, name__len); f = Files_Old(name, name__len);
if (f == NIL) { if (f == NIL) {
f = Files_New((CHAR*)"", 1); f = Files_New((CHAR*)"", 1);
@ -1593,7 +1590,6 @@ void Texts_Open (Texts_Text T, CHAR *name, ADDRESS name__len)
T->cache = T->head; T->cache = T->head;
T->corg = 0; T->corg = 0;
} }
__DEL(name);
} }
static struct Store__39 { static struct Store__39 {
@ -1762,7 +1758,6 @@ void Texts_Close (Texts_Text T, CHAR *name, ADDRESS name__len)
Files_Rider r; Files_Rider r;
INT16 i, res; INT16 i, res;
CHAR bak[64]; CHAR bak[64];
__DUP(name, name__len, CHAR);
f = Files_New(name, name__len); f = Files_New(name, name__len);
Files_Set(&r, Files_Rider__typ, f, 0); Files_Set(&r, Files_Rider__typ, f, 0);
Files_Write(&r, Files_Rider__typ, 0xf0); Files_Write(&r, Files_Rider__typ, 0xf0);
@ -1780,7 +1775,6 @@ void Texts_Close (Texts_Text T, CHAR *name, ADDRESS name__len)
bak[__X(i + 4, 64)] = 0x00; bak[__X(i + 4, 64)] = 0x00;
Files_Rename(name, name__len, bak, 64, &res); Files_Rename(name, name__len, bak, 64, &res);
Files_Register(f); Files_Register(f);
__DEL(name);
} }
static void EnumPtrs(void (*P)(void*)) static void EnumPtrs(void (*P)(void*))

2
bootstrap/unix-48/Texts.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Texts__h #ifndef Texts__h
#define Texts__h #define Texts__h

12
bootstrap/unix-48/VT100.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -87,44 +87,37 @@ void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len)
static void VT100_EscSeq0 (CHAR *letter, ADDRESS letter__len) static void VT100_EscSeq0 (CHAR *letter, ADDRESS letter__len)
{ {
CHAR cmd[9]; CHAR cmd[9];
__DUP(letter, letter__len, CHAR);
__COPY(VT100_CSI, cmd, 9); __COPY(VT100_CSI, cmd, 9);
Strings_Append(letter, letter__len, (void*)cmd, 9); Strings_Append(letter, letter__len, (void*)cmd, 9);
Out_String(cmd, 9); Out_String(cmd, 9);
__DEL(letter);
} }
static void VT100_EscSeq (INT16 n, CHAR *letter, ADDRESS letter__len) static void VT100_EscSeq (INT16 n, CHAR *letter, ADDRESS letter__len)
{ {
CHAR nstr[2]; CHAR nstr[2];
CHAR cmd[7]; CHAR cmd[7];
__DUP(letter, letter__len, CHAR);
VT100_IntToStr(n, (void*)nstr, 2); VT100_IntToStr(n, (void*)nstr, 2);
__COPY(VT100_CSI, cmd, 7); __COPY(VT100_CSI, cmd, 7);
Strings_Append(nstr, 2, (void*)cmd, 7); Strings_Append(nstr, 2, (void*)cmd, 7);
Strings_Append(letter, letter__len, (void*)cmd, 7); Strings_Append(letter, letter__len, (void*)cmd, 7);
Out_String(cmd, 7); Out_String(cmd, 7);
__DEL(letter);
} }
static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, ADDRESS letter__len) static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, ADDRESS letter__len)
{ {
CHAR nstr[2]; CHAR nstr[2];
CHAR cmd[7]; CHAR cmd[7];
__DUP(letter, letter__len, CHAR);
VT100_IntToStr(n, (void*)nstr, 2); VT100_IntToStr(n, (void*)nstr, 2);
__COPY(VT100_CSI, cmd, 7); __COPY(VT100_CSI, cmd, 7);
Strings_Append(letter, letter__len, (void*)cmd, 7); Strings_Append(letter, letter__len, (void*)cmd, 7);
Strings_Append(nstr, 2, (void*)cmd, 7); Strings_Append(nstr, 2, (void*)cmd, 7);
Out_String(cmd, 7); Out_String(cmd, 7);
__DEL(letter);
} }
static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len) static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len)
{ {
CHAR nstr[5], mstr[5]; CHAR nstr[5], mstr[5];
CHAR cmd[12]; CHAR cmd[12];
__DUP(letter, letter__len, CHAR);
VT100_IntToStr(n, (void*)nstr, 5); VT100_IntToStr(n, (void*)nstr, 5);
VT100_IntToStr(m, (void*)mstr, 5); VT100_IntToStr(m, (void*)mstr, 5);
__COPY(VT100_CSI, cmd, 12); __COPY(VT100_CSI, cmd, 12);
@ -133,7 +126,6 @@ static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len)
Strings_Append(mstr, 5, (void*)cmd, 12); Strings_Append(mstr, 5, (void*)cmd, 12);
Strings_Append(letter, letter__len, (void*)cmd, 12); Strings_Append(letter, letter__len, (void*)cmd, 12);
Out_String(cmd, 12); Out_String(cmd, 12);
__DEL(letter);
} }
void VT100_CUU (INT16 n) void VT100_CUU (INT16 n)
@ -239,11 +231,9 @@ void VT100_DECTCEMh (void)
void VT100_SetAttr (CHAR *attr, ADDRESS attr__len) void VT100_SetAttr (CHAR *attr, ADDRESS attr__len)
{ {
CHAR tmpstr[16]; CHAR tmpstr[16];
__DUP(attr, attr__len, CHAR);
__COPY(VT100_CSI, tmpstr, 16); __COPY(VT100_CSI, tmpstr, 16);
Strings_Append(attr, attr__len, (void*)tmpstr, 16); Strings_Append(attr, attr__len, (void*)tmpstr, 16);
Out_String(tmpstr, 16); Out_String(tmpstr, 16);
__DEL(attr);
} }

2
bootstrap/unix-48/VT100.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef VT100__h #ifndef VT100__h
#define VT100__h #define VT100__h

10
bootstrap/unix-48/extTools.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -31,8 +31,6 @@ static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRES
{ {
INT16 r, status, exitcode; INT16 r, status, exitcode;
extTools_CommandString fullcmd; extTools_CommandString fullcmd;
__DUP(title, title__len, CHAR);
__DUP(cmd, cmd__len, CHAR);
if (__IN(18, OPM_Options, 32)) { if (__IN(18, OPM_Options, 32)) {
Out_String((CHAR*)" ", 3); Out_String((CHAR*)" ", 3);
Out_String(cmd, cmd__len); Out_String(cmd, cmd__len);
@ -66,8 +64,6 @@ static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRES
Modules_Halt(exitcode); Modules_Halt(exitcode);
} }
} }
__DEL(title);
__DEL(cmd);
} }
static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len) static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len)
@ -84,19 +80,16 @@ static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len)
void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len) void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len)
{ {
extTools_CommandString cmd; extTools_CommandString cmd;
__DUP(moduleName, moduleName__len, CHAR);
extTools_InitialiseCompilerCommand((void*)cmd, 4096); extTools_InitialiseCompilerCommand((void*)cmd, 4096);
Strings_Append((CHAR*)"-c ", 4, (void*)cmd, 4096); Strings_Append((CHAR*)"-c ", 4, (void*)cmd, 4096);
Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096); Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096);
Strings_Append((CHAR*)".c", 3, (void*)cmd, 4096); Strings_Append((CHAR*)".c", 3, (void*)cmd, 4096);
extTools_execute((CHAR*)"C compile: ", 12, cmd, 4096); extTools_execute((CHAR*)"C compile: ", 12, cmd, 4096);
__DEL(moduleName);
} }
void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len) void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len)
{ {
extTools_CommandString cmd; extTools_CommandString cmd;
__DUP(additionalopts, additionalopts__len, CHAR);
extTools_InitialiseCompilerCommand((void*)cmd, 4096); extTools_InitialiseCompilerCommand((void*)cmd, 4096);
Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096); Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096);
Strings_Append((CHAR*)".c ", 4, (void*)cmd, 4096); Strings_Append((CHAR*)".c ", 4, (void*)cmd, 4096);
@ -116,7 +109,6 @@ void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN stati
Strings_Append((CHAR*)"", 1, (void*)cmd, 4096); Strings_Append((CHAR*)"", 1, (void*)cmd, 4096);
} }
extTools_execute((CHAR*)"C compile and link: ", 21, cmd, 4096); extTools_execute((CHAR*)"C compile and link: ", 21, cmd, 4096);
__DEL(additionalopts);
} }

2
bootstrap/unix-48/extTools.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef extTools__h #ifndef extTools__h
#define extTools__h #define extTools__h

4
bootstrap/unix-88/Compiler.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspamS */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspamS */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -89,7 +89,7 @@ static void Compiler_PropagateElementaryTypeSizes (void)
OPT_sintobj->typ = OPT_sinttyp; OPT_sintobj->typ = OPT_sinttyp;
OPT_intobj->typ = OPT_inttyp; OPT_intobj->typ = OPT_inttyp;
OPT_lintobj->typ = OPT_linttyp; OPT_lintobj->typ = OPT_linttyp;
switch (OPM_LongintSize) { switch (OPM_SetSize) {
case 4: case 4:
OPT_settyp = OPT_set32typ; OPT_settyp = OPT_set32typ;
break; break;

4
bootstrap/unix-88/Configuration.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -19,6 +19,6 @@ export void *Configuration__init(void)
__DEFMOD; __DEFMOD;
__REGMOD("Configuration", 0); __REGMOD("Configuration", 0);
/* BEGIN */ /* BEGIN */
__MOVE("2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 76); __MOVE("2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 76);
__ENDMOD; __ENDMOD;
} }

2
bootstrap/unix-88/Configuration.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Configuration__h #ifndef Configuration__h
#define Configuration__h #define Configuration__h

16
bootstrap/unix-88/Files.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -123,7 +123,6 @@ static void Files_Assert (BOOLEAN truth)
static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode) static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode)
{ {
__DUP(s, s__len, CHAR);
Out_Ln(); Out_Ln();
Out_String((CHAR*)"-- ", 4); Out_String((CHAR*)"-- ", 4);
Out_String(s, s__len); Out_String(s, s__len);
@ -145,14 +144,11 @@ static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode)
} }
Out_Ln(); Out_Ln();
__HALT(99); __HALT(99);
__DEL(s);
} }
static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS name__len, CHAR *dest, ADDRESS dest__len) static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS name__len, CHAR *dest, ADDRESS dest__len)
{ {
INT16 i, j, ld, ln; INT16 i, j, ld, ln;
__DUP(dir, dir__len, CHAR);
__DUP(name, name__len, CHAR);
ld = Strings_Length(dir, dir__len); ld = Strings_Length(dir, dir__len);
ln = Strings_Length(name, name__len); ln = Strings_Length(name, name__len);
while ((ld > 0 && dir[__X(ld - 1, dir__len)] == '/')) { while ((ld > 0 && dir[__X(ld - 1, dir__len)] == '/')) {
@ -177,14 +173,11 @@ static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS
j += 1; j += 1;
} }
dest[__X(i, dest__len)] = 0x00; dest[__X(i, dest__len)] = 0x00;
__DEL(dir);
__DEL(name);
} }
static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *name, ADDRESS name__len) static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *name, ADDRESS name__len)
{ {
INT16 i, n; INT16 i, n;
__DUP(finalName, finalName__len, CHAR);
if (finalName[0] == '/') { if (finalName[0] == '/') {
__COPY(finalName, name, name__len); __COPY(finalName, name, name__len);
} else { } else {
@ -219,7 +212,6 @@ static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *na
i += 1; i += 1;
} }
name[__X(i, name__len)] = 0x00; name[__X(i, name__len)] = 0x00;
__DEL(finalName);
} }
static void Files_Deregister (CHAR *name, ADDRESS name__len) static void Files_Deregister (CHAR *name, ADDRESS name__len)
@ -227,7 +219,6 @@ static void Files_Deregister (CHAR *name, ADDRESS name__len)
Platform_FileIdentity identity; Platform_FileIdentity identity;
Files_File osfile = NIL; Files_File osfile = NIL;
INT16 error; INT16 error;
__DUP(name, name__len, CHAR);
if (Platform_IdentifyByName(name, name__len, &identity, Platform_FileIdentity__typ) == 0) { if (Platform_IdentifyByName(name, name__len, &identity, Platform_FileIdentity__typ) == 0) {
osfile = (Files_File)Files_files; osfile = (Files_File)Files_files;
while ((osfile != NIL && !Platform_SameFile(osfile->identity, identity))) { while ((osfile != NIL && !Platform_SameFile(osfile->identity, identity))) {
@ -246,7 +237,6 @@ static void Files_Deregister (CHAR *name, ADDRESS name__len)
} }
} }
} }
__DEL(name);
} }
static void Files_Create (Files_File f) static void Files_Create (Files_File f)
@ -334,7 +324,6 @@ INT32 Files_Length (Files_File f)
Files_File Files_New (CHAR *name, ADDRESS name__len) Files_File Files_New (CHAR *name, ADDRESS name__len)
{ {
Files_File f = NIL; Files_File f = NIL;
__DUP(name, name__len, CHAR);
__NEW(f, Files_FileDesc); __NEW(f, Files_FileDesc);
f->workName[0] = 0x00; f->workName[0] = 0x00;
__COPY(name, f->registerName, 256); __COPY(name, f->registerName, 256);
@ -343,7 +332,6 @@ Files_File Files_New (CHAR *name, ADDRESS name__len)
f->len = 0; f->len = 0;
f->pos = 0; f->pos = 0;
f->swapper = -1; f->swapper = -1;
__DEL(name);
return f; return f;
} }
@ -1082,14 +1070,12 @@ static void Files_Finalize (SYSTEM_PTR o)
void Files_SetSearchPath (CHAR *path, ADDRESS path__len) void Files_SetSearchPath (CHAR *path, ADDRESS path__len)
{ {
__DUP(path, path__len, CHAR);
if (Strings_Length(path, path__len) != 0) { if (Strings_Length(path, path__len) != 0) {
Files_SearchPath = __NEWARR(NIL, 1, 1, 1, 1, ((ADDRESS)((Strings_Length(path, path__len) + 1)))); Files_SearchPath = __NEWARR(NIL, 1, 1, 1, 1, ((ADDRESS)((Strings_Length(path, path__len) + 1))));
__COPY(path, Files_SearchPath->data, Files_SearchPath->len[0]); __COPY(path, Files_SearchPath->data, Files_SearchPath->len[0]);
} else { } else {
Files_SearchPath = NIL; Files_SearchPath = NIL;
} }
__DEL(path);
} }
static void EnumPtrs(void (*P)(void*)) static void EnumPtrs(void (*P)(void*))

2
bootstrap/unix-88/Files.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Files__h #ifndef Files__h
#define Files__h #define Files__h

6
bootstrap/unix-88/Heap.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -151,7 +151,6 @@ SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs)
INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len) INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len)
{ {
Heap_Module m, p; Heap_Module m, p;
__DUP(name, name__len, CHAR);
m = (Heap_Module)(ADDRESS)Heap_modules; m = (Heap_Module)(ADDRESS)Heap_modules;
while ((m != NIL && __STRCMP(m->name, name) != 0)) { while ((m != NIL && __STRCMP(m->name, name) != 0)) {
p = m; p = m;
@ -163,14 +162,11 @@ INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len)
} else { } else {
p->next = m->next; p->next = m->next;
} }
__DEL(name);
return 0; return 0;
} else { } else {
if (m == NIL) { if (m == NIL) {
__DEL(name);
return -1; return -1;
} else { } else {
__DEL(name);
return m->refcnt; return m->refcnt;
} }
} }

2
bootstrap/unix-88/Heap.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */
#ifndef Heap__h #ifndef Heap__h
#define Heap__h #define Heap__h

37
bootstrap/unix-88/Modules.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -100,33 +100,28 @@ INT16 Modules_ArgPos (CHAR *s, ADDRESS s__len)
{ {
INT16 i; INT16 i;
CHAR arg[256]; CHAR arg[256];
__DUP(s, s__len, CHAR);
i = 0; i = 0;
Modules_GetArg(i, (void*)arg, 256); Modules_GetArg(i, (void*)arg, 256);
while ((i < Modules_ArgCount && __STRCMP(s, arg) != 0)) { while ((i < Modules_ArgCount && __STRCMP(s, arg) != 0)) {
i += 1; i += 1;
Modules_GetArg(i, (void*)arg, 256); Modules_GetArg(i, (void*)arg, 256);
} }
__DEL(s);
return i; return i;
} }
static INT16 Modules_CharCount (CHAR *s, ADDRESS s__len) static INT16 Modules_CharCount (CHAR *s, ADDRESS s__len)
{ {
INT16 i; INT16 i;
__DUP(s, s__len, CHAR);
i = 0; i = 0;
while ((i < s__len && s[__X(i, s__len)] != 0x00)) { while ((i < s__len && s[__X(i, s__len)] != 0x00)) {
i += 1; i += 1;
} }
__DEL(s);
return i; return i;
} }
static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len) static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
{ {
INT16 i, j; INT16 i, j;
__DUP(s, s__len, CHAR);
i = 0; i = 0;
j = Modules_CharCount(d, d__len); j = Modules_CharCount(d, d__len);
while (s[__X(i, s__len)] != 0x00) { while (s[__X(i, s__len)] != 0x00) {
@ -135,13 +130,11 @@ static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
j += 1; j += 1;
} }
d[__X(j, d__len)] = 0x00; d[__X(j, d__len)] = 0x00;
__DEL(s);
} }
static void Modules_AppendPart (CHAR c, CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len) static void Modules_AppendPart (CHAR c, CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
{ {
INT16 i, j; INT16 i, j;
__DUP(s, s__len, CHAR);
i = 0; i = 0;
j = Modules_CharCount(d, d__len); j = Modules_CharCount(d, d__len);
if ((j > 0 && d[__X(j - 1, d__len)] != c)) { if ((j > 0 && d[__X(j - 1, d__len)] != c)) {
@ -154,69 +147,54 @@ static void Modules_AppendPart (CHAR c, CHAR *s, ADDRESS s__len, CHAR *d, ADDRES
j += 1; j += 1;
} }
d[__X(j, d__len)] = 0x00; d[__X(j, d__len)] = 0x00;
__DEL(s);
} }
static BOOLEAN Modules_IsOneOf (CHAR c, CHAR *s, ADDRESS s__len) static BOOLEAN Modules_IsOneOf (CHAR c, CHAR *s, ADDRESS s__len)
{ {
INT16 i; INT16 i;
__DUP(s, s__len, CHAR);
if (c == 0x00) { if (c == 0x00) {
__DEL(s);
return 0; return 0;
} }
i = 0; i = 0;
while ((s[__X(i, s__len)] != c && s[__X(i, s__len)] != 0x00)) { while ((s[__X(i, s__len)] != c && s[__X(i, s__len)] != 0x00)) {
i += 1; i += 1;
} }
__DEL(s);
return s[__X(i, s__len)] == c; return s[__X(i, s__len)] == c;
} }
static BOOLEAN Modules_IsAbsolute (CHAR *d, ADDRESS d__len) static BOOLEAN Modules_IsAbsolute (CHAR *d, ADDRESS d__len)
{ {
__DUP(d, d__len, CHAR);
if (d[0] == 0x00) { if (d[0] == 0x00) {
__DEL(d);
return 0; return 0;
} }
if (Modules_IsOneOf(d[0], (CHAR*)"/\\", 3)) { if (Modules_IsOneOf(d[0], (CHAR*)"/\\", 3)) {
__DEL(d);
return 1; return 1;
} }
if (d[__X(1, d__len)] == ':') { if (d[__X(1, d__len)] == ':') {
__DEL(d);
return 1; return 1;
} }
__DEL(d);
return 0; return 0;
} }
static void Modules_Canonify (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len) static void Modules_Canonify (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
{ {
__DUP(s, s__len, CHAR);
if (Modules_IsAbsolute(s, s__len)) { if (Modules_IsAbsolute(s, s__len)) {
__COPY(s, d, d__len); __COPY(s, d, d__len);
} else { } else {
__COPY(Platform_CWD, d, d__len); __COPY(Platform_CWD, d, d__len);
Modules_AppendPart('/', s, s__len, (void*)d, d__len); Modules_AppendPart('/', s, s__len, (void*)d, d__len);
} }
__DEL(s);
} }
static BOOLEAN Modules_IsFilePresent (CHAR *s, ADDRESS s__len) static BOOLEAN Modules_IsFilePresent (CHAR *s, ADDRESS s__len)
{ {
Platform_FileIdentity identity; Platform_FileIdentity identity;
__DUP(s, s__len, CHAR);
__DEL(s);
return Platform_IdentifyByName(s, s__len, &identity, Platform_FileIdentity__typ) == 0; return Platform_IdentifyByName(s, s__len, &identity, Platform_FileIdentity__typ) == 0;
} }
static void Modules_ExtractPart (CHAR *s, ADDRESS s__len, INT16 *i, CHAR *p, ADDRESS p__len, CHAR *d, ADDRESS d__len) static void Modules_ExtractPart (CHAR *s, ADDRESS s__len, INT16 *i, CHAR *p, ADDRESS p__len, CHAR *d, ADDRESS d__len)
{ {
INT16 j; INT16 j;
__DUP(s, s__len, CHAR);
__DUP(p, p__len, CHAR);
j = 0; j = 0;
while ((s[__X(*i, s__len)] != 0x00 && !Modules_IsOneOf(s[__X(*i, s__len)], p, p__len))) { while ((s[__X(*i, s__len)] != 0x00 && !Modules_IsOneOf(s[__X(*i, s__len)], p, p__len))) {
d[__X(j, d__len)] = s[__X(*i, s__len)]; d[__X(j, d__len)] = s[__X(*i, s__len)];
@ -227,15 +205,12 @@ static void Modules_ExtractPart (CHAR *s, ADDRESS s__len, INT16 *i, CHAR *p, ADD
while (Modules_IsOneOf(s[__X(*i, s__len)], p, p__len)) { while (Modules_IsOneOf(s[__X(*i, s__len)], p, p__len)) {
*i += 1; *i += 1;
} }
__DEL(s);
__DEL(p);
} }
static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len) static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
{ {
INT16 i, j; INT16 i, j;
CHAR part[1024]; CHAR part[1024];
__DUP(s, s__len, CHAR);
i = 0; i = 0;
j = 0; j = 0;
while ((i < 2 && Modules_IsOneOf(s[__X(i, s__len)], (CHAR*)"/\\", 3))) { while ((i < 2 && Modules_IsOneOf(s[__X(i, s__len)], (CHAR*)"/\\", 3))) {
@ -250,7 +225,6 @@ static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
Modules_AppendPart('/', part, 1024, (void*)d, d__len); Modules_AppendPart('/', part, 1024, (void*)d, d__len);
} }
} }
__DEL(s);
} }
typedef typedef
@ -306,7 +280,6 @@ Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len)
Heap_Module m = NIL; Heap_Module m = NIL;
CHAR bodyname[64]; CHAR bodyname[64];
Heap_Command body; Heap_Command body;
__DUP(name, name__len, CHAR);
m = Modules_modules(); m = Modules_modules();
while ((m != NIL && __STRCMP(m->name, name) != 0)) { while ((m != NIL && __STRCMP(m->name, name) != 0)) {
m = m->next; m = m->next;
@ -321,14 +294,12 @@ Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len)
Modules_Append(name, name__len, (void*)Modules_resMsg, 256); Modules_Append(name, name__len, (void*)Modules_resMsg, 256);
Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256); Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256);
} }
__DEL(name);
return m; return m;
} }
Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len) Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len)
{ {
Heap_Cmd c = NIL; Heap_Cmd c = NIL;
__DUP(name, name__len, CHAR);
c = mod->cmds; c = mod->cmds;
while ((c != NIL && __STRCMP(c->name, name) != 0)) { while ((c != NIL && __STRCMP(c->name, name) != 0)) {
c = c->next; c = c->next;
@ -336,7 +307,6 @@ Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len
if (c != NIL) { if (c != NIL) {
Modules_res = 0; Modules_res = 0;
Modules_resMsg[0] = 0x00; Modules_resMsg[0] = 0x00;
__DEL(name);
return c->cmd; return c->cmd;
} else { } else {
Modules_res = 2; Modules_res = 2;
@ -346,7 +316,6 @@ Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len
Modules_Append((CHAR*)".", 2, (void*)Modules_resMsg, 256); Modules_Append((CHAR*)".", 2, (void*)Modules_resMsg, 256);
Modules_Append(name, name__len, (void*)Modules_resMsg, 256); Modules_Append(name, name__len, (void*)Modules_resMsg, 256);
Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256); Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256);
__DEL(name);
return NIL; return NIL;
} }
__RETCHK; __RETCHK;
@ -356,7 +325,6 @@ void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all)
{ {
Heap_Module m = NIL, p = NIL; Heap_Module m = NIL, p = NIL;
INT32 refcount; INT32 refcount;
__DUP(name, name__len, CHAR);
m = Modules_modules(); m = Modules_modules();
if (all) { if (all) {
Modules_res = 1; Modules_res = 1;
@ -374,7 +342,6 @@ void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all)
Modules_res = 1; Modules_res = 1;
} }
} }
__DEL(name);
} }
static void Modules_errch (CHAR c) static void Modules_errch (CHAR c)
@ -386,13 +353,11 @@ static void Modules_errch (CHAR c)
static void Modules_errstring (CHAR *s, ADDRESS s__len) static void Modules_errstring (CHAR *s, ADDRESS s__len)
{ {
INT32 i; INT32 i;
__DUP(s, s__len, CHAR);
i = 0; i = 0;
while ((i < s__len && s[__X(i, s__len)] != 0x00)) { while ((i < s__len && s[__X(i, s__len)] != 0x00)) {
Modules_errch(s[__X(i, s__len)]); Modules_errch(s[__X(i, s__len)]);
i += 1; i += 1;
} }
__DEL(s);
} }
static void Modules_errint (INT32 l) static void Modules_errint (INT32 l)

2
bootstrap/unix-88/Modules.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Modules__h #ifndef Modules__h
#define Modules__h #define Modules__h

277
bootstrap/unix-88/OPB.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -27,6 +27,7 @@ static void OPB_CheckProc (OPT_Struct x, OPT_Object y);
static void OPB_CheckPtr (OPT_Node x, OPT_Node y); static void OPB_CheckPtr (OPT_Node x, OPT_Node y);
static void OPB_CheckRealType (INT16 f, INT16 nr, OPT_Const x); static void OPB_CheckRealType (INT16 f, INT16 nr, OPT_Const x);
static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp); static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp);
static void OPB_CheckWrite (OPT_Node x);
static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y); static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y);
export void OPB_Construct (INT8 class, OPT_Node *x, OPT_Node y); export void OPB_Construct (INT8 class, OPT_Node *x, OPT_Node y);
static void OPB_Convert (OPT_Node *x, OPT_Struct typ); static void OPB_Convert (OPT_Node *x, OPT_Struct typ);
@ -101,9 +102,6 @@ OPT_Node OPB_NewLeaf (OPT_Object obj)
} }
node->obj = obj; node->obj = obj;
node->typ = obj->typ; node->typ = obj->typ;
if ((((obj->mode == 1 && __IN(obj->typ->comp, 0x0c, 32))) && obj->typ->sysflag != 0)) {
node->readonly = 1;
}
return node; return node;
} }
@ -359,16 +357,16 @@ void OPB_Field (OPT_Node *x, OPT_Object y)
} }
} }
static struct TypTest__58 { static struct TypTest__59 {
OPT_Node *x; OPT_Node *x;
OPT_Object *obj; OPT_Object *obj;
BOOLEAN *guard; BOOLEAN *guard;
struct TypTest__58 *lnk; struct TypTest__59 *lnk;
} *TypTest__58_s; } *TypTest__59_s;
static void GTT__59 (OPT_Struct t0, OPT_Struct t1); static void GTT__60 (OPT_Struct t0, OPT_Struct t1);
static void GTT__59 (OPT_Struct t0, OPT_Struct t1) static void GTT__60 (OPT_Struct t0, OPT_Struct t1)
{ {
OPT_Node node = NIL; OPT_Node node = NIL;
OPT_Struct t = NIL; OPT_Struct t = NIL;
@ -381,54 +379,54 @@ static void GTT__59 (OPT_Struct t0, OPT_Struct t1)
t1 = t1->BaseTyp; t1 = t1->BaseTyp;
} }
if (t1 == t0 || t0->form == 0) { if (t1 == t0 || t0->form == 0) {
if (*TypTest__58_s->guard) { if (*TypTest__59_s->guard) {
OPB_BindNodes(5, NIL, &*TypTest__58_s->x, NIL); OPB_BindNodes(5, NIL, &*TypTest__59_s->x, NIL);
(*TypTest__58_s->x)->readonly = (*TypTest__58_s->x)->left->readonly; (*TypTest__59_s->x)->readonly = (*TypTest__59_s->x)->left->readonly;
} else { } else {
node = OPT_NewNode(11); node = OPT_NewNode(11);
node->subcl = 16; node->subcl = 16;
node->left = *TypTest__58_s->x; node->left = *TypTest__59_s->x;
node->obj = *TypTest__58_s->obj; node->obj = *TypTest__59_s->obj;
*TypTest__58_s->x = node; *TypTest__59_s->x = node;
} }
} else { } else {
OPB_err(85); OPB_err(85);
} }
} else if (t0 != t1) { } else if (t0 != t1) {
OPB_err(85); OPB_err(85);
} else if (!*TypTest__58_s->guard) { } else if (!*TypTest__59_s->guard) {
if ((*TypTest__58_s->x)->class == 5) { if ((*TypTest__59_s->x)->class == 5) {
node = OPT_NewNode(11); node = OPT_NewNode(11);
node->subcl = 16; node->subcl = 16;
node->left = *TypTest__58_s->x; node->left = *TypTest__59_s->x;
node->obj = *TypTest__58_s->obj; node->obj = *TypTest__59_s->obj;
*TypTest__58_s->x = node; *TypTest__59_s->x = node;
} else { } else {
*TypTest__58_s->x = OPB_NewBoolConst(1); *TypTest__59_s->x = OPB_NewBoolConst(1);
} }
} }
} }
void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard) void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
{ {
struct TypTest__58 _s; struct TypTest__59 _s;
_s.x = x; _s.x = x;
_s.obj = &obj; _s.obj = &obj;
_s.guard = &guard; _s.guard = &guard;
_s.lnk = TypTest__58_s; _s.lnk = TypTest__59_s;
TypTest__58_s = &_s; TypTest__59_s = &_s;
if (OPB_NotVar(*x)) { if (OPB_NotVar(*x)) {
OPB_err(112); OPB_err(112);
} else if ((*x)->typ->form == 11) { } else if ((*x)->typ->form == 11) {
if (((*x)->typ->BaseTyp->comp != 4 && (*x)->typ != OPT_sysptrtyp)) { if (((*x)->typ->BaseTyp->comp != 4 && (*x)->typ != OPT_sysptrtyp)) {
OPB_err(85); OPB_err(85);
} else if (obj->typ->form == 11) { } else if (obj->typ->form == 11) {
GTT__59((*x)->typ->BaseTyp, obj->typ->BaseTyp); GTT__60((*x)->typ->BaseTyp, obj->typ->BaseTyp);
} else { } else {
OPB_err(86); OPB_err(86);
} }
} else if (((((*x)->typ->comp == 4 && (*x)->class == 1)) && obj->typ->comp == 4)) { } else if (((((*x)->typ->comp == 4 && (*x)->class == 1)) && obj->typ->comp == 4)) {
GTT__59((*x)->typ, obj->typ); GTT__60((*x)->typ, obj->typ);
} else { } else {
OPB_err(87); OPB_err(87);
} }
@ -437,7 +435,7 @@ void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
} else { } else {
(*x)->typ = OPT_booltyp; (*x)->typ = OPT_booltyp;
} }
TypTest__58_s = _s.lnk; TypTest__59_s = _s.lnk;
} }
void OPB_In (OPT_Node *x, OPT_Node y) void OPB_In (OPT_Node *x, OPT_Node y)
@ -501,13 +499,13 @@ static void OPB_CheckRealType (INT16 f, INT16 nr, OPT_Const x)
x->intval = -1; x->intval = -1;
} }
static struct MOp__28 { static struct MOp__29 {
struct MOp__28 *lnk; struct MOp__29 *lnk;
} *MOp__28_s; } *MOp__29_s;
static OPT_Node NewOp__29 (INT8 op, OPT_Struct typ, OPT_Node z); static OPT_Node NewOp__30 (INT8 op, OPT_Struct typ, OPT_Node z);
static OPT_Node NewOp__29 (INT8 op, OPT_Struct typ, OPT_Node z) static OPT_Node NewOp__30 (INT8 op, OPT_Struct typ, OPT_Node z)
{ {
OPT_Node node = NIL; OPT_Node node = NIL;
node = OPT_NewNode(11); node = OPT_NewNode(11);
@ -522,9 +520,9 @@ void OPB_MOp (INT8 op, OPT_Node *x)
INT16 f; INT16 f;
OPT_Struct typ = NIL; OPT_Struct typ = NIL;
OPT_Node z = NIL; OPT_Node z = NIL;
struct MOp__28 _s; struct MOp__29 _s;
_s.lnk = MOp__28_s; _s.lnk = MOp__29_s;
MOp__28_s = &_s; MOp__29_s = &_s;
z = *x; z = *x;
if (z->class == 8 || z->class == 9) { if (z->class == 8 || z->class == 9) {
OPB_err(126); OPB_err(126);
@ -538,7 +536,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
z->conval->intval = OPB_BoolToInt(!OPB_IntToBool(z->conval->intval)); z->conval->intval = OPB_BoolToInt(!OPB_IntToBool(z->conval->intval));
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__29(op, typ, z); z = NewOp__30(op, typ, z);
} }
} else { } else {
OPB_err(98); OPB_err(98);
@ -570,7 +568,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
} }
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__29(op, typ, z); z = NewOp__30(op, typ, z);
} }
} else { } else {
OPB_err(97); OPB_err(97);
@ -591,7 +589,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
} }
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__29(op, typ, z); z = NewOp__30(op, typ, z);
} }
} else { } else {
OPB_err(111); OPB_err(111);
@ -603,7 +601,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
z->conval->intval = (INT16)__CAP(__CHR(z->conval->intval)); z->conval->intval = (INT16)__CAP(__CHR(z->conval->intval));
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__29(op, typ, z); z = NewOp__30(op, typ, z);
} }
} else { } else {
OPB_err(111); OPB_err(111);
@ -616,7 +614,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
z->conval->intval = OPB_BoolToInt(__ODD(z->conval->intval)); z->conval->intval = OPB_BoolToInt(__ODD(z->conval->intval));
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__29(op, typ, z); z = NewOp__30(op, typ, z);
} }
} else { } else {
OPB_err(111); OPB_err(111);
@ -629,7 +627,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
f = 8; f = 8;
} }
if (z->class < 7 || f == 8) { if (z->class < 7 || f == 8) {
z = NewOp__29(op, typ, z); z = NewOp__30(op, typ, z);
} else { } else {
OPB_err(127); OPB_err(127);
} }
@ -638,7 +636,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
case 25: case 25:
if ((f == 4 && z->class == 7)) { if ((f == 4 && z->class == 7)) {
if ((0 <= z->conval->intval && z->conval->intval <= -1)) { if ((0 <= z->conval->intval && z->conval->intval <= -1)) {
z = NewOp__29(op, typ, z); z = NewOp__30(op, typ, z);
} else { } else {
OPB_err(219); OPB_err(219);
} }
@ -655,7 +653,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
} }
} }
*x = z; *x = z;
MOp__28_s = _s.lnk; MOp__29_s = _s.lnk;
} }
static void OPB_CheckPtr (OPT_Node x, OPT_Node y) static void OPB_CheckPtr (OPT_Node x, OPT_Node y)
@ -742,65 +740,65 @@ static void OPB_CheckProc (OPT_Struct x, OPT_Object y)
} }
} }
static struct ConstOp__13 { static struct ConstOp__14 {
OPT_Node *x; OPT_Node *x;
INT16 *f; INT16 *f;
OPT_Const *xval, *yval; OPT_Const *xval, *yval;
struct ConstOp__13 *lnk; struct ConstOp__14 *lnk;
} *ConstOp__13_s; } *ConstOp__14_s;
static INT16 ConstCmp__14 (void); static INT16 ConstCmp__15 (void);
static INT16 ConstCmp__14 (void) static INT16 ConstCmp__15 (void)
{ {
INT16 res; INT16 res;
switch (*ConstOp__13_s->f) { switch (*ConstOp__14_s->f) {
case 0: case 0:
res = 9; res = 9;
break; break;
case 1: case 3: case 4: case 1: case 3: case 4:
if ((*ConstOp__13_s->xval)->intval < (*ConstOp__13_s->yval)->intval) { if ((*ConstOp__14_s->xval)->intval < (*ConstOp__14_s->yval)->intval) {
res = 11; res = 11;
} else if ((*ConstOp__13_s->xval)->intval > (*ConstOp__13_s->yval)->intval) { } else if ((*ConstOp__14_s->xval)->intval > (*ConstOp__14_s->yval)->intval) {
res = 13; res = 13;
} else { } else {
res = 9; res = 9;
} }
break; break;
case 5: case 6: case 5: case 6:
if ((*ConstOp__13_s->xval)->realval < (*ConstOp__13_s->yval)->realval) { if ((*ConstOp__14_s->xval)->realval < (*ConstOp__14_s->yval)->realval) {
res = 11; res = 11;
} else if ((*ConstOp__13_s->xval)->realval > (*ConstOp__13_s->yval)->realval) { } else if ((*ConstOp__14_s->xval)->realval > (*ConstOp__14_s->yval)->realval) {
res = 13; res = 13;
} else { } else {
res = 9; res = 9;
} }
break; break;
case 2: case 2:
if ((*ConstOp__13_s->xval)->intval != (*ConstOp__13_s->yval)->intval) { if ((*ConstOp__14_s->xval)->intval != (*ConstOp__14_s->yval)->intval) {
res = 10; res = 10;
} else { } else {
res = 9; res = 9;
} }
break; break;
case 7: case 7:
if ((*ConstOp__13_s->xval)->setval != (*ConstOp__13_s->yval)->setval) { if ((*ConstOp__14_s->xval)->setval != (*ConstOp__14_s->yval)->setval) {
res = 10; res = 10;
} else { } else {
res = 9; res = 9;
} }
break; break;
case 8: case 8:
if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) < 0) { if (__STRCMP(*(*ConstOp__14_s->xval)->ext, *(*ConstOp__14_s->yval)->ext) < 0) {
res = 11; res = 11;
} else if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) > 0) { } else if (__STRCMP(*(*ConstOp__14_s->xval)->ext, *(*ConstOp__14_s->yval)->ext) > 0) {
res = 13; res = 13;
} else { } else {
res = 9; res = 9;
} }
break; break;
case 9: case 11: case 12: case 9: case 11: case 12:
if ((*ConstOp__13_s->xval)->intval != (*ConstOp__13_s->yval)->intval) { if ((*ConstOp__14_s->xval)->intval != (*ConstOp__14_s->yval)->intval) {
res = 10; res = 10;
} else { } else {
res = 9; res = 9;
@ -808,11 +806,11 @@ static INT16 ConstCmp__14 (void)
break; break;
default: default:
OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstCmp, f = ", 37); OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstCmp, f = ", 37);
OPM_LogWNum(*ConstOp__13_s->f, 0); OPM_LogWNum(*ConstOp__14_s->f, 0);
OPM_LogWLn(); OPM_LogWLn();
break; break;
} }
(*ConstOp__13_s->x)->typ = OPT_booltyp; (*ConstOp__14_s->x)->typ = OPT_booltyp;
return res; return res;
} }
@ -822,13 +820,13 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
OPT_Const xval = NIL, yval = NIL; OPT_Const xval = NIL, yval = NIL;
INT64 xv, yv; INT64 xv, yv;
BOOLEAN temp; BOOLEAN temp;
struct ConstOp__13 _s; struct ConstOp__14 _s;
_s.x = &x; _s.x = &x;
_s.f = &f; _s.f = &f;
_s.xval = &xval; _s.xval = &xval;
_s.yval = &yval; _s.yval = &yval;
_s.lnk = ConstOp__13_s; _s.lnk = ConstOp__14_s;
ConstOp__13_s = &_s; ConstOp__14_s = &_s;
f = x->typ->form; f = x->typ->form;
g = y->typ->form; g = y->typ->form;
xval = x->conval; xval = x->conval;
@ -1055,37 +1053,37 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
} }
break; break;
case 9: case 9:
xval->intval = OPB_BoolToInt(ConstCmp__14() == 9); xval->intval = OPB_BoolToInt(ConstCmp__15() == 9);
break; break;
case 10: case 10:
xval->intval = OPB_BoolToInt(ConstCmp__14() != 9); xval->intval = OPB_BoolToInt(ConstCmp__15() != 9);
break; break;
case 11: case 11:
if (__IN(f, 0x0a84, 32)) { if (__IN(f, 0x0a84, 32)) {
OPB_err(108); OPB_err(108);
} else { } else {
xval->intval = OPB_BoolToInt(ConstCmp__14() == 11); xval->intval = OPB_BoolToInt(ConstCmp__15() == 11);
} }
break; break;
case 12: case 12:
if (__IN(f, 0x0a84, 32)) { if (__IN(f, 0x0a84, 32)) {
OPB_err(108); OPB_err(108);
} else { } else {
xval->intval = OPB_BoolToInt(ConstCmp__14() != 13); xval->intval = OPB_BoolToInt(ConstCmp__15() != 13);
} }
break; break;
case 13: case 13:
if (__IN(f, 0x0a84, 32)) { if (__IN(f, 0x0a84, 32)) {
OPB_err(108); OPB_err(108);
} else { } else {
xval->intval = OPB_BoolToInt(ConstCmp__14() == 13); xval->intval = OPB_BoolToInt(ConstCmp__15() == 13);
} }
break; break;
case 14: case 14:
if (__IN(f, 0x0a84, 32)) { if (__IN(f, 0x0a84, 32)) {
OPB_err(108); OPB_err(108);
} else { } else {
xval->intval = OPB_BoolToInt(ConstCmp__14() != 11); xval->intval = OPB_BoolToInt(ConstCmp__15() != 11);
} }
break; break;
default: default:
@ -1094,7 +1092,7 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
OPM_LogWLn(); OPM_LogWLn();
break; break;
} }
ConstOp__13_s = _s.lnk; ConstOp__14_s = _s.lnk;
} }
static void OPB_Convert (OPT_Node *x, OPT_Struct typ) static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
@ -1157,15 +1155,15 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
(*x)->typ = typ; (*x)->typ = typ;
} }
static struct Op__38 { static struct Op__39 {
INT16 *f, *g; INT16 *f, *g;
struct Op__38 *lnk; struct Op__39 *lnk;
} *Op__38_s; } *Op__39_s;
static void NewOp__39 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y); static void NewOp__40 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y);
static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y); static BOOLEAN strings__42 (OPT_Node *x, OPT_Node *y);
static void NewOp__39 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y) static void NewOp__40 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
{ {
OPT_Node node = NIL; OPT_Node node = NIL;
node = OPT_NewNode(12); node = OPT_NewNode(12);
@ -1176,28 +1174,28 @@ static void NewOp__39 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
*x = node; *x = node;
} }
static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y) static BOOLEAN strings__42 (OPT_Node *x, OPT_Node *y)
{ {
BOOLEAN ok, xCharArr, yCharArr; BOOLEAN ok, xCharArr, yCharArr;
xCharArr = (__IN((*x)->typ->comp, 0x0c, 32) && (*x)->typ->BaseTyp->form == 3) || *Op__38_s->f == 8; xCharArr = (__IN((*x)->typ->comp, 0x0c, 32) && (*x)->typ->BaseTyp->form == 3) || *Op__39_s->f == 8;
yCharArr = (__IN((*y)->typ->comp, 0x0c, 32) && (*y)->typ->BaseTyp->form == 3) || *Op__38_s->g == 8; yCharArr = (__IN((*y)->typ->comp, 0x0c, 32) && (*y)->typ->BaseTyp->form == 3) || *Op__39_s->g == 8;
if ((((xCharArr && *Op__38_s->g == 3)) && (*y)->class == 7)) { if ((((xCharArr && *Op__39_s->g == 3)) && (*y)->class == 7)) {
OPB_CharToString(*y); OPB_CharToString(*y);
*Op__38_s->g = 8; *Op__39_s->g = 8;
yCharArr = 1; yCharArr = 1;
} }
if ((((yCharArr && *Op__38_s->f == 3)) && (*x)->class == 7)) { if ((((yCharArr && *Op__39_s->f == 3)) && (*x)->class == 7)) {
OPB_CharToString(*x); OPB_CharToString(*x);
*Op__38_s->f = 8; *Op__39_s->f = 8;
xCharArr = 1; xCharArr = 1;
} }
ok = (xCharArr && yCharArr); ok = (xCharArr && yCharArr);
if (ok) { if (ok) {
if ((*Op__38_s->f == 8 && (*x)->conval->intval2 == 1)) { if ((*Op__39_s->f == 8 && (*x)->conval->intval2 == 1)) {
(*x)->typ = OPT_chartyp; (*x)->typ = OPT_chartyp;
(*x)->conval->intval = 0; (*x)->conval->intval = 0;
OPB_Index(&*y, OPB_NewIntConst(0)); OPB_Index(&*y, OPB_NewIntConst(0));
} else if ((*Op__38_s->g == 8 && (*y)->conval->intval2 == 1)) { } else if ((*Op__39_s->g == 8 && (*y)->conval->intval2 == 1)) {
(*y)->typ = OPT_chartyp; (*y)->typ = OPT_chartyp;
(*y)->conval->intval = 0; (*y)->conval->intval = 0;
OPB_Index(&*x, OPB_NewIntConst(0)); OPB_Index(&*x, OPB_NewIntConst(0));
@ -1213,11 +1211,11 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
OPT_Struct typ = NIL; OPT_Struct typ = NIL;
BOOLEAN do_; BOOLEAN do_;
INT64 val; INT64 val;
struct Op__38 _s; struct Op__39 _s;
_s.f = &f; _s.f = &f;
_s.g = &g; _s.g = &g;
_s.lnk = Op__38_s; _s.lnk = Op__39_s;
Op__38_s = &_s; Op__39_s = &_s;
z = *x; z = *x;
if (((z->class == 8 || z->class == 9) || y->class == 8) || y->class == 9) { if (((z->class == 8 || z->class == 9) || y->class == 8) || y->class == 9) {
OPB_err(126); OPB_err(126);
@ -1338,7 +1336,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp; typ = OPT_undftyp;
} }
if (do_) { if (do_) {
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
} }
break; break;
case 2: case 2:
@ -1357,7 +1355,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
OPB_err(102); OPB_err(102);
typ = OPT_undftyp; typ = OPT_undftyp;
} }
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
break; break;
case 3: case 3:
do_ = 1; do_ = 1;
@ -1380,7 +1378,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp; typ = OPT_undftyp;
} }
if (do_) { if (do_) {
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
} }
break; break;
case 4: case 4:
@ -1398,7 +1396,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
OPB_err(104); OPB_err(104);
typ = OPT_undftyp; typ = OPT_undftyp;
} }
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
break; break;
case 5: case 5:
if (f == 2) { if (f == 2) {
@ -1408,7 +1406,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
} }
} else if ((y->class == 7 && OPB_IntToBool(y->conval->intval))) { } else if ((y->class == 7 && OPB_IntToBool(y->conval->intval))) {
} else { } else {
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
} }
} else if (f != 0) { } else if (f != 0) {
OPB_err(94); OPB_err(94);
@ -1431,7 +1429,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
} }
} }
if (do_) { if (do_) {
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
} }
break; break;
case 7: case 7:
@ -1440,7 +1438,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
typ = OPT_undftyp; typ = OPT_undftyp;
} }
if ((f != 4 || y->class != 7) || y->conval->intval != 0) { if ((f != 4 || y->class != 7) || y->conval->intval != 0) {
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
} }
break; break;
case 8: case 8:
@ -1451,7 +1449,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
} }
} else if ((y->class == 7 && !OPB_IntToBool(y->conval->intval))) { } else if ((y->class == 7 && !OPB_IntToBool(y->conval->intval))) {
} else { } else {
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
} }
} else if (f != 0) { } else if (f != 0) {
OPB_err(95); OPB_err(95);
@ -1459,16 +1457,16 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
} }
break; break;
case 9: case 10: case 9: case 10:
if (__IN(f, 0x1aff, 32) || strings__41(&z, &y)) { if (__IN(f, 0x1aff, 32) || strings__42(&z, &y)) {
typ = OPT_booltyp; typ = OPT_booltyp;
} else { } else {
OPB_err(107); OPB_err(107);
typ = OPT_undftyp; typ = OPT_undftyp;
} }
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
break; break;
case 11: case 12: case 13: case 14: case 11: case 12: case 13: case 14:
if (__IN(f, 0x79, 32) || strings__41(&z, &y)) { if (__IN(f, 0x79, 32) || strings__42(&z, &y)) {
typ = OPT_booltyp; typ = OPT_booltyp;
} else { } else {
OPM_LogWLn(); OPM_LogWLn();
@ -1477,7 +1475,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
OPB_err(108); OPB_err(108);
typ = OPT_undftyp; typ = OPT_undftyp;
} }
NewOp__39(op, typ, &z, y); NewOp__40(op, typ, &z, y);
break; break;
default: default:
OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", 32); OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", 32);
@ -1487,7 +1485,7 @@ void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
} }
} }
*x = z; *x = z;
Op__38_s = _s.lnk; Op__39_s = _s.lnk;
} }
void OPB_SetRange (OPT_Node *x, OPT_Node y) void OPB_SetRange (OPT_Node *x, OPT_Node y)
@ -1672,6 +1670,19 @@ static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo)
{ {
} }
static void OPB_CheckWrite (OPT_Node x)
{
if (x->readonly) {
OPB_err(76);
}
while (__IN(x->class, 0x74, 32)) {
x = x->left;
}
if ((x != NIL && x->obj != NIL)) {
x->obj->written = 1;
}
}
void OPB_StPar0 (OPT_Node *par0, INT16 fctno) void OPB_StPar0 (OPT_Node *par0, INT16 fctno)
{ {
INT16 f; INT16 f;
@ -1697,9 +1708,7 @@ void OPB_StPar0 (OPT_Node *par0, INT16 fctno)
if (OPB_NotVar(x)) { if (OPB_NotVar(x)) {
OPB_err(112); OPB_err(112);
} else if (f == 11) { } else if (f == 11) {
if (x->readonly) { OPB_CheckWrite(x);
OPB_err(76);
}
f = x->typ->BaseTyp->comp; f = x->typ->BaseTyp->comp;
if (__IN(f, 0x1c, 32)) { if (__IN(f, 0x1c, 32)) {
if (f == 3) { if (f == 3) {
@ -1855,8 +1864,8 @@ void OPB_StPar0 (OPT_Node *par0, INT16 fctno)
OPB_err(112); OPB_err(112);
} else if (f != 4) { } else if (f != 4) {
OPB_err(111); OPB_err(111);
} else if (x->readonly) { } else {
OPB_err(76); OPB_CheckWrite(x);
} }
break; break;
case 15: case 16: case 15: case 16:
@ -1865,8 +1874,8 @@ void OPB_StPar0 (OPT_Node *par0, INT16 fctno)
} else if (x->typ->form != 7) { } else if (x->typ->form != 7) {
OPB_err(111); OPB_err(111);
x->typ = OPT_settyp; x->typ = OPT_settyp;
} else if (x->readonly) { } else {
OPB_err(76); OPB_CheckWrite(x);
} }
break; break;
case 17: case 17:
@ -1978,13 +1987,13 @@ void OPB_StPar0 (OPT_Node *par0, INT16 fctno)
*par0 = x; *par0 = x;
} }
static struct StPar1__53 { static struct StPar1__54 {
struct StPar1__53 *lnk; struct StPar1__54 *lnk;
} *StPar1__53_s; } *StPar1__54_s;
static OPT_Node NewOp__54 (INT8 class, INT8 subcl, OPT_Node left, OPT_Node right); static OPT_Node NewOp__55 (INT8 class, INT8 subcl, OPT_Node left, OPT_Node right);
static OPT_Node NewOp__54 (INT8 class, INT8 subcl, OPT_Node left, OPT_Node right) static OPT_Node NewOp__55 (INT8 class, INT8 subcl, OPT_Node left, OPT_Node right)
{ {
OPT_Node node = NIL; OPT_Node node = NIL;
node = OPT_NewNode(class); node = OPT_NewNode(class);
@ -1999,9 +2008,9 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
INT16 f, L; INT16 f, L;
OPT_Struct typ = NIL; OPT_Struct typ = NIL;
OPT_Node p = NIL, t = NIL; OPT_Node p = NIL, t = NIL;
struct StPar1__53 _s; struct StPar1__54 _s;
_s.lnk = StPar1__53_s; _s.lnk = StPar1__54_s;
StPar1__53_s = &_s; StPar1__54_s = &_s;
p = *par0; p = *par0;
f = x->typ->form; f = x->typ->form;
switch (fctno) { switch (fctno) {
@ -2017,7 +2026,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
OPB_err(111); OPB_err(111);
} }
} }
p = NewOp__54(19, fctno, p, x); p = NewOp__55(19, fctno, p, x);
p->typ = OPT_notyp; p->typ = OPT_notyp;
} }
break; break;
@ -2028,7 +2037,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval >= (INT64)__ASHL(p->typ->size, 3)))) { if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval >= (INT64)__ASHL(p->typ->size, 3)))) {
OPB_err(202); OPB_err(202);
} }
p = NewOp__54(19, fctno, p, x); p = NewOp__55(19, fctno, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2053,7 +2062,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
p = p->left; p = p->left;
x->conval->intval += 1; x->conval->intval += 1;
} }
p = NewOp__54(12, 19, p, x); p = NewOp__55(12, 19, p, x);
p->typ = OPT_linttyp; p->typ = OPT_linttyp;
} else { } else {
p = x; p = x;
@ -2069,13 +2078,11 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
if (OPB_NotVar(x)) { if (OPB_NotVar(x)) {
OPB_err(112); OPB_err(112);
} else if ((__IN(x->typ->comp, 0x0c, 32) && x->typ->BaseTyp->form == 3)) { } else if ((__IN(x->typ->comp, 0x0c, 32) && x->typ->BaseTyp->form == 3)) {
if (x->readonly) { OPB_CheckWrite(x);
OPB_err(76);
}
t = x; t = x;
x = p; x = p;
p = t; p = t;
p = NewOp__54(19, 18, p, x); p = NewOp__55(19, 18, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2101,7 +2108,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
} }
p->obj = NIL; p->obj = NIL;
} else { } else {
p = NewOp__54(12, 17, p, x); p = NewOp__55(12, 17, p, x);
p->typ = p->left->typ; p->typ = p->left->typ;
} }
} else { } else {
@ -2132,9 +2139,9 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
OPB_err(111); OPB_err(111);
} else { } else {
if (fctno == 22) { if (fctno == 22) {
p = NewOp__54(12, 27, p, x); p = NewOp__55(12, 27, p, x);
} else { } else {
p = NewOp__54(12, 28, p, x); p = NewOp__55(12, 28, p, x);
} }
p->typ = p->left->typ; p->typ = p->left->typ;
} }
@ -2151,7 +2158,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
x = p; x = p;
p = t; p = t;
} }
p = NewOp__54(19, fctno, p, x); p = NewOp__55(19, fctno, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2161,7 +2168,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
if (x->class == 8 || x->class == 9) { if (x->class == 8 || x->class == 9) {
OPB_err(126); OPB_err(126);
} else if (f == 4) { } else if (f == 4) {
p = NewOp__54(12, 26, p, x); p = NewOp__55(12, 26, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2191,7 +2198,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
if (x->class == 8 || x->class == 9) { if (x->class == 8 || x->class == 9) {
OPB_err(126); OPB_err(126);
} else if (f == 4) { } else if (f == 4) {
p = NewOp__54(19, 30, p, x); p = NewOp__55(19, 30, p, x);
} else { } else {
OPB_err(111); OPB_err(111);
} }
@ -2237,7 +2244,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
break; break;
} }
*par0 = p; *par0 = p;
StPar1__53_s = _s.lnk; StPar1__54_s = _s.lnk;
} }
void OPB_StParN (OPT_Node *par0, OPT_Node x, INT16 fctno, INT16 n) void OPB_StParN (OPT_Node *par0, OPT_Node x, INT16 fctno, INT16 n)
@ -2356,7 +2363,7 @@ static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpa
f = atyp->comp; f = atyp->comp;
ftyp = ftyp->BaseTyp; ftyp = ftyp->BaseTyp;
atyp = atyp->BaseTyp; atyp = atyp->BaseTyp;
if (((fvarpar || sysflag != 0) && ftyp == OPT_bytetyp)) { if (ftyp == OPT_bytetyp) {
if (!__IN(f, 0x0c, 32) || !((__IN(atyp->form, 0x1e, 32) && atyp->size == 1))) { if (!__IN(f, 0x0c, 32) || !((__IN(atyp->form, 0x1e, 32) && atyp->size == 1))) {
if (__IN(18, OPM_Options, 32)) { if (__IN(18, OPM_Options, 32)) {
OPB_err(-301); OPB_err(-301);
@ -2426,9 +2433,7 @@ void OPB_Param (OPT_Node ap, OPT_Object fp)
} else { } else {
OPB_CheckLeaf(ap, 0); OPB_CheckLeaf(ap, 0);
} }
if (ap->readonly) { OPB_CheckWrite(ap);
OPB_err(76);
}
if (fp->typ->comp == 3) { if (fp->typ->comp == 3) {
OPB_DynArrParCheck(fp->typ, ap->typ, 1); OPB_DynArrParCheck(fp->typ, ap->typ, 1);
} else if ((fp->typ->comp == 4 && ap->typ->comp == 4)) { } else if ((fp->typ->comp == 4 && ap->typ->comp == 4)) {
@ -2540,9 +2545,7 @@ void OPB_Assign (OPT_Node *x, OPT_Node y)
OPB_err(56); OPB_err(56);
} }
OPB_CheckAssign((*x)->typ, y); OPB_CheckAssign((*x)->typ, y);
if ((*x)->readonly) { OPB_CheckWrite(*x);
OPB_err(76);
}
if ((*x)->typ->comp == 4) { if ((*x)->typ->comp == 4) {
if ((*x)->class == 5) { if ((*x)->class == 5) {
z = (*x)->left; z = (*x)->left;

2
bootstrap/unix-88/OPB.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPB__h #ifndef OPB__h
#define OPB__h #define OPB__h

14
bootstrap/unix-88/OPC.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -141,7 +141,6 @@ static void OPC_Str1 (CHAR *s, ADDRESS s__len, INT32 x)
{ {
CHAR ch; CHAR ch;
INT16 i; INT16 i;
__DUP(s, s__len, CHAR);
ch = s[0]; ch = s[0];
i = 0; i = 0;
while (ch != 0x00) { while (ch != 0x00) {
@ -153,7 +152,6 @@ static void OPC_Str1 (CHAR *s, ADDRESS s__len, INT32 x)
i += 1; i += 1;
ch = s[__X(i, s__len)]; ch = s[__X(i, s__len)];
} }
__DEL(s);
} }
static INT16 OPC_Length (CHAR *s, ADDRESS s__len) static INT16 OPC_Length (CHAR *s, ADDRESS s__len)
@ -727,12 +725,10 @@ static void OPC_DefineType (OPT_Struct str)
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, ADDRESS y__len) static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, ADDRESS y__len)
{ {
INT16 i; INT16 i;
__DUP(y, y__len, CHAR);
i = 0; i = 0;
while ((*x)[__X(i + 1, 256)] == y[__X(i, y__len)]) { while ((*x)[__X(i + 1, 256)] == y[__X(i, y__len)]) {
i += 1; i += 1;
} }
__DEL(y);
return y[__X(i, y__len)] == 0x00; return y[__X(i, y__len)] == 0x00;
} }
@ -1466,7 +1462,7 @@ void OPC_EnterProc (OPT_Object proc)
} }
var = proc->link; var = proc->link;
while (var != NIL) { while (var != NIL) {
if ((var->typ->comp == 2 && var->mode == 1)) { if ((((var->written && var->typ->comp == 2)) && var->mode == 1)) {
OPC_BegStat(); OPC_BegStat();
if (var->typ->strobj == NIL) { if (var->typ->strobj == NIL) {
OPM_Mark(200, var->typ->txtpos); OPM_Mark(200, var->typ->txtpos);
@ -1482,7 +1478,7 @@ void OPC_EnterProc (OPT_Object proc)
} }
var = proc->link; var = proc->link;
while (var != NIL) { while (var != NIL) {
if ((((__IN(var->typ->comp, 0x0c, 32) && var->mode == 1)) && var->typ->sysflag == 0)) { if ((((((var->written && __IN(var->typ->comp, 0x0c, 32))) && var->mode == 1)) && var->typ->sysflag == 0)) {
OPC_BegStat(); OPC_BegStat();
if (var->typ->comp == 2) { if (var->typ->comp == 2) {
OPM_WriteString((CHAR*)"__DUPARR(", 10); OPM_WriteString((CHAR*)"__DUPARR(", 10);
@ -1632,7 +1628,7 @@ void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet)
} }
var = proc->link; var = proc->link;
while (var != NIL) { while (var != NIL) {
if ((((var->typ->comp == 3 && var->mode == 1)) && var->typ->sysflag == 0)) { if ((((((var->written && var->typ->comp == 3)) && var->mode == 1)) && var->typ->sysflag == 0)) {
if (indent) { if (indent) {
OPC_BegStat(); OPC_BegStat();
} else { } else {
@ -1752,7 +1748,6 @@ static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l)
{ {
INT32 i; INT32 i;
INT16 c; INT16 c;
__DUP(s, s__len, CHAR);
OPM_Write('"'); OPM_Write('"');
i = 0; i = 0;
while (i < l) { while (i < l) {
@ -1773,7 +1768,6 @@ static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l)
i += 1; i += 1;
} }
OPM_Write('"'); OPM_Write('"');
__DEL(s);
} }
void OPC_Case (INT64 caseVal, INT16 form) void OPC_Case (INT64 caseVal, INT16 form)

2
bootstrap/unix-88/OPC.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPC__h #ifndef OPC__h
#define OPC__h #define OPC__h

25
bootstrap/unix-88/OPM.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -27,7 +27,7 @@ export INT16 OPM_AddressSize;
static INT16 OPM_GlobalAlignment; static INT16 OPM_GlobalAlignment;
export INT16 OPM_Alignment; export INT16 OPM_Alignment;
export UINT32 OPM_GlobalOptions, OPM_Options; export UINT32 OPM_GlobalOptions, OPM_Options;
export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize; export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize, OPM_SetSize;
export INT64 OPM_MaxIndex; export INT64 OPM_MaxIndex;
export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
export BOOLEAN OPM_noerr; export BOOLEAN OPM_noerr;
@ -112,9 +112,7 @@ void OPM_LogW (CHAR ch)
void OPM_LogWStr (CHAR *s, ADDRESS s__len) void OPM_LogWStr (CHAR *s, ADDRESS s__len)
{ {
__DUP(s, s__len, CHAR);
Out_String(s, s__len); Out_String(s, s__len);
__DEL(s);
} }
void OPM_LogWNum (INT64 i, INT64 len) void OPM_LogWNum (INT64 i, INT64 len)
@ -129,16 +127,13 @@ void OPM_LogWLn (void)
void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len) void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len)
{ {
__DUP(vt100code, vt100code__len, CHAR);
if ((Out_IsConsole && !__IN(16, OPM_Options, 32))) { if ((Out_IsConsole && !__IN(16, OPM_Options, 32))) {
VT100_SetAttr(vt100code, vt100code__len); VT100_SetAttr(vt100code, vt100code__len);
} }
__DEL(vt100code);
} }
void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len) void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len)
{ {
__DUP(modname, modname__len, CHAR);
OPM_LogWStr((CHAR*)"Compiling ", 11); OPM_LogWStr((CHAR*)"Compiling ", 11);
OPM_LogWStr(modname, modname__len); OPM_LogWStr(modname, modname__len);
if (__IN(18, OPM_Options, 32)) { if (__IN(18, OPM_Options, 32)) {
@ -154,7 +149,6 @@ void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len)
OPM_LogWNum(__ASHL(OPM_Alignment, 3), 1); OPM_LogWNum(__ASHL(OPM_Alignment, 3), 1);
} }
OPM_LogW('.'); OPM_LogW('.');
__DEL(modname);
} }
INT64 OPM_SignedMaximum (INT32 bytecount) INT64 OPM_SignedMaximum (INT32 bytecount)
@ -183,7 +177,6 @@ INT16 OPM_Integer (INT64 n)
static void OPM_ScanOptions (CHAR *s, ADDRESS s__len) static void OPM_ScanOptions (CHAR *s, ADDRESS s__len)
{ {
INT16 i; INT16 i;
__DUP(s, s__len, CHAR);
i = 1; i = 1;
while (s[__X(i, s__len)] != 0x00) { while (s[__X(i, s__len)] != 0x00) {
switch (s[__X(i, s__len)]) { switch (s[__X(i, s__len)]) {
@ -263,7 +256,6 @@ static void OPM_ScanOptions (CHAR *s, ADDRESS s__len)
} }
i += 1; i += 1;
} }
__DEL(s);
} }
BOOLEAN OPM_OpenPar (void) BOOLEAN OPM_OpenPar (void)
@ -338,7 +330,7 @@ BOOLEAN OPM_OpenPar (void)
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" -O2 Original Oberon / Oberon-2: 8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET.", 95); OPM_LogWStr((CHAR*)" -O2 Original Oberon / Oberon-2: 8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET.", 95);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95); OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER and SET, 64 bit LONGINT.", 95);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95); OPM_LogWStr((CHAR*)" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95);
OPM_LogWLn(); OPM_LogWLn();
@ -410,21 +402,25 @@ void OPM_InitOptions (void)
OPM_ShortintSize = 1; OPM_ShortintSize = 1;
OPM_IntegerSize = 2; OPM_IntegerSize = 2;
OPM_LongintSize = 4; OPM_LongintSize = 4;
OPM_SetSize = 4;
break; break;
case 'C': case 'C':
OPM_ShortintSize = 2; OPM_ShortintSize = 2;
OPM_IntegerSize = 4; OPM_IntegerSize = 4;
OPM_LongintSize = 8; OPM_LongintSize = 8;
OPM_SetSize = 4;
break; break;
case 'V': case 'V':
OPM_ShortintSize = 1; OPM_ShortintSize = 1;
OPM_IntegerSize = 4; OPM_IntegerSize = 4;
OPM_LongintSize = 8; OPM_LongintSize = 8;
OPM_SetSize = 8;
break; break;
default: default:
OPM_ShortintSize = 1; OPM_ShortintSize = 1;
OPM_IntegerSize = 2; OPM_IntegerSize = 2;
OPM_LongintSize = 4; OPM_LongintSize = 4;
OPM_SetSize = 4;
break; break;
} }
__MOVE(OPM_InstallDir, OPM_ResourceDir, 1024); __MOVE(OPM_InstallDir, OPM_ResourceDir, 1024);
@ -492,7 +488,6 @@ static void OPM_MakeFileName (CHAR *name, ADDRESS name__len, CHAR *FName, ADDRES
{ {
INT16 i, j; INT16 i, j;
CHAR ch; CHAR ch;
__DUP(ext, ext__len, CHAR);
i = 0; i = 0;
for (;;) { for (;;) {
ch = name[__X(i, name__len)]; ch = name[__X(i, name__len)];
@ -509,7 +504,6 @@ static void OPM_MakeFileName (CHAR *name, ADDRESS name__len, CHAR *FName, ADDRES
i += 1; i += 1;
j += 1; j += 1;
} while (!(ch == 0x00)); } while (!(ch == 0x00));
__DEL(ext);
} }
static void OPM_LogErrMsg (INT16 n) static void OPM_LogErrMsg (INT16 n)
@ -1050,28 +1044,23 @@ static BOOLEAN OPM_IsProbablyInstallDir (CHAR *s, ADDRESS s__len)
{ {
CHAR testpath[4096]; CHAR testpath[4096];
Platform_FileIdentity identity; Platform_FileIdentity identity;
__DUP(s, s__len, CHAR);
__COPY(OPM_InstallDir, testpath, 4096); __COPY(OPM_InstallDir, testpath, 4096);
Strings_Append((CHAR*)"/lib/lib", 9, (void*)testpath, 4096); Strings_Append((CHAR*)"/lib/lib", 9, (void*)testpath, 4096);
Strings_Append((CHAR*)"voc", 4, (void*)testpath, 4096); Strings_Append((CHAR*)"voc", 4, (void*)testpath, 4096);
Strings_Append((CHAR*)"-O2.a", 6, (void*)testpath, 4096); Strings_Append((CHAR*)"-O2.a", 6, (void*)testpath, 4096);
if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) { if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
__DEL(s);
return 0; return 0;
} }
__COPY(OPM_InstallDir, testpath, 4096); __COPY(OPM_InstallDir, testpath, 4096);
Strings_Append((CHAR*)"/2/include/Oberon.h", 20, (void*)testpath, 4096); Strings_Append((CHAR*)"/2/include/Oberon.h", 20, (void*)testpath, 4096);
if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) { if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
__DEL(s);
return 0; return 0;
} }
__COPY(OPM_InstallDir, testpath, 4096); __COPY(OPM_InstallDir, testpath, 4096);
Strings_Append((CHAR*)"/2/sym/Files.sym", 17, (void*)testpath, 4096); Strings_Append((CHAR*)"/2/sym/Files.sym", 17, (void*)testpath, 4096);
if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) { if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
__DEL(s);
return 0; return 0;
} }
__DEL(s);
return 1; return 1;
} }

4
bootstrap/unix-88/OPM.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPM__h #ifndef OPM__h
#define OPM__h #define OPM__h
@ -9,7 +9,7 @@
import CHAR OPM_Model[10]; import CHAR OPM_Model[10];
import INT16 OPM_AddressSize, OPM_Alignment; import INT16 OPM_AddressSize, OPM_Alignment;
import UINT32 OPM_GlobalOptions, OPM_Options; import UINT32 OPM_GlobalOptions, OPM_Options;
import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize; import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize, OPM_SetSize;
import INT64 OPM_MaxIndex; import INT64 OPM_MaxIndex;
import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
import BOOLEAN OPM_noerr; import BOOLEAN OPM_noerr;

2
bootstrap/unix-88/OPP.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16

2
bootstrap/unix-88/OPP.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPP__h #ifndef OPP__h
#define OPP__h #define OPP__h

2
bootstrap/unix-88/OPS.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16

2
bootstrap/unix-88/OPS.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPS__h #ifndef OPS__h
#define OPS__h #define OPS__h

4
bootstrap/unix-88/OPT.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -77,7 +77,7 @@ typedef
OPS_Name name; OPS_Name name;
BOOLEAN leaf; BOOLEAN leaf;
INT8 mode, mnolev, vis, history; INT8 mode, mnolev, vis, history;
BOOLEAN used, fpdone; BOOLEAN used, fpdone, written;
INT32 fprint; INT32 fprint;
OPT_Struct typ; OPT_Struct typ;
OPT_Const conval; OPT_Const conval;

4
bootstrap/unix-88/OPT.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPT__h #ifndef OPT__h
#define OPT__h #define OPT__h
@ -55,7 +55,7 @@ typedef
OPS_Name name; OPS_Name name;
BOOLEAN leaf; BOOLEAN leaf;
INT8 mode, mnolev, vis, history; INT8 mode, mnolev, vis, history;
BOOLEAN used, fpdone; BOOLEAN used, fpdone, written;
INT32 fprint; INT32 fprint;
OPT_Struct typ; OPT_Struct typ;
OPT_Const conval; OPT_Const conval;

2
bootstrap/unix-88/OPV.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16

2
bootstrap/unix-88/OPV.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPV__h #ifndef OPV__h
#define OPV__h #define OPV__h

2
bootstrap/unix-88/Out.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16

2
bootstrap/unix-88/Out.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Out__h #ifndef Out__h
#define Out__h #define Out__h

11
bootstrap/unix-88/Platform.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2019/11/11]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ /* voc 2.1.0 [2019/11/22]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -209,22 +209,18 @@ typedef
BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len) BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len)
{ {
EnvPtr__83 p = NIL; EnvPtr__83 p = NIL;
__DUP(var, var__len, CHAR);
p = (EnvPtr__83)(ADDRESS)Platform_getenv(var, var__len); p = (EnvPtr__83)(ADDRESS)Platform_getenv(var, var__len);
if (p != NIL) { if (p != NIL) {
__COPY(*p, val, val__len); __COPY(*p, val, val__len);
} }
__DEL(var);
return p != NIL; return p != NIL;
} }
void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len) void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len)
{ {
__DUP(var, var__len, CHAR);
if (!Platform_getEnv(var, var__len, (void*)val, val__len)) { if (!Platform_getEnv(var, var__len, (void*)val, val__len)) {
val[0] = 0x00; val[0] = 0x00;
} }
__DEL(var);
} }
void Platform_SetInterruptHandler (Platform_SignalHandler handler) void Platform_SetInterruptHandler (Platform_SignalHandler handler)
@ -280,8 +276,6 @@ void Platform_Delay (INT32 ms)
INT16 Platform_System (CHAR *cmd, ADDRESS cmd__len) INT16 Platform_System (CHAR *cmd, ADDRESS cmd__len)
{ {
__DUP(cmd, cmd__len, CHAR);
__DEL(cmd);
return Platform_system(cmd, cmd__len); return Platform_system(cmd, cmd__len);
} }
@ -358,16 +352,13 @@ INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *iden
INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ) INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ)
{ {
__DUP(n, n__len, CHAR);
Platform_structstats(); Platform_structstats();
if (Platform_stat(n, n__len) < 0) { if (Platform_stat(n, n__len) < 0) {
__DEL(n);
return Platform_err(); return Platform_err();
} }
(*identity).volume = Platform_statdev(); (*identity).volume = Platform_statdev();
(*identity).index = Platform_statino(); (*identity).index = Platform_statino();
(*identity).mtime = Platform_statmtime(); (*identity).mtime = Platform_statmtime();
__DEL(n);
return 0; return 0;
} }

Some files were not shown because too many files have changed in this diff Show more