1 /* libpoke.c - Implementation of the public services in libpoke. */
2
3 /* Copyright (C) 2020, 2021 Jose E. Marchesi */
4
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 3 of the License, or
8 * (at your option) any later version.
9 *
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.
14 *
15 * You should have received a copy of the GNU General Public License
16 * along with this program. If not, see <http://www.gnu.org/licenses/>.
17 */
18
19 #include <config.h>
20
21 #include <string.h>
22 #include <stdlib.h>
23 #include <assert.h>
24
25 #include "pkt.h"
26 #include "pkl.h"
27 #include "pkl-ast.h" /* XXX */
28 #include "pkl-env.h" /* XXX */
29 #include "pvm.h"
30 #include "pvm-val.h" /* XXX */
31 #include "libpoke.h"
32
33 struct pk_compiler
34 {
35 pkl_compiler compiler;
36 pvm vm;
37
38 pkl_ast_node complete_type;
39 int status; /* Status of last API function call. Initialized with PK_OK */
40 };
41
42 struct pk_term_if libpoke_term_if;
43
44 #define PK_RETURN(code) do { return pkc->status = (code); } while (0)
45
46 pk_compiler
pk_compiler_new(struct pk_term_if * term_if)47 pk_compiler_new (struct pk_term_if *term_if)
48 {
49 pk_compiler pkc;
50
51 if (!term_if)
52 return NULL;
53
54 if (!term_if->flush_fn || !term_if->puts_fn || !term_if->printf_fn
55 || !term_if->indent_fn || !term_if->class_fn || !term_if->end_class_fn
56 || !term_if->hyperlink_fn || !term_if->end_hyperlink_fn)
57 return NULL;
58
59 pkc = malloc (sizeof (struct pk_compiler));
60 if (pkc)
61 {
62 /* Determine the path to the compiler's runtime files. */
63 const char *libpoke_datadir = getenv ("POKEDATADIR");
64 if (libpoke_datadir == NULL)
65 libpoke_datadir = PKGDATADIR;
66
67 libpoke_term_if = *term_if;
68
69 pkc->vm = pvm_init ();
70 if (pkc->vm == NULL)
71 goto error;
72 pkc->compiler = pkl_new (pkc->vm,
73 libpoke_datadir);
74 if (pkc->compiler == NULL)
75 goto error;
76 pkc->complete_type = NULL;
77 pkc->status = PK_OK;
78
79 pvm_set_compiler (pkc->vm, pkc->compiler);
80 }
81
82 return pkc;
83
84 error:
85 free (pkc);
86 return NULL;
87 }
88
89 void
pk_compiler_free(pk_compiler pkc)90 pk_compiler_free (pk_compiler pkc)
91 {
92 if (pkc)
93 {
94 pkl_free (pkc->compiler);
95 pvm_shutdown (pkc->vm);
96 }
97
98 free (pkc);
99 }
100
101 int
pk_errno(pk_compiler pkc)102 pk_errno (pk_compiler pkc)
103 {
104 if (pkc)
105 return pkc->status;
106 return PK_ERROR;
107 }
108
109 int
pk_compile_file(pk_compiler pkc,const char * filename,int * exit_status)110 pk_compile_file (pk_compiler pkc, const char *filename,
111 int *exit_status)
112 {
113 PK_RETURN (pkl_execute_file (pkc->compiler, filename, exit_status)
114 ? PK_OK
115 : PK_ERROR);
116 }
117
118 int
pk_compile_buffer(pk_compiler pkc,const char * buffer,const char ** end)119 pk_compile_buffer (pk_compiler pkc, const char *buffer,
120 const char **end)
121 {
122 PK_RETURN (pkl_execute_buffer (pkc->compiler, buffer, end) ? PK_OK
123 : PK_ERROR);
124 }
125
126 int
pk_compile_statement(pk_compiler pkc,const char * buffer,const char ** end,pk_val * valp)127 pk_compile_statement (pk_compiler pkc, const char *buffer,
128 const char **end, pk_val *valp)
129 {
130 pvm_val val;
131
132 if (!pkl_execute_statement (pkc->compiler, buffer, end, &val))
133 PK_RETURN (PK_ERROR);
134
135 if (valp)
136 *valp = val;
137
138 PK_RETURN (PK_OK);
139 }
140
141 int
pk_compile_expression(pk_compiler pkc,const char * buffer,const char ** end,pk_val * valp)142 pk_compile_expression (pk_compiler pkc, const char *buffer,
143 const char **end, pk_val *valp)
144 {
145 pvm_val val;
146
147 if (!pkl_execute_expression (pkc->compiler, buffer, end, &val))
148 PK_RETURN (PK_ERROR);
149
150 if (valp)
151 *valp = val;
152
153 PK_RETURN (PK_OK);
154 }
155
156 int
pk_load(pk_compiler pkc,const char * module)157 pk_load (pk_compiler pkc, const char *module)
158 {
159 PK_RETURN (pkl_load (pkc->compiler, module) == 0 ? PK_OK : PK_ERROR);
160 }
161
162 void
pk_set_quiet_p(pk_compiler pkc,int quiet_p)163 pk_set_quiet_p (pk_compiler pkc, int quiet_p)
164 {
165 pkl_set_quiet_p (pkc->compiler, quiet_p);
166 pkc->status = PK_OK;
167 }
168
169 void
pk_set_lexical_cuckolding_p(pk_compiler pkc,int lexical_cuckolding_p)170 pk_set_lexical_cuckolding_p (pk_compiler pkc, int lexical_cuckolding_p)
171 {
172 pkl_set_lexical_cuckolding_p (pkc->compiler, lexical_cuckolding_p);
173 pkc->status = PK_OK;
174 }
175
176 void
pk_set_alien_token_fn(pk_compiler pkc,pk_alien_token_handler_fn cb)177 pk_set_alien_token_fn (pk_compiler pkc, pk_alien_token_handler_fn cb)
178 {
179 pkl_set_alien_token_fn (pkc->compiler, cb);
180 pkc->status = PK_OK;
181 }
182
183 static char *
complete_struct(pk_compiler pkc,int * idx,const char * x,size_t len,int state)184 complete_struct (pk_compiler pkc,
185 int *idx, const char *x, size_t len, int state)
186 {
187 char *ret = NULL;
188 pkl_ast_node type = pkc->complete_type;
189 pkl_ast_node t;
190 size_t trunk_len;
191 int j;
192
193 if (state == 0)
194 {
195 pkl_env compiler_env;
196 int back, over;
197 char *base;
198
199 compiler_env = pkl_get_env (pkc->compiler);
200 base = strndup (x, len - strlen (strchr (x, '.')));
201
202 type = pkl_env_lookup (compiler_env, PKL_ENV_NS_MAIN,
203 base, &back, &over);
204 free (base);
205
206 if (type == NULL || PKL_AST_DECL_KIND (type) != PKL_AST_DECL_KIND_VAR)
207 return NULL;
208
209 type = PKL_AST_TYPE (PKL_AST_DECL_INITIAL (type));
210 type = pkl_struct_type_traverse (type, x);
211 if (type == NULL)
212 {
213 ret = NULL;
214 goto exit;
215 }
216 }
217
218 trunk_len = len - strlen (strrchr (x, '.')) + 1;
219
220 t = PKL_AST_TYPE_S_ELEMS (type);
221
222 for (j = 0; j < (*idx); j++)
223 t = PKL_AST_CHAIN (t);
224
225 for (; t; t = PKL_AST_CHAIN (t), (*idx)++)
226 {
227 pkl_ast_node ename;
228 char *elem;
229
230 if (PKL_AST_CODE (t) == PKL_AST_STRUCT_TYPE_FIELD
231 || (PKL_AST_CODE (t) == PKL_AST_DECL
232 && PKL_AST_DECL_KIND (t) == PKL_AST_DECL_KIND_FUNC
233 && PKL_AST_FUNC_METHOD_P (PKL_AST_DECL_INITIAL (t))))
234 {
235 if (PKL_AST_CODE (t) == PKL_AST_STRUCT_TYPE_FIELD)
236 ename = PKL_AST_STRUCT_TYPE_FIELD_NAME (t);
237 else
238 ename = PKL_AST_DECL_NAME (t);
239
240 if (ename)
241 elem = PKL_AST_IDENTIFIER_POINTER (ename);
242 else
243 elem = "<unnamed field>";
244
245 if (strncmp (x + trunk_len, elem, len - trunk_len) == 0)
246 {
247 char *name;
248
249 if (asprintf (&name, "%.*s%s", (int) trunk_len, x, elem) == -1)
250 {
251 ret = NULL;
252 goto exit;
253 }
254
255 (*idx)++;
256 ret = name;
257 goto exit;
258 }
259 }
260 }
261
262 exit:
263 pkc->complete_type = type;
264 return ret;
265 }
266
267 /* This function is called repeatedly by the readline library, when
268 generating potential command line completions. It returns
269 command line completion based upon the current state of PKC.
270
271 TEXT is the partial word to be completed. STATE is zero the first
272 time the function is called and non-zero for each subsequent call.
273
274 On each call, the function returns a potential completion. It
275 returns NULL to indicate that there are no more possibilities left. */
276 char *
pk_completion_function(pk_compiler pkc,const char * text,int state)277 pk_completion_function (pk_compiler pkc,
278 const char *text, int state)
279 {
280 char *function_name;
281 static int idx = 0;
282 static struct pkl_ast_node_iter iter;
283 pkl_env env = pkl_get_env (pkc->compiler);
284 if (state == 0)
285 {
286 pkl_env_iter_begin (env, &iter);
287 idx = 0;
288 }
289 else
290 {
291 if (pkl_env_iter_end (env, &iter))
292 idx++;
293 else
294 pkl_env_iter_next (env, &iter);
295 }
296
297 size_t len = strlen (text);
298
299 if ((text[0] != '.') && (strchr (text, '.') != NULL))
300 return complete_struct (pkc, &idx, text, len, state);
301
302 function_name = pkl_env_get_next_matching_decl (env, &iter, text, len);
303 return function_name;
304 }
305
306 /* This function provides command line completion when the tag of an
307 IOS is an appropriate completion.
308
309 TEXT is the partial word to be completed. STATE is zero the first
310 time the function is called and non-zero for each subsequent call.
311
312 On each call, the function returns the tag of an IOS for which
313 that tag and TEXT share a common substring. It returns NULL to
314 indicate that there are no more such tags.
315 */
316 char *
pk_ios_completion_function(pk_compiler pkc,const char * text,int state)317 pk_ios_completion_function (pk_compiler pkc __attribute__ ((unused)),
318 const char *text, int state)
319 {
320 static ios io;
321 if (state == 0)
322 {
323 io = ios_begin ();
324 }
325 else
326 {
327 io = ios_next (io);
328 }
329
330 int len = strlen (text);
331 while (1)
332 {
333 if (ios_end (io))
334 break;
335
336 char buf[16];
337 snprintf (buf, 16, "#%d", ios_get_id (io));
338
339 if (strncmp (buf, text, len) == 0)
340 return strdup (buf);
341
342 io = ios_next (io);
343 }
344
345 return NULL;
346 }
347
348 int
pk_disassemble_function_val(pk_compiler pkc,pk_val val,int native_p)349 pk_disassemble_function_val (pk_compiler pkc,
350 pk_val val, int native_p)
351 {
352 pvm_program program;
353
354 if (!PVM_IS_CLS (val))
355 PK_RETURN (PK_ERROR);
356
357 program = pvm_val_cls_program (val);
358 if (native_p)
359 pvm_disassemble_program_nat (program);
360 else
361 pvm_disassemble_program (program);
362
363 PK_RETURN (PK_OK);
364 }
365
366 int
pk_disassemble_function(pk_compiler pkc,const char * fname,int native_p)367 pk_disassemble_function (pk_compiler pkc,
368 const char *fname, int native_p)
369 {
370 int back, over;
371 pvm_val val;
372
373 pkl_env compiler_env = pkl_get_env (pkc->compiler);
374 pvm_env runtime_env = pvm_get_env (pkc->vm);
375
376 pkl_ast_node decl = pkl_env_lookup (compiler_env,
377 PKL_ENV_NS_MAIN,
378 fname,
379 &back, &over);
380
381 if (decl == NULL
382 || PKL_AST_DECL_KIND (decl) != PKL_AST_DECL_KIND_FUNC)
383 /* Function not found. */
384 PK_RETURN (PK_ERROR);
385
386 val = pvm_env_lookup (runtime_env, back, over);
387 PK_RETURN (pk_disassemble_function_val (pkc, val, native_p));
388 }
389
390 int
pk_disassemble_expression(pk_compiler pkc,const char * str,int native_p)391 pk_disassemble_expression (pk_compiler pkc, const char *str,
392 int native_p)
393 {
394 const char *end;
395 const char *program_string;
396
397 pvm_program program;
398
399 program_string = str;
400 program = pkl_compile_expression (pkc->compiler,
401 program_string, &end);
402
403 if (program == NULL)
404 /* Invalid expression. */
405 PK_RETURN (PK_ERROR);
406
407 if (*end != '\0')
408 {
409 pvm_destroy_program (program);
410 PK_RETURN (PK_ERROR);
411 }
412
413 if (native_p)
414 pvm_disassemble_program_nat (program);
415 else
416 pvm_disassemble_program (program);
417
418 PK_RETURN (PK_OK);
419 }
420
421 void
pk_print_profile(pk_compiler pkc)422 pk_print_profile (pk_compiler pkc)
423 {
424 pvm_print_profile (pkc->vm);
425 }
426
427 void
pk_reset_profile(pk_compiler pkc)428 pk_reset_profile (pk_compiler pkc)
429 {
430 pvm_reset_profile (pkc->vm);
431 }
432
433 pk_ios
pk_ios_cur(pk_compiler pkc)434 pk_ios_cur (pk_compiler pkc)
435 {
436 pkc->status = PK_OK;
437 return (pk_ios) ios_cur ();
438 }
439
440 void
pk_ios_set_cur(pk_compiler pkc,pk_ios io)441 pk_ios_set_cur (pk_compiler pkc, pk_ios io)
442 {
443 /* XXX use pkc */
444 ios_set_cur ((ios) io);
445 pkc->status = PK_OK;
446 }
447
448 const char *
pk_ios_handler(pk_ios io)449 pk_ios_handler (pk_ios io)
450 {
451 return ios_handler ((ios) io);
452 }
453
454 uint64_t
pk_ios_flags(pk_ios io)455 pk_ios_flags (pk_ios io)
456 {
457 return ios_flags ((ios) io);
458 }
459
460 pk_ios
pk_ios_search(pk_compiler pkc,const char * handler)461 pk_ios_search (pk_compiler pkc, const char *handler)
462 {
463 pkc->status = PK_OK;
464 /* XXX use pkc */
465 return (pk_ios) ios_search (handler);
466 }
467
468 pk_ios
pk_ios_search_by_id(pk_compiler pkc,int id)469 pk_ios_search_by_id (pk_compiler pkc, int id)
470 {
471 pkc->status = PK_OK;
472 /* XXX use pkc */
473 return (pk_ios) ios_search_by_id (id);
474 }
475
476 int
pk_ios_open(pk_compiler pkc,const char * handler,uint64_t flags,int set_cur_p)477 pk_ios_open (pk_compiler pkc,
478 const char *handler, uint64_t flags, int set_cur_p)
479 {
480 int ret;
481
482 /* XXX use pkc */
483 if ((ret = ios_open (handler, flags, set_cur_p)) >= 0)
484 return ret;
485
486 switch (ret)
487 {
488 case IOS_ERROR: pkc->status = PK_ERROR; break;
489 case IOS_ENOMEM: pkc->status = PK_ENOMEM; break;
490 case IOS_EOF: pkc->status = PK_EEOF; break;
491 case IOS_EINVAL:
492 case IOS_EOPEN:
493 pkc->status = PK_EINVAL;
494 break;
495 default:
496 pkc->status = PK_ERROR;
497 }
498 return PK_IOS_NOID;
499 }
500
501 void
pk_ios_close(pk_compiler pkc,pk_ios io)502 pk_ios_close (pk_compiler pkc, pk_ios io)
503 {
504 /* XXX use pkc */
505 ios_close ((ios) io);
506 pkc->status = PK_OK;
507 }
508
509 int
pk_ios_get_id(pk_ios io)510 pk_ios_get_id (pk_ios io)
511 {
512 return ios_get_id ((ios) io);
513 }
514
515 char *
pk_ios_get_dev_if_name(pk_ios io)516 pk_ios_get_dev_if_name (pk_ios io)
517 {
518 return ios_get_dev_if_name ((ios) io);
519 }
520
521 uint64_t
pk_ios_size(pk_ios io)522 pk_ios_size (pk_ios io)
523 {
524 return ios_size ((ios) io);
525 }
526
527 struct ios_map_fn_payload
528 {
529 pk_ios_map_fn cb;
530 void *data;
531 };
532
533 static void
my_ios_map_fn(ios io,void * data)534 my_ios_map_fn (ios io, void *data)
535 {
536 struct ios_map_fn_payload *payload = data;
537 payload->cb ((pk_ios) io, payload->data);
538 }
539
540 void
pk_ios_map(pk_compiler pkc,pk_ios_map_fn cb,void * data)541 pk_ios_map (pk_compiler pkc,
542 pk_ios_map_fn cb, void *data)
543 {
544 struct ios_map_fn_payload payload = { cb, data };
545 /* XXX use pkc */
546 ios_map (my_ios_map_fn, (void *) &payload);
547 pkc->status = PK_OK;
548 }
549
550 struct decl_map_fn_payload
551 {
552 pk_map_decl_fn cb;
553 void *data;
554 };
555
556 static void
my_decl_map_fn(pkl_ast_node decl,void * data)557 my_decl_map_fn (pkl_ast_node decl, void *data)
558 {
559 struct decl_map_fn_payload *payload = data;
560
561 pkl_ast_node decl_name = PKL_AST_DECL_NAME (decl);
562 pkl_ast_node initial = PKL_AST_DECL_INITIAL (decl);
563 pkl_ast_loc loc = PKL_AST_LOC (decl);
564 char *source = PKL_AST_DECL_SOURCE (decl);
565 char *type = NULL;
566 int kind;
567
568 /* Skip mappers, i.e. function declarations whose initials are
569 actually struct types, and not function literals. */
570
571 if (PKL_AST_DECL_KIND (decl) == PKL_AST_DECL_KIND_FUNC
572 && PKL_AST_CODE (initial) != PKL_AST_FUNC)
573 return;
574
575 switch (PKL_AST_DECL_KIND (decl))
576 {
577 case PKL_AST_DECL_KIND_VAR: kind = PK_DECL_KIND_VAR; break;
578 case PKL_AST_DECL_KIND_FUNC: kind = PK_DECL_KIND_FUNC; break;
579 case PKL_AST_DECL_KIND_TYPE: kind = PK_DECL_KIND_TYPE; break;
580 default:
581 /* Ignore this declaration. */
582 return;
583 }
584
585 type
586 = (PKL_AST_TYPE (initial)
587 ? pkl_type_str (PKL_AST_TYPE (initial), 1)
588 : NULL);
589 payload->cb (kind,
590 source,
591 PKL_AST_IDENTIFIER_POINTER (decl_name),
592 type,
593 loc.first_line, loc.last_line,
594 loc.first_column, loc.last_column,
595 payload->data);
596 free (type);
597 }
598
599 void
pk_decl_map(pk_compiler pkc,int kind,pk_map_decl_fn handler,void * data)600 pk_decl_map (pk_compiler pkc, int kind,
601 pk_map_decl_fn handler, void *data)
602 {
603 struct decl_map_fn_payload payload = { handler, data };
604 pkl_env compiler_env = pkl_get_env (pkc->compiler);
605 int pkl_kind;
606
607 pkc->status = PK_OK;
608
609 switch (kind)
610 {
611 case PK_DECL_KIND_VAR: pkl_kind = PKL_AST_DECL_KIND_VAR; break;
612 case PK_DECL_KIND_FUNC: pkl_kind = PKL_AST_DECL_KIND_FUNC; break;
613 case PK_DECL_KIND_TYPE: pkl_kind = PKL_AST_DECL_KIND_TYPE; break;
614 default:
615 return;
616 }
617
618 pkl_env_map_decls (compiler_env, pkl_kind,
619 my_decl_map_fn, (void *) &payload);
620 }
621
622 int
pk_decl_p(pk_compiler pkc,const char * name,int kind)623 pk_decl_p (pk_compiler pkc, const char *name, int kind)
624 {
625 pkl_env compiler_env = pkl_get_env (pkc->compiler);
626 pkl_ast_node decl = pkl_env_lookup (compiler_env,
627 PKL_ENV_NS_MAIN,
628 name,
629 NULL, NULL);
630
631 pkc->status = PK_OK;
632
633 int pkl_kind;
634 switch (kind)
635 {
636 case PK_DECL_KIND_VAR: pkl_kind = PKL_AST_DECL_KIND_VAR; break;
637 case PK_DECL_KIND_FUNC: pkl_kind = PKL_AST_DECL_KIND_FUNC; break;
638 case PK_DECL_KIND_TYPE: pkl_kind = PKL_AST_DECL_KIND_TYPE; break;
639 default:
640 return 0;
641 }
642
643 if (decl && PKL_AST_DECL_KIND (decl) == pkl_kind)
644 return 1;
645 else
646 return 0;
647 }
648
649 pk_val
pk_decl_val(pk_compiler pkc,const char * name)650 pk_decl_val (pk_compiler pkc, const char *name)
651 {
652 pkl_env compiler_env = pkl_get_env (pkc->compiler);
653 pvm_env runtime_env = pvm_get_env (pkc->vm);
654 int back, over;
655 pkl_ast_node decl = pkl_env_lookup (compiler_env,
656 PKL_ENV_NS_MAIN,
657 name,
658 &back, &over);
659
660 pkc->status = PK_OK;
661
662 if (decl == NULL
663 || (PKL_AST_DECL_KIND (decl) != PKL_AST_DECL_KIND_VAR
664 && PKL_AST_DECL_KIND (decl) != PKL_AST_DECL_KIND_FUNC))
665 return PK_NULL;
666
667 return pvm_env_lookup (runtime_env, back, over);
668 }
669
670 void
pk_decl_set_val(pk_compiler pkc,const char * name,pk_val val)671 pk_decl_set_val (pk_compiler pkc, const char *name, pk_val val)
672 {
673 pkl_env compiler_env = pkl_get_env (pkc->compiler);
674 pvm_env runtime_env = pvm_get_env (pkc->vm);
675 int back, over;
676 pkl_ast_node decl = pkl_env_lookup (compiler_env,
677 PKL_ENV_NS_MAIN,
678 name,
679 &back, &over);
680
681 pkc->status = PK_OK;
682
683 if (decl == NULL
684 || (PKL_AST_DECL_KIND (decl) != PKL_AST_DECL_KIND_VAR
685 && PKL_AST_DECL_KIND (decl) != PKL_AST_DECL_KIND_FUNC))
686 return;
687
688 pvm_env_set_var (runtime_env, back, over, val);
689 }
690
691 int
pk_defvar(pk_compiler pkc,const char * varname,pk_val val)692 pk_defvar (pk_compiler pkc, const char *varname, pk_val val)
693 {
694 pvm_env runtime_env = pvm_get_env (pkc->vm);
695
696 if (!pkl_defvar (pkc->compiler, varname, val))
697 PK_RETURN (PK_ERROR);
698 pvm_env_register (runtime_env, val);
699
700 PK_RETURN (PK_OK);
701 }
702
703 int
pk_call(pk_compiler pkc,pk_val cls,pk_val * ret,...)704 pk_call (pk_compiler pkc, pk_val cls, pk_val *ret, ...)
705 {
706 pvm_program program;
707 va_list ap;
708 enum pvm_exit_code rret;
709
710 /* Compile a program that calls the function. */
711 va_start (ap, ret);
712 program = pkl_compile_call (pkc->compiler, cls, ret, ap);
713 va_end (ap);
714 if (!program)
715 PK_RETURN (PK_ERROR);
716
717 /* Run the program in the poke VM. */
718 pvm_program_make_executable (program);
719 rret = pvm_run (pkc->vm, program, ret);
720
721 pvm_destroy_program (program);
722 PK_RETURN (rret == PVM_EXIT_OK ? PK_OK : PK_ERROR);
723 }
724
725 int
pk_obase(pk_compiler pkc)726 pk_obase (pk_compiler pkc)
727 {
728 pkc->status = PK_OK;
729 return pvm_obase (pkc->vm);
730 }
731
732 void
pk_set_obase(pk_compiler pkc,int obase)733 pk_set_obase (pk_compiler pkc, int obase)
734 {
735 pvm_set_obase (pkc->vm, obase);
736 pkc->status = PK_OK;
737 }
738
739 unsigned int
pk_oacutoff(pk_compiler pkc)740 pk_oacutoff (pk_compiler pkc)
741 {
742 pkc->status = PK_OK;
743 return pvm_oacutoff (pkc->vm);
744 }
745
pk_set_oacutoff(pk_compiler pkc,unsigned int oacutoff)746 void pk_set_oacutoff (pk_compiler pkc, unsigned int oacutoff)
747 {
748 pvm_set_oacutoff (pkc->vm, oacutoff);
749 pkc->status = PK_OK;
750 }
751
752 unsigned int
pk_odepth(pk_compiler pkc)753 pk_odepth (pk_compiler pkc)
754 {
755 pkc->status = PK_OK;
756 return pvm_odepth (pkc->vm);
757 }
758
759 void
pk_set_odepth(pk_compiler pkc,unsigned int odepth)760 pk_set_odepth (pk_compiler pkc, unsigned int odepth)
761 {
762 pvm_set_odepth (pkc->vm, odepth);
763 pkc->status = PK_OK;
764 }
765
766 unsigned int
pk_oindent(pk_compiler pkc)767 pk_oindent (pk_compiler pkc)
768 {
769 pkc->status = PK_OK;
770 return pvm_oindent (pkc->vm);
771 }
772
773 void
pk_set_oindent(pk_compiler pkc,unsigned int oindent)774 pk_set_oindent (pk_compiler pkc, unsigned int oindent)
775 {
776 pvm_set_oindent (pkc->vm, oindent);
777 pkc->status = PK_OK;
778 }
779
780 int
pk_omaps(pk_compiler pkc)781 pk_omaps (pk_compiler pkc)
782 {
783 pkc->status = PK_OK;
784 return pvm_omaps (pkc->vm);
785 }
786
787 void
pk_set_omaps(pk_compiler pkc,int omaps_p)788 pk_set_omaps (pk_compiler pkc, int omaps_p)
789 {
790 pvm_set_omaps (pkc->vm, omaps_p);
791 pkc->status = PK_OK;
792 }
793
794 enum pk_omode
pk_omode(pk_compiler pkc)795 pk_omode (pk_compiler pkc)
796 {
797 enum pk_omode omode;
798
799 switch (pvm_omode (pkc->vm))
800 {
801 case PVM_PRINT_FLAT: omode = PK_PRINT_FLAT; break;
802 case PVM_PRINT_TREE: omode = PK_PRINT_TREE; break;
803 default:
804 assert (0);
805 }
806 pkc->status = PK_OK;
807 return omode;
808 }
809
810 void
pk_set_omode(pk_compiler pkc,enum pk_omode omode)811 pk_set_omode (pk_compiler pkc, enum pk_omode omode)
812 {
813 enum pvm_omode mode;
814
815 switch (omode)
816 {
817 case PK_PRINT_FLAT: mode = PVM_PRINT_FLAT; break;
818 case PK_PRINT_TREE: mode = PVM_PRINT_TREE; break;
819 default:
820 assert (0);
821 }
822 pvm_set_omode (pkc->vm, mode);
823 pkc->status = PK_OK;
824 }
825
826 int
pk_error_on_warning(pk_compiler pkc)827 pk_error_on_warning (pk_compiler pkc)
828 {
829 pkc->status = PK_OK;
830 return pkl_error_on_warning (pkc->compiler);
831 }
832
833 void
pk_set_error_on_warning(pk_compiler pkc,int error_on_warning_p)834 pk_set_error_on_warning (pk_compiler pkc, int error_on_warning_p)
835 {
836 pkl_set_error_on_warning (pkc->compiler, error_on_warning_p);
837 pkc->status = PK_OK;
838 }
839
840 enum pk_endian
pk_endian(pk_compiler pkc)841 pk_endian (pk_compiler pkc)
842 {
843 enum pk_endian endian;
844
845 switch (pvm_endian (pkc->vm))
846 {
847 case IOS_ENDIAN_LSB: endian = PK_ENDIAN_LSB; break;
848 case IOS_ENDIAN_MSB: endian = PK_ENDIAN_MSB; break;
849 default:
850 assert (0);
851 }
852 pkc->status = PK_OK;
853 return endian;
854 }
855
856 void
pk_set_endian(pk_compiler pkc,enum pk_endian endian)857 pk_set_endian (pk_compiler pkc, enum pk_endian endian)
858 {
859 enum ios_endian ios_endian;
860
861 switch (endian)
862 {
863 case PK_ENDIAN_LSB: ios_endian = IOS_ENDIAN_LSB; break;
864 case PK_ENDIAN_MSB: ios_endian = IOS_ENDIAN_MSB; break;
865 default:
866 assert (0);
867 }
868 pvm_set_endian (pkc->vm, ios_endian);
869 pkc->status = PK_OK;
870 }
871
872 enum pk_nenc
pk_nenc(pk_compiler pkc)873 pk_nenc (pk_compiler pkc)
874 {
875 enum pk_nenc nenc;
876
877 switch (pvm_nenc (pkc->vm))
878 {
879 case IOS_NENC_1: nenc = PK_NENC_1; break;
880 case IOS_NENC_2: nenc = PK_NENC_2; break;
881 default:
882 assert (0);
883 }
884 pkc->status = PK_OK;
885 return nenc;
886 }
887
888 void
pk_set_nenc(pk_compiler pkc,enum pk_nenc nenc)889 pk_set_nenc (pk_compiler pkc, enum pk_nenc nenc)
890 {
891 enum ios_nenc ios_nenc;
892
893 switch (nenc)
894 {
895 case PK_NENC_1: ios_nenc = IOS_NENC_1; break;
896 case PK_NENC_2: ios_nenc = IOS_NENC_2; break;
897 default:
898 assert (0);
899 }
900 pvm_set_nenc (pkc->vm, ios_nenc);
901 pkc->status = PK_OK;
902 }
903
904 int
pk_pretty_print(pk_compiler pkc)905 pk_pretty_print (pk_compiler pkc)
906 {
907 pkc->status = PK_OK;
908 return pvm_pretty_print (pkc->vm);
909 }
910
911 void
pk_set_pretty_print(pk_compiler pkc,int pretty_print_p)912 pk_set_pretty_print (pk_compiler pkc, int pretty_print_p)
913 {
914 pvm_set_pretty_print (pkc->vm, pretty_print_p);
915 pkc->status = PK_OK;
916 }
917
918 void
pk_print_val(pk_compiler pkc,pk_val val)919 pk_print_val (pk_compiler pkc, pk_val val)
920 {
921 pvm_print_val (pkc->vm, val);
922 pkc->status = PK_OK;
923 }
924
925 void
pk_print_val_with_params(pk_compiler pkc,pk_val val,int depth,int mode,int base,int indent,int acutoff,uint32_t flags)926 pk_print_val_with_params (pk_compiler pkc, pk_val val,
927 int depth, int mode, int base,
928 int indent, int acutoff,
929 uint32_t flags)
930 {
931 pvm_print_val_with_params (pkc->vm, val,
932 depth, mode, base,
933 indent, acutoff, flags);
934 }
935