3 Commits d7e7829fee ... 5127d52168

Author SHA1 Message Date
  Andrew Whatson 5127d52168 Update generated C sources 1 month ago
  Andrew Whatson bf927dea2e Use clang-format to prettify generated C 1 month ago
  Andrew Whatson 7821441213 Automate calling of static init procedures 1 month ago
9 changed files with 529 additions and 395 deletions
  1. 4 1
      Makefile
  2. 103 82
      append.c
  3. 106 78
      btree.c
  4. 38 28
      hello.c
  5. 5 6
      manifest.scm
  6. 11 0
      ps-init.h
  7. 134 99
      recfun.c
  8. 128 92
      vecfun.c
  9. 0 9
      vecfun.scm

+ 4 - 1
Makefile

@@ -1,6 +1,7 @@
 # Pre-Scheme Makefile
 
 CC=gcc
+FORMAT=clang-format -i
 PRESCHEME=prescheme
 
 CFLAGS=-g -Wall
@@ -22,9 +23,11 @@ all: $(TARGETS)
 %.c: %.scm $(SOURCES)
 	rm -f $@
 	( echo ",batch"; \
-	  echo "(prescheme-compiler '$* '(\"packages.scm\") '$*-init \"$@\")"; \
+	  echo "(prescheme-compiler '$* '(\"packages.scm\") 'ps-init \"$@\""; \
+	  echo " '(header \"#include \\\"ps-init.h\\\"\"))"; \
 	  echo ",exit" ) \
 	| $(PRESCHEME)
+	$(FORMAT) $@
 
 clean:
 	rm -f $(TARGETS)

+ 103 - 82
append.c

@@ -1,46 +1,52 @@
+#include "prescheme.h"
+#include "ps-init.h"
 #include <stdio.h>
-#include <string.h>
 #include <stdlib.h>
-#include "prescheme.h"
-
-static void string_copyB(char*, long, char*, long, long);
-char *string_append(char*, char*);
-long main(long, char**);
+#include <string.h>
 
+static void string_copyB(char *, long, char *, long, long);
+char *string_append(char *, char *);
+long main(long, char **);
 
