|
DataMuseum.dkPresents historical artifacts from the history of: RC3500 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC3500 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 18432 (0x4800)
Types: TextFileVerbose
Names: »tstaplst«
└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system
└─⟦72244f0ef⟧
└─⟦this⟧ »tstaplst«
\f
tstaplst 81.04.14. 14.39. page 1
10 1
\f
tstaplst 81.04.14. 14.39. page 2
1010 2 <*
1020 3 PROCESS tsconnector (
1030 4 opsem : sempointer; (* operator sem *)
1040 5 VAR s1, s2, s3, s4, s5: !sempointer;
1050 6 VAR sem, p2, p3, p4, p5, p6: !ts_pointer );
1060 7
1070 8 *>
1080 9 PROCESS tap (
1090 10 opsem : sempointer; (* operator sem *)
1100 11 VAR sem : !ts_pointer ); (* main sem *)
1110 12
1120 13 (*---------------------------------------------------------------
1130 14 *
1140 15 * function: the tap module is used to supervise
1150 16 * the traffic between 2 modules.
1160 17 *
1170 18 * externals: testopen, testout
1180 19 *
1190 20 * var params: sem
1200 21 *
1210 22 * semaphores: the module sends to the system semaphore
1220 23 * "operatorsem".
1230 24 *
1240 25 *
1250 26 * programmed oct 1980 by hej
1260 27 *
1270 28 --------------------------------------------------------------*)
1280 29
1290 30 CONST
1300 31
1310 32 version = "vers 6.06 /" ;
1320 33
1330 34
1340 35
\f
tstaplst 81.04.14. 14.39. page 3
2010 36 CONST
2020 37 opbufsize = 80; (* no. of bytes in buffers to the operator module *)
2030 38
2040 39 firstindex= 6 + alfalength;
2050 40 lastindex= firstindex + (opbufsize - 1);
2060 41 ok= 0; (* result from operator *)
2070 42
2080 43
2090 44 TYPE
2100 45 opbuftype=
2110 46 RECORD
2120 47 ! first,
2130 48 ! last,
2140 49 ! next: integer;
2150 50 ! name: alfa;
2160 51 ! data: ARRAY (firstindex..lastindex) OF char
2170 52 END;
2180 53
2190 54 alarmbuftype = ARRAY (1..size_listen) OF integer;
2200 55
2210 56 alfa10= ARRAY (1..10) OF char;
2220 57
2230 58 VAR
2240 59 (********* pools *********)
2250 60 opbufpool: pool 3 OF opbuftype;
2260 61
2270 62 (********** semaphores **********)
2280 63 wsem (* buffers written by the operatormodule is
2290 64 returned here *)
2300 65 : semaphore;
2310 66
2320 67 (********** references **********)
2330 68 opoutref, (* ref. to buffer to operator *)
2340 69 cur (* ref. to current buffer *)
2350 70 : reference;
2360 71
2370 72 (********** zones **********)
2380 73 z: zone;
2390 74
2400 75
2410 76
2420 77 (********** integers **********)
2430 78 base, (* number base for input and output *)
2440 79 mc,
2450 80 i,
2460 81 lastword (* used by "o"-command *)
\f
tstaplst 81.04.14. 14.39. page 4
2470 82 : integer;
2480 83
2490 84
2500 85 (********** externals **********)
2510 86
2520 87 PROCEDURE setoflowmask ( obit: boolean);
2530 88 EXTERNAL;
2540 89
2550 90
\f
tstaplst 81.04.14. 14.39. page 5
3010 91 PROCEDURE outchar(ch:char);
3020 92 (* writes ch into the output buffer *)
3030 93 BEGIN
3040 94 1 ! LOCK opoutref AS opbuf: opbuftype DO
3050 95 2 ! WITH opbuf DO
3060 96 3 ! BEGIN
3070 97 4 ! ! last:= last + 1;
3080 98 5 ! ! data (last):= ch;
3090 99 6 ! END;
3100 100 7 END (* outchar *);
3110 101
\f
tstaplst 81.04.14. 14.39. page 6
4010 102 PROCEDURE outinteger ( int, positions : integer);
4020 103 (* writes the integer int using outchar *)
4030 104
4040 105 TYPE
4050 106 digittable = ARRAY (0..15) OF char;
4060 107
4070 108 CONST
4080 109 lastpos = 16; (* lastpos+1 positions in layout *)
4090 110 dig = digittable ('0','1','2','3','4','5','6','7',
4100 111 '8','9','a','b','c','d','e','f' );
4110 112
4120 113 TYPE
4130 114 range = 0..lastpos ;
4140 115
4150 116 VAR
4160 117 digits : ARRAY (range) OF char;
4170 118 p : range;
4180 119 res : integer;
4190 120 negative : boolean;
4200 121
4210 122 PROCEDURE setzero ( stop : range );
4220 123 (* global p *)
4230 124 BEGIN
4240 125 1 ! WHILE p > stop DO
4250 126 2 ! BEGIN
4260 127 3 ! ! res:= 0;
4270 128 4 ! ! digits(p):= '0';
4280 129 5 ! ! p:= p-1
4290 130 6 ! END;
4300 131 7 ! IF base = 16 THEN digits(p+1):= dig(8+res)
4310 132 8 ! ELSE digits(p+1):= '1'
4320 133 9 END;
4330 134
4340 135 BEGIN
4350 136 1 ! FOR p:= 0 TO lastpos DO digits(p):= sp;
4360 137 2 ! p:= lastpos;
4370 138 3 ! negative:= int<0;
4380 139 4 ! IF negative AND (base <> 10 ) THEN int:= int - (-32768);
4390 140 5 !
4400 141 6 ! REPEAT (* unpack the digits backwards *)
4410 142 7 ! ! res:= abs ( int MOD base);
4420 143 8 ! ! digits(p):= dig(res);
4430 144 9 ! ! p:= p-1;
4440 145 10 ! ! int:= int DIV base
4450 146 11 ! UNTIL (p=0) OR (int=0);
4460 147 12 !
\f
tstaplst 81.04.14. 14.39. page 7
4470 148 13 ! IF negative THEN
4480 149 14 ! CASE base OF
4490 150 15 ! ! 2: setzero ( lastpos-16);
4500 151 16 ! !
4510 152 17 ! ! 8: setzero ( lastpos-6);
4520 153 18 ! !
4530 154 19 ! ! 10:
4540 155 20 ! ! BEGIN
4550 156 21 ! ! ! digits(p):= '-'; (* sign *)
4560 157 22 ! ! ! p:= p-1
4570 158 23 ! ! END;
4580 159 24 ! !
4590 160 25 ! ! 16: setzero ( lastpos-4)
4600 161 26 ! ! OTHERWISE
4610 162 27 ! END; (* case *)
4620 163 28 !
4630 164 29 ! res:= lastpos+1 - positions; (* where to start *)
4640 165 30 ! WHILE res < 0 DO (* make extra sp *)
4650 166 31 ! BEGIN
4660 167 32 ! ! outchar ( sp);
4670 168 33 ! ! res:= res+1
4680 169 34 ! END;
4690 170 35 !
4700 171 36 ! IF res < p THEN p:= res;
4710 172 37 !
4720 173 38 ! FOR p:= p TO lastpos DO outchar ( digits(p));
4730 174 39 !
4740 175 40 END; (* outinteger *)
4750 176
4760 177
\f
tstaplst 81.04.14. 14.39. page 8
5010 178 PROCEDURE outstring10(text: alfa10);
5020 179 (* writes the text into opbuf starting at outputpointer
5030 180 which is updated accordingly *)
5040 181 VAR
5050 182 i: integer;
5060 183 BEGIN
5070 184 1 ! FOR i:=1 TO 10 DO
5080 185 2 ! outchar( text(i) );
5090 186 3 END (* out string 10 *);
5100 187
\f
tstaplst 81.04.14. 14.39. page 9
6010 188 PROCEDURE outnl;
6020 189 (* prepares opbuf for output to the operator and signals
6030 190 it to operator module *)
6040 191 BEGIN
6050 192 1 ! IF NOT nil(opoutref) THEN
6060 193 2 ! BEGIN
6070 194 3 ! ! outchar(nl);
6080 195 4 ! ! signal(opoutref, opsem^)
6090 196 5 ! END;
6100 197 6 ! wait(opoutref, wsem);
6110 198 7 ! LOCK opoutref AS opbuf: opbuftype DO
6120 199 8 ! opbuf.last:= firstindex;
6130 200 9 END (* writenl *);
6140 201
6150 202
\f
tstaplst 81.04.14. 14.39. page 10
7010 203 PROCEDURE display;
7020 204
7030 205 BEGIN
7040 206 1 ! outchar ("u"); outchar(":");
7050 207 2 ! outinteger ( cur^.u1, 4);
7060 208 3 ! outinteger ( cur^.u2, 4);
7070 209 4 ! outinteger ( cur^.u3, 4);
7080 210 5 ! outinteger ( cur^.u4, 4);
7090 211 6 ! outinteger ( cur^.size, 8);
7100 212 7 ! outnl;
7110 213 8 ! IF cur^.size >= size_listen THEN (* alarmbuffer *)
7120 214 9 ! LOCK cur AS buf: alarmbuftype DO
7130 215 10 ! IF buf(1) IN (. 0..64 .) THEN
7140 216 11 ! BEGIN
7150 217 12 ! ! outstring10 ("label ");
7160 218 13 ! ! FOR i:= 1 TO 8 DO outinteger ( buf(i), 6);
7170 219 14 ! ! outnl;
7180 220 15 ! ! lastword:= (buf(1)+3) DIV 2;
7190 221 16 ! ! IF lastword > size_listen THEN lastword:= size_listen;
7200 222 17 ! ! IF lastword > 8 THEN
7210 223 18 ! ! BEGIN
7220 224 19 ! ! ! outstring10 ("datapart ");
7230 225 20 ! ! ! FOR i:= 9 TO lastword DO outinteger ( buf(i), 6);
7240 226 21 ! ! ! outnl;
7250 227 22 ! ! END
7260 228 23 ! END
7270 229 24 END; (* display *)
7280 230
7290 231
\f
tstaplst 81.04.14. 14.39. page 11
8010 232 FUNCTION equal ( a, b : sempointer ): boolean;
8020 233
8030 234 TYPE
8040 235 os = RECORD sp: sempointer END;
8050 236
8060 237 VAR
8070 238 one, two: os;
8080 239
8090 240 BEGIN
8100 241 1 ! one.sp:= a;
8110 242 2 ! two.sp:= b;
8120 243 3 ! equal:= one = two
8130 244 4 END;
8140 245
8150 246
\f
tstaplst 81.04.14. 14.39. page 12
9010 247
9020 248 (****************************************
9030 249 * *
9040 250 * m a i n p r o g r a m *
9050 251 * *
9060 252 ****************************************)
9070 253
9080 254 BEGIN
9090 255 1 ! testopen (z, own.incname, opsem);
9100 256 2 ! testout ( z, version, al_env_version);
9110 257 3 !
9120 258 4 ! (* initialise op buffers *)
9130 259 5 ! FOR i:= 1 TO 3 DO
9140 260 6 ! BEGIN
9150 261 7 ! ! alloc (opoutref, opbufpool, wsem);
9160 262 8 ! ! opoutref^.u1:=2; (* write *)
9170 263 9 ! ! LOCK opoutref AS opbuf: opbuftype DO
9180 264 10 ! ! WITH opbuf DO
9190 265 11 ! ! BEGIN
9200 266 12 ! ! ! first:= firstindex;
9210 267 13 ! ! ! name:= own.incname;
9220 268 14 ! ! ! data(firstindex):= "!";
9230 269 15 ! ! END;
9240 270 16 ! ! return (opoutref);
9250 271 17 ! END;
9260 272 18 !
9270 273 19 ! outnl;
9280 274 20 ! setoflowmask ( true); (* no except for arith. overflow *)
9290 275 21 ! base:= 16;
9300 276 22 !
9310 277 23 ! REPEAT
9320 278 24 ! ! wait ( cur, sem.w^);
9330 279 25 ! ! IF cur^.u1 <> 6 THEN
9340 280 26 ! ! display;
9350 281 27 ! ! IF equal ( sem.w, sem.s ) THEN return ( cur)
9360 282 28 ! ! ELSE
9370 283 29 ! ! signal ( cur, sem.s^)
9380 284 30 ! UNTIL false
9390 285 31 !
9400 286 32 END .
9410 287
9420 288
\f
tstaplst 81.04.14. 14.39. page 13
0 41* 106* 114* 127 136 138 146 146 165 215
1 40* 54* 56* 97 129 131 132 144 157 164 168 184 215 218 220
259
2 150: 220 262
3 60* 220 259
4 160 207 208 209 210
6 39* 152 218 225 279
8 131 152: 211 218 222
9 225
10 56* 139 154: 184
15 106*
16 109* 131 150 160: 275
64 215
80 37*
32768 139
a 232* 241
abs 142
alarmbuftype 54* 214
alfa 50*
alfa10 56* 178*
alfalength 39*
alloc 261
al_env_version <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
256
as 94: 198: 214: 263:
b 232* 242
base 78* 131 139 142 145 149 275=
boolean 87* 120* 232*
buf 214: 215 218 220 225
ch 91* 98
char 51* 56* 91* 106* 117*
cur 69* 207 208 209 210 211 213 214: 278 279 281 283
data 51* 98= 268=
dig 110* 131 143
digits 117* 128= 131= 132= 136= 143= 156= 173
digittable 106* 110*
display 203* 280
equal 232* 243= 281
external 88*
false 284
first 47* 266=
firstindex 39* 40* 51* 199 266 268
i 80* 182* 184= 185 218= 218 225= 225 259=
incname 255 267
\f
tstaplst 81.04.14. 14.39. page 14
int 102* 138 139= 139 142 145= 145 146
integer 49* 54* 82* 102* 119* 182*
last 48* 97= 97 98 199=
lastindex 40* 51*
lastpos 109* 114* 136 137 150 152 160 164 173
lastword 81* 220= 221 221= 222 225
lock 94: 198: 214: 263:
mc 79*
name 50* 267=
negative 120* 138= 139 148
next 49*
nl 194
obit 87*
ok 41*
one 238* 241 243
opbuf 94: 95 198: 199 263: 264
opbufpool 60* 261
opbufsize 37* 40*
opbuftype 45* 60* 94 198 263
opoutref 68* 94: 192 195 197 198: 261 262 263: 270
opsem 10* 195 255
os 235* 238*
outchar 91* 167 173 185 194 206 206
outinteger 102* 207 208 209 210 211 218 225
outnl 188* 212 219 226 273
outstring10 178* 217 224
own 255 267
p 118* 125 128 129= 129 131 132 136= 136 137= 143 144= 144 146 156
157= 157 171 171= 173= 173 173
pool 60*
positions 102* 164
process 9*
range 114* 117* 118* 122*
reference 70*
res 119* 127= 131 142= 143 164= 165 168= 168 171 171
return 270 281
s 281 283
sem 11* 278 281 281 283
semaphore 65*
sempointer 10* 232* 235*
setoflowmask 87* 274
setzero 122* 150 152 160
signal 195 283
size 211 213
\f
tstaplst 81.04.14. 14.39. page 15
size_listen 54* 213 221 221
sp 136 167 235* 241= 242=
stop 122* 125
tap 9*
testopen 255
testout 256
text 178* 185
true 274
ts_pointer 11*
two 238* 242 243
u1 207 262= 279
u2 208
u3 209
u4 210
version 32* 256
w 278 281
wait 197 278
wsem 63* 197 261
z 73* 255 256
zone 73*
\f
tstaplst 81.04.14. 14.39. page 16
AND 1
ARRAY 5
BEGIN 17
CASE 1
CONST 3
DIV 2
DO 14
ELSE 2
END 20
FOR 6
FUNCTION 1
IF 11
IN 1
MOD 1
NIL 1
NOT 1
OF 7
OR 1
OTHERWISE 1
PROCEDURE 7
RECORD 2
REPEAT 2
THEN 11
TO 6
TYPE 4
UNTIL 2
VAR 5
WHILE 2
WITH 2
tap program
81.04.14. 14.39. pascal80 version 1981.02.09
name headline beginline endline appetite(words)
outchar 91 94 100 : 9
setzero 122 125 133 : 7
outinteger 102 136 175 : 27
outstring10 178 184 186 : 17
outnl 188 193 200 : 11
display 203 206 229 : 20
equal 232 241 244 : 11
tap 30 255 286 : 110
code: 0 . 2218 = 2218 bytes
end of PASCAL80 compilation
end
blocksread = 52
«eof»