467 |
object *vt = PRINTvs_top; |
object *vt = PRINTvs_top; |
468 |
object *vl = PRINTvs_limit; |
object *vl = PRINTvs_limit; |
469 |
bool e = PRINTescape; |
bool e = PRINTescape; |
470 |
|
bool ra = PRINTreadably; |
471 |
bool r = PRINTradix; |
bool r = PRINTradix; |
472 |
int b = PRINTbase; |
int b = PRINTbase; |
473 |
bool c = PRINTcircle; |
bool c = PRINTcircle; |
522 |
|
|
523 |
old_bds_top = bds_top; |
old_bds_top = bds_top; |
524 |
bds_bind(sLAprint_escapeA, PRINTescape?Ct:Cnil); |
bds_bind(sLAprint_escapeA, PRINTescape?Ct:Cnil); |
525 |
|
bds_bind(sLAprint_readablyA, PRINTreadably?Ct:Cnil); |
526 |
bds_bind(sLAprint_radixA, PRINTradix?Ct:Cnil); |
bds_bind(sLAprint_radixA, PRINTradix?Ct:Cnil); |
527 |
bds_bind(sLAprint_baseA, make_fixnum(PRINTbase)); |
bds_bind(sLAprint_baseA, make_fixnum(PRINTbase)); |
528 |
bds_bind(sLAprint_circleA, PRINTcircle?Ct:Cnil); |
bds_bind(sLAprint_circleA, PRINTcircle?Ct:Cnil); |
573 |
PRINTbase = b; |
PRINTbase = b; |
574 |
PRINTradix = r; |
PRINTradix = r; |
575 |
PRINTescape = e; |
PRINTescape = e; |
576 |
|
PRINTreadably = ra; |
577 |
PRINTvs_limit = vl; |
PRINTvs_limit = vl; |
578 |
PRINTvs_top = vt; |
PRINTvs_top = vt; |
579 |
|
|
1468 |
FEwrong_type_argument(sLstream, PRINTstream); |
FEwrong_type_argument(sLstream, PRINTstream); |
1469 |
} |
} |
1470 |
PRINTescape = symbol_value(sLAprint_escapeA) != Cnil; |
PRINTescape = symbol_value(sLAprint_escapeA) != Cnil; |
1471 |
|
PRINTreadably = symbol_value(sLAprint_readablyA) != Cnil; |
1472 |
PRINTpretty = symbol_value(sLAprint_prettyA) != Cnil; |
PRINTpretty = symbol_value(sLAprint_prettyA) != Cnil; |
1473 |
PRINTcircle = symbol_value(sLAprint_circleA) != Cnil; |
PRINTcircle = symbol_value(sLAprint_circleA) != Cnil; |
1474 |
y = symbol_value(sLAprint_baseA); |
y = symbol_value(sLAprint_baseA); |
1584 |
@(defun write (x |
@(defun write (x |
1585 |
&key ((:stream strm) Cnil) |
&key ((:stream strm) Cnil) |
1586 |
(escape `symbol_value(sLAprint_escapeA)`) |
(escape `symbol_value(sLAprint_escapeA)`) |
1587 |
|
(readably `symbol_value(sLAprint_readablyA)`) |
1588 |
(radix `symbol_value(sLAprint_radixA)`) |
(radix `symbol_value(sLAprint_radixA)`) |
1589 |
(base `symbol_value(sLAprint_baseA)`) |
(base `symbol_value(sLAprint_baseA)`) |
1590 |
(circle `symbol_value(sLAprint_circleA)`) |
(circle `symbol_value(sLAprint_circleA)`) |
1607 |
FEerror("~S is not a stream.", 1, strm); |
FEerror("~S is not a stream.", 1, strm); |
1608 |
PRINTvs_top = vs_top; |
PRINTvs_top = vs_top; |
1609 |
PRINTstream = strm; |
PRINTstream = strm; |
1610 |
PRINTescape = escape != Cnil; |
PRINTreadably = readably != Cnil; |
1611 |
|
PRINTescape = PRINTreadably || escape != Cnil; |
1612 |
PRINTpretty = pretty != Cnil; |
PRINTpretty = pretty != Cnil; |
1613 |
PRINTcircle = circle != Cnil; |
PRINTcircle = circle != Cnil; |
1614 |
if (type_of(base)!=t_fixnum || fix((base))<2 || fix((base))>36) |
if (type_of(base)!=t_fixnum || fix((base))<2 || fix((base))>36) |
1620 |
if (PRINTcase != sKupcase && PRINTcase != sKdowncase && |
if (PRINTcase != sKupcase && PRINTcase != sKdowncase && |
1621 |
PRINTcase != sKcapitalize) |
PRINTcase != sKcapitalize) |
1622 |
FEerror("~S is an illegal PRINT-CASE.", 1, cas); |
FEerror("~S is an illegal PRINT-CASE.", 1, cas); |
1623 |
PRINTgensym = gensym != Cnil; |
PRINTgensym = PRINTreadably || gensym != Cnil; |
1624 |
if (level == Cnil) |
if (PRINTreadably || level == Cnil) |
1625 |
PRINTlevel = -1; |
PRINTlevel = -1; |
1626 |
else if (type_of(level) != t_fixnum || fix((level)) < 0) |
else if (type_of(level) != t_fixnum || fix((level)) < 0) |
1627 |
FEerror("~S is an illegal PRINT-LEVEL.", 1, level); |
FEerror("~S is an illegal PRINT-LEVEL.", 1, level); |
1628 |
else |
else |
1629 |
PRINTlevel = fix((level)); |
PRINTlevel = fix((level)); |
1630 |
if (length == Cnil) |
if (PRINTreadably || length == Cnil) |
1631 |
PRINTlength = -1; |
PRINTlength = -1; |
1632 |
else if (type_of(length) != t_fixnum || fix((length)) < 0) |
else if (type_of(length) != t_fixnum || fix((length)) < 0) |
1633 |
FEerror("~S is an illegal PRINT-LENGTH.", 1, length); |
FEerror("~S is an illegal PRINT-LENGTH.", 1, length); |
1634 |
else |
else |
1635 |
PRINTlength = fix((length)); |
PRINTlength = fix((length)); |
1636 |
PRINTarray = array != Cnil; |
PRINTarray = PRINTreadably || array != Cnil; |
1637 |
if (PRINTcircle) setupPRINTcircle(x,1); |
if (PRINTcircle) setupPRINTcircle(x,1); |
1638 |
if (PRINTpretty) { |
if (PRINTpretty) { |
1639 |
qh = qt = qc = 0; |
qh = qt = qc = 0; |
1672 |
WRITEC_NEWLINE(strm); |
WRITEC_NEWLINE(strm); |
1673 |
{SETUP_PRINT_DEFAULT(obj); |
{SETUP_PRINT_DEFAULT(obj); |
1674 |
PRINTstream = strm; |
PRINTstream = strm; |
1675 |
|
PRINTreadably = FALSE; |
1676 |
PRINTescape = TRUE; |
PRINTescape = TRUE; |
1677 |
PRINTpretty = TRUE; |
PRINTpretty = TRUE; |
1678 |
qh = qt = qc = 0; |
qh = qt = qc = 0; |
1810 |
DEF_ORDINARY("CAPITALIZE",sKcapitalize,KEYWORD,""); |
DEF_ORDINARY("CAPITALIZE",sKcapitalize,KEYWORD,""); |
1811 |
DEF_ORDINARY("STREAM",sKstream,KEYWORD,""); |
DEF_ORDINARY("STREAM",sKstream,KEYWORD,""); |
1812 |
DEF_ORDINARY("ESCAPE",sKescape,KEYWORD,""); |
DEF_ORDINARY("ESCAPE",sKescape,KEYWORD,""); |
1813 |
|
DEF_ORDINARY("READABLY",sKreadably,KEYWORD,""); |
1814 |
DEF_ORDINARY("PRETTY",sKpretty,KEYWORD,""); |
DEF_ORDINARY("PRETTY",sKpretty,KEYWORD,""); |
1815 |
DEF_ORDINARY("CIRCLE",sKcircle,KEYWORD,""); |
DEF_ORDINARY("CIRCLE",sKcircle,KEYWORD,""); |
1816 |
DEF_ORDINARY("BASE",sKbase,KEYWORD,""); |
DEF_ORDINARY("BASE",sKbase,KEYWORD,""); |
1821 |
DEF_ORDINARY("LENGTH",sKlength,KEYWORD,""); |
DEF_ORDINARY("LENGTH",sKlength,KEYWORD,""); |
1822 |
DEF_ORDINARY("ARRAY",sKarray,KEYWORD,""); |
DEF_ORDINARY("ARRAY",sKarray,KEYWORD,""); |
1823 |
DEFVAR("*PRINT-ESCAPE*",sLAprint_escapeA,LISP,Ct,""); |
DEFVAR("*PRINT-ESCAPE*",sLAprint_escapeA,LISP,Ct,""); |
1824 |
|
DEFVAR("*PRINT-READABLY*",sLAprint_readablyA,LISP,Ct,""); |
1825 |
DEFVAR("*PRINT-PRETTY*",sLAprint_prettyA,LISP,Ct,""); |
DEFVAR("*PRINT-PRETTY*",sLAprint_prettyA,LISP,Ct,""); |
1826 |
DEFVAR("*PRINT-CIRCLE*",sLAprint_circleA,LISP,Cnil,""); |
DEFVAR("*PRINT-CIRCLE*",sLAprint_circleA,LISP,Cnil,""); |
1827 |
DEFVAR("*PRINT-BASE*",sLAprint_baseA,LISP,make_fixnum(10),""); |
DEFVAR("*PRINT-BASE*",sLAprint_baseA,LISP,make_fixnum(10),""); |
1848 |
|
|
1849 |
PRINTstream = Cnil; |
PRINTstream = Cnil; |
1850 |
enter_mark_origin(&PRINTstream); |
enter_mark_origin(&PRINTstream); |
1851 |
|
PRINTreadably = FALSE; |
1852 |
PRINTescape = TRUE; |
PRINTescape = TRUE; |
1853 |
PRINTpretty = FALSE; |
PRINTpretty = FALSE; |
1854 |
PRINTcircle = FALSE; |
PRINTcircle = FALSE; |
1885 |
case t_string: |
case t_string: |
1886 |
case t_character: |
case t_character: |
1887 |
PRINTstream = strm; |
PRINTstream = strm; |
1888 |
|
PRINTreadably = FALSE; |
1889 |
PRINTescape = FALSE; |
PRINTescape = FALSE; |
1890 |
write_ch_fun = writec_PRINTstream; |
write_ch_fun = writec_PRINTstream; |
1891 |
write_object(obj, 0); |
write_object(obj, 0); |
1894 |
default: |
default: |
1895 |
{SETUP_PRINT_DEFAULT(obj); |
{SETUP_PRINT_DEFAULT(obj); |
1896 |
PRINTstream = strm; |
PRINTstream = strm; |
1897 |
|
PRINTreadably = FALSE; |
1898 |
PRINTescape = FALSE; |
PRINTescape = FALSE; |
1899 |
write_object(obj, 0); |
write_object(obj, 0); |
1900 |
CLEANUP_PRINT_DEFAULT;} |
CLEANUP_PRINT_DEFAULT;} |
1920 |
case t_string: |
case t_string: |
1921 |
case t_character: |
case t_character: |
1922 |
PRINTstream = strm; |
PRINTstream = strm; |
1923 |
|
PRINTreadably = FALSE; |
1924 |
PRINTescape = TRUE; |
PRINTescape = TRUE; |
1925 |
write_ch_fun = writec_PRINTstream; |
write_ch_fun = writec_PRINTstream; |
1926 |
write_object(obj, 0); |
write_object(obj, 0); |
1929 |
default: |
default: |
1930 |
{SETUP_PRINT_DEFAULT(obj); |
{SETUP_PRINT_DEFAULT(obj); |
1931 |
PRINTstream = strm; |
PRINTstream = strm; |
1932 |
|
PRINTreadably = FALSE; |
1933 |
PRINTescape = TRUE; |
PRINTescape = TRUE; |
1934 |
write_object(obj, 0); |
write_object(obj, 0); |
1935 |
CLEANUP_PRINT_DEFAULT;} |
CLEANUP_PRINT_DEFAULT;} |