/* outchar.c */

/* generated by GNU MARST -- Algol-to-C Translator, Version 2.2 */

#include "algol.h"

extern struct desc outchar_0 /* precompiled void procedure */
(     struct arg /* channel: by value integer */,
      struct arg /* str: by name string */,
      struct arg /* int: by value integer */
);

extern struct desc length_0 /* builtin integer procedure */
(     struct arg /* str: by name string */
);

extern struct desc fault_0 /* builtin void procedure */
(     struct arg /* str: by name string */,
      struct arg /* r: by value real */
);

struct dsa_outchar_0
{     /* procedure outchar (level 0) declared at line 26 */
      char *proc;
      char *file;
      int line;
      struct dsa *parent;
      struct dsa *vector[0+1];
      /* level of innermost block = 1 */
      struct mem *old_top_0;
      struct mem *new_top_0;
      struct mem *old_top_1;
      struct mem *new_top_1;
      /* procedure block 1 (level 0) beginning at line 26 */
      struct desc retval;
      /* channel: by value integer
         specified at line 28 and never referenced */
      int channel_1;
      /* str: by name string
         specified at line 29 and first referenced at line 30 */
      char *str_1;
      /* int: by value integer
         specified at line 28 and first referenced at line 30 */
      int int_1;
      /* local block 2 (level 1) beginning at line 30 */
};

static struct desc _thunk_1(void)
{     /* actual parameter at line 31 */
      struct desc res;
      register struct dsa_outchar_0 *dsa_0 = (void *)
         global_dsa->vector[0];
      dsa_0->line = 31;
      res.lval = 1;
      res.type = 'i';
      res.u.int_ptr = &(dsa_0->int_1);
      return res;
}

struct desc outchar_0 /* precompiled void procedure */
(     struct arg channel_1 /* by value integer */,
      struct arg str_1 /* by name string */,
      struct arg int_1 /* by value integer */
)
{     struct dsa_outchar_0 my_dsa;
      register struct dsa_outchar_0 *dsa_0 = &my_dsa;
      my_dsa.proc = "outchar";
      my_dsa.file = "outchar.alg";
      my_dsa.line = 26;
      my_dsa.parent = active_dsa, active_dsa = (struct dsa *)&my_dsa;
      my_dsa.vector[0] = (void *)dsa_0;
      /* start of procedure block 1 (level 0) at line 26 */
      dsa_0->old_top_0 = stack_top;
      my_dsa.line = 28;
      my_dsa.channel_1 = get_int((global_dsa = channel_1.arg2, (*(
         struct desc (*)(void))channel_1.arg1)()));
      my_dsa.str_1 = str_1.arg1;
      my_dsa.line = 28;
      my_dsa.int_1 = get_int((global_dsa = int_1.arg2, (*(struct desc (
         *)(void))int_1.arg1)()));
      dsa_0->new_top_0 = stack_top;
      /* start of local block 2 (level 1) at line 30 */
      dsa_0->old_top_1 = stack_top;
      dsa_0->new_top_1 = stack_top;
      dsa_0->line = 30;
      if (!(or(less(dsa_0->int_1, 1), greater(dsa_0->int_1, get_int((
         global_dsa = (void *)dsa_0, length_0(make_arg(dsa_0->str_1, 
         NULL)))))))) goto _gamma_1;
      dsa_0->line = 31;
      ((global_dsa = (void *)dsa_0, fault_0(make_arg("character not in "
         "string", NULL), make_arg((void *)_thunk_1, dsa_0))));
      goto _omega_1;
_gamma_1:
      dsa_0->line = 33;
      /* inline code */
      outchar(my_dsa.channel_1, my_dsa.str_1[my_dsa.int_1 - 1]);
_omega_1:
      pop_stack(dsa_0->old_top_1);
      /* end of block 2 */
      pop_stack(dsa_0->old_top_0);
      /* end of block 1 */
      my_dsa.retval.lval = 0;
      my_dsa.retval.type = 0;
      active_dsa = my_dsa.parent;
      return my_dsa.retval;
}

/* eof */
