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