/[dtapublic]/projs/dtats/tags/0000.00/shared_source/c_tclxtens_7_5/pr_randa.c
ViewVC logotype

Contents of /projs/dtats/tags/0000.00/shared_source/c_tclxtens_7_5/pr_randa.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 102 - (show annotations) (download)
Sun Dec 18 05:07:36 2016 UTC (7 years, 11 months ago) by dashley
File MIME type: text/plain
File size: 4839 byte(s)
Initial tag of DTATS.
1 //$Header$
2 //-------------------------------------------------------------------------------------------------
3 //This file is part of "David T. Ashley's Shared Source Code", a set of shared components
4 //integrated into many of David T. Ashley's projects.
5 //-------------------------------------------------------------------------------------------------
6 //This source code and any program in which it is compiled/used is provided under the MIT License,
7 //reproduced below.
8 //-------------------------------------------------------------------------------------------------
9 //Permission is hereby granted, free of charge, to any person obtaining a copy of
10 //this software and associated documentation files(the "Software"), to deal in the
11 //Software without restriction, including without limitation the rights to use,
12 //copy, modify, merge, publish, distribute, sublicense, and / or sell copies of the
13 //Software, and to permit persons to whom the Software is furnished to do so,
14 //subject to the following conditions :
15 //
16 //The above copyright notice and this permission notice shall be included in all
17 //copies or substantial portions of the Software.
18 //
19 //THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
20 //IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
21 //FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.IN NO EVENT SHALL THE
22 //AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
23 //LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
24 //OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
25 //SOFTWARE.
26 //-------------------------------------------------------------------------------------------------
27 #define MODULE_PR_RANDA
28
29 #include "tcl.h"
30 #include "tcldecls.h"
31
32 #include "pr_randa.h"
33
34
35 /* Random seed used in this module.
36 */
37 static unsigned long seed = 1578127215;
38
39
40 /* Returns the random successor of the argument.
41 ** Uses the power residue method discussed
42 ** in a probability book. Is public so that other
43 ** modules may use it.
44 */
45 DECMOD_PR_RANDA unsigned long PrRandARandSucc(unsigned long arg)
46 {
47 __int64 k16807;
48 __int64 input_arg;
49 __int64 mul_result;
50 __int64 return_value;
51 __int64 M;
52
53 k16807 = 16807;
54 M = 2147483647;
55 input_arg = arg;
56 mul_result = k16807 * input_arg;
57 return_value = mul_result % M;
58 return((unsigned long)return_value);
59 }
60
61
62 /* The command which requires the previous value to go on to
63 ** the next.
64 */
65 int PrRandA_rngPwrResRndA_cmd(ClientData dummy,
66 Tcl_Interp *interp,
67 int objc,
68 Tcl_Obj *objv[])
69 {
70 int i;
71 //Passed integer if one present.
72 Tcl_Obj *rv;
73 //Object to return.
74 char *problem_arg;
75 //String value of problem argument if we need to announce
76 //it to caller.
77
78 //We need to break this into three cases. Either
79 //there is one arg, which means use internal seed.
80 //Or, there are two args, which means the predecessor
81 //is supplied. Or, there are more args, which means
82 //error.
83 if (objc == 1)
84 {
85 //Use internal seed.
86 rv = Tcl_NewIntObj(seed);
87 seed = PrRandARandSucc(seed);
88 Tcl_SetObjResult(interp, rv);
89 return(TCL_OK);
90 }
91 else if (objc == 2)
92 {
93 //Form successor of number passed.
94 if (Tcl_GetIntFromObj(interp, objv[1], &i) != TCL_OK)
95 {
96 //We could not retrieve an integer from the passed argument.
97 //We can't form the successor of a non-integer.
98 //Error out.
99
100 //Create the return object.
101 rv = Tcl_NewStringObj("rngPwrResRndA: can't parse this argument as an integer: ", -1);
102
103 //Tack on the offensive argument.
104 problem_arg = Tcl_GetString(objv[1]);
105 Tcl_AppendToObj(rv, problem_arg, -1);
106
107 //Set the return value to be the error message.
108 Tcl_SetObjResult(interp, rv);
109
110 //Error return.
111 return(TCL_ERROR);
112 }
113
114 rv = Tcl_NewIntObj(PrRandARandSucc(i));
115 Tcl_SetObjResult(interp, rv);
116 return(TCL_OK);
117 }
118 else //Wrong number of args.
119 {
120 Tcl_WrongNumArgs(interp,
121 1,
122 objv,
123 "?N?");
124 return(TCL_ERROR);
125 }
126 }
127
128
129 //Performs initial registration to the hash table.
130 //
131 DECMOD_PR_RANDA void PrRandAInit(Tcl_Interp *interp)
132 {
133 Tcl_CreateObjCommand(interp,
134 "rngPwrResRndA",
135 (Tcl_ObjCmdProc *)PrRandA_rngPwrResRndA_cmd,
136 NULL,
137 NULL);
138 }
139
140
141 DECMOD_PR_RANDA const char *PrRandACversion(void)
142 {
143 return ("$Header$");
144 }
145
146
147 DECMOD_PR_RANDA const char *PrRandAHversion(void)
148 {
149 return (PR_RANDA_H_VERSION);
150 }
151
152 /* End of pr_randa.c */

Properties

Name Value
svn:eol-style native
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25