Pārlūkot izejas kodu

Initial revision

keie 40 gadi atpakaļ
vecāks
revīzija
166bccd1b5
15 mainītis faili ar 4028 papildinājumiem un 0 dzēšanām
  1. 298 0
      etc/ip_spec.t
  2. 77 0
      util/ass/Makefile
  3. 371 0
      util/ass/ass30.c
  4. 55 0
      util/ass/ass40.c
  5. 190 0
      util/ass/ass50.c
  6. 211 0
      util/ass/ass60.c
  7. 341 0
      util/ass/ass70.c
  8. 412 0
      util/ass/ass80.c
  9. 847 0
      util/ass/assci.c
  10. 137 0
      util/ass/asscm.c
  11. 125 0
      util/ass/assda.c
  12. 158 0
      util/ass/assex.h
  13. 298 0
      util/ass/assrl.c
  14. 33 0
      util/ass/ip_spec.h
  15. 475 0
      util/ass/maktab.c

+ 298 - 0
etc/ip_spec.t

@@ -0,0 +1,298 @@
+aar mwPo 1 34
+adf sP 1 35
+adi mwPo 2 36
+adp 2 38
+adp mPo 2 39
+adp sP 1 41
+adp sN 1 42
+ads mwPo 1 43
+and mwPo 1 44
+asp mwPo 5 45
+asp swP 1 50
+beq 2 51
+beq sP 1 52
+bge sP 1 53
+bgt sP 1 54
+ble sP 1 55
+blm sP 1 56
+blt sP 1 57
+bne sP 1 58
+bra 2 59
+bra sN 2 60
+bra sP 2 62
+cal mPo 28 64
+cal sP 1 92
+cff - 93
+cif - 94
+cii - 95
+cmf sP 1 96
+cmi mwPo 2 97
+cmp - 99
+cms sP 1 100
+csa mwPo 1 101
+csb mwPo 1 102
+dec - 103
+dee sw 1 104
+del swN 1 105
+dup mwPo 1 106
+dvf sP 1 107
+dvi mwPo 1 108
+fil 2 109
+inc - 110
+ine w2 111
+ine sw 1 112
+inl mwN 3 113
+inl swN 1 116
+inn sP 1 117
+ior mwPo 1 118
+ior sP 1 119
+lae 2 120
+lae sw 7 121
+lal P2 128
+lal N2 129
+lal m 1 130
+lal mN 1 131
+lal swP 1 132
+lal swN 2 133
+lar mwPo 1 135
+ldc mP 1 136
+lde w2 137
+lde sw 1 138
+ldl mP 1 139
+ldl swN 1 140
+lfr mwPo 2 141
+lfr sP 1 143
+lil swN 1 144
+lil swP 1 145
+lil mwP 2 146
+lin 2 148
+lin sP 1 149
+lni - 150
+loc 2 151
+loc mP 34 0
+loc mN 1 152
+loc sP 1 153
+loc sN 1 154
+loe w2 155
+loe sw 5 156
+lof 2 161
+lof mwPo 4 162
+lof sP 1 166
+loi 2 167
+loi mPo 1 168
+loi mwPo 4 169
+loi sP 1 173
+lol wP2 174
+lol wN2 175
+lol mwP 4 176
+lol mwN 8 180
+lol swP 1 188
+lol swN 1 189
+lxa mPo 1 190
+lxl mPo 2 191
+mlf sP 1 193
+mli mwPo 2 194
+rck mwPo 1 196
+ret mwP 2 197
+ret sP 1 199
+rmi mwPo 1 200
+sar mwPo 1 201
+sbf sP 1 202
+sbi mwPo 2 203
+sdl swN 1 205
+set sP 1 206
+sil swN 1 207
+sil swP 1 208
+sli mwPo 1 209
+ste w2 210
+ste sw 3 211
+stf 2 214
+stf mwPo 2 215
+stf sP 1 217
+sti mPo 1 218
+sti mwPo 4 219
+sti sP 1 223
+stl wP2 224
+stl wN2 225
+stl mwP 2 226
+stl mwN 5 228
+stl swN 1 233
+teq - 234
+tgt - 235
+tlt - 236
+tne - 237
+zeq 2 238
+zeq sP 2 239
+zer sP 1 241
+zge sP 1 242
+zgt sP 1 243
+zle sP 1 244
+zlt sP 1 245
+zne sP 1 246
+zne sN 1 247
+zre w2 248
+zre sw 1 249
+zrl mwN 2 250
+zrl swN 1 252
+zrl wN2 253
+aar e2 0
+aar e- 1
+adf e2 2
+adf e- 3
+adi e2 4
+adi e- 5
+ads e2 6
+ads e- 7
+adu e2 8
+adu e- 9
+and e2 10
+and e- 11
+asp ew2 12
+ass e2 13
+ass e- 14
+bge e2 15
+bgt e2 16
+ble e2 17
+blm e2 18
+bls e2 19
+bls e- 20
+blt e2 21
+bne e2 22
+cai e- 23
+cal e2 24
+cfi e- 25
+cfu e- 26
+ciu e- 27
+cmf e2 28
+cmf e- 29
+cmi e2 30
+cmi e- 31
+cms e2 32
+cms e- 33
+cmu e2 34
+cmu e- 35
+com e2 36
+com e- 37
+csa e2 38
+csa e- 39
+csb e2 40
+csb e- 41
+cuf e- 42
+cui e- 43
+cuu e- 44
+dee ew2 45
+del ewP2 46
+del ewN2 47
+dup e2 48
+dus e2 49
+dus e- 50
+dvf e2 51
+dvf e- 52
+dvi e2 53
+dvi e- 54
+dvu e2 55
+dvu e- 56
+fef e2 57
+fef e- 58
+fif e2 59
+fif e- 60
+inl ewP2 61
+inl ewN2 62
+inn e2 63
+inn e- 64
+ior e2 65
+ior e- 66
+lar e2 67
+lar e- 68
+ldc e2 69
+ldf e2 70
+ldl ewP2 71
+ldl ewN2 72
+lfr e2 73
+lil ewP2 74
+lil ewN2 75
+lim e- 76
+los e2 77
+los e- 78
+lor esP 1 79
+lpi e2 80
+lxa e2 81
+lxl e2 82
+mlf e2 83
+mlf e- 84
+mli e2 85
+mli e- 86
+mlu e2 87
+mlu e- 88
+mon e- 89
+ngf e2 90
+ngf e- 91
+ngi e2 92
+ngi e- 93
+nop e- 94
+rck e2 95
+rck e- 96
+ret e2 97
+rmi e2 98
+rmi e- 99
+rmu e2 100
+rmu e- 101
+rol e2 102
+rol e- 103
+ror e2 104
+ror e- 105
+rtt e- 106
+sar e2 107
+sar e- 108
+sbf e2 109
+sbf e- 110
+sbi e2 111
+sbi e- 112
+sbs e2 113
+sbs e- 114
+sbu e2 115
+sbu e- 116
+sde e2 117
+sdf e2 118
+sdl ewP2 119
+sdl ewN2 120
+set e2 121
+set e- 122
+sig e- 123
+sil ewP2 124
+sil ewN2 125
+sim e- 126
+sli e2 127
+sli e- 128
+slu e2 129
+slu e- 130
+sri e2 131
+sri e- 132
+sru e2 133
+sru e- 134
+sti e2 135
+sts e2 136
+sts e- 137
+str esP 1 138
+tge e- 139
+tle e- 140
+trp e- 141
+xor e2 142
+xor e- 143
+zer e2 144
+zer e- 145
+zge e2 146
+zgt e2 147
+zle e2 148
+zlt e2 149
+zne e2 150
+zrf e2 151
+zrf e- 152
+zrl ewP2 153
+dch e- 154
+exg esP 1 155
+exg e2 156
+exg e- 157
+lpb e- 158
+gto e2 159
+ldc 4 0

+ 77 - 0
util/ass/Makefile

@@ -0,0 +1,77 @@
+d=../..
+l=$d/lib
+h=$d/h
+ASS_PATH=$l/em_ass
+
+SEP_OPT=-i
+
+CFLAGS=-O
+
+all:            ass$(SEP_OPT)
+
+clean:
+		-rm -f ass-i ass-n *.o maktab *.old asstb.c
+
+install :       all
+		cp ass$(SEP_OPT) $(ASS_PATH)
+
+cmp :           all
+		cmp ass$(SEP_OPT) $(ASS_PATH)
+
+lint:           ass00.c ass30.c ass40.c ass50.c ass60.c ass70.c \
+			ass80.c assci.c assda.c assrl.c asstb.c asscm.c
+		lint -hpvbx \
+			ass00.c ass30.c ass40.c ass50.c ass60.c ass70.c \
+			ass80.c assci.c assda.c assrl.c asstb.c asscm.c
+
+
+ass-n:       ass00.o ass30.o ass40.o ass50.o ass60.o ass70.o \
+			ass80.o assci.o assda.o assrl.o asstb.o asscm.o \
+			$l/em_data.a
+		cc -n $(CFLAGS) -o ass-n \
+			ass00.o ass30.o ass40.o ass50.o ass60.o ass70.o \
+			ass80.o assci.o assda.o assrl.o asstb.o asscm.o \
+			$l/em_data.a
+
+ass-i:       ass00.o ass30.o ass40.o ass50.o ass60.o ass70.o \
+			ass80.o assci.o assda.o assrl.o asstb.o asscm.o \
+			$l/em_data.a
+		cc -i $(CFLAGS) -o ass-i \
+			ass00.o ass30.o ass40.o ass50.o ass60.o ass70.o \
+			ass80.o assci.o assda.o assrl.o asstb.o asscm.o \
+			$l/em_data.a
+
+ass00.o ass40.o ass60.o ass70.o ass80.o assrl.c: \
+		$h/local.h $h/em_spec.h $h/as_spec.h \
+		$h/em_flag.h $h/arch.h ass00.h assex.h
+
+assci.o:        $h/local.h $h/em_spec.h $h/as_spec.h \
+		$h/em_flag.h $h/em_mes.h $h/em_pseu.h \
+		$h/em_ptyp.h $h/arch.h ass00.h assex.h
+
+ass30.o ass50.o : \
+		$h/local.h $h/em_spec.h $h/as_spec.h \
+		$h/em_flag.h ip_spec.h ass00.h assex.h
+
+ass80.o:        $h/em_path.h
+
+assda.o:        $h/local.h $h/em_spec.h $h/as_spec.h \
+		$h/em_flag.h $h/arch.h ass00.h
+
+asscm.o:        ass00.h
+
+asstb.o:        asstb.c
+
+asstb.c:        maktab ip_spec.t
+		maktab ip_spec.t asstb.c
+
+maktab:         maktab.c $h/em_spec.h ip_spec.h $h/em_flag.h \
+		$l/em_data.a
+		cc -O -o maktab maktab.c $l/em_data.a
+
+opr:
+		make pr ^ opr
+
+pr:
+		@(pr ass00.h assex.h ip_spec.h ass?0.c ass[rcd]?.c \
+		maktab.c ; pr -3 ip_spec.t)

+ 371 - 0
util/ass/ass30.c