-static void string_copyB(char *target_0X, long offset_1X, char *source_2X, long start_3X, long end_4X)
-{
+static void string_copyB(char *target_0X, long offset_1X, char *source_2X,
+                         long start_3X, long end_4X) {
   long arg0K1;
   long arg0K0;
   long src_6X;
   long tgt_5X;
- {  arg0K0 = offset_1X;
-  arg0K1 = start_3X;
-  goto L18;}
- L18: {
+  {
+    arg0K0 = offset_1X;
+    arg0K1 = start_3X;
+    goto L18;
+  }
+L18 : {
   tgt_5X = arg0K0;
   src_6X = arg0K1;
   if ((src_6X == end_4X)) {
-    return;}
-  else {
+    return;
+  } else {
     *(target_0X + tgt_5X) = (*(source_2X + src_6X));
     arg0K0 = (1 + tgt_5X);
     arg0K1 = (1 + src_6X);
-    goto L18;}}
+    goto L18;
+  }
 }
-char *string_append(char *a_7X, char *b_8X)
-{
+}
+char *string_append(char *a_7X, char *b_8X) {
   char *target_11X;
   long len_b_10X;
   long len_a_9X;
- {  len_a_9X = strlen((char *) a_7X);
-  len_b_10X = strlen((char *) b_8X);
-  target_11X = (char *)calloc( 1, 1 + (len_a_9X + len_b_10X));string_copyB(target_11X, 0, a_7X, 0, len_a_9X);string_copyB(target_11X, len_a_9X, b_8X, 0, len_b_10X);
-  return target_11X;}
+  {
+    len_a_9X = strlen((char *)a_7X);
+    len_b_10X = strlen((char *)b_8X);
+    target_11X = (char *)calloc(1, 1 + (len_a_9X + len_b_10X));
+    string_copyB(target_11X, 0, a_7X, 0, len_a_9X);
+    string_copyB(target_11X, len_a_9X, b_8X, 0, len_b_10X);
+    return target_11X;
+  }
 }
-long main(long argc_12X, char **argv_13X)
-{
-  FILE * merged_arg2K2;
+long main(long argc_12X, char **argv_13X) {
+  FILE *merged_arg2K2;
   char *merged_arg1K1;
   char *merged_arg1K0;
 
@@ -52,86 +58,101 @@ long main(long argc_12X, char **argv_13X)
   char demo_string_append0_return_value;
   char *a_14X;
   char *b_15X;
-  FILE * out_16X;
+  FILE *out_16X;
   char *target_23X;
   long len_b_22X;
   long len_a_21X;
-  FILE * out_20X;
+  FILE *out_20X;
   char *b_19X;
   char *a_18X;
-  FILE * out_17X;
- {  if ((3 == argc_12X)) {
-    out_17X = stdout;
-    a_18X = *(argv_13X + 1);
-    b_19X = *(argv_13X + 2);
-    merged_arg1K0 = a_18X;
-    merged_arg1K1 = a_18X;
-    merged_arg2K2 = out_17X;
+  FILE *out_17X;
+  {
+    if ((3 == argc_12X)) {
+      out_17X = stdout;
+      a_18X = *(argv_13X + 1);
+      b_19X = *(argv_13X + 2);
+      merged_arg1K0 = a_18X;
+      merged_arg1K1 = a_18X;
+      merged_arg2K2 = out_17X;
 #ifdef USE_DIRECT_THREADING
-    demo_string_append_return_address = &&demo_string_append_return_0;
+      demo_string_append_return_address = &&demo_string_append_return_0;
 #else
-    demo_string_append_return_tag = 0;
+      demo_string_append_return_tag = 0;
 #endif
-    goto demo_string_append;
-   demo_string_append_return_0:
-    merged_arg1K0 = a_18X;
-    merged_arg1K1 = b_19X;
-    merged_arg2K2 = out_17X;
+      goto demo_string_append;
+    demo_string_append_return_0:
+      merged_arg1K0 = a_18X;
+      merged_arg1K1 = b_19X;
+      merged_arg2K2 = out_17X;
 #ifdef USE_DIRECT_THREADING
-    demo_string_append_return_address = &&demo_string_append_return_1;
+      demo_string_append_return_address = &&demo_string_append_return_1;
 #else
-    demo_string_append_return_tag = 1;
+      demo_string_append_return_tag = 1;
 #endif
-    goto demo_string_append;
-   demo_string_append_return_1:
-    merged_arg1K0 = b_19X;
-    merged_arg1K1 = b_19X;
-    merged_arg2K2 = out_17X;
+      goto demo_string_append;
+    demo_string_append_return_1:
+      merged_arg1K0 = b_19X;
+      merged_arg1K1 = b_19X;
+      merged_arg2K2 = out_17X;
 #ifdef USE_DIRECT_THREADING
-    demo_string_append_return_address = &&demo_string_append_return_2;
+      demo_string_append_return_address = &&demo_string_append_return_2;
 #else
-    demo_string_append_return_tag = 2;
+      demo_string_append_return_tag = 2;
 #endif
-    goto demo_string_append;
-   demo_string_append_return_2:
-    return 0;}
-  else {
-    out_20X = stderr;
-    ps_write_string("Usage: ", out_20X);
-    ps_write_string((*(argv_13X + 0)), out_20X);
-    ps_write_string(" <string-a> <string-b>", out_20X);
-    { long ignoreXX;
-    PS_WRITE_CHAR(10, out_20X, ignoreXX) }
-    ps_write_string("  Prints permutations of <string-a> and <string-b>.", out_20X);
-    { long ignoreXX;
-    PS_WRITE_CHAR(10, out_20X, ignoreXX) }
-    return 1;}}
- demo_string_append: {
+      goto demo_string_append;
+    demo_string_append_return_2:
+      return 0;
+    } else {
+      out_20X = stderr;
+      ps_write_string("Usage: ", out_20X);
+      ps_write_string((*(argv_13X + 0)), out_20X);
+      ps_write_string(" <string-a> <string-b>", out_20X);
+      {
+        long ignoreXX;
+        PS_WRITE_CHAR(10, out_20X, ignoreXX)
+      }
+      ps_write_string("  Prints permutations of <string-a> and <string-b>.",
+                      out_20X);
+      {
+        long ignoreXX;
+        PS_WRITE_CHAR(10, out_20X, ignoreXX)
+      }
+      return 1;
+    }
+  }
+demo_string_append : {
   a_14X = merged_arg1K0;
   b_15X = merged_arg1K1;
-  out_16X = merged_arg2K2;{
-  len_a_21X = strlen((char *) a_14X);
-  len_b_22X = strlen((char *) b_15X);
-  target_23X = (char *)calloc( 1, 1 + (len_a_21X + len_b_22X));string_copyB(target_23X, 0, a_14X, 0, len_a_21X);string_copyB(target_23X, len_a_21X, b_15X, 0, len_b_22X);
-  ps_write_string(target_23X, out_16X);
-  { long ignoreXX;
-  PS_WRITE_CHAR(10, out_16X, ignoreXX) }
-  free(target_23X);
-  demo_string_append0_return_value = 1;
+  out_16X = merged_arg2K2;
+  {
+    len_a_21X = strlen((char *)a_14X);
+    len_b_22X = strlen((char *)b_15X);
+    target_23X = (char *)calloc(1, 1 + (len_a_21X + len_b_22X));
+    string_copyB(target_23X, 0, a_14X, 0, len_a_21X);
+    string_copyB(target_23X, len_a_21X, b_15X, 0, len_b_22X);
+    ps_write_string(target_23X, out_16X);
+    {
+      long ignoreXX;
+      PS_WRITE_CHAR(10, out_16X, ignoreXX)
+    }
+    free(target_23X);
+    demo_string_append0_return_value = 1;
 #ifdef USE_DIRECT_THREADING
-  goto *demo_string_append_return_address;
+    goto *demo_string_append_return_address;
 #else
-  goto demo_string_append_return;
+    goto demo_string_append_return;
 #endif
-}
+  }
 #ifndef USE_DIRECT_THREADING
- demo_string_append_return:
+demo_string_append_return:
   switch (demo_string_append_return_tag) {
-  case 0: goto demo_string_append_return_0;
-  case 1: goto demo_string_append_return_1;
-  default: goto demo_string_append_return_2;
+  case 0:
+    goto demo_string_append_return_0;
+  case 1:
+    goto demo_string_append_return_1;
+  default:
+    goto demo_string_append_return_2;
   }
 #endif
 }
-
 }

+ 106 - 78
btree.c

@@ -1,68 +1,79 @@
+#include "prescheme.h"
+#include "ps-init.h"
 #include <stdio.h>
-#include <string.h>
 #include <stdlib.h>
-#include "prescheme.h"
+#include <string.h>
 
 struct btree_node {
   struct btree_node *left;
   struct btree_node *right;
   long value;
 };
-static void deallocate_btree(struct btree_node*);
-static char btree_equalP(struct btree_node*, struct btree_node*);
+static void deallocate_btree(struct btree_node *);
+static char btree_equalP(struct btree_node *, struct btree_node *);
 long main(void);
 
-
-static void deallocate_btree(struct btree_node *t_0X)
-{
+static void deallocate_btree(struct btree_node *t_0X) {
   struct btree_node *v_2X;
   struct btree_node *v_1X;
- {  v_1X = t_0X->left;
-  if ((NULL == v_1X)) {
-    goto L91;}
-  else {deallocate_btree((t_0X->left));
-    goto L91;}}
- L91: {
+  {
+    v_1X = t_0X->left;
+    if ((NULL == v_1X)) {
+      goto L91;
+    } else {
+      deallocate_btree((t_0X->left));
+      goto L91;
+    }
+  }
+L91 : {
   v_2X = t_0X->right;
   if ((NULL == v_2X)) {
-    goto L105;}
-  else {deallocate_btree((t_0X->right));
-    goto L105;}}
- L105: {
+    goto L105;
+  } else {
+    deallocate_btree((t_0X->right));
+    goto L105;
+  }
+}
+L105 : {
   free(t_0X);
-  return;}
+  return;
 }
-static char btree_equalP(struct btree_node *a_3X, struct btree_node *b_4X)
-{
+}
+static char btree_equalP(struct btree_node *a_3X, struct btree_node *b_4X) {
   struct btree_node *arg0K1;
   struct btree_node *arg0K0;
   char v_8X;
   char temp_7X;
   struct btree_node *b_6X;
   struct btree_node *a_5X;
- {  arg0K0 = a_3X;
-  arg0K1 = b_4X;
-  goto L358;}
- L358: {
+  {
+    arg0K0 = a_3X;
+    arg0K1 = b_4X;
+    goto L358;
+  }
+L358 : {
   a_5X = arg0K0;
   b_6X = arg0K1;
   temp_7X = a_5X == b_6X;
   if (temp_7X) {
-    return temp_7X;}
-  else {
+    return temp_7X;
+  } else {
     if (((a_5X->value) == (b_6X->value))) {
       v_8X = btree_equalP((a_5X->left), (b_6X->left));
       if (v_8X) {
         arg0K0 = (a_5X->right);
         arg0K1 = (b_6X->right);
-        goto L358;}
-      else {
-        return 0;}}
-    else {
-      return 0;}}}
+        goto L358;
+      } else {
+        return 0;
+      }
+    } else {
+      return 0;
+    }
+  }
+}
 }
-long main(void)
-{
+long main(void) {
   struct btree_node *arg0K0;
   char v_23X;
   struct btree_node *c2_22X;
@@ -78,89 +89,106 @@ long main(void)
   struct btree_node *a1_12X;
   struct btree_node *btree_node_11X;
   struct btree_node *null_10X;
-  FILE * out_9X;
- {  out_9X = stdout;
-  null_10X = NULL;
-  btree_node_11X = (struct btree_node*)malloc(sizeof(struct btree_node));
-  if ((NULL == btree_node_11X)) {
-    arg0K0 = btree_node_11X;
-    goto L219;}
-  else {
-    btree_node_11X->left = null_10X;
-    btree_node_11X->right = null_10X;
-    btree_node_11X->value = 6;
-    arg0K0 = btree_node_11X;
-    goto L219;}}
- L219: {
+  FILE *out_9X;
+  {
+    out_9X = stdout;
+    null_10X = NULL;
+    btree_node_11X = (struct btree_node *)malloc(sizeof(struct btree_node));
+    if ((NULL == btree_node_11X)) {
+      arg0K0 = btree_node_11X;
+      goto L219;
+    } else {
+      btree_node_11X->left = null_10X;
+      btree_node_11X->right = null_10X;
+      btree_node_11X->value = 6;
+      arg0K0 = btree_node_11X;
+      goto L219;
+    }
+  }
+L219 : {
   a1_12X = arg0K0;
-  btree_node_13X = (struct btree_node*)malloc(sizeof(struct btree_node));
+  btree_node_13X = (struct btree_node *)malloc(sizeof(struct btree_node));
   if ((NULL == btree_node_13X)) {
     arg0K0 = btree_node_13X;
-    goto L223;}
-  else {
+    goto L223;
+  } else {
     btree_node_13X->left = null_10X;
     btree_node_13X->right = null_10X;
     btree_node_13X->value = 5;
     arg0K0 = btree_node_13X;
-    goto L223;}}
- L223: {
+    goto L223;
+  }
+}
+L223 : {
   b1_14X = arg0K0;
-  btree_node_15X = (struct btree_node*)malloc(sizeof(struct btree_node));
+  btree_node_15X = (struct btree_node *)malloc(sizeof(struct btree_node));
   if ((NULL == btree_node_15X)) {
     arg0K0 = btree_node_15X;
-    goto L227;}
-  else {
+    goto L227;
+  } else {
     btree_node_15X->left = a1_12X;
     btree_node_15X->right = b1_14X;
     btree_node_15X->value = 4;
     arg0K0 = btree_node_15X;
-    goto L227;}}
- L227: {
+    goto L227;
+  }
+}
+L227 : {
   c1_16X = arg0K0;
-  btree_node_17X = (struct btree_node*)malloc(sizeof(struct btree_node));
+  btree_node_17X = (struct btree_node *)malloc(sizeof(struct btree_node));
   if ((NULL == btree_node_17X)) {
     arg0K0 = btree_node_17X;
-    goto L231;}
-  else {
+    goto L231;
+  } else {
     btree_node_17X->left = null_10X;
     btree_node_17X->right = null_10X;
     btree_node_17X->value = 6;
     arg0K0 = btree_node_17X;
-    goto L231;}}
- L231: {
+    goto L231;
+  }
+}
+L231 : {
   a2_18X = arg0K0;
-  btree_node_19X = (struct btree_node*)malloc(sizeof(struct btree_node));
+  btree_node_19X = (struct btree_node *)malloc(sizeof(struct btree_node));
   if ((NULL == btree_node_19X)) {
     arg0K0 = btree_node_19X;
-    goto L235;}
-  else {
+    goto L235;
+  } else {
     btree_node_19X->left = null_10X;
     btree_node_19X->right = null_10X;
     btree_node_19X->value = 5;
     arg0K0 = btree_node_19X;
-    goto L235;}}
- L235: {
+    goto L235;
+  }
+}
+L235 : {
   b2_20X = arg0K0;
-  btree_node_21X = (struct btree_node*)malloc(sizeof(struct btree_node));
+  btree_node_21X = (struct btree_node *)malloc(sizeof(struct btree_node));
   if ((NULL == btree_node_21X)) {
     arg0K0 = btree_node_21X;
-    goto L239;}
-  else {
+    goto L239;
+  } else {
     btree_node_21X->left = a2_18X;
     btree_node_21X->right = b2_20X;
     btree_node_21X->value = 4;
     arg0K0 = btree_node_21X;
-    goto L239;}}
- L239: {
+    goto L239;
+  }
+}
+L239 : {
   c2_22X = arg0K0;
   v_23X = btree_equalP(c1_16X, c2_22X);
   if (v_23X) {
     ps_write_string("trees are equal\n", out_9X);
-    goto L249;}
-  else {
+    goto L249;
+  } else {
     ps_write_string("trees are not equal\n", out_9X);
-    goto L249;}}
- L249: {
-deallocate_btree(c1_16X);deallocate_btree(c2_22X);
-  return 0;}
+    goto L249;
+  }
+}
+L249 : {
+  deallocate_btree(c1_16X);
+  deallocate_btree(c2_22X);
+  return 0;
+}
 }

