github.com/Interlisp.maiko
1
0
Fork 0
mirror of https://github.com/Interlisp/maiko.git synced 2026-01-14 15:36:34 +00:00
Code Issues Projects Releases Wiki Activity

Merge remote-tracking branch 'upstream/master'

Browse Source
This commit is contained in:
Peter 2021-11-07 19:37:24 +01:00
commit f73b4d1ff5
19 changed files with 75 additions and 149 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
inc/mkatomdefs.h
View File

@ -5,6 +5,5 @@ DLword compute_hash(const char *char_base, DLword offset, DLword length);
DLword compute_lisp_hash(const char *char_base, DLword offset, DLword length, DLword fatp);
LispPTR compare_chars(register const char *char1, register const char *char2, register DLword length);
LispPTR compare_lisp_chars(register const char *char1, register const char *char2, register DLword length, DLword fat1, DLword fat2);
LispPTR make_atom(const char *char_base, DLword offset, DLword length, short int non_numericp);
LispPTR parse_number(const char *char_base, short int length);
LispPTR make_atom(const char *char_base, DLword offset, DLword length);
#endif

4
inc/timeout.h
View File

@ -61,8 +61,8 @@ extern int TIMEOUT_TIME;
/************************************************************************/
#define INTRSAFE(exp) \
do {} while ((int)(exp) == -1 && errno == EINTR)
do {errno = 0; } while ((exp) == -1 && errno == EINTR)
#define INTRSAFE0(exp) \
do {} while ((int)(exp) == 0 && errno == EINTR)
do {errno = 0; } while ((exp) == NULL && errno == EINTR)
#endif /* TIMEOUT_H */

18
inc/tosfns.h
View File

