source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/ZOSVKSOS.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 7.1 KB
Line 
1%ZOSVKSS ;OAK/KAK - Automatic INTEGRIT Routine (cont.) (Cache) ;5/9/07 10:44
2 ;;8.0;KERNEL;**90,94,197,268,456**;Jul 26, 2004
3 ;
4 ; Version for Cache
5 ;
6RESTART ;-- called by routine C+6^%ZOSVKSE
7 ;
8 ;-- code from routine CHECKPNT
9 ;
10 K SUB,C
11 N B,D,E,FLAG,LE,LL,LN,LNP,TL1
12 ;
13 S (ERR,FLAG,NP,NB,LSNP,LNB)=0
14 ;
15 S X="",@^%ZOSF("TRAP")
16 ;
17 V BLK
18 S A=$V(2,-5)
19 V A
20 S A=",,"_($V(2043,0,1)*16777216+A)_","
21 ;
22 S X="ERR^%ZOSVKSS",@^%ZOSF("TRAP")
23 ;
24CHK Q:+$G(^XTMP("KMPS","STOP"))
25 ;
26 V BLK
27 S LINK=$V(2040,0,"3O")
28 S A=$V($P(A,",",3),-7,$P(A,",",4),400)
29 S TL=$P(A,",",3)\16777216
30 S NP=NP+A,NB=NB+$P(A,",",2)
31 ;
32 ; big global data blocks (type 12)
33 I FLAG=0,(TL=8)!(TL=12) S FLAG=1 V BLK S B=$V(2,-5) D
34 .F Q:'B V B S B=$V(2040,0,"3O") F N=1:1 Q:$V(N-1*2+1,-6)="" S X=$V(N-1*2+2,-6) S:$A(X)=3 LNB=LNB+($A(X,2)*2048)+$ZWA(X,3),LSNP=LSNP+$A(X,2)+1
35 ;
36CHKB I LINK S BLK=LINK G CHK
37 ;
38 ; ragged edge
39 I $P(A,",",3)#16777216,$P(A,",",3)\16777216-16 G ER6
40 ;
41END S X="",@^%ZOSF("TRAP")
42 ;
43 ; W "# ptrs = "_NP
44 S LNBLK=+$G(LNBLK)
45 ; na% => cannot calculate the percent efficiency of first pointer block
46 I CUR=1 S ^XTMP("KMPS",KMPSSITE,NUM,$P(GLO,"^"),KMPSZU,KMPSDT,CUR)="1^na%^Pointer"
47 I (NBLK+LNBLK) D
48 .; W ", # blks = "_(NBLK+LNBLK)_", # ptrs/blk = "_(NP\(NBLK+LNBLK))
49 .; W ", eff = "_(((NBYTE+LNBYTE)*100)\((2036*NBLK)+(2048*LNBLK)))_"%"
50 .S ^XTMP("KMPS",KMPSSITE,NUM,$P(GLO,"^"),KMPSZU,KMPSDT,CUR)=(NBLK+LNBLK)_"^"_(((NBYTE+LNBYTE)*100)\((2036*NBLK)+(2048*LNBLK)))_"%^"_$S(CUR=(LEV-1):"Bottom p",1:"P")_"ointer"
51 S TL=$P(A,",",3)\16777216
52 ;
53 ; m-code blocks (type 16) - do not store into ^XTMP("KMPS")
54 ; I TL=16 W "Routine level: # rtns = "_NP
55 ;
56 ; global data blocks (type 8) and big global data blocks (type 12)
57 I TL=8!(TL=12) D
58 .; I NP W "Data level: # blks = "_NP_", eff = " W:NP (NB*100\(2036*NP))_"%"
59 .I NP S ^XTMP("KMPS",KMPSSITE,NUM,$P(GLO,"^"),KMPSZU,KMPSDT,"D")=NP_"^"_$S(NP:NB*100\(2036*NP),1:"")_"%^Data"
60 .; I LSNP W "Long String level: # blks = "_LSNP_",eff = " W:LSNP (LNB*100\(2048*LSNP))_"%"
61 .I LSNP S ^XTMP("KMPS",KMPSSITE,NUM,$P(GLO,"^"),KMPSZU,KMPSDT,"L")=LSNP_"^"_$S(LSNP:LNB*100\(2048*LSNP),1:"")_"%^LongString"
62 S NBLK=NP,LNBLK=LSNP,NBYTE=NB,LNBYTE=LNB
63 Q
64 ;-- end code from routine CHECKPNT
65 ;
66ERR ;-- code from routine CHECK0
67 ;
68 S (LE,LL,ERR)=0
69 ;
70 ; global is too large for INTEGRIT - use ^DIAG to check this global
71 I $ZE?1"<MAXARRAY>".E S ERR=1 Q
72 ;
73 S D=BLK,LN=$P(A,",",4),TL=$P(A,",",3)\16777216
74 ;
75 S X="ERROR^%ZOSVKSS",@^%ZOSF("TRAP")
76 ;
77 V BLK
78 D CHECK1
79 Q:ERR
80 ;
81 K B
82 F I=1:2:C-2 S B=C(I)-1#400,B(C(I)-B,B)=""
83 D CM(1)
84 Q:ERR
85 ;
86 K B
87 F I=1:2:C-2 I C(I,1) D MB
88 D CM(249)
89 Q:ERR
90 ;
91 K B
92 S NP=C\2+NP,NB=NB+LE,A=",,"_(TL*16777216+LL)_","_LN
93 K C
94 ;
95 S X="ERR^%ZOSVKSS",@^%ZOSF("TRAP")
96 ;
97 G CHKB
98 ;
99ERROR I $ZE?1"<DISK".E!($ZE?1"<DATA".E) G ERDK
100 G MISC
101 ;
102CM(X) S D=""
103 F I=1:1 S D=$O(B(D)) Q:D="" V D D ER15:$V(2038,0,"4O")-1431699455!($V(2042,0,"4O")=0) Q:ERR S B="" F J=1:1 S B=$O(B(D,B)) Q:B="" I $V(B,0)'=X,$V(B,0)'=255 D ER5
104 Q
105 ;
106MB N A,X,L,BL,J,K,R
107 ;
108 V C(I)
109 F J=1:2 Q:$V(J,-6)="" S X=$V(J+1,-6) I $E(X)=3 D
110 .S N=$A(X,2),A=4,L=A+((N+1)*3) I L'=$L(X) D ER18 Q
111 .S R=$A(X,4)*256+$A(X,3) I (R<1)!(R>2048) D ER19
112 .F K=0:1:N S BL=(((($A(X,A+3)*256)+$A(X,A+2))*256)+$A(X,A+1)),A=A+3 S B=BL-1#400 I $D(B(BL-B,B)) D ER20 S B(BL-B,B)=C(I)_","_J_","_K
113 Q
114 ;-- end code from routine CHECK0
115 ;
116CHECK1 ;-- code from routine CHECK1
117 ;
118 F C=1:2 Q:$V(C,-5)="" S SUB(C)=$V(C,-5)
119 F I=1:2:C-2 D
120 .S C(I)=$V(I+1,-6),C(I,1)=C(I)\8388608#2,C(I)=C(I)#8388608
121 .I C(I)=BLK G ER10
122 I $P(A,",",3)#16777216-C(1),$P(A,",",3)\16777216-16 G ER3
123 F E=1:2:C-2 S D=C(E) V D D CH Q:ERR
124 I TL=16,LINK S D=LINK V D S LL=$V(2,-5)
125 Q
126 ;
127CH I $V(0,0)#256 G ER7
128 S TL1=$V(2043,0,1)
129 I (TL=8)!(TL=12) D
130 .I 'C(E,1),TL1'=8 G ER16
131 .I C(E,1),TL1'=12 G ER17
132 I (TL-8),(TL-12),$V(2043,0,1)-TL G ER12
133 S LE=LE+$V(2046,0,2)
134 I $V(1,-5)'=SUB(E) G ER8
135 Q:TL=16
136 S LL=$V(2040,0,"3O") I E+2<C,LL-C(E+2) G ER9
137 I $V(1,-6)']LN G ER1
138 S LN=$V(-1,-6),LNP=$V(-1,-5)
139 Q
140 ;-- end code from routine CHECK1
141 ;
142 ;-- code from routine CHECKERR
143 ;
144ER1 ; error: the first node in block D is $V(1,-5) and it should collate after the previous block's last node, which was LNP
145 S KMPSERR4="ER1",ERR=1
146 Q
147ER3 ; error: pointer block BLK has a first pointer of C(1) [ The node is SUB(1) ] but the link from the previous lower level block is $P(A,",",3)#16777216
148 S KMPSERR4="ER3",ERR=1
149 Q
150ER5 ; block B+D, which is pointed to by block BLK appears to be available in map block D - checking of this global will continue
151 S KMPSERR4="ER5"
152 I '$V(B,0) Q
153 ; block B+D, which is pointed to by block BLK has code $V(B,0) in the map block D whereas code X was expected - checking of this global will continue
154 Q
155ER6 ; error: pointer block BLK should have had a right link
156 ; V BLK F I=1:2 Q:$V(I,-6)=""
157 ; according to the lower level block $V(I-1,-5), which had a link to block $P(A,",",3)#16777216
158 S KMPSERR4="ER6",ERR=1
159 Q
160ER7 ; error: the 1st byte of block D should have been zero - the pointer block was BLK
161 S KMPSERR4="ER7",ERR=1
162 Q
163ER8 ; error: the lower block's first node didn't match the pointer node - node E+1\2 in pointer block BLK was: SUB(E) - the 1st node in the lower level block D was: $V(1,-5)
164 S KMPSERR4="ER8",ERR=1
165 Q
166ER9 ; error: the link in block D is LL although the pointer block BLK specifies that C(E+2) should be the next block
167 S KMPSERR4="ER9",ERR=1
168 Q
169ER10 ; error: node I+1\2 in block BLK points to itself - the node is: SUB(I)
170 S KMPSERR4="ER10",ERR=1
171 Q
172ER12 ; error: block D, which is pointed to by pointer block BLK has a block type of $V(2043,0,1) whereas a block type of TL was expected
173 S KMPSERR4="ER12",ERR=1
174 Q
175ER15 ; error: map block D does not have a correct map label - the pointer block was BLK
176 S KMPSERR4="ER15",ERR=1
177 Q
178 ;
179ER16 ; block D, which is pointed to by pointer block BLK has a block type of $V(2043,0,1) whereas a block type of 8 was expected since the pointer block say big data nodes are not present
180 ; checking of this global will continue if $V(2043,0,1)=12
181 I $V(2043,0,1)=12 Q
182 ; else error
183 S KMPSERR="ER16",ERR=1
184 Q
185 ;
186ER17 ; block D, which is pointed to by pointer block BLK has a block type of $V(2043,0,1),whereas a block type of 12 was expected since the pointer block says big data nodes are present
187 ; checking of this global will continue if $V(2043,0,1)=8
188 I $V(2043,0,1)=8 Q
189 ; else error
190 S KMPSERR="ER17",ERR=1
191 Q
192 ;
193ER18 ; node J+1\2 in big data block C(I), which is pointed to by block BLK says number of data blocks is N, but length of node is $L(X) rather than L
194 ; this big string node will not be checked - checking of this global will continue
195 Q
196 ;
197ER19 ; node J+1\2 in big data block C(I), which is pointed to by block BLK says it has R bytes in last block, which is illegal - checking of this global will continue
198 Q
199 ;
200ER20 ; node J+1\2 in big data block C(I), which is pointed to by block BLK has data block BL which is also used as data block $P(B(BL-B,B),",",3) in node $P(B(BL-B,B),",",2)+1\2 of block $P(B(BL-B,B),",",1)
201 ; checking of this global will continue
202 Q
203 ;
204ERDK ; if D-BL error in lower block D - pointer block is BLK
205 ; else error in pointer block D - last node in prev pntr block was LNP
206 S KMPSERR="ERDK",ERR=1
207 Q
208 ;
209MISC ; misc error
210 S KMPSERR="MISC",ERR=1
211 Q
Note: See TracBrowser for help on using the repository browser.