### Bookstore

 Computer Math and Games in Pascal (preview) Lazarus Handbook

### Author Topic: Function in Function and Result [SOLVED]  (Read 762 times)

#### trn76

• New Member
• Posts: 39
##### Function in Function and Result [SOLVED]
« on: October 30, 2020, 01:55:38 pm »
When I have a function within a function, how can I "access" the "main" Result?
...Yeah this example will not work, it is just an example - look at "<--- How to access "Main Function" Result?"

Code: Pascal  [Select][+][-]
1.
2. // https://github.com/FChrisF/LLCL/blob/master/sources/SysUtils.pas#L563
3. function Format(const sFormat: string; const Args: array of const): string;
4. // supported: %% %s %d %x %.prec? %index:?  TRN: added ;
5. var i, j, c, L: integer;
6.     decim: string;
7.
8.   function padding(const S, F: Char): boolean;
9.   var u: integer;
10.   begin
11.     if (sFormat[i]=S) and (i+2<=L) and (c<=high(Args)) and
12.        (ord(sFormat[i+1]) in [ord('1')..ord('9')]) and
13.        (ord(sFormat[i+2]) in [ord('d'),ord('x'),ord('p')]) and
14.        (Args[c].VType=vtInteger) then begin
15.       u := Args[c].VInteger;
16.       if sFormat[i+2]='d' then
17.         decim := IntToStr(u) else
18.         decim := IntToHex(u, ord(sFormat[i+1])-49);
19.       for u := length(decim) to ord(sFormat[i+1])-49 do
20.         decim := F + decim;
21.       ..result := ..result+decim;    // <--- How to access "Main Function" Result?
22.       Inc(c);
23.       Inc(i, 2);
24.       Result := True
25.     end else Result := False;
26.   end;
27.
28. begin
29.   if high(Args)<0 then begin
30.     result := sFormat;
31.     exit;
32.   end;
33.   result := '';
34.   L := length(sFormat);
35.   if L=0 then exit;
36.   i := 1;
37.   c := 0;
38.   while (i<=L) do begin
39.     j := i;
40.     while (i<=L) and (sFormat[i]<>'%') do Inc(i);
41.     case i-j of
42.       0: ;
43.       1: result := result+sFormat[j];
44.       else result := result+copy(sFormat, j, i-j);
45.     end;
46.     Inc(i);
47.     if i>L then break;
48.     if (ord(sFormat[i]) in [ord('0')..ord('9')]) and (i<L) and
49.        (sFormat[i+1]=':') then begin
50.       c := ord(sFormat[i])-48;  // Format('%d %d %d %0:d %d',[1,2,3,4]) = '1 2 3 1 2'
51.       Inc(i, 2);
52.       if i>L then break;
53.     end;
54.     if sFormat[i]='%' then        // Format('%%') = '%'
55.       result := result+'%' else   // Format('%.3d',[4]) = '004':
58.     //if (sFormat[i]='.') and (i+2<=L) and (c<=high(Args)) and
59.     //   (ord(sFormat[i+1]) in [ord('1')..ord('9')]) and
60.     //   (ord(sFormat[i+2]) in [ord('d'),ord('x'),ord('p')]) and
61.     //   (Args[c].VType=vtInteger) then begin
62.     //  j := Args[c].VInteger;
63.     //  if sFormat[i+2]='d' then
64.     //    decim := IntToStr(j) else
65.     //    decim := IntToHex(j, ord(sFormat[i+1])-49);
66.     //  for j := length(decim) to ord(sFormat[i+1])-49 do
67.     //    decim := '0'+decim;
68.     //  result := result+decim;
69.     //  Inc(c);
70.     //  Inc(i, 2);
71.     //end else
72.     if c<=high(Args) then begin
73.       with Args[c] do
74.       case sFormat[i] of
75.       's': case VType of
76.         vtString:     result := result+string(VString^);
77.         vtAnsiString: result := result+string(VAnsiString);
78.         vtPChar:      result := result+string(VPChar);
79.         vtChar:       result := result+string(VChar);
80.       'd': if VType=vtInteger then
81.              result := result+IntToStr(VInteger) else
82.            if VType=vtInt64 then
83.              result := result+IntToStr(VInt64^);
84.       'x','p': if VType in [vtInteger,vtPointer] then
85.         result := result+IntToHex(VInteger,8);
86.       end;
87.       Inc(c);
88.     end;
89.     Inc(i);
90.   end;
91. end;
92.
93.

