ccasmb.c

KCC , a good c compiler, write by Ken Harrenstien

	/* No tmpcor, must use file.  Fix up buff ptr to reflect 7-bitness */
	str = bp7(str);
	}

#endif

    /* Can't use PRARG% or TMPCOR, make .TMP file */
    sprintf(tmpfile,
#if __MSDOS__
	"%03.3d%.3s.TMP",   getpid() & 0777,
#else
	"DSK:%03.3d%.3s.TMP", ((pid == 0) ? _getpid(pid) : pid),
#endif
		    name);
    if ((tf = fopen(tmpfile, "w")) == NULL)
	{
	errfopen("output TMP", tmpfile);
	if (cp)
	    free(cp);
	return NULL;
	}
    fputs(str, tf);		/* Write out the string */
    fclose(tf);
    if (cp)
	free(cp);
    return NULL;
}

/* MAKTFLINK - Make argument "file" for LINK.
**	This may be either a PRARG% block or TMPCOR-type file.
**	Note that ALL of the argument array is examined, including
**	the first one!  This may be set by the mainline to something special.
*/
/* ofilename is the filename to save executable image to */
/* nextprog is the next program to chain thru, if any */

static
int *
maktflink (int argct, char **argvt, char *ofilename, char *nextprog)
{
    extern char *libpath;	/* Specified in CCDATA */
    char *s, *t, *cp;
    char module[FNAMESIZE], ext[FNAMESIZE];
    char tmpfile[4000];			/* Very large buffer (sigh) */
    char *libstart = NULL;
    extern char *savofnam;	/* Defined in CC */


    /* Put together the command string for LINK */

    t = tmpfile;

    sprintf (t, "/define:$stksz:%d\n", stksz);	/* define stack size */
    t += strlen (t);

    if (profbliss)

        /*
	 * The BLISS profiler wants symbols high.
	 */

	t = estrcpy (t, "/symseg:high\n");
    else

    	/*
	 * The C profilers need symbols low.
	 */

	switch (abs (debcsi))
	    {
	    case KCC_DBG_SPRF :
		t = estrcpy (t, "SYS:KCCDBG/INCL:SPROF\n");
		break;


	    case KCC_DBG_FPRF :
		t = estrcpy (t, "SYS:KCCDBG/INCL:FNPROF\n");
		break;


	    default:
		break;
	    }

    if (ldddtf)					/* shall I link in DDT?  */
	t = estrcpy (t, "/test:DDT\n");		/* added 09/15/89 by MVS */

    /* Do preliminary stuff */

#ifdef	MULTI_SECTION /* FW 2A(51) */
    if (ldpsectf)		/* Hacking PSECTs? */
	{
	sprintf (t,"/SET:DATA:%o/LIMIT:DATA:%o/SET:CODE:%o/LIMIT:CODE:%o\n",
		ldpsdata.ps_beg, ldpsdata.ps_lim,
		ldpscode.ps_beg, ldpscode.ps_lim );
	t += strlen (t);
	t = estrcpy (t, "/REDIRECT:DATA:CODE/SYMSEG:PSECT:DATA\n");
	}

    if (ldextf)		/* Hacking extended addressing? */
	{
	t = fstrcpy (t, libpath, "ckx"); /* -i Preload x-addr module */
	*t++ = ',';
	}
#endif

    while (--argct >= 0)		/* while we have arguments left */
	{
	s = *argvt++;

	if (s == NULL)
	    continue;	/* Skip over ex-switches */

	if (*s == '-')
	    {
	    switch (*++s)	/* Is this a still-alive switch? */
		{
		case 'l':			/* -l Library search request */
		    if (libstart == NULL)
			libstart = t;
		    t = estrcpy (fstrcpy (t, libpath, s+1), "/SEARCH");
		    break;


		case 'L':			/* -L= Pass string to loader */
		    if (*++s == '=')
			{
			if (libstart == NULL)
			    libstart = t;
			t = estrcpy (t, s + 1);	/* Just copy it directly! */
			break;
			}

		/* If -L not followed by =, drop thru and complain */

		default:
		    jerr ("Internal error: bad LINK sw \"%s\"", argvt[-1]);
		}
	    }
	else		/* Assume it's a filename */
	    {
	    if ( (cp = fnparse (s, NULL, module, ext, NULL)) != NULL)
		jerr ("Bad filename arg for LINK (%s): \"%s\"", cp, s);
	    else if (fnxisrel (ext))	/* If it's a .REL file, copy */
		t = estrcpy (t, s);	/* entire name */
	    else if (libstart == NULL)
		t = estrcpy (t, (savofnam ? savofnam : module));
	    else
		{
		char *ptr;
		int length = strlen (module) + 1;

		/* ensure module(s) before libpath(s) */

		for (ptr = t - 2; ptr >= libstart; ptr--)
		    ptr[length] = ptr[0];	/* shift over libpath (s) */

		libstart = estrcpy (libstart, module);	/* insert module */
		*libstart++ = ',';
		t = t + length - 1;
		}
	    }

	if (profbliss)				/* for BLISS profiler */
	    t = estrcpy (t, "/locals");		/* added 09/15/89 by MVS */

	*t++ = ',';
	}

    /* Add final commands to SAVE and GO */

    t = estrcpy (estrcpy (estrcpy (t, "\n"), ofilename),
	    (!(ldddtf | debcsi | profbliss) ? "/SSA/RUN:MAKSHR" : "/SSA"));
    estrcpy (t, "/GO\n");

    if (vrbld)
	fprintf (outmsgs, "Loader argument: \"%s\"\n", tmpfile);

    return stmpfile ("LNK", tmpfile, nextprog);
}
    
