devel/misc/unknown/src/XLIST.ELA

Raw file
Back to index

  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
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
PACKET xlist DEFINES xlist :          (* M. Staubermann, 1.8.0 861203 *)
                                      (* Heapsize korrigiert   870711 *) 
DATASPACE VAR ds, act ;
 
PROC x list : 
 ds := nilspace ; 
 FILE VAR f := sequentialfile (output, ds) ; 
 headline (f, "Dataspaces:" + text (dataspaces) + 
              "  Speicher:" + text (storage (myself))) ; 
 disablestop ;
 xlist (f) ; 
 show (f) ; 
 forget (ds) ; 
ENDPROC x list ; 
 
PROC x list (FILE VAR f) : 
 INT VAR i, acttype, heapsiz, seiten ;
 TEXT VAR name, status ;
 FILE VAR f2 ;
 ROW 255 STRUCT (TEXT name, status) VAR names ;

 enablestop ;
 FOR i FROM 1 UPTO 255 REP 
  names (i).name := "" ; 
  names (i).status := "" 
 PER ; 
 begin list ; 
 get list entry (name, status) ; 
 WHILE name <> "" REP 
  makeid (old (name)) ; 
  names (dsnr).name := name ; 
  names (dsnr).status := status ;
  get list entry (name, status) 
 PER ;
 maxlinelength (f, 1000) ;
 putline (f, "Datum  Status Ds    kB  Type HeapLines Segs S/L ""Name""/'Headline'");
 line (f) ;
 putline (f, "               4 " + text ((pages (4, myself)+1) DIV 2, 5) +
             "        " + text (heapsize, 3) + "    -    -  -") ; 
 disablestop ;
 FOR i FROM 5 UPTO 255 REP 
  cout (i) ;
  makeid (i) ;
  act := reveal ds ; 
  IF iserror
   THEN clearerror
   ELSE name := names (i).name ; 
        status := names (i).status ; 
        acttype := type (act) ;
        names (i).name := "" ; 
        names (i).status := "" ;
        put (f,  stat + id + " " + speicher + " " + typ + " " + heap) ;
        putline (f, zeilen + " " + segmente + " " + sl percent + dsname) ; 
  FI ; 
  forget (act) ; 
  IF iserror THEN puterror ; clearerror FI
 PER . 
 
dsname : 
 IF name = "" 
    THEN IF act type = 1003 
            THEN " '" + headline (f2) + "'" 
            ELSE ""
         FI
    ELSE " """ + name + """" 
 FI . 
 
stat : 
 IF status = "" 
    THEN "             " 
    ELSE status 
 FI . 
 
typ: 
 text (act type, 5) .
 
id : 
 text (i, 3) .
 
speicher : 
 seiten := ds pages (act) ;
 text ((seiten+1) DIV 2, 5) . 
 
zeilen : 
 IF act type <> 1003 THEN "   -" 
 ELSE f2 := sequentialfile (modify, act) ; 
      text (lines (f2), 4) 
 FI . 
 
segmente : 
 IF act type <> 1003 THEN "   -" 
 ELSE INT CONST segs :: segments (f2) ; 
      text (segs, 4) 
 FI . 
 
sl percent: 
 IF act type <> 1003 THEN " - "
 ELIF segs = 1 THEN "   " 
 ELSE text (int (real (segs) * 100.0 / real (lines (f2))+0.5), 2) + "%" 
 FI . 
 
heap :
 heapsiz:= heapsize (act) * 2 ;
 IF heapsiz >= 2046 
    THEN "   -" 
 ELIF act type = 1003 
    THEN IF heapsiz < 192 
            THEN "   0" 
            ELSE text ((heapsiz-192) DIV 2, 4)
         FI 
 ELSE INT CONST next page :: next ds page (act, seiten) ; 
      IF next page < 0 
         THEN "   0" 
      ELIF heapsiz = next page 
         THEN "   1" 
      ELSE text ((heapsiz + 1 - next page) DIV 2, 4)
      FI 
 FI .

ENDPROC x list ; 
 
PROC make id (DATASPACE CONST ds) : 
 BOUND INT VAR i := ds 
ENDPROC make id ; 
 
INT PROC dsnr : 
 INT VAR id ; 
 id AND 255
ENDPROC dsnr ; 
 
PROC makeid (INT CONST nr) : 
 INT VAR dsid := nr + 256 * index (myself) 
ENDPROC makeid ; 
 
DATASPACE PROC reveal ds :
 DATASPACE VAR ds ; ds 
ENDPROC reveal ds ;
 
INT PROC pages (INT CONST dsnr, TASK CONST task) : 
 EXTERNAL 88 
ENDPROC pages ; 
 
ENDPACKET x list ;