Initial revision

modules/src/read_em/EM_vars.c

@@ -0,0 +1,7 @@
+/* $Header$ */
+
+/* Variables must be declared somewhere ... */
+
+char	*EM_error;
+char	*EM_filename;
+unsigned int EM_lineno;

modules/src/read_em/Makefile

@@ -0,0 +1,86 @@
+EMHOME = ../../..
+MODULES = $(EMHOME)/modules
+HDIR =	$(MODULES)/h
+EMHDIR = $(EMHOME)/h
+INCLUDES = -I$(HDIR) -I$(EMHDIR)
+CFLAGS = -O $(INCLUDES) -DPRIVATE=static -DEXPORT=
+INSTALL = $(MODULES)/install
+COMPARE = $(MODULES)/compare
+
+TARGETS =	libread_emk.a\
+		libread_emkV.a\
+		libread_emeV.a
+
+SRCFILES =	em_comp.h\
+		read_em.c\
+		reade.c\
+		readk.c\
+		mkcalls.c\
+		EM_vars.c
+
+EV_OFILES =	read_emeV.o makecallsV.o EM_vars.o
+KV_OFILES = 	read_emkV.o makecallsV.o EM_vars.o
+K_OFILES =	read_emk.o makecalls.o EM_vars.o
+
+all:		$(TARGETS)
+
+install:	all
+		$(INSTALL) h/em_comp.h
+		$(INSTALL) lib/libread_emk.a
+		$(INSTALL) lib/libread_emkV.a
+		$(INSTALL) lib/libread_emeV.a
+		$(INSTALL) man/read_em.3
+
+cmp:		all
+		$(COMPARE) h/em_comp.h
+		$(COMPARE) lib/libread_emk.a
+		$(COMPARE) lib/libread_emkV.a
+		$(COMPARE) lib/libread_emeV.a
+		$(COMPARE) man/read_em.3
+
+pr:
+		@pr Makefile m_C_mnem m_C_mnem_na argtype $(SRCFILES)
+
+opr:
+		make pr | opr
+
+clean:
+		rm -f *.o *.a C_mnem C_mnem_narg
+
+libread_emk.a:	$(K_OFILES)
+		ar r libread_emk.a $(K_OFILES)
+		-sh -c 'ranlib libread_emk.a'
+
+libread_emkV.a:	$(KV_OFILES)
+		ar r libread_emkV.a $(KV_OFILES)
+		-sh -c 'ranlib libread_emkV.a'
+
+libread_emeV.a:	$(EV_OFILES)
+		ar r libread_emeV.a $(EV_OFILES)
+		-sh -c 'ranlib libread_emeV.a'
+
+read_emk.o:	read_em.c em_comp.h readk.c
+		$(CC) -c $(CFLAGS) -DCOMPACT read_em.c
+		mv read_em.o read_emk.o
+
+read_emkV.o:	read_em.c em_comp.h readk.c
+		$(CC) -c $(CFLAGS) -DCOMPACT -DCHECKING read_em.c
+		mv read_em.o read_emkV.o
+
+read_emeV.o:	read_em.c em_comp.h reade.c
+		$(CC) -c $(CFLAGS) -DCHECKING read_em.c
+		mv read_em.o read_emeV.o
+
+makecalls.o:	C_mnem C_mnem_narg em_comp.h mkcalls.c
+		$(CC) -c $(CFLAGS) mkcalls.c
+		mv mkcalls.o makecalls.o
+
+makecallsV.o:	C_mnem C_mnem_narg em_comp.h mkcalls.c
+		$(CC) -c $(CFLAGS) -DCHECKING mkcalls.c
+		mv mkcalls.o makecallsV.o
+
+C_mnem:		m_C_mnem argtype
+		sh m_C_mnem > C_mnem
+
+C_mnem_narg:	m_C_mnem_na argtype
+		sh m_C_mnem_na > C_mnem_narg

modules/src/read_em/argtype

@@ -0,0 +1,14 @@
+: argtype lists all em mnemonics that have an argument type equal to
+: one of the letters specified in the argument
+case x$# in
+	x2)	
+		;;
+	x*)	echo "Usage: $0 argtypes <em_table>" 1>&2
+		exit 1
+		;;
+esac
+ed - $2 << A
+1,/^\$/d
+1,/^\$/d
+1,/^\$/g/^\(...\)	[$1].*/s//\\1/gp
+A

modules/src/read_em/em_comp.h

@@ -0,0 +1,64 @@
+/* $Header$ */
+
+struct e_instr {
+	int	em_type;		/* Type of this instr */
+#define EM_MNEM		256		/* A machine instruction */
+#define	EM_PSEU		257		/* A pseudo */
+#define EM_STARTMES	258		/* Start of a MES pseudo */
+#define EM_MESARG	259		/* A member in a MES list */
+#define EM_ENDMES	260		/* End of a MES pseudo */
+#define EM_DEFILB	261		/* An instruction label definition */
+#define EM_DEFDLB	262		/* A numeric data label definition */
+#define EM_DEFDNAM	263		/* A non-numeric data label def */
+#define EM_ERROR	264		/* Recoverable error */
+#define EM_FATAL	265		/* Unrecoverable error */
+	union {
+	      struct {
+	           int	emus_opcode;	/* Opcode of instruction */
+	           struct e_args *emus_args;	/* Arguments of instruction */
+	      } emu_mp;
+	      label	emu_deflb;	/* Numeric label definition */
+	      char	*emu_defdnam;	/* Non-numeric label definition */
+	      struct e_args	*emu_arg;	/* For an argument */
+	} em_i; 
+#define em_opcode	em_i.emu_mp.emus_opcode
+#define em_args		em_i.emu_mp.emus_args
+#define em_deflb	em_i.emu_deflb
+#define em_defdnam	em_i.emu_defdnam
+#define em_arg		em_i.emu_arg
+};
+
+struct e_args {
+	struct e_args	*em_next;	/* Next argument */
+	short	em_argtype;		/* Type of this argument */
+	union {
+	       arith	emu_cst;		/* A constant */
+	       label	emu_ilb;		/* An instruction label */
+	       char	*emu_pnam;	/* A procedure name (not including '$') */
+	       struct {
+	              label	emus_dlb;
+	              arith	emus_noff;
+	       } emu_ndlb;		/* Numeric data label + offset */
+	       struct {
+	              char	*emus_dnam;
+	              arith	emus_soff;
+	       } emu_sdlb;		/* String data label + offset */
+	       struct {
+	              char	*emus_str;
+	              arith	emus_size;
+	       } emu_con;			/* An scon, icon, ucon or fcon */
+	} em_value;
+#define em_cst		em_value.emu_cst
+#define em_ilb		em_value.emu_ilb
+#define em_pnam		em_value.emu_pnam
+#define em_dlb		em_value.emu_ndlb.emus_dlb
+#define em_noff		em_value.emu_ndlb.emus_noff
+#define em_dnam		em_value.emu_sdlb.emus_dnam
+#define em_soff		em_value.emu_sdlb.emus_soff
+#define em_str		em_value.emu_con.emus_str
+#define em_size		em_value.emu_con.emus_size
+};
+
+extern char *EM_error;
+extern unsigned int EM_lineno;
+extern char *EM_filename;

modules/src/read_em/m_C_mnem

@@ -0,0 +1,91 @@
+EM_TABLE=../../../etc/em_table
+echo "switch(opcode) {"
+for i in - cdflnorswz p b
+do
+	list=`./argtype $i $EM_TABLE`
+	case $i in
+	-)	args='()'
+		echo "/* no arguments */"
+		;;
+	cdflnorswz)
+		args='(arg->em_cst)'
+		echo "/* one integer constant argument */"
+		;;
+	p)
+		args='(arg->em_pnam)'
+		echo "/* a procedure name argument */"
+		;;
+	b)
+
+: Grumbl, an instruction label as argument is encoded in a sp_cst2
+
+		args='((label) (arg->em_cst))'
+		echo "/* An instruction label argument */"
+		;;
+	esac
+	for i in $list
+	do
+		cat << EOF
+	case op_$i:
+		C_$i$args;
+		break;
+EOF
+	done
+done
+list=`./argtype g $EM_TABLE`
+cat << 'EOF'
+	default:
+/* a "g" argument */
+		if (arg->em_argtype == nof_ptyp) {
+			switch(opcode) {
+				default:
+					EM_error = "Illegal mnemonic";
+					break;
+EOF
+for i in $list
+do
+	cat << EOF
+				case op_$i:
+					C_${i}_dlb(arg->em_dlb, arg->em_noff);
+					break;
+EOF
+done
+cat << 'EOF'
+			}
+		}
+		else if (arg->em_argtype == sof_ptyp) {
+			switch(opcode) {
+				default:
+					EM_error = "Illegal mnemonic";
+					break;
+EOF
+for i in $list
+do
+	cat << EOF
+				case op_$i:
+					C_${i}_dnam(arg->em_dnam, arg->em_soff);
+					break;
+EOF
+done
+cat << 'EOF'
+			}
+		}
+		else /*argtype == cst_ptyp */ {
+			switch(opcode) {
+				default:
+					EM_error = "Illegal mnemonic";
+					break;
+EOF
+for i in $list
+do
+	cat << EOF
+				case op_$i:
+					C_$i(arg->em_cst);
+					break;
+EOF
+done
+cat << 'EOF'
+			}
+		}
+}
+EOF

