From e2ce4011f52839cf896c25c72b5750bb7b5a018a Mon Sep 17 00:00:00 2001 From: Tasuku HIRAISHI Date: Tue, 22 Jul 2014 03:26:04 +0000 Subject: [PATCH 001/105] Created new branch exception From d440df256998905c5e3591ad5f2fff396bcf6e8e Mon Sep 17 00:00:00 2001 From: tasuku Date: Thu, 24 Jul 2014 10:30:29 +0900 Subject: [PATCH 002/105] Fixed a bug in Makefile in src/sample/tcell (from bacc138) --- src/sample/tcell/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/sample/tcell/Makefile b/src/sample/tcell/Makefile index 470ef2fc..f6bb57fd 100644 --- a/src/sample/tcell/Makefile +++ b/src/sample/tcell/Makefile @@ -1,4 +1,4 @@ -OS=${shell uname -o} +OS=${shell uname} # Command for sc2c compiler SC2C=sc2c # set -m option not to remove intermediate files From 2cfaf28dca09b5117d6ca0c87330d7689b0d76f1 Mon Sep 17 00:00:00 2001 From: tasuku Date: Wed, 17 Sep 2014 19:38:47 +0900 Subject: [PATCH 003/105] (1) Enhanced rslt message to indicate reason of exit (normal/exception/cancel). (2) Changed the type of EXITING pseudo function from int to (enum exiting-rsn) (3) Moved the definitions of strings corresponding to enum values to worker.sh. --- eli/tcell-mode.el | 2 +- src/rule/tcell-defs.lsp | 9 ++-- src/rule/tcell.rule | 5 +- src/sample/tcell/cmd-serial.sc | 5 -- src/sample/tcell/fib-excep.tcell | 29 ++++++---- src/sample/tcell/worker.sc | 90 +++++++++++++++++++++++--------- src/sample/tcell/worker.sh | 32 ++++++++++-- 7 files changed, 119 insertions(+), 53 deletions(-) diff --git a/eli/tcell-mode.el b/eli/tcell-mode.el index 644f49cc..ef9d924c 100644 --- a/eli/tcell-mode.el +++ b/eli/tcell-mode.el @@ -107,7 +107,7 @@ ;; pseudo variables (,(concat "\\<" (regexp-opt - '("PROBABILITY" "WDATA" "WORKER-ID" "this") t) + '("PROBABILITY" "WDATA" "WORKER-ID" "EXITING" "this") t) "\\(\\.\\sw+\\)?\\>") (1 tcell-variable-name-face)) )))) diff --git a/src/rule/tcell-defs.lsp b/src/rule/tcell-defs.lsp index 771a1b65..b8a8ee62 100644 --- a/src/rule/tcell-defs.lsp +++ b/src/rule/tcell-defs.lsp @@ -170,12 +170,11 @@ ~(def (-bk) ,(nestfunc-type) ;; * When worker is handling an exception, exit this task ;; with returning an "abrt" message. - (if -thr->exiting - (begin - (= -thr->exiting 0) - (goto ,label-id))) + (if (or (== -thr->exiting EXITING-EXCEPTION) + (== -thr->exiting EXITING-CANCEL)) + (goto ,label-id)) ;; * The terminal of temporary backtracking - (return 0)) )) + (return)) )) ,@body (label ,label-id (return)) ) diff --git a/src/rule/tcell.rule b/src/rule/tcell.rule index 65ed1e83..68b86839 100644 --- a/src/rule/tcell.rule +++ b/src/rule/tcell.rule @@ -23,7 +23,6 @@ ;;; SUCH DAMAGE. ;;; Tascell --> LW-SC -;;; To be rewritten as an extension of sc0t-to-sc0t (define-ruleset tcell (sc0t-to-sc0t) (ignore-cfunc t) @@ -458,10 +457,10 @@ ;; exit from the catch block. Otherwise, continue ;; backtracking. ~(def (,bk-id) ,(tcell:nestfunc-type) - (if (and -thr->exiting + (if (and (== -thr->exiting EXITING-EXCEPTION) (== ,e-exp -thr->exception-tag)) (begin - (= -thr->exiting 0) + (= -thr->exiting EXITING-NORMAL) (goto ,label-id)) (,(tcell:latest-bk)))))) (= ,catchval-id ,e-exp) diff --git a/src/sample/tcell/cmd-serial.sc b/src/sample/tcell/cmd-serial.sc index 77c1e2a1..057ac370 100644 --- a/src/sample/tcell/cmd-serial.sc +++ b/src/sample/tcell/cmd-serial.sc @@ -64,11 +64,6 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;; -;; (enum command)の値が配列添字に対応 -;; ここを変えると deserilalize-cmdname の「ゆるい文字列比較」も変える必要があるので注意 -(def cmd-strings (array (ptr char)) - (array "task" "rslt" "treq" "none" "rack" "dreq" "data" - "bcst" "bcak" "stat" "verb" "exit" "leav" "lack" "abrt" "cncl" "wrng" 0)) ;; コマンド->文字列 (returns 書いた文字数) (def (csym::serialize-cmdname buf w) (fn int (ptr char) (enum command)) diff --git a/src/sample/tcell/fib-excep.tcell b/src/sample/tcell/fib-excep.tcell index 22cafd82..41330b7e 100644 --- a/src/sample/tcell/fib-excep.tcell +++ b/src/sample/tcell/fib-excep.tcell @@ -107,23 +107,32 @@ ;;(csym::fprintf stderr "receive fib(%d)=%d~%" this.n this.r) ) +(def rsn-strings (array (ptr char)) + (array "EXITING-NORMAL" "EXITING-EXCEPTION" "EXITING-CANCEL" "EXITING-SPAWN")) + (def (fib n) (wfn int int) ;; When non-zero is thrown here, the exception is not caught in task-body ;; and thus execution time is not printed. (if (== n 10) - (throw 0)) + (throw 3)) (if (<= n 2) (return 1) (begin (def s1 int) (def s2 int) - (do-two - (= s1 (fib (- n 1))) - (= s2 (fib (- n 2))) - (handles fib - (:put - (%ifdef* USE-PROBGUARD - (= PROBABILITY (csym::my-probability (- n 2)))) - (= this.n (- n 2))) - (:get (= s2 this.r)))) + (dynamic-wind + (:before) + (:body + (do-two + (= s1 (fib (- n 1))) + (= s2 (fib (- n 2))) + (handles fib + (:put + (%ifdef* USE-PROBGUARD + (= PROBABILITY (csym::my-probability (- n 2)))) + (= this.n (- n 2))) + (:get (= s2 this.r))))) + (:after + (csym::fprintf stderr "%d exinting fib(%d): %s~%" + WORKER-ID n (aref rsn-strings EXITING)))) (return (+ s1 s2))))) diff --git a/src/sample/tcell/worker.sc b/src/sample/tcell/worker.sc index cab3d627..936e2e64 100644 --- a/src/sample/tcell/worker.sc +++ b/src/sample/tcell/worker.sc @@ -479,6 +479,8 @@ (def tx (ptr (struct task))) (def old-ndiv int) (def old-probability double) + (def rsn (enum exiting-rsn)) + (def reason int) (def rcmd (struct cmd)) ; for RSLT command ;; If there is a treq message that was sent by this worker @@ -489,7 +491,9 @@ ;; If the result for the most recent suspended task has arrived, ;; stop requesting a new task and resume the suspended task. (if (and thr->sub - (== thr->sub->stat TASK-HOME-DONE)) + (or (== thr->sub->stat TASK-HOME-DONE) + (== thr->sub->stat TASK-HOME-EXCEPTION) + (== thr->sub->stat TASK-HOME-ABORTED))) (return))) ;; Allocate task to be initialized @@ -507,13 +511,40 @@ (DEBUG-PRINT 1 "(%d): (Thread %d) start %d<%p>.~%" (csym::get-universal-real-time) thr->id tx->task-no tx->body) ((aref task-doers tx->task-no) thr tx->body) ; Invoke the task body method - (DEBUG-PRINT 1 "(%d): (Thread %d) end %d<%p>.~%" - (csym::get-universal-real-time) thr->id tx->task-no tx->body) + (= rsn thr->exiting) + (= thr->exiting EXITING-NORMAL) + (switch rsn + (case EXITING-NORMAL) + (DEBUG-PRINT 1 "(%d): (Thread %d) end %d<%p>.~%" + (csym::get-universal-real-time) + thr->id tx->task-no tx->body) + (= reason 0) + (break) + (case EXITING-EXCEPTION) + (DEBUG-PRINT 1 "(%d): (Thread %d) end %d<%p> with exception %d.~%" + (csym::get-universal-real-time) + thr->id tx->task-no tx->body thr->exception-tag) + (= reason 1) + (break) + (case EXITING-CANCEL) + (DEBUG-PRINT 1 "(%d): (Thread %d) aborted %d<%p>.~%" + (csym::get-universal-real-time) + thr->id tx->task-no tx->body) + (= reason 2) + (break) + (default) + (csym::fprintf + stderr "(%d) Warn: Thread %d ended with unexpected reason.~%" + (csym::get-universal-real-time) thr->id) + (= reason 0)) ;; Send the result to the task sender (== the recipient of the treq) (= rcmd.w RSLT) - (= rcmd.c 1) + (= rcmd.c 3) (= rcmd.node tx->rslt-to) ; internal or external - (csym::copy-address (aref rcmd.v 0) tx->rslt-head) + (csym::copy-address (aref rcmd.v 0) tx->rslt-head) ;[0]:recipient + (= (aref rcmd.v 1 0) reason) (= (aref rcmd.v 1 1) TERM) ;[1]:reason + (= (aref rcmd.v 2 0) thr->exception-tag) (= (aref rcmd.v 2 1) TERM) + ; [2]:exception-tag (meaningful only when [1]==1) (csym::send-command (ptr rcmd) tx->body tx->task-no) (inc thr->w-rack) ; Increase w-rack counter. This is decreased when the worker ; receives a rack message as a reply to the rslt. While this @@ -668,15 +699,17 @@ ;;; rslt message: a reply to a task message to send the result of the task -;;; rslt +;;; rslt (def (csym::recv-rslt pcmd body) (csym::fn void (ptr (struct cmd)) (ptr void)) (def rcmd (struct cmd)) ; rack command (def thr (ptr (struct thread-data))) (def hx (ptr (struct task-home))) (def tid (enum addr)) (def sid int) + (def reason int) + (def exception-tag int) ;; Check # of arguments - (if (< pcmd->c 1) + (if (< pcmd->c 2) (csym::proto-error "Wrong rslt" pcmd)) ;; Extract the recipient worker id and the task-home id from ;; = : @@ -687,13 +720,17 @@ (if (== TERM sid) (csym::proto-error "Wrong rslt-head (no task-home-id)" pcmd)) (= thr (+ threads tid)) - + ;; Get + (= reason (aref pcmd->v 1 0)) + ;; Get (ignored when is not 1) + (= exception-tag (aref pcmd->v 2 0)) + (csym::pthread-mutex-lock (ptr thr->mut)) ;; Determine the task-home entry whose id is (if (not (= hx (csym::search-task-home-by-id sid thr->sub))) (csym::proto-error "Wrong rslt-head (specified task not exists)" pcmd)) - ;; For an external rslt message, receive the body of the result by - ;; invoking the user-defined receiver method. + ;; IF the rslt message is from external node and the task is normally exited, + ;; receive the body of thea result by invoking the user-defined receiver method. ;; (for an internal rslt, the body is passed as the argument) (cond ((== pcmd->node OUTSIDE) @@ -711,9 +748,15 @@ ; Set the recipient address ; (same to the recipient of the task message) - ;; Change the status of the task-home entry and notify that to the worker - ;; that is waiting for the result. - (= hx->stat TASK-HOME-DONE) + ;; Change the status of the task-home entry + (cond + ((== reason 0) + (= hx->stat TASK-HOME-DONE)) + ((== reason 1) + (= hx->stat TASK-HOME-EXCEPTION)) + ((== reason 2) + (= hx->stat TASK-HOME-ABORTED))) + ;; Notify the worker waiting for the result. (if (== hx thr->sub) (begin (csym::pthread-cond-broadcast (ptr thr->cond-r)) @@ -722,6 +765,7 @@ (csym::pthread-mutex-unlock (ptr thr->mut)) (csym::send-command (ptr rcmd) 0 0)) ; Send the rack command + ;; The Thread 'thr' has the task specified by [,...,]x(INSIDE|OUTSIDE) ? (def (csym::have-task thr task-spec task-from) (csym::fn int (ptr (struct thread-data)) (ptr (enum addr)) (enum node)) @@ -738,7 +782,6 @@ (return 0)) -(decl task-stat-strings (array (ptr char))) ;;; Check if the id-th worker can accept the task request 'pcmd' ;;; If ok, the worker allocate a task-home. (def (csym::try-treq pcmd id) @@ -1348,8 +1391,6 @@ ;;; Print information of a task entry in human-friendly style -(def task-stat-strings (array (ptr char)) ; consistent with (enum task-stat) definition - (array "TASK-ALLOCATED" "TASK-INITIALIZED" "TASK-STARTED" "TASK-DONE" "TASK-NONE" "TASK-SUSPENDED")) (def (csym::node-to-string buf node) (csym::fn void (ptr char) (enum node)) (switch node (case INSIDE) (csym::strcpy buf "INSIDE") (break) @@ -1374,8 +1415,6 @@ (return)) ;;; Print information of a task-home entry in human-friendly style -(def task-home-stat-strings (array (ptr char)) ; consistent with (enum task-home-stat) definition - (array "TASK-HOME-ALLOCATED" "TASK-HOME-INITIALIZED" "TASK-HOME-DONE")) (def (csym::print-task-home-list treq-top name) (csym::fn void (ptr (struct task-home)) (ptr char)) (def cur (ptr (struct task-home))) (defs (array char BUFSIZE) buf0 buf1 buf2) @@ -1391,13 +1430,14 @@ (return)) ;;; Print the status of a worker in human-friendly style -(def choose-strings (array (ptr char)) (array "CHS-RANDOM" "CHS-ORDER")) ; consistent with (enum choose) (def (csym::print-thread-status thr) (csym::fn void (ptr (struct thread-data))) (csym::fprintf stderr "~%" thr->id) (csym::fprintf stderr "req=%p, " thr->req) (csym::fprintf stderr "w-rack=%d, " thr->w-rack) (csym::fprintf stderr "w-none=%d, " thr->w-none) (csym::fprintf stderr "ndiv=%d, " thr->ndiv) + (csym::fprintf stderr "exiting=%s, " (aref exiting-rsn-strings thr->exiting)) + (csym::fprintf stderr "exception-tag=%d, " thr->exception-tag) (csym::fprintf stderr "probability=%lf, " thr->probability) (csym::fprintf stderr "last-treq=%d, " thr->last-treq) (csym::fprintf stderr "last-choose=%s, " (aref choose-strings thr->last-choose)) @@ -1457,14 +1497,16 @@ (csym::pthread-mutex-lock (ptr -thr->mut)) (if -thr->req (begin - (-bk) - (= -thr->req -thr->treq-top))) + (= -thr->exiting EXITING-SPAWN) + (-bk) + (= -thr->exiting EXITING-NORMAL) + (= -thr->req -thr->treq-top))) (csym::pthread-mutex-unlock (ptr -thr->mut))) ;; Start propagating an exception (def (handle-exception -bk -thr excep) - (fn void (ptr (NESTFN int void)) (ptr (struct thread-data)) long) - (= -thr->exiting 1) + (fn void (ptr (NESTFN int void)) (ptr (struct thread-data)) int) + (= -thr->exiting EXITING-EXCEPTION) (= -thr->exception-tag excep) (-bk)) ; never returns @@ -1750,7 +1792,7 @@ (= thr->probability 1.0) (= thr->last-treq i) (= thr->last-choose CHS-RANDOM) - (= thr->exiting 0) + (= thr->exiting EXITING-NORMAL) (= thr->exception-tag 0) (let ((r double) (q double)) (= r (csym::sqrt (+ 0.5 i))) diff --git a/src/sample/tcell/worker.sh b/src/sample/tcell/worker.sh index 2e6b320a..a07e278b 100644 --- a/src/sample/tcell/worker.sh +++ b/src/sample/tcell/worker.sh @@ -64,11 +64,16 @@ (def (enum command) TASK RSLT TREQ NONE RACK DREQ DATA BCST BCAK STAT VERB EXIT LEAV LACK ABRT CNCL WRNG) -;; Strings corresponding to the commands above. Defined in cmd-serial.sc. -(extern-decl cmd-strings (array (ptr char))) +;; Strings corresponding to the commands above. +(static cmd-strings (array (ptr char)) + (array "task" "rslt" "treq" "none" "rack" "dreq" "data" + "bcst" "bcak" "stat" "verb" "exit" "leav" "lack" "abrt" "cncl" "wrng" 0)) ;; How to determine the recipient of "treq any" (random or in-order) (def (enum choose) CHS-RANDOM CHS-ORDER) +;; consistent with (enum choose) +(static choose-strings (array (ptr char)) + (array "CHS-RANDOM" "CHS-ORDER")) (%defconstant NKIND-CHOOSE 2) ; # of kinds of (enum choose) ;; A message transferred among workers. @@ -143,6 +148,9 @@ TASK-DONE ; The task is completed TASK-NONE ; Sent treq for ALLOCATED entry but received none TASK-SUSPENDED) ; The task is suspended (due to waiting the result of a subtask) +(static task-stat-strings (array (ptr char)) + (array "TASK-ALLOCATED" "TASK-INITIALIZED" "TASK-STARTED" + "TASK-DONE" "TASK-NONE" "TASK-SUSPENDED")) ;; -(send treq)-> ALLOCATED -(receive task)-> INITIALIZED --> STARTED --> DONE --> ;; ^ |receive none ^ |receive the result ;; resend treq| V wait result of subtask| V @@ -153,8 +161,22 @@ TASK-HOME-ALLOCATED ; Allocated to request queue, or then moved to subtask stack but uninitialized TASK-HOME-INITIALIZED ; Initialized in subtask stack TASK-HOME-DONE ; Completed (received and handled the result) - TASK-HOME-ABORTED ; Aborted (received abrt) + TASK-HOME-EXCEPTION ; Completed with an exception + TASK-HOME-ABORTED ; Aborted by a cancellation message ) +(static task-home-stat-strings (array (ptr char)) + (array "TASK-HOME-ALLOCATED" "TASK-HOME-INITIALIZED" "TASK-HOME-DONE" + "TASK-HOME-EXCEPTION" "TASK-HOME-ABORTED")) + +;;;; The reason for the abnormal exit. +(def (enum exiting-rsn) + EXITING-NORMAL ; normal exit + EXITING-EXCEPTION ; exiting due to an exception + EXITING-CANCEL ; exiting due to a cancellation + EXITING-SPAWN ; temporary exiting to spawning a task + ) +(static exiting-rsn-strings (array (ptr char)) + (array "EXITING-NORMAL" "EXITING-EXCEPTION" "EXITING-CANCEL" "EXITING-SPAWN")) ;; Entry in the task stack of a worker (def (struct task) @@ -211,8 +233,8 @@ (def cond-r pthread-cond-t) ; condition variable for notifying rslt messages (def wdptr (ptr void)) ; worker local storage object (def w-bcak int) ; # of bcak messages to be recieved - (def exiting int) ; non-zero when backtracking to propagate an exception by a throw statement - (def exception-tag long) ; the exception tag to be catched + (def exiting (enum exiting-rsn)) ; the reason for abnormal exiting + (def exception-tag int) ; the exception tag to be catched (def dummy (array char DUMMY-SIZE)) ; padding for preventing false sharing ) From e39aade6e80286450a0232ec41b027b6861bf33b Mon Sep 17 00:00:00 2001 From: tasuku Date: Fri, 19 Sep 2014 08:54:26 +0900 Subject: [PATCH 004/105] Implemented partial cancellation flags (put, detect, and cancel) and propagation of exception across multiple tasks. --- src/rule/tcell-defs.lsp | 3 +- src/rule/tcell.rule | 140 +++++++++++++++++++------------ src/sample/tcell/fib-excep.tcell | 3 +- src/sample/tcell/worker.sc | 45 ++++++++-- src/sample/tcell/worker.sh | 2 + 5 files changed, 131 insertions(+), 62 deletions(-) diff --git a/src/rule/tcell-defs.lsp b/src/rule/tcell-defs.lsp index b8a8ee62..f55b3590 100644 --- a/src/rule/tcell-defs.lsp +++ b/src/rule/tcell-defs.lsp @@ -172,7 +172,8 @@ ;; with returning an "abrt" message. (if (or (== -thr->exiting EXITING-EXCEPTION) (== -thr->exiting EXITING-CANCEL)) - (goto ,label-id)) + (begin + (goto ,label-id))) ;; * The terminal of temporary backtracking (return)) )) ,@body diff --git a/src/rule/tcell.rule b/src/rule/tcell.rule index 68b86839..f91bea67 100644 --- a/src/rule/tcell.rule +++ b/src/rule/tcell.rule @@ -213,47 +213,64 @@ (b-put-body (function-body put-body)) (b-get-body (function-body get-body))) ~(begin - (def ,tdat-id (struct ,(tcell:task-struct-id))) ; 送信用 task-body - (def pthis (ptr (struct ,(tcell:task-struct-id))) (ptr ,tdat-id)) - (def ,spn-id int 0) ; すでに仕事をsendしていたら '1' - (begin - ;; Called for backtracking to handle a task request or an exception - (def (,bk-id) ,(tcell:nestfunc-type) - ;; If this nested function is called by an exception: - (if -thr->exiting - (begin - ;; Wait for spawned tasks to be completed - (while (> (dec ,spn-id) 0) - (wait-rslt -thr 0)) - ;; Continue backtracking (never returns) - (,(tcell:latest-bk)))) - ;; If this do-two has spawned a task: + #+comment + (def ,tdat-id (struct ,(tcell:task-struct-id))) ; 送信用 task-body + (def pthis (ptr (struct ,(tcell:task-struct-id))) + #+comment (ptr ,tdat-id)) + (def ,spn-id int 0) ; すでに仕事をsendしていたら '1' + (begin + ;; Called for backtracking to handle a task request or an exception + (def (,bk-id) ,(tcell:nestfunc-type) + ;; If this nested function is called for abnormal exit: + (if (or (== -thr->exiting EXITING-EXCEPTION) + (== -thr->exiting EXITING-CANCEL)) + (begin + ;; Wait for spawned tasks to be completed + (while (> (dec ,spn-id) 0) + (wait-rslt -thr 0)) + ;; Continue backtracking (never returns) + (,(tcell:latest-bk)))) + ;; If this do-two has spawned a task: (if ,spn-id (return 0)) ;; Try further backtracking (,(tcell:latest-bk)) ; より根元での分割を試みる - (while (fref (mref -thr) treq-top) ; タスク作成待ちスタックに要素があれば - (begin - ,@(if-pattern-variable guard-exp - (list - ~(begin - ,@guard-body - (if (csym::guard-task-request-prob -thr ,guard-exp) - (continue))))) - (begin ,@b-put-body) - (= ,spn-id 1) - (csym::make-and-send-task -thr ,(tcell:task-no) pthis) - (return 1))) + (while -thr->treq-top ; タスク作成待ちスタックに要素があれば + (begin + ,@(if-pattern-variable guard-exp + (list + ~(begin + ,@guard-body + (if (csym::guard-task-request-prob -thr ,guard-exp) + (continue))))) + (= pthis + (cast (ptr (struct ,(tcell:task-struct-id))) + (csym::malloc (sizeof (struct ,(tcell:task-struct-id)))))) + (begin ,@b-put-body) + (= ,spn-id 1) + (csym::make-and-send-task -thr ,(tcell:task-no) pthis) + (return 1))) (return 0)) - ;; ここから仕事本体 - (if (fref (mref -thr) req) ; （ポーリング）タスク要求がきていたら - ,(tcell:with-new-bk bk-id ; 分割を試みる - (wfn-add-argids ~(handle-req)))) - ,b-stat1) - (if (and ,spn-id - (wait-rslt -thr 1)) - (begin ,@b-get-body) - (begin ,b-stat2)) - ) ))) + ;; ここから仕事本体 + ;; Polling for cancellation flags + (if -thr->task-top->cancellation + ,(tcell:with-new-bk bk-id + (wfn-add-argids ~(handle-cancellation)))) + ;; Polling for task requests + (if -thr->req + ,(tcell:with-new-bk bk-id + (wfn-add-argids ~(handle-req)))) + ,b-stat1) + (if ,spn-id + ;; If a subtask is spawned, wait for the result. + (if (= pthis (wait-rslt -thr 1)) + (begin + (begin ,@b-get-body) + (csym::free pthis)) + ;; If the subtask has thrown an exception, propagate it. + (if (== -thr->exiting EXITING-EXCEPTION) + ,(wfn-add-argids ~(handle-exception -thr->exception-tag)))) + (begin ,b-stat2)) + ) ))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; do-many ;; * ,var を制御変数として，,fromから ,toまでについて ,@bodyを実行 @@ -286,11 +303,12 @@ (def ,var2 int ,(expression to)) ; ,var <= i < ,var2 が未処理 (def pthis (ptr (struct ,(tcell:task-struct-id)))) ; 送信用 task-body (def ,spn-id int 0) ; 仕事を他所にsendしている数 - ;; <-- Nestfunc start + ;; <-- Nestfunc start --- ;; Called for backtracking to handle a task request or an exception (def (,bk-id) ,(tcell:nestfunc-type) - ;; If this nested function is called by an exception: - (if -thr->exiting + ;; If this nested function is called for abnormal exit + (if (or (== -thr->exiting EXITING-EXCEPTION) + (== -thr->exiting EXITING-CANCEL)) (begin ;; Wait for spawned tasks to be completed (while (> (dec ,spn-id) 0) @@ -301,7 +319,7 @@ (,(tcell:latest-bk)))) ;; If this do-many has not spawned any tasks, continue backtracking (if (not ,spn-id) (,(tcell:latest-bk))) - (while (and (fref (mref -thr) treq-top) ; there remains a treq? + (while (and -thr->treq-top ; there remains a treq? (<= 2 (- ,var2 ,var))) ; there remains any spawnable iterations? (def ,put-to int ,var2) (def ,put-from int) @@ -329,9 +347,13 @@ (inc ,spn-id) (csym::make-and-send-task -thr ,(tcell:task-no) pthis)) (return 0)) - ;; Nestfunc End --> + ;; --- Nestfunc End --> + ;; Polling for cancellation flags + (if -thr->task-top->cancellation + ,(tcell:with-new-bk bk-id + (wfn-add-argids ~(handle-cancellation)))) ;; Polling for task requests - (if (fref (mref -thr) req) + (if -thr->req ,(tcell:with-new-bk bk-id (wfn-add-argids ~(handle-req)))) ;; Loop body @@ -341,8 +363,13 @@ (while (> (dec ,spn-id) 0) (= pthis (cast (ptr (struct ,(tcell:task-struct-id))) (wait-rslt -thr 1))) - ,@(function-body get-body) - (csym::free pthis))) ))) + (if pthis (begin + ,@(function-body get-body) + (csym::free pthis)))) + ;; If there is a subtask that has thrown an exception, propagate it. + (if (== -thr->exiting EXITING-EXCEPTION) + ,(wfn-add-argids ~(handle-exception -thr->exception-tag))) + ) ))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; do-many* ;; * Space Stealing用のdo-many @@ -363,7 +390,7 @@ ;; タスク要求がきたら呼ばれる (def (,bk-id) ,(tcell:nestfunc-type) (if (not ,spn-id) (,(tcell:latest-bk))) - (if (fref (mref -thr) treq-top) ; タスク作成待ちスタックに要素があれば + (if -thr->treq-top ; タスク作成待ちスタックに要素があれば (begin (= pthis (cast (ptr (struct ,(tcell:task-struct-id))) (csym::malloc (sizeof (struct ,(tcell:task-struct-id)))))) @@ -372,15 +399,21 @@ (csym::make-and-send-task -thr ,(tcell:task-no) pthis))) (return 0)) (for (,(expression! init-exp) ,(expression! cond-exp) ,(expression! loop-exp)) - (if (fref (mref -thr) req) ; （ポーリング）タスク要求がきていたら + (if -thr->req ; （ポーリング）タスク要求がきていたら ,(tcell:with-new-bk bk-id ; 分割を試みる (wfn-add-argids ~(handle-req)))) ,@(function-body body)) (while (> (dec ,spn-id) 0) (= pthis (cast (ptr (struct ,(tcell:task-struct-id))) (wait-rslt -thr 1))) - ,@(function-body get-body) - (csym::free pthis))) ))) + (if pthis + (begin + ,@(function-body get-body) + (csym::free pthis)))) + ;; If there is a subtask that has thrown an exception, propagate it. + (if (== -thr->exiting EXITING-EXCEPTION) + ,(wfn-add-argids ~(handle-exception -thr->exception-tag))) + ) ))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; tcell-broadcast ;; * タスクを全ノードに送りつける @@ -461,6 +494,7 @@ (== ,e-exp -thr->exception-tag)) (begin (= -thr->exiting EXITING-NORMAL) + (csym::pthread-mutex-unlock (ptr -thr->mut)) (goto ,label-id)) (,(tcell:latest-bk)))))) (= ,catchval-id ,e-exp) @@ -487,22 +521,22 @@ ;; get acceptance probability (#?(the ,texp PROBABILITY) (if (tcell:wdata-accessible-p) - ~(fref (mref -thr) probability) + ~-thr->probability x)) ;; access to worker local storage (#?(the ,texp WDATA) (if (tcell:wdata-accessible-p) - ~(mref (cast (ptr (struct worker-data)) (fref (mref -thr) wdptr))) + ~(mref (cast (ptr (struct worker-data)) -thr->wdptr)) x)) ;; get WORKER-ID (#?(the ,texp WORKER-ID) (if (tcell:wdata-accessible-p) - ~(fref (mref -thr) id) + ~-thr->id -1)) ;; get whether propagating an exception (#?(the ,texp EXITING) (if (tcell:wdata-accessible-p) - ~(fref (mref -thr) exiting) + ~-thr->exiting 0)) ;; this -> (mref pthis) (#?(the ,texp this) diff --git a/src/sample/tcell/fib-excep.tcell b/src/sample/tcell/fib-excep.tcell index 41330b7e..7f27ff31 100644 --- a/src/sample/tcell/fib-excep.tcell +++ b/src/sample/tcell/fib-excep.tcell @@ -113,7 +113,8 @@ (def (fib n) (wfn int int) ;; When non-zero is thrown here, the exception is not caught in task-body ;; and thus execution time is not printed. - (if (== n 10) + (if (and (== WORKER-ID 1) + (== n 10)) (throw 3)) (if (<= n 2) (return 1) diff --git a/src/sample/tcell/worker.sc b/src/sample/tcell/worker.sc index 936e2e64..29f65dff 100644 --- a/src/sample/tcell/worker.sc +++ b/src/sample/tcell/worker.sc @@ -503,6 +503,7 @@ (begin ;; Execute the task (= tx->stat TASK-STARTED) ; TASK-INITIALIZED => TASK-STARTED + (= tx->cancellation 0) ; initialize # of cancellation flags (= old-ndiv thr->ndiv) (= old-probability thr->probability) (= thr->ndiv tx->ndiv) @@ -753,7 +754,9 @@ ((== reason 0) (= hx->stat TASK-HOME-DONE)) ((== reason 1) - (= hx->stat TASK-HOME-EXCEPTION)) + (= hx->stat TASK-HOME-EXCEPTION) + (= hx->exception-tag exception-tag) + (inc hx->owner->cancellation)) ((== reason 2) (= hx->stat TASK-HOME-ABORTED))) ;; Notify the worker waiting for the result. @@ -1503,13 +1506,27 @@ (= -thr->req -thr->treq-top))) (csym::pthread-mutex-unlock (ptr -thr->mut))) -;; Start propagating an exception +;; Start propagating an exception. Invoked by a Tascell throw statement. (def (handle-exception -bk -thr excep) (fn void (ptr (NESTFN int void)) (ptr (struct thread-data)) int) (= -thr->exiting EXITING-EXCEPTION) (= -thr->exception-tag excep) (-bk)) ; never returns +;; Check (partial) cancellation flags and abort if needed. +(def (handle-cancellation -bk -thr) + (fn void (ptr (NESTFN int void)) (ptr (struct thread-data))) + (csym::pthread-mutex-lock (ptr -thr->mut)) + (if -thr->task-top->cancellation + (begin + (DEBUG-PRINT 1 "(%d): (Thread %d) detected cancellation flag (%d)~%" (csym::get-universal-real-time) -thr->id -thr->task-top->cancellation) + (= -thr->exiting EXITING-CANCEL) + (csym::pthread-mutex-unlock (ptr -thr->mut)) + (-bk))) + (csym::pthread-mutex-unlock (ptr -thr->mut)) + ) ; never returns + + ;; Make a task message and send it. ;; (The recipient is determined by the top of the task request stack) ;; Called by a worker thread ("thr") after initializing the task object @@ -1529,7 +1546,7 @@ (= hx->id (if-exp hx->next ; the subtask ID (= height_of_the_stack + 1) (+ hx->next->id 1) 0)) - (= hx->owner thr->task-top) ; the parent task (= the top of the task stack) + (= hx->owner thr->task-top) ; the parent task (= current top of the task stack) (= hx->stat TASK-HOME-INITIALIZED) ; ALLOCATED => INITIALIZED ;; Make a task message (= tcmd.c 4) ; # of arguments @@ -1553,7 +1570,8 @@ (def sub (ptr (struct task-home))) (csym::pthread-mutex-lock (ptr thr->mut)) (= sub thr->sub) ; sub: the top of the worker's subtask stack - (while (and (!= sub->stat TASK-HOME-DONE) ; Until the subtask is done or aborted + (while (and (!= sub->stat TASK-HOME-DONE) ; Until the subtask is done/aborted + (!= sub->stat TASK-HOME-EXCEPTION) (!= sub->stat TASK-HOME-ABORTED)) (= thr->task-top->stat TASK-SUSPENDED) ; STARTED => SUSPENDED (thr->task-top is the task being executed) (if stback @@ -1570,6 +1588,7 @@ )) ;; Quit if the subtask is finished or aborted. (if (or (== sub->stat TASK-HOME-DONE) + (== sub->stat TASK-HOME-EXCEPTION) (== sub->stat TASK-HOME-ABORTED)) (break)) ;; Steal and execute a task @@ -1577,9 +1596,20 @@ ;; If stealing back is disabled, just wait for the result. (csym::pthread-cond-wait (ptr thr->cond-r) (ptr thr->mut))) ) - - (if (== sub->stat TASK-HOME-ABORTED) - (= body 0) + + ;; When the subtask has thrown an exception, propagate it + (if (== sub->stat TASK-HOME-EXCEPTION) + (begin + (= thr->exiting EXITING-EXCEPTION) + (= thr->exception-tag sub->exception-tag) + (dec sub->owner->cancellation) + )) + ;; When the subtask is abnormally exited, a task object is not returned as the result + (if (or (== sub->stat TASK-HOME-EXCEPTION) + (== sub->stat TASK-HOME-ABORTED)) + (begin + (csym::free body) + (= body 0)) (= body sub->body)) ;; Pop the subtask stack (= thr->sub sub->next) ; stack top <== 2nd entry @@ -1789,6 +1819,7 @@ (= thr->w-none 0) (= thr->w-bcak 0) (= thr->ndiv 0) + (= thr-> 0) (= thr->probability 1.0) (= thr->last-treq i) (= thr->last-choose CHS-RANDOM) diff --git a/src/sample/tcell/worker.sh b/src/sample/tcell/worker.sh index a07e278b..5647349e 100644 --- a/src/sample/tcell/worker.sh +++ b/src/sample/tcell/worker.sh @@ -186,6 +186,7 @@ (def task-no int) ; kind of the task (def body (ptr void)) ; task object (def ndiv int) ; # of task division + (def cancellation int) ; # of partial cancellation flags (def rslt-to (enum node)) ; task sender (= result recipient) is INSIDE/OUTSIDE of this node (def rslt-head (array (enum addr) ARG-SIZE-MAX))) ; address of task sender (= result recipient) @@ -195,6 +196,7 @@ (def (struct task-home) (def stat (enum task-home-stat)) ; status (def id int) ; ID (unique in each worker) + (def exception-tag int) ; thrown exception value (when stat is TASK-HOME-EXCEPTION) (def waiting-head (array (enum addr) ARG-SIZE-MAX)) ; for stealing-back treq, the task head of which ; the requester is waiting for the result From bf33349ea95ed14a2de10f0b77fe49ee5bdd3ee4 Mon Sep 17 00:00:00 2001 From: tasuku Date: Fri, 19 Sep 2014 10:39:40 +0900 Subject: [PATCH 005/105] Added the example "pen-excep.tcell" --- src/sample/tcell/Makefile | 2 +- src/sample/tcell/pen-excep.tcell | 223 +++++++++++++++++++++++++++++++ 2 files changed, 224 insertions(+), 1 deletion(-) create mode 100644 src/sample/tcell/pen-excep.tcell diff --git a/src/sample/tcell/Makefile b/src/sample/tcell/Makefile index f6bb57fd..cf99ade7 100644 --- a/src/sample/tcell/Makefile +++ b/src/sample/tcell/Makefile @@ -44,7 +44,7 @@ endif # icc-c, icc-lw, and icc-clos} # By default, this Makefile makes all ALL_PROGS. You can make just one of targets by specifying the target file name, # (e.g., "make fib-gcc") -APPS=fib fib-guard fib-excep lu cmp pen pen6x17 pen6x17-guard nq grav matmul spanning bcast copine0 copine1 copine2 copine3 +APPS=fib fib-guard fib-excep lu cmp pen pen-excep pen6x17 pen6x17-guard nq grav matmul spanning bcast copine0 copine1 copine2 copine3 C_PROGS=$(addsuffix -c,$(APPS)) GCC_PROGS=$(addsuffix -gcc,$(APPS)) diff --git a/src/sample/tcell/pen-excep.tcell b/src/sample/tcell/pen-excep.tcell new file mode 100644 index 00000000..6b5b1cb3 --- /dev/null +++ b/src/sample/tcell/pen-excep.tcell @@ -0,0 +1,223 @@ +;;; Copyright (c) 2008 Tasuku Hiraishi +;;; All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: +;;; 1. Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. +;;; 2. Redistributions in binary form must reproduce the above copyright +;;; notice, this list of conditions and the following disclaimer in the +;;; documentation and/or other materials provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND +;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE +;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +;;; SUCH DAMAGE. + +;;; Find solutions of Pentomino puzzle +;;; Based on pen.tcell but throws an exception when # solutions exceeds 100 + +;; task 0 0 0 1 +;; + + +(c-exp "#include") + +(%include "rule/tcell-setrule.sh") +(%include "clib.sh") +(%include "dprint.sh") +(%cinclude "sendrecv.h" (:macro)) + +(%defconstant ASIZE 12) +(%defconstant BSIZE 70) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(def (task pentomino) + (def r int :out) + (def k int :in) + (def i0 int :in) + (def i1 int :in) + (def i2 int :in) + (def a (array int ASIZE) :in) + (def b (array int BSIZE) :in)) + +;; task/rslt-sender/receiver = default + +(decl (search k j0 j1 j2 tsk) (wfn int int int int int (ptr (struct pentomino)))) +(def (task-body pentomino) + (decl i int) + (def k int this.k) + (def i0 int this.i0) + (def i1 int this.i1) + (def i2 int this.i2) + (DEBUG-PRINT 1 "start %d %d %d %d~%" k i0 i1 i2) + (= this.r (search k i0 i1 i2 (ptr this))) + (DEBUG-PRINT 1 "end %d~%" this.r)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(def (task start-pentomino) + (def r int :out)) + +(def (csym::elapsed-time tp) + (fn double (array (struct timeval) 2)) + (return (+ (- (fref (aref tp 1) tv-sec) + (fref (aref tp 0) tv-sec)) + (* 0.000001 + (- (fref (aref tp 1) tv-usec) + (fref (aref tp 0) tv-usec)))))) + +;; 新しい問題を解く +(def (task-body start-pentomino) + (decl tp (array (struct timeval) 2)) + (def pen (struct pentomino)) + (def i int) + (for ((= i 0) (< i ASIZE) (inc i)) (= (aref pen.a i) i)) + (for ((= i 0) (< i BSIZE) (inc i)) (= (aref pen.b i) 0)) + (for ((= i 6) (< i BSIZE) (+= i 7)) + (= (aref pen.b i) #\Newline)) + (csym::gettimeofday tp 0) + (= this.r (search 0 0 0 ASIZE (ptr pen))) + (csym::gettimeofday (+ tp 1) 0) + (fprintf stderr "time: %lf~%" (csym::elapsed-time tp))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(def ps (array int 57 5) + (array + (array 1 1 1 1) (array 7 7 7 7) ; ***** とその縦向き + (array 4 1 1 1) (array 7 7 6 1) ; * * + ; **** * + ; * + ; ** + (array 6 1 1 1) (array 5 1 1 1) (array 1 1 1 5) (array 1 1 1 6) + ;; * * **** **** + ;; **** **** * * + (array 7 1 6 7) (array 7 7 1 6) (array 7 6 1 7) (array 6 1 7 7) + ;; * * * * + ;; ** * * ** + ;; * ** ** * + ;; * * * * + (array 7 7 1 1) (array 1 1 5 7) (array 1 1 7 7) (array 7 5 1 1) + ;; * *** *** * + ;; * * * * + ;; *** * * *** + (array 2 5 1 1) (array 1 1 5 2) (array 1 6 7 1) (array 1 7 6 1) + ;; * * *** ** ** + ;; *** * * * * + ;; ** ** + (array 7 1 1 5) (array 5 1 1 7) (array 7 6 1 1) (array 1 1 6 7) + ;; * * * *** + ;; *** *** * * + ;; * * *** * + (array 7 1 1 6) (array 5 1 1 6) (array 6 1 1 5) (array 6 1 1 7) + ;; * * * * + ;; *** *** *** *** + ;; * * * * + (array 1 7 1 6) (array 7 1 5 1) (array 1 5 1 7) (array 6 1 7 1) + ;; ** * ** * + ;; ** ** ** ** + ;; * ** * ** + (array 7 1 1 7) (array 5 1 1 5) (array 1 7 7 1) (array 1 6 6 1) + ;; * * ** ** + ;; *** *** * * + ;; * * ** ** + (array 6 1 1 6) + ;; * + ;; *** + ;; * + (array 1 6 1 1) (array 1 1 5 1) (array 1 5 1 1) (array 1 1 6 1) + ;; ** *** ** *** + ;; *** ** *** ** + (array 7 1 6 1) (array 1 6 1 6) (array 6 1 6 1) (array 1 6 1 7) + ;; * ** * ** + ;; ** ** ** ** + ;; ** * ** * + (array 1 4 1 1) (array 1 1 7 1) (array 1 7 1 1) (array 1 1 4 1) + ;; ** *** ** *** + ;; *** ** *** ** + (array 7 1 7 7) (array 7 6 1 6) (array 6 1 6 7) (array 7 7 1 7) + ;; * * * * + ;; ** * ** * + ;; * ** * ** + ;; * * * * + (array 7 1 7 1) (array 1 5 1 6) (array 1 7 1 7) (array 6 1 5 1) + ;; * ** ** * + ;; ** ** ** ** + ;; ** * * ** + )) + +(def pos (array int 13) (array 0 2 4 12 16 20 24 32 36 37 45 53 57)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; k: 最初の空きセル +;; j0: +;; j1--j2: 試すビースの種類 +(def (search k j0 j1 j2 tsk) (wfn int int int int int (ptr (struct pentomino))) + (def s int 0) + (do-many for p from j1 to j2 + (def ap int (aref (fref (mref tsk) a) p)) + (def i int) + (for ((= i (aref pos ap)) (< i (aref pos (+ ap 1))) (inc i)) + ;; examine the "i"-th (piece, direction) + ;; at the first empty location "k" + (def pss (ptr int) (aref ps i)) + (def kk int k) (decl l int) + (for ((= l 0) (< l 4) (inc l)) + (if (or (>= (+= kk (aref pss l)) 70) + (!= (aref (fref (mref tsk) b) kk) 0)) + (goto Ln))) + (dynamic-wind + (:before + (= (aref (fref (mref tsk) b) + (= kk k)) + (+ p #\A)) + (for ((= l 0) (< l 4) (inc l)) + (= (aref (fref (mref tsk) b) + (+= kk (aref pss l))) + (+ p #\A))) + (= (aref (fref (mref tsk) a) p) + (aref (fref (mref tsk) a) j0)) + (= (aref (fref (mref tsk) a) j0) ap)) + (:body + (for ((= kk k) (< kk 70) (inc kk)) + (if (== (aref (fref (mref tsk) b) kk) 0) (break))) + (if (== kk 70) + (+= s 1) + (if (and (or (>= (+ kk 7) 70) + (!= (aref (fref (mref tsk) b) (+ kk 7)) 0)) + (or (!= (aref (fref (mref tsk) b) (+ kk 1)) 0) + (and (or (>= (+ kk 8) 70) + (!= (aref (fref (mref tsk) b) (+ kk 8)) 0)) + (!= (aref (fref (mref tsk) b) (+ kk 2)) 0)))) + () + (+= s (search kk (+ j0 1) (+ j0 1) 12 tsk))))) + (:after + (= ap (aref (fref (mref tsk) a) j0)) + (= (aref (fref (mref tsk) a) j0) (aref (fref (mref tsk) a) p)) + (= (aref (fref (mref tsk) a) p) ap) + (= (aref (fref (mref tsk) b) (= kk k)) 0) + (for ((= l 0) (< l 4) (inc l)) + (= (aref (fref (mref tsk) b) (+= kk (aref pss l))) 0))) + ) + (label Ln (continue)) + ) + ;; put/get pentomino task/result + (handles pentomino + (:put from i1 to i2 + (= this (mref tsk)) + (= this.k k) + (= this.i0 j0) + (= this.i1 i1) + (= this.i2 i2)) + (:get + (+= s this.r)))) + (if (> s 100) (throw 0)) + (return s)) From 67a7311c0ac2ad4a40cc63bc92e2dadf692a328b Mon Sep 17 00:00:00 2001 From: tasuku Date: Mon, 22 Sep 2014 21:10:39 +0900 Subject: [PATCH 006/105] Implemented sending cancellation message when receiving an exception or an cancellation message. --- src/rule/tcell.rule | 12 +++- src/sample/tcell/worker.sc | 140 ++++++++++++++++++++++++++++++------- src/sample/tcell/worker.sh | 14 ++-- 3 files changed, 135 insertions(+), 31 deletions(-) diff --git a/src/rule/tcell.rule b/src/rule/tcell.rule index f91bea67..eada49dd 100644 --- a/src/rule/tcell.rule +++ b/src/rule/tcell.rule @@ -247,10 +247,14 @@ (csym::malloc (sizeof (struct ,(tcell:task-struct-id)))))) (begin ,@b-put-body) (= ,spn-id 1) - (csym::make-and-send-task -thr ,(tcell:task-no) pthis) + (csym::make-and-send-task -thr ,(tcell:task-no) pthis 1) (return 1))) (return 0)) ;; ここから仕事本体 + ;; Polling for cancel message requests + (if -thr->req-cncl + ,(tcell:with-new-bk bk-id + (wfn-add-argids ~(handle-req-cncl)))) ;; Polling for cancellation flags (if -thr->task-top->cancellation ,(tcell:with-new-bk bk-id @@ -345,9 +349,13 @@ (csym::malloc (sizeof (struct ,(tcell:task-struct-id)))))) (begin ,@(function-body put-body)) (inc ,spn-id) - (csym::make-and-send-task -thr ,(tcell:task-no) pthis)) + (csym::make-and-send-task -thr ,(tcell:task-no) pthis (== ,spn-id 1))) (return 0)) ;; --- Nestfunc End --> + ;; Polling for cancel message requests + (if -thr->req-cncl + ,(tcell:with-new-bk bk-id + (wfn-add-argids ~(handle-req-cncl)))) ;; Polling for cancellation flags (if -thr->task-top->cancellation ,(tcell:with-new-bk bk-id diff --git a/src/sample/tcell/worker.sc b/src/sample/tcell/worker.sc index 29f65dff..ba53a4d0 100644 --- a/src/sample/tcell/worker.sc +++ b/src/sample/tcell/worker.sc @@ -509,28 +509,29 @@ (= thr->ndiv tx->ndiv) (= thr->probability 1.0) (csym::pthread-mutex-unlock (ptr thr->mut)) - (DEBUG-PRINT 1 "(%d): (Thread %d) start %d<%p>.~%" - (csym::get-universal-real-time) thr->id tx->task-no tx->body) + (DEBUG-PRINT 1 "(%d): (Thread %d) start %d<%p> (body=%p).~%" + (csym::get-universal-real-time) thr->id tx->task-no tx tx->body) ((aref task-doers tx->task-no) thr tx->body) ; Invoke the task body method (= rsn thr->exiting) (= thr->exiting EXITING-NORMAL) + ;; Set the reason for compliting the task (switch rsn (case EXITING-NORMAL) - (DEBUG-PRINT 1 "(%d): (Thread %d) end %d<%p>.~%" + (DEBUG-PRINT 1 "(%d): (Thread %d) end %d<%p> (body=%p).~%" (csym::get-universal-real-time) - thr->id tx->task-no tx->body) + thr->id tx->task-no tx tx->body) (= reason 0) (break) (case EXITING-EXCEPTION) - (DEBUG-PRINT 1 "(%d): (Thread %d) end %d<%p> with exception %d.~%" + (DEBUG-PRINT 1 "(%d): (Thread %d) end %d<%p> (body=%p) with exception %d.~%" (csym::get-universal-real-time) - thr->id tx->task-no tx->body thr->exception-tag) + thr->id tx->task-no tx tx->body thr->exception-tag) (= reason 1) (break) (case EXITING-CANCEL) - (DEBUG-PRINT 1 "(%d): (Thread %d) aborted %d<%p>.~%" + (DEBUG-PRINT 1 "(%d): (Thread %d) aborted %d<%p> (body=%p).~%" (csym::get-universal-real-time) - thr->id tx->task-no tx->body) + thr->id tx->task-no tx tx->body) (= reason 2) (break) (default) @@ -547,6 +548,7 @@ (= (aref rcmd.v 2 0) thr->exception-tag) (= (aref rcmd.v 2 1) TERM) ; [2]:exception-tag (meaningful only when [1]==1) (csym::send-command (ptr rcmd) tx->body tx->task-no) + (csym::pthread-mutex-lock (ptr thr->rack-mut)) (inc thr->w-rack) ; Increase w-rack counter. This is decreased when the worker ; receives a rack message as a reply to the rslt. While this ; counter is larger than zero, the worker does not spawn a @@ -698,6 +700,30 @@ (= hx hx->next)) (return hx)) + +;;; Set subtasks to be cancelled spawned by "owner" and newer than "eldest" +;;; If eldest is 0, all the subtasks spawned by "owner" are set to be cancelled. +;;; The mutex thr->mut must be acquired before calling this function. +;;; When there is any subtask set to be cancelled, set a cancel request flag to "thr". +;;; (This flag is detected by polling and cncl messages are sent for flagged subtasks) +;;; Returns # of subtasks that are set to be cancelled. +(def (csym::set-cancelled thr owner eldest) + (csym::fn int (ptr (struct thread-data)) (ptr (struct task)) (ptr (struct task-home))) + (def cur (ptr (struct task-home))) + (def count int 0) + (for ((= cur thr->sub) cur (= cur cur->next)) + (if (and (== cur->owner owner) + (== cur->stat TASK-HOME-INITIALIZED) ; currently running? + (== cur->msg-cncl 0)) + (begin + (= cur->msg-cncl 1) + (inc count))) + (if (and eldest (== eldest cur->eldest)) + (break)) + ) + (if count (= thr->req-cncl 1)) + (return count)) + ;;; rslt message: a reply to a task message to send the result of the task ;;; rslt @@ -730,7 +756,7 @@ ;; Determine the task-home entry whose id is (if (not (= hx (csym::search-task-home-by-id sid thr->sub))) (csym::proto-error "Wrong rslt-head (specified task not exists)" pcmd)) - ;; IF the rslt message is from external node and the task is normally exited, + ;; If the rslt message is from external node and the task is normally exited, ;; receive the body of thea result by invoking the user-defined receiver method. ;; (for an internal rslt, the body is passed as the argument) (cond @@ -756,7 +782,9 @@ ((== reason 1) (= hx->stat TASK-HOME-EXCEPTION) (= hx->exception-tag exception-tag) - (inc hx->owner->cancellation)) + (inc hx->owner->cancellation) + (csym::set-cancelled thr hx->owner hx->eldest) + ) ((== reason 2) (= hx->stat TASK-HOME-ABORTED))) ;; Notify the worker waiting for the result. @@ -769,9 +797,10 @@ (csym::send-command (ptr rcmd) 0 0)) ; Send the rack command -;; The Thread 'thr' has the task specified by [,...,]x(INSIDE|OUTSIDE) ? +;; If the worker 'thr' has the task whose return address is [,...,]x(INSIDE|OUTSIDE), +;; return the pointer to the task object. Return 0 otherwise. (def (csym::have-task thr task-spec task-from) - (csym::fn int (ptr (struct thread-data)) (ptr (enum addr)) (enum node)) + (csym::fn (ptr (struct task)) (ptr (struct thread-data)) (ptr (enum addr)) (enum node)) (def tx (ptr (struct task))) (= tx thr->task-top) (while tx @@ -780,7 +809,7 @@ (== tx->stat TASK-STARTED)) (== tx->rslt-to task-from) (csym::address-equal tx->rslt-head task-spec)) - (return 1)) + (return tx)) (= tx tx->next)) (return 0)) @@ -819,6 +848,9 @@ (if (< thr->probability (csym::my-random-probability thr)) (= fail-reason 5))) (= avail (not fail-reason)) + (csym::pthread-mutex-unlock (ptr thr->rack-mut)) + + ;; (Debug) Show the reason for refusing the task request (DEBUG-STMTS 2 (if (not avail) (let ((from-str (array char BUFSIZE)) @@ -842,7 +874,6 @@ (csym::fprintf stderr "(%d): Thread %d refused treq from %s because %s.~%" (csym::get-universal-real-time) id from-str rsn-str)))) - (csym::pthread-mutex-unlock (ptr thr->rack-mut)) ;; If succeeded, push a task-home entry to the requestee's request queue. (if avail @@ -1335,7 +1366,7 @@ (csym::print-thread-status thr)) ;; all command check (csym::exit 0)) - + ;;; abrt: reply to a task message without the result ;;; abrt :")> (def (csym::recv-abrt pcmd) (csym::fn void (ptr (struct cmd))) @@ -1371,9 +1402,33 @@ (csym::pthread-mutex-unlock (ptr thr->mut)) (csym::send-command (ptr rcmd) 0 0)) ; Send rack -;;; cncl + +;;; cncl: set a cancellation to the recipient task +;;; cncl (def (csym::recv-cncl pcmd) (csym::fn void (ptr (struct cmd))) - (csym::exit 0)) + (def from-addr (ptr (enum addr))) ; return address of the task to be cancelled (search key) + (def dst0 (enum addr)) ; ID of recipient worker + (def thr (ptr (struct thread-data))) ; recipient worker thread + (def tx (ptr (struct task))) ; task to be cancelled + ;; Check # of arguments + (if (< pcmd->c 2) + (csym::proto-error "Wrong cncl" pcmd)) + ;; Get from the message + (= from-addr (aref pcmd->v 0)) + ;; Extract from the message + (= dst0 (aref pcmd->v 1 0)) + (if (not (and (<= 0 dst0) (< dst0 num-thrs))) ; Range check of + (csym::proto-error "Wrong cncl-head" pcmd)) + (= thr (+ threads dst0)) + + (csym::pthread-mutex-lock (ptr thr->mut)) + (if (= tx (csym::have-task thr from-addr pcmd->node)) ; Check whether the recipient task exists + (begin + (inc tx->cancellation) + (csym::set-cancelled thr tx 0) + (DEBUG-PRINT 1 "Task %p of worker %d is cancelled by cncl~%" tx dst0))) + (csym::pthread-mutex-unlock (ptr thr->mut)) +) ;;; bcak: ack message to bcst ;;; bcak @@ -1410,8 +1465,8 @@ (defs (array char BUFSIZE) buf1 buf2) (csym::fprintf stderr "%s= {" name) (for ((= cur task-top) cur (= cur cur->next)) - (csym::fprintf stderr "{stat=%s, task-no=%d, body=%p, ndiv=%d, rslt-to=%s, rslt-head=%s}, " - (aref task-stat-strings cur->stat) cur->task-no cur->body cur->ndiv + (csym::fprintf stderr "{stat=%s, task-no=%d, body=%p, ndiv=%d, cancellation=%d, rslt-to=%s, rslt-head=%s}, " + (aref task-stat-strings cur->stat) cur->task-no cur->body cur->ndiv cur->cancellation (exps (csym::node-to-string buf1 cur->rslt-to) buf1) (exps (csym::serialize-arg buf2 cur->rslt-head) buf2))) (csym::fprintf stderr "}, ") @@ -1423,10 +1478,12 @@ (defs (array char BUFSIZE) buf0 buf1 buf2) (csym::fprintf stderr "%s= {" name) (for ((= cur treq-top) cur (= cur cur->next)) - (csym::fprintf stderr "{stat=%s, id=%d, waiting=%s, owner=%p, task-no=%d, body=%p, req-from=%s, task-head=%s}, " + (csym::fprintf stderr "{stat=%s, id=%d, waiting=%s, owner=%p, eldest=%p(%d), task-no=%d, body=%p, req-from=%s, task-head=%s}, " (aref task-home-stat-strings cur->stat) cur->id (exps (csym::serialize-arg buf0 cur->waiting-head) buf0) - cur->owner cur->task-no cur->body + cur->owner + cur->eldest (if-exp cur->eldest cur->eldest->id 0) + cur->task-no cur->body (exps (csym::node-to-string buf1 cur->req-from) buf1) (exps (csym::serialize-arg buf2 cur->task-head) buf2))) (csym::fprintf stderr "}, ") @@ -1503,7 +1560,34 @@ (= -thr->exiting EXITING-SPAWN) (-bk) (= -thr->exiting EXITING-NORMAL) - (= -thr->req -thr->treq-top))) + (= -thr->req -thr->treq-top) )) + (csym::pthread-mutex-unlock (ptr -thr->mut))) + +;; Check -thr's subtask queue and send a cncl message for each flagged subtask +(def (handle-req-cncl -bk -thr) + (fn void (ptr (NESTFN int void)) (ptr (struct thread-data))) + (def rcmd (struct cmd)) ; for CNCL command + (def cur (ptr (struct task-home))) + (csym::pthread-mutex-lock (ptr -thr->mut)) + (= rcmd.w CNCL) + (= rcmd.c 2) + (= (aref rcmd.v 0 0) -thr->id) + (= (aref rcmd.v 0 2) TERM) + (if -thr->req-cncl + (begin + (DEBUG-PRINT 1 "(%d): (Thread %d) detected cncl message request~%" + (csym::get-universal-real-time) -thr->id) + (for ((= cur -thr->sub) cur (= cur cur->next)) + (if (and (== cur->msg-cncl 1) + (== cur->stat TASK-HOME-INITIALIZED)) + (begin + (= rcmd.node cur->req-from) + (= (aref rcmd.v 0 1) cur->id) ; =: + (csym::copy-address (aref rcmd.v 1) cur->task-head) ; + (csym::send-command (ptr rcmd) 0 0) + (= cur->msg-cncl 2) + ))) + (= -thr->req-cncl 0) )) (csym::pthread-mutex-unlock (ptr -thr->mut))) ;; Start propagating an exception. Invoked by a Tascell throw statement. @@ -1519,7 +1603,8 @@ (csym::pthread-mutex-lock (ptr -thr->mut)) (if -thr->task-top->cancellation (begin - (DEBUG-PRINT 1 "(%d): (Thread %d) detected cancellation flag (%d)~%" (csym::get-universal-real-time) -thr->id -thr->task-top->cancellation) + (DEBUG-PRINT 1 "(%d): (Thread %d) detected cancellation flag (%d)~%" + (csym::get-universal-real-time) -thr->id -thr->task-top->cancellation) (= -thr->exiting EXITING-CANCEL) (csym::pthread-mutex-unlock (ptr -thr->mut)) (-bk))) @@ -1531,8 +1616,10 @@ ;; (The recipient is determined by the top of the task request stack) ;; Called by a worker thread ("thr") after initializing the task object ;; in :put section ("body"). The thr->mut should have been acquired. -(def (csym::make-and-send-task thr task-no body) - (csym::fn void (ptr (struct thread-data)) int (ptr void)) +;; If "eldest-p" is non-zero, the task is the first one among tasks +;; spawned in a parallel region. +(def (csym::make-and-send-task thr task-no body eldest-p) + (csym::fn void (ptr (struct thread-data)) int (ptr void) int) (def tcmd (struct cmd)) (def hx (ptr (struct task-home)) thr->treq-top) ;; (csym::fprintf stderr "make-and-send-task(%d)~%" thr->id) @@ -1547,6 +1634,8 @@ (+ hx->next->id 1) 0)) (= hx->owner thr->task-top) ; the parent task (= current top of the task stack) + (= hx->eldest (if-exp eldest-p hx hx->next->eldest)) + (= hx->msg-cncl 0) ; initialize flag to be cancelled (= hx->stat TASK-HOME-INITIALIZED) ; ALLOCATED => INITIALIZED ;; Make a task message (= tcmd.c 4) ; # of arguments @@ -1814,6 +1903,7 @@ (tx (ptr (struct task))) (hx (ptr (struct task-home)))) (= thr->req 0) + (= thr->req-cncl 0) (= thr->id i) (= thr->w-rack 0) (= thr->w-none 0) diff --git a/src/sample/tcell/worker.sh b/src/sample/tcell/worker.sh index 5647349e..7d94b20f 100644 --- a/src/sample/tcell/worker.sh +++ b/src/sample/tcell/worker.sh @@ -197,23 +197,29 @@ (def stat (enum task-home-stat)) ; status (def id int) ; ID (unique in each worker) (def exception-tag int) ; thrown exception value (when stat is TASK-HOME-EXCEPTION) + (def msg-cncl int) ; a request flag for a cncl message + ; 1: a cncl message would be sent for this subtask + ; 2: the cncl message is already sent (def waiting-head (array (enum addr) ARG-SIZE-MAX)) ; for stealing-back treq, the task head of which ; the requester is waiting for the result (def owner (ptr (struct task))) ; the task that spawned this subtask + (def eldest (ptr (struct task-home))) ; the task-home that is first spawned + ; in a parallel region (def task-no int) ; task number (corresponds to a task function) (def req-from (enum node)) ; where to send this subtask (INSIDE or OUTSIDE) (def task-head (array (enum addr) ARG-SIZE-MAX)) ; the address of the worker which this task is sent to ; (referred when sending stealing back "treq" or "rack") - (def next (ptr (struct task-home))) ; link to the next task-home + (def next (ptr (struct task-home))) ; link to the next (older) task-home (def body (ptr void)) ; task object ) (def (struct thread-data) (def id int) ; worker ID (def pthr-id pthread-t) ; pthread assigned to the worker - (def req (ptr (struct task-home))) ; flag to check whether there are any task requests + (def req (ptr (struct task-home))) ; request to check task request queue and spawn tasks if needed + (def req-cncl int) ; request to check subtask stack and send cncl messages if needed (def w-rack int) ; # of rack messages to be received (def w-none int) ; # of none messages to be received (def ndiv int) ; # of division of the task being executed by this worker @@ -256,8 +262,8 @@ ) ;;;; Declarations of functions in worker.sc -(decl (csym::make-and-send-task thr task-no body) - (csym::fn void (ptr (struct thread-data)) int (ptr void))) +(decl (csym::make-and-send-task thr task-no body eldest-p) + (csym::fn void (ptr (struct thread-data)) int (ptr void) int)) (decl (wait-rslt thr stback) (fn (ptr void) (ptr (struct thread-data)) int)) (decl (csym::broadcast-task thr task-no body) (csym::fn void (ptr (struct thread-data)) int (ptr void))) From 0b221acea98c25a0834c4d53cbe9123759c03519 Mon Sep 17 00:00:00 2001 From: tasuku Date: Wed, 24 Sep 2014 09:52:07 +0900 Subject: [PATCH 007/105] Implemented sending cancellation message when propagating an exception --- src/sample/tcell/Makefile | 2 +- src/sample/tcell/worker.sc | 85 +++++++++++++++++++++----------------- 2 files changed, 49 insertions(+), 38 deletions(-) diff --git a/src/sample/tcell/Makefile b/src/sample/tcell/Makefile index cf99ade7..aa277359 100644 --- a/src/sample/tcell/Makefile +++ b/src/sample/tcell/Makefile @@ -10,7 +10,7 @@ GCC=gcc #$(XCC) # Command for Intel C Compiler ICC=icc # Optimization options for C Compilers -OPT=-O3 -g -msse4.2$(MOPT) +OPT=-O2 -g -msse4.2 $(MOPT) # Keyword for L-Closures and Closures in XC Cube. Don't modify. XCCOPT=-DCT=lightweight diff --git a/src/sample/tcell/worker.sc b/src/sample/tcell/worker.sc index ba53a4d0..155088b5 100644 --- a/src/sample/tcell/worker.sc +++ b/src/sample/tcell/worker.sc @@ -1478,8 +1478,9 @@ (defs (array char BUFSIZE) buf0 buf1 buf2) (csym::fprintf stderr "%s= {" name) (for ((= cur treq-top) cur (= cur cur->next)) - (csym::fprintf stderr "{stat=%s, id=%d, waiting=%s, owner=%p, eldest=%p(%d), task-no=%d, body=%p, req-from=%s, task-head=%s}, " + (csym::fprintf stderr "{stat=%s, id=%d, exception-tag=%d, msg-cncl=%d, waiting=%s, owner=%p, eldest=%p(%d), task-no=%d, body=%p, req-from=%s, task-head=%s}, " (aref task-home-stat-strings cur->stat) cur->id + cur->exception-tag cur->msg-cncl (exps (csym::serialize-arg buf0 cur->waiting-head) buf0) cur->owner cur->eldest (if-exp cur->eldest cur->eldest->id 0) @@ -1491,7 +1492,7 @@ ;;; Print the status of a worker in human-friendly style (def (csym::print-thread-status thr) (csym::fn void (ptr (struct thread-data))) - (csym::fprintf stderr "~%" thr->id) + (csym::fprintf stderr "*** Worker %d ***~%" thr->id) (csym::fprintf stderr "req=%p, " thr->req) (csym::fprintf stderr "w-rack=%d, " thr->w-rack) (csym::fprintf stderr "w-none=%d, " thr->w-none) @@ -1563,30 +1564,39 @@ (= -thr->req -thr->treq-top) )) (csym::pthread-mutex-unlock (ptr -thr->mut))) -;; Check -thr's subtask queue and send a cncl message for each flagged subtask -(def (handle-req-cncl -bk -thr) - (fn void (ptr (NESTFN int void)) (ptr (struct thread-data))) +;; Send a cncl message for each flagged subtask spawned by "thr" +;; The mutex thr->mut must be acquired before calling. +;; Returns # of sent cncl messages. +(def (csym::send-cncl-for-flagged-subtasks thr) + (csym::fn int (ptr (struct thread-data))) (def rcmd (struct cmd)) ; for CNCL command (def cur (ptr (struct task-home))) - (csym::pthread-mutex-lock (ptr -thr->mut)) + (def count int 0) (= rcmd.w CNCL) (= rcmd.c 2) - (= (aref rcmd.v 0 0) -thr->id) + (= (aref rcmd.v 0 0) thr->id) (= (aref rcmd.v 0 2) TERM) + (for ((= cur thr->sub) cur (= cur cur->next)) + (if (and (== cur->msg-cncl 1) + (== cur->stat TASK-HOME-INITIALIZED)) + (begin + (= rcmd.node cur->req-from) + (= (aref rcmd.v 0 1) cur->id) ; =: + (csym::copy-address (aref rcmd.v 1) cur->task-head) ; + (csym::send-command (ptr rcmd) 0 0) + (= cur->msg-cncl 2) + (inc count) ))) + (return count) ) + +;; Check -thr's subtask queue and send a cncl message for each flagged subtask +(def (handle-req-cncl -bk -thr) + (fn void (ptr (NESTFN int void)) (ptr (struct thread-data))) + (csym::pthread-mutex-lock (ptr -thr->mut)) (if -thr->req-cncl (begin (DEBUG-PRINT 1 "(%d): (Thread %d) detected cncl message request~%" (csym::get-universal-real-time) -thr->id) - (for ((= cur -thr->sub) cur (= cur cur->next)) - (if (and (== cur->msg-cncl 1) - (== cur->stat TASK-HOME-INITIALIZED)) - (begin - (= rcmd.node cur->req-from) - (= (aref rcmd.v 0 1) cur->id) ; =: - (csym::copy-address (aref rcmd.v 1) cur->task-head) ; - (csym::send-command (ptr rcmd) 0 0) - (= cur->msg-cncl 2) - ))) + (csym::send-cncl-for-flagged-subtasks -thr) (= -thr->req-cncl 0) )) (csym::pthread-mutex-unlock (ptr -thr->mut))) @@ -1663,27 +1673,28 @@ (!= sub->stat TASK-HOME-EXCEPTION) (!= sub->stat TASK-HOME-ABORTED)) (= thr->task-top->stat TASK-SUSPENDED) ; STARTED => SUSPENDED (thr->task-top is the task being executed) - (if stback - ;; If stealing back is enabled + ;; When propagating exception, send cncl messages for subtasks + (if (== thr->exiting EXITING-EXCEPTION) (begin - ;; Wait for a moment if the victim is an external worker. - (if (== OUTSIDE sub->req-from) - (let ((now (struct timeval)) - (t-until (struct timespec))) - (csym::gettimeofday (ptr now) 0) - (csym::timeval-plus-nsec-to-timespec (ptr t-until) (ptr now) 1000) - (csym::pthread-cond-timedwait (ptr thr->cond-r) (ptr thr->mut) - (ptr t-until)) - )) - ;; Quit if the subtask is finished or aborted. - (if (or (== sub->stat TASK-HOME-DONE) - (== sub->stat TASK-HOME-EXCEPTION) - (== sub->stat TASK-HOME-ABORTED)) - (break)) - ;; Steal and execute a task - (recv-exec-send thr sub->task-head sub->req-from)) - ;; If stealing back is disabled, just wait for the result. - (csym::pthread-cond-wait (ptr thr->cond-r) (ptr thr->mut))) + (csym::set-cancelled thr thr->task-top sub->eldest) + (csym::send-cncl-for-flagged-subtasks thr))) + ;; Wait for a moment if the victim is an external worker. + (if (== OUTSIDE sub->req-from) + (let ((now (struct timeval)) + (t-until (struct timespec))) + (csym::gettimeofday (ptr now) 0) + (csym::timeval-plus-nsec-to-timespec (ptr t-until) (ptr now) 1000) + (csym::pthread-cond-timedwait (ptr thr->cond-r) (ptr thr->mut) + (ptr t-until)) + )) + ;; Quit if the subtask is finished or aborted. + (if (or (== sub->stat TASK-HOME-DONE) + (== sub->stat TASK-HOME-EXCEPTION) + (== sub->stat TASK-HOME-ABORTED)) + (break)) + ;; Steal and execute a task + (if stback + (recv-exec-send thr sub->task-head sub->req-from)) ) ;; When the subtask has thrown an exception, propagate it From 40daf9b174c45bf92e304b83bbf592ceb4dc967a Mon Sep 17 00:00:00 2001 From: tasuku Date: Wed, 24 Sep 2014 12:48:59 +0900 Subject: [PATCH 008/105] Fixed a but that woker does not exit stealing back loop when the waiting task finished by an exception of cancellation --- src/sample/tcell/fib-excep.tcell | 11 ++++++----- src/sample/tcell/pen-excep.tcell | 2 +- src/sample/tcell/worker.sc | 18 ++++++++++++------ 3 files changed, 19 insertions(+), 12 deletions(-) diff --git a/src/sample/tcell/fib-excep.tcell b/src/sample/tcell/fib-excep.tcell index 7f27ff31..cc191719 100644 --- a/src/sample/tcell/fib-excep.tcell +++ b/src/sample/tcell/fib-excep.tcell @@ -111,11 +111,6 @@ (array "EXITING-NORMAL" "EXITING-EXCEPTION" "EXITING-CANCEL" "EXITING-SPAWN")) (def (fib n) (wfn int int) - ;; When non-zero is thrown here, the exception is not caught in task-body - ;; and thus execution time is not printed. - (if (and (== WORKER-ID 1) - (== n 10)) - (throw 3)) (if (<= n 2) (return 1) (begin @@ -136,4 +131,10 @@ (:after (csym::fprintf stderr "%d exinting fib(%d): %s~%" WORKER-ID n (aref rsn-strings EXITING)))) + ;; Throw an exception if the intermediate sum exceeds an arbitrary value. + (if (>= (+ s1 s2) 10000) + (begin + (csym::fprintf stderr "Worker %d throws an exception %d~%" + WORKER-ID WORKER-ID) + (throw WORKER-ID))) (return (+ s1 s2))))) diff --git a/src/sample/tcell/pen-excep.tcell b/src/sample/tcell/pen-excep.tcell index 6b5b1cb3..6966ea82 100644 --- a/src/sample/tcell/pen-excep.tcell +++ b/src/sample/tcell/pen-excep.tcell @@ -219,5 +219,5 @@ (= this.i2 i2)) (:get (+= s this.r)))) - (if (> s 100) (throw 0)) + (if (> s 100) (throw WORKER-ID)) (return s)) diff --git a/src/sample/tcell/worker.sc b/src/sample/tcell/worker.sc index 155088b5..bdae0d15 100644 --- a/src/sample/tcell/worker.sc +++ b/src/sample/tcell/worker.sc @@ -421,8 +421,10 @@ ;; stop getting a new task and resume the suspended task. (if (and (!= tx->stat TASK-INITIALIZED) thr->sub - (== thr->sub->stat TASK-HOME-DONE)) - ;; The worker sent a treq and its response may not have arrived. + (or (== thr->sub->stat TASK-HOME-DONE) + (== thr->sub->stat TASK-HOME-EXCEPTION) + (== thr->sub->stat TASK-HOME-ABORTED))) + ;; The worker sent a treq and its response may not have arrived. ;; However, we can guarantee that the response is "none" because ;; this treq is a stealing back and the result of the spawned task ;; that caused the stealing back has been sent (and received). @@ -465,7 +467,9 @@ ;; If the most recent spawned task has been completed, ;; stop getting a new task and resume the suspended task. (if (and thr->sub - (== thr->sub->stat TASK-HOME-DONE)) + (or (== thr->sub->stat TASK-HOME-DONE) + (== thr->sub->stat TASK-HOME-EXCEPTION) + (== thr->sub->stat TASK-HOME-ABORTED))) (return 0)))) ) (return 1)) @@ -1691,10 +1695,12 @@ (if (or (== sub->stat TASK-HOME-DONE) (== sub->stat TASK-HOME-EXCEPTION) (== sub->stat TASK-HOME-ABORTED)) - (break)) - ;; Steal and execute a task + (break)) (if stback - (recv-exec-send thr sub->task-head sub->req-from)) + ;; Steal and execute a task + (recv-exec-send thr sub->task-head sub->req-from) + ;; Just wait for the subtask finishing + (csym::pthread-cond-wait (ptr thr->cond-r) (ptr thr->mut))) ) ;; When the subtask has thrown an exception, propagate it From 90e517c04c29fc678ecf5f5fdec031600bc3cfce Mon Sep 17 00:00:00 2001 From: tasuku Date: Wed, 24 Sep 2014 13:36:52 +0900 Subject: [PATCH 009/105] Fixed a bug in Makefile --- src/sample/tcell/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/sample/tcell/Makefile b/src/sample/tcell/Makefile index 8bea80ec..25431bf5 100644 --- a/src/sample/tcell/Makefile +++ b/src/sample/tcell/Makefile @@ -6,7 +6,7 @@ XCC=xcc GCC=gcc #$(XCC) ICC=icc # Optimization options for C Compilers -OPT=-O3 -g -msse4.2$ (MOPT) +OPT=-O3 -g -msse4.2 $(MOPT) XCCOPT=-DCT=lightweight XCCCLOPT=-DCT=closure From e36bd15c7f2b3e9e1ec989ee0cf8be45c67d53b4 Mon Sep 17 00:00:00 2001 From: tasuku Date: Wed, 24 Sep 2014 14:32:12 +0900 Subject: [PATCH 010/105] Updated references to EXITING/BACKTRACKING copine?.tcell pseudo variables to fit the new specification of EXITING --- eli/tcell-mode.el | 4 +++- src/c2scpp/src/set_mcpp.sh | 0 src/c2scpp/src/unset_mcpp.sh | 0 src/c2scpp/tests/after_test.sh | 0 src/c2scpp/tests/set_test.sh | 0 src/sample/tcell/copine1.tcell | 4 ++-- src/sample/tcell/copine2.tcell | 4 ++-- src/sample/tcell/copine3.tcell | 4 ++-- src/sample/tcell/copine4.tcell | 9 +++++---- src/sample/tcell/mk-hostnames.pl | 0 10 files changed, 14 insertions(+), 11 deletions(-) mode change 100755 => 100644 src/c2scpp/src/set_mcpp.sh mode change 100755 => 100644 src/c2scpp/src/unset_mcpp.sh mode change 100755 => 100644 src/c2scpp/tests/after_test.sh mode change 100755 => 100644 src/c2scpp/tests/set_test.sh mode change 100755 => 100644 src/sample/tcell/mk-hostnames.pl diff --git a/eli/tcell-mode.el b/eli/tcell-mode.el index ef9d924c..99d1df08 100644 --- a/eli/tcell-mode.el +++ b/eli/tcell-mode.el @@ -107,7 +107,9 @@ ;; pseudo variables (,(concat "\\<" (regexp-opt - '("PROBABILITY" "WDATA" "WORKER-ID" "EXITING" "this") t) + '("PROBABILITY" "WDATA" "WORKER-ID" "EXITING" + "EXITING-NORMAL" "EXITING-EXCEPTION" "EXITING-CANCEL" "EXITING-SPAWN" + "this") t) "\\(\\.\\sw+\\)?\\>") (1 tcell-variable-name-face)) )))) diff --git a/src/c2scpp/src/set_mcpp.sh b/src/c2scpp/src/set_mcpp.sh old mode 100755 new mode 100644 diff --git a/src/c2scpp/src/unset_mcpp.sh b/src/c2scpp/src/unset_mcpp.sh old mode 100755 new mode 100644 diff --git a/src/c2scpp/tests/after_test.sh b/src/c2scpp/tests/after_test.sh old mode 100755 new mode 100644 diff --git a/src/c2scpp/tests/set_test.sh b/src/c2scpp/tests/set_test.sh old mode 100755 new mode 100644 diff --git a/src/sample/tcell/copine1.tcell b/src/sample/tcell/copine1.tcell index 8a62bfae..c46ad3e8 100644 --- a/src/sample/tcell/copine1.tcell +++ b/src/sample/tcell/copine1.tcell @@ -435,7 +435,7 @@ (+= (fref pTsk -> numC) cc) (inc (fref pTsk -> numT)) - (if BACKTRACKING + (if (== EXITING EXITING-SPAWN) (begin (for ((= j 0) (<= j i) (inc j)) (inc (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) (- (- numC j) 1)))))))) @@ -452,7 +452,7 @@ (for ((= j 0) (< j (fref pTsk -> numC)) (inc j)) (dec (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j))))) (:after - (if BACKTRACKING + (if (== EXITING EXITING-SPAWN) (begin (for ((= j 0) (<= j i) (inc j)) (dec (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) (- (- numC j) 1))))))) diff --git a/src/sample/tcell/copine2.tcell b/src/sample/tcell/copine2.tcell index 0fd31d25..ed2fa8a1 100644 --- a/src/sample/tcell/copine2.tcell +++ b/src/sample/tcell/copine2.tcell @@ -436,7 +436,7 @@ (+= (fref pTsk -> numC) cc) (inc (fref pTsk -> numT)) - (if BACKTRACKING + (if (== EXITING EXITING-SPAWN) (begin (for ((= j 0) (<= j i) (inc j)) (inc (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) (- (- numC j) 1)))))))) @@ -453,7 +453,7 @@ (for ((= j 0) (< j (fref pTsk -> numC)) (inc j)) (dec (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j))))) (:after - (if BACKTRACKING + (if (== EXITING EXITING-SPAWN) (begin (for ((= j 0) (<= j i) (inc j)) (dec (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) (- (- numC j) 1))))))) diff --git a/src/sample/tcell/copine3.tcell b/src/sample/tcell/copine3.tcell index 9e1f2088..8c009b4b 100644 --- a/src/sample/tcell/copine3.tcell +++ b/src/sample/tcell/copine3.tcell @@ -719,7 +719,7 @@ (+= (fref pTsk -> numC) cc) (inc (fref pTsk -> numT)) - (if BACKTRACKING + (if (== EXITING EXITING-SPAWN) (begin (for ((= j 0) (<= j i) (inc j)) (inc (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) (- (- numC j) 1)))))))) @@ -741,7 +741,7 @@ (for ((= j 0) (< j (fref pTsk -> numC)) (inc j)) (dec (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j))))) (:after - (if BACKTRACKING + (if (== EXITING EXITING-SPAWN) (begin (for ((= j 0) (<= j i) (inc j)) (dec (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) (- (- numC j) 1))))))) diff --git a/src/sample/tcell/copine4.tcell b/src/sample/tcell/copine4.tcell index b0a00ba7..f6758187 100644 --- a/src/sample/tcell/copine4.tcell +++ b/src/sample/tcell/copine4.tcell @@ -893,7 +893,7 @@ (+= (fref pTsk -> numC) cc) (inc (fref pTsk -> numT)) - (if BACKTRACKING + (if (== EXITING EXITING-SPAWN) (begin (for ((= j 0) (<= j i) (inc j)) (inc (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) (- (- numC j) 1)))))))) @@ -928,7 +928,8 @@ (csym::pthread_mutex_unlock (ptr (aref excpMutex (fref -thr -> id)))) (= (aref flagQe (fref -thr -> id)) 0)))) (:after - (if EXITING + (if (or (== EXITING EXITING-CANCEL) + (== EXITING EXITING-EXCEPTION)) (begin (%if* DEBUG-LOCK (begin (= locked 0))) @@ -948,7 +949,7 @@ (csym::removeITnode (ptr (aref vItemTable vv)) ITadd) (csym::pthread_mutex_unlock (ptr (aref itMutex vv))))) - (if (and (not BACKTRACKING) (not EXITING)) + (if (== EXITING EXITING-NORMAL) (begin (%if* DEBUG-LOCK (begin (= locked 0))) @@ -971,7 +972,7 @@ (csym::removeITnode (ptr (aref vItemTable vv)) ITadd))) (csym::pthread_mutex_unlock (ptr (aref itMutex vv))))) - (if (or BACKTRACKING EXITING) + (if (!= EXITING EXITING-NORMAL) (begin (for ((= j 0) (<= j i) (inc j)) (dec (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) (- (- numC j) 1))))))) diff --git a/src/sample/tcell/mk-hostnames.pl b/src/sample/tcell/mk-hostnames.pl old mode 100755 new mode 100644 From 00563f31ea699d8c7480067874d30c082ba9b71a Mon Sep 17 00:00:00 2001 From: tasuku Date: Wed, 24 Sep 2014 19:59:41 +0900 Subject: [PATCH 011/105] Fixed a small bug in sock.c --- src/sample/tcell/sock.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/sample/tcell/sock.c b/src/sample/tcell/sock.c index b9c280ee..b4423c88 100644 --- a/src/sample/tcell/sock.c +++ b/src/sample/tcell/sock.c @@ -349,7 +349,7 @@ int connect_to (char *hostname, unsigned short port) perror ("connection"); exit (1); } - fprintf(stderr, "Ok\n", hostname, port); + fprintf(stderr, "Ok\n"); /* test */ /* send(dstSocket, "Test", strlen("Test")+1, 0); */ /* close(dstSocket); */ From e22068af4dfa944f27e486f959fe17ae8a07faea Mon Sep 17 00:00:00 2001 From: tasuku Date: Thu, 25 Sep 2014 21:19:53 +0900 Subject: [PATCH 012/105] Reverted undesired changes in tcell/Makefile at Revision (a02031c925f2) --- src/sample/tcell/Makefile | 25 ++++++++++++++++--------- 1 file changed, 16 insertions(+), 9 deletions(-) diff --git a/src/sample/tcell/Makefile b/src/sample/tcell/Makefile index 25431bf5..6b137246 100644 --- a/src/sample/tcell/Makefile +++ b/src/sample/tcell/Makefile @@ -1,21 +1,29 @@ OS=${shell uname} # Command for sc2c compiler SC2C=sc2c +# set -m option not to remove intermediate files SC2C_OPT= +# Command for XC Cube (an extended GCC that supports L-Closures and Closures) XCC=xcc +# Command for gcc GCC=gcc #$(XCC) +# Command for Intel C Compiler ICC=icc # Optimization options for C Compilers OPT=-O3 -g -msse4.2 $(MOPT) + +# Keyword for L-Closures and Closures in XC Cube. Don't modify. XCCOPT=-DCT=lightweight XCCCLOPT=-DCT=closure +# setaffinity options ifeq ($(OS),SunOS) SC2C_OPT += -D USE_AFFINITY=PBIND -else +else ifeq ($(OS),Linux) SC2C_OPT += -D USE_AFFINITY=SCHED endif +# library options ifeq ($(OS),SunOS) THROPTS=-lthread else @@ -26,6 +34,7 @@ ifeq ($(OS),SunOS) LIBOPTS += -lsocket -lnsl endif +# Use vsnprintf() instead of vasprintf(). ifeq ($(OS),SunOS) OPT += -DNO_VASPRINTF endif @@ -138,11 +147,9 @@ $(addsuffix .c,$(XCCCL_PROGS)): %-xcccl.c: %.tcell $(XCCCL_PROGS): %: $(WORKER_XCCCL) $(LIBS) %.c $(XCC) $(OPT) $+ $(LIBOPTS) -o $@ - - -# demo -# pen-demo: $(WORKER_GCC) pen-gcc-gtk.c $(LIBS) -# $(GCC) $(OPT) $(THROPT) $(WORKER_GCC) pen-gcc-gtk.c $(LIBS) -o pen-demo `pkg-config --cflags --libs gtk+-2.0` - -# clean: -# rm -f $(PROGS) +# "make clean" to delete all target files +clean: + rm -f $(ALL_PROGS) +# "make clean" to delete all target files and intermediate files +allclean: + rm -f $(ALL_PROGS) cinclude_tmp.h cinclude_tmp.se cinclude_tmp.se1 cinclude_tmp.se2 cinclude_tmp.se3 cinclude_tmp.se4 cinclude_tmp.se5 cinclude_tmp.se6 cinclude_tmp.se7 From 911f209a09b1e0ecbfe7957f2cc07993d2779f53 Mon Sep 17 00:00:00 2001 From: tasuku Date: Mon, 29 Sep 2014 14:15:10 +0900 Subject: [PATCH 013/105] Now SC preprocessor applies preprocessor directives included in results of macro expansion --- src/scpp.lsp | 47 ++++++++++++++++++++++++++++------------------- 1 file changed, 28 insertions(+), 19 deletions(-) diff --git a/src/scpp.lsp b/src/scpp.lsp index 63d1c410..e49b09cd 100644 --- a/src/scpp.lsp +++ b/src/scpp.lsp @@ -70,6 +70,9 @@ (defvar *sc2c-modifier* #'identity) ; sc-main から渡される関数．sc2cに使うルールを変更する． (defvar *ofile-modifier* #'identity) ; sc-main から渡される関数．出力ファイル名を変更する． +(defvar *extracting-macro* (list)) ; List of macro symbols currently being extracted. + ; (Such macros are not extracted more than onece recursively) + (defstruct (macro-entry (:constructor create-macro-entry (type value))) type ; one of {constant macro} @@ -220,10 +223,9 @@ (string-begin-with "%%" (symbol-name x) nil)) '()) (t - (with1 expand-ret (scpp-macroexpand x) - (if (atom expand-ret) - (list expand-ret) - (list (scpp-list expand-ret))))))) + ;; Macro expansion and recursive application of scpp-exp1. + (scpp-macroexpand x)) + )) ;; *cinclude-h-file* を作成 (defun make-cinclude-h (header-list @@ -314,33 +316,40 @@ (fmakunbound macsymbol) (remhash macsymbol *macro-entries*)) -;; 適用 -;; fref-idの展開や，identifierのnormalizeもここで +;; Macro expansion and recursive application of scpp-exp1. +;; Simple annotation for field references (e.g., "obj.a->b") is +;; also expanded here (to "(fref (mref (fref obj a)) b)"). +;; When there is any expansion applied, scpp-exp1/scpp-list is applied +;; recursively. (defun scpp-macroexpand (x - &key (extracting-macro '()) ; 展開を行わないマクロ &aux macsymbol macentry) (cond ((symbolp x) ; constant macro (multiple-value-bind (fref-exp expanded-p) (expand-fref-symbol x) (cond - (expanded-p (scpp-macroexpand fref-exp)) + ;; Simple annotation for field references + (expanded-p + (scpp-1exp fref-exp)) (t (setq macsymbol (entry-and-normalize-id x)) - (if (and (not (member macsymbol extracting-macro)) + (if (and (not (member macsymbol *extracting-macro*)) (setq macentry (macro-find macsymbol)) (eq 'constant (macro-entry-type macentry))) - (scpp-macroexpand (macro-entry-value macentry) - :extracting-macro (cons macsymbol extracting-macro)) - macsymbol))))) + ;; Symbol macro (by %defconstant) + (let ((*extracting-macro* (cons macsymbol *extracting-macro*))) + (scpp-1exp (macro-entry-value macentry))) + ;; Other symbol + (list macsymbol)))))) ((consp x) ; ( ... ) (if (and (symbolp (car x)) (setq macsymbol (entry-and-normalize-id (car x))) - (not (member macsymbol extracting-macro)) + (not (member macsymbol *extracting-macro*)) (setq macentry (macro-find macsymbol)) (eq 'macro (macro-entry-type macentry))) - ;; マクロ - (scpp-macroexpand (macroexpand-1 (cons macsymbol (cdr x))) - :extracting-macro (cons macsymbol extracting-macro)) - x)) - ;; symbol以外のatom（number, stringなど） - (t x))) + ;; Macro (by %defmacro) + (let ((*extracting-macro* (cons macsymbol *extracting-macro*))) + (scpp-1exp (macroexpand-1 (cons macsymbol (cdr x))))) + ;; Cons to which no macro can be applied. + (list (scpp-list x)))) + ;; Atom other than symbol (e.g., number string) + (t (list x)))) From b36ac72724be0b2353c7cb1630ced78d3a71cd46 Mon Sep 17 00:00:00 2001 From: tasuku Date: Mon, 29 Sep 2014 14:31:40 +0900 Subject: [PATCH 014/105] Implemented profiling mode for Tascell. Validate by compiling by 'make SC2C_OPT="-D PROFILE=1" -B ' --- src/rule/tcell-defs.lsp | 8 ++- src/rule/tcell.rule | 16 ++++- src/sample/tcell/Makefile | 5 +- src/sample/tcell/dprint.sh | 9 +++ src/sample/tcell/worker.sc | 117 +++++++++++++++++++++++++++++++++++-- src/sample/tcell/worker.sh | 40 +++++++++++++ 6 files changed, 182 insertions(+), 13 deletions(-) diff --git a/src/rule/tcell-defs.lsp b/src/rule/tcell-defs.lsp index f55b3590..aa0e4d73 100644 --- a/src/rule/tcell-defs.lsp +++ b/src/rule/tcell-defs.lsp @@ -157,7 +157,9 @@ (push (list id texp size) (task-info-output-vars (get-task task-or-scid)))) -;;; Generate the body of "task-body" method +;;; Generate the body of "task-body" method. +;;; The generated function is set to task-doers[] and called from +;;; recv-exec-send() in "worker.sc". (defun task-body-function (body &optional (task *current-task*)) (let ((id (do-task-id task)) (struct-id (task-struct-id task)) @@ -168,8 +170,8 @@ (list ;; Nested function ~(def (-bk) ,(nestfunc-type) - ;; * When worker is handling an exception, exit this task - ;; with returning an "abrt" message. + ;; * When worker is propagating an exception or cancelling the task, + ;; exit the task with returning an abort flag. (if (or (== -thr->exiting EXITING-EXCEPTION) (== -thr->exiting EXITING-CANCEL)) (begin diff --git a/src/rule/tcell.rule b/src/rule/tcell.rule index eada49dd..8742f331 100644 --- a/src/rule/tcell.rule +++ b/src/rule/tcell.rule @@ -42,10 +42,16 @@ ~(decl (handle-req) (fn void (ptr ,(tcell:nestfunc-type)) (ptr (struct thread-data)))) + ~(decl (handle-req-cncl) (fn void + (ptr ,(tcell:nestfunc-type)) + (ptr (struct thread-data)))) ~(decl (handle-exception) (fn void (ptr ,(tcell:nestfunc-type)) (ptr (struct thread-data)) long)) + ~(decl (handle-cancellation) (fn void + (ptr ,(tcell:nestfunc-type)) + (ptr (struct thread-data)))) ) pg ;; データ系の関数が定義されてなければ空定義の関数を追加する @@ -219,6 +225,7 @@ #+comment (ptr ,tdat-id)) (def ,spn-id int 0) ; すでに仕事をsendしていたら '1' (begin + ;; <-- Nestfunc start --- ;; Called for backtracking to handle a task request or an exception (def (,bk-id) ,(tcell:nestfunc-type) ;; If this nested function is called for abnormal exit: @@ -250,7 +257,7 @@ (csym::make-and-send-task -thr ,(tcell:task-no) pthis 1) (return 1))) (return 0)) - ;; ここから仕事本体 + ;; --- Nestfunc End --> ;; Polling for cancel message requests (if -thr->req-cncl ,(tcell:with-new-bk bk-id @@ -395,6 +402,7 @@ ~(begin (def pthis (ptr (struct ,(tcell:task-struct-id)))) ; 送信用 task-body (def ,spn-id int 0) ; 仕事を他所にsendしている数 + ;; <-- Nestfunc start --- ;; タスク要求がきたら呼ばれる (def (,bk-id) ,(tcell:nestfunc-type) (if (not ,spn-id) (,(tcell:latest-bk))) @@ -406,6 +414,7 @@ (inc ,spn-id) (csym::make-and-send-task -thr ,(tcell:task-no) pthis))) (return 0)) + ;; --- Nestfunc end --> (for (,(expression! init-exp) ,(expression! cond-exp) ,(expression! loop-exp)) (if -thr->req ; （ポーリング）タスク要求がきていたら ,(tcell:with-new-bk bk-id ; 分割を試みる @@ -490,7 +499,7 @@ (b-body (tcell:with-new-bk bk-id (function-body body)))) ~(begin (def ,label-id __label__) - (def ,catchval-id long) + (def ,catchval-id int) ,.(unless (ruleset-param 'no-nestfunc) (list ;; nestfunc: If worker is handling an exception and @@ -502,7 +511,8 @@ (== ,e-exp -thr->exception-tag)) (begin (= -thr->exiting EXITING-NORMAL) - (csym::pthread-mutex-unlock (ptr -thr->mut)) + (PROF-CODE + (csym::tcounter-change-state -thr TCOUNTER-EXEC)) (goto ,label-id)) (,(tcell:latest-bk)))))) (= ,catchval-id ,e-exp) diff --git a/src/sample/tcell/Makefile b/src/sample/tcell/Makefile index 6b137246..6eff60bb 100644 --- a/src/sample/tcell/Makefile +++ b/src/sample/tcell/Makefile @@ -1,8 +1,11 @@ OS=${shell uname} # Command for sc2c compiler SC2C=sc2c -# set -m option not to remove intermediate files +# Options for SC-to-C compiler SC2C_OPT= +# SC2C_OPT=-m # don't remove intermediate files +# SC2C_OPT="-D DEBUG=0" # invalidate debugging code +# SC2C_OPT="-D PROFILE=1" # validate profiling code # Command for XC Cube (an extended GCC that supports L-Closures and Closures) XCC=xcc # Command for gcc diff --git a/src/sample/tcell/dprint.sh b/src/sample/tcell/dprint.sh index 8a406b1d..65b3e56a 100644 --- a/src/sample/tcell/dprint.sh +++ b/src/sample/tcell/dprint.sh @@ -8,3 +8,12 @@ %else (%defmacro DEBUG-STMTS (n &rest stmts) `(begin)) (%defmacro DEBUG-PRINT (n &rest args) `(begin))) + +;;; Profiler +(%ifndef* PROFILE + (%defconstant PROFILE 0)) ; non-nil: Profiler ON +(%if* PROFILE + (%defmacro PROF-CODE (&rest stmts) `(%splice ,@stmts)) + %else + (%defmacro PROF-CODE (n &rest stmts) `(%splice)) + ) diff --git a/src/sample/tcell/worker.sc b/src/sample/tcell/worker.sc index bdae0d15..404f3a86 100644 --- a/src/sample/tcell/worker.sc +++ b/src/sample/tcell/worker.sc @@ -122,6 +122,12 @@ (csym::gettimeofday (ptr now) 0) (return (+ (* 1000 1000 now.tv-sec) now.tv-usec))) +;;; Get diff time between two timevals (tp1-tp2) as a double value. +(def (csym::diff-timevals tp1 tp2) + (fn double (ptr (struct timeval)) (ptr (struct timeval))) + (return (+ (- tp1->tv-sec tp2->tv-sec) + (* 0.000001 (- tp1->tv-usec tp2->tv-usec))))) + ;;; Output the error message (str) to stderr (def (csym::proto-error str pcmd) (csym::fn void (ptr (const char)) (ptr (struct cmd))) (def i int) @@ -211,7 +217,10 @@ (csym::pthread-mutex-unlock (ptr send-mut)) ;; ---> sender-lock ---> (if (and (== w RSLT) option.auto-exit) - (csym::exit 0)) + (begin + (PROF-CODE + (csym::show-tcounter)) + (csym::exit 0))) ) ;;; Take cmd and call the function corresponding to its command name. @@ -506,6 +515,8 @@ (if (csym::send-treq-to-initialize-task thr treq-head req-to) (begin ;; Execute the task + (PROF-CODE + (csym::tcounter-change-state thr TCOUNTER-EXEC)) (= tx->stat TASK-STARTED) ; TASK-INITIALIZED => TASK-STARTED (= tx->cancellation 0) ; initialize # of cancellation flags (= old-ndiv thr->ndiv) @@ -619,9 +630,12 @@ (%ifdef* USE-AFFINITY (if option.affinity (csym::worker-setaffinity thr->id))) - (csym::worker-init thr) + (csym::worker-init thr) ; initialize app-defined worker local storage (csym::pthread-mutex-lock (ptr thr->mut)) (loop + (PROF-CODE + (if (!= thr->tcnt-stat TCOUNTER-INIT) + (csym::tcounter-change-state thr TCOUNTER-TREQ-ANY))) (recv-exec-send thr (init (array (enum addr) 2) (array ANY TERM)) INSIDE)) (csym::pthread-mutex-unlock (ptr thr->mut))) @@ -1563,7 +1577,11 @@ (if -thr->req (begin (= -thr->exiting EXITING-SPAWN) + (PROF-CODE + (csym::tcounter-change-state -thr TCOUNTER-SPWN)) (-bk) + (PROF-CODE + (csym::tcounter-change-state -thr TCOUNTER-EXEC)) (= -thr->exiting EXITING-NORMAL) (= -thr->req -thr->treq-top) )) (csym::pthread-mutex-unlock (ptr -thr->mut))) @@ -1609,6 +1627,8 @@ (fn void (ptr (NESTFN int void)) (ptr (struct thread-data)) int) (= -thr->exiting EXITING-EXCEPTION) (= -thr->exception-tag excep) + (PROF-CODE + (csym::tcounter-change-state -thr TCOUNTER-ABRT)) (-bk)) ; never returns ;; Check (partial) cancellation flags and abort if needed. @@ -1620,6 +1640,8 @@ (DEBUG-PRINT 1 "(%d): (Thread %d) detected cancellation flag (%d)~%" (csym::get-universal-real-time) -thr->id -thr->task-top->cancellation) (= -thr->exiting EXITING-CANCEL) + (PROF-CODE + (csym::tcounter-change-state -thr TCOUNTER-ABRT)) (csym::pthread-mutex-unlock (ptr -thr->mut)) (-bk))) (csym::pthread-mutex-unlock (ptr -thr->mut)) @@ -1671,11 +1693,21 @@ (def (wait-rslt thr stback) (fn (ptr void) (ptr (struct thread-data)) int) (def body (ptr void)) (def sub (ptr (struct task-home))) + (PROF-CODE + (def tcnt-stat (enum tcounter)) + (def tcnt-stat-w (enum tcounter))) (csym::pthread-mutex-lock (ptr thr->mut)) + (PROF-CODE + (= tcnt-stat thr->tcnt-stat)) (= sub thr->sub) ; sub: the top of the worker's subtask stack (while (and (!= sub->stat TASK-HOME-DONE) ; Until the subtask is done/aborted (!= sub->stat TASK-HOME-EXCEPTION) (!= sub->stat TASK-HOME-ABORTED)) + (PROF-CODE + (= tcnt-stat-w (if-exp (== tcnt-stat TCOUNTER-EXEC) + TCOUNTER-WAIT + TCOUNTER-ABRT-WAIT)) + (csym::tcounter-change-state thr tcnt-stat-w)) (= thr->task-top->stat TASK-SUSPENDED) ; STARTED => SUSPENDED (thr->task-top is the task being executed) ;; When propagating exception, send cncl messages for subtasks (if (== thr->exiting EXITING-EXCEPTION) @@ -1698,17 +1730,25 @@ (break)) (if stback ;; Steal and execute a task - (recv-exec-send thr sub->task-head sub->req-from) + (begin + (PROF-CODE + (csym::tcounter-change-state thr TCOUNTER-TREQ-BK)) + (recv-exec-send thr sub->task-head sub->req-from) + (PROF-CODE + (csym::tcounter-change-state thr tcnt-stat-w)) + ) ;; Just wait for the subtask finishing (csym::pthread-cond-wait (ptr thr->cond-r) (ptr thr->mut))) ) + (PROF-CODE + (csym::tcounter-change-state thr tcnt-stat)) ;; When the subtask has thrown an exception, propagate it (if (== sub->stat TASK-HOME-EXCEPTION) (begin (= thr->exiting EXITING-EXCEPTION) (= thr->exception-tag sub->exception-tag) - (dec sub->owner->cancellation) + (dec sub->owner->cancellation) ; take the partial cancellation flag )) ;; When the subtask is abnormally exited, a task object is not returned as the result (if (or (== sub->stat TASK-HOME-EXCEPTION) @@ -1876,6 +1916,67 @@ (= (fref (aref hlist (- len 1)) next) 0)) (return)) + +(PROF-CODE +;;; Initialize time counters +(def (csym::initialize-tcounter thr) (fn void (ptr (struct thread-data))) + (def i int) + (def tp (struct timeval)) + (= thr->tcnt-stat TCOUNTER-INIT) + (csym::gettimeofday (ptr tp) 0) + (for ((= i 0) (< i NKIND-TCOUNTER) (inc i)) + (= (aref thr->tcnt i) 0) + (= (aref thr->tcnt-tp i) tp)) + ) + +;;; Set the start a time of tcnt-stat to the current time +(def (csym::tcounter-start thr tcnt-stat) + (fn void (ptr (struct thread-data)) (enum tcounter)) + (def tp (struct timeval)) + (csym::gettimeofday (ptr tp) 0) + (= (aref thr->tcnt-tp tcnt-stat) tp)) + +;;; Add time from the last start time of tcnt-stat to the corresponding counter +;;; Set the start a time of tcnt-stat to the current time +(def (csym::tcounter-end thr tcnt-stat) + (fn void (ptr (struct thread-data)) (enum tcounter)) + (def tp (struct timeval)) + (csym::gettimeofday (ptr tp) 0) + (+= (aref thr->tcnt tcnt-stat) + (csym::diff-timevals (ptr tp) (ptr (aref thr->tcnt-tp tcnt-stat)))) + (= (aref thr->tcnt-tp tcnt-stat) tp)) + +;;; (tcounter-end ) and (tcounter-start tcnt-stat) +;;; at the same time and change the to tcnt-stat. +;;; Return the original state. +(def (csym::tcounter-change-state thr tcnt-stat) + (fn (enum tcounter) (ptr (struct thread-data)) (enum tcounter)) + (def tp (struct timeval)) + (def tcnt-stat0 (enum tcounter)) + (= tcnt-stat0 thr->tcnt-stat) + (if (!= tcnt-stat0 tcnt-stat) + (begin + (csym::gettimeofday (ptr tp) 0) + (+= (aref thr->tcnt tcnt-stat0) + (csym::diff-timevals (ptr tp) (ptr (aref thr->tcnt-tp tcnt-stat)))) + (= (aref thr->tcnt-tp tcnt-stat) tp) + (= thr->tcnt-stat tcnt-stat))) + (return tcnt-stat0)) + +;;; Show time counters +(def (csym::show-tcounter) (fn void) + (defs int i j) + (def thr (ptr (struct thread-data))) + (for ((= i 0) (< i num-thrs) (inc i)) + (csym::fprintf stderr "*** Worker %d ***~%" i) + (= thr (+ threads i)) + (for ((= j 0) (< j NKIND-TCOUNTER) (inc j)) + (csym::fprintf stderr "%s: %lf~%" + (aref tcounter-strings j) (aref thr->tcnt j)))) + (return)) +) ; end PROF-CODE + + ;; main (entry point) ;; Initialize and run all workers and wait for external messages. (def (main argc argv) (fn int int (ptr (ptr char))) @@ -1888,6 +1989,7 @@ ;; Show compile-time option (fprintf stderr (%string "compile-time options: " "VERBOSE=" VERBOSE " " + "PROFILE=" PROFILE " " "NF-TYPE=" NF-TYPE " " "USE-AFFINITY=" USE-AFFINITY "~%")) @@ -1957,11 +2059,14 @@ (csym::malloc (* (sizeof (struct task-home)) TASK-LIST-LENGTH)))) (csym::initialize-task-home-list hx TASK-LIST-LENGTH (ptr thr->treq-top) (ptr thr->treq-free)) - (= thr->sub 0))) - + (= thr->sub 0) + )) + ;; Create and run worker threads (for ((= i 0) (< i num-thrs) (inc i)) (let ((thr (ptr (struct thread-data)) (+ threads i))) + (PROF-CODE ; initialize time counter + (csym::initialize-tcounter thr)) (systhr-create (ptr thr->pthr-id) worker thr))) ;; If option.initial-task is given, send a task to the 0-th worker diff --git a/src/sample/tcell/worker.sh b/src/sample/tcell/worker.sh index 7d94b20f..51756552 100644 --- a/src/sample/tcell/worker.sh +++ b/src/sample/tcell/worker.sh @@ -35,6 +35,8 @@ ;; (%defconstant USE-AFFINITY SCHED) ; for Linux ;; (%defconstant USE-AFFINITY PBIND) ; for SunOS +(c-exp "#include") + ;;; ;;; Sizes @@ -178,6 +180,25 @@ (static exiting-rsn-strings (array (ptr char)) (array "EXITING-NORMAL" "EXITING-EXCEPTION" "EXITING-CANCEL" "EXITING-SPAWN")) +(PROF-CODE +;;; Kinds of time counter (for evaluations) +(%defconstant NKIND-TCOUNTER 8) +(def (enum tcounter) + TCOUNTER-INIT ; before execution + TCOUNTER-EXEC ; task execution time + TCOUNTER-SPWN ; task spawning time + TCOUNTER-WAIT ; waiting result (does not include time for stealing back) + TCOUNTER-ABRT ; exiting due to abortion or propagating exception + TCOUNTER-ABRT-WAIT ; waiting result during abortion + TCOUNTER-TREQ-BK ; time for task request for stealing back + TCOUNTER-TREQ-ANY ; time for task request when having no task +) +(static tcounter-strings (array (ptr char)) + (array "TCOUNTER-INIT" "TCOUNTER-EXEC" "TCOUNTER-SPWN" + "TCOUNTER-WAIT" "TCOUNTER-ABRT" "TCOUNTER-ABRT-WAIT" + "TCOUNTER-TREQ-BK" "TCOUNTER-TREQ-ANY")) +) + ;; Entry in the task stack of a worker (def (struct task) (def stat (enum task-stat)) ; task status @@ -243,6 +264,14 @@ (def w-bcak int) ; # of bcak messages to be recieved (def exiting (enum exiting-rsn)) ; the reason for abnormal exiting (def exception-tag int) ; the exception tag to be catched + (PROF-CODE + ;; time counter (for profiling) + (def tcnt-stat (enum tcounter)) ; the last state by tcounter-change-state + (def tcnt (array double NKIND-TCOUNTER)) ; total time of each state + (def tcnt-tp (array (struct timeval) NKIND-TCOUNTER)) + ; start time of each state + ) + ;; dummy (def dummy (array char DUMMY-SIZE)) ; padding for preventing false sharing ) @@ -296,6 +325,17 @@ (decl (csym::recv-abrt) (csym::fn void (ptr (struct cmd)))) (decl (csym::recv-cncl) (csym::fn void (ptr (struct cmd)))) +(PROF-CODE + (decl (csym::initialize-tcounter) (fn void (ptr (struct thread-data)))) + (decl (csym::tcounter-start) + (fn void (ptr (struct thread-data)) (enum tcounter))) + (decl (csym::tcounter-end) + (fn void (ptr (struct thread-data)) (enum tcounter))) + (decl (csym::tcounter-change-state) + (fn (enum tcounter) (ptr (struct thread-data)) (enum tcounter))) + (decl (csym::show-tcounter) (fn void)) + ) + ;;;; Declarations of functions in cmd-serial.sc (decl (csym::serialize-cmdname buf w) (fn int (ptr char) (enum command))) (decl (csym::deserialize-cmdname buf str) (fn int (ptr (enum command)) (ptr char))) From 7a4aeb4950894293796bee7da0037c633bea04bf Mon Sep 17 00:00:00 2001 From: tasuku Date: Mon, 29 Sep 2014 20:54:49 +0900 Subject: [PATCH 015/105] Fixed bugs for profiling --- src/sample/tcell/worker.sc | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/src/sample/tcell/worker.sc b/src/sample/tcell/worker.sc index 404f3a86..c34c2cc0 100644 --- a/src/sample/tcell/worker.sc +++ b/src/sample/tcell/worker.sc @@ -72,6 +72,9 @@ )) +;;;; Worker threads +(def threads (array (struct thread-data) 128)) +(def num-thrs unsigned-int) ;;;; Random number generator (def random-seed1 double 0.2403703) (def random-seed2 double 3.638732) @@ -219,7 +222,10 @@ (if (and (== w RSLT) option.auto-exit) (begin (PROF-CODE - (csym::show-tcounter)) + (let ((i int)) + (for ((= i 0) (< i num-thrs) (inc i)) + (csym::tcounter-change-state (+ threads i) TCOUNTER-INIT)) + (csym::show-tcounter))) (csym::exit 0))) ) @@ -265,9 +271,6 @@ ) )) -(def threads (array (struct thread-data) 128)) -(def num-thrs unsigned-int) - ;;; Flush the once accepted task request pointed by "(mref p-hx)" ;;; by sending back "none" and removing the treq entry from the thr's treq-top list. @@ -1958,7 +1961,8 @@ (begin (csym::gettimeofday (ptr tp) 0) (+= (aref thr->tcnt tcnt-stat0) - (csym::diff-timevals (ptr tp) (ptr (aref thr->tcnt-tp tcnt-stat)))) + (csym::diff-timevals (ptr tp) + (ptr (aref thr->tcnt-tp tcnt-stat0)))) (= (aref thr->tcnt-tp tcnt-stat) tp) (= thr->tcnt-stat tcnt-stat))) (return tcnt-stat0)) From 018d45e2d35fb0ef4dba7c72a4c13906b0817877 Mon Sep 17 00:00:00 2001 From: tasuku Date: Tue, 30 Sep 2014 09:45:22 +0900 Subject: [PATCH 016/105] Implemented logging for timechart of Tascell workers. (Validate PROFILE complie-time option and use -T option.) --- src/sample/tcell/worker.sc | 94 +++++++++++++++++++++++++++++--------- src/sample/tcell/worker.sh | 8 ++-- 2 files changed, 77 insertions(+), 25 deletions(-) diff --git a/src/sample/tcell/worker.sc b/src/sample/tcell/worker.sc index c34c2cc0..20f1858e 100644 --- a/src/sample/tcell/worker.sc +++ b/src/sample/tcell/worker.sc @@ -78,6 +78,10 @@ ;;;; Random number generator (def random-seed1 double 0.2403703) (def random-seed2 double 3.638732) +;;;; Start time of the first task execution +(PROF-CODE + (def tp-strt (struct timeval))) + ;; Random integer in [0, max-1] (def (csym::my-random max pseed1 pseed2) (fn int int (ptr double) (ptr double)) (= (mref pseed1) (+ (* (mref pseed1) 3.0) (mref pseed2))) @@ -222,10 +226,16 @@ (if (and (== w RSLT) option.auto-exit) (begin (PROF-CODE - (let ((i int)) + (let ((i int) (thr (ptr (struct thread-data))) (fp (ptr FILE))) (for ((= i 0) (< i num-thrs) (inc i)) - (csym::tcounter-change-state (+ threads i) TCOUNTER-INIT)) - (csym::show-tcounter))) + (= thr (+ threads i)) + (csym::tcounter-change-state thr TCOUNTER-INIT) + (if thr->fp-tc + (begin + (= fp thr->fp-tc) + (= thr->fp-tc 0) + (csym::fclose fp))))) + (csym::show-tcounter)) (csym::exit 0))) ) @@ -1812,7 +1822,7 @@ (def (set-option argc argv) (csym::fn void int (ptr (ptr char))) (def i int) (def ch int) ;; Default values - (= (aref option.sv-hostname 0) #\NULL) + (= option.sv-hostname 0) (= option.port 9865) (= option.num-thrs 1) (= option.node-name 0) @@ -1821,20 +1831,19 @@ (= option.affinity 0) (= option.always-flush-accepted-treq 0) (= option.verbose 0) + (PROF-CODE + (= option.timechart-file 0)) + ;; Parse and set options - (while (!= -1 (= ch (csym::getopt argc argv "n:s:p:N:i:xafP:v:h"))) + (while (!= -1 (= ch (csym::getopt argc argv "n:s:p:N:i:xafP:v:T:h"))) (switch ch (case #\n) ; number of threads (= option.num-thrs (csym::atoi optarg)) (break) (case #\s) ; server name - (if (csym::strcmp "stdout" optarg) - (begin - (csym::strncpy option.sv-hostname optarg - HOSTNAME-MAXSIZE) - (= (aref option.sv-hostname (- HOSTNAME-MAXSIZE 1)) 0)) - (= (aref option.sv-hostname 0) #\NULL)) + (= option.sv-hostname + (if-exp (csym::strcmp "stdout" optarg) optarg 0)) (break) (case #\p) ; connection port number @@ -1877,7 +1886,17 @@ (break) (case #\v) ; verbose level - (= option.verbose (csym::atoi optarg)) + (%if* VERBOSE + (= option.verbose (csym::atoi optarg)) + %else + (csym::fprintf stderr "Warning: -v option is invalidated at compile-time.~%")) + (break) + + (case #\T) ; output time chart + (%if* PROFILE + (= option.timechart-file optarg) + %else + (csym::fprintf stderr "Warning: -T option is invalidated at compile-time.~%")) (break) (case #\h) ; usage @@ -1956,15 +1975,33 @@ (fn (enum tcounter) (ptr (struct thread-data)) (enum tcounter)) (def tp (struct timeval)) (def tcnt-stat0 (enum tcounter)) - (= tcnt-stat0 thr->tcnt-stat) + (defs double tcnt0 tcnt) + (= tcnt-stat0 thr->tcnt-stat) ; old state (if (!= tcnt-stat0 tcnt-stat) (begin - (csym::gettimeofday (ptr tp) 0) - (+= (aref thr->tcnt tcnt-stat0) - (csym::diff-timevals (ptr tp) - (ptr (aref thr->tcnt-tp tcnt-stat0)))) - (= (aref thr->tcnt-tp tcnt-stat) tp) - (= thr->tcnt-stat tcnt-stat))) + (= tcnt0 (aref thr->tcnt tcnt-stat0)) ; total time of old state + (csym::gettimeofday (ptr tp) 0) ; end time of old state + (= tcnt (+ tcnt0 ; increase total time of old state + (csym::diff-timevals (ptr tp) + (ptr (aref thr->tcnt-tp tcnt-stat0))))) + (= (aref thr->tcnt tcnt-stat0) tcnt) ; update total time of old state + (= (aref thr->tcnt-tp tcnt-stat) tp) ; set start time of new state + (= thr->tcnt-stat tcnt-stat) ; set the new state of the worker + (if thr->fp-tc + ;; Write time chart + (let ((tp0 (ptr (struct timeval)))) + (= tp0 (ptr (aref thr->tcnt-tp tcnt-stat0))) + (if (and (== tcnt-stat0 TCOUNTER-INIT) + (== thr->id 0)) + (= tp-strt tp)) ; start time of whole execution + (csym::fprintf thr->fp-tc "%s %d.%05d %d.%05d~%" + (aref tcounter-strings tcnt-stat0) + (- tp0->tv-sec tp-strt.tv-sec) + (- tp0->tv-usec tp-strt.tv-usec) + (- tp.tv-sec tp-strt.tv-sec) + (- tp.tv-usec tp-strt.tv-usec)) + )) + )) (return tcnt-stat0)) ;;; Show time counters @@ -2002,9 +2039,9 @@ (csym::set-option argc argv) ;; Connect to a Tascell server - (= sv-socket (if-exp (== #\NULL (aref option.sv-hostname 0)) - -1 - (csym::connect-to option.sv-hostname option.port))) + (= sv-socket (if-exp option.sv-hostname + (csym::connect-to option.sv-hostname option.port) + -1)) ;; Initialized mutex attribute (def m-attr pthread-mutexattr-t) @@ -2064,6 +2101,19 @@ (csym::initialize-task-home-list hx TASK-LIST-LENGTH (ptr thr->treq-top) (ptr thr->treq-free)) (= thr->sub 0) + + ;; open timechart output file + (PROF-CODE + (if option.timechart-file + (let ((fname (ptr char)) (len int)) + (= len (+ (csym::strlen option.timechart-file) 10)) + (= fname (csym::malloc (* (sizeof char) len))) + (csym::snprintf fname len "%s-%04d.dat" + option.timechart-file thr->id) + (= thr->fp-tc (csym::fopen fname "w")) + (if (not thr->fp-tc) (csym::perror "Failed to open timechart-file for writing")) + (csym::free fname)) + (= thr->fp-tc 0))) )) ;; Create and run worker threads diff --git a/src/sample/tcell/worker.sh b/src/sample/tcell/worker.sh index 51756552..97aca44b 100644 --- a/src/sample/tcell/worker.sh +++ b/src/sample/tcell/worker.sh @@ -270,6 +270,8 @@ (def tcnt (array double NKIND-TCOUNTER)) ; total time of each state (def tcnt-tp (array (struct timeval) NKIND-TCOUNTER)) ; start time of each state + ;; time chart output + (def fp-tc (ptr FILE)) ; file pointer for time chart data output ) ;; dummy (def dummy (array char DUMMY-SIZE)) ; padding for preventing false sharing @@ -348,11 +350,9 @@ (decl (csym::address-equal adr1 adr2) (fn int (ptr (enum addr)) (ptr (enum addr)))) ;;;; Command line options -(%defconstant HOSTNAME-MAXSIZE 256) (def (struct runtime-option) (def num-thrs int) ; # of workers - (def sv-hostname (array char HOSTNAME-MAXSIZE)) - ; hostname of connecting Tascell server + (def sv-hostname (ptr char)) ; hostname of connecting Tascell server ; If the string is "", external messages are output to stdout (def port unsigned-short) ; port # used to connect to Tascell server (def node-name (ptr char)) ; node name (used for debugging only) @@ -361,5 +361,7 @@ (def affinity int) ; use sched_setaffinity to assign a physical core/thread to each worker (def always-flush-accepted-treq int) ; flush stealing back (accepted) treq message (def verbose int) ; verbose level + (PROF-CODE + (def timechart-file (ptr char))) ; postfix of timechart output file names ) (extern-decl option (struct runtime-option)) From 88e5502e258b00a2fe285af233ad92ee71d1a758 Mon Sep 17 00:00:00 2001 From: tasuku Date: Tue, 30 Sep 2014 10:00:44 +0900 Subject: [PATCH 017/105] Added help message for -T option --- src/sample/tcell/worker.sc | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/sample/tcell/worker.sc b/src/sample/tcell/worker.sc index 20f1858e..d452772d 100644 --- a/src/sample/tcell/worker.sc +++ b/src/sample/tcell/worker.sc @@ -1815,7 +1815,11 @@ ;;; Handling command-line options (def (csym::usage argc argv) (csym::fn void int (ptr (ptr char))) (csym::fprintf stderr - "Usage: %s [-s hostname] [-p port-num] [-n n-threads] [-i initial-task-parms] [-a] [-v verbosity]~%" + (%string + "Usage: %s [-s hostname] [-p port-num] [-n n-threads] [-i initial-task-parms] [-a]" + (%if* VERBOSE " [-v verbosity]" %else "") + (%if* PROFILE " [-T timechart-prefix]" %else "") + "~%") (aref argv 0)) (csym::exit 1)) From e2a88ad42616ed3854304bd23f900ef9749208d8 Mon Sep 17 00:00:00 2001 From: tasuku Date: Tue, 30 Sep 2014 14:29:04 +0900 Subject: [PATCH 018/105] Implemented a Perl script to plot a timechart from log output of -T Tascell option. --- src/sample/tcell/timechart.pl | 138 ++++++++++++++++++++++++++++++++++ src/sample/tcell/worker.sc | 10 +-- 2 files changed, 142 insertions(+), 6 deletions(-) create mode 100644 src/sample/tcell/timechart.pl diff --git a/src/sample/tcell/timechart.pl b/src/sample/tcell/timechart.pl new file mode 100644 index 00000000..a99490d3 --- /dev/null +++ b/src/sample/tcell/timechart.pl @@ -0,0 +1,138 @@ +#/bin/env perl + +# Plot a timechart grah from timechart log files generated by Tascell worker +# with the -T option. Employs gnuplot. + +# Usage: perl timechart.pl +# --> Read all -.dat files. is a worker id (0000-9999). +# EPS file .eps is generated. + +use strict; +use File::Temp qw/tempfile tempdir/; + +my $prefix=$ARGV[0]; +if ($prefix eq '') { + print "Usage: perl timechart.pl \n"; + exit 99; +} + +# States (equivalent to tcounter-strings in worker.sh) +my @Tcounter=("TCOUNTER-INIT","TCOUNTER-EXEC","TCOUNTER-SPWN", + "TCOUNTER-WAIT","TCOUNTER-ABRT","TCOUNTER-ABRT-WAIT", + "TCOUNTER-TREQ-BK","TCOUNTER-TREQ-ANY"); +# Plot file name for each state. +my %Plot_file = (); +# Whether there is any plot data for each state? +my %Valid = (); +# Color for each state. +my %Color = (); +$Color{'TCOUNTER-INIT'} = '"black"'; +$Color{'TCOUNTER-EXEC'} = '"green"'; +$Color{'TCOUNTER-SPWN'} = '"magenta"'; +$Color{'TCOUNTER-WAIT'} = '"blue"'; +$Color{'TCOUNTER-ABRT'} = '"red"'; +$Color{'TCOUNTER-ABRT-WAIT'} = '"cyan"'; +$Color{'TCOUNTER-TREQ-BK'} = '"khaki"'; +$Color{'TCOUNTER-TREQ-ANY'} = '"orange"'; +# Title in legend for each state. +my %Title = (); +foreach my $stat (@Tcounter) { + my $tit = $stat; + if ($stat =~ /TCOUNTER-(\S+)/) { + $tit = $1; + } + $Title{$stat} = $tit; +} + +# Max of xrange (depends on max number of end time) +my $x_max = 0; +# Max of yrange (depends on the number of workers) +my $y_max = 0; + +# Output eps file +my $fname_eps = "$prefix.eps"; + +# Log files +my @Files = (); +foreach my $i (0 .. 9999) { + my $fname = sprintf ("$prefix-%04d.dat", $i); + if ( -e $fname ) { + print "$fname\n"; + push (@Files, $fname); + } elsif ($i>0) { + print ($i." log files found.\n"); + $y_max = $i; + last; + } else { + print "No log files named $prefix-.dat found.\n"; + exit 99; + } +} + +# Generate a plot file for each status +foreach my $stat (@Tcounter) { + my $id = -1; + $Plot_file{$stat} = "$prefix-$stat.plt"; + $Valid{$stat} = 0; + open (FP_PLT, "> $Plot_file{$stat}") or die "Failed to write a plot file $Plot_file{$stat}"; + foreach my $file (@Files) { + $id++; + open (FP, "< $file") or die "Failed to open $file."; + while (my $line = ) { + if ($line =~ /\s*(\S+)\s+(\S+)\s+(\S+)/) { + my ($l_stat, $start, $end) = ($1, $2, $3); + if ($l_stat eq $stat) { + $Valid{$stat} = 1; + if ($end > $x_max) { $x_max = $end; } + print FP_PLT "$start $id\n"; + print FP_PLT "$end $id\n"; + print FP_PLT "\n"; + } + } + } + close (FP); + } + close (FP_PLT); +} + +# Run gnuplot and plot +open (GP, "| gnuplot" ) or die "Failed to exeute gnuplot"; +sub print_gp { + my $str = shift; + print GP $str; + print $str; +} +print_gp "set key left top font 'Helvetica Neue,10' width 2"."\n"; + +print_gp "set xrange [-0.25:$x_max]"."\n"; +print_gp "set xtics 0, 1, $x_max"."\n"; +print_gp 'set xlabel "time [s]"'."\n"; + +print_gp "set yrange [-1:$y_max]"."\n"; +print_gp "set ytics 0, 1, ".($y_max-1)."\n"; +print_gp 'set ylabel "worker ID"'."\n"; + +print_gp 'set terminal postscript eps enhanced color'."\n"; +print_gp "set output \"$fname_eps\""."\n"; + +my $replot = 0; + +foreach my $stat (@Tcounter) { + if ($Valid{$stat}) { + print_gp (($replot==0)?'plot ':', '); + print_gp "\"$Plot_file{$stat}\" w l lc rgb $Color{$stat} lt 1 linewidth 5 title \"$Title{$stat}\""; + $replot = 1; + } +} +print_gp "\n"; +# Close gnuplot process +close (GP); + +# remove plot files +foreach my $stat (@Tcounter) { + unlink $Plot_file{$stat}; +} + +if ( -e $fname_eps ) { + print "eps file $fname_eps generated.\n"; +} diff --git a/src/sample/tcell/worker.sc b/src/sample/tcell/worker.sc index d452772d..c3feec8f 100644 --- a/src/sample/tcell/worker.sc +++ b/src/sample/tcell/worker.sc @@ -1998,12 +1998,10 @@ (if (and (== tcnt-stat0 TCOUNTER-INIT) (== thr->id 0)) (= tp-strt tp)) ; start time of whole execution - (csym::fprintf thr->fp-tc "%s %d.%05d %d.%05d~%" - (aref tcounter-strings tcnt-stat0) - (- tp0->tv-sec tp-strt.tv-sec) - (- tp0->tv-usec tp-strt.tv-usec) - (- tp.tv-sec tp-strt.tv-sec) - (- tp.tv-usec tp-strt.tv-usec)) + (csym::fprintf thr->fp-tc "%s %lf %lf~%" + (aref tcounter-strings tcnt-stat0) + (csym::diff-timevals tp0 (ptr tp-strt)) + (csym::diff-timevals (ptr tp) (ptr tp-strt))) )) )) (return tcnt-stat0)) From 95dbd33ac600fcfd4aba08229121dc7143ef09fd Mon Sep 17 00:00:00 2001 From: Shingo OKUNO Date: Tue, 30 Sep 2014 17:09:23 +0900 Subject: [PATCH 019/105] Added some features for analyzing copine4.tcell --- src/sample/tcell/README4COPINE | 5 +- src/sample/tcell/copine3.tcell | 2 +- src/sample/tcell/copine4.tcell | 108 +++++++++++++++++++-------------- 3 files changed, 66 insertions(+), 49 deletions(-) diff --git a/src/sample/tcell/README4COPINE b/src/sample/tcell/README4COPINE index 6674bb01..652f7e2b 100644 --- a/src/sample/tcell/README4COPINE +++ b/src/sample/tcell/README4COPINE @@ -11,7 +11,7 @@ extracts all connected subgraphs, each of which shares a common itemset whose size is not less than a given threshold, from a given graph in which each vertex is associated to an itemset. For this problem, an efficient sequential backtrack search algorithm called COmmon Pattern Itemset NEtwork mining -(COPINE) [Seki et al., BIBE08] has been already proposed. COPINE reduces the +(COPINE) [Seki et al., BIBE'08] has been already proposed. COPINE reduces the search space of a dynamically growing tree structure by pruning its branches corresponding to the following subgraphs; already visited, having itemsets smaller than a given threshold, and having already-visited supergraphs with @@ -60,7 +60,8 @@ Input files (2) Run the program. e.g.) $ ./copine3-gcc -n <# of threads> -Note that input files are specified in the main function currently. For more information about runtime arguments, see each source code. +Note that input files are specified in the main function currently. For more +information about runtime arguments, see each source code. 4. Publication ------------------------- diff --git a/src/sample/tcell/copine3.tcell b/src/sample/tcell/copine3.tcell index 8c009b4b..368e0031 100644 --- a/src/sample/tcell/copine3.tcell +++ b/src/sample/tcell/copine3.tcell @@ -66,7 +66,7 @@ (%defconstant USE-SSE 0) ;;; Max # of workers -(%defconstant NUM-WORKERS 16) +(%defconstant NUM-WORKERS 32) ;;; Constants (%defconstant E-SIZE 500000) ; # of edges diff --git a/src/sample/tcell/copine4.tcell b/src/sample/tcell/copine4.tcell index f6758187..80637c19 100644 --- a/src/sample/tcell/copine4.tcell +++ b/src/sample/tcell/copine4.tcell @@ -66,7 +66,7 @@ (%defconstant USE-SSE 0) ;;; Max # of workers -(%defconstant NUM-WORKERS 16) +(%defconstant NUM-WORKERS 32) ;;; Constants (%defconstant E-SIZE 500000) ; # of edges @@ -685,38 +685,13 @@ (decl tp (array (struct timeval) 2)) ; (decl tpc (array (struct timeval) 4)) ; - (inc (fref pTsk -> numEmutexTrylock)) - (if (!= (csym::pthread_mutex_trylock (ptr (aref excpMutex (fref -thr -> id)))) 0) - (begin - (inc (fref pTsk -> numEmutexLocked)) - (csym::pthread_mutex_lock (ptr (aref excpMutex (fref -thr -> id)))))) - (if (aref numQe (fref -thr -> id)) - (begin - (= excpIndex INT_MAX) - (for ((= j 0) (< j (aref numQe (fref -thr -> id))) (inc j)) - (for ((= k 0) (< k (fref pTsk -> numT)) (inc k)) - (if (== (aref Qe (fref -thr -> id) j) (aref (fref pTsk -> T) k)) - (begin - (if (< k excpIndex) - (begin - (= excpValue (cast int (aref (fref pTsk -> T) k))) - (= excpIndex k))) - (break))))))) - (csym::pthread_mutex_unlock (ptr (aref excpMutex (fref -thr -> id)))) - (if (!= excpValue -1) - (begin - (inc (aref numThrow (fref -thr -> id))) - (= (aref flagQe (fref -thr -> id)) 1) - (throw excpValue))) - + ;(inc (fref pTsk -> numEmutexTrylock)) + ;(if (!= (csym::pthread_mutex_trylock (ptr (aref excpMutex (fref -thr -> id)))) 0) + ; (begin + ; (inc (fref pTsk -> numEmutexLocked)) + ; (csym::pthread_mutex_lock (ptr (aref excpMutex (fref -thr -> id)))))) ;(if (aref numQe (fref -thr -> id)) ; (begin - ; (inc (fref pTsk -> numEmutexTrylock)) - ; (if (!= (csym::pthread_mutex_trylock (ptr (aref excpMutex (fref -thr -> id)))) 0) - ; (begin - ; (inc (fref pTsk -> numEmutexLocked)) - ; (csym::pthread_mutex_lock (ptr (aref excpMutex (fref -thr -> id)))))) - ; (= excpValue -1) ; (= excpIndex INT_MAX) ; (for ((= j 0) (< j (aref numQe (fref -thr -> id))) (inc j)) ; (for ((= k 0) (< k (fref pTsk -> numT)) (inc k)) @@ -726,14 +701,38 @@ ; (begin ; (= excpValue (cast int (aref (fref pTsk -> T) k))) ; (= excpIndex k))) - ; (break))))) - ; (= (aref numQe (fref -thr -> id)) 0) - ; (csym::pthread_mutex_unlock (ptr (aref excpMutex (fref -thr -> id)))) - ; (if (!= excpValue -1) - ; (begin - ; (inc (aref numThrow (fref -thr -> id))) - ; (= (aref flagQe (fref -thr -> id)) 1) - ; (throw excpValue))))) + ; (break))))))) + ;(csym::pthread_mutex_unlock (ptr (aref excpMutex (fref -thr -> id)))) + ;(if (!= excpValue -1) + ; (begin + ; (inc (aref numThrow (fref -thr -> id))) + ; (= (aref flagQe (fref -thr -> id)) 1) + ; (throw excpValue))) + + (if (aref numQe (fref -thr -> id)) + (begin + (inc (fref pTsk -> numEmutexTrylock)) + (if (!= (csym::pthread_mutex_trylock (ptr (aref excpMutex (fref -thr -> id)))) 0) + (begin + (inc (fref pTsk -> numEmutexLocked)) + (csym::pthread_mutex_lock (ptr (aref excpMutex (fref -thr -> id)))))) + (= excpValue -1) + (= excpIndex INT_MAX) + (for ((= j 0) (< j (aref numQe (fref -thr -> id))) (inc j)) + (for ((= k 0) (< k (fref pTsk -> numT)) (inc k)) + (if (== (aref Qe (fref -thr -> id) j) (aref (fref pTsk -> T) k)) + (begin + (if (< k excpIndex) + (begin + (= excpValue (cast int (aref (fref pTsk -> T) k))) + (= excpIndex k))) + (break))))) + (csym::pthread_mutex_unlock (ptr (aref excpMutex (fref -thr -> id)))) + (if (!= excpValue -1) + (begin + (inc (aref numThrow (fref -thr -> id))) + (= (aref flagQe (fref -thr -> id)) 1) + (throw excpValue))))) ;; DFS (do-many for i from minC to maxC @@ -1775,19 +1774,19 @@ (defs (struct hsearch_data) eHash iHash) ;; Debug Data - (def numSearch uint64_t 0) ; # of search space + (def numSearch uint64_t 0) ; # of search spaces (def maxWorkerSearch uint64_t 0) ; (def avgWorkerSearch double 0.0) ; (def workerSearchSD double 0.0) ; (def avgWorkerSearchPerSec double 0.0) ; (def workerSearchPerSecSD double 0.0) ; - (def numTaskRequest int 0) ; # of task request + (def numTaskRequest int 0) ; # of task requests (def avgTaskRequest double 0.0) ; (def taskRequestSD double 0.0) ; - (def numSeqTaskRequest int 0) ; # of seq. task request + (def numSeqTaskRequest int 0) ; # of seq. task requests (def avgSeqTaskRequest double 0.0) ; (def seqTaskRequestSD double 0.0) ; - (def numAllTaskRequest int 0) ; # of all task request + (def numAllTaskRequest int 0) ; # of all task requests (def avgAllTaskRequest double 0.0) ; (def allTaskRequestSD double 0.0) ; (def numTableReference uint64_t 0) ; @@ -1795,7 +1794,12 @@ (def tableReferenceSD double 0.0) ; (def avgSizeSubgraph uint64_t 0) ; (def maxSizeSubgraph int 0) ; + (def numFindRedundant int 0) ; # of finding redundant searches + (def avgFindRedundant double 0.0) ; + (def findRedundantSD double 0.0) ; (def numThrowException int 0) ; # of thrown exceptions + (def avgThrowException double 0.0) ; + (def throwExceptionSD double 0.0) ; ;; arguments (= patternFile "data/symatlas_pattern.txt") @@ -2057,13 +2061,17 @@ (+= numSeqTaskRequest (aref seqTaskRequest j)) (+= numAllTaskRequest (aref taskRequest j)) (+= numAllTaskRequest (aref seqTaskRequest j)) - (+= numTableReference (aref tableReference j))) + (+= numTableReference (aref tableReference j)) + (+= numFindRedundant (aref numRedundantSearch j)) + (+= numThrowException (aref numThrow j))) (= avgWorkerSearch (/ (cast double numSearch) (cast double (fref option num-thrs)))) (= avgWorkerSearchPerSec (/ avgWorkerSearchPerSec (cast double (fref option num-thrs)))) (= avgTaskRequest (/ (cast double numTaskRequest) (cast double (fref option num-thrs)))) (= avgSeqTaskRequest (/ (cast double numSeqTaskRequest) (cast double (fref option num-thrs)))) (= avgAllTaskRequest (/ (cast double (+ numTaskRequest numSeqTaskRequest)) (cast double (fref option num-thrs)))) (= avgTableReference (/ (cast double numTableReference) (cast double (fref option num-thrs)))) + (= avgFindRedundant (/ (cast double numFindRedundant) (cast double (fref option num-thrs)))) + (= avgThrowException (/ (cast double numThrowException) (cast double (fref option num-thrs)))) (for ((= j 0) (< j (fref option num-thrs)) (inc j)) (+= workerSearchSD (csym::pow (- (aref searchSpace j) avgWorkerSearch) 2.0)) @@ -2071,19 +2079,25 @@ (+= taskRequestSD (csym::pow (- (aref taskRequest j) avgTaskRequest) 2.0)) (+= seqTaskRequestSD (csym::pow (- (aref seqTaskRequest j) avgSeqTaskRequest) 2.0)) (+= allTaskRequestSD (csym::pow (- (+ (aref taskRequest j) (aref seqTaskRequest j)) avgAllTaskRequest) 2.0)) - (+= tableReferenceSD (csym::pow (- (aref tableReference j) avgTableReference) 2.0))) + (+= tableReferenceSD (csym::pow (- (aref tableReference j) avgTableReference) 2.0)) + (+= findRedundantSD (csym::pow (- (aref numRedundantSearch j) avgFindRedundant) 2.0)) + (+= throwExceptionSD (csym::pow (- (aref numThrow j) avgThrowException) 2.0))) (/= workerSearchSD (fref option num-thrs)) (/= workerSearchPerSecSD (fref option num-thrs)) (/= taskRequestSD (fref option num-thrs)) (/= seqTaskRequestSD (fref option num-thrs)) (/= allTaskRequestSD (fref option num-thrs)) (/= tableReferenceSD (fref option num-thrs)) + (/= findRedundantSD (fref option num-thrs)) + (/= throwExceptionSD (fref option num-thrs)) (= workerSearchSD (csym::sqrt workerSearchSD)) (= workerSearchPerSecSD (csym::sqrt workerSearchPerSecSD)) (= taskRequestSD (csym::sqrt taskRequestSD)) (= seqTaskRequestSD (csym::sqrt seqTaskRequestSD)) (= allTaskRequestSD (csym::sqrt allTaskRequestSD)) (= tableReferenceSD (csym::sqrt tableReferenceSD)) + (= findRedundantSD (csym::sqrt findRedundantSD)) + (= throwExceptionSD (csym::sqrt throwExceptionSD)) (csym::fprintf stderr "# of searches = %llu, Max = %d, Avg. = %.1f, S.D. = %.1f~%" numSearch maxWorkerSearch avgWorkerSearch workerSearchSD) (csym::fprintf stderr "# of task requests = %d, Avg. = %.1f, S.D. = %.1f~%" numTaskRequest avgTaskRequest taskRequestSD) @@ -2094,4 +2108,6 @@ (csym::fprintf stderr "# of ITmutex trylock = %llu, " (fref tsk numITmutexTrylock)) (csym::fprintf stderr "# of ITmutex locked = %llu(%.3f%%)~%" (fref tsk numITmutexLocked) (* (/ (cast double (fref tsk numITmutexLocked)) (cast double (fref tsk numITmutexTrylock))) 100.0)) (csym::fprintf stderr "# of Emutex trylock = %llu, " (fref tsk numEmutexTrylock)) - (csym::fprintf stderr "# of Emutex locked = %llu(%.3f%%)~%" (fref tsk numEmutexLocked) (* (/ (cast double (fref tsk numEmutexLocked)) (cast double (fref tsk numEmutexTrylock))) 100.0))) + (csym::fprintf stderr "# of Emutex locked = %llu(%.3f%%)~%" (fref tsk numEmutexLocked) (* (/ (cast double (fref tsk numEmutexLocked)) (cast double (fref tsk numEmutexTrylock))) 100.0)) + (csym::fprintf stderr "# of finding redundant searches = %d, Avg. = %.1f, S.D. = %.1f~%" numFindRedundant avgFindRedundant findRedundantSD) + (csym::fprintf stderr "# of throwing exceptions = %d, Avg. = %.1f, S.D. =%.1f~%" numThrowException avgThrowException throwExceptionSD)) From 1e8d8b496fe4affb7e1a53e95d86dd9c092e9359 Mon Sep 17 00:00:00 2001 From: tasuku Date: Tue, 30 Sep 2014 20:32:59 +0900 Subject: [PATCH 020/105] Predefinitions of SC preprocessor constants (by -D sc2c option) are applied in all phases of SC preprocessor --- src/sc-main.lsp | 2 +- src/scpp.lsp | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/sc-main.lsp b/src/sc-main.lsp index e8cd441a..1eca8870 100644 --- a/src/sc-main.lsp +++ b/src/sc-main.lsp @@ -180,7 +180,7 @@ X is an S-expression or a filespec." ;; apply scpp ;;(format *error-output* "~&>>> Applying SCPP...~%") ;;(force-output *error-output*) - (setq x (apply #'scpp:scpp x common-scpp-args)) + (setq x (apply #'scpp:scpp (append predefinitions x) common-scpp-args)) ;; write to intermediate file (preprocessed) if requried (when intermediate (write-intermediate-file diff --git a/src/scpp.lsp b/src/scpp.lsp index e49b09cd..bc7a87ad 100644 --- a/src/scpp.lsp +++ b/src/scpp.lsp @@ -1,4 +1,4 @@ -;;; Copyright (c) 2008 Tasuku Hiraishi +;;; Copyright (c) 2008-2014 Tasuku Hiraishi ;;; All rights reserved. ;;; Redistribution and use in source and binary forms, with or without From 2d7f507e912538665f8aa4df04557b843d002af8 Mon Sep 17 00:00:00 2001 From: tasuku Date: Wed, 1 Oct 2014 15:01:17 +0900 Subject: [PATCH 021/105] Distinguish abortion from propagating exceptions in profiling logs for timecharts. --- src/sample/tcell/timechart.pl | 13 ++++++++----- src/sample/tcell/worker.sc | 6 ++++-- src/sample/tcell/worker.sh | 7 +++++-- 3 files changed, 17 insertions(+), 9 deletions(-) diff --git a/src/sample/tcell/timechart.pl b/src/sample/tcell/timechart.pl index a99490d3..43f8cb0f 100644 --- a/src/sample/tcell/timechart.pl +++ b/src/sample/tcell/timechart.pl @@ -18,7 +18,8 @@ # States (equivalent to tcounter-strings in worker.sh) my @Tcounter=("TCOUNTER-INIT","TCOUNTER-EXEC","TCOUNTER-SPWN", - "TCOUNTER-WAIT","TCOUNTER-ABRT","TCOUNTER-ABRT-WAIT", + "TCOUNTER-WAIT","TCOUNTER-EXCP","TCOUNTER-EXCP-WAIT", + "TCOUNTER-ABRT","TCOUNTER-ABRT-WAIT", "TCOUNTER-TREQ-BK","TCOUNTER-TREQ-ANY"); # Plot file name for each state. my %Plot_file = (); @@ -29,11 +30,13 @@ $Color{'TCOUNTER-INIT'} = '"black"'; $Color{'TCOUNTER-EXEC'} = '"green"'; $Color{'TCOUNTER-SPWN'} = '"magenta"'; -$Color{'TCOUNTER-WAIT'} = '"blue"'; +$Color{'TCOUNTER-WAIT'} = '"dark-green"'; +$Color{'TCOUNTER-EXCP'} = '"orange"'; +$Color{'TCOUNTER-EXCP-WAIT'} = '"dark-orange"'; $Color{'TCOUNTER-ABRT'} = '"red"'; -$Color{'TCOUNTER-ABRT-WAIT'} = '"cyan"'; -$Color{'TCOUNTER-TREQ-BK'} = '"khaki"'; -$Color{'TCOUNTER-TREQ-ANY'} = '"orange"'; +$Color{'TCOUNTER-ABRT-WAIT'} = '"dark-red"'; +$Color{'TCOUNTER-TREQ-BK'} = '"dark-khaki"'; +$Color{'TCOUNTER-TREQ-ANY'} = '"khaki"'; # Title in legend for each state. my %Title = (); foreach my $stat (@Tcounter) { diff --git a/src/sample/tcell/worker.sc b/src/sample/tcell/worker.sc index c3feec8f..1aa6c0cb 100644 --- a/src/sample/tcell/worker.sc +++ b/src/sample/tcell/worker.sc @@ -1641,7 +1641,7 @@ (= -thr->exiting EXITING-EXCEPTION) (= -thr->exception-tag excep) (PROF-CODE - (csym::tcounter-change-state -thr TCOUNTER-ABRT)) + (csym::tcounter-change-state -thr TCOUNTER-EXCP)) (-bk)) ; never returns ;; Check (partial) cancellation flags and abort if needed. @@ -1719,7 +1719,9 @@ (PROF-CODE (= tcnt-stat-w (if-exp (== tcnt-stat TCOUNTER-EXEC) TCOUNTER-WAIT - TCOUNTER-ABRT-WAIT)) + (if-exp (== tcnt-stat TCOUNTER-ABRT) + TCOUNTER-ABRT-WAIT + TCOUNTER-EXCP-WAIT))) (csym::tcounter-change-state thr tcnt-stat-w)) (= thr->task-top->stat TASK-SUSPENDED) ; STARTED => SUSPENDED (thr->task-top is the task being executed) ;; When propagating exception, send cncl messages for subtasks diff --git a/src/sample/tcell/worker.sh b/src/sample/tcell/worker.sh index 97aca44b..88d65ead 100644 --- a/src/sample/tcell/worker.sh +++ b/src/sample/tcell/worker.sh @@ -188,14 +188,17 @@ TCOUNTER-EXEC ; task execution time TCOUNTER-SPWN ; task spawning time TCOUNTER-WAIT ; waiting result (does not include time for stealing back) - TCOUNTER-ABRT ; exiting due to abortion or propagating exception + TCOUNTER-EXCP ; exiting due to propagating an exception + TCOUNTER-EXCP-WAIT ; waiting result during propagating an exception + TCOUNTER-ABRT ; exiting due to abortion TCOUNTER-ABRT-WAIT ; waiting result during abortion TCOUNTER-TREQ-BK ; time for task request for stealing back TCOUNTER-TREQ-ANY ; time for task request when having no task ) (static tcounter-strings (array (ptr char)) (array "TCOUNTER-INIT" "TCOUNTER-EXEC" "TCOUNTER-SPWN" - "TCOUNTER-WAIT" "TCOUNTER-ABRT" "TCOUNTER-ABRT-WAIT" + "TCOUNTER-WAIT" "TCOUNTER-EXCP" "TCOUNTER-EXCP-WAIT" + "TCOUNTER-ABRT" "TCOUNTER-ABRT-WAIT" "TCOUNTER-TREQ-BK" "TCOUNTER-TREQ-ANY")) ) From f67319381c6ec9fd4f4628ce21b067cde1a58741 Mon Sep 17 00:00:00 2001 From: tasuku Date: Wed, 1 Oct 2014 15:42:37 +0900 Subject: [PATCH 022/105] Fixed a bug in worker.sh --- src/sample/tcell/worker.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/sample/tcell/worker.sh b/src/sample/tcell/worker.sh index 88d65ead..62084a3a 100644 --- a/src/sample/tcell/worker.sh +++ b/src/sample/tcell/worker.sh @@ -182,7 +182,7 @@ (PROF-CODE ;;; Kinds of time counter (for evaluations) -(%defconstant NKIND-TCOUNTER 8) +(%defconstant NKIND-TCOUNTER 10) (def (enum tcounter) TCOUNTER-INIT ; before execution TCOUNTER-EXEC ; task execution time From 29eba70335e69b5ff72385d8a4d3850bfaacd7df Mon Sep 17 00:00:00 2001 From: tasuku Date: Wed, 1 Oct 2014 17:12:10 +0900 Subject: [PATCH 023/105] New option '-k' of tcell/timechart.pl to keep plot files and a gnuplot script. --- src/sample/tcell/timechart.pl | 64 ++++++++++++++++++++++++++++------- src/sample/tcell/worker.sh | 2 +- 2 files changed, 53 insertions(+), 13 deletions(-) diff --git a/src/sample/tcell/timechart.pl b/src/sample/tcell/timechart.pl index 43f8cb0f..5794c50e 100644 --- a/src/sample/tcell/timechart.pl +++ b/src/sample/tcell/timechart.pl @@ -3,19 +3,29 @@ # Plot a timechart grah from timechart log files generated by Tascell worker # with the -T option. Employs gnuplot. -# Usage: perl timechart.pl +# Usage: perl timechart.pl [-k] # --> Read all -.dat files. is a worker id (0000-9999). # EPS file .eps is generated. +# When -k option is given, keep all plot files and a gnuplot script after execution. use strict; use File::Temp qw/tempfile tempdir/; +### Set parameters +# Prefix of input/output files. my $prefix=$ARGV[0]; if ($prefix eq '') { - print "Usage: perl timechart.pl \n"; + print "Usage: perl timechart.pl [-k]\n"; exit 99; } +# Keep plot files and gnuplot script? (-k option) +my $keep_files = 0; +if ($ARGV[1] eq '-k') { + print "Keep-file option is enabled.\n"; + $keep_files = 1; +} + # States (equivalent to tcounter-strings in worker.sh) my @Tcounter=("TCOUNTER-INIT","TCOUNTER-EXEC","TCOUNTER-SPWN", "TCOUNTER-WAIT","TCOUNTER-EXCP","TCOUNTER-EXCP-WAIT", @@ -52,10 +62,13 @@ # Max of yrange (depends on the number of workers) my $y_max = 0; -# Output eps file +# Directory to save all generated files +my $dirname = "$prefix-plot"; + +# Generated eps file my $fname_eps = "$prefix.eps"; -# Log files +# Generated log files my @Files = (); foreach my $i (0 .. 9999) { my $fname = sprintf ("$prefix-%04d.dat", $i); @@ -72,12 +85,21 @@ } } +# Gnuplot script file +my $fname_gp = "plot.gnuplot"; + + +### Main +# Make directory +mkdir $dirname or die "Failed to generate $dirname"; + # Generate a plot file for each status foreach my $stat (@Tcounter) { my $id = -1; $Plot_file{$stat} = "$prefix-$stat.plt"; + my $pltfile = "$dirname/$Plot_file{$stat}"; $Valid{$stat} = 0; - open (FP_PLT, "> $Plot_file{$stat}") or die "Failed to write a plot file $Plot_file{$stat}"; + open (FP_PLT, "> $pltfile") or die "Failed to write a plot file $pltfile"; foreach my $file (@Files) { $id++; open (FP, "< $file") or die "Failed to open $file."; @@ -98,11 +120,14 @@ close (FP_PLT); } -# Run gnuplot and plot +# Run gnuplot to generate an eps file and make a gnuplot script file +# with which the same eps file can be generated again. open (GP, "| gnuplot" ) or die "Failed to exeute gnuplot"; +open (FP_GP, "> $dirname/$fname_gp") or die "Failed to open $dirname/$fname_gp to write"; sub print_gp { my $str = shift; print GP $str; + print FP_GP $str; print $str; } print_gp "set key left top font 'Helvetica Neue,10' width 2"."\n"; @@ -122,20 +147,35 @@ sub print_gp { foreach my $stat (@Tcounter) { if ($Valid{$stat}) { - print_gp (($replot==0)?'plot ':', '); - print_gp "\"$Plot_file{$stat}\" w l lc rgb $Color{$stat} lt 1 linewidth 5 title \"$Title{$stat}\""; + print_gp (($replot==0)?'plot ':", \\\n"); + print_gp "\"$dirname/$Plot_file{$stat}\" w l lc rgb $Color{$stat} lt 1 linewidth 5 title \"$Title{$stat}\""; $replot = 1; } } print_gp "\n"; -# Close gnuplot process + +# Close gnuplot process and script close (GP); +close (FP_GP); +unless ($keep_files) { # remove plot files -foreach my $stat (@Tcounter) { - unlink $Plot_file{$stat}; + foreach my $stat (@Tcounter) { + unlink "$dirname/$Plot_file{$stat}"; + } +# remove gnuplot script + unlink "$dirname/$fname_gp"; +# remove directory + rmdir $dirname; } +# Show summary +print "* * * Summary * * *\n"; if ( -e $fname_eps ) { - print "eps file $fname_eps generated.\n"; + print "An eps file $fname_eps generated.\n"; +} +if ( -d $dirname ) { + print "Plot files and a gnuplot script file are stored in $dirname/.\n"; + print "You can generate $fname_eps again by:\n"; + print "\$ gnuplot $dirname/$fname_gp\n"; } diff --git a/src/sample/tcell/worker.sh b/src/sample/tcell/worker.sh index 88d65ead..62084a3a 100644 --- a/src/sample/tcell/worker.sh +++ b/src/sample/tcell/worker.sh @@ -182,7 +182,7 @@ (PROF-CODE ;;; Kinds of time counter (for evaluations) -(%defconstant NKIND-TCOUNTER 8) +(%defconstant NKIND-TCOUNTER 10) (def (enum tcounter) TCOUNTER-INIT ; before execution TCOUNTER-EXEC ; task execution time From 2be3e841c22d437c5565c53c02adec3eeb7c94f3 Mon Sep 17 00:00:00 2001 From: tasuku Date: Thu, 2 Oct 2014 12:52:13 +0900 Subject: [PATCH 024/105] Output auxiliary data in timechart logs (recipient in TCOUNTER-TREQ-BK, exception value in TCOUNTER-EXCP, and the number of cancellation flags in TCOUNTER-ABRT) --- src/rule/tcell.rule | 2 +- src/sample/tcell/timechart.pl | 2 +- src/sample/tcell/worker.sc | 58 ++++++++++++++++++++++++++--------- src/sample/tcell/worker.sh | 21 ++++++++++++- 4 files changed, 65 insertions(+), 18 deletions(-) diff --git a/src/rule/tcell.rule b/src/rule/tcell.rule index 8742f331..4dc5db71 100644 --- a/src/rule/tcell.rule +++ b/src/rule/tcell.rule @@ -512,7 +512,7 @@ (begin (= -thr->exiting EXITING-NORMAL) (PROF-CODE - (csym::tcounter-change-state -thr TCOUNTER-EXEC)) + (csym::tcounter-change-state -thr TCOUNTER-EXEC OBJ-NULL 0)) (goto ,label-id)) (,(tcell:latest-bk)))))) (= ,catchval-id ,e-exp) diff --git a/src/sample/tcell/timechart.pl b/src/sample/tcell/timechart.pl index 5794c50e..a9205ccb 100644 --- a/src/sample/tcell/timechart.pl +++ b/src/sample/tcell/timechart.pl @@ -104,7 +104,7 @@ $id++; open (FP, "< $file") or die "Failed to open $file."; while (my $line = ) { - if ($line =~ /\s*(\S+)\s+(\S+)\s+(\S+)/) { + if ($line =~ /^\s*(\S+)\s+(\S+)\s+(\S+)/) { my ($l_stat, $start, $end) = ($1, $2, $3); if ($l_stat eq $stat) { $Valid{$stat} = 1; diff --git a/src/sample/tcell/worker.sc b/src/sample/tcell/worker.sc index 1aa6c0cb..9afa95e4 100644 --- a/src/sample/tcell/worker.sc +++ b/src/sample/tcell/worker.sc @@ -229,7 +229,7 @@ (let ((i int) (thr (ptr (struct thread-data))) (fp (ptr FILE))) (for ((= i 0) (< i num-thrs) (inc i)) (= thr (+ threads i)) - (csym::tcounter-change-state thr TCOUNTER-INIT) + (csym::tcounter-change-state thr TCOUNTER-INIT OBJ-NULL 0) (if thr->fp-tc (begin (= fp thr->fp-tc) @@ -529,7 +529,7 @@ (begin ;; Execute the task (PROF-CODE - (csym::tcounter-change-state thr TCOUNTER-EXEC)) + (csym::tcounter-change-state thr TCOUNTER-EXEC OBJ-NULL 0)) (= tx->stat TASK-STARTED) ; TASK-INITIALIZED => TASK-STARTED (= tx->cancellation 0) ; initialize # of cancellation flags (= old-ndiv thr->ndiv) @@ -648,7 +648,7 @@ (loop (PROF-CODE (if (!= thr->tcnt-stat TCOUNTER-INIT) - (csym::tcounter-change-state thr TCOUNTER-TREQ-ANY))) + (csym::tcounter-change-state thr TCOUNTER-TREQ-ANY OBJ-NULL 0))) (recv-exec-send thr (init (array (enum addr) 2) (array ANY TERM)) INSIDE)) (csym::pthread-mutex-unlock (ptr thr->mut))) @@ -1591,10 +1591,10 @@ (begin (= -thr->exiting EXITING-SPAWN) (PROF-CODE - (csym::tcounter-change-state -thr TCOUNTER-SPWN)) + (csym::tcounter-change-state -thr TCOUNTER-SPWN OBJ-NULL 0)) (-bk) (PROF-CODE - (csym::tcounter-change-state -thr TCOUNTER-EXEC)) + (csym::tcounter-change-state -thr TCOUNTER-EXEC OBJ-NULL 0)) (= -thr->exiting EXITING-NORMAL) (= -thr->req -thr->treq-top) )) (csym::pthread-mutex-unlock (ptr -thr->mut))) @@ -1641,7 +1641,7 @@ (= -thr->exiting EXITING-EXCEPTION) (= -thr->exception-tag excep) (PROF-CODE - (csym::tcounter-change-state -thr TCOUNTER-EXCP)) + (csym::tcounter-change-state -thr TCOUNTER-EXCP OBJ-INT (cast (ptr void) excep))) (-bk)) ; never returns ;; Check (partial) cancellation flags and abort if needed. @@ -1654,7 +1654,8 @@ (csym::get-universal-real-time) -thr->id -thr->task-top->cancellation) (= -thr->exiting EXITING-CANCEL) (PROF-CODE - (csym::tcounter-change-state -thr TCOUNTER-ABRT)) + (csym::tcounter-change-state -thr TCOUNTER-ABRT + OBJ-INT (cast (ptr void) -thr->task-top->cancellation))) (csym::pthread-mutex-unlock (ptr -thr->mut)) (-bk))) (csym::pthread-mutex-unlock (ptr -thr->mut)) @@ -1722,7 +1723,7 @@ (if-exp (== tcnt-stat TCOUNTER-ABRT) TCOUNTER-ABRT-WAIT TCOUNTER-EXCP-WAIT))) - (csym::tcounter-change-state thr tcnt-stat-w)) + (csym::tcounter-change-state thr tcnt-stat-w OBJ-NULL 0)) (= thr->task-top->stat TASK-SUSPENDED) ; STARTED => SUSPENDED (thr->task-top is the task being executed) ;; When propagating exception, send cncl messages for subtasks (if (== thr->exiting EXITING-EXCEPTION) @@ -1747,16 +1748,18 @@ ;; Steal and execute a task (begin (PROF-CODE - (csym::tcounter-change-state thr TCOUNTER-TREQ-BK)) + (csym::tcounter-change-state thr TCOUNTER-TREQ-BK + OBJ-ADDR sub->task-head)) (recv-exec-send thr sub->task-head sub->req-from) (PROF-CODE - (csym::tcounter-change-state thr tcnt-stat-w)) + (csym::tcounter-change-state thr tcnt-stat-w + OBJ-NULL 0)) ) ;; Just wait for the subtask finishing (csym::pthread-cond-wait (ptr thr->cond-r) (ptr thr->mut))) ) (PROF-CODE - (csym::tcounter-change-state thr tcnt-stat)) + (csym::tcounter-change-state thr tcnt-stat OBJ-NULL 0)) ;; When the subtask has thrown an exception, propagate it (if (== sub->stat TASK-HOME-EXCEPTION) @@ -1955,6 +1958,7 @@ (for ((= i 0) (< i NKIND-TCOUNTER) (inc i)) (= (aref thr->tcnt i) 0) (= (aref thr->tcnt-tp i) tp)) + (= thr->tc-aux.type OBJ-NULL) ) ;;; Set the start a time of tcnt-stat to the current time @@ -1977,11 +1981,14 @@ ;;; (tcounter-end ) and (tcounter-start tcnt-stat) ;;; at the same time and change the to tcnt-stat. ;;; Return the original state. -(def (csym::tcounter-change-state thr tcnt-stat) - (fn (enum tcounter) (ptr (struct thread-data)) (enum tcounter)) +;;; aux-type/aux-body is auxiliary data type/body for timechart: +(def (csym::tcounter-change-state thr tcnt-stat aux-type aux-body) + (fn (enum tcounter) (ptr (struct thread-data)) (enum tcounter) + (enum obj-type) (ptr void)) (def tp (struct timeval)) (def tcnt-stat0 (enum tcounter)) (defs double tcnt0 tcnt) + (def buf (array char BUFSIZE)) (= tcnt-stat0 thr->tcnt-stat) ; old state (if (!= tcnt-stat0 tcnt-stat) (begin @@ -2000,10 +2007,32 @@ (if (and (== tcnt-stat0 TCOUNTER-INIT) (== thr->id 0)) (= tp-strt tp)) ; start time of whole execution - (csym::fprintf thr->fp-tc "%s %lf %lf~%" + ;; Output the previous state name, and the time range of the state. + (csym::fprintf thr->fp-tc "%s %lf %lf" (aref tcounter-strings tcnt-stat0) (csym::diff-timevals tp0 (ptr tp-strt)) (csym::diff-timevals (ptr tp) (ptr tp-strt))) + ;; Output auxiliary data of the previous state. + (switch thr->tc-aux.type + (case OBJ-INT) + (csym::fprintf thr->fp-tc " %d" thr->tc-aux.body.aux-int) + (break) + (case OBJ-ADDR) + (csym::serialize-arg buf thr->tc-aux.body.aux-addr) + (csym::fputc #\Space thr->fp-tc) + (csym::fputs buf thr->fp-tc) + (break)) + (csym::fputc #\Newline thr->fp-tc) + ;; Save the given aux data for the next output + (= thr->tc-aux.type aux-type) + (switch aux-type + (case OBJ-INT) + (= thr->tc-aux.body.aux-int (cast int aux-body)) + (break) + (case OBJ-ADDR) + (csym::copy-address thr->tc-aux.body.aux-addr + (cast (ptr (enum addr)) aux-body)) + (break)) )) )) (return tcnt-stat0)) @@ -2073,7 +2102,6 @@ (= thr->w-none 0) (= thr->w-bcak 0) (= thr->ndiv 0) - (= thr-> 0) (= thr->probability 1.0) (= thr->last-treq i) (= thr->last-choose CHS-RANDOM) diff --git a/src/sample/tcell/worker.sh b/src/sample/tcell/worker.sh index 62084a3a..625d8d62 100644 --- a/src/sample/tcell/worker.sh +++ b/src/sample/tcell/worker.sh @@ -180,6 +180,7 @@ (static exiting-rsn-strings (array (ptr char)) (array "EXITING-NORMAL" "EXITING-EXCEPTION" "EXITING-CANCEL" "EXITING-SPAWN")) + (PROF-CODE ;;; Kinds of time counter (for evaluations) (%defconstant NKIND-TCOUNTER 10) @@ -200,8 +201,24 @@ "TCOUNTER-WAIT" "TCOUNTER-EXCP" "TCOUNTER-EXCP-WAIT" "TCOUNTER-ABRT" "TCOUNTER-ABRT-WAIT" "TCOUNTER-TREQ-BK" "TCOUNTER-TREQ-ANY")) + +;;; Obj types of auxiliary data +(def (enum obj-type) + OBJ-NULL + OBJ-INT + OBJ-ADDR ) +(def (union aux-data-body) + (def aux-int int) + (def aux-addr (array (enum addr) ARG-SIZE-MAX)) + ) +(def (struct aux-data) + (def type (enum obj-type)) + (def body (union aux-data-body)) + ) +) ; end of PROF-CODE + ;; Entry in the task stack of a worker (def (struct task) (def stat (enum task-stat)) ; task status @@ -275,6 +292,7 @@ ; start time of each state ;; time chart output (def fp-tc (ptr FILE)) ; file pointer for time chart data output + (def tc-aux (struct aux-data)) ; auxiliary data for time chart ) ;; dummy (def dummy (array char DUMMY-SIZE)) ; padding for preventing false sharing @@ -337,7 +355,8 @@ (decl (csym::tcounter-end) (fn void (ptr (struct thread-data)) (enum tcounter))) (decl (csym::tcounter-change-state) - (fn (enum tcounter) (ptr (struct thread-data)) (enum tcounter))) + (fn (enum tcounter) (ptr (struct thread-data)) (enum tcounter) + (enum obj-type) (ptr void))) (decl (csym::show-tcounter) (fn void)) ) From b07f70ce444d52618def08600b842f756324dd70 Mon Sep 17 00:00:00 2001 From: tasuku Date: Fri, 3 Oct 2014 14:52:56 +0900 Subject: [PATCH 025/105] Moved a comment to the appropriate place. --- src/sample/tcell/worker.sc | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/sample/tcell/worker.sc b/src/sample/tcell/worker.sc index 9afa95e4..149ddfb6 100644 --- a/src/sample/tcell/worker.sc +++ b/src/sample/tcell/worker.sc @@ -1657,9 +1657,9 @@ (csym::tcounter-change-state -thr TCOUNTER-ABRT OBJ-INT (cast (ptr void) -thr->task-top->cancellation))) (csym::pthread-mutex-unlock (ptr -thr->mut)) - (-bk))) + (-bk))) ; never returns (csym::pthread-mutex-unlock (ptr -thr->mut)) - ) ; never returns + ) ;; Make a task message and send it. From c47e7c25e4435f09ddb9e7b436b872f689f3490d Mon Sep 17 00:00:00 2001 From: tasuku Date: Fri, 3 Oct 2014 15:27:57 +0900 Subject: [PATCH 026/105] Modularized code for outputting aux-data as a function. --- src/sample/tcell/worker.sc | 36 ++++++++++++++++++++++-------------- src/sample/tcell/worker.sh | 2 +- 2 files changed, 23 insertions(+), 15 deletions(-) diff --git a/src/sample/tcell/worker.sc b/src/sample/tcell/worker.sc index 149ddfb6..7c9fb38d 100644 --- a/src/sample/tcell/worker.sc +++ b/src/sample/tcell/worker.sc @@ -1641,7 +1641,7 @@ (= -thr->exiting EXITING-EXCEPTION) (= -thr->exception-tag excep) (PROF-CODE - (csym::tcounter-change-state -thr TCOUNTER-EXCP OBJ-INT (cast (ptr void) excep))) + (csym::tcounter-change-state -thr TCOUNTER-EXCP OBJ-INT (cast (ptr void) (cast long excep)))) (-bk)) ; never returns ;; Check (partial) cancellation flags and abort if needed. @@ -1655,7 +1655,7 @@ (= -thr->exiting EXITING-CANCEL) (PROF-CODE (csym::tcounter-change-state -thr TCOUNTER-ABRT - OBJ-INT (cast (ptr void) -thr->task-top->cancellation))) + OBJ-INT (cast (ptr void) (cast long -thr->task-top->cancellation)))) (csym::pthread-mutex-unlock (ptr -thr->mut)) (-bk))) ; never returns (csym::pthread-mutex-unlock (ptr -thr->mut)) @@ -1978,6 +1978,22 @@ (csym::diff-timevals (ptr tp) (ptr (aref thr->tcnt-tp tcnt-stat)))) (= (aref thr->tcnt-tp tcnt-stat) tp)) + +;;; Output (struct aux-data) object pointed by paux to fp. +(def (csym::print-aux-data fp paux) + (fn void (ptr FILE) (ptr (struct aux-data))) + (def buf (array char BUFSIZE)) + (switch paux->type + (case OBJ-INT) + (csym::fprintf fp " %d" paux->body.aux-int) + (break) + (case OBJ-ADDR) + (csym::serialize-arg buf paux->body.aux-addr) + (csym::fputc #\Space fp) + (csym::fputs buf fp) + (break)) + ) + ;;; (tcounter-end ) and (tcounter-start tcnt-stat) ;;; at the same time and change the to tcnt-stat. ;;; Return the original state. @@ -1988,7 +2004,6 @@ (def tp (struct timeval)) (def tcnt-stat0 (enum tcounter)) (defs double tcnt0 tcnt) - (def buf (array char BUFSIZE)) (= tcnt-stat0 thr->tcnt-stat) ; old state (if (!= tcnt-stat0 tcnt-stat) (begin @@ -2012,22 +2027,15 @@ (aref tcounter-strings tcnt-stat0) (csym::diff-timevals tp0 (ptr tp-strt)) (csym::diff-timevals (ptr tp) (ptr tp-strt))) - ;; Output auxiliary data of the previous state. - (switch thr->tc-aux.type - (case OBJ-INT) - (csym::fprintf thr->fp-tc " %d" thr->tc-aux.body.aux-int) - (break) - (case OBJ-ADDR) - (csym::serialize-arg buf thr->tc-aux.body.aux-addr) - (csym::fputc #\Space thr->fp-tc) - (csym::fputs buf thr->fp-tc) - (break)) + ;; Output auxiliary data of the previous state. + (csym::fputc #\Space thr->fp-tc) + (csym::print-aux-data thr->fp-tc (ptr thr->tc-aux)) (csym::fputc #\Newline thr->fp-tc) ;; Save the given aux data for the next output (= thr->tc-aux.type aux-type) (switch aux-type (case OBJ-INT) - (= thr->tc-aux.body.aux-int (cast int aux-body)) + (= thr->tc-aux.body.aux-int (cast long aux-body)) (break) (case OBJ-ADDR) (csym::copy-address thr->tc-aux.body.aux-addr diff --git a/src/sample/tcell/worker.sh b/src/sample/tcell/worker.sh index 625d8d62..3ba26e36 100644 --- a/src/sample/tcell/worker.sh +++ b/src/sample/tcell/worker.sh @@ -209,7 +209,7 @@ OBJ-ADDR ) (def (union aux-data-body) - (def aux-int int) + (def aux-int long) (def aux-addr (array (enum addr) ARG-SIZE-MAX)) ) (def (struct aux-data) From 52f15d26e32b02cd03cd8fe67dbbac6a58ed66ee Mon Sep 17 00:00:00 2001 From: tasuku Date: Fri, 3 Oct 2014 18:44:23 +0900 Subject: [PATCH 027/105] Implemented event counters for profiling mode. --- src/sample/tcell/worker.sc | 108 ++++++++++++++++++++++++++----------- src/sample/tcell/worker.sh | 23 ++++++-- 2 files changed, 96 insertions(+), 35 deletions(-) diff --git a/src/sample/tcell/worker.sc b/src/sample/tcell/worker.sc index 7c9fb38d..522aa9c6 100644 --- a/src/sample/tcell/worker.sc +++ b/src/sample/tcell/worker.sc @@ -235,7 +235,7 @@ (= fp thr->fp-tc) (= thr->fp-tc 0) (csym::fclose fp))))) - (csym::show-tcounter)) + (csym::show-counters)) (csym::exit 0))) ) @@ -1699,6 +1699,8 @@ (csym::copy-address (aref tcmd.v 2) hx->task-head) ; recipient: use the information in the task request (= (aref tcmd.v 3 0) task-no) ; the kind of task (= (aref tcmd.v 3 1) TERM) + (PROF-CODE + (csym::evcounter-count thr EV-SEND-TASK OBJ-PADDR hx->task-head)) (csym::send-command (ptr tcmd) body task-no)) ;;; Wait for the result of the subtask thr->sub, remove it from the worker's subtask list, @@ -1949,6 +1951,43 @@ (PROF-CODE +;;; Initialize (struct aux-data) object pointed by paux by given type and value +(def (csym::set-aux-data paux aux-type aux-body) + (fn void (ptr (struct aux-data)) (enum obj-type) (ptr void)) + (= paux->type aux-type) + (switch aux-type + (case OBJ-INT) + (= paux->body.aux-int (cast long aux-body)) + (break) + (case OBJ-ADDR) ; copy address + (csym::copy-address paux->body.aux-addr + (cast (ptr (enum addr)) aux-body)) + (break) + (case OBJ-PADDR) ; copy pointer to address + (= paux->body.aux-paddr (cast (ptr (enum addr)) aux-body)) + (break)) + ) + +;;; Output (struct aux-data) object pointed by paux to fp. +(def (csym::print-aux-data fp paux) + (fn void (ptr FILE) (ptr (struct aux-data))) + (def buf (array char BUFSIZE)) + (switch paux->type + (case OBJ-INT) + (csym::fprintf fp " %d" paux->body.aux-int) + (break) + (case OBJ-ADDR) + (csym::serialize-arg buf paux->body.aux-addr) + (csym::fputc #\Space fp) + (csym::fputs buf fp) + (break) + (case OBJ-PADDR) + (csym::serialize-arg buf paux->body.aux-paddr) + (csym::fputc #\Space fp) + (csym::fputs buf fp) + (break)) + ) + ;;; Initialize time counters (def (csym::initialize-tcounter thr) (fn void (ptr (struct thread-data))) (def i int) @@ -1978,22 +2017,6 @@ (csym::diff-timevals (ptr tp) (ptr (aref thr->tcnt-tp tcnt-stat)))) (= (aref thr->tcnt-tp tcnt-stat) tp)) - -;;; Output (struct aux-data) object pointed by paux to fp. -(def (csym::print-aux-data fp paux) - (fn void (ptr FILE) (ptr (struct aux-data))) - (def buf (array char BUFSIZE)) - (switch paux->type - (case OBJ-INT) - (csym::fprintf fp " %d" paux->body.aux-int) - (break) - (case OBJ-ADDR) - (csym::serialize-arg buf paux->body.aux-addr) - (csym::fputc #\Space fp) - (csym::fputs buf fp) - (break)) - ) - ;;; (tcounter-end ) and (tcounter-start tcnt-stat) ;;; at the same time and change the to tcnt-stat. ;;; Return the original state. @@ -2031,22 +2054,40 @@ (csym::fputc #\Space thr->fp-tc) (csym::print-aux-data thr->fp-tc (ptr thr->tc-aux)) (csym::fputc #\Newline thr->fp-tc) - ;; Save the given aux data for the next output - (= thr->tc-aux.type aux-type) - (switch aux-type - (case OBJ-INT) - (= thr->tc-aux.body.aux-int (cast long aux-body)) - (break) - (case OBJ-ADDR) - (csym::copy-address thr->tc-aux.body.aux-addr - (cast (ptr (enum addr)) aux-body)) - (break)) + ;; Save the given aux data for the next output + (csym::set-aux-data (ptr thr->tc-aux) aux-type aux-body) )) )) (return tcnt-stat0)) -;;; Show time counters -(def (csym::show-tcounter) (fn void) +;;; Initialize event counters +(def (csym::initialize-evcounter thr) (fn void (ptr (struct thread-data))) + (def i int) + (for ((= i 0) (< i NKIND-EV) (inc i)) + (= (aref thr->ev-cnt i) 0)) + ) + +;;; Add event counter and output to log file +(def (csym::evcounter-count thr ev aux-type aux-body) + (fn int (ptr (struct thread-data)) (enum event) (enum obj-type) (ptr void)) + (def tp (struct timeval)) + (def aux (struct aux-data)) + (inc (aref thr->ev-cnt ev)) + (if thr->fp-tc + (begin + (csym::gettimeofday (ptr tp) 0) + (csym::fprintf thr->fp-tc "%s %lf" + (aref ev-strings ev) + (csym::diff-timevals (ptr tp) (ptr tp-strt))) + ;; Output auxiliary data of the previous state. + (csym::fputc #\Space thr->fp-tc) + (csym::set-aux-data (ptr aux) aux-type aux-body) + (csym::print-aux-data thr->fp-tc (ptr aux)) + (csym::fputc #\Newline thr->fp-tc))) + (return)) + +;;; Show time / event counters +(def (csym::show-counters) (fn void) (defs int i j) (def thr (ptr (struct thread-data))) (for ((= i 0) (< i num-thrs) (inc i)) @@ -2054,9 +2095,13 @@ (= thr (+ threads i)) (for ((= j 0) (< j NKIND-TCOUNTER) (inc j)) (csym::fprintf stderr "%s: %lf~%" - (aref tcounter-strings j) (aref thr->tcnt j)))) + (aref tcounter-strings j) (aref thr->tcnt j))) + (for ((= j 0) (< j NKIND-EV) (inc j)) + (csym::fprintf stderr "%s: %ld~%" + (aref ev-strings j) (aref thr->ev-cnt j)))) (return)) -) ; end PROF-CODE + +) ; end PROF-CODE ;; main (entry point) @@ -2160,6 +2205,7 @@ (for ((= i 0) (< i num-thrs) (inc i)) (let ((thr (ptr (struct thread-data)) (+ threads i))) (PROF-CODE ; initialize time counter + (csym::initialize-evcounter thr) (csym::initialize-tcounter thr)) (systhr-create (ptr thr->pthr-id) worker thr))) diff --git a/src/sample/tcell/worker.sh b/src/sample/tcell/worker.sh index 3ba26e36..1ced949c 100644 --- a/src/sample/tcell/worker.sh +++ b/src/sample/tcell/worker.sh @@ -182,7 +182,7 @@ (PROF-CODE -;;; Kinds of time counter (for evaluations) +;;; Kinds of time counter (for profiling) (%defconstant NKIND-TCOUNTER 10) (def (enum tcounter) TCOUNTER-INIT ; before execution @@ -202,15 +202,25 @@ "TCOUNTER-ABRT" "TCOUNTER-ABRT-WAIT" "TCOUNTER-TREQ-BK" "TCOUNTER-TREQ-ANY")) +;;; Kinds of events (for profiling) +(%defconstant NKIND-EV 1) +(def (enum event) + EV-SEND-TASK ; task send + ) +(static ev-strings (array (ptr char)) + (array "EV-SEND-TASK")) + ;;; Obj types of auxiliary data (def (enum obj-type) OBJ-NULL OBJ-INT OBJ-ADDR + OBJ-PADDR ) (def (union aux-data-body) (def aux-int long) (def aux-addr (array (enum addr) ARG-SIZE-MAX)) + (def aux-paddr (ptr (enum addr))) ) (def (struct aux-data) (def type (enum obj-type)) @@ -290,9 +300,11 @@ (def tcnt (array double NKIND-TCOUNTER)) ; total time of each state (def tcnt-tp (array (struct timeval) NKIND-TCOUNTER)) ; start time of each state - ;; time chart output - (def fp-tc (ptr FILE)) ; file pointer for time chart data output (def tc-aux (struct aux-data)) ; auxiliary data for time chart + ;; event (for profiling) + (def ev-cnt (array int NKIND-EV)) ; number of events + ;; time chart / event output + (def fp-tc (ptr FILE)) ; file pointer for time chart data output ) ;; dummy (def dummy (array char DUMMY-SIZE)) ; padding for preventing false sharing @@ -357,7 +369,10 @@ (decl (csym::tcounter-change-state) (fn (enum tcounter) (ptr (struct thread-data)) (enum tcounter) (enum obj-type) (ptr void))) - (decl (csym::show-tcounter) (fn void)) + (decl (csym::initialize-evcounter) (fn void (ptr (struct thread-data)))) + (decl (csym::evcounter-count) + (fn int (ptr (struct thread-data)) (enum event) (enum obj-type) (ptr void))) + (decl (csym::show-counters) (fn void)) ) ;;;; Declarations of functions in cmd-serial.sc From e3bf7ddb19f5b7aab114a720b63045cd61e47939 Mon Sep 17 00:00:00 2001 From: tasuku Date: Sat, 4 Oct 2014 16:40:59 +0900 Subject: [PATCH 028/105] (1) Implemented event coutners for profiling mode of Tascell. (2) Implemented --ignore option to timechart.pl. Changed option name '-k' to '--keep'. --- src/sample/tcell/timechart.pl | 186 ++++++++++++++++++++++++++-------- src/sample/tcell/worker.sc | 7 +- src/sample/tcell/worker.sh | 10 +- 3 files changed, 154 insertions(+), 49 deletions(-) diff --git a/src/sample/tcell/timechart.pl b/src/sample/tcell/timechart.pl index a9205ccb..06efa037 100644 --- a/src/sample/tcell/timechart.pl +++ b/src/sample/tcell/timechart.pl @@ -1,29 +1,51 @@ #/bin/env perl +use strict; +use IO::Handle; +use Getopt::Long qw(:config posix_default no_ignore_case gnu_compat); -# Plot a timechart grah from timechart log files generated by Tascell worker -# with the -T option. Employs gnuplot. - -# Usage: perl timechart.pl [-k] -# --> Read all -.dat files. is a worker id (0000-9999). -# EPS file .eps is generated. -# When -k option is given, keep all plot files and a gnuplot script after execution. +sub help { + print <<'EOS'; + + timechart.pl: Read all -.dat files generated by Tascell worker with the -T option where is a worker id (0000-9999) and generate a timechart graph as an eps file .eps. + + Usage: + + perl timechart.pl [options] + + Options: + + --keep: keep all plot files and a gnuplot script after execution. + --ignore [regexp]+: graphs for states / events whose names match this regexp are not printed. + (e.g., "--ignore EV" to ignore events and print only time chart) -use strict; -use File::Temp qw/tempfile tempdir/; +EOS + exit (1); +} -### Set parameters +### Get Command-line options # Prefix of input/output files. -my $prefix=$ARGV[0]; +my $prefix = shift (@ARGV); if ($prefix eq '') { - print "Usage: perl timechart.pl [-k]\n"; - exit 99; + print "No is specified.\n"; + help(); } +# States / events whose names match this regexp are not printed. +my @Ignore_regexp = (); # Keep plot files and gnuplot script? (-k option) my $keep_files = 0; -if ($ARGV[1] eq '-k') { +# Help +my $help = 0; + +GetOptions ( + 'ignore=s@' => \@Ignore_regexp, + 'keep!' => \$keep_files, + 'help|?' => \$help, + ) or help(); +help() if $help; + +if ( $keep_files ) { print "Keep-file option is enabled.\n"; - $keep_files = 1; } # States (equivalent to tcounter-strings in worker.sh) @@ -31,11 +53,10 @@ "TCOUNTER-WAIT","TCOUNTER-EXCP","TCOUNTER-EXCP-WAIT", "TCOUNTER-ABRT","TCOUNTER-ABRT-WAIT", "TCOUNTER-TREQ-BK","TCOUNTER-TREQ-ANY"); -# Plot file name for each state. -my %Plot_file = (); -# Whether there is any plot data for each state? -my %Valid = (); -# Color for each state. +# Events (eqivalent to ev-strings in worker.sh) +my @Evcounter = ("EV-SEND-TASK","EV-STRT-TASK","EV-RSLT-TASK","EV-EXCP-TASK","EV-ABRT-TASK"); + +# Color for each state/event. my %Color = (); $Color{'TCOUNTER-INIT'} = '"black"'; $Color{'TCOUNTER-EXEC'} = '"green"'; @@ -47,16 +68,49 @@ $Color{'TCOUNTER-ABRT-WAIT'} = '"dark-red"'; $Color{'TCOUNTER-TREQ-BK'} = '"dark-khaki"'; $Color{'TCOUNTER-TREQ-ANY'} = '"khaki"'; -# Title in legend for each state. +$Color{'EV-SEND-TASK'} = '"magenta"'; +$Color{'EV-STRT-TASK'} = '"green"'; +$Color{'EV-RSLT-TASK'} = '"green"'; +$Color{'EV-EXCP-TASK'} = '"orange"'; +$Color{'EV-ABRT-TASK'} = '"red"'; + +# Point type for each event. +my %Ptype = (); +$Ptype{'EV-SEND-TASK'} = 6; +$Ptype{'EV-STRT-TASK'} = 66; +$Ptype{'EV-RSLT-TASK'} = 67; +$Ptype{'EV-EXCP-TASK'} = 67; +$Ptype{'EV-ABRT-TASK'} = 67; + +# Offset of location of points (y-axis) for each event. +my %Offset = (); +$Offset{'EV-SEND-TASK'} = 0; +$Offset{'EV-STRT-TASK'} = 0.2; +$Offset{'EV-RSLT-TASK'} = -0.2; +$Offset{'EV-EXCP-TASK'} = -0.2; +$Offset{'EV-ABRT-TASK'} = -0.2; + +# Title in legend for each state/event. my %Title = (); -foreach my $stat (@Tcounter) { +foreach my $stat (@Tcounter, @Evcounter) { my $tit = $stat; if ($stat =~ /TCOUNTER-(\S+)/) { $tit = $1; } + if ($stat =~ /EV-(\S+)/) { + $tit = $1; + } $Title{$stat} = $tit; } +# Plot file name for each state/event. +my %Plot_file = (); +# File handler for each state/event. +my %Plot_file_fp = (); +# Whether there is any plot data for each state/event? +my %Valid = (); + + # Max of xrange (depends on max number of end time) my $x_max = 0; # Max of yrange (depends on the number of workers) @@ -65,10 +119,10 @@ # Directory to save all generated files my $dirname = "$prefix-plot"; -# Generated eps file +# eps file to be created my $fname_eps = "$prefix.eps"; -# Generated log files +# Scan log files generated by Tascell workers my @Files = (); foreach my $i (0 .. 9999) { my $fname = sprintf ("$prefix-%04d.dat", $i); @@ -93,31 +147,66 @@ # Make directory mkdir $dirname or die "Failed to generate $dirname"; -# Generate a plot file for each status -foreach my $stat (@Tcounter) { - my $id = -1; +# Open a plot file for each status/evnet to be written +foreach my $stat (@Tcounter, @Evcounter) { $Plot_file{$stat} = "$prefix-$stat.plt"; my $pltfile = "$dirname/$Plot_file{$stat}"; - $Valid{$stat} = 0; - open (FP_PLT, "> $pltfile") or die "Failed to write a plot file $pltfile"; - foreach my $file (@Files) { - $id++; - open (FP, "< $file") or die "Failed to open $file."; - while (my $line = ) { - if ($line =~ /^\s*(\S+)\s+(\S+)\s+(\S+)/) { - my ($l_stat, $start, $end) = ($1, $2, $3); + open ($Plot_file_fp{$stat}, "> $pltfile") or die "Failed to write a plot file $pltfile"; +} + +# Read log files and write to plot files. +foreach my $stat (@Tcounter, @Evcounter) { $Valid{$stat} = 0; } +my $id = -1; +foreach my $file (@Files) { + $id++; + open (FP, "< $file") or die "Failed to open $file."; + while (my $line = ) { + # status + time range? + if ($line =~ /^\s*(\S+)\s+(\S+)\s+(\S+)/) { + my ($l_stat, $start, $end) = ($1, $2, $3); + foreach my $stat (@Tcounter) { if ($l_stat eq $stat) { $Valid{$stat} = 1; if ($end > $x_max) { $x_max = $end; } - print FP_PLT "$start $id\n"; - print FP_PLT "$end $id\n"; - print FP_PLT "\n"; + $Plot_file_fp{$stat}->print("$start $id\n"); + $Plot_file_fp{$stat}->print("$end $id\n"); + $Plot_file_fp{$stat}->print("\n"); + goto LINE_END; } - } - } - close (FP); + } + } + # event + event time? + if ($line =~ /^\s*(\S+)\s+(\S+)/) { + my ($l_ev, $evtime) = ($1, $2); + foreach my $ev (@Evcounter) { + if ($l_ev eq $ev) { + $Valid{$ev} = 1; + if ($evtime > $x_max) { $x_max = $evtime; } + my $py = $id + $Offset{$ev}; + $Plot_file_fp{$ev}->print("$evtime $py\n"); + goto LINE_END; + } + } + } + LINE_END: ; + } + close (FP); +} + +# Close a plot files +foreach my $stat (@Tcounter, @Evcounter) { + close ($Plot_file_fp{$stat}); +} + +# Handle --ignore option +foreach my $stat (@Tcounter, @Evcounter) { + foreach my $reg (@Ignore_regexp) { + if ( $stat =~ $reg ) { + $Valid{$stat} = 0; + print "$stat is not printed due to --ignore $reg option\n"; + last; + } } - close (FP_PLT); } # Run gnuplot to generate an eps file and make a gnuplot script file @@ -130,7 +219,8 @@ sub print_gp { print FP_GP $str; print $str; } -print_gp "set key left top font 'Helvetica Neue,10' width 2"."\n"; +#print_gp "set key left top font 'Helvetica Neue,10' width 2"."\n"; +print_gp "set key left top"."\n"; print_gp "set xrange [-0.25:$x_max]"."\n"; print_gp "set xtics 0, 1, $x_max"."\n"; @@ -144,7 +234,6 @@ sub print_gp { print_gp "set output \"$fname_eps\""."\n"; my $replot = 0; - foreach my $stat (@Tcounter) { if ($Valid{$stat}) { print_gp (($replot==0)?'plot ':", \\\n"); @@ -152,6 +241,13 @@ sub print_gp { $replot = 1; } } +foreach my $ev (@Evcounter) { + if ($Valid{$ev}) { + print_gp (($replot==0)?'plot ':", \\\n"); + print_gp "\"$dirname/$Plot_file{$ev}\" w p lc rgb $Color{$ev} pt $Ptype{$ev} ps 0.7 title \"$Title{$ev}\""; + $replot = 1; + } +} print_gp "\n"; # Close gnuplot process and script @@ -160,7 +256,7 @@ sub print_gp { unless ($keep_files) { # remove plot files - foreach my $stat (@Tcounter) { + foreach my $stat (@Tcounter, @Evcounter) { unlink "$dirname/$Plot_file{$stat}"; } # remove gnuplot script diff --git a/src/sample/tcell/worker.sc b/src/sample/tcell/worker.sc index 522aa9c6..704172eb 100644 --- a/src/sample/tcell/worker.sc +++ b/src/sample/tcell/worker.sc @@ -529,7 +529,9 @@ (begin ;; Execute the task (PROF-CODE - (csym::tcounter-change-state thr TCOUNTER-EXEC OBJ-NULL 0)) + (csym::tcounter-change-state thr TCOUNTER-EXEC OBJ-NULL 0) + (csym::evcounter-count thr EV-STRT-TASK OBJ-PADDR tx->rslt-head) + ) (= tx->stat TASK-STARTED) ; TASK-INITIALIZED => TASK-STARTED (= tx->cancellation 0) ; initialize # of cancellation flags (= old-ndiv thr->ndiv) @@ -548,18 +550,21 @@ (DEBUG-PRINT 1 "(%d): (Thread %d) end %d<%p> (body=%p).~%" (csym::get-universal-real-time) thr->id tx->task-no tx tx->body) + (csym::evcounter-count thr EV-RSLT-TASK OBJ-PADDR tx->rslt-head) (= reason 0) (break) (case EXITING-EXCEPTION) (DEBUG-PRINT 1 "(%d): (Thread %d) end %d<%p> (body=%p) with exception %d.~%" (csym::get-universal-real-time) thr->id tx->task-no tx tx->body thr->exception-tag) + (csym::evcounter-count thr EV-EXCP-TASK OBJ-PADDR tx->rslt-head) (= reason 1) (break) (case EXITING-CANCEL) (DEBUG-PRINT 1 "(%d): (Thread %d) aborted %d<%p> (body=%p).~%" (csym::get-universal-real-time) thr->id tx->task-no tx tx->body) + (csym::evcounter-count thr EV-ABRT-TASK OBJ-PADDR tx->rslt-head) (= reason 2) (break) (default) diff --git a/src/sample/tcell/worker.sh b/src/sample/tcell/worker.sh index 1ced949c..34e72bdc 100644 --- a/src/sample/tcell/worker.sh +++ b/src/sample/tcell/worker.sh @@ -203,12 +203,16 @@ "TCOUNTER-TREQ-BK" "TCOUNTER-TREQ-ANY")) ;;; Kinds of events (for profiling) -(%defconstant NKIND-EV 1) +(%defconstant NKIND-EV 5) (def (enum event) - EV-SEND-TASK ; task send + EV-SEND-TASK ; task send (aux: recipient) + EV-STRT-TASK ; task start (aux: task sender) + EV-RSLT-TASK ; task finished normally (aux: rslt recipient) + EV-EXCP-TASK ; task finished with an exce[tion (aux: rslt recipient) + EV-ABRT-TASK ; task aborted (aux: rslt recipient) ) (static ev-strings (array (ptr char)) - (array "EV-SEND-TASK")) + (array "EV-SEND-TASK" "EV-STRT-TASK" "EV-RSLT-TASK" "EV-EXCP-TASK" "EV-ABRT-TASK")) ;;; Obj types of auxiliary data (def (enum obj-type) From 5a1c20919b8cde2f6c4f3318a56a133102f6173e Mon Sep 17 00:00:00 2001 From: Shingo OKUNO Date: Mon, 6 Oct 2014 00:18:22 +0900 Subject: [PATCH 029/105] COPINE: changed a task ID from uint64_t to the GCC extension __uint128_t --- src/sample/tcell/copine3.tcell | 58 ++++++++++----------- src/sample/tcell/copine4.tcell | 93 ++++++++++++++++++---------------- 2 files changed, 77 insertions(+), 74 deletions(-) diff --git a/src/sample/tcell/copine3.tcell b/src/sample/tcell/copine3.tcell index 368e0031..202ba609 100644 --- a/src/sample/tcell/copine3.tcell +++ b/src/sample/tcell/copine3.tcell @@ -87,9 +87,9 @@ (%defconstant DEBUG-COPY 0) ; flag to output copy file ;;; Typedef -(deftype set uint64_t) ; bitset -(deftype vtx uint32_t) ; vertex -(deftype task-id uint64_t) ; task ID +(deftype set uint64_t) ; bitset +(deftype vtx uint32_t) ; vertex +(deftype task-id __uint128_t) ; task ID ;;; Structure of ITnode (def (struct --ITnode) @@ -1412,27 +1412,27 @@ (defs (struct hsearch_data) eHash iHash) ;; Debug Data - (def numSearch uint64_t 0) ; # of search space - (def maxWorkerSearch uint64_t 0) ; - (def avgWorkerSearch double 0.0) ; - (def workerSearchSD double 0.0) ; - (def avgWorkerSearchPerSec double 0.0) ; - (def workerSearchPerSecSD double 0.0) ; - (def numTaskRequest int 0) ; # of task request - (def avgTaskRequest double 0.0) ; - (def taskRequestSD double 0.0) ; - (def numSeqTaskRequest int 0) ; # of seq. task request - (def avgSeqTaskRequest double 0.0) ; - (def seqTaskRequestSD double 0.0) ; - (def numAllTaskRequest int 0) ; # of all task request - (def avgAllTaskRequest double 0.0) ; - (def allTaskRequestSD double 0.0) ; - (def numTableReference uint64_t 0) ; - (def avgTableReference double 0.0) ; - (def tableReferenceSD double 0.0) ; - (def avgSizeSubgraph uint64_t 0) ; - (def maxSizeSubgraph int 0) ; - + (def numSearch uint64_t 0) ; # of search space + (def maxWorkerSearch uint64_t 0) ; + (def minWorkerSearch uint64_t UINT-LEAST64-MAX) ; + (def avgWorkerSearch double 0.0) ; + (def workerSearchSD double 0.0) ; + (def avgWorkerSearchPerSec double 0.0) ; + (def workerSearchPerSecSD double 0.0) ; + (def numTaskRequest int 0) ; # of task request + (def avgTaskRequest double 0.0) ; + (def taskRequestSD double 0.0) ; + (def numSeqTaskRequest int 0) ; # of seq. task request + (def avgSeqTaskRequest double 0.0) ; + (def seqTaskRequestSD double 0.0) ; + (def numAllTaskRequest int 0) ; # of all task request + (def avgAllTaskRequest double 0.0) ; + (def allTaskRequestSD double 0.0) ; + (def numTableReference uint64_t 0) ; + (def avgTableReference double 0.0) ; + (def tableReferenceSD double 0.0) ; + (def avgSizeSubgraph uint64_t 0) ; + (def maxSizeSubgraph int 0) ; ;; arguments (= patternFile "data/symatlas_pattern.txt") @@ -1467,7 +1467,7 @@ ;; set ID (= (fref tsk minID) 0) - (= (fref tsk maxID) UINT-LEAST64-MAX) + (= (fref tsk maxID) (bit-not (cast task-id 0))) ;; init pthread ;(csym::pthread_attr_init (ptr attr)) @@ -1540,7 +1540,7 @@ ;; re-set ID (= (fref tsk minID) 0) - (= (fref tsk maxID) UINT-LEAST64-MAX)) + (= (fref tsk maxID) (bit-not (cast task-id 0)))) (enumCCIG i (+ maxVertex 1) (ptr tsk)) ;(for ((= j 1) (< j (fref this loopRatio)) (inc j)) @@ -1673,8 +1673,6 @@ (csym::fprintf stderr "time = %f[sec]~%" (csym::elapsedTime tp (+ tp 1))) (csym::fprintf stderr "user time = %f[sec]~%" (- t2 t1)) (csym::fprintf stderr "# of subgraphs = %d~%" (fref tsk numSubgraph)) - (csym::fprintf stderr "# of thresholds = %llu~%" (fref tsk numThreshold)) - (csym::fprintf stderr "# of prunings = %u~%" (fref tsk numPruning)) (csym::fprintf stderr "Avg. size of tree depth = %f~%" (/ (cast double (fref tsk treeDepth)) (cast double (fref tsk numTraversed)))) (%if* DEBUG-RSLT (begin (csym::fprintf stderr "Max size of subgraph = %d~%" maxSizeSubgraph) @@ -1688,6 +1686,8 @@ aref inclusivePruning j))) (+= numSearch (aref searchSpace j)) (if (< maxWorkerSearch (aref searchSpace j)) (= maxWorkerSearch (aref searchSpace j))) + (if (> minWorkerSearch (aref searchSpace j)) + (= minWorkerSearch (aref searchSpace j))) (+= avgWorkerSearchPerSec (/ (aref searchSpace j) (csym::elapsedTime tp (+ tp 1)))) (+= numTaskRequest (aref taskRequest j)) (+= numSeqTaskRequest (aref seqTaskRequest j)) @@ -1721,7 +1721,7 @@ aref inclusivePruning j))) (= allTaskRequestSD (csym::sqrt allTaskRequestSD)) (= tableReferenceSD (csym::sqrt tableReferenceSD)) - (csym::fprintf stderr "# of searches = %llu, Max = %d, Avg. = %.1f, S.D. = %.1f~%" numSearch maxWorkerSearch avgWorkerSearch workerSearchSD) + (csym::fprintf stderr "# of searches = %llu, Min = %llu, Max = %llu, Avg. = %.1f, S.D. = %.1f~%" numSearch minWorkerSearch maxWorkerSearch avgWorkerSearch workerSearchSD) (csym::fprintf stderr "# of task requests = %d, Avg. = %.1f, S.D. = %.1f~%" numTaskRequest avgTaskRequest taskRequestSD) (csym::fprintf stderr "# of seq. task requests = %d, Avg. = %.1f, S.D. = %.1f~%" numSeqTaskRequest avgSeqTaskRequest seqTaskRequestSD) (csym::fprintf stderr "# of all task requests = %d, Avg. = %.1f, S.D. = %.1f~%" numAllTaskRequest avgAllTaskRequest allTaskRequestSD) diff --git a/src/sample/tcell/copine4.tcell b/src/sample/tcell/copine4.tcell index 80637c19..707066da 100644 --- a/src/sample/tcell/copine4.tcell +++ b/src/sample/tcell/copine4.tcell @@ -88,9 +88,9 @@ (%defconstant DEBUG-COPY 0) ; flag to output copy file ;;; Typedef -(deftype set uint64_t) ; bitset -(deftype vtx uint32_t) ; vertex -(deftype task-id uint64_t) ; task ID +(deftype set uint64_t) ; bitset +(deftype vtx uint32_t) ; vertex +(deftype task-id __uint128_t) ; task ID ;;; Structure of ITnode (def (struct --ITnode) @@ -1774,32 +1774,33 @@ (defs (struct hsearch_data) eHash iHash) ;; Debug Data - (def numSearch uint64_t 0) ; # of search spaces - (def maxWorkerSearch uint64_t 0) ; - (def avgWorkerSearch double 0.0) ; - (def workerSearchSD double 0.0) ; - (def avgWorkerSearchPerSec double 0.0) ; - (def workerSearchPerSecSD double 0.0) ; - (def numTaskRequest int 0) ; # of task requests - (def avgTaskRequest double 0.0) ; - (def taskRequestSD double 0.0) ; - (def numSeqTaskRequest int 0) ; # of seq. task requests - (def avgSeqTaskRequest double 0.0) ; - (def seqTaskRequestSD double 0.0) ; - (def numAllTaskRequest int 0) ; # of all task requests - (def avgAllTaskRequest double 0.0) ; - (def allTaskRequestSD double 0.0) ; - (def numTableReference uint64_t 0) ; - (def avgTableReference double 0.0) ; - (def tableReferenceSD double 0.0) ; - (def avgSizeSubgraph uint64_t 0) ; - (def maxSizeSubgraph int 0) ; - (def numFindRedundant int 0) ; # of finding redundant searches - (def avgFindRedundant double 0.0) ; - (def findRedundantSD double 0.0) ; - (def numThrowException int 0) ; # of thrown exceptions - (def avgThrowException double 0.0) ; - (def throwExceptionSD double 0.0) ; + (def numSearch uint64_t 0) ; # of search spaces + (def maxWorkerSearch uint64_t 0) ; + (def minWorkerSearch uint64_t UINT-LEAST64-MAX) ; + (def avgWorkerSearch double 0.0) ; + (def workerSearchSD double 0.0) ; + (def avgWorkerSearchPerSec double 0.0) ; + (def workerSearchPerSecSD double 0.0) ; + (def numTaskRequest int 0) ; # of task requests + (def avgTaskRequest double 0.0) ; + (def taskRequestSD double 0.0) ; + (def numSeqTaskRequest int 0) ; # of seq. task requests + (def avgSeqTaskRequest double 0.0) ; + (def seqTaskRequestSD double 0.0) ; + (def numAllTaskRequest int 0) ; # of all task requests + (def avgAllTaskRequest double 0.0) ; + (def allTaskRequestSD double 0.0) ; + (def numTableReference uint64_t 0) ; + (def avgTableReference double 0.0) ; + (def tableReferenceSD double 0.0) ; + (def avgSizeSubgraph uint64_t 0) ; + (def maxSizeSubgraph int 0) ; + (def numFindRedundant int 0) ; # of finding redundant searches + (def avgFindRedundant double 0.0) ; + (def findRedundantSD double 0.0) ; + (def numThrowException int 0) ; # of thrown exceptions + (def avgThrowException double 0.0) ; + (def throwExceptionSD double 0.0) ; ;; arguments (= patternFile "data/symatlas_pattern.txt") @@ -1815,26 +1816,26 @@ (= resultFile "result.txt") (if USE-SPN-RANGE (begin - (csym::sprintf timeFile "time3-%02d_%d-%d.csv" (fref option num-thrs) (fref this th) (fref this spawnSize)) - (csym::sprintf taskFile "task3-%02d_%d-%d.csv" (fref option num-thrs) (fref this th) (fref this spawnSize)) - (csym::sprintf lockFile "lock3-%02d_%d-%d.csv" (fref option num-thrs) (fref this th) (fref this spawnSize)) - (csym::sprintf copyFile "copy3-%02d_%d-%d.csv" (fref option num-thrs) (fref this th) (fref this spawnSize))) + (csym::sprintf timeFile "time4-%02d_%d-%d.csv" (fref option num-thrs) (fref this th) (fref this spawnSize)) + (csym::sprintf taskFile "task4-%02d_%d-%d.csv" (fref option num-thrs) (fref this th) (fref this spawnSize)) + (csym::sprintf lockFile "lock4-%02d_%d-%d.csv" (fref option num-thrs) (fref this th) (fref this spawnSize)) + (csym::sprintf copyFile "copy4-%02d_%d-%d.csv" (fref option num-thrs) (fref this th) (fref this spawnSize))) (begin (if USE-SPN-RATIO (begin - (csym::sprintf timeFile "time3-%02d_%d_%d.csv" (fref option num-thrs) (fref this th) (fref this spawnSize)) - (csym::sprintf taskFile "task3-%02d_%d_%d.csv" (fref option num-thrs) (fref this th) (fref this spawnSize)) - (csym::sprintf lockFile "lock3-%02d_%d_%d.csv" (fref option num-thrs) (fref this th) (fref this spawnSize)) - (csym::sprintf copyFile "copy3-%02d_%d_%d.csv" (fref option num-thrs) (fref this th) (fref this spawnSize))) + (csym::sprintf timeFile "time4-%02d_%d_%d.csv" (fref option num-thrs) (fref this th) (fref this spawnSize)) + (csym::sprintf taskFile "task4-%02d_%d_%d.csv" (fref option num-thrs) (fref this th) (fref this spawnSize)) + (csym::sprintf lockFile "lock4-%02d_%d_%d.csv" (fref option num-thrs) (fref this th) (fref this spawnSize)) + (csym::sprintf copyFile "copy4-%02d_%d_%d.csv" (fref option num-thrs) (fref this th) (fref this spawnSize))) (begin - (csym::sprintf timeFile "time3-%02d_%d-half.csv" (fref option num-thrs) (fref this th)) - (csym::sprintf taskFile "task3-%02d_%d-half.csv" (fref option num-thrs) (fref this th)) - (csym::sprintf lockFile "lock3-%02d_%d-half.csv" (fref option num-thrs) (fref this th)) - (csym::sprintf copyFile "copy3-%02d_%d-half.csv" (fref option num-thrs) (fref this th)))))) + (csym::sprintf timeFile "time4-%02d_%d-half.csv" (fref option num-thrs) (fref this th)) + (csym::sprintf taskFile "task4-%02d_%d-half.csv" (fref option num-thrs) (fref this th)) + (csym::sprintf lockFile "lock4-%02d_%d-half.csv" (fref option num-thrs) (fref this th)) + (csym::sprintf copyFile "copy4-%02d_%d-half.csv" (fref option num-thrs) (fref this th)))))) ;; set ID (= (fref tsk minID) 0) - (= (fref tsk maxID) UINT-LEAST64-MAX) + (= (fref tsk maxID) (bit-not (cast task-id 0))) ;; init pthread ;(csym::pthread_attr_init (ptr attr)) @@ -1909,7 +1910,7 @@ ;; re-set ID (= (fref tsk minID) 0) - (= (fref tsk maxID) UINT-LEAST64-MAX)) + (= (fref tsk maxID) (bit-not (cast task-id 0)))) (enumCCIG i (+ maxVertex 1) (ptr tsk)) ;(for ((= j 1) (< j (fref this loopRatio)) (inc j)) @@ -2056,6 +2057,8 @@ (+= numSearch (aref searchSpace j)) (if (< maxWorkerSearch (aref searchSpace j)) (= maxWorkerSearch (aref searchSpace j))) + (if (> minWorkerSearch (aref searchSpace j)) + (= minWorkerSearch (aref searchSpace j))) (+= avgWorkerSearchPerSec (/ (aref searchSpace j) (csym::elapsedTime tp (+ tp 1)))) (+= numTaskRequest (aref taskRequest j)) (+= numSeqTaskRequest (aref seqTaskRequest j)) @@ -2099,7 +2102,7 @@ (= findRedundantSD (csym::sqrt findRedundantSD)) (= throwExceptionSD (csym::sqrt throwExceptionSD)) - (csym::fprintf stderr "# of searches = %llu, Max = %d, Avg. = %.1f, S.D. = %.1f~%" numSearch maxWorkerSearch avgWorkerSearch workerSearchSD) + (csym::fprintf stderr "# of searches = %llu, Min = %llu, Max = %llu, Avg. = %.1f, S.D. = %.1f~%" numSearch minWorkerSearch maxWorkerSearch avgWorkerSearch workerSearchSD) (csym::fprintf stderr "# of task requests = %d, Avg. = %.1f, S.D. = %.1f~%" numTaskRequest avgTaskRequest taskRequestSD) (csym::fprintf stderr "# of seq. task requests = %d, Avg. = %.1f, S.D. = %.1f~%" numSeqTaskRequest avgSeqTaskRequest seqTaskRequestSD) (csym::fprintf stderr "# of all task requests = %d, Avg. = %.1f, S.D. = %.1f~%" numAllTaskRequest avgAllTaskRequest allTaskRequestSD) @@ -2110,4 +2113,4 @@ (csym::fprintf stderr "# of Emutex trylock = %llu, " (fref tsk numEmutexTrylock)) (csym::fprintf stderr "# of Emutex locked = %llu(%.3f%%)~%" (fref tsk numEmutexLocked) (* (/ (cast double (fref tsk numEmutexLocked)) (cast double (fref tsk numEmutexTrylock))) 100.0)) (csym::fprintf stderr "# of finding redundant searches = %d, Avg. = %.1f, S.D. = %.1f~%" numFindRedundant avgFindRedundant findRedundantSD) - (csym::fprintf stderr "# of throwing exceptions = %d, Avg. = %.1f, S.D. =%.1f~%" numThrowException avgThrowException throwExceptionSD)) + (csym::fprintf stderr "# of throwing exceptions = %d, Avg. = %.1f, S.D. = %.1f~%" numThrowException avgThrowException throwExceptionSD)) From 6799123c64185480f6272c6a4148bf4d6c9c3eba Mon Sep 17 00:00:00 2001 From: Shingo OKUNO Date: Wed, 8 Oct 2014 00:16:11 +0900 Subject: [PATCH 030/105] COPINE: Associated a pair of multiple-length integers with each task as its task ID. --- src/sample/tcell/copine3.tcell | 125 ++++++++++++++++++++++---------- src/sample/tcell/copine4.tcell | 129 +++++++++++++++++++++++---------- 2 files changed, 178 insertions(+), 76 deletions(-) diff --git a/src/sample/tcell/copine3.tcell b/src/sample/tcell/copine3.tcell index 202ba609..a430aa3e 100644 --- a/src/sample/tcell/copine3.tcell +++ b/src/sample/tcell/copine3.tcell @@ -71,6 +71,8 @@ ;;; Constants (%defconstant E-SIZE 500000) ; # of edges (%defconstant V-SIZE 25000) ; # of vertices +(%defconstant TID_LEN 128) ; bit length of task id +(%defconstant TID_NUM 4) ; # of task id (%defconstant BIT-LEN 64) ; bit length of bitset (%defconstant BIT-ITEM 3) ; # of items = BIT-ITEM * BIT-LEN (%defconstant BIT-EDGE 8125) ; # of edges = BIT-EDGE * BIT-LEN @@ -93,8 +95,8 @@ ;;; Structure of ITnode (def (struct --ITnode) - (decl minID task-id) ; task ID - (decl maxID task-id) ; task ID + (decl minID (array task-id TID_NUM)) ; task ID + (decl maxID (array task-id TID_NUM)) ; task ID (decl item (array set BIT-ITEM)) ; itemset (decl prev (ptr (struct --ITnode))) ; pointer to the previous node (decl next (ptr (struct --ITnode)))) ; pointer to the next node @@ -222,19 +224,70 @@ ;;; Function: resetTaskID - (def (csym::resetTaskID param) (fn (ptr void) (ptr void)) - (decl i int) + (defs int i j) (def data (ptr threadInfo) (cast (ptr threadInfo) param)) (decl ITptr (ptr ITnode)) ; pointer to the ITnode (for ((= i (fref data -> loopStart)) (< i (fref data -> loopEnd)) (inc i)) (= ITptr (fref (fref (aref vItemTable i) head) -> next)) (while (!= ITptr (fref (aref vItemTable i) head)) - (= (fref ITptr -> minID) (cast task-id 0)) - (= (fref ITptr -> maxID) (cast task-id 0)) + (for ((= j 0) (< j TID_NUM) (inc j)) + (= (aref (fref ITptr -> minID) j) (cast task-id 0)) + (= (aref (fref ITptr -> maxID) j) (cast task-id 0))) (= ITptr (fref ITptr -> next)))) (csym::pthread_exit 0)) +;;; Function: compareTaskID - +(def (csym::compareTaskID id1 id2) (fn int (ptr task-id) (ptr task-id)) + (decl i int) + (for ((= i (- TID_NUM 1)) (>= i 0) (dec i)) + (if (> (aref id1 i) (aref id2 i)) + (begin + (return 1)) + (if (< (aref id1 i) (aref id2 i)) + (return -1)))) + (return 0)) + +;;; Function: divideTaskID - +(def (csym::divideTaskID victimMin victimMax thiefMin thiefMax) (fn void (ptr task-id) (ptr task-id) (ptr task-id) (ptr task-id)) + (defs int i flagU flagD Co) + (def maxValue task-id -1) + (def carryDown task-id (<< (cast task-id 1) (- TID_LEN 1))) + + (csym::memcpy thiefMax victimMax (* (sizeof task-id) TID_NUM)) + + (for ((= flagU 0) (= flagD 0) (= i 0) (< i TID_NUM) (inc i)) + (if (> (aref victimMin i) (- maxValue (aref victimMax i))) + (= flagU 1)) + (+= (aref victimMax i) (aref victimMin i)) + (if (and (== (aref victimMax i) maxValue) flagD) + (= flagU 1)) + (if flagD + (+= (aref victimMax i) (cast task-id 1))) + (= Co flagU) + (= flagD flagU) + (= flagU 0)) + (= flagU Co) + (for ((= i (- TID_NUM 1)) (>= i 0) (dec i)) + (if (bit-and (aref victimMax i) (cast task-id 1)) + (= flagD 1)) + (>>= (aref victimMax i) 1) + (if flagU + (bit-or= (aref victimMax i) carryDown)) + (= flagU flagD) + (= flagD 0)) + + (csym::memcpy thiefMin victimMax (* (sizeof task-id) TID_NUM))) + +;;; Function: rangeTaskID - +(def (csym::rangeTaskID minID maxID) (fn __int128_t (ptr task-id) (ptr task-id)) + (decl i int) + (for ((= i (- TID_NUM 1)) (> i 0) (dec i)) + (if (< (aref minID i) (aref maxID i)) + (return -1))) + (return (- (aref maxID 0) (aref minID 0)))) + ;;; Function: allocITnode - allocate a ITnode (def (csym::allocITnode) (fn (ptr ITnode)) (return (cast (ptr ITnode) (csym::malloc(sizeof ITnode))))) @@ -247,8 +300,9 @@ (def (csym::initITlist list) (fn void (ptr ITlist)) (decl i int) (def dummyNode (ptr ITnode) (csym::allocITnode)) - (= (fref dummyNode -> minID) (cast task-id 0)) - (= (fref dummyNode -> maxID) (cast task-id 0)) + (for ((= i 0) (< i TID_NUM) (inc i)) + (= (aref (fref dummyNode -> minID) i) (cast task-id 0)) + (= (aref (fref dummyNode -> maxID) i) (cast task-id 0))) (for ((= i 0) (< i BIT-ITEM) (inc i)) (= (aref (fref dummyNode -> item) i) (cast set 0))) (= (fref list -> crnt) dummyNode) @@ -257,14 +311,14 @@ (= (fref dummyNode -> prev) dummyNode)) ;;; Function: insertITnodeAfter - insert a new ITnode after the pointer 'p' -(def (csym::insertITnodeAfter list p minID maxID item) (fn void (ptr ITlist) (ptr ITnode) task-id task-id (array set)) +(def (csym::insertITnodeAfter list p minID maxID item) (fn void (ptr ITlist) (ptr ITnode) (ptr task-id) (ptr task-id) (array set)) (decl i int) (def new (ptr ITnode) (csym::allocITnode)) (def nxt (ptr ITnode) (fref p -> next)) (= (fref (fref p -> next) -> prev) new) (= (fref p -> next) new) - (= (fref new -> minID) minID) - (= (fref new -> maxID) maxID) + (csym::memcpy (fref new -> minID) minID (* (sizeof task-id) TID_NUM)) + (csym::memcpy (fref new -> maxID) maxID (* (sizeof task-id) TID_NUM)) (for ((= i 0) (< i BIT-ITEM) (inc i)) (= (aref (fref new -> item) i) (aref item i))) (= (fref new -> prev) p) @@ -347,8 +401,8 @@ ;;; (def (task T-exploreCCIG) - (def minID task-id) - (def maxID task-id) + (def minID (array task-id TID_NUM)) + (def maxID (array task-id TID_NUM)) (def minC int) (def maxC int) (def v int) @@ -474,7 +528,7 @@ (= ITptr (fref (fref (aref vItemTable vv) head) -> next)) (while (!= ITptr (fref (aref vItemTable vv) head)) (inc (fref pTsk -> numTableReference)) - (if (<= (fref ITptr -> minID) (fref pTsk -> minID)) + (if (<= (csym::compareTaskID (fref ITptr -> minID) (fref pTsk -> minID)) 0) (begin (for ((= k 0) (= m 0) (< k BIT-ITEM) (inc k)) (if (== (cast set (bit-and (aref commonItem k) (aref (fref ITptr -> item) k))) (aref commonItem k)) @@ -510,7 +564,7 @@ (= ITptr (fref (fref (aref vItemTable vv) head) -> next)) (while (!= ITptr (fref (aref vItemTable vv) head)) (inc (fref pTsk -> numTableReference)) - (if (>= (fref ITptr -> minID) (fref pTsk -> minID)) + (if (>= (csym::compareTaskID (fref ITptr -> minID) (fref pTsk -> minID)) 0) (begin (for ((= k 0) (= m 0) (< k BIT-ITEM) (inc k)) (if (== (cast set (bit-and (aref (fref ITptr -> item) k) (aref commonItem k))) (aref (fref ITptr -> item) k)) @@ -644,7 +698,7 @@ (= ITptr (fref (fref (aref vItemTable vv) head) -> next)) (while (!= ITptr (fref (aref vItemTable vv) head)) (inc (fref pTsk -> numTableReference)) - (if (<= (fref ITptr -> minID) (fref pTsk -> minID)) + (if (<= (csym::compareTaskID (fref ITptr -> minID) (fref pTsk -> minID)) 0) (begin (for ((= k 0) (= m 0) (< k BIT-ITEM) (inc k)) (if (== (cast set (bit-and (aref commonItem k) (aref (fref ITptr -> item) k))) (aref commonItem k)) @@ -680,7 +734,7 @@ (= ITptr (fref (fref (aref vItemTable vv) head) -> next)) (while (!= ITptr (fref (aref vItemTable vv) head)) (inc (fref pTsk -> numTableReference)) - (if (>= (fref ITptr -> minID) (fref pTsk -> minID)) + (if (>= (csym::compareTaskID (fref ITptr -> minID) (fref pTsk -> minID)) 0) (begin (for ((= k 0) (= m 0) (< k BIT-ITEM) (inc k)) (if (== (cast set (bit-and (aref (fref ITptr -> item) k) (aref commonItem k))) (aref (fref ITptr -> item) k)) @@ -731,7 +785,7 @@ (csym::fprintf stderr "> %d~%" (aref (fref pTsk -> T) (- (fref pTsk -> numT) 1)))))) ;; recursive call - (if (> (- (fref pTsk -> maxID) (fref pTsk -> minID)) (fref pTsk -> numC)) + (if (or (== (csym::rangeTaskID (fref pTsk -> minID) (fref pTsk -> maxID)) -1) (> (csym::rangeTaskID (fref pTsk -> minID) (fref pTsk -> maxID)) (fref pTsk -> numC))) (begin (exploreCCIG 0 (fref pTsk -> numC) vv commonItem pTsk)) (begin @@ -775,9 +829,7 @@ (csym::gettimeofday tpc 0))) (= (fref this minC) i1) (= (fref this maxC) i2) - (= (fref this maxID) (fref pTsk -> maxID)) - (= (fref pTsk -> maxID) (+ (cast task-id (* (- (fref pTsk -> maxID) (fref pTsk -> minID)) 0.5)) (fref pTsk -> minID))) - (= (fref this minID) (fref pTsk -> maxID)) + (csym::divideTaskID (fref pTsk -> minID) (fref pTsk -> maxID) (fref this minID) (fref this maxID)) (initExploreCCIG 1 NULL NULL NULL (ptr this)) (= (fref this v) v) (csym::memcpy (fref this itemSet) itemSet (* (sizeof set) BIT-ITEM)) @@ -821,10 +873,8 @@ (decl seq int) (decl tp (array (struct timeval) 2)) (inc (aref taskRequest (fref -thr -> id))) - (if (> (fref this minID) (fref this maxID)) - (csym::fprintf stderr "minID = %llu, maxID = %llu~%" (fref this minID) (fref this maxID))) (csym::gettimeofday tp 0) - (if (> (- (fref this maxID) (fref this minID)) (- (fref this maxC) (fref this minC))) + (if (or (== (csym::rangeTaskID (fref this minID) (fref this maxID)) -1) (> (csym::rangeTaskID (fref this minID) (fref this maxID)) (- (fref this maxC) (fref this minC)))) (begin (= seq 0) (exploreCCIG (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this))) @@ -886,7 +936,7 @@ (csym::fprintf fpLock "%f, %d~%" (csym::elapsedTime tp (+ tp 1)) locked))))) (= ITptr (fref (fref (aref vItemTable i) head) -> next)) (inc (fref pTsk -> numTableReference)) - (if (<= (fref ITptr -> minID) (fref pTsk -> minID)) + (if (<= (csym::compareTaskID (fref ITptr -> minID) (fref pTsk -> minID)) 0) (begin (for ((= k 0) (< k BIT-ITEM) (inc k)) (if (!= (cast set (bit-and (aref vItem i k) (aref (fref ITptr -> item) k))) (aref vItem i k)) @@ -993,7 +1043,7 @@ (csym::fprintf fpLock "%f, %d~%" (csym::elapsedTime tp (+ tp 1)) locked))))) (= ITptr (fref (fref (aref vItemTable i) head) -> next)) (inc (fref pTsk -> numTableReference)) - (if (<= (fref ITptr -> minID) (fref pTsk -> minID)) + (if (<= (csym::compareTaskID (fref ITptr -> minID) (fref pTsk -> minID)) 0) (begin (for ((= k 0) (< k BIT-ITEM) (inc k)) (if (!= (cast set (bit-and (aref vItem i k) (aref (fref ITptr -> item) k))) (aref vItem i k)) @@ -1042,7 +1092,7 @@ (inc (fref pTsk -> treeDepth)) (inc (fref pTsk -> numTraversed)) - (if (> (- (fref pTsk -> maxID) (fref pTsk -> minID)) (fref pTsk -> numC)) + (if (or (== (csym::rangeTaskID (fref pTsk -> minID) (fref pTsk -> maxID)) -1) (> (csym::rangeTaskID (fref pTsk -> minID) (fref pTsk -> maxID)) (fref pTsk -> numC))) (begin (exploreCCIG 0 (fref pTsk -> numC) i (aref vItem i) pTsk)) (begin @@ -1078,9 +1128,7 @@ (csym::gettimeofday tpc 0))) (= (fref this minVertex) i1) (= (fref this maxVertex) i2) - (= (fref (fref this tsk) maxID) (fref pTsk -> maxID)) - (= (fref pTsk -> maxID) (+ (cast task-id (* (- (fref pTsk -> maxID) (fref pTsk -> minID)) 0.5)) (fref pTsk -> minID))) - (= (fref (fref this tsk) minID) (fref pTsk -> maxID)) + (csym::divideTaskID (fref pTsk -> minID) (fref pTsk -> maxID) (fref (fref this tsk) minID) (fref (fref this tsk) maxID)) (initExploreCCIG 0 NULL NULL NULL (ptr (fref this tsk))) (%if* DEBUG-COPY (begin (csym::gettimeofday (+ tpc 1) 0)))) @@ -1111,7 +1159,7 @@ (decl tp (array (struct timeval) 2)) (inc (aref taskRequest (fref -thr -> id))) (csym::gettimeofday tp 0) - (if (> (- (fref (fref this tsk) maxID) (fref (fref this tsk) minID)) (- (fref this maxVertex) (fref this minVertex))) + (if (or (== (csym::rangeTaskID (fref (fref this tsk) minID) (fref (fref this tsk) maxID)) -1) (> (csym::rangeTaskID (fref (fref this tsk) minID) (fref (fref this tsk) maxID)) (- (fref this maxVertex) (fref this minVertex)))) (begin (= seq 0) (enumCCIG (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk)))) @@ -1373,7 +1421,7 @@ ;;; Main (def (task-body T-startCCIG) - (defs int i j k) ; temporary variable + (defs int i j k l) ; temporary variable (decl tp (array (struct timeval) 2)) ; start time, end time (defs double t1 t2) ; start user time, end user time (decl loopRange int) ; loop range of enumCCIG @@ -1466,8 +1514,9 @@ (csym::sprintf copyFile "copy3-%02d_%d-half.csv" (fref option num-thrs) (fref this th)))))) ;; set ID - (= (fref tsk minID) 0) - (= (fref tsk maxID) (bit-not (cast task-id 0))) + (for ((= i 0) (< i TID_NUM) (inc i)) + (= (aref (fref tsk minID) i) 0) + (= (aref (fref tsk maxID) i) -1)) ;; init pthread ;(csym::pthread_attr_init (ptr attr)) @@ -1534,13 +1583,15 @@ (for ((= k minVertex) (< k (+ maxVertex 1)) (inc k)) (= ITptr (fref (fref (aref vItemTable k) head) -> next)) (while (!= ITptr (fref (aref vItemTable k) head)) - (= (fref ITptr -> minID) (cast task-id 0)) - (= (fref ITptr -> maxID) (cast task-id 0)) + (for ((= l 0) (< l TID_NUM) (inc l)) + (= (aref (fref ITptr -> minID) l) (cast task-id 0)) + (= (aref (fref ITptr -> maxID) l) (cast task-id 0))) (= ITptr (fref ITptr -> next)))) ;; re-set ID - (= (fref tsk minID) 0) - (= (fref tsk maxID) (bit-not (cast task-id 0)))) + (for ((= l 0) (< l TID_NUM) (inc l)) + (= (aref (fref tsk minID) l) 0) + (= (aref (fref tsk maxID) l) -1))) (enumCCIG i (+ maxVertex 1) (ptr tsk)) ;(for ((= j 1) (< j (fref this loopRatio)) (inc j)) diff --git a/src/sample/tcell/copine4.tcell b/src/sample/tcell/copine4.tcell index 707066da..52f2e8e4 100644 --- a/src/sample/tcell/copine4.tcell +++ b/src/sample/tcell/copine4.tcell @@ -71,6 +71,8 @@ ;;; Constants (%defconstant E-SIZE 500000) ; # of edges (%defconstant V-SIZE 25000) ; # of vertices +(%defconstant TID_LEN 128) ; bit length of task id +(%defconstant TID_NUM 4) ; # of task id (%defconstant BIT-LEN 64) ; bit length of bitset (%defconstant BIT-ITEM 3) ; # of items = BIT-ITEM * BIT-LEN (%defconstant BIT-EDGE 8125) ; # of edges = BIT-EDGE * BIT-LEN @@ -94,8 +96,8 @@ ;;; Structure of ITnode (def (struct --ITnode) - (decl minID task-id) ; task ID - (decl maxID task-id) ; task ID + (decl minID (array task-id TID_NUM)) ; task ID + (decl maxID (array task-id TID_NUM)) ; task ID (decl item (array set BIT-ITEM)) ; itemset (decl worker int) ; worker ID (decl flagRedundant int) ; flag indicating redundant search @@ -233,19 +235,70 @@ ;;; Function: resetTaskID - (def (csym::resetTaskID param) (fn (ptr void) (ptr void)) - (decl i int) + (defs int i j) (def data (ptr threadInfo) (cast (ptr threadInfo) param)) (decl ITptr (ptr ITnode)) ; pointer to the ITnode (for ((= i (fref data -> loopStart)) (< i (fref data -> loopEnd)) (inc i)) (= ITptr (fref (fref (aref vItemTable i) head) -> next)) (while (!= ITptr (fref (aref vItemTable i) head)) - (= (fref ITptr -> minID) (cast task-id 0)) - (= (fref ITptr -> maxID) (cast task-id 0)) + (for ((= j 0) (< j TID_NUM) (inc j)) + (= (aref (fref ITptr -> minID) j) (cast task-id 0)) + (= (aref (fref ITptr -> maxID) j) (cast task-id 0))) (= ITptr (fref ITptr -> next)))) (csym::pthread_exit 0)) +;;; Function: compareTaskID - +(def (csym::compareTaskID id1 id2) (fn int (ptr task-id) (ptr task-id)) + (decl i int) + (for ((= i (- TID_NUM 1)) (>= i 0) (dec i)) + (if (> (aref id1 i) (aref id2 i)) + (begin + (return 1)) + (if (< (aref id1 i) (aref id2 i)) + (return -1)))) + (return 0)) + +;;; Function: divideTaskID - +(def (csym::divideTaskID victimMin victimMax thiefMin thiefMax) (fn void (ptr task-id) (ptr task-id) (ptr task-id) (ptr task-id)) + (defs int i flagU flagD Co) + (def maxValue task-id -1) + (def carryDown task-id (<< (cast task-id 1) (- TID_LEN 1))) + + (csym::memcpy thiefMax victimMax (* (sizeof task-id) TID_NUM)) + + (for ((= flagU 0) (= flagD 0) (= i 0) (< i TID_NUM) (inc i)) + (if (> (aref victimMin i) (- maxValue (aref victimMax i))) + (= flagU 1)) + (+= (aref victimMax i) (aref victimMin i)) + (if (and (== (aref victimMax i) maxValue) flagD) + (= flagU 1)) + (if flagD + (+= (aref victimMax i) (cast task-id 1))) + (= Co flagU) + (= flagD flagU) + (= flagU 0)) + (= flagU Co) + (for ((= i (- TID_NUM 1)) (>= i 0) (dec i)) + (if (bit-and (aref victimMax i) (cast task-id 1)) + (= flagD 1)) + (>>= (aref victimMax i) 1) + (if flagU + (bit-or= (aref victimMax i) carryDown)) + (= flagU flagD) + (= flagD 0)) + + (csym::memcpy thiefMin victimMax (* (sizeof task-id) TID_NUM))) + +;;; Function: rangeTaskID - +(def (csym::rangeTaskID minID maxID) (fn __int128_t (ptr task-id) (ptr task-id)) + (decl i int) + (for ((= i (- TID_NUM 1)) (> i 0) (dec i)) + (if (< (aref minID i) (aref maxID i)) + (return -1))) + (return (- (aref maxID 0) (aref minID 0)))) + ;;; Function: allocITnode - allocate a ITnode (def (csym::allocITnode) (fn (ptr ITnode)) (return (cast (ptr ITnode) (csym::malloc(sizeof ITnode))))) @@ -258,8 +311,9 @@ (def (csym::initITlist list) (fn void (ptr ITlist)) (decl i int) (def dummyNode (ptr ITnode) (csym::allocITnode)) - (= (fref dummyNode -> minID) (cast task-id 0)) - (= (fref dummyNode -> maxID) (cast task-id 0)) + (for ((= i 0) (< i TID_NUM) (inc i)) + (= (aref (fref dummyNode -> minID) i) (cast task-id 0)) + (= (aref (fref dummyNode -> maxID) i) (cast task-id 0))) (for ((= i 0) (< i BIT-ITEM) (inc i)) (= (aref (fref dummyNode -> item) i) (cast set 0))) (= (fref dummyNode -> worker) -1) @@ -270,14 +324,14 @@ (= (fref dummyNode -> prev) dummyNode)) ;;; Function: insertITnodeAfter - insert a new ITnode after the pointer 'p' -(def (csym::insertITnodeAfter list p minID maxID item worker) (fn void (ptr ITlist) (ptr ITnode) task-id task-id (array set) int) +(def (csym::insertITnodeAfter list p minID maxID item worker) (fn void (ptr ITlist) (ptr ITnode) (ptr task-id) (ptr task-id) (array set) int) (decl i int) (def new (ptr ITnode) (csym::allocITnode)) (def nxt (ptr ITnode) (fref p -> next)) (= (fref (fref p -> next) -> prev) new) (= (fref p -> next) new) - (= (fref new -> minID) minID) - (= (fref new -> maxID) maxID) + (csym::memcpy (fref new -> minID) minID (* (sizeof task-id) TID_NUM)) + (csym::memcpy (fref new -> maxID) maxID (* (sizeof task-id) TID_NUM)) (for ((= i 0) (< i BIT-ITEM) (inc i)) (= (aref (fref new -> item) i) (aref item i))) (= (fref new -> worker) worker) @@ -362,8 +416,8 @@ ;;; (def (task T-exploreCCIG) - (def minID task-id) - (def maxID task-id) + (def minID (array task-id TID_NUM)) + (def maxID (array task-id TID_NUM)) (def minC int) (def maxC int) (def v int) @@ -521,7 +575,7 @@ (= ITptr (fref (fref (aref vItemTable vv) head) -> next)) (while (!= ITptr (fref (aref vItemTable vv) head)) (inc (fref pTsk -> numTableReference)) - (if (<= (fref ITptr -> minID) (fref pTsk -> minID)) + (if (<= (csym::compareTaskID (fref ITptr -> minID) (fref pTsk -> minID)) 0) (begin (for ((= k 0) (= m 0) (< k BIT-ITEM) (inc k)) (if (== (cast set (bit-and (aref commonItem k) (aref (fref ITptr -> item) k))) (aref commonItem k)) @@ -557,7 +611,7 @@ (= ITptr (fref (fref (aref vItemTable vv) head) -> next)) (while (!= ITptr (fref (aref vItemTable vv) head)) (inc (fref pTsk -> numTableReference)) - (if (>= (fref ITptr -> minID) (fref pTsk -> minID)) + (if (>= (csym::compareTaskID (fref ITptr -> minID) (fref pTsk -> minID)) 0) (begin (for ((= k 0) (= m 0) (< k BIT-ITEM) (inc k)) (if (== (cast set (bit-and (aref (fref ITptr -> item) k) (aref commonItem k))) (aref (fref ITptr -> item) k)) @@ -803,7 +857,7 @@ (= ITptr (fref (fref (aref vItemTable vv) head) -> next)) (while (!= ITptr (fref (aref vItemTable vv) head)) (inc (fref pTsk -> numTableReference)) - (if (<= (fref ITptr -> minID) (fref pTsk -> minID)) + (if (<= (csym::compareTaskID (fref ITptr -> minID) (fref pTsk -> minID)) 0) (begin (for ((= k 0) (= m 0) (< k BIT-ITEM) (inc k)) (if (== (cast set (bit-and (aref commonItem k) (aref (fref ITptr -> item) k))) (aref commonItem k)) @@ -839,7 +893,7 @@ (= ITptr (fref (fref (aref vItemTable vv) head) -> next)) (while (!= ITptr (fref (aref vItemTable vv) head)) (inc (fref pTsk -> numTableReference)) - (if (>= (fref ITptr -> minID) (fref pTsk -> minID)) + (if (>= (csym::compareTaskID (fref ITptr -> minID) (fref pTsk -> minID)) 0) (begin (for ((= k 0) (= m 0) (< k BIT-ITEM) (inc k)) (if (== (cast set (bit-and (aref (fref ITptr -> item) k) (aref commonItem k))) (aref (fref ITptr -> item) k)) @@ -904,7 +958,7 @@ (csym::fprintf stderr "> %d~%" (aref (fref pTsk -> T) (- (fref pTsk -> numT) 1)))))) ;; recursive call - (if (> (- (fref pTsk -> maxID) (fref pTsk -> minID)) (fref pTsk -> numC)) + (if (or (== (csym::rangeTaskID (fref pTsk -> minID) (fref pTsk -> maxID)) -1) (> (csym::rangeTaskID (fref pTsk -> minID) (fref pTsk -> maxID)) (fref pTsk -> numC))) (begin (catch vv (exploreCCIG 0 (fref pTsk -> numC) vv commonItem pTsk) @@ -1005,9 +1059,7 @@ (csym::gettimeofday tpc 0))) (= (fref this minC) i1) (= (fref this maxC) i2) - (= (fref this maxID) (fref pTsk -> maxID)) - (= (fref pTsk -> maxID) (+ (cast task-id (* (- (fref pTsk -> maxID) (fref pTsk -> minID)) 0.5)) (fref pTsk -> minID))) - (= (fref this minID) (fref pTsk -> maxID)) + (csym::divideTaskID (fref pTsk -> minID) (fref pTsk -> maxID) (fref this minID) (fref this maxID)) (initExploreCCIG 1 NULL NULL NULL (ptr this)) (= (fref this v) v) (csym::memcpy (fref this itemSet) itemSet (* (sizeof set) BIT-ITEM)) @@ -1053,10 +1105,8 @@ (decl seq int) (decl tp (array (struct timeval) 2)) (inc (aref taskRequest (fref -thr -> id))) - (if (> (fref this minID) (fref this maxID)) - (csym::fprintf stderr "minID = %llu, maxID = %llu~%" (fref this minID) (fref this maxID))) (csym::gettimeofday tp 0) - (if (> (- (fref this maxID) (fref this minID)) (- (fref this maxC) (fref this minC))) + (if (or (== (csym::rangeTaskID (fref this minID) (fref this maxID)) -1) (> (csym::rangeTaskID (fref this minID) (fref this maxID)) (- (fref this maxC) (fref this minC)))) (begin (= seq 0) (catch (fref this v) @@ -1130,7 +1180,7 @@ (csym::fprintf fpLock "%f, %d~%" (csym::elapsedTime tp (+ tp 1)) locked))))) (= ITptr (fref (fref (aref vItemTable i) head) -> next)) (inc (fref pTsk -> numTableReference)) - (if (<= (fref ITptr -> minID) (fref pTsk -> minID)) + (if (<= (csym::compareTaskID (fref ITptr -> minID) (fref pTsk -> minID)) 0) (begin (for ((= k 0) (< k BIT-ITEM) (inc k)) (if (!= (cast set (bit-and (aref vItem i k) (aref (fref ITptr -> item) k))) (aref vItem i k)) @@ -1165,7 +1215,7 @@ (= ITptr (fref (fref (aref vItemTable i) head) -> next)) (while (!= ITptr (fref (aref vItemTable i) head)) (inc (fref pTsk -> numTableReference)) - (if (>= (fref ITptr -> minID) (fref pTsk -> minID)) + (if (>= (csym::compareTaskID (fref ITptr -> minID) (fref pTsk -> minID)) 0) (begin (for ((= k 0) (= m 0) (< k BIT-ITEM) (inc k)) (if (== (cast set (bit-and (aref (fref ITptr -> item) k) (aref vItem i k))) (aref (fref ITptr -> item) k)) @@ -1285,7 +1335,7 @@ (csym::fprintf fpLock "%f, %d~%" (csym::elapsedTime tp (+ tp 1)) locked))))) (= ITptr (fref (fref (aref vItemTable i) head) -> next)) (inc (fref pTsk -> numTableReference)) - (if (<= (fref ITptr -> minID) (fref pTsk -> minID)) + (if (<= (csym::compareTaskID (fref ITptr -> minID) (fref pTsk -> minID)) 0) (begin (for ((= k 0) (< k BIT-ITEM) (inc k)) (if (!= (cast set (bit-and (aref vItem i k) (aref (fref ITptr -> item) k))) (aref vItem i k)) @@ -1320,7 +1370,7 @@ (= ITptr (fref (fref (aref vItemTable i) head) -> next)) (while (!= ITptr (fref (aref vItemTable i) head)) (inc (fref pTsk -> numTableReference)) - (if (>= (fref ITptr -> minID) (fref pTsk -> minID)) + (if (>= (csym::compareTaskID (fref ITptr -> minID) (fref pTsk -> minID)) 0) (begin (for ((= k 0) (= m 0) (< k BIT-ITEM) (inc k)) (if (== (cast set (bit-and (aref (fref ITptr -> item) k) (aref vItem i k))) (aref (fref ITptr -> item) k)) @@ -1360,7 +1410,7 @@ (inc (fref pTsk -> treeDepth)) (inc (fref pTsk -> numTraversed)) - (if (> (- (fref pTsk -> maxID) (fref pTsk -> minID)) (fref pTsk -> numC)) + (if (or (== (csym::rangeTaskID (fref pTsk -> minID) (fref pTsk -> maxID)) -1) (> (csym::rangeTaskID (fref pTsk -> minID) (fref pTsk -> maxID)) (fref pTsk -> numC))) (begin (catch i (exploreCCIG 0 (fref pTsk -> numC) i (aref vItem i) pTsk) @@ -1430,9 +1480,7 @@ (csym::gettimeofday tpc 0))) (= (fref this minVertex) i1) (= (fref this maxVertex) i2) - (= (fref (fref this tsk) maxID) (fref pTsk -> maxID)) - (= (fref pTsk -> maxID) (+ (cast task-id (* (- (fref pTsk -> maxID) (fref pTsk -> minID)) 0.5)) (fref pTsk -> minID))) - (= (fref (fref this tsk) minID) (fref pTsk -> maxID)) + (csym::divideTaskID (fref pTsk -> minID) (fref pTsk -> maxID) (fref (fref this tsk) minID) (fref (fref this tsk) maxID)) (initExploreCCIG 0 NULL NULL NULL (ptr (fref this tsk))) (%if* DEBUG-COPY (begin (csym::gettimeofday (+ tpc 1) 0)))) @@ -1465,7 +1513,7 @@ (decl tp (array (struct timeval) 2)) (inc (aref taskRequest (fref -thr -> id))) (csym::gettimeofday tp 0) - (if (> (- (fref (fref this tsk) maxID) (fref (fref this tsk) minID)) (- (fref this maxVertex) (fref this minVertex))) + (if (or (== (csym::rangeTaskID (fref (fref this tsk) minID) (fref (fref this tsk) maxID)) -1) (> (csym::rangeTaskID (fref (fref this tsk) minID) (fref (fref this tsk) maxID)) (- (fref this maxVertex) (fref this minVertex)))) (begin (= seq 0) (enumCCIG (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk)))) @@ -1735,7 +1783,7 @@ ;;; Main (def (task-body T-startCCIG) - (defs int i j k) ; temporary variable + (defs int i j k l) ; temporary variable (decl tp (array (struct timeval) 2)) ; start time, end time (defs double t1 t2) ; start user time, end user time (decl loopRange int) ; loop range of enumCCIG @@ -1834,8 +1882,9 @@ (csym::sprintf copyFile "copy4-%02d_%d-half.csv" (fref option num-thrs) (fref this th)))))) ;; set ID - (= (fref tsk minID) 0) - (= (fref tsk maxID) (bit-not (cast task-id 0))) + (for ((= i 0) (< i TID_NUM) (inc i)) + (= (aref (fref tsk minID) i) 0) + (= (aref (fref tsk maxID) i) -1)) ;; init pthread ;(csym::pthread_attr_init (ptr attr)) @@ -1904,13 +1953,15 @@ (for ((= k minVertex) (< k (+ maxVertex 1)) (inc k)) (= ITptr (fref (fref (aref vItemTable k) head) -> next)) (while (!= ITptr (fref (aref vItemTable k) head)) - (= (fref ITptr -> minID) (cast task-id 0)) - (= (fref ITptr -> maxID) (cast task-id 0)) + (for ((= l 0) (< l TID_NUM) (inc l)) + (= (aref (fref ITptr -> minID) l) (cast task-id 0)) + (= (aref (fref ITptr -> maxID) l) (cast task-id 0))) (= ITptr (fref ITptr -> next)))) ;; re-set ID - (= (fref tsk minID) 0) - (= (fref tsk maxID) (bit-not (cast task-id 0)))) + (for ((= l 0) (< l TID_NUM) (inc l)) + (= (aref (fref tsk minID) l) 0) + (= (aref (fref tsk maxID) l) -1))) (enumCCIG i (+ maxVertex 1) (ptr tsk)) ;(for ((= j 1) (< j (fref this loopRatio)) (inc j)) From 6b5c8719d8cbc28ac7f05cb3a1edac8a93558b74 Mon Sep 17 00:00:00 2001 From: tasuku Date: Fri, 7 Nov 2014 17:32:02 +0900 Subject: [PATCH 031/105] Fixed the bug that compilation fails when the profiling option is disabled. --- src/sample/tcell/worker.sc | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/sample/tcell/worker.sc b/src/sample/tcell/worker.sc index 704172eb..8bdae903 100644 --- a/src/sample/tcell/worker.sc +++ b/src/sample/tcell/worker.sc @@ -550,21 +550,24 @@ (DEBUG-PRINT 1 "(%d): (Thread %d) end %d<%p> (body=%p).~%" (csym::get-universal-real-time) thr->id tx->task-no tx tx->body) - (csym::evcounter-count thr EV-RSLT-TASK OBJ-PADDR tx->rslt-head) + (PROF-CODE + (csym::evcounter-count thr EV-RSLT-TASK OBJ-PADDR tx->rslt-head)) (= reason 0) (break) (case EXITING-EXCEPTION) (DEBUG-PRINT 1 "(%d): (Thread %d) end %d<%p> (body=%p) with exception %d.~%" (csym::get-universal-real-time) thr->id tx->task-no tx tx->body thr->exception-tag) - (csym::evcounter-count thr EV-EXCP-TASK OBJ-PADDR tx->rslt-head) + (PROF-CODE + (csym::evcounter-count thr EV-EXCP-TASK OBJ-PADDR tx->rslt-head)) (= reason 1) (break) (case EXITING-CANCEL) (DEBUG-PRINT 1 "(%d): (Thread %d) aborted %d<%p> (body=%p).~%" (csym::get-universal-real-time) thr->id tx->task-no tx tx->body) - (csym::evcounter-count thr EV-ABRT-TASK OBJ-PADDR tx->rslt-head) + (PROF-CODE + (csym::evcounter-count thr EV-ABRT-TASK OBJ-PADDR tx->rslt-head)) (= reason 2) (break) (default) From e62b114d8293157580245acbe22cc384aa4ecd25 Mon Sep 17 00:00:00 2001 From: tasuku Date: Wed, 12 Nov 2014 17:45:57 +0900 Subject: [PATCH 032/105] Tascell server supports rslt messages extended for exceptions --- src/sample/tcell/server.lsp | 26 ++++++++++++++++---------- 1 file changed, 16 insertions(+), 10 deletions(-) diff --git a/src/sample/tcell/server.lsp b/src/sample/tcell/server.lsp index 89c4a82c..adae31b3 100644 --- a/src/sample/tcell/server.lsp +++ b/src/sample/tcell/server.lsp @@ -940,24 +940,28 @@ (when (eq :gnuplot *transfer-log-format*) (tcell-server-dprint (get-gnuplot-error-bar rslt-head to "task")))) -(defgeneric send-rslt (to rslt-head rslt-body)) -(defmethod send-rslt (to rslt-head rslt-body) - (send to (list "rslt " rslt-head #\Newline rslt-body #\Newline))) +(defgeneric send-rslt (to rslt-head rslt-rsn rslt-excp rslt-body)) +(defmethod send-rslt (to rslt-head rslt-rsn rslt-excp rslt-body) + (send to (list "rslt " + rslt-head #\Space + rslt-rsn #\Space + rslt-excp #\Space + #\Newline rslt-body #\Newline))) ;; Reply in place of an invalid child. #+PENDING ; rsltだけではrackの返信先がわからない -(defmethod send-rslt :around (to rslt-head rslt-body) +(defmethod send-rslt :around (to rslt-head rslt-rsn rslt-excp rslt-body) (if (child-valid to) (call-next-method) (proc-cmd (host-server to) to (list "rack")))) -(defmethod send-rslt :after ((to parent) rslt-head rslt-body) - (declare (ignore rslt-head rslt-body)) +(defmethod send-rslt :after ((to parent) rslt-head rslt-rsn rslt-excp rslt-body) + (declare (ignore rslt-head rslt-rsn rslt-excp rslt-body)) (decf (parent-diff-task-rslt to))) -(defmethod send-rslt :after ((to terminal-parent) rslt-head rslt-body) - (declare (ignore rslt-body)) +(defmethod send-rslt :after ((to terminal-parent) rslt-head rslt-rsn rslt-excp rslt-body) + (declare (ignore rslt-rsn rslt-excp rslt-body)) ;; log (tcell-server-dprint "~&# (~D) rslt sent to terminal parent." (get-internal-real-time)) ;; rack，task，exit自動送信の設定（task再送信は性能評価用） @@ -1254,8 +1258,10 @@ (defmethod proc-rslt ((sv tcell-server) (from host) cmd) (destructuring-bind (to s-rslt-head) (head-shift sv (second cmd)) ; rslt送信先 - (let ((rslt-body (cddr cmd))) - (send-rslt to s-rslt-head rslt-body)))) + (let ((rslt-rsn (third cmd)) + (rslt-excp (fourth cmd)) + (rslt-body (cddddr cmd))) + (send-rslt to s-rslt-head rslt-rsn rslt-excp rslt-body)))) (defmethod proc-rslt :before ((sv tcell-server) (from child) cmd) (declare (ignore cmd)) From 9846fbd51bfe31f4b82d28951d2b661cb300d785 Mon Sep 17 00:00:00 2001 From: Shingo OKUNO Date: Tue, 25 Nov 2014 02:14:55 +0900 Subject: [PATCH 033/105] COPINE: fixed bugs --- src/sample/tcell/copine3.tcell | 125 ++++++++++++++++++++++-------- src/sample/tcell/copine4.tcell | 136 ++++++++++++++++++++++++++------- 2 files changed, 201 insertions(+), 60 deletions(-) diff --git a/src/sample/tcell/copine3.tcell b/src/sample/tcell/copine3.tcell index a430aa3e..47c73cfe 100644 --- a/src/sample/tcell/copine3.tcell +++ b/src/sample/tcell/copine3.tcell @@ -213,6 +213,20 @@ (csym::fprintf fp "0")) (>>= mask 1))) +;;; Function: printTaskID +(def (csym::printTaskID x) (fn void (ptr task-id)) + (defs int i j) + (decl mask task-id) + (for ((= i 0) (< i TID_NUM) (inc i)) + (= mask (<< (cast task-id 1) (- TID-LEN 1))) + (for ((= j 0) (< j TID_LEN) (inc j)) + (if (cast task-id (bit-and (aref x i) mask)) + (csym::fprintf stderr "1") + (csym::fprintf stderr "0")) + (>>= mask 1)) + (csym::fprintf stderr " ")) + (csym::fprintf stderr "~%")) + ;;; Function: fprintDecimally - write a variable with set date type by decimal representation to stream (def (csym::fprintDecimally fp x k) (fn void (ptr FILE) (const set) int) (decl i int) @@ -241,7 +255,7 @@ ;;; Function: compareTaskID - (def (csym::compareTaskID id1 id2) (fn int (ptr task-id) (ptr task-id)) (decl i int) - (for ((= i (- TID_NUM 1)) (>= i 0) (dec i)) + (for ((= i 0) (< i TID_NUM) (inc i)) (if (> (aref id1 i) (aref id2 i)) (begin (return 1)) @@ -250,14 +264,14 @@ (return 0)) ;;; Function: divideTaskID - -(def (csym::divideTaskID victimMin victimMax thiefMin thiefMax) (fn void (ptr task-id) (ptr task-id) (ptr task-id) (ptr task-id)) +(def (csym::divideTaskID victimMin victimMax thiefMin thiefMax) (fn void (ptr task-id) (ptr task-id) (ptr task-id) (ptr task-id)) (defs int i flagU flagD Co) (def maxValue task-id -1) (def carryDown task-id (<< (cast task-id 1) (- TID_LEN 1))) (csym::memcpy thiefMax victimMax (* (sizeof task-id) TID_NUM)) - (for ((= flagU 0) (= flagD 0) (= i 0) (< i TID_NUM) (inc i)) + (for ((= flagU 0) (= flagD 0) (= i (- TID_NUM 1)) (>= i 0) (dec i)) (if (> (aref victimMin i) (- maxValue (aref victimMax i))) (= flagU 1)) (+= (aref victimMax i) (aref victimMin i)) @@ -269,7 +283,8 @@ (= flagD flagU) (= flagU 0)) (= flagU Co) - (for ((= i (- TID_NUM 1)) (>= i 0) (dec i)) + (= flagD 0) + (for ((= i 0) (< i TID_NUM) (inc i)) (if (bit-and (aref victimMax i) (cast task-id 1)) (= flagD 1)) (>>= (aref victimMax i) 1) @@ -281,12 +296,16 @@ (csym::memcpy thiefMin victimMax (* (sizeof task-id) TID_NUM))) ;;; Function: rangeTaskID - -(def (csym::rangeTaskID minID maxID) (fn __int128_t (ptr task-id) (ptr task-id)) +(def (csym::rangeTaskID minID maxID rangeID) (fn int (ptr task-id) (ptr task-id) (ptr task-id)) (decl i int) - (for ((= i (- TID_NUM 1)) (> i 0) (dec i)) - (if (< (aref minID i) (aref maxID i)) - (return -1))) - (return (- (aref maxID 0) (aref minID 0)))) + (for ((= i 0) (< i (- TID_NUM 1)) (inc i)) + (if (!= (aref maxID i) (aref minID i)) + (return 1))) + (= (mref rangeID) (- (aref maxID (- TID_NUM 1)) (aref minID (- TID_NUM 1)))) + ;(csym::fprintf stderr "range: %u~%" (mref rangeID)) + (if (== (mref rangeID) 0) + (return 0)) + (return -1)) ;;; Function: allocITnode - allocate a ITnode (def (csym::allocITnode) (fn (ptr ITnode)) @@ -649,6 +668,8 @@ (decl commonItem (array set BIT-ITEM)) ; common itemset (def closed int 1) ; flag which denotes subgraph is closed (decl pruning int) ; flag to prune + (decl rangeFlag int) ; + (def rangeID task-id 0) ; (decl ITptr (ptr ITnode)) ; pointer to the ITnode (decl locked int) ; (decl tp (array (struct timeval) 2)) ; @@ -785,13 +806,21 @@ (csym::fprintf stderr "> %d~%" (aref (fref pTsk -> T) (- (fref pTsk -> numT) 1)))))) ;; recursive call - (if (or (== (csym::rangeTaskID (fref pTsk -> minID) (fref pTsk -> maxID)) -1) (> (csym::rangeTaskID (fref pTsk -> minID) (fref pTsk -> maxID)) (fref pTsk -> numC))) - (begin - (exploreCCIG 0 (fref pTsk -> numC) vv commonItem pTsk)) - (begin + (= rangeFlag (csym::rangeTaskID (fref pTsk -> minID) (fref pTsk -> maxID) (ptr rangeID))) + (switch rangeFlag + (case 1) (begin + (exploreCCIG 0 (fref pTsk -> numC) vv commonItem pTsk)) (break) + (case 0) (begin (inc (aref seqTaskRequest (fref -thr -> id))) - (exploreCCIG2 0 (fref pTsk -> numC) vv commonItem pTsk))) - + (exploreCCIG2 0 (fref pTsk -> numC) vv commonItem pTsk)) (break) + (case -1) (begin + (if (>= (cast int (csym::log2 (cast double rangeID))) (fref option num-thrs)) + (begin + (exploreCCIG 0 (fref pTsk -> numC) vv commonItem pTsk)) + (begin + (inc (aref seqTaskRequest (fref -thr -> id))) + (exploreCCIG2 0 (fref pTsk -> numC) vv commonItem pTsk)))) (break)) + (for ((= j 0) (< j (fref pTsk -> numC)) (inc j)) (dec (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j))))) (:after @@ -871,17 +900,29 @@ (def (task-body T-exploreCCIG) (decl i int) (decl seq int) + (decl rangeFlag int) + (def rangeID task-id 0) (decl tp (array (struct timeval) 2)) (inc (aref taskRequest (fref -thr -> id))) + (= rangeFlag (csym::rangeTaskID (fref this minID) (fref this maxID) (ptr rangeID))) (csym::gettimeofday tp 0) - (if (or (== (csym::rangeTaskID (fref this minID) (fref this maxID)) -1) (> (csym::rangeTaskID (fref this minID) (fref this maxID)) (- (fref this maxC) (fref this minC)))) - (begin + (switch rangeFlag + (case 1) (begin (= seq 0) - (exploreCCIG (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this))) - (begin + (exploreCCIG (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this))) (break) + (case 0) (begin (= seq 1) (inc (aref seqTaskRequest (fref -thr -> id))) - (exploreCCIG2 (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this)))) + (exploreCCIG2 (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this))) (break) + (case -1) (begin + (if (>= (cast int (csym::log2 (cast double rangeID))) (fref option num-thrs)) + (begin + (= seq 0) + (exploreCCIG (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this))) + (begin + (= seq 1) + (inc (aref seqTaskRequest (fref -thr -> id))) + (exploreCCIG2 (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this))))) (break)) (csym::gettimeofday (+ tp 1) 0) (+= (aref visit2Vertices (fref -thr -> id)) (fref this numSearch)) (+= (aref thresholdPruning (fref -thr -> id)) (fref this numThreshold)) @@ -1010,7 +1051,9 @@ (defs int i j k) ; temporary variable (decl visiting int) ; flag to search (decl ITptr (ptr ITnode)) ; - (decl locked int) + (decl rangeFlag int) ; + (decl rangeID task-id 0) ; + (decl locked int) ; (decl tp (array (struct timeval) 2)) (decl tpc (array (struct timeval) 4)) @@ -1092,12 +1135,20 @@ (inc (fref pTsk -> treeDepth)) (inc (fref pTsk -> numTraversed)) - (if (or (== (csym::rangeTaskID (fref pTsk -> minID) (fref pTsk -> maxID)) -1) (> (csym::rangeTaskID (fref pTsk -> minID) (fref pTsk -> maxID)) (fref pTsk -> numC))) - (begin - (exploreCCIG 0 (fref pTsk -> numC) i (aref vItem i) pTsk)) - (begin + (= rangeFlag (csym::rangeTaskID (fref pTsk -> minID) (fref pTsk -> maxID) (ptr rangeID))) + (switch rangeFlag + (case 1) (begin + (exploreCCIG 0 (fref pTsk -> numC) i (aref vItem i) pTsk)) (break) + (case 0) (begin (inc (aref seqTaskRequest (fref -thr -> id))) - (exploreCCIG2 0 (fref pTsk -> numC) i (aref vItem i) pTsk))) + (exploreCCIG2 0 (fref pTsk -> numC) i (aref vItem i) pTsk)) (break) + (case -1) (begin + (if (>= (cast int (csym::log2 (cast double rangeID))) (fref option num-thrs)) + (begin + (exploreCCIG 0 (fref pTsk -> numC) i (aref vItem i) pTsk)) + (begin + (inc (aref seqTaskRequest (fref -thr -> id))) + (exploreCCIG2 0 (fref pTsk -> numC) i (aref vItem i) pTsk)))) (break)) (for ((= j 0) (< j (fref pTsk -> numC)) (inc j)) (= (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j)) 0)) @@ -1156,17 +1207,29 @@ ;;; (def (task-body T-enumCCIG) (decl seq int) + (decl rangeFlag int) + (def rangeID task-id 0) (decl tp (array (struct timeval) 2)) (inc (aref taskRequest (fref -thr -> id))) + (= rangeFlag (csym::rangeTaskID (fref (fref this tsk) minID) (fref (fref this tsk) maxID) (ptr rangeID))) (csym::gettimeofday tp 0) - (if (or (== (csym::rangeTaskID (fref (fref this tsk) minID) (fref (fref this tsk) maxID)) -1) (> (csym::rangeTaskID (fref (fref this tsk) minID) (fref (fref this tsk) maxID)) (- (fref this maxVertex) (fref this minVertex)))) - (begin + (switch rangeFlag + (case 1) (begin (= seq 0) - (enumCCIG (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk)))) - (begin + (enumCCIG (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk)))) (break) + (case 0) (begin (= seq 1) (inc (aref seqTaskRequest (fref -thr -> id))) - (enumCCIG2 (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk))))) + (enumCCIG2 (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk)))) (break) + (case -1) (begin + (if (>= (cast int (csym::log2 (cast double rangeID))) (fref option num-thrs)) + (begin + (= seq 0) + (enumCCIG (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk)))) + (begin + (= seq 1) + (inc (aref seqTaskRequest (fref -thr -> id))) + (enumCCIG2 (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk)))))) (break)) (csym::gettimeofday (+ tp 1) 0) (+= (aref visit2Vertices (fref -thr -> id)) (fref (fref this tsk) numSearch)) (+= (aref thresholdPruning (fref -thr -> id)) (fref (fref this tsk) numThreshold)) diff --git a/src/sample/tcell/copine4.tcell b/src/sample/tcell/copine4.tcell index 52f2e8e4..553cf386 100644 --- a/src/sample/tcell/copine4.tcell +++ b/src/sample/tcell/copine4.tcell @@ -224,6 +224,20 @@ (csym::fprintf fp "0")) (>>= mask 1))) +;;; Function: printTaskID +(def (csym::printTaskID x) (fn void (ptr task-id)) + (defs int i j) + (decl mask task-id) + (for ((= i 0) (< i TID_NUM) (inc i)) + (= mask (<< (cast task-id 1) (- TID-LEN 1))) + (for ((= j 0) (< j TID_LEN) (inc j)) + (if (cast task-id (bit-and (aref x i) mask)) + (csym::fprintf stderr "1") + (csym::fprintf stderr "0")) + (>>= mask 1)) + (csym::fprintf stderr " ")) + (csym::fprintf stderr "~%")) + ;;; Function: fprintDecimally - write a variable with set date type by decimal representation to stream (def (csym::fprintDecimally fp x k) (fn void (ptr FILE) (const set) int) (decl i int) @@ -252,7 +266,7 @@ ;;; Function: compareTaskID - (def (csym::compareTaskID id1 id2) (fn int (ptr task-id) (ptr task-id)) (decl i int) - (for ((= i (- TID_NUM 1)) (>= i 0) (dec i)) + (for ((= i 0) (< i TID_NUM) (inc i)) (if (> (aref id1 i) (aref id2 i)) (begin (return 1)) @@ -268,7 +282,7 @@ (csym::memcpy thiefMax victimMax (* (sizeof task-id) TID_NUM)) - (for ((= flagU 0) (= flagD 0) (= i 0) (< i TID_NUM) (inc i)) + (for ((= flagU 0) (= flagD 0) (= i (- TID_NUM 1)) (>= i 0) (dec i)) (if (> (aref victimMin i) (- maxValue (aref victimMax i))) (= flagU 1)) (+= (aref victimMax i) (aref victimMin i)) @@ -280,7 +294,8 @@ (= flagD flagU) (= flagU 0)) (= flagU Co) - (for ((= i (- TID_NUM 1)) (>= i 0) (dec i)) + (= flagD 0) + (for ((= i 0) (< i TID_NUM) (inc i)) (if (bit-and (aref victimMax i) (cast task-id 1)) (= flagD 1)) (>>= (aref victimMax i) 1) @@ -292,12 +307,16 @@ (csym::memcpy thiefMin victimMax (* (sizeof task-id) TID_NUM))) ;;; Function: rangeTaskID - -(def (csym::rangeTaskID minID maxID) (fn __int128_t (ptr task-id) (ptr task-id)) +(def (csym::rangeTaskID minID maxID rangeID) (fn int (ptr task-id) (ptr task-id) (ptr task-id)) (decl i int) - (for ((= i (- TID_NUM 1)) (> i 0) (dec i)) - (if (< (aref minID i) (aref maxID i)) - (return -1))) - (return (- (aref maxID 0) (aref minID 0)))) + (for ((= i 0) (< i (- TID_NUM 1)) (inc i)) + (if (!= (aref maxID i) (aref minID i)) + (return 1))) + (= (mref rangeID) (- (aref maxID (- TID_NUM 1)) (aref minID (- TID_NUM 1)))) + ;(csym::fprintf stderr "range: %u~%" (mref rangeID)) + (if (== (mref rangeID) 0) + (return 0)) + (return -1)) ;;; Function: allocITnode - allocate a ITnode (def (csym::allocITnode) (fn (ptr ITnode)) @@ -733,6 +752,8 @@ (decl pruning int) ; flag to prune (def excpValue int -1) ; exception value (def excpIndex int -1) ; + (decl rangeFlag int) ; + (def rangeID task-id 0) ; (decl ITptr (ptr ITnode)) ; pointer to the ITnode (decl ITadd (ptr ITnode)) ; (decl locked int) ; @@ -958,17 +979,31 @@ (csym::fprintf stderr "> %d~%" (aref (fref pTsk -> T) (- (fref pTsk -> numT) 1)))))) ;; recursive call - (if (or (== (csym::rangeTaskID (fref pTsk -> minID) (fref pTsk -> maxID)) -1) (> (csym::rangeTaskID (fref pTsk -> minID) (fref pTsk -> maxID)) (fref pTsk -> numC))) - (begin + (= rangeFlag (csym::rangeTaskID (fref pTsk -> minID) (fref pTsk -> maxID) (ptr rangeID))) + (switch rangeFlag + (case 1) (begin (catch vv (exploreCCIG 0 (fref pTsk -> numC) vv commonItem pTsk) (for ((= j 0) (< j (fref pTsk -> numC)) (inc j)) - (dec (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j)))))) - (begin + (dec (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j)))))) (break) + (case 0) (begin (inc (aref seqTaskRequest (fref -thr -> id))) (exploreCCIG2 0 (fref pTsk -> numC) vv commonItem pTsk) (for ((= j 0) (< j (fref pTsk -> numC)) (inc j)) - (dec (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j)))))) + (dec (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j))))) (break) + (case -1) (begin + ;(csym::fprintf stderr "rangeID = %u~%" (csym::log2 (cast double rangeID))) + (if (>= (cast int (csym::log2 (cast double rangeID))) (fref option num-thrs)) + (begin + (catch vv + (exploreCCIG 0 (fref pTsk -> numC) vv commonItem pTsk) + (for ((= j 0) (< j (fref pTsk -> numC)) (inc j)) + (dec (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j)))))) + (begin + (inc (aref seqTaskRequest (fref -thr -> id))) + (exploreCCIG2 0 (fref pTsk -> numC) vv commonItem pTsk) + (for ((= j 0) (< j (fref pTsk -> numC)) (inc j)) + (dec (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j))))))) (break)) (if (== (aref flagQe (fref -thr -> id)) 1) (begin @@ -1103,18 +1138,32 @@ (def (task-body T-exploreCCIG) (decl i int) (decl seq int) + (decl rangeFlag int) + (def rangeID task-id 0) (decl tp (array (struct timeval) 2)) (inc (aref taskRequest (fref -thr -> id))) + (= rangeFlag (csym::rangeTaskID (fref this minID) (fref this maxID) (ptr rangeID))) (csym::gettimeofday tp 0) - (if (or (== (csym::rangeTaskID (fref this minID) (fref this maxID)) -1) (> (csym::rangeTaskID (fref this minID) (fref this maxID)) (- (fref this maxC) (fref this minC)))) - (begin + (switch rangeFlag + (case 1) (begin (= seq 0) (catch (fref this v) - (exploreCCIG (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this)))) - (begin + (exploreCCIG (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this)))) (break) + (case 0) (begin (= seq 1) (inc (aref seqTaskRequest (fref -thr -> id))) - (exploreCCIG2 (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this)))) + (exploreCCIG2 (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this))) (break) + (case -1) (begin + ;(csym::fprintf stderr "rangeID = %u~%" (csym::log2 (cast double rangeID))) + (if (>= (cast int (csym::log2 (cast double rangeID))) (fref option num-thrs)) + (begin + (= seq 0) + (catch (fref this v) + (exploreCCIG (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this)))) + (begin + (= seq 1) + (inc (aref seqTaskRequest (fref -thr -> id))) + (exploreCCIG2 (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this))))) (break)) (csym::gettimeofday (+ tp 1) 0) (if (== (aref flagQe (fref -thr -> id)) 1) (begin @@ -1301,7 +1350,9 @@ (defs int i j k m) ; temporary variable (decl visiting int) ; flag to search (decl ITptr (ptr ITnode)) ; - (decl ITadd (ptr ITnode)) ; + (decl ITadd (ptr ITnode)) ; + (decl rangeFlag int) ; + (def rangeID task-id 0) ; (decl locked int) (decl tp (array (struct timeval) 2)) (decl tpc (array (struct timeval) 4)) @@ -1410,17 +1461,31 @@ (inc (fref pTsk -> treeDepth)) (inc (fref pTsk -> numTraversed)) - (if (or (== (csym::rangeTaskID (fref pTsk -> minID) (fref pTsk -> maxID)) -1) (> (csym::rangeTaskID (fref pTsk -> minID) (fref pTsk -> maxID)) (fref pTsk -> numC))) - (begin + (= rangeFlag (csym::rangeTaskID (fref pTsk -> minID) (fref pTsk -> maxID) (ptr rangeID))) + (switch rangeFlag + (case 1) (begin (catch i (exploreCCIG 0 (fref pTsk -> numC) i (aref vItem i) pTsk) (for ((= j 0) (< j (fref pTsk -> numC)) (inc j)) - (= (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j)) 0)))) - (begin + (= (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j)) 0)))) (break) + (case 0) (begin (inc (aref seqTaskRequest (fref -thr -> id))) (exploreCCIG2 0 (fref pTsk -> numC) i (aref vItem i) pTsk) (for ((= j 0) (< j (fref pTsk -> numC)) (inc j)) - (= (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j)) 0)))) + (= (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j)) 0))) (break) + (case -1) (begin + ;(csym::fprintf stderr "rangeID = %u~%" (csym::log2 (cast double rangeID))) + (if (>= (cast int (csym::log2 (cast double rangeID))) (fref option num-thrs)) + (begin + (catch i + (exploreCCIG 0 (fref pTsk -> numC) i (aref vItem i) pTsk) + (for ((= j 0) (< j (fref pTsk -> numC)) (inc j)) + (= (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j)) 0)))) + (begin + (inc (aref seqTaskRequest (fref -thr -> id))) + (exploreCCIG2 0 (fref pTsk -> numC) i (aref vItem i) pTsk) + (for ((= j 0) (< j (fref pTsk -> numC)) (inc j)) + (= (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j)) 0))))) (break)) (if (== (aref flagQe (fref -thr -> id)) 1) (begin @@ -1510,17 +1575,30 @@ ;;; (def (task-body T-enumCCIG) (decl seq int) + (decl rangeFlag int) + (def rangeID task-id 0) (decl tp (array (struct timeval) 2)) (inc (aref taskRequest (fref -thr -> id))) + (= rangeFlag (csym::rangeTaskID (fref (fref this tsk) minID) (fref (fref this tsk) maxID) (ptr rangeID))) (csym::gettimeofday tp 0) - (if (or (== (csym::rangeTaskID (fref (fref this tsk) minID) (fref (fref this tsk) maxID)) -1) (> (csym::rangeTaskID (fref (fref this tsk) minID) (fref (fref this tsk) maxID)) (- (fref this maxVertex) (fref this minVertex)))) - (begin + (switch rangeFlag + (case 1) (begin (= seq 0) - (enumCCIG (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk)))) - (begin + (enumCCIG (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk)))) (break) + (case 0) (begin (= seq 1) (inc (aref seqTaskRequest (fref -thr -> id))) - (enumCCIG2 (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk))))) + (enumCCIG2 (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk)))) (break) + (case -1) (begin + ;(csym::fprintf stderr "rangeID = %u~%" (csym::log2 (cast double rangeID))) + (if (>= (cast int (csym::log2 (cast double rangeID))) (fref option num-thrs)) + (begin + (= seq 0) + (enumCCIG (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk)))) + (begin + (= seq 1) + (inc (aref seqTaskRequest (fref -thr -> id))) + (enumCCIG2 (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk)))))) (break)) (csym::gettimeofday (+ tp 1) 0) (+= (aref visit2Vertices (fref -thr -> id)) (fref (fref this tsk) numSearch)) (+= (aref thresholdPruning (fref -thr -> id)) (fref (fref this tsk) numThreshold)) From 4516334c5ed6b8e23b566501b8d7328ea84060a2 Mon Sep 17 00:00:00 2001 From: tasuku Date: Sun, 21 Dec 2014 22:00:26 +0900 Subject: [PATCH 034/105] Commented out the profiling option in tcell/Makefile --- src/sample/tcell/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/sample/tcell/Makefile b/src/sample/tcell/Makefile index b8419e59..78e87c9a 100644 --- a/src/sample/tcell/Makefile +++ b/src/sample/tcell/Makefile @@ -5,7 +5,7 @@ SC2C=sc2c SC2C_OPT= # SC2C_OPT+=-m # don't remove intermediate files # SC2C_OPT+=-D DEBUG=0 # invalidate debugging code -SC2C_OPT+=-D PROFILE=1 # validate profiling +# SC2C_OPT+=-D PROFILE=1 # validate profiling # Command for XC Cube (an extended GCC that supports L-Closures and Closures) XCC=xcc # Command for gcc From ebc69997d9114f64234c01cb8a0968fa9421fec8 Mon Sep 17 00:00:00 2001 From: tasuku Date: Wed, 31 Dec 2014 17:59:59 +0900 Subject: [PATCH 035/105] tcell/worker.sc: call pthread_cond_broadcast() before pthread_mutex_unlock() --- src/sample/tcell/worker.sc | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/sample/tcell/worker.sc b/src/sample/tcell/worker.sc index 8bdae903..628dbefb 100644 --- a/src/sample/tcell/worker.sc +++ b/src/sample/tcell/worker.sc @@ -704,10 +704,10 @@ (= tx->task-no task-no) ; the kind of the task (= tx->body body) ; task object (= tx->stat TASK-INITIALIZED) ; TASK-ALLOCATED => TASK-INITIALIZED - (csym::pthread-mutex-unlock (ptr thr->mut)) ;; Awake the worker thread sleeping to waiting for the task (csym::pthread-cond-broadcast (ptr thr->cond)) + (csym::pthread-mutex-unlock (ptr thr->mut)) ) @@ -726,10 +726,10 @@ (if (> thr->w-none 0) ; When w-none>0, the recipient has stopped waiting (dec thr->w-none) ; the response to treq (= thr->task-top->stat TASK-NONE)) ; TASK-ALLOCATED => TASK-NONE - (csym::pthread-mutex-unlock (ptr thr->mut)) ;; Awake the worker thread sleeping to waiting for the task (csym::pthread-cond-broadcast (ptr thr->cond)) + (csym::pthread-mutex-unlock (ptr thr->mut)) ) From 7a261dff65a7834cf7a56673c58042ac8d40fb57 Mon Sep 17 00:00:00 2001 From: Shingo OKUNO Date: Sat, 7 Feb 2015 22:49:07 +0900 Subject: [PATCH 036/105] COPINE: Fixed bugs --- src/sample/tcell/copine0.tcell | 291 ++++++++++++++++-------- src/sample/tcell/copine1.tcell | 297 +++++++++++++++++-------- src/sample/tcell/copine2.tcell | 290 ++++++++++++++++-------- src/sample/tcell/copine3.tcell | 277 ++++++++--------------- src/sample/tcell/copine4.tcell | 389 +++++++++------------------------ 5 files changed, 806 insertions(+), 738 deletions(-) diff --git a/src/sample/tcell/copine0.tcell b/src/sample/tcell/copine0.tcell index 2f0925dc..0b0e63f9 100644 --- a/src/sample/tcell/copine0.tcell +++ b/src/sample/tcell/copine0.tcell @@ -31,6 +31,7 @@ ;; task 0 0 0 2 ;; ; threshold ;; ; # of iterations left for a victim worker +;; ; # of divisions of the higher layer of the search tree (c-exp "#include ") @@ -42,7 +43,10 @@ (c-exp "#include ") (c-exp "#include ") (c-exp "#include ") -;(c-exp "#include ") +(c-exp "#include ") + +(c-exp "#define __USE_GNU") +(c-exp "#include ") (%ifndef* NF-TYPE (%defconstant NF-TYPE GCC)) ; one of (GCC LW-SC CL-SC XCC XCCCL) @@ -60,15 +64,16 @@ (%defconstant USE-SSE 0) ;;; Max # of workers -(%defconstant NUM-WORKERS 16) +(%defconstant NUM-WORKERS 32) ;;; Constants -(%defconstant E-SIZE 500000) ; # of edges -(%defconstant V-SIZE 20000) ; # of vertices -(%defconstant BIT-LEN 32) ; bit length of bitset -(%defconstant BIT-ITEM 5) ; # of items = BIT-ITEM * BIT-LEN -(%defconstant BIT-EDGE 8125) ; # of edges = BIT-EDGE * BIT-LEN -(%defconstant BIT-VERTEX 625) ; # of vertices = BIT-VERTEX * BIT-LEN +(%defconstant E-SIZE 500000) ; # of edges +(%defconstant V-SIZE 15500) ; # of vertices +(%defconstant BIT-LEN 64) ; bit length of bitset +(%defconstant BIT-ITEM 3) ; # of items = BIT-ITEM * BIT-LEN +(%defconstant BIT-EDGE 8125) ; # of edges = BIT-EDGE * BIT-LEN +(%defconstant BIT-VERTEX 625) ; # of vertices = BIT-VERTEX * BIT-LEN +(%defconstant I-SIZE (* BIT-LEN BIT-ITEM)) ; ;;; Debug Flags (%defconstant DEBUG-DATA 0) ; flag to show some data @@ -79,7 +84,7 @@ (%defconstant DEBUG-COPY 0) ; flag to output copy file ;;; Typedef -(deftype set uint32-t) ; bitset +(deftype set uint64_t) ; bitset (deftype vtx uint32_t) ; vertex ;;; Structure of ITnode @@ -129,7 +134,11 @@ ;;; Worker Data (decl searchSpace (array uint64_t NUM-WORKERS)) +(decl visit2Vertices (array uint64_t NUM-WORKERS)) +(decl thresholdPruning (array uint64_t NUM-WORKERS)) +(decl inclusivePruning (array uint64_t NUM-WORKERS)) (decl taskRequest (array int NUM-WORKERS)) +(decl tableReference (array uint64_t NUM-WORKERS)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -145,18 +154,28 @@ (def (csym::elapsedTime t1 t2) (fn double (ptr (struct timeval)) (ptr (struct timeval))) (return (+ (- (fref t2 -> tv-sec) (fref t1 -> tv-sec)) (* 0.000001 (- (fref t2 -> tv-usec) (fref t1 -> tv-usec)))))) -;;; Function: countBits - count the number of "i-th bit == 1" -(def (csym::countBits x) (fn int set) +;;; Function: countBits32 - count the number of "i-th bit == 1" +(def (csym::countBits32 x) (fn int uint32_t) (= x (+ (bit-and x #x55555555) (bit-and (>> x 1) #x55555555))) (= x (+ (bit-and x #x33333333) (bit-and (>> x 2) #x33333333))) (= x (+ (bit-and x #x0f0f0f0f) (bit-and (>> x 4) #x0f0f0f0f))) (= x (+ (bit-and x #x00ff00ff) (bit-and (>> x 8) #x00ff00ff))) (return (+ (bit-and x #x0000ffff) (bit-and (>> x 16) #x0000ffff)))) +;;; Function: countBits64 - count the number of "i-th bit == 1" +(def (csym::countBits64 x) (fn int uint64_t) + (= x (+ (bit-and x (c-exp "0x5555555555555555UL")) (>> (bit-and x (c-exp "0xaaaaaaaaaaaaaaaaUL")) 1))) + (= x (+ (bit-and x (c-exp "0x3333333333333333UL")) (>> (bit-and x (c-exp "0xccccccccccccccccUL")) 2))) + (= x (+ (bit-and x (c-exp "0x0f0f0f0f0f0f0f0fUL")) (>> (bit-and x (c-exp "0xf0f0f0f0f0f0f0f0UL")) 4))) + (= x (+ (bit-and x (c-exp "0x00ff00ff00ff00ffUL")) (>> (bit-and x (c-exp "0xff00ff00ff00ff00UL")) 8))) + (= x (+ (bit-and x (c-exp "0x0000ffff0000ffffUL")) (>> (bit-and x (c-exp "0xffff0000ffff0000UL")) 16))) + (= x (+ (bit-and x (c-exp "0x00000000ffffffffUL")) (>> (bit-and x (c-exp "0xffffffff00000000UL")) 32))) + (return x)) + ;;; Function: printBits - print a variable with set data type by binary representation (def (csym::printBits x) (fn void (const set)) (decl i int) - (def mask set (<< 1 (- BIT-LEN 1))) + (def mask set (<< (cast set 1) (- BIT-LEN 1))) (for ((= i 0) (< i BIT-LEN) (inc i)) (if (bit-and x mask) (csym::fprintf stderr "1") @@ -166,7 +185,7 @@ ;;; Function: fprintBits - write a variable with set data type by binary representation to stream (def (csym::fprintBits fp x) (fn void (ptr FILE) (const set)) (decl i int) - (def mask set (<< 1 (- BIT-LEN 1))) + (def mask set (<< (cast set 1) (- BIT-LEN 1))) (for ((= i 0) (< i BIT-LEN) (inc i)) (if (bit-and x mask) (csym::fprintf fp "1") @@ -307,18 +326,15 @@ (def numSubgraph uint64_t) (def numSearch uint64_t) (def numThreshold uint64_t) - (def numPruning int)) + (def numPruning int) + (def numTableReference uint64_t)) ;;;Function: initExploreCCIG - -(def (initExploreCCIG vTraversed vItemTable C T pTsk) (fn void int (ptr ITlist) (ptr vtx) (ptr vtx) (ptr (struct T-exploreCCIG))) +(def (initExploreCCIG vTraversed vItemTable C T pTsk) (fn void (ptr int) (ptr ITlist) (ptr vtx) (ptr vtx) (ptr (struct T-exploreCCIG))) (decl i int) ;; initialize vTraversed - (if (== vTraversed 0) - (begin - (= (fref pTsk -> vTraversed) (cast (ptr int) (csym::calloc V-SIZE (sizeof int))))) - (begin - (= (fref pTsk -> vTraversed) (cast (ptr int) (csym::malloc (* V-SIZE (sizeof int))))))) + (= (fref pTsk -> vTraversed) (cast (ptr int) (csym::calloc V-SIZE (sizeof int)))) ;; initialize vItemTable ;(= (fref pTsk -> vItemTable) (cast (ptr ITlist) (csym::malloc (* V-SIZE (sizeof ITlist))))) @@ -327,12 +343,12 @@ ;; initialize C (= (fref pTsk -> numC) 0) - (= (fref pTsk -> sizeOfC) 50000) + (= (fref pTsk -> sizeOfC) 10000) (= (fref pTsk -> C) (cast (ptr vtx) (csym::malloc (* (fref pTsk -> sizeOfC) (sizeof vtx))))) ;; initialize T (= (fref pTsk -> numT) 0) - (= (fref pTsk -> sizeOfT) 100) + (= (fref pTsk -> sizeOfT) 1000) (= (fref pTsk -> T) (cast (ptr vtx) (csym::malloc (* (fref pTsk -> sizeOfT) (sizeof vtx))))) ;; init subgraph @@ -344,7 +360,8 @@ (= (fref pTsk -> numSubgraph) 0) (= (fref pTsk -> numSearch) 0) (= (fref pTsk -> numThreshold) 0) - (= (fref pTsk -> numPruning) 0)) + (= (fref pTsk -> numPruning) 0) + (= (fref pTsk -> numTableReference) 0)) ;;; Function: exploreCCIG - create a common-itemset tree with recursive call (def (exploreCCIG minC maxC v itemSet pTsk) (wfn void int int int (array set) (ptr (struct T-exploreCCIG))) @@ -366,13 +383,12 @@ (if (== (aref (fref pTsk -> vTraversed) vv) 1) (begin - (inc (fref pTsk -> numSearch)) - ;; evaluate common itemset (for ((= k 0) (= m 0) (= commonNum 0) (< k BIT-ITEM) (inc k)) (= (aref commonItem k) (cast set (bit-and (aref itemSet k) (aref vItem vv k)))) - (+= commonNum (csym::countBits (aref commonItem k))) - ;(+= commonNum (csym::--builtin-popcount (aref commonItem k))) + ;(+= commonNum (csym::countBits32 (aref commonItem k))) + (+= commonNum (csym::countBits64 (aref commonItem k))) + ;(+= commonNum (csym::_mm_popcnt_u64 (aref commonItem k))) (if (== (aref commonItem k) (aref itemSet k)) (inc m))) (if (== m BIT-ITEM) @@ -384,6 +400,8 @@ (inc (fref pTsk -> numTraversed)) (+= (fref pTsk -> treeDepth) (+ (fref pTsk -> numT) 1)) + (inc (fref pTsk -> numSearch)) + ;; add new candidates (if (>= (+ (fref pTsk -> numC) (aref vDegree vv)) (fref pTsk -> sizeOfC)) (begin @@ -453,7 +471,7 @@ (= (fref this maxC) i2) (= (fref this v) v) (csym::memcpy (fref this itemSet) itemSet (* (sizeof set) BIT-ITEM)) - (initExploreCCIG 1 NULL NULL NULL (ptr this)) + (initExploreCCIG NULL NULL NULL NULL (ptr this)) (csym::memcpy (fref this vTraversed) (fref pTsk -> vTraversed) (* (sizeof int) V-SIZE)) (for ((= j 0) (< j i1) (inc j)) (inc (aref (fref this vTraversed) (aref (fref pTsk -> C) (- (- numC j) 1))))) @@ -466,14 +484,14 @@ (:get (%if* DEBUG-COPY (begin (csym::gettimeofday (+ tpc 2) 0))) - (= (fref (fref (fref (fref pTsk -> subgraph) head) -> prev) -> next) (fref (fref (fref this subgraph) head) -> next)) - (= (fref (fref (fref (fref this subgraph) head) -> next) -> prev) (fref (fref (fref pTsk -> subgraph) head) -> prev)) - (= (fref (fref (fref (fref this subgraph) head) -> prev) -> next) (fref (fref pTsk -> subgraph) head)) - (= (fref (fref (fref pTsk -> subgraph) head) -> prev) (fref (fref (fref this subgraph) head) -> prev)) + (%if* DEBUG-RSLT (begin + (= (fref (fref (fref (fref pTsk -> subgraph) head) -> prev) -> next) (fref (fref (fref this subgraph) head) -> next)) + (= (fref (fref (fref (fref this subgraph) head) -> next) -> prev) (fref (fref (fref pTsk -> subgraph) head) -> prev)) + (= (fref (fref (fref (fref this subgraph) head) -> prev) -> next) (fref (fref pTsk -> subgraph) head)) + (= (fref (fref (fref pTsk -> subgraph) head) -> prev) (fref (fref (fref this subgraph) head) -> prev)))) (+= (fref pTsk -> treeDepth) (fref this treeDepth)) (+= (fref pTsk -> numTraversed) (fref this numTraversed)) (+= (fref pTsk -> numSubgraph) (fref this numSubgraph)) - (+= (fref pTsk -> numThreshold) (fref this numThreshold)) (%if* DEBUG-COPY (begin (csym::gettimeofday (+ tpc 3) 0) (csym::fprintf fpCopy "%f, 1~%" (+ (csym::elapsedTime tpc (+ tpc 1)) (csym::elapsedTime (+ tpc 2) (+ tpc 3))))))))) @@ -492,9 +510,11 @@ (csym::gettimeofday tp 0) (exploreCCIG (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this)) (csym::gettimeofday (+ tp 1) 0) - (+= (aref searchSpace (fref -thr -> id)) (fref this numSearch)) + (+= (aref visit2Vertices (fref -thr -> id)) (fref this numSearch)) + (+= (aref thresholdPruning (fref -thr -> id)) (fref this numThreshold)) + (+= (aref inclusivePruning (fref -thr -> id)) (fref this numPruning)) + (+= (aref tableReference (fref -thr -> id)) (fref this numTableReference)) (%if* DEBUG-TASK (begin - ;(csym::fprintf stderr "T-exploreCCIG(%d): %f[sec](%f[sec]), %llu, ID:%d~%" (aref (fref this T) 0) (csym::elapsedTime tp (+ tp 1)) (csym::elapsedTime (ptr t0) (+ tp 1)) (fref this numSearch) (fref -thr -> id)) (csym::fprintf fpTask "%f, %f, %llu~%" (csym::elapsedTime tp (+ tp 1)) (csym::elapsedTime (ptr t0) (+ tp 1)) (fref this numSearch)))) (csym::free (fref this vTraversed)) (csym::free (fref this C)) @@ -527,6 +547,8 @@ (%if* DEBUG-SHOW (begin (csym::fprintf stderr "+++ Allons-y! +++~%"))) + (inc (fref pTsk -> numSearch)) + (for ((= j (aref vFirstEdge i)) (!= j -1) (= j (aref eNext j))) (if (< i (aref eTo j)) (begin @@ -563,20 +585,20 @@ (csym::gettimeofday tpc 0))) (= (fref this minVertex) i1) (= (fref this maxVertex) i2) - (initExploreCCIG 1 NULL NULL NULL (ptr (fref this tsk))) + (initExploreCCIG NULL NULL NULL NULL (ptr (fref this tsk))) (%if* DEBUG-COPY (begin (csym::gettimeofday (+ tpc 1) 0)))) (:get (%if* DEBUG-COPY (begin (csym::gettimeofday (+ tpc 2) 0))) - (= (fref (fref (fref (fref pTsk -> subgraph) head) -> prev) -> next) (fref (fref (fref (fref this tsk) subgraph) head) -> next)) - (= (fref (fref (fref (fref (fref this tsk) subgraph) head) -> next) -> prev) (fref (fref (fref pTsk -> subgraph) head) -> prev)) - (= (fref (fref (fref (fref (fref this tsk) subgraph) head) -> prev) -> next) (fref (fref pTsk -> subgraph) head)) - (= (fref (fref (fref pTsk -> subgraph) head) -> prev) (fref (fref (fref (fref this tsk) subgraph) head) -> prev)) + (%if* DEBUG-RSLT (begin + (= (fref (fref (fref (fref pTsk -> subgraph) head) -> prev) -> next) (fref (fref (fref (fref this tsk) subgraph) head) -> next)) + (= (fref (fref (fref (fref (fref this tsk) subgraph) head) -> next) -> prev) (fref (fref (fref pTsk -> subgraph) head) -> prev)) + (= (fref (fref (fref (fref (fref this tsk) subgraph) head) -> prev) -> next) (fref (fref pTsk -> subgraph) head)) + (= (fref (fref (fref pTsk -> subgraph) head) -> prev) (fref (fref (fref (fref this tsk) subgraph) head) -> prev)))) (+= (fref pTsk -> treeDepth) (fref (fref this tsk) treeDepth)) (+= (fref pTsk -> numTraversed) (fref (fref this tsk) numTraversed)) (+= (fref pTsk -> numSubgraph) (fref (fref this tsk) numSubgraph)) - (+= (fref pTsk -> numThreshold) (fref (fref this tsk) numThreshold)) (csym::free (fref (fref this tsk) vTraversed)) (csym::free (fref (fref this tsk) C)) (csym::free (fref (fref this tsk) T)) @@ -591,7 +613,10 @@ (csym::gettimeofday tp 0) (enumCCIG (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk))) (csym::gettimeofday (+ tp 1) 0) - (+= (aref searchSpace (fref -thr -> id)) (fref (fref this tsk) numSearch)) + (+= (aref visit2Vertices (fref -thr -> id)) (fref (fref this tsk) numSearch)) + (+= (aref thresholdPruning (fref -thr -> id)) (fref (fref this tsk) numThreshold)) + (+= (aref inclusivePruning (fref -thr -> id)) (fref (fref this tsk) numPruning)) + (+= (aref tableReference (fref -thr -> id)) (fref (fref this tsk) numTableReference)) (%if* DEBUG-TASK (begin ;(csym::fprintf stderr "T-enumCCIG(from %d to %d): %f[sec](%f[sec]), %llu, ID:%d~%" (fref this minVertex) (fref this maxVertex) (csym::elapsedTime tp (+ tp 1)) (csym::elapsedTime (ptr t0) (+ tp 1)) (fref (fref this tsk) numSearch) (fref -thr -> id)) (csym::fprintf fpTask "%f, %f, %llu~%" (csym::elapsedTime tp (+ tp 1)) (csym::elapsedTime (ptr t0) (+ tp 1)) (fref (fref this tsk) numSearch))))) @@ -631,12 +656,16 @@ (= l k))))))) ;;; Function: loadPatternFile - load pattern file -(def (loadPatternFile patternFile maxNumItems) (fn void (ptr (const char)) (ptr int)) - (decl n int) ; item number - (decl v int) ; vertex number - (decl item (ptr char)) ; - (decl buff (array char 256)) ; buffer - (decl fp (ptr FILE)) ; file pointer +(def (loadPatternFile patternFile maxNumItems eHash iHash) (fn void (ptr (const char)) (ptr int) (ptr (struct hsearch_data)) (ptr (struct hsearch_data))) + (def i int 0) ; + (decl n int) ; item number + (decl v int) ; vertex number + (decl item (ptr char)) ; + (decl buff (array char 256)) ; buffer + (decl temp (array char 256)) ; + (decl he (struct entry)) ; + (decl hep (ptr (struct entry))) ; + (decl fp (ptr FILE)) ; file pointer ;; open pattern file (if (== (= fp (csym::fopen patternFile "r")) NULL) @@ -650,10 +679,30 @@ (if (!= (csym::strncmp buff "#" 1) 0) (begin (= v (csym::atoi (csym::strtok buff "~|11|"))) + + ;; find v from eHash + (csym::sprintf temp "%d" v) + (= (fref he key) temp) + (csym::hsearch_r he FIND (ptr hep) eHash) + (if (== hep NULL) + (continue)) + (= v (cast int (fref hep -> data))) + ;; add item to Vertex Data (while (!= (= item (csym::strtok NULL ",")) NULL) (= n (csym::atoi item)) - (bit-or= (aref vItem v (cast int (/ n BIT-LEN))) (<< 1 (cast int (% n BIT-LEN)))) + + ;; enter n to iHash + (csym::sprintf temp "%d" n) + (= (fref he key) temp) + (csym::hsearch_r he FIND (ptr hep) iHash) + (if (== hep NULL) + (begin + (= (fref he data) (cast (ptr void) (inc i))) + (csym::hsearch_r he ENTER (ptr hep) iHash))) + (= n (cast int (fref hep -> data))) + + (bit-or= (aref vItem v (cast int (/ n BIT-LEN))) (<< (cast set 1) (cast int (% n BIT-LEN)))) (inc (aref vNumItems v)) ; increase # of items ;; evaluate maximum # of items (if (> n (mref maxNumItems)) @@ -708,12 +757,16 @@ (inc (aref vDegree v1))) ;;; Function: loadGraphFile - load graph file -(def (loadGraphFile graphFile edgeMax minVertex maxVertex) (fn void (ptr (const char)) (ptr int) (ptr int) (ptr int)) - (defs int v1 v2) ; starting point, ending point - (decl eLabel (ptr char)) ; label of edge - (decl empty (ptr char)) ; - (decl buff (array char 256)) ; buffer - (decl fp (ptr FILE)) ; file pointer +(def (loadGraphFile graphFile edgeMax minVertex maxVertex eHash) (fn void (ptr (const char)) (ptr int) (ptr int) (ptr int) (ptr (struct hsearch_data))) + (def v int 1) ; + (defs int v1 v2) ; starting point, ending point + (decl eLabel (ptr char)) ; label of edge + (decl empty (ptr char)) ; + (decl buff (array char 256)) ; buffer + (decl temp (array char 256)) ; + (decl he (struct entry)) ; + (decl hep (ptr (struct entry))) ; + (decl fp (ptr FILE)) ; file pointer ;; open graph file (if (== (= fp (csym::fopen graphFile "r")) NULL) @@ -730,6 +783,27 @@ (= eLabel (csym::strtok NULL "~|11|")) (= v2 (csym::atoi (csym::strtok NULL "~|11|"))) (= empty (csym::strtok NULL "~|11|")) + + ;; enter v1 to eHash + (csym::sprintf temp "%d" v1) + (= (fref he key) temp) + (csym::hsearch_r he FIND (ptr hep) eHash) + (if (== hep NULL) + (begin + (= (fref he data) (cast (ptr void) (inc v))) + (csym::hsearch_r he ENTER (ptr hep) eHash))) + (= v1 (cast int (fref hep -> data))) + + ;; enter v2 to eHash + (csym::sprintf temp "%d" v2) + (= (fref he key) temp) + (csym::hsearch_r he FIND (ptr hep) eHash) + (if (== hep NULL) + (begin + (= (fref he data) (cast (ptr void) (inc v))) + (csym::hsearch_r he ENTER (ptr hep) eHash))) + (= v2 (cast int (fref hep -> data))) + ;; add edge to Edge List (if (== empty NULL) (if (!= v1 v2) @@ -741,7 +815,7 @@ (csym::fclose fp)) ;;; Function: initData - initialize Edge Data & Vertex Data & Debug Data -(def (initData edgeMax minVertex maxVertex maxNumItems) (fn void (ptr int) (ptr int) (ptr int) (ptr int)) +(def (initData edgeMax minVertex maxVertex maxNumItems eHash iHash) (fn void (ptr int) (ptr int) (ptr int) (ptr int) (ptr (struct hsearch_data)) (ptr (struct hsearch_data))) (defs int i j) ; temporary variable ;; initialize Edge Data @@ -764,20 +838,33 @@ ;; initialize Debug Data (for ((= i 0) (< i NUM-WORKERS) (inc i)) (= (aref searchSpace i) 0) - (= (aref taskRequest i) 0)) + (= (aref visit2Vertices i) 0) + (= (aref thresholdPruning i) 0) + (= (aref inclusivePruning i) 0) + (= (aref taskRequest i) 0) + (= (aref tableReference i) 0)) + (for ((= i 0) (< i V-SIZE) (inc i)) - (= (aref doneID i) 0))) + (= (aref doneID i) 0)) + + ;; initialize Hash Data + (csym::memset eHash 0 (sizeof (mref eHash))) + (csym::memset iHash 0 (sizeof (mref iHash))) + (csym::hcreate_r E-SIZE eHash) + (csym::hcreate_r I-SIZE iHash)) ;;; (def (task T-startCCIG) (def th int :in) - (def spawnSize int :in)) + (def spawnSize int :in) + (def loopRatio int :in)) ;;; Main (def (task-body T-startCCIG) (defs int i j) ; temporary variable (decl tp (array (struct timeval) 2)) ; start time, end time (defs double t1 t2) ; start user time, end user time + (decl loopRange int) ; loop range of enumCCIG (decl patternFile (ptr char)) ; name of pattern file (decl graphFile (ptr char)) ; name of graph file (decl resultFile (ptr char)) ; name of result file @@ -800,17 +887,25 @@ ;; Subgraph Data (decl Gptr (ptr Gnode)) + ;; Hash Data + (defs (struct hsearch_data) eHash iHash) + ;; Debug Data - (def numSearch uint64_t 0) ; # of search space - (def avgWorkerSearch double 0.0) ; - (def workerSearchSD double 0.0) ; - (def avgWorkerSearchPerSec double 0.0) ; - (def workerSearchPerSecSD double 0.0) ; - (def numTaskRequest int 0) ; # of task request - (def avgTaskRequest double 0.0) ; - (def taskRequestSD double 0.0) ; - (def avgSizeSubgraph uint64_t 0) ; - (def maxSizeSubgraph int 0) ; + (def numSearch uint64_t 0) ; # of search space + (def maxWorkerSearch uint64_t 0) ; + (def minWorkerSearch uint64_t UINT-LEAST64-MAX) ; + (def avgWorkerSearch double 0.0) ; + (def workerSearchSD double 0.0) ; + (def avgWorkerSearchPerSec double 0.0) ; + (def workerSearchPerSecSD double 0.0) ; + (def numTaskRequest int 0) ; # of task request + (def avgTaskRequest double 0.0) ; + (def taskRequestSD double 0.0) ; + (def numTableReference uint64_t 0) ; + (def avgTableReference double 0.0) ; + (def tableReferenceSD double 0.0) ; + (def avgSizeSubgraph uint64_t 0) ; + (def maxSizeSubgraph int 0) ; ;; arguments (= patternFile "data/symatlas_pattern.txt") @@ -840,19 +935,22 @@ (csym::sprintf copyFile "copy0-%02d_%d-half.csv" (fref option num-thrs) (fref this th)))) ;; initialize Edge Data & Vertex Data & Debug Data - (initData (ptr edgeMax) (ptr minVertex) (ptr maxVertex) (ptr maxNumItems)) + (initData (ptr edgeMax) (ptr minVertex) (ptr maxVertex) (ptr maxNumItems) (ptr eHash) (ptr iHash)) ;; load graph file - (loadGraphFile graphFile (ptr edgeMax) (ptr minVertex) (ptr maxVertex)) + (loadGraphFile graphFile (ptr edgeMax) (ptr minVertex) (ptr maxVertex) (ptr eHash)) ;; load pattern file - (loadPatternFile patternFile (ptr maxNumItems)) + (loadPatternFile patternFile (ptr maxNumItems) (ptr eHash) (ptr iHash)) ;; delete the vertex whose # of items is less than the user-specified threshold (thresholdItem minVertex maxVertex) + ;; set the range of enumCCIG loop + (= loopRange (cast int (/ (- (+ maxVertex 1) minVertex) (fref this loopRatio)))) + ;; init T-ExploreCCIG - (initExploreCCIG 0 NULL NULL NULL (ptr tsk)) + (initExploreCCIG NULL NULL NULL NULL (ptr tsk)) ;; open task file (%if* DEBUG-TASK (begin @@ -874,21 +972,31 @@ (csym::gettimeofday tp 0) ;; enumerate CCIG - (enumCCIG minVertex (+ maxVertex 1) (ptr tsk)) + (= i minVertex) + (for ((< (+ i loopRange) maxVertex) (+= i loopRange)) + (enumCCIG i (+ i loopRange) (ptr tsk))) + (enumCCIG i (+ maxVertex 1) (ptr tsk)) ;; get end time of program (csym::gettimeofday (+ tp 1) 0) (= t2 (csym::getrusageSec)) + ;; dispose of hash tables + (csym::hdestroy_r (ptr eHash)) + (csym::hdestroy_r (ptr iHash)) + ;; close copy file (%if* DEBUG-COPY (begin (csym::fclose fpCopy))) (%if* DEBUG-TASK (begin - ;(csym::fprintf stderr "T-enumCCIG(from %d to %d): %f[sec](%f[sec]), %llu, ID:%d~%" minVertex maxVertex (csym::elapsedTime tp (+ tp 1)) (csym::elapsedTime (ptr t0) (+ tp 1)) (fref tsk numSearch) (fref -thr -> id)) (csym::fprintf fpTask "%f, %f, %llu~%" (csym::elapsedTime tp (+ tp 1)) (csym::elapsedTime (ptr t0) (+ tp 1)) (fref tsk numSearch)) (csym::fclose fpTask))) - (+= (aref searchSpace (fref -thr -> id)) (fref tsk numSearch)) + + (+= (aref visit2Vertices (fref -thr -> id)) (fref tsk numSearch)) + (+= (aref thresholdPruning (fref -thr -> id)) (fref tsk numThreshold)) + (+= (aref inclusivePruning (fref -thr -> id)) (fref tsk numPruning)) + (+= (aref tableReference (fref -thr -> id)) (fref tsk numTableReference)) (%if* DEBUG-TIME (begin ;; open time file @@ -967,36 +1075,45 @@ ;; show debug datas (csym::fprintf stderr "time = %f[sec]~%" (csym::elapsedTime tp (+ tp 1))) (csym::fprintf stderr "user time = %f[sec]~%" (- t2 t1)) - (csym::fprintf stderr "# of subgraphs = %llu~%" (fref tsk numSubgraph)) - (csym::fprintf stderr "# of thresholds = %llu~%" (fref tsk numThreshold)) - (csym::fprintf stderr "# of prunings = %u~%" (fref tsk numPruning)) - (csym::fprintf stderr "Avg. tree depth = %f~%" (/ (cast double (fref tsk treeDepth)) (cast double (fref tsk numTraversed)))) + (csym::fprintf stderr "# of subgraphs = %d~%" (fref tsk numSubgraph)) + (csym::fprintf stderr "Avg. size of tree depth = %f~%" (/ (cast double (fref tsk treeDepth)) (cast double (fref tsk numTraversed)))) (%if* DEBUG-RSLT (begin (csym::fprintf stderr "Max size of subgraph = %d~%" maxSizeSubgraph) (csym::fprintf stderr "Avg. size of subgraph = %f~%" (/ (cast double avgSizeSubgraph) (cast double (fref tsk numSubgraph)))))) (csym::fprintf stderr "~%# of searches & task-requests~%") (for ((= j 0) (< j (fref option num-thrs)) (inc j)) - (csym::fprintf stderr " ID:%d, %llu, %d~%" j (aref searchSpace j) (aref taskRequest j)) + (= (aref searchSpace j) (+ (+ (aref visit2Vertices j) (aref thresholdPruning j)) ( +aref inclusivePruning j))) + (csym::fprintf stderr " ID:%d, %llu(%llu, %llu, %llu), %d, %llu~%" j (aref searchSpace j) (aref visit2Vertices j) (aref thresholdPruning j) (aref inclusivePruning j) (aref taskRequest j) (aref tableReference j)) (+= numSearch (aref searchSpace j)) + (if (< maxWorkerSearch (aref searchSpace j)) + (= maxWorkerSearch (aref searchSpace j))) + (if (> minWorkerSearch (aref searchSpace j)) + (= minWorkerSearch (aref searchSpace j))) (+= avgWorkerSearchPerSec (/ (aref searchSpace j) (csym::elapsedTime tp (+ tp 1)))) - (+= numTaskRequest (aref taskRequest j))) + (+= numTaskRequest (aref taskRequest j)) + (+= numTableReference (aref tableReference j))) (= avgWorkerSearch (/ (cast double numSearch) (cast double (fref option num-thrs)))) (= avgWorkerSearchPerSec (/ avgWorkerSearchPerSec (cast double (fref option num-thrs)))) (= avgTaskRequest (/ (cast double numTaskRequest) (cast double (fref option num-thrs)))) + (= avgTableReference (/ (cast double numTableReference) (cast double (fref option num-thrs)))) (for ((= j 0) (< j (fref option num-thrs)) (inc j)) (+= workerSearchSD (csym::pow (- (aref searchSpace j) avgWorkerSearch) 2.0)) (+= workerSearchPerSecSD (csym::pow (- (/ (aref searchSpace j) (csym::elapsedTime tp (+ tp 1))) avgWorkerSearchPerSec) 2.0)) - (+= taskRequestSD (csym::pow (- (aref taskRequest j) avgTaskRequest) 2.0))) - + (+= taskRequestSD (csym::pow (- (aref taskRequest j) avgTaskRequest) 2.0)) + (+= tableReferenceSD (csym::pow (- (aref tableReference j) avgTableReference) 2.0))) (/= workerSearchSD (fref option num-thrs)) (/= workerSearchPerSecSD (fref option num-thrs)) (/= taskRequestSD (fref option num-thrs)) + (/= tableReferenceSD (fref option num-thrs)) (= workerSearchSD (csym::sqrt workerSearchSD)) (= workerSearchPerSecSD (csym::sqrt workerSearchPerSecSD)) (= taskRequestSD (csym::sqrt taskRequestSD)) + (= tableReferenceSD (csym::sqrt tableReferenceSD)) - (csym::fprintf stderr "# of searches = %llu, Avg. = %.1f, S.D. = %.1f~%" numSearch avgWorkerSearch workerSearchSD) - (csym::fprintf stderr "# of task requests = %d, Avg. = %.2f, S.D. = %.2f~%" numTaskRequest avgTaskRequest taskRequestSD) - (csym::fprintf stderr "# of searches / sec = %.1f, Avg. = %.1f, S.D. = %.1f~%" (/ numSearch (csym::elapsedTime tp (+ tp 1))) avgWorkerSearchPerSec workerSearchPerSecSD)) + (csym::fprintf stderr "# of searches = %llu, Min = %llu, Max = %llu, Avg. = %.1f, S.D. = %.1f~%" numSearch minWorkerSearch maxWorkerSearch avgWorkerSearch workerSearchSD) + (csym::fprintf stderr "# of task requests = %d, Avg. = %.1f, S.D. = %.1f~%" numTaskRequest avgTaskRequest taskRequestSD) + (csym::fprintf stderr "# of searches / sec = %.1f, Avg. = %.1f, S.D. = %.1f~%" (/ numSearch (csym::elapsedTime tp (+ tp 1))) avgWorkerSearchPerSec workerSearchPerSecSD) + (csym::fprintf stderr "# of table references = %llu, Avg. = %.1f, S.D. = %.1f~%" numTableReference avgTableReference tableReferenceSD)) diff --git a/src/sample/tcell/copine1.tcell b/src/sample/tcell/copine1.tcell index c46ad3e8..bfdc8c9b 100644 --- a/src/sample/tcell/copine1.tcell +++ b/src/sample/tcell/copine1.tcell @@ -31,6 +31,7 @@ ;; task 0 0 0 2 ;; ; threshold ;; ; # of iterations left for a victim worker +;; ; # of divisions of the higher layer of the search tree (c-exp "#include ") @@ -42,7 +43,10 @@ (c-exp "#include ") (c-exp "#include ") (c-exp "#include ") -;(c-exp "#include ") +(c-exp "#include ") + +(c-exp "#define __USE_GNU") +(c-exp "#include ") (%ifndef* NF-TYPE (%defconstant NF-TYPE GCC)) ; one of (GCC LW-SC CL-SC XCC XCCCL) @@ -60,15 +64,17 @@ (%defconstant USE-SSE 0) ;;; Max # of workers -(%defconstant NUM-WORKERS 16) +(%defconstant NUM-WORKERS 32) ;;; Constants -(%defconstant E-SIZE 500000) ; # of edges -(%defconstant V-SIZE 20000) ; # of vertices -(%defconstant BIT-LEN 32) ; bit length of bitset -(%defconstant BIT-ITEM 5) ; # of items = BIT-ITEM * BIT-LEN -(%defconstant BIT-EDGE 8125) ; # of edges = BIT-EDGE * BIT-LEN -(%defconstant BIT-VERTEX 625) ; # of vertices = BIT-VERTEX * BIT-LEN +(%defconstant E-SIZE 500000) ; # of edges +(%defconstant V-SIZE 15500) ; # of vertices +(%defconstant BIT-LEN 64) ; bit length of bitset +(%defconstant BIT-ITEM 3) ; # of items = BIT-ITEM * BIT-LEN +(%defconstant BIT-EDGE 8125) ; # of edges = BIT-EDGE * BIT-LEN +(%defconstant BIT-VERTEX 625) ; # of vertices = BIT-VERTEX * BIT-LEN +(%defconstant I-SIZE (* BIT-LEN BIT-ITEM)) ; + ;;; Debug Flags (%defconstant DEBUG-DATA 0) ; flag to show some data @@ -79,7 +85,7 @@ (%defconstant DEBUG-COPY 0) ; flag to output copy file ;;; Typedef -(deftype set uint32_t) ; bitset +(deftype set uint64_t) ; bitset (deftype vtx uint32_t) ; vertex ;;; Structure of ITnode @@ -129,7 +135,11 @@ ;;; Worker Data (decl searchSpace (array uint64_t NUM-WORKERS)) +(decl visit2Vertices (array uint64_t NUM-WORKERS)) +(decl thresholdPruning (array uint64_t NUM-WORKERS)) +(decl inclusivePruning (array uint64_t NUM-WORKERS)) (decl taskRequest (array int NUM-WORKERS)) +(decl tableReference (array uint64_t NUM-WORKERS)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -145,18 +155,28 @@ (def (csym::elapsedTime t1 t2) (fn double (ptr (struct timeval)) (ptr (struct timeval))) (return (+ (- (fref t2 -> tv-sec) (fref t1 -> tv-sec)) (* 0.000001 (- (fref t2 -> tv-usec) (fref t1 -> tv-usec)))))) -;;; Function: countBits - count the number of "i-th bit == 1" -(def (csym::countBits x) (fn int set) +;;; Function: countBits32 - count the number of "i-th bit == 1" +(def (csym::countBits32 x) (fn int uint32_t) (= x (+ (bit-and x #x55555555) (bit-and (>> x 1) #x55555555))) (= x (+ (bit-and x #x33333333) (bit-and (>> x 2) #x33333333))) (= x (+ (bit-and x #x0f0f0f0f) (bit-and (>> x 4) #x0f0f0f0f))) (= x (+ (bit-and x #x00ff00ff) (bit-and (>> x 8) #x00ff00ff))) (return (+ (bit-and x #x0000ffff) (bit-and (>> x 16) #x0000ffff)))) +;;; Function: countBits64 - count the number of "i-th bit == 1" +(def (csym::countBits64 x) (fn int uint64_t) + (= x (+ (bit-and x (c-exp "0x5555555555555555UL")) (>> (bit-and x (c-exp "0xaaaaaaaaaaaaaaaaUL")) 1))) + (= x (+ (bit-and x (c-exp "0x3333333333333333UL")) (>> (bit-and x (c-exp "0xccccccccccccccccUL")) 2))) + (= x (+ (bit-and x (c-exp "0x0f0f0f0f0f0f0f0fUL")) (>> (bit-and x (c-exp "0xf0f0f0f0f0f0f0f0UL")) 4))) + (= x (+ (bit-and x (c-exp "0x00ff00ff00ff00ffUL")) (>> (bit-and x (c-exp "0xff00ff00ff00ff00UL")) 8))) + (= x (+ (bit-and x (c-exp "0x0000ffff0000ffffUL")) (>> (bit-and x (c-exp "0xffff0000ffff0000UL")) 16))) + (= x (+ (bit-and x (c-exp "0x00000000ffffffffUL")) (>> (bit-and x (c-exp "0xffffffff00000000UL")) 32))) + (return x)) + ;;; Function: printBits - print a variable with set data type by binary representation (def (csym::printBits x) (fn void (const set)) (decl i int) - (def mask set (<< 1 (- BIT-LEN 1))) + (def mask set (<< (cast set 1) (- BIT-LEN 1))) (for ((= i 0) (< i BIT-LEN) (inc i)) (if (bit-and x mask) (csym::fprintf stderr "1") @@ -166,7 +186,7 @@ ;;; Function: fprintBits - write a variable with set data type by binary representation to stream (def (csym::fprintBits fp x) (fn void (ptr FILE) (const set)) (decl i int) - (def mask set (<< 1 (- BIT-LEN 1))) + (def mask set (<< (cast set 1) (- BIT-LEN 1))) (for ((= i 0) (< i BIT-LEN) (inc i)) (if (bit-and x mask) (csym::fprintf fp "1") @@ -307,18 +327,15 @@ (def numSubgraph int) (def numSearch uint64_t) (def numThreshold uint64_t) - (def numPruning int)) + (def numPruning int) + (def numTableReference uint64_t)) ;;;Function: initExploreCCIG - -(def (initExploreCCIG traversed itemTable C T pTsk) (fn void int (ptr ITlist) (ptr vtx) (ptr vtx) (ptr (struct T-exploreCCIG))) +(def (initExploreCCIG traversed itemTable C T pTsk) (fn void (ptr int) (ptr ITlist) (ptr vtx) (ptr vtx) (ptr (struct T-exploreCCIG))) (decl i int) ;; initialize vTraversed - (if (== traversed 0) - (begin - (= (fref pTsk -> vTraversed) (cast (ptr int) (csym::calloc V-SIZE (sizeof int))))) - (begin - (= (fref pTsk -> vTraversed) (cast (ptr int) (csym::malloc (* V-SIZE (sizeof int))))))) + (= (fref pTsk -> vTraversed) (cast (ptr int) (csym::calloc V-SIZE (sizeof int)))) ;; initialize vItemTable (= (fref pTsk -> vItemTable) (cast (ptr ITlist) (csym::malloc (* V-SIZE (sizeof ITlist))))) @@ -332,7 +349,7 @@ ;; initialize T (= (fref pTsk -> numT) 0) - (= (fref pTsk -> sizeOfT) 100) + (= (fref pTsk -> sizeOfT) 1000) (= (fref pTsk -> T) (cast (ptr vtx) (csym::malloc (* (fref pTsk -> sizeOfT) (sizeof vtx))))) ;; init subgraph @@ -344,7 +361,8 @@ (= (fref pTsk -> numSubgraph) 0) (= (fref pTsk -> numSearch) 0) (= (fref pTsk -> numThreshold) 0) - (= (fref pTsk -> numPruning) 0)) + (= (fref pTsk -> numPruning) 0) + (= (fref pTsk -> numTableReference) 0)) ;;; Function: exploreCCIG - create a common-itemset tree with recursive call (def (exploreCCIG minC maxC v itemSet pTsk) (wfn void int int int (array set) (ptr (struct T-exploreCCIG))) @@ -366,13 +384,12 @@ (if (== (aref (fref pTsk -> vTraversed) vv) 1) (begin - (inc (fref pTsk -> numSearch)) - ;; evaluate common itemset (for ((= k 0) (= m 0) (= commonNum 0) (< k BIT-ITEM) (inc k)) (= (aref commonItem k) (cast set (bit-and (aref itemSet k) (aref vItem vv k)))) - (+= commonNum (csym::countBits (aref commonItem k))) - ;(+= commonNum (csym::--builtin-popcount (aref commonItem k))) + ;(+= commonNum (csym::countBits32 (aref commonItem k))) + (+= commonNum (csym::countBits64 (aref commonItem k))) + ;(+= commonNum (csym::_mm_popcnt_u64 (aref commonItem k))) (if (== (aref commonItem k) (aref itemSet k)) (inc m))) (if (== m BIT-ITEM) @@ -386,6 +403,7 @@ ;; check that common-itemset is subset of item table (= ITptr (fref (fref (aref (fref pTsk -> vItemTable) vv) head) -> next)) (while (!= ITptr (fref (aref (fref pTsk -> vItemTable) vv) head)) + (inc (fref pTsk -> numTableReference)) (for ((= k 0) (= m 0) (< k BIT-ITEM) (inc k)) (if (== (cast set (bit-and (aref commonItem k) (aref (fref ITptr -> item) k))) (aref commonItem k)) (inc m))) @@ -403,6 +421,7 @@ (= ITptr (fref (fref (aref (fref pTsk -> vItemTable) vv) head) -> next)) (while (!= ITptr (fref (aref (fref pTsk -> vItemTable) vv) head)) + (inc (fref pTsk -> numTableReference)) (for ((= k 0) (= m 0) (< k BIT-ITEM) (inc k)) (if (== (cast set (bit-and (aref (fref ITptr -> item) k) (aref commonItem k))) (aref (fref ITptr -> item) k)) (inc m))) @@ -411,6 +430,8 @@ (csym::removeITnode (ptr (aref (fref pTsk -> vItemTable) vv)) (fref ITptr -> prev)))) (csym::insertITnodeAfter (ptr (aref (fref pTsk -> vItemTable) vv)) (fref (aref (fref pTsk -> vItemTable) vv) head) commonItem) + (inc (fref pTsk -> numSearch)) + ;; add new candidates (if (>= (+ (fref pTsk -> numC) (aref vDegree vv)) (fref pTsk -> sizeOfC)) (begin @@ -488,7 +509,7 @@ (= (fref this maxC) i2) (= (fref this v) v) (csym::memcpy (fref this itemSet) itemSet (* (sizeof set) BIT-ITEM)) - (initExploreCCIG 1 NULL NULL NULL (ptr this)) + (initExploreCCIG NULL NULL NULL NULL (ptr this)) (csym::memcpy (fref this vTraversed) (fref pTsk -> vTraversed) (* (sizeof int) V-SIZE)) (for ((= j 0) (< j i1) (inc j)) (inc (aref (fref this vTraversed) (aref (fref pTsk -> C) (- (- numC j) 1))))) @@ -501,15 +522,14 @@ (:get (%if* DEBUG-COPY (begin (csym::gettimeofday (+ tpc 2) 0))) - (= (fref (fref (fref (fref pTsk -> subgraph) head) -> prev) -> next) (fref (fref (fref this subgraph) head) -> next)) - (= (fref (fref (fref (fref this subgraph) head) -> next) -> prev) (fref (fref (fref pTsk -> subgraph) head) -> prev)) - (= (fref (fref (fref (fref this subgraph) head) -> prev) -> next) (fref (fref pTsk -> subgraph) head)) - (= (fref (fref (fref pTsk -> subgraph) head) -> prev) (fref (fref (fref this subgraph) head) -> prev)) + (%if* DEBUG-RSLT (begin + (= (fref (fref (fref (fref pTsk -> subgraph) head) -> prev) -> next) (fref (fref (fref this subgraph) head) -> next)) + (= (fref (fref (fref (fref this subgraph) head) -> next) -> prev) (fref (fref (fref pTsk -> subgraph) head) -> prev)) + (= (fref (fref (fref (fref this subgraph) head) -> prev) -> next) (fref (fref pTsk -> subgraph) head)) + (= (fref (fref (fref pTsk -> subgraph) head) -> prev) (fref (fref (fref this subgraph) head) -> prev)))) (+= (fref pTsk -> treeDepth) (fref this treeDepth)) (+= (fref pTsk -> numTraversed) (fref this numTraversed)) (+= (fref pTsk -> numSubgraph) (fref this numSubgraph)) - (+= (fref pTsk -> numThreshold) (fref this numThreshold)) - (+= (fref pTsk -> numPruning) (fref this numPruning)) (%if* DEBUG-COPY (begin (csym::gettimeofday (+ tpc 3) 0) (csym::fprintf fpCopy "%f, 1~%" (+ (csym::elapsedTime tpc (+ tpc 1)) (csym::elapsedTime (+ tpc 2) (+ tpc 3))))))))) @@ -529,9 +549,11 @@ (csym::gettimeofday tp 0) (exploreCCIG (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this)) (csym::gettimeofday (+ tp 1) 0) - (+= (aref searchSpace (fref -thr -> id)) (fref this numSearch)) + (+= (aref visit2Vertices (fref -thr -> id)) (fref this numSearch)) + (+= (aref thresholdPruning (fref -thr -> id)) (fref this numThreshold)) + (+= (aref inclusivePruning (fref -thr -> id)) (fref this numPruning)) + (+= (aref tableReference (fref -thr -> id)) (fref this numTableReference)) (%if* DEBUG-TASK (begin - ;(csym::fprintf stderr "T-exploreCCIG(%d): %f[sec](%f[sec]), %llu, ID:%d~%" (aref (fref this T) 0) (csym::elapsedTime tp (+ tp 1)) (csym::elapsedTime (ptr t0) (+ tp 1)) (fref this numSearch) (fref -thr -> id)) (csym::fprintf fpTask "%f, %f, %llu~%" (csym::elapsedTime tp (+ tp 1)) (csym::elapsedTime (ptr t0) (+ tp 1)) (fref this numSearch)))) (csym::free (fref this vTraversed)) (for ((= i 0) (< i V-SIZE) (inc i)) @@ -566,6 +588,7 @@ ;; check that itemset of 'i' is subset of itemset-table (= ITptr (fref (fref (aref (fref pTsk -> vItemTable) i) head) -> next)) + (inc (fref pTsk -> numTableReference)) (for ((= k 0) (< k BIT-ITEM) (inc k)) (if (!= (cast set (bit-and (aref vItem i k) (aref (fref ITptr -> item) k))) (aref vItem i k)) (begin @@ -581,6 +604,8 @@ (csym::clearITlist (ptr (aref (fref pTsk -> vItemTable) i))) (csym::insertITnodeAfter (ptr (aref (fref pTsk -> vItemTable) i)) (fref (aref (fref pTsk -> vItemTable) i) head) (aref vItem i)) + (inc (fref pTsk -> numSearch)) + (for ((= j (aref vFirstEdge i)) (!= j -1) (= j (aref eNext j))) (if (< i (aref eTo j)) (begin @@ -622,21 +647,20 @@ (csym::gettimeofday tpc 0))) (= (fref this minVertex) i1) (= (fref this maxVertex) i2) - (initExploreCCIG 0 NULL NULL NULL (ptr (fref this tsk))) + (initExploreCCIG NULL NULL NULL NULL (ptr (fref this tsk))) (%if* DEBUG-COPY (begin (csym::gettimeofday (+ tpc 1) 0)))) (:get (%if* DEBUG-COPY (begin (csym::gettimeofday (+ tpc 2) 0))) - (= (fref (fref (fref (fref pTsk -> subgraph) head) -> prev) -> next) (fref (fref (fref (fref this tsk) subgraph) head) -> next)) - (= (fref (fref (fref (fref (fref this tsk) subgraph) head) -> next) -> prev) (fref (fref (fref pTsk -> subgraph) head) -> prev)) - (= (fref (fref (fref (fref (fref this tsk) subgraph) head) -> prev) -> next) (fref (fref pTsk -> subgraph) head)) - (= (fref (fref (fref pTsk -> subgraph) head) -> prev) (fref (fref (fref (fref this tsk) subgraph) head) -> prev)) + (%if* DEBUG-RSLT (begin + (= (fref (fref (fref (fref pTsk -> subgraph) head) -> prev) -> next) (fref (fref (fref (fref this tsk) subgraph) head) -> next)) + (= (fref (fref (fref (fref (fref this tsk) subgraph) head) -> next) -> prev) (fref (fref (fref pTsk -> subgraph) head) -> prev)) + (= (fref (fref (fref (fref (fref this tsk) subgraph) head) -> prev) -> next) (fref (fref pTsk -> subgraph) head)) + (= (fref (fref (fref pTsk -> subgraph) head) -> prev) (fref (fref (fref (fref this tsk) subgraph) head) -> prev)))) (+= (fref pTsk -> treeDepth) (fref (fref this tsk) treeDepth)) (+= (fref pTsk -> numTraversed) (fref (fref this tsk) numTraversed)) (+= (fref pTsk -> numSubgraph) (fref (fref this tsk) numSubgraph)) - (+= (fref pTsk -> numThreshold) (fref (fref this tsk) numThreshold)) - (+= (fref pTsk -> numPruning) (fref (fref this tsk) numPruning)) (csym::free (fref (fref this tsk) vTraversed)) (for ((= j 0) (< j V-SIZE) (inc j)) (csym::termITlist (ptr (aref (fref (fref this tsk) vItemTable) j)))) @@ -654,9 +678,11 @@ (csym::gettimeofday tp 0) (enumCCIG (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk))) (csym::gettimeofday (+ tp 1) 0) - (+= (aref searchSpace (fref -thr -> id)) (fref (fref this tsk) numSearch)) + (+= (aref visit2Vertices (fref -thr -> id)) (fref (fref this tsk) numSearch)) + (+= (aref thresholdPruning (fref -thr -> id)) (fref (fref this tsk) numThreshold)) + (+= (aref inclusivePruning (fref -thr -> id)) (fref (fref this tsk) numPruning)) + (+= (aref tableReference (fref -thr -> id)) (fref (fref this tsk) numTableReference)) (%if* DEBUG-TASK (begin - ;(csym::fprintf stderr "T-enumCCIG(from %d to %d): %f[sec](%f[sec]), %llu, ID:%d~%" (fref this minVertex) (fref this maxVertex) (csym::elapsedTime tp (+ tp 1)) (csym::elapsedTime (ptr t0) (+ tp 1)) (fref (fref this tsk) numSearch) (fref -thr -> id)) (csym::fprintf fpTask "%f, %f, %llu~%" (csym::elapsedTime tp (+ tp 1)) (csym::elapsedTime (ptr t0) (+ tp 1)) (fref (fref this tsk) numSearch))))) ;;; Function: thresholdItem - delete the vertex whose # of items is less than the user-specified threshold @@ -694,12 +720,16 @@ (= l k))))))) ;;; Function: loadPatternFile - load pattern file -(def (loadPatternFile patternFile maxNumItems) (fn void (ptr (const char)) (ptr int)) - (decl n int) ; item number - (decl v int) ; vertex number - (decl item (ptr char)) ; - (decl buff (array char 256)) ; buffer - (decl fp (ptr FILE)) ; file pointer +(def (loadPatternFile patternFile maxNumItems eHash iHash) (fn void (ptr (const char)) (ptr int) (ptr (struct hsearch_data)) (ptr (struct hsearch_data))) + (def i int 0) ; + (decl n int) ; item number + (decl v int) ; vertex number + (decl item (ptr char)) ; + (decl buff (array char 256)) ; buffer + (decl temp (array char 256)) ; + (decl he (struct entry)) ; + (decl hep (ptr (struct entry))) ; + (decl fp (ptr FILE)) ; file pointer ;; open pattern file (if (== (= fp (csym::fopen patternFile "r")) NULL) @@ -713,10 +743,30 @@ (if (!= (csym::strncmp buff "#" 1) 0) (begin (= v (csym::atoi (csym::strtok buff "~|11|"))) + + ;; find v from eHash + (csym::sprintf temp "%d" v) + (= (fref he key) temp) + (csym::hsearch_r he FIND (ptr hep) eHash) + (if (== hep NULL) + (continue)) + (= v (cast int (fref hep -> data))) + ;; add item to Vertex Data (while (!= (= item (csym::strtok NULL ",")) NULL) (= n (csym::atoi item)) - (bit-or= (aref vItem v (cast int (/ n BIT-LEN))) (<< 1 (cast int (% n BIT-LEN)))) + + ;; enter n to iHash + (csym::sprintf temp "%d" n) + (= (fref he key) temp) + (csym::hsearch_r he FIND (ptr hep) iHash) + (if (== hep NULL) + (begin + (= (fref he data) (cast (ptr void) (inc i))) + (csym::hsearch_r he ENTER (ptr hep) iHash))) + (= n (cast int (fref hep -> data))) + + (bit-or= (aref vItem v (cast int (/ n BIT-LEN))) (<< (cast set 1) (cast int (% n BIT-LEN)))) (inc (aref vNumItems v)) ; increase # of items ;; evaluate maximum # of items (if (> n (mref maxNumItems)) @@ -771,12 +821,16 @@ (inc (aref vDegree v1))) ;;; Function: loadGraphFile - load graph file -(def (loadGraphFile graphFile edgeMax minVertex maxVertex) (fn void (ptr (const char)) (ptr int) (ptr int) (ptr int)) - (defs int v1 v2) ; starting point, ending point - (decl eLabel (ptr char)) ; label of edge - (decl empty (ptr char)) ; - (decl buff (array char 256)) ; buffer - (decl fp (ptr FILE)) ; file pointer +(def (loadGraphFile graphFile edgeMax minVertex maxVertex eHash) (fn void (ptr (const char)) (ptr int) (ptr int) (ptr int) (ptr (struct hsearch_data))) + (def v int 1) ; + (defs int v1 v2) ; starting point, ending point + (decl eLabel (ptr char)) ; label of edge + (decl empty (ptr char)) ; + (decl buff (array char 256)) ; buffer + (decl temp (array char 256)) ; + (decl he (struct entry)) ; + (decl hep (ptr (struct entry))) ; + (decl fp (ptr FILE)) ; file pointer ;; open graph file (if (== (= fp (csym::fopen graphFile "r")) NULL) @@ -793,6 +847,27 @@ (= eLabel (csym::strtok NULL "~|11|")) (= v2 (csym::atoi (csym::strtok NULL "~|11|"))) (= empty (csym::strtok NULL "~|11|")) + + ;; enter v1 to eHash + (csym::sprintf temp "%d" v1) + (= (fref he key) temp) + (csym::hsearch_r he FIND (ptr hep) eHash) + (if (== hep NULL) + (begin + (= (fref he data) (cast (ptr void) (inc v))) + (csym::hsearch_r he ENTER (ptr hep) eHash))) + (= v1 (cast int (fref hep -> data))) + + ;; enter v2 to eHash + (csym::sprintf temp "%d" v2) + (= (fref he key) temp) + (csym::hsearch_r he FIND (ptr hep) eHash) + (if (== hep NULL) + (begin + (= (fref he data) (cast (ptr void) (inc v))) + (csym::hsearch_r he ENTER (ptr hep) eHash))) + (= v2 (cast int (fref hep -> data))) + ;; add edge to Edge List (if (== empty NULL) (if (!= v1 v2) @@ -804,7 +879,7 @@ (csym::fclose fp)) ;;; Function: initData - initialize Edge Data & Vertex Data & Debug Data -(def (initData edgeMax minVertex maxVertex maxNumItems) (fn void (ptr int) (ptr int) (ptr int) (ptr int)) +(def (initData edgeMax minVertex maxVertex maxNumItems eHash iHash) (fn void (ptr int) (ptr int) (ptr int) (ptr int) (ptr (struct hsearch_data)) (ptr (struct hsearch_data))) (defs int i j) ; temporary variable ;; initialize Edge Data @@ -827,20 +902,33 @@ ;; initialize Debug Data (for ((= i 0) (< i NUM-WORKERS) (inc i)) (= (aref searchSpace i) 0) - (= (aref taskRequest i) 0)) + (= (aref visit2Vertices i) 0) + (= (aref thresholdPruning i) 0) + (= (aref inclusivePruning i) 0) + (= (aref taskRequest i) 0) + (= (aref tableReference i) 0)) + (for ((= i 0) (< i V-SIZE) (inc i)) - (= (aref doneID i) 0))) + (= (aref doneID i) 0)) + + ;; initialize Hash Data + (csym::memset eHash 0 (sizeof (mref eHash))) + (csym::memset iHash 0 (sizeof (mref iHash))) + (csym::hcreate_r E-SIZE eHash) + (csym::hcreate_r I-SIZE iHash)) ;;; (def (task T-startCCIG) (def th int :in) - (def spawnSize int :in)) + (def spawnSize int :in) + (def loopRatio int :in)) ;;; Main (def (task-body T-startCCIG) (defs int i j) ; temporary variable (decl tp (array (struct timeval) 2)) ; start time, end time (defs double t1 t2) ; start user time, end user time + (decl loopRange int) ; loop range of enumCCIG (decl patternFile (ptr char)) ; name of pattern file (decl graphFile (ptr char)) ; name of graph file (decl resultFile (ptr char)) ; name of result file @@ -863,17 +951,25 @@ ;; Subgraph Data (decl Gptr (ptr Gnode)) + ;; Hash Data + (defs (struct hsearch_data) eHash iHash) + ;; Debug Data - (def numSearch uint64_t 0) ; # of search space - (def avgWorkerSearch double 0.0) ; - (def workerSearchSD double 0.0) ; - (def avgWorkerSearchPerSec double 0.0) ; - (def workerSearchPerSecSD double 0.0) ; - (def numTaskRequest int 0) ; # of task request - (def avgTaskRequest double 0.0) ; - (def taskRequestSD double 0.0) ; - (def avgSizeSubgraph uint64_t 0) ; - (def maxSizeSubgraph int 0) ; + (def numSearch uint64_t 0) ; # of search space + (def maxWorkerSearch uint64_t 0) ; + (def minWorkerSearch uint64_t UINT-LEAST64-MAX) ; + (def avgWorkerSearch double 0.0) ; + (def workerSearchSD double 0.0) ; + (def avgWorkerSearchPerSec double 0.0) ; + (def workerSearchPerSecSD double 0.0) ; + (def numTaskRequest int 0) ; # of task request + (def avgTaskRequest double 0.0) ; + (def taskRequestSD double 0.0) ; + (def numTableReference uint64_t 0) ; + (def avgTableReference double 0.0) ; + (def tableReferenceSD double 0.0) ; + (def avgSizeSubgraph uint64_t 0) ; + (def maxSizeSubgraph int 0) ; ;; arguments (= patternFile "data/symatlas_pattern.txt") @@ -903,19 +999,22 @@ (csym::sprintf copyFile "copy1-%02d_%d-half.csv" (fref option num-thrs) (fref this th)))) ;; initialize Edge Data & Vertex Data & Debug Data - (initData (ptr edgeMax) (ptr minVertex) (ptr maxVertex) (ptr maxNumItems)) + (initData (ptr edgeMax) (ptr minVertex) (ptr maxVertex) (ptr maxNumItems) (ptr eHash) (ptr iHash)) ;; load graph file - (loadGraphFile graphFile (ptr edgeMax) (ptr minVertex) (ptr maxVertex)) + (loadGraphFile graphFile (ptr edgeMax) (ptr minVertex) (ptr maxVertex) (ptr eHash)) ;; load pattern file - (loadPatternFile patternFile (ptr maxNumItems)) + (loadPatternFile patternFile (ptr maxNumItems) (ptr eHash) (ptr iHash)) ;; delete the vertex whose # of items is less than the user-specified threshold (thresholdItem minVertex maxVertex) + ;; set the range of enumCCIG loop + (= loopRange (cast int (/ (- (+ maxVertex 1) minVertex) (fref this loopRatio)))) + ;; init T-exploreCCIG - (initExploreCCIG 0 NULL NULL NULL (ptr tsk)) + (initExploreCCIG NULL NULL NULL NULL (ptr tsk)) ;; open task file (%if* DEBUG-TASK (begin @@ -937,21 +1036,31 @@ (csym::gettimeofday tp 0) ;; enumerate CCIG - (enumCCIG minVertex (+ maxVertex 1) (ptr tsk)) + (= i minVertex) + (for ((< (+ i loopRange) maxVertex) (+= i loopRange)) + (enumCCIG i (+ i loopRange) (ptr tsk))) + (enumCCIG i (+ maxVertex 1) (ptr tsk)) ;; get end time of program (csym::gettimeofday (+ tp 1) 0) (= t2 (csym::getrusageSec)) + ;; dispose of hash tables + (csym::hdestroy_r (ptr eHash)) + (csym::hdestroy_r (ptr iHash)) + ;; close copy file (%if* DEBUG-COPY (begin (csym::fclose fpCopy))) (%if* DEBUG-TASK (begin - ;(csym::fprintf stderr "T-enumCCIG(from %d to %d): %f[sec](%f[sec]), %llu, ID:%d~%" minVertex maxVertex (csym::elapsedTime tp (+ tp 1)) (csym::elapsedTime (ptr t0) (+ tp 1)) (fref tsk numSearch) (fref -thr -> id)) (csym::fprintf fpTask "%f, %f, %llu~%" (csym::elapsedTime tp (+ tp 1)) (csym::elapsedTime (ptr t0) (+ tp 1)) (fref tsk numSearch)) (csym::fclose fpTask))) - (+= (aref searchSpace (fref -thr -> id)) (fref tsk numSearch)) + + (+= (aref visit2Vertices (fref -thr -> id)) (fref tsk numSearch)) + (+= (aref thresholdPruning (fref -thr -> id)) (fref tsk numThreshold)) + (+= (aref inclusivePruning (fref -thr -> id)) (fref tsk numPruning)) + (+= (aref tableReference (fref -thr -> id)) (fref tsk numTableReference)) (%if* DEBUG-TIME (begin ;; open time file @@ -1030,35 +1139,45 @@ ;; show debug datas (csym::fprintf stderr "time = %f[sec]~%" (csym::elapsedTime tp (+ tp 1))) (csym::fprintf stderr "user time = %f[sec]~%" (- t2 t1)) - (csym::fprintf stderr "# of subgraphs = %d~%" (fref tsk numSubgraph)) - (csym::fprintf stderr "# of thresholds = %llu~%" (fref tsk numThreshold)) - (csym::fprintf stderr "# of prunings = %u~%" (fref tsk numPruning)) - (csym::fprintf stderr "Avg. tree depth = %f~%" (/ (cast double (fref tsk treeDepth)) (cast double (fref tsk numTraversed)))) + (csym::fprintf stderr "# of subgraphs = %d~%" (fref tsk numSubgraph)) + (csym::fprintf stderr "Avg. size of tree depth = %f~%" (/ (cast double (fref tsk treeDepth)) (cast double (fref tsk numTraversed)))) (%if* DEBUG-RSLT (begin (csym::fprintf stderr "Max size of subgraph = %d~%" maxSizeSubgraph) (csym::fprintf stderr "Avg. size of subgraph = %f~%" (/ (cast double avgSizeSubgraph) (cast double (fref tsk numSubgraph)))))) (csym::fprintf stderr "~%# of searches & task-requests~%") (for ((= j 0) (< j (fref option num-thrs)) (inc j)) - (csym::fprintf stderr " ID:%d, %llu, %d~%" j (aref searchSpace j) (aref taskRequest j)) + (= (aref searchSpace j) (+ (+ (aref visit2Vertices j) (aref thresholdPruning j)) ( +aref inclusivePruning j))) + (csym::fprintf stderr " ID:%d, %llu(%llu, %llu, %llu), %d, %llu~%" j (aref searchSpace j) (aref visit2Vertices j) (aref thresholdPruning j) (aref inclusivePruning j) (aref taskRequest j) (aref tableReference j)) (+= numSearch (aref searchSpace j)) + (if (< maxWorkerSearch (aref searchSpace j)) + (= maxWorkerSearch (aref searchSpace j))) + (if (> minWorkerSearch (aref searchSpace j)) + (= minWorkerSearch (aref searchSpace j))) (+= avgWorkerSearchPerSec (/ (aref searchSpace j) (csym::elapsedTime tp (+ tp 1)))) - (+= numTaskRequest (aref taskRequest j))) + (+= numTaskRequest (aref taskRequest j)) + (+= numTableReference (aref tableReference j))) (= avgWorkerSearch (/ (cast double numSearch) (cast double (fref option num-thrs)))) (= avgWorkerSearchPerSec (/ avgWorkerSearchPerSec (cast double (fref option num-thrs)))) (= avgTaskRequest (/ (cast double numTaskRequest) (cast double (fref option num-thrs)))) + (= avgTableReference (/ (cast double numTableReference) (cast double (fref option num-thrs)))) (for ((= j 0) (< j (fref option num-thrs)) (inc j)) (+= workerSearchSD (csym::pow (- (aref searchSpace j) avgWorkerSearch) 2.0)) -(+= workerSearchPerSecSD (csym::pow (- (/ (aref searchSpace j) (csym::elapsedTime tp (+ tp 1))) avgWorkerSearchPerSec) 2.0)) - (+= taskRequestSD (csym::pow (- (aref taskRequest j) avgTaskRequest) 2.0))) + (+= workerSearchPerSecSD (csym::pow (- (/ (aref searchSpace j) (csym::elapsedTime tp (+ tp 1))) avgWorkerSearchPerSec) 2.0)) + (+= taskRequestSD (csym::pow (- (aref taskRequest j) avgTaskRequest) 2.0)) + (+= tableReferenceSD (csym::pow (- (aref tableReference j) avgTableReference) 2.0))) (/= workerSearchSD (fref option num-thrs)) (/= workerSearchPerSecSD (fref option num-thrs)) (/= taskRequestSD (fref option num-thrs)) + (/= tableReferenceSD (fref option num-thrs)) (= workerSearchSD (csym::sqrt workerSearchSD)) (= workerSearchPerSecSD (csym::sqrt workerSearchPerSecSD)) (= taskRequestSD (csym::sqrt taskRequestSD)) + (= tableReferenceSD (csym::sqrt tableReferenceSD)) - (csym::fprintf stderr "# of searches = %llu, Avg. = %.1f, S.D. = %.1f~%" numSearch avgWorkerSearch workerSearchSD) - (csym::fprintf stderr "# of task requests = %d, Avg. = %.2f, S.D. = %.2f~%" numTaskRequest avgTaskRequest taskRequestSD) - (csym::fprintf stderr "# of searches / sec = %.1f, Avg. = %.1f, S.D. = %.1f~%" (/ numSearch (csym::elapsedTime tp (+ tp 1))) avgWorkerSearchPerSec workerSearchPerSecSD)) \ No newline at end of file + (csym::fprintf stderr "# of searches = %llu, Min = %llu, Max = %llu, Avg. = %.1f, S.D. = %.1f~%" numSearch minWorkerSearch maxWorkerSearch avgWorkerSearch workerSearchSD) + (csym::fprintf stderr "# of task requests = %d, Avg. = %.1f, S.D. = %.1f~%" numTaskRequest avgTaskRequest taskRequestSD) + (csym::fprintf stderr "# of searches / sec = %.1f, Avg. = %.1f, S.D. = %.1f~%" (/ numSearch (csym::elapsedTime tp (+ tp 1))) avgWorkerSearchPerSec workerSearchPerSecSD) + (csym::fprintf stderr "# of table references = %llu, Avg. = %.1f, S.D. = %.1f~%" numTableReference avgTableReference tableReferenceSD)) diff --git a/src/sample/tcell/copine2.tcell b/src/sample/tcell/copine2.tcell index ed2fa8a1..533a75a8 100644 --- a/src/sample/tcell/copine2.tcell +++ b/src/sample/tcell/copine2.tcell @@ -43,7 +43,10 @@ (c-exp "#include ") (c-exp "#include ") (c-exp "#include ") -;(c-exp "#include ") +(c-exp "#include ") + +(c-exp "#define __USE_GNU") +(c-exp "#include ") (%ifndef* NF-TYPE (%defconstant NF-TYPE GCC)) ; one of (GCC LW-SC CL-SC XCC XCCCL) @@ -61,15 +64,17 @@ (%defconstant USE-SSE 0) ;;; Max # of workers -(%defconstant NUM-WORKERS 16) +(%defconstant NUM-WORKERS 32) ;;; Constants -(%defconstant E-SIZE 500000) ; # of edges -(%defconstant V-SIZE 20000) ; # of vertices -(%defconstant BIT-LEN 32) ; bit length of bitset -(%defconstant BIT-ITEM 5) ; # of items = BIT-ITEM * BIT-LEN -(%defconstant BIT-EDGE 8125) ; # of edges = BIT-EDGE * BIT-LEN -(%defconstant BIT-VERTEX 625) ; # of vertices = BIT-VERTEX * BIT-LEN +(%defconstant E-SIZE 500000) ; # of edges +(%defconstant V-SIZE 15500) ; # of vertices +(%defconstant BIT-LEN 64) ; bit length of bitset +(%defconstant BIT-ITEM 3) ; # of items = BIT-ITEM * BIT-LEN +(%defconstant BIT-EDGE 8125) ; # of edges = BIT-EDGE * BIT-LEN +(%defconstant BIT-VERTEX 625) ; # of vertices = BIT-VERTEX * BIT-LEN +(%defconstant I-SIZE (* BIT-LEN BIT-ITEM)) ; + ;;; Debug Flags (%defconstant DEBUG-DATA 0) ; flag to show some data @@ -80,7 +85,7 @@ (%defconstant DEBUG-COPY 0) ; flag to output copy file ;;; Typedef -(deftype set uint32_t) ; bitset +(deftype set uint64_t) ; bitset (deftype vtx uint32_t) ; vertex ;;; Structure of ITnode @@ -130,7 +135,11 @@ ;;; Worker Data (decl searchSpace (array uint64_t NUM-WORKERS)) +(decl visit2Vertices (array uint64_t NUM-WORKERS)) +(decl thresholdPruning (array uint64_t NUM-WORKERS)) +(decl inclusivePruning (array uint64_t NUM-WORKERS)) (decl taskRequest (array int NUM-WORKERS)) +(decl tableReference (array uint64_t NUM-WORKERS)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -146,18 +155,28 @@ (def (csym::elapsedTime t1 t2) (fn double (ptr (struct timeval)) (ptr (struct timeval))) (return (+ (- (fref t2 -> tv-sec) (fref t1 -> tv-sec)) (* 0.000001 (- (fref t2 -> tv-usec) (fref t1 -> tv-usec)))))) -;;; Function: countBits - count the number of "i-th bit == 1" -(def (csym::countBits x) (fn int set) +;;; Function: countBits32 - count the number of "i-th bit == 1" +(def (csym::countBits32 x) (fn int uint32_t) (= x (+ (bit-and x #x55555555) (bit-and (>> x 1) #x55555555))) (= x (+ (bit-and x #x33333333) (bit-and (>> x 2) #x33333333))) (= x (+ (bit-and x #x0f0f0f0f) (bit-and (>> x 4) #x0f0f0f0f))) (= x (+ (bit-and x #x00ff00ff) (bit-and (>> x 8) #x00ff00ff))) (return (+ (bit-and x #x0000ffff) (bit-and (>> x 16) #x0000ffff)))) +;;; Function: countBits64 - count the number of "i-th bit == 1" +(def (csym::countBits64 x) (fn int uint64_t) + (= x (+ (bit-and x (c-exp "0x5555555555555555UL")) (>> (bit-and x (c-exp "0xaaaaaaaaaaaaaaaaUL")) 1))) + (= x (+ (bit-and x (c-exp "0x3333333333333333UL")) (>> (bit-and x (c-exp "0xccccccccccccccccUL")) 2))) + (= x (+ (bit-and x (c-exp "0x0f0f0f0f0f0f0f0fUL")) (>> (bit-and x (c-exp "0xf0f0f0f0f0f0f0f0UL")) 4))) + (= x (+ (bit-and x (c-exp "0x00ff00ff00ff00ffUL")) (>> (bit-and x (c-exp "0xff00ff00ff00ff00UL")) 8))) + (= x (+ (bit-and x (c-exp "0x0000ffff0000ffffUL")) (>> (bit-and x (c-exp "0xffff0000ffff0000UL")) 16))) + (= x (+ (bit-and x (c-exp "0x00000000ffffffffUL")) (>> (bit-and x (c-exp "0xffffffff00000000UL")) 32))) + (return x)) + ;;; Function: printBits - print a variable with set data type by binary representation (def (csym::printBits x) (fn void (const set)) (decl i int) - (def mask set (<< 1 (- BIT-LEN 1))) + (def mask set (<< (cast set 1) (- BIT-LEN 1))) (for ((= i 0) (< i BIT-LEN) (inc i)) (if (bit-and x mask) (csym::fprintf stderr "1") @@ -167,7 +186,7 @@ ;;; Function: fprintBits - write a variable with set data type by binary representation to stream (def (csym::fprintBits fp x) (fn void (ptr FILE) (const set)) (decl i int) - (def mask set (<< 1 (- BIT-LEN 1))) + (def mask set (<< (cast set 1) (- BIT-LEN 1))) (for ((= i 0) (< i BIT-LEN) (inc i)) (if (bit-and x mask) (csym::fprintf fp "1") @@ -308,18 +327,15 @@ (def numSubgraph int) (def numSearch uint64_t) (def numThreshold uint64_t) - (def numPruning int)) + (def numPruning int) + (def numTableReference uint64_t)) ;;;Function: initExploreCCIG - -(def (initExploreCCIG traversed itemTable C T pTsk) (fn void int (ptr ITlist) (ptr vtx) (ptr vtx) (ptr (struct T-exploreCCIG))) +(def (initExploreCCIG traversed itemTable C T pTsk) (fn void (ptr int) (ptr ITlist) (ptr vtx) (ptr vtx) (ptr (struct T-exploreCCIG))) (decl i int) ;; initialize vTraversed - (if (== traversed 0) - (begin - (= (fref pTsk -> vTraversed) (cast (ptr int) (csym::calloc V-SIZE (sizeof int))))) - (begin - (= (fref pTsk -> vTraversed) (cast (ptr int) (csym::malloc (* V-SIZE (sizeof int))))))) + (= (fref pTsk -> vTraversed) (cast (ptr int) (csym::calloc V-SIZE (sizeof int)))) ;; initialize vItemTable (= (fref pTsk -> vItemTable) (cast (ptr ITlist) (csym::malloc (* V-SIZE (sizeof ITlist))))) @@ -328,12 +344,12 @@ ;; initialize C (= (fref pTsk -> numC) 0) - (= (fref pTsk -> sizeOfC) 15000) + (= (fref pTsk -> sizeOfC) 10000) (= (fref pTsk -> C) (cast (ptr vtx) (csym::malloc (* (fref pTsk -> sizeOfC) (sizeof vtx))))) ;; initialize T (= (fref pTsk -> numT) 0) - (= (fref pTsk -> sizeOfT) 100) + (= (fref pTsk -> sizeOfT) 1000) (= (fref pTsk -> T) (cast (ptr vtx) (csym::malloc (* (fref pTsk -> sizeOfT) (sizeof vtx))))) ;; init subgraph @@ -345,7 +361,8 @@ (= (fref pTsk -> numSubgraph) 0) (= (fref pTsk -> numSearch) 0) (= (fref pTsk -> numThreshold) 0) - (= (fref pTsk -> numPruning) 0)) + (= (fref pTsk -> numPruning) 0) + (= (fref pTsk -> numTableReference) 0)) ;;; Function: exploreCCIG - create a common-itemset tree with recursive call (def (exploreCCIG minC maxC v itemSet pTsk) (wfn void int int int (array set) (ptr (struct T-exploreCCIG))) @@ -367,13 +384,12 @@ (if (== (aref (fref pTsk -> vTraversed) vv) 1) (begin - (inc (fref pTsk -> numSearch)) - ;; evaluate common itemset (for ((= k 0) (= m 0) (= commonNum 0) (< k BIT-ITEM) (inc k)) (= (aref commonItem k) (cast set (bit-and (aref itemSet k) (aref vItem vv k)))) - (+= commonNum (csym::countBits (aref commonItem k))) - ;(+= commonNum (csym::--builtin-popcount (aref commonItem k))) + ;(+= commonNum (csym::countBits32 (aref commonItem k))) + (+= commonNum (csym::countBits64 (aref commonItem k))) + ;(+= commonNum (csym::_mm_popcnt_u64 (aref commonItem k))) (if (== (aref commonItem k) (aref itemSet k)) (inc m))) (if (== m BIT-ITEM) @@ -387,6 +403,7 @@ ;; check that common-itemset is subset of item table (= ITptr (fref (fref (aref (fref pTsk -> vItemTable) vv) head) -> next)) (while (!= ITptr (fref (aref (fref pTsk -> vItemTable) vv) head)) + (inc (fref pTsk -> numTableReference)) (for ((= k 0) (= m 0) (< k BIT-ITEM) (inc k)) (if (== (cast set (bit-and (aref commonItem k) (aref (fref ITptr -> item) k))) (aref commonItem k)) (inc m))) @@ -404,6 +421,7 @@ (= ITptr (fref (fref (aref (fref pTsk -> vItemTable) vv) head) -> next)) (while (!= ITptr (fref (aref (fref pTsk -> vItemTable) vv) head)) + (inc (fref pTsk -> numTableReference)) (for ((= k 0) (= m 0) (< k BIT-ITEM) (inc k)) (if (== (cast set (bit-and (aref (fref ITptr -> item) k) (aref commonItem k))) (aref (fref ITptr -> item) k)) (inc m))) @@ -412,6 +430,8 @@ (csym::removeITnode (ptr (aref (fref pTsk -> vItemTable) vv)) (fref ITptr -> prev)))) (csym::insertITnodeAfter (ptr (aref (fref pTsk -> vItemTable) vv)) (fref (aref (fref pTsk -> vItemTable) vv) head) commonItem) + (inc (fref pTsk -> numSearch)) + ;; add new candidates (if (>= (+ (fref pTsk -> numC) (aref vDegree vv)) (fref pTsk -> sizeOfC)) (begin @@ -489,7 +509,7 @@ (= (fref this maxC) i2) (= (fref this v) v) (csym::memcpy (fref this itemSet) itemSet (* (sizeof set) BIT-ITEM)) - (initExploreCCIG 1 NULL NULL NULL (ptr this)) + (initExploreCCIG NULL NULL NULL NULL (ptr this)) (csym::memcpy (fref this vTraversed) (fref pTsk -> vTraversed) (* (sizeof int) V-SIZE)) (for ((= j 0) (< j i1) (inc j)) (inc (aref (fref this vTraversed) (aref (fref pTsk -> C) (- (- numC j) 1))))) @@ -507,15 +527,14 @@ (:get (%if* DEBUG-COPY (begin (csym::gettimeofday (+ tpc 2) 0))) - (= (fref (fref (fref (fref pTsk -> subgraph) head) -> prev) -> next) (fref (fref (fref this subgraph) head) -> next)) - (= (fref (fref (fref (fref this subgraph) head) -> next) -> prev) (fref (fref (fref pTsk -> subgraph) head) -> prev)) - (= (fref (fref (fref (fref this subgraph) head) -> prev) -> next) (fref (fref pTsk -> subgraph) head)) - (= (fref (fref (fref pTsk -> subgraph) head) -> prev) (fref (fref (fref this subgraph) head) -> prev)) + (%if* DEBUG-RSLT (begin + (= (fref (fref (fref (fref pTsk -> subgraph) head) -> prev) -> next) (fref (fref (fref this subgraph) head) -> next)) + (= (fref (fref (fref (fref this subgraph) head) -> next) -> prev) (fref (fref (fref pTsk -> subgraph) head) -> prev)) + (= (fref (fref (fref (fref this subgraph) head) -> prev) -> next) (fref (fref pTsk -> subgraph) head)) + (= (fref (fref (fref pTsk -> subgraph) head) -> prev) (fref (fref (fref this subgraph) head) -> prev)))) (+= (fref pTsk -> treeDepth) (fref this treeDepth)) (+= (fref pTsk -> numTraversed) (fref this numTraversed)) (+= (fref pTsk -> numSubgraph) (fref this numSubgraph)) - (+= (fref pTsk -> numThreshold) (fref this numThreshold)) - (+= (fref pTsk -> numPruning) (fref this numPruning)) (%if* DEBUG-COPY (begin (csym::gettimeofday (+ tpc 3) 0) (csym::fprintf fpCopy "%f, 1~%" (+ (csym::elapsedTime tpc (+ tpc 1)) (csym::elapsedTime (+ tpc 2) (+ tpc 3))))))))) @@ -535,9 +554,11 @@ (csym::gettimeofday tp 0) (exploreCCIG (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this)) (csym::gettimeofday (+ tp 1) 0) - (+= (aref searchSpace (fref -thr -> id)) (fref this numSearch)) + (+= (aref visit2Vertices (fref -thr -> id)) (fref this numSearch)) + (+= (aref thresholdPruning (fref -thr -> id)) (fref this numThreshold)) + (+= (aref inclusivePruning (fref -thr -> id)) (fref this numPruning)) + (+= (aref tableReference (fref -thr -> id)) (fref this numTableReference)) (%if* DEBUG-TASK (begin - ;(csym::fprintf stderr "T-exploreCCIG(%d): %f[sec](%f[sec]), %llu, ID:%d~%" (aref (fref this T) 0) (csym::elapsedTime tp (+ tp 1)) (csym::elapsedTime (ptr t0) (+ tp 1)) (fref this numSearch) (fref -thr -> id)) (csym::fprintf fpTask "%f, %f, %llu~%" (csym::elapsedTime tp (+ tp 1)) (csym::elapsedTime (ptr t0) (+ tp 1)) (fref this numSearch)))) (csym::free (fref this vTraversed)) (for ((= i 0) (< i V-SIZE) (inc i)) @@ -572,6 +593,7 @@ ;; check that itemset of 'i' is subset of itemset-table (= ITptr (fref (fref (aref (fref pTsk -> vItemTable) i) head) -> next)) + (inc (fref pTsk -> numTableReference)) (for ((= k 0) (< k BIT-ITEM) (inc k)) (if (!= (cast set (bit-and (aref vItem i k) (aref (fref ITptr -> item) k))) (aref vItem i k)) (begin @@ -587,6 +609,8 @@ (csym::clearITlist (ptr (aref (fref pTsk -> vItemTable) i))) (csym::insertITnodeAfter (ptr (aref (fref pTsk -> vItemTable) i)) (fref (aref (fref pTsk -> vItemTable) i) head) (aref vItem i)) + (inc (fref pTsk -> numSearch)) + (for ((= j (aref vFirstEdge i)) (!= j -1) (= j (aref eNext j))) (if (< i (aref eTo j)) (begin @@ -628,7 +652,7 @@ (csym::gettimeofday tpc 0))) (= (fref this minVertex) i1) (= (fref this maxVertex) i2) - (initExploreCCIG 0 NULL NULL NULL (ptr (fref this tsk))) + (initExploreCCIG NULL NULL NULL NULL (ptr (fref this tsk))) (for ((= j (+ i1 1)) (< j V-SIZE) (inc j)) (= ITptr (fref (fref (aref (fref pTsk -> vItemTable) j) head) -> next)) (while (!= ITptr (fref (aref (fref pTsk -> vItemTable) j) head)) @@ -639,15 +663,14 @@ (:get (%if* DEBUG-COPY (begin (csym::gettimeofday (+ tpc 2) 0))) - (= (fref (fref (fref (fref pTsk -> subgraph) head) -> prev) -> next) (fref (fref (fref (fref this tsk) subgraph) head) -> next)) - (= (fref (fref (fref (fref (fref this tsk) subgraph) head) -> next) -> prev) (fref (fref (fref pTsk -> subgraph) head) -> prev)) - (= (fref (fref (fref (fref (fref this tsk) subgraph) head) -> prev) -> next) (fref (fref pTsk -> subgraph) head)) - (= (fref (fref (fref pTsk -> subgraph) head) -> prev) (fref (fref (fref (fref this tsk) subgraph) head) -> prev)) + (%if* DEBUG-RSLT (begin + (= (fref (fref (fref (fref pTsk -> subgraph) head) -> prev) -> next) (fref (fref (fref (fref this tsk) subgraph) head) -> next)) + (= (fref (fref (fref (fref (fref this tsk) subgraph) head) -> next) -> prev) (fref (fref (fref pTsk -> subgraph) head) -> prev)) + (= (fref (fref (fref (fref (fref this tsk) subgraph) head) -> prev) -> next) (fref (fref pTsk -> subgraph) head)) + (= (fref (fref (fref pTsk -> subgraph) head) -> prev) (fref (fref (fref (fref this tsk) subgraph) head) -> prev)))) (+= (fref pTsk -> treeDepth) (fref (fref this tsk) treeDepth)) (+= (fref pTsk -> numTraversed) (fref (fref this tsk) numTraversed)) (+= (fref pTsk -> numSubgraph) (fref (fref this tsk) numSubgraph)) - (+= (fref pTsk -> numThreshold) (fref (fref this tsk) numThreshold)) - (+= (fref pTsk -> numPruning) (fref (fref this tsk) numPruning)) (csym::free (fref (fref this tsk) vTraversed)) (for ((= j 0) (< j V-SIZE) (inc j)) (csym::termITlist (ptr (aref (fref (fref this tsk) vItemTable) j)))) @@ -665,9 +688,11 @@ (csym::gettimeofday tp 0) (enumCCIG (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk))) (csym::gettimeofday (+ tp 1) 0) - (+= (aref searchSpace (fref -thr -> id)) (fref (fref this tsk) numSearch)) + (+= (aref visit2Vertices (fref -thr -> id)) (fref (fref this tsk) numSearch)) + (+= (aref thresholdPruning (fref -thr -> id)) (fref (fref this tsk) numThreshold)) + (+= (aref inclusivePruning (fref -thr -> id)) (fref (fref this tsk) numPruning)) + (+= (aref tableReference (fref -thr -> id)) (fref (fref this tsk) numTableReference)) (%if* DEBUG-TASK (begin - ;(csym::fprintf stderr "T-enumCCIG(from %d to %d): %f[sec](%f[sec]), %llu, ID:%d~%" (fref this minVertex) (fref this maxVertex) (csym::elapsedTime tp (+ tp 1)) (csym::elapsedTime (ptr t0) (+ tp 1)) (fref (fref this tsk) numSearch) (fref -thr -> id)) (csym::fprintf fpTask "%f, %f, %llu~%" (csym::elapsedTime tp (+ tp 1)) (csym::elapsedTime (ptr t0) (+ tp 1)) (fref (fref this tsk) numSearch))))) ;;; Function: thresholdItem - delete the vertex whose # of items is less than the user-specified threshold @@ -705,12 +730,16 @@ (= l k))))))) ;;; Function: loadPatternFile - load pattern file -(def (loadPatternFile patternFile maxNumItems) (fn void (ptr (const char)) (ptr int)) - (decl n int) ; item number - (decl v int) ; vertex number - (decl item (ptr char)) ; - (decl buff (array char 256)) ; buffer - (decl fp (ptr FILE)) ; file pointer +(def (loadPatternFile patternFile maxNumItems eHash iHash) (fn void (ptr (const char)) (ptr int) (ptr (struct hsearch_data)) (ptr (struct hsearch_data))) + (def i int 0) ; + (decl n int) ; item number + (decl v int) ; vertex number + (decl item (ptr char)) ; + (decl buff (array char 256)) ; buffer + (decl temp (array char 256)) ; + (decl he (struct entry)) ; + (decl hep (ptr (struct entry))) ; + (decl fp (ptr FILE)) ; file pointer ;; open pattern file (if (== (= fp (csym::fopen patternFile "r")) NULL) @@ -724,10 +753,30 @@ (if (!= (csym::strncmp buff "#" 1) 0) (begin (= v (csym::atoi (csym::strtok buff "~|11|"))) + + ;; find v from eHash + (csym::sprintf temp "%d" v) + (= (fref he key) temp) + (csym::hsearch_r he FIND (ptr hep) eHash) + (if (== hep NULL) + (continue)) + (= v (cast int (fref hep -> data))) + ;; add item to Vertex Data (while (!= (= item (csym::strtok NULL ",")) NULL) (= n (csym::atoi item)) - (bit-or= (aref vItem v (cast int (/ n BIT-LEN))) (<< 1 (cast int (% n BIT-LEN)))) + + ;; enter n to iHash + (csym::sprintf temp "%d" n) + (= (fref he key) temp) + (csym::hsearch_r he FIND (ptr hep) iHash) + (if (== hep NULL) + (begin + (= (fref he data) (cast (ptr void) (inc i))) + (csym::hsearch_r he ENTER (ptr hep) iHash))) + (= n (cast int (fref hep -> data))) + + (bit-or= (aref vItem v (cast int (/ n BIT-LEN))) (<< (cast set 1) (cast int (% n BIT-LEN)))) (inc (aref vNumItems v)) ; increase # of items ;; evaluate maximum # of items (if (> n (mref maxNumItems)) @@ -782,12 +831,16 @@ (inc (aref vDegree v1))) ;;; Function: loadGraphFile - load graph file -(def (loadGraphFile graphFile edgeMax minVertex maxVertex) (fn void (ptr (const char)) (ptr int) (ptr int) (ptr int)) - (defs int v1 v2) ; starting point, ending point - (decl eLabel (ptr char)) ; label of edge - (decl empty (ptr char)) ; - (decl buff (array char 256)) ; buffer - (decl fp (ptr FILE)) ; file pointer +(def (loadGraphFile graphFile edgeMax minVertex maxVertex eHash) (fn void (ptr (const char)) (ptr int) (ptr int) (ptr int) (ptr (struct hsearch_data))) + (def v int 1) ; + (defs int v1 v2) ; starting point, ending point + (decl eLabel (ptr char)) ; label of edge + (decl empty (ptr char)) ; + (decl buff (array char 256)) ; buffer + (decl temp (array char 256)) ; + (decl he (struct entry)) ; + (decl hep (ptr (struct entry))) ; + (decl fp (ptr FILE)) ; file pointer ;; open graph file (if (== (= fp (csym::fopen graphFile "r")) NULL) @@ -804,6 +857,27 @@ (= eLabel (csym::strtok NULL "~|11|")) (= v2 (csym::atoi (csym::strtok NULL "~|11|"))) (= empty (csym::strtok NULL "~|11|")) + + ;; enter v1 to eHash + (csym::sprintf temp "%d" v1) + (= (fref he key) temp) + (csym::hsearch_r he FIND (ptr hep) eHash) + (if (== hep NULL) + (begin + (= (fref he data) (cast (ptr void) (inc v))) + (csym::hsearch_r he ENTER (ptr hep) eHash))) + (= v1 (cast int (fref hep -> data))) + + ;; enter v2 to eHash + (csym::sprintf temp "%d" v2) + (= (fref he key) temp) + (csym::hsearch_r he FIND (ptr hep) eHash) + (if (== hep NULL) + (begin + (= (fref he data) (cast (ptr void) (inc v))) + (csym::hsearch_r he ENTER (ptr hep) eHash))) + (= v2 (cast int (fref hep -> data))) + ;; add edge to Edge List (if (== empty NULL) (if (!= v1 v2) @@ -815,7 +889,7 @@ (csym::fclose fp)) ;;; Function: initData - initialize Edge Data & Vertex Data & Debug Data -(def (initData edgeMax minVertex maxVertex maxNumItems) (fn void (ptr int) (ptr int) (ptr int) (ptr int)) +(def (initData edgeMax minVertex maxVertex maxNumItems eHash iHash) (fn void (ptr int) (ptr int) (ptr int) (ptr int) (ptr (struct hsearch_data)) (ptr (struct hsearch_data))) (defs int i j) ; temporary variable ;; initialize Edge Data @@ -838,9 +912,20 @@ ;; initialize Debug Data (for ((= i 0) (< i NUM-WORKERS) (inc i)) (= (aref searchSpace i) 0) - (= (aref taskRequest i) 0)) + (= (aref visit2Vertices i) 0) + (= (aref thresholdPruning i) 0) + (= (aref inclusivePruning i) 0) + (= (aref taskRequest i) 0) + (= (aref tableReference i) 0)) + (for ((= i 0) (< i V-SIZE) (inc i)) - (= (aref doneID i) 0))) + (= (aref doneID i) 0)) + + ;; initialize Hash Data + (csym::memset eHash 0 (sizeof (mref eHash))) + (csym::memset iHash 0 (sizeof (mref iHash))) + (csym::hcreate_r E-SIZE eHash) + (csym::hcreate_r I-SIZE iHash)) ;;; (def (task T-startCCIG) @@ -876,17 +961,25 @@ ;; Subgraph Data (decl Gptr (ptr Gnode)) + ;; Hash Data + (defs (struct hsearch_data) eHash iHash) + ;; Debug Data - (def numSearch uint64_t 0) ; # of search space - (def avgWorkerSearch double 0.0) ; - (def workerSearchSD double 0.0) ; - (def avgWorkerSearchPerSec double 0.0) ; - (def workerSearchPerSecSD double 0.0) ; - (def numTaskRequest int 0) ; # of task request - (def avgTaskRequest double 0.0) ; - (def taskRequestSD double 0.0) ; - (def avgSizeSubgraph uint64_t 0) ; - (def maxSizeSubgraph int 0) ; + (def numSearch uint64_t 0) ; # of search space + (def maxWorkerSearch uint64_t 0) ; + (def minWorkerSearch uint64_t UINT-LEAST64-MAX) ; + (def avgWorkerSearch double 0.0) ; + (def workerSearchSD double 0.0) ; + (def avgWorkerSearchPerSec double 0.0) ; + (def workerSearchPerSecSD double 0.0) ; + (def numTaskRequest int 0) ; # of task request + (def avgTaskRequest double 0.0) ; + (def taskRequestSD double 0.0) ; + (def numTableReference uint64_t 0) ; + (def avgTableReference double 0.0) ; + (def tableReferenceSD double 0.0) ; + (def avgSizeSubgraph uint64_t 0) ; + (def maxSizeSubgraph int 0) ; ;; arguments (= patternFile "data/symatlas_pattern.txt") @@ -913,13 +1006,13 @@ (csym::sprintf copyFile "copy2-%02d_%d-half.csv" (fref option num-thrs) (fref this th)))))) ;; initialize Edge Data & Vertex Data & Debug Data - (initData (ptr edgeMax) (ptr minVertex) (ptr maxVertex) (ptr maxNumItems)) + (initData (ptr edgeMax) (ptr minVertex) (ptr maxVertex) (ptr maxNumItems) (ptr eHash) (ptr iHash)) ;; load graph file - (loadGraphFile graphFile (ptr edgeMax) (ptr minVertex) (ptr maxVertex)) + (loadGraphFile graphFile (ptr edgeMax) (ptr minVertex) (ptr maxVertex) (ptr eHash)) ;; load pattern file - (loadPatternFile patternFile (ptr maxNumItems)) + (loadPatternFile patternFile (ptr maxNumItems) (ptr eHash) (ptr iHash)) ;; delete the vertex whose # of items is less than the user-specified threshold (thresholdItem minVertex maxVertex) @@ -928,7 +1021,7 @@ (= loopRange (cast int (/ (- (+ maxVertex 1) minVertex) (fref this loopRatio)))) ;; init T-exploreCCIG - (initExploreCCIG 0 NULL NULL NULL (ptr tsk)) + (initExploreCCIG NULL NULL NULL NULL (ptr tsk)) ;; open task file (%if* DEBUG-TASK (begin @@ -953,24 +1046,30 @@ ;; enumerate CCIG (= i minVertex) - (for ((= j 1) (< j (fref this loopRatio)) (inc j)) - (enumCCIG i (+ i loopRange) (ptr tsk)) - (+= i loopRange)) - (enumCCIG i (+ maxVertex 1) (ptr tsk)) + (for ((< (+ i loopRange) maxVertex) (+= i loopRange)) + (enumCCIG i (+ i loopRange) (ptr tsk))) + (enumCCIG i (+ maxVertex 1) (ptr tsk)) ;; get end time of program (csym::gettimeofday (+ tp 1) 0) (= t2 (csym::getrusageSec)) + ;; dispose of hash tables + (csym::hdestroy_r (ptr eHash)) + (csym::hdestroy_r (ptr iHash)) + ;; close copy file (%if* DEBUG-COPY (begin (csym::fclose fpCopy))) (%if* DEBUG-TASK (begin - ;(csym::fprintf stderr "T-enumCCIG(from %d to %d): %f[sec](%f[sec]), %llu, ID:%d~%" minVertex maxVertex (csym::elapsedTime tp (+ tp 1)) (csym::elapsedTime (ptr t0) (+ tp 1)) (fref tsk numSearch) (fref -thr -> id)) (csym::fprintf fpTask "%f, %f, %llu~%" (csym::elapsedTime tp (+ tp 1)) (csym::elapsedTime (ptr t0) (+ tp 1)) (fref tsk numSearch)) (csym::fclose fpTask))) - (+= (aref searchSpace (fref -thr -> id)) (fref tsk numSearch)) + + (+= (aref visit2Vertices (fref -thr -> id)) (fref tsk numSearch)) + (+= (aref thresholdPruning (fref -thr -> id)) (fref tsk numThreshold)) + (+= (aref inclusivePruning (fref -thr -> id)) (fref tsk numPruning)) + (+= (aref tableReference (fref -thr -> id)) (fref tsk numTableReference)) (%if* DEBUG-TIME (begin ;; open time file @@ -1047,36 +1146,45 @@ ;; show debug datas (csym::fprintf stderr "time = %f[sec]~%" (csym::elapsedTime tp (+ tp 1))) (csym::fprintf stderr "user time = %f[sec]~%" (- t2 t1)) - (csym::fprintf stderr "Max size of subgraph = %d~%" maxSizeSubgraph) (csym::fprintf stderr "# of subgraphs = %d~%" (fref tsk numSubgraph)) - (csym::fprintf stderr "# of thresholds = %llu~%" (fref tsk numThreshold)) - (csym::fprintf stderr "# of prunings = %u~%" (fref tsk numPruning)) - (csym::fprintf stderr "Avg. tree depth = %f~%" (/ (cast double (fref tsk treeDepth)) (cast double (fref tsk numTraversed)))) + (csym::fprintf stderr "Avg. size of tree depth = %f~%" (/ (cast double (fref tsk treeDepth)) (cast double (fref tsk numTraversed)))) (%if* DEBUG-RSLT (begin (csym::fprintf stderr "Max size of subgraph = %d~%" maxSizeSubgraph) (csym::fprintf stderr "Avg. size of subgraph = %f~%" (/ (cast double avgSizeSubgraph) (cast double (fref tsk numSubgraph)))))) (csym::fprintf stderr "~%# of searches & task-requests~%") (for ((= j 0) (< j (fref option num-thrs)) (inc j)) - (csym::fprintf stderr " ID:%d, %llu, %d~%" j (aref searchSpace j) (aref taskRequest j)) + (= (aref searchSpace j) (+ (+ (aref visit2Vertices j) (aref thresholdPruning j)) ( +aref inclusivePruning j))) + (csym::fprintf stderr " ID:%d, %llu(%llu, %llu, %llu), %d, %llu~%" j (aref searchSpace j) (aref visit2Vertices j) (aref thresholdPruning j) (aref inclusivePruning j) (aref taskRequest j) (aref tableReference j)) (+= numSearch (aref searchSpace j)) + (if (< maxWorkerSearch (aref searchSpace j)) + (= maxWorkerSearch (aref searchSpace j))) + (if (> minWorkerSearch (aref searchSpace j)) + (= minWorkerSearch (aref searchSpace j))) (+= avgWorkerSearchPerSec (/ (aref searchSpace j) (csym::elapsedTime tp (+ tp 1)))) - (+= numTaskRequest (aref taskRequest j))) + (+= numTaskRequest (aref taskRequest j)) + (+= numTableReference (aref tableReference j))) (= avgWorkerSearch (/ (cast double numSearch) (cast double (fref option num-thrs)))) (= avgWorkerSearchPerSec (/ avgWorkerSearchPerSec (cast double (fref option num-thrs)))) (= avgTaskRequest (/ (cast double numTaskRequest) (cast double (fref option num-thrs)))) + (= avgTableReference (/ (cast double numTableReference) (cast double (fref option num-thrs)))) (for ((= j 0) (< j (fref option num-thrs)) (inc j)) (+= workerSearchSD (csym::pow (- (aref searchSpace j) avgWorkerSearch) 2.0)) (+= workerSearchPerSecSD (csym::pow (- (/ (aref searchSpace j) (csym::elapsedTime tp (+ tp 1))) avgWorkerSearchPerSec) 2.0)) - (+= taskRequestSD (csym::pow (- (aref taskRequest j) avgTaskRequest) 2.0))) + (+= taskRequestSD (csym::pow (- (aref taskRequest j) avgTaskRequest) 2.0)) + (+= tableReferenceSD (csym::pow (- (aref tableReference j) avgTableReference) 2.0))) (/= workerSearchSD (fref option num-thrs)) (/= workerSearchPerSecSD (fref option num-thrs)) (/= taskRequestSD (fref option num-thrs)) + (/= tableReferenceSD (fref option num-thrs)) (= workerSearchSD (csym::sqrt workerSearchSD)) (= workerSearchPerSecSD (csym::sqrt workerSearchPerSecSD)) (= taskRequestSD (csym::sqrt taskRequestSD)) + (= tableReferenceSD (csym::sqrt tableReferenceSD)) - (csym::fprintf stderr "# of searches = %llu, Avg. = %.1f, S.D. = %.1f~%" numSearch avgWorkerSearch workerSearchSD) - (csym::fprintf stderr "# of task requests = %d, Avg. = %.2f, S.D. = %.2f~%" numTaskRequest avgTaskRequest taskRequestSD) - (csym::fprintf stderr "# of searches / sec = %.1f, Avg. = %.1f, S.D. = %.1f~%" (/ numSearch (csym::elapsedTime tp (+ tp 1))) avgWorkerSearchPerSec workerSearchPerSecSD)) + (csym::fprintf stderr "# of searches = %llu, Min = %llu, Max = %llu, Avg. = %.1f, S.D. = %.1f~%" numSearch minWorkerSearch maxWorkerSearch avgWorkerSearch workerSearchSD) + (csym::fprintf stderr "# of task requests = %d, Avg. = %.1f, S.D. = %.1f~%" numTaskRequest avgTaskRequest taskRequestSD) + (csym::fprintf stderr "# of searches / sec = %.1f, Avg. = %.1f, S.D. = %.1f~%" (/ numSearch (csym::elapsedTime tp (+ tp 1))) avgWorkerSearchPerSec workerSearchPerSecSD) + (csym::fprintf stderr "# of table references = %llu, Avg. = %.1f, S.D. = %.1f~%" numTableReference avgTableReference tableReferenceSD)) diff --git a/src/sample/tcell/copine3.tcell b/src/sample/tcell/copine3.tcell index 47c73cfe..54032d0b 100644 --- a/src/sample/tcell/copine3.tcell +++ b/src/sample/tcell/copine3.tcell @@ -69,14 +69,12 @@ (%defconstant NUM-WORKERS 32) ;;; Constants -(%defconstant E-SIZE 500000) ; # of edges -(%defconstant V-SIZE 25000) ; # of vertices -(%defconstant TID_LEN 128) ; bit length of task id -(%defconstant TID_NUM 4) ; # of task id -(%defconstant BIT-LEN 64) ; bit length of bitset -(%defconstant BIT-ITEM 3) ; # of items = BIT-ITEM * BIT-LEN -(%defconstant BIT-EDGE 8125) ; # of edges = BIT-EDGE * BIT-LEN -(%defconstant BIT-VERTEX 625) ; # of vertices = BIT-VERTEX * BIT-LEN +(%defconstant E-SIZE 500000) ; # of edges +(%defconstant V-SIZE 15500) ; # of vertices +(%defconstant BIT-LEN 64) ; bit length of bitset +(%defconstant BIT-ITEM 3) ; # of items = BIT-ITEM * BIT-LEN +(%defconstant BIT-EDGE 8125) ; # of edges = BIT-EDGE * BIT-LEN +(%defconstant BIT-VERTEX 625) ; # of vertices = BIT-VERTEX * BIT-LEN (%defconstant I-SIZE (* BIT-LEN BIT-ITEM)) ; ;;; Debug Flags @@ -95,8 +93,8 @@ ;;; Structure of ITnode (def (struct --ITnode) - (decl minID (array task-id TID_NUM)) ; task ID - (decl maxID (array task-id TID_NUM)) ; task ID + (decl minID task-id) ; task ID + (decl maxID task-id) ; task ID (decl item (array set BIT-ITEM)) ; itemset (decl prev (ptr (struct --ITnode))) ; pointer to the previous node (decl next (ptr (struct --ITnode)))) ; pointer to the next node @@ -213,20 +211,6 @@ (csym::fprintf fp "0")) (>>= mask 1))) -;;; Function: printTaskID -(def (csym::printTaskID x) (fn void (ptr task-id)) - (defs int i j) - (decl mask task-id) - (for ((= i 0) (< i TID_NUM) (inc i)) - (= mask (<< (cast task-id 1) (- TID-LEN 1))) - (for ((= j 0) (< j TID_LEN) (inc j)) - (if (cast task-id (bit-and (aref x i) mask)) - (csym::fprintf stderr "1") - (csym::fprintf stderr "0")) - (>>= mask 1)) - (csym::fprintf stderr " ")) - (csym::fprintf stderr "~%")) - ;;; Function: fprintDecimally - write a variable with set date type by decimal representation to stream (def (csym::fprintDecimally fp x k) (fn void (ptr FILE) (const set) int) (decl i int) @@ -238,75 +222,19 @@ ;;; Function: resetTaskID - (def (csym::resetTaskID param) (fn (ptr void) (ptr void)) - (defs int i j) + (decl i int) (def data (ptr threadInfo) (cast (ptr threadInfo) param)) (decl ITptr (ptr ITnode)) ; pointer to the ITnode (for ((= i (fref data -> loopStart)) (< i (fref data -> loopEnd)) (inc i)) (= ITptr (fref (fref (aref vItemTable i) head) -> next)) (while (!= ITptr (fref (aref vItemTable i) head)) - (for ((= j 0) (< j TID_NUM) (inc j)) - (= (aref (fref ITptr -> minID) j) (cast task-id 0)) - (= (aref (fref ITptr -> maxID) j) (cast task-id 0))) + (= (fref ITptr -> minID) (cast task-id 0)) + (= (fref ITptr -> maxID) (cast task-id 0)) (= ITptr (fref ITptr -> next)))) (csym::pthread_exit 0)) -;;; Function: compareTaskID - -(def (csym::compareTaskID id1 id2) (fn int (ptr task-id) (ptr task-id)) - (decl i int) - (for ((= i 0) (< i TID_NUM) (inc i)) - (if (> (aref id1 i) (aref id2 i)) - (begin - (return 1)) - (if (< (aref id1 i) (aref id2 i)) - (return -1)))) - (return 0)) - -;;; Function: divideTaskID - -(def (csym::divideTaskID victimMin victimMax thiefMin thiefMax) (fn void (ptr task-id) (ptr task-id) (ptr task-id) (ptr task-id)) - (defs int i flagU flagD Co) - (def maxValue task-id -1) - (def carryDown task-id (<< (cast task-id 1) (- TID_LEN 1))) - - (csym::memcpy thiefMax victimMax (* (sizeof task-id) TID_NUM)) - - (for ((= flagU 0) (= flagD 0) (= i (- TID_NUM 1)) (>= i 0) (dec i)) - (if (> (aref victimMin i) (- maxValue (aref victimMax i))) - (= flagU 1)) - (+= (aref victimMax i) (aref victimMin i)) - (if (and (== (aref victimMax i) maxValue) flagD) - (= flagU 1)) - (if flagD - (+= (aref victimMax i) (cast task-id 1))) - (= Co flagU) - (= flagD flagU) - (= flagU 0)) - (= flagU Co) - (= flagD 0) - (for ((= i 0) (< i TID_NUM) (inc i)) - (if (bit-and (aref victimMax i) (cast task-id 1)) - (= flagD 1)) - (>>= (aref victimMax i) 1) - (if flagU - (bit-or= (aref victimMax i) carryDown)) - (= flagU flagD) - (= flagD 0)) - - (csym::memcpy thiefMin victimMax (* (sizeof task-id) TID_NUM))) - -;;; Function: rangeTaskID - -(def (csym::rangeTaskID minID maxID rangeID) (fn int (ptr task-id) (ptr task-id) (ptr task-id)) - (decl i int) - (for ((= i 0) (< i (- TID_NUM 1)) (inc i)) - (if (!= (aref maxID i) (aref minID i)) - (return 1))) - (= (mref rangeID) (- (aref maxID (- TID_NUM 1)) (aref minID (- TID_NUM 1)))) - ;(csym::fprintf stderr "range: %u~%" (mref rangeID)) - (if (== (mref rangeID) 0) - (return 0)) - (return -1)) - ;;; Function: allocITnode - allocate a ITnode (def (csym::allocITnode) (fn (ptr ITnode)) (return (cast (ptr ITnode) (csym::malloc(sizeof ITnode))))) @@ -319,9 +247,8 @@ (def (csym::initITlist list) (fn void (ptr ITlist)) (decl i int) (def dummyNode (ptr ITnode) (csym::allocITnode)) - (for ((= i 0) (< i TID_NUM) (inc i)) - (= (aref (fref dummyNode -> minID) i) (cast task-id 0)) - (= (aref (fref dummyNode -> maxID) i) (cast task-id 0))) + (= (fref dummyNode -> minID) (cast task-id 0)) + (= (fref dummyNode -> maxID) (cast task-id 0)) (for ((= i 0) (< i BIT-ITEM) (inc i)) (= (aref (fref dummyNode -> item) i) (cast set 0))) (= (fref list -> crnt) dummyNode) @@ -330,14 +257,14 @@ (= (fref dummyNode -> prev) dummyNode)) ;;; Function: insertITnodeAfter - insert a new ITnode after the pointer 'p' -(def (csym::insertITnodeAfter list p minID maxID item) (fn void (ptr ITlist) (ptr ITnode) (ptr task-id) (ptr task-id) (array set)) +(def (csym::insertITnodeAfter list p minID maxID item) (fn void (ptr ITlist) (ptr ITnode) task-id task-id (array set)) (decl i int) (def new (ptr ITnode) (csym::allocITnode)) (def nxt (ptr ITnode) (fref p -> next)) (= (fref (fref p -> next) -> prev) new) (= (fref p -> next) new) - (csym::memcpy (fref new -> minID) minID (* (sizeof task-id) TID_NUM)) - (csym::memcpy (fref new -> maxID) maxID (* (sizeof task-id) TID_NUM)) + (= (fref new -> minID) minID) + (= (fref new -> maxID) maxID) (for ((= i 0) (< i BIT-ITEM) (inc i)) (= (aref (fref new -> item) i) (aref item i))) (= (fref new -> prev) p) @@ -420,8 +347,8 @@ ;;; (def (task T-exploreCCIG) - (def minID (array task-id TID_NUM)) - (def maxID (array task-id TID_NUM)) + (def minID task-id) + (def maxID task-id) (def minC int) (def maxC int) (def v int) @@ -446,15 +373,11 @@ (def numMutexLocked uint64_t)) ;;;Function: initExploreCCIG - -(def (initExploreCCIG traversed itemTable C T pTsk) (fn void int (ptr ITlist) (ptr vtx) (ptr vtx) (ptr (struct T-exploreCCIG))) +(def (initExploreCCIG traversed itemTable C T pTsk) (fn void (ptr int) (ptr ITlist) (ptr vtx) (ptr vtx) (ptr (struct T-exploreCCIG))) (decl i int) ;; initialize vTraversed - (if (== traversed 0) - (begin - (= (fref pTsk -> vTraversed) (cast (ptr int) (csym::calloc V-SIZE (sizeof int))))) - (begin - (= (fref pTsk -> vTraversed) (cast (ptr int) (csym::malloc (* V-SIZE (sizeof int))))))) + (= (fref pTsk -> vTraversed) (cast (ptr int) (csym::calloc V-SIZE (sizeof int)))) ;; initialize vItemTable ;(if (== itemTable NULL) @@ -472,7 +395,7 @@ ;; initialize T (= (fref pTsk -> numT) 0) - (= (fref pTsk -> sizeOfT) 100) + (= (fref pTsk -> sizeOfT) 1000) (= (fref pTsk -> T) (cast (ptr vtx) (csym::malloc (* (fref pTsk -> sizeOfT) (sizeof vtx))))) ;; init subgraph @@ -510,8 +433,6 @@ (if (== (aref (fref pTsk -> vTraversed) vv) 1) (begin - ;(inc (fref pTsk -> numSearch)) - ;; evaluate common itemset (for ((= k 0) (= m 0) (= commonNum 0) (< k BIT-ITEM) (inc k)) (= (aref commonItem k) (cast set (bit-and (aref itemSet k) (aref vItem vv k)))) @@ -547,7 +468,7 @@ (= ITptr (fref (fref (aref vItemTable vv) head) -> next)) (while (!= ITptr (fref (aref vItemTable vv) head)) (inc (fref pTsk -> numTableReference)) - (if (<= (csym::compareTaskID (fref ITptr -> minID) (fref pTsk -> minID)) 0) + (if (<= (fref ITptr -> minID) (fref pTsk -> minID)) (begin (for ((= k 0) (= m 0) (< k BIT-ITEM) (inc k)) (if (== (cast set (bit-and (aref commonItem k) (aref (fref ITptr -> item) k))) (aref commonItem k)) @@ -583,7 +504,7 @@ (= ITptr (fref (fref (aref vItemTable vv) head) -> next)) (while (!= ITptr (fref (aref vItemTable vv) head)) (inc (fref pTsk -> numTableReference)) - (if (>= (csym::compareTaskID (fref ITptr -> minID) (fref pTsk -> minID)) 0) + (if (>= (fref ITptr -> minID) (fref pTsk -> minID)) (begin (for ((= k 0) (= m 0) (< k BIT-ITEM) (inc k)) (if (== (cast set (bit-and (aref (fref ITptr -> item) k) (aref commonItem k))) (aref (fref ITptr -> item) k)) @@ -668,8 +589,6 @@ (decl commonItem (array set BIT-ITEM)) ; common itemset (def closed int 1) ; flag which denotes subgraph is closed (decl pruning int) ; flag to prune - (decl rangeFlag int) ; - (def rangeID task-id 0) ; (decl ITptr (ptr ITnode)) ; pointer to the ITnode (decl locked int) ; (decl tp (array (struct timeval) 2)) ; @@ -682,8 +601,6 @@ (if (== (aref (fref pTsk -> vTraversed) vv) 1) (begin - ;(inc (fref pTsk -> numSearch)) - ;; evaluate common itemset (for ((= k 0) (= m 0) (= commonNum 0) (< k BIT-ITEM) (inc k)) (= (aref commonItem k) (cast set (bit-and (aref itemSet k) (aref vItem vv k)))) @@ -719,7 +636,7 @@ (= ITptr (fref (fref (aref vItemTable vv) head) -> next)) (while (!= ITptr (fref (aref vItemTable vv) head)) (inc (fref pTsk -> numTableReference)) - (if (<= (csym::compareTaskID (fref ITptr -> minID) (fref pTsk -> minID)) 0) + (if (<= (fref ITptr -> minID) (fref pTsk -> minID)) (begin (for ((= k 0) (= m 0) (< k BIT-ITEM) (inc k)) (if (== (cast set (bit-and (aref commonItem k) (aref (fref ITptr -> item) k))) (aref commonItem k)) @@ -755,7 +672,7 @@ (= ITptr (fref (fref (aref vItemTable vv) head) -> next)) (while (!= ITptr (fref (aref vItemTable vv) head)) (inc (fref pTsk -> numTableReference)) - (if (>= (csym::compareTaskID (fref ITptr -> minID) (fref pTsk -> minID)) 0) + (if (>= (fref ITptr -> minID) (fref pTsk -> minID)) (begin (for ((= k 0) (= m 0) (< k BIT-ITEM) (inc k)) (if (== (cast set (bit-and (aref (fref ITptr -> item) k) (aref commonItem k))) (aref (fref ITptr -> item) k)) @@ -806,21 +723,18 @@ (csym::fprintf stderr "> %d~%" (aref (fref pTsk -> T) (- (fref pTsk -> numT) 1)))))) ;; recursive call - (= rangeFlag (csym::rangeTaskID (fref pTsk -> minID) (fref pTsk -> maxID) (ptr rangeID))) - (switch rangeFlag - (case 1) (begin - (exploreCCIG 0 (fref pTsk -> numC) vv commonItem pTsk)) (break) - (case 0) (begin - (inc (aref seqTaskRequest (fref -thr -> id))) - (exploreCCIG2 0 (fref pTsk -> numC) vv commonItem pTsk)) (break) - (case -1) (begin - (if (>= (cast int (csym::log2 (cast double rangeID))) (fref option num-thrs)) + (if (!= (fref pTsk -> minID) (fref pTsk -> maxID)) + (begin + (if (>= (cast int (csym::log2 (cast double (- (fref pTsk -> maxID) (fref pTsk -> minID))))) (fref option num-thrs)) (begin (exploreCCIG 0 (fref pTsk -> numC) vv commonItem pTsk)) (begin (inc (aref seqTaskRequest (fref -thr -> id))) - (exploreCCIG2 0 (fref pTsk -> numC) vv commonItem pTsk)))) (break)) - + (exploreCCIG2 0 (fref pTsk -> numC) vv commonItem pTsk)))) + (begin + (inc (aref seqTaskRequest (fref -thr -> id))) + (exploreCCIG2 0 (fref pTsk -> numC) vv commonItem pTsk))) + (for ((= j 0) (< j (fref pTsk -> numC)) (inc j)) (dec (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j))))) (:after @@ -858,8 +772,10 @@ (csym::gettimeofday tpc 0))) (= (fref this minC) i1) (= (fref this maxC) i2) - (csym::divideTaskID (fref pTsk -> minID) (fref pTsk -> maxID) (fref this minID) (fref this maxID)) - (initExploreCCIG 1 NULL NULL NULL (ptr this)) + (= (fref this maxID) (fref pTsk -> maxID)) + (= (fref pTsk -> maxID) (+ (cast task-id (* (- (fref pTsk -> maxID) (fref pTsk -> minID)) 0.5)) (fref pTsk -> minID))) + (= (fref this minID) (+ (fref pTsk -> maxID) 1)) + (initExploreCCIG NULL NULL NULL NULL (ptr this)) (= (fref this v) v) (csym::memcpy (fref this itemSet) itemSet (* (sizeof set) BIT-ITEM)) (csym::memcpy (fref this vTraversed) (fref pTsk -> vTraversed) (* (sizeof int) V-SIZE)) @@ -874,17 +790,16 @@ (:get (%if* DEBUG-COPY (begin (csym::gettimeofday (+ tpc 2) 0))) - (= (fref (fref (fref (fref pTsk -> subgraph) head) -> prev) -> next) (fref (fref (fref this subgraph) head) -> next)) - (= (fref (fref (fref (fref this subgraph) head) -> next) -> prev) (fref (fref (fref pTsk -> subgraph) head) -> prev)) - (= (fref (fref (fref (fref this subgraph) head) -> prev) -> next) (fref (fref pTsk -> subgraph) head)) - (= (fref (fref (fref pTsk -> subgraph) head) -> prev) (fref (fref (fref this subgraph) head) -> prev)) + (%if* DEBUG-RSLT (begin + (= (fref (fref (fref (fref pTsk -> subgraph) head) -> prev) -> next) (fref (fref (fref this subgraph) head) -> next)) + (= (fref (fref (fref (fref this subgraph) head) -> next) -> prev) (fref (fref (fref pTsk -> subgraph) head) -> prev)) + (= (fref (fref (fref (fref this subgraph) head) -> prev) -> next) (fref (fref pTsk -> subgraph) head)) + (= (fref (fref (fref pTsk -> subgraph) head) -> prev) (fref (fref (fref this subgraph) head) -> prev)))) (+= (fref pTsk -> treeDepth) (fref this treeDepth)) (+= (fref pTsk -> numMutexTrylock) (fref this numMutexTrylock)) (+= (fref pTsk -> numMutexLocked) (fref this numMutexLocked)) (+= (fref pTsk -> numTraversed) (fref this numTraversed)) (+= (fref pTsk -> numSubgraph) (fref this numSubgraph)) - ;(+= (fref pTsk -> numThreshold) (fref this numThreshold)) - ;(+= (fref pTsk -> numPruning) (fref this numPruning)) (%if* DEBUG-COPY (begin (csym::gettimeofday (+ tpc 3) 0) (csym::fprintf fpCopy "%f, 1~%" (+ (csym::elapsedTime tpc (+ tpc 1)) (csym::elapsedTime (+ tpc 2) (+ tpc 3))))))))) @@ -900,29 +815,25 @@ (def (task-body T-exploreCCIG) (decl i int) (decl seq int) - (decl rangeFlag int) - (def rangeID task-id 0) (decl tp (array (struct timeval) 2)) (inc (aref taskRequest (fref -thr -> id))) - (= rangeFlag (csym::rangeTaskID (fref this minID) (fref this maxID) (ptr rangeID))) + (if (> (fref this minID) (fref this maxID)) + (csym::fprintf stderr "minID = %llu, maxID = %llu~%" (fref this minID) (fref this maxID))) (csym::gettimeofday tp 0) - (switch rangeFlag - (case 1) (begin - (= seq 0) - (exploreCCIG (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this))) (break) - (case 0) (begin - (= seq 1) - (inc (aref seqTaskRequest (fref -thr -> id))) - (exploreCCIG2 (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this))) (break) - (case -1) (begin - (if (>= (cast int (csym::log2 (cast double rangeID))) (fref option num-thrs)) + (if (!= (fref this minID) (fref this maxID)) + (begin + (if (>= (cast int (csym::log2 (cast double (- (fref this maxID) (fref this minID))))) (fref option num-thrs)) (begin (= seq 0) (exploreCCIG (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this))) (begin (= seq 1) (inc (aref seqTaskRequest (fref -thr -> id))) - (exploreCCIG2 (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this))))) (break)) + (exploreCCIG2 (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this))))) + (begin + (= seq 1) + (inc (aref seqTaskRequest (fref -thr -> id))) + (exploreCCIG2 (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this)))) (csym::gettimeofday (+ tp 1) 0) (+= (aref visit2Vertices (fref -thr -> id)) (fref this numSearch)) (+= (aref thresholdPruning (fref -thr -> id)) (fref this numThreshold)) @@ -977,7 +888,7 @@ (csym::fprintf fpLock "%f, %d~%" (csym::elapsedTime tp (+ tp 1)) locked))))) (= ITptr (fref (fref (aref vItemTable i) head) -> next)) (inc (fref pTsk -> numTableReference)) - (if (<= (csym::compareTaskID (fref ITptr -> minID) (fref pTsk -> minID)) 0) + (if (<= (fref ITptr -> minID) (fref pTsk -> minID)) (begin (for ((= k 0) (< k BIT-ITEM) (inc k)) (if (!= (cast set (bit-and (aref vItem i k) (aref (fref ITptr -> item) k))) (aref vItem i k)) @@ -1051,9 +962,7 @@ (defs int i j k) ; temporary variable (decl visiting int) ; flag to search (decl ITptr (ptr ITnode)) ; - (decl rangeFlag int) ; - (decl rangeID task-id 0) ; - (decl locked int) ; + (decl locked int) (decl tp (array (struct timeval) 2)) (decl tpc (array (struct timeval) 4)) @@ -1086,7 +995,7 @@ (csym::fprintf fpLock "%f, %d~%" (csym::elapsedTime tp (+ tp 1)) locked))))) (= ITptr (fref (fref (aref vItemTable i) head) -> next)) (inc (fref pTsk -> numTableReference)) - (if (<= (csym::compareTaskID (fref ITptr -> minID) (fref pTsk -> minID)) 0) + (if (<= (fref ITptr -> minID) (fref pTsk -> minID)) (begin (for ((= k 0) (< k BIT-ITEM) (inc k)) (if (!= (cast set (bit-and (aref vItem i k) (aref (fref ITptr -> item) k))) (aref vItem i k)) @@ -1135,20 +1044,17 @@ (inc (fref pTsk -> treeDepth)) (inc (fref pTsk -> numTraversed)) - (= rangeFlag (csym::rangeTaskID (fref pTsk -> minID) (fref pTsk -> maxID) (ptr rangeID))) - (switch rangeFlag - (case 1) (begin - (exploreCCIG 0 (fref pTsk -> numC) i (aref vItem i) pTsk)) (break) - (case 0) (begin - (inc (aref seqTaskRequest (fref -thr -> id))) - (exploreCCIG2 0 (fref pTsk -> numC) i (aref vItem i) pTsk)) (break) - (case -1) (begin - (if (>= (cast int (csym::log2 (cast double rangeID))) (fref option num-thrs)) + (if (!= (fref pTsk -> minID) (fref pTsk -> maxID)) + (begin + (if (>= (cast int (csym::log2 (cast double (- (fref pTsk -> maxID) (fref pTsk -> minID))))) (fref option num-thrs)) (begin (exploreCCIG 0 (fref pTsk -> numC) i (aref vItem i) pTsk)) (begin (inc (aref seqTaskRequest (fref -thr -> id))) - (exploreCCIG2 0 (fref pTsk -> numC) i (aref vItem i) pTsk)))) (break)) + (exploreCCIG2 0 (fref pTsk -> numC) i (aref vItem i) pTsk)))) + (begin + (inc (aref seqTaskRequest (fref -thr -> id))) + (exploreCCIG2 0 (fref pTsk -> numC) i (aref vItem i) pTsk))) (for ((= j 0) (< j (fref pTsk -> numC)) (inc j)) (= (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j)) 0)) @@ -1179,24 +1085,25 @@ (csym::gettimeofday tpc 0))) (= (fref this minVertex) i1) (= (fref this maxVertex) i2) - (csym::divideTaskID (fref pTsk -> minID) (fref pTsk -> maxID) (fref (fref this tsk) minID) (fref (fref this tsk) maxID)) - (initExploreCCIG 0 NULL NULL NULL (ptr (fref this tsk))) + (= (fref (fref this tsk) maxID) (fref pTsk -> maxID)) + (= (fref pTsk -> maxID) (+ (cast task-id (* (- (fref pTsk -> maxID) (fref pTsk -> minID)) 0.5)) (fref pTsk -> minID))) + (= (fref (fref this tsk) minID) (+ (fref pTsk -> maxID) 1)) + (initExploreCCIG NULL NULL NULL NULL (ptr (fref this tsk))) (%if* DEBUG-COPY (begin (csym::gettimeofday (+ tpc 1) 0)))) (:get (%if* DEBUG-COPY (begin (csym::gettimeofday (+ tpc 2) 0))) - (= (fref (fref (fref (fref pTsk -> subgraph) head) -> prev) -> next) (fref (fref (fref (fref this tsk) subgraph) head) -> next)) - (= (fref (fref (fref (fref (fref this tsk) subgraph) head) -> next) -> prev) (fref (fref (fref pTsk -> subgraph) head) -> prev)) - (= (fref (fref (fref (fref (fref this tsk) subgraph) head) -> prev) -> next) (fref (fref pTsk -> subgraph) head)) - (= (fref (fref (fref pTsk -> subgraph) head) -> prev) (fref (fref (fref (fref this tsk) subgraph) head) -> prev)) + (%if* DEBUG-RSLT (begin + (= (fref (fref (fref (fref pTsk -> subgraph) head) -> prev) -> next) (fref (fref (fref (fref this tsk) subgraph) head) -> next)) + (= (fref (fref (fref (fref (fref this tsk) subgraph) head) -> next) -> prev) (fref (fref (fref pTsk -> subgraph) head) -> prev)) + (= (fref (fref (fref (fref (fref this tsk) subgraph) head) -> prev) -> next) (fref (fref pTsk -> subgraph) head)) + (= (fref (fref (fref pTsk -> subgraph) head) -> prev) (fref (fref (fref (fref this tsk) subgraph) head) -> prev)))) (+= (fref pTsk -> treeDepth) (fref (fref this tsk) treeDepth)) (+= (fref pTsk -> numMutexTrylock) (fref (fref this tsk) numMutexTrylock)) (+= (fref pTsk -> numMutexLocked) (fref (fref this tsk) numMutexLocked)) (+= (fref pTsk -> numTraversed) (fref (fref this tsk) numTraversed)) (+= (fref pTsk -> numSubgraph) (fref (fref this tsk) numSubgraph)) - ;(+= (fref pTsk -> numThreshold) (fref (fref this tsk) numThreshold)) - ;(+= (fref pTsk -> numPruning) (fref (fref this tsk) numPruning)) (csym::free (fref (fref this tsk) vTraversed)) (csym::free (fref (fref this tsk) C)) (csym::free (fref (fref this tsk) T)) @@ -1207,29 +1114,23 @@ ;;; (def (task-body T-enumCCIG) (decl seq int) - (decl rangeFlag int) - (def rangeID task-id 0) (decl tp (array (struct timeval) 2)) (inc (aref taskRequest (fref -thr -> id))) - (= rangeFlag (csym::rangeTaskID (fref (fref this tsk) minID) (fref (fref this tsk) maxID) (ptr rangeID))) (csym::gettimeofday tp 0) - (switch rangeFlag - (case 1) (begin - (= seq 0) - (enumCCIG (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk)))) (break) - (case 0) (begin - (= seq 1) - (inc (aref seqTaskRequest (fref -thr -> id))) - (enumCCIG2 (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk)))) (break) - (case -1) (begin - (if (>= (cast int (csym::log2 (cast double rangeID))) (fref option num-thrs)) + (if (!= (fref (fref this tsk) minID) (fref (fref this tsk) maxID)) + (begin + (if (>= (cast int (csym::log2 (cast double (- (fref (fref this tsk) maxID) (fref (fref this tsk) minID))))) (fref option num-thrs)) (begin (= seq 0) (enumCCIG (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk)))) (begin (= seq 1) (inc (aref seqTaskRequest (fref -thr -> id))) - (enumCCIG2 (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk)))))) (break)) + (enumCCIG2 (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk)))))) + (begin + (= seq 1) + (inc (aref seqTaskRequest (fref -thr -> id))) + (enumCCIG2 (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk))))) (csym::gettimeofday (+ tp 1) 0) (+= (aref visit2Vertices (fref -thr -> id)) (fref (fref this tsk) numSearch)) (+= (aref thresholdPruning (fref -thr -> id)) (fref (fref this tsk) numThreshold)) @@ -1484,7 +1385,7 @@ ;;; Main (def (task-body T-startCCIG) - (defs int i j k l) ; temporary variable + (defs int i j k) ; temporary variable (decl tp (array (struct timeval) 2)) ; start time, end time (defs double t1 t2) ; start user time, end user time (decl loopRange int) ; loop range of enumCCIG @@ -1577,9 +1478,8 @@ (csym::sprintf copyFile "copy3-%02d_%d-half.csv" (fref option num-thrs) (fref this th)))))) ;; set ID - (for ((= i 0) (< i TID_NUM) (inc i)) - (= (aref (fref tsk minID) i) 0) - (= (aref (fref tsk maxID) i) -1)) + (= (fref tsk minID) 0) + (= (fref tsk maxID) -1) ;; init pthread ;(csym::pthread_attr_init (ptr attr)) @@ -1606,7 +1506,7 @@ ; (= (fref (aref data i) loopEnd) (* (/ (- maxVertex minVertex) (fref option num-thrs)) (+ i 1)))) ;; init T-exploreCCIG - (initExploreCCIG 0 NULL NULL NULL (ptr tsk)) + (initExploreCCIG NULL NULL NULL NULL (ptr tsk)) ;; init mutex (for ((= i 0) (< i V-SIZE) (inc i)) @@ -1646,15 +1546,13 @@ (for ((= k minVertex) (< k (+ maxVertex 1)) (inc k)) (= ITptr (fref (fref (aref vItemTable k) head) -> next)) (while (!= ITptr (fref (aref vItemTable k) head)) - (for ((= l 0) (< l TID_NUM) (inc l)) - (= (aref (fref ITptr -> minID) l) (cast task-id 0)) - (= (aref (fref ITptr -> maxID) l) (cast task-id 0))) + (= (fref ITptr -> minID) (cast task-id 0)) + (= (fref ITptr -> maxID) (cast task-id 0)) (= ITptr (fref ITptr -> next)))) ;; re-set ID - (for ((= l 0) (< l TID_NUM) (inc l)) - (= (aref (fref tsk minID) l) 0) - (= (aref (fref tsk maxID) l) -1))) + (= (fref tsk minID) 0) + (= (fref tsk maxID) -1)) (enumCCIG i (+ maxVertex 1) (ptr tsk)) ;(for ((= j 1) (< j (fref this loopRatio)) (inc j)) @@ -1704,6 +1602,7 @@ (%if* DEBUG-TASK (begin (csym::fprintf fpTask "%f, %f, %f, %llu, 0, %d~%" (csym::elapsedTime (ptr t0) tp) (csym::elapsedTime tp (+ tp 1)) (csym::elapsedTime (ptr t0) (+ tp 1)) (fref tsk numSearch) (fref -thr -> id)) (csym::fclose fpTask))) + (+= (aref visit2Vertices (fref -thr -> id)) (fref tsk numSearch)) (+= (aref thresholdPruning (fref -thr -> id)) (fref tsk numThreshold)) (+= (aref inclusivePruning (fref -thr -> id)) (fref tsk numPruning)) diff --git a/src/sample/tcell/copine4.tcell b/src/sample/tcell/copine4.tcell index 553cf386..51c83f70 100644 --- a/src/sample/tcell/copine4.tcell +++ b/src/sample/tcell/copine4.tcell @@ -70,9 +70,7 @@ ;;; Constants (%defconstant E-SIZE 500000) ; # of edges -(%defconstant V-SIZE 25000) ; # of vertices -(%defconstant TID_LEN 128) ; bit length of task id -(%defconstant TID_NUM 4) ; # of task id +(%defconstant V-SIZE 15500) ; # of vertices (%defconstant BIT-LEN 64) ; bit length of bitset (%defconstant BIT-ITEM 3) ; # of items = BIT-ITEM * BIT-LEN (%defconstant BIT-EDGE 8125) ; # of edges = BIT-EDGE * BIT-LEN @@ -96,8 +94,8 @@ ;;; Structure of ITnode (def (struct --ITnode) - (decl minID (array task-id TID_NUM)) ; task ID - (decl maxID (array task-id TID_NUM)) ; task ID + (decl minID task-id) ; task ID + (decl maxID task-id) ; task ID (decl item (array set BIT-ITEM)) ; itemset (decl worker int) ; worker ID (decl flagRedundant int) ; flag indicating redundant search @@ -166,7 +164,6 @@ ;; Exception Queue (def Qe (array (array vtx Q-SIZE) NUM-WORKERS)) (def numQe (array int NUM-WORKERS)) -(def flagQe (array int NUM-WORKERS)) ;;; Mutex (decl itMutex (array pthread_mutex_t V-SIZE)) @@ -224,20 +221,6 @@ (csym::fprintf fp "0")) (>>= mask 1))) -;;; Function: printTaskID -(def (csym::printTaskID x) (fn void (ptr task-id)) - (defs int i j) - (decl mask task-id) - (for ((= i 0) (< i TID_NUM) (inc i)) - (= mask (<< (cast task-id 1) (- TID-LEN 1))) - (for ((= j 0) (< j TID_LEN) (inc j)) - (if (cast task-id (bit-and (aref x i) mask)) - (csym::fprintf stderr "1") - (csym::fprintf stderr "0")) - (>>= mask 1)) - (csym::fprintf stderr " ")) - (csym::fprintf stderr "~%")) - ;;; Function: fprintDecimally - write a variable with set date type by decimal representation to stream (def (csym::fprintDecimally fp x k) (fn void (ptr FILE) (const set) int) (decl i int) @@ -249,75 +232,19 @@ ;;; Function: resetTaskID - (def (csym::resetTaskID param) (fn (ptr void) (ptr void)) - (defs int i j) + (decl i int) (def data (ptr threadInfo) (cast (ptr threadInfo) param)) (decl ITptr (ptr ITnode)) ; pointer to the ITnode (for ((= i (fref data -> loopStart)) (< i (fref data -> loopEnd)) (inc i)) (= ITptr (fref (fref (aref vItemTable i) head) -> next)) (while (!= ITptr (fref (aref vItemTable i) head)) - (for ((= j 0) (< j TID_NUM) (inc j)) - (= (aref (fref ITptr -> minID) j) (cast task-id 0)) - (= (aref (fref ITptr -> maxID) j) (cast task-id 0))) + (= (fref ITptr -> minID) (cast task-id 0)) + (= (fref ITptr -> maxID) (cast task-id 0)) (= ITptr (fref ITptr -> next)))) (csym::pthread_exit 0)) -;;; Function: compareTaskID - -(def (csym::compareTaskID id1 id2) (fn int (ptr task-id) (ptr task-id)) - (decl i int) - (for ((= i 0) (< i TID_NUM) (inc i)) - (if (> (aref id1 i) (aref id2 i)) - (begin - (return 1)) - (if (< (aref id1 i) (aref id2 i)) - (return -1)))) - (return 0)) - -;;; Function: divideTaskID - -(def (csym::divideTaskID victimMin victimMax thiefMin thiefMax) (fn void (ptr task-id) (ptr task-id) (ptr task-id) (ptr task-id)) - (defs int i flagU flagD Co) - (def maxValue task-id -1) - (def carryDown task-id (<< (cast task-id 1) (- TID_LEN 1))) - - (csym::memcpy thiefMax victimMax (* (sizeof task-id) TID_NUM)) - - (for ((= flagU 0) (= flagD 0) (= i (- TID_NUM 1)) (>= i 0) (dec i)) - (if (> (aref victimMin i) (- maxValue (aref victimMax i))) - (= flagU 1)) - (+= (aref victimMax i) (aref victimMin i)) - (if (and (== (aref victimMax i) maxValue) flagD) - (= flagU 1)) - (if flagD - (+= (aref victimMax i) (cast task-id 1))) - (= Co flagU) - (= flagD flagU) - (= flagU 0)) - (= flagU Co) - (= flagD 0) - (for ((= i 0) (< i TID_NUM) (inc i)) - (if (bit-and (aref victimMax i) (cast task-id 1)) - (= flagD 1)) - (>>= (aref victimMax i) 1) - (if flagU - (bit-or= (aref victimMax i) carryDown)) - (= flagU flagD) - (= flagD 0)) - - (csym::memcpy thiefMin victimMax (* (sizeof task-id) TID_NUM))) - -;;; Function: rangeTaskID - -(def (csym::rangeTaskID minID maxID rangeID) (fn int (ptr task-id) (ptr task-id) (ptr task-id)) - (decl i int) - (for ((= i 0) (< i (- TID_NUM 1)) (inc i)) - (if (!= (aref maxID i) (aref minID i)) - (return 1))) - (= (mref rangeID) (- (aref maxID (- TID_NUM 1)) (aref minID (- TID_NUM 1)))) - ;(csym::fprintf stderr "range: %u~%" (mref rangeID)) - (if (== (mref rangeID) 0) - (return 0)) - (return -1)) - ;;; Function: allocITnode - allocate a ITnode (def (csym::allocITnode) (fn (ptr ITnode)) (return (cast (ptr ITnode) (csym::malloc(sizeof ITnode))))) @@ -330,9 +257,8 @@ (def (csym::initITlist list) (fn void (ptr ITlist)) (decl i int) (def dummyNode (ptr ITnode) (csym::allocITnode)) - (for ((= i 0) (< i TID_NUM) (inc i)) - (= (aref (fref dummyNode -> minID) i) (cast task-id 0)) - (= (aref (fref dummyNode -> maxID) i) (cast task-id 0))) + (= (fref dummyNode -> minID) (cast task-id 0)) + (= (fref dummyNode -> maxID) (cast task-id 0)) (for ((= i 0) (< i BIT-ITEM) (inc i)) (= (aref (fref dummyNode -> item) i) (cast set 0))) (= (fref dummyNode -> worker) -1) @@ -343,14 +269,14 @@ (= (fref dummyNode -> prev) dummyNode)) ;;; Function: insertITnodeAfter - insert a new ITnode after the pointer 'p' -(def (csym::insertITnodeAfter list p minID maxID item worker) (fn void (ptr ITlist) (ptr ITnode) (ptr task-id) (ptr task-id) (array set) int) +(def (csym::insertITnodeAfter list p minID maxID item worker) (fn void (ptr ITlist) (ptr ITnode) task-id task-id (array set) int) (decl i int) (def new (ptr ITnode) (csym::allocITnode)) (def nxt (ptr ITnode) (fref p -> next)) (= (fref (fref p -> next) -> prev) new) (= (fref p -> next) new) - (csym::memcpy (fref new -> minID) minID (* (sizeof task-id) TID_NUM)) - (csym::memcpy (fref new -> maxID) maxID (* (sizeof task-id) TID_NUM)) + (= (fref new -> minID) minID) + (= (fref new -> maxID) maxID) (for ((= i 0) (< i BIT-ITEM) (inc i)) (= (aref (fref new -> item) i) (aref item i))) (= (fref new -> worker) worker) @@ -435,8 +361,8 @@ ;;; (def (task T-exploreCCIG) - (def minID (array task-id TID_NUM)) - (def maxID (array task-id TID_NUM)) + (def minID task-id) + (def maxID task-id) (def minC int) (def maxC int) (def v int) @@ -463,15 +389,11 @@ (def numEmutexLocked uint64_t)) ;;;Function: initExploreCCIG - -(def (initExploreCCIG traversed itemTable C T pTsk) (fn void int (ptr ITlist) (ptr vtx) (ptr vtx) (ptr (struct T-exploreCCIG))) +(def (initExploreCCIG traversed itemTable C T pTsk) (fn void (ptr int) (ptr ITlist) (ptr vtx) (ptr vtx) (ptr (struct T-exploreCCIG))) (decl i int) ;; initialize vTraversed - (if (== traversed 0) - (begin - (= (fref pTsk -> vTraversed) (cast (ptr int) (csym::calloc V-SIZE (sizeof int))))) - (begin - (= (fref pTsk -> vTraversed) (cast (ptr int) (csym::malloc (* V-SIZE (sizeof int))))))) + (= (fref pTsk -> vTraversed) (cast (ptr int) (csym::calloc V-SIZE (sizeof int)))) ;; initialize vItemTable ;(if (== itemTable NULL) @@ -557,8 +479,6 @@ (if (== (aref (fref pTsk -> vTraversed) vv) 1) (begin - ;(inc (fref pTsk -> numSearch)) - ;; evaluate common itemset (for ((= k 0) (= m 0) (= commonNum 0) (< k BIT-ITEM) (inc k)) (= (aref commonItem k) (cast set (bit-and (aref itemSet k) (aref vItem vv k)))) @@ -594,7 +514,7 @@ (= ITptr (fref (fref (aref vItemTable vv) head) -> next)) (while (!= ITptr (fref (aref vItemTable vv) head)) (inc (fref pTsk -> numTableReference)) - (if (<= (csym::compareTaskID (fref ITptr -> minID) (fref pTsk -> minID)) 0) + (if (<= (fref ITptr -> minID) (fref pTsk -> minID)) (begin (for ((= k 0) (= m 0) (< k BIT-ITEM) (inc k)) (if (== (cast set (bit-and (aref commonItem k) (aref (fref ITptr -> item) k))) (aref commonItem k)) @@ -630,7 +550,7 @@ (= ITptr (fref (fref (aref vItemTable vv) head) -> next)) (while (!= ITptr (fref (aref vItemTable vv) head)) (inc (fref pTsk -> numTableReference)) - (if (>= (csym::compareTaskID (fref ITptr -> minID) (fref pTsk -> minID)) 0) + (if (>= (fref ITptr -> minID) (fref pTsk -> minID)) (begin (for ((= k 0) (= m 0) (< k BIT-ITEM) (inc k)) (if (== (cast set (bit-and (aref (fref ITptr -> item) k) (aref commonItem k))) (aref (fref ITptr -> item) k)) @@ -752,38 +672,12 @@ (decl pruning int) ; flag to prune (def excpValue int -1) ; exception value (def excpIndex int -1) ; - (decl rangeFlag int) ; - (def rangeID task-id 0) ; (decl ITptr (ptr ITnode)) ; pointer to the ITnode (decl ITadd (ptr ITnode)) ; (decl locked int) ; (decl tp (array (struct timeval) 2)) ; (decl tpc (array (struct timeval) 4)) ; - ;(inc (fref pTsk -> numEmutexTrylock)) - ;(if (!= (csym::pthread_mutex_trylock (ptr (aref excpMutex (fref -thr -> id)))) 0) - ; (begin - ; (inc (fref pTsk -> numEmutexLocked)) - ; (csym::pthread_mutex_lock (ptr (aref excpMutex (fref -thr -> id)))))) - ;(if (aref numQe (fref -thr -> id)) - ; (begin - ; (= excpIndex INT_MAX) - ; (for ((= j 0) (< j (aref numQe (fref -thr -> id))) (inc j)) - ; (for ((= k 0) (< k (fref pTsk -> numT)) (inc k)) - ; (if (== (aref Qe (fref -thr -> id) j) (aref (fref pTsk -> T) k)) - ; (begin - ; (if (< k excpIndex) - ; (begin - ; (= excpValue (cast int (aref (fref pTsk -> T) k))) - ; (= excpIndex k))) - ; (break))))))) - ;(csym::pthread_mutex_unlock (ptr (aref excpMutex (fref -thr -> id)))) - ;(if (!= excpValue -1) - ; (begin - ; (inc (aref numThrow (fref -thr -> id))) - ; (= (aref flagQe (fref -thr -> id)) 1) - ; (throw excpValue))) - (if (aref numQe (fref -thr -> id)) (begin (inc (fref pTsk -> numEmutexTrylock)) @@ -806,7 +700,7 @@ (if (!= excpValue -1) (begin (inc (aref numThrow (fref -thr -> id))) - (= (aref flagQe (fref -thr -> id)) 1) + (= (aref numQe (fref -thr -> id)) 0) (throw excpValue))))) ;; DFS @@ -814,35 +708,8 @@ (= vv (aref (fref pTsk -> C) (- (- (fref pTsk -> numC) i) 1))) (inc (aref (fref pTsk -> vTraversed) vv)) - ;(if (aref numQe (fref -thr -> id)) - ; (begin - ; (inc (fref pTsk -> numEmutexTrylock)) - ; (if (!= (csym::pthread_mutex_trylock (ptr (aref excpMutex (fref -thr -> id)))) 0) - ; (begin - ; (inc (fref pTsk -> numEmutexLocked)) - ; (csym::pthread_mutex_lock (ptr (aref excpMutex (fref -thr -> id)))))) - ; (= excpValue -1) - ; (= excpIndex INT_MAX) - ; (for ((= j 0) (< j (aref numQe (fref -thr -> id))) (inc j)) - ; (for ((= k 0) (< k (fref pTsk -> numT)) (inc k)) - ; (if (== (aref Qe (fref -thr -> id) j) (aref (fref pTsk -> T) k)) - ; (begin - ; (if (< k excpIndex) - ; (begin - ; (= excpValue (cast int (aref (fref pTsk -> T) k))) - ; (= excpIndex k))) - ; (break))))) - ; (csym::pthread_mutex_unlock (ptr (aref excpMutex (fref -thr -> id)))) - ; (if (!= excpValue -1) - ; (begin - ; (inc (aref numThrow (fref -thr -> id))) - ; (= (aref flagQe (fref -thr -> id)) 1) - ; (throw excpValue))))) - (if (== (aref (fref pTsk -> vTraversed) vv) 1) (begin - ;(inc (fref pTsk -> numSearch)) - ;; evaluate common itemset (for ((= k 0) (= m 0) (= commonNum 0) (< k BIT-ITEM) (inc k)) (= (aref commonItem k) (cast set (bit-and (aref itemSet k) (aref vItem vv k)))) @@ -878,7 +745,7 @@ (= ITptr (fref (fref (aref vItemTable vv) head) -> next)) (while (!= ITptr (fref (aref vItemTable vv) head)) (inc (fref pTsk -> numTableReference)) - (if (<= (csym::compareTaskID (fref ITptr -> minID) (fref pTsk -> minID)) 0) + (if (<= (fref ITptr -> minID) (fref pTsk -> minID)) (begin (for ((= k 0) (= m 0) (< k BIT-ITEM) (inc k)) (if (== (cast set (bit-and (aref commonItem k) (aref (fref ITptr -> item) k))) (aref commonItem k)) @@ -914,7 +781,7 @@ (= ITptr (fref (fref (aref vItemTable vv) head) -> next)) (while (!= ITptr (fref (aref vItemTable vv) head)) (inc (fref pTsk -> numTableReference)) - (if (>= (csym::compareTaskID (fref ITptr -> minID) (fref pTsk -> minID)) 0) + (if (>= (fref ITptr -> minID) (fref pTsk -> minID)) (begin (for ((= k 0) (= m 0) (< k BIT-ITEM) (inc k)) (if (== (cast set (bit-and (aref (fref ITptr -> item) k) (aref commonItem k))) (aref (fref ITptr -> item) k)) @@ -979,21 +846,9 @@ (csym::fprintf stderr "> %d~%" (aref (fref pTsk -> T) (- (fref pTsk -> numT) 1)))))) ;; recursive call - (= rangeFlag (csym::rangeTaskID (fref pTsk -> minID) (fref pTsk -> maxID) (ptr rangeID))) - (switch rangeFlag - (case 1) (begin - (catch vv - (exploreCCIG 0 (fref pTsk -> numC) vv commonItem pTsk) - (for ((= j 0) (< j (fref pTsk -> numC)) (inc j)) - (dec (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j)))))) (break) - (case 0) (begin - (inc (aref seqTaskRequest (fref -thr -> id))) - (exploreCCIG2 0 (fref pTsk -> numC) vv commonItem pTsk) - (for ((= j 0) (< j (fref pTsk -> numC)) (inc j)) - (dec (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j))))) (break) - (case -1) (begin - ;(csym::fprintf stderr "rangeID = %u~%" (csym::log2 (cast double rangeID))) - (if (>= (cast int (csym::log2 (cast double rangeID))) (fref option num-thrs)) + (if (!= (fref pTsk -> minID) (fref pTsk -> maxID)) + (begin + (if (>= (cast int (csym::log2 (cast double (- (fref pTsk -> maxID) (fref pTsk -> minID))))) (fref option num-thrs)) (begin (catch vv (exploreCCIG 0 (fref pTsk -> numC) vv commonItem pTsk) @@ -1003,18 +858,12 @@ (inc (aref seqTaskRequest (fref -thr -> id))) (exploreCCIG2 0 (fref pTsk -> numC) vv commonItem pTsk) (for ((= j 0) (< j (fref pTsk -> numC)) (inc j)) - (dec (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j))))))) (break)) - - (if (== (aref flagQe (fref -thr -> id)) 1) + (dec (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j))))))) (begin - (inc (fref pTsk -> numEmutexTrylock)) - (if (!= (csym::pthread_mutex_trylock (ptr (aref excpMutex (fref -thr -> id)))) 0) - (begin - (inc (fref pTsk -> numEmutexLocked)) - (csym::pthread_mutex_lock (ptr (aref excpMutex (fref -thr -> id)))))) - (= (aref numQe (fref -thr -> id)) 0) - (csym::pthread_mutex_unlock (ptr (aref excpMutex (fref -thr -> id)))) - (= (aref flagQe (fref -thr -> id)) 0)))) + (inc (aref seqTaskRequest (fref -thr -> id))) + (exploreCCIG2 0 (fref pTsk -> numC) vv commonItem pTsk) + (for ((= j 0) (< j (fref pTsk -> numC)) (inc j)) + (dec (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j))))))) (:after (if (or (== EXITING EXITING-CANCEL) (== EXITING EXITING-EXCEPTION)) @@ -1065,6 +914,26 @@ (for ((= j 0) (<= j i) (inc j)) (dec (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) (- (- numC j) 1))))))) + (if (or (== EXITING EXITING-NORMAL) + (== EXITING EXITING-CANCEL) + (== EXITING EXITING-EXCEPTION)) + (begin + (if (aref numQe (fref -thr -> id)) + (begin + (inc (fref pTsk -> numEmutexTrylock)) + (if (!= (csym::pthread_mutex_trylock (ptr (aref excpMutex (fref -thr -> id)))) 0) + (begin + (inc (fref pTsk -> numEmutexLocked)) + (csym::pthread_mutex_lock (ptr (aref excpMutex (fref -thr -> id)))))) + (for ((= j 0) (< j (aref numQe (fref -thr -> id))) (inc j)) + (if (== (aref Qe (fref -thr -> id) j) v) + (begin + (if (!= j (- (aref numQe (fref -thr -> id)) 1)) + (begin + (csym::memmove (+ (aref Qe (fref -thr -> id)) j) (+ (aref Qe (fref -thr -> id)) (+ j 1)) (* (sizeof vtx) (- (aref numQe (fref -thr -> id)) (+ j 1)))))) + (dec (aref numQe (fref -thr -> id)))))) + (csym::pthread_mutex_unlock (ptr (aref excpMutex (fref -thr -> id)))))))) + (-= (fref pTsk -> numC) cc) (dec (fref pTsk -> numT))))) (begin @@ -1094,8 +963,10 @@ (csym::gettimeofday tpc 0))) (= (fref this minC) i1) (= (fref this maxC) i2) - (csym::divideTaskID (fref pTsk -> minID) (fref pTsk -> maxID) (fref this minID) (fref this maxID)) - (initExploreCCIG 1 NULL NULL NULL (ptr this)) + (= (fref this maxID) (fref pTsk -> maxID)) + (= (fref pTsk -> maxID) (+ (cast task-id (* (- (fref pTsk -> maxID) (fref pTsk -> minID)) 0.5)) (fref pTsk -> minID))) + (= (fref this minID) (+ (fref pTsk -> maxID) 1)) + (initExploreCCIG NULL NULL NULL NULL (ptr this)) (= (fref this v) v) (csym::memcpy (fref this itemSet) itemSet (* (sizeof set) BIT-ITEM)) (csym::memcpy (fref this vTraversed) (fref pTsk -> vTraversed) (* (sizeof int) V-SIZE)) @@ -1110,10 +981,11 @@ (:get (%if* DEBUG-COPY (begin (csym::gettimeofday (+ tpc 2) 0))) - (= (fref (fref (fref (fref pTsk -> subgraph) head) -> prev) -> next) (fref (fref (fref this subgraph) head) -> next)) - (= (fref (fref (fref (fref this subgraph) head) -> next) -> prev) (fref (fref (fref pTsk -> subgraph) head) -> prev)) - (= (fref (fref (fref (fref this subgraph) head) -> prev) -> next) (fref (fref pTsk -> subgraph) head)) - (= (fref (fref (fref pTsk -> subgraph) head) -> prev) (fref (fref (fref this subgraph) head) -> prev)) + (%if* DEBUG-RSLT (begin + (= (fref (fref (fref (fref pTsk -> subgraph) head) -> prev) -> next) (fref (fref (fref this subgraph) head) -> next)) + (= (fref (fref (fref (fref this subgraph) head) -> next) -> prev) (fref (fref (fref pTsk -> subgraph) head) -> prev)) + (= (fref (fref (fref (fref this subgraph) head) -> prev) -> next) (fref (fref pTsk -> subgraph) head)) + (= (fref (fref (fref pTsk -> subgraph) head) -> prev) (fref (fref (fref this subgraph) head) -> prev)))) (+= (fref pTsk -> treeDepth) (fref this treeDepth)) (+= (fref pTsk -> numITmutexTrylock) (fref this numITmutexTrylock)) (+= (fref pTsk -> numITmutexLocked) (fref this numITmutexLocked)) @@ -1121,8 +993,6 @@ (+= (fref pTsk -> numEmutexLocked) (fref this numEmutexLocked)) (+= (fref pTsk -> numTraversed) (fref this numTraversed)) (+= (fref pTsk -> numSubgraph) (fref this numSubgraph)) - ;(+= (fref pTsk -> numThreshold) (fref this numThreshold)) - ;(+= (fref pTsk -> numPruning) (fref this numPruning)) (%if* DEBUG-COPY (begin (csym::gettimeofday (+ tpc 3) 0) (csym::fprintf fpCopy "%f, 1~%" (+ (csym::elapsedTime tpc (+ tpc 1)) (csym::elapsedTime (+ tpc 2) (+ tpc 3))))))))) @@ -1138,24 +1008,14 @@ (def (task-body T-exploreCCIG) (decl i int) (decl seq int) - (decl rangeFlag int) - (def rangeID task-id 0) (decl tp (array (struct timeval) 2)) (inc (aref taskRequest (fref -thr -> id))) - (= rangeFlag (csym::rangeTaskID (fref this minID) (fref this maxID) (ptr rangeID))) + (if (> (fref this minID) (fref this maxID)) + (csym::fprintf stderr "minID = %llu, maxID = %llu~%" (fref this minID) (fref this maxID))) (csym::gettimeofday tp 0) - (switch rangeFlag - (case 1) (begin - (= seq 0) - (catch (fref this v) - (exploreCCIG (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this)))) (break) - (case 0) (begin - (= seq 1) - (inc (aref seqTaskRequest (fref -thr -> id))) - (exploreCCIG2 (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this))) (break) - (case -1) (begin - ;(csym::fprintf stderr "rangeID = %u~%" (csym::log2 (cast double rangeID))) - (if (>= (cast int (csym::log2 (cast double rangeID))) (fref option num-thrs)) + (if (!= (fref this minID) (fref this maxID)) + (begin + (if (>= (cast int (csym::log2 (cast double (- (fref this maxID) (fref this minID))))) (fref option num-thrs)) (begin (= seq 0) (catch (fref this v) @@ -1163,18 +1023,12 @@ (begin (= seq 1) (inc (aref seqTaskRequest (fref -thr -> id))) - (exploreCCIG2 (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this))))) (break)) - (csym::gettimeofday (+ tp 1) 0) - (if (== (aref flagQe (fref -thr -> id)) 1) + (exploreCCIG2 (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this))))) (begin - (inc (fref this numEmutexTrylock)) - (if (!= (csym::pthread_mutex_trylock (ptr (aref excpMutex (fref -thr -> id)))) 0) - (begin - (inc (fref this numEmutexLocked)) - (csym::pthread_mutex_lock (ptr (aref excpMutex (fref -thr -> id)))))) - (= (aref numQe (fref -thr -> id)) 0) - (csym::pthread_mutex_unlock (ptr (aref excpMutex (fref -thr -> id)))) - (= (aref flagQe (fref -thr -> id)) 0))) + (= seq 1) + (inc (aref seqTaskRequest (fref -thr -> id))) + (exploreCCIG2 (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this)))) + (csym::gettimeofday (+ tp 1) 0) (+= (aref visit2Vertices (fref -thr -> id)) (fref this numSearch)) (+= (aref thresholdPruning (fref -thr -> id)) (fref this numThreshold)) (+= (aref inclusivePruning (fref -thr -> id)) (fref this numPruning)) @@ -1229,7 +1083,7 @@ (csym::fprintf fpLock "%f, %d~%" (csym::elapsedTime tp (+ tp 1)) locked))))) (= ITptr (fref (fref (aref vItemTable i) head) -> next)) (inc (fref pTsk -> numTableReference)) - (if (<= (csym::compareTaskID (fref ITptr -> minID) (fref pTsk -> minID)) 0) + (if (<= (fref ITptr -> minID) (fref pTsk -> minID)) (begin (for ((= k 0) (< k BIT-ITEM) (inc k)) (if (!= (cast set (bit-and (aref vItem i k) (aref (fref ITptr -> item) k))) (aref vItem i k)) @@ -1264,7 +1118,7 @@ (= ITptr (fref (fref (aref vItemTable i) head) -> next)) (while (!= ITptr (fref (aref vItemTable i) head)) (inc (fref pTsk -> numTableReference)) - (if (>= (csym::compareTaskID (fref ITptr -> minID) (fref pTsk -> minID)) 0) + (if (>= (fref ITptr -> minID) (fref pTsk -> minID)) (begin (for ((= k 0) (= m 0) (< k BIT-ITEM) (inc k)) (if (== (cast set (bit-and (aref (fref ITptr -> item) k) (aref vItem i k))) (aref (fref ITptr -> item) k)) @@ -1350,9 +1204,7 @@ (defs int i j k m) ; temporary variable (decl visiting int) ; flag to search (decl ITptr (ptr ITnode)) ; - (decl ITadd (ptr ITnode)) ; - (decl rangeFlag int) ; - (def rangeID task-id 0) ; + (decl ITadd (ptr ITnode)) ; (decl locked int) (decl tp (array (struct timeval) 2)) (decl tpc (array (struct timeval) 4)) @@ -1386,7 +1238,7 @@ (csym::fprintf fpLock "%f, %d~%" (csym::elapsedTime tp (+ tp 1)) locked))))) (= ITptr (fref (fref (aref vItemTable i) head) -> next)) (inc (fref pTsk -> numTableReference)) - (if (<= (csym::compareTaskID (fref ITptr -> minID) (fref pTsk -> minID)) 0) + (if (<= (fref ITptr -> minID) (fref pTsk -> minID)) (begin (for ((= k 0) (< k BIT-ITEM) (inc k)) (if (!= (cast set (bit-and (aref vItem i k) (aref (fref ITptr -> item) k))) (aref vItem i k)) @@ -1421,7 +1273,7 @@ (= ITptr (fref (fref (aref vItemTable i) head) -> next)) (while (!= ITptr (fref (aref vItemTable i) head)) (inc (fref pTsk -> numTableReference)) - (if (>= (csym::compareTaskID (fref ITptr -> minID) (fref pTsk -> minID)) 0) + (if (>= (fref ITptr -> minID) (fref pTsk -> minID)) (begin (for ((= k 0) (= m 0) (< k BIT-ITEM) (inc k)) (if (== (cast set (bit-and (aref (fref ITptr -> item) k) (aref vItem i k))) (aref (fref ITptr -> item) k)) @@ -1461,21 +1313,9 @@ (inc (fref pTsk -> treeDepth)) (inc (fref pTsk -> numTraversed)) - (= rangeFlag (csym::rangeTaskID (fref pTsk -> minID) (fref pTsk -> maxID) (ptr rangeID))) - (switch rangeFlag - (case 1) (begin - (catch i - (exploreCCIG 0 (fref pTsk -> numC) i (aref vItem i) pTsk) - (for ((= j 0) (< j (fref pTsk -> numC)) (inc j)) - (= (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j)) 0)))) (break) - (case 0) (begin - (inc (aref seqTaskRequest (fref -thr -> id))) - (exploreCCIG2 0 (fref pTsk -> numC) i (aref vItem i) pTsk) - (for ((= j 0) (< j (fref pTsk -> numC)) (inc j)) - (= (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j)) 0))) (break) - (case -1) (begin - ;(csym::fprintf stderr "rangeID = %u~%" (csym::log2 (cast double rangeID))) - (if (>= (cast int (csym::log2 (cast double rangeID))) (fref option num-thrs)) + (if (!= (fref pTsk -> minID) (fref pTsk -> maxID)) + (begin + (if (>= (cast int (csym::log2 (cast double (- (fref pTsk -> maxID) (fref pTsk -> minID))))) (fref option num-thrs)) (begin (catch i (exploreCCIG 0 (fref pTsk -> numC) i (aref vItem i) pTsk) @@ -1485,18 +1325,12 @@ (inc (aref seqTaskRequest (fref -thr -> id))) (exploreCCIG2 0 (fref pTsk -> numC) i (aref vItem i) pTsk) (for ((= j 0) (< j (fref pTsk -> numC)) (inc j)) - (= (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j)) 0))))) (break)) - - (if (== (aref flagQe (fref -thr -> id)) 1) + (= (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j)) 0))))) (begin - (inc (fref pTsk -> numEmutexTrylock)) - (if (!= (csym::pthread_mutex_trylock (ptr (aref excpMutex (fref -thr -> id)))) 0) - (begin - (inc (fref pTsk -> numEmutexLocked)) - (csym::pthread_mutex_lock (ptr (aref excpMutex (fref -thr -> id)))))) - (= (aref numQe (fref -thr -> id)) 0) - (csym::pthread_mutex_unlock (ptr (aref excpMutex (fref -thr -> id)))) - (= (aref flagQe (fref -thr -> id)) 0))) + (inc (aref seqTaskRequest (fref -thr -> id))) + (exploreCCIG2 0 (fref pTsk -> numC) i (aref vItem i) pTsk) + (for ((= j 0) (< j (fref pTsk -> numC)) (inc j)) + (= (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j)) 0)))) (%if* DEBUG-LOCK (begin (= locked 0))) @@ -1545,17 +1379,20 @@ (csym::gettimeofday tpc 0))) (= (fref this minVertex) i1) (= (fref this maxVertex) i2) - (csym::divideTaskID (fref pTsk -> minID) (fref pTsk -> maxID) (fref (fref this tsk) minID) (fref (fref this tsk) maxID)) - (initExploreCCIG 0 NULL NULL NULL (ptr (fref this tsk))) + (= (fref (fref this tsk) maxID) (fref pTsk -> maxID)) + (= (fref pTsk -> maxID) (+ (cast task-id (* (- (fref pTsk -> maxID) (fref pTsk -> minID)) 0.5)) (fref pTsk -> minID))) + (= (fref (fref this tsk) minID) (+ (fref pTsk -> maxID) 1)) + (initExploreCCIG NULL NULL NULL NULL (ptr (fref this tsk))) (%if* DEBUG-COPY (begin (csym::gettimeofday (+ tpc 1) 0)))) (:get (%if* DEBUG-COPY (begin (csym::gettimeofday (+ tpc 2) 0))) - (= (fref (fref (fref (fref pTsk -> subgraph) head) -> prev) -> next) (fref (fref (fref (fref this tsk) subgraph) head) -> next)) - (= (fref (fref (fref (fref (fref this tsk) subgraph) head) -> next) -> prev) (fref (fref (fref pTsk -> subgraph) head) -> prev)) - (= (fref (fref (fref (fref (fref this tsk) subgraph) head) -> prev) -> next) (fref (fref pTsk -> subgraph) head)) - (= (fref (fref (fref pTsk -> subgraph) head) -> prev) (fref (fref (fref (fref this tsk) subgraph) head) -> prev)) + (%if* DEBUG-RSLT (begin + (= (fref (fref (fref (fref pTsk -> subgraph) head) -> prev) -> next) (fref (fref (fref (fref this tsk) subgraph) head) -> next)) + (= (fref (fref (fref (fref (fref this tsk) subgraph) head) -> next) -> prev) (fref (fref (fref pTsk -> subgraph) head) -> prev)) + (= (fref (fref (fref (fref (fref this tsk) subgraph) head) -> prev) -> next) (fref (fref pTsk -> subgraph) head)) + (= (fref (fref (fref pTsk -> subgraph) head) -> prev) (fref (fref (fref (fref this tsk) subgraph) head) -> prev)))) (+= (fref pTsk -> treeDepth) (fref (fref this tsk) treeDepth)) (+= (fref pTsk -> numITmutexTrylock) (fref (fref this tsk) numITmutexTrylock)) (+= (fref pTsk -> numITmutexLocked) (fref (fref this tsk) numITmutexLocked)) @@ -1563,8 +1400,6 @@ (+= (fref pTsk -> numEmutexLocked) (fref (fref this tsk) numEmutexLocked)) (+= (fref pTsk -> numTraversed) (fref (fref this tsk) numTraversed)) (+= (fref pTsk -> numSubgraph) (fref (fref this tsk) numSubgraph)) - ;(+= (fref pTsk -> numThreshold) (fref (fref this tsk) numThreshold)) - ;(+= (fref pTsk -> numPruning) (fref (fref this tsk) numPruning)) (csym::free (fref (fref this tsk) vTraversed)) (csym::free (fref (fref this tsk) C)) (csym::free (fref (fref this tsk) T)) @@ -1575,30 +1410,23 @@ ;;; (def (task-body T-enumCCIG) (decl seq int) - (decl rangeFlag int) - (def rangeID task-id 0) (decl tp (array (struct timeval) 2)) (inc (aref taskRequest (fref -thr -> id))) - (= rangeFlag (csym::rangeTaskID (fref (fref this tsk) minID) (fref (fref this tsk) maxID) (ptr rangeID))) (csym::gettimeofday tp 0) - (switch rangeFlag - (case 1) (begin - (= seq 0) - (enumCCIG (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk)))) (break) - (case 0) (begin - (= seq 1) - (inc (aref seqTaskRequest (fref -thr -> id))) - (enumCCIG2 (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk)))) (break) - (case -1) (begin - ;(csym::fprintf stderr "rangeID = %u~%" (csym::log2 (cast double rangeID))) - (if (>= (cast int (csym::log2 (cast double rangeID))) (fref option num-thrs)) + (if (!= (fref (fref this tsk) minID) (fref (fref this tsk) maxID)) + (begin + (if (>= (cast int (csym::log2 (cast double (- (fref (fref this tsk) maxID) (fref (fref this tsk) minID))))) (fref option num-thrs)) (begin (= seq 0) (enumCCIG (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk)))) (begin (= seq 1) (inc (aref seqTaskRequest (fref -thr -> id))) - (enumCCIG2 (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk)))))) (break)) + (enumCCIG2 (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk)))))) + (begin + (= seq 1) + (inc (aref seqTaskRequest (fref -thr -> id))) + (enumCCIG2 (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk))))) (csym::gettimeofday (+ tp 1) 0) (+= (aref visit2Vertices (fref -thr -> id)) (fref (fref this tsk) numSearch)) (+= (aref thresholdPruning (fref -thr -> id)) (fref (fref this tsk) numThreshold)) @@ -1830,8 +1658,7 @@ (for ((= i 0) (< i NUM-WORKERS) (inc i)) (for ((= j 0) (< j Q-SIZE) (inc j)) (= (aref Qe i j) 0)) - (= (aref numQe i) 0) - (= (aref flagQe i) 0)) + (= (aref numQe i) 0)) ;; initialize Debug Data (for ((= i 0) (< i NUM-WORKERS) (inc i)) @@ -1861,7 +1688,7 @@ ;;; Main (def (task-body T-startCCIG) - (defs int i j k l) ; temporary variable + (defs int i j k) ; temporary variable (decl tp (array (struct timeval) 2)) ; start time, end time (defs double t1 t2) ; start user time, end user time (decl loopRange int) ; loop range of enumCCIG @@ -1960,9 +1787,8 @@ (csym::sprintf copyFile "copy4-%02d_%d-half.csv" (fref option num-thrs) (fref this th)))))) ;; set ID - (for ((= i 0) (< i TID_NUM) (inc i)) - (= (aref (fref tsk minID) i) 0) - (= (aref (fref tsk maxID) i) -1)) + (= (fref tsk minID) 0) + (= (fref tsk maxID) -1) ;; init pthread ;(csym::pthread_attr_init (ptr attr)) @@ -1989,7 +1815,7 @@ ; (= (fref (aref data i) loopEnd) (* (/ (- maxVertex minVertex) (fref option num-thrs)) (+ i 1)))) ;; init T-exploreCCIG - (initExploreCCIG 0 NULL NULL NULL (ptr tsk)) + (initExploreCCIG NULL NULL NULL NULL (ptr tsk)) ;; init mutex (for ((= i 0) (< i V-SIZE) (inc i)) @@ -2031,15 +1857,13 @@ (for ((= k minVertex) (< k (+ maxVertex 1)) (inc k)) (= ITptr (fref (fref (aref vItemTable k) head) -> next)) (while (!= ITptr (fref (aref vItemTable k) head)) - (for ((= l 0) (< l TID_NUM) (inc l)) - (= (aref (fref ITptr -> minID) l) (cast task-id 0)) - (= (aref (fref ITptr -> maxID) l) (cast task-id 0))) + (= (fref ITptr -> minID) (cast task-id 0)) + (= (fref ITptr -> maxID) (cast task-id 0)) (= ITptr (fref ITptr -> next)))) ;; re-set ID - (for ((= l 0) (< l TID_NUM) (inc l)) - (= (aref (fref tsk minID) l) 0) - (= (aref (fref tsk maxID) l) -1))) + (= (fref tsk minID) 0) + (= (fref tsk maxID) -1)) (enumCCIG i (+ maxVertex 1) (ptr tsk)) ;(for ((= j 1) (< j (fref this loopRatio)) (inc j)) @@ -2091,6 +1915,7 @@ (%if* DEBUG-TASK (begin (csym::fprintf fpTask "%f, %f, %f, %llu, 0, %d~%" (csym::elapsedTime (ptr t0) tp) (csym::elapsedTime tp (+ tp 1)) (csym::elapsedTime (ptr t0) (+ tp 1)) (fref tsk numSearch) (fref -thr -> id)) (csym::fclose fpTask))) + (+= (aref visit2Vertices (fref -thr -> id)) (fref tsk numSearch)) (+= (aref thresholdPruning (fref -thr -> id)) (fref tsk numThreshold)) (+= (aref inclusivePruning (fref -thr -> id)) (fref tsk numPruning)) From b4ca097e599b592dc78cca6ba0548d9a28742caf Mon Sep 17 00:00:00 2001 From: Shingo OKUNO Date: Fri, 27 Mar 2015 22:08:40 +0900 Subject: [PATCH 037/105] COPINE: added copine3d.tcell. (This program is a prototype of copine3.tcell for distributed memory environments.) --- src/sample/tcell/Makefile | 4 +- src/sample/tcell/README4COPINE | 26 +- src/sample/tcell/copine0.tcell | 6 +- src/sample/tcell/copine1.tcell | 9 +- src/sample/tcell/copine3d.tcell | 1894 +++++++++++++++++++++++++++++++ src/sample/tcell/sendrecv.c | 15 + src/sample/tcell/sendrecv.h | 6 + src/sample/tcell/worker.sc | 15 +- 8 files changed, 1952 insertions(+), 23 deletions(-) create mode 100644 src/sample/tcell/copine3d.tcell diff --git a/src/sample/tcell/Makefile b/src/sample/tcell/Makefile index 78e87c9a..e98ff53d 100644 --- a/src/sample/tcell/Makefile +++ b/src/sample/tcell/Makefile @@ -13,7 +13,7 @@ GCC=gcc #$(XCC) # Command for Intel C Compiler ICC=icc # Optimization options for C Compilers -OPT=-O3 -g -msse4.2 $(MOPT) +OPT=-O3 -g -msse4.2$(MOPT) # Keyword for L-Closures and Closures in XC Cube. Don't modify. XCCOPT=-DCT=lightweight @@ -47,7 +47,7 @@ endif # icc-c, icc-lw, and icc-clos} # By default, this Makefile makes all ALL_PROGS. You can make just one of targets by specifying the target file name, # (e.g., "make fib-gcc") -APPS=fib fib-guard fib-excep lu cmp pen pen-excep pen6x17 pen6x17-guard nq grav matmul spanning bcast copine0 copine1 copine2 copine3 copine4 +APPS=fib fib-guard fib-excep lu cmp pen pen-excep pen6x17 pen6x17-guard nq grav matmul spanning bcast copine0 copine1 copine2 copine3 copine4 copine0d copine1d copine3d C_PROGS=$(addsuffix -c,$(APPS)) GCC_PROGS=$(addsuffix -gcc,$(APPS)) diff --git a/src/sample/tcell/README4COPINE b/src/sample/tcell/README4COPINE index 652f7e2b..492e3c7a 100644 --- a/src/sample/tcell/README4COPINE +++ b/src/sample/tcell/README4COPINE @@ -11,17 +11,17 @@ extracts all connected subgraphs, each of which shares a common itemset whose size is not less than a given threshold, from a given graph in which each vertex is associated to an itemset. For this problem, an efficient sequential backtrack search algorithm called COmmon Pattern Itemset NEtwork mining -(COPINE) [Seki et al., BIBE'08] has been already proposed. COPINE reduces the -search space of a dynamically growing tree structure by pruning its branches -corresponding to the following subgraphs; already visited, having itemsets -smaller than a given threshold, and having already-visited supergraphs with -identical itemsets. For the third pruning, we use a table associating already- -visited subgraphs and their itemsets. To avoid excess pruning in a parallel -search where a unique set of subtrees (tasks) is assigned to each worker, we -should put a certain restriction on a worker when it is referring to a table -entry registered by another worker. I designed a parallel algorithm as an -extension of COPINE by introducing this restriction, and implemented it using -the task-parallel language Tascell [Hiraishi et al., PPoPP'09]. +(COPINE) [J. Sese et al., CIKM'10] has been already proposed. COPINE reduces +the search space of a dynamically growing tree structure by pruning its +branches corresponding to the following subgraphs; already visited, having +itemsets smaller than a given threshold, and having already-visited supergraphs +with identical itemsets. For the third pruning, we use a table associating +already-visited subgraphs and their itemsets. To avoid excess pruning in a +parallel search where a unique set of subtrees (tasks) is assigned to each +worker, we should put a certain restriction on a worker when it is referring +to a table entry registered by another worker. I designed a parallel algorithm +as an extension of COPINE by introducing this restriction, and implemented it +using the task-parallel language Tascell [T. Hiraishi et al., PPoPP'09]. 2. Files ------------------------- @@ -65,9 +65,9 @@ information about runtime arguments, see each source code. 4. Publication ------------------------- -[1] S. Okuno, T. Hiraishi, H. Nakashima, M. Yasugi and J. Sese: Parallelization +[1] S. Okuno, T. Hiraishi, H. Nakashima, M. Yasugi and J. Sese: Parallelization of Extracting Connected Subgraphs with Common Itemsets, IPSJ Transactions on -Programming, Vol. 7, No. 3, pp. 22-39, 2014. (IPSJ Online Transactions, Vol. 7, +Programming, Vol. 7, No. 3, pp. 22-39, 2014. (IPSJ Online Transactions, Vol. 7, pp. 93-110.). 5. Contact information diff --git a/src/sample/tcell/copine0.tcell b/src/sample/tcell/copine0.tcell index 0b0e63f9..ab5dd22a 100644 --- a/src/sample/tcell/copine0.tcell +++ b/src/sample/tcell/copine0.tcell @@ -387,8 +387,9 @@ (for ((= k 0) (= m 0) (= commonNum 0) (< k BIT-ITEM) (inc k)) (= (aref commonItem k) (cast set (bit-and (aref itemSet k) (aref vItem vv k)))) ;(+= commonNum (csym::countBits32 (aref commonItem k))) - (+= commonNum (csym::countBits64 (aref commonItem k))) - ;(+= commonNum (csym::_mm_popcnt_u64 (aref commonItem k))) + ;(+= commonNum (csym::countBits64 (aref commonItem k))) + ;(+= commonNum (csym::_mm_popcnt_u32 (aref commonItem k))) + (+= commonNum (csym::_mm_popcnt_u64 (aref commonItem k))) (if (== (aref commonItem k) (aref itemSet k)) (inc m))) (if (== m BIT-ITEM) @@ -618,7 +619,6 @@ (+= (aref inclusivePruning (fref -thr -> id)) (fref (fref this tsk) numPruning)) (+= (aref tableReference (fref -thr -> id)) (fref (fref this tsk) numTableReference)) (%if* DEBUG-TASK (begin - ;(csym::fprintf stderr "T-enumCCIG(from %d to %d): %f[sec](%f[sec]), %llu, ID:%d~%" (fref this minVertex) (fref this maxVertex) (csym::elapsedTime tp (+ tp 1)) (csym::elapsedTime (ptr t0) (+ tp 1)) (fref (fref this tsk) numSearch) (fref -thr -> id)) (csym::fprintf fpTask "%f, %f, %llu~%" (csym::elapsedTime tp (+ tp 1)) (csym::elapsedTime (ptr t0) (+ tp 1)) (fref (fref this tsk) numSearch))))) ;;; Function: thresholdItem - delete the vertex whose # of items is less than the user-specified threshold diff --git a/src/sample/tcell/copine1.tcell b/src/sample/tcell/copine1.tcell index bfdc8c9b..39b98096 100644 --- a/src/sample/tcell/copine1.tcell +++ b/src/sample/tcell/copine1.tcell @@ -69,8 +69,8 @@ ;;; Constants (%defconstant E-SIZE 500000) ; # of edges (%defconstant V-SIZE 15500) ; # of vertices -(%defconstant BIT-LEN 64) ; bit length of bitset -(%defconstant BIT-ITEM 3) ; # of items = BIT-ITEM * BIT-LEN +(%defconstant BIT-LEN 32) ; bit length of bitset +(%defconstant BIT-ITEM 5) ; # of items = BIT-ITEM * BIT-LEN (%defconstant BIT-EDGE 8125) ; # of edges = BIT-EDGE * BIT-LEN (%defconstant BIT-VERTEX 625) ; # of vertices = BIT-VERTEX * BIT-LEN (%defconstant I-SIZE (* BIT-LEN BIT-ITEM)) ; @@ -85,7 +85,7 @@ (%defconstant DEBUG-COPY 0) ; flag to output copy file ;;; Typedef -(deftype set uint64_t) ; bitset +(deftype set uint32_t) ; bitset (deftype vtx uint32_t) ; vertex ;;; Structure of ITnode @@ -388,7 +388,8 @@ (for ((= k 0) (= m 0) (= commonNum 0) (< k BIT-ITEM) (inc k)) (= (aref commonItem k) (cast set (bit-and (aref itemSet k) (aref vItem vv k)))) ;(+= commonNum (csym::countBits32 (aref commonItem k))) - (+= commonNum (csym::countBits64 (aref commonItem k))) + ;(+= commonNum (csym::countBits64 (aref commonItem k))) + (+= commonNum (csym::_mm_popcnt_u32 (aref commonItem k))) ;(+= commonNum (csym::_mm_popcnt_u64 (aref commonItem k))) (if (== (aref commonItem k) (aref itemSet k)) (inc m))) diff --git a/src/sample/tcell/copine3d.tcell b/src/sample/tcell/copine3d.tcell new file mode 100644 index 00000000..07a66855 --- /dev/null +++ b/src/sample/tcell/copine3d.tcell @@ -0,0 +1,1894 @@ +;;; Copyright (c) 2013 Shingo OKUNO +;;; All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: +;;; 1. Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. +;;; 2. Redistributions in binary form must reproduce the above copyright +;;; notice, this list of conditions and the following disclaimer in the +;;; documentation and/or other materials provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND +;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE +;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +;;; SUCH DAMAGE. + +;;; copine3d.tcell + +;;; Extract all connected subgraphs, each of which shares a common itemset +;;; whose size is not less than a given threshold, from a given graph +;;; in which each vertex is associated to an itemset + +;; task 0 0 0 2 +;; ; threshold +;; ; # of iterations left for a victim worker +;; ; # of divisions of the higher layer of the search tree + + +(c-exp "#include ") +(c-exp "#include ") +(c-exp "#include ") +(c-exp "#include ") +(c-exp "#include ") +(c-exp "#include ") +(c-exp "#include ") +;(c-exp "#include ") +(c-exp "#include ") +(c-exp "#include ") +(c-exp "#include ") +(c-exp "#include ") + +(c-exp "#define __USE_GNU") +(c-exp "#include ") + +(%ifndef* NF-TYPE + (%defconstant NF-TYPE GCC)) ; one of (GCC LW-SC CL-SC XCC XCCCL) +(%include "rule/tcell-setrule.sh") + +(%include "clib.sh") +(%include "dprint.sh") + +;;; Set # of iterations left for a victim worker +;;; default: half of the unexecuted iterations +(%defconstant USE-SPN-RANGE 1) ; set # directly +(%defconstant USE-SPN-RATIO 0) ; set # by the ratio to the number of unexecuted iterations + +;;; Use "popcount (SSE4.2)" +(%defconstant USE-SSE 0) + +;;; Max # of workers +(%defconstant NUM-WORKERS 32) +(%defconstant NUM-NODES 2) + +;;; Constants +(%defconstant E-SIZE 500000) ; # of edges +(%defconstant V-SIZE 15500) ; # of vertices +(%defconstant BIT-LEN 64) ; bit length of bitset +(%defconstant BIT-ITEM 3) ; # of items = BIT-ITEM * BIT-LEN +(%defconstant BIT-EDGE 8125) ; # of edges = BIT-EDGE * BIT-LEN +(%defconstant BIT-VERTEX 625) ; # of vertices = BIT-VERTEX * BIT-LEN +(%defconstant I-SIZE (* BIT-LEN BIT-ITEM)) ; + +;;; Debug Flags +(%defconstant DEBUG-DATA 0) ; flag to show some data +(%defconstant DEBUG-RSLT 0) ; flag to output result file +(%defconstant DEBUG-SHOW 0) ; flag to show traversal +(%defconstant DEBUG-TASK 0) ; flag to show task request +(%defconstant DEBUG-TIME 0) ; flag to output time file +(%defconstant DEBUG-LOCK 0) ; flag to output lock file +(%defconstant DEBUG-COPY 0) ; flag to output copy file + +;;; Typedef +(deftype set uint64_t) ; bitset +(deftype vtx uint32_t) ; vertex +(deftype task-id uint64_t) ; task ID + +;;; Structure of ITnode +(def (struct --ITnode) + (decl minID task-id) ; task ID + (decl maxID task-id) ; task ID + (decl item (array set BIT-ITEM)) ; itemset + (decl prev (ptr (struct --ITnode))) ; pointer to the previous node + (decl next (ptr (struct --ITnode)))) ; pointer to the next node +(deftype ITnode (struct --ITnode)) + +;;; Structure of ITlist +(deftype ITlist struct + (decl head (ptr ITnode)) ; pointer to the head node + (decl crnt (ptr ITnode))) ; pointer to the current node + +;;; Structure of Gnode +(def (struct --Gnode) + (decl T (ptr vtx)) ; vertices of CCIG + (decl numT int) ; element counts of T + (decl item (array set BIT-ITEM)) ; common itemset + (decl prev (ptr (struct --Gnode))) ; pointer to the previsou node + (decl next (ptr (struct --Gnode)))) ; pointer to the next node +(deftype Gnode (struct --Gnode)) + +;;; Structure of Glist +(deftype Glist struct + (decl head (ptr Gnode)) ; pointer to the head node + (decl crnt (ptr Gnode))) ; pointer to the current node + +;;; Structure of threadInfo +(deftype threadInfo struct + (decl loopStart int) + (decl loopEnd int)) + +;;; Edge Data +(decl eTo (array int E-SIZE)) ; vertex that this edge points to +(decl eNext (array int E-SIZE)) ; next edge (index for eTo) + +;;; Vertex Data +(decl vDegree (array int V-SIZE)) ; # of edges from this vertex +(decl vFirstEdge (array int V-SIZE)) ; first edge (index for eTo) +(decl vItem (array (array set BIT-ITEM) V-SIZE)) ; itemset ("i-th bit ==1" means the vertex has the item 'i') +(decl vNumItems (array int V-SIZE)) ; # of items the vertex has + +;;; Global Variables +(decl th int) ; threshold of common itemset size +(decl spawnSize int) +(decl t0 (struct timeval)) +(decl t (array (array (struct timeval) 2) V-SIZE)) +(decl doneID (array int V-SIZE)) +(decl fpTask (ptr FILE)) +(decl fpLock (ptr FILE)) +(decl fpCopy (ptr FILE)) +(def inited int 0) + +;;; Worker Data +(decl searchSpace (array uint64_t NUM-WORKERS)) +(decl visit2Vertices (array uint64_t NUM-WORKERS)) +(decl thresholdPruning (array uint64_t NUM-WORKERS)) +(decl inclusivePruning (array uint64_t NUM-WORKERS)) +(decl taskRequest (array int NUM-WORKERS)) +(decl seqTaskRequest (array int NUM-WORKERS)) +(decl tableReference (array uint64_t NUM-WORKERS)) + +;;; Item Table +(def vItemTable (ptr ITlist)) + +;;; Mutex +(decl mutex (array pthread_mutex_t V-SIZE)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Function: getrusageSec - have the user time +(def (csym::getrusageSec) (fn double void) + (decl t (struct rusage)) + (decl tv (struct timeval)) + (csym::getrusage RUSAGE-SELF (ptr t)) + (= tv t.ru-utime) + (return (+ tv.tv-sec (* (cast double tv.tv-usec) 0.000001)))) + +;;; Function: elapsedTime - have the time +(def (csym::elapsedTime t1 t2) (fn double (ptr (struct timeval)) (ptr (struct timeval))) + (return (+ (- (fref t2 -> tv-sec) (fref t1 -> tv-sec)) (* 0.000001 (- (fref t2 -> tv-usec) (fref t1 -> tv-usec)))))) + +;;; Function: countBits32 - count the number of "i-th bit == 1" +(def (csym::countBits32 x) (fn int uint32_t) + (= x (+ (bit-and x #x55555555) (bit-and (>> x 1) #x55555555))) + (= x (+ (bit-and x #x33333333) (bit-and (>> x 2) #x33333333))) + (= x (+ (bit-and x #x0f0f0f0f) (bit-and (>> x 4) #x0f0f0f0f))) + (= x (+ (bit-and x #x00ff00ff) (bit-and (>> x 8) #x00ff00ff))) + (return (+ (bit-and x #x0000ffff) (bit-and (>> x 16) #x0000ffff)))) + +;;; Function: countBits64 - count the number of "i-th bit == 1" +(def (csym::countBits64 x) (fn int uint64_t) + (= x (+ (bit-and x (c-exp "0x5555555555555555UL")) (>> (bit-and x (c-exp "0xaaaaaaaaaaaaaaaaUL")) 1))) + (= x (+ (bit-and x (c-exp "0x3333333333333333UL")) (>> (bit-and x (c-exp "0xccccccccccccccccUL")) 2))) + (= x (+ (bit-and x (c-exp "0x0f0f0f0f0f0f0f0fUL")) (>> (bit-and x (c-exp "0xf0f0f0f0f0f0f0f0UL")) 4))) + (= x (+ (bit-and x (c-exp "0x00ff00ff00ff00ffUL")) (>> (bit-and x (c-exp "0xff00ff00ff00ff00UL")) 8))) + (= x (+ (bit-and x (c-exp "0x0000ffff0000ffffUL")) (>> (bit-and x (c-exp "0xffff0000ffff0000UL")) 16))) + (= x (+ (bit-and x (c-exp "0x00000000ffffffffUL")) (>> (bit-and x (c-exp "0xffffffff00000000UL")) 32))) + (return x)) + +;;; Function: printBits - print a variable with set data type by binary representation +(def (csym::printBits x) (fn void (const set)) + (decl i int) + (def mask set (<< (cast set 1) (- BIT-LEN 1))) + (for ((= i 0) (< i BIT-LEN) (inc i)) + (if (bit-and x mask) + (csym::fprintf stderr "1") + (csym::fprintf stderr "0")) + (>>= mask 1))) + +;;; Function: fprintBits - write a variable with set data type by binary representation to stream +(def (csym::fprintBits fp x) (fn void (ptr FILE) (const set)) + (decl i int) + (def mask set (<< (cast set 1) (- BIT-LEN 1))) + (for ((= i 0) (< i BIT-LEN) (inc i)) + (if (bit-and x mask) + (csym::fprintf fp "1") + (csym::fprintf fp "0")) + (>>= mask 1))) + +;;; Function: fprintDecimally - write a variable with set date type by decimal representation to stream +(def (csym::fprintDecimally fp x k) (fn void (ptr FILE) (const set) int) + (decl i int) + (def mask set 1) + (for ((= i 0) (< i BIT-LEN) (inc i)) + (if (bit-and x mask) + (csym::fprintf fp "%d " (+ i (* k BIT-LEN)))) + (<<= mask 1))) + +;;; Function: resetTaskID - +(def (csym::resetTaskID param) (fn (ptr void) (ptr void)) + (decl i int) + (def data (ptr threadInfo) (cast (ptr threadInfo) param)) + (decl ITptr (ptr ITnode)) ; pointer to the ITnode + + (for ((= i (fref data -> loopStart)) (< i (fref data -> loopEnd)) (inc i)) + (= ITptr (fref (fref (aref vItemTable i) head) -> next)) + (while (!= ITptr (fref (aref vItemTable i) head)) + (= (fref ITptr -> minID) (cast task-id 0)) + (= (fref ITptr -> maxID) (cast task-id 0)) + (= ITptr (fref ITptr -> next)))) + + (csym::pthread_exit 0)) + +;;; Function: allocITnode - allocate a ITnode +(def (csym::allocITnode) (fn (ptr ITnode)) + (return (cast (ptr ITnode) (csym::malloc(sizeof ITnode))))) + +;;; Function: isEmptyITlist - determine whether ITlist is empty +(def (csym::isEmptyITlist list) (fn int (ptr ITlist)) + (return (== (fref (fref list -> head) -> next) (fref list -> head)))) + +;;; Function: initITlist - initialize ITlist +(def (csym::initITlist list) (fn void (ptr ITlist)) + (decl i int) + (def dummyNode (ptr ITnode) (csym::allocITnode)) + (= (fref dummyNode -> minID) (cast task-id 0)) + (= (fref dummyNode -> maxID) (cast task-id 0)) + (for ((= i 0) (< i BIT-ITEM) (inc i)) + (= (aref (fref dummyNode -> item) i) (cast set 0))) + (= (fref list -> crnt) dummyNode) + (= (fref list -> head) dummyNode) + (= (fref dummyNode -> next) dummyNode) + (= (fref dummyNode -> prev) dummyNode)) + +;;; Function: insertITnodeAfter - insert a new ITnode after the pointer 'p' +(def (csym::insertITnodeAfter list p minID maxID item) (fn void (ptr ITlist) (ptr ITnode) task-id task-id (array set)) + (decl i int) + (def new (ptr ITnode) (csym::allocITnode)) + (def nxt (ptr ITnode) (fref p -> next)) + (= (fref (fref p -> next) -> prev) new) + (= (fref p -> next) new) + (= (fref new -> minID) minID) + (= (fref new -> maxID) maxID) + (for ((= i 0) (< i BIT-ITEM) (inc i)) + (= (aref (fref new -> item) i) (aref item i))) + (= (fref new -> prev) p) + (= (fref new -> next) nxt) + (= (fref list -> crnt) new)) + +;;; Function: removeITnode - remove ITnode +(def (csym::removeITnode list p) (fn void (ptr ITlist) (ptr ITnode)) + (= (fref (fref p -> prev) -> next) (fref p -> next)) + (= (fref (fref p -> next) -> prev) (fref p -> prev)) + (= (fref list -> crnt) (fref p -> prev)) + (csym::free p)) + +;;; Function: clearITlist - remove all ITnodes of ITlist +(def (csym::clearITlist list) (fn void (ptr ITlist)) + (while (not (csym::isEmptyITlist list)) + (csym::removeITnode list (fref (fref list -> head) -> next)))) + +;;; Function: termITlist - dispose of ITlist +(def (csym::termITlist list) (fn void (ptr ITlist)) + (while (not (csym::isEmptyITlist list)) + (csym::removeITnode list (fref (fref list -> head) -> next))) + (csym::free (fref list -> head)) + (= (fref list -> crnt) NULL) + (= (fref list -> head) NULL)) + +;;; Function: allocGnode - allocate a Gnode +(def (csym::allocGnode) (fn (ptr Gnode)) + (return (cast (ptr Gnode) (csym::malloc(sizeof Gnode))))) + +;;; Function: isEmptyGlist - determine whether Glist is empty +(def (csym::isEmptyGlist list) (fn int (ptr Glist)) + (return (== (fref (fref list -> head) -> next) (fref list -> head)))) + +;;; Function: initGlist - initialize Glist +(def (csym::initGlist list) (fn void (ptr Glist)) + (def dummyNode (ptr Gnode) (csym::allocGnode)) + (= (fref list -> crnt) dummyNode) + (= (fref list -> head) dummyNode) + (= (fref dummyNode -> next) dummyNode) + (= (fref dummyNode -> prev) dummyNode)) + +;;; Function: insertGnodeAfter - insert a new Gnode after the pointer 'p' +(def (csym::insertGnodeAfter list p T numT item) (fn void (ptr Glist) (ptr Gnode) (array vtx) int (array set)) + (decl i int) + (def new (ptr Gnode) (csym::allocGnode)) + (def nxt (ptr Gnode) (fref p -> next)) + + (= (fref (fref p -> next) -> prev) new) + (= (fref p -> next) new) + + (= (fref new -> numT) numT) + + (= (fref new -> T) (cast (ptr vtx) (csym::malloc (* (fref new -> numT) (sizeof vtx))))) + (for ((= i 0) (< i (fref new -> numT)) (inc i)) + (= (aref (fref new -> T) i) (aref T i))) + + (for ((= i 0) (< i BIT-ITEM) (inc i)) + (= (aref (fref new -> item) i) (aref item i))) + + (= (fref new -> prev) p) + (= (fref new -> next) nxt) + (= (fref list -> crnt) new)) + +;;; Function: removeGnode - remove Gnode +(def (csym::removeGnode list p) (fn void (ptr Glist) (ptr Gnode)) + (= (fref (fref p -> prev) -> next) (fref p -> next)) + (= (fref (fref p -> next) -> prev) (fref p -> prev)) + (= (fref list -> crnt) (fref p -> prev)) + (csym::free p)) + +;;; Function: termGlist - dispose of Glist +(def (csym::termGlist list) (fn void (ptr Glist)) + (while (not (csym::isEmptyGlist list)) + (csym::removeGnode list (fref (fref list -> head) -> next))) + (csym::free (fref list -> head)) + (= (fref list -> crnt) NULL) + (= (fref list -> head) NULL)) + + +;;; +(def (task T-exploreCCIG) + (def minID task-id) + (def maxID task-id) + (def minC int) + (def maxC int) + (def v int) + (def itemSet (array set BIT-ITEM)) + (def vTraversed (ptr int)) + ;(def vItemTable (ptr ITlist)) + (def C (ptr vtx)) + (def numC int) + (def sizeOfC int) + (def T (ptr vtx)) + (def numT int) + (def sizeOfT int) + (def subgraph Glist) + (def treeDepth uint64_t) + (def numTraversed uint64_t) + (def numSubgraph int) + (def numSearch uint64_t) + (def numThreshold uint64_t) + (def numPruning int) + (def numTableReference uint64_t) + (def numMutexTrylock uint64_t) + (def numMutexLocked uint64_t)) + +(def (task-sender T-exploreCCIG) + (def i int 0) + (def temp int 0) + (decl tp (array (struct timeval) 2)) + ;(csym::fprintf stderr "start sending_exploreCCIG~%") + (csym::gettimeofday tp 0) + (csym::send-int th) + (csym::send-int (fref this minC)) + (csym::send-int (fref this maxC)) + (csym::send-longlong (cast long-long (fref this minID))) + (csym::send-longlong (cast long-long (fref this maxID))) + (csym::send-int (fref this v)) + (for ((= i 0) (< i BIT-ITEM) (inc i)) + (csym::send-longlong (aref (fref this itemSet) i))) + (for ((= i 0) (< i V-SIZE) (inc i)) + (csym::send-int (aref (fref this vTraversed) i))) + (csym::send-int (fref this numC)) + (for ((= i 0) (< i (fref this numC)) (inc i)) + (= temp (cast int (aref (fref this C) i))) + (csym::send-int temp)) + (csym::send-int (fref this numT)) + (for ((= i 0) (< i (fref this numT)) (inc i)) + (= temp (cast int (aref (fref this T) i))) + (csym::send-int temp)) + (csym::gettimeofday (+ tp 1) 0) + (csym::fprintf stderr "end sending_exploreCCIG, %f, %d, %d~%" (csym::elapsedTime tp (+ tp 1)) (fref this numC) (fref this numT))) + +(def (task-receiver T-exploreCCIG) + (def i int 0) + (def temp int 0) + (decl tp (array (struct timeval) 2)) + (initExploreCCIG NULL NULL NULL NULL (ptr this)) + ;(csym::fprintf stderr "start receiving_exploreCCIG~%") + (if (not inited) + (csym::gettimeofday (ptr t0) 0)) + (csym::gettimeofday tp 0) + (= th (csym::recv-int)) + (= (fref this minC) (csym::recv-int)) + (= (fref this maxC) (csym::recv-int)) + (= (fref this minID) (cast task-id (csym::recv-longlong))) + (= (fref this maxID) (cast task-id (csym::recv-longlong))) + (= (fref this v) (csym::recv-int)) + (for ((= i 0) (< i BIT-ITEM) (inc i)) + (= (aref (fref this itemSet) i) (cast set (csym::recv-longlong)))) + (for ((= i 0) (< i V-SIZE) (inc i)) + (= (aref (fref this vTraversed) i) (csym::recv-int))) + (= (fref this numC) (csym::recv-int)) + (for ((= i 0) (< i (fref this numC)) (inc i)) + (= temp (csym::recv-int)) + (= (aref (fref this C) i) (cast vtx temp))) + (= (fref this numT) (csym::recv-int)) + (for ((= i 0) (< i (fref this numT)) (inc i)) + (= temp (csym::recv-int)) + (= (aref (fref this T) i) (cast vtx temp))) + (csym::gettimeofday (+ tp 1) 0) + (csym::fprintf stderr "end receiving_exploreCCIG, %f, %f, %d, %d~%" (csym::elapsedTime (ptr t0) (+ tp 1)) (csym::elapsedTime tp (+ tp 1)) (fref this numC) (fref this numT)) + (if (not inited) + (begin + (decl edgeMax int) + (decl minVertex int) + (decl maxVertex int) + (decl maxNumItems int) + (decl patternFile (ptr char)) + (decl graphFile (ptr char)) + (= patternFile "data/symatlas_pattern.txt") + (= graphFile "data/symatlas_graph.txt") + (defs (struct hsearch_data) eHash iHash) + (initData (ptr edgeMax) (ptr minVertex) (ptr maxVertex) (ptr maxNumItems) (ptr eHash) (ptr iHash)) + (loadGraphFile graphFile (ptr edgeMax) (ptr minVertex) (ptr maxVertex) (ptr eHash)) + (loadPatternFile patternFile (ptr maxNumItems) (ptr eHash) (ptr iHash)) + (thresholdItem minVertex maxVertex) + (for ((= i 0) (< i V-SIZE) (inc i)) + (csym::pthread_mutex_init (ptr (aref mutex i)) NULL)) + (csym::hdestroy_r (ptr eHash)) + (csym::hdestroy_r (ptr iHash)) + (= inited 1)))) + +;(def (rslt-sender T-exploreCCIG) +; (csym::fprintf stderr "start: rslt-sender_exploreCCIG~%") +; (csym::fprintf stderr "end: rslt-sender_exploreCCIG~%")) + +;(def (rslt-receiver T-exploreCCIG) +; (csym::fprintf stderr "start: rslt-receiver_exploreCCIG~%") +; (csym::fprintf stderr "end: rslt-receiver_exploreCCIG~%")) + +;;;Function: initExploreCCIG - +(def (initExploreCCIG traversed itemTable C T pTsk) (fn void (ptr int) (ptr ITlist) (ptr vtx) (ptr vtx) (ptr (struct T-exploreCCIG))) + (decl i int) + + ;; initialize vTraversed + (= (fref pTsk -> vTraversed) (cast (ptr int) (csym::calloc V-SIZE (sizeof int)))) + + ;; initialize vItemTable + ;(if (== itemTable NULL) + ; (begin + ; (= (fref pTsk -> vItemTable) (cast (ptr ITlist) (csym::malloc (* V-SIZE (sizeof ITlist))))) + ; (for ((= i 0) (< i V-SIZE) (inc i)) + ; (csym::initITlist (ptr (aref (fref pTsk -> vItemTable) i))))) + ; (begin + ; (= (fref pTsk -> vItemTable) itemTable))) + + ;; initialize C + (= (fref pTsk -> numC) 0) + (= (fref pTsk -> sizeOfC) 10000) + (= (fref pTsk -> C) (cast (ptr vtx) (csym::malloc (* (fref pTsk -> sizeOfC) (sizeof vtx))))) + + ;; initialize T + (= (fref pTsk -> numT) 0) + (= (fref pTsk -> sizeOfT) 1000) + (= (fref pTsk -> T) (cast (ptr vtx) (csym::malloc (* (fref pTsk -> sizeOfT) (sizeof vtx))))) + + ;; init subgraph + (csym::initGlist (ptr (fref pTsk -> subgraph))) + + ;; init Debug Data + (= (fref pTsk -> treeDepth) 0) + (= (fref pTsk -> numTraversed) 0) + (= (fref pTsk -> numSubgraph) 0) + (= (fref pTsk -> numSearch) 0) + (= (fref pTsk -> numThreshold) 0) + (= (fref pTsk -> numPruning) 0) + (= (fref pTsk -> numTableReference) 0) + (= (fref pTsk -> numMutexTrylock) 0) + (= (fref pTsk -> numMutexLocked) 0)) + +;;; Function: exploreCCIG2 - create a common-itemset tree with recursive call +(def (exploreCCIG2 minC maxC v itemSet pTsk) (wfn void int int int (array set) (ptr (struct T-exploreCCIG))) + (defs int i j k l m) ; temporary variable + (def cc int 0) ; # of newly added candidates + (decl vv int) ; vertex whice is searched next time + (def numC int (fref pTsk -> numC)) ; + (decl commonNum int) ; # of common itemset + (decl commonItem (array set BIT-ITEM)) ; common itemset + (def closed int 1) ; flag which denotes subgraph is closed + (decl pruning int) ; flag to prune + (decl ITptr (ptr ITnode)) ; pointer to the ITnode + (decl locked int) ; + (decl tp (array (struct timeval) 2)) ; + + ;; DFS + (for ((= i minC) (< i maxC) (inc i)) + (= vv (aref (fref pTsk -> C) (- (- (fref pTsk -> numC) i) 1))) + (inc (aref (fref pTsk -> vTraversed) vv)) + + (if (== (aref (fref pTsk -> vTraversed) vv) 1) + (begin + ;; evaluate common itemset + (for ((= k 0) (= m 0) (= commonNum 0) (< k BIT-ITEM) (inc k)) + (= (aref commonItem k) (cast set (bit-and (aref itemSet k) (aref vItem vv k)))) + ;(+= commonNum (csym::countBits32 (aref commonItem k))) + ;(+= commonNum (csym::countBits64 (aref commonItem k))) + ;(+= commonNum (csym::_mm_popcnt_u32 (aref commonItem k))) + (+= commonNum (csym::_mm_popcnt_u64 (aref commonItem k))) + (if (== (aref commonItem k) (aref itemSet k)) + (inc m))) + (if (== m BIT-ITEM) + (= closed 0)) + + ;; if # of common-itemset >= th, then + (if (>= commonNum th) + (begin + (= pruning 0) + + ;; check that common-itemset is subset of item table + (%if* DEBUG-LOCK (begin + (= locked 0))) + (inc (fref pTsk -> numMutexTrylock)) + (if (!= (csym::pthread_mutex_trylock (ptr (aref mutex vv))) 0) + (begin + (inc (fref pTsk -> numMutexLocked)) + (%if* DEBUG-LOCK (begin + (= locked 1) + (csym::gettimeofday tp 0))) + (csym::pthread_mutex_lock (ptr (aref mutex vv))))) + (%if* DEBUG-LOCK (begin + (if locked + (begin + (csym::gettimeofday (+ tp 1) 0) + (csym::fprintf fpLock "%f, %d~%" (csym::elapsedTime tp (+ tp 1)) locked))))) + (= ITptr (fref (fref (aref vItemTable vv) head) -> next)) + (while (!= ITptr (fref (aref vItemTable vv) head)) + (inc (fref pTsk -> numTableReference)) + (if (<= (fref ITptr -> minID) (fref pTsk -> minID)) + (begin + (for ((= k 0) (= m 0) (< k BIT-ITEM) (inc k)) + (if (== (cast set (bit-and (aref commonItem k) (aref (fref ITptr -> item) k))) (aref commonItem k)) + (inc m))) + (if (== m BIT-ITEM) + (begin + (= pruning 1) + (break))))) + (= ITptr (fref ITptr -> next))) + (csym::pthread_mutex_unlock (ptr (aref mutex vv))) + + ;; if common-itemset is not subset of item table, then + (if (not pruning) + (begin + (inc (fref pTsk -> numTraversed)) + (+= (fref pTsk -> treeDepth) (+ (fref pTsk -> numT) 1)) + + (%if* DEBUG-LOCK (begin + (= locked 0))) + (inc (fref pTsk -> numMutexTrylock)) + (if (!= (csym::pthread_mutex_trylock (ptr (aref mutex vv))) 0) + (begin + (inc (fref pTsk -> numMutexLocked)) + (%if* DEBUG-LOCK (begin + (= locked 1) + (csym::gettimeofday tp 0))) + (csym::pthread_mutex_lock (ptr (aref mutex vv))))) + (%if* DEBUG-LOCK (begin + (if locked + (begin + (csym::gettimeofday (+ tp 1) 0) + (csym::fprintf fpLock "%f, %d~%" (csym::elapsedTime tp (+ tp 1)) locked))))) + (= ITptr (fref (fref (aref vItemTable vv) head) -> next)) + (while (!= ITptr (fref (aref vItemTable vv) head)) + (inc (fref pTsk -> numTableReference)) + (if (>= (fref ITptr -> minID) (fref pTsk -> minID)) + (begin + (for ((= k 0) (= m 0) (< k BIT-ITEM) (inc k)) + (if (== (cast set (bit-and (aref (fref ITptr -> item) k) (aref commonItem k))) (aref (fref ITptr -> item) k)) + (inc m))) + (= ITptr (fref ITptr -> next)) + (if (== m BIT-ITEM) + (csym::removeITnode (ptr (aref vItemTable vv)) (fref ITptr -> prev)))) + (begin + (= ITptr (fref ITptr -> next))))) + (csym::insertITnodeAfter (ptr (aref vItemTable vv)) (fref (aref vItemTable vv) head) (fref pTsk -> minID) (fref pTsk -> maxID) commonItem) + (csym::pthread_mutex_unlock (ptr (aref mutex vv))) + + (inc (fref pTsk -> numSearch)) + + ;; add new candidates + (if (>= (+ (fref pTsk -> numC) (aref vDegree vv)) (fref pTsk -> sizeOfC)) + (begin + (*= (fref pTsk -> sizeOfC) 2) + (= (fref pTsk -> C) (cast (ptr vtx) (csym::realloc (fref pTsk -> C) (* (fref pTsk -> sizeOfC) (sizeof vtx))))))) + (for ((= cc 0) (= j (aref vFirstEdge vv)) (!= j -1) (= j (aref eNext j))) + (if (and (< (aref (fref pTsk -> T) 0) (aref eTo j)) (== (aref (fref pTsk -> vTraversed) (aref eTo j)) 0)) + (begin + (= (aref (fref pTsk -> C) (+ cc (fref pTsk -> numC))) (aref eTo j)) + (inc cc)))) + + ;; update vertices of CCIG + (if (== (+ (fref pTsk -> numT) 1) (fref pTsk -> sizeOfT)) + (begin + (*= (fref pTsk -> sizeOfT) 2) + (= (fref pTsk -> T) (cast (ptr vtx) (csym::realloc (fref pTsk -> T) (* (fref pTsk -> sizeOfT) (sizeof vtx))))))) + (= (aref (fref pTsk -> T) (fref pTsk -> numT)) vv) + + ;; update numC & numT + (+= (fref pTsk -> numC) cc) + (inc (fref pTsk -> numT)) + + (%if* DEBUG-SHOW (begin + (begin + (for ((= l 0) (< l (- (fref pTsk -> numT) 1)) (inc l)) + (csym::fprintf stderr " %d -" (aref (fref pTsk -> T) l))) + (csym::fprintf stderr "> %d~%" (aref (fref pTsk -> T) (- (fref pTsk -> numT) 1)))))) + + ;; recursive call + (exploreCCIG2 0 (fref pTsk -> numC) vv commonItem pTsk) + + (for ((= j 0) (< j (fref pTsk -> numC)) (inc j)) + (dec (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j)))) + + (-= (fref pTsk -> numC) cc) + (dec (fref pTsk -> numT))) + (begin + (inc (fref pTsk -> numPruning)) + (%if* DEBUG-SHOW (begin + (begin + (csym::fprintf stderr " pruning!! ") + (for ((= l 0) (< l (fref pTsk -> numT)) (inc l)) + (csym::fprintf stderr " %d -" (aref (fref pTsk -> T) l))) + (csym::fprintf stderr "> %d~%" vv))))))) + (begin + (inc (fref pTsk -> numThreshold)) + (%if* DEBUG-SHOW (begin + (begin + (csym::fprintf stderr " threshold!! ") + (for ((= l 0) (< l (fref pTsk -> numT)) (inc l)) + (csym::fprintf stderr " %d -" (aref (fref pTsk -> T) l))) + (csym::fprintf stderr "> %d~%" vv))))))))) + + (if closed + ;; output common-itemset subgraph + (begin + (%if* DEBUG-RSLT (begin + (csym::insertGnodeAfter (ptr (fref pTsk -> subgraph)) (fref (fref pTsk -> subgraph) crnt) (fref pTsk -> T) (fref pTsk -> numT) itemSet))) + (inc (fref pTsk -> numSubgraph))))) + +;;; Function: exploreCCIG - create a common-itemset tree with recursive call +(def (exploreCCIG minC maxC v itemSet pTsk) (wfn void int int int (array set) (ptr (struct T-exploreCCIG))) + (defs int i j k l m) ; temporary variable + (def cc int 0) ; # of newly added candidates + (decl vv int) ; vertex whice is searched next time + (def numC int (fref pTsk -> numC)) ; + (decl commonNum int) ; # of common itemset + (decl commonItem (array set BIT-ITEM)) ; common itemset + (def closed int 1) ; flag which denotes subgraph is closed + (decl pruning int) ; flag to prune + (decl ITptr (ptr ITnode)) ; pointer to the ITnode + (decl locked int) ; + (decl tp (array (struct timeval) 2)) ; + (decl tpc (array (struct timeval) 4)) ; + + ;; DFS + (do-many for i from minC to maxC + (= vv (aref (fref pTsk -> C) (- (- (fref pTsk -> numC) i) 1))) + (inc (aref (fref pTsk -> vTraversed) vv)) + + (if (== (aref (fref pTsk -> vTraversed) vv) 1) + (begin + ;; evaluate common itemset + (for ((= k 0) (= m 0) (= commonNum 0) (< k BIT-ITEM) (inc k)) + (= (aref commonItem k) (cast set (bit-and (aref itemSet k) (aref vItem vv k)))) + ;(+= commonNum (csym::countBits32 (aref commonItem k))) + ;(+= commonNum (csym::countBits64 (aref commonItem k))) + ;(+= commonNum (csym::_mm_popcnt_u32 (aref commonItem k))) + (+= commonNum (csym::_mm_popcnt_u64 (aref commonItem k))) + (if (== (aref commonItem k) (aref itemSet k)) + (inc m))) + (if (== m BIT-ITEM) + (= closed 0)) + + ;; if # of common-itemset >= th, then + (if (>= commonNum th) + (begin + (= pruning 0) + + ;; check that common-itemset is subset of item table + (%if* DEBUG-LOCK (begin + (= locked 0))) + (inc (fref pTsk -> numMutexTrylock)) + (if (!= (csym::pthread_mutex_trylock (ptr (aref mutex vv))) 0) + (begin + (inc (fref pTsk -> numMutexLocked)) + (%if* DEBUG-LOCK (begin + (= locked 1) + (csym::gettimeofday tp 0))) + (csym::pthread_mutex_lock (ptr (aref mutex vv))))) + (%if* DEBUG-LOCK (begin + (if locked + (begin + (csym::gettimeofday (+ tp 1) 0) + (csym::fprintf fpLock "%f, %d~%" (csym::elapsedTime tp (+ tp 1)) locked))))) + (= ITptr (fref (fref (aref vItemTable vv) head) -> next)) + (while (!= ITptr (fref (aref vItemTable vv) head)) + (inc (fref pTsk -> numTableReference)) + (if (<= (fref ITptr -> minID) (fref pTsk -> minID)) + (begin + (for ((= k 0) (= m 0) (< k BIT-ITEM) (inc k)) + (if (== (cast set (bit-and (aref commonItem k) (aref (fref ITptr -> item) k))) (aref commonItem k)) + (inc m))) + (if (== m BIT-ITEM) + (begin + (= pruning 1) + (break))))) + (= ITptr (fref ITptr -> next))) + (csym::pthread_mutex_unlock (ptr (aref mutex vv))) + + ;; if common-itemset is not subset of item table, then + (if (not pruning) + (begin + (inc (fref pTsk -> numTraversed)) + (+= (fref pTsk -> treeDepth) (+ (fref pTsk -> numT) 1)) + + (%if* DEBUG-LOCK (begin + (= locked 0))) + (inc (fref pTsk -> numMutexTrylock)) + (if (!= (csym::pthread_mutex_trylock (ptr (aref mutex vv))) 0) + (begin + (inc (fref pTsk -> numMutexLocked)) + (%if* DEBUG-LOCK (begin + (= locked 1) + (csym::gettimeofday tp 0))) + (csym::pthread_mutex_lock (ptr (aref mutex vv))))) + (%if* DEBUG-LOCK (begin + (if locked + (begin + (csym::gettimeofday (+ tp 1) 0) + (csym::fprintf fpLock "%f, %d~%" (csym::elapsedTime tp (+ tp 1)) locked))))) + (= ITptr (fref (fref (aref vItemTable vv) head) -> next)) + (while (!= ITptr (fref (aref vItemTable vv) head)) + (inc (fref pTsk -> numTableReference)) + (if (>= (fref ITptr -> minID) (fref pTsk -> minID)) + (begin + (for ((= k 0) (= m 0) (< k BIT-ITEM) (inc k)) + (if (== (cast set (bit-and (aref (fref ITptr -> item) k) (aref commonItem k))) (aref (fref ITptr -> item) k)) + (inc m))) + (= ITptr (fref ITptr -> next)) + (if (== m BIT-ITEM) + (csym::removeITnode (ptr (aref vItemTable vv)) (fref ITptr -> prev)))) + (begin + (= ITptr (fref ITptr -> next))))) + (csym::insertITnodeAfter (ptr (aref vItemTable vv)) (fref (aref vItemTable vv) head) (fref pTsk -> minID) (fref pTsk -> maxID) commonItem) + (csym::pthread_mutex_unlock (ptr (aref mutex vv))) + + (inc (fref pTsk -> numSearch)) + + ;; add new candidates + (if (>= (+ (fref pTsk -> numC) (aref vDegree vv)) (fref pTsk -> sizeOfC)) + (begin + (*= (fref pTsk -> sizeOfC) 2) + (= (fref pTsk -> C) (cast (ptr vtx) (csym::realloc (fref pTsk -> C) (* (fref pTsk -> sizeOfC) (sizeof vtx))))))) + (for ((= cc 0) (= j (aref vFirstEdge vv)) (!= j -1) (= j (aref eNext j))) + (if (and (< (aref (fref pTsk -> T) 0) (aref eTo j)) (== (aref (fref pTsk -> vTraversed) (aref eTo j)) 0)) + (begin + (= (aref (fref pTsk -> C) (+ cc (fref pTsk -> numC))) (aref eTo j)) + (inc cc)))) + + ;; update vertices of CCIG + (if (== (+ (fref pTsk -> numT) 1) (fref pTsk -> sizeOfT)) + (begin + (*= (fref pTsk -> sizeOfT) 2) + (= (fref pTsk -> T) (cast (ptr vtx) (csym::realloc (fref pTsk -> T) (* (fref pTsk -> sizeOfT) (sizeof vtx))))))) + (= (aref (fref pTsk -> T) (fref pTsk -> numT)) vv) + + (dynamic-wind + (:before + ;; update numC & numT + (+= (fref pTsk -> numC) cc) + (inc (fref pTsk -> numT)) + + (if (== EXITING EXITING-SPAWN) + (begin + (for ((= j 0) (<= j i) (inc j)) + (inc (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) (- (- numC j) 1)))))))) + (:body + (%if* DEBUG-SHOW (begin + (begin + (for ((= l 0) (< l (- (fref pTsk -> numT) 1)) (inc l)) + (csym::fprintf stderr " %d -" (aref (fref pTsk -> T) l))) + (csym::fprintf stderr "> %d~%" (aref (fref pTsk -> T) (- (fref pTsk -> numT) 1)))))) + + ;; recursive call + (if (!= (fref pTsk -> minID) (fref pTsk -> maxID)) + (begin + (if (>= (cast int (csym::log2 (cast double (- (fref pTsk -> maxID) (fref pTsk -> minID))))) (* (fref option num-thrs) NUM-NODES)) + (begin + (exploreCCIG 0 (fref pTsk -> numC) vv commonItem pTsk)) + (begin + (inc (aref seqTaskRequest (fref -thr -> id))) + (exploreCCIG2 0 (fref pTsk -> numC) vv commonItem pTsk)))) + (begin + (inc (aref seqTaskRequest (fref -thr -> id))) + (exploreCCIG2 0 (fref pTsk -> numC) vv commonItem pTsk))) + + (for ((= j 0) (< j (fref pTsk -> numC)) (inc j)) + (dec (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j))))) + (:after + (if (== EXITING EXITING-SPAWN) + (begin + (for ((= j 0) (<= j i) (inc j)) + (dec (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) (- (- numC j) 1))))))) + + (-= (fref pTsk -> numC) cc) + (dec (fref pTsk -> numT))))) + (begin + (inc (fref pTsk -> numPruning)) + (%if* DEBUG-SHOW (begin + (begin + (csym::fprintf stderr " pruning!! ") + (for ((= l 0) (< l (fref pTsk -> numT)) (inc l)) + (csym::fprintf stderr " %d -" (aref (fref pTsk -> T) l))) + (csym::fprintf stderr "> %d~%" vv))))))) + (begin + (inc (fref pTsk -> numThreshold)) + (%if* DEBUG-SHOW (begin + (begin + (csym::fprintf stderr " threshold!! ") + (for ((= l 0) (< l (fref pTsk -> numT)) (inc l)) + (csym::fprintf stderr " %d -" (aref (fref pTsk -> T) l))) + (csym::fprintf stderr "> %d~%" vv)))))))) + + (handles T-exploreCCIG + (%if* USE-SPN-RANGE + (:spawn-from (if-exp (> (- i2 i) spawnSize) (+ i spawnSize) (/ (+ 1 i i2) 2)))) + (%if* USE-SPN-RATIO + (:spawn-from (/ (+ 1 i i2) spawnSize))) + (:put from i1 to i2 + (%if* DEBUG-COPY (begin + (csym::gettimeofday tpc 0))) + (= (fref this minC) i1) + (= (fref this maxC) i2) + (= (fref this maxID) (fref pTsk -> maxID)) + (= (fref pTsk -> maxID) (+ (cast task-id (* (- (fref pTsk -> maxID) (fref pTsk -> minID)) 0.5)) (fref pTsk -> minID))) + (= (fref this minID) (+ (fref pTsk -> maxID) 1)) + (initExploreCCIG NULL NULL NULL NULL (ptr this)) + (= (fref this v) v) + (csym::memcpy (fref this itemSet) itemSet (* (sizeof set) BIT-ITEM)) + (csym::memcpy (fref this vTraversed) (fref pTsk -> vTraversed) (* (sizeof int) V-SIZE)) + (for ((= j 0) (< j i1) (inc j)) + (inc (aref (fref this vTraversed) (aref (fref pTsk -> C) (- (- numC j) 1))))) + (csym::memcpy (fref this C) (fref pTsk -> C) (* (sizeof vtx) numC)) + (= (fref this numC) numC) + (csym::memcpy (fref this T) (fref pTsk -> T) (* (sizeof vtx) (fref pTsk -> numT))) + (= (fref this numT) (fref pTsk -> numT)) + (%if* DEBUG-COPY (begin + (csym::gettimeofday (+ tpc 1) 0)))) + (:get + (%if* DEBUG-COPY (begin + (csym::gettimeofday (+ tpc 2) 0))) + (%if* DEBUG-RSLT (begin + (= (fref (fref (fref (fref pTsk -> subgraph) head) -> prev) -> next) (fref (fref (fref this subgraph) head) -> next)) + (= (fref (fref (fref (fref this subgraph) head) -> next) -> prev) (fref (fref (fref pTsk -> subgraph) head) -> prev)) + (= (fref (fref (fref (fref this subgraph) head) -> prev) -> next) (fref (fref pTsk -> subgraph) head)) + (= (fref (fref (fref pTsk -> subgraph) head) -> prev) (fref (fref (fref this subgraph) head) -> prev)))) + (+= (fref pTsk -> treeDepth) (fref this treeDepth)) + (+= (fref pTsk -> numMutexTrylock) (fref this numMutexTrylock)) + (+= (fref pTsk -> numMutexLocked) (fref this numMutexLocked)) + (+= (fref pTsk -> numTraversed) (fref this numTraversed)) + (+= (fref pTsk -> numSubgraph) (fref this numSubgraph)) + (%if* DEBUG-COPY (begin + (csym::gettimeofday (+ tpc 3) 0) + (csym::fprintf fpCopy "%f, 1~%" (+ (csym::elapsedTime tpc (+ tpc 1)) (csym::elapsedTime (+ tpc 2) (+ tpc 3))))))))) + + (if closed + ;; output common-itemset subgraph + (begin + (%if* DEBUG-RSLT (begin + (csym::insertGnodeAfter (ptr (fref pTsk -> subgraph)) (fref (fref pTsk -> subgraph) crnt) (fref pTsk -> T) (fref pTsk -> numT) itemSet))) + (inc (fref pTsk -> numSubgraph))))) + +;;; +(def (task-body T-exploreCCIG) + (decl i int) + (decl seq int) + (decl tp (array (struct timeval) 2)) + (inc (aref taskRequest (fref -thr -> id))) + ;(csym::fprintf stderr "start: task-body_exploreCCIG / worker-%d~%" (fref -thr -> id)) + (if (> (fref this minID) (fref this maxID)) + (csym::fprintf stderr "minID = %llu, maxID = %llu~%" (fref this minID) (fref this maxID))) + (csym::gettimeofday tp 0) + (if (!= (fref this minID) (fref this maxID)) + (begin + (if (>= (cast int (csym::log2 (cast double (- (fref this maxID) (fref this minID))))) (* (fref option num-thrs) NUM-NODES)) + (begin + (= seq 0) + (exploreCCIG (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this))) + (begin + (= seq 1) + (inc (aref seqTaskRequest (fref -thr -> id))) + (exploreCCIG2 (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this))))) + (begin + (= seq 1) + (inc (aref seqTaskRequest (fref -thr -> id))) + (exploreCCIG2 (fref this minC) (fref this maxC) (fref this v) (fref this itemSet) (ptr this)))) + (csym::gettimeofday (+ tp 1) 0) + (+= (aref visit2Vertices (fref -thr -> id)) (fref this numSearch)) + (+= (aref thresholdPruning (fref -thr -> id)) (fref this numThreshold)) + (+= (aref inclusivePruning (fref -thr -> id)) (fref this numPruning)) + (+= (aref tableReference (fref -thr -> id)) (fref this numTableReference)) + (csym::fprintf stderr "end: task-body_exploreCCIG, %f, %llu, %llu, %llu, %d, %llu, %llu, %llu, %d, %d~%" (csym::elapsedTime tp (+ tp 1)) (+ (fref this numSearch) (+ (fref this numThreshold) (fref this numPruning))) (fref this numSearch) (fref this numThreshold) (fref this numPruning) (fref this numTableReference) (fref this numMutexTrylock) (fref this numMutexLocked) (fref -thr -> id) seq) + (%if* DEBUG-TASK (begin + (csym::fprintf fpTask "%f, %f, %f, %llu, %d, %d~%" (csym::elapsedTime (ptr t0) tp) (csym::elapsedTime tp (+ tp 1)) (csym::elapsedTime (ptr t0) (+ tp 1)) (fref this numSearch) seq (fref -thr -> id)))) + (csym::free (fref this vTraversed)) + (csym::free (fref this C)) + (csym::free (fref this T))) + +;;; +(def (task T-enumCCIG) + (def minVertex int :in) + (def maxVertex int :in) + (def tsk (struct T-exploreCCIG))) + +(def (task-sender T-enumCCIG) + (def i int 0) + (decl tp (array (struct timeval) 2)) + ;(csym::fprintf stderr "start sending_enumCCIG~%") + (csym::gettimeofday tp 0) + (csym::send-int th) + (csym::send-longlong (cast long-long (fref (fref this tsk) minID))) + (csym::send-longlong (cast long-long (fref (fref this tsk) maxID))) + (csym::gettimeofday (+ tp 1) 0) + (csym::fprintf stderr "end sending_enumCCIG, %f~%" (csym::elapsedTime tp (+ tp 1)))) + +(def (task-receiver T-enumCCIG) + (def i int 0) + (decl tp (array (struct timeval) 2)) + (initExploreCCIG NULL NULL NULL NULL (ptr (fref this tsk))) + ;(csym::fprintf stderr "start receiving_enumCCIG~%") + (if (not inited) + (csym::gettimeofday (ptr t0) 0)) + (csym::gettimeofday tp 0) + (= th (csym::recv-int)) + (= (fref (fref this tsk) minID) (cast task-id (csym::recv-longlong))) + (= (fref (fref this tsk) maxID) (cast task-id (csym::recv-longlong))) + (csym::gettimeofday (+ tp 1) 0) + (csym::fprintf stderr "end receiving_enumCCIG, %f, %f~%" (csym::elapsedTime (ptr t0) (+ tp 1)) (csym::elapsedTime tp (+ tp 1))) + (if (not inited) + (begin + (decl edgeMax int) + (decl minVertex int) + (decl maxVertex int) + (decl maxNumItems int) + (decl patternFile (ptr char)) + (decl graphFile (ptr char)) + (= patternFile "data/symatlas_pattern.txt") + (= graphFile "data/symatlas_graph.txt") + (defs (struct hsearch_data) eHash iHash) + (initData (ptr edgeMax) (ptr minVertex) (ptr maxVertex) (ptr maxNumItems) (ptr eHash) (ptr iHash)) + (loadGraphFile graphFile (ptr edgeMax) (ptr minVertex) (ptr maxVertex) (ptr eHash)) + (loadPatternFile patternFile (ptr maxNumItems) (ptr eHash) (ptr iHash)) + (thresholdItem minVertex maxVertex) + (for ((= i 0) (< i V-SIZE) (inc i)) + (csym::pthread_mutex_init (ptr (aref mutex i)) NULL)) + (csym::hdestroy_r (ptr eHash)) + (csym::hdestroy_r (ptr iHash)) + (= inited 1)))) + +(def (rslt-sender T-enumCCIG) + ;(csym::fprintf stderr "start: rslt-sender_enumCCIG~%") + (csym::free (fref (fref this tsk) vTraversed)) + (csym::free (fref (fref this tsk) C)) + (csym::free (fref (fref this tsk) T)) + (csym::fprintf stderr "end: rslt-sender_enumCCIG~%")) + +(def (rslt-receiver T-enumCCIG) + ;(csym::fprintf stderr "start: rslt-receiver_enumCCIG~%") + (csym::fprintf stderr "end: rslt-receiver_enumCCIG~%")) + +;;; Function: enumCCIG2 - enumerate CCIG +(def (enumCCIG2 minVertex maxVertex pTsk) (wfn void int int (ptr (struct T-exploreCCIG))) + (defs int i j k) ; temporary variable + (decl visiting int) ; flag to search + (decl ITptr (ptr ITnode)) ; + (decl locked int) + (decl tp (array (struct timeval) 2)) + + (for ((= i minVertex) (< i maxVertex) (inc i)) + (%if* DEBUG-TIME (begin + (csym::gettimeofday (aref t i) 0))) + (if (> (aref vDegree i) 0) + (begin + (%if* DEBUG-SHOW (begin + (csym::fprintf stderr "Starting Point: %d~%" i))) + + (= (aref (fref pTsk -> vTraversed) i) 2) + (= visiting 0) + + ;; check that itemset of 'i' is subset of itemset-table + (%if* DEBUG-LOCK (begin + (= locked 0))) + (inc (fref pTsk -> numMutexTrylock)) + (if (!= (csym::pthread_mutex_trylock (ptr (aref mutex i))) 0) + (begin + (inc (fref pTsk -> numMutexLocked)) + (%if* DEBUG-LOCK (begin + (= locked 1) + (csym::gettimeofday tp 0))) + (csym::pthread_mutex_lock (ptr (aref mutex i))))) + (%if* DEBUG-LOCK (begin + (if locked + (begin + (csym::gettimeofday (+ tp 1) 0) + (csym::fprintf fpLock "%f, %d~%" (csym::elapsedTime tp (+ tp 1)) locked))))) + (= ITptr (fref (fref (aref vItemTable i) head) -> next)) + (inc (fref pTsk -> numTableReference)) + (if (<= (fref ITptr -> minID) (fref pTsk -> minID)) + (begin + (for ((= k 0) (< k BIT-ITEM) (inc k)) + (if (!= (cast set (bit-and (aref vItem i k) (aref (fref ITptr -> item) k))) (aref vItem i k)) + (begin + (= visiting 1) + (break))))) + (begin + (= visiting 1))) + (csym::pthread_mutex_unlock (ptr (aref mutex i))) + + ;; if search the CCIG whose starting point is 'i', then + (if visiting + (begin + (%if* DEBUG-SHOW (begin + (csym::fprintf stderr "+++ Allons-y! +++~%"))) + + (%if* DEBUG-LOCK (begin + (= locked 0))) + (inc (fref pTsk -> numMutexTrylock)) + (if (!= (csym::pthread_mutex_trylock (ptr (aref mutex i))) 0) + (begin + (inc (fref pTsk -> numMutexLocked)) + (%if* DEBUG-LOCK (begin + (= locked 1) + (csym::gettimeofday tp 0))) + (csym::pthread_mutex_lock (ptr (aref mutex i))))) + (%if* DEBUG-LOCK (begin + (if locked + (begin + (csym::gettimeofday (+ tp 1) 0) + (csym::fprintf fpLock "%f, %d~%" (csym::elapsedTime tp (+ tp 1)) locked))))) + (csym::clearITlist (ptr (aref vItemTable i))) + (csym::insertITnodeAfter (ptr (aref vItemTable i)) (fref (aref vItemTable i) head) (fref pTsk -> minID) (fref pTsk -> maxID) (aref vItem i)) + (csym::pthread_mutex_unlock (ptr (aref mutex i))) + + (inc (fref pTsk -> numSearch)) + + (for ((= j (aref vFirstEdge i)) (!= j -1) (= j (aref eNext j))) + (if (< i (aref eTo j)) + (begin + (= (aref (fref pTsk -> C) (fref pTsk -> numC)) (aref eTo j)) + (inc (fref pTsk -> numC))))) + + (= (aref (fref pTsk -> T) (fref pTsk -> numT)) i) + (inc (fref pTsk -> numT)) + (inc (fref pTsk -> treeDepth)) + (inc (fref pTsk -> numTraversed)) + + (exploreCCIG2 0 (fref pTsk -> numC) i (aref vItem i) pTsk) + + (for ((= j 0) (< j (fref pTsk -> numC)) (inc j)) + (= (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j)) 0)) + (= (fref pTsk -> numC) 0) + + (= (fref pTsk -> numT) 0) + + (%if* DEBUG-SHOW (begin + (csym::fprintf stderr "~%")))) + (begin + (inc (fref pTsk -> numPruning)) + + (%if* DEBUG-SHOW (begin + (csym::fprintf stderr "- PRUNING! -~%~%"))))))) + + (%if* DEBUG-TIME (begin + (csym::gettimeofday (+ (aref t i) 1) 0) + (= (aref doneID i) (fref -thr -> id)))))) + +;;; Function: enumCCIG - enumerate CCIG +(def (enumCCIG minVertex maxVertex pTsk) (wfn void int int (ptr (struct T-exploreCCIG))) + (defs int i j k) ; temporary variable + (decl visiting int) ; flag to search + (decl ITptr (ptr ITnode)) ; + (decl locked int) + (decl tp (array (struct timeval) 2)) + (decl tpc (array (struct timeval) 4)) + + (do-many for i from minVertex to maxVertex + (%if* DEBUG-TIME (begin + (csym::gettimeofday (aref t i) 0))) + (if (> (aref vDegree i) 0) + (begin + (%if* DEBUG-SHOW (begin + (csym::fprintf stderr "Starting Point: %d~%" i))) + + (= (aref (fref pTsk -> vTraversed) i) 2) + (= visiting 0) + + ;; check that itemset of 'i' is subset of itemset-table + (%if* DEBUG-LOCK (begin + (= locked 0))) + (inc (fref pTsk -> numMutexTrylock)) + (if (!= (csym::pthread_mutex_trylock (ptr (aref mutex i))) 0) + (begin + (inc (fref pTsk -> numMutexLocked)) + (%if* DEBUG-LOCK (begin + (= locked 1) + (csym::gettimeofday tp 0))) + (csym::pthread_mutex_lock (ptr (aref mutex i))))) + (%if* DEBUG-LOCK (begin + (if locked + (begin + (csym::gettimeofday (+ tp 1) 0) + (csym::fprintf fpLock "%f, %d~%" (csym::elapsedTime tp (+ tp 1)) locked))))) + (= ITptr (fref (fref (aref vItemTable i) head) -> next)) + (inc (fref pTsk -> numTableReference)) + (if (<= (fref ITptr -> minID) (fref pTsk -> minID)) + (begin + (for ((= k 0) (< k BIT-ITEM) (inc k)) + (if (!= (cast set (bit-and (aref vItem i k) (aref (fref ITptr -> item) k))) (aref vItem i k)) + (begin + (= visiting 1) + (break))))) + (begin + (= visiting 1))) + (csym::pthread_mutex_unlock (ptr (aref mutex i))) + + ;; if search the CCIG whose starting point is 'i', then + (if visiting + (begin + (%if* DEBUG-SHOW (begin + (csym::fprintf stderr "+++ Allons-y! +++~%"))) + + (%if* DEBUG-LOCK (begin + (= locked 0))) + (inc (fref pTsk -> numMutexTrylock)) + (if (!= (csym::pthread_mutex_trylock (ptr (aref mutex i))) 0) + (begin + (inc (fref pTsk -> numMutexLocked)) + (%if* DEBUG-LOCK (begin + (= locked 1) + (csym::gettimeofday tp 0))) + (csym::pthread_mutex_lock (ptr (aref mutex i))))) + (%if* DEBUG-LOCK (begin + (if locked + (begin + (csym::gettimeofday (+ tp 1) 0) + (csym::fprintf fpLock "%f, %d~%" (csym::elapsedTime tp (+ tp 1)) locked))))) + (csym::clearITlist (ptr (aref vItemTable i))) + (csym::insertITnodeAfter (ptr (aref vItemTable i)) (fref (aref vItemTable i) head) (fref pTsk -> minID) (fref pTsk -> maxID) (aref vItem i)) + (csym::pthread_mutex_unlock (ptr (aref mutex i))) + + (inc (fref pTsk -> numSearch)) + + (for ((= j (aref vFirstEdge i)) (!= j -1) (= j (aref eNext j))) + (if (< i (aref eTo j)) + (begin + (= (aref (fref pTsk -> C) (fref pTsk -> numC)) (aref eTo j)) + (inc (fref pTsk -> numC))))) + + (= (aref (fref pTsk -> T) (fref pTsk -> numT)) i) + (inc (fref pTsk -> numT)) + (inc (fref pTsk -> treeDepth)) + (inc (fref pTsk -> numTraversed)) + + (if (!= (fref pTsk -> minID) (fref pTsk -> maxID)) + (begin + (if (>= (cast int (csym::log2 (cast double (- (fref pTsk -> maxID) (fref pTsk -> minID))))) (* (fref option num-thrs) NUM-NODES)) + (begin + (exploreCCIG 0 (fref pTsk -> numC) i (aref vItem i) pTsk)) + (begin + (inc (aref seqTaskRequest (fref -thr -> id))) + (exploreCCIG2 0 (fref pTsk -> numC) i (aref vItem i) pTsk)))) + (begin + (inc (aref seqTaskRequest (fref -thr -> id))) + (exploreCCIG2 0 (fref pTsk -> numC) i (aref vItem i) pTsk))) + + (for ((= j 0) (< j (fref pTsk -> numC)) (inc j)) + (= (aref (fref pTsk -> vTraversed) (aref (fref pTsk -> C) j)) 0)) + (= (fref pTsk -> numC) 0) + + (= (fref pTsk -> numT) 0) + + (%if* DEBUG-SHOW (begin + (csym::fprintf stderr "~%")))) + (begin + (inc (fref pTsk -> numPruning)) + + (%if* DEBUG-SHOW (begin + (csym::fprintf stderr "- PRUNING! -~%~%"))))))) + + (%if* DEBUG-TIME (begin + (csym::gettimeofday (+ (aref t i) 1) 0) + (= (aref doneID i) (fref -thr -> id)))) + + (handles T-enumCCIG + (%if* USE-SPN-RANGE + ;(:spawn-from i2)) + (:spawn-from (if-exp (> (- i2 i) spawnSize) (+ i spawnSize) (/ (+ 1 i i2) 2)))) + (%if* USE-SPN-RATIO + (:spawn-from (/ (+ 1 i i2) spawnSize))) + (:put from i1 to i2 + (%if* DEBUG-COPY (begin + (csym::gettimeofday tpc 0))) + (= (fref this minVertex) i1) + (= (fref this maxVertex) i2) + (= (fref (fref this tsk) maxID) (fref pTsk -> maxID)) + (= (fref pTsk -> maxID) (+ (cast task-id (* (- (fref pTsk -> maxID) (fref pTsk -> minID)) 0.5)) (fref pTsk -> minID))) + (= (fref (fref this tsk) minID) (+ (fref pTsk -> maxID) 1)) + (initExploreCCIG NULL NULL NULL NULL (ptr (fref this tsk))) + (%if* DEBUG-COPY (begin + (csym::gettimeofday (+ tpc 1) 0)))) + (:get + (%if* DEBUG-COPY (begin + (csym::gettimeofday (+ tpc 2) 0))) + (%if* DEBUG-RSLT (begin + (= (fref (fref (fref (fref pTsk -> subgraph) head) -> prev) -> next) (fref (fref (fref (fref this tsk) subgraph) head) -> next)) + (= (fref (fref (fref (fref (fref this tsk) subgraph) head) -> next) -> prev) (fref (fref (fref pTsk -> subgraph) head) -> prev)) + (= (fref (fref (fref (fref (fref this tsk) subgraph) head) -> prev) -> next) (fref (fref pTsk -> subgraph) head)) + (= (fref (fref (fref pTsk -> subgraph) head) -> prev) (fref (fref (fref (fref this tsk) subgraph) head) -> prev)))) + (+= (fref pTsk -> treeDepth) (fref (fref this tsk) treeDepth)) + (+= (fref pTsk -> numMutexTrylock) (fref (fref this tsk) numMutexTrylock)) + (+= (fref pTsk -> numMutexLocked) (fref (fref this tsk) numMutexLocked)) + (+= (fref pTsk -> numTraversed) (fref (fref this tsk) numTraversed)) + (+= (fref pTsk -> numSubgraph) (fref (fref this tsk) numSubgraph)) + (csym::free (fref (fref this tsk) vTraversed)) + (csym::free (fref (fref this tsk) C)) + (csym::free (fref (fref this tsk) T)) + (%if* DEBUG-COPY (begin + (csym::gettimeofday (+ tpc 3) 0) + (csym::fprintf fpCopy "%f, 2~%" (+ (csym::elapsedTime tpc (+ tpc 1)) (csym::elapsedTime (+ tpc 2) (+ tpc 3)))))))))) + +;;; +(def (task-body T-enumCCIG) + (decl seq int) + (decl tp (array (struct timeval) 2)) + (inc (aref taskRequest (fref -thr -> id))) + ;(csym::fprintf stderr "start: task-body_enumCCIG / worker-%d~%" (fref -thr -> id)) + (csym::gettimeofday tp 0) + (if (!= (fref (fref this tsk) minID) (fref (fref this tsk) maxID)) + (begin + (if (>= (cast int (csym::log2 (cast double (- (fref (fref this tsk) maxID) (fref (fref this tsk) minID))))) (fref option num-thrs)) + (begin + (= seq 0) + (enumCCIG (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk)))) + (begin + (= seq 1) + (inc (aref seqTaskRequest (fref -thr -> id))) + (enumCCIG2 (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk)))))) + (begin + (= seq 1) + (inc (aref seqTaskRequest (fref -thr -> id))) + (enumCCIG2 (fref this minVertex) (fref this maxVertex) (ptr (fref this tsk))))) + (csym::gettimeofday (+ tp 1) 0) + (+= (aref visit2Vertices (fref -thr -> id)) (fref (fref this tsk) numSearch)) + (+= (aref thresholdPruning (fref -thr -> id)) (fref (fref this tsk) numThreshold)) + (+= (aref inclusivePruning (fref -thr -> id)) (fref (fref this tsk) numPruning)) + (+= (aref tableReference (fref -thr -> id)) (fref (fref this tsk) numTableReference)) + (csym::fprintf stderr "end: task-body_enumCCIG, %f, %llu, %llu, %llu, %d, %llu, %llu, %llu, %d, %d~%" (csym::elapsedTime tp (+ tp 1)) (+ (fref (fref this tsk) numSearch) (+ (fref (fref this tsk) numThreshold) (fref (fref this tsk) numPruning))) (fref (fref this tsk) numSearch) (fref (fref this tsk) numThreshold) (fref (fref this tsk) numPruning) (fref (fref this tsk) numTableReference) (fref (fref this tsk) numMutexTrylock) (fref (fref this tsk) numMutexLocked) (fref -thr -> id) seq) + (%if* DEBUG-TASK (begin + (csym::fprintf fpTask "%f, %f, %f, %llu, %d, %d~%" (csym::elapsedTime (ptr t0) tp) (csym::elapsedTime tp (+ tp 1)) (csym::elapsedTime (ptr t0) (+ tp 1)) (fref (fref this tsk) numSearch) seq (fref -thr -> id))))) + +;;; Function: thresholdItem - delete the vertex whose # of items is less than the user-specified threshold +(def (thresholdItem minVertex maxVertex) (fn void (const int) (const int)) + (defs int i j k l) ; temporary variable + + (for ((= i minVertex) (< i maxVertex) (inc i)) + ;; if # of items is less than the use-specified threshold, then + (if (and (> (aref vDegree i) 0) (< (aref vNumItems i) th)) + (begin + ;; delete edges connected from the vertex + (= (aref vDegree i) 0) + (= (aref vFirstEdge i) -1) + + (for ((= j minVertex) (< j maxVertex) (inc j)) + (for ((= k (aref vFirstEdge j)) (!= k -1) (= k (aref eNext k))) + ;; delete edges connected to the vertex + (if (== (aref eTo k) i) + (begin + ;; if degree of starting point == 1, then + (if (== (aref vDegree j) 1) + (begin + (= (aref vDegree j) 0) + (= (aref vFirstEdge j) -1)) + ;; if degree of starting point >= 2, then + (begin + (if (== k (aref vFirstEdge j)) + (begin + (= (aref vFirstEdge j) (aref eNext k))) + (if (== (aref eNext k) -1) + (= (aref eNext l) -1) + (begin + (= (aref eNext l) (aref eNext k))))) + (dec (aref vDegree j)))))) + (= l k))))))) + +;;; Function: loadPatternFile - load pattern file +(def (loadPatternFile patternFile maxNumItems eHash iHash) (fn void (ptr (const char)) (ptr int) (ptr (struct hsearch_data)) (ptr (struct hsearch_data))) + (def i int 0) ; + (decl n int) ; item number + (decl v int) ; vertex number + (decl item (ptr char)) ; + (decl buff (array char 256)) ; buffer + (decl temp (array char 256)) ; + (decl he (struct entry)) ; + (decl hep (ptr (struct entry))) ; + (decl fp (ptr FILE)) ; file pointer + + ;; open pattern file + (if (== (= fp (csym::fopen patternFile "r")) NULL) + (begin + (csym::fprintf stderr "Cannot open pattern file: %s~%" patternFile) + (exit EXIT-FAILURE))) + + ;; read a line of data from pattern file + (while (!= (csym::fgets buff 256 fp) NULL) + ;; skip a comment line + (if (!= (csym::strncmp buff "#" 1) 0) + (begin + (= v (csym::atoi (csym::strtok buff "~|11|"))) + + ;; find v from eHash + (csym::sprintf temp "%d" v) + (= (fref he key) temp) + (csym::hsearch_r he FIND (ptr hep) eHash) + (if (== hep NULL) + (continue)) + (= v (cast int (fref hep -> data))) + + ;; add item to Vertex Data + (while (!= (= item (csym::strtok NULL ",")) NULL) + (= n (csym::atoi item)) + + ;; enter n to iHash + (csym::sprintf temp "%d" n) + (= (fref he key) temp) + (csym::hsearch_r he FIND (ptr hep) iHash) + (if (== hep NULL) + (begin + (= (fref he data) (cast (ptr void) (inc i))) + (csym::hsearch_r he ENTER (ptr hep) iHash))) + (= n (cast int (fref hep -> data))) + + (bit-or= (aref vItem v (cast int (/ n BIT-LEN))) (<< (cast set 1) (cast int (% n BIT-LEN)))) + (inc (aref vNumItems v)) ; increase # of items + ;; evaluate maximum # of items + (if (> n (mref maxNumItems)) + (= (mref maxNumItems) n)))))) + + ;; close pattern file + (csym::fclose fp)) + +;;; Function: createEdge - add edge to eTo +(def (createEdge v1 v2 edgeMax minVertex maxVertex) (fn void int int (ptr int) (ptr int) (ptr int)) + (defs int i j temp1 temp2) ; temporary variable + + ;; if degree of the starting point == 0, then + (if (== (aref vDegree v1) 0) + (begin + (inc (mref edgeMax)) + (= (aref eTo (mref edgeMax)) v2) + (= (aref vFirstEdge v1) (mref edgeMax))) + + ;; if degree of starting point >= 1, then + (begin + (= temp1 v2) + (for ((= i (aref vFirstEdge v1)) 1 (= i (aref eNext i))) + (if (== temp1 (aref eTo i)) + (return)) ; the edge already exists + (if (> temp1 (aref eTo i)) + (begin + (= temp2 (aref eTo i)) + (= (aref eTo i) temp1) + (= temp1 temp2))) + (if (== (aref eNext i) -1) + (break))) + + ;; update Edge Data + (inc (mref edgeMax)) + (= (aref eTo (mref edgeMax)) temp1) + (= (aref eNext i) (mref edgeMax)))) + + ;; evaluate mimimum vertex number + (if (< v1 (mref minVertex)) + (= (mref minVertex) v1)) + (if (< v2 (mref minVertex)) + (= (mref minVertex) v2)) + + ;; evaluate maximum vertex number + (if (> v1 (mref maxVertex)) + (= (mref maxVertex) v1)) + (if (> v2 (mref maxVertex)) + (= (mref maxVertex) v2)) + + ;; increase degree of the starting point + (inc (aref vDegree v1))) + +;;; Function: loadGraphFile - load graph file +(def (loadGraphFile graphFile edgeMax minVertex maxVertex eHash) (fn void (ptr (const char)) (ptr int) (ptr int) (ptr int) (ptr (struct hsearch_data))) + (def v int 1) ; + (defs int v1 v2) ; starting point, ending point + (decl eLabel (ptr char)) ; label of edge + (decl empty (ptr char)) ; + (decl buff (array char 256)) ; buffer + (decl temp (array char 256)) ; + (decl he (struct entry)) ; + (decl hep (ptr (struct entry))) ; + (decl fp (ptr FILE)) ; file pointer + + ;; open graph file + (if (== (= fp (csym::fopen graphFile "r")) NULL) + (begin + (csym::fprintf stderr "Cannot open graph file: %s~%" graphFile) + (exit EXIT-FAILURE))) + + ;; read a line of data from graph file + (while (!= (csym::fgets buff 256 fp) NULL) + ;; skip a comment line + (if (!= (csym::strncmp buff "#" 1) 0) + (begin + (= v1 (csym::atoi (csym::strtok buff "~|11|"))) + (= eLabel (csym::strtok NULL "~|11|")) + (= v2 (csym::atoi (csym::strtok NULL "~|11|"))) + (= empty (csym::strtok NULL "~|11|")) + + ;; enter v1 to eHash + (csym::sprintf temp "%d" v1) + (= (fref he key) temp) + (csym::hsearch_r he FIND (ptr hep) eHash) + (if (== hep NULL) + (begin + (= (fref he data) (cast (ptr void) (inc v))) + (csym::hsearch_r he ENTER (ptr hep) eHash))) + (= v1 (cast int (fref hep -> data))) + + ;; enter v2 to eHash + (csym::sprintf temp "%d" v2) + (= (fref he key) temp) + (csym::hsearch_r he FIND (ptr hep) eHash) + (if (== hep NULL) + (begin + (= (fref he data) (cast (ptr void) (inc v))) + (csym::hsearch_r he ENTER (ptr hep) eHash))) + (= v2 (cast int (fref hep -> data))) + + ;; add edge to Edge List + (if (== empty NULL) + (if (!= v1 v2) + (begin + (createEdge v1 v2 edgeMax minVertex maxVertex) + (createEdge v2 v1 edgeMax minVertex maxVertex))))))) + + ;; close graph file + (csym::fclose fp)) + +;;; Function: initData - initialize Edge Data & Vertex Data & Debug Data +(def (initData edgeMax minVertex maxVertex maxNumItems eHash iHash) (fn void (ptr int) (ptr int) (ptr int) (ptr int) (ptr (struct hsearch_data)) (ptr (struct hsearch_data))) + (defs int i j) ; temporary variable + + ;; initialize Edge Data + (= (mref edgeMax) -1) + (for ((= i 0) (< i E-SIZE) (inc i)) + (= (aref eTo i) -1) + (= (aref eNext i) -1)) + + ;; initialize Vertex Data + (= (mref minVertex) INT_MAX) + (= (mref maxVertex) -1) + (= (mref maxNumItems) -1) + (for ((= i 0) (< i V-SIZE) (inc i)) + (= (aref vDegree i) 0) + (= (aref vFirstEdge i) -1) + (= (aref vNumItems i) 0) + (for ((= j 0) (< j BIT-ITEM) (inc j)) + (= (aref vItem i j) 0))) + + ;; initialize Item Table + (= vItemTable (cast (ptr ITlist) (csym::malloc (* V-SIZE (sizeof ITlist))))) + (for ((= i 0) (< i V-SIZE) (inc i)) + (csym::initITlist (ptr (aref vItemTable i)))) + + ;; initialize Debug Data + (for ((= i 0) (< i NUM-WORKERS) (inc i)) + (= (aref searchSpace i) 0) + (= (aref visit2Vertices i) 0) + (= (aref thresholdPruning i) 0) + (= (aref inclusivePruning i) 0) + (= (aref taskRequest i) 0) + (= (aref seqTaskRequest i) 0) + (= (aref tableReference i) 0)) + + (for ((= i 0) (< i V-SIZE) (inc i)) + (= (aref doneID i) 0)) + + ;; initialize Hash Data + (csym::memset eHash 0 (sizeof (mref eHash))) + (csym::memset iHash 0 (sizeof (mref iHash))) + (csym::hcreate_r E-SIZE eHash) + (csym::hcreate_r I-SIZE iHash)) + +;;; +(def (task T-startCCIG) + (def th int :in) + (def spawnSize int :in) + (def loopRatio int :in)) + +;;; Main +(def (task-body T-startCCIG) + (defs int i j k) ; temporary variable + (decl tp (array (struct timeval) 2)) ; start time, end time + (defs double t1 t2) ; start user time, end user time + (decl loopRange int) ; loop range of enumCCIG + (decl patternFile (ptr char)) ; name of pattern file + (decl graphFile (ptr char)) ; name of graph file + (decl resultFile (ptr char)) ; name of result file + ;(decl patternFile (array char 128)) + ;(decl graphFile (array char 128)) + (decl timeFile (array char 128)) ; name of time file + (decl taskFile (array char 128)) ; name of task file + (decl lockFile (array char 128)) ; name of lock file + (decl copyFile (array char 128)) ; name of copy file + (decl ITptr (ptr ITnode)) ; pointer to the ITnode + (defs (ptr FILE) fp fpt) ; file pointer + + ;; pthread data + ;(decl resetThread (array pthread_t (fref option num-thrs))) + ;(decl data (array threadInfo (fref option num-thrs))) + ;(decl attr pthread_attr_t) + + ;; Task + (def tsk (struct T-exploreCCIG)) + + ;; Edge Data + (decl edgeMax int) ; maximum edge number + + ;; Vertex Data + (decl minVertex int) ; minimum vertex number + (decl maxVertex int) ; maximum vertex number + (decl maxNumItems int) ; maximum # of items + + ;; Subgraph Data + (decl Gptr (ptr Gnode)) + + ;; Hash Data + (defs (struct hsearch_data) eHash iHash) + + ;; Debug Data + (def numSearch uint64_t 0) ; # of search space + (def maxWorkerSearch uint64_t 0) ; + (def minWorkerSearch uint64_t UINT-LEAST64-MAX) ; + (def avgWorkerSearch double 0.0) ; + (def workerSearchSD double 0.0) ; + (def avgWorkerSearchPerSec double 0.0) ; + (def workerSearchPerSecSD double 0.0) ; + (def numTaskRequest int 0) ; # of task request + (def avgTaskRequest double 0.0) ; + (def taskRequestSD double 0.0) ; + (def numSeqTaskRequest int 0) ; # of seq. task request + (def avgSeqTaskRequest double 0.0) ; + (def seqTaskRequestSD double 0.0) ; + (def numAllTaskRequest int 0) ; # of all task request + (def avgAllTaskRequest double 0.0) ; + (def allTaskRequestSD double 0.0) ; + (def numTableReference uint64_t 0) ; + (def avgTableReference double 0.0) ; + (def tableReferenceSD double 0.0) ; + (def avgSizeSubgraph uint64_t 0) ; + (def maxSizeSubgraph int 0) ; + + ;; arguments + (= patternFile "data/symatlas_pattern.txt") + (= graphFile "data/symatlas_graph.txt") + ;(= patternFile "data/dblp_author-of.tab") + ;(= graphFile "data/dblp_cites_network.tab") + ;(= patternFile "data/eg_pattern.txt") + ;(= graphFile "data/eg_graph.txt") + ;(= patternFile "data/eg2_pattern.txt") + ;(= graphFile "data/eg2_graph.txt") + (= th (fref this th)) + (= spawnSize (fref this spawnSize)) + (= resultFile "result.txt") + (if USE-SPN-RANGE + (begin + (csym::sprintf timeFile "time3-%02d_%d-%d.csv" (fref option num-thrs) (fref this th) (fref this spawnSize)) + (csym::sprintf taskFile "task3-%02d_%d-%d.csv" (fref option num-thrs) (fref this th) (fref this spawnSize)) + (csym::sprintf lockFile "lock3-%02d_%d-%d.csv" (fref option num-thrs) (fref this th) (fref this spawnSize)) + (csym::sprintf copyFile "copy3-%02d_%d-%d.csv" (fref option num-thrs) (fref this th) (fref this spawnSize))) + (begin + (if USE-SPN-RATIO + (begin + (csym::sprintf timeFile "time3-%02d_%d_%d.csv" (fref option num-thrs) (fref this th) (fref this spawnSize)) + (csym::sprintf taskFile "task3-%02d_%d_%d.csv" (fref option num-thrs) (fref this th) (fref this spawnSize)) + (csym::sprintf lockFile "lock3-%02d_%d_%d.csv" (fref option num-thrs) (fref this th) (fref this spawnSize)) + (csym::sprintf copyFile "copy3-%02d_%d_%d.csv" (fref option num-thrs) (fref this th) (fref this spawnSize))) + (begin + (csym::sprintf timeFile "time3-%02d_%d-half.csv" (fref option num-thrs) (fref this th)) + (csym::sprintf taskFile "task3-%02d_%d-half.csv" (fref option num-thrs) (fref this th)) + (csym::sprintf lockFile "lock3-%02d_%d-half.csv" (fref option num-thrs) (fref this th)) + (csym::sprintf copyFile "copy3-%02d_%d-half.csv" (fref option num-thrs) (fref this th)))))) + + ;; set ID + (= (fref tsk minID) 0) + (= (fref tsk maxID) -1) + + ;; init pthread + ;(csym::pthread_attr_init (ptr attr)) + ;(csym::pthread_attr_setdetachstate (ptr attr) PTHREAD_CREATE_JOINABLE) + + ;; initialize Edge Data & Vertex Data & Debug Data + (initData (ptr edgeMax) (ptr minVertex) (ptr maxVertex) (ptr maxNumItems) (ptr eHash) (ptr iHash)) + + ;; load graph file + (loadGraphFile graphFile (ptr edgeMax) (ptr minVertex) (ptr maxVertex) (ptr eHash)) + + ;; load pattern file + (loadPatternFile patternFile (ptr maxNumItems) (ptr eHash) (ptr iHash)) + + ;; delete the vertex whose # of items is less than the user-specified threshold + (thresholdItem minVertex maxVertex) + + ;; set the range of enumCCIG loop + (= loopRange (cast int (/ (- (+ maxVertex 1) minVertex) (fref this loopRatio)))) + + ;; set the range of resetTaskID loop + ;(for ((= i 0) (< i (fref option num-thrs)) (inc i)) + ; (= (fref (aref data i) loopStart) (* (/ (- maxVertex minVertex) (fref option num-thrs)) i)) + ; (= (fref (aref data i) loopEnd) (* (/ (- maxVertex minVertex) (fref option num-thrs)) (+ i 1)))) + + ;; init T-exploreCCIG + (initExploreCCIG NULL NULL NULL NULL (ptr tsk)) + + ;; init mutex + (for ((= i 0) (< i V-SIZE) (inc i)) + (csym::pthread_mutex_init (ptr (aref mutex i)) NULL)) + (= inited 1) + + ;; open task file + (%if* DEBUG-TASK (begin + (if (== (= fpTask (csym::fopen taskFile "w")) NULL) + (begin + (csym::fprintf stderr "Cannot open task file: %s~%" taskFile) + (exit EXIT-FAILURE))))) + + ;; open lock file + (%if* DEBUG-LOCK (begin + (if (== (= fpLock (csym::fopen lockFile "w")) NULL) + (begin + (csym::fprintf stderr "Cannot open lock file: %s~%" lockFile) + (exit EXIT-FAILURE))))) + + ;; open copy file + (%if* DEBUG-COPY (begin + (if (== (= fpCopy (csym::fopen copyFile "w")) NULL) + (begin + (csym::fprintf stderr "Cannot open copy file: %s~%" copyFile) + (exit EXIT-FAILURE))))) + + ;; get start time of program + (= t1 (csym::getrusageSec)) + (csym::gettimeofday (ptr t0) 0) + (csym::gettimeofday tp 0) + + ;; enumerate CCIG + (= i minVertex) + (for ((< (+ i loopRange) maxVertex) (+= i loopRange)) + (enumCCIG i (+ i loopRange) (ptr tsk)) + + (for ((= k minVertex) (< k (+ maxVertex 1)) (inc k)) + (= ITptr (fref (fref (aref vItemTable k) head) -> next)) + (while (!= ITptr (fref (aref vItemTable k) head)) + (= (fref ITptr -> minID) (cast task-id 0)) + (= (fref ITptr -> maxID) (cast task-id 0)) + (= ITptr (fref ITptr -> next)))) + + ;; re-set ID + (= (fref tsk minID) 0) + (= (fref tsk maxID) -1)) + (enumCCIG i (+ maxVertex 1) (ptr tsk)) + + ;(for ((= j 1) (< j (fref this loopRatio)) (inc j)) + ; (enumCCIG i (+ i loopRange) (ptr tsk)) + + ; ;(for ((= k 0) (< k (fref option num-thrs)) (inc k)) + ; ; (csym::pthread_create (ptr (aref resetThread k)) (ptr attr) resetTaskID (ptr (aref data k)))) + ; ;(for ((= k 0) (< k (fref option num-thrs)) (inc k)) + ; ; (csym::pthread_join (aref resetThread k) NULL)) + + ; (for ((= k minVertex) (< k (+ maxVertex 1)) (inc k)) + ; (= ITptr (fref (fref (aref vItemTable k) head) -> next)) + ; (while (!= ITptr (fref (aref vItemTable k) head)) + ; (= (fref ITptr -> minID) (cast task-id 0)) + ; (= (fref ITptr -> maxID) (cast task-id 0)) + ; (= ITptr (fref ITptr -> next)))) + + ; ;; re-set ID + ; (= (fref tsk minID) 0) + ; (= (fref tsk maxID) UINT-LEAST64-MAX) + + ; (+= i loopRange)) + ;(enumCCIG i (+ maxVertex 1) (ptr tsk)) + + ;; get end time of program + (csym::gettimeofday (+ tp 1) 0) + (= t2 (csym::getrusageSec)) + + ;; dispose of pthread & mutex & item table & hash tables + ;(csym::pthread_attr_destroy (ptr attr)) + (for ((= i 0) (< i V-SIZE) (inc i)) + (csym::pthread_mutex_destroy (ptr (aref mutex i))) + (csym::termITlist (ptr (aref vItemTable i)))) + (csym::free vItemTable) + (csym::hdestroy_r (ptr eHash)) + (csym::hdestroy_r (ptr iHash)) + + ;; close lock file + (%if* DEBUG-LOCK (begin + (csym::fclose fpLock))) + + ;; close copy file + (%if* DEBUG-COPY (begin + (csym::fclose fpCopy))) + + ;; close task file + (%if* DEBUG-TASK (begin + (csym::fprintf fpTask "%f, %f, %f, %llu, 0, %d~%" (csym::elapsedTime (ptr t0) tp) (csym::elapsedTime tp (+ tp 1)) (csym::elapsedTime (ptr t0) (+ tp 1)) (fref tsk numSearch) (fref -thr -> id)) + (csym::fclose fpTask))) + + (+= (aref visit2Vertices (fref -thr -> id)) (fref tsk numSearch)) + (+= (aref thresholdPruning (fref -thr -> id)) (fref tsk numThreshold)) + (+= (aref inclusivePruning (fref -thr -> id)) (fref tsk numPruning)) + (+= (aref tableReference (fref -thr -> id)) (fref tsk numTableReference)) + + (%if* DEBUG-TIME (begin + ;; open time file + (if (== (= fpt (csym::fopen timeFile "w")) NULL) + (begin + (csym::fprintf stderr "Cannot open time file: %s~%" timeFile) + (exit EXIT-FAILURE))) + + (for ((= i minVertex) (< i maxVertex) (inc i)) + (csym::fprintf fpt "%d, %f, %f, %d~%" i (csym::elapsedTime tp (+ (aref t i) 1)) (csym::elapsedTime (aref t i) (+ (aref t i) 1)) (aref doneID i))) + + ;; close time file + (csym::fclose fpt))) + + ;; debug mode + (%if* DEBUG-DATA (begin + (begin + (csym::fprintf stderr "~%----- Edge Data -----~%") + (for ((= i 0) (<= i edgeMax) (inc i)) + (csym::fprintf stderr "Edge %d: %d, %d~%" i (aref eTo i) (aref eNext i))) + (csym::fprintf stderr "~%----- Vertex Data -----~%") + (for ((= i minVertex) (<= i maxVertex) (inc i)) + (csym::fprintf stderr "Vertex %d: %d, %d, " i (aref vDegree i) (aref vFirstEdge i)) + (for ((= j (/ maxNumItems BIT-LEN)) (>= j 0) (dec j)) + (printBits (aref vItem i j))) + (csym::fprintf stderr ", %d~%" (aref vNumItems i))) + (csym::fprintf stderr "~%----- Subgraph List -----~%") + (= i 0) + (= Gptr (fref (fref (fref tsk subgraph) head) -> next)) + (while (!= Gptr (fref (fref tsk subgraph) head)) + ;; print vertices of CCIG + (csym::fprintf stderr "Subgraph %d:" i) + (for ((= j 0) (< j (fref Gptr -> numT)) (inc j)) + (csym::fprintf stderr " %d" (aref (fref Gptr -> T) j))) + (csym::fprintf stderr " ( ") + ;; print common itemset of CCIG + (for ((= j 0) (< j BIT-ITEM) (inc j)) + (csym::fprintDecimally stderr (aref (fref Gptr -> item) j) j)) + (inc i) + (= Gptr (fref Gptr -> next)) + (csym::fprintf stderr ")~%")) + (csym::fprintf stderr "~%") + (csym::fprintf stderr "edgeMax = %d, minVertex = %d, maxVertex = %d, maxNumItems = %d~%" edgeMax minVertex maxVertex maxNumItems)))) + + ;; output result file + (%if* DEBUG-RSLT (begin + (begin + ;; open result file + (if (== (= fp (csym::fopen resultFile "w")) NULL) + (begin + (csym::fprintf stderr "Cannot open result file: %s~%" resultFile) + (exit EXIT-FAILURE))) + (= Gptr (fref (fref (fref tsk subgraph) head) -> next)) + (while (!= Gptr (fref (fref tsk subgraph) head)) + ;; write vertices of CCIG to stream + (for ((= j 0) (< j (fref Gptr -> numT)) (inc j)) + (csym::fprintf fp "%d " (aref (fref Gptr -> T) j))) + (csym::fprintf fp "( ") + ;; write common itemset of CCIG to stream + (for ((= j 0) (< j BIT-ITEM) (inc j)) + (csym::fprintDecimally fp (aref (fref Gptr -> item) j) j)) + (= Gptr (fref Gptr -> next)) + (csym::fprintf fp ")~%")) + + ;; close result file + (csym::fclose fp)))) + + (%if* DEBUG-RSLT (begin + (= Gptr (fref (fref (fref tsk subgraph) head) -> next)) + (while (!= Gptr (fref (fref tsk subgraph) head)) + (+= avgSizeSubgraph (fref Gptr -> numT)) + (if (< maxSizeSubgraph (fref Gptr -> numT)) + (= maxSizeSubgraph (fref Gptr -> numT))) + (= Gptr (fref Gptr -> next))))) + + ;; show debug datas + (csym::fprintf stderr "time = %f[sec]~%" (csym::elapsedTime tp (+ tp 1))) + (csym::fprintf stderr "user time = %f[sec]~%" (- t2 t1)) + (csym::fprintf stderr "# of subgraphs = %d~%" (fref tsk numSubgraph)) + (csym::fprintf stderr "Avg. size of tree depth = %f~%" (/ (cast double (fref tsk treeDepth)) (cast double (fref tsk numTraversed)))) + (%if* DEBUG-RSLT (begin + (csym::fprintf stderr "Max size of subgraph = %d~%" maxSizeSubgraph) + (csym::fprintf stderr "Avg. size of subgraph = %f~%" (/ (cast double avgSizeSubgraph) (cast double (fref tsk numSubgraph)))))) + + (csym::fprintf stderr "~%# of searches & task-requests~%") + (for ((= j 0) (< j (fref option num-thrs)) (inc j)) + (= (aref searchSpace j) (+ (+ (aref visit2Vertices j) (aref thresholdPruning j)) ( +aref inclusivePruning j))) + (csym::fprintf stderr " ID:%d, %llu(%llu, %llu, %llu), %d/%d, %llu~%" j (aref searchSpace j) (aref visit2Vertices j) (aref thresholdPruning j) (aref inclusivePruning j) (aref taskRequest j) (aref seqTaskRequest j) (aref tableReference j)) + (+= numSearch (aref searchSpace j)) + (if (< maxWorkerSearch (aref searchSpace j)) + (= maxWorkerSearch (aref searchSpace j))) + (if (> minWorkerSearch (aref searchSpace j)) + (= minWorkerSearch (aref searchSpace j))) + (+= avgWorkerSearchPerSec (/ (aref searchSpace j) (csym::elapsedTime tp (+ tp 1)))) + (+= numTaskRequest (aref taskRequest j)) + (+= numSeqTaskRequest (aref seqTaskRequest j)) + (+= numAllTaskRequest (aref taskRequest j)) + (+= numAllTaskRequest (aref seqTaskRequest j)) + (+= numTableReference (aref tableReference j))) + (= avgWorkerSearch (/ (cast double numSearch) (cast double (fref option num-thrs)))) + (= avgWorkerSearchPerSec (/ avgWorkerSearchPerSec (cast double (fref option num-thrs)))) + (= avgTaskRequest (/ (cast double numTaskRequest) (cast double (fref option num-thrs)))) + (= avgSeqTaskRequest (/ (cast double numSeqTaskRequest) (cast double (fref option num-thrs)))) + (= avgAllTaskRequest (/ (cast double (+ numTaskRequest numSeqTaskRequest)) (cast double (fref option num-thrs)))) + (= avgTableReference (/ (cast double numTableReference) (cast double (fref option num-thrs)))) + + (for ((= j 0) (< j (fref option num-thrs)) (inc j)) + (+= workerSearchSD (csym::pow (- (aref searchSpace j) avgWorkerSearch) 2.0)) + (+= workerSearchPerSecSD (csym::pow (- (/ (aref searchSpace j) (csym::elapsedTime tp (+ tp 1))) avgWorkerSearchPerSec) 2.0)) + (+= taskRequestSD (csym::pow (- (aref taskRequest j) avgTaskRequest) 2.0)) + (+= seqTaskRequestSD (csym::pow (- (aref seqTaskRequest j) avgSeqTaskRequest) 2.0)) + (+= allTaskRequestSD (csym::pow (- (+ (aref taskRequest j) (aref seqTaskRequest j)) avgAllTaskRequest) 2.0)) + (+= tableReferenceSD (csym::pow (- (aref tableReference j) avgTableReference) 2.0))) + (/= workerSearchSD (fref option num-thrs)) + (/= workerSearchPerSecSD (fref option num-thrs)) + (/= taskRequestSD (fref option num-thrs)) + (/= seqTaskRequestSD (fref option num-thrs)) + (/= allTaskRequestSD (fref option num-thrs)) + (/= tableReferenceSD (fref option num-thrs)) + (= workerSearchSD (csym::sqrt workerSearchSD)) + (= workerSearchPerSecSD (csym::sqrt workerSearchPerSecSD)) + (= taskRequestSD (csym::sqrt taskRequestSD)) + (= seqTaskRequestSD (csym::sqrt seqTaskRequestSD)) + (= allTaskRequestSD (csym::sqrt allTaskRequestSD)) + (= tableReferenceSD (csym::sqrt tableReferenceSD)) + + (csym::fprintf stderr "# of searches = %llu, Min = %llu, Max = %llu, Avg. = %.1f, S.D. = %.1f~%" numSearch minWorkerSearch maxWorkerSearch avgWorkerSearch workerSearchSD) + (csym::fprintf stderr "# of task requests = %d, Avg. = %.1f, S.D. = %.1f~%" numTaskRequest avgTaskRequest taskRequestSD) + (csym::fprintf stderr "# of seq. task requests = %d, Avg. = %.1f, S.D. = %.1f~%" numSeqTaskRequest avgSeqTaskRequest seqTaskRequestSD) + (csym::fprintf stderr "# of all task requests = %d, Avg. = %.1f, S.D. = %.1f~%" numAllTaskRequest avgAllTaskRequest allTaskRequestSD) + (csym::fprintf stderr "# of searches / sec = %.1f, Avg. = %.1f, S.D. = %.1f~%" (/ numSearch (csym::elapsedTime tp (+ tp 1))) avgWorkerSearchPerSec workerSearchPerSecSD) + (csym::fprintf stderr "# of table references = %llu, Avg. = %.1f, S.D. = %.1f~%" numTableReference avgTableReference tableReferenceSD) + (csym::fprintf stderr "# of ITmutex trylock = %llu, " (fref tsk numMutexTrylock)) + (csym::fprintf stderr "# of ITmutex locked = %llu(%.3f%%)~%" (fref tsk numMutexLocked) (* (/ (cast double (fref tsk numMutexLocked)) (cast double (fref tsk numMutexTrylock))) 100.0))) \ No newline at end of file diff --git a/src/sample/tcell/sendrecv.c b/src/sample/tcell/sendrecv.c index af12aa87..9a3f0ac9 100644 --- a/src/sample/tcell/sendrecv.c +++ b/src/sample/tcell/sendrecv.c @@ -26,6 +26,7 @@ SUCH DAMAGE. #include #include +#include #include #include "sock.h" #include "sendrecv.h" @@ -48,6 +49,20 @@ int recv_int(void) return atoi(buf); } +/**/ +void send_longlong(long long int n) +{ + char buf[24]; + snprintf(buf, 24, "%lld\n", n); + send_string(buf, sv_socket); +} +long long int recv_longlong(void) +{ + char buf[24]; + receive_line(buf, 24, sv_socket); + return atoll(buf); +} + /**/ union int_4 { int i; diff --git a/src/sample/tcell/sendrecv.h b/src/sample/tcell/sendrecv.h index b85bd8a9..29aea10e 100644 --- a/src/sample/tcell/sendrecv.h +++ b/src/sample/tcell/sendrecv.h @@ -28,8 +28,14 @@ SUCH DAMAGE. #define INT32 int #endif +/**/ void send_int(int n); int recv_int(void); + +/**/ +void send_longlong(long long int n); +long long int recv_longlong(void); + /**/ int send_binary_header (int elmsize, /* size of an element */ int nelm ) /* number of elements */; diff --git a/src/sample/tcell/worker.sc b/src/sample/tcell/worker.sc index 628dbefb..74b3db0e 100644 --- a/src/sample/tcell/worker.sc +++ b/src/sample/tcell/worker.sc @@ -1840,6 +1840,9 @@ (def (set-option argc argv) (csym::fn void int (ptr (ptr char))) (def i int) (def ch int) + (decl fp (ptr FILE)) + (decl buf (array char 256)) + (decl command (ptr char)) ;; Default values (= option.sv-hostname 0) (= option.port 9865) @@ -1912,8 +1915,18 @@ (break) (case #\T) ; output time chart - (%if* PROFILE + (= command "hostname -s") + (if (== (= fp (csym::popen command "r")) NULL) + (begin + (csym::fprintf stderr "popen errer!~%") + (exit EXIT-FAILURE))) + (csym::fgets buf 256 fp) + (csym::strtok buf "~%") + (cast void (csym::pclose fp)) + + (%if* PROFILE (begin (= option.timechart-file optarg) + (csym::strcat option.timechart-file buf)) %else (csym::fprintf stderr "Warning: -T option is invalidated at compile-time.~%")) (break) From d1a736b7c349c93577c2fb8440c9b4ed524437e7 Mon Sep 17 00:00:00 2001 From: Tasuku HIRAISHI Date: Tue, 2 Jun 2015 22:19:51 +0900 Subject: [PATCH 038/105] Fixed a macro expansion bug in scpp.lsp --- src/scpp.lsp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/scpp.lsp b/src/scpp.lsp index bc7a87ad..0064dd74 100644 --- a/src/scpp.lsp +++ b/src/scpp.lsp @@ -350,6 +350,7 @@ (let ((*extracting-macro* (cons macsymbol *extracting-macro*))) (scpp-1exp (macroexpand-1 (cons macsymbol (cdr x))))) ;; Cons to which no macro can be applied. - (list (scpp-list x)))) + (let ((*extracting-macro* ())) + (list (scpp-list x))))) ;; Atom other than symbol (e.g., number string) (t (list x)))) From 1f0646126a14e661f2ec629745694c21186468a3 Mon Sep 17 00:00:00 2001 From: tasuku Date: Thu, 11 Jun 2015 14:38:50 +0900 Subject: [PATCH 039/105] Small fix to worker.sc and worker.sh --- src/sample/tcell/worker.sc | 2 +- src/sample/tcell/worker.sh | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/sample/tcell/worker.sc b/src/sample/tcell/worker.sc index 74b3db0e..a19533c8 100644 --- a/src/sample/tcell/worker.sc +++ b/src/sample/tcell/worker.sc @@ -43,7 +43,7 @@ (c-exp "#include") (c-exp "#include") (c-exp "#include") -(c-exp "#include") +(c-exp "#include") (%ifdef* USEMPI (c-exp "#include ")) (%cinclude "sock.h") diff --git a/src/sample/tcell/worker.sh b/src/sample/tcell/worker.sh index 34e72bdc..3a24678d 100644 --- a/src/sample/tcell/worker.sh +++ b/src/sample/tcell/worker.sh @@ -102,15 +102,15 @@ ;;; Arrays of task/result sender/receiver methods. ;;; Each method body is defined by a Tascell programmer or generated by Tascell compiler. -(decl task-doers +(extern-decl task-doers (array (ptr (fn void (ptr (struct thread-data)) (ptr void))) TASK-MAX)) -(decl task-senders +(extern-decl task-senders (array (ptr (csym::fn void (ptr void))) TASK-MAX)) -(decl task-receivers +(extern-decl task-receivers (array (ptr (csym::fn (ptr void))) TASK-MAX)) -(decl rslt-senders +(extern-decl rslt-senders (array (ptr (csym::fn void (ptr void))) TASK-MAX)) -(decl rslt-receivers +(extern-decl rslt-receivers (array (ptr (csym::fn void (ptr void))) TASK-MAX)) ;;;; NOTE: this functionality (on-demand data request) is incomplete now. From 914ea41700516b7b536123725615f38a4fd02c8f Mon Sep 17 00:00:00 2001 From: tasuku Date: Thu, 9 Jul 2015 15:06:55 +0900 Subject: [PATCH 040/105] Tascell: long type support for :in/:out task object members --- src/sample/tcell/sendrecv.c | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/src/sample/tcell/sendrecv.c b/src/sample/tcell/sendrecv.c index 9a3f0ac9..eaf4dd12 100644 --- a/src/sample/tcell/sendrecv.c +++ b/src/sample/tcell/sendrecv.c @@ -49,6 +49,20 @@ int recv_int(void) return atoi(buf); } +/**/ +void send_long(long n) +{ + char buf[16]; + snprintf (buf, 16, "%ld\n", n); + send_string (buf, sv_socket); +} +long recv_long(void) +{ + char buf[16]; + receive_line (buf, 16, sv_socket); + return atol(buf); +} + /**/ void send_longlong(long long int n) { From 88b4d4ca29330bc9f6c2dbeec298b7e49b527135 Mon Sep 17 00:00:00 2001 From: tasuku Date: Thu, 9 Jul 2015 15:13:21 +0900 Subject: [PATCH 041/105] fib.tcell: changed the type of the variable for the answer value int->long, and changed the settings for COUNT-NTASK and USE-PROBGUARD. --- src/sample/tcell/fib.tcell | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/src/sample/tcell/fib.tcell b/src/sample/tcell/fib.tcell index aaeca21c..06dca5ff 100644 --- a/src/sample/tcell/fib.tcell +++ b/src/sample/tcell/fib.tcell @@ -30,9 +30,9 @@ (c-exp "#include") ;; ワーカごとに処理したタスクの数をカウントして表示 -;; (%defconstant COUNT-NTASK 1) +(%defconstant COUNT-NTASK 0) ;; Probability guardを使う -(%defconstant USE-PROBGUARD 1) +(%defconstant USE-PROBGUARD 0) (%ifndef* NF-TYPE (%defconstant NF-TYPE GCC)) ; one of (GCC LW-SC CL-SC XCC XCCCL) @@ -51,16 +51,16 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(%ifdef* COUNT-NTASK +(%if* COUNT-NTASK (def worker-data - (def n-task int)) + (def n-task long)) (def worker-init (= WDATA.n-task 0)) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(def N0 int 0) +(def N0 long 0) (def (csym::my-probability n) (fn double int) (if (< n 20) (return (/ (cast double n) 20.0)) @@ -70,32 +70,32 @@ ; (return 0.0) ; (return 1.0))) -(decl (fib n) (wfn int int)) +(decl (fib n) (wfn long long)) (def (task fib) - (def n int :in) - (def r int :out)) + (def n long :in) + (def r long :out)) (def (task-body fib) ;;(csym::fprintf stderr "start fib(%d)~%" (fref this n)) - (%ifdef* COUNT-NTASK + (%if* COUNT-NTASK (++ WDATA.n-task) (csym::fprintf stderr "%d starts %d-th task.~%" WORKER-ID WDATA.n-task)) - (%ifdef* USE-PROBGUARD + (%if* USE-PROBGUARD (= PROBABILITY (csym::my-probability this.n))) (= this.r (fib this.n)) ) (def (task fib-start) - (def n int :in) - (def r int :out)) + (def n long :in) + (def r long :out)) (def (task-body fib-start) (decl tp (array (struct timeval) 2)) - (csym::fprintf stderr "start fib(%d)~%" this.n) - (%ifdef* COUNT-NTASK + (csym::fprintf stderr "start fib(%ld)~%" this.n) + (%if* COUNT-NTASK (++ WDATA.n-task) - (csym::fprintf stderr "%d starts %d-th task.~%" WORKER-ID WDATA.n-task)) + (csym::fprintf stderr "%d starts %ld-th task.~%" WORKER-ID WDATA.n-task)) (= N0 this.n) (csym::gettimeofday tp 0) (= this.r (fib this.n)) @@ -118,18 +118,18 @@ ;;(csym::fprintf stderr "receive fib(%d)=%d~%" this.n this.r) ) -(def (fib n) (wfn int int) +(def (fib n) (wfn long long) (if (<= n 2) (return 1) (begin - (def s1 int) - (def s2 int) + (def s1 long) + (def s2 long) (do-two (= s1 (fib (- n 1))) (= s2 (fib (- n 2))) (handles fib (:put - (%ifdef* USE-PROBGUARD + (%if* USE-PROBGUARD (= PROBABILITY (csym::my-probability (- n 2)))) (= this.n (- n 2))) (:get (= s2 this.r)))) From 56754cd2ef0e8c32d91ee7ccc048eb71186cd8cb Mon Sep 17 00:00:00 2001 From: tasuku Date: Thu, 9 Jul 2015 15:14:58 +0900 Subject: [PATCH 042/105] nq,pen6x17.tcell: changed the settings for USE-PROBGUARD --- src/sample/tcell/nq.tcell | 4 ++-- src/sample/tcell/pen6x17.tcell | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/sample/tcell/nq.tcell b/src/sample/tcell/nq.tcell index 21f113b7..fc718eee 100644 --- a/src/sample/tcell/nq.tcell +++ b/src/sample/tcell/nq.tcell @@ -38,7 +38,7 @@ ;; Use "user defined spawned range" (%defconstant USE-SPN-RANGE 0) ;; Use "Probability guard" -(%defconstant USE-PROBGUARD 1) +(%defconstant USE-PROBGUARD 0) (def (csym::my-probability n k) (fn double int int) (if (>= k 2) @@ -149,7 +149,7 @@ (def k int this.k) (decl tp (array (struct timeval) 2)) (if (> option.verbose 0) (csym::fprintf stderr "start %d %d %d %d~%" n k this.i1 this.i2)) - (%ifdef* USE-PROBGUARD + (%if* USE-PROBGUARD (= PROBABILITY (csym::my-probability n k))) (if (< k 0) (begin diff --git a/src/sample/tcell/pen6x17.tcell b/src/sample/tcell/pen6x17.tcell index 7f3e444a..61b8c445 100644 --- a/src/sample/tcell/pen6x17.tcell +++ b/src/sample/tcell/pen6x17.tcell @@ -37,7 +37,7 @@ (%defconstant ASIZE 20) (%defconstant BSIZE 119) -(%defconstant USE-PROBABILITY 1) +(%defconstant USE-PROBABILITY 0) (def (pen-probability j maxp) (fn double int int) @@ -77,7 +77,7 @@ (def maxp int this.maxp) (def maxk int this.maxk) (DEBUG-PRINT 1 "start %d %d %d %d %d %d~%" k i0 i1 i2 maxp maxk) - (%ifdef* USE-PROBABILITY + (%if* USE-PROBABILITY (= PROBABILITY (pen-probability i0 maxp))) (= this.r (search k i0 i1 i2 maxp maxk (ptr this))) (DEBUG-PRINT 1 "end %d~%" this.r)) @@ -120,7 +120,7 @@ (for ((< kk BSIZE) (inc kk)) (if (== (aref pen.b kk) 0) (= (aref pen.b kk) #\*))) (= pen.maxp maxp) - (%ifdef* USE-PROBABILITY + (%if* USE-PROBABILITY (= PROBABILITY 1.0)) (csym::gettimeofday tp 0) (= this.r (search 0 0 0 maxp maxp pen.maxk (ptr pen))) @@ -267,7 +267,7 @@ ;; put/get pentomino task/result (handles pentomino (:put from i1 to i2 - (%ifdef* USE-PROBABILITY + (%if* USE-PROBABILITY (= PROBABILITY (pen-probability j0 maxp))) (= this (mref tsk)) (= this.k k) From 073b5726342befacc6038643572253517c686dc6 Mon Sep 17 00:00:00 2001 From: tasuku Date: Thu, 9 Jul 2015 16:06:32 +0900 Subject: [PATCH 043/105] Added Tascell test programs using the exception handling mechanism. --- src/sample/tcell/Makefile | 6 +- src/sample/tcell/fib-thr.tcell | 151 +++++++++++++++ src/sample/tcell/fib-try.tcell | 137 ++++++++++++++ src/sample/tcell/nq-thr.tcell | 180 ++++++++++++++++++ src/sample/tcell/nq-try.tcell | 171 +++++++++++++++++ src/sample/tcell/pen6x17-thr.tcell | 294 +++++++++++++++++++++++++++++ src/sample/tcell/pen6x17-try.tcell | 281 +++++++++++++++++++++++++++ 7 files changed, 1217 insertions(+), 3 deletions(-) create mode 100644 src/sample/tcell/fib-thr.tcell create mode 100644 src/sample/tcell/fib-try.tcell create mode 100644 src/sample/tcell/nq-thr.tcell create mode 100644 src/sample/tcell/nq-try.tcell create mode 100644 src/sample/tcell/pen6x17-thr.tcell create mode 100644 src/sample/tcell/pen6x17-try.tcell diff --git a/src/sample/tcell/Makefile b/src/sample/tcell/Makefile index e98ff53d..413e8af6 100644 --- a/src/sample/tcell/Makefile +++ b/src/sample/tcell/Makefile @@ -5,7 +5,7 @@ SC2C=sc2c SC2C_OPT= # SC2C_OPT+=-m # don't remove intermediate files # SC2C_OPT+=-D DEBUG=0 # invalidate debugging code -# SC2C_OPT+=-D PROFILE=1 # validate profiling +SC2C_OPT+=-D PROFILE=1 # validate profiling # Command for XC Cube (an extended GCC that supports L-Closures and Closures) XCC=xcc # Command for gcc @@ -13,7 +13,7 @@ GCC=gcc #$(XCC) # Command for Intel C Compiler ICC=icc # Optimization options for C Compilers -OPT=-O3 -g -msse4.2$(MOPT) +OPT=-O3 -g $(MOPT) # Keyword for L-Closures and Closures in XC Cube. Don't modify. XCCOPT=-DCT=lightweight @@ -47,7 +47,7 @@ endif # icc-c, icc-lw, and icc-clos} # By default, this Makefile makes all ALL_PROGS. You can make just one of targets by specifying the target file name, # (e.g., "make fib-gcc") -APPS=fib fib-guard fib-excep lu cmp pen pen-excep pen6x17 pen6x17-guard nq grav matmul spanning bcast copine0 copine1 copine2 copine3 copine4 copine0d copine1d copine3d +APPS=fib fib-guard fib-try fib-thr lu cmp pen pen-excep pen6x17 pen6x17-guard pen6x17-try pen6x17-thr nq nq-try nq-thr grav matmul spanning bcast copine0 copine1 copine2 copine3 copine4 copine0d copine1d copine3d C_PROGS=$(addsuffix -c,$(APPS)) GCC_PROGS=$(addsuffix -gcc,$(APPS)) diff --git a/src/sample/tcell/fib-thr.tcell b/src/sample/tcell/fib-thr.tcell new file mode 100644 index 00000000..3dbccfc7 --- /dev/null +++ b/src/sample/tcell/fib-thr.tcell @@ -0,0 +1,151 @@ +;;; Copyright (c) 2008 Tasuku Hiraishi +;;; All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: +;;; 1. Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. +;;; 2. Redistributions in binary form must reproduce the above copyright +;;; notice, this list of conditions and the following disclaimer in the +;;; documentation and/or other materials provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND +;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE +;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +;;; SUCH DAMAGE. + +;;; Fibonacci + +;; task 0 0 0 1 +;; +;; + +(c-exp "#include") + +;; ワーカごとに処理したタスクの数をカウントして表示 +(%defconstant COUNT-NTASK 0) +;; Probability guardを使う +(%defconstant USE-PROBGUARD 0) + +(%ifndef* NF-TYPE + (%defconstant NF-TYPE GCC)) ; one of (GCC LW-SC CL-SC XCC XCCCL) +(%include "rule/tcell-setrule.sh") + +(%include "clib.sh") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(def (csym::elapsed-time tp) + (fn double (array (struct timeval) 2)) + (return (+ (- (fref (aref tp 1) tv-sec) + (fref (aref tp 0) tv-sec)) + (* 0.000001 + (- (fref (aref tp 1) tv-usec) + (fref (aref tp 0) tv-usec)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(%if* COUNT-NTASK + (def worker-data + (def n-task long)) + (def worker-init + (= WDATA.n-task 0)) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def N0 long 0) +(def (csym::my-probability n) (fn double int) + (if (< n 20) + (return (/ (cast double n) 20.0)) + (return 1.0))) + ; threshold based probability + ; (if (< n 20) + ; (return 0.0) + ; (return 1.0))) + +(decl (fib n) (wfn long long)) + +(def (task fib) + (def n long :in) + (def r long :out)) + +(def (task-body fib) + ;;(csym::fprintf stderr "start fib(%d)~%" (fref this n)) + (%if* COUNT-NTASK + (++ WDATA.n-task) + (csym::fprintf stderr "%d starts %d-th task.~%" WORKER-ID WDATA.n-task)) + (%if* USE-PROBGUARD + (= PROBABILITY (csym::my-probability this.n))) + (= this.r (fib this.n)) + ) + +(def Threshold long) +(def Tp (array (struct timeval) 2)) +(def (task fib-start) + (def n long :in) + (def threshold long :in) + (def r long :out)) + +(def (task-body fib-start) + (decl tp (array (struct timeval) 2)) + (csym::fprintf stderr "start fib(%ld)~%" this.n) + (%if* COUNT-NTASK + (++ WDATA.n-task) + (csym::fprintf stderr "%d starts %ld-th task.~%" WORKER-ID WDATA.n-task)) + (= N0 this.n) + (= Threshold (/ (* 20365011074 this.threshold) 100)) + (csym::fprintf stderr "Threshold: %ld %ld~%" this.threshold Threshold) + (csym::gettimeofday tp 0) + (= (aref Tp 0) (aref tp 0)) + (catch 1 + (= this.r 1) + (fib this.n) + (= this.r 0)) + (csym::gettimeofday (+ tp 1) 0) + (csym::fprintf stderr "time: %lf~%" (csym::elapsed-time tp))) + +(def (task-receiver fib) + ;;(csym::fprintf stderr "receive %d~%" this.n) + ) + +(def (task-sender fib) + ;;(csym::fprintf stderr "send %d~%" this.n) + ) + +(def (rslt-sender fib) + ;;(csym::fprintf stderr "send fib(%d)=%d~%" this.n this.r) + ) + +(def (rslt-receiver fib) + ;;(csym::fprintf stderr "receive fib(%d)=%d~%" this.n this.r) + ) + +(def (fib n) (wfn long long) + (if (<= n 2) + (return 1) + (begin + (def s1 long) + (def s2 long) + (do-two + (= s1 (fib (- n 1))) + (= s2 (fib (- n 2))) + (handles fib + (:put + (%if* USE-PROBGUARD + (= PROBABILITY (csym::my-probability (- n 2)))) + (= this.n (- n 2))) + (:get (= s2 this.r)))) + (if (> (+ s1 s2) Threshold) + (begin + (csym::gettimeofday (+ Tp 1) 0) + (csym::fprintf stderr "etime: %lf~%s=%ld~%" (csym::elapsed-time Tp) (+ s1 s2)) + (throw 1))) + (return (+ s1 s2))))) diff --git a/src/sample/tcell/fib-try.tcell b/src/sample/tcell/fib-try.tcell new file mode 100644 index 00000000..ac5bb3ba --- /dev/null +++ b/src/sample/tcell/fib-try.tcell @@ -0,0 +1,137 @@ +;;; Copyright (c) 2008 Tasuku Hiraishi +;;; All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: +;;; 1. Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. +;;; 2. Redistributions in binary form must reproduce the above copyright +;;; notice, this list of conditions and the following disclaimer in the +;;; documentation and/or other materials provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND +;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE +;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +;;; SUCH DAMAGE. + +;;; Fibonacci + +;; task 0 0 0 0 +;; + +(c-exp "#include") + +;; ワーカごとに処理したタスクの数をカウントして表示 +(%defconstant COUNT-NTASK 0) +;; Probability guardを使う +(%defconstant USE-PROBGUARD 0) + +(%ifndef* NF-TYPE + (%defconstant NF-TYPE GCC)) ; one of (GCC LW-SC CL-SC XCC XCCCL) +(%include "rule/tcell-setrule.sh") + +(%include "clib.sh") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(def (csym::elapsed-time tp) + (fn double (array (struct timeval) 2)) + (return (+ (- (fref (aref tp 1) tv-sec) + (fref (aref tp 0) tv-sec)) + (* 0.000001 + (- (fref (aref tp 1) tv-usec) + (fref (aref tp 0) tv-usec)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(%if* COUNT-NTASK + (def worker-data + (def n-task long)) + (def worker-init + (= WDATA.n-task 0)) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def N0 long 0) +(def (csym::my-probability n) (fn double int) + (if (< n 20) + (return (/ (cast double n) 20.0)) + (return 1.0))) + ; threshold based probability + ; (if (< n 20) + ; (return 0.0) + ; (return 1.0))) + +(decl (fib n) (wfn long long)) + +(def (task fib) + (def n long :in) + (def r long :out)) + +(def (task-body fib) + ;;(csym::fprintf stderr "start fib(%d)~%" (fref this n)) + (%if* COUNT-NTASK + (++ WDATA.n-task) + (csym::fprintf stderr "%d starts %d-th task.~%" WORKER-ID WDATA.n-task)) + (%if* USE-PROBGUARD + (= PROBABILITY (csym::my-probability this.n))) + (= this.r (fib this.n)) + ) + +(def (task fib-start) + (def n long :in) + (def r long :out)) + +(def (task-body fib-start) + (decl tp (array (struct timeval) 2)) + (csym::fprintf stderr "start fib(%ld)~%" this.n) + (%if* COUNT-NTASK + (++ WDATA.n-task) + (csym::fprintf stderr "%d starts %ld-th task.~%" WORKER-ID WDATA.n-task)) + (= N0 this.n) + (csym::gettimeofday tp 0) + (= this.r (fib this.n)) + (csym::gettimeofday (+ tp 1) 0) + (csym::fprintf stderr "time: %lf~%" (csym::elapsed-time tp))) + +(def (task-receiver fib) + ;;(csym::fprintf stderr "receive %d~%" this.n) + ) + +(def (task-sender fib) + ;;(csym::fprintf stderr "send %d~%" this.n) + ) + +(def (rslt-sender fib) + ;;(csym::fprintf stderr "send fib(%d)=%d~%" this.n this.r) + ) + +(def (rslt-receiver fib) + ;;(csym::fprintf stderr "receive fib(%d)=%d~%" this.n this.r) + ) + +(def (fib n) (wfn long long) + (catch 1 ; meaningless catch for performance evaluation + (if (<= n 2) + (return 1) + (begin + (def s1 long) + (def s2 long) + (do-two + (= s1 (fib (- n 1))) + (= s2 (fib (- n 2))) + (handles fib + (:put + (%if* USE-PROBGUARD + (= PROBABILITY (csym::my-probability (- n 2)))) + (= this.n (- n 2))) + (:get (= s2 this.r)))) + (return (+ s1 s2))))) ) diff --git a/src/sample/tcell/nq-thr.tcell b/src/sample/tcell/nq-thr.tcell new file mode 100644 index 00000000..eea02cbe --- /dev/null +++ b/src/sample/tcell/nq-thr.tcell @@ -0,0 +1,180 @@ +;;; Copyright (c) 2008 Tasuku Hiraishi +;;; All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: +;;; 1. Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. +;;; 2. Redistributions in binary form must reproduce the above copyright +;;; notice, this list of conditions and the following disclaimer in the +;;; documentation and/or other materials provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND +;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE +;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +;;; SUCH DAMAGE. + +;;; Find all the solutions of the n-queen problem + +;; task 0 0 0 0 +;; +;; - + +(c-exp "#include") + +(%include "rule/tcell-setrule.sh") +(%include "clib.sh") +(%include "dprint.sh") +(%cinclude "sendrecv.h" (:macro)) + +;; Use "user defined spawned range" +(%defconstant USE-SPN-RANGE 0) +;; Use "Probability guard" +(%defconstant USE-PROBGUARD 0) + +(def (csym::my-probability n k) (fn double int int) + (if (>= k 2) + (return (/ (cast double (- n (+ k 1))) (cast double (- n 2)))) + (return 1.0))) + ; constant probability + ; (if (>= k 2) + ; (return (/ 1.0 16.0)) + ; (return 1.0))) + ; threshold based probability + ; (if (>= k 2) + ; (return 0.0) + ; (return 1.0))) + +(def (csym::elapsed-time tp) + (fn double (array (struct timeval) 2)) + (return (+ (- (fref (aref tp 1) tv-sec) + (fref (aref tp 0) tv-sec)) + (* 0.000001 + (- (fref (aref tp 1) tv-usec) + (fref (aref tp 0) tv-usec)))))) + +;;; thread local strogae +(def Threshold int) +(def Tp (array (struct timeval) 2)) +(def (task nqueens) + (def r int :out) ; （部分）解の数 + (def n int :in) ; 問題サイズ + (def k int :in) ; 初期化->探索開始(k<0) or 部分探索開始かのフラグ(>=0) + (def i1 int) ; 探索範囲 start + (def i2 int) ; 探索範囲 end + (def a (array int 20)) ; 使用済み行の管理 + (def lb (array int 40)) ; 盤面情報1 + (def rb (array int 40)) ; 盤面情報2 + ) + +(def (task-sender nqueens) + (def i int 0) + (if (>= this.k 0) + (begin + (csym::send-int this.i1) + (csym::send-int this.i2) + (for ((= i 0) (< i this.n) (inc i)) + (csym::send-int (aref this.a i))) + (for ((= i 0) (< i (- (* 2 this.n) 1)) (inc i)) + (csym::send-int (aref this.lb i))) + (for ((= i 0) (< i (- (* 2 this.n) 1)) (inc i)) + (csym::send-int (aref this.rb i))))) + ) + +(def (task-receiver nqueens) + (def i int 0) + (if (>= this.k 0) + (begin + (= this.i1 (csym::recv-int)) + (= this.i2 (csym::recv-int)) + (for ((= i 0) (< i this.n) (inc i)) + (= (aref this.a i) (csym::recv-int))) + (for ((= i 0) (< i (- (* 2 this.n) 1)) (inc i)) + (= (aref this.lb i) (csym::recv-int))) + (for ((= i 0) (< i (- (* 2 this.n) 1)) (inc i)) + (= (aref this.rb i) (csym::recv-int))) + ))) + + +;; k: a[j] (0a i)) + ;; 駒が置けるかチェック + (if (not (or (aref tsk->lb (+ n -1 (- ai) k)) + (aref tsk->rb (+ ai k)))) + (begin + (if (== k (- n 1)) (inc s) + (begin + (dynamic-wind + (:before + (= (aref tsk->lb (+ n -1 (- ai) k)) 1) + (= (aref tsk->rb (+ ai k)) 1) + (= (aref tsk->a i) (aref tsk->a k)) + (= (aref tsk->a k) ai)) + (:body + (+= s (nqueens n (+ k 1) (+ k 1) n tsk))) + (:after + (= (aref tsk->lb (+ n -1 (- ai) k)) 0) + (= (aref tsk->rb (+ ai k)) 0) + (= ai (aref tsk->a k)) + (= (aref tsk->a k) (aref tsk->a i)) + (= (aref tsk->a i) ai))))))) + (handles nqueens + (%if* USE-SPN-RANGE + (:spawn-from (+ i 3))) + (:put from i1 to i2 + (%if* USE-PROBGUARD + (= PROBABILITY (csym::my-probability n k))) + (= this (mref tsk)) + (= this.k k) + (= this.i1 i1) + (= this.i2 i2)) + (:get (+= s this.r)))) + (if (> s Threshold) + (begin + (csym::gettimeofday (+ Tp 1) 0) + (csym::fprintf stderr "etime: %lf~%s=%ld~%" (csym::elapsed-time Tp) s) + (throw 1))) + (return s)) + +(def (task-body nqueens) + (def i int) + (def n int this.n) + (def k int this.k) + (decl tp (array (struct timeval) 2)) + (if (> option.verbose 0) (csym::fprintf stderr "start %d %d %d %d~%" n k this.i1 this.i2)) + (%if* USE-PROBGUARD + (= PROBABILITY (csym::my-probability n k))) + (if (< k 0) + (begin + (= Threshold (/ (* (cast long 95815104) (- this.k)) 100)) ; 95815104 = Nq(17) + (csym::fprintf stderr "Threshold: %ld %ld~%" (- this.k) Threshold) + (for ((= i 0) (< i n) (inc i)) + (= (aref this.a i) i)) + (for ((= i 0) (< i (- (* 2 n) 1)) (inc i)) + (= (aref this.lb i) 0) + (= (aref this.rb i) 0)) + (csym::gettimeofday tp 0) + (= (aref Tp 0) (aref tp 0)) + (catch 1 + (= this.r 1) + (nqueens n 0 0 n (ptr this)) + (= this.r 0)) + (csym::gettimeofday (+ tp 1) 0) + (csym::fprintf stderr "time: %lf~%" (csym::elapsed-time tp))) + (= this.r + (nqueens n k this.i1 this.i2 (ptr this)))) + (DEBUG-PRINT 1 "end %d %d %d %d~%" k n this.i1 this.i2) + ) diff --git a/src/sample/tcell/nq-try.tcell b/src/sample/tcell/nq-try.tcell new file mode 100644 index 00000000..c4752b89 --- /dev/null +++ b/src/sample/tcell/nq-try.tcell @@ -0,0 +1,171 @@ +;;; Copyright (c) 2008 Tasuku Hiraishi +;;; All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: +;;; 1. Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. +;;; 2. Redistributions in binary form must reproduce the above copyright +;;; notice, this list of conditions and the following disclaimer in the +;;; documentation and/or other materials provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND +;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE +;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +;;; SUCH DAMAGE. + +;;; Find all the solutions of the n-queen problem + +;; task 0 0 0 0 +;; +;; -1 + +(c-exp "#include") + +(%include "rule/tcell-setrule.sh") +(%include "clib.sh") +(%include "dprint.sh") +(%cinclude "sendrecv.h" (:macro)) + +;; Use "user defined spawned range" +(%defconstant USE-SPN-RANGE 0) +;; Use "Probability guard" +(%defconstant USE-PROBGUARD 0) + +(def (csym::my-probability n k) (fn double int int) + (if (>= k 2) + (return (/ (cast double (- n (+ k 1))) (cast double (- n 2)))) + (return 1.0))) + ; constant probability + ; (if (>= k 2) + ; (return (/ 1.0 16.0)) + ; (return 1.0))) + ; threshold based probability + ; (if (>= k 2) + ; (return 0.0) + ; (return 1.0))) + +;;; thread local strogae +(def (task nqueens) + (def r int :out) ; （部分）解の数 + (def n int :in) ; 問題サイズ + (def k int :in) ; 初期化->探索開始(-1) or 部分探索開始かのフラグ(>=0) + (def i1 int) ; 探索範囲 start + (def i2 int) ; 探索範囲 end + (def a (array int 20)) ; 使用済み行の管理 + (def lb (array int 40)) ; 盤面情報1 + (def rb (array int 40)) ; 盤面情報2 + ) + +(def (task-sender nqueens) + (def i int 0) + (if (>= this.k 0) + (begin + (csym::send-int this.i1) + (csym::send-int this.i2) + (for ((= i 0) (< i this.n) (inc i)) + (csym::send-int (aref this.a i))) + (for ((= i 0) (< i (- (* 2 this.n) 1)) (inc i)) + (csym::send-int (aref this.lb i))) + (for ((= i 0) (< i (- (* 2 this.n) 1)) (inc i)) + (csym::send-int (aref this.rb i))))) + ) + +(def (task-receiver nqueens) + (def i int 0) + (if (>= this.k 0) + (begin + (= this.i1 (csym::recv-int)) + (= this.i2 (csym::recv-int)) + (for ((= i 0) (< i this.n) (inc i)) + (= (aref this.a i) (csym::recv-int))) + (for ((= i 0) (< i (- (* 2 this.n) 1)) (inc i)) + (= (aref this.lb i) (csym::recv-int))) + (for ((= i 0) (< i (- (* 2 this.n) 1)) (inc i)) + (= (aref this.rb i) (csym::recv-int))) + ))) + + +;; k: a[j] (0a i)) + ;; 駒が置けるかチェック + (if (not (or (aref tsk->lb (+ n -1 (- ai) k)) + (aref tsk->rb (+ ai k)))) + (begin + (if (== k (- n 1)) (inc s) + (begin + (dynamic-wind + (:before + (= (aref tsk->lb (+ n -1 (- ai) k)) 1) + (= (aref tsk->rb (+ ai k)) 1) + (= (aref tsk->a i) (aref tsk->a k)) + (= (aref tsk->a k) ai)) + (:body + (+= s (nqueens n (+ k 1) (+ k 1) n tsk))) + (:after + (= (aref tsk->lb (+ n -1 (- ai) k)) 0) + (= (aref tsk->rb (+ ai k)) 0) + (= ai (aref tsk->a k)) + (= (aref tsk->a k) (aref tsk->a i)) + (= (aref tsk->a i) ai))))))) + (handles nqueens + (%if* USE-SPN-RANGE + (:spawn-from (+ i 3))) + (:put from i1 to i2 + (%if* USE-PROBGUARD + (= PROBABILITY (csym::my-probability n k))) + (= this (mref tsk)) + (= this.k k) + (= this.i1 i1) + (= this.i2 i2)) + (:get (+= s this.r)))) + ) + (return s)) + + +(def (csym::elapsed-time tp) + (fn double (array (struct timeval) 2)) + (return (+ (- (fref (aref tp 1) tv-sec) + (fref (aref tp 0) tv-sec)) + (* 0.000001 + (- (fref (aref tp 1) tv-usec) + (fref (aref tp 0) tv-usec)))))) + +(def (task-body nqueens) + (def i int) + (def n int this.n) + (def k int this.k) + (decl tp (array (struct timeval) 2)) + (if (> option.verbose 0) (csym::fprintf stderr "start %d %d %d %d~%" n k this.i1 this.i2)) + (%if* USE-PROBGUARD + (= PROBABILITY (csym::my-probability n k))) + (if (< k 0) + (begin + (for ((= i 0) (< i n) (inc i)) + (= (aref this.a i) i)) + (for ((= i 0) (< i (- (* 2 n) 1)) (inc i)) + (= (aref this.lb i) 0) + (= (aref this.rb i) 0)) + (csym::gettimeofday tp 0) + (= this.r + (nqueens n 0 0 n (ptr this))) + (csym::gettimeofday (+ tp 1) 0) + (csym::fprintf stderr "time: %lf~%" (csym::elapsed-time tp))) + (= this.r + (nqueens n k this.i1 this.i2 (ptr this)))) + (DEBUG-PRINT 1 "end %d %d %d %d~%" k n this.i1 this.i2) + ) diff --git a/src/sample/tcell/pen6x17-thr.tcell b/src/sample/tcell/pen6x17-thr.tcell new file mode 100644 index 00000000..48f3c854 --- /dev/null +++ b/src/sample/tcell/pen6x17-thr.tcell @@ -0,0 +1,294 @@ +;;; Copyright (c) 2008 Tasuku Hiraishi +;;; All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: +;;; 1. Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. +;;; 2. Redistributions in binary form must reproduce the above copyright +;;; notice, this list of conditions and the following disclaimer in the +;;; documentation and/or other materials provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND +;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE +;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +;;; SUCH DAMAGE. + +;;; Find all the solutions of Pentomino puzzle + +;; task 0 0 0 1 +;; +;; + +(c-exp "#include") + +(%include "rule/tcell-setrule.sh") +(%include "clib.sh") +(%include "dprint.sh") +(%cinclude "sendrecv.h" (:macro)) + +(%defconstant ASIZE 20) +(%defconstant BSIZE 119) + +(%defconstant USE-PROBABILITY 0) + +(def (pen-probability j maxp) + (fn double int int) + (if (>= j 3) + (return (/ (cast double (- maxp j)) (cast double (- maxp 2)))) + (return 1.0))) + ; constant probability + ; (if (>= j 3) + ; (return (/ 1.0 16.0)) + ; (return 1.0))) + ; threshold based probability + ; (if (>= j 3) + ; (return 0.0) + ; (return 1.0))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(def (task pentomino) + (def r int :out) + (def k int :in) + (def i0 int :in) + (def i1 int :in) + (def i2 int :in) + (def maxp int :in) ; number of pieces + (def maxk int :in) ; the last empty cell + (def a (array int ASIZE) :in) + (def b (array int BSIZE) :in)) + +;; task/rslt-sender/receiver = default + +(decl (search k j0 j1 j2 maxp maxk tsk) (wfn int int int int int int int (ptr (struct pentomino)))) +(def (task-body pentomino) + (decl i int) + (def k int this.k) + (def i0 int this.i0) + (def i1 int this.i1) + (def i2 int this.i2) + (def maxp int this.maxp) + (def maxk int this.maxk) + (DEBUG-PRINT 1 "start %d %d %d %d %d %d~%" k i0 i1 i2 maxp maxk) + (%if* USE-PROBABILITY + (= PROBABILITY (pen-probability i0 maxp))) + (= this.r (search k i0 i1 i2 maxp maxk (ptr this))) + (DEBUG-PRINT 1 "end %d~%" this.r)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(def Threshold int) +(def Tp (array (struct timeval) 2)) +(def (task start-pentomino) + (def maxp int :in) ; number of pieces + (def threshold int :in) + (def r int :out)) + +(def (csym::elapsed-time tp) + (fn double (array (struct timeval) 2)) + (return (+ (- (fref (aref tp 1) tv-sec) + (fref (aref tp 0) tv-sec)) + (* 0.000001 + (- (fref (aref tp 1) tv-usec) + (fref (aref tp 0) tv-usec)))))) + +;; 新しい問題を解く +(def (task-body start-pentomino) + (decl tp (array (struct timeval) 2)) + (def pen (struct pentomino)) + (def maxp int this.maxp) + (def i int) + (def kk int) + (if (or (< maxp 0) (> maxp 20)) + (begin + (csym::fprintf stderr "maxp=%d: no more than 20 pieces~%" maxp) + (= maxp 12))) + (= Threshold (/ (* 1008576 this.threshold) 100)) + (csym::fprintf stderr "Threshold: %ld %ld~%" this.threshold Threshold) + (for ((= i 0) (< i ASIZE) (inc i)) (= (aref pen.a i) 0)) + (for ((= i 0) (< i maxp) (inc i)) (= (aref pen.a i) i)) + (for ((= i 0) (< i BSIZE) (inc i)) (= (aref pen.b i) 0)) + (for ((= i 6) (< i BSIZE) (+= i 7)) + (= (aref pen.b i) #\Newline)) ; right side wall + ;; piece数*5 個目より先の穴は埋める + (= kk 0) + (for ((= i 0) (< i (* maxp 5)) (inc i)) + (for ((inc kk) (< kk BSIZE) (inc kk)) (if (== (aref pen.b kk) 0) + (break)))) + (= pen.maxk kk) + (for ((< kk BSIZE) (inc kk)) (if (== (aref pen.b kk) 0) + (= (aref pen.b kk) #\*))) + (= pen.maxp maxp) + (%if* USE-PROBABILITY + (= PROBABILITY 1.0)) + (csym::gettimeofday tp 0) + (= (aref Tp 0) (aref tp 0)) + (catch 1 + (= this.r 1) + (search 0 0 0 maxp maxp pen.maxk (ptr pen)) + (= this.r 0)) + (csym::gettimeofday (+ tp 1) 0) + (fprintf stderr "time: %lf~%" (csym::elapsed-time tp))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(def ps (array int 73 5) + (array + (array 1 1 1 1) (array 7 7 7 7) ; ***** とその縦向き + (array 4 1 1 1) (array 7 7 6 1) ; * * + ; **** * + ; * + ; ** + (array 6 1 1 1) (array 5 1 1 1) (array 1 1 1 5) (array 1 1 1 6) + ;; * * **** **** + ;; **** **** * * + (array 7 1 6 7) (array 7 7 1 6) (array 7 6 1 7) (array 6 1 7 7) + ;; * * * * + ;; ** * * ** + ;; * ** ** * + ;; * * * * + (array 7 7 1 1) (array 1 1 5 7) (array 1 1 7 7) (array 7 5 1 1) + ;; * *** *** * + ;; * * * * + ;; *** * * *** + (array 2 5 1 1) (array 1 1 5 2) (array 1 6 7 1) (array 1 7 6 1) + ;; * * *** ** ** + ;; *** * * * * + ;; ** ** + (array 7 1 1 5) (array 5 1 1 7) (array 7 6 1 1) (array 1 1 6 7) + ;; * * * *** + ;; *** *** * * + ;; * * *** * + (array 7 1 1 6) (array 5 1 1 6) (array 6 1 1 5) (array 6 1 1 7) + ;; * * * * + ;; *** *** *** *** + ;; * * * * + (array 1 7 1 6) (array 7 1 5 1) (array 1 5 1 7) (array 6 1 7 1) + ;; ** * ** * + ;; ** ** ** ** + ;; * ** * ** + (array 7 1 1 7) (array 5 1 1 5) (array 1 7 7 1) (array 1 6 6 1) + ;; * * ** ** + ;; *** *** * * + ;; * * ** ** + (array 6 1 1 6) + ;; * + ;; *** + ;; * + (array 1 6 1 1) (array 1 1 5 1) (array 1 5 1 1) (array 1 1 6 1) + ;; ** *** ** *** + ;; *** ** *** ** + (array 7 1 6 1) (array 1 6 1 6) (array 6 1 6 1) (array 1 6 1 7) + ;; * ** * ** + ;; ** ** ** ** + ;; ** * ** * + (array 1 4 1 1) (array 1 1 7 1) (array 1 7 1 1) (array 1 1 4 1) + ;; ** *** ** *** + ;; *** ** *** ** + (array 7 1 7 7) (array 7 6 1 6) (array 6 1 6 7) (array 7 7 1 7) + ;; * * * * + ;; ** * ** * + ;; * ** * ** + ;; * * * * + (array 7 1 7 1) (array 1 5 1 6) (array 1 7 1 7) (array 6 1 5 1) + ;; * ** ** * + ;; ** ** ** ** + ;; ** * * ** + ;; ; extension + (array 1 1 1 1) (array 7 7 7 7) + (array 1 1 1 1) (array 7 7 7 7) + (array 1 1 1 1) (array 7 7 7 7) + (array 1 1 1 1) (array 7 7 7 7) + (array 1 1 1 1) (array 7 7 7 7) + (array 1 1 1 1) (array 7 7 7 7) + (array 1 1 1 1) (array 7 7 7 7) + (array 1 1 1 1) (array 7 7 7 7) + )) + +(def pos (array int 21) (array 0 2 4 12 16 20 24 32 36 37 45 53 57 + ;; extension + 59 61 63 65 67 69 71 73)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; k: 最初の空きセル +;; j0: +;; j1--j2: 試すビースの種類 +(def (search k j0 j1 j2 maxp maxk tsk) (wfn int int int int int int int (ptr (struct pentomino))) + (def s int 0) + (do-many for p from j1 to j2 + (def ap int (aref (fref (mref tsk) a) p)) + (def i int) + (for ((= i (aref pos ap)) (< i (aref pos (+ ap 1))) (inc i)) + ;; examine the "i"-th (piece, direction) + ;; at the first empty location "k" + (def pss (ptr int) (aref ps i)) + (def kk int k) (decl l int) + (for ((= l 0) (< l 4) (inc l)) + (if (or (>= (+= kk (aref pss l)) maxk) + (!= (aref (fref (mref tsk) b) kk) 0)) + (goto Ln))) + (dynamic-wind + (:before + (= (aref (fref (mref tsk) b) + (= kk k)) + (+ p #\A)) + (for ((= l 0) (< l 4) (inc l)) + (= (aref (fref (mref tsk) b) + (+= kk (aref pss l))) + (+ p #\A))) + (= (aref (fref (mref tsk) a) p) + (aref (fref (mref tsk) a) j0)) + (= (aref (fref (mref tsk) a) j0) ap) + (DEBUG-STMTS 2 + (if BACKTRACKING (csym::fprintf stderr "(worker %d) redoing~%" WORKER-ID))) + ) + (:body + (for ((= kk k) (< kk maxk) (inc kk)) + (if (== (aref (fref (mref tsk) b) kk) 0) (break))) + (if (== kk maxk) + (+= s 1) + (if (and (or (>= (+ kk 7) maxk) + (!= (aref (fref (mref tsk) b) (+ kk 7)) 0)) + (or (!= (aref (fref (mref tsk) b) (+ kk 1)) 0) + (and (or (>= (+ kk 8) maxk) + (!= (aref (fref (mref tsk) b) (+ kk 8)) 0)) + (!= (aref (fref (mref tsk) b) (+ kk 2)) 0)))) + () + (+= s (search kk (+ j0 1) (+ j0 1) maxp maxp maxk tsk))))) + (:after + (= ap (aref (fref (mref tsk) a) j0)) + (= (aref (fref (mref tsk) a) j0) (aref (fref (mref tsk) a) p)) + (= (aref (fref (mref tsk) a) p) ap) + (= (aref (fref (mref tsk) b) (= kk k)) 0) + (for ((= l 0) (< l 4) (inc l)) + (= (aref (fref (mref tsk) b) (+= kk (aref pss l))) 0)) + (DEBUG-STMTS 2 + (if BACKTRACKING (csym::fprintf stderr "(worker %d) temporary undoing~%" WORKER-ID))) + ) + ) + (label Ln (continue)) + ) + ;; put/get pentomino task/result + (handles pentomino + (:put from i1 to i2 + (%if* USE-PROBABILITY + (= PROBABILITY (pen-probability j0 maxp))) + (= this (mref tsk)) + (= this.k k) + (= this.i0 j0) + (= this.i1 i1) + (= this.i2 i2)) + (:get + (+= s this.r)))) + (if (> s Threshold) + (begin + (csym::gettimeofday (+ Tp 1) 0) + (csym::fprintf stderr "etime: %lf~%s=%ld~%" (csym::elapsed-time Tp) s) + (throw 1))) + (return s)) diff --git a/src/sample/tcell/pen6x17-try.tcell b/src/sample/tcell/pen6x17-try.tcell new file mode 100644 index 00000000..171fb542 --- /dev/null +++ b/src/sample/tcell/pen6x17-try.tcell @@ -0,0 +1,281 @@ +;;; Copyright (c) 2008 Tasuku Hiraishi +;;; All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: +;;; 1. Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. +;;; 2. Redistributions in binary form must reproduce the above copyright +;;; notice, this list of conditions and the following disclaimer in the +;;; documentation and/or other materials provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND +;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE +;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +;;; SUCH DAMAGE. + +;;; Find all the solutions of Pentomino puzzle + +;; task 0 0 0 1 +;; + +(c-exp "#include") + +(%include "rule/tcell-setrule.sh") +(%include "clib.sh") +(%include "dprint.sh") +(%cinclude "sendrecv.h" (:macro)) + +(%defconstant ASIZE 20) +(%defconstant BSIZE 119) + +(%defconstant USE-PROBABILITY 0) + +(def (pen-probability j maxp) + (fn double int int) + (if (>= j 3) + (return (/ (cast double (- maxp j)) (cast double (- maxp 2)))) + (return 1.0))) + ; constant probability + ; (if (>= j 3) + ; (return (/ 1.0 16.0)) + ; (return 1.0))) + ; threshold based probability + ; (if (>= j 3) + ; (return 0.0) + ; (return 1.0))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(def (task pentomino) + (def r int :out) + (def k int :in) + (def i0 int :in) + (def i1 int :in) + (def i2 int :in) + (def maxp int :in) ; number of pieces + (def maxk int :in) ; the last empty cell + (def a (array int ASIZE) :in) + (def b (array int BSIZE) :in)) + +;; task/rslt-sender/receiver = default + +(decl (search k j0 j1 j2 maxp maxk tsk) (wfn int int int int int int int (ptr (struct pentomino)))) +(def (task-body pentomino) + (decl i int) + (def k int this.k) + (def i0 int this.i0) + (def i1 int this.i1) + (def i2 int this.i2) + (def maxp int this.maxp) + (def maxk int this.maxk) + (DEBUG-PRINT 1 "start %d %d %d %d %d %d~%" k i0 i1 i2 maxp maxk) + (%if* USE-PROBABILITY + (= PROBABILITY (pen-probability i0 maxp))) + (= this.r (search k i0 i1 i2 maxp maxk (ptr this))) + (DEBUG-PRINT 1 "end %d~%" this.r)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(def (task start-pentomino) + (def maxp int :in) ; number of pieces + (def r int :out)) + +(def (csym::elapsed-time tp) + (fn double (array (struct timeval) 2)) + (return (+ (- (fref (aref tp 1) tv-sec) + (fref (aref tp 0) tv-sec)) + (* 0.000001 + (- (fref (aref tp 1) tv-usec) + (fref (aref tp 0) tv-usec)))))) + +;; 新しい問題を解く +(def (task-body start-pentomino) + (decl tp (array (struct timeval) 2)) + (def pen (struct pentomino)) + (def maxp int this.maxp) + (def i int) + (def kk int) + (if (or (< maxp 0) (> maxp 20)) + (begin + (csym::fprintf stderr "maxp=%d: no more than 20 pieces~%" maxp) + (= maxp 12))) + (for ((= i 0) (< i ASIZE) (inc i)) (= (aref pen.a i) 0)) + (for ((= i 0) (< i maxp) (inc i)) (= (aref pen.a i) i)) + (for ((= i 0) (< i BSIZE) (inc i)) (= (aref pen.b i) 0)) + (for ((= i 6) (< i BSIZE) (+= i 7)) + (= (aref pen.b i) #\Newline)) ; right side wall + ;; piece数*5 個目より先の穴は埋める + (= kk 0) + (for ((= i 0) (< i (* maxp 5)) (inc i)) + (for ((inc kk) (< kk BSIZE) (inc kk)) (if (== (aref pen.b kk) 0) + (break)))) + (= pen.maxk kk) + (for ((< kk BSIZE) (inc kk)) (if (== (aref pen.b kk) 0) + (= (aref pen.b kk) #\*))) + (= pen.maxp maxp) + (%if* USE-PROBABILITY + (= PROBABILITY 1.0)) + (csym::gettimeofday tp 0) + (= this.r (search 0 0 0 maxp maxp pen.maxk (ptr pen))) + (csym::gettimeofday (+ tp 1) 0) + (fprintf stderr "time: %lf~%" (csym::elapsed-time tp))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(def ps (array int 73 5) + (array + (array 1 1 1 1) (array 7 7 7 7) ; ***** とその縦向き + (array 4 1 1 1) (array 7 7 6 1) ; * * + ; **** * + ; * + ; ** + (array 6 1 1 1) (array 5 1 1 1) (array 1 1 1 5) (array 1 1 1 6) + ;; * * **** **** + ;; **** **** * * + (array 7 1 6 7) (array 7 7 1 6) (array 7 6 1 7) (array 6 1 7 7) + ;; * * * * + ;; ** * * ** + ;; * ** ** * + ;; * * * * + (array 7 7 1 1) (array 1 1 5 7) (array 1 1 7 7) (array 7 5 1 1) + ;; * *** *** * + ;; * * * * + ;; *** * * *** + (array 2 5 1 1) (array 1 1 5 2) (array 1 6 7 1) (array 1 7 6 1) + ;; * * *** ** ** + ;; *** * * * * + ;; ** ** + (array 7 1 1 5) (array 5 1 1 7) (array 7 6 1 1) (array 1 1 6 7) + ;; * * * *** + ;; *** *** * * + ;; * * *** * + (array 7 1 1 6) (array 5 1 1 6) (array 6 1 1 5) (array 6 1 1 7) + ;; * * * * + ;; *** *** *** *** + ;; * * * * + (array 1 7 1 6) (array 7 1 5 1) (array 1 5 1 7) (array 6 1 7 1) + ;; ** * ** * + ;; ** ** ** ** + ;; * ** * ** + (array 7 1 1 7) (array 5 1 1 5) (array 1 7 7 1) (array 1 6 6 1) + ;; * * ** ** + ;; *** *** * * + ;; * * ** ** + (array 6 1 1 6) + ;; * + ;; *** + ;; * + (array 1 6 1 1) (array 1 1 5 1) (array 1 5 1 1) (array 1 1 6 1) + ;; ** *** ** *** + ;; *** ** *** ** + (array 7 1 6 1) (array 1 6 1 6) (array 6 1 6 1) (array 1 6 1 7) + ;; * ** * ** + ;; ** ** ** ** + ;; ** * ** * + (array 1 4 1 1) (array 1 1 7 1) (array 1 7 1 1) (array 1 1 4 1) + ;; ** *** ** *** + ;; *** ** *** ** + (array 7 1 7 7) (array 7 6 1 6) (array 6 1 6 7) (array 7 7 1 7) + ;; * * * * + ;; ** * ** * + ;; * ** * ** + ;; * * * * + (array 7 1 7 1) (array 1 5 1 6) (array 1 7 1 7) (array 6 1 5 1) + ;; * ** ** * + ;; ** ** ** ** + ;; ** * * ** + ;; ; extension + (array 1 1 1 1) (array 7 7 7 7) + (array 1 1 1 1) (array 7 7 7 7) + (array 1 1 1 1) (array 7 7 7 7) + (array 1 1 1 1) (array 7 7 7 7) + (array 1 1 1 1) (array 7 7 7 7) + (array 1 1 1 1) (array 7 7 7 7) + (array 1 1 1 1) (array 7 7 7 7) + (array 1 1 1 1) (array 7 7 7 7) + )) + +(def pos (array int 21) (array 0 2 4 12 16 20 24 32 36 37 45 53 57 + ;; extension + 59 61 63 65 67 69 71 73)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; k: 最初の空きセル +;; j0: +;; j1--j2: 試すビースの種類 +(def (search k j0 j1 j2 maxp maxk tsk) (wfn int int int int int int int (ptr (struct pentomino))) + (def s int 0) + (catch 1 ; meaningless catch for performance evaluation + (do-many for p from j1 to j2 + (def ap int (aref (fref (mref tsk) a) p)) + (def i int) + (for ((= i (aref pos ap)) (< i (aref pos (+ ap 1))) (inc i)) + ;; examine the "i"-th (piece, direction) + ;; at the first empty location "k" + (def pss (ptr int) (aref ps i)) + (def kk int k) (decl l int) + (for ((= l 0) (< l 4) (inc l)) + (if (or (>= (+= kk (aref pss l)) maxk) + (!= (aref (fref (mref tsk) b) kk) 0)) + (goto Ln))) + (dynamic-wind + (:before + (= (aref (fref (mref tsk) b) + (= kk k)) + (+ p #\A)) + (for ((= l 0) (< l 4) (inc l)) + (= (aref (fref (mref tsk) b) + (+= kk (aref pss l))) + (+ p #\A))) + (= (aref (fref (mref tsk) a) p) + (aref (fref (mref tsk) a) j0)) + (= (aref (fref (mref tsk) a) j0) ap) + (DEBUG-STMTS 2 + (if BACKTRACKING (csym::fprintf stderr "(worker %d) redoing~%" WORKER-ID))) + ) + (:body + (for ((= kk k) (< kk maxk) (inc kk)) + (if (== (aref (fref (mref tsk) b) kk) 0) (break))) + (if (== kk maxk) + (+= s 1) + (if (and (or (>= (+ kk 7) maxk) + (!= (aref (fref (mref tsk) b) (+ kk 7)) 0)) + (or (!= (aref (fref (mref tsk) b) (+ kk 1)) 0) + (and (or (>= (+ kk 8) maxk) + (!= (aref (fref (mref tsk) b) (+ kk 8)) 0)) + (!= (aref (fref (mref tsk) b) (+ kk 2)) 0)))) + () + (+= s (search kk (+ j0 1) (+ j0 1) maxp maxp maxk tsk))))) + (:after + (= ap (aref (fref (mref tsk) a) j0)) + (= (aref (fref (mref tsk) a) j0) (aref (fref (mref tsk) a) p)) + (= (aref (fref (mref tsk) a) p) ap) + (= (aref (fref (mref tsk) b) (= kk k)) 0) + (for ((= l 0) (< l 4) (inc l)) + (= (aref (fref (mref tsk) b) (+= kk (aref pss l))) 0)) + (DEBUG-STMTS 2 + (if BACKTRACKING (csym::fprintf stderr "(worker %d) temporary undoing~%" WORKER-ID))) + ) + ) + (label Ln (continue)) + ) + ;; put/get pentomino task/result + (handles pentomino + (:put from i1 to i2 + (%if* USE-PROBABILITY + (= PROBABILITY (pen-probability j0 maxp))) + (= this (mref tsk)) + (= this.k k) + (= this.i0 j0) + (= this.i1 i1) + (= this.i2 i2)) + (:get + (+= s this.r)))) + ) + (return s)) From 0f968654dded22015fbd6336e530f95c6dc950b3 Mon Sep 17 00:00:00 2001 From: tasuku Date: Fri, 10 Jul 2015 11:32:30 +0900 Subject: [PATCH 044/105] Fixed a spelling error in an error message. --- src/sample/tcell/worker.sc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/sample/tcell/worker.sc b/src/sample/tcell/worker.sc index a19533c8..b617e8bf 100644 --- a/src/sample/tcell/worker.sc +++ b/src/sample/tcell/worker.sc @@ -1918,7 +1918,7 @@ (= command "hostname -s") (if (== (= fp (csym::popen command "r")) NULL) (begin - (csym::fprintf stderr "popen errer!~%") + (csym::fprintf stderr "popen error!~%") (exit EXIT-FAILURE))) (csym::fgets buf 256 fp) (csym::strtok buf "~%") From bd3de4d9fda7be355a0dd0b3f53f0e2bb5bc2efc Mon Sep 17 00:00:00 2001 From: Tasuku HIRAISHI Date: Sun, 12 Jul 2015 17:53:07 +0900 Subject: [PATCH 045/105] fib-thr.tcell works with any input number n. --- src/sample/tcell/fib-thr.tcell | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/src/sample/tcell/fib-thr.tcell b/src/sample/tcell/fib-thr.tcell index 3dbccfc7..edf32727 100644 --- a/src/sample/tcell/fib-thr.tcell +++ b/src/sample/tcell/fib-thr.tcell @@ -94,6 +94,17 @@ (def threshold long :in) (def r long :out)) +(def (csym::fib-seq n) (csym::fn long long) + (def s int 1) + (def n1 int 1) + (def n2 int) + (def i int) + (for ((= i 3) (<= i n) (inc i)) + (= n2 n1) + (= n1 s) + (= s (+ n1 n2))) + (return s)) + (def (task-body fib-start) (decl tp (array (struct timeval) 2)) (csym::fprintf stderr "start fib(%ld)~%" this.n) @@ -101,8 +112,9 @@ (++ WDATA.n-task) (csym::fprintf stderr "%d starts %ld-th task.~%" WORKER-ID WDATA.n-task)) (= N0 this.n) - (= Threshold (/ (* 20365011074 this.threshold) 100)) - (csym::fprintf stderr "Threshold: %ld %ld~%" this.threshold Threshold) + (= Threshold (/ (* (csym::fib-seq this.n) this.threshold) 100)) + (csym::fprintf stderr "Threshold: %ld * %ld / 100 = %ld~%" + (csym::fib-seq this.n) this.threshold Threshold) (csym::gettimeofday tp 0) (= (aref Tp 0) (aref tp 0)) (catch 1 From 8c7c462a1f6aedb567347757733b6da58f75beeb Mon Sep 17 00:00:00 2001 From: Tasuku HIRAISHI Date: Sun, 12 Jul 2015 17:53:41 +0900 Subject: [PATCH 046/105] Tascell: new event counter EV-SEND-CNCL --- src/sample/tcell/worker.sc | 2 ++ src/sample/tcell/worker.sh | 5 +++-- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/src/sample/tcell/worker.sc b/src/sample/tcell/worker.sc index b617e8bf..fc2a416c 100644 --- a/src/sample/tcell/worker.sc +++ b/src/sample/tcell/worker.sc @@ -1628,6 +1628,8 @@ (csym::copy-address (aref rcmd.v 1) cur->task-head) ; (csym::send-command (ptr rcmd) 0 0) (= cur->msg-cncl 2) + (PROF-CODE + (csym::evcounter-count thr EV-SEND-CNCL OBJ-PADDR cur->task-head)) (inc count) ))) (return count) ) diff --git a/src/sample/tcell/worker.sh b/src/sample/tcell/worker.sh index 3a24678d..6a043e2c 100644 --- a/src/sample/tcell/worker.sh +++ b/src/sample/tcell/worker.sh @@ -203,16 +203,17 @@ "TCOUNTER-TREQ-BK" "TCOUNTER-TREQ-ANY")) ;;; Kinds of events (for profiling) -(%defconstant NKIND-EV 5) +(%defconstant NKIND-EV 6) (def (enum event) EV-SEND-TASK ; task send (aux: recipient) EV-STRT-TASK ; task start (aux: task sender) EV-RSLT-TASK ; task finished normally (aux: rslt recipient) EV-EXCP-TASK ; task finished with an exce[tion (aux: rslt recipient) EV-ABRT-TASK ; task aborted (aux: rslt recipient) + EV-SEND-CNCL ; send cncl (aux: recipient) ) (static ev-strings (array (ptr char)) - (array "EV-SEND-TASK" "EV-STRT-TASK" "EV-RSLT-TASK" "EV-EXCP-TASK" "EV-ABRT-TASK")) + (array "EV-SEND-TASK" "EV-STRT-TASK" "EV-RSLT-TASK" "EV-EXCP-TASK" "EV-ABRT-TASK" "EV-SEND-CNCL")) ;;; Obj types of auxiliary data (def (enum obj-type) From 787b42ae67e6f2c218f29df4e6ecc437f24f98ce Mon Sep 17 00:00:00 2001 From: Tasuku HIRAISHI Date: Tue, 14 Jul 2015 01:10:41 +0900 Subject: [PATCH 047/105] Fixed a bug that a worker spawns a task from a tak to which a cancellation flag is set (and such a child task will not be aborted) --- src/rule/tcell.rule | 50 +++++++++++++------------------------- src/sample/tcell/worker.sc | 46 +++++++++++++++++++++++++---------- 2 files changed, 50 insertions(+), 46 deletions(-) diff --git a/src/rule/tcell.rule b/src/rule/tcell.rule index 4dc5db71..fa95e323 100644 --- a/src/rule/tcell.rule +++ b/src/rule/tcell.rule @@ -39,19 +39,13 @@ (let ((pg (mapcar #'external-declaration decl-list))) (append (list ~(%include "rule/tcell.sh") - ~(decl (handle-req) (fn void - (ptr ,(tcell:nestfunc-type)) - (ptr (struct thread-data)))) - ~(decl (handle-req-cncl) (fn void - (ptr ,(tcell:nestfunc-type)) - (ptr (struct thread-data)))) - ~(decl (handle-exception) (fn void + ~(decl (handle-reqs) (fn void + (ptr ,(tcell:nestfunc-type)) + (ptr (struct thread-data)))) + ~(decl (handle-exception) (fn void (ptr ,(tcell:nestfunc-type)) (ptr (struct thread-data)) long)) - ~(decl (handle-cancellation) (fn void - (ptr ,(tcell:nestfunc-type)) - (ptr (struct thread-data)))) ) pg ;; データ系の関数が定義されてなければ空定義の関数を追加する @@ -258,18 +252,13 @@ (return 1))) (return 0)) ;; --- Nestfunc End --> - ;; Polling for cancel message requests - (if -thr->req-cncl + ;; Polling for cancel message requests, cancellation flags, + ;; and task requests. + (if (or -thr->req-cncl + -thr->task-top->cancellation + -thr->req) ,(tcell:with-new-bk bk-id - (wfn-add-argids ~(handle-req-cncl)))) - ;; Polling for cancellation flags - (if -thr->task-top->cancellation - ,(tcell:with-new-bk bk-id - (wfn-add-argids ~(handle-cancellation)))) - ;; Polling for task requests - (if -thr->req - ,(tcell:with-new-bk bk-id - (wfn-add-argids ~(handle-req)))) + (wfn-add-argids ~(handle-reqs)))) ,b-stat1) (if ,spn-id ;; If a subtask is spawned, wait for the result. @@ -359,18 +348,13 @@ (csym::make-and-send-task -thr ,(tcell:task-no) pthis (== ,spn-id 1))) (return 0)) ;; --- Nestfunc End --> - ;; Polling for cancel message requests - (if -thr->req-cncl - ,(tcell:with-new-bk bk-id - (wfn-add-argids ~(handle-req-cncl)))) - ;; Polling for cancellation flags - (if -thr->task-top->cancellation - ,(tcell:with-new-bk bk-id - (wfn-add-argids ~(handle-cancellation)))) - ;; Polling for task requests - (if -thr->req - ,(tcell:with-new-bk bk-id - (wfn-add-argids ~(handle-req)))) + ;; Polling for cancel message requests, cancellation flags, + ;; and task requests. + (if (or -thr->req-cncl + -thr->task-top->cancellation + -thr->req) + ,(tcell:with-new-bk bk-id + (wfn-add-argids ~(handle-reqs)))) ;; Loop body (for ((< ,var ,var2) (inc ,var)) ,@(tcell:with-new-bk bk-id (function-body body))) diff --git a/src/sample/tcell/worker.sc b/src/sample/tcell/worker.sc index fc2a416c..d2099338 100644 --- a/src/sample/tcell/worker.sc +++ b/src/sample/tcell/worker.sc @@ -1592,10 +1592,11 @@ ;; Start temporary backtracking to spawn tasks +;; Called from handle-reqs after acquiring -thr->mut (def (handle-req -bk -thr) (fn void (ptr (NESTFN int void)) (ptr (struct thread-data))) - (csym::pthread-mutex-lock (ptr -thr->mut)) - (if -thr->req + (if (and -thr->req + (not -thr->task-top->cancellation)) (begin (= -thr->exiting EXITING-SPAWN) (PROF-CODE @@ -1605,7 +1606,7 @@ (csym::tcounter-change-state -thr TCOUNTER-EXEC OBJ-NULL 0)) (= -thr->exiting EXITING-NORMAL) (= -thr->req -thr->treq-top) )) - (csym::pthread-mutex-unlock (ptr -thr->mut))) + ) ;; Send a cncl message for each flagged subtask spawned by "thr" ;; The mutex thr->mut must be acquired before calling. @@ -1634,16 +1635,16 @@ (return count) ) ;; Check -thr's subtask queue and send a cncl message for each flagged subtask +;; Called from handle-reqs after acquiring -thr->mut (def (handle-req-cncl -bk -thr) (fn void (ptr (NESTFN int void)) (ptr (struct thread-data))) - (csym::pthread-mutex-lock (ptr -thr->mut)) (if -thr->req-cncl (begin (DEBUG-PRINT 1 "(%d): (Thread %d) detected cncl message request~%" (csym::get-universal-real-time) -thr->id) (csym::send-cncl-for-flagged-subtasks -thr) (= -thr->req-cncl 0) )) - (csym::pthread-mutex-unlock (ptr -thr->mut))) + ) ;; Start propagating an exception. Invoked by a Tascell throw statement. (def (handle-exception -bk -thr excep) @@ -1652,12 +1653,14 @@ (= -thr->exception-tag excep) (PROF-CODE (csym::tcounter-change-state -thr TCOUNTER-EXCP OBJ-INT (cast (ptr void) (cast long excep)))) - (-bk)) ; never returns + (-bk) ; never returns + (csym::perror "Unexpectedly returned from backtracking for an exception.") + ) -;; Check (partial) cancellation flags and abort if needed. +;; Check (partial) cancellation lags and abort if needed. +;; Called from handle-reqs after acquiring -thr->mut (def (handle-cancellation -bk -thr) (fn void (ptr (NESTFN int void)) (ptr (struct thread-data))) - (csym::pthread-mutex-lock (ptr -thr->mut)) (if -thr->task-top->cancellation (begin (DEBUG-PRINT 1 "(%d): (Thread %d) detected cancellation flag (%d)~%" @@ -1667,10 +1670,25 @@ (csym::tcounter-change-state -thr TCOUNTER-ABRT OBJ-INT (cast (ptr void) (cast long -thr->task-top->cancellation)))) (csym::pthread-mutex-unlock (ptr -thr->mut)) - (-bk))) ; never returns + (-bk) ; never returns + (csym::perror "Unexpectedly returned from backtracking for abortion.") + ))) + +;; Called when at least one of the request flags: +;; * -thr->req +;; * -thr->req-cncl +;; * -thr->task-top->cancellation +;; are found to be raised by checking without acquiring -thr->mut. +;; Calls these request handlers after aquiring this mutex lock. +(def (handle-reqs -bk -thr) + (fn void (ptr (NESTFN int void)) (ptr (struct thread-data))) + (csym::pthread-mutex-lock (ptr -thr->mut)) + (handle-req -bk -thr) ; request for spawning tasks + (handle-req-cncl -bk -thr) ; request for sending CNCL messages + (handle-cancellation -bk -thr) ; request for aborting the task being executed (csym::pthread-mutex-unlock (ptr -thr->mut)) ) - + ;; Make a task message and send it. ;; (The recipient is determined by the top of the task request stack) @@ -1770,16 +1788,18 @@ ;; Just wait for the subtask finishing (csym::pthread-cond-wait (ptr thr->cond-r) (ptr thr->mut))) ) - (PROF-CODE - (csym::tcounter-change-state thr tcnt-stat OBJ-NULL 0)) - ;; When the subtask has thrown an exception, propagate it (if (== sub->stat TASK-HOME-EXCEPTION) (begin (= thr->exiting EXITING-EXCEPTION) (= thr->exception-tag sub->exception-tag) (dec sub->owner->cancellation) ; take the partial cancellation flag + (PROF-CODE + (= tcnt-stat TCOUNTER-EXCP)) )) + (PROF-CODE + (csym::tcounter-change-state thr tcnt-stat OBJ-NULL 0)) + ;; When the subtask is abnormally exited, a task object is not returned as the result (if (or (== sub->stat TASK-HOME-EXCEPTION) (== sub->stat TASK-HOME-ABORTED)) From 67509ff7c8ed662ebb14f9a35759a03850a9effb Mon Sep 17 00:00:00 2001 From: tasuku Date: Thu, 4 Feb 2016 22:30:15 +0900 Subject: [PATCH 048/105] Fixed a bug in the pattern matcher. --- src/sct-rule2lsp.lsp | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/sct-rule2lsp.lsp b/src/sct-rule2lsp.lsp index a75ac9ac..6a20a53a 100644 --- a/src/sct-rule2lsp.lsp +++ b/src/sct-rule2lsp.lsp @@ -413,6 +413,8 @@ `(let ((,cur-var ,focus-var) ,head-var ,.(when in-bracket (list rtmp-var `(,maxvals-var 0)))) ,.(when in-bracket (list `(declare (fixnum ,maxvals-var)))) + (setq ,pv nil) + (setq ,pv-ret nil) (tagbody (go ,skip-tag) ,retry-tag From 0784ec07fff6a8782bc496c048f4cc7abc1389f1 Mon Sep 17 00:00:00 2001 From: tasuku Date: Fri, 5 Feb 2016 10:39:00 +0900 Subject: [PATCH 049/105] Fixed a bug on the -s option of sc2c. --- src/sc-cmdline.lsp | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/sc-cmdline.lsp b/src/sc-cmdline.lsp index 4020e809..1a774f1a 100644 --- a/src/sc-cmdline.lsp +++ b/src/sc-cmdline.lsp @@ -60,7 +60,12 @@ (setq output-file parm)) ((#\s) ; sc2c-rule (with1 elm (read-from-string (car rest)) - (setq sc2c-rule (if (symbolp elm) (eval (car rest)) elm)))) + (setq sc2c-rule elm) + (unless (or (symbolp elm) + (listp elm)) + (format *error-output* "~&Illegal parameter value for -s: ~S~%" (car rest)) + (bye exit-status)) + )) ((#\m) ; intermediate (with1 elm (read-from-string parm) (setq intermediate (and elm (not (eql 0 elm)))))) From 327ef3543af975cb943a1f7b667d896fe5002924 Mon Sep 17 00:00:00 2001 From: tasuku Date: Sun, 7 Feb 2016 15:13:32 +0900 Subject: [PATCH 050/105] Changed Japanese encoding from EUC-JP to UTF-8. --- src/c2sc-lex.lsp | 2 +- src/c2sc-parser.lsp | 52 ++-- src/init.lsp | 4 +- src/rule/hoist.rule | 14 +- src/rule/hsc-defs.lsp | 22 +- src/rule/hsc.rule | 48 ++-- src/rule/hsc.sc | 28 +- src/rule/hsc.sh | 8 +- src/rule/labeled-break.rule | 8 +- src/rule/multithread-defs.lsp | 28 +- src/rule/multithread-hoist.rule | 2 +- src/rule/multithread-rename.rule | 2 +- src/rule/multithread-sc1.rule | 2 +- src/rule/multithread-temp.rule | 2 +- src/rule/multithread-type.rule | 2 +- src/rule/multithread.rule | 26 +- src/rule/multithread.sh | 42 +-- src/rule/nestfunc-defs.lsp | 186 ++++++------- src/rule/nestfunc-setrule.sh | 4 +- src/rule/nestfunc.rule | 334 +++++++++++------------ src/rule/nestfunc.sc | 12 +- src/rule/nestfunc.sh | 12 +- src/rule/rename-defs.lsp | 12 +- src/rule/sc0-to-sc0.rule | 4 +- src/rule/sc1.rule | 4 +- src/rule/sc2c-defs.lsp | 8 +- src/rule/sc2c.rule | 16 +- src/rule/stack-scan.rule | 20 +- src/rule/sxcc2c.rule | 2 +- src/rule/tcell-defs.lsp | 30 +-- src/rule/tcell.rule | 96 +++---- src/rule/temp-defs.lsp | 6 +- src/rule/temp.rule | 12 +- src/rule/type-defs.lsp | 32 +-- src/rule/type-info.rule | 22 +- src/rule/untype.rule | 4 +- src/sample/delete-intermediate | Bin 58 -> 56 bytes src/sample/hsc/bin2list.hsc | 8 +- src/sample/hsc/bintree.hsc | 10 +- src/sample/lightweight/nonlocalexit.sc | 6 +- src/sample/lightweight/nonlocalexit2.sc | 10 +- src/sample/tcell/Messages.txt | 22 +- src/sample/tcell/README | 40 +-- src/sample/tcell/buffer.lsp | 34 +-- src/sample/tcell/cmd-serial.sc | 46 ++-- src/sample/tcell/cmp.tcell | 2 +- src/sample/tcell/copine.tcell | 96 +++---- src/sample/tcell/fib-excep.tcell | 2 +- src/sample/tcell/fib-guard.tcell | 2 +- src/sample/tcell/fib-thr.tcell | 4 +- src/sample/tcell/fib-try.tcell | 4 +- src/sample/tcell/fib.tcell | 4 +- src/sample/tcell/grav.tcell | 4 +- src/sample/tcell/lu.tcell | 14 +- src/sample/tcell/matmul.tcell | 12 +- src/sample/tcell/nq-copy.tcell | 22 +- src/sample/tcell/nq-thr.tcell | 22 +- src/sample/tcell/nq-try.tcell | 22 +- src/sample/tcell/nq.tcell | 22 +- src/sample/tcell/pen-copy.tcell | 8 +- src/sample/tcell/pen-excep.tcell | 8 +- src/sample/tcell/pen.tcell | 8 +- src/sample/tcell/pen6x17-copy.tcell | 10 +- src/sample/tcell/pen6x17-guard.tcell | 10 +- src/sample/tcell/pen6x17-thr.tcell | 10 +- src/sample/tcell/pen6x17-try.tcell | 10 +- src/sample/tcell/pen6x17.tcell | 10 +- src/sample/tcell/queue.lsp | 142 +++++----- src/sample/tcell/sendrecv.c | 6 +- src/sample/tcell/sendrecv.h | 2 +- src/sample/tcell/server.lsp | 340 ++++++++++++------------ src/sample/tcell/sock.c | 2 +- src/sample/tcell/socket/socket.lsp | 8 +- src/sample/tcell/spanning.tcell | 168 ++++++------ src/sc-decl.lsp | 22 +- src/sc-main.lsp | 44 +-- src/sc-misc.lsp | 214 +++++++-------- src/scpp.lsp | 42 +-- src/sct-defrule.lsp | 56 ++-- src/sct-file.lsp | 80 +++--- src/sct-lib.lsp | 52 ++-- src/sct-macch.lsp | 34 +-- src/sct-rule2lsp.lsp | 102 +++---- 83 files changed, 1452 insertions(+), 1452 deletions(-) diff --git a/src/c2sc-lex.lsp b/src/c2sc-lex.lsp index 1fb7244a..bd63260e 100644 --- a/src/c2sc-lex.lsp +++ b/src/c2sc-lex.lsp @@ -288,7 +288,7 @@ (defun lex-prev-token () *prev-token*) (defun lex-colon-follows () *colon-follows*) -;; 字句解析の親分 +;; 絖ヨВ荀 (defun lex-get-token (&aux (le *lex-env*) (line nil)) (the lex-env *lex-env*) (unless (setq line (skip-whitespace le (lex-env-lptr le))) diff --git a/src/c2sc-parser.lsp b/src/c2sc-parser.lsp index 36f4aa64..8717a02b 100644 --- a/src/c2sc-parser.lsp +++ b/src/c2sc-parser.lsp @@ -67,14 +67,14 @@ ;;; whether c2sc::piece-c2sc is being processed (defvar *parsing-piece* nil) -;;; c2sc-getline 中に preprocessing directive が現れたらここに溜めておく。 +;;; c2sc-getline 筝 preprocessing directive 憗羣 ;;; %defmacro, %defconstant, %undef ;;; --> *scpp-macro-buffer* -;;; --> translation-unit の末尾につなげる -;;; それ以外 +;;; --> translation-unit 絨障ゃ +;;; 篁ュ ;;; --> *scpp-directive-buffer* -;;; --> *directive-emit-functions* に指定されている関数の返り値の頭に -;;; つなげて一緒に吐き出す +;;; --> *directive-emit-functions* 絎∽違菴ゃ +;;; ゃ筝膩冴 (defvar *scpp-directive-buffer* nil) (defvar *scpp-macro-buffer* nil) (defparameter *directive-emit-functions* '(declaration statement)) @@ -298,7 +298,7 @@ ;;;; -;; get-gensymid で mark をつけたところの identifier を決定する +;; get-gensymid mark ゃ identifier 羆阪 (defun decide-unidentified (sc-program) (let ((dec-id (memoize #'(lambda (usym) @@ -319,7 +319,7 @@ (ragrs *required-aggregates*)) (if (and (eq t rvars) (eq t ragrs)) sc-program (loop for df in sc-program - when (or (atom df) (not (defsymbol-p (car df))) ; 宣言・定義以外 + when (or (atom df) (not (defsymbol-p (car df))) ; 絎ｈ糸臂篁ュ (if (consp (second df)) (if (member (car (second df)) ~(struct union enum)) (aggregate-required-p (second (second df))) @@ -330,8 +330,8 @@ (defun defsymbol-p (sym) (rule:declaration-tag? sym :sc2c)) -;; 無名のstructなどは，SCでは無名にできないので， -;; mark をつけておいて,後で identifier を決定する +;; ≦struct鐚SCс≦сэ +;; mark ゃ,緇 identifier 羆阪 (defvar *gensym-num*) (defun get-gensymid () (prog1 @@ -1658,9 +1658,9 @@ (aif (read-line stream nil) (if (eql #\$ (string-ref it 0)) (progn - ;; S-expression としてreadして、、、 + ;; S-expression read (handle-c2sc-directive (string-left-ntrim it)) - ;; あらためて次の行を読む + ;; 罨＜茵茯 (c2sc-getline stream)) (funcall (if *want-debugging-output* #'print #'identity) (string+ it #.(format nil "~%")))) @@ -1706,8 +1706,8 @@ (otherwise (push directive *scpp-directive-buffer*)))))) -;; *directive-emit-functions* の関数（構文単位）処理後， -;; *scpp-direcive-buffer*にたまったプリプロセッサ指令を吐き出す +;; *directive-emit-functions* ∽逸罕篏鐚緇鐚 +;; *scpp-direcive-buffer*障ｃ祉究篁ゃ冴 (dolist (de-func *directive-emit-functions*) (let ((orig-func (symbol-function de-func))) (setf (symbol-function de-func) @@ -1718,12 +1718,12 @@ (nconc emit-directive (apply orig-func args))))))) -;;; %defconstant-cexp 中のCコードの断片を可能ならSC化 +;;; %defconstant-cexp 筝C潟若純SC (defun defconstant-cexp-c2sc (defconstant-exp-directive) (assert (eq '%defconstant-cexp (car defconstant-exp-directive))) (let* ((const-name (second defconstant-exp-directive)) (piece-c-code (third defconstant-exp-directive)) - ;; C の "~" は "~~" になっているので + ;; C "~" "~~" ｃ (formatted-c-code #|(format nil|# piece-c-code #|)|#)) (if (not (macro-required-p const-name)) nil (progn @@ -1742,8 +1742,8 @@ (format *error-output* "==> ~%")) `(sc::c-exp ,piece-c-code)) )))))) -;;; defmacro における c-code の "$$" の部分を引数名に置き換える -;;; 返り値は +;;; defmacro c-code "$$" 綣医臀 +;;; 菴ゃ ;;; (values `(c-exp ...) ;;; ) (defun replace-arguments (piece-c-code arg-list) @@ -1770,7 +1770,7 @@ (values `(cl:list 'sc::c-exp ,cexpstr ,@arg-list) formatted-c-code) ))) -;; マクロ本体を backquote-macro に変換 +;; 篏 backquote-macro 紊 (defun to-eval-macroarg (scized-defmacro macro-arg-list) (if (atom scized-defmacro) (if (member scized-defmacro macro-arg-list) @@ -1779,7 +1779,7 @@ `(cl:list ,@(mapcar (suffixed-func #'to-eval-macroarg macro-arg-list) scized-defmacro)))) -;;; %defmacro-cexp 中のCコードの断片を可能ならSC化 +;;; %defmacro-cexp 筝C潟若純SC (defun defmacro-cexp-c2sc (defmacro-exp-directive) (assert (eq '%defmacro-cexp (car defmacro-exp-directive))) (destructuring-bind (macro-name piece-c-code arg-list) @@ -1807,7 +1807,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; 環境を整えてinitiatorから構文解析開始 +;; 医眼initiator罕茹ｆ紮 ;; input : input-stream or string (defun parser-main (input &key @@ -1879,8 +1879,8 @@ fixed-typename-entries (mapcar #'make-typename-entry typename-list) ))))) -;; 同じ変換結果を削除する． -;; 複数の候補の原因が型変数(or not)の場合，その変数名を特定する． +;; 紊腟ゃ鐚 +;; 茲違茖紊(or not)翫鐚紊医劫鐚 (defun remove-duplicate-candidates (all-candidates) (let ((ret (list))) ;; ( ) (dolist (cand all-candidates) @@ -1889,7 +1889,7 @@ (intersection (second (car it)) (second cand)) (intersection (third (car it)) (third cand)) )) (push cand ret))) - ;; 候補の違いに影響してない変数名を除く + ;; 茖綵演帥紊医ゃ (mapc #'(lambda (get-place &aux (get-placea (compose #'car get-place))) (dolist (tn (funcall get-placea (first ret))) @@ -1902,7 +1902,7 @@ (list #'cdr #'cddr)) ret)) -;; tried-functionで指定された全ての場所からparsingを試みる +;; tried-functionф絎贋parsing荅帥 (defun try-all-parsing (istring &key (tried-function *tried-function*)) (check-type istring string) (let* ((all-candidates) ; list of ( ) @@ -2031,8 +2031,8 @@ ;;; (c2sc "csample/c_parser.c") -;;; 対話環境での利用向けpiece-c2sc -;;; sc:: などの情報を除いてすっきり出力 +;;; 絲乗援医сpiece-c2sc +;;; sc:: 宴ゃｃ阪 (defun pcsc (x &rest try) (unless try (setq try *tried-function*)) (immigrate-package (piece-c2sc x :tried-function try) *package*)) diff --git a/src/init.lsp b/src/init.lsp index 5af69d7b..9d0fba34 100644 --- a/src/init.lsp +++ b/src/init.lsp @@ -33,11 +33,11 @@ ;;; Implementation-dependent settings #+cmu (setq ext:*gc-verbose* nil) -#+clisp (progn (setq custom:*default-file-encoding* charset:euc-jp) +#+clisp (progn (setq custom:*default-file-encoding* charset:utf-8) (unuse-package :ext)) #+allegro (progn (setq comp:*cltl1-compile-file-toplevel-compatibility-p* t) (require :osi)) -#+(and allegro mswindows) (setq *locale* (find-locale "japan.EUC")) +#+(and allegro mswindows) (setq *locale* (find-locale "ja_JP.utf8")) ;; #+(and composer allegro) (wt:start-composer) ;;; Printer settings diff --git a/src/rule/hoist.rule b/src/rule/hoist.rule index 392bb723..b62d982d 100644 --- a/src/rule/hoist.rule +++ b/src/rule/hoist.rule @@ -63,7 +63,7 @@ (return-from remove-const (remove-const (car x)))) (mapcar #'remove-const x)) -;; declaration, block-item の返り値を宣言部とbody部に分ける +;; declaration, block-item 菴ゃ絎ｈbody (defun split-decl-and-body (x) (list (apply #'append (mapcar #'first x)) (remove nil (mapcar #'second x)))) @@ -80,9 +80,9 @@ (hst:with-hoist-env (call-next-rule) )) ) -;;; 以下, declaration, block-item の返り値は、 -;;; (<関数本体の先頭に出すS式のリスト> -;;; <元の場所に残すS式>) +;;; 篁ヤ, declaration, block-item 菴ゃ +;;; (<∽井篏冴S綣鴻> +;;; <贋罧S綣>) ;;; declaration (defrule inlined-declaration hoist @@ -153,12 +153,12 @@ (defrule struct-declaration hoist (otherwise - (hst:with-new-func ; ダミーの関数を置いて，add-declされた宣言を捕まえる + (hst:with-new-func ; 若∽違臀鐚add-decl絎ｈ障 (with1 ret (call-next-rule) ~(%splice ,.(hst:finfo-flush-decls) ,ret) ))) ) -;;; 配列初期化子で参照される最大のindex数 +;;; 絖ус紊сindex (defrule max-referred-index hoist (#?(array ,@inits) (with1 cnt 0 @@ -170,7 +170,7 @@ (defrule referred-index hoist ;; initializer with designator (#?((aref-this ,@exp-list) ,init) - (eval (car exp-list)) ) ; 添字がLispで評価できる式であることを仮定 + (eval (car exp-list)) ) ; 羞糸Lispц箴＜с綣с篁絎 (#?((aref ,desig ,@exp-list) ,init) (referred-index ~(,desig ,init))) ;; initializer without designator diff --git a/src/rule/hsc-defs.lsp b/src/rule/hsc-defs.lsp index 8bee0598..9e47e700 100644 --- a/src/rule/hsc-defs.lsp +++ b/src/rule/hsc-defs.lsp @@ -51,8 +51,8 @@ ;;; function information (defstruct finfo variables ; list of ( . ) - tmp-variables ; 追加された一時変数 list of ( . ) - (function-head t) ; 関数の先頭のブロック通過時にnilにする + tmp-variables ; 菴遵筝紊 list of ( . ) + (function-head t) ; ∽違nil main-p ) @@ -100,12 +100,12 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; struct information (defstruct sinfo - id ; 元の構造体名 + id ; 罕篏 members ; list of ( . ) - hsc-sid ; 変換後の構造体名 - data-sid ; データ部の構造体名（今の実装ではidと同一） - smap-id ; マップ配列の変数名 - sdesc-id ; 構造体ごとのdesc情報を保持する変数名 + hsc-sid ; 紊緇罕篏 + data-sid ; 若翠罕篏鐚篁絎茖сid筝鐚 + smap-id ; 紊医 + sdesc-id ; 罕篏desc宴篆紊医 ) (defun sinfo-asize (&optional (sinfo *sinfo*)) @@ -121,18 +121,18 @@ ;; make expression for aligned size -;; sinfo追加 +;; sinfo菴遵 (defun add-sinfo (&optional (sinfo *sinfo*)) (push sinfo *sinfo-list*)) -;; sinfoをidで検索 +;; sinfoidф膣 (defun find-sinfo (id) (find id *sinfo-list* :key #'sinfo-id)) (defun add-member (id type &optional (sinfo *sinfo*)) (push (cons id type) (sinfo-members sinfo))) -;; オブジェクト内の参照の位置を示す配列式 +;; 吾сс篏臀腓冴綣 (defun make-struct-map (&optional (sinfo *sinfo*)) (let ((vars (sinfo-members sinfo)) (hsc-sid (sinfo-hsc-sid sinfo)) @@ -152,7 +152,7 @@ ,member-id))) ) -;; オブジェクト情報構造体式を作る +;; 吾с掩篏綣篏 (defun make-descriptor (&optional (sinfo *sinfo*)) (let ((hsc-sid (sinfo-hsc-sid sinfo)) (smap-id (sinfo-smap-id sinfo))) diff --git a/src/rule/hsc.rule b/src/rule/hsc.rule index e19fc723..570c04e3 100644 --- a/src/rule/hsc.rule +++ b/src/rule/hsc.rule @@ -24,10 +24,10 @@ ;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF ;;; SUCH DAMAGE. -;;; HSC -> LW-SC （要hoisting, type, temp） +;;; HSC -> LW-SC 鐚荀hoisting, type, temp鐚 -;; 未対応 -;; ・構造体がメンバとして構造体を持つ場合 +;; 絲上 +;; 紙篏＜潟罕篏ゅ翫 (scr:require "HSC-DEFS") @@ -60,7 +60,7 @@ (#?(,scs[storage-class-specifier] (,fname ,@arg-list) (,fntag[function-tag] ,rtype ,@type-list {,va-arg[vaarg-tag]}) ,@body) - (if (or (cid-p fname) (cid-p fntag)) (list x) ; csym::なら何もしない + (if (or (cid-p fname) (cid-p fntag)) (list x) ; csym::篏 (let* ((hsc:*finfo* (hsc:make-finfo :main-p (eq fname ~hsc-main))) (vaarg-ret (if-pattern-variable va-arg (list (get-retval va-arg)))) (rtype-ret (type-expression! rtype)) @@ -86,12 +86,12 @@ (let ((sbody-ret (mapcar #'struct-declaration sbody))) (list 'splice - ~(def (struct ,data-sid) ,@sbody-ret) ; 元の構造体情報 + ~(def (struct ,data-sid) ,@sbody-ret) ; 罕篏 ~(def (struct ,hsc-sid) ; --> {, , _data} (def d desc-t) (def data (struct ,data-sid))) - ~(def ,smap-id (array size-t) ,(hsc:make-struct-map)) ; オブジェクト中の参照の位置 - ~(def ,sdesc-id descriptor ,(hsc:make-descriptor)) ; 構造体固有の情報(descriptor) + ~(def ,smap-id (array size-t) ,(hsc:make-struct-map)) ; 吾с筝с篏臀 + ~(def ,sdesc-id descriptor ,(hsc:make-descriptor)) ; 罕篏堺(descriptor) ))))) ;; union (not featured) (#?(def (union ,sid) ,@sbody) @@ -106,7 +106,7 @@ ~(,scs ,id ,texp-ret 0))) ;; variable (otherwise) (#?(,scs[storage-class-specifier] ,id[identifier] ,texp {,init}) - ;;ptrならmove対象としてリストに加える。csym::がついていたらmove対象から外す。 + ;;ptrmove絲乗院鴻csym::ゃmove絲乗院紊 (if (cid-p id) x (let* ((texp-ret (type-expression texp)) (init-ret (if-pattern-variable init (list (initializer init)) @@ -115,7 +115,7 @@ ~(,scs ,id ,texp-ret ,@init-ret)))) ) -;; メンバを*sinfo*に登録 +;; ＜潟*sinfo*脂 (defrule struct-declaration hsc (#?(def ,id ,texp) (let ((texp-ret (type-expression texp))) @@ -123,9 +123,9 @@ ~(def ,id ,texp-ret)))) ;; type-expression -;; * fn型に第一引数 (入れ子関数sht型)追加 +;; * fn膃筝綣 (ャ絖∽sht)菴遵 ;; * array -> ptr -;; * 構造体名を変換 +;; * 罕篏紊 (defrule type-expression hsc (#?,atom[#'atom] x) @@ -145,7 +145,7 @@ (otherwise (mapcar #'type-expression x))) -;; texpが参照型かどうかの判定 +;; texpуゅ (defrule ref-type-p hsc ((#?(ptr ,texp) #?(array ,@rem)) @@ -153,7 +153,7 @@ (otherwise nil)) -;; 宣言の最後に一時変数の宣言および入れ子関数の追加 +;; 絎ｈ緇筝紊違絎ｈ喝ャ絖∽違菴遵 (defrule function-body hsc (#?({:attr ,f-attr} { ,r-decl[register-declarator] } ,@bi-list) @@ -163,16 +163,16 @@ (list (get-retval r-decl))))) (fhead (hsc:function-head-p)) (rembody bi-list) - (decls (loop for bi in bi-list ; body先頭の宣言部 + (decls (loop for bi in bi-list ; body絎ｈ as ret = (inlined-declaration (car rembody)) until (eq 'rule::no-match ret) do (pop rembody) collect ret)) - (stats (mapcar #'statement! rembody))) ; 残りのstatement部 + (stats (mapcar #'statement! rembody))) ; 罧statement (nconc pre decls (when fhead - (nconc (hsc:make-add-decls) ; 一時変数の宣言 - (list (hsc:make-nestfunc)))) ; 入れ子関数定義 + (nconc (hsc:make-add-decls) ; 筝紊違絎ｈ + (list (hsc:make-nestfunc)))) ; ャ絖∽医臂 stats))) ) @@ -232,22 +232,22 @@ (bit-or TYPE-STRUCT ; type-id (see "hsc.sh") (cast size-t ; descriptor (ptr ,(hsc:sinfo-sdesc-id sinfo))))) - ,init-ret) ; もともとのデータ + ,init-ret) ; 若 )))) ;; field reference - ;; (struct d data) に変わっているのでdata部を指すように変更 + ;; (struct d data) 紊ｃdata紊 (#?(the ,texp (fref ,exp ,@id-list)) - (let* ((exp-ret (expression! exp)) ; fref第一式 + (let* ((exp-ret (expression! exp)) ; fref膃筝綣 (exp-type (second exp-ret))) (aif (and (tagged-p ~struct exp-type) (hsc:find-sinfo (second exp-type))) ~(the ,texp (fref ,exp-ret data ,@id-list)) - (progn ; 未定義または構造体型でない + (progn ; 絎臂障罕篏с (warn "~S (type of ~S) is not defined as structure" exp-type (third exp)) ~(the ,texp (fref ,exp-ret ,@id-list)))))) - ;; array object: body部を参照するように変更 - ;; indexがない場合は，Cへの関数渡し用に，単にbodyを参照する + ;; array object: bodyс紊 + ;; index翫鐚C吾∽井検鐚bodyс (#?(the (array ,texp) (aref ,exp)) (let* ((texp-ret (type-expression! texp)) (exp-ret (expression! exp))) @@ -266,7 +266,7 @@ ;; function call (#?(the ,texp (call (the (ptr (,ftag ,@texp-list)) ,exp) ,@exp-list)) - (let ((exp-ret (expression! (second (third x)))) ; call第一式 + (let ((exp-ret (expression! (second (third x)))) ; call膃筝綣 (expl-ret (mapcar #'expression! exp-list))) (if (or (eq 'csym::fn ftag) (cid-p exp)) ~(the ,texp (call ,exp-ret ,@expl-ret)) diff --git a/src/rule/hsc.sc b/src/rule/hsc.sc index 26140fd1..df7c6ddf 100644 --- a/src/rule/hsc.sc +++ b/src/rule/hsc.sc @@ -39,7 +39,7 @@ (%include "rule/nestfunc-setrule.sh") (%include "hsc.sh") -;;; gc-initで無指定(=0)の場合に採用される値 +;;; gc-initх≧絎(=0)翫｡ (%ifndef TOSIZE ((%defconstant TOSIZE (* 5 1024 1024))) ) ;; (%ifndef ROOTSIZEMAX @@ -51,7 +51,7 @@ (%ifndef GC-LIMITED-STACK-MAX ((%defconstant GC-LIMITED-STACK-MAX 32)) ) -;;; ポインタ判定 +;;; ゃ潟水ゅ (%defmacro MREF-AS (tp p) `(mref (cast (ptr ,tp) ,p))) @@ -111,7 +111,7 @@ (static-def new-memory-end (ptr char)) ;; Referred in move & gc-breadth-first -(static-def b (ptr char)) ; moveの次の移動先 +(static-def b (ptr char)) ; move罨＜腱糸 ;; *link = move(*link); (def (csym::move vp) (csym::fn (ptr void) (ptr void)) @@ -128,7 +128,7 @@ ;; Object not located in From Space (if (not (IN-FROM p)) (return vp)) - ;; オブジェクトの先頭 (sizeof size-t)[byte] は + ;; 吾с (sizeof size-t)[byte] ;; fowarding pointer OR (bit-or least2bit-tag pointer-to-descriptor) (= tag (bit-and #b11 (MREF-AS size-t p))) (= fwp (cast (ptr void) @@ -137,7 +137,7 @@ (if (IN-TOSP fwp) (return fwp)) - ;; オブジェクトの先頭 sizeof(int) bytes --- (fref ,obj type) + ;; 吾с sizeof(int) bytes --- (fref ,obj type) ;; LSB==1: type-id ;; LSB==0: forwarding pointer (switch tag @@ -155,13 +155,13 @@ (default) (error "Illegal type ID!")) - (= np b) ; 移動先 - (= nb (+ np asize)) ; 次の移動先 + (= np b) ; 腱糸 + (= nb (+ np asize)) ; 罨＜腱糸 (if (>= nb new-memory-end) (error "buffer overrun.")) (MEMCPY np p size) - (= b nb) ; 移動先を更新 - (= (FWPTR p) np) ; 跡地にfowarding pointer + (= b nb) ; 腱糸贋 + (= (FWPTR p) np) ; 莊≦違fowarding pointer (return np)) ;; BREADTH-FIRST-GC @@ -180,7 +180,7 @@ (if (fref params gcv) (csym::printf "BREADTH-FIRST-GC start~%")) (= b new-memory) (= s b) - (scan) ; stackから直接指されているobjをcopy + (scan) ; stack贋･objcopy (while (< s b) ; for each copied object (= tag (bit-and #b11 (MREF-AS size-t s))) (switch tag @@ -222,12 +222,12 @@ (csym::printf "GC complete (%d)~%" allocated-size)) ) -;; 性能測定用 +;; ц醇謙絎 (def gc-ttime double) (def tp1 (struct timeval)) (def tp2 (struct timeval)) -;; GC開始 +;; GC紮 (def (gc scan) (fn void sht) (csym::gettimeofday (ptr tp1) 0) (switch (fref params gctype) @@ -252,7 +252,7 @@ (if (== (fref params tosize) 0) (= (fref params tosize) TOSIZE)) (+= (fref params tosize) 3) (-= (fref params tosize) (bit-and (fref params tosize) 3)) - ; 下位2bitが00になるように繰り上げ + ; 筝篏2bit00膵違筝 (if (== (fref params stack-size) 0) (= (fref params stack-size) GC-STACK-SIZE)) (if (== (fref params limited-stack-max) 0) @@ -262,7 +262,7 @@ (fref params tosize) (fref params stack-size) (fref params limited-stack-max) ) - ;; heap領域の確保 + ;; heap腆坂 (= old-memory (csym::myalloc (fref params tosize))) (= old-memory-end (+ old-memory (fref params tosize))) (= new-memory (csym::myalloc (fref params tosize))) diff --git a/src/rule/hsc.sh b/src/rule/hsc.sh index 0b989daa..a46f3a4e 100644 --- a/src/rule/hsc.sh +++ b/src/rule/hsc.sh @@ -32,13 +32,13 @@ ;; (deftype size-t long) (deftype align-t double) -;;; (def d desc-t) の下位2ビットに埋め込む +;;; (def d desc-t) 筝篏2莨若 (%defconstant TYPE-STRUCT 0) (%defconstant TYPE-REF-ARRAY 1) (%defconstant TYPE-NONREF-ARRAY 3) -;;; 構造体の構造（hsc.ruleより） -;; ~(def (struct ,data-sid) ,@sbody-ret) ; 元の構造体情報は _data +;;; 罕篏罕鐚hsc.rule鐚 +;; ~(def (struct ,data-sid) ,@sbody-ret) ; 罕篏宴 _data ;; ~(def (struct ,sid) ; --> {, , _data} ;; (def d desc-t) ; (ptr (struct desc-struct)) ;; (def data (struct ,data-sid)) @@ -54,7 +54,7 @@ (deftype desc-t (ptr descriptor)) (def (struct array-object) - (decl d desc-t) ; 下位2bit以外はダミー + (decl d desc-t) ; 筝篏2bit篁ュ (decl length int) (decl el-size size-t) (decl size size-t) diff --git a/src/rule/labeled-break.rule b/src/rule/labeled-break.rule index 27dfdf3a..08870c50 100644 --- a/src/rule/labeled-break.rule +++ b/src/rule/labeled-break.rule @@ -22,10 +22,10 @@ ;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF ;;; SUCH DAMAGE. -;;;;; Javaとかで使うlabelつきbreak,continueをSCでも使用できるようにする． -;;; *label-list* = list of ( -;;; -;;; ) +;;;;; Javaт戎labelゃbreak,continueSCс篏睡с鐚 +;;; *label-list* = list of ( +;;; +;;; ) (defvar *label-list*) diff --git a/src/rule/multithread-defs.lsp b/src/rule/multithread-defs.lsp index 94311437..b9245eeb 100644 --- a/src/rule/multithread-defs.lsp +++ b/src/rule/multithread-defs.lsp @@ -37,22 +37,22 @@ (defvar *current-func* nil) -;(<ラベル 変数><入れ子関数名><ローカル変数><スレッドの判断(生成か継続か)>) +;(< 紊><ャ絖∽医><若紊><鴻ゆ(膓膓)>) (defstruct finfo - ;; 関数名? <- 違った。たぶん李さんの勘違い - ;; 関数名として使うことにする + ;; ∽医? <- ｃ吟 + ;; ∽医篏帥 id - ;; 返り値の型 + ;; 菴ゃ rettype - ;; 関数の先頭に追加する宣言のリスト + ;; ∽違菴遵絎ｈ鴻 decl - ;; 計算がどこまで終わったかを示すラベル名のリスト + ;; 荐膊障хｃ腓冴鴻 ;; list of ( ) - ;; 出現順にpush + ;; 榊憥push label - ;; 入れ子関数の名前 + ;; ャ絖∽違 nfunc-id - ;; 次につけるlnの値? + ;; 罨＜ゃln? ;; ln) ) @@ -84,7 +84,7 @@ (defun make-nestfunc-id (f-id) (generate-id (string+ (identifier f-id) "_c"))) -; block-item-listから先頭の宣言部分を取り出す +; block-item-list絎ｈ冴 (defun separate-decl (bil &aux dcl-list oth-list) (dolist (bi bil (list (nreverse dcl-list) (nreverse oth-list))) (if (and (consp bi) @@ -92,7 +92,7 @@ (push bi dcl-list) (push bi oth-list)))) -;; 入れ子関数の定義を生成 +;; ャ絖∽違絎臂 (defun make-nestfunc (nf-body) #| (setq label-l (get-id-from-string (string+ "@L" (write-to-string ln)))) @@ -113,10 +113,10 @@ (return)) (return) - ;;<入れ子関数の文>部分 + ;;<ャ絖∽違> ,@nf-body - ;;関数の最後にreturnがない場合もちゃんと呼び出し元のスレッドを - ;;runnableにしてからスケジューラにreturn + ;;∽違緇return翫＜若喝冴鴻 + ;;runnable鴻宴吾ャ若return (= (fref cp -> c) c_p) (= (fref cp -> stat) thr_runnable) (return)) diff --git a/src/rule/multithread-hoist.rule b/src/rule/multithread-hoist.rule index 0a31c2e1..5c2512d1 100644 --- a/src/rule/multithread-hoist.rule +++ b/src/rule/multithread-hoist.rule @@ -24,7 +24,7 @@ (define-ruleset multithread-hoist (hoist)) -;; マルチスレッド用プリミティブ +;; 鴻ｃ (extendrule block-item multithread-hoist ((#?(thread-create ,@body) ) (let ((body-ret (function-body body))) diff --git a/src/rule/multithread-rename.rule b/src/rule/multithread-rename.rule index 5c082e59..40110086 100644 --- a/src/rule/multithread-rename.rule +++ b/src/rule/multithread-rename.rule @@ -24,7 +24,7 @@ (define-ruleset multithread-rename (rename)) -;; マルチスレッド用プリミティブ +;; 鴻ｃ (extendrule block-item multithread-rename ((#?(thread-create ,@body) ) (ren:inc-block-level diff --git a/src/rule/multithread-sc1.rule b/src/rule/multithread-sc1.rule index e4602bfa..b3a065b7 100644 --- a/src/rule/multithread-sc1.rule +++ b/src/rule/multithread-sc1.rule @@ -24,7 +24,7 @@ (define-ruleset multithread-sc1 (sc1-to-sc0)) -;; マルチスレッド用プリミティブ +;; 鴻ｃ (extendrule statement multithread-sc1 (#?(thread-create ,@body) ~(thread-create ,@(function-body body)) ) diff --git a/src/rule/multithread-temp.rule b/src/rule/multithread-temp.rule index 79be7802..5730fa3d 100644 --- a/src/rule/multithread-temp.rule +++ b/src/rule/multithread-temp.rule @@ -24,7 +24,7 @@ (define-ruleset multithread-temp (temp)) -;; マルチスレッド用プリミティブ +;; 鴻ｃ (extendrule statement multithread-temp (#?(thread-create ,@body) ~(thread-create ,@(function-body body)) ) diff --git a/src/rule/multithread-type.rule b/src/rule/multithread-type.rule index 7f19d711..1f6ade48 100644 --- a/src/rule/multithread-type.rule +++ b/src/rule/multithread-type.rule @@ -24,7 +24,7 @@ (define-ruleset multithread-type (type-info)) -;;; マルチスレッド用プリミティブ +;;; 鴻ｃ (extendrule statement multithread-type (#?(thread-create ,@body) (type:with-new-environment diff --git a/src/rule/multithread.rule b/src/rule/multithread.rule index 55abc024..1a1ee287 100755 --- a/src/rule/multithread.rule +++ b/src/rule/multithread.rule @@ -42,8 +42,8 @@ ;;;;;; declaration ;;;;;; -;; declaration, block-item, expression の返り値は -;;(<入れ子関数のitem-list> <元の関数のitem-list>) +;; declaration, block-item, expression 菴ゃ +;;(<ャ絖∽違item-list> <∽違item-list>) (extendrule inlined-declaration multithread ;; function ((#?(,scs[storage-class-specifier] (,func-id ,@arg-id[identifier]) @@ -69,7 +69,7 @@ ~(,scs (,func-id c-p ,@arg-id) (fn ,func-texp cont-f ,@arg-texp) ,@new-decl ,@add-decl ,def-nfunc ,@new-body) - ;;msc-main関数なら、main関数の定義を追加 + ;;msc-main∽違main∽違絎臂菴遵 (when (eq ~msc-main func-id) (list ~(%include "rule/multithread-main.sc"))))) )))) (otherwise @@ -154,7 +154,7 @@ ,@caller-resume (return)) ~((return ,return-exp)))))) ) - ;;; <--- マルチスレッド用プリミティブ + ;;; <--- 鴻ｃ ((#?(thread-create ,@body)) (let* ((ln (1+ (length (mt:finfo-label mt:*current-func*)))) (label-l (generate-id (string+ "L" (write-to-string ln)))) @@ -214,13 +214,13 @@ ((#?(thread-resume ,exp)) (list (list ~(thr-resume ,exp)) (list ~(thr-resume ,exp))) ) - ;;; マルチスレッド用プリミティブ ---> + ;;; 鴻ｃ ---> ;; expression-statement (otherwise (expression x)) ) -;;; thread-createの最初の宣言用 +;;; thread-create絎ｈ (defrule mtcreate-decl multithread ((#?(,id[identifier] ,texp ,@init)) (mtcreate-decl (cons ~def x))) @@ -230,16 +230,16 @@ ;;;;;;;;;;; ;;; expression -;;; tmp.ruleの変換結果により、callは +;;; tmp.rule紊腟call ;;; (the void (call (the ,texp ,exp) ,@exp-list)) -;;; か、 +;;; ;;; (the ,texp (= (the ,texp ,id) (the ,texp (call (the ,texp ,exp) ,@exp-list))) -;;; のどちらかの形で現れるようになっている。 +;;; ＜綵≪х憗ｃ (defrule expression multithread ;; function-call - ;; ・引数の値を保存 - ;; ・呼び出す関数のポインタも保存 + ;; 糸違ゃ篆絖 + ;; 糸若喝冴∽違ゃ潟帥篆絖 ((#? #1=(the ,texp (call (the (ptr (,fn-tag[function-tag] ,fexp1 ,@fexp)) ,exp-f) ,@arg-list)) #?(the ,texp0 (= (the ,texp1 ,id) #1#))) @@ -251,14 +251,14 @@ (renew-ln ~(= ln ,ln)) (label-stat ~(label ,label-l nil)) (tmp-id (if-pattern-variable id id nil)) - ;; 第1引数に入れ子関数へのポインタを追加 + ;; 膃1綣違ャ絖∽違吾ゃ潟帥菴遵 (call-exp ~(,exp-f ,nfunc-id ,@arg-list)) (new-exp (if-pattern-variable id ~(= ,id ,call-exp) call-exp))) (push (list label-l tmp-id) (mt:finfo-label mt:*current-func*)) (list (list renew-ln new-exp label-stat) (list renew-ln new-exp)) ))) - ;; その他の式，c-exp + ;; 篁綣鐚c-exp ((#?(the ,@rem)) (list (list x) (list x)) ) ((#?(c-exp ,@rem)) diff --git a/src/rule/multithread.sh b/src/rule/multithread.sh index eb16d27d..739ccdcc 100644 --- a/src/rule/multithread.sh +++ b/src/rule/multithread.sh @@ -32,28 +32,28 @@ (decl (struct _thstelm)) -;; 継続用入れ子関数の呼び出し理由 +;; 膓膓ャ絖∽違若喝冴 (deftype reason enum rsn-cont rsn-retval) -;; 継続用入れ子関数のポインタ +;; 膓膓ャ絖∽違ゃ潟 (deftype cont-f (ptr (NESTFUNC-TAG (ptr void) (ptr (struct _thstelm)) reason))) -;; スレッドの状態 +;; 鴻倶 (def (enum _stat) - ;; 停止中で，暗黙的継続も有効 + ;; 罩≫賢э藥膓膓 thr-new-suspended - ;; 実行可能で、暗黙的継続も有効 + ;; 絎茵純с藥膓膓 thr-new-runnable - ;; 停止中で、明示的継続のみ有効 + ;; 罩≫賢с腓榊膓膓炊 thr-suspended - ;; 実行可能で、明示的継続のみ有効 + ;; 絎茵純с腓榊膓膓炊 thr-runnable - ;; 明示的継続(cont-f c)は無効 + ;; 腓榊膓膓(cont-f c)≦ thr-scheduled) -;; スレッド管理用スタックの要素 +;; 鴻膊∞鴻帥荀膣 (def (struct _thstelm) (def c cont-f) (def stat (enum _stat))) @@ -63,24 +63,24 @@ (deftype thst-ptr (ptr (struct _thstelm))) (deftype cont thst-ptr) -;; スレッド管理用スタック +;; 鴻膊∞鴻帥 (def thst (array thstelm 65536)) -;; スレッド管理用スタックのトップ +;; 鴻膊∞鴻帥 (def thst-top thst-ptr thst) (deftype schdexit (ptr (NESTFUNC-TAG void))) -;; スケジューラの非局所脱出先 +;; 鴻宴吾ャ若絮怨阪 (def cur-schd-exit schdexit 0) (def cur-schd-thst-top thst-ptr thst) (def scheduling (fn void) (def L0 --label--) - ;;元のスケジューラの情報 + ;;鴻宴吾ャ若 (def prev-exit schdexit cur-schd-exit) (def prev-thst-top thst-ptr cur-schd-thst-top) - ;;このスケジュラの情報 + ;;鴻宴吾ャ (def mythst-top thst-ptr thst-top) (def nonlocalexit (NESTFUNC-TAG void) (goto L0)) @@ -89,15 +89,15 @@ (= cur-schd-thst-top (= thst-top mythst-top)) (while 1 (let ((cp thst-ptr)) - ;;ここで元のスケジューラへの非局所脱出を試みる + ;;у鴻宴吾ャ若吾絮怨冴荅帥 (for ((= cp prev-thst-top) (< cp mythst-top) (inc cp)) (if (!= (fref cp -> stat) thr-scheduled) (break)) - ;; 間が全て thr-scheduled なら + ;; thr-scheduled (if (== cp mythst-top) (if prev-exit (prev-exit))))) - ;; runnableなスレッドを探す + ;; runnable鴻｢ (let ((cp thst-ptr) (cc cont-f)) (for ((= cp (- thst-top 1)) @@ -108,8 +108,8 @@ (break))) (if (< cp thst) (begin - ;; 見つからなかったときは他のプロセッサからの要求を処理すべし - ;; 今回は何もしない + ;; 荀ゃｃ篁祉泣荀羆鴻 + ;; 篁篏 (c-exp "fprintf(stderr, ~A)" "No Active thread!~%") (c-exp "exit(1)") )) @@ -118,12 +118,12 @@ (= (fref cp -> c) 0) (= (fref cp -> stat) thr-scheduled) (cc cp rsn-cont))) - ;;直下がnew-runnableならpopし、そちらに制御を移す + ;;岩new-runnablepop＜九勝腱祉 (if (and (> thst-top thst) (== (fref (- thst-top 1) -> stat) thr-new-runnable)) (begin (dec thst-top) (break)))) - ;; 元のスケジューラの情報を戻す + ;; 鴻宴吾ャ若宴祉 (= cur-schd-exit prev-exit) (= cur-schd-thst-top prev-thst-top)) diff --git a/src/rule/nestfunc-defs.lsp b/src/rule/nestfunc-defs.lsp index 272cd88b..5b7cf794 100644 --- a/src/rule/nestfunc-defs.lsp +++ b/src/rule/nestfunc-defs.lsp @@ -52,51 +52,51 @@ (defstruct finfo - name ;関数名 - parent-func ;親関数のfinfo構造体（非nil iff 入れ子関数） - ret-type ;返り値の型 - argp ;argpの要/不要 (=入れ子関数呼び出しの有無) - ;; (<復帰位置を示すラベル名> . <フレーム復帰用コード>) のリスト(逆順) + name ;∽医 + parent-func ;荀∽違finfo罕篏鐚nil iff ャ絖∽逸 + ret-type ;菴ゃ + argp ;argp荀/筝荀 (=ャ絖∽医若喝冴) + ;; (<緇絽遺臀腓冴> . <若緇絽亥潟若>) 鴻() label-list ;; ( . ) - ;; frameには var-list #|と tmp-listの両方を|# 入れる - ;; （nf-list の orig-name も入れる） - ;; frame-save, frame-resume はvar-listのみ - ;; tmp-list は不要か？ - var-list ;通常のローカル変数のリスト＋関数のポインタ保存用 - tmp-list ;一時変数のリスト（call時の引数，入れ子関数ポインタ保存用） - nf-list ;定義された入れ子関数のリスト ( . ) - ;; 明示的スタックを参照するローカル変数．list of - ;; var-listと重複．入れ子関数は nf-listで管理するのでここには入れない - ;; search-ptr での収集方針により，var-listでないものも入り得る． + ;; frame var-list #| tmp-list筝≧鴻|# ャ + ;; 鐚nf-list orig-name ャ鐚 + ;; frame-save, frame-resume var-list + ;; tmp-list 筝荀鐚 + var-list ;絽吾若紊違鴻鐚∽違ゃ潟推絖 + tmp-list ;筝紊違鴻鐚call綣逸ャ絖∽違ゃ潟推絖鐚 + nf-list ;絎臂ャ絖∽違鴻 ( . ) + ;; 腓榊鴻帥с若紊逸list of + ;; var-list茲鐚ャ絖∽違 nf-listх∞сャ + ;; search-ptr с拷鐚var-listсャ緇鐚 estack-var - ;; staticで定義された変数 ( . )．var-listと重複． + ;; staticу臂紊 ( . )鐚var-list茲鐚 static-var - ;; 局所ラベルのリスト(def ,id __label__)で定義。入れ子関数脱出用 - ;; (<ラベル名> . <復帰コード>)。宣言と逆順 + ;; 絮鴻(def ,id __label__)у臂ャ絖∽域怨榊 + ;; (<> . <緇絽違潟若>)絎ｈ local-label ) -;; フレーム構造体の管理 +;; 若罕篏膊∞ (defstruct frame-struct-info - name ; 構造体名 (SCのid) - func-name ; 対応する関数名 (SCのid) + name ; 罕篏 (SCid) + func-name ; 絲上∽医 (SCid) ) -;;; global関数名 +;;; global∽医 (defvar *global-funcs* '()) -;;; 関数フレームの構造体情報 -;;; ( <関数名(symbol)> . <構造体情報> ) のリスト -;;; <構造体情報> := ( <構造体名> ) +;;; ∽違若罕篏 +;;; ( <∽医(symbol)> . <罕篏> ) 鴻 +;;; <罕篏> := ( <罕篏> ) (defvar *frame-alist* '() ) -;;; 現在いる関数の情報 +;;; 憜∽違 (defvar *current-func* nil) (defvar *estack-size* 65536) (defvar *all-in-estack* nil) -;;;; 環境設定 +;;;; 医荐絎 (defmacro with-nestfunc-environment (&body body) `(let ((*global-funcs* '()) (*estack-size* (ruleset-param 'rule::estack-size)) @@ -106,7 +106,7 @@ ,@body)) -;;;; 関数 +;;;; ∽ (defun add-global-func (fid) (push fid *global-funcs*)) @@ -114,17 +114,17 @@ (defun global-func-p (fid) (member fid *global-funcs* :test #'eq)) -;;; マルチスレッド環境で，スタックの最初のフレームを判断する条件 +;;; 鴻医э鴻帥若ゆ＞散 (defun thread-origin-p (finfo-or-fid) (let ((fid (if (symbolp finfo-or-fid) finfo-or-fid (finfo-name finfo-or-fid)))) (or (eq ~main fid) - (eq ~thread-origin fid)))) ; 不要か？ + (eq ~thread-origin fid)))) ; 筝荀鐚 -;;; 関数名を*frame-alist*から探して関数フレームの構造体情報を得る。 -;;; 未登録の場合は登録して、登録した構造体情報を返す。 +;;; ∽医*frame-alist*｢∽違若罕篏宴緇 +;;; 脂蚊翫脂蚊脂蚊罕篏宴菴 (defun get-frame (x) (let* ((asc (assoc x *frame-alist* :test #'eq))) (if asc @@ -135,34 +135,34 @@ (push (cons x frame-info) *frame-alist*) frame-info)))) -;;; 関数名=>関数のフレーム構造体名 +;;; ∽医=>∽違若罕篏 (defun get-frame-name (fname) (frame-struct-info-name (get-frame fname))) -;;; 現関数（親は含まない）のlocal-variableか？ -;;; tmp-list内のもの，入れ子関数は検索対象ではない． +;;; 憥∽逸荀障鐚local-variable鐚 +;;; tmp-list鐚ャ絖∽違罎膣√乗院с鐚 (defun local-variable-p (id &optional (finfo *current-func*)) (and *current-func* (assoc id (finfo-var-list finfo) :test #'eq))) -;;; 現関数（親は含まない）の明示的スタックに値があるlocal-variableか？ +;;; 憥∽逸荀障鐚腓榊鴻帥ゃlocal-variable鐚 (defun estack-variable-p (id &optional (finfo *current-func*) - (skip-lv-check nil)) ; local-variable-p のチェックを省略 + (skip-lv-check nil)) ; local-variable-p с (and (or skip-lv-check (local-variable-p id finfo)) (member id (finfo-estack-var finfo) :test #'eq))) -;;; 現関数（親は含まない）でstaticで定義されたlocal-variableか？ -;;; そうなら，ext-idを返す． +;;; 憥∽逸荀障鐚staticу臂local-variable鐚 +;;; 鐚ext-id菴鐚 (defun static-variable-p (id &optional (finfo *current-func*) - (skip-lv-check nil)) ; local-variable-p のチェックを省略 + (skip-lv-check nil)) ; local-variable-p с (and (or skip-lv-check (local-variable-p id finfo)) (cdr (assoc id (finfo-static-var finfo) :test #'eq)))) -;;; 現関数(=0)からいくつ外の関数で定義された local-variable/nestfunc か? -;;; 見つからなければ -1 -;;; 第二返り値は local-varriable-> :var, nestfunc-> :nestfunc -;;; 第三返り値は 見つかった関数のfinfo -;;; 第四返り値は local-variable-p/nestfunc-extid の返り値 +;;; 憥∽(=0)ゅ∽違у臂 local-variable/nestfunc ? +;;; 荀ゃ -1 +;;; 膃篋菴ゃ local-varriable-> :var, nestfunc-> :nestfunc +;;; 膃筝菴ゃ 荀ゃｃ∽違finfo +;;; 膃菴ゃ local-variable-p/nestfunc-extid 菴 (defun howmany-outer (id &optional (finfo *current-func*)) (labels ((rec (curfunc acc) (acond @@ -175,7 +175,7 @@ (t (rec (finfo-parent-func curfunc) (1+ acc))) ))) (rec finfo 0))) -;;; 与えられた関数情報からフレーム構造体の定義を作る +;;; 筝∽井宴若罕篏絎臂篏 (defun make-frame-def (fi) (let* ((frm-info (get-frame (finfo-name fi))) (frame-name (frame-struct-info-name frm-info)) @@ -186,19 +186,19 @@ (member-defs (mapcar #'(lambda (x) ~(def ,(car x) ,(cdr x))) member-list))) ~(def (struct ,frame-name) - (def tmp-esp (ptr char)) ; これは、絶対に先頭 + (def tmp-esp (ptr char)) ; 腟九障 (def argp (ptr char)) (def call-id int) ,@member-defs))) -;;; 全ての関数フレーム構造体の宣言を作る +;;; ∽違若罕篏絎ｈ篏 (defun make-all-frame-decls () - (nreverse ; nreverseは必須ではない + (nreverse ; nreverse綽с (loop for (fn-name . frm-info) in *frame-alist* collect (with1 frame-name (frame-struct-info-name frm-info) ~(decl (struct ,frame-name))))) ) -;;; トップレベルに追加する宣言の処理 +;;; 菴遵絎ｈ (defvar *static-var-defs* ()) (defvar *frame-defs* ()) (defvar *nestfunc-defs* ()) @@ -221,7 +221,7 @@ (prog1 (nreverse *nestfunc-defs*) (setq *nestfunc-defs* ()))) -;;; ブロックの先頭に追加する宣言の処理 +;;; 菴遵絎ｈ (defvar *additional-local-decls* ()) (defmacro with-new-block (&body body) `(let ((*additional-local-decls* ())) ,@body)) @@ -231,7 +231,7 @@ (prog1 (nreverse *additional-local-decls*) (setq *additional-local-decls* ()))) -;;; 各文の直前に追加する文の処理 +;;; 翫菴遵 (defvar *precedents* ()) (defmacro with-block-item (&body body) `(let ((*precedents* ())) ,@body)) @@ -241,37 +241,37 @@ (prog1 (nreverse *precedents*) (setq *precedents* ()))) -;;; 今トップレベルにいるかどうかの判定 +;;; 篁ゅ (defun top-level-p (&key (finfo *current-func*)) (not finfo)) -;;; --local-- で宣言された局所ラベルを追加 -;;; cons の cdr 部はフレーム復帰用コードで，後から追加 +;;; --local-- уｈ絮菴遵 +;;; cons cdr 若緇絽亥潟若э緇菴遵 (defun finfo-add-local-label (id &key (finfo *current-func*)) (push (cons id nil) (finfo-local-label finfo))) -;;; *current-func*に変数情報を追加して、declaration文を返す +;;; *current-func*紊井宴菴遵declaration菴 (defun finfo-add-local (id texp mode &key (init nil) (finfo *current-func*)) - ;; mode： :var or :temp + ;; mode鐚 :var or :temp (when finfo (case mode - ((:var) ; （estack-varでなければ）save/resume の対象 + ((:var) ; 鐚estack-varс逸save/resume 絲乗院 (when (let ((ttexp (remove-type-qualifier texp))) (or (and (listp ttexp) (eq ~array (car ttexp))) *all-in-estack*)) (pushnew id (finfo-estack-var finfo) :test #'eq)) (push (cons id texp) (finfo-var-list finfo))) - ((:tmp) ; save/resume の対象にならない + ((:tmp) ; save/resume 絲乗院 (push (cons id texp) (finfo-tmp-list finfo))) - ((:static) ; 外に出す．frameにも入れない． + ((:static) ; 紊冴鐚frameャ鐚 (let ((ext-id (generate-id (string+ (identifier0! id :sc2c) "_in_" (identifier0! (finfo-name finfo) :sc2c))))) (push (cons id texp) (finfo-var-list finfo)) (push (cons id ext-id) (finfo-static-var finfo)) - (setq id ext-id))) ; 名前を衝突しないように変更 - ((:system) ; 補助変数（特に副作用なし） + (setq id ext-id))) ; 茵腦紊 + ((:system) ; 茖紊逸鴻篏鐚 ) (otherwise (error "unexpected value of 'mode'(~s)" mode)))) @@ -279,22 +279,22 @@ ~(def ,id ,texp ,init) ~(def ,id ,texp))) -;;; *current-func* に入れ子関数情報を追加 +;;; *current-func* ャ絖∽井宴菴遵 (defun finfo-add-nestfunc (id extid &optional (finfo *current-func*)) (push (cons id extid) (finfo-nf-list finfo)) ) -;;; 次のcall-idの数字 +;;; 罨＜call-id医 (defun finfo-next-call-id (&optional (finfo *current-func*)) (length (finfo-label-list finfo))) -;;; 復帰位置を示すラベルを追加．ラベル名を返す． +;;; 緇絽遺臀腓冴菴遵鐚菴鐚 (defun finfo-add-resume-label (&optional (finfo *current-func*) (base-name "L_CALL")) (with1 label-id (rule:generate-id base-name) (push (cons label-id nil) (finfo-label-list finfo)) label-id)) -;;; 与えられた関数情報から復帰処理を行うstatementを作る +;;; 筝∽井宴緇絽医茵statement篏 (defun make-resume (fi) (unless (or (finfo-label-list fi) (finfo-local-label fi)) @@ -303,10 +303,10 @@ (let ((reconst-impossible (or (eq ~main (finfo-name fi)) (finfo-parent-func fi) *all-in-estack*)) - ; スタックの積み直し中に成り得ない + ; 鴻帥腥睡眼筝緇 (case-goto (append - ;; 入れ子関数呼び出し終了後の復帰 + ;; ャ絖∽医若喝冴腟篋緇緇絽 (do ((ret nil) (k 0 (1+ k)) (lb (reverse (finfo-label-list fi)) (cdr lb))) @@ -315,7 +315,7 @@ ,@(cdar lb) (goto ,(caar lb))) ret)) - ;; gotoによる入れ子関数から親関数への脱出先 + ;; gotoャ絖∽違荀∽違吾怨阪 (do ((ret nil) (k -1 (1- k)) (lb (reverse (finfo-local-label fi)) (cdr lb))) @@ -341,7 +341,7 @@ ,@(when (finfo-label-list fi) ~( (goto ,(caar (last (finfo-label-list fi)))) ))))))) -;;; efp(xfp)の設定および espをフレームサイズ分移動させる +;;; efp(xfp)荐絎 esp若泣ゃ阪腱糸 (defun make-init-efp-esp (fi) (let ((frame-type ~(struct ,(get-frame-name (finfo-name fi))))) (list* @@ -352,17 +352,17 @@ (list ~(= (fref efp -> xfp) xfp) ))) )) -;;; parmp の初期値 +;;; parmp (defun make-parmp-init (&optional (all-in-estack *all-in-estack*)) ~(cast (ptr char) ,(if all-in-estack ~esp ~(bit-xor (cast size-t esp) esp-flag))) ) -;;; （*all-in-estack*時）引数の値をestackに保存 +;;; 鐚*all-in-estack*鐚綣違ゃestack篆絖 (defun save-args-into-estack (argid-list argtexp-list &optional (finfo *current-func*)) - ;; ちょっと手抜きで型情報 (the)なし + ;; ＜ｃу (the) (mapcar #'(lambda (id texp) (if (finfo-parent-func finfo) ~(= (fref efp -> ,id) (pop-arg ,texp parmp)) @@ -370,24 +370,24 @@ argid-list argtexp-list) ) -;;; 入れ子関数のid -> トップレベルに移した関数のid +;;; ャ絖∽違id -> 腱祉∽違id (defun make-extid (id &optional (pfinfo *current-func*)) (generate-id (string+ (identifier0! id :sc2c) "_in_" (identifier0! (finfo-name pfinfo) :sc2c))) ) -;;; idが現在の関数（親は除く）内で定義された入れ子関数か？ -;;; もしそうなら，ext-name を返す +;;; id憜∽逸荀ゃ鐚у臂ャ絖∽違鐚 +;;; 鐚ext-name 菴 (defun nestfunc-extid (id &optional (finfo *current-func*)) (and *current-func* (cdr (assoc id (finfo-nf-list finfo) :test #'eq)))) -;;; 入れ子関数の参照 -> etackへの参照 -;;; （pfinfo: 親関数情報） +;;; ャ絖∽違 -> etack吾 +;;; 鐚pfinfo: 荀∽井縁 (defun nestfunc-in-estack (fid &optional (pfinfo *current-func*)) (declare (ignore pfinfo)) ~(ptr (fref efp -> ,fid))) -;;; 与えられた関数情報から入れ子関数を正規化するコードを作る +;;; 筝∽井宴ャ絖∽違罩ｈ潟若篏 (defun make-normalize-nf (&optional (fi *current-func*)) (let ((nf-list (finfo-nf-list fi))) (apply #'nconc @@ -399,7 +399,7 @@ (cast (ptr void) efp)) )) nf-list)))) -;;; 与えられた関数情報からフレーム情報を保存するコードを作る +;;; 筝∽井宴若宴篆絖潟若篏 (defun make-frame-save (&optional (fi *current-func*)) (mapcar #'(lambda (x) @@ -409,7 +409,7 @@ (eq ~closure-t (cdr x)))) (finfo-var-list fi)))) -;;; 与えられた関数情報からフレーム情報を復活するコードを作る +;;; 筝∽井宴若宴緇羇祉潟若篏 (defun make-frame-resume (&optional (fi *current-func*)) (mapcar #'(lambda (x) @@ -419,7 +419,7 @@ (eq ~closure-t (cdr x)))) (finfo-var-list fi)))) -;;; 与えられた関数情報から関数中断用のreturnを生成するコードを作る +;;; 筝∽井宴∽遺賢return潟若篏 (defun make-suspend-return (&optional (fi *current-func*)) (cond ((finfo-parent-func fi) ;;~(return (fref efp -> tmp-esp))) @@ -429,11 +429,11 @@ (t ~(return (SPECIAL ,(finfo-ret-type *current-func*)))))) -;;; 与えられたラベル名が、親関数の局所ラベルとして定義されているか調べる。 -;;; 定義されていなければ,返り値はnil。定義されていれば、 -;;; (values <自分からみて何番目の親関数に定義されていたか> -;;; <その定義 (