324 lines
9.2 KiB
Mathematica
324 lines
9.2 KiB
Mathematica
%ZOSVKSE ;OAK/KAK - Automatic INTEGRIT Routine (Cache) ;5/9/07 10:46
|
|
;;8.0;KERNEL;**90,94,197,268,456**;Jul 26, 2004
|
|
;
|
|
; Version for Cache
|
|
;
|
|
Q
|
|
;
|
|
START(KMPSTEMP) ;-- called by routine CVMS+2^KMPSGE/CWINNT+1^KMPSGE in VAH
|
|
;
|
|
; KMPSTEMP... ^ piece 1: SiteNumber
|
|
; piece 2: SessionNumber
|
|
; piece 3: XTMP Global Location
|
|
; piece 4: Current Date/Time
|
|
; piece 5: Production UCI
|
|
;
|
|
N DIRNAM,KMPSDT,KMPSERR,KMPSERR1,KMPSERR2,KMPSERR3,KMPSERR4
|
|
N KMPSLOC,KMPSPROD,KMPSSITE,KMPSVOL,KMPSZU,NUM,X,VERSION,ZV
|
|
;
|
|
I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERROR^%ZOSVKSE"
|
|
E S X="ERROR^%ZOSVKSE",@^%ZOSF("TRAP")
|
|
;
|
|
S U="^",KMPSSITE=$P(KMPSTEMP,U),NUM=$P(KMPSTEMP,U,2),KMPSLOC=$P(KMPSTEMP,U,3)
|
|
S KMPSDT=$P(KMPSTEMP,U,4),KMPSPROD=$P(KMPSTEMP,U,5),KMPSVOL=$P(KMPSTEMP,U,6)
|
|
K KMPSTEMP
|
|
S KMPSZU=$ZU(5)_","_KMPSVOL
|
|
S ^XTMP("KMPS","START",KMPSVOL,NUM)=$H
|
|
S VERSION=+($TR($E($ZV,38,43)," ",""))
|
|
;
|
|
UCI ;-- code from routine INTEGRIT/Integrity
|
|
;
|
|
; DIRNAM = directory name
|
|
S DIRNAM=KMPSVOL
|
|
;
|
|
S ZV=$E($ZV,1,17)
|
|
I ZV="Cache for Windows" D UC1
|
|
I ZV="Cache for OpenVMS" D UC1VMS
|
|
DONE ; normal exit
|
|
C 63
|
|
K ^XTMP("KMPS","START",KMPSVOL)
|
|
Q
|
|
;
|
|
UC1 ;-- entry point for Cache NT
|
|
; code from routine INTEGRIT
|
|
;
|
|
N A,BLK,CUR,DIRSTAT,ERR,G,GLOBAL,J,LEV,LINK,LNB,LNBLK,LNBYTE,LSNP,LTOTBLK,LTOTBYTE
|
|
N N,NB,NBLK,NBYTE,NP,RET,TL,TOTBLK,TOTBYTE
|
|
;
|
|
; prevent dismounted database
|
|
S DIRSTAT=$P($ZU(49,DIRNAM),",",1)
|
|
; either dismounted or does not exist
|
|
I DIRSTAT<0 D ERR G ERROR
|
|
O 63:"^^"_DIRNAM
|
|
D INTEG1
|
|
I $G(GLOBAL(1))="" S ^XTMP("KMPS",KMPSSITE,NUM," NO GLOBALS ",KMPSVOL)="" Q
|
|
D EV1
|
|
Q
|
|
;
|
|
GLOCHK ;
|
|
N GLOINFO,JRNL,PROT,PROTINFO
|
|
;
|
|
; these extra logic ideas are from routine %GD
|
|
; GLO = name ^ type ^ protection ^ growth_area ^ root_block (first pointer block) ^ journal ^ collate
|
|
S PROT=$P(GLO,U,3),PROT(0)="N",PROT(1)="R",PROT(2)="RW",PROT(3)="RWD"
|
|
; protection - world ^ group ^ owner ^ network
|
|
S PROTINFO=PROT(PROT\16#4)_U_PROT(PROT\4#4)_U_PROT(PROT#4)_U_PROT(PROT\64#4)
|
|
S JRNL=$S($P(GLO,U,6):"Y",1:"N")
|
|
; global info = jrnl^collating^blank^growth area block^blank^protection:world^group^owner^network^first pointer block
|
|
S GLOINFO=JRNL_U_$P(GLO,U,7)_"^^"_$P(GLO,U,4)_"^^"_PROTINFO_U_$P(GLO,U,5)
|
|
; end of extra logic ideas
|
|
;
|
|
S TOTBLK=TOTBLK+1
|
|
S G=$P(GLO,U,2,99),G=$P(G,U,4),LEV=1
|
|
;
|
|
; quit if global is implicit - do not process
|
|
I G\256=65535 Q
|
|
;
|
|
S X="ERRHND^%ZOSVKSE",@^%ZOSF("TRAP")
|
|
S $ZE=""
|
|
;
|
|
B ; LEV(LEV) = root block
|
|
S LEV(LEV)=G
|
|
V G
|
|
S A=$V(2043,0)
|
|
; find bottom level
|
|
I A=2!(A=6) S G=$V(2,-5),LEV=LEV+1 G B
|
|
;
|
|
S X="",@^%ZOSF("TRAP")
|
|
;
|
|
; W LEV_" Levels in this global"
|
|
S (NBLK,LNBLK,NBYTE,LNBYTE)=0,CUR=1
|
|
; LEV(1) = first block number
|
|
S ^XTMP("KMPS",KMPSSITE,NUM,KMPSDT,$P(GLO,U),KMPSZU)=LEV(1)_U_GLOINFO
|
|
C S BLK=LEV(CUR),RET="RETURN^"_$ZN
|
|
; W "Level: "_CUR_", "
|
|
;
|
|
S X="ERRHND^%ZOSVKSE",@^%ZOSF("TRAP")
|
|
;
|
|
D RESTART^%ZOSVKSS
|
|
;
|
|
S X="",@^%ZOSF("TRAP")
|
|
;
|
|
Q:+$G(^XTMP("KMPS","STOP"))
|
|
RETURN S TOTBLK=NP+TOTBLK,LTOTBLK=LTOTBLK+LSNP
|
|
S TOTBYTE=TOTBYTE+NB,LTOTBYTE=LTOTBYTE+LNB
|
|
I $ZE="" S CUR=CUR+1 I CUR<LEV G C
|
|
; W %TIM
|
|
Q
|
|
ERRHND ; if there's an error from line tag B or from call
|
|
; to RESTART^%ZOSVKVSS come here and skip the rest
|
|
; of this global
|
|
S X="",@^%ZOSF("TRAP")
|
|
Q
|
|
EV1 ;
|
|
N GC,GLO,GS
|
|
;
|
|
S (TOTBLK,LTOTBLK,TOTBYTE,LTOTBYTE,GC)=0
|
|
EV2 S GC=$O(GLOBAL(GC)),GS=1
|
|
;
|
|
S ^XTMP("KMPS","START",KMPSVOL,NUM)=$H
|
|
;
|
|
I GC=""!+$G(^XTMP("KMPS","STOP")) G EVL
|
|
EV3 S GLO=$P(GLOBAL(GC),",",GS)
|
|
I GLO=""!+$G(^XTMP("KMPS","STOP")) G EVL
|
|
I GLO="*" G EV2
|
|
; W "Global ^"_$P(GLO,U)
|
|
D GLOCHK
|
|
S GS=GS+1
|
|
G EV3
|
|
EVL ; N TBLK
|
|
; S TBLK=TOTBLK+LTOTBLK
|
|
; W "Total global blocks in "_DIRNAM_" = "_TBLK
|
|
; W "Total efficiency = "
|
|
; I (TBLK) W ((TOTBYTE+LTOTBYTE)*100)\((2036*TOTBLK)+(2048*LTOTBLK))_"%"
|
|
Q
|
|
ERR ;
|
|
I DIRSTAT=-1 S KMPSERR1=DIRNAM_" is dismounted"
|
|
I DIRSTAT=-2 S KMPSERR1=DIRNAM_" does not exist"
|
|
; set the error variable
|
|
S $ZE="<UDIRECTORY>UC1+6^%ZOSVKSE"
|
|
Q
|
|
;-- end code from routine INTEGRIT
|
|
;
|
|
INTEG1 ;-- code from routine INTEG1
|
|
;
|
|
; place global information into local variable GLOBAL array
|
|
; GLOBAL(1:C) = gbl_info1, gbl_info2, ... * (no '*' on last)
|
|
; gbl_info = name ^ type ^ protection ^ growth_area ^ root_block (first pointer block) ^ journal ^ collate
|
|
;
|
|
N %ST,A,C,END,G,GD,INFO,NAM,P
|
|
;
|
|
K GLOBAL
|
|
S C=1,GLOBAL(C)=""
|
|
V 1
|
|
D GFS^%ST
|
|
; obtain global directory (GD) from system table array (%ST)
|
|
S GD=$V(%ST("GFOFFSET")+%ST("gfdir"),0,%ST("szdir")),G=0
|
|
B1 V GD
|
|
S END=$V(2046,0,2),NAM="",P=0
|
|
;
|
|
NEXT G D1:END'>P
|
|
;
|
|
C1 ; build name
|
|
S A=$V(P,0),P=P+1
|
|
I A S NAM=NAM_$C(A) G C1
|
|
;
|
|
; info = type ^ protection ^ growth_area ^ root_block (first pointer block) ^ journal ^ collate
|
|
S INFO=$V(P,0,"2O")_U_$V(P+2,0)_U_$V(P+3,0,"3O")_U_$V(P+6,0,"3O")_U_$V(P,0)_U_$V(P+1,0)
|
|
;
|
|
; one entry
|
|
S GLOBAL=NAM_U_INFO
|
|
I $L(GLOBAL(C))>460 S GLOBAL(C)=GLOBAL(C)_"*",C=C+1,GLOBAL(C)=""
|
|
;
|
|
S GLOBAL(C)=GLOBAL(C)_GLOBAL_","
|
|
;
|
|
S G=G+1,P=P+9,NAM="" G NEXT
|
|
D1 S GD=$V(2040,0,"3O") I GD G B1
|
|
Q
|
|
;-- end code from routine INTEG1
|
|
;
|
|
ERROR ; ERROR - Tell all SAGG jobs to STOP collection
|
|
;
|
|
C 63
|
|
S KMPSERR="Error encountered while running SAGG collection routine for volume set "_$G(KMPSVOL)
|
|
S KMPSERR2="Last global reference = "_$ZR
|
|
S KMPSERR3="Error code = "_$$EC^%ZOSV
|
|
I $D(KMPSERR4) S KMPSERR4="For more information, read text at line tag "_KMPSERR4_" in routine ^%ZOSVKSS"
|
|
;
|
|
S ^XTMP("KMPS","ERROR",KMPSVOL)="",^XTMP("KMPS","STOP")=1
|
|
K ^XTMP("KMPS","START",KMPSVOL)
|
|
;
|
|
D ^%ZTER,UNWIND^%ZTER
|
|
;
|
|
Q
|
|
;
|
|
UC1VMS ;-- entry point for Cache VMS
|
|
; code from routine Integrity (Cache v4.1.16)
|
|
;
|
|
N GLOARRAY,RC
|
|
;
|
|
; set up GLOARRAY array indexed by global name
|
|
S RC=$$GETDIRGL^%ZOSVKSD(VERSION)
|
|
;
|
|
I ('+RC) D ERRVMS G ERROR
|
|
;
|
|
I '$D(GLOARRAY) S ^XTMP("KMPS",KMPSSITE,NUM," NO GLOBALS ",KMPSVOL)="" Q
|
|
;
|
|
O 63:"^^"_DIRNAM
|
|
;
|
|
D ALLGLO
|
|
;
|
|
Q
|
|
;
|
|
ALLGLO ;- collect global info
|
|
;
|
|
N COLLATE,DATASIZE,FBLK,GLO,GLOINFO,GLOTOTBLKS,GLOPNTBLKS,GLOTOTBYTES
|
|
N GLOPNTBYTES,GLOBIGBLKS,GLOBIGBYTES,GLOBIGSTRINGS,GRWBLK
|
|
N I,INFO,JRNL,LEV,MSGLIST,PROT,PROTECT,PROTINFO,RC,TPTRBLK,TRY
|
|
;
|
|
S GLO="",RC=1
|
|
S PROT(0)="N",PROT(1)="R",PROT(2)="RW",PROT(3)="RWD"
|
|
;
|
|
F S GLO=$O(GLOARRAY(GLO)) Q:GLO=""!+$G(^XTMP("KMPS","STOP")) D Q:+$G(^XTMP("KMPS","STOP"))!('+RC)
|
|
.;
|
|
.S (COLLATE,FBLK,GRWBLK,JRNL,PROTECT,TPTRBLK)=""
|
|
.S PROTINFO="^^^"
|
|
.;
|
|
.; return collation value for this global (GLO)
|
|
.;S RC=$$GetCollationType^%DM(DIRNAM,GLO,.COLLATE)
|
|
.;
|
|
.; return protection value for this global (GLO)
|
|
.;S RC=$$GetProtectState^%DM(DIRNAM,GLO,.PROTECT)
|
|
.;I +RC D
|
|
..; protection - world ^ group ^ owner ^ network
|
|
..;S PROTINFO=PROT(PROTECT\16#4)_U_PROT(PROTECT\4#4)_U_PROT(PROTECT#4)_U_PROT(PROTECT\64#4)
|
|
.;
|
|
.; return top pointer block and first data block for this global (GLO)
|
|
.;S RC=$$GetGlobalPointers^%DM(DIRNAM,GLO,.TPTRBLK,.FBLK)
|
|
.;
|
|
.;-- these extra logic ideas are from routine ^%GD
|
|
.; this code MUST use %utility($J) to properly work
|
|
.;K ^%utility($J)
|
|
.;
|
|
.; $$Fetch^%GD is NOT a PUBLIC API
|
|
.; <<< PUBLIC API $$GetJournalType^%DM did NOT work >>>
|
|
.;I $$Fetch^%GD(GLO,1,0) D
|
|
..;S INFO=$G(^%utility($J,U_GLO))
|
|
..;Q:INFO=""
|
|
..;
|
|
..;S GRWBLK=$P(INFO,U,2)
|
|
..;S JRNL=$S($P(INFO,U,4):"Y",1:"N")
|
|
..;
|
|
..;K ^%utility($J)
|
|
..;-- end of extra logic ideas from routine ^%GD
|
|
.;
|
|
.; global info - '^' delimited
|
|
.; piece 1: first block
|
|
.; piece 2: jrnl^collate
|
|
.; piece 3: bits(blank)
|
|
.; piece 4: growth area block
|
|
.; piece 5: protection:system(blank)
|
|
.; piece 6: protection:world
|
|
.; piece 7: group^owner
|
|
.; piece 8: network^top (first) pointer block
|
|
.S GLOINFO=FBLK_U_JRNL_U_COLLATE_"^^"_GRWBLK_"^^"_PROTINFO_U_TPTRBLK
|
|
.;
|
|
.S ^XTMP("KMPS",KMPSSITE,NUM,KMPSDT,GLO,KMPSZU)=GLOINFO
|
|
.;
|
|
.; check integrity of a single global
|
|
.; will stop if there are more than 999 errors with this global
|
|
.S RC=$$GLOINTEG^%ZOSVKSD(VERSION)
|
|
.;
|
|
.K MSGLIST
|
|
.D DCMPST^%ZOSVKSD(VERSION)
|
|
.;
|
|
.S (LEV,RC)=1
|
|
.F I=1:1:MSGLIST D
|
|
..S INFO=MSGLIST(I),BLK=$$BLK(INFO),EFF=$$EFF(INFO)
|
|
..;
|
|
..; more than 999 errors reported
|
|
..I INFO["***Further checking of this global is aborted." S RC=0 D ERRVMS1 Q
|
|
..;
|
|
..I ($P(INFO,":")["Top Pointer Level")!($P(INFO,":")["Top/Bottom Pnt Level") D Q
|
|
...S ^XTMP("KMPS",KMPSSITE,NUM,GLO,KMPSZU,KMPSDT,1)=BLK_"^"_EFF_"%^Pointer"
|
|
..I $P(INFO,":")["Pointer Level" D Q
|
|
...S LEV=LEV+1,^XTMP("KMPS",KMPSSITE,NUM,GLO,KMPSZU,KMPSDT,LEV)=BLK_"^"_EFF_"%^Pointer"
|
|
..I $P(INFO,":")["Bottom Pointer Level" D Q
|
|
...S LEV=LEV+1,^XTMP("KMPS",KMPSSITE,NUM,GLO,KMPSZU,KMPSDT,LEV)=BLK_"^"_EFF_"%^Bottom pointer"
|
|
..I $P(INFO,":")["Data Level" D Q
|
|
...S ^XTMP("KMPS",KMPSSITE,NUM,GLO,KMPSZU,KMPSDT,"D")=BLK_"^"_EFF_"%^Data"
|
|
..I $P(INFO,":")["Big Strings" D Q
|
|
...S ^XTMP("KMPS",KMPSSITE,NUM,GLO,KMPSZU,KMPSDT,"L")=BLK_"^"_EFF_"%^LongString"
|
|
;
|
|
I ('+RC) G ERROR
|
|
;
|
|
Q
|
|
;
|
|
BLK(STRNG) ;-- function to obtain number of blocks from input string
|
|
;
|
|
N BLK
|
|
Q:$G(STRNG)="" ""
|
|
S BLK=$$NOCOMMA($P($P(STRNG,"=",2)," "))
|
|
Q BLK
|
|
;
|
|
EFF(STRNG) ;-- function to obtain efficiency from input string
|
|
;
|
|
N EFF
|
|
Q:$G(STRNG)="" ""
|
|
S EFF=$P($P(STRNG,"%"),"(",2)
|
|
Q EFF
|
|
;
|
|
NOCOMMA(IN) ;-- strip comma from input string
|
|
;
|
|
Q $TR(IN,",","")
|
|
;
|
|
ERRVMS ;
|
|
S $ZE="<ERROR>UC1VMS+6^%ZOSVKSE"
|
|
I '+RC S KMPSERR1="ERROR: Cannot find global names for "_DIRNAM
|
|
Q
|
|
;
|
|
ERRVMS1 ;
|
|
S $ZE="<ERROR>ALLGLO+50^%ZOSVKSE"
|
|
S KMPSERR1="ERROR: Over 999 integrity errors with ^"_GLO_" in "_DIRNAM
|
|
Q
|