|
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: 9984 (0x2700)
Types: TextFileVerbose
Names: »testoutlst«
└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system
└─⟦72244f0ef⟧
└─⟦this⟧ »testoutlst«
\f
testoutlst 80.12.01. 15.24. page 1
10 1 PREFIX testout;
20 2
30 3 (*****************************************************************
40 4 *
50 5 * function: this procedure is used to produce testoutput to
60 6 * the operators console from within a pascal-80
70 7 * process.
80 8 *
90 9 * externals: none
100 10 *
110 11 * environment: testenv
120 12 *
130 13 * note: the used zone must be opened by a call of the
140 14 * procedure "open".
150 15 *
160 16 * programmed may 1980 by wib and stb.
170 17 *
180 18 ******************************************************************)
190 19
200 20
\f
testoutlst 80.12.01. 15.24. page 2
1010 21 PROCEDURE testout(VAR z:zone; text:alfa; i:integer);
1020 22 (* the procedure writes the text followed by the value of i
1030 23 on the operator console.
1040 24
1050 25 example:
1060 26 the call:
1070 27 _ i:=7;
1080 28 _ testout(z, "value is ",i);
1090 29 yields the following output:
1100 30 _ value is 7
1110 31 *)
1120 32
1130 33 TYPE
1140 34 opbuftype = RECORD
1150 35 ! first, last, next: integer;
1160 36 ! name: alfa;
1170 37 ! data: ARRAY(1..80) OF char;
1180 38 END;
1190 39
1200 40 VAR
1210 41 opbuf: opbuftype;
1220 42 opref: reference;
1230 43
1240 44
\f
testoutlst 80.12.01. 15.24. page 3
2010 45 PROCEDURE outchar(ch: char);
2020 46 (* writes ch into the output buffer *)
2030 47 BEGIN
2040 48 1 ! LOCK opref AS opbuf: opbuftype DO
2050 49 2 ! WITH opbuf DO
2060 50 3 ! BEGIN
2070 51 4 ! ! data(next):= ch;
2080 52 5 ! ! next:= next + 1;
2090 53 6 ! END;
2100 54 7 !
2110 55 8 END (* outchar *);
2120 56
\f
testoutlst 80.12.01. 15.24. page 4
3010 57 PROCEDURE outinteger(int,positions:integer);
3020 58 (* writes the integer "int" into opbuf starting at
3030 59 "outputpoint", which is updated accordingly *)
3040 60 CONST
3050 61 maxpos = 20; (* max number of positions in layout *)
3060 62 base = 10;
3070 63
3080 64 VAR
3090 65 digits:ARRAY(1..maxpos) OF char;
3100 66 used,i:integer;
3110 67 negative:boolean;
3120 68
3130 69 BEGIN
3140 70 1 ! used:= 1;
3150 71 2 !
3160 72 3 ! (* first we initialise the digits array *)
3170 73 4 ! FOR i:=1 TO maxpos DO digits(i):=sp;
3180 74 5 !
3190 75 6 ! i:=maxpos;
3200 76 7 !
3210 77 8 ! negative:= int<0;
3220 78 9 !
3230 79 10 ! REPEAT
3240 80 11 ! ! (* now we unpack the digits backwards and put them
3250 81 12 ! ! into the digits array *)
3260 82 13 ! !
3270 83 14 ! ! digits(i):= chr(abs(int MOD base) + ord("0"));
3280 84 15 ! ! int:=int DIV base;
3290 85 16 ! ! i:=i-1;
3300 86 17 ! UNTIL (i=1) OR (int=0);
3310 87 18 !
3320 88 19 ! IF negative THEN
3330 89 20 ! BEGIN
3340 90 21 ! ! digits(i):="-";
3350 91 22 ! ! i:=i-1;
3360 92 23 ! END;
3370 93 24 !
3380 94 25 ! used:=maxpos-i;
3390 95 26 !
3400 96 27 ! IF int <> 0 THEN digits(1):= "*";
3410 97 28 !
3420 98 29 ! (* i n{ste linje skal 20 erstattes af maxpos !!!!!!!!!!!!!!!!!!!!!!!*)
3430 99 30 ! IF (NOT (positions IN (. 1 .. 20 .)) )
3440 100 31 ! OR (positions < used) THEN
3450 101 32 ! positions:=used;
3460 102 33 !
\f
testoutlst 80.12.01. 15.24. page 5
3470 103 34 ! FOR i:=maxpos+1-positions TO maxpos DO
3480 104 35 ! outchar( digits(i) );
3490 105 36 !
3500 106 37 END (* out integer *);
3510 107
3520 108
3530 109
\f
testoutlst 80.12.01. 15.24. page 6
4010 110 PROCEDURE outstring(text: alfa);
4020 111 (* writes the text into opbuf starting at opbuf.next
4030 112 which is updated accordingly *)
4040 113 VAR
4050 114 i: integer;
4060 115 BEGIN
4070 116 1 ! FOR i:=1 TO alfalength DO
4080 117 2 ! outchar( text(i) );
4090 118 3 !
4100 119 4 END (* out string *);
4110 120
\f
testoutlst 80.12.01. 15.24. page 7
5010 121 BEGIN
5020 122 1 ! (**********************************************
5030 123 2 ! *
5040 124 3 ! * m a i n p r o g r a m
5050 125 4 ! *
5060 126 5 ! ************************************************)
5070 127 6 !
5080 128 7 ! wait(opref, z.testoutsem);
5090 129 8 !
5100 130 9 ! LOCK opref AS opbuf: opbuftype DO
5110 131 10 ! opbuf.next:= 1;
5120 132 11 ! outstring(text);
5130 133 12 ! outinteger(i,4);
5140 134 13 ! outchar(nl);
5150 135 14 ! LOCK opref AS opbuf: opbuftype DO
5160 136 15 ! WITH opbuf DO
5170 137 16 ! last:=next+16;
5180 138 17 !
5190 139 18 ! opref^.u2:= 0;
5200 140 19 ! signal(opref, z.opsem^);
5210 141 20 !
5220 142 21 ! wait(opref,z.testoutsem);
5230 143 22 ! return(opref);
5240 144 23 !
5250 145 24 END (* test out *);
5260 146 .
5270 147
\f
testoutlst 80.12.01. 15.24. page 8
0 77 86 96 139
1 37* 52 65* 70 73 85 86 91 96 99 103 116 131
4 133
10 62*
16 137
20 61* 99
80 37*
abs 83
alfa 21* 36* 110*
alfalength 116
as 48: 130: 135:
base 62* 83 84
boolean 67*
ch 45* 51
char 37* 45* 65*
chr 83
data 37* 51=
digits 65* 73= 83= 90= 96= 104
first 35*
i 21* 66* 73= 73 75= 83 85= 85 86 90 91= 91 94 103= 104
114* 116= 117 133
int 57* 77 83 84= 84 86 96
integer 21* 35* 57* 66* 114*
last 35* 137=
lock 48: 130: 135:
maxpos 61* 65* 73 75 94 103 103
name 36*
negative 67* 77= 88
next 35* 51 52= 52 131= 137
nl 134
opbuf 41* 48: 49 130: 131 135: 136
opbuftype 34* 41* 48 130 135
opref 42* 48: 128 130: 135: 139 140 142 143
opsem 140
ord 83
outchar 45* 104 117 134
outinteger 57* 133
outstring 110* 132
positions 57* 99 100 101= 103
prefix 1*
reference 42*
return 143
signal 140
sp 73
\f
testoutlst 80.12.01. 15.24. page 9
testout 1* 21*
testoutsem 128 142
text 21* 110* 117 132
u2 139=
used 66* 70= 94= 100 101
wait 128 142
z 21* 128 140 142
zone 21*
\f
testoutlst 80.12.01. 15.24. page 10
ARRAY 2
BEGIN 6
CONST 1
DIV 1
DO 8
END 7
FOR 3
IF 3
IN 1
MOD 1
NOT 1
OF 2
OR 2
PROCEDURE 4
RECORD 1
REPEAT 1
THEN 3
TO 3
TYPE 1
UNTIL 1
VAR 4
WITH 2
pascal testout
80.12.01. 15.24. pascal80 version 1980.11.28
file does not exist: alarmenv9
occured in 1040 = line 148 of readcall 584936 1754 rel of segm 22 of program
called from 2469 = line 15 of readline 584864 148 rel of segm 50 of program
called from 2508 = line 7 of inchar 584798 70 rel of segm 51 of program
called from 2713 = line 6 of lexical 584722 32 rel of segm 59 of program
called from 3193 = line 6 of parse 584484 46 rel of segm 71 of program
called from 3204 = line 5 of parser 575436 74 rel of segm 72 of program
called from 3211 = line 5 of platonpass1 551684 76 rel of segm 73 of program
blocksread = 54
«eof»