@@ -0,0 +1,371 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+#include        "ass00.h"
+#include        "assex.h"
+#include        "ip_spec.h"
+
+short           opt_line ;      /* max_line_no - # lines removed from end
+				   after perfoming exc's.
+				   Used to estimate the distance in # of
+				   instructions.
+				*/
+/*
+** Determine the exact instruction length & format where possible, and the
+** the upper and lower limits otherwise. Enter limits in labeltable
+*/
+pass_3()
+{
+	register line_t *lnp, *rev_lnp;
+	line_t   *tmp_lnp;
+	locl_t   *lbp;
+	int      min_l, max_l, min_bytes;
+	short    last_line ;
+	short    hol_err_line ;
+	register insno ;
+
+	pass = 3;
+	opt_line= line_num ; hol_err_line=0 ;
+	min_bytes = max_bytes = 0; rev_lnp= lnp_cast 0 ;
+	for (lnp = pstate.s_fline ; lnp ; opt_line--, line_num-- ) {
+		pstate.s_fline= lnp;
+		insno = ctrunc(lnp->instr_num);
+		switch( insno ) {
+		case sp_fpseu :
+			last_line = line_num ;
+			line_num = lnp->ad.ad_ln.ln_first ;
+			opt_line -= lnp->ad.ad_ln.ln_extra ;
+			lnp->ad.ad_ln.ln_first= last_line ;
+			break ;
+		case sp_ilb1 :
+			lbp = lnp->ad.ad_lp;
+			lbp->l_defined = SEEN;
+			lbp->l_min = min_bytes;
+			lbp->l_max = max_bytes;
+			break ;
+		default:
+		if ( lnp->type1==CONST && (em_flag[insno]&EM_PAR)==PAR_G ) {
+			if (holbase != 0) {
+				lnp->ad.ad_i += holbase;
+				if (lnp->ad.ad_i >= holsize) {
+						hol_err_line= line_num ;
+				}
+			}
+		} else
+		if ( lnp->type1>=VALLOW && (em_flag[insno]&EM_PAR)==PAR_G ) {
+			if (holbase != 0) {
+				pstate.s_fline= lnp->l_next ;
+				newline(CONST) ;
+				pstate.s_fline->instr_num= insno ;
+				pstate.s_fline->ad.ad_i=
+					VAL1(lnp->type1)+holbase ;
+				freearea((area_t)lnp,
+					(unsigned)linesize[VALLOW]) ;
+				lnp= pstate.s_fline ;
+				if ( VAL1(lnp->type1) >= holsize) {
+					hol_err_line= line_num ;
+				}
+			}
+		}
+		if ( !valid(lnp) ) fatal("Invalid operand") ;
+
+		determine_props(lnp, &min_l, &max_l);
+		min_bytes += min_l; max_bytes += max_l;
+		break ;
+		}
+		tmp_lnp= lnp->l_next ;
+		lnp->l_next= rev_lnp ; rev_lnp= lnp ;
+		lnp= tmp_lnp ;
+	}
+	pstate.s_fline= rev_lnp ;
+	if ( hol_err_line ) {
+		line_num= hol_err_line ;
+		werror("address exceeds holsize") ;
+	}
+}
+
+
+/*
+** Determine the format that should be used for each instruction,
+** depending on its offsets
+*/
+
+determine_props(lnp, min_len, max_len)
+	line_t *lnp;
+	int    *min_len, *max_len;
+{
+	cons_t  val ;
+	register int insno ;
+	register char *f_off, *l_off ;
+	char defined ;
+
+	insno=ctrunc(lnp->instr_num) ;
+	val=parval(lnp,&defined) ;
+	if ( !defined ) {
+		switch(em_flag[insno]&EM_PAR) {
+		case PAR_NO:
+		case PAR_W:
+			f_off = findnop(insno) ;
+			break ;
+		case PAR_G:
+			/* We want the maximum address that is a multiple
+			   of the wordsize.
+			   Assumption: there is no shortie for
+				intr max_word_multiple
+			     where intr is a instruction allowing parameters
+			     that are not a word multiple (PAR_G).
+			*/
+			f_off = findfit(insno, maxadr&(~(wordsize-1))) ;
+			break ;
+		case PAR_B:
+			f_off = findfit(insno, (cons_t)0) ;
+			l_off = findfit(insno, val ) ;
+			if ( f_off != l_off ) {
+				*min_len=oplength(*f_off) ;
+				*max_len=oplength(*l_off) ;
+				lnp->opoff = NO_OFF ;
+				return ;
+			}
+			break ;
+		}
+	} else {
+		f_off = findfit(insno,val) ;
+	}
+	lnp->opoff = f_off ;
+	*min_len = *max_len = oplength(*f_off) ;
+}
+
+char *findfit(instr,val) int instr ; cons_t val ; {
+	register char *currc,*endc ;
+	int found, flags, number ;
+	char *opc ;
+
+	endc = opindex[instr+1] ;
+	for ( currc=opindex[instr], found=0 ;
+		!found && currc<endc ; currc++ ) {
+		opc = currc ;
+		flags=ctrunc(*currc++) ;
+		switch ( flags&OPTYPE ) {
+		case OPNO :
+			continue ;
+		case OPMINI :
+		case OPSHORT :
+			number=ctrunc(*++currc) ;
+		}
+		found = opfit(flags, number, val, em_flag[instr]&EM_PAR ) ;
+	}
+	if ( !found ) fatal("Cannot find interpreter opcode") ;
+	return opc ;
+}
+
+char *findnop(instr) int instr ; {
+	register char *currc,*endc ;
+
+	endc = opindex[instr+1] ;
+	for ( currc=opindex[instr] ; currc<endc ; currc++ ) {
+		switch ( ctrunc(*currc)&OPTYPE ) {
+		case OPNO :
+			return currc ;
+		case OPSHORT :
+		case OPMINI :
+			currc++ ;
+		}
+		currc++ ;
+	}
+	fatal("Cannot find interpreter opcode") ;
+	/* NOTREACHED */
+}
+
+int opfit(flag,number,val,i_flag)
+int i_flag,flag,number ; cons_t val ; {
+	/* Number is invalid if flag does not contain MINI or SHORT */
+	switch ( flag&OPRANGE ) {
+	case OP_POS :
+		if ( val<0 ) return 0 ;
+		break ;
+	case OP_NEG :
+		if ( val>=0 ) return 0 ;
+		break ;
+	}
+	if ( flag&OPWORD ) {
+		if ( val%wordsize ) return 0 ;
+		val /= wordsize ;
+	}
+	if ( flag&OPNZ ) {
+		if ( val==0 ) return 0 ;
+		val-- ;
+	}
+	switch ( flag&OPTYPE ) {
+	case OPMINI :
+		if ( val<0 ) val = -1-val ;
+		return val>=0 && val<number ;
+	case OPSHORT :
+		if ( val<0 ) val = -1-val ;
+		return val>=0 && val<number*256 ;
+	case OP16 :
+		if ( i_flag==PAR_G ) return val>=0 && val<=maxadr ;
+		return val>= -32768 && val<=32767 ;
+	case OP32 :
+		return TRUE ;
+	default :
+		fatal("illegal OPTYPE value") ;
+		/* NOTREACHED */
+	}
+}
+
+int oplength(flag) int flag ; {
+	int cnt ;
+
+	cnt=1 ;
+	if ( flag&OPESC ) cnt++ ;
+	switch( flag&OPTYPE ) {
+	case OPNO    :
+	case OPMINI  : break ;
+	case OP8     :
+	case OPSHORT : cnt++ ; break ;
+	case OP16    : cnt+=2 ; break ;
+	case OP32    : cnt+=5 ; break ;
+	case OP64    : cnt+=9 ; break ;
+	}
+	return cnt ;
+}
+
+/*
+** return estimation of value of parameter
+*/
+cons_t parval(lnp,defined)
+	line_t *lnp;
+	char *defined;
+{
+	register int    type;
+	register locl_t *lbp;
+	register glob_t *gbp;
+	cons_t   offs ;
+
+	*defined = TRUE ;
+	type = lnp->type1;
+	switch(type) {
+		default: if ( type>=VALLOW && type<=VALHIGH )
+				 return VAL1(type) ;
+			 error("bad type during parval");
+			 break;
+		case CONST:
+			return(lnp->ad.ad_i);
+		case GLOSYM:
+		case GLOOFF:
+			if ( type!=GLOOFF) {
+				gbp = lnp->ad.ad_gp;
+				offs= 0 ;
+			} else {
+				gbp =lnp->ad.ad_df.df_gp ;
+				offs=lnp->ad.ad_df.df_i ;
+			}
+			if(gbp->g_status&DEF)
+				return(gbp->g_val.g_addr+offs);
+			else {
+				*defined = FALSE ;
+				return offs ;
+			}
+		case LOCSYM:
+			lbp = lnp->ad.ad_lp;
+			switch(pass) {
+			default:error("bad pass in parval");
+			case 3:
+				*defined = FALSE;
+				switch(lbp->l_defined) {
+				default : fatal("Illegal local label") ;
+				case NO :
+					error("Undefined local label") ;
+					lbp->l_defined= NOTPRESENT ;
+				case NOTPRESENT:
+					return max_bytes;
+				case SEEN :
+					return max_bytes - lbp->l_min ;
+				case YES :
+					/* l_min contains line_num
+					   adjusted for exc's.
+					*/
+			return (lbp->l_min - opt_line -1 ) * maxinsl ;
+				}
+			case 4: if(lbp->l_defined == YES)
+					return(lbp->l_min-prog_size-maxinsl);
+				return max_bytes - lbp->l_max- prog_size;
+			case 5: if (lbp->l_defined == YES )
+					return lbp->l_min ;
+				*defined = FALSE ;
+				break ;
+			}
+			break;
+		case MISSING:
+			*defined = FALSE ;
+			break;
+		case PROCNAME:
+			return(lnp->ad.ad_pp->p_num);
+	}
+	return(0);
+}
+int valid(lnp) register line_t *lnp ; {
+	cons_t val ;
+	char type ;
+
+	type = lnp->type1 ;
+	if ( type>=VALLOW && type<=VALHIGH ) {
+		val= VAL1(type) ;
+		type= CONST ;
+	} else if ( type==CONST ) val = lnp->ad.ad_i ;
+	switch ( em_flag[ctrunc(lnp->instr_num)]&EM_PAR ) {
+	case PAR_NO:
+		return type==MISSING ;
+	case PAR_C:
+		if ( type!=CONST ) return FALSE;
+		if ( val>maxint && val<=maxunsig ) {
+			lnp->ad.ad_i = val -maxunsig -1 ;
+		}
+		return TRUE ;
+	case PAR_D:
+		if ( type!=CONST ) return FALSE;
+		if ( val>maxdint && val<=maxdunsig ) {
+			lnp->ad.ad_i = val -maxdunsig -1 ;
+		}
+		return TRUE ;
+	case PAR_L:
+	case PAR_F:
+		return type==CONST ;
+	case PAR_N:
+		return type==CONST && val>=0 ;
+	case PAR_G:
+		return type==CONST || type==GLOSYM || type==GLOOFF ;
+	case PAR_W:
+		if ( type==MISSING ) return TRUE ;
+	case PAR_S:
+		return type==CONST && val>0 && val%wordsize==0 ;
+	case PAR_Z:
+		return type==CONST && val>=0 && val%wordsize==0 ;
+	case PAR_O:
+		return type==CONST && val>=0 &&
+		    ( val >= wordsize ? val%wordsize : wordsize%val ) == 0 ;
+	case PAR_P:
+		return type==PROCNAME ;
+	case PAR_B:
+		return type==LOCSYM ;
+	case PAR_R:
+		return type==CONST && val>=0 && val<=3 ;
+	default:
+		fatal("Unknown parameter type") ;
+		/* NOTREACHED */
+	}
+}

+ 55 - 0
util/ass/ass40.c

@@ -0,0 +1,55 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+#include        "ass00.h"
+#include        "assex.h"
+/*
+** Make scans to do final assignment of instruction sizes & formats
+** to those not already done. assign final values to labels
+*/
+pass_4()
+{
+	register line_t *lnp;
+	register locl_t *lbp;
+	int     min_l, max_l;
+	int     instr;
+
+	pass = 4;
+	prog_size= 0 ;
+	for (lnp = pstate.s_fline ; lnp ; lnp= lnp->l_next, line_num++) {
+		instr = ctrunc(lnp->instr_num);
+		if ( instr==sp_fpseu ) {
+			line_num = lnp->ad.ad_ln.ln_first ;
+			continue ;
+		}
+		if ( instr==sp_ilb1 ) {
+			lbp = lnp->ad.ad_lp;
+			lbp->l_min= prog_size; lbp->l_defined = YES;
+			continue ;
+		}
+
+		if (lnp->opoff == NO_OFF)
+		{
+			determine_props(lnp, &min_l, &max_l);
+			if (min_l != max_l)
+				fatal("no size known");
+		} else {
+			min_l = oplength(*(lnp->opoff)) ;
+		}
+		prog_size += min_l ;
+	}
+}

+ 190 - 0
util/ass/ass50.c

@@ -0,0 +1,190 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+#include        "ass00.h"
+#include        "assex.h"
+#include        "ip_spec.h"
+
+/*
+** Pass 5 of EM1 assembler/loader
+** Fix reloc tables
+** Write out code
+*/
+
+pass_5() {
+	register line_t *lnp;
+	cons_t off1;
+	char defined ;
+	int afterlength, partype ;
+	register int inslength, ope;
+	char *op_curr ;
+
+	pass = 5;
+	afterlength = 0;
+	for (lnp = pstate.s_fline ; lnp ; lnp= lnp->l_next, line_num++ ) {
+		ope = ctrunc(lnp->instr_num);
+		if ( ope==sp_ilb1 ) continue ;
+		if ( ope==sp_fpseu ) {
+			line_num = lnp->ad.ad_ln.ln_first ;
+			continue ;
+		}
+		off1 = parval(lnp,&defined);
+		if ( (op_curr = lnp->opoff)==NO_OFF ) {
+			fatal("opoff assertion failed") ;
+		}
+		inslength = oplength(*op_curr) ;
+		afterlength += inslength ;
+
+		/*
+		 * Change absolute offset to a relative for branches.
+		 */
+
+
+		partype= em_flag[ope]&EM_PAR ;
+		if ( partype==PAR_B && defined ) {
+			off1 -= afterlength;
+		}
+
+#ifdef JOHAN
+		if ( jflag ) {
+			extern char em_mnem[][4] ;
+			printf("%s %D\n",em_mnem[ope],off1) ;
+		}
+#endif
+
+		if ( !defined && partype==PAR_G ) { /* must be external */
+			text_reloc((lnp->type1==GLOSYM ?
+					lnp->ad.ad_gp:lnp->ad.ad_df.df_gp),
+				(FOFFSET)(textbytes+afterlength-inslength) ,
+					op_curr-opchoice);
+			xputarb(inslength,off1,tfile);
+			textoff += inslength ;
+		} else {
+			genop(op_curr,off1,partype) ;
+		}
+	} /* end forloop */
+	line_num-- ;
+
+	patchcase();
+	textbytes += prog_size;
+	if ( textbytes>maxadr ) fatal("Maximum code area size exceeded") ;
+
+} /* end pass_5 */
+
+genop(startc,value,i_flag) char *startc ; cons_t value ; int i_flag ; {
+	char *currc ;
+	register flag ;
+	char opc ;
+
+	/*
+	 * Real code generation.
+	 */
+
+	currc= startc ;
+	flag = ctrunc(*currc++);
+	opc  = *currc++;
+	if ( (flag&OPTYPE)!=OPNO ) {
+
+		if ( !opfit(flag,*currc,value,i_flag) ) {
+		   fatal("parameter value unsuitable for selected opcode") ;
+		}
+		if ( flag&OPWORD ) {
+			if ( value%wordsize!=0 ) {
+				error("parameter not word multiple");
+			}
+			value /= wordsize ;
+		}
+		if ( flag&OPNZ ) {
+			if ( value<=0 ) error("negative parameter");
+			value-- ;
+		}
+	}
+	if ( flag&OPESC ) put8(ESC) ;
+
+	switch ( flag&OPTYPE ) {
+	case OPMINI :
+		opc += value<0 ? -1-value : value ;
+		break ;
+	case OPSHORT :
+		if ( value<0 ) {
+			opc += -1-(value>>8) ;
+		} else {
+			opc += value>>8 ;
+		}
+		break ;
+	case OP32 :
+	case OP64 :
+		put8(ESC_L) ;
+	}
+
+#ifdef DUMP
+	if ( c_flag ) {
+		switch(flag&OPTYPE) {
+		case OP32 :
+		case OP64 :
+			opcnt3[opc&0377]= 1 ;
+			break ;
+		default :
+			if ( flag&OPESC ) opcnt2[opc&0377]= 1 ;
+			else              opcnt1[opc&0377]= 1 ;
+			break ;
+		}
+	}
+#endif
+
+	put8(opc) ;
+	switch( flag&OPTYPE ) {
+	case OPNO:
+	case OPMINI:
+		break ;
+	case OPSHORT:
+	case OP8:
+		put8((char)value) ;
+		break ;
+	case OP16:
+		put16(int_cast value) ;
+		break ;
+	case OP32:
+		put32(value) ;
+		break ;
+	case OP64:
+		put64(value) ;
+		break ;
+	}
+}
+
+patchcase() {
+	register relc_t *r;
+	register locl_t *k;
+
+	if ( r= pstate.s_fdata ) {
+		r= r->r_next ;
+	} else {
+		r= f_data ;
+	}
+	for( ; r ; r= r->r_next ) {
+		if (r->r_typ == RELLOC) {
+			r->r_typ = RELADR;
+			k = r->r_val.rel_lp;
+			if (k->l_defined==YES)
+				r->r_val.rel_i = k->l_min + textbytes;
+			else
+				error("case label at line %d undefined",
+					k->l_min);
+		}
+	}
+}

+ 211 - 0
util/ass/ass60.c

