/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/debug.c,v 9.43 1992/02/04 04:14:43 jinx Exp $
+$Id: debug.c,v 9.44 1993/06/24 04:23:41 gjr Exp $
-Copyright (c) 1987-1992 Massachusetts Institute of Technology
+Copyright (c) 1987-1993 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
#include "trap.h"
#include "lookup.h"
-static void EXFUN (do_printing, (FILE *, SCHEME_OBJECT, Boolean));
-static Boolean EXFUN (print_primitive_name, (FILE *, SCHEME_OBJECT));
-static void EXFUN (print_expression, (FILE *, SCHEME_OBJECT, char *));
+static void EXFUN (do_printing, (outf_channel, SCHEME_OBJECT, Boolean));
+static Boolean EXFUN (print_primitive_name, (outf_channel, SCHEME_OBJECT));
+static void EXFUN (print_expression, (outf_channel, SCHEME_OBJECT, char *));
\f
/* Compiled Code Debugging */
{
if (Obj_Address > Free_Constant)
{
- printf ("Past end of area.\n");
+ outf_console ("Past end of area.\n");
return;
}
if (Obj_Address == Free_Constant)
{
- printf ("Done.\n");
+ outf_console ("Done.\n");
return;
}
Pure_Size = OBJECT_DATUM (*Obj_Address);
Total_Size = OBJECT_DATUM (Obj_Address[1]);
- printf ("0x%lx: pure=0x%lx, total=0x%lx\n",
+ outf_console ("0x%lx: pure=0x%lx, total=0x%lx\n",
((long) Obj_Address), ((long) Pure_Size), ((long) Total_Size));
if (OBJECT_TYPE (*Obj_Address) != TC_MANIFEST_SPECIAL_NM_VECTOR)
{
- printf ("Missing initial SNMV.\n");
+ outf_console ("Missing initial SNMV.\n");
return;
}
if (OBJECT_TYPE (Obj_Address[1]) != PURE_PART)
{
- printf ("Missing subsequent pure header.\n");
+ outf_console ("Missing subsequent pure header.\n");
}
if (OBJECT_TYPE (Obj_Address[Pure_Size-1]) !=
TC_MANIFEST_SPECIAL_NM_VECTOR)
{
- printf ("Missing internal SNMV.\n");
+ outf_console ("Missing internal SNMV.\n");
return;
}
if (OBJECT_TYPE (Obj_Address[Pure_Size]) != CONSTANT_PART)
{
- printf ("Missing constant header.\n");
+ outf_console ("Missing constant header.\n");
return;
}
if (OBJECT_DATUM (Obj_Address[Pure_Size]) != Pure_Size)
{
- printf ("Pure size mismatch 0x%lx.\n",
+ outf_console ("Pure size mismatch 0x%lx.\n",
((long) (OBJECT_DATUM (Obj_Address[Pure_Size]))));
}
if (OBJECT_TYPE (Obj_Address[Total_Size-1]) !=
TC_MANIFEST_SPECIAL_NM_VECTOR)
{
- printf ("Missing ending SNMV.\n");
+ outf_console ("Missing ending SNMV.\n");
return;
}
if (OBJECT_TYPE (Obj_Address[Total_Size]) != END_OF_BLOCK)
{
- printf ("Missing ending header.\n");
+ outf_console ("Missing ending header.\n");
return;
}
if (OBJECT_DATUM (Obj_Address[Total_Size]) != Total_Size)
{
- printf ("Total size mismatch 0x%lx.\n",
+ outf_console ("Total size mismatch 0x%lx.\n",
((long) (OBJECT_DATUM (Obj_Address[Total_Size]))));
}
Obj_Address += Total_Size+1;
if ((OBJECT_TYPE (procedure) != TC_PROCEDURE) &&
(OBJECT_TYPE (procedure) != TC_EXTENDED_PROCEDURE))
{
- printf ("Not created by a procedure");
+ outf_console ("Not created by a procedure");
return;
}
name_ptr = MEMORY_LOC (procedure, PROCEDURE_LAMBDA_EXPR);
{
Print_Expression (*name_ptr++, "Name ");
Print_Expression (*value_ptr++, " Value ");
- printf ("\n");
+ outf_console ("\n");
}
if (extension != SHARP_F)
{
- printf ("Auxilliary Variables\n");
+ outf_console ("Auxilliary Variables\n");
count = OBJECT_DATUM (MEMORY_REF (extension, AUX_LIST_COUNT));
for (i = 0, name_ptr = MEMORY_LOC (extension, AUX_LIST_FIRST);
i < count;
{
Print_Expression ((PAIR_CAR (*name_ptr)), "Name ");
Print_Expression ((PAIR_CDR (*name_ptr)), " Value ");
- printf ("\n");
+ outf_console ("\n");
}
}
}
\f
static void
-DEFUN (print_list, (stream, pair), FILE * stream AND SCHEME_OBJECT pair)
+DEFUN (print_list, (stream, pair), outf_channel stream AND SCHEME_OBJECT pair)
{
int count;
- fprintf (stream, "(");
+ outf (stream, "(");
count = 0;
while (((PAIR_P (pair)) || (WEAK_PAIR_P (pair))) && (count < MAX_LIST_PRINT))
{
if (count > 0)
- fprintf (stream, " ");
+ outf (stream, " ");
print_expression (stream,
(PAIR_CAR (pair)),
((WEAK_PAIR_P (pair)) ? "{weak}" : ""));
if (pair != EMPTY_LIST)
{
if (count == MAX_LIST_PRINT)
- fprintf (stream, " ...");
+ outf (stream, " ...");
else
{
- fprintf (stream, " . ");
+ outf (stream, " . ");
print_expression (stream, pair, "");
}
}
- fprintf (stream, ")");
+ outf (stream, ")");
return;
}
static void
-DEFUN (print_return_name, (stream, Ptr), FILE * stream AND SCHEME_OBJECT Ptr)
+DEFUN (print_return_name, (stream, Ptr), outf_channel stream AND SCHEME_OBJECT Ptr)
{
long index;
char * name;
if ((name != ((char *) 0)) &&
((name [0]) != '\0'))
{
- fprintf (stream, "%s", name);
+ outf (stream, "%s", name);
return;
}
}
- fprintf (stream, "[0x%lx]", index);
+ outf (stream, "[0x%lx]", index);
return;
}
void
DEFUN (Print_Return, (String), char * String)
{
- printf ("%s: ", String);
- print_return_name (stdout, Fetch_Return ());
- printf ("\n");
+ outf_console ("%s: ", String);
+ print_return_name (console_output, Fetch_Return ());
+ outf_console ("\n");
}
\f
static void
-DEFUN (print_string, (stream, string), FILE * stream AND SCHEME_OBJECT string)
+DEFUN (print_string, (stream, string), outf_channel stream AND SCHEME_OBJECT string)
{
long length;
long i;
char * next;
char this;
- fprintf (stream, "\"");
+ outf (stream, "\"");
length = (STRING_LENGTH (string));
next = ((char *) (STRING_LOC (string, 0)));
for (i = 0; (i < length); i += 1)
switch (this)
{
case '\\':
- fprintf (stream, "\\\\");
+ outf (stream, "\\\\");
break;
case '"':
- fprintf (stream, "\\\"");
+ outf (stream, "\\\"");
break;
case '\t':
- fprintf (stream, "\\t");
+ outf (stream, "\\t");
break;
case '\n':
- fprintf (stream, "\\n");
+ outf (stream, "\\n");
break;
case '\f':
- fprintf (stream, "\\f");
+ outf (stream, "\\f");
break;
default:
if ((this >= ' ') && (this <= '~'))
- putc (this, stream);
+ outf (stream, "%c", this);
else
- fprintf (stream, "\\%03o", this);
+ outf (stream, "\\%03o", this);
break;
}
}
- fprintf (stream, "\"");
+ outf (stream, "\"");
return;
}
static void
-DEFUN (print_symbol, (stream, symbol), FILE * stream AND SCHEME_OBJECT symbol)
+DEFUN (print_symbol, (stream, symbol), outf_channel stream AND SCHEME_OBJECT symbol)
{
SCHEME_OBJECT string;
long length;
length = (STRING_LENGTH (string));
next = ((char *) (STRING_LOC (string, 0)));
for (i = 0; (i < length); i += 1)
- putc (*next++, stream);
+ outf(stream, "%c", *next++); /*should use %s? */
return;
}
\f
static void
DEFUN (print_filename, (stream, filename),
- FILE * stream AND SCHEME_OBJECT filename)
+ outf_channel stream AND SCHEME_OBJECT filename)
{
long length;
char * scan;
while (scan < end)
if ((*scan++) == '/')
slash = scan;
- fprintf (stream, "\"%s\"", slash);
+ outf (stream, "\"%s\"", slash);
return;
}
static void
DEFUN (print_object, (object), SCHEME_OBJECT object)
{
- do_printing (stdout, object, true);
- printf ("\n");
- fflush (stdout);
+ do_printing (console_output, object, true);
+ outf_console ("\n");
+ outf_flush_console();
return;
}
end = (objects + n);
while (scan < end)
{
- printf ("%4x: ", (((char *) scan) - ((char *) objects)));
- do_printing (stdout, (*scan++), true);
- printf ("\n");
+ outf_console ("%4x: ", (((char *) scan) - ((char *) objects)));
+ do_printing (console_output, (*scan++), true);
+ outf_console ("\n");
}
- fflush (stdout);
+ outf_flush_console();
return;
}
\f
static void
DEFUN (print_expression, (stream, expression, string),
- FILE * stream AND SCHEME_OBJECT expression AND char * string)
+ outf_channel stream AND SCHEME_OBJECT expression AND char * string)
{
if ((string [0]) != 0)
- fprintf (stream, "%s: ", string);
+ outf (stream, "%s: ", string);
do_printing (stream, expression, true);
return;
}
DEFUN (Print_Expression, (expression, string),
SCHEME_OBJECT expression AND char * string)
{
- print_expression (stdout, expression, string);
+ print_expression (console_output, expression, string);
return;
}
static void
DEFUN (do_printing, (stream, Expr, Detailed),
- FILE * stream AND SCHEME_OBJECT Expr AND Boolean Detailed)
+ outf_channel stream AND SCHEME_OBJECT Expr AND Boolean Detailed)
{
long Temp_Address;
Boolean handled_p;
{
case TC_ACCESS:
{
- fprintf (stream, "[ACCESS (");
+ outf (stream, "[ACCESS (");
Expr = (MEMORY_REF (Expr, ACCESS_NAME));
SPrint:
print_symbol (stream, Expr);
handled_p = true;
- fprintf (stream, ")");
+ outf (stream, ")");
break;
}
case TC_ASSIGNMENT:
- fprintf (stream, "[SET! (");
+ outf (stream, "[SET! (");
Expr = (MEMORY_REF ((MEMORY_REF (Expr, ASSIGN_NAME)), VARIABLE_SYMBOL));
goto SPrint;
return;
case TC_DEFINITION:
- fprintf (stream, "[DEFINE (");
+ outf (stream, "[DEFINE (");
Expr = (MEMORY_REF (Expr, DEFINE_NAME));
goto SPrint;
case TC_FIXNUM:
- fprintf (stream, "%ld", ((long) (FIXNUM_TO_LONG (Expr))));
+ outf (stream, "%ld", ((long) (FIXNUM_TO_LONG (Expr))));
return;
case TC_BIG_FLONUM:
- fprintf (stream, "%lf", (FLONUM_TO_DOUBLE (Expr)));
+ outf (stream, "%lf", (FLONUM_TO_DOUBLE (Expr)));
return;
case TC_WEAK_CONS:
case TC_NULL:
if (Temp_Address == 0)
{
- fprintf (stream, "()");
+ outf (stream, "()");
return;
}
break;
case TC_UNINTERNED_SYMBOL:
- fprintf (stream, "[UNINTERNED_SYMBOL (");
+ outf (stream, "[UNINTERNED_SYMBOL (");
goto SPrint;
case TC_INTERNED_SYMBOL:
Expr = (MEMORY_REF (Expr, VARIABLE_SYMBOL));
if (Detailed)
{
- fprintf (stream, "[VARIABLE (");
+ outf (stream, "[VARIABLE (");
goto SPrint;
}
print_symbol (stream, Expr);
return;
case TC_COMBINATION:
- fprintf (stream, "[COMBINATION (%ld args) 0x%lx]",
+ outf (stream, "[COMBINATION (%ld args) 0x%lx]",
((long) ((VECTOR_LENGTH (Expr)) - 1)),
((long) Temp_Address));
if (Detailed)
{
- fprintf (stream, " (");
+ outf (stream, " (");
do_printing (stream, (MEMORY_REF (Expr, COMB_FN_SLOT)), false);
- fprintf (stream, " ...)");
+ outf (stream, " ...)");
}
return;
case TC_COMBINATION_1:
- fprintf (stream, "[COMBINATION_1 0x%lx]", ((long) Temp_Address));
+ outf (stream, "[COMBINATION_1 0x%lx]", ((long) Temp_Address));
if (Detailed)
{
- fprintf (stream, " (");
+ outf (stream, " (");
do_printing (stream, (MEMORY_REF (Expr, COMB_1_FN)), false);
- fprintf (stream, ", ");
+ outf (stream, ", ");
do_printing (stream, (MEMORY_REF (Expr, COMB_1_ARG_1)), false);
- fprintf (stream, ")");
+ outf (stream, ")");
}
return;
case TC_COMBINATION_2:
- fprintf (stream, "[COMBINATION_2 0x%lx]", ((long) Temp_Address));
+ outf (stream, "[COMBINATION_2 0x%lx]", ((long) Temp_Address));
if (Detailed)
{
- fprintf (stream, " (");
+ outf (stream, " (");
do_printing (stream, (MEMORY_REF (Expr, COMB_2_FN)), false);
- fprintf (stream, ", ");
+ outf (stream, ", ");
do_printing (stream, (MEMORY_REF (Expr, COMB_2_ARG_1)), false);
- fprintf (stream, ", ");
+ outf (stream, ", ");
do_printing (stream, (MEMORY_REF (Expr, COMB_2_ARG_2)), false);
- fprintf (stream, ")");
+ outf (stream, ")");
}
return;
{
SCHEME_OBJECT procedure;
- fprintf (stream, "[ENVIRONMENT 0x%lx]", ((long) Temp_Address));
- fprintf (stream, " (from ");
+ outf (stream, "[ENVIRONMENT 0x%lx]", ((long) Temp_Address));
+ outf (stream, " (from ");
procedure = (MEMORY_REF (Expr, ENVIRONMENT_FUNCTION));
if ((OBJECT_TYPE (procedure)) == TC_QUAD)
procedure = (MEMORY_REF (procedure, ENV_EXTENSION_PROCEDURE));
do_printing (stream, procedure, false);
- fprintf (stream, ")");
+ outf (stream, ")");
return;
}
case TC_EXTENDED_LAMBDA:
if (Detailed)
- fprintf (stream, "[EXTENDED_LAMBDA (");
+ outf (stream, "[EXTENDED_LAMBDA (");
do_printing (stream,
(MEMORY_REF ((MEMORY_REF (Expr, ELAMBDA_NAMES)), 1)),
false);
if (Detailed)
- fprintf (stream, ") 0x%lx", ((long) Temp_Address));
+ outf (stream, ") 0x%lx", ((long) Temp_Address));
return;
case TC_EXTENDED_PROCEDURE:
if (Detailed)
- fprintf (stream, "[EXTENDED_PROCEDURE (");
+ outf (stream, "[EXTENDED_PROCEDURE (");
do_printing (stream, (MEMORY_REF (Expr, PROCEDURE_LAMBDA_EXPR)), false);
if (Detailed)
- fprintf (stream, ") 0x%lx]", ((long) Temp_Address));
+ outf (stream, ") 0x%lx]", ((long) Temp_Address));
break;
case TC_LAMBDA:
if (Detailed)
- fprintf (stream, "[LAMBDA (");
+ outf (stream, "[LAMBDA (");
do_printing (stream,
(MEMORY_REF ((MEMORY_REF (Expr, LAMBDA_FORMALS)), 1)),
false);
if (Detailed)
- fprintf (stream, ") 0x%lx]", ((long) Temp_Address));
+ outf (stream, ") 0x%lx]", ((long) Temp_Address));
return;
case TC_PRIMITIVE:
- fprintf (stream, "[PRIMITIVE ");
+ outf (stream, "[PRIMITIVE ");
print_primitive_name (stream, Expr);
- fprintf (stream, "]");
+ outf (stream, "]");
return;
case TC_PROCEDURE:
if (Detailed)
- fprintf (stream, "[PROCEDURE (");
+ outf (stream, "[PROCEDURE (");
do_printing (stream, (MEMORY_REF (Expr, PROCEDURE_LAMBDA_EXPR)), false);
if (Detailed)
- fprintf (stream, ") 0x%lx]", ((long) Temp_Address));
+ outf (stream, ") 0x%lx]", ((long) Temp_Address));
return;
case TC_REFERENCE_TRAP:
{
if ((OBJECT_DATUM (Expr)) <= TRAP_MAX_IMMEDIATE)
break;
- fprintf (stream, "[REFERENCE-TRAP");
+ outf (stream, "[REFERENCE-TRAP");
print_expression (stream, (MEMORY_REF (Expr, TRAP_TAG)), " tag");
print_expression (stream, (MEMORY_REF (Expr, TRAP_EXTRA)), " extra");
- fprintf (stream, "]");
+ outf (stream, "]");
return;
}
case TC_RETURN_CODE:
- fprintf (stream, "[RETURN_CODE ");
+ outf (stream, "[RETURN_CODE ");
print_return_name (stream, Expr);
- fprintf (stream, "]");
+ outf (stream, "]");
return;
case TC_TRUE:
if (Temp_Address == 0)
{
- fprintf (stream, "#T");
+ outf (stream, "#T");
return;
}
break;
break;
}
- fprintf (stream, "[%s offset: 0x%lx entry: 0x%lx",
+ outf (stream, "[%s offset: 0x%lx entry: 0x%lx",
type_string,
((long) (compiled_entry_to_block_offset (entry))),
((long) (OBJECT_DATUM (entry))));
if (closure_p)
- fprintf (stream, " address: 0x%lx", ((long) Temp_Address));
+ outf (stream, " address: 0x%lx", ((long) Temp_Address));
filename = (compiled_entry_debug_filename (entry));
if (STRING_P (filename))
{
- fprintf (stream, " file: ");
+ outf (stream, " file: ");
print_filename (stream, filename);
}
else if (PAIR_P (filename))
{
- fprintf (stream, " file: ");
+ outf (stream, " file: ");
print_filename (stream, (PAIR_CAR (filename)));
- fprintf (stream, " block: %ld",
+ outf (stream, " block: %ld",
((long) (FIXNUM_TO_LONG (PAIR_CDR (filename)))));
}
- fprintf (stream, "]");
+ outf (stream, "]");
return;
}
if (! handled_p)
{
if ((OBJECT_TYPE (Expr)) <= LAST_TYPE_CODE)
- fprintf (stream, "[%s", (Type_Names [OBJECT_TYPE (Expr)]));
+ outf (stream, "[%s", (Type_Names [OBJECT_TYPE (Expr)]));
else
- fprintf (stream, "[0x%02x", (OBJECT_TYPE (Expr)));
+ outf (stream, "[0x%02x", (OBJECT_TYPE (Expr)));
}
- fprintf (stream, " 0x%lx]", ((long) Temp_Address));
+ outf (stream, " 0x%lx]", ((long) Temp_Address));
return;
}
\f
static Boolean
DEFUN (print_one_continuation_frame, (stream, Temp),
- FILE * stream AND SCHEME_OBJECT Temp)
+ outf_channel stream AND SCHEME_OBJECT Temp)
{
SCHEME_OBJECT Expr;
print_expression (stream, Temp, "Return code");
- fprintf (stream, "\n");
+ outf (stream, "\n");
Expr = (STACK_POP ());
print_expression (stream, Expr, "Expression");
- fprintf (stream, "\n");
+ outf (stream, "\n");
if (((OBJECT_DATUM (Temp)) == RC_END_OF_COMPUTATION) ||
((OBJECT_DATUM (Temp)) == RC_HALT))
return (true);
Boolean
DEFUN (Print_One_Continuation_Frame, (Temp), SCHEME_OBJECT Temp)
{
- return (print_one_continuation_frame (stdout, Temp));
+ return (print_one_continuation_frame (console_output, Temp));
}
\f
/* Back_Trace relies on (a) only a call to Save_Cont puts a return code on the
*/
void
-DEFUN (Back_Trace, (stream), FILE * stream)
+DEFUN (Back_Trace, (stream), outf_channel stream)
{
SCHEME_OBJECT Temp, * Old_Stack;
if ((STACK_LOCATIVE_DIFFERENCE (Stack_Top, (STACK_LOC (0)))) <= 0)
{
if ((STACK_LOC (0)) == Old_Stack)
- fprintf (stream, "\n[Invalid stack pointer.]\n");
+ outf (stream, "\n[Invalid stack pointer.]\n");
else
- fprintf (stream, "\n[Stack ends abruptly.]\n");
+ outf (stream, "\n[Stack ends abruptly.]\n");
break;
}
if (Return_Hook_Address == (STACK_LOC (0)))
Temp = (STACK_POP ());
if (Temp != (MAKE_OBJECT (TC_RETURN_CODE, RC_RETURN_TRAP_POINT)))
{
- fprintf (stream, "\n--> Return trap is missing here <--\n");
+ outf (stream, "\n--> Return trap is missing here <--\n");
}
else
{
- fprintf (stream, "\n[Return trap found here as expected]\n");
+ outf (stream, "\n[Return trap found here as expected]\n");
Temp = Old_Return_Code;
}
}
if ((OBJECT_TYPE (Temp)) == TC_MANIFEST_NM_VECTOR)
{
Stack_Pointer = (STACK_LOC (- (OBJECT_DATUM (Temp))));
- fprintf (stream, " (skipping)");
+ outf (stream, " (skipping)");
}
- fprintf (stream, "\n");
+ outf (stream, "\n");
}
}
Stack_Pointer = Old_Stack;
Back_Trace_Exit_Hook();
- fflush (stream);
+ outf_flush (stream);
return;
}
saved_sp = Stack_Pointer;
Stack_Pointer = sp;
- Back_Trace (stdout);
+ Back_Trace (console_output);
Stack_Pointer = saved_sp;
return;
}
\f
static Boolean
DEFUN (print_primitive_name, (stream, primitive),
- FILE * stream AND SCHEME_OBJECT primitive)
+ outf_channel stream AND SCHEME_OBJECT primitive)
{
extern char * EXFUN (primitive_to_name, (SCHEME_OBJECT));
char *name;
name = primitive_to_name(primitive);
if (name == ((char *) NULL))
{
- fprintf (stream, "Unknown primitive 0x%08x", PRIMITIVE_NUMBER(primitive));
+ outf (stream, "Unknown primitive 0x%08x", PRIMITIVE_NUMBER(primitive));
return false;
}
else
{
- fprintf (stream, "%s", name);
+ outf (stream, "%s", name);
return true;
}
}
char buffer[40];
int NArgs, i;
- printf ("Primitive: ");
- if (print_primitive_name (stdout, primitive))
+ outf_console ("Primitive: ");
+ if (print_primitive_name (console_output, primitive))
{
NArgs = primitive_to_arity(primitive);
}
{
NArgs = 3; /* Unknown primitive */
}
- printf ("\n");
+ outf_console ("\n");
for (i = 0; i < NArgs; i++)
{
sprintf (buffer, "...Arg %ld", ((long) (i + 1)));
- print_expression (stdout, (STACK_REF (i)), buffer);
- printf ("\n");
+ print_expression (console_output, (STACK_REF (i)), buffer);
+ outf_console ("\n");
}
return;
}
{
int value = (* (find_flag (i)));
if (all || value)
- fprintf (stdout, "Flag %ld (%s) is %s.\n",
+ outf (console_output, "Flag %ld (%s) is %s.\n",
((long) i), (flag_name (i)), (value ? "set" : "clear"));
}
- fflush (stdout);
+ outf_flush_console();
return;
}
show_flags (0);
while (1)
{
- fputs ("Clear<number>, Set<number>, Done, ?, or Halt: ", stdout);
- fflush (stdout);
+ outf_console("Clear<number>, Set<number>, Done, ?, or Halt: ");
+ outf_flush_console();
{
fgets (input_line, (sizeof (input_line)), stdin);
switch (input_line[0])
void
DEFUN_VOID (debug_edit_flags)
{
- fprintf (stderr, "Not a debugging version. No flags to handle.\n");
- fflush (stderr);
+ outf_error ("Not a debugging version. No flags to handle.\n");
+ outf_flush_error();
return;
}
#!/bin/sh
# Configuration script for MIT Scheme
-# $Id: config,v 1.18 1993/02/18 01:50:41 gjr Exp $
+# $Id: config,v 1.19 1993/06/24 04:22:09 gjr Exp $
# Modelled on the configuration script for GNU CC
# Copyright (C) 1988 Free Software Foundation, Inc.
# Shell script to create proper links to machine-dependent files in
# preparation for compiling gcc.
#
-# Usage: config.sh machine
+# Usage: config machine
#
-# If config.sh succeeds, it leaves its status in config.status.
-# If config.sh fails after disturbing the status quo,
-# config.status is removed.
+# If config succeeds, it leaves its status in config.out.
+# If config fails after disturbing the status quo,
+# config.out is removed.
#
progname=$0
remove=rm
hard_link=ln
symbolic_link='ln -s'
+copy=cp
#for Test
#remove="echo rm"
#symbolic_link="echo ln -s"
cmpint_file=nothing_special
+cmpaux_file=nothing_special
+cmpaux_target=cmpauxmd.m4
cmp_file=nothing_special
case $# in
machine=$1
case $machine in
- vax-bsd42) # vaxen running 4.2BSD
- system_file=bsd4-2
- machine_file=vax
- cmpint_file=cmpint-vax.h
- ;;
- vax-bsd43) # vaxen running 4.3BSD
- system_file=bsd4-3
- machine_file=vax
- cmpint_file=cmpint-vax.h
- ;;
- vax-ultrix) # vaxen running ultrix
- system_file=ultrix
- machine_file=vax
- cmpint_file=cmpint-vax.h
+ alpha-osf | alpha) # DEC Alpha running OSF
+ system_file=decosf
+ machine_file=alpha
+ cmpint_file=alpha.h
+ cmpaux_file=alpha.m4
;;
mips-ultrix | dec-3100 | dec-5100 | pmax)
system_file=ultrix
machine_file=mips
- cmpint_file=cmpint-mips.h
+ cmpint_file=mips.h
+ cmpaux_file=mips.m4
;;
sgi4d)
system_file=irix4
machine_file=mips
- cmpint_file=cmpint-mips.h
+ cmpint_file=mips.h
+ cmpaux_file=mips.m4
;;
nws3250) # sony news laptop
system_file=newsos5
machine_file=mips
- cmpint_file=cmpint-mips.h
+ cmpint_file=mips.h
+ cmpaux_file=mips.m4
+ ;;
+ 386bsd)
+ system_file=386bsd
+ machine_file=i386
+ cmpint_file=i386.h
+ cmpaux_file=i386.m4
+ ;;
+ i386-sysv)
+ system_file=sysv3
+ machine_file=i386
+ cmpint_file=i386.h
+ cmpaux_file=i386.m4
+ ;;
+ hp9k800 | hp9k700) # HP9000 series 800
+ system_file=hpux
+ machine_file=hp9k800
+ cmpint_file=hppa.h
+ cmpaux_file=hppa.m4
;;
hp9k300) # HP9000 series 300
system_file=hpux
machine_file=hp9k300
- cmpint_file=cmpint-mc68k.h
+ cmpint_file=mc68k.h
+ cmpaux_file=mc68k.m4
;;
hp9k400) # HP9000 series 400
system_file=hpux
machine_file=hp9k400
- cmpint_file=cmpint-mc68k.h
+ cmpint_file=mc68k.h
+ cmpaux_file=mc68k.m4
;;
- hp9k800 | hp9k700) # HP9000 series 800
- system_file=hpux
- machine_file=hp9k800
- cmpint_file=cmpint-hppa.h
- ;;
- i386-sysv)
- system_file=sysv3
- machine_file=i386
- cmpint_file=cmpint-i386.h
+ next)
+ system_file=nextos.h
+ machine_file=next
+ cmpint_file=mc68k.h
+ cmpaux_file=mc68k.m4
+ cmp_file=sun3-gcc.s
;;
- 386bsd)
- system_file=386bsd
- machine_file=i386
- cmpint_file=cmpint-i386.h
- ;;
sun3)
system_file=sunos4
machine_file=sun3
- cmpint_file=cmpint-mc68k.h
- cmp_file=cmpaux/sun3.s
- cmp_link=cmpaux-mc68k.s
+ cmpint_file=mc68k.h
+ cmpaux_file=mc68k.m4
+ cmp_file=sun3.s
;;
sun3-os3) # sun3, pre-4.0 sunos
system_file=sunos3
machine_file=sun3
- cmpint_file=cmpint-mc68k.h
- cmp_file=cmpaux/sun3.s
- cmp_link=cmpaux-mc68k.s
+ cmpint_file=mc68k.h
+ cmpaux_file=mc68k.m4
+ cmp_file=sun3.s
;;
sun3-nfp) # sun3, No Floating Point
system_file=sunos4
machine_file=sun3
- cmpint_file=cmpint-mc68k.h
- cmp_file=cmpaux/sun3-nfp.s
- cmp_link=cmpaux-mc68k.s
+ cmpint_file=mc68k.h
+ cmpaux_file=mc68k.m4
+ cmp_file=sun3-nfp.s
;;
sun3-os3-nfp) # sun3, pre-4.0 sunos, No Floating Point
system_file=sunos3
machine_file=sun3
- cmpint_file=cmpint-mc68k.h
- cmp_file=cmpaux/sun3-nfp.s
- cmp_link=cmpaux-mc68k.s
+ cmpint_file=mc68k.h
+ cmpaux_file=mc68k.m4
+ cmp_file=sun3-nfp.s
;;
sun4)
system_file=sunos4
machine_file=sun4
;;
- next)
- system_file=next-mach
- machine_file=next
- cmpint_file=cmpint-mc68k.h
- cmp_file=cmpaux/sun3-gcc.s
- cmp_link=cmpaux-mc68k.s
- ;;
umax) # Encore Multimax
system_file=umax
machine_file=umax
;;
- alpha-osf | alpha) # DEC Alpha running OSF
- system_file=decosf
- machine_file=alpha
- cmpint_file=cmpint-alpha.h
+ vax-bsd42) # vaxen running 4.2BSD
+ system_file=bsd4-2
+ machine_file=vax
+ cmpint_file=vax.h
+ cmpaux_file=vax.m4
+ ;;
+ vax-bsd43) # vaxen running 4.3BSD
+ system_file=bsd4-3
+ machine_file=vax
+ cmpint_file=vax.h
+ cmpaux_file=vax.m4
+ ;;
+ vax-ultrix) # vaxen running ultrix
+ system_file=ultrix
+ machine_file=vax
+ cmpint_file=vax.h
+ cmpaux_file=vax.m4
;;
*)
echo "$progname: unknown machine name: $machine"
exit 1
esac
- files="s/${system_file}.h m/${machine_file}.h"
- links="s.h m.h"
+ files="s/${system_file}.h m/${machine_file}.h unxutl/makefile unxutl/ymkfile unxutl/ymake.sed"
+ links="s.h m.h makefile ymkfile ymake.sed"
while [ -n "$files" ]
do
fi
$remove -f $link
- rm -f config.status
+ rm -f config.out
# Make a symlink if possible, otherwise try a hard link
$symbolic_link $file $link 2>/dev/null || $hard_link $file $link
echo "Linked \`$link' to \`$file'."
done
+ files="unxutl/cf-dist.h"
+ targets="cf.h"
+
+ while [ -n "$files" ]
+ do
+ # set file to car of files, files to cdr of files
+ set $files; file=$1; shift; files=$*
+ set $targets; target=$1; shift; targets=$*
+
+ if [ ! -r $file ]
+ then
+ echo "$progname: cannot create file \`$target',"
+ echo "since the file \`$file' does not exist."
+ exit 1
+ fi
+
+ $remove -f $target
+ rm -f config.out
+ # Make a symlink if possible, otherwise try a hard link
+ $copy $file $target
+
+ if [ ! -r $target ]
+ then
+ echo "$progname: unable to copy \`$file' to \`$target'."
+ exit 1
+ fi
+ echo "Copied \`$file' to \`$target'."
+ done
+
case $cmpint_file in
nothing_special)
;;
*)
- $symbolic_link $cmpint_file cmpint2.h 2>/dev/null || $hard_link $cmpint_file cmpint2.h
- if [ ! -r cmpint2.h ]
+ $symbolic_link cmpintmd/$cmpint_file cmpintmd.h 2>/dev/null \
+ || $hard_link cmpintmd/$cmpint_file cmpintmd.h
+ if [ ! -r cmpintmd.h ]
+ then
+ echo "$progname: unable to link \`cmpintmd.h' to \`cmpintmd/$cmpint_file'."
+ exit 1
+ fi
+ echo "Linked \`cmpintmd.h' to \`cmpintmd/$cmpint_file'."
+ ;;
+ esac
+
+ case $cmpaux_file in
+ nothing_special)
+ ;;
+ *)
+ $symbolic_link cmpauxmd/$cmpaux_file $cmpaux_target 2>/dev/null \
+ || $hard_link cmpauxmd/$cmpaux_file $cmpaux_target
+ if [ ! -r $cmpaux_target ]
then
- echo "$progname: unable to link \`cmpint2.h' to \`$cmpint_file'."
+ echo "$progname: unable to link \`$cmpaux_target' to \`cmpauxmd/$cmpaux_file'."
exit 1
fi
- echo "Linked \`cmpint2.h' to \`$cmpint_file'."
+ echo "Linked \`$cmpaux_target' to \`cmpauxmd/$cmpaux_file'."
;;
esac
nothing_special)
;;
*)
- $symbolic_link $cmp_file $cmp_link 2>/dev/null || $hard_link $cmp_file $cmp_link
- if [ ! -r $cmp_link ]
+ $symbolic_link cmpauxmd/$cmp_file cmpauxmd.s 2>/dev/null \
+ || $hard_link cmpauxmd/$cmp_file cmpauxmd.s
+ if [ ! -r cmpauxmd.s ]
then
- echo "$progname: unable to link \`$cmp_link' to \`$cmp_file'."
+ echo "$progname: unable to link \`cmpauxmd.s' to \`cmpauxmd/$cmp_file'."
exit 1
fi
- echo "Linked \`$cmp_link' to \`$cmp_file'."
+ echo "Linked \`cmpauxmd.s' to \`cmpauxmd/$cmp_file'."
;;
esac
- echo "Links are now set up for use with a $machine." \
- | tee config.status
+ (echo "Links are now set up for use with a $machine." ; \
+ echo "Remember to edit file cf.h before using make.") \
+ | tee config.out
exit 0
;;
*)
echo "Usage: $progname machine"
echo "Where \`machine' is one of:"
- echo "vax-bsd42 vax-bsd43 vax-ultrix mips-ultrix"
- echo "nws3250 hp9k300 hp9k400 hp9k700 hp9k800 i386-sysv"
- echo "sun3 sun3-os3 sun3-nfp sun3-os3-nfp sun4 umax next"
- echo "alpha-osf alpha sgi4d"
- if [ -r config.status ]
+ echo "alpha-osf alpha"
+ echo "mips-ultrix nws3250 sgi4d"
+ echo "hp9k300 hp9k400 hp9k700 hp9k800 next"
+ echo "sun3 sun3-os3 sun3-nfp sun3-os3-nfp sun4"
+ echo "i386-sysv 386bsd umax"
+ echo "vax-bsd42 vax-bsd43 vax-ultrix"
+ if [ -r config.out ]
then
- cat config.status
+ cat config.out
fi
exit 1
;;
projects / mit-scheme.git / commitdiff