Unpack disk4.tgz
This commit is contained in:
parent
777c904054
commit
3855274aa5
|
@ -0,0 +1,136 @@
|
|||
/* =====> ASM_LINK.C */
|
||||
/* TIPC Scheme '84 Runtime Support - Linkage to non-Scheme Routines
|
||||
(C) Copyright 1984,1985 by Texas Instruments Incorporated.
|
||||
All rights reserved.
|
||||
|
||||
Author: John C. Jensen
|
||||
Installation: Texas Instruments Incorporated, Dallas, Texas
|
||||
Division: Central Research Laboratories
|
||||
Cost Center: Computer Science Laboratory
|
||||
Project: Computer Architecture Branch
|
||||
Date Written: 20 June 1985
|
||||
Last Modification: 18 October 1985
|
||||
*/
|
||||
|
||||
#include "scheme.h"
|
||||
|
||||
asm_link(n_args, arg1, arg2, arg3, arg4, arg5, arg6, arg7)
|
||||
int n_args; /* the number of actual arguments */
|
||||
int arg1[2],arg2[2],arg3[2],arg4[2],arg5[2],arg6[2],arg7[2];
|
||||
{
|
||||
int i; /* the usual index variable */
|
||||
int page,disp; /* page and displacement components of a pointer */
|
||||
long *p[7]; /* pointers to arguments */
|
||||
int **ptr; /* pointer to current argument register address */
|
||||
double result_value; /* return area for result */
|
||||
double *result; /* pointer to result returned */
|
||||
int return_code = 0; /* return_code to send back to Scheme support */
|
||||
int stat; /* status returned from called procedure */
|
||||
int str_len[7]; /* length of dynamically allocated strings */
|
||||
|
||||
long integers[7];
|
||||
int chars[7];
|
||||
double flonums[7];
|
||||
char *strings[7];
|
||||
|
||||
char *string_asciz();
|
||||
double get_flo();
|
||||
|
||||
ENTER(asm_link);
|
||||
|
||||
/* null out string pointers */
|
||||
for (i = 0; i < 7; i++)
|
||||
{
|
||||
p[i] = NULL;
|
||||
strings[i] = NULL;
|
||||
str_len[i] = 0;
|
||||
}
|
||||
|
||||
/* create a C version of each argument */
|
||||
result = &result_value;
|
||||
ptr = &arg1;
|
||||
for (i = n_args-1; i >= 0; i--, ptr++)
|
||||
{
|
||||
page = CORRPAGE((*ptr)[C_PAGE]);
|
||||
disp = (*ptr)[C_DISP];
|
||||
switch (ptype[page])
|
||||
{
|
||||
case STRTYPE*2: strings[i] = string_asciz(*ptr);
|
||||
str_len[i] = get_word(page,disp+1);
|
||||
if (str_len[i] < 0) /* Adjust for small strings */
|
||||
str_len[i] = str_len[i] + BLK_OVHD + 1;
|
||||
else
|
||||
str_len[i] = str_len[i] - BLK_OVHD + 1;
|
||||
p[i] = (long *) strings[i];
|
||||
break;
|
||||
|
||||
case BIGTYPE*2:
|
||||
case FIXTYPE*2: if (int2long(integers+i, *ptr))
|
||||
goto bad_arg;
|
||||
p[i] = (long *) (integers+i);
|
||||
break;
|
||||
|
||||
case FLOTYPE*2: flonums[i] = get_flo(page, disp);
|
||||
p[i] = (long *) (flonums+i);
|
||||
break;
|
||||
|
||||
case CHARTYPE*2: chars[i] = get_char(page,disp);
|
||||
p[i] = (long *) (chars+i);
|
||||
break;
|
||||
bad_arg:
|
||||
default: return(1);
|
||||
} /* end: switch (ptype[page]) */
|
||||
} /* end: for (i = 0; i < n_args; i++, ptr++) */
|
||||
|
||||
/* all arguments ready-- call the interface routine */
|
||||
stat = link(&result,p[0],p[1],p[2],p[3],p[4],p[5],p[6]);
|
||||
|
||||
/* fetch result returned from low level return and make it a Scheme object */
|
||||
ptr = ((int **) &arg1) + (n_args - 1);
|
||||
switch (stat)
|
||||
{
|
||||
case 1: /* 't or 'nil */
|
||||
if (*((int *) result))
|
||||
{
|
||||
(*ptr)[C_PAGE] = T_PAGE*2;
|
||||
(*ptr)[C_DISP] = T_DISP;
|
||||
}
|
||||
else
|
||||
{
|
||||
(*ptr)[C_PAGE] = (*ptr)[C_DISP] = 0;
|
||||
}
|
||||
case 0: /* no value returned */
|
||||
break;
|
||||
|
||||
case 2: /* integer */
|
||||
long2int(*ptr, *((long *) result));
|
||||
break;
|
||||
|
||||
case 3: /* flonum */
|
||||
alloc_flonum(*ptr, *result);
|
||||
break;
|
||||
|
||||
case 4: /* character */
|
||||
(*ptr)[C_PAGE] = SPECCHAR*2;
|
||||
(*ptr)[C_DISP] = *((char *) result);
|
||||
break;
|
||||
|
||||
case 5: /* string */
|
||||
alloc_string(*ptr, result);
|
||||
break;
|
||||
|
||||
default: /* error */
|
||||
return_code = 1;
|
||||
} /* end: switch (stat) */
|
||||
|
||||
/* release memory allocated to character strings */
|
||||
for (i = 0; i < 7; i++)
|
||||
{
|
||||
if (strings[i])
|
||||
if (rlsmem(strings[i], str_len[i]))
|
||||
rlsmem_error(rtn_name);
|
||||
}
|
||||
|
||||
return(return_code);
|
||||
} /* end of function: asm_link(n_args, arg1, arg2, ... , arg7) */
|
||||
|
|
@ -0,0 +1,39 @@
|
|||
/* =====> FREESP.C */
|
||||
/* TIPC Scheme '84 -- Freespace Utility
|
||||
(C) Copyright 1984,1985 by Texas Instruments Incorporated.
|
||||
All rights reserved.
|
||||
|
||||
Author: Terry Caudill
|
||||
Date Written: 07 August 1985
|
||||
Last Modification:
|
||||
*/
|
||||
|
||||
#include "ctype.h"
|
||||
#include "scheme.h"
|
||||
|
||||
/**********************************************************************/
|
||||
/* TIPC Scheme '84 Free Space */
|
||||
/* */
|
||||
/* Purpose: This Routine will return the number of bytes of free */
|
||||
/* user memory. */
|
||||
/**********************************************************************/
|
||||
long int freesp()
|
||||
{
|
||||
int space[NUMPAGES]; /* Free memory per page array */
|
||||
int i; /* index var */
|
||||
long int bytes_free; /* word to sum bytes available */
|
||||
|
||||
ENTER(freesp);
|
||||
|
||||
sum_space(space);
|
||||
bytes_free = 0;
|
||||
|
||||
for (i = DEDPAGES; i < lastpage; i++)
|
||||
if (ptype[i] == FREETYPE*2)
|
||||
bytes_free = bytes_free + psize[i];
|
||||
else
|
||||
bytes_free = bytes_free + space[i];
|
||||
|
||||
return (bytes_free);
|
||||
}
|
||||
|
|
@ -0,0 +1,133 @@
|
|||
/* =====> GET_PORT */
|
||||
/* Copyright 1985 by Texas Instruments Incorporated.
|
||||
All Rights Reserved.
|
||||
|
||||
Author: John C. Jensen
|
||||
Installation: Texas Instruments Incorporated, Dallas, Texas
|
||||
Project: Computer Architecture Branch
|
||||
Date Written: January 1985
|
||||
Last Modification: 18 October 1985
|
||||
*/
|
||||
|
||||
#include "ctype.h"
|
||||
#include "scheme.h"
|
||||
|
||||
char *getmem(); /* Lattice C's memory allocation function */
|
||||
|
||||
/************************************************************************/
|
||||
/* Determine Port */
|
||||
/* */
|
||||
/* Purpose: To determine is a register contains a valid port object */
|
||||
/* representation and to return the appropriate port */
|
||||
/* pointer in "tmp_reg". */
|
||||
/************************************************************************/
|
||||
get_port(reg, mode)
|
||||
int reg[2], mode;
|
||||
{
|
||||
int disp; /* displacement component of a pointer */
|
||||
int page; /* page number component of a pointer */
|
||||
|
||||
/* fetch page and displacement portions of port pointer */
|
||||
page = CORRPAGE(reg[C_PAGE]);
|
||||
disp = reg[C_DISP];
|
||||
|
||||
/* check to see if port pointer is nil-- if so, search fluid env */
|
||||
if (!page)
|
||||
{
|
||||
if (mode) intern (tmp_reg, "OUTPUT-PORT", 11);
|
||||
else intern (tmp_reg, "INPUT-PORT", 10);
|
||||
|
||||
/* search fluid environment for interned symbol */
|
||||
ASSERT(fluid_lookup(tmp_reg));
|
||||
page = CORRPAGE(tmp_page);
|
||||
disp = tmp_disp;
|
||||
} /* end: if (!page) */
|
||||
|
||||
/* At this point, the page, disp should point to a port, or the
|
||||
symbol 'console */
|
||||
if (ptype[page] != PORTTYPE*2)
|
||||
{
|
||||
if (CORRPAGE(CON_PAGE) != page || CON_DISP != disp) return(1);
|
||||
tmp_page = SPECPOR*2;
|
||||
tmp_disp = (mode ? OUT_DISP : IN_DISP);
|
||||
}
|
||||
else
|
||||
{
|
||||
tmp_page = ADJPAGE(page);
|
||||
tmp_disp = disp;
|
||||
}
|
||||
return(0);
|
||||
} /* end of function: get_port(reg, mode) */
|
||||
|
||||
/***** Code turned off 17 May 1985 (JCJ) *****
|
||||
/************************************************************************/
|
||||
/* file-exists? Predicate */
|
||||
/* */
|
||||
/* Purpose: To support the "file-exists?" predicate for the Scheme */
|
||||
/* interpreter. */
|
||||
/* */
|
||||
/* Author: John C. Jensen */
|
||||
/* Installation: Texas Instruments Incorporated, Dallas, Texas */
|
||||
/* Department: Computer Science Laboratory */
|
||||
/* Project: Computer Architecture Branch */
|
||||
/* Date Written: 17 January 1985 */
|
||||
/* Last Modification: 17 January 1985 */
|
||||
/* */
|
||||
/* Calling Sequence: file_exists(reg) */
|
||||
/* where reg - VM register containing the string */
|
||||
/* which is the filename of the */
|
||||
/* file in question. The contents */
|
||||
/* of this register is replaced */
|
||||
/* with the 't if the file exists */
|
||||
/* or 'nil if it does not. */
|
||||
/************************************************************************/
|
||||
file_exists(reg)
|
||||
int reg[2]; /* parameter register */
|
||||
{
|
||||
char *buffer; /* character buffer for filename */
|
||||
int disp; /* displacement component of a pointer */
|
||||
int handle; /* file "handle" */
|
||||
int len; /* length of the file name (bytes) */
|
||||
int page; /* page number component of a pointer */
|
||||
int retstat = 0; /* return status */
|
||||
int type; /* type code of a pointer */
|
||||
ENTER (file_ex);
|
||||
|
||||
page = CORRPAGE(reg[C_PAGE]);
|
||||
disp = reg[C_DISP];
|
||||
type = ptype[page];
|
||||
|
||||
switch (type)
|
||||
{
|
||||
case STRTYPE*2: len = get_word(page, disp+1) - BLK_OVHD;
|
||||
if (!(buffer = getmem(len+1))) getmem_error(rtn_name);
|
||||
get_str(buffer, page, disp);
|
||||
buffer[len] = '\0';
|
||||
if (zopen(&handle, buffer, 0, &retstat, &retstat))
|
||||
{ /* open failed-- file does not exist */
|
||||
reg[C_PAGE] = reg[C_DISP] = 0;
|
||||
}
|
||||
else
|
||||
{ /* open succeeded-- close file and return 't */
|
||||
zclose (handle);
|
||||
reg[C_PAGE] = T_PAGE*2;
|
||||
reg[C_DISP] = T_DISP;
|
||||
}
|
||||
rlsstr(buffer);
|
||||
break;
|
||||
|
||||
case SYMTYPE*2: if (CON_PAGE == reg[C_PAGE] && CON_DISP == reg[C_DISP])
|
||||
{
|
||||
reg[C_PAGE] = T_PAGE*2;
|
||||
reg[C_DISP] = T_DISP;
|
||||
break;
|
||||
}
|
||||
|
||||
default: /* invalid source operand */
|
||||
set_src_err("FILE-EXISTS?", 1, reg);
|
||||
retstat = -1;
|
||||
} /* end: case (type) */
|
||||
return(retstat);
|
||||
} /* end of function: file_exists(reg) */
|
||||
***** Code turned off 17 May 1985 (JCJ) *****/
|
||||
|
|
@ -0,0 +1,618 @@
|
|||
/* =====> MAKE_FSL.C */
|
||||
/* TIPC Scheme Runtime Support - Conversion To Fast Load Format
|
||||
(C) Copyright 1984,1985,1987 by Texas Instruments Incorporated.
|
||||
All rights reserved.
|
||||
|
||||
Author: John C. Jensen
|
||||
Installation: Texas Instruments Incorporated, Dallas, Texas
|
||||
Division: Central Research Laboratories
|
||||
Cost Center: Computer Science Laboratory
|
||||
Project: Computer Architecture Branch
|
||||
Date Written: 27 December 1984
|
||||
Last Modification: 17 October 1985
|
||||
|
||||
Purpose: To convert PC Scheme object programs into a fast-load format.
|
||||
|
||||
Description: Object programs are read in by the make_fsl utility and an
|
||||
equivalent fast-load representation is output. This utility
|
||||
preforms similarly to the Scheme reader, but it understands
|
||||
only enough about s-expressions to read in valid object
|
||||
programs in a standard format. Any error condition will
|
||||
abort the exectution of this utility.
|
||||
|
||||
The format of the object module which can be read by
|
||||
this utility is:
|
||||
|
||||
(execute (quote (pcs-code-block #consts #codebytes (constants) (code))))
|
||||
|
||||
where pcs-code-block is a compiler generated tag indicating
|
||||
that this is an object module.
|
||||
#consts is an integer value indicating the number of
|
||||
source contants in the compiled program.
|
||||
This is the number of entries in the
|
||||
"constants" list (see below).
|
||||
#codebytes is an integer value indicating the number
|
||||
of bytes of executable code in the compiled
|
||||
program. This is the number of entries in
|
||||
the "code" list (see below).
|
||||
(constants) is a list of program constants. Each
|
||||
constant is a Scheme s-expression in its
|
||||
ASCII source representation.
|
||||
(code) is a list of integer values representing the
|
||||
executable code of the compiled program.
|
||||
|
||||
Invocation: The MAKE_FSL utility is executed by entering the following
|
||||
command to MS-DOS:
|
||||
|
||||
MAKE_FSL PROGRAM.SO PROGRAM.FSL {/copyright}
|
||||
|
||||
where PROGRAM.SO is a valid MS-DOS file name of a file
|
||||
containing the object program (the output
|
||||
of the PC Scheme compiler),
|
||||
|
||||
PROGRAM.FSL is a valid MS-DOS file name of the file
|
||||
which is to contain the fast-load
|
||||
representation produced by this utility.
|
||||
|
||||
/copyright is an optional flag which indicates that,
|
||||
instead of the standard fast-load module
|
||||
header record, a TI copyright notice is
|
||||
to be inserted in the output file.
|
||||
|
||||
Note: The /copyright option is an undocumented feature designed to
|
||||
add some measure of protection for TI proprietary software. This
|
||||
capability is not intended to be visible to the general user
|
||||
community and is not documented in any of the messages produced
|
||||
by this utility.
|
||||
|
||||
Modification History:
|
||||
02 Feb 86 - Made two changes which corrected problems in reading
|
||||
symbols containing backslash characters. According to
|
||||
the Common Lisp standard, a backslash is an escape
|
||||
character, which causes the character following it to
|
||||
be accepted as part of the symbol.
|
||||
rb 15 Oct 86 - changed %x to %X; fasl expects uppercase and Lattice C
|
||||
now distinguishes the two printf formats
|
||||
*/
|
||||
#include "stdio.h"
|
||||
#include "ctype.h"
|
||||
|
||||
#include "schars.h" /* copy in special character definitions */
|
||||
|
||||
#define MAX_STRING_LENGTH 8192 /* maximum string length */
|
||||
|
||||
#define TRUE 1
|
||||
#define FALSE 0
|
||||
#define skip_space() ch=fgetc(in_file); while(isspace(ch))ch=fgetc(in_file);
|
||||
|
||||
static FILE *in_file, *out_file; /* input/output file pointers */
|
||||
static int count = 0; /* count of characters in current record */
|
||||
|
||||
static char *month[12] = {"Jan","Feb","Mar","Apr","May","Jun",
|
||||
"Jul","Aug","Sep","Oct","Nov","Dec"};
|
||||
|
||||
int _stack = 12288; /* Increase Lattice C's default stack size */
|
||||
|
||||
int _fmode = 0; /* default files to text mode translation */
|
||||
|
||||
char *getmem(); /* Lattice C's memory allocation routine */
|
||||
|
||||
main(argc, argv)
|
||||
int argc; /* number of arguments */
|
||||
char *argv[]; /* array of ptrs to arg strings */
|
||||
{
|
||||
int cflag = FALSE; /* copyright notice flag */
|
||||
int ch; /* current character */
|
||||
int codebytes = 0; /* number of codebytes */
|
||||
int constants = 0; /* number of constants */
|
||||
int date[3]; /* array to receive current date */
|
||||
int module = 0; /* module count */
|
||||
int n; /* number of fields read */
|
||||
int time[4]; /* array to receive current time */
|
||||
static char *invalid_module = "***Error-- Invalid Object Module***\n%s\n";
|
||||
|
||||
/* Print Welcome to Scheme */
|
||||
printf("\nFast-Load Conversion Utility for PC Scheme\n%s%s%s\n",
|
||||
" Version 3.03 7 June 88\n",
|
||||
" (C) Copyright 1987 by Texas Instruments\n",
|
||||
" All Rights Reserved.\n");
|
||||
|
||||
/* test for generation of copyright notice */
|
||||
if (argc == 4)
|
||||
{
|
||||
if (!strcmp(argv[3], "/copyright"))
|
||||
{
|
||||
cflag = TRUE;
|
||||
argc = 3;
|
||||
}
|
||||
}
|
||||
|
||||
/* test for proper number of arguments */
|
||||
if (argc != 3)
|
||||
{
|
||||
printf("***Error-- Wrong Number of Arguments to MAKE_FSL***\n");
|
||||
describe:
|
||||
printf("\nMAKE_FSL expects two file names as follows:\n\n%s%s%s%s%s",
|
||||
" MAKE_FSL PROGRAM.SO PROGRAM.FSL\n\n",
|
||||
"where PROGRAM.SO is the output of the 'compile-file' function of",
|
||||
" the PC Scheme Compiler\n",
|
||||
" PROGRAM.FSL is the name of the file which is to contain the\n",
|
||||
" output of the MAKE_FSL utility.\n");
|
||||
exit();
|
||||
}
|
||||
|
||||
/* open input file */
|
||||
_fmode = 0x8000; /* make files use binary (untranslated) output */
|
||||
if (!(in_file = fopen(argv[1], "r")))
|
||||
{
|
||||
printf("***Error-- Unable to Open Input File '%s'***\n", argv[1]);
|
||||
goto describe;
|
||||
}
|
||||
|
||||
/* open output file */
|
||||
if (!(out_file = fopen(argv[2], "w")))
|
||||
{
|
||||
printf("***Error-- Unable to Open Output File '%s'***\n", argv[2]);
|
||||
goto describe;
|
||||
}
|
||||
_fmode = 0; /* reset to text mode translation */
|
||||
|
||||
/* obtain current time and date */
|
||||
get_date(date);
|
||||
|
||||
/* Output header record(s) to output file */
|
||||
if (cflag)
|
||||
{
|
||||
/* Output TI Copyright notice */
|
||||
fprintf(out_file,
|
||||
"#!fast-load (C) Copyright %4d by Texas Instruments\r\n%s",date[2],
|
||||
"#!fast-load All Rights Reserved.\r\n");
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Output module header to output file */
|
||||
get_time(time);
|
||||
fprintf(out_file, "#!fast-load Version 3.0 %2d %s %2d %02d:%02d:%02d\r\n",
|
||||
date[1], month[date[0]-1], date[2]-1900, time[0], time[1], time[2]);
|
||||
}
|
||||
|
||||
/* read 'til end-of-file */
|
||||
skip_space();
|
||||
while (ch != EOF && ch != '\032')
|
||||
{
|
||||
/* read (skip over) object module "header" */
|
||||
n = -1;
|
||||
if (ch != '(') goto oops_header;
|
||||
ch = fgetc(in_file);
|
||||
if (ch == '%') ch = fgetc(in_file); /* "optional" % in front of execute */
|
||||
for (n = 0; n < 30; n++)
|
||||
{
|
||||
ch = tolower(ch);
|
||||
if (ch != "execute (quote (pcs-code-block "[n])
|
||||
{
|
||||
oops_header:
|
||||
printf(invalid_module, "Bad Module Header");
|
||||
printf("n = %d ch = '%c'\n", n, ch);
|
||||
exit();
|
||||
}
|
||||
ch = fgetc(in_file);
|
||||
}
|
||||
|
||||
/* read number of constants, number of code bytes */
|
||||
fscanf(in_file, "%d %d", &constants, &codebytes);
|
||||
fprintf(out_file, "h%04X %04X\r\n", constants, codebytes);
|
||||
|
||||
/* skip over '(' which begins constants list */
|
||||
skip_space();
|
||||
if (ch != '(')
|
||||
{
|
||||
if (constants || ch != 'n' || (ch = fgetc(in_file)) != 'i' ||
|
||||
(ch = fgetc(in_file)) != 'l')
|
||||
{
|
||||
printf (invalid_module, "Bad Start of Constants List");
|
||||
printf("ch = '%c'\n", ch);
|
||||
exit();
|
||||
}
|
||||
else goto good_const;
|
||||
}
|
||||
|
||||
/* read and output constants */
|
||||
for (n = 0; n < constants; n++)
|
||||
{
|
||||
count = 0;
|
||||
process_constant();
|
||||
fprintf(out_file, "\r\n");
|
||||
}
|
||||
|
||||
/* make sure constants list was exhausted */
|
||||
skip_space();
|
||||
if (ch != ')')
|
||||
{
|
||||
printf (invalid_module, "Bad End of Constants List");
|
||||
printf("ch = '%c'\n", ch);
|
||||
exit();
|
||||
}
|
||||
good_const:
|
||||
/* output start of code bytes */
|
||||
fputc('t', out_file);
|
||||
|
||||
/* read and format code bytes */
|
||||
skip_space();
|
||||
if (ch != '(')
|
||||
{
|
||||
printf(invalid_module,"Bad Start of Codebytes");
|
||||
printf("Looking For '('\n");
|
||||
exit();
|
||||
}
|
||||
|
||||
for (count = n = 0; n < codebytes; n++)
|
||||
{
|
||||
fscanf(in_file, "%d", &ch);
|
||||
fprintf(out_file, "%c", (ch & 0x00ff));
|
||||
count++;
|
||||
/* if (count++ == 34)
|
||||
{
|
||||
fprintf(out_file, "\r\n");
|
||||
count = 0;
|
||||
} */
|
||||
}
|
||||
if (count) fprintf(out_file, "\r\n"); /* complete last text record */
|
||||
|
||||
/* flush closing parenthesis from program's end */
|
||||
for (n = 0; n < 4; n++)
|
||||
{
|
||||
skip_space();
|
||||
if (ch != ')')
|
||||
{
|
||||
printf(invalid_module,"Closing Parenthesis");
|
||||
exit();
|
||||
}
|
||||
}
|
||||
|
||||
/* write trailer record for object program */
|
||||
fprintf(out_file, "z\r\n");
|
||||
printf("module %d complete\n", module++);
|
||||
|
||||
/* skip over white space at end of program */
|
||||
skip_space();
|
||||
}
|
||||
|
||||
/* close the input and output files */
|
||||
if (fclose(in_file)) printf("***Error Closing Input File***\n");
|
||||
if (fclose(out_file)) printf("***Error Closing Output File***\n");
|
||||
|
||||
} /* end of function: main(argc, argv) */
|
||||
|
||||
/************************************************************************/
|
||||
/* Process Constant List Entry */
|
||||
/************************************************************************/
|
||||
process_constant()
|
||||
{
|
||||
int big_parts[2]; /* the two words of a 32-bit bignum value */
|
||||
char buffer[300]; /* input buffer */
|
||||
int ch; /* the current character */
|
||||
char *ch_buffer; /* character string buffer (dynamic) */
|
||||
double flonum; /* a floating point value */
|
||||
int flo_parts[4]; /* the four words of a floating point value */
|
||||
int i,j; /* our old favorite index variables */
|
||||
int n; /* character count */
|
||||
int sign; /* sign flag for integer values */
|
||||
long value; /* accumulator for integer values */
|
||||
int vect_count; /* number of entries in a vector */
|
||||
long vect_end; /* ending offset in out_file for a vector */
|
||||
long vect_start; /* starting offset in out_file for a vector */
|
||||
|
||||
long ftell(); /* returns the current position of a file */
|
||||
|
||||
/* if current constant entry is "long enough", break this record */
|
||||
if (count > 72)
|
||||
{
|
||||
fprintf(out_file, "\r\n");
|
||||
count = 0;
|
||||
}
|
||||
|
||||
/* skip over white space in front of constant */
|
||||
skip_space();
|
||||
|
||||
/* make an initial attempt to decide the constant's type */
|
||||
switch (ch)
|
||||
{
|
||||
case '"': /* the beginnings of a character string */
|
||||
if (!(ch_buffer = getmem(MAX_STRING_LENGTH)))
|
||||
{
|
||||
printf("***Error-- Memory Exhausted***\n");
|
||||
exit();
|
||||
}
|
||||
n = 0;
|
||||
do {
|
||||
ch = fgetc(in_file);
|
||||
if (ch != '\r')
|
||||
{
|
||||
if (ch == '\\')
|
||||
{
|
||||
ch_buffer[n++] = fgetc(in_file);
|
||||
}
|
||||
else
|
||||
{
|
||||
ch_buffer[n++] = ch;
|
||||
}
|
||||
}
|
||||
} while (ch != '"');
|
||||
n--; /* decrement to remove the closing '"' */
|
||||
if (n > MAX_STRING_LENGTH)
|
||||
{
|
||||
printf("***Error-- String Too Long***\n%s",
|
||||
"MAKE_FSL limits strings to %d characters\n",
|
||||
MAX_STRING_LENGTH);
|
||||
exit();
|
||||
}
|
||||
fprintf(out_file, "s%04X", n);
|
||||
for (i = 0; i < n; i++) fputc(ch_buffer[i], out_file);
|
||||
count += (n + 3);
|
||||
if (rlsmem(ch_buffer, MAX_STRING_LENGTH))
|
||||
{
|
||||
printf("***Warning-- Release Memory Error***\n");
|
||||
}
|
||||
break;
|
||||
|
||||
case '(': /* begin a list */
|
||||
ch = fgetc(in_file);
|
||||
if (ch == ')')
|
||||
{ /* empty list found-- output "nil" */
|
||||
fputc('n', out_file);
|
||||
count++;
|
||||
goto blow_this_place;
|
||||
}
|
||||
else
|
||||
{
|
||||
nuther_list:
|
||||
ungetc(ch, in_file);
|
||||
fputc('l', out_file);
|
||||
count++;
|
||||
process_constant();
|
||||
skip_space();
|
||||
if (ch == ')')
|
||||
{
|
||||
fputc('n', out_file);
|
||||
count++;
|
||||
goto blow_this_place;
|
||||
}
|
||||
else
|
||||
{
|
||||
if (ch == '.')
|
||||
{
|
||||
ch = fgetc(in_file);
|
||||
if (!isspace(ch))
|
||||
{
|
||||
/* character after '.'-- it's a symbol */
|
||||
ungetc(ch, in_file);
|
||||
ch = '.';
|
||||
goto nuther_list;
|
||||
}
|
||||
process_constant();
|
||||
skip_space();
|
||||
if (ch != ')')
|
||||
{
|
||||
printf("***Error-- Invalid List Constant (cdr)***\n");
|
||||
exit();
|
||||
}
|
||||
goto blow_this_place;
|
||||
}
|
||||
else goto nuther_list;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
case '|': /* a special slashified symbol */
|
||||
n = 0;
|
||||
do {
|
||||
ch = fgetc(in_file);
|
||||
if (ch == '\\') ch = fgetc(in_file); /*** 2/14/86 ***/
|
||||
if (ch != '\r')
|
||||
{
|
||||
if (ch == '|')
|
||||
{
|
||||
if (n > 0x00ff)
|
||||
{
|
||||
printf("***Error-- Symbol Too Long***\n%s",
|
||||
"MAKE_FSL limits symbols to 255 characters\n");
|
||||
exit();
|
||||
}
|
||||
fprintf(out_file, "x%02X", n);
|
||||
for (i = 0; i < n; i++) fputc(buffer[i], out_file);
|
||||
count += (n+3);
|
||||
goto blow_this_place;
|
||||
}
|
||||
buffer[n++] = ch;
|
||||
}
|
||||
} while (TRUE);
|
||||
|
||||
case '#': /* special constants (we hope) */
|
||||
n = 0;
|
||||
buffer[n++] = ch;
|
||||
ch = fgetc(in_file);
|
||||
switch(ch)
|
||||
{
|
||||
case '\\': /* character constant */
|
||||
buffer[n++] = ch; /* store '\' */
|
||||
ch = fgetc(in_file);
|
||||
buffer[n++] = ch; /* store 1st character */
|
||||
ch = fgetc(in_file);
|
||||
while ((!isspace(ch)) && ch != ')')
|
||||
{
|
||||
buffer[n++] = ch;
|
||||
ch = fgetc(in_file);
|
||||
}
|
||||
if (ch == ')') ungetc(ch, in_file);
|
||||
if (n == 3)
|
||||
{
|
||||
fprintf(out_file, "c%02X", buffer[2]);
|
||||
count += 3;
|
||||
}
|
||||
else
|
||||
{ /* test for a multi-character character */
|
||||
buffer[n] = '\0';
|
||||
for (j = 0; j < test_num; j++)
|
||||
{
|
||||
if (!strcmp(buffer+2, test_string[j]))
|
||||
{
|
||||
fprintf(out_file, "c%02X", test_char[j]);
|
||||
count += 3;
|
||||
break;
|
||||
}
|
||||
if (j == test_num-1)
|
||||
{
|
||||
printf("Invalid Character Constant\n");
|
||||
exit();
|
||||
}
|
||||
} /* end: for (j = 0; j < test_num; j++) */
|
||||
}
|
||||
goto blow_this_place;
|
||||
|
||||
case '(': /* vector constant */
|
||||
vect_start = ftell(out_file);
|
||||
vect_count = 0;
|
||||
fprintf(out_file, "vxxxx");
|
||||
skip_space();
|
||||
while(ch != ')')
|
||||
{
|
||||
ungetc(ch, in_file);
|
||||
process_constant();
|
||||
vect_count++;
|
||||
skip_space();
|
||||
} /* end: while(ch != ')') */
|
||||
vect_end = ftell(out_file);
|
||||
if (fseek(out_file, vect_start, 0))
|
||||
{
|
||||
printf("file seek error-- vector start\n");
|
||||
exit();
|
||||
}
|
||||
fprintf(out_file, "v%04X", vect_count);
|
||||
if (fseek(out_file, vect_end, 0))
|
||||
{
|
||||
printf("file seek error-- vector end\n");
|
||||
exit();
|
||||
}
|
||||
goto blow_this_place;
|
||||
|
||||
default: /* other special constant */
|
||||
goto right_here; /* treat as a symbol */
|
||||
}
|
||||
|
||||
default: /* must look at symbol to see what it is */
|
||||
n = 0;
|
||||
right_here:
|
||||
while (!isspace(ch))
|
||||
{
|
||||
if (ch == ')')
|
||||
{
|
||||
ungetc(ch, in_file);
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
if (n >= sizeof(buffer)) goto too_long;
|
||||
buffer[n++] = ch;
|
||||
ch = fgetc(in_file);
|
||||
}
|
||||
}
|
||||
i = 0;
|
||||
if (buffer[0] == '-' && n > 1) i++;
|
||||
for (i; i < n; i++)
|
||||
{
|
||||
if (!isdigit(buffer[i]))
|
||||
{
|
||||
if (buffer[i] == '.' && (i > 0 || isdigit(buffer[i+1])))
|
||||
{
|
||||
buffer[n++] = '\0';
|
||||
sscanf(buffer, "%lf", &flonum);
|
||||
get_parts(flo_parts, flonum);
|
||||
fprintf(out_file, "f%04X%04X%04X%04X", flo_parts[0],
|
||||
flo_parts[1], flo_parts[2], flo_parts[3]);
|
||||
count += 17;
|
||||
goto blow_this_place;
|
||||
}
|
||||
else
|
||||
{ /* this here's got to be a symbol */
|
||||
if (n > 0x00ff)
|
||||
{
|
||||
too_long:
|
||||
printf("***Error-- Symbol Too Long***\n%s",
|
||||
"MAKE_FSL limits symbols to 255 characters\n");
|
||||
exit();
|
||||
}
|
||||
/* special fixup to remove escaping \'s */
|
||||
for (i=0; i<n; i++)
|
||||
{
|
||||
if (buffer[i] == '\\')
|
||||
{
|
||||
for (j=i; j < n-1; j++) buffer[j] = buffer[j+1];
|
||||
n--;
|
||||
}
|
||||
}
|
||||
fprintf(out_file, "x%02X", n);
|
||||
for (i = 0; i < n; i++) fputc(toupper(buffer[i]),
|
||||
out_file);
|
||||
count += (n + 3);
|
||||
goto blow_this_place;
|
||||
}
|
||||
} /* end: if (!isdigit(buffer[i]))) */
|
||||
} /* end: for (i; i < n; i++) */
|
||||
/* if loop exits, we've got a fixnum */
|
||||
i = sign = 0;
|
||||
value = 0L;
|
||||
if (buffer[0] == '-')
|
||||
{
|
||||
sign = 1;
|
||||
i++;
|
||||
}
|
||||
for (i; i < n; i++)
|
||||
{
|
||||
j = (buffer[i] - '0');
|
||||
if (value > ((0x7fffffff - j)/10))
|
||||
{
|
||||
printf("***Error-- Integer Too Big***\n%s",
|
||||
"MAKE_FSL requires integers be between -2,147,483,647 and 2,147,483,647\n");
|
||||
exit();
|
||||
}
|
||||
value = (value * 10) + j;
|
||||
}
|
||||
if (sign) value = -value;
|
||||
if (value <= 16383 && value >= -16384)
|
||||
{
|
||||
i = value & 0x00007fff;
|
||||
fprintf(out_file, "i%04X", i);
|
||||
count += 5;
|
||||
goto blow_this_place;
|
||||
}
|
||||
else
|
||||
{
|
||||
if (sign) value = -value;
|
||||
get_pieces(big_parts, value);
|
||||
fprintf(out_file, "b02%02X%04X%04X", (sign ? 1 : 0),
|
||||
big_parts[0], big_parts[1]);
|
||||
count += 13;
|
||||
}
|
||||
} /* end: switch (ch) */
|
||||
|
||||
blow_this_place:
|
||||
} /* end of function: process_constant() */
|
||||
|
||||
/************************************************************************/
|
||||
/* Coerce a floating point value to "words" */
|
||||
/************************************************************************/
|
||||
get_parts(flo_parts, flonum)
|
||||
double *flo_parts, flonum;
|
||||
{
|
||||
*flo_parts = flonum;
|
||||
}
|
||||
|
||||
/************************************************************************/
|
||||
/* Coerce a bignum value to "words" */
|
||||
/************************************************************************/
|
||||
get_pieces(big_parts, value)
|
||||
long *big_parts, value;
|
||||
{
|
||||
*big_parts = value;
|
||||
}
|
||||
|
|
@ -0,0 +1,110 @@
|
|||
#include "dos.h"
|
||||
#include "math.h"
|
||||
|
||||
#define F_NEAR 0x0001
|
||||
#define F_PAD 0x0008
|
||||
|
||||
#define RT_DOUBLE 3
|
||||
|
||||
typedef unsigned short WORD; /* 16-bit unsigned value */
|
||||
|
||||
extern WORD _psp; /* Lattice C variables */
|
||||
extern WORD _tsize;
|
||||
|
||||
/* Note xwait and xbye are the actual addresses we'll jump to when we
|
||||
call XLI from the glue routine. C calls the glue routine at the
|
||||
two entry points xli_wait and xli_bye. These 2 routines set
|
||||
up the stack for calling xwait and xbye. */
|
||||
WORD xwait[2]; /* XLI entry points */
|
||||
WORD xbye[2];
|
||||
|
||||
struct xli_file_struct {
|
||||
WORD id;
|
||||
WORD flags;
|
||||
WORD table[2]; /* offset in 0, segment in 1 */
|
||||
WORD parm_block[2];
|
||||
WORD reserved[8];
|
||||
} file_block;
|
||||
|
||||
struct xli_routine_struct {
|
||||
WORD select;
|
||||
WORD special_service;
|
||||
WORD ss_args[8];
|
||||
WORD reserved[8];
|
||||
WORD return_type;
|
||||
double return_value;
|
||||
double arg1;
|
||||
double arg2;
|
||||
} parm_block;
|
||||
|
||||
char table[] =
|
||||
/* 0 2 4 6 8 10 12 */
|
||||
"sqrt/sin/cos/tan/asin/acos/atan/atan2/exp/expt/ln/log10/log//";
|
||||
|
||||
|
||||
void main(argc,argv)
|
||||
int argc;
|
||||
char *argv[];
|
||||
{
|
||||
WORD psp;
|
||||
/*WORD memsize; */
|
||||
WORD buffer[2];
|
||||
struct SREGS segregs;
|
||||
int xli_wait();
|
||||
void xli_bye();
|
||||
|
||||
/* Note PSP@ is not necessarily directly accessible in any
|
||||
Lattice C memory model. */
|
||||
psp = *(&_psp+1); /* get seg addr of PSP */
|
||||
|
||||
/* init file block */
|
||||
file_block.id = 0x4252;
|
||||
file_block.flags = F_NEAR+F_PAD;
|
||||
file_block.table[0] = (WORD) table;
|
||||
file_block.parm_block[0] = (WORD) &parm_block;
|
||||
segread(&segregs);
|
||||
file_block.table[1] = segregs.ds;
|
||||
file_block.parm_block[1] = segregs.ds;
|
||||
|
||||
/* determine link address */
|
||||
buffer[0] = (WORD) &file_block;
|
||||
buffer[1] = segregs.ds;
|
||||
|
||||
/* determine size to keep */
|
||||
/*memsize = _tsize; */ /* done in glue routine for S Lattice */
|
||||
|
||||
/* establish the link addresses between C and PCS */
|
||||
poke((int) psp, 0x5c, (char *) buffer, 4); /* poke file block@ into PSP */
|
||||
peek((int) psp, 0x0a, (char *) xwait, 4); /* get DOS ret@ */
|
||||
xbye[0] = xwait[0];
|
||||
xbye[1] = xwait[1];
|
||||
xwait[0] += 3; /* incr by 3 for normal call */
|
||||
xbye[0] += 6; /* incr by 6 for termination */
|
||||
|
||||
while (xli_wait()) {
|
||||
switch (parm_block.select) {
|
||||
case 0: parm_block.return_value = sqrt(parm_block.arg1); break;
|
||||
case 1: parm_block.return_value = sin(parm_block.arg1); break;
|
||||
case 2: parm_block.return_value = cos(parm_block.arg1); break;
|
||||
case 3: parm_block.return_value = tan(parm_block.arg1); break;
|
||||
case 4: parm_block.return_value = asin(parm_block.arg1); break;
|
||||
case 5: parm_block.return_value = acos(parm_block.arg1); break;
|
||||
case 6: parm_block.return_value = atan(parm_block.arg1); break;
|
||||
case 7: parm_block.return_value =
|
||||
atan2(parm_block.arg1,parm_block.arg2); break;
|
||||
case 8: parm_block.return_value = exp(parm_block.arg1); break;
|
||||
case 9: parm_block.return_value =
|
||||
pow(parm_block.arg1,parm_block.arg2); break;
|
||||
case 10: parm_block.return_value = log(parm_block.arg1); break;
|
||||
case 11: parm_block.return_value = log10(parm_block.arg1); break;
|
||||
case 12: parm_block.return_value =
|
||||
log(parm_block.arg1) / log(parm_block.arg2); break;
|
||||
default: ;
|
||||
} /* end switch */
|
||||
parm_block.return_type = RT_DOUBLE;
|
||||
} /* end while */
|
||||
|
||||
xli_bye();
|
||||
|
||||
} /* end main */
|
||||
|
|
@ -0,0 +1,18 @@
|
|||
SC+SCHEMED+sinterp+smain+
|
||||
INTRUP+SSTRING+SMEMORY+SGCMARK+SGCSWEEP+
|
||||
SBIGMEM+SEXEC+SUPPORT+
|
||||
SHASH+SSTACK+SARITH+SUTIL+SERROR+
|
||||
sdebug+sdump+STRACE+
|
||||
sprint+cprint+cprint1+
|
||||
SERRMSG+SIO+SBIGMATH+
|
||||
sread+cread+zcio+sin_out+cio+cwindow+
|
||||
SCAR_CDR+SVARS+SAPROP+SPROP+MSDOS+
|
||||
SRESET+GET_PORT+SFASL+
|
||||
zio+SREIFY+SENV+
|
||||
sprintf+SCANNUM+STIMER+GET_PATH+
|
||||
SOBJHASH+ASM_LINK+GRAPHCMD+
|
||||
border+SLINK+ALINK+SBID+
|
||||
STRMLNRS+SRCH_STR+SQUISH+
|
||||
SRELOCAT+FREESP+SCROLL+
|
||||
SW_INT+FLO2HEX+SMMU+BLOCK+XLI
|
||||
|
|
@ -0,0 +1,444 @@
|
|||
# PC Scheme 4.0 make file: Conventional memory PCS
|
||||
|
||||
#
|
||||
# command-line macro variables
|
||||
#
|
||||
|
||||
redo= # if nonempty, force make to do everything here
|
||||
debug= # if nonempty, generate symbol file
|
||||
|
||||
#
|
||||
# directories
|
||||
#
|
||||
|
||||
tools=\tools # read-only
|
||||
lib=\lib # read-only
|
||||
src=\build # read-only
|
||||
obj=\object # read-write
|
||||
exec=\exec # read-write
|
||||
|
||||
#
|
||||
# rules
|
||||
#
|
||||
|
||||
.asm.obj:
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
|
||||
.c.obj:
|
||||
$(tools)\lc -dREGMEM -ms -ccdswum -o$@ $*
|
||||
|
||||
#
|
||||
# make-specific initialization
|
||||
#
|
||||
|
||||
# if redo on command line specified, build the entire system
|
||||
:
|
||||
if not "$(redo)"=="" del $(obj)\*.obj
|
||||
if not "$(redo)"=="" del $(exec)\pcs.*
|
||||
|
||||
#
|
||||
# application-specific initialization
|
||||
#
|
||||
|
||||
:
|
||||
cd $(src)
|
||||
path $(tools)
|
||||
|
||||
#
|
||||
# assembly language files
|
||||
#
|
||||
|
||||
$(src)\schemed.equ: $(src)\memtype.equ
|
||||
$(tools)\touch schemed.equ
|
||||
|
||||
$(src)\scheme.equ: $(src)\schemed.equ $(src)\schemed.ref $(src)\schemed.mac \
|
||||
$(src)\smmu.mac
|
||||
$(tools)\touch scheme.equ
|
||||
|
||||
$(obj)\alink.obj: $(src)\alink.asm
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
|
||||
$(obj)\block.obj: $(src)\block.asm $(src)\scheme.equ $(src)\memtype.equ
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
|
||||
$(obj)\flo2hex.obj: $(src)\flo2hex.asm
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
|
||||
$(obj)\get_path.obj: $(src)\get_path.asm $(src)\scheme.equ
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
|
||||
#$(obj)\graphcmd.obj: $(src)\graphcmd.asm $(src)\pcmake.equ
|
||||
# $(tools)\masm /DREGMEM $*,$@;
|
||||
|
||||
# PCS 3.02 version: graphics integrated into VM
|
||||
$(obj)\graphcmd.obj: $(src)\graphics.asm $(src)\pcmake.equ
|
||||
$(tools)\masm /DREGMEM $(src)\graphics,$@ /Dcombined /Dti /Dibm;
|
||||
|
||||
$(obj)\intrup.obj: $(src)\intrup.asm $(src)\dos.mac $(src)\pcmake.equ
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
REM **** REMEMBER TO CHECK PROINTRP.ASM FOR PROTECTED MODE UPDATES ALSO ****
|
||||
|
||||
$(obj)\msdos.obj: $(src)\msdos.asm
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
|
||||
$(obj)\saprop.obj: $(src)\saprop.asm $(src)\scheme.equ
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
|
||||
$(obj)\sbid.obj: $(src)\sbid.asm
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
REM **** REMEMBER TO CHECK PROBID.ASM FOR PROTECTED MODE UPDATES ALSO ****
|
||||
|
||||
$(obj)\sbigmath.obj: $(src)\sbigmath.asm $(src)\scheme.equ
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
|
||||
$(obj)\sc.obj: $(src)\sc.asm $(src)\dos.mac
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
|
||||
$(obj)\scannum.obj: $(src)\scannum.asm
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
|
||||
$(obj)\scar_cdr.obj: $(src)\scar_cdr.asm $(src)\scheme.equ $(src)\sinterp.mac \
|
||||
$(src)\sinterp.arg
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
|
||||
$(obj)\schemed.obj: $(src)\schemed.asm $(src)\schemed.equ $(src)\sasm.mac
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
|
||||
$(obj)\senv.obj: $(src)\senv.asm $(src)\scheme.equ $(src)\sinterp.mac \
|
||||
$(src)\sinterp.arg $(src)\stackf.equ
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
|
||||
$(obj)\sexec.obj: $(src)\sexec.asm $(src)\scheme.equ
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
|
||||
$(obj)\sgcmark.obj: $(src)\sgcmark.asm $(src)\scheme.equ
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
|
||||
$(obj)\sgcsweep.obj: $(src)\sgcsweep.asm $(src)\scheme.equ
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
|
||||
$(obj)\sinterp.obj: $(src)\sinterp.asm $(src)\schemed.equ $(src)\schemed.ref \
|
||||
$(src)\schemed.mac $(src)\pcmake.equ $(src)\stackf.equ \
|
||||
$(src)\smmu.mac $(src)\sinterp.mac $(src)\sinterp.arg
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
|
||||
$(obj)\smmu.obj: $(src)\smmu.asm $(src)\schemed.equ $(src)\schemed.ref
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
|
||||
$(obj)\sobjhash.obj: $(src)\sobjhash.asm $(src)\scheme.equ
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
|
||||
$(obj)\squish.obj: $(src)\squish.asm $(src)\scheme.equ
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
|
||||
$(obj)\srch_str.obj: $(src)\srch_str.asm $(src)\scheme.equ $(src)\pcmake.equ \
|
||||
$(src)\sinterp.arg
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
|
||||
$(obj)\srelocat.obj: $(src)\srelocat.asm $(src)\scheme.equ
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
|
||||
$(obj)\sstack.obj: $(src)\sstack.asm $(src)\scheme.equ $(src)\sinterp.mac \
|
||||
$(src)\sinterp.arg $(src)\stackf.equ
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
|
||||
$(obj)\sstring.obj: $(src)\sstring.asm $(src)\scheme.equ $(src)\sinterp.mac \
|
||||
$(src)\sinterp.arg
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
|
||||
$(obj)\stimer.obj: $(src)\stimer.asm $(src)\scheme.equ
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
echo **** REMEMBER TO CHECK SINTERP.ASM FOR PROTECTED MODE UPDATES ALSO ****
|
||||
|
||||
$(obj)\strmlnrs.obj: $(src)\strmlnrs.asm $(src)\scheme.equ
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
|
||||
$(obj)\sutil.obj: $(src)\sutil.asm $(src)\scheme.equ
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
REM **** REMEMBER TO CHECK FOR PROTECTED MODE UPDATES ALSO ****
|
||||
|
||||
$(obj)\svars.obj: $(src)\svars.asm $(src)\scheme.equ $(src)\sinterp.mac \
|
||||
$(src)\sinterp.arg
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
|
||||
$(obj)\sw_int.obj: $(src)\sw_int.asm
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
|
||||
$(obj)\xli.obj: $(src)\xli.asm $(src)\scheme.equ
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
REM **** REMEMBER TO CHECK PRO2REAL.ASM FOR PROTECTED MODE UPDATES ALSO ****
|
||||
|
||||
|
||||
|
||||
#
|
||||
# C source files
|
||||
#
|
||||
|
||||
$(src)\scheme.h: $(src)\memtype.h $(src)\schmdefs.h
|
||||
$(tools)\touch scheme.h
|
||||
|
||||
$(obj)\asm_link.obj: $(src)\asm_link.c $(src)\scheme.h
|
||||
# $(tools)\lc -ms -ccdswum -o$@ $*
|
||||
$(tools)\lc1 -dREGMEM -ms -ccdswum -o$(obj)\$*.q $*
|
||||
$(tools)\lc2 -o -v$@ $(obj)\$*.q
|
||||
|
||||
$(obj)\freesp.obj: $(src)\freesp.c $(src)\scheme.h $(src)\ctype.h
|
||||
# $(tools)\lc -ms -ccdswum -o$@ $*
|
||||
$(tools)\lc1 -dREGMEM -ms -ccdswum -o$(obj)\$*.q $*
|
||||
$(tools)\lc2 -o -v$@ $(obj)\$*.q
|
||||
|
||||
$(obj)\sarith.obj: $(src)\sarith.c $(src)\scheme.h $(src)\slist.h
|
||||
# $(tools)\lc -ms -ccdswum -o$@ $*
|
||||
$(tools)\lc1 -dREGMEM -ms -ccdswum -o$(obj)\$*.q $*
|
||||
$(tools)\lc2 -o -v$@ $(obj)\$*.q
|
||||
|
||||
$(obj)\sbigmem.obj: $(src)\sbigmem.c $(src)\scheme.h
|
||||
# $(tools)\lc -ms -ccdswum -o$@ $*
|
||||
$(tools)\lc1 -dREGMEM -ms -ccdswum -o$(obj)\$*.q $*
|
||||
$(tools)\lc2 -o -v$@ $(obj)\$*.q
|
||||
|
||||
$(obj)\sdebug.obj: $(src)\sdebug.c $(src)\scheme.h $(src)\ctype.h
|
||||
# $(tools)\lc -ms -ccdswum -o$@ $*
|
||||
$(tools)\lc1 -dREGMEM -ms -ccdswum -o$(obj)\$*.q $*
|
||||
$(tools)\lc2 -o -v$@ $(obj)\$*.q
|
||||
|
||||
$(obj)\sdump.obj: $(src)\sdump.c $(src)\scheme.h $(src)\ctype.h \
|
||||
$(src)\schars.h $(src)\slist.h
|
||||
# $(tools)\lc -ms -ccdswum -o$@ $*
|
||||
$(tools)\lc1 -dREGMEM -ms -ccdswum -o$(obj)\$*.q $*
|
||||
$(tools)\lc2 -o -v$@ $(obj)\$*.q
|
||||
|
||||
$(obj)\serrmsg.obj: $(src)\serrmsg.c $(src)\scheme.h
|
||||
# $(tools)\lc -ms -ccdswum -o$@ $*
|
||||
$(tools)\lc1 -dREGMEM -ms -ccdswum -o$(obj)\$*.q $*
|
||||
$(tools)\lc2 -o -v$@ $(obj)\$*.q
|
||||
|
||||
$(obj)\serror.obj: $(src)\serror.c $(src)\scheme.h $(src)\ctype.h \
|
||||
$(src)\slist.h
|
||||
# $(tools)\lc -ms -ccdswum -o$@ $*
|
||||
$(tools)\lc1 -dREGMEM -ms -ccdswum -o$(obj)\$*.q $*
|
||||
$(tools)\lc2 -o -v$@ $(obj)\$*.q
|
||||
|
||||
$(obj)\sfasl.obj: $(src)\sfasl.c $(src)\scheme.h $(src)\stdio.h \
|
||||
$(src)\slist.h
|
||||
# $(tools)\lc -ms -ccdswum -o$@ $*
|
||||
$(tools)\lc1 -dREGMEM -ms -ccdswum -o$(obj)\$*.q $*
|
||||
$(tools)\lc2 -o -v$@ $(obj)\$*.q
|
||||
|
||||
$(obj)\shash.obj: $(src)\shash.c $(src)\scheme.h $(src)\ctype.h
|
||||
# $(tools)\lc -ms -ccdswum -o$@ $*
|
||||
$(tools)\lc1 -dREGMEM -ms -ccdswum -o$(obj)\$*.q $*
|
||||
$(tools)\lc2 -o -v$@ $(obj)\$*.q
|
||||
|
||||
$(obj)\slink.obj: $(src)\slink.c $(src)\ctype.h $(src)\slink.h
|
||||
# $(tools)\lc -ms -ccdswum -o$@ $*
|
||||
$(tools)\lc1 -dREGMEM -ms -ccdswum -o$(obj)\$*.q $*
|
||||
$(tools)\lc2 -o -v$@ $(obj)\$*.q
|
||||
|
||||
$(obj)\smain.obj: $(src)\smain.c $(src)\version.h $(src)\scheme.h \
|
||||
$(src)\sport.h $(src)\pcmake.h
|
||||
# $(tools)\lc -ms -ccdswum -o$@ $*
|
||||
$(tools)\lc1 -dREGMEM -ms -ccdswum -o$(obj)\$*.q $*
|
||||
$(tools)\lc2 -o -v$@ $(obj)\$*.q
|
||||
|
||||
$(obj)\smemory.obj: $(src)\smemory.c $(src)\scheme.h
|
||||
# $(tools)\lc -ms -ccdswum -o$@ $*
|
||||
$(tools)\lc1 -dREGMEM -ms -ccdswum -o$(obj)\$*.q $*
|
||||
$(tools)\lc2 -o -v$@ $(obj)\$*.q
|
||||
|
||||
$(obj)\sprintf.obj: $(src)\sprintf.c $(src)\scheme.h
|
||||
# $(tools)\lc -ms -ccdswum -o$@ $*
|
||||
$(tools)\lc1 -dREGMEM -ms -ccdswum -o$(obj)\$*.q $*
|
||||
$(tools)\lc2 -o -v$@ $(obj)\$*.q
|
||||
|
||||
$(obj)\sprop.obj: $(src)\sprop.c $(src)\scheme.h $(src)\ctype.h \
|
||||
$(src)\slist.h
|
||||
# $(tools)\lc -ms -ccdswum -o$@ $*
|
||||
$(tools)\lc1 -dREGMEM -ms -ccdswum -o$(obj)\$*.q $*
|
||||
$(tools)\lc2 -o -v$@ $(obj)\$*.q
|
||||
|
||||
$(obj)\sreify.obj: $(src)\sreify.c $(src)\scheme.h
|
||||
# $(tools)\lc -ms -ccdswum -o$@ $*
|
||||
$(tools)\lc1 -dREGMEM -ms -ccdswum -o$(obj)\$*.q $*
|
||||
$(tools)\lc2 -o -v$@ $(obj)\$*.q
|
||||
|
||||
$(obj)\sreset.obj: $(src)\sreset.c $(src)\scheme.h $(src)\ctype.h
|
||||
# $(tools)\lc -ms -ccdswum -o$@ $*
|
||||
$(tools)\lc1 -dREGMEM -ms -ccdswum -o$(obj)\$*.q $*
|
||||
$(tools)\lc2 -o -v$@ $(obj)\$*.q
|
||||
|
||||
$(obj)\strace.obj: $(src)\strace.c $(src)\scheme.h
|
||||
# $(tools)\lc -ms -ccdswum -o$@ $*
|
||||
$(tools)\lc1 -dREGMEM -ms -ccdswum -o$(obj)\$*.q $*
|
||||
$(tools)\lc2 -o -v$@ $(obj)\$*.q
|
||||
|
||||
$(obj)\support.obj: $(src)\support.c $(src)\scheme.h $(src)\slist.h
|
||||
# $(tools)\lc -ms -ccdswum -o$@ $*
|
||||
$(tools)\lc1 -dREGMEM -ms -ccdswum -o$(obj)\$*.q $*
|
||||
$(tools)\lc2 -o -v$@ $(obj)\$*.q
|
||||
|
||||
#
|
||||
# I/O source files - All of regular scheme's I/O files have been grouped
|
||||
# together in one place so they can be easily recognized from Protected
|
||||
# Mode Scheme's I/O files. There wasn't enough time to get all the I/O
|
||||
# code merged, so there may be duplicate code between regular scheme and
|
||||
# protected mode scheme. This means that if any code is modified in the
|
||||
# following files, you should check the corresponding protected mode
|
||||
# files also.
|
||||
#
|
||||
|
||||
# Assembly language I/O files
|
||||
|
||||
$(obj)\border.obj: $(src)\border.asm $(src)\scheme.equ $(src)\pcmake.equ
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
REM **** REMEMBER TO CHECK PROTECTED MODE I/O FILES FOR UPDATES ALSO ****
|
||||
|
||||
$(obj)\cio.obj: $(src)\cio.asm $(src)\scheme.equ $(src)\sinterp.arg
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
REM **** REMEMBER TO CHECK PROTECTED MODE I/O FILES FOR UPDATES ALSO ****
|
||||
|
||||
$(obj)\cprint.obj: $(src)\cprint.asm $(src)\scheme.equ $(src)\sinterp.arg
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
REM **** REMEMBER TO CHECK PROTECTED MODE I/O FILES FOR UPDATES ALSO ****
|
||||
|
||||
$(obj)\cprint1.obj: $(src)\cprint1.asm $(src)\scheme.equ
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
REM **** REMEMBER TO CHECK PROTECTED MODE I/O FILES FOR UPDATES ALSO ****
|
||||
|
||||
$(obj)\cread.obj: $(src)\cread.asm $(src)\scheme.equ $(src)\sinterp.arg
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
REM **** REMEMBER TO CHECK PROTECTED MODE I/O FILES FOR UPDATES ALSO ****
|
||||
|
||||
$(obj)\cwindow.obj: $(src)\cwindow.asm $(src)\scheme.equ $(src)\sinterp.arg
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
REM **** REMEMBER TO CHECK PROTECTED MODE I/O FILES FOR UPDATES ALSO ****
|
||||
|
||||
$(obj)\scroll.obj: $(src)\scroll.asm $(src)\pcmake.equ
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
REM **** REMEMBER TO CHECK PROTECTED MODE I/O FILES FOR UPDATES ALSO ****
|
||||
|
||||
$(obj)\sio.obj: $(src)\sio.asm $(src)\scheme.equ
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
REM **** REMEMBER TO CHECK PROTECTED MODE I/O FILES FOR UPDATES ALSO ****
|
||||
|
||||
$(obj)\zio.obj: $(src)\zio.asm $(src)\scheme.equ $(src)\pcmake.equ
|
||||
$(tools)\masm /DREGMEM $*,$@;
|
||||
REM **** REMEMBER TO CHECK PROTECTED MODE I/O FILES FOR UPDATES ALSO ****
|
||||
|
||||
# Lattice C I/O files
|
||||
|
||||
$(obj)\get_port.obj: $(src)\get_port.c $(src)\scheme.h $(src)\ctype.h
|
||||
$(tools)\lc1 -dREGMEM -ms -ccdswum -o$(obj)\$*.q $*
|
||||
$(tools)\lc2 -o -v$@ $(obj)\$*.q
|
||||
REM **** REMEMBER TO CHECK PROTECTED MODE I/O FILES FOR UPDATES ALSO ****
|
||||
|
||||
$(obj)\sin_out.obj: $(src)\sin_out.c $(src)\scheme.h $(src)\sport.h \
|
||||
$(src)\slist.h
|
||||
$(tools)\lc1 -dREGMEM -ms -ccdswum -o$(obj)\$*.q $*
|
||||
$(tools)\lc2 -o -v$@ $(obj)\$*.q
|
||||
REM **** REMEMBER TO CHECK PROTECTED MODE I/O FILES FOR UPDATES ALSO ****
|
||||
|
||||
$(obj)\sprint.obj: $(src)\sprint.c $(src)\scheme.h $(src)\schars.h
|
||||
$(tools)\lc1 -dREGMEM -ms -ccdswum -o$(obj)\$*.q $*
|
||||
$(tools)\lc2 -o -v$@ $(obj)\$*.q
|
||||
REM **** REMEMBER TO CHECK PROTECTED MODE I/O FILES FOR UPDATES ALSO ****
|
||||
|
||||
$(obj)\sread.obj: $(src)\sread.c $(src)\scheme.h $(src)\schars.h
|
||||
$(tools)\lc1 -dREGMEM -ms -ccdswum -o$(obj)\$*.q $*
|
||||
$(tools)\lc2 -o -v$@ $(obj)\$*.q
|
||||
REM **** REMEMBER TO CHECK PROTECTED MODE I/O FILES FOR UPDATES ALSO ****
|
||||
|
||||
$(obj)\zcio.obj: $(src)\zcio.c $(src)\scheme.h $(src)\sport.h \
|
||||
$(src)\slist.h
|
||||
$(tools)\lc1 -dREGMEM -ms -ccdswum -o$(obj)\$*.q $*
|
||||
$(tools)\lc2 -o -v$@ $(obj)\$*.q
|
||||
REM **** REMEMBER TO CHECK PROTECTED MODE I/O FILES FOR UPDATES ALSO ****
|
||||
|
||||
#
|
||||
# Generate .EXE file
|
||||
#
|
||||
|
||||
$(exec)\pcs.exe: $(obj)\sc.obj \
|
||||
$(obj)\schemed.obj \
|
||||
$(obj)\sinterp.obj \
|
||||
$(obj)\smain.obj \
|
||||
$(obj)\intrup.obj \
|
||||
$(obj)\sstring.obj \
|
||||
$(obj)\smemory.obj \
|
||||
$(obj)\sgcmark.obj \
|
||||
$(obj)\sgcsweep.obj \
|
||||
$(obj)\sbigmem.obj \
|
||||
$(obj)\sexec.obj \
|
||||
$(obj)\support.obj \
|
||||
$(obj)\shash.obj \
|
||||
$(obj)\sstack.obj \
|
||||
$(obj)\sarith.obj \
|
||||
$(obj)\sutil.obj \
|
||||
$(obj)\serror.obj \
|
||||
$(obj)\sdebug.obj \
|
||||
$(obj)\sdump.obj \
|
||||
$(obj)\strace.obj \
|
||||
$(obj)\sprint.obj \
|
||||
$(obj)\cprint.obj \
|
||||
$(obj)\cprint1.obj \
|
||||
$(obj)\serrmsg.obj \
|
||||
$(obj)\sio.obj \
|
||||
$(obj)\sbigmath.obj \
|
||||
$(obj)\sread.obj \
|
||||
$(obj)\cread.obj \
|
||||
$(obj)\zcio.obj \
|
||||
$(obj)\sin_out.obj \
|
||||
$(obj)\cio.obj \
|
||||
$(obj)\cwindow.obj \
|
||||
$(obj)\scar_cdr.obj \
|
||||
$(obj)\svars.obj \
|
||||
$(obj)\saprop.obj \
|
||||
$(obj)\sprop.obj \
|
||||
$(obj)\msdos.obj \
|
||||
$(obj)\sreset.obj \
|
||||
$(obj)\get_port.obj \
|
||||
$(obj)\sfasl.obj \
|
||||
$(obj)\zio.obj \
|
||||
$(obj)\sreify.obj \
|
||||
$(obj)\senv.obj \
|
||||
$(obj)\sprintf.obj \
|
||||
$(obj)\scannum.obj \
|
||||
$(obj)\stimer.obj \
|
||||
$(obj)\get_path.obj \
|
||||
$(obj)\sobjhash.obj \
|
||||
$(obj)\asm_link.obj \
|
||||
$(obj)\graphcmd.obj \
|
||||
$(obj)\border.obj \
|
||||
$(obj)\block.obj \
|
||||
$(obj)\slink.obj \
|
||||
$(obj)\alink.obj \
|
||||
$(obj)\sbid.obj \
|
||||
$(obj)\strmlnrs.obj \
|
||||
$(obj)\srch_str.obj \
|
||||
$(obj)\squish.obj \
|
||||
$(obj)\srelocat.obj \
|
||||
$(obj)\freesp.obj \
|
||||
$(obj)\scroll.obj \
|
||||
$(obj)\sw_int.obj \
|
||||
$(obj)\flo2hex.obj \
|
||||
$(obj)\smmu.obj \
|
||||
$(obj)\xli.obj
|
||||
cd $(obj)
|
||||
$(tools)\link @$(src)\pcs.lnk,$(exec)\pcs.exe,$(exec)\pcs.map/map,$(lib)\lcm+$(lib)\lc
|
||||
cd $(src)
|
||||
|
||||
#
|
||||
# Write debug info if specified
|
||||
#
|
||||
|
||||
:
|
||||
if not "$(debug)"=="" cd $(exec)
|
||||
if not "$(debug)"=="" $(tools)\mapsym $(exec)\pcs.map
|
||||
|
||||
#
|
||||
# make-specific wrapup
|
||||
#
|
||||
|
||||
:
|
||||
echo MAKE is done.
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
SC+SCHEMED+
|
||||
sinterp+smain+
|
||||
INTRUP+SSTRING+SMEMORY+SGCMARK+SGCSWEEP+
|
||||
SBIGMXP+
|
||||
SEXEC+SUPPORT+
|
||||
SHASH+SSTACK+SARITH+SUTIL+SERROR+SDEBUG+SDUMP+STRACE+SPRINT+CPRINT+CPRINT1+
|
||||
SERRMSG+SIO+SBIGMATH+SREAD+CREAD+ZCIO+SIN_OUT+CIO+CWINDOW+SCAR_CDR+SVARS+
|
||||
SAPROP+SPROP+MSDOS+SRESET+GET_PORT+SFASL+ZIO+SREIFY+SENV+SPRINTF+SCANNUM+STIMER+
|
||||
GET_PATH+SOBJHASH+ASM_LINK+GRAPHCMD+BORDER+SLINK+ALINK+SBID+STRMLNRS+SRCH_STR+
|
||||
squish+srelocat+
|
||||
FREESP+SCROLL+SW_INT+FLO2HEX+
|
||||
expsmmu+BLOCK+XLI
|
||||