@@ -0,0 +1,211 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+#include        "ass00.h"
+#include        "assex.h"
+#include        "ip_spec.h"
+
+#ifdef DUMP
+static  char    *typestr[] =
+     {"missing","const","procname","glosym","locsym","glosym+off","pseudo"};
+static  char    *labstr[]  = {"EMPTY","no","yes","seen","notpresent"};
+static  char    formstr[] = { 'm','s','-','1','2','4','8' };
+static  char    *r_data[] = { "null","glob","head","loc","adr" };
+
+cons_t nicepr(typ,ap) addr_u *ap; char typ; {
+	register proc_t *pl;
+
+	switch (typ) {
+		case CONST:
+			return(ap->ad_i);
+		case LOCSYM:
+			return(int_cast ap->ad_lp);
+		case GLOOFF:
+			return(ap->ad_df.df_gp - mglobs);
+		case GLOSYM:
+			return(ap->ad_gp - mglobs);
+		case PROCNAME:
+			pl = ap->ad_pp;;
+			if (pl->p_status&EXT)
+				return((pl-xprocs)+1000);
+			else
+				return(pl-mprocs);
+		default:
+			if ( typ>=VALLOW && typ<=VALHIGH ) return VAL1(typ) ;
+			break ;
+	}
+	return(0);
+}
+
+char *pflags(flg) int flg ; {
+	static char res[9] ;
+	register char *cp ;
+
+	cp=res ;
+	if ( flg&OPESC ) *cp++ = 'e' ;
+	switch ( flg&OPRANGE ) {
+	case OP_NEG : *cp++ = 'N' ; break ;
+	case OP_POS : *cp++ = 'P' ; break ;
+	}
+	if ( flg&OPWORD ) *cp++ = 'w' ;
+	if ( flg&OPNZ ) *cp++ = 'o' ;
+	*cp++ = formstr[flg&OPTYPE] ;
+	*cp++ = 0 ;
+	return res ;
+}
+
+
+dump(n)
+{
+	register glob_t *gb;
+	register line_t *ln;
+	register locl_t *lbp;
+	register locl_t *lbhead;
+	proc_t *pl;
+	int i;
+	int insno;
+	extern char em_mnem[][4] ;
+
+	if (d_flag==0) return;
+if ( (n==0 && d_flag) || (n==4 && d_flag>=2) || (n<100 && d_flag>=3) ) {
+	printf("\nEM1-assembler      *****   pass %1d complete:\n",n);
+	printf("current size %D\n",prog_size) ;
+	printf("  %9.9s%9.9s%14.14s%8.8s%8.8s\n", "instr_nr",
+		"type1","addr1","length","format");
+	for (ln = pstate.s_fline ; ln ;
+	     ln = ln->l_next, n>=3 || n==0 ? i++ : i-- ) {
+		insno = ctrunc(ln->instr_num) ;
+		if ( insno==sp_fpseu ) {
+			i= ln->ad.ad_ln.ln_first ;
+			continue ;
+		}
+		printf("%4d  ",i) ;
+		switch(insno) {
+		default:
+			printf(
+				" %3.3s",em_mnem[insno]) ;
+			break ;
+		case sp_ilb1:
+			printf("l   ");
+			break;
+		case sp_fpseu:
+			printf("p   ");
+			break;
+		}
+		printf(" %9.9s%14D",
+			typestr[ln->type1<VALLOW ? ln->type1 : CONST],
+			nicepr(ln->type1,&ln->ad)) ;
+		if ( ln->opoff != NO_OFF )
+			printf("%5d     %.6s",
+			oplength(*(ln->opoff)),pflags(*(ln->opoff)));
+		printf("\n");
+	}
+	printf("\n    %8s%8s%8s%8s%8s\n","labnum","labid","minval","maxval",
+		"defined");
+	for ( i = 0, lbhead= *pstate.s_locl ; i<LOCLABSIZE ; lbhead++,i++) {
+		if ( lbhead->l_defined!=EMPTY ) printf("%4d\n",i);
+		for (lbp= lbhead; lbp != lbp_cast 0; lbp= lbp->l_chain) {
+			if (lbp->l_defined!=EMPTY)
+				printf("    %8d%8d%8d%8d  %-s\n",
+				lbp->l_hinum*LOCLABSIZE + i,
+				int_cast lbp,lbp->l_min,
+				lbp->l_max, labstr[lbp->l_defined]);
+		}
+	}
+}
+if ( ( (n==0 || n>=100) && d_flag) || (n<=1 && d_flag>=2) ) {
+	if ( n==0 || n==100 ) {
+		printf("File %s",curfile) ;
+		if ( archmode ) printf("(%.14s)",archhdr.ar_name);
+		printf(" :\n\n") ;
+	}
+	printf("Local data labels:\n");
+	printf(
+	   "\n\t%8.8s  %8.8s  %8.8s\n","g_name","g_status","g_addr");
+	for (gb = mglobs,i = 0;gb < &mglobs[oursize->n_mlab]; gb++, i++)
+	    if (gb->g_name[0] != 0) {
+		printf("%5d\t%8.6s",i,gb->g_name);
+		printf("  %8o  %8ld\n",gb->g_status,gb->g_val.g_addr);
+	    }
+	printf("\n\nGlobal data labels\n");
+	printf("\n\t%8.8s  %8.8s  %8.8s\n",
+		"g_name","g_status","g_addr");
+	for (gb = xglobs,i = 0;gb < &xglobs[oursize->n_glab]; gb++, i++)
+	    if (gb->g_name[0] != 0) {
+		printf("%5d\t%8.6s",i,gb->g_name);
+		printf("  %8o  %8ld\n",gb->g_status,gb->g_val.g_addr);
+	    }
+	printf("\n\nLocal procedures\n");
+	printf("\n\t%8.8s%8s%8s\t%8s%8s\n",
+		"name","status","num","off","locals");
+	for (pl=mprocs;pl< &mprocs[oursize->n_mproc]; pl++)
+	    if (pl->p_name[0]) {
+		printf("%4d\t%-8s%8o%8d",
+			pl-mprocs,pl->p_name,pl->p_status,pl->p_num);
+		if (pl->p_status&DEF)
+			printf("\t%8ld%8ld",proctab[pl->p_num].pr_off,
+				proctab[pl->p_num].pr_loc);
+		printf("\n");
+	}
+	printf("\nGlobal procedures\n");
+	printf("\n\t%8s%8s%8s\t%8s%8s\n",
+		"name","status","num","off","locals");
+	for (pl=xprocs;pl< &xprocs[oursize->n_xproc]; pl++)
+	    if (pl->p_name[0]) {
+		printf("%4d\t%-8s%8o%8d",
+			pl-xprocs,pl->p_name,pl->p_status,pl->p_num);
+		if (pl->p_status&DEF)
+			printf("\t%8ld%8ld",proctab[pl->p_num].pr_off,
+				proctab[pl->p_num].pr_loc);
+		printf("\n");
+	}
+	if ( r_flag ) {
+		register relc_t *rl ;
+		printf("\nData relocation\n") ;
+		printf("\n\t%10s %10s %10s\n","offset","type","value");
+		for ( rl=f_data ; rl ; rl= rl->r_next ) {
+			printf("\t%10D %10s ",rl->r_off,r_data[rl->r_typ]);
+			switch(rl->r_typ) {
+			case RELADR:
+			case RELHEAD:
+				printf("%10D\n",rl->r_val.rel_i) ;
+				break ;
+			case RELGLO:
+				printf("%8.8s\n",rl->r_val.rel_gp->g_name) ;
+				break ;
+			case RELLOC:
+				printf("%10d\n",rl->r_val.rel_lp) ;
+				break ;
+			case RELNULL:
+				printf("\n"); break ;
+			}
+		}
+		printf("\n\nText relocation\n") ;
+		printf("\n\t%10s %10s %10s\n","offset","flags","value");
+		for ( rl=f_text; rl ; rl= rl->r_next ) {
+			printf("\t%10D %10s ",
+			 rl->r_off,pflags(opchoice[rl->r_typ&~RELMNS])) ;
+			if ( rl->r_typ&RELMNS )
+				printf("%10D\n",rl->r_val.rel_i) ;
+			else    printf("\n") ;
+		}
+	}
+
+
+}
+}
+#endif

+ 341 - 0
util/ass/ass70.c

@@ -0,0 +1,341 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+#include        "ass00.h"
+#include        "assex.h"
+/*
+** utilities of EM1-assembler/loader
+*/
+
+static int globstep;
+
+/*
+ * glohash returns an index in table and leaves a stepsize in globstep
+ *
+ */
+
+static int glohash(aname,size) char *aname; {
+	register char *p;
+	register i;
+	register sum;
+
+	/*
+	 * Computes a hash-value from a string.
+	 * Algorithm is adding all the characters after shifting some way.
+	 */
+
+	for(sum=i=0,p=aname;*p;i += 3)
+		sum += (*p++)<<(i&07);
+	sum &= 077777;
+	globstep = (sum / size) + 7;
+	return(sum % size);
+}
+
+/*
+ * lookup idname in labeltable , if it is not there enter it
+ * return index in labeltable
+ */
+
+glob_t *glo2lookup(name,status) char *name; {
+
+	return(glolookup(name,status,mglobs,oursize->n_mlab));
+}
+
+glob_t *xglolookup(name,status) char *name; {
+
+	return(glolookup(name,status,xglobs,oursize->n_glab));
+}
+
+static void findext(g) glob_t *g ; {
+	glob_t *x;
+
+	x = xglolookup(g->g_name,ENTERING);
+	if (x && (x->g_status&DEF)) {
+		g->g_status |= DEF;
+		g->g_val.g_addr = x->g_val.g_addr;
+	}
+	g->g_status |= EXT;
+}
+
+glob_t *glolookup(name,status,table,size)
+char *name;     /* name */
+int status;     /* kind of lookup */
+glob_t *table;  /* which table to use */
+int size;       /* size for hash */
+{
+	register glob_t *g;
+	register rem,j;
+	int new;
+
+	/*
+	 * lookup global symbol name in specified table.
+	 * Various actions are taken depending on status.
+	 *
+	 * DEFINING:
+	 *      Lookup or enter the symbol, check for mult. def.
+	 * OCCURRING:
+	 *      Lookup the symbol, export if not known.
+	 * INTERNING:
+	 *      Enter symbol local to the module.
+	 * EXTERNING:
+	 *      Enter symbol visable from every module.
+	 * SEARCHING:
+	 *      Lookup the symbol, return 0 if not found.
+	 * ENTERING:
+	 *      Lookup or enter the symbol, don't check
+	 */
+
+	rem = glohash(name,size);
+	j = 0; new=0;
+	g = &table[rem];
+	while (g->g_name[0] != 0 && strcmp(name,g->g_name) != 0) {
+		j++;
+		if (j>size)
+			fatal("global label table overflow");
+		rem = (rem + globstep) % size;
+		g = &table[rem];
+	}
+	if (g->g_name[0] == 0) {
+		/*
+		 * This symbol is shining new.
+		 * Enter it in table except for status = SEARCHING
+		 */
+		if (status == SEARCHING)
+			return(0);
+		strcpy(g->g_name,name);
+		g->g_status = 0;
+		g->g_val.g_addr=0;
+		new++;
+	}
+	switch(status) {
+	case SEARCHING: /* nothing special */
+	case ENTERING:
+		break;
+	case INTERNING:
+		if (!new)
+			werror("INA must be first occurrence of '%s'",name);
+		break;
+	case EXTERNING:          /* lookup in other table */
+		/*
+		 * The If statement is removed to be friendly
+		 * to Backend writers having to deal with assemblers
+		 * not following our conventions.
+		if (!new)
+			error("EXA must be first occurrence of '%s'",name);
+		*/
+		findext(g);
+		break;
+	case DEFINING:  /* Thou shalt not redefine */
+		if (g->g_status&DEF)
+			error("global symbol '%s' redefined",name);
+		g->g_status |= DEF;
+		break;
+	case OCCURRING:
+		if ( new )
+			findext(g);
+		g->g_status |= OCC;
+		break;
+	default:
+		fatal("bad status in glolookup");
+	}
+	return(g);
+}
+
+locl_t *loclookup(an,status) {
+	register locl_t *lbp,*l_lbp;
+	register unsigned num;
+	char hinum;
+
+	if ( !pstate.s_locl ) fatal("label outside procedure");
+	num = an;
+	if ( num/LOCLABSIZE>255 ) fatal("local label number too large");
+	hinum = num/LOCLABSIZE;
+	l_lbp= lbp= &(*pstate.s_locl)[num%LOCLABSIZE];
+	if ( lbp->l_defined==EMPTY ) {
+		lbp= lbp_cast 0 ;
+	} else {
+		while ( lbp!= lbp_cast 0 && lbp->l_hinum != hinum ) {
+			l_lbp = lbp ;
+			lbp = lbp->l_chain;
+		}
+	}
+	if ( lbp == lbp_cast 0 ) {
+		if ( l_lbp->l_defined!=EMPTY ) {
+			lbp = lbp_cast getarea(sizeof *lbp);
+			l_lbp->l_chain= lbp ;
+		} else lbp= l_lbp ;
+		lbp->l_chain= lbp_cast 0 ;
+		lbp->l_hinum=hinum;
+		lbp->l_defined = (status==OCCURRING ? NO : YES);
+		lbp->l_min= line_num;
+	} else
+		if (status == DEFINING) {
+			if (lbp->l_defined == YES)
+				error("multiple defined local symbol");
+			else
+				lbp->l_defined = YES;
+		}
+	if ( status==DEFINING ) lbp->l_min= line_num ;
+	return(lbp);
+}
+
+proc_t *prolookup(name,status) char *name; {
+	register proc_t *p;
+	register pstat;
+
+	/*
+	 * Look up a procedure name according to status
+	 *
+	 * PRO_OCC:     Occurrence
+	 *      Search both tables, local table first.
+	 *      If not found, enter in global table
+	 * PRO_INT:     INP
+	 *      Enter symbol in local table.
+	 * PRO_DEF:     Definition
+	 *      Define local procedure.
+	 * PRO_EXT:     EXP
+	 *      Enter symbol in global table.
+	 *
+	 *      The EXT bit in this table indicates the the name is used
+	 *      as external in this module.
+	 */
+
+	switch(status) {
+	case PRO_OCC:
+		p = searchproc(name,mprocs,oursize->n_mproc);
+		if (p->p_name[0]) {
+			p->p_status |= OCC;
+			return(p);
+		}
+		p = searchproc(name,xprocs,oursize->n_xproc);
+		if (p->p_name[0]) {
+			p->p_status |= OCC;
+			return(p);
+		}
+		pstat = OCC|EXT;
+		unresolved++ ;
+		break;
+	case PRO_INT:
+		p = searchproc(name,xprocs,oursize->n_xproc);
+		if (p->p_name[0] && (p->p_status&EXT) )
+			error("pro '%s' conflicting use",name);
+
+		p = searchproc(name,mprocs,oursize->n_mproc);
+		if (p->p_name[0])
+			werror("INP must be first occurrence of '%s'",name);
+		pstat = 0;
+		break;
+	case PRO_EXT:
+		p = searchproc(name,mprocs,oursize->n_mproc);
+		if (p->p_name[0])
+			error("pro '%s' exists already localy",name);
+		p = searchproc(name,xprocs,oursize->n_xproc);
+		if (p->p_name[0]) {
+			/*
+			 * The If statement is removed to be friendly
+			 * to Backend writers having to deal with assemblers
+			 * not following our conventions.
+			if ( p->p_status&EXT )
+				werror("EXP must be first occurrence of '%s'",
+					name) ;
+			 */
+			p->p_status |= EXT;
+			return(p);
+		}
+		pstat = EXT;
+		unresolved++;
+		break;
+	case PRO_DEF:
+		p = searchproc(name,xprocs,oursize->n_xproc);
+		if (p->p_name[0] && (p->p_status&EXT) ) {
+			if (p->p_status&DEF)
+				error("global pro '%s' redeclared",name);
+			else
+				unresolved-- ;
+			p->p_status |= DEF;
+			return(p);
+		} else {
+			p = searchproc(name,mprocs,oursize->n_mproc);
+			if (p->p_name[0]) {
+				if (p->p_status&DEF)
+					error("local pro '%s' redeclared",
+						name);
+				p->p_status |= DEF;
+				return(p);
+			}
+		}
+		pstat = DEF;
+		break;
+	default:
+		fatal("bad status in prolookup");
+	}
+	return(enterproc(name,pstat,p));
+}
+
+proc_t *searchproc(name,table,size)
+	char *name;
+	proc_t *table;
+	int size;
+{
+	register proc_t *p;
+	register rem,j;
+
+	/*
+	 * return a pointer into table to the place where the procedure
+	 * name is or should be if in the table.
+	 */
+
+	rem = glohash(name,size);
+	j = 0;
+	p = &table[rem];
+	while (p->p_name[0] != 0 && strcmp(name,p->p_name) != 0) {
+		j++;
+		if (j>size)
+			fatal("procedure table overflow");
+		rem = (rem + globstep) % size;
+		p = &table[rem];
+	}
+	return(p);
+}
+
+proc_t *enterproc(name,status,place)
+char *name;
+char status;
+proc_t *place; {
+	register proc_t *p;
+
+	/*
+	 * Enter the procedure name into the table at place place.
+	 * Place had better be computed by searchproc().
+	 *
+	 * NOTE:
+	 *      At this point the procedure gets assigned a number.
+	 *      This number is used as a parameter of cal and in some
+	 *      other ways. There exists a 1-1 correspondence between
+	 *      procedures and numbers.
+	 *      Two local procedures with the same name in different
+	 *      modules have different numbers.
+	 */
+
+	p=place;
+	strcpy(p->p_name,name);
+	p->p_status = status;
+	if (procnum>=oursize->n_proc)
+		fatal("too many procedures");
+	p->p_num = procnum++;
+	return(p);
+}