+ 38 - 28
hello.c

@@ -1,33 +1,43 @@
+#include "prescheme.h"
+#include "ps-init.h"
 #include <stdio.h>
-#include <string.h>
 #include <stdlib.h>
-#include "prescheme.h"
-
-long main(long, char**);
+#include <string.h>
 
+long main(long, char **);
 
-long main(long argc_0X, char **argv_1X)
-{
-  FILE * out_3X;
-  FILE * out_2X;
- {  if ((2 == argc_0X)) {
-    out_2X = stdout;
-    ps_write_string("Hello, world, ", out_2X);
-    ps_write_string((*(argv_1X + 1)), out_2X);
-    { long ignoreXX;
-    PS_WRITE_CHAR(33, out_2X, ignoreXX) }
-    { long ignoreXX;
-    PS_WRITE_CHAR(10, out_2X, ignoreXX) }
-    return 0;}
-  else {
-    out_3X = stderr;
-    ps_write_string("Usage: ", out_3X);
-    ps_write_string((*(argv_1X + 0)), out_3X);
-    ps_write_string(" <user>", out_3X);
-    { long ignoreXX;
-    PS_WRITE_CHAR(10, out_3X, ignoreXX) }
-    ps_write_string("  Greets the world & <user>.", out_3X);
-    { long ignoreXX;
-    PS_WRITE_CHAR(10, out_3X, ignoreXX) }
-    return 1;}}
+long main(long argc_0X, char **argv_1X) {
+  FILE *out_3X;
+  FILE *out_2X;
+  {
+    if ((2 == argc_0X)) {
+      out_2X = stdout;
+      ps_write_string("Hello, world, ", out_2X);
+      ps_write_string((*(argv_1X + 1)), out_2X);
+      {
+        long ignoreXX;
+        PS_WRITE_CHAR(33, out_2X, ignoreXX)
+      }
+      {
+        long ignoreXX;
+        PS_WRITE_CHAR(10, out_2X, ignoreXX)
+      }
+      return 0;
+    } else {
+      out_3X = stderr;
+      ps_write_string("Usage: ", out_3X);
+      ps_write_string((*(argv_1X + 0)), out_3X);
+      ps_write_string(" <user>", out_3X);
+      {
+        long ignoreXX;
+        PS_WRITE_CHAR(10, out_3X, ignoreXX)
+      }
+      ps_write_string("  Greets the world & <user>.", out_3X);
+      {
+        long ignoreXX;
+        PS_WRITE_CHAR(10, out_3X, ignoreXX)
+      }
+      return 1;
+    }
+  }
 }

+ 5 - 6
manifest.scm

@@ -1,9 +1,6 @@
-(use-modules (guix gexp)
-             ((guix licenses) #:select (bsd-3))
-             (guix packages)
-             (guix profiles)
-             (gnu packages base)
+(use-modules (guix profiles)
              (gnu packages commencement)
+             (gnu packages llvm)
              (gnu packages pkg-config)
              (gnu packages scheme))
 
@@ -11,4 +8,6 @@
  (list scheme48-prescheme
        gcc-toolchain
        gnu-make
-       pkg-config))
+       pkg-config
+       clang ;; for clang-format
+       ))