@ -513,7 +513,8 @@
#ifndef BIGATOMS
#define EVAL \
do { \
LispPTR scratch, work, lookuped; \
LispPTR work, lookuped; \
DLword scratch[2]; \
switch (TOPOFSTACK & SEGMASK) { \
case S_POSITIVE: \
case S_NEGATIVE: \
@ -521,8 +522,8 @@
case ATOM_OFFSET: \
if ((TOPOFSTACK == NIL_PTR) || (TOPOFSTACK == ATOM_T)) \
goto Hack_Label; \
nnewframe(CURRENTFX, &scratch, TOPOFSTACK & 0xffff); \
work = POINTERMASK & swapx(scratch); \
nnewframe(CURRENTFX, scratch, TOPOFSTACK & 0xffff); \
work = POINTERMASK & ((GETBASEWORD(scratch,1) << 16) | GETBASEWORD(scratch,0)); \
lookuped = *((LispPTR *)(Addr68k_from_LADDR(work))); \
if (lookuped == NOBIND_PTR) \
goto op_ufn; \
@ -552,7 +553,8 @@
#else
#define EVAL \
do { \
LispPTR scratch, work, lookuped; \
LispPTR work, lookuped; \
DLword scratch[2]; \
switch (TOPOFSTACK & SEGMASK) { \
case S_POSITIVE: \
case S_NEGATIVE: \
@ -560,8 +562,8 @@
case ATOM_OFFSET: \
if ((TOPOFSTACK == NIL_PTR) || (TOPOFSTACK == ATOM_T)) \
goto Hack_Label; \
nnewframe(CURRENTFX, &scratch, TOPOFSTACK & 0xffff); \
work = POINTERMASK & swapx(scratch); \
nnewframe(CURRENTFX, scratch, TOPOFSTACK & 0xffff); \
work = POINTERMASK & ((GETBASEWORD(scratch,1) << 16) | GETBASEWORD(scratch,0)); \
lookuped = *((LispPTR *)(Addr68k_from_LADDR(work))); \
if (lookuped == NOBIND_PTR) \
goto op_ufn; \
@ -584,8 +586,8 @@
fn_apply = 0; \
goto op_fn_common; \
case TYPE_NEWATOM: \
nnewframe(CURRENTFX, &scratch, TOPOFSTACK); \
work = POINTERMASK & swapx(scratch); \
nnewframe(CURRENTFX, scratch, TOPOFSTACK); \
work = POINTERMASK & ((GETBASEWORD(scratch,1) << 16) | GETBASEWORD(scratch,0)); \
lookuped = *((LispPTR *)(Addr68k_from_LADDR(work))); \
if (lookuped == NOBIND_PTR) \
goto op_ufn; \

2
inc/xinitdefs.h
View File

@ -6,5 +6,5 @@ void lisp_Xexit(DspInterface dsp);
void Xevent_before_raid(DspInterface dsp);
void Xevent_after_raid(DspInterface dsp);
void Open_Display(DspInterface dsp);
DspInterface X_init(DspInterface dsp, char *lispbitmap, int width_hint, int height_hint, int depth_hint);
DspInterface X_init(DspInterface dsp, LispPTR lispbitmap, int width_hint, int height_hint, int depth_hint);
#endif

6
src/dir.c
View File

@ -691,7 +691,7 @@ static int enum_dsk_prop(char *dir, char *name, char *ver, FINFO **finfo_buf)
nextp->prop->wdate = (unsigned)ToLispTime(sbuf.st_mtime);
nextp->prop->rdate = (unsigned)ToLispTime(sbuf.st_atime);
nextp->prop->protect = (unsigned)sbuf.st_mode;
TIMEOUT(pwd = getpwuid(sbuf.st_uid));
TIMEOUT0(pwd = getpwuid(sbuf.st_uid));
if (pwd == (struct passwd *)NULL) {
nextp->prop->au_len = 0;
} else {
@ -1080,7 +1080,7 @@ static int enum_ufs_prop(char *dir, char *name, char *ver, FINFO **finfo_buf)
char namebuf[MAXPATHLEN];
errno = 0;
TIMEOUT(dirp = opendir(dir));
TIMEOUT0(dirp = opendir(dir));
if (dirp == NULL) {
*Lisp_errno = errno;
return (-1);
@ -1263,7 +1263,7 @@ static int enum_ufs(char *dir, char *name, char *ver, FINFO **finfo_buf)
char namebuf[MAXPATHLEN];
errno = 0;
TIMEOUT(dirp = opendir(dir));
TIMEOUT0(dirp = opendir(dir));
if (dirp == NULL) {
*Lisp_errno = errno;
return (-1);

24
src/draw.c
View File

@ -17,10 +17,10 @@
#include "version.h"
#include <stddef.h>
#include <stdio.h>
#include <stdlib.h>
#include "lispemul.h"
#include "lspglob.h"
#include "lispmap.h"
@ -268,21 +268,21 @@ int N_OP_drawline(LispPTR ptr, int curbit, int xsize, int width, int ysize, int
#endif /* COLOR */
{
DLword *start_addr, *temp_s, *temp_e;
DLword *start_addr;
start_addr = (DLword *)Addr68k_from_LADDR(ptr);
if (((int)(temp_s = (DLword *)(start_addr - DisplayRegion68k)) >= 0) &&
(start_addr < DisplayRegion68k_end_addr) &&
((int)(temp_e = (DLword *)(dataptr - DisplayRegion68k)) >= 0) &&
((DLword *)dataptr < DisplayRegion68k_end_addr)) {
if (in_display_segment(start_addr) && in_display_segment(dataptr)) {
int start_x, start_y, end_x, end_y, w, h;
ptrdiff_t temp_s, temp_e;
start_y = (int)temp_s / DisplayRasterWidth;
start_x = ((int)temp_s % DisplayRasterWidth) * BITSPER_DLWORD;
temp_s = start_addr - DisplayRegion68k;
temp_e = dataptr - DisplayRegion68k;
end_y = (int)temp_e / DisplayRasterWidth;
end_x = ((int)temp_e % DisplayRasterWidth) * BITSPER_DLWORD + (BITSPER_DLWORD - 1);
start_y = temp_s / DisplayRasterWidth;
start_x = (temp_s % DisplayRasterWidth) * BITSPER_DLWORD;
end_y = temp_e / DisplayRasterWidth;
end_x = (temp_e % DisplayRasterWidth) * BITSPER_DLWORD + (BITSPER_DLWORD - 1);
w = abs(start_x - end_x) + 1;
h = abs(start_y - end_y) + 1;
@ -290,10 +290,8 @@ int N_OP_drawline(LispPTR ptr, int curbit, int xsize, int width, int ysize, int
if (start_x > end_x) start_x = end_x;
if (start_y > end_y) start_y = end_y;
#if defined(XWINDOW) || defined(BYTESWAP)
flush_display_region(start_x, start_y, w, h);
#endif /* XWINDOW */
}
}

4
src/dsk.c
View File

@ -1702,7 +1702,7 @@ LispPTR COM_getfileinfo(register LispPTR *args)
case AUTHOR: {
size_t rval;
#ifndef DOS
TIMEOUT(pwd = getpwuid(sbuf.st_uid));
TIMEOUT0(pwd = getpwuid(sbuf.st_uid));
if (pwd == (struct passwd *)NULL) {
/*
* Returns Lisp 0. Lisp code handles this case as author
@ -1748,7 +1748,7 @@ LispPTR COM_getfileinfo(register LispPTR *args)
bufp = (unsigned *)(Addr68k_from_LADDR(laddr));
*bufp = sbuf.st_mode;
#ifndef DOS
TIMEOUT(pwd = getpwuid(sbuf.st_uid));
TIMEOUT0(pwd = getpwuid(sbuf.st_uid));
if (pwd == (struct passwd *)NULL) { return (GetSmallp(0)); }
laddr = cdr(car(cdr(cdr(cdr(cdr(args[2]))))));
STRING_BASE(laddr, base);

3
src/dspif.c
View File

@ -27,9 +27,6 @@ DspInterface currentdsp = &curdsp;
#ifdef XWINDOW
extern int LispDisplayRequestedWidth;
extern int LispDisplayRequestedHeight;
extern DspInterface X_init(DspInterface dsp, char *lispbitmap, int width_hint, int height_hint,
int depth_hint);
#endif /* XWINDOW */
#ifdef DOS

6
src/ether.c
View File

@ -742,7 +742,7 @@ static int check_filter(u_char *buffer)
static void init_uid() {
int rid;
rid = getuid();
seteuid(rid);
setuid(rid);
}
#endif /* MAIKO_ENABLE_ETHERNET */
@ -830,7 +830,7 @@ void init_ether() {
/* JDS 991228 remove perror("Can't open network; XNS unavailable.\n"); */
ether_fd = -1;
}
seteuid(getuid());
setuid(getuid());
}
#elif defined(USE_NIT)
#ifndef OS4
@ -952,7 +952,7 @@ void init_ether() {
perror("Can't open network; XNS unavailable.\n");
ether_fd = -1;
}
seteuid(getuid());
setuid(getuid());
}
#endif /* OS4 */

3
src/initsout.c
View File

@ -139,8 +139,7 @@ void init_ifpage(int sysout_size) {
#ifdef BIGVM
/* For BIGVM system, save the value in \LASTVMEMFILEPAGE for lisp's use */
if ((LispPTR)LASTVMEMFILEPAGE_word != 0xFFFFFFFF)
*LASTVMEMFILEPAGE_word = InterfacePage->dllastvmempage;
*LASTVMEMFILEPAGE_word = InterfacePage->dllastvmempage;
#endif /* BIGVM */
/* unfortunately, Lisp only looks at a 16 bit serial number */

2
src/ldeether.c
View File

@ -214,7 +214,7 @@ int main(int argc, char *argv[]) {
ether_fd = -1;
/* exit(); */
}
seteuid(getuid());
setuid(getuid());
}
/* OK, right here do other stuff like scan args */

10
src/main.c
View File

@ -486,9 +486,9 @@ int main(int argc, char *argv[])
probemouse(); /* See if the mouse is connected. */
#else
if (getuid() != geteuid()) {
fprintf(stderr, "Effective user is not real user. Setting euid to uid.\n");
if (seteuid(getuid()) == -1) {
fprintf(stderr, "Unable to reset effective user id to real user id\n");
fprintf(stderr, "Effective user is not real user. Resetting uid\n");
if (setuid(getuid()) == -1) {
fprintf(stderr, "Unable to reset user id to real user id\n");
exit(1);
}
}
@ -661,7 +661,7 @@ int makepathname(char *src, char *dst)
#ifdef DOS
pwd = 0;
#else
TIMEOUT(pwd = getpwuid(getuid()));
TIMEOUT0(pwd = getpwuid(getuid()));
#endif /* DOS */
if (pwd == NULL) {
*Lisp_errno = errno;
@ -680,7 +680,7 @@ int makepathname(char *src, char *dst)
strncpy(name, base + 1, len);
name[len] = '\0';
#ifndef DOS
TIMEOUT(pwd = getpwnam(name));
TIMEOUT0(pwd = getpwnam(name));
#endif /* DOS */
if (pwd == NULL) {
*Lisp_errno = errno;

120
src/mkatom.c
View File

@ -27,7 +27,6 @@
compute_hash
create_symbol
compare_chars
parse_number
*/
/**********************************************************************/
@ -248,10 +247,11 @@ LispPTR compare_lisp_chars(register const char *char1, register const char *char
/*
Func name : make_atom
If the atom already existed then return
else create new atom . Returns the Atom's index.
Look up the atom index of an existing atom, or return 0xFFFFFFFF
This function does not handle FAT pname's.
This function is a subset of \MKATOM (in LLBASIC), but only handles
thin text atom names (no numbers, no 2-byte pnames).
It MUST return the same atom index number as \MKATOM
Date : January 29, 1987
Edited by : Takeshi Shimizu
@ -264,8 +264,7 @@ LispPTR compare_lisp_chars(register const char *char1, register const char *char
*/
/**********************************************************************/
LispPTR make_atom(const char *char_base, DLword offset, DLword length, short int non_numericp)
/* if it is NIL then these chars are treated as NUMBER */
LispPTR make_atom(const char *char_base, DLword offset, DLword length)
{
extern DLword *AtomHT;
extern DLword *Pnamespace;
@ -281,41 +280,34 @@ LispPTR make_atom(const char *char_base, DLword offset, DLword length, short int
unsigned short first_char;
#ifdef TRACE2
printf("TRACE: make_atom( %s , offset= %d, len= %d, non_numericp = %d)\n", char_base, offset,
length, non_numericp);
printf("TRACE: make_atom( %s , offset= %d, len= %d)\n", char_base, offset, length);
#endif
first_char = (*(char_base + offset)) & 0xff;
if (length != 0) {
if (length == 1) /* one char. atoms */
{
if (first_char > 57) /* greater than '9 */
return ((LispPTR)(ATOMoffset + (first_char - 10)));
else if (first_char > 47) /* between '0 to '9 */
return ((LispPTR)(S_POSITIVE + (first_char - 48)));
/* fixed S_... mar-27-87 take */
else /* other one char. atoms */
return ((LispPTR)(ATOMoffset + first_char));
} /* if(length==1.. end */
else if ((non_numericp == NIL) && (first_char <= '9'))
/* more than 10 arithmetic aon + - mixed atom process */
{
if ((hash_entry = parse_number(char_base + offset, length)) != 0)
return ((LispPTR)hash_entry); /* if NIL that means THE ATOM is +- mixed litatom */
/* 15 may 87 take */
}
hash = compute_hash(char_base, offset, length);
} /* if(lengt.. end */
else {
switch (length) {
case 0:
/* the zero-length atom has hashcode 0 */
hash = 0;
first_char = 255;
break;
case 1:
/* One-character atoms live in well known places, no need to hash */
if (first_char > '9')
return ((LispPTR)(ATOMoffset + (first_char - 10)));
if (first_char >= '0' ) /* 0..9 */
return ((LispPTR)(S_POSITIVE + (first_char - '0')));
/* other one character atoms */
return ((LispPTR)(ATOMoffset + first_char));
default:
hash = compute_hash(char_base, offset, length);
break;
}
/* This point corresponds with LP in Lisp source */
/* following for loop never exits until it finds new hash entry or same atom */
/* following for loop does not exit until it finds new hash entry or same atom */
for (reprobe = Atom_reprobe(hash, first_char); (hash_entry = GETWORD(AtomHT + hash)) != 0;
hash = ((hash + reprobe) & 0xffff)) {
atom_index = hash_entry - 1;
@ -326,7 +318,7 @@ LispPTR make_atom(const char *char_base, DLword offset, DLword length, short int
if ((length == GETBYTE(pname_base)) &&
(compare_chars(++pname_base, char_base + offset, length) == T)) {
DBPRINT(("FOUND the atom. \n"));
return (atom_index); /* find already existed atom */
return (atom_index); /* found existing atom */
}
DBPRINT(("HASH doesn't hit. reprobe!\n"));
@ -337,65 +329,3 @@ LispPTR make_atom(const char *char_base, DLword offset, DLword length, short int
return (0xffffffff);
/** Don't create newatom now **/
} /* make_atom end */
/*********************************************************************/
/*
Func name : parse_number
Desc : It can treat -65534 to 65535 integer
Returns SMALLP PTR
Date : 1,May 1987 Take
15 May 87 take
*/
/*********************************************************************/
/* Assume this func. should be called with C string in "char_base" */
LispPTR parse_number(const char *char_base, short int length) {
register LispPTR sign_mask;
register LispPTR val;
register int radix;
register int *cell68k;
#ifdef TRACE2
printf("TRACE: parse_number()\n");
#endif
/* Check for Radix 8(Q) postfixed ?? */
if ((*(char_base + (length - 1))) == 'Q') {
radix = 8;
length--;
} else
radix = 10;
/* Check for Sign */
sign_mask = S_POSITIVE;
if ((*(char_base) == '+') || (*(char_base) == '-')) {
sign_mask = ((*char_base++) == '+') ? S_POSITIVE : S_NEGATIVE;
length--;
}
for (val = 0; length > 0; length--) {
if ((((*char_base)) < '0') || ('9' < ((*char_base)))) return (NIL);
val = radix * val + (*char_base++) - '0';
}
if (val > 0xffffffff) error("parse_number : Overflow ...exceeded range of FIXP");
if ((sign_mask == S_POSITIVE) && (val > 0xffff)) {
cell68k = (int *)createcell68k(TYPE_FIXP);
*cell68k = val;
return (LADDR_from_68k(cell68k));
} else if ((sign_mask == S_NEGATIVE) && (val > 0xffff)) {
cell68k = (int *)createcell68k(TYPE_FIXP);
*cell68k = ~val + 1;
return (LADDR_from_68k(cell68k));
}
else if (sign_mask == S_NEGATIVE)
return (sign_mask | (~((DLword)val) + 1));
else {
return (sign_mask | val);
}
}
/* end parse_number */

4
src/storage.c
View File

@ -35,7 +35,7 @@
#include "conspagedefs.h"
#include "gcfinaldefs.h"
#include "gchtfinddefs.h"
#include "mkatomdefs.h"
#include "testtooldefs.h"
#define MINARRAYBLOCKSIZE 4
#define GUARDVMEMFULL 500
@ -374,7 +374,7 @@ LispPTR newpage(LispPTR base) {
} else if (InterfacePage->key == IFPVALID_KEY) {
*VMEM_FULL_STATE_word = ATOM_T;
} else
*VMEM_FULL_STATE_word = make_atom("DIRTY", 0, 5, 0);
*VMEM_FULL_STATE_word = MAKEATOM("DIRTY");
}
return (base);

1
src/subr.c
View File

@ -484,6 +484,7 @@ void OP_subrcall(int subr_no, int argnum) {
case sb_GET_NATIVE_ADDR_FROM_LISP_PTR:
POP_SUBR_ARGS;
/* XXX: this WILL NOT WORK if Lisp memory is allocated outside the low 4GB */
ARITH_SWITCH(Addr68k_from_LADDR(args[0]), TopOfStack);
break;

6
src/testtool.c
View File

@ -424,7 +424,7 @@ void dump_fnobj(LispPTR index)
/************************************************************************/
/* Opcode names, by opcode */
static const char *opcode_table[256] = {
const char *opcode_table[256] = {
"-X-",
"CAR",
"CDR",
@ -1018,7 +1018,7 @@ FX *get_nextFX(FX *fx) {
} /* get_nextFX end */
LispPTR MAKEATOM(char *string) {
return (make_atom(string, 0, strlen(string), 0));
return (make_atom(string, 0, strlen(string)));
}
/************************************************************************/
@ -1032,7 +1032,7 @@ LispPTR MAKEATOM(char *string) {
LispPTR *MakeAtom68k(char *string) {
LispPTR index;
index = make_atom(string, 0, strlen(string), 0);
index = make_atom(string, 0, strlen(string));
if (index == 0xffffffff) {
error("MakeAtom68k: no such atom found");
}

4
src/ufs.c
View File

@ -566,7 +566,7 @@ int unixpathname(char *src, char *dst, int versionp, int genp)
case '~':
if (*(cp + 1) == '>' || *(cp + 1) == '\0') {
/* "~>" or "~" means the user's home directory. */
TIMEOUT(pwd = getpwuid(getuid()));
TIMEOUT0(pwd = getpwuid(getuid()));
if (pwd == NULL) return (0);
strcpy(dst, pwd->pw_dir);
@ -590,7 +590,7 @@ int unixpathname(char *src, char *dst, int versionp, int genp)
*/
for (++cp, np = name; *cp != '\0' && *cp != '>';) *np++ = *cp++;
*np = '\0';
TIMEOUT(pwd = getpwnam(name));
TIMEOUT0(pwd = getpwnam(name));
if (pwd == NULL) return (0);
strcpy(dst, pwd->pw_dir);

2
src/uraid.c
View File

@ -286,7 +286,7 @@ LispPTR parse_atomstring(char *string)
namelen = cnt - 1;
if ((packagelen == 0) || (strncmp(packageptr, "IL", packagelen) == 0)) { /* default IL: */
aindex = make_atom(nameptr, 0, namelen, T);
aindex = make_atom(nameptr, 0, namelen);
if (aindex == 0xffffffff) {
printf("trying IL:\n");
aindex = get_package_atom(nameptr, namelen, "INTERLISP", 9, 0);

2
src/xinit.c
View File

@ -222,7 +222,7 @@ void Open_Display(DspInterface dsp)
/* */
/*********************************************************************/
DspInterface X_init(DspInterface dsp, char *lispbitmap, int width_hint, int height_hint,
DspInterface X_init(DspInterface dsp, LispPTR lispbitmap, int width_hint, int height_hint,
int depth_hint)
{
Screen *Xscreen;