+ 412 - 0
util/ass/ass80.c

@@ -0,0 +1,412 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+#include        "ass00.h"
+#include        "assex.h"
+#include        "../../h/em_path.h"
+
+/*
+ * this file contains several library routines.
+ */
+
+zero(area,length) char *area; unsigned length ; {
+	register char *p;
+	register n;
+	/*
+	 * Clear area of length bytes.
+	 */
+	if ((n=length)==0)
+		return;
+	p = area;
+	do *p++=0; while (--n);
+}
+
+/* VARARGS1 */
+static void pr_error(string1,a1,a2,a3,a4) char *string1 ; {
+	/*
+	 * diagnostic output
+	 */
+	fprintf(stderr,"%s: ",progname);
+	if (curfile) {
+		fprintf(stderr,"file %s",curfile);
+		if (archmode)
+			fprintf(stderr," (%.14s)",archhdr.ar_name);
+		fprintf(stderr,": ");
+	}
+	if ( pstate.s_curpro ) {
+		fprintf(stderr,"proc %s, ",pstate.s_curpro->p_name);
+	}
+	fprintf(stderr,"line %d: ",line_num);
+	fprintf(stderr,string1,a1,a2,a3,a4);
+	fprintf(stderr,"\n");
+}
+
+/* VARARGS1 */
+void error(string1,a1,a2,a3,a4) char *string1 ; {
+	pr_error(string1,a1,a2,a3,a4) ;
+	nerrors++ ;
+}
+
+/* VARARGS1 */
+void werror(string1,a1,a2,a3,a4) char *string1 ; {
+	if ( wflag ) return ;
+	pr_error(string1,a1,a2,a3,a4) ;
+}
+
+fatal(s) char *s; {
+	/*
+	 * handle fatal errors
+	 */
+	error("Fatal error: %s",s);
+	dump(0);
+	exit(-1);
+}
+
+#ifndef CPM
+FILE *frewind(f) FILE *f ; {
+	/* Rewind a file open for writing and open it for reading */
+	/* Assumption, file descriptor is r/w */
+	register FILE *tmp ;
+	rewind(f);
+	tmp=fdopen(dup(fileno(f)),"r");
+	fclose(f);
+	return tmp ;
+}
+#endif
+
+int xgetc(af) register FILE *af; {
+	register int nextc;
+	/*
+	 * read next character; fatal if there isn't one
+	 */
+	nextc=fgetc(af) ;
+	if ( feof(af) )
+			fatal("unexpected end of file");
+	return nextc ;
+}
+
+xputc(c,af) register FILE *af; {
+	/* output one character and scream if it gives an error */
+	fputc(c,af) ;
+	if ( ferror(af) ) fatal("write error") ;
+}
+
+
+putblk(stream,from,amount)
+	register FILE *stream; register char *from ; register int amount ; {
+
+	for ( ; amount-- ; from++ ) {
+		fputc(*from,stream) ;
+		if ( ferror(stream) ) fatal("write error") ;
+	}
+}
+
+int getblk(stream,from,amount)
+	register FILE *stream; register char *from ; register int amount ; {
+
+	for ( ; amount-- ; from++ ) {
+		*from = fgetc(stream) ;
+		if ( feof(stream) ) return 1 ;
+	}
+	return 0 ;
+}
+
+xput16(w,f) FILE *f; {
+	/*
+	 * two times xputc
+	 */
+	xputc(w,f);
+	xputc(w>>8,f);
+}
+
+xputarb(l,w,f) int l ; cons_t w ; FILE *f ; {
+	while ( l-- ) {
+		xputc( int_cast w,f) ;
+		w >>=8 ;
+	}
+}
+
+put8(n) {
+	xputc(n,tfile);
+	textoff++;
+}
+
+put16(n) {
+	/*
+	 * note reversed order of bytes.
+	 * this is done for faster interpretation.
+	 */
+	xputc(n>>8,tfile);
+	xputc(n&0377,tfile);
+	textoff += 2;
+}
+
+put32(n) cons_t n ; {
+	put16( int_cast (n>>16)) ;
+	put16( int_cast n) ;
+}
+
+put64(n) cons_t n ; {
+	fatal("put64 called") ;
+}
+
+int xget8() {
+	/*
+	 * Read one byte from ifile.
+	 */
+	if (libeof && inpoff >= libeof)
+		return EOF ;
+	inpoff++;
+	return fgetc(ifile) ;
+}
+
+unsigned get8() {
+	register int nextc;
+	/*
+	 * Read one byte from ifile.
+	 */
+	nextc=xget8();
+	if ( nextc==EOF ) {
+		if (libeof)
+			fatal("Tried to read past end of arentry\n");
+		else
+			fatal("end of file on input");
+	}
+	return nextc ;
+}
+
+cons_t xgetarb(l,f) int l; FILE *f ; {
+	cons_t val ;
+	register int shift ;
+
+	shift=0 ; val=0 ;
+	while ( l-- ) {
+		val += ((cons_t)ctrunc(xgetc(f)))<<shift ;
+		shift += 8 ;
+	}
+	return val ;
+}
+
+ext8(b) {
+	/*
+	 * Handle one byte of data.
+	 */
+	++dataoff;
+	xputc(b,dfile);
+}
+
+extword(w) cons_t w ; {
+	/* Assemble the word constant w.
+	 * NOTE: The bytes are written low to high.
+	 */
+	register i ;
+	for ( i=wordsize ; i-- ; ) {
+		ext8( int_cast w) ;
+		w >>= 8 ;
+	}
+}
+
+extarb(size,value) int size ; long value ; {
+	/* Assemble the 'size' constant value.
+	 * The bytes are again written low to high.
+	 */
+	register i ;
+	for ( i=size ; i-- ; ) {
+		ext8( int_cast value ) ;
+		value >>=8 ;
+	}
+}
+
+extadr(a) cons_t a ; {
+	/* Assemble the word constant a.
+	 * NOTE: The bytes are written low to high.
+	 */
+	register i ;
+	for ( i=ptrsize ; i-- ; ) {
+		ext8( int_cast a) ;
+		a >>= 8 ;
+	}
+}
+
+xputa(a,f) cons_t a ; FILE *f ; {
+	/* Assemble the pointer constant a.
+	 * NOTE: The bytes are written low to high.
+	 */
+	register i ;
+	for ( i=ptrsize ; i-- ; ) {
+		xputc( int_cast a,f) ;
+		a >>= 8 ;
+	}
+}
+
+cons_t xgeta(f) FILE *f ; {
+	/* Read the pointer constant a.
+	 * NOTE: The bytes were written low to high.
+	 */
+	register i, shift ;
+	cons_t val ;
+	val = 0 ; shift=0 ;
+	for ( i=ptrsize ; i-- ; ) {
+		val += ((cons_t)xgetc(f))<<shift ;
+		shift += 8 ;
+	}
+	return val ;
+}
+
+#define MAXBYTE 255
+
+int icount(size) {
+	int amount ;
+	amount=(dataoff-lastoff)/size ;
+	if ( amount>MAXBYTE) fatal("Descriptor overflow");
+	return amount ;
+}
+
+setmode(mode) {
+
+	if (datamode==mode) {   /* in right mode already */
+		switch ( datamode ) {
+		case DATA_CONST:
+			if ( (dataoff-lastoff)/wordsize < MAXBYTE ) return ;
+			break ;
+		case DATA_BYTES:
+			if ( dataoff-lastoff < MAXBYTE ) return ;
+			break ;
+		case DATA_IPTR:
+		case DATA_DPTR:
+			if ( (dataoff-lastoff)/ptrsize < MAXBYTE ) return ;
+			break ;
+		case DATA_ICON:
+		case DATA_FCON:
+		case DATA_UCON:
+			break ;
+		default:
+			return ;
+		}
+		setmode(DATA_NUL) ; /* flush current descriptor */
+		setmode(mode) ;
+		return;
+	}
+	switch(datamode) {              /* terminate current mode */
+	case DATA_NUL:
+		break;                  /* nothing to terminate */
+	case DATA_CONST:
+		lastheader->r_val.rel_i=icount(wordsize) ;
+		lastheader->r_typ = RELHEAD;
+		datablocks++;
+		break;
+	case DATA_BYTES:
+		lastheader->r_val.rel_i=icount(1) ;
+		lastheader->r_typ = RELHEAD;
+		datablocks++;
+		break;
+	case DATA_DPTR:
+	case DATA_IPTR:
+		lastheader->r_val.rel_i=icount(ptrsize) ;
+		lastheader->r_typ = RELHEAD;
+		datablocks++;
+		break;
+	default:
+		datablocks++;
+		break;
+	}
+	datamode=mode;
+	switch(datamode) {
+	case DATA_NUL:
+		break;
+	case DATA_CONST:
+		ext8(HEADCONST);
+		lastheader=data_reloc( chp_cast 0,dataoff,RELNULL);
+		ext8(0);
+		lastoff=dataoff;
+		break;
+	case DATA_BYTES:
+		ext8(HEADBYTE);
+		lastheader=data_reloc( chp_cast 0,dataoff,RELNULL);
+		ext8(0);
+		lastoff=dataoff;
+		break;
+	case DATA_IPTR:
+		ext8(HEADIPTR);
+		lastheader=data_reloc( chp_cast 0,dataoff,RELNULL);
+		ext8(0);
+		lastoff=dataoff;
+		break;
+	case DATA_DPTR:
+		ext8(HEADDPTR);
+		lastheader=data_reloc( chp_cast 0,dataoff,RELNULL);
+		ext8(0);
+		lastoff=dataoff;
+		break;
+	case DATA_ICON:
+		ext8(HEADICON) ;
+		ext8( int_cast consiz) ;
+		break;
+	case DATA_FCON:
+		ext8(HEADFCON) ;
+		ext8( int_cast consiz) ;
+		break;
+	case DATA_UCON:
+		ext8(HEADUCON) ;
+		ext8( int_cast consiz) ;
+		break;
+	case DATA_REP:
+		ext8(HEADREP) ;
+		break ;
+	default:
+		fatal("Unknown mode in setmode") ;
+	}
+}
+
+#ifndef CPM
+int tmpfil() {
+	register char *fname, *cpname ;
+	char *sfname;
+	register fildes,pid;
+	static char name[80] = TMP_DIR ;
+	int count;
+	/*
+	 * This procedure returns a file-descriptor of a temporary
+	 * file valid for reading and writing.
+	 * After closing the tmpfil-descriptor the file is lost
+	 * Calling this routine frees the program from generating uniqe names.
+	 */
+	sfname = fname = "tmp.00000";
+	count = 10;
+	pid = getpid();
+	fname += 4;
+	while (pid!=0) {
+		*fname++ = (pid&07) + '0';
+		pid >>= 3;
+	}
+	*fname = 0;
+	for ( fname=name ; *fname ; fname++ ) ;
+	cpname=sfname ;
+	while ( *fname++ = *cpname++ ) ;
+	do {
+		fname = name;
+		if ((fildes = creat(fname, 0600)) < 0)
+			if ((fildes = creat(fname=sfname, 0600)) < 0)
+				return(-1);
+		if (close(fildes) < 0)
+			;
+	} while((fildes = open(fname, 2)) < 0 && count--);
+	if (unlink(fname) < 0)
+		;
+	return(fildes);
+}
+#endif

+ 847 - 0
util/ass/assci.c