+ 11 - 0
ps-init.h

@@ -0,0 +1,11 @@
+/*
+ * Call Pre-Scheme static initialization before main.
+ */
+__attribute__((constructor))
+void ps_init(void);
+
+/*
+ * Missing definition for open-input-file.  Probably an oversight, it's
+ * defined in scheme48.h but should be in prescheme.h.
+ */
+#define NO_ERRORS 0

+ 134 - 99
recfun.c

@@ -1,7 +1,8 @@
+#include "prescheme.h"
+#include "ps-init.h"
 #include <stdio.h>
-#include <string.h>
 #include <stdlib.h>
-#include "prescheme.h"
+#include <string.h>
 
 struct vec2 {
   long x;
@@ -11,44 +12,52 @@ struct rect {
   struct vec2 *tl;
   struct vec2 *wh;
 };
-long write_vec2(struct vec2*, FILE *);
-long write_rect(struct rect*, FILE *);
+long write_vec2(struct vec2 *, FILE *);
+long write_rect(struct rect *, FILE *);
 long main(void);
 
-
-long write_vec2(struct vec2 *a_0X, FILE * port_1X)
-{
+long write_vec2(struct vec2 *a_0X, FILE *port_1X) {
   long v_2X;
- {  ps_write_string("#<vec2 ", port_1X);
-  ps_write_integer((a_0X->x), port_1X);
-  { long ignoreXX;
-  PS_WRITE_CHAR(32, port_1X, ignoreXX) }
-  ps_write_integer((a_0X->y), port_1X);
-  PS_WRITE_CHAR(62, port_1X, v_2X)
-  return v_2X;}
+  {
+    ps_write_string("#<vec2 ", port_1X);
+    ps_write_integer((a_0X->x), port_1X);
+    {
+      long ignoreXX;
+      PS_WRITE_CHAR(32, port_1X, ignoreXX)
+    }
+    ps_write_integer((a_0X->y), port_1X);
+    PS_WRITE_CHAR(62, port_1X, v_2X)
+    return v_2X;
+  }
 }
-long write_rect(struct rect *a_3X, FILE * port_4X)
-{
+long write_rect(struct rect *a_3X, FILE *port_4X) {
   long v_5X;
- {  ps_write_string("#<rect ", port_4X);
-  ps_write_integer(((a_3X->tl)->x), port_4X);
-  { long ignoreXX;
-  PS_WRITE_CHAR(32, port_4X, ignoreXX) }
-  ps_write_integer(((a_3X->tl)->y), port_4X);
-  { long ignoreXX;
-  PS_WRITE_CHAR(32, port_4X, ignoreXX) }
-  ps_write_integer(((a_3X->wh)->x), port_4X);
-  { long ignoreXX;
-  PS_WRITE_CHAR(32, port_4X, ignoreXX) }
-  ps_write_integer(((a_3X->wh)->y), port_4X);
-  PS_WRITE_CHAR(62, port_4X, v_5X)
-  return v_5X;}
+  {
+    ps_write_string("#<rect ", port_4X);
+    ps_write_integer(((a_3X->tl)->x), port_4X);
+    {
+      long ignoreXX;
+      PS_WRITE_CHAR(32, port_4X, ignoreXX)
+    }
+    ps_write_integer(((a_3X->tl)->y), port_4X);
+    {
+      long ignoreXX;
+      PS_WRITE_CHAR(32, port_4X, ignoreXX)
+    }
+    ps_write_integer(((a_3X->wh)->x), port_4X);
+    {
+      long ignoreXX;
+      PS_WRITE_CHAR(32, port_4X, ignoreXX)
+    }
+    ps_write_integer(((a_3X->wh)->y), port_4X);
+    PS_WRITE_CHAR(62, port_4X, v_5X)
+    return v_5X;
+  }
 }
-long main(void)
-{
+long main(void) {
   struct rect *arg1K0;
   struct vec2 *arg0K0;
-  FILE * merged_arg3K2;
+  FILE *merged_arg3K2;
   struct vec2 *merged_arg0K1;
   char *merged_arg2K0;
 
@@ -59,7 +68,7 @@ long main(void)
 #endif
   char *name_6X;
   struct vec2 *corner_7X;
-  FILE * out_8X;
+  FILE *out_8X;
   struct vec2 *v_31X;
   struct vec2 *vec2_30X;
   long y_29X;
@@ -82,55 +91,67 @@ long main(void)
   struct vec2 *vec2_12X;
   struct vec2 *tl_11X;
   struct vec2 *vec2_10X;
-  FILE * out_9X;
- {  out_9X = stdout;
-  vec2_10X = (struct vec2*)malloc(sizeof(struct vec2));
-  if ((NULL == vec2_10X)) {
-    arg0K0 = vec2_10X;
-    goto L389;}
-  else {
-    vec2_10X->x = 10;
-    vec2_10X->y = 10;
-    arg0K0 = vec2_10X;
-    goto L389;}}
- L389: {
+  FILE *out_9X;
+  {
+    out_9X = stdout;
+    vec2_10X = (struct vec2 *)malloc(sizeof(struct vec2));
+    if ((NULL == vec2_10X)) {
+      arg0K0 = vec2_10X;
+      goto L389;
+    } else {
+      vec2_10X->x = 10;
+      vec2_10X->y = 10;
+      arg0K0 = vec2_10X;
+      goto L389;
+    }
+  }
+L389 : {
   tl_11X = arg0K0;
-  vec2_12X = (struct vec2*)malloc(sizeof(struct vec2));
+  vec2_12X = (struct vec2 *)malloc(sizeof(struct vec2));
   if ((NULL == vec2_12X)) {
     arg0K0 = vec2_12X;
-    goto L391;}
-  else {
+    goto L391;
+  } else {
     vec2_12X->x = 2;
     vec2_12X->y = 2;
     arg0K0 = vec2_12X;
-    goto L391;}}
- L391: {
+    goto L391;
+  }
+}
+L391 : {
   wh_13X = arg0K0;
-  rect_14X = (struct rect*)malloc(sizeof(struct rect));
+  rect_14X = (struct rect *)malloc(sizeof(struct rect));
   if ((NULL == rect_14X)) {
     arg1K0 = rect_14X;
-    goto L393;}
-  else {
+    goto L393;
+  } else {
     rect_14X->tl = tl_11X;
     rect_14X->wh = wh_13X;
     arg1K0 = rect_14X;
-    goto L393;}}
- L393: {
-  a_15X = arg1K0;write_rect(a_15X, out_9X);
-  { long ignoreXX;
-  PS_WRITE_CHAR(10, out_9X, ignoreXX) }
+    goto L393;
+  }
+}
+L393 : {
+  a_15X = arg1K0;
+  write_rect(a_15X, out_9X);
+  {
+    long ignoreXX;
+    PS_WRITE_CHAR(10, out_9X, ignoreXX)
+  }
   x_16X = (a_15X->tl)->x;
   y_17X = (a_15X->tl)->y;
-  vec2_18X = (struct vec2*)malloc(sizeof(struct vec2));
+  vec2_18X = (struct vec2 *)malloc(sizeof(struct vec2));
   if ((NULL == vec2_18X)) {
     arg0K0 = vec2_18X;
-    goto L417;}
-  else {
+    goto L417;
+  } else {
     vec2_18X->x = x_16X;
     vec2_18X->y = y_17X;
     arg0K0 = vec2_18X;
-    goto L417;}}
- L417: {
+    goto L417;
+  }
+}
+L417 : {
   v_19X = arg0K0;
   merged_arg2K0 = "top-left";
   merged_arg0K1 = v_19X;
@@ -141,19 +162,21 @@ long main(void)
   write_cornerD0_return_tag = 0;
 #endif
   goto write_cornerD0;
- write_cornerD0_return_0:
+write_cornerD0_return_0:
   x_20X = ((a_15X->tl)->x) + ((a_15X->wh)->x);
   y_21X = (a_15X->tl)->y;
-  vec2_22X = (struct vec2*)malloc(sizeof(struct vec2));
+  vec2_22X = (struct vec2 *)malloc(sizeof(struct vec2));
   if ((NULL == vec2_22X)) {
     arg0K0 = vec2_22X;
-    goto L421;}
-  else {
+    goto L421;
+  } else {
     vec2_22X->x = x_20X;
     vec2_22X->y = y_21X;
     arg0K0 = vec2_22X;
-    goto L421;}}
- L421: {
+    goto L421;
+  }
+}
+L421 : {
   v_23X = arg0K0;
   merged_arg2K0 = "top-right";
   merged_arg0K1 = v_23X;
@@ -164,19 +187,21 @@ long main(void)
   write_cornerD0_return_tag = 1;
 #endif
   goto write_cornerD0;
- write_cornerD0_return_1:
+write_cornerD0_return_1:
   x_24X = (a_15X->tl)->x;
   y_25X = ((a_15X->tl)->y) + ((a_15X->wh)->y);
-  vec2_26X = (struct vec2*)malloc(sizeof(struct vec2));
+  vec2_26X = (struct vec2 *)malloc(sizeof(struct vec2));
   if ((NULL == vec2_26X)) {
     arg0K0 = vec2_26X;
-    goto L425;}
-  else {
+    goto L425;
+  } else {
     vec2_26X->x = x_24X;
     vec2_26X->y = y_25X;
     arg0K0 = vec2_26X;
-    goto L425;}}
- L425: {
+    goto L425;
+  }
+}
+L425 : {
   v_27X = arg0K0;
   merged_arg2K0 = "bottom-left";
   merged_arg0K1 = v_27X;
@@ -187,19 +212,21 @@ long main(void)
   write_cornerD0_return_tag = 2;
 #endif
   goto write_cornerD0;
- write_cornerD0_return_2:
+write_cornerD0_return_2:
   x_28X = ((a_15X->tl)->x) + ((a_15X->wh)->x);
   y_29X = ((a_15X->tl)->y) + ((a_15X->wh)->y);
-  vec2_30X = (struct vec2*)malloc(sizeof(struct vec2));
+  vec2_30X = (struct vec2 *)malloc(sizeof(struct vec2));
   if ((NULL == vec2_30X)) {
     arg0K0 = vec2_30X;
-    goto L429;}
-  else {
+    goto L429;
+  } else {
     vec2_30X->x = x_28X;
     vec2_30X->y = y_29X;
     arg0K0 = vec2_30X;
-    goto L429;}}
- L429: {
+    goto L429;
+  }
+}
+L429 : {
   v_31X = arg0K0;
   merged_arg2K0 = "bottom-right";
   merged_arg0K1 = v_31X;
@@ -210,32 +237,40 @@ long main(void)
   write_cornerD0_return_tag = 3;
 #endif
   goto write_cornerD0;
- write_cornerD0_return_3:
-  return 0;}
- write_cornerD0: {
+write_cornerD0_return_3:
+  return 0;
+}
+write_cornerD0 : {
   name_6X = merged_arg2K0;
   corner_7X = merged_arg0K1;
-  out_8X = merged_arg3K2;{
-  ps_write_string(name_6X, out_8X);
-  ps_write_string(": ", out_8X);write_vec2(corner_7X, out_8X);
-  { long ignoreXX;
-  PS_WRITE_CHAR(10, out_8X, ignoreXX) }
-  free(corner_7X);
+  out_8X = merged_arg3K2;
+  {
+    ps_write_string(name_6X, out_8X);
+    ps_write_string(": ", out_8X);
+    write_vec2(corner_7X, out_8X);
+    {
+      long ignoreXX;
+      PS_WRITE_CHAR(10, out_8X, ignoreXX)
+    }
+    free(corner_7X);
 #ifdef USE_DIRECT_THREADING
-  goto *write_cornerD0_return_address;
+    goto *write_cornerD0_return_address;
 #else
-  goto write_cornerD0_return;
+    goto write_cornerD0_return;
 #endif
-}
+  }
 #ifndef USE_DIRECT_THREADING
- write_cornerD0_return:
+write_cornerD0_return:
   switch (write_cornerD0_return_tag) {
-  case 0: goto write_cornerD0_return_0;
-  case 1: goto write_cornerD0_return_1;
-  case 2: goto write_cornerD0_return_2;
-  default: goto write_cornerD0_return_3;
+  case 0:
+    goto write_cornerD0_return_0;
+  case 1:
+    goto write_cornerD0_return_1;
+  case 2:
+    goto write_cornerD0_return_2;
+  default:
+    goto write_cornerD0_return_3;
   }
 #endif
 }
