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

Merge pull request #81 from kernigh/kernigh-libfp

Browse source 
software floats, line editor for CP/M
This commit is contained in:
David Given 2018-05-12 00:59:05 +02:00 committed by GitHub
parent aabf0bdd69 019c7f9da7
commit f8dfdef974
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
14 changed files with 409 additions and 162 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
build.lua
View file

@ -4,6 +4,7 @@ vars.cflags = {
vars.ackcflags = {
"-O6"
}
vars.ackldflags = {}
vars.plats = {
"cpm",
"linux386",

16
examples/build.lua
View file

@ -4,6 +4,10 @@ local conly = {
rpi = true
}
local softfp = {
cpm = true,
}
local sourcefiles = filenamesof(
"./hilo.b",
"./hilo.bas",
@ -15,6 +19,11 @@ local sourcefiles = filenamesof(
"./startrek.c"
)
local usesfp = {
["mandelbrot.c"] = true,
["startrek.c"] = true,
}
local installmap = {}
for _, file in ipairs(sourcefiles) do
local b = basename(file)
@ -22,6 +31,12 @@ for _, file in ipairs(sourcefiles) do
local _, _, e = b:find("%.(%w*)$")
for _, plat in ipairs(vars.plats) do
local flags = {}
if softfp[plat] and usesfp[b] then
flags[#flags+1] = "-fp"
end
if (e == "c") or not conly[plat] then
local exe = ackprogram {
name = be.."_"..plat,
@ -29,6 +44,7 @@ for _, file in ipairs(sourcefiles) do
vars = {
plat = plat,
lang = e,
["+ackldflags"] = flags,
}
}

41
examples/hilo.p
View file

@ -9,7 +9,6 @@ program hilo(input, output);
type
string = packed array [0..255] of char;
charstar = packed array [0..0] of char;
var
playing : Boolean;
@ -30,47 +29,25 @@ function random(range : integer) : integer;
random := seed mod range;
end;
{ Pascal doesn't provide string input, so we interface to the read() syscall
and do it manually. But... we can't interface to read() directly because
that conflicts with a Pascal keyword. Luckily there's a private function
uread() in the ACK Pascal library that we can use instead. }
function uread(fd : integer; var buffer : charstar; count : integer) : integer;
extern;
{ Pascal doesn't provide string input, so we read characters until the
end of line and put them in a string. }
function readchar : char;
var
c : charstar;
dummy : integer;
begin
c[0] := chr(0);
dummy := uread(0, c, 1);
readchar := c[0];
end;
procedure readstring(var buffer : string; var length : integer);
var
finished : Boolean;
c : char;
begin
write('> ');
length := 0;
finished := FALSE;
seed := 0;
while not finished do
repeat
begin
c := readchar;
if (ord(c) = 10) then
finished := true
else
begin
buffer[length] := c;
length := length + 1;
end
end;
read(c);
buffer[length] := c;
length := length + 1;
end
until eoln;
readln; { discard end of line }
end;
procedure getname;

195
examples/startrek.c
View file

@ -58,7 +58,18 @@
*
*/
/* For `ack -mcpm -fp`, the i80 code was too big. Make it smaller by
* removing the game's intro and replacing part of libc. */
#ifdef __i80
#define SMALL
#endif
#ifdef SMALL
#include <stdarg.h>
#include <unistd.h>
#else
#include <stdio.h>
#endif
#include <stdlib.h>
#include <string.h>
#include <math.h>
@ -134,13 +145,26 @@ int cint(double d);
void compute_vector(void);
void sub1(void);
void sub2(void);
#ifndef SMALL
void showfile(char *filename);
int openfile(char * sFilename, char * sMode);
void closefile(void);
int get_line(char *s);
#endif
void randomize(void);
int get_rand(int iSpread);
double rnd(void);
#ifdef SMALL
#undef atof
#define atof trek_atof
#define getchar trek_getchar
#define putchar trek_putchar
#define printf trek_printf
double atof(const char *);
static int getchar(void);
static void putchar(int c);
void printf(const char *fmt, ...);
#endif
/* Global Variables */
@ -196,14 +220,20 @@ char sQ[194]; /* Visual Display of Quadrant */
string sG2; /* Used to pass string results */
#ifndef SMALL
FILE *stream;
bool bFlag = FALSE; /* Prevent multiple file opens */
#endif
void
reads(char* buffer)
{
#ifdef SMALL
read(0, buffer, sizeof(string));
#else
fflush(stdout);
fgets(buffer, sizeof(string), stdin);
#endif
}
/* Main Program */
@ -224,6 +254,7 @@ intro(void)
{
string sTemp;
#ifndef SMALL
printf ("\n\n");
printf (" *************************************\n");
printf (" * *\n");
@ -239,6 +270,7 @@ intro(void)
if (sTemp[0] == 'y' || sTemp[0] == 'Y')
showfile("startrek.doc");
#endif /* !SMALL */
printf ("\n\n\n\n\n\n\n");
printf(" ------*------\n");
@ -1879,6 +1911,7 @@ cint (double d)
return(i);
}
#ifndef SMALL
void
showfile(char *filename)
{
@ -1934,6 +1967,7 @@ get_line(char *s)
else
return(strlen(s));
}
#endif /* !SMALL */
/* Seed the randomizer with the timer */
void
@ -1960,3 +1994,164 @@ rnd(void)
return(d);
}
#ifdef SMALL
/* These are small but incomplete replacements for functions in libc.
* Local variables are static for smaller i80 code. */
double
atof(const char *str)
{
static double d;
static char n, prec;
d = 0.0;
n = prec = 0; /* Forget to skip whitespace before number */
if (*str == '-') { n = 1; str++; }
for (;;)
{
if (*str >= '0' && *str <= '9')
{
d = 10.0 * d + (double)(*str - '0');
if (prec != 0) prec++;
}
else if (*str == '.')
prec++;
else
break; /* Forget to parse exponent like "e10" */
str++;
}
while (prec > 1) { d /= 10.0; prec--; }
return n ? -d : d;
}
static int
getchar(void)
{
static unsigned char c[2]; /* CP/M read() needs 2 bytes */
if (read(0, c, 2) > 0)
return c[0];
else
return -1;
}
static void
putchar(int c)
{
write(1, &c, 1);
}
struct printf_buf {
char p_buf[13];
char p_len;
char *p_str;
};
static struct printf_buf pfb;
static void
pfb_put(int c)
{
if (pfb.p_str != pfb.p_buf)
{
pfb.p_str--;
*pfb.p_str = c; /* Prepend character to buffer */
pfb.p_len++;
}
else
pfb.p_len = 0; /* No room in buffer; force empty string */
}
void
printf(const char *fmt, ...)
{
static va_list ap;
static const char *s;
va_start(ap, fmt);
while (*fmt != '\0')
{
if (*fmt != '%')
{
s = fmt;
do { s++; } while ( *s != '\0' && *s != '%');
write(1, fmt, s - fmt);
fmt = s;
}
if (*fmt == '%')
{
static char prec, width;
fmt++; /* Pass '%' */
/* Read optional width.prec, as 4.2 in "%4.2f" */
prec = width = 0;
if (*fmt >= '0' && *fmt <= '9')
{
width = *fmt - '0';
fmt++;
}
if (*fmt == '.')
{
fmt++;
if (*fmt >= '0' && *fmt <= '9')
{
prec = *fmt - '0';
fmt++;
}
}
if (*fmt == 's') /* Format "%s" */
{
static const char *s;
s = va_arg(ap, const char *);
write(1, s, strlen(s));
}
else /* Format "%d" or "%f" */
{
static double d;
static char n, pad;
if (*fmt == 'd')
{
d = (double)va_arg(ap, int);
prec = 0; /* No digits after point */
pad = '0';
}
else
{
d = va_arg(ap, double);
/* Move digits before point */
for (n = prec; n != 0; n--) d *= 10.0;
pad = ' ';
}
/* Set up buffer */
pfb.p_len = 0;
pfb.p_str = pfb.p_buf + sizeof(pfb.p_buf);
/* Change negative number to positive */
n = 0;
if (d < 0) { n = 1; d = -d; }
modf(d + 0.5, &d); /* Round last digit */
for (;;)
{
d /= 10.0; /* Extract next digit */
/* Use 10.5 instead of 10.0 to decrease error */
pfb_put('0' + (int)(10.5 * modf(d, &d)));
if (prec != 0)
{
prec--;
if (prec == 0) pfb_put('.');
}
else if (d < 1.0)
break; /* No more digits */
}
if (n) pfb_put('-');
while(pfb.p_len < width) pfb_put(pad);
write(1, pfb.p_str, pfb.p_len);
}
fmt++; /* Pass 's' in "%s" */
}
}
va_end(ap);
}
#endif /* SMALL */

3
first/build.lua
View file

@ -40,6 +40,7 @@ definerule("cfile",
{
srcs = { type="targets" },
deps = { type="targets", default={} },
suffix = { type="string", default=".o" },
commands = {
type="strings",
default={
@ -56,7 +57,7 @@ definerule("cfile",
end
hdrpaths = uniquify(hdrpaths)
local outleaf = basename(e.name)..".o"
local outleaf = basename(e.name)..e.suffix
return normalrule {
name = e.name,

14
mach/i80/libem/flp.s
View file

@ -1,7 +1,6 @@
.define .adf4,.adf8,.sbf4,.sbf8,.mlf4,.mlf8,.dvf4,.dvf8
.define .ngf4,.ngf8,.fif4,.fif8,.fef4,.fef8
.define .zrf4,.zrf8
.define .cfi,.cif,.cuf,.cff,.cfu
.define .cfi,.cif4,.cif8,.cuf4,.cuf8,.cff4,.cff8,.cfu
.define .cmf4,.cmf8
.sect .text
.sect .rom
@ -25,12 +24,13 @@
.fif8:
.fef4:
.fef8:
.zrf4:
.zrf8:
.cfi:
.cif:
.cuf:
.cff:
.cif4:
.cif8:
.cuf4:
.cuf8:
.cff4:
.cff8:
.cfu:
.cmf4:
.cmf8:

21
mach/i80/ncg/mach.c
View file

@ -41,21 +41,12 @@ con_mult(sz) word sz; {
fprintf(codefile,".data4\t%ld\n",atol(str));
}
void
con_float() {
static int warning_given;
int i = argval;
if (!warning_given) {
fprintf(stderr, "warning: dummy floating point constant\n");
warning_given = 1;
}
while (i > 0) {
fputs(".data4 0 !dummy float\n", codefile);
i -= 4;
}
}
#define CODE_GENERATOR
#define IEEEFLOAT
#define FL_MSL_AT_LOW_ADDRESS 0
#define FL_MSW_AT_LOW_ADDRESS 0
#define FL_MSB_AT_LOW_ADDRESS 0
#include <con_float>
void
prolog(nlocals) full nlocals; {

131
mach/i80/ncg/table
View file

@ -817,61 +817,28 @@ gen mvi a,{const1,0}
/* Group 5: Floating point arithmetic */
/********************************************/
pat adf $1==4
kills ALL
gen Call {label,".adf4"}
pat adf $1==8
kills ALL
gen Call {label,".adf8"}
pat sbf $1==4
kills ALL
gen Call {label,".sbf4"}
pat sbf $1==8
kills ALL
gen Call {label,".sbf8"}
pat mlf $1==4
kills ALL
gen Call {label,".mlf4"}
pat mlf $1==8
kills ALL
gen Call {label,".mlf8"}
pat dvf $1==4
kills ALL
gen Call {label,".dvf4"}
pat dvf $1==8
kills ALL
gen Call {label,".dvf8"}
pat ngf $1==4
kills ALL
gen Call {label,".ngf4"}
pat ngf $1==8
kills ALL
gen Call {label,".ngf8"}
pat adf $1==4 leaving cal ".adf4" asp 4
pat adf $1==8 leaving cal ".adf8" asp 8
pat sbf $1==4 leaving cal ".sbf4" asp 4
pat sbf $1==8 leaving cal ".sbf8" asp 8
pat mlf $1==4 leaving cal ".mlf4" asp 4
pat mlf $1==8 leaving cal ".mlf8" asp 8
pat dvf $1==4 leaving cal ".dvf4" asp 4
pat dvf $1==8 leaving cal ".dvf8" asp 8
pat ngf $1==4 leaving cal ".ngf4"
pat ngf $1==8 leaving cal ".ngf8"
pat fif $1==4
kills ALL
gen Call {label,".fif4"}
leaving lor 1 cal ".fif4" asp 2
pat fif $1==8
kills ALL
gen Call {label,".fif8"}
leaving lor 1 cal ".fif8" asp 2
pat fef $1==4
kills ALL
gen Call {label,".fef4"}
leaving lor 1 adp 0-2 cal ".fef4"
pat fef $1==8
kills ALL
gen Call {label,".fef8"}
leaving lor 1 adp 0-2 cal ".fef8"
/********************************************/
/* Group 6: Pointer arithmetic */
@ -964,13 +931,9 @@ pat zre
uses hlreg={const2,0}
gen shld {label,$1}
pat zrf $1==4
kills ALL
gen Call {label,".zrf4"}
pat zrf $1==4 leaving zer 4
pat zrf $1==8
kills ALL
gen Call {label,".zrf8"}
pat zrf $1==8 leaving zer 8
pat zer $1==2 yields {const2,0}
@ -1086,25 +1049,51 @@ kills ALL
gen mvi a,{const1,0}
Call {label,".cii"}
pat cfi
kills ALL
gen Call {label,".cfi"}
pat loc loc cfi $2==2
leaving loc $1 loc $2 cal ".cfi" asp 4+$1 loe ".fra"
pat cif
kills ALL
gen Call {label,".cif"}
pat loc loc cfi $2==4
leaving loc $1 loc $2 cal ".cfi" asp 4+$1 lfr 4
pat cuf
kills ALL
gen Call {label,".cuf"}
pat loc loc cif $2==4
leaving loc $1 cal ".cif4" asp $1-2
pat cff
kills ALL
gen Call {label,".cff"}
pat loc loc cif $1==2 && $2==8
with hl_or_de
gen push %1
push %1
push %1 leaving loc $1 cal ".cif8"
pat cfu
kills ALL
gen Call {label,".cfu"}
pat loc loc cif $1==4 && $2==8
with hl_or_de hl_or_de
gen push %2
push %2
push %1 leaving loc $1 cal ".cif8"
pat loc loc cuf $2==4
leaving loc $1 cal ".cuf4" asp $1-2
pat loc loc cuf $1==2 && $2==8
with hl_or_de
gen push %1
push %1
push %1 leaving loc $1 cal ".cuf8"
pat loc loc cuf $1==4 && $2==8
with hl_or_de hl_or_de
gen push %1
push %2
push %1 leaving loc $1 cal ".cuf8"
pat loc loc cff $1==8 && $2==4 leaving cal ".cff4" asp 4
pat loc loc cff $1==4 && $2==8 leaving dup 4 cal ".cff8"
pat loc loc cfu $2==2
leaving loc $1 loc $2 cal ".cfu" asp 4+$1 loe ".fra"
pat loc loc cfu $2==4
leaving loc $1 loc $2 cal ".cfu" asp 4+$1 lfr 4
/*****************************************/
/* Group 9: Logical instructions */
@ -1408,12 +1397,10 @@ gen mvi a,{const1,1}
Call {label,".cmi4"} yields de
pat cmf $1==4
kills ALL
gen Call {label,".cmf4"}
leaving cal ".cmf4" asp 8 lfr 2
pat cmf $1==8
kills ALL
gen Call {label,".cmf8"}
leaving cal ".cmf8" asp 16 lfr 2
pat cmu $1==2
with hl_or_de hl_or_de

2
mach/proto/fp/FP.script
View file

@ -37,5 +37,5 @@ g/_b64_add/s//.b64_add/g
g/_b64_sft/s//.b64_sft/g
g/_b64_rsft/s//.b64_rsft/g
g/_b64_lsft/s//.b64_lsft/g
w
1,$p
q

53
mach/proto/fp/build.lua Normal file
View file

@ -0,0 +1,53 @@
include("plat/build.lua")
-- For now, all floats are little-endian.
local byte_order = "mach/i86/libfp/byte_order.h"
-- For now, only cpm uses software floating-point.
for _, plat in ipairs({"cpm"}) do
local edits = {}
for _, src in fpairs("./*.c", "./*.e") do
-- Compile each src file into assembly code.
local n = basename(src):gsub("%.%w*$", "")
local assembly = ackfile {
name = "s_"..plat.."/"..n,
srcs = { src },
deps = {
"./*.h",
byte_order,
},
suffix = ".s",
vars = {
["+ackcflags"] = { "-I"..dirname(byte_order) },
plat = plat
}
}
-- Run FP.script to edit the assembly code.
edits[#edits+1] = normalrule {
name = "ed_"..plat.."/"..n,
ins = {
"./FP.script",
assembly,
},
outleaves = { n..".s" },
commands = {
"ed -s %{ins[2]} <%{ins[1]} >%{outs}"
}
}
end
acklibrary {
name = "lib_"..plat,
srcs = { edits },
vars = { plat = plat }
}
installable {
name = "pkg_"..plat,
map = {
["$(PLATIND)/"..plat.."/libfp.a"] = "+lib_"..plat,
}
}
end

34
plat/build.lua
View file

@ -8,8 +8,10 @@ definerule("ackfile",
{
srcs = { type="targets" },
deps = { type="targets", default={} },
suffix = { type="string", default=".o" },
},
function (e)
local c = (e.suffix == ".o" and "-c" or "-c"..e.suffix)
local plat = e.vars.plat
return cfile {
@ -28,8 +30,9 @@ definerule("ackfile",
"util/misc+pkg",
e.deps
},
suffix = e.suffix,
commands = {
"ACKDIR=$(INSDIR) $(INSDIR)/bin/ack -m%{plat} -c -o %{outs} %{ins} %{hdrpaths} %{ackcflags}"
"ACKDIR=$(INSDIR) $(INSDIR)/bin/ack -m%{plat} "..c.." -o %{outs} %{ins} %{hdrpaths} %{ackcflags}"
}
}
end
@ -88,7 +91,7 @@ definerule("ackprogram",
},
_clibrary = acklibrary,
commands = {
"ACKDIR=$(INSDIR) $(INSDIR)/bin/ack -m%{plat} -.%{lang} -o %{outs} %{ins}"
"ACKDIR=$(INSDIR) $(INSDIR)/bin/ack -m%{plat} -.%{lang} -o %{outs} %{ins} %{ackldflags}"
}
}
end
@ -100,18 +103,25 @@ definerule("build_plat_libs",
plat = { type="string" },
},
function(e)
local installmap = {
"lang/b/lib+pkg_"..e.plat,
"lang/basic/lib+pkg_"..e.plat,
"lang/cem/libcc.ansi+pkg_"..e.plat,
"lang/m2/libm2+pkg_"..e.plat,
"lang/pc/libpc+pkg_"..e.plat,
"lang/b/lib+pkg_"..e.plat,
["$(PLATIND)/"..e.plat.."/libem.a"] = "mach/"..e.arch.."/libem+lib_"..e.plat,
["$(PLATIND)/"..e.plat.."/libend.a"] = "mach/"..e.arch.."/libend+lib_"..e.plat,
}
-- For now, only cpm uses software floating-point.
if e.plat == "cpm" then
installmap[#installmap+1] = "mach/proto/fp+pkg_"..e.plat
end
return installable {
name = e.name,
map = {
"lang/b/lib+pkg_"..e.plat,
"lang/basic/lib+pkg_"..e.plat,
"lang/cem/libcc.ansi+pkg_"..e.plat,
"lang/m2/libm2+pkg_"..e.plat,
"lang/pc/libpc+pkg_"..e.plat,
"lang/b/lib+pkg_"..e.plat,
["$(PLATIND)/"..e.plat.."/libem.a"] = "mach/"..e.arch.."/libem+lib_"..e.plat,
["$(PLATIND)/"..e.plat.."/libend.a"] = "mach/"..e.arch.."/libend+lib_"..e.plat,
}
map = installmap,
}
end
)

9
plat/cpm/README
View file

@ -11,14 +11,15 @@ CP/M-compliant machine.
This port only implements a very limited set of syscalls --- and most of those
are stubs required to make the demo apps link. File descriptors 0, 1 and 2
represent the console. All reads block. There's enough TTY emulation to allow
\n conversion and local echo (but it can't be turned off).
represent the console. Each read() blocks and reads an entire line (it can't
read part of a line) from the CP/M line editor, then appends \n. Each write()
converts \n to \r\n. The line editor and \n conversion can't be turned off.
There's a special, if rather minimilist, interface to give applications access
to CP/M. See include/cpm.h for details.
IEEE floating point is not available. Attempts to use floating-point numbers
will cause the program to terminate.
Link with `ack -fp` to enable software floating point. Otherwise, attempts to
use floating-point numbers will cause the program to terminate.
Example command line

2
plat/cpm/descr
View file

@ -58,7 +58,7 @@ name led
program {EM}/lib/ack/em_led
mapflag -l* LNAME={PLATFORMDIR}/lib*
mapflag -i SEPID=-b1:0
mapflag -fp FLOATS={EM}/{ILIB}fp
mapflag -fp FLOATS={PLATFORMDIR}/libfp.a
args {ALIGN} {SEPID?} \
({RTS}:.b=-u _i_main) \
(.e:{HEAD}={PLATFORMDIR}/boot.o) \

49
plat/cpm/libsys/read.c
View file

@ -10,29 +10,44 @@
int read(int fd, void* buffer, size_t count)
{
char i;
short save;
unsigned char before_n;
/* We're only allowed to read from fd 0, 1 or 2. */
if ((fd < 0) || (fd > 2))
{
errno = EBADF;
return -1;
}
/* Empty buffer? */
if (count == 0)
return 0;
/* Read one byte. */
cpm_bc_register = CPM_BDOS_CONSOLE_INPUT;
/* We need room for at least 1 char plus '\n'. */
if (count < 2)
{
errno = EINVAL;
return -1;
}
/* Make room to append '\n' later. */
before_n = count > 255 ? 255 : count - 1;
/* Borrow 2 bytes of RAM before the buffer. */
/* This might overwrite count!!! */
save = ((short*)buffer)[-1];
/* Read one line from the console. */
((unsigned char*)buffer)[-2] = before_n;
cpm_bc_register = CPM_BDOS_READ_CONSOLE_BUFFER;
cpm_de_register = (char*)buffer - 2;
cpm_bdos();
before_n = ((unsigned char*)buffer)[-1];
((char*)buffer)[before_n] = '\n'; /* Append '\n'. */
((short*)buffer)[-1] = save; /* Give back borrowed bytes. */
/* Echo '\n' to console. */
cpm_bc_register = CPM_BDOS_PRINT_STRING;
cpm_de_register = "\r\n$";
cpm_bdos();
if (cpm_a_register == '\r')
cpm_a_register = '\n';
*(char*)buffer = cpm_a_register;
return 1;
return (int)before_n + 1;
}