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; } } }