#!/bin/sh # to extract, remove the header and type "sh filename" # Patch file contributed by Mike Meyer, mwm@wse.dec.com if `test ! -s ./AMIGA.Readme` then echo "writing ./AMIGA.Readme" cat > ./AMIGA.Readme << '\End\Of\Shar\' ******** WARNING ******** The Amiga patch file patches the source in ./scsc and ./scrt. You should apply it to a copy, not the originals. ******** WARNING ******** The patch file Amiga-28Sep90.patches should be applied to the 28sep90 version of Scheme-to-C with the MCC-28sep90.patches applied (the MCC patches give sources that can open their words on either end). Because various things are not available on AmigaDOS, there have been a number of changes. Links and a standard make are missing from AmigaDOS, so the organization that allowed for keeping multiple versions out of the same source tree has been discarded. The patch file modifies sources in the directories scsc and scrt in the current directory, and there are build scripts to build the system in each of those two directories. Build is a rexx script in the current directory. It will read the file name given as an argument, and process it in a manner similar to make, except on a line-by-line basis instead of the entire file. As a result, the scripts can be used as execute scripts directly. For more information on build, see the file "build.rexx" in the Amiga directory. To build from C source, use the build script "fromc". To build from scheme sources, use the build script "fromsc". If you have Rexx, the scripts will work directly. If you don't have rexx, the "build" in the last line of the fromsc script will need to be changed to an "execute". You will need SAS C 5.10b to build the system. 5.10a can be used as a target, but bugs in the code generator for 5.10a cause the garbage collection code to fail. I suspect that any 5.10 can be used as a target for the compiler, but have only tested 5.10a and b. If you don't have 5.10b yet, binaries should be available in pub/micro/amiga/lisp/Scheme-to-C on gatekeeper.pa.dec.com. To build the system, first cd to scrt, run sascoption to set the processor types correctly (the default is 68030/68881). If you are running 1.3, edit the select function at the end of cio.c. The second parameter WaitForChar should be 1, not 0, to avoid a bug in the pre 2.0 timer.device. Now execute "fromc" and get a cup of coffee. After the build, the file sc.lib should be copid to lib:, objects.h to include:sc, and sci to wherever on your path you wish it to live. Next cd to scsc, run sascoptions, and execute fromc again. Then copy Xscc to wherever you wish it to live as "scc." At this point, you can rebuild the system from scheme by execute "fromsc" in each directory instead of fromc. The interpreter (sci) should run on a 1.5 Meg system, and the compiler (scc) on a 2 Meg system. However, I recommend at least a 2 meg heap for anything but trivial compiles, and 3 for anything serious. All scheme files except scsc/transform.sc can be compiled with a 3 meg heap; transform.sc requires a 4 meg heap. This means you need (at least) a 5 meg amiga to rebuild the system from scratch. The "save-heap" and "restore-heap" facilities are probably not possible on the Amiga; I decided not to worry about them. As a result, the compiler re-initializes itself every time it is run. There is no rusage information available. Other than that, the scheme environment has not been changed. The "front end" portion of the compiler was modified to work with SAS C instead of a Unix C, and the "profiled" compile switch was disabled. Those are the only changes to the scheme sources in either the interpreter or the compiler that are anything but minor tweaks for SAS C. I think the changed C code will still work in most of the environments it worked in before, but I haven't tested it. \End\Of\Shar\ else echo "will not over write ./AMIGA.Readme" fi if `test ! -s ./Amiga-28sep90.patches` then echo "writing ./Amiga-28sep90.patches" cat > ./Amiga-28sep90.patches << '\End\Of\Shar\' diff -r -c -N ../orig/makefile ./makefile *** ../orig/makefile Tue Oct 8 12:30:39 1991 --- ./makefile Mon Oct 7 14:31:20 1991 *************** *** 32,37 **** --- 32,41 ---- SUN3BIN = ${SRCDIR}/bin.sun3 SUN3LIB = ${SRCDIR}/lib.sun3 + AMIGADIR = ${SRCDIR}/Amiga + AMIGABIN = ${SRCDIR}/bin.Amiga + AMIGALIB = ${SRCDIR}/lib.Amiga + I386DIR = ${SRCDIR}/i386 I386BIN = ${SRCDIR}/bin.i386 I386LIB = ${SRCDIR}/lib.i386 *************** *** 38,44 **** # This is a list of the machines/architectures that are currently supported. # These are also the names of the necessary makefile fragements. ! MACHINES = APOLLO I386 MIPS PRISM SPARC SUN3 TITAN VAX # Architecture specific directories and links to the source files are # constructed by the following commands which follow: --- 42,48 ---- # This is a list of the machines/architectures that are currently supported. # These are also the names of the necessary makefile fragements. ! MACHINES = APOLLO I386 MIPS PRISM SPARC SUN3 TITAN VAX AMIGA # Architecture specific directories and links to the source files are # constructed by the following commands which follow: *************** *** 119,124 **** --- 123,132 ---- forSUN3: $(MAKE) "CPU = SUN3" "CPUDIR = ${SUN3DIR}" "SRCDIR = ${SRCDIR}" \ "BINDIR=${SUN3BIN}" "LIBDIR=${SUN3LIB}" forCPU + + forAMIGA: + $(MAKE) "CPU = AMIGA" "CPUDIR = ${AMIGADIR}" "SRCDIR = ${SRCDIR}" \ + "BINDIR=${AMIGABIN}" "LIBDIR=${AMIGALIB}" forCPU forI386: $(MAKE) "CPU = I386" "CPUDIR = ${I386DIR}" "SRCDIR = ${SRCDIR}" \ diff -r -c -N ../orig/scrt/SASCOPTS ./scrt/SASCOPTS *** ../orig/scrt/SASCOPTS --- ./scrt/SASCOPTS Mon Oct 7 18:09:22 1991 *************** *** 0 **** --- 1,18 ---- + -b0 + -r0 + -f8 -Lm + -m3 + -O + -cs + -cu + -i + -dMC68030 + -dMATHTRAPS=0 + -j93i + -j85i + -j132i + -j84i + -j88i + -mt + -Ln + -Psci diff -r -c -N ../orig/scrt/cio.c ./scrt/cio.c *** ../orig/scrt/cio.c Tue Oct 8 12:30:12 1991 --- ./scrt/cio.c Mon Oct 7 19:02:00 1991 *************** *** 42,49 **** --- 42,57 ---- /* This module supplies functions to access C Library I/O macros. */ #include + #ifndef AMIGA #include #include + #else + #include + #define _cnt _rcnt /* Map buffer checks to read buffer only */ + #include + #include + #endif + #include "objects.h" /* This really does not need to be dependant on ISC386IX, just the lack of */ *************** *** 102,114 **** FILE *stream; { int readfds, nfound; #ifndef ISC386IX struct timeval timeout; #else struct pollfd pollfd; ! #endif if (((stream)->_cnt) <= 0) { #ifndef ISC386IX readfds = 1<<(fileno( stream )); timeout.tv_sec = 0; --- 110,130 ---- FILE *stream; { int readfds, nfound; + #ifdef AMIGA + extern struct UFB _ufbs[]; + #else #ifndef ISC386IX struct timeval timeout; #else struct pollfd pollfd; ! #endif /* ISC386IX */ ! #endif /* AMIGA */ if (((stream)->_cnt) <= 0) { + #ifdef AMIGA + nfound = (!IsInteractive(_ufbs[fileno(stream)].ufbfh)) ? 1 + : WaitForChar(_ufbs[fileno(stream)].ufbfh, 0); + #else #ifndef ISC386IX readfds = 1<<(fileno( stream )); timeout.tv_sec = 0; *************** *** 118,124 **** pollfd.fd = fileno( stream ); pollfd.events = POLLIN; nfound = poll(&pollfd, 1, 0); ! #endif if (nfound == 0) return( 0 ); } return( 1 ); --- 134,141 ---- pollfd.fd = fileno( stream ); pollfd.events = POLLIN; nfound = poll(&pollfd, 1, 0); ! #endif /* ISC386IX */ ! #endif /* AMIGA */ if (nfound == 0) return( 0 ); } return( 1 ); *************** *** 136,138 **** --- 153,181 ---- else return( 0 ); } + + #ifdef AMIGA + /* Sigh - lattice doesn't have an fflush function or any select, so we + * so we provide them... */ + #undef fflush + extern struct UFB _ufbs[]; + + int select(nfds, readfds, writefds, execptfds, timeout) + int nfds, *readfds, *writefds, *execptfds, timeout; + { + int file = 0, fd = *readfds ; + + while (fd) { /* Get a real file number from the bit*/ + fd = fd >> 1 ; + file += 1 ; + } + return (!IsInteractive(_ufbs[file].ufbfh)) ? 1 + : WaitForChar(_ufbs[file].ufbfh, 0) ? 0 : 1 ; + } + + + int + fflush(fp) FILE *fp; { + return _flsbf(-1, fp) ; + } + #endif diff -r -c -N ../orig/scrt/fromc ./scrt/fromc *** ../orig/scrt/fromc --- ./scrt/fromc Mon Oct 7 19:01:51 1991 *************** *** 0 **** --- 1,26 ---- + ;; ===build instructions + lc -. apply ; output= apply.o input= apply.c objects.h scinit.h apply.h callcc.h cio.h heap.h objects.h signal.h + lc -. callcc ; output= callcc.o input= callcc.c objects.h scinit.h apply.h callcc.h cio.h heap.h objects.h signal.h + lc -. cio ; output= cio.o input= cio.c objects.h scinit.h apply.h callcc.h cio.h heap.h objects.h signal.h + lc -. heap ; output= heap.o input= heap.c objects.h scinit.h apply.h callcc.h cio.h heap.h objects.h signal.h + lc -. objects ; output= objects.o input= objects.c objects.h scinit.h apply.h callcc.h cio.h heap.h objects.h signal.h + lc -. scdebug ; output= scdebug.o input= scdebug.c objects.h + lc -. sceval ; output= sceval.o input= sceval.c objects.h + lc -. scexpand ; output= scexpand.o input= scexpand.c objects.h + lc -. scexpanders1 ; output= scexpanders1.o input= scexpanders1.c objects.h + lc -. scexpanders2 ; output= scexpanders2.o input= scexpanders2.c objects.h + lc -. scinit ; output= scinit.o input= scinit.c objects.h scinit.h apply.h callcc.h cio.h heap.h objects.h signal.h + lc -. scqquote ; output= scqquote.o input= scqquote.c objects.h + lc -. screp ; output= screp.o input= screp.c objects.h + lc -. scrt1 ; output= scrt1.o input= scrt1.c objects.h + lc -. scrt2 ; output= scrt2.o input= scrt2.c objects.h + lc -. scrt3 ; output= scrt3.o input= scrt3.c objects.h + lc -. scrt4 ; output= scrt4.o input= scrt4.c objects.h + lc -. scrt5 ; output= scrt5.o input= scrt5.c objects.h + lc -. scrt6 ; output= scrt6.o input= scrt6.c objects.h + lc -. scrt7 ; output= scrt7.o input= scrt7.c objects.h + lc -. signal ; output= signal.o input= signal.c objects.h scinit.h apply.h callcc.h cio.h heap.h objects.h signal.h + join as sc.lib apply.o callcc.o cio.o heap.o objects.o scdebug.o sceval.o scexpand.o scexpanders1.o scexpanders2.o scinit.o scqquote.o screp.o scrt1.o scrt2.o scrt3.o scrt4.o scrt5.o scrt6.o scrt7.o signal.o ; output= sc.lib input= apply.o callcc.o cio.o heap.o objects.o scdebug.o sceval.o scexpand.o scexpanders1.o scexpanders2.o scinit.o scqquote.o screp.o scrt1.o scrt2.o scrt3.o scrt4.o scrt5.o scrt6.o scrt7.o select.o signal.o + lc -. sci ; output= sci.o input= sci.c objects.h + lc -. -M -L+sc.lib sci ; output= sci input= sc.lib sci.o + ;; ===endbuild diff -r -c -N ../orig/scrt/fromsc ./scrt/fromsc *** ../orig/scrt/fromsc --- ./scrt/fromsc Mon Oct 7 18:08:59 1991 *************** *** 0 **** --- 1,18 ---- + ;; ===build instructions, from sc to c + scc -C scdebug.sc ; output= scdebug.c input= scdebug.sc predef.sc repdef.sc + scc -C sceval.sc ; output= sceval.c input= sceval.sc predef.sc repdef.sc + scc -C scexpand.sc ; output= scexpand.c input= scexpand.sc predef.sc repdef.sc + scc -C scexpanders1.sc ; output= scexpanders1.c input= scexpanders1.sc predef.sc repdef.sc + scc -C scexpanders2.sc ; output= scexpanders2.c input= scexpanders2.sc predef.sc repdef.sc + scc -C screp.sc ; output= screp.c input= screp.sc predef.sc repdef.sc + scc -C sci.sc ; output= sci.c input= sci.sc predef.sc + scc -C scqquote.sc ; output= scqquote.c input= scqquote.sc predef.sc repdef.sc + scc -C scrt1.sc ; output= scrt1.c input= scrt1.sc predef.sc + scc -C scrt2.sc ; output= scrt2.c input= scrt2.sc predef.sc + scc -C scrt3.sc ; output= scrt3.c input= scrt3.sc predef.sc + scc -C scrt4.sc ; output= scrt4.c input= scrt4.sc predef.sc + scc -C scrt5.sc ; output= scrt5.c input= scrt5.sc predef.sc + scc -C scrt6.sc ; output= scrt6.c input= scrt6.sc predef.sc repdef.sc + scc -C scrt7.sc ; output= scrt7.c input= scrt7.sc predef.sc + build fromc + ;; ===endbuild diff -r -c -N ../orig/scrt/heap.c ./scrt/heap.c *** ../orig/scrt/heap.c Tue Oct 8 12:30:15 1991 --- ./scrt/heap.c Mon Oct 7 14:31:28 1991 *************** *** 106,112 **** int sc_gcinfo; /* controls logging */ ! #ifndef SYSV static struct rusage gcru, /* resource consumption during collection */ startru, stopru; --- 106,112 ---- int sc_gcinfo; /* controls logging */ ! #ifndef NO_RUSAGE static struct rusage gcru, /* resource consumption during collection */ startru, stopru; *************** *** 119,125 **** TSCP sc_after_2dcollect_v; /* Collection status callback */ ! #ifndef SYSV /* The following function converts a rusage structure into an 18 word Scheme vector composed of the same items. */ --- 119,125 ---- TSCP sc_after_2dcollect_v; /* Collection status callback */ ! #ifndef NO_RUSAGE /* The following function converts a rusage structure into an 18 word Scheme vector composed of the same items. */ *************** *** 249,255 **** { return( rusagevector( &gcru ) ); } - #else #define getrusage(x,y) /* no operation */ #define updategcru() /* no operation */ --- 249,254 ---- *************** *** 499,504 **** --- 498,533 ---- #endif SUN3 + #ifdef AMIGA + /* All processor registers are traced by the following procedure. */ + + static trace_stack_and_registers() + { + volatile int d0toa4[ 15 ]; + int *pp; + + d0toa4[0] = getreg(0); + d0toa4[1] = getreg(1); + d0toa4[2] = getreg(2); + d0toa4[3] = getreg(3); + d0toa4[4] = getreg(4); + d0toa4[5] = getreg(5); + d0toa4[6] = getreg(6); + d0toa4[7] = getreg(7); + d0toa4[8] = getreg(8); + d0toa4[9] = getreg(9); + d0toa4[10] = getreg(10); + d0toa4[11] = getreg(11); + d0toa4[12] = getreg(12); + d0toa4[13] = getreg(13); + d0toa4[14] = getreg(14); + pp = (short *) STACKPTR; /* This gets 15 */ + while (pp != sc_stackbase) + move_continuation_ptr( *pp++ ); + } + #endif + + #ifdef I386 /* The following code is used to read the stack pointer. The register number is passed in to force an argument to be on the stack, which in *************** *** 1545,1551 **** getrusage( 0, &stopru ); updategcru(); if (sc_gcinfo) { ! #ifndef SYSV fprintf( stderr, " %d%% locked %d%% retained %d user ms", (sc_lockcnt*100)/sc_heappages, --- 1574,1580 ---- getrusage( 0, &stopru ); updategcru(); if (sc_gcinfo) { ! #ifndef NO_RUSAGE fprintf( stderr, " %d%% locked %d%% retained %d user ms", (sc_lockcnt*100)/sc_heappages, diff -r -c -N ../orig/scrt/heap.h ./scrt/heap.h *** ../orig/scrt/heap.h Tue Oct 8 12:30:18 1991 --- ./scrt/heap.h Mon Oct 7 14:31:30 1991 *************** *** 59,65 **** #endif #endif ! #ifndef SYSV #include #endif --- 59,65 ---- #endif #endif ! #ifndef NO_RUSAGE #include #endif *************** *** 354,359 **** --- 354,364 ---- #ifdef SPARC #define STACKPTR sc_processor_register( 0 ) + #endif + + #ifdef AMIGA + #include + #define STACKPTR getreg(15) #endif #ifdef SUN3 diff -r -c -N ../orig/scrt/objects.h ./scrt/objects.h *** ../orig/scrt/objects.h Tue Oct 8 12:30:28 1991 --- ./scrt/objects.h Mon Oct 7 14:31:35 1991 *************** *** 127,132 **** --- 127,142 ---- #define CPUTYPE VAX #endif + #ifdef AMIGA + #include + #define NO_RUSAGE + #define BIG_ENDIAN + #undef DOUBLE_ALIGN + #undef SHORTFLOAT + #undef MATHTRAPS + #define MATHTRAPS 0 + #endif + #ifdef APOLLO #include #define CPUTYPE APOLLO *************** *** 169,174 **** --- 179,188 ---- #define MATHTRAPS 0 #endif + #ifdef SYSV + #define NO_RUSAGE + #endif + /* The data encoding scheme is similar to that used by Vax NIL and T, where all objects are represented by 32-bit pointers, with a "low tag" encoded in the two least significant bits encoding the type. All objects are *************** *** 323,328 **** --- 337,346 ---- #define TX_U( tscp ) ((SCP)((char*)tscp-EXTENDEDTAG)) #define TP_U( tscp ) ((SCP)((char*)tscp-PAIRTAG)) #endif + #ifdef AMIGA + #define TX_U( tscp ) ((SCP)((char*)(tscp)-EXTENDEDTAG)) + #define TP_U( tscp ) ((SCP)((char*)(tscp)-PAIRTAG)) + #endif #ifdef I386 #define TX_U( tscp ) ((SCP)((char*)tscp-EXTENDEDTAG)) #define TP_U( tscp ) ((SCP)((char*)tscp-PAIRTAG)) *************** *** 882,887 **** --- 900,908 ---- #ifdef SUN3 #define VECTOR_ELEMENT( tscp, n ) (*((PATSCP)(((char*)( tscp ))+3+((int)n)))) #endif + #ifdef AMIGA + #define VECTOR_ELEMENT( tscp, n ) (*((PATSCP)(((char*)( tscp ))+3+((int)n)))) + #endif #define PROCEDURE_REQUIRED( tscp ) (TX_U( tscp )->procedure.required) #define PROCEDURE_OPTIONAL( tscp ) (TX_U( tscp )->procedure.optional) *************** *** 919,967 **** #define EXTERNTSCP( a ) extern TSCP a ! #define EXTERNTSCPP( a ) extern TSCP a() #define EXTERNINT( a ) extern int a ! #define EXTERNINTP( a ) extern int a() ! #define EXTERNPOINTER( a ) extern unsigned a ! #define EXTERNPOINTERP( a ) extern unsigned a() #define EXTERNCHAR( a ) extern char a ! #define EXTERNCHARP( a ) extern char a() #define EXTERNSHORTINT( a ) extern short int a ! #define EXTERNSHORTINTP( a ) extern short int a() #define EXTERNLONGINT( a ) extern long int a ! #define EXTERNLONGINTP( a ) extern long int a() #define EXTERNUNSIGNED( a ) extern unsigned a ! #define EXTERNUNSIGNEDP( a ) extern unsigned a() ! #define EXTERNSHORTUNSIGNED( a ) extern short unsigned a ! #define EXTERNSHORTUNSIGNEDP( a ) extern short unsigned a() ! #define EXTERNLONGUNSIGNED( a ) extern long unsigned a ! #define EXTERNLONGUNSIGNEDP( a ) extern long unsigned a() #define EXTERNFLOAT( a ) extern float a ! #define EXTERNFLOATP( a ) extern float a() #define EXTERNDOUBLE( a ) extern double a ! #define EXTERNDOUBLEP( a ) extern double a() ! #define EXTERNVOIDP( a ) extern void a() #define MAXDISPLAY( a ) if (a > sc_maxdisplay) sc_maxdisplay = a --- 940,988 ---- #define EXTERNTSCP( a ) extern TSCP a ! #define EXTERNTSCPP( a ) extern TSCP (a)() #define EXTERNINT( a ) extern int a ! #define EXTERNINTP( a ) extern int (a)() ! #define EXTERNPOINTER( a ) extern void *a ! #define EXTERNPOINTERP( a ) extern void *(a)() #define EXTERNCHAR( a ) extern char a ! #define EXTERNCHARP( a ) extern char (a)() #define EXTERNSHORTINT( a ) extern short int a ! #define EXTERNSHORTINTP( a ) extern short int (a)() #define EXTERNLONGINT( a ) extern long int a ! #define EXTERNLONGINTP( a ) extern long int (a)() #define EXTERNUNSIGNED( a ) extern unsigned a ! #define EXTERNUNSIGNEDP( a ) extern unsigned (a)() ! #define EXTERNSHORTUNSIGNED( a ) extern unsigned short a ! #define EXTERNSHORTUNSIGNEDP( a ) extern unsigned short (a)() ! #define EXTERNLONGUNSIGNED( a ) extern unsigned long a ! #define EXTERNLONGUNSIGNEDP( a ) extern unsigned long (a)() #define EXTERNFLOAT( a ) extern float a ! #define EXTERNFLOATP( a ) extern float (a)() #define EXTERNDOUBLE( a ) extern double a ! #define EXTERNDOUBLEP( a ) extern double (a)() ! #define EXTERNVOIDP( a ) extern void (a)() #define MAXDISPLAY( a ) if (a > sc_maxdisplay) sc_maxdisplay = a *************** *** 991,999 **** #define SHORTINT( a ) ((short int) a) #define INT( a ) ((int) a) #define LONGINT( a ) ((long int) a) ! #define SHORTUNSIGNED( a ) ((short unsigned) a) #define UNSIGNED( a ) ((unsigned) a) ! #define LONGUNSIGNED( a ) ((long unsigned) a) #define FLOAT( a ) ((FLOATTYPE) a) #define CFLOAT( a ) ((float) a) #define CDOUBLE( a ) ((double) a) --- 1012,1020 ---- #define SHORTINT( a ) ((short int) a) #define INT( a ) ((int) a) #define LONGINT( a ) ((long int) a) ! #define SHORTUNSIGNED( a ) ((unsigned short) a) #define UNSIGNED( a ) ((unsigned) a) ! #define LONGUNSIGNED( a ) ((unsigned long) a) #define FLOAT( a ) ((FLOATTYPE) a) #define CFLOAT( a ) ((float) a) #define CDOUBLE( a ) ((double) a) *************** *** 1002,1007 **** --- 1023,1036 ---- #define ADR( a ) (&a) #define DISPLAY( a ) (sc_display[ a ]) + /* AmigaOS doesn't do divide-by-zero trapping, so we add it here */ + #ifdef AMIGA + #undef QUOTIENT + #define QUOTIENT(a, b) (b == 0 ? sc_error("?????", "Divide by zero", 0) : (a / b)) + #undef REMAINDER + #define REMAINDER(a, b) (b == 0 ? sc_error("?????", "Divide by zero", 0) : (a % b)) + #endif + /* C operators that detect integer overflow in some implementations */ #if (MATHTRAPS == 0 || CPUTYPE == TITAN) *************** *** 1082,1089 **** #define MBYTE( base, bx ) (*( ((unsigned char*)T_U( base ))+bx )) #define MSINT( base, bx ) (*((short int*)( ((char*)T_U( base )) + bx ))) #define MINT( base, bx ) (*((int*)( ((char*)T_U( base )) + bx ))) ! #define MUNSIGNED(base, bx) (*((unsigned*)( ((char*)T_U( base )) + bx ))) ! #define MSUNSIGNED(base,bx) (*((short unsigned*)( ((char*)T_U( base )) + bx ))) #define MTSCP( base, bx ) (*((TSCP*)( ((char*)T_U( base )) + bx ))) #define MFLOAT( base, bx ) (*((float*)( ((char*)T_U( base )) + bx ))) #define MDOUBLE( base, bx ) (*((double*)( ((char*)T_U( base )) + bx ))) --- 1111,1118 ---- #define MBYTE( base, bx ) (*( ((unsigned char*)T_U( base ))+bx )) #define MSINT( base, bx ) (*((short int*)( ((char*)T_U( base )) + bx ))) #define MINT( base, bx ) (*((int*)( ((char*)T_U( base )) + bx ))) ! #define MUNSIGNED(base, bx) (*((unsigned *)( ((char*)T_U( base )) + bx ))) ! #define MSUNSIGNED(base,bx) (*((unsigned short*)( ((char*)T_U( base )) + bx ))) #define MTSCP( base, bx ) (*((TSCP*)( ((char*)T_U( base )) + bx ))) #define MFLOAT( base, bx ) (*((float*)( ((char*)T_U( base )) + bx ))) #define MDOUBLE( base, bx ) (*((double*)( ((char*)T_U( base )) + bx ))) diff -r -c -N ../orig/scrt/scinit.c ./scrt/scinit.c *** ../orig/scrt/scinit.c Tue Oct 8 12:30:32 1991 --- ./scrt/scinit.c Mon Oct 7 14:31:39 1991 *************** *** 52,58 **** --- 52,65 ---- extern errno; /* C-library Error flag */ + #ifdef AMIGA + extern _tsize; + #define ETEXT ((int) _tsize) + #define STACKBASE (FindTask(0)->tc_SPLower) + #else extern etext; + #endif + #ifdef MIPS #define ETEXT ((int)&etext) /* First address after text */ #include *************** *** 99,108 **** --- 106,123 ---- #define STACKBASE (int*)UVSTACK #endif + #ifdef AMIGA + #include + #include + #include + #include + #include + #else #include #include #include #include + #endif #include /* Definitions for objects within sc */ *************** *** 215,221 **** static init_procs() { ! #ifndef SYSV INITIALIZEVAR( U_TX( ADR( t1030 ) ), ADR( sc_my_2drusage_v ), MAKEPROCEDURE( 0, --- 230,236 ---- static init_procs() { ! #ifndef NO_RUSAGE INITIALIZEVAR( U_TX( ADR( t1030 ) ), ADR( sc_my_2drusage_v ), MAKEPROCEDURE( 0, *************** *** 311,316 **** --- 326,347 ---- } return( memp ); } + #ifdef AMIGA + /* + * On the Amiga, sbrk() does not return contiguous blocks after each call. + * So we pre-allocate everything we're going to need, and provide our own sbrk. + */ + static char *amiga_heap ; + static unsigned amiga_heap_size ; + + static char *sbrk(unsigned size) { + + if (size > amiga_heap_size) return NULL ; + amiga_heap_size -= size ; + amiga_heap += size ; + return amiga_heap - size ; + } + #endif /* The following function is called to initialize the heap from scratch. */ *************** *** 335,345 **** } #endif if (sc_gcinfo) fprintf( stderr, "***** SCGCINFO = %d SCHEAP = %d SCLIMIT = %d\n", sc_gcinfo, scheap, sclimit ); sc_limit = sclimit; - sc_heappages = scheap*(ONEMB/PAGEBYTES); sc_allocatedheappages = 0; freebase = getmem( scheap*ONEMB+PAGEBYTES-1 ); if ((int)freebase & (PAGEBYTES-1)) --- 366,385 ---- } #endif + sc_heappages = scheap*(ONEMB/PAGEBYTES); + #ifdef AMIGA + /* Allocate the contiguous chunk of memory that everything else comes from */ + amiga_heap_size = scheap*ONEMB + 16*sc_heappages + 2*PAGEBYTES - 32 ; + if ( ! ( amiga_heap = (char *) malloc( amiga_heap_size ) ) ) { + fprintf( stderr, "***** Memory allocation failed: malloc( %d )\n", + amiga_heap_size ) ; + exit( 1 ); + } + #endif if (sc_gcinfo) fprintf( stderr, "***** SCGCINFO = %d SCHEAP = %d SCLIMIT = %d\n", sc_gcinfo, scheap, sclimit ); sc_limit = sclimit; sc_allocatedheappages = 0; freebase = getmem( scheap*ONEMB+PAGEBYTES-1 ); if ((int)freebase & (PAGEBYTES-1)) *************** *** 406,411 **** --- 446,452 ---- valid pages of the heap. */ + #ifndef AMIGA static struct { char id[4]; /* S->C */ TSCP procedure; /* Restart procedure */ *************** *** 463,468 **** --- 504,510 ---- C_FIXED( error ) ); } } + #endif AMIGA /* A Scheme program may call (SAVE-HEAP filename . procedure) to save the heap in a file named "filename". When the heap is reloaded into a *************** *** 479,484 **** --- 521,529 ---- int i, firstpage, pagecount; TSCP correct, cl, symbol, procedure; + #ifdef AMIGA + sc_error( "SAVE-HEAP", "Heap save/restore not supported on the Amiga", 0 ); + #else procedure = FALSEVALUE; if (argl != EMPTYLIST) { procedure = PAIR_CAR( argl ); *************** *** 556,561 **** --- 601,607 ---- heapout( PAGE_ADDRESS( firstpage ), pagecount*PAGEBYTES ); close( heapfile ); return( TRUEVALUE ); + #endif AMIGA } /* The following routine is called from a Scheme main program to determine *************** *** 587,596 **** --- 633,650 ---- #ifdef GGC GGCcreateMemoryBoard(); #endif + #ifdef AMIGA + /* We turn off buffering on stderr so we get reports when we want them */ + setnbf(stderr) ; + setvbuf(stdout, NULL, _IOLBF, BUFSIZ) ; + #endif if (heapfilename == NULL) { sc_newheap(); return; } + #ifdef AMIGA + fprintf( stderr, "***** Heap save/restore not supported on the Amiga\n" ); + #else /* Saved heap exists, open it and validate the header */ heapfile = open( heapfilename, O_RDONLY ); if (heapfile == -1) { *************** *** 617,622 **** --- 671,685 ---- sc_gcinfo, scheap, sclimit ); sc_limit = sclimit; sc_heappages = scheap*(ONEMB/PAGEBYTES); + #ifdef AMIGA + /* Allocate the contiguous chunk of memory that everything else comes from */ + amiga_heap_size = scheap*ONEMB + 16*sc_heappages + 2*PAGEBYTES - 32 ; + if ( ! ( amiga_heap = (char *) malloc( amiga_heap_size ) ) ) { + fprintf( stderr, "***** Memory allocation failed: malloc( %d )\n", + amiga_heap_size ) ; + exit( 1 ); + } + #endif sc_allocatedheappages = save.allocatedheappages; freebase = getmem( scheap*ONEMB+PAGEBYTES-1 ); if ((int)freebase & (PAGEBYTES-1)) *************** *** 724,729 **** --- 787,793 ---- (*mainproc)( sc_clarguments( argc, argv ) ); else return; + #endif AMIGA SCHEMEEXIT(); } *************** *** 797,802 **** --- 861,869 ---- #ifdef SUN3 sc_cstringtostring( "Sun3" ), #endif + #ifdef AMIGA + sc_cstringtostring( "Amiga" ), + #endif #ifdef I386 sc_cstringtostring( "AT/386" ), #endif *************** *** 823,828 **** --- 890,910 ---- #ifdef SUN3 sc_cstringtostring( "68K" ), #endif + #ifdef AMIGA + #ifdef MC68030 /* A kludge... */ + sc_cstringtostring( "MC68030/68881" ), + #else + #ifdef MC68020 + sc_cstringtostring( "MC68020/68881" ), + #else + #ifdef MC68010 + sc_cstringtostring( "MC68010" ), + #else + sc_cstringtostring( "MC68000" ), + #endif /* MC68010 */ + #endif /* MC68020 */ + #endif /* MC68030 */ + #endif /* AMIGA */ #ifdef I386 sc_cstringtostring( "Intel 386" ), #endif *************** *** 843,849 **** --- 925,935 ---- #ifdef SYSV sc_cstringtostring( "System V.3.2" ), #else + #ifdef AMIGA + sc_cstringtostring( "AmigaDOS" ), + #else sc_cstringtostring( "ULTRIX" ), + #endif /* AMIGA */ #endif /* SYSV */ #endif /* SUN3 */ #endif /* SPARC */ diff -r -c -N ../orig/scrt/scrt2.c ./scrt/scrt2.c *** ../orig/scrt/scrt2.c Fri Sep 21 13:36:48 1990 --- ./scrt/scrt2.c Mon Oct 7 20:36:48 1991 *************** *** 59,65 **** DEFSTATICTSCP2( c2416, t3371 ); DEFSTRING( t3372, "SQRT", 4 ); DEFSTATICTSCP( c2415 ); ! DEFFLOAT( t3373, .5 ); DEFSTATICTSCP2( c2357, t3373 ); DEFSTRING( t3374, "/", 1 ); DEFSTATICTSCP( c1866 ); --- 59,65 ---- DEFSTATICTSCP2( c2416, t3371 ); DEFSTRING( t3372, "SQRT", 4 ); DEFSTATICTSCP( c2415 ); ! DEFFLOAT( t3373, 0.5 ); DEFSTATICTSCP2( c2357, t3373 ); DEFSTRING( t3374, "/", 1 ); DEFSTATICTSCP( c1866 ); *************** *** 440,448 **** scrt6_error( c1172, c1173, CONS( x1167, EMPTYLIST ) ); L3498: ! X1 = BOOLEAN( LT( FLOAT_VALUE( x1167 ), -536870912.1 ) ); if ( TRUE( X1 ) ) goto L3504; ! if ( LTE( FLOAT_VALUE( x1167 ), 536870911.1 ) ) goto L3507; L3504: scrt6_error( c1172, c1178, CONS( x1167, EMPTYLIST ) ); --- 440,450 ---- scrt6_error( c1172, c1173, CONS( x1167, EMPTYLIST ) ); L3498: ! X1 = BOOLEAN( LT( FLOAT_VALUE( x1167 ), ! -536870912.1000000226 ) ); if ( TRUE( X1 ) ) goto L3504; ! if ( LTE( FLOAT_VALUE( x1167 ), 536870911.1000000231 ) ! ) goto L3507; L3504: scrt6_error( c1172, c1178, CONS( x1167, EMPTYLIST ) ); *************** *** 2219,2227 **** EQ( TSCP_EXTENDEDTAG( X3 ), FLOATTAG ) ) ) goto L4319; scrt6_error( c1172, c1173, CONS( X3, EMPTYLIST ) ); L4319: ! X4 = BOOLEAN( LT( FLOAT_VALUE( X3 ), -536870912.1 ) ); if ( TRUE( X4 ) ) goto L4325; ! if ( LTE( FLOAT_VALUE( X3 ), 536870911.1 ) ) goto L4328; L4325: scrt6_error( c1172, c1178, CONS( X3, EMPTYLIST ) ); L4328: --- 2221,2230 ---- EQ( TSCP_EXTENDEDTAG( X3 ), FLOATTAG ) ) ) goto L4319; scrt6_error( c1172, c1173, CONS( X3, EMPTYLIST ) ); L4319: ! X4 = BOOLEAN( LT( FLOAT_VALUE( X3 ), ! -536870912.1000000226 ) ); if ( TRUE( X4 ) ) goto L4325; ! if ( LTE( FLOAT_VALUE( X3 ), 536870911.1000000231 ) ) goto L4328; L4325: scrt6_error( c1172, c1178, CONS( X3, EMPTYLIST ) ); L4328: *************** *** 2301,2309 **** EQ( TSCP_EXTENDEDTAG( X2 ), FLOATTAG ) ) ) goto L4373; scrt6_error( c1172, c1173, CONS( X2, EMPTYLIST ) ); L4373: ! X3 = BOOLEAN( LT( FLOAT_VALUE( X2 ), -536870912.1 ) ); if ( TRUE( X3 ) ) goto L4379; ! if ( LTE( FLOAT_VALUE( X2 ), 536870911.1 ) ) goto L4382; L4379: scrt6_error( c1172, c1178, CONS( X2, EMPTYLIST ) ); L4382: --- 2304,2313 ---- EQ( TSCP_EXTENDEDTAG( X2 ), FLOATTAG ) ) ) goto L4373; scrt6_error( c1172, c1173, CONS( X2, EMPTYLIST ) ); L4373: ! X3 = BOOLEAN( LT( FLOAT_VALUE( X2 ), ! -536870912.1000000226 ) ); if ( TRUE( X3 ) ) goto L4379; ! if ( LTE( FLOAT_VALUE( X2 ), 536870911.1000000231 ) ) goto L4382; L4379: scrt6_error( c1172, c1178, CONS( X2, EMPTYLIST ) ); L4382: *************** *** 2345,2353 **** if ( NOT( AND( EQ( TSCPTAG( x2529 ), EXTENDEDTAG ), EQ( TSCP_EXTENDEDTAG( x2529 ), FLOATTAG ) ) ) ) goto L4394; ! X1 = BOOLEAN( LT( FLOAT_VALUE( x2529 ), -536870912.1 ) ); if ( TRUE( X1 ) ) goto L4401; ! if ( LTE( FLOAT_VALUE( x2529 ), 536870911.1 ) ) goto L4404; L4401: scrt6_error( c1172, c1178, CONS( x2529, EMPTYLIST ) ); --- 2349,2359 ---- if ( NOT( AND( EQ( TSCPTAG( x2529 ), EXTENDEDTAG ), EQ( TSCP_EXTENDEDTAG( x2529 ), FLOATTAG ) ) ) ) goto L4394; ! X1 = BOOLEAN( LT( FLOAT_VALUE( x2529 ), ! -536870912.1000000226 ) ); if ( TRUE( X1 ) ) goto L4401; ! if ( LTE( FLOAT_VALUE( x2529 ), 536870911.1000000231 ) ! ) goto L4404; L4401: scrt6_error( c1172, c1178, CONS( x2529, EMPTYLIST ) ); diff -r -c -N ../orig/scrt/scrt7.c ./scrt/scrt7.c *** ../orig/scrt/scrt7.c Fri Sep 21 13:39:25 1990 --- ./scrt/scrt7.c Mon Oct 7 20:48:04 1991 *************** *** 95,101 **** DEFSTATICTSCP2( c1852, t3007 ); DEFSTRING( t3008, "Illegal floating point number: ~a", 33 ); DEFSTATICTSCP2( c1841, t3008 ); ! DEFSTRING( t3009, "%F)%d", 5 ); DEFSTATICTSCP2( c1840, t3009 ); DEFSTRING( t3010, "Floating point numbers must be base 10: ~a", 42 ); --- 95,101 ---- DEFSTATICTSCP2( c1852, t3007 ); DEFSTRING( t3008, "Illegal floating point number: ~a", 33 ); DEFSTATICTSCP2( c1841, t3008 ); ! DEFSTRING( t3009, "%f)%d", 5 ); DEFSTATICTSCP2( c1840, t3009 ); DEFSTRING( t3010, "Floating point numbers must be base 10: ~a", 42 ); *************** *** 108,116 **** DEFSTATICTSCP2( c1819, t3013 ); DEFSTRING( t3014, "FLOAT->FIXED", 12 ); DEFSTATICTSCP( c1818 ); ! DEFFLOAT( t3015, 536870911.1 ); DEFSTATICTSCP2( c1813, t3015 ); ! DEFFLOAT( t3016, -536870912.1 ); DEFSTATICTSCP2( c1805, t3016 ); DEFSTRING( t3017, ")0", 2 ); DEFSTATICTSCP2( c1790, t3017 ); --- 108,116 ---- DEFSTATICTSCP2( c1819, t3013 ); DEFSTRING( t3014, "FLOAT->FIXED", 12 ); DEFSTATICTSCP( c1818 ); ! DEFFLOAT( t3015, 536870911.1000000231 ); DEFSTATICTSCP2( c1813, t3015 ); ! DEFFLOAT( t3016, -536870912.1000000226 ); DEFSTATICTSCP2( c1805, t3016 ); DEFSTRING( t3017, ")0", 2 ); DEFSTATICTSCP2( c1790, t3017 ); *************** *** 1459,1467 **** EQ( TSCP_EXTENDEDTAG( X1 ), FLOATTAG ) ) ) goto L3618; scrt6_error( c1818, c1819, CONS( X1, EMPTYLIST ) ); L3618: ! X2 = BOOLEAN( LT( FLOAT_VALUE( X1 ), -536870912.1 ) ); if ( TRUE( X2 ) ) goto L3624; ! if ( LTE( FLOAT_VALUE( X1 ), 536870911.1 ) ) goto L3627; L3624: scrt6_error( c1818, c1824, CONS( X1, EMPTYLIST ) ); L3627: --- 1459,1468 ---- EQ( TSCP_EXTENDEDTAG( X1 ), FLOATTAG ) ) ) goto L3618; scrt6_error( c1818, c1819, CONS( X1, EMPTYLIST ) ); L3618: ! X2 = BOOLEAN( LT( FLOAT_VALUE( X1 ), ! -536870912.1000000226 ) ); if ( TRUE( X2 ) ) goto L3624; ! if ( LTE( FLOAT_VALUE( X1 ), 536870911.1000000231 ) ) goto L3627; L3624: scrt6_error( c1818, c1824, CONS( X1, EMPTYLIST ) ); L3627: diff -r -c -N ../orig/scrt/scrt7.sc ./scrt/scrt7.sc *** ../orig/scrt/scrt7.sc Fri Sep 21 13:00:12 1990 --- ./scrt/scrt7.sc Mon Oct 7 14:31:57 1991 *************** *** 272,278 **** (if (not (eq? base 10)) (error 'READ "Floating point numbers must be base 10: ~a" cl)) ! (if (eq? 2 (sscanf cs "%F)%d" result pad)) (c-double-ref result 0) (error 'READ "Illegal floating point number: ~a" cl))) ((eq? iv -1) --- 272,278 ---- (if (not (eq? base 10)) (error 'READ "Floating point numbers must be base 10: ~a" cl)) ! (if (eq? 2 (sscanf cs "%f)%d" result pad)) (c-double-ref result 0) (error 'READ "Illegal floating point number: ~a" cl))) ((eq? iv -1) diff -r -c -N ../orig/scrt/signal.c ./scrt/signal.c *** ../orig/scrt/signal.c Tue Oct 8 12:30:35 1991 --- ./scrt/signal.c Mon Oct 7 14:32:00 1991 *************** *** 48,54 **** --- 48,63 ---- #include "heap.h" #include "apply.h" #include "signal.h" + #ifndef AMIGA #include "/usr/include/signal.h" + #else + #include "include:signal.h" + #include + #include + #include + #include + #endif + #ifdef apollo #include #endif *************** *** 121,131 **** } else { /* Signal must be defered */ #ifdef SYSV sighold( signal ); #else sigblock( 1< + int matherr(struct exception *x) { + + switch (x->type) { + case DOMAIN: + sc_error("????? (Math Error)", "Domain", 0) ; + break ; + case SING: + sc_error("????? (Math Error)", "Singularity", 0) ; + break ; + case OVERFLOW: + sc_error("????? (Math Error)", "Overflow", 0) ; + break ; + case UNDERFLOW: + sc_error("????? (Math Error)", "Underflow", 0) ; + break ; + case TLOSS: /* Totla/Partial loss of precision */ + case PLOSS: + sc_error("???? (Math Error)", "Loss of precision", 0) ; + /* Just return "use this value" for now */ + break ; + } + return (0) ; + } + #endif diff -r -c -N ../orig/scrt/varargs.h ./scrt/varargs.h *** ../orig/scrt/varargs.h --- ./scrt/varargs.h Mon Oct 7 18:09:27 1991 *************** *** 0 **** --- 1,10 ---- + /* + * Varargs, for use on AmigaDOS with the Lattice C compiler, or (maybe?) the + * Manx compiler with 32-bit ints. Blatantly lifted from 4.2BSD. + */ + + typedef char *va_list; + #define va_dcl int va_alist; + #define va_start(pv) pv = (char *) &va_alist + #define va_end(pv) /* Naught to do... */ + #define va_arg(pv, t) ((t *) (pv += sizeof(t)))[-1] diff -r -c -N ../orig/scsc/SASCOPTS ./scsc/SASCOPTS *** ../orig/scsc/SASCOPTS --- ./scsc/SASCOPTS Mon Oct 7 19:51:40 1991 *************** *** 0 **** --- 1,18 ---- + -b0 + -r0 + -f8 -Lm + -m3 + -cs + -cu + -i/scrt + -dMC68030 + -dMATHTRAPS=0 + -j93i + -j85i + -j132i + -j84i + -j88i + -mt + -Ln + -L+/scrt/sc.lib + -PXscc diff -r -c -N ../orig/scsc/fromc ./scsc/fromc *** ../orig/scsc/fromc --- ./scsc/fromc Mon Oct 7 19:20:06 1991 *************** *** 0 **** --- 1,18 ---- + ;; ===build instructions + lc -O -. callcode ; output= callcode.o input= callcode.c /scrt/objects.h + lc -O -. closeana ; output= closeana.o input= closeana.c /scrt/objects.h + lc -O -. compile ; output= compile.o input= compile.c /scrt/objects.h + lc -O -. expform ; output= expform.o input= expform.c /scrt/objects.h + lc -O -. gencode ; output= gencode.o input= gencode.c /scrt/objects.h + lc -O -. lambdacode ; output= lambdacode.o input= lambdacode.c /scrt/objects.h + lc -O -. lambdaexp ; output= lambdaexp.o input= lambdaexp.c /scrt/objects.h + lc -. lap ; output= lap.o input= lap.c /scrt/objects.h + lc -O -. macros ; output= macros.o input= macros.c /scrt/objects.h + lc -O -. main ; output= main.o input= main.c /scrt/objects.h + lc -O -. misccode ; output= misccode.o input= misccode.c /scrt/objects.h + lc -O -. miscexp ; output= miscexp.o input= miscexp.c /scrt/objects.h + lc -O -. plist ; output= plist.o input= plist.c /scrt/objects.h + lc -O -. readtext ; output= readtext.o input= readtext.c /scrt/objects.h + lc -O -. transform ; output= transform.o input= transform.c /scrt/objects.h + lc -O -. -M -L+/scrt/sc.lib callcode closeana compile expform gencode lambdacode lambdaexp lap macros main misccode miscexp plist readtext transform ; output= scc input= callcode.o closeana.o compile.o expform.o gencode.o lambdacode.o lambdaexp.o lap.o macros.o main.o misccode.o miscexp.o plist.o readtext.o transform.o /scrt/sc.lib + ;; ===endbuild diff -r -c -N ../orig/scsc/fromsc ./scsc/fromsc *** ../orig/scsc/fromsc --- ./scsc/fromsc Mon Oct 7 18:10:19 1991 *************** *** 0 **** --- 1,18 ---- + ;; ===build instructions + scc -C callcode.sc ; output= callcode.c input= callcode.sc plist.sch expform.sch lambdaexp.sch miscexp.sch gencode.sch lap.sch + scc -C closeana.sc ; output= closeana.c input= closeana.sc plist.sch expform.sch lambdaexp.sch miscexp.sch + scc -C compile.sc ; output= compile.c input= compile.sc plist.sch expform.sch lambdaexp.sch miscexp.sch + scc -C expform.sc ; output= expform.c input= expform.sc plist.sch expform.sch lambdaexp.sch + scc -C gencode.sc ; output= gencode.c input= gencode.sc plist.sch expform.sch lambdaexp.sch miscexp.sch lap.sch + scc -C lambdacode.sc ; output= lambdacode.c input= lambdacode.sc plist.sch expform.sch lambdaexp.sch miscexp.sch gencode.sch lap.sch + scc -C lambdaexp.sc ; output= lambdaexp.c input= lambdaexp.sc plist.sch lambdaexp.sch + scc -C lap.sc ; output= lap.c input= lap.sc + scc -C macros.sc ; output= macros.c input= macros.sc + scc -C main.sc ; output= main.c input= main.sc + scc -C misccode.sc ; output= misccode.c input= misccode.sc plist.sch expform.sch lambdaexp.sch miscexp.sch gencode.sch lap.sch + scc -C miscexp.sc ; output= miscexp.c input= miscexp.sc plist.sch miscexp.sch + scc -C plist.sc ; output= plist.c input= plist.sc + scc -C readtext.sc ; output= readtext.c input= readtext.sc plist.sch expform.sch + scc -C transform.sc ; output= transform.c input= transform.sc plist.sch expform.sch lambdaexp.sch miscexp.sch + build fromc + ;; ===endbuild diff -r -c -N ../orig/scsc/main.c ./scsc/main.c *** ../orig/scsc/main.c Fri Sep 21 13:47:49 1990 --- ./scsc/main.c Mon Oct 7 21:38:29 1991 *************** *** 3,328 **** #include ! DEFSTRING( t1612, "INITIALIZE-COMPILE", 18 ); DEFSTATICTSCP( initialize_2dcompile_v ); ! DEFSTRING( t1613, "SC-LOG-DEFAULT", 14 ); DEFSTATICTSCP( sc_2dlog_2ddefault_v ); ! DEFSTRING( t1614, "DO-DEFINE-CONSTANT", 18 ); DEFSTATICTSCP( do_2ddefine_2dconstant_v ); ! DEFSTRING( t1615, "SC-INCLUDE-DIRS", 15 ); DEFSTATICTSCP( sc_2dinclude_2ddirs_v ); ! DEFSTRING( t1616, "SC-INPUT", 8 ); DEFSTATICTSCP( sc_2dinput_v ); ! DEFSTRING( t1617, "SC-SOURCE-NAME", 14 ); DEFSTATICTSCP( sc_2dsource_2dname_v ); ! DEFSTRING( t1618, "SC-ICODE", 8 ); DEFSTATICTSCP( sc_2dicode_v ); ! DEFSTRING( t1619, "SC-ERROR", 8 ); DEFSTATICTSCP( sc_2derror_v ); ! DEFSTRING( t1620, "SC-LOG", 6 ); DEFSTATICTSCP( sc_2dlog_v ); ! DEFSTRING( t1621, "SC-STACK-TRACE", 14 ); DEFSTATICTSCP( sc_2dstack_2dtrace_v ); ! DEFSTRING( t1622, "SC-INTERPRETER", 14 ); DEFSTATICTSCP( sc_2dinterpreter_v ); ! DEFSTRING( t1623, "DOCOMPILE", 9 ); DEFSTATICTSCP( docompile_v ); ! DEFSTRING( t1624, "SC-ERROR-CNT", 12 ); DEFSTATICTSCP( sc_2derror_2dcnt_v ); ! DEFSTRING( t1625, "MODULE-NAME", 11 ); DEFSTATICTSCP( module_2dname_v ); ! DEFSTRING( t1626, "CLOSE-SC-FILES", 14 ); DEFSTATICTSCP( close_2dsc_2dfiles_v ); ! DEFSTRING( t1627, ".c", 2 ); ! DEFSTATICTSCP2( c1535, t1627 ); ! DEFSTRING( t1628, "~a:~%", 5 ); ! DEFSTATICTSCP2( c1487, t1628 ); ! DEFSTRING( t1629, ".sc", 3 ); ! DEFSTATICTSCP2( c1485, t1629 ); ! DEFSTRING( t1630, "cc", 2 ); ! DEFSTATICTSCP2( c1456, t1630 ); ! DEFSTRING( t1631, " -I", 3 ); ! DEFSTATICTSCP2( c1415, t1631 ); ! DEFSTRING( t1632, " -D", 3 ); ! DEFSTATICTSCP2( c1414, t1632 ); ! DEFSTRING( t1633, "}~%", 3 ); ! DEFSTATICTSCP2( c1408, t1633 ); ! DEFSTRING( t1634, " SCHEMEEXIT();~%", 18 ); ! DEFSTATICTSCP2( c1407, t1634 ); ! DEFSTRING( t1635, " screp_read_2deval_2dprint( sc_clarguments( argc, argv ) );~%", 63 ); ! DEFSTATICTSCP2( c1406, t1635 ); ! DEFSTRING( t1636, "screp", 5 ); ! DEFSTATICTSCP2( c1405, t1636 ); ! DEFSTRING( t1637, " ~a__init();~%", 16 ); ! DEFSTATICTSCP2( c1404, t1637 ); ! DEFSTRING( t1638, "Argument not a PAIR: ~s", 23 ); ! DEFSTATICTSCP2( c1393, t1638 ); ! DEFSTRING( t1639, "SET-CDR!", 8 ); ! DEFSTATICTSCP( c1392 ); ! DEFSTRING( t1640, " INITHEAP( 0, argc, argv, screp_read_2deval_2dprint );~%", 58 ); ! DEFSTATICTSCP2( c1361, t1640 ); ! DEFSTRING( t1641, "main( argc, argv )~%{~%", 23 ); ! DEFSTATICTSCP2( c1360, t1641 ); ! DEFSTRING( t1642, "extern TSCP screp_read_2deval_2dprint();~%", 42 ); ! DEFSTATICTSCP2( c1359, t1642 ); ! DEFSTRING( t1643, "#include \"~a/~a\"~%", 18 ); ! DEFSTATICTSCP2( c1358, t1643 ); ! DEFSTRING( t1644, ")", 1 ); ! DEFSTATICTSCP2( c1344, t1644 ); ! DEFSTRING( t1645, " ", 1 ); ! DEFSTATICTSCP2( c1343, t1645 ); ! DEFSTRING( t1646, "(define-constant ", 17 ); ! DEFSTATICTSCP2( c1332, t1646 ); ! DEFSTRING( t1647, "/", 1 ); ! DEFSTATICTSCP2( c1315, t1647 ); ! DEFSTATICTSCP( c1274 ); ! DEFSTRING( t1649, "PEEP", 4 ); ! DEFSTATICTSCP( t1648 ); ! DEFSTRING( t1651, "-peep", 5 ); ! DEFSTATICTSCP2( t1650, t1651 ); ! DEFSTRING( t1653, "LAP", 3 ); ! DEFSTATICTSCP( t1652 ); ! DEFSTRING( t1655, "-lap", 4 ); ! DEFSTATICTSCP2( t1654, t1655 ); ! DEFSTRING( t1657, "TREE", 4 ); ! DEFSTATICTSCP( t1656 ); ! DEFSTRING( t1659, "-tree", 5 ); ! DEFSTATICTSCP2( t1658, t1659 ); ! DEFSTRING( t1661, "LAMBDA", 6 ); ! DEFSTATICTSCP( t1660 ); ! DEFSTRING( t1663, "-lambda", 7 ); ! DEFSTATICTSCP2( t1662, t1663 ); ! DEFSTRING( t1665, "TRANSFORM", 9 ); ! DEFSTATICTSCP( t1664 ); ! DEFSTRING( t1667, "-transform", 10 ); ! DEFSTATICTSCP2( t1666, t1667 ); ! DEFSTRING( t1669, "CLOSED", 6 ); ! DEFSTATICTSCP( t1668 ); ! DEFSTRING( t1671, "-closed", 7 ); ! DEFSTATICTSCP2( t1670, t1671 ); ! DEFSTRING( t1673, "EXPAND", 6 ); ! DEFSTATICTSCP( t1672 ); ! DEFSTRING( t1675, "-expand", 7 ); ! DEFSTATICTSCP2( t1674, t1675 ); ! DEFSTRING( t1677, "MACRO", 5 ); ! DEFSTATICTSCP( t1676 ); ! DEFSTRING( t1679, "-macro", 6 ); ! DEFSTATICTSCP2( t1678, t1679 ); ! DEFSTRING( t1681, "SOURCE", 6 ); ! DEFSTATICTSCP( t1680 ); ! DEFSTRING( t1683, "-source", 7 ); ! DEFSTATICTSCP2( t1682, t1683 ); ! DEFSTRING( t1684, "(define-constant *type-check* #f)", 33 ); ! DEFSTATICTSCP2( c1259, t1684 ); ! DEFSTRING( t1685, "(define-constant *bounds-check* #f)", 35 ); ! DEFSTATICTSCP2( c1253, t1685 ); ! DEFSTRING( t1686, "(define-constant *fixed-only* #t)", 33 ); ! DEFSTATICTSCP2( c1242, t1686 ); ! DEFSTRING( t1687, "-lm", 3 ); ! DEFSTATICTSCP2( c1236, t1687 ); ! DEFSTRING( t1688, "-cc", 3 ); ! DEFSTATICTSCP2( c1197, t1688 ); ! DEFSTRING( t1689, "-C", 2 ); ! DEFSTATICTSCP2( c1193, t1689 ); ! DEFSTRING( t1690, "-pg", 3 ); ! DEFSTATICTSCP2( c1192, t1690 ); ! DEFSTRING( t1691, "-On", 3 ); ! DEFSTATICTSCP2( c1191, t1691 ); ! DEFSTRING( t1692, "-Og", 3 ); ! DEFSTATICTSCP2( c1190, t1692 ); ! DEFSTRING( t1693, "-Ob", 3 ); ! DEFSTATICTSCP2( c1189, t1693 ); ! DEFSTRING( t1694, "-Ot", 3 ); ! DEFSTATICTSCP2( c1188, t1694 ); ! DEFSTRING( t1695, "-log", 4 ); ! DEFSTATICTSCP2( c1185, t1695 ); ! DEFSTRING( t1696, "-m", 2 ); ! DEFSTATICTSCP2( c1179, t1696 ); ! DEFSTRING( t1697, "-I", 2 ); ! DEFSTATICTSCP2( c1170, t1697 ); ! DEFSTRING( t1698, "-i", 2 ); ! DEFSTATICTSCP2( c1166, t1698 ); ! DEFSTRING( t1699, "-f", 2 ); ! DEFSTATICTSCP2( c1146, t1699 ); ! DEFSTATICTSCP( c1125 ); ! DEFSTRING( t1700, ! "c-include filename must include directory path: ~s", 50 ); ! DEFSTATICTSCP2( c1105, t1700 ); ! DEFSTRING( t1701, "CONFIGURE", 9 ); ! DEFSTATICTSCP( c1104 ); ! DEFSTRING( t1702, "Argument is out of range: ~s", 28 ); ! DEFSTATICTSCP2( c1089, t1702 ); ! DEFSTRING( t1703, "Argument is not a STRING: ~s", 28 ); ! DEFSTATICTSCP2( c1088, t1703 ); ! DEFSTRING( t1704, "STRING-LENGTH", 13 ); ! DEFSTATICTSCP( c1087 ); ! DEFSTRING( t1705, "Argument is not an INTEGER: ~s", 30 ); ! DEFSTATICTSCP2( c1066, t1705 ); ! DEFSTRING( t1706, "STRING-REF", 10 ); ! DEFSTATICTSCP( c1065 ); ! DEFSTRING( t1707, ! "sccomp ", ! 66 ); ! DEFSTATICTSCP2( c1044, t1707 ); ! DEFSTRING( t1708, "TITAN", 5 ); ! DEFSTATICTSCP2( c1029, t1708 ); ! DEFSTRING( t1709, "/udir/bartlett/scheme/scrt/libsc.a", 34 ); ! DEFSTATICTSCP2( c1026, t1709 ); ! DEFSTRING( t1710, "/udir/bartlett/scheme/scrt", 26 ); ! DEFSTATICTSCP2( c1024, t1710 ); ! DEFSTRING( t1711, "objects.h", 9 ); ! DEFSTATICTSCP2( c1022, t1711 ); ! DEFSTRING( t1712, "/udir/bartlett/scheme/scrt/predef.sc", 36 ); ! DEFSTATICTSCP2( c1020, t1712 ); ! DEFSTRING( t1713, "SC-TO-C~s.o", 11 ); ! DEFSTATICTSCP2( c1018, t1713 ); ! DEFSTRING( t1714, "SC-TO-C~s.c", 11 ); ! DEFSTATICTSCP2( c1016, t1714 ); ! DEFSTRING( t1715, "28sep90jfb", 10 ); ! DEFSTATICTSCP2( c1013, t1715 ); static void init_constants() { TSCP X1; ! initialize_2dcompile_v = STRINGTOSYMBOL( U_TX( ADR( t1612 ) ) ); CONSTANTEXP( ADR( initialize_2dcompile_v ) ); ! sc_2dlog_2ddefault_v = STRINGTOSYMBOL( U_TX( ADR( t1613 ) ) ); CONSTANTEXP( ADR( sc_2dlog_2ddefault_v ) ); ! do_2ddefine_2dconstant_v = STRINGTOSYMBOL( U_TX( ADR( t1614 ) ) ); CONSTANTEXP( ADR( do_2ddefine_2dconstant_v ) ); ! sc_2dinclude_2ddirs_v = STRINGTOSYMBOL( U_TX( ADR( t1615 ) ) ); CONSTANTEXP( ADR( sc_2dinclude_2ddirs_v ) ); ! sc_2dinput_v = STRINGTOSYMBOL( U_TX( ADR( t1616 ) ) ); CONSTANTEXP( ADR( sc_2dinput_v ) ); ! sc_2dsource_2dname_v = STRINGTOSYMBOL( U_TX( ADR( t1617 ) ) ); CONSTANTEXP( ADR( sc_2dsource_2dname_v ) ); ! sc_2dicode_v = STRINGTOSYMBOL( U_TX( ADR( t1618 ) ) ); CONSTANTEXP( ADR( sc_2dicode_v ) ); ! sc_2derror_v = STRINGTOSYMBOL( U_TX( ADR( t1619 ) ) ); CONSTANTEXP( ADR( sc_2derror_v ) ); ! sc_2dlog_v = STRINGTOSYMBOL( U_TX( ADR( t1620 ) ) ); CONSTANTEXP( ADR( sc_2dlog_v ) ); ! sc_2dstack_2dtrace_v = STRINGTOSYMBOL( U_TX( ADR( t1621 ) ) ); CONSTANTEXP( ADR( sc_2dstack_2dtrace_v ) ); ! sc_2dinterpreter_v = STRINGTOSYMBOL( U_TX( ADR( t1622 ) ) ); CONSTANTEXP( ADR( sc_2dinterpreter_v ) ); ! docompile_v = STRINGTOSYMBOL( U_TX( ADR( t1623 ) ) ); CONSTANTEXP( ADR( docompile_v ) ); ! sc_2derror_2dcnt_v = STRINGTOSYMBOL( U_TX( ADR( t1624 ) ) ); CONSTANTEXP( ADR( sc_2derror_2dcnt_v ) ); ! module_2dname_v = STRINGTOSYMBOL( U_TX( ADR( t1625 ) ) ); CONSTANTEXP( ADR( module_2dname_v ) ); ! close_2dsc_2dfiles_v = STRINGTOSYMBOL( U_TX( ADR( t1626 ) ) ); CONSTANTEXP( ADR( close_2dsc_2dfiles_v ) ); ! c1392 = STRINGTOSYMBOL( U_TX( ADR( t1639 ) ) ); ! CONSTANTEXP( ADR( c1392 ) ); ! c1274 = EMPTYLIST; ! t1648 = STRINGTOSYMBOL( U_TX( ADR( t1649 ) ) ); ! X1 = t1648; ! X1 = CONS( t1650, X1 ); ! c1274 = CONS( X1, c1274 ); ! t1652 = STRINGTOSYMBOL( U_TX( ADR( t1653 ) ) ); ! X1 = t1652; ! X1 = CONS( t1654, X1 ); ! c1274 = CONS( X1, c1274 ); ! t1656 = STRINGTOSYMBOL( U_TX( ADR( t1657 ) ) ); ! X1 = t1656; ! X1 = CONS( t1658, X1 ); ! c1274 = CONS( X1, c1274 ); ! t1660 = STRINGTOSYMBOL( U_TX( ADR( t1661 ) ) ); ! X1 = t1660; ! X1 = CONS( t1662, X1 ); ! c1274 = CONS( X1, c1274 ); ! t1664 = STRINGTOSYMBOL( U_TX( ADR( t1665 ) ) ); ! X1 = t1664; ! X1 = CONS( t1666, X1 ); ! c1274 = CONS( X1, c1274 ); ! t1668 = STRINGTOSYMBOL( U_TX( ADR( t1669 ) ) ); ! X1 = t1668; ! X1 = CONS( t1670, X1 ); ! c1274 = CONS( X1, c1274 ); ! t1672 = STRINGTOSYMBOL( U_TX( ADR( t1673 ) ) ); ! X1 = t1672; ! X1 = CONS( t1674, X1 ); ! c1274 = CONS( X1, c1274 ); ! t1676 = STRINGTOSYMBOL( U_TX( ADR( t1677 ) ) ); ! X1 = t1676; ! X1 = CONS( t1678, X1 ); ! c1274 = CONS( X1, c1274 ); ! t1680 = STRINGTOSYMBOL( U_TX( ADR( t1681 ) ) ); ! X1 = t1680; ! X1 = CONS( t1682, X1 ); ! c1274 = CONS( X1, c1274 ); ! CONSTANTEXP( ADR( c1274 ) ); ! c1125 = EMPTYLIST; ! c1125 = CONS( EMPTYSTRING, c1125 ); ! CONSTANTEXP( ADR( c1125 ) ); ! c1104 = STRINGTOSYMBOL( U_TX( ADR( t1701 ) ) ); ! CONSTANTEXP( ADR( c1104 ) ); ! c1087 = STRINGTOSYMBOL( U_TX( ADR( t1704 ) ) ); ! CONSTANTEXP( ADR( c1087 ) ); ! c1065 = STRINGTOSYMBOL( U_TX( ADR( t1706 ) ) ); ! CONSTANTEXP( ADR( c1065 ) ); } DEFTSCP( main_scc_2dversion_v ); ! DEFSTRING( t1716, "SCC-VERSION", 11 ); DEFTSCP( main_force_2dld_2dof_2drep_v ); ! DEFSTRING( t1717, "FORCE-LD-OF-REP", 15 ); EXTERNTSCPP( screp_read_2deval_2dprint ); EXTERNTSCP( screp_read_2deval_2dprint_v ); DEFTSCP( main_sc_2dto_2dc_2ec_v ); ! DEFSTRING( t1718, "SC-TO-C.C", 9 ); DEFTSCP( main_sc_2dto_2dc_2eo_v ); ! DEFSTRING( t1719, "SC-TO-C.O", 9 ); DEFTSCP( main_predef_2ddefault_v ); ! DEFSTRING( t1720, "PREDEF-DEFAULT", 14 ); DEFTSCP( main_c_2dinclude_2dfile_v ); ! DEFSTRING( t1721, "C-INCLUDE-FILE", 14 ); DEFTSCP( main_c_2dinclude_2ddir_v ); ! DEFSTRING( t1722, "C-INCLUDE-DIR", 13 ); DEFTSCP( main_sc_2dlibrary_v ); ! DEFSTRING( t1723, "SC-LIBRARY", 10 ); DEFTSCP( main_sc_2dlibrary__p_v ); ! DEFSTRING( t1724, "SC-LIBRARY_P", 12 ); DEFTSCP( main_sc_2dprocessor_v ); ! DEFSTRING( t1725, "SC-PROCESSOR", 12 ); DEFTSCP( main_configure_v ); ! DEFSTRING( t1726, "CONFIGURE", 9 ); ! EXTERNTSCPP( scrt1_length ); ! EXTERNTSCP( scrt1_length_v ); ! EXTERNTSCPP( scrt2__3d_2dtwo ); ! EXTERNTSCP( scrt2__3d_2dtwo_v ); ! EXTERNTSCPP( scrt6_display ); ! EXTERNTSCP( scrt6_display_v ); ! EXTERNTSCPP( scrt6_newline ); ! EXTERNTSCP( scrt6_newline_v ); ! EXTERNTSCP( scrt6_exit_v ); ! EXTERNTSCPP( scrt1_list_2dref ); ! EXTERNTSCP( scrt1_list_2dref_v ); ! EXTERNTSCPP( scrt6_error ); ! EXTERNTSCP( scrt6_error_v ); ! EXTERNTSCPP( scrt2__2d_2dtwo ); ! EXTERNTSCP( scrt2__2d_2dtwo_v ); ! EXTERNTSCPP( scrt2__3c_3d_2dtwo ); ! EXTERNTSCP( scrt2__3c_3d_2dtwo_v ); ! EXTERNTSCPP( scrt1_equal_3f ); ! EXTERNTSCP( scrt1_equal_3f_v ); ! EXTERNTSCPP( scrt2__3e_3d_2dtwo ); ! EXTERNTSCP( scrt2__3e_3d_2dtwo_v ); ! EXTERNTSCPP( scrt3_substring ); ! EXTERNTSCP( scrt3_substring_v ); ! EXTERNTSCPP( scrt2__2b_2dtwo ); ! EXTERNTSCP( scrt2__2b_2dtwo_v ); ! EXTERNTSCPP( sc_save_2dheap ); ! EXTERNTSCP( sc_save_2dheap_v ); EXTERNTSCPP( main_scc ); EXTERNTSCP( main_scc_v ); --- 3,282 ---- #include ! DEFSTRING( t1541, "INITIALIZE-COMPILE", 18 ); DEFSTATICTSCP( initialize_2dcompile_v ); ! DEFSTRING( t1542, "SC-LOG-DEFAULT", 14 ); DEFSTATICTSCP( sc_2dlog_2ddefault_v ); ! DEFSTRING( t1543, "DO-DEFINE-CONSTANT", 18 ); DEFSTATICTSCP( do_2ddefine_2dconstant_v ); ! DEFSTRING( t1544, "SC-INCLUDE-DIRS", 15 ); DEFSTATICTSCP( sc_2dinclude_2ddirs_v ); ! DEFSTRING( t1545, "SC-INPUT", 8 ); DEFSTATICTSCP( sc_2dinput_v ); ! DEFSTRING( t1546, "SC-SOURCE-NAME", 14 ); DEFSTATICTSCP( sc_2dsource_2dname_v ); ! DEFSTRING( t1547, "SC-ICODE", 8 ); DEFSTATICTSCP( sc_2dicode_v ); ! DEFSTRING( t1548, "SC-ERROR", 8 ); DEFSTATICTSCP( sc_2derror_v ); ! DEFSTRING( t1549, "SC-LOG", 6 ); DEFSTATICTSCP( sc_2dlog_v ); ! DEFSTRING( t1550, "SC-STACK-TRACE", 14 ); DEFSTATICTSCP( sc_2dstack_2dtrace_v ); ! DEFSTRING( t1551, "SC-INTERPRETER", 14 ); DEFSTATICTSCP( sc_2dinterpreter_v ); ! DEFSTRING( t1552, "DOCOMPILE", 9 ); DEFSTATICTSCP( docompile_v ); ! DEFSTRING( t1553, "SC-ERROR-CNT", 12 ); DEFSTATICTSCP( sc_2derror_2dcnt_v ); ! DEFSTRING( t1554, "MODULE-NAME", 11 ); DEFSTATICTSCP( module_2dname_v ); ! DEFSTRING( t1555, "CLOSE-SC-FILES", 14 ); DEFSTATICTSCP( close_2dsc_2dfiles_v ); ! DEFSTRING( t1556, "Argument is not a STRING: ~s", 28 ); ! DEFSTATICTSCP2( c1500, t1556 ); ! DEFSTRING( t1557, "STRING-LENGTH", 13 ); ! DEFSTATICTSCP( c1499 ); ! DEFSTRING( t1558, ".c", 2 ); ! DEFSTATICTSCP2( c1482, t1558 ); ! DEFSTRING( t1559, "~a:~%", 5 ); ! DEFSTATICTSCP2( c1434, t1559 ); ! DEFSTRING( t1560, ".sc", 3 ); ! DEFSTATICTSCP2( c1432, t1560 ); ! DEFSTRING( t1561, "lc", 2 ); ! DEFSTATICTSCP2( c1402, t1561 ); ! DEFSTRING( t1562, "+", 1 ); ! DEFSTATICTSCP2( c1361, t1562 ); ! DEFSTRING( t1563, " -Lm", 4 ); ! DEFSTATICTSCP2( c1320, t1563 ); ! DEFSTRING( t1564, " -i", 3 ); ! DEFSTATICTSCP2( c1319, t1564 ); ! DEFSTRING( t1565, " -csu -f8 -b0 -r0 -C -d", 23 ); ! DEFSTATICTSCP2( c1318, t1565 ); ! DEFSTRING( t1566, "}~%", 3 ); ! DEFSTATICTSCP2( c1314, t1566 ); ! DEFSTRING( t1567, " SCHEMEEXIT();~%", 18 ); ! DEFSTATICTSCP2( c1313, t1567 ); ! DEFSTRING( t1568, " screp_read_2deval_2dprint( sc_clarguments( argc, argv ) );~%", 63 ); ! DEFSTATICTSCP2( c1312, t1568 ); ! DEFSTRING( t1569, "screp", 5 ); ! DEFSTATICTSCP2( c1311, t1569 ); ! DEFSTRING( t1570, " ~a__init();~%", 16 ); ! DEFSTATICTSCP2( c1310, t1570 ); ! DEFSTRING( t1571, "Argument not a PAIR: ~s", 23 ); ! DEFSTATICTSCP2( c1299, t1571 ); ! DEFSTRING( t1572, "SET-CDR!", 8 ); ! DEFSTATICTSCP( c1298 ); ! DEFSTRING( t1573, " INITHEAP( 0, argc, argv, screp_read_2deval_2dprint );~%", 58 ); ! DEFSTATICTSCP2( c1267, t1573 ); ! DEFSTRING( t1574, "main( argc, argv )~%{~%", 23 ); ! DEFSTATICTSCP2( c1266, t1574 ); ! DEFSTRING( t1575, "extern TSCP screp_read_2deval_2dprint();~%", 42 ); ! DEFSTATICTSCP2( c1265, t1575 ); ! DEFSTRING( t1576, "#include \"~a/~a\"~%", 18 ); ! DEFSTATICTSCP2( c1264, t1576 ); ! DEFSTRING( t1577, ")", 1 ); ! DEFSTATICTSCP2( c1249, t1577 ); ! DEFSTRING( t1578, " ", 1 ); ! DEFSTATICTSCP2( c1248, t1578 ); ! DEFSTRING( t1579, "(define-constant ", 17 ); ! DEFSTATICTSCP2( c1237, t1579 ); ! DEFSTRING( t1580, "/", 1 ); ! DEFSTATICTSCP2( c1220, t1580 ); ! DEFSTATICTSCP( c1179 ); ! DEFSTRING( t1582, "PEEP", 4 ); ! DEFSTATICTSCP( t1581 ); ! DEFSTRING( t1584, "-peep", 5 ); ! DEFSTATICTSCP2( t1583, t1584 ); ! DEFSTRING( t1586, "LAP", 3 ); ! DEFSTATICTSCP( t1585 ); ! DEFSTRING( t1588, "-lap", 4 ); ! DEFSTATICTSCP2( t1587, t1588 ); ! DEFSTRING( t1590, "TREE", 4 ); ! DEFSTATICTSCP( t1589 ); ! DEFSTRING( t1592, "-tree", 5 ); ! DEFSTATICTSCP2( t1591, t1592 ); ! DEFSTRING( t1594, "LAMBDA", 6 ); ! DEFSTATICTSCP( t1593 ); ! DEFSTRING( t1596, "-lambda", 7 ); ! DEFSTATICTSCP2( t1595, t1596 ); ! DEFSTRING( t1598, "TRANSFORM", 9 ); ! DEFSTATICTSCP( t1597 ); ! DEFSTRING( t1600, "-transform", 10 ); ! DEFSTATICTSCP2( t1599, t1600 ); ! DEFSTRING( t1602, "CLOSED", 6 ); ! DEFSTATICTSCP( t1601 ); ! DEFSTRING( t1604, "-closed", 7 ); ! DEFSTATICTSCP2( t1603, t1604 ); ! DEFSTRING( t1606, "EXPAND", 6 ); ! DEFSTATICTSCP( t1605 ); ! DEFSTRING( t1608, "-expand", 7 ); ! DEFSTATICTSCP2( t1607, t1608 ); ! DEFSTRING( t1610, "MACRO", 5 ); ! DEFSTATICTSCP( t1609 ); ! DEFSTRING( t1612, "-macro", 6 ); ! DEFSTATICTSCP2( t1611, t1612 ); ! DEFSTRING( t1614, "SOURCE", 6 ); ! DEFSTATICTSCP( t1613 ); ! DEFSTRING( t1616, "-source", 7 ); ! DEFSTATICTSCP2( t1615, t1616 ); ! DEFSTRING( t1617, "(define-constant *type-check* #f)", 33 ); ! DEFSTATICTSCP2( c1164, t1617 ); ! DEFSTRING( t1618, "(define-constant *bounds-check* #f)", 35 ); ! DEFSTATICTSCP2( c1158, t1618 ); ! DEFSTRING( t1619, "(define-constant *fixed-only* #t)", 33 ); ! DEFSTATICTSCP2( c1147, t1619 ); ! DEFSTRING( t1620, "-cc", 3 ); ! DEFSTATICTSCP2( c1108, t1620 ); ! DEFSTRING( t1621, "-C", 2 ); ! DEFSTATICTSCP2( c1104, t1621 ); ! DEFSTRING( t1622, "-On", 3 ); ! DEFSTATICTSCP2( c1103, t1622 ); ! DEFSTRING( t1623, "-Og", 3 ); ! DEFSTATICTSCP2( c1102, t1623 ); ! DEFSTRING( t1624, "-Ob", 3 ); ! DEFSTATICTSCP2( c1101, t1624 ); ! DEFSTRING( t1625, "-Ot", 3 ); ! DEFSTATICTSCP2( c1100, t1625 ); ! DEFSTRING( t1626, "-log", 4 ); ! DEFSTATICTSCP2( c1097, t1626 ); ! DEFSTRING( t1627, "-m", 2 ); ! DEFSTATICTSCP2( c1091, t1627 ); ! DEFSTRING( t1628, "-I", 2 ); ! DEFSTATICTSCP2( c1082, t1628 ); ! DEFSTRING( t1629, "-i", 2 ); ! DEFSTATICTSCP2( c1078, t1629 ); ! DEFSTRING( t1630, "-f", 2 ); ! DEFSTATICTSCP2( c1058, t1630 ); ! DEFSTATICTSCP( c1037 ); ! DEFSTRING( t1631, "Amiga", 5 ); ! DEFSTATICTSCP2( c1029, t1631 ); ! DEFSTRING( t1632, "lib:sc.lib", 10 ); ! DEFSTATICTSCP2( c1026, t1632 ); ! DEFSTRING( t1633, "include:sc", 10 ); ! DEFSTATICTSCP2( c1024, t1633 ); ! DEFSTRING( t1634, "objects.h", 9 ); ! DEFSTATICTSCP2( c1022, t1634 ); ! DEFSTRING( t1635, "include:sc/predef.sc", 20 ); ! DEFSTATICTSCP2( c1020, t1635 ); ! DEFSTRING( t1636, "SC-TO-C~s.o", 11 ); ! DEFSTATICTSCP2( c1018, t1636 ); ! DEFSTRING( t1637, "SC-TO-C~s.c", 11 ); ! DEFSTATICTSCP2( c1016, t1637 ); ! DEFSTRING( t1638, "28sep90jfb", 10 ); ! DEFSTATICTSCP2( c1013, t1638 ); static void init_constants() { TSCP X1; ! initialize_2dcompile_v = STRINGTOSYMBOL( U_TX( ADR( t1541 ) ) ); CONSTANTEXP( ADR( initialize_2dcompile_v ) ); ! sc_2dlog_2ddefault_v = STRINGTOSYMBOL( U_TX( ADR( t1542 ) ) ); CONSTANTEXP( ADR( sc_2dlog_2ddefault_v ) ); ! do_2ddefine_2dconstant_v = STRINGTOSYMBOL( U_TX( ADR( t1543 ) ) ); CONSTANTEXP( ADR( do_2ddefine_2dconstant_v ) ); ! sc_2dinclude_2ddirs_v = STRINGTOSYMBOL( U_TX( ADR( t1544 ) ) ); CONSTANTEXP( ADR( sc_2dinclude_2ddirs_v ) ); ! sc_2dinput_v = STRINGTOSYMBOL( U_TX( ADR( t1545 ) ) ); CONSTANTEXP( ADR( sc_2dinput_v ) ); ! sc_2dsource_2dname_v = STRINGTOSYMBOL( U_TX( ADR( t1546 ) ) ); CONSTANTEXP( ADR( sc_2dsource_2dname_v ) ); ! sc_2dicode_v = STRINGTOSYMBOL( U_TX( ADR( t1547 ) ) ); CONSTANTEXP( ADR( sc_2dicode_v ) ); ! sc_2derror_v = STRINGTOSYMBOL( U_TX( ADR( t1548 ) ) ); CONSTANTEXP( ADR( sc_2derror_v ) ); ! sc_2dlog_v = STRINGTOSYMBOL( U_TX( ADR( t1549 ) ) ); CONSTANTEXP( ADR( sc_2dlog_v ) ); ! sc_2dstack_2dtrace_v = STRINGTOSYMBOL( U_TX( ADR( t1550 ) ) ); CONSTANTEXP( ADR( sc_2dstack_2dtrace_v ) ); ! sc_2dinterpreter_v = STRINGTOSYMBOL( U_TX( ADR( t1551 ) ) ); CONSTANTEXP( ADR( sc_2dinterpreter_v ) ); ! docompile_v = STRINGTOSYMBOL( U_TX( ADR( t1552 ) ) ); CONSTANTEXP( ADR( docompile_v ) ); ! sc_2derror_2dcnt_v = STRINGTOSYMBOL( U_TX( ADR( t1553 ) ) ); CONSTANTEXP( ADR( sc_2derror_2dcnt_v ) ); ! module_2dname_v = STRINGTOSYMBOL( U_TX( ADR( t1554 ) ) ); CONSTANTEXP( ADR( module_2dname_v ) ); ! close_2dsc_2dfiles_v = STRINGTOSYMBOL( U_TX( ADR( t1555 ) ) ); CONSTANTEXP( ADR( close_2dsc_2dfiles_v ) ); ! c1499 = STRINGTOSYMBOL( U_TX( ADR( t1557 ) ) ); ! CONSTANTEXP( ADR( c1499 ) ); ! c1298 = STRINGTOSYMBOL( U_TX( ADR( t1572 ) ) ); ! CONSTANTEXP( ADR( c1298 ) ); ! c1179 = EMPTYLIST; ! t1581 = STRINGTOSYMBOL( U_TX( ADR( t1582 ) ) ); ! X1 = t1581; ! X1 = CONS( t1583, X1 ); ! c1179 = CONS( X1, c1179 ); ! t1585 = STRINGTOSYMBOL( U_TX( ADR( t1586 ) ) ); ! X1 = t1585; ! X1 = CONS( t1587, X1 ); ! c1179 = CONS( X1, c1179 ); ! t1589 = STRINGTOSYMBOL( U_TX( ADR( t1590 ) ) ); ! X1 = t1589; ! X1 = CONS( t1591, X1 ); ! c1179 = CONS( X1, c1179 ); ! t1593 = STRINGTOSYMBOL( U_TX( ADR( t1594 ) ) ); ! X1 = t1593; ! X1 = CONS( t1595, X1 ); ! c1179 = CONS( X1, c1179 ); ! t1597 = STRINGTOSYMBOL( U_TX( ADR( t1598 ) ) ); ! X1 = t1597; ! X1 = CONS( t1599, X1 ); ! c1179 = CONS( X1, c1179 ); ! t1601 = STRINGTOSYMBOL( U_TX( ADR( t1602 ) ) ); ! X1 = t1601; ! X1 = CONS( t1603, X1 ); ! c1179 = CONS( X1, c1179 ); ! t1605 = STRINGTOSYMBOL( U_TX( ADR( t1606 ) ) ); ! X1 = t1605; ! X1 = CONS( t1607, X1 ); ! c1179 = CONS( X1, c1179 ); ! t1609 = STRINGTOSYMBOL( U_TX( ADR( t1610 ) ) ); ! X1 = t1609; ! X1 = CONS( t1611, X1 ); ! c1179 = CONS( X1, c1179 ); ! t1613 = STRINGTOSYMBOL( U_TX( ADR( t1614 ) ) ); ! X1 = t1613; ! X1 = CONS( t1615, X1 ); ! c1179 = CONS( X1, c1179 ); ! CONSTANTEXP( ADR( c1179 ) ); ! c1037 = EMPTYLIST; ! c1037 = CONS( EMPTYSTRING, c1037 ); ! CONSTANTEXP( ADR( c1037 ) ); } DEFTSCP( main_scc_2dversion_v ); ! DEFSTRING( t1639, "SCC-VERSION", 11 ); DEFTSCP( main_force_2dld_2dof_2drep_v ); ! DEFSTRING( t1640, "FORCE-LD-OF-REP", 15 ); EXTERNTSCPP( screp_read_2deval_2dprint ); EXTERNTSCP( screp_read_2deval_2dprint_v ); DEFTSCP( main_sc_2dto_2dc_2ec_v ); ! DEFSTRING( t1641, "SC-TO-C.C", 9 ); DEFTSCP( main_sc_2dto_2dc_2eo_v ); ! DEFSTRING( t1642, "SC-TO-C.O", 9 ); DEFTSCP( main_predef_2ddefault_v ); ! DEFSTRING( t1643, "PREDEF-DEFAULT", 14 ); DEFTSCP( main_c_2dinclude_2dfile_v ); ! DEFSTRING( t1644, "C-INCLUDE-FILE", 14 ); DEFTSCP( main_c_2dinclude_2ddir_v ); ! DEFSTRING( t1645, "C-INCLUDE-DIR", 13 ); DEFTSCP( main_sc_2dlibrary_v ); ! DEFSTRING( t1646, "SC-LIBRARY", 10 ); DEFTSCP( main_sc_2dlibrary__p_v ); ! DEFSTRING( t1647, "SC-LIBRARY_P", 12 ); ! EXTERNTSCP( sc_emptystring ); DEFTSCP( main_sc_2dprocessor_v ); ! DEFSTRING( t1648, "SC-PROCESSOR", 12 ); DEFTSCP( main_configure_v ); ! DEFSTRING( t1649, "CONFIGURE", 9 ); EXTERNTSCPP( main_scc ); EXTERNTSCP( main_scc_v ); *************** *** 329,431 **** TSCP main_configure( c1032 ) TSCP c1032; { ! TSCP X6, X5, X4, X3, X2, X1; ! PUSHSTACKTRACE( U_TX( ADR( t1726 ) ) ); ! X1 = scrt1_length( c1032 ); ! if ( BITAND( BITOR( INT( X1 ), INT( _TSCP( 4 ) ) ), ! 3 ) ) goto L1730; ! if ( EQ( UNSIGNED( X1 ), UNSIGNED( _TSCP( 4 ) ) ) ) goto L1734; ! goto L1737; ! L1730: ! if ( FALSE( scrt2__3d_2dtwo( X1, _TSCP( 4 ) ) ) ) goto L1737; ! L1734: ! scrt6_display( c1044, EMPTYLIST ); ! scrt6_newline( EMPTYLIST ); ! X2 = scrt6_exit_v; ! X2 = UNKNOWNCALL( X2, 0 ); ! VIA( PROCEDURE_CODE( X2 ) )( PROCEDURE_CLOSURE( X2 ) ); ! L1737: ! main_predef_2ddefault_v = scrt1_list_2dref( c1032, _TSCP( 4 ) ); ! X1 = scrt1_list_2dref( c1032, _TSCP( 8 ) ); ! if ( AND( EQ( TSCPTAG( X1 ), EXTENDEDTAG ), ! EQ( TSCP_EXTENDEDTAG( X1 ), STRINGTAG ) ) ) goto L1741; ! scrt6_error( c1087, c1088, CONS( X1, EMPTYLIST ) ); ! L1741: ! X2 = C_FIXED( STRING_LENGTH( X1 ) ); ! if ( BITAND( BITOR( INT( X2 ), INT( _TSCP( 4 ) ) ), ! 3 ) ) goto L1745; ! X3 = _TSCP( IDIFFERENCE( INT( X2 ), ! INT( _TSCP( 4 ) ) ) ); ! goto L1746; ! L1745: ! X3 = scrt2__2d_2dtwo( X2, _TSCP( 4 ) ); ! L1746: ! if ( BITAND( BITOR( INT( X3 ), INT( _TSCP( 0 ) ) ), ! 3 ) ) goto L1749; ! if ( LTE( INT( X3 ), INT( _TSCP( 0 ) ) ) ) goto L1753; ! goto L1754; ! L1749: ! if ( FALSE( scrt2__3c_3d_2dtwo( X3, _TSCP( 0 ) ) ) ) goto L1754; ! L1753: ! scrt6_error( c1104, c1105, CONS( X1, EMPTYLIST ) ); ! goto L1759; ! L1754: ! if ( EQ( TSCPTAG( X3 ), FIXNUMTAG ) ) goto L1761; ! scrt6_error( c1065, c1066, CONS( X3, EMPTYLIST ) ); ! L1761: ! X5 = BOOLEAN( LT( INT( X3 ), 0 ) ); ! if ( TRUE( X5 ) ) goto L1767; ! X6 = C_FIXED( STRING_LENGTH( X1 ) ); ! if ( BITAND( BITOR( INT( X3 ), INT( X6 ) ), ! 3 ) ) goto L1771; ! if ( GTE( INT( X3 ), INT( X6 ) ) ) goto L1767; ! goto L1778; ! L1771: ! if ( FALSE( scrt2__3e_3d_2dtwo( X3, X6 ) ) ) goto L1778; ! L1767: ! scrt6_error( c1065, c1089, CONS( X3, EMPTYLIST ) ); ! L1778: ! X4 = C_CHAR( STRING_CHAR( X1, X3 ) ); ! if ( FALSE( scrt1_equal_3f( X4, _TSCP( 12050 ) ) ) ) goto L1758; ! main_c_2dinclude_2ddir_v = scrt3_substring( X1, ! _TSCP( 0 ), X3 ); ! if ( BITAND( BITOR( INT( X3 ), INT( _TSCP( 4 ) ) ), ! 3 ) ) goto L1780; ! X4 = _TSCP( IPLUS( INT( X3 ), INT( _TSCP( 4 ) ) ) ); ! goto L1781; ! L1780: ! X4 = scrt2__2b_2dtwo( X3, _TSCP( 4 ) ); ! L1781: ! main_c_2dinclude_2dfile_v = scrt3_substring( X1, X4, X2 ); ! goto L1759; ! L1758: ! if ( BITAND( BITOR( INT( X3 ), INT( _TSCP( 4 ) ) ), ! 3 ) ) goto L1782; ! X3 = _TSCP( IDIFFERENCE( INT( X3 ), ! INT( _TSCP( 4 ) ) ) ); ! goto L1746; ! L1782: ! X3 = scrt2__2d_2dtwo( X3, _TSCP( 4 ) ); ! goto L1746; ! L1759: ! main_sc_2dlibrary_v = scrt1_list_2dref( c1032, _TSCP( 12 ) ); ! main_sc_2dlibrary__p_v = scrt1_list_2dref( c1032, _TSCP( 16 ) ); ! main_sc_2dprocessor_v = scrt1_list_2dref( c1032, _TSCP( 20 ) ); X1 = SYMBOL_VALUE( initialize_2dcompile_v ); X1 = UNKNOWNCALL( X1, 0 ); VIA( PROCEDURE_CODE( X1 ) )( PROCEDURE_CLOSURE( X1 ) ); ! X1 = scrt1_list_2dref( c1032, _TSCP( 24 ) ); ! POPSTACKTRACE( sc_save_2dheap( X1, ! CONS( main_scc_v, EMPTYLIST ) ) ); } DEFTSCP( main_module_2dnames_v ); ! DEFSTRING( t1784, "MODULE-NAMES", 12 ); DEFTSCP( main_include_2ddirs_v ); ! DEFSTRING( t1785, "INCLUDE-DIRS", 12 ); DEFTSCP( main_scc_v ); ! DEFSTRING( t1786, "SCC", 3 ); EXTERNTSCPP( scrt1_cons_2a ); EXTERNTSCP( scrt1_cons_2a_v ); EXTERNTSCPP( scrt6_format ); --- 283,303 ---- TSCP main_configure( c1032 ) TSCP c1032; { ! TSCP X1; ! PUSHSTACKTRACE( U_TX( ADR( t1649 ) ) ); X1 = SYMBOL_VALUE( initialize_2dcompile_v ); X1 = UNKNOWNCALL( X1, 0 ); VIA( PROCEDURE_CODE( X1 ) )( PROCEDURE_CLOSURE( X1 ) ); ! POPSTACKTRACE( main_scc( c1032 ) ); } DEFTSCP( main_module_2dnames_v ); ! DEFSTRING( t1651, "MODULE-NAMES", 12 ); DEFTSCP( main_include_2ddirs_v ); ! DEFSTRING( t1652, "INCLUDE-DIRS", 12 ); DEFTSCP( main_scc_v ); ! DEFSTRING( t1653, "SCC", 3 ); EXTERNTSCPP( scrt1_cons_2a ); EXTERNTSCP( scrt1_cons_2a_v ); EXTERNTSCPP( scrt6_format ); *************** *** 435,440 **** --- 307,314 ---- EXTERNTSCP( scrt1__24__cdr_2derror_v ); EXTERNTSCPP( scrt1__24__car_2derror ); EXTERNTSCP( scrt1__24__car_2derror_v ); + EXTERNTSCPP( scrt1_equal_3f ); + EXTERNTSCP( scrt1_equal_3f_v ); EXTERNTSCPP( sc_cons ); EXTERNTSCP( sc_cons_v ); EXTERNTSCPP( scrt3_string_2dappend ); *************** *** 449,466 **** EXTERNTSCP( scrt1_assoc_v ); EXTERNTSCPP( main_do_2dc_2dflag ); EXTERNTSCP( main_do_2dc_2dflag_v ); EXTERNTSCP( scrt6_reset_v ); ! DEFSTRING( t1921, "main_l1355 [inside SCC]", 23 ); EXTERNINTP( unlink ); ! TSCP main_l1355( c1920 ) ! TSCP c1920; { TSCP X3, X2, X1; ! PUSHSTACKTRACE( U_TX( ADR( t1921 ) ) ); X1 = DISPLAY( 0 ); ! DISPLAY( 0 ) = CLOSURE_VAR( c1920, 0 ); unlink( TSCP_POINTER( main_sc_2dto_2dc_2ec_v ) ); unlink( TSCP_POINTER( main_sc_2dto_2dc_2eo_v ) ); X3 = DISPLAY( 0 ); --- 323,341 ---- EXTERNTSCP( scrt1_assoc_v ); EXTERNTSCPP( main_do_2dc_2dflag ); EXTERNTSCP( main_do_2dc_2dflag_v ); + EXTERNTSCP( scrt6_exit_v ); EXTERNTSCP( scrt6_reset_v ); ! DEFSTRING( t1784, "main_l1261 [inside SCC]", 23 ); EXTERNINTP( unlink ); ! TSCP main_l1261( c1783 ) ! TSCP c1783; { TSCP X3, X2, X1; ! PUSHSTACKTRACE( U_TX( ADR( t1784 ) ) ); X1 = DISPLAY( 0 ); ! DISPLAY( 0 ) = CLOSURE_VAR( c1783, 0 ); unlink( TSCP_POINTER( main_sc_2dto_2dc_2ec_v ) ); unlink( TSCP_POINTER( main_sc_2dto_2dc_2eo_v ) ); X3 = DISPLAY( 0 ); *************** *** 472,477 **** --- 347,354 ---- EXTERNTSCPP( scrt5_open_2doutput_2dfile ); EXTERNTSCP( scrt5_open_2doutput_2dfile_v ); + EXTERNTSCPP( scrt6_error ); + EXTERNTSCP( scrt6_error_v ); EXTERNTSCPP( scrt5_close_2doutput_2dport ); EXTERNTSCP( scrt5_close_2doutput_2dport_v ); EXTERNTSCPP( sc_apply_2dtwo ); *************** *** 480,489 **** EXTERNTSCP( scrt1_reverse_v ); EXTERNINTP( system ); ! TSCP main_scc( c1127 ) ! TSCP c1127; { ! TSCP X20, X19, X18, X17, --- 357,369 ---- EXTERNTSCP( scrt1_reverse_v ); EXTERNINTP( system ); ! TSCP main_scc( c1039 ) ! TSCP c1039; { ! TSCP X23, ! X22, ! X21, ! X20, X19, X18, X17, *************** *** 499,518 **** TSCP SD0 = DISPLAY( 0 ); TSCP SDVAL; ! PUSHSTACKTRACE( U_TX( ADR( t1786 ) ) ); ! X1 = c1456; X2 = EMPTYLIST; X3 = EMPTYLIST; X4 = FALSEVALUE; X5 = TRUEVALUE; - X7 = CONS( EMPTYLIST, EMPTYLIST ); X6 = scrt1_cons_2a( main_sc_2dlibrary_v, ! CONS( c1236, X7 ) ); X7 = FALSEVALUE; X8 = EMPTYLIST; X8 = CONS( X8, EMPTYLIST ); X7 = CONS( X7, EMPTYLIST ); - X6 = CONS( X6, EMPTYLIST ); X5 = CONS( X5, EMPTYLIST ); X4 = CONS( X4, EMPTYLIST ); X3 = CONS( X3, EMPTYLIST ); --- 379,396 ---- TSCP SD0 = DISPLAY( 0 ); TSCP SDVAL; ! PUSHSTACKTRACE( U_TX( ADR( t1653 ) ) ); ! X1 = c1402; X2 = EMPTYLIST; X3 = EMPTYLIST; X4 = FALSEVALUE; X5 = TRUEVALUE; X6 = scrt1_cons_2a( main_sc_2dlibrary_v, ! CONS( EMPTYLIST, EMPTYLIST ) ); X7 = FALSEVALUE; X8 = EMPTYLIST; X8 = CONS( X8, EMPTYLIST ); X7 = CONS( X7, EMPTYLIST ); X5 = CONS( X5, EMPTYLIST ); X4 = CONS( X4, EMPTYLIST ); X3 = CONS( X3, EMPTYLIST ); *************** *** 524,576 **** main_sc_2dto_2dc_2eo_v = scrt6_format( main_sc_2dto_2dc_2eo_v, CONS( INT_TSCP( getpid( ) ), EMPTYLIST ) ); ! if ( EQ( TSCPTAG( c1127 ), PAIRTAG ) ) goto L1791; ! scrt1__24__cdr_2derror( c1127 ); ! L1791: ! X9 = PAIR_CDR( c1127 ); ! L1793: ! if ( FALSE( X9 ) ) goto L1822; ! if ( EQ( TSCPTAG( X9 ), PAIRTAG ) ) goto L1797; scrt1__24__car_2derror( X9 ); ! L1797: X10 = PAIR_CAR( X9 ); ! X11 = scrt1_equal_3f( X10, c1146 ); ! if ( FALSE( X11 ) ) goto L1821; X12 = PAIR_CDR( X9 ); ! if ( FALSE( X12 ) ) goto L1821; X13 = PAIR_CDR( X9 ); ! if ( EQ( TSCPTAG( X13 ), PAIRTAG ) ) goto L1811; scrt1__24__cdr_2derror( X13 ); ! L1811: ! if ( FALSE( PAIR_CDR( X13 ) ) ) goto L1821; ! X16 = CONS( c1344, EMPTYLIST ); X16 = CONS( scrt1_caddr( X9 ), X16 ); ! X16 = CONS( c1343, X16 ); X17 = PAIR_CDR( X9 ); ! if ( EQ( TSCPTAG( X17 ), PAIRTAG ) ) goto L1818; scrt1__24__car_2derror( X17 ); ! L1818: X16 = CONS( PAIR_CAR( X17 ), X16 ); ! X15 = scrt3_string_2dappend( CONS( c1332, X16 ) ); X14 = sc_cons( X15, PAIR_CAR( X8 ) ); SETGEN( PAIR_CAR( X8 ), X14 ); X9 = scrt1_cdddr( X9 ); ! goto L1793; ! L1821: ! if ( FALSE( scrt1_equal_3f( X10, c1166 ) ) ) goto L1823; X11 = TRUEVALUE; SETGEN( PAIR_CAR( X7 ), X11 ); X9 = PAIR_CDR( X9 ); ! goto L1793; ! L1823: ! X11 = scrt1_equal_3f( X10, c1170 ); ! if ( FALSE( X11 ) ) goto L1844; ! if ( FALSE( PAIR_CDR( X9 ) ) ) goto L1844; ! X15 = CONS( c1315, EMPTYLIST ); X16 = PAIR_CDR( X9 ); ! if ( EQ( TSCPTAG( X16 ), PAIRTAG ) ) goto L1837; scrt1__24__car_2derror( X16 ); ! L1837: X14 = scrt3_string_2dappend( CONS( PAIR_CAR( X16 ), X15 ) ); X13 = sc_cons( X14, EMPTYLIST ); X12 = X13; --- 402,454 ---- main_sc_2dto_2dc_2eo_v = scrt6_format( main_sc_2dto_2dc_2eo_v, CONS( INT_TSCP( getpid( ) ), EMPTYLIST ) ); ! if ( EQ( TSCPTAG( c1039 ), PAIRTAG ) ) goto L1658; ! scrt1__24__cdr_2derror( c1039 ); ! L1658: ! X9 = PAIR_CDR( c1039 ); ! L1660: ! if ( FALSE( X9 ) ) goto L1689; ! if ( EQ( TSCPTAG( X9 ), PAIRTAG ) ) goto L1664; scrt1__24__car_2derror( X9 ); ! L1664: X10 = PAIR_CAR( X9 ); ! X11 = scrt1_equal_3f( X10, c1058 ); ! if ( FALSE( X11 ) ) goto L1688; X12 = PAIR_CDR( X9 ); ! if ( FALSE( X12 ) ) goto L1688; X13 = PAIR_CDR( X9 ); ! if ( EQ( TSCPTAG( X13 ), PAIRTAG ) ) goto L1678; scrt1__24__cdr_2derror( X13 ); ! L1678: ! if ( FALSE( PAIR_CDR( X13 ) ) ) goto L1688; ! X16 = CONS( c1249, EMPTYLIST ); X16 = CONS( scrt1_caddr( X9 ), X16 ); ! X16 = CONS( c1248, X16 ); X17 = PAIR_CDR( X9 ); ! if ( EQ( TSCPTAG( X17 ), PAIRTAG ) ) goto L1685; scrt1__24__car_2derror( X17 ); ! L1685: X16 = CONS( PAIR_CAR( X17 ), X16 ); ! X15 = scrt3_string_2dappend( CONS( c1237, X16 ) ); X14 = sc_cons( X15, PAIR_CAR( X8 ) ); SETGEN( PAIR_CAR( X8 ), X14 ); X9 = scrt1_cdddr( X9 ); ! goto L1660; ! L1688: ! if ( FALSE( scrt1_equal_3f( X10, c1078 ) ) ) goto L1690; X11 = TRUEVALUE; SETGEN( PAIR_CAR( X7 ), X11 ); X9 = PAIR_CDR( X9 ); ! goto L1660; ! L1690: ! X11 = scrt1_equal_3f( X10, c1082 ); ! if ( FALSE( X11 ) ) goto L1711; ! if ( FALSE( PAIR_CDR( X9 ) ) ) goto L1711; ! X15 = CONS( c1220, EMPTYLIST ); X16 = PAIR_CDR( X9 ); ! if ( EQ( TSCPTAG( X16 ), PAIRTAG ) ) goto L1704; scrt1__24__car_2derror( X16 ); ! L1704: X14 = scrt3_string_2dappend( CONS( PAIR_CAR( X16 ), X15 ) ); X13 = sc_cons( X14, EMPTYLIST ); X12 = X13; *************** *** 577,677 **** main_include_2ddirs_v = scrt1_append_2dtwo( main_include_2ddirs_v, X12 ); X12 = PAIR_CDR( X9 ); ! if ( EQ( TSCPTAG( X12 ), PAIRTAG ) ) goto L1842; scrt1__24__cdr_2derror( X12 ); ! L1842: X9 = PAIR_CDR( X12 ); ! goto L1793; ! L1844: ! X11 = scrt1_equal_3f( X10, c1179 ); ! if ( FALSE( X11 ) ) goto L1861; ! if ( FALSE( PAIR_CDR( X9 ) ) ) goto L1861; X13 = PAIR_CDR( X9 ); ! if ( EQ( TSCPTAG( X13 ), PAIRTAG ) ) goto L1855; scrt1__24__car_2derror( X13 ); ! L1855: X12 = PAIR_CAR( X13 ); main_module_2dnames_v = sc_cons( X12, main_module_2dnames_v ); X12 = PAIR_CDR( X9 ); ! if ( EQ( TSCPTAG( X12 ), PAIRTAG ) ) goto L1859; scrt1__24__cdr_2derror( X12 ); ! L1859: X9 = PAIR_CDR( X12 ); ! goto L1793; ! L1861: ! if ( FALSE( scrt1_equal_3f( X10, c1185 ) ) ) goto L1862; X11 = SYMBOL_VALUE( sc_2dlog_2ddefault_v ); SETGEN( PAIR_CAR( X2 ), X11 ); X9 = PAIR_CDR( X9 ); ! goto L1793; ! L1862: ! X11 = scrt1_assoc( X10, c1274 ); ! if ( FALSE( X11 ) ) goto L1867; ! if ( EQ( TSCPTAG( X11 ), PAIRTAG ) ) goto L1871; scrt1__24__cdr_2derror( X11 ); ! L1871: X13 = PAIR_CDR( X11 ); X12 = sc_cons( X13, PAIR_CAR( X2 ) ); SETGEN( PAIR_CAR( X2 ), X12 ); X9 = PAIR_CDR( X9 ); ! goto L1793; ! L1867: ! if ( FALSE( scrt1_equal_3f( X10, c1188 ) ) ) goto L1874; ! X12 = sc_cons( c1259, PAIR_CAR( X8 ) ); SETGEN( PAIR_CAR( X8 ), X12 ); X9 = PAIR_CDR( X9 ); ! goto L1793; ! L1874: ! if ( FALSE( scrt1_equal_3f( X10, c1189 ) ) ) goto L1878; ! X12 = sc_cons( c1253, PAIR_CAR( X8 ) ); SETGEN( PAIR_CAR( X8 ), X12 ); X9 = PAIR_CDR( X9 ); ! goto L1793; ! L1878: ! if ( FALSE( scrt1_equal_3f( X10, c1190 ) ) ) goto L1882; X12 = FALSEVALUE; SETGEN( PAIR_CAR( X5 ), X12 ); X9 = PAIR_CDR( X9 ); ! goto L1793; ! L1882: ! if ( FALSE( scrt1_equal_3f( X10, c1191 ) ) ) goto L1886; ! X12 = sc_cons( c1242, PAIR_CAR( X8 ) ); SETGEN( PAIR_CAR( X8 ), X12 ); X9 = PAIR_CDR( X9 ); ! goto L1793; ! L1886: ! if ( FALSE( scrt1_equal_3f( X10, c1192 ) ) ) goto L1890; ! X13 = CONS( EMPTYLIST, EMPTYLIST ); ! X12 = scrt1_cons_2a( main_sc_2dlibrary__p_v, ! CONS( c1236, X13 ) ); ! SETGEN( PAIR_CAR( X6 ), X12 ); ! X12 = sc_cons( X10, PAIR_CAR( X3 ) ); ! SETGEN( PAIR_CAR( X3 ), X12 ); ! X9 = PAIR_CDR( X9 ); ! goto L1793; ! L1890: ! if ( FALSE( scrt1_equal_3f( X10, c1193 ) ) ) goto L1894; X12 = TRUEVALUE; SETGEN( PAIR_CAR( X4 ), X12 ); X9 = PAIR_CDR( X9 ); ! goto L1793; ! L1894: ! X12 = scrt1_equal_3f( X10, c1197 ); ! if ( FALSE( X12 ) ) goto L1914; ! if ( FALSE( PAIR_CDR( X9 ) ) ) goto L1914; X14 = PAIR_CDR( X9 ); ! if ( EQ( TSCPTAG( X14 ), PAIRTAG ) ) goto L1908; scrt1__24__car_2derror( X14 ); ! L1908: X13 = PAIR_CAR( X14 ); SETGEN( PAIR_CAR( X1 ), X13 ); X13 = PAIR_CDR( X9 ); ! if ( EQ( TSCPTAG( X13 ), PAIRTAG ) ) goto L1912; scrt1__24__cdr_2derror( X13 ); ! L1912: X9 = PAIR_CDR( X13 ); ! goto L1793; ! L1914: X12 = main_do_2dc_2dflag( X10, PAIR_CAR( X8 ), PAIR_CAR( X2 ), --- 455,545 ---- main_include_2ddirs_v = scrt1_append_2dtwo( main_include_2ddirs_v, X12 ); X12 = PAIR_CDR( X9 ); ! if ( EQ( TSCPTAG( X12 ), PAIRTAG ) ) goto L1709; scrt1__24__cdr_2derror( X12 ); ! L1709: X9 = PAIR_CDR( X12 ); ! goto L1660; ! L1711: ! X11 = scrt1_equal_3f( X10, c1091 ); ! if ( FALSE( X11 ) ) goto L1728; ! if ( FALSE( PAIR_CDR( X9 ) ) ) goto L1728; X13 = PAIR_CDR( X9 ); ! if ( EQ( TSCPTAG( X13 ), PAIRTAG ) ) goto L1722; scrt1__24__car_2derror( X13 ); ! L1722: X12 = PAIR_CAR( X13 ); main_module_2dnames_v = sc_cons( X12, main_module_2dnames_v ); X12 = PAIR_CDR( X9 ); ! if ( EQ( TSCPTAG( X12 ), PAIRTAG ) ) goto L1726; scrt1__24__cdr_2derror( X12 ); ! L1726: X9 = PAIR_CDR( X12 ); ! goto L1660; ! L1728: ! if ( FALSE( scrt1_equal_3f( X10, c1097 ) ) ) goto L1729; X11 = SYMBOL_VALUE( sc_2dlog_2ddefault_v ); SETGEN( PAIR_CAR( X2 ), X11 ); X9 = PAIR_CDR( X9 ); ! goto L1660; ! L1729: ! X11 = scrt1_assoc( X10, c1179 ); ! if ( FALSE( X11 ) ) goto L1734; ! if ( EQ( TSCPTAG( X11 ), PAIRTAG ) ) goto L1738; scrt1__24__cdr_2derror( X11 ); ! L1738: X13 = PAIR_CDR( X11 ); X12 = sc_cons( X13, PAIR_CAR( X2 ) ); SETGEN( PAIR_CAR( X2 ), X12 ); X9 = PAIR_CDR( X9 ); ! goto L1660; ! L1734: ! if ( FALSE( scrt1_equal_3f( X10, c1100 ) ) ) goto L1741; ! X12 = sc_cons( c1164, PAIR_CAR( X8 ) ); SETGEN( PAIR_CAR( X8 ), X12 ); X9 = PAIR_CDR( X9 ); ! goto L1660; ! L1741: ! if ( FALSE( scrt1_equal_3f( X10, c1101 ) ) ) goto L1745; ! X12 = sc_cons( c1158, PAIR_CAR( X8 ) ); SETGEN( PAIR_CAR( X8 ), X12 ); X9 = PAIR_CDR( X9 ); ! goto L1660; ! L1745: ! if ( FALSE( scrt1_equal_3f( X10, c1102 ) ) ) goto L1749; X12 = FALSEVALUE; SETGEN( PAIR_CAR( X5 ), X12 ); X9 = PAIR_CDR( X9 ); ! goto L1660; ! L1749: ! if ( FALSE( scrt1_equal_3f( X10, c1103 ) ) ) goto L1753; ! X12 = sc_cons( c1147, PAIR_CAR( X8 ) ); SETGEN( PAIR_CAR( X8 ), X12 ); X9 = PAIR_CDR( X9 ); ! goto L1660; ! L1753: ! if ( FALSE( scrt1_equal_3f( X10, c1104 ) ) ) goto L1757; X12 = TRUEVALUE; SETGEN( PAIR_CAR( X4 ), X12 ); X9 = PAIR_CDR( X9 ); ! goto L1660; ! L1757: ! X12 = scrt1_equal_3f( X10, c1108 ); ! if ( FALSE( X12 ) ) goto L1777; ! if ( FALSE( PAIR_CDR( X9 ) ) ) goto L1777; X14 = PAIR_CDR( X9 ); ! if ( EQ( TSCPTAG( X14 ), PAIRTAG ) ) goto L1771; scrt1__24__car_2derror( X14 ); ! L1771: X13 = PAIR_CAR( X14 ); SETGEN( PAIR_CAR( X1 ), X13 ); X13 = PAIR_CDR( X9 ); ! if ( EQ( TSCPTAG( X13 ), PAIRTAG ) ) goto L1775; scrt1__24__cdr_2derror( X13 ); ! L1775: X9 = PAIR_CDR( X13 ); ! goto L1660; ! L1777: X12 = main_do_2dc_2dflag( X10, PAIR_CAR( X8 ), PAIR_CAR( X2 ), *************** *** 680,791 **** X11 = sc_cons( X12, PAIR_CAR( X3 ) ); SETGEN( PAIR_CAR( X3 ), X11 ); X9 = PAIR_CDR( X9 ); ! goto L1793; ! L1822: ! if ( FALSE( PAIR_CAR( X4 ) ) ) goto L1917; X9 = scrt6_exit_v; X9 = UNKNOWNCALL( X9, 0 ); VIA( PROCEDURE_CODE( X9 ) )( PROCEDURE_CLOSURE( X9 ) ); ! L1917: DISPLAY( 0 ) = scrt6_reset_v; scrt6_reset_v = MAKEPROCEDURE( 0, 0, ! main_l1355, MAKECLOSURE( EMPTYLIST, 1, DISPLAY( 0 ) ) ); ! if ( FALSE( PAIR_CAR( X7 ) ) ) goto L1923; X9 = scrt5_open_2doutput_2dfile( main_sc_2dto_2dc_2ec_v ); X10 = CONS( main_c_2dinclude_2dfile_v, EMPTYLIST ); X10 = CONS( main_c_2dinclude_2ddir_v, X10 ); ! scrt6_format( X9, CONS( c1358, X10 ) ); ! scrt6_format( X9, CONS( c1359, EMPTYLIST ) ); ! scrt6_format( X9, CONS( c1360, EMPTYLIST ) ); ! scrt6_format( X9, CONS( c1361, EMPTYLIST ) ); ! X10 = sc_cons( c1405, main_module_2dnames_v ); X11 = X10; X12 = EMPTYLIST; X13 = EMPTYLIST; ! L1928: ! if ( EQ( UNSIGNED( X11 ), UNSIGNED( EMPTYLIST ) ) ) goto L1936; ! if ( EQ( TSCPTAG( X11 ), PAIRTAG ) ) goto L1932; scrt1__24__car_2derror( X11 ); ! L1932: X16 = CONS( PAIR_CAR( X11 ), EMPTYLIST ); ! X15 = scrt6_format( X9, CONS( c1404, X16 ) ); X14 = sc_cons( X15, EMPTYLIST ); ! if ( NEQ( UNSIGNED( X12 ), UNSIGNED( EMPTYLIST ) ) ) goto L1935; X15 = PAIR_CDR( X11 ); X13 = X14; X12 = X14; X11 = X15; ! goto L1928; ! L1935: X15 = PAIR_CDR( X11 ); ! if ( EQ( TSCPTAG( X13 ), PAIRTAG ) ) goto L1940; ! scrt6_error( c1392, ! c1393, CONS( X13, EMPTYLIST ) ); ! L1940: X13 = SETGEN( PAIR_CDR( X13 ), X14 ); X11 = X15; ! goto L1928; ! L1936: ! scrt6_format( X9, CONS( c1406, EMPTYLIST ) ); ! scrt6_format( X9, CONS( c1407, EMPTYLIST ) ); ! scrt6_format( X9, CONS( c1408, EMPTYLIST ) ); scrt5_close_2doutput_2dport( X9 ); ! X12 = sc_cons( main_sc_2dto_2dc_2ec_v, EMPTYLIST ); ! X11 = X12; ! X10 = scrt1_append_2dtwo( PAIR_CAR( X3 ), X11 ); SETGEN( PAIR_CAR( X3 ), X10 ); ! L1923: ! X15 = scrt1_reverse( PAIR_CAR( X3 ) ); ! X14 = scrt1_append_2dtwo( X15, PAIR_CAR( X6 ) ); ! X15 = X14; X16 = EMPTYLIST; ! X17 = EMPTYLIST; ! L1947: ! if ( NEQ( UNSIGNED( X15 ), UNSIGNED( EMPTYLIST ) ) ) goto L1948; ! X13 = X16; ! goto L1955; ! L1948: ! if ( EQ( TSCPTAG( X15 ), PAIRTAG ) ) goto L1951; ! scrt1__24__car_2derror( X15 ); ! L1951: ! X20 = CONS( PAIR_CAR( X15 ), EMPTYLIST ); ! X19 = scrt3_string_2dappend( CONS( c1343, X20 ) ); ! X18 = sc_cons( X19, EMPTYLIST ); ! if ( NEQ( UNSIGNED( X16 ), UNSIGNED( EMPTYLIST ) ) ) goto L1954; ! X19 = PAIR_CDR( X15 ); ! X17 = X18; ! X16 = X18; ! X15 = X19; ! goto L1947; ! L1954: ! X19 = PAIR_CDR( X15 ); ! if ( EQ( TSCPTAG( X17 ), PAIRTAG ) ) goto L1959; ! scrt6_error( c1392, ! c1393, CONS( X17, EMPTYLIST ) ); ! L1959: ! X17 = SETGEN( PAIR_CDR( X17 ), X18 ); ! X15 = X19; ! goto L1947; ! L1955: ! X14 = scrt1_cons_2a( EMPTYLIST, EMPTYLIST ); X12 = CONS( scrt1_append_2dtwo( X13, X14 ), EMPTYLIST ); X12 = CONS( main_c_2dinclude_2ddir_v, X12 ); ! X12 = CONS( c1415, X12 ); X12 = CONS( main_sc_2dprocessor_v, X12 ); X11 = scrt1_cons_2a( PAIR_CAR( X1 ), ! CONS( c1414, X12 ) ); X10 = sc_apply_2dtwo( scrt3_string_2dappend_v, X11 ); X9 = INT_TSCP( system( TSCP_POINTER( X10 ) ) ); ! if ( EQ( UNSIGNED( _TSCP( 0 ) ), UNSIGNED( X9 ) ) ) goto L1943; X9 = scrt6_reset_v; X9 = UNKNOWNCALL( X9, 0 ); VIA( PROCEDURE_CODE( X9 ) )( PROCEDURE_CLOSURE( X9 ) ); ! L1943: unlink( TSCP_POINTER( main_sc_2dto_2dc_2ec_v ) ); SDVAL = INT_TSCP( unlink( TSCP_POINTER( main_sc_2dto_2dc_2eo_v ) ) ); DISPLAY( 0 ) = SD0; --- 548,689 ---- X11 = sc_cons( X12, PAIR_CAR( X3 ) ); SETGEN( PAIR_CAR( X3 ), X11 ); X9 = PAIR_CDR( X9 ); ! goto L1660; ! L1689: ! if ( FALSE( PAIR_CAR( X4 ) ) ) goto L1780; X9 = scrt6_exit_v; X9 = UNKNOWNCALL( X9, 0 ); VIA( PROCEDURE_CODE( X9 ) )( PROCEDURE_CLOSURE( X9 ) ); ! L1780: DISPLAY( 0 ) = scrt6_reset_v; scrt6_reset_v = MAKEPROCEDURE( 0, 0, ! main_l1261, MAKECLOSURE( EMPTYLIST, 1, DISPLAY( 0 ) ) ); ! if ( FALSE( PAIR_CAR( X7 ) ) ) goto L1786; X9 = scrt5_open_2doutput_2dfile( main_sc_2dto_2dc_2ec_v ); X10 = CONS( main_c_2dinclude_2dfile_v, EMPTYLIST ); X10 = CONS( main_c_2dinclude_2ddir_v, X10 ); ! scrt6_format( X9, CONS( c1264, X10 ) ); ! scrt6_format( X9, CONS( c1265, EMPTYLIST ) ); ! scrt6_format( X9, CONS( c1266, EMPTYLIST ) ); ! scrt6_format( X9, CONS( c1267, EMPTYLIST ) ); ! X10 = sc_cons( c1311, main_module_2dnames_v ); X11 = X10; X12 = EMPTYLIST; X13 = EMPTYLIST; ! L1791: ! if ( EQ( UNSIGNED( X11 ), UNSIGNED( EMPTYLIST ) ) ) goto L1799; ! if ( EQ( TSCPTAG( X11 ), PAIRTAG ) ) goto L1795; scrt1__24__car_2derror( X11 ); ! L1795: X16 = CONS( PAIR_CAR( X11 ), EMPTYLIST ); ! X15 = scrt6_format( X9, CONS( c1310, X16 ) ); X14 = sc_cons( X15, EMPTYLIST ); ! if ( NEQ( UNSIGNED( X12 ), UNSIGNED( EMPTYLIST ) ) ) goto L1798; X15 = PAIR_CDR( X11 ); X13 = X14; X12 = X14; X11 = X15; ! goto L1791; ! L1798: X15 = PAIR_CDR( X11 ); ! if ( EQ( TSCPTAG( X13 ), PAIRTAG ) ) goto L1803; ! scrt6_error( c1298, ! c1299, CONS( X13, EMPTYLIST ) ); ! L1803: X13 = SETGEN( PAIR_CDR( X13 ), X14 ); X11 = X15; ! goto L1791; ! L1799: ! scrt6_format( X9, CONS( c1312, EMPTYLIST ) ); ! scrt6_format( X9, CONS( c1313, EMPTYLIST ) ); ! scrt6_format( X9, CONS( c1314, EMPTYLIST ) ); scrt5_close_2doutput_2dport( X9 ); ! X10 = sc_cons( main_sc_2dto_2dc_2ec_v, PAIR_CAR( X3 ) ); SETGEN( PAIR_CAR( X3 ), X10 ); ! L1786: ! X14 = X6; ! X15 = EMPTYLIST; X16 = EMPTYLIST; ! L1808: ! if ( NEQ( UNSIGNED( X14 ), UNSIGNED( EMPTYLIST ) ) ) goto L1809; ! X13 = X15; ! goto L1816; ! L1809: ! if ( EQ( TSCPTAG( X14 ), PAIRTAG ) ) goto L1812; ! scrt1__24__car_2derror( X14 ); ! L1812: ! X19 = CONS( PAIR_CAR( X14 ), EMPTYLIST ); ! X18 = scrt3_string_2dappend( CONS( c1361, X19 ) ); ! X17 = sc_cons( X18, EMPTYLIST ); ! if ( NEQ( UNSIGNED( X15 ), UNSIGNED( EMPTYLIST ) ) ) goto L1815; ! X18 = PAIR_CDR( X14 ); ! X16 = X17; ! X15 = X17; ! X14 = X18; ! goto L1808; ! L1815: ! X18 = PAIR_CDR( X14 ); ! if ( EQ( TSCPTAG( X16 ), PAIRTAG ) ) goto L1820; ! scrt6_error( c1298, ! c1299, CONS( X16, EMPTYLIST ) ); ! L1820: ! X16 = SETGEN( PAIR_CDR( X16 ), X17 ); ! X14 = X18; ! goto L1808; ! L1816: ! X17 = scrt1_reverse( PAIR_CAR( X3 ) ); ! X18 = X17; ! X19 = EMPTYLIST; ! X20 = EMPTYLIST; ! L1824: ! if ( NEQ( UNSIGNED( X18 ), UNSIGNED( EMPTYLIST ) ) ) goto L1825; ! X16 = X19; ! goto L1832; ! L1825: ! if ( EQ( TSCPTAG( X18 ), PAIRTAG ) ) goto L1828; ! scrt1__24__car_2derror( X18 ); ! L1828: ! X23 = CONS( PAIR_CAR( X18 ), EMPTYLIST ); ! X22 = scrt3_string_2dappend( CONS( c1248, X23 ) ); ! X21 = sc_cons( X22, EMPTYLIST ); ! if ( NEQ( UNSIGNED( X19 ), UNSIGNED( EMPTYLIST ) ) ) goto L1831; ! X22 = PAIR_CDR( X18 ); ! X20 = X21; ! X19 = X21; ! X18 = X22; ! goto L1824; ! L1831: ! X22 = PAIR_CDR( X18 ); ! if ( EQ( TSCPTAG( X20 ), PAIRTAG ) ) goto L1836; ! scrt6_error( c1298, ! c1299, CONS( X20, EMPTYLIST ) ); ! L1836: ! X20 = SETGEN( PAIR_CDR( X20 ), X21 ); ! X18 = X22; ! goto L1824; ! L1832: ! X17 = scrt1_cons_2a( EMPTYLIST, EMPTYLIST ); ! X15 = scrt1_append_2dtwo( X16, X17 ); ! X14 = scrt1_cons_2a( X15, EMPTYLIST ); X12 = CONS( scrt1_append_2dtwo( X13, X14 ), EMPTYLIST ); + X12 = CONS( c1320, X12 ); X12 = CONS( main_c_2dinclude_2ddir_v, X12 ); ! X12 = CONS( c1319, X12 ); X12 = CONS( main_sc_2dprocessor_v, X12 ); X11 = scrt1_cons_2a( PAIR_CAR( X1 ), ! CONS( c1318, X12 ) ); X10 = sc_apply_2dtwo( scrt3_string_2dappend_v, X11 ); X9 = INT_TSCP( system( TSCP_POINTER( X10 ) ) ); ! if ( EQ( UNSIGNED( _TSCP( 0 ) ), UNSIGNED( X9 ) ) ) goto L1805; X9 = scrt6_reset_v; X9 = UNKNOWNCALL( X9, 0 ); VIA( PROCEDURE_CODE( X9 ) )( PROCEDURE_CLOSURE( X9 ) ); ! L1805: unlink( TSCP_POINTER( main_sc_2dto_2dc_2ec_v ) ); SDVAL = INT_TSCP( unlink( TSCP_POINTER( main_sc_2dto_2dc_2eo_v ) ) ); DISPLAY( 0 ) = SD0; *************** *** 793,799 **** } DEFTSCP( main_do_2dc_2dflag_v ); ! DEFSTRING( t1961, "DO-C-FLAG", 9 ); EXTERNTSCPP( scrt2_max_2dtwo ); EXTERNTSCP( scrt2_max_2dtwo_v ); EXTERNTSCPP( scrt2__3e_2dtwo ); --- 691,701 ---- } DEFTSCP( main_do_2dc_2dflag_v ); ! DEFSTRING( t1838, "DO-C-FLAG", 9 ); ! EXTERNTSCPP( scrt3_substring ); ! EXTERNTSCP( scrt3_substring_v ); ! EXTERNTSCPP( scrt2__2d_2dtwo ); ! EXTERNTSCP( scrt2__2d_2dtwo_v ); EXTERNTSCPP( scrt2_max_2dtwo ); EXTERNTSCP( scrt2_max_2dtwo_v ); EXTERNTSCPP( scrt2__3e_2dtwo ); *************** *** 811,881 **** EXTERNTSCP( scrt2_zero_3f_v ); EXTERNINTP( rename ); ! TSCP main_do_2dc_2dflag( a1458, ! f1459, l1460, s1461, i1462 ) ! TSCP a1458, f1459, l1460, s1461, i1462; { TSCP X7, X6, X5, X4, X3, X2, X1; ! PUSHSTACKTRACE( U_TX( ADR( t1961 ) ) ); ! if ( AND( EQ( TSCPTAG( a1458 ), EXTENDEDTAG ), ! EQ( TSCP_EXTENDEDTAG( a1458 ), STRINGTAG ) ) ! ) goto L1964; ! scrt6_error( c1087, ! c1088, CONS( a1458, EMPTYLIST ) ); ! L1964: ! X2 = C_FIXED( STRING_LENGTH( a1458 ) ); if ( BITAND( BITOR( INT( X2 ), INT( _TSCP( 12 ) ) ), ! 3 ) ) goto L1967; X5 = _TSCP( IDIFFERENCE( INT( X2 ), INT( _TSCP( 12 ) ) ) ); ! goto L1968; ! L1967: X5 = scrt2__2d_2dtwo( X2, _TSCP( 12 ) ); ! L1968: if ( BITAND( BITOR( INT( _TSCP( 0 ) ), INT( X5 ) ), ! 3 ) ) goto L1970; ! if ( LTE( INT( _TSCP( 0 ) ), INT( X5 ) ) ) goto L1972; X4 = _TSCP( 0 ); ! goto L1971; ! L1972: X4 = X5; ! goto L1971; ! L1970: X4 = scrt2_max_2dtwo( _TSCP( 0 ), X5 ); ! L1971: ! X3 = scrt3_substring( a1458, _TSCP( 0 ), X4 ); ! X4 = CONS( c1535, EMPTYLIST ); X1 = scrt3_string_2dappend( CONS( X3, X4 ) ); if ( BITAND( BITOR( INT( X2 ), INT( _TSCP( 12 ) ) ), ! 3 ) ) goto L1977; ! if ( GT( INT( X2 ), INT( _TSCP( 12 ) ) ) ) goto L1981; ! POPSTACKTRACE( a1458 ); ! L1977: ! if ( TRUE( scrt2__3e_2dtwo( X2, _TSCP( 12 ) ) ) ) goto L1981; ! POPSTACKTRACE( a1458 ); ! L1981: if ( BITAND( BITOR( INT( X2 ), INT( _TSCP( 12 ) ) ), ! 3 ) ) goto L1986; X4 = _TSCP( IDIFFERENCE( INT( X2 ), INT( _TSCP( 12 ) ) ) ); ! goto L1987; ! L1986: X4 = scrt2__2d_2dtwo( X2, _TSCP( 12 ) ); ! L1987: ! X3 = scrt3_substring( a1458, X4, X2 ); ! if ( FALSE( scrt3_string_3d_3f( X3, c1485 ) ) ) goto L1984; ! X3 = CONS( a1458, EMPTYLIST ); ! scrt6_format( TRUEVALUE, CONS( c1487, X3 ) ); X3 = SYMBOL_VALUE( initialize_2dcompile_v ); X3 = UNKNOWNCALL( X3, 0 ); VIA( PROCEDURE_CODE( X3 ) )( PROCEDURE_CLOSURE( X3 ) ); ! X3 = f1459; ! L1990: ! if ( EQ( UNSIGNED( X3 ), UNSIGNED( EMPTYLIST ) ) ) goto L1991; ! if ( EQ( TSCPTAG( X3 ), PAIRTAG ) ) goto L1995; scrt1__24__car_2derror( X3 ); ! L1995: X4 = PAIR_CAR( X3 ); X6 = scrt6_read( CONS( scrt5_open_2dinput_2dstring( X4 ), EMPTYLIST ) ); --- 713,783 ---- EXTERNTSCP( scrt2_zero_3f_v ); EXTERNINTP( rename ); ! TSCP main_do_2dc_2dflag( a1404, ! f1405, l1406, s1407, i1408 ) ! TSCP a1404, f1405, l1406, s1407, i1408; { TSCP X7, X6, X5, X4, X3, X2, X1; ! PUSHSTACKTRACE( U_TX( ADR( t1838 ) ) ); ! if ( AND( EQ( TSCPTAG( a1404 ), EXTENDEDTAG ), ! EQ( TSCP_EXTENDEDTAG( a1404 ), STRINGTAG ) ) ! ) goto L1841; ! scrt6_error( c1499, ! c1500, CONS( a1404, EMPTYLIST ) ); ! L1841: ! X2 = C_FIXED( STRING_LENGTH( a1404 ) ); if ( BITAND( BITOR( INT( X2 ), INT( _TSCP( 12 ) ) ), ! 3 ) ) goto L1844; X5 = _TSCP( IDIFFERENCE( INT( X2 ), INT( _TSCP( 12 ) ) ) ); ! goto L1845; ! L1844: X5 = scrt2__2d_2dtwo( X2, _TSCP( 12 ) ); ! L1845: if ( BITAND( BITOR( INT( _TSCP( 0 ) ), INT( X5 ) ), ! 3 ) ) goto L1847; ! if ( LTE( INT( _TSCP( 0 ) ), INT( X5 ) ) ) goto L1849; X4 = _TSCP( 0 ); ! goto L1848; ! L1849: X4 = X5; ! goto L1848; ! L1847: X4 = scrt2_max_2dtwo( _TSCP( 0 ), X5 ); ! L1848: ! X3 = scrt3_substring( a1404, _TSCP( 0 ), X4 ); ! X4 = CONS( c1482, EMPTYLIST ); X1 = scrt3_string_2dappend( CONS( X3, X4 ) ); if ( BITAND( BITOR( INT( X2 ), INT( _TSCP( 12 ) ) ), ! 3 ) ) goto L1854; ! if ( GT( INT( X2 ), INT( _TSCP( 12 ) ) ) ) goto L1858; ! POPSTACKTRACE( a1404 ); ! L1854: ! if ( TRUE( scrt2__3e_2dtwo( X2, _TSCP( 12 ) ) ) ) goto L1858; ! POPSTACKTRACE( a1404 ); ! L1858: if ( BITAND( BITOR( INT( X2 ), INT( _TSCP( 12 ) ) ), ! 3 ) ) goto L1863; X4 = _TSCP( IDIFFERENCE( INT( X2 ), INT( _TSCP( 12 ) ) ) ); ! goto L1864; ! L1863: X4 = scrt2__2d_2dtwo( X2, _TSCP( 12 ) ); ! L1864: ! X3 = scrt3_substring( a1404, X4, X2 ); ! if ( FALSE( scrt3_string_3d_3f( X3, c1432 ) ) ) goto L1861; ! X3 = CONS( a1404, EMPTYLIST ); ! scrt6_format( TRUEVALUE, CONS( c1434, X3 ) ); X3 = SYMBOL_VALUE( initialize_2dcompile_v ); X3 = UNKNOWNCALL( X3, 0 ); VIA( PROCEDURE_CODE( X3 ) )( PROCEDURE_CLOSURE( X3 ) ); ! X3 = f1405; ! L1867: ! if ( EQ( UNSIGNED( X3 ), UNSIGNED( EMPTYLIST ) ) ) goto L1868; ! if ( EQ( TSCPTAG( X3 ), PAIRTAG ) ) goto L1872; scrt1__24__car_2derror( X3 ); ! L1872: X4 = PAIR_CAR( X3 ); X6 = scrt6_read( CONS( scrt5_open_2dinput_2dstring( X4 ), EMPTYLIST ) ); *************** *** 883,927 **** X5 = UNKNOWNCALL( X5, 1 ); VIA( PROCEDURE_CODE( X5 ) )( X6, PROCEDURE_CLOSURE( X5 ) ); X3 = PAIR_CDR( X3 ); ! goto L1990; ! L1991: SETGENTL( SYMBOL_VALUE( sc_2dinclude_2ddirs_v ), main_include_2ddirs_v ); ! X4 = scrt5_open_2dinput_2dfile( a1458 ); X3 = sc_cons( X4, EMPTYLIST ); SETGENTL( SYMBOL_VALUE( sc_2dinput_v ), X3 ); ! SETGENTL( SYMBOL_VALUE( sc_2dsource_2dname_v ), a1458 ); SETGENTL( SYMBOL_VALUE( sc_2dicode_v ), scrt5_open_2doutput_2dfile( main_sc_2dto_2dc_2ec_v ) ); SETGENTL( SYMBOL_VALUE( sc_2derror_v ), scrt5_stderr_2dport_v ); ! SETGENTL( SYMBOL_VALUE( sc_2dlog_v ), l1460 ); ! SETGENTL( SYMBOL_VALUE( sc_2dstack_2dtrace_v ), s1461 ); ! SETGENTL( SYMBOL_VALUE( sc_2dinterpreter_v ), i1462 ); X3 = SYMBOL_VALUE( docompile_v ); X3 = UNKNOWNCALL( X3, 0 ); VIA( PROCEDURE_CODE( X3 ) )( PROCEDURE_CLOSURE( X3 ) ); X3 = SYMBOL_VALUE( sc_2derror_2dcnt_v ); ! if ( NEQ( TSCPTAG( X3 ), FIXNUMTAG ) ) goto L2002; ! if ( NEQ( UNSIGNED( X3 ), UNSIGNED( _TSCP( 0 ) ) ) ) goto L2006; ! goto L2009; ! L2002: ! if ( TRUE( scrt2_zero_3f( X3 ) ) ) goto L2009; ! L2006: X4 = scrt6_reset_v; X4 = UNKNOWNCALL( X4, 0 ); VIA( PROCEDURE_CODE( X4 ) )( PROCEDURE_CLOSURE( X4 ) ); ! L2009: X3 = SYMBOL_VALUE( module_2dname_v ); main_module_2dnames_v = sc_cons( X3, main_module_2dnames_v ); X3 = SYMBOL_VALUE( close_2dsc_2dfiles_v ); X3 = UNKNOWNCALL( X3, 0 ); VIA( PROCEDURE_CODE( X3 ) )( PROCEDURE_CLOSURE( X3 ) ); rename( TSCP_POINTER( main_sc_2dto_2dc_2ec_v ), TSCP_POINTER( X1 ) ); POPSTACKTRACE( X1 ); ! L1984: ! POPSTACKTRACE( a1458 ); } void main__init(){} --- 785,830 ---- X5 = UNKNOWNCALL( X5, 1 ); VIA( PROCEDURE_CODE( X5 ) )( X6, PROCEDURE_CLOSURE( X5 ) ); X3 = PAIR_CDR( X3 ); ! goto L1867; ! L1868: SETGENTL( SYMBOL_VALUE( sc_2dinclude_2ddirs_v ), main_include_2ddirs_v ); ! X4 = scrt5_open_2dinput_2dfile( a1404 ); X3 = sc_cons( X4, EMPTYLIST ); SETGENTL( SYMBOL_VALUE( sc_2dinput_v ), X3 ); ! SETGENTL( SYMBOL_VALUE( sc_2dsource_2dname_v ), a1404 ); SETGENTL( SYMBOL_VALUE( sc_2dicode_v ), scrt5_open_2doutput_2dfile( main_sc_2dto_2dc_2ec_v ) ); SETGENTL( SYMBOL_VALUE( sc_2derror_v ), scrt5_stderr_2dport_v ); ! SETGENTL( SYMBOL_VALUE( sc_2dlog_v ), l1406 ); ! SETGENTL( SYMBOL_VALUE( sc_2dstack_2dtrace_v ), s1407 ); ! SETGENTL( SYMBOL_VALUE( sc_2dinterpreter_v ), i1408 ); X3 = SYMBOL_VALUE( docompile_v ); X3 = UNKNOWNCALL( X3, 0 ); VIA( PROCEDURE_CODE( X3 ) )( PROCEDURE_CLOSURE( X3 ) ); X3 = SYMBOL_VALUE( sc_2derror_2dcnt_v ); ! if ( NEQ( TSCPTAG( X3 ), FIXNUMTAG ) ) goto L1879; ! if ( NEQ( UNSIGNED( X3 ), UNSIGNED( _TSCP( 0 ) ) ) ) goto L1883; ! goto L1886; ! L1879: ! if ( TRUE( scrt2_zero_3f( X3 ) ) ) goto L1886; ! L1883: X4 = scrt6_reset_v; X4 = UNKNOWNCALL( X4, 0 ); VIA( PROCEDURE_CODE( X4 ) )( PROCEDURE_CLOSURE( X4 ) ); ! L1886: X3 = SYMBOL_VALUE( module_2dname_v ); main_module_2dnames_v = sc_cons( X3, main_module_2dnames_v ); X3 = SYMBOL_VALUE( close_2dsc_2dfiles_v ); X3 = UNKNOWNCALL( X3, 0 ); VIA( PROCEDURE_CODE( X3 ) )( PROCEDURE_CLOSURE( X3 ) ); + unlink( TSCP_POINTER( X1 ) ); rename( TSCP_POINTER( main_sc_2dto_2dc_2ec_v ), TSCP_POINTER( X1 ) ); POPSTACKTRACE( X1 ); ! L1861: ! POPSTACKTRACE( a1404 ); } void main__init(){} *************** *** 929,938 **** static void init_modules( compiler_version ) char *compiler_version; { scrt5__init(); scrt3__init(); scrt6__init(); - scrt2__init(); scrt1__init(); screp__init(); callcode__init(); --- 832,841 ---- static void init_modules( compiler_version ) char *compiler_version; { + scrt2__init(); scrt5__init(); scrt3__init(); scrt6__init(); scrt1__init(); screp__init(); callcode__init(); *************** *** 961,1000 **** INITHEAP( 0, argc, argv, main_configure ); init_constants(); init_modules( "(main SCHEME->C COMPILER 28sep90jfb)" ); ! INITIALIZEVAR( U_TX( ADR( t1716 ) ), ADR( main_scc_2dversion_v ), c1013 ); ! INITIALIZEVAR( U_TX( ADR( t1717 ) ), ADR( main_force_2dld_2dof_2drep_v ), screp_read_2deval_2dprint_v ); ! INITIALIZEVAR( U_TX( ADR( t1718 ) ), ADR( main_sc_2dto_2dc_2ec_v ), c1016 ); ! INITIALIZEVAR( U_TX( ADR( t1719 ) ), ADR( main_sc_2dto_2dc_2eo_v ), c1018 ); ! INITIALIZEVAR( U_TX( ADR( t1720 ) ), ADR( main_predef_2ddefault_v ), c1020 ); ! INITIALIZEVAR( U_TX( ADR( t1721 ) ), ADR( main_c_2dinclude_2dfile_v ), c1022 ); ! INITIALIZEVAR( U_TX( ADR( t1722 ) ), ADR( main_c_2dinclude_2ddir_v ), c1024 ); ! INITIALIZEVAR( U_TX( ADR( t1723 ) ), ADR( main_sc_2dlibrary_v ), c1026 ); ! INITIALIZEVAR( U_TX( ADR( t1724 ) ), ! ADR( main_sc_2dlibrary__p_v ), c1026 ); ! INITIALIZEVAR( U_TX( ADR( t1725 ) ), ADR( main_sc_2dprocessor_v ), c1029 ); ! INITIALIZEVAR( U_TX( ADR( t1726 ) ), ADR( main_configure_v ), MAKEPROCEDURE( 1, 0, main_configure, EMPTYLIST ) ); ! INITIALIZEVAR( U_TX( ADR( t1784 ) ), ADR( main_module_2dnames_v ), EMPTYLIST ); ! INITIALIZEVAR( U_TX( ADR( t1785 ) ), ! ADR( main_include_2ddirs_v ), c1125 ); ! INITIALIZEVAR( U_TX( ADR( t1786 ) ), ADR( main_scc_v ), MAKEPROCEDURE( 1, 0, main_scc, EMPTYLIST ) ); ! INITIALIZEVAR( U_TX( ADR( t1961 ) ), ADR( main_do_2dc_2dflag_v ), MAKEPROCEDURE( 5, 0, --- 864,904 ---- INITHEAP( 0, argc, argv, main_configure ); init_constants(); init_modules( "(main SCHEME->C COMPILER 28sep90jfb)" ); ! INITIALIZEVAR( U_TX( ADR( t1639 ) ), ADR( main_scc_2dversion_v ), c1013 ); ! INITIALIZEVAR( U_TX( ADR( t1640 ) ), ADR( main_force_2dld_2dof_2drep_v ), screp_read_2deval_2dprint_v ); ! INITIALIZEVAR( U_TX( ADR( t1641 ) ), ADR( main_sc_2dto_2dc_2ec_v ), c1016 ); ! INITIALIZEVAR( U_TX( ADR( t1642 ) ), ADR( main_sc_2dto_2dc_2eo_v ), c1018 ); ! INITIALIZEVAR( U_TX( ADR( t1643 ) ), ADR( main_predef_2ddefault_v ), c1020 ); ! INITIALIZEVAR( U_TX( ADR( t1644 ) ), ADR( main_c_2dinclude_2dfile_v ), c1022 ); ! INITIALIZEVAR( U_TX( ADR( t1645 ) ), ADR( main_c_2dinclude_2ddir_v ), c1024 ); ! INITIALIZEVAR( U_TX( ADR( t1646 ) ), ADR( main_sc_2dlibrary_v ), c1026 ); ! INITIALIZEVAR( U_TX( ADR( t1647 ) ), ! ADR( main_sc_2dlibrary__p_v ), ! sc_emptystring ); ! INITIALIZEVAR( U_TX( ADR( t1648 ) ), ADR( main_sc_2dprocessor_v ), c1029 ); ! INITIALIZEVAR( U_TX( ADR( t1649 ) ), ADR( main_configure_v ), MAKEPROCEDURE( 1, 0, main_configure, EMPTYLIST ) ); ! INITIALIZEVAR( U_TX( ADR( t1651 ) ), ADR( main_module_2dnames_v ), EMPTYLIST ); ! INITIALIZEVAR( U_TX( ADR( t1652 ) ), ! ADR( main_include_2ddirs_v ), c1037 ); ! INITIALIZEVAR( U_TX( ADR( t1653 ) ), ADR( main_scc_v ), MAKEPROCEDURE( 1, 0, main_scc, EMPTYLIST ) ); ! INITIALIZEVAR( U_TX( ADR( t1838 ) ), ADR( main_do_2dc_2dflag_v ), MAKEPROCEDURE( 5, 0, diff -r -c -N ../orig/scsc/main.sc ./scsc/main.sc *** ../orig/scsc/main.sc Fri Sep 21 11:42:19 1990 --- ./scsc/main.sc Mon Oct 7 14:32:14 1991 *************** *** 81,87 **** ;;; The following top-level variables define the implementation dependent ;;; information: ! (define PREDEF-DEFAULT "/udir/bartlett/scheme/scrt/predef.sc") ; File holding the declarations for predefined ; functions. --- 81,87 ---- ;;; The following top-level variables define the implementation dependent ;;; information: ! (define PREDEF-DEFAULT "include:sc/predef.sc") ; File holding the declarations for predefined ; functions. *************** *** 88,104 **** (define C-INCLUDE-FILE "objects.h") ; #include file for the predefined functions. ! (define C-INCLUDE-DIR "/udir/bartlett/scheme/scrt") ; directory containing #include file for ; predefined functions. ! (define SC-LIBRARY "/udir/bartlett/scheme/scrt/libsc.a") ; Scheme->C library file. ! (define SC-LIBRARY_P "/udir/bartlett/scheme/scrt/libsc.a") ; Scheme->C profiled library file. ! (define SC-PROCESSOR "TITAN") ; Processor type. ;;; The compiler is "configured" and the heap image is saved by the following ;;; function. It will set the previously defined variables to the values --- 88,104 ---- (define C-INCLUDE-FILE "objects.h") ; #include file for the predefined functions. ! (define C-INCLUDE-DIR "include:sc") ; directory containing #include file for ; predefined functions. ! (define SC-LIBRARY "lib:sc.lib") ; Scheme->C library file. ! (define SC-LIBRARY_P "") ; Scheme->C profiled library file. ! (define SC-PROCESSOR "Amiga") ; Processor type. ;;; The compiler is "configured" and the heap image is saved by the following ;;; function. It will set the previously defined variables to the values *************** *** 107,135 **** ;;; compiler. (define (CONFIGURE clargs) - (when (= (length clargs) 1) - (display - "sccomp ") - (newline) - (exit)) - (set! predef-default (list-ref clargs 1)) - (let* ((c-include (list-ref clargs 2)) - (c-include-len (string-length c-include))) - (let loop ((i (- c-include-len 1))) - (cond ((<= i 0) - (error 'CONFIGURE - "c-include filename must include directory path: ~s" - c-include)) - ((equal? (string-ref c-include i) #\/) - (set! c-include-dir (substring c-include 0 i)) - (set! c-include-file - (substring c-include (+ i 1) c-include-len))) - (else (loop (- i 1)))))) - (set! sc-library (list-ref clargs 3)) - (set! sc-library_p (list-ref clargs 4)) - (set! sc-processor (list-ref clargs 5)) (initialize-compile) ! (save-heap (list-ref clargs 6) scc)) ;;; When the compiler is invoked directly from the shell, the following ;;; function is invoked to control compilation. It will interprete the flags, --- 107,114 ---- ;;; compiler. (define (CONFIGURE clargs) (initialize-compile) ! (scc clargs)) ;;; When the compiler is invoked directly from the shell, the following ;;; function is invoked to control compilation. It will interprete the flags, *************** *** 197,208 **** (define (SCC clargs) (let ((flags '()) (interpreter #f) ! (library `(,sc-library "-lm")) (strace #t) (c-only #f) (c-flags '()) (log '()) ! (cc "cc")) ;;; 1. Pick up the command line arguments. --- 176,187 ---- (define (SCC clargs) (let ((flags '()) (interpreter #f) ! (library `(,sc-library)) (strace #t) (c-only #f) (c-flags '()) (log '()) ! (cc "lc")) ;;; 1. Pick up the command line arguments. *************** *** 267,276 **** (cons "(define-constant *fixed-only* #t)" flags)) (loop (cdr args))) ! ((equal? arg "-pg") ! (set! library `(,sc-library_p "-lm")) ! (set! c-flags (cons arg c-flags)) ! (loop (cdr args))) ((equal? arg "-C") (set! c-only #t) (loop (cdr args))) --- 246,255 ---- (cons "(define-constant *fixed-only* #t)" flags)) (loop (cdr args))) ! ;; ((equal? arg "-pg") ! ;; (set! library `(,sc-library_p)) ! ;; (set! c-flags (cons arg c-flags)) ! ;; (loop (cdr args))) ((equal? arg "-C") (set! c-only #t) (loop (cdr args))) *************** *** 310,316 **** (format fh " SCHEMEEXIT();~%") (format fh "}~%") (close-output-port fh) ! (set! c-flags (append c-flags (list sc-to-c.c))))) ;;; 4. Flags processed and all .sc -> .c compiles done. Invoke the ;;; C compiler to do the rest. --- 289,295 ---- (format fh " SCHEMEEXIT();~%") (format fh "}~%") (close-output-port fh) ! (set! c-flags (cons sc-to-c.c c-flags)))) ;;; 4. Flags processed and all .sc -> .c compiles done. Invoke the ;;; C compiler to do the rest. *************** *** 317,328 **** (unless (eq? 0 (system (apply string-append ! `(,cc " -D" ,sc-processor ! " -I" ,c-include-dir ,@(map (lambda (x) (string-append " " x)) ! (append (reverse c-flags) ! library)))))) (reset)) (unlink sc-to-c.c) (unlink sc-to-c.o))) --- 296,310 ---- (unless (eq? 0 (system (apply string-append ! `(,cc " -csu -f8 -b0 -r0 -C -d" ,sc-processor ! " -i" ,c-include-dir ! " -Lm" ! ,@(map (lambda (x) ! (string-append "+" x)) ! library) ,@(map (lambda (x) (string-append " " x)) ! (append (reverse c-flags))))))) (reset)) (unlink sc-to-c.c) (unlink sc-to-c.o))) *************** *** 362,367 **** --- 344,350 ---- (if (not (zero? sc-error-cnt)) (reset)) (set! module-names (cons module-name module-names)) (close-sc-files) + (unlink root.c) (rename sc-to-c.c root.c) root.c) ;;; Pass argument to C. \End\Of\Shar\ else echo "will not over write ./Amiga-28sep90.patches" fi if `test ! -s ./build.rexx` then echo "writing ./build.rexx" cat > ./build.rexx << '\End\Of\Shar\' /* * A hack to make building other programs easier, by extracting the * commands needed to build the file from it's source. * * build [name NAME] [flags COMMAND=FLAGS ...] [file] FILE [FILE ...] * * Name defaults to "build". Flags causes the following arguments to be parsed * for extra flags to be added to each COMMAND. All input FILEs are scanned * for build lines to be issued to the system. If flags is present, file is * required. * * In scanning a file, build ignores all lines until it sees a line containing * the string "===NAME", for whatever value name has, defaulting to build. All * lines following are then processed until a line containing "===endNAME" is * encountered. Delimiter and control are set by parsing the line ===NAME line * as '===NAME delimiter DELIMITER control CONTROL' * * In processing the build lines, two tokens have special significance. They * are called delimiter and control, and are normally '%' and ';'. The line is * first split on the control character, into the front and back halves. If * there is a delimiter in the front half, any text preceding it is discarded. * If there is a delimiter in the back half, any text following it is discarded. * * The front half is treated as a command to be issued to the system. If the * first word of the front half is matched by a the command part of a flags * argument, then the flags part of that argument is inserted into the command * after the first word. I.e. the command issued is "command FLAGS rest of line". * The back half of the command is then checked, and the above comamnd is issued * if it is called for. * * The back half is assumed to be of the form 'output= FILE input= FILE ...'. * If any of the input files are newer than the output file, then the command * in the front half will be executed. If either input or output keywords are * missing, the command is always issued. * * As a convenience, if the back half of a line is empty, then it will be * executed if the previous command was executed. */ /* Get the support code */ if ~show('Libraries', 'rexxsupport.library') then do if ~addlib('rexxsupport.library', 0, -30) then do say "Can't open rexxsupport.library!" exit end end flags. = '' flags = 0 name = 'build' files = '' /* Parse them arguments */ args = arg(1) do i = 1 to words(args) select when upper(word(args, i)) = 'NAME' then do flags = 0 i = i + 1 name = word(args, i) end when upper(word(args, i)) = 'FILE' then do flags = 0 i = i + 1 files = word(args, i) end when upper(word(args, i)) = 'FLAGS' then flags = 1 when flags then do parse value word(args, i) with command '=' flag if flag = '' then flags.currentcommand = flags.currentcommand word(args, i) else do currentcommand = command flags.command = flag end end otherwise files = files word(args, i) end end /* * loop over the file names. */ files = expand(files) do i = 1 to words(files) call buildfile(word(files, i), name) end exit 0 /* * Scan a file, looking for the build instructions. */ buildfile: procedure expose flags. parse arg file, name delim = '%' control = ';' if ~open(input, file) then do say "Can't open file" file return 10 end /* Search for the section with command in it */ search = '==='upper(name) do until index(upper(line), search) ~= 0 if eof(input) then do say "No actions found for" name "in file" file return 5 end line = readln(input) end /* Check for control/delimter settings */ parse var line 'control' new . if new ~= '' then control = new parse var line 'delimiter' new . if new ~= '' then delimiter = new /* Process the command lines */ search = '===END'upper(name) line = readln(input) do while index(upper(line), search) = 0 parse var line command (control) files /* Check files section */ parse var files files (delim) parse var files "output=" outfile "input=" infiles if outfile = "" | infiles = "" then docommand = 1 else do instamp = makestamp(strip(outfile)) docommand = 0 do i = 1 to words(infiles) if instamp < makestamp(word(infiles, i)) then do docommand = 1 leave end end end /* Build command to execute */ parse var command (delim) new flags if new ~= "" then command = new else parse var command command flags if command ~= "" & docommand then do say command flags address command command flags.command flags if rc ~= 0 then exit rc end line = readln(input) if eof(input) then do say "No end to build section" exit 10 end end call close input return 0 /* Get a files creation date as a numeric string */ makestamp: procedure arg filename parse value statef(filename) with . . . . d m t . return right(d, 4, 0) || right(m, 4, 0) || right(t, 4, 0) \End\Of\Shar\ else echo "will not over write ./build.rexx" fi echo "Finished archive 1 of 1" exit