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

Merge pull request #103 from davidgiven/dtrg-warnings

Browse source 
Fix a lot of warnings.
This commit is contained in:
David Given 2018-06-18 22:31:35 +02:00 committed by GitHub
parent ddca7276c0 698613cd7d
commit 9eff7102e9
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
81 changed files with 1031 additions and 1227 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
lang/cem/libcc.ansi/signal/raise.c
View file

@ -5,9 +5,9 @@
/* $Id$ */
#if defined(_POSIX_SOURCE)
#include <sys/types.h>
#include <sys/types.h>
#endif
#include <signal.h>
#include <signal.h>
int
raise(int sig)

11
lang/cem/libcc.ansi/stdlib/system.c
View file

@ -5,10 +5,12 @@
/* $Id$ */
#if defined(_POSIX_SOURCE)
#include <sys/types.h>
#include <sys/types.h>
#endif
#include <stdlib.h>
#include <signal.h>
#include <stdlib.h>
#include <signal.h>
extern char** environ;
extern int _fork(void);
extern int _wait(int *);
@ -18,7 +20,6 @@ extern void _close(int);
#define FAIL 127
extern const char **environ;
static const char *exec_tab[] = {
"sh", /* argv[0] */
"-c", /* argument to the shell */
@ -39,7 +40,7 @@ system(const char *str)
_close(i);
if (!str) str = "cd ."; /* just testing for a shell */
exec_tab[2] = str; /* fill in command */
_execve("/bin/sh", exec_tab, environ);
_execve("/bin/sh", exec_tab, (char const**) environ);
/* get here if execve fails ... */
_exit(FAIL); /* see manual page */
}

3
lang/cem/libcc.ansi/string/strdup.c
View file

@ -4,7 +4,8 @@
*/
/* $Id$ */
#include <string.h>
#include <stdlib.h>
#include <string.h>
char*
strdup(const char *s)

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

