BLARSON@ECLA.USC.EDU (Bob Larson) (05/26/88)
comp.sources.misc: Volume 3, Issue 34
Submitted-By: "Bob Larson" <BLARSON@ECLA.USC.EDU>
Archive-Name: mg2a/Part10
# This is a shell archive.
# Remove everything above and including the cut line.
# Then run the rest of the file through sh.
#----cut here-----cut here-----cut here-----cut here----#
#!/bin/sh
# shar: Shell Archiver
# Run the following text with /bin/sh to create:
# sys/osk/fileio.c
# sys/osk/makefile
# sys/osk/readme.osk
# sys/osk/spawn.c
# sys/osk/sysdef.h
# sys/osk/ttyio.c
# sys/osk/varargs.h
# sys/vms/aaareadme.1st
# sys/vms/ccom.com
# sys/vms/fileio.c
# sys/vms/fparse.c
# sys/vms/make.com
# sys/vms/mg.com
# sys/vms/mg.opt
# sys/vms/spawn.c
# sys/vms/sysdef.h
# sys/vms/trnlnm.c
# sys/vms/unixfns.mar
# This archive created: Mon May 23 18:09:33 1988
# By: blarson
if test -d sys
then true
else mkdir sys
fi
if test -d sys/osk
then true
else mkdir sys/osk
fi
if test -d sys/vms
then true
else mkdir sys/vsm
fi
cat << \SHAR_EOF > sys/osk/fileio.c
/*
* Os9/68k fileio.c for MicroGnuEmacs by Robert A. Larson
* system dependent file io routines
*/
#include "def.h"
#include "kbd.h"
#include <modes.h>
#include <dir.h>
#include <direct.h>
char *getenv(), *index();
static FILE *ffp;
/*
* Open a file for reading.
*/
ffropen(fn)
char *fn;
{
if ((ffp=fopen(fn, "r")) == NULL) return FIOFNF;
return FIOSUC;
}
/*
* Open a file for writing.
*/
ffwopen(fn)
char *fn;
{
if ((ffp=fopen(fn, "w")) == NULL) {
ewprintf("Cannot open file %s for writing", fn);
return FIOERR;
}
return FIOSUC;
}
/*
* Close a file.
* Should look at the status.
*/
ffclose()
{
fclose(ffp);
return FIOSUC;
}
/*
* Write a buffer to the already
* opened file. bp points to the
* buffer. Return the status.
* Check only at the newline and
* end of buffer.
*/
ffputbuf(bp)
BUFFER *bp;
{
register char *cp;
register char *cpend;
register LINE *lp;
register LINE *lpend;
lpend = bp->b_linep;
lp = lforw(lpend);
do {
cp = <ext(lp)[0]; /* begining of line */
cpend = &cp[llength(lp)]; /* end of line */
while(cp != cpend) {
putc(*cp, ffp);
cp++; /* putc may evalualte arguments more than once */
}
lp = lforw(lp);
if(lp == lpend) break; /* no implied newline on last line */
putc('\n', ffp);
} while(!ferror(ffp));
if(ferror(ffp)) {
ewprintf("Write I/O error");
return FIOERR;
}
return FIOSUC;
}
/*
* Read a line from a file, and store the bytes
* in the supplied buffer. Stop on end of file or end of
* line. When FIOEOF is returned, there is a valid line
* of data without the normally implied \n.
*/
ffgetline(buf, nbuf, nbytes)
register char *buf;
register int nbuf;
register int *nbytes;
{
register int c;
register int i;
i = 0;
while((c = getc(ffp))!=EOF && c!='\n') {
buf[i++] = c;
if (i >= nbuf) return FIOLONG;
}
if (c == EOF && ferror(ffp) != FALSE) {
ewprintf("File read error");
return FIOERR;
}
*nbytes = i;
return c==EOF ? FIOEOF : FIOSUC;
}
#ifndef NO_BACKUP
/*
* Rename the file "fname" into a backup copy.
* The backup copy is the same name with ".BAK" appended unless the file
* name is to long. The error handling is all in "file.c".
*/
fbackupfile(fname)
char *fname;
{
char *rindex();
register char *backname, *cp;
int stat;
if((backname = malloc(strlen(fname) + 5)) == NULL) return FALSE;
/* delete the old backup */
strcpy(backname, fname);
strcat(backname, ".BAK");
unlink(backname); /* ignore errors */
if(cp = rindex(fname, '/')) {
strcpy(backname, cp+1);
strcat(backname, ".BAK");
}
stat = rename(fname, backname) >= 0;
free(backname);
return stat;
}
#endif
#ifdef NO_BACKUP
#ifdef NO_DIRED
#define NO_RENAME
#endif
#endif
#ifndef NO_RENAME
rename(frname, toname)
char *frname, *toname;
{
register char *params;
register int frnamel, tonamel;
int status;
frnamel = strlen(frname);
tonamel = strlen(toname);
if((params = malloc(frnamel + tonamel + 2)) == NULL) return FALSE;
strcpy(params, frname);
params[frnamel] = ' ';
strcpy(params + frnamel + 1, toname);
if(os9fork("rename", frnamel + tonamel + 2, params, 0, 0, 0, 0)==-1) {
free(params);
return -1;
}
wait(&status);
free(params);
return (status & 0xffff)==0 ? 0 : -1;
}
#endif
/*
* The string "fn" is a file name.
* Perform any required appending of directory name or case adjustments.
* If NO_DIR is not defined, the same file should be refered to even if the
* working directory changes. For Os9/68k, leave the file name case alone
* so we use what the user specified. (Should, but doesn't, use the case
* stored on the disk for existing files.)
*/
#ifndef NO_DIR
extern char *wdir;
#endif
char *adjustname(fn)
register char *fn;
{
static char fnb[NFILEN];
register char *cp;
register char *rootp;
switch(*fn) {
case '/':
cp = fnb;
*cp++ = *fn++;
while(*fn && (*cp++ = *fn++) != '/') {}
rootp = cp - 1;
break;
case '~':
if(fn[1] != '/') return fn; /* invalid, punt */
strcpy(fnb, getenv("HOME"));
rootp = index(fnb+1, '/');
cp = fnb + strlen(fnb);
if(cp==fnb) return fn; /* invalid */
if(rootp == NULL) rootp = cp;
*cp++ = '/';
fn += 2;
break;
default:
#ifndef NODIR
strcpy(fnb, wdir);
rootp = index(fnb+1, '/');
cp = fnb + strlen(fnb);
if(cp==fnb) return fn; /* invalid */
if(rootp == NULL) rootp = cp;
*cp++ = '/';
break;
#else
return fn; /* punt */
#endif
}
while(*fn) {
if(*fn == '.') {
switch(fn[1]) {
case '\0':
*--cp = '\0';
return fnb;
case '/':
fn += 2;
continue;
case '.':
if(fn[2]=='/' || fn[2] == '\0') {
--cp;
while(cp > rootp && *--cp != '/') {}
++cp;
if(fn[2]=='\0') {
*--cp = '\0';
return fnb;
}
fn += 3;
continue;
}
break;
default: break;
}
}
while(*fn && (*cp++ = *fn++) != '/') {}
}
*cp = '\0';
return fnb;
}
/*
* fncmp: compare file or buffer names. Return 0 on equality.
* (for compatibility with strcmp) Both arguments have been
* through adjustname.
*/
fncmp(fna, fnb)
register char *fna, *fnb;
{
register char ca, cb;
while(ca = *fna++)
if(ca != (cb = *fnb++) &&
(!ISUPPER(ca) || TOLOWER(ca) != cb) &&
(!ISUPPER(cb) || ca != TOLOWER(cb)))
return -1;
return *fnb;
}
#ifndef NO_STARTUP
char *startupfile(suffix)
char *suffix;
{
register char *file;
static char home[NFILEN];
char *getenv();
if ((file = getenv("HOME")) == NULL) goto notfound;
if (strlen(file)+4 >= NFILEN - 1) goto notfound;
(VOID) strcpy(home, file);
(VOID) strcat(home, "/.mg");
if (suffix != NULL) {
(VOID) strcat(home, "-");
(VOID) strcat(home, suffix);
}
if (access(home, 0) == 0) return home;
notfound:
#ifdef STARTUPFILE
file = STARTUPFILE;
if (suffix != NULL) {
(VOID) strcpy(home, file);
(VOID) strcat(home, "-");
(VOID) strcat(home, suffix);
file = home;
}
if (access(file, 0) == 0) return file;
#endif
return NULL;
}
#endif
#ifndef NO_DIR
char *getwd(cwd)
char *cwd;
{
char backpath[MAXPATH];
char *bpp = backpath, *path = cwd;
DIR *dirp;
struct direct *dp;
long inode, inode2;
char dots[MAXPATH];
if((dirp = opendir(".")) == NULL || readdir(dirp) == NULL ||
(dp = readdir(dirp)) == NULL) {
closedir(dirp);
return (char *)NULL;
}
inode = dp->d_addr;
*path++ = '/';
_gs_devn(dirp->dd_fd, path);
path += strlen(path);
closedir(dirp);
strcpy(dots, "..");
for(;;) {
if((dirp = opendir(dots)) == NULL || readdir(dirp) == NULL ||
(dp = readdir(dirp)) == NULL) {
closedir(dirp);
return (char *)NULL;
}
inode2 = dp->d_addr;
if(inode == inode2) break;
do {
if((dp = readdir(dirp)) == NULL) {
closedir(dirp);
return (char *)NULL;
}
} while(dp->d_addr != inode);
*bpp++ = '/';
strcpy(bpp, dp->d_name);
bpp += strlen(bpp);
closedir(dirp);
inode = inode2;
strcat(dots, "/..");
}
while(bpp > backpath) {
*bpp = '\0';
while(*--bpp != '/') {}
strcpy(path, bpp);
path += strlen(path);
}
return cwd;
}
#endif
#ifndef NO_DIRED
copy(frname, toname)
char *frname, *toname;
{
register char *params;
register int frnamel, tonamel;
int status;
frnamel = strlen(frname);
tonamel = strlen(toname);
if((params = malloc(frnamel + tonamel + 2)) == NULL) return FALSE;
strcpy(params, frname);
params[frnamel] = ' ';
strcpy(params + frnamel + 1, toname);
if(os9fork("copy", frnamel + tonamel + 2, params, 0, 0, 0, 0)==-1) {
free(params);
return -1;
}
wait(&status);
free(params);
return (status & 0xffff)==0 ? 0 : -1;
}
unlinkdir(fname)
char *fname;
{
/* does NOT delete non-empty directories */
if(_ss_attr(fname, S_IWRITE | S_IREAD) < 0) return -1;
return unlink(fname);
}
BUFFER *dired_(dirname)
char *dirname;
{
extern char *wdir; /* defined in dir.c */
register BUFFER *bp;
char line[128];
register FILE *dirpipe;
int i;
BUFFER *findbuffer();
if(dirname == NULL || *dirname == '\0') dirname = wdir;
else if((dirname = adjustname(dirname)) == NULL) {
ewprintf("Could not adjust dir name");
return NULL;
}
if((bp = findbuffer(dirname)) == NULL) {
ewprintf("Could not create buffer");
return NULL;
}
if(bclear(bp) != TRUE) return NULL;
i = -1;
strcpy(line, "-ae ");
strcpy(&line[4], dirname);
/* fopen doesn't work here for some reason, so use open & fdopen */
if((i = open("/pipe", S_IREAD | S_IWRITE)) < 0 ||
((dirpipe = fdopen(i, "rw")) == NULL) || ((i = dup(1)) < 0) ||
(close(1) < 0) || (dup(fileno(dirpipe)) != 1) ||
(os9fork("dir", strlen(line) + 1, line, 0, 0, 0, 0) < 0) ||
(close(1) < 0) || (dup(i) != 1) || (close(i) < 0)) {
ewprintf("Could not open pipe to dir");
fclose(dirpipe);
if(i >= 0) {
close(1);
dup(i);
close(i);
}
return NULL;
}
line[0] = line[1] = ' ';
while(fgets(&line[2], 126, dirpipe) != NULL) {
line[strlen(line) - 1] = '\0';
addline(bp, line);
}
if(fclose(dirpipe) < 0 || wait(&i) < 0 || i != 0) {
ewprintf("Trouble closing directory pipe");
return NULL;
}
bp->b_dotp = lforw(bp->b_linep); /* go to first line */
strncpy(bp->b_fname, dirname, NFILEN);
if((bp->b_modes[0] = name_mode("dired")) == NULL) {
bp->b_modes[0] = &map_table[0];
ewprintf("Could not find mode dired");
return NULL;
}
bp->b_nmodes = 0;
return bp;
}
d_makename(lp, fn)
register LINE *lp;
register char *fn;
{
register char *cp;
if(llength(lp) <= 54) return ABORT;
strcpy(fn, curbp->b_fname);
cp = fn + strlen(fn);
*cp++ = '/';
bcopy(&lp->l_text[54], cp, llength(lp) - 54);
cp[llength(lp) - 54] = '\0';
return lgetc(lp, 27) == 'd';
}
#endif
SHAR_EOF
cat << \SHAR_EOF > sys/osk/makefile
# Makefile for OSK MicroGnuEMACS by Robert A. Larson
# 07/12/86 MicroGnuEMACS version
# Copy ./sys/osk/makefile to . before making. Check
# OPTS and LIBS.
#
# mg is short for micrognuemacs. Call it what you want.
NAME = mg
# terminal type or termcap
TERM = TERMCAP
# opts is for user definable options
OPTS = -dMAXMEM=320 -dXKEYS
# termlib is needed for termcap.
LFLAGS = -l=/dd/lib/termlib.l -m=4
CFLAGS = -r=. -t=/r0
OBJ = basic.r \
dir.r \
dired.r \
file.r \
line.r \
match.r \
paragraph.r \
random.r \
region.r \
search.r \
version.r \
window.r \
word.r
# unique requirements
IND = buffer.r \
display.r \
echo.r \
extend.r \
help.r \
kbd.r \
keymap.r \
macro.r \
main.r \
modes.r \
regex.r \
re_search.r
# these files are listed individually below
SYSOBJ = cinfo.r \
fileio.r \
spawn.r \
ttyio.r \
tty.r \
ttykbd.r
#
$(NAME): $(OBJ) $(IND) $(SYSOBJ) makefile
cc -i -f=$(NAME) $(LFLAGS) $(OBJ) $(IND) $(SYSOBJ)
$(OBJ): def.h sysdef.h ttydef.h chrdef.h makefile
cc $(CFLAGS) $(OPTS) $*.c
kbd.r: def.h sysdef.h ttydef.h chrdef.h makefile macro.h kbd.h key.h
cc $(CFLAGS) $(OPTS) $*.c
macro.r main.r: def.h sysdef.h ttydef.h chrdef.h makefile macro.h
cc $(CFLAGS) $(OPTS) $*.c
buffer.r display.r keymap.r help.r modes.r dired.r: \
def.h sysdef.h ttydef.h chrdef.h makefile kbd.h
cc $(CFLAGS) $(OPTS) $*.c
extend.r: def.h sysdef.h ttydef.h chrdef.h makefile kbd.h macro.h key.h
cc $(CFLAGS) $(OPTS) $*.c
help.r: def.h sysdef.h ttydef.h chrdef.h makefile kbd.h key.h macro.h
cc $(CFLAGS) $(OPTS) $*.c
echo.r: def.h sysdef.h ttydef.h chrdef.h makefile key.h macro.h
cc $(CFLAGS) $(OPTS) $*.c
regex.r re_search.r: def.h sysdef.h ttydef.h chrdef.h makefile regex.h
cc $(CFLAGS) $(OPTS) $*.c
fileio.r: sys/osk/fileio.c def.h sysdef.h ttydef.h chrdef.h makefile kbd.h
cc $(CFLAGS) $(OPTS) sys/osk/fileio.c
spawn.r: sys/osk/spawn.c def.h sysdef.h ttydef.h chrdef.h makefile
cc $(CFLAGS) $(OPTS) sys/osk/spawn.c
ttyio.r: sys/osk/ttyio.c def.h sysdef.h ttydef.h chrdef.h makefile
cc $(CFLAGS) $(OPTS) sys/osk/ttyio.c
tty.r: sys/default/tty.c def.h sysdef.h ttydef.h chrdef.h makefile
cc $(CFLAGS) $(OPTS) sys/default/tty.c
ttykbd.r: sys/default/ttykbd.c def.h sysdef.h ttydef.h chrdef.h makefile
cc $(CFLAGS) $(OPTS) sys/default/ttykbd.c
cinfo.r: sys/default/cinfo.c def.h sysdef.h ttydef.h chrdef.h makefile
cc $(CFLAGS) $(OPTS) sys/default/cinfo.c
# The touch commands are needed to update the modified time.
sysdef.h: sys/osk/sysdef.h
copy -b=16 -w=. -r sys/osk/sysdef.h
touch sysdef.h
ttydef.h: sys/default/ttydef.h
copy -b=16 -w=. -r sys/default/ttydef.h
touch ttydef.h
chrdef.h: sys/default/chrdef.h
copy -b=16 -w=. -r sys/default/chrdef.h
touch chrdef.h
SHAR_EOF
cat << \SHAR_EOF > sys/osk/readme.osk
readme.osk for MicroGnuEmacs 2a Oct 27, 1987
Copy sys/osk/makefile to .
copy sys/osk/varargs.h to /dd/defs/varargs.h if you don't have one.
Look at makefile for personal preference options and terminal selection.
Use make to compile.
Baud should be set correctly in tmode/xmode even if it is set in
hardware as it is on a QT+. This is used for display optimization
and padding.
All files are indented assuming tabs every eight columns, and mg
itself uses tabs there. I have no idea why Microware decided not to
follow this defacto industry standard, but at least they allow you to
change your system to whatever you want.
The enviornment variable TERM is used to determine your terminal type,
and HOME is used to find the .mg startup file and for expanding a
leading ~ in a file name.
SHAR_EOF
cat << \SHAR_EOF > sys/osk/spawn.c
/*
* Name: MicroGnuEmacs
* OS9/68k Spawn Shell
*/
#include "def.h"
#include <sgstat.h>
extern struct sgbuf oldtty; /* There really should be a */
extern struct sgbuf newtty; /* nicer way of doing this */
spawncli(f, n)
{
register int pid;
register int wpid;
int status;
register char *cp;
int os9fork();
static char *argv[2] = {"shell", NULL};
extern char **environ;
char *getenv();
ttcolor(CTEXT);
ttnowindow();
ttmove(nrow-1, 0);
if (epresf != FALSE) {
tteeol();
epresf = FALSE;
}
ttflush();
if((cp=getenv("SHELL")) != NULL) argv[0] = cp;
if(_ss_opt(0, &oldtty) == -1) {
ewprintf("_ss_opt #1 to terminal failed");
return FALSE;
}
if((pid=os9exec(os9fork, argv[0], argv, environ, 0, 0)) == -1) {
ewprintf("Failed to create process");
return FALSE;
}
while ((wpid=wait(&status))>=0 && wpid!=pid) {}
sgarbf = TRUE; /* Force repaint. */
if(_ss_opt(0, &newtty) == -1) {
ewprintf("_ss_opt #2 to terminal failed");
return FALSE;
}
return TRUE;
}
SHAR_EOF
cat << \SHAR_EOF > sys/osk/sysdef.h
/*
* Os9/68K specific definitions for micrognuemacs
*/
#include <stdio.h>
#define KBLOCK 1024 /* Kill grow. */
#define GOOD 0 /* Good exit status. */
#define NO_VOID_TYPE /* void not supported yet */
#define PC PC_ /* compiler can't handle variable */
#define SR SR_ /* called PC or SR */
#define NO_RESIZE /* terminal doesn't change size */
typedef int RSIZE; /* Type for file/region sizes */
typedef short KCHAR; /* Type for keyboard character */
#define MAXPATH 128 /* reasonable maximum path length */
/* malloc works best with a multiple of 8 bytes */
#define MALLOCROUND(v) ((v) += 7, (v) &= ~7)
/*
* Macros used by the buffer name making code.
* Start at the end of the file name, scan to the left
* until BDC1 (or BDC2, if defined) is reached. The buffer
* name starts just to the right of that location, and
* stops at end of string (or at the next BDC3 character,
* if defined). BDC2 and BDC3 are mainly for VMS.
*/
#define BDC1 '/' /* Buffer names. */
/*
* Needed for lots of small mallocs on os9/68k. _memmins should be
* (maximum malloced memory)/16. (defalt _memmins is 4096)
* Note that malloc may now fail if there isn't _memmins bytes
* contiguous free memory. _memins could be reduced and the malloc
* tried again. (Not currently implemented.)
*/
#ifdef MAXMEM
# define SYSINIT {extern int _memmins; _memmins=MAXMEM*64; }
#else
# define SYSINIT {extern int _memmins; _memmins=32768; }
#endif
/* see "caveates" in the osk C manual on _strass */
#define bcopy(from,to,len) _strass(to,from,len)
/* see comments on these in display.c. OSK can't stand the wasted memory
* without making the score array "remote", which generates lousy code.
* Besides, I don't have an extra 100kb of memory for the score array.
*/
#define XCHAR char
#define XSHORT short
char *getenv();
#define gettermtype() getenv("TERM") /* get terminal type */
SHAR_EOF
cat << \SHAR_EOF > sys/osk/ttyio.c
/*
* sys/osk/ttyio.c by Robert A. Larson
*
* The functions in this file
* negotiate with the operating system for
* keyboard characters, and write characters to
* the display in a barely buffered fashion.
*/
#include "def.h"
#include <sgstat.h>
#ifndef NO_DPROMPT
# include <varargs.h>
# define S_RDY 2437 /* arbitrary user signal */
#endif
#define NOBUF 512 /* Output buffer size. */
char obuf[NOBUF]; /* Output buffer. */
int nobuf;
struct sgbuf oldtty, newtty;
int nrow; /* Terminal size, rows. */
int ncol; /* Terminal size, columns. */
short ospeed; /* Terminal speed, for termlib.l */
#ifndef NO_DPROMPT
wakeup(signum)
int signum;
{
/* ignore the signal */
}
#endif
/*
* This function gets called once, to set up
* the terminal channel.
*/
ttopen()
{
if(_gs_opt(0, &oldtty) == -1) panic("can't get options");
ospeed = oldtty.sg_baud;
_strass(&newtty, &oldtty, sizeof(newtty)); /* newtty=oldtty; */
if(oldtty.sg_class == 0) { /* scf */
newtty.sg_backsp=
newtty.sg_delete=
newtty.sg_echo =
newtty.sg_alf =
newtty.sg_pause =
newtty.sg_bspch =
newtty.sg_dlnch =
newtty.sg_eorch =
newtty.sg_eofch =
newtty.sg_rlnch =
newtty.sg_dulnch=
newtty.sg_psch =
newtty.sg_kbich =
newtty.sg_kbach = 0;
#ifndef xon_xoff
newtty.sg_xon =
newtty.sg_xoff = 0;
#endif
if(_ss_opt(0, &newtty) == -1) panic("can't set options");
nrow = oldtty.sg_page == 0 ? NROW : oldtty.sg_page;
} else { /* not scf, fake it */
nrow = NROW;
}
ncol = NCOL;
#ifndef NO_DPROMPT
intercept(wakeup); /* ignore signals */
#endif
}
/*
* This function gets called just
* before we go back home to the shell. Put all of
* the terminal parameters back.
*/
ttclose()
{
ttflush();
if(_ss_opt(0, &oldtty) == -1) panic("can't reset options");
}
/*
* Write character to the display.
* Characters are buffered up, to make things
* a little bit more efficient.
*/
ttputc(c)
{
if (nobuf >= NOBUF)
ttflush();
obuf[nobuf++] = c;
}
/*
* Flush output.
*/
ttflush()
{
if (nobuf != 0) {
write(1, obuf, nobuf);
nobuf = 0;
}
}
/*
* Read character from terminal.
* All 8 bits are returned, so that you can use
* a multi-national terminal.
*/
ttgetc()
{
char buf[1];
while (read(0, &buf[0], 1) != 1)
;
return (buf[0] & 0xFF);
}
int typeahead()
{
return _gs_rdy(0) > 0;
}
panic(s) char *s; {
_ss_opt(0, &oldtty); /* ignore errors */
fputs("Panic: ", stdout); /* avoid printf, don't load all that */
puts(s);
exit(1);
}
#ifndef NO_DPROMPT
ttwait() {
if(_gs_rdy(0) > 0) return FALSE; /* already something waiting */
_ss_ssig(0, S_RDY); /* wake me when you have something */
if(sleep(2)!=0) return FALSE; /* sleep interupted */
_ss_rel(0);
return TRUE;
}
#endif
SHAR_EOF
cat << \SHAR_EOF > sys/osk/varargs.h
/* varargs.h for os9/68k by Robert A. Larson */
/* version 0 for os9/68k C 2.0 04/20/86 */
/* varargs is a "portable" way to write a routine that takes a variable */
/* number of arguements. This implemination agrees with both the 4.2bsd*/
/* and Sys V documentation of varargs. Note that just because varargs.h*/
/* is used does not mean that it is used properly. */
/* Ignore the "expression with little effect" warnings. (Seems to be a */
/* compiler bug.) */
#define va_alist _va_arg1, _va_arg2, _va_arg3
#define va_dcl unsigned _va_arg1, _va_arg2, _va_arg3;
typedef struct {
unsigned _va_at; /* number of arguments used, 0, 1, or more */
/* (double as first arg counts as 2) */
union {
struct {
unsigned _va_uns1, _va_uns2;
} _va_uuns;
double _va_udouble;
} _va_union;
char *_va_pointer;
} va_list;
#define va_start(pvar) ( (pvar)._va_at = 0, \
(pvar)._va_union._va_uuns._va_uns1 = _va_arg1,\
(pvar)._va_union._va_uuns._va_uns2 = _va_arg2,\
(pvar)._va_pointer = (char *) &_va_arg3 \
)
#define va_arg(pvar, type) ( \
((pvar)._va_at++) ? ( \
((pvar)._va_at == 2) ? ( \
(sizeof(type) == 8) ? ( \
*(((type *)((pvar)._va_pointer))++) \
) : (type)( \
(pvar)._va_union._va_uuns._va_uns2 \
) \
) : ( \
*(((type *)((pvar)._va_pointer))++) \
) \
) : ( \
(sizeof(type) == 8) ? (type)( \
(pvar)._va_at++, \
(pvar)._va_union._va_udouble \
) : (type)( \
(pvar)._va_union._va_uuns._va_uns1 \
) \
) \
)
#define va_end(pvar) /* va_end is simple */
SHAR_EOF
cat << \SHAR_EOF > sys/vms/aaareadme.1st
This directory ([.SYS.VMS]) contains the VMS-specific files for MG.
+-----------------------+
| Construction |
+-----------------------+
By this point you should have put the ``system-independent'' files
into a directory of your choice, then put the VMS files into the
subdirectory [.SYS.VMS]. You should also put the termcap terminal
driver into the subdirectory [.SYS.DEFAULT], and the termcap library
files into [.SYS.TERMLIB]. These come with the standard MG distribution,
so you shouldn't have much trouble.
The command file MAKE.COM is designed to compile and link the entire
program, using the VMS system functions and the termcap terminal
driver.
To invoke MAKE.COM, enter
SET DEF dev:[emacs-dir] ! location of system-independent files
@[.SYS.VMS]MAKE ! go have some coffee...
This will create the termcap library, compile each of the necessary
modules, and link the entire program into dev:[emacs-dir]MG.EXE.
NOTE: To keep the size of the executable program down, MAKE.COM
attempts to link in the VAX C shareable run-time library. Since VMS
4.4 and up have the VAX C run-time library bundled into it, there
shouldn't be any problem finding it. If there is, modify MG.OPT to
link with SYS$LIBRARY:VAXCRTL.OBJ/LIB instead.
+-------------------------------------------------------+
| Specifying Your Terminal With Termcap |
+-------------------------------------------------------+
(CAVEAT AND CREDITS: The termcap subroutine library in
[.SYS.TERMLIB] was written by Fred Fish (of Amiga Public Domain
Library fame) and placed in the public domain. It is not guaranteed to
be a complete implementation of the Unix termcap(5) library; the usual
disclaimers (like "it works for me":-) apply here. I have modified it
to support the tc= capability, which lets you define terminals in
terms (pardon the pun) of other terminals, so it should work
reasonably well with the termcap provided in [.SYS.TERMLIB]TERMCAP.)
To use the termcap library, you need to tell it where to find a
terminal definition (termcap) file. If you have GNU Emacs installed,
MG will use its termcap file from EMACS_LIBRARY:[ETC]TERMCAP.DAT.
Otherwise, it will try to find the file which on Unix systems is
called /etc/termcap. To emulate the same behavior on VMS, DEFINE/JOB
the logical name ETC to point to a directory that contains a termcap
file, with the name TERMCAP. (no extension). (The /JOB qualifier is
needed when you run MG as a spawned supprocess.)
DEFINE/JOB ETC dev:[dir]
If your system has Eunice, there is a large termcap file already
available via this exact mechanism, so you shouldn't need to define
ETC at all. If you don't have Eunice, never fear; a termcap resides
in the file [.SYS.TERMLIB]TERMCAP., so all you have to do is
DEFINE ETC [emacs-directory.SYS.TERMLIB]
to get started. You get the idea. Lastly, if your site uses the
logical name ETC for another purpose, you can define the logical name
TERMCAP to point to the MG termcap file. You must specify the path in
Unix format, with the root being the disk drive the file resides on.
For example, if the termcap file is in DUA0:[USER]TERMCAP., the
command would be
DEFINE TERMCAP "/dua0/user/termcap"
The VAX C run-time library can translate this into the appropriate VMS
file specification for you (a rather nice feature...).
Once you've indicated where the termcap file is, you can tell MG what
kind of terminal you're using by defining the logical name EMACS_TERM.
DEFINE/JOB EMACS_TERM "termtype"
where "termtype" is in lower case and matches an entry in the termcap
file. (Alternatively, you can define the logical name TERM and MG will
look there if EMACS_TERM is not defined. Again, GNU Emacs uses EMACS_TERM
and Eunice uses TERM.)
NOTE: One performance aspect of termcap files is that they are
searched sequentially, so you may want to move the most frequently
used terminals at your site to the beginning of the file to minimize
startup overhead.
+---------------------------------------+
+ TERMINAL INITIALIZATION FILE |
+---------------------------------------+
The termcap terminal driver allows you to initialize MG differently,
depending on what kind of terminal you're using. See
[.SYS.DEFAULT]README for more information.
+---------------------------------------+
| INVOKING MG |
+---------------------------------------+
First of all, remember to set up the logical names for the terminal
type and termcap file. This can be done just once, in your LOGIN.COM file.
Then, to just run MG in your current process,
$ RUN [emacs-directory]MG
Or you can define a symbol to run it with command line arguments:
$ MG :== $dev:[emacs-directory]MG
$ MG [file]
+---------------------------------------+
| MG As a Kept Fork |
+---------------------------------------+
You can use [.SYS.VMS]MG.COM to spawn a MicroEmacs subjob, which you
can then attach to and pop out of as you please. Edit the line at the
top of MG.COM that defines the path to the image MG.EXE, then define a
global symbol called MG:
$ MG :== @dev:[emacs-directory.SYS.VMS]MG
You can then use MG to edit files:
$ MG [file]
When inside MG, use the command M-x suspend-emacs (bound to C-z by
default) to suspend the MG process and attach your terminal to the
process that spawned it. To re-attach to MG, just issue the MG command
again:
$ MG [file]
The command file will reattach you to your MG process, where you can
continue editing where you left off. If you specify a new file to
edit, the command file sets a logical name which MG then looks at when
you reattach.
+-------------------------------+
| MG As a Mail Editor |
+-------------------------------+
As an added bonus, the file MGMAILEDIT.COM makes MG your mail editor
when you use the SEND/EDIT command. Issue the command
DEFINE/JOB MAIL$EDIT dev:[dir]MGMAILEDIT.COM
to inform the mail system you want to use MGMAILEDIT.COM, then whenever
you issue SEND/EDIT inside mail, MG will be used as your mail editor.
SHAR_EOF
cat << \SHAR_EOF > sys/vms/ccom.com
$ Verify = F$Verify(0)
$!
$! CCOM.COM
$!
$! Run the C compiler on P1, but only if the .c file
$! is newer than the corresponding .obj file.
$!
$! Usage:
$! @CCOM [file [qualifiers]]
$!
$ If P1 .Eqs. "" Then -
Inquire P1 "C Source File"
$ Name = P1 - ".C"
$ Source = Name + ".C"
$ Object = f$parse(P1,,,"NAME") + ".OBJ"
$!
$! See if both files exist. If both exist, only compile the
$! source if the revision date is greater than or equal to
$! that of the object file.
$!
$ If F$Search(Source) .Eqs. "" Then -
Goto NoSource
$ If F$Search(Object) .Eqs. "" Then -
$ Goto Compile
$ SDate = F$File_Attributes(Source, "RDT")
$ ODate = F$File_Attributes(Object, "RDT")
$ If SDate .Lts. ODate Then -
Goto Bye
$!
$! Compile the program
$!
$Compile:
$ On Error Then Goto Fail
$ Write Sys$Output "Compiling " + Source
$ CC 'P2' 'Source
$ If F$Search(Object) .Eqs. "" Then -
Goto Fail
$!
$! Done.
$!
$Bye:
$ If Verify Then Set Verify
$ Exit
$!
$NoSource:
$ Write Sys$Output "%CCOM-F-NOTFOUND, file not found"
$ Goto Bye
$!
$Fail:
$ Write Sys$Output "%CCOM-F-FAIL, compile failed"
$ Goto Bye
SHAR_EOF
cat << \SHAR_EOF > sys/vms/fileio.c
/*
* Name: MicroGNUEmacs
* Version: 2a
* VAX/VMS file I/O.
* Created: 05-Feb-86 decvax!decwrl!dec-rhea!dec-rex!conroy
* Last edit: 1-Mar-88 sandra@cs.utah.edu
*
* Read and write ASCII files on VAX/VMS. All of the low level file
* I/O knowledge is here. This uses RMS system calls directly because
* the VAX C i/o functions are so slow.
*/
#include "def.h"
#include <rms.h>
#define DEFAULT_READ_BUFFER_SIZE 1024
struct FAB fab;
struct RAB rab;
struct XABFHC xab;
char *inbuf;
int instart, inend;
/*
* Open a file for reading. Also malloc's an input buffer that is big enough
* to hold the longest line in the file.
*/
ffropen(fn)
char *fn;
{
int maxlen;
fab = cc$rms_fab;
rab = cc$rms_rab;
xab = cc$rms_xabfhc;
fab.fab$l_fna = fn;
fab.fab$b_fns = strlen(fn);
fab.fab$l_xab = &xab;
rab.rab$l_fab = &fab;
rab.rab$w_isi = 0;
if (SYS$OPEN (&fab, 0, 0) == RMS$_NORMAL) {
SYS$CONNECT (&rab, 0, 0);
if (xab.xab$w_lrl == 0)
maxlen = DEFAULT_READ_BUFFER_SIZE;
else
maxlen = xab.xab$w_lrl;
inbuf = malloc(maxlen);
instart = 0;
inend = 0;
rab.rab$l_ubf = inbuf;
rab.rab$w_usz = maxlen;
return (FIOSUC);
}
else
return (FIOFNF);
}
/*
* Open a file for writing.
* Return TRUE if all is well, and
* FALSE on error (cannot create).
*/
ffwopen(fn)
char *fn;
{
int status;
fab = cc$rms_fab;
rab = cc$rms_rab;
fab.fab$l_fna = fn;
fab.fab$b_fns = strlen(fn);
fab.fab$b_rat = FAB$M_CR;
fab.fab$b_rfm = FAB$C_VAR;
rab.rab$l_fab = &fab;
rab.rab$w_isi = 0;
status = SYS$CREATE (&fab, 0, 0);
switch (status) {
case RMS$_NORMAL:
case RMS$_FILEPURGED:
SYS$CONNECT (&rab, 0, 0);
inbuf = NULL;
return (FIOSUC);
default:
ewprintf("Cannot open file for writing STS=%d, STV=%d",
fab.fab$l_sts, fab.fab$l_stv);
return (FIOERR);
}
}
/*
* Close a file.
*/
ffclose()
{
if (inbuf)
free(inbuf);
if (SYS$CLOSE(&fab, 0, 0) == RMS$_NORMAL)
return (FIOSUC);
else
return (FIOERR);
}
/*
* Write a buffer to the already opened file. bp points to the
* buffer. Return the status.
* This doesn't write out the last line of the buffer unless it is
* non-empty, to prevent VMS from putting an extra newline at the
* end of the file.
*/
ffputbuf(bp)
BUFFER *bp;
{
register LINE *lp;
register LINE *lpend;
int status;
lpend = bp->b_linep;
lp = lforw(lpend);
while (! ((lp == lpend) || ((lforw(lp) == lpend) && (llength(lp) == 0)))) {
rab.rab$l_rbf = <ext(lp)[0];
rab.rab$w_rsz = llength(lp);
if ((status = SYS$PUT (&rab, 0, 0)) != RMS$_NORMAL) {
ewprintf("Write I/O error, VMS status code %d", status);
return(FIOERR);
}
lp = lforw(lp);
}
return FIOSUC;
}
/*
* Read a line from a file, and store the bytes in the
* supplied buffer. Stop on end of file or end of line.
* Returns an extra newline on FIOEOF.
*
*/
ffgetline(buf, nbuf, nbytes)
register char *buf;
register int nbuf;
register int *nbytes;
{ register int status;
register int i;
/* Load the input buffer if it's empty. */
if (instart >= inend) {
status = SYS$GET (&rab, 0, 0);
if (status == RMS$_EOF) {
*nbytes = 0;
return FIOEOF;
}
else if (status != RMS$_NORMAL) {
ewprintf("File read error, VMS status code %d", status);
return FIOERR;
}
else {
instart = 0;
inend = rab.rab$w_rsz;
}
}
/* Copy contents of the input buffer */
*nbytes = inend - instart;
if (*nbytes > nbuf) *nbytes = nbuf;
for (i=0; i<*nbytes; i++)
buf[i] = inbuf[instart++];
if (instart < inend)
return FIOLONG;
else
return FIOSUC;
}
#ifndef NO_BACKUP
/*
* VMS has version numbers, so there is no need for
* MicroEMACS to bother making its own flavour of
* backup copy. Return TRUE so the caller doesn't quit.
*/
fbackupfile(fname)
char *fname;
{
return (TRUE);
}
#endif
/*
* The string "fn" is a file name. Canonicalize it by making RMS
* do the dirty work, then lowercase it.
*/
char *adjustname(fn)
char *fn;
{
register char *cp;
#ifndef NO_DIR
char *fullname, *fparse(), *strrchr();
static char name[NFILEN];
if (fullname = fparse(fn, NULL, NULL, NULL)) {
strncpy(name, fullname, NFILEN);
fn = name;
free(fullname); /* fparse malloc()'s the name */
}
#endif
for (cp = fn; *cp ; cp++)
if (ISUPPER(*cp))
*cp = *cp - 'A' + 'a';
return fn;
}
/*
* Fn1 and Fn2 are two file names. Return 0 if they represent the
* same file.
* Both arguments have already gone through adjustname(), so just do
* strcmp() here.
*/
fncmp(fn1,fn2)
char *fn1,*fn2;
{
return strcmp(fn1,fn2);
}
#ifndef NO_STARTUP
#include <file.h>
/*
* Find the user's startup file, and return its name.
*/
char *
startupfile(suffix)
char *suffix;
{
static char file[NFILEN];
(VOID) strcpy(file, "SYS$LOGIN:.MG");
if (suffix) {
strcat(file,"-");
strcat(file,suffix);
}
if (access(file, O_RDONLY ) == 0) return file;
return NULL;
}
#endif
#ifndef NO_DIR
#include <descrip.h>
#include <ssdef.h>
/*
* Get current working directory. Path had best be rather big
* (at least 400 characters long...)
*/
$DESCRIPTOR(sys_disk,"SYS$DISK");
char *getwd(path)
char path[];
{
struct dsc$descriptor devdsc, dirdsc;
char tempdev[512], tempdir[512];
int status, templen;
short devlen, dirlen;
/* translate the logical name SYS$DISK */
devdsc.dsc$a_pointer = tempdev;
devdsc.dsc$w_length = sizeof(tempdev) - 1;
devdsc.dsc$b_dtype = DSC$K_DTYPE_T;
devdsc.dsc$b_class = DSC$K_CLASS_S;
status = LIB$SYS_TRNLOG(&sys_disk, &devlen, &devdsc);
if (status!=SS$_NORMAL && status!=SS$_NOTRAN)
panic("getwd: can't translate SYS$DISK");
/* Append the current default directory using SYS$SETDDIR() */
dirdsc.dsc$b_dtype = DSC$K_DTYPE_T;
dirdsc.dsc$b_class = DSC$K_CLASS_S;
dirdsc.dsc$a_pointer = tempdir;
dirdsc.dsc$w_length = sizeof(tempdir) - 1;
status = SYS$SETDDIR(0L, &dirlen, &dirdsc);
if (status != RMS$_NORMAL)
panic("getwd: can't get current directory!");
bcopy(tempdev,path,devlen);
bcopy(tempdir,path+devlen,dirlen);
path[devlen + dirlen] = '\0';
return path;
}
#endif
SHAR_EOF
cat << \SHAR_EOF > sys/vms/fparse.c
/*
*From ut-ngp!ut-sally!im4u!rutgers!nike!ucbcad!ucbvax!YALE.ARPA!LEICHTER-JERRY
* Thu Nov 6 08:29:57 CST 1986
*
*
* I am writing a user interface program for radio telescopes and
* am trying to locate a piece of code to parse VMS file names. I
* would prefer C but we also have Fortran and Pascal compilers. I'm
* trying to avoid having figuring out the call to SYS$PARSE and would
* rather not have to open the file at this point in the program.
* Try the following (I didn't write it but I do use it).
* -- Jerry
*/
/*)LIBRARY
*/
/*
fparse.c - fparse routine to emulate f$parse in DCL command files
Synposis:
char *fparse( file_name, default_name, related_name, field)
char *file_name, default_name, related_name, field;
Description:
All strings are null-terminated. Only the first one or two characters
are checked in field names. Parameters can be omitted by passing NULL.
Fields are:
"node" node name
"device" device name
"directory" directory name
"name" file name
"type" file type
"version" file version number
If the field parameter is null, all fields are expanded, except that
the node name is included only if it appears in the file_name,
default_name or related_name. Note that field parameters
must be given in lower-case.
Within each field, the expanded name is taken from the file_name,
default_name and related_name, in that order.
The value returned is the address of the null-terminated file name;
fparse calls malloc to reserve space for the string.
The string "" is returned on either an RMS parse error, or
an erroroneous field parameter name. The RMS status error
is not available. Only one field may be given.
Example:
To parse a command line LINK/EXE=exefile objfile, the default extension
for "objfile" is .OBJ. The default file name for "exefile" is the file
name of "objfile", and the default extension is .EXE.
Say that the char * variable "objfile" points to the object file
name from the command line, and the char * "exefile" points to the
exe file from the command line. Then to expand these into file
names for calls to open() or fopen():
objfile = fparse( objfile, ".OBJ", NULL, NULL);
exefile = fparse( exefile, ".EXE", objfile, NULL);
To find only the directory of the object file:
dir = fparse( objfile, ".OBJ", NULL, "directory");
The field name could also be abbreviated:
dir = fparse( objfile, ".OBJ", NULL, "di");
*/
#include <stdio.h>
#include <rms.h>
#include <ssdef.h>
char *fparse( file_name, default_name, related_name, field)
char *file_name, *default_name, *related_name, *field;
{
struct FAB ff_file_fab;
struct NAM fn_file_nam, rn_related_nam, *nam;
char *expanded_name, *eptr;
int expanded_length, rms_status;
char expand_buffer[ NAM$C_MAXRSS];
/* initialize all the blocks for RMS */
ff_file_fab = cc$rms_fab;
ff_file_fab.fab$l_nam = &fn_file_nam;
ff_file_fab.fab$l_fna = file_name;
ff_file_fab.fab$b_fns = (file_name == NULL) ? 0 : strlen( file_name);
ff_file_fab.fab$l_dna = default_name;
ff_file_fab.fab$b_dns = (default_name == NULL) ? 0 : strlen( default_name);
fn_file_nam = cc$rms_nam;
nam = &fn_file_nam;
nam->nam$l_esa = expand_buffer;
nam->nam$b_ess = NAM$C_MAXRSS;
nam->nam$l_rlf = &rn_related_nam;
rn_related_nam = cc$rms_nam;
rn_related_nam.nam$l_rsa = related_name;
rn_related_nam.nam$b_rsl =
(related_name == NULL) ? 0 : strlen( related_name);
/* call SYS$PARSE to parse the file name */
rms_status = sys$parse( &ff_file_fab);
if (rms_status != RMS$_NORMAL)
{ /* error in parse, so return empty string */
expanded_name = malloc(1);
expanded_name[0] = '\0';
return( expanded_name);
}
/* construct the expanded file name */
if (field == NULL || field[0] == '\0')
{ /* caller wants all fields */
expanded_length = nam->nam$b_esl;
eptr = expand_buffer;
}
else
{ /* caller wants just one field */
switch (field[0])
{
case 'n': /* node or name */
if (field[1] == 'o')
{ /* node */
expanded_length = nam->nam$b_node;
eptr = nam->nam$l_node;
}
else
{ /* name */
expanded_length = nam->nam$b_name;
eptr = nam->nam$l_name;
}
break;
case 'd': /* device or directory */
if (field[1] == 'e')
{ /* device */
expanded_length = nam->nam$b_dev;
eptr = nam->nam$l_dev;
}
else
{ /* directory */
expanded_length = nam->nam$b_dir;
eptr = nam->nam$l_dir;
}
break;
case 't': /* type */
expanded_length = nam->nam$b_type;
eptr = nam->nam$l_type;
break;
case 'v': /* version */
expanded_length = nam->nam$b_ver;
eptr = nam->nam$l_ver;
break;
default:
expanded_length = 0;
break;
}
}
expanded_name = malloc( expanded_length + 1);
strncpy( expanded_name, eptr, expanded_length);
expanded_name[ expanded_length] = '\0';
return( expanded_name);
}
SHAR_EOF
cat << \SHAR_EOF > sys/vms/make.com
$ on error then goto trouble
$ on severe_error then goto trouble
$!
$! Command procedure to build MG on VMS systems. To use it, issue the
$! command
$! @[SYS.VMS]MAKE
$!
$! while in the top-level MG directory.
$!
$!* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
$!
$! Define a search path for include files.
$!
$ define c$include [],[.sys.vms],[.sys.default]
$!
$! Define alias for the compilation command. Use a command file that
$! checks revision dates and only compiles when it has to.
$!
$ ccom := @[.sys.vms]ccom
$!
$! Select compilation options:
$!
$! PREFIXREGION -- use a silly hack that I (mpk) like
$! XKEYS -- look for a terminal-specific startup file
$! NO_BACKUP -- do not include code for making backup files
$! NO_DIRED -- DIRED hasn't been implemented yet
$! REGEX -- Include the regular expression code
$!
$! See MGPROG.DOC in the main directory for more info.
$!
$ ccomflags = "/DEFINE=(""PREFIXREGION"",""DO_METAKEY"",""XKEYS""" + -
",""NO_BACKUP"",""NO_DIRED"",""REGEX"")"
$!
$! If REGEX is #defined, link in these two object modules.
$!
$ if f$locate("REGEX",ccomflags) .ne. f$length(ccomflags) then -
regexobj = "[]re_search.obj,[]regex.obj,"
$!
$! Compile the system-independent files
$!
$ ccom basic.c 'ccomflags
$ ccom dir.c 'ccomflags
$ ccom dired.c 'ccomflags
$ ccom file.c 'ccomflags
$ ccom line.c 'ccomflags
$ ccom match.c 'ccomflags
$ ccom paragraph.c 'ccomflags
$ ccom random.c 'ccomflags
$ ccom region.c 'ccomflags
$ ccom search.c 'ccomflags
$ ccom version.c 'ccomflags
$ ccom window.c 'ccomflags
$ ccom word.c 'ccomflags
$ ccom buffer.c 'ccomflags
$ ccom display.c 'ccomflags
$ ccom echo.c 'ccomflags
$ ccom extend.c 'ccomflags
$ ccom help.c 'ccomflags
$ ccom kbd.c 'ccomflags
$ ccom keymap.c 'ccomflags
$ ccom macro.c 'ccomflags
$ ccom main.c 'ccomflags
$ ccom modes.c 'ccomflags
$ ccom regex.c 'ccomflags
$ ccom re_search.c 'ccomflags
$!
$! Use the termcap terminal driver and default ASCII character set info
$!
$ ccom [.sys.default]cinfo.c 'ccomflags
$ ccom [.sys.default]tty.c 'ccomflags
$ ccom [.sys.default]ttykbd.c 'ccomflags
$!
$! Make the termcap library
$!
$ ccom [.termlib]fgetlr
$ ccom [.termlib]tgetent
$ ccom [.termlib]tgetflag
$ ccom [.termlib]tgetnum
$ ccom [.termlib]tgetstr
$ ccom [.termlib]tgoto
$ ccom [.termlib]tputs
$!
$ library/create/object termcap.olb fgetlr.obj,tgetent.obj,-
tgetflag.obj,tgetnum.obj,tgetstr.obj,tgoto.obj,tputs.obj
$ purge/keep=2 termcap.olb
$!
$! VMS-specific files
$!
$ ccom [.sys.vms]fileio.c 'ccomflags
$ ccom [.sys.vms]spawn.c 'ccomflags
$ ccom [.sys.vms]ttyio.c 'ccomflags
$ ccom [.sys.vms]trnlnm.c 'ccomflags
$ ccom [.sys.vms]fparse.c 'ccomflags
$!
$! VAX Macro sources
$!
$ macro [.sys.vms]unixfns.mar
$!
$! Link it all together
$!
$ link /exe=mg [.sys.vms]mg.opt/opt, 'regexobj' []termcap.olb/lib
$ exit
$!
$! Trouble!
$!
$trouble:
$ write sys$output "%MAKEIT-F-TROUBLE, trouble building MG"
$ exit
SHAR_EOF
cat << \SHAR_EOF > sys/vms/mg.com
$ Verify = 'F$Verify(0)
$!
$! MG.COM
$!
$! Usage:
$! @MG [file1 [file2 [...]]] ! To start up MG
$! @MG [file] ! To reattach to MG after ^Z
$!
$! MG.COM implements a "kept-fork" capability for MG, allowing you to pop
$! in and out of the editor without reloading it all the time. If a
$! process called user_MG (where user is your username) exists, this
$! command file attempts to attach to it. If not, it silently spawns a
$! subjob to run Emacs for you.
$!
$! To `keep' MG around once you get into it, use "suspend-emacs" (bound
$! to C-z by default) to suspend MG and attach back to the process
$! pointed to by MG$AttachTo.
$!
$! To get back into MG from DCL enter @MG again. You may optionally
$! specify *one* new file name, in which case MG will attempt to
$! visit that file when you re-attach.
$!
$!----------------------------------------------------------------
$!
$! Set things up. Change the definition of MG_Name to whatever you like.
$! You'll *have* to redefine MG_PROG, of course...
$!
$ MG_Name = F$Edit(F$Getjpi("","USERNAME"),"TRIM") + "_MG"
$ MG_Prog = "Disk$Staff:[Ccep001.Proj.Mg3]MG.Exe"
$ MG_Base = MG_Name ! Used for additions
$ If F$Length(MG_Base) .GT. 13 Then - ! Truncate base for _1,_2...
$ MG_Base = F$Extract(0,13,MG_Base)
$ Proc = F$GetJpi("","PRCNAM")
$ Master_Pid = F$Getjpi("","MASTER_PID")
$!
$! Define logical names used for communicating with MG
$!
$ Define/Nolog/Job MG$AttachTo "''Proc'"
$ Define/Nolog/Job MG$File " " ! No file by default
$ If P1 .Nes. "" Then -
Define/Nolog/Job MG$File "''P1'"
$!
$! Attempt to find MG subprocess in current tree. If found, attach
$! to it, else spawn a new MG process
$!
$ Save_Priv = F$SetPrv("NOWORLD,NOGROUP") ! Only look in job tree
$ Try_Count = 1
$Search:
$ Context = "" ! Set up process search context
$ProcLoop:
$ Pid = F$Pid(Context) ! Get next PID
$ If Pid .Eqs. "" Then -
Goto Spawn ! No MG_Name found; spawn a process
$ If F$GetJpi(Pid,"PRCNAM") .Nes. MG_Name Then -
Goto Procloop ! Try next process
$! Process name matches; see if it's in our job
$ If F$GetJpi(Pid,"MASTER_PID") .Eqs. Master_Pid Then -
Goto Attach ! Found process in our job!
$! Process name matches, but isn't in our job. Re-start search
$ MG_Name = MG_Base + "_" + F$String(Try_Count)
$ Try_Count = Try_Count + 1
$ Goto Search
$!
$! Here to attach to a process in our tree. Set message to
$! turn off the "Attaching to..." message
$!
$Attach:
$ Message = F$Environment("MESSAGE")
$ Set Proc/Priv=('Save_Priv') ! Restore privileges
$ Set Message/NoFacility/NoIdentification/NoSeverity/NoText
$ Attach "''MG_Name'"
$ Set Message/Facility/Identification/Severity/Text
$ Goto Done
$!
$! Here if can't attach. Spawn a new MG process
$!
$Spawn:
$ Set Process/Priv=('Save_Priv') ! Restore privileges
$ MG$MG :== $'MG_Prog' ! Avoid recursion
$ Spawn/NoLog/Proc="''MG_Name'" MG$MG 'P1' 'P2' 'P3' 'P4' 'P5' 'P6' 'P7' 'P8'
$ Delete/Symbol/Global MG$MG ! Get rid of it
$Done:
$!
$! Here once we reconnect from MG, whether we detached or exited.
$!
$ Deassign/Job MG$File
$ Deassign/Job MG$AttachTo
$ If Verify Then -
Set Verify
SHAR_EOF
cat << \SHAR_EOF > sys/vms/mg.opt
!
! Options file for MG 2a
!
basic.obj, dir.obj, dired.obj, file.obj, line.obj, match.obj, -
paragraph.obj, random.obj, region.obj, search.obj, version.obj, -
window.obj, word.obj, buffer.obj, display.obj, echo.obj, extend.obj, -
help.obj, kbd.obj, keymap.obj, macro.obj, main.obj, -
modes.obj, cinfo.obj, fileio.obj, spawn.obj, ttyio.obj, tty.obj, -
ttykbd.obj, unixfns.obj, fparse.obj, trnlnm.obj, -
SYS$SHARE:VAXCRTL.EXE/SHARE
SHAR_EOF
cat << \SHAR_EOF > sys/vms/spawn.c
/*
* Name: MicroEMACS
* VAX/VMS spawn and attach to a DCL subprocess.
* Created: rex::conroy
* decvax!decwrl!dec-rhea!dec-rex!conroy
* Modified:
* 19-May-86 ...!ihnp4!seismo!ut-sally!ut-ngp!mic
* Add att-to-parent command to attach to the parent
* process. If we can't attach to parent somehow,
* spawn a DCL subjob. This gives us the same
* suspend capability as Unix Emacses.
*
* As an added hook, you can DEFINE/JOB
* MG$ATTACHTO to a process name, and
* the code will try to attach to that name.
*
* Also, if the logical name MG$FILE is
* defined, attachtoparent() will visit that file
* when you re-attach to Emacs. This is useful
* for a lot of applications, especially MAIL/EDIT...
* 26-Jun-86 ...!ihnp4!seismo!ut-sally!ut-ngp!mic
* Specify process we're attaching to when we attempt
* to attach to it.
* 03-Sep-86 ...!ihnp4!seismo!ut-sally!ut-ngp!mic
* Call savebuffers() before leaving the editor.
* Unlike csh, DCL has no problem with people
* logging out without completing subjobs...
* #define NOSAVEONZ if you don't want this behavior.
* 13-Oct-86 ...!ihnp4!seismo!ut-sally!ut-ngp!mic
* Change MICROEMACS$... to MG$... for consistency.
* 20-Feb-87 ...!ihnp4!seismo!ut-sally!ut-ngp!mic
* Get rid of call to eputs(), so it can be private
* to echo.c.
*/
#include "def.h"
#include <ssdef.h>
#include <stsdef.h>
#include <descrip.h>
#include <iodef.h>
#include <jpidef.h>
#define EFN 0 /* Event flag. */
extern int oldmode[3]; /* In "ttyio.c". */
extern int newmode[3];
extern short iochan;
extern int ckttysize(); /* Checks for new term size */
extern int savebuffers(); /* Save all buffers before */
/*
* Create a subjob with a copy
* of the command intrepreter in it. When the
* command interpreter exits, mark the screen as
* garbage so that you do a full repaint. Bound
* to "C-C" and called from "C-Z". The message at
* the start in VMS puts out a newline. Under
* some (unknown) condition, you don't get one
* free when DCL starts up.
*/
spawncli(f, n)
{
register int s;
register char *msg;
if (savebuffers() == ABORT) /* TRUE means all saved,*/
return (ABORT); /* FALSE means not. */
eerase(); /* Get rid of echo line */
ttcolor(CTEXT); /* Normal color. */
ttnowindow(); /* Full screen scroll. */
ttmove(nrow-1, 0); /* Last line. */
msg = "Starting DCL";
while (*msg) /* Avoid using eputs() */
ttputc(*(msg++));
ttputc('\r');
ttputc('\n');
ttflush();
sgarbf = TRUE;
s = sys(NULL); /* NULL => DCL. */
return (s);
}
/*
* Run a command. The "cmd" is a pointer
* to a command string, or NULL if you want to run
* a copy of DCL in the subjob (this is how the standard
* routine LIB$SPAWN works. You have to do wierd stuff
* with the terminal on the way in and the way out,
* because DCL does not want the channel to be
* in raw mode.
*/
sys(cmd)
register char *cmd;
{
struct dsc$descriptor cdsc;
struct dsc$descriptor *cdscp;
long status;
long substatus;
long iosb[2];
status = SYS$QIOW(EFN, iochan, IO$_SETMODE, iosb, 0, 0,
oldmode, sizeof(oldmode), 0, 0, 0, 0);
if (status!=SS$_NORMAL || (iosb[0]&0xFFFF)!=SS$_NORMAL)
return (FALSE);
cdscp = NULL; /* Assume DCL. */
if (cmd != NULL) { /* Build descriptor. */
cdsc.dsc$a_pointer = cmd;
cdsc.dsc$w_length = strlen(cmd);
cdsc.dsc$b_dtype = DSC$K_DTYPE_T;
cdsc.dsc$b_class = DSC$K_CLASS_S;
cdscp = &cdsc;
}
status = LIB$SPAWN(cdscp, 0, 0, 0, 0, 0, &substatus, 0, 0, 0);
if (status != SS$_NORMAL)
substatus = status;
ckttysize(); /* check for new terminal size */
status = SYS$QIOW(EFN, iochan, IO$_SETMODE, iosb, 0, 0,
newmode, sizeof(newmode), 0, 0, 0, 0);
if (status!=SS$_NORMAL || (iosb[0]&0xFFFF)!=SS$_NORMAL)
return (FALSE);
if ((substatus&STS$M_SUCCESS) == 0) /* Command failed. */
return (FALSE);
return (TRUE);
}
/*
* Front end for combined attach-to-parent and spawn-cli action
*/
attachtoparent(f, n)
{
register int s;
s = attparent();
if (s == ABORT)
return (ABORT);
else if (s == FALSE)
return spawncli(f, n); /* better than nothing */
else
return (TRUE);
}
/*
* Attach to parent. If the logical name MG$ATTACHTO
* is present, attempt to attach to it. If not, attempt to
* attach to parent process.
*
* On return, see if the logical name MG$FILE contains
* anything, and try to visit that file.
*/
static $DESCRIPTOR(nmdsc,"MG$ATTACHTO");
attparent()
{
long pid, jpi_code;
char equiv[18], msgbuf[60];
struct dsc$descriptor_s eqdsc;
short eqlen;
int status, pos;
register BUFFER *bp;
BUFFER *findbuffer();
int s;
/* Set up string descriptor */
eqdsc.dsc$a_pointer = equiv;
eqdsc.dsc$w_length = sizeof(equiv);
eqdsc.dsc$b_dtype = DSC$K_DTYPE_T;
eqdsc.dsc$b_class = DSC$K_CLASS_S;
/* Try to translate MG$ATTACH */
status = lib$sys_trnlog(&nmdsc, &eqdsc.dsc$w_length, &eqdsc);
if (status!=SS$_NORMAL && status!=SS$_NOTRAN) {
ewprintf("Error translating %s",nmdsc.dsc$a_pointer);/* DEBUG */
return (FALSE);
}
if (status == SS$_NORMAL) {
/* Found a translation -- attempt to attach to it */
jpi_code = JPI$_PID;
status = lib$getjpi(&jpi_code,0,&eqdsc,&pid,0);
equiv[eqdsc.dsc$w_length] = '\0';
if (status != SS$_NORMAL) {
ewprintf("Error getting JPI for \"%s\"",equiv);
return (FALSE);
}
/* Attempt to attach to named process. Save all buffers, */
/* set sgarbf because attach() always trashes the display */
if (savebuffers() == ABORT)
return (ABORT);
/* indicate process we're attaching to */
strcpy(msgbuf,"Attaching to process \"");
for (pos = strlen(equiv) - 1; pos >= 0; --pos)
if (equiv[pos] != ' ') {
equiv[pos+1] = '\0';
break;
}
strcat(msgbuf,equiv);
strcat(msgbuf,"\"");
sgarbf = TRUE;
if (attach(pid,msgbuf) == FALSE) /* whups -- try spawn */
return (FALSE);
}
else { /* No translation -- attempt to find parent process */
jpi_code = JPI$_OWNER;
status = lib$getjpi(&jpi_code,0,0,&pid,0,0);
if ((status != SS$_NORMAL) || (pid == 0)) /* not found! */
return (FALSE);
if (savebuffers() == ABORT)
return (ABORT);
sgarbf = TRUE;
if (attach(pid,"Attaching to parent process") == FALSE)
return (FALSE);
}
newfile(); /* attempt to find a new file, but don't care */
/* if we don't find one... */
refresh(FFRAND, 0);
return (TRUE);
}
/*
* If we find after re-attaching that there is
* a new file to be edited, attempt to read it in,
* using essentially the same code as findfile().
*/
static newfile()
{
register BUFFER *bp;
register int s;
char filename[NFILEN];
BUFFER *findbuffer();
if ((s = cknewfile(filename, sizeof filename)) != TRUE)
return (s);
if ((bp = findbuffer(filename, &s)) == NULL)
return (s);
curbp = bp;
if (showbuffer(bp, curwp, WFHARD) != TRUE)
return (FALSE);
if (bp->b_fname[0] == 0)
return (readin(filename)); /* Read it in. */
return (TRUE);
}
/*
* Attach to a process by process number. Restore the
* terminal channel to the way it was when we started.
* Also put out an optional message to the user.
*/
static attach(pid, msg)
long pid;
char *msg;
{
long status, attstatus;
long iosb[2];
ttcolor(CTEXT); /* Normal color. */
ttnowindow(); /* Full screen scroll. */
ttmove(nrow-1, 0); /* Last line. */
if (msg) { /* Display a message */
while (*msg)
ttputc(*(msg++));
ttputc('\r');
ttputc('\n');
}
ttflush();
/* Set terminal to old modes */
status = SYS$QIOW(EFN, iochan, IO$_SETMODE, iosb, 0, 0,
oldmode, sizeof(oldmode), 0, 0, 0, 0);
if (status!=SS$_NORMAL || (iosb[0]&0xFFFF)!=SS$_NORMAL)
return (FALSE);
/* Attach to the process */
attstatus = LIB$ATTACH(&pid);
/* Return terminal to the modes MG needs */
ckttysize(); /* check for new terminal size first */
status = SYS$QIOW(EFN, iochan, IO$_SETMODE, iosb, 0, 0,
newmode, sizeof(newmode), 0, 0, 0, 0);
if (status!=SS$_NORMAL || (iosb[0]&0xFFFF)!=SS$_NORMAL)
return (FALSE);
return (attstatus == SS$_NORMAL ? TRUE : FALSE);
}
/*
* Attempt to translate MG$FILE into fname.
* If it's there and non-empty, return TRUE.
*/
static $DESCRIPTOR(filedsc,"MG$FILE");
static cknewfile(fname,fnsiz)
char *fname;
int fnsiz;
{
char equiv[NFILEN];
struct dsc$descriptor_s eqdsc;
short len;
register int status;
eqdsc.dsc$a_pointer = equiv;
eqdsc.dsc$w_length = sizeof(equiv);
eqdsc.dsc$b_dtype = DSC$K_DTYPE_T;
eqdsc.dsc$b_class = DSC$K_CLASS_S;
status = lib$sys_trnlog(&filedsc, &len, &eqdsc);
if (status!=SS$_NORMAL && status!=SS$_NOTRAN) {
ewprintf("Error translating MG$FILE");
return (FALSE);
}
if (status == SS$_NOTRAN) /* No new file found */
return (FALSE);
if (equiv[0] == ' ')
return (FALSE);
equiv[len] = '\0';
strcpy(fname, equiv);
return (TRUE);
}
SHAR_EOF
cat << \SHAR_EOF > sys/vms/sysdef.h
/*
* Name: MicroEMACS
* VAX/VMS system header file.
* Version: 29
* Last edit: 05-Feb-86
* By: rex::conroy
* decvax!decwrl!dec-rhea!dec-rex!conroy
*/
#include <stdio.h>
#include <ssdef.h>
#define overwrite ovwrite /* avoid conflict with curses */
#define PCC 0 /* "[]" works. */
#define KBLOCK 8192 /* Kill grow. */
#define GOOD (SS$_NORMAL) /* Good exit status. */
#define MAXPATH 1024 /* Goodly-sized path name */
typedef int RSIZE; /* Type for file/region sizes */
typedef unsigned char KCHAR; /* Type for keyboard character */
/* (all must be positive) */
/*
* Macros used by the buffer name making code.
* Start at the end of the file name, scan to the left
* until BDC1 (or BDC2, if defined) is reached. The buffer
* name starts just to the right of that location, and
* stops at end of string (or at the next BDC3 character,
* if defined). BDC2 and BDC3 are mainly for VMS.
*/
#define BDC1 ':' /* Buffer names. */
#define BDC2 ']'
#define BDC3 ';'
#define DPROMPT /* use delayed prompts */
#define GOSMACS /* for Gosling's compatibility fns */
SHAR_EOF
cat << \SHAR_EOF > sys/vms/trnlnm.c
/*
* Name: MicroEmacs
* VAX/VMS translate logical name routine
* Version: Gnu30
* Last Edit: 10-Jul-86
* By: ...!ihnp4!seismo!ut-sally!ut-ngp!mic
*
*/
/*
*
* Trnlnm()
*
* Description:
* Attempt to translate the logical name logname into an equivalence
* string, using the standard VMS routine LIB$SYS_TRNLOG().
* If a translation exists, return a pointer to the static area
* that contains the null-terminated translation string. If not,
* return 0.
*
* Bugs:
* Returns a pointer to static data that is modified each time
* the routine successfully translates a logical name.
*/
#include <ssdef.h>
#include <descrip.h>
#include <stdio.h>
static char _equiv_buf[256];
static struct dsc$descriptor_s
_equiv = {
sizeof(_equiv_buf), DSC$K_DTYPE_T, DSC$K_CLASS_S, _equiv_buf
},
_name = {
0, DSC$K_DTYPE_T, DSC$K_CLASS_S, NULL
};
char *trnlnm(logname)
char *logname;
{
short eqlen;
int status;
if (logname == NULL)
return (NULL);
_name.dsc$a_pointer = logname;
_name.dsc$w_length = strlen(logname);
status = lib$sys_trnlog(&_name, &eqlen, &_equiv);
if (status != SS$_NORMAL)
return (NULL);
_equiv_buf[eqlen] = '\0';
return (_equiv_buf);
}
/* gettermtype -- get the terminal type used for MG.
*
* If there is a logical name translation for EMACS_TERM, return that.
* Otherwise translate the logical name TERM.
* (Both GNU Emacs and Unipress Emacs use EMACS_TERM, but Eunice likes TERM.)
*
*/
char *gettermtype()
{ register char *result;
if (result = trnlnm("EMACS_TERM"))
return(result);
else
return(trnlnm("TERM"));
}
SHAR_EOF
cat << \SHAR_EOF > sys/vms/unixfns.mar
.title unixfns MG access to Unix library functions
;
; bcopy by Mic Kaczmarczik, July 11, 1986
; everything else by Peter Newton April 24, 1987
;
; UNIX stack-based memory allocation
;
.entry alloca,^m<>
movl 4(ap),r0 ; number of bytes
movl 16(fp),r1 ; return address
moval alloca_reenter,16(fp) ; return to reenter code
ret
alloca_reenter:
addl #3,r0 ; round up byte count to
bicl #3,r0 ; longword boundary
subl r0,sp ; allocate stack space
moval (sp),r0 ; address of allocated block
jmp (r1) ; return to caller
;
; UNIX bcmp function
;
.entry bcmp,^m<r2,r3>
cmpc3 12(ap),@4(ap),@8(ap)
ret
;
; UNIX bcopy function
;
.entry bcopy,^m<r2,r3,r4,r5> ; MOVC3 side-effects r0-r5
subl2 #4,sp ; Step over call frame
movc3 12(ap),@4(ap),@8(ap) ; Copy them bytes
ret ; Bye!
;
; UNIX bzero function
;
.entry bzero,^m<r2,r3,r4,r5>
movc5 #0,(r0),#0,8(ap),@4(ap)
ret
.end
SHAR_EOF
# End of shell archive
exit 0
-------