Allow for AALMAG as well as ARMAG

util/ass/ass00.c

@@ -117,7 +117,7 @@ argument(arg) char *arg; {
 	inpoff = 2;
 	if ((w = getu16()) == sp_magic )
 		read_compact();
-	else if (w == ARMAG) {
+	else if (w == ARMAG || w == AALMAG) {
 		archmode = TRUE;
 		archive();
 		archmode = FALSE;
@@ -456,9 +456,6 @@ finish_up()
 	 * make the e.out file and stop.
 	 */
 
-#ifdef JOHAN
-	if ( jflag ) return ;
-#endif
 #ifdef DUMP
 	c_print();
 #endif

util/ass/ass00.h

@@ -17,7 +17,7 @@
 
 #define DUMP            1       /* dump between passes */
 /*  #define TIMING          1       /* some timing measurements */
-/*  #define JOHAN           1       /* dump the loaded instructions */
+#define JOHAN           1       /* dump the loaded instructions */
 #define MEMUSE          1       /* print memory usage statistics */
 
 #ifndef DUMP

util/ass/ass70.c

@@ -121,7 +121,7 @@ int size;       /* size for hash */
 	case ENTERING:
 		break;
 	case INTERNING:
-		if (!new)
+		if (!new && (g->g_status&EXT))
 			werror("INA must be first occurrence of '%s'",name);
 		break;
 	case EXTERNING:          /* lookup in other table */

util/ass/ass80.c

@@ -185,12 +185,19 @@ unsigned get8() {
 cons_t xgetarb(l,f) int l; FILE *f ; {
 	cons_t val ;
 	register int shift ;
+	int c;
 
 	shift=0 ; val=0 ;
 	while ( l-- ) {
-		val += ((cons_t)ctrunc(xgetc(f)))<<shift ;
+		val += ((cons_t)(c = ctrunc(xgetc(f))))<<shift ;
 		shift += 8 ;
 	}
+	if (c == 0377 && shift > 8 && ((shift>>3)&1)) {
+		while (shift < 8*sizeof(cons_t)) {
+			val += ((cons_t)c)<<shift ;
+			shift += 8;
+		}
+	}
 	return val ;
 }
 

util/ego/ic/ic_io.c

@@ -200,7 +200,7 @@ arch_init(arch)
 
 	infile = arch;
 	n = readshort();
-	if (n != (short)ARMAG) {
+	if (n != (short)ARMAG && n != (short)AALMAG) {
 		error("wrong archive magic number: %d",n);
 	}
 }

util/ego/ic/ic_lookup.c

@@ -34,6 +34,8 @@ extern char	*strcpy();
 #define oldprc(x)	oldstruct(prc,x)
 #define oldnum(x)	oldstruct(num,x)
 
+#define PF_FILE	2
+#define DF_FILE	2
 
 /* instr_lab */
 
@@ -118,12 +120,14 @@ dblock_p symlookup(name, status)
 			 * list.
 			 */
 			if (strcmp((*spp)->sy_name, name) == 0) {
-				if ((status != DEFINING
+				dp = (*spp)->sy_dblock;
-				     && ((*spp)->sy_dblock->d_flags1 & DF_EXTERNAL) == 0)
+				if (status != DEFINING ||
-				    || (*spp)->sy_dblock->d_pseudo == DUNKNOWN) {
+			    	    (dp->d_flags1 & DF_EXTERNAL) == 0) {
-					/* found */
+					dp->d_flags2 |= DF_FILE;
+				}
+				if (dp->d_flags2 & DF_FILE) {
 					lastname = (*spp)->sy_name;
-					return ((*spp)->sy_dblock);
+					return dp;
 				}
 				break;
 			} else {
@@ -168,6 +172,7 @@ dblock_p symlookup(name, status)
 		 */
 		dp->d_flags1 |= DF_EXTERNAL;
 	}
+	dp->d_flags2 |= DF_FILE;
 	return dp;
 }
 
@@ -217,11 +222,13 @@ proc_p proclookup(name, status)
 		 */
 		if (strcmp((*ppp)->pr_name, name) == 0) {
 			/* found */
-			if ((status != DEFINING
+			dp = (*ppp)->pr_proc;
-			     && ((*ppp)->pr_proc->p_flags1 & PF_EXTERNAL) == 0)
+			if (status != DEFINING ||
-			    || ! ((*ppp)->pr_proc->p_flags1 & PF_BODYSEEN)) {
+			    (dp->p_flags1 & PF_EXTERNAL) == 0) {
-				return ((*ppp)->pr_proc);
+				dp->p_flags2 |= PF_FILE;
+				return dp;
 			}
+			if (dp->p_flags2 & PF_FILE) return dp;
 			break;
 		} else {
 			ppp = &(*ppp)->pr_next;
@@ -256,6 +263,7 @@ proc_p proclookup(name, status)
 		 */
 		dp->p_flags1 |= PF_EXTERNAL;
 	}
+	dp->p_flags2 |= PF_FILE;
 	return dp;
 }
 
@@ -318,35 +326,6 @@ dump_procnames(hash,n,f)
 	}
 }
 
-static int
-extrefproc_superfluous(ph)
-	prc_p	ph;
-{
-	/* The problem is that when an EXP is found, we don't know yet
-	 * to which definition it applies (although this only is a problem
-	 * for erroneous input). Therefore, we create an entry in the
-	 * procedure table, and at the end of the EM file remove it if it
-	 * is superfluous. This routine checks for this superfluousness.
-	 */
-	prc_p	next = ph->pr_next;
-
-	if (! (ph->pr_proc->p_flags1 & PF_BODYSEEN)) {
-		/* No body seen yet, but maybe there is another definition ...
-		*/
-		register prc_p nn = next;
-
-		while (nn) {
-			if ((nn->pr_proc->p_flags1 & (PF_BODYSEEN|PF_EXTERNAL))
-			    == (PF_BODYSEEN|PF_EXTERNAL)
-			    && ! strcmp(nn->pr_name, ph->pr_name)) {
-				return 1;
-			}
-			nn = nn->pr_next;
-		}
-	}
-	return 0;
-}
-
 /* cleanprocs */
 
 cleanprocs(hash,n,mask)
@@ -373,10 +352,9 @@ cleanprocs(hash,n,mask)
 			 * or is 0 if ph is the first struct of
 			 * the list.
 			 */
+			ph->pr_proc->p_flags2 &= ~PF_FILE;
 			next = ph->pr_next;
-			if ((ph->pr_proc->p_flags1 & mask) == 0
+			if ((ph->pr_proc->p_flags1 & mask) == 0) {
-			    || (mask == PF_EXTERNAL
-				&& extrefproc_superfluous(ph))) {
 				if (x == (prc_p) 0) {
 					*pp = next;
 				} else {
@@ -424,37 +402,6 @@ dump_dblocknames(hash,n,f)
 	}
 }
 
-
-static int
-extrefdata_superfluous(ph)
-	sym_p	ph;
-{
-	/* The problem is that when an EXA is found, we don't know yet
-	 * to which definition it applies (although this only is a problem
-	 * for erroneous input). Therefore, we create an entry in the
-	 * data table, and at the end of the EM file remove it if it
-	 * is superfluous. This routine checks for this superfluousness.
-	 */
-	sym_p	next = ph->sy_next;
-
-	if (ph->sy_dblock->d_pseudo == DUNKNOWN) {
-		/* No definition seen yet, but maybe there is another one ...
-		*/
-		register sym_p nn = next;
-
-		while (nn) {
-			if (nn->sy_dblock->d_pseudo != DUNKNOWN
-			    && (nn->sy_dblock->d_flags1 & DF_EXTERNAL)
-			    && ! strcmp(nn->sy_name, ph->sy_name)) {
-				return 1;
-			}
-			nn = nn->sy_next;
-		}
-	}
-	return 0;
-}
-
-
 /* cleandblocks */
 
 cleandblocks(hash,n,mask)
@@ -471,9 +418,8 @@ cleandblocks(hash,n,mask)
 		x = (sym_p) 0;
 		for (sh = *sp; sh != (sym_p) 0; sh = next) {
 			next = sh->sy_next;
-			if ((sh->sy_dblock->d_flags1 & mask) == 0
+			sh->sy_dblock->d_flags2 &= ~DF_FILE;
-			    || (mask == DF_EXTERNAL
+			if ((sh->sy_dblock->d_flags1 & mask) == 0) {
-				&& extrefdata_superfluous(sh))) {
 				if (x == (sym_p) 0) {
 					*sp = next;
 				} else {