d0p1/ack
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

Warning-fixed and ansified the Modula-2 library.

Browse source
This commit is contained in:
David Given 2018-06-25 22:22:37 +02:00
parent f8ba7ef962
commit 7971bdba5a
27 changed files with 463 additions and 386 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
.clang-format
View file

@ -1,12 +1,17 @@
--- ---
BasedOnStyle: WebKit AlignAfterOpenBracket: AlwaysBreak
AllowShortLoopsOnASingleLine: 'false' AllowShortFunctionsOnASingleLine: false
AllowShortLoopsOnASingleLine: false
AlwaysBreakAfterDefinitionReturnType: false AlwaysBreakAfterDefinitionReturnType: false
BasedOnStyle: WebKit
BinPackArguments: true
BinPackParameters: false
BreakBeforeBraces: Allman BreakBeforeBraces: Allman
ColumnLimit: 100
IndentCaseLabels: 'true' IndentCaseLabels: 'true'
PointerAlignment: Left PointerAlignment: Left
SortIncludes: false
TabWidth: '4' TabWidth: '4'
UseTab: ForIndentation UseTab: ForIndentation
SortIncludes: false
... ...

103
lang/m2/include/libm2.h Normal file
View file

@ -0,0 +1,103 @@
#ifndef LIBM2_H
#define LIBM2_H
#include <stdint.h>
struct array_descr
{
int lbound;
int n_elts_min_one;
unsigned size;
};
struct int_range_descr
{
int low, high;
};
struct uint_range_descr
{
unsigned int low, high;
};
struct long_range_descr
{
long low, high;
};
struct ulong_range_descr
{
unsigned long low, high;
};
struct stack_descr
{
char* addr;
int low;
unsigned int highminlow;
unsigned int size;
};
struct proc
{
unsigned size; /* size of saved stackframe(s) */
int (*proc)(void); /* address of coroutine procedure */
char* brk; /* stack break of this coroutine */
};
extern void (*handler)(int);
extern char** argv;
extern int argc;
extern char* MainLB;
extern double absd(double i);
extern int CallAtEnd(void (*p)(void));
extern int absi(int i);
extern int dvi(int j, int i);
extern int rmi(int j, int i);
extern int sigtrp(int trapno, int signo);
extern int stackprio(unsigned n);
extern int topsave(void* brkpos, struct proc* proc);
extern long absl(long i);
extern long dvil(long j, long i);
extern long rmil(long j, long i);
extern size_t new_stackptr(struct stack_descr* pdscr, int a);
extern unsigned int topsize(void* brkpos);
extern void SIG(void (*)(int));
extern void StringAssign(int dstsiz, int srcsiz, register char* dstaddr, register char* srcaddr);
extern void TRP(int trapno);
extern void _Arguments_(void);
extern void _SYSTEM__NEWPROCESS(int (*p)(void), struct proc* a, unsigned n, struct proc** p1);
extern void _SYSTEM__TRANSFER(struct proc** a, struct proc** b);
extern void _cleanup(void);
extern void adduchk(unsigned a, unsigned b);
extern void blockmove(size_t siz, char* dst, char* src);
extern void cap(unsigned u);
extern void catch (int trapno);
extern void copy_array(char* pp, int a);
extern void halt(void);
extern void init(void);
extern void killbss(void);
extern void load(size_t siz, register char* addr, int p);
extern void muluchk(unsigned a, unsigned b);
extern void rcka(struct array_descr* descr, int indx);
extern void rcki(struct int_range_descr* descr, int val);
extern void rckil(struct long_range_descr* descr, long val);
extern void rcku(struct uint_range_descr* descr, unsigned val);
extern void rckul(struct ulong_range_descr* descr, unsigned long val);
extern void store(size_t siz, register char* addr, int p);
extern void subuchk(unsigned a, unsigned b);
extern void topload(struct proc* proc);
extern void unstackprio(unsigned n);
/* PROCEDURE Argv(argnum: CARDINAL; VAR argument: ARRAY OF CHAR): CARDINAL; */
extern unsigned _Arguments__Argv(int n, char* argument, int l, unsigned int u, int s);
/* PROCEDURE GetEnv(name: ARRAY OF CHAR; VAR value: ARRAY OF CHAR): CARDINAL; */
extern unsigned _Arguments__GetEnv(
char* name, int nn, unsigned int nu, int ns, char* value, int l, unsigned int u, int s);
/* PROCEDURE Message(str: ARRAY OF CHAR); */
extern void _Traps__Message(char* str, int nn, unsigned int nu, int ns);
#endif

16
lang/m2/include/m2_traps.h
View file

@ -6,11 +6,11 @@
/* Modula-2 runtime errors */ /* Modula-2 runtime errors */
#define M2_TOOLARGE 64 /* stack of process too large */ #define M2_TOOLARGE 64 /* stack of process too large */
#define M2_TOOMANY 65 /* too many nested traps & handlers */ #define M2_TOOMANY 65 /* too many nested traps & handlers */
#define M2_NORESULT 66 /* no RETURN from procedure function */ #define M2_NORESULT 66 /* no RETURN from procedure function */
#define M2_UOVFL 67 /* cardinal overflow */ #define M2_UOVFL 67 /* cardinal overflow */
#define M2_FORCH 68 /* FOR-loop control variable changed */ #define M2_FORCH 68 /* FOR-loop control variable changed */
#define M2_UUVFL 69 /* cardinal underflow */ #define M2_UUVFL 69 /* cardinal underflow */
#define M2_INTERNAL 70 /* internal error, should not happen */ #define M2_INTERNAL 70 /* internal error, should not happen */
#define M2_UNIXSIG 71 /* unix signal */ #define M2_UNIXSIG 71 /* unix signal */