-
 }

+ 128 - 92
vecfun.c

@@ -1,13 +1,13 @@
+#include "prescheme.h"
+#include "ps-init.h"
 #include <stdio.h>
-#include <string.h>
 #include <stdlib.h>
-#include "prescheme.h"
+#include <string.h>
 
 long main(void);
 static long *Qvec_a;
 
-long main(void)
-{
+long main(void) {
   char **arg2K1;
   long *arg1K1;
   long arg0K1;
@@ -53,37 +53,47 @@ long main(void)
   long i_6X;
   long val_5X;
   long i_4X;
-  FILE * out_3X;
- {  out_3X = stdout;vecfun_init();
-  ps_write_string("Print vec-a with vector-for-each:\n", out_3X);
-  arg0K0 = 0;
-  goto L380;}
- L380: {
+  FILE *out_3X;
+  {
+    out_3X = stdout;
+    ps_write_string("Print vec-a with vector-for-each:\n", out_3X);
+    arg0K0 = 0;
+    goto L376;
+  }
+L376 : {
   i_4X = arg0K0;
   if ((5 == i_4X)) {
-    ps_write_string("Print the last value of vec-a with vector-fold:\n", out_3X);
+    ps_write_string("Print the last value of vec-a with vector-fold:\n",
+                    out_3X);
     arg0K0 = 0;
     arg0K1 = -1;
-    goto L397;}
-  else {
+    goto L393;
+  } else {
     val_5X = *(Qvec_a + i_4X);
     ps_write_string(" vec-a[", out_3X);
     ps_write_integer(i_4X, out_3X);
     ps_write_string("] = ", out_3X);
     ps_write_integer(val_5X, out_3X);
-    { long ignoreXX;
-    PS_WRITE_CHAR(10, out_3X, ignoreXX) }
+    {
+      long ignoreXX;
+      PS_WRITE_CHAR(10, out_3X, ignoreXX)
+    }
     arg0K0 = (1 + i_4X);
-    goto L380;}}
- L397: {
+    goto L376;
+  }
+}
+L393 : {
   i_6X = arg0K0;
   result_7X = arg0K1;
   if ((5 == i_6X)) {
     ps_write_string(" vec-a[-1] = ", out_3X);
     ps_write_integer(result_7X, out_3X);
-    { long ignoreXX;
-    PS_WRITE_CHAR(10, out_3X, ignoreXX) }
-    ps_write_string("Compute the sum of two vectors with vector-map:\n", out_3X);
+    {
+      long ignoreXX;
+      PS_WRITE_CHAR(10, out_3X, ignoreXX)
+    }
+    ps_write_string("Compute the sum of two vectors with vector-map:\n",
+                    out_3X);
     merged_arg0K0 = (*(Qvec_a + 0));
     merged_arg0K1 = (*(Qvec_a + 0));
 #ifdef USE_DIRECT_THREADING
@@ -92,22 +102,24 @@ long main(void)
     procD0_return_tag = 0;
 #endif
     goto procD0;
-   procD0_return_0:
+  procD0_return_0:
     v_8X = procD00_return_value;
     arg0K0 = 0;
-    arg1K1 = ((long*)malloc(sizeof(long) * 5));
-    goto L214;}
-  else {
+    arg1K1 = ((long *)malloc(sizeof(long) * 5));
+    goto L212;
+  } else {
     arg0K0 = (1 + i_6X);
     arg0K1 = (*(Qvec_a + i_6X));
-    goto L397;}}
- L214: {
+    goto L393;
+  }
+}
+L212 : {
   i_9X = arg0K0;
   result_10X = arg1K1;
   if ((5 == i_9X)) {
     arg0K0 = 0;
-    goto L413;}
-  else {
+    goto L409;
+  } else {
     merged_arg0K0 = (*(Qvec_a + i_9X));
     merged_arg0K1 = (*(Qvec_a + i_9X));
 #ifdef USE_DIRECT_THREADING
@@ -116,13 +128,15 @@ long main(void)
     procD0_return_tag = 1;
 #endif
     goto procD0;
-   procD0_return_1:
+  procD0_return_1:
     v_11X = procD00_return_value;
     *(result_10X + i_9X) = v_11X;
     arg0K0 = (1 + i_9X);
     arg1K1 = result_10X;
-    goto L214;}}
- L413: {
+    goto L212;
+  }
+}
+L409 : {
   i_12X = arg0K0;
   if ((5 == i_12X)) {
     free(result_10X);
@@ -134,28 +148,32 @@ long main(void)
     procD1_return_tag = 0;
 #endif
     goto procD1;
-   procD1_return_0:
+  procD1_return_0:
     v_13X = procD10_return_value;
     arg0K0 = 0;
-    arg2K1 = ((char**)malloc(sizeof(char*) * 5));
-    goto L161;}
-  else {
+    arg2K1 = ((char **)malloc(sizeof(char *) * 5));
+    goto L159;
+  } else {
     val_14X = *(result_10X + i_12X);
     ps_write_string(" sums[", out_3X);
     ps_write_integer(i_12X, out_3X);
     ps_write_string("] = ", out_3X);
     ps_write_integer(val_14X, out_3X);
-    { long ignoreXX;
-    PS_WRITE_CHAR(10, out_3X, ignoreXX) }
+    {
+      long ignoreXX;
+      PS_WRITE_CHAR(10, out_3X, ignoreXX)
+    }
     arg0K0 = (1 + i_12X);
-    goto L413;}}
- L161: {
+    goto L409;
+  }
+}
+L159 : {
   i_15X = arg0K0;
   result_16X = arg2K1;
   if ((5 == i_15X)) {
     arg0K0 = 0;
-    goto L429;}
-  else {
+    goto L425;
+  } else {
     merged_arg0K0 = (*(Qvec_a + i_15X));
 #ifdef USE_DIRECT_THREADING
     procD1_return_address = &&procD1_return_1;
@@ -163,46 +181,58 @@ long main(void)
     procD1_return_tag = 1;
 #endif
     goto procD1;
-   procD1_return_1:
+  procD1_return_1:
     v_17X = procD10_return_value;
     *(result_16X + i_15X) = v_17X;
     arg0K0 = (1 + i_15X);
     arg2K1 = result_16X;
-    goto L161;}}
- L429: {
+    goto L159;
+  }
+}
+L425 : {
   i_18X = arg0K0;
   if ((5 == i_18X)) {
     arg0K0 = 0;
-    goto L445;}
-  else {
+    goto L441;
+  } else {
     val_19X = *(result_16X + i_18X);
     ps_write_string(" strs[", out_3X);
     ps_write_integer(i_18X, out_3X);
     ps_write_string("] = \"", out_3X);
     ps_write_string(val_19X, out_3X);
-    { long ignoreXX;
-    PS_WRITE_CHAR(34, out_3X, ignoreXX) }
-    { long ignoreXX;
-    PS_WRITE_CHAR(10, out_3X, ignoreXX) }
+    {
+      long ignoreXX;
+      PS_WRITE_CHAR(34, out_3X, ignoreXX)
+    }
+    {
+      long ignoreXX;
+      PS_WRITE_CHAR(10, out_3X, ignoreXX)
+    }
     arg0K0 = (1 + i_18X);
-    goto L429;}}
- L445: {
+    goto L425;
+  }
+}
+L441 : {
   i_20X = arg0K0;
   if ((5 == i_20X)) {
     free(result_16X);
-    return 0;}
-  else {
+    return 0;
+  } else {
     free((*(result_16X + i_20X)));
     arg0K0 = (1 + i_20X);
-    goto L445;}}
- procD1: {
-  val_2X = merged_arg0K0;{
-  len_21X = strlen((char *) "x");
-  total_22X = len_21X * val_2X;
-  target_23X = (char *)calloc( 1, 1 + total_22X);
-  arg0K0 = 0;
-  goto L110;}
- L110: {
+    goto L441;
+  }
+}
+procD1 : {
+  val_2X = merged_arg0K0;
+  {
+    len_21X = strlen((char *)"x");
+    total_22X = len_21X * val_2X;
+    target_23X = (char *)calloc(1, 1 + total_22X);
+    arg0K0 = 0;
+    goto L108;
+  }
+L108 : {
   ix_24X = arg0K0;
   if ((ix_24X == total_22X)) {
     procD10_return_value = target_23X;
@@ -211,57 +241,63 @@ long main(void)
 #else
     goto procD1_return;
 #endif
-}
-  else {
+  } else {
     arg0K0 = ix_24X;
     arg0K1 = 0;
-    goto L42;}}
- L42: {
+    goto L41;
+  }
+}
+L41 : {
   tgt_25X = arg0K0;
   src_26X = arg0K1;
   if ((src_26X == len_21X)) {
     arg0K0 = (ix_24X + len_21X);
-    goto L110;}
-  else {
+    goto L108;
+  } else {
     *(target_23X + tgt_25X) = (*("x" + src_26X));
     arg0K0 = (1 + tgt_25X);
     arg0K1 = (1 + src_26X);
-    goto L42;}}
+    goto L41;
+  }
+}
 #ifndef USE_DIRECT_THREADING
