long xmfree(long addr)
{
MD *p,**q;
MPB *mpb;
#if DBGUMEM
kprintf("BDOS: Mfree(0x%08lx)\n", (long) addr);
#endif
if(addr >= start_stram && addr <= end_stram) {
mpb = &pmd;
#if CONF_WITH_ALT_RAM
} else if(has_alt_ram) {
mpb = &pmdalt;
#endif
} else {
return EIMBA;
}
for (p = *(q = &mpb->mp_mal); p; p = *(q = &p->m_link))
if (addr == p->m_start)
break;
if (!p)
return(EIMBA);
*q = p->m_link;
freeit(p,mpb);
return(E_OK);
}
/*
* xmfree - Function 0x49 (Mfree)
*/
long xmfree(void *addr)
{
MD *p,**q;
MPB *mpb;
KDEBUG(("BDOS: Mfree(0x%08lx)\n",(ULONG)addr));
if (((UBYTE *)addr >= start_stram) && ((UBYTE *)addr <= end_stram)) {
mpb = &pmd;
#if CONF_WITH_ALT_RAM
} else if (has_alt_ram) {
mpb = &pmdalt;
#endif
} else {
return EIMBA;
}
for (p = *(q = &mpb->mp_mal); p; p = *(q = &p->m_link))
if ((UBYTE *)addr == p->m_start)
break;
if (!p)
return EIMBA;
*q = p->m_link;
freeit(p,mpb);
dump_mem_map();
return E_OK;
}
/* Recursively free all elements in the linked list. If freeit != NULL
* call it on each datum in the list */
void FAST_FUNC llist_free(llist_t *elm, void (*freeit)(void *data))
{
while (elm) {
void *data = llist_pop(&elm);
if (freeit)
freeit(data);
}
}
// Free all the elements of a linked list
// Call freeit() on each element before freeing it.
static void dlist_free(struct double_list *list, void (*freeit)(void *data))
{
while (list) {
void *pop = list;
list = list->next;
freeit(pop);
// Bail out also if list is circular.
if (list == pop) break;
}
}
/* free each item in the allocated list, that is owned by 'p' */
static void free_all_owned(PD *p, MPB *mpb)
{
MD *m, **q;
for (m = *(q = &mpb->mp_mal); m; m = *q) {
if (m->m_own == p) {
*q = m->m_link;
freeit(m,mpb);
} else {
q = &m->m_link;
}
}
}
long xsetblk(int n, void *blk, long len)
{
MD *m,*p;
MPB *mpb;
#if DBGUMEM
kprintf("BDOS: Mshrink(0x%08lx, %ld)\n", (long) blk, len);
#endif
if(((long)blk) >= start_stram && ((long)blk) <= end_stram) {
mpb = &pmd;
#if DBGUMEM
kprintf("BDOS: xsetblk - mpb = &pmd\n");
#endif
#if CONF_WITH_ALT_RAM
} else if(has_alt_ram) {
mpb = &pmdalt;
#if DBGUMEM
kprintf("BDOS: xsetblk - mpb = &pmdalt\n");
#endif
#endif /* CONF_WITH_ALT_RAM */
} else {
return EIMBA;
}
/*
* Traverse the list of memory descriptors looking for this block.
*/
for (p = mpb->mp_mal; p; p = p->m_link)
if( (long) blk == p->m_start )
break;
/*
* If block address doesn't match any memory descriptor, then abort.
*/
if (!p)
return(EIMBA);
/*
* Round the size to a multiple of 4 bytes to keep alignment.
* Alignment on long boundaries matters in FastRAM.
*/
len = (len + 3) & ~3;
#if DBGUMEM
kprintf("BDOS: xsetblk - new length = %ld\n", len);
#endif
/*
* If the caller is not shrinking the block size, then abort.
*/
if (p->m_length < len)
return(EGSBF);
/*
* Create a memory descriptor for the freed portion of memory.
*/
m = MGET(MD);
#if DBGUMEM
/* what if 0? */
if( m == 0 )
panic("umem.c/xsetblk: Null Return From MGET\n") ;
#endif
m->m_start = p->m_start + len;
m->m_length = p->m_length - len;
p->m_length = len;
freeit(m,mpb);
return(E_OK);
}
long xexec(WORD flag, char *path, char *tail, char *env)
{
PD *p;
PGMHDR01 hdr;
MD *m, *env_md;
LONG rc;
long max, needed;
FH fh;
KDEBUG(("BDOS xexec: flag or mode = %d\n",flag));
/* first branch - actions that do not require loading files */
switch(flag) {
#if DETECT_NATIVE_FEATURES
case PE_RELOCATE: /* internal use only, see bootstrap() in bios/bios.c */
p = (PD *) tail;
rc = kpgm_relocate(p, (long)path);
if (rc) {
KDEBUG(("BDOS xexec: kpgm_reloc returned %ld (0x%lx)\n",rc,rc));
return rc;
}
/* invalidate instruction cache for the TEXT segment only
* programs that jump into their DATA, BSS or HEAP are kindly invited
* to do their cache management themselves.
*/
invalidate_instruction_cache( p+1, p->p_tlen);
return (long)p;
#endif
case PE_BASEPAGE: /* just create a basepage */
path = (char *) 0L; /* (same as basepage+flags with flags set to zero) */
/* drop thru */
case PE_BASEPAGEFLAGS: /* create a basepage, respecting the flags */
env_md = alloc_env(env);
if (env_md == NULL) {
KDEBUG(("BDOS xexec: not enough memory!\n"));
return ENSMEM;
}
m = alloc_tpa((ULONG)path,sizeof(PD),&max);
if (m == NULL) { /* not even enough memory for basepage */
freeit(env_md, &pmd);
KDEBUG(("BDOS xexec: No memory for basepage\n"));
return ENSMEM;
}
p = (PD *) m->m_start;
/* memory ownership */
m->m_own = env_md->m_own = run;
/* initialize the PD */
init_pd_fields(p, tail, max, env_md);
p->p_flags = (ULONG)path; /* set the flags */
init_pd_files(p);
return (long)p;
case PE_GOTHENFREE:
/* set the owner of the memory to be this process */
p = (PD *) tail;
set_owner(p, p, find_mpb(p));
set_owner(p->p_env, p, find_mpb(p->p_env));
/* fall through */
case PE_GO:
p = (PD *) tail;
proc_go(p);
/* should not return ? */
return (long)p;
case PE_LOADGO:
case PE_LOAD:
break;
default:
return EINVFN;
}
/* we now need to load a file */
KDEBUG(("BDOS xexec: trying to find the command ...\n"));
if (ixsfirst(path,0,0L)) {
KDEBUG(("BDOS xexec: command %s not found!!!\n",path));
return EFILNF; /* file not found */
}
/* load the header - if I/O error occurs now, the longjmp in rwabs will
* jump directly back to bdosmain.c, which is not a problem because
* we haven't allocated anything yet.
*/
rc = kpgmhdrld(path, &hdr, &fh);
if (rc) {
KDEBUG(("BDOS xexec: kpgmhdrld returned %ld (0x%lx)\n",rc,rc));
return rc;
}
/* allocate the environment first, always in ST RAM */
env_md = alloc_env(env);
if (env_md == NULL) {
KDEBUG(("BDOS xexec: not enough memory!\n"));
return ENSMEM;
}
/* allocate the basepage depending on memory policy */
needed = hdr.h01_tlen + hdr.h01_dlen + hdr.h01_blen + sizeof(PD);
m = alloc_tpa(hdr.h01_flags,needed,&max);
/* if failed, free env_md and return */
if (m == NULL) {
KDEBUG(("BDOS xexec: no memory for TPA\n"));
freeit(env_md, &pmd);
return ENSMEM;
}
p = (PD *) m->m_start;
/* memory ownership - the owner is either the new process being created,
* or the parent
*/
if (flag == PE_LOADGO) {
m->m_own = env_md->m_own = p;
} else {
m->m_own = env_md->m_own = run;
}
/* initialize the fields in the PD structure */
init_pd_fields(p, tail, max, env_md);
/* set the flags (must be done after init_pd) */
p->p_flags = hdr.h01_flags;
/* use static variable to avoid the obscure longjmp warning */
cur_p = p;
cur_m = m;
cur_env_md = env_md;
/* we have now allocated memory, so we need to intercept longjmp. */
memcpy(bakbuf, errbuf, sizeof(errbuf));
if (setjmp(errbuf)) {
KDEBUG(("Error and longjmp in xexec()!\n"));
/* free any memory allocated yet */
freeit(cur_env_md, &pmd);
freeit(cur_m, find_mpb(cur_m->m_start));
/* we still have to jump back to bdosmain.c so that the proper error
* handling can occur.
*/
longjmp(bakbuf, 1);
}
/* now, load the rest of the program and perform relocation */
rc = kpgmld(cur_p, fh, &hdr);
if (rc) {
KDEBUG(("BDOS xexec: kpgmld returned %ld (0x%lx)\n",rc,rc));
/* free any memory allocated yet */
freeit(cur_env_md, &pmd);
freeit(cur_m, find_mpb(cur_m->m_start));
return rc;
}
/* at this point the program has been correctly loaded in memory, and
* more I/O errors cannot occur, so it is safe now to finish initializing
* the new process.
*/
init_pd_files(cur_p);
/* invalidate instruction cache for the TEXT segment only
* programs that jump into their DATA, BSS or HEAP are kindly invited
* to do their cache management themselves.
*/
invalidate_instruction_cache(((char *)cur_p) + sizeof(PD), hdr.h01_tlen);
if (flag != PE_LOAD)
proc_go(cur_p);
return (long)cur_p;
}
int
_f_open(
FIOSPTR css, /* Fortran statement state */
unit **cup_p,/* input: pointer to currently open unit. output: */
/* pointer to new unit. */
olist *olptr, /* OPEN information */
int isf90) /* 1 if being opened from CF90, 0 if CF77 */
{
register short is_bin; /* 1 if binary; else 0 */
register short is_fmt; /* 1 if formatted; 0 if unformatted */
register short is_seq; /* 1 if sequential; 0 if direct */
register short is_sys; /* 1 if system; else 0 */
register short no_mem; /* 1 if malloc() fails */
register int aifound; /* 1 if assign/asgcmd info found */
register int errn; /* Error code */
register int gamask; /* Global assign mask */
register int oflags; /* O_EXCL/O_CREAT */
register int P_value; /* -P option value */
register int stdfn; /* 1 if std file stdin/stdout/stderr */
register int stdfnum; /* standard file descriptor number */
register int stat_ok; /* 1 if statbuf is valid */
register int tufs; /* requested file structure (default) */
register int uscope; /* File scope */
register unum_t unum; /* unit number */
char namebuf[MXUNITSZ]; /* buffer to construct file name */
char *fname; /* FILE= specifier or default filename*/
char *aname; /* actual file name */
char *atstr; /* assign attributes string */
unit *cup;
assign_info ai;
struct stat statbuf;
unum = olptr->ounit;
if (! GOOD_UNUM(unum))
FERROR1(olptr->oerr, FEIVUNIT, unum);
/*
* Check for a re-open before initializing any unit table fields.
*/
if (OPEN_UPTR(*cup_p)) {
/*
* The unit is connected, but we have already checked in
* $OPN for reconnection to the same file with unchanged
* attributes. Thus, we know that we may disconnect the unit
* here before continuing the set up of the new connection.
*
* We unlock it so that _alloc_unit may find it again and
* lock it.
*/
errn = _unit_close(*cup_p, CLST_UNSPEC, NULL);
if (errn != 0)
FERROR(olptr->oerr, errn);
_release_cup(*cup_p); /* unlock the unit */
}
/*
* "aname" receives the actual name to be opened by the system.
* It starts out the same as fname, but might later be reassigned
* by assign.
*/
aname = NULL;
fname = NULL;
stdfn = 0;
no_mem = 0;
if (olptr->ofile == NULL) { /* If no name specified */
if (olptr->ostatus == OS_SCRATCH) { /* If SCRATCH */
int scratchfd;
/*
* Scratch files have no name (see INQUIRE).
*/
fname = NULL;
aname = strdup("FXXXXXX");
scratchfd = mkstemp(aname);
close(scratchfd); /* because mkstemp opens the file */
}
else if (unum == 0 || unum == 5 || unum == 6 ||
RSVD_UNUM(unum)) {
stdfn = 1; /* Possible standard file */
stdfnum = -1;
switch (unum) {
case 5: /* Connect 5 and 100 to stdin */
case 100:
stdfnum = STDIN_FILENO;
break;
case 6: /* Connect 6 and 101 to stdout */
case 101:
stdfnum = STDOUT_FILENO;
break;
case 0: /* Connect 0 and 102 to stderr/errfile */
case 102: /* (see finit.c) */
stdfnum = fileno(errfile);
break;
default:
_ferr(css, FEINTUNK); /* deep weeds */
}
}
else { /* not scratch nor standard file */
(void) _fortname(namebuf, unum); /* Make default name */
fname = strdup(namebuf);
aname = strdup(namebuf);
no_mem = (aname == NULL) || (fname == NULL);
}
}
else { /* Copy user supplied name */
if ((fname = malloc(olptr->ofilelen + 1)) != NULL) {
_copy_n_trim(olptr->ofile, olptr->ofilelen, fname);
aname = strdup(fname);
}
no_mem = (aname == NULL) || (fname == NULL);
}
if (no_mem) { /* If malloc() failed */
freeit(aname);
freeit(fname);
FERROR(olptr->oerr, FENOMEMY); /* No memory */
}
is_bin = (olptr->oform == OS_BINARY) ? 1 : 0;
is_fmt = (olptr->oform == OS_FORMATTED) ? 1 : 0;
is_seq = (olptr->oaccess == OS_SEQUENTIAL ? 1 : 0);
is_sys = (olptr->oform == OS_SYSTEM) ? 1 : 0;
/*
* The ASN_G_SF/SU/DF/DU masks map to the ACCESS/FORM specifiers on OPEN.
*/
switch ((is_seq << 3) | is_fmt) {
case 011: /* Sequential Formatted */
gamask = ASN_G_SF;
break;
case 010: /* Sequential Unformatted */
gamask = ASN_G_SU;
break;
case 001: /* Direct Formatted */
gamask = ASN_G_DF;
break;
case 000: /* Direct Unformatted */
gamask = ASN_G_DU;
break;
}
gamask = gamask | ASN_G_ALL;
atstr = NULL;
aifound = _assign_asgcmd_info(fname, unum, gamask, &ai, &atstr,
olptr->oerr);
#ifdef KEY /* Bug 4924 */
/* Ignore "-F f77.mips" if the file is not sequential and thus has no
* headers. Otherwise, we would select an ffio layer which gives a
* runtime error on non-sequential files. Today f77.mips is the only
* value we support; if we supported some other value which permitted
* non-sequential access, this test would need to be made more precise.
*/
if (!is_seq) {
ai.F_filter_flg = 0;
}
#endif /* KEY Bug 4924 */
if (aifound == -1) {
freeit(fname);
freeit(aname);
freeit(atstr);
FERROR(olptr->oerr, errno);
}
/*
* Set up the scoping of this unit. -P process is default.
*/
uscope = AS_PROCESS; /* actual scope */
P_value = AS_PROCESS; /* -P option value, if any */
if (aifound == 1 && ai.P_ioscop_flg) {
uscope = ai.P_ioscop;
P_value = ai.P_ioscop;
/* Map -P private and -P global to the new spelling */
#ifdef _CRAYMPP
if (ai.P_ioscop == AS_PRIVATE)
uscope = AS_PROCESS;
#else
if (ai.P_ioscop == AS_PRIVATE)
uscope = AS_THREAD;
if (ai.P_ioscop == AS_GLOBAL)
uscope = AS_PROCESS;
#endif
}
#ifdef _CRAYMPP
if (uscope == AS_GLOBAL)
FERROR(olptr->oerr, FENOGLOB);
if (uscope == AS_THREAD)
FERROR(olptr->oerr, FENOTHRD);
if (uscope == AS_TEAM)
FERROR(olptr->oerr, FENOTEAM);
#else
if (uscope == AS_TEAM)
FERROR(olptr->oerr, FENOTEAM);
#endif
/*
* Now that we know the unit number and scope we can get a pointer to the
* unit table.
*/
#ifdef _CRAYMPP
cup = _alloc_unit(unum, 1); /* TEMPORARY */
#else
cup = _alloc_unit(unum, (uscope == AS_THREAD));
#endif
if (cup == NULL)
FERROR1(olptr->oerr, errno, unum);
*cup_p = cup;
/*
* Record OPEN specifiers in unit table
*/
cup->ubinary = is_bin;
cup->ufmt = is_fmt;
cup->useq = is_seq;
cup->usystem = is_sys;
cup->ublnk = (olptr->oblank == OS_ZERO ? 1 : 0);
cup->uposition = olptr->oposition;
cup->uaction = olptr->oaction;
cup->udelim = olptr->odelim;
cup->upad = olptr->opad;
cup->urecl = olptr->orecl;
/*
* Initialize the cf77/f90 mode. It might be changed in f_asgn() later.
*/
cup->uft90 = isf90;
if (aifound == 1 && ai.a_actfil_flg) {
stdfn = 0; /* standard file overridden */
freeit(aname);
aname = strdup(ai.a_actfil);
if (aname == NULL) {
freeit(atstr);
freeit(fname);
FERROR(olptr->oerr, FENOMEMY);
}
}
if (aifound == 1 && ai.D_fildes_flg) {
stdfn = 1; /* indicate standard file */
stdfnum = ai.D_fildes;
freeit(aname);
aname = NULL;
}
/*
* Units connected to stdin, stdout, or stderr may not have thread scope
* on PVP systems.
*/
#ifdef _CRAYMPP
if (stdfn && uscope == AS_TEAM) {
freeit(fname);
freeit(aname);
freeit(atstr);
FERROR(olptr->oerr, FENOTEAM);
}
#else
if (stdfn && uscope == AS_THREAD) {
freeit(fname);
freeit(aname);
freeit(atstr);
FERROR(olptr->oerr, (P_value==AS_PRIVATE)? FENOPRIV: FENOTHRD);
}
#endif
/*
* Set up cup->urecsize, the maximum record size. If RECL was
* specified (it's required on direct access files; optional
* on sequential access files), then RECL becomes the maximum
* record size for all formatted I/O on this unit. Otherwise
* we use default values for the maximum record size for both
* regular I/O and list-directed/namelist output.
*/
if (cup->ufmt) { /* If formatted file */
if (cup->urecl > 0) { /* If RECL specified */
cup->urecsize = cup->urecl;
cup->uldwsize = cup->urecl;
}
else { /* Else set defaults */
cup->urecsize = _f_rcsz;
cup->uldwsize = _f_ldsz;
}
/* Allocate line buffer for formatted files */
cup->ulinebuf = (long *) malloc(sizeof(long) *
(cup->urecsize + 1));
if (cup->ulinebuf == NULL) {
freeit(fname);
freeit(aname);
freeit(atstr);
FERROR(olptr->oerr, FENOMEMY);
}
}
/*
* See if the file exists. We don't know the filename for sure if FFIO
* is being used though.
*/
errn = 0;
stat_ok = 0;
if (stdfn) {
errn = fstat(stdfnum, &statbuf);
stat_ok = 1;
}
else if (aifound == 0 || ai.F_filter_flg == 0) {
errn = stat(aname, &statbuf);
stat_ok = 1;
}
/*
* ENOENT means the file doesn't exist. EINTR means the request
* was interrupted. If we got an EINTR error, retry the stat
* request a few times. A persistent EINTR error or any other
* stat error besides ENOENT is fatal.
*
* On UNICOS and UNICOS/mk systems, a EINTR error should never
* occur on a stat request... but we've seen some on UNICOS/mk
* for a reason the kernel developers do not understand.
*/
if (stat_ok && errn == -1) { /* If we did a stat and it failed */
register short retry = 0;
while (errn == -1 && errno == EINTR && retry++ < 10) {
if (stdfn)
errn = fstat(stdfnum, &statbuf);
else
errn = stat(aname, &statbuf);
}
if (errn == -1) { /* We have a hard failure */
stat_ok = 0;
if (errno != ENOENT) { /* If not ENOENT, abort */
freeit(fname);
freeit(aname);
freeit(atstr);
freeit(cup->ulinebuf);
FERROR(olptr->oerr, errno);
}
}
}
/* Select the file structure */
if (aifound == 1 && (ai.s_fstrct_flg || ai.F_filter_flg)) {
if (ai.F_filter_flg)
tufs = FS_FDC;
else
tufs = ai.s_fstrct;
}
else {
/* Select default file structure */
if ( cup->ufmt ) /* if formatted */
#if defined(__mips) || defined(_LITTLE_ENDIAN)
tufs = (cup->useq) ? FS_TEXT : FS_UNBLOCKED;
#else
tufs = FS_TEXT;
#endif
else { /* else unformatted */
#ifdef _UNICOS
tufs = (cup->useq) ? FS_COS : FS_UNBLOCKED;
#else /* else NOT _UNICOS */
tufs = (cup->useq) ? FS_F77 : FS_UNBLOCKED;
#endif /* END _UNICOS */
if (is_bin || is_sys) {
/*
* Use UNBLOCKED layer for direct or
* sequential unformatted IO that does
* not contain record control images.
* Formatted IO is not allowed (i.e., a)
*/
tufs = FS_UNBLOCKED;
}
}
/* See if the device is a tape and handle it accordingly */
if (stat_ok && _gsys_qtape(&statbuf) != 0)
tufs = FS_TAPE;
}
long xexec(WORD flag, char *path, char *tail, char *env)
{
PD *p;
PGMHDR01 hdr;
MD *m, *env_md;
LONG rc;
long max, needed;
FH fh;
D(("BDOS: xexec - flag or mode = %d\n", flag));
/* first branch - actions that do not require loading files */
switch(flag) {
case PE_RELOCATE:
p = (PD *) tail;
rc = kpgm_relocate(p, (long)path);
if(rc) {
D(("BDOS: xexec - kpgm_relloc returned %ld (0x%lx)\n", rc, rc));
return(rc);
}
/* invalidate instruction cache for the TEXT segment only
* programs that jump into their DATA, BSS or HEAP are kindly invited
* to do their cache management themselves.
*/
invalidate_icache( p+1, p->p_tlen);
return (long) p;
case PE_BASEPAGE:
/* just create a basepage */
env_md = alloc_env(env);
if(env_md == NULL) {
D(("xexec: Not Enough Memory!\n"));
return(ENSMEM);
}
max = (long) ffit(-1L, &pmd);
if(max >= sizeof(PD)) {
m = ffit(max, &pmd);
p = (PD *) m->m_start;
} else {
/* not even enough memory for basepage */
freeit(env_md, &pmd);
D(("xexec: No memory for TPA\n"));
return(ENSMEM);
}
/* memory ownership */
m->m_own = env_md->m_own = run;
/* initialize the PD */
init_pd_fields(p, tail, max, env_md);
init_pd_files(p);
return (long) p;
case PE_GOTHENFREE:
/* set the owner of the memory to be this process */
p = (PD *) tail;
set_owner(p, p, find_mpb(p));
set_owner(p->p_env, p, find_mpb(p->p_env));
/* fall through */
case PE_GO:
p = (PD *) tail;
proc_go(p);
/* should not return ? */
return (long)p;
case PE_LOADGO:
case PE_LOAD:
break;
default:
return EINVFN;
}
/* we now need to load a file */
D(("BDOS: xexec - trying to find the command ...\n"));
if (ixsfirst(path,0,0L)) {
D(("BDOS: Command %s not found!!!\n", path));
return(EFILNF); /* file not found */
}
/* load the header - if IO error occurs now, the longjmp in rwabs will
* jump directly back to bdosmain.c, which is not a problem because
* we haven't allocated anything yet.
*/
rc = kpgmhdrld(path, &hdr, &fh);
if(rc) {
D(("BDOS: xexec - kpgmhdrld returned %ld (0x%lx)\n", rc, rc));
return(rc);
}
/* allocate the environment first, always in ST RAM */
env_md = alloc_env(env);
if ( env_md == NULL ) {
D(("xexec: Not Enough Memory!\n"));
return(ENSMEM);
}
/* allocate the basepage depending on memory policy */
needed = hdr.h01_tlen + hdr.h01_dlen + hdr.h01_blen + sizeof(PD);
max = 0;
/* first try */
p = NULL;
m = NULL;
#if CONF_WITH_ALT_RAM
if(has_alt_ram && (hdr.h01_flags & PF_TTRAMLOAD)) {
/* use alternate ram preferably */
max = (long) ffit(-1L, &pmdalt);
if(max >= needed) {
m = ffit(max, &pmdalt);
p = (PD *) m->m_start;
}
}
#endif
/* second try */
if(p == NULL) {
max = (long) ffit(-1L, &pmd);
if(max >= needed) {
m = ffit(max, &pmd);
p = (PD *) m->m_start;
}
}
/* still failed? free env_md and return */
if(p == NULL) {
D(("xexec: No memory for TPA\n"));
freeit(env_md, &pmd);
return(ENSMEM);
}
assert(m != NULL);
/* memory ownership - the owner is either the new process being created,
* or the parent
*/
if(flag == PE_LOADGO) {
m->m_own = env_md->m_own = p;
} else {
m->m_own = env_md->m_own = run;
}
/* initialize the fields in the PD structure */
init_pd_fields(p, tail, max, env_md);
/* set the flags (must be done after init_pd) */
p->p_flags = hdr.h01_flags;
/* use static variable to avoid the obscure longjmp warning */
cur_p = p;
cur_m = m;
cur_env_md = env_md;
/* we have now allocated memory, so we need to intercept longjmp. */
memcpy(bakbuf, errbuf, sizeof(errbuf));
if ( setjmp(errbuf) ) {
kprintf("Error and longjmp in xexec()!\n");
/* free any memory allocated yet */
freeit(cur_env_md, &pmd);
freeit(cur_m, find_mpb((void *)cur_m->m_start));
/* we still have to jump back to bdosmain.c so that the proper error
* handling can occur.
*/
longjmp(bakbuf, 1);
}
/* now, load the rest of the program and perform relocation */
rc = kpgmld(cur_p, fh, &hdr);
if ( rc ) {
D(("BDOS: xexec - kpgmld returned %ld (0x%lx)\n", rc, rc));
/* free any memory allocated yet */
freeit(cur_env_md, &pmd);
freeit(cur_m, find_mpb((void *)cur_m->m_start));
return rc;
}
/* at this point the program has been correctly loaded in memory, and
* more IO errors cannot occur, so it is safe now to finish initializing
* the new process.
*/
init_pd_files(cur_p);
/* invalidate instruction cache for the TEXT segment only
* programs that jump into their DATA, BSS or HEAP are kindly invited
* to do their cache management themselves.
*/
invalidate_icache(((char *)cur_p) + sizeof(PD), hdr.h01_tlen);
if(flag != PE_LOAD)
proc_go(cur_p);
return (long) cur_p;
}