...aaahahahhaha I got it before I could post

Code: Pascal  [Select][+][-]
1.
2. function Format(const sFormat: string; const Args: array of const): string;
3. // supported: %% %s %d %x %.prec? %index:?  TRN: added ;
4. var i, j, c, L: integer;
5.     decim: string;
6. var MReturn: string absolute Result;   // <--- Salute! :)
7.
8.   function padding(const S, F: Char): boolean;
9.   var u: integer;
10.   begin
11.     if (sFormat[i]=S) and (i+2<=L) and (c<=high(Args)) and
12.        (ord(sFormat[i+1]) in [ord('1')..ord('9')]) and
13.        (ord(sFormat[i+2]) in [ord('d'),ord('x'),ord('p')]) and
14.        (Args[c].VType=vtInteger) then begin
15.       u := Args[c].VInteger;
16.       if sFormat[i+2]='d' then
17.         decim := IntToStr(u) else
18.         decim := IntToHex(u, ord(sFormat[i+1])-49);
19.       for u := length(decim) to ord(sFormat[i+1])-49 do
20.         decim := F + decim;
21.       MReturn := MReturn+decim;    // K.I.S.S :)=
22.       Inc(c);
23.       Inc(i, 2);
24.       Result := True
25.     end else Result := False;
26.   end;
27.
28.