@ -111,6 +111,7 @@ cprogram {
"+scope_h",
"+type_h",
"h+emheaders",
"lang/pc/include+headers",
"modules+headers",
"modules/src/alloc+lib",
"modules/src/em_code+lib_k",

65
lang/pc/comp/proto.main
View file

@ -1,65 +0,0 @@
# $Id$
# C compilation part. Not to be called directly.
# Instead, it is to be called by the Makefile.
# SRC_DIR, UTIL_HOME, TARGET_HOME, CC, COPTIONS, LINT, LINTOPTIONS, LDOPTIONS,
# CC_AND_MKDEP, SUF, LIBSUF should be set here.
#PARAMS do not remove this line!
# PRODUCE is either e (readable EM) or k (compact EM)
PRODUCE = k
MDIR = $(TARGET_HOME)/modules
LIBDIR = $(MDIR)/lib
LINTLIBDIR = $(UTIL_HOME)/modules/lib
MALLOC = $(LIBDIR)/malloc.$(SUF)
EMLIB = $(LIBDIR)/libem_mes.$(LIBSUF) \
$(LIBDIR)/libem$(PRODUCE).$(LIBSUF) \
$(TARGET_HOME)/lib.bin/em_data.$(LIBSUF)
MODLIB = $(LIBDIR)/libinput.$(LIBSUF) \
$(LIBDIR)/libassert.$(LIBSUF) \
$(LIBDIR)/liballoc.$(LIBSUF) \
$(MALLOC) \
$(LIBDIR)/libflt.$(LIBSUF) \
$(LIBDIR)/libprint.$(LIBSUF) \
$(LIBDIR)/libstring.$(LIBSUF) \
$(LIBDIR)/libsystem.$(LIBSUF)
LIBS = $(EMLIB) $(MODLIB)
LINTLIBS = $(LINTLIBDIR)/$(LINTPREF)em_mes.$(LINTSUF) \
$(LINTLIBDIR)/$(LINTPREF)emk.$(LINTSUF) \
$(LINTLIBDIR)/$(LINTPREF)input.$(LINTSUF) \
$(LINTLIBDIR)/$(LINTPREF)assert.$(LINTSUF) \
$(LINTLIBDIR)/$(LINTPREF)alloc.$(LINTSUF) \
$(LINTLIBDIR)/$(LINTPREF)flt.$(LINTSUF) \
$(LINTLIBDIR)/$(LINTPREF)print.$(LINTSUF) \
$(LINTLIBDIR)/$(LINTPREF)string.$(LINTSUF) \
$(LINTLIBDIR)/$(LINTPREF)system.$(LINTSUF)
PROFILE =
INCLUDES = -I. -I$(SRC_DIR) -I$(TARGET_HOME)/modules/h -I$(TARGET_HOME)/h -I$(TARGET_HOME)/modules/pkg
CFLAGS = $(PROFILE) $(INCLUDES) $(COPTIONS) -DSTATIC=static
LINTFLAGS = $(INCLUDES) $(LINTOPTIONS) -DNORCSID -DSTATIC=static
LDFLAGS = $(PROFILE) $(LDOPTIONS)
# C_SRC and OBJ should be set here.
#LISTS do not remove this line!
all: main
clean:
rm -f *.$(SUF) main
lint:
$(LINT) $(LINTFLAGS) $(C_SRC) $(LINTLIBS)
main: $(OBJ)
$(CC) $(LDFLAGS) $(OBJ) $(LIBS) -o main
# do not remove the next line; it is used for generating dependencies
#DEPENDENCIES

154
lang/pc/comp/proto.make
View file

@ -1,154 +0,0 @@
# $Id$
# make Pascal compiler
#PARAMS do not remove this line!
UTIL_BIN = \
$(UTIL_HOME)/bin
SRC_DIR = \
$(SRC_HOME)/lang/pc/comp
TABGEN= $(UTIL_BIN)/tabgen
LLGEN = $(UTIL_BIN)/LLgen
LLGENOPTIONS = \
-v
SRC_G = $(SRC_DIR)/program.g $(SRC_DIR)/declar.g \
$(SRC_DIR)/expression.g $(SRC_DIR)/statement.g
GEN_G = tokenfile.g
GFILES= $(GEN_G) $(SRC_G)
SRC_C = $(SRC_DIR)/LLlex.c $(SRC_DIR)/LLmessage.c $(SRC_DIR)/body.c \
$(SRC_DIR)/error.c $(SRC_DIR)/label.c $(SRC_DIR)/readwrite.c \
$(SRC_DIR)/main.c $(SRC_DIR)/tokenname.c $(SRC_DIR)/idf.c \
$(SRC_DIR)/input.c $(SRC_DIR)/type.c $(SRC_DIR)/def.c \
$(SRC_DIR)/misc.c $(SRC_DIR)/enter.c $(SRC_DIR)/progs.c \
$(SRC_DIR)/typequiv.c $(SRC_DIR)/node.c $(SRC_DIR)/cstoper.c \
$(SRC_DIR)/chk_expr.c $(SRC_DIR)/options.c $(SRC_DIR)/scope.c \
$(SRC_DIR)/desig.c $(SRC_DIR)/code.c $(SRC_DIR)/lookup.c \
$(SRC_DIR)/stab.c
GEN_C = tokenfile.c program.c declar.c expression.c statement.c \
symbol2str.c char.c Lpars.c casestat.c tmpvar.c next.c
CFILES= $(SRC_C) $(GEN_C)
SRC_H = $(SRC_DIR)/LLlex.h $(SRC_DIR)/chk_expr.h $(SRC_DIR)/class.h \
$(SRC_DIR)/const.h $(SRC_DIR)/debug.h $(SRC_DIR)/f_info.h \
$(SRC_DIR)/idf.h $(SRC_DIR)/input.h $(SRC_DIR)/main.h \
$(SRC_DIR)/misc.h $(SRC_DIR)/required.h $(SRC_DIR)/tokenname.h
GEN_H = errout.h idfsize.h numsize.h strsize.h target_sizes.h \
inputtype.h density.h nocross.h def.h debugcst.h \
type.h Lpars.h node.h dbsymtab.h scope.h desig.h
HFILES= $(GEN_H) $(SRC_H)
NEXTFILES = \
$(SRC_DIR)/def.H $(SRC_DIR)/type.H $(SRC_DIR)/node.H \
$(SRC_DIR)/scope.H $(SRC_DIR)/desig.H \
$(SRC_DIR)/tmpvar.C $(SRC_DIR)/casestat.C
all: make.main
make -f make.main main
install: all
cp main $(TARGET_HOME)/lib.bin/em_pc
cmp: all
-cmp main $(TARGET_HOME)/lib.bin/em_pc
opr:
make pr | opr
pr:
@pr $(SRC_DIR)/proto.make $(SRC_DIR)/proto.main Parameters \
$(SRC_DIR)/char.tab $(SRC_G) $(SRC_H) $(NEXTFILES) $(SRC_C)
lint: make.main
make -f make.main lint
Cfiles: hfiles LLfiles $(GEN_C) $(GEN_H) Makefile
echo $(CFILES) | tr ' ' '\012' > Cfiles
echo $(HFILES) | tr ' ' '\012' >> Cfiles
resolved: Cfiles
CC="$(CC)" UTIL_HOME="$(UTIL_HOME)" do_resolve `cat Cfiles` > Cfiles.new
-if cmp -s Cfiles Cfiles.new ; then rm -f Cfiles.new ; else mv Cfiles.new Cfiles ; fi
touch resolved
# there is no file called "dependencies"; we want dependencies checked
# every time. This means that make.main is made every time. Oh well ...
# it does not take much time.
dependencies: resolved
do_deps `grep '.c$$' Cfiles`
make.main: dependencies make_macros lists $(SRC_DIR)/proto.main
rm_deps $(SRC_DIR)/proto.main | sed -e '/^.PARAMS/r make_macros' -e '/^.LISTS/r lists' > make.main
cat *.dep >> make.main
make_macros: Makefile
echo 'SRC_DIR=$(SRC_DIR)' > make_macros
echo 'UTIL_HOME=$(UTIL_HOME)' >> make_macros
echo 'TARGET_HOME=$(TARGET_HOME)' >> make_macros
echo 'CC=$(CC)' >> make_macros
echo 'COPTIONS=$(COPTIONS)' >> make_macros
echo 'LDOPTIONS=$(LDOPTIONS)' >> make_macros
echo 'LINT=$(LINT)' >> make_macros
echo 'LINTSUF=$(LINTSUF)' >> make_macros
echo 'LINTPREF=$(LINTPREF)' >> make_macros
echo 'LINTOPTIONS=$(LINTOPTIONS)' >> make_macros
echo 'SUF=$(SUF)' >> make_macros
echo 'LIBSUF=$(LIBSUF)' >> make_macros
echo 'CC_AND_MKDEP=$(CC_AND_MKDEP)' >> make_macros
lists: Cfiles
echo "C_SRC = \\" > lists
echo $(CFILES) >> lists
echo "OBJ = \\" >> lists
echo $(CFILES) | sed -e 's|[^ ]*/||g' -e 's/\.c/.$$(SUF)/g' >> lists
clean:
-make -f make.main clean
rm -f $(GEN_C) $(GEN_G) $(GEN_H) hfiles LLfiles Cfiles LL.output
rm -f resolved *.dep lists make.main make_macros
LLfiles: $(GFILES)
$(LLGEN) $(LLGENOPTIONS) $(GFILES)
@touch LLfiles
hfiles: Parameters $(SRC_DIR)/make.hfiles
$(SRC_DIR)/make.hfiles Parameters
touch hfiles
tokenfile.g: $(SRC_DIR)/tokenname.c $(SRC_DIR)/make.tokfile
$(SRC_DIR)/make.tokfile <$(SRC_DIR)/tokenname.c >tokenfile.g
symbol2str.c: $(SRC_DIR)/tokenname.c $(SRC_DIR)/make.tokcase
$(SRC_DIR)/make.tokcase <$(SRC_DIR)/tokenname.c >symbol2str.c
def.h: $(SRC_DIR)/make.allocd $(SRC_DIR)/def.H
$(SRC_DIR)/make.allocd < $(SRC_DIR)/def.H > def.h
type.h: $(SRC_DIR)/make.allocd $(SRC_DIR)/type.H
$(SRC_DIR)/make.allocd < $(SRC_DIR)/type.H > type.h
scope.h: $(SRC_DIR)/make.allocd $(SRC_DIR)/scope.H
$(SRC_DIR)/make.allocd < $(SRC_DIR)/scope.H > scope.h
node.h: $(SRC_DIR)/make.allocd $(SRC_DIR)/node.H
$(SRC_DIR)/make.allocd < $(SRC_DIR)/node.H > node.h
desig.h: $(SRC_DIR)/make.allocd $(SRC_DIR)/desig.H
$(SRC_DIR)/make.allocd < $(SRC_DIR)/desig.H > desig.h
tmpvar.c: $(SRC_DIR)/make.allocd $(SRC_DIR)/tmpvar.C
$(SRC_DIR)/make.allocd < $(SRC_DIR)/tmpvar.C > tmpvar.c
casestat.c: $(SRC_DIR)/make.allocd $(SRC_DIR)/casestat.C
$(SRC_DIR)/make.allocd < $(SRC_DIR)/casestat.C > casestat.c
next.c: $(NEXTFILES) $(SRC_DIR)/make.next
$(SRC_DIR)/make.next $(NEXTFILES) > next.c
char.c: $(SRC_DIR)/char.tab
$(TABGEN) -f$(SRC_DIR)/char.tab >char.c

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

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

131
lang/pc/include/pc.h Normal file
View file

@ -0,0 +1,131 @@
#ifndef PC_H
#define PC_H
#include "pc_err.h"
#include "pc_file.h"
#include "pc_math.h"
struct descr
{
int low;
int diff;
int size;
};
struct array_descr
{
int lbound;
unsigned n_elts_min_one;
unsigned size; /* doesn't really matter */
};
extern int _extflc;
extern struct file** _extfl;
extern struct file* _curfil;
extern int _pargc;
extern char** _pargv;
extern char** _penvp;
extern char* _m_lb; /* LB of _m_a_i_n */
extern struct file* _curfil; /* points to file struct in case of errors */
extern char *_ecvt(double value, int ndigit, int *decpt, int *sign);
extern char *_fcvt(double value, int ndigit, int *decpt, int *sign);
extern char *_wdw(struct file *f);
extern char *argv(int i);
extern char *strbuf(char *s);
extern char* _hol0(void);
extern double _abr(double r);
extern double _atn(double x);
extern double _cos(double x);
extern double _exp(double x);
extern double _fef(double fl, int* res);
extern double _fif(double f1, double f2, double* f3);
extern double _log(double x);
extern double _rdr(struct file *f);
extern double _rnd(double r);
extern double _sin(double x);
extern double _sqt(double x);
extern int _abi(int i);
extern int _asz(struct descr *dp);
extern int _bcp(int sz, unsigned char *y, unsigned char *x);
extern int _dvi(unsigned int j, unsigned int i);
extern int _efl(struct file *f);
extern int _eln(struct file *f);
extern int _fstdig(struct file *f);
extern int _getint(struct file *f);
extern int _getsig(struct file *f);
extern int _mdi(int j, int i);
extern int _nxtdig(struct file *f);
extern int _rdc(struct file *f);
extern int _rdi(struct file *f);
extern int argc(void);
extern int perrno(void);
extern int strfetch(char *s, int i);
extern int strlen(char *s);
extern int strtobuf(char *s, char *b, int l);
extern int uread(int fd, char *b, int n);
extern int uwrite(int fd, char *b, int n);
extern long _abl(long i);
extern long _dvil(unsigned long j, unsigned long i);
extern long _mdil(long j, long i);
extern long _mdl(long j, long i);
extern long _rdl(struct file *f);
extern void _ass(int line, int bool);
extern void _catch(unsigned erno);
extern void _cls(struct file *f);
extern void _cre(int sz, struct file *f);
extern void _dis(int n, void **ptr);
extern void _flush(struct file *f);
extern void _get(struct file *f);
extern void _hlt(int ecode);
extern void _incpt(struct file *f);
extern void _ini(char *args, int c, struct file **p, char *mainlb);
extern void _new(int n, void **ptr);
extern void _nfa(int bool);
extern void _opn(int sz, struct file *f);
extern void _outcpt(struct file *f);
extern void _pac(struct descr *ad, struct descr *zd, char *zp, int i, char *ap);
extern void _pag(struct file *f);
extern void _put(struct file *f);
extern void _rcka(struct array_descr *descr, int index);
extern void _rf(struct file *f);
extern void _rln(struct file *f);
extern void _sig(void (*)(unsigned int));
extern void _skipsp(struct file *f);
extern void _trp(int trapno);
extern void _unp(struct descr *ad, struct descr *zd, int i, char *ap, char *zp, int noext);
extern void _wf(struct file *f);
extern void _wln(struct file *f);
extern void _wrb(int b, struct file *f);
extern void _wrc(int c, struct file *f);
extern void _wrf(int n, int w, double r, struct file *f);
extern void _wri(int i, struct file *f);
extern void _wrl(long l, struct file *f);
extern void _wrr(double r, struct file *f);
extern void _wrs(int len, char *s, struct file *f);
extern void _wrz(char *s, struct file *f);
extern void _wsb(int w, int b, struct file* f);
extern void _wsc(int w, char c, struct file* f);
extern void _wsi(int w, int i, struct file* f);
extern void _wsl(int w, long l, struct file *f);
extern void _wsr(int w, double r, struct file *f);
extern void _wss(int w, int len, char* s, struct file* f);
extern void _wstrin(int width, int len, char* buf, struct file* f);
extern void _wsz(int w, char* s, struct file* f);
extern void _xcls(struct file *f);
extern void argshift(void);
extern void buff(struct file *f);
extern void diag(struct file *f);
extern void nobuff(struct file *f);
extern void notext(struct file *f);
extern void pclose(struct file *f);
extern void pcreat(struct file *f, char *s);
extern void popen(struct file *f, char *s);
extern void procentry(char *name);
extern void procexit(char *name);
extern void strstore(char *s, int i, int c);
#endif

0
h/pc_err.h → lang/pc/include/pc_err.h
View file

0
h/pc_file.h → lang/pc/include/pc_file.h
View file

0
h/pc_math.h → lang/pc/include/pc_math.h
View file

73
lang/pc/libpc/LIST
View file

@ -1,73 +0,0 @@
tail_pc.a
abi.c
abl.c
abr.c
arg.c
ass.c
asz.c
atn.c
bcp.c
bts.e
buff.c
clock.c
diag.c
dis.c
efl.c
eln.c
encaps.e
exp.c
get.c
gto.e
hlt.c
ini.c
catch.c
log.c
mdi.c
mdl.c
new.c
nobuff.c
notext.c
opn.c
hol0.e
pac.c
pclose.c
pcreat.c
pentry.c
perrno.c
pexit.c
popen.c
cls.c
put.c
rdc.c
rdl.c
rdr.c
rdi.c
rln.c
rf.c
rnd.c
sav.e
sig.e
sin.c
sqt.c
fef.e
string.c
trap.e
unp.c
uread.c
uwrite.c
wdw.c
incpt.c
wrc.c
wrf.c
wri.c
wrl.c
wrr.c
cvt.c
fif.e
wrz.c
wrs.c
outcpt.c
wf.c
nfa.c
rcka.c
trp.e

13
lang/pc/libpc/Makefile
View file

@ -1,13 +0,0 @@
# $Id$
head:
echo This Makefile needs arguments
clean:
rm -f *.old
opr:
make pr | opr
pr:
@pr Makefile *.[ec]

6
lang/pc/libpc/abi.c
View file

@ -17,7 +17,9 @@
*/
/* Author: J.W. Stevenson */
#include "pc.h"
int _abi(i) int i; {
return(i>=0 ? i : -i);
int _abi(int i)
{
return (i >= 0 ? i : -i);
}

6
lang/pc/libpc/abl.c
View file

@ -17,7 +17,9 @@
*/
/* Author: J.W. Stevenson */
#include "pc.h"
long _abl(i) long i; {
return(i>=0 ? i : -i);
long _abl(long i)
{
return (i >= 0 ? i : -i);
}

6
lang/pc/libpc/abr.c
View file

@ -17,7 +17,9 @@
*/
/* Author: J.W. Stevenson */
#include "pc.h"
double _abr(r) double r; {
return(r>=0 ? r : -r);
double _abr(double r)
{
return (r >= 0 ? r : -r);
}

33
lang/pc/libpc/arg.c
View file

@ -17,40 +17,31 @@
*/
/* Author: J.W. Stevenson */
#include "pc.h"
/* function argc:integer; extern; */
/* function argv(i:integer):string; extern; */
/* procedure argshift; extern; */
/* function environ(i:integer):string; extern; */
extern int _pargc;
extern char **_pargv;
extern char **_penvp;
int argc() {
return(_pargc);
int argc(void)
{
return (_pargc);
}
char *argv(i) {
char* argv(int i)
{
if (i >= _pargc)
return(0);
return(_pargv[i]);
return (0);
return (_pargv[i]);
}
argshift() {
void argshift(void)
{
if (_pargc > 1) {
if (_pargc > 1)
{
--_pargc;
_pargv++;
}
}
char *environ(i) {
char **p; char *q;
if (p = _penvp)
while (q = *p++)
if (i-- < 0)
return(q);
return(0);
}

13
lang/pc/libpc/ass.c
View file

@ -18,15 +18,14 @@
/* Author: J.W. Stevenson */
#include <em_abs.h>
#include <pc_err.h>
#include <em_abs.h>
#include "pc.h"
extern char *_hol0();
extern _trp();
void _ass(int line, int bool)
{
_ass(line,bool) int line,bool; {
if (bool==0) {
if (bool == 0)
{
LINO = line;
_trp(EASS);
}

13
lang/pc/libpc/asz.c
View file

@ -16,14 +16,11 @@
*
*/
#include "pc.h"
/* Author: J.W. Stevenson */
struct descr {
int low;
int diff;
int size;
};
int _asz(dp) struct descr *dp; {
return(dp->size * (dp->diff + 1));
int _asz(struct descr* dp)
{
return (dp->size * (dp->diff + 1));
}

48
lang/pc/libpc/atn.c
View file

@ -10,13 +10,9 @@
#define __NO_DEFS
#include <math.h>
#if __STDC__
#include <pc_math.h>
#endif
#include "pc.h"
double
_atn(x)
double x;
double _atn(double x)
{
/* Algorithm and coefficients from:
"Software manual for the elementary functions"
@ -30,43 +26,47 @@ _atn(x)
-0.83758299368150059274e+0
};
static double q[] = {
0.41066306682575781263e+2,
0.86157349597130242515e+2,
0.59578436142597344465e+2,
0.15024001160028576121e+2,
1.0
0.41066306682575781263e+2,
0.86157349597130242515e+2,
0.59578436142597344465e+2,
0.15024001160028576121e+2,
1.0
};
static double a[] = {
0.0,
0.52359877559829887307710723554658381, /* pi/6 */
0.52359877559829887307710723554658381, /* pi/6 */
M_PI_2,
1.04719755119659774615421446109316763 /* pi/3 */
1.04719755119659774615421446109316763 /* pi/3 */
};
int neg = x < 0;
int n;
double g;
int neg = x < 0;
int n;
double g;
if (neg) {
if (neg)
{
x = -x;
}
if (x > 1.0) {
x = 1.0/x;
if (x > 1.0)
{
x = 1.0 / x;
n = 2;
}
else n = 0;
else
n = 0;
if (x > 0.26794919243112270647) { /* 2-sqtr(3) */
if (x > 0.26794919243112270647)
{ /* 2-sqtr(3) */
n = n + 1;
x = (((0.73205080756887729353*x-0.5)-0.5)+x)/
(1.73205080756887729353+x);
x = (((0.73205080756887729353 * x - 0.5) - 0.5) + x) / (1.73205080756887729353 + x);
}
/* ??? avoid underflow ??? */
g = x * x;
x += x * g * POLYNOM3(g, p) / POLYNOM4(g, q);
if (n > 1) x = -x;
if (n > 1)
x = -x;
x += a[n];
return neg ? -x : x;
}

13
lang/pc/libpc/bcp.c
View file

@ -17,14 +17,17 @@
*/
/* Author: J.W. Stevenson */
#include "pc.h"
int _bcp(sz,y,x) int sz; unsigned char *y,*x; {
int _bcp(int sz, unsigned char* y, unsigned char* x)
{
while (--sz >= 0) {
while (--sz >= 0)
{
if (*x < *y)
return(-1);
return (-1);
if (*x++ > *y++)
return(1);
return (1);
}
return(0);
return (0);
}

11
lang/pc/libpc/buff.c
View file

@ -18,18 +18,17 @@
/* Author: J.W. Stevenson */
#include <pc_file.h>
extern _flush();
#include "pc.h"
/* procedure buff(var f:file of ?); */
buff(f) struct file *f; {
void buff(struct file* f)
{
int sz;
if ((f->flags & (0377|WRBIT)) != (MAGIC|WRBIT))
if ((f->flags & (0377 | WRBIT)) != (MAGIC | WRBIT))
return;
_flush(f);
sz = f->size;
f->count = f->buflen = (sz>PC_BUFLEN ? sz : PC_BUFLEN-PC_BUFLEN%sz);
f->count = f->buflen = (sz > PC_BUFLEN ? sz : PC_BUFLEN - PC_BUFLEN % sz);
}

8
lang/pc/libpc/build.lua
View file

@ -17,9 +17,10 @@ for _, plat in ipairs(vars.plats) do
},
hdrs = {}, -- must be empty
deps = {
"lang/cem/libcc.ansi/headers+pkg",
"plat/"..plat.."/include+pkg",
"h+emheaders",
"lang/cem/libcc.ansi/headers+pkg",
"lang/pc/include+headers",
"plat/"..plat.."/include+pkg",
},
vars = { plat = plat }
}
@ -29,7 +30,8 @@ for _, plat in ipairs(vars.plats) do
srcs = { "./head_pc.e" },
vars = { plat = plat },
deps = {
"h+emheaders"
"h+emheaders",
"lang/pc/include+headers",
}
}

151
lang/pc/libpc/catch.c
View file

@ -20,82 +20,74 @@
#include <errno.h>
#include <unistd.h>
#include <em_abs.h>
#include <pc_err.h>
#include <pc_file.h>
#include "pc.h"
/* to make it easier to patch ... */
extern struct file *_curfil;
static struct errm {
static struct errm
{
int errno;
char *errmes;
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"},
{ 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"},
{ 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" },
{ EARGC, "more args expected" },
{ EEXP, "error in exp" },
{ ELOG, "error in ln" },
{ ESQT, "error in sqrt" },
{ EASS, "assertion failed" },
{ EPACK, "array bound error in pack" },
{ EUNPACK, "array bound error in unpack" },
{ EMOD, "only positive j in 'i mod j'" },
{ EBADF, "file not yet open" },
{ EFREE, "dispose error" },
{ EFUNASS, "function not assigned" },
{ EWIDTH, "illegal field width" },
{ EARGC, "more args expected" },
{ EEXP, "error in exp" },
{ ELOG, "error in ln" },
{ ESQT, "error in sqrt" },
{ EASS, "assertion failed" },
{ EPACK, "array bound error in pack" },
{ EUNPACK, "array bound error in unpack" },
{ EMOD, "only positive j in 'i mod j'" },
{ EBADF, "file not yet open" },
{ EFREE, "dispose error" },
{ EFUNASS, "function not assigned" },
{ EWIDTH, "illegal field width" },
{ EWRITEF, "not writable" },
{ EREADF, "not readable" },
{ EEOF, "end of file" },
{ EFTRUNC, "truncated" },
{ ERESET, "reset error" },
{ EREWR, "rewrite error" },
{ ECLOSE, "close error" },
{ EREAD, "read error" },
{ EWRITE, "write error" },
{ EDIGIT, "digit expected" },
{ EASCII, "non-ASCII char read" },
{ -1, 0}
{ EWRITEF, "not writable" },
{ EREADF, "not readable" },
{ EEOF, "end of file" },
{ EFTRUNC, "truncated" },
{ ERESET, "reset error" },
{ EREWR, "rewrite error" },
{ ECLOSE, "close error" },
{ EREAD, "read error" },
{ EWRITE, "write error" },
{ EDIGIT, "digit expected" },
{ EASCII, "non-ASCII char read" },
{ -1, 0 }
};
extern int _pargc;
extern char **_pargv;
extern char **_penvp;
extern char *_hol0();
extern _trp();
_catch(erno) unsigned erno; {
register struct errm *ep = &errors[0];
char *p,*q,*s,**qq;
void _catch(unsigned int erno)
{
register struct errm* ep = &errors[0];
char *p, *q, *s, **qq;
char buf[20];
unsigned i;
int j = erno;
char *pp[11];
char* pp[11];
char xbuf[100];
qq = pp;
@ -104,52 +96,61 @@ _catch(erno) unsigned erno; {
else
*qq++ = _pargv[0];
while (ep->errno != erno && ep->errmes != 0) ep++;
while (ep->errno != erno && ep->errmes != 0)
ep++;
p = buf;
s = xbuf;
if (i = LINO) {
if (i = LINO)
{
*qq++ = ", ";
do
*p++ = i % 10 + '0';
while (i /= 10);
while (p > buf) *s++ = *--p;
while (p > buf)
*s++ = *--p;
}
*s++ = ':';
*s++ = ' ';
*s++ = '\0';
*qq++ = xbuf;
if ((erno & ~037) == 0140 && (_curfil->flags&0377)==MAGIC) {
if ((erno & ~037) == 0140 && (_curfil->flags & 0377) == MAGIC)
{
/* file error */
*qq++ = "file ";
*qq++ = _curfil->fname;
*qq++ = ": ";
}
if (ep->errmes) *qq++ = ep->errmes;
else {
if (ep->errmes)
*qq++ = ep->errmes;
else
{
*qq++ = "error number ";
*qq++ = s;
p = buf;
if (j < 0) {
if (j < 0)
{
j = -j;
*s++ = '-';
}
do
*p++ = j % 10 + '0';
while (j /= 10);
while (p > buf) *s++ = *--p;
while (p > buf)
*s++ = *--p;
*s = 0;
}
*qq++ = "\n";
*qq = 0;
qq = pp;
while (q = *qq++) {
while (q = *qq++)
{
p = q;
while (*p)
p++;
if (write(2,q,(int)(p-q)) < 0)
if (write(2, q, (int)(p - q)) < 0)
;
}
_exit(erno+1);
_exit(erno + 1);
error:
_trp(erno);
}

47
lang/pc/libpc/clock.c
View file

@ -1,47 +0,0 @@
/* $Id$ */
/*
* (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
*
* This product is part of the Amsterdam Compiler Kit.
*
* Permission to use, sell, duplicate or disclose this software must be
* obtained in writing. Requests for such permissions may be sent to
*
* Dr. Andrew S. Tanenbaum
* Wiskundig Seminarium
* Vrije Universiteit
* Postbox 7161
* 1007 MC Amsterdam
* The Netherlands
*
*/
/* Author: J.W. Stevenson */
/* function clock:integer; extern; */
extern int _times();
struct tbuf {
long utime;
long stime;
long cutime;
long cstime;
};
#ifndef EM_WSIZE
#define EM_WSIZE _EM_WSIZE
#endif
int clock() {
struct tbuf t;
_times(&t);
return( (int)(t.utime + t.stime) &
#if EM_WSIZE <= 2
077777
#else
0x7fffffffL
#endif
);
}

21
lang/pc/libpc/cls.c
View file

@ -20,19 +20,15 @@
#include <stdlib.h>
#include <unistd.h>
#include <pc_file.h>
#include <pc_err.h>
#include "pc.h"
extern struct file *_curfil;
extern _trp();
extern _flush();
extern _outcpt();
_xcls(f) struct file *f; {
void _xcls(struct file* f)
{
if ((f->flags & WRBIT) == 0)
return;
if ((f->flags & (TXTBIT|ELNBIT)) == TXTBIT) {
if ((f->flags & (TXTBIT | ELNBIT)) == TXTBIT)
{
#ifdef CPM
*f->ptr = '\r';
_outcpt(f);
@ -43,13 +39,14 @@ _xcls(f) struct file *f; {
_flush(f);
}
_cls(f) struct file *f; {
void _cls(struct file* f)
{
#ifdef MAYBE
char *p;
char* p;
#endif
_curfil = f;
if ((f->flags&0377) != MAGIC)
if ((f->flags & 0377) != MAGIC)
return;
#ifdef MAYBE
p = f->bufadr;

111
lang/pc/libpc/cvt.c
View file

@ -1,3 +1,5 @@
#include "pc.h"
/* $Id$ */
#ifndef NOFLOAT
@ -5,29 +7,25 @@
#include <float.h>
#else
#include <math.h>
#define DBL_MAX M_MAX_D
#define DBL_MAX M_MAX_D
#endif
static char *cvt();
#define NDIGITS 128
static char* cvt(double value, int ndigit, int* decpt, int* sign, int ecvtflag);
char *
_ecvt(value, ndigit, decpt, sign)
double value;
int ndigit, *decpt, *sign;
#define NDIGITS 128
char *_ecvt(double value, int ndigit, int *decpt, int *sign)
{
return cvt(value, ndigit, decpt, sign, 1);
}
char *
_fcvt(value, ndigit, decpt, sign)
double value;
int ndigit, *decpt, *sign;
char *_fcvt(double value, int ndigit, int *decpt, int *sign)
{
return cvt(value, ndigit, decpt, sign, 0);
}
static struct powers_of_10 {
static struct powers_of_10
{
double pval;
double rpval;
int exp;
@ -41,73 +39,90 @@ static struct powers_of_10 {
1.0e0, 1.0e0, 0
};
static char *
cvt(value, ndigit, decpt, sign, ecvtflag)
double value;
int ndigit, *decpt, *sign;
static char* cvt(double value, int ndigit, int* decpt, int* sign, int ecvtflag)
{
static char buf[NDIGITS+1];
register char *p = buf;
register char *pe;
static char buf[NDIGITS + 1];
register char* p = buf;
register char* pe;
if (ndigit < 0) ndigit = 0;
if (ndigit > NDIGITS) ndigit = NDIGITS;
if (ndigit < 0)
ndigit = 0;
if (ndigit > NDIGITS)
ndigit = NDIGITS;
pe = &buf[ndigit];
buf[0] = '\0';
*sign = 0;
if (value < 0) {
if (value < 0)
{
*sign = 1;
value = -value;
}
*decpt = 0;
if (value >= DBL_MAX) {
if (value >= DBL_MAX)
{
value = DBL_MAX;
}
if (value != 0.0) {
register struct powers_of_10 *pp = &p10[0];
if (value != 0.0)
{
register struct powers_of_10* pp = &p10[0];
if (value >= 10.0) do {
while (value >= pp->pval) {
value *= pp->rpval;
*decpt += pp->exp;
}
} while ((++pp)->exp > 0);
if (value >= 10.0)
do
{
while (value >= pp->pval)
{
value *= pp->rpval;
*decpt += pp->exp;
}
} while ((++pp)->exp > 0);
pp = &p10[0];
if (value < 1.0) do {
while (value * pp->pval < 10.0) {
value *= pp->pval;
*decpt -= pp->exp;
}
} while ((++pp)->exp > 0);
if (value < 1.0)
do
{
while (value * pp->pval < 10.0)
{
value *= pp->pval;
*decpt -= pp->exp;
}
} while ((++pp)->exp > 0);
(*decpt)++; /* because now value in [1.0, 10.0) */
(*decpt)++; /* because now value in [1.0, 10.0) */
}
if (! ecvtflag) {
if (!ecvtflag)
{
/* for fcvt() we need ndigit digits behind the dot */
pe += *decpt;
if (pe > &buf[NDIGITS]) pe = &buf[NDIGITS];
if (pe > &buf[NDIGITS])
pe = &buf[NDIGITS];
}
while (p <= pe) {
while (p <= pe)
{
*p++ = (int)value + '0';
value = 10.0 * (value - (int)value);
}
if (pe >= buf) {
if (pe >= buf)
{
p = pe;
*p += 5; /* round of at the end */
while (*p > '9') {
*p += 5; /* round of at the end */
while (*p > '9')
{
*p = '0';
if (p > buf) ++*--p;
else {
if (p > buf)
++*--p;
else
{
*p = '1';
++*decpt;
if (! ecvtflag) {
if (!ecvtflag)
{
/* maybe add another digit at the end,
because the point was shifted right
*/
if (pe > buf) *pe = '0';
if (pe > buf)
*pe = '0';
pe++;
}
}

8
lang/pc/libpc/diag.c
View file

@ -18,14 +18,14 @@
/* Author: J.W. Stevenson */
#include <pc_file.h>
#include "pc.h"
/* procedure diag(var f:text); */
diag(f) struct file *f; {
void diag(struct file* f)
{
f->ptr = f->bufadr;
f->flags = WRBIT|EOFBIT|ELNBIT|TXTBIT|MAGIC;
f->flags = WRBIT | EOFBIT | ELNBIT | TXTBIT | MAGIC;
f->fname = "DIAG";
f->ufd = 2;
f->size = 1;

14
lang/pc/libpc/efl.c
View file

@ -20,19 +20,15 @@
#include <stdlib.h>
#include <errno.h>
#include <pc_file.h>
#include <pc_err.h>
#include "pc.h"
extern struct file *_curfil;
extern _trp();
extern _incpt();
int _efl(f) struct file *f; {
int _efl(struct file* f)
{
_curfil = f;
if ((f->flags & 0377) != MAGIC)
_trp(EBADF);
if ((f->flags & (WINDOW|WRBIT|EOFBIT)) == 0)
if ((f->flags & (WINDOW | WRBIT | EOFBIT)) == 0)
_incpt(f);
return((f->flags & EOFBIT) != 0);
return ((f->flags & EOFBIT) != 0);
}

11
lang/pc/libpc/eln.c
View file

@ -18,16 +18,13 @@
/* Author: J.W. Stevenson */
#include <pc_file.h>
#include <pc_err.h>
#include "pc.h"
extern _trp();
extern _rf();
int _eln(f) struct file *f; {
int _eln(struct file* f)
{
_rf(f);
if (f->flags & EOFBIT)
_trp(EEOF);
return((f->flags & ELNBIT) != 0);
return ((f->flags & ELNBIT) != 0);
}

100
lang/pc/libpc/exp.c
View file

@ -8,54 +8,51 @@
/* $Id$ */
#define __NO_DEFS
#include <math.h>
#include <pc_err.h>
extern _trp();
#include "pc.h"
#if __STDC__
#include <float.h>
#include <pc_math.h>
#define M_MIN_D DBL_MIN
#define M_MAX_D DBL_MAX
#define M_MIN_D DBL_MIN
#define M_MAX_D DBL_MAX
#define M_DMINEXP DBL_MIN_EXP
#endif
#undef HUGE
#define HUGE 1e1000
#define HUGE 1e1000
static double
Ldexp(fl,exp)
double fl;
int exp;
static double Ldexp(double fl, int exp)
{
extern double _fef();
int sign = 1;
int currexp;
if (fl<0) {
if (fl < 0)
{
fl = -fl;
sign = -1;
}
fl = _fef(fl,&currexp);
fl = _fef(fl, &currexp);
exp += currexp;
if (exp > 0) {
while (exp>30) {
fl *= (double) (1L << 30);
if (exp > 0)
{
while (exp > 30)
{
fl *= (double)(1L << 30);
exp -= 30;
}
fl *= (double) (1L << exp);
fl *= (double)(1L << exp);
}
else {
while (exp<-30) {
fl /= (double) (1L << 30);
else
{
while (exp < -30)
{
fl /= (double)(1L << 30);
exp += 30;
}
fl /= (double) (1L << -exp);
fl /= (double)(1L << -exp);
}
return sign * fl;
}
double
_exp(x)
double x;
double _exp(double x)
{
/* Algorithm and coefficients from:
"Software manual for the elementary functions"
@ -63,56 +60,65 @@ _exp(x)
*/
static double p[] = {
0.25000000000000000000e+0,
0.75753180159422776666e-2,
0.25000000000000000000e+0,
0.75753180159422776666e-2,
0.31555192765684646356e-4
};
static double q[] = {
0.50000000000000000000e+0,
0.56817302698551221787e-1,
0.63121894374398503557e-3,
0.50000000000000000000e+0,
0.56817302698551221787e-1,
0.63121894374398503557e-3,
0.75104028399870046114e-6
};
double xn, g;
int n;
int negative = x < 0;
double xn, g;
int n;
int negative = x < 0;
if (x <= M_LN_MIN_D) {
g = M_MIN_D/4.0;
if (x <= M_LN_MIN_D)
{
g = M_MIN_D / 4.0;
if (g != 0.0) {
if (g != 0.0)
{
/* unnormalized numbers apparently exist */
if (x < (M_LN2 * (M_DMINEXP - 53))) return 0.0;
if (x < (M_LN2 * (M_DMINEXP - 53)))
return 0.0;
}
else {
if (x < M_LN_MIN_D) return 0.0;
else
{
if (x < M_LN_MIN_D)
return 0.0;
return M_MIN_D;
}
}
if (x >= M_LN_MAX_D) {
if (x > M_LN_MAX_D) {
if (x >= M_LN_MAX_D)
{
if (x > M_LN_MAX_D)
{
_trp(EEXP);
return HUGE;
}
return M_MAX_D;
}
if (negative) x = -x;
if (negative)
x = -x;
n = x * M_LOG2E + 0.5; /* 1/ln(2) = log2(e), 0.5 added for rounding */
n = x * M_LOG2E + 0.5; /* 1/ln(2) = log2(e), 0.5 added for rounding */
xn = n;
{
double x1 = (long) x;
double x2 = x - x1;
double x1 = (long)x;
double x2 = x - x1;
g = ((x1-xn*0.693359375)+x2) - xn*(-2.1219444005469058277e-4);
g = ((x1 - xn * 0.693359375) + x2) - xn * (-2.1219444005469058277e-4);
}
if (negative) {
if (negative)
{
g = -g;
n = -n;
}
xn = g * g;
x = g * POLYNOM2(xn, p);
n += 1;
return (Ldexp(0.5 + x/(POLYNOM3(xn, q) - x), n));
return (Ldexp(0.5 + x / (POLYNOM3(xn, q) - x), n));
}

11
lang/pc/libpc/get.c
View file

@ -16,16 +16,13 @@
*
*/
#include <pc_file.h>
#include <pc_err.h>
#include "pc.h"
extern _rf();
extern _trp();
_get(f) struct file *f; {
void _get(struct file* f)
{
_rf(f);
if (f->flags&EOFBIT)
if (f->flags & EOFBIT)
_trp(EEOF);
f->flags &= ~WINDOW;
}

13
lang/pc/libpc/hlt.c
View file

@ -18,18 +18,15 @@
/* Author: J.W. Stevenson */
#include <pc_file.h>
#include <unistd.h>
#include "pc.h"
extern struct file **_extfl;
extern int _extflc;
extern _cls();
extern _exit();
_hlt(ecode) int ecode; {
void _hlt(int ecode)
{
int i;
for (i = 0; i < _extflc; i++)
if (_extfl[i] != (struct file *) 0)
if (_extfl[i] != (struct file*)0)
_cls(_extfl[i]);
_exit(ecode);
}

62
lang/pc/libpc/incpt.c
View file

@ -21,51 +21,57 @@
#include <stdlib.h>
#include <errno.h>
#include <unistd.h>
#include <pc_file.h>
#include <pc_err.h>
extern _trp();
_incpt(f) struct file *f; {
#include "pc.h"
void _incpt(struct file* f)
{
if (f->flags & EOFBIT)
_trp(EEOF);
f->flags |= WINDOW;
f->flags &= ~ELNBIT;
#ifdef CPM
do {
do
{
#endif
f->ptr += f->size;
if (f->count == 0) {
f->ptr = f->bufadr;
for(;;) {
f->count=read(f->ufd,f->bufadr,f->buflen);
if ( f->count<0 ) {
if (errno != EINTR) _trp(EREAD) ;
continue ;
f->ptr += f->size;
if (f->count == 0)
{
f->ptr = f->bufadr;
for (;;)
{
f->count = read(f->ufd, f->bufadr, f->buflen);
if (f->count < 0)
{
if (errno != EINTR)
_trp(EREAD);
continue;
}
break;
}
if (f->count == 0)
{
f->flags |= EOFBIT;
*f->ptr = '\0';
return;
}
break ;
}
if (f->count == 0) {
f->flags |= EOFBIT;
*f->ptr = '\0';
return;
}
}
if ((f->count -= f->size) < 0)
_trp(EFTRUNC);
if ((f->count -= f->size) < 0)
_trp(EFTRUNC);
#ifdef CPM
} while ((f->flags&TXTBIT) && *f->ptr == '\r');
} while ((f->flags & TXTBIT) && *f->ptr == '\r');
#endif
if (f->flags & TXTBIT) {
if (f->flags & TXTBIT)
{
if (*f->ptr & 0200)
_trp(EASCII);
if (*f->ptr == '\n') {
if (*f->ptr == '\n')
{
f->flags |= ELNBIT;
*f->ptr = ' ';
}
#ifdef CPM
if (*f->ptr == 26) {
if (*f->ptr == 26)
{
f->flags |= EOFBIT;
*f->ptr = 0;
}

51
lang/pc/libpc/ini.c
View file

@ -18,44 +18,49 @@
/* Author: J.W. Stevenson */
#include <pc_file.h>
#include <pc_err.h>
#include "pc.h"
extern (*_sig())();
extern _catch();
int _pargc;
char** _pargv;
char** _penvp;
struct file **_extfl;
int _extflc; /* number of external files */
char *_m_lb; /* LB of _m_a_i_n */
struct file *_curfil; /* points to file struct in case of errors */
int _pargc;
char **_pargv;
char **_penvp;
int _fp_hook = 1; /* This is for Minix, but does not harm others */
char* _m_lb; /* LB of _m_a_i_n */
struct file* _curfil; /* points to file struct in case of errors */
_ini(args,c,p,mainlb) char *args,*mainlb; int c; struct file **p; {
struct file *f;
_pargc= *(int *)args; args += sizeof (int);
_pargv= *(char ***)args; args += sizeof (char **);
_penvp= *(char ***)args;
int _extflc;
struct file** _extfl;
int _fp_hook = 1; /* This is for Minix, but does not harm others */
void _ini(char *args, int c, struct file **p, char *mainlb)
{
struct file* f;
_pargc = *(int*)args;
args += sizeof(int);
_pargv = *(char***)args;
args += sizeof(char**);
_penvp = *(char***)args;
_sig(_catch);
_extfl = p;
_extflc = c;
if( !c ) return;
if (!c)
return;
_m_lb = mainlb;
if ( (f = _extfl[0]) != (struct file *) 0) {
if ((f = _extfl[0]) != (struct file*)0)
{
f->ptr = f->bufadr;
f->flags = MAGIC|TXTBIT;
f->flags = MAGIC | TXTBIT;
f->fname = "INPUT";
f->ufd = 0;
f->size = 1;
f->count = 0;
f->buflen = PC_BUFLEN;
}
if ( (f = _extfl[1]) != (struct file *) 0) {
if ((f = _extfl[1]) != (struct file*)0)
{
f->ptr = f->bufadr;
f->flags = MAGIC|TXTBIT|WRBIT|EOFBIT|ELNBIT;
f->flags = MAGIC | TXTBIT | WRBIT | EOFBIT | ELNBIT;
f->fname = "OUTPUT";
f->ufd = 1;
f->size = 1;

34
lang/pc/libpc/log.c
View file

@ -9,18 +9,15 @@
#define __NO_DEFS
#include <math.h>
#include <pc_err.h>
#include "pc.h"
#if __STDC__
#include <pc_math.h>
#include <float.h>
#endif
#undef HUGE
#define HUGE 1e1000
#define HUGE 1e1000
double
_log(x)
double x;
double _log(double x)
{
/* Algorithm and coefficients from:
"Software manual for the elementary functions"
@ -28,37 +25,40 @@ _log(x)
*/
static double a[] = {
-0.64124943423745581147e2,
0.16383943563021534222e2,
0.16383943563021534222e2,
-0.78956112887491257267e0
};
static double b[] = {
-0.76949932108494879777e3,
0.31203222091924532844e3,
0.31203222091924532844e3,
-0.35667977739034646171e2,
1.0
1.0
};
extern double _fef();
double znum, zden, z, w;
int exponent;
double znum, zden, z, w;
int exponent;
if (x <= 0) {
if (x <= 0)
{
_trp(ELOG);
return -HUGE;
}
x = _fef(x, &exponent);
if (x > M_1_SQRT2) {
if (x > M_1_SQRT2)
{
znum = (x - 0.5) - 0.5;
zden = x * 0.5 + 0.5;
}
else {
else
{
znum = x - 0.5;
zden = znum * 0.5 + 0.5;
exponent--;
}
z = znum/zden; w = z * z;
x = z + z * w * (POLYNOM2(w,a)/POLYNOM3(w,b));
z = znum / zden;
w = z * z;
x = z + z * w * (POLYNOM2(w, a) / POLYNOM3(w, b));
z = exponent;
x += z * (-2.121944400546905827679e-4);
return x + z * 0.693359375;

66
lang/pc/libpc/mdi.c
View file

@ -18,54 +18,66 @@
/* Author: J.W. Stevenson */
#include <pc_err.h>
#include "pc.h"
extern _trp();
int _mdi(j,i) int j,i; {
if (j <= 0)
_trp(EMOD);
i = i % j;
if (i < 0)
i += j;
return(i);
}
long _mdil(j,i) long j,i; {
int _mdi(int j, int i)
{
if (j <= 0)
_trp(EMOD);
i = i % j;
if (i < 0)
i += j;
return(i);
return (i);
}
int _dvi(j, i) unsigned int j,i; {
long _mdil(long j, long i)
{
if (j <= 0)
_trp(EMOD);
i = i % j;
if (i < 0)
i += j;
return (i);
}
int _dvi(unsigned int j, unsigned int i)
{
int neg = 0;
if ((int)j < 0) {
j = -(int)j; neg = 1;
if ((int)j < 0)
{
j = -(int)j;
neg = 1;
}
if ((int)i < 0) {
i = -(int)i; neg = !neg;
if ((int)i < 0)
{
i = -(int)i;
neg = !neg;
}
i = i / j;
if (neg) return -(int)i;
if (neg)
return -(int)i;
return i;
}
long _dvil(j, i) unsigned long j,i; {
long _dvil(unsigned long j, unsigned long i)
{
int neg = 0;
if ((long)j < 0) {
j = -(long)j; neg = 1;
if ((long)j < 0)
{
j = -(long)j;
neg = 1;
}
if ((long)i < 0) {
i = -(long)i; neg = !neg;
if ((long)i < 0)
{
i = -(long)i;
neg = !neg;
}
i = i / j;
if (neg) return -(long)i;
if (neg)
return -(long)i;
return i;
}

9
lang/pc/libpc/mdl.c
View file

@ -18,16 +18,15 @@
/* Author: J.W. Stevenson */
#include <pc_err.h>
#include "pc.h"
extern _trp();
long _mdl(j,i) long j,i; {
long _mdl(long j, long i)
{
if (j <= 0)
_trp(EMOD);
i = i % j;
if (i < 0)
i += j;
return(i);
return (i);
}

4
lang/pc/libpc/new.c
View file

@ -1,8 +1,6 @@
#include <stdlib.h>
#include <em_abs.h>
#include <pc_err.h>
extern void _trp(int); /* called on error */
#include "pc.h"
void _new(int n, void** ptr)
{

9
lang/pc/libpc/nfa.c
View file

@ -6,11 +6,10 @@
/* Author: Hans van Eck */
#include <pc_err.h>
#include "pc.h"
extern _trp();
_nfa(bool)
void _nfa(int bool)
{
if (! bool) _trp(EFUNASS);
if (!bool)
_trp(EFUNASS);
}

9
lang/pc/libpc/nobuff.c
View file

@ -18,15 +18,14 @@
/* Author: J.W. Stevenson */
#include <pc_file.h>
extern _flush();
#include "pc.h"
/* procedure nobuff(var f:file of ?); */
nobuff(f) struct file *f; {
void nobuff(struct file* f)
{
if ((f->flags & (0377|WRBIT)) != (MAGIC|WRBIT))
if ((f->flags & (0377 | WRBIT)) != (MAGIC | WRBIT))
return;
_flush(f);
f->count = f->buflen = f->size;

5
lang/pc/libpc/notext.c
View file

@ -16,8 +16,9 @@
*
*/
#include <pc_file.h>
#include "pc.h"
notext(f) struct file *f; {
void notext(struct file* f)
{
f->flags &= ~TXTBIT;
}

87
lang/pc/libpc/opn.c
View file

@ -19,24 +19,15 @@
/* Author: J.W. Stevenson */
#include <stdlib.h>
#include <fcntl.h>
#include <unistd.h>
#include <pc_file.h>
#include <pc_err.h>
#include "pc.h"
extern struct file **_extfl;
extern int _extflc;
extern struct file *_curfil;
extern int _pargc;
extern char **_pargv;
extern char **_penvp;
extern _cls();
extern _xcls();
extern _trp();
static int tmpfil() {
static int tmpfil(void)
{
static char namebuf[] = "/tmp/plf.xxxxx";
int i; char *p,*q;
int i;
char *p, *q;
i = getpid();
p = namebuf;
@ -45,70 +36,84 @@ static int tmpfil() {
*q++ = (i & 07) + '0';
while (i >>= 3);
*q = '\0';
if ((i = creat(p,0644)) < 0)
if ((i = creat(p += 4,0644)) < 0)
if ((i = creat(p += 5,0644)) < 0)
if ((i = creat(p, 0644)) < 0)
if ((i = creat(p += 4, 0644)) < 0)
if ((i = creat(p += 5, 0644)) < 0)
goto error;
if (close(i) != 0)
goto error;
if ((i = open(p,2)) < 0)
if ((i = open(p, 2)) < 0)
goto error;
if (remove(p) != 0)
error: _trp(EREWR);
return(i);
if (unlink(p) != 0)
error:
_trp(EREWR);
return (i);
}
static int initfl(descr,sz,f) int descr; int sz; struct file *f; {
static int initfl(int descr, int sz, struct file* f)
{
int i;
_curfil = f;
if (sz == 0) {
if (sz == 0)
{
sz++;
descr |= TXTBIT;
}
for (i=0; i<_extflc; i++)
for (i = 0; i < _extflc; i++)
if (f == _extfl[i])
break;
if (i >= _extflc) { /* local file */
if (i >= _extflc)
{ /* local file */
f->fname = "LOCAL";
if ((descr & WRBIT) == 0 && (f->flags & 0377) == MAGIC) {
if ((descr & WRBIT) == 0 && (f->flags & 0377) == MAGIC)
{
_xcls(f);
if (lseek(f->ufd,(long)0,0) == -1)
if (lseek(f->ufd, (long)0, 0) == -1)
_trp(ERESET);
} else {
}
else
{
_cls(f);
f->ufd = tmpfil();
}
} else { /* external file */
}
else
{ /* external file */
if (--i <= 0)
return(0);
return (0);
if (i >= _pargc)
_trp(EARGC);
f->fname = _pargv[i];
_cls(f);
if ((descr & WRBIT) == 0) {
if ((f->ufd = open(f->fname,0)) < 0)
if ((descr & WRBIT) == 0)
{
if ((f->ufd = open(f->fname, 0)) < 0)
_trp(ERESET);
} else {
if ((f->ufd = creat(f->fname,0644)) < 0)
}
else
{
if ((f->ufd = creat(f->fname, 0644)) < 0)
_trp(EREWR);
}
}
f->buflen = (sz>PC_BUFLEN ? sz : PC_BUFLEN-PC_BUFLEN%sz);
f->buflen = (sz > PC_BUFLEN ? sz : PC_BUFLEN - PC_BUFLEN % sz);
f->size = sz;
f->ptr = f->bufadr;
f->flags = descr;
return(1);
return (1);
}
_opn(sz,f) int sz; struct file *f; {
void _opn(int sz, struct file* f)
{
if (initfl(MAGIC,sz,f))
if (initfl(MAGIC, sz, f))
f->count = 0;
}
_cre(sz,f) int sz; struct file *f; {
void _cre(int sz, struct file* f)
{
if (initfl(WRBIT|EOFBIT|ELNBIT|MAGIC,sz,f))
if (initfl(WRBIT | EOFBIT | ELNBIT | MAGIC, sz, f))
f->count = f->buflen;
}

15
lang/pc/libpc/outcpt.c
View file

@ -21,26 +21,25 @@
#include <stdlib.h>
#include <errno.h>
#include <unistd.h>
#include <pc_file.h>
#include <pc_err.h>
#include "pc.h"
extern _trp();
_flush(f) struct file *f; {
int i,n;
void _flush(struct file* f)
{
int i, n;
f->ptr = f->bufadr;
n = f->buflen - f->count;
if (n <= 0)
return;
f->count = f->buflen;
if ((i = write(f->ufd,f->bufadr,n)) < 0 && errno == EINTR)
if ((i = write(f->ufd, f->bufadr, n)) < 0 && errno == EINTR)
return;
if (i != n)
_trp(EWRITE);
}
_outcpt(f) struct file *f; {
void _outcpt(struct file* f)
{
f->flags &= ~ELNBIT;
f->ptr += f->size;

36
lang/pc/libpc/pac.c
View file

@ -18,44 +18,40 @@
/* Author: J.W. Stevenson */
#include <pc_err.h>
#include "pc.h"
extern _trp();
#define assert(x) /* nothing */
#define assert(x) /* nothing */
#ifndef EM_WSIZE
#define EM_WSIZE _EM_WSIZE
#endif
struct descr {
int low;
int diff;
int size;
};
void _pac(struct descr *ad, struct descr *zd, char *zp, int i, char *ap)
{
_pac(ad,zd,zp,i,ap) int i; struct descr *ad,*zd; char *zp,*ap; {
if (zd->diff > ad->diff ||
(i -= ad->low) < 0 ||
(i+zd->diff) > ad->diff)
if (zd->diff > ad->diff || (i -= ad->low) < 0 || (i + zd->diff) > ad->diff)
_trp(EPACK);
ap += (i * ad->size);
i = (zd->diff + 1) * zd->size;
if (zd->size == 1) {
int *aptmp = (int *)ap;
if (zd->size == 1)
{
int* aptmp = (int*)ap;
assert(ad->size == EM_WSIZE);
while (--i >= 0)
*zp++ = *aptmp++;
#if EM_WSIZE > 2
} else if (zd->size == 2) {
int *aptmp = (int *)ap;
short *zptmp = (short *) zp;
}
else if (zd->size == 2)
{
int* aptmp = (int*)ap;
short* zptmp = (short*)zp;
assert(ad->size == EM_WSIZE);
while (--i >= 0)
*zptmp++ = *aptmp++;
#endif
} else {
}
else
{
assert(ad->size == zd->size);
while (--i >= 0)
*zp++ = *ap++;

7
lang/pc/libpc/pclose.c
View file

@ -16,12 +16,11 @@
*
*/
#include <pc_file.h>
extern _cls();
#include "pc.h"
/* procedure pclose(var f:file of ??); */
pclose(f) struct file *f; {
void pclose(struct file* f)
{
_cls(f);
}

17
lang/pc/libpc/pcreat.c
View file

@ -18,24 +18,21 @@
/* Author: J.W. Stevenson */
#include <unistd.h>
#include <pc_file.h>
#include <pc_err.h>
extern _cls();
extern _trp();
#include <unistd.h>
#include "pc.h"
/* procedure pcreat(var f:text; s:string); */
pcreat(f,s) struct file *f; char *s; {
void pcreat(struct file* f, char* s)
{
_cls(f); /* initializes _curfil */
_cls(f); /* initializes _curfil */
f->ptr = f->bufadr;
f->flags = WRBIT|EOFBIT|ELNBIT|TXTBIT|MAGIC;
f->flags = WRBIT | EOFBIT | ELNBIT | TXTBIT | MAGIC;
f->fname = s;
f->size = 1;
f->count = PC_BUFLEN;
f->buflen = PC_BUFLEN;
if ((f->ufd = creat(s,0644)) < 0)
if ((f->ufd = creat(s, 0644)) < 0)
_trp(EREWR);
}

16
lang/pc/libpc/pentry.c
View file

@ -18,18 +18,14 @@
/* Author: J.W. Stevenson */
#include <pc_file.h>
#include "pc.h"
extern struct file **_extfl;
extern _wrs();
extern _wrz();
extern _wln();
procentry(name) char *name; {
struct file *f;
void procentry(char* name)
{
struct file* f;
f = _extfl[1];
_wrs(5,"call ",f);
_wrz(name,f);
_wrs(5, "call ", f);
_wrz(name, f);
_wln(f);
}

6
lang/pc/libpc/perrno.c
View file

@ -19,7 +19,9 @@
/* function perrno:integer; extern; */
#include <errno.h>
#include "pc.h"
int perrno() {
return(errno);
int perrno(void)
{
return (errno);
}

16
lang/pc/libpc/pexit.c
View file

@ -16,18 +16,14 @@
*
*/
#include <pc_file.h>
#include "pc.h"
extern struct file **_extfl;
extern _wrs();
extern _wrz();
extern _wln();
procexit(name) char *name; {
struct file *f;
void procexit(char* name)
{
struct file* f;
f = _extfl[1];
_wrs(5,"exit ",f);
_wrz(name,f);
_wrs(5, "exit ", f);
_wrz(name, f);
_wln(f);
}

18
lang/pc/libpc/popen.c
View file

@ -18,24 +18,20 @@
/* Author: J.W. Stevenson */
#include <pc_file.h>
#include <pc_err.h>
extern _cls();
extern _trp();
extern int _open();
#include "fcntl.h"
#include "pc.h"
/* procedure popen(var f:text; s:string); */
popen(f,s) struct file *f; char *s; {
_cls(f); /* initializes _curfil */
void popen(struct file* f, char* s)
{
_cls(f); /* initializes _curfil */
f->ptr = f->bufadr;
f->flags = TXTBIT|MAGIC;
f->flags = TXTBIT | MAGIC;
f->fname = s;
f->size = 1;
f->count = 0;
f->buflen = PC_BUFLEN;
if ((f->ufd = _open(s,0)) < 0)
if ((f->ufd = open(s, 0)) < 0)
_trp(ERESET);
}

8
lang/pc/libpc/put.c
View file

@ -16,12 +16,10 @@
*
*/
#include <pc_file.h>
#include "pc.h"
extern _wf();
extern _outcpt();
_put(f) struct file *f; {
void _put(struct file* f)
{
_wf(f);
_outcpt(f);
}

17
lang/pc/libpc/rcka.c
View file

@ -6,20 +6,11 @@
/* Author: Hans van Eck */
#include <em_abs.h>
#include "pc.h"
#include <em_abs.h>
extern _trp();
struct array_descr {
int lbound;
unsigned n_elts_min_one;
unsigned size; /* doesn't really matter */
};
_rcka(descr, index)
struct array_descr *descr;
void _rcka(struct array_descr* descr, int index)
{
if( index < descr->lbound ||
index > (int) descr->n_elts_min_one + descr->lbound )
if (index < descr->lbound || index > (int)descr->n_elts_min_one + descr->lbound)
_trp(EARRAY);
}

10
lang/pc/libpc/rdc.c
View file

@ -16,16 +16,14 @@
*
*/
#include <pc_file.h>
#include "pc.h"
extern _rf();
extern _incpt();
int _rdc(f) struct file *f; {
int _rdc(struct file* f)
{
int c;
_rf(f);
c = *f->ptr;
_incpt(f);
return(c);
return (c);
}

46
lang/pc/libpc/rdi.c
View file

@ -18,61 +18,63 @@
/* Author: J.W. Stevenson */
#include <pc_file.h>
#include <pc_err.h>
#include "pc.h"
extern _trp();
extern _rf();
extern _incpt();
_skipsp(f) struct file *f; {
void _skipsp(struct file* f)
{
while ((*f->ptr == ' ') || (*f->ptr == '\t'))
_incpt(f);
}
int _getsig(f) struct file *f; {
int _getsig(struct file* f)
{
int sign;
if ((sign = (*f->ptr == '-')) || *f->ptr == '+')
_incpt(f);
return(sign);
return (sign);
}
int _fstdig(f) struct file *f; {
int _fstdig(struct file* f)
{
int ch;
ch = *f->ptr - '0';
if ((unsigned) ch > 9) {
if ((unsigned)ch > 9)
{
_trp(EDIGIT);
ch = 0;
}
return(ch);
return (ch);
}
int _nxtdig(f) struct file *f; {
int _nxtdig(struct file* f)
{
int ch;
_incpt(f);
ch = *f->ptr - '0';
if ((unsigned) ch > 9)
return(-1);
return(ch);
if ((unsigned)ch > 9)
return (-1);
return (ch);
}
int _getint(f) struct file *f; {
int is_signed,i,ch;
int _getint(struct file* f)
{
int is_signed, i, ch;
is_signed = _getsig(f);
ch = _fstdig(f);
i = 0;
do
i = i*10 - ch;
i = i * 10 - ch;
while ((ch = _nxtdig(f)) >= 0);
return(is_signed ? i : -i);
return (is_signed ? i : -i);
}
int _rdi(f) struct file *f; {
int _rdi(struct file* f)
{
_rf(f);
_skipsp(f);
return(_getint(f));
return (_getint(f));
}

18
lang/pc/libpc/rdl.c
View file

@ -18,16 +18,12 @@
/* Author: J.W. Stevenson */
#include <pc_file.h>
#include "pc.h"
extern _rf();
extern _skipsp();
extern int _getsig();
extern int _fstdig();
extern int _nxtdig();
long _rdl(f) struct file *f; {
int is_signed,ch; long l;
long _rdl(struct file* f)
{
int is_signed, ch;
long l;
_rf(f);
_skipsp(f);
@ -35,7 +31,7 @@ long _rdl(f) struct file *f; {
ch = _fstdig(f);
l = 0;
do
l = l*10 - ch;
l = l * 10 - ch;
while ((ch = _nxtdig(f)) >= 0);
return(is_signed ? l : -l);
return (is_signed ? l : -l);
}

43
lang/pc/libpc/rdr.c
View file

@ -18,31 +18,27 @@
/* Author: J.W. Stevenson */
#include <pc_file.h>
#include "pc.h"
#define BIG 1e17
#define BIG 1e17
extern _rf();
extern _incpt();
extern _skipsp();
extern int _getsig();
extern int _getint();
extern int _fstdig();
extern int _nxtdig();
static double r;
static int pow10;
static double r;
static int pow10;
static void dig(int ch)
{
static dig(ch) int ch; {
if (r>BIG)
if (r > BIG)
pow10++;
else
r = r*10.0 + ch;
r = r * 10.0 + ch;
}
double _rdr(f) struct file *f; {
int i; double e; int is_signed,ch;
double _rdr(struct file* f)
{
int i;
double e;
int is_signed, ch;
r = 0;
pow10 = 0;
@ -53,15 +49,18 @@ double _rdr(f) struct file *f; {
do
dig(ch);
while ((ch = _nxtdig(f)) >= 0);
if (*f->ptr == '.') {
if (*f->ptr == '.')
{
_incpt(f);
ch = _fstdig(f);
do {
do
{
dig(ch);
pow10--;
} while ((ch = _nxtdig(f)) >= 0);
}
if ((*f->ptr == 'e') || (*f->ptr == 'E')) {
if ((*f->ptr == 'e') || (*f->ptr == 'E'))
{
_incpt(f);
pow10 += _getint(f);
}
@ -70,9 +69,9 @@ double _rdr(f) struct file *f; {
e = 1.0;
while (--i >= 0)
e *= 10.0;
if (pow10<0)
if (pow10 < 0)
r /= e;
else
r *= e;
return(is_signed? -r : r);
return (is_signed ? -r : r);
}

12
lang/pc/libpc/rf.c
View file

@ -16,17 +16,13 @@
*
*/
#include <pc_file.h>
#include <pc_err.h>
#include "pc.h"
extern struct file *_curfil;
extern _trp();
extern _incpt();
_rf(f) struct file *f; {
void _rf(struct file* f)
{
_curfil = f;
if ((f->flags&0377) != MAGIC)
if ((f->flags & 0377) != MAGIC)
_trp(EBADF);
if (f->flags & WRBIT)
_trp(EREADF);

8
lang/pc/libpc/rln.c
View file

@ -16,12 +16,10 @@
*
*/
#include <pc_file.h>
#include "pc.h"
extern _rf();
extern _incpt();
_rln(f) struct file *f; {
void _rln(struct file* f)
{
_rf(f);
while ((f->flags & ELNBIT) == 0)

7
lang/pc/libpc/rnd.c
View file

@ -16,6 +16,9 @@
*
*/
double _rnd(r) double r; {
return(r + (r<0 ? -0.5 : 0.5));
#include "pc.h"
double _rnd(double r)
{
return (r + (r < 0 ? -0.5 : 0.5));
}

57
lang/pc/libpc/sin.c
View file

@ -9,14 +9,9 @@
#define __NO_DEFS
#include <math.h>
#include "pc.h"
#if __STDC__
#include <pc_math.h>
#endif
static double
sinus(x, cos_flag)
double x;
static double sinus(double x, int cos_flag)
{
/* Algorithm and coefficients from:
"Software manual for the elementary functions"
@ -25,34 +20,37 @@ sinus(x, cos_flag)
static double r[] = {
-0.16666666666666665052e+0,
0.83333333333331650314e-2,
0.83333333333331650314e-2,
-0.19841269841201840457e-3,
0.27557319210152756119e-5,
0.27557319210152756119e-5,
-0.25052106798274584544e-7,
0.16058936490371589114e-9,
0.16058936490371589114e-9,
-0.76429178068910467734e-12,
0.27204790957888846175e-14
0.27204790957888846175e-14
};
double xsqr;
double y;
int neg = 0;
double xsqr;
double y;
int neg = 0;
if (x < 0) {
if (x < 0)
{
x = -x;
neg = 1;
}
if (cos_flag) {
if (cos_flag)
{
neg = 0;
y = M_PI_2 + x;
}
else y = x;
else
y = x;
/* ??? avoid loss of significance, if y is too large, error ??? */
y = y * M_1_PI + 0.5;
/* Use extended precision to calculate reduced argument.
/* Use extended precision to calculate reduced argument.
Here we used 12 bits of the mantissa for a1.
Also split x in integer part x1 and fraction part x2.
*/
@ -60,11 +58,12 @@ sinus(x, cos_flag)
#define A2 -8.908910206761537356617e-6
{
double x1, x2;
extern double _fif();
_fif(y, 1.0, &y);
if (_fif(y, 0.5, &x1)) neg = !neg;
if (cos_flag) y -= 0.5;
_fif(y, 1.0, &y);
if (_fif(y, 0.5, &x1))
neg = !neg;
if (cos_flag)
y -= 0.5;
x2 = _fif(x, 1.0, &x1);
x = x1 - y * A1;
x += x2;
@ -73,7 +72,8 @@ sinus(x, cos_flag)
#undef A2
}
if (x < 0) {
if (x < 0)
{
neg = !neg;
x = -x;
}
@ -85,17 +85,14 @@ sinus(x, cos_flag)
return neg ? -x : x;
}
double
_sin(x)
double x;
double _sin(double x)
{
return sinus(x, 0);
}
double
_cos(x)
double x;
double _cos(double x)
{
if (x < 0) x = -x;
if (x < 0)
x = -x;
return sinus(x, 1);
}

55
lang/pc/libpc/sqt.c
View file

@ -8,64 +8,65 @@
/* $Id$ */
#define __NO_DEFS
#include <math.h>
#include <pc_err.h>
extern _trp();
#include "pc.h"
#define NITER 5
#define NITER 5
static double
Ldexp(fl,exp)
double fl;
int exp;
static double Ldexp(double fl, int exp)
{
extern double _fef();
int sign = 1;
int currexp;
if (fl<0) {
if (fl < 0)
{
fl = -fl;
sign = -1;
}
fl = _fef(fl,&currexp);
fl = _fef(fl, &currexp);
exp += currexp;
if (exp > 0) {
while (exp>30) {
fl *= (double) (1L << 30);
if (exp > 0)
{
while (exp > 30)
{
fl *= (double)(1L << 30);
exp -= 30;
}
fl *= (double) (1L << exp);
fl *= (double)(1L << exp);
}
else {
while (exp<-30) {
fl /= (double) (1L << 30);
else
{
while (exp < -30)
{
fl /= (double)(1L << 30);
exp += 30;
}
fl /= (double) (1L << -exp);
fl /= (double)(1L << -exp);
}
return sign * fl;
}
double
_sqt(x)
double x;
double _sqt(double x)
{
extern double _fef();
int exponent;
double val;
if (x <= 0) {
if (x < 0) _trp(ESQT);
if (x <= 0)
{
if (x < 0)
_trp(ESQT);
return 0;
}
val = _fef(x, &exponent);
if (exponent & 1) {
if (exponent & 1)
{
exponent--;
val *= 2;
}
val = Ldexp(val + 1.0, exponent/2 - 1);
val = Ldexp(val + 1.0, exponent / 2 - 1);
/* was: val = (val + 1.0)/2.0; val = Ldexp(val, exponent/2); */
for (exponent = NITER - 1; exponent >= 0; exponent--) {
for (exponent = NITER - 1; exponent >= 0; exponent--)
{
val = (val + x / val) / 2.0;
}
return val;

30
lang/pc/libpc/string.c
View file

@ -16,45 +16,53 @@
*
*/
#include "pc.h"
/* function strbuf(var b:charbuf):string; */
char *strbuf(s) char *s; {
return(s);
char* strbuf(char* s)
{
return (s);
}
/* function strtobuf(s:string; var b:charbuf; blen:integer):integer; */
int strtobuf(s,b,l) char *s,*b; {
int strtobuf(char* s, char* b, int l)
{
int i;
i = 0;
while (--l>=0) {
while (--l >= 0)
{
if ((*b++ = *s++) == 0)
break;
i++;
}
return(i);
return (i);
}
/* function strlen(s:string):integer; */
int strlen(s) char *s; {
int strlen(char* s)
{
int i;
i = 0;
while (*s++)
i++;
return(i);
return (i);
}
/* function strfetch(s:string; i:integer):char; */
int strfetch(s,i) char *s; {
return(s[i-1]);
int strfetch(char* s, int i)
{
return (s[i - 1]);
}
/* procedure strstore(s:string; i:integer; c:char); */
strstore(s,i,c) char *s; {
s[i-1] = c;
void strstore(char* s, int i, int c)
{
s[i - 1] = c;
}

48
lang/pc/libpc/unp.c
View file

@ -18,46 +18,46 @@
/* Author: J.W. Stevenson */
#include <pc_err.h>
#include "pc.h"
extern _trp();
#define assert(x) /* nothing */
#define assert(x) /* nothing */
#ifndef EM_WSIZE
#define EM_WSIZE _EM_WSIZE
#endif
struct descr {
int low;
int diff;
int size;
};
void _unp(struct descr *ad, struct descr *zd, int i, char *ap, char *zp, int noext)
{
_unp(ad,zd,i,ap,zp,noext) int i; struct descr *ad,*zd; char *ap,*zp; int noext; {
if (zd->diff > ad->diff ||
(i -= ad->low) < 0 ||
(i+zd->diff) > ad->diff)
if (zd->diff > ad->diff || (i -= ad->low) < 0 || (i + zd->diff) > ad->diff)
_trp(EUNPACK);
ap += (i * ad->size);
i = (zd->diff + 1) * zd->size;
if (zd->size == 1) {
int *aptmp = (int *) ap;
if (zd->size == 1)
{
int* aptmp = (int*)ap;
assert(ad->size == EM_WSIZE);
while (--i >= 0)
if (noext) *aptmp++ = *zp++ & 0377;
else *aptmp++ = *zp++;
if (noext)
*aptmp++ = *zp++ & 0377;
else
*aptmp++ = *zp++;
#if EM_WSIZE > 2
} else if (zd->size == 2) {
int *aptmp = (int *) ap;
short *zptmp = (short *) zp;
}
else if (zd->size == 2)
{
int* aptmp = (int*)ap;
short* zptmp = (short*)zp;
assert(ad->size == EM_WSIZE);
while (--i >= 0)
if (noext) *aptmp++ = *zptmp++ & 0177777;
else *aptmp++ = *zptmp++;
if (noext)
*aptmp++ = *zptmp++ & 0177777;
else
*aptmp++ = *zptmp++;
#endif
} else {
}
else
{
assert(ad->size == zd->size);
while (--i >= 0)
*ap++ = *zp++;

6
lang/pc/libpc/uread.c
View file

@ -20,7 +20,9 @@
#include <stdlib.h>
#include <unistd.h>
#include "pc.h"
int uread(fd,b,n) char *b; int fd,n; {
return(read(fd,b,n));
int uread(int fd, char* b, int n)
{
return (read(fd, b, n));
}

6
lang/pc/libpc/uwrite.c
View file

@ -20,7 +20,9 @@
#include <stdlib.h>
#include <unistd.h>
#include "pc.h"
int uwrite(fd,b,n) char *b; int fd,n; {
return(write(fd,b,n));
int uwrite(int fd, char* b, int n)
{
return (write(fd, b, n));
}

13
lang/pc/libpc/wdw.c
View file

@ -16,15 +16,12 @@
*
*/
#include <pc_file.h>
extern struct file *_curfil;
extern _incpt();
char *_wdw(f) struct file *f; {
#include "pc.h"
char* _wdw(struct file* f)
{
_curfil = f;
if ((f->flags & (WINDOW|WRBIT|0377)) == MAGIC)
if ((f->flags & (WINDOW | WRBIT | 0377)) == MAGIC)
_incpt(f);
return(f->ptr);
return (f->ptr);
}

11
lang/pc/libpc/wf.c
View file

@ -16,16 +16,13 @@
*
*/
#include <pc_file.h>
#include <pc_err.h>
#include "pc.h"
extern struct file *_curfil;
extern _trp();
_wf(f) struct file *f; {
void _wf(struct file* f)
{
_curfil = f;
if ((f->flags&0377) != MAGIC)
if ((f->flags & 0377) != MAGIC)
_trp(EBADF);
if ((f->flags & WRBIT) == 0)
_trp(EWRITEF);

20
lang/pc/libpc/wrc.c
View file

@ -16,26 +16,26 @@
*
*/
#include <pc_file.h>
#include "pc.h"
extern _wf();
extern _outcpt();
_wrc(c,f) int c; struct file *f; {
void _wrc(int c, struct file* f)
{
*f->ptr = c;
_wf(f);
_outcpt(f);
}
_wln(f) struct file *f; {
void _wln(struct file* f)
{
#ifdef CPM
_wrc('\r',f);
_wrc('\r', f);
#endif
_wrc('\n',f);
_wrc('\n', f);
f->flags |= ELNBIT;
}
_pag(f) struct file *f; {
_wrc('\014',f);
void _pag(struct file* f)
{
_wrc('\014', f);
f->flags |= ELNBIT;
}

42
lang/pc/libpc/wrf.c
View file

@ -18,36 +18,36 @@
/* Author: J.W. Stevenson */
#include <pc_err.h>
#include <pc_file.h>
#include "pc.h"
extern _wstrin();
extern char *_fcvt();
#define assert(x) /* nothing */
#define assert(x) /* nothing */
#if __STDC__
#include <float.h>
#define HUGE_DIG DBL_MAX_10_EXP /* log10(maxreal) */
#define HUGE_DIG DBL_MAX_10_EXP /* log10(maxreal) */
#else
#define HUGE_DIG 400 /* log10(maxreal) */
#define HUGE_DIG 400 /* log10(maxreal) */
#endif
#define PREC_DIG 80 /* the maximum digits returned by _fcvt() */
#define FILL_CHAR '0' /* char printed if all of _fcvt() used */
#define BUFSIZE HUGE_DIG + PREC_DIG + 3
#define PREC_DIG 80 /* the maximum digits returned by _fcvt() */
#define FILL_CHAR '0' /* char printed if all of _fcvt() used */
#define BUFSIZE HUGE_DIG + PREC_DIG + 3
_wrf(n,w,r,f) int n,w; double r; struct file *f; {
char *p,*b; int s,d; char buf[BUFSIZE];
void _wrf(int n, int w, double r, struct file* f)
{
char *p, *b;
int s, d;
char buf[BUFSIZE];
if ( n < 0 || w < 0) _trp(EWIDTH);
if (n < 0 || w < 0)
_trp(EWIDTH);
p = buf;
if (n > PREC_DIG)
n = PREC_DIG;
b = _fcvt(r,n,&d,&s);
b = _fcvt(r, n, &d, &s);
assert(abs(d) <= HUGE_DIG);
if (s)
*p++ = '-';
if (d<=0)
if (d <= 0)
*p++ = '0';
else
do
@ -55,14 +55,16 @@ _wrf(n,w,r,f) int n,w; double r; struct file *f; {
while (--d > 0);
if (n > 0)
*p++ = '.';
while (++d <= 0) {
while (++d <= 0)
{
if (--n < 0)
break;
*p++ = '0';
}
while (--n >= 0) {
while (--n >= 0)
{
*p++ = (*b ? *b++ : FILL_CHAR);
assert(p <= buf+BUFSIZE);
assert(p <= buf + BUFSIZE);
}
_wstrin(w,(int)(p-buf),buf,f);
_wstrin(w, (int)(p - buf), buf, f);
}

42
lang/pc/libpc/wri.c
View file

@ -16,10 +16,7 @@
*
*/
#include <pc_err.h>
#include <pc_file.h>
extern _wstrin();
#include "pc.h"
#ifndef EM_WSIZE
#ifdef _EM_WSIZE
@ -27,46 +24,53 @@ extern _wstrin();
#endif
#endif
#if EM_WSIZE==4
#if EM_WSIZE == 4
#define SZ 11
#define MININT -2147483648
#define STRMININT "-2147483648"
#endif
#if EM_WSIZE==2
#if EM_WSIZE == 2
#define SZ 6
#define MININT -32768
#define STRMININT "-32768"
#endif
#if EM_WSIZE==1
#if EM_WSIZE == 1
#define SZ 4
#define MININT -128
#define STRMININT "-128"
#endif
#ifndef STRMININT
Something wrong here!
Something wrong here !
#endif
_wsi(w,i,f) int w,i; struct file *f; {
char *p; int j; char buf[SZ];
void _wsi(int w, int i, struct file* f)
{
char* p;
int j;
char buf[SZ];
if (w < 0) _trp(EWIDTH);
if (w < 0)
_trp(EWIDTH);
p = &buf[SZ];
if ((j=i) < 0) {
if (i == MININT) {
_wstrin(w,SZ,STRMININT,f);
if ((j = i) < 0)
{
if (i == MININT)
{
_wstrin(w, SZ, STRMININT, f);
return;
}
j = -j;
}
do
*--p = '0' + j%10;
*--p = '0' + j % 10;
while (j /= 10);
if (i<0)
if (i < 0)
*--p = '-';
_wstrin(w,(int)(&buf[SZ]-p),p,f);
_wstrin(w, (int)(&buf[SZ] - p), p, f);
}
_wri(i,f) int i; struct file *f; {
_wsi(SZ,i,f);
void _wri(int i, struct file* f)
{
_wsi(SZ, i, f);
}

40
lang/pc/libpc/wrl.c
View file

@ -18,34 +18,38 @@
/* Author: J.W. Stevenson */
#include <pc_err.h>
#include <pc_file.h>
#include "pc.h"
#include <limits.h>
extern _wstrin();
void _wsl(int w, long l, struct file* f)
{
char *p, c;
long j;
char buf[11];
#define MAXNEGLONG -2147483648
_wsl(w,l,f) int w; long l; struct file *f; {
char *p,c; long j; char buf[11];
if (w < 0) _trp(EWIDTH);
if (w < 0)
_trp(EWIDTH);
p = &buf[11];
if ((j=l) < 0) {
if (l == MAXNEGLONG) {
_wstrin(w,11,"-2147483648",f);
if ((j = l) < 0)
{
if (l == LONG_MIN)
{
_wstrin(w, 11, "-2147483648", f);
return;
}
j = -j;
}
do {
c = j%10;
do
{
c = j % 10;
*--p = c + '0';
} while (j /= 10);
if (l<0)
if (l < 0)
*--p = '-';
_wstrin(w,(int)(&buf[11]-p),p,f);
_wstrin(w, (int)(&buf[11] - p), p, f);
}
_wrl(l,f) long l; struct file *f; {
_wsl(11,l,f);
void _wrl(long l, struct file* f)
{
_wsl(11, l, f);
}

49
lang/pc/libpc/wrr.c
View file

@ -18,23 +18,23 @@
/* Author: J.W. Stevenson */
#include <pc_err.h>
#include <pc_file.h>
#include "pc.h"
extern _wstrin();
extern char *_ecvt();
#define PREC_DIG 80 /* maximum digits produced by _ecvt() */
#define PREC_DIG 80 /* maximum digits produced by _ecvt() */
void _wsr(int w, double r, struct file* f)
{
char *p, *b;
int s, d, i;
char buf[PREC_DIG + 7];
_wsr(w,r,f) int w; double r; struct file *f; {
char *p,*b; int s,d,i; char buf[PREC_DIG+7];
if (w < 0) _trp(EWIDTH);
if (w < 0)
_trp(EWIDTH);
p = buf;
if ((i = w-6) < 2)
if ((i = w - 6) < 2)
i = 2;
b = _ecvt(r,i,&d,&s);
*p++ = s? '-' : ' ';
b = _ecvt(r, i, &d, &s);
*p++ = s ? '-' : ' ';
if (*b == '0')
d++;
*p++ = *b++;
@ -43,25 +43,30 @@ _wsr(w,r,f) int w; double r; struct file *f; {
*p++ = *b++;
*p++ = 'e';
d--;
if (d < 0) {
if (d < 0)
{
d = -d;
*p++ = '-';
} else
}
else
*p++ = '+';
if (d >= 1000) {
if (d >= 1000)
{
*p++ = '*';
*p++ = '*';
*p++ = '*';
}
else {
*p++ = '0' + d/100;
*p++ = '0' + (d/10) % 10;
*p++ = '0' + d%10;
else
{
*p++ = '0' + d / 100;
*p++ = '0' + (d / 10) % 10;
*p++ = '0' + d % 10;
}
_wstrin(w,(int)(p-buf),buf,f);
_wstrin(w, (int)(p - buf), buf, f);
}
_wrr(r,f) double r; struct file *f; {
_wsr(13,r,f);
void _wrr(double r, struct file* f)
{
_wsr(13, r, f);
}

54
lang/pc/libpc/wrs.c
View file

@ -18,51 +18,55 @@
/* Author: J.W. Stevenson */
#include <pc_err.h>
#include <pc_file.h>
extern _wf();
extern _outcpt();
_wstrin(width,len,buf,f) int width,len; char *buf; struct file *f; {
#include "pc.h"
void _wstrin(int width, int len, char* buf, struct file* f)
{
_wf(f);
for (width -= len; width>0; width--) {
for (width -= len; width > 0; width--)
{
*f->ptr = ' ';
_outcpt(f);
}
while (--len >= 0) {
while (--len >= 0)
{
*f->ptr = *buf++;
_outcpt(f);
}
}
_wsc(w,c,f) int w; char c; struct file *f; {
if (w < 0) _trp(EWIDTH);
_wss(w,1,&c,f);
void _wsc(int w, char c, struct file* f)
{
if (w < 0)
_trp(EWIDTH);
_wss(w, 1, &c, f);
}
_wss(w,len,s,f) int w,len; char *s; struct file *f; {
if (w < 0 || len < 0) _trp(EWIDTH);
void _wss(int w, int len, char* s, struct file* f)
{
if (w < 0 || len < 0)
_trp(EWIDTH);
if (w < len)
len = w;
_wstrin(w,len,s,f);
_wstrin(w, len, s, f);
}
_wrs(len,s,f) int len; char *s; struct file *f; {
if (len < 0) _trp(EWIDTH);
_wss(len,len,s,f);
void _wrs(int len, char* s, struct file* f)
{
if (len < 0)
_trp(EWIDTH);
_wss(len, len, s, f);
}
_wsb(w,b,f) int w,b; struct file *f; {
void _wsb(int w, int b, struct file* f)
{
if (b)
_wss(w,4,"true",f);
_wss(w, 4, "true", f);
else
_wss(w,5,"false",f);
_wss(w, 5, "false", f);
}
_wrb(b,f) int b; struct file *f; {
_wsb(5,b,f);
void _wrb(int b, struct file* f)
{
_wsb(5, b, f);
}

29
lang/pc/libpc/wrz.c
View file

@ -16,23 +16,24 @@
*
*/
#include <pc_err.h>
#include <pc_file.h>
#include "pc.h"
extern _wss();
extern _wrs();
void _wsz(int w, char* s, struct file* f)
{
char* p;
_wsz(w,s,f) int w; char *s; struct file *f; {
char *p;
if (w < 0) _trp(EWIDTH);
for (p=s; *p; p++);
_wss(w,(int)(p-s),s,f);
if (w < 0)
_trp(EWIDTH);
for (p = s; *p; p++)
;
_wss(w, (int)(p - s), s, f);
}
_wrz(s,f) char *s; struct file *f; {
char *p;
void _wrz(char* s, struct file* f)
{
char* p;
for (p=s; *p; p++);
_wrs((int)(p-s),s,f);
for (p = s; *p; p++)
;
_wrs((int)(p - s), s, f);
}

4
plat/build.lua
View file

@ -11,7 +11,7 @@ definerule("ackfile",
suffix = { type="string", optional=true },
},
function (e)
local em = e.vars.plat:find("^em")
local em = (e.vars.plat or ""):find("^em")
local suffix = e.suffix or (em and ".m" or ".o")
local c = "-c"..suffix
local plat = e.vars.plat
@ -47,7 +47,7 @@ definerule("acklibrary",
deps = { type="targets", default={} },
},
function (e)
local em = e.vars.plat:find("^em")
local em = (e.vars.plat or ""):find("^em")
return clibrary {
name = e.name,
srcs = e.srcs,

1
plat/cpm/include/unistd.h
View file

@ -45,6 +45,7 @@ extern int open(const char* path, int access, ...);
extern int creat(const char* path, mode_t mode);
extern int read(int fd, void* buffer, size_t count);
extern int write(int fd, void* buffer, size_t count);
extern int unlink(const char* path);
/* Unimplemented system calls (these are just prototypes to let the library
* compile). */

1
plat/pc86/include/unistd.h
View file

@ -46,6 +46,7 @@ extern int open(const char* path, int access, ...);
extern int creat(const char* path, mode_t mode);
extern int read(int fd, void* buffer, size_t count);
extern int write(int fd, void* buffer, size_t count);
extern int unlink(const char* path);
/* Unimplemented system calls (these are just prototypes to let the library
* compile). */

1
plat/pdpv7/include/unistd.h
View file

@ -67,6 +67,7 @@ extern int open(const char* path, int access, ...);
extern int creat(const char* path, mode_t mode);
extern int read(int fd, void* buffer, size_t count);
extern int write(int fd, void* buffer, size_t count);
extern int unlink(const char* path);
/* Unimplemented system calls (these are just prototypes to let the library
* compile). */

2
plat/rpi/include/unistd.h
View file

@ -67,6 +67,7 @@ extern int open(const char* path, int access, ...);
extern int creat(const char* path, mode_t mode);
extern int read(int fd, void* buffer, size_t count);
extern int write(int fd, void* buffer, size_t count);
extern int unlink(const char* path);
/* Unimplemented system calls (these are just prototypes to let the library
* compile). */
@ -89,6 +90,7 @@ typedef int sig_atomic_t;
typedef void (*sighandler_t)(int);
extern sighandler_t signal(int signum, sighandler_t handler);
extern int raise(int signum);
extern int kill(pid_t pid, int sig);
/* Select */

8
tests/plat/lib/test_b.c
View file

@ -1,8 +1,8 @@
#include <stdint.h>
#include "test.h"
extern void patch_addresses(uintptr_t* module);
extern uintptr_t* bmodule_main;
extern void patch_addresses(uintptr_t** module);
extern uintptr_t* bmodule_main[];
static void i_writehex(intptr_t code)
{
@ -28,7 +28,7 @@ static uintptr_t* bmodule_test[] =
void binit(void)
{
patch_addresses(&bmodule_test);
patch_addresses(&bmodule_main);
patch_addresses(bmodule_test);
patch_addresses(bmodule_main);
}