1 /*
2 **********************************************************************
3 * *
4 * ML/I macro processor -- C version *
5 * *
6 * Module MD - Machine dependent logic *
7 * *
8 * Copyright (C) R.D. Eager MMXVIII *
9 * P.J. Brown University of Kent MCMLXVII *
10 * *
11 **********************************************************************
12 */
13
14 /*
15 * Edit History:
16 *
17 * 1.1 -- First version in C.
18 * 2.1 -- Added facility to rewind input streams.
19 * 2.2 -- Generalised number of output streams; now selected by MAXOUT.
20 * 3.0 -- Machine dependent version change for machine independent version
21 * change to CKA.
22 * 3.1 -- Change to make S18 into a bit mask controlling all end of
23 * process messages.
24 * 3.2 -- Added support for Zortech C, and function prototypes. Some
25 * type changes and casting added.
26 * 3.3 -- Added support for VAXC under VMS.
27 * 4.0 -- Added support for Microsoft C under OS/2 and DOS, and added ANSI
28 * C support; removed ICL Perq and Lattice C support.
29 * 4.1 -- Changes to add S24 (start of line flags for output
30 * streams).
31 * -- Correction to suppress output on unassigned streams.
32 * 4.2 -- Include for 'stdio.h' moved to ml1.h so that NULL is available
33 * to all modules.
34 * -- Correction to Microsoft C code for handling argv[0].
35 * 4.3 -- Update for version CKF of MI-logic.
36 * 4.4 -- Update for version CKG of MI-logic.
37 * Include for 'stdio.h' removed from md.c.
38 * Update to handle IBM C Set/2.
39 * 4.5 -- Removed illegal character check on IBM PC implementations, since
40 * all values are legal characters.
41 * 4.6 -- Machine dependent version change for machine independent version
42 * change to CKI.
43 * 4.7 -- Removed check for low valued character codes (so that all
44 * character code values between 0 and 255 are accepted) on
45 * BSD4 version.
46 * 4.8 -- Machine dependent version change for machine independent version
47 * change to CKL.
48 * 4.9 -- Update to handle Microsoft Windows (32 bit); machine independent
49 * version changed to CKM.
50 * 4.10 -- Update to handle gcc on FreeBSD and possibly others; machine
51 * independent version changed to CKN.
52 * 4.11 -- Update to handle clang on FreeBSD; machine independent version
53 * changed to CKO.
54 * 4.12 -- Update to handle 64 bit FreeBSD; machine independent version
55 * changed to CKP.
56 *
57 */
58
59 #include "ml1.h"
60 #if VMS
61 #include <ssdef.h>
62 #endif
63
64
65 /* Use of S-variables
66 ------------------
67
68 S1-S9 are used by the machine-independent logic
69 -----------------------------------------------
70
71 S1 - 0 => Don't insert startlines on input
72 1 => Insert startlines on input
73 S2 - Source text line number
74 S3 - 0 => Give error message if warning marker not followed by macro name
75 1 => Don't give error message if warning marker not followed by macro name
76 S4 - 0 => Don't suppress context print-out on MC-NOTE call
77 1 => Suppress context print-out on MC-NOTE call
78 S5 - Count of processing errors
79 S6 - Character to be treated as alphanumeric
80 S7 - Not used
81 S8 - Not used
82 S9 - Not used
83
84 S10 upwards are used by the machine-dependent logic
85 ---------------------------------------------------
86
87 S10 - Input switch:
88 0 => end of process
89 1 -> MAXIN selects stream
90 101 -> 100+MAXIN selects and rewinds stream
91 S11 - Not used
92 S12 - Remaining line quota on debugging file
93 S13 - Not used
94 S14 - Not used
95 S15 - Not used
96 S16 - Character to be translated on input
97 S17 - Character to replace S16
98 S18 - Bit 2**0 = 0 => Don't give environment printout at end of process
99 Bit 2**0 = 1 => Give environment printout at end of process
100 Bit 2**1 = 0 => Don't output end of process statistics
101 Bit 2**1 = 1 => Give end of process statistics
102 S19 - Line number of output text
103 S20 - 0 => Don't list output text
104 1 => List output text without line numbers
105 2 => List output text with line numbers
106 S21 - 0 => Don't send output at all
107 Bit 2**0 => Send output to output stream 1
108 Bit 2**1 => Send output to output stream 2
109 Bit 2**2 => Send output to output stream 3
110 Bit 2**3 => Send output to output stream 4
111 S22 - 0 => Don't send output to output stream 2
112 1 => Send output to output stream 2
113 S23 - Reverted input switch
114 S24 - 0 => No stream at start of line
115 Bit 2**0 => Output stream 1 at start of line
116 Bit 2**1 => Output stream 2 at start of line
117 Bit 2**2 => Output stream 3 at start of line
118 Bit 2**3 => Output stream 4 at start of line
119
120 */
121
122
123 /*** Machine dependent definitions ***/
124
125 #if ATT3B | BSD4 | FBSD32| FBSD64 | IBMC | L1 | MSC | VMS | WIN
126 #define PROGNAME progname /* Present OK on these systems */
127 #endif
128 #if ZTC | ZTCX
129 #define PROGNAME "ml1" /* Name not known */
130 #endif
131 #define MAXIN 5 /* Maximum number of input files */
132 #define MAXOUT 4 /* Maximum number of output files */
133 #define ERRWIDTH 72 /* Maximum length of line in debugging file */
134 #define DEFWORK 5000 /* Default workspace size */
135 #define ERRQUOT 500 /* Default lines limit on debugging file */
136 #define ERRCHAR '?' /* Substituted for illegal input characters */
137
138
139 /*** Version number and system description ***/
140
141 #define MDVERSION "4.12" /* Version number of machine dependent logic */
142
143 #if ATT3B
144 #define MDSYSTEM "AT&T 3B" /* System on which program runs */
145 #endif
146 #if BSD4
147 #define MDSYSTEM "4.3BSD" /* System on which program runs */
148 #endif
149 #if FBSD32
150 #define MDSYSTEM "FreeBSD (32 bit)" /* System on which program runs */
151 #endif
152 #if FBSD64
153 #define MDSYSTEM "FreeBSD (64 bit)" /* System on which program runs */
154 #endif
155 #if IBMC
156 #define MDSYSTEM "OS/2" /* System on which program runs */
157 #endif
158 #if L1
159 #define MDSYSTEM "Olivetti L1" /* System on which program runs */
160 #endif
161 #if MSC
162 #define MDSYSTEM "OS/2 and DOS" /* System on which program runs */
163 #endif
164 #if VMS
165 #define MDSYSTEM "VMS" /* System on which program runs */
166 #endif
167 #if WIN
168 #define MDSYSTEM "Windows" /* System on which program runs */
169 #endif
170 #if ZTC
171 #define MDSYSTEM "IBM PC" /* System on which program runs */
172 #endif
173 #if ZTCX
174 #define MDSYSTEM "DOS extended" /* System on which program runs */
175 #endif
176
177
178 /*** Variables private to the machine dependent logic ***/
179
180 static INT errchs; /* Count of characters on current line of debugging file */
181 static INT nlpend; /* TRUE if last input character was a newline, otherwise FALSE */
182 static FILE *in_fps[MAXIN+1];/* Vector of input file pointers */
183 static FILE *out_fps[MAXOUT+1];/* Vector of output file pointers */
184 static FILE *list_fp; /* File pointer for listing file */
185 static FILE *err_fp; /* File pointer for debugging file */
186 #if ATT3B | BSD4 | FBSD32 | FBSD64 | IBMC | L1 | MSC | VMS | WIN
187 static char *progname; /* Pointer to argv[0] */
188 #endif
189
190
191 /*** External references to system interface ***/
192
193 #if ANSI
194 #include <stdlib.h>
195 #include <string.h>
196 #endif
197 #if ZTC
198 #include <io.h>
199 #endif
200 #if !ANSI
201 extern exit();
202 extern FILE *fopen();
203 extern fprintf();
204 extern int fseek();
205 #if L1
206 extern char *malloc();
207 #endif
208 extern char *sbrk();
209 extern int strlen();
210 #endif
211
212 /*** Forward references ***/
213
214 #if ANSI
215 static void eputc(char);
216 static void fail(char *,...);
217 static void listing_error(void);
218 static void mdabort(void);
219 static FILE *openio(char *,char *);
220 static void write_error(INT);
221 #else
222 static VOID eputc();
223 static VOID fail();
224 static VOID listing_error();
225 static VOID mdabort();
226 static FILE *openio();
227 static VOID write_error();
228 #endif
229
230
231 #if VMS
232 int main(argc,argv)
233 int argc;
234 char *argv[];
235 #endif
236 #if ATT3B | BSD4 | L1
237 VOID main(argc,argv)
238 int argc;
239 char *argv[];
240 #endif
241 #if MSC | WIN | ZTC | ZTCX
main(int argc,char * argv[])242 VOID main(int argc,char *argv[])
243 #endif
244 #if FBSD32 | FBSD64 | IBMC
245 int main(int argc,char *argv[])
246 #endif
247 /* Main initialisation routine. Reads and decodes the parameter string,
248 opens files, and obtains workspace. */
249 { INT worksize = DEFWORK;
250 INT *workad;
251 int in_count = 0;
252 int out_count = 0;
253 int i;
254 INT res;
255 int argp = 1;
256 #if MSC | WIN
257 char *ptr;
258 #endif
259
260 #if ATT3B | BSD4 | FBSD32 | FBSD64 | IBMC | L1 | VMS
261 progname = argv[0];
262 #endif
263 #if MSC | WIN
264 progname = argv[0];
265 ptr = strrchr(progname, '\\');
266 if(ptr != (char *) NULL) progname = ++ptr;
267 ptr = strrchr(progname, '.');
268 if(ptr != (char *) NULL) *ptr = '\0';
269 for(i = 0; progname[i] != '\0'; i++)
270 progname[i] = (char) tolower(progname[i]);
271 #endif
272
273 list_fp = (FILE *) NULL;
274 err_fp = stderr; /* Default setting */
275
276 /* Set up I/O files from parameters */
277
278 for(i = 0; i <= MAXIN; i++) in_fps[i] = (FILE *) NULL;
279 /* 'in_fps[0]' must be NULL */
280 for(i = 0; i <= MAXOUT; i++) out_fps[i] = (FILE *) NULL;
281
282 while(argp < argc) {
283 char *s = argv[argp++];
284
285 #if IBMC | MSC | WIN
286 if((strlen(s) > 1) && (*s == '-' || *s == '/')) {
287 #endif
288 #if ATT3B | BSD4 | FBSD32 | FBSD64 | L1 | VMS | ZTC | ZTCX
289 if((strlen(s) > 1) && (*s == '-')) {
290 #endif
291 for(;;) {
292 char ch = *s++;
293
294 if(ch == '\0') break;
295 switch(ch) {
296 case '-':
297 case '/':
298 case ' ': break;
299
300 case 'V':
301 case 'v': fprintf(stderr,"%s: %s version %s (%s)\n",
302 PROGNAME,MDSYSTEM,MDVERSION,MIVERSION);
303 break;
304
305 case 'W':
306 case 'w': worksize = 0;
307 while(isdigit((ch = *s++))) {
308 worksize = worksize*10 + (ch - '0');
309 }
310 #if ATT3B | BSD4 | FBSD32 | FBSD64 | IBMC | MSC | VMS | WIN | ZTC
311 if(worksize < 200) {
312 #endif
313 #if L1
314 if(worksize < 200L || worksize > 12000L) {
315 /* Max needed in case of segment wrapround */
316 #endif
317 #if ZTCX
318 if(worksize < 200) {
319 #endif
320 fail("bad value for 'w' flag");
321 }
322 s--; /* Backspace to re-read terminator */
323 break;
324
325 case 'L':
326 case 'l': if(argp >= argc) fail("no file for 'l' flag");
327 list_fp = openio(argv[argp++],"w");
328 break;
329
330 case 'D':
331 case 'd': if(argp >= argc) fail("no file for 'd' flag");
332 err_fp = openio(argv[argp++],"w");
333 break;
334
335 case 'O':
336 case 'o': if(argp >= argc) fail("no file for 'o' flag");
337 if(out_count >= MAXOUT) fail("too many output files");
338 out_fps[++out_count] = openio(argv[argp++],"w");
339 break;
340
341 default : fail("flag '%c' not recognised",ch);
342 }
343 }
344 } else {
345 if(in_count >= MAXIN) fail("too many input files");
346 in_fps[++in_count] = openio(s,"r");
347 }
348 }
349
350 /* Ensure that at least one input file and one output file are
351 in use */
352
353 if(in_fps[1] == (FILE *) NULL) in_fps[1] = stdin;
354 if(out_fps[1] == (FILE *) NULL) out_fps[1] = stdout;
355
356 #if ATT3B | BSD4
357 workad = (INT *) sbrk(((int) worksize)*sizeof(INT));
358 if(workad == ((INT *) -1)) fail("cannot get workspace");
359 #endif
360 #if FBSD32 | FBSD64 | IBMC | L1 | MSC | VMS | WIN | ZTC | ZTCX
361 workad = (INT *) malloc(((unsigned) worksize)*sizeof(INT));
362 if(workad == ((INT *) NULL)) fail("cannot get workspace");
363 #endif
364
365 errchs = 0;
366
367 /* Pass control to the machine-independent logic */
368
369 res = milogic(workad,worksize); /* Address and size, in words */
370
371 /* Close all files. Not strictly necessary as 'exit' is supposed
372 to do this, but some systems might not bother... */
373
374 for(i = 1; i <= MAXIN; i++) {
375 FILE *fp = in_fps[i];
376
377 if(fp != (FILE *) NULL) fclose(fp);
378 }
379 for(i = 1; i <= MAXOUT; i++) {
380 FILE *fp = out_fps[i];
381
382 if(fp != (FILE *) NULL) fclose(fp);
383 }
384 if(list_fp != (FILE *) NULL) fclose(list_fp);
385 fclose(err_fp);
386
387 #if VMS
388 exit(res == 0 ? SS$_NORMAL: SS$_ABORT);
389 #endif
390 #if ATT3B | BSD4 | L1
391 exit(res == 0 ? 0: 254);
392 #endif
393 #if FBSD32 | FBSD64 | MSC | WIN | ZTC | ZTCX
394 exit(res == 0 ? EXIT_SUCCESS: EXIT_FAILURE);
395 #endif
396 #if IBMC
397 return(res == 0 ? EXIT_SUCCESS: EXIT_FAILURE);
398 #endif
399 }
400
401
402 /* VARARGS1 */
403
404 #if ANSI
405 static VOID fail(char *mes,...)
406 /* Print the error message 'mes', with optional arguments. */
407 { va_list ap;
408
409 fprintf(stderr,"%s: ",PROGNAME);
410
411 va_start(ap,mes);
412 vfprintf(stderr,mes,ap);
413 va_end(ap);
414
415 fputc('\n',stderr);
416
417 exit(EXIT_FAILURE);
418 }
419 #else
420 static VOID fail(mes,a,b,c)
421 char *mes;
422 INT a,b,c;
423 /* Print the error message 'mes', with optional arguments. */
424 { fprintf(stderr,"%s: ",PROGNAME);
425 fprintf(stderr,mes,a,b,c);
426 fputc('\n',stderr);
427 exit(255);
428 }
429 #endif
430
431
432 #if ANSI
433 static FILE *openio(char *name,char *mode)
434 #else
435 static FILE *openio(name,mode)
436 char *name;
437 char *mode;
438 #endif
439 /* Try to open the file 'name' in mode 'mode', only returning if successful.
440 The name '-' is treated as standard input or standard output, as appropriate.
441 */
442 { FILE *fp;
443
444 if((name[0] == '-') && (name[1] == 0)) {
445 return(mode[0] == 'r' ? stdin: stdout);
446 }
447
448 fp = fopen(name,mode);
449 if(fp == (FILE *) NULL) fail("cannot open '%s'",name);
450
451 return(fp);
452 }
453
454
455 /* VARARGS1 */
456
457 #if ANSI
458 VOID mderpr(char *format,...)
459 /* Standard ML/I machine-dependent routine; used to output information
460 to the debugging file. Handles wrap-round of long lines of output, and
461 enforces the lines limit controlled by the value of S12. */
462 { char s[100];
463 unsigned i;
464 va_list ap;
465
466 va_start(ap,format);
467 vsprintf(s,format,ap);
468 va_end(ap);
469
470 for(i = 0; i < strlen(s); i++) eputc(s[i]);
471 }
472 #else
473 VOID mderpr(format,a,b,c,d)
474 char *format;
475 INT a,b,c,d;
476 /* Standard ML/I machine-dependent routine; used to output information
477 to the debugging file. Handles wrap-round of long lines of output, and
478 enforces the lines limit controlled by the value of S12. */
479 { char s[100];
480 int i;
481
482 sprintf(s,format,a,b,c,d);
483
484 for(i = 0; i < strlen(s); i++) eputc(s[i]);
485 }
486 #endif
487
488
489 #if ANSI
490 static VOID eputc(char c)
491 #else
492 static VOID eputc(c)
493 char c;
494 #endif
495 /* Outputs the character 'c' to the debugging file. Handles wrap-round
496 of long lines of output, and enforces the lines limit controlled by
497 the value of S12. */
498 { if(c == '\n') {
499 errchs = 0;
500 if(--*at_s12 < 0) {
501 *at_s12 = MAXINT; /* To allow environment dump, etc. */
502 eputc('\n');
503 prerr();
504 mderpr("\nDebugging file lines quota exhausted\n");
505 mdabort();
506 }
507 } else {
508 if(errchs == ERRWIDTH) {
509 eputc('\n');
510 errchs = 0;
511 }
512 errchs++;
513 }
514 fputc(c, err_fp);
515 }
516
517
518 VOID mderid()
519 /* Prints the identifier specified by 'idpt' and 'idlen' to the debugging file.
520 */
521 { int i;
522 int c;
523
524 for(i = 0; i < (int) idlen; i++) {
525 c = (int) idpt[i];
526
527 if(c == SLREP) mderpr("(SL)"); else eputc((char) c);
528 }
529 }
530
531
532 static VOID mdabort()
533 /* Routine called to abort the process after a fatal error detected by
534 the machine-dependent logic. Prints a standard error message, then
535 enters normal shutdown sequence. */
536 { mderpr("\nProcess aborted due to above error\n");
537 mihalt();
538 }
539
540
541 INT *mdfind()
542 /* Standard ML/I machine-dependent function; the main hash function.
543 'idpt' points to the identifier to be hashed (an unpacked string).
544 'idlen' is its length. This version assumes LHV is a power of two. */
545 { INT r = idlen;
546
547 if(r > 2) r += idpt[2];
548 r += idpt[0];
549
550 offset = ((r*113) >> 1) & (LHV-1);
551 return(sdb.hashpt + offset);
552 }
553
554
555 INT mdread()
556 /* The main input routine. Handles input switching (using S10) and
557 input translation (using S16 and S17). */
558 { INT s10 = *at_s10; /* Make copy for speed */
559 INT c;
560 int rewflag,ret;
561 FILE *fp;
562
563 if(s10 == 0) return(EOFCH); /* User forced end of file */
564
565 /* Handle legal values of S10 greater than 100. These indicate that 100
566 should be subtracted from the value of S10, and the result used to
567 select the input stream. Additionally, the stream is rewound
568 (repositioned at its start). */
569
570 if(101 <= (int) s10 && (int) s10 <= MAXIN + 100) {
571 s10 -= 100;
572 *at_s10 = s10;
573 rewflag = TRUE;
574 } else rewflag = FALSE;
575
576 /* Check for values of S10 outside the permitted range. Illegal
577 values of S10 are replaced by zero; this is trapped because
578 in_fps[0] is NULL. */
579
580 if((s10 < 1) || (s10 > MAXIN)) s10 = 0;
581
582 fp = in_fps[s10];
583 if(fp == (FILE *) NULL) {
584 *at_s12 += 10; /* Ensure this message comes out */
585 prerr();
586 mderpr("\nS10 has illegal value");
587 mdconv(*at_s10); /* Convert S10 value to identifier */
588 prviz();
589 mdabort();
590 }
591
592 /* Rewind the stream if requested */
593
594 if(rewflag == TRUE) {
595 #if ANSI
596 ret = fseek(fp,0L,SEEK_SET); /* Reposition at start */
597 #else
598 ret = fseek(fp,0L,0); /* Reposition at start */
599 #endif
600 if(ret == -1) { /* Error */
601 *at_s12 += 10; /* Ensure this message comes out */
602 prerr();
603 #if ATT3B | BSD4 | FBSD32 | IBMC | MSC | VMS | WIN | ZTC | ZTCX
604 mderpr("\nCannot rewind input stream %d\n",s10);
605 #endif
606 #if FBSD64 | L1
607 mderpr("\nCannot rewind input stream %ld\n",s10);
608 #endif
609 mdabort();
610 }
611 }
612
613 c = getc(fp);
614
615 /* Action at end of file. If S10 is not the "revert file"
616 (whose value is in S23) then input is switched to the revert
617 file; otherwise the process is terminated. */
618
619 if(c == EOF) {
620 if(s10 == *at_s23) return(EOFCH);
621 *at_s10 = *at_s23;
622 c = mdread();
623 return(c);
624 }
625
626 if(c == *at_s16) c = *at_s17;
627
628 #if !BSD4 & !FBSD32 & !FBSD64 & !IBMC & !MSC & !WIN & !ZTC & !ZTCX
629 if((c & 0x80) != 0) {
630 ersic(); /* Illegal input character */
631 c = ERRCHAR; /* Substitute the 'error character' */
632 }
633 #endif
634
635 return(c);
636 }
637
638
639 #if ANSI
640 VOID mdconv(INT value)
641 #else
642 VOID mdconv(value)
643 INT value;
644 #endif
645 /* Converts 'value' to a minimum-width, unpacked character string,
646 pointed to by 'idpt'. The string is stored in the area 'convarea' which
647 is allocated by the machine-independent logic. The length of the string
648 is set into 'idlen'. */
649 { int neg = FALSE;
650
651 idpt = convarea;
652 idlen = 0;
653
654 if(value < 0) {
655 value = -value;
656 neg = TRUE;
657 }
658
659 if(value == 0) {
660 *idpt = '0';
661 idlen = 1;
662 return;
663 } else {
664 for(;;) {
665 *idpt-- = value%10 + '0';
666 idlen++;
667 value /= 10;
668 if(value == 0) break;
669 }
670 }
671
672 if(neg) {
673 *idpt = '-';
674 idlen++;
675 } else idpt++;
676 }
677
678
679 INT mdnum()
680 /* Converts the unpacked string pointed at by 'idpt' into a decimal
681 number. 'idlen' gives the length of the string. Yields FALSE if
682 'idpt' does not point at a valid digit, otherwise generally yields
683 TRUE. However, in the case where 'idpt' points at a valid digit but
684 succeeding characters up to 'sdb.spt' are not all valid digits, 'erlia()'
685 is called. */
686 { INT c = *idpt;
687 INT *i;
688
689 meval = 0;
690 if(!isdigit(c)) return(FALSE);
691
692 for(i = idpt; i <= sdb.spt; i++) {
693 c = *i;
694 if(!isdigit(c)) erlia();
695 meval = meval*10 + c - '0';
696 }
697 return(TRUE);
698 }
699
700
701 VOID mdinit()
702 /* Routine to perform any machine-dependent initialisation which cannot
703 be done until machine-independent initialisation has been completed. */
704 { nlpend = TRUE;
705
706 /* Obtain addresses of commonly used system variables.
707 This is to improve efficiency. */
708
709 at_s10 = svarpt - 10;
710 at_s12 = svarpt - 12;
711 at_s16 = svarpt - 16;
712 at_s17 = svarpt - 17;
713 at_s19 = svarpt - 19;
714 at_s20 = svarpt - 20;
715 at_s21 = svarpt - 21;
716 at_s22 = svarpt - 22;
717 at_s23 = svarpt - 23;
718 at_s24 = svarpt - 24;
719
720 /* Initialise system variables */
721
722 *at_s10 = 1; /* Initial input from first input file */
723 *at_s12 = ERRQUOT; /* Initial lines limit on debugging file */
724 *at_s16 = -1; /* No input translation */
725 *at_s21 = 1; /* Initial output only to primary output */
726 *at_s23 = 1; /* Reverted input file is initially first input file */
727 *at_s24 = (1 << MAXOUT) - 1; /* Start of line flags */
728 svarpt[-18] = 0; /* Print end of process messages only on demand */
729 }
730
731
732 VOID mdfinal()
733 /* Routine to perform machine-dependent finalisation. */
734 { *at_s12 = MAXINT; /* Ensure statistics are output OK */
735
736 if((svarpt[-18] & 1) != 0) prenv();
737 }
738
739
740 #if ANSI
741 VOID fmove(INT len,INT *src,INT *dest)
742 #else
743 VOID fmove(len,src,dest)
744 INT len;
745 INT *src,*dest;
746 #endif
747 /* Moves 'len' INTs from 'src' to 'dest', starting at 'src' and 'dest'.
748 */
749 { INT i;
750
751 for(i = 0; i < len; i++) dest[i] = src[i];
752 }
753
754
755 #if ANSI
756 VOID bmove(INT len,INT *src,INT *dest)
757 #else
758 VOID bmove(len,src,dest)
759 INT len;
760 INT *src,*dest;
761 #endif
762 /* Moves 'len' words from 'src' to 'dest', starting at 'src+len-1' and
763 'dest+len-1'. */
764 { int i;
765
766 for(i = (int) len - 1; i >= 0; i--)
767 dest[i] = src[i];
768 }
769
770
771 #if ANSI
772 VOID mdouch(INT c)
773 #else
774 VOID mdouch(c)
775 INT c;
776 #endif
777 /* Main output routine. Handles multi-file output, and output listing
778 if required. */
779 { INT s20 = *at_s20;
780 INT s21 = *at_s21;
781 INT s24 = *at_s24;
782
783 if(nlpend) {
784 (*at_s19)++; /* Update output line number */
785 if((list_fp != (FILE *) NULL) && (s20 == 2)) {
786 #if ATT3B | BSD4 | FBSD32 | IBMC | MSC | VMS | WIN | ZTC | ZTCX
787 fprintf(list_fp,"%5d. ",*at_s19);
788 #endif
789 #if FBSD64 | L1
790 fprintf(list_fp,"%5ld. ",*at_s19);
791 #endif
792 }
793 }
794
795 nlpend = (c == '\n');
796
797 if((list_fp != (FILE *) NULL) && (s20 != 0)) {
798 if(fputc((int) c, list_fp) == EOF) listing_error();
799 }
800
801 if(s21 != 0) {
802 INT i;
803
804 for(i = 1; i <= MAXOUT; i++) {
805 INT bit = 1 << (i-1);
806
807 if((s21 & bit) != 0 && out_fps[i] != (FILE *) NULL) {
808 if(fputc((int) c, out_fps[i]) == EOF)
809 write_error(i);
810 if(c == '\n') s24 |= bit;
811 else s24 &= (~bit);
812 }
813 }
814 }
815
816 if(*at_s22 != 0 && (s21 & 2) == 0) {
817 if(fputc((int) c, out_fps[2]) == EOF)
818 write_error(2);
819 if(c == '\n') s24 |= 2;
820 else s24 &= (~2);
821 }
822 *at_s24 = s24;
823 }
824
825
826 #if ANSI
827 static VOID write_error(INT file_number)
828 #else
829 static VOID write_error(file_number)
830 INT file_number;
831 #endif
832 /* Routine called after a failure to write to one of the output files.
833 A suitable message is sent to the debugging file, and the process is
834 aborted. */
835 { *at_s12 += 10; /* Ensure this message comes out */
836 prerr();
837 #if ATT3B | BSD4 | FBSD32 | IBMC | MSC | VMS | WIN | ZTC | ZTCX
838 mderpr("\nError while writing to output stream %d\n",file_number);
839 #endif
840 #if FBSD64 | L1
841 mderpr("\nError while writing to output stream %ld\n",file_number);
842 #endif
843 mdabort();
844 }
845
846
847 static VOID listing_error()
848 /* Routine called after a failure to write to the listing file.
849 A suitable message is sent to the debugging file, and the process is
850 aborted. */
851 { *at_s12 += 10; /* Ensure this message comes out */
852 prerr();
853 mderpr("\nError while writing to listing file\n");
854 mdabort();
855 }
856
857
858 #if ANSI
859 INT mddiv(INT a,INT b)
860 #else
861 INT mddiv(a,b)
862 INT a,b;
863 #endif
864 /* Divides 'a' by 'b' according to the (somewhat strange) rules in Section
865 2.6.3 of the User's Manual. 'b' can never be zero; this is detected by
866 the machine-independent logic. */
867 { int neg = FALSE;
868 INT res;
869
870 if(a < 0) {
871 a = -a;
872 neg = TRUE;
873 }
874
875 if(b < 0) {
876 b = -b;
877 neg = (int) (neg ? FALSE: TRUE);
878 }
879
880 res = a/b;
881
882 /* Round result towards minus infinity */
883
884 if(neg && (a%b != 0)) res++;
885
886 return(neg ? -res: res);
887 }
888
889
890 #if DEBUGGING
891 #if ANSI
892 static VOID mddump(INT *,INT *);
893 #else
894 static VOID mddump();
895 #endif
896 /* Routine called on a program error or abort, to dump the ML/I stacks. */
897 VOID mdpostmort(VOID)
898 { INT *n;
899
900 #if MSC | ZTC
901 fprintf(stderr,"\n\nBackwards stack: (lfpt = %4x)\n",(INT) lfpt);
902 #endif
903 #if ATT3B | FBSD32 | IBMC | BSD4 | VMS | WIN | ZTCX
904 fprintf(stderr,"\n\nBackwards stack: (lfpt = %8x)\n",(INT) lfpt);
905 #endif
906 #if FBSD64 | L1
907 fprintf(stderr,"\n\nBackwards stack: (lfpt = %8lx)\n",(INT) lfpt);
908 #endif
909 n = lfpt - 30;
910 if(n < ffpt) n = ffpt;
911 mddump(n,endpt);
912 #if MSC | ZTC
913 fprintf(stderr,"\n\nForwards stack: (ffpt = %4x)\n",(INT) ffpt);
914 #endif
915 #if ATT3B | BSD4 | FBSD32 | IBMC | VMS | WIN | ZTCX
916 fprintf(stderr,"\n\nForwards stack: (ffpt = %8x)\n",(INT) ffpt);
917 #endif
918 #if FBSD64 | L1
919 fprintf(stderr,"\n\nForwards stack: (ffpt = %8lx)\n",(INT) ffpt);
920 #endif
921 n = ffpt + 30;
922 if(n > lfpt) n = lfpt;
923 mddump(stffpt,n);
924 fputc('\n', stderr);
925 }
926
927
928 #if ANSI
929 static VOID mddump(INT *strt,INT *fin)
930 #else
931 static VOID mddump(strt,fin)
932 INT *strt;
933 INT *fin;
934 #endif
935 /* Routine used by 'postmort'. */
936 { INT online = 8;
937 INT *i;
938
939 for(i = strt; i <= fin; i++) {
940 if(online == 8) {
941 online = 0;
942 #if MSC | ZTC
943 fprintf(stderr,"\n%4x: ",(int) i);
944 #endif
945 #if ATT3B | BSD4 | FBSD32 | IBMC | VMS | WIN | ZTCX
946 fprintf(stderr,"\n%8x: ",(int) i);
947 #endif
948 #if FBSD64 | L1
949 fprintf(stderr,"\n%8lx: ",(INT) i);
950 #endif
951 }
952 #if MSC | ZTC
953 fprintf(stderr," %4x",*i);
954 #endif
955 #if ATT3B | BSD4 | FBSD32 | IBMC | VMS | WIN | ZTCX
956 fprintf(stderr," %8x",*i);
957 #endif
958 #if FBSD64 | L1
959 fprintf(stderr," %8lx",*i);
960 #endif
961 online++;
962 }
963 }
964 #endif
965
966 /*
967 ***********************
968 * *
969 * End of module MD *
970 * *
971 ***********************
972 */
973
974