modules/src/read_em/m_C_mnem_na

@@ -0,0 +1,15 @@
+EM_TABLE=../../../etc/em_table
+list=`./argtype w $EM_TABLE`
+echo "switch(opcode) {"
+for i in $list
+do
+	cat << EOF
+	case op_$i:
+		C_${i}_narg();
+		break;
+EOF
+done
+cat << EOF
+	default: EM_error = "Illegal mnemonic";
+}
+EOF

modules/src/read_em/mkcalls.c

@@ -0,0 +1,467 @@
+/*	makecalls: expand a datastructure as delivered by "EM_getline"
+	into calls to the procedural interface.
+	Exported routine:
+		EM_mkcalls
+*/
+
+#include <em_spec.h>
+#include <em_mnem.h>
+#include <em_pseu.h>
+#include <em_flag.h>
+#include "em_ptyp.h"
+#include <em.h>
+#include "em_comp.h"
+#include <assert.h>
+
+extern char em_flag[];	/* One per EM instruction: indicates parameter kind */
+extern short em_ptyp[];	/* One per parameter kind: indicates parameter type */
+
+static int listtype = 0;	/* indicates pseudo when generating code for
+				   variable length argument lists
+				   (only for MES)
+				*/
+
+#ifdef CHECKING
+/*	c_getarg: Check the argument indicated by "args".
+	The argument must be of a type allowed by "typset".
+	Return a pointer to the next argument.
+*/
+PRIVATE struct e_args *
+c_getarg(args, typset)
+	register struct e_args *args;
+{
+
+	if (((!typset) && args) ||
+	    ((!args) && typset)) {
+		/* End of arguments expected, but there are more, or
+		   an argument expected, but there is none
+		*/
+		EM_error = "Illegal number of parameters";
+		return 0;
+	}
+
+	if (!args) return 0;
+	if (!(args->em_argtype & typset)) {
+		/* Type error */
+		EM_error = "Illegal parameter type";
+	}
+
+	return args->em_next;
+}
+#else not CHECKING
+#define c_getarg(arg, x)	((arg) ? (arg)->em_next : (arg))
+#endif CHECKING
+
+/*	EM_doinstr: An EM instruction
+*/
+PRIVATE
+EM_doinstr(opcode, arg)
+	register struct e_args *arg;
+{
+	register int parametertype;	/* parametertype of the instruction */
+	register struct e_args *args;
+
+	parametertype = em_flag[opcode-sp_fmnem] & EM_PAR;
+#ifdef CHECKING
+	if (parametertype != PAR_NO && parametertype != PAR_W) {
+		if (!arg) {
+			EM_error = "Illegal number of parameters";
+			return;
+		}
+	}
+#endif CHECKING
+	switch(parametertype) {
+		case PAR_NO:
+			break;
+		default:
+			args = c_getarg(arg, em_ptyp[parametertype]);
+			args = c_getarg(args, 0);
+			break;
+		case PAR_W:
+			if (arg) {
+				args = c_getarg(arg, cst_ptyp);
+				args = c_getarg(args, 0);
+			}
+			else {
+#include "C_mnem_narg"
+				return;
+			}
+			break;
+	}
+#include "C_mnem"
+}
+
+PRIVATE
+EM_dopseudo(opcode, args)
+	register struct e_args *args;
+{
+	register struct e_args *arg;
+
+	switch(opcode) {
+		case ps_exc: {
+			register struct e_args *args2;
+
+			arg = c_getarg(args, cst_ptyp);
+			args2 = c_getarg(arg, cst_ptyp);
+			args2 = c_getarg(args2, 0);
+			C_exc(args->em_cst, arg->em_cst);
+			break;
+		}
+		case ps_hol: {
+			register struct e_args *args2, *args3;
+
+			arg = c_getarg(args, cst_ptyp);
+			args2 = c_getarg(arg, arg_ptyp);
+			args3 = c_getarg(args2, cst_ptyp);
+			args3 = c_getarg(args3, 0);
+			switch(arg->em_argtype) {
+			    case cst_ptyp:
+				C_hol_cst(args->em_cst,
+					  arg->em_cst,
+					  args2->em_cst);
+				break;
+			    case ico_ptyp:
+				C_hol_icon(args->em_cst,
+					   arg->em_str,
+					   arg->em_size, 
+					   args2->em_cst);
+				break;
+			    case uco_ptyp:
+				C_hol_ucon(args->em_cst,
+					   arg->em_str,
+					   arg->em_size,
+					   args2->em_cst);
+				break;
+			    case fco_ptyp:
+				C_hol_fcon(args->em_cst,
+					   arg->em_str,
+					   arg->em_size, 
+					   args2->em_cst);
+				break;
+			    case sof_ptyp:
+				C_hol_dnam(args->em_cst,
+					   arg->em_dnam,
+					   arg->em_soff, 
+					   args2->em_cst);
+				break;
+			    case nof_ptyp:
+				C_hol_dlb(args->em_cst,
+					  arg->em_dlb,
+					  arg->em_noff, 
+					  args2->em_cst);
+				break;
+			    case ilb_ptyp:
+				C_hol_ilb(args->em_cst,
+					  arg->em_ilb, 
+					  args2->em_cst);
+				break;
+			    case pro_ptyp:
+				C_hol_pnam(args->em_cst, 
+					   arg->em_pnam, 
+					   args2->em_cst);
+				break;
+			    default:
+				EM_error = "Illegal parameter type";
+				break;
+			}
+			break;
+		}
+		case ps_bss: {
+			register struct e_args *args2, *args3;
+
+			arg = c_getarg(args, cst_ptyp);
+			args2 = c_getarg(arg, arg_ptyp);
+			args3 = c_getarg(args2, cst_ptyp);
+			args3 = c_getarg(args3, 0);
+			switch(arg->em_argtype) {
+			    case cst_ptyp:
+				C_bss_cst(args->em_cst,
+					  arg->em_cst,
+					  args2->em_cst);
+				break;
+			    case ico_ptyp:
+				C_bss_icon(args->em_cst,
+					   arg->em_str,
+					   arg->em_size, 
+					   args2->em_cst);
+				break;
+			    case uco_ptyp:
+				C_bss_ucon(args->em_cst,
+					   arg->em_str,
+					   arg->em_size,
+					   args2->em_cst);
+				break;
+			    case fco_ptyp:
+				C_bss_fcon(args->em_cst,
+					   arg->em_str,
+					   arg->em_size, 
+					   args2->em_cst);
+				break;
+			    case sof_ptyp:
+				C_bss_dnam(args->em_cst,
+					   arg->em_dnam,
+					   arg->em_soff, 
+					   args2->em_cst);
+				break;
+			    case nof_ptyp:
+				C_bss_dlb(args->em_cst,
+					  arg->em_dlb,
+					  arg->em_noff, 
+					  args2->em_cst);
+				break;
+			    case ilb_ptyp:
+				C_bss_ilb(args->em_cst,
+					  arg->em_ilb, 
+					  args2->em_cst);
+				break;
+			    case pro_ptyp:
+				C_bss_pnam(args->em_cst, 
+					   arg->em_pnam, 
+					   args2->em_cst);
+				break;
+			    default:
+				EM_error = "Illegal parameter type";
+				break;
+			}
+			break;
+		}
+		case ps_end:
+			if (args) {
+				arg = c_getarg(args, cst_ptyp);
+				arg = c_getarg(arg, 0);
+				C_end(args->em_cst);
+				break;
+			}
+			C_end_narg();
+			break;
+		case ps_exa:
+		case ps_ina:
+			arg = c_getarg(args, lab_ptyp);
+			arg = c_getarg(arg, 0);
+			if (args->em_argtype == nof_ptyp) {
+				if (opcode == ps_exa) {
+					C_exa_dlb(args->em_dlb);
+				}
+				else	C_ina_dlb(args->em_dlb);
+				break;
+			}
+			if (opcode == ps_exa) {
+				C_exa_dnam(args->em_dnam);
+			}
+			else	C_ina_dnam(args->em_dnam);
+			break;
+		case ps_exp:
+		case ps_inp:
+			arg = c_getarg(args, pro_ptyp);
+			arg = c_getarg(arg, 0);
+			if (opcode == ps_exp) {
+				C_exp(args->em_pnam);
+			}
+			else	C_inp(args->em_pnam);
+			break;
+		case ps_pro:
+			arg = c_getarg(args, pro_ptyp);
+			if (arg) {
+				struct e_args *args2;
+
+				args2 = c_getarg(arg, cst_ptyp);
+				args2 = c_getarg(args2, 0);
+				C_pro(args->em_pnam, arg->em_cst);
+			}
+			else	C_pro_narg(args->em_pnam);
+			break;
+		case ps_con:
+			arg = c_getarg(args, val_ptyp);
+			arg = c_getarg(arg, 0);
+			switch(args->em_argtype) {
+				case ilb_ptyp:
+					C_con_ilb(args->em_ilb);
+					break;
+				case nof_ptyp:
+					C_con_dlb(args->em_dlb, args->em_noff);
+					break;
+				case sof_ptyp:
+					C_con_dnam(args->em_dnam, args->em_soff);
+					break;
+				case cst_ptyp:
+					C_con_cst(args->em_cst);
+					break;
+				case pro_ptyp:
+					C_con_pnam(args->em_pnam);
+					break;
+				case str_ptyp:
+					C_con_scon(args->em_str, args->em_size);
+					break;
+				case ico_ptyp:
+					C_con_icon(args->em_str, args->em_size);
+					break;
+				case uco_ptyp:
+					C_con_ucon(args->em_str, args->em_size);
+					break;
+				case fco_ptyp:
+					C_con_fcon(args->em_str, args->em_size);
+					break;
+				default:
+					EM_error = "Illegal argument type";
+					return 0;
+			}
+			break;
+		case ps_rom:
+			arg = c_getarg(args, val_ptyp);
+			arg = c_getarg(arg, 0);
+			switch(args->em_argtype) {
+				case ilb_ptyp:
+					C_rom_ilb(args->em_ilb);
+					break;
+				case nof_ptyp:
+					C_rom_dlb(args->em_dlb, args->em_noff);
+					break;
+				case sof_ptyp:
+					C_rom_dnam(args->em_dnam, args->em_soff);
+					break;
+				case cst_ptyp:
+					C_rom_cst(args->em_cst);
+					break;
+				case pro_ptyp:
+					C_rom_pnam(args->em_pnam);
+					break;
+				case str_ptyp:
+					C_rom_scon(args->em_str, args->em_size);
+					break;
+				case ico_ptyp:
+					C_rom_icon(args->em_str, args->em_size);
+					break;
+				case uco_ptyp:
+					C_rom_ucon(args->em_str, args->em_size);
+					break;
+				case fco_ptyp:
+					C_rom_fcon(args->em_str, args->em_size);
+					break;
+				default:
+					EM_error = "Illegal argument type";
+					return 0;
+			}
+			break;
+		default: 
+			EM_error = "Illegal pseudo instruction";
+			break;
+	}
+}
+
+PRIVATE
+EM_docon(args)
+	register struct e_args *args;
+{
+	register struct e_args *arg;
+
+	arg = c_getarg(args, val_ptyp);
+	arg = c_getarg(arg, 0);
+	switch(args->em_argtype) {
+		case ilb_ptyp:
+			C_ilb(args->em_ilb);
+			break;
+		case nof_ptyp:
+			C_dlb(args->em_dlb, args->em_noff);
+			break;
+		case sof_ptyp:
+			C_dnam(args->em_dnam, args->em_soff);
+			break;
+		case cst_ptyp:
+			C_cst(args->em_cst);
+			break;
+		case pro_ptyp:
+			C_pnam(args->em_pnam);
+			break;
+		case str_ptyp:
+			C_scon(args->em_str, args->em_size);
+			break;
+		case ico_ptyp:
+			C_icon(args->em_str, args->em_size);
+			break;
+		case uco_ptyp:
+			C_ucon(args->em_str, args->em_size);
+			break;
+		case fco_ptyp:
+			C_fcon(args->em_str, args->em_size);
+			break;
+		default:
+			EM_error = "Illegal argument type";
+			break;
+	}
+}
+
+PRIVATE
+EM_dostartmes(args)
+	register struct e_args *args;
+{
+	register struct e_args *arg;
+
+	if (listtype) {
+		EM_error = "Message not ended";
+		return;
+	}
+	arg = c_getarg(args, cst_ptyp);
+	arg = c_getarg(arg, 0);
+	C_mes_begin(args->em_cst);
+	listtype = ps_mes;
+}
+
+EXPORT int
+EM_mkcalls(line)
+	register struct e_instr *line;
+{
+
+#ifdef CHECKING
+	if (listtype && line->em_type != EM_MESARG && line->em_type != EM_ENDMES) {
+		EM_error = "Message not ended";
+		return 0;
+	}
+#endif CHECKING
+	EM_error = 0;
+	switch(line->em_type) {
+		default:
+			EM_error = "Illegal EM line";
+			break;
+		case EM_MNEM:
+			/* normal instruction */
+			EM_doinstr(line->em_opcode, line->em_args);
+			break;
+		case EM_DEFILB:
+			/* defining occurrence of an instruction label */
+			C_df_ilb(line->em_deflb);
+			break;
+		case EM_DEFDLB:
+			/* defining occurrence of a global data label */
+			C_df_dlb(line->em_deflb);
+			break;
+		case EM_DEFDNAM:
+			/* defining occurrence of a non-numeric data label */
+			C_df_dnam(line->em_defdnam);
+			break;
+		case EM_PSEU:
+			/* pseudo */
+			EM_dopseudo(line->em_opcode, line->em_args);
+			break;
+		case EM_STARTMES:
+			/* start of a MES pseudo */
+			EM_dostartmes(line->em_arg);
+			break;
+		case EM_MESARG:
+		case EM_ENDMES:
+#ifdef CHECKING
+			if (!listtype) {
+				EM_error = "Message not started";
+				return 0;
+			}
+#endif
+			if (line->em_type == EM_MESARG) {
+				EM_docon(line->em_args);
+				break;
+			}
+			C_mes_end();
+			listtype = 0;
+			break;
+	}
+	if (EM_error) return 0;
+	return 1;
+}

