lispval
Ndumplisp()
{
register struct exec *workp;
register lispval argptr, temp;
register char *fname;
extern int reborn;
struct exec work, old;
extern int dmpmode,usehole;
extern char etext[], *curhbeg;
int descrip, des2, ax,mode;
extern int holesize;
char tbuf[BUFSIZ];
long count, lseek();
pageseql();
pagsiz = Igtpgsz();
pagrnd = pagsiz - 1;
/* dump mode is kept in decimal (which looks like octal in dmpmode)
and is changeable via (sstatus dumpmode n) where n is 413 or 410
base 10
*/
if(dmpmode == 413) mode = 0413;
else if(dmpmode == 407) mode = 0407;
else mode = 0410;
workp = &work;
workp->a_magic = mode;
#ifdef os_masscomp
workp->a_stamp = 1;
#endif
if(holesize) { /* was ifdef HOLE */
curhbeg = (char *) (1 + (pagrnd | ((int)curhbeg)-1));
workp->a_text = (unsigned long)curhbeg - (unsigned long)OFFSET;
workp->a_data = (unsigned) sbrk(0) - workp->a_text - OFFSET;
} else {
if(mode==0407)
workp->a_text = ((int)etext) - OFFSET;
else
workp->a_text = 1 + ((((int)etext)-1-OFFSET) | pagrnd);
workp->a_data = (int) sbrk(0) - ((int)curhbeg);
}
workp->a_bss = 0;
workp->a_syms = 0;
workp->a_entry = (unsigned) gstart();
workp->a_trsize = 0;
workp->a_drsize = 0;
fname = "savedlisp"; /*set defaults*/
reborn = (int) CNIL;
argptr = lbot->val;
if (argptr != nil) {
temp = argptr->d.car;
if((TYPE(temp))==ATOM)
fname = temp->a.pname;
}
des2 = open(gstab(),0);
if(des2 >= 0) {
if(read(des2,(char *)&old,sizeof(old))>=0)
work.a_syms = old.a_syms;
}
descrip=creat(fname,0777); /*doit!*/
if(-1==write(descrip,(char *)workp,sizeof(work)))
{
close(descrip);
error("Dumplisp header failed",FALSE);
}
if(mode == 0413) lseek(descrip,(long)pagsiz,0);
if( -1==write(descrip,(char *)nil,(int)workp->a_text) )
{
close(descrip);
error("Dumplisp text failed",FALSE);
}
if( -1==write(descrip,(char *)curhbeg,(int)workp->a_data) )
{
close(descrip);
error("Dumplisp data failed",FALSE);
}
if(des2>0 && work.a_syms) {
count = old.a_text + old.a_data + (old.a_magic == 0413 ? pagsiz
: sizeof(old));
if(-1==lseek(des2,count,0))
error("Could not seek to stab",FALSE);
for(count = old.a_syms;count > 0; count -=BUFSIZ) {
ax = read(des2,tbuf,(int)(count < BUFSIZ ? count : BUFSIZ));
if(ax==0) {
printf("Unexpected end of syms",count);
fflush(stdout);
break;
} else if(ax > 0)
write(descrip,tbuf,ax);
else
error("Failure to write dumplisp stab",FALSE);
}
#if ! (os_unix_ts | os_unisoft)
if(-1 == lseek(des2,(long)
((old.a_magic == 0413 ? pagsiz : sizeof(old))
+ old.a_text + old.a_data
+ old.a_trsize + old.a_drsize + old.a_syms),
0))
error(" Could not seek to string table ",FALSE);
for( ax = 1 ; ax > 0;) {
ax = read(des2,tbuf,BUFSIZ);
if(ax > 0)
write(descrip,tbuf,ax);
else if (ax < 0)
error("Error in string table read ",FALSE);
}
#endif
}
close(descrip);
if(des2>0) close(des2);
reborn = 0;
pagenorm();
return(nil);
}
void CPrint::OnPaint()
{
if(m_bRepaintPreview){
CWnd* item = GetDlgItem(IDC_PREVIEW_FRAME);
CRect prerect;
item->GetWindowRect(prerect);
ScreenToClient(prerect);
int obase = m_Calculator->m_base;
m_Calculator->m_base = 10;
UpdateData();
CDC print_dc;
print_dc.Attach(m_PrintDlg.GetPrinterDC()); // Attach a printer DC
CPaintDC dc(this); // device context for painting
CPoint ul(prerect.left + 10, prerect.top + 19);
CRect print_rect(0,0, print_dc.GetDeviceCaps(HORZRES), print_dc.GetDeviceCaps(VERTRES));
CRect window_rect(0,0,prerect.Width() - 20, prerect.Height() - 25);
double scale_factor;
TRACE("print_rect.Width=%d print_rect.Height=%d\n", print_rect.Width(), print_rect.Height());
if((double(print_rect.Width())/double(print_rect.Height())) >
(double(window_rect.Width())/double(window_rect.Height())))
scale_factor = double(window_rect.Width()) / double(print_rect.Width());
else
scale_factor = double(window_rect.Height()) / double(print_rect.Height());
CPoint start;
start.x = ul.x + (double(window_rect.Width() - (print_rect.Width() * scale_factor)) / 2.0);
start.y = ul.y + (double(window_rect.Height() - (print_rect.Height() * scale_factor)) / 2.0);
//////////// DRAW PAPER
CBrush brush(RGB(255,255,255)), *pOldBrush;
pOldBrush = dc.SelectObject(&brush);
CPen penBlack;
penBlack.CreatePen(PS_SOLID, 0, RGB(0,0,0));
CPen* pOldPen = dc.SelectObject(&penBlack);
dc.Rectangle(start.x - 3, start.y - 3,
start.x + (print_rect.Width() * scale_factor) + 3,
start.y + (print_rect.Height() * scale_factor) + 3);
dc.SelectObject(pOldPen);
//////////// END DRAW PAPER
//////////// Calculate width and height
long double w, h;
if(m_iPageSize == 1){
double scale;
if((double(print_rect.Width()) / double(m_graph_width)) >
(double(print_rect.Height()) / double(m_graph_height)))
scale = (double(print_rect.Height()) / 2.0) / double(m_graph_height);
else
scale = (double(print_rect.Width()) / 2.0) / double(m_graph_width);
h = (double(m_graph_height)/double(print_dc.GetDeviceCaps(LOGPIXELSY))) * scale;
w = (double(m_graph_width)/double(print_dc.GetDeviceCaps(LOGPIXELSX))) * scale;
}
else if(m_iPageSize == 0){
w = double(print_rect.Width()) / double(print_dc.GetDeviceCaps(LOGPIXELSX));
h = double(print_rect.Height()) / double(print_dc.GetDeviceCaps(LOGPIXELSY));
}
else{
m_Calculator->StringToDecimal(m_sWidth, 10, w);
m_Calculator->StringToDecimal(m_sHeight, 10, h);
w = m_Calculator->abs(w);
h = m_Calculator->abs(h);
// convert width
if(m_sWUnits == "cm")
w *= 0.39370078740157;
// convert height
if(m_sHUnits == "cm")
h *= 0.39370078740157;
}
// I now have desired width and height in inches
CPoint gstart(start.x, start.y);
double max_h((double(print_rect.Height()) / double(print_dc.GetDeviceCaps(LOGPIXELSY))));
double max_w((double(print_rect.Width()) / double(print_dc.GetDeviceCaps(LOGPIXELSX))));
// resize max height based on printing options
if(m_bTitleOn){
max_h -= (0.25 + 0.125);
gstart.y += ((0.25 + 0.125) * print_dc.GetDeviceCaps(LOGPIXELSY) * scale_factor);
}
if(m_bEquations)
max_h -= (1.5 + 0.125);
// error check for desired size too large too large
if(w > (max_w + 0.0001)){
w = max_w;
m_Calculator->DecimalToString(m_sWidth, w);
if(m_iPageSize == 2)
SetDimensionsW(w);
}
if(h > (max_h + 0.0001)){
h = max_h;
m_Calculator->DecimalToString(m_sHeight, h);
if(m_iPageSize == 2)
SetDimensionsH(h);
}
// now convert inches into device units (ie device pixels)
w *= print_dc.GetDeviceCaps(LOGPIXELSX) * scale_factor; // scale w for window
h *= print_dc.GetDeviceCaps(LOGPIXELSY) * scale_factor; // scale h for window
//////////// END Calculate width and height
//////////// Draw Graph Rectangle
CBrush gray(RGB(128,128,128));
dc.SelectObject(&gray);
if(m_bCenter){
gstart.x += ((print_rect.Width() * scale_factor) / 2.0) - (w / 2.0);
double th(h);
if(m_bTitleOn)
th += ((0.25 + 0.125) * print_dc.GetDeviceCaps(LOGPIXELSY) * scale_factor);
if(m_bEquations)
th += ((1.5 + 0.125) * print_dc.GetDeviceCaps(LOGPIXELSY) * scale_factor);
gstart.y += (double(print_rect.Height() * scale_factor) / 2.0) - (double(th) / 2.0);
}
dc.Rectangle(gstart.x,
gstart.y,
gstart.x + w,
gstart.y + h);
//////////// END Draw Graph Rectangle
if(m_bEquations){
//////////// Draw Equations List
CPoint estart(gstart.x, gstart.y + h +(0.125 * print_dc.GetDeviceCaps(LOGPIXELSY) * scale_factor));
CPoint eend(gstart.x + w, gstart.y + h + (1.625 * print_dc.GetDeviceCaps(LOGPIXELSY) * scale_factor));
int ew(w);
if(ew < (5 * print_dc.GetDeviceCaps(LOGPIXELSX) * scale_factor)) // check for min eqs list size
ew = (5 * print_dc.GetDeviceCaps(LOGPIXELSX) * scale_factor);
if(ew > (max_w * print_dc.GetDeviceCaps(LOGPIXELSX) * scale_factor))
ew = max_w;
if((eend.y - estart.y) > (max_h * print_dc.GetDeviceCaps(LOGPIXELSY) * scale_factor))
eend.y = estart.y + max_h;
estart.x = (gstart.x + (double(w) / 2.0)) - (double(ew) / 2.0);
if(estart.x < start.x)
estart.x = start.x;
eend.x = estart.x + ew;
dc.SelectObject(&brush);
dc.Rectangle(estart.x, estart.y, eend.x, eend.y);
//////////// END Draw Equations List
}
if(m_bTitleOn){
//////////// Draw Title Rectangle
dc.SelectObject(&brush);
dc.Rectangle(start.x,
start.y,
start.x + (print_rect.Width() * scale_factor),
start.y + (0.25 * print_dc.GetDeviceCaps(LOGPIXELSY) * scale_factor));
//////////// END Draw Title Rectangle
}
dc.SelectObject(pOldBrush);
print_dc.Detach();
UpdateData(true);
m_Calculator->m_base = obase;
}
}
lispval
Ndumplisp()
{
register struct exec *workp;
register lispval argptr, temp;
char *fname;
register ISD *Isd;
register int i;
extern lispval reborn;
struct exec work,old;
extern etext;
extern int dmpmode,holend,curhbeg,usehole,holesize;
int extra_cref_page = 0;
char *start_of_data;
int descrip, des2, count, ax,mode;
char buf[5000],stabname[100],tbuf[BUFSIZ];
int fp,fp1;
union {
char Buffer[512];
struct {
IHD Ihd;
IHA Iha;
IHS Ihs;
IHI Ihi;
} Header;
} Buffer; /* VMS Header */
/*
* Dumpmode is always 413!!
*/
mode = 0413;
pagsiz = Igtpgsz();
pagrnd = pagsiz - 1;
workp = &work;
workp->a_magic = mode;
if (holesize) {
workp->a_text =
((unsigned)curhbeg) & (~pagrnd);
if (((unsigned)curhbeg) & pagrnd) extra_cref_page = 1;
start_of_data = (char *)
(((((unsigned) (&holend)) -1) & (~pagrnd)) + pagsiz);
} else {
workp->a_text =
((((unsigned) (&etext)) -1) & (~pagrnd)) + pagsiz;
start_of_data = (char *)workp->a_text;
}
workp->a_data =
(unsigned) sbrk(0) - (unsigned)start_of_data;
workp->a_bss = 0;
workp->a_syms = 0;
workp->a_entry = (unsigned) gstart();
workp->a_trsize = 0;
workp->a_drsize = 0;
fname = "savedlisp"; /* set defaults */
reborn = CNIL;
argptr = lbot->val;
if (argptr != nil) {
temp = argptr->d.car;
if((TYPE(temp))==ATOM)
fname = temp->a.pname;
}
/*
* Open the new executable file
*/
strcpy(buf,fname);
if (index(buf,'.') == 0) strcat(buf,".exe");
if ((descrip = creat(buf,0777)) < 0) error("Dumplisp failed",FALSE);
/*
* Create the VMS header
*/
for(i = 0; i < 512; i++) Buffer.Buffer[i] = 0; /* Clear Header */
Buffer.Header.Ihd.size = sizeof(Buffer.Header);
Buffer.Header.Ihd.activoff = sizeof(IHD);
Buffer.Header.Ihd.symdbgoff = sizeof(IHD) + sizeof(IHA);
Buffer.Header.Ihd.imgidoff = sizeof(IHD) + sizeof(IHA) + sizeof(IHS);
Buffer.Header.Ihd.majorid[0] = '0';
Buffer.Header.Ihd.majorid[1] = '2';
Buffer.Header.Ihd.minorid[0] = '0';
Buffer.Header.Ihd.minorid[1] = '2';
Buffer.Header.Ihd.imgtype = IHD_EXECUTABLE;
Buffer.Header.Ihd.privreqs[0] = -1;
Buffer.Header.Ihd.privreqs[1] = -1;
Buffer.Header.Ihd.lnkflags.nopobufs = 1;
Buffer.Header.Ihd.imgiocnt = 250;
Buffer.Header.Iha.tfradr1 = SYS$IMGSTA;
Buffer.Header.Iha.tfradr2 = workp->a_entry;
strcpy(Buffer.Header.Ihi.imgnam+1,"SAVEDLISP");
Buffer.Header.Ihi.imgnam[0] = 9;
Buffer.Header.Ihi.imgid[0] = 0;
Buffer.Header.Ihi.imgid[1] = '0';
sys$gettim(Buffer.Header.Ihi.linktime);
strcpy(Buffer.Header.Ihi.linkid+1," Opus 38");
Buffer.Header.Ihi.linkid[0] = 8;
Isd = (ISD *)&Buffer.Buffer[sizeof(Buffer.Header)];
/* Text ISD */
Isd->size = ISDSIZE_TEXT;
Isd->pagcnt = workp->a_text >> 9;
Isd->vpnpfc.vpn = 0;
Isd->flags.type = ISD_NORMAL;
Isd->vbn = 3;
Isd = (ISD *)((char *)Isd + Isd->size);
/* Hole ISDs (if necessary) */
if (usehole) {
/* Copy on Ref ISD for possible extra text page */
if(extra_cref_page) {
Isd->size = ISDSIZE_TEXT;
Isd->pagcnt = 1;
Isd->vpnpfc.vpn = (((unsigned)curhbeg) & (~pagrnd)) >> 9;
Isd->flags.type = ISD_NORMAL;
Isd->flags.crf = 1;
Isd->flags.wrt = 1;
Isd->vbn = (workp->a_text >> 9) + 3;
Isd = (ISD *)((char *)Isd + Isd->size);
}
/* Demand Zero ISD for rest of Hole */
Isd->size = ISDSIZE_DZRO;
Isd->pagcnt =
((((unsigned)&holend)
- (unsigned)curhbeg) & (~pagrnd)) >> 9;
Isd->vpnpfc.vpn =
((((unsigned)curhbeg) & (~pagrnd)) >> 9) + extra_cref_page;
Isd->flags.type = ISD_NORMAL;
Isd->flags.dzro = 1;
Isd->flags.wrt = 1;
Isd = (ISD *)((char *)Isd + Isd->size);
}
/* Data ISD */
Isd->size = ISDSIZE_TEXT;
Isd->pagcnt = workp->a_data >> 9;
Isd->vpnpfc.vpn = ((unsigned)start_of_data) >> 9;
Isd->flags.type = ISD_NORMAL;
Isd->flags.crf = 1;
Isd->flags.wrt = 1;
Isd->vbn = (workp->a_text >> 9) + 3;
if (holesize) {
/*
* Correct the Data ISD
*/
Isd->vbn += extra_cref_page;
}
Isd = (ISD *)((char *)Isd + Isd->size);
/* Stack ISD */
Isd->size = ISDSIZE_DZRO;
Isd->pagcnt = ISDSTACK_SIZE;
Isd->vpnpfc.vpn = ISDSTACK_BASE;
Isd->flags.type = ISD_USERSTACK;
Isd->flags.dzro = 1;
Isd->flags.wrt = 1;
Isd = (ISD *)((char *)Isd + Isd->size);
/* End of ISD List */
Isd->size = 0;
Isd = (ISD *)((char *)Isd + 2);
/*
* Make the rest of the header -1s
*/
for (i = ((char *)Isd - Buffer.Buffer); i < 512; i++)
Buffer.Buffer[i] = -1;
/*
* Write the VMS Header
*/
if (write(descrip,Buffer.Buffer,512) == -1)
error("Dumplisp failed",FALSE);
#if EUNICE_UNIX_OBJECT_FILE_CFASL
/*
* Get the UNIX symbol table file header
*/
des2 = open(gstab(),0);
if (des2 >= 0) {
old.a_magic = 0;
if (read(des2,(char *)&old,sizeof(old)) >= 0) {
if (N_BADMAG(old)) {
lseek(des2,512,0); /* Try block #1 */
read(des2,(char *)&old,sizeof(old));
}
if (!N_BADMAG(old)) work.a_syms = old.a_syms;
}
}
#endif EUNICE_UNIX_OBJECT_FILE_CFASL
/*
* Update the UNIX header so that the extra cref page is
* considered part of data space.
*/
if (extra_cref_page) work.a_data += 512;
/*
* Write the UNIX header
*/
if (write(descrip,&work,sizeof(work)) == -1)
error("Dumplisp failed",FALSE);
/*
* seek to 1024 (end of headers)
*/
if (lseek(descrip,1024,0) == -1)
error("Dumplisp failed",FALSE);
/*
* write the world
*/
if (write(descrip,0,workp->a_text) == -1)
error("Dumplisp failed",FALSE);
if (extra_cref_page)
if (write(descrip,(((unsigned)curhbeg) & pagrnd), pagsiz) == -1)
error("Dumplisp failed",FALSE);
if (write(descrip,start_of_data,workp->a_data) == -1)
error("Dumplisp failed",FALSE);
#if !EUNICE_UNIX_OBJECT_FILE_CFASL
/*
* VMS OBJECT files: We are done with the executable file
*/
close(descrip);
/*
* Now try to write the symbol table file!
*/
strcpy(buf,gstab());
strcpy(stabname,fname);
if (index(stabname,'.') == 0) strcat(stabname,".stb");
else strcpy(index(stabname,'.'), ".stb");
/* Use Link/Unlink to rename the symbol table */
if (!strncmp(gstab(),"tmp:",4))
if (link(buf,stabname) >= 0)
if (unlink(buf) >= 0) return(nil);
/* Copy the symbol table */
if ((fp = open(buf,0)) < 0)
error("Symbol table file not there\n",FALSE);
fp1 = creat(stabname,0666,"var");
while((i = read(fp,buf,5000)) > 0)
if (write(fp1,buf,i) == -1) {
close(fp); close(fp1);
error("Error writing symbol table\n",FALSE);
}
close(fp); close(fp1);
if (i < 0) error("Error reading symbol table\n",FALSE);
if (!strncmp(gstab(),"tmp:",4)) unlink(gstab);
/*
* Done
*/
reborn = 0;
return(nil);
#else EUNICE_UNIX_OBJECT_FILE_CFASL
/*
* UNIX OBJECT files: append the new symbol table
*/
if(des2>0 && work.a_syms) {
count = old.a_text + old.a_data + (old.a_magic == 0413 ? 1024
: sizeof(old));
if(-1==lseek(des2,count,0))
error("Could not seek to stab",FALSE);
for(count = old.a_syms;count > 0; count -=BUFSIZ) {
ax = read(des2,tbuf,(int)(count < BUFSIZ ? count : BUFSIZ));
if(ax==0) {
printf("Unexpected end of syms",count);
fflush(stdout);
break;
} else if(ax > 0)
write(descrip,tbuf,ax);
else
error("Failure to write dumplisp stab",FALSE);
}
if(-1 == lseek(des2,(long)
((old.a_magic == 0413 ? 1024 : sizeof(old))
+ old.a_text + old.a_data
+ old.a_trsize + old.a_drsize + old.a_syms),
0))
error(" Could not seek to string table ",FALSE);
for( ax = 1 ; ax > 0;) {
ax = read(des2,tbuf,BUFSIZ);
if(ax > 0)
write(descrip,tbuf,ax);
else if (ax < 0)
error("Error in string table read ",FALSE);
}
}
close(descrip);
if(des2>0) close(des2);
reborn = 0;
return(nil);
#endif EUNICE_UNIX_OBJECT_FILE_CFASL
}
