value_t symbol(char *str)
{
symbol_t **pnode;
pnode = symtab_lookup(&symtab, str);
if (*pnode == NULL)
*pnode = mk_symbol(str);
return tagptr(*pnode, TAG_SYM);
}
static void global_env_list(symbol_t *root, value_t *pv)
{
while (root != NULL) {
if (root->name[0] != ':' && (root->binding != UNBOUND)) {
*pv = fl_cons(tagptr(root,TAG_SYM), *pv);
}
global_env_list(root->left, pv);
root = root->right;
}
}
static value_t mk_cons(void)
{
cons_t *c;
if (curheap > lim)
gc();
c = (cons_t*)curheap;
curheap += sizeof(cons_t);
return tagptr(c, TAG_CONS);
}
/*---------------------------------------------------------------startElement-+
| Effects: |
| Push a given element on the ELM stack - no check / no call back |
+----------------------------------------------------------------------------*/
bool Yasp3::startElement(UnicodeString const & ucsGi)
{
Element const * pElm = elmMgr.inqElement(ucsGi);
if (pElm) {
RefdItem tagptr(new Tag(pElm, pElm->inqAttlist()));
ElmManager::SignalEventCB cb;
elmMgr.startElement(tagptr, cb);
dlmfnd.setConMode(
elmMgr.inqRecognitionMode(), elmMgr.isNetEnabled(), entMgr.inqDepth()
);
return true;
}
return false;
}
void osdep_cwd( void )
{
char buf[FILENAME_MAX+1];
int k;
k = GetCurrentDirectory( sizeof(buf), buf );
if (k == 0 || k >= sizeof(buf))
globals[G_RESULT] = FALSE_CONST;
else
{
int nwords = roundup4(k)/4;
word *p = alloc_from_heap( (nwords+1)*sizeof(word) );
*p = mkheader( k, BV_HDR );
memcpy( p+1, buf, k );
globals[G_RESULT] = tagptr(p,BVEC_TAG);
}
}
static void* visit_measuring_float( word *addr, int tag, void *accum )
{
struct visit_measuring_float_data *data =
(struct visit_measuring_float_data*)accum;
word obj;
bool marked;
bool marked_via_remsets;
int words;
struct float_counts *type_counts;
obj = tagptr( addr, tag );
marked =
msfloat_object_marked_p( data->context, obj );
marked_via_remsets =
msfloat_object_marked_p( data->context_incl_remsets, obj );
data->objs.total += 1 ;
if (!marked && !marked_via_remsets) {
data->objs.zzflt += 1;
}
if (!marked && marked_via_remsets) {
data->objs.rsflt += 1;
}
switch (tag) {
case PAIR_TAG:
words = 2;
break;
case VEC_TAG:
case BVEC_TAG:
case PROC_TAG:
words = roundup8( sizefield( *addr )+4 ) / 4;
break;
default:
assert(0);
}
data->words.total += words;
if (!marked && !marked_via_remsets)
data->words.zzflt += words;
if (!marked && marked_via_remsets)
data->words.rsflt += words;
return data;
}
// label is the backreference we'd like to fix up with this read
static value_t do_read_sexpr(value_t label)
{
value_t v, sym, oldtokval, *head;
value_t *pv;
u_int32_t t;
char c;
t = peek();
take();
switch (t) {
case TOK_CLOSE:
lerror(ParseError, "read: unexpected ')'");
case TOK_CLOSEB:
lerror(ParseError, "read: unexpected ']'");
case TOK_DOT:
lerror(ParseError, "read: unexpected '.'");
case TOK_SYM:
case TOK_NUM:
return tokval;
case TOK_COMMA:
head = , goto listwith;
case TOK_COMMAAT:
head = &COMMAAT; goto listwith;
case TOK_COMMADOT:
head = &COMMADOT; goto listwith;
case TOK_BQ:
head = &BACKQUOTE; goto listwith;
case TOK_QUOTE:
head = "E;
listwith:
v = cons_reserve(2);
car_(v) = *head;
cdr_(v) = tagptr(((cons_t*)ptr(v))+1, TAG_CONS);
car_(cdr_(v)) = cdr_(cdr_(v)) = NIL;
PUSH(v);
if (label != UNBOUND)
ptrhash_put(&readstate->backrefs, (void*)label, (void*)v);
v = do_read_sexpr(UNBOUND);
car_(cdr_(Stack[SP-1])) = v;
return POP();
case TOK_SHARPQUOTE:
// femtoLisp doesn't need symbol-function, so #' does nothing
return do_read_sexpr(label);
case TOK_OPEN:
PUSH(NIL);
read_list(&Stack[SP-1], label);
return POP();
case TOK_SHARPSYM:
sym = tokval;
if (sym == tsym || sym == Tsym)
return FL_T;
else if (sym == fsym || sym == Fsym)
return FL_F;
// constructor notation
c = nextchar();
if (c != '(') {
take();
lerrorf(ParseError, "read: expected argument list for %s",
symbol_name(tokval));
}
PUSH(NIL);
read_list(&Stack[SP-1], UNBOUND);
if (sym == vu8sym) {
sym = arraysym;
Stack[SP-1] = fl_cons(uint8sym, Stack[SP-1]);
}
else if (sym == fnsym) {
sym = FUNCTION;
}
v = symbol_value(sym);
if (v == UNBOUND)
fl_raise(fl_list2(UnboundError, sym));
return fl_apply(v, POP());
case TOK_OPENB:
return read_vector(label, TOK_CLOSEB);
case TOK_SHARPOPEN:
return read_vector(label, TOK_CLOSE);
case TOK_SHARPDOT:
// eval-when-read
// evaluated expressions can refer to existing backreferences, but they
// cannot see pending labels. in other words:
// (... #2=#.#0# ... ) OK
// (... #2=#.(#2#) ... ) DO NOT WANT
sym = do_read_sexpr(UNBOUND);
if (issymbol(sym)) {
v = symbol_value(sym);
if (v == UNBOUND)
fl_raise(fl_list2(UnboundError, sym));
return v;
}
return fl_toplevel_eval(sym);
case TOK_LABEL:
// create backreference label
if (ptrhash_has(&readstate->backrefs, (void*)tokval))
lerrorf(ParseError, "read: label %ld redefined", numval(tokval));
oldtokval = tokval;
v = do_read_sexpr(tokval);
ptrhash_put(&readstate->backrefs, (void*)oldtokval, (void*)v);
return v;
case TOK_BACKREF:
// look up backreference
v = (value_t)ptrhash_get(&readstate->backrefs, (void*)tokval);
if (v == (value_t)HT_NOTFOUND)
lerrorf(ParseError, "read: undefined label %ld", numval(tokval));
return v;
case TOK_GENSYM:
pv = (value_t*)ptrhash_bp(&readstate->gensyms, (void*)tokval);
if (*pv == (value_t)HT_NOTFOUND)
*pv = fl_gensym(NULL, 0);
return *pv;
case TOK_DOUBLEQUOTE:
return read_string();
}
return FL_UNSPECIFIED;
}
void stk_flush( word *globals )
{
word *stktop, *stkbot, *first, *prev;
word retaddr, codeaddr, codeptr, proc, size;
unsigned framecount;
assert2( tagof( globals[ G_REG0 ]) == PROC_TAG );
stktop = (word*)globals[ G_STKP ];
stkbot = (word*)globals[ G_STKBOT ];
stack_state.words_flushed += (stkbot-stktop);
first = prev = 0;
framecount = 0;
while (stktop < stkbot) {
size = *(stktop+STK_CONTSIZE);
retaddr = *(stktop+STK_RETADDR);
/* convert header to vector header */
assert2( size % 4 == 0 ); /* size must be words, a fixnum */
assert2( (s_word)size >= 12 ); /* 3-word minimum, and nonnegative */
*(stktop+HC_HEADER) = mkheader( size, VEC_HDR );
/* convert return address */
proc = *(stktop+STK_REG0);
if (proc != 0) {
assert2( tagof( proc ) == PROC_TAG );
codeptr = *(ptrof( proc )+PROC_CODEPTR);
if (tagof( codeptr ) == BVEC_TAG) {
codeaddr = (word)ptrof( codeptr );
*(stktop+HC_RETOFFSET) = retaddr-(codeaddr+4);
} else {
*(stktop+HC_RETOFFSET) = retaddr;
}
} else {
*(stktop+HC_RETOFFSET) = retaddr;
}
/* chain things together */
if (first == 0)
first = stktop;
else
*(prev+HC_DYNLINK) = (word)tagptr( stktop, VEC_TAG );
prev = stktop;
framecount++;
size = roundup8( size+4 );
stktop += size / 4;
#if 0
annoyingmsg("Flush: %d", size );
#endif
}
if (prev != 0)
*(prev+HC_DYNLINK) = globals[ G_CONT ];
if (first != 0)
globals[ G_CONT ] = (word)tagptr( first, VEC_TAG );
globals[ G_STKBOT ] = globals[ G_STKP ];
stack_state.frames_flushed += framecount;
}
void C_varargs( void )
{
word j = nativeint( globals[ G_RESULT ] );
word n = nativeint( globals[ G_ARGREG2 ] );
word r = 31; /* Highest register # */
word *p, *first, *prev, t;
word k, limit;
word bytes;
#if !defined(BDW_GC)
word *allocptr;
#endif
in_noninterruptible_syscall = 1;
bytes = sizeof(word)*(2*(j-n));
if (bytes == 0) {
globals[ G_REG0 + n + 1 ] = NIL_CONST;
in_noninterruptible_syscall = 0;
return;
}
/* At least one vararg to cons up. */
/* Optimized allocation for precise GC; conservative GC calls
allocator each time.
*/
#if !defined(BDW_GC)
allocptr = (word*)alloc_from_heap( bytes );
# define alloc_one_pair(p) (p = allocptr, allocptr+=2)
#else
# define alloc_one_pair(p) (p = (word*)alloc_from_heap(2*sizeof(word)) )
#endif
first = prev = 0;
k = n+1;
limit = min( j, r-1 );
while (k <= limit ) {
alloc_one_pair(p);
*p = globals[ G_REG0 + k ];
if (prev)
*(prev+1) = tagptr( p, PAIR_TAG );
else
first = p;
prev = p;
k++;
}
/* Copy the list in t into the memory pointed to by p. */
if (j >= r) {
t = globals[ G_REG0 + r ];
while (t != NIL_CONST) {
alloc_one_pair(p);
*p = pair_car( t );
if (prev)
*(prev+1) = tagptr( p, PAIR_TAG );
else
first = p;
prev = p;
t = pair_cdr( t );
}
}
*(prev+1) = NIL_CONST;
globals[ G_REG0+n+1 ] = tagptr( first, PAIR_TAG );
in_noninterruptible_syscall = 0;
}
/*-------------------------------------------------------------handleStartTag-+
| Effects: |
| This routine is called to parse a start tag |
| |
| When entering: |
| - curr_char is after the STAGO delimiter |
| |
| When returning: |
| - curr_char is: |
| - either the character that follows a NET or a TAGC |
| - or *AT* the ETAGOs, STAGOs delimiters |
| - events might have been stacked. |
+----------------------------------------------------------------------------*/
void Yasp3::handleStartTag()
{
bool isConrefSpec = false;
Element const * pElm;
Attlist attlst;
Tag::Flag tagFlag;
switch (dlmfnd.delimFound()) {
case Delimiter::IX_STAGO:
/*
| Regular tag: parse it, including the attributes
*/
{
UCS_2 giName[1+NAMELEN_MAX];
if (!grabNameGeneral(giName)) {
closeTag(false);
evCurr = YSP__ERROR;
return;
}
if (pElm = elmMgr.inqElement(giName), !pElm) {
if (options == YSP__validate) {
erh << ECE__ERROR << _YSP__INVSTGNAME << giName << endm;
}
pElm = elmMgr.defineElementIfNotThere(giName);
}else {
attlst = pElm->inqAttlist();
}
}
dlmfnd.pushMode(MODE_TAG);
closeTag(parseAttSpecList(attlst, isConrefSpec));
if (dlmfnd.delimFound() == Delimiter::IX_NESTC){
if (options == YSP__validate) {
if (sdcl.isXML()) {
/*
| XML is allowing a net-enabling start-tag
| only when immediately followed by a null end-tag.
*/
int iOffset = 0;
if (!peek(value(Delimiter::IX_NET), false, iOffset)) {
//>>PGR: produce a better message, when SHR freeze lifted.
erh << ECE__ERROR << _YSP__NOTAGC << endm;
}
}else if (
!sdcl.features().isShorttag() || pElm->inqModel().isEmpty()
) {
erh << ECE__ERROR << _YSP__INVNETMIN << endm;
}
}
tagFlag = Tag::Net;
}else {
tagFlag = Tag::Regular;
}
dlmfnd.popMode();
break;
default: // STAGO_TAGC "<>"
/*
| By 7.4.1.1, a GI specification is implied for an
| empty start tag before to determine whether
| any tags were omitted before it
| a) if (OMITTAG==YES) <> == most recently started
| b) if (OMITTAG==NO) <> == most recently ended
| c) or the base document element
*/
if (elmMgr.inqDepth() > 1) {
if (sdcl.features().isOmittag()) { // 7.4.1.1 a)
pElm = elmMgr.inqElementLastOpened();
}else { // 7.4.1.1 b)
pElm = elmMgr.inqElementLastClosed();
}
}else { // 7.4.1.1 c)
pElm = elmMgr.inqElementBase();
}
if (!pElm) {
erh << ECE__ERROR << _YSP__INVSTGEMPTY << endm;
evCurr = YSP__ERROR;
return;
}
attlst = pElm->inqAttlist();
tagFlag = Tag::Empty;
break;
}
/*
| parsing job now finished: open the element
*/
RecordBinder rcdbndBackup(rcdbnd);
YaspSignalEventCB cb(this);
switch (elmMgr.welcomeElement(pElm, cb)) {
case ElmManager::WCOND_INCLUDED:
tagFlag << Tag::Inclusion;
if (!pElm->isDefined()) { // faked inclusion
tagFlag << Tag::InvalidStart;
}
break;
case ElmManager::WCOND_HIT:
break;
case ElmManager::WCOND_FORCED: // forced to be valid
tagFlag << Tag::InvalidStart;
break;
case ElmManager::WCOND_INVALID:
tagFlag << Tag::InvalidStart;
rcdbnd = rcdbndBackup;
evlst.reset();
break;
default:
assert (false);
rcdbnd = rcdbndBackup;
evlst.reset();
evCurr = YSP__ERROR;
return;
}
if ((options == YSP__validate) &&
evlst.isEventWaiting() && !sdcl.features().isOmittag()
) {
erh << ECE__ERROR << _YSP__NOTAGOMIT << endm;
}
if (evStartEntity.inqType() != YSP__noType) { // entity start still pending
registerEntityStart();
};
RefdItem tagptr(new Tag(pElm, attlst, tagFlag));
if (!elmMgr.startElement(tagptr, cb, isConrefSpec)) { // == isEmpty
evCurr = YSP__ERROR; // YSP__FATAL???
}else {
dlmfnd.setConMode(
elmMgr.inqRecognitionMode(),
elmMgr.isNetEnabled(),
entMgr.inqDepth(),
pElm->inqGi()
);
evlst.next(evCurr);
}
/*
| The EMPTYNRM feature allows EMPTY tags to be followed by an end tag.
| Look ahead and see if the current empty tag is followed by its
| matching end tag. If so: discard it. This will keep the tag
| reporting consistent: end of EMPTY tags is never reported.
*/
if (
sdcl.features().isEmptynrm() &&
(pElm->inqModel().isEmpty() || isConrefSpec)
) {
int iOffset = 0;
switch (dlmfnd.delimFound()) {
case Delimiter::IX_TAGC:
if (!peek(value(Delimiter::IX_ETAGO), false, iOffset)) {
break;
}
/* fall thru */
case Delimiter::IX_ETAGO:
if (peek(pElm->inqGi(), sdcl.charset().isCaseGeneral(), iOffset)) {
oec.skip(iOffset);
dlmfnd.pushMode(MODE_TAG);
skip_S();
closeTag(true);
if (dlmfnd.delimFound() == Delimiter::IX_NESTC) {
erh << ECE__ERROR << _YSP__INVDLM << endm;
}
dlmfnd.popMode();
}
break;
case Delimiter::IX_NESTC:
if (peek(value(Delimiter::IX_NET), false, iOffset)) {
oec.skip(iOffset);
}
break;
case Delimiter::IX_ETAGO_TAGC:
oec.skip(dlmfnd.delimLength());
break;
default:
break;
}
}
}