53
lang/m2/libm2/Arguments.c
View file

@ -8,66 +8,65 @@
Author: Ceriel J.H. Jacobs Author: Ceriel J.H. Jacobs
Version: $Id$ Version: $Id$
*/ */
#include "libm2.h"
extern char **argv, **environ; extern char **argv, **environ;
extern int argc; extern int argc;
unsigned int _Arguments__Argc; unsigned int _Arguments__Argc;
static char * static char* findname(char* s1, char* s2)
findname(s1, s2)
register char *s1, *s2;
{ {
while (*s1 == *s2++) s1++; while (*s1 == *s2++)
if (*s1 == '\0' && *(s2-1) == '=') return s2; s1++;
if (*s1 == '\0' && *(s2 - 1) == '=')
return s2;
return 0; return 0;
} }
static unsigned int static unsigned int scopy(char* src, char* dst, unsigned int max)
scopy(src, dst, max)
register char *src, *dst;
unsigned int max;
{ {
register unsigned int i = 0; register unsigned int i = 0;
while (*src && i <= max) { while (*src && i <= max)
{
i++; i++;
*dst++ = *src++; *dst++ = *src++;
} }
if (i <= max) { if (i <= max)
{
*dst = '\0'; *dst = '\0';
return i+1; return i + 1;
} }
while (*src++) i++; while (*src++)
i++;
return i + 1; return i + 1;
} }
_Arguments_() void _Arguments_(void)
{ {
_Arguments__Argc = argc; _Arguments__Argc = argc;
} }
unsigned unsigned int _Arguments__Argv(int n, char* argument, int l, unsigned int u, int s)
_Arguments__Argv(n, argument, l, u, s)
unsigned int u;
char *argument;
{ {
if (n >= argc) return 0; if (n >= argc)
return 0;
return scopy(argv[n], argument, u); return scopy(argv[n], argument, u);
} }
unsigned unsigned int _Arguments__GetEnv(
_Arguments__GetEnv(name, nn, nu, ns, value, l, u, s) char* name, int nn, unsigned int nu, int ns, char* value, int l, unsigned int u, int s)
char *name, *value;
unsigned int nu, u;
{ {
register char **p = environ; register char** p = environ;
register char *v = 0; register char* v = 0;
while (*p && !(v = findname(name, *p++))) { while (*p && !(v = findname(name, *p++)))
{
/* nothing */ /* nothing */
} }
if (!v) return 0; if (!v)
return 0;
return scopy(v, value, u); return scopy(v, value, u);
} }

86
lang/m2/libm2/SYSTEM.c
View file

