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