diff interps/c-intercal/pit/explib/syslibc.c @ 996:859f9b4339e6

<Gregor> tar xf egobot.tar.xz
author HackBot
date Sun, 09 Dec 2012 19:30:08 +0000
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/interps/c-intercal/pit/explib/syslibc.c	Sun Dec 09 19:30:08 2012 +0000
@@ -0,0 +1,203 @@
+/*
+ * The INTERCAL system library, optimised version in C.
+ *
+ * This is provided as an example of how to write a C program
+ * that links to INTERCAL programs, to demonstrate the external
+ * call code.
+ *
+ * Written originally by Alex Smith, and released to the public
+ * domain. This library comes with NO WARRANTY.
+ */
+
+#include <ick_ec.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <time.h>
+
+/* This identifier name breaches the namespace rule that ick_ must be
+   avoided, but this library has to work with both other people's
+   INTERCAL programs and other people's C programs. So I've chosen an
+   identifier name which breaches the rules (so that it doesn't clash
+   with other people's C programs) but isn't used anywhere in the
+   compiler, and so doesn't clash with it either.
+*/
+
+static void errout(int routine, const char* msg)
+{
+  fprintf(stderr,"C-INTERCAL system library: (%d): %s\n", routine, msg);
+  exit(EXIT_FAILURE);
+}
+
+ICK_EC_FUNC_START(ick_my_custom_syslib)
+{
+  register uint16_t os1, os2;
+  register uint32_t ts1, ts2;
+  static int seededyet = 0;
+
+  ick_linelabel(1000);
+  os1=ick_getonespot(1);
+  os2=ick_getonespot(2);
+  if(0xffff-os1<os2) errout(1000, "onespot overflow");
+  ick_setonespot(3,os1+os2);
+  ick_resume(1);
+  return; /* so the compiler knows the next line can't be reached from here */
+
+  ick_linelabel(1009);
+  os1=ick_getonespot(1);
+  os2=ick_getonespot(2);
+  ick_setonespot(4,1);
+  if(0xffff-os1<os2) ick_setonespot(4,2);
+  ick_setonespot(3,os1+os2);
+  ick_resume(1);
+  return;
+
+  ick_linelabel(1010);
+  ick_setonespot(3,ick_getonespot(1)-ick_getonespot(2));
+  ick_resume(1);
+  return;
+
+  ick_linelabel(1020);
+  ick_setonespot(1,ick_getonespot(1)+1U);
+  ick_resume(1);
+  return;
+
+  ick_linelabel(1030);
+  os1=ick_getonespot(1);
+  os2=ick_getonespot(2);
+  if(os1&&0xffff/os1<os2) errout(1030, "onespot overflow");
+  ick_setonespot(3,os1*os2);
+  ick_resume(1);
+  return;
+
+  ick_linelabel(1039);
+  os1=ick_getonespot(1);
+  os2=ick_getonespot(2);
+  ick_setonespot(4,1);
+  if(os1&&0xffff/os1<os2) ick_setonespot(4,2);
+  ick_setonespot(3,os1*os2);
+  ick_resume(1);
+  return;
+
+  ick_linelabel(1040);
+  os2=ick_getonespot(2);
+  if(!os2)
+    ick_setonespot(3,0);
+  else
+    ick_setonespot(3,ick_getonespot(1)/os2);
+  ick_resume(1);
+  return;
+
+  ick_linelabel(1050);
+  os1=ick_getonespot(1);
+  ts1=ick_gettwospot(1);
+  if(!os1)
+    ts1 = 0;
+  else
+    ts1/=os1;
+  if(ts1>0xffffLU) errout(1050, "onespot overflow");
+  ick_setonespot(2,(uint16_t)ts1);
+  ick_resume(1);
+  return;
+
+  ick_linelabel(1500);
+  ts1=ick_gettwospot(1);
+  ts2=ick_gettwospot(2);
+  if(0xffffffffLU-ts1<ts2) errout(1500, "twospot overflow");
+  ick_settwospot(3,ts1+ts2);
+  ick_resume(1);
+  return;
+
+  ick_linelabel(1509);
+  ts1=ick_gettwospot(1);
+  ts2=ick_gettwospot(2);
+  ick_setonespot(4,1);
+  if(0xffffffffLU-ts1<ts2) ick_setonespot(4,2);
+  ick_settwospot(3,ts1+ts2);
+  ick_resume(1);
+  return;
+
+  ick_linelabel(1510);
+  ick_settwospot(3,ick_gettwospot(1)-ick_gettwospot(2));
+  ick_resume(1);
+  return;
+
+  ick_linelabel(1520);
+  ick_settwospot(1,(((uint32_t)ick_getonespot(1))<<16)+ick_getonespot(2));
+  ick_resume(1);
+  return;
+
+  ick_linelabel(1530);
+  ick_settwospot(1,ick_getonespot(1)*ick_getonespot(2));
+  ick_resume(1);
+  return;
+
+  ick_linelabel(1540);
+  ts1=ick_gettwospot(1);
+  ts2=ick_gettwospot(2);
+  if(ts1&&0xfffffffflu/ts1<ts2) errout(1540, "twospot overflow");
+  ick_settwospot(3,ts1*ts2);
+  ick_resume(1);
+  return;
+
+  ick_linelabel(1549);
+  ts1=ick_gettwospot(1);
+  ts2=ick_gettwospot(2);
+  ick_setonespot(4,1);
+  if(ts1&&0xfffffffflu/ts1<ts2) ick_setonespot(4,2);
+  ick_settwospot(3,ts1*ts2);
+  ick_resume(1);
+  return;
+
+  ick_linelabel(1550);
+  ts2=ick_gettwospot(2);
+  if(!ts2)
+    ick_settwospot(3,0);
+  else
+    ick_settwospot(3,ick_gettwospot(1)/ts2);
+  ick_resume(1);
+  return;
+
+  ick_linelabel(1900);
+  if(!seededyet) srand(time(0));
+  seededyet=1;
+  ick_setonespot(1,rand()/(1+RAND_MAX/65536));
+  ick_resume(1);
+  return;
+
+  ick_linelabel(1910);
+  /* Here, we use the same algorithm as the original INTERCAL,
+     so as to produce similarly-distributed results.
+
+     If we add together 12 uniform random variables in the range #0 to
+     (.1 / 12), then the resulting random variable has a mean of (.1 /
+     2), and a variance of 12 times the original variance, which is
+     (((.1 * .1) / 144) / 12), giving a final variance of ((.1 * .1) /
+     144) and a final standard deviation of .1 / 12. */
+  if(!seededyet) srand(time(0));
+  seededyet=1;
+  os1=ick_getonespot(1);
+  os2 =rand()/(RAND_MAX/((os1   )/12));
+  os2+=rand()/(RAND_MAX/((os1+ 1)/12));
+  os2+=rand()/(RAND_MAX/((os1+ 2)/12));
+  os2+=rand()/(RAND_MAX/((os1+ 3)/12));
+  os2+=rand()/(RAND_MAX/((os1+ 4)/12));
+  os2+=rand()/(RAND_MAX/((os1+ 5)/12));
+  os2+=rand()/(RAND_MAX/((os1+ 6)/12));
+  os2+=rand()/(RAND_MAX/((os1+ 7)/12));
+  os2+=rand()/(RAND_MAX/((os1+ 8)/12));
+  os2+=rand()/(RAND_MAX/((os1+ 9)/12));
+  os2+=rand()/(RAND_MAX/((os1+10)/12));
+  os2+=rand()/(RAND_MAX/((os1+11)/12));
+  ick_setonespot(2,os2);
+  ick_resume(1);
+  return;
+
+  /* Several existing INTERCAL programs rely on the routine (1001),
+     which is undocumented and therefore shouldn't be used. So as not
+     to break those programs, here it is: */
+  ick_linelabel(1001);
+  ick_resume(ick_getonespot(5));
+  return;
+
+}
+ICK_EC_FUNC_END