util/ass/ass80.c

   1 /*
   2  * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
   3  * See the copyright notice in the ACK home directory, in the file "Copyright".
   4  *
   5  */
   6
   7 #include        "ass00.h"
   8 #include        "assex.h"
   9 #include        <em_path.h>
  10
  11 #ifndef NORCSID
  12 static char rcs_id[] = "$Id: ass80.c,v 2.9 1994/06/24 10:15:23 ceriel Exp $" ;
  13 #endif
  14
  15 /*
  16  * this file contains several library routines.
  17  */
  18
  19 zero(area,length) char *area; unsigned length ; {
  20         register char *p;
  21         register n;
  22         /*
  23          * Clear area of length bytes.
  24          */
  25         if ((n=length)==0)
  26                 return;
  27         p = area;
  28         do *p++=0; while (--n);
  29 }
  30
  31 /* VARARGS1 */
  32 static void pr_error(string1,a1,a2,a3,a4) char *string1 ; {
  33         /*
  34          * diagnostic output
  35          */
  36         fprintf(stderr,"%s: ",progname);
  37         if (curfile) {
  38                 fprintf(stderr,"file %s",curfile);
  39                 if (archmode)
  40                         fprintf(stderr," (%.14s)",archhdr.ar_name);
  41                 fprintf(stderr,": ");
  42         }
  43         if ( pstate.s_curpro ) {
  44                 fprintf(stderr,"proc %s, ",pstate.s_curpro->p_name);
  45         }
  46         fprintf(stderr,"line %d: ",line_num);
  47         fprintf(stderr,string1,a1,a2,a3,a4);
  48         fprintf(stderr,"\n");
  49 }
  50
  51 /* VARARGS1 */
  52 void error(string1,a1,a2,a3,a4) char *string1 ; {
  53         pr_error(string1,a1,a2,a3,a4) ;
  54         nerrors++ ;
  55 }
  56
  57 /* VARARGS1 */
  58 void werror(string1,a1,a2,a3,a4) char *string1 ; {
  59         if ( wflag ) return ;
  60         pr_error(string1,a1,a2,a3,a4) ;
  61 }
  62
  63 fatal(s) char *s; {
  64         /*
  65          * handle fatal errors
  66          */
  67         error("Fatal error: %s",s);
  68         dump(0);
  69         exit(-1);
  70 }
  71
  72 #ifndef CPM
  73 FILE *frewind(f) FILE *f ; {
  74         /* Rewind a file open for writing and open it for reading */
  75         /* Assumption, file descriptor is r/w */
  76         register FILE *tmp ;
  77         tmp=fdopen(dup(fileno(f)),"r");
  78         fclose(f);
  79         rewind(tmp);
  80         return tmp ;
  81 }
  82 #endif
  83
  84 int xgetc(af) register FILE *af; {
  85         register int nextc;
  86         /*
  87          * read next character; fatal if there isn't one
  88          */
  89         nextc=fgetc(af) ;
  90         if ( feof(af) )
  91                         fatal("unexpected end of file");
  92         return nextc ;
  93 }
  94
  95 xputc(c,af) register FILE *af; {
  96         /* output one character and scream if it gives an error */
  97         fputc(c,af) ;
  98         if ( ferror(af) ) fatal("write error") ;
  99 }
 100
 101
 102 putblk(stream,from,amount)
 103         register FILE *stream; register char *from ; register int amount ; {
 104
 105         for ( ; amount-- ; from++ ) {
 106                 fputc(*from,stream) ;
 107                 if ( ferror(stream) ) fatal("write error") ;
 108         }
 109 }
 110
 111 int getblk(stream,from,amount)
 112         register FILE *stream; register char *from ; register int amount ; {
 113
 114         for ( ; amount-- ; from++ ) {
 115                 *from = fgetc(stream) ;
 116                 if ( feof(stream) ) return 1 ;
 117         }
 118         return 0 ;
 119 }
 120
 121 xput16(w,f) FILE *f; {
 122         /*
 123          * two times xputc
 124          */
 125         xputc(w,f);
 126         xputc(w>>8,f);
 127 }
 128
 129 xputarb(l,w,f) int l ; cons_t w ; FILE *f ; {
 130         while ( l-- ) {
 131                 xputc( int_cast w,f) ;
 132                 w >>=8 ;
 133         }
 134 }
 135
 136 put8(n) {
 137         xputc(n,tfile);
 138         textoff++;
 139 }
 140
 141 put16(n) {
 142         /*
 143          * note reversed order of bytes.
 144          * this is done for faster interpretation.
 145          */
 146         xputc(n>>8,tfile);
 147         xputc(n&0377,tfile);
 148         textoff += 2;
 149 }
 150
 151 put32(n) cons_t n ; {
 152         put16( int_cast (n>>16)) ;
 153         put16( int_cast n) ;
 154 }
 155
 156 put64(n) cons_t n ; {
 157         fatal("put64 called") ;
 158 }
 159
 160 int xget8() {
 161         /*
 162          * Read one byte from ifile.
 163          */
 164         if (libeof && inpoff >= libeof)
 165                 return EOF ;
 166         inpoff++;
 167         return fgetc(ifile) ;
 168 }
 169
 170 unsigned get8() {
 171         register int nextc;
 172         /*
 173          * Read one byte from ifile.
 174          */
 175         nextc=xget8();
 176         if ( nextc==EOF ) {
 177                 if (libeof)
 178                         fatal("Tried to read past end of arentry\n");
 179                 else
 180                         fatal("end of file on input");
 181         }
 182         return nextc ;
 183 }
 184
 185 cons_t xgetarb(l,f) int l; FILE *f ; {
 186         cons_t val ;
 187         register int shift ;
 188         int c;
 189
 190         shift=0 ; val=0 ;
 191         while ( l-- ) {
 192                 val += ((cons_t)(c = ctrunc(xgetc(f))))<<shift ;
 193                 shift += 8 ;
 194         }
 195         if (c == 0377 && shift > 8 && ((shift>>3)&1)) {
 196                 while (shift < 8*sizeof(cons_t)) {
 197                         val += ((cons_t)c)<<shift ;
 198                         shift += 8;
 199                 }
 200         }
 201         return val ;
 202 }
 203
 204 ext8(b) {
 205         /*
 206          * Handle one byte of data.
 207          */
 208         ++dataoff;
 209         xputc(b,dfile);
 210 }
 211
 212 extword(w) cons_t w ; {
 213         /* Assemble the word constant w.
 214          * NOTE: The bytes are written low to high.
 215          */
 216         register i ;
 217         for ( i=wordsize ; i-- ; ) {
 218                 ext8( int_cast w) ;
 219                 w >>= 8 ;
 220         }
 221 }
 222
 223 extarb(size,value) int size ; long value ; {
 224         /* Assemble the 'size' constant value.
 225          * The bytes are again written low to high.
 226          */
 227         register i ;
 228         for ( i=size ; i-- ; ) {
 229                 ext8( int_cast value ) ;
 230                 value >>=8 ;
 231         }
 232 }
 233
 234 extadr(a) cons_t a ; {
 235         /* Assemble the word constant a.
 236          * NOTE: The bytes are written low to high.
 237          */
 238         register i ;
 239         for ( i=ptrsize ; i-- ; ) {
 240                 ext8( int_cast a) ;
 241                 a >>= 8 ;
 242         }
 243 }
 244
 245 xputa(a,f) cons_t a ; FILE *f ; {
 246         /* Assemble the pointer constant a.
 247          * NOTE: The bytes are written low to high.
 248          */
 249         register i ;
 250         for ( i=ptrsize ; i-- ; ) {
 251                 xputc( int_cast a,f) ;
 252                 a >>= 8 ;
 253         }
 254 }
 255
 256 cons_t xgeta(f) FILE *f ; {
 257         /* Read the pointer constant a.
 258          * NOTE: The bytes were written low to high.
 259          */
 260         register i, shift ;
 261         cons_t val ;
 262         val = 0 ; shift=0 ;
 263         for ( i=ptrsize ; i-- ; ) {
 264                 val += ((cons_t)xgetc(f))<<shift ;
 265                 shift += 8 ;
 266         }
 267         return val ;
 268 }
 269
 270 int icount(size) {
 271         int amount ;
 272         amount=(dataoff-lastoff)/size ;
 273         if ( amount>MAXBYTE) fatal("Descriptor overflow");
 274         return amount ;
 275 }
 276
 277 setmode(mode) {
 278
 279         if (datamode==mode) {   /* in right mode already */
 280                 switch ( datamode ) {
 281                 case DATA_CONST:
 282                         if ( (dataoff-lastoff)/wordsize < MAXBYTE ) return ;
 283                         break ;
 284                 case DATA_BYTES:
 285                         if ( dataoff-lastoff < MAXBYTE ) return ;
 286                         break ;
 287                 case DATA_IPTR:
 288                 case DATA_DPTR:
 289                         if ( (dataoff-lastoff)/ptrsize < MAXBYTE ) return ;
 290                         break ;
 291                 case DATA_ICON:
 292                 case DATA_FCON:
 293                 case DATA_UCON:
 294                 case DATA_BSS:
 295                         break ;
 296                 default:
 297                         return ;
 298                 }
 299                 setmode(DATA_NUL) ; /* flush current descriptor */
 300                 setmode(mode) ;
 301                 return;
 302         }
 303         switch(datamode) {              /* terminate current mode */
 304         case DATA_NUL:
 305                 break;                  /* nothing to terminate */
 306         case DATA_CONST:
 307                 lastheader->r_val.rel_i=icount(wordsize) ;
 308                 lastheader->r_typ = RELHEAD;
 309                 datablocks++;
 310                 break;
 311         case DATA_BYTES:
 312                 lastheader->r_val.rel_i=icount(1) ;
 313                 lastheader->r_typ = RELHEAD;
 314                 datablocks++;
 315                 break;
 316         case DATA_DPTR:
 317         case DATA_IPTR:
 318                 lastheader->r_val.rel_i=icount(ptrsize) ;
 319                 lastheader->r_typ = RELHEAD;
 320                 datablocks++;
 321                 break;
 322         default:
 323                 datablocks++;
 324                 break;
 325         }
 326         datamode=mode;
 327         switch(datamode) {
 328         case DATA_NUL:
 329                 break;
 330         case DATA_CONST:
 331                 ext8(HEADCONST);
 332                 lastheader=data_reloc( chp_cast 0,dataoff,RELNULL);
 333                 ext8(0);
 334                 lastoff=dataoff;
 335                 break;
 336         case DATA_BYTES:
 337                 ext8(HEADBYTE);
 338                 lastheader=data_reloc( chp_cast 0,dataoff,RELNULL);
 339                 ext8(0);
 340                 lastoff=dataoff;
 341                 break;
 342         case DATA_IPTR:
 343                 ext8(HEADIPTR);
 344                 lastheader=data_reloc( chp_cast 0,dataoff,RELNULL);
 345                 ext8(0);
 346                 lastoff=dataoff;
 347                 break;
 348         case DATA_DPTR:
 349                 ext8(HEADDPTR);
 350                 lastheader=data_reloc( chp_cast 0,dataoff,RELNULL);
 351                 ext8(0);
 352                 lastoff=dataoff;
 353                 break;
 354         case DATA_ICON:
 355                 ext8(HEADICON) ;
 356                 ext8( int_cast consiz) ;
 357                 break;
 358         case DATA_FCON:
 359                 ext8(HEADFCON) ;
 360                 ext8( int_cast consiz) ;
 361                 break;
 362         case DATA_UCON:
 363                 ext8(HEADUCON) ;
 364                 ext8( int_cast consiz) ;
 365                 break;
 366         case DATA_REP:
 367                 ext8(HEADREP) ;
 368                 break ;
 369         case DATA_BSS:
 370                 ext8(HEADBSS) ;
 371                 break;
 372         default:
 373                 fatal("Unknown mode in setmode") ;
 374         }
 375 }
 376
 377 #ifndef CPM
 378 int tmpfil() {
 379         register char *fname, *cpname ;
 380         static char sfname[] = "tmp.00000";
 381         register fildes,pid;
 382         static char name[80] = TMP_DIR ;
 383         int count;
 384         /*
 385          * This procedure returns a file-descriptor of a temporary
 386          * file valid for reading and writing.
 387          * After closing the tmpfil-descriptor the file is lost
 388          * Calling this routine frees the program from generating uniqe names.
 389          */
 390         fname = sfname+4;
 391         count = 10;
 392         pid = getpid();
 393         while (pid!=0) {
 394                 *fname++ = (pid&07) + '0';
 395                 pid >>= 3;
 396         }
 397         *fname = 0;
 398         for ( fname=name ; *fname ; fname++ ) ;
 399         cpname=sfname ;
 400         while ( *fname++ = *cpname++ ) ;
 401         do {
 402                 fname = name;
 403                 if ((fildes = creat(fname, 0600)) < 0)
 404                         if ((fildes = creat(fname=sfname, 0600)) < 0)
 405                                 return(-1);
 406                 if (close(fildes) < 0)
 407                         ;
 408         } while((fildes = open(fname, 2)) < 0 && count--);
 409         if (unlink(fname) < 0)
 410                 ;
 411         return(fildes);
 412 }
 413 #endif