LispObj *
Lisp_PQgetlength(LispBuiltin *builtin)
/*
pq-getlength result tupple field-number
*/
{
PGresult *res;
int tuple, field, length;
LispObj *result, *otupple, *field_number;
field_number = ARGUMENT(2);
otupple = ARGUMENT(1);
result = ARGUMENT(0);
if (!CHECKO(result, PGresult_t))
LispDestroy("%s: cannot convert %s to PGresult*",
STRFUN(builtin), STROBJ(result));
res = (PGresult*)(result->data.opaque.data);
CHECK_INDEX(otupple);
tuple = FIXNUM_VALUE(otupple);
CHECK_INDEX(field_number);
field = FIXNUM_VALUE(field_number);
length = PQgetlength(res, tuple, field);
return (INTEGER(length));
}
void AxisPlot::LinkDataVerticalAxis(size_t nData, size_t nAxis)
{
CHECK_INDEX(wxT("data"), nData, m_datasets);
CHECK_INDEX(wxT("vertical axis"), nAxis, m_verticalAxes);
m_links.Add(new DataAxisLink(m_datasets[nData], m_verticalAxes[nAxis]));
m_verticalAxes[nAxis]->AddDataset(m_datasets[nData]);
//UpdateAxis(m_datasets[nData]);
m_verticalAxes[nAxis]->UpdateBounds();
// redundant
//FirePlotNeedRedraw();
}
/* XXX ignoring element-type */
LispObj *
Lisp_MakeString(LispBuiltin *builtin)
/*
make-string size &key initial-element element-type
*/
{
long length;
char *string, initial;
LispObj *size, *initial_element;
initial_element = ARGUMENT(1);
size = ARGUMENT(0);
CHECK_INDEX(size);
length = FIXNUM_VALUE(size);
if (initial_element != UNSPEC) {
CHECK_SCHAR(initial_element);
initial = SCHAR_VALUE(initial_element);
}
else
initial = 0;
string = LispMalloc(length + 1);
memset(string, initial, length);
string[length] = '\0';
return (LSTRING2(string, length));
}
LispObj *
Lisp_DigitCharP(LispBuiltin *builtin)
/*
digit-char-p character &optional radix
*/
{
long radix = 10, character;
LispObj *ochar, *oradix, *result = NIL;
oradix = ARGUMENT(1);
ochar = ARGUMENT(0);
CHECK_SCHAR(ochar);
character = SCHAR_VALUE(ochar);
if (oradix != UNSPEC) {
CHECK_INDEX(oradix);
radix = FIXNUM_VALUE(oradix);
}
if (radix < 2 || radix > 36)
LispDestroy("%s: radix must be >= 2 and <= 36, not %ld",
STRFUN(builtin), radix);
if (character >= '0' && character <= '9')
character -= '0';
else if (character >= 'A' && character <= 'Z')
character -= 'A' - 10;
else if (character >= 'a' && character <= 'z')
character -= 'a' - 10;
if (character < radix)
result = FIXNUM(character);
return (result);
}
LispObj *
Lisp_DigitChar(LispBuiltin *builtin)
/*
digit-char weight &optional radix
*/
{
long radix = 10, weight;
LispObj *oweight, *oradix, *result = NIL;
oradix = ARGUMENT(1);
oweight = ARGUMENT(0);
CHECK_FIXNUM(oweight);
weight = FIXNUM_VALUE(oweight);
if (oradix != UNSPEC) {
CHECK_INDEX(oradix);
radix = FIXNUM_VALUE(oradix);
}
if (radix < 2 || radix > 36)
LispDestroy("%s: radix must be >= 2 and <= 36, not %ld",
STRFUN(builtin), radix);
if (weight >= 0 && weight < radix) {
if (weight < 9)
weight += '0';
else
weight += 'A' - 10;
result = SCHAR(weight);
}
return (result);
}
LispObj *
Lisp_PQfsize(LispBuiltin *builtin)
/*
pq-fsize result field-number
*/
{
int size, field;
PGresult *res;
LispObj *result, *field_number;
field_number = ARGUMENT(1);
result = ARGUMENT(0);
if (!CHECKO(result, PGresult_t))
LispDestroy("%s: cannot convert %s to PGresult*",
STRFUN(builtin), STROBJ(result));
res = (PGresult*)(result->data.opaque.data);
CHECK_INDEX(field_number);
field = FIXNUM_VALUE(field_number);
size = PQfsize(res, field);
return (INTEGER(size));
}
LispObj *
Lisp_XawListHighlight(LispBuiltin *builtin)
/*
xaw-list-highlight widget index
*/
{
Widget widget;
int position;
LispObj *owidget, *oindex;
oindex = ARGUMENT(1);
owidget = ARGUMENT(0);
if (!CHECKO(owidget, xawWidget_t))
LispDestroy("%s: cannot convert %s to Widget",
STRFUN(builtin), STROBJ(owidget));
widget = (Widget)(owidget->data.opaque.data);
CHECK_INDEX(oindex);
position = FIXNUM_VALUE(oindex);
XawListHighlight(widget, position);
return (oindex);
}
uval
h_protect(struct cpu *pcop, uval flags, uval tlb_id)
{
union tlbe tlbe;
uval tlbx = tlb_id;
if (flags & H_EADDR) {
if (-1 == (tlbx = EADDR_TO_TLBX(tlb_id)))
return H_NOT_FOUND;
} else if (CHECK_INDEX(tlb_id)) {
return H_Parameter;
}
tlbre(tlbx, &tlbe.words.epnWord, &tlbe.words.rpnWord,
&tlbe.words.attribWord);
tlbe.bits.up = 0;
tlbe.bits.up |= !!(flags & H_UX) << 2;
tlbe.bits.up |= !!(flags & H_UW) << 1;
tlbe.bits.up |= !!(flags & H_UR);
tlbe.bits.sp = 0;
tlbe.bits.sp |= !!(flags & H_SX) << 2;
tlbe.bits.sp |= !!(flags & H_SW) << 1;
tlbe.bits.sp |= !!(flags & H_SR);
tlbwe(tlbx, tlbe.words.epnWord, tlbe.words.rpnWord,
tlbe.words.attribWord);
return H_Success;
}
LispObj *
Lisp_XawTextSearch(LispBuiltin *builtin)
/*
xaw-text-search widget direction text
*/
{
Widget widget;
XawTextScanDirection direction;
XawTextBlock block;
LispObj *owidget, *odirection, *otext;
otext = ARGUMENT(2);
odirection = ARGUMENT(1);
owidget = ARGUMENT(0);
if (!CHECKO(owidget, xawWidget_t))
LispDestroy("%s: cannot convert %s to Widget",
STRFUN(builtin), STROBJ(owidget));
widget = (Widget)(owidget->data.opaque.data);
CHECK_INDEX(odirection);
direction = (XawTextPosition)FIXNUM_VALUE(odirection);
if (direction != XawsdLeft && direction != XawsdRight)
LispDestroy("%s: %d does not fit in XawTextScanDirection",
STRFUN(builtin), direction);
CHECK_STRING(otext);
block.firstPos = 0;
block.ptr = THESTR(otext);
block.length = strlen(block.ptr);
block.format = FMT8BIT;
return (FIXNUM(XawTextSearch(widget, direction, &block)));
}
LispObj *
Lisp_Char(LispBuiltin *builtin)
/*
char string index
schar simple-string index
*/
{
unsigned char *string;
long offset, length;
LispObj *ostring, *oindex;
oindex = ARGUMENT(1);
ostring = ARGUMENT(0);
CHECK_STRING(ostring);
CHECK_INDEX(oindex);
offset = FIXNUM_VALUE(oindex);
string = (unsigned char*)THESTR(ostring);
length = STRLEN(ostring);
if (offset >= length)
LispDestroy("%s: index %ld too large for string length %ld",
STRFUN(builtin), offset, length);
return (SCHAR(string[offset]));
}
LispObj *
Lisp_XawTextSetInsertionPoint(LispBuiltin *builtin)
/*
xaw-text-set-insertion-point widget position
*/
{
Widget widget;
XawTextPosition position;
LispObj *owidget, *oposition;
oposition = ARGUMENT(1);
owidget = ARGUMENT(0);
if (!CHECKO(owidget, xawWidget_t))
LispDestroy("%s: cannot convert %s to Widget",
STRFUN(builtin), STROBJ(owidget));
widget = (Widget)(owidget->data.opaque.data);
CHECK_INDEX(oposition);
position = (XawTextPosition)FIXNUM_VALUE(oposition);
XawTextSetInsertionPoint(widget, position);
return (oposition);
}
void get_unistate(int sidx, int *val, int count)
{
CHECK_INDEX(sidx);
CHECK_COUNT(count, state[sidx].type);
memcpy(val, state[sidx].ival, count * sizeof *val);
}
LispObj *
Lisp_XBlackPixel(LispBuiltin *builtin)
/*
x-black-pixel display &optional screen
*/
{
Display *display;
int screen;
LispObj *odisplay, *oscreen;
oscreen = ARGUMENT(1);
odisplay = ARGUMENT(0);
if (!CHECKO(odisplay, x11Display_t))
LispDestroy("%s: cannot convert %s to Display*",
STRFUN(builtin), STROBJ(odisplay));
display = (Display*)(odisplay->data.opaque.data);
if (oscreen == UNSPEC)
screen = DefaultScreen(display);
else {
CHECK_INDEX(oscreen);
screen = FIXNUM_VALUE(oscreen);
}
if (screen >= ScreenCount(display))
LispDestroy("%s: screen index %d too large, %d screens available",
STRFUN(builtin), screen, ScreenCount(display));
return (INTEGER(BlackPixel(display, screen)));
}
uval
h_read(struct cpu *pcop, uval flags, uval tlb_id)
{
union tlbe localTlbe;
uval tlbx = tlb_id;
/* XXX flag H_READ_4 won't work for 3-word TLBEs... */
if (flags & H_EADDR) {
if (-1 == (tlbx = EADDR_TO_TLBX(tlb_id)))
return H_NOT_FOUND;
} else if (CHECK_INDEX(tlb_id)) {
return H_Parameter;
}
/* load up gpr4-6 with the old TLBE's words */
tlbre(tlbx, &pcop->reg_gprs[4], &pcop->reg_gprs[5],
&pcop->reg_gprs[6]);
/* set the OS's MMUCR from hardware */
pcop->reg_mmucr.stid = get_mmucr() & MMUCR_STID_MASK;
/* untranslate RPN */
localTlbe.words.rpnWord = pcop->reg_gprs[5];
localTlbe.bits.rpn = RPN_L2R(pcop, localTlbe.bits.rpn);
pcop->reg_gprs[5] = localTlbe.words.rpnWord;
return H_Success;
}
/* helper function for setf
* DONT explicitly call. Non standard function
*/
LispObj *
Lisp_XeditCharStore(LispBuiltin *builtin)
/*
xedit::char-store string index value
*/
{
int character;
long offset, length;
LispObj *ostring, *oindex, *ovalue;
ovalue = ARGUMENT(2);
oindex = ARGUMENT(1);
ostring = ARGUMENT(0);
CHECK_STRING(ostring);
CHECK_INDEX(oindex);
length = STRLEN(ostring);
offset = FIXNUM_VALUE(oindex);
if (offset >= length)
LispDestroy("%s: index %ld too large for string length %ld",
STRFUN(builtin), offset, length);
CHECK_SCHAR(ovalue);
CHECK_STRING_WRITABLE(ostring);
character = SCHAR_VALUE(ovalue);
if (character < 0 || character > 255)
LispDestroy("%s: cannot represent character %d",
STRFUN(builtin), character);
THESTR(ostring)[offset] = character;
return (ovalue);
}
LispObj *
Lisp_PQfname(LispBuiltin *builtin)
/*
pq-fname result field-number
*/
{
char *string;
int field;
PGresult *res;
LispObj *result, *field_number;
field_number = ARGUMENT(1);
result = ARGUMENT(0);
if (!CHECKO(result, PGresult_t))
LispDestroy("%s: cannot convert %s to PGresult*",
STRFUN(builtin), STROBJ(result));
res = (PGresult*)(result->data.opaque.data);
CHECK_INDEX(field_number);
field = FIXNUM_VALUE(field_number);
string = PQfname(res, field);
return (string ? STRING(string) : NIL);
}
void set_unistate(int sidx, const float *val, int count)
{
CHECK_INDEX(sidx);
CHECK_COUNT(count, state[sidx].type);
memcpy(state[sidx].fval, val, count * sizeof *state[sidx].fval);
state[sidx].transpose = 0;
}
LispObj *
Lisp_XawTextReplace(LispBuiltin *builtin)
/*
xaw-text-replace widget left right text
*/
{
Widget widget;
XawTextPosition left, right;
XawTextBlock block;
LispObj *owidget, *oleft, *oright, *otext;
otext = ARGUMENT(3);
oright = ARGUMENT(2);
oleft = ARGUMENT(1);
owidget = ARGUMENT(0);
if (!CHECKO(owidget, xawWidget_t))
LispDestroy("%s: cannot convert %s to Widget",
STRFUN(builtin), STROBJ(owidget));
widget = (Widget)(owidget->data.opaque.data);
CHECK_INDEX(oleft);
left = (XawTextPosition)FIXNUM_VALUE(oleft);
CHECK_INDEX(oright);
right = (XawTextPosition)FIXNUM_VALUE(oright);
CHECK_STRING(otext);
block.firstPos = 0;
block.ptr = THESTR(otext);
block.length = strlen(block.ptr);
block.format = FMT8BIT;
return (FIXNUM(XawTextReplace(widget, left, right, &block)));
}
uval
h_remove(struct cpu *pcop, uval flags, uval tlb_id)
{
uval tlbx = tlb_id;
/* XXX
* handle flags:
* H_AVPN
* H_ANDCOND
*/
/* remove all OS TLBEs */
if (flags & H_ALL) {
for (tlbx = MIN_OS_TLBX; tlbx < pcop->tlb_lowest_bolted;
++tlbx) {
if (pcop->utlb[tlbx].bits.v) {
tlbwe(tlbx, 0, 0, 0);
pcop->utlb[tlbx].words.epnWord = 0;
}
}
return H_Success;
}
/* otherwise remove only 1 */
if (flags & H_EADDR) {
if (-1 == (tlbx = EADDR_TO_TLBX(tlb_id)))
return H_NOT_FOUND;
} else if (CHECK_INDEX(tlb_id)) {
return H_Parameter;
}
/* load up gpr3-5 with the old TLBE's words */
tlbre(tlbx, &pcop->reg_gprs[4], &pcop->reg_gprs[5],
&pcop->reg_gprs[6]);
/* now invalidate that TLBE. ignore MMUCR:STID, since V=0 */
tlbwe(tlbx, 0, 0, 0);
pcop->utlb[tlbx].words.epnWord = 0;
return H_Success;
}
LispObj *
Lisp_PQftype(LispBuiltin *builtin)
{
Oid oid;
int field;
PGresult *res;
LispObj *result, *field_number;
field_number = ARGUMENT(1);
result = ARGUMENT(0);
if (!CHECKO(result, PGresult_t))
LispDestroy("%s: cannot convert %s to PGresult*",
STRFUN(builtin), STROBJ(result));
res = (PGresult*)(result->data.opaque.data);
CHECK_INDEX(field_number);
field = FIXNUM_VALUE(field_number);
oid = PQftype(res, field);
return (INTEGER(oid));
}
LispObj *
Lisp_XBlackPixel(LispBuiltin *builtin)
/*
x-black-pixel display &optional screen
*/
{
Display *display;
int screen;
LispObj *odisplay, *oscreen;
oscreen = ARGUMENT(1);
odisplay = ARGUMENT(0);
if (!CHECKO(odisplay, x11Display_t))
LispDestroy("%s: cannot convert %s to Display*",
STRFUN(builtin), STROBJ(odisplay));
display = (Display*)(odisplay->data.opaque.data);
if (oscreen == UNSPEC)
screen = DefaultScreen(display);
else
CHECK_INDEX(oscreen);
else
LispObj *
Lisp_Reexec(LispBuiltin *builtin)
/*
re-exec regex string &key count start end notbol noteol
*/
{
size_t nmatch;
re_mat match[10];
long start, end, length;
int code, cflags, eflags;
char *string;
LispObj *result;
re_cod *regexp;
LispObj *regex, *ostring, *count, *ostart, *oend, *notbol, *noteol;
noteol = ARGUMENT(6);
notbol = ARGUMENT(5);
oend = ARGUMENT(4);
ostart = ARGUMENT(3);
count = ARGUMENT(2);
ostring = ARGUMENT(1);
regex = ARGUMENT(0);
if (STRINGP(regex))
regexp = LispRecomp(builtin, THESTR(regex), cflags = 0);
else {
CHECK_REGEX(regex);
regexp = regex->data.regex.regex;
cflags = regex->data.regex.options;
}
CHECK_STRING(ostring);
if (count == UNSPEC)
nmatch = 1;
else {
CHECK_INDEX(count);
nmatch = FIXNUM_VALUE(count);
if (nmatch > 10)
LispDestroy("%s: COUNT cannot be larger than 10", STRFUN(builtin));
}
if (nmatch && (cflags & RE_NOSUB))
nmatch = 1;
eflags = RE_STARTEND;
if (notbol != UNSPEC && notbol != NIL)
eflags |= RE_NOTBOL;
if (noteol != UNSPEC && noteol != NIL)
eflags |= RE_NOTEOL;
string = THESTR(ostring);
LispCheckSequenceStartEnd(builtin, ostring, ostart, oend,
&start, &end, &length);
match[0].rm_so = start;
match[0].rm_eo = end;
code = reexec(regexp, string, nmatch, &match[0], eflags);
if (code == 0) {
if (nmatch && match[0].rm_eo >= match[0].rm_so) {
result = CONS(CONS(FIXNUM(match[0].rm_so),
FIXNUM(match[0].rm_eo)), NIL);
if (nmatch > 1 && match[1].rm_eo >= match[1].rm_so) {
int i;
GC_ENTER();
LispObj *cons = result;
GC_PROTECT(result);
for (i = 1;
i < nmatch && match[i].rm_eo >= match[i].rm_so;
i++) {
RPLACD(cons, CONS(CONS(FIXNUM(match[i].rm_so),
FIXNUM(match[i].rm_eo)), NIL));
cons = CDR(cons);
}
GC_LEAVE();
}
}
else
result = NIL;
}
else
result = Knomatch;
/* Maybe shoud cache compiled regex, but better the caller do it */
if (!XREGEXP(regex)) {
refree(regexp);
LispFree(regexp);
}
return (result);
}
LispObj *
Lisp_ParseInteger(LispBuiltin *builtin)
/*
parse-integer string &key start end radix junk-allowed
*/
{
GC_ENTER();
char *ptr, *string;
int character, junk, sign, overflow;
long i, start, end, radix, length, integer, check;
LispObj *result;
LispObj *ostring, *ostart, *oend, *oradix, *junk_allowed;
junk_allowed = ARGUMENT(4);
oradix = ARGUMENT(3);
oend = ARGUMENT(2);
ostart = ARGUMENT(1);
ostring = ARGUMENT(0);
start = end = radix = 0;
result = NIL;
CHECK_STRING(ostring);
LispCheckSequenceStartEnd(builtin, ostring, ostart, oend,
&start, &end, &length);
string = THESTR(ostring);
if (oradix == UNSPEC)
radix = 10;
else {
CHECK_INDEX(oradix);
radix = FIXNUM_VALUE(oradix);
}
if (radix < 2 || radix > 36)
LispDestroy("%s: :RADIX %ld must be in the range 2 to 36",
STRFUN(builtin), radix);
integer = check = 0;
ptr = string + start;
sign = overflow = 0;
/* Skip leading white spaces */
for (i = start; i < end && *ptr && isspace(*ptr); ptr++, i++)
;
/* Check for sign specification */
if (i < end && (*ptr == '-' || *ptr == '+')) {
sign = *ptr == '-';
++ptr;
++i;
}
for (junk = 0; i < end; i++, ptr++) {
character = *ptr;
if (islower(character))
character = toupper(character);
if (character >= '0' && character <= '9') {
if (character - '0' >= radix)
junk = 1;
else {
check = integer;
integer = integer * radix + character - '0';
}
}
else if (character >= 'A' && character <= 'Z') {
if (character - 'A' + 10 >= radix)
junk = 1;
else {
check = integer;
integer = integer * radix + character - 'A' + 10;
}
}
else {
if (isspace(character))
break;
junk = 1;
}
if (junk)
break;
if (!overflow && check > integer)
overflow = 1;
/* keep looping just to count read bytes */
}
if (!junk)
/* Skip white spaces */
for (; i < end && *ptr && isspace(*ptr); ptr++, i++)
;
if ((junk || ptr == string) &&
(junk_allowed == UNSPEC || junk_allowed == NIL))
LispDestroy("%s: %s has a bad integer representation",
STRFUN(builtin), STROBJ(ostring));
else if (ptr == string)
result = NIL;
else if (overflow) {
mpi *bigi = LispMalloc(sizeof(mpi));
char *str;
length = end - start + sign;
str = LispMalloc(length + 1);
strncpy(str, string - sign, length + sign);
str[length + sign] = '\0';
mpi_init(bigi);
mpi_setstr(bigi, str, radix);
LispFree(str);
result = BIGNUM(bigi);
}
else
result = INTEGER(sign ? -integer : integer);
GC_PROTECT(result);
RETURN(0) = FIXNUM(i);
RETURN_COUNT = 1;
GC_LEAVE();
return (result);
}
LispObj *
Lisp_XCreateSimpleWindow(LispBuiltin *builtin)
/*
x-create-simple-window display parent x y width height &optional border-width border background
*/
{
Display *display;
Window parent;
int x, y;
unsigned int width, height, border_width;
unsigned long border, background;
LispObj *odisplay, *oparent, *ox, *oy, *owidth, *oheight,
*oborder_width, *oborder, *obackground;
obackground = ARGUMENT(8);
oborder = ARGUMENT(7);
oborder_width = ARGUMENT(6);
oheight = ARGUMENT(5);
owidth = ARGUMENT(4);
oy = ARGUMENT(3);
ox = ARGUMENT(2);
oparent = ARGUMENT(1);
odisplay = ARGUMENT(0);
if (!CHECKO(odisplay, x11Display_t))
LispDestroy("%s: cannot convert %s to Display*",
STRFUN(builtin), STROBJ(odisplay));
display = (Display*)(odisplay->data.opaque.data);
if (!CHECKO(oparent, x11Window_t))
LispDestroy("%s: cannot convert %s to Window",
STRFUN(builtin), STROBJ(oparent));
parent = (Window)(oparent->data.opaque.data);
CHECK_FIXNUM(ox);
x = FIXNUM_VALUE(ox);
CHECK_FIXNUM(oy);
y = FIXNUM_VALUE(oy);
CHECK_INDEX(owidth);
width = FIXNUM_VALUE(owidth);
CHECK_INDEX(oheight);
height = FIXNUM_VALUE(oheight);
/* check &OPTIONAL parameters */
if (oborder_width == UNSPEC)
border_width = 1;
else {
CHECK_INDEX(oborder_width);
border_width = FIXNUM_VALUE(oborder_width);
}
if (oborder == UNSPEC)
border = BlackPixel(display, DefaultScreen(display));
else {
CHECK_LONGINT(oborder);
border = LONGINT_VALUE(oborder);
}
if (obackground == UNSPEC)
background = WhitePixel(display, DefaultScreen(display));
else {
CHECK_LONGINT(obackground);
background = LONGINT_VALUE(obackground);
}
return (OPAQUE(
XCreateSimpleWindow(display, parent, x, y, width, height,
border_width, border, background),
x11Window_t));
}
LispObj *
Lisp_XawListChange(LispBuiltin *builtin)
/*
xaw-list-change widget list &optional longest resize
*/
{
Widget widget;
String *list;
int i, nitems;
int longest;
Boolean resize;
LispObj *object;
WidgetData *data;
LispObj *owidget, *olist, *olongest, *oresize;
oresize = ARGUMENT(3);
olongest = ARGUMENT(2);
olist = ARGUMENT(1);
owidget = ARGUMENT(0);
if (!CHECKO(owidget, xawWidget_t))
LispDestroy("%s: cannot convert %s to Widget",
STRFUN(builtin), STROBJ(owidget));
widget = (Widget)(owidget->data.opaque.data);
CHECK_LIST(olist);
for (nitems = 0, object = olist; CONSP(object);
++nitems, object = CDR(object))
CHECK_STRING(CAR(object));
if (olongest != UNSPEC) {
CHECK_INDEX(olongest);
longest = FIXNUM_VALUE(olongest);
}
else
XtVaGetValues(widget, XtNlongest, &longest, NULL, 0);
resize = oresize != UNSPEC && oresize != NIL;
/* No errors in arguments, build string list */
list = (String*)XtMalloc(sizeof(String) * nitems);
for (i = 0, object = olist; CONSP(object); i++, object = CDR(object))
list[i] = THESTR(CAR(object));
/* Check if xaw-list-change was already called
* for this widget and free previous data */
for (i = 0; i < num_list_data; i++)
if ((Widget)CAR(list_data[i]->object)->data.opaque.data == widget) {
XtRemoveCallback(widget, XtNdestroyCallback,
LispXawCleanupCallback, list_data[i]);
LispXawCleanupCallback(widget, list_data[i], NULL);
break;
}
if (i >= num_list_data) {
++num_list_data;
list_data = (WidgetData**)XtRealloc((XtPointer)list_data,
sizeof(WidgetData*) * num_list_data);
}
data = (WidgetData*)XtMalloc(sizeof(WidgetData));
data->data = list;
list_data[i] = data;
data->object = CONS(owidget, olist);
PROTECT(owidget, data->object);
XtAddCallback(widget, XtNdestroyCallback, LispXawCleanupCallback, data);
XawListChange(widget, list, nitems, longest, resize);
return (olist);
}
uval
h_enter(struct cpu *pcop, uval flags, uval tlb_id,
uval epnWord, uval rpnWord, uval attribWord)
{
union tlbe localTlbe;
uval tlbx = tlb_id;
if (flags & H_BOLTED) {
tlbx = -1;
if (flags & H_EADDR) {
tlbx = EADDR_TO_TLBX(tlb_id);
if (tlbx != -1 && tlbx < pcop->tlb_lowest_bolted) {
/* We're adding a bolted TLBE, replacing a previous non-bolted
* one. Invalidate the old non-bolted entry.
*/
tlbwe(tlbx, 0, 0, 0);
tlbx = -1;
}
}
if (tlbx == -1) {
tlbx = --pcop->tlb_lowest_bolted;
assert(pcop->tlb_lowest_bolted > 4,
"too many bolted TLBEs!");
}
} else if (flags & H_EADDR) {
if (-1 == (tlbx = EADDR_TO_TLBX(tlb_id))) {
/* select new index with wraparound */
tlbx = pcop->tlb_last_used + 1;
if (tlbx >= pcop->tlb_lowest_bolted) {
tlbx = MIN_OS_TLBX;
}
pcop->tlb_last_used = tlbx;
}
} else if (CHECK_INDEX(tlb_id)) {
return H_Parameter;
}
localTlbe.words.epnWord = epnWord;
localTlbe.words.rpnWord = rpnWord;
localTlbe.words.attribWord = attribWord;
/* translate OS's Real to hypervisor's Logical */
localTlbe.bits.rpn = RPN_R2L(pcop, localTlbe.bits.rpn);
/* XXX
* validate RPN (including page size)
* validate attribute bits (IO vs memory)
* clear reserved bits
* handle flags:
* H_ZERO_PAGE
* H_ICACHE_INVALIDATE
* H_ICACHE_SYNCHRONIZE
* H_EXACT
* H_LARGE_PAGE
*/
/* Record the TID so we can get later context switches right. */
localTlbe.bits.tid = get_mmucr() & MMUCR_STID_MASK;
/* store TLBE in struct cpu's TLB mirror */
pcop->utlb[tlbx] = localTlbe;
/* enter TLBE into the UTLB */
tlbwe(tlbx, localTlbe.words.epnWord, localTlbe.words.rpnWord,
localTlbe.words.attribWord);
pcop->reg_gprs[4] = tlbx;
return H_Success;
}
LispObj *
Lisp_PQgetvalue(LispBuiltin *builtin)
/*
pq-getvalue result tuple field &optional type-specifier
*/
{
char *string;
double real = 0.0;
PGresult *res;
int tuple, field, isint = 0, isreal = 0, integer;
LispObj *result, *otupple, *field_number, *type;
type = ARGUMENT(3);
field_number = ARGUMENT(2);
otupple = ARGUMENT(1);
result = ARGUMENT(0);
if (!CHECKO(result, PGresult_t))
LispDestroy("%s: cannot convert %s to PGresult*",
STRFUN(builtin), STROBJ(result));
res = (PGresult*)(result->data.opaque.data);
CHECK_INDEX(otupple);
tuple = FIXNUM_VALUE(otupple);
CHECK_INDEX(field_number);
field = FIXNUM_VALUE(field_number);
string = PQgetvalue(res, tuple, field);
if (type != UNSPEC) {
char *typestring;
CHECK_SYMBOL(type);
typestring = ATOMID(type);
if (strcmp(typestring, "INT16") == 0) {
integer = *(short*)string;
isint = 1;
goto simple_type;
}
else if (strcmp(typestring, "INT32") == 0) {
integer = *(int*)string;
isint = 1;
goto simple_type;
}
else if (strcmp(typestring, "FLOAT") == 0) {
real = *(float*)string;
isreal = 1;
goto simple_type;
}
else if (strcmp(typestring, "REAL") == 0) {
real = *(double*)string;
isreal = 1;
goto simple_type;
}
else if (strcmp(typestring, "PG-POLYGON") == 0)
goto polygon_type;
else if (strcmp(typestring, "STRING") != 0)
LispDestroy("%s: unknown type %s",
STRFUN(builtin), typestring);
}
simple_type:
return (isint ? INTEGER(integer) : isreal ? DFLOAT(real) :
(string ? STRING(string) : NIL));
polygon_type:
{
LispObj *poly, *box, *p = NIL, *cdr, *obj;
POLYGON *polygon;
int i, size;
size = PQgetlength(res, tuple, field);
polygon = (POLYGON*)(string - sizeof(int));
GCDisable();
/* get polygon->boundbox */
cdr = EVAL(CONS(ATOM("MAKE-PG-POINT"),
CONS(KEYWORD("X"),
CONS(REAL(polygon->boundbox.high.x),
CONS(KEYWORD("Y"),
CONS(REAL(polygon->boundbox.high.y), NIL))))));
obj = EVAL(CONS(ATOM("MAKE-PG-POINT"),
CONS(KEYWORD("X"),
CONS(REAL(polygon->boundbox.low.x),
CONS(KEYWORD("Y"),
CONS(REAL(polygon->boundbox.low.y), NIL))))));
box = EVAL(CONS(ATOM("MAKE-PG-BOX"),
CONS(KEYWORD("HIGH"),
CONS(cdr,
CONS(KEYWORD("LOW"),
CONS(obj, NIL))))));
/* get polygon->p values */
for (i = 0; i < polygon->npts; i++) {
obj = EVAL(CONS(ATOM("MAKE-PG-POINT"),
CONS(KEYWORD("X"),
CONS(REAL(polygon->p[i].x),
CONS(KEYWORD("Y"),
CONS(REAL(polygon->p[i].y), NIL))))));
if (i == 0)
p = cdr = CONS(obj, NIL);
else {
RPLACD(cdr, CONS(obj, NIL));
cdr = CDR(cdr);
}
}
/* make result */
poly = EVAL(CONS(ATOM("MAKE-PG-POLYGON"),
CONS(KEYWORD("SIZE"),
CONS(REAL(size),
CONS(KEYWORD("NUM-POINTS"),
CONS(REAL(polygon->npts),
CONS(KEYWORD("BOUNDBOX"),
CONS(box,
CONS(KEYWORD("POINTS"),
CONS(QUOTE(p), NIL))))))))));
GCEnable();
return (poly);
}
}
int
main(int argc, char **argv)
{
int n;
if (argc > 1) {
if ((fp = fopen(argv[1], "r")) == NULL) {
fprintf(stderr, "%s", Usage);
bu_exit(1, "pixhist3d: can't open \"%s\"\n", argv[1]);
}
} else
fp = stdin;
if (isatty(fileno(fp))) {
bu_exit(2, "%s", Usage);
}
if ((fbp = fb_open(NULL, 512, 512)) == NULL) {
bu_exit(12, "fb_open failed\n");
}
#define CHECK_INDEX(idx) \
if (idx > MAX_INDEX) { \
bu_exit(3, "pixhist3d: read invalid index %u\n", (unsigned int)idx); \
}
while ((n = fread(&ibuf[0], sizeof(*ibuf), sizeof(ibuf), fp)) > 0) {
unsigned char *bp;
int i;
long r, g, b;
CHECK_INDEX(ibuf[RED]);
CHECK_INDEX(ibuf[GRN]);
CHECK_INDEX(ibuf[BLU]);
bp = &ibuf[0];
for (i = n/3; i > 0; i--, bp += 3) {
r = bp[RED];
g = bp[GRN];
b = bp[BLU];
/* sanitize no-op */
if (UNLIKELY(r < 0))
r = 0;
if (UNLIKELY(r > 255))
r = 255;
if (UNLIKELY(g < 0))
g = 0;
if (UNLIKELY(g > 255))
g = 255;
if (UNLIKELY(b < 0))
b = 0;
if (UNLIKELY(b > 255))
b = 255;
rxb[ r ][ b ]++;
rxg[ r ][ g ]++;
bxg[ b ][ g ]++;
}
}
disp_array(rxg, 0, 0);
disp_array(rxb, 256, 0);
disp_array(bxg, 0, 256);
fb_close(fbp);
return 0;
}