modules/src/read_em/read_em.3

@@ -0,0 +1,281 @@
+.TH READ_EM 3ACK "March 17, 1986"
+.SH NAME
+EM_open, EM_getinstr, EM_close,
+EM_mkcalls\ \-\ a module to read EM assembly code
+.SH SYNOPSIS
+.B #include <em_spec.h>
+.br
+.B #include <em_mnem.h>
+.br
+.B #include <em_pseu.h>
+.br
+.B #include <em_flag.h>
+.br
+.B #include <em_ptyp.h>
+.br
+.B #include <em.h>
+.br
+.B #include <em_comp.h>
+.PP
+.B int EM_open(filename)
+.br
+.B EM_close()
+.br
+.B char *filename;
+.PP
+.B struct e_instr *EM_getinstr()
+.PP
+.B int EM_mkcalls(instr)
+.br
+.B struct e_instr *instr;
+.PP
+.B char *EM_error;
+.PP
+.B unsigned int EM_lineno;
+.PP
+.B char *EM_filename;
+.SH DESCRIPTION
+This package provides routines to read EM assembly code.
+The object is to simplify the program
+writer's task of reading EM assembly code,
+either in compact or human-readable form.
+.PP
+\fIEM_open\fR must be called as initializer of the package.
+If \fIfilename\fR is a null pointer, reading is done from standard input,
+otherwise it is done from the file \fIfilename\fR.
+\fIEM_open\fR returns 1 on success and 0 on failure
+with an error message in \fIEM_error\fR.
+\fIEM_close\fR must be called after all other calls to this package.
+.PP
+\fIEM_getinstr\fR reads an EM instruction, and
+returns it as a pointer to a structure having the following
+layout:
+.br
+.PP
+.ta \w'struct'u +\w'struct e_instr *\ \ \ \ \ \ \ \ \ 'u +\w'em_argtype\ \ \ \ \ \ 'u
+.nf
+struct e_instr {
+	int	em_type;	/* Type of this instruction */
+	union {
+	      struct {
+	           int	emus_opcode;	/* Opcode of instruction */
+	           struct e_args	*emus_args;	/* Arguments of instruction */
+	      } emu_mp;
+	      label	emu_deflb;	/* Numeric label definition */
+	      char	*emu_defdnam;	/* Non-numeric label definition */
+	      struct e_args	*emu_arg;	/* For a message argument */
+	} em_i; 
+#define em_opcode    \kaem_i.emu_mp.emus_opcode
+#define em_args\h'|\nau'em_i.emu_mp.emus_args
+#define em_deflb\h'|\nau'em_i.emu_deflb
+#define em_defdnam\h'|\nau'em_i.emu_defdnam
+#define em_arg\h'|\nau'em_i.emu_arg
+};
+.fi
+.PP
+Possible arguments to the EM instruction read are supplied in a linked list
+of structures:
+.PP
+.nf
+struct e_args {
+	struct e_args	*em_next;	/* Next argument */
+	short	em_argtype;	/* Type of this argument */
+	union {
+	       arith	emu_cst;	/* A constant */
+	       label	emu_ilb;	/* An instruction label */
+	       char	*emu_pnam;	/* A procedure name (not including '$') */
+	       struct {
+	              label	emus_dlb;
+	              arith	emus_noff;
+	       } emu_ndlb;		/* Numeric data label + offset */
+	       struct {
+	              char	*emus_dnam;
+	              arith	emus_soff;
+	       } emu_sdlb;		/* String data label + offset */
+	       struct {
+	              char	*emus_str;
+	              arith	emus_size;
+	       } emu_con;		/* An scon, icon, ucon or fcon */
+	} em_value;
+#define em_cst\h'|\nau'em_value.emu_cst
+#define em_ilb\h'|\nau'em_value.emu_ilb
+#define em_pnam\h'|\nau'em_value.emu_pnam
+#define em_dlb\h'|\nau'em_value.emu_ndlb.emus_dlb
+#define em_noff\h'|\nau'em_value.emu_ndlb.emus_noff
+#define em_dnam\h'|\nau'em_value.emu_sdlb.emus_dnam
+#define em_soff\h'|\nau'em_value.emu_sdlb.emus_soff
+#define em_str\h'|\nau'em_value.emu_con.emus_str
+#define em_size\h'|\nau'em_value.emu_con.emus_size
+};
+.fi
+.PP
+The named types \fBarith\fR and \fBlabel\fR refer to types on the local machine
+that are suitable for doing arithmetic and storing EM numeric labels
+respectively.
+Common definitions are \fBlong\fR for \fBarith\fR and \fBunsigned int\fR for
+\fBlabel\fR.
+.PP
+The \fIe_instr\fR structure consists of the fields
+\fIem_type\fR, containing the type of this \fIe_instr\fR, and
+\fIem_i\fR, containing its value of this \fIe_instr\fR.
+.PP
+The possible values of
+\fIem_type\fR, defined in <em_code.h>, are summarized below:
+.br
+.ta \w'EM_STARTMES\ \ \ 'u +\w'em_defdnam\ \ \ 'u
+.di xx
+		\ka
+.br
+.di
+.IP "Value	Selector" \nau
+Meaning
+.IP "EM_MNEM	em_opcode" \nau
+an EM machine instruction.
+.br
+.PD 0
+.IP "	em_args" \nau
+The \fIem_opcode\fR field
+contains the opcode of the instruction, and \fIem_args\fR may indicate
+arguments.
+.IP "EM_PSEU	em_opcode" \nau
+an EM pseudo instruction.
+.IP "	em_args" \nau
+The \fIem_opcode\fR field
+contains the opcode, and \fIem_args\fR may indicate arguments.
+As consecutive CON-pseudos are allocated consecutively, a CON delivered by
+\fIEM_getinstr\fR has exactly one argument.
+If the CON-pseudo read has more, they are delivered as separate CON's.
+The same holds for ROM-pseudos.
+Also, if the length of a string constant exceeds 256 characters, it will be
+delivered as several CON's or ROM's.
+.IP "EM_STARTMES	em_arg" \nau
+the start of a MES pseudo.
+.br
+There is one argument: the message number.
+The other arguments, if any, are delivered as separate EM_MESARG's.
+.IP "EM_MESARG	em_arg" \nau
+an argument of a MES pseudo.
+.IP "EM_ENDMES	none" \nau
+the end of a MES pseudo.
+.IP "EM_DEFILB	em_deflb" \nau
+an instruction label definition.
+.br
+The field \fIem_deflb\fR contains the label (instruction labels are always
+numeric).
+.IP "EM_DEFDLB	em_deflb" \nau
+a numeric data label definition.
+.br
+The field \fIem_deflb\fR contains the label.
+.IP "EM_DEFDNAM	em_defdnam" \nau
+a non-numeric data label definition.
+.br
+The field \fIem_defdnam\fR contains the label.
+.IP "EM_ERROR	none" \nau
+an error in the input.
+.br
+\fIEM_error\fR
+contains an error message.
+.IP "EM_FATAL	none" \nau
+a fatal error.
+.br
+\fIEM_error\fR contains an
+error message.
+.PD
+.PP
+The \fIe_args\fR structure consists of the fields
+\fIem_next\fR, containing a pointer to the next argument or null,
+the field \fIem_argtype\fR, containing the type of this argument, and
+the field \fIem_value\fR, containing the value of the argument.
+The possible values of \fIem_argtype\fR, defined in <em_ptyp.h>,
+are summarized below:
+.br
+.ta \w'dlb_ptyp\ \ \ \ 'u +\w'em_opcode\ \ \ 'u
+.di xx
+		\ka
+.br
+.di
+.IP "Value	Selector" \nau
+Meaning
+.IP "ilb_ptyp	em_ilb" \nau
+an instruction label.
+.PD 0
+.IP "nof_ptyp	em_dlb" \nau
+an offset from a numeric data label.
+.IP "	em_noff" \nau
+The
+\fIem_noff\fR field contains the offset and the
+\fIem_dlb\fR field contains the label.
+.IP "sof_ptyp	em_dnam" \nau
+an offset from a non-numeric data label.
+.IP "	em_soff" \nau
+The \fIem_soff\fR field contains the offset and the \fIem_dnam\fR field
+contains the label, represented as a string.
+.IP "cst_ptyp	em_cst" \nau
+a numeric constant.
+.IP "pro_ptyp	em_pnam" \nau
+a procedure name, not including the '$',
+represented as a string.
+.IP "str_ptyp	em_str" \nau
+a string constant.
+.IP "	em_size" \nau
+The string is found in \fIem_str\fR, represented as a row of bytes, of
+length \fIem_size\fR.
+.IP "ico_ptyp	em_str" \nau
+an integer constant.
+.IP "	em_size" \nau
+A string representation of the constant is found in \fIem_str\fR.
+It has size \fIem_size\fR bytes on the target machine.
+.IP "uco_ptyp	em_str" \nau
+an unsigned constant.
+.IP "	em_size" \nau
+A string representation of the constant is found in \fIem_str\fR.
+It has size \fIem_size\fR bytes on the target machine.
+.IP "fco_ptyp	em_str" \nau
+a floating constant.
+.IP "	em_size" \nau
+A string representation of the constant is found in \fIem_str\fR.
+It has size \fIem_size\fR bytes on the target machine.
+.PD
+.PP
+The routine \fIEM_mkcalls\fR "translates" the EM instruction indicated
+by \fIinstr\fR
+into calls of the procedural interface defined in \fIem_code\fR(3L).
+It returns 1 if it succeeds, 0 if it fails for some reason. The
+reason can then be found in \fIEM_error\fR.
+.PP
+\fIEM_lineno\fR contains the line number of the last line read by 
+\fIEM_getinstr\fR.
+.PP
+\fIEM_filename\fR contains a filename. It usually contains the value
+given as parameter to \fIEM_open\fR, but may have a different value, when
+the input was the result of some preprocessing.
+.PP
+.SH FILES
+.nf
+~em/modules/h/em.h
+~em/modules/h/em_ptyp.h
+~em/modules/h/em_comp.h
+~em/modules/lib/libread_emk.a: non-checking library for reading compact EM code
+~em/modules/lib/libread_emkV.a: checking library for reading compact EM code
+~em/modules/lib/libread_emeV.a: checking library for reading human-readable EM code
+.fi
+.SH MODULES
+em_code(3), string(3), system(3), ~em/lib/em_data.a
+.SH "SEE ALSO"
+em_code(3)
+.br
+A.S. Tanenbaum, H. v Staveren, E.G. Keizer, J.W. Stevenson, "\fBDescription
+of a Machine Architecture for use with Block Structured Languages\fR",
+Informatica Rapport IR-81, Vrije Universiteit, Amsterdam, 1983.
+.SH DIAGNOSTICS
+\fIEM_getinstr\fR returns a null pointer on end of file.
+.SH REMARKS
+All information must be considered to be contained in a static area so it
+must be copied to be saved.
+.SH BUGS
+As CON's and ROM's may be delivered in several parts, the count fields in
+a static exchange may be wrong.
+.PP
+Please report bugs to the author.
+.SH AUTHOR
+Ceriel J.H. Jacobs <ceriel@vu44.UUCP>

