src/c/builtins.c

   1 /* <Built-in procedures> */
   2
   3 /* Creates a closure and adds it to the top-level
   4    @param name (string) the name of the built-in procedure
   5    @param code (void*) the address of the built-in procedure (label address)
   6 */
   7 #define CREATE_BUILTIN_CLOS(name,code) \
   8     r_res = (int)getSymbol((name),topLevel); /* create a hash bucket */ \
   9     ((SymbolEntry*)r_res)->sob = makeSchemeClosure(NULL,(code)); \
  10     ASSERT_ALWAYS( ((SymbolEntry*)r_res)->sob!=NULL,"" ); \
  11     ((SymbolEntry*)r_res)->isDefined = 1;
  12
  13 /* The stack when in a built-in precedure (there is no fp):
  14   sp -> |      |
  15         | ret  |  - return address
  16         | env  |  - points to the enviroment vector
  17         | n    |  - number of arguments
  18         | A0   |  - argument 0
  19         | A1   |  - argument 1
  20         | ...  |  - ...
  21         | An-1 |  - argument n-1
  22
  23    Macros for built-in procedures:
  24 */
  25 #define BI_ST_ARG(n) (stack[sp-4-(n)])
  26 #define BI_ST_ARG_COUNT() (stack[sp-3])
  27 #define BI_ST_RET() (stack[sp-1])
  28 #define BI_RETURN() goto *pop()
  29
  30     goto Lstart; /* skip all definitions */
  31
  32 Lcar:
  33     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==1,MSG_ERR_ARGCOUNT("car",1) );
  34     r[0] = BI_ST_ARG(0);
  35     ASSERT_ALWAYS( IS_SOB_PAIR(r[0]), MSG_ERR_NOTPAIR );
  36     r_res = (int)SOB_PAIR_CAR(r[0]);
  37     BI_RETURN();
  38
  39 Lcdr:
  40     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==1,MSG_ERR_ARGCOUNT("cdr",1) );
  41     r[0] = BI_ST_ARG(0);
  42     ASSERT_ALWAYS( IS_SOB_PAIR(r[0]), MSG_ERR_NOTPAIR );
  43     r_res = (int)SOB_PAIR_CDR(r[0]);
  44     BI_RETURN();
  45
  46 Lsymbol:
  47     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==1,MSG_ERR_ARGCOUNT("symbol?",1) );
  48     r[0] = BI_ST_ARG(0);
  49     if ( IS_SOB_SYMBOL(r[0]) ) goto Lsymbol_true;
  50     r_res = (int)&sc_false;
  51     BI_RETURN();
  52 Lsymbol_true:
  53     r_res = (int)&sc_true;
  54     BI_RETURN();
  55
  56 Lset_car:
  57     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==2,MSG_ERR_ARGCOUNT("set-car!",2) );
  58     r[0] = BI_ST_ARG(0);
  59     r[1] = BI_ST_ARG(1);
  60     ASSERT_ALWAYS( IS_SOB_PAIR(r[0]), MSG_ERR_NOTPAIR );
  61     SOB_PAIR_CAR(r[0]) = (SchemeObject*)r[1];
  62     r_res = (int)&sc_void;
  63     BI_RETURN();
  64
  65 Lset_cdr:
  66     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==2,MSG_ERR_ARGCOUNT("set-cdr!",2) );
  67     r[0] = BI_ST_ARG(0);
  68     r[1] = BI_ST_ARG(1);
  69     ASSERT_ALWAYS( IS_SOB_PAIR(r[0]), MSG_ERR_NOTPAIR );
  70     SOB_PAIR_CDR(r[0]) = (SchemeObject*)r[1];
  71     r_res = (int)&sc_void;
  72     BI_RETURN();
  73
  74 Lmake_vector:
  75     ASSERT_ALWAYS( BI_ST_ARG_COUNT()>=1,MSG_ERR_ARGCOUNT("make-vector",1) );
  76     r[0] = BI_ST_ARG(0);
  77     ASSERT_ALWAYS(IS_SOB_INT((SchemeObject*)r[0]), "");
  78     r[0] = SOB_INT_VALUE(r[0]);
  79     r_res = (int)makeSchemeVectorInit(r[0],&sc_void);
  80     /* initialize vector elements
  81     for (int i=1; i<BI_ST_ARG_COUNT(); ++i)
  82         SOB_VECTOR_SET(r_res,i,BI_ST_ARG(i));
  83     */
  84     BI_RETURN();
  85
  86 Lvector_set:
  87     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==3,MSG_ERR_ARGCOUNT("vector-set!",3) );
  88     r[0] = BI_ST_ARG(0);
  89     ASSERT_ALWAYS(IS_SOB_VECTOR((SchemeObject*)r[0]), "");
  90     r[1] = BI_ST_ARG(1);
  91     ASSERT_ALWAYS(IS_SOB_INT((SchemeObject*)r[1]), "");
  92     r[1] = SOB_INT_VALUE((SchemeObject*)r[1]);
  93     r[2] = BI_ST_ARG(2);
  94     SOB_VECTOR_SET((SchemeObject*)r[0],r[1],(SchemeObject*)r[2]);
  95     r_res = (int)&sc_void;
  96     BI_RETURN();
  97
  98 Lvector_ref:
  99     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==2,MSG_ERR_ARGCOUNT("vector-ref",2) );
 100     r[0] = BI_ST_ARG(0);
 101     ASSERT_ALWAYS(IS_SOB_VECTOR((SchemeObject*)r[0]), "");
 102     r[1] = BI_ST_ARG(1);
 103     ASSERT_ALWAYS(IS_SOB_INT((SchemeObject*)r[1]), "");
 104     r[1] = SOB_INT_VALUE((SchemeObject*)r[1]);
 105     r_res = (int)SOB_VECTOR_REF((SchemeObject*)r[0],r[1]);
 106     BI_RETURN();
 107
 108 LbinaryEQ:
 109     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==2,MSG_ERR_ARGCOUNT("binary=?",2) );
 110     r[0] = BI_ST_ARG(0);
 111     ASSERT_ALWAYS(IS_SOB_INT((SchemeObject*)r[0]), "");
 112     r[0] = SOB_INT_VALUE((SchemeObject*)r[0]);
 113     r[1] = BI_ST_ARG(1);
 114     ASSERT_ALWAYS(IS_SOB_INT((SchemeObject*)r[1]), "");
 115     r[1] = SOB_INT_VALUE((SchemeObject*)r[1]);
 116     if (r[0] != r[1]) goto LbinaryEQ_false;
 117     r_res = (int)&sc_true;
 118     BI_RETURN();
 119 LbinaryEQ_false:
 120     r_res = (int)&sc_false;
 121     BI_RETURN();
 122
 123 LbinaryADD:
 124     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==2,MSG_ERR_ARGCOUNT("binary-add",2) );
 125     r[0] = BI_ST_ARG(0);
 126     ASSERT_ALWAYS(IS_SOB_INT((SchemeObject*)r[0]), "");
 127     r[0] = SOB_INT_VALUE((SchemeObject*)r[0]);
 128     r[1] = BI_ST_ARG(1);
 129     ASSERT_ALWAYS(IS_SOB_INT((SchemeObject*)r[1]), "");
 130     r[1] = SOB_INT_VALUE((SchemeObject*)r[1]);
 131     r_res = r[0] + r[1];
 132     r_res = (int)makeSchemeInt( r_res );
 133     BI_RETURN();
 134
 135 LbinarySUB:
 136     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==2,MSG_ERR_ARGCOUNT("binary-sub",2) );
 137     r[0] = BI_ST_ARG(0);
 138     ASSERT_ALWAYS(IS_SOB_INT((SchemeObject*)r[0]), "");
 139     r[0] = SOB_INT_VALUE((SchemeObject*)r[0]);
 140     r[1] = BI_ST_ARG(1);
 141     ASSERT_ALWAYS(IS_SOB_INT((SchemeObject*)r[1]), "");
 142     r[1] = SOB_INT_VALUE((SchemeObject*)r[1]);
 143     r_res = r[0] - r[1];
 144     r_res = (int)makeSchemeInt( r_res );
 145     BI_RETURN();
 146
 147 LbinaryMUL:
 148     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==2,MSG_ERR_ARGCOUNT("binary-mul",2) );
 149     r[0] = BI_ST_ARG(0);
 150     ASSERT_ALWAYS(IS_SOB_INT((SchemeObject*)r[0]), "");
 151     r[0] = SOB_INT_VALUE((SchemeObject*)r[0]);
 152     r[1] = BI_ST_ARG(1);
 153     ASSERT_ALWAYS(IS_SOB_INT((SchemeObject*)r[1]), "");
 154     r[1] = SOB_INT_VALUE((SchemeObject*)r[1]);
 155     r_res = (int)r[0] * (int)r[1]; /* multiply as signed integers */
 156     r_res = (int)makeSchemeInt( r_res );
 157     BI_RETURN();
 158
 159 LbinaryDIV:
 160     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==2,MSG_ERR_ARGCOUNT("binary-div",2) );
 161     r[0] = BI_ST_ARG(0);
 162     ASSERT_ALWAYS(IS_SOB_INT((SchemeObject*)r[0]), "");
 163     r[0] = SOB_INT_VALUE((SchemeObject*)r[0]);
 164     r[1] = BI_ST_ARG(1);
 165     ASSERT_ALWAYS(IS_SOB_INT((SchemeObject*)r[1]), "");
 166     r[1] = SOB_INT_VALUE((SchemeObject*)r[1]);
 167     ASSERT_ALWAYS( (int)r[1]!=0, MSG_ERR_DIVZERO );
 168     r_res = (int)r[0] / (int)r[1]; /* divide as signed integers */
 169     r_res = (int)makeSchemeInt( r_res );
 170     BI_RETURN();
 171
 172 LbinaryLT:
 173     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==2,MSG_ERR_ARGCOUNT("binary<?",2) );
 174     r[0] = BI_ST_ARG(0);
 175     ASSERT_ALWAYS(IS_SOB_INT((SchemeObject*)r[0]), "");
 176     r[0] = SOB_INT_VALUE((SchemeObject*)r[0]);
 177     r[1] = BI_ST_ARG(1);
 178     ASSERT_ALWAYS(IS_SOB_INT((SchemeObject*)r[1]), "");
 179     r[1] = SOB_INT_VALUE((SchemeObject*)r[1]);
 180     r_res = ((int)r[0] < (int)r[1]); /* compare as signed integers */
 181     if ( r_res ) goto LbinaryLT_true;
 182     r_res = (int)&sc_false;
 183     BI_RETURN();
 184 LbinaryLT_true:
 185     r_res = (int)&sc_true;
 186     BI_RETURN();
 187
 188 Lbox:
 189     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==1,MSG_ERR_ARGCOUNT("box",1) );
 190     r[0] = BI_ST_ARG(0);
 191     r_res = (int)makeSchemeVectorInit( 1,(SchemeObject*)(r[0]) );
 192     BI_RETURN();
 193
 194 Lnull:
 195     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==1,MSG_ERR_ARGCOUNT("null?",1) );
 196     r[0] = BI_ST_ARG(0);
 197     if ( IS_SOB_NIL(r[0]) ) goto Lnull_true;
 198     r_res = (int)&sc_false;
 199     BI_RETURN();
 200 Lnull_true:
 201     r_res = (int)&sc_true;
 202     BI_RETURN();
 203
 204 Lchar_to_integer:
 205     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==1,MSG_ERR_ARGCOUNT("char->integer",1) );
 206     r[0] = BI_ST_ARG(0);
 207     ASSERT_ALWAYS( IS_SOB_CHAR(r[0]), "" );
 208     r[0] = SOB_CHAR_VALUE(r[0]);
 209     r_res = (int)makeSchemeInt( (int)r[0] );
 210     BI_RETURN();
 211
 212 Linteger_to_char:
 213     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==1,MSG_ERR_ARGCOUNT("integer->char",1) );
 214     r[0] = BI_ST_ARG(0);
 215     ASSERT_ALWAYS( IS_SOB_INT(r[0]), "" );
 216     r[0] = SOB_INT_VALUE(r[0]);
 217     r_res = (int)makeSchemeChar( (char)r[0] );
 218     BI_RETURN();
 219
 220 Lapply:
 221     push( fp );
 222     fp = sp;
 223     ASSERT_ALWAYS( ST_ARG_COUNT()==2,MSG_ERR_ARGCOUNT("apply",2) );
 224     r[0] = ST_ARG(0); /* r[0] is now the closure */
 225     ASSERT_ALWAYS( IS_SOB_CLOSURE(r[0]), MSG_ERR_APPNONPROC );
 226     r[1] = ST_ARG(1); /* r[1] is now the list of arguments */
 227     ASSERT_ALWAYS( (r[1]==(int)&sc_nil) | (IS_SOB_PAIR(r[1])), MSG_ERR_NOTLIST );
 228     /* push arguments (backwards) and number of arguments */
 229     pushArgsList( (SchemeObject*)r[1] );
 230     /* push env. of closure */
 231     push( (int)SOB_CLOSURE_ENV(r[0]) );
 232     /* push current return address (it's a tail call) */
 233     push( (int)ST_RET() );
 234     /* override current frame (it's a tail call) */
 235     shiftActFrmDown();
 236     /* branch */
 237     goto *SOB_CLOSURE_CODE(r[0]);
 238
 239 Lboolean:
 240     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==1,MSG_ERR_ARGCOUNT("boolean?",1) );
 241     r[0] = BI_ST_ARG(0);
 242     r_res = (IS_SOB_BOOL(r[0])) ? (int)&sc_true : (int)&sc_false;
 243     BI_RETURN();
 244
 245 Lchar:
 246     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==1,MSG_ERR_ARGCOUNT("char?",1) );
 247     r[0] = BI_ST_ARG(0);
 248     r_res = (IS_SOB_CHAR(r[0])) ? (int)&sc_true : (int)&sc_false;
 249     BI_RETURN();
 250
 251 Linteger:
 252     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==1,MSG_ERR_ARGCOUNT("integer?",1) );
 253     r[0] = BI_ST_ARG(0);
 254     r_res = (IS_SOB_INT(r[0])) ? (int)&sc_true : (int)&sc_false;
 255     BI_RETURN();
 256
 257 Lpair:
 258     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==1,MSG_ERR_ARGCOUNT("pair?",1) );
 259     r[0] = BI_ST_ARG(0);
 260     r_res = (IS_SOB_PAIR(r[0])) ? (int)&sc_true : (int)&sc_false;
 261     BI_RETURN();
 262
 263 Lprocedure:
 264     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==1,MSG_ERR_ARGCOUNT("procedure?",1) );
 265     r[0] = BI_ST_ARG(0);
 266     r_res = (IS_SOB_CLOSURE(r[0])) ? (int)&sc_true : (int)&sc_false;
 267     BI_RETURN();
 268
 269 Lcons:
 270     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==2,MSG_ERR_ARGCOUNT("cons",2) );
 271     r[0] = BI_ST_ARG(0);
 272     r[1] = BI_ST_ARG(1);
 273     r_res = (int)makeSchemePair( (SchemeObject*)r[0], (SchemeObject*)r[1] );
 274     BI_RETURN();
 275
 276 Leq:
 277     /* The eq? procedure compare the
 278        VALUES of booleans,
 279                  chars,
 280                  integers,
 281                  symbols,
 282        and the ADDRESSES of pairs,
 283                             strings, and
 284                             vectors.
 285     */
 286     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==2,MSG_ERR_ARGCOUNT("eq?",2) );
 287     r[0] = BI_ST_ARG(0);
 288     r[1] = BI_ST_ARG(1);
 289     if ( IS_SOB_BOOL(r[0]) ) goto Leq_boolval;
 290     if ( IS_SOB_CHAR(r[0]) ) goto Leq_charval;
 291     if ( IS_SOB_INT(r[0]) ) goto Leq_intval;
 292     if ( IS_SOB_SYMBOL(r[0]) ) goto Leq_symval;
 293     if ( r[0]==r[1] ) goto Leq_true;
 294     goto Leq_false;
 295 Leq_boolval:
 296     if ( !IS_SOB_BOOL(r[1]) ) goto Leq_false;
 297     if ( SOB_BOOL_VALUE(r[0])==SOB_BOOL_VALUE(r[1]) ) goto Leq_true;
 298     goto Leq_false;
 299 Leq_charval:
 300     if ( !IS_SOB_CHAR(r[1]) ) goto Leq_false;
 301     if ( SOB_CHAR_VALUE(r[0])==SOB_CHAR_VALUE(r[1]) ) goto Leq_true;
 302     goto Leq_false;
 303 Leq_intval:
 304     if ( !IS_SOB_INT(r[1]) ) goto Leq_false;
 305     if ( SOB_INT_VALUE(r[0])==SOB_INT_VALUE(r[1]) ) goto Leq_true;
 306     goto Leq_false;
 307 Leq_symval:
 308     if ( !IS_SOB_SYMBOL(r[1]) ) goto Leq_false;
 309     if ( SOB_SYMBOL_ENTRY(r[0])==SOB_SYMBOL_ENTRY(r[1]) ) goto Leq_true;
 310     goto Leq_false;
 311 Leq_true:
 312     r_res = (int)&sc_true;
 313     BI_RETURN();
 314 Leq_false:
 315     r_res = (int)&sc_false;
 316     BI_RETURN();
 317
 318 Lmake_string:
 319     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==2,MSG_ERR_ARGCOUNT("make-string",2) );
 320     r[0] = BI_ST_ARG(0);
 321     ASSERT_ALWAYS(IS_SOB_INT((SchemeObject*)r[0]), "");
 322     r[0] = SOB_INT_VALUE(r[0]);
 323     r[1] = BI_ST_ARG(1);
 324     ASSERT_ALWAYS(IS_SOB_CHAR((SchemeObject*)r[1]), "");
 325     r[1] = (int)SOB_CHAR_VALUE(r[1]);
 326     r_res = (int)makeSchemeString(r[0],(char)r[1]);
 327     BI_RETURN();
 328
 329 Lremainder:
 330     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==2,MSG_ERR_ARGCOUNT("remainder",2) );
 331     r[0] = BI_ST_ARG(0);
 332     ASSERT_ALWAYS( IS_SOB_INT(r[0]), "" );
 333     r[0] = SOB_INT_VALUE(r[0]);
 334     r[1] = BI_ST_ARG(1);
 335     ASSERT_ALWAYS( IS_SOB_INT(r[1]), "" );
 336     r[1] = SOB_INT_VALUE(r[1]);
 337     ASSERT_ALWAYS( (int)r[1]!=0, MSG_ERR_DIVZERO );
 338     r_res = (int)r[0] % (int)r[1]; /* divide as signed integers */
 339     r_res = (int)makeSchemeInt( r_res );
 340     BI_RETURN();
 341
 342 Lstring_to_symbol:
 343     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==1,MSG_ERR_ARGCOUNT("string->symbol",1) );
 344     r[0] = BI_ST_ARG(0);
 345     ASSERT_ALWAYS( IS_SOB_STRING(r[0]), "" );
 346     r[0] = (int)SOB_STRING_VALUE(r[0]);
 347     r_res = (int)makeSchemeSymbol((char*)r[0]);
 348     BI_RETURN();
 349
 350 Lstring_length:
 351     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==1,MSG_ERR_ARGCOUNT("string-length",1) );
 352     r[0] = BI_ST_ARG(0);
 353     ASSERT_ALWAYS( IS_SOB_STRING(r[0]), "" );
 354     r_res = SOB_STRING_LENGTH(r[0]);
 355     r_res = (int)makeSchemeInt(r_res);
 356     BI_RETURN();
 357
 358 Lstring_ref:
 359     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==2,MSG_ERR_ARGCOUNT("string-ref",2) );
 360     r[0] = BI_ST_ARG(0);
 361     ASSERT_ALWAYS( IS_SOB_STRING(r[0]), "" );
 362     r[1] = BI_ST_ARG(1);
 363     ASSERT_ALWAYS( IS_SOB_INT(r[1]), "" );
 364     r[1] = SOB_INT_VALUE( r[1] );
 365     ASSERT_ALWAYS( (r[1]>=0) & (r[1]<SOB_STRING_LENGTH(r[0])), MSG_ERR_NDXOUTOFBOUNDS );
 366     r_res = SOB_STRING_REF(r[0],r[1]);
 367     r_res = (int)makeSchemeChar(r_res);
 368     BI_RETURN();
 369
 370 Lstring_set:
 371     ASSERT_ALWAYS( BI_ST_ARG_COUNT()==3,MSG_ERR_ARGCOUNT("string-set!",3) );
 372     r[0] = BI_ST_ARG(0);
 373     ASSERT_ALWAYS( IS_SOB_STRING(r[0]), "" );
 374
 375     r[1] = BI_ST_ARG(1);
 376     ASSERT_ALWAYS( IS_SOB_INT(r[1]), "" );
 377     r[1] = SOB_INT_VALUE( r[1] );
 378     ASSERT_ALWAYS( (r[1]>=0) & (r[1]<SOB_STRING_LENGTH(r[0])), MSG_ERR_NDXOUTOFBOUNDS );
 379
 380     r[2] = BI_ST_ARG(2);
 381     ASSERT_ALWAYS( IS_SOB_CHAR(r[2]), "" );
 382     r[2] = SOB_CHAR_VALUE( r[2] );
 383     SOB_STRING_SET((SchemeObject*)r[0],r[1],(char)r[2]);
 384     r_res = (int)&sc_void;
 385     BI_RETURN();
 386
 387 Lstart:
 388     /* create closures for the free variables of the built-in procedures */
 389     CREATE_BUILTIN_CLOS("car"           ,&&Lcar);
 390     CREATE_BUILTIN_CLOS("cdr"           ,&&Lcdr);
 391     CREATE_BUILTIN_CLOS("symbol?"       ,&&Lsymbol);
 392     CREATE_BUILTIN_CLOS("set-car!"      ,&&Lset_car);
 393     CREATE_BUILTIN_CLOS("set-cdr!"      ,&&Lset_cdr);
 394     CREATE_BUILTIN_CLOS("make-vector"   ,&&Lmake_vector);
 395     CREATE_BUILTIN_CLOS("vector-set!"   ,&&Lvector_set);
 396     CREATE_BUILTIN_CLOS("vector-ref"    ,&&Lvector_ref);
 397     CREATE_BUILTIN_CLOS("binary=?"      ,&&LbinaryEQ);
 398     CREATE_BUILTIN_CLOS("binary-add"    ,&&LbinaryADD);
 399     CREATE_BUILTIN_CLOS("binary-sub"    ,&&LbinarySUB);
 400     CREATE_BUILTIN_CLOS("binary-mul"    ,&&LbinaryMUL);
 401     CREATE_BUILTIN_CLOS("binary-div"    ,&&LbinaryDIV);
 402     CREATE_BUILTIN_CLOS("binary<?"      ,&&LbinaryLT);
 403     CREATE_BUILTIN_CLOS("box"           ,&&Lbox);
 404     CREATE_BUILTIN_CLOS("null?"         ,&&Lnull);
 405     CREATE_BUILTIN_CLOS("char->integer" ,&&Lchar_to_integer);
 406     CREATE_BUILTIN_CLOS("integer->char" ,&&Linteger_to_char);
 407     CREATE_BUILTIN_CLOS("apply"         ,&&Lapply);
 408     CREATE_BUILTIN_CLOS("boolean?"      ,&&Lboolean);
 409     CREATE_BUILTIN_CLOS("char?"         ,&&Lchar);
 410     CREATE_BUILTIN_CLOS("cons"          ,&&Lcons);
 411     CREATE_BUILTIN_CLOS("eq?"           ,&&Leq);
 412     CREATE_BUILTIN_CLOS("integer?"      ,&&Linteger);
 413     CREATE_BUILTIN_CLOS("make-string"   ,&&Lmake_string);
 414     CREATE_BUILTIN_CLOS("number?"       ,&&Linteger); /* same as integer? */
 415     CREATE_BUILTIN_CLOS("pair?"         ,&&Lpair);
 416     CREATE_BUILTIN_CLOS("procedure?"    ,&&Lprocedure);
 417     CREATE_BUILTIN_CLOS("remainder"     ,&&Lremainder);
 418     CREATE_BUILTIN_CLOS("string->symbol",&&Lstring_to_symbol);
 419     CREATE_BUILTIN_CLOS("string-length" ,&&Lstring_length);
 420     CREATE_BUILTIN_CLOS("string-ref"    ,&&Lstring_ref);
 421     CREATE_BUILTIN_CLOS("string-set!"   ,&&Lstring_set);
 422
 423 /* </Built-in procedures> */