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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
PACKET table info DEFINES table info : (* Michael Staubermann *)
(* 02.12.86 *)
LET insert flag addr = 4654 ,
(* prev modnr addr = 4662 , *)
cur modnr addr = 4806 ,
prev code end addr = 4775 ,
cur code end addr = 4807 ,
prev name tab end addr = 4688 ,
cur name tab end addr = 4693 ,
prev permanent tab end addr = 4704 ,
cur permanent tab end addr = 4707 ,
prev denoter end addr = 4815 ,
cur denoter end addr = 4809 ,
prev static data end addr = 4816 ,
cur static data end addr = 4810 ,
prev static data begin addr = 4817 ,
cur static data begin addr = 4811 ,
(*
begin of hash table = 0 ,
end of hash table = 1023 ,
begin of string table = 1024 ,
end of string table = 4093 ,
*)
begin of name table = 4096 ,
end of name table = 22783 ,
begin of permanent table = 22784 ,
end of permanent table = 32767 ,
begin of code = 4096 ,
begin of data = 4096 ;
INT CONST end of code :: -1 ,
end of data :: -1 ;
BOOL VAR was insert ;
INT PROC getword (INT CONST segment, address) :
EXTERNAL 120
ENDPROC getword ;
PROC arith16 :
EXTERNAL 92
ENDPROC arith16 ;
INT OP SUB (INT CONST left, right) :
arith 16 ;
left - right
ENDOP SUB ;
PROC entry (TEXT CONST name, BOOL CONST size,
INT CONST begin, cur, prev, end) :
put (subtext (name + " ....................", 1, 20) + ":") ;
IF size
THEN put (card (end SUB begin)) ;
put (card (end SUB cur)) ;
put (card (cur SUB begin)) ;
put (card (int (positiv (cur SUB begin) /
positiv (end SUB begin) * 100.0))) ;
ELSE put (" ")
FI ;
IF NOT was insert
THEN put (card (prev - cur))
FI ;
line
ENDPROC entry ;
PROC table info :
was insert := getword (0, insert flag addr) = 0 ;
line ;
put ("N„chste Modulenr.:") ;
put (getword (0, cur modnr addr)) ; line (2) ;
put ("Name Size Free Used Used%") ;
IF NOT was insert
THEN put ("LastRun")
FI ;
line ;
entry ("Permanenttable", TRUE, begin of permanent table,
getword (0, cur permanent tab end addr),
getword (0, prev permanent tab end addr), end of permanent table) ;
entry ("Nametable", TRUE, begin of name table,
getword (0, cur name tab end addr),
getword (0, prev name tab end addr), end of name table) ;
entry ("Code", TRUE, begin of code,
getword (0, cur code end addr),
getword (0, prev code end addr), end of code) ;
entry ("Data", TRUE, begin of data,
getword (0, cur static data end addr),
getword (0, prev static data end addr), end of data) ;
line ;
ENDPROC table info ;
REAL PROC positiv (INT CONST value) :
IF value < 0
THEN real (value) + 65536.0
ELSE real (value)
FI
ENDPROC positiv ;
TEXT PROC card (INT CONST i) :
IF i = minint
THEN "32768"
ELIF i < 0
THEN subtext (text (real (i) + 65536.0), 1, 5)
ELSE text (i, 5)
FI
ENDPROC card
ENDPACKET table info ;
|