modules/src/read_em/read_em.c

@@ -0,0 +1,452 @@
+/*	Read_em: a module to read either compact or human readable EM code.
+	Exported are the following routines:
+	EM_open() :	has a parameter representing either a pointer to a
+			filename or a null pointer, indicating that input is
+			from standard input. This routine initializes for
+			reading.
+	EM_getinstr() :	Delivers the next EM instruction in a format
+			defined in <em_comp.h>.
+	Imported are:
+	The constants COMPACT (either defined or not defined) and
+	CHECKING (again either defined or not defined),
+	some routines from the system module. and the em_code module
+*/
+
+#include <assert.h>
+#include <system.h>
+#include <em_label.h>
+#include <em_arith.h>
+#include <em_pseu.h>
+#include <em_spec.h>
+#include "em_ptyp.h"
+#include "em_comp.h"
+#include <em_flag.h>
+#include <em_mes.h>
+
+/* Buffered input */
+
+#define getbyte()	(*_ich ? (*_ich++ & 0377) : _fill())
+#define ungetbyte(uch)	((uch) >= 0 && (*--_ich = (uch)))
+#define init_input()	(_fill(), _ich--)
+
+#define EOF	-1
+
+static File *fd;
+static char *_ich;
+
+PRIVATE int
+_fill()
+{
+	static char text[BUFSIZ + 1];
+	static int sz;
+
+	if (_ich && _ich < &text[sz]) return _ich++, '\0';
+	if (sys_read(fd, text, BUFSIZ, &sz) &&
+	    sz > 0
+	   ) {
+		text[sz] = '\0';
+		return _ich = text, (*_ich++&0377);
+	}
+	else	return EOF;
+}
+
+#define NARGS	3		/* Maximum number of arguments */
+#define STRSIZ	256		/* Maximum length of strings */
+
+static struct e_instr emhead;	/* Where we put the head */
+static struct e_args emargs[NARGS];	/* Where we put the arguments */
+static struct e_args *i_emargs;
+#define argentry()	(i_emargs++)
+static struct string {
+	int length;
+	char str[STRSIZ + 1];
+} strings[NARGS];		/* Room for strings */
+static struct string *i_strings;		/* Index of last one used */
+#define stringentry()	(i_strings++)
+
+static struct e_args *argp;	/* Indicates arguments yet to be
+				   delivered
+				*/
+static arith strleft;		/* count # of chars left to read
+				   in a string
+				*/
+
+static int state;		/* What state are we in? */
+#define CON	01		/* Reading a CON */
+#define ROM	02		/* Reading a ROM */
+#define MES	03		/* Reading a MES */
+#define PSEUMASK 03
+#define INSTRING 010		/* Reading a string */
+
+static int EM_initialized;	/* EM_open called? */
+
+static long wordmask[] = {	/* allowed bits in a word */
+	0x00000000,
+	0x000000FF,
+	0x0000FFFF,
+	0x00000000,
+	0xFFFFFFFF
+};
+
+static int wsize, psize;	/* word size and pointer size */
+
+#ifdef CHECKING
+static char *argrange = "Argument range error";
+#define check(expr) (expr || (xerror(argrange)))
+#else not CHECKING
+#define check(x)	/* nothing */
+#endif CHECKING
+
+/* Error handling
+*/
+
+PRIVATE
+xerror(s)
+	char *s;
+{
+	if (emhead.em_type != EM_FATAL) emhead.em_type = EM_ERROR;
+	if (!EM_error) EM_error = s;
+}
+
+PRIVATE
+xfatal(s)
+	char *s;
+{
+	emhead.em_type = EM_FATAL;
+	if (!EM_error) EM_error = s;
+}
+
+#ifdef COMPACT
+#include "readk.c"
+#else not COMPACT
+#include "reade.c"
+#endif COMPACT
+
+/* EM_open: Open input file, get magic word if COMPACT.
+*/
+EXPORT int
+EM_open(filename)
+	char *filename;
+{
+	
+	if (EM_initialized) {
+		EM_error = "EM_open already called";
+		return 0;
+	}
+	
+	if (filename) {
+		if (!sys_open(filename, OP_READ, &fd)) {
+			EM_error = "Could not open input file";
+			return 0;
+		}
+	}
+	else	fd = STDIN;
+	EM_filename = filename;
+	init_input();
+
+#ifdef COMPACT
+	if (get16() != sp_magic) {
+		EM_error = "Illegal magic word";
+		return 0;
+	}
+#else not COMPACT
+	inithash();	/* initialize hashtable */
+#endif COMPACT
+
+	EM_initialized = 1;
+	return 1;
+}
+
+/* EM_close: Close input file
+*/
+EXPORT
+EM_close()
+{
+	
+	register struct string *pstr;
+
+	if (fd != STDIN) {
+		sys_close(fd);
+		fd = STDIN;
+	}
+	EM_initialized = 0;
+}
+
+
+/* startmes: handle the start of a message. The only important thing here
+	is to get the wordsize and pointer size, and remember that they
+	have already been read, not only to check that they are not specified
+	again, but also to deliver the arguments on next calls to EM_getinstr.
+	This is indicated by the variable "argp".
+*/
+PRIVATE
+startmes(p)
+	register struct e_instr *p;
+{
+	register struct e_args *ap;
+
+	ap = getarg(cst_ptyp);
+	p->em_arg = ap;
+	state = MES;
+
+	if (ap->em_cst == ms_emx) {
+		if (wsize || psize) {
+			xerror("Duplicate ms_emx");
+		}
+		argp = ap = getarg(cst_ptyp);
+		wsize = ap->em_cst;
+		ap->em_next = getarg(cst_ptyp);
+		ap = ap->em_next;
+		psize = ap->em_cst;
+	}
+}
+
+
+/* EM_getinstr: read an "EM_line"
+*/
+EXPORT struct e_instr *
+EM_getinstr()
+{
+	register struct e_instr *p = &emhead;
+	register struct e_args *args;
+
+	i_emargs = emargs;
+	i_strings = strings;
+	EM_error = 0;
+#ifdef CHECKING
+	if (!EM_initialized) {
+		EM_error = "Initialization not done";
+		p->em_type = EM_FATAL;
+		return p;
+	}
+#endif CHECKING
+
+	if (argp) {	/* We have some arguments left to deliver */
+		args = argp;
+		argp = args->em_next;
+		p->em_type = EM_MESARG;
+		p->em_args = args;
+		args->em_next = 0;
+		return p;
+	}
+
+	if (!state) {		/* All clear, get a new line */
+		p = gethead();
+		if (!p) {	/* End of file */
+			return p;
+		}
+		switch(p->em_type) {
+		case EM_MNEM: {
+			register int i,j;
+			register struct e_args *ap;
+			extern char em_flag[];
+			extern short em_ptyp[];	
+
+			p->em_args = 0;
+			j = em_flag[p->em_opcode - sp_fmnem] & EM_PAR;
+			i = em_ptyp[j];
+			if (j == PAR_NO) {	/* No arguments */
+				break;
+			}
+#ifndef COMPACT
+			if (j == PAR_B) i = ptyp(sp_ilb2);
+#endif COMPACT
+			ap = getarg(i);
+#ifndef COMPACT
+			if (j == PAR_B) {
+				ap->em_cst = ap->em_ilb;
+				ap->em_argtype = cst_ptyp;
+			}
+#endif COMPACT
+			/* range checking
+			*/
+#ifdef CHECKING
+			if (wsize <= 4 && psize <= 4) switch(j) {
+			case PAR_B:
+				check(ap->em_cst <= 32767);
+				/* Fall through */
+			case PAR_N:
+				check(ap->em_cst >= 0);
+				break;
+			case PAR_G:
+				if (ap->em_argtype == cst_ptyp) {
+					check(ap->em_cst >= 0);
+				}
+				/* Fall through */
+			case PAR_F:
+				/* ??? not in original em_decode or em_encode */
+			case PAR_L:
+			{	arith m = ap->em_cst >= 0 ? ap->em_cst :
+							    - ap->em_cst;
+
+				/* Check that the number fits in a pointer */
+				check((m & ~wordmask[psize]) == 0);
+				break;
+			}
+			case PAR_W:
+				if (!ap) break;
+				check((ap->em_cst & ~wordmask[wsize]) == 0);
+				/* Fall through */
+			case PAR_S:
+				check(ap->em_cst > 0);
+				/* Fall through */
+			case PAR_Z:
+				check(ap->em_cst >= 0 &&
+				      ap->em_cst % wsize == 0);
+				break;
+			case PAR_O:
+				check(ap->em_cst > 0 &&
+		      		      ( ap->em_cst % wsize == 0 ||
+					wsize % ap->em_cst == 0));
+				break;
+			case PAR_R:
+				check(ap->em_cst >= 0 && ap->em_cst <= 2);
+				break;
+			}
+#endif CHECKING
+			p->em_args = ap;
+#ifndef COMPACT
+			checkeol();
+#endif COMPACT
+			}
+			break;
+		case EM_PSEU:
+			/* handle a pseudo, read possible arguments. CON's and
+			   ROM's are handled especially: Only one argument is
+			   read, and a mark is set that an argument list of
+			   type ROM or CON is in process
+			*/
+			{
+			register struct e_args *ap = 0, *ap1;
+
+			switch(p->em_opcode) {
+			case ps_bss:
+			case ps_hol:
+				ap = getarg(cst_ptyp);
+				ap->em_next = ap1 = getarg(par_ptyp);
+				ap->em_next->em_next = ap1 = getarg(cst_ptyp);
+#ifdef CHECKING
+				/* Check that the last value is 0 or 1
+				*/
+				if (ap1->em_cst != 1 && ap1->em_cst != 0) {
+				  xerror("Third argument of hol/bss not 0/1");
+				}
+#endif CHECKING
+				break;
+			case ps_exa:
+			case ps_ina:
+				ap = getarg(lab_ptyp);
+				break;
+			case ps_exp:
+			case ps_inp:
+				ap = getarg(pro_ptyp);
+				break;
+			case ps_exc:
+				ap = getarg(cst_ptyp);
+				ap->em_next = getarg(cst_ptyp);
+				break;
+			case ps_pro:
+				ap = getarg(pro_ptyp);
+				ap->em_next = getarg(cst_ptyp|ptyp(sp_cend));
+				break;
+			case ps_end:
+				ap = getarg(cst_ptyp|ptyp(sp_cend));
+				break;
+			case ps_con:
+				ap = getarg(val_ptyp);
+				state |= CON;
+				break;
+			case ps_rom:
+				ap = getarg(val_ptyp);
+				state |= ROM;
+				break;
+			default:
+				xerror("Bad pseudo");
+				break;
+			}
+			p->em_args = ap;
+			}
+#ifndef COMPACT
+			if (p->em_opcode != ps_con && p->em_opcode != ps_rom) {
+				checkeol();
+			}
+#endif COMPACT
+			break;
+		case EM_STARTMES:
+			startmes(p);
+			break;
+		}
+		if (!wsize) {
+			xerror("EM code should start with mes 2");
+		}
+		if (EM_error && p->em_type != EM_FATAL) p->em_type = EM_ERROR;
+		return p;
+	}
+
+	if (state & INSTRING) {	/* We already delivered part of a string.
+				   Deliver the next part
+				*/
+		register struct string *s;
+		
+		s = getstring(0);
+		args = argentry();
+		args->em_next = 0;
+		args->em_argtype = str_ptyp;
+		args->em_str = s->str;
+		args->em_size = s->length;
+		switch(state & PSEUMASK) {
+		default:
+			assert(0);
+		case MES:
+			xerror("String too long in message");
+			/* p->em_type = EM_MESARG;
+			   p->em_arg = args;
+			*/
+			break;
+		case CON:
+			p->em_type = EM_PSEU;
+			p->em_opcode = ps_con;
+			p->em_args = args;
+			break;
+		case ROM:
+			p->em_type = EM_PSEU;
+			p->em_opcode = ps_rom;
+			p->em_args = args;
+			break;
+		}
+		if (EM_error && p->em_type != EM_FATAL) p->em_type = EM_ERROR;
+		return p;
+	}
+
+	/* Here, we are in a state reading arguments */
+	args = getarg(any_ptyp);
+	if (EM_error && p->em_type != EM_FATAL) {
+		p->em_type = EM_ERROR;
+		return p;
+	}
+	if (!args) {	/* No more arguments */
+#ifndef COMPACT
+		checkeol();
+#endif
+		if (state == MES) {
+			state = 0;
+			p->em_type = EM_ENDMES;
+			return p;
+		}
+		/* Here, we have to get the next instruction */
+		state = 0;
+		return EM_getinstr();
+	}
+
+	/* Here, there was an argument */
+	if (state == MES) {
+		p->em_type = EM_MESARG;
+		p->em_arg = args;
+		return p;
+	}
+	p->em_type = EM_PSEU;
+	p->em_args = args;
+	if (state == CON) p->em_opcode = ps_con;
+	else	p->em_opcode = ps_rom;
+	return p;
+}