@@ -0,0 +1,847 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+#include        "ass00.h"
+#include        "assex.h"
+#include        "../../h/em_mes.h"
+#include        "../../h/em_pseu.h"
+#include        "../../h/em_ptyp.h"
+
+/*
+ * read compact code and fill in tables
+ */
+
+static  int     tabval;
+static  cons_t  argval;
+
+static  int     oksizes;        /* MES EMX,.,. seen */
+
+static  enum    m_type { CON, ROM, HOLBSS }     memtype ;
+static  int     valtype;        /* Transfer of type information between
+				   valsize ans putval
+				*/
+
+int table3(i) {
+
+	switch(i) {
+	case sp_ilb1:
+		tabval = get8();
+		break;
+	case sp_dlb1:
+		make_string(get8());
+		i= sp_dnam;
+		break;
+	case sp_dlb2:
+		tabval = get16();
+		if ( tabval<0 ) {
+			error("illegal data label .%d",tabval);
+			tabval=0 ;
+		}
+		make_string(tabval);
+		i= sp_dnam;
+		break;
+	case sp_cst2:
+		argval = get16();
+		break;
+	case sp_ilb2:
+		tabval = get16();
+		if ( tabval<0 ) {
+			error("illegal instruction label %d",tabval);
+			tabval=0 ;
+		}
+		i = sp_ilb1;
+		break;
+	case sp_cst4:
+		i = sp_cst2;
+		argval = get32();
+		break;
+	case sp_dnam:
+	case sp_pnam:
+		inident();
+		break ;
+	case sp_scon:
+		getstring() ;
+		break;
+	case sp_doff:
+		getarg(sym_ptyp);
+		getarg(cst_ptyp);
+		break;
+	case sp_icon:
+	case sp_ucon:
+	case sp_fcon:
+		getarg(cst_ptyp);
+		consiz = argval;
+		if ( consiz<wordsize ?
+			wordsize%consiz!=0 : consiz%wordsize!=0 ) {
+			fatal("illegal object size") ;
+		}
+		getstring();
+		break;
+	}
+	return(i);
+}
+
+int get16() {
+	register int l_byte, h_byte;
+
+	l_byte = get8();
+	h_byte = get8();
+	if ( h_byte>=128 ) h_byte -= 256 ;
+	return l_byte | (h_byte*256) ;
+}
+
+cons_t get32() {
+	register cons_t l;
+	register int h_byte;
+
+	l = get8(); l |= (unsigned)get8()*256 ; l |= get8()*256L*256L ;
+	h_byte = get8() ;
+	if ( h_byte>=128 ) h_byte -= 256 ;
+	return l | (h_byte*256L*256*256L) ;
+}
+
+int table1() {
+	register i;
+
+	i = xget8();
+	if (i < sp_fmnem+sp_nmnem && i >= sp_fmnem) {
+		tabval = i-sp_fmnem;
+		return(sp_fmnem);
+	}
+	if (i < sp_fpseu+sp_npseu && i >= sp_fpseu) {
+		tabval = i;
+		return(sp_fpseu);
+	}
+	if (i < sp_filb0+sp_nilb0 && i >= sp_filb0) {
+		tabval = i - sp_filb0;
+		return(sp_ilb1);
+	}
+	return(table3(i));
+}
+
+int table2() {
+	register i;
+
+	i = get8();
+	if (i < sp_fcst0+sp_ncst0 && i >= sp_fcst0) {
+		argval = i - sp_zcst0;
+		return(sp_cst2);
+	}
+	return(table3(i));
+}
+
+int getarg(typset) {
+	register t,argtyp;
+
+	argtyp = t = table2();
+	t -= sp_fspec;
+	t = 1 << t;
+	if ((typset & t) == 0)
+		error("bad argument type %d",argtyp);
+	return(argtyp);
+}
+
+cons_t getint() {
+	getarg(cst_ptyp);
+	return(argval);
+}
+
+glob_t *getlab(status) {
+	getarg(sym_ptyp);
+	return(glo2lookup(string,status));
+}
+
+char *inproname() {
+	getarg(ptyp(sp_pnam));
+	return(string);
+}
+
+int needed() {
+	register glob_t *g;
+	register proc_t *p;
+
+	for(;;){
+		switch ( table2() ) {
+		case sp_dnam :
+			if (g = xglolookup(string,SEARCHING)) {
+				if ((g->g_status&DEF) != 0)
+					continue ;
+			} else continue ;
+			break ;
+		case sp_pnam :
+			p = searchproc(string,xprocs,oursize->n_xproc);
+			if (p->p_name[0]) {
+				if ((p->p_status & DEF) != 0)
+					continue ;
+			} else continue ;
+			break ;
+		default :
+			error("Unexpected byte after ms_ext") ;
+		case sp_cend :
+			return FALSE ;
+		}
+		while ( table2()!=sp_cend ) ;
+		return TRUE ;
+	}
+}
+
+cons_t valsize() {
+	switch(valtype=table2()) { /* valtype is used by putval */
+	case sp_cst2:
+		return wordsize ;
+	case sp_ilb1:
+	case sp_dnam:
+	case sp_doff:
+	case sp_pnam:
+		return ptrsize ;
+	case sp_scon:
+		return strlngth ;
+	case sp_fcon:
+	case sp_icon:
+	case sp_ucon:
+		return consiz ;
+	case sp_cend:
+		return 0 ;
+	default:
+		fatal("value expected") ;
+		/* NOTREACHED */
+	}
+}
+
+newline(type) {
+	register line_t *n_lnp ;
+
+	if ( type>VALLOW ) type=VALLOW ;
+	n_lnp = lnp_cast getarea((unsigned)linesize[type]) ;
+	n_lnp->l_next = pstate.s_fline ;
+	pstate.s_fline = n_lnp ;
+	n_lnp->type1 = type ;
+	n_lnp->opoff = NO_OFF ;
+}
+
+read_compact() {
+
+	/*
+	 * read module in compact EM1 code
+	 */
+	init_module();
+	pass = 1;
+	eof_seen = 0;
+	do {
+		compact_line() ;
+		line_num++;
+	} while (!eof_seen) ;
+	endproc() ; /* Throw away unwanted garbage */
+	if ( mod_sizes ) end_module();
+		/* mod_sizes is only false for rejected library modules */
+}
+
+int compact_line() {
+	register instr_no ;
+
+	/*
+	 * read one "line" of compact code.
+	 */
+	curglosym=0;
+	switch (table1()) {
+	default:
+		fatal("unknown byte at start of \"line\""); /* NOTREACHED */
+	case EOF:
+		eof_seen++ ;
+		while ( pstate.s_prevstat != pst_cast 0 ) {
+			error("missing end") ; do_proc() ;
+		}
+		return ;
+	case sp_fmnem:
+		if ( pstate.s_curpro == prp_cast 0) {
+			error("instruction outside procedure");
+		}
+		instr_no = tabval;
+		if ( (em_flag[instr_no]&EM_PAR)==PAR_NO ) {
+			newline(MISSING) ;
+			pstate.s_fline->instr_num= instr_no ;
+			return ;
+		}
+		/*
+		 * This instruction should have an opcode, so read it after
+		 * this switch.
+		 */
+		break;
+	case sp_dnam:
+		chkstart() ;
+		align(wordsize) ;
+		curglosym = glo2lookup(string,DEFINING);
+		curglosym->g_val.g_addr = databytes;
+		lastglosym = curglosym;
+		setline() ; line_num++ ;
+		if (table1() != sp_fpseu)
+			fatal("no pseudo after global label");
+	case sp_fpseu:
+		inpseudo(tabval);
+		setline() ;
+		return ;
+	case sp_ilb1:
+		newline(LOCSYM) ;
+		pstate.s_fline->ad.ad_lp = loclookup(tabval,DEFINING);
+		pstate.s_fline->instr_num = sp_ilb1;
+		return ;
+	}
+
+	/*
+	 * Now process argument
+	 */
+
+	switch(table2()) {
+	default:
+		fatal("unknown byte at start of argument"); /*NOTREACHED*/
+	case sp_cst2:
+		if ( (em_flag[instr_no]&EM_PAR)==PAR_B ) {
+			/* value indicates a label */
+			newline(LOCSYM) ;
+			pstate.s_fline->ad.ad_lp=
+				loclookup((int)argval,OCCURRING) ;
+		} else {
+			if ( argval>=VAL1(VALLOW) && argval<=VAL1(VALHIGH)) {
+				newline(VALLOW) ;
+				pstate.s_fline->type1 = argval+VALMID ;
+			} else {
+				newline(CONST) ;
+				pstate.s_fline->ad.ad_i = argval;
+				pstate.s_fline->type1 = CONST;
+			}
+		}
+		break;
+	case sp_ilb1:
+		newline(LOCSYM) ;
+		pstate.s_fline->ad.ad_lp = loclookup(tabval,OCCURRING);
+		break;
+	case sp_dnam:
+		newline(GLOSYM) ;
+		pstate.s_fline->ad.ad_gp = glo2lookup(string,OCCURRING);
+		break;
+	case sp_pnam:
+		newline(PROCNAME) ;
+		pstate.s_fline->ad.ad_pp=prolookup(string,PRO_OCC);
+		break;
+	case sp_cend:
+		if ( (em_flag[instr_no]&EM_PAR)!=PAR_W ) {
+			fatal("missing operand") ;
+		}
+		newline(MISSING) ;
+		break ;
+	case sp_doff:
+		newline(GLOOFF) ;
+		pstate.s_fline->ad.ad_df.df_i = argval ;
+		pstate.s_fline->ad.ad_df.df_gp= glo2lookup(string,OCCURRING) ;
+		break ;
+	}
+	pstate.s_fline->instr_num= instr_no ;
+	return ;
+}
+
+inpseudo(instr_no) {
+	cons_t cst;
+	register proc_t *prptr;
+	cons_t objsize;
+	cons_t par1,par2;
+	register char *pars;
+
+	/*
+	 * get operands of pseudo (if needed) and process it.
+	 */
+
+	switch ( ctrunc(instr_no) ) {
+	case ps_bss:
+		chkstart() ;
+		typealign(HOLBSS) ;
+		cst = getint();   /* number of bytes */
+		extbss(cst);
+		break;
+	case ps_hol:
+		chkstart() ;
+		typealign(HOLBSS) ;
+		holsize=getint();
+		holbase=databytes;
+		extbss(holsize);
+		break;
+	case ps_rom:
+	case ps_con:
+		chkstart() ;
+		typealign( ctrunc(instr_no)==ps_rom ? ROM : CON ) ;
+		while( (objsize=valsize())!=0 ) {
+			sizealign(objsize) ;
+			putval() ;
+			databytes+=objsize ;
+		}
+		break;
+	case ps_end:
+		prptr= pstate.s_curpro ;
+		if ( prptr == prp_cast 0 ) fatal("unexpected END") ;
+		proctab[prptr->p_num].pr_off = textbytes;
+		if (procflag) {
+			printf("%6lu\t%6lo\t%5d\t%-12s\t%s",
+				textbytes,textbytes,
+					prptr->p_num,prptr->p_name,curfile);
+			if (archmode)
+				printf("(%.14s)",archhdr.ar_name);
+			printf("\n");
+		}
+		par2 = proctab[prptr->p_num].pr_loc ;
+		if ( getarg(cst_ptyp|ptyp(sp_cend))==sp_cend ) {
+			if ( par2 == -1 ) {
+				fatal("size of local area unspecified") ;
+			}
+		} else {
+			if ( par2 != -1 && argval!=par2 ) {
+				fatal("inconsistent local area size") ;
+			}
+			proctab[prptr->p_num].pr_loc = argval ;
+		}
+		setline();
+		do_proc();
+		break;
+	case ps_mes:
+		switch( int_cast getint() ) {
+		case ms_err:
+			error("module with error") ; ertrap();
+			/* NOTREACHED */
+		case ms_emx:
+			if ( oksizes ) {
+				if ( wordsize!=getint() ) {
+					fatal("Inconsistent word size");
+				}
+				if ( ptrsize!=getint() ) {
+					fatal("Inconsistent pointer size");
+				}
+			} else {
+				oksizes++ ;
+				wordsize=getint();ptrsize=getint();
+				if ( wordsize!=2 && wordsize!=4 ) {
+					fatal("Illegal word size");
+				}
+				if ( ptrsize!=2 && ptrsize!=4 ) {
+					fatal("Illegal pointer size");
+				}
+				setsizes() ;
+			}
+			++mod_sizes ;
+			break;
+		case ms_src:
+			break;
+		case ms_flt:
+			intflags |= 020; break;  /*floats used*/
+		case ms_ext:
+			if ( !needed() ) {
+				eof_seen++ ;
+			}
+			if ( line_num!=1 ) {
+				werror("mes ms_ext must be first pseudo") ;
+			}
+			return ;
+		}
+		while (table2() != sp_cend)
+			;
+		break;
+	case ps_exc:
+		par1 = getint();
+		par2 = getint();
+		if (par1 == 0 || par2 == 0)
+			break;
+		exchange((int)par2,(int)par1) ;
+		break;
+	case ps_exa:
+		getlab(EXTERNING);
+		break;
+	case ps_ina:
+		getlab(INTERNING);
+		break;
+	case ps_pro:
+		chkstart() ;
+		initproc();
+		pars = inproname();
+		if ( getarg(cst_ptyp|ptyp(sp_cend))==sp_cend ) {
+			par2 = -1 ;
+		} else {
+			par2 = argval ;
+		}
+		prptr = prolookup(pars,PRO_DEF);
+		proctab[prptr->p_num].pr_loc = par2;
+		pstate.s_curpro=prptr;
+		break;
+	case ps_inp:
+		prptr = prolookup(inproname(),PRO_INT);
+		break;
+	case ps_exp:
+		prptr = prolookup(inproname(),PRO_EXT);
+		break;
+	default:
+		fatal("unknown pseudo");
+	}
+	if ( !mod_sizes ) fatal("Missing size specification");
+	if ( databytes>maxadr ) error("Maximum data area size exceeded") ;
+}
+
+setline() {
+
+	/* Get line numbers correct */
+
+	if ( pstate.s_fline &&
+	     ctrunc(pstate.s_fline->instr_num) == sp_fpseu ) {
+		/* Already one present */
+		pstate.s_fline->ad.ad_ln.ln_extra++ ;
+	} else {
+		newline(LINES) ;
+		pstate.s_fline->instr_num= sp_fpseu ;
+		pstate.s_fline->ad.ad_ln.ln_extra= 0 ;
+		pstate.s_fline->ad.ad_ln.ln_first= line_num ;
+	}
+
+}
+
+cons_t maxval(bits) int bits ; {
+	/* find the maximum positive value,
+	 * fitting in 'bits' bits AND
+	 * fitting in a 'cons_t' .
+	 */
+
+	cons_t val ;
+	val=1 ;
+	while ( bits-- ) {
+		val<<= 1 ;
+		if ( val<0 ) return ~val ;
+	}
+	return val-1 ;
+}
+
+setsizes() {
+	maxadr    = maxval(8*ptrsize)      ;
+	maxint    = maxval(8*wordsize-1)   ;
+	maxunsig  = maxval(8*wordsize)     ;
+	maxdint   = maxval(2*8*wordsize-1) ;
+	maxdunsig = maxval(2*8*wordsize)   ;
+}
+
+char *getdig(str,number) char *str; register unsigned number; {
+	register int remain;
+
+	remain= number%10;
+	number /= 10;
+	if ( number ) str= getdig(str,number) ;
+	*str++ = '0'+remain ;
+	return str ;
+}
+
+make_string(n) unsigned n ; {
+	string[0] = '.';
+	*getdig(&string[1],n)= 0;
+}
+
+
+getstring() {
+	register char *p;
+	register n;
+
+	getarg(cst_ptyp);
+	if ( argval < 0 || argval >= MAXSTRING-1 )
+		fatal("string/identifier too long");
+	strlngth = n = argval;
+	p = string;
+	while (--n >= 0)
+		*p++ = get8();
+	*p = 0 ;
+}
+
+inident() {
+	getstring();
+	string[IDLENGTH] = '\0';
+}
+
+exchange(p1,p2) {
+	int size, line ;
+	int l_of_p1, l_of_p2, l_of_before ;
+	register line_t *t_lnp,*a_lnp, *b_lnp ;
+
+	/* Since the lines are linked backwards it is easy
+	 * to count the number of lines backwards.
+	 * Each instr counts for 1, each pseudo for ln_extra + 1.
+	 * The line numbers in error messages etc. are INCORRECT
+	 * If exc's are used.
+	 */
+
+	line= line_num ; size=0 ;
+	newline(LINES) ; a_lnp=pstate.s_fline ;
+	a_lnp->instr_num= sp_fpseu ;
+	a_lnp->ad.ad_ln.ln_first= line ;
+	a_lnp->ad.ad_ln.ln_extra= -1 ;
+	for ( ; a_lnp ; a_lnp= a_lnp->l_next ) {
+		line-- ;
+		switch ( ctrunc(a_lnp->instr_num) ) {
+		case sp_fpseu :
+			line= a_lnp->ad.ad_ln.ln_first ;
+			size += a_lnp->ad.ad_ln.ln_extra ;
+			break ;
+		case sp_ilb1 :
+			a_lnp->ad.ad_lp->l_min -= p2 ;
+			break ;
+		}
+		size++ ;
+		if ( size>=p1 ) break ;
+	}
+	if ( ( size-= p1 )>0 ) {
+		if ( ctrunc(a_lnp->instr_num) !=sp_fpseu ) {
+			fatal("EXC inconsistency") ;
+		}
+		doinsert(a_lnp,line,a_lnp->ad.ad_ln.ln_extra-size) ;
+		a_lnp->ad.ad_ln.ln_first += size ;
+		a_lnp->ad.ad_ln.ln_extra = size-1 ;
+		size=0 ;
+		b_lnp=a_lnp->l_next ;
+	} else  {
+		doinsert(a_lnp,line,-1) ;
+		b_lnp= a_lnp ;
+	}
+	while ( b_lnp ) {
+		b_lnp= b_lnp->l_next ;
+		line-- ;
+		switch ( ctrunc(b_lnp->instr_num) ) {
+		case sp_fpseu :
+			size += b_lnp->ad.ad_ln.ln_extra ;
+			line = b_lnp->ad.ad_ln.ln_first ;
+			break ;
+		case sp_ilb1 :
+			b_lnp->ad.ad_lp->l_min += p1 ;
+			break ;
+		}
+		size++ ;
+		if ( size>=p2 ) break ;
+	}
+	if ( ( size-= p2 )>0 ) {
+		if ( ctrunc(b_lnp->instr_num) !=sp_fpseu ) {
+			fatal("EXC inconsistency") ;
+		}
+		doinsert(b_lnp,line,b_lnp->ad.ad_ln.ln_extra-size) ;
+		b_lnp->ad.ad_ln.ln_first += size ;
+		b_lnp->ad.ad_ln.ln_extra = size-1 ;
+	} else  {
+		doinsert(b_lnp,line,-1) ;
+	}
+	if ( !b_lnp ) { /* if a_lnp==0, so is b_lnp */
+		fatal("Cannot perform exchange") ;
+	}
+	t_lnp = b_lnp->l_next ;
+	b_lnp->l_next = pstate.s_fline ;
+	pstate.s_fline= a_lnp->l_next ;
+	a_lnp->l_next=t_lnp ;
+}
+
+doinsert(lnp,first,extra) line_t *lnp ; {
+	/* Beware : s_fline will be clobbered and restored */
+	register line_t *t_lnp ;
+
+	t_lnp= pstate.s_fline;
+	pstate.s_fline= lnp->l_next ;
+	newline(LINES) ;
+	pstate.s_fline->instr_num= sp_fpseu ;
+	pstate.s_fline->ad.ad_ln.ln_first= first ;
+	pstate.s_fline->ad.ad_ln.ln_extra= extra ;
+	lnp->l_next= pstate.s_fline ;
+	pstate.s_fline= t_lnp; /* restore */
+}
+
+putval() {
+	switch(valtype){
+	case sp_cst2:
+		extconst(argval);
+		return ;
+	case sp_ilb1:
+		extloc(loclookup(tabval,OCCURRING));
+		return ;
+	case sp_dnam:
+		extglob(glo2lookup(string,OCCURRING),(cons_t)0);
+		return ;
+	case sp_doff:
+		extglob(glo2lookup(string,OCCURRING),argval);
+		return ;
+	case sp_pnam:
+		extpro(prolookup(string,PRO_OCC));
+		return ;
+	case sp_scon:
+		extstring() ;
+		return ;
+	case sp_fcon:
+		extxcon(DATA_FCON) ;
+		return ;
+	case sp_icon:
+		extvcon(DATA_ICON) ;
+		return ;
+	case sp_ucon:
+		extvcon(DATA_UCON) ;
+		return ;
+	default:
+		fatal("putval notreached") ;
+		/* NOTREACHED */
+	}
+}
+
+chkstart() {
+	static int absout = 0 ;
+
+	if ( absout ) return ;
+	if ( !oksizes ) fatal("missing size specification") ;
+	setmode(DATA_CONST) ;
+	extconst((cons_t)0) ;
+	setmode(DATA_REP) ;
+	extadr( (cons_t) (ABSSIZE/wordsize-1) ) ;
+	absout++ ;
+	databytes = ABSSIZE ;
+	memtype= HOLBSS ;
+}
+
+typealign(new) enum m_type new ; {
+	if ( memtype==new ) return ;
+	align(wordsize);
+	memtype=new ;
+}
+
+sizealign(size) cons_t size ; {
+	align( size>wordsize ? wordsize : (int)size ) ;
+}
+
+align(size) int size ; {
+	register unsigned gapsize ;
+
+	for ( gapsize= databytes%size ; gapsize ; gapsize-- ) {
+		setmode(DATA_BYTES) ;
+		ext8(0) ;
+		databytes++ ;
+	}
+}
+
+extconst(n) cons_t n ; {
+	setmode(DATA_CONST);
+	extword(n);
+}
+
+extbss(n) cons_t n ; {
+	cons_t objsize,amount ;
+
+	if ( n<=0 ) {
+		if ( n<0 ) werror("negative bss/hol size") ;
+		if ( table2()==sp_cend || table2()==sp_cend) {
+			werror("Unexpected end-of-line") ;
+		}
+		return ;
+	}
+	setmode(DATA_NUL) ; /* flush descriptor */
+	objsize= valsize();
+	if ( objsize==0 ) {
+		werror("Unexpected end-of-line");
+		return;
+	}
+	if ( n%objsize != 0 ) error("BSS/HOL incompatible sizes");
+	putval();
+	amount= n/objsize ;
+	if ( amount>1 ) {
+		setmode(DATA_REP);
+		extadr(amount-1) ;
+	}
+	databytes +=n ;
+	getarg(sp_cst2);
+	if ( argval<0 || argval>1 ) error("illegal last argument") ;
+}
+
+extloc(lbp) register locl_t *lbp; {
+
+	/*
+	 * assemble a pointer constant from a local label.
+	 * For example  con *1
+	 */
+	setmode(DATA_IPTR);
+	data_reloc( chp_cast lbp,dataoff,RELLOC);
+	extadr((cons_t)0);
+}
+
+extglob(agbp,off) glob_t *agbp; cons_t off; {
+	register glob_t *gbp;
+
+	/*
+	 * generate a word of data that is defined by a global symbol.
+	 * Various relocation has to be prepared here in some cases
+	 */
+	gbp=agbp;
+	setmode(DATA_DPTR);
+	if ( gbp->g_status&DEF ) {
+		extadr(gbp->g_val.g_addr+off);
+	} else {
+		data_reloc( chp_cast gbp,dataoff,RELGLO);
+		extadr(off);
+	}
+}
+
+extpro(aprp) proc_t *aprp; {
+	/*
+	 * generate a addres that is defined by a procedure descriptor.
+	 */
+	consiz= ptrsize ; setmode(DATA_UCON);
+	extarb((int)ptrsize,(long)(aprp->p_num));
+}
+
+extstring() {
+	register char *s;
+	register n ;
+
+	/*
+	 * generate data for a string.
+	 */
+	for(n=strlngth,s=string ; n--; ) {
+		setmode(DATA_BYTES) ;
+		ext8(*s++);
+	}
+	return ;
+}
+
+extxcon(header) {
+	register char *s ;
+	register n;
+
+	/*
+	 * generate data for a floating constant initialized by a string.
+	 */
+
+	setmode(header);
+	s = string ;
+	for (n=strlngth ; n-- ;) {
+		if ( *s==0 ) error("Zero byte in initializer") ;
+		ext8(*s++);
+	}
+	ext8(0);
+	return ;
+}
+
+extvcon(header) {
+	extern long atol() ;
+	/*
+	 * generate data for a constant initialized by a string.
+	 */
+
+	setmode(header);
+	if ( consiz>4 ) {
+		error("Size of initializer exceeds loader capability") ;
+	}
+	extarb((int)consiz,atol(string)) ;
+	return ;
+}

