/[dtapublic]/projs/trunk/shared_source/c_tclxtens_7_5/pr_randa.c
ViewVC logotype

Annotation of /projs/trunk/shared_source/c_tclxtens_7_5/pr_randa.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 68 - (hide annotations) (download)
Mon Oct 31 16:18:20 2016 UTC (8 years, 1 month ago) by dashley
File MIME type: text/plain
File size: 4991 byte(s)
Licensing change.  Header and footer cleanup.  Addition of keyword expansion.
1 dashley 68 //$Header$
2 dashley 25 //-------------------------------------------------------------------------------------------------
3 dashley 68 //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 dashley 25 //-------------------------------------------------------------------------------------------------
6 dashley 68 //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 dashley 25 //
16 dashley 68 //The above copyright notice and this permission notice shall be included in all
17     //copies or substantial portions of the Software.
18 dashley 25 //
19 dashley 68 //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 dashley 25 //-------------------------------------------------------------------------------------------------
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 dashley 68 return ("$Header$");
144 dashley 25 }
145    
146    
147     DECMOD_PR_RANDA const char *PrRandAHversion(void)
148     {
149     return (PR_RANDA_H_VERSION);
150     }
151    
152 dashley 68 /* End of pr_randa.c */

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25