modules/src/read_em/reade.c

@@ -0,0 +1,640 @@
+/*	This file is ment to be included in the file read_emeV.c.
+	It contains the part that takes care of the reading of human readable
+	EM-code.
+*/
+
+#include <ctype.h>
+
+/* #define XXX_YYY	/* only for early debugging */
+
+#ifdef XXX_YYY
+#define out(str)	((void) sys_write(STDOUT, str, strlen(str)))
+#else
+#define out(s)
+#endif
+
+#define fit16i(x)	((x) >= -32768L && (x) <= 32767L)
+
+#define HSIZE	256	/* Size of hashtable for mnemonics */
+
+static int hashtab[HSIZE];	/* The hashtable for mnemonics */
+
+static int argnum;		/* Number of arguments */
+
+#define COMMENTSTARTER	';'
+
+/* inithash, pre_hash, hash: Simple hashtable mechanism
+*/
+PRIVATE int
+hash(s)
+	register char *s;
+{
+	register int h = 0;
+
+	while (*s) {
+		h <<= 1;
+		h += *s++;
+	}
+	return h;
+}
+
+PRIVATE
+pre_hash(i, s)
+	char *s;
+{
+	register int h;
+
+	assert(i != 0);
+	h = hash(s);
+
+	for (;;) {
+		h++;
+		if (h >= HSIZE) h %= HSIZE;
+		if (hashtab[h] == 0) {
+			hashtab[h] = i;
+			return;
+		}
+	}
+	/*NOTREACHED*/
+}
+
+extern char em_mnem[][4];
+extern char em_pseu[][4];
+
+PRIVATE
+inithash()
+{
+	register int i;
+
+	/* Enter instructions ... */
+	for (i = sp_fmnem; i <= sp_lmnem; i++) {
+		pre_hash(i, em_mnem[i - sp_fmnem]);
+	}
+
+	/* and pseudos ... */
+	for (i = sp_fpseu; i <= sp_lpseu; i++) {
+		pre_hash(i, em_pseu[i - sp_fpseu]);
+	}
+}
+
+/* nospace: skip until we find a non-space character. Also skip
+	comments.
+*/
+PRIVATE int
+nospace()
+{
+	register int c;
+
+	do	c = getbyte();
+	while (isspace(c) && c != '\n');
+
+	if (c == COMMENTSTARTER) {
+		do	c = getbyte();
+		while (c != '\n' && c != EOF);
+	}
+
+	return c;
+}
+
+/* syntax: Put an error message in EM_error and skip to the end of the line
+*/
+PRIVATE
+syntax(s)
+	char *s;
+{
+	register int c;
+
+	xerror(s);
+	state = 0;
+	while ((c = getbyte()) != '\n' && c != EOF) /* nothing */ ;
+	ungetbyte(c);
+}
+
+/* checkeol: check that we have a complete line (except maybe for spaces)
+*/
+PRIVATE
+checkeol()
+{
+
+	if (nospace() != '\n') {
+		syntax("end of line expected");
+		(void) nospace();
+	}
+}
+
+/* getescape: read a '\' escape sequence
+*/
+PRIVATE int
+getescape()
+{
+	register int c, j, r;
+
+	if ((c = getbyte()) >= '0' && c <= '7') { /* numeric escape */
+		r = c - '0';
+
+		for (j = 0; j < 2; j++) {
+			if ((c = getbyte()) < '0' || c > '7') {
+				ungetbyte(c);
+				return r;
+			}
+			r <<= 3;
+			r += c - '0';
+		}
+
+		return r;
+	}
+
+	switch(c) {
+	case 'b':	return '\b';
+	case 'f':	return '\f';
+	case 'n':	return '\n';
+	case 'r':	return '\r';
+	case 't':	return '\t';
+	}
+
+	return c;
+}
+
+/* getname: Read a string of characters representing an identifier
+*/
+PRIVATE struct string *
+getname()
+{
+	register char *p;
+	register struct string *s;
+	register int c;
+
+	s = stringentry();
+	p = s->str;
+	c = getbyte();
+
+	if (!(isalpha(c) || c == '_')) {
+		ungetbyte(c);
+		syntax("Letter expected");
+		return s;
+	}
+
+	while (isalnum(c) || c == '_') {
+		if (p < &(s->str[STRSIZ])) *p++ = c;
+		c = getbyte();
+	}
+
+	ungetbyte(c);
+	*p = '\0';
+	s->length = p - s->str;
+	return s;
+}
+
+/* getstring: read a string of characters between quotes
+*/
+PRIVATE struct string *
+getstring()
+{
+	register char *p;
+	struct string *s;
+	register int c;
+	static int termc;
+
+	s = stringentry();
+	p = s->str;
+
+	if (!(state & INSTRING)) {	/* Not reading a string yet */
+		termc = getbyte();
+		/* assert(termc == '"' || termc == '\''); */
+		/* This assertion does not work. Compiler error messages.
+		   The trouble lies in the ", it terminates the string
+		   created in the assertion macro
+		*/
+	}
+
+	for (;;) {
+		if ((c = getbyte()) == '\n' || c == EOF) {
+			ungetbyte(c);
+			syntax("non-terminated string");
+			break;
+		}
+
+		if (c == termc) {
+			if (termc == '"') *p++ = '\0';
+			state &= ~INSTRING;
+			break;
+		}
+
+		if (c == '\\') c = getescape();
+
+		if (p >= &(s->str[STRSIZ])) {
+			state |= INSTRING;
+			ungetbyte(c);
+			break;
+		}
+
+		*p++ = c;	
+	}
+	*p = '\0';
+
+	s->length = p - s->str;
+	return s;
+}
+
+PRIVATE struct e_args *gettyp();
+
+PRIVATE int
+offsetted(argtyp, ap)
+	arith *ap;
+{
+	register int c;
+	register struct e_args *ap1;
+
+	if ((c = nospace()) == '+' || c == '-') {
+		ap1 = gettyp(cst_ptyp);
+		if (c == '-') *ap = -(ap1->em_cst);
+		else *ap = ap1->em_cst;
+		return sp_doff;
+	}
+	else	*ap = 0;
+
+	ungetbyte(c);
+	return argtyp;
+}
+
+PRIVATE int
+getnumber(c, ap)
+	register int c;
+	register struct e_args *ap;
+{
+	register char *p;
+	int n;
+	register struct string *s = stringentry();
+	int expsign;
+	long str2long();
+
+	p = s->str;
+	ap->em_argtype = cst_ptyp;
+	expsign = 0;
+
+	if (c == '+' || c == '-') {
+		if (c == '-') *p++ = c;
+		c = getbyte();
+	}
+
+	if (! isdigit(c)) {
+		ungetbyte(c);
+		syntax("digit expected");
+		return sp_cst4;
+	}
+
+	n = sp_cst4;
+
+	for (;;) {
+		if (p >= &(s->str[STRSIZ])) {
+			syntax("number too long");
+			return sp_cst4;
+		}
+
+		*p++ = c;
+
+		if ((c = getbyte()) == '.' || c == 'e' || c == 'E') {
+			expsign = c != '.';
+			n = sp_fcon;
+			continue;
+		}
+
+		if (expsign) {
+			expsign = 0;
+			if (c == '+' || c == '-') continue;
+		}
+
+		if (! isdigit(c)) break;
+	}
+
+	ungetbyte(c);
+	*p = '\0';
+	c = nospace();
+
+	if (n == sp_fcon && c != 'F') {
+		ungetbyte(c);
+		syntax("'F' expected");
+		return n;
+	}	
+
+	if (c == 'I' || c == 'U' || c == 'F') {
+		ap->em_str = s->str;
+		ap->em_size = gettyp(cst_ptyp)->em_cst;
+
+		switch(c) {
+		case 'I':
+			ap->em_argtype = ico_ptyp;
+			return sp_icon;
+		case 'U':
+			ap->em_argtype = uco_ptyp;
+			return sp_ucon;
+		case 'F':
+			ap->em_argtype = fco_ptyp;
+			return sp_fcon;
+		}
+		assert(0);
+	}
+
+	ungetbyte(c);
+	ap->em_cst = (arith) str2long(s->str, 10);
+	i_strings--;	
+	return sp_cst4;
+}
+
+PRIVATE int getexpr();
+
+PRIVATE int
+getfactor(c, ap)
+	register int c;
+	register struct e_args *ap;
+{
+	if (c == '(') {
+		if (getexpr(nospace(), ap) != sp_cst4) {
+			syntax("expression expected");
+		}
+		else if ((c = nospace()) != ')') {
+			ungetbyte(c);
+			syntax("')' expected");
+		}
+		return sp_cst4;
+	}
+	return getnumber(c, ap);
+}
+
+PRIVATE int
+getterm(c, ap) 
+	register int c;
+	register struct e_args *ap;
+{
+	arith left;
+
+	if ((c = getfactor(c, ap)) != sp_cst4) return c;
+
+	for (;;) {
+		if ((c = nospace()) != '*' && c != '/' && c != '%') {
+			ungetbyte(c);
+			break;
+		}
+
+		left = ap->em_cst;
+		if (getfactor(nospace(), ap) != sp_cst4) {
+			syntax("factor expected");
+			break;
+		}
+
+		if (c == '*') ap->em_cst *= left;
+		else if (c == '/') ap->em_cst = left / ap->em_cst;
+		else	ap->em_cst = left % ap->em_cst;
+	}
+	return sp_cst4;
+}
+
+PRIVATE int
+getexpr(c, ap)
+	register int c;
+	register struct e_args *ap;
+{
+	arith left;
+
+	if ((c = getterm(c, ap)) != sp_cst4) return c;
+
+	for (;;) {
+		if ((c = nospace()) != '+' && c != '-') {
+			ungetbyte(c);
+			break;
+		}
+
+		left = ap->em_cst;
+		if (getterm(nospace(), ap) != sp_cst4) {
+			syntax("term expected");
+			break;
+		}
+
+		if (c == '+') ap->em_cst += left;
+		else ap->em_cst = left - ap->em_cst;
+	}
+	return sp_cst4;
+}
+
+PRIVATE int
+get15u()
+{
+	register struct e_args *ap = argentry();
+
+	ap->em_next = 0;
+	if (getnumber(getbyte(), ap) != sp_cst4) {
+		syntax("integer expected");
+	}
+	else check((ap->em_cst & ~077777) == 0);
+	i_emargs--;
+	return (int) (ap->em_cst);
+}
+
+PRIVATE struct e_args *
+gettyp(typset)
+{
+	register int c, t;
+	register struct e_args *ap = argentry();
+	register int argtyp;
+
+	ap->em_next = 0;
+	if ((c = nospace()) == '\n') {
+		ungetbyte(c);
+		out("newline\n");
+		argtyp = sp_cend;
+	}
+	else if (isdigit(c) || c == '+' || c == '-' || c == '(') {
+		out("expr\n");
+		argtyp = getexpr(c, ap);
+		if (argtyp == sp_cst4 && fit16i(ap->em_cst)) argtyp = sp_cst2;
+	}
+	else if (isalpha(c) || c == '_') {
+		out("name\n");
+		ungetbyte(c);
+		ap->em_dnam = getname()->str;
+		ap->em_argtype = sof_ptyp;
+		argtyp = offsetted(sp_dnam, &(ap->em_soff));
+	}
+	else if (c == '.') {
+		out(".label\n");
+		ap->em_dlb = get15u();
+		ap->em_argtype = nof_ptyp;
+		argtyp = offsetted(sp_dlb2, &(ap->em_noff));
+	}
+	else if (c == '*') {
+		out("*label\n");
+		ap->em_ilb = get15u();
+		ap->em_argtype = ilb_ptyp;
+		argtyp = sp_ilb2;
+	}
+	else if (c == '$') {
+		out("$name\n");
+		ap->em_pnam = getname()->str;
+		ap->em_argtype = pro_ptyp;
+		argtyp = sp_pnam;
+	}
+	else if (c == '"' || c == '\'') {
+		register struct string *s;
+
+		out("string\n");
+		ungetbyte(c);
+		s = getstring(0);
+		ap->em_str = s->str;
+		ap->em_size = s->length;	
+		ap->em_argtype = str_ptyp;
+		argtyp = sp_scon;
+	}
+	else if (c == '?') {
+		out("?\n");
+		argtyp = sp_cend;
+	}
+	else {
+		/* c != '\n', so "ungetbyte" not neccesary */
+		syntax("operand expected");
+		return ap;
+	}
+
+	t = argtyp - sp_fspec;
+	assert(t >= 0 && t < 16);
+	if ((typset & (1 << t)) == 0) {
+		syntax("Bad argument type");
+		return ap;
+	}
+
+	if (argtyp == sp_cend) return 0;
+	return ap;
+}
+
+PRIVATE struct e_args *
+getarg(typset)
+{
+	register int c;
+
+	if (argnum != 1) {
+		if ((c = nospace()) != ',') {
+			if (c != '\n') {
+				syntax("comma expected");
+				return 0;
+			}
+			ungetbyte(c);
+		}
+	}
+	argnum++;
+	return gettyp(typset);
+}
+
+/* getmnem: We found the start of either an instruction or a pseudo.
+	get the rest of it
+*/
+PRIVATE
+getmnem(c, p)
+	register struct e_instr *p;
+{
+	register int h;
+	int i;
+	register struct string *s;
+
+	ungetbyte(c);
+	s = getname();
+	h = hash(s->str);
+
+	for (;;) {
+		h++;
+		if (h >= HSIZE) h %= HSIZE;
+		if ((i = hashtab[h]) == 0) {
+			syntax("bad mnemonic");
+			return;
+		}
+		else if (i <= sp_lmnem) {
+			assert(i >= sp_fmnem);
+			if (strcmp(s->str, em_mnem[i - sp_fmnem]) != 0) {
+				continue;
+			}
+			p->em_type = EM_MNEM;
+			p->em_opcode = i;
+			break;
+		}
+		assert(i <= sp_lpseu && i >= sp_fpseu);
+		if (strcmp(s->str, em_pseu[i - sp_fpseu]) != 0) {
+			continue;
+		}
+		if (i == ps_mes) {
+			p->em_type = EM_STARTMES;
+			break;
+		}
+		p->em_opcode = i;
+		p->em_type = EM_PSEU;
+		break;
+	}
+	i_strings--;
+}
+
+PRIVATE
+line_line()
+{
+	register struct e_args *ap;
+	static char filebuf[STRSIZ + 1];
+	char *btscpy();
+
+	ap = gettyp(ptyp(sp_cst2));
+	EM_lineno = ap->em_cst;
+	i_emargs--;
+	ap = gettyp(str_ptyp);
+	btscpy(filebuf, ap->em_str, (int) ap->em_size);
+	i_emargs--;
+	EM_filename = filebuf;
+}
+
+PRIVATE
+getlabel(c, p)
+	register struct e_instr *p;
+{
+	register struct e_args *ap;
+
+	ungetbyte(c);
+	ap = gettyp(lab_ptyp|ptyp(sp_cst2));
+	switch(ap->em_argtype) {
+	case cst_ptyp:
+		p->em_type = EM_DEFILB;
+		p->em_deflb = ap->em_cst;
+		break;
+	case sof_ptyp:
+		p->em_type = EM_DEFDNAM;
+		p->em_defdnam = ap->em_dnam;
+		break;
+	case nof_ptyp:
+		p->em_type = EM_DEFDLB;
+		p->em_deflb = ap->em_dlb;
+		break;
+	}
+	checkeol();
+}
+
+PRIVATE struct e_instr *
+gethead()
+{
+	register int c, i;
+	register struct e_instr *p = &emhead;
+
+	argnum = 1;
+	for (;;) {	
+		EM_lineno++;
+		if ((c = getbyte()) == EOF) return 0;
+		if (c == '\n') continue;
+		if (isspace(c)) {
+			c = nospace();
+			if (isalpha(c) || c == '_') {
+				getmnem(c, p);
+				return p;
+			}
+			ungetbyte(c);
+		}
+		else if (c == '#') line_line();
+		else {
+			getlabel(c, p);
+			return p;
+		}
+		checkeol();
+	}
+	/*NOTREACHED*/
+}