@ -10,49 +10,45 @@
*/ */
/* /*
An implementation of the Modula-2 NEWPROCESS and TRANSFER facilities An implementation of the Modula-2 NEWPROCESS and TRANSFER facilities
using the topsize, topsave, and topload facilities. using the topsize, topsave, and topload facilities.
For each coroutine, a proc structure is built. For the main routine, For each coroutine, a proc structure is built. For the main routine,
a static space is declared to save its stack. For the other coroutines, a static space is declared to save its stack. For the other coroutines,
the user specifies this space. the user specifies this space.
*/ */
#include <unistd.h>
#include "libm2.h"
#include <m2_traps.h> #include <m2_traps.h>
#define MAXMAIN 2048 #define MAXMAIN 2048
struct proc { static struct proc mainproc[MAXMAIN / sizeof(struct proc) + 1];
unsigned size; /* size of saved stackframe(s) */
int (*proc)(); /* address of coroutine procedure */
char *brk; /* stack break of this coroutine */
};
extern unsigned topsize(); static struct proc* curproc = 0; /* current coroutine */
extern char* MainLB; /* stack break of main routine */
static struct proc mainproc[MAXMAIN/sizeof(struct proc) + 1]; void _SYSTEM__NEWPROCESS(
int (*p)(void) /* coroutine procedure */,
static struct proc *curproc = 0;/* current coroutine */ struct proc* a /* pointer to area for saved stack-frame */,
extern char *MainLB; /* stack break of main routine */ unsigned int n /* size of this area */,
struct proc** p1 /* where to leave coroutine descriptor,
_SYSTEM__NEWPROCESS(p, a, n, p1) in this implementation the address of
int (*p)(); /* coroutine procedure */ the area for saved stack-frame(s) */
struct proc *a; /* pointer to area for saved stack-frame */ )
unsigned n; /* size of this area */
struct proc **p1; /* where to leave coroutine descriptor,
in this implementation the address of
the area for saved stack-frame(s) */
{ {
/* This procedure creates a new coroutine, but does not /* This procedure creates a new coroutine, but does not
transfer control to it. The routine "topsize" will compute the transfer control to it. The routine "topsize" will compute the
stack break, which will be the local base of this routine. stack break, which will be the local base of this routine.
Notice that we can do this because we do not need the stack Notice that we can do this because we do not need the stack
above this point for this coroutine. In Modula-2, coroutines above this point for this coroutine. In Modula-2, coroutines
must be level 0 procedures without parameters. must be level 0 procedures without parameters.
*/ */
char *brk = 0; char* brk = 0;
unsigned sz = topsize(&brk); unsigned sz = topsize(&brk);
if (sz + sizeof(struct proc) > n) { if (sz + sizeof(struct proc) > n)
{
/* not enough space */ /* not enough space */
TRP(M2_TOOLARGE); TRP(M2_TOOLARGE);
} }
@ -60,10 +56,11 @@ _SYSTEM__NEWPROCESS(p, a, n, p1)
a->proc = p; a->proc = p;
a->brk = brk; a->brk = brk;
*p1 = a; *p1 = a;
if (topsave(brk, a+1)) if (topsave(brk, a + 1))
/* stack frame saved; now just return */ /* stack frame saved; now just return */
; ;
else { else
{
/* We get here through the first transfer to the coroutine /* We get here through the first transfer to the coroutine
created above. created above.
This also means that curproc is now set to this coroutine. This also means that curproc is now set to this coroutine.
@ -76,16 +73,16 @@ _SYSTEM__NEWPROCESS(p, a, n, p1)
} }
} }
_SYSTEM__TRANSFER(a, b) void _SYSTEM__TRANSFER(struct proc** a, struct proc** b)
struct proc **a, **b;
{ {
/* transfer from one coroutine to another, saving the current /* transfer from one coroutine to another, saving the current
descriptor in the space indicated by "a", and transfering to descriptor in the space indicated by "a", and transfering to
the coroutine in descriptor "b". the coroutine in descriptor "b".
*/ */
unsigned size; unsigned size;
if (! curproc) { if (!curproc)
{
/* the current coroutine is the main process; /* the current coroutine is the main process;
initialize a coroutine descriptor for it ... initialize a coroutine descriptor for it ...
*/ */
@ -93,21 +90,24 @@ _SYSTEM__TRANSFER(a, b)
mainproc[0].size = sizeof(mainproc); mainproc[0].size = sizeof(mainproc);
curproc = &mainproc[0]; curproc = &mainproc[0];
} }
*a = curproc; /* save current descriptor in "a" */ *a = curproc; /* save current descriptor in "a" */
if (*b == curproc) { if (*b == curproc)
{
/* transfer to itself is a no-op */ /* transfer to itself is a no-op */
return; return;
} }
size = topsize(&(curproc->brk)); size = topsize(&(curproc->brk));
if (size + sizeof(struct proc) > curproc->size) { if (size + sizeof(struct proc) > curproc->size)
{
TRP(M2_TOOLARGE); TRP(M2_TOOLARGE);
} }
if (topsave(curproc->brk, curproc+1)) { if (topsave(curproc->brk, curproc + 1))
{
/* stack top saved. Now restore context of target /* stack top saved. Now restore context of target
coroutine coroutine
*/ */
curproc = *b; curproc = *b;
topload(curproc+1); topload(curproc + 1);
/* we never get here ... */ /* we never get here ... */
} }
/* but we do get here, when a transfer is done to the coroutine in "a". /* but we do get here, when a transfer is done to the coroutine in "a".

13
lang/m2/libm2/StrAss.c
View file

@ -5,19 +5,22 @@
/* /*
Module: assign string to character array, with possible 0-byte Module: assign string to character array, with possible 0-byte
extension extension
Author: Ceriel J.H. Jacobs Author: Ceriel J.H. Jacobs
Version: $Id$ Version: $Id$
*/ */
StringAssign(dstsiz, srcsiz, dstaddr, srcaddr) #include "libm2.h"
register char *dstaddr, *srcaddr;
void StringAssign(int dstsiz, int srcsiz, char* dstaddr, char* srcaddr)
{ {
while (srcsiz > 0) { while (srcsiz > 0)
{
*dstaddr++ = *srcaddr++; *dstaddr++ = *srcaddr++;
srcsiz--; srcsiz--;
dstsiz--; dstsiz--;
} }
if (dstsiz > 0) { if (dstsiz > 0)
{
*dstaddr = 0; *dstaddr = 0;
} }
} }

8
lang/m2/libm2/Terminal.mod
View file

@ -15,14 +15,14 @@ IMPLEMENTATION MODULE Terminal;
*) *)
FROM SYSTEM IMPORT ADR; FROM SYSTEM IMPORT ADR;
#ifdef __USG #ifdef __USG
FROM Unix IMPORT read, write, open, fcntl; FROM Unix IMPORT read, write, fcntl;
#else #else
FROM Unix IMPORT read, write, open, ioctl; FROM Unix IMPORT read, write, ioctl;
#endif #endif
VAR fildes, fdout: INTEGER; VAR fildes, fdout: INTEGER;
unreadch: CHAR; unreadch: CHAR;
unread: BOOLEAN; unread: BOOLEAN;
tty: ARRAY[0..8] OF CHAR; (* tty: ARRAY[0..8] OF CHAR; *)
PROCEDURE Read(VAR ch: CHAR); PROCEDURE Read(VAR ch: CHAR);
BEGIN BEGIN
@ -115,7 +115,7 @@ BEGIN
*) *)
(* dtrg: changed so that instead of opening /dev/tty, fd 0 is always used. *) (* dtrg: changed so that instead of opening /dev/tty, fd 0 is always used. *)
(* kernigh: sent output to fd 1 *) (* kernigh: sent output to fd 1 *)
tty := "stdio"; (* tty := "stdio"; *)
fildes := 0; fildes := 0;
fdout := 1; fdout := 1;
unread := FALSE; unread := FALSE;

6
lang/m2/libm2/absd.c
View file

@ -8,10 +8,10 @@
Author: Ceriel J.H. Jacobs Author: Ceriel J.H. Jacobs
Version: $Id$ Version: $Id$
*/ */
#include "libm2.h"
#ifndef NOFLOAT #ifndef NOFLOAT
double double absd(double i)
absd(i)
double i;
{ {
return i >= 0 ? i : -i; return i >= 0 ? i : -i;
} }

3
lang/m2/libm2/absi.c
View file

@ -8,8 +8,9 @@
Author: Ceriel J.H. Jacobs Author: Ceriel J.H. Jacobs
Version: $Id$ Version: $Id$
*/ */
#include "libm2.h"
absi(i) int absi(int i)
{ {
return i >= 0 ? i : -i; return i >= 0 ? i : -i;
} }