/*
 * RUNLINK - invoked when all compilation done.
 *	May invoke assembler, linker, or a "next program".
 *	Always chains through, never returns.
 */

void
runlink (int linkf, int argc, char** argv, char* ofilename, char* nextprog)
    {
    int*	loc = NULL;
    char*	pname = NULL;
    char	mks_cmd_str[25];


    /* Need to invoke assembler? */

    if (asmtfptr)
	{
	pname = "MACRO";		/* Default */
	stmpfile (pname, asmtfptr,	/* Build TMPCOR or .TMP file */
		 (link ? "LINK" : nextprog));
	}

    /* Need to invoke loader? */

    if (linkf)
	{
	loc = maktflink (argc, argv, ofilename, nextprog);

	if (!(ldddtf | debcsi | profbliss))
	    {
	    sprintf (mks_cmd_str, "%s/o\n", ofilename);
	    stmpfile ("MKS", mks_cmd_str, NULL);
	    }

	if (!pname)
	    pname = "LINK";
	}

    /*
     * Check for case of chaining through random program.  If so,
     * we don't even bother setting the PRARG% block or TMPCOR file or
     * anything, since all should already have been set up by the EXEC, and
     * as long as we're chaining, the new program will have access to the same
     * PRARG% block that we originally read.  And of course if a disk .TMP
     * file was used, that should already exist.
     */

    if (!pname)				/* If neither asm or link, */
	{
	if ((pname = nextprog) == NULL)	/* must be chaining random prog. */
	    fatal ("Internal error: Chaining to no program!");
	}

    /* Invoke program!! */
    /* Note that loc will be set only if a PRARG% block is being used. */

    if (!hackfork (pname, loc, PRGBLEN, 1, 1))
	fatal ("Could not chain to %s", pname);	/* never to return */
    }

static
int
hackfork (char* pgmname, int* argblk, int blklen, int stoffset, int chainf)
    {
#if !__MSDOS__							// FW KCC-NT
    struct
    frkxec	fx;


    fflush (stdout);	/* Make sure no output lost if chaining */

    fx.fx_flags = FX_PGMSRCH | FX_WAIT
		| (stoffset ? FX_STARTOFF : 0)
		| (chainf ? FX_NOFORK : 0);
    fx.fx_name = pgmname;
    fx.fx_argv = fx.fx_envp = NULL;
    fx.fx_startoff = stoffset;
    fx.fx_blkadr = (char *) argblk;
    fx.fx_blklen = blklen;

#ifdef __COMPILER_KCC__
    return (forkexec (&fx) < 0 ? 0 : 1);
#else
    return 1;	/* assume OK */
#endif

#else
	return 1;
#endif
}


/*
 * FNPARSE - do simple parsing of filename; tries to find the module
 *	name component, and everything else is derived from that.
 */

