|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 23808 (0x5d00)
Types: TextFile
Names: »pxforlst«
└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system
└─⟦72244f0ef⟧
└─⟦this⟧ »pxforlst«
\f
pxforlst 81.06.17. 14.25. page 1
10 1
20 2
30 3
40 4
50 5
60 6
70 7 PROCESS formatter(
80 8 VAR sys_vector:system_vector;
90 9 VAR reserve_sem: semaphore;
100 10 VAR formatter_sem:semaphore);
110 11
120 12 CONST
130 13 sp_data_sz=300;
140 14 forewer=true;
150 15 time_lgt=12;
160 16
170 17
180 18 TYPE
190 19
200 20 basetype=(bin,oct,dec,hex);
210 21 types=(bytet,wrdt);
220 22 base_l_t=ARRAY(basetype) OF integer;
230 23 intg_l_r_t=ARRAY(basetype) OF integer;
240 24 intg_l_t_t=ARRAY(types) OF intg_l_r_t;
250 25 sp_5_data = PACKED ARRAY(1..5) OF byte;
260 26 new_ts_data =
270 27 RECORD
280 28 ! f,l,n:integer;
290 29 ! s_h : sp_head_type;
300 30 ! new_sp_data : sp_5_data;
310 31 END;
320 32
330 33
340 34 CONST
350 35 outbuf_init = operbuf_t(
360 36 6+alfalength,
370 37 97,
380 38 0,
390 39 "ncth ",
400 40 ? ) ;
410 41
420 42 bases=base_l_t(2,8,10,16);
430 43 intg_len=intg_l_t_t(
440 44 intg_l_r_t(9,4,4,3),
450 45 intg_l_r_t(17,7,6,5));
460 46
\f
pxforlst 81.06.17. 14.25. page 2
470 47 VAR
480 48 defbase:basetype:=dec;
490 49 mask:mask_type:=def_opt_mask;
500 50 outbufp:integer:=0;
510 51 outbufpool:pool 3 OF operbuf_t;
520 52 outbufr:reference;
530 53 formatter_o_sem:semaphore;
540 54 avbuf:boolean:=true;
550 55
560 56 reserve_hook : reference;
570 57
580 58 inbufr:reference;
590 59 hook,hook1:reference;
600 60 last_mess:reference;
610 61 old_sp_data : sp_5_data := sp_5_data(5***0);
620 62 new : boolean;
630 63
640 64
650 65 PROCEDURE outputbuf;
660 66 BEGIN
670 67 1 ! IF NOT nil(outbufr) THEN
680 68 2 ! BEGIN
690 69 3 ! ! LOCK outbufr AS outbuf:operbuf_t DO
700 70 4 ! ! outbuf.last:=outbufp+4+alfalength;
710 71 5 ! ! signal(outbufr,sys_vector(operatorsem)^);
720 72 6 ! END;
730 73 7 ! outbufp:=0;
740 74 8 END;
750 75
760 76 PROCEDURE outchar(ch:char);
770 77 BEGIN
780 78 1 ! IF outbufp=0 THEN
790 79 2 ! BEGIN
800 80 3 ! ! wait(outbufr,formatter_o_sem);
810 81 4 ! ! IF outbufr^.u2 <> 0 THEN
820 82 5 ! ! BEGIN
830 83 6 ! ! ! hook^.u2 := outbufr^.u2;
840 84 7 ! ! ! avbuf:=false;
850 85 8 ! ! ! signal(outbufr,sys_vector(operatorsem)^);
860 86 9 ! ! END
870 87 10 ! ! ELSE
880 88 11 ! ! BEGIN
890 89 12 ! ! ! outbufp:=1;
900 90 13 ! ! ! avbuf:=true;
910 91 14 ! ! END;
920 92 15 ! END;
\f
pxforlst 81.06.17. 14.25. page 3
930 93 16 ! IF avbuf THEN
940 94 17 ! BEGIN
950 95 18 ! ! LOCK outbufr AS outbuf:operbuf_t DO
960 96 19 ! ! WITH outbuf DO
970 97 20 ! ! databuf(outbufp):=ch;
980 98 21 ! ! outbufp:= succ(outbufp);
990 99 22 ! ! IF outbufp > 80 THEN outputbuf;
1000 100 23 ! END;
1010 101 24 END;
1020 102
1030 103 PROCEDURE outtext(txt:txt_type;len:0..txt_len);
1040 104 VAR i:integer;
1050 105 BEGIN
1060 106 1 ! FOR i:=1 TO len DO outchar(txt(i));
1070 107 2 END;
1080 108
1090 109 PROCEDURE outint(val:integer;base:basetype;len:1..txt_len);
1100 110 VAR
1110 111 bas,help,i,extra:integer;
1120 112 txt:txt_type;
1130 113 LABEL outprint;
1140 114 BEGIN
1150 115 1 ! bas:=bases(base);
1160 116 2 ! IF val < 0 THEN
1170 117 3 ! IF val <> -1 THEN
1180 118 4 ! BEGIN
1190 119 5 ! ! val:=32767 + val + 2;
1200 120 6 ! ! extra := 32767;
1210 121 7 ! END
1220 122 8 ! ELSE
1230 123 9 ! BEGIN
1240 124 10 ! ! CASE base OF
1250 125 11 ! ! ! bin: txt:=" 1111111111111111 ";
1260 126 12 ! ! ! oct: txt:=" 177777 ";
1270 127 13 ! ! ! dec: txt:=" 65535 ";
1280 128 14 ! ! ! hex: txt:=" ffff ";
1290 129 15 ! ! END;
1300 130 16 ! ! IF len >= intg_len(wrdt,base) THEN val:=0;
1310 131 17 ! ! GOTO outprint;
1320 132 18 ! END
1330 133 19 ! ELSE
1340 134 20 ! extra:=0;
1350 135 21 ! i:=len;
1360 136 22 ! REPEAT
1370 137 23 ! ! help:=val MOD bas + extra MOD bas;
1380 138 24 ! ! val:=val DIV bas;
\f
pxforlst 81.06.17. 14.25. page 4
1390 139 25 ! ! extra:=extra DIV bas + help DIV bas;
1400 140 26 ! ! help:=help MOD bas;
1410 141 27 ! ! IF help < 10 THEN txt(i):=chr(help+48)
1420 142 28 ! ! ELSE txt(i):=chr(help+55);
1430 143 29 ! ! i:=i-1;
1440 144 30 ! UNTIL (i=1) OR
1450 145 31 ! (val=0) AND
1460 146 32 ! (extra=0) AND
1470 147 33 ! (base <> bin);
1480 148 34 ! outprint:
1490 149 35 ! IF val > 0 THEN FOR help:=1 TO len DO txt(help):='*'
1500 150 36 ! ELSE
1510 151 37 ! FOR help:=1 TO i DO txt(help):=" ";
1520 152 38 ! FOR i:=1 TO len DO outchar(txt(i));
1530 153 39 END;
1540 154
1550 155 PROCEDURE outfield(
1560 156 txt:txt_type;
1570 157 tlen:integer;
1580 158 val:integer;
1590 159 base:basetype;
1600 160 typ:types);
1610 161 BEGIN
1620 162 1 ! outtext(txt,tlen);
1630 163 2 ! outint(val,base,intg_len(typ,base));
1640 164 3 ! outchar(nl);
1650 165 4 END;
1660 166
1670 167 PROCEDURE out_lcp_mess(VAR p:reference );
1680 168 FORWARD;
1690 169
1700 170
1710 171 PROCEDURE int_comint_com( VAR p:reference );
1720 172
1730 173 BEGIN
1740 174 1 ! LOCK p AS m:comint_mess_t DO
1750 175 2 ! WITH m,sp_head,comint_data DO
1760 176 3 ! BEGIN
1770 177 4 ! ! IF messnr < 51 THEN
1780 178 5 ! ! outfield("error nr : ",10,messnr,dec,bytet);
1790 179 6 ! ! IF position > 0 THEN
1800 180 7 ! ! outfield("near position : ",15,position,dec,bytet);
1810 181 8 ! ! outtext(message,mess_l); outchar(nl);
1820 182 9 ! ! mask:=c_mask;
1830 183 10 ! ! IF lcp_oper=repmess THEN
1840 184 11 ! ! IF NOT nil(last_mess) THEN
\f
pxforlst 81.06.17. 14.25. page 5
1850 185 12 ! ! out_lcp_mess(last_mess);
1860 186 13 ! ! CASE c_defbase OF
1870 187 14 ! ! ! 2:defbase:=bin;
1880 188 15 ! ! ! 8:defbase:=oct;
1890 189 16 ! ! ! 10:defbase:=dec;
1900 190 17 ! ! ! 16:defbase:=hex;
1910 191 18 ! ! ! OTHERWISE (* do nothing *);
1920 192 19 ! ! END;
1930 193 20 ! ! IF NOT ( c_mask(keep_last_mess) OR nil(last_mess)) THEN
1940 194 21 ! ! BEGIN
1950 195 22 ! ! ! push(hook1,last_mess);
1960 196 23 ! ! ! return(last_mess);
1970 197 24 ! ! END;
1980 198 25 ! END;
1990 199 26 ! outputbuf;
2000 200 27 END; (* of int_comint_com *)
2010 201
2020 202
2030 203 PROCEDURE out_lcp_mess( VAR p:reference );
2040 204
2050 205 TYPE
2060 206 b_p_l_t = ARRAY(basetype) OF byte;
2070 207
2080 208 CONST
2090 209 bytes_pr_l = b_p_l_t(4,8,8,16);
2100 210
2110 211 VAR
2120 212 b_pr_l,nrlines,remb,lim,i,j,k,l,len,val:integer;
2130 213
2140 214 BEGIN
2150 215 1 ! LOCK p AS m:ts_data_type DO
2160 216 2 ! WITH m,sp_head DO
2170 217 3 ! BEGIN
2180 218 4 ! ! IF mask(prhead) AND (sender_id<>0) THEN
2190 219 5 ! ! BEGIN
2200 220 6 ! ! ! outfield("SENDER_ID: ",12,sender_id,dec,wrdt);
2210 221 7 ! ! ! outfield("SEQ_NO: ",12,seq_no,dec,wrdt);
2220 222 8 ! ! ! outfield("SP_TYPE: ",12,sp_type,bin,bytet);
2230 223 9 ! ! ! outfield("LCP_OPER: ",12,lcp_oper,dec,bytet);
2240 224 10 ! ! ! outfield("STATUS: ",12,status,bin,wrdt);
2250 225 11 ! ! ! outtext("TIME: ",12);
2260 226 12 ! ! ! FOR i:= time_lgt DIV 2 DOWNTO 1 DO
2270 227 13 ! ! ! outint(time(i),hex,3);
2280 228 14 ! ! ! outchar(nl);
2290 229 15 ! ! ! outfield("BYTECOUNT: ",12,bytecount,dec,wrdt);
2300 230 16 ! ! ! outchar(nl);
\f
pxforlst 81.06.17. 14.25. page 6
2310 231 17 ! ! END
2320 232 18 ! ! ELSE
2330 233 19 ! ! BEGIN
2340 234 20 ! ! ! IF sender_id <> 0 THEN
2350 235 21 ! ! ! BEGIN
2360 236 22 ! ! ! ! outint(sender_id,dec,4);
2370 237 23 ! ! ! ! outchar(' ');
2380 238 24 ! ! ! END;
2390 239 25 ! ! ! IF (status <> 0 ) THEN outfield("STATUS :",12,status,bin,wrdt);
2400 240 26 ! ! END;
2410 241 27 ! ! IF mask(prdata) THEN
2420 242 28 ! ! IF mask(prvert) THEN
2430 243 29 ! ! BEGIN
2440 244 30 ! ! ! outtext("NO. !DEC !HEX!ASC ",17);outchar(nl);
2450 245 31 ! ! ! FOR i:=1 TO sp_head.bytecount DO
2460 246 32 ! ! ! BEGIN
2470 247 33 ! ! ! ! val:=sp_data(i);
2480 248 34 ! ! ! ! outint(i,dec,4); outchar('!');
2490 249 35 ! ! ! ! outint(val,dec,4); outchar('!');
2500 250 36 ! ! ! ! outint(val,hex,3); outchar('!');
2510 251 37 ! ! ! ! outchar(' ');
2520 252 38 ! ! ! ! IF val IN (. 32..126.) THEN outchar(chr(val))
2530 253 39 ! ! ! ! ELSE outchar('*');
2540 254 40 ! ! ! ! outchar(nl);
2550 255 41 ! ! ! END;
2560 256 42 ! ! END
2570 257 43 ! ! ELSE
2580 258 44 ! ! BEGIN
2590 259 45 ! ! ! k:=0;
2600 260 46 ! ! ! b_pr_l:=bytes_pr_l(defbase);
2610 261 47 ! ! ! nrlines:=bytecount DIV b_pr_l;
2620 262 48 ! ! ! remb:=bytecount MOD b_pr_l;
2630 263 49 ! ! ! len:= intg_len(bytet,defbase);
2640 264 50 ! ! ! lim:=b_pr_l;
2650 265 51 ! ! ! IF remb > 0 THEN
2660 266 52 ! ! ! nrlines:=succ(nrlines);
2670 267 53 ! ! ! FOR i:=1 TO nrlines DO
2680 268 54 ! ! ! BEGIN
2690 269 55 ! ! ! ! outint(k+1,dec,4); outchar(':');
2700 270 56 ! ! ! ! IF ( i = nrlines ) AND ( remb > 0 ) THEN lim:=remb;
2710 271 57 ! ! ! ! FOR j:=1 TO lim DO
2720 272 58 ! ! ! ! BEGIN
2730 273 59 ! ! ! ! ! k:=succ(k);
2740 274 60 ! ! ! ! ! outint(sp_data(k),defbase,len);
2750 275 61 ! ! ! ! END;
2760 276 62 ! ! ! ! outchar(nl);
\f
pxforlst 81.06.17. 14.25. page 7
2770 277 63 ! ! ! END
2780 278 64 ! ! END; (* of out lcp-messdata *)
2790 279 65 ! ! outputbuf;
2800 280 66 ! END;
2810 281 67 END; (* of out_lcp_mess *)
2820 282
2830 283
2840 284 VAR i:integer;
2850 285 BEGIN (* body of formatter *)
2860 286 1 ! FOR i:=1 TO 2 DO
2870 287 2 ! BEGIN alloc(outbufr,outbufpool,formatter_o_sem);
2880 288 3 ! ! outbufr^.u1:=2; outbufr^.u2:=0;
2890 289 4 ! ! LOCK outbufr AS outbuf:operbuf_t DO
2900 290 5 ! ! outbuf:=outbuf_init;
2910 291 6 ! ! return(outbufr)
2920 292 7 ! END;
2930 293 8 ! WHILE forewer DO
2940 294 9 ! BEGIN
2950 295 10 ! ! wait(inbufr,formatter_sem);
2960 296 11 ! ! wait(reserve_hook,reserve_sem);
2970 297 12 ! ! pop(hook,inbufr);
2980 298 13 ! ! hook^.u2:=0;
2990 299 14 ! ! IF hook^.u1 = 8+5 THEN
3000 300 15 ! ! int_comint_com(inbufr)
3010 301 16 ! ! ELSE
3020 302 17 ! ! BEGIN
3030 303 18 ! ! ! LOCK inbufr AS n: new_ts_data DO
3040 304 19 ! ! ! IF n.new_sp_data <> old_sp_data THEN
3050 305 20 ! ! ! BEGIN
3060 306 21 ! ! ! ! old_sp_data := n.new_sp_data;
3070 307 22 ! ! ! ! new := true;
3080 308 23 ! ! ! END
3090 309 24 ! ! ! ELSE
3100 310 25 ! ! ! new := false;
3110 311 26 ! ! ! IF new THEN
3120 312 27 ! ! ! out_lcp_mess(inbufr);
3130 313 28 ! ! ! IF mask(keep_last_mess) THEN
3140 314 29 ! ! ! BEGIN
3150 315 30 ! ! ! ! last_mess:=:inbufr;
3160 316 31 ! ! ! ! hook1:=:hook;
3170 317 32 ! ! ! END;
3180 318 33 ! ! END;
3190 319 34 ! ! IF NOT nil(inbufr) THEN
3200 320 35 ! ! BEGIN
3210 321 36 ! ! ! push(hook,inbufr);
3220 322 37 ! ! ! return(inbufr);
\f
pxforlst 81.06.17. 14.25. page 8
3230 323 38 ! ! END;
3240 324 39 ! ! signal(reserve_hook,reserve_sem);
3250 325 40 ! END;
3260 326 41 END. (* of formatter *)
3270 327
\f
pxforlst 81.06.17. 14.25. page 9
0 38* 50* 61* 73 78 81 103* 116 130 134 145 146 149 179 218
234 239 259 265 270 288 298
1 25* 89 106 109* 117 143 144 149 151 152 226 245 267 269 271
286
2 42* 119 187: 226 286 288
3 44* 51* 227 250
4 44* 44* 70 209* 236 248 249 269
5 25* 45* 61* 299
6 36* 45*
7 45*
8 42* 188: 209* 209* 299
9 44*
10 42* 141 178 189:
12 15* 220 221 222 223 224 225 229 239
15 180
16 42* 190: 209*
17 45* 244
32 252
48 141
51 177
55 142
80 99
97 37*
126 252
300 13*
32767 119 120
alfalength 36* 70
alloc 287
as 69: 95: 174: 215: 289: 303:
avbuf 54* 84= 90= 93
bas 111* 115= 137 137 138 139 139 140
base 109* 115 124 130 147 159* 163 163
bases 42* 115
basetype 20* 22* 23* 48* 109* 159* 206*
base_l_t 22* 42*
bin 20* 125: 147 187 222 224 239
boolean 54* 62*
byte 25* 206*
bytecount 229 245 261 262
bytes_pr_l 209* 260
bytet 21* 178 180 222 223 263
b_pr_l 212* 260= 261 262 264
b_p_l_t 206* 209*
ch 76* 97
\f
pxforlst 81.06.17. 14.25. page 10
char 76*
chr 141 142 252
comint_data 175
comint_mess_t <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
174
c_defbase 186
c_mask 182 193
databuf 97=
dec 20* 48* 127: 178 180 189 220 221 223 229 236 248 249 269
defbase 48* 187= 188= 189= 190= 260 263 274
def_opt_mask 49*
extra 111* 120= 134= 137 139= 139 146
f 28*
false 84 310
forewer 14* 293
formatter 7*
formatter_o_sem <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
53* 80 287
formatter_sem <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
10* 295
help 111* 137= 139 140= 140 141 141 142 149= 149 151= 151
hex 20* 128: 190 227 250
hook 59* 83 297 298 299 316 321
hook1 59* 195 316=
i 104* 106= 106 111* 135= 141 142 143= 143 144 151 152= 152 212* 226=
227 245= 247 248 267= 270 284* 286=
inbufr 58* 295 297 300 303: 312 315 319 321 322
integer 22* 23* 28* 50* 104* 109* 111* 157* 158* 212* 284*
intg_len 43* 130 163 263
intg_l_r_t 23* 24* 44* 45*
intg_l_t_t 24* 43*
int_comint_com <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
171* 300
j 212* 271=
k 212* 259= 269 273= 273 274
keep_last_mess <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
193 313
l 28* 212*
last 70=
last_mess 60* 184 185 193 195 196 315=
lcp_oper 183 223
len 103* 106 109* 130 135 149 152 212* 263= 274
lim 212* 264= 270= 271
lock 69: 95: 174: 215: 289: 303:
\f
pxforlst 81.06.17. 14.25. page 11
m 174: 175 215: 216
mask 49* 182= 218 241 242 313
mask_type 49*
message 181
messnr 177 178
mess_l 181
n 28* 303: 304 306
new 62* 307= 310= 311
new_sp_data 30* 304 306
new_ts_data 26* 303
nl 164 181 228 230 244 254 276
nrlines 212* 261= 266= 266 267 270
oct 20* 126: 188
old_sp_data 61* 304 306=
operatorsem 71 85
operbuf_t 35* 51* 69 95 289
outbuf 69: 70 95: 96 289: 290=
outbufp 50* 70 73= 78 89= 97 98= 98 99
outbufpool 51* 287
outbufr 52* 67 69: 71 80 81 83 85 95: 287 288 288 289: 291
outbuf_init 35* 290
outchar 76* 106 152 164 181 228 230 237 244 248 249 250 251 252 253
254 269 276
outfield 155* 178 180 220 221 222 223 224 229 239
outint 109* 163 227 236 248 249 250 269 274
outprint 113* 131 148:
outputbuf 65* 99 199 279
outtext 103* 162 181 225 244
out_lcp_mess 167* 185 203* 312
p 167* 171* 174: 203* 215:
pool 51*
pop 297
position 179 180
prdata 241
prhead 218
process 7*
prvert 242
push 195 321
reference 52* 56* 58* 59* 60* 167* 171* 203*
remb 212* 262= 265 270 270
repmess 183
reserve_hook 56* 296 324
reserve_sem 9* 296 324
return 196 291 322
\f
pxforlst 81.06.17. 14.25. page 12
semaphore 9* 10* 53*
sender_id 218 220 234 236
seq_no 221
signal 71 85 324
sp_5_data 25* 30* 61* 61*
sp_data 247 274
sp_data_sz 13*
sp_head 175 216 245
sp_head_type 29*
sp_type 222
status 224 239 239
succ 98 266 273
system_vector <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
8*
sys_vector 8* 71 85
s_h 29*
time 227
time_lgt 15* 226
tlen 157* 162
true 14* 54* 90 307
ts_data_type 215
txt 103* 106 112* 125= 126= 127= 128= 141= 142= 149= 151= 152 156* 162
txt_len 103* 109*
txt_type 103* 112* 156*
typ 160* 163
types 21* 24* 160*
u1 288= 299
u2 81 83= 83 288= 298=
val 109* 116 117 119= 119 130= 137 138= 138 145 149 158* 163 212* 247=
249 250 252 252
wait 80 295 296
wrdt 21* 130 220 221 224 229 239
\f
pxforlst 81.06.17. 14.25. page 13
AND 4
ARRAY 5
BEGIN 32
CASE 2
CONST 3
DIV 5
DO 19
DOWNTO 1
ELSE 10
END 35
FOR 9
FORWARD 1
GOTO 1
IF 28
IN 1
LABEL 1
MOD 4
NIL 4
NOT 4
OF 8
OR 2
OTHERWISE 1
PACKED 1
PROCEDURE 8
RECORD 1
REPEAT 1
THEN 28
TO 8
TYPE 2
UNTIL 1
VAR 11
WHILE 1
WITH 3
*message compile pxfor
compile pxfor
*pascal80 codesize.1024 spacing.1024 xtenv xncpenv xpoolenv xrouenv ncthenv,
testenv source
81.06.17. 14.26. pascal80 version 1981.04.01
name headline beginline endline appetite(words)
outputbuf 66 68 74 : 9
outchar 77 79 101 : 10
outtext 104 106 107 : 17
outint 111 115 153 : 30
outfield 161 162 165 : 21
int_comint_c 173 174 200 : 31
out_lcp_mess 206 215 281 : 45
formatter 13 286 326 : 118
code: 3 . 974 = 4046 bytes
end of PASCAL80 compilation
end
blocksread = 53
*mode list.no
▶EOF◀