source: trunk/minix/commands/i386/acd.c@ 15

Last change on this file since 15 was 9, checked in by Mattia Monga, 14 years ago

Minix 3.1.2a
File size: 57.1 KB
Line 
1/* acd 1.10 - A compiler driver Author: Kees J. Bot
2 * 7 Jan 1993
3 * Needs about 25kw heap + stack.
4 */
5char version[] = "1.9";
6
7#define nil 0
8#define _POSIX_SOURCE 1
9#include <sys/types.h>
10#include <stdio.h>
11#include <stddef.h>
12#include <stdlib.h>
13#include <unistd.h>
14#include <fcntl.h>
15#include <string.h>
16#include <signal.h>
17#include <errno.h>
18#include <ctype.h>
19#include <assert.h>
20#include <sys/stat.h>
21#include <sys/wait.h>
22
23#ifndef LIB
24#define LIB "/usr/lib" /* Default library directory. */
25#endif
26
27#define arraysize(a) (sizeof(a) / sizeof((a)[0]))
28#define arraylimit(a) ((a) + arraysize(a))
29
30char *program; /* Call name. */
31
32int verbose= 0; /* -v0: Silent.
33 * -v1: Show abbreviated pass names.
34 * -v2: Show executed UNIX commands.
35 * -v3: Show executed ACD commands.
36 * -v4: Show descr file as it is read.
37 */
38
39int action= 2; /* 0: An error occured, don't do anything anymore.
40 * 1: (-vn) Do not execute, play-act.
41 * 2: Execute UNIX commands.
42 */
43
44void report(char *label)
45{
46 if (label == nil || label[0] == 0) {
47 fprintf(stderr, "%s: %s\n", program, strerror(errno));
48 } else {
49 fprintf(stderr, "%s: %s: %s\n",
50 program, label, strerror(errno));
51 }
52 action= 0;
53}
54
55void quit(int exit_code);
56
57void fatal(char *label)
58{
59 report(label);
60 quit(-1);
61}
62
63size_t heap_chunks= 0;
64
65void *allocate(void *mem, size_t size)
66/* Safe malloc/realloc. (I have heard that one can call realloc with a
67 * null first argument with the effect below, but that is of course to
68 * ridiculous to believe.)
69 */
70{
71 assert(size > 0);
72
73 if (mem != nil) {
74 mem= realloc(mem, size);
75 } else {
76 mem= malloc(size);
77 heap_chunks++;
78 }
79 if (mem == nil) fatal(nil);
80 return mem;
81}
82
83void deallocate(void *mem)
84{
85 if (mem != nil) {
86 free(mem);
87 heap_chunks--;
88 }
89}
90
91char *copystr(const char *s)
92{
93 char *c;
94 c= allocate(nil, (strlen(s)+1) * sizeof(*c));
95 strcpy(c, s);
96 return c;
97}
98
99/* Every object, list, letter, or variable, is made with cells. */
100typedef struct cell {
101 unsigned short refc; /* Reference count. */
102 char type; /* Type of object. */
103 unsigned char letter; /* Simply a letter. */
104 char *name; /* Name of a word. */
105 struct cell *hash; /* Hash chain. */
106 struct cell *car, *cdr; /* To form lists. */
107
108/* For a word: */
109# define value car /* Value of a variable. */
110# define base cdr /* Base-name in transformations. */
111# define suffix cdr /* Suffix in a treat-as. */
112# define flags letter /* Special flags. */
113
114/* A substitution: */
115# define subst car
116
117} cell_t;
118
119typedef enum type {
120 CELL, /* A list cell. */
121 STRING, /* To make a list of characters and substs. */
122 SUBST, /* Variable to substitute. */
123 /* Unique objects. */
124 LETTER, /* A letter. */
125 WORD, /* A string collapses to a word. */
126 EQUALS, /* = operator, etc. */
127 OPEN,
128 CLOSE,
129 PLUS,
130 MINUS,
131 STAR,
132 INPUT,
133 OUTPUT,
134 WHITE,
135 COMMENT,
136 SEMI,
137 EOLN,
138 N_TYPES /* number of different types */
139} type_t;
140
141#define is_unique(type) ((type) >= LETTER)
142
143/* Flags on a word. */
144#define W_SET 0x01 /* Not undefined, e.g. assigned to. */
145#define W_RDONLY 0x02 /* Read only. */
146#define W_LOCAL 0x04 /* Local variable, immediate substitution. */
147#define W_TEMP 0x08 /* Name of a temporary file, delete on quit. */
148#define W_SUFF 0x10 /* Has a suffix set on it. */
149
150void princhar(int c)
151/* Print a character, escaped if important to the shell *within* quotes. */
152{
153 if (strchr("\\'\"<>();~$^&*|{}[]?", c) != nil) fputc('\\', stdout);
154 putchar(c);
155}
156
157void prinstr(char *s)
158/* Print a string, in quotes if the shell might not like it. */
159{
160 int q= 0;
161 char *s2= s;
162
163 while (*s2 != 0)
164 if (strchr("~`$^&*()=\\|[]{};'\"<>?", *s2++) != nil) q= 1;
165
166 if (q) fputc('"', stdout);
167 while (*s != 0) princhar(*s++);
168 if (q) fputc('"', stdout);
169}
170
171void prin2(cell_t *p);
172
173void prin1(cell_t *p)
174/* Print a cell structure for debugging purposes. */
175{
176 if (p == nil) {
177 printf("(\b(\b()\b)\b)");
178 return;
179 }
180
181 switch (p->type) {
182 case CELL:
183 printf("(\b(\b(");
184 prin2(p);
185 printf(")\b)\b)");
186 break;
187 case STRING:
188 printf("\"\b\"\b\"");
189 prin2(p);
190 printf("\"\b\"\b\"");
191 break;
192 case SUBST:
193 printf("$\b$\b${%s}", p->subst->name);
194 break;
195 case LETTER:
196 princhar(p->letter);
197 break;
198 case WORD:
199 prinstr(p->name);
200 break;
201 case EQUALS:
202 printf("=\b=\b=");
203 break;
204 case PLUS:
205 printf("+\b+\b+");
206 break;
207 case MINUS:
208 printf("-\b-\b-");
209 break;
210 case STAR:
211 printf("*\b*\b*");
212 break;
213 case INPUT:
214 printf(verbose >= 3 ? "<\b<\b<" : "<");
215 break;
216 case OUTPUT:
217 printf(verbose >= 3 ? ">\b>\b>" : ">");
218 break;
219 default:
220 assert(0);
221 }
222}
223
224void prin2(cell_t *p)
225/* Print a list for debugging purposes. */
226{
227 while (p != nil && p->type <= STRING) {
228 prin1(p->car);
229
230 if (p->type == CELL && p->cdr != nil) fputc(' ', stdout);
231
232 p= p->cdr;
233 }
234 if (p != nil) prin1(p); /* Dotted pair? */
235}
236
237void prin1n(cell_t *p) { prin1(p); fputc('\n', stdout); }
238
239void prin2n(cell_t *p) { prin2(p); fputc('\n', stdout); }
240
241/* A program is consists of a series of lists at a certain indentation level. */
242typedef struct program {
243 struct program *next;
244 cell_t *file; /* Associated description file. */
245 unsigned indent; /* Line indentation level. */
246 unsigned lineno; /* Line number where this is found. */
247 cell_t *line; /* One line of tokens. */
248} program_t;
249
250program_t *pc; /* Program Counter (what else?) */
251program_t *nextpc; /* Next line to execute. */
252
253cell_t *oldcells; /* Keep a list of old cells, don't deallocate. */
254
255cell_t *newcell(void)
256/* Make a new empty cell. */
257{
258 cell_t *p;
259
260 if (oldcells != nil) {
261 p= oldcells;
262 oldcells= p->cdr;
263 heap_chunks++;
264 } else {
265 p= allocate(nil, sizeof(*p));
266 }
267
268 p->refc= 0;
269 p->type= CELL;
270 p->letter= 0;
271 p->name= nil;
272 p->car= nil;
273 p->cdr= nil;
274 return p;
275}
276
277#define N_CHARS (1 + (unsigned char) -1)
278#define HASHDENSE 0x400
279
280cell_t *oblist[HASHDENSE + N_CHARS + N_TYPES];
281
282unsigned hashfun(cell_t *p)
283/* Use a blender on a cell. */
284{
285 unsigned h;
286 char *name;
287
288 switch (p->type) {
289 case WORD:
290 h= 0;
291 name= p->name;
292 while (*name != 0) h= (h * 0x1111) + *name++;
293 return h % HASHDENSE;
294 case LETTER:
295 return HASHDENSE + p->letter;
296 default:
297 return HASHDENSE + N_CHARS + p->type;
298 }
299}
300
301cell_t *search(cell_t *p, cell_t ***hook)
302/* Search for *p, return the one found. *hook may be used to insert or
303 * delete.
304 */
305{
306 cell_t *sp;
307
308 sp= *(*hook= &oblist[hashfun(p)]);
309
310 if (p->type == WORD) {
311 /* More than one name per hash slot. */
312 int cmp= 0;
313
314 while (sp != nil && (cmp= strcmp(p->name, sp->name)) > 0)
315 sp= *(*hook= &sp->hash);
316
317 if (cmp != 0) sp= nil;
318 }
319 return sp;
320}
321
322void dec(cell_t *p)
323/* Decrease the number of references to p, if zero delete and recurse. */
324{
325 if (p == nil || --p->refc > 0) return;
326
327 if (is_unique(p->type)) {
328 /* Remove p from the oblist. */
329 cell_t *o, **hook;
330
331 o= search(p, &hook);
332
333 if (o == p) {
334 /* It's there, remove it. */
335 *hook= p->hash;
336 p->hash= nil;
337 }
338
339 if (p->type == WORD && (p->flags & W_TEMP)) {
340 /* A filename to remove. */
341 if (verbose >= 2) {
342 printf("rm -f ");
343 prinstr(p->name);
344 fputc('\n', stdout);
345 }
346 if (unlink(p->name) < 0 && errno != ENOENT)
347 report(p->name);
348 }
349 }
350 deallocate(p->name);
351 dec(p->car);
352 dec(p->cdr);
353 p->cdr= oldcells;
354 oldcells= p;
355 heap_chunks--;
356}
357
358cell_t *inc(cell_t *p)
359/* Increase the number of references to p. */
360{
361 cell_t *o, **hook;
362
363 if (p == nil) return nil;
364
365 if (++p->refc > 1 || !is_unique(p->type)) return p;
366
367 /* First appearance, put p on the oblist. */
368 o= search(p, &hook);
369
370 if (o == nil) {
371 /* Not there yet, add it. */
372 p->hash= *hook;
373 *hook= p;
374 } else {
375 /* There is another object already there with the same info. */
376 o->refc++;
377 dec(p);
378 p= o;
379 }
380 return p;
381}
382
383cell_t *go(cell_t *p, cell_t *field)
384/* Often happening: You've got p, you want p->field. */
385{
386 field= inc(field);
387 dec(p);
388 return field;
389}
390
391cell_t *cons(type_t type, cell_t *p)
392/* P is to be added to a list (or a string). */
393{
394 cell_t *l= newcell();
395 l->type= type;
396 l->refc++;
397 l->car= p;
398 return l;
399}
400
401cell_t *append(type_t type, cell_t *p)
402/* P is to be appended to a list (or a string). */
403{
404 return p == nil || p->type == type ? p : cons(type, p);
405}
406
407cell_t *findnword(char *name, size_t n)
408/* Find the word with the given name of length n. */
409{
410 cell_t *w= newcell();
411 w->type= WORD;
412 w->name= allocate(nil, (n+1) * sizeof(*w->name));
413 memcpy(w->name, name, n);
414 w->name[n]= 0;
415 return inc(w);
416}
417
418cell_t *findword(char *name)
419/* Find the word with the given null-terminated name. */
420{
421 return findnword(name, strlen(name));
422}
423
424void quit(int exstat)
425/* Remove all temporary names, then exit. */
426{
427 cell_t **op, *p, *v, *b;
428 size_t chunks;
429
430 /* Remove cycles, like X = X. */
431 for (op= oblist; op < oblist + HASHDENSE; op++) {
432 p= *op;
433 while (p != nil) {
434 if (p->value != nil || p->base != nil) {
435 v= p->value;
436 b= p->base;
437 p->value= nil;
438 p->base= nil;
439 p= *op;
440 dec(v);
441 dec(b);
442 } else {
443 p= p->hash;
444 }
445 }
446 }
447 chunks= heap_chunks;
448
449 /* Something may remain on an early quit: tempfiles. */
450 for (op= oblist; op < oblist + HASHDENSE; op++) {
451
452 while (*op != nil) { (*op)->refc= 1; dec(*op); }
453 }
454
455 if (exstat != -1 && chunks > 0) {
456 fprintf(stderr,
457 "%s: internal fault: %d chunks still on the heap\n",
458 program, chunks);
459 }
460 exit(exstat);
461}
462
463void interrupt(int sig)
464{
465 signal(sig, interrupt);
466 if (verbose >= 2) write(1, "# interrupt\n", 12);
467 action= 0;
468}
469
470int extalnum(int c)
471/* Uppercase, lowercase, digit, underscore or anything non-American. */
472{
473 return isalnum(c) || c == '_' || c >= 0200;
474}
475
476char *descr; /* Name of current description file. */
477FILE *dfp; /* Open description file. */
478int dch; /* Input character. */
479unsigned lineno; /* Line number in file. */
480unsigned indent; /* Indentation level. */
481
482void getdesc(void)
483{
484 if (dch == EOF) return;
485
486 if (dch == '\n') { lineno++; indent= 0; }
487
488 if ((dch = getc(dfp)) == EOF && ferror(dfp)) fatal(descr);
489
490 if (dch == 0) {
491 fprintf(stderr, "%s: %s is a binary file.\n", program, descr);
492 quit(-1);
493 }
494}
495
496#define E_BASH 0x01 /* Escaped by backslash. */
497#define E_QUOTE 0x02 /* Escaped by double quote. */
498#define E_SIMPLE 0x04 /* More simple characters? */
499
500cell_t *get_token(void)
501/* Read one token from the description file. */
502{
503 int whitetype= 0;
504 static int escape= 0;
505 cell_t *tok;
506 char *name;
507 int n, i;
508
509 if (escape & E_SIMPLE) {
510 /* More simple characters? (Note: performance hack.) */
511 if (isalnum(dch)) {
512 tok= newcell();
513 tok->type= LETTER;
514 tok->letter= dch;
515 getdesc();
516 return inc(tok);
517 }
518 escape&= ~E_SIMPLE;
519 }
520
521 /* Gather whitespace. */
522 for (;;) {
523 if (dch == '\\' && whitetype == 0) {
524 getdesc();
525 if (isspace(dch)) {
526 /* \ whitespace: remove. */
527 do {
528 getdesc();
529 if (dch == '#' && !(escape & E_QUOTE)) {
530 /* \ # comment */
531 do
532 getdesc();
533 while (dch != '\n'
534 && dch != EOF);
535 }
536 } while (isspace(dch));
537 continue;
538 }
539 escape|= E_BASH; /* Escaped character. */
540 }
541
542 if (escape != 0) break;
543
544 if (dch == '#' && (indent == 0 || whitetype != 0)) {
545 /* # Comment. */
546 do getdesc(); while (dch != '\n' && dch != EOF);
547 whitetype= COMMENT;
548 break;
549 }
550
551 if (!isspace(dch) || dch == '\n' || dch == EOF) break;
552
553 whitetype= WHITE;
554
555 indent++;
556 if (dch == '\t') indent= (indent + 7) & ~7;
557
558 getdesc();
559 }
560
561 if (dch == EOF) return nil;
562
563 /* Make a token. */
564 tok= newcell();
565
566 if (whitetype != 0) {
567 tok->type= whitetype;
568 return inc(tok);
569 }
570
571 if (!(escape & E_BASH) && dch == '"') {
572 getdesc();
573 if (!(escape & E_QUOTE)) {
574 /* Start of a string, signal this with a string cell. */
575 escape|= E_QUOTE;
576 tok->type= STRING;
577 return inc(tok);
578 } else {
579 /* End of a string, back to normal mode. */
580 escape&= ~E_QUOTE;
581 deallocate(tok);
582 return get_token();
583 }
584 }
585
586 if (escape & E_BASH
587 || strchr(escape & E_QUOTE ? "$" : "$=()+-*<>;\n", dch) == nil
588 ) {
589 if (dch == '\n') {
590 fprintf(stderr,
591 "\"%s\", line %u: missing closing quote\n",
592 descr, lineno);
593 escape&= ~E_QUOTE;
594 action= 0;
595 }
596 if (escape & E_BASH && dch == 'n') dch= '\n';
597 escape&= ~E_BASH;
598
599 /* A simple character. */
600 tok->type= LETTER;
601 tok->letter= dch;
602 getdesc();
603 escape|= E_SIMPLE;
604 return inc(tok);
605 }
606
607 if (dch != '$') {
608 /* Single character token. */
609 switch (dch) {
610 case '=': tok->type= EQUALS; break;
611 case '(': tok->type= OPEN; break;
612 case ')': tok->type= CLOSE; break;
613 case '+': tok->type= PLUS; break;
614 case '-': tok->type= MINUS; break;
615 case '*': tok->type= STAR; break;
616 case '<': tok->type= INPUT; break;
617 case '>': tok->type= OUTPUT; break;
618 case ';': tok->type= SEMI; break;
619 case '\n': tok->type= EOLN; break;
620 }
621 getdesc();
622 return inc(tok);
623 }
624
625 /* Substitution. */
626 getdesc();
627 if (dch == EOF || isspace(dch)) {
628 fprintf(stderr, "\"%s\", line %u: Word expected after '$'\n",
629 descr, lineno);
630 action= 0;
631 deallocate(tok);
632 return get_token();
633 }
634
635 name= allocate(nil, (n= 16) * sizeof(*name));
636 i= 0;
637
638 if (dch == '{' || dch == '(' /* )} */ ) {
639 /* $(X), ${X} */
640 int lpar= dch; /* ( */
641 int rpar= lpar == '{' ? '}' : ')';
642
643 for (;;) {
644 getdesc();
645 if (dch == rpar) { getdesc(); break; }
646 if (isspace(dch) || dch == EOF) {
647 fprintf(stderr,
648 "\"%s\", line %u: $%c unmatched, no '%c'\n",
649 descr, lineno, lpar, rpar);
650 action= 0;
651 break;
652 }
653 name[i++]= dch;
654 if (i == n)
655 name= allocate(name, (n*= 2) * sizeof(char));
656 }
657 } else
658 if (extalnum(dch)) {
659 /* $X */
660 do {
661 name[i++]= dch;
662 if (i == n)
663 name= allocate(name, (n*= 2) * sizeof(char));
664 getdesc();
665 } while (extalnum(dch));
666 } else {
667 /* $* */
668 name[i++]= dch;
669 getdesc();
670 }
671 name[i++]= 0;
672 name= allocate(name, i * sizeof(char));
673 tok->type= SUBST;
674 tok->subst= newcell();
675 tok->subst->type= WORD;
676 tok->subst->name= name;
677 tok->subst= inc(tok->subst);
678 return inc(tok);
679}
680
681typedef enum how { SUPERFICIAL, PARTIAL, FULL, EXPLODE, IMPLODE } how_t;
682
683cell_t *explode(cell_t *p, how_t how);
684
685cell_t *get_string(cell_t **pp)
686/* Get a string: A series of letters and substs. Special tokens '=', '+', '-'
687 * and '*' are also recognized if on their own. A finished string is "exploded"
688 * to a word if it consists of letters only.
689 */
690{
691 cell_t *p= *pp, *s= nil, **ps= &s;
692 int quoted= 0;
693
694 while (p != nil) {
695 switch (p->type) {
696 case STRING:
697 quoted= 1;
698 dec(p);
699 break;
700 case EQUALS:
701 case PLUS:
702 case MINUS:
703 case STAR:
704 case SUBST:
705 case LETTER:
706 *ps= cons(STRING, p);
707 ps= &(*ps)->cdr;
708 break;
709 default:
710 goto got_string;
711 }
712 p= get_token();
713 }
714 got_string:
715 *pp= p;
716
717 /* A single special token must be folded up. */
718 if (!quoted && s != nil && s->cdr == nil) {
719 switch (s->car->type) {
720 case EQUALS:
721 case PLUS:
722 case MINUS:
723 case STAR:
724 case SUBST:
725 return go(s, s->car);
726 }
727 }
728
729 /* Go over the string changing '=', '+', '-', '*' to letters. */
730 for (p= s; p != nil; p= p->cdr) {
731 int c= 0;
732
733 switch (p->car->type) {
734 case EQUALS:
735 c= '='; break;
736 case PLUS:
737 c= '+'; break;
738 case MINUS:
739 c= '-'; break;
740 case STAR:
741 c= '*'; break;
742 }
743 if (c != 0) {
744 dec(p->car);
745 p->car= newcell();
746 p->car->type= LETTER;
747 p->car->letter= c;
748 p->car= inc(p->car);
749 }
750 }
751 return explode(s, SUPERFICIAL);
752}
753
754cell_t *get_list(cell_t **pp, type_t stop)
755/* Read a series of tokens upto a token of type "stop". */
756{
757 cell_t *p= *pp, *l= nil, **pl= &l;
758
759 while (p != nil && p->type != stop
760 && !(stop == EOLN && p->type == SEMI)) {
761 switch (p->type) {
762 case WHITE:
763 case COMMENT:
764 case SEMI:
765 case EOLN:
766 dec(p);
767 p= get_token();
768 break;
769 case OPEN:
770 /* '(' words ')'. */
771 dec(p);
772 p= get_token();
773 *pl= cons(CELL, get_list(&p, CLOSE));
774 pl= &(*pl)->cdr;
775 dec(p);
776 p= get_token();
777 break;
778 case CLOSE:
779 /* Unexpected closing parenthesis. (*/
780 fprintf(stderr, "\"%s\", line %u: unmatched ')'\n",
781 descr, lineno);
782 action= 0;
783 dec(p);
784 p= get_token();
785 break;
786 case INPUT:
787 case OUTPUT:
788 *pl= cons(CELL, p);
789 pl= &(*pl)->cdr;
790 p= get_token();
791 break;
792 case STRING:
793 case EQUALS:
794 case PLUS:
795 case MINUS:
796 case STAR:
797 case LETTER:
798 case SUBST:
799 *pl= cons(CELL, get_string(&p));
800 pl= &(*pl)->cdr;
801 break;
802 default:
803 assert(0);
804 }
805 }
806
807 if (p == nil && stop == CLOSE) {
808 /* Couldn't get the closing parenthesis. */
809 fprintf(stderr, "\"%s\", lines %u-%u: unmatched '('\n", /*)*/
810 descr, pc->lineno, lineno);
811 action= 0;
812 }
813 *pp= p;
814 return l;
815}
816
817program_t *get_line(cell_t *file)
818{
819 program_t *l;
820 cell_t *p;
821 static keep_indent= 0;
822 static unsigned old_indent= 0;
823
824 /* Skip leading whitespace to determine the indentation level. */
825 indent= 0;
826 while ((p= get_token()) != nil && p->type == WHITE) dec(p);
827
828 if (p == nil) return nil; /* EOF */
829
830 if (p->type == EOLN) indent= old_indent; /* Empty line. */
831
832 /* Make a program line. */
833 pc= l= allocate(nil, sizeof(*l));
834
835 l->next= nil;
836 l->file= inc(file);
837 l->indent= keep_indent ? old_indent : indent;
838 l->lineno= lineno;
839
840 l->line= get_list(&p, EOLN);
841
842 /* If the line ended in a semicolon then keep the indentation level. */
843 keep_indent= (p != nil && p->type == SEMI);
844 old_indent= l->indent;
845
846 dec(p);
847
848 if (verbose >= 4) {
849 if (l->line == nil)
850 fputc('\n', stdout);
851 else {
852 printf("%*s", (int) l->indent, "");
853 prin2n(l->line);
854 }
855 }
856 return l;
857}
858
859program_t *get_prog(void)
860/* Read the description file into core. */
861{
862 cell_t *file;
863 program_t *prog, **ppg= &prog;
864
865 descr= copystr(descr);
866
867 if (descr[0] == '-' && descr[1] == 0) {
868 /* -descr -: Read from standard input. */
869 deallocate(descr);
870 descr= copystr("stdin");
871 dfp= stdin;
872 } else {
873 char *d= descr;
874
875 if (*d == '.' && *++d == '.') d++;
876 if (*d != '/') {
877 /* -descr name: Read /usr/lib/<name>/descr. */
878
879 d= allocate(nil, sizeof(LIB) +
880 (strlen(descr) + 7) * sizeof(*d));
881 sprintf(d, "%s/%s/descr", LIB, descr);
882 deallocate(descr);
883 descr= d;
884 }
885 if ((dfp= fopen(descr, "r")) == nil) fatal(descr);
886 }
887 file= findword(descr);
888 deallocate(descr);
889 descr= file->name;
890
891 /* Preread the first character. */
892 dch= 0;
893 lineno= 1;
894 indent= 0;
895 getdesc();
896
897 while ((*ppg= get_line(file)) != nil) ppg= &(*ppg)->next;
898
899 if (dfp != stdin) (void) fclose(dfp);
900 dec(file);
901
902 return prog;
903}
904
905void makenames(cell_t ***ppr, cell_t *s, char **name, size_t i, size_t *n)
906/* Turn a string of letters and lists into words. A list denotes a choice
907 * between several paths, like a search on $PATH.
908 */
909{
910 cell_t *p, *q;
911 size_t len;
912
913 /* Simply add letters, skip empty lists. */
914 while (s != nil && (s->car == nil || s->car->type == LETTER)) {
915 if (s->car != nil) {
916 if (i == *n) *name= allocate(*name,
917 (*n *= 2) * sizeof(**name));
918 (*name)[i++]= s->car->letter;
919 }
920 s= s->cdr;
921 }
922
923 /* If the end is reached then make a word out of the result. */
924 if (s == nil) {
925 **ppr= cons(CELL, findnword(*name, i));
926 *ppr= &(**ppr)->cdr;
927 return;
928 }
929
930 /* Elements of a list must be tried one by one. */
931 p= s->car;
932 s= s->cdr;
933
934 while (p != nil) {
935 if (p->type == WORD) {
936 q= p; p= nil;
937 } else {
938 assert(p->type == CELL);
939 q= p->car; p= p->cdr;
940 assert(q != nil);
941 assert(q->type == WORD);
942 }
943 len= strlen(q->name);
944 if (i + len > *n) *name= allocate(*name,
945 (*n += i + len) * sizeof(**name));
946 memcpy(*name + i, q->name, len);
947
948 makenames(ppr, s, name, i+len, n);
949 }
950}
951
952int constant(cell_t *p)
953/* See if a string has been partially evaluated to a constant so that it
954 * can be imploded to a word.
955 */
956{
957 while (p != nil) {
958 switch (p->type) {
959 case CELL:
960 case STRING:
961 if (!constant(p->car)) return 0;
962 p= p->cdr;
963 break;
964 case SUBST:
965 return 0;
966 default:
967 return 1;
968 }
969 }
970 return 1;
971}
972
973cell_t *evaluate(cell_t *p, how_t how);
974
975cell_t *explode(cell_t *s, how_t how)
976/* Explode a string with several choices to just one list of choices. */
977{
978 cell_t *t, *r= nil, **pr= &r;
979 size_t i, n;
980 char *name;
981 struct stat st;
982
983 if (how >= PARTIAL) {
984 /* Evaluate the string, expanding substitutions. */
985 while (s != nil) {
986 assert(s->type == STRING);
987 t= inc(s->car);
988 s= go(s, s->cdr);
989
990 t= evaluate(t, how == IMPLODE ? EXPLODE : how);
991
992 /* A list of one element becomes that element. */
993 if (t != nil && t->type == CELL && t->cdr == nil)
994 t= go(t, t->car);
995
996 /* Append the result, trying to flatten it. */
997 *pr= t;
998
999 /* Find the end of what has just been added. */
1000 while ((*pr) != nil) {
1001 *pr= append(STRING, *pr);
1002 pr= &(*pr)->cdr;
1003 }
1004 }
1005 s= r;
1006 }
1007
1008 /* Is the result a simple string of constants? */
1009 if (how <= PARTIAL && !constant(s)) return s;
1010
1011 /* Explode the string to all possible choices, by now the string is
1012 * a series of characters, words and lists of words.
1013 */
1014 r= nil; pr= &r;
1015 name= allocate(nil, (n= 16) * sizeof(char));
1016 i= 0;
1017
1018 makenames(&pr, s, &name, i, &n);
1019 deallocate(name);
1020 assert(r != nil);
1021 dec(s);
1022 s= r;
1023
1024 /* "How" may specify that a choice must be made. */
1025 if (how == IMPLODE) {
1026 if (s->cdr != nil) {
1027 /* More than one choice, find the file. */
1028 do {
1029 assert(s->car->type == WORD);
1030 if (stat(s->car->name, &st) >= 0)
1031 return go(r, s->car); /* Found. */
1032 } while ((s= s->cdr) != nil);
1033 }
1034 /* The first name is the default if nothing is found. */
1035 return go(r, r->car);
1036 }
1037
1038 /* If the result is a list of one word then return that word, otherwise
1039 * turn it into a string again unless this explode has been called
1040 * by another explode. (Exploding a string inside a string, the joys
1041 * of recursion.)
1042 */
1043 if (s->cdr == nil) return go(s, s->car);
1044
1045 return how >= EXPLODE ? s : cons(STRING, s);
1046}
1047
1048void modify(cell_t **pp, cell_t *p, type_t mode)
1049/* Add or remove the element p from the list *pp. */
1050{
1051 while (*pp != nil) {
1052 *pp= append(CELL, *pp);
1053
1054 if ((*pp)->car == p) {
1055 /* Found it, if adding then exit, else remove. */
1056 if (mode == PLUS) break;
1057 *pp= go(*pp, (*pp)->cdr);
1058 } else
1059 pp= &(*pp)->cdr;
1060 }
1061
1062 if (*pp == nil && mode == PLUS) {
1063 /* Not found, add it. */
1064 *pp= cons(CELL, p);
1065 } else
1066 dec(p);
1067}
1068
1069int tainted(cell_t *p)
1070/* A variable is tainted (must be substituted) if either it is marked as a
1071 * local variable, or some subst in its value is.
1072 */
1073{
1074 if (p == nil) return 0;
1075
1076 switch (p->type) {
1077 case CELL:
1078 case STRING:
1079 return tainted(p->car) || tainted(p->cdr);
1080 case SUBST:
1081 return p->subst->flags & W_LOCAL || tainted(p->subst->value);
1082 default:
1083 return 0;
1084 }
1085}
1086
1087cell_t *evaluate(cell_t *p, how_t how)
1088/* Evaluate an expression, usually the right hand side of an assignment. */
1089{
1090 cell_t *q, *t, *r= nil, **pr= &r;
1091 type_t mode;
1092
1093 if (p == nil) return nil;
1094
1095 switch (p->type) {
1096 case CELL:
1097 break; /* see below */
1098 case STRING:
1099 return explode(p, how);
1100 case SUBST:
1101 if (how >= FULL || tainted(p))
1102 p= evaluate(go(p, p->subst->value), how);
1103 return p;
1104 case EQUALS:
1105 fprintf(stderr,
1106 "\"%s\", line %u: Can't do nested assignments\n",
1107 descr, pc->lineno);
1108 action= 0;
1109 dec(p);
1110 return nil;
1111 case LETTER:
1112 case WORD:
1113 case INPUT:
1114 case OUTPUT:
1115 case PLUS:
1116 case MINUS:
1117 return p;
1118 default:
1119 assert(0);
1120 }
1121
1122 /* It's a list, see if there is a '*' there forcing a full expansion,
1123 * or a '+' or '-' forcing an implosive expansion. (Yeah, right.)
1124 * Otherwise evaluate each element.
1125 */
1126 q = inc(p);
1127 while (p != nil) {
1128 if ((t= p->car) != nil) {
1129 if (t->type == STAR) {
1130 if (how < FULL) how= FULL;
1131 dec(q);
1132 *pr= evaluate(go(p, p->cdr), how);
1133 return r;
1134 }
1135 if (how>=FULL && (t->type == PLUS || t->type == MINUS))
1136 break;
1137 }
1138
1139 t= evaluate(inc(t), how);
1140 assert(p->type == CELL);
1141 p= go(p, p->cdr);
1142
1143 if (how >= FULL) {
1144 /* Flatten the list. */
1145 *pr= t;
1146 } else {
1147 /* Keep the nested list structure. */
1148 *pr= cons(CELL, t);
1149 }
1150
1151 /* Find the end of what has just been added. */
1152 while ((*pr) != nil) {
1153 *pr= append(CELL, *pr);
1154 pr= &(*pr)->cdr;
1155 }
1156 }
1157
1158 if (p == nil) {
1159 /* No PLUS or MINUS: done. */
1160 dec(q);
1161 return r;
1162 }
1163
1164 /* A PLUS or MINUS, reevaluate the original list implosively. */
1165 if (how < IMPLODE) {
1166 dec(r);
1167 dec(p);
1168 return evaluate(q, IMPLODE);
1169 }
1170 dec(q);
1171
1172 /* Execute the PLUSes and MINUSes. */
1173 while (p != nil) {
1174 t= inc(p->car);
1175 p= go(p, p->cdr);
1176
1177 if (t != nil && (t->type == PLUS || t->type == MINUS)) {
1178 /* Change the add/subtract mode. */
1179 mode= t->type;
1180 dec(t);
1181 continue;
1182 }
1183
1184 t= evaluate(t, IMPLODE);
1185
1186 /* Add or remove all elements of t to/from r. */
1187 while (t != nil) {
1188 if (t->type == CELL) {
1189 modify(&r, inc(t->car), mode);
1190 } else {
1191 modify(&r, t, mode);
1192 break;
1193 }
1194 t= go(t, t->cdr);
1195 }
1196 }
1197 return r;
1198}
1199
1200/* An ACD program can be in three phases: Initialization (the first run
1201 * of the program), argument scanning, and compilation.
1202 */
1203typedef enum phase { INIT, SCAN, COMPILE } phase_t;
1204
1205phase_t phase;
1206
1207typedef struct rule { /* Transformation rule. */
1208 struct rule *next;
1209 char type; /* arg, transform, combine */
1210 char flags;
1211 unsigned short npaths; /* Number of paths running through. */
1212# define match from /* Arg matching strings. */
1213 cell_t *from; /* Transformation source suffixe(s) */
1214 cell_t *to; /* Destination suffix. */
1215 cell_t *wait; /* Files waiting to be transformed. */
1216 program_t *prog; /* Program to execute. */
1217 struct rule *path; /* Transformation path. */
1218} rule_t;
1219
1220typedef enum ruletype { ARG, PREFER, TRANSFORM, COMBINE } ruletype_t;
1221
1222#define R_PREFER 0x01 /* A preferred transformation. */
1223
1224rule_t *rules= nil;
1225
1226void newrule(ruletype_t type, cell_t *from, cell_t *to)
1227/* Make a new rule cell. */
1228{
1229 rule_t *r= nil, **pr= &rules;
1230
1231 /* See if there is a rule with the same suffixes, probably a matching
1232 * transform and prefer, or a re-execution of the same arg command.
1233 */
1234 while ((r= *pr) != nil) {
1235 if (r->from == from && r->to == to) break;
1236 pr= &r->next;
1237 }
1238
1239 if (*pr == nil) {
1240 /* Add a new rule. */
1241 *pr= r= allocate(nil, sizeof(*r));
1242
1243 r->next= nil;
1244 r->type= type;
1245 r->flags= 0;
1246 r->from= r->to= r->wait= nil;
1247 r->path= nil;
1248 }
1249 if (type == TRANSFORM) r->type= TRANSFORM;
1250 if (type == PREFER) r->flags|= R_PREFER;
1251 if (type != PREFER) r->prog= pc;
1252 dec(r->from); r->from= from;
1253 dec(r->to); r->to= to;
1254}
1255
1256int talk(void)
1257/* True if verbose and if so indent what is to come. */
1258{
1259 if (verbose < 3) return 0;
1260 printf("%*s", (int) pc->indent, "");
1261 return 1;
1262}
1263
1264void unix_exec(cell_t *c)
1265/* Execute the list of words p as a UNIX command. */
1266{
1267 cell_t *v, *a;
1268 int fd[2];
1269 int *pf;
1270 char **argv;
1271 int i, n;
1272 int r, pid, status;
1273
1274 if (action == 0) return; /* Error mode. */
1275
1276 if (talk() || verbose >= 2) prin2n(c);
1277
1278 fd[0]= fd[1]= -1;
1279
1280 argv= allocate(nil, (n= 16) * sizeof(*argv));
1281 i= 0;
1282
1283 /* Gather argv[] and scan for I/O redirection. */
1284 for (v= c; v != nil; v= v->cdr) {
1285 a= v->car;
1286 pf= nil;
1287 if (a->type == INPUT) pf= &fd[0];
1288 if (a->type == OUTPUT) pf= &fd[1];
1289
1290 if (pf == nil) {
1291 /* An argument. */
1292 argv[i++]= a->name;
1293 if (i==n) argv= allocate(argv, (n*= 2) * sizeof(*argv));
1294 continue;
1295 }
1296 /* I/O redirection. */
1297 if ((v= v->cdr) == nil || (a= v->car)->type != WORD) {
1298 fprintf(stderr,
1299 "\"%s\", line %u: I/O redirection without a file\n",
1300 descr, pc->lineno);
1301 action= 0;
1302 if (v == nil) break;
1303 }
1304 if (*pf >= 0) close(*pf);
1305
1306 if (action >= 2
1307 && (*pf= open(a->name, pf == &fd[0] ? O_RDONLY
1308 : O_WRONLY | O_CREAT | O_TRUNC, 0666)) < 0
1309 ) {
1310 report(a->name);
1311 action= 0;
1312 }
1313 }
1314 argv[i]= nil;
1315
1316 if (i >= 0 && action > 0 && verbose == 1) {
1317 char *name= strrchr(argv[0], '/');
1318
1319 if (name == nil) name= argv[0]; else name++;
1320
1321 printf("%s\n", name);
1322 }
1323 if (i >= 0 && action >= 2) {
1324 /* Really execute the command. */
1325 fflush(stdout);
1326 switch (pid= fork()) {
1327 case -1:
1328 fatal("fork()");
1329 case 0:
1330 if (fd[0] >= 0) { dup2(fd[0], 0); close(fd[0]); }
1331 if (fd[1] >= 0) { dup2(fd[1], 1); close(fd[1]); }
1332 execvp(argv[0], argv);
1333 report(argv[0]);
1334 exit(-1);
1335 }
1336 }
1337 if (fd[0] >= 0) close(fd[0]);
1338 if (fd[1] >= 0) close(fd[1]);
1339
1340 if (i >= 0 && action >= 2) {
1341 /* Wait for the command to terminate. */
1342 while ((r= wait(&status)) != pid && (r >= 0 || errno == EINTR));
1343
1344 if (status != 0) {
1345 int sig= WTERMSIG(status);
1346
1347 if (!WIFEXITED(status)
1348 && sig != SIGINT && sig != SIGPIPE) {
1349 fprintf(stderr, "%s: %s: Signal %d%s\n",
1350 program, argv[0], sig,
1351 status & 0x80 ? " - core dumped" : "");
1352 }
1353 action= 0;
1354 }
1355 }
1356 deallocate(argv);
1357}
1358
1359/* Special read-only variables ($*) and lists. */
1360cell_t *V_star, **pV_star;
1361cell_t *L_files, **pL_files= &L_files;
1362cell_t *V_in, *V_out, *V_stop, *L_args, *L_predef;
1363
1364typedef enum exec { DOIT, DONT } exec_t;
1365
1366void execute(exec_t how, unsigned indent);
1367
1368int equal(cell_t *p, cell_t *q)
1369/* Two lists are equal if they contain each others elements. */
1370{
1371 cell_t *t, *m1, *m2;
1372
1373 t= inc(newcell());
1374 t->cdr= inc(newcell());
1375 t->cdr->cdr= inc(newcell());
1376 t->cdr->car= newcell();
1377 t->cdr->car->type= MINUS;
1378 t->cdr->car= inc(t->cdr->car);
1379
1380 /* Compute p - q. */
1381 t->car= inc(p);
1382 t->cdr->cdr->car= inc(q);
1383 m1= evaluate(inc(t), IMPLODE);
1384 dec(m1);
1385
1386 /* Compute q - p. */
1387 t->car= q;
1388 t->cdr->cdr->car= p;
1389 m2= evaluate(t, IMPLODE);
1390 dec(m2);
1391
1392 /* Both results must be empty. */
1393 return m1 == nil && m2 == nil;
1394}
1395
1396int wordlist(cell_t **pw, int atom)
1397/* Check if p is a list of words, typically an imploded list. Return
1398 * the number of words seen, -1 if they are not words (INPUT/OUTPUT?).
1399 * If atom is true than a list of one word is turned into a word.
1400 */
1401{
1402 int n= 0;
1403 cell_t *p, **pp= pw;
1404
1405 while (*pp != nil) {
1406 *pp= append(CELL, *pp);
1407 p= (*pp)->car;
1408 n= n >= 0 && p != nil && p->type == WORD ? n+1 : -1;
1409 pp= &(*pp)->cdr;
1410 }
1411 if (atom && n == 1) *pw= go(*pw, (*pw)->car);
1412 return n;
1413}
1414
1415char *template; /* Current name of a temporary file. */
1416static char *tp; /* Current place withing the tempfile. */
1417
1418char *maketemp(void)
1419/* Return a name that can be used as a temporary filename. */
1420{
1421 int i= 0;
1422
1423 if (tp == nil) {
1424 size_t len= strlen(template);
1425
1426 template= allocate(template, (len+20) * sizeof(*template));
1427 sprintf(template+len, "/acd%d", getpid());
1428 tp= template + strlen(template);
1429 }
1430
1431 for (;;) {
1432 switch (tp[i]) {
1433 case 0: tp[i]= 'a';
1434 tp[i+1]= 0; return template;
1435 case 'z': tp[i++]= 'a'; break;
1436 default: tp[i]++; return template;
1437 }
1438 }
1439}
1440
1441void inittemp(char *tmpdir)
1442/* Initialize the temporary filename generator. */
1443{
1444 template= allocate(nil, (strlen(tmpdir)+20) * sizeof(*template));
1445 sprintf(template, "%s/acd%d", tmpdir, getpid());
1446 tp= template + strlen(template);
1447
1448 /* Create a directory within tempdir that we can safely play in. */
1449 while (action != 1 && mkdir(template, 0700) < 0) {
1450 if (errno == EEXIST) {
1451 (void) maketemp();
1452 } else {
1453 report(template);
1454 action= 0;
1455 }
1456 }
1457 if (verbose >= 2) printf("mkdir %s\n", template);
1458 while (*tp != 0) tp++;
1459 *tp++= '/';
1460 *tp= 0;
1461}
1462
1463void deltemp(void)
1464/* Remove our temporary temporaries directory. */
1465{
1466 while (*--tp != '/') {}
1467 *tp = 0;
1468 if (rmdir(template) < 0 && errno != ENOENT) report(template);
1469 if (verbose >= 2) printf("rmdir %s\n", template);
1470 deallocate(template);
1471}
1472
1473cell_t *splitenv(char *env)
1474/* Split a string from the environment into several words at whitespace
1475 * and colons. Two colons (::) become a dot.
1476 */
1477{
1478 cell_t *r= nil, **pr= &r;
1479 char *p;
1480
1481 do {
1482 while (*env != 0 && isspace(*env)) env++;
1483
1484 if (*env == 0) break;
1485
1486 p= env;
1487 while (*p != 0 && !isspace(*p) && *p != ':') p++;
1488
1489 *pr= cons(CELL,
1490 p == env ? findword(".") : findnword(env, p-env));
1491 pr= &(*pr)->cdr;
1492 env= p;
1493 } while (*env++ != 0);
1494 return r;
1495}
1496
1497void key_usage(char *how)
1498{
1499 fprintf(stderr, "\"%s\", line %u: Usage: %s %s\n",
1500 descr, pc->lineno, pc->line->car->name, how);
1501 action= 0;
1502}
1503
1504void inappropriate(void)
1505{
1506 fprintf(stderr, "\"%s\", line %u: wrong execution phase for '%s'\n",
1507 descr, pc->lineno, pc->line->car->name);
1508 action= 0;
1509}
1510
1511int readonly(cell_t *v)
1512{
1513 if (v->flags & W_RDONLY) {
1514 fprintf(stderr, "\"%s\", line %u: %s is read-only\n",
1515 descr, pc->lineno, v->name);
1516 action= 0;
1517 return 1;
1518 }
1519 return 0;
1520}
1521
1522void complain(cell_t *err)
1523/* acd: err ... */
1524{
1525 cell_t *w;
1526
1527 fprintf(stderr, "%s:", program);
1528
1529 while (err != nil) {
1530 if (err->type == CELL) {
1531 w= err->car; err= err->cdr;
1532 } else {
1533 w= err; err= nil;
1534 }
1535 fprintf(stderr, " %s", w->name);
1536 }
1537 action= 0;
1538}
1539
1540int keyword(char *name)
1541/* True if the current line is headed by the given keyword. */
1542{
1543 cell_t *t;
1544
1545 return (t= pc->line) != nil && t->type == CELL
1546 && (t= t->car) != nil && t->type == WORD
1547 && strcmp(t->name, name) == 0;
1548}
1549
1550cell_t *getvar(cell_t *v)
1551/* Return a word or the word referenced by a subst. */
1552{
1553 if (v == nil) return nil;
1554 if (v->type == WORD) return v;
1555 if (v->type == SUBST) return v->subst;
1556 return nil;
1557}
1558
1559void argscan(void), compile(void);
1560void transform(rule_t *);
1561
1562void exec_one(void)
1563/* Execute one line of the program. */
1564{
1565 cell_t *v, *p, *q, *r, *t;
1566 unsigned n= 0;
1567 static int last_if= 1;
1568
1569 /* Description file this line came from. */
1570 descr= pc->file->name;
1571
1572 for (p= pc->line; p != nil; p= p->cdr) n++;
1573
1574 if (n == 0) return; /* Null statement. */
1575
1576 p= pc->line;
1577 q= p->cdr;
1578 r= q == nil ? nil : q->cdr;
1579
1580 /* Try one by one all the different commands. */
1581
1582 if (n >= 2 && q->car != nil && q->car->type == EQUALS) {
1583 /* An assignment. */
1584 int flags;
1585
1586 if ((v= getvar(p->car)) == nil) {
1587 fprintf(stderr,
1588 "\"%s\", line %u: Usage: <var> = expr ...\n",
1589 descr, pc->lineno);
1590 action= 0;
1591 return;
1592 }
1593
1594 if (readonly(v)) return;
1595
1596 flags= v->flags;
1597 v->flags|= W_LOCAL|W_RDONLY;
1598 t= evaluate(inc(r), PARTIAL);
1599 dec(v->value);
1600 v->value= t;
1601 v->flags= flags | W_SET;
1602 if (talk()) {
1603 printf("%s =\b=\b= ", v->name);
1604 prin2n(t);
1605 }
1606 } else
1607 if (keyword("unset")) {
1608 /* Set a variable to "undefined". */
1609
1610 if (n != 2 || (v= getvar(q->car)) == nil) {
1611 key_usage("<var>");
1612 return;
1613 }
1614 if (readonly(v)) return;
1615
1616 if (talk()) prin2n(p);
1617
1618 dec(v->value);
1619 v->value= nil;
1620 v->flags&= ~W_SET;
1621 } else
1622 if (keyword("import")) {
1623 /* Import a variable from the UNIX environment. */
1624 char *env;
1625
1626 if (n != 2 || (v= getvar(q->car)) == nil) {
1627 key_usage("<var>");
1628 return;
1629 }
1630 if (readonly(v)) return;
1631
1632 if ((env= getenv(v->name)) == nil) return;
1633
1634 if (talk()) printf("import %s=%s\n", v->name, env);
1635
1636 t= splitenv(env);
1637 dec(v->value);
1638 v->value= t;
1639 v->flags|= W_SET;
1640 } else
1641 if (keyword("mktemp")) {
1642 /* Assign a variable the name of a temporary file. */
1643 char *tmp, *suff;
1644
1645 r= evaluate(inc(r), IMPLODE);
1646 if (n == 3 && wordlist(&r, 1) != 1) n= 0;
1647
1648 if ((n != 2 && n != 3) || (v= getvar(q->car)) == nil) {
1649 dec(r);
1650 key_usage("<var> [<suffix>]");
1651 return;
1652 }
1653 if (readonly(v)) { dec(r); return; }
1654
1655 tmp= maketemp();
1656 suff= r == nil ? "" : r->name;
1657
1658 t= newcell();
1659 t->type= WORD;
1660 t->name= allocate(nil,
1661 (strlen(tmp) + strlen(suff) + 1) * sizeof(*t->name));
1662 strcpy(t->name, tmp);
1663 strcat(t->name, suff);
1664 t= inc(t);
1665 dec(r);
1666 dec(v->value);
1667 v->value= t;
1668 v->flags|= W_SET;
1669 t->flags|= W_TEMP;
1670 if (talk()) printf("mktemp %s=%s\n", v->name, t->name);
1671 } else
1672 if (keyword("temporary")) {
1673 /* Mark a word as a temporary file. */
1674 cell_t *tmp;
1675
1676 tmp= evaluate(inc(q), IMPLODE);
1677
1678 if (wordlist(&tmp, 1) < 0) {
1679 dec(tmp);
1680 key_usage("<word>");
1681 return;
1682 }
1683 if (talk()) printf("temporary %s\n", tmp->name);
1684
1685 tmp->flags|= W_TEMP;
1686 dec(tmp);
1687 } else
1688 if (keyword("stop")) {
1689 /* Set the suffix to stop the transformation on. */
1690 cell_t *suff;
1691
1692 if (phase > SCAN) { inappropriate(); return; }
1693
1694 suff= evaluate(inc(q), IMPLODE);
1695
1696 if (wordlist(&suff, 1) != 1) {
1697 dec(suff);
1698 key_usage("<suffix>");
1699 return;
1700 }
1701 dec(V_stop);
1702 V_stop= suff;
1703 if (talk()) printf("stop %s\n", suff->name);
1704 } else
1705 if (keyword("numeric")) {
1706 /* Check if a string denotes a number, like $n in -O$n. */
1707 cell_t *num;
1708 char *pn;
1709
1710 num= evaluate(inc(q), IMPLODE);
1711
1712 if (wordlist(&num, 1) != 1) {
1713 dec(num);
1714 key_usage("<arg>");
1715 return;
1716 }
1717 if (talk()) printf("numeric %s\n", num->name);
1718
1719 (void) strtoul(num->name, &pn, 10);
1720 if (*pn != 0) {
1721 complain(phase == SCAN ? V_star->value : nil);
1722 if (phase == SCAN) fputc(':', stderr);
1723 fprintf(stderr, " '%s' is not a number\n", num->name);
1724 }
1725 dec(num);
1726 } else
1727 if (keyword("error")) {
1728 /* Signal an error. */
1729 cell_t *err;
1730
1731 err= evaluate(inc(q), IMPLODE);
1732
1733 if (wordlist(&err, 0) < 1) {
1734 dec(err);
1735 key_usage("expr ...");
1736 return;
1737 }
1738
1739 if (talk()) { printf("error "); prin2n(err); }
1740
1741 complain(err);
1742 fputc('\n', stderr);
1743 dec(err);
1744 } else
1745 if (keyword("if")) {
1746 /* if (list) = (list) using set comparison. */
1747 int eq;
1748
1749 if (n != 4 || r->car == nil || r->car->type != EQUALS) {
1750 key_usage("<expr> = <expr>");
1751 execute(DONT, pc->indent+1);
1752 last_if= 1;
1753 return;
1754 }
1755 q= q->car;
1756 r= r->cdr->car;
1757 if (talk()) {
1758 printf("if ");
1759 prin1(t= evaluate(inc(q), IMPLODE));
1760 dec(t);
1761 printf(" = ");
1762 prin1n(t= evaluate(inc(r), IMPLODE));
1763 dec(t);
1764 }
1765 eq= equal(q, r);
1766 execute(eq ? DOIT : DONT, pc->indent+1);
1767 last_if= eq;
1768 } else
1769 if (keyword("ifdef") || keyword("ifndef")) {
1770 /* Is a variable defined or undefined? */
1771 int doit;
1772
1773 if (n != 2 || (v= getvar(q->car)) == nil) {
1774 key_usage("<var>");
1775 execute(DONT, pc->indent+1);
1776 last_if= 1;
1777 return;
1778 }
1779 if (talk()) prin2n(p);
1780
1781 doit= ((v->flags & W_SET) != 0) ^ (p->car->name[2] == 'n');
1782 execute(doit ? DOIT : DONT, pc->indent+1);
1783 last_if= doit;
1784 } else
1785 if (keyword("iftemp") || keyword("ifhash")) {
1786 /* Is a file a temporary file? */
1787 /* Does a file need preprocessing? */
1788 cell_t *file;
1789 int doit= 0;
1790
1791 file= evaluate(inc(q), IMPLODE);
1792
1793 if (wordlist(&file, 1) != 1) {
1794 dec(file);
1795 key_usage("<arg>");
1796 return;
1797 }
1798 if (talk()) printf("%s %s\n", p->car->name, file->name);
1799
1800 if (p->car->name[2] == 't') {
1801 /* iftemp file */
1802 if (file->flags & W_TEMP) doit= 1;
1803 } else {
1804 /* ifhash file */
1805 int fd;
1806 char hash;
1807
1808 if ((fd= open(file->name, O_RDONLY)) >= 0) {
1809 if (read(fd, &hash, 1) == 1 && hash == '#')
1810 doit= 1;
1811 close(fd);
1812 }
1813 }
1814 dec(file);
1815
1816 execute(doit ? DOIT : DONT, pc->indent+1);
1817 last_if= doit;
1818 } else
1819 if (keyword("else")) {
1820 /* Else clause for an if, ifdef, or ifndef. */
1821 if (n != 1) {
1822 key_usage("");
1823 execute(DONT, pc->indent+1);
1824 return;
1825 }
1826 if (talk()) prin2n(p);
1827
1828 execute(!last_if ? DOIT : DONT, pc->indent+1);
1829 } else
1830 if (keyword("treat")) {
1831 /* Treat a file as having a certain suffix. */
1832
1833 if (phase > SCAN) { inappropriate(); return; }
1834
1835 if (n == 3) {
1836 q= evaluate(inc(q->car), IMPLODE);
1837 r= evaluate(inc(r->car), IMPLODE);
1838 }
1839 if (n != 3 || wordlist(&q, 1) != 1 || wordlist(&r, 1) != 1) {
1840 if (n == 3) { dec(q); dec(r); }
1841 key_usage("<file> <suffix>");
1842 return;
1843 }
1844 if (talk()) printf("treat %s %s\n", q->name, r->name);
1845
1846 dec(q->suffix);
1847 q->suffix= r;
1848 q->flags|= W_SUFF;
1849 dec(q);
1850 } else
1851 if (keyword("apply")) {
1852 /* Apply a transformation rule to the current input file. */
1853 rule_t *rule, *sav_path;
1854 cell_t *sav_wait, *sav_in, *sav_out;
1855 program_t *sav_next;
1856
1857 if (phase != COMPILE) { inappropriate(); return; }
1858
1859 if (V_star->value->cdr != nil) {
1860 fprintf(stderr, "\"%s\", line %u: $* is not one file\n",
1861 descr, pc->lineno);
1862 action= 0;
1863 return;
1864 }
1865 if (n == 3) {
1866 q= evaluate(inc(q->car), IMPLODE);
1867 r= evaluate(inc(r->car), IMPLODE);
1868 }
1869 if (n != 3 || wordlist(&q, 1) != 1 || wordlist(&r, 1) != 1) {
1870 if (n == 3) { dec(q); dec(r); }
1871 key_usage("<file> <suffix>");
1872 return;
1873 }
1874 if (talk()) printf("apply %s %s\n", q->name, r->name);
1875
1876 /* Find a rule */
1877 for (rule= rules; rule != nil; rule= rule->next) {
1878 if (rule->type == TRANSFORM
1879 && rule->from == q && rule->to == r) break;
1880 }
1881 if (rule == nil) {
1882 fprintf(stderr,
1883 "\"%s\", line %u: no %s %s transformation\n",
1884 descr, pc->lineno, q->name, r->name);
1885 action= 0;
1886 }
1887 dec(q);
1888 dec(r);
1889 if (rule == nil) return;
1890
1891 /* Save the world. */
1892 sav_path= rule->path;
1893 sav_wait= rule->wait;
1894 sav_in= V_in->value;
1895 sav_out= V_out->value;
1896 sav_next= nextpc;
1897
1898 /* Isolate the rule and give it new input. */
1899 rule->path= rule;
1900 rule->wait= V_star->value;
1901 V_star->value= nil;
1902 V_in->value= nil;
1903 V_out->value= nil;
1904
1905 transform(rule);
1906
1907 /* Retrieve the new $* and repair. */
1908 V_star->value= rule->wait;
1909 rule->path= sav_path;
1910 rule->wait= sav_wait;
1911 V_in->value= sav_in;
1912 V_out->value= sav_out;
1913 V_out->flags= W_SET|W_LOCAL;
1914 nextpc= sav_next;
1915 } else
1916 if (keyword("include")) {
1917 /* Include another description file into this program. */
1918 cell_t *file;
1919 program_t *incl, *prog, **ppg= &prog;
1920
1921 file= evaluate(inc(q), IMPLODE);
1922
1923 if (wordlist(&file, 1) != 1) {
1924 dec(file);
1925 key_usage("<file>");
1926 return;
1927 }
1928 if (talk()) printf("include %s\n", file->name);
1929 descr= file->name;
1930 incl= pc;
1931 prog= get_prog();
1932 dec(file);
1933
1934 /* Raise the program to the include's indent level. */
1935 while (*ppg != nil) {
1936 (*ppg)->indent += incl->indent;
1937 ppg= &(*ppg)->next;
1938 }
1939
1940 /* Kill the include and splice the included program in. */
1941 dec(incl->line);
1942 incl->line= nil;
1943 *ppg= incl->next;
1944 incl->next= prog;
1945 pc= incl;
1946 nextpc= prog;
1947 } else
1948 if (keyword("arg")) {
1949 /* An argument scanning rule. */
1950
1951 if (phase > SCAN) { inappropriate(); return; }
1952
1953 if (n < 2) {
1954 key_usage("<string> ...");
1955 execute(DONT, pc->indent+1);
1956 return;
1957 }
1958 if (talk()) prin2n(p);
1959
1960 newrule(ARG, inc(q), nil);
1961
1962 /* Always skip the body, it comes later. */
1963 execute(DONT, pc->indent+1);
1964 } else
1965 if (keyword("transform")) {
1966 /* A file transformation rule. */
1967
1968 if (phase > SCAN) { inappropriate(); return; }
1969
1970 if (n == 3) {
1971 q= evaluate(inc(q->car), IMPLODE);
1972 r= evaluate(inc(r->car), IMPLODE);
1973 }
1974 if (n != 3 || wordlist(&q, 1) != 1 || wordlist(&r, 1) != 1) {
1975 if (n == 3) { dec(q); dec(r); }
1976 key_usage("<suffix1> <suffix2>");
1977 execute(DONT, pc->indent+1);
1978 return;
1979 }
1980 if (talk()) printf("transform %s %s\n", q->name, r->name);
1981
1982 newrule(TRANSFORM, q, r);
1983
1984 /* Body comes later. */
1985 execute(DONT, pc->indent+1);
1986 } else
1987 if (keyword("prefer")) {
1988 /* Prefer a transformation over others. */
1989
1990 if (phase > SCAN) { inappropriate(); return; }
1991
1992 if (n == 3) {
1993 q= evaluate(inc(q->car), IMPLODE);
1994 r= evaluate(inc(r->car), IMPLODE);
1995 }
1996 if (n != 3 || wordlist(&q, 1) != 1 || wordlist(&r, 1) != 1) {
1997 if (n == 3) { dec(q); dec(r); }
1998 key_usage("<suffix1> <suffix2>");
1999 return;
2000 }
2001 if (talk()) printf("prefer %s %s\n", q->name, r->name);
2002
2003 newrule(PREFER, q, r);
2004 } else
2005 if (keyword("combine")) {
2006 /* A file combination (loader) rule. */
2007
2008 if (phase > SCAN) { inappropriate(); return; }
2009
2010 if (n == 3) {
2011 q= evaluate(inc(q->car), IMPLODE);
2012 r= evaluate(inc(r->car), IMPLODE);
2013 }
2014 if (n != 3 || wordlist(&q, 0) < 1 || wordlist(&r, 1) != 1) {
2015 if (n == 3) { dec(q); dec(r); }
2016 key_usage("<suffix-list> <suffix>");
2017 execute(DONT, pc->indent+1);
2018 return;
2019 }
2020 if (talk()) {
2021 printf("combine ");
2022 prin1(q);
2023 printf(" %s\n", r->name);
2024 }
2025
2026 newrule(COMBINE, q, r);
2027
2028 /* Body comes later. */
2029 execute(DONT, pc->indent+1);
2030 } else
2031 if (keyword("scan") || keyword("compile")) {
2032 program_t *next= nextpc;
2033
2034 if (n != 1) { key_usage(""); return; }
2035 if (phase != INIT) { inappropriate(); return; }
2036
2037 if (talk()) prin2n(p);
2038
2039 argscan();
2040 if (p->car->name[0] == 'c') compile();
2041 nextpc= next;
2042 } else {
2043 /* A UNIX command. */
2044 t= evaluate(inc(pc->line), IMPLODE);
2045 unix_exec(t);
2046 dec(t);
2047 }
2048}
2049
2050void execute(exec_t how, unsigned indent)
2051/* Execute (or skip) all lines with at least the given indent. */
2052{
2053 int work= 0; /* Need to execute at least one line. */
2054 unsigned firstline;
2055 unsigned nice_indent= 0; /* 0 = Don't know what's nice yet. */
2056
2057 if (pc == nil) return; /* End of program. */
2058
2059 firstline= pc->lineno;
2060
2061 if (how == DONT) {
2062 /* Skipping a body, but is there another guard? */
2063 pc= pc->next;
2064 if (pc != nil && pc->indent < indent && pc->line != nil) {
2065 /* There is one! Bail out, then it get's executed. */
2066 return;
2067 }
2068 } else {
2069 /* Skip lines with a lesser indentation, they are guards for
2070 * the same substatements. Don't go past empty lines.
2071 */
2072 while (pc != nil && pc->indent < indent && pc->line != nil)
2073 pc= pc->next;
2074 }
2075
2076 /* Execute all lines with an indentation of at least "indent". */
2077 while (pc != nil && pc->indent >= indent) {
2078 if (pc->indent != nice_indent && how == DOIT) {
2079 if (nice_indent != 0) {
2080 fprintf(stderr,
2081 "\"%s\", line %u: (warning) sudden indentation shift\n",
2082 descr, pc->lineno);
2083 }
2084 nice_indent= pc->indent;
2085 }
2086 nextpc= pc->next;
2087 if (how == DOIT) exec_one();
2088 pc= nextpc;
2089 work= 1;
2090 }
2091
2092 if (indent > 0 && !work) {
2093 fprintf(stderr, "\"%s\", line %u: empty body, no statements\n",
2094 descr, firstline);
2095 action= 0;
2096 }
2097}
2098
2099int argmatch(int shift, cell_t *match, cell_t *match1, char *arg1)
2100/* Try to match an arg rule to the input file list L_args. Execute the arg
2101 * body (pc is set to it) on success.
2102 */
2103{
2104 cell_t *oldval, *v;
2105 int m, oldflags;
2106 size_t i, len;
2107 int minus= 0;
2108
2109 if (shift) {
2110 /* An argument has been accepted and may be shifted to $*. */
2111 cell_t **oldpstar= pV_star;
2112 *pV_star= L_args;
2113 L_args= *(pV_star= &L_args->cdr);
2114 *pV_star= nil;
2115
2116 if (argmatch(0, match->cdr, nil, nil)) return 1;
2117
2118 /* Undo the damage. */
2119 *pV_star= L_args;
2120 L_args= *(pV_star= oldpstar);
2121 *pV_star= nil;
2122 return 0;
2123 }
2124
2125 if (match == nil) {
2126 /* A full match, execute the arg body. */
2127
2128 /* Enable $>. */
2129 V_out->flags= W_SET|W_LOCAL;
2130
2131 if (verbose >= 3) {
2132 prin2(pc->line);
2133 printf(" =\b=\b= ");
2134 prin2n(V_star->value);
2135 }
2136 execute(DOIT, pc->indent+1);
2137
2138 /* Append $> to the file list. */
2139 if (V_out->value != nil) {
2140 *pL_files= cons(CELL, V_out->value);
2141 pL_files= &(*pL_files)->cdr;
2142 }
2143
2144 /* Disable $>. */
2145 V_out->value= nil;
2146 V_out->flags= W_SET|W_LOCAL|W_RDONLY;
2147
2148 return 1;
2149 }
2150
2151 if (L_args == nil) return 0; /* Out of arguments to match. */
2152
2153 /* Match is a list of words, substs and strings containing letters and
2154 * substs. Match1 is the current element of the first element of match.
2155 * Arg1 is the current character of the first element of L_args.
2156 */
2157 if (match1 == nil) {
2158 /* match1 is at the end of a string, then arg1 must also. */
2159 if (arg1 != nil) {
2160 if (*arg1 != 0) return 0;
2161 return argmatch(1, match, nil, nil);
2162 }
2163 /* If both are nil: Initialize. */
2164 match1= match->car;
2165 arg1= L_args->car->name;
2166
2167 /* A subst may not match a leading '-'. */
2168 if (arg1[0] == '-') minus= 1;
2169 }
2170
2171 if (match1->type == WORD && strcmp(match1->name, arg1) == 0) {
2172 /* A simple match of an argument. */
2173
2174 return argmatch(1, match, nil, nil);
2175 }
2176
2177 if (match1->type == SUBST && !minus) {
2178 /* A simple match of a subst. */
2179
2180 /* The variable gets the first of the arguments as its value. */
2181 v= match1->subst;
2182 if (v->flags & W_RDONLY) return 0; /* ouch */
2183 oldflags= v->flags;
2184 v->flags= W_SET|W_LOCAL|W_RDONLY;
2185 oldval= v->value;
2186 v->value= inc(L_args->car);
2187
2188 m= argmatch(1, match, nil, nil);
2189
2190 /* Recover the value of the variable. */
2191 dec(v->value);
2192 v->flags= oldflags;
2193 v->value= oldval;
2194 return m;
2195 }
2196 if (match1->type != STRING) return 0;
2197
2198 /* Match the first item in the string. */
2199 if (match1->car == nil) return 0;
2200
2201 if (match1->car->type == LETTER
2202 && match1->car->letter == (unsigned char) *arg1) {
2203 /* A letter matches, try the rest of the string. */
2204
2205 return argmatch(0, match, match1->cdr, arg1+1);
2206 }
2207
2208 /* It can only be a subst in a string now. */
2209 len= strlen(arg1);
2210 if (match1->car->type != SUBST || minus || len == 0) return 0;
2211
2212 /* The variable can match from 1 character to all of the argument.
2213 * Matching as few characters as possible happens to be the Right Thing.
2214 */
2215 v= match1->car->subst;
2216 if (v->flags & W_RDONLY) return 0; /* ouch */
2217 oldflags= v->flags;
2218 v->flags= W_SET|W_LOCAL|W_RDONLY;
2219 oldval= v->value;
2220
2221 m= 0;
2222 for (i= match1->cdr == nil ? len : 1; !m && i <= len; i++) {
2223 v->value= findnword(arg1, i);
2224
2225 m= argmatch(0, match, match1->cdr, arg1+i);
2226
2227 dec(v->value);
2228 }
2229 /* Recover the value of the variable. */
2230 v->flags= oldflags;
2231 v->value= oldval;
2232 return m;
2233}
2234
2235void argscan(void)
2236/* Match all the arguments to the arg rules, those that don't match are
2237 * used as files for transformation.
2238 */
2239{
2240 rule_t *rule;
2241 int m;
2242
2243 phase= SCAN;
2244
2245 /* Process all the arguments. */
2246 while (L_args != nil) {
2247 pV_star= &V_star->value;
2248
2249 /* Try all the arg rules. */
2250 m= 0;
2251 for (rule= rules; !m && rule != nil; rule= rule->next) {
2252 if (rule->type != ARG) continue;
2253
2254 pc= rule->prog;
2255
2256 m= argmatch(0, rule->match, nil, nil);
2257 }
2258 dec(V_star->value);
2259 V_star->value= nil;
2260
2261 /* On failure, add the first argument to the list of files. */
2262 if (!m) {
2263 *pL_files= L_args;
2264 L_args= *(pL_files= &L_args->cdr);
2265 *pL_files= nil;
2266 }
2267 }
2268 phase= INIT;
2269}
2270
2271int member(cell_t *p, cell_t *l)
2272/* True if p is a member of list l. */
2273{
2274 while (l != nil && l->type == CELL) {
2275 if (p == l->car) return 1;
2276 l= l->cdr;
2277 }
2278 return p == l;
2279}
2280
2281long basefind(cell_t *f, cell_t *l)
2282/* See if f has a suffix in list l + set the base name of f.
2283 * -1 if not found, preference number for a short basename otherwise. */
2284{
2285 cell_t *suff;
2286 size_t blen, slen;
2287 char *base;
2288
2289 /* Determine base name of f, with suffix. */
2290 if ((base= strrchr(f->name, '/')) == nil) base= f->name; else base++;
2291 blen= strlen(base);
2292
2293 /* Try suffixes. */
2294 while (l != nil) {
2295 if (l->type == CELL) {
2296 suff= l->car; l= l->cdr;
2297 } else {
2298 suff= l; l= nil;
2299 }
2300 if (f->flags & W_SUFF) {
2301 /* F has a suffix imposed on it. */
2302 if (f->suffix == suff) return 0;
2303 continue;
2304 }
2305 slen= strlen(suff->name);
2306 if (slen < blen && strcmp(base+blen-slen, suff->name) == 0) {
2307 /* Got it! */
2308 dec(f->base);
2309 f->base= findnword(base, blen-slen);
2310 return 10000L * (blen - slen);
2311 }
2312 }
2313 return -1;
2314}
2315
2316#define NO_PATH 2000000000 /* No path found yet. */
2317
2318long shortest; /* Length of the shortest path as yet. */
2319
2320rule_t *findpath(long depth, int seek, cell_t *file, rule_t *start)
2321/* Find the path of the shortest transformation to the stop suffix. */
2322{
2323 rule_t *rule;
2324
2325 if (action == 0) return nil;
2326
2327 if (start == nil) {
2328 /* No starting point defined, find one using "file". */
2329
2330 for (rule= rules; rule != nil; rule= rule->next) {
2331 if (rule->type < TRANSFORM) continue;
2332
2333 if ((depth= basefind(file, rule->from)) >= 0) {
2334 if (findpath(depth, seek, nil, rule) != nil)
2335 return rule;
2336 }
2337 }
2338 return nil;
2339 }
2340
2341 /* Cycle? */
2342 if (start->path != nil) {
2343 /* We can't have cycles through combines. */
2344 if (start->type == COMBINE) {
2345 fprintf(stderr,
2346 "\"%s\": contains a combine-combine cycle\n",
2347 descr);
2348 action= 0;
2349 }
2350 return nil;
2351 }
2352
2353 /* Preferred transformations are cheap. */
2354 if (start->flags & R_PREFER) depth-= 100;
2355
2356 /* Try to go from start closer to the stop suffix. */
2357 for (rule= rules; rule != nil; rule= rule->next) {
2358 if (rule->type < TRANSFORM) continue;
2359
2360 if (member(start->to, rule->from)) {
2361 start->path= rule;
2362 rule->npaths++;
2363 if (findpath(depth+1, seek, nil, rule) != nil)
2364 return start;
2365 start->path= nil;
2366 rule->npaths--;
2367 }
2368 }
2369
2370 if (V_stop == nil) {
2371 fprintf(stderr, "\"%s\": no stop suffix has been defined\n",
2372 descr);
2373 action= 0;
2374 return nil;
2375 }
2376
2377 /* End of the line? */
2378 if (start->to == V_stop) {
2379 /* Got it. */
2380 if (seek) {
2381 /* Second hunt, do we find the shortest? */
2382 if (depth == shortest) return start;
2383 } else {
2384 /* Is this path shorter than the last one? */
2385 if (depth < shortest) shortest= depth;
2386 }
2387 }
2388 return nil; /* Fail. */
2389}
2390
2391void transform(rule_t *rule)
2392/* Transform the file(s) connected to the rule according to the rule. */
2393{
2394 cell_t *file, *in, *out;
2395 char *base;
2396
2397 /* Let $* be the list of input files. */
2398 while (rule->wait != nil) {
2399 file= rule->wait;
2400 rule->wait= file->cdr;
2401 file->cdr= V_star->value;
2402 V_star->value= file;
2403 }
2404
2405 /* Set $< to the basename of the first input file. */
2406 file= file->car;
2407 V_in->value= in= inc(file->flags & W_SUFF ? file : file->base);
2408 file->flags&= ~W_SUFF;
2409
2410 /* Set $> to the output file name of the transformation. */
2411 out= newcell();
2412 out->type= WORD;
2413 base= rule->path == nil ? in->name : maketemp();
2414 out->name= allocate(nil,
2415 (strlen(base)+strlen(rule->to->name)+1) * sizeof(*out->name));
2416 strcpy(out->name, base);
2417 if (rule->path == nil || strchr(rule->to->name, '/') == nil)
2418 strcat(out->name, rule->to->name);
2419 out= inc(out);
2420 if (rule->path != nil) out->flags|= W_TEMP;
2421
2422 V_out->value= out;
2423 V_out->flags= W_SET|W_LOCAL;
2424
2425 /* Do a transformation. (Finally) */
2426 if (verbose >= 3) {
2427 printf("%s ", rule->type==TRANSFORM ? "transform" : "combine");
2428 prin2(V_star->value);
2429 printf(" %s\n", out->name);
2430 }
2431 pc= rule->prog;
2432 execute(DOIT, pc->indent+1);
2433
2434 /* Hand $> over to the next rule, it must be a single word. */
2435 out= evaluate(V_out->value, IMPLODE);
2436 if (wordlist(&out, 1) != 1) {
2437 fprintf(stderr,
2438 "\"%s\", line %u: $> should be returned as a single word\n",
2439 descr, rule->prog->lineno);
2440 action= 0;
2441 }
2442
2443 if ((rule= rule->path) != nil) {
2444 /* There is a next rule. */
2445 dec(out->base);
2446 out->base= in; /* Basename of input file. */
2447 file= inc(newcell());
2448 file->car= out;
2449 file->cdr= rule->wait;
2450 rule->wait= file;
2451 } else {
2452 dec(in);
2453 dec(out);
2454 }
2455
2456 /* Undo the damage to $*, $<, and $>. */
2457 dec(V_star->value);
2458 V_star->value= nil;
2459 V_in->value= nil;
2460 V_out->value= nil;
2461 V_out->flags= W_SET|W_LOCAL|W_RDONLY;
2462}
2463
2464void compile(void)
2465{
2466 rule_t *rule;
2467 cell_t *file, *t;
2468
2469 phase= COMPILE;
2470
2471 /* Implode the files list. */
2472 L_files= evaluate(L_files, IMPLODE);
2473 if (wordlist(&L_files, 0) < 0) {
2474 fprintf(stderr, "\"%s\": An assignment to $> contained junk\n",
2475 descr);
2476 action= 0;
2477 }
2478
2479 while (action != 0 && L_files != nil) {
2480 file= L_files->car;
2481
2482 /* Initialize. */
2483 shortest= NO_PATH;
2484 for (rule= rules; rule != nil; rule= rule->next)
2485 rule->path= nil;
2486
2487 /* Try all possible transformation paths. */
2488 (void) findpath(0L, 0, file, nil);
2489
2490 if (shortest == NO_PATH) { /* Can't match the file. */
2491 fprintf(stderr,
2492 "%s: %s: can't compile, no transformation applies\n",
2493 program, file->name);
2494 action= 0;
2495 return;
2496 }
2497
2498 /* Find the first short path. */
2499 if ((rule= findpath(0L, 1, file, nil)) == nil) return;
2500
2501 /* Transform the file until you hit a combine. */
2502 t= inc(newcell());
2503 t->car= inc(file);
2504 L_files= go(L_files, L_files->cdr);
2505 t->cdr= rule->wait;
2506 rule->wait= t;
2507 while (action != 0 && rule != nil && rule->type != COMBINE) {
2508 transform(rule);
2509 rule= rule->path;
2510 }
2511 }
2512
2513 /* All input files have been transformed to combine rule(s). Now
2514 * we need to find the combine rule with the least number of paths
2515 * running through it (this combine may be followed by another) and
2516 * transform from there.
2517 */
2518 while (action != 0) {
2519 int least;
2520 rule_t *comb= nil;
2521
2522 for (rule= rules; rule != nil; rule= rule->next) {
2523 rule->path= nil;
2524
2525 if (rule->type != COMBINE || rule->wait == nil)
2526 continue;
2527
2528 if (comb == nil || rule->npaths < least) {
2529 least= rule->npaths;
2530 comb= rule;
2531 }
2532 }
2533
2534 /* No combine? Then we're done. */
2535 if (comb == nil) break;
2536
2537 /* Initialize. */
2538 shortest= NO_PATH;
2539
2540 /* Try all possible transformation paths. */
2541 (void) findpath(0L, 0, nil, comb);
2542
2543 if (shortest == NO_PATH) break;
2544
2545 /* Find the first short path. */
2546 if ((rule= findpath(0L, 1, nil, comb)) == nil) return;
2547
2548 /* Transform until you hit another combine. */
2549 do {
2550 transform(rule);
2551 rule= rule->path;
2552 } while (action != 0 && rule != nil && rule->type != COMBINE);
2553 }
2554 phase= INIT;
2555}
2556
2557cell_t *predef(char *var, char *val)
2558/* A predefined variable var with value val, or a special variable. */
2559{
2560 cell_t *p, *t;
2561
2562 p= findword(var);
2563 if (val != nil) { /* Predefined. */
2564 t= findword(val);
2565 dec(p->value);
2566 p->value= t;
2567 p->flags|= W_SET;
2568 if (verbose >= 3) {
2569 prin1(p);
2570 printf(" =\b=\b= ");
2571 prin2n(t);
2572 }
2573 } else { /* Special: $* and such. */
2574 p->flags= W_SET|W_LOCAL|W_RDONLY;
2575 }
2576 t= inc(newcell());
2577 t->car= p;
2578 t->cdr= L_predef;
2579 L_predef= t;
2580 return p;
2581}
2582
2583void usage(void)
2584{
2585 fprintf(stderr,
2586 "Usage: %s -v<n> -vn<n> -name <name> -descr <descr> -T <dir> ...\n",
2587 program);
2588 exit(-1);
2589}
2590
2591int main(int argc, char **argv)
2592{
2593 char *tmpdir;
2594 program_t *prog;
2595 cell_t **pa;
2596 int i;
2597
2598 /* Call name of the program, decides which description to use. */
2599 if ((program= strrchr(argv[0], '/')) == nil)
2600 program= argv[0];
2601 else
2602 program++;
2603
2604 /* Directory for temporary files. */
2605 if ((tmpdir= getenv("TMPDIR")) == nil || *tmpdir == 0)
2606 tmpdir= "/tmp";
2607
2608 /* Transform arguments to a list, processing the few ACD options. */
2609 pa= &L_args;
2610 for (i= 1; i < argc; i++) {
2611 if (argv[i][0] == '-' && argv[i][1] == 'v') {
2612 char *a= argv[i]+2;
2613
2614 if (*a == 'n') { a++; action= 1; }
2615 verbose= 2;
2616
2617 if (*a != 0) {
2618 verbose= strtoul(a, &a, 10);
2619 if (*a != 0) usage();
2620 }
2621 } else
2622 if (strcmp(argv[i], "-name") == 0) {
2623 if (++i == argc) usage();
2624 program= argv[i];
2625 } else
2626 if (strcmp(argv[i], "-descr") == 0) {
2627 if (++i == argc) usage();
2628 descr= argv[i];
2629 } else
2630 if (argv[i][0] == '-' && argv[i][1] == 'T') {
2631 if (argv[i][2] == 0) {
2632 if (++i == argc) usage();
2633 tmpdir= argv[i];
2634 } else
2635 tmpdir= argv[i]+2;
2636 } else {
2637 /* Any other argument must be processed. */
2638 *pa= cons(CELL, findword(argv[i]));
2639 pa= &(*pa)->cdr;
2640 }
2641 }
2642#ifndef DESCR
2643 /* Default description file is based on the program name. */
2644 if (descr == nil) descr= program;
2645#else
2646 /* Default description file is predefined. */
2647 if (descr == nil) descr= DESCR;
2648#endif
2649
2650 inittemp(tmpdir);
2651
2652 /* Catch user signals. */
2653 if (signal(SIGHUP, SIG_IGN) != SIG_IGN) signal(SIGHUP, interrupt);
2654 if (signal(SIGINT, SIG_IGN) != SIG_IGN) signal(SIGINT, interrupt);
2655 if (signal(SIGTERM, SIG_IGN) != SIG_IGN) signal(SIGTERM, interrupt);
2656
2657 /* Predefined or special variables. */
2658 predef("PROGRAM", program);
2659 predef("VERSION", version);
2660#ifdef ARCH
2661 predef("ARCH", ARCH); /* Cross-compilers like this. */
2662#endif
2663 V_star= predef("*", nil);
2664 V_in= predef("<", nil);
2665 V_out= predef(">", nil);
2666
2667 /* Read the description file. */
2668 if (verbose >= 3) printf("include %s\n", descr);
2669 prog= get_prog();
2670
2671 phase= INIT;
2672 pc= prog;
2673 execute(DOIT, 0);
2674
2675 argscan();
2676 compile();
2677
2678 /* Delete all allocated data to test inc/dec balance. */
2679 while (prog != nil) {
2680 program_t *junk= prog;
2681 prog= junk->next;
2682 dec(junk->file);
2683 dec(junk->line);
2684 deallocate(junk);
2685 }
2686 while (rules != nil) {
2687 rule_t *junk= rules;
2688 rules= junk->next;
2689 dec(junk->from);
2690 dec(junk->to);
2691 dec(junk->wait);
2692 deallocate(junk);
2693 }
2694 deltemp();
2695 dec(V_stop);
2696 dec(L_args);
2697 dec(L_files);
2698 dec(L_predef);
2699
2700 quit(action == 0 ? 1 : 0);
2701}
Note: See TracBrowser for help on using the repository browser.