864 lines
		
	
	
	
		
			17 KiB
		
	
	
	
		
			C
		
	
	
	
	
	
			
		
		
	
	
			864 lines
		
	
	
	
		
			17 KiB
		
	
	
	
		
			C
		
	
	
	
	
	
| /*
 | |
|  * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
 | |
|  * See the copyright notice in the ACK home directory, in the file "Copyright".
 | |
|  *
 | |
|  */
 | |
| 
 | |
| #include        "ass00.h"
 | |
| #include        "assex.h"
 | |
| #include        "../../h/em_mes.h"
 | |
| #include        "../../h/em_pseu.h"
 | |
| #include        "../../h/em_ptyp.h"
 | |
| 
 | |
| #ifndef NORCSID
 | |
| static char rcs_id[] = "$Header$" ;
 | |
| #endif
 | |
| 
 | |
| /*
 | |
|  * 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, inpseudo and 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) ;
 | |
| }
 | |
| 
 | |
| int getu16() {
 | |
| 	register int l_byte, h_byte;
 | |
| 
 | |
| 	l_byte = get8();
 | |
| 	h_byte = get8();
 | |
| 	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 *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();
 | |
| }
 | |
| 
 | |
| 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) {
 | |
| 				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 and inpseudo */
 | |
| 	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 data 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 ) {
 | |
| 			if ( valtype!=sp_scon) 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>2 ) {
 | |
| 				werror("mes ms_ext must be first or second 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)   ;
 | |
| }
 | |
| 
 | |
| 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,size-1) ;
 | |
| 		a_lnp->ad.ad_ln.ln_extra -= size ;
 | |
| 		size=0 ;
 | |
| 	} else  {
 | |
| 		if( a_lnp) 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 ( !b_lnp ) { /* if a_lnp==0, so is b_lnp */
 | |
| 		fatal("Cannot perform exchange") ;
 | |
| 	}
 | |
| 	if ( ( size-= p2 )>0 ) {
 | |
| 		if ( ctrunc(b_lnp->instr_num) !=sp_fpseu ) {
 | |
| 			fatal("EXC inconsistency") ;
 | |
| 		}
 | |
| 		doinsert(b_lnp,line,size-1) ;
 | |
| 		b_lnp->ad.ad_ln.ln_extra -= size ;
 | |
| 	} else  {
 | |
| 		doinsert(b_lnp,line,-1) ;
 | |
| 	}
 | |
| 	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) ;
 | |
| 	databytes= wordsize ;
 | |
| 	setmode(DATA_REP) ;
 | |
| 	if ( wordsize<ABSSIZE ) {
 | |
| 		register factor = ABSSIZE/wordsize - 1 ;
 | |
| 		extadr( (cons_t) factor ) ;
 | |
| 		databytes += factor * wordsize ;
 | |
| 	}
 | |
| 	absout++ ;
 | |
| 	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 ; {
 | |
| 	while ( databytes%size ) {
 | |
| 		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 ;
 | |
| 	cons_t sv_argval;
 | |
| 	int sv_tabval;
 | |
| 
 | |
| 	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");
 | |
| 	sv_tabval = tabval;
 | |
| 	sv_argval = argval;
 | |
| 	getarg(sp_cst2);
 | |
| 	if ( argval<0 || argval>1 ) error("illegal last argument") ;
 | |
| 	databytes +=n ;
 | |
| 	if (argval == 1) {
 | |
| 		tabval = sv_tabval;
 | |
| 		argval = sv_argval;
 | |
| 		putval();
 | |
| 		amount= n/objsize ;
 | |
| 		if ( amount>1 ) {
 | |
| 			setmode(DATA_REP);
 | |
| 			extadr(amount-1) ;
 | |
| 		}
 | |
| 	}
 | |
| 	else {
 | |
| 		n = (n + wordsize - 1) / wordsize;
 | |
| 		while (n > MAXBYTE) {
 | |
| 			setmode(DATA_BSS);
 | |
| 			ext8(MAXBYTE);
 | |
| 			n -= MAXBYTE;
 | |
| 		}
 | |
| 		setmode(DATA_BSS);
 | |
| 		ext8((int) n);
 | |
| 	}
 | |
| }
 | |
| 
 | |
| 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 ;
 | |
| }
 |