+ 137 - 0
util/ass/asscm.c

@@ -0,0 +1,137 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/*  Core management for the EM assembler.
+    two routines:
+	getarea(size)
+		returns a pointer to a free area of 'size' bytes.
+	freearea(ptr,size)
+		free's the area of 'size' bytes pointed to by ptr
+
+    Free blocks are linked together and kept sorted.
+    Adjacent free blocks are collapsed.
+    Free blocks with a size smaller then the administration cannot
+    exist.
+    The algorithm is first fit.
+*/
+
+#include "ass00.h"
+
+#ifdef MEMUSE
+static unsigned m_used = 0 ;
+static unsigned m_free = 0 ;
+#endif
+
+struct freeblock {
+	struct freeblock *f_next ;
+	unsigned         f_size  ;
+} ;
+
+static struct freeblock freexx[2] = {
+	{ freexx, 0 },
+	{ freexx+1, 0 }
+} ;
+
+#define freehead freexx[1]
+
+#define CHUNK 2048              /* Smallest chunk to be gotten from UNIX */
+
+area_t getarea(size) unsigned size ; {
+	register struct freeblock *c_ptr,*l_ptr ;
+	register char *ptr ;
+	unsigned rqsize ;
+	char *malloc() ;
+
+#ifdef MEMUSE
+	m_used += size ;
+	m_free -= size ;
+#endif
+	for(;;) {
+		for ( l_ptr= &freehead, c_ptr= freehead.f_next ;
+		      c_ptr!= &freehead ; c_ptr = c_ptr->f_next ) {
+			if ( size==c_ptr->f_size ) {
+				l_ptr->f_next= c_ptr->f_next ;
+				return (area_t) c_ptr ;
+			}
+			if ( size+sizeof freehead <= c_ptr->f_size ) {
+				c_ptr->f_size -= size ;
+			   return (area_t) ((char *) c_ptr + c_ptr->f_size) ;
+			}
+			l_ptr = c_ptr ;
+		}
+		rqsize = size<CHUNK ? CHUNK : size ;
+		for(;;){
+			ptr = malloc( rqsize ) ;
+			if ( ptr ) break ; /* request succesfull */
+			rqsize /= 2 ;
+			rqsize -= rqsize%sizeof (short) ;
+			if ( rqsize < sizeof freehead ) {
+				fatal("Out of memory") ;
+			}
+		}
+		freearea((area_t)ptr,rqsize) ;
+#ifdef MEMUSE
+		m_used += rqsize ;
+#endif
+	}
+	/* NOTREACHED */
+}
+
+freearea(ptr,size) register area_t ptr ; unsigned size ; {
+	register struct freeblock *c_ptr, *l_ptr ;
+
+#ifdef MEMUSE
+	m_free += size ;
+	m_used -= size ;
+#endif
+	for ( l_ptr= &freehead, c_ptr=freehead.f_next ;
+	      c_ptr!= &freehead ; c_ptr= c_ptr->f_next ) {
+		if ( (area_t)c_ptr>ptr ) break ;
+		l_ptr= c_ptr ;
+	}
+	/* now insert between l_ptr and c_ptr */
+	/* Beware they may both point to freehead */
+
+#ifdef MEMUSE
+	if ( ((char *)l_ptr)+l_ptr->f_size> (char *)ptr && l_ptr<=ptr )
+		fatal("Double freed") ;
+	if ( ((char *)ptr)+size > (char *)c_ptr && ptr<=c_ptr )
+		fatal("Frreed double") ;
+#endif
+	/* Is the block before this one adjacent ? */
+	if ( ((char *)l_ptr) + l_ptr->f_size == (char *) ptr ) {
+		l_ptr->f_size += size ; /* yes */
+	} else {
+		/* No, create an entry */
+		((struct freeblock *)ptr)->f_next = c_ptr ;
+		((struct freeblock *)ptr)->f_size = size ;
+		l_ptr->f_next = (struct freeblock *)ptr ;
+		l_ptr = (struct freeblock *)ptr ;
+	}
+	/* Are the two entries adjacent ? */
+	if ( (char *)l_ptr + l_ptr->f_size == (char *) c_ptr ) {
+		/* the two entries are adjacent */
+		l_ptr->f_next = c_ptr->f_next ;
+		l_ptr->f_size += c_ptr->f_size ;
+	}
+}
+
+#ifdef MEMUSE
+memuse() {
+	printf("Free %7u, Used %7u, Total %7u\n",m_free,m_used,m_free+m_used);
+}
+#endif

+ 125 - 0
util/ass/assda.c

@@ -0,0 +1,125 @@
+#include        "ass00.h"
+#include        "assex.h"
+/*
+ * global data
+ */
+
+int     wordsize ;
+int     ptrsize ;
+cons_t  maxadr ;
+cons_t  maxint;
+cons_t  maxdint;
+cons_t  maxunsig;
+cons_t  maxdunsig;
+
+/*
+	The structure containing used for procedure environment stacking
+*/
+stat_t  pstate ;
+
+/*
+ * pointers to not yet allocated storage
+ */
+glob_t  *mglobs;                        /* pointer to module symbols */
+glob_t  *xglobs;                        /* pointer to extern symbols */
+proc_t  *mprocs;                        /* pointer to local procs */
+proc_t  *xprocs;                        /* pointer to external procs */
+ptab_t  *proctab;                       /* pointer to proctab[] */
+
+/*
+ * some array and structures of known size
+ */
+FILE    *ifile;                         /* input file buffer */
+FILE    *tfile;                         /* code file buffer */
+FILE    *dfile;                         /* data file buffer */
+FILE    *rtfile;                        /* code file buffer */
+FILE    *rdfile;                        /* data file buffer */
+char    string[MAXSTRING];
+
+/*
+ * some other pointers
+ */
+glob_t  *lastglosym;                    /* last global symbol */
+glob_t  *curglosym;                     /* current global symbol */
+relc_t  *f_data = (relc_t *)0 ;         /* first data reloc pointer */
+relc_t  *l_data = (relc_t *)0 ;         /* last data reloc pointer */
+relc_t  *f_text = (relc_t *)0 ;         /* first text reloc pointer */
+relc_t  *l_text = (relc_t *)0 ;         /* last text reloc pointer */
+
+/*
+ * some indices
+ */
+int     strlngth;                       /* index in string[] */
+FOFFSET inpoff;                         /* offset in current input file */
+FOFFSET libeof;                         /* ceiling for above number */
+
+/*
+ * some other counters
+ */
+int     procnum;                        /* generic for unique proc-descr. */
+cons_t  prog_size;                      /* length of current proc */
+int     max_bytes;
+int     pass;
+int     line_num;                       /* line number for error messages */
+int     nerrors;                        /* number of nonfatal errors */
+cons_t  consiz;                         /* size of U,I or F value */
+cons_t  textbytes;                      /* size of code file */
+cons_t  databytes;                      /* highwater mark in data */
+FOFFSET dataoff;                        /* size of data file */
+FOFFSET textoff;                        /* size of text file */
+FOFFSET lastoff;                        /* previous size before last block */
+int     datamode;                       /* what kind of data */
+int     datablocks;                     /* number of datablocks written out */
+relc_t *lastheader;                     /* pointer into datareloc */
+cons_t  holbase;
+cons_t  holsize;
+int     unresolved;                     /* # of unresolved references */
+int     sourcelines;                    /* number of lines in source program*/
+int     intflags        =  1;           /* flags for interpreter */
+/*
+ * some flags
+ */
+int     archmode;                       /* reading library ? */
+int     procflag;                       /* print "namelist" of procedures */
+#ifdef  DUMP
+int     c_flag;                         /* print unused opcodes */
+char    opcnt1[256];                    /* count primary opcodes */
+char    opcnt2[256];                    /* count secondary opcodes */
+char    opcnt3[256];                    /* count long opcodes */
+#endif
+int     d_flag          =  0;           /* don't dump */
+int     r_flag          =  0;           /* don't dump relocation tables */
+#ifdef JOHAN
+int     jflag;
+#endif
+int     wflag           =  0;           /* don't issue warning messages */
+int     eof_seen;
+int     mod_sizes;                      /* Size info in current module ok? */
+
+#define BASE    (sizeof (struct lines) - sizeof (addr_u))
+
+char    linesize[VALLOW+1] = {
+	BASE,                           /* MISSING */
+	BASE + sizeof (cons_t),         /* CONST */
+	BASE + sizeof prp_cast,         /* PROCNAME */
+	BASE + sizeof gbp_cast,         /* GLOSYM */
+	BASE + sizeof lbp_cast,         /* LOCSYM */
+	BASE + sizeof (struct sad_df),  /* GLOOFF */
+	BASE + sizeof (struct sad_ln),  /* LINES */
+	BASE                            /* VALLOW */
+} ;
+
+/*
+ * miscellaneous
+ */
+char    *progname;                      /* argv[0] */
+char    *curfile        =  0;           /* name of current file */
+char    *eout           =  "e.out";
+arch_t  archhdr;
+size_t  sizes[NDEFAULT] = {
+/*   mlab, glab,mproc,xproc, proc */
+    { 151,   29,   31,   73,  130 },
+    { 307,  127,  151,  401,  460 },
+    { 601,  251,  151,  401,  600 }
+};
+size_t  *oursize        =  &sizes[1] ;  /* point to selected sizes */

+ 158 - 0
util/ass/assex.h

