Unpack disk4.tgz

This commit is contained in:
Lassi Kortela 2023-05-20 12:57:06 +03:00
parent 777c904054
commit 3855274aa5
41 changed files with 13721 additions and 0 deletions

136
asm_link.c Normal file
View File

@ -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) */


39
freesp.c Normal file
View File

@ -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);
}


133
get_port.c Normal file
View File

@ -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) *****/


618
make_fsl.c Normal file
View File

@ -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;
}


110
newtrig.c Normal file
View File

@ -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 */


18
pcs.lnk Normal file
View File

@ -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


444
pcs.mak Normal file
View File

@ -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.


13
pcsexp.lnk Normal file
View File

@ -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