6
lang/m2/libm2/absl.c
View file

@ -8,9 +8,9 @@
Author: Ceriel J.H. Jacobs Author: Ceriel J.H. Jacobs
Version: $Id$ Version: $Id$
*/ */
long #include "libm2.h"
absl(i)
long i; long absl(long i)
{ {
return i >= 0 ? i : -i; return i >= 0 ? i : -i;
} }

15
lang/m2/libm2/blockmove.c
View file

@ -8,16 +8,11 @@
Author: Ceriel J.H. Jacobs Author: Ceriel J.H. Jacobs
Version: $Id$ Version: $Id$
*/ */
#include <stdint.h>
#include "libm2.h"
#if _EM_WSIZE==_EM_PSIZE void blockmove(size_t siz, char* dst, char* src)
typedef unsigned pcnt;
#else
typedef unsigned long pcnt;
#endif
blockmove(siz, dst, src)
pcnt siz;
register char *dst, *src;
{ {
while (siz--) *dst++ = *src++; while (siz--)
*dst++ = *src++;
} }

9
lang/m2/libm2/cap.c
View file

@ -8,11 +8,12 @@
Author: Ceriel J.H. Jacobs Author: Ceriel J.H. Jacobs
Version: $Id$ Version: $Id$
*/ */
#include "libm2.h"
cap(u) void cap(unsigned int u)
unsigned u;
{ {
register unsigned *p = &u; register unsigned* p = &u;
if (*p >= 'a' && *p <= 'z') *p += 'A'-'a'; if (*p >= 'a' && *p <= 'z')
*p += 'A' - 'a';
} }

119
lang/m2/libm2/catch.c
View file

@ -11,89 +11,96 @@
#include <em_abs.h> #include <em_abs.h>
#include <m2_traps.h> #include <m2_traps.h>
#include <signal.h> #include <signal.h>
#include "libm2.h"
static struct errm { static struct errm
int errno;
char *errmes;
} errors[] = {
{ EARRAY, "array bound error"},
{ ERANGE, "range bound error"},
{ ESET, "set bound error"},
{ EIOVFL, "integer overflow"},
{ EFOVFL, "real overflow"},
{ EFUNFL, "real underflow"},
{ EIDIVZ, "divide by 0"},
{ EFDIVZ, "divide by 0.0"},
{ EIUND, "undefined integer"},
{ EFUND, "undefined real"},
{ ECONV, "conversion error"},
{ ESTACK, "stack overflow"},
{ EHEAP, "heap overflow"},
{ EILLINS, "illegal instruction"},
{ EODDZ, "illegal size argument"},
{ ECASE, "case error"},
{ EMEMFLT, "addressing non existent memory"},
{ EBADPTR, "bad pointer used"},
{ EBADPC, "program counter out of range"},
{ EBADLAE, "bad argument of lae"},
{ EBADMON, "bad monitor call"},
{ EBADLIN, "argument if LIN too high"},
{ EBADGTO, "GTO descriptor error"},
{ M2_TOOLARGE, "stack size of process too large"},
{ M2_TOOMANY, "too many nested traps + handlers"},
{ M2_NORESULT, "no RETURN from function procedure"},
{ M2_UOVFL, "cardinal overflow"},
{ M2_FORCH, "(warning) FOR-loop control variable was changed in the body"},
{ M2_UUVFL, "cardinal underflow"},
{ M2_INTERNAL, "internal error; ask an expert for help"},
{ M2_UNIXSIG, "got a unix signal"},
{ -1, 0}
};
catch(trapno)
int trapno;
{ {
register struct errm *ep = &errors[0]; int errno;
char *errmessage; char* errmes;
} errors[] = { { EARRAY, "array bound error" },
{ ERANGE, "range bound error" },
{ ESET, "set bound error" },
{ EIOVFL, "integer overflow" },
{ EFOVFL, "real overflow" },
{ EFUNFL, "real underflow" },
{ EIDIVZ, "divide by 0" },
{ EFDIVZ, "divide by 0.0" },
{ EIUND, "undefined integer" },
{ EFUND, "undefined real" },
{ ECONV, "conversion error" },
{ ESTACK, "stack overflow" },
{ EHEAP, "heap overflow" },
{ EILLINS, "illegal instruction" },
{ EODDZ, "illegal size argument" },
{ ECASE, "case error" },
{ EMEMFLT, "addressing non existent memory" },
{ EBADPTR, "bad pointer used" },
{ EBADPC, "program counter out of range" },
{ EBADLAE, "bad argument of lae" },
{ EBADMON, "bad monitor call" },
{ EBADLIN, "argument if LIN too high" },
{ EBADGTO, "GTO descriptor error" },
{ M2_TOOLARGE, "stack size of process too large" },
{ M2_TOOMANY, "too many nested traps + handlers" },
{ M2_NORESULT, "no RETURN from function procedure" },
{ M2_UOVFL, "cardinal overflow" },
{ M2_FORCH, "(warning) FOR-loop control variable was changed in the body" },
{ M2_UUVFL, "cardinal underflow" },
{ M2_INTERNAL, "internal error; ask an expert for help" },
{ M2_UNIXSIG, "got a unix signal" },
{ -1, 0 } };
void catch (int trapno)
{
register struct errm* ep = &errors[0];
char* errmessage;
char buf[20]; char buf[20];
register char *p, *s; register char *p, *s;
while (ep->errno != trapno && ep->errmes != 0) ep++; while (ep->errno != trapno && ep->errmes != 0)
if (p = ep->errmes) { ep++;
while (*p) p++; if (p = ep->errmes)
_Traps__Message(ep->errmes, 0, (int) (p - ep->errmes), 1); {
while (*p)
p++;
_Traps__Message(ep->errmes, 0, (int)(p - ep->errmes), 1);
} }
else { else
{
int i = trapno; int i = trapno;
static char q[] = "error number xxxxxxxxxxxxx"; static char q[] = "error number xxxxxxxxxxxxx";
p = &q[13]; p = &q[13];
s = buf; s = buf;
if (i < 0) { if (i < 0)
{
i = -i; i = -i;
*p++ = '-'; *p++ = '-';
} }
do do
*s++ = i % 10 + '0'; *s++ = i % 10 + '0';
while (i /= 10); while (i /= 10);
while (s > buf) *p++ = *--s; while (s > buf)
*p++ = *--s;
*p = 0; *p = 0;
_Traps__Message(q, 0, (int) (p - q), 1); _Traps__Message(q, 0, (int)(p - q), 1);
} }
#if !defined(__em24) && !defined(__em44) && !defined(__em22) #if !defined(__em24) && !defined(__em44) && !defined(__em22)
if (trapno == M2_UNIXSIG) { if (trapno == M2_UNIXSIG)
{
extern int __signo; extern int __signo;
signal(__signo, SIG_DFL); signal(__signo, SIG_DFL);
_cleanup(); _cleanup();
kill(getpid(), __signo); kill(getpid(), __signo);
_exit(trapno+1); _exit(trapno + 1);
} }
#endif #endif
if (trapno != M2_FORCH) { if (trapno != M2_FORCH)
{
_cleanup(); _cleanup();
_exit(trapno+1); _exit(trapno + 1);
} }
SIG(catch); SIG(catch);
} }

