-
Notifications
You must be signed in to change notification settings - Fork 7
/
Copy pathparallelfox.vca
2267 lines (1925 loc) · 79 KB
/
parallelfox.vca
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
SCCTEXT Version 4.0.0.2
PLATFORM C(8,0),UNIQUEID C(10,0),TIMESTAMP N(10,0),CLASS M(4,0),CLASSLOC M(4,0),BASECLASS M(4,0),OBJNAME M(4,0),PARENT M(4,0),PROPERTIES M(4,0),PROTECTED M(4,0),METHODS M(4,0),OBJCODE M(4,0),OLE M(4,0),OLE2 M(4,0),RESERVED1 M(4,0),RESERVED2 M(4,0),RESERVED3 M(4,0),RESERVED4 M(4,0),RESERVED5 M(4,0),RESERVED6 M(4,0),RESERVED7 M(4,0),RESERVED8 M(4,0),USER M(4,0)
1252
[ RECORD]
[PLATFORM] COMMENT
[UNIQUEID] Class
[START RESERVED1]
VERSION = 3.00[END RESERVED1]
[ RECORD]
[PLATFORM] WINDOWS
[UNIQUEID] _2XP193DS4
[CLASS] custom
[BASECLASS] custom
[OBJNAME] amanager
[START PROPERTIES]
Name = "amanager"
_memberdata = 403<VFPData><memberdata name="createparameterobject" display="CreateParameterObject"/><memberdata name="createparameterclause" display="CreateParameterClause"/><memberdata name="aarraycopy" display="aArrayCopy"/><memberdata name="copyarray" display="CopyArray"/><memberdata name="detecthyperthreading" display="DetectHyperThreading"/><memberdata name="lhyperthreading" display="lHyperThreading"/></VFPData>
lhyperthreading = .NULL.
[END PROPERTIES]
[START METHODS]
PROCEDURE copyarray
* Copy array to worker.
* ACOPY doesn't work when run from worker on array that is COM object property.
* Must pass array as parameter to worker.
Lparameters laArray
Debugout Time(0), Program()
Acopy(laArray, This.aArrayCopy)
ENDPROC
PROCEDURE createparameterclause
* Convert parameter object into variables
* Pass in parameter variables by reference ("out" variables)
Lparameters loParameters, tPar1, tPar2, tPar3, tPar4, tPar5, tPar6, ;
tPar7, tPar8, tPar9, tPar10, tPar11, tPar12, tPar13, ;
tPar14, tPar15, tPar16, tPar17, tPar18, tPar19, tPar20, ;
tPar21, tPar22, tPar23, tPar24, tPar25
Local lnPCount, lnParameter, lcParameter, lcParameterClause
Debugout Time(0), Program()
* Convert array to parameters and parameter clause
lcParameterClause = ""
lnPCount = loParameters.nPCount
For lnParameter = 1 to lnPCount
lcParameter = "tPar" + Transform(lnParameter)
* Build parameter clause
If !Empty(lcParameterClause)
lcParameterClause = lcParameterClause + ", "
EndIf
If loParameters.IsArray(lcParameter)
* Arrays have to be copied from object property and passed by reference
loParameters.CopyArray(lcParameter, This)
Dimension &lcParameter.[1]
Acopy(This.aArrayCopy, &lcParameter)
lcParameterClause = lcParameterClause + "@" + lcParameter
Else
&lcParameter = loParameters.&lcParameter
lcParameterClause = lcParameterClause + lcParameter
EndIf
EndFor
Return lcParameterClause
ENDPROC
PROCEDURE createparameterobject
* Convert parameters into parameter object
* Pass in all parameters by reference in case any are arrays.
Lparameters lnPCount, tPar1, tPar2, tPar3, tPar4, tPar5, tPar6, ;
tPar7, tPar8, tPar9, tPar10, tPar11, tPar12, tPar13, ;
tPar14, tPar15, tPar16, tPar17, tPar18, tPar19, tPar20, ;
tPar21, tPar22, tPar23, tPar24, tPar25
Local lnParameter, lcParameter, loParameters as Parameters of ParallelFox.vcx, lvValue
Debugout Time(0), Program()
loParameters = NewObject("Parameters","ParallelFox.vcx")
loParameters.nPCount = lnPCount
* AddProperty(loParameters, "nPCount", lnPCount)
* Create array of serialized parameters
For lnParameter = 1 to lnPCount
lcParameter = "tPar" + Transform(lnParameter)
If Type(lcParameter, 1) = "A"
* Arrays have to be copied to object property
AddProperty(loParameters, lcParameter + "[1]")
Acopy(&lcParameter, loParameters.&lcParameter)
Else
AddProperty(loParameters, lcParameter)
loParameters.&lcParameter = Evaluate(lcParameter)
EndIf
EndFor
Return loParameters
ENDPROC
PROCEDURE detecthyperthreading
* Use WMI to determine if HyperThreading is turned on
* This only works on Windows XP SP3, Windows Server 2003, and later because
* underlying Windows APIs were not added until those versions.
Local lcWMIFolder, loWMI, lcolProcessors, loProcessor
This.lHyperThreading = .F.
lcWMIFolder = Addbs(GetEnv("SystemRoot")) + "System32\WBEM\"
If Directory(lcWMIFolder) && make sure installed
loWMI = GetObject("winmgmts:\\.\root\cimv2")
lcolProcessors = loWMI.ExecQuery("Select * from Win32_Processor")
For each loProcessor in lcolProcessors FoxObject
If Type("loProcessor.NumberOfCores")<> "U" and Type("loProcessor.NumberOfLogicalProcessors")<> "U"
* If logical processors > actual cores, HT must be turned on
If loProcessor.NumberOfLogicalProcessors > loProcessor.NumberOfCores
This.lHyperThreading = .T.
EndIf
EndIf
EndFor
EndIf
ENDPROC
[END METHODS]
[START RESERVED1]
Class[END RESERVED1]
[START RESERVED2]
1[END RESERVED2]
[START RESERVED3]
*copyarray Copy array.
*createparameterclause Create parameter clause from parameter object.
*createparameterobject
*detecthyperthreading Detect if HyperThreading is turned on.
^aarraycopy[1,0]
_memberdata XML Metadata for customizable properties
lhyperthreading Is .T. when HyperThreading is turned on.
[END RESERVED3]
[START RESERVED6]
Pixels[END RESERVED6]
[ RECORD]
[PLATFORM] COMMENT
[UNIQUEID] RESERVED
[OBJNAME] amanager
[ RECORD]
[PLATFORM] WINDOWS
[UNIQUEID] _2YT0NV2N3
[CLASS] custom
[BASECLASS] custom
[OBJNAME] command
[START PROPERTIES]
Name = "command"
_memberdata = 419<VFPData><memberdata name="ccommandtype" display="cCommandType"/><memberdata name="ccommand" display="cCommand"/><memberdata name="cclass" display="cClass"/><memberdata name="cmodule" display="cModule"/><memberdata name="oparameters" display="oParameters"/><memberdata name="nworker" display="nWorker"/><memberdata name="oevents" display="oEvents"/><memberdata name="cinapplication" display="cInApplication"/></VFPData>
cclass =
ccommand =
ccommandtype =
cinapplication =
cmodule =
nworker = 0
oevents = .NULL.
oparameters = .NULL.
[END PROPERTIES]
[START RESERVED1]
Class[END RESERVED1]
[START RESERVED2]
1[END RESERVED2]
[START RESERVED3]
_memberdata XML Metadata for customizable properties
cclass Class containing command (if applicable).
ccommand Command.
ccommandtype Command type.
cinapplication Application containing class library.
cmodule Module/Class Library containing command (if applicable).
nworker Specifies which worker to run on. 0 means next available. Used to run a command on all workers.
oevents Events object.
oparameters Parameter object.
[END RESERVED3]
[START RESERVED6]
Pixels[END RESERVED6]
[ RECORD]
[PLATFORM] COMMENT
[UNIQUEID] RESERVED
[OBJNAME] command
[ RECORD]
[PLATFORM] WINDOWS
[UNIQUEID] _3CV0I1GR4
[CLASS] custom
[BASECLASS] custom
[OBJNAME] errorhandler
[START PROPERTIES]
Name = "errorhandler"
_memberdata = <VFPData><memberdata name="handleerror" display="HandleError"/></VFPData>
[END PROPERTIES]
[START METHODS]
PROCEDURE Init
* Default error handler
* Unhandled errors may cause workers to crash when not in debug mode
On Error _Screen.oErrorHandler.HandleError(Error(), Sys(16), Lineno(), Message(), Message(1))
ENDPROC
PROCEDURE handleerror
* Handle worker error and return to main process
Lparameters lnError, lcMethod, lnLine, lcMessage, lcCode
Local array laCallStack[1,6]
Local lnRow, lnErrorRow, lcCallStack
Local Worker as Worker
Worker = NewObject("Worker", "ParallelFox.vcx")
* Add call stack to lcCode
AStackInfo(laCallStack)
lnErrorRow = Max(Alen(laCallStack, 1) - 1, 1)
For lnRow = lnErrorRow to 1 step -1
* aStackInfo does a better job of capturing code
If lnRow = lnErrorRow
lcCode = Alltrim(Alltrim(laCallStack[lnRow,6],0,Chr(9))) + Chr(13)
lcCode = lcCode + "====== Call Stack ======" + Chr(13)
EndIf
lcCallStack = Transform(laCallStack[lnRow,1]) + " " && Call Stack Level
* lcCallStack = lcCallStack + laCallStack[lnRow,2] + " " && Current program filename
lcCallStack = lcCallStack + laCallStack[lnRow,3] + " " && Module or Object name
lcCallStack = lcCallStack + JustFname(laCallStack[lnRow,4]) + " " && Module or Object Source filename
lcCallStack = lcCallStack + "Line " + Transform(laCallStack[lnRow,5]) + " " && Line number in the object source file
* lcCallStack = lcCallStack + laCallStack[lnRow,6] + " " && Source line contents
lcCode = lcCode + lcCallStack + Chr(13)
EndFor
Worker.ReturnError(lnError, lcMethod, lnLine, lcMessage, lcCode)
* Exit current code containing error and return to command processor
Return to ProcessCommand
ENDPROC
[END METHODS]
[START RESERVED1]
Class[END RESERVED1]
[START RESERVED2]
1[END RESERVED2]
[START RESERVED3]
*handleerror Handle worker error.
_memberdata XML Metadata for customizable properties
[END RESERVED3]
[START RESERVED6]
Pixels[END RESERVED6]
[ RECORD]
[PLATFORM] COMMENT
[UNIQUEID] RESERVED
[OBJNAME] errorhandler
[ RECORD]
[PLATFORM] WINDOWS
[UNIQUEID] _2YX0JA1AX
[CLASS] custom
[BASECLASS] custom
[OBJNAME] events
[START PROPERTIES]
Name = "events"
_memberdata = 581<VFPData><memberdata name="ncommands" display="nCommands"/><memberdata name="complete" display="Complete"/><memberdata name="updateprogress" display="UpdateProgress"/><memberdata name="returndata" display="ReturnData"/><memberdata name="returnerror" display="ReturnError"/><memberdata name="updatecommandcount" display="UpdateCommandCount"/><memberdata name="loadcursor" display="LoadCursor"/><memberdata name="returncursor" display="ReturnCursor"/><memberdata name="setdatasession" display="SetDataSession"/><memberdata name="getdatasession" display="GetDataSession"/></VFPData>
ncommands = 0
[END PROPERTIES]
[START METHODS]
PROCEDURE complete
Lparameters lvReturn
Debugout Time(0), Program(), lvReturn
This.nCommands = This.nCommands - 1
ENDPROC
PROCEDURE getdatasession
* Return data session ID of events object.
Return Set("Datasession")
ENDPROC
PROCEDURE loadcursor
* Load cursor from temp table.
Lparameters lcAlias, lcTempFile
Local lnCurrentArea, lcDBC
Debugout Time(0), Program(), lcAlias, lcTempFile
lnCurrentArea = Select()
lcDBC = Dbc()
Select * from (lcTempFile) ;
into cursor (lcAlias) NoFilter ReadWrite
* Close/erase temp files
Set Database To (lcTempFile)
Close Databases
Erase (lcTempFile + ".*")
Set Database To (lcDBC)
Select (lnCurrentArea)
* Fire event
This.ReturnCursor(lcAlias)
ENDPROC
PROCEDURE returncursor
* Fires when Worker.ReturnCursor() is called on worker and after cursor has been loaded.
Lparameters lcAlias
Debugout Time(0), Program(), lcAlias
ENDPROC
PROCEDURE returndata
* Fires when Worker.ReturnData() is called on worker.
Lparameters tPar1, tPar2, tPar3, tPar4, tPar5, tPar6, ;
tPar7, tPar8, tPar9, tPar10, tPar11, tPar12, tPar13, ;
tPar14, tPar15, tPar16, tPar17, tPar18, tPar19, tPar20, ;
tPar21, tPar22, tPar23, tPar24, tPar25, tPar26
Debugout Time(0), Program(), tPar1, tPar2, tPar3, tPar4, tPar5, tPar6, ;
tPar7, tPar8, tPar9, tPar10, tPar11, tPar12, tPar13, ;
tPar14, tPar15, tPar16, tPar17, tPar18, tPar19, tPar20, ;
tPar21, tPar22, tPar23, tPar24, tPar25, tPar26
ENDPROC
PROCEDURE returnerror
* Return error to main process
LPARAMETERS lnError, lcMethod, lnLine, lcMessage, lcCode
Debugout Time(0), Program(), lnError, lcMethod, lnLine, lcMessage, lcCode
This.nCommands = This.nCommands - 1
ENDPROC
PROCEDURE setdatasession
* Set data session so events occur in same session as Parallel object.
* BindEvent does not cause data session switch, so this object needs to be in same datasession
Lparameters lnDataSession
Try
Set Datasession To (lnDataSession)
Catch
* If data session not available, stay in current session
EndTry
ENDPROC
PROCEDURE updatecommandcount
* Update number of commands currently running.
Lparameters llAllWorkers, lnWorkerCount
Local lnCommands
If llAllWorkers
lnCommands = lnWorkerCount
Else
lnCommands = 1
EndIf
This.nCommands = This.nCommands + lnCommands
ENDPROC
PROCEDURE updateprogress
* Send progress update to main process
Lparameters lnProgress, lcMessage
Debugout Time(0), Program(), lnProgress, lcMessage
ENDPROC
[END METHODS]
[START RESERVED1]
Class[END RESERVED1]
[START RESERVED2]
1[END RESERVED2]
[START RESERVED3]
*complete Fires when worker has finished executing command.
*getdatasession Return data session ID of events object.
*loadcursor Load cursor from temp table.
*returncursor Fires when Worker.ReturnCursor() is called on worker and after cursor has been loaded.
*returndata Fires when Worker.ReturnData() is called on worker.
*returnerror Return error to main process.
*setdatasession Set data session so events occur in same session as Parallel object.
*updatecommandcount Update number of commands currently running.
*updateprogress Fires when Worker.UpdateProgress() is called on worker.
_memberdata XML Metadata for customizable properties
ncommands Number of commands currently queued or running.
[END RESERVED3]
[START RESERVED6]
Pixels[END RESERVED6]
[ RECORD]
[PLATFORM] COMMENT
[UNIQUEID] RESERVED
[OBJNAME] events
[ RECORD]
[PLATFORM] WINDOWS
[UNIQUEID] _3CV0J32BY
[CLASS] form
[BASECLASS] form
[OBJNAME] frmerrorlist
[START PROPERTIES]
AutoCenter = .T.
Caption = "ParallelFox Worker Errors"
DoCreate = .T.
Height = 480
Name = "frmerrorlist"
Width = 640
_memberdata = <VFPData><memberdata name="displayerror" display="DisplayError"/><memberdata name="cerrorlist" display="cErrorList"/></VFPData>
cerrorlist =
[END PROPERTIES]
[START METHODS]
PROCEDURE displayerror
* Display error in list.
Lparameters lnError, lcMethod, lnLine, lcMessage, lcCode
Local lcErrorMsg
Text to lcErrorMsg TextMerge NoShow
Error: <<lnError>>
Message: <<lcMessage>>
Method: <<lcMethod>>
Line: <<lnLine>>
Code: <<lcCode>>
<<Replicate("-",100)>>
EndText
ThisForm.cErrorList = ThisForm.cErrorList + lcErrorMsg
* ThisForm.edtErrorList.Value = ThisForm.edtErrorList.Value + lcErrorMsg
ThisForm.edtErrorList.Refresh()
ENDPROC
[END METHODS]
[START RESERVED1]
Class[END RESERVED1]
[START RESERVED2]
2[END RESERVED2]
[START RESERVED3]
*displayerror Display error in list.
_memberdata XML Metadata for customizable properties
cerrorlist List of errors.
[END RESERVED3]
[START RESERVED6]
Pixels[END RESERVED6]
[ RECORD]
[PLATFORM] WINDOWS
[UNIQUEID] _3CV0J60T9
[CLASS] editbox
[BASECLASS] editbox
[OBJNAME] edtErrorList
[PARENT] frmerrorlist
[START PROPERTIES]
Anchor = 15
ControlSource = "Thisform.cErrorList"
Height = 478
Left = 1
Name = "edtErrorList"
ReadOnly = .T.
Top = 1
Width = 638
[END PROPERTIES]
[ RECORD]
[PLATFORM] COMMENT
[UNIQUEID] RESERVED
[OBJNAME] frmerrorlist
[START PROPERTIES]
Arial, 0, 9, 5, 15, 12, 32, 3, 0
[END PROPERTIES]
[ RECORD]
[PLATFORM] WINDOWS
[UNIQUEID] _2Z619GLX6
[CLASS] custom
[BASECLASS] custom
[OBJNAME] mainprocess
[START PROPERTIES]
Name = "mainprocess"
_memberdata = <VFPData><memberdata name="omainvfp" display="oMainVFP"/><memberdata name="isrunning" display="IsRunning"/><memberdata name="starttimer" display="StartTimer"/><memberdata name="otimer" display="oTimer"/></VFPData>
omainvfp = .NULL.
otimer =
[END PROPERTIES]
[START METHODS]
PROCEDURE isrunning
* Check if main process is still running. If not, quit worker.
This.oTimer.Enabled = .f.
Debugout Time(0), Program()
* No need to test main process when in MTDLL
If _VFP.StartMode = 5
Return .t.
EndIf
Try
This.oMainVFP.Eval(1)
Catch
Quit
EndTry
This.oTimer.Enabled = .t.
Return .t.
ENDPROC
PROCEDURE starttimer
* Start timer to periodically check that main process is still running.
Local loTimer as Timer
Debugout Time(0), Program()
loTimer = CreateObject("Timer")
BindEvent(loTimer, "Timer", This, "IsRunning")
loTimer.Interval = 60000 && check every minute
This.oTimer = loTimer
ENDPROC
[END METHODS]
[START RESERVED1]
Class[END RESERVED1]
[START RESERVED2]
1[END RESERVED2]
[START RESERVED3]
*isrunning Check if main process is still running. If not, quit worker.
*starttimer Start timer to periodically check that main process is still running.
_memberdata XML Metadata for customizable properties
omainvfp Reference to _VFP object in main process.
otimer Timer to periodically check that main process is still running.
[END RESERVED3]
[START RESERVED6]
Pixels[END RESERVED6]
[ RECORD]
[PLATFORM] COMMENT
[UNIQUEID] RESERVED
[OBJNAME] mainprocess
[ RECORD]
[PLATFORM] WINDOWS
[UNIQUEID] _2XO1B7PVN
[CLASS] custom
[BASECLASS] custom
[OBJNAME] parallel
[START PROPERTIES]
Name = "parallel"
_events = NULL
_memberdata = 997<VFPData><memberdata name="do" display="Do"/><memberdata name="startworkers" display="StartWorkers"/><memberdata name="cpucount" display="CPUCount"/><memberdata name="setworkercount" display="SetWorkerCount"/><memberdata name="docmd" display="DoCmd"/><memberdata name="execscript" display="ExecScript"/><memberdata name="call" display="Call"/><memberdata name="bindevent" display="BindEvent"/><memberdata name="wait" display="Wait"/><memberdata name="_events" display="_Events"/><memberdata name="callmethod" display="CallMethod"/><memberdata name="stopworkers" display="StopWorkers"/><memberdata name="onerror" display="OnError"/><memberdata name="clearqueue" display="ClearQueue"/><memberdata name="setworkerclass" display="SetWorkerClass"/><memberdata name="detecthyperthreading" display="DetectHyperThreading"/><memberdata name="setmultithreaded" display="SetMultiThreaded"/><memberdata name="oparpoolmgr" display="oParPoolMgr"/><memberdata name="setinstance" display="SetInstance"/></VFPData>
cpucount = 0
oparpoolmgr = .NULL.
[END PROPERTIES]
[START PROTECTED]
oparpoolmgr
[END PROTECTED]
[START METHODS]
PROCEDURE Destroy
Debugout Time(0), Program()
UnBindEvents(This)
ENDPROC
PROCEDURE Init
* Instantiate default parallel pool manager
This.SetInstance()
This.CPUCount = This.oParPoolMgr.nCPUCount
This._Events = NewObject("Events", "ParallelFox.vcx")
This.BindEvent("ReturnError", This.oParPoolMgr, "HandleError")
ENDPROC
PROCEDURE bindevent
* Bind to worker events
Lparameters cEvent, oEventHandler, cDelegate, nFlags
Debugout Time(0), Program(), cEvent, cDelegate
cEvent = Alltrim(cEvent)
nFlags = Evl(nFlags, 0)
* Unbind global error handler if overriding
If Upper(cEvent) = "RETURNERROR"
UnBindEvents(This._Events, "ReturnError", This.oParPoolMgr, "HandleError")
EndIf
BindEvent(This._Events, cEvent, oEventHandler, cDelegate, nFlags)
ENDPROC
PROCEDURE call
* Execute program on worker
Lparameters cFunction, lAllWorkers, tPar1, tPar2, tPar3, tPar4, tPar5, tPar6, ;
tPar7, tPar8, tPar9, tPar10, tPar11, tPar12, tPar13, ;
tPar14, tPar15, tPar16, tPar17, tPar18, tPar19, tPar20, ;
tPar21, tPar22, tPar23, tPar24
Local loParameters
Debugout Time(0), Program(), cFunction, lAllWorkers, tPar1, tPar2, tPar3, tPar4, tPar5, tPar6, ;
tPar7, tPar8, tPar9, tPar10, tPar11, tPar12, tPar13, ;
tPar14, tPar15, tPar16, tPar17, tPar18, tPar19, tPar20, ;
tPar21, tPar22, tPar23, tPar24
This._Events.UpdateCommandCount(lAllWorkers, This.oParPoolMgr.nWorkerCount)
loParameters = This.oParPoolMgr.CreateParameterObject(Pcount()-2, @tPar1, @tPar2, @tPar3, @tPar4, ;
@tPar5, @tPar6, @tPar7, @tPar8, @tPar9, @tPar10, @tPar11, ;
@tPar12, @tPar13, @tPar14, @tPar15, @tPar16, @tPar17, @tPar18, ;
@tPar19, @tPar20, @tPar21, @tPar22, @tPar23, @tPar24)
This.oParPoolMgr.QueueCommand("Call", cFunction,,,,loParameters, lAllWorkers, This._Events)
ENDPROC
PROCEDURE callmethod
* Execute/call class method on worker.
Lparameters cMethod, cClassName, cModule, cInApplication, lAllWorkers, ;
tPar1, tPar2, tPar3, tPar4, tPar5, tPar6, ;
tPar7, tPar8, tPar9, tPar10, tPar11, tPar12, tPar13, ;
tPar14, tPar15, tPar16, tPar17, tPar18, tPar19, tPar20, ;
tPar21
Local loParameters
Debugout Time(0), Program(), cMethod, cClassName, cModule, cInApplication, lAllWorkers, ;
tPar1, tPar2, tPar3, tPar4, tPar5, tPar6, ;
tPar7, tPar8, tPar9, tPar10, tPar11, tPar12, tPar13, ;
tPar14, tPar15, tPar16, tPar17, tPar18, tPar19, tPar20, ;
tPar21
This._Events.UpdateCommandCount(lAllWorkers, This.oParPoolMgr.nWorkerCount)
loParameters = This.oParPoolMgr.CreateParameterObject(Pcount()-5, @tPar1, @tPar2, @tPar3, @tPar4, ;
@tPar5, @tPar6, @tPar7, @tPar8, @tPar9, @tPar10, @tPar11, ;
@tPar12, @tPar13, @tPar14, @tPar15, @tPar16, @tPar17, @tPar18, ;
@tPar19, @tPar20, @tPar21)
This.oParPoolMgr.QueueCommand("CallMethod", cMethod, cClassName, cModule, cInApplication, ;
loParameters, lAllWorkers, This._Events)
ENDPROC
PROCEDURE clearqueue
* Remove all pending commands from queue.
Debugout Time(0), Program()
This.oParPoolMgr.ClearQueue()
ENDPROC
PROCEDURE detecthyperthreading
* Returns .T. when HyperThreading is Enabled.
* Default value is NULL. Detection is a little slow, so only run once.
If IsNull(This.oParPoolMgr.lHyperThreading)
This.oParPoolMgr.DetectHyperThreading()
EndIf
Return This.oParPoolMgr.lHyperThreading
ENDPROC
PROCEDURE do
* Execute program on worker
Lparameters cPRG, cInProgram, lAllWorkers, tPar1, tPar2, tPar3, tPar4, tPar5, tPar6, ;
tPar7, tPar8, tPar9, tPar10, tPar11, tPar12, tPar13, ;
tPar14, tPar15, tPar16, tPar17, tPar18, tPar19, tPar20, ;
tPar21, tPar22, tPar23
Local loParameters
Debugout Time(0), Program(), cPRG, cInProgram, lAllWorkers, tPar1, tPar2, tPar3, tPar4, tPar5, tPar6, ;
tPar7, tPar8, tPar9, tPar10, tPar11, tPar12, tPar13, ;
tPar14, tPar15, tPar16, tPar17, tPar18, tPar19, tPar20, ;
tPar21, tPar22, tPar23
This._Events.UpdateCommandCount(lAllWorkers, This.oParPoolMgr.nWorkerCount)
loParameters = This.oParPoolMgr.CreateParameterObject(Pcount()-3, @tPar1, @tPar2, @tPar3, @tPar4, ;
@tPar5, @tPar6, @tPar7, @tPar8, @tPar9, @tPar10, @tPar11, ;
@tPar12, @tPar13, @tPar14, @tPar15, @tPar16, @tPar17, @tPar18, ;
@tPar19, @tPar20, @tPar21, @tPar22, @tPar23)
This.oParPoolMgr.QueueCommand("Do", cPRG, cInProgram,,,loParameters, lAllWorkers, This._Events)
ENDPROC
PROCEDURE docmd
Lparameters cCommand, lAllWorkers
Debugout Time(0), Program(), cCommand, lAllWorkers
This._Events.UpdateCommandCount(lAllWorkers, This.oParPoolMgr.nWorkerCount)
This.oParPoolMgr.QueueCommand("DoCmd", cCommand,,,,, lAllWorkers, This._Events)
ENDPROC
PROCEDURE execscript
* Execute script on worker
Lparameters cScript, lAllWorkers, tPar1, tPar2, tPar3, tPar4, tPar5, tPar6, ;
tPar7, tPar8, tPar9, tPar10, tPar11, tPar12, tPar13, ;
tPar14, tPar15, tPar16, tPar17, tPar18, tPar19, tPar20, ;
tPar21, tPar22, tPar23, tPar24
Local loParameters
Debugout Time(0), Program(), "(Script)", lAllWorkers, tPar1, tPar2, tPar3, tPar4, tPar5, tPar6, ;
tPar7, tPar8, tPar9, tPar10, tPar11, tPar12, tPar13, ;
tPar14, tPar15, tPar16, tPar17, tPar18, tPar19, tPar20, ;
tPar21, tPar22, tPar23, tPar24
This._Events.UpdateCommandCount(lAllWorkers, This.oParPoolMgr.nWorkerCount)
loParameters = This.oParPoolMgr.CreateParameterObject(Pcount()-2, @tPar1, @tPar2, @tPar3, @tPar4, ;
@tPar5, @tPar6, @tPar7, @tPar8, @tPar9, @tPar10, @tPar11, ;
@tPar12, @tPar13, @tPar14, @tPar15, @tPar16, @tPar17, @tPar18, ;
@tPar19, @tPar20, @tPar21, @tPar22, @tPar23, @tPar24)
This.oParPoolMgr.QueueCommand("ExecScript", cScript,,,,loParameters, lAllWorkers, This._Events)
ENDPROC
PROCEDURE onerror
Lparameters cOnErrorCommand
Debugout Time(0), Program(), cOnErrorCommand
This.oParPoolMgr.cOnError = cOnErrorCommand
ENDPROC
PROCEDURE setinstance
* Set instance of parallel pool manager, creating new instance if necessary.
* Call before StartWorkers() and other Set... functions.
* Default instance name is "DEFAULT" (empty string not allowed in collection)
Lparameters cInstanceName
cInstanceName = Upper(Evl(cInstanceName, "DEFAULT"))
* Pool manager collection
If Type("_Screen.ParPoolMgrs") <> "O" or IsNull(_Screen.ParPoolMgrs)
_Screen.AddObject("ParPoolMgrs", "Collection")
EndIf
If _Screen.ParPoolMgrs.GetKey(cInstanceName) > 0
This.oParPoolMgr = _Screen.ParPoolMgrs.Item(cInstanceName)
Else
This.oParPoolMgr = NewObject("ParPoolMgr", "ParallelFox.vcx", "", cInstanceName)
_Screen.ParPoolMgrs.Add(This.oParPoolMgr, cInstanceName)
EndIf
ENDPROC
PROCEDURE setmultithreaded
* Set .T. to use in-process multithreaded DLL workers. Otherwise, out-of-process EXEs are used.
* Must be set before StartWorkers is called.
Lparameters lMTDLL
This.oParPoolMgr.lMTDLL = lMTDLL
ENDPROC
PROCEDURE setworkerclass
* Change worker class from default. lcClass and lcLibrary are used in debug mode.
Lparameters cCOMProgID, cClass, cLibrary
Debugout Time(0), Program(), cCOMProgID, cClass, cLibrary
This.oParPoolMgr.cWorkerCOMProgID = cCOMProgID
This.oParPoolMgr.cWorkerClass = cClass
This.oParPoolMgr.cWorkerLibrary = cLibrary
ENDPROC
PROCEDURE setworkercount
* Set number of workers.
* Defaults to CPU count.
* Set before starting workers.
Lparameters nWorkerCount, nTerminalServerCount
This.oParPoolMgr.SetWorkerCount(nWorkerCount, nTerminalServerCount)
ENDPROC
PROCEDURE startworkers
* Start worker processes
* Same EXE is used for all workers
Lparameters cProcedureFile, cDirectory, lDebugMode
Debugout Time(0), Program(), cProcedureFile, cDirectory, lDebugMode
This.oParPoolMgr.StartWorkers(cProcedureFile, cDirectory, lDebugMode)
ENDPROC
PROCEDURE stopworkers
* Stop worker processes
* Pass .T. to stop worker processes immediately. Otherwise, existing commands will finish first.
Lparameters lStopImmediately
Debugout Time(0), Program(), lStopImmediately
If lStopImmediately
This.oParPoolMgr.StopWorkers()
Else
This.oParPoolMgr.QueueCommand("StopWorkers")
EndIf
ENDPROC
PROCEDURE wait
* Wait until workers have finished processing queued commands.
Lparameters lAllWorkers
Debugout Time(0), Program(), "Start"
Local lnKey
lnKey = 0
Do while .t.
* Sleep() blocks worker processes, so use INKEY() to wait
Try
lnKey = Inkey(.1, "H")
Catch
* INKEY() crashes intermittently. If that happens, use Chrsaw().
lnKey = 0
If Chrsaw(.1)
lnKey = Inkey()
EndIf
EndTry
Do Case
* ON Escape doesn't work during INKEY() and VFP can appear locked up.
* CTRL+X will force exit from Wait.
Case lnKey = 24
Exit
* Wait for commands from current instance of Parallel object
Case !lAllWorkers and !(This._Events.nCommands > 0 and This.oParPoolMgr.nBusyWorkers > 0)
Exit
* Wait for commands from all instances of Parallel object
Case lAllWorkers and !(This.oParPoolMgr.nBusyWorkers > 0 ;
or (Type("This.oParPoolMgr.CommandQueue.Count") = "N" and This.oParPoolMgr.CommandQueue.Count > 0))
Exit
EndCase
EndDo
Debugout Time(0), Program(), "Complete"
ENDPROC
[END METHODS]
[START RESERVED1]
Class[END RESERVED1]
[START RESERVED2]
1[END RESERVED2]
[START RESERVED3]
*bindevent Bind to worker events: "Complete", "UpdateProgress", "ReturnData", "ReturnError".
*call Execute/call function on worker.
*callmethod Execute/call class method on worker.
*clearqueue Remove all pending commands from queue.
*detecthyperthreading Returns .T. when HyperThreading is enabled.
*do Execute program on worker.
*docmd Execute single command on worker.
*execscript Execute script on worker.
*onerror Set up global handler for worker errors. Available variables are nError, cMethod, nLine, cMessage, cCode. Example: Parallel.OnError("Do MyErrorHandler with nError, cMethod, nLine, cMessage, cCode")
*setinstance Set instance of parallel pool manager, creating new instance if necessary.
*setmultithreaded Set .T. to use in-process multithreaded DLL workers. Otherwise, out-of-process EXEs are used.
*setworkerclass Change worker class from default. lcClass and lcLibrary are used in debug mode.
*setworkercount Set number of workers. Defaults to CPU count. Set before starting workers.
*startworkers Start worker processes.
*stopworkers Stop worker processes.
*wait Wait until workers have finished processing queued commands.
_events Use Parallel.BindEvent().
_memberdata XML Metadata for customizable properties
cpucount Number of logical processors on machine.
oparpoolmgr Reference to parallel pool manager for current instance.
[END RESERVED3]
[START RESERVED6]
Pixels[END RESERVED6]
[ RECORD]
[PLATFORM] COMMENT
[UNIQUEID] RESERVED
[OBJNAME] parallel
[ RECORD]
[PLATFORM] WINDOWS
[UNIQUEID] _2YX10COEF
[CLASS] custom
[BASECLASS] custom
[OBJNAME] parameters
[START PROPERTIES]
Name = "parameters"
_memberdata = <VFPData><memberdata name="npcount" display="nPCount"/><memberdata name="isarray" display="IsArray"/><memberdata name="copyarray" display="CopyArray"/></VFPData>
npcount = 0
[END PROPERTIES]
[START METHODS]
PROCEDURE copyarray
* Copy array to worker.
* ACOPY doesn't work when run from worker on array that is COM object property.
* Must pass array as parameter to worker.
Lparameters lcParameter, loManager as aManager of ParallelFox.vcx
Local lcArray
Local array laTemp[1]
lcArray = "This." + lcParameter
Acopy(&lcArray, laTemp)
loManager.CopyArray(@laTemp)
ENDPROC
PROCEDURE isarray
* Returns .T. if specified parameter is an array.
* Type("aArray", 1) does not work when called from worker.
Lparameters lcParameter
Local llIsArray
lcParameter = "This." + lcParameter
llIsArray = (Type(lcParameter, 1) = "A")
Return llIsArray
ENDPROC
[END METHODS]
[START RESERVED1]
Class[END RESERVED1]
[START RESERVED2]
1[END RESERVED2]
[START RESERVED3]
*copyarray Copy array to worker.
*isarray Returns .T. if specified parameter is an array.
_memberdata XML Metadata for customizable properties
npcount Number of parameters.
[END RESERVED3]
[START RESERVED6]
Pixels[END RESERVED6]
[ RECORD]
[PLATFORM] COMMENT
[UNIQUEID] RESERVED
[OBJNAME] parameters
[ RECORD]
[PLATFORM] WINDOWS
[UNIQUEID] _2XP17XKBP
[CLASS] amanager
[CLASSLOC] parallelfox.vcx
[BASECLASS] custom
[OBJNAME] parpoolmgr
[START PROPERTIES]
Name = "parpoolmgr"
_memberdata = 1217<VFPData><memberdata name="ncpucount" display="nCPUCount"/><memberdata name="nworkercount" display="nWorkerCount"/><memberdata name="startworkers" display="StartWorkers"/><memberdata name="workers" display="Workers"/><memberdata name="nbusyworkers" display="nBusyWorkers"/><memberdata name="queuecommand" display="QueueCommand"/><memberdata name="processqueue" display="ProcessQueue"/><memberdata name="commandqueue" display="CommandQueue"/><memberdata name="ldebugmode" display="lDebugMode"/><memberdata name="stopworkers" display="StopWorkers"/><memberdata name="handleerror" display="HandleError"/><memberdata name="conerror" display="cOnError"/><memberdata name="clearqueue" display="ClearQueue"/><memberdata name="cworkercomprogid" display="cWorkerCOMProgID"/><memberdata name="cworkerclass" display="cWorkerClass"/><memberdata name="cworkerlibrary" display="cWorkerLibrary"/><memberdata name="nprocessing" display="nProcessing"/><memberdata name="setworkercount" display="SetWorkerCount"/><memberdata name="displayerrors" display="DisplayErrors"/><memberdata name="oerrorlist" display="oErrorList"/><memberdata name="lmtdll" display="lMTDLL"/><memberdata name="cinstancename" display="cInstanceName"/></VFPData>
cinstancename =
commandqueue =
conerror = This.DisplayErrors(nError, cMethod, nLine, cMessage, cCode)
cworkerclass = WorkerMgr
cworkercomprogid = ParallelFox.WorkerMgr
cworkerlibrary = ParallelFox.vcx
ldebugmode = .F.
lmtdll = .F.
nbusyworkers = 0
ncpucount = 0
nprocessing = 0
nworkercount = 0
oerrorlist = .NULL.
workers = .NULL.
[END PROPERTIES]
[START PROTECTED]
ldebugmode
nprocessing
[END PROTECTED]
[START METHODS]
PROCEDURE Init
* Number of logical processors on machine.
Lparameters lcInstanceName
This.cInstanceName = lcInstanceName
This.nCPUCount = Evl(Val(GetEnv("NUMBER_OF_PROCESSORS")), 1)
This.SetWorkerCount(This.nCPUCount, 1)
This.Workers = CreateObject("Collection")
This.CommandQueue = CreateObject("Collection")
Return DoDefault()
ENDPROC
PROCEDURE clearqueue
* Remove all pending commands from queue.
Debugout Time(0), Program()
This.CommandQueue = NULL
This.CommandQueue = CreateObject("Collection")
This.nProcessing = 0
ENDPROC
PROCEDURE displayerrors
* Default error handler displays list of errors from workers.
Lparameters lnError, lcMethod, lnLine, lcMessage, lcCode
If Vartype(This.oErrorList) <> "O" or IsNull(This.oErrorList)
This.oErrorList = NewObject("frmErrorList", "ParallelFox.vcx")
This.oErrorList.Show()
EndIf
This.oErrorList.DisplayError(lnError, lcMethod, lnLine, lcMessage, lcCode)
ENDPROC
PROCEDURE handleerror
* Global error handler. Set up with Parallel.OnError()
Lparameters nError, cMethod, nLine, cMessage, cCode
Local lcOnError
Debugout Time(0), Program(), nError, cMethod, nLine, cMessage, cCode
lcOnError = This.cOnError
&lcOnError
ENDPROC
PROCEDURE processqueue
Local lnCommands, lnCommand, loWorkerProxy as WorkerProxy of ParallelFox.vcx, ;
lnCommandNum, llSendCommand, lnWorker
* This method can be interrupted and called again by worker events
* Make sure it completely finishes before calling again
* nProcessing=0 means ProcessQueue is not currently running and queue can be processed now
* nProcessing=1 means ProcessQueue is currently running
* nProcessing=2 means run ProcessQueue again at the end of the current run
* Need to do evaluation and assignment in single line of code so it doesn't get interrupted (hope this works)
If Iif(This.nProcessing > 0, ;
This.WriteExpression("nProcessing", "2"), ;
!This.WriteExpression("nProcessing", "1"))