modules/src/read_em/readk.c

@@ -0,0 +1,367 @@
+/*	This file must be included in the file "read_emk.c".
+	It takes care of the reading of compact EM code.
+*/
+
+#include <ctype.h>
+
+/* get16, get32: read a signed constant
+*/
+PRIVATE int
+get16()
+{
+	register int l_byte, h_byte;
+
+	l_byte = getbyte();
+	h_byte = getbyte();
+	if (h_byte >= 128) h_byte -= 256;
+	return l_byte | (h_byte << 8);
+}
+
+PRIVATE arith
+get32()
+{
+	register arith l;
+	register int h_byte;
+
+	l = getbyte();
+	l |= ((unsigned) getbyte() << 8);
+	l |= ((arith) getbyte() << 16);
+	h_byte = getbyte();
+	if (h_byte >= 128) h_byte -= 256;
+	return l | ((arith) h_byte << 24);
+}
+
+PRIVATE struct string *getstring();
+
+/* getarg : read an argument of any type, and check it against "typset"
+   if neccesary. Return a pointer to the argument.
+*/
+PRIVATE struct e_args *
+getarg(typset)
+{
+	register struct e_args *ap = argentry();
+	register int i = getbyte();
+#ifdef CHECKING
+	int argtyp;
+#endif CHECKING
+
+	ap->em_next = 0;
+	switch(i) {
+	default:
+		if (i < sp_fcst0+sp_ncst0 && i >= sp_fcst0) { /* A cst */
+			ap->em_cst = i - sp_zcst0;
+			ap->em_argtype = cst_ptyp;
+			i = sp_cst2;
+		}
+		break;
+
+	case sp_dlb1:	/* Numeric data label encoded in one byte */
+		ap->em_dlb = getbyte();
+		ap->em_noff = 0;
+		ap->em_argtype = nof_ptyp;
+		break;
+
+	case sp_dlb2:	/* Numeric data label encoded in two bytes */
+		ap->em_dlb = get16();
+		ap->em_noff = 0;
+		ap->em_argtype = nof_ptyp;
+#ifdef CHECKING
+		if (ap->em_dlb < 0) {
+			xerror("Illegal data label");
+			break;
+		}
+#endif CHECKING
+		break;
+
+	case sp_ilb1:	/* Instruction label encoded in one byte */
+		ap->em_ilb = getbyte();
+		ap->em_argtype = ilb_ptyp;
+		break;
+
+	case sp_ilb2:	/* Instruction label encoded in two bytes */
+		ap->em_ilb = get16();
+		ap->em_argtype = ilb_ptyp;
+#ifdef CHECKING
+		if (ap->em_ilb < 0) {
+			xerror("Illegal instruction label");
+			break;
+		}
+#endif CHECKING
+		break;
+
+	case sp_cst2:	/* A cst encoded in two bytes */
+		ap->em_cst = get16();
+		ap->em_argtype = cst_ptyp;
+		break;
+
+	case sp_cst4:	/* A cst encoded in four bytes */
+		ap->em_cst = get32();
+		ap->em_argtype = cst_ptyp;
+		break;
+
+	case sp_pnam:	/* A procedure name */
+	{
+		register struct string *p;
+
+		p = getstring(1);
+#ifdef CHECKING
+		if (state & INSTRING) {
+			xerror("Procedure name too long");
+		}
+#endif CHECKING
+		ap->em_pnam = p->str;
+		ap->em_argtype = pro_ptyp;
+		break;
+	}
+
+	case sp_dnam:	/* A Non-numeric data label */
+	{
+		register struct string *p;
+
+		p = getstring(1);
+#ifdef CHECKING
+		if (state & INSTRING) {
+			xerror("Data label too long");
+		}
+#endif CHECKING
+		ap->em_dnam = p->str;
+		ap->em_soff = 0;
+		ap->em_argtype = sof_ptyp;
+		break;
+	}
+
+	case sp_doff:	/* A data label + offset */
+	{
+		register struct e_args *ap1, *ap2;
+
+		ap1 = getarg(lab_ptyp);
+		ap2 = getarg(cst_ptyp);
+		*ap = *ap1;
+		if (ap->em_argtype == sof_ptyp) {	/* non-numeric label */
+			ap->em_soff = ap2->em_cst;
+		}
+		else	ap->em_noff = ap2->em_cst;
+		i_emargs -= 2;
+		break;
+	}
+
+	case sp_icon:	/* An integer constant */
+	case sp_ucon:	/* An unsigned constant */
+	case sp_fcon:	/* A floating constant */
+	{
+		register struct e_args *ap1;
+		register struct string *p;
+
+		ap1 = getarg(cst_ptyp);
+		p = getstring(0);
+#ifdef CHECKING
+		if (state & INSTRING) {
+			xerror("Numeric constant too long");
+		}
+#endif CHECKING
+		ap->em_argtype = ptyp(i);
+		ap->em_str = p->str;
+		ap->em_size = ap1->em_cst;
+		i_emargs--;
+		break;
+	}
+
+	case sp_scon:	/* A string constant */
+	{
+		register struct string *p;
+
+		p = getstring(0);
+		ap->em_argtype = str_ptyp;
+		ap->em_str = p->str;
+		ap->em_size = p->length;
+		break;
+	}
+	}
+#ifdef CHECKING
+	argtyp = i;
+	if (EM_error) return 0;
+
+	if (i == EOF) {
+		xfatal("Unexpected EOF");
+		return 0;
+	}
+
+	if ((i -= sp_fspec) < 0 || i >= 16) {
+		xerror("Illegal byte");
+		return 0;
+	}
+
+	if ((typset & (1 << i)) == 0) {
+		xerror("Bad argument type");
+	}
+	if (argtyp == sp_cend) return 0;
+#else not CHECKING
+	if (i == sp_cend) return 0;
+#endif CHECKING
+	return ap;
+}
+
+#ifdef CHECKING
+/* checkident: check that a string indeed represents an identifier
+*/
+PRIVATE int
+checkident(s)
+	register struct string *s;
+{
+	register char *p;
+	register int n;
+
+	p = s->str;
+	if (!isascii(*p) || (!isalpha(*p) && *p != '_')) {
+		return 0;
+	}
+	p++;
+	for (n = s->length; --n > 0; p++) {
+		if (!isascii(*p) || (!isalnum(*p) && *p != '_')) {
+			return 0;
+		}
+	}
+	return 1;
+}
+#endif CHECKING
+
+/* getstring: read a string from the input, but at most STRSIZ characters
+	of it. The next characters will be read another time around
+*/
+/*ARGSUSED*/
+PRIVATE struct string *
+getstring(isident)
+{
+	register char *p;
+	register int n;
+	register struct string *s;
+
+	if (!(state & INSTRING)) {	/* Not reading a string yet */
+		struct e_args *ap = getarg(cst_ptyp);
+					/* Read length of string */
+		i_emargs--;
+		strleft = ap->em_cst;
+#ifdef CHECKING
+		if (strleft < 0) {
+			xerror("Negative length in string");
+			return 0;
+		}
+#endif CHECKING
+	}
+
+	s = stringentry();
+
+	if (strleft <= STRSIZ) {	/* Handle the whole string */
+		n = strleft;
+		state &= ~INSTRING;
+	}
+	else {				/* Handle STRSIZ characters of it, and
+					   indicate that there is more
+					*/
+	 	n = STRSIZ;
+		strleft -= STRSIZ;
+		state |= INSTRING;
+	}
+
+	s->length = n;
+	p = s->str;
+	while (--n >= 0) {
+		*p++ = getbyte();
+	}
+	*p++ = '\0';
+
+#ifdef CHECKING
+	if (isident) {
+		if (!checkident(s)) {
+			xerror("Illegal identifier");
+		}
+	}
+#endif CHECKING
+	return s;
+}
+
+/* gethead: read the start of an EM-line
+*/
+PRIVATE struct e_instr *
+gethead()
+{
+	register int i;
+	register struct e_instr *p = &emhead;
+
+	EM_lineno++;
+
+	if ((i = getbyte()) < sp_fmnem+sp_nmnem && i >= sp_fmnem) {
+		/* A mnemonic */
+		p->em_type = EM_MNEM;
+		p->em_opcode = i;
+		return p;
+	}
+
+	if (i < sp_fpseu+sp_npseu && i >= sp_fpseu) {	/* A pseudo */
+		if (i == ps_mes) {
+			p->em_type = EM_STARTMES;
+		}
+		else	p->em_type = EM_PSEU;
+		p->em_opcode = i;
+		return p;
+	}
+
+	if (i < sp_filb0+sp_nilb0 && i >= sp_filb0) {	/* Instruction label */
+		p->em_type = EM_DEFILB;
+		p->em_deflb = i - sp_filb0;
+		return p;
+	}
+
+	switch(i) {
+	case sp_ilb1:	/* Instruction label */
+		p->em_type = EM_DEFILB;
+		p->em_deflb = getbyte();
+		break;
+
+	case sp_ilb2:	/* Instruction label */
+		p->em_type = EM_DEFILB;
+		p->em_deflb = get16();
+#ifdef CHECKING
+		if (p->em_deflb < 0) {
+			xerror("Illegal instruction label definition");
+		}
+#endif CHECKING
+		break;
+
+	case sp_dlb1:	/* Numeric data label */
+		p->em_type = EM_DEFDLB;
+		p->em_deflb = getbyte();
+		break;
+
+	case sp_dlb2:	/* Numeric data label */
+		p->em_type = EM_DEFDLB;
+		p->em_deflb = get16();
+#ifdef CHECKING
+		if (p->em_deflb < 0) {
+			xerror("Illegal data label definition");
+		}
+#endif CHECKING
+		break;
+
+	case sp_dnam:	/* Non-numeric data label */
+	{
+		struct string *s;
+
+		p->em_type = EM_DEFDNAM;
+		if (!(s = getstring(1))) {
+			p->em_type = EM_ERROR;
+		}
+		else	p->em_defdnam = s->str;
+		break;
+	}		
+
+	case EOF:	/* End of file */
+		return 0;
+
+	default:
+		xerror("Unknown opcode");
+		break;
+	}
+
+	return p;
+}