char *
fnparse (char* source, char* dir, char* name, char* ext, char* suf)
    {
#if __MSDOS__
#ifndef	WIN32							// FW KCC-NT
    int		fnsplit (const char *source_path, char *suf_drive, char *dir,
			 char *name, char *ext);


    fnsplit (source, suf, dir, name, ext);
    return NULL;	/* assume OK */
#else
	char		buf[256];
	char*		cp;


	strcpy (buf, source);				// Make a copy we can play with.
	*suf = '\0';						// Not going to return this anyhow.

	cp = strrchr (buf, '.');			// Is there an extension?

	if (cp)
		{
		strcpy (ext, cp);				// Yes: return it.
		*cp = '\0';						// Delimit the basename.
		}
	else
		{
		*ext = '\0';					// No: tell the caller.
		cp = buf + strlen (buf);		// Set up to parse the basename.
		}

	do
		{
		--cp;
		}
	while ((cp >= buf) && (*cp != '\\') && (*cp != '/') && (*cp != ':'));

	strcpy (name, ++cp);
	*cp = '\0';
	strcpy (dir, buf);

	return NULL;
#endif
#else
    register
    char*	cp = source;
    char*	start = cp;
    int		devf = 0;
    int		i;


    *name = *ext = 0;	/* Init all returned strings */

    if (dir)
	*dir = 0;	/* optional args */

    if (suf)
	*suf = 0;

    for (;;)
	{
	switch (*cp)
	    {
	/* Check possible name terminators */
	    case '\0':
	    case '.':
		break;

	/* Check for directory start chars (must skip insides) */

#define DIRSTOP ']'
	    case '[':
		if (start != cp)		/* If collected a name, */
		    break;			/* we've won, OK to stop! */

		if ( (cp = strchr (cp, DIRSTOP)) == NULL)
		    return "malformed directory name";
	    /* Now drop through to handle as if randomly terminated */

	/* Check for other random word terminators */
	    case DIRSTOP:		/* Directory */
	    case '/':			/* Un*x-simulation directory */
		start = ++cp;
		continue;

	/* Do special check to permit "DEV:" alone to succeed */
	    case ':':			/* Device */
		if (start == source && !cp[1])	/* 1st & only word? */
		    {
		    ++devf;		/* Yep, set flag and stop */
		    break;
		    }
		else if (start == source && stats_parse)
		    {
		    short pos = cp - source;
		    strncpy (dir,source,pos);
		    dir[pos]='\0';
		    }

		start = ++cp;		/* Nope, start new name search */
		continue;

	/* Check for string-type quote chars */
	    case '\"':
		i = *cp++;			/* Remember the char */
		if ( (cp = strchr (cp, i)) == NULL)
		    return "unbalanced quoted name";
		++cp;			/* Include ending quote */
		break;			/* and assume this was filename */

	/* Check for single-char quote chars */
	    case '\\':			/* Backslash */
		if (!cp[1])			/* Don't permit quoting NUL */
		    return "NUL char quoted";
		++cp;			/* Else OK, include quote char. */

	/* Handle normal filename char */
	    default:
		++cp;
		continue;
	    }
	break;			/* If break from switch, stop loop. */
	}

    /* Found name if any, rest is easy */
    i = cp - start;
    if (i == 0)	/* Find length of name */
	return "no module name";	/* Ugh */

    strncat (name, start, i);	/* Return module name */
    if (devf)			/* Handle "FOO:" specially */
	{
	if (dir)
	    strcpy (dir, source);
	return NULL;
	}
    if (start != source && dir && !stats_parse)	/* Copy stuff preceding name */
	strncat (dir, source, start-source);

    /* Now check for extension.  Slightly tricky. */
    if (*cp == '.')
	{
	start = cp;
	while (isalnum (*++cp))
	    ;		/* Scan over valid chars */
	strncat (ext, start, cp-start);	/* Copy what we got of extension */
	}

    if (*cp && suf)			/* If anything left after ext, */
	strcpy (suf, cp);		/* just copy it all. */

    return NULL;			/* Say we won, no error msg! */
#endif	/* not MSDOS */
    }

int
fnxisrel (char* cp)
    {
    return (*cp == '.'
#if __MSDOS__
	    && toupper (*++cp) == 'O'
	    && toupper (*++cp) == 'B'
	    && toupper (*++cp) == 'J'
#else
	    && toupper (*++cp) == 'R'
	    && toupper (*++cp) == 'E'
	    && toupper (*++cp) == 'L'
#endif
	    && ! (*++cp));
    }



/* Misc auxiliaries */
/* ESTRCPY - like STRCPY but returns pointer to END of s1, not beginning.
**	Copies string s2 to s1, including the terminating null.
**	The returned pointer points to this null character which ends s1.
*/

char *
estrcpy (register char *s1, register char *s2)
{
    if ( (*s1 = *s2) != '\0')
	while ( (*++s1 = *++s2) != '\0')
	    ;
    return s1;
}

/* FSTRCPY - Filename string copy.  Builds a filename string out of
**	a name and prefix+suffix string, and copies it.
**	Like estrcpy (), the returned pointer points to the END of the
**	copied string.
*/
char *
fstrcpy (register char *d, register char *ps, register char *fname)
{
    if (!ps || !*ps)			/* If no prefix+suffix, */
	return estrcpy (d, fname);	/* just copy basic filename */
    if ( (*d = *ps) != FILE_FIX_SEP_CHAR)	/* If have a prefix, */
	while ( (*++d = *++ps) != '\0' && *d != FILE_FIX_SEP_CHAR)
	    ;	/* copy it */
    d = estrcpy (d, fname);		/* Done, now copy filename */
    return *ps ? estrcpy (d, ps+1) : d;	/* then suffix, if any */
}

INT
sixbit (str)
register char *str;
{
    register int i = 6*6, c;
    register unsigned INT val = 0;

    --str;
    while (i > 0 && (c = *++str) != '\0')
	val |= tosixbit ((char) c) << (i -= 6);	// FW KCC-NT

    return val;
}
INT
rad50 (str)