1 /*
2 * The INTERCAL system library, optimised version in C.
3 *
4 * This is provided as an example of how to write a C program
5 * that links to INTERCAL programs, to demonstrate the external
6 * call code.
7 *
8 * Written originally by Alex Smith, and released to the public
9 * domain. This library comes with NO WARRANTY.
10 */
11
12 #include <ick_ec.h>
13 #include <stdio.h>
14 #include <stdlib.h>
15 #include <time.h>
16
errout(int routine,const char * msg)17 static void errout(int routine, const char* msg)
18 {
19 fprintf(stderr,"C-INTERCAL system library: (%d): %s\n", routine, msg);
20 exit(EXIT_FAILURE);
21 }
22
23 /* This identifier name breaches the namespace rule that ick_ must be
24 avoided, but this library has to work with both other people's
25 INTERCAL programs and other people's C programs. So I changed the
26 rules so that the ick_my_ prefix is legal in (and only in)
27 expansion libraries.
28 */
29
ICK_EC_FUNC_START(ick_my_custom_syslib)30 ICK_EC_FUNC_START(ick_my_custom_syslib)
31 {
32 register uint16_t os1, os2;
33 register uint32_t ts1, ts2;
34 static int seededyet = 0;
35
36 ick_linelabel(1000);
37 os1=ick_getonespot(1);
38 os2=ick_getonespot(2);
39 if(0xffff-os1<os2) errout(1000, "onespot overflow");
40 ick_setonespot(3,os1+os2);
41 ick_resume(1);
42 return; /* so the compiler knows the next line can't be reached from here */
43
44 ick_linelabel(1009);
45 os1=ick_getonespot(1);
46 os2=ick_getonespot(2);
47 ick_setonespot(4,1);
48 if(0xffff-os1<os2) ick_setonespot(4,2);
49 ick_setonespot(3,os1+os2);
50 ick_resume(1);
51 return;
52
53 ick_linelabel(1010);
54 ick_setonespot(3,ick_getonespot(1)-ick_getonespot(2));
55 ick_resume(1);
56 return;
57
58 ick_linelabel(1020);
59 ick_setonespot(1,ick_getonespot(1)+1U);
60 ick_resume(1);
61 return;
62
63 ick_linelabel(1030);
64 os1=ick_getonespot(1);
65 os2=ick_getonespot(2);
66 if(os1&&0xffff/os1<os2) errout(1030, "onespot overflow");
67 ick_setonespot(3,os1*os2);
68 ick_resume(1);
69 return;
70
71 ick_linelabel(1039);
72 os1=ick_getonespot(1);
73 os2=ick_getonespot(2);
74 ick_setonespot(4,1);
75 if(os1&&0xffff/os1<os2) ick_setonespot(4,2);
76 ick_setonespot(3,os1*os2);
77 ick_resume(1);
78 return;
79
80 ick_linelabel(1040);
81 os2=ick_getonespot(2);
82 if(!os2)
83 ick_setonespot(3,0);
84 else
85 ick_setonespot(3,ick_getonespot(1)/os2);
86 ick_resume(1);
87 return;
88
89 ick_linelabel(1050);
90 os1=ick_getonespot(1);
91 ts1=ick_gettwospot(1);
92 if(!os1)
93 ts1 = 0;
94 else
95 ts1/=os1;
96 if(ts1>0xffffLU) errout(1050, "onespot overflow");
97 ick_setonespot(2,(uint16_t)ts1);
98 ick_resume(1);
99 return;
100
101 ick_linelabel(1500);
102 ts1=ick_gettwospot(1);
103 ts2=ick_gettwospot(2);
104 if(0xffffffffLU-ts1<ts2) errout(1500, "twospot overflow");
105 ick_settwospot(3,ts1+ts2);
106 ick_resume(1);
107 return;
108
109 ick_linelabel(1509);
110 ts1=ick_gettwospot(1);
111 ts2=ick_gettwospot(2);
112 ick_setonespot(4,1);
113 if(0xffffffffLU-ts1<ts2) ick_setonespot(4,2);
114 ick_settwospot(3,ts1+ts2);
115 ick_resume(1);
116 return;
117
118 ick_linelabel(1510);
119 ick_settwospot(3,ick_gettwospot(1)-ick_gettwospot(2));
120 ick_resume(1);
121 return;
122
123 ick_linelabel(1520);
124 ick_settwospot(1,(((uint32_t)ick_getonespot(1))<<16)+ick_getonespot(2));
125 ick_resume(1);
126 return;
127
128 ick_linelabel(1530);
129 ick_settwospot(1,ick_getonespot(1)*ick_getonespot(2));
130 ick_resume(1);
131 return;
132
133 ick_linelabel(1540);
134 ts1=ick_gettwospot(1);
135 ts2=ick_gettwospot(2);
136 if(ts1&&0xfffffffflu/ts1<ts2) errout(1540, "twospot overflow");
137 ick_settwospot(3,ts1*ts2);
138 ick_resume(1);
139 return;
140
141 ick_linelabel(1549);
142 ts1=ick_gettwospot(1);
143 ts2=ick_gettwospot(2);
144 ick_setonespot(4,1);
145 if(ts1&&0xfffffffflu/ts1<ts2) ick_setonespot(4,2);
146 ick_settwospot(3,ts1*ts2);
147 ick_resume(1);
148 return;
149
150 ick_linelabel(1550);
151 ts2=ick_gettwospot(2);
152 if(!ts2)
153 ick_settwospot(3,0);
154 else
155 ick_settwospot(3,ick_gettwospot(1)/ts2);
156 ick_resume(1);
157 return;
158
159 ick_linelabel(1900);
160 if(!seededyet) srand(time(0));
161 seededyet=1;
162 ick_setonespot(1,rand()/(1+RAND_MAX/65536));
163 ick_resume(1);
164 return;
165
166 ick_linelabel(1910);
167 /* Here, we use the same algorithm as the original INTERCAL,
168 so as to produce similarly-distributed results.
169
170 If we add together 12 uniform random variables in the range #0 to
171 (.1 / 12), then the resulting random variable has a mean of (.1 /
172 2), and a variance of 12 times the original variance, which is
173 (((.1 * .1) / 144) / 12), giving a final variance of ((.1 * .1) /
174 144) and a final standard deviation of .1 / 12. */
175 if(!seededyet) srand(time(0));
176 seededyet=1;
177 os1=ick_getonespot(1);
178 os2 =rand()/(RAND_MAX/((os1 )/12));
179 os2+=rand()/(RAND_MAX/((os1+ 1)/12));
180 os2+=rand()/(RAND_MAX/((os1+ 2)/12));
181 os2+=rand()/(RAND_MAX/((os1+ 3)/12));
182 os2+=rand()/(RAND_MAX/((os1+ 4)/12));
183 os2+=rand()/(RAND_MAX/((os1+ 5)/12));
184 os2+=rand()/(RAND_MAX/((os1+ 6)/12));
185 os2+=rand()/(RAND_MAX/((os1+ 7)/12));
186 os2+=rand()/(RAND_MAX/((os1+ 8)/12));
187 os2+=rand()/(RAND_MAX/((os1+ 9)/12));
188 os2+=rand()/(RAND_MAX/((os1+10)/12));
189 os2+=rand()/(RAND_MAX/((os1+11)/12));
190 ick_setonespot(2,os2);
191 ick_resume(1);
192 return;
193
194 /* Several existing INTERCAL programs rely on the routine (1001),
195 which is undocumented and therefore shouldn't be used. So as not
196 to break those programs, here it is: */
197 ick_linelabel(1001);
198 ick_resume(ick_getonespot(5));
199 return;
200
201 }
202 ICK_EC_FUNC_END
203