58
lang/m2/libm2/confarray.c
View file

@ -8,6 +8,7 @@
Author: Ceriel J.H. Jacobs Author: Ceriel J.H. Jacobs
Version: $Id$ Version: $Id$
*/ */
#include "libm2.h"
#include <m2_traps.h> #include <m2_traps.h>
#ifndef EM_WSIZE #ifndef EM_WSIZE
@ -15,58 +16,43 @@
#define EM_PSIZE _EM_PSIZE #define EM_PSIZE _EM_PSIZE
#endif #endif
#if EM_WSIZE==EM_PSIZE static struct stack_descr* descrs[10];
typedef unsigned pcnt; static struct stack_descr** ppdescr = descrs;
#else
typedef unsigned long pcnt;
#endif
struct descr { size_t new_stackptr(struct stack_descr* pdescr, int a)
char *addr;
int low;
unsigned int highminlow;
unsigned int size;
};
static struct descr *descrs[10];
static struct descr **ppdescr = descrs;
pcnt
new_stackptr(pdscr, a)
struct descr *pdscr;
{ {
register struct descr *pdescr = pdscr; size_t size = (((pdescr->highminlow + 1) * pdescr->size + (EM_WSIZE - 1)) & ~(EM_WSIZE - 1));
pcnt size = (((pdescr->highminlow + 1) * pdescr->size +
(EM_WSIZE - 1)) & ~(EM_WSIZE - 1));
if (ppdescr >= &descrs[10]) { if (ppdescr >= &descrs[10])
{
/* to many nested traps + handlers ! */ /* to many nested traps + handlers ! */
TRP(M2_TOOMANY); TRP(M2_TOOMANY);
} }
*ppdescr++ = pdescr; *ppdescr++ = pdescr;
if ((char *) &a - (char *) &pdscr > 0) { if ((char*)&a - (char*)&pdescr > 0)
{
/* stack grows downwards */ /* stack grows downwards */
return - size; return -size;
} }
return size; return size;
} }
copy_array(pp, a) void copy_array(char* p, int a)
char *pp;
{ {
register char *p = pp; char* q;
register char *q; size_t sz;
register pcnt sz;
char dummy; char dummy;
ppdescr--; ppdescr--;
sz = ((*ppdescr)->highminlow + 1) * (*ppdescr)->size; sz = ((*ppdescr)->highminlow + 1) * (*ppdescr)->size;
if ((char *) &a - (char *) &pp > 0) {
(*ppdescr)->addr = q = (char *) &a;
}
else (*ppdescr)->addr = q = (char *) &a -
((sz + (EM_WSIZE - 1)) & ~ (EM_WSIZE - 1));
while (sz--) *q++ = *p++; if ((char*)&a - (char*)&p > 0)
{
(*ppdescr)->addr = q = (char*)&a;
}
else
(*ppdescr)->addr = q = (char*)&a - ((sz + (EM_WSIZE - 1)) & ~(EM_WSIZE - 1));
while (sz--)
*q++ = *p++;
} }

65
lang/m2/libm2/dvi.c
View file

