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
|
(**********************************************************************)
(* *)
(* This program generates/updates a dataspace "procheads" from the *)
(* file "bulletin", including the module numbers. "procheads" will *)
(* be used by 'trace" and 'disasm" to show the name and the formal *)
(* param list of a called procedure. *)
(* *)
(* GMD-Z2.P/G.Szalay/86-04-06 *)
(* *)
(**********************************************************************)
LET digits = "1234567890", outname = "procheads",
maxno of procs = 3071, first compiled module no = 256;
FILE VAR infile := sequential file (input, old ("bulletin"));
TEXT VAR buf, linebuf, entry, answer;
INT VAR i, j, module no, posit, max module no := 0;
BOUND ROW maxno of procs TEXT VAR proc heads;
putline ("generating """ + outname + """ ...");
BOOL VAR oldfile := exists (outname);
IF oldfile
THEN ask for action to be taken;
IF answer = "r"
THEN forget (outname); oldfile := FALSE;
proc heads := new (outname)
ELSE proc heads := old (outname)
FI
ELSE proc heads := new (outname)
FI;
IF NOT oldfile THEN init heads FI;
getline (infile, linebuf);
FOR i FROM 1 UPTO 1000 REP
process line;
cout (i);
getline (infile, linebuf)
UNTIL eof (infile) PER;
process missing heads.
ask for action to be taken:
out ("replace or append to old file """+outname+""" (r/a) ? ");
REP inchar (answer);
IF answer <> "r" AND answer <> "a" THEN out(""7"") FI
UNTIL answer = "r" OR answer = "a" PER;
putline (answer).
init heads:
proc heads (1) := "+>1";
FOR i FROM 2 UPTO maxno of procs REP proc heads (i) := "" PER.
process line:
fetch module no and entry;
IF module no >= first compiled module no
THEN IF module no < 10000
THEN proc heads (module no) := entry
ELSE proc heads (module no - 10000) := entry
FI
FI.
fetch module no and entry:
posit := LENGTH linebuf - 1;
WHILE pos (digits, linebuf SUB posit) <> 0
REP posit DECR 1 PER;
module no := int (subtext (linebuf, posit+1));
IF module no < 10000 AND module no > max module no
THEN max module no := module no
FI;
WHILE (linebuf SUB posit) = " " REP posit DECR 1 PER;
entry := subtext (linebuf, 1, posit).
process missing heads:
putline ("max module no=" + text(max module no));
FOR i FROM 1 UPTO max module no REP
cout(i);
IF proc heads (i) = "" THEN put in offset to last head FI
PER.
put in offset to last head:
FOR j FROM i-1 DOWNTO 1 REP
IF proc heads (j) <> ""
THEN IF subtext (proc heads (j), 1, 2) = "+>"
THEN proc heads (i) := "+>" + text (i - j
+ int (subtext (proc heads (j), 3)))
ELSE proc heads (i) := "+>" + text (i - j)
FI;
LEAVE put in offset to last head
FI
PER.
|