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

Merge from default.

Browse source
This commit is contained in:
David Given 2019-02-10 12:22:59 +01:00
parent d1e9cd803b 39acc01862
commit 7cdd0cd5c0
306 changed files with 12973 additions and 6157 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
.appveyor.yml Normal file
View file

@ -0,0 +1,17 @@
environment:
matrix:
- CYGWIN: C:\cygwin64
clone_depth: 1
init:
- git config --global core.autocrlf input
install:
- '%CYGWIN%\bin\bash -lc "cygcheck -dc cygwin"'
- '%CYGWIN%\setup-x86_64 -q -P bison,flex,ninja'
build_script:
- 'echo building...'
- '%CYGWIN%\bin\bash -lc "cd $APPVEYOR_BUILD_FOLDER; exec 0</dev/null; make +ack"'

11
.clang-format
View file

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

15
.drone.yml Normal file
View file

@ -0,0 +1,15 @@
clone:
depth: 10
build:
image: teaci/msys32
pull: true
shell: $$arch
commands:
- if [ $$arch = sh ]; then apt update; apt install build-essential bison flex; fi
- make PREFIX=/tmp/acki +ack
matrix:
arch:
- sh
#- msys32

4
Makefile
View file

@ -15,8 +15,8 @@ ACK_TEMP_DIR = /tmp
# install it and just want to run the ACK from the build directory
# (/tmp/ack-build/staging, by default), leave this as $(INSDIR).
#PREFIX = /usr/local
PREFIX = $(INSDIR)
PREFIX = /usr/local
#PREFIX = $(INSDIR)
# Where do you want to put the object files used when building?

3
README
View file

@ -33,6 +33,7 @@ pc86 produces bootable floppy disk images for 8086 PCs
linux386 produces ELF executables for PC Linux systems
linux68k produces ELF executables for m68020 Linux systems
linuxppc produces ELF executables for PowerPC Linux systems
linuxmips produces ELF executables for little-endian MIPS32r2 Linux systems
cpm produces i80 CP/M .COM files
rpi produces Raspberry Pi GPU binaries
pdpv7 produces PDP/11 V7 Unix binaries
@ -194,4 +195,4 @@ Please enjoy.
David Given (davidgiven on Github)
dg@cowlark.com
2016-11-26
2018-09-18

5
build.lua
View file

@ -10,19 +10,20 @@ vars.plats = {
"linux386",
"linux68k",
"linuxppc",
"linuxmips",
"osx386",
"osxppc",
-- --"qemuppc",
"pc86",
"rpi",
"pdpv7",
"em22",
}
vars.plats_with_tests = {
"cpm",
"linux68k",
"linux386",
"linuxppc",
-- --"qemuppc",
"linuxmips",
"pc86",
}

21
h/bc_string.h
View file

@ -1,21 +0,0 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*/
#
/* $Id$ */
/* Strings are allocated in a fixed string descriptor table
** This mechanism is used to avoid string copying as much as possible
*/
typedef struct{
char *strval;
int strcount;
int strlength;
} String;
extern String *_newstr(char* str);
#define MAXSTRING 1024

205
h/con_float
View file