- procD1_return:
+procD1_return:
   switch (procD1_return_tag) {
-  case 0: goto procD1_return_0;
-  default: goto procD1_return_1;
+  case 0:
+    goto procD1_return_0;
+  default:
+    goto procD1_return_1;
   }
 #endif
 }
 
- procD0: {
+procD0 : {
   val1_0X = merged_arg0K0;
-  val2_1X = merged_arg0K1;{
-  procD00_return_value = (val1_0X + val2_1X);
+  val2_1X = merged_arg0K1;
+  {
+    procD00_return_value = (val1_0X + val2_1X);
 #ifdef USE_DIRECT_THREADING
-  goto *procD0_return_address;
+    goto *procD0_return_address;
 #else
-  goto procD0_return;
+    goto procD0_return;
 #endif
-}
+  }
 #ifndef USE_DIRECT_THREADING
- procD0_return:
+procD0_return:
   switch (procD0_return_tag) {
-  case 0: goto procD0_return_0;
-  default: goto procD0_return_1;
+  case 0:
+    goto procD0_return_0;
+  default:
+    goto procD0_return_1;
   }
 #endif
 }
-
-}void
-vecfun_init(void)
-{
-Qvec_a = malloc(5 * sizeof(long));
-Qvec_a[0] = 0;
-Qvec_a[1] = 1;
-Qvec_a[2] = 4;
-Qvec_a[3] = 9;
-Qvec_a[4] = 16;
+}
+void ps_init(void) {
+  Qvec_a = malloc(5 * sizeof(long));
+  Qvec_a[0] = 0;
+  Qvec_a[1] = 1;
+  Qvec_a[2] = 4;
+  Qvec_a[3] = 9;
+  Qvec_a[4] = 16;
 }

+ 0 - 9
vecfun.scm

@@ -1,8 +1,5 @@
 ;;; vecfun: an example Pre-Scheme program
 
-;; FIXME: bodge to support static init from main
-(define %static-init (external "vecfun_init" (=> () null)))
-
 ;; vec-a is computed at compile-time
 (define %vec-a (vector-unfold (lambda (i)
                                 (* i i))
@@ -14,12 +11,6 @@
 (define (main)
   (define out (current-output-port))
 
-  ;; XXX: We need to run static-init to initialize vec-a, otherwise the
-  ;; following code will segfault.  The Scheme 48 VM gets around this by
-  ;; using a hand-coded C main which runs the init routine before
-  ;; calling the Pre-Scheme entrypoint.
-  (%static-init)
-
   (write-string "Print vec-a with vector-for-each:\n" out)
   (vector-for-each (lambda (i val)
                      (write-string " vec-a[" out)