70 |
|
|
71 |
extern object coerce_stream(object,int); |
extern object coerce_stream(object,int); |
72 |
|
|
73 |
|
void |
74 |
|
flush_queue(int); |
75 |
|
|
76 |
|
void |
77 |
writec_queue(c) |
writec_queue(c) |
78 |
int c; |
int c; |
79 |
{ |
{ |
86 |
qc++; |
qc++; |
87 |
} |
} |
88 |
|
|
89 |
flush_queue(force) |
void |
90 |
|
flush_queue(int force) |
91 |
{ |
{ |
92 |
int c, i, j, k, l, i0; |
int c, i, j, k, l, i0; |
93 |
|
|
95 |
while (qc > 0) { |
while (qc > 0) { |
96 |
c = queue[qh]; |
c = queue[qh]; |
97 |
if (c == MARK) |
if (c == MARK) |
98 |
goto DO_MARK; |
goto MDO_MARK; |
99 |
else if (c == UNMARK) |
else if (c == UNMARK) |
100 |
isp -= 2; |
isp -= 2; |
101 |
else if (c == SET_INDENT) |
else if (c == SET_INDENT) |
102 |
indent_stack[isp] = file_column(PRINTstream); |
indent_stack[isp] = file_column(PRINTstream); |
103 |
else if (c == INDENT) { |
else if (c == INDENT) { |
104 |
goto DO_INDENT; |
goto MDO_INDENT; |
105 |
} else if (c == INDENT1) { |
} else if (c == INDENT1) { |
106 |
i = file_column(PRINTstream)-indent_stack[isp]; |
i = file_column(PRINTstream)-indent_stack[isp]; |
107 |
if (i < 8 && indent_stack[isp] < LINE_LENGTH/2) { |
if (i < 8 && indent_stack[isp] < LINE_LENGTH/2) { |
113 |
indent_stack[isp] |
indent_stack[isp] |
114 |
= indent_stack[isp-1] + 4; |
= indent_stack[isp-1] + 4; |
115 |
} |
} |
116 |
goto DO_INDENT; |
goto MDO_INDENT; |
117 |
} |
} |
118 |
} else if (c == INDENT2) { |
} else if (c == INDENT2) { |
119 |
indent_stack[isp] = indent_stack[isp-1] + 2; |
indent_stack[isp] = indent_stack[isp-1] + 2; |
125 |
} |
} |
126 |
return; |
return; |
127 |
|
|
128 |
DO_MARK: |
MDO_MARK: |
129 |
k = LINE_LENGTH - 1 - file_column(PRINTstream); |
k = LINE_LENGTH - 1 - file_column(PRINTstream); |
130 |
for (i = 1, j = 0, l = 1; l > 0 && i < qc && j < k; i++) { |
for (i = 1, j = 0, l = 1; l > 0 && i < qc && j < k; i++) { |
131 |
c = queue[mod(qh + i)]; |
c = queue[mod(qh + i)]; |
150 |
indent_stack[isp] = indent_stack[isp-1]; |
indent_stack[isp] = indent_stack[isp-1]; |
151 |
goto BEGIN; |
goto BEGIN; |
152 |
|
|
153 |
DO_INDENT: |
MDO_INDENT: |
154 |
if (iisp > isp) |
if (iisp > isp) |
155 |
goto PUT_INDENT; |
goto PUT_INDENT; |
156 |
k = LINE_LENGTH - 1 - file_column(PRINTstream); |
k = LINE_LENGTH - 1 - file_column(PRINTstream); |
211 |
goto BEGIN; |
goto BEGIN; |
212 |
} |
} |
213 |
|
|
214 |
|
void |
215 |
writec_PRINTstream(c) |
writec_PRINTstream(c) |
216 |
int c; |
int c; |
217 |
{ |
{ |
221 |
writec_stream(c, PRINTstream); |
writec_stream(c, PRINTstream); |
222 |
} |
} |
223 |
|
|
224 |
|
void |
225 |
write_str(s) |
write_str(s) |
226 |
char *s; |
char *s; |
227 |
{ |
{ |
229 |
write_ch(*s++); |
write_ch(*s++); |
230 |
} |
} |
231 |
|
|
232 |
|
void |
233 |
|
write_decimal1(int); |
234 |
|
|
235 |
|
void |
236 |
write_decimal(i) |
write_decimal(i) |
237 |
int i; |
int i; |
238 |
{ |
{ |
243 |
write_decimal1(i); |
write_decimal1(i); |
244 |
} |
} |
245 |
|
|
246 |
|
void |
247 |
write_decimal1(i) |
write_decimal1(i) |
248 |
int i; |
int i; |
249 |
{ |
{ |
253 |
write_ch(i%10 + '0'); |
write_ch(i%10 + '0'); |
254 |
} |
} |
255 |
|
|
256 |
|
void |
257 |
write_addr(x) |
write_addr(x) |
258 |
object x; |
object x; |
259 |
{ |
{ |
270 |
} |
} |
271 |
} |
} |
272 |
|
|
273 |
write_base() |
void |
274 |
|
write_base(void) |
275 |
{ |
{ |
276 |
if (PRINTbase == 2) |
if (PRINTbase == 2) |
277 |
write_str("#b"); |
write_str("#b"); |
301 |
|
|
302 |
object sSAprint_nansA; |
object sSAprint_nansA; |
303 |
|
|
304 |
|
void |
305 |
edit_double(n, d, sp, s, ep) |
edit_double(n, d, sp, s, ep) |
306 |
int n; |
int n; |
307 |
double d; |
double d; |
373 |
s[n] = '\0'; |
s[n] = '\0'; |
374 |
} |
} |
375 |
|
|
376 |
|
void |
377 |
write_double(d, e, shortp) |
write_double(d, e, shortp) |
378 |
double d; |
double d; |
379 |
int e; |
int e; |
451 |
write_decimal(exp); |
write_decimal(exp); |
452 |
} |
} |
453 |
|
|
454 |
|
void |
455 |
call_structure_print_function(x, level) |
call_structure_print_function(x, level) |
456 |
object x; |
object x; |
457 |
int level; |
int level; |
460 |
bool eflag; |
bool eflag; |
461 |
bds_ptr old_bds_top; |
bds_ptr old_bds_top; |
462 |
|
|
463 |
int (*wf)() = write_ch_fun; |
void (*wf)(int) = write_ch_fun; |
464 |
|
|
465 |
object *vt = PRINTvs_top; |
object *vt = PRINTvs_top; |
466 |
object *vl = PRINTvs_limit; |
object *vl = PRINTvs_limit; |
537 |
|
|
538 |
ifuncall3(S_DATA(x->str.str_def)->print_function, |
ifuncall3(S_DATA(x->str.str_def)->print_function, |
539 |
x, PRINTstream, vs_head); |
x, PRINTstream, vs_head); |
540 |
vs_pop; |
vs_popp; |
541 |
eflag = FALSE; |
eflag = FALSE; |
542 |
|
|
543 |
L: |
L: |
582 |
object copy_big(); |
object copy_big(); |
583 |
object coerce_big_to_string(object,int); |
object coerce_big_to_string(object,int); |
584 |
|
|
585 |
|
bool |
586 |
|
potential_number_p(object,int); |
587 |
|
|
588 |
|
void |
589 |
write_object(x, level) |
write_object(x, level) |
590 |
object x; |
object x; |
591 |
int level; |
int level; |
631 |
PRINTradix = FALSE; |
PRINTradix = FALSE; |
632 |
write_object(x, level); |
write_object(x, level); |
633 |
PRINTradix = i; |
PRINTradix = i; |
634 |
vs_pop; |
vs_popp; |
635 |
if (PRINTradix && PRINTbase == 10) |
if (PRINTradix && PRINTbase == 10) |
636 |
write_ch('.'); |
write_ch('.'); |
637 |
break; |
break; |
766 |
j = x->s.s_self[i]; |
j = x->s.s_self[i]; |
767 |
if (isUpper(j)) { |
if (isUpper(j)) { |
768 |
if (PRINTcase == sKdowncase || |
if (PRINTcase == sKdowncase || |
769 |
PRINTcase == sKcapitalize && i!=lw) |
(PRINTcase == sKcapitalize && i!=lw)) |
770 |
j += 'a' - 'A'; |
j += 'a' - 'A'; |
771 |
} else if (!isLower(j)) |
} else if (!isLower(j)) |
772 |
lw = i + 1; |
lw = i + 1; |
820 |
if (k == 0) { |
if (k == 0) { |
821 |
if (isUpper(j)) { |
if (isUpper(j)) { |
822 |
if (PRINTcase == sKdowncase || |
if (PRINTcase == sKdowncase || |
823 |
PRINTcase == sKcapitalize && i!=lw) |
(PRINTcase == sKcapitalize && i!=lw)) |
824 |
j += 'a' - 'A'; |
j += 'a' - 'A'; |
825 |
} else if (!isLower(j)) |
} else if (!isLower(j)) |
826 |
lw = i + 1; |
lw = i + 1; |
861 |
if (k == 0) { |
if (k == 0) { |
862 |
if (isUpper(j)) { |
if (isUpper(j)) { |
863 |
if (PRINTcase == sKdowncase || |
if (PRINTcase == sKdowncase || |
864 |
PRINTcase == sKcapitalize && i != lw) |
(PRINTcase == sKcapitalize && i != lw)) |
865 |
j += 'a' - 'A'; |
j += 'a' - 'A'; |
866 |
} else if (!isLower(j)) |
} else if (!isLower(j)) |
867 |
lw = i + 1; |
lw = i + 1; |
945 |
if (n == x->a.a_rank) { |
if (n == x->a.a_rank) { |
946 |
vs_push(aref(x, m)); |
vs_push(aref(x, m)); |
947 |
write_object(vs_head, level+n); |
write_object(vs_head, level+n); |
948 |
vs_pop; |
vs_popp; |
949 |
} else |
} else |
950 |
write_ch('#'); |
write_ch('#'); |
951 |
j = n-1; |
j = n-1; |
1007 |
} |
} |
1008 |
vs_push(aref(x, 0)); |
vs_push(aref(x, 0)); |
1009 |
write_object(vs_head, level+1); |
write_object(vs_head, level+1); |
1010 |
vs_pop; |
vs_popp; |
1011 |
for (i = 1; i < x->v.v_fillp; i++) { |
for (i = 1; i < x->v.v_fillp; i++) { |
1012 |
write_ch(INDENT); |
write_ch(INDENT); |
1013 |
if (PRINTlength>=0 && i>=PRINTlength){ |
if (PRINTlength>=0 && i>=PRINTlength){ |
1016 |
} |
} |
1017 |
vs_push(aref(x, i)); |
vs_push(aref(x, i)); |
1018 |
write_object(vs_head, level+1); |
write_object(vs_head, level+1); |
1019 |
vs_pop; |
vs_popp; |
1020 |
} |
} |
1021 |
} |
} |
1022 |
write_ch(')'); |
write_ch(')'); |
1289 |
fix(y) = x->rnd.rnd_value; |
fix(y) = x->rnd.rnd_value; |
1290 |
vs_push(y); |
vs_push(y); |
1291 |
write_object(y, level); |
write_object(y, level); |
1292 |
vs_pop; |
vs_popp; |
1293 |
break; |
break; |
1294 |
|
|
1295 |
case t_structure: |
case t_structure: |
1323 |
x = structure_to_list(x); |
x = structure_to_list(x); |
1324 |
vs_push(x); |
vs_push(x); |
1325 |
write_object(x, level); |
write_object(x, level); |
1326 |
vs_pop; |
vs_popp; |
1327 |
break; |
break; |
1328 |
} |
} |
1329 |
call_structure_print_function(x, level); |
call_structure_print_function(x, level); |
1341 |
write_ch('p'); |
write_ch('p'); |
1342 |
vs_push(namestring(x)); |
vs_push(namestring(x)); |
1343 |
write_object(vs_head, level); |
write_object(vs_head, level); |
1344 |
vs_pop; |
vs_popp; |
1345 |
} else { |
} else { |
1346 |
write_str("#<pathname "); |
write_str("#<pathname "); |
1347 |
write_addr(x); |
write_addr(x); |
1390 |
|
|
1391 |
char travel_push_type[32]; |
char travel_push_type[32]; |
1392 |
|
|
1393 |
|
void |
1394 |
travel_push_object(x) |
travel_push_object(x) |
1395 |
object x; |
object x; |
1396 |
{ |
{ |
1430 |
} |
} |
1431 |
} |
} |
1432 |
|
|
1433 |
|
void |
|
|
|
1434 |
setupPRINTcircle(x,dogensyms) |
setupPRINTcircle(x,dogensyms) |
1435 |
object x; |
object x; |
1436 |
int dogensyms; |
int dogensyms; |
1448 |
PRINTvs_limit = vs_top = vq; |
PRINTvs_limit = vs_top = vq; |
1449 |
} |
} |
1450 |
|
|
1451 |
|
void |
1452 |
setupPRINTdefault(x) |
setupPRINTdefault(x) |
1453 |
object x; |
object x; |
1454 |
{ |
{ |
1455 |
object y; |
object y; |
|
object *vp, *vq; |
|
1456 |
|
|
1457 |
PRINTvs_top = vs_top; |
PRINTvs_top = vs_top; |
1458 |
PRINTstream = symbol_value(sLAstandard_outputA); |
PRINTstream = symbol_value(sLAstandard_outputA); |
1512 |
PRINTstructure = symbol_value(sSAprint_structureA) != Cnil; |
PRINTstructure = symbol_value(sSAprint_structureA) != Cnil; |
1513 |
} |
} |
1514 |
|
|
1515 |
cleanupPRINT() |
void |
1516 |
|
cleanupPRINT(void) |
1517 |
{ |
{ |
1518 |
vs_top = PRINTvs_top; |
vs_top = PRINTvs_top; |
1519 |
if (PRINTpretty) |
if (PRINTpretty) |
1520 |
flush_queue(TRUE); |
flush_queue(TRUE); |
1521 |
} |
} |
1522 |
|
|
1523 |
|
void |
1524 |
write_object_by_default(x) |
write_object_by_default(x) |
1525 |
object x; |
object x; |
1526 |
{ |
{ |
1530 |
CLEANUP_PRINT_DEFAULT; |
CLEANUP_PRINT_DEFAULT; |
1531 |
} |
} |
1532 |
|
|
1533 |
|
void |
1534 |
terpri_by_default() |
terpri_by_default() |
1535 |
{ |
{ |
1536 |
PRINTstream = symbol_value(sLAstandard_outputA); |
PRINTstream = symbol_value(sLAstandard_outputA); |
1587 |
((:case cas) `symbol_value(sLAprint_caseA)`) |
((:case cas) `symbol_value(sLAprint_caseA)`) |
1588 |
(gensym `symbol_value(sLAprint_gensymA)`) |
(gensym `symbol_value(sLAprint_gensymA)`) |
1589 |
(array `symbol_value(sLAprint_arrayA)`)) |
(array `symbol_value(sLAprint_arrayA)`)) |
|
object *vp, *vq; |
|
1590 |
struct printStruct printStructBuf; |
struct printStruct printStructBuf; |
1591 |
struct printStruct *old_printStructBufp = printStructBufp; |
struct printStruct *old_printStructBufp = printStructBufp; |
1592 |
@ |
@ |
1824 |
DEFVAR("*PRINT-STRUCTURE*",sSAprint_structureA,SI,Cnil,""); |
DEFVAR("*PRINT-STRUCTURE*",sSAprint_structureA,SI,Cnil,""); |
1825 |
DEF_ORDINARY("PRETTY-PRINT-FORMAT",sSpretty_print_format,SI,""); |
DEF_ORDINARY("PRETTY-PRINT-FORMAT",sSpretty_print_format,SI,""); |
1826 |
|
|
1827 |
|
void |
1828 |
init_print() |
init_print() |
1829 |
{ |
{ |
1830 |
|
|
1948 |
return(Cnil); |
return(Cnil); |
1949 |
} |
} |
1950 |
|
|
1951 |
|
void |
1952 |
write_string(strng, strm) |
write_string(strng, strm) |
1953 |
object strng, strm; |
object strng, strm; |
1954 |
{ |
{ |
1968 |
/* |
/* |
1969 |
THE ULTRA-SPECIAL-DINNER-SERVICE OPTIMIZATION |
THE ULTRA-SPECIAL-DINNER-SERVICE OPTIMIZATION |
1970 |
*/ |
*/ |
1971 |
|
void |
1972 |
princ_str(s, sym) |
princ_str(s, sym) |
1973 |
char *s; |
char *s; |
1974 |
object sym; |
object sym; |
1982 |
writestr_stream(s, sym); |
writestr_stream(s, sym); |
1983 |
} |
} |
1984 |
|
|
1985 |
|
void |
1986 |
princ_char(c, sym) |
princ_char(c, sym) |
1987 |
int c; |
int c; |
1988 |
object sym; |
object sym; |
2002 |
} |
} |
2003 |
|
|
2004 |
|
|
2005 |
|
void |
2006 |
pp(x) |
pp(x) |
2007 |
object x; |
object x; |
2008 |
{ |
{ |
2010 |
flush_stream(symbol_value(sLAstandard_outputA)); |
flush_stream(symbol_value(sLAstandard_outputA)); |
2011 |
} |
} |
2012 |
|
|
2013 |
|
object |
2014 |
set_line_length(n) |
set_line_length(n) |
2015 |
int n; |
int n; |
2016 |
{ |
{ |
2017 |
return line_length = n; |
return make_fixnum(line_length = n); |
2018 |
} |
} |
2019 |
|
|
2020 |
DEFVAR("*PRINT-NANS*",sSAprint_nansA,SI,Cnil,""); |
DEFVAR("*PRINT-NANS*",sSAprint_nansA,SI,Cnil,""); |
2021 |
|
|
2022 |
|
void |
2023 |
init_print_function() |
init_print_function() |
2024 |
{ |
{ |
2025 |
make_function("WRITE", Lwrite); |
make_function("WRITE", Lwrite); |