@ -5,7 +5,7 @@
/* $Id$ */
/*
/*
#define CODE_GENERATOR for code generator
#define CODE_EXPANDER for code expander
@ -20,9 +20,9 @@
Unfortunately, the IEEE standard does not define the byte-order.
depends on the #defines
FL_MSL_AT_LOW_ADDRESS 1 if most significant long is at low address
FL_MSW_AT_LOW_ADDRESS 1 if most significant word is at low address
FL_MSB_AT_LOW_ADDRESS 1 if most significant byte is at low address
FL_MSL_AT_LOW_ADDRESS 1 if most significant long is at low address
FL_MSW_AT_LOW_ADDRESS 1 if most significant word is at low address
FL_MSB_AT_LOW_ADDRESS 1 if most significant byte is at low address
*/
#ifdef IEEEFLOAT
#define USE_FLT
@ -37,47 +37,57 @@
#define FL_MSB_AT_LOW_ADDRESS 0
#endif
#define I0 ((FL_MSL_AT_LOW_ADDRESS ? 0 : 4) + (FL_MSW_AT_LOW_ADDRESS ? 0 : 2) \
+ (FL_MSB_AT_LOW_ADDRESS ? 0 : 1))
#define I1 ((FL_MSL_AT_LOW_ADDRESS ? 0 : 4) + (FL_MSW_AT_LOW_ADDRESS ? 0 : 2) \
+ (FL_MSB_AT_LOW_ADDRESS ? 1 : 0))
#define I2 ((FL_MSL_AT_LOW_ADDRESS ? 0 : 4) + (FL_MSW_AT_LOW_ADDRESS ? 2 : 0) \
+ (FL_MSB_AT_LOW_ADDRESS ? 0 : 1))
#define I3 ((FL_MSL_AT_LOW_ADDRESS ? 0 : 4) + (FL_MSW_AT_LOW_ADDRESS ? 2 : 0) \
+ (FL_MSB_AT_LOW_ADDRESS ? 1 : 0))
#define I4 ((FL_MSL_AT_LOW_ADDRESS ? 4 : 0) + (FL_MSW_AT_LOW_ADDRESS ? 0 : 2) \
+ (FL_MSB_AT_LOW_ADDRESS ? 0 : 1))
#define I5 ((FL_MSL_AT_LOW_ADDRESS ? 4 : 0) + (FL_MSW_AT_LOW_ADDRESS ? 0 : 2) \
+ (FL_MSB_AT_LOW_ADDRESS ? 1 : 0))
#define I6 ((FL_MSL_AT_LOW_ADDRESS ? 4 : 0) + (FL_MSW_AT_LOW_ADDRESS ? 2 : 0) \
+ (FL_MSB_AT_LOW_ADDRESS ? 0 : 1))
#define I7 ((FL_MSL_AT_LOW_ADDRESS ? 4 : 0) + (FL_MSW_AT_LOW_ADDRESS ? 2 : 0) \
+ (FL_MSB_AT_LOW_ADDRESS ? 1 : 0))
#define I0 \
((FL_MSL_AT_LOW_ADDRESS ? 0 : 4) + (FL_MSW_AT_LOW_ADDRESS ? 0 : 2) \
+ (FL_MSB_AT_LOW_ADDRESS ? 0 : 1))
#define I1 \
((FL_MSL_AT_LOW_ADDRESS ? 0 : 4) + (FL_MSW_AT_LOW_ADDRESS ? 0 : 2) \
+ (FL_MSB_AT_LOW_ADDRESS ? 1 : 0))
#define I2 \
((FL_MSL_AT_LOW_ADDRESS ? 0 : 4) + (FL_MSW_AT_LOW_ADDRESS ? 2 : 0) \
+ (FL_MSB_AT_LOW_ADDRESS ? 0 : 1))
#define I3 \
((FL_MSL_AT_LOW_ADDRESS ? 0 : 4) + (FL_MSW_AT_LOW_ADDRESS ? 2 : 0) \
+ (FL_MSB_AT_LOW_ADDRESS ? 1 : 0))
#define I4 \
((FL_MSL_AT_LOW_ADDRESS ? 4 : 0) + (FL_MSW_AT_LOW_ADDRESS ? 0 : 2) \
+ (FL_MSB_AT_LOW_ADDRESS ? 0 : 1))
#define I5 \
((FL_MSL_AT_LOW_ADDRESS ? 4 : 0) + (FL_MSW_AT_LOW_ADDRESS ? 0 : 2) \
+ (FL_MSB_AT_LOW_ADDRESS ? 1 : 0))
#define I6 \
((FL_MSL_AT_LOW_ADDRESS ? 4 : 0) + (FL_MSW_AT_LOW_ADDRESS ? 2 : 0) \
+ (FL_MSB_AT_LOW_ADDRESS ? 0 : 1))
#define I7 \
((FL_MSL_AT_LOW_ADDRESS ? 4 : 0) + (FL_MSW_AT_LOW_ADDRESS ? 2 : 0) \
+ (FL_MSB_AT_LOW_ADDRESS ? 1 : 0))
#ifndef USE_FLT
static int
float_cst(str, sz, buf)
char *str, *buf;
int sz;
static int float_cst(str, sz, buf) char *str, *buf;
int sz;
{
int i;
char *p;
char* p;
float fl;
double f;
double atof();
if (sz!= 4 && sz!= 8) {
if (sz != 4 && sz != 8)
{
return 1;
}
f = atof(str);
if (sz == 4) {
if (sz == 4)
{
fl = f;
p = (char *) &fl;
p = (char*)&fl;
}
else {
p = (char *) &f;
else
{
p = (char*)&f;
}
for (i = sz; i; i--) {
for (i = sz; i; i--)
{
*buf++ = *p++;
}
return 0;
@ -87,89 +97,105 @@ float_cst(str, sz, buf)
#include <ctype.h>
#include <flt_arith.h>
int
float_cst(str, sz, buf)
char *str, *buf;
int sz;
int float_cst(str, sz, buf) char *str, *buf;
int sz;
{
int overflow = 0;
flt_arith e;
if (sz!= 4 && sz!= 8) {
if (sz != 4 && sz != 8)
{
return 1;
}
flt_str2flt(str, &e);
#ifdef IEEEFLOAT
if (sz == 4) {
if (sz == 4)
{
#endif
#ifdef PDPFLOAT
e.flt_exp += 129;
#else
e.flt_exp += 127;
e.flt_exp += 127;
#endif
if (e.flt_mantissa.flt_h_32 == 0) e.flt_exp = 0;
if (e.flt_mantissa.flt_h_32 == 0)
e.flt_exp = 0;
#ifdef IEEEFLOAT
if (e.flt_mantissa.flt_h_32 & 0x80) {
if (e.flt_mantissa.flt_h_32 & 0x80)
{
/* rounding */
if ((e.flt_mantissa.flt_h_32 & 0xffffff00) == 0xffffff00) {
if ((e.flt_mantissa.flt_h_32 & 0xffffff00) == 0xffffff00)
{
e.flt_exp++;
e.flt_mantissa.flt_h_32 = 0x80000000;
}
else {
else
{
e.flt_mantissa.flt_h_32 += 0x80;
}
}
if (e.flt_exp >= 255) {
if (e.flt_exp >= 255)
{
overflow = 1;
e.flt_exp = 255;
e.flt_mantissa.flt_h_32 = e.flt_mantissa.flt_l_32 = 0;
}
if (e.flt_exp <= 0) {
if (e.flt_exp <= 0)
{
flt_b64_sft(&(e.flt_mantissa), 1);
if (e.flt_exp < 0) {
if (e.flt_exp < 0)
{
flt_b64_sft(&(e.flt_mantissa), -e.flt_exp);
e.flt_exp = 0;
}
}
#endif
#ifndef IEEEFLOAT
if (sz == 4 && (e.flt_mantissa.flt_h_32 & 0x80)) {
if (sz == 4 && (e.flt_mantissa.flt_h_32 & 0x80))
{
/* rounding */
if ((e.flt_mantissa.flt_h_32 & 0xffffff00) == 0xffffff00) {
if ((e.flt_mantissa.flt_h_32 & 0xffffff00) == 0xffffff00)
{
e.flt_exp++;
e.flt_mantissa.flt_h_32 = 0x80000000;
}
else {
else
{
e.flt_mantissa.flt_h_32 += 0x80;
}
}
if (sz == 8 && (e.flt_mantissa.flt_l_32 & 0x80)) {
if (sz == 8 && (e.flt_mantissa.flt_l_32 & 0x80))
{
/* rounding */
if ((e.flt_mantissa.flt_l_32 & 0xffffff00) == 0xffffff00) {
if ((e.flt_mantissa.flt_l_32 & 0xffffff00) == 0xffffff00)
{
e.flt_mantissa.flt_l_32 = 0;
if (e.flt_mantissa.flt_h_32 == 0xffffffff) {
if (e.flt_mantissa.flt_h_32 == 0xffffffff)
{
e.flt_exp++;
e.flt_mantissa.flt_h_32 = 0x80000000;
}
else e.flt_mantissa.flt_h_32++;
else
e.flt_mantissa.flt_h_32++;
}
else {
else
{
e.flt_mantissa.flt_l_32 += 0x80;
}
}
if (e.flt_exp > 255) {
if (e.flt_exp > 255)
{
overflow = 1;
e.flt_exp = 255;
e.flt_mantissa.flt_h_32 = e.flt_mantissa.flt_l_32 = 0xffffffff;
}
#endif
buf[I0] = (e.flt_sign << 7) | (e.flt_exp >> 1);
buf[I1] = ((e.flt_exp&1) << 7) |
((e.flt_mantissa.flt_h_32 & 0x7fffffff) >> 24);
buf[I1] = ((e.flt_exp & 1) << 7) | ((e.flt_mantissa.flt_h_32 & 0x7fffffff) >> 24);
buf[I2] = e.flt_mantissa.flt_h_32 >> 16;
buf[I3] = e.flt_mantissa.flt_h_32 >> 8;
#ifndef IEEEFLOAT
if (sz == 8) {
if (sz == 8)
{
buf[I4] = e.flt_mantissa.flt_h_32;
buf[I5] = e.flt_mantissa.flt_l_32 >> 24;
buf[I6] = e.flt_mantissa.flt_l_32 >> 16;
@ -181,37 +207,47 @@ float_cst(str, sz, buf)
flt_b64_sft(&(e.flt_mantissa), -24);
#ifdef IEEEFLOAT
}
else {
else
{
e.flt_exp += 1023;
if (e.flt_mantissa.flt_h_32 == 0) e.flt_exp = 0;
if (e.flt_mantissa.flt_l_32 & 0x400) {
if (e.flt_mantissa.flt_h_32 == 0)
e.flt_exp = 0;
if (e.flt_mantissa.flt_l_32 & 0x400)
{
/* rounding */
if ((e.flt_mantissa.flt_l_32 & 0xfffff800) == 0xfffff800) {
if ((e.flt_mantissa.flt_l_32 & 0xfffff800) == 0xfffff800)
{
e.flt_mantissa.flt_l_32 = 0;
if (e.flt_mantissa.flt_h_32 == 0xffffffff) {
if (e.flt_mantissa.flt_h_32 == 0xffffffff)
{
e.flt_exp++;
e.flt_mantissa.flt_h_32 = 0x80000000;
}
else e.flt_mantissa.flt_h_32++;
else
e.flt_mantissa.flt_h_32++;
}
else {
else
{
e.flt_mantissa.flt_l_32 += 0x400;
}
}
if (e.flt_exp >= 2047) {
if (e.flt_exp >= 2047)
{
overflow = 1;
e.flt_exp = 2047;
e.flt_mantissa.flt_h_32 = e.flt_mantissa.flt_l_32 = 0;
}
if (e.flt_exp <= 0) {
if (e.flt_exp <= 0)
{
flt_b64_sft(&(e.flt_mantissa), 1);
if (e.flt_exp < 0) {
if (e.flt_exp < 0)
{
flt_b64_sft(&(e.flt_mantissa), -e.flt_exp);
e.flt_exp = 0;
}
}
buf[I0] = (e.flt_sign << 7) | (e.flt_exp >> 4);
buf[I1] = ((e.flt_exp & 017)<< 4) | ((e.flt_mantissa.flt_h_32 >> 27) & 017);
buf[I1] = ((e.flt_exp & 017) << 4) | ((e.flt_mantissa.flt_h_32 >> 27) & 017);
buf[I2] = e.flt_mantissa.flt_h_32 >> 19;
buf[I3] = e.flt_mantissa.flt_h_32 >> 11;
buf[I4] = e.flt_mantissa.flt_h_32 >> 3;
@ -221,15 +257,17 @@ float_cst(str, sz, buf)
flt_b64_sft(&(e.flt_mantissa), -53);
}
#endif
#if ! FL_MSL_AT_LOW_ADDRESS
if (sz == 4) {
#if !FL_MSL_AT_LOW_ADDRESS
if (sz == 4)
{
buf[I4] = buf[I0];
buf[I5] = buf[I1];
buf[I6] = buf[I2];
buf[I7] = buf[I3];
}
#endif
if (overflow) {
if (overflow)
{
return 2;
}
return 0;
@ -237,22 +275,25 @@ float_cst(str, sz, buf)
#endif /* USE_FLT */
#ifdef CODE_GENERATOR
con_float()
void con_float(void)
{
char buf[8];
int rval = float_cst(str, (int)argval, buf);
int i;
if (rval == 1) {
fprintf(stderr,"float constant size = %d\n",(int)argval);
if (rval == 1)
{
fprintf(stderr, "float constant size = %d\n", (int)argval);
fatal("bad fcon size");
}
fprintf(codefile,"!float %s sz %d\n", str, (int)argval);
if (rval == 2) {
fprintf(codefile, "!float %s sz %d\n", str, (int)argval);
if (rval == 2)
{
fprintf(stderr, "Warning: overflow in floating point constant %s\n", str);
}
fprintf(codefile, ".data1 0%o", buf[0] & 0377);
for (i = 1; i < (int)argval; i++) {
for (i = 1; i < (int)argval; i++)
{
fprintf(codefile, ",0%o", buf[i] & 0377);
}
putc('\n', codefile);
@ -260,19 +301,19 @@ con_float()
#endif /* CODE_GENERATOR */
#ifdef CODE_EXPANDER
con_float(str, argval)
char *str;
arith argval;
void con_float(const char* str, arith argval)
{
char buf[8];
int rval = float_cst(str, (int)argval, buf);
int i;
if (rval == 1) {
if (rval == 1)
{
argval = 8;
rval = float_cst(str, 8, buf);
}
for (i = 0; i < (int)argval; i++) {
for (i = 0; i < (int)argval; i++)
{
gen1(buf[i]);
}
}

16
h/m2_traps.h
View file

@ -1,16 +0,0 @@
/* $Id$ */
/*
* (c) copyright 1990 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*/
/* Modula-2 runtime errors */
#define M2_TOOLARGE 64 /* stack of process too large */
#define M2_TOOMANY 65 /* too many nested traps & handlers */
#define M2_NORESULT 66 /* no RETURN from procedure function */
#define M2_UOVFL 67 /* cardinal overflow */
#define M2_FORCH 68 /* FOR-loop control variable changed */
#define M2_UUVFL 69 /* cardinal underflow */
#define M2_INTERNAL 70 /* internal error, should not happen */
#define M2_UNIXSIG 71 /* unix signal */

5
h/out.h
View file

@ -67,7 +67,10 @@ struct outname {
#define RELO4 3 /* 4 bytes */
#define RELOPPC 4 /* PowerPC 26-bit address */
#define RELOPPC_LIS 5 /* PowerPC lis */
#define RELOVC4 6 /* VideoCore IV address in 32-bit instruction */
#define RELOVC4 6 /* VideoCore IV address in 32-bit instruction */
#define RELOMIPS 7 /* MIPS */
#define RELO2HI 8 /* high 2 bytes of word */
#define RELO2HISAD 9 /* high 2 bytes of word, sign adjusted */
#define RELPC 0x2000 /* pc relative */
#define RELBR 0x4000 /* High order byte lowest address. */

7
lang/basic/lib/abs.c
View file

@ -1,9 +1,4 @@
/* $Id$ */
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*/
#include "lib.h"
long _abl(long i)
{

4
lang/basic/lib/asc.c
View file

@ -1,6 +1,4 @@
#include "bc_string.h"
/* $Id$ */
#include "lib.h"
int _asc(String* str)
{

1
lang/basic/lib/asrt.c
View file

@ -1,5 +1,6 @@
#include <stdio.h>
#include <stdlib.h>
#include "lib.h"
void asrt(int b)
{

10
lang/basic/lib/atn.c
View file

@ -1,12 +1,4 @@
/*
* (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*
* Author: Ceriel J.H. Jacobs
*/
/* $Id$ */
#include <math.h>
#include "lib.h"
double _atn(double x) { return atan(x); }

6
h/bc_io.h → lang/basic/lib/bc_io.h
View file

@ -1,11 +1,5 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*/
#include <stdio.h>
/* $Id$ */
/* BASIC file io definitions */
extern FILE *_chanrd;

1
lang/basic/lib/build.lua
View file

@ -12,6 +12,7 @@ for _, plat in ipairs(vars.plats) do
"h+emheaders",
"lang/cem/libcc.ansi/headers+pkg",
"plat/"..plat.."/include+pkg",
"./*.h",
},
vars = { plat = plat }
}

4
lang/basic/lib/chr.c
View file

@ -1,6 +1,4 @@
#include "bc_string.h"
/* $Id$ */
#include "lib.h"
String* _chr(int i)
{

2
lang/basic/lib/conversion.c
View file

@ -1,4 +1,4 @@
/* $Id$ */
#include "lib.h"
int _cint(double f)
{

1
lang/basic/lib/error.c
View file

@ -1,5 +1,6 @@
#include <stdlib.h>
#include <stdio.h>
#include "lib.h"
int _errsym;
int _erlsym;

10
lang/basic/lib/exp.c
View file

@ -1,14 +1,6 @@
/*
* (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*
* Author: Ceriel J.H. Jacobs
*/
/* $Id$ */
#define __NO_DEFS
#include <math.h>
#include "lib.h"
double _exp(double x)
{

2
lang/basic/lib/fef.e
View file

@ -1,8 +1,6 @@
#
mes 2,EM_WSIZE,EM_PSIZE
; $Id$
#define FARG 0
#define ERES EM_DSIZE

2
lang/basic/lib/fif.e
View file

@ -1,8 +1,6 @@
#
mes 2,EM_WSIZE,EM_PSIZE
; $Id$
#define ARG1 0
#define ARG2 EM_DSIZE
#define IRES 2*EM_DSIZE

4
lang/basic/lib/file.c
View file

@ -1,8 +1,6 @@
#include "bc_string.h"
#include <stdio.h>
#include "bc_io.h"
/* $Id$ */
#include "lib.h"
Filedesc _fdtable[16];
/* BASIC file descriptor table */

1
lang/basic/lib/hlt.c
View file

@ -1,4 +1,5 @@
#include <stdlib.h>
#include "lib.h"
void _hlt(int nr)
{

1
lang/basic/lib/io.c
View file

@ -1,4 +1,5 @@
#include "bc_io.h"
#include "lib.h"
/* dtrg --- this originally used sgtty.h to do clever tty manipulation.
* Strictly this should be converted to use termios, but for simplicity

104
lang/basic/lib/lib.h
View file

@ -1,9 +1,107 @@
#ifndef LIB_H
#define LIB_H
typedef struct{
char *strval;
int strcount;
int strlength;
} String;
#define MAXSTRING 1024
extern String *_chr(int i);
extern String *_concat(String *s1, String *s2);
extern String *_hex(int i);
extern String *_left(int size, String *s);
extern String *_mid(int i1, int i2, String *s);
extern String *_mkd(double d);
extern String *_mki(long i);
extern String *_newstr(char *str);
extern String *_nstr(double f);
extern String *_oct(int i);
extern String *_right(int length, String *str);
extern String *_space(int d);
extern String *_strascii(void);
extern String *_string(double f, double d);
extern char *salloc(unsigned length);
extern double _abr(double f);
extern double _atn(double x);
extern double _cos(double x);
extern double _cvd(String *s);
extern double _exp(double x);
extern double _fcint(double f);
extern double _log(double x);
extern double _power(double x, double y);
extern double _rnd(double d);
extern double _sin(double x);
extern double _sqt(double x);
extern double _tan(double x);
extern double _trunc(double f);
extern int _asc(String *str);
extern int _cint(double f);
extern int _fix(double f);
extern int _forsgn(double v);
extern int _ioeof(int channel);
extern int _length(String *str);
extern int _retstmt(void);
extern int _sgn(double v);
extern int _stop(void);
extern int _strcomp(String *s1, String *s2);
extern int peek(int addr);
extern long _abl(long i);
extern long _cvi(String *s);
extern void _asschn(void);
extern void _clochn(int nr);
extern void _closeall(void);
extern void _decstr(String *str);
extern void _delstr(String *src);
extern void _fltswap(double *i1, double *i2);
extern void _gosub(int x);
extern void _goto_err(void);
extern void _hlt(int nr);
extern void _in(char *buf);
extern void _incstr(String *src);
extern void _ini_trp(void);
extern void _intswap(int *i1, int *i2);
extern void _midstmt(String *s2, int i1, int i2, String *s);
extern void _nl(void);
extern void _opnchn(int reclen, String *fname, String *mode);
extern void _out(char *str);
extern void _outnl(void);
extern void _poke(int i, int j);
extern void _prfnum(double f);
extern void _prinum(int i);
extern void _prstr(String *str);
extern void _qstmark(void);
extern void _randomi(void);
extern void _rdline(String **s);
extern void _readflt(double *addr);
extern void _readint(int *addr);
extern void _readln(void);
extern void _readstr(String **s);
extern void _restore(int line);
extern void _setchan(int index);
extern void _setline(void);
extern void _setrand(int i);
extern void _settrap(int nr);
extern void _spc(int x);
extern void _str(double f, char *buffer);
extern void _strcpy(String *dst, String *src);
extern void _strswap(String **s1, String **s2);
extern void _tab(int x);
extern void _trace(int i);
extern void _trap(void);
extern void _trpfatal(int i);
extern void _trpset(int nr);
extern void _wrcomma(void);
extern void _wrflt(double f);
extern void _wrint(int i);
extern void _wrnl(void);
extern void _wrstr(String *s);
extern void _zone(void);
extern void asrt(int b);
extern void error(int index);
extern char* salloc(unsigned length);
extern void sfree(char* c);
extern void readskip(void);
extern void sfree(char *c);
#endif

10
lang/basic/lib/log.c
View file

@ -1,14 +1,6 @@
/*
* (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*
* Author: Ceriel J.H. Jacobs
*/
/* $Id$ */
#define __NO_DEFS
#include <math.h>
#include "lib.h"
double _log(double x)
{

4
lang/basic/lib/mki.c
View file

@ -1,6 +1,4 @@
#include "bc_string.h"
/* $Id$ */
#include "lib.h"
String* _mki(long i)
{

4
lang/basic/lib/oct.c
View file

@ -1,8 +1,6 @@
#include <stdlib.h>
#include <stdio.h>
#include "bc_string.h"
/* $Id$ */
#include "lib.h"
String* _oct(int i)
{

2
lang/basic/lib/peek.c
View file

@ -1,4 +1,4 @@
/* $Id$ */
#include "lib.h"
int peek(int addr)
{

1
lang/basic/lib/power.c
View file

@ -1,3 +1,4 @@
#include <math.h>
#include "lib.h"
double _power(double x, double y) { return pow(x, y); }

5
lang/basic/lib/print.c
View file

@ -1,9 +1,8 @@
#include <stdlib.h>
#include <stdio.h>
#include "bc_string.h"
#include <string.h>
#include "bc_io.h"
/* $Id$ */
#include "lib.h"
/* Here all routine to generate terminal oriented output is located */

1
lang/basic/lib/random.c
View file

@ -1,5 +1,6 @@
#include <stdlib.h>
#include <stdio.h>
#include "lib.h"
#if !defined(EM_WSIZE)
#define EM_WSIZE _EM_WSIZE

4
lang/basic/lib/read.c
View file

@ -1,8 +1,6 @@
#include "bc_string.h"
#include "bc_io.h"
#include <ctype.h>
/* $Id$ */
#include "lib.h"
void _readln(void)
{

2
lang/basic/lib/return.c
View file

@ -1,4 +1,4 @@
/* $Id$ */
#include "lib.h"
#define MAXNESTING 1000

1
lang/basic/lib/salloc.c
View file

@ -1,4 +1,5 @@
#include <stdlib.h>
#include "lib.h"
char* salloc(unsigned length)
{

1
lang/basic/lib/setline.e
View file

@ -1,6 +1,5 @@
#
mes 2,EM_WSIZE,EM_PSIZE
; $Id$
; Save the line where the error occurred
exp $_setline
pro $_setline,0

2
lang/basic/lib/sgn.c
View file

@ -1,4 +1,4 @@
/* $Id$ */
#include "lib.h"
int _sgn(double v)
{

10
lang/basic/lib/sin.c
View file

@ -1,14 +1,6 @@
/*
* (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*
* Author: Ceriel J.H. Jacobs
*/
/* $Id$ */
#define __NO_DEFS
#include <math.h>
#include "lib.h"
double _sin(double x) { return sin(x); }
double _cos(double x) { return cos(x); }

10
lang/basic/lib/sqt.c
View file

@ -1,13 +1,5 @@
/*
* (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*
* Author: Ceriel J.H. Jacobs
*/
/* $Id$ */
#define __NO_DEFS
#include <math.h>
#include "lib.h"
double _sqt(double x) { return sqrt(x); }

1
lang/basic/lib/stop.c
View file

@ -1,5 +1,6 @@
#include <stdlib.h>
#include <stdio.h>
#include "lib.h"
_stop()
{

3
lang/basic/lib/string.c
View file

@ -1,10 +1,7 @@
#include <stdlib.h>
#include <string.h>
#include "bc_string.h"
#include "lib.h"
/* $Id$ */
#define ok(X) \
if (X == 0) \
return;

4
lang/basic/lib/swap.c
View file

@ -1,6 +1,4 @@
#include "bc_string.h"
/* $Id$ */
#include "lib.h"
void _intswap(int* i1, int* i2)
{

3
lang/basic/lib/trace.c
View file

@ -1,4 +1,5 @@
/* $Id$ */
#include <stdio.h>
#include "lib.h"
void _trace(int i)
{

3
lang/basic/lib/trap.c
View file

@ -2,13 +2,12 @@
#include <stdio.h>
#include <signal.h>
#include <setjmp.h>
#include "lib.h"
#ifndef NSIG
#define NSIG _NSIG
#endif
/* $Id$ */
/* Trap handling */
int _trpline; /* BASIC return label */
jmp_buf trpbuf;

4
lang/basic/lib/write.c
View file

@ -1,7 +1,5 @@
#include "bc_string.h"
#include "bc_io.h"
/* $Id$ */
#include "lib.h"
/* assume that the channel has been set */

9
lang/basic/src/graph.c
View file

@ -199,19 +199,26 @@ int lab;
genreturns()
{
int count;
int nr;
nr= genlabel();
C_df_dnam("returns");
C_rom_ilb((label) nr);
C_rom_cst((arith)1);
C_rom_cst((arith) (gosubcnt-1));
C_rom_cst((arith) (gosubcnt-2));
count = 0;
while ( gosubhead)
{
C_rom_ilb((label) gosubhead->emlabel);
gosubhead= gosubhead->nextlist;
count++;
}
if (count != (gosubcnt-1))
error("gosub count table mismatch");
C_df_ilb((label) nr);
C_loc((arith) 1);
C_cal("error");

4
lang/cem/cemcom.ansi/BigPars
View file

@ -111,10 +111,6 @@
#define INP_READ_IN_ONE 1 /* read input file in one */
!File: nopp.h
/*#define NOPP 1 /* if NOT defined, use built-int preprocessor */
!File: nobitfield.h
/*#define NOBITFIELD 1 /* if NOT defined, implement bitfields */

1119
lang/cem/cemcom.ansi/LLlex.c
View file

File diff suppressed because it is too large Load diff

6
lang/cem/cemcom.ansi/LLlex.h
View file

@ -43,12 +43,6 @@ extern struct token dot, ahead, aside;
extern int token_nmb; /* number of the ahead token */
extern int tk_nmb_at_last_syn_err; /* token number at last syntax error */
#ifndef NOPP
extern int ReplaceMacros; /* "LLlex.c" */
extern int AccDefined; /* "LLlex.c" */
extern int Unstacked; /* "LLlex.c" */
extern int UnknownIdIsZero; /* "LLlex.c" */
#endif /* NOPP */
extern int EoiForNewline; /* "LLlex.c" */
extern int AccFileSpecifier; /* "LLlex.c" */
extern int File_Inserted; /* "LLlex.c" */

4
lang/cem/cemcom.ansi/SmallPars
View file

@ -111,10 +111,6 @@
/*#define INP_READ_IN_ONE 1 /* read input file in one */
!File: nopp.h
#define NOPP 1 /* if NOT defined, use built-int preprocessor */
!File: nobitfield.h
/*#define NOBITFIELD 1 /* if NOT defined, implement bitfields */

2
lang/cem/cemcom.ansi/build.lua
View file

@ -111,7 +111,6 @@ cprogram {
"./field.c",
"./fltcstoper.c",
"./idf.c",
"./init.c",
"./input.c",
"./l_comment.c",
"./l_ev_ord.c",
@ -124,7 +123,6 @@ cprogram {
"./options.c",
"./pragma.c",
"./proto.c",
"./replace.c",
"./skip.c",
"./stab.c",
"./stack.c",

850
lang/cem/cemcom.ansi/domacro.c
View file

@ -5,811 +5,41 @@
/* $Id$ */
/* PREPROCESSOR: CONTROLLINE INTERPRETER */
#include <assert.h>
#include <stdlib.h>
#include <string.h>
#include "parameters.h"
#include "idf.h"
#include "arith.h"
#include "LLlex.h"
#include "Lpars.h"
#include "input.h"
#include "replace.h"
#include <assert.h>
#include <stdlib.h>
#include <string.h>
#include "parameters.h"
#include "idf.h"
#include "arith.h"
#include "LLlex.h"
#include "Lpars.h"
#include "input.h"
#ifndef NOPP
#include <alloc.h>
#include "class.h"
#include "macro.h"
#ifdef DBSYMTAB
#include <stb.h>
#include <em.h>
int IncludeLevel = 0;
#include <stb.h>
#include <em.h>
int IncludeLevel = 0;
#endif
extern char options[];
extern char **inctable; /* list of include directories */
extern char *getwdir();
char ifstack[IFDEPTH]; /* if-stack: the content of an entry is */
/* 1 if a corresponding ELSE has been */
/* encountered. */
int nestlevel = -1;
void macro_def();
void do_define();
struct idf *
GetIdentifier(skiponerr)
int skiponerr; /* skip the rest of the line on error */
struct idf* GetIdentifier(skiponerr) int skiponerr; /* skip the rest of the line on error */
{
/* returns a pointer to the descriptor of the identifier that is
read from the input stream. When the input doe not contain
an identifier, the rest of the line is skipped when
skiponerr is on, and a null-pointer is returned.
The substitution of macros is disabled.
*/
int tmp = UnknownIdIsZero;
int tok;
struct token tk;
UnknownIdIsZero = ReplaceMacros = 0;
tok = GetToken(&tk);
ReplaceMacros = 1;
UnknownIdIsZero = tmp;
if (tok != IDENTIFIER) {
if (skiponerr && tok != EOI) SkipToNewLine();
return (struct idf *)0;
}
return tk.tk_idf;
}
/* domacro() is the control line interpreter. The '#' has already
been read by the lexical analyzer by which domacro() is called.
The token appearing directly after the '#' is obtained by calling
the basic lexical analyzing function GetToken() and is interpreted
to perform the action belonging to that token.
An error message is produced when the token is not recognized,
i.e. it is not one of "define" .. "undef" , integer or newline.
*/
domacro()
{
struct token tk; /* the token itself */
int toknum;
EoiForNewline = 1;
ReplaceMacros = 0;
toknum = GetToken(&tk);
ReplaceMacros = 1;
switch(toknum) { /* select control line action */
case IDENTIFIER: /* is it a macro keyword? */
switch (tk.tk_idf->id_resmac) {
case K_DEFINE: /* "define" */
do_define();
break;
case K_ELIF: /* "elif" */
do_elif();
break;
case K_ELSE: /* "else" */
do_else();
break;
case K_ENDIF: /* "endif" */
do_endif();
break;
case K_IF: /* "if" */
do_if();
break;
case K_IFDEF: /* "ifdef" */
do_ifdef(1);
break;
case K_IFNDEF: /* "ifndef" */
do_ifdef(0);
break;
case K_INCLUDE: /* "include" */
do_include();
break;
case K_LINE: /* "line" */
/* set LineNumber and FileName according to
the arguments.
*/
if (GetToken(&tk) != INTEGER) {
lexerror("bad #line syntax");
SkipToNewLine();
}
else
do_line((unsigned int)tk.tk_ival);
break;
case K_ERROR: /* "error" */
do_error();
break;
case K_PRAGMA: /* "pragma" */
do_pragma();
break;
case K_UNDEF: /* "undef" */
do_undef((struct idf *) 0);
break;
default:
/* invalid word seen after the '#' */
lexerror("%s: unknown control", tk.tk_idf->id_text);
SkipToNewLine();
}
break;
case INTEGER: /* # <integer> [<filespecifier>]? */
do_line((unsigned int)tk.tk_ival);
break;
case EOI: /* only `#' on this line: do nothing, ignore */
break;
default: /* invalid token following '#' */
lexerror("illegal # line");
SkipToNewLine();
}
EoiForNewline = 0;
}
#ifdef LINT
int lint_skip_comment;
#endif
void
skip_block(to_endif)
int to_endif;
{
/* skip_block() skips the input from
1) a false #if, #ifdef, #ifndef or #elif until the
corresponding #elif (resulting in true), #else or
#endif is read.
2) a #else corresponding to a true #if, #ifdef,
#ifndef or #elif until the corresponding #endif is
seen.
*/
register int ch;
register int skiplevel = nestlevel; /* current nesting level */
struct token tk;
int toknum;
#ifdef LINT
lint_skip_comment++;
#endif
NoUnstack++;
for (;;) {
ch = GetChar(); /* read first character after newline */
while (class(ch) == STSKIP)
ch = GetChar();
if (ch != '#') {
if (ch == EOI) {
NoUnstack--;
#ifdef LINT
lint_skip_comment--;
#endif
return;
}
/* A possible '/' is not pushed back */
if (ch == '/') {
ch = GetChar();
if (ch != '*') UnGetChar();
else {
skipcomment();
continue;
}
} else UnGetChar();
SkipToNewLine();
continue;
}
ReplaceMacros = 0;
toknum = GetToken(&tk);
ReplaceMacros = 1;
if (toknum != IDENTIFIER) {
if (toknum != INTEGER) {
lexerror("illegal # line");
}
SkipToNewLine();
continue;
}
/* an IDENTIFIER: look for #if, #ifdef and #ifndef
without interpreting them.
Interpret #else, #elif and #endif if they occur
on the same level.
*/
switch(tk.tk_idf->id_resmac) {
default:
case K_UNKNOWN:
/* invalid word seen after the '#' */
lexwarning("%s: unknown control", tk.tk_idf->id_text);
/* fallthrough */
case K_DEFINE:
case K_ERROR:
case K_INCLUDE:
case K_LINE:
case K_PRAGMA:
case K_UNDEF:
case K_FILE:
SkipToNewLine();
break;
case K_IF:
case K_IFDEF:
case K_IFNDEF:
push_if();
SkipToNewLine();
break;
case K_ELIF:
if (ifstack[nestlevel])
lexerror("#elif after #else");
if (!to_endif && nestlevel == skiplevel) {
nestlevel--;
push_if();
if (ifexpr()) {
NoUnstack--;
#ifdef LINT
lint_skip_comment--;
#endif
return;
}
}
else SkipToNewLine(); /* otherwise done in ifexpr() */
break;
case K_ELSE:
if (ifstack[nestlevel])
lexerror("#else after #else");
++(ifstack[nestlevel]);
if (!to_endif && nestlevel == skiplevel) {
if (SkipToNewLine()) {
if (!options['o'])
lexstrict("garbage following #else");
}
NoUnstack--;
#ifdef LINT
lint_skip_comment--;
#endif
return;
}
else SkipToNewLine();
break;
case K_ENDIF:
assert(nestlevel > nestlow);
if (nestlevel == skiplevel) {
if (SkipToNewLine()) {
if (!options['o'])
lexstrict("garbage following #endif");
}
nestlevel--;
NoUnstack--;
#ifdef LINT
lint_skip_comment--;
#endif
return;
}
else SkipToNewLine();
nestlevel--;
break;
}
}
}
ifexpr()
{
/* ifexpr() returns whether the restricted constant
expression following #if or #elif evaluates to true. This
is done by calling the LLgen generated subparser for
constant expressions. The result of this expression will
be given in the extern long variable "ifval".
*/
extern arith ifval;
int errors = err_occurred;
ifval = (arith)0;
AccDefined = 1;
UnknownIdIsZero = 1;
PushLex(); /* NEW parser */
If_expr(); /* invoke constant expression parser */
PopLex(); /* OLD parser */
AccDefined = 0;
UnknownIdIsZero = 0;
return (errors == err_occurred) && (ifval != (arith)0);
}
do_include()
{
/* do_include() performs the inclusion of a file.
*/
char *filenm;
char *result;
int tok;
struct token tk;
AccFileSpecifier = 1;
if (((tok = GetToken(&tk)) == FILESPECIFIER) || tok == STRING)
filenm = tk.tk_bts;
else {
lexerror("bad include syntax");
filenm = (char *)0;
}
AccFileSpecifier = 0;
if (SkipToNewLine()) {
lexerror("bad include syntax");
}
inctable[0] = WorkingDir;
if (filenm) {
if (!InsertFile(filenm, &inctable[tok==FILESPECIFIER],&result)){
lexerror("cannot open include file \"%s\"", filenm);
add_dependency(filenm);
free(filenm);
}
else {
add_dependency(result);
WorkingDir = getwdir(result);
File_Inserted = 1;
FileName = result;
LineNumber = 0;
nestlow = nestlevel;
#ifdef DBSYMTAB
IncludeLevel++;
if (options['g']) {
C_ms_stb_cst(FileName, N_BINCL, 0, (arith) 0);
}
#endif /* DBSYMTAB */
if (result != filenm) free(filenm);
}
}
}
void
do_define()
{
/* do_define() interprets a #define control line.
*/
struct idf *id; /* the #defined identifier's descriptor */
int nformals = -1; /* keep track of the number of formals */
char *formals[NPARAMS]; /* pointers to the names of the formals */
char parbuf[PARBUFSIZE]; /* names of formals */
char *repl_text; /* start of the replacement text */
int length; /* length of the replacement text */
register ch;
char *get_text();
/* read the #defined macro's name */
if (!(id = GetIdentifier(1))) {
lexerror("illegal #define line");
return;
}
/* there is a formal parameter list if the identifier is
followed immediately by a '('.
*/
ch = GetChar();
if (ch == '(') {
if ((nformals = getparams(formals, parbuf)) == -1) {
SkipToNewLine();
return; /* an error occurred */
}
ch = GetChar();
}
/* read the replacement text if there is any */
ch = skipspaces(ch,0); /* find first character of the text */
assert(ch != EOI);
/* UnGetChar() is not right when replacement starts with a '/' */
ChPushBack(ch);
repl_text = get_text((nformals > 0) ? formals : 0, &length);
macro_def(id, repl_text, nformals, length, NOFLAG);
LineNumber++;
}
push_if()
{
if (nestlevel >= IFDEPTH)
fatal("too many nested #if/#ifdef/#ifndef");
else
ifstack[++nestlevel] = 0;
}
do_elif()
{
if (nestlevel <= nestlow) {
lexerror("#elif without corresponding #if");
SkipToNewLine();
}
else { /* restart at this level as if a #if is detected. */
if (ifstack[nestlevel]) {
lexerror("#elif after #else");
SkipToNewLine();
}
nestlevel--;
push_if();
skip_block(1);
}
}
do_else()
{
if (SkipToNewLine())
if (!options['o'])
lexstrict("garbage following #else");
if (nestlevel <= nestlow)
lexerror("#else without corresponding #if");
else { /* mark this level as else-d */
if (ifstack[nestlevel]) {
lexerror("#else after #else");
}
++(ifstack[nestlevel]);
skip_block(1);
}
}
do_endif()
{
if (SkipToNewLine()) {
if (!options['o'])
lexstrict("garbage following #endif");
}
if (nestlevel <= nestlow) {
lexerror("#endif without corresponding #if");
}
else nestlevel--;
}
do_if()
{
push_if();
if (!ifexpr()) /* a false #if/#elif expression */
skip_block(0);
}
do_ifdef(how)
{
register struct idf *id;
/* how == 1 : ifdef; how == 0 : ifndef
*/
push_if();
if (!(id = GetIdentifier(1)))
lexerror("illegal #ifdef construction");
else if (SkipToNewLine())
if (!options['o'])
lexstrict("garbage following #%s <identifier>",
how ? "ifdef" : "ifndef");
/* The next test is a shorthand for:
(how && !id->id_macro) || (!how && id->id_macro)
*/
if (how ^ (id && id->id_macro != 0))
skip_block(0);
}
/* argidf != NULL when the undef came from a -U option */
do_undef(argidf)
struct idf *argidf;
{
register struct idf *id = argidf;
/* Forget a macro definition. */
if (id || (id = GetIdentifier(1))) {
if (id->id_macro) { /* forget the macro */
if (id->id_macro->mc_flag & NOUNDEF) {
lexerror("it is not allowed to undef %s", id->id_text);
} else {
free(id->id_macro->mc_text);
free_macro(id->id_macro);
id->id_macro = (struct macro *) 0;
}
} /* else: don't complain */
if (!argidf) {
if (SkipToNewLine())
if (!options['o'])
lexstrict("garbage following #undef");
}
}
else
lexerror("illegal #undef construction");
}
do_error()
{
int len;
char *get_text();
char *bp = get_text((char **) 0, &len);
lexerror("user error: %s", bp);
free(bp);
LineNumber++;
}
int
getparams(buf, parbuf)
char *buf[];
char parbuf[];
{
/* getparams() reads the formal parameter list of a macro
definition.
The number of parameters is returned.
As a formal parameter list is expected when calling this
routine, -1 is returned if an error is detected, for
example:
#define one(1), where 1 is not an identifier.
Note that the '(' has already been eaten.
The names of the formal parameters are stored into parbuf.
*/
register char **pbuf = &buf[0];
register int c;
register char *ptr = &parbuf[0];
register char **pbuf2;
c = GetChar();
c = skipspaces(c,0);
if (c == ')') { /* no parameters: #define name() */
*pbuf = (char *) 0;
return 0;
}
for (;;) { /* eat the formal parameter list */
if (class(c) != STIDF && class(c) != STELL) {
lexerror("#define: bad formal parameter");
return -1;
}
*pbuf = ptr; /* name of the formal */
*ptr++ = c;
if (ptr >= &parbuf[PARBUFSIZE])
fatal("formal parameter buffer overflow");
do { /* eat the identifier name */
c = GetChar();
*ptr++ = c;
if (ptr >= &parbuf[PARBUFSIZE])
fatal("formal parameter buffer overflow");
} while (in_idf(c));
*(ptr - 1) = '\0'; /* mark end of the name */
/* Check if this formal parameter is already used.
Usually, macros do not have many parameters, so ...
*/
for (pbuf2 = pbuf - 1; pbuf2 >= &buf[0]; pbuf2--) {
if (!strcmp(*pbuf2, *pbuf)) {
lexerror("formal parameter \"%s\" already used",
*pbuf);
}
}
pbuf++;
c = skipspaces(c,0);
if (c == ')') { /* end of the formal parameter list */
*pbuf = (char *) 0;
return pbuf - buf;
}
if (c != ',') {
lexerror("#define: bad formal parameter list");
return -1;
}
c = GetChar();
c = skipspaces(c,0);
}
/*NOTREACHED*/
}
void
macro_def(id, text, nformals, length, flags)
register struct idf *id;
char *text;
{
register struct macro *newdef = id->id_macro;
/* macro_def() puts the contents and information of a macro
definition into a structure and stores it into the symbol
table entry belonging to the name of the macro.
An error is given if there was already a definition
*/
if (newdef) { /* is there a redefinition? */
if (newdef->mc_flag & NOUNDEF) {
lexerror("it is not allowed to redefine %s", id->id_text);
} else if (!macroeq(newdef->mc_text, text))
lexerror("illegal redefine of \"%s\"", id->id_text);
free(text);
return;
}
id->id_macro = newdef = new_macro();
newdef->mc_text = text; /* replacement text */
newdef->mc_nps = nformals; /* nr of formals */
newdef->mc_length = length; /* length of repl. text */
newdef->mc_flag = flags; /* special flags */
}
int
find_name(nm, index)
char *nm, *index[];
{
/* find_name() returns the index of "nm" in the namelist
"index" if it can be found there. 0 is returned if it is
not there.
*/
register char **ip = &index[0];
while (*ip)
if (strcmp(nm, *ip++) == 0)
return ip - &index[0];
/* arrived here, nm is not in the name list. */
return 0;
}
#define BLANK(ch) ((ch == ' ') || (ch == '\t'))
char *
get_text(formals, length)
char *formals[];
int *length;
{
/* get_text() copies the replacement text of a macro
definition with zero, one or more parameters, thereby
substituting each formal parameter by a special character
(non-ascii: 0200 & (order-number in the formal parameter
list)) in order to substitute this character later by the
actual parameter. The replacement text is copied into
itself because the copied text will contain fewer or the
same amount of characters. The length of the replacement
text is returned.
Implementation:
finite automaton : we are interested in
1- white space, sequences must be mapped onto 1 single
blank.
2- identifiers, since they might be replaced by some
actual parameter.
3- strings and character constants, since replacing
variables within them is illegal, and white-space is
significant.
4- comment, same as for 1
Other tokens will not be seen as such.
*/
register int c;
struct repl repls;
register struct repl *repl = &repls;
int blank = 0;
c = GetChar();
repl->r_ptr = repl->r_text = Malloc(repl->r_size = ITEXTSIZE);
*repl->r_ptr = '\0';
while ((c != EOI) && (class(c) != STNL)) {
if (BLANK(c)) {
blank++;
c = GetChar();
continue;
}
if (c == '\'' || c == '"') {
register int delim = c;
if (blank) {
blank = 0;
add2repl(repl, ' ');
}
do {
add2repl(repl, c);
if (c == '\\') add2repl(repl, GetChar());
c = GetChar();
} while (c != delim && c != EOI && class(c) != STNL);
if (c == EOI || class(c) == STNL) {
lexstrict("unclosed opening %c", delim);
break;
}
add2repl(repl, c);
c = GetChar();
} else if (c == '/') {
c = GetChar();
if (c == '*') {
skipcomment();
blank++;
c = GetChar();
continue;
}
if (blank) {
blank = 0;
add2repl(repl, ' ');
}
add2repl(repl, '/');
} else if (formals
&& (class(c) == STIDF || class(c) == STELL)) {
char id_buf[IDFSIZE + 1];
register char *idp = id_buf;
int n;
/* read identifier: it may be a formal parameter */
*idp++ = c;
do {
c = GetChar();
if (idp <= &id_buf[IDFSIZE])
*idp++ = c;
} while (in_idf(c));
*--idp = '\0';
if (blank) {
blank = 0;
add2repl(repl, ' ');
}
/* construct the formal parameter mark or identifier */
if (n = find_name(id_buf, formals))
add2repl(repl, FORMALP | (char) n);
else {
idp = id_buf;
while (*idp) add2repl(repl, *idp++);
}
} else if (class(c) == STNUM) {
if (blank) {
blank = 0;
add2repl(repl, ' ');
}
add2repl(repl, c);
if (c == '.') {
c = GetChar();
if (class(c) != STNUM) {
continue;
}
add2repl(repl, c);
}
c = GetChar();
while(in_idf(c) || c == '.') {
add2repl(repl, c);
if((c = GetChar()) == 'e' || c == 'E') {
add2repl(repl, c);
c = GetChar();
if (c == '+' || c == '-') {
add2repl(repl, c);
c = GetChar();
}
}
}
} else {
if (blank) {
blank = 0;
add2repl(repl, ' ');
}
add2repl(repl, c);
c = GetChar();
}
}
*length = repl->r_ptr - repl->r_text;
return Realloc(repl->r_text, (unsigned)(repl->r_ptr - repl->r_text +1));
}
/* macroeq() decides whether two macro replacement texts are
identical. This version compares the texts, which occur
as strings, without taking care of the leading and trailing
blanks (spaces and tabs).
*/
macroeq(s, t)
register char *s, *t;
{
/* skip leading spaces */
while (BLANK(*s)) s++;
while (BLANK(*t)) t++;
/* first non-blank encountered in both strings */
/* The actual comparison loop: */
while (*s && *s == *t)
s++, t++;
/* two cases are possible when arrived here: */
if (*s == '\0') { /* *s == '\0' */
while (BLANK(*t)) t++;
return *t == '\0';
}
else { /* *s != *t */
while (BLANK(*s)) s++;
while (BLANK(*t)) t++;
return (*s == '\0') && (*t == '\0');
}
}
#else /* NOPP */
struct idf *
GetIdentifier(skiponerr)
int skiponerr; /* skip the rest of the line on error */
{
/* returns a pointer to the descriptor of the identifier that is
read from the input stream. When the input does not contain
an identifier, the rest of the line is skipped when
skiponerr is on, and a null-pointer is returned.
The substitution of macros is disabled.
read from the input stream. When the input does not contain
an identifier, the rest of the line is skipped when
skiponerr is on, and a null-pointer is returned.
The substitution of macros is disabled.
*/
int tok;
struct token tk;
tok = GetToken(&tk);
if (tok != IDENTIFIER) {
if (skiponerr && tok != EOI) SkipToNewLine();
return (struct idf *)0;
if (tok != IDENTIFIER)
{
if (skiponerr && tok != EOI)
SkipToNewLine();
return (struct idf*)0;
}
return tk.tk_idf;
}
@ -820,14 +50,18 @@ domacro()
struct token tk;
EoiForNewline = 1;
if ((tok = GetToken(&tk)) == IDENTIFIER) {
if (! strcmp(tk.tk_idf->id_text, "pragma")) {
if ((tok = GetToken(&tk)) == IDENTIFIER)
{
if (!strcmp(tk.tk_idf->id_text, "pragma"))
{
do_pragma();
EoiForNewline = 0;
return;
}
} else if (tok == INTEGER) {
do_line((unsigned int) tk.tk_ival);
}
else if (tok == INTEGER)
{
do_line((unsigned int)tk.tk_ival);
EoiForNewline = 0;
return;
}
@ -835,24 +69,24 @@ domacro()
EoiForNewline = 0;
SkipToNewLine();
}
#endif /* NOPP */
do_line(l)
unsigned int l;
do_line(l) unsigned int l;
{
struct token tk;
int t = GetToken(&tk);
if (t != EOI) SkipToNewLine();
LineNumber = l; /* the number of the next input line */
if (t == STRING) { /* is there a filespecifier? */
/*
* Do not attempt to free the old string, since it might
* be used in a def structure.
*/
if (t != EOI)
SkipToNewLine();
LineNumber = l; /* the number of the next input line */
if (t == STRING)
{ /* is there a filespecifier? */
/*
* Do not attempt to free the old string, since it might
* be used in a def structure.
*/
#ifdef DBSYMTAB
if (options['g'] && strcmp(FileName, tk.tk_bts) != 0) {
if (options['g'] && strcmp(FileName, tk.tk_bts) != 0)
{
C_ms_std(tk.tk_bts, N_SOL, 0);
}
#endif /* DBSYMTAB */

9
lang/cem/cemcom.ansi/dumpidf.c
View file

@ -106,15 +106,6 @@ dumpidf(idf, opt)
if (!idf)
return;
#ifndef NOPP
if ((opt&1) && idf->id_macro) {
if (!started++) {
newline();
print("%s:", idf->id_text);
}
print(" macro");
}
#endif /* NOPP */
if ((opt&2) && idf->id_reserved) {
if (!started++) {
newline();

13
lang/cem/cemcom.ansi/idf.str
View file

@ -8,10 +8,6 @@
#include "parameters.h"
struct id_u {
#ifndef NOPP
struct macro *idd_macro;
int idd_resmac; /* if nonzero: keyword of macroproc. */
#endif /* NOPP */
int idd_reserved; /* non-zero for reserved words */
char *idd_file; /* file containing the occurrence */
unsigned int idd_line; /* line number of the occurrence */
@ -36,14 +32,5 @@ struct id_u {
#include <idf_pkg.spec>
#ifndef NOPP
struct dependency {
struct dependency *next;
struct idf *dep_idf;
};
/* ALLOCDEF "dependency" 10 */
#endif /* NOPP */
extern int level;
extern struct idf *gen_idf();

99
lang/cem/cemcom.ansi/init.c
View file

@ -1,99 +0,0 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*/
/* $Id$ */
/* PREPROCESSOR: INITIALIZATION ROUTINES */
#include <stdlib.h>
#include <string.h>
#include <time.h>
#include "parameters.h"
#ifndef NOPP
#include <system.h>
#include <alloc.h>
#include <time.h>
#include "idf.h"
#include "class.h"
#include "macro.h"
extern char *sprint();
struct mkey {
char *mk_reserved;
int mk_key;
} mkey[] = {
{"define", K_DEFINE},
{"elif", K_ELIF},
{"else", K_ELSE},
{"endif", K_ENDIF},
{"error", K_ERROR},
{"if", K_IF},
{"ifdef", K_IFDEF},
{"ifndef", K_IFNDEF},
{"include", K_INCLUDE},
{"line", K_LINE},
{"pragma", K_PRAGMA},
{"undef", K_UNDEF},
{0, K_UNKNOWN}
};
init_pp()
{
static char *months[12] = {
"Jan", "Feb", "Mar", "Apr", "May", "Jun",
"Jul", "Aug", "Sep", "Oct", "Nov", "Dec"
};
time_t clock;
static char dbuf[30];
static char tbuf[30];
struct tm *tp;
/* Initialise the control line keywords (if, include, define, etc)
Although the lexical analyzer treats them as identifiers, the
control line handler can recognize them as keywords by the
id_resmac field of the identifier.
*/
{
register struct mkey *mk = &mkey[0];
while (mk->mk_reserved) {
register struct idf *idf = str2idf(mk->mk_reserved, 0);
if (idf->id_resmac)
fatal("maximum identifier length insufficient");
idf->id_resmac = mk->mk_key;
mk++;
}
}
/* Initialize __LINE__, __FILE__, __DATE__, __TIME__,
and __STDC__ macro definitions.
*/
clock = time(NULL);
tp = localtime(&clock);
/* __DATE__ */
sprint(dbuf, "\"%s %02d %d\"", months[tp->tm_mon],
tp->tm_mday, tp->tm_year+1900);
if (tp->tm_mday < 10) dbuf[5] = ' '; /* hack */
macro_def(str2idf("__DATE__", 0), dbuf, -1, strlen(dbuf), NOUNDEF);
/* __TIME__ */
sprint(tbuf, "\"%02d:%02d:%02d\"", tp->tm_hour, tp->tm_min, tp->tm_sec);
macro_def(str2idf("__TIME__", 0), tbuf, -1, strlen(tbuf), NOUNDEF);
/* __LINE__ */
macro_def(str2idf("__LINE__", 0), "0", -1, 1, NOUNDEF | FUNC);
/* __FILE__ */
macro_def(str2idf("__FILE__", 0), "", -1, 1, NOUNDEF | FUNC);
/* __STDC__ */
macro_def(str2idf("__STDC__", 0), "1", -1, 1, NOUNDEF);
/* defined(??) */
macro_def(str2idf("defined", 0), "", 1, 1, NOUNDEF | FUNC);
}
#endif /* NOPP */

56
lang/cem/cemcom.ansi/input.c
View file

@ -18,50 +18,10 @@ struct file_info finfo;
#include <inp_pkg.body>
#include <alloc.h>
#ifndef NOPP
#ifdef DBSYMTAB
#include <stb.h>
#include <em.h>
extern int IncludeLevel;
extern char options[];
#endif
char *
getwdir(fn)
register char *fn;
{
register char *p;
char *strrchr();
p = strrchr(fn, '/');
while (p && *(p + 1) == '\0') { /* remove trailing /'s */
*p = '\0';
p = strrchr(fn, '/');
}
if (fn[0] == '\0' || (fn[0] == '/' && p == &fn[0])) /* absolute path */
return "";
if (p) {
*p = '\0';
fn = Salloc(fn,(unsigned) (p - &fn[0] + 1));
*p = '/';
return fn;
}
return "";
}
int InputLevel;
extern int nestlevel;
#endif /* NOPP */
int NoUnstack;
AtEoIT()
{
#ifndef NOPP
InputLevel--;
unstackrepl();
#endif /* NOPP */
return 0;
}
@ -69,22 +29,6 @@ extern char *source;
AtEoIF()
{
#ifndef NOPP
if (nestlevel != nestlow) lexwarning("missing #endif");
else
#endif /* NOPP */
if (NoUnstack) lexerror("unexpected EOF");
#ifndef NOPP
nestlevel = nestlow;
#ifdef DBSYMTAB
if (options['g'] && IncludeLevel > 0) {
C_ms_stb_cst(FileName, N_EINCL, 0, (arith) 0);
}
IncludeLevel--;
#endif
/* We don't free WorkingDir and FileName here because the rest of the
* compiler may be holding pointers to them for displaying error messages.
*/
#endif /* NOPP */
return 0;
}

44
lang/cem/cemcom.ansi/macro.str
View file

@ -6,47 +6,3 @@
/* PREPROCESSOR: DEFINITION OF MACRO DESCRIPTOR */
#include "parameters.h"
#ifndef NOPP
/* The flags of the mc_flag field of the macro structure. Note that
these flags can be set simultaneously.
*/
#define NOFLAG 0 /* no special flags */
#define FUNC 0x1 /* function attached */
#define NOUNDEF 0x2 /* reserved macro */
#define NOREPLACE 0x4 /* prevent recursion */
#define FORMALP 0200 /* mask for creating macro formal parameter */
/* The macro descriptor is very simple, except the fact that the
mc_text, which points to the replacement text, contains the
non-ascii characters \201, \202, etc, indicating the position of a
formal parameter in this text.
*/
struct macro {
struct macro *next;
char * mc_text; /* the replacement text */
int mc_nps; /* number of formal parameters */
int mc_length; /* length of replacement text */
char mc_flag; /* marking this macro */
};
/* ALLOCDEF "macro" 20 */
/* `token' numbers of keywords of command-line processor
*/
#define K_UNKNOWN 0
#define K_DEFINE 1
#define K_ELIF 2
#define K_ELSE 3
#define K_ENDIF 4
#define K_ERROR 5
#define K_IF 6
#define K_IFDEF 7
#define K_IFNDEF 8
#define K_INCLUDE 9
#define K_LINE 10
#define K_PRAGMA 11
#define K_UNDEF 12
#define K_FILE 100 /* for dependency generator */
#endif /* NOPP */

196
lang/cem/cemcom.ansi/main.c
View file

@ -29,19 +29,6 @@ extern struct tokenname tkidf[];
extern char *symbol2str();
extern char options[128];
#ifndef NOPP
int inc_pos = 1; /* place where next -I goes */
int inc_total = 0;
int inc_max;
char **inctable;
extern int do_dependencies;
extern char *dep_file;
static File *dep_fd = STDOUT;
extern char *getwdir();
#endif /* NOPP */
struct sp_id special_ids[] = {
{"__setjmp", SP_SETJMP}, /* non-local goto's are registered */
{0, 0}
@ -74,10 +61,6 @@ int
union_align = AL_UNION;
#endif /* NOCROSS */
#ifndef NOPP
arith ifval; /* ifval will contain the result of the #if expression */
#endif /* NOPP */
char *prog_name;
main(argc, argv)
@ -86,17 +69,6 @@ main(argc, argv)
/* parse and interpret the command line options */
prog_name = argv[0];
#ifndef NOPP
inctable = (char **) Malloc(10 * sizeof(char *));
inctable[0] = "";
inctable[1] = 0;
inctable[2] = 0;
inc_total = 3;
inc_max = 10;
init_pp(); /* initialise the preprocessor macros */
#endif /* NOPP */
/* Note: source file "-" indicates that the source is supplied
as standard input. This is only allowed if INP_READ_IN_ONE is
not defined!
@ -122,83 +94,10 @@ main(argc, argv)
if (options['m']) Info();
#endif /* DEBUG */
#ifndef NOPP
if (do_dependencies) {
extern char *source;
list_dependencies(source);
}
#endif
sys_stop(err_occurred ? S_EXIT : S_END);
/*NOTREACHED*/
}
#ifndef NOPP
struct dependency *file_head;
extern char *strrchr();
list_dependencies(source)
char *source;
{
register struct dependency *p = file_head;
if (source) {
register char *s = strrchr(source, '.');
if (s && *(s+1)) {
s++;
*s++ = 'o';
*s = '\0';
/* the source may be in another directory than the
* object generated, so don't include the pathname
* leading to it.
*/
if (s = strrchr(source, '/')) {
source = s + 1;
}
}
else source = 0;
}
if (dep_file && !sys_open(dep_file, OP_WRITE, &dep_fd)) {
fatal("could not open %s", dep_file);
}
while (p) {
dependency(p->dep_idf->id_text, source);
p = p->next;
}
}
add_dependency(s)
char *s;
{
register struct idf *p = str2idf(s, 1);
if (! p->id_resmac) {
register struct dependency *q = new_dependency();
p->id_resmac = K_FILE;
q->dep_idf = p;
q->next = file_head;
file_head = q;
}
}
void
dependency(s, source)
char *s, *source;
{
if (options['i'] && !strncmp(s, "/usr/include/", 13)) {
return;
}
if (options['m'] && source) {
fprint(dep_fd, "%s: %s\n", source, s);
}
else fprint(dep_fd, "%s\n", s);
}
#endif /* NOPP */
char *source = 0;
#ifdef GEN_NM_LIST
@ -213,19 +112,10 @@ compile(argc, argv)
register char *destination = 0;
#endif /* LINT */
#ifdef DEBUG
#ifndef NOPP
int pp_only = options['E'] || options['P'] || options['C'];
#endif /* NOPP */
#endif
switch (argc) {
case 1:
#ifndef LINT
#ifdef DEBUG
#ifndef NOPP
if (!pp_only)
#endif /* NOPP */
#endif
fatal("%s: destination file not specified", prog_name);
#endif /* LINT */
@ -277,20 +167,7 @@ compile(argc, argv)
: 0);
#endif /* LINT */
#ifndef NOPP
WorkingDir = getwdir(source);
PushLex(); /* initialize lex machine */
#else /* NOPP */
GetToken(&ahead);
#endif /* NOPP */
#ifdef DEBUG
#ifndef NOPP
if (pp_only) /* run the preprocessor as if it is stand-alone */
preprocess();
else
#endif /* NOPP */
#endif /* DEBUG */
{
/* compile the source text */
C_program();
@ -311,9 +188,6 @@ compile(argc, argv)
dumpidftab("end of main", options['f'] ? 7 : 0);
#endif /* DEBUG */
}
#ifndef NOPP
PopLex();
#endif /* NOPP */
}
init()
@ -395,76 +269,6 @@ init_specials(si)
}
#ifdef DEBUG
#ifndef NOPP
preprocess()
{
/* preprocess() is the "stand-alone" preprocessor which
consecutively calls the lexical analyzer LLlex() to get
the tokens and prints them in a suitable way.
*/
static unsigned int lastlineno = 0;
static char *lastfilenm = "";
while (LLlex() != EOI) {
if (lastlineno != dot.tk_line) {
if (strcmp(lastfilenm, dot.tk_file) == 0) {
if (dot.tk_line - lastlineno <= 1) {
lastlineno++;
print("\n");
}
else {
lastlineno = dot.tk_line;
if (!options['P'])
print("\n#line %ld \"%s\"\n",
lastlineno,
lastfilenm
);
}
}
else {
lastfilenm = dot.tk_file;
lastlineno = dot.tk_line;
if (!options['P'])
print("\n#line %ld \"%s\"\n",
lastlineno, lastfilenm);
}
}
else
if (strcmp(lastfilenm, dot.tk_file) != 0) {
lastfilenm = dot.tk_file;
if (!options['P'])
print("\n#line %ld \"%s\"\n",
lastlineno, lastfilenm);
}
switch (DOT) {
case IDENTIFIER:
case TYPE_IDENTIFIER:
print("%s ", dot.tk_idf->id_text);
break;
case STRING:
{
char sbuf[1024]; /* a transient buffer */
print("\"%s\" ", bts2str(dot.tk_bts, dot.tk_len -
1, sbuf));
break;
}
case INTEGER:
print("%ld ", dot.tk_ival);
break;
case FLOATING:
print("%s ", dot.tk_fval);
break;
case EOI:
case EOF:
return;
default: /* very expensive... */
print("%s ", symbol2str(DOT));
}
}
}
#endif /* NOPP */
Info()
{
extern int cnt_string_cst, cnt_formal,

86
lang/cem/cemcom.ansi/options.c
View file

@ -16,16 +16,6 @@
#include "sizes.h"
#include "align.h"
#ifndef NOPP
extern char **inctable;
extern int inc_pos;
extern int inc_max;
extern int inc_total;
int do_dependencies = 0;
char *dep_file = 0;
#endif /* NOPP */
char options[128]; /* one for every char */
#ifdef LINT
char loptions[128]; /* one for every char */
@ -60,18 +50,6 @@ next_option: /* to allow combined one-char options */
goto next_option;
#ifndef LINT
#ifndef NOPP
case 'A' : /* Amake dependency generation */
do_dependencies = 1;
if (*text) {
dep_file = text;
}
break;
case 'i':
case 'm':
options[opt] = 1;
break;
#endif /* NOPP */
#endif /* LINT */
#ifdef DBSYMTAB
case 'g': /* symbol table for debugger */
@ -110,64 +88,6 @@ next_option: /* to allow combined one-char options */
goto next_option;
#endif /* LINT */
#ifndef NOPP
case 'D' : { /* -Dname : predefine name */
register char *cp = text, *name, *mactext;
unsigned maclen;
if (class(*cp) != STIDF && class(*cp) != STELL) {
error("identifier missing in -D%s", text);
break;
}
name = cp;
while (*cp && in_idf(*cp)) {
++cp;
}
if (!*cp) { /* -Dname */
maclen = 1;
mactext = Salloc("1", 2);
}
else
if (*cp == '=') { /* -Dname=text */
*cp++ = '\0'; /* end of name */
maclen = (unsigned) strlen(cp);
mactext = Salloc(cp, maclen + 1);
}
else { /* -Dname?? */
error("malformed option -D%s", text);
break;
}
macro_def(str2idf(name, 0), mactext, -1, (int)maclen, NOFLAG);
break;
}
case 'I' : /* -Ipath : insert "path" into include list */
if (*text) {
int i;
register char *new = text;
if (inc_total >= inc_max) {
inctable = (char **)
Realloc((char *)inctable,
(unsigned)((inc_max+=10)*sizeof(char *)));
}
for (i = inc_pos++; i < inc_total ; i++) {
char *tmp = inctable[i];
inctable[i] = new;
new = tmp;
}
inc_total++;
}
else inctable[inc_pos] = 0;
break;
#endif /* NOPP */
case 'M': /* maximum identifier length */
idfsize = txt2int(&text);
if (*text || idfsize <= 0)
@ -197,12 +117,6 @@ next_option: /* to allow combined one-char options */
break;
}
#ifndef NOPP
case 'U' : /* -Uname : undefine predefined */
if (*text) do_undef(str2idf(text, 0));
break;
#endif /* NOPP */
#ifndef LINT
#ifndef NOCROSS
case 'V' : /* set object sizes and alignment requirements */

12
lang/cem/cemcom.ansi/program.g
View file

@ -61,10 +61,6 @@
#include "l_lint.h"
#endif /* LINT */
#ifndef NOPP
extern arith ifval;
#endif /* NOPP */
extern error();
}
@ -75,14 +71,6 @@ control_if_expression
:
constant_expression(&exprX)
{
#ifndef NOPP
register struct expr *expr = exprX;
if (expr->ex_flags & EX_SIZEOF)
expr_error(expr,
"sizeof not allowed in preprocessor");
ifval = expr->VL_VALUE;
free_expression(expr);
#endif /* NOPP */
}
;

808
lang/cem/cemcom.ansi/replace.c
View file

@ -1,808 +0,0 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*/
/* $Id$ */
/* M A C R O R E P L A C E M E N T */
#include <assert.h>
#include <stdlib.h>
#include <string.h>
#include "parameters.h"
#ifndef NOPP
#include <ack_string.h>
#include <alloc.h>
#include "idf.h"
#include "input.h"
#include "macro.h"
#include "arith.h"
#include "LLlex.h"
#include "class.h"
#include "replace.h"
extern struct idf *GetIdentifier();
extern int InputLevel;
struct repl *ReplaceList; /* list of currently active macros */
void macro2buffer();
void getactuals();
void expand_defined();
int
replace(idf)
register struct idf *idf;
{
/* replace is called by the lexical analyzer to perform
macro replacement. The routine actualy functions as a
higher interface to the real thing: expand_macro().
*/
struct repl *repl;
if (!(idf->id_macro)) return 0;
if (idf->id_macro->mc_flag & NOREPLACE)
return 0;
repl = new_repl();
repl->r_ptr = repl->r_text = Malloc(repl->r_size = LAPBUF);
repl->r_args = new_args();
repl->r_idf = idf;
if (!expand_macro(repl, idf))
return 0;
InputLevel++;
InsertText(repl->r_text, (int)(repl->r_ptr - repl->r_text));
idf->id_macro->mc_flag |= NOREPLACE;
repl->r_level = InputLevel;
repl->next = ReplaceList;
ReplaceList = repl;
return 1;
}
unstackrepl()
{
Unstacked++;
}
freeargs(args)
struct args *args;
{
register int i;
/* We must don't know how many parameters were specified, so be
* prepared to free all NPARAMS parameters.
* When an expvec is !0, the rawvec will also be !0.
* When an expvec is 0, all remaining vectors will also be 0.
*/
for (i = 0; i < NPARAMS; i++) {
if (args->a_expvec[i]) {
free(args->a_expvec[i]);
free(args->a_rawvec[i]);
} else break;
}
free_args(args);
}
EnableMacros()
{
register struct repl *r = ReplaceList, *prev = 0;
assert(Unstacked > 0);
while(r) {
struct repl *nxt = r->next;
if (r->r_level > InputLevel) {
r->r_idf->id_macro->mc_flag &= ~NOREPLACE;
if (!prev) ReplaceList = nxt;
else prev->next = nxt;
free(r->r_text);
freeargs(r->r_args);
free_repl(r);
}
else prev = r;
r = nxt;
}
Unstacked = 0;
}
expand_macro(repl, idf)
register struct repl *repl;
register struct idf *idf;
{
/* expand_macro() does the actual macro replacement.
"idf" is a description of the identifier which
caused the replacement.
If the identifier represents a function-like macro
call, the number of actual parameters is checked
against the number of formal parameters. Note that
in ANSI C the parameters are expanded first;
this is done by calling getactuals().
When the possible parameters are expanded, the replace-
ment list associated with "idf" is expanded.
expand_macro() returns 1 if the replacement succeeded
and 0 if some error occurred.
A special case is "defined". This acts as a unary operator
on a single, unexpanded identifier, which may be surrounded
by parenthesis. The function expand_defined() handles this.
*/
register struct macro *mac = idf->id_macro;
struct args *args = repl->r_args;
register int ch;
if (mac->mc_nps != -1) { /* with parameter list */
if (mac->mc_flag & FUNC) {
/* the following assertion won't compile:
assert(!strcmp("defined", idf->id_text));
expand the assert macro by hand (??? dirty, temporary)
*/
#ifdef DEBUG
if (strcmp("defined", idf->id_text))
crash("in %s, %u: assertion %s failed",
__FILE__, __LINE__ - 2,
"strcmp(\"defined\", idf->id_text)");
#endif
if (!AccDefined) return 0;
expand_defined(repl);
return 1;
}
ch = GetChar();
ch = skipspaces(ch,1);
if (ch != '(') { /* no replacement if no () */
ChPushBack(ch);
return 0;
} else
getactuals(repl, idf);
}
if (mac->mc_flag & FUNC) /* this macro leads to special action */
macro_func(idf);
macro2buffer(repl, idf, args);
/* According to the ANSI definition:
#define a +
a+b; --> + + b ;
'a' must be substituded, but the result should be
three tokens: + + ID. Therefore a token separator is
inserted after the replacement.
*/
if (repl->r_text == repl->r_ptr || *(repl->r_ptr - 1) != TOKSEP) {
add2repl(repl, TOKSEP);
}
return 1;
}
void
expand_defined(repl)
register struct repl *repl;
{
register int ch = GetChar();
struct idf *id;
int parens = 0;
ch = skipspaces(ch, 0);
if (ch == '(') {
parens++;
ch = GetChar();
ch = skipspaces(ch, 0);
}
if ((class(ch) != STIDF) && (class(ch) != STELL)) {
error("identifier missing");
if (parens && ch != ')') error(") missing");
if (!parens || ch != ')') ChPushBack(ch);
add2repl(repl, '0');
return;
}
ChPushBack(ch);
id = GetIdentifier(0);
assert(id || class(ch) == STELL);
ch = GetChar();
ch = skipspaces(ch, 0);
if (parens && ch != ')') error(") missing");
if (!parens || ch != ')') ChPushBack(ch);
add2repl(repl, (id && id->id_macro) ? '1' : '0');
add2repl(repl, ' ');
}
newarg(args)
struct args *args;
{
args->a_expptr = args->a_expbuf = Malloc(args->a_expsize = ARGBUF);
args->a_rawptr = args->a_rawbuf = Malloc(args->a_rawsize = ARGBUF);
}
void
getactuals(repl, idf)
struct repl *repl;
register struct idf *idf;
{
/* Get the actual parameters from the input stream.
The hard part is done by actual(), only comma's and
other syntactic trivialities are checked here.
*/
register struct args *args = repl->r_args;
register int nps = idf->id_macro->mc_nps;
register int argcnt;
register int ch;
argcnt = 0;
newarg(args);
if ((ch = GetChar()) != ')') {
UnGetChar();
while ((ch = actual(repl)) != ')' ) {
if (ch != ',') {
lexerror("illegal macro call");
return;
}
stash(repl, '\0', 1);
args->a_expvec[argcnt] = args->a_expbuf;
args->a_rawvec[argcnt] = args->a_rawbuf;
++argcnt;
if (argcnt == STDC_NPARAMS)
lexstrict("number of parameters exceeds ANSI standard");
if (argcnt >= NPARAMS)
fatal("argument vector overflow");
newarg(args);
}
stash(repl, '\0', 1);
args->a_expvec[argcnt] = args->a_expbuf;
args->a_rawvec[argcnt] = args->a_rawbuf;
++argcnt;
}
if (argcnt < nps)
lexerror("too few macro arguments");
else if (argcnt > nps)
lexerror("too many macro arguments");
}
saveraw(repl)
struct repl *repl;
{
register struct repl *nrepl = ReplaceList;
register struct args *ap = nrepl->r_args;
register char *p;
/* stash identifier name */
for (p = nrepl->r_idf->id_text; *p != '\0'; p++)
stash(repl, *p, -1);
/* The following code deals with expanded function
like macro calls. It makes the following code
work:
#define def(a,b) x(a,b)
#define glue(a,b) a ## b
glue(abc,def(a,b))
Results in:
abcdef(a,b);
*/
if (ap->a_rawvec[0]) {
/* stash arguments */
register int i;
for (i = 0; ap->a_rawvec[i] != (char *)0; i++) {
if (i == 0) stash(repl, '(', -1);
else stash(repl, ',', -1);
for (p = ap->a_rawvec[i]; *p != '\0'; p++)
stash(repl, *p, -1);
}
stash(repl, ')', -1);
}
}
int
actual(repl)
struct repl *repl;
{
/* This routine deals with the scanning of an actual parameter.
It keeps in account the opening and closing brackets,
preprocessor numbers, strings and character constants.
*/
register int ch = 0;
register int level = 0, nostashraw = 0;
int lastch;
static int Unstacked_missed;
while (1) {
lastch = ch;
ch = GetChar();
if (nostashraw
&& nostashraw >= Unstacked_missed) {
nostashraw -= Unstacked_missed;
Unstacked_missed = 0;
}
if (Unstacked) {
nostashraw -= Unstacked;
if (nostashraw < 0) {
Unstacked_missed = -nostashraw;
nostashraw = 0;
}
EnableMacros();
}
if (class(ch) == STIDF || class(ch) == STELL) {
/* Scan a preprocessor identifier token. If the
token is a macro, it is expanded first.
*/
char buf[(IDFSIZE > NUMSIZE ? IDFSIZE : NUMSIZE) + 1];
register char *p = buf;
register struct idf *idef;
register int pos = -1;
extern int idfsize;
int NoExpandMacro;
if (ch == NOEXPM) {
NoExpandMacro= 1;
ch = GetChar();
} else NoExpandMacro = 0;
do {
if (++pos < idfsize) {
*p++ = ch;
}
ch = GetChar();
} while (in_idf(ch));
*p++ = '\0';
ch = '\0'; /* It could be an unstashed TOKSEP */
UnGetChar();
/* When the identifier has an associated macro
replacement list, it's expanded.
*/
idef = findidf(buf);
if (!idef || NoExpandMacro || !replace(idef)) {
if (NoExpandMacro
|| (idef && idef->id_macro
&& (idef->id_macro->mc_flag & NOREPLACE)))
stash(repl, NOEXPM, !nostashraw);
for (p = buf; *p != '\0'; p++)
stash(repl, *p, !nostashraw);
} else {
if (!nostashraw) saveraw(repl);
nostashraw++;
}
} else if (class(ch) == STNUM) {
/* a preprocessing number has the following
regular expression:
[0-9|"."[0-9]]{[0-9"."a-zA-Z_]|{[Ee][+-]}}*
*/
stash(repl, ch, !nostashraw);
if (ch == '.') {
ch = GetChar();
if (class(ch) != STNUM) {
ch = '\0'; /* It could be an unstashed TOKSEP */
UnGetChar();
continue;
}
else stash(repl, ch, !nostashraw);
}
ch = GetChar();
while (in_idf(ch) || ch == '.') {
stash(repl, ch, !nostashraw);
if ((ch = GetChar()) == 'e' || ch == 'E') {
stash(repl, ch, !nostashraw);
ch = GetChar();
if (ch == '+' || ch == '-') {
stash(repl, ch, !nostashraw);
ch = GetChar();
}
}
}
ch = '\0'; /* It could be an unstashed TOKSEP */
UnGetChar();
} else if (ch == '(') {
/* a comma may occur between parentheses */
level++;
stash(repl, ch, !nostashraw);
} else if (ch == ')') {
level--;
/* closing parenthesis of macro call */
if (level < 0) return ')';
stash(repl, ch, !nostashraw);
} else if (ch == ',') {
if (level <= 0) { /* comma separator for next argument */
if (level)
lexerror("unbalanced parenthesis");
if (!nostashraw)
return ','; /* ??? */
}
stash(repl, ch, !nostashraw);
} else if (ch == '\n') {
/* newlines are accepted as white spaces */
LineNumber++;
/* This piece of code needs some explanation:
consider the call of a macro defined as:
#define sum(a,b) (a+b)
in the following form:
sum(
/_* comment *_/ #include phone_number
,2);
in which case the include must be handled
interpreted as such.
*/
a_new_line: ch = GetChar();
while (class(ch) == STSKIP || ch == '/') {
if (ch == '/') {
if ((ch = GetChar()) == '*' && !InputLevel) {
skipcomment();
stash(repl, ' ', !nostashraw);
ch = GetChar();
continue;
} else {
UnGetChar();
ch = '/';
}
stash(repl, '/', !nostashraw);
break;
} else ch = GetChar();
}
if (ch == '#') {
domacro();
/* Clear File_Inserted since domacro could
* be called again, which calls GetToken().
*/
File_Inserted = 0;
goto a_new_line;
} else if (ch == EOI) {
lexerror("unterminated macro call");
return ')';
}
if (ch != '/') {
UnGetChar();
ch = ' ';
stash(repl, ' ', !nostashraw);
}
} else if (ch == '/') {
/* comments are treated as one white space token */
if ((ch = GetChar()) == '*' && !InputLevel) {
skipcomment();
stash(repl, ' ', !nostashraw);
} else {
UnGetChar();
ch = '/';
stash(repl, '/', !nostashraw);
}
} else if (ch == '\'' || ch == '"') {
/* Strings are considered as ONE token, thus no
replacement within strings.
*/
register int match = ch;
stash(repl, ch, !nostashraw);
while ((ch = GetChar()) != EOI) {
if (ch == match)
break;
if (ch == '\\') {
stash(repl, ch, !nostashraw);
ch = GetChar();
} else if (ch == '\n') {
lexerror("newline in string");
LineNumber++;
stash(repl, match, !nostashraw);
break;
}
stash(repl, ch, !nostashraw);
}
if (ch != match) {
lexerror("unterminated macro call");
return ')';
}
stash(repl, ch, !nostashraw);
} else {
if (lastch == TOKSEP && ch == TOKSEP) continue;
stash(repl, ch, !nostashraw);
}
}
}
macro_func(idef)
register struct idf *idef;
{
/* macro_func() performs the special actions needed with some
macros. These macros are __FILE__ and __LINE__ which
replacement texts must be evaluated at the time they are
used.
*/
register struct macro *mac = idef->id_macro;
static char FilNamBuf[PATHLENGTH];
switch (idef->id_text[2]) {
case 'F': /* __FILE__ */
FilNamBuf[0] = '"';
strcpy(&FilNamBuf[1], FileName);
strcat(FilNamBuf, "\"");
mac->mc_text = FilNamBuf;
mac->mc_length = strlen(FilNamBuf);
break;
case 'L': /* __LINE__ */
mac->mc_text = long2str((long)LineNumber, 10);
mac->mc_length = strlen(mac->mc_text);
break;
default:
crash("(macro_func)");
/*NOTREACHED*/
}
}
void
macro2buffer(repl, idf, args)
register struct repl *repl;
register struct idf *idf;
register struct args *args;
{
/* macro2buffer expands the replacement list and places the
result onto the replacement buffer. It deals with the #
and ## operators, and inserts the actual parameters.
The argument buffer contains the raw argument (needed
for the ## operator), and the expanded argument (for
all other parameter substitutions).
The grammar of the replacement list is:
repl_list: TOKEN repl_list
| PARAMETER repl_list
| '#' PARAMETER
| TOKEN '##' TOKEN
| PARAMETER '##' TOKEN
| TOKEN '##' PARAMETER
| PARAMETER '##' PARAMETER
;
As the grammar indicates, we could make a DFA and
use this finite state machine for the replacement
list parsing (inserting the arguments, etc.).
Currently we go through the replacement list in a
linear fashion. This is VERY expensive, something
smarter should be done (but even a DFA is O(|s|)).
*/
register char *ptr = idf->id_macro->mc_text;
int err = 0;
int func = idf->id_macro->mc_nps != -1;
char *stringify();
assert(ptr[idf->id_macro->mc_length] == '\0');
while (*ptr) {
if (*ptr == '\'' || *ptr == '"') {
register int delim = *ptr;
do {
add2repl(repl, *ptr);
if (*ptr == '\\')
add2repl(repl, *++ptr);
if (*ptr == '\0') {
lexerror("unterminated string");
return;
}
ptr++;
} while (*ptr != delim || *ptr == '\0');
add2repl(repl, *ptr++);
} else if (*ptr == '#' && (func || *(ptr+1) == '#')) {
if (*++ptr == '#') {
register int tmpindex;
/* ## - paste operator */
ptr++;
/* trim the actual replacement list */
--repl->r_ptr;
while (repl->r_ptr >= repl->r_text
&& is_wsp(*repl->r_ptr))
--repl->r_ptr;
/* ## occurred at the beginning of the replacement list.
*/
if (repl->r_ptr < repl->r_text) {
err = 1;
break;
}
if (repl->r_ptr >= repl->r_text
&& *repl->r_ptr == TOKSEP)
--repl->r_ptr;
++repl->r_ptr;
tmpindex = repl->r_ptr - repl->r_text;
/* tmpindex can be 0 */
/* skip space in macro replacement list */
while ((*ptr & FORMALP) == 0 && is_wsp(*ptr))
ptr++;
/* ## occurred at the end of the replacement list.
*/
if (*ptr & FORMALP) {
register int n = *ptr++ & 0177;
register char *p;
assert(n > 0);
p = args->a_rawvec[n-1];
if (p) { /* else macro argument missing */
while (is_wsp(*p)) p++;
if (*p == NOEXPM) p++;
while (*p)
add2repl(repl, *p++);
}
while (tmpindex > 0
&& in_idf(repl->r_text[tmpindex]))
tmpindex--;
if (tmpindex >= 0
&& repl->r_text[tmpindex] == NOEXPM)
repl->r_text[tmpindex] = TOKSEP;
} else if (*ptr == '\0') {
err = 1;
break;
} else {
if (in_idf(*ptr)) {
tmpindex--;
while (tmpindex > 0
&& in_idf(repl->r_text[tmpindex]))
tmpindex--;
if (tmpindex >= 0
&& repl->r_text[tmpindex] == NOEXPM)
repl->r_text[tmpindex] = TOKSEP;
}
}
} else { /* # operator */
ptr = stringify(repl, ptr, args);
}
} else if (*ptr & FORMALP) {
/* insert actual parameter */
register int n = *ptr++ & 0177;
register char *p, *q;
assert(n > 0);
/* This is VERY dirty, we look ahead for the
## operator. If it's found we use the raw
argument buffer instead of the expanded
one.
*/
for (p = ptr; (*p & FORMALP) == 0 && is_wsp(*p); p++)
/* EMPTY */;
if (*p == '#' && p[1] == '#')
q = args->a_rawvec[n-1];
else
q = args->a_expvec[n-1];
if (q) /* else macro argument missing */
while (*q)
add2repl(repl, *q++);
if (repl->r_text == repl->r_ptr || *(repl->r_ptr - 1) != TOKSEP)
add2repl(repl, TOKSEP);
} else {
add2repl(repl, *ptr++);
}
}
if (err)
lexerror("illegal use of the ## operator");
}
char *
stringify(repl, ptr, args)
register struct repl *repl;
register char *ptr;
register struct args *args;
{
/* If a parameter is immediately preceded by a # token
both are replaced by a single string literal that
contains the spelling of the token sequence for the
corresponding argument.
Each occurrence of white space between the argument's
tokens become a single space character in the string
literal. White spaces before the first token and after
the last token comprising the argument are deleted.
To retain the original spelling we insert backslashes
as appropriate. We only escape backslashes if they
occure within string tokens.
*/
register int space = 1; /* skip leading spaces */
register int delim = 0; /* string or character constant delim */
register int backslash = 0; /* last character was a \ */
/* skip spaces macro replacement list */
while ((*ptr & FORMALP) == 0 && is_wsp(*ptr))
ptr++;
if (*ptr & FORMALP) {
register int n = *ptr++ & 0177;
register char *p;
assert(n != 0);
p = args->a_rawvec[n-1];
add2repl(repl, '"');
while (*p) {
if (is_wsp(*p)) {
if (!space) {
space = 1;
add2repl(repl, ' ');
}
p++;
continue;
}
space = 0;
if (!delim && (*p == '"' || *p == '\''))
delim = *p;
else if (*p == delim && !backslash)
delim = 0;
backslash = *p == '\\';
if (*p == '"' || (delim && *p == '\\'))
add2repl(repl, '\\');
if (*p == TOKSEP || *p == NOEXPM) p++;
else add2repl(repl, *p++);
}
/* trim spaces in the replacement list */
for (--repl->r_ptr; is_wsp(*repl->r_ptr); repl->r_ptr--)
/* EMPTY */;
++repl->r_ptr; /* oops, one to far */
add2repl(repl, '"');
} else
error("illegal use of # operator");
return ptr;
}
/* The following routine is also called from domacro.c.
*/
add2repl(repl, ch)
register struct repl *repl;
int ch;
{
register int index = repl->r_ptr - repl->r_text;
assert(index < repl->r_size);
if (index + 2 >= repl->r_size) {
repl->r_text = Realloc(repl->r_text, (unsigned) (repl->r_size <<= 1));
repl->r_ptr = repl->r_text + index;
}
*repl->r_ptr++ = ch;
*repl->r_ptr = '\0';
}
/* If the variable stashraw is negative, we must only stash into the raw
* buffer. If the variable is zero, we must only stash into the expanded
* buffer. Otherwise, we must use both buffers.
*/
stash(repl, ch, stashraw)
struct repl *repl;
register int ch;
int stashraw;
{
/* Stash characters into the macro expansion buffer.
*/
register struct args *args = repl->r_args;
register int index = args->a_expptr - args->a_expbuf;
if (stashraw >= 0) {
assert(index < args->a_expsize);
if (index + 1 >= args->a_expsize) {
args->a_expbuf = Realloc(args->a_expbuf,
(unsigned) (args->a_expsize <<= 1));
args->a_expptr = args->a_expbuf + index;
}
*args->a_expptr++ = ch;
}
if (stashraw) {
index = args->a_rawptr - args->a_rawbuf;
assert(index < args->a_rawsize);
if (index + 1 >= args->a_rawsize) {
args->a_rawbuf = Realloc(args->a_rawbuf,
(unsigned)(args->a_rawsize <<= 1));
args->a_rawptr = args->a_rawbuf + index;
}
*args->a_rawptr++ = ch;
}
}
#endif /* NOPP */

51
lang/cem/cemcom.ansi/replace.str
View file

@ -1,51 +0,0 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*/
/* $Id$ */
/* DEFINITIONS FOR THE MACRO REPLACEMENT ROUTINES */
struct repl {
struct repl *next;
struct idf *r_idf; /* name of the macro */
struct args *r_args; /* replacement parameters */
int r_level; /* level of insertion */
int r_size; /* current size of replacement buffer */
char *r_ptr; /* replacement text index pointer */
char *r_text; /* replacement text */
};
/* ALLOCDEF "repl" 4 */
#define NO_REPL (struct repl *)0
/* The implementation of the ## operator is currently very clumsy.
When the the ## operator is used the arguments are taken from
the raw buffer; this buffer contains a precise copy of the
original argument. The fully expanded copy is in the arg buffer.
The two copies are here explicitely because:
#define ABC f()
#define ABCD 2
#define g(x, y) x ## y + h(x)
g(ABC, D); // gives: 2 + h(f())
In this case we need two copies: one raw copy for the pasting
operator, and an expanded one as argument for h().
*/
struct args {
char *a_expptr; /* expanded argument index pointer */
char *a_expbuf; /* expanded argument buffer pointer */
int a_expsize; /* current size of expanded buffer */
char *a_expvec[NPARAMS]; /* expanded argument vector */
char *a_rawptr; /* raw argument index pointer */
char *a_rawbuf; /* raw argument buffer pointer */
int a_rawsize; /* current size of raw buffer */
char *a_rawvec[NPARAMS]; /* raw argument vector */
};
/* ALLOCDEF "args" 2 */
#define NO_ARGS (struct args *)0

91
lang/cem/cemcom.ansi/skip.c
View file

@ -5,100 +5,23 @@
/* $Id$ */
/* PREPROCESSOR: INPUT SKIP FUNCTIONS */
#include "parameters.h"
#include "arith.h"
#include "LLlex.h"
#include "class.h"
#include "input.h"
#include "parameters.h"
#include "arith.h"
#include "LLlex.h"
#include "class.h"
#include "input.h"
#ifndef NOPP
extern int InputLevel;
int
skipspaces(ch, skipnl)
register int ch;
{
/* skipspaces() skips any white space and returns the first
non-space character.
*/
register int nlseen = 0;
for (;;) {
while (class(ch) == STSKIP)
ch = GetChar();
if (skipnl && class(ch) == STNL) {
ch = GetChar();
LineNumber++;
nlseen++;
continue;
}
if (ch == TOKSEP && InputLevel) {
ch = GetChar();
continue;
}
/* \\\n are handled by trigraph */
if (ch == '/') {
ch = GetChar();
if (ch == '*' && !InputLevel) {
skipcomment();
ch = GetChar();
}
else {
UnGetChar();
return '/';
}
}
else if (nlseen && ch == '#') {
domacro();
ch = GetChar();
} else
return ch;
}
}
#endif /* NOPP */
SkipToNewLine()
{
register int ch;
register int garbage = 0;
#ifndef NOPP
register int delim = 0;
#endif
while ((ch = GetChar()) != '\n') {
#ifndef NOPP
if (delim) {
if (ch == '\\') {
if (GetChar() == '\n') break;
} else if (ch == delim) {
delim = 0;
}
continue;
}
else if (ch == '\'' || ch == '\"') {
delim = ch;
garbage = 1;
} else if (ch == '/') {
if (GetChar() == '*'
&& !InputLevel
) {
skipcomment();
continue;
}
else UnGetChar();
}
else if (ch == TOKSEP && InputLevel) {
continue;
}
#endif
while ((ch = GetChar()) != '\n')
{
if (!is_wsp(ch))
garbage = 1;
}
#ifndef NOPP
if (delim) strict("unclosed opening %c", delim);
#endif
++LineNumber;
return garbage;
}

896
lang/cem/cpp.ansi/LLlex.c
View file

File diff suppressed because it is too large Load diff

3
lang/cem/cpp.ansi/build.lua
View file

@ -108,7 +108,8 @@ cprogram {
installable {
name = "pkg",
map = {
["$(PLATDEP)/cpp.ansi"] = "+cpp"
["$(PLATDEP)/cpp.ansi"] = "+cpp",
["$(INSDIR)/share/man/man6/cpp.ansi.6"] = "./ncpp.6",
}
}

853
lang/cem/cpp.ansi/domacro.c
View file

File diff suppressed because it is too large Load diff

695
lang/cem/cpp.ansi/preprocess.c
View file

@ -5,92 +5,113 @@
/* $Id$ */
/* PREPROCESSOR DRIVER */
#include <stdlib.h>
#include <stdio.h>
#include <system.h>
#include <alloc.h>
#include "input.h"
#include "parameters.h"
#include "arith.h"
#include "LLlex.h"
#include "class.h"
#include "macro.h"
#include "idf.h"
#include "bits.h"
#include <stdlib.h>
#include <stdio.h>
#include <system.h>
#include <alloc.h>
#include "input.h"
#include "parameters.h"
#include "arith.h"
#include "LLlex.h"
#include "class.h"
#include "macro.h"
#include "idf.h"
#include "bits.h"
char _obuf[OBUFSIZE];
char _obuf[OBUFSIZE];
#ifdef DOBITS
char bits[128];
char bits[128];
#endif
extern int InputLevel;
extern char *sprint();
extern char* sprint();
Xflush()
{
sys_write(STDOUT, _obuf, OBUFSIZE);
}
static char *SkipComment();
static char* SkipComment();
extern char options[];
/* #pragma directives are saved here and passed to the compiler later on.
*/
struct prag_info {
int pr_linnr;
char *pr_fil;
char *pr_text;
struct prag_info
{
int pr_linnr;
char* pr_fil;
char* pr_text;
};
static struct prag_info *pragma_tab;
static struct prag_info* pragma_tab;
static int pragma_nr;
do_pragma()
{
register int size = ITEXTSIZE;
char *cur_line = Malloc((unsigned)size);
register char *c_ptr = cur_line;
char* cur_line = Malloc((unsigned)size);
register char* c_ptr = cur_line;
register int c = GetChar();
register int delim = 0;
while(c != '\n') {
if (c_ptr + 1 - cur_line == size) {
while (c != '\n')
{
if (c_ptr + 1 - cur_line == size)
{
cur_line = Realloc(cur_line, (unsigned)(size + ITEXTSIZE));
c_ptr = cur_line + size - 1;
size += ITEXTSIZE;
}
if (delim) {
if (c == delim) {
if (delim)
{
if (c == delim)
{
delim = 0;
}
else if (c == '\\') {
else if (c == '\\')
{
*c_ptr++ = c;
c = GetChar();
if (c == '\n') break;
if (c == '\n')
break;
}
}
else if (c == '\'' || c == '"') {
else if (c == '\'' || c == '"')
{
delim = c;
}
else if (c == '/') {
if ((c = GetChar()) != '*' || InputLevel) {
else if (c == '/')
{
if (!InputLevel)
{
c = GetChar();
if (c == '*')
{
skipcomment();
continue;
}
else if (c == '/')
{
skiplinecomment();
continue;
}
*c_ptr++ = '/';
}
else {
skipcomment();
continue;
}
}
*c_ptr++ = c;
c = GetChar();
}
*c_ptr = '\0';
if (!pragma_nr) {
pragma_tab = (struct prag_info *)Malloc(sizeof(struct prag_info));
} else {
pragma_tab = (struct prag_info *)Realloc((char *)pragma_tab
, (unsigned)(sizeof(struct prag_info) * (pragma_nr+1)));
if (!pragma_nr)
{
pragma_tab = (struct prag_info*)Malloc(sizeof(struct prag_info));
}
if (delim) {
else
{
pragma_tab = (struct prag_info*)Realloc(
(char*)pragma_tab, (unsigned)(sizeof(struct prag_info) * (pragma_nr + 1)));
}
if (delim)
{
error("unclosed opening %c", delim);
}
pragma_tab[pragma_nr].pr_linnr = LineNumber;
@ -102,138 +123,188 @@ do_pragma()
char Xbuf[256];
void
preprocess(fn)
char *fn;
void preprocess(fn) char* fn;
{
register int c;
register char *op = _obuf;
register char *ob = &_obuf[OBUFSIZE];
register char* op = _obuf;
register char* ob = &_obuf[OBUFSIZE];
int lineno = 0;
int startline;
#define flush(X) (sys_write(STDOUT,_obuf,X))
#define echo(ch) if (op == ob) { Xflush(); op = _obuf; } *op++ = (ch);
#define newline() op--; while (op >= _obuf && (*op == ' ' || *op == '\t')) op--; op++; echo('\n')
#define flush(X) (sys_write(STDOUT, _obuf, X))
#define echo(ch) \
if (op == ob) \
{ \
Xflush(); \
op = _obuf; \
} \
*op++ = (ch);
#define newline() \
op--; \
while (op >= _obuf && (*op == ' ' || *op == '\t')) \
op--; \
op++; \
echo('\n')
if (!options['P']) {
if (!options['P'])
{
/* Generate a line directive communicating the
source filename
*/
register char *p = Xbuf;
register char* p = Xbuf;
sprint(p, "%s 1 \"%s\"\n",
LINE_PREFIX,
FileName);
while (*p) {
sprint(p, "%s 1 \"%s\"\n", LINE_PREFIX, FileName);
while (*p)
{
echo(*p++);
}
}
#define do_line_dir(lineno, fn) \
if (lineno != LineNumber || fn != FileName) { \
fn = FileName; \
lineno = LineNumber; \
if (! options['P']) { \
register char *p = Xbuf; \
sprint(Xbuf, "%s %d \"%s\"\n", \
LINE_PREFIX, \
(int)LineNumber, \
FileName); \
op--; \
while (op >= _obuf \
&& (class(*op) == STSKIP \
|| *op == '\n')) op--; \
op++; \
newline(); \
while (*p) { \
echo(*p++); \
} \
} \
}
#define do_line_dir(lineno, fn) \
if (lineno != LineNumber || fn != FileName) \
{ \
fn = FileName; \
lineno = LineNumber; \
if (!options['P']) \
{ \
register char* p = Xbuf; \
sprint(Xbuf, "%s %d \"%s\"\n", LINE_PREFIX, (int)LineNumber, FileName); \
op--; \
while (op >= _obuf && (class(*op) == STSKIP || *op == '\n')) \
op--; \
op++; \
newline(); \
while (*p) \
{ \
echo(*p++); \
} \
} \
}
for (;;) {
for (;;)
{
LineNumber++;
lineno++;
startline = 1;
c = GetChar();
while (startline) {
/* first flush the saved pragma's */
if (pragma_nr) {
while (startline)
{
/* first flush the saved pragma's */
if (pragma_nr)
{
register int i = 0;
int LiNo = LineNumber;
char *FiNam = FileName;
while (i < pragma_nr) {
register char *c_ptr = "#pragma";
LineNumber = pragma_tab[i].pr_linnr;
FileName = pragma_tab[i].pr_fil;
do_line_dir(lineno, fn);
while (*c_ptr) { echo(*c_ptr++); }
c_ptr = pragma_tab[i].pr_text;
while (*c_ptr) { echo(*c_ptr++); }
newline(); lineno++;
free(pragma_tab[i].pr_text);
i++;
char* FiNam = FileName;
while (i < pragma_nr)
{
register char* c_ptr = "#pragma";
LineNumber = pragma_tab[i].pr_linnr;
FileName = pragma_tab[i].pr_fil;
do_line_dir(lineno, fn);
while (*c_ptr)
{
echo(*c_ptr++);
}
c_ptr = pragma_tab[i].pr_text;
while (*c_ptr)
{
echo(*c_ptr++);
}
newline();
lineno++;
free(pragma_tab[i].pr_text);
i++;
}
free((char *) pragma_tab);
pragma_tab = (struct prag_info *)0;
free((char*)pragma_tab);
pragma_tab = (struct prag_info*)0;
pragma_nr = 0;
LineNumber = LiNo;
FileName = FiNam;
do_line_dir(lineno, fn);
}
}
while (class(c) == STSKIP || c == '/') {
if (c == '/') {
if (!InputLevel) {
c = GetChar();
if (c == '*') {
op = SkipComment(op, &lineno);
if (!op) return;
if (!options['C']) { echo(' '); }
c = GetChar();
continue;
while (class(c) == STSKIP || c == '/')
{
if (c == '/')
{
if (!InputLevel)
{
c = GetChar();
if (c == '*')
{
op = SkipComment(op, &lineno);
if (!op)
return;
if (!options['C'])
{
echo(' ');
}
c = GetChar();
continue;
}
else if (c == '/')
{
skiplinecomment();
c = GetChar();
continue;
}
UnGetChar();
c = '/';
}
UnGetChar();
c = '/';
}
break;
break;
}
echo(c);
c = GetChar();
}
}
if (c == '#') {
if (c == '#')
{
domacro();
lineno++;
newline();
do_line_dir(lineno, fn);
c = GetChar();
} else startline = 0;
}
else
startline = 0;
}
do_line_dir(lineno, fn);
for (;;) {
for (;;)
{
/* illegal character */
if (c & 0200) {
if (c == EOI) {
if (c & 0200)
{
if (c == EOI)
{
newline();
flush((int)(op-_obuf));
flush((int)(op - _obuf));
return;
}
fatal("non-ascii character read");
}
/* comments */
if (c == '/' && !InputLevel) {
if (c == '/' && !InputLevel)
{
c = GetChar();
if (c == '*') {
if (c == '*')
{
op = SkipComment(op, &lineno);
if (!op) return;
if (!options['C']) { echo(' '); }
if (!op)
return;
if (!options['C'])
{
echo(' ');
}
c = GetChar();
continue;
}
else if (c == '/')
{
skiplinecomment();
c = GetChar();
continue;
}
@ -242,164 +313,221 @@ preprocess(fn)
}
/* switch on character */
switch(class(c)) {
case STNL:
newline();
break;
case STSTR:
case STCHAR:
switch (class(c))
{
case STNL:
newline();
break;
case STSTR:
case STCHAR:
{
register int stopc = c;
int escaped;
register int stopc = c;
int escaped;
do {
escaped = 0;
echo(c);
c = GetChar();
if (c == '\n') {
/* the compiler will complain */
break;
}
else if (c == EOI) {
newline();
flush((int)(op-_obuf));
return;
}
if (c == '\\') {
do
{
escaped = 0;
echo(c);
c = GetChar();
if (c == '\n') {
++LineNumber;
lineno++;
} else escaped = 1;
}
} while (escaped || c != stopc);
echo(c);
if (c == '\n')
break; /* Don't eat # */
c = GetChar();
continue;
}
case STNUM:
/* The following code is quit ugly. This because
* ..3 == . .3 , whereas ...3 == ... 3
*/
echo(c);
if (c == '.') {
if (c == '\n')
{
/* the compiler will complain */
break;
}
else if (c == EOI)
{
newline();
flush((int)(op - _obuf));
return;
}
if (c == '\\')
{
echo(c);
c = GetChar();
if (c == '\n')
{
++LineNumber;
lineno++;
}
else
escaped = 1;
}
} while (escaped || c != stopc);
echo(c);
if (c == '\n')
break; /* Don't eat # */
c = GetChar();
if (c == '.') {
if ((c = GetChar()) == '.') {
echo('.'); echo('.');
continue;
}
case STNUM:
/* The following code is quit ugly. This because
* ..3 == . .3 , whereas ...3 == ... 3
*/
echo(c);
if (c == '.')
{
c = GetChar();
if (c == '.')
{
if ((c = GetChar()) == '.')
{
echo('.');
echo('.');
c = GetChar();
continue;
}
UnGetChar();
c = '.';
continue;
}
else if (!is_dig(c))
{
continue;
}
else
{
echo(c);
}
}
c = GetChar();
while (in_idf(c) || c == '.')
{
echo(c);
if (c == 'e' || c == 'E')
{
c = GetChar();
if (c == '+' || c == '-')
{
echo(c);
c = GetChar();
}
}
else
c = GetChar();
}
continue;
case STELL:
c = GetChar();
UnGetChar();
if (c == '"' || c == '\'')
{
echo('L');
continue;
}
c = 'L';
case STIDF:
{
extern int idfsize; /* ??? */
char buf[IDFSIZE + 1];
register char* tg = &buf[0];
register char* maxpos = &buf[idfsize];
register struct idf* idef;
int NoExpandNext = 0;
#define tstmac(bx) \
if (!(bits[c] & bx)) \
goto nomac
#define cpy *tg++ = c
#define load \
c = GetChar(); \
if (!in_idf(c)) \
goto endidf
/* unstack macro's when allowed. */
if (Unstacked)
EnableMacros();
if (c == NOEXPM)
{
NoExpandNext = 1;
c = GetChar();
}
#ifdef DOBITS
cpy;
tstmac(bit0);
load;
cpy;
tstmac(bit1);
load;
cpy;
tstmac(bit2);
load;
cpy;
tstmac(bit3);
load;
cpy;
tstmac(bit4);
load;
cpy;
tstmac(bit5);
load;
cpy;
tstmac(bit6);
load;
cpy;
tstmac(bit7);
load;
#endif
for (;;)
{
if (tg < maxpos)
{
cpy;
}
load;
}
endidf:
if (c != EOF)
UnGetChar();
*tg = '\0'; /* mark the end of the identifier */
if ((idef = findidf(buf)) && idef->id_macro && ReplaceMacros && !NoExpandNext)
{
if (replace(idef))
{
echo(' ');
c = GetChar();
continue;
}
UnGetChar();
c = '.';
continue;
} else if (!is_dig(c)) {
continue;
} else { echo(c); }
}
c = GetChar();
while (in_idf(c) || c == '.') {
echo(c);
if (c == 'e' || c == 'E') {
c = GetChar();
if (c == '+' || c == '-') {
echo(c);
c = GetChar();
tg = buf;
while (*tg)
{
echo(*tg++);
}
} else c = GetChar();
}
continue;
case STELL:
c = GetChar();
UnGetChar();
if (c == '"' || c == '\'') {
echo('L');
continue;
}
c = 'L';
case STIDF: {
extern int idfsize; /* ??? */
char buf[IDFSIZE + 1];
register char *tg = &buf[0];
register char *maxpos = &buf[idfsize];
register struct idf *idef;
int NoExpandNext = 0;
#define tstmac(bx) if (!(bits[c] & bx)) goto nomac
#define cpy *tg++ = c
#define load c = GetChar(); if (!in_idf(c)) goto endidf
/* unstack macro's when allowed. */
if (Unstacked)
EnableMacros();
if (c == NOEXPM) {
NoExpandNext = 1;
c = GetChar();
}
#ifdef DOBITS
cpy; tstmac(bit0); load;
cpy; tstmac(bit1); load;
cpy; tstmac(bit2); load;
cpy; tstmac(bit3); load;
cpy; tstmac(bit4); load;
cpy; tstmac(bit5); load;
cpy; tstmac(bit6); load;
cpy; tstmac(bit7); load;
#endif
for(;;) {
if (tg < maxpos) {
cpy;
}
load;
}
endidf:
if (c != EOF) UnGetChar();
*tg = '\0'; /* mark the end of the identifier */
if ((idef = findidf(buf))
&& idef->id_macro
&& ReplaceMacros && !NoExpandNext) {
if (replace(idef)) {
echo(' ');
c = GetChar();
if (in_idf(c))
{
echo(' ');
}
continue;
}
nomac:
*tg = '\0';
tg = buf;
while (*tg) {
while (*tg)
{
echo(*tg++);
}
c = GetChar();
if (in_idf(c)) { echo(' '); }
while (in_idf(c))
{
echo(c);
c = GetChar();
}
continue;
}
nomac:
*tg = '\0';
tg = buf;
while (*tg) {
echo(*tg++);
}
c = GetChar();
while (in_idf(c)) {
case STMSPEC:
if (InputLevel)
{
echo(' '); /* seperate tokens */
c = GetChar();
continue;
}
/* else fallthrough */
default:
echo(c);
c = GetChar();
}
continue;
}
case STMSPEC:
if (InputLevel) {
echo(' '); /* seperate tokens */
c = GetChar();
continue;
}
/* else fallthrough */
default:
echo(c);
c = GetChar();
continue;
}
break;
}
@ -407,49 +535,60 @@ preprocess(fn)
/*NOTREACHED*/
}
static char *
SkipComment(op, lineno)
char *op;
int *lineno;
static char* SkipComment(op, lineno) char* op;
int* lineno;
{
char *ob = &_obuf[OBUFSIZE];
char* ob = &_obuf[OBUFSIZE];
register int c, oldc = '\0';
NoUnstack++;
if (options['C']) {
if (options['C'])
{
echo('/');
echo('*');
}
c = GetChar();
for(;;) {
if (c == EOI) {
for (;;)
{
if (c == EOI)
{
newline();
flush((int)(op - _obuf));
op = 0;
break;
}
if (options['C']) {
if (options['C'])
{
echo(c);
}
if (c == '\n') {
if (c == '\n')
{
++LineNumber;
++*lineno;
if (!options['C']) {
if (!options['C'])
{
echo(c);
}
}
if (c == '*') {
if (c == '*')
{
c = GetChar();
if (c == '/') {
if (options['C']) {
if (c == '/')
{
if (options['C'])
{
echo(c);
}
break; /* for(;;) */
} else if (oldc == '/') {
break; /* for(;;) */
}
else if (oldc == '/')
{
warning("comment inside comment ?");
}
oldc = '*';
} else {
}
else
{
oldc = c;
c = GetChar();
}

94
lang/cem/cpp.ansi/skip.c
View file

@ -5,53 +5,64 @@
/* $Id$ */
/* PREPROCESSOR: INPUT SKIP FUNCTIONS */
#include "arith.h"
#include "LLlex.h"
#include "class.h"
#include "input.h"
#include "arith.h"
#include "LLlex.h"
#include "class.h"
#include "input.h"
extern int InputLevel;
int
skipspaces(ch, skipnl)
register int ch;
int skipspaces(ch, skipnl) register int ch;
{
/* skipspaces() skips any white space and returns the first
non-space character.
non-space character.
*/
register int nlseen = 0;
for (;;) {
for (;;)
{
while (class(ch) == STSKIP)
ch = GetChar();
if (skipnl && class(ch) == STNL) {
if (skipnl && class(ch) == STNL)
{
ch = GetChar();
LineNumber++;
nlseen++;
continue;
}
if (ch == TOKSEP && InputLevel) {
if (ch == TOKSEP && InputLevel)
{
ch = GetChar();
continue;
}
/* \\\n are handled by trigraph */
if (ch == '/') {
if (ch == '/')
{
ch = GetChar();
if (ch == '*' && !InputLevel) {
if (ch == '*' && !InputLevel)
{
skipcomment();
ch = GetChar();
}
else {
else if (ch == '/' && !InputLevel)
{
skiplinecomment();
ch = GetChar();
}
else
{
UnGetChar();
return '/';
}
}
else if (nlseen && ch == '#') {
else if (nlseen && ch == '#')
{
domacro();
ch = GetChar();
} else
}
else
return ch;
}
}
@ -62,31 +73,54 @@ SkipToNewLine()
register int garbage = 0;
register int delim = 0;
while ((ch = GetChar()) != '\n') {
if (delim) {
if (ch == '\\') {
if (GetChar() == '\n') break;
} else if (ch == delim) {
while ((ch = GetChar()) != '\n')
{
if (delim)
{
if (ch == '\\')
{
if (GetChar() == '\n')
break;
}
else if (ch == delim)
{
delim = 0;
}
continue;
} else if (ch == '\'' || ch == '\"') {
}
else if (ch == '\'' || ch == '\"')
{
delim = ch;
garbage = 1;
} else if (ch == '/') {
if (GetChar() == '*' && !InputLevel) {
skipcomment();
continue;
}
else UnGetChar();
}
else if (ch == TOKSEP && InputLevel) {
else if (ch == '/')
{
if (!InputLevel)
{
int nch = GetChar();
if (nch == '*')
{
skipcomment();
continue;
}
else if (nch == '/')
{
skiplinecomment();
continue;
}
else
UnGetChar();
}
}
else if (ch == TOKSEP && InputLevel)
{
continue;
}
if (!is_wsp(ch))
garbage = 1;
}
if (delim) strict("unclosed opening %c", delim);
if (delim)
strict("unclosed opening %c", delim);
++LineNumber;
return garbage;
}

4
lang/cem/libcc.ansi/sys/exit/exit.c
View file

@ -15,8 +15,8 @@ int __funccnt = 0;
void exit(int status)
{
/* "Called in reversed order of their registration" */
while (__funccnt >= 0)
(*__functab[__funccnt])();
while (__funccnt)
(*__functab[--__funccnt])();
_exit(status);
}

1
lang/m2/comp/build.lua
View file

@ -111,6 +111,7 @@ cprogram {
"+real_h",
"+type_h",
"h+emheaders",
"lang/m2/include+headers",
"modules+headers",
"modules/src/alloc+lib",
"modules/src/data+lib",

4
lang/m2/include/build.lua Normal file
View file

@ -0,0 +1,4 @@
clibrary {
name = "headers",
hdrs = {"./*.h"}
}

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 Normal file
View file

@ -0,0 +1,16 @@
/* $Id$ */
/*
* (c) copyright 1990 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*/
/* Modula-2 runtime errors */
#define M2_TOOLARGE 64 /* stack of process too large */
#define M2_TOOMANY 65 /* too many nested traps & handlers */
#define M2_NORESULT 66 /* no RETURN from procedure function */
#define M2_UOVFL 67 /* cardinal overflow */
#define M2_FORCH 68 /* FOR-loop control variable changed */
#define M2_UUVFL 69 /* cardinal underflow */
#define M2_INTERNAL 70 /* internal error, should not happen */
#define M2_UNIXSIG 71 /* unix signal */

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

@ -8,66 +8,65 @@
Author: Ceriel J.H. Jacobs
Version: $Id$
*/
#include "libm2.h"
extern char **argv, **environ;
extern int argc;
unsigned int _Arguments__Argc;
static char *
findname(s1, s2)
register char *s1, *s2;
static char* findname(char* s1, char* s2)
{
while (*s1 == *s2++) s1++;
if (*s1 == '\0' && *(s2-1) == '=') return s2;
while (*s1 == *s2++)
s1++;
if (*s1 == '\0' && *(s2 - 1) == '=')
return s2;
return 0;
}
static unsigned int
scopy(src, dst, max)
register char *src, *dst;
unsigned int max;
static unsigned int scopy(char* src, char* dst, unsigned int max)
{
register unsigned int i = 0;
while (*src && i <= max) {
while (*src && i <= max)
{
i++;
*dst++ = *src++;
}
if (i <= max) {
if (i <= max)
{
*dst = '\0';
return i+1;
return i + 1;
}
while (*src++) i++;
while (*src++)
i++;
return i + 1;
}
_Arguments_()
void _Arguments_(void)
{
_Arguments__Argc = argc;
}
unsigned
_Arguments__Argv(n, argument, l, u, s)
unsigned int u;
char *argument;
unsigned int _Arguments__Argv(int n, char* argument, int l, unsigned int u, int s)
{
if (n >= argc) return 0;
if (n >= argc)
return 0;
return scopy(argv[n], argument, u);
}
unsigned
_Arguments__GetEnv(name, nn, nu, ns, value, l, u, s)
char *name, *value;
unsigned int nu, u;
unsigned int _Arguments__GetEnv(
char* name, int nn, unsigned int nu, int ns, char* value, int l, unsigned int u, int s)
{
register char **p = environ;
register char *v = 0;
register char** p = environ;
register char* v = 0;
while (*p && !(v = findname(name, *p++))) {
while (*p && !(v = findname(name, *p++)))
{
/* nothing */
}
if (!v) return 0;
if (!v)
return 0;
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
using the topsize, topsave, and topload facilities.
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,
the user specifies this space.
An implementation of the Modula-2 NEWPROCESS and TRANSFER facilities
using the topsize, topsave, and topload facilities.
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,
the user specifies this space.
*/
#include <unistd.h>
#include "libm2.h"
#include <m2_traps.h>
#define MAXMAIN 2048
#define MAXMAIN 2048
struct proc {
unsigned size; /* size of saved stackframe(s) */
int (*proc)(); /* address of coroutine procedure */
char *brk; /* stack break of this coroutine */
};
static struct proc mainproc[MAXMAIN / sizeof(struct proc) + 1];
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];
static struct proc *curproc = 0;/* current coroutine */
extern char *MainLB; /* stack break of main routine */
_SYSTEM__NEWPROCESS(p, a, n, p1)
int (*p)(); /* coroutine procedure */
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) */
void _SYSTEM__NEWPROCESS(
int (*p)(void) /* coroutine procedure */,
struct proc* a /* pointer to area for saved stack-frame */,
unsigned int 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
transfer control to it. The routine "topsize" will compute the
stack break, which will be the local base of this routine.
Notice that we can do this because we do not need the stack
above this point for this coroutine. In Modula-2, coroutines
must be level 0 procedures without parameters.
transfer control to it. The routine "topsize" will compute the
stack break, which will be the local base of this routine.
Notice that we can do this because we do not need the stack
above this point for this coroutine. In Modula-2, coroutines
must be level 0 procedures without parameters.
*/
char *brk = 0;
char* brk = 0;
unsigned sz = topsize(&brk);
if (sz + sizeof(struct proc) > n) {
if (sz + sizeof(struct proc) > n)
{
/* not enough space */
TRP(M2_TOOLARGE);
}
@ -60,10 +56,11 @@ _SYSTEM__NEWPROCESS(p, a, n, p1)
a->proc = p;
a->brk = brk;
*p1 = a;
if (topsave(brk, a+1))
if (topsave(brk, a + 1))
/* stack frame saved; now just return */
;
else {
else
{
/* We get here through the first transfer to the coroutine
created above.
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)
struct proc **a, **b;
void _SYSTEM__TRANSFER(struct proc** a, struct proc** b)
{
/* transfer from one coroutine to another, saving the current
descriptor in the space indicated by "a", and transfering to
the coroutine in descriptor "b".
descriptor in the space indicated by "a", and transfering to
the coroutine in descriptor "b".
*/
unsigned size;
if (! curproc) {
if (!curproc)
{
/* the current coroutine is the main process;
initialize a coroutine descriptor for it ...
*/
@ -93,21 +90,24 @@ _SYSTEM__TRANSFER(a, b)
mainproc[0].size = sizeof(mainproc);
curproc = &mainproc[0];
}
*a = curproc; /* save current descriptor in "a" */
if (*b == curproc) {
*a = curproc; /* save current descriptor in "a" */
if (*b == curproc)
{
/* transfer to itself is a no-op */
return;
}
size = topsize(&(curproc->brk));
if (size + sizeof(struct proc) > curproc->size) {
if (size + sizeof(struct proc) > curproc->size)
{
TRP(M2_TOOLARGE);
}
if (topsave(curproc->brk, curproc+1)) {
if (topsave(curproc->brk, curproc + 1))
{
/* stack top saved. Now restore context of target
coroutine
*/
curproc = *b;
topload(curproc+1);
topload(curproc + 1);
/* we never get here ... */
}
/* 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
extension
extension
Author: Ceriel J.H. Jacobs
Version: $Id$
*/
StringAssign(dstsiz, srcsiz, dstaddr, srcaddr)
register char *dstaddr, *srcaddr;
#include "libm2.h"
void StringAssign(int dstsiz, int srcsiz, char* dstaddr, char* srcaddr)
{
while (srcsiz > 0) {
while (srcsiz > 0)
{
*dstaddr++ = *srcaddr++;
srcsiz--;
dstsiz--;
}
if (dstsiz > 0) {
if (dstsiz > 0)
{
*dstaddr = 0;
}
}

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

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

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

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

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

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

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

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

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

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

1
lang/m2/libm2/build.lua
View file

@ -32,6 +32,7 @@ for _, plat in ipairs(vars.plats) do
"lang/cem/libcc.ansi/headers+pkg",
"plat/"..plat.."/include+pkg",
"h+emheaders",
"lang/m2/include+headers",
},
vars = { plat = plat }
}

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

@ -8,11 +8,12 @@
Author: Ceriel J.H. Jacobs
Version: $Id$
*/
#include "libm2.h"
cap(u)
unsigned u;
void cap(unsigned int 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 <m2_traps.h>
#include <signal.h>
#include "libm2.h"
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;
static struct errm
{
register struct errm *ep = &errors[0];
char *errmessage;
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 } };
void catch (int trapno)
{
register struct errm* ep = &errors[0];
char* errmessage;
char buf[20];
register char *p, *s;
while (ep->errno != trapno && ep->errmes != 0) ep++;
if (p = ep->errmes) {
while (*p) p++;
_Traps__Message(ep->errmes, 0, (int) (p - ep->errmes), 1);
while (ep->errno != trapno && ep->errmes != 0)
ep++;
if (p = ep->errmes)
{
while (*p)
p++;
_Traps__Message(ep->errmes, 0, (int)(p - ep->errmes), 1);
}
else {
else
{
int i = trapno;
static char q[] = "error number xxxxxxxxxxxxx";
p = &q[13];
s = buf;
if (i < 0) {
if (i < 0)
{
i = -i;
*p++ = '-';
}
do
*s++ = i % 10 + '0';
while (i /= 10);
while (s > buf) *p++ = *--s;
while (s > buf)
*p++ = *--s;
*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 (trapno == M2_UNIXSIG) {
if (trapno == M2_UNIXSIG)
{
extern int __signo;
signal(__signo, SIG_DFL);
_cleanup();
kill(getpid(), __signo);
_exit(trapno+1);
_exit(trapno + 1);
}
#endif
if (trapno != M2_FORCH) {
if (trapno != M2_FORCH)
{
_cleanup();
_exit(trapno+1);
_exit(trapno + 1);
}
SIG(catch);
}

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

@ -8,6 +8,7 @@
Author: Ceriel J.H. Jacobs
Version: $Id$
*/
#include "libm2.h"
#include <m2_traps.h>
#ifndef EM_WSIZE
@ -15,58 +16,43 @@
#define EM_PSIZE _EM_PSIZE
#endif
#if EM_WSIZE==EM_PSIZE
typedef unsigned pcnt;
#else
typedef unsigned long pcnt;
#endif
static struct stack_descr* descrs[10];
static struct stack_descr** ppdescr = descrs;
struct descr {
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;
size_t new_stackptr(struct stack_descr* pdescr, int a)
{
register struct descr *pdescr = pdscr;
pcnt size = (((pdescr->highminlow + 1) * pdescr->size +
(EM_WSIZE - 1)) & ~(EM_WSIZE - 1));
size_t 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 ! */
TRP(M2_TOOMANY);
}
*ppdescr++ = pdescr;
if ((char *) &a - (char *) &pdscr > 0) {
if ((char*)&a - (char*)&pdescr > 0)
{
/* stack grows downwards */
return - size;
return -size;
}
return size;
}
copy_array(pp, a)
char *pp;
void copy_array(char* p, int a)
{
register char *p = pp;
register char *q;
register pcnt sz;
char* q;
size_t sz;
char dummy;
ppdescr--;
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
Version: $Id$
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>
int
dvi(j,i)
int j,i;
int dvi(int j, int i)
{
if (j == 0) TRP(EIDIVZ);
if ((i < 0) != (j < 0)) {
if (i < 0) i = -i;
else j = -j;
return -((i+j-1)/j);
if (j == 0)
TRP(EIDIVZ);
if ((i < 0) != (j < 0))
{
if (i < 0)
i = -i;
else
j = -j;
return -((i + j - 1) / j);
}
else return i/j;
else
return i / j;
}
long
dvil(j,i)
long j,i;
long dvil(long j, long i)
{
if (j == 0) TRP(EIDIVZ);
if ((i < 0) != (j < 0)) {
if (i < 0) i = -i;
else j = -j;
return -((i+j-1)/j);
if (j == 0)
TRP(EIDIVZ);
if ((i < 0) != (j < 0))
{
if (i < 0)
i = -i;
else
j = -j;
return -((i + j - 1) / j);
}
else return i/j;
else
return i / j;
}
int
rmi(j,i)
int j,i;
int rmi(int j, int i)
{
int m;
if (j == 0) TRP(EIDIVZ);
if (i == 0) return 0;
if (j == 0)
TRP(EIDIVZ);
if (i == 0)
return 0;
m = i % j;
if (m != 0 && (i < 0) != (j < 0))
@ -54,14 +61,14 @@ rmi(j,i)
return m;
}
long
rmil(j,i)
long j,i;
long rmil(long j, long i)
{
long m;
if (j == 0) TRP(EIDIVZ);
if (i == 0) return 0L;
if (j == 0)
TRP(EIDIVZ);
if (i == 0)
return 0L;
m = i % j;
if (m != 0 && (i < 0) != (j < 0))

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

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

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

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

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

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

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

@ -8,18 +8,11 @@
* Version: $Id$
*/
#include "libm2.h"
#include <em_abs.h>
extern TRP();
struct array_descr {
int lbound;
int n_elts_min_one;
unsigned size;
};
rcka(descr, indx)
struct array_descr *descr;
void rcka(struct array_descr* descr, int indx)
{
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$
*/
#include "libm2.h"
#include <em_abs.h>
extern TRP();
struct range_descr {
int low, high;
};
rcki(descr, val)
struct range_descr *descr;
void rcki(struct int_range_descr* descr, int val)
{
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$
*/
#include "libm2.h"
#include <em_abs.h>
extern TRP();
struct range_descr {
long low, high;
};
rckil(descr, val)
struct range_descr *descr;
long val;
void rckil(struct long_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$
*/
#include "libm2.h"
#include <em_abs.h>
extern TRP();
struct range_descr {
unsigned low, high;
};
rcku(descr, val)
struct range_descr *descr;
unsigned val;
void rcku(struct uint_range_descr* descr, unsigned int 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$
*/
#include "libm2.h"
#include <em_abs.h>
extern TRP();
struct range_descr {
unsigned long low, high;
};
rckul(descr, val)
struct range_descr *descr;
unsigned long val;
void rckul(struct ulong_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
(only when not using the MON instruction)
(only when not using the MON instruction)
Author: Ceriel J.H. Jacobs
Version: $Id$
*/
#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 <errno.h>
int __signo;
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
__ctchsig(signo)
static void __ctchsig(int signo)
{
signal(signo,__ctchsig);
signal(signo, __ctchsig);
#ifdef __BSD4_2
sigsetmask(sigblock(0) & ~(1<<(signo - 1)));
sigsetmask(sigblock(0) & ~(1 << (signo - 1)));
#endif
__signo = signo;
EM_trap(__traps[signo]);
}
int
sigtrp(trapno, signo)
int sigtrp(int trapno, int signo)
{
/* Let Unix signal signo cause EM trap trapno to occur.
If trapno = -2, restore default,
If trapno = -3, ignore.
Return old trapnumber.
Careful, this could be -2 or -3; But return value of -1
indicates failure, with error number in errno.
If trapno = -2, restore default,
If trapno = -3, ignore.
Return old trapnumber.
Careful, this could be -2 or -3; But return value of -1
indicates failure, with error number in errno.
*/
extern int errno;
void (*ctch)() = __ctchsig;
void (*oldctch)();
void (*ctch)(int) = __ctchsig;
void (*oldctch)(int);
int oldtrap;
if (signo <= 0 || signo >= sizeof(__traps)/sizeof(__traps[0])) {
if (signo <= 0 || signo >= sizeof(__traps) / sizeof(__traps[0]))
{
errno = EINVAL;
return -1;
}
@ -62,20 +61,23 @@ sigtrp(trapno, signo)
ctch = SIG_DFL;
else if (trapno >= 0 && trapno <= 252)
;
else {
else
{
errno = EINVAL;
return -1;
}
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;
else if (oldctch == SIG_IGN) {
else if (oldctch == SIG_IGN)
{
signal(signo, SIG_IGN);
}
else __traps[signo] = trapno;
else
__traps[signo] = trapno;
return oldtrap;
}

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

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

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

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

12
lib/descr/fe
View file

@ -72,18 +72,8 @@ name cem
mapflag -V* CEM_F={CEM_F?} -V*
rts .c
need .c
prep always
args \
{CPP_F?} \
-D__{ARCH} -D__{PLATFORM} \
-D__ACK \
{SYSINCLUDES?} \
{C_INCLUDES} \
{INCLUDES?} \
({ANSI_C?.xx}:.xx=-D{ARCH} \
-DEM_WSIZE={w} -DEM_PSIZE={p} \
-DEM_SSIZE={s} -DEM_LSIZE={l} -DEM_FSIZE={f} -DEM_DSIZE={d}) \
-D_EM_WSIZE={w} -D_EM_PSIZE={p} \
-D_EM_SSIZE={s} -D_EM_LSIZE={l} -D_EM_FSIZE={f} -D_EM_DSIZE={d} \
-Vw{w}.{wa}i{w}.{wa}p{p}.{pa}f{f}.{fa}s{s}.{sa}l{l}.{la}d{d}.{da}x{x}.{xa} \
{CC_ALIGN?} \
{CEM_F?} {LFLAG?} < >

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