github.com/open-simh.simtools
1
0
Fork 0
mirror of https://github.com/open-simh/simtools.git synced 2026-01-11 23:53:02 +00:00
Code Issues Projects Releases Wiki Activity

Merge commit '0616816f8e81c24377dca6e191a82c406ab59394' into macro11-v0.8

Browse Source 
Update to latest released version of macro-11.

Command run: git subtree pull --prefix=crossassemblers/macro11 ../macro11 macro11-v0.8
(should be equivalent to git subtree pull --prefix=crossassemblers/macro11 git://gitlab.com/Rhialto/macro11.git macro11-v0.8)
This commit is contained in:
Olaf Seibert 2022-07-06 19:00:22 +02:00
commit 37be615dcc
38 changed files with 2521 additions and 482 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
crossassemblers/macro11/CHANGES
View File

@ -1,3 +1,32 @@
07.07.2022: Rhialto
version 0.8:
- Improve parsing of symbols, e.g. `4..` is not a symbol.
- More careful file format checking of .MLB files, so that you can
use either RSX or RT format .MLB files, and autodetection works.
- Replace the floating point parser by a version which is based on
integer math only, because the Apple M1 doesn't have the required
long double support in its compiler.
13 changes from Paul Koning that add some features which help to
assemble RSTS/E sources:
- Add default extensions to .include, .library
- Fix .psect without argument, add (ignored) pseudo ops .mdelete,
.cross, .nocross
- Allow TRAP without argument, or with non-literal argument
- Fix .library pseudo
- Always list lines that have an error
- Fix macro calls with omitted argument that has a default value,
followed by additional (not omitted) arguments.
- Implement .ENABLE MCL
- Treat unexpected .IF argument as true, not false. This appears to
be what the reference assembler does, at least it is necessary for
certain RSTS source files to assemble without error.
- Allow formal name of .IRP and .IRPC to be enclosed in < >.
- Just like .RAD50, .IDENT accepts an argument that can contain not
just delimited string characters but also values in < >.
- Allow expression (with constant value) in .RADIX
- Bugfixes in macro expansion, incl duplicate named arguments
- Fix references to blank section: Its name is empty, not ". BLK."
05.01.2022: Rhialto
version 0.7.2:
- Improved error messages for bad addressing modes

4
crossassemblers/macro11/README
View File

@ -110,6 +110,10 @@ Options:
-m macname Gives a macro library name.
Up to 32 macro libraries may be specified, one per
-m option.
The current object file format (default, or from
-rt11 or -rsx before this option) is used first to
read the file; if this fails, the other format is
tried.
Note: unlike MACRO.SAV, SYSMAC.SML is not
automatically included; you must name it.

4
crossassemblers/macro11/TODO
View File

@ -4,10 +4,6 @@ listing format errors: ignore whitespace of input
documentation: print supported directives
register symbols: %3+1 is the same as %4 (pdf page 3-9 aka 35),
but where precisely register symbols can be used, and how,
isn't specified.
---------------------------------------
I was not able to locate a Macro-11 language reference manual any more
recent than for RT11 version *3*, so I used that plus my recollection

434
crossassemblers/macro11/assemble.c
View File

@ -27,6 +27,82 @@
#define CHECK_EOL check_eol(stack, cp)
/* assemble a rad50 value (some number of words). */
static unsigned * assemble_rad50 (
char *cp,
int max,
int *count,
STACK *stack)
{
char *radstr;
unsigned *ret;
int i, len, wcnt;
/*
* Allocate storage sufficient for the rest of
* the line.
*/
radstr = memcheck(malloc(strlen(cp)));
len = 0;
do {
cp = skipwhite(cp);
if (*cp == '<') {
EX_TREE *value;
/* A byte value */
value = parse_unary_expr(cp, 0);
cp = value->cp;
if (value->type != EX_LIT) {
report(stack->top, "expression must be constant\n");
radstr[len++] = 0;
} else if (value->data.lit >= 050) {
report(stack->top, "invalid character value %o\n", value->data.lit);
radstr[len++] = 0;
} else {
radstr[len++] = value->data.lit;
}
free_tree(value);
} else {
char quote = *cp++;
while (*cp && *cp != '\n' && *cp != quote) {
int ch = ascii2rad50(*cp++);
if (ch == -1) {
report(stack->top, "invalid character '%c'\n", cp[-1]);
radstr[len++] = 0;
} else {
radstr[len++] = ch;
}
}
cp++; /* Skip closing quote */
}
cp = skipwhite(cp);
} while (!EOL(*cp));
wcnt = (len + 2) / 3;
/* Return at most "max" words, if specified */
if (max && max < wcnt)
wcnt = max;
if (count != NULL)
*count = wcnt;
/* Allocate space for actual or max words, whichever is larger */
ret = memcheck (malloc (((wcnt < max) ? max : wcnt) * sizeof (int)));
for (i = 0; i < wcnt; i++) {
int word = packrad50word(radstr + i * 3, len - (i * 3));
ret[i] = word;
}
/* If max is specified, zero fill */
for (; i < max; i++)
ret[i] = 0;
free(radstr);
return ret;
}
/* assemble - read a line from the input stack, assemble it. */
/* This function is way way too large, because I just coded most of
@ -45,7 +121,7 @@ static int assemble(
int local; /* Whether a label is a local label or
not */
line = stack_gets(stack);
line = stack_getline(stack);
if (line == NULL)
return -1; /* Return code for EOF. */
@ -71,7 +147,20 @@ static int assemble(
op = get_op(cp, &cp); /* Look at operation code */
/* FIXME: this code will blindly look into .REM commentary and
find operation codes. Incidentally, so will read_body. */
find operation codes. Incidentally, so will read_body().
That doesn't really matter, though, since the original also
did that (line 72 ends the suppressed conditional block):
69 .if NE,0
70 .rem &
71 junk
72 .endc
A 73 000144 000000G 000000G more junk
A 74 000150 000000G 000000G 000000G line that ends the comments with &
000156 000000G 000000G 000000C
O 75 .endc
*/
if (op == NULL)
return 1; /* Not found. Don't care. */
@ -251,6 +340,7 @@ static int assemble(
/* Try to resolve macro */
do_mcalled_macro:
op = lookup_sym(label, &macro_st);
if (op /*&& op->stmtno < stmtno*/) {
STREAM *macstr;
@ -260,6 +350,10 @@ static int assemble(
list_location(stack->top, DOT);
macstr = expandmacro(stack->top, (MACRO *) op, ncp);
if (macstr == NULL) {
/* Error in expanding the macro, stop now. */
return 0;
}
stack_push(stack, macstr); /* Push macro expansion
onto input stream */
@ -280,6 +374,8 @@ static int assemble(
case P_PAGE:
case P_PRINT:
case P_SBTTL:
case P_CROSS:
case P_NOCROSS:
return 1; /* Accepted, ignored. (An obvious
need: get assembly listing
controls working fully. ) */
@ -299,41 +395,45 @@ static int assemble(
return 1;
case P_IDENT:
{
char endc[6];
int len;
if (ident) /* An existing ident? */
free(ident); /* Discard it. */
cp = skipwhite(cp);
endc[0] = *cp++;
endc[1] = '\n';
endc[2] = 0;
len = (int) strcspn(cp, endc);
if (len > 6)
len = 6;
if (ident) /* An existing ident? */
free(ident); /* Discard it. */
ident = memcheck(malloc(len + 1));
memcpy(ident, cp, len);
ident[len] = 0;
upcase(ident);
cp += len + 1;
return CHECK_EOL;
}
ident = assemble_rad50 (cp, 2, NULL, stack);
return 1;
case P_RADIX:
{
int old_radix = radix;
EX_TREE *value;
int ok = 1;
radix = strtoul(cp, &cp, 10);
if (radix != 8 && radix != 10 && radix != 16 && radix != 2) {
radix = old_radix;
report(stack->top, "Illegal radix\n");
return 0;
cp = skipwhite(cp);
if (EOL(*cp)) {
/* If no argument, assume 8 */
radix = 8;
return 1;
}
return CHECK_EOL;
/* Parse the argument in decimal radix */
radix = 10;
value = parse_expr(cp, 0);
cp = value->cp;
if (value->type != EX_LIT) {
report(stack->top, "Argument to .RADIX must be constant\n");
radix = old_radix;
ok = 0;
} else {
radix = value->data.lit;
list_value(stack->top, radix);
if (radix != 8 && radix != 10 &&
radix != 2 && radix != 16) {
radix = old_radix;
report(stack->top, "Argument to .RADIX must be 2, 8, 10, or 16\n");
ok = 0;
}
}
free_tree(value);
return ok && CHECK_EOL;
}
case P_FLT4:
@ -341,20 +441,24 @@ static int assemble(
{
int ok = 1;
while (!EOL(*cp)) {
while (ok && !EOL(*cp)) {
unsigned flt[4];
if (parse_float(cp, &cp, (op->value == P_FLT4 ? 4 : 2), flt)) {
/* Store the word values */
store_word(stack->top, tr, 2, flt[0]);
store_word(stack->top, tr, 2, flt[1]);
if (op->value == P_FLT4) {
store_word(stack->top, tr, 2, flt[2]);
store_word(stack->top, tr, 2, flt[3]);
}
/* All is well */
} else {
report(stack->top, "Bad floating point format\n");
ok = 0;
ok = 0; /* Don't try to parse the rest of the line */
flt[0] = flt[1] /* Store zeroes */
= flt[2]
= flt[3] = 0;
}
/* Store the word values */
store_word(stack->top, tr, 2, flt[0]);
store_word(stack->top, tr, 2, flt[1]);
if (op->value == P_FLT4) {
store_word(stack->top, tr, 2, flt[2]);
store_word(stack->top, tr, 2, flt[3]);
}
cp = skipdelim(cp);
}
@ -485,6 +589,7 @@ static int assemble(
return 0;
}
name = defext (name, "MAC");
my_searchenv(name, "INCLUDE", hitfile, sizeof(hitfile));
if (hitfile[0] == '\0') {
@ -522,7 +627,7 @@ static int assemble(
cp += strcspn(cp, quote);
if (*cp == quote[0])
break; /* Found closing quote */
cp = stack_gets(stack); /* Read next input line */
cp = stack_getline(stack); /* Read next input line */
if (cp == NULL)
break; /* EOF */
}
@ -548,10 +653,11 @@ static int assemble(
}
case P_LIBRARY:
if (pass == 0) {
{
char hitfile[FILENAME_MAX];
char *name = getstring_fn(cp, &cp);
name = defext (name, "MLB");
my_searchenv(name, "MCALL", hitfile, sizeof(hitfile));
if (hitfile[0]) {
@ -570,15 +676,6 @@ static int assemble(
case P_MCALL:
{
STREAM *macstr;
BUFFER *macbuf;
char *maccp;
int saveline;
MACRO *mac;
int i;
char macfile[FILENAME_MAX];
char hitfile[FILENAME_MAX];
for (;;) {
cp = skipdelim(cp);
@ -612,68 +709,8 @@ static int assemble(
continue;
}
/* Find the macro in the list of included
macro libraries */
macbuf = NULL;
for (i = 0; i < nr_mlbs; i++)
if ((macbuf = mlb_entry(mlbs[i], label)) != NULL)
break;
if (macbuf != NULL) {
macstr = new_buffer_stream(macbuf, label);
buffer_free(macbuf);
} else {
char *bufend = &macfile[sizeof(macfile)],
*end;
end = stpncpy(macfile, label, sizeof(macfile) - 5);
if (end >= bufend - 5) {
report(stack->top, ".MCALL: name too long: '%s'\n", label);
return 0;
}
stpncpy(end, ".MAC", bufend - end);
my_searchenv(macfile, "MCALL", hitfile, sizeof(hitfile));
if (hitfile[0])
macstr = new_file_stream(hitfile);
else
macstr = NULL;
}
if (macstr != NULL) {
for (;;) {
char *mlabel;
maccp = macstr->vtbl->gets(macstr);
if (maccp == NULL)
break;
mlabel = get_symbol(maccp, &maccp, NULL);
if (mlabel == NULL)
continue;
op = lookup_sym(mlabel, &system_st);
free(mlabel);
if (op == NULL)
continue;
if (op->value == P_MACRO)
break;
}
if (maccp != NULL) {
STACK macstack = {
macstr
};
int savelist = list_level;
saveline = stmtno;
list_level = -1;
mac = defmacro(maccp, &macstack, CALLED_NOLIST);
if (mac == NULL) {
report(stack->top, "Failed to define macro called %s\n", label);
}
stmtno = saveline;
list_level = savelist;
}
macstr->vtbl->delete(macstr);
} else
/* Do the actual macro library search */
if (!do_mcall (label, stack))
report(stack->top, "MACRO %s not found\n", label);
free(label);
@ -689,6 +726,9 @@ static int assemble(
return mac != NULL;
}
case P_MDELETE:
return 1; /* TODO: or should it just be a NOP? */
case P_MEXIT:
{
STREAM *macstr;
@ -733,6 +773,8 @@ static int assemble(
enabl_lc = 1;
} else if (strcmp(label, "LCM") == 0) {
enabl_lcm = 1;
} else if (strcmp(label, "MCL") == 0) {
enabl_mcl = 1;
}
free(label);
cp = skipdelim(cp);
@ -754,6 +796,8 @@ static int assemble(
enabl_lc = 0;
} else if (strcmp(label, "LCM") == 0) {
enabl_lcm = 0;
} else if (strcmp(label, "MCL") == 0) {
enabl_mcl = 0;
}
free(label);
cp = skipdelim(cp);
@ -874,7 +918,7 @@ static int assemble(
report(stack->top, "Bad .IF expression\n");
list_value(stack->top, 0);
free_tree(tvalue);
ok = FALSE; /* Pick something. */
ok = TRUE; /* Pick something. */
} else {
unsigned word;
@ -1015,38 +1059,29 @@ static int assemble(
SYMBOL *sectsym;
SECTION *sect;
unsigned int old_flags = ~0u;
int unnamed_csect = 0;
label = get_symbol(cp, &cp, NULL);
if (label == NULL) {
if (op->value == P_CSECT) {
label = memcheck(strdup(". BLK."));
unnamed_csect = 1;
} else {
label = memcheck(strdup("")); /* Allow blank */
}
sect = &blank_section;
}
else {
sectsym = lookup_sym(label, &section_st);
if (sectsym) {
sect = sectsym->section;
free(label);
old_flags = sect->flags;
} else {
sect = new_section();
sect->label = label;
sect->flags = 0;
sect->pc = 0;
sect->size = 0;
sect->type = SECTION_USER;
sections[sector++] = sect;
sectsym = add_sym(label, 0, SYMBOLFLAG_DEFINITION, sect, &section_st);
sectsym = lookup_sym(label, &section_st);
if (sectsym) {
sect = sectsym->section;
free(label);
old_flags = sect->flags;
} else {
sect = new_section();
sect->label = label;
sect->flags = 0;
sect->pc = 0;
sect->size = 0;
sect->type = SECTION_USER;
sections[sector++] = sect;
sectsym = add_sym(label, 0, SYMBOLFLAG_DEFINITION, sect, &section_st);
/* page 6-41 table 6-5 */
if (op->value == P_PSECT) {
sect->flags |= PSECT_REL;
} else if (op->value == P_CSECT) {
if (unnamed_csect) {
/* page 6-41 table 6-5 */
if (op->value == P_PSECT) {
sect->flags |= PSECT_REL;
} else {
sect->flags |= PSECT_REL | PSECT_COM | PSECT_GBL;
@ -1249,59 +1284,15 @@ static int assemble(
DOT++; /* Fix it */
}
{
char *radstr;
int i, len;
/*
* Allocate storage sufficient for the rest of
* the line.
*/
radstr = memcheck(malloc(strlen(cp)));
len = 0;
do {
cp = skipwhite(cp);
if (*cp == '<') {
EX_TREE *value;
/* A byte value */
value = parse_unary_expr(cp, 0);
cp = value->cp;
if (value->type != EX_LIT) {
report(stack->top, "expression must be constant\n");
radstr[len++] = 0;
} else if (value->data.lit >= 050) {
report(stack->top, "invalid character value %o\n", value->data.lit);
radstr[len++] = 0;
} else {
radstr[len++] = value->data.lit;
}
free_tree(value);
} else {
char quote = *cp++;
while (*cp && *cp != '\n' && *cp != quote) {
int ch = ascii2rad50(*cp++);
if (ch == -1) {
report(stack->top, "invalid character '%c'\n", cp[-1]);
radstr[len++] = 0;
} else {
radstr[len++] = ch;
}
}
cp++; /* Skip closing quote */
}
cp = skipwhite(cp);
} while (!EOL(*cp));
for (i = 0; i < len; i += 3) {
int word = packrad50word(radstr + i, len - i);
store_word(stack->top, tr, 2, word);
int i, count;
unsigned *rad50;
/* Now assemble the argument */
rad50 = assemble_rad50 (cp, 0, &count, stack);
for (i = 0; i < count; i++) {
store_word (stack->top, tr, 2, rad50[i]);
}
free(radstr);
free (rad50);
}
return 1;
@ -1327,29 +1318,40 @@ static int assemble(
case OC_MARK:
/* MARK, EMT, TRAP */ {
EX_TREE *value;
unsigned word;
cp = skipwhite(cp);
if (*cp == '#')
cp++; /* Allow the hash, but
don't require it */
value = parse_expr(cp, 0);
cp = value->cp;
if (value->type != EX_LIT) {
report(stack->top, "Instruction requires simple literal operand\n");
word = op->value;
} else {
unsigned int max = (op->value == I_MARK)? 077 : 0377;
if (value->data.lit > max) {
report(stack->top, "Literal operand too large (%d. > %d.)\n", value->data.lit, max);
value->data.lit = max;
}
word = op->value | value->data.lit;
if (EOL (*cp)) {
/* Default argument is 0 */
store_word (stack->top, tr, 2, op->value);
}
else {
if (*cp == '#')
cp++; /* Allow the hash, but
don't require it */
value = parse_expr(cp, 0);
cp = value->cp;
if (value->type != EX_LIT) {
if (op->value == I_MARK) {
report(stack->top, "Instruction requires " "simple literal operand\n");
store_word(stack->top, tr, 2, op->value);
}
else {
/* EMT, TRAP: handle as two bytes */
store_value (stack, tr, 1, value);
store_word (stack->top, tr, 1, op->value >> 8);
}
} else {
unsigned v = value->data.lit;
unsigned int max = (op->value == I_MARK)? 077 : 0377;
store_word(stack->top, tr, 2, word);
free_tree(value);
if (v > max) {
report(stack->top, "Literal operand too large (%d. > %d.)\n", value->data.lit, max);
v = max;
}
store_word(stack->top, tr, 2, op->value | v);
}
free_tree(value);
}
}
return CHECK_EOL;
@ -1822,6 +1824,16 @@ static int assemble(
} /* end if (op is a symbol) */
}
/* If .ENABL MCL is in effect, try to define the symbol as a
* library macro if it is not a defined symbol. */
if (enabl_mcl) {
if (lookup_sym(label, &symbol_st) == NULL) {
if (do_mcall (label, stack)) {
goto do_mcalled_macro;
}
}
}
/* Only thing left is an implied .WORD directive */
/*JH: fall through in case of illegal opcode, illegal label! */
free(label);

5
crossassemblers/macro11/assemble_globals.c
View File

@ -40,6 +40,9 @@ int enabl_lc = 1; /* If lowercase disabled, convert assembler
int enabl_lcm = 0; /* If lowercase disabled, .IF IDN/DIF are
case-sensitive. */
int enabl_mcl = 0; /* When set, unknown symbols are looked up
as if .MCALL <sym> had been done. */
int suppressed = 0; /* Assembly suppressed by failed conditional */
@ -56,7 +59,7 @@ int sect_sp; /* Stack pointer */
char *module_name = NULL; /* The module name (taken from the 'TITLE'); */
char *ident = NULL; /* .IDENT name */
unsigned *ident = NULL; /* Encoded .IDENT name */
EX_TREE *xfer_address = NULL; /* The transfer address */

4
crossassemblers/macro11/assemble_globals.h
View File

@ -55,6 +55,8 @@ extern int suppressed; /* Assembly suppressed by failed conditional */
extern MLB *mlbs[MAX_MLBS]; /* macro libraries specified on the command line */
extern int nr_mlbs; /* Number of macro libraries */
extern int enabl_mcl; /* If MCALL of unknown symbols is enabled. */
extern COND conds[MAX_CONDS]; /* Stack of recent conditions */
extern int last_cond; /* 0 means no stacked cond. */
@ -64,7 +66,7 @@ extern int sect_sp; /* Stack pointer */
extern char *module_name; /* The module name (taken from the 'TITLE'); */
extern char *ident; /* .IDENT name */
extern unsigned *ident; /* .IDENT name (encoded RAD50 value) */
extern EX_TREE *xfer_address; /* The transfer address */

22
crossassemblers/macro11/listing.c
View File

@ -30,16 +30,26 @@ FILE *lstfile = NULL;
int list_pass_0 = 0;/* Also list what happens during the first pass */
static int errline = 0; /* Set if current line has an error */
/* maybe_list returns TRUE if listing may happen for this line. */
static int can_list(
void)
{
int ok = lstfile != NULL &&
(pass > 0 || list_pass_0);
return ok;
}
/* do_list returns TRUE if listing is enabled. */
static int dolist(
void)
{
int ok = lstfile != NULL &&
(pass > 0 || list_pass_0) &&
list_level > 0;
int ok = can_list () &&
(list_level > 0 || errline);
return ok;
}
@ -50,9 +60,11 @@ void list_source(
STREAM *str,
char *cp)
{
if (dolist()) {
if (can_list()) {
int len = strcspn(cp, "\n");
/* Not an error yet */
errline = 0;
/* Save the line text away for later... */
if (listline)
free(listline);
@ -165,6 +177,8 @@ void report(
if (!pass && list_pass_0 < 2)
return; /* Don't report now. */
errline = 1;
if (str) {
name = str->name;
line = str->line;

5
crossassemblers/macro11/macro11.c
View File

@ -1,6 +1,3 @@
#define MACRO11__C
/*
Assembler compatible with MACRO-11.
@ -132,7 +129,7 @@ static void print_help(
printf(" -l - enables listing to stdout.\n");
printf("-m load RSX-11 or RT-11 compatible macro library from which\n");
printf(" .MCALLed macros can be found.\n");
printf(" Multiple allowed.\n");
printf(" Multiple allowed. Affected by any -rsx or -rt11 which come before.\n");
printf("-o gives the object file name (.OBJ)\n");
printf("-p gives the name of a directory in which .MCALLed macros may be found.\n");
printf(" Sets environment variable \"MCALL\".\n");

4
crossassemblers/macro11/macro11.h
View File

@ -3,12 +3,12 @@
#include "git-info.h"
#define BASE_VERSION "0.7.2"
#define BASE_VERSION "0.8"
#if defined(GIT_VERSION)
#define VERSIONSTR BASE_VERSION" ("GIT_VERSION"\n\t"GIT_AUTHOR_DATE")"
#else
#define VERSIONSTR BASE_VERSION" (05 Jan 2022)"
#define VERSIONSTR BASE_VERSION" (07 Jul 2022)"
/*#define VERSIONSTR "0.3 (April 21, 2009)" */
/*#define VERSIONSTR "0.2 July 15, 2001" */
#endif

131
crossassemblers/macro11/macros.c
View File

@ -40,7 +40,7 @@ void macro_stream_delete(
}
STREAM_VTBL macro_stream_vtbl = {
macro_stream_delete, buffer_stream_gets, buffer_stream_rewind
macro_stream_delete, buffer_stream_getline, buffer_stream_rewind
};
STREAM *new_macro_stream(
@ -85,7 +85,7 @@ void read_body(
char *nextline;
char *cp;
nextline = stack_gets(stack); /* Now read the line */
nextline = stack_getline(stack); /* Now read the line */
if (nextline == NULL) { /* End of file. */
report(stack->top, "Macro body of '%s' not closed\n", name);
break;
@ -478,15 +478,19 @@ STREAM *expandmacro(
label = get_symbol(cp, &nextcp, NULL);
if (label && (nextcp = skipwhite(nextcp), *nextcp == '=') && (macarg = find_arg(mac->args, label))) {
/* Check if I've already got a value for it */
if (find_arg(args, label) != NULL) {
report(refstr, "Duplicate submission of keyword " "argument %s\n", label);
free(label);
free_args(args);
return NULL;
if ((arg = find_arg(args, label)) != NULL) {
/* Duplicate is legal; the last one wins. */
if (arg->value) {
free (arg->value);
arg->value = NULL;
}
}
else {
arg = new_arg();
arg->label = label;
arg->next = args;
args = arg;
}
arg = new_arg();
arg->label = label;
nextcp = skipwhite(nextcp + 1);
arg->value = getstring_macarg(refstr, nextcp, &nextcp);
} else {
@ -503,15 +507,20 @@ STREAM *expandmacro(
if (macarg == NULL)
break; /* Don't pick up any more arguments. */
nextcp = skipwhite (cp);
arg = new_arg();
arg->label = memcheck(strdup(macarg->label)); /* Copy the name */
arg->value = getstring_macarg(refstr, cp, &nextcp);
arg->next = args;
args = arg;
if (*nextcp != ',') {
arg->value = getstring_macarg(refstr, cp, &nextcp);
}
else {
arg->value = NULL;
}
nargs++; /* Count nonkeyword arguments only. */
}
arg->next = args;
args = arg;
/* If there is a trailing comma, there is an empty last argument */
cp = skipdelim_comma(nextcp, &onemore);
}
@ -527,9 +536,13 @@ STREAM *expandmacro(
for (macarg = mac->args; macarg != NULL; macarg = macarg->next) {
arg = find_arg(args, macarg->label);
if (arg == NULL) {
arg = new_arg();
arg->label = memcheck(strdup(macarg->label));
if (arg == NULL || arg->value == NULL) {
int wasnull = 0;
if (arg == NULL) {
wasnull = 1;
arg = new_arg();
arg->label = memcheck(strdup(macarg->label));
}
if (macarg->locsym) {
char temp[32];
@ -541,8 +554,10 @@ STREAM *expandmacro(
} else
arg->value = memcheck(strdup(""));
arg->next = args;
args = arg;
if (wasnull) {
arg->next = args;
args = arg;
}
}
}
@ -606,3 +621,81 @@ void free_macro(
free_args(mac->args);
free_sym(&mac->sym);
}
int do_mcall (char *label, STACK *stack)
{
SYMBOL *op; /* The operation SYMBOL */
STREAM *macstr;
BUFFER *macbuf;
char *maccp;
int saveline;
MACRO *mac;
int i;
char macfile[FILENAME_MAX];
char hitfile[FILENAME_MAX];
/* Find the macro in the list of included
macro libraries */
macbuf = NULL;
for (i = 0; i < nr_mlbs; i++)
if ((macbuf = mlb_entry(mlbs[i], label)) != NULL)
break;
if (macbuf != NULL) {
macstr = new_buffer_stream(macbuf, label);
buffer_free(macbuf);
} else {
char *bufend = &macfile[sizeof(macfile)],
*end;
end = stpncpy(macfile, label, sizeof(macfile) - 5);
if (end >= bufend - 5) {
report(stack->top, ".MCALL: name too long: '%s'\n", label);
return 0;
}
stpncpy(end, ".MAC", bufend - end);
my_searchenv(macfile, "MCALL", hitfile, sizeof(hitfile));
if (hitfile[0])
macstr = new_file_stream(hitfile);
else
macstr = NULL;
}
if (macstr != NULL) {
for (;;) {
char *mlabel;
maccp = macstr->vtbl->getline(macstr);
if (maccp == NULL)
break;
mlabel = get_symbol(maccp, &maccp, NULL);
if (mlabel == NULL)
continue;
op = lookup_sym(mlabel, &system_st);
free(mlabel);
if (op == NULL)
continue;
if (op->value == P_MACRO)
break;
}
if (maccp != NULL) {
STACK macstack = {
macstr
};
int savelist = list_level;
saveline = stmtno;
list_level = -1;
mac = defmacro(maccp, &macstack, CALLED_NOLIST);
if (mac == NULL) {
report(stack->top, "Failed to define macro called %s\n", label);
}
stmtno = saveline;
list_level = savelist;
}
macstr->vtbl->delete(macstr);
return 1;
}
return 0;
}

5
crossassemblers/macro11/macros.h
View File

@ -71,6 +71,9 @@ BUFFER *subst_args(
BUFFER *text,
ARG *args);
int do_mcall (
char *label,
STACK *stack);
#endif

163
crossassemblers/macro11/mlb-rsx.c
View File

@ -156,6 +156,9 @@ DAMAGE.
#include "mlb.h"
#include "util.h"
#define MLBDEBUG_OPEN 0
#define MLBDEBUG_ENTRY 0
static MLB *mlb_rsx_open(
char *name,
int allow_object_library);
@ -168,10 +171,11 @@ static void mlb_rsx_extract(
MLB *mlb);
struct mlb_vtbl mlb_rsx_vtbl = {
mlb_rsx_open,
mlb_rsx_entry,
mlb_rsx_extract,
mlb_rsx_close,
.mlb_open = mlb_rsx_open,
.mlb_entry = mlb_rsx_entry,
.mlb_extract = mlb_rsx_extract,
.mlb_close = mlb_rsx_close,
.mlb_is_rt11 = 0,
};
#define BLOCKSIZE 512
@ -201,7 +205,7 @@ MLB *mlb_rsx_open(
int allow_objlib)
{
MLB *mlb = memcheck(malloc(sizeof(MLB)));
char *buff;
char *buff = NULL;
unsigned entsize;
unsigned nr_entries;
unsigned start_block;
@ -210,6 +214,9 @@ MLB *mlb_rsx_open(
mlb->vtbl = &mlb_rsx_vtbl;
mlb->directory = NULL;
#if MLBDEBUG_OPEN
fprintf(stderr, "mlb_rsx_open('%s', %d)\n", name, allow_objlib);
#endif
mlb->fp = fopen(name, "rb");
if (mlb->fp == NULL) {
mlb_rsx_close(mlb);
@ -219,20 +226,16 @@ MLB *mlb_rsx_open(
buff = memcheck(malloc(060)); /* Size of MLB library header */
if (fread(buff, 1, 060, mlb->fp) < 060) {
fprintf(stderr, "error: can't read full header\n");
mlb_rsx_close(mlb);
free(buff);
return NULL;
fprintf(stderr, "mlb_rsx_open error: can't read full header\n");
goto error;
}
mlb->is_objlib = 0;
if (allow_objlib && WORD(buff) == 01000) { /* Is it an object library? */
mlb->is_objlib = 1;
} else if (WORD(buff) != 01001) { /* Is this really a macro library? */
/* fprintf(stderr, "error: first word not correct value\n"); */
mlb_rsx_close(mlb); /* Nope. */
free(buff);
return NULL;
/* fprintf(stderr, "mlb_rsx_open error: first word not correct value\n"); */
goto error;
}
entsize = buff[032]; /* The size of each macro directory
@ -242,24 +245,33 @@ MLB *mlb_rsx_open(
directory */
if (entsize < 8) { /* Is this really a macro library? */
mlb_rsx_close(mlb); /* Nope. */
fprintf(stderr, "error: entsize too small: %d\n", entsize);
return NULL;
fprintf(stderr, "mlb_rsx_open error: entsize too small: %d\n", entsize);
goto error;
}
// fprintf(stderr, "entsize=%d, nr_entries=%d, start_block=%d\n",
// entsize, nr_entries, start_block);
if (start_block < 1) { /* Is this really a macro library? */
fprintf(stderr, "mlb_rsx_open error: start_block too small: %d\n", start_block);
goto error;
}
#if MLBDEBUG_OPEN
fprintf(stderr, "entsize=%d, nr_entries=%d, start_block=%d\n",
entsize, nr_entries, start_block);
#endif
free(buff); /* Done with that header. */
/* Allocate a buffer for the disk directory */
buff = memcheck(malloc(nr_entries * entsize));
fseek(mlb->fp, start_block * BLOCKSIZE, SEEK_SET); /* Go to the directory */
/* Go to the directory */
if (fseek(mlb->fp, start_block * BLOCKSIZE, SEEK_SET) == -1) {
fprintf(stderr, "mlb_rsx_open error: seek error: %d\n", start_block * BLOCKSIZE);
goto error;
}
/* Read the disk directory */
if (fread(buff, entsize, nr_entries, mlb->fp) < nr_entries) {
mlb_rsx_close(mlb); /* Sorry, read error. */
free(buff);
return NULL;
fprintf(stderr, "mlb_rsx_open error: fread: not enough entries\n");
goto error;
}
/* Shift occupied directory entries to the front of the array */
@ -269,11 +281,15 @@ MLB *mlb_rsx_open(
for (i = 0, j = nr_entries; i < j; i++) {
char *ent1,
*ent2;
int w1, w2;
ent1 = buff + (i * entsize);
/* Unused entries have 0177777 0177777 for the RAD50 name,
which is not legal RAD50. */
if (WORD(ent1) == 0177777 && WORD(ent1 + 2) == 0177777) {
w1 = WORD(ent1);
w2 = WORD(ent1 + 2);
if (w1 == 0177777 && w2 == 0177777) {
while (--j > i
&& (ent2 = buff + (j * entsize), WORD(ent2) == 0177777 && WORD(ent2 + 2) == 0177777)) ;
if (j <= i)
@ -283,15 +299,31 @@ MLB *mlb_rsx_open(
space */
memset(ent2, 0377, entsize); /* Mark entry unused */
} else {
// fprintf(stderr, "entry %d: %02x%02x.%02x%02x\n",
// i, ent1[5] & 0xFF, ent1[4] & 0xFF, ent1[7] & 0xFF, ent1[6] & 0xFF);
#if MLBDEBUG_OPEN
fprintf(stderr, "entry %d: %02x%02x.%02x%02x\n",
i, ent1[5] & 0xFF, ent1[4] & 0xFF, ent1[7] & 0xFF, ent1[6] & 0xFF);
#endif
/*
* 00 00 rad50-decodes to spaces, which are not a
* valid name for a macro or object file.
*/
if (w1 == 0000000 && w2 == 0000000) {
fprintf(stderr, "mlb_rsx_open error: bad file, null name\n");
goto error;
}
}
}
/* Now i contains the actual number of entries. */
mlb->nentries = i;
// fprintf(stderr, " mlb->nentries=%d\n", mlb->nentries);
#if MLBDEBUG_OPEN
fprintf(stderr, "mlb->nentries=%d\n", mlb->nentries);
#endif
if (mlb->nentries == 0) {
fprintf(stderr, "mlb_rsx_open error: no entries\n");
goto error;
}
/* Now, allocate my in-memory directory */
mlb->directory = memcheck(malloc(sizeof(MLBENT) * mlb->nentries));
@ -308,15 +340,28 @@ MLB *mlb_rsx_open(
unrad50(WORD(ent + 2), radname + 3);
radname[6] = 0;
// fprintf(stderr, "entry %d: \"%s\" %02x%02x.%02x%02x\n",
// j, radname,
// ent[5] & 0xFF, ent[4] & 0xFF, ent[7] & 0xFF, ent[6] & 0xFF);
#if MLBDEBUG_OPEN
fprintf(stderr, "entry %d: \"%s\" %02x%02x.%02x%02x\n",
j, radname,
ent[5] & 0xFF, ent[4] & 0xFF, ent[7] & 0xFF, ent[6] & 0xFF);
#endif
trim(radname);
if (radname[0] == '\0' || strchr(radname, ' ')) {
fprintf(stderr, "mlb_rsx_open error: entry with space in name\n");
goto error;
}
mlb->directory[j].label = memcheck(strdup(radname));
mlb->directory[j].position = BYTEPOS(ent);
// fprintf(stderr, "entry %d: \"%s\" bytepos=%d\n", j, mlb->directory[j].label, mlb->directory[j].position);
#if MLBDEBUG_OPEN
fprintf(stderr, "entry %d: \"%s\" bytepos=%ld\n", j, mlb->directory[j].label, mlb->directory[j].position);
#endif
mlb->directory[j].length = -1;
if (mlb->directory[j].position < BLOCKSIZE) {
fprintf(stderr, "mlb_rsx_open error: bad entry: position\n");
goto error;
}
}
free(buff);
@ -324,6 +369,14 @@ MLB *mlb_rsx_open(
/* Done. Return the struct that represents the opened MLB. */
return mlb;
error:
#if MLBDEBUG_OPEN
fprintf(stderr, "(mlb_rsx_open closing '%s' due to errors)\n", name);
#endif
mlb_rsx_close(mlb); /* Sorry, bad file. */
free(buff);
return NULL;
}
/* mlb_rsx_close discards MLB and closes the file. */
@ -367,28 +420,38 @@ BUFFER *mlb_rsx_entry(
}
if (i >= mlb->nentries) {
// fprintf(stderr, "mlb_rsx_entry: %s not found\n", name);
#if MLBDEBUG_ENTRY
fprintf(stderr, "mlb_rsx_entry: %s not found\n", name);
#endif
return NULL;
}
fseek(mlb->fp, ent->position, SEEK_SET);
// fprintf(stderr, "mlb_rsx_entry: %s at position %ld\n", name, (long)ent->position);
#if MLBDEBUG_ENTRY
fprintf(stderr, "mlb_rsx_entry: %s at position %ld\n", name, (long)ent->position);
#endif
#define MODULE_HEADER_SIZE 022
if (fread(module_header, MODULE_HEADER_SIZE, 1, mlb->fp) < 1) {
// fprintf(stderr, "mlb_rsx_entry: %s at position %lx can't read 022 bytes\n", name, (long)ent->position);
#if MLBDEBUG_ENTRY
fprintf(stderr, "mlb_rsx_entry: %s at position %lx can't read 022 bytes\n", name, (long)ent->position);
#endif
return NULL;
}
// for (i = 0; i < MODULE_HEADER_SIZE; i++) {
// fprintf(stderr, "%02x ", module_header[i]);
// }
// fprintf(stderr, "\n");
#if MLBDEBUG_ENTRY
for (i = 0; i < MODULE_HEADER_SIZE; i++) {
fprintf(stderr, "%02x ", module_header[i]);
}
fprintf(stderr, "\n");
#endif
ent->length = (WORD(module_header + 04) << 16) +
WORD(module_header + 06);
ent->length -= MODULE_HEADER_SIZE; /* length is including this header */
// fprintf(stderr, "mlb_rsx_entry: %s at position %lx length = %d\n", name, (long)ent->position, ent->length);
#if MLBDEBUG_ENTRY
fprintf(stderr, "mlb_rsx_entry: %s at position %lx length = %d\n", name, (long)ent->position, ent->length);
#endif
if (module_header[02] == 1) {
fprintf(stderr, "mlb_rsx_entry: %s at position %lx deleted entry\n", name, (long)ent->position);
@ -418,19 +481,25 @@ BUFFER *mlb_rsx_entry(
i = fread(bp, 1, ent->length, mlb->fp);
bp += i;
} else if (module_header[0] & 0x10) {
// fprintf(stderr, "mlb_rsx_entry: %s at position %lx variable length records\n", name, (long)ent->position);
#if MLBDEBUG_ENTRY
fprintf(stderr, "mlb_rsx_entry: %s at position %lx variable length records\n", name, (long)ent->position);
#endif
/* Variable length records with size before them */
i = ent->length;
while (i > 0) {
int length;
// fprintf(stderr, "file offset:$%lx\n", (long)ftell(mlb->fp));
#if MLBDEBUG_ENTRY
fprintf(stderr, "file offset:$%lx\n", (long)ftell(mlb->fp));
#endif
c = fgetc(mlb->fp); /* Get low byte of length */
length = c & 0xFF;
c = fgetc(mlb->fp); /* Get high byte */
length += (c & 0xFF) << 8;
i -= 2;
// fprintf(stderr, "line length: %d $%x\n", length, length);
#if MLBDEBUG_ENTRY
fprintf(stderr, "line length: %d $%x\n", length, length);
#endif
/* Odd lengths are padded with an extra 0 byte */
int padded = length & 1;
@ -441,7 +510,9 @@ BUFFER *mlb_rsx_entry(
while (length > 0) {
c = fgetc(mlb->fp); /* Get macro byte */
//fprintf(stderr, "%02x %c length=%d\n", c, c, length);
#if MLBDEBUG_ENTRY
fprintf(stderr, "%02x %c length=%d\n", c, c, length);
#endif
i--;
length--;
if (c == '\r' || c == 0) /* If it's a carriage return or 0,
@ -452,12 +523,16 @@ BUFFER *mlb_rsx_entry(
*bp++ = '\n';
if (padded) {
c = fgetc(mlb->fp); /* Get pad byte; need not be 0. */
//fprintf(stderr, "pad byte %02x %c length=%d\n", c, c, length);
#if MLBDEBUG_ENTRY
fprintf(stderr, "pad byte %02x %c length=%d\n", c, c, length);
#endif
i--;
}
}
} else {
// fprintf(stderr, "mlb_rsx_entry: %s at position %lx byte stream records\n", name, (long)ent->position);
#if MLBDEBUG_ENTRY
fprintf(stderr, "mlb_rsx_entry: %s at position %lx byte stream records\n", name, (long)ent->position);
#endif
for (i = 0; i < ent->length; i++) {
c = fgetc(mlb->fp); /* Get macro byte */
if (c == '\r' || c == 0) /* If it's a carriage return or 0,

116
crossassemblers/macro11/mlb-rt11.c
View File

@ -40,13 +40,12 @@ DAMAGE.
#include <string.h>
#include "rad50.h"
#include "stream2.h"
#include "mlb.h"
#include "util.h"
#define MLBDEBUG_OPEN 0
static MLB *mlb_rt11_open(
char *name,
int allow_object_library);
@ -59,12 +58,23 @@ static void mlb_rt11_extract(
MLB *mlb);
struct mlb_vtbl mlb_rt11_vtbl = {
mlb_rt11_open,
mlb_rt11_entry,
mlb_rt11_extract,
mlb_rt11_close,
.mlb_open = mlb_rt11_open,
.mlb_entry = mlb_rt11_entry,
.mlb_extract = mlb_rt11_extract,
.mlb_close = mlb_rt11_close,
.mlb_is_rt11 = 1,
};
/*
* Format description:
* http://www.bitsavers.org/pdf/dec/pdp11/rt11/v5.6_Aug91/AA-PD6PA-TC_RT-11_Volume_and_File_Formats_Manual_Aug91.pdf
* pages 2-27 ff.
*
* A MLB Macro Library Header differs a lot from an Object Library Header.
*/
#define BLOCKSIZE 512
#define WORD(cp) ((*(cp) & 0xff) + ((*((cp)+1) & 0xff) << 8))
/* BYTEPOS calculates the byte position within the macro libray file.
@ -72,7 +82,8 @@ struct mlb_vtbl mlb_rt11_vtbl = {
be able to calculate the entries' sizes, which isn't actually
stored in the directory. */
#define BYTEPOS(rec) ((WORD((rec)+4) & 32767) * 512 + (WORD((rec)+6) & 511))
#define BYTEPOS(rec) ((WORD((rec)+4) & 32767) * BLOCKSIZE + \
(WORD((rec)+6) & 511))
/* compare_position is the qsort callback function that compares byte
locations within the macro library */
@ -116,6 +127,9 @@ MLB *mlb_rt11_open(
unsigned start_block;
int i;
#if MLBDEBUG_OPEN
fprintf(stderr, "mlb_rt11_open('%s', %d)\n", name, allow_object_library);
#endif
(void)allow_object_library; /* This parameter is not supported */
mlb->vtbl = &mlb_rt11_vtbl;
mlb->directory = NULL;
@ -129,14 +143,12 @@ MLB *mlb_rt11_open(
buff = memcheck(malloc(044)); /* Size of MLB library header */
if (fread(buff, 1, 044, mlb->fp) < 044) {
mlb_rt11_close(mlb);
free(buff);
return NULL;
goto error; /* Nope. */
}
if (WORD(buff) != 01001) { /* Is this really a macro library? */
mlb_rt11_close(mlb); /* Nope. */
return NULL;
if (WORD(buff) != 01001 ||
WORD(buff + 2) != 0500) { /* Is this really a macro library? */
goto error; /* Nope. */
}
entsize = WORD(buff + 032); /* The size of each macro directory
@ -145,17 +157,34 @@ MLB *mlb_rt11_open(
start_block = WORD(buff + 034); /* The start RT-11 block of the
directory */
if (entsize < 8) { /* Is this really a macro library? */
fprintf(stderr, "mlb_rt11_open error: entsize too small: %d\n", entsize);
goto error; /* Nope. */
}
if (start_block < 1) { /* Is this really a macro library? */
fprintf(stderr, "mlb_rt11_open error: start_block too small: %d\n", start_block);
goto error; /* Nope. */
}
#if MLBDEBUG_OPEN
fprintf(stderr, "entsize=%d, nr_entries=%d, start_block=%d\n",
entsize, nr_entries, start_block);
#endif
free(buff); /* Done with that header. */
/* Allocate a buffer for the disk directory */
buff = memcheck(malloc(nr_entries * entsize));
fseek(mlb->fp, start_block * 512, SEEK_SET); /* Go to the directory */
/* Go to the directory */
if (fseek(mlb->fp, start_block * BLOCKSIZE, SEEK_SET) == -1) {
fprintf(stderr, "mlb_rt11_open error: seek error: %d\n", start_block * BLOCKSIZE);
goto error;
}
/* Read the disk directory */
if (fread(buff, entsize, nr_entries, mlb->fp) < nr_entries) {
mlb_rt11_close(mlb); /* Sorry, read error. */
free(buff);
return NULL;
fprintf(stderr, "mlb_rt11_open error: fread: not enough entries\n");
goto error; /* Sorry, read error. */
}
/* Shift occupied directory entries to the front of the array
@ -166,11 +195,14 @@ MLB *mlb_rt11_open(
for (i = 0, j = nr_entries; i < j; i++) {
char *ent1,
*ent2;
int w1, w2;
ent1 = buff + (i * entsize);
w1 = WORD(ent1);
w2 = WORD(ent1 + 2);
/* Unused entries have 0177777 0177777 for the RAD50 name,
which is not legal RAD50. */
if (WORD(ent1) == 0177777 && WORD(ent1 + 2) == 0177777) {
if (w1 == 0177777 && w2 == 0177777) {
while (--j > i
&& (ent2 = buff + (j * entsize), WORD(ent2) == 0177777 && WORD(ent2 + 2) == 0177777)) ;
if (j <= i)
@ -179,12 +211,24 @@ MLB *mlb_rt11_open(
into unused entry's
space */
memset(ent2, 0377, entsize); /* Mark entry unused */
} else {
if (w1 == 0000000 && w2 == 0000000) {
fprintf(stderr, "mlb_rt11_open error: bad file, null name\n");
goto error;
}
}
}
/* Now i contains the actual number of entries. */
mlb->nentries = i;
#if MLBDEBUG_OPEN
fprintf(stderr, "mlb->nentries=%d\n", mlb->nentries);
#endif
if (mlb->nentries == 0) {
fprintf(stderr, "mlb_rt11_open error: no entries\n");
goto error;
}
/* Sort the array by file position */
@ -194,6 +238,11 @@ MLB *mlb_rt11_open(
mlb->directory = memcheck(malloc(sizeof(MLBENT) * mlb->nentries));
memset(mlb->directory, 0, sizeof(MLBENT) * mlb->nentries);
unsigned long max_filepos;
fseek(mlb->fp, 0, SEEK_END);
max_filepos = ftell(mlb->fp);
/* Build in-memory directory */
for (j = 0; j < i; j++) {
char radname[16];
@ -206,17 +255,25 @@ MLB *mlb_rt11_open(
radname[6] = 0;
trim(radname);
if (radname[0] == '\0' || strchr(radname, ' ')) {
fprintf(stderr, "mlb_rt11_open error: entry with space in name\n");
goto error;
}
mlb->directory[j].label = memcheck(strdup(radname));
mlb->directory[j].position = BYTEPOS(ent);
if (mlb->directory[j].position > max_filepos) {
fprintf(stderr, "mlb_rt11_open error: entry past EOF\n");
goto error;
}
if (j < i - 1) {
mlb->directory[j].length = BYTEPOS(ent + entsize) - BYTEPOS(ent);
} else {
unsigned long max;
unsigned long max = max_filepos;
char c;
fseek(mlb->fp, 0, SEEK_END);
max = ftell(mlb->fp);
/* Look for last non-zero */
do {
max--;
@ -226,6 +283,13 @@ MLB *mlb_rt11_open(
max++;
mlb->directory[j].length = max - BYTEPOS(ent);
}
#if MLBDEBUG_OPEN
fprintf(stderr, "entry #%d '%s' %ld length %d\n",
j,
mlb->directory[j].label,
mlb->directory[j].position,
mlb->directory[j].length);
#endif
}
free(buff);
@ -233,6 +297,14 @@ MLB *mlb_rt11_open(
/* Done. Return the struct that represents the opened MLB. */
return mlb;
error:
#if MLBDEBUG_OPEN
fprintf(stderr, "(mlb_rt11_open closing '%s' due to errors)\n", name);
#endif
mlb_rt11_close(mlb); /* Sorry, bad file. */
free(buff);
return NULL;
}
/* mlb_rt11_close discards MLB and closes the file. */

1
crossassemblers/macro11/mlb.h
View File

@ -62,6 +62,7 @@ typedef struct mlb_vtbl {
BUFFER *(*mlb_entry)(MLB *mlb, char *name);
void (*mlb_extract)(MLB *mlb);
void (*mlb_close)(MLB *mlb);
int mlb_is_rt11;
} MLB_VTBL;
extern MLB *mlb_open(

34
crossassemblers/macro11/mlb2.c
View File

@ -35,6 +35,7 @@ DAMAGE.
#include <string.h>
#include "util.h"
#include "mlb.h"
#include "object.h"
MLB_VTBL *mlb_vtbls[] = {
&mlb_rsx_vtbl,
@ -42,25 +43,46 @@ MLB_VTBL *mlb_vtbls[] = {
NULL
};
MLB *mlb_open(
static MLB *mlb_open_fmt(
char *name,
int allow_object_library)
int allow_object_library,
int object_format)
{
MLB_VTBL *vtbl;
MLB *mlb = NULL;
int i;
for (i = 0; (vtbl = mlb_vtbls[i]); i++) {
mlb = vtbl->mlb_open(name, allow_object_library);
if (mlb != NULL) {
mlb->name = memcheck(strdup(name));
break;
if (vtbl->mlb_is_rt11 == object_format) {
mlb = vtbl->mlb_open(name, allow_object_library);
if (mlb != NULL) {
mlb->name = memcheck(strdup(name));
break;
}
}
}
return mlb;
}
MLB *mlb_open(
char *name,
int allow_object_library)
{
MLB *mlb = NULL;
/*
* First try the open function for the currently set object format.
* If that fails, try the other one.
*/
mlb = mlb_open_fmt(name, allow_object_library, rt11);
if (mlb == NULL) {
mlb = mlb_open_fmt(name, allow_object_library, !rt11);
}
return mlb;
}
BUFFER *mlb_entry(
MLB *mlb,
char *name)

25
crossassemblers/macro11/object.c
View File

@ -159,23 +159,21 @@ int gsd_flush(
/* 1 byte type */
/* 2 bytes value */
static int gsd_write(
static int gsd_write2(
GSD * gsd,
char *name,
unsigned *radtbl,
int flags,
int type,
int value)
{
char *cp;
unsigned radtbl[2];
if (gsd->offset > (int)sizeof(gsd->buf) - 8) {
if (!gsd_flush(gsd))
return 0;
}
rad50x2(name, radtbl);
cp = gsd->buf + gsd->offset;
*cp++ = radtbl[0] & 0xff;
*cp++ = (radtbl[0] >> 8) & 0xff;
@ -193,6 +191,19 @@ static int gsd_write(
return 1;
}
static int gsd_write(
GSD * gsd,
char *name,
int flags,
int type,
int value)
{
unsigned radtbl[2];
rad50x2(name, radtbl);
return gsd_write2 (gsd, radtbl, flags, type, value);
}
/* gsd_mod - Write module name to GSD */
int gsd_mod(
@ -258,9 +269,9 @@ int gsd_psect(
/* Write program ident to GSD */
int gsd_ident(
GSD * gsd,
char *name)
unsigned *name)
{
return gsd_write(gsd, name, 0, GSD_IDENT, 0);
return gsd_write2(gsd, name, 0, GSD_IDENT, 0);
}
/* Write virtual array declaration to GSD */

2
crossassemblers/macro11/object.h
View File

@ -161,7 +161,7 @@ int gsd_psect(
int size);
int gsd_ident(
GSD * gsd,
char *name);
unsigned *name);
int gsd_virt(
GSD * gsd,
char *name,

345
crossassemblers/macro11/parse.c
View File

@ -417,7 +417,6 @@ int get_fp_src_mode(
}
#define DEBUG_FLOAT 0
#if DEBUG_FLOAT
void
printflt(unsigned *flt, int size)
@ -434,9 +433,10 @@ printflt(unsigned *flt, int size)
printf("\n");
}
#define DF(x) printf x
#if DEBUG_FLOAT
#define DF(...) printf(__VA_ARGS__)
#else
#define DF(x)
#define DF(...)
#endif
/*
@ -470,12 +470,18 @@ printflt(unsigned *flt, int size)
# define FREXP frexp
#endif
#define PARSE_FLOAT_WITH_FLOATS 0
#define PARSE_FLOAT_WITH_INTS 1
#define PARSE_FLOAT_DIVIDE_BY_MULT_LOOP 0
/* Parse PDP-11 64-bit floating point format. */
/* Give a pointer to "size" words to receive the result. */
/* Note: there are probably degenerate cases that store incorrect
results. For example, I think rounding up a FLT2 might cause
exponent overflow. Sorry. */
#if PARSE_FLOAT_WITH_FLOATS
/* Note also that the full 56 bits of precision probably aren't always
available on the source platform, given the widespread application
of IEEE floating point formats, so expect some differences. Sorry
@ -502,8 +508,8 @@ int parse_float(
i = sscanf(cp, SCANF_FMT "%n", &d, &n);
if (i == 0)
return 0; /* Wasn't able to convert */
DF(("LDBL_MANT_DIG: %d\n", LDBL_MANT_DIG));
DF(("%Lf input: %s", d, cp));
DF("LDBL_MANT_DIG: %d\n", LDBL_MANT_DIG);
DF("%Lf input: %s", d, cp);
cp += n;
if (endp)
@ -517,13 +523,13 @@ int parse_float(
}
frac = FREXP(d, &sexp); /* Separate into exponent and mantissa */
DF(("frac: %Lf %La sexp: %d\n", frac, frac, sexp));
DF("frac: %Lf %La sexp: %d\n", frac, frac, sexp);
if (sexp < -127 || sexp > 127)
return 0; /* Exponent out of range. */
uexp = sexp + 128; /* Make excess-128 mode */
uexp &= 0xff; /* express in 8 bits */
DF(("uexp: %02x\n", uexp));
DF("uexp: %02x\n", uexp);
/*
* frexp guarantees its fractional return value is
@ -555,8 +561,8 @@ int parse_float(
/* The following big literal is 2 to the 57th power: */
ufrac = (uint64_t) (frac * 144115188075855872.0); /* Align fraction bits */
DF(("ufrac: %016lx\n", ufrac));
DF(("56 : %016lx\n", (1UL<<57) - 2));
DF("ufrac: %016lx\n", ufrac);
DF("56 : %016lx\n", (1UL<<57) - 2);
/*
* ufrac is now >= 2**56 and < 2**57.
@ -589,14 +595,14 @@ int parse_float(
onehalf = 1ULL << (16 * (4-size));
ufrac += onehalf;
DF(("onehalf=%016lx, ufrac+onehalf: %016lx\n", onehalf, ufrac));
DF("onehalf=%016lx, ufrac+onehalf: %016lx\n", onehalf, ufrac);
/* Did it roll up to a value 2**56? */
if ((ufrac >> 57) > 0) { /* Overflow? */
if (uexp < 0xFF) {
ufrac >>= 1; /* Normalize */
uexp++;
DF(("ufrac: %016lx uexp: %02x (normalized)\n", ufrac, uexp));
DF("ufrac: %016lx uexp: %02x (normalized)\n", ufrac, uexp);
} else {
/*
* If rounding and then normalisation would cause the exponent to
@ -606,7 +612,7 @@ int parse_float(
* readable to just undo it here.
*/
ufrac -= onehalf;
DF(("don't round: exponent overflow"));
DF("don't round: exponent overflow\n");
}
}
@ -624,6 +630,298 @@ int parse_float(
return 1;
}
#elif PARSE_FLOAT_WITH_INTS
#define DUMP3 DF("exp: %d. %d %016llx\n", \
float_dec_exponent, float_bin_exponent, float_buf)
/*
* Parse floating point denotations using integer operations only.
* Follows the reference version's implementation fairly closely.
*/
int parse_float(
char *cp,
char **endp,
int size,
unsigned *flt)
{
int float_sign = 0;
int float_dot = 0;
int float_dec_exponent = 0;
int float_bin_exponent = 0;
int ok_chars = 0;
uint64_t float_buf = 0;
float_bin_exponent = 65;
cp = skipwhite(cp);
if (*cp == '+') {
cp++;
} else if (*cp == '-') {
float_sign = 1;
cp++;
}
DF("float_sign: %d\n", float_sign);
while (!EOL(*cp)) {
if (isdigit(*cp)) {
/* Can we multiply by 10? */
DF("digit: %c\n", *cp);
ok_chars++;
if (float_buf & 0xF800000000000000ULL) { /* [0] & 0174000, 0xF800 */
/* No, that would overflow */
float_dec_exponent++; /* no, compensate for the snub */
/*
* Explanation of the above comment:
* - after the decimal separator, we should ignore extra digits
* completely. Since float_dot == -1, the exponent will be
* decremented below, and compensate for that here.
* - before the decimal separator, we don't add the digit
* (which would overflow) so we lose some lesser significant
* bits. float_dot == 0 in this case, and we do want the
* exponent increased to compensate for the ignored digit.
* So in both cases the right thing happens.
*/
} else {
/* Multiply by 10 */
float_buf *= 10;
/* Add digit */
float_buf += *cp - '0';
}
float_dec_exponent -= float_dot;
DUMP3;
cp++;
} else if (*cp == '.') {
DF("dot: %c\n", *cp);
ok_chars++;
if (float_dot) {
return 0; /* Error: repeated decimal separator */
}
float_dot = 1;
cp++;
} else {
DF("Other char: %c\n", *cp);
if (ok_chars == 0) {
return 0; /* No valid number found */
}
break;
}
}
if (toupper(*cp) == 'E') {
cp++;
int exp = strtol(cp, &cp, 10);
float_dec_exponent += exp;
DF("E%d -> dec_exp %d\n", exp, float_dec_exponent);
}
if (endp)
*endp = cp;
/* FLTG3 */
if (float_buf) {
/* Non-zero */
DF("Non-zero: decimal exponent: %d\n", float_dec_exponent);
while (float_dec_exponent > 0) { /* 31$ */
DUMP3;
if (float_buf <= 0x3316000000000000ULL) { /* 031426, 13078, 0x3316, 65390 / 5 */
/* Multiply by 5 and 2 */
DF("Multiply by 5 and 2\n");
float_buf *= 5;
float_bin_exponent++;
DUMP3;
} else {
/* Multiply by 5/4 and 8 32$ */
DF("Multiply by 5/4 and 8\n");
if (float_buf >= 0xCCCC000000000000ULL) {
float_buf >>= 1;
float_bin_exponent++;
}
float_buf += (float_buf >> 2);
float_bin_exponent += 3;
DUMP3;
}
float_dec_exponent--;
}
while (float_dec_exponent < 0) { /* 41$ ish */
DUMP3;
DF("Prepare for division by left-shifting the bits\n");
/* Prepare for division by left-shifting the bits */
while (((float_buf >> 63) & 1) == 0) { /* 41$ */
float_bin_exponent--; /* 40$ */
float_buf <<= 1;
DUMP3;
}
/* Divide by 2 */
float_buf >>= 1;
#if PARSE_FLOAT_DIVIDE_BY_MULT_LOOP
uint64_t float_save = float_buf;
DUMP3;
DF("float_save: %016llx\n", float_save);
/*
* Divide by 5: this is done by the trick of "dividing by
* multiplying". In order to keep as many significant bits as
* possible, we multiply by 8/5, and adjust the binary exponent to
* compensate for the factor of 8.
* The result is found when we drop the 64 low bits.
*
* So we multiply with the 65-bit number
* 0x19999999999999999
* 1 1001 1001 1001 ...
* which is 8 * 0011 0011 0011 ... aka 0x333...
* which is (2**64 - 1) / 5 aka 0xFFF... / 5.
*
* The rightmost (1 * float_save << 0) is contributed to the total
* because float_buf already contains that value.
* In loop i=32, (float_save << 3) is added:
* due to the two extra conditional shifts.
* In loop i=31, (float_save << 4) is added.
* In loop i=30, (float_save << 7) is added.
* etc, etc,
* so forming the repeating bit-pattern 1100 of the multiplier.
*
* Instead of shifting float_save left, we shift float_buf right,
* which over time drops precisely the desired 64 low bits.
*
* This is nearly exact but exact enough.
*
* The final result = start * 8 / 5.
*/
for (int i = 16 * 2; i > 0; i--) {
if ((i & 1) == 0) { /* 42$ */
float_buf >>= 2;
}
float_buf >>= 1; /* 43$ */
float_buf += float_save;
DF("Loop i=%2d: ", i); DUMP3;
}
#else
int round = float_buf % 5;
float_buf = float_buf / 5 * 8;
/*
* Try to fill in some of the lesser significant bits.
* This is not always bitwise identical to the original method
* but probably more accurate.
*/
if (round) {
float_buf += round * 8 / 5;
}
#endif
/* It's not simply dividing by 5, it also multiplies by 8,
* so we need to adjust the exponent here. */
float_bin_exponent -= 3;
float_dec_exponent++;
DUMP3;
}
/* Normalize the mantissa: shift a single 1 out to the left */
DF("Normalize the mantissa: shift a single 1 out to the left\n");
int carry;
do {
/* FLTG5 */
float_bin_exponent--;
carry = (float_buf >> 63) & 1;
float_buf <<= 1;
DUMP3;
} while (carry == 0);
/* Set excess 128. */
DF("Set excess 128.\n");
float_bin_exponent += 0200;
DUMP3;
if (float_bin_exponent & 0xFF00) {
/* Error N. Underflow. 2$ */
report(NULL, "Error N (underflow)\n");
return 0;
}
/* Shift right 9 positions to make room for sign and exponent 3$ */
DF("Shift right 9 positions to make room for sign and exponent\n");
int round = (float_buf >> 8) & 0x0001;
float_buf >>= 9;
float_buf |= (uint64_t)float_bin_exponent << (64-9);
DUMP3;
/*
* This rounding step seems always needed to make the result the same
* as the implementation with long doubles.
*
* This may be because of the slight imprecision of the divisions by 10?
*
* It is needed to get some exact results for values that are indeed
* exactly representable. Examples:
*
* (2**9-3)/2**9 = 0.994140625 = 0,11111101
* 407e 7fff ffff ffff -> 407e 8000 0000 0000 (correct)
* 1.00 (or 100E-2) divides 100 by 100 and gets
* 407f ffff ffff ffff -> 4080 0000 0000 0000 (correct)
*
* The reference implementation omits this rounding for size != 4:
* it has only one rounding step, which always depends on the size.
*/
float_buf += round;
DF("round: size = 4, round = %d\n", round);
/* Round (there is a truncation option to omit this step) */
if (1) {
uint64_t onehalf;
if (size < 4) {
/* 1 << 31 or 1 << 47 */
onehalf = 1ULL << ((16 * (4-size)) - 1);
DF("round: size = %d, onehalf = %016llx\n", size, onehalf);
float_buf += onehalf;
DUMP3;
/* The rounding bit is the lesser significant bit that's just
* outside the returned result. If we round, we add it to the
* returned value.
*
* If there is a carry-out of the mantissa, it gets added to
* the exponent (increasing it by 1).
*
* If that also overflows, we truely have overflow.
*/
}
DF("After rounding\n");
DUMP3;
}
if (float_buf & 0x8000000000000000ULL) {
// 6$ error T: exponent overflow
report(NULL, "error T: exponent overflow\n");
return 0;
}
/* 7$ */
float_buf |= (uint64_t)float_sign << 63;
DF("Put in float_sign: "); DUMP3;
}
/* Now put together the result from the parts */
flt[0] = (float_buf >> 48) & 0xFFFF;
if (size > 1) {
flt[1] = (float_buf >> 32) & 0xFFFF;
if (size > 2) {
flt[2] = (float_buf >> 16) & 0xFFFF;
flt[3] = (float_buf >> 0) & 0xFFFF;
}
}
return 1;
}
#else
# error How are you going to parse floats?
#endif
/* The recursive-descent expression parser parse_expr. */
@ -743,23 +1041,23 @@ char *get_symbol(
{
int len;
char *symcp;
int digits = 0;
int start_digit = 0;
int not_digits = 0;
cp = skipwhite(cp); /* Skip leading whitespace */
if (!issym((unsigned char)*cp))
return NULL;
digits = 0;
if (isdigit((unsigned char)*cp))
digits = 2; /* Think about digit count */
start_digit = 1;
for (symcp = cp + 1; issym((unsigned char)*symcp); symcp++) {
if (!isdigit((unsigned char)*symcp)) /* Not a digit? */
digits--; /* Make a note. */
not_digits++; /* Make a note. */
}
if (digits == 2)
if (start_digit && not_digits == 0)
return NULL; /* Not a symbol, it's a digit string */
if (endp)
@ -780,9 +1078,9 @@ char *get_symbol(
if (islocal) {
*islocal = 0;
/* Turn to local label format */
if (digits == 1) {
if (symcp[len - 1] == '$') {
/* Check if local label format */
if (start_digit) {
if (not_digits == 1 && symcp[len - 1] == '$') {
char *newsym = memcheck(malloc(32)); /* Overkill */
sprintf(newsym, "%ld$%d", strtol(symcp, NULL, 10), lsb);
@ -792,8 +1090,7 @@ char *get_symbol(
}
free(symcp);
symcp = newsym;
if (islocal)
*islocal = SYMBOLFLAG_LOCAL;
*islocal = SYMBOLFLAG_LOCAL;
lsb_used++;
} else {
free(symcp);
@ -801,8 +1098,8 @@ char *get_symbol(
}
}
} else {
/* disallow local label format */
if (isdigit((unsigned char)*symcp)) {
/* Disallow local label format */
if (start_digit) {
free(symcp);
return NULL;
}

51
crossassemblers/macro11/rept_irpc.c
View File

@ -27,11 +27,11 @@ typedef struct rept_stream {
expansion */
} REPT_STREAM;
/* rept_stream_gets gets a line from a repeat stream. At the end of
/* rept_stream_getline gets a line from a repeat stream. At the end of
each count, the coutdown is decreated and the stream is reset to
its beginning. */
char *rept_stream_gets(
char *rept_stream_getline(
STREAM *str)
{
REPT_STREAM *rstr = (REPT_STREAM *) str;
@ -41,7 +41,7 @@ char *rept_stream_gets(
if (rstr->count <= 0)
return NULL;
if ((cp = buffer_stream_gets(str)) != NULL)
if ((cp = buffer_stream_getline(str)) != NULL)
return cp;
buffer_stream_rewind(str);
@ -64,7 +64,7 @@ void rept_stream_delete(
/* The VTBL */
STREAM_VTBL rept_stream_vtbl = {
rept_stream_delete, rept_stream_gets, buffer_stream_rewind
rept_stream_delete, rept_stream_getline, buffer_stream_rewind
};
/* expand_rept is called when a .REPT is encountered in the input. */
@ -135,11 +135,11 @@ typedef struct irp_stream {
int savecond; /* Saved conditional level */
} IRP_STREAM;
/* irp_stream_gets expands the IRP as the stream is read. */
/* irp_stream_getline expands the IRP as the stream is read. */
/* Each time an iteration is exhausted, the next iteration is
generated. */
char *irp_stream_gets(
char *irp_stream_getline(
STREAM *str)
{
IRP_STREAM *istr = (IRP_STREAM *) str;
@ -148,7 +148,7 @@ char *irp_stream_gets(
ARG *arg;
for (;;) {
if ((cp = buffer_stream_gets(str)) != NULL)
if ((cp = buffer_stream_getline(str)) != NULL)
return cp;
cp = istr->items + istr->offset;
@ -190,9 +190,32 @@ void irp_stream_delete(
}
STREAM_VTBL irp_stream_vtbl = {
irp_stream_delete, irp_stream_gets, buffer_stream_rewind
irp_stream_delete, irp_stream_getline, buffer_stream_rewind
};
/* We occasionally see .IRP with the formal name in angle brackets. I
* have no idea why, but it appears to be legal. So allow that. Not
* sure if it should be allowed elsewhere, e.g., in .MACRO. For now,
* don't. */
static char *get_irp_sym (char *cp, char **endcp, int *islocal)
{
char *ret = NULL;
cp = skipwhite(cp);
if (*cp == '<') {
ret = get_symbol (cp + 1, &cp, islocal);
if (*cp++ != '>') {
*endcp = cp;
return NULL;
}
}
else {
ret = get_symbol (cp, &cp, islocal);
}
*endcp = cp;
return ret;
}
/* expand_irp is called when a .IRP is encountered in the input. */
STREAM *expand_irp(
@ -205,7 +228,7 @@ STREAM *expand_irp(
int levelmod = 0;
IRP_STREAM *str;
label = get_symbol(cp, &cp, NULL);
label = get_irp_sym(cp, &cp, NULL);
if (!label) {
report(stack->top, "Illegal .IRP syntax\n");
return NULL;
@ -266,10 +289,10 @@ typedef struct irpc_stream {
int savecond; /* conditional stack at invocation */
} IRPC_STREAM;
/* irpc_stream_gets - same comments apply as with irp_stream_gets, but
/* irpc_stream_getline - same comments apply as with irp_stream_getline, but
the substitution is character-by-character */
char *irpc_stream_gets(
char *irpc_stream_getline(
STREAM *str)
{
IRPC_STREAM *istr = (IRPC_STREAM *) str;
@ -278,7 +301,7 @@ char *irpc_stream_gets(
ARG *arg;
for (;;) {
if ((cp = buffer_stream_gets(str)) != NULL)
if ((cp = buffer_stream_getline(str)) != NULL)
return cp;
cp = istr->items + istr->offset;
@ -320,7 +343,7 @@ void irpc_stream_delete(
}
STREAM_VTBL irpc_stream_vtbl = {
irpc_stream_delete, irpc_stream_gets, buffer_stream_rewind
irpc_stream_delete, irpc_stream_getline, buffer_stream_rewind
};
/* expand_irpc - called when .IRPC is encountered in the input */
@ -335,7 +358,7 @@ STREAM *expand_irpc(
int levelmod = 0;
IRPC_STREAM *str;
label = get_symbol(cp, &cp, NULL);
label = get_irp_sym(cp, &cp, NULL);
if (!label) {
report(stack->top, "Illegal .IRPC syntax\n");
return NULL;

18
crossassemblers/macro11/stream2.c
View File

@ -172,9 +172,9 @@ void stream_delete(
/* *** class BUFFER_STREAM implementation */
/* STREAM::gets for a buffer stream */
/* STREAM::getline for a buffer stream */
char *buffer_stream_gets(
char *buffer_stream_getline(
STREAM *str)
{
char *nl;
@ -228,7 +228,7 @@ void buffer_stream_rewind(
/* BUFFER_STREAM vtbl */
STREAM_VTBL buffer_stream_vtbl = {
buffer_stream_delete, buffer_stream_gets, buffer_stream_rewind
buffer_stream_delete, buffer_stream_getline, buffer_stream_rewind
};
void buffer_stream_construct(
@ -271,9 +271,9 @@ STREAM *new_buffer_stream(
/* *** FILE_STREAM implementation */
/* Implement STREAM::gets for a file stream */
/* Implement STREAM::getline for a file stream */
static char *file_gets(
static char *file_getline(
STREAM *str)
{
int i,
@ -332,7 +332,7 @@ void file_rewind(
}
static STREAM_VTBL file_stream_vtbl = {
file_destroy, file_gets, file_rewind
file_destroy, file_getline, file_rewind
};
/* Prepare and open a stream from a file. */
@ -391,11 +391,11 @@ void stack_push(
stack->top = str;
}
/* stack_gets calls vtbl->gets for the topmost stack entry. When
/* stack_getline calls vtbl->getline for the topmost stack entry. When
topmost streams indicate they're exhausted, they are popped and
deleted, until the stack is exhausted. */
char *stack_gets(
char *stack_getline(
STACK *stack)
{
char *line;
@ -403,7 +403,7 @@ char *stack_gets(
if (stack->top == NULL)
return NULL;
while ((line = stack->top->vtbl->gets(stack->top)) == NULL) {
while ((line = stack->top->vtbl->getline(stack->top)) == NULL) {
stack_pop(stack);
if (stack->top == NULL)
return NULL;

19
crossassemblers/macro11/stream2.h
View File

@ -40,15 +40,12 @@ DAMAGE.
struct stream;
typedef struct stream_vtbl {
void (
*delete) (
struct stream * stream); /* Destructor */
char *(
*gets) (
struct stream * stream); /* "gets" function */
void (
*rewind) (
struct stream * stream); /* "rewind" function */
void (*delete)(
struct stream *stream); /* Destructor */
char *(*getline)(
struct stream *stream); /* "getline" function */
void (*rewind)(
struct stream *stream); /* "rewind" function */
} STREAM_VTBL;
typedef struct stream {
@ -114,7 +111,7 @@ void buffer_stream_construct(
BUFFER_STREAM * bstr,
BUFFER *buf,
char *name);
char *buffer_stream_gets(
char *buffer_stream_getline(
STREAM *str);
void buffer_stream_delete(
STREAM *str);
@ -131,7 +128,7 @@ void stack_push(
STREAM *str);
void stack_pop(
STACK *stack);
char *stack_gets(
char *stack_getline(
STACK *stack);
#endif /* STREAM2_H */

3
crossassemblers/macro11/symbols.c
View File

@ -369,6 +369,7 @@ void add_symbols(
add_sym(".BLKW", P_BLKW, S, &pseudo_section, &system_st);
add_sym(".BYTE", P_BYTE, S, &pseudo_section, &system_st);
add_sym(".CSECT", P_CSECT, S, &pseudo_section, &system_st);
add_sym(".CROSS", P_CROSS, S, &pseudo_section, &system_st);
add_sym(".DSABL", P_DSABL, S, &pseudo_section, &system_st);
add_sym(".ENABL", P_ENABL, S, &pseudo_section, &system_st);
add_sym(".END", P_END, S, &pseudo_section, &system_st);
@ -396,10 +397,12 @@ void add_symbols(
add_sym(".LIMIT", P_LIMIT, S, &pseudo_section, &system_st);
add_sym(".LIST", P_LIST, S, &pseudo_section, &system_st);
add_sym(".MCALL", P_MCALL, S, &pseudo_section, &system_st);
add_sym(".MDELE", P_MDELETE, S, &pseudo_section, &system_st);
add_sym(".MEXIT", P_MEXIT, S, &pseudo_section, &system_st);
add_sym(".NARG", P_NARG, S, &pseudo_section, &system_st);
add_sym(".NCHR", P_NCHR, S, &pseudo_section, &system_st);
add_sym(".NLIST", P_NLIST, S, &pseudo_section, &system_st);
add_sym(".NOCRO", P_NOCROSS, S, &pseudo_section, &system_st);
add_sym(".NTYPE", P_NTYPE, S, &pseudo_section, &system_st);
add_sym(".ODD", P_ODD, S, &pseudo_section, &system_st);
add_sym(".PACKED", P_PACKED, S, &pseudo_section, &system_st);

3
crossassemblers/macro11/symbols.h
View File

@ -57,6 +57,7 @@ enum pseudo_ops { P_ASCII,
P_BLKW,
P_BYTE,
P_CSECT,
P_CROSS,
P_DSABL,
P_ENABL,
P_END,
@ -81,10 +82,12 @@ enum pseudo_ops { P_ASCII,
P_LIMIT,
P_LIST,
P_MCALL,
P_MDELETE,
P_MEXIT,
P_NARG,
P_NCHR,
P_NLIST,
P_NOCROSS,
P_NTYPE,
P_ODD,
P_PACKED,

2
crossassemblers/macro11/tests/RunTests
View File

@ -30,9 +30,11 @@ TESTS="test-asciz \
test-prec \
test-psect \
test-rad50 \
test-radix \
test-reg \
test-reloc \
test-rept \
test-syntax \
test-ua-pl \
test-undef \
test-word-comma"

972
crossassemblers/macro11/tests/float.c Executable file
View File

@ -0,0 +1,972 @@
# /*
gcc float.c -o float -lm
./float
exit $?
*/
/*
* Parsing PDP-11 floating point literals.
* Testing ground for different implementations.
*/
#include <stdlib.h>
#include <stdint.h>
#include <stdio.h>
#include <string.h>
#include <ctype.h>
#include <math.h>
#include <float.h>
#include <ieeefp.h>
#define DEBUG_FLOAT 1
void
printflt(unsigned *flt, int size)
{
printf("%06o: ", flt[0]);
printf("sign: %d ", (flt[0] & 0x8000) >> 15);
printf("uexp: %x ", (flt[0] & 0x7F80) >> 7);
printf("ufrac: %02x", flt[0] & 0x007F);
for (int i = 1; i < size; i++) {
printf(" %04x", flt[i]);
}
printf("\n");
}
#if DEBUG_FLOAT
#define DF(...) printf(__VA_ARGS__)
#else
#define DF(...)
#endif
/*
* We need 56 bits of mantissa.
*
* Try to detect if it is needed, possible and useful to use
* long double instead of double, when parsing floating point numbers.
*/
#if DBL_MANT_DIG >= 56
/* plain double seems big enough */
# define USE_LONG_DOUBLE 0
/* long double exists and seems big enough */
#elif LDBL_MANT_DIG >= 56
# define USE_LONG_DOUBLE 1
#elif defined(LDBL_MANT_DIG)
/* long double exists but is probably still too small */
# define USE_LONG_DOUBLE 1
#else
/* long double does not exist and plain double is too small */
# define USE_LONG_DOUBLE 0
#endif
#if USE_LONG_DOUBLE
# define DOUBLE long double
# define SCANF_FMT "%Lf"
# define FREXP frexpl
#else
# define DOUBLE double
# define SCANF_FMT "%lf"
# define FREXP frexp
#endif
/* Parse PDP-11 64-bit floating point format. */
/* Give a pointer to "size" words to receive the result. */
/* Note: there are probably degenerate cases that store incorrect
results. For example, I think rounding up a FLT2 might cause
exponent overflow. Sorry. */
/* Note also that the full 56 bits of precision probably aren't always
available on the source platform, given the widespread application
of IEEE floating point formats, so expect some differences. Sorry
again. */
int parse_float(
char *cp,
int size,
unsigned *flt)
{
DOUBLE d; /* value */
DOUBLE frac; /* fractional value */
uint64_t ufrac; /* fraction converted to 56 bit
unsigned integer */
uint64_t onehalf; /* one half of the smallest bit
(used for rounding) */
int i; /* Number of fields converted by sscanf */
int n; /* Number of characters converted by sscanf */
int sexp; /* Signed exponent */
unsigned uexp; /* Unsigned excess-128 exponent */
unsigned sign = 0; /* Sign mask */
i = sscanf(cp, SCANF_FMT "%n", &d, &n);
if (i == 0)
return 0; /* Wasn't able to convert */
DF("LDBL_MANT_DIG: %d\n", LDBL_MANT_DIG);
DF("%Lf input: %s\n", d, cp);
cp += n;
if (d == 0.0) {
for (i = 0; i < size; i++) {
flt[i] = 0; /* All-bits-zero equals zero */
}
return 1; /* Good job. */
}
frac = FREXP(d, &sexp); /* Separate into exponent and mantissa */
DF("frac: %Lf %La sexp: %d\n", frac, frac, sexp);
if (sexp < -127 || sexp > 127)
return 0; /* Exponent out of range. */
uexp = sexp + 128; /* Make excess-128 mode */
uexp &= 0xff; /* express in 8 bits */
DF("uexp: %02x\n", uexp);
/*
* frexp guarantees its fractional return value is
* abs(frac) >= 0.5 and abs(frac) < 1.0
* Another way to think of this is that:
* abs(frac) >= 2**-1 and abs(frac) < 2**0
*/
if (frac < 0) {
sign = (1 << 15); /* Negative sign */
frac = -frac; /* fix the mantissa */
}
/*
* For the PDP-11 floating point representation the
* fractional part is 7 bits (for 16-bit floating point
* literals), 23 bits (for 32-bit floating point values),
* or 55 bits (for 64-bit floating point values).
* However the bit immediately above the MSB is always 1
* because the value is normalized. So it's actually
* 8 bits, 24 bits, or 56 bits.
* We effectively multiply the fractional part of our value by
* 2**56 to fully expose all of those bits (including
* the MSB which is 1).
* However as an intermediate step, we really multiply by
* 2**57, so we get one lsb for possible later rounding
* purposes. After that, we divide by 2 again.
*/
/* The following big literal is 2 to the 57th power: */
ufrac = (uint64_t) (frac * 144115188075855872.0); /* Align fraction bits */
DF("ufrac: %016lx\n", ufrac);
DF("56 : %016lx\n", (1UL<<57) - 2);
/*
* ufrac is now >= 2**56 and < 2**57.
* This means it's normalized: bit [56] is 1
* and all higher bits are 0.
*/
/* Round from 57-bits to 56, 24, or 8.
* We do this by:
* + first adding a value equal to one half of the
* least significant bit (the value 'onehalf')
* + (possibly) dealing with any carrying that
* causes the value to no longer be normalized
* (with bit [56] = 1 and all higher bits = 0)
* + shifting right by 1 bit (which throws away
* the 0 bit). Note this step could be rolled
* into the next step.
* + taking the remaining highest order 8,
* 24, or 56 bits.
*
* +--+--------+-------+ +--------+--------+
* |15|14 7|6 0| |15 | 0|
* +--+--------+-------+ +--------+--------+
* | S|EEEEEEEE|MMMMMMM| |MMMMMMMM|MMMMMMMM| ...maybe 2 more words...
* +--+--------+-------+ +--------+--------+
* Sign (1 bit)
* Exponent (8 bits)
* Mantissa (7 bits)
*/
onehalf = 1ULL << (16 * (4-size));
ufrac += onehalf;
DF("onehalf=%016lx, ufrac+onehalf: %016lx\n", onehalf, ufrac);
/* Did it roll up to a value 2**56? */
if ((ufrac >> 57) > 0) { /* Overflow? */
if (uexp < 0xFF) {
ufrac >>= 1; /* Normalize */
uexp++;
DF("ufrac: %016lx uexp: %02x (normalized)\n", ufrac, uexp);
} else {
/*
* If rounding and then normalisation would cause the exponent to
* overflow, just don't round: the cure is worse than the disease.
* We could detect ahead of time but the conditions for all size
* values may be a bit complicated, and so rare, that it is more
* readable to just undo it here.
*/
ufrac -= onehalf;
DF("don't round: exponent overflow\n");
}
}
ufrac >>= 1; /* Go from 57 bits to 56 */
flt[0] = (unsigned) (sign | (uexp << 7) | ((ufrac >> 48) & 0x7F));
if (size > 1) {
flt[1] = (unsigned) ((ufrac >> 32) & 0xffff);
if (size > 2) {
flt[2] = (unsigned) ((ufrac >> 16) & 0xffff);
flt[3] = (unsigned) ((ufrac >> 0) & 0xffff);
}
}
return 1;
}
/*
* Several of these functions assume that "unsigned" contains more
* than 16 bits. Bit 16 is sometimes used to store a carry.
*/
#define DUMP DF("exp: %d. %d %04x %04x %04x %04x\n", \
float_dec_exponent, float_bin_exponent, \
float_buf[0], float_buf[1], float_buf[2], float_buf[3])
#define DUMP4(b, t) DF("%04x %04x %04x %04x%s", \
b[0], b[1], b[2], b[3], t)
void float_copy( /* XMIT4 at FLTGSV, more or less */
unsigned *to,
unsigned *from)
{
to[0] = from[0] & 0xFFFF;
to[1] = from[1] & 0xFFFF;
to[2] = from[2] & 0xFFFF;
to[3] = from[3] & 0xFFFF;
}
int float_right_shift( /* FLTGRS */
unsigned *buf)
{
int carry1, carry2;
carry1 = buf[0] & 0x0001; buf[0] >>= 1;
carry2 = buf[1] & 0x0001; buf[1] >>= 1; buf[1] |= (carry1 << 15);
carry1 = buf[2] & 0x0001; buf[2] >>= 1; buf[2] |= (carry2 << 15);
carry2 = buf[3] & 0x0001; buf[3] >>= 1; buf[3] |= (carry1 << 15);
return carry2;
}
int float_left_shift( /* FLTGLS */
unsigned *buf)
{
int carry1, carry2;
carry1 = buf[3] >> 15; buf[3] <<= 1;
carry2 = buf[2] >> 15; buf[2] <<= 1; buf[2] |= (carry1 & 0x0001);
carry1 = buf[1] >> 15; buf[1] <<= 1; buf[1] |= (carry2 & 0x0001);
carry2 = buf[0] >> 15; buf[0] <<= 1; buf[0] |= (carry1 & 0x0001);
float_copy(buf, buf); /* Clean up carries */
return carry2 & 0x01;
}
void float_add( /* FLTGAD */
unsigned *to,
unsigned *from)
{
//DF("float_add: "); DUMP4(to, ""); DF(" += "); DUMP4(from, "\n");
to[3] += from[3];
to[2] += from[2] + ((to[3] >> 16) & 0x0001);
to[1] += from[1] + ((to[2] >> 16) & 0x0001);
to[0] += from[0] + ((to[1] >> 16) & 0x0001);
//DF(" = "); DUMP4(to, "\n");
float_copy(to, to); /* Clean up carries */
}
void float_mult_by_5( /* FLTM50 */
unsigned *buf,
unsigned *workspace)
{
float_copy(workspace, buf); /* Save 1 x original value */
float_left_shift(buf); /* 2 x */
float_left_shift(buf); /* 4 x */
float_add(buf, workspace); /* 5 x */
}
void float_mult_by_5_4th( /* FLTM54 */
int *bin_exp,
unsigned *buf,
unsigned *workspace)
{
if (buf[0] >= 0146314) {
float_right_shift(buf);
++*bin_exp;
}
float_copy(workspace, buf);
float_right_shift(buf); /* half of the original */
float_right_shift(buf); /* a quarter */
float_add(buf, workspace); /* add the original to the quarter */
}
int parse_float_m2(
char *cp,
int size,
unsigned *flt)
{
int float_sign = 0;
int float_dot = 0;
int float_dec_exponent = 0;
int float_bin_exponent = 0;
unsigned float_buf[4] = { 0 };
unsigned float_save[4];
float_bin_exponent = 65;
if (*cp == '+') {
cp++;
} else if (*cp == '-') {
float_sign = 0100000;
cp++;
}
DF("float_sign: %d\n", float_sign);
for (;;) {
if (isdigit(*cp)) {
/* Can we multiply by 10? */
DF("digit: %c\n", *cp);
if (float_buf[0] & 0174000) {
/* No, that would overflow */
float_dec_exponent++; /* no, compensate for the snub */
/*
* Explanation of the above comment:
* - after the decimal separator, we should ignore extra digits
* completely. Since float_dot == -1, the exponent will be
* decremented below, and compensate for that here.
* - before the decimal separator, we don't add the digit
* (which would overflow) so we lose some lesser significant
* bits. float_dot == 0 in this case, and we do want the
* exponent increased to compensate for the ignored digit.
* So in both cases the right thing happens.
*/
} else {
/* Multiply by 10 */
float_mult_by_5(float_buf, float_save);
float_left_shift(float_buf);
/* Add digit */
float_buf[3] += *cp - '0';
/* Ripple carry */
float_buf[2] += (float_buf[3] >> 16) & 0x0001;
float_buf[1] += (float_buf[2] >> 16) & 0x0001;
float_buf[0] += (float_buf[1] >> 16) & 0x0001;
float_copy(float_buf, float_buf); /* Clean up carries */
}
float_dec_exponent += float_dot;
DUMP;
cp++;
} else if (*cp == '.') {
DF("dot: %c\n", *cp);
if (float_dot < 0) {
// error...
printf("Error: repeated decimal separator\n");
return 0;
}
float_dot = -1;
cp++;
} else {
DF("Other char: %c\n", *cp);
break;
}
}
if (toupper(*cp) == 'E') {
cp++;
int exp = strtol(cp, &cp, 10);
float_dec_exponent += exp;
DF("E%d -> dec_exp %d\n", exp, float_dec_exponent);
}
/* FLTG3 */
if (float_buf[0] | float_buf[1] | float_buf[2] | float_buf[3]) {
/* Non-zero */
DF("Non-zero: decimal exponent: %d\n", float_dec_exponent);
while (float_dec_exponent > 0) { /* 31$ */
DUMP;
if (float_buf[0] <= 031426) { /* 13078, 0x3316, 65390 / 5 */
/* Multiply by 5 and 2 */
DF("Multiply by 5 and 2\n");
float_mult_by_5(float_buf, float_save);
float_bin_exponent++;
DUMP;
} else {
/* Multiply by 5/4 and 8 32$ */
DF("Multiply by 5/4 and 8\n");
float_mult_by_5_4th(&float_bin_exponent, float_buf, float_save);
float_bin_exponent += 3;
DUMP;
}
float_dec_exponent--;
}
while (float_dec_exponent < 0) { /* 41$ ish */
DUMP;
DF("Prepare for division by left-shifting the bits\n");
/* Prepare for division by left-shifting the bits */
while ((float_buf[0] & 0x8000) == 0) { /* 41$ */
float_bin_exponent--; /* 40$ */
float_left_shift(float_buf);
DUMP;
}
/* Divide by 2 */
float_right_shift(float_buf);
float_copy(float_save, float_buf);
DUMP;
DF("float_save: "); DUMP4(float_save, "\n");
/* Divide by 5:
* multiplying by (2**32 - 1) / 5 = 0x333333333
* while dropping the 32 least significant bits.
* This is nearly exact but exact enough?
* 2**32 - 1 is a multiple of 5.
*/
for (int i = 16 * 2; i > 0; i--) {
if ((i & 1) == 0) { /* 42$ */
float_right_shift(float_buf);
float_right_shift(float_buf);
}
float_right_shift(float_buf); /* 43$ */
float_add(float_buf, float_save);
DF("Loop i=%2d: ", i); DUMP;
}
float_bin_exponent -= 3;
float_dec_exponent++;
DUMP;
}
/* Normalize the mantissa: shift a single 1 out to the left */
DF("Normalize the mantissa: shift a single 1 out to the left\n");
int carry;
do {
/* FLTG5 */
float_bin_exponent--;
carry = float_left_shift(float_buf);
DUMP;
} while (carry == 0);
/* Set excess 128. */
DF("Set excess 128.\n");
float_bin_exponent += 0200;
DUMP;
if (float_bin_exponent & 0xFF00) {
/* Error N. Underflow. 2$ */
printf("Error N (underflow)\n");
return 0;
}
/* Shift right 9 positions to make room for sign and exponent 3$ */
DF("Shift right 9 positions to make room for sign and exponent\n");
int round = (float_buf[3] >> 8) & 0x0001;
float_buf[3] >>= 9; float_buf[3] |= (float_buf[2] << (16-9)) & 0xff80;
float_buf[2] >>= 9; float_buf[2] |= (float_buf[1] << (16-9)) & 0xff80;
float_buf[1] >>= 9; float_buf[1] |= (float_buf[0] << (16-9)) & 0xff80;
float_buf[0] >>= 9;
float_buf[0] |= float_bin_exponent << 7;
DUMP;
/*
* float_bin_exponent is included because of the location of
* FLTBEX ;BINARY EXPONENT (MUST PRECEED FLTBUF)
*/
/* Round (this is optional, really) */
if (1) {
if (size < 4) {
round = float_buf[size] & 0x8000;
}
/* The rounding bit is the lesser significant bit that's just
* outside the returned result. If we round, we add it to the
* returned value.
*
* If there is a carry-out of the mantissa, it gets added to
* the exponent (increasing it by 1).
*
* If that also overflows, we truely have overflow.
*/
if (round) {
for (int i = size - 1 ; round && i >= 0; i--) {
float_buf[i]++; /* 5$ */
round = float_buf[i] & 0x10000; /* carry */
DF("round, i=%d: ", i); DUMP;
}
}
DF("After rounding\n");
DUMP;
}
if (float_buf[0] & 0x8000) {
// 6$ error T: exponent overflow
printf("Error T\n");
return 0;
}
/* 7$ */
float_buf[0] |= float_sign;
DF("Put in float_sign: "); DUMP;
}
/* Now put together the result from the parts */
flt[0] = float_buf[0] & 0xFFFF;
if (size > 1) {
flt[1] = float_buf[1] & 0xFFFF;
if (size > 2) {
flt[2] = float_buf[2] & 0xFFFF;
flt[3] = float_buf[3] & 0xFFFF;
}
}
return 1;
}
static void
mult64to128(uint64_t op1, uint64_t op2, uint64_t *hi, uint64_t *lo)
{
#if defined(__SIZEOF_INT128__) && __SIZEOF_INT128__ >= 16
__uint128_t result = (__uint128_t)op1 * op2;
*lo = result;
*hi = result >> 64;
#else
uint64_t u1 = (op1 & 0xffffffff);
uint64_t v1 = (op2 & 0xffffffff);
uint64_t t = (u1 * v1);
uint64_t w3 = (t & 0xffffffff);
uint64_t k = (t >> 32);
op1 >>= 32;
t = (op1 * v1) + k;
k = (t & 0xffffffff);
uint64_t w1 = (t >> 32);
op2 >>= 32;
t = (u1 * op2) + k;
k = (t >> 32);
*hi = (op1 * op2) + w1 + k;
*lo = (t << 32) + w3;
#endif
}
#define DUMP3 DF("exp: %d. %d %016llx\n", \
float_dec_exponent, float_bin_exponent, float_buf)
int parse_float_m3(
char *cp,
int size,
unsigned *flt)
{
int float_sign = 0;
int float_dot = 0;
int float_dec_exponent = 0;
int float_bin_exponent = 0;
uint64_t float_buf = 0;
float_bin_exponent = 65;
if (*cp == '+') {
cp++;
} else if (*cp == '-') {
float_sign = 1;
cp++;
}
DF("float_sign: %d\n", float_sign);
for (;;) {
if (isdigit(*cp)) {
/* Can we multiply by 10? */
DF("digit: %c\n", *cp);
if (float_buf & 0xF800000000000000ULL) { /* [0] & 0174000, 0xF800 */
/* No, that would overflow */
float_dec_exponent++; /* no, compensate for the snub */
/*
* Explanation of the above comment:
* - after the decimal separator, we should ignore extra digits
* completely. Since float_dot == -1, the exponent will be
* decremented below, and compensate for that here.
* - before the decimal separator, we don't add the digit
* (which would overflow) so we lose some lesser significant
* bits. float_dot == 0 in this case, and we do want the
* exponent increased to compensate for the ignored digit.
* So in both cases the right thing happens.
*/
} else {
/* Multiply by 10 */
float_buf *= 10;
/* Add digit */
float_buf += *cp - '0';
}
float_dec_exponent -= float_dot;
DUMP3;
cp++;
} else if (*cp == '.') {
DF("dot: %c\n", *cp);
if (float_dot) {
// error...
printf("Error: repeated decimal separator\n");
return 0;
}
float_dot = 1;
cp++;
} else {
DF("Other char: %c\n", *cp);
break;
}
}
if (toupper(*cp) == 'E') {
cp++;
int exp = strtol(cp, &cp, 10);
float_dec_exponent += exp;
DF("E%d -> dec_exp %d\n", exp, float_dec_exponent);
}
/* FLTG3 */
if (float_buf) {
/* Non-zero */
DF("Non-zero: decimal exponent: %d\n", float_dec_exponent);
while (float_dec_exponent > 0) { /* 31$ */
DUMP3;
if (float_buf <= 0x3316000000000000ULL) { /* 031426, 13078, 0x3316, 65390 / 5 */
/* Multiply by 5 and 2 */
DF("Multiply by 5 and 2\n");
float_buf *= 5;
float_bin_exponent++;
DUMP3;
} else {
/* Multiply by 5/4 and 8 32$ */
DF("Multiply by 5/4 and 8\n");
if (float_buf >= 0xCCCC000000000000ULL) {
float_buf >>= 1;
float_bin_exponent++;
}
float_buf += (float_buf >> 2);
float_bin_exponent += 3;
DUMP3;
}
float_dec_exponent--;
}
while (float_dec_exponent < 0) { /* 41$ ish */
DUMP3;
DF("Prepare for division by left-shifting the bits\n");
/* Prepare for division by left-shifting the bits */
while (((float_buf >> 63) & 1) == 0) { /* 41$ */
float_bin_exponent--; /* 40$ */
float_buf <<= 1;
DUMP3;
}
/* Divide by 2 */
float_buf >>= 1;
uint64_t float_save = float_buf;
DUMP3;
DF("float_save: %016llx\n", float_save);
/* Divide by 5:
* multiplying by (2**66 - 4) / 5 = 0xCCCCCCCCCCCCCCCC
* while dropping the 64 least significant bits.
* This is nearly exact but exact enough?
* Somehow there is another doubling in here, so the
* final result = start * 8 / 5.
*/
for (int i = 16 * 2; i > 0; i--) {
if ((i & 1) == 0) { /* 42$ */
float_buf >>= 2;
}
float_buf >>= 1; /* 43$ */
float_buf += float_save;
DF("Loop i=%2d: ", i); DUMP3;
}
#if 1
{ /* Method 3 */
uint64_t hi, lo;
mult64to128(float_save, 0x9999999999999999ULL, &hi, &lo);
/*
* Really multiply with the 65-bit number
* 0x19999999999999999
* 1 1001 1001 1001 ...
* which is 8 * 0011 0011 0011 ... aka 0x333...
* which is (2**64 - 1) / 5 aka 0xFFF... / 5.
*/
uint64_t result = hi + float_save;
if (result == float_buf) {
printf("Same 333 loop and *9999: %016llx vs %016llx\n", float_buf, result);
printf(" was : %016llx\n", float_save);
} else {
printf("Difference between 333 loop and *3333: %016llx vs %016llx\n", float_buf, result);
printf(" : %016llx %016llx\n", hi, lo);
printf(" was : %016llx\n", float_save);
}
}
#endif
#if 0 /* Try other methods to calculate the same thing more directly */
{
uint64_t result = float_save / 5 * 8;
/* Try to fill in some of the lesser significant bits */
int round = float_save % 5;
if (round) {
// If round == 2, sometimes 2 needs to be added instead,
// to match the original calculation.
result += round * 8 / 5;
} else {
// decrement to match the original calculation, but
// the end result is ok without that.
//result--;
}
# if 0
if (result == float_buf) {
printf("Same 333 loop and /5 *8: %016llx vs %016llx\n", float_buf, result);
} else {
printf("Difference between 333 loop and /5 *8: %016llx vs %016llx\n", float_buf, result);
printf(" was : %016llx %d %d\n", float_buf, float_save % 20, (float_save % 20) * 2 / 5);
}
# endif
float_buf = result;
printf("after / 5 * 8: ");
DUMP3;
}
#endif
#if 1
{
__uint128_t big = (__uint128_t)float_save << 3;
uint64_t result = big / 5;
if (float_save % 5 == 0)
result--;
if (result == float_buf) {
printf("Same 333 loop and *8 /5: %016llx vs %016llx\n", float_buf, result);
} else {
printf("Difference between 333 loop and *8 /5: %016llx vs %016llx\n", float_buf, result);
}
/*
* Rounding is slightly different, in particular for start
* values that are multiples of 5 but some other cases too.
*/
}
#endif
/* It's not simply dividing by 5, it also multiplies by 8,
* so we need to adjust the exponent here. */
float_bin_exponent -= 3;
float_dec_exponent++;
DUMP3;
}
/* Normalize the mantissa: shift a single 1 out to the left */
DF("Normalize the mantissa: shift a single 1 out to the left\n");
int carry;
do {
/* FLTG5 */
float_bin_exponent--;
carry = (float_buf >> 63) & 1;
float_buf <<= 1;
DUMP3;
} while (carry == 0);
/* Set excess 128. */
DF("Set excess 128.\n");
float_bin_exponent += 0200;
DUMP3;
if (float_bin_exponent & 0xFF00) {
/* Error N. Underflow. 2$ */
printf("Error N (underflow)\n");
return 0;
}
/* Shift right 9 positions to make room for sign and exponent 3$ */
DF("Shift right 9 positions to make room for sign and exponent\n");
int round = (float_buf >> 8) & 0x0001;
float_buf >>= 9;
float_buf |= (uint64_t)float_bin_exponent << (64-9);
DUMP3;
/*
* This rounding step seems always needed to make the result the same
* as the implementation with long doubles.
* This may be because of the slight imprecision of the divisions by 10?
* However there is something to be said for the argument that when you
* want a 1 or 2 word result, rounding twice is wrong.
* The reference implementation omits this rounding for size != 4.
*/
float_buf += round;
DF("round: size = 4, round = %d\n", round);
/* Round (there is a truncation option to omit this step) */
if (1) {
if (size < 4) {
/* 1 << 31 or 1 << 47 */
uint64_t onehalf = 1ULL << ((16 * (4-size)) - 1);
DUMP3;
DF("round: size = %d, onehalf = %016llx\n", size, onehalf);
float_buf += onehalf;
DUMP3;
/* The rounding bit is the lesser significant bit that's just
* outside the returned result. If we round, we add it to the
* returned value.
*
* If there is a carry-out of the mantissa, it gets added to
* the exponent (increasing it by 1).
*
* If that also overflows, we truely have overflow.
*/
}
DF("After rounding\n");
DUMP3;
}
if (float_buf & 0x8000000000000000ULL) {
// 6$ error T: exponent overflow
printf("Error T: exponent overflow\n");
return 0;
}
/* 7$ */
float_buf |= (uint64_t)float_sign << 63;
DF("Put in float_sign: "); DUMP3;
}
/* Now put together the result from the parts */
flt[0] = (float_buf >> 48) & 0xFFFF;
if (size > 1) {
flt[1] = (float_buf >> 32) & 0xFFFF;
if (size > 2) {
flt[2] = (float_buf >> 16) & 0xFFFF;
flt[3] = (float_buf >> 0) & 0xFFFF;
}
}
return 1;
}
void
test_one(char *input, unsigned expected0, unsigned expected1, unsigned expected2, unsigned expected3)
{
unsigned result[4];
unsigned result2[4];
printf("------------------------\n");
parse_float_m3(input, 4, result);
if (result[0] != expected0 ||
result[1] != expected1 ||
result[2] != expected2 ||
result[3] != expected3) {
printf("Unexpected result: %04x %04x %04x %04x from %s\n", result[0], result[1], result[2], result[3], input);
printf(" expected : %04x %04x %04x %04x\n", expected0, expected1, expected2, expected3);
printflt(result, 4);
}
#if 0
parse_float_m2(input, 4, result2);
if (result2[0] != expected0 ||
result2[1] != expected1 ||
result2[2] != expected2 ||
result2[3] != expected3) {
printf("Unexpected result2: %04x %04x %04x %04x from %s\n", result2[0], result2[1], result2[2], result2[3], input);
printf(" expected : %04x %04x %04x %04x\n", expected0, expected1, expected2, expected3);
printflt(result2, 4);
}
#endif
}
int
main(int argc, char **argv)
{
/* Should print 64 */
DF("LDBL_MANT_DIG: %d\n", LDBL_MANT_DIG);
test_one("100E-2", 040200, 0000000, 0000000, 0000000);
#if 1
test_one("10000000000E-10", 040200, 0000000, 0000000, 0000000);
test_one("1.0", 040200, 0000000, 0000000, 0000000);
test_one("0.1", 037314, 0146314, 0146314, 0146315);
test_one("1.0E5", 0044303, 0050000, 0000000, 0000000);
test_one("1.0E10", 0050425, 0001371, 0000000, 0000000);
test_one("1.0E20", 0060655, 0074353, 0142654, 0061000);
test_one("1.0E30", 0071111, 0171311, 0146404, 0063517);
test_one("1.0E38", 0077626, 0073231, 0050265, 0006611);
test_one("1.701411834604692307e+38", 077777, 0177777, 0177777, 0177777);
#endif
test_one("0.994140625", 0040176, 0100000, 000000, 000000);
// 407e 8000 0000 0000
#if 1
test_one("0.998046875", 0040177, 0100000, 000000, 000000);
test_one("1.00390625", 0040200, 0100000, 000000, 000000);
test_one("1.01171875", 0040201, 0100000, 000000, 000000);
test_one("0.999999910593032836914062", 0040177, 0177776, 0100000, 0000000);
test_one("0.999999970197677612304687", 0040177, 0177777, 0100000, 0000000);
test_one("1.00000005960464477539062", 0040200, 0000000, 0100000, 0000000);
test_one("1.000000178813934326171875", 0040200, 0000001, 0100000, 0000000);
test_one("1.0000000000000000138777878078144567552953958511353", 0040200, 0000000, 0000000, 0000000);
test_one("1.0000000000000000416333634234433702658861875534058", 0040200, 0000000, 0000000, 0000001);
test_one("0.99999999999999997918331828827831486705690622329712", 0040177, 0177777, 0177777, 0177776);
test_one("0.99999999999999999306110609609277162235230207443237", 0040177, 0177777, 0177777, 0177777);
//test_one("", 0, 0, 0, 0);
test_one("6.66666", 040725, 052507, 055061, 0122276);
test_one("170141183460469230846243588177825628160", 0100000, 0000000, 0000000, 0000000); // T error
test_one("170141183460469230564930741053754966016", 0077777, 0177777, 0177777, 0177777);
//test_one("3.1415926535897932384626433", 0, 0, 0, 0);
//test_one("", 0, 0, 0, 0);
//
/* First a number that should just fit in a 56 bit mantissa. */
/* 1 << 56 */
test_one("72057594037927936", 056200, 000000, 000000, 000000);
/* A bit more requires more precision, so they are rounded. */
test_one("72057594037927937", 056200, 000000, 000000, 000001);
test_one("72057594037927938", 056200, 000000, 000000, 000001);
/* Lower numbers should all be represented exactly */
test_one("72057594037927935", 056177, 0177777, 0177777, 0177777);
test_one("72057594037927934", 056177, 0177777, 0177777, 0177776);
test_one("72057594037927933", 056177, 0177777, 0177777, 0177775);
/* 1 << 57 should also be exactly representable */
test_one("144115188075855872", 056400, 000000, 000000, 000000);
/* 1 less lacks one significant bit so will be rounded up */
test_one("144115188075855871", 056400, 000000, 000000, 000000);
/* Same for 1 more, rounded down */
test_one("144115188075855873", 056400, 000000, 000000, 000000);
/* but 2 more should show up in the lsb */
/* This one seems most clearly problematic */
test_one("144115188075855874", 056400, 000000, 000000, 000001);
// Some numbers around some of the magic numbers in the parser
test_one("3681129745421959167", 0057514, 0054000, 0, 0);
test_one("3681129745421959168", 0057514, 0054000, 0, 0); // 0x3316000000000000
test_one("3681129745421959169", 0057514, 0054000, 0, 0);
test_one("3681129745421959170", 0057514, 0054000, 0, 0);
test_one("14757170078986272767", 0060114, 0146000, 0000000, 0000000);
test_one("14757170078986272768", 0060114, 0146000, 0000000, 0000000); // 0xCCCC000000000000
test_one("14757170078986272769", 0060114, 0146000, 0000000, 0000000);
test_one("14757170078986272780", 0060114, 0146000, 0000000, 0000000);
#endif
return 0;
}

250
crossassemblers/macro11/tests/test-float.lst.ok
View File

@ -97,19 +97,19 @@
82 ; V05.06
83
84 000240 040177 .word ^F 0.994140625 ; (2**9-3)/2**9 040176 040177
85 000242 040176 100000 000000 .flt4 0.994140625
85 000242 040176 100000 000000 .flt4 0.994140625 ; same-> 040176 100000 0 0
000250 000000
86
87 000252 040200 .word ^F 0.998046875 ; (2**9-1)/2**9 040177 040200
88 000254 040177 100000 000000 .flt4 0.998046875
88 000254 040177 100000 000000 .flt4 0.998046875 ; same-> 040177 100000 0 0
000262 000000
89
90 000264 040201 .word ^F 1.00390625 ; (2**8+1)/2**8 040200 040201
91 000266 040200 100000 000000 .flt4 1.00390625
91 000266 040200 100000 000000 .flt4 1.00390625 ; same-> 040200 100000 0 0
000274 000000
92
93 000276 040202 .word ^F 1.01171875 ; (2**8+3)/2**8 040201 040202
94 000300 040201 100000 000000 .flt4 1.01171875
94 000300 040201 100000 000000 .flt4 1.01171875 ; same-> 040201 100000 0 0
000306 000000
95
96 000310 077777 177777 177777 .flt4 1.701411834604692307e+38 ; 077777 177777 177777 177777
@ -121,90 +121,178 @@
99 000340 077777 177777 177777 .FLT4 170141183460469230564930741053754966016 ; 2**127-(2**70-2**64+2**62+2)
000346 177777
100
101 ; Several ways to define a name for the fpp registers
102
103 000000 ac0 = r0
104 000001 ac1 = %1
105 000002 f2 = %2
106
107 000350 171003 mulf r3,ac0
108 000352 171102 mulf r2,ac1
109 000354 172227 041040 ADDF #^O41040,F2
110 000360 172127 040200 addf #1,ac1
111
112 000364 171003 mulf r3,ac0
113 000366 171102 mulf r2,ac1
114 000370 172227 041040 addf #^O41040,F2 ; taken literally
115 000374 172127 040200 addf #1,ac1 ; as float
116 000400 172127 040200 addf #1.,ac1 ; as float
117 000404 172127 040200 addf #1.0,ac1 ; as float
118 000410 172127 000001 addf #^D1,ac1 ; literally
119 000414 173027 000001 subf #<1>,ac0 ; literally
120 000420 172127 000002 addf #<1+1>,ac1 ; literally
test-float.mac:121: ***ERROR Invalid addressing mode (1st operand, fsrc: Invalid expression after '#')
121 subf #<1.0>,ac0 ; error
122 000424 172127 040300 addf #1.5,ac1 ; as float
123 000430 172127 140263 addd #-1.4,ac1 ; as float
124 000434 173027 040200 subf #<^F 1.0>,ac0 ; as float
test-float.mac:125: ***ERROR Invalid addressing mode (1st operand, fsrc: Invalid expression after '#')
125 subf #<^D 1.0>,ac0 ; error
126 000440 173027 000001 subf #<^D 1>,ac0 ; literally
127 000444 173027 000002 subf #^D<1+1>,ac0 ; literally
128 000450 173027 000002 subf #^D 1+1 ,ac0 ; literally
129 000454 173027 042572 subf #1e3,ac0 ; as float
test-float.mac:130: ***ERROR Invalid syntax (comma expected)
130 subf #1e 3,ac0 ; TODO: accepted by MACRO11 as 1E3 (but not 1 e3, 1 e 3)
131 000001 a = 1
132 000003 e3 = 3
133 000460 173027 000001 subf #a,ac0 ; a interpreted as bit pattern
134 000464 173027 000001 subf #<a>,ac0 ; a interpreted as bit pattern
135 000470 173027 000003 subf #e3,ac0 ; e3 is the label
test-float.mac:136: ***ERROR Invalid addressing mode (1st operand, fsrc: Invalid expression after '#')
136 subf #<1e3>,ac0 ; error N
137
test-float.mac:138: ***ERROR Junk at end of line ('5 ; bad: ')
138 000474 170627 000002 absf #2.5 ; bad: operand is destination
test-float.mac:139: ***ERROR Junk at end of line ('5 ; bad: ')
139 000500 170527 000002 tstd #2.5 ; bad: operand is considered FDST by the arch handbook
test-float.mac:140: ***ERROR Junk at end of line ('5 ; bad: junk')
140 000504 174027 000002 stf ac0,#2.5 ; bad: junk at end of line
141 000510 174027 000002 stf ac0,#2 ; doesn't makes sense but MACRO11 allows it
142
143 ; Test immediate source argument for instructions that have one (src or fsrc)
144
145 000514 172027 040200 addd #1,ac0 ; float
146 000520 172027 040200 addf #1,ac0 ; float
147 000524 173427 040200 cmpd #1,ac0 ; float
148 000530 173427 040200 cmpf #1,ac0 ; float
149 000534 174427 040200 divd #1,ac0 ; float
150 000540 174427 040200 divf #1,ac0 ; float
151 000544 177427 040200 ldcdf #1,ac0 ; float
152 000550 177427 040200 ldcfd #1,ac0 ; float
153 000554 177027 000001 ldcid #1,ac0 ; integer
154 000560 177027 000001 ldcif #1,ac0 ; integer
155 000564 177027 000001 ldcld #1,ac0 ; integer
156 000570 177027 000001 ldclf #1,ac0 ; integer
157 000574 172427 040200 ldd #1,ac0 ; float
158 000600 172427 040200 ldf #1,ac0 ; float
159 000604 176427 000001 ldexp #1,ac0 ; integer
160 000610 171427 040200 modd #1,ac0 ; float
161 000614 171427 040200 modf #1,ac0 ; float
162 000620 171027 040200 muld #1,ac0 ; float
163 000624 171027 040200 mulf #1,ac0 ; float
164 000630 173027 040200 subd #1,ac0 ; float
165 000634 173027 040200 subf #1,ac0 ; float
166
167 .end
167
101 000350 040200 000000 000000 .flt4 1.0000000000000000138777878078144567552953958511353 ; 0040200 0000000 0000000 0000000
000356 000000
102 000360 040200 000000 000000 .flt4 1.0000000000000000416333634234433702658861875534058 ; 0040200 0000000 0000000 0000001
000366 000001
103 000370 040177 177777 177777 .flt4 0.99999999999999997918331828827831486705690622329712 ; 0040177 0177777 0177777 0177776
000376 177776
104 000400 040177 177777 177777 .flt4 0.99999999999999999306110609609277162235230207443237 ; 0040177 0177777 0177777 0177777
000406 177777
105
106 000410 040200 000000 000000 .flt4 100E-2 ; 040200 000000 000000 000000
000416 000000
107 000420 044303 050000 000000 .flt4 1.0E5 ; 044303 050000 000000 000000
000426 000000
108 000430 050425 001371 000000 .flt4 1.0E10 ; 050425 001371 000000 000000
000436 000000
109 000440 060655 074353 142654 .flt4 1.0E20 ; 060655 074353 142654 061000
000446 061000
110 000450 071111 171311 146404 .flt4 1.0E30 ; 071111 171311 146404 063517
000456 063517
111 000460 077626 073231 050265 .flt4 1.0E38 ; 077626 073231 050265 006611
000466 006611
112
113 000470 034047 142654 043433 .flt4 1.0E-5 ; 034047 142654 043433 043604
000476 043604
114 000500 027733 163376 147275 .flt4 1.0E-10 ; 027733 163376 147275 166726
000506 166726
115 000510 017474 162410 062222 .flt4 1.0E-20 ; 017474 162410 062222 010433
000516 010433
116 000520 007242 041137 173536 .flt4 1.0E-30 ; 007242 041137 173536 012374
000526 012374
117 000530 000531 143734 166523 .flt4 1.0E-38 ; 000531 143734 166523 143442
000536 143442
118
119 000540 057514 054000 000000 .flt4 3681129745421959167 ; 057514 054000 000000 000000
000546 000000
120 000550 057514 054000 000000 .flt4 3681129745421959168 ; 0x3316000000000000 057514 054000 000000 000000
000556 000000
121 000560 057514 054000 000000 .flt4 3681129745421959169 ; 057514 054000 000000 000000
000566 000000
122 000570 057514 054000 000000 .flt4 3681129745421959170 ; 057514 054000 000000 000000
000576 000000
123
124 000600 060114 146000 000000 .flt4 14757170078986272767 ; 060114 146000 000000 000000
000606 000000
125 000610 060114 146000 000000 .flt4 14757170078986272768 ; 0xCCCC000000000000 060114 146000 000000 000000
000616 000000
126 000620 060114 146000 000000 .flt4 14757170078986272769 ; 060114 146000 000000 000000
000626 000000
127 000630 060114 146000 000000 .flt4 14757170078986272780 ; 060114 146000 000000 000000
000636 000000
128
129 000640 040511 007732 121041 .flt4 3.1415926535897932384626433 ; 040511 007732 121041 064302
000646 064302
130
131 ; Try some possibly incomplete numbers
132
test-float.mac:133: ***ERROR Bad floating point format
133 000650 000000 000000 000000 .flt4 + ; bad
000656 000000
134 000660 040200 000000 000000 .flt4 +1 ; ok
000666 000000
test-float.mac:135: ***ERROR Bad floating point format
135 000670 000000 000000 000000 .flt4 +E1 ; bad
000676 000000
test-float.mac:136: ***ERROR Bad floating point format
136 000700 000000 000000 000000 .flt4 - ; bad
000706 000000
137 000710 140200 000000 000000 .flt4 -1 ; ok
000716 000000
138 000720 140200 000000 000000 .flt4 -1. ; ok
000726 000000
test-float.mac:139: ***ERROR Bad floating point format
139 000730 000000 000000 000000 .flt4 -1.. ; bad
000736 000000
test-float.mac:140: ***ERROR Bad floating point format
140 000740 000000 000000 000000 .flt4 -E1 ; bad
000746 000000
141 000750 000000 000000 000000 .flt4 +. ; bad
000756 000000
142 000760 000000 000000 000000 .flt4 -. ; bad
000766 000000
143 000770 000000 000000 000000 .flt4 . ; bad
000776 000000
test-float.mac:144: ***ERROR Bad floating point format
144 001000 000000 000000 000000 .flt4 .. ; bad
001006 000000
145 001010 000000 000000 000000 .flt4 .E10 ; bad
001016 000000
146
147 ; Several ways to define a name for the fpp registers
148
149 000000 ac0 = r0
150 000001 ac1 = %1
151 000002 f2 = %2
152
153 001020 171003 mulf r3,ac0
154 001022 171102 mulf r2,ac1
155 001024 172227 041040 ADDF #^O41040,F2
156 001030 172127 040200 addf #1,ac1
157
158 001034 171003 mulf r3,ac0
159 001036 171102 mulf r2,ac1
160 001040 172227 041040 addf #^O41040,F2 ; taken literally
161 001044 172127 040200 addf #1,ac1 ; as float
162 001050 172127 040200 addf #1.,ac1 ; as float
163 001054 172127 040200 addf #1.0,ac1 ; as float
164 001060 172127 000001 addf #^D1,ac1 ; literally
165 001064 173027 000001 subf #<1>,ac0 ; literally
166 001070 172127 000002 addf #<1+1>,ac1 ; literally
test-float.mac:167: ***ERROR Invalid addressing mode (1st operand, fsrc: Invalid expression after '#')
167 subf #<1.0>,ac0 ; error
168 001074 172127 040300 addf #1.5,ac1 ; as float
169 001100 172127 140263 addd #-1.4,ac1 ; as float
170 001104 173027 040200 subf #<^F 1.0>,ac0 ; as float
test-float.mac:171: ***ERROR Invalid addressing mode (1st operand, fsrc: Invalid expression after '#')
171 subf #<^D 1.0>,ac0 ; error
172 001110 173027 000001 subf #<^D 1>,ac0 ; literally
173 001114 173027 000002 subf #^D<1+1>,ac0 ; literally
174 001120 173027 000002 subf #^D 1+1 ,ac0 ; literally
175 001124 173027 042572 subf #1e3,ac0 ; as float
176 001130 173027 042572 subf #1e 3,ac0 ; accepted by MACRO11 as 1E3 (but not 1 e3, 1 e 3)
177 000001 a = 1
178 000003 e3 = 3
179 001134 173027 000001 subf #a,ac0 ; a interpreted as bit pattern
180 001140 173027 000001 subf #<a>,ac0 ; a interpreted as bit pattern
181 001144 173027 000003 subf #e3,ac0 ; e3 is the label
test-float.mac:182: ***ERROR Invalid addressing mode (1st operand, fsrc: Invalid expression after '#')
182 subf #<1e3>,ac0 ; error N
183
test-float.mac:184: ***ERROR Junk at end of line ('5 ; bad: ')
184 001150 170627 000002 absf #2.5 ; bad: operand is destination
test-float.mac:185: ***ERROR Junk at end of line ('5 ; bad: ')
185 001154 170527 000002 tstd #2.5 ; bad: operand is considered FDST by the arch handbook
test-float.mac:186: ***ERROR Junk at end of line ('5 ; bad: junk')
186 001160 174027 000002 stf ac0,#2.5 ; bad: junk at end of line
187 001164 174027 000002 stf ac0,#2 ; doesn't makes sense but MACRO11 allows it
188
189 ; Test immediate source argument for instructions that have one (src or fsrc)
190
191 001170 172027 040200 addd #1,ac0 ; float
192 001174 172027 040200 addf #1,ac0 ; float
193 001200 173427 040200 cmpd #1,ac0 ; float
194 001204 173427 040200 cmpf #1,ac0 ; float
195 001210 174427 040200 divd #1,ac0 ; float
196 001214 174427 040200 divf #1,ac0 ; float
197 001220 177427 040200 ldcdf #1,ac0 ; float
198 001224 177427 040200 ldcfd #1,ac0 ; float
199 001230 177027 000001 ldcid #1,ac0 ; integer
200 001234 177027 000001 ldcif #1,ac0 ; integer
201 001240 177027 000001 ldcld #1,ac0 ; integer
202 001244 177027 000001 ldclf #1,ac0 ; integer
203 001250 172427 040200 ldd #1,ac0 ; float
204 001254 172427 040200 ldf #1,ac0 ; float
205 001260 176427 000001 ldexp #1,ac0 ; integer
206 001264 171427 040200 modd #1,ac0 ; float
207 001270 171427 040200 modf #1,ac0 ; float
208 001274 171027 040200 muld #1,ac0 ; float
209 001300 171027 040200 mulf #1,ac0 ; float
210 001304 173027 040200 subd #1,ac0 ; float
211 001310 173027 040200 subf #1,ac0 ; float
212
213 .end
213
Symbol table
. 000640R 001 AC0 =%000000 E3 = 000003
. 001314R 001 AC0 =%000000 E3 = 000003
A = 000001 AC1 =%000001 F2 =%000002
Program sections:
. ABS. 000000 000 (RW,I,GBL,ABS,OVR,NOSAV)
000640 001 (RW,I,LCL,REL,CON,NOSAV)
001314 001 (RW,I,LCL,REL,CON,NOSAV)

56
crossassemblers/macro11/tests/test-float.mac
View File

@ -82,22 +82,68 @@
; V05.06
.word ^F 0.994140625 ; (2**9-3)/2**9 040176 040177
.flt4 0.994140625
.flt4 0.994140625 ; same-> 040176 100000 0 0
.word ^F 0.998046875 ; (2**9-1)/2**9 040177 040200
.flt4 0.998046875
.flt4 0.998046875 ; same-> 040177 100000 0 0
.word ^F 1.00390625 ; (2**8+1)/2**8 040200 040201
.flt4 1.00390625
.flt4 1.00390625 ; same-> 040200 100000 0 0
.word ^F 1.01171875 ; (2**8+3)/2**8 040201 040202
.flt4 1.01171875
.flt4 1.01171875 ; same-> 040201 100000 0 0
.flt4 1.701411834604692307e+38 ; 077777 177777 177777 177777
.FLT4 170141183460469230551095682998472802304 ; 2**127-2**70
.FLT4 170141183460469230564930741053754966015 ; 2**127-(2**70-2**64+2**62+1)
.FLT4 170141183460469230564930741053754966016 ; 2**127-(2**70-2**64+2**62+2)
.flt4 1.0000000000000000138777878078144567552953958511353 ; 0040200 0000000 0000000 0000000
.flt4 1.0000000000000000416333634234433702658861875534058 ; 0040200 0000000 0000000 0000001
.flt4 0.99999999999999997918331828827831486705690622329712 ; 0040177 0177777 0177777 0177776
.flt4 0.99999999999999999306110609609277162235230207443237 ; 0040177 0177777 0177777 0177777
.flt4 100E-2 ; 040200 000000 000000 000000
.flt4 1.0E5 ; 044303 050000 000000 000000
.flt4 1.0E10 ; 050425 001371 000000 000000
.flt4 1.0E20 ; 060655 074353 142654 061000
.flt4 1.0E30 ; 071111 171311 146404 063517
.flt4 1.0E38 ; 077626 073231 050265 006611
.flt4 1.0E-5 ; 034047 142654 043433 043604
.flt4 1.0E-10 ; 027733 163376 147275 166726
.flt4 1.0E-20 ; 017474 162410 062222 010433
.flt4 1.0E-30 ; 007242 041137 173536 012374
.flt4 1.0E-38 ; 000531 143734 166523 143442
.flt4 3681129745421959167 ; 057514 054000 000000 000000
.flt4 3681129745421959168 ; 0x3316000000000000 057514 054000 000000 000000
.flt4 3681129745421959169 ; 057514 054000 000000 000000
.flt4 3681129745421959170 ; 057514 054000 000000 000000
.flt4 14757170078986272767 ; 060114 146000 000000 000000
.flt4 14757170078986272768 ; 0xCCCC000000000000 060114 146000 000000 000000
.flt4 14757170078986272769 ; 060114 146000 000000 000000
.flt4 14757170078986272780 ; 060114 146000 000000 000000
.flt4 3.1415926535897932384626433 ; 040511 007732 121041 064302
; Try some possibly incomplete numbers
.flt4 + ; bad
.flt4 +1 ; ok
.flt4 +E1 ; bad
.flt4 - ; bad
.flt4 -1 ; ok
.flt4 -1. ; ok
.flt4 -1.. ; bad
.flt4 -E1 ; bad
.flt4 +. ; bad
.flt4 -. ; bad
.flt4 . ; bad
.flt4 .. ; bad
.flt4 .E10 ; bad
; Several ways to define a name for the fpp registers
ac0 = r0
@ -127,7 +173,7 @@ f2 = %2
subf #^D<1+1>,ac0 ; literally
subf #^D 1+1 ,ac0 ; literally
subf #1e3,ac0 ; as float
subf #1e 3,ac0 ; TODO: accepted by MACRO11 as 1E3 (but not 1 e3, 1 e 3)
subf #1e 3,ac0 ; accepted by MACRO11 as 1E3 (but not 1 e3, 1 e 3)
a = 1
e3 = 3
subf #a,ac0 ; a interpreted as bit pattern

4
crossassemblers/macro11/tests/test-listing.lst.ok
View File

@ -4,13 +4,13 @@
4 ;
5
6 ; This should get listed (list_level 1)
7 .nlist
9 .list
10 ; This should get listed (list_level 1)
11 .list
12 ; This should get listed (list_level 2)
13 .nlist
14 ; This should get listed (list_level 1)
15 .nlist
21 .list
22 ; This should get listed (list_level 1)
22

60
crossassemblers/macro11/tests/test-macro-comma.lst.ok
View File

@ -49,15 +49,69 @@
1 ; <bro<ken>
35 000000 braket <bro<ken> string
1 ; <bro<ken>
35
36
37 ;
38 ; Test that commas work with default arguments
39 ;
40 .macro tstarg a1,a2=default,a3,a4
41 .narg label ; second arg is "a2"
42 .endm
43
44 000000 start: tstarg ; 0 args
1 000000 .narg label ; second arg is "default"
45 000000 tstarg 123 ; 1 arg
1 000001 .narg label ; second arg is "default"
46 000000 tstarg 1, ; 2 args
1 000002 .narg label ; second arg is ""
47 000000 tstarg ,2 ; 2 args
1 000002 .narg label ; second arg is "2"
48 000000 tstarg , ; 2 args
1 000002 .narg label ; second arg is ""
49 000000 tstarg ,, ; 3 args
1 000003 .narg label ; second arg is "default"
50 000000 tstarg 1,, ; 3 args
1 000003 .narg label ; second arg is "default"
51 000000 tstarg ,,3 ; 3 args
1 000003 .narg label ; second arg is "default"
52 000000 tstarg 1,,3 ; 3 args
1 000003 .narg label ; second arg is "default"
53 000000 tstarg 1,2,3 ; 3 args
1 000003 .narg label ; second arg is "2"
54
55 ;
56 ; Test default args and strange commas
57 ;
58 .macro tstdef a=1,b=2
59 .word a,b
60 .endm
61
62 000000 tstdef
1 000000 000001 000002 .word 1,2
63 000004 tstdef 4,5
1 000004 000004 000005 .word 4,5
64 000010 tstdef 4,5,6 ; Excess argument is ignored
1 000010 000004 000005 .word 4,5
65 000014 tstdef b=42
1 000014 000001 000042 .word 1,42
66 000020 tstdef a=73
1 000020 000073 000002 .word 73,2
67 000024 tstdef ,b=11
1 000024 000001 000011 .word 1,11
68 000030 tstdef a=5,b=4
1 000030 000005 000004 .word 5,4
69 000034 tstdef ,a=5,b=4 ; Strange case seen in some sources
1 000034 000005 000004 .word 5,4
70 000040 tstdef a=5,a=4 ; Duplicate keyword argument -- legal!
1 000040 000004 000002 .word 4,2
70
Symbol table
. 000000R 001 LABEL = 000003 START 000000R 001
. 000044R 001 LABEL = 000003 START 000000R 001
Program sections:
. ABS. 000000 000 (RW,I,GBL,ABS,OVR,NOSAV)
000000 001 (RW,I,LCL,REL,CON,NOSAV)
000044 001 (RW,I,LCL,REL,CON,NOSAV)

35
crossassemblers/macro11/tests/test-macro-comma.mac
View File

@ -33,3 +33,38 @@ start: tstarg ; 0 args
braket ^/broken
braket <bro<ken>
braket <bro<ken> string
;
; Test that commas work with default arguments
;
.macro tstarg a1,a2=default,a3,a4
.narg label ; second arg is "a2"
.endm
start: tstarg ; 0 args
tstarg 123 ; 1 arg
tstarg 1, ; 2 args
tstarg ,2 ; 2 args
tstarg , ; 2 args
tstarg ,, ; 3 args
tstarg 1,, ; 3 args
tstarg ,,3 ; 3 args
tstarg 1,,3 ; 3 args
tstarg 1,2,3 ; 3 args
;
; Test default args and strange commas
;
.macro tstdef a=1,b=2
.word a,b
.endm
tstdef
tstdef 4,5
tstdef 4,5,6 ; Excess argument is ignored
tstdef b=42
tstdef a=73
tstdef ,b=11
tstdef a=5,b=4
tstdef ,a=5,b=4 ; Strange case seen in some sources
tstdef a=5,a=4 ; Duplicate keyword argument -- legal!

6
crossassemblers/macro11/tests/test-operands.lst.ok
View File

@ -22,16 +22,14 @@ test-operands.mac:15: ***ERROR Junk at end of line (',0 ; bad')
19 000020 104377 emt 255.
test-operands.mac:20: ***ERROR Literal operand too large (256. > 255.)
20 000022 104377 emt 256. ; too large
test-operands.mac:21: ***ERROR Instruction requires simple literal operand
21 000024 104000 emt . ; must be literal
21 000024 024' 210 emt . ; allowed though strange
22
23 000026 104400 trap 0
24 000030 104401 trap 1
25 000032 104777 trap 255.
test-operands.mac:26: ***ERROR Literal operand too large (256. > 255.)
26 000034 104777 trap 256. ; too large
test-operands.mac:27: ***ERROR Instruction requires simple literal operand
27 000036 104400 trap . ; must be literal
27 000036 036' 211 trap . ; allowed though strange
28
29 ; OC_1GEN
30

4
crossassemblers/macro11/tests/test-operands.mac
View File

@ -18,13 +18,13 @@
emt 1
emt 255.
emt 256. ; too large
emt . ; must be literal
emt . ; allowed though strange
trap 0
trap 1
trap 255.
trap 256. ; too large
trap . ; must be literal
trap . ; allowed though strange
; OC_1GEN

38
crossassemblers/macro11/tests/test-radix.lst.ok Normal file
View File

@ -0,0 +1,38 @@
1 ;;;;;
2 ;
3 ; Test .radix directive
4 ;
5 000010 .RADIX 8
6 000000 000010 .WORD 10
7 000012 .RADIX 10
8 000002 000012 .WORD 10
9 .RADIX ;Default is 8
10 000004 000010 .WORD 10
11 000002 .RADIX 2
12 000006 000002 .WORD 10
13 000020 .RADIX 16
14 000010 000020 .WORD 10
15 ; Odd but valid
16 000010 .RADIX ^O10 ;Octal 10, i.e., 8
17 000012 000010 .WORD 10
18 000012 .RADIX 5+5
19 000014 000012 .WORD 10
20 ; Errors
test-radix.mac:21: ***ERROR Argument to .RADIX must be 2, 8, 10, or 16
21 000007 .RADIX 7
22 000016 000012 .WORD 10 ;Radix is unchanged after error
test-radix.mac:23: ***ERROR Argument to .RADIX must be constant
23 .RADIX .
24 000020 000012 .WORD 10
24
Symbol table
. 000022R 001
Program sections:
. ABS. 000000 000 (RW,I,GBL,ABS,OVR,NOSAV)
000022 001 (RW,I,LCL,REL,CON,NOSAV)

24
crossassemblers/macro11/tests/test-radix.mac Normal file
View File

@ -0,0 +1,24 @@
;;;;;
;
; Test .radix directive
;
.RADIX 8
.WORD 10
.RADIX 10
.WORD 10
.RADIX ;Default is 8
.WORD 10
.RADIX 2
.WORD 10
.RADIX 16
.WORD 10
; Odd but valid
.RADIX ^O10 ;Octal 10, i.e., 8
.WORD 10
.RADIX 5+5
.WORD 10
; Errors
.RADIX 7
.WORD 10 ;Radix is unchanged after error
.RADIX .
.WORD 10

64
crossassemblers/macro11/tests/test-syntax.lst.ok Normal file
View File

@ -0,0 +1,64 @@
1 ;;;;
2 ;
3 ; Test some aspects of syntax.
4 ;
5 ; Reference MACRO11 does very weird things with these errors.
6 ; Fortunately I don't plan to produce exactly the same results in case of errors.
7 ; It seems to recognise an operand where there is none (or none yet)...
8 ;
9 ; AQ 37 000022 012767 000004 177772 mov #4..,r0
10 ; AQ 38 000030 012767 000011 177772 mov #9..,r0
11 ; AQ 39 000036 012767 000004 000000G mov #4.$,r0
12 ; AQU 40 000044 012767 000000 177772 mov #4$.,r0
13 ; 41
14 ; A 42 000052 012767 000004 177772 mov #4..
15 ; A 43 000060 012767 000004 000000G mov #4.$
16 ; AU 44 000066 012767 000000 177772 mov #4$.
17
test-syntax.mac:18: ***ERROR Invalid syntax (comma expected)
18 mov #4..,r0 ; bad syntax
test-syntax.mac:19: ***ERROR Invalid syntax (comma expected)
19 mov #4$.,r0 ; bad syntax
test-syntax.mac:20: ***ERROR Invalid syntax (comma expected)
20 mov #4.$,r0 ; bad syntax
test-syntax.mac:21: ***ERROR Invalid syntax (comma expected)
21 mov #4$$,r0 ; bad syntax
22
test-syntax.mac:23: ***ERROR Invalid syntax (comma expected)
23 mov #4.. ; bad syntax
test-syntax.mac:24: ***ERROR Invalid syntax (comma expected)
24 mov #4$. ; bad syntax
test-syntax.mac:25: ***ERROR Invalid syntax (comma expected)
25 mov #4.$ ; bad syntax
test-syntax.mac:26: ***ERROR Invalid syntax (comma expected)
26 mov #4$$ ; bad syntax
27
28 ;; page 2-4:
29 ;; Multiple expressions used in the operand field of a MACRO-11 statement
30 ;; must be separated by a comma;
31 ;; multiple symbols similarly must be delimited by a valid separator
32 ;; (a comma, tab, and/or space).
33 ;; When the operator field contains an op code, associated operands are
34 ;; always expressions, ...
35
36 000001 a=1
test-syntax.mac:37: ***ERROR Invalid syntax (comma expected)
37 mov #4 r0
test-syntax.mac:38: ***ERROR Invalid syntax (comma expected)
38 mov a r0
39
40 ;; page 2-3:
41 ;; An operator is terminated by a space, tab, or any non-Radix-50 character,
42 000000 017700 000001' mov@a,r0
42
Symbol table
. 000004R 001 A = 000001
Program sections:
. ABS. 000000 000 (RW,I,GBL,ABS,OVR,NOSAV)
000004 001 (RW,I,LCL,REL,CON,NOSAV)

42
crossassemblers/macro11/tests/test-syntax.mac Normal file
View File

@ -0,0 +1,42 @@
;;;;
;
; Test some aspects of syntax.
;
; Reference MACRO11 does very weird things with these errors.
; Fortunately I don't plan to produce exactly the same results in case of errors.
; It seems to recognise an operand where there is none (or none yet)...
;
; AQ 37 000022 012767 000004 177772 mov #4..,r0
; AQ 38 000030 012767 000011 177772 mov #9..,r0
; AQ 39 000036 012767 000004 000000G mov #4.$,r0
; AQU 40 000044 012767 000000 177772 mov #4$.,r0
; 41
; A 42 000052 012767 000004 177772 mov #4..
; A 43 000060 012767 000004 000000G mov #4.$
; AU 44 000066 012767 000000 177772 mov #4$.
mov #4..,r0 ; bad syntax
mov #4$.,r0 ; bad syntax
mov #4.$,r0 ; bad syntax
mov #4$$,r0 ; bad syntax
mov #4.. ; bad syntax
mov #4$. ; bad syntax
mov #4.$ ; bad syntax
mov #4$$ ; bad syntax
;; page 2-4:
;; Multiple expressions used in the operand field of a MACRO-11 statement
;; must be separated by a comma;
;; multiple symbols similarly must be delimited by a valid separator
;; (a comma, tab, and/or space).
;; When the operator field contains an op code, associated operands are
;; always expressions, ...
a=1
mov #4 r0
mov a r0
;; page 2-3:
;; An operator is terminated by a space, tab, or any non-Radix-50 character,
mov@a,r0

18
crossassemblers/macro11/util.c
View File

@ -314,3 +314,21 @@ void padto(
*str++ = ' ', needspace--;
*str = 0;
}
/* defext adds the supplied extension to the file name if it doesn't
already have one. "ext" is the desired extension, without the
period. The file name must be in a malloc'ed buffer. The
resulting string address is returned. */
char *defext (char *fn, const char *ext)
{
char *ret;
if (strchr (fn, '.'))
return fn;
ret = realloc (fn, strlen (fn) + strlen (ext) + 2);
if (ret == NULL)
return ret;
strcat (ret, ".");
strcat (ret, ext);
return ret;
}

1
crossassemblers/macro11/util.h
View File

@ -87,5 +87,6 @@ void padto(
void *memcheck(
void *ptr);
char *defext (char *fn, const char *ext);
#endif /* UTIL__H */