...thank you myself, I hope the reader (that's you) enjoyed!

#### PascalDragon

• Hero Member
• Posts: 2593
• Compiler Developer
##### Re: Function in Function and Result [SOLVED]
« Reply #1 on: October 30, 2020, 02:27:00 pm »
You don't need to declare an alias for Result, because there already exists an alias from original Pascal times: the function name.

Code: Pascal  [Select][+][-]
1. function Format(const sFormat: String; const Args: array of const): String;
2.
3.   function padding(const S, F: Char): Boolean;
4.   begin
5.     Format := 'test';
6.   end;
7.
8. begin
9.
10. end;

#### trn76

• New Member
• Posts: 39
##### Re: Function in Function and Result [SOLVED]
« Reply #2 on: October 30, 2020, 02:31:30 pm »
You don't need to declare an alias for Result, because there already exists an alias from original Pascal times: the function name.

...I need more coffe'

#### lucamar

• Hero Member
• Posts: 3429
##### Re: Function in Function and Result [SOLVED]
« Reply #3 on: October 30, 2020, 03:48:23 pm »
An alternative, for clarity's sake, is to pass the main Result as a var (or out) parameter to the nested function:

Code: Pascal  [Select][+][-]
1. function Format(const sFormat: string; const Args: array of const): string;
2.
3.   function padding(const S, F: Char; var MainResult: String): boolean;
4.   var u: integer;
5.   begin
6.       { ... }
7.       MainResult := MainResult + decim;    // K.I.S.S :)=
8.       { ... }
9.   end;
10.
11. begin
12.     { ... }
13.
16.
17.     { ... }
18. end;

That is (more or less) the "standard" way to return a value when there are two (or more) values to return, in your case a boolean and a string.
Turbo Pascal 3 CP/M - Amstrad PCW 8256 (512 KB !!!)
Lazarus/FPC 2.0.8/3.0.4 & 2.0.10/3.2.0 - 32/64 bits on:
(K|L|X)Ubuntu 12..18, Windows XP, 7, 10 and various DOSes.

#### Handoko

• Hero Member
• Posts: 4009
• My goal: build my own game engine using Lazarus
##### Re: Function in Function and Result [SOLVED]
« Reply #4 on: October 30, 2020, 04:16:55 pm »
I prefer lucamar's way to do it.

I personally will avoid to change the value of variables that are outside the current routine. Not long ago there was a discussion about avoiding to use global variables. I read and learned many things from the discussion. I'm not so skillful to not using global variables but I like the idea of minimize of using it. This one is different but the concept is similar.

#### trn76

• New Member
• Posts: 39
##### Re: Function in Function and Result [SOLVED]
« Reply #5 on: October 30, 2020, 04:46:41 pm »
An alternative, for clarity's sake, is to pass the main Result as a var (or out) parameter to the nested function:

That is (more or less) the "standard" way to return a value when there are two (or more) values to return, in your case a boolean and a string.

...Thank you too

#### bytebites

• Sr. Member
• Posts: 366
##### Re: Function in Function and Result [SOLVED]
« Reply #6 on: October 30, 2020, 06:40:57 pm »
Code: Pascal  [Select][+][-]
1.        (ord(sFormat[i+1]) in [ord('1')..ord('9')]) and
2.        (ord(sFormat[i+2]) in [ord('d'),ord('x'),ord('p')]) and
3.
If we follow kiss-principle then ord is unnecessary.

#### trn76

• New Member
• Posts: 39
##### Re: Function in Function and Result [SOLVED]
« Reply #7 on: October 30, 2020, 10:17:51 pm »
Code: Pascal  [Select][+][-]
1.        (ord(sFormat[i+1]) in [ord('1')..ord('9')]) and
2.        (ord(sFormat[i+2]) in [ord('d'),ord('x'),ord('p')]) and
3.
If we follow kiss-principle then ord is unnecessary.

Thank you, "Ord" have now been removed, as stated, the function was not working at all - just a copy.. But it will be something like this:

Code: Pascal  [Select][+][-]
1. // https://github.com/FChrisF/LLCL/blob/master/sources/SysUtils.pas#L563
2. function Format(const sFormat: string; const args: array of const): string;
3. // supported: %% %s %d %x %.prec? %index:?  TRN: added ^
4. var i, j, c, L: integer;
5.     decim: string;
6.
8.   var u: integer;
9.   begin
10.     u := args[c].VInteger;
11.     if sFormat[i+3] = 'd'
12.       then decim := IntToStr(u)
13.       else decim := IntToHex(u, Ord(sFormat[i+2])-49);
14.     for u := Length(decim) to Ord(sFormat[i+2])-49 do
15.       decim := sFormat[i+1] + decim;
16.     Inc(c);
17.     Inc(i, 3);
18.     Format += decim;
19.   end;
20.
22.   begin
23.     Result := (i+2 <= L) and (c <= High(args)) and
24.        ((sFormat[i+2]) in [('1')..('9')]) and
25.        ((sFormat[i+3]) in [('d'), ('x'), ('p')]) and
26.        (args[c].VType = vtInteger);;
27.   end;
28.
29. begin
30.   if (High(args) < 0) then Result := sFormat
31.   else begin
32.     Result := '';
33.     L := Length(sFormat);
34.     if (L > 0) then begin
35.       i := 1;
36.       c := 0;
37.       while (i <= L) do begin
38.         j := i;
39.         while (i <= L) and (sFormat[i] <> '%') do Inc(i);
40.         case i-j of
41.           0: ;
42.           1: Result += sFormat[j];
43.           else Result += Copy(sFormat, j, i-j);
44.         end;
45.         Inc(i);
46.         if (i > L) then Break;
47.         if ((sFormat[i]) in [('0')..('9')]) and (i < L) and (sFormat[i+1] = ':') then begin
48.           c := Ord(sFormat[i])-48;  // Format('%d %d %d %0:d %d',[1,2,3,4]) = '1 2 3 1 2'
49.           Inc(i, 2);
50.           if (i > L) then Break;
51.         end;
52.         if sFormat[i] = '%'                       // Format('%%') = '%'
53.           then Result += '%' else                 // Format('%.3d',[4]) = '004':
54.         if (sFormat[i] = '^') and isPadding{%H-}  // TRN custom padding ^ + Char
56.         if (c <= High(args)) then begin
57.           with args[c] do
58.           case sFormat[i] of
59.           's': case VType of
60.             vtString:     Result += string(VString^);
61.             vtAnsiString: Result += string(VAnsiString);
62.             vtPChar:      Result += string(VPChar);
63.             vtChar:       Result += string(VChar);
64.             //vtPWideChar:  Result += string(VPWideChar);
65.             //vtWideChar:   Result += string(VWideChar);
66.             {\$IFDEF UNICODE}
67.             vtUnicodeString: Result += string(VUnicodeString);
68.             {\$ENDIF}
69.           end;
70.     {      'g','f','n','m': case VType of
71.           vtExtended: begin
72.              str(VExtended^, decim);
73.              Result += decim;
74.            end;
75.            vtCurrency: begin
76.              str(VCurrency^, decim);
77.              Result += decim;
78.            end;
79.            end;  // add 3kb to the .exe -> use str() and %s parameter }
80.           'd': if VType = vtInteger then
81.                  Result += IntToStr(VInteger) else
82.                if VType = vtInt64 then
83.                  Result += IntToStr(VInt64^);
84.           'x','p': if VType in [vtInteger, vtPointer] then
85.             Result += IntToHex(VInteger, 8);
86.           end;
87.           Inc(c);
88.         end;
89.         Inc(i);
90.       end;
91.     end;
92.   end;
93. end;
94.
95. ..
96.
97. const
98.
99.   month_str : array [0..15] of string = (
100.     'jan', 'feb', 'mar', 'apr', 'may', 'jun', 'jul', 'aug',
101.     'sep', 'oct', 'nov', 'dec', '?13', '?14', '?15', '?16'
102.   );
103.
104. ..
105.
106. procedure pac_text_format(var pac: TPack; show_merged: boolean = True);
107. type  Tattrib_table = record
108.         m : Byte;
109.         c : Char;
110.       end;
111. const attr: array [0..7] of Tattrib_table = (
112.         (m: \$20; c: 'h'),
113.         (m: \$40; c: 's'),
114.         (m: \$80; c: 'p'),
115.         (m: \$10; c: 'a'),
116.         (m: \$01; c: 'r'),
117.         (m: \$02; c: 'w'),
118.         (m: \$08; c: 'e'),
119.         (m: \$04; c: 'd'));
120. var s: string;
121.     u: cuint;
122. begin
123.
124.   s := Format('%^ 8d ', [pac.unpack_size]);
125.   if ((cuint8(pac.head_archive[12]) and 1) <> 0)
126.     then s += '     n/a '
127.     else s += Format('%^ 8d ', [pac.pack_size]);
128.
129.   // get time
130.   s += Format('%^02d:%^02d:%^02d ', [pac.hour, pac.minute, pac.second]);
131.
132.   // get date
133.   s += Format('%^ 2d-%s-%^04d ', [pac.day, month_str[pac.month], pac.year]);
134.
135.   // get attributes *
136.   for u := 0 to 7 do
137.     if (pac.attributes and attr[u].m) <> 0 then s += attr[u].c  else s += '-';
138.
139.   // get filename *
140.   s += ' ' + PChar(@pac.head_filename);
141.
142.   // print output *
143.   pac_text(pac, s);
144.
145.   // print merged *
146.   if show_merged and ((pac.head_archive[12] and 1) <> 0) and (pac.pack_size <> 0) then begin
147.     pac_text( pac, Format('%^ 8d %^ 8d', [pac.merge_size, pac.pack_size]) + ' ........ ........... ........ Merged sum');
148.   end;
149.
150. end;
151.
152.

and here is the output:

Code: INI  [Select][+][-]
1. Unpacked   Packed Time     Date        Attrib   Name
2. -------- -------- -------- ----------- -------- ----------------
3.   901120   770922 18:33:21 19-nov-2011 ----rwed adf_game_aga/SimCity 2000 v1.1d (1994-10-27)(Maxis)(AGA)(Disk 3 of 3).adf
4.   901120   735552 18:33:23 19-nov-2011 ----rwed adf_game_aga/SimCity 2000 v1.1d (1994-10-27)(Maxis)(AGA)(Disk 2 of 3).adf
5.   901120   831000 18:33:24 19-nov-2011 ----rwed adf_game_aga/SimCity 2000 v1.1d (1994-10-27)(Maxis)(AGA)(Disk 1 of 3).adf
9.   901120   455026 22:00:17 10-mar-2011 ----rwed adf_game_ecs/Standard Deviation (1994)(Enertia)(Disk 3 of 3).adf
10.   901120   477114 22:00:11 10-mar-2011 ----rwed adf_game_ecs/Standard Deviation (1994)(Enertia)(Disk 2 of 3).adf
11.   901120   454854 22:00:04 10-mar-2011 ----rwed adf_game_ecs/Standard Deviation (1994)(Enertia)(Disk 1 of 3).adf
16.   215368   215368 16:47:39 25-sep-2013 ----rwed adf_game_ecs/Solomons Key.dms
19.   165044   165044 22:23:10  1-nov-2012 ----rwed adf_game_ecs/Metro-Cross.dms
36.    52716      n/a 14:36:08  5-oct-2032 ----rwed C/zoo
37.    42244      n/a 05:35:35 30-nov-1999 ----rwed C/ZipSplit
38.    40120      n/a 05:35:16 30-nov-1999 ----rwed C/ZipNote
39.    81216      n/a 05:33:54 30-nov-1999 ----rwed C/Zip
40.     3092      n/a 16:58:09 13-apr-2032 ----rwed C/xUP
41.     2124      n/a 16:58:09 13-apr-2032 ----rwed C/xType
42.     1384      n/a 16:58:09 13-apr-2032 ----rwed C/xScan
43.     2572      n/a 16:58:09 13-apr-2032 ----rwed C/xQuery
44.     3208      n/a 16:58:09 13-apr-2032 ----rwed C/XpkMasterPrefs
45.     3428      n/a 16:58:09 13-apr-2032 ----rwed C/xPack
46.     2232      n/a 16:58:09 13-apr-2032 ----rwed C/xLoadSeg
47.     6184      n/a 03:03:16 15-mar-2030 ----rwed C/xicon
48.     1420      n/a 18:26:06 13-oct-2031 ----rwed C/xfdUnlink
49.     1516      n/a 18:26:06 13-oct-2031 ----rwed C/xfdScan
50.     1652      n/a 18:26:06 13-oct-2031 ----rwed C/xfdPatch
51.     1568      n/a 18:26:06 13-oct-2031 ----rwed C/xfdList
52.     1204      n/a 18:26:06 13-oct-2031 ----rwed C/xfdLibInfo
53.     7568      n/a 11:01:06 18-oct-2014 ----rwed C/XFDguide
54.     4748      n/a 18:26:06 13-oct-2031 ----rwed C/xfdDecrunchAddr
55.     1516      n/a 16:51:36 30-nov-2031 ----rwed C/xadList
56.       60      n/a 11:23:22 17-dec-1992 ----rwed C/TestRMB
57.       60      n/a 07:32:12 17-dec-1992 ----rwed C/TestLMB
58.   261832   109562 ........ ........... ........ Merged sum
59.     2263      n/a 11:01:06 18-oct-2014 ----rwed C/XFDguide.info
60.     1227      n/a 16:18:55  1-sep-2007 ----rw-d C/WBSMgr.info
61.     1268      n/a 16:02:15 10-oct-2009 ----rw-d C/TinyMeter_enable.info
62.     1268      n/a 16:02:15 10-oct-2009 ----rw-d C/TinyMeter_disable.info
63.     1749      n/a 16:02:15 10-oct-2009 ----rw-d C/TextView.info
64.     1268      n/a 16:02:15 10-oct-2009 ----rw-d C/TagLiFE_enable.info
65.     1268      n/a 16:02:15 10-oct-2009 ----rw-d C/TagLiFE_disable.info
66.     1268      n/a 16:02:15 10-oct-2009 ----rw-d C/StickyRMB_toggle.info
67.     1268      n/a 16:02:15 10-oct-2009 ----rw-d C/StickyRMB_enable.info
68.     1268      n/a 16:02:15 10-oct-2009 ----rw-d C/StickyRMB_disable.info
69.     1270      n/a 16:02:15 10-oct-2009 ----rw-d C/StackAttack_enable.info
70.     1270      n/a 16:02:15 10-oct-2009 ----rw-d C/StackAttack_disable.info
71. ...
72.

...and so on, not complete but now I have a nice output (for now) and can complete the decruncher, using the output as debug too (formating is faster than FPC Format and I don't have any  "uses" units in my decruncher)

#### PascalDragon

• Hero Member
• Posts: 2593
• Compiler Developer
##### Re: Function in Function and Result [SOLVED]
« Reply #8 on: October 31, 2020, 11:03:01 am »
I prefer lucamar's way to do it.

The ability to access the parent frame is one of the strong points of nested functions in Pascal. C++ for example only gained such with the introduction of lambdas.

It can also be more efficient: If you call a nested function and pass four parameters that exactly represent local variables then the compiler does indeed need to handle those four parameters (this involves moving to and from the stack, maybe spilling registers to make room for the parameters) while if you access these same variables simply from inside the function the compiler only needs to pass a single parameter: the parent frame. Though you do have a slightly less efficient access to these variables then, cause they need to be loaded indirectly through the parent frame pointer.

#### 440bx

• Hero Member
• Posts: 2094
##### Re: Function in Function and Result [SOLVED]
« Reply #9 on: October 31, 2020, 11:34:27 am »
Though you do have a slightly less efficient access to these variables then, cause they need to be loaded indirectly through the parent frame pointer.
It should also be noted that there is one additional level of indirection for every nesting level involved in accessing a variable.  In some cases that can result in a noticeable loss of performance.
FPC v3.0.4 and Lazarus 1.8.2 on Windows 7 64bit.