@@ -0,0 +1,158 @@
+/*
+ * global data
+ */
+
+extern  int     wordsize;
+extern  int     ptrsize;
+extern  cons_t  maxadr;
+extern  cons_t  maxint;
+extern  cons_t  maxdint;
+extern  cons_t  maxunsig;
+extern  cons_t  maxdunsig;
+
+/*
+ * tables loaded from em_libraries
+ */
+extern  char    em_flag[];
+
+/*
+	The structure containing used for procedure environment stacking
+ */
+extern  stat_t  pstate ;
+
+/*
+ * pointers to not yet allocated storage
+ */
+extern  glob_t  *mglobs;
+extern  glob_t  *xglobs;
+extern  proc_t  *mprocs;
+extern  proc_t  *xprocs;
+extern  ptab_t  *proctab;
+
+extern  FILE    *ifile;
+extern  FILE    *tfile;
+extern  FILE    *dfile;
+extern  FILE    *rtfile;
+extern  FILE    *rdfile;
+extern  char    string[];
+
+/*
+ * some other pointers
+ */
+extern  glob_t  *lastglosym;
+extern  glob_t  *curglosym;
+extern  size_t  *oursize;
+extern  relc_t  *f_data;
+extern  relc_t  *l_data;
+extern  relc_t  *f_text;
+extern  relc_t  *l_text;
+
+/*
+ * some indices
+ */
+extern  int     strlngth;
+extern  FOFFSET inpoff;
+extern  FOFFSET libeof;
+
+/*
+ * some other counters
+ */
+extern  int     procnum;
+extern  cons_t  prog_size;
+extern  int     max_bytes;
+extern  int     pass;
+extern  int     line_num;
+extern  int     nerrors;
+extern  cons_t  textbytes;
+extern  cons_t  databytes;
+extern  FOFFSET dataoff;
+extern  FOFFSET textoff;
+extern  FOFFSET lastoff;
+extern  int     datamode;
+extern  int     datablocks;
+extern  relc_t  *lastheader;
+extern  cons_t  holbase;
+extern  cons_t  holsize;
+extern  int     unresolved;
+extern  int     sourcelines;
+extern  int     intflags;
+/*
+ * some flags
+ */
+extern  int     archmode;
+extern  int     procflag;
+#ifdef  DUMP
+extern  int     c_flag;
+extern  char    opcnt1[];
+extern  char    opcnt2[];
+extern  char    opcnt3[];
+#endif
+extern  int     d_flag;
+extern  int     r_flag;
+#ifdef JOHAN
+extern  int     jflag;
+#endif
+extern  int     wflag;
+extern  int     eof_seen;
+extern  int     mod_sizes;
+/*
+ * miscellaneous
+ */
+extern  cons_t  consiz;
+extern  char    *progname;
+extern  char    *curfile;
+extern  char    *eout;
+extern  arch_t  archhdr;
+extern  size_t  sizes[];
+
+extern  char    linesize[];
+
+/*
+ * from asstb.c
+ */
+
+extern  char    *opindex[] ;
+extern  char    opchoice[] ;
+extern  int     maxinsl ;
+
+/*
+ * types of value returning routines
+ */
+#ifndef CPM
+extern  int     tmpfil();
+extern  FILE    *frewind();
+#endif
+extern  int     xgetc();
+extern  unsigned get8();
+extern  int     get16();
+extern  cons_t  get32();
+extern  cons_t  xgeta();
+extern  cons_t  parval();
+extern  cons_t  valsize();
+extern  cons_t  xgetarb();
+extern  char    *findnop();
+extern  char    *findfit();
+extern  glob_t  *glolookup();
+extern  glob_t  *glo2lookup();
+extern  glob_t  *xglolookup();
+extern  locl_t  *loclookup();
+extern  proc_t  *prolookup();
+extern  proc_t  *enterproc();
+extern  proc_t  *searchproc();
+extern  relc_t  *text_reloc();
+extern  relc_t  *data_reloc();
+extern  area_t  getarea();
+
+/*
+ * all used library routines
+ */
+extern  char    *malloc();
+extern  int     open();
+extern  int     creat();
+extern  int     getpid();
+extern  int     unlink();
+extern  int     close();
+extern  int     strcmp();
+extern  char    *strcpy();
+
+#define void    int

+ 298 - 0
util/ass/assrl.c