@ -8,45 +8,52 @@
Author: Ceriel J.H. Jacobs Author: Ceriel J.H. Jacobs
Version: $Id$ Version: $Id$
Reason: We cannot use DVI and RMI, because DVI rounds towards 0 Reason: We cannot use DVI and RMI, because DVI rounds towards 0
and Modula-2 requires truncation and Modula-2 requires truncation
*/ */
#include "libm2.h"
#include <em_abs.h> #include <em_abs.h>
int int dvi(int j, int i)
dvi(j,i)
int j,i;
{ {
if (j == 0) TRP(EIDIVZ); if (j == 0)
if ((i < 0) != (j < 0)) { TRP(EIDIVZ);
if (i < 0) i = -i; if ((i < 0) != (j < 0))
else j = -j; {
return -((i+j-1)/j); if (i < 0)
i = -i;
else
j = -j;
return -((i + j - 1) / j);
} }
else return i/j; else
return i / j;
} }
long long dvil(long j, long i)
dvil(j,i)
long j,i;
{ {
if (j == 0) TRP(EIDIVZ); if (j == 0)
if ((i < 0) != (j < 0)) { TRP(EIDIVZ);
if (i < 0) i = -i; if ((i < 0) != (j < 0))
else j = -j; {
return -((i+j-1)/j); if (i < 0)
i = -i;
else
j = -j;
return -((i + j - 1) / j);
} }
else return i/j; else
return i / j;
} }
int int rmi(int j, int i)
rmi(j,i)
int j,i;
{ {
int m; int m;
if (j == 0) TRP(EIDIVZ); if (j == 0)
if (i == 0) return 0; TRP(EIDIVZ);
if (i == 0)
return 0;
m = i % j; m = i % j;
if (m != 0 && (i < 0) != (j < 0)) if (m != 0 && (i < 0) != (j < 0))
@ -54,14 +61,14 @@ rmi(j,i)
return m; return m;
} }
long long rmil(long j, long i)
rmil(j,i)
long j,i;
{ {
long m; long m;
if (j == 0) TRP(EIDIVZ); if (j == 0)
if (i == 0) return 0L; TRP(EIDIVZ);
if (i == 0)
return 0L;
m = i % j; m = i % j;
if (m != 0 && (i < 0) != (j < 0)) if (m != 0 && (i < 0) != (j < 0))

15
lang/m2/libm2/halt.c
View file

@ -8,29 +8,32 @@
Author: Ceriel J.H. Jacobs Author: Ceriel J.H. Jacobs
Version: $Id$ Version: $Id$
*/ */
#include <unistd.h>
#include "libm2.h"
#define MAXPROCS 32 #define MAXPROCS 32
static int callindex = 0; static int callindex = 0;
static int (*proclist[MAXPROCS])(); static void (*proclist[MAXPROCS])(void);
_cleanup() void _cleanup(void)
{ {
while (--callindex >= 0) while (--callindex >= 0)
(*proclist[callindex])(); (*proclist[callindex])();
callindex = 0; callindex = 0;
} }
CallAtEnd(p) int CallAtEnd(void (*p)(void))
int (*p)();
{ {
if (callindex >= MAXPROCS) { if (callindex >= MAXPROCS)
{
return 0; return 0;
} }
proclist[callindex++] = p; proclist[callindex++] = p;
return 1; return 1;
} }
halt() void halt(void)
{ {
_cleanup(); _cleanup();
_exit(0); _exit(0);

33
lang/m2/libm2/init.c
View file

@ -12,6 +12,7 @@
#include <signal.h> #include <signal.h>
#include <em_abs.h> #include <em_abs.h>
#include <m2_traps.h> #include <m2_traps.h>
#include "libm2.h"
static const char signals_list[] = { static const char signals_list[] = {
#ifdef SIGHUP #ifdef SIGHUP
@ -57,7 +58,8 @@ static const char signals_list[] = {
void init(void) void init(void)
{ {
const char* p = signals_list; const char* p = signals_list;
do { do
{
int i = *p++; int i = *p++;
if (i == -1) if (i == -1)
break; break;
@ -70,29 +72,28 @@ void init(void)
#endif #endif
} }
#if defined(__em22) || defined(__em24) || defined(__em44) #if defined(__em22) || defined(__em24) || defined(__em44)
killbss() void killbss(void)
{ {
} }
#else #else
static int blablabla; /* We cannot use end, because then also static int blablabla; /* We cannot use end, because then also
bss allocated for the systemcall lib bss allocated for the systemcall lib
would be overwritten. Lets hope that would be overwritten. Lets hope that
this helps ... this helps ...
*/ */
killbss() void killbss(void)
{ {
extern char *bkillbss; extern char* bkillbss;
register char *p = (char *) &bkillbss; register char* p = (char*)&bkillbss;
while (p < (char *) &blablabla) *p++ = 0x66; while (p < (char*)&blablabla)
*p++ = 0x66;
} }
#endif #endif
extern int catch(); void (*handler)(int) = catch;
char** argv = 0;
int (*handler)() = catch;
char **argv = 0;
int argc = 0; int argc = 0;
char *MainLB = 0; char* MainLB = 0;

31
lang/m2/libm2/load.c
View file

@ -9,6 +9,7 @@
Version: $Id$ Version: $Id$
*/ */
#include "libm2.h"
#include <m2_traps.h> #include <m2_traps.h>
#ifndef EM_WSIZE #ifndef EM_WSIZE
@ -16,30 +17,26 @@
#define EM_PSIZE _EM_PSIZE #define EM_PSIZE _EM_PSIZE
#endif #endif
#if EM_WSIZE==EM_PSIZE void load(size_t siz, char* addr, int p)
typedef unsigned pcnt;
#else
typedef long pcnt;
#endif
load(siz, addr, p)
register char *addr;
register pcnt siz;
{ {
/* Make sure, that a value with a size that could have been /* Make sure, that a value with a size that could have been
handled by the LOI instruction ends up at the same place, handled by the LOI instruction ends up at the same place,
where it would, were the LOI instruction used. where it would, were the LOI instruction used.
*/ */
register char *q = (char *) &p; register char* q = (char*)&p;
char t[4]; char t[4];
if (siz < EM_WSIZE && EM_WSIZE % siz == 0) { if (siz < EM_WSIZE && EM_WSIZE % siz == 0)
{
/* as long as EM_WSIZE <= 4 ... */ /* as long as EM_WSIZE <= 4 ... */
if (siz != 2) TRP(M2_INTERNAL); /* internal error */ if (siz != 2)
TRP(M2_INTERNAL); /* internal error */
q = &t[0]; q = &t[0];
} }
while (siz--) *q++ = *addr++; while (siz--)
if (q - t == 2) { *q++ = *addr++;
*((unsigned *)(&p)) = *((unsigned short *) (&t[0])); if (q - t == 2)
{
*((unsigned*)(&p)) = *((unsigned short*)(&t[0]));
} }
} }

15
lang/m2/libm2/rcka.c
View file

@ -8,18 +8,11 @@
* Version: $Id$ * Version: $Id$
*/ */
#include "libm2.h"
#include <em_abs.h> #include <em_abs.h>
extern TRP(); void rcka(struct array_descr* descr, int indx)
struct array_descr {
int lbound;
int n_elts_min_one;
unsigned size;
};
rcka(descr, indx)
struct array_descr *descr;
{ {
if (indx < 0 || indx > descr->n_elts_min_one) TRP(EARRAY); if (indx < 0 || indx > descr->n_elts_min_one)
TRP(EARRAY);
} }

13
lang/m2/libm2/rcki.c
View file

@ -8,16 +8,11 @@
* Version: $Id$ * Version: $Id$
*/ */
#include "libm2.h"
#include <em_abs.h> #include <em_abs.h>
extern TRP(); void rcki(struct int_range_descr* descr, int val)
struct range_descr {
int low, high;
};
rcki(descr, val)
struct range_descr *descr;
{ {
if (val < descr->low || val > descr->high) TRP(ERANGE); if (val < descr->low || val > descr->high)
TRP(ERANGE);
} }

14
lang/m2/libm2/rckil.c
View file

@ -8,17 +8,11 @@
* Version: $Id$ * Version: $Id$
*/ */
#include "libm2.h"
#include <em_abs.h> #include <em_abs.h>
extern TRP(); void rckil(struct long_range_descr* descr, long val)
struct range_descr {
long low, high;
};
rckil(descr, val)
struct range_descr *descr;
long val;
{ {
if (val < descr->low || val > descr->high) TRP(ERANGE); if (val < descr->low || val > descr->high)
TRP(ERANGE);
} }

14
lang/m2/libm2/rcku.c
View file

@ -8,17 +8,11 @@
* Version: $Id$ * Version: $Id$
*/ */
#include "libm2.h"
#include <em_abs.h> #include <em_abs.h>
extern TRP(); void rcku(struct uint_range_descr* descr, unsigned int val)
struct range_descr {
unsigned low, high;
};
rcku(descr, val)
struct range_descr *descr;
unsigned val;
{ {
if (val < descr->low || val > descr->high) TRP(ERANGE); if (val < descr->low || val > descr->high)
TRP(ERANGE);
} }

14
lang/m2/libm2/rckul.c
View file

@ -8,17 +8,11 @@
* Version: $Id$ * Version: $Id$
*/ */
#include "libm2.h"
#include <em_abs.h> #include <em_abs.h>
extern TRP(); void rckul(struct ulong_range_descr* descr, unsigned long val)
struct range_descr {
unsigned long low, high;
};
rckul(descr, val)
struct range_descr *descr;
unsigned long val;
{ {
if (val < descr->low || val > descr->high) TRP(ERANGE); if (val < descr->low || val > descr->high)
TRP(ERANGE);
} }

50
lang/m2/libm2/sigtrp.c
View file

@ -5,53 +5,52 @@
/* /*
Module: Mapping of Unix signals to EM traps Module: Mapping of Unix signals to EM traps
(only when not using the MON instruction) (only when not using the MON instruction)
Author: Ceriel J.H. Jacobs Author: Ceriel J.H. Jacobs
Version: $Id$ Version: $Id$
*/ */
#if !defined(__em22) && !defined(__em24) && !defined(__em44) #if !defined(__em22) && !defined(__em24) && !defined(__em44)
#define EM_trap(n) TRP(n) /* define to whatever is needed to cause the trap */ #define EM_trap(n) TRP(n) /* define to whatever is needed to cause the trap */
#include "libm2.h"
#include <signal.h> #include <signal.h>
#include <errno.h> #include <errno.h>
int __signo; int __signo;
static int __traps[] = { static int __traps[] = {
-2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2,
-2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2,
-2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2,
}; };
static void static void __ctchsig(int signo)
__ctchsig(signo)
{ {
signal(signo,__ctchsig); signal(signo, __ctchsig);
#ifdef __BSD4_2 #ifdef __BSD4_2
sigsetmask(sigblock(0) & ~(1<<(signo - 1))); sigsetmask(sigblock(0) & ~(1 << (signo - 1)));
#endif #endif
__signo = signo; __signo = signo;
EM_trap(__traps[signo]); EM_trap(__traps[signo]);
} }
int int sigtrp(int trapno, int signo)
sigtrp(trapno, signo)
{ {
/* Let Unix signal signo cause EM trap trapno to occur. /* Let Unix signal signo cause EM trap trapno to occur.
If trapno = -2, restore default, If trapno = -2, restore default,
If trapno = -3, ignore. If trapno = -3, ignore.
Return old trapnumber. Return old trapnumber.
Careful, this could be -2 or -3; But return value of -1 Careful, this could be -2 or -3; But return value of -1
indicates failure, with error number in errno. indicates failure, with error number in errno.
*/ */
extern int errno; extern int errno;
void (*ctch)() = __ctchsig; void (*ctch)(int) = __ctchsig;
void (*oldctch)(); void (*oldctch)(int);
int oldtrap; int oldtrap;
if (signo <= 0 || signo >= sizeof(__traps)/sizeof(__traps[0])) { if (signo <= 0 || signo >= sizeof(__traps) / sizeof(__traps[0]))
{
errno = EINVAL; errno = EINVAL;
return -1; return -1;
} }
@ -62,20 +61,23 @@ sigtrp(trapno, signo)
ctch = SIG_DFL; ctch = SIG_DFL;
else if (trapno >= 0 && trapno <= 252) else if (trapno >= 0 && trapno <= 252)
; ;
else { else
{
errno = EINVAL; errno = EINVAL;
return -1; return -1;
} }
oldtrap = __traps[signo]; oldtrap = __traps[signo];
if ((oldctch = signal(signo, ctch)) == (void (*)())-1) /* errno set by signal */ if ((oldctch = signal(signo, ctch)) == (void (*)()) - 1) /* errno set by signal */
return -1; return -1;
else if (oldctch == SIG_IGN) { else if (oldctch == SIG_IGN)
{
signal(signo, SIG_IGN); signal(signo, SIG_IGN);
} }
else __traps[signo] = trapno; else
__traps[signo] = trapno;
return oldtrap; return oldtrap;
} }

10
lang/m2/libm2/stackprio.c
View file

@ -8,20 +8,20 @@
Author: Ceriel J.H. Jacobs Author: Ceriel J.H. Jacobs
Version: $Id$ Version: $Id$
*/ */
#include "libm2.h"
static unsigned prio = 0; static unsigned prio = 0;
stackprio(n) int stackprio(unsigned int n)
unsigned n;
{ {
unsigned old = prio; unsigned old = prio;
if (n > prio) prio = n; if (n > prio)
prio = n;
return old; return old;
} }
unstackprio(n) void unstackprio(unsigned int n)
unsigned n;
{ {
prio = n; prio = n;
} }

28
lang/m2/libm2/store.c
View file

@ -9,6 +9,7 @@
Version: $Id$ Version: $Id$
*/ */
#include "libm2.h"
#include <m2_traps.h> #include <m2_traps.h>
#ifndef EM_WSIZE #ifndef EM_WSIZE
@ -16,28 +17,23 @@
#define EM_PSIZE _EM_PSIZE #define EM_PSIZE _EM_PSIZE
#endif #endif
#if EM_WSIZE==EM_PSIZE void store(size_t siz, char* addr, int p)
typedef unsigned pcnt;
#else
typedef long pcnt;
#endif
store(siz, addr, p)
register char *addr;
register pcnt siz;
{ {
/* Make sure, that a value with a size that could have been /* Make sure, that a value with a size that could have been
handled by the LOI instruction is handled as if it was handled by the LOI instruction is handled as if it was
loaded with the LOI instruction. loaded with the LOI instruction.
*/ */
register char *q = (char *) &p; register char* q = (char*)&p;
char t[4]; char t[4];
if (siz < EM_WSIZE && EM_WSIZE % siz == 0) { if (siz < EM_WSIZE && EM_WSIZE % siz == 0)
{
/* as long as EM_WSIZE <= 4 ... */ /* as long as EM_WSIZE <= 4 ... */
if (siz != 2) TRP(M2_INTERNAL); /* internal error */ if (siz != 2)
*((unsigned short *) (&t[0])) = *((unsigned *) q); TRP(M2_INTERNAL); /* internal error */
*((unsigned short*)(&t[0])) = *((unsigned*)q);
q = &t[0]; q = &t[0];
} }
while (siz--) *addr++ = *q++; while (siz--)
*addr++ = *q++;
} }

41
lang/m2/libm2/ucheck.c
View file

@ -15,51 +15,52 @@
#define EM_LSIZE _EM_LSIZE #define EM_LSIZE _EM_LSIZE
#endif #endif
#include "libm2.h"
#include <m2_traps.h> #include <m2_traps.h>
#define MAXCARD ((unsigned)-1) #define MAXCARD ((unsigned)-1)
#if EM_WSIZE < EM_LSIZE #if EM_WSIZE < EM_LSIZE
#define MAXLONGCARD ((unsigned long) -1L) #define MAXLONGCARD ((unsigned long)-1L)
#endif #endif
adduchk(a,b) void adduchk(unsigned int a, unsigned int b)
unsigned a,b;
{ {
if (MAXCARD - a < b) TRP(M2_UOVFL); if (MAXCARD - a < b)
TRP(M2_UOVFL);
} }
#if EM_WSIZE < EM_LSIZE #if EM_WSIZE < EM_LSIZE
addulchk(a,b) void addulchk(unsigned long a, unsigned long b)
unsigned long a,b;
{ {
if (MAXLONGCARD - a < b) TRP(M2_UOVFL); if (MAXLONGCARD - a < b)
TRP(M2_UOVFL);
} }
#endif #endif
muluchk(a,b) void muluchk(unsigned int a, unsigned int b)
unsigned a,b;
{ {
if (a != 0 && MAXCARD/a < b) TRP(M2_UOVFL); if (a != 0 && MAXCARD / a < b)
TRP(M2_UOVFL);
} }
#if EM_WSIZE < EM_LSIZE #if EM_WSIZE < EM_LSIZE
mululchk(a,b) void mululchk(unsigned long a, unsigned long b)
unsigned long a,b;
{ {
if (a != 0 && MAXLONGCARD/a < b) TRP(M2_UOVFL); if (a != 0 && MAXLONGCARD / a < b)
TRP(M2_UOVFL);
} }
#endif #endif
subuchk(a,b) void subuchk(unsigned int a, unsigned int b)
unsigned a,b;
{ {
if (b < a) TRP(M2_UUVFL); if (b < a)
TRP(M2_UUVFL);
} }
#if EM_WSIZE < EM_LSIZE #if EM_WSIZE < EM_LSIZE
subulchk(a,b) void subulchk(unsigned long a, unsigned long b)
unsigned long a,b;
{ {
if (b < a) TRP(M2_UUVFL); if (b < a)
TRP(M2_UUVFL);
} }
#endif #endif