#!/bin/sh # to extract, remove the header and type "sh filename" if `test ! -d ./amiga` then mkdir ./amiga echo "mkdir ./amiga" fi echo "writing ./amiga/AMIGA.Readme" cat > ./amiga/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 ******** System Requirements 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 on gatekeeper.pa.dec.com. The interpreter (sci) should run on a 1.5 Meg system, and the compiler (scc) on a 2 Meg system, if the ram is all FAST. 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 5 meg of ram to rebuild the system from scratch, and possibly more. I recommend that much fast, but the heap expansion may make it work with part of that being CHIP. Building the System First get a copy of the 01nov91 release of Scheme->C, and extract it as instructed. Then extract this shar file in the top-level directory created by Scheme->C (the directory that contains subdirectories scrt and scsc). You want to turn on the script bit for scrt/from#? and scsc/from#?, as shar doesn't seem to preserve it. Next, apply the patches in amiga/01nov91.patches. If you are running 1.3, edit the select function near 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. You are now ready to build the system. To build form C sources - required for the first build - cd into scrt, run sascoptions to set the processor types correctly (the default is 68030/68881), and execute the script "fromc". This will recompile the scheme interpreter and run-time library. Next, cd into /scsc, run sascoptions if needed, and execute the script "fromc" there. This builds the compiler as Xscc. From scrt, you should install sc.lib in lib:, predefs.sc and objects.h in include:sc, and sci somewhere in your path. From scsc, install Xscc as scc in somewhere in your path. At this point, the Rexx script build can be used to rebuild the entire system from scheme by using it on the "fromsc" file in scrt and then in scsc . Build is a rexx script in the amiga 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. If you don't have rexx, edit the "fromsc" scripts to change the "build fromc" line to "execute fromc". Changes for the Amiga Links and a standard make are missing from AmigaDOS, so the organization that allowed for building 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. 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 on the Amiga, so the rusage-related functions are missing. OPEN-INPUT-PROCESS, OPEN-OUTPUT-PROCESS and OPEN-PROCESS are implemented with Per Bojsen's APIPE: device, and the restrictions on it apply to the commands passed to those functions. This device requires 2.0. If you don't have it, you'll get a requester asking for the volume APIPE: to be mounted if those functions are called. Cancel this and the the system will drop into the scheme error handler with a failure from POPEN. 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" compiler 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. Of Heaps and Things With the 01nov91 release, Scheme->C has the ability to dynamically increase the heap size. This is a godsend for the Amiga. I've changed the code slightly; rather than failing to expand the heap if it can't allocate as much heap as it asks for, it trys to allocate as much FAST as it can reasonably get. The algorithm for heap growth is straightforward - each time the heap grows, it tries to grow by the smallest of the current heap size, the amount needed to get to the maximum heap size, or one-quarter of the maximum heap size. Should that fail, it checks to see if there is a contiguous piece of fast larger than 1MB, and allocates all but the last 1/2MB of that. Otherwise, the expand fails, and it won't try again. The heap has a set of "side tables" that are used to for bookeeping purposes. This table has an entry for *all* pages between the lowest and highest page of the heap (even if that memory belongs to another process), which can create some problems on the Amiga. When the heap is expanded, new side tables are allocated, and the old side tables are added to the heap - which may force another round of the above, but usually doesn't. The side tables have important implications for machines whose primary memory pool is outside the 16MB address space of the 68000 (i.e. - the A3000, and possibly other accellerated machines). Since they describe all memory between the lowest and highest addresses, trying to add heap memory from CHIP ram causes a side table allocation to cover all most of the memory in between the old heap and CHIP - on the A3000, this table is around 4meg in size. Since the system only uses CHIP when it can't find FAST, that allocation usually fails. Under those conditions, the CHIP allocation (usually a megabyte or more!) is kept, but not used. Given all the above, there are a number of strategies for for dealing with heap expansion. The A3000 is probably the only machine that has to worry about them; most other machines either don't have more than a meg of CHIP ram, or don't have any RAM outside the 68000 space. If you have machine that meets both conditions, you'll want to pay attention now. Strategy one: paranoid. Don't set maxheap at all, and don't allow the heap to expand. Once Scheme->C starts, it won't try and allocate any more memory, so you can ignore all this. This is fine if you've got enough RAM to allocate everything you're liable to need in the initial contiguous piece. Strategy two: authers intent. Set the initial heap to something you're willing to give up everytime you run Scheme->C and usually have available in a contiguous piece, and maxheap to as much fast as you're willing to ever let Scheme->C use. This risks grabbing CHIP ram, with the problems described above. Other than that, it's probably the best bet. Note that setting the initial heap to 1 can also suffer from excessive garbage collection. Strategy three: grab it all. Set the initial heap to something you're sure you can get at startup, and preferably bigger than all of CHIP. The more the better. Set the maximum heap to at least four times that size. The heap will expand by grabbing most of each contiguous piece of FAST every time it expands. It leave 512K of each piece, to insure that there's always enough fast for side tables on a 16 meg system. With this, you can get more heap than paranoid, and should never grab CHIP ram for the heap (it's unlikely, but not impossible). Strategy four: slow growth. Set the initial heap to 1 meg (bare minimum), and the maximum heap to the size of total RAM or four times as much CHIP as you have, whichever is larger. This uses less RAM than grab it all until you expand, and may be able to get more total, but spends a a dispraportionate amount of time garbage collecting, as you have to collect to trigger an expansion. I don't have a lot of experience with these yet. If you have a better idea, or an insight, please let me know. Thanx, ./amiga/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\ echo "writing ./amiga/01nov91.patches" cat > ./amiga/01nov91.patches << '\End\Of\Shar\' Only in .: Amiga-patches Only in ../orig: CHANGES Only in ../orig: MIPS Only in ../orig: README Only in ../orig: VAX Only in .: amiga Only in ../orig: cdecl Only in ../orig: doc Only in ../orig: gnuemacs Only in ../orig: makefile Only in ./scrt: SASCOPTS diff -r -c ../orig/scrt/apply.h ./scrt/apply.h *** ../orig/scrt/apply.h Tue Oct 15 11:07:03 1991 --- ./scrt/apply.h Thu Oct 24 16:35:18 1991 *************** *** 68,73 **** --- 68,80 ---- of one's C compiler. */ #endif + #ifdef AMIGA + #define MAXARGS 25 /* Maximum number of required arguments permitted. + Note that this does not preclude an optional + argument list as an additional argument. This + number is typically determined by the ability + of one's C compiler. */ + #endif extern int sc_unknownargc; /* Data structures for sc_unknowncall */ extern TSCP sc_unknownproc[ 4 ]; diff -r -c ../orig/scrt/cio.c ./scrt/cio.c *** ../orig/scrt/cio.c Tue Oct 15 11:54:19 1991 --- ./scrt/cio.c Thu Oct 24 20:45:52 1991 *************** *** 42,49 **** --- 42,58 ---- /* 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 + #include + #endif + #include "objects.h" int sc_libc_eof = EOF; *************** *** 89,100 **** --- 98,117 ---- { int readfds, nfound; struct timeval timeout; + #ifdef AMIGA + extern struct UFB _ufbs[]; + #endif if (((stream)->_cnt) <= 0) { + #ifdef AMIGA + nfound = (!IsInteractive(_ufbs[fileno(stream)].ufbfh)) ? 1 + : WaitForChar(_ufbs[fileno(stream)].ufbfh, 0); + #else readfds = 1<<(fileno( stream )); timeout.tv_sec = 0; timeout.tv_usec = 0; nfound = select( fileno( stream )+1, &readfds, 0, 0, &timeout ); + #endif if (nfound == 0) return( 0 ); } return( 1 ); *************** *** 112,114 **** --- 129,177 ---- 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) ; + } + /* pope/pclose - for now, just punt */ + FILE * + popen(char *c, char *t) { + int size ; + char *tmp ; + FILE *out ; + + if ((tmp = AllocMem(size = strlen(c) + 6, 0)) == NULL) + sc_error("POPEN", "Unable to allocate scratch memory", 0 ); + sprintf(tmp, "APIPE:%s", c) ; + out = fopen(tmp, t) ; + FreeMem(tmp, size) ; + return out ; + } + + int + pclose(FILE *f) { + + return fclose(f) ; + } + #endif Only in ./scrt: fromc Only in ./scrt: fromsc diff -r -c ../orig/scrt/heap.c ./scrt/heap.c *** ../orig/scrt/heap.c Mon Oct 21 18:39:08 1991 --- ./scrt/heap.c Thu Oct 24 16:35:28 1991 *************** *** 98,107 **** int sc_gcinfo; /* controls logging */ static struct rusage gcru, /* resource consumption during collection */ startru, stopru; ! static int sc_newlist; /* list of newly allocated pages */ int *sc_stackbase; /* pointer to base of the stack */ --- 98,108 ---- int sc_gcinfo; /* controls logging */ + #ifndef NO_RUSAGE static struct rusage gcru, /* resource consumption during collection */ startru, stopru; ! #endif static int sc_newlist; /* list of newly allocated pages */ int *sc_stackbase; /* pointer to base of the stack */ *************** *** 141,146 **** --- 142,151 ---- if (tail == page) tail = 0; \ } + #ifdef NO_RUSAGE + #define getrusage(x,y) /* no operation */ + #define updategcru() /* no operation */ + #else /* The following function converts a rusage structure into an 18 word Scheme vector composed of the same items. */ *************** *** 270,275 **** --- 275,281 ---- { return( rusagevector( &gcru ) ); } + #endif /* Errors detected during garbage collection are logged by the following procedure. If any errors occur, the program will abort after logging *************** *** 432,437 **** --- 438,471 ---- } #endif MIPS + #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 = (int *) STACKPTR; /* This gets 15 */ + while (pp != sc_stackbase) + move_continuation_ptr( *pp++ ); + } + #endif /* The size of an extended object in words is returned by the following function. *************** *** 1396,1401 **** --- 1430,1441 ---- getrusage( 0, &stopru ); updategcru(); if (sc_gcinfo) { + #ifdef NO_RUSAGE + fprintf( stderr, + " %d%% locked %d%% retained", + (sc_lockcnt*100)/sc_heappages, + (sc_generationpages*100)/sc_heappages ); + #else fprintf( stderr, " %d%% locked %d%% retained %d user ms", (sc_lockcnt*100)/sc_heappages, *************** *** 1405,1410 **** --- 1445,1451 ---- " %d system ms %d page faults\n", stopru.ru_stime.tv_sec*1000+stopru.ru_stime.tv_usec/1000, stopru.ru_majflt ); + #endif } if (sc_gcinfo == 2) { /* Perform additional consistency checks */ diff -r -c ../orig/scrt/heap.h ./scrt/heap.h *** ../orig/scrt/heap.h Tue Oct 15 11:07:11 1991 --- ./scrt/heap.h Thu Oct 24 16:35:36 1991 *************** *** 43,50 **** --- 43,52 ---- #ifndef rusage #include + #ifndef NO_RUSAGE #include #endif + #endif /* This module implements the object storage storage system for SCHEME->C. *************** *** 333,338 **** --- 335,345 ---- #ifdef VAX #define STACKPTR sc_processor_register( 14 ) + #endif + + #ifdef AMIGA + #include + #define STACKPTR getreg(15) #endif /* Some objects require cleanup actions when they are freed. For example, diff -r -c ../orig/scrt/objects.c ./scrt/objects.c *** ../orig/scrt/objects.c Tue Oct 15 11:54:19 1991 --- ./scrt/objects.c Thu Oct 24 16:35:44 1991 *************** *** 51,57 **** --- 51,61 ---- #include "cio.h" #include + #ifdef AMIGA + #define bcopy(f, t, n) memcpy(t, f, n) + #else extern int bcopy(); + #endif extern TSCP scrt1_reverse(); diff -r -c ../orig/scrt/objects.h ./scrt/objects.h *** ../orig/scrt/objects.h Tue Oct 15 11:07:17 1991 --- ./scrt/objects.h Thu Oct 24 16:35:47 1991 *************** *** 67,72 **** --- 67,81 ---- #endif #endif + #ifdef AMIGA + #define NO_RUSAGE + #define BIGENDIAN + #undef DOUBLE_ALIGN + #undef SHORTFLOAT + #undef MATHTRAPS + #define MATHTRAPS 0 + #endif + /* If BIGENDIAN is defined, then architecture is big endian, otherwise it is little endian. UNSIGNED_FIELDSx defines bit fields in 32-bit words from least signigicant to most significant bits. *************** *** 118,123 **** --- 127,141 ---- #define CPUTYPE VAX #endif + #ifdef AMIGA + #include + typedef jmp_buf sc_jmp_buf; + #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 *************** *** 744,749 **** --- 762,770 ---- #ifndef VECTOR_ELEMENT #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) *************** *** 795,845 **** #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 EXTERNARRAY( 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 --- 816,866 ---- #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 EXTERNARRAY( 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 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 *************** *** 869,877 **** #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) --- 890,898 ---- #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) *************** *** 880,885 **** --- 901,914 ---- #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) *************** *** 944,951 **** #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 ))) --- 973,980 ---- #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 ../orig/scrt/scinit.c ./scrt/scinit.c *** ../orig/scrt/scinit.c Tue Oct 22 13:48:29 1991 --- ./scrt/scinit.c Thu Oct 24 16:35:52 1991 *************** *** 52,61 **** --- 52,70 ---- extern errno; /* C-library Error flag */ + #ifdef AMIGA + #include + #include + #include + #include + #include + #include + #else #include #include #include #include + #endif #include /* Definitions for objects within sc */ *************** *** 72,78 **** --- 81,94 ---- extern TSCP scrt1_reverse(); extern TSCP scrt6_error(); + #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 */ #ifdef BIGMIPS *************** *** 202,207 **** --- 218,224 ---- static init_procs() { + #ifndef NO_RUSAGE INITIALIZEVAR( U_TX( ADR( t1030 ) ), ADR( sc_my_2drusage_v ), MAKEPROCEDURE( 0, *************** *** 211,216 **** --- 228,234 ---- MAKEPROCEDURE( 0, 0, sc_collect_2drusage, EMPTYLIST ) ); + #endif INITIALIZEVAR( U_TX( ADR( t1034 ) ), ADR( sc_collect_v ), MAKEPROCEDURE( 0, *************** *** 284,290 **** /* Memory is allocated from the heap by calling the following function with a byte count. It returns a pointer to the space. Errors occurring during initialization will cause the program to abort. Later errors will ! return -1 as the procedure's value. Storage is allocated on PAGEBYTE boundaries and counts are rounded up to full pages. */ --- 302,308 ---- /* Memory is allocated from the heap by calling the following function with a byte count. It returns a pointer to the space. Errors occurring during initialization will cause the program to abort. Later errors will ! return NULL as the procedure's value. Storage is allocated on PAGEBYTE boundaries and counts are rounded up to full pages. */ *************** *** 293,303 **** --- 311,325 ---- { char *memp; + #ifdef AMIGA + memp = sbrk( bytes + PAGEBYTES - 1 ); + #else memp = sbrk( 0 ); if ((int)memp & (PAGEBYTES-1)) sbrk( PAGEBYTES-(int)memp & (PAGEBYTES-1) ); bytes = (bytes+PAGEBYTES-1) & ~(PAGEBYTES-1); memp = sbrk( bytes ); + #endif if ((int)memp == -1) { memp = NULL; expandfailed = 1; *************** *** 307,312 **** --- 329,337 ---- exit( 1 ); } } + #ifdef AMIGA + else memp = (char *) ((PAGEBYTES + (int) memp) & ~(PAGEBYTES - 1)); + #endif if (sc_gcinfo > 1) fprintf( stderr, "***** Memory %x %x\n", memp, memp+bytes-1 ); return( memp ); *************** *** 509,515 **** { int old_pages = sc_heappages, /* Existing heap size */ add_pages = sc_heappages; /* # of pages to add */ ! char *msgheader; if ((sc_collecting == 0) || (sc_collecting && sc_gcinfo == 0)) msgheader = "\n***** COLLECT "; --- 534,540 ---- { int old_pages = sc_heappages, /* Existing heap size */ add_pages = sc_heappages; /* # of pages to add */ ! char *msgheader, *newmem; if ((sc_collecting == 0) || (sc_collecting && sc_gcinfo == 0)) msgheader = "\n***** COLLECT "; *************** *** 529,535 **** add_pages = (sc_maxheappages*25)/100; if (sc_gcinfo) fprintf( stderr, "%sheap expanded to ", msgheader ); ! addrtoheap( getmem( add_pages*PAGEBYTES ), add_pages*PAGEBYTES ); if (sc_gcinfo) fprintf( stderr, "%d MB\n", (sc_heappages*PAGEBYTES+ONEMB/2)/ONEMB ); --- 554,570 ---- add_pages = (sc_maxheappages*25)/100; if (sc_gcinfo) fprintf( stderr, "%sheap expanded to ", msgheader ); ! newmem = getmem( add_pages*PAGEBYTES ); ! #ifdef AMIGA ! if (newmem == NULL) { ! add_pages = (AvailMem(MEMF_FAST | MEMF_LARGEST) - (ONEMB / 2)) / PAGEBYTES; ! if (add_pages > ONEMB / 2 / PAGEBYTES) { ! expandfailed = 0; ! newmem = getmem( add_pages*PAGEBYTES ); ! } ! } ! #endif ! addrtoheap( newmem, add_pages*PAGEBYTES ); if (sc_gcinfo) fprintf( stderr, "%d MB\n", (sc_heappages*PAGEBYTES+ONEMB/2)/ONEMB ); *************** *** 545,550 **** --- 580,586 ---- valid pages of the heap. */ + #ifndef AMIGA static struct { char id[4]; /* S->C */ TSCP procedure; /* Restart procedure */ *************** *** 602,607 **** --- 638,644 ---- 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 *************** *** 618,623 **** --- 655,663 ---- 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 ); *************** *** 695,700 **** --- 735,741 ---- heapout( PAGE_ADDRESS( firstpage ), pagecount*PAGEBYTES ); close( heapfile ); return( TRUEVALUE ); + #endif AMIGA } /* The following routine is called from a Scheme main program to determine *************** *** 723,732 **** --- 764,782 ---- minheap = desiredheap; } decodearguments( argc, argv ); + #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 + sc_error( "RESTORE-HEAP", "Heap save/restore not supported on the Amiga", 0 ); + #else + /* Saved heap exists, open it and validate the header */ heapfile = open( heapfilename, O_RDONLY ); if (heapfile == -1) { *************** *** 837,842 **** --- 887,893 ---- (*mainproc)( sc_clarguments( argc, argv ) ); else return; + #endif AMIGA SCHEMEEXIT(); } *************** *** 904,909 **** --- 955,963 ---- #ifdef VAX sc_cstringtostring( "VAX" ), #endif + #ifdef AMIGA + sc_cstringtostring( "Amiga" ), + #endif sc_cons( #ifdef MIPS sc_cstringtostring( "R2000/R3000" ), *************** *** 914,921 **** --- 968,994 ---- #ifdef VAX sc_cstringtostring( "VAX" ), #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 */ sc_cons( + #ifdef AMIGA + sc_cstringtostring( "AmigaDOS" ), + #else sc_cstringtostring( "ULTRIX" ), + #endif sc_cons( FALSEVALUE, EMPTYLIST diff -r -c ../orig/scrt/scrt2.c ./scrt/scrt2.c *** ../orig/scrt/scrt2.c Tue Oct 22 13:47:34 1991 --- ./scrt/scrt2.c Thu Oct 24 18:28:11 1991 *************** *** 59,65 **** DEFSTATICTSCP2( c3450, t4411 ); DEFSTRING( t4412, "SQRT", 4 ); DEFSTATICTSCP( c3449 ); ! DEFFLOAT( t4413, .5 ); DEFSTATICTSCP2( c3391, t4413 ); DEFSTRING( t4414, "/", 1 ); DEFSTATICTSCP( c2891 ); --- 59,65 ---- DEFSTATICTSCP2( c3450, t4411 ); DEFSTRING( t4412, "SQRT", 4 ); DEFSTATICTSCP( c3449 ); ! DEFFLOAT( t4413, 0.5 ); DEFSTATICTSCP2( c3391, t4413 ); DEFSTRING( t4414, "/", 1 ); DEFSTATICTSCP( c2891 ); *************** *** 464,472 **** scrt6_error( c2182, c2183, CONS( x2177, EMPTYLIST ) ); L4545: ! X1 = BOOLEAN( LT( FLOAT_VALUE( x2177 ), -536870912.1 ) ); if ( TRUE( X1 ) ) goto L4551; ! if ( LTE( FLOAT_VALUE( x2177 ), 536870911.1 ) ) goto L4554; L4551: scrt6_error( c2182, c2188, CONS( x2177, EMPTYLIST ) ); --- 464,474 ---- scrt6_error( c2182, c2183, CONS( x2177, EMPTYLIST ) ); L4545: ! X1 = BOOLEAN( LT( FLOAT_VALUE( x2177 ), ! -536870912.1000000226 ) ); if ( TRUE( X1 ) ) goto L4551; ! if ( LTE( FLOAT_VALUE( x2177 ), 536870911.1000000231 ) ! ) goto L4554; L4551: scrt6_error( c2182, c2188, CONS( x2177, EMPTYLIST ) ); *************** *** 2252,2260 **** EQ( TSCP_EXTENDEDTAG( X3 ), FLOATTAG ) ) ) goto L5370; scrt6_error( c2182, c2183, CONS( X3, EMPTYLIST ) ); L5370: ! X4 = BOOLEAN( LT( FLOAT_VALUE( X3 ), -536870912.1 ) ); if ( TRUE( X4 ) ) goto L5376; ! if ( LTE( FLOAT_VALUE( X3 ), 536870911.1 ) ) goto L5379; L5376: scrt6_error( c2182, c2188, CONS( X3, EMPTYLIST ) ); L5379: --- 2254,2263 ---- EQ( TSCP_EXTENDEDTAG( X3 ), FLOATTAG ) ) ) goto L5370; scrt6_error( c2182, c2183, CONS( X3, EMPTYLIST ) ); L5370: ! X4 = BOOLEAN( LT( FLOAT_VALUE( X3 ), ! -536870912.1000000226 ) ); if ( TRUE( X4 ) ) goto L5376; ! if ( LTE( FLOAT_VALUE( X3 ), 536870911.1000000231 ) ) goto L5379; L5376: scrt6_error( c2182, c2188, CONS( X3, EMPTYLIST ) ); L5379: *************** *** 2334,2342 **** EQ( TSCP_EXTENDEDTAG( X2 ), FLOATTAG ) ) ) goto L5424; scrt6_error( c2182, c2183, CONS( X2, EMPTYLIST ) ); L5424: ! X3 = BOOLEAN( LT( FLOAT_VALUE( X2 ), -536870912.1 ) ); if ( TRUE( X3 ) ) goto L5430; ! if ( LTE( FLOAT_VALUE( X2 ), 536870911.1 ) ) goto L5433; L5430: scrt6_error( c2182, c2188, CONS( X2, EMPTYLIST ) ); L5433: --- 2337,2346 ---- EQ( TSCP_EXTENDEDTAG( X2 ), FLOATTAG ) ) ) goto L5424; scrt6_error( c2182, c2183, CONS( X2, EMPTYLIST ) ); L5424: ! X3 = BOOLEAN( LT( FLOAT_VALUE( X2 ), ! -536870912.1000000226 ) ); if ( TRUE( X3 ) ) goto L5430; ! if ( LTE( FLOAT_VALUE( X2 ), 536870911.1000000231 ) ) goto L5433; L5430: scrt6_error( c2182, c2188, CONS( X2, EMPTYLIST ) ); L5433: *************** *** 2378,2386 **** if ( NOT( AND( EQ( TSCPTAG( x3563 ), EXTENDEDTAG ), EQ( TSCP_EXTENDEDTAG( x3563 ), FLOATTAG ) ) ) ) goto L5445; ! X1 = BOOLEAN( LT( FLOAT_VALUE( x3563 ), -536870912.1 ) ); if ( TRUE( X1 ) ) goto L5452; ! if ( LTE( FLOAT_VALUE( x3563 ), 536870911.1 ) ) goto L5455; L5452: scrt6_error( c2182, c2188, CONS( x3563, EMPTYLIST ) ); --- 2382,2392 ---- if ( NOT( AND( EQ( TSCPTAG( x3563 ), EXTENDEDTAG ), EQ( TSCP_EXTENDEDTAG( x3563 ), FLOATTAG ) ) ) ) goto L5445; ! X1 = BOOLEAN( LT( FLOAT_VALUE( x3563 ), ! -536870912.1000000226 ) ); if ( TRUE( X1 ) ) goto L5452; ! if ( LTE( FLOAT_VALUE( x3563 ), 536870911.1000000231 ) ! ) goto L5455; L5452: scrt6_error( c2182, c2188, CONS( x3563, EMPTYLIST ) ); diff -r -c ../orig/scrt/scrt7.c ./scrt/scrt7.c *** ../orig/scrt/scrt7.c Tue Oct 15 11:54:19 1991 --- ./scrt/scrt7.c Thu Oct 24 18:44:46 1991 *************** *** 117,125 **** DEFSTATICTSCP2( c2849, t4377 ); DEFSTRING( t4378, "FLOAT->FIXED", 12 ); DEFSTATICTSCP( c2848 ); ! DEFFLOAT( t4379, -536870912.1 ); DEFSTATICTSCP2( c2843, t4379 ); ! DEFFLOAT( t4380, 536870911.1 ); DEFSTATICTSCP2( c2835, t4380 ); DEFSTRING( t4381, ")0", 2 ); DEFSTATICTSCP2( c2816, t4381 ); --- 117,125 ---- DEFSTATICTSCP2( c2849, t4377 ); DEFSTRING( t4378, "FLOAT->FIXED", 12 ); DEFSTATICTSCP( c2848 ); ! DEFFLOAT( t4379, -536870912.1000000226 ); DEFSTATICTSCP2( c2843, t4379 ); ! DEFFLOAT( t4380, 536870911.1000000231 ); DEFSTATICTSCP2( c2835, t4380 ); DEFSTRING( t4381, ")0", 2 ); DEFSTATICTSCP2( c2816, t4381 ); *************** *** 127,133 **** DEFSTATICTSCP2( c2815, t4382 ); DEFSTRING( t4383, "Illegal floating point number: ~a", 33 ); DEFSTATICTSCP2( c2811, t4383 ); ! DEFSTRING( t4384, "%F)%d", 5 ); DEFSTATICTSCP2( c2810, t4384 ); DEFSTRING( t4385, "Floating point numbers must be base 10: ~a", 42 ); --- 127,133 ---- DEFSTATICTSCP2( c2815, t4382 ); DEFSTRING( t4383, "Illegal floating point number: ~a", 33 ); DEFSTATICTSCP2( c2811, t4383 ); ! DEFSTRING( t4384, "%f)%d", 5 ); DEFSTATICTSCP2( c2810, t4384 ); DEFSTRING( t4385, "Floating point numbers must be base 10: ~a", 42 ); *************** *** 1488,1496 **** EQ( TSCP_EXTENDEDTAG( X3 ), FLOATTAG ) ) ) goto L4998; scrt6_error( c2848, c2849, CONS( X3, EMPTYLIST ) ); L4998: ! X4 = BOOLEAN( LT( FLOAT_VALUE( X3 ), -536870912.1 ) ); if ( TRUE( X4 ) ) goto L5004; ! if ( LTE( FLOAT_VALUE( X3 ), 536870911.1 ) ) goto L5007; L5004: scrt6_error( c2848, c2854, CONS( X3, EMPTYLIST ) ); L5007: --- 1488,1497 ---- EQ( TSCP_EXTENDEDTAG( X3 ), FLOATTAG ) ) ) goto L4998; scrt6_error( c2848, c2849, CONS( X3, EMPTYLIST ) ); L4998: ! X4 = BOOLEAN( LT( FLOAT_VALUE( X3 ), ! -536870912.1000000226 ) ); if ( TRUE( X4 ) ) goto L5004; ! if ( LTE( FLOAT_VALUE( X3 ), 536870911.1000000231 ) ) goto L5007; L5004: scrt6_error( c2848, c2854, CONS( X3, EMPTYLIST ) ); L5007: *************** *** 3118,3126 **** scrt6_error( c2848, c2849, CONS( c2835, EMPTYLIST ) ); L5010: ! X3 = BOOLEAN( LT( FLOAT_VALUE( c2835 ), -536870912.1 ) ); if ( TRUE( X3 ) ) goto L5016; ! if ( LTE( FLOAT_VALUE( c2835 ), 536870911.1 ) ) goto L5019; L5016: scrt6_error( c2848, c2854, CONS( c2835, EMPTYLIST ) ); --- 3119,3129 ---- scrt6_error( c2848, c2849, CONS( c2835, EMPTYLIST ) ); L5010: ! X3 = BOOLEAN( LT( FLOAT_VALUE( c2835 ), ! -536870912.1000000226 ) ); if ( TRUE( X3 ) ) goto L5016; ! if ( LTE( FLOAT_VALUE( c2835 ), 536870911.1000000231 ) ! ) goto L5019; L5016: scrt6_error( c2848, c2854, CONS( c2835, EMPTYLIST ) ); diff -r -c ../orig/scrt/scrt7.sc ./scrt/scrt7.sc *** ../orig/scrt/scrt7.sc Tue Oct 15 11:08:34 1991 --- ./scrt/scrt7.sc Thu Oct 24 16:36:07 1991 *************** *** 277,283 **** (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))))) (next-char))) --- 277,283 ---- (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))))) (next-char))) diff -r -c ../orig/scrt/signal.c ./scrt/signal.c *** ../orig/scrt/signal.c Tue Oct 15 11:54:19 1991 --- ./scrt/signal.c Thu Oct 24 16:36:13 1991 *************** *** 48,54 **** --- 48,62 ---- #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 extern TSCP scrt4_onsignal2(); *************** *** 123,129 **** --- 131,139 ---- } else { /* Signal must be defered */ + #ifndef AMIGA 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 Only in ./scrt: varargs.h Only in ./scsc: SASCOPTS Only in ./scsc: fromc Only in ./scsc: fromsc diff -r -c ../orig/scsc/main.sc ./scsc/main.sc *** ../orig/scsc/main.sc Tue Oct 15 10:55:24 1991 --- ./scsc/main.sc Thu Oct 24 16:37:19 1991 *************** *** 79,85 **** ;;; 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. --- 79,85 ---- ;;; The following top-level variables define the implementation dependent ;;; information: ! (define PREDEF-DEFAULT "include:sc/predef.sc") ; File holding the declarations for predefined ; functions. *************** *** 86,102 **** (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 --- 86,102 ---- (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 *************** *** 105,133 **** ;;; 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, --- 105,112 ---- ;;; 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, *************** *** 195,206 **** (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. --- 174,185 ---- (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. *************** *** 265,274 **** (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))) --- 244,253 ---- (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))) *************** *** 308,314 **** (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. --- 287,293 ---- (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. *************** *** 315,326 **** (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))) --- 294,308 ---- (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))) *************** *** 360,365 **** --- 342,348 ---- (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. Only in ../orig: test Only in ../orig: xlib \End\Of\Shar\ if `test ! -d ./scrt` then mkdir ./scrt echo "mkdir ./scrt" fi echo "writing ./scrt/fromc" cat > ./scrt/fromc << '\End\Of\Shar\' ;; ===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 \End\Of\Shar\ echo "writing ./scrt/fromsc" cat > ./scrt/fromsc << '\End\Of\Shar\' ;; ===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 \End\Of\Shar\ echo "writing ./scrt/SASCOPTS" cat > ./scrt/SASCOPTS << '\End\Of\Shar\' -b0 -r0 -f8 -Lm -m3 -O -cs -cu -i -dMC68030 -dMATHTRAPS=0 -j93i -j85i -j132i -j84i -j88i -mt -Ln -Psci \End\Of\Shar\ echo "writing ./scrt/varargs.h" cat > ./scrt/varargs.h << '\End\Of\Shar\' /* * 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] \End\Of\Shar\ if `test ! -d ./scsc` then mkdir ./scsc echo "mkdir ./scsc" fi echo "writing ./scsc/fromc" cat > ./scsc/fromc << '\End\Of\Shar\' ;; ===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 \End\Of\Shar\ echo "writing ./scsc/fromsc" cat > ./scsc/fromsc << '\End\Of\Shar\' ;; ===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 \End\Of\Shar\ echo "writing ./scsc/SASCOPTS" cat > ./scsc/SASCOPTS << '\End\Of\Shar\' -b0 -r0 -f8 -Lm -m3 -cs -cu -i/scrt -dMC68030 -dMATHTRAPS=0 -j93i -j85i -j132i -j84i -j88i -mt -Ln -L+/scrt/sc.lib -PXscc \End\Of\Shar\ echo "writing ./scsc/main.c" cat > ./scsc/main.c << '\End\Of\Shar\' /* SCHEME->C */ #include DEFSTRING( t2552, "INITIALIZE-COMPILE", 18 ); DEFSTATICTSCP( initialize_2dcompile_v ); DEFSTRING( t2553, "SC-LOG-DEFAULT", 14 ); DEFSTATICTSCP( sc_2dlog_2ddefault_v ); DEFSTRING( t2554, "DO-DEFINE-CONSTANT", 18 ); DEFSTATICTSCP( do_2ddefine_2dconstant_v ); DEFSTRING( t2555, "SC-INCLUDE-DIRS", 15 ); DEFSTATICTSCP( sc_2dinclude_2ddirs_v ); DEFSTRING( t2556, "SC-INPUT", 8 ); DEFSTATICTSCP( sc_2dinput_v ); DEFSTRING( t2557, "SC-SOURCE-NAME", 14 ); DEFSTATICTSCP( sc_2dsource_2dname_v ); DEFSTRING( t2558, "SC-ICODE", 8 ); DEFSTATICTSCP( sc_2dicode_v ); DEFSTRING( t2559, "SC-ERROR", 8 ); DEFSTATICTSCP( sc_2derror_v ); DEFSTRING( t2560, "SC-LOG", 6 ); DEFSTATICTSCP( sc_2dlog_v ); DEFSTRING( t2561, "SC-STACK-TRACE", 14 ); DEFSTATICTSCP( sc_2dstack_2dtrace_v ); DEFSTRING( t2562, "SC-INTERPRETER", 14 ); DEFSTATICTSCP( sc_2dinterpreter_v ); DEFSTRING( t2563, "DOCOMPILE", 9 ); DEFSTATICTSCP( docompile_v ); DEFSTRING( t2564, "SC-ERROR-CNT", 12 ); DEFSTATICTSCP( sc_2derror_2dcnt_v ); DEFSTRING( t2565, "MODULE-NAME", 11 ); DEFSTATICTSCP( module_2dname_v ); DEFSTRING( t2566, "CLOSE-SC-FILES", 14 ); DEFSTATICTSCP( close_2dsc_2dfiles_v ); DEFSTRING( t2567, "Argument is not a STRING: ~s", 28 ); DEFSTATICTSCP2( c2511, t2567 ); DEFSTRING( t2568, "STRING-LENGTH", 13 ); DEFSTATICTSCP( c2510 ); DEFSTRING( t2569, ".c", 2 ); DEFSTATICTSCP2( c2493, t2569 ); DEFSTRING( t2570, "~a:~%", 5 ); DEFSTATICTSCP2( c2445, t2570 ); DEFSTRING( t2571, ".sc", 3 ); DEFSTATICTSCP2( c2443, t2571 ); DEFSTRING( t2572, "lc", 2 ); DEFSTATICTSCP2( c2413, t2572 ); DEFSTRING( t2573, "+", 1 ); DEFSTATICTSCP2( c2368, t2573 ); DEFSTRING( t2574, " -Lm", 4 ); DEFSTATICTSCP2( c2323, t2574 ); DEFSTRING( t2575, " -i", 3 ); DEFSTATICTSCP2( c2322, t2575 ); DEFSTRING( t2576, " -csu -f8 -b0 -r0 -C -d", 23 ); DEFSTATICTSCP2( c2321, t2576 ); DEFSTRING( t2577, "}~%", 3 ); DEFSTATICTSCP2( c2317, t2577 ); DEFSTRING( t2578, " SCHEMEEXIT();~%", 18 ); DEFSTATICTSCP2( c2316, t2578 ); DEFSTRING( t2579, " screp_read_2deval_2dprint( sc_clarguments( argc, argv ) );~%", 63 ); DEFSTATICTSCP2( c2315, t2579 ); DEFSTRING( t2580, "screp", 5 ); DEFSTATICTSCP2( c2314, t2580 ); DEFSTRING( t2581, " ~a__init();~%", 16 ); DEFSTATICTSCP2( c2313, t2581 ); DEFSTRING( t2582, "Argument not a PAIR: ~s", 23 ); DEFSTATICTSCP2( c2302, t2582 ); DEFSTRING( t2583, "SET-CDR!", 8 ); DEFSTATICTSCP( c2301 ); DEFSTRING( t2584, " INITHEAP( 0, argc, argv, screp_read_2deval_2dprint );~%", 58 ); DEFSTATICTSCP2( c2266, t2584 ); DEFSTRING( t2585, "main( argc, argv )~%{~%", 23 ); DEFSTATICTSCP2( c2265, t2585 ); DEFSTRING( t2586, "extern TSCP screp_read_2deval_2dprint();~%", 42 ); DEFSTATICTSCP2( c2264, t2586 ); DEFSTRING( t2587, "#include \"~a/~a\"~%", 18 ); DEFSTATICTSCP2( c2263, t2587 ); DEFSTRING( t2588, ")", 1 ); DEFSTATICTSCP2( c2248, t2588 ); DEFSTRING( t2589, " ", 1 ); DEFSTATICTSCP2( c2247, t2589 ); DEFSTRING( t2590, "(define-constant ", 17 ); DEFSTATICTSCP2( c2236, t2590 ); DEFSTRING( t2591, "/", 1 ); DEFSTATICTSCP2( c2219, t2591 ); DEFSTATICTSCP( c2178 ); DEFSTRING( t2593, "PEEP", 4 ); DEFSTATICTSCP( t2592 ); DEFSTRING( t2595, "-peep", 5 ); DEFSTATICTSCP2( t2594, t2595 ); DEFSTRING( t2597, "LAP", 3 ); DEFSTATICTSCP( t2596 ); DEFSTRING( t2599, "-lap", 4 ); DEFSTATICTSCP2( t2598, t2599 ); DEFSTRING( t2601, "TREE", 4 ); DEFSTATICTSCP( t2600 ); DEFSTRING( t2603, "-tree", 5 ); DEFSTATICTSCP2( t2602, t2603 ); DEFSTRING( t2605, "LAMBDA", 6 ); DEFSTATICTSCP( t2604 ); DEFSTRING( t2607, "-lambda", 7 ); DEFSTATICTSCP2( t2606, t2607 ); DEFSTRING( t2609, "TRANSFORM", 9 ); DEFSTATICTSCP( t2608 ); DEFSTRING( t2611, "-transform", 10 ); DEFSTATICTSCP2( t2610, t2611 ); DEFSTRING( t2613, "CLOSED", 6 ); DEFSTATICTSCP( t2612 ); DEFSTRING( t2615, "-closed", 7 ); DEFSTATICTSCP2( t2614, t2615 ); DEFSTRING( t2617, "EXPAND", 6 ); DEFSTATICTSCP( t2616 ); DEFSTRING( t2619, "-expand", 7 ); DEFSTATICTSCP2( t2618, t2619 ); DEFSTRING( t2621, "MACRO", 5 ); DEFSTATICTSCP( t2620 ); DEFSTRING( t2623, "-macro", 6 ); DEFSTATICTSCP2( t2622, t2623 ); DEFSTRING( t2625, "SOURCE", 6 ); DEFSTATICTSCP( t2624 ); DEFSTRING( t2627, "-source", 7 ); DEFSTATICTSCP2( t2626, t2627 ); DEFSTRING( t2628, "(define-constant *type-check* #f)", 33 ); DEFSTATICTSCP2( c2163, t2628 ); DEFSTRING( t2629, "(define-constant *bounds-check* #f)", 35 ); DEFSTATICTSCP2( c2157, t2629 ); DEFSTRING( t2630, "(define-constant *fixed-only* #t)", 33 ); DEFSTATICTSCP2( c2146, t2630 ); DEFSTRING( t2631, "-cc", 3 ); DEFSTATICTSCP2( c2107, t2631 ); DEFSTRING( t2632, "-C", 2 ); DEFSTATICTSCP2( c2103, t2632 ); DEFSTRING( t2633, "-On", 3 ); DEFSTATICTSCP2( c2102, t2633 ); DEFSTRING( t2634, "-Og", 3 ); DEFSTATICTSCP2( c2101, t2634 ); DEFSTRING( t2635, "-Ob", 3 ); DEFSTATICTSCP2( c2100, t2635 ); DEFSTRING( t2636, "-Ot", 3 ); DEFSTATICTSCP2( c2099, t2636 ); DEFSTRING( t2637, "-log", 4 ); DEFSTATICTSCP2( c2096, t2637 ); DEFSTRING( t2638, "-m", 2 ); DEFSTATICTSCP2( c2090, t2638 ); DEFSTRING( t2639, "-I", 2 ); DEFSTATICTSCP2( c2081, t2639 ); DEFSTRING( t2640, "-i", 2 ); DEFSTATICTSCP2( c2077, t2640 ); DEFSTRING( t2641, "-f", 2 ); DEFSTATICTSCP2( c2057, t2641 ); DEFSTATICTSCP( c2034 ); DEFSTRING( t2642, "Amiga", 5 ); DEFSTATICTSCP2( c2026, t2642 ); DEFSTRING( t2643, "lib:sc.lib", 10 ); DEFSTATICTSCP2( c2023, t2643 ); DEFSTRING( t2644, "include:sc", 10 ); DEFSTATICTSCP2( c2021, t2644 ); DEFSTRING( t2645, "objects.h", 9 ); DEFSTATICTSCP2( c2019, t2645 ); DEFSTRING( t2646, "include:sc/predef.sc", 20 ); DEFSTATICTSCP2( c2017, t2646 ); DEFSTRING( t2647, "SC-TO-C~s.o", 11 ); DEFSTATICTSCP2( c2015, t2647 ); DEFSTRING( t2648, "SC-TO-C~s.c", 11 ); DEFSTATICTSCP2( c2013, t2648 ); DEFSTRING( t2649, "01nov91jfb", 10 ); DEFSTATICTSCP2( c2010, t2649 ); static void init_constants() { TSCP X1; initialize_2dcompile_v = STRINGTOSYMBOL( U_TX( ADR( t2552 ) ) ); CONSTANTEXP( ADR( initialize_2dcompile_v ) ); sc_2dlog_2ddefault_v = STRINGTOSYMBOL( U_TX( ADR( t2553 ) ) ); CONSTANTEXP( ADR( sc_2dlog_2ddefault_v ) ); do_2ddefine_2dconstant_v = STRINGTOSYMBOL( U_TX( ADR( t2554 ) ) ); CONSTANTEXP( ADR( do_2ddefine_2dconstant_v ) ); sc_2dinclude_2ddirs_v = STRINGTOSYMBOL( U_TX( ADR( t2555 ) ) ); CONSTANTEXP( ADR( sc_2dinclude_2ddirs_v ) ); sc_2dinput_v = STRINGTOSYMBOL( U_TX( ADR( t2556 ) ) ); CONSTANTEXP( ADR( sc_2dinput_v ) ); sc_2dsource_2dname_v = STRINGTOSYMBOL( U_TX( ADR( t2557 ) ) ); CONSTANTEXP( ADR( sc_2dsource_2dname_v ) ); sc_2dicode_v = STRINGTOSYMBOL( U_TX( ADR( t2558 ) ) ); CONSTANTEXP( ADR( sc_2dicode_v ) ); sc_2derror_v = STRINGTOSYMBOL( U_TX( ADR( t2559 ) ) ); CONSTANTEXP( ADR( sc_2derror_v ) ); sc_2dlog_v = STRINGTOSYMBOL( U_TX( ADR( t2560 ) ) ); CONSTANTEXP( ADR( sc_2dlog_v ) ); sc_2dstack_2dtrace_v = STRINGTOSYMBOL( U_TX( ADR( t2561 ) ) ); CONSTANTEXP( ADR( sc_2dstack_2dtrace_v ) ); sc_2dinterpreter_v = STRINGTOSYMBOL( U_TX( ADR( t2562 ) ) ); CONSTANTEXP( ADR( sc_2dinterpreter_v ) ); docompile_v = STRINGTOSYMBOL( U_TX( ADR( t2563 ) ) ); CONSTANTEXP( ADR( docompile_v ) ); sc_2derror_2dcnt_v = STRINGTOSYMBOL( U_TX( ADR( t2564 ) ) ); CONSTANTEXP( ADR( sc_2derror_2dcnt_v ) ); module_2dname_v = STRINGTOSYMBOL( U_TX( ADR( t2565 ) ) ); CONSTANTEXP( ADR( module_2dname_v ) ); close_2dsc_2dfiles_v = STRINGTOSYMBOL( U_TX( ADR( t2566 ) ) ); CONSTANTEXP( ADR( close_2dsc_2dfiles_v ) ); c2510 = STRINGTOSYMBOL( U_TX( ADR( t2568 ) ) ); CONSTANTEXP( ADR( c2510 ) ); c2301 = STRINGTOSYMBOL( U_TX( ADR( t2583 ) ) ); CONSTANTEXP( ADR( c2301 ) ); c2178 = EMPTYLIST; t2592 = STRINGTOSYMBOL( U_TX( ADR( t2593 ) ) ); X1 = t2592; X1 = CONS( t2594, X1 ); c2178 = CONS( X1, c2178 ); t2596 = STRINGTOSYMBOL( U_TX( ADR( t2597 ) ) ); X1 = t2596; X1 = CONS( t2598, X1 ); c2178 = CONS( X1, c2178 ); t2600 = STRINGTOSYMBOL( U_TX( ADR( t2601 ) ) ); X1 = t2600; X1 = CONS( t2602, X1 ); c2178 = CONS( X1, c2178 ); t2604 = STRINGTOSYMBOL( U_TX( ADR( t2605 ) ) ); X1 = t2604; X1 = CONS( t2606, X1 ); c2178 = CONS( X1, c2178 ); t2608 = STRINGTOSYMBOL( U_TX( ADR( t2609 ) ) ); X1 = t2608; X1 = CONS( t2610, X1 ); c2178 = CONS( X1, c2178 ); t2612 = STRINGTOSYMBOL( U_TX( ADR( t2613 ) ) ); X1 = t2612; X1 = CONS( t2614, X1 ); c2178 = CONS( X1, c2178 ); t2616 = STRINGTOSYMBOL( U_TX( ADR( t2617 ) ) ); X1 = t2616; X1 = CONS( t2618, X1 ); c2178 = CONS( X1, c2178 ); t2620 = STRINGTOSYMBOL( U_TX( ADR( t2621 ) ) ); X1 = t2620; X1 = CONS( t2622, X1 ); c2178 = CONS( X1, c2178 ); t2624 = STRINGTOSYMBOL( U_TX( ADR( t2625 ) ) ); X1 = t2624; X1 = CONS( t2626, X1 ); c2178 = CONS( X1, c2178 ); CONSTANTEXP( ADR( c2178 ) ); c2034 = EMPTYLIST; c2034 = CONS( EMPTYSTRING, c2034 ); CONSTANTEXP( ADR( c2034 ) ); } DEFTSCP( main_scc_2dversion_v ); DEFSTRING( t2650, "SCC-VERSION", 11 ); DEFTSCP( main_force_2dld_2dof_2drep_v ); DEFSTRING( t2651, "FORCE-LD-OF-REP", 15 ); EXTERNTSCPP( screp_read_2deval_2dprint ); EXTERNTSCP( screp_read_2deval_2dprint_v ); DEFTSCP( main_sc_2dto_2dc_2ec_v ); DEFSTRING( t2652, "SC-TO-C.C", 9 ); DEFTSCP( main_sc_2dto_2dc_2eo_v ); DEFSTRING( t2653, "SC-TO-C.O", 9 ); DEFTSCP( main_predef_2ddefault_v ); DEFSTRING( t2654, "PREDEF-DEFAULT", 14 ); DEFTSCP( main_c_2dinclude_2dfile_v ); DEFSTRING( t2655, "C-INCLUDE-FILE", 14 ); DEFTSCP( main_c_2dinclude_2ddir_v ); DEFSTRING( t2656, "C-INCLUDE-DIR", 13 ); DEFTSCP( main_sc_2dlibrary_v ); DEFSTRING( t2657, "SC-LIBRARY", 10 ); DEFTSCP( main_sc_2dlibrary__p_v ); DEFSTRING( t2658, "SC-LIBRARY_P", 12 ); EXTERNTSCP( sc_emptystring ); DEFTSCP( main_sc_2dprocessor_v ); DEFSTRING( t2659, "SC-PROCESSOR", 12 ); DEFTSCP( main_configure_v ); DEFSTRING( t2660, "CONFIGURE", 9 ); EXTERNTSCPP( main_scc ); EXTERNTSCP( main_scc_v ); TSCP main_configure( c2029 ) TSCP c2029; { TSCP X1; PUSHSTACKTRACE( U_TX( ADR( t2660 ) ) ); X1 = SYMBOL_VALUE( initialize_2dcompile_v ); X1 = UNKNOWNCALL( X1, 0 ); VIA( PROCEDURE_CODE( X1 ) )( PROCEDURE_CLOSURE( X1 ) ); POPSTACKTRACE( main_scc( c2029 ) ); } DEFTSCP( main_module_2dnames_v ); DEFSTRING( t2662, "MODULE-NAMES", 12 ); DEFTSCP( main_include_2ddirs_v ); DEFSTRING( t2663, "INCLUDE-DIRS", 12 ); DEFTSCP( main_scc_v ); DEFSTRING( t2664, "SCC", 3 ); EXTERNTSCPP( scrt1_cons_2a ); EXTERNTSCP( scrt1_cons_2a_v ); EXTERNTSCPP( scrt6_format ); EXTERNTSCP( scrt6_format_v ); EXTERNINTP( getpid ); EXTERNTSCPP( scrt1__24__cdr_2derror ); 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 ); EXTERNTSCP( scrt3_string_2dappend_v ); EXTERNTSCPP( scrt1_caddr ); EXTERNTSCP( scrt1_caddr_v ); EXTERNTSCPP( scrt1_cdddr ); EXTERNTSCP( scrt1_cdddr_v ); EXTERNTSCPP( scrt1_append_2dtwo ); EXTERNTSCP( scrt1_append_2dtwo_v ); EXTERNTSCPP( scrt1_assoc ); EXTERNTSCP( scrt1_assoc_v ); EXTERNTSCPP( main_do_2dc_2dflag ); EXTERNTSCP( main_do_2dc_2dflag_v ); EXTERNTSCP( scrt6_exit_v ); EXTERNTSCP( scrt6_reset_v ); DEFSTRING( t2796, "main_l2260 [inside SCC]", 23 ); EXTERNINTP( unlink ); TSCP main_l2260( c2795 ) TSCP c2795; { TSCP X3, X2, X1; PUSHSTACKTRACE( U_TX( ADR( t2796 ) ) ); X1 = DISPLAY( 0 ); DISPLAY( 0 ) = CLOSURE_VAR( c2795, 0 ); unlink( TSCP_POINTER( main_sc_2dto_2dc_2ec_v ) ); unlink( TSCP_POINTER( main_sc_2dto_2dc_2eo_v ) ); X3 = DISPLAY( 0 ); X3 = UNKNOWNCALL( X3, 0 ); X2 = VIA( PROCEDURE_CODE( X3 ) )( PROCEDURE_CLOSURE( X3 ) ); DISPLAY( 0 ) = X1; POPSTACKTRACE( X2 ); } EXTERNTSCPP( scrt5_open_2doutput_2dfile ); EXTERNTSCP( scrt5_open_2doutput_2dfile_v ); EXTERNTSCPP( scrt1_reverse ); EXTERNTSCP( scrt1_reverse_v ); EXTERNTSCPP( scrt6_error ); EXTERNTSCP( scrt6_error_v ); EXTERNTSCPP( scrt5_close_2doutput_2dport ); EXTERNTSCP( scrt5_close_2doutput_2dport_v ); EXTERNTSCPP( scrt4_system ); EXTERNTSCP( scrt4_system_v ); EXTERNTSCPP( sc_apply_2dtwo ); EXTERNTSCP( sc_apply_2dtwo_v ); TSCP main_scc( c2036 ) TSCP c2036; { TSCP X23, X22, X21, X20, X19, X18, X17, X16, X15, X14, X13, X12, X11, X10, X9, X8, X7, X6, X5, X4, X3, X2, X1; TSCP SD0 = DISPLAY( 0 ); TSCP SDVAL; PUSHSTACKTRACE( U_TX( ADR( t2664 ) ) ); X1 = c2413; 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 ); X2 = CONS( X2, EMPTYLIST ); X1 = CONS( X1, EMPTYLIST ); main_sc_2dto_2dc_2ec_v = scrt6_format( main_sc_2dto_2dc_2ec_v, CONS( INT_TSCP( getpid( ) ), EMPTYLIST ) ); main_sc_2dto_2dc_2eo_v = scrt6_format( main_sc_2dto_2dc_2eo_v, CONS( INT_TSCP( getpid( ) ), EMPTYLIST ) ); if ( EQ( TSCPTAG( c2036 ), PAIRTAG ) ) goto L2668; scrt1__24__cdr_2derror( c2036 ); L2668: X9 = PAIR_CDR( c2036 ); X10 = X9; L2672: if ( FALSE( X10 ) ) goto L2701; if ( EQ( TSCPTAG( X10 ), PAIRTAG ) ) goto L2676; scrt1__24__car_2derror( X10 ); L2676: X11 = PAIR_CAR( X10 ); X12 = scrt1_equal_3f( X11, c2057 ); if ( FALSE( X12 ) ) goto L2700; X13 = PAIR_CDR( X10 ); if ( FALSE( X13 ) ) goto L2700; X14 = PAIR_CDR( X10 ); if ( EQ( TSCPTAG( X14 ), PAIRTAG ) ) goto L2690; scrt1__24__cdr_2derror( X14 ); L2690: if ( FALSE( PAIR_CDR( X14 ) ) ) goto L2700; X17 = CONS( c2248, EMPTYLIST ); X17 = CONS( scrt1_caddr( X10 ), X17 ); X17 = CONS( c2247, X17 ); X18 = PAIR_CDR( X10 ); if ( EQ( TSCPTAG( X18 ), PAIRTAG ) ) goto L2697; scrt1__24__car_2derror( X18 ); L2697: X17 = CONS( PAIR_CAR( X18 ), X17 ); X16 = scrt3_string_2dappend( CONS( c2236, X17 ) ); X15 = sc_cons( X16, PAIR_CAR( X8 ) ); SETGEN( PAIR_CAR( X8 ), X15 ); X10 = scrt1_cdddr( X10 ); goto L2672; L2700: if ( FALSE( scrt1_equal_3f( X11, c2077 ) ) ) goto L2702; X12 = TRUEVALUE; SETGEN( PAIR_CAR( X7 ), X12 ); X10 = PAIR_CDR( X10 ); goto L2672; L2702: X12 = scrt1_equal_3f( X11, c2081 ); if ( FALSE( X12 ) ) goto L2723; if ( FALSE( PAIR_CDR( X10 ) ) ) goto L2723; X16 = CONS( c2219, EMPTYLIST ); X17 = PAIR_CDR( X10 ); if ( EQ( TSCPTAG( X17 ), PAIRTAG ) ) goto L2716; scrt1__24__car_2derror( X17 ); L2716: X15 = scrt3_string_2dappend( CONS( PAIR_CAR( X17 ), X16 ) ); X14 = sc_cons( X15, EMPTYLIST ); X13 = X14; main_include_2ddirs_v = scrt1_append_2dtwo( main_include_2ddirs_v, X13 ); X13 = PAIR_CDR( X10 ); if ( EQ( TSCPTAG( X13 ), PAIRTAG ) ) goto L2721; scrt1__24__cdr_2derror( X13 ); L2721: X10 = PAIR_CDR( X13 ); goto L2672; L2723: X12 = scrt1_equal_3f( X11, c2090 ); if ( FALSE( X12 ) ) goto L2740; if ( FALSE( PAIR_CDR( X10 ) ) ) goto L2740; X14 = PAIR_CDR( X10 ); if ( EQ( TSCPTAG( X14 ), PAIRTAG ) ) goto L2734; scrt1__24__car_2derror( X14 ); L2734: X13 = PAIR_CAR( X14 ); main_module_2dnames_v = sc_cons( X13, main_module_2dnames_v ); X13 = PAIR_CDR( X10 ); if ( EQ( TSCPTAG( X13 ), PAIRTAG ) ) goto L2738; scrt1__24__cdr_2derror( X13 ); L2738: X10 = PAIR_CDR( X13 ); goto L2672; L2740: if ( FALSE( scrt1_equal_3f( X11, c2096 ) ) ) goto L2741; X12 = SYMBOL_VALUE( sc_2dlog_2ddefault_v ); SETGEN( PAIR_CAR( X2 ), X12 ); X10 = PAIR_CDR( X10 ); goto L2672; L2741: X12 = scrt1_assoc( X11, c2178 ); if ( FALSE( X12 ) ) goto L2746; if ( EQ( TSCPTAG( X12 ), PAIRTAG ) ) goto L2750; scrt1__24__cdr_2derror( X12 ); L2750: X14 = PAIR_CDR( X12 ); X13 = sc_cons( X14, PAIR_CAR( X2 ) ); SETGEN( PAIR_CAR( X2 ), X13 ); X10 = PAIR_CDR( X10 ); goto L2672; L2746: if ( FALSE( scrt1_equal_3f( X11, c2099 ) ) ) goto L2753; X13 = sc_cons( c2163, PAIR_CAR( X8 ) ); SETGEN( PAIR_CAR( X8 ), X13 ); X10 = PAIR_CDR( X10 ); goto L2672; L2753: if ( FALSE( scrt1_equal_3f( X11, c2100 ) ) ) goto L2757; X13 = sc_cons( c2157, PAIR_CAR( X8 ) ); SETGEN( PAIR_CAR( X8 ), X13 ); X10 = PAIR_CDR( X10 ); goto L2672; L2757: if ( FALSE( scrt1_equal_3f( X11, c2101 ) ) ) goto L2761; X13 = FALSEVALUE; SETGEN( PAIR_CAR( X5 ), X13 ); X10 = PAIR_CDR( X10 ); goto L2672; L2761: if ( FALSE( scrt1_equal_3f( X11, c2102 ) ) ) goto L2765; X13 = sc_cons( c2146, PAIR_CAR( X8 ) ); SETGEN( PAIR_CAR( X8 ), X13 ); X10 = PAIR_CDR( X10 ); goto L2672; L2765: if ( FALSE( scrt1_equal_3f( X11, c2103 ) ) ) goto L2769; X13 = TRUEVALUE; SETGEN( PAIR_CAR( X4 ), X13 ); X10 = PAIR_CDR( X10 ); goto L2672; L2769: X13 = scrt1_equal_3f( X11, c2107 ); if ( FALSE( X13 ) ) goto L2789; if ( FALSE( PAIR_CDR( X10 ) ) ) goto L2789; X15 = PAIR_CDR( X10 ); if ( EQ( TSCPTAG( X15 ), PAIRTAG ) ) goto L2783; scrt1__24__car_2derror( X15 ); L2783: X14 = PAIR_CAR( X15 ); SETGEN( PAIR_CAR( X1 ), X14 ); X14 = PAIR_CDR( X10 ); if ( EQ( TSCPTAG( X14 ), PAIRTAG ) ) goto L2787; scrt1__24__cdr_2derror( X14 ); L2787: X10 = PAIR_CDR( X14 ); goto L2672; L2789: X13 = main_do_2dc_2dflag( X11, PAIR_CAR( X8 ), PAIR_CAR( X2 ), PAIR_CAR( X5 ), PAIR_CAR( X7 ) ); X12 = sc_cons( X13, PAIR_CAR( X3 ) ); SETGEN( PAIR_CAR( X3 ), X12 ); X10 = PAIR_CDR( X10 ); goto L2672; L2701: if ( FALSE( PAIR_CAR( X4 ) ) ) goto L2792; X9 = scrt6_exit_v; X9 = UNKNOWNCALL( X9, 0 ); VIA( PROCEDURE_CODE( X9 ) )( PROCEDURE_CLOSURE( X9 ) ); L2792: DISPLAY( 0 ) = scrt6_reset_v; scrt6_reset_v = MAKEPROCEDURE( 0, 0, main_l2260, MAKECLOSURE( EMPTYLIST, 1, DISPLAY( 0 ) ) ); if ( FALSE( PAIR_CAR( X7 ) ) ) goto L2798; 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( c2263, X10 ) ); scrt6_format( X9, CONS( c2264, EMPTYLIST ) ); scrt6_format( X9, CONS( c2265, EMPTYLIST ) ); scrt6_format( X9, CONS( c2266, EMPTYLIST ) ); X11 = scrt1_reverse( main_module_2dnames_v ); X10 = sc_cons( c2314, X11 ); X11 = X10; X12 = EMPTYLIST; X13 = EMPTYLIST; L2803: if ( EQ( UNSIGNED( X11 ), UNSIGNED( EMPTYLIST ) ) ) goto L2811; if ( EQ( TSCPTAG( X11 ), PAIRTAG ) ) goto L2807; scrt1__24__car_2derror( X11 ); L2807: X16 = CONS( PAIR_CAR( X11 ), EMPTYLIST ); X15 = scrt6_format( X9, CONS( c2313, X16 ) ); X14 = sc_cons( X15, EMPTYLIST ); if ( NEQ( UNSIGNED( X12 ), UNSIGNED( EMPTYLIST ) ) ) goto L2810; X15 = PAIR_CDR( X11 ); X13 = X14; X12 = X14; X11 = X15; goto L2803; L2810: X15 = PAIR_CDR( X11 ); if ( EQ( TSCPTAG( X13 ), PAIRTAG ) ) goto L2815; scrt6_error( c2301, c2302, CONS( X13, EMPTYLIST ) ); L2815: X13 = SETGEN( PAIR_CDR( X13 ), X14 ); X11 = X15; goto L2803; L2811: scrt6_format( X9, CONS( c2315, EMPTYLIST ) ); scrt6_format( X9, CONS( c2316, EMPTYLIST ) ); scrt6_format( X9, CONS( c2317, EMPTYLIST ) ); scrt5_close_2doutput_2dport( X9 ); X10 = sc_cons( main_sc_2dto_2dc_2ec_v, PAIR_CAR( X3 ) ); SETGEN( PAIR_CAR( X3 ), X10 ); L2798: X14 = X6; X15 = EMPTYLIST; X16 = EMPTYLIST; L2820: if ( NEQ( UNSIGNED( X14 ), UNSIGNED( EMPTYLIST ) ) ) goto L2821; X13 = X15; goto L2828; L2821: if ( EQ( TSCPTAG( X14 ), PAIRTAG ) ) goto L2824; scrt1__24__car_2derror( X14 ); L2824: X19 = CONS( PAIR_CAR( X14 ), EMPTYLIST ); X18 = scrt3_string_2dappend( CONS( c2368, X19 ) ); X17 = sc_cons( X18, EMPTYLIST ); if ( NEQ( UNSIGNED( X15 ), UNSIGNED( EMPTYLIST ) ) ) goto L2827; X18 = PAIR_CDR( X14 ); X16 = X17; X15 = X17; X14 = X18; goto L2820; L2827: X18 = PAIR_CDR( X14 ); if ( EQ( TSCPTAG( X16 ), PAIRTAG ) ) goto L2832; scrt6_error( c2301, c2302, CONS( X16, EMPTYLIST ) ); L2832: X16 = SETGEN( PAIR_CDR( X16 ), X17 ); X14 = X18; goto L2820; L2828: X17 = scrt1_reverse( PAIR_CAR( X3 ) ); X18 = X17; X19 = EMPTYLIST; X20 = EMPTYLIST; L2836: if ( NEQ( UNSIGNED( X18 ), UNSIGNED( EMPTYLIST ) ) ) goto L2837; X16 = X19; goto L2844; L2837: if ( EQ( TSCPTAG( X18 ), PAIRTAG ) ) goto L2840; scrt1__24__car_2derror( X18 ); L2840: X23 = CONS( PAIR_CAR( X18 ), EMPTYLIST ); X22 = scrt3_string_2dappend( CONS( c2247, X23 ) ); X21 = sc_cons( X22, EMPTYLIST ); if ( NEQ( UNSIGNED( X19 ), UNSIGNED( EMPTYLIST ) ) ) goto L2843; X22 = PAIR_CDR( X18 ); X20 = X21; X19 = X21; X18 = X22; goto L2836; L2843: X22 = PAIR_CDR( X18 ); if ( EQ( TSCPTAG( X20 ), PAIRTAG ) ) goto L2848; scrt6_error( c2301, c2302, CONS( X20, EMPTYLIST ) ); L2848: X20 = SETGEN( PAIR_CDR( X20 ), X21 ); X18 = X22; goto L2836; L2844: 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( c2323, X12 ); X12 = CONS( main_c_2dinclude_2ddir_v, X12 ); X12 = CONS( c2322, X12 ); X12 = CONS( main_sc_2dprocessor_v, X12 ); X11 = scrt1_cons_2a( PAIR_CAR( X1 ), CONS( c2321, X12 ) ); X10 = sc_apply_2dtwo( scrt3_string_2dappend_v, X11 ); X9 = scrt4_system( X10 ); if ( EQ( UNSIGNED( _TSCP( 0 ) ), UNSIGNED( X9 ) ) ) goto L2817; X9 = scrt6_reset_v; X9 = UNKNOWNCALL( X9, 0 ); VIA( PROCEDURE_CODE( X9 ) )( PROCEDURE_CLOSURE( X9 ) ); L2817: unlink( TSCP_POINTER( main_sc_2dto_2dc_2ec_v ) ); SDVAL = INT_TSCP( unlink( TSCP_POINTER( main_sc_2dto_2dc_2eo_v ) ) ); DISPLAY( 0 ) = SD0; POPSTACKTRACE( SDVAL ); } DEFTSCP( main_do_2dc_2dflag_v ); DEFSTRING( t2850, "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 ); EXTERNTSCP( scrt2__3e_2dtwo_v ); EXTERNTSCPP( scrt3_string_3d_3f ); EXTERNTSCP( scrt3_string_3d_3f_v ); EXTERNTSCPP( scrt6_read ); EXTERNTSCP( scrt6_read_v ); EXTERNTSCPP( scrt5_open_2dinput_2dstring ); EXTERNTSCP( scrt5_open_2dinput_2dstring_v ); EXTERNTSCPP( scrt5_open_2dinput_2dfile ); EXTERNTSCP( scrt5_open_2dinput_2dfile_v ); EXTERNTSCP( scrt5_stderr_2dport_v ); EXTERNTSCPP( scrt2_zero_3f ); EXTERNTSCP( scrt2_zero_3f_v ); EXTERNINTP( rename ); TSCP main_do_2dc_2dflag( a2415, f2416, l2417, s2418, i2419 ) TSCP a2415, f2416, l2417, s2418, i2419; { TSCP X7, X6, X5, X4, X3, X2, X1; PUSHSTACKTRACE( U_TX( ADR( t2850 ) ) ); if ( AND( EQ( TSCPTAG( a2415 ), EXTENDEDTAG ), EQ( TSCP_EXTENDEDTAG( a2415 ), STRINGTAG ) ) ) goto L2853; scrt6_error( c2510, c2511, CONS( a2415, EMPTYLIST ) ); L2853: X2 = C_FIXED( STRING_LENGTH( a2415 ) ); if ( BITAND( BITOR( INT( X2 ), INT( _TSCP( 12 ) ) ), 3 ) ) goto L2856; X5 = _TSCP( IDIFFERENCE( INT( X2 ), INT( _TSCP( 12 ) ) ) ); goto L2857; L2856: X5 = scrt2__2d_2dtwo( X2, _TSCP( 12 ) ); L2857: if ( BITAND( BITOR( INT( _TSCP( 0 ) ), INT( X5 ) ), 3 ) ) goto L2859; if ( LTE( INT( _TSCP( 0 ) ), INT( X5 ) ) ) goto L2861; X4 = _TSCP( 0 ); goto L2860; L2861: X4 = X5; goto L2860; L2859: X4 = scrt2_max_2dtwo( _TSCP( 0 ), X5 ); L2860: X3 = scrt3_substring( a2415, _TSCP( 0 ), X4 ); X4 = CONS( c2493, EMPTYLIST ); X1 = scrt3_string_2dappend( CONS( X3, X4 ) ); if ( BITAND( BITOR( INT( X2 ), INT( _TSCP( 12 ) ) ), 3 ) ) goto L2866; if ( GT( INT( X2 ), INT( _TSCP( 12 ) ) ) ) goto L2870; POPSTACKTRACE( a2415 ); L2866: if ( TRUE( scrt2__3e_2dtwo( X2, _TSCP( 12 ) ) ) ) goto L2870; POPSTACKTRACE( a2415 ); L2870: if ( BITAND( BITOR( INT( X2 ), INT( _TSCP( 12 ) ) ), 3 ) ) goto L2875; X4 = _TSCP( IDIFFERENCE( INT( X2 ), INT( _TSCP( 12 ) ) ) ); goto L2876; L2875: X4 = scrt2__2d_2dtwo( X2, _TSCP( 12 ) ); L2876: X3 = scrt3_substring( a2415, X4, X2 ); if ( FALSE( scrt3_string_3d_3f( X3, c2443 ) ) ) goto L2873; X3 = CONS( a2415, EMPTYLIST ); scrt6_format( TRUEVALUE, CONS( c2445, X3 ) ); X3 = SYMBOL_VALUE( initialize_2dcompile_v ); X3 = UNKNOWNCALL( X3, 0 ); VIA( PROCEDURE_CODE( X3 ) )( PROCEDURE_CLOSURE( X3 ) ); X3 = f2416; L2879: if ( EQ( UNSIGNED( X3 ), UNSIGNED( EMPTYLIST ) ) ) goto L2880; if ( EQ( TSCPTAG( X3 ), PAIRTAG ) ) goto L2884; scrt1__24__car_2derror( X3 ); L2884: X4 = PAIR_CAR( X3 ); X6 = scrt6_read( CONS( scrt5_open_2dinput_2dstring( X4 ), EMPTYLIST ) ); X5 = SYMBOL_VALUE( do_2ddefine_2dconstant_v ); X5 = UNKNOWNCALL( X5, 1 ); VIA( PROCEDURE_CODE( X5 ) )( X6, PROCEDURE_CLOSURE( X5 ) ); X3 = PAIR_CDR( X3 ); goto L2879; L2880: SETGENTL( SYMBOL_VALUE( sc_2dinclude_2ddirs_v ), main_include_2ddirs_v ); X4 = scrt5_open_2dinput_2dfile( a2415 ); X3 = sc_cons( X4, EMPTYLIST ); SETGENTL( SYMBOL_VALUE( sc_2dinput_v ), X3 ); SETGENTL( SYMBOL_VALUE( sc_2dsource_2dname_v ), a2415 ); 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 ), l2417 ); SETGENTL( SYMBOL_VALUE( sc_2dstack_2dtrace_v ), s2418 ); SETGENTL( SYMBOL_VALUE( sc_2dinterpreter_v ), i2419 ); 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 L2891; if ( NEQ( UNSIGNED( X3 ), UNSIGNED( _TSCP( 0 ) ) ) ) goto L2895; goto L2898; L2891: if ( TRUE( scrt2_zero_3f( X3 ) ) ) goto L2898; L2895: X4 = scrt6_reset_v; X4 = UNKNOWNCALL( X4, 0 ); VIA( PROCEDURE_CODE( X4 ) )( PROCEDURE_CLOSURE( X4 ) ); L2898: 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 ); L2873: POPSTACKTRACE( a2415 ); } void main__init(){} static void init_modules( compiler_version ) char *compiler_version; { scrt2__init(); scrt4__init(); scrt5__init(); scrt3__init(); scrt6__init(); scrt1__init(); screp__init(); callcode__init(); closeana__init(); compile__init(); expform__init(); gencode__init(); lambdacode__init(); lambdaexp__init(); lap__init(); macros__init(); misccode__init(); miscexp__init(); plist__init(); readtext__init(); transform__init(); MAXDISPLAY( 1 ); } main( argc, argv ) int argc; char *argv[]; { static int init = 0; if (init) return; init = 1; INITHEAP( 0, argc, argv, main_configure ); init_constants(); init_modules( "(main SCHEME->C COMPILER 01nov91jfb)" ); INITIALIZEVAR( U_TX( ADR( t2650 ) ), ADR( main_scc_2dversion_v ), c2010 ); INITIALIZEVAR( U_TX( ADR( t2651 ) ), ADR( main_force_2dld_2dof_2drep_v ), screp_read_2deval_2dprint_v ); INITIALIZEVAR( U_TX( ADR( t2652 ) ), ADR( main_sc_2dto_2dc_2ec_v ), c2013 ); INITIALIZEVAR( U_TX( ADR( t2653 ) ), ADR( main_sc_2dto_2dc_2eo_v ), c2015 ); INITIALIZEVAR( U_TX( ADR( t2654 ) ), ADR( main_predef_2ddefault_v ), c2017 ); INITIALIZEVAR( U_TX( ADR( t2655 ) ), ADR( main_c_2dinclude_2dfile_v ), c2019 ); INITIALIZEVAR( U_TX( ADR( t2656 ) ), ADR( main_c_2dinclude_2ddir_v ), c2021 ); INITIALIZEVAR( U_TX( ADR( t2657 ) ), ADR( main_sc_2dlibrary_v ), c2023 ); INITIALIZEVAR( U_TX( ADR( t2658 ) ), ADR( main_sc_2dlibrary__p_v ), sc_emptystring ); INITIALIZEVAR( U_TX( ADR( t2659 ) ), ADR( main_sc_2dprocessor_v ), c2026 ); INITIALIZEVAR( U_TX( ADR( t2660 ) ), ADR( main_configure_v ), MAKEPROCEDURE( 1, 0, main_configure, EMPTYLIST ) ); INITIALIZEVAR( U_TX( ADR( t2662 ) ), ADR( main_module_2dnames_v ), EMPTYLIST ); INITIALIZEVAR( U_TX( ADR( t2663 ) ), ADR( main_include_2ddirs_v ), c2034 ); INITIALIZEVAR( U_TX( ADR( t2664 ) ), ADR( main_scc_v ), MAKEPROCEDURE( 1, 0, main_scc, EMPTYLIST ) ); INITIALIZEVAR( U_TX( ADR( t2850 ) ), ADR( main_do_2dc_2dflag_v ), MAKEPROCEDURE( 5, 0, main_do_2dc_2dflag, EMPTYLIST ) ); main_configure( CLARGUMENTS( argc, argv ) ); SCHEMEEXIT(); } \End\Of\Shar\ echo "Finished archive 1 of 1" exit