/* * (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_path.h" #ifndef NORCSID static char rcs_id[] = "$Header$" ; #endif /* * 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 ; int c; shift=0 ; val=0 ; while ( l-- ) { val += ((cons_t)(c = ctrunc(xgetc(f))))< 8 && ((shift>>3)&1)) { while (shift < 8*sizeof(cons_t)) { val += ((cons_t)c)<>= 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))<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: case DATA_BSS: 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 ; case DATA_BSS: ext8(HEADBSS) ; 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