github.com/Interlisp.maiko
1
0
Fork 0
mirror of https://github.com/Interlisp/maiko.git synced 2026-02-23 07:32:20 +00:00
Code Issues Projects Releases Wiki Activity

Maiko sources matching state as of 020102 prior to initial patching for Mac OSX

Browse Source
This commit is contained in:
Nick Briggs
2015-04-20 18:53:52 -07:00
commit de170a64d9
427 changed files with 129342 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

629
src/gcmain3.c Executable file
View File

@@ -0,0 +1,629 @@
/* $Id: gcmain3.c,v 1.4 1999/05/31 23:35:31 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */
static char *id = "$Id: gcmain3.c,v 1.4 1999/05/31 23:35:31 sybalsky Exp $ Copyright (C) Venue";
/************************************************************************/
/* */
/* (C) Copyright 1989-99 Venue. All Rights Reserved. */
/* Manufactured in the United States of America. */
/* */
/* The contents of this file are proprietary information */
/* belonging to Venue, and are provided to you under license. */
/* They may not be further distributed or disclosed to third */
/* parties without the specific permission of Venue. */
/* */
/************************************************************************/
#include "version.h"
/*************************************************************************/
/* */
/* File Name : gcmain3.c */
/* */
/*************************************************************************/
/* */
/* Creation Date : July-7-1987 */
/* Written by Tomoru Teruuchi */
/* */
/*************************************************************************/
/* */
/* Functions : gcmapscan(); */
/* gcmapunscan(); */
/* gcscanstack(); */
/* */
/* */
/*************************************************************************/
/* Descreption : */
/* */
/*************************************************************************/
/* \Tomtom */
/*************************************************************************/
#include "lispemul.h"
#include "lispmap.h"
#include "lsptypes.h"
#include "address.h"
#include "adr68k.h"
#include "lspglob.h"
#include "emlglob.h"
#include "stack.h"
#include "cell.h"
#include "ifpage.h"
#include "gc.h"
#ifdef GCC386
#include "inlnPS2.h"
#endif
#define WORDSPERCELL 2
#define MAXHTCNT 63
#define PADDING 4
#define FNOVERHEADWORDS 8
#define ADD_OFFSET(ptr, dloffset) ((LispPTR *) ((DLword *) (ptr) + (dloffset)))
#ifdef BIGVM
#define BIND_BITS(value) ((unsigned int) (value) >> 28)
#define BF_FLAGS(value) ((unsigned int) (value) >> 29)
#define PTR_BITS(entry) ((unsigned int)(entry) & POINTERMASK)
#define GetSegnuminColl(entry1) (((entry1) & 0xFFFE) >> 1)
#define GetStkCnt(entry1) ((entry1) >> 16)
#define StkCntIsZero(entry1) (!((entry1) & 0xFFFF0000))
#define StkrefP(entry1) ((entry1) & 0x10000)
#define SinglerefP(entry1) (((entry1) & 0xFFFE0000) == 0x20000)
#define Boundp(frame_field) ((frame_field) == 0)
#define Stkref(ptr) REC_GCLOOKUP(ptr, STKREF)
#define GcreclaimLp(ptr) while((ptr = gcreccell(ptr)) != NIL) \
REC_GCLOOKUP(ptr, ADDREF)
#define HTLPTR ((struct htlinkptr *) (entry))
#define HENTRY ((struct hashentry *) (entry))
#define HTMAIN_ENTRY_COUNT (HTMAIN_SIZE >> 1)
#define STKREFBIT 0x10000 /* the bit that says "I'm on the stack" */
#else
#define BIND_BITS(value) ((unsigned int) (value) >> 24)
#define BF_FLAGS(value) ((unsigned int) (value) >> 29)
#define PTR_BITS(entry) ((unsigned int)((unsigned int)((entry) << 8) >> 8))
#define GetSegnuminColl(entry1) ((entry1 & 0x01fe) >> 1)
#define GetStkCnt(entry1) ((entry1 & 0x0fe00) >> 9)
#define StkCntIsZero(entry1) (!((entry1) & 0x0fe00))
#define StkrefP(entry1) ((entry1) & 0x0200)
#define SinglerefP(entry1) (((entry1) & 0xFC00) == 0x0400)
#define Boundp(frame_field) ((frame_field) == 0)
#define Stkref(ptr) REC_GCLOOKUP(ptr, STKREF)
#define GcreclaimLp(ptr) while((ptr = gcreccell(ptr)) != NIL) \
REC_GCLOOKUP(ptr, ADDREF)
#define HTLPTR ((struct htlinkptr *) WORDPTR(entry))
#define HENTRY ((struct hashentry *) WORDPTR(entry))
#define HTMAIN_ENTRY_COUNT HTMAIN_SIZE
#define STKREFBIT 0x200
#endif /* BIGVM */
#ifdef GCC386
/* byte-swapped, 386 assembler version */
gcmapscan()
{
volatile DLword probe;
volatile DLword *entry;
volatile DLword offset;
volatile LispPTR ptr;
asm volatile(" \n\
movl $32768,%%edi / probe = HTSIZE. \n\
.align 4 \n\
nextentry: / nextentry: \n\
decl %%edi \n\
js returNIL \n\
leal 0(,%%edi,2),%%esi \n\
addl HTmain,%%esi /htlptr = (struct htlinkptr *)(HTmain+probe); \n\
.align 4 \n\
scanloop: \n\
movl %%esi,%%edx \n\
xorb $2,%%dl \n\
movzwl (%%edx),%%eax / contents = ((struct htlinkptr *)WORDPTR(htlptr))->contents \n\
testl %%eax,%%eax / if (contents && \n\
je scanbot \n\
testb $1,%%al \n\
jne scanok \n\
testb $254,%%ah \n\
jne scanbot \n\
scanok: \n\
jmp scandone \n\
.align 4 \n\
scanbot: \n\
addl $-2,%%esi / end of while loop. \n\
decl %%edi \n\
jns scanloop \n\
jmp returNIL \n\
\n\
\n\
scandone: \n\
movl %%edx,%0 / entry = (DLword *) HTmain + probe. \n\
retry: / retry: \n\
movl %0,%%ecx \n\
movzwl (%%ecx),%%eax \n\
testb $1,%%al / if HENTRY->collision, \n\
je nocollision \n\
xorl %%esi,%%esi / prev = 0 \n\
andl $65534,%%eax \n\
linkloop: // linkloop: \n\
leal 0(,%%eax,2),%%ecx \n\
addl HTcoll,%%ecx \n\
movw 2(%%ecx),%%ax / offset = ((struct htcoll *)link)->free_ptr; \n\
testb $254,%%ah / if StkCountIsZero(offset) \n\
jne stknz \n\
sall $15,%%eax / , (probe << 1)); \n\
andl $16711680,%%eax \n\
leal 0(,%%edi,2),%%edx \n\
orl %%eax,%%edx \n\
movl %%edx,%2 / to ptr. \n\
testl %%esi,%%esi / DelLink. if (prev != 0) \n\
je prevZ \n\
leal 2(%%esi),%%edx / GETWORD((DLword *)prev + 1) = GETWORD((DLword *)link + 1) \n\
xorb $2,%%dl \n\
leal 2(%%ecx),%%eax \n\
xorb $2,%%al \n\
movw (%%eax),%%ax \n\
jmp freelink \n\
.align 4 \n\
prevZ: \n\
movl %0,%%edx / else GETWORD((DLword *)entry) = GETWORD((DLword *)link + 1) \n\
leal 2(%%ecx),%%eax \n\
xorb $2,%%al \n\
movw (%%eax),%%ax \n\
orb $1,%%al \n\
freelink: / FreeLink \n\
movw %%ax,(%%edx) \n\
movl %%ecx,%%eax \n\
xorb $2,%%al \n\
movw $0,(%%eax) \n\
leal 2(%%ecx),%%eax \n\
xorb $2,%%al \n\
movl HTcoll,%%edx / GETWORD(link+1) = GETWORD(HTcoll); \n\
xorb $2,%%dl \n\
movw (%%edx),%%dx \n\
movw %%dx,(%%eax) \n\
movl HTcoll,%%edx / GETWORD(HTcoll) = (link - HTcoll); \n\
xorb $2,%%dl \n\
movl %%ecx,%%eax \n\
subl HTcoll,%%eax \n\
sarl $1,%%eax \n\
movw %%ax,(%%edx) \n\
movl %0,%%esi / link = (DLword *)HTcoll + GetLinkptr(GETWORD((DLword *)entry \n\
movw (%%esi),%%ax \n\
andl $65534,%%eax \n\
addl %%eax,%%eax \n\
movl %%eax,%%ecx \n\
addl HTcoll,%%ecx \n\
leal 2(%%ecx),%%edx / if (GETWORD((DLword *)link + 1) == 0) { \n\
xorb $2,%%dl \n\
cmpw $0,(%%edx) \n\
jne sgclp1 \n\
movl %%ecx,%%eax / GETWORD((DLword *)entry) = GETWORD((DLword *)link) \n\
xorb $2,%%al \n\
movw (%%eax),%%bx \n\
movw %%bx,(%%esi) \n\
movw $0,(%%eax) / FreeLink: GETWORD(link) = 0 \n\
movl HTcoll,%%eax / GETWORD(link+1) = GETWORD(HTcoll) \n\
xorb $2,%%al \n\
movw (%%eax),%%bx \n\
movw %%bx,(%%edx) \n\
movl %%ecx,%%ebx \n\
subl HTcoll,%%ebx \n\
sarl $1,%%ebx \n\
movw %%bx,(%%eax) \n\
.align 4 \n\
sgclp1: / start of gcloop 1 - do setup \n\
movl GcDisabled_word,%%ecx \n\
movl MDStypetbl,%%ebx \n\
gclp1: / GcreclaimLp: \n\
pushl %2 \n\
call gcreccell \n\
addl $4,%%esp \n\
movl %%eax,%2 \n\
testl %%eax,%%eax \n\
je eogclp1 \n\
shrl $9,%%eax \n\
leal 0(%%ebx,%%eax,2),%%eax \n\
xorb $2,%%al \n\
cmpw $0,(%%eax) \n\
jl gclp1 \n\
cmpl $76,(%%ecx) \n\
je gclp1 \n\
pushl $0 \n\
pushl %2 \n\
call rec_htfind \n\
addl $8,%%esp \n\
jmp gclp1 \n\
.align 4 \n\
.align 4 \n\
eogclp1: \n\
movl %0,%%eax / if (HTLPTR->contents == 0) \n\
cmpw $0,(%%eax) \n\
je nextentry / goto nextentry; \n\
jmp retry / else goto retry; \n\
.align 4 \n\
.align 4 \n\
\n\
stknz: \n\
movw (%%ecx),%%ax / if ((offset = ((struct htcoll *)link)->next_free)) \n\
testw %%ax,%%ax \n\
je nextentry \n\
movl %%ecx,%%esi \n\
andl $65535,%%eax \n\
jmp linkloop \n\
.align 4 \n\
.align 4 \n\
nocollision: \n\
testw $65024,(%%ecx) / if (StkCntIsZero(HTLPTR->contents)) { \n\
jne nextentry \n\
movw (%%ecx),%%dx /ptr = VAG2(HENTRY->segnum, (probe << 1)); \n\
sall $15,%%edx \n\
andl $16711680,%%edx \n\
leal (,%%edi,2),%%eax \n\
orl %%eax,%%edx \n\
movl %%edx,%2 \n\
movw $0,(%%ecx) / HTLPTR->contents = 0 \n\
.align 4 \n\
movl GcDisabled_word,%%ecx \n\
movl MDStypetbl,%%ebx \n\
gclp2: / GcreclaimLp \n\
pushl %2 \n\
call gcreccell \n\
addl $4,%%esp \n\
movl %%eax,%2 \n\
testl %%eax,%%eax \n\
je nextentry \n\
shrl $9,%%eax \n\
leal 0(%%ebx,%%eax,2),%%eax \n\
xorb $2,%%al \n\
cmpw $0,(%%eax) \n\
jl gclp2 \n\
cmpl $76,(%%ecx) \n\
je gclp2 \n\
pushl $0 \n\
pushl %2 \n\
call rec_htfind \n\
addl $8,%%esp \n\
jmp gclp2 \n\
.align 4 \n\
returNIL: \n\
" : "=g" (entry), "=g" (offset), "=g" (ptr) : : "ax", "dx", "cx", "bx", "si", "di");
return NIL;
}
#else
gcmapscan(void)
{
register GCENTRY probe;
register GCENTRY *entry;
GCENTRY offset, dbgentry, dbgcontents;
register LispPTR ptr;
probe = HTMAIN_ENTRY_COUNT;
nextentry:
while ((probe = gcscan1(probe)) != NIL)
{
entry = (GCENTRY *)HTmain + probe;
dbgentry = GETGC(entry);
retry:
if (HENTRY->collision)
{
register GCENTRY *prev;
register GCENTRY *link;
LispPTR content, dbgfree;
prev = (GCENTRY *)0;
link = (GCENTRY *)HTcoll + GetLinkptr((content = HTLPTR->contents));
linkloop:
offset = ((struct htcoll *)link)->free_ptr;
dbgfree = ((struct htcoll *)link)->next_free;
if (StkCntIsZero(offset))
{
/* Reclaimable object */
ptr = VAG2(GetSegnuminColl(offset), (probe << 1));
DelLink(link, prev, entry);
GcreclaimLp(ptr);
if (HTLPTR->contents == 0)
goto nextentry;
else
goto retry;
}
if ((offset = ((struct htcoll *)link)->next_free))
{
prev = link;
link = (GCENTRY *)(HTcoll + offset);
goto linkloop;
}
goto nextentry;
}
if (StkCntIsZero(dbgcontents = HTLPTR->contents)) {
ptr = VAG2(HENTRY->segnum, (probe << 1));
HTLPTR->contents = 0;
GcreclaimLp(ptr);
}
}
return(NIL);
}
#endif /* GCC386 */
gcmapunscan(void)
{
register GCENTRY probe;
register GCENTRY *entry;
GCENTRY offset;
register LispPTR ptr;
probe = HTMAIN_ENTRY_COUNT;
while ((probe = gcscan2(probe)) != NIL) {
entry = (GCENTRY *)HTmain + probe;
retry:
if (HENTRY->collision) {
register GCENTRY *prev;
register GCENTRY *link;
prev = (GCENTRY *)0;
link = (GCENTRY *)(HTcoll + GetLinkptr(HTLPTR->contents));
scnlp:
offset = ((struct htcoll *)link)->free_ptr;
if (StkrefP(offset)) {
if (SinglerefP(offset)) {
DelLink(link, prev, entry);
goto retry;
} else {
GETGC((GCENTRY *)link) =
offset & (~ STKREFBIT);
}
}
if ((offset = ((struct htcoll *)link)->next_free)) {
prev = link;
link = (GCENTRY *)(HTcoll + offset);
goto scnlp;
}
} else if (HENTRY->stackref) {
if (HENTRY->count == 1)
HTLPTR->contents = 0;
else
HENTRY->stackref = 0;
}
}
return(NIL);
}
gcscanstack(void)
{
register Bframe *bascframe;
Bframe *obascframe;
LispPTR scanptr,scanend;
UNSIGNED scanend68K;
struct fnhead *nametable;
int ftyp;
int pvcount;
scanptr = VAG2(STK_HI,InterfacePage->stackbase);
scanend = VAG2(STK_HI,InterfacePage->endofstack);
scanend68K = (UNSIGNED) Addr68k_from_LADDR(scanend);
bascframe = (Bframe *)Addr68k_from_LADDR(scanptr);
if (0 != 3 & (UNSIGNED)bascframe)
{
char debugStr[100];
sprintf(debugStr, "Frame ptr (0x%x) not to word bound "
"at start of gcscanstack.", bascframe);
error(debugStr);
}
while (1) {
/*This is endless loop until encountering tail of stack */
ftyp = (int)bascframe->flags;
switch(ftyp)
{
case STK_FX:
{
{
register struct frameex1 *frameex;
register struct fnhead *fnheader;
frameex = (struct frameex1 *)bascframe;
scanptr = LADDR_from_68k(frameex);
{
register LispPTR fn_head;
#ifdef BIGVM
fn_head = (LispPTR) (frameex->fnheader);
#else
fn_head = (LispPTR)
VAG2(frameex->hi2fnheader,
frameex->lofnheader);
#endif /* BIGVM */
Stkref(fn_head);
fnheader = (struct fnhead *)
Addr68k_from_LADDR(fn_head);
};
{
register int pcou;
register LispPTR *pvars;
pvars =(LispPTR *)
((DLword *)bascframe + FRAMESIZE);
for (pcou = fnheader->nlocals;pcou-- != 0;) {
register LispPTR value;
value = *pvars;
if Boundp(BIND_BITS(value)) Stkref(value);
++pvars;
}; /* for */
}; /* register int pcou */
{
register UNSIGNED qtemp;
register UNSIGNED next;
register UNSIGNED ntend;
next = qtemp = (UNSIGNED)
Addr68k_from_StkOffset(frameex->nextblock);
/* this is offset */
ntend = 0; /* init flag */
if (frameex->validnametable) {
register LispPTR nametable;
#ifdef BIGVM
nametable = frameex->nametable;
#define hi2nametable (nametable >> 16 )
#else
register unsigned int hi2nametable;
register unsigned int lonametable;
lonametable = frameex->lonametable;
hi2nametable = frameex->hi2nametable;
nametable = VAG2(hi2nametable,lonametable);
#endif /* BIGVM */
if (STK_HI == hi2nametable)
{
Stkref(fnheader->framename);
#ifdef BIGVM
qtemp = (UNSIGNED)
Addr68k_from_StkOffset(nametable&0xFFFF);
#else
qtemp = (UNSIGNED)
Addr68k_from_StkOffset(lonametable);
#endif
ntend = (UNSIGNED) (
((DLword *)qtemp) +
FNHEADSIZE +
(((struct fnhead *)qtemp)->ntsize)*2);
} else Stkref(nametable);
}; /* frameex->validnametable */
obascframe = bascframe;
bascframe = (Bframe *)
ADD_OFFSET(bascframe, FRAMESIZE+PADDING+
(((fnheader->pv)+1)<<2));
if (0 != 3 & (UNSIGNED)bascframe)
{
char debugStr[100];
sprintf(debugStr, "Frame ptr (0x%x) not to word bound "
"in gcscanstack() STK_FX case; old frame = 0x%x.",
bascframe, obascframe);
error(debugStr);
}
scantemps:
while((UNSIGNED)bascframe < (UNSIGNED )qtemp) {
register LispPTR value;
value = *((LispPTR *) bascframe);
if Boundp(BIND_BITS(value)) Stkref(value);
bascframe++;
}; /* while */
if (ntend != 0) {
obascframe = bascframe;
bascframe = (Bframe *)
Addr68k_from_StkOffset(ntend);
if (0 != 3 & (UNSIGNED)bascframe)
{
char debugStr[100];
sprintf(debugStr, "Frame ptr (0x%x) not to word bound "
"in gcscanstack() scantemps; old frame = 0x%x.",
bascframe, obascframe);
error(debugStr);
}
qtemp = next;
ntend = 0;
goto scantemps;
};
obascframe = bascframe;
bascframe = (Bframe *) next;
if (0 != 3 & (UNSIGNED)bascframe)
{
char debugStr[100];
sprintf(debugStr, "Frame ptr (0x%x) not to word bound "
"in gcscanstack(), end scantemps; old frame = 0x%x.",
bascframe, obascframe);
error(debugStr);
}
}; /* LOCAL regs qtemp next */
}; /* local regs fnheader frameex */
break;
};
case STK_GUARD:/* stack's tail ? */ {
if ((UNSIGNED) bascframe >= (UNSIGNED) scanend68K)
return(NIL);
else {
obascframe = bascframe;
bascframe = (Bframe *)((DLword *)
bascframe + bascframe->ivar);
if (0 != 3 & (UNSIGNED)bascframe)
{
char debugStr[100];
sprintf(debugStr, "Frame ptr (0x%x) not to word bound "
"in gcscanstack() STK_GUARD; old frame = 0x%x.",
bascframe, obascframe);
error(debugStr);
}
};
break;
};
case STK_FSB: {
obascframe = bascframe;
bascframe = (Bframe *)((DLword *)
bascframe + bascframe->ivar);
if (0 != 3 & (UNSIGNED)bascframe)
{
char debugStr[100];
sprintf(debugStr, "Frame ptr (0x%x) not to word bound "
"in gcscanstack() STK_FSB; old frame = 0x%x.",
bascframe, obascframe);
error(debugStr);
}
break;
};
default: /* must be basic frame !! */
{
register LispPTR bf_word;
while(STK_BF != BF_FLAGS(bf_word = *((LispPTR *)bascframe)))
{ Stkref(PTR_BITS(bf_word));
bascframe++;
};
bascframe++;
};
/* **** NOTE THIS CODE DOES NOT COMPILE CORRECTLY ON THE SUN 4
{register LispPTR bf_word;
while(STK_BF != BF_FLAGS(
bf_word = *((LispPTR *)bascframe++)))
{ Stkref(PTR_BITS(bf_word));
};
};
**** */
}; /* switch */
}; /* while(1) */
}