1 /* Loglan82 Compiler&Interpreter
2 Copyright (C) 1981-1993 Institute of Informatics, University of Warsaw
3 Copyright (C) 1993, 1994 LITA, Pau
5 This program is free software; you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation; either version 2 of the License, or
8 (at your option) any later version.
10 This program is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
15 You should have received a copy of the GNU General Public License
16 along with this program; if not, write to the Free Software
17 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
19 contacts: Andrzej.Salwicki@univ-pau.fr
22 LITA Departement d'Informatique
24 Avenue de l'Universite
26 tel. ++33 59923154 fax. ++33 59841696
28 =======================================================================
40 /* Call standard procedure */
42 /* Process call to a standard proc. */
43 void standard(word nrproc)
45 word t1, t2, t3, t5, t6;
57 fprintf(stderr, "standard procedure %d\n", nrproc);
60 switch ((int) nrproc) {
63 newarry(param[1]. xword, param[0].xword, param[2].xword,
64 ¶m[3].xvirt, ¶m[4].xword);
88 /* unpack:function(s:string):arrayof char */
90 t1 = strings+param[0].xword+1;
91 /* length of the string */
95 newarry((word) 1, t6, (word)AINT, ¶m[1].xvirt, &t5);
103 param[1].xvirt.addr = 0;
104 param[1].xvirt.mark = 0;
107 /* random:function:real */
109 param[0].xreal = (real)prandom();
111 /* time:function:integer */
114 param[0].xword = tim;
116 /* sqrt:function(x:real):real */
118 param[1].xreal = (real)sqrt((double) param[0].xreal);
120 /* entier:function(x:real):integer */
122 param[1].xword = entier((double) param[0].xreal);
124 /* round:function(x:real):integer */
126 param[1].xword = entier((double) (param[0].xreal + 0.5));
130 /* intrinsic procedure */
134 /* imin:function(x, y:integer):integer */
136 param[2].xword = min(param[0].xword, param[1].xword);
138 /* imax:function(x, y:integer):integer */
140 param[2].xword = max(param[0].xword, param[1].xword);
142 /* imin3:function(x, y, z:integer):integer */
144 t1 = min(param[0].xword, param[1].xword);
145 param[3].xword = min(t1, param[2].xword);
147 /* imax3:function(x, y, z:integer):integer */
149 t1 = max(param[0].xword, param[1].xword);
150 param[3].xword = max(t1, param[2].xword);
152 /* sin:function(x:real):real */
154 param[1].xreal = (real)sin((double) param[0].xreal);
156 /* cos:function(x:real):real */
158 param[1].xreal = (real)cos((double) param[0].xreal);
160 /* tan:function(x:real):real */
162 r = cos((double) param[0].xreal);
165 param[1].xreal = (real)sin((double) param[0].xreal) / r;
167 /* exp:function(x:real):real */
169 param[1].xreal = (real)exp((double) param[0].xreal);
171 /* ln:function(x:real):real */
173 param[1].xreal = (real)log((double) param[0].xreal);
175 /* atan:function(x:real):real */
177 param[1].xreal = (real)atan((double) param[0].xreal);
179 /* endrun:procedure */
183 /* ranset:procedure(x:real) */
207 param[0].xbool = lbool(testeof(stdin));
211 loadfile((word) UNKNOWN, &t1, &t2, &fp);
213 if (t3 == READING || t3 == UPDATING)
214 param[0].xbool = lbool(testeof(fp));
224 loadfile((word) READING, &t1, &t2, &fp);
231 param[0].xword = read_char();
235 loadfile((word) READING, &t1, &t2, &fp);
238 if ((ch = getc(fp)) == EOF)
245 param[0].xword = atoi(s);
248 case 46: /* readint(f) */
249 loadfile((word) READING, &t1, &t2, &fp);
252 param[0].xword = readint(fp);
257 param[0].xreal = (real)atof(s);
261 loadfile((word) READING, &t1, &t2, &fp);
264 param[0].xreal = (real)readreal(fp);
268 loadfile((word) READING, &t1, &t2, &fp);
271 if ((ch = getc(fp)) == EOF)
277 loadfile((word) READING, &t1, &t2, &fp);
280 n = fread((char *) ¶m[ 0 ].xword, sizeof(word), 1, fp);
286 loadfile((word) READING, &t1, &t2, &fp);
289 n = fread((char *) ¶m[0].xreal, sizeof(real), 1, fp);
299 loadfile((word) WRITING, &t1, &t2, &fp);
302 ch = (char) param[ 0 ].xword;
303 if (putc(ch, fp) == EOF)
308 loadfile((word) WRITING, &t1, &t2, &fp);
311 n = fwrite((char *) ¶m[ 0 ].xword, sizeof(word), 1, fp);
317 loadfile((word) WRITING, &t1, &t2, &fp);
320 n = fwrite((char *) ¶m[ 0 ].xreal, sizeof(real), 1, fp);
332 loadfile((word) WRITING, &t1, &t2, &fp);
335 if (putc('\n', fp) == EOF)
346 loadfile((word) WRITING, &t1, &t2, &fp);
349 if (putc((char) param[0].xword, fp) == EOF)
354 write_char((char) param[0].xword);
358 loadfile((word) WRITING, &t1, &t2, &fp);
361 writeint(param[0].xword, param[1].xword, fp);
365 writeint(param[0].xword, param[1].xword, stdout);
373 loadfile((word) WRITING, &t1, &t2, &fp);
376 writereal((double) param[0].xreal, param[1].xword,
385 writereal((double) param[0].xreal, param[1].xword,
386 param[2].xword, stdout);
390 loadfile((word) WRITING, &t1, &t2, &fp);
393 writestring(param[0].xword, param[1].xword, fp);
397 writestring(param[0].xword, param[1].xword, stdout);
399 /* open temporary file */
401 genfileobj(TRUE, param[1].xword, tempfilename(),
402 ¶m[0].xvirt, &t1);
404 /* open external file */
406 genfileobj(FALSE, param[1].xword, asciiz(¶m[2].xvirt),
407 ¶m[0].xvirt, &t1);
411 param[0].xbool = lbool(testeoln(stdin));
415 loadfile((word) READING, &t1, &t2, &fp);
416 if (t1 != TEXTF) errsignal(RTEILLIO);
417 param[0].xbool = lbool(testeoln(fp));
421 loadvirt(param[0].xvirt,
422 thisp->prochead + M[thisp->prochead] + CHD);
431 p.mark = thisp->mark;
432 mess2obj(thisp, &p, &v);
436 /* reset:procedure(f:file) */
438 if (member(¶m[0].xvirt, &t2))
443 /* rewrite:procedure(f:file) */
445 if (member(¶m[0].xvirt, &t2))
450 /* unlink:procedure(f:file) */
452 delete(¶m[0].xvirt);
454 /* seek:procedure(f:file, offset, base:integer) */
456 storevirt(param[0].xvirt, currfile);
457 loadfile((word) UPDATING, &t1, &t2, &fp);
460 if (fseek(fp, (long) param[1].xword, (int) param[2].xword))
463 /* getrec(f, a, n) */
465 loadfile((word) UPDATING, &t1, &t2, &fp);
468 param[1].xword = directio(¶m[0].xvirt, param[1].xword,
469 (int (*)())fread, fp);
471 /* putrec(f, a, n) */
473 loadfile((word) UPDATING, &t1, &t2, &fp);
474 if (t1 != DIRECT) errsignal(RTEILLIO);
475 param[1].xword = directio(¶m[0].xvirt, param[1].xword,
476 (int (*)())fwrite, fp);
478 /* position:function(f:file):real */
480 storevirt(param[0].xvirt, currfile);
481 loadfile((word) UPDATING, &t1, &t2, &fp);
484 param[1].xword =(int) ftell(fp);
486 /* memavail:function:integer */
488 param[0].xword = memavail();
490 /* exec:function(c:arrayof char):integer */
492 cp = asciiz(¶m[0].xvirt);
493 param[1].xword = system(cp);