1 /*
2 * $Id: ascio.c,v 1.8 2010-07-03 19:42:31 dhmunro Exp $
3 * Define standard Yorick built-in functions for ASCII I/O
4 *
5 * See std.i for documentation on the interface functions defined here.
6 */
7 /* Copyright (c) 2005, The Regents of the University of California.
8 * All rights reserved.
9 * This file is part of yorick (http://yorick.sourceforge.net).
10 * Read the accompanying LICENSE file for details.
11 */
12
13 #include "ydata.h"
14 #include "yio.h"
15 #include "defmem.h"
16 #include "pstdlib.h"
17 #include "play.h"
18 #include <string.h>
19 #include <errno.h>
20
21 extern BuiltIn Y_open, Y_close, Y_read, Y_write, Y_sread, Y_swrite;
22 extern BuiltIn Y_rdline, Y_bookmark, Y_backup, Y_popen, Y_fflush;
23 extern BuiltIn Y_filepath;
24
25 extern char *MakeErrorLine(long lineNumber, const char *filename);
26
27 extern void YErrorIO(const char *msg);
28
29 /*--------------------------------------------------------------------------*/
30
31 static char *CheckBuf(long len);
32 static char *CrackScan(char *format);
33 static char *CrackPrint(char *format);
34 static int CrackFormat(char *format, char *(*Cracker)(char *));
35 static void AddFormat(char *format, int type, int danger);
36 static void FreeFormats(void);
37 static void CheckOps(int nArgs);
38 static char *NextInLine(Operand *op, long n);
39 static void ReadWorker(Operand *sourceOp, Symbol *stack, char *format,
40 Symbol *stack0);
41 static void WriteWorker(Operand *sinkOp, Symbol *stack, char *format);
42 static char *CheckOut(long len);
43
44 static char *fmtBuf= 0;
45 static long fmtLen= 0;
46 static int fmtType;
47 #define IO_NONE 0
48 #define IO_STRING 1
49 #define IO_LONG 2
50 #define IO_DOUBLE 3
51 #define IO_POINTER 4
52 #define IO_CHAR 5
53
54 struct FormatList { char *format; int type; int typeID; int danger; };
55 static struct FormatList *fmtList= 0;
56 static long fmtMax= 0;
57 static long fmtNow= 0;
58
59 static long fmtAssigns;
60 static long fmtWidth, fmtTotal;
61 static int fmtDanger;
62
63 struct io_operand {
64 Operand o;
65 Symbol s;
66 };
67 static struct io_operand *ioOps= 0;
68 static long maxIOops= 0;
69
70 static int typeMatch[]= { IO_LONG, IO_LONG, IO_LONG, IO_LONG,
71 IO_DOUBLE, IO_DOUBLE, IO_NONE, IO_STRING, IO_POINTER };
72 static char *scanDefaults[]= { 0, "%s%n", "%ld%n", "%le%n" };
73 static char *printDefaults[]= { 0, " %s", " %8ld", " %#14.6g", " %8p" };
74
75 typedef int ScanFunc(Operand *op, char *format, char **text);
76 static ScanFunc CScanner, SScanner, IScanner, LScanner,
77 FScanner, DScanner, QScanner, NilScanner;
78 static ScanFunc *Scanner[]= { &CScanner, &SScanner, &IScanner, &LScanner,
79 &FScanner, &DScanner, 0, &QScanner, &NilScanner };
80
81 static YgetsLine inputBuffer= { 0, 0, 0 };
82
83 static Dimension *pDims= 0;
84 static char *outBuf= 0;
85 static long outLen= 0;
86 static long lineSize;
87
88 typedef void PrtFunc(Operand *op, char *format, char *text);
89 static PrtFunc CPrinter, SPrinter, IPrinter, LPrinter,
90 FPrinter, DPrinter, QPrinter, PPrinter;
91 static PrtFunc *Printer[]= { &CPrinter, &SPrinter, &IPrinter, &LPrinter,
92 &FPrinter, &DPrinter, 0, &QPrinter, &PPrinter };
93 static PrtFunc CPrintC, SPrintC, IPrintC, LPrintC;
94 static PrtFunc *PrintC[]= { &CPrintC, &SPrintC, &IPrintC, &LPrintC };
95 static PrtFunc FPrintD, DPrintD;
96 static PrtFunc *PrintD[]= { &FPrintD, &DPrintD };
97
98 /*--------------------------------------------------------------------------*/
99
100 /* Two data types which are "foreign" to Yorick are defined in this
101 file: the TextStream and the Bookmark. */
102
103 static UnaryOp PrintBM, PrintTX;
104
105 /* Implement text streams as a foreign Yorick data type. */
106 struct TextStream {
107 int references; /* reference counter */
108 Operations *ops; /* virtual function table */
109 p_file *stream; /* 0 indicates file has been closed */
110 char *fullname; /* filename after YExpandName */
111 int permissions; /* +1 read permission, +2 write permission
112 +4 append mode, +8 binary mode,
113 +16 not seekable, +32 pipe */
114 /* ------ begin specific text stream part ------- */
115 long lastLineRead; /* 1-origin line number of last line read */
116 long readPosition; /* file position (ftell) after lastLineRead */
117 long lastPosition; /* file position (ftell) before lastLineRead --
118 after backup, lastPosition==readPosition,
119 and lastPosition is not valid */
120 int readWrite; /* 0 initially, 1 after read, 2 after write */
121 long fileID; /* unique number used to recognize this file */
122 };
123
124 extern TextStream *NewTextStream(char *fullname,
125 void *stream, int permissions,
126 long line, long pos);
127 extern void FreeTextStream(void *ts); /* ******* Use Unref(ts) ******* */
128
129 Operations textOps = {
130 &FreeTextStream, T_OPAQUE, 0, T_STRING, "text_stream",
131 {&PromXX, &PromXX, &PromXX, &PromXX, &PromXX, &PromXX, &PromXX, &PromXX},
132 &ToAnyX, &ToAnyX, &ToAnyX, &ToAnyX, &ToAnyX, &ToAnyX, &ToAnyX,
133 &NegateX, &ComplementX, &NotX, &TrueX,
134 &AddX, &SubtractX, &MultiplyX, &DivideX, &ModuloX, &PowerX,
135 &EqualX, &NotEqualX, &GreaterX, &GreaterEQX,
136 &ShiftLX, &ShiftRX, &OrX, &AndX, &XorX,
137 &AssignX, &EvalX, &SetupX, &GetMemberX, &MatMultX, &PrintTX
138 };
139
140 /* Implement bookmarks as a foreign Yorick data type. */
141 typedef struct Bookmark Bookmark;
142 struct Bookmark {
143 int references; /* reference counter */
144 Operations *ops; /* virtual function table */
145 long lastLineRead;
146 long lastPosition, readPosition;
147 long fileID;
148 };
149
150 extern Bookmark *NewBookmark(long line, long last, long next, long id);
151 extern void FreeBookmark(void *bm); /* ******* Use Unref(bm) ******* */
152
153 Operations bookOps = {
154 &FreeBookmark, T_OPAQUE, 0, T_STRING, "bookmark",
155 {&PromXX, &PromXX, &PromXX, &PromXX, &PromXX, &PromXX, &PromXX, &PromXX},
156 &ToAnyX, &ToAnyX, &ToAnyX, &ToAnyX, &ToAnyX, &ToAnyX, &ToAnyX,
157 &NegateX, &ComplementX, &NotX, &TrueX,
158 &AddX, &SubtractX, &MultiplyX, &DivideX, &ModuloX, &PowerX,
159 &EqualX, &NotEqualX, &GreaterX, &GreaterEQX,
160 &ShiftLX, &ShiftRX, &OrX, &AndX, &XorX,
161 &AssignX, &EvalX, &SetupX, &GetMemberX, &MatMultX, &PrintBM
162 };
163
164 /*--------------------------------------------------------------------------*/
165
Y_open(int nArgs)166 void Y_open(int nArgs)
167 {
168 Symbol *stack= sp-nArgs+1;
169 char *filename, *fmode, *fullname, filemode[8];
170 int errmode, permissions;
171 p_file *file;
172
173 if (nArgs<1 || nArgs>3) YError("bad argument list to open function");
174 filename= YGetString(stack);
175 if (nArgs<2) fmode= 0;
176 else fmode= YGetString(stack+1);
177 if (nArgs<3) errmode= 0;
178 else errmode= YGetInteger(stack+2);
179
180 memset(filemode, 0, 8);
181 if (!fmode || !fmode[0])
182 strcpy(filemode, "r");
183 else if (fmode[0]!='r' && fmode[0]!='w' && fmode[0]!='a')
184 YError("2nd argument to open must begin with r, w, or a");
185 else
186 strncat(filemode, fmode, 7);
187 if (filemode[0]=='r') permissions= 1;
188 else if (filemode[0]=='w') permissions= 2;
189 else permissions= 6;
190 if (filemode[1]=='+' || filemode[2]=='+') permissions|= 3;
191 if (filemode[1]=='b' || filemode[2]=='b') {
192 permissions|= 8;
193 if (filemode[2]=='c') {
194 if (permissions&2) permissions|= 64;
195 filemode[2]= '\0';
196 } else if (filemode[3]=='c') {
197 if (permissions&2) permissions|= 64;
198 filemode[3]= '\0';
199 }
200 }
201
202 fullname= YExpandName(filename);
203 file= p_fopen(fullname, filemode);
204
205 if (file) {
206 /* set permission bits and push result IOStream */
207 if (permissions&8) {
208 IOStream *ios= NewIOStream(fullname, file, permissions);
209 PushDataBlock(ios);
210 if (permissions&64) CLupdate(ios);
211 } else {
212 PushDataBlock(NewTextStream(fullname, file, permissions, 0L, 0L));
213 }
214
215 } else if (errmode) {
216 /* fail silently if optional errmode flag is set */
217 p_free(fullname);
218 permissions= 0;
219 PushDataBlock(RefNC(&nilDB));
220
221 } else {
222 /* blow up if optional errmode flag is not set */
223 char *dots= strlen(filename)>100? "..." : "";
224 char message[140];
225 p_free(fullname);
226 sprintf(message, "cannot open file %.100s%s (mode %.6s)",
227 filename, dots, filemode);
228 YErrorIO(message);
229 return;
230 }
231
232 PopTo(sp-nArgs-1);
233 Drop(nArgs);
234 return;
235 }
236
237 PLUG_API int psckt_0close(void); /* from socky.c */
238
Y_close(int nArgs)239 void Y_close(int nArgs)
240 {
241 DataBlock *db;
242 IOStream *binary= 0;
243 long index = -1;
244 if (nArgs!=1) YError("close function takes exactly one argument");
245
246 /* If argument is a simple variable reference, nil the variable. */
247 if (sp->ops==&referenceSym) {
248 Symbol *s= &globTab[(index = sp->index)];
249 ReplaceRef(sp);
250 if (s->ops==&dataBlockSym &&
251 (s->value.db->ops==&textOps || s->value.db->ops==&streamOps)) {
252 s->ops= &intScalar;
253 Unref(s->value.db);
254 s->value.db= RefNC(&nilDB);
255 s->ops= &dataBlockSym;
256 }
257 }
258 db= sp->value.db;
259
260 if (db->ops==&textOps) {
261 TextStream *text= (TextStream *)db;
262 if (text->stream)
263 p_fclose(text->stream);
264 text->stream= 0;
265 } else if (db->ops==&streamOps) {
266 /* Make sure that the binary->stream gets closed, even if the IOStream
267 itself is not freed by the Drop() below. */
268 if (db->references) binary= (IOStream *)db;
269 } else if (db->ops!=&voidOps) {
270 if (psckt_0close())
271 YError("bad argument type to close function");
272 if (index >= 0) {
273 ypush_nil();
274 yput_global(index, 0);
275 yarg_drop(1);
276 }
277 yarg_drop(1);
278 ypush_nil();
279 return;
280 }
281
282 if (db->references && db->ops!=&voidOps) {
283 char message[80];
284 sprintf(message, "%d outstanding references to closed file",
285 db->references);
286 YWarning(message);
287 }
288
289 Drop(1);
290 if (binary) {
291 HistoryInfo *history = binary->history;
292 ClearPointees(binary, 0);
293 if (history) {
294 IOStream *child = history->child;
295 ClearPointees(child, 0);
296 if (child->CloseHook) {
297 child->CloseHook(child);
298 child->CloseHook = 0;
299 }
300 if (child->stream) {
301 if (child->stream == binary->stream) FlushFile(child, 1);
302 else if (child->stream) child->ioOps->Close(child);
303 child->stream = 0;
304 }
305 if (child->contentsLog != binary->contentsLog) FreeClogFile(child);
306 } else if (binary->CloseHook) {
307 binary->CloseHook(binary);
308 binary->CloseHook = 0;
309 }
310 if (binary->stream) binary->ioOps->Close(binary);
311 binary->stream = 0;
312 if (binary->contentsLog) FreeClogFile(binary);
313 }
314 ypush_nil();
315 }
316
Y_filepath(int argc)317 void Y_filepath(int argc)
318 {
319 Dimension *dims;
320 Operand op;
321 char **input, **output;
322 long i, n;
323
324 if (argc != 1) YError("filepath function takes exactly one argument");
325 op.ops= 0;
326 if (sp->ops) sp->ops->FormOperand(sp, &op);
327 if (op.ops == &stringOps) {
328 input = YGet_Q(sp, 0, &dims);
329 n = TotalNumber(dims);
330 output = ((Array *)PushDataBlock(NewArray(&stringStruct, dims)))->value.q;
331 for (i = 0; i < n; ++i) {
332 output[i] = (input[i] ? YExpandName(input[i]) : 0);
333 }
334 } else if (op.ops == &streamOps) {
335 output = ypush_q(0);
336 output[0] = p_strcpy(((IOStream *)op.value)->fullname);
337 } else if (op.ops == &textOps) {
338 output = ypush_q(0);
339 output[0] = p_strcpy(((TextStream *)op.value)->fullname);
340 } else if (op.ops == &voidOps) {
341 PushDataBlock(RefNC(&nilDB));
342 } else {
343 YError("bad argument: expecting text/binary file or file name(s)");
344 }
345 }
346
347 /*--------------------------------------------------------------------------*/
348
349 /* a read operation from the keyboard actually suspends the virtual
350 * machine until the next keyboard input event
351 * the pc is saved so that other interpreted tasks can run while waiting
352 * for keyboard input
353 */
354
355 extern void yr_reader(char *input_line);
356 extern Instruction *ym_suspend(void);
357 extern void ym_resume(Instruction *pc);
358 extern char *y_read_prompt;
359 extern int yp_continue;
360 char *y_read_prompt = 0;
361
362 static Instruction *yr_pc_resume= 0;
363 static char *yr_dflt_prompts[] = { "read> ", "" };
364 static char **yr_result = 0;
365 static long yr_n, yr_nlines;
366 static int yr_j, yr_nargs;
367
368 void
yr_reset(void)369 yr_reset(void)
370 {
371 int i;
372 char *prompt = y_read_prompt;
373 y_read_prompt = 0;
374 yr_pc_resume = 0;
375 if (prompt) p_free(prompt);
376 for (i=0 ; i<yr_nargs ; i++) {
377 if (ioOps[i].s.ops == &dataBlockSym) {
378 Unref(ioOps[i].s.value.db);
379 ioOps[i].s.value.db = 0;
380 } else if (ioOps[i].s.index >= 0) {
381 long index = ioOps[i].s.index;
382 if (globTab[index].ops == &dataBlockSym) {
383 /* scalar asynchronously redefined since ym_suspend */
384 globTab[index].ops = &intScalar;
385 Unref(globTab[index].value.db);
386 }
387 globTab[index] = ioOps[i].s;
388 }
389 }
390 yr_nargs = 0;
391 FreeFormats();
392 }
393
394 void
yr_reader(char * input_line)395 yr_reader(char *input_line)
396 {
397 if (yr_result) { /* rdline */
398 *yr_result++ = p_strcpy(input_line);
399 yr_n--;
400 } else if (yr_n > 0) { /* read */
401 yr_nlines++;
402 /* Scanner returns 0 if found, 1 if not found,
403 * sets input_line==0 on matching failure, which should abort read */
404 while (!Scanner[fmtList[yr_j].typeID](&ioOps[yr_j].o,
405 fmtList[yr_j].format,
406 &input_line)) {
407 yr_j++;
408 if (yr_j >= yr_nargs) {
409 yr_n--;
410 if (!yr_n) break;
411 yr_j = 0;
412 }
413 }
414 if (!input_line) yr_n = 0; /* halt on matching failure */
415 }
416 if (p_signalling) p_abort();
417 if (yr_n <= 0) {
418 ym_resume(yr_pc_resume);
419 /* read() returns count -- rdline() already pushed its result */
420 if (!yr_result && sp->ops==&longScalar) sp->value.l = fmtAssigns;
421 yr_reset();
422 }
423 }
424
Y_read(int nArgs)425 void Y_read(int nArgs)
426 {
427 Symbol *stack, *s;
428 char *format, *keyNames[3];
429 Symbol *keySymbols[2];
430 Operand sourceOp;
431 Symbol *stack0= sp-nArgs;
432
433 keyNames[0]= "format";
434 keyNames[1]= "prompt";
435 keyNames[2]= 0;
436 stack= YGetKeywords(stack0+1, nArgs, keyNames, keySymbols);
437
438 /* Get 1st argument if it is an IOStream or nil, otherwise will use
439 nil stream (keyboard). */
440 if (stack>sp) YError("read function takes at least one argument");
441 /* treat references gently -- don't want to suck reference to
442 scalar int, long, or double onto the stack */
443 if (stack->ops==&referenceSym) s= &globTab[stack->index];
444 else s= stack;
445 if (s->ops==&dataBlockSym &&
446 (s->value.db->ops==&textOps || s->value.db->ops==&voidOps)) {
447 stack->ops->FormOperand(stack, &sourceOp);
448 stack++;
449 if (sourceOp.ops==&voidOps) sourceOp.ops= 0;
450 else {
451 TextStream *ts= sourceOp.value;
452 p_file *file= ts->stream;
453 if (!file)
454 YErrorIO("attempt to read from closed I/O stream");
455 else if (!(ts->permissions & 1))
456 YErrorIO("attempt to read from file opened in w or a mode");
457 if (ts->readWrite&2 && p_fseek(file, ts->readPosition)) {
458 p_ferror(file); /* don't prejudice future I/O attempts */
459 YErrorIO("fseek failed to find current position in ASCII read");
460 }
461 ts->readWrite= 1;
462 }
463 } else {
464 sourceOp.ops= 0; /* special form recognized by NextInLine */
465 }
466 if (!sourceOp.ops) {
467 /* set prompt string for NextInLine. */
468 sourceOp.value=
469 keySymbols[1]? YGetString(keySymbols[1]) : yr_dflt_prompts[0];
470 if (!sourceOp.value) sourceOp.value= yr_dflt_prompts[1];
471 }
472
473 /* get format keyword, if any */
474 format= keySymbols[0]? YGetString(keySymbols[0]) : 0;
475
476 ReadWorker(&sourceOp, stack, format, stack0);
477 }
478
Y_sread(int nArgs)479 void Y_sread(int nArgs)
480 {
481 Symbol *stack;
482 char *format, *keyNames[2];
483 Symbol *keySymbols[1];
484 Operand sourceOp;
485
486 keyNames[0]= "format";
487 keyNames[1]= 0;
488 stack= YGetKeywords(sp-nArgs+1, nArgs, keyNames, keySymbols);
489
490 /* Get 1st argument if it is an IOStream or nil, otherwise will use
491 nil stream (keyboard). */
492 if (stack>sp) YError("sread function takes at least one argument");
493 stack->ops->FormOperand(stack, &sourceOp);
494 if (sourceOp.ops!=&stringOps)
495 YError("1st argument to sread must be source string or string array");
496 stack++;
497
498 /* get format keyword, if any */
499 format= keySymbols[0]? YGetString(keySymbols[0]) : 0;
500
501 ReadWorker(&sourceOp, stack, format, 0);
502 }
503
504 static void
ReadWorker(Operand * sourceOp,Symbol * stack,char * format,Symbol * stack0)505 ReadWorker(Operand *sourceOp, Symbol *stack, char *format, Symbol *stack0)
506 {
507 Symbol *s;
508 char *text;
509 Dimension *dims= 0;
510 Operand *op;
511 long i, number, lineCount;
512 int j, nConversions, nArgs, typeID;
513 int from_keybd = !sourceOp->ops;
514
515 /* crack format string */
516 nConversions= CrackFormat(format, &CrackScan);
517
518 /* First pass through arguments counts them, checks data types and
519 conformability, and matches them to conversions in the format list. */
520 CheckOps((int)(sp-stack+2));
521 nArgs= 0;
522 for ( ; stack<=sp ; stack++) {
523 if (!stack->ops) { /* skip keywords */
524 stack++;
525 continue;
526 }
527 if (stack->ops==&referenceSym &&
528 globTab[stack->index].ops!=&dataBlockSym) s= &globTab[stack->index];
529 else s= stack;
530 op= &ioOps[nArgs].o;
531 s->ops->FormOperand(s, op);
532 typeID= op->ops->typeID;
533 if (typeID>T_DOUBLE && typeID!=T_STRING)
534 YError("read cannot handle non-array, complex, pointer, or structure");
535 if (from_keybd) {
536 ioOps[nArgs].s.value.db = 0;
537 ioOps[nArgs].s.index = -1;
538 ioOps[nArgs].s.ops = ioOps[nArgs].o.owner->ops;
539 if (ioOps[nArgs].s.ops != &dataBlockSym) {
540 /* int, long, double scalars read directly into ioOps */
541 if (s!=stack) ioOps[nArgs].s.index = stack->index,
542 ioOps[nArgs].s.value = globTab[stack->index].value;
543 ioOps[nArgs].o.value = &ioOps[nArgs].s.value;
544 }
545 }
546 if (nArgs<nConversions) {
547 if (typeMatch[typeID]!=fmtList[nArgs].type)
548 YError("read format/read output data type mismatch");
549 } else if (!nArgs && !nConversions && fmtNow==1) {
550 format= fmtList[0].format;
551 fmtList[0].format= p_strncat(format, scanDefaults[typeMatch[typeID]], 0);
552 p_free(format);
553 } else {
554 AddFormat(scanDefaults[typeMatch[typeID]], typeMatch[typeID], 0);
555 }
556 fmtList[nArgs].typeID= typeID;
557 if (nArgs) {
558 Dimension *tmp= op->type.dims;
559 while (tmp && dims && tmp->number==dims->number) {
560 tmp= tmp->next;
561 dims= dims->next;
562 }
563 if (tmp || dims)
564 YError("all outputs from formatted read must have same dimensions");
565 }
566 dims= op->type.dims;
567 nArgs++;
568 }
569 number= TotalNumber(dims);
570
571 if (nArgs<fmtNow) {
572 /* must scan for matching junk after all arguments read */
573 fmtList[nArgs].typeID= 8; /* NilScanner */
574 i= strlen(fmtList[nArgs].format);
575 while (i && (fmtList[nArgs].format[i-1]=='\012' ||
576 fmtList[nArgs].format[i-1]=='\015' ||
577 fmtList[nArgs].format[i-1]==' '))
578 fmtList[nArgs].format[--i]= '\0'; /* strip off trailing newlines */
579 if (i) {
580 if (from_keybd) {
581 ioOps[nArgs].s.ops = 0;
582 ioOps[nArgs].s.index = -1;
583 }
584 nArgs++;
585 }
586 }
587
588 if (from_keybd) {
589 if (p_signalling) p_abort();
590 if (y_read_prompt)
591 YError("read() while waiting for read() or rdline()");
592 if (yp_continue)
593 YError("read() while waiting for continued input for parser");
594 yr_result = 0;
595 yr_n = number;
596 yr_j = 0;
597 yr_nargs = nArgs;
598 yr_nlines = fmtAssigns = 0;
599 y_read_prompt = p_strcpy(sourceOp->value);
600 PushLongValue(0); /* actual result filled in later */
601 /* get an extra use for result arrays so they will survive
602 * being dropped off stack */
603 for (j=0 ; j<nArgs ; j++)
604 if (ioOps[j].s.ops==&dataBlockSym)
605 ioOps[j].s.value.db = Ref(ioOps[j].o.owner->value.db);
606 yr_pc_resume = ym_suspend();
607 return;
608 }
609
610 /* outer loop is on input array elements */
611 lineCount= 0;
612 text= NextInLine(sourceOp, lineCount++);
613 fmtAssigns= 0;
614 for (i=0 ; i<number ; i++) {
615 if (p_signalling) p_abort();
616 /* inner loop is on arguments to be read */
617 for (j=0 ; j<nArgs ; j++) {
618 do {
619 while (text && !text[0]) text= NextInLine(sourceOp, lineCount++);
620 /* If input exhausted, NextInLine returns text==0.
621 * If matching failure, Scanner returns text==0. */
622
623 /* Scanner returns zero if object was found, non-zero if not
624 * found. The text pointer is advanced past the number of
625 * characters scanned, or set to zero if a matching failure
626 * occurred. */
627 } while (Scanner[fmtList[j].typeID](&ioOps[j].o, fmtList[j].format,
628 &text));
629 }
630 }
631
632 /* release excessive temporary space */
633 FreeFormats();
634
635 /* return total number of objects actually assigned */
636 PushLongValue(fmtAssigns);
637 }
638
Y_rdline(int nArgs)639 void Y_rdline(int nArgs)
640 {
641 Symbol *stack;
642 Operand op;
643 long i, nLines= 0;
644 Array *result;
645 Dimension *dims;
646 char *keyNames[2], *q;
647 Symbol *keySymbols[1];
648 Symbol *stack0= sp-nArgs;
649
650 keyNames[0]= "prompt";
651 keyNames[1]= 0;
652 stack= YGetKeywords(stack0+1, nArgs, keyNames, keySymbols);
653
654 for (nArgs=0 ; stack<=sp ; stack++) {
655 if (!stack->ops) {
656 stack++;
657 continue;
658 }
659 if (nArgs==1) nLines= YGetInteger(stack);
660 else if (nArgs==0) {
661 stack->ops->FormOperand(stack, &op);
662 if (op.ops!=&textOps && op.ops!=&voidOps)
663 YError("1st argument to rdline function not a text stream or nil");
664 } else {
665 YError("rdline function takes exactly one or two arguments");
666 }
667 nArgs++;
668 }
669
670 if (!nArgs || op.ops==&voidOps) op.ops= 0;
671 else {
672 TextStream *ts= op.value;
673 p_file *file= ts->stream;
674 if (!file)
675 YErrorIO("attempt to read from closed I/O stream");
676 else if (!(ts->permissions & 1))
677 YErrorIO("attempt to read from file opened in w or a mode");
678 if (ts->readWrite&2 && p_fseek(file, ts->readPosition)) {
679 p_ferror(file); /* don't prejudice future I/O attempts */
680 YErrorIO("fseek failed to find current position in ASCII read");
681 }
682 ts->readWrite= 1;
683 }
684 if (!op.ops) {
685 /* set prompt string for keyboard input */
686 op.value= keySymbols[0]? YGetString(keySymbols[0]) : yr_dflt_prompts[0];
687 if (!op.value) op.value= yr_dflt_prompts[1];
688 }
689
690 dims= tmpDims;
691 tmpDims= 0;
692 FreeDimension(dims);
693 if (nLines>0) tmpDims= NewDimension(nLines, 1L, tmpDims);
694 else nLines= 1;
695 result= PushDataBlock(NewArray(&stringStruct, tmpDims));
696
697 if (!op.ops) {
698 if (p_signalling) p_abort();
699 if (y_read_prompt)
700 YError("rdline() while waiting for read() or rdline()");
701 if (yp_continue)
702 YError("rdline() while waiting for continued input for parser");
703 yr_result = result->value.q;
704 yr_n = nLines;
705 y_read_prompt = p_strcpy(op.value);
706 yr_pc_resume = ym_suspend();
707 return;
708 }
709
710 for (i=0 ; i<nLines ; i++) {
711 q = NextInLine(&op, i);
712 if (!q) break;
713 result->value.q[i] = p_strcpy(q);
714 }
715 }
716
717 /*--------------------------------------------------------------------------*/
718
Y_write(int nArgs)719 void Y_write(int nArgs)
720 {
721 Symbol *stack;
722 char *format, *keyNames[3];
723 Symbol *keySymbols[2];
724 Operand sinkOp;
725
726 keyNames[0]= "format";
727 keyNames[1]= "linesize";
728 keyNames[2]= 0;
729 stack= YGetKeywords(sp-nArgs+1, nArgs, keyNames, keySymbols);
730
731 /* Get 1st argument if it is an IOStream or nil, otherwise will use
732 nil stream (keyboard). */
733 if (stack>sp) YError("write function takes at least one argument");
734 stack->ops->FormOperand(stack, &sinkOp);
735 if (sinkOp.ops==&textOps) {
736 TextStream *ts= sinkOp.value;
737 p_file *file= ts->stream;
738 stack++;
739 if (!file)
740 YErrorIO("attempt to write to closed I/O stream");
741 else if (!(ts->permissions & 2))
742 YErrorIO("attempt to write to file opened in r mode");
743 if (ts->readWrite&1 && p_fseek(file, p_fsize(file))) {
744 p_ferror(file); /* don't prejudice future I/O attempts */
745 YErrorIO("fseek failed to find current position in ASCII write");
746 }
747 ts->readWrite= 2;
748 } else {
749 if (sinkOp.ops==&voidOps) stack++;
750 sinkOp.ops= 0;
751 }
752
753 /* get format keyword, if any */
754 format= keySymbols[0]? YGetString(keySymbols[0]) : 0;
755
756 /* get linesize keyword, if any */
757 lineSize= keySymbols[1]? YGetInteger(keySymbols[1]) : 80;
758
759 WriteWorker(&sinkOp, stack, format);
760 }
761
Y_swrite(int nArgs)762 void Y_swrite(int nArgs)
763 {
764 Symbol *stack;
765 char *format, *keyNames[2];
766 Symbol *keySymbols[1];
767
768 keyNames[0]= "format";
769 keyNames[1]= 0;
770 stack= YGetKeywords(sp-nArgs+1, nArgs, keyNames, keySymbols);
771
772 /* get format keyword, if any */
773 format= keySymbols[0]? YGetString(keySymbols[0]) : 0;
774
775 WriteWorker((Operand *)0, stack, format);
776 }
777
778 static void
WriteWorker(Operand * sinkOp,Symbol * stack,char * format)779 WriteWorker(Operand *sinkOp, Symbol *stack, char *format)
780 {
781 Dimension *dims;
782 Operand *op;
783 long i, number;
784 int j, nConversions, nArgs, typeID, nChars, nLine;
785 char *text;
786 Array *result; /* for swrite only (sinkOp==0) */
787 p_file *file= (sinkOp && sinkOp->ops)?
788 ((TextStream *)sinkOp->value)->stream : (p_file *)0;
789
790 /* crack format string, set fmtTotal */
791 nConversions= CrackFormat(format, &CrackPrint);
792
793 dims= pDims;
794 pDims= 0;
795 FreeDimension(dims);
796
797 /* First pass through arguments counts them, checks data types and
798 conformability, and matches them to conversions in the format list. */
799 CheckOps((int)(sp-stack+1));
800 nArgs= 0;
801 for ( ; stack<=sp ; stack++) {
802 if (!stack->ops) { /* skip keywords */
803 stack++;
804 continue;
805 }
806 op= &ioOps[nArgs].o;
807 stack->ops->FormOperand(stack, op);
808 typeID= op->ops->typeID;
809 if (typeID>T_DOUBLE && typeID!=T_STRING && typeID!=T_POINTER)
810 YError("write cannot handle non-array, complex, or structure");
811 if (nArgs<nConversions) {
812 int ftype= fmtList[nArgs].type;
813 if (ftype==IO_CHAR) ftype= IO_LONG;
814 if (typeMatch[typeID]!=ftype)
815 YError("write format/write input data type mismatch");
816 } else if (!nArgs && !nConversions && fmtNow==1) {
817 format= fmtList[0].format;
818 fmtList[0].format=
819 p_strncat(format, printDefaults[typeMatch[typeID]], 0);
820 p_free(format);
821 } else {
822 AddFormat(printDefaults[typeMatch[typeID]], typeMatch[typeID], 0);
823 }
824 fmtList[nArgs].typeID= typeID;
825 if (typeID==T_STRING) {
826 /* A string field might expand by as much as the length
827 of the longest string to be printed. */
828 char **q= op->value;
829 long len;
830 fmtWidth= 0;
831 number= op->type.number;
832 for (i=0 ; i<number ; i++)
833 if (q[i] && (len= strlen(q[i]))>fmtWidth) fmtWidth= len;
834 fmtTotal+= fmtWidth;
835 } else {
836 fmtTotal+= 25; /* difficult to imagine longer numeric field */
837 }
838 if (nArgs) {
839 if (Conform(pDims, op->type.dims) & 4)
840 YError("all inputs to formatted write must be conformable");
841 dims= pDims;
842 pDims= Ref(tmpDims);
843 FreeDimension(dims);
844 } else {
845 pDims= Ref(op->type.dims);
846 }
847 nArgs++;
848 }
849 number= TotalNumber(pDims);
850
851 /* second pass broadcasts arguments to same size */
852 for (j=0 ; j<nArgs ; j++) RightConform(pDims, &ioOps[j].o);
853
854 /* Make sure the outBuf has at least fmtTotal characters, which should
855 be a very conservative estimate of the maximum number of characters
856 required by the Printer output routines. */
857 CheckOut(fmtTotal>80? fmtTotal : 80);
858 outBuf[0]= '\0';
859
860 if (!sinkOp)
861 /* this is swrite call -- it's time to create the result array */
862 result= PushDataBlock(NewArray(&stringStruct, pDims));
863 else
864 result= 0;
865
866 /* outer loop is on output array elements */
867 nLine= 0;
868 fmtTotal= 0;
869 for (i=0 ; i<number ; i++) {
870 if (p_signalling) p_abort();
871 /* inner loop is on arguments to be written */
872 text= outBuf;
873 text[0]= '\0';
874 nChars= 0;
875 for (j=0 ; j<nArgs ; j++) {
876 if (fmtList[j].type == IO_CHAR)
877 PrintC[fmtList[j].typeID](&ioOps[j].o, fmtList[j].format, text);
878 else if (fmtList[j].danger)
879 PrintD[fmtList[j].typeID-T_FLOAT](&ioOps[j].o,
880 fmtList[j].format, text);
881 else
882 Printer[fmtList[j].typeID](&ioOps[j].o, fmtList[j].format, text);
883 nChars= (int)strlen(text); /* can't rely on sprintf to return this */
884 text+= nChars;
885 fmtTotal+= nChars;
886 nLine+= nChars;
887 }
888
889 /* one result printed/stored per array element */
890 if (!sinkOp) {
891 result->value.q[i]= p_strcpy(outBuf);
892 } else {
893 /* extra line break explained in help,write documentation
894 * nLine>nChars not mentioned in documentation prevents
895 * extra line break if single argument is longer than lineSize
896 */
897 if (i && ((nArgs>nConversions && nArgs>1) ||
898 (nLine>lineSize && nLine>nChars))) {
899 if (sinkOp->ops && file) p_fputs(file, "\n");
900 else p_stdout("\n");
901 fmtTotal++;
902 nLine= strlen(outBuf);
903 }
904 if (sinkOp->ops && file) p_fputs(file, outBuf);
905 else p_stdout(outBuf);
906 if (nChars && text[-1]=='\n') nLine= 0;
907 }
908 }
909
910 /* add trailing newline if it seems reasonable to do so */
911 if (sinkOp && nArgs>nConversions) {
912 if (sinkOp->ops && file) p_fputs(file, "\n");
913 else p_stdout("\n");
914 fmtTotal++;
915 }
916
917 /* release excessive temporary space */
918 FreeFormats();
919 CheckOut(0L);
920
921 /* if this is write (not swrite), result is character count */
922 if (!result) PushLongValue(fmtTotal);
923 }
924
925 /*--------------------------------------------------------------------------*/
926
927 static long aFileID= 0; /* unique file ID number for ASCII files */
928 IOFileLink *yTextFiles= 0;
929
930 /* Set up a block allocator which grabs space for 16 TextStream objects
931 at a time. Since TextStream contains several pointers, the alignment
932 of an TextStream must be at least as strict as a void*. */
933 static MemryBlock txtsBlock= {0, 0, sizeof(TextStream),
934 16*sizeof(TextStream)};
935
NewTextStream(char * fullname,void * stream,int permissions,long line,long pos)936 TextStream *NewTextStream(char *fullname, void *stream, int permissions,
937 long line, long pos)
938 {
939 TextStream *ios= NextUnit(&txtsBlock);
940 p_file *file= stream;
941
942 ios->references= 0;
943 ios->ops= &textOps;
944 ios->stream= file;
945 ios->fullname= fullname;
946 ios->permissions= permissions;
947 ios->lastLineRead= line;
948 ios->readPosition= ios->lastPosition= pos;
949 if (file && !(permissions&16) &&
950 p_fseek(file, pos)) ios->permissions|= 16;
951 ios->readWrite= 0;
952 ios->fileID= aFileID++;
953
954 AddIOLink(&yTextFiles, ios);
955 return ios;
956 }
957
FreeTextStream(void * ios)958 void FreeTextStream(void *ios)
959 {
960 TextStream *io= ios;
961 p_file *stream= io->stream;
962 if (stream) p_fclose(stream);
963 p_free(io->fullname);
964 RemoveIOLink(yTextFiles, io);
965 FreeUnit(&txtsBlock, io);
966 }
967
968 static char *txStatus[]=
969 { "<illegal>", "read-only", "write-only", "read-write" };
970
PrintTX(Operand * op)971 static void PrintTX(Operand *op)
972 {
973 TextStream *ts= op->value;
974 long line= ts->lastLineRead+1;
975 ForceNewline();
976 if (ts->stream) {
977 char text[32];
978 sprintf(text, "%s text stream at:", txStatus[ts->permissions&3]);
979 PrintFunc(text);
980 } else {
981 PrintFunc("text stream <closed> was:");
982 line= 0;
983 }
984 ForceNewline();
985 PrintFunc(MakeErrorLine(line, ts->fullname));
986 ForceNewline();
987 }
988
989 /* Set up a block allocator which grabs space for 16 bookmark objects
990 at a time. Since Bookmark contains an ops pointer, the alignment
991 of a Bookmark must be at least as strict as a void*. */
992 static MemryBlock bookBlock= {0, 0, sizeof(Bookmark),
993 16*sizeof(Bookmark)};
994
NewBookmark(long line,long last,long next,long id)995 Bookmark *NewBookmark(long line, long last, long next, long id)
996 {
997 Bookmark *bookmark= NextUnit(&bookBlock);
998 bookmark->references= 0;
999 bookmark->ops= &bookOps;
1000 bookmark->lastLineRead= line;
1001 bookmark->lastPosition= last;
1002 bookmark->readPosition= next;
1003 bookmark->fileID= id;
1004 return bookmark;
1005 }
1006
FreeBookmark(void * bm)1007 void FreeBookmark(void *bm) /* ******* Use Unref(bm) ******* */
1008 {
1009 FreeUnit(&bookBlock , bm);
1010 }
1011
PrintBM(Operand * op)1012 static void PrintBM(Operand *op)
1013 {
1014 Bookmark *bm= op->value;
1015 IOFileLink *iofl;
1016 for (iofl=yTextFiles ; iofl ; iofl=iofl->next)
1017 if (((TextStream *)iofl->ios)->fileID == bm->fileID) break;
1018 if (iofl) {
1019 TextStream *ts= iofl->ios;
1020 ForceNewline();
1021 PrintFunc("bookmark at:");
1022 ForceNewline();
1023 PrintFunc(MakeErrorLine(bm->lastLineRead+1, ts->fullname));
1024 ForceNewline();
1025 } else {
1026 PrintFunc("<lost bookmark>");
1027 }
1028 }
1029
Y_bookmark(int nArgs)1030 void Y_bookmark(int nArgs)
1031 {
1032 Operand op;
1033 TextStream *ios;
1034 if (nArgs!=1) YError("bookmark function takes exactly one argument");
1035 sp->ops->FormOperand(sp, &op);
1036 ios= op.value;
1037 if (op.ops!=&textOps)
1038 YError("argument to bookmark function not a text stream");
1039 if (ios->permissions&16) YError("can't place a bookmark in a pipe");
1040 PushDataBlock(NewBookmark(ios->lastLineRead, ios->lastPosition,
1041 ios->readPosition, ios->fileID));
1042 }
1043
Y_backup(int nArgs)1044 void Y_backup(int nArgs)
1045 {
1046 Operand op;
1047 TextStream *ios;
1048 Bookmark *bm= 0;
1049 p_file *file;
1050
1051 if (nArgs!=1 && nArgs!=2)
1052 YError("backup function takes exactly one or two arguments");
1053 if (nArgs==2) {
1054 sp->ops->FormOperand(sp, &op);
1055 if (op.ops==&bookOps)
1056 bm= op.value;
1057 else if (op.ops!=&voidOps)
1058 YError("2nd argument to backup function is not nil or bookmark");
1059 Drop(1);
1060 }
1061 sp->ops->FormOperand(sp, &op);
1062 ios= op.value;
1063 if (op.ops!=&textOps)
1064 YError("1st argument to backup function not a text stream");
1065 if (ios->permissions&16) YError("can't backup a pipe");
1066 file= ios->stream;
1067
1068 /* don't try to detect no-op, as side effect of this routine is
1069 to ensure that fseek is called to make a read operation
1070 legal (previous operation may have been a write) */
1071
1072 if (bm) {
1073 /* reset state to bookmark */
1074 struct IOFileLink *iofl;
1075 for (iofl=yTextFiles ; iofl ; iofl=iofl->next)
1076 if (((TextStream *)iofl->ios)->fileID == bm->fileID) break;
1077 if (!iofl) YError("no file for bookmark passed to backup function");
1078 if (iofl->ios!=ios)
1079 YError("wrong file for bookmark passed to backup function");
1080 if (p_fseek(file, bm->readPosition))
1081 YErrorIO("fseek failed in backup function");
1082 ios->lastLineRead= bm->lastLineRead;
1083 ios->lastPosition= bm->lastPosition;
1084 ios->readPosition= bm->readPosition;
1085
1086 } else {
1087 /* back up to previous line */
1088 if (p_fseek(file, ios->lastPosition))
1089 YErrorIO("fseek failed in backup function");
1090 ios->readPosition= ios->lastPosition;
1091 ios->lastLineRead--;
1092 }
1093
1094 ios->readWrite= 1; /* fseek equivalent to read here */
1095 }
1096
1097 /*--------------------------------------------------------------------------*/
1098
NextInLine(Operand * op,long n)1099 static char *NextInLine(Operand *op, long n)
1100 {
1101 char *text;
1102 if (op->ops==&textOps) {
1103 TextStream *stream= op->value;
1104 p_file *file= stream->stream;
1105 text= Ygets(&inputBuffer, file);
1106 if (!text) {
1107 int hadEOF= Yfeof(file);
1108 int hadError= Yferror(file);
1109 p_ferror(file); /* don't prejudice later I/O attempts */
1110 if (hadError)
1111 YErrorIO("****ABORTING READ**** error reading input file");
1112 if (!hadEOF)
1113 YErrorIO("****ABORTING READ**** input file not ASCII text");
1114 } else {
1115 stream->lastLineRead++;
1116 stream->lastPosition= stream->readPosition;
1117 if (!(stream->permissions&16)) stream->readPosition= p_ftell(file);
1118 }
1119 } else if (op->ops==&stringOps) {
1120 char **q= op->value;
1121 if (n<op->type.number) text= q[n];
1122 else text= 0;
1123 } else {
1124 YError("(BUG) impossible operand to NextInLine");
1125 text= 0;
1126 }
1127 return text;
1128 }
1129
1130 /*--------------------------------------------------------------------------*/
1131
1132 #undef OPERATION
1133 #define OPERATION(opname, type1, type2) \
1134 static int opname(Operand *op, char *format, char **text) \
1135 { \
1136 type1 *x= op->value; \
1137 type2 v; int i, n; \
1138 if (*text) { \
1139 i= sscanf(*text, format, &v, &n); \
1140 if (i==1) { *x= (type1)v; fmtAssigns++; *text+= n; i= 0; \
1141 } else if (i==0) { *text= 0; i= 1; \
1142 } else { *text+= strlen(*text); i= 1; \
1143 } \
1144 } else { \
1145 *x= 0; i= 0; \
1146 } \
1147 if (!i) op->value= x+1; \
1148 return i; \
1149 }
1150
1151 OPERATION(CScanner, unsigned char, long)
1152 OPERATION(SScanner, short, long)
1153 OPERATION(IScanner, int, long)
1154 OPERATION(LScanner, long, long)
1155
1156 /* floating point read operations cope with Fortran "D" exponent format */
1157 static int retry_sscanf(char *text, char *format, double *pv, int *pn);
1158 #undef OPERATION
1159 #define OPERATION(opname, type1, type2) \
1160 static int opname(Operand *op, char *format, char **text) \
1161 { \
1162 type1 *x= op->value; \
1163 type2 v; int i, n; \
1164 if (*text) { \
1165 i= retry_sscanf(*text, format, &v, &n); \
1166 if (i==1) { *x= (type1)v; fmtAssigns++; *text+= n; i= 0; \
1167 } else if (i==0) { *text= 0; i= 1; \
1168 } else { *text+= strlen(*text); i= 1; \
1169 } \
1170 } else { \
1171 *x= 0; i= 0; \
1172 } \
1173 if (!i) op->value= x+1; \
1174 return i; \
1175 }
1176
OPERATION(FScanner,float,double)1177 OPERATION(FScanner, float, double)
1178 OPERATION(DScanner, double, double)
1179
1180 static int QScanner(Operand *op, char *format, char **text)
1181 {
1182 char **x= op->value;
1183 char *v; int i, n;
1184 if (*x) { p_free(*x); *x= 0; }
1185 if (*text) {
1186 long len= strlen(*text);
1187 v= CheckBuf(len); /* allow enough space for worst case */
1188 i= sscanf(*text, format, v, &n);
1189 if (i==1) { *x= p_strcpy(v); fmtAssigns++; *text+= n; i= 0;
1190 } else if (i==0) { *text= 0; i= 1;
1191 } else { *text+= len; i= 1;
1192 }
1193 } else {
1194 i= 0;
1195 }
1196 if (!i) op->value= x+1;
1197 return i;
1198 }
1199
1200 /* ARGSUSED */
NilScanner(Operand * op,char * format,char ** text)1201 static int NilScanner(Operand *op, char *format, char **text)
1202 {
1203 if (!*text) return 0;
1204 if (strcmp(format,*text)) {
1205 *text= 0;
1206 return 1;
1207 } else {
1208 *text+= strlen(*text);
1209 return 0;
1210 }
1211 }
1212
1213 /* Try to recognize things like 1.234d-21 or 1.234D-21 that Fortran emits.
1214 * The only reasonably cheap recourse is also a bit dangerous:
1215 * We temporarily modify the text buffer and attempt a
1216 * rescan. Of course, if we're interrupted before we restore
1217 * the modified text buffer, we may have modified the caller's
1218 * text illegally.
1219 * Hopefully, a significant performance penalty accrues only if
1220 * the text you are reading contains things like "1.234e-21dumb".
1221 * However, a file full of "1.234D-21" style numbers will take
1222 * twice as long to read as one with ANSI C acceptable formats.
1223 *
1224 * New problem: Strings which overflow, e.g.- "1.e1000", insert Inf
1225 * and potentially mess with SIGFPE trap masking. According to C9x
1226 * draft, this is supposed to set errno to ERANGE
1227 */
1228 static int
retry_sscanf(char * text,char * format,double * pv,int * pn)1229 retry_sscanf(char *text, char *format, double *pv, int *pn)
1230 {
1231 int i;
1232 errno = 0;
1233 i = sscanf(text, format, pv, pn);
1234 if (i == 1) {
1235 int n = *pn;
1236 char c = text[n];
1237 if (c=='D' || c=='d') {
1238 /* this may represent only limited success if the scan
1239 * stopped at a "d" or "D" character */
1240 text[n] = 'e';
1241 errno = 0;
1242 i = sscanf(text, format, pv, pn);
1243 text[n] = c;
1244 }
1245 }
1246 if (errno) { /* treat e.g. 1e1000 like non-numeric sequence */
1247 #if !defined(_WIN32) && !defined(__CYGWIN__)
1248 extern void u_fpu_setup(int when); /* playu.h */
1249 u_fpu_setup(-1); /* on some Linux platforms resets SIGFPE trap mask */
1250 #endif
1251 i = 0;
1252 *pv = 0.;
1253 }
1254 return i;
1255 }
1256
1257 /*--------------------------------------------------------------------------*/
1258
1259 #undef OPERATION
1260 #define OPERATION(opname, type1, type2) \
1261 static void opname(Operand *op, char *format, char *text) \
1262 { \
1263 type1 *x= op->value; \
1264 type2 v= *x; op->value= x+1; \
1265 sprintf(text, format, v); \
1266 }
1267
OPERATION(CPrinter,unsigned char,long)1268 OPERATION(CPrinter, unsigned char, long)
1269 OPERATION(SPrinter, short, long)
1270 OPERATION(IPrinter, int, long)
1271 OPERATION(LPrinter, long, long)
1272 OPERATION(FPrinter, float, double)
1273 OPERATION(DPrinter, double, double)
1274 OPERATION(PPrinter, void *, void *)
1275
1276 static void QPrinter(Operand *op, char *format, char *text)
1277 {
1278 char **x= op->value;
1279 char *v= *x; op->value= x+1;
1280 sprintf(text, format, v? v : "");
1281 }
1282
1283 #undef OPERATION
1284 #define OPERATION(opname, type1) \
1285 static void opname(Operand *op, char *format, char *text) \
1286 { \
1287 type1 *x= op->value; \
1288 double v= *x; op->value= x+1; \
1289 if (v>1.e15) v= 1.e15; else if (v<-1.e15) v= -1.e15; \
1290 sprintf(text, format, v); \
1291 }
1292
OPERATION(FPrintD,float)1293 OPERATION(FPrintD, float)
1294 OPERATION(DPrintD, double)
1295
1296 #undef OPERATION
1297 #define OPERATION(opname, type1) \
1298 static void opname(Operand *op, char *format, char *text) \
1299 { \
1300 type1 *x= op->value; \
1301 int v= *x; op->value= x+1; \
1302 sprintf(text, format, v); \
1303 }
1304
1305 OPERATION(CPrintC, unsigned char)
1306 OPERATION(SPrintC, short)
1307 OPERATION(IPrintC, int)
1308 OPERATION(LPrintC, long)
1309
1310 /*--------------------------------------------------------------------------*/
1311
1312 static void CheckOps(int nArgs)
1313 {
1314 if (nArgs >= maxIOops) {
1315 long newMax= maxIOops+16;
1316 while (nArgs >= newMax) newMax+= 16;
1317 ioOps= p_realloc(ioOps, sizeof(struct io_operand)*newMax);
1318 maxIOops= newMax;
1319 }
1320 }
1321
AddFormat(char * format,int type,int danger)1322 static void AddFormat(char *format, int type, int danger)
1323 {
1324 if (fmtNow >= fmtMax) {
1325 fmtList= p_realloc(fmtList, sizeof(struct FormatList)*(fmtMax+16));
1326 fmtMax+= 16;
1327 }
1328 fmtList[fmtNow].format= p_strcpy(format);
1329 fmtList[fmtNow].type= type;
1330 fmtList[fmtNow].typeID= -1;
1331 fmtList[fmtNow++].danger= danger;
1332 }
1333
FreeFormats(void)1334 static void FreeFormats(void)
1335 {
1336 while (fmtNow) p_free(fmtList[--fmtNow].format);
1337 if (fmtMax>32) {
1338 fmtList= p_realloc(fmtList, sizeof(struct FormatList)*32);
1339 fmtMax= 32;
1340 }
1341 if (maxIOops>32) {
1342 ioOps= p_realloc(ioOps, sizeof(struct io_operand)*32);
1343 maxIOops= 32;
1344 }
1345 }
1346
CrackFormat(char * format,char * (* Cracker)(char *))1347 static int CrackFormat(char *format, char *(*Cracker)(char *))
1348 {
1349 int nConversions= 0;
1350 fmtTotal= 0;
1351
1352 /* free fmtList left over from last time, if any */
1353 while (fmtNow) p_free(fmtList[--fmtNow].format);
1354
1355 /* Use either CrackScan or CrackPrint to split the format into pieces
1356 containing a single conversion specification corresponding to one
1357 item in the read or write argument list. After this, either
1358 fmtNow==nConversions, or possibly fmtNow==1 and nConversions==0. */
1359 if (format) {
1360 while (format[0]) {
1361 format= Cracker(format);
1362 if (fmtType!=IO_NONE) nConversions++;
1363 AddFormat(fmtBuf, fmtType, fmtDanger);
1364 fmtTotal+= fmtWidth;
1365 }
1366 }
1367 return nConversions;
1368 }
1369
CheckBuf(long len)1370 static char *CheckBuf(long len)
1371 {
1372 if (len+4 > fmtLen) {
1373 long newSize= 80*(1 + (len+4)/80);
1374 fmtBuf= p_realloc(fmtBuf, newSize);
1375 fmtLen= newSize;
1376 } else if (fmtLen>80 && len+4<=80) {
1377 fmtBuf= p_realloc(fmtBuf, 80L);
1378 fmtLen= 80L;
1379 }
1380 return fmtBuf; /* used by CrackScan and CrackPrint for format strings */
1381 }
1382
CheckOut(long len)1383 static char *CheckOut(long len)
1384 {
1385 if (len > outLen) {
1386 long newSize= 256*(1 + (len-1)/256);
1387 outBuf= p_realloc(outBuf, newSize);
1388 outLen= newSize;
1389 } else if (outLen>512 && len<=512) {
1390 outBuf= p_realloc(outBuf, 512L);
1391 outLen= 512L;
1392 }
1393 return outBuf; /* used by Printer routines to hold sprintf results */
1394 }
1395
CrackScan(char * format)1396 static char *CrackScan(char *format)
1397 {
1398 int got_one;
1399 long i, n;
1400 char *part= CheckBuf(strlen(format));
1401 part[0]= '\0';
1402 fmtType= IO_NONE;
1403 got_one= 0;
1404 fmtWidth= 0;
1405 fmtDanger= 0;
1406
1407 while (!got_one) { /* loop on conversion specifiers which do not assign */
1408 /* copy format until first conversion specifier */
1409 i= strcspn(format, "%");
1410 strncat(part, format, i);
1411 part+= i;
1412 format+= i;
1413 if (got_one || !format[0]) break;
1414 *part++= '%';
1415 *part= '\0';
1416 format++;
1417
1418 /* find conversion type character */
1419 i= strcspn(format, "diouxXfeEgGs[cpn%");
1420 if (!format[i]) {
1421 strncat(part, format, i);
1422 break;
1423 }
1424 got_one= (format[i]!='%' && format[0]!='*');
1425
1426 switch (format[i]) {
1427 case '%':
1428 i++;
1429 strncat(part, format, i);
1430 part+= i;
1431 format+= i;
1432 break;
1433 case '[':
1434 if (format[i+1]==']') i+= 2;
1435 else if (format[i+1]=='^' && format[i+2]==']') i+= 3;
1436 i+= strcspn(&format[i], "]");
1437 case 's': /* actually can use case drop through here... */
1438 i++;
1439 strncat(part, format, i);
1440 part+= i;
1441 format+= i;
1442 fmtType= IO_STRING;
1443 break;
1444 case 'd': case 'i': case 'o': case 'u': case 'x': case 'X':
1445 /* all integers are handled as longs */
1446 if (format[i-1]=='h' || format[i-1]=='l') n= i-1;
1447 else n= i;
1448 strncat(part, format, n);
1449 part+= n;
1450 *part++= 'l';
1451 *part++= format[i];
1452 *part= '\0';
1453 format+= i+1;
1454 fmtType= IO_LONG;
1455 break;
1456 case 'e': case 'E': case 'f': case 'g': case 'G':
1457 /* all reals are handled as doubles */
1458 if (format[i-1]=='h' || format[i-1]=='l' ||
1459 format[i-1]=='L') n= i-1;
1460 else n= i;
1461 strncat(part, format, n);
1462 part+= n;
1463 *part++= 'l';
1464 *part++= format[i];
1465 *part= '\0';
1466 format+= i+1;
1467 fmtType= IO_DOUBLE;
1468 break;
1469 case 'p':
1470 YError("Yorick read cannot handle %p format, use %i");
1471 break;
1472 case 'c':
1473 YError("Yorick read cannot handle %c format, use %1s or %1[...]");
1474 break;
1475 case 'n':
1476 YError("Yorick read cannot handle %n format");
1477 break;
1478 }
1479 }
1480
1481 /* append final character count to be able to advance input pointer */
1482 if (got_one) strcat(part, "%n");
1483
1484 return format;
1485 }
1486
CrackPrint(char * format)1487 static char *CrackPrint(char *format)
1488 {
1489 int got_one;
1490 long i, n;
1491 char *part= CheckBuf(strlen(format));
1492 part[0]= '\0';
1493 fmtType= IO_NONE;
1494 got_one= 0;
1495 fmtWidth= 0;
1496 fmtDanger= 0;
1497
1498 for (;;) { /* loop on conversion specifiers which do not eat arguments */
1499 /* copy format until first conversion specifier */
1500 i= strcspn(format, "%");
1501 while (format[i]=='%' && format[i+1]=='%')
1502 i+= 2+strcspn(format+i+2, "%"); /* skip %% immediately */
1503 strncat(part, format, i);
1504 part+= i;
1505 format+= i;
1506 if (got_one || !format[0]) break;
1507 *part++= '%';
1508 *part= '\0';
1509 format++;
1510
1511 /* find conversion type character */
1512 i= strcspn(format, "diouxXfeEgGscpn");
1513 if (!format[i]) break;
1514 for (n=0 ; n<i ; n++) {
1515 if (format[n] == '*')
1516 YError("Yorick write cannot handle %*.* format, compute format");
1517 if (!fmtWidth && format[n]>='1' && format[n]<='9') {
1518 /* get minimum field width, if specified */
1519 fmtWidth= format[n]-'0';
1520 for (n++ ; n<i && format[n]>='0' && format[n]<='9' ; n++)
1521 fmtWidth= 10*fmtWidth + format[n]-'0';
1522 }
1523 }
1524 got_one= 1;
1525
1526 switch (format[i]) {
1527 case 's':
1528 i++;
1529 strncat(part, format, i);
1530 part+= i;
1531 format+= i;
1532 fmtType= IO_STRING;
1533 break;
1534 case 'd': case 'i': case 'o': case 'u': case 'x': case 'X':
1535 /* all integers are handled as longs */
1536 if (format[i-1]=='h' || format[i-1]=='l') n= i-1;
1537 else n= i;
1538 strncat(part, format, n);
1539 part+= n;
1540 *part++= 'l';
1541 *part++= format[i];
1542 *part= '\0';
1543 format+= i+1;
1544 fmtType= IO_LONG;
1545 break;
1546 case 'f':
1547 fmtDanger= 1;
1548 case 'e': case 'E': case 'g': case 'G':
1549 /* all reals are handled as doubles */
1550 if (format[i-1]=='L') n= i-1;
1551 else n= i;
1552 strncat(part, format, n);
1553 part+= n;
1554 *part++= format[i];
1555 *part= '\0';
1556 format+= i+1;
1557 fmtType= IO_DOUBLE;
1558 break;
1559 case 'c':
1560 i++;
1561 strncat(part, format, i);
1562 part+= i;
1563 format+= i;
1564 fmtType= IO_CHAR;
1565 break;
1566 case 'p':
1567 i++;
1568 strncat(part, format, i);
1569 part+= i;
1570 format+= i;
1571 fmtType= IO_POINTER;
1572 break;
1573 case 'n':
1574 YError("Yorick write cannot handle %n format, use strlen(swrite())");
1575 break;
1576 }
1577 }
1578
1579 fmtWidth+= strlen(fmtBuf);
1580 return format;
1581 }
1582
1583 /*--------------------------------------------------------------------------*/
1584
YErrorIO(const char * msg)1585 void YErrorIO(const char *msg)
1586 {
1587 extern int y_catch_category;
1588 y_catch_category= 0x02;
1589 YError(msg);
1590 }
1591
1592 /*--------------------------------------------------------------------------*/
1593
Y_popen(int nArgs)1594 void Y_popen(int nArgs)
1595 {
1596 char *command;
1597 int mode;
1598 p_file *file;
1599 if (nArgs!=2) YError("popen needs exactly two arguments");
1600
1601 command= YGetString(sp-1);
1602 mode= (int)YGetInteger(sp);
1603 Drop(1);
1604 file= p_popen(command, mode?"w":"r");
1605 if (!file) YError("system popen function failed");
1606 PushDataBlock(NewTextStream(p_strcpy(command), file, mode?50:49, 0L, 0L));
1607 }
1608
1609 void
Y_fflush(int nArgs)1610 Y_fflush(int nArgs)
1611 {
1612 Operand op;
1613 if (nArgs!=1) YError("fflush accepts exactly one argument");
1614 sp->ops->FormOperand(sp, &op);
1615 if (sp->value.db->ops==&textOps) {
1616 TextStream *ts = (TextStream *)sp->value.db;
1617 if (ts->stream) p_fflush(ts->stream);
1618 } else if (sp->value.db->ops==&streamOps) {
1619 IOStream *file = (IOStream *)sp->value.db;
1620 if (file->permissions & 2) {
1621 ClearPointees(file, 1);
1622 FlushFile(file, 0);
1623 }
1624 } else {
1625 YError("fflush expecting file handle as argument");
1626 }
1627 }
1628
1629 /*--------------------------------------------------------------------------*/
1630