void Fmake_string_output_stream(CL_FORM *base, int nargs) { switch(nargs) { case 0: LOAD_SMALLFIXNUM(10, ARG(0)); LOAD_SYMBOL(SYMBOL(Slisp, 99), ARG(1)); /* ELEMENT-TYPE */ LOAD_SYMBOL(SYMBOL(Slisp, 18), ARG(2)); /* CHARACTER */ LOAD_SYMBOL(SYMBOL(Slisp, 100), ARG(3)); /* ADJUSTABLE */ LOAD_SYMBOL(SYMBOL(Slisp, 48), ARG(4)); /* T */ LOAD_SYMBOL(SYMBOL(Slisp, 101), ARG(5)); /* FILL-POINTER */ LOAD_SMALLFIXNUM(0, ARG(6)); Fmake_array(ARG(0), 7); case 1: break; default: Labort(TOO_MANY_ARGS); } make_string_output_stream1(ARG(0)); }
void gensym1(CL_FORM *base) { if(CL_TRUEP(ARG(0))) { LOAD_FIXNUM(ARG(2), 0, ARG(2)); if(CL_FIXNUMP(ARG(0)) && GET_FIXNUM(ARG(0)) >= GET_FIXNUM(ARG(2))) { COPY(ARG(0), SYMVAL(Slisp, 662)); /* *GENSYM-COUNTER* */ } else { COPY(ARG(0), ARG(1)); Fstringp(ARG(1)); if(CL_TRUEP(ARG(1))) { COPY(ARG(0), SYMVAL(Slisp, 674)); /* *GENSYM-PREFIX* */ } else { LOAD_SMSTR((CL_FORM *)&Kgensym1[0], ARG(1)); /* positive integer or string expected */ Ferror(ARG(1), 1); } } } LOAD_SYMBOL(SYMBOL(Slisp, 44), ARG(1)); /* STRING */ COPY(SYMVAL(Slisp, 674), ARG(2)); /* *GENSYM-PREFIX* */ COPY(SYMVAL(Slisp, 662), ARG(3)); /* *GENSYM-COUNTER* */ LOAD_FIXNUM(ARG(4), 10, ARG(4)); LOAD_SYMBOL(SYMBOL(Slisp, 18), ARG(5)); /* CHARACTER */ LOAD_NIL(ARG(6)); LOAD_NIL(ARG(7)); LOAD_SYMBOL(SYMBOL(Slisp, 48), ARG(8)); /* T */ LOAD_FIXNUM(ARG(9), 0, ARG(9)); LOAD_NIL(ARG(10)); LOAD_FIXNUM(ARG(11), 0, ARG(11)); LOAD_NIL(ARG(12)); LOAD_NIL(ARG(13)); LOAD_NIL(ARG(14)); make_array1(ARG(4)); make_string_output_stream1(ARG(4)); COPY(ARG(3), ARG(5)); COPY(ARG(4), ARG(6)); prin11(ARG(5)); COPY(ARG(4), ARG(5)); LOAD_SYMBOL(SYMBOL(Slisp, 64), ARG(6)); /* STREAM */ rt_struct_typep(ARG(5)); if(CL_TRUEP(ARG(5))) { COPY(OFFSET(AR_BASE(GET_FORM(ARG(4))), 0 + 1), ARG(5)); } else { COPY(SYMVAL(Slisp, 352), ARG(5)); /* NO_STRUCT */ COPY(ARG(4), ARG(6)); LOAD_SYMBOL(SYMBOL(Slisp, 64), ARG(7)); /* STREAM */ Ferror(ARG(5), 3); } if(CL_SYMBOLP(ARG(5)) && GET_SYMBOL(ARG(5)) == SYMBOL(Slisp, 102)) /* STRING-OUTPUT */ { } else { LOAD_SMSTR((CL_FORM *)&KClisp[268], ARG(5)); /* string-output-stream expected */ Ferror(ARG(5), 1); } COPY(ARG(4), ARG(5)); COPY(ARG(5), ARG(6)); COPY(ARG(6), ARG(7)); LOAD_SYMBOL(SYMBOL(Slisp, 64), ARG(8)); /* STREAM */ rt_struct_typep(ARG(7)); if(CL_TRUEP(ARG(7))) { COPY(OFFSET(AR_BASE(GET_FORM(ARG(6))), 1 + 1), ARG(5)); } else { COPY(SYMVAL(Slisp, 352), ARG(5)); /* NO_STRUCT */ LOAD_SYMBOL(SYMBOL(Slisp, 64), ARG(7)); /* STREAM */ Ferror(ARG(5), 3); } Ffuncall(ARG(5), 1); mv_count = 1; COPY(ARG(5), ARG(3)); Fconcatenate(ARG(1), 3); Fmake_symbol(ARG(1)); COPY(SYMVAL(Slisp, 662), ARG(2)); /* *GENSYM-COUNTER* */ F1plus(ARG(2)); COPY(ARG(2), SYMVAL(Slisp, 662)); /* *GENSYM-COUNTER* */ COPY(ARG(1), ARG(0)); }
void write_to_string1(CL_FORM *base) { BIND_SPECIAL(SYMBOL(Slisp, 474), ARG(1)); /* *PRINT-ESCAPE* */ BIND_SPECIAL(SYMBOL(Slisp, 479), ARG(2)); /* *PRINT-RADIX* */ BIND_SPECIAL(SYMBOL(Slisp, 471), ARG(3)); /* *PRINT-BASE* */ BIND_SPECIAL(SYMBOL(Slisp, 473), ARG(4)); /* *PRINT-CIRCLE* */ BIND_SPECIAL(SYMBOL(Slisp, 478), ARG(5)); /* *PRINT-PRETTY* */ BIND_SPECIAL(SYMBOL(Slisp, 477), ARG(6)); /* *PRINT-LEVEL* */ BIND_SPECIAL(SYMBOL(Slisp, 476), ARG(7)); /* *PRINT-LENGTH* */ BIND_SPECIAL(SYMBOL(Slisp, 472), ARG(8)); /* *PRINT-CASE* */ BIND_SPECIAL(SYMBOL(Slisp, 475), ARG(9)); /* *PRINT-GENSYM* */ BIND_SPECIAL(SYMBOL(Slisp, 470), ARG(10)); /* *PRINT-ARRAY* */ LOAD_FIXNUM(ARG(11), 10, ARG(11)); LOAD_SYMBOL(SYMBOL(Slisp, 18), ARG(12)); /* CHARACTER */ LOAD_NIL(ARG(13)); LOAD_NIL(ARG(14)); LOAD_SYMBOL(SYMBOL(Slisp, 48), ARG(15)); /* T */ LOAD_FIXNUM(ARG(16), 0, ARG(16)); LOAD_NIL(ARG(17)); LOAD_FIXNUM(ARG(18), 0, ARG(18)); LOAD_NIL(ARG(19)); LOAD_NIL(ARG(20)); LOAD_NIL(ARG(21)); make_array1(ARG(11)); make_string_output_stream1(ARG(11)); COPY(ARG(0), ARG(12)); COPY(ARG(11), ARG(13)); write2(ARG(12)); COPY(ARG(11), ARG(12)); LOAD_SYMBOL(SYMBOL(Slisp, 64), ARG(13)); /* STREAM */ rt_struct_typep(ARG(12)); if(CL_TRUEP(ARG(12))) { COPY(OFFSET(AR_BASE(GET_FORM(ARG(11))), 0 + 1), ARG(12)); } else { COPY(SYMVAL(Slisp, 352), ARG(12)); /* NO_STRUCT */ COPY(ARG(11), ARG(13)); LOAD_SYMBOL(SYMBOL(Slisp, 64), ARG(14)); /* STREAM */ Ferror(ARG(12), 3); } if(CL_SYMBOLP(ARG(12)) && GET_SYMBOL(ARG(12)) == SYMBOL(Slisp, 102)) /* STRING-OUTPUT */ { } else { LOAD_SMSTR((CL_FORM *)&KClisp[268], ARG(12)); /* string-output-stream expected */ Ferror(ARG(12), 1); } COPY(ARG(11), ARG(12)); COPY(ARG(12), ARG(13)); COPY(ARG(13), ARG(14)); LOAD_SYMBOL(SYMBOL(Slisp, 64), ARG(15)); /* STREAM */ rt_struct_typep(ARG(14)); if(CL_TRUEP(ARG(14))) { COPY(OFFSET(AR_BASE(GET_FORM(ARG(13))), 1 + 1), ARG(12)); } else { COPY(SYMVAL(Slisp, 352), ARG(12)); /* NO_STRUCT */ LOAD_SYMBOL(SYMBOL(Slisp, 64), ARG(14)); /* STREAM */ Ferror(ARG(12), 3); } Ffuncall(ARG(12), 1); COPY(ARG(12), ARG(0)); RESTORE_SPECIAL; RESTORE_SPECIAL; RESTORE_SPECIAL; RESTORE_SPECIAL; RESTORE_SPECIAL; RESTORE_SPECIAL; RESTORE_SPECIAL; RESTORE_SPECIAL; RESTORE_SPECIAL; RESTORE_SPECIAL; }