1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
|
/*
* 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>
static void errout(int routine, const char* msg)
{
fprintf(stderr,"C-INTERCAL system library: (%d): %s\n", routine, msg);
exit(EXIT_FAILURE);
}
/* 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 changed the
rules so that the ick_my_ prefix is legal in (and only in)
expansion libraries.
*/
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
|