@@ -0,0 +1,298 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+#include        "ass00.h"
+#include        "assex.h"
+
+#define COPYFINAL       1
+#define COPYTEMP        0
+
+/*
+ * collection of routines to deal with relocation business
+ */
+
+void    dataprocess();
+void    textprocess();
+relc_t *
+text_reloc(glosym,off,typ) glob_t *glosym; FOFFSET off ; int typ ; {
+
+	/*
+	 * prepare the relocation that has to be done at text-offset off
+	 * according to global symbol glosym.
+	 * NOTE: The pointer glosym will point into mglobs[], while at
+	 *       the time copyout() is called all the symbols here
+	 *       will have disappeared.
+	 *       The procedure upd_reloc() will change this pointer
+	 *       into the one in xglobs[] later.
+	 */
+
+	register relc_t *nxtextreloc ;
+
+	nxtextreloc= rlp_cast getarea(sizeof *nxtextreloc) ;
+	if ( !f_text ) {
+		f_text= nxtextreloc ;
+	} else {
+		l_text->r_next= nxtextreloc ;
+	}
+	nxtextreloc->r_next= rlp_cast 0 ;
+	l_text= nxtextreloc ;
+	nxtextreloc->r_off = off;
+	nxtextreloc->r_val.rel_gp = glosym;
+	nxtextreloc->r_typ = typ;       /* flags of instruction */
+	return(nxtextreloc);
+}
+
+relc_t *
+data_reloc(arg,off,typ) char *arg ; FOFFSET off ; int typ ; {
+
+	/*
+	 * Same as above.
+	 */
+
+	register relc_t *nxdatareloc ;
+
+	nxdatareloc= rlp_cast getarea(sizeof *nxdatareloc) ;
+	if ( !f_data ) {
+		f_data= nxdatareloc ;
+	} else {
+		l_data->r_next= nxdatareloc ;
+	}
+	nxdatareloc->r_next= rlp_cast 0 ;
+	l_data= nxdatareloc ;
+	nxdatareloc->r_off = off;
+	nxdatareloc->r_val.rel_lp = lbp_cast arg;
+	nxdatareloc->r_typ = typ;
+	return(nxdatareloc);
+}
+
+copyout() {
+	register i;
+	int remtext ;
+
+	/*
+	 * Make the e.out file that looks as follows:
+	 *
+	 *      __________________________
+	 *      |      MAGIC             | \
+	 *      |      FLAGS             |  \
+	 *      |      UNRESOLVED        |   \
+	 *      |      VERSION           |    | 8*(2-byte word) header
+	 *      |      WORDSIZE          |    | for interpreter selection
+	 *      |      PTRSIZE           |   /
+	 *      |      <UNUSED>          |  /
+	 *      |      <UNUSED>          | /
+	 *      |      NTEXT             | \
+	 *      |      NDATA             |  \
+	 *      |      NPROC             |   \
+	 *      |      ENTRY-POINT       |    | 8*(wordsize-word) header
+	 *      |      NLINES            |    | for interpreter proper
+	 *      |      <UNUSED>          |   /
+	 *      |      <UNUSED>          |  /
+	 *      |      <UNUSED>          | /
+	 *      |________________________|
+	 *      |                        |
+	 *      |      TEXT              |        zero filled
+	 *      |                        |        if not word multiple
+	 *      |________________________|
+	 *      |                        |
+	 *      |      DATA              |
+	 *      |                        |
+	 *      |________________________|
+	 *      |                        |
+	 *      |      PROCTABLE         |
+	 *      |                        |
+	 *      |________________________|
+	 *
+	 *
+	 */
+
+	remtext = textbytes%wordsize ;
+	if ( remtext != 0 ) remtext = wordsize-remtext ;
+
+	if ((ifile = fopen(eout,"w")) == NULL )
+		fatal("can't create e.out");
+#ifdef  CPM
+	fclose(tfile); tfile=fopen("TFILE.$$$, "r");
+	fclose(dfile); dfile=fopen("DFILE.$$$, "r");
+#else
+	tfile=frewind(tfile);
+	dfile=frewind(dfile);
+#endif
+	xput16(as_magic,ifile);
+	xput16(intflags,ifile);
+	xput16(unresolved,ifile);
+	xput16(VERSION,ifile);
+	xput16(wordsize,ifile);
+	xput16(ptrsize,ifile);
+	xput16(0,ifile);
+	xput16(0,ifile);
+	xputa(textbytes+remtext ,ifile);
+	xputa((cons_t)datablocks,ifile);
+	xputa((cons_t)procnum,ifile);
+	xputa((cons_t)searchproc(MAIN,xprocs,oursize->n_xproc)->p_num,
+		ifile);
+	xputa((cons_t)sourcelines,ifile);
+	xputa((cons_t)databytes,ifile);
+	xputa((cons_t)0,ifile);
+	xputa((cons_t)0,ifile);
+
+	textprocess(tfile,ifile);
+	while ( remtext-- ) xputc(0,ifile) ;
+
+	dataprocess(dfile,ifile);
+	for (i=0;i<procnum;i++) {
+		xputarb(ptrsize,proctab[i].pr_loc,ifile);
+		xputarb(ptrsize,proctab[i].pr_off,ifile);
+	}
+	if ( fclose(ifile)==EOF ) ;
+}
+
+dataprocess(f1,f2) FILE *f1,*f2; {
+	relc_t datareloc;
+	FOFFSET i;
+	register ieof ;
+
+#ifdef  CPM
+	fclose(rdfile); rdfile=fopen("RDFILE.$$$, "r");
+#else
+	rdfile=frewind(rdfile) ;
+#endif
+	ieof=getblk(rdfile,(char *)(&datareloc.r_off),
+		sizeof datareloc - sizeof datareloc.r_next) ;
+	for (i=0 ; i<dataoff && !ieof ; i++) {
+		if (i==datareloc.r_off) {
+			switch(datareloc.r_typ) {
+			case RELADR:
+				xputa(xgeta(f1)+datareloc.r_val.rel_i,f2) ;
+				i += ptrsize-1 ;
+				break ;
+			case RELGLO:
+				if (datareloc.r_val.rel_gp->g_status&DEF) {
+				xputa(xgeta(f1)+
+					datareloc.r_val.rel_gp->g_val.g_addr,
+						f2);
+					i+= ptrsize-1 ;
+					break ;
+				}
+				if ( unresolved == 0 )
+					fatal("Definition botch") ;
+			case RELHEAD:
+				xputc((int)(xgetc(f1)+datareloc.r_val.rel_i),
+					f2);
+				break;
+			default:
+				fatal("Bad r_typ in dataprocess");
+			}
+			ieof=getblk(rdfile,(char *)(&datareloc.r_off),
+				sizeof datareloc - sizeof datareloc.r_next) ;
+		} else
+			xputc(xgetc(f1),f2);
+	}
+	for ( ; i<dataoff ; i++ ) xputc(xgetc(f1),f2) ;
+	if ( !ieof && !getblk(rdfile,(char *)&datareloc,1) )
+		fatal("data relocation botch") ;
+}
+
+textprocess(f1,f2) FILE *f1,*f2; {
+	relc_t textreloc;
+	cons_t n;
+	FOFFSET i;
+	FILE *otfile ;
+	int insl ;  register int ieof ;
+	char *op_curr ;
+	register FOFFSET keep ;
+
+#ifdef  CPM
+	fclose(rtfile); rtfile=fopen("RTFILE.$$$, "r");
+#else
+	rtfile=frewind(rtfile) ;
+#endif
+	keep = textoff ; textoff=0 ; otfile=tfile ; tfile=f2 ;
+	/* This redirects the output of genop */
+	ieof=getblk(rtfile,(char *)(&textreloc.r_off),
+		sizeof textreloc - sizeof textreloc.r_next) ;
+	for(i=0;i<keep && !ieof ;i++) {
+		if( i == textreloc.r_off ) {
+			if (textreloc.r_typ&RELMNS) {
+				n=textreloc.r_val.rel_i;
+			} else {
+				if (textreloc.r_val.rel_gp->g_status&DEF) {
+				      n=textreloc.r_val.rel_gp->g_val.g_addr;
+				} else {
+					if ( unresolved==0 )
+						fatal("Definition botch") ;
+					xputc(xgetc(f1),f2) ;
+				ieof=getblk(rtfile,(char *)(&textreloc.r_off),
+				sizeof textreloc-sizeof textreloc.r_next);
+					continue ;
+				}
+			}
+			op_curr = &opchoice[textreloc.r_typ& ~RELMNS] ;
+			insl = oplength(*op_curr) ;
+			genop(op_curr, n+xgetarb(insl,f1), PAR_G);
+			i += insl-1 ;
+			ieof=getblk(rtfile,(char *)(&textreloc.r_off),
+				sizeof textreloc - sizeof textreloc.r_next) ;
+		} else {
+			xputc(xgetc(f1),f2) ;
+		}
+	}
+	for ( ; i<keep ; i++ ) xputc(xgetc(f1),f2) ;
+	if ( !ieof && !getblk(rtfile,(char *)&textreloc,1) )
+		fatal("text relocation botch") ;
+	textoff = keep ;
+	tfile = otfile ;
+}
+
+upd_reloc() {
+	register relc_t *p;
+	register glob_t *gbp;
+
+	/*
+	 * Change reloc-tables such that for every pointer into mglobs
+	 * either the corresponding pointer into xglobs or its value
+	 * is substituted.
+	 *
+	 * Use is made of the known order of mglobs and xglobs
+	 * see also getcore()
+	 */
+
+	while ( p= f_text ) {
+		gbp= p->r_val.rel_gp ;
+		if( gbp->g_status&DEF ) {
+			p->r_typ |= RELMNS;
+			p->r_val.rel_i = gbp->g_val.g_addr;
+		} else
+			p->r_val.rel_gp = gbp->g_val.g_gp;
+		putblk(rtfile,(char *)(&(p->r_off)),sizeof *p - sizeof p) ;
+		f_text= p->r_next ; freearea( (area_t) p , sizeof *p ) ;
+	}
+
+	while( p= f_data ) {
+		if (p->r_typ == RELGLO) {
+			gbp= p->r_val.rel_gp ;
+			if(gbp->g_status&DEF) {
+				p->r_typ = RELADR;
+				p->r_val.rel_i = gbp->g_val.g_addr;
+			} else
+				p->r_val.rel_gp = gbp->g_val.g_gp;
+		}
+		putblk(rdfile,(char *)(&(p->r_off)),sizeof *p - sizeof p) ;
+		f_data= p->r_next ; freearea( (area_t) p , sizeof *p ) ;
+	}
+	l_data= rlp_cast 0 ;
+}

+ 33 - 0
util/ass/ip_spec.h

@@ -0,0 +1,33 @@
+/* Contents of flags used when describing interpreter opcodes */
+
+#define OPTYPE  07      /* type field in flag */
+
+#define OPMINI  0       /* m  MINI */
+#define OPSHORT 1       /* s  SHORT */
+#define OPNO    2       /* -  No operand */
+#define OP8     3       /* 1  1-byte signed operand */
+#define OP16    4       /* 2  2-byte signed operand */
+#define OP32    5       /* 4  4-byte signed operand */
+#define OP64    6       /* 8  8-byte signed operand */
+
+#define OPESC   010     /* e  escaped opcode */
+#define OPWORD  020     /* w  operand is word multiple */
+#define OPNZ    040     /* o  operand starts at 1 ( or wordsize if w-flag) */
+
+#define OPRANGE 0300    /* Range of operands: Positive, negative, both */
+
+#define OP_BOTH 0000    /* the default */
+#define OP_POS  0100    /* p  Positive (>=0) operands only */
+#define OP_NEG  0200    /* n  Negative (<0) operands only */
+
+struct opform {
+	char    i_opcode ;      /* the opcode number */
+	char    i_flag   ;      /* the flag byte */
+	char    i_low    ;      /* the interpreter first opcode */
+	char    i_num    ;      /* the number of shorts/minis (optional) */
+};
+
+/* Escape indicators */
+
+#define ESC     254             /* To escape group */
+#define ESC_L   255             /* To 32 and 64 bit operands */

+ 475 - 0
util/ass/maktab.c

@@ -0,0 +1,475 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+#include "ip_spec.h"
+#include <stdio.h>
+#include "../../h/em_spec.h"
+#include "../../h/em_flag.h"
+
+/* This program reads the human readable interpreter specification
+   and produces a efficient machine representation that can be
+   translated by a C-compiler.
+*/
+
+#define NOTAB   600    /* The max no of interpreter specs */
+#define ESCAP   256
+
+struct opform intable[NOTAB] ;
+struct opform *lastform = intable-1 ;
+
+int nerror = 0 ;
+int atend  = 0 ;
+int line   = 1 ;
+int maxinsl= 0 ;
+
+extern char em_mnem[][4] ;
+char esca[] = "escape" ;
+#define ename(no)       ((no)==ESCAP?esca:em_mnem[(no)])
+
+extern char em_flag[] ;
+
+main(argc,argv) char **argv ; {
+	if ( argc>1 ) {
+		if ( freopen(argv[1],"r",stdin)==NULL) {
+			fatal("Cannot open %s",argv[1]) ;
+		}
+	}
+	if ( argc>2 ) {
+		if ( freopen(argv[2],"w",stdout)==NULL) {
+			fatal("Cannot create %s",argv[2]) ;
+		}
+	}
+	if ( argc>3 ) {
+		fatal("%s [ file [ file ] ]",argv[0]) ;
+	}
+	atend=0 ;
+	readin();
+	atend=1 ;
+	checkall();
+	if ( nerror==0 ) {
+		writeout();
+	}
+	return nerror ;
+}
+
+readin() {
+	register struct opform *nextform ;
+	char *ident();
+	char *firstid ;
+	register maxl ;
+
+	maxl = 0 ;
+	for ( nextform=intable ;
+		!feof(stdin) && nextform<&intable[NOTAB] ; ) {
+		firstid=ident() ;
+		if ( *firstid=='\n' || feof(stdin) ) continue ;
+		lastform=nextform ;
+		nextform->i_opcode = getmnem(firstid) ;
+		nextform->i_flag   = decflag(ident()) ;
+		switch ( nextform->i_flag&OPTYPE ) {
+		case OPMINI:
+		case OPSHORT:
+			nextform->i_num = atoi(ident()) ;
+			break ;
+		}
+		nextform->i_low    = atoi(ident())    ;
+		if ( *ident()!='\n' ) {
+			int c ;
+			error("End of line expected");
+			while ( (c=readchar())!='\n' && c!=EOF ) ;
+		}
+		if ( oplength(nextform)>maxl ) maxl=oplength(nextform) ;
+		nextform++ ;
+	}
+	if ( !feof(stdin) ) fatal("Internal table too small") ;
+	maxinsl = maxl ;
+}
+
+char *ident() {
+	/* skip spaces and tabs, anything up to space,tab or eof is
+	   a identifier.
+	   Anything from # to end-of-line is an end-of-line.
+	   End-of-line is an identifier all by itself.
+	*/
+
+	static char array[200] ;
+	register int c ;
+	register char *cc ;
+
+	do {
+		c=readchar() ;
+	} while ( c==' ' || c=='\t' ) ;
+	for ( cc=array ; cc<&array[(sizeof array) - 1] ; cc++ ) {
+		if ( c=='#' ) {
+			do {
+				c=readchar();
+			} while ( c!='\n' && c!=EOF ) ;
+		}
+		*cc = c ;
+		if ( c=='\n' && cc==array ) break ;
+		c=readchar() ;
+		if ( c=='\n' ) {
+			pushback(c) ;
+			break ;
+		}
+		if ( c==' ' || c=='\t' || c==EOF ) break ;
+	}
+	*++cc=0 ;
+	return array ;
+}
+
+int getmnem(str) char *str ; {
+	char (*ptr)[4] ;
+
+	for ( ptr = em_mnem ; *ptr<= &em_mnem[sp_lmnem-sp_fmnem][0] ; ptr++ ) {
+		if ( strcmp(*ptr,str)==0 ) return (ptr-em_mnem) ;
+	}
+	error("Illegal mnemonic") ;
+	return 0 ;
+}
+
+error(str,a1,a2,a3,a4,a5,a6) /* VARARGS1 */ char *str ; {
+	if ( !atend ) fprintf(stderr,"line %d: ",line) ;
+	fprintf(stderr,str,a1,a2,a3,a4,a5,a6) ;
+	fprintf(stderr,"\n");
+	nerror++ ;
+}
+
+mess(str,a1,a2,a3,a4,a5,a6) /* VARARGS1 */ char *str ; {
+	if ( !atend ) fprintf(stderr,"line %d: ",line) ;
+	fprintf(stderr,str,a1,a2,a3,a4,a5,a6) ;
+	fprintf(stderr,"\n");
+}
+
+fatal(str,a1,a2,a3,a4,a5,a6) /* VARARGS1 */ char *str ; {
+	error(str,a1,a2,a3,a4,a5,a6) ;
+	exit(1) ;
+}
+
+#define ILLGL   -1
+
+check(val) int val ; {
+	if ( val!=ILLGL ) error("Illegal flag combination") ;
+}
+
+int decflag(str) char *str ; {
+	int type ;
+	int escape ;
+	int range ;
+	int wordm ;
+	int notzero ;
+
+	type=escape=range=wordm=notzero= ILLGL ;
+	while ( *str ) switch ( *str++ ) {
+	case 'm' :
+		check(type) ; type=OPMINI ; break ;
+	case 's' :
+		check(type) ; type=OPSHORT ; break ;
+	case '-' :
+		check(type) ; type=OPNO ; break ;
+	case '1' :
+		check(type) ; type=OP8 ; break ;
+	case '2' :
+		check(type) ; type=OP16 ; break ;
+	case '4' :
+		check(type) ; type=OP32 ; break ;
+	case '8' :
+		check(type) ; type=OP64 ; break ;
+	case 'e' :
+		check(escape) ; escape=0 ; break ;
+	case 'N' :
+		check(range) ; range= 2 ; break ;
+	case 'P' :
+		check(range) ; range= 1 ; break ;
+	case 'w' :
+		check(wordm) ; wordm=0 ; break ;
+	case 'o' :
+		check(notzero) ; notzero=0 ; break ;
+	default :
+		error("Unknown flag") ;
+	}
+	if ( type==ILLGL ) error("Type must be specified") ;
+	switch ( type ) {
+	case OP64 :
+	case OP32 :
+		if ( escape!=ILLGL ) error("Conflicting escapes") ;
+		escape=ILLGL ;
+	case OP16 :
+	case OP8 :
+	case OPSHORT :
+	case OPNO :
+		if ( notzero!=ILLGL ) mess("Improbable OPNZ") ;
+		if ( type==OPNO && range!=ILLGL ) {
+			mess("No operand in range") ;
+		}
+	}
+	if ( escape!=ILLGL ) type|=OPESC ;
+	if ( wordm!=ILLGL ) type|=OPWORD ;
+	switch ( range) {
+	case ILLGL : type|=OP_BOTH ; break ;
+	case 1     : type|=OP_POS  ; break ;
+	case 2     : type|=OP_NEG  ; break ;
+	}
+	if ( notzero!=ILLGL ) type|=OPNZ ;
+	return type ;
+}
+
+writeout() {
+	register struct opform *next ;
+	int elem[sp_lmnem-sp_fmnem+1+1] ;
+		/* for each op points to first of descr. */
+	register int i,currop ;
+	int nch ;
+	int compare() ;
+
+	qsort(intable,(lastform-intable)+1,sizeof intable[0],compare) ;
+
+	printf("int\tmaxinsl\t= %d ;\n",maxinsl) ;
+	currop= -1 ; nch=0 ;
+	printf("char opchoice[] = {\n") ;
+	for (next=intable ; next<=lastform ; next++ ) {
+		if ( (next->i_opcode&0377)!=currop ) {
+			for ( currop++ ;
+				currop<(next->i_opcode&0377) ; currop++ ) {
+				elem[currop]= nch ;
+				error("Missing opcode %s",em_mnem[currop]) ;
+			}
+			elem[currop]= nch ;
+		}
+		printf("%d, %d,",next->i_flag&0377,next->i_low&0377) ;
+		nch+=2 ;
+		switch ( next->i_flag&OPTYPE ) {
+		case OPMINI :
+		case OPSHORT :
+			printf("%d,",next->i_num&0377) ; nch++ ;
+		}
+		printf("\n") ;
+	}
+	for ( currop++ ; currop<=sp_lmnem-sp_fmnem ; currop++ ) {
+		elem[currop]= nch ;
+		error("Missing opcode %s",em_mnem[currop]) ;
+	}
+	elem[sp_lmnem-sp_fmnem+1]=nch ;
+	printf("0 } ;\n\nchar *opindex[] = {\n");
+	for ( i=0 ; i<=sp_lmnem-sp_fmnem+1 ; i++ ) {
+		printf(" &opchoice[%d],\n",elem[i]) ;
+	}
+	printf("} ;\n") ;
+}
+
+int compare(a,b) struct opform *a,*b ; {
+	if ( a->i_opcode!=b->i_opcode ) {
+		return (a->i_opcode&0377)-(b->i_opcode&0377) ;
+	}
+	return oplength(a)-oplength(b) ;
+}
+
+int oplength(a) struct opform *a ; {
+	int cnt ;
+
+	cnt=1 ;
+	if ( a->i_flag&OPESC ) cnt++ ;
+	switch( a->i_flag&OPTYPE ) {
+	case OPNO    :
+	case OPMINI  : break ;
+	case OP8     :
+	case OPSHORT : cnt++ ; break ;
+	case OP16    : cnt+=2 ; break ;
+	case OP32    : cnt+=5 ; break ;
+	case OP64    : cnt+=9 ; break ;
+	}
+	return cnt ;
+}
+
+/* ----------- checking --------------*/
+
+int ecodes[256],codes[256],lcodes[256] ;
+
+#define NMNEM   (sp_lmnem-sp_fmnem+1)
+#define MUST    1
+#define MAY     2
+#define FORB    3
+
+char negc[NMNEM], zc[NMNEM], posc[NMNEM] ;
+
+checkall() {
+	register i,flag ;
+	register struct opform *next ;
+	int opc,low ;
+
+	for ( i=0 ; i<NMNEM ; i++ ) negc[i]=zc[i]=posc[i]=0 ;
+	for ( i=0 ; i<256 ; i++ ) lcodes[i]= codes[i]= ecodes[i]= -1 ;
+	codes[254]=codes[255]=ESCAP;
+
+	atend=0 ; line=0 ;
+	for ( next=intable ; next<=lastform ; next++ ) {
+		line++ ;
+		flag = next->i_flag&0377 ;
+		opc  = next->i_opcode&0377 ;
+		low  = next->i_low&0377 ;
+		chkc(flag,low,opc) ;
+		switch(flag&OPTYPE) {
+		case OPNO : zc[opc]++ ; break ;
+		case OPMINI :
+		case OPSHORT :
+			for ( i=1 ; i<((next->i_num)&0377) ; i++ ) {
+				chkc(flag,low+i,opc) ;
+			}
+			if ( !(em_flag[opc]&PAR_G) &&
+			     (flag&OPRANGE)==OP_BOTH) {
+	      mess("Mini's and shorties should have P or N");
+			}
+			break ;
+		case OP8 :
+			error("OP8 is removed") ;
+			break ;
+		case OP16 :
+			if ( flag&OP_NEG )
+				negc[opc]++ ;
+			else if ( flag&OP_POS )
+				posc[opc]++ ;
+			break ;
+		case OP32 :
+		case OP64 :
+			break ;
+		default :
+			error("Illegal type") ;
+			break ;
+		}
+	}
+	atend=1 ;
+	for ( i=0 ; i<256 ; i++ ) if ( codes[i]== -1 ) {
+		mess("interpreter opcode %d not used",i) ;
+	}
+	for ( opc=0 ; opc<NMNEM ; opc++ ) {
+		switch(em_flag[opc]&EM_PAR) {
+		case PAR_NO :
+			ckop(opc,MUST,FORB,FORB) ;
+			break ;
+		case PAR_C:
+		case PAR_D:
+		case PAR_F:
+		case PAR_B:
+			ckop(opc,FORB,MAY,MAY) ;
+			break ;
+		case PAR_N:
+		case PAR_G:
+		case PAR_S:
+		case PAR_Z:
+		case PAR_O:
+		case PAR_P:
+			ckop(opc,FORB,MAY,FORB) ;
+			break ;
+		case PAR_R:
+			ckop(opc,FORB,MAY,FORB) ;
+			break ;
+		case PAR_L:
+			ckop(opc,FORB,MUST,MUST) ;
+			break ;
+		case PAR_W:
+			ckop(opc,MUST,MAY,FORB) ;
+			break ;
+		default :
+			error("Unknown instruction type of %s",ename(opc)) ;
+			break ;
+		}
+	}
+}
+
+chkc(flag,icode,emc) {
+	if ( flag&OPESC ) {
+		if ( ecodes[icode]!=-1 ) {
+			mess("Escaped opcode %d used by %s and %s",
+				icode,ename(emc),ename(ecodes[icode])) ;
+		}
+		ecodes[icode]=emc;
+	} else switch ( flag&OPTYPE ) {
+	default:
+		if ( codes[icode]!=-1 ) {
+			mess("Opcode %d used by %s and %s",
+				icode,ename(emc),ename(codes[icode])) ;
+		}
+		codes[icode]=emc;
+		break ;
+	case OP32:
+	case OP64:
+		if ( lcodes[icode]!=-1 ) {
+			mess("Long opcode %d used by %s and %s",
+				icode,ename(emc),ename(codes[icode])) ;
+		}
+		lcodes[icode]=emc;
+		break ;
+	}
+}
+
+ckop(emc,zf,pf,nf) {
+	if ( zc[emc]>1 ) mess("More then one OPNO for %s",ename(emc)) ;
+	if ( posc[emc]>1 ) mess("More then one OP16(pos) for %s",ename(emc)) ;
+	if ( negc[emc]>1 ) mess("More then one OP16(neg) for %s",ename(emc)) ;
+	switch(zf) {
+	case MUST:
+		if ( zc[emc]==0 ) mess("No OPNO for %s",ename(emc)) ;
+		break ;
+	case FORB:
+		if ( zc[emc]==1 ) mess("Forbidden OPNO for %s",ename(emc)) ;
+		break ;
+	}
+	switch(pf) {
+	case MUST:
+		if ( posc[emc]==0 ) mess("No OP16(pos) for %s",ename(emc)) ;
+		break ;
+	case FORB:
+		if ( posc[emc]==1 )
+			mess("Forbidden OP16(pos) for %s",ename(emc)) ;
+		break ;
+	}
+	switch(nf) {
+	case MUST:
+		if ( negc[emc]==0 ) mess("No OP16(neg) for %s",ename(emc)) ;
+		break ;
+	case FORB:
+		if ( negc[emc]==1 )
+			mess("Forbidden OP16(neg) for %s",ename(emc)) ;
+		break ;
+	}
+}
+
+static int pushchar ;
+static int pushf ;
+
+int readchar() {
+	int c ;
+
+	if ( pushf ) {
+		pushf=0 ;
+		c = pushchar ;
+	} else {
+		if ( feof(stdin) ) return EOF ;
+		c=getc(stdin) ;
+	}
+	if ( c=='\n' ) line++ ;
+	return c ;
+}
+
+pushback(c) {
+	if ( pushf ) {
+		fatal("Double pushback") ;
+	}
+	pushf++ ;
+	pushchar=c ;
+	if ( c=='\n' ) line-- ;
+}