source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/ARJTXRB.m@ 861

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1ARJTXRB ;PUG/TOAD - Routine Buffer Tools ;2/27/02 13:58
2 ;;8.0;KERNEL;;Jul 10, 1995;**LOCAL RTN: PUG/TOAD**
3 ;
4LOAD(ROUTINE,ROOT) ; Load a routine into a global
5 ; ROUTINE = name of the routine
6 ; ROOT = name of the global root, closed array format (e.g., "^TMP($J)")
7 ;
8 K @ROOT
9 N LINE,LABEL,BODY
10 N BYTES S BYTES=0 ; size of routine
11 N CHAR S CHAR=0 ; absolute count of char position, incl. eol as $C(13)
12 N LINECHAR ; relative count of char position within each line
13 N CHECKSUM S CHECKSUM=0 ; absolute checksum of routine, incl. comments
14 N LABEL,SECTION,FROM S SECTION="[anonymous]",FROM=1
15 ;
16 N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D
17 . I $E(LINE)'=" " D ; deal with line label
18 . . S LABEL=$P($P(LINE," "),"(") ; get line label if any
19 . . Q:LABEL="" ; this should never happen, but who knows
20 . . S @ROOT@("B",LABEL,NUM)="" ; index of labels
21 . . I NUM-FROM D ; for all but anonymous, unless it has lines
22 . . . S @ROOT@("ALINE",FROM,NUM,SECTION)="" ; index lines by sec
23 . . . S @ROOT@("ASIZE",SECTION,NUM-FROM)="" ; index sections by # lines
24 . . S SECTION=LABEL,FROM=NUM ; start next section
25 . E S LABEL="",BODY=LINE,$E(BODY)=""
26 . S @ROOT@(NUM,0)=LINE
27 . S BYTES=BYTES+$L(LINE)+2
28 . F LINECHAR=1:1:$L(LINE) D ; add line to cumulative absolute checksum
29 . . S CHAR=CHAR+1 ; advance absolute counter
30 . . S CHECKSUM=CHECKSUM+($A(LINE,LINECHAR)*CHAR)
31 . S CHAR=CHAR+1,CHECKSUM=CHECKSUM+(13*CHAR) ; incl. end of line
32 ;
33 N NODE0 S NODE0=ROUTINE_U_$$HTFM^XLFDT($H)_U_(NUM-1)
34 S NODE0=NODE0_U_BYTES_U_CHECKSUM
35 S @ROOT@(0)=NODE0
36 Q
37 ;
38 ;
39RCMP1(ROU1,ROU2) ; compare sections in two routines
40 ;
41 K ^TMP("ARJTXR",$J) ; clear routine buffers
42 ;
43 N GLO1 S GLO1=$NA(^TMP("ARJTXR",$J,ROU1))
44 D LOAD(ROU1,GLO1)
45 N STATS1
46 D SUMM1(GLO1,.STATS1) ; summarize 1st routine
47 ;
48 N GLO2 S GLO2=$NA(^TMP("ARJTXR",$J,ROU2))
49 D LOAD(ROU2,GLO2)
50 N STATS2
51 D SUMM1(GLO2,.STATS2) ; summarize 2nd routine
52 ;
53 QUIT ;
54 ;
55SUMM1(ROOT,STATS) ; summarize the routine loaded into @ROOT
56 ;
57 N NODE0 S NODE0=$G(@ROOT@(0))
58 K STATS
59 S STATS("NAME")=$P(NODE0,U) W !!,STATS("NAME")
60 S STATS("LINES")=$P(NODE0,U,3) W ?13,STATS("LINES")," lines"
61 S STATS("BYTES")=$P(NODE0,U,4) W ?27,STATS("BYTES")," bytes"
62 S STATS("CSUM")=$P(NODE0,U,5) W ?42,"Checksum = ",STATS("CSUM")
63 ;
64 N SECTION
65 N ALINE S ALINE=$NA(@ROOT@("ALINE"))
66 N SUBS S SUBS=$QL(ALINE)
67 N NODE S NODE=ALINE
68 F S NODE=$Q(@NODE) Q:NODE="" Q:$NA(@NODE,SUBS)'=ALINE D
69 . S SECTION=$QS(NODE,SUBS+3)
70 . W !?13,SECTION,?26,$O(@ROOT@("ASIZE",SECTION,0))," lines"
71 ;
72 QUIT
73 ;
74 ;
75RCMP2(ROU1,ROU2) ; compare sections in two routines
76 ;
77 K ^TMP("ARJTXR",$J) ; clear routine buffers
78 ;
79 N GLO1 S GLO1=$NA(^TMP("ARJTXR",$J,ROU1))
80 D LOAD(ROU1,GLO1)
81 N STATS1
82 D SUMM2(GLO1,.STATS1) ; summarize 1st routine
83 ;
84 N GLO2 S GLO2=$NA(^TMP("ARJTXR",$J,ROU2))
85 D LOAD(ROU2,GLO2)
86 N STATS2
87 D SUMM2(GLO2,.STATS2) ; summarize 2nd routine
88 ;
89 W !!,"Routine comparison of ",ROU1," and ",ROU2,"."
90 W !!?13,ROU1,?40,ROU2
91 W !,"Lines",?13,STATS1("LINES"),?40,STATS2("LINES")
92 W !,"Bytes",?13,STATS1("BYTES"),?40,STATS2("BYTES")
93 W !,"Checksum",?13,STATS1("CSUM"),?40,STATS2("CSUM")
94 W !,"Sections:"
95 N SECTION
96 F SECTION=1:1 Q:'$D(STATS1(SECTION))&'$D(STATS2(SECTION)) D
97 . W !?5,SECTION
98 . I $D(STATS1(SECTION)) D
99 . . W ?13,$P(STATS1(SECTION),U)
100 . . W ?26,$P(STATS1(SECTION),U,2)," lines"
101 . I $D(STATS2(SECTION)) D
102 . . W ?40,$P(STATS2(SECTION),U)
103 . . W ?53,$P(STATS2(SECTION),U,2)," lines"
104 ;
105 QUIT ;
106 ;
107 ;
108SUMM2(ROOT,STATS) ; summarize the routine loaded into @ROOT
109 ;
110 N NODE0 S NODE0=$G(@ROOT@(0))
111 K STATS
112 S STATS("NAME")=$P(NODE0,U)
113 S STATS("LINES")=$P(NODE0,U,3)
114 S STATS("BYTES")=$P(NODE0,U,4)
115 S STATS("CSUM")=$P(NODE0,U,5)
116 ;
117 N SECTION
118 N COUNT
119 N ALINE S ALINE=$NA(@ROOT@("ALINE"))
120 N SUBS S SUBS=$QL(ALINE)
121 N NODE S NODE=ALINE
122 F COUNT=1:1 S NODE=$Q(@NODE) Q:NODE="" Q:$NA(@NODE,SUBS)'=ALINE D
123 . S SECTION=$QS(NODE,SUBS+3)
124 . S STATS(COUNT)=SECTION_U_$O(@ROOT@("ASIZE",SECTION,0))
125 ;
126 QUIT
127 ;
128 ;
Note: See TracBrowser for help on using the repository browser.