Patch Detail
get:
Show a patch.
patch:
Update a patch.
put:
Update a patch.
GET /api/patches/2195314/?format=api
{ "id": 2195314, "url": "http://patchwork.ozlabs.org/api/patches/2195314/?format=api", "web_url": "http://patchwork.ozlabs.org/project/gcc/patch/83b0975e-d57e-4aaf-9f21-8d0056ecba69@gmail.com/", "project": { "id": 17, "url": "http://patchwork.ozlabs.org/api/projects/17/?format=api", "name": "GNU Compiler Collection", "link_name": "gcc", "list_id": "gcc-patches.gcc.gnu.org", "list_email": "gcc-patches@gcc.gnu.org", "web_url": null, "scm_url": null, "webscm_url": null, "list_archive_url": "", "list_archive_url_format": "", "commit_url_format": "" }, "msgid": "<83b0975e-d57e-4aaf-9f21-8d0056ecba69@gmail.com>", "list_archive_url": null, "date": "2026-02-10T18:17:09", "name": "[8/13] Coarray shared memory library", "commit_ref": null, "pull_url": null, "state": "new", "archived": false, "hash": "47021645f010ac80f279573d8858442c837e7017", "submitter": { "id": 78264, "url": "http://patchwork.ozlabs.org/api/people/78264/?format=api", "name": "Jerry D", "email": "jvdelisle2@gmail.com" }, "delegate": null, "mbox": "http://patchwork.ozlabs.org/project/gcc/patch/83b0975e-d57e-4aaf-9f21-8d0056ecba69@gmail.com/mbox/", "series": [ { "id": 491723, "url": "http://patchwork.ozlabs.org/api/series/491723/?format=api", "web_url": "http://patchwork.ozlabs.org/project/gcc/list/?series=491723", "date": "2026-02-10T18:17:09", "name": null, "version": 1, "mbox": "http://patchwork.ozlabs.org/series/491723/mbox/" } ], "comments": "http://patchwork.ozlabs.org/api/patches/2195314/comments/", "check": "pending", "checks": "http://patchwork.ozlabs.org/api/patches/2195314/checks/", "tags": {}, "related": [], "headers": { "Return-Path": "<gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org>", "X-Original-To": [ "incoming@patchwork.ozlabs.org", "gcc-patches@gcc.gnu.org" ], "Delivered-To": [ "patchwork-incoming@legolas.ozlabs.org", "gcc-patches@gcc.gnu.org" ], "Authentication-Results": [ "legolas.ozlabs.org;\n\tdkim=pass (2048-bit key;\n unprotected) header.d=gmail.com header.i=@gmail.com header.a=rsa-sha256\n header.s=20230601 header.b=e1h4irI4;\n\tdkim-atps=neutral", "legolas.ozlabs.org;\n spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org\n (client-ip=2620:52:6:3111::32; helo=vm01.sourceware.org;\n envelope-from=gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org;\n receiver=patchwork.ozlabs.org)", "sourceware.org;\n\tdkim=pass (2048-bit key,\n unprotected) header.d=gmail.com header.i=@gmail.com header.a=rsa-sha256\n header.s=20230601 header.b=e1h4irI4", "sourceware.org;\n dmarc=pass (p=none dis=none) header.from=gmail.com", "sourceware.org; spf=pass smtp.mailfrom=gmail.com", "server2.sourceware.org;\n arc=none smtp.remote-ip=209.85.214.176" ], "Received": [ "from vm01.sourceware.org (vm01.sourceware.org\n [IPv6:2620:52:6:3111::32])\n\t(using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)\n\t key-exchange x25519 server-signature ECDSA (secp384r1) server-digest SHA384)\n\t(No client certificate requested)\n\tby legolas.ozlabs.org (Postfix) with ESMTPS id 4f9VDV2XN2z1xvb\n\tfor <incoming@patchwork.ozlabs.org>; Wed, 11 Feb 2026 05:18:18 +1100 (AEDT)", "from vm01.sourceware.org (localhost [127.0.0.1])\n\tby sourceware.org (Postfix) with ESMTP id 5E58B4BA2E1A\n\tfor <incoming@patchwork.ozlabs.org>; Tue, 10 Feb 2026 18:18:16 +0000 (GMT)", "from mail-pl1-f176.google.com (mail-pl1-f176.google.com\n [209.85.214.176])\n by sourceware.org (Postfix) with ESMTPS id BED084BA2E1A\n for <gcc-patches@gcc.gnu.org>; Tue, 10 Feb 2026 18:17:11 +0000 (GMT)", "by mail-pl1-f176.google.com with SMTP id\n d9443c01a7336-2aaed195901so12090255ad.0\n for <gcc-patches@gcc.gnu.org>; Tue, 10 Feb 2026 10:17:11 -0800 (PST)", "from [10.168.168.23] ([50.37.179.80])\n by smtp.gmail.com with ESMTPSA id\n d9443c01a7336-2aa3ec42e2asm154817875ad.53.2026.02.10.10.17.09\n (version=TLS1_3 cipher=TLS_AES_128_GCM_SHA256 bits=128/128);\n Tue, 10 Feb 2026 10:17:09 -0800 (PST)" ], "DKIM-Filter": [ "OpenDKIM Filter v2.11.0 sourceware.org 5E58B4BA2E1A", "OpenDKIM Filter v2.11.0 sourceware.org BED084BA2E1A" ], "DMARC-Filter": "OpenDMARC Filter v1.4.2 sourceware.org BED084BA2E1A", "ARC-Filter": "OpenARC Filter v1.0.0 sourceware.org BED084BA2E1A", "ARC-Seal": "i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1770747432; cv=none;\n b=SQdVelVVPMX/uHSZNiOACagr78e2uAZpJbdRyYhOI2uPf3gEdlcz/rnbg/QxT/YghXf0J2EIfTW8rvTrTN7mX4SO7+vsM5hrSE5mGNTVDxuFsRTCr/JHVl/qPbDNHMVuJDrOm3QD9OV88bP9jbDDeHWb7SgDfBo2746A8lG2AC0=", "ARC-Message-Signature": "i=1; a=rsa-sha256; d=sourceware.org; s=key;\n t=1770747432; c=relaxed/simple;\n bh=ZDWuKqYS42RLvDvvMODm27lqREWvaIxNXVmxhSy7sMQ=;\n h=DKIM-Signature:Message-ID:Date:MIME-Version:To:From:Subject;\n b=j9tgryMXrKMeH64KS7bngQOcYryzWHSIUk///h0NrDuJ/pxgj21Nn8kricQG/7+2/Dk32K+2AD1UpwzvNOuaw4Awx4JhD4bPS+pzBgSNScVp2TyXBAYBwcccyxaauz1v7pc5E0SVTP2XJvNO0LjQbX1E6/btLbEQU/Up0fMXVuQ=", "ARC-Authentication-Results": "i=1; server2.sourceware.org", "DKIM-Signature": "v=1; a=rsa-sha256; c=relaxed/relaxed;\n d=gmail.com; s=20230601; t=1770747431; x=1771352231; darn=gcc.gnu.org;\n h=autocrypt:subject:from:cc:to:content-language:user-agent\n :mime-version:date:message-id:from:to:cc:subject:date:message-id\n :reply-to; bh=ZDWuKqYS42RLvDvvMODm27lqREWvaIxNXVmxhSy7sMQ=;\n b=e1h4irI4qPFTe4T0LBIr9dqikY2UNFeYjYJ/PQgmNWQd4G4A7xklzV7/urrBlFgTvO\n Dzxu4IuNhgxQUPB4ynjMQmSI7A0N6dr7LNXkZvrSQr6j3Xr8arUics11aDSCbGNP2k9/\n pXFVEGOQUmIoQG5Y5zB3guf5t++Cew5jh5fWds4aWEnt6/PiTfJGKQZ/BiS/2yoMJgT+\n 4eBYGdfdQEOZUmwblDAP+iTznOZrut0QYgj1bg4WRjNsnxe0el7ZfutoSbkXnph60ORY\n FkXeNNHXuakzzhid51D7KGL6NougXahqriaAvzavnRjt6vfi1kT0vLBi3tsg/btrZDdC\n NOLg==", "X-Google-DKIM-Signature": "v=1; a=rsa-sha256; c=relaxed/relaxed;\n d=1e100.net; s=20230601; t=1770747431; x=1771352231;\n h=autocrypt:subject:from:cc:to:content-language:user-agent\n :mime-version:date:message-id:x-gm-gg:x-gm-message-state:from:to:cc\n :subject:date:message-id:reply-to;\n bh=ZDWuKqYS42RLvDvvMODm27lqREWvaIxNXVmxhSy7sMQ=;\n b=w9GbRpBABw+UwcnmiEMxMBdRYaI79RTrPD9oBZ87qXW98CO0EfOhDS9N3TWH3BnDPk\n fqT3/7wwsZB+/widi3HvoK0oxllniCmBVyhwfCGqDUs2VCFNEIuchIga79wYbtbrPwKj\n wHmKY1xeNw/+lO0badLY0hsEoJo4rq6qg7Ln0Gnzgt4C1OUaBYMsU0ajQGSQpvQLKNG/\n QzVYyakJQ6+aa+/lf0kyKLtcx0HLPCabOm7zUD2QPDoYkBvGMhsn3ox0kOpH+IpmamoV\n kp++dAToG4iGXF3zeL358I9iLVLlwRFyPxWEbd9KGJzYUqqhmUl0y2QNVoWFVknB3ZEQ\n MNuQ==", "X-Forwarded-Encrypted": "i=1;\n AJvYcCVKC0KsvEN51kk7ncvppI8jWEJlOtOp7EoPoR4iRScofBNJBH+6Op5n2B0SmNxnt5nOHKMCr+YADGaRzw==@gcc.gnu.org", "X-Gm-Message-State": "AOJu0YydTYrJk8iQTmrM4IAL4go4GqNm5GwAAUduSdVjnS6s6HCUvMHD\n iN+Wh7TW5m2EjvYNoiylrCCbqUTZSHVbL+YSaoWfyS4eRk05Ti0dqAO9", "X-Gm-Gg": "AZuq6aI4i3qlkdJdQMEcifc0KcZNVbCfg4Qs9FcaUP3bo/KJWOiJFcMN7m+dGfXv2O/\n hblwgNA7I5qoeXdkjEBu+/MDuS9mMAXhBAwrAdG/Cn5wwwAyZD2LJ1goiygwxtzydsYDQBCwAKH\n Re4Rqzgwy5tkZUZG4mcaWEyrq4x3ZjR51+GqCAEsVetvsO7VWkvGaz7UUcc2BSsYMDj0CtT0Ypt\n NtS0EY3PpD2nxmlgNKJ60CAymF+wFtH78R4Wb3eMNf5rJ0mfGKl1YisD5LGVypmrf6By4W1k6bl\n IxsKstF6c7qLLMxrMNR1vcw90Q+Vj1B4amnmaifUSKBUf+FxnZfm9BZXQyy72LrZ+iWvLUNlfrN\n 4Pfz7O9wxOqySoojIVIQ24PtwGf5BcEUa507G0zZYQ0Q97Tid5t//C4X5OsHhmh4b0kQSEMGqM3\n rLRQSdL7cEKuexLvZDrFBnPA6OsZk=", "X-Received": "by 2002:a17:903:22d1:b0:2aa:d647:b3ed with SMTP id\n d9443c01a7336-2ab106e5923mr29289885ad.34.1770747430664;\n Tue, 10 Feb 2026 10:17:10 -0800 (PST)", "Content-Type": "multipart/mixed; boundary=\"------------h3oQgfcMTQDta0VvTRdR5fmm\"", "Message-ID": "<83b0975e-d57e-4aaf-9f21-8d0056ecba69@gmail.com>", "Date": "Tue, 10 Feb 2026 10:17:09 -0800", "MIME-Version": "1.0", "User-Agent": "Mozilla Thunderbird", "Content-Language": "en-US", "To": "gfortran <fortran@gcc.gnu.org>, gcc-patches <gcc-patches@gcc.gnu.org>", "Cc": "Tobias Burnus <tburnus@baylibre.com>, Richard Biener <rguenther@suse.de>,\n Andre Vehreschild <vehre@gmx.de>, Jakub Jelinek <jakub@redhat.com>,\n Paul Richard Thomas <paul.richard.thomas@gmail.com>,\n FX Coudert <fxcoudert@gmail.com>, Toon Moene <toon@moene.org>", "From": "Jerry D <jvdelisle2@gmail.com>", "Subject": "[PATCH 8/13] Coarray shared memory library", "Autocrypt": "addr=jvdelisle2@gmail.com; keydata=\n xjMEY5TlkxYJKwYBBAHaRw8BAQdAyrkRDhmJhSTTlV/50gJLlvliU6/Lm5C9ViKV8T9y1GnN\n HkplcnJ5IEQgPGp2ZGVsaXNsZTJAZ21haWwuY29tPsKJBBMWCAAxFiEEOFR0TS0390uh8dRV\n uWXAJaWpwWoFAmOU5ZMCGwMECwkIBwUVCAkKCwUWAgMBAAAKCRC5ZcAlpanBalsJAP4wdCiH\n 2Of9oZv1QWgZ/AVdbWFM3Fv47/WZQHOXfoZ9HgD6AkXrKeJ+6usST7PEaDJjptaViT1fLiYY\n V/6XaOKSsgLOOARjlOWTEgorBgEEAZdVAQUBAQdAdA7PczYnl07vnOT9oP/wvvMDd4HP09Zl\n g3LzwXQJWT8DAQgHwngEGBYIACAWIQQ4VHRNLTf3S6Hx1FW5ZcAlpanBagUCY5TlkwIbDAAK\n CRC5ZcAlpanBasF/AQCa5WjlsVpLsEiggZyT18MOJNAdeRd7wkGDUrwedHrvawD/cE1H+/Ms\n L1ZwvQiLfGdx8crigQqWTQyos4kH8Wx82wc=", "X-BeenThere": "gcc-patches@gcc.gnu.org", "X-Mailman-Version": "2.1.30", "Precedence": "list", "List-Id": "Gcc-patches mailing list <gcc-patches.gcc.gnu.org>", "List-Unsubscribe": "<https://gcc.gnu.org/mailman/options/gcc-patches>,\n <mailto:gcc-patches-request@gcc.gnu.org?subject=unsubscribe>", "List-Archive": "<https://gcc.gnu.org/pipermail/gcc-patches/>", "List-Post": "<mailto:gcc-patches@gcc.gnu.org>", "List-Help": "<mailto:gcc-patches-request@gcc.gnu.org?subject=help>", "List-Subscribe": "<https://gcc.gnu.org/mailman/listinfo/gcc-patches>,\n <mailto:gcc-patches-request@gcc.gnu.org?subject=subscribe>", "Errors-To": "gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org" }, "content": "Dear all, as requested,\n\nSee attached patch 8 of 13\n\nBest Regards,\n\nJerry", "diff": "commit 290f3b399ec3cb5991e28edf30cc55ba3a39c176\nAuthor: Andre Vehreschild <vehre@gcc.gnu.org>\nDate: Wed Aug 6 15:36:54 2025 +0200\n\n Fortran: Fix caf_shmem syncing on Windows.\n \n Cygwin's libc's pthread implementation does not support setting\n pshared on mutexes and condition variables. Therefore Windows\n synchronisation primitives needed to be used directly.\n On MSYS2/UCRT64 fork and mmap are not available and Windows core\n functionality needs to be used.\n \n libgfortran/ChangeLog:\n \n * caf/shmem.c (_gfortran_caf_init): Cleanup thread helper after\n use.\n (_gfortran_caf_finalize): Same.\n (_gfortran_caf_register): Handle lock_t correctly on Windows.\n (GEN_OP): Prevent warnings on non-initialized.\n (_gfortran_caf_lock): Handle lock_t correctly on Windows.\n (_gfortran_caf_unlock): Same.\n (_gfortran_caf_random_init): Fix formatting.\n (_gfortran_caf_form_team): Add more images to counter_barrier.\n * caf/shmem/alloc.c: Use routines from thread_support.\n * caf/shmem/allocator.c (allocator_lock): Same.\n (allocator_unlock): Same.\n * caf/shmem/allocator.h: Same.\n * caf/shmem/collective_subroutine.c (get_collsub_buf): Same.\n * caf/shmem/collective_subroutine.h: Same.\n * caf/shmem/counter_barrier.c (lock_counter_barrier): Same.\n (unlock_counter_barrier): Same.\n (counter_barrier_init): Same.\n (counter_barrier_wait): Same.\n (change_internal_barrier_count): Same.\n (counter_barrier_add): Same.\n (counter_barrier_init_add): Only increase value w/o signaling.\n (counter_barrier_get_count): Use routines from thread_support.\n * caf/shmem/counter_barrier.h: Same.\n (counter_barrier_init_add): New routine.\n * caf/shmem/shared_memory.c: Use windows routines where\n applicable.\n (shared_memory_set_env): Same.\n (shared_memory_get_master): Same.\n (shared_memory_init): Same.\n (shared_memory_cleanup): Same.\n * caf/shmem/shared_memory.h: Use types from thread_support.\n * caf/shmem/supervisor.c: Use windows routines where applicable.\n (get_memory_size_from_envvar): Same.\n (ensure_shmem_initialization): Same.\n (supervisor_main_loop): Use windows process start on windows\n without fork().\n * caf/shmem/supervisor.h: Use types from thread_support.\n * caf/shmem/sync.c (lock_table): Use routines from thread_support.\n (unlock_table): Same.\n (sync_init): Same.\n (sync_init_supervisor): Same.\n (sync_table): Same.\n (lock_event): Same.\n (unlock_event): Same.\n (event_post): Same.\n (event_wait): Same.\n * caf/shmem/sync.h: Use types from thread_support.\n * caf/shmem/teams_mgmt.c (update_teams_images): Use routines from\n thread_support.\n * caf/shmem/thread_support.c: Add synchronisation primitives for\n windows.\n (smax): Windows only: Max for size_t.\n (get_handle): Windows only: Get the windows handle for a given\n id or create a new one, if it does not exist.\n (get_mutex): Windows only: Shortcut for getting a windows mutex\n handle.\n (get_condvar): Windows only: Same, but for condition variable.\n (thread_support_init_supervisor): Windows only: Clear tracker of\n allocated handle ids.\n (caf_shmem_mutex_lock): Windows only: Implememtation of lock,\n (caf_shmem_mutex_trylock): Windows only: trylock, and\n (caf_shmem_mutex_unlock): Windows only: unlock for Windows.\n (bm_is_set): Windows only: Check a bit is set in a mask.\n (bm_clear_bit): Windows only: Clear a bit in a mask.\n (bm_set_mask): Windows only: Set all bits in a mask.\n (bm_is_none): Windows only: Check if all bits are cleared.\n (caf_shmem_cond_wait): Windows only: Condition variable\n implemenation fro wait,\n (caf_shmem_cond_broadcast): Windows only: broadcast, and\n (caf_shmem_cond_signal): Windows only: signal on Windows.\n (caf_shmem_cond_update_count): Windows only: Need to know the\n images participating in a condition variable.\n (thread_support_cleanup): Windows only: Clean up the handles on\n exit.\n * caf/shmem/thread_support.h: Conditionally compile the types\n as required for Windows and other OSes.\n\ndiff --git a/libgfortran/caf/shmem.c b/libgfortran/caf/shmem.c\nindex b8d92d657f5..266feab3e45 100644\n--- a/libgfortran/caf/shmem.c\n+++ b/libgfortran/caf/shmem.c\n@@ -94,6 +94,8 @@ _gfortran_caf_init (int *argc, char ***argv)\n \n if (supervisor_main_loop (argc, argv, &exit_code))\n return;\n+\n+ thread_support_cleanup ();\n shared_memory_cleanup (&local->sm);\n \n /* Free pseudo tokens and memory to allow main process to survive caf_init.\n@@ -107,6 +109,7 @@ _gfortran_caf_init (int *argc, char ***argv)\n caf_static_list = tmp;\n }\n free (local);\n+\n exit (exit_code);\n }\n \n@@ -150,6 +153,8 @@ _gfortran_caf_finalize (void)\n caf_teams_formed = NULL;\n \n free (local);\n+\n+ thread_support_cleanup ();\n }\n \n int\n@@ -267,19 +272,25 @@ _gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token,\n {\n \tlock_t *addr;\n \tbool created;\n+\tsize_t alloc_size;\n \n \tallocator_lock (&local->ai.alloc);\n-\t/* Allocate enough space for the metadata infront of the lock\n-\t array. */\n-\taddr\n-\t = alloc_get_memory_by_id_created (&local->ai, size * sizeof (lock_t),\n-\t\t\t\t\t next_memid, &created);\n+#if defined(WIN32) || defined(__CYGWIN__)\n+\t/* On Windows mutexes are not an object stored in the shmem but\n+\t identified by an id. */\n+\talloc_size = size * caf_current_team->u.image_info->image_count.count;\n+#else\n+\talloc_size = size;\n+#endif\n+\taddr = alloc_get_memory_by_id_created (&local->ai,\n+\t\t\t\t\t alloc_size * sizeof (lock_t),\n+\t\t\t\t\t next_memid, &created);\n \n \tif (created)\n \t {\n \t /* Initialize the mutex only, when the memory was allocated for the\n \t first time. */\n-\t for (size_t c = 0; c < size; ++c)\n+\t for (size_t c = 0; c < alloc_size; ++c)\n \t initialize_shared_errorcheck_mutex (&addr[c]);\n \t }\n \tsize *= sizeof (lock_t);\n@@ -852,6 +863,7 @@ typedef void *opr_t;\n \tdefault: \\\n \t caf_runtime_error (\"\" #name \\\n \t\t\t \" not available for type/kind combination\"); \\\n+\t opr = NULL; /* Prevent false warnings. */ \\\n \t} \\\n break; \\\n }\n@@ -873,10 +885,12 @@ typedef void *opr_t;\n \tdefault: \\\n \t caf_runtime_error (\"\" #name \\\n \t\t\t \" not available for type/kind combination\"); \\\n+\t opr = NULL; /* Prevent false warning. */ \\\n \t} \\\n break; \\\n default: \\\n caf_runtime_error (\"\" #name \" not available for type/kind combination\"); \\\n+ opr = NULL; /* Prevent false warning. */ \\\n }\n \n void\n@@ -1473,17 +1487,23 @@ _gfortran_caf_event_query (caf_token_t token, size_t index, int image_index,\n }\n \n void\n-_gfortran_caf_lock (caf_token_t token, size_t index,\n-\t\t int image_index __attribute__ ((unused)),\n+_gfortran_caf_lock (caf_token_t token, size_t index, int image_index,\n \t\t int *acquired_lock, int *stat, char *errmsg,\n \t\t size_t errmsg_len)\n {\n const char *msg = \"Already locked\";\n- lock_t *lock = &((lock_t *) MEMTOK (token))[index];\n+#if defined(WIN32) || defined(__CYGWIN__)\n+ const size_t lock_index\n+ = image_index * caf_current_team->u.image_info->image_count.count + index;\n+#else\n+ const size_t lock_index = index;\n+ (void) image_index; // Prevent unused warnings.\n+#endif\n+ lock_t *lock = &((lock_t *) MEMTOK (token))[lock_index];\n int res;\n \n- res\n- = acquired_lock ? pthread_mutex_trylock (lock) : pthread_mutex_lock (lock);\n+ res = acquired_lock ? caf_shmem_mutex_trylock (lock)\n+\t\t : caf_shmem_mutex_lock (lock);\n \n if (stat)\n *stat = res == EBUSY ? GFC_STAT_LOCKED : 0;\n@@ -1501,28 +1521,32 @@ _gfortran_caf_lock (caf_token_t token, size_t index,\n {\n if (errmsg_len > 0)\n \t{\n-\t size_t len = (sizeof (msg) > errmsg_len) ? errmsg_len\n-\t\t\t\t\t\t : sizeof (msg);\n+\t size_t len = (sizeof (msg) > errmsg_len) ? errmsg_len : sizeof (msg);\n \t memcpy (errmsg, msg, len);\n \t if (errmsg_len > len)\n-\t memset (&errmsg[len], ' ', errmsg_len-len);\n+\t memset (&errmsg[len], ' ', errmsg_len - len);\n \t}\n return;\n }\n _gfortran_caf_error_stop_str (msg, strlen (msg), false);\n }\n \n-\n void\n-_gfortran_caf_unlock (caf_token_t token, size_t index,\n-\t\t int image_index __attribute__ ((unused)),\n+_gfortran_caf_unlock (caf_token_t token, size_t index, int image_index,\n \t\t int *stat, char *errmsg, size_t errmsg_len)\n {\n const char *msg = \"Variable is not locked\";\n- lock_t *lock = &((lock_t *) MEMTOK (token))[index];\n+#if defined(WIN32) || defined(__CYGWIN__)\n+ const size_t lock_index\n+ = image_index * caf_current_team->u.image_info->image_count.count + index;\n+#else\n+ const size_t lock_index = index;\n+ (void) image_index; // Prevent unused warnings.\n+#endif\n+ lock_t *lock = &((lock_t *) MEMTOK (token))[lock_index];\n int res;\n \n- res = pthread_mutex_unlock (lock);\n+ res = caf_shmem_mutex_unlock (lock);\n \n if (res == 0)\n {\n@@ -1535,34 +1559,33 @@ _gfortran_caf_unlock (caf_token_t token, size_t index,\n {\n /* res == EPERM means that the lock is locked. Now figure, if by us by\n \t trying to lock it or by other image, which fails. */\n- res = pthread_mutex_trylock (lock);\n+ res = caf_shmem_mutex_trylock (lock);\n if (res == EBUSY)\n \t*stat = GFC_STAT_LOCKED_OTHER_IMAGE;\n else\n \t{\n \t *stat = GFC_STAT_UNLOCKED;\n-\t pthread_mutex_unlock (lock);\n+\t caf_shmem_mutex_unlock (lock);\n \t}\n \n if (errmsg_len > 0)\n \t{\n-\t size_t len = (sizeof (msg) > errmsg_len) ? errmsg_len\n-\t : sizeof (msg);\n+\t size_t len = (sizeof (msg) > errmsg_len) ? errmsg_len : sizeof (msg);\n \t memcpy (errmsg, msg, len);\n \t if (errmsg_len > len)\n-\t memset (&errmsg[len], ' ', errmsg_len-len);\n+\t memset (&errmsg[len], ' ', errmsg_len - len);\n \t}\n return;\n }\n _gfortran_caf_error_stop_str (msg, strlen (msg), false);\n }\n \n-\n /* Reference the libraries implementation. */\n extern void _gfortran_random_seed_i4 (int32_t *size, gfc_array_i4 *put,\n \t\t\t\t gfc_array_i4 *get);\n \n-void _gfortran_caf_random_init (bool repeatable, bool image_distinct)\n+void\n+_gfortran_caf_random_init (bool repeatable, bool image_distinct)\n {\n static struct\n {\n@@ -1720,8 +1743,8 @@ _gfortran_caf_form_team (int team_no, caf_team_t *team, int *new_index,\n \t ++i)\n \tt->u.image_info->image_map[i] = -1;\n }\n- counter_barrier_add (&t->u.image_info->image_count, 1);\n- counter_barrier_add (&t->u.image_info->collsub.barrier, 1);\n+ counter_barrier_init_add (&t->u.image_info->image_count, 1);\n+ counter_barrier_init_add (&t->u.image_info->collsub.barrier, 1);\n allocator_unlock (&local->ai.alloc);\n \n if (new_index)\ndiff --git a/libgfortran/caf/shmem/alloc.c b/libgfortran/caf/shmem/alloc.c\nindex fecf97c03ff..ea250ac6922 100644\n--- a/libgfortran/caf/shmem/alloc.c\n+++ b/libgfortran/caf/shmem/alloc.c\n@@ -30,9 +30,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see\n #include \"../caf_error.h\"\n #include \"supervisor.h\"\n #include \"shared_memory.h\"\n+#include \"thread_support.h\"\n \n #include <assert.h>\n-#include <pthread.h>\n #include <string.h>\n \n /* Worker's part to initialize the alloc interface. */\ndiff --git a/libgfortran/caf/shmem/allocator.c b/libgfortran/caf/shmem/allocator.c\nindex 3ea4d50e045..2a22abb2a80 100644\n--- a/libgfortran/caf/shmem/allocator.c\n+++ b/libgfortran/caf/shmem/allocator.c\n@@ -133,11 +133,11 @@ allocator_shared_free (allocator *a, shared_mem_ptr p, size_t size)\n void\n allocator_lock (allocator *a)\n {\n- pthread_mutex_lock (&a->s->lock);\n+ caf_shmem_mutex_lock (&a->s->lock);\n }\n \n void\n allocator_unlock (allocator *a)\n {\n- pthread_mutex_unlock (&a->s->lock);\n+ caf_shmem_mutex_unlock (&a->s->lock);\n }\ndiff --git a/libgfortran/caf/shmem/allocator.h b/libgfortran/caf/shmem/allocator.h\nindex 53b6abeeba1..0cf31ea837a 100644\n--- a/libgfortran/caf/shmem/allocator.h\n+++ b/libgfortran/caf/shmem/allocator.h\n@@ -29,16 +29,16 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see\n #define ALLOCATOR_HDR\n \n #include \"shared_memory.h\"\n+#include \"thread_support.h\"\n \n #include <stddef.h>\n-#include <pthread.h>\n \n /* The number of bits a void pointer has. */\n #define VOIDP_BITS (__CHAR_BIT__ * sizeof (void *))\n \n /* The shared memory part of the allocator. */\n typedef struct {\n- pthread_mutex_t lock;\n+ caf_shmem_mutex lock;\n shared_mem_ptr free_bucket_head[VOIDP_BITS];\n } allocator_shared;\n \ndiff --git a/libgfortran/caf/shmem/collective_subroutine.c b/libgfortran/caf/shmem/collective_subroutine.c\nindex 257a048d63d..d261b412a93 100644\n--- a/libgfortran/caf/shmem/collective_subroutine.c\n+++ b/libgfortran/caf/shmem/collective_subroutine.c\n@@ -198,7 +198,7 @@ get_collsub_buf (size_t size)\n {\n void *ret;\n \n- pthread_mutex_lock (&caf_current_team->u.image_info->collsub.mutex);\n+ caf_shmem_mutex_lock (&caf_current_team->u.image_info->collsub.mutex);\n /* curr_size is always at least sizeof(double), so we don't need to worry\n about size == 0. */\n if (size > caf_current_team->u.image_info->collsub.curr_size)\n@@ -214,7 +214,7 @@ get_collsub_buf (size_t size)\n \n ret = SHMPTR_AS (void *, caf_current_team->u.image_info->collsub.collsub_buf,\n \t\t &local->sm);\n- pthread_mutex_unlock (&caf_current_team->u.image_info->collsub.mutex);\n+ caf_shmem_mutex_unlock (&caf_current_team->u.image_info->collsub.mutex);\n return ret;\n }\n \ndiff --git a/libgfortran/caf/shmem/collective_subroutine.h b/libgfortran/caf/shmem/collective_subroutine.h\nindex 8c37186c867..bdddab07a93 100644\n--- a/libgfortran/caf/shmem/collective_subroutine.h\n+++ b/libgfortran/caf/shmem/collective_subroutine.h\n@@ -36,7 +36,7 @@ typedef struct collsub_shared\n size_t curr_size;\n shared_mem_ptr collsub_buf;\n counter_barrier barrier;\n- pthread_mutex_t mutex;\n+ caf_shmem_mutex mutex;\n } collsub_shared;\n \n void collsub_init_supervisor (collsub_shared *, allocator *,\ndiff --git a/libgfortran/caf/shmem/counter_barrier.c b/libgfortran/caf/shmem/counter_barrier.c\nindex f78ba7fe852..2cda2afb2ed 100644\n--- a/libgfortran/caf/shmem/counter_barrier.c\n+++ b/libgfortran/caf/shmem/counter_barrier.c\n@@ -34,7 +34,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see\n static inline void\n lock_counter_barrier (counter_barrier *b)\n {\n- pthread_mutex_lock (&b->mutex);\n+ caf_shmem_mutex_lock (&b->mutex);\n }\n \n /* Unlock the associated counter of this barrier. */\n@@ -42,15 +42,15 @@ lock_counter_barrier (counter_barrier *b)\n static inline void\n unlock_counter_barrier (counter_barrier *b)\n {\n- pthread_mutex_unlock (&b->mutex);\n+ caf_shmem_mutex_unlock (&b->mutex);\n }\n \n void\n counter_barrier_init (counter_barrier *b, int val)\n {\n- *b = (counter_barrier) {PTHREAD_MUTEX_INITIALIZER, PTHREAD_COND_INITIALIZER,\n-\t\t\t val, 0, val};\n- initialize_shared_condition (&b->cond);\n+ *b = (counter_barrier) {CAF_SHMEM_MUTEX_INITIALIZER,\n+\t\t\t CAF_SHMEM_COND_INITIALIZER, val, 0, val};\n+ initialize_shared_condition (&b->cond, val);\n initialize_shared_mutex (&b->mutex);\n }\n \n@@ -60,15 +60,14 @@ counter_barrier_wait (counter_barrier *b)\n int wait_group_beginning;\n \n lock_counter_barrier (b);\n-\n wait_group_beginning = b->curr_wait_group;\n \n if ((--b->wait_count) <= 0)\n- pthread_cond_broadcast (&b->cond);\n+ caf_shmem_cond_broadcast (&b->cond);\n else\n {\n while (b->wait_count > 0 && b->curr_wait_group == wait_group_beginning)\n-\t pthread_cond_wait (&b->cond, &b->mutex);\n+\tcaf_shmem_cond_wait (&b->cond, &b->mutex);\n }\n \n if (b->wait_count <= 0)\n@@ -80,13 +79,12 @@ counter_barrier_wait (counter_barrier *b)\n unlock_counter_barrier (b);\n }\n \n-\n static inline void\n change_internal_barrier_count (counter_barrier *b, int val)\n {\n b->wait_count += val;\n if (b->wait_count <= 0)\n- pthread_cond_broadcast (&b->cond);\n+ caf_shmem_cond_broadcast (&b->cond);\n }\n \n int\n@@ -103,19 +101,27 @@ int\n counter_barrier_add (counter_barrier *c, int val)\n {\n int ret;\n- pthread_mutex_lock (&c->mutex);\n+ caf_shmem_mutex_lock (&c->mutex);\n ret = counter_barrier_add_locked (c, val);\n \n- pthread_mutex_unlock (&c->mutex);\n+ caf_shmem_mutex_unlock (&c->mutex);\n return ret;\n }\n \n+void\n+counter_barrier_init_add (counter_barrier *b, int val)\n+{\n+ b->count += val;\n+ b->wait_count += val;\n+ caf_shmem_cond_update_count (&b->cond, val);\n+}\n+\n int\n counter_barrier_get_count (counter_barrier *c)\n {\n int ret;\n- pthread_mutex_lock (&c->mutex);\n+ caf_shmem_mutex_lock (&c->mutex);\n ret = c->count;\n- pthread_mutex_unlock (&c->mutex);\n+ caf_shmem_mutex_unlock (&c->mutex);\n return ret;\n }\ndiff --git a/libgfortran/caf/shmem/counter_barrier.h b/libgfortran/caf/shmem/counter_barrier.h\nindex a28c58812a5..ab3d35ada74 100644\n--- a/libgfortran/caf/shmem/counter_barrier.h\n+++ b/libgfortran/caf/shmem/counter_barrier.h\n@@ -25,7 +25,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see\n #ifndef COUNTER_BARRIER_HDR\n #define COUNTER_BARRIER_HDR\n \n-#include <pthread.h>\n+#include \"thread_support.h\"\n \n /* Usable as counter barrier and as waitable counter.\n This \"class\" allows to sync all images acting as a barrier. For this the\n@@ -41,8 +41,8 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see\n \n typedef struct\n {\n- pthread_mutex_t mutex;\n- pthread_cond_t cond;\n+ caf_shmem_mutex mutex;\n+ caf_shmem_condvar cond;\n volatile int wait_count;\n volatile int curr_wait_group;\n volatile int count;\n@@ -65,6 +65,10 @@ int counter_barrier_add_locked (counter_barrier *, int);\n \n int counter_barrier_add (counter_barrier *, int);\n \n+/* Add the given number to the counter barrier. This version does not signal.\n+ The mutex needs to be locked for this routine to be safe. */\n+void counter_barrier_init_add (counter_barrier *, int);\n+\n /* Get the count of the barrier. */\n \n int counter_barrier_get_count (counter_barrier *);\ndiff --git a/libgfortran/caf/shmem/shared_memory.c b/libgfortran/caf/shmem/shared_memory.c\nindex 2b3666ddd3b..d0789a4bac6 100644\n--- a/libgfortran/caf/shmem/shared_memory.c\n+++ b/libgfortran/caf/shmem/shared_memory.c\n@@ -22,6 +22,10 @@ a copy of the GCC Runtime Library Exception along with this program;\n see the files COPYING3 and COPYING.RUNTIME respectively. If not, see\n <http://www.gnu.org/licenses/>. */\n \n+#ifdef HAVE_CONFIG_H\n+#include \"config.h\"\n+#endif\n+\n #include \"libgfortran.h\"\n #include \"allocator.h\"\n #include \"shared_memory.h\"\n@@ -30,7 +34,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see\n #include <fcntl.h>\n #include <stdlib.h>\n #include <string.h>\n+#ifdef HAVE_SYS_MMAN_H\n #include <sys/mman.h>\n+#elif defined(WIN32)\n+#include <Windows.h>\n+#include <Memoryapi.h>\n+#endif\n #include <unistd.h>\n \n /* This implements shared memory based on POSIX mmap. We start with\n@@ -56,7 +65,11 @@ shared_memory_set_env (pid_t pid)\n char buffer[bufsize];\n \n snprintf (buffer, bufsize, \"%d\", pid);\n+#ifdef HAVE_SETENV\n setenv (ENV_PPID, buffer, 1);\n+#else\n+ SetEnvironmentVariable (ENV_PPID, buffer);\n+#endif\n #undef bufsize\n }\n \n@@ -82,7 +95,7 @@ shared_mem_ptr\n shared_memory_get_master (shared_memory_act *mem, size_t size, size_t align)\n {\n if (mem->glbl.meta->master)\n- return (shared_mem_ptr) {mem->glbl.meta->master};\n+ return (shared_mem_ptr) {mem->glbl.meta->master};\n else\n {\n ptrdiff_t loc = mem->glbl.meta->used;\n@@ -112,7 +125,6 @@ shared_memory_init (shared_memory_act *mem, size_t size)\n char shm_name[NAME_MAX];\n const char *env_val = getenv (ENV_PPID), *base = getenv (ENV_BASE);\n pid_t ppid = getpid ();\n- int shm_fd, res;\n void *base_ptr;\n \n if (env_val)\n@@ -131,70 +143,138 @@ shared_memory_init (shared_memory_act *mem, size_t size)\n \n if (!env_val)\n {\n- shm_fd = shm_open (shm_name, O_CREAT | O_RDWR | O_EXCL, 0600);\n- if (shm_fd == -1)\n+#ifdef HAVE_MMAP\n+ int res;\n+\n+ mem->shm_fd = shm_open (shm_name, O_CREAT | O_RDWR | O_EXCL, 0600);\n+ if (mem->shm_fd == -1)\n \t{\n \t perror (\"creating shared memory segment failed.\");\n \t exit (1);\n \t}\n \n- res = ftruncate (shm_fd, size);\n+ res = ftruncate (mem->shm_fd, size);\n if (res == -1)\n \t{\n \t perror (\"resizing shared memory segment failed.\");\n \t exit (1);\n \t}\n+#elif defined(WIN32)\n+ mem->shm_fd\n+\t= CreateFileMapping (INVALID_HANDLE_VALUE, NULL, PAGE_READWRITE,\n+\t\t\t size >> (sizeof (DWORD) * 8),\n+\t\t\t (DWORD) (size & ~((DWORD) 0)), shm_name);\n+ if (mem->shm_fd == NULL)\n+\t{\n+\t LPVOID lpMsgBuf;\n+\t DWORD dw = GetLastError ();\n+\n+\t if (FormatMessage (FORMAT_MESSAGE_ALLOCATE_BUFFER\n+\t\t\t | FORMAT_MESSAGE_FROM_SYSTEM\n+\t\t\t | FORMAT_MESSAGE_IGNORE_INSERTS,\n+\t\t\t NULL, dw,\n+\t\t\t MAKELANGID (LANG_NEUTRAL, SUBLANG_DEFAULT),\n+\t\t\t (LPTSTR) &lpMsgBuf, 0, NULL)\n+\t == 0)\n+\t {\n+\t fprintf (stderr, \"formatting the error message failed.\\n\");\n+\t ExitProcess (dw);\n+\t }\n+\n+\t fprintf (stderr, \"creating shared memory segment failed: %d, %s\\n\",\n+\t\t dw, (LPCTSTR) lpMsgBuf);\n+\n+\t LocalFree (lpMsgBuf);\n+\t exit (1);\n+\t}\n+#else\n+#error \"no way to map shared memory.\"\n+#endif\n }\n else\n {\n- shm_fd = shm_open (shm_name, O_RDWR, 0);\n- if (shm_fd == -1)\n+#ifdef HAVE_MMAP\n+ mem->shm_fd = shm_open (shm_name, O_RDWR, 0);\n+ if (mem->shm_fd == -1)\n \t{\n \t perror (\"opening shared memory segment failed.\");\n \t exit (1);\n \t}\n+#elif defined(WIN32)\n+ mem->shm_fd = OpenFileMapping (FILE_MAP_ALL_ACCESS, FALSE, shm_name);\n+ if (mem->shm_fd == NULL)\n+\t{\n+\t perror (\"opening shared memory segment failed.\");\n+\t exit (1);\n+\t}\n+#endif\n }\n-\n+#ifdef HAVE_MMAP\n mem->glbl.base\n- = mmap (base_ptr, size, PROT_READ | PROT_WRITE, MAP_SHARED, shm_fd, 0);\n- res = close (shm_fd);\n+ = mmap (base_ptr, size, PROT_READ | PROT_WRITE, MAP_SHARED, mem->shm_fd, 0);\n if (mem->glbl.base == MAP_FAILED)\n {\n perror (\"mmap failed\");\n exit (1);\n }\n+#elif defined(WIN32)\n+ mem->glbl.base\n+ = (LPTSTR) MapViewOfFileExNuma (mem->shm_fd, FILE_MAP_ALL_ACCESS, 0, 0,\n+\t\t\t\t size, base_ptr, NUMA_NO_PREFERRED_NODE);\n+ if (mem->glbl.base == NULL)\n+ {\n+ perror (\"MapViewOfFile failed\");\n+ exit (1);\n+ }\n+#endif\n if (!base_ptr)\n {\n #define bufsize 20\n char buffer[bufsize];\n \n snprintf (buffer, bufsize, \"%p\", mem->glbl.base);\n+#ifdef HAVE_SETENV\n setenv (ENV_BASE, buffer, 1);\n+#else\n+ SetEnvironmentVariable (ENV_BASE, buffer);\n+#endif\n #undef bufsize\n }\n- if (res)\n- { // from close()\n- perror (\"closing shm file handle failed. Trying to continue...\");\n- }\n mem->size = size;\n if (!env_val)\n *mem->glbl.meta\n = (global_shared_memory_meta) {sizeof (global_shared_memory_meta), 0};\n-\n }\n \n void\n-shared_memory_cleanup (shared_memory_act *)\n+shared_memory_cleanup (shared_memory_act *mem)\n {\n char shm_name[NAME_MAX];\n- int res;\n \n snprintf (shm_name, NAME_MAX, \"/gfor-shm-%s\", shared_memory_get_env ());\n+#ifdef HAVE_MMAP\n+ int res = munmap (mem->glbl.base, mem->size);\n+ if (res)\n+ {\n+ perror (\"unmapping shared memory segment failed\");\n+ }\n+ res = close (mem->shm_fd);\n+ if (res)\n+ {\n+ perror (\"closing shm file handle failed. Trying to continue...\");\n+ }\n res = shm_unlink (shm_name);\n if (res == -1)\n {\n perror (\"shm_unlink failed\");\n exit (1);\n }\n+#elif defined(WIN32)\n+ if (!UnmapViewOfFile (mem->glbl.base))\n+ {\n+ perror (\"unmapping shared memory segment failed\");\n+ }\n+ CloseHandle (mem->shm_fd);\n+#endif\n }\n #undef NAME_MAX\ndiff --git a/libgfortran/caf/shmem/shared_memory.h b/libgfortran/caf/shmem/shared_memory.h\nindex 01ac2811e5d..3d031875ed2 100644\n--- a/libgfortran/caf/shmem/shared_memory.h\n+++ b/libgfortran/caf/shmem/shared_memory.h\n@@ -25,6 +25,8 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see\n #ifndef SHARED_MEMORY_H\n #define SHARED_MEMORY_H\n \n+#include \"thread_support.h\"\n+\n #include <stdlib.h>\n #include <stddef.h>\n #include <unistd.h>\n@@ -47,6 +49,7 @@ typedef struct shared_memory_act\n global_shared_memory_meta *meta;\n } glbl;\n size_t size; // const\n+ caf_shmem_fd shm_fd;\n } shared_memory_act;\n \n /* A struct to serve as shared memory object. */\ndiff --git a/libgfortran/caf/shmem/supervisor.c b/libgfortran/caf/shmem/supervisor.c\nindex e4310b03e43..c39ffc6715c 100644\n--- a/libgfortran/caf/shmem/supervisor.c\n+++ b/libgfortran/caf/shmem/supervisor.c\n@@ -22,8 +22,6 @@ a copy of the GCC Runtime Library Exception along with this program;\n see the files COPYING3 and COPYING.RUNTIME respectively. If not, see\n <http://www.gnu.org/licenses/>. */\n \n-#include \"config.h\"\n-\n #include \"../caf_error.h\"\n #include \"supervisor.h\"\n #include \"teams_mgmt.h\"\n@@ -38,6 +36,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see\n #elif HAVE_SYS_WAIT_H\n #include <sys/wait.h>\n #endif\n+#if !defined(_SC_PAGE_SIZE) && defined(WIN32)\n+#include <windows.h>\n+#endif\n \n #define GFORTRAN_ENV_NUM_IMAGES \"GFORTRAN_NUM_IMAGES\"\n #define GFORTRAN_ENV_SHARED_MEMORY_SIZE \"GFORTRAN_SHARED_MEMORY_SIZE\"\n@@ -56,8 +57,13 @@ get_image_num_from_envvar (void)\n int nimages;\n num_images_char = getenv (GFORTRAN_ENV_NUM_IMAGES);\n if (!num_images_char)\n- return sysconf (_SC_NPROCESSORS_ONLN); /* TODO: Make portable. */\n- /* TODO: Error checking. */\n+#ifdef _SC_NPROCESSORS_ONLN\n+ return sysconf (_SC_NPROCESSORS_ONLN);\n+#elif defined(WIN32)\n+ num_images_char = getenv (\"NUMBER_OF_PROCESSORS\");\n+#else\n+#error \"Unsupported system: No known way to get number of cores!\"\n+#endif\n nimages = atoi (num_images_char);\n return nimages;\n }\n@@ -105,7 +111,12 @@ get_memory_size_from_envvar (void)\n if (sizeof (size_t) == 4)\n \tsz = ((size_t) 1) << 28;\n else\n+#ifndef WIN32\n \tsz = ((size_t) 1) << 34;\n+#else\n+\t/* Use 1GB on Windows. */\n+\tsz = ((size_t) 1) << 30;\n+#endif\n }\n return sz;\n }\n@@ -146,7 +157,19 @@ ensure_shmem_initialization (void)\n return;\n \n local = malloc (sizeof (image_local));\n+#if defined(_SC_PAGE_SIZE)\n pagesize = sysconf (_SC_PAGE_SIZE);\n+#elif defined(WIN32)\n+ {\n+ SYSTEM_INFO si;\n+ GetNativeSystemInfo (&si);\n+ pagesize = si.dwAllocationGranularity;\n+ }\n+#else\n+#warning \\\n+ \"Unsupported system: No known way to get memory page size. Assuming 4k!\"\n+ pagesize = 4096;\n+#endif\n shmem_size = round_to_pagesize (get_memory_size_from_envvar ());\n local->total_num_images = get_image_num_from_envvar ();\n shared_memory_init (&local->sm, shmem_size);\n@@ -199,6 +222,7 @@ ensure_shmem_initialization (void)\n {\n this_image = (image) {-1, get_supervisor ()};\n this_image.supervisor->magic_number = SUPERVISOR_MAGIC_NUM;\n+ thread_support_init_supervisor ();\n counter_barrier_init (&this_image.supervisor->num_active_images,\n \t\t\t local->total_num_images);\n alloc_init_supervisor (&local->ai, &local->sm);\n@@ -206,16 +230,31 @@ ensure_shmem_initialization (void)\n }\n }\n \n+#if !defined(environ)\n extern char **environ;\n+#endif\n \n+/* argc and argv may not be used on certain OSes. Flag them unused therefore.\n+ */\n int\n-supervisor_main_loop (int *argc __attribute__ ((unused)), char ***argv,\n-\t\t int *exit_code)\n+supervisor_main_loop (int *argc __attribute__ ((unused)),\n+\t\t char ***argv __attribute__ ((unused)), int *exit_code)\n {\n supervisor *m;\n- pid_t new_pid, finished_pid;\n image im;\n+#if defined(WIN32) && !defined(HAVE_FORK)\n+ HANDLE *process_handles = malloc (sizeof (HANDLE) * local->total_num_images),\n+\t *thread_handles = malloc (sizeof (HANDLE) * local->total_num_images),\n+\t *waiting_handles = malloc (sizeof (HANDLE) * local->total_num_images);\n+ int count_waiting = local->total_num_images;\n+ LPTCH *envs = malloc (sizeof (LPTCH) * local->total_num_images);\n+ LPTSTR currentDir;\n+ DWORD cdLen = GetCurrentDirectory (0, NULL);\n+ currentDir = malloc (cdLen);\n+ GetCurrentDirectory (cdLen, currentDir);\n+#else\n int chstatus;\n+#endif\n \n *exit_code = 0;\n shared_memory_set_env (getpid ());\n@@ -223,6 +262,8 @@ supervisor_main_loop (int *argc __attribute__ ((unused)), char ***argv,\n \n for (im.image_num = 0; im.image_num < local->total_num_images; im.image_num++)\n {\n+#ifdef HAVE_FORK\n+ caf_shmem_pid new_pid;\n if ((new_pid = fork ()))\n \t{\n \t if (new_pid == -1)\n@@ -247,10 +288,63 @@ supervisor_main_loop (int *argc __attribute__ ((unused)), char ***argv,\n \t execve ((*argv)[0], *argv, new_env);\n \t return 1;\n \t}\n+#elif defined(WIN32)\n+ LPTCH new_env;\n+ size_t n = 0, es;\n+ STARTUPINFO si;\n+ DWORD dwFlags = 0;\n+ PROCESS_INFORMATION pi;\n+ LPTCH env = GetEnvironmentStrings ();\n+\n+ ZeroMemory (&si, sizeof (si));\n+ si.cb = sizeof (si);\n+ ZeroMemory (&pi, sizeof (pi));\n+\n+ /* Count the number of characters in the current environment. */\n+ for (LPTSTR e = (LPTSTR) env; *e; es = lstrlen (e) + 1, e += es, n += es)\n+\t;\n+ new_env = (LPCH) malloc (n + 32 * sizeof (TCHAR));\n+ memcpy (new_env, env, n);\n+ snprintf (&((TCHAR *) new_env)[n], 32, \"%s=%d%c\", GFORTRAN_ENV_IMAGE_NUM,\n+\t\tim.image_num, (char) 0);\n+ if (!CreateProcessA (NULL, GetCommandLine (), NULL, NULL, FALSE, dwFlags,\n+\t\t\t new_env, currentDir, &si, &pi))\n+\t{\n+\t LPVOID lpMsgBuf;\n+\t DWORD dw = GetLastError ();\n+\n+\t if (FormatMessage (FORMAT_MESSAGE_ALLOCATE_BUFFER\n+\t\t\t | FORMAT_MESSAGE_FROM_SYSTEM\n+\t\t\t | FORMAT_MESSAGE_IGNORE_INSERTS,\n+\t\t\t NULL, dw,\n+\t\t\t MAKELANGID (LANG_NEUTRAL, SUBLANG_DEFAULT),\n+\t\t\t (LPTSTR) &lpMsgBuf, 0, NULL)\n+\t == 0)\n+\t {\n+\t fprintf (stderr, \"formatting the error message failed.\\n\");\n+\t ExitProcess (dw);\n+\t }\n+\n+\t fprintf (stderr, \"error spawning child: %ld, %s\\n\", dw,\n+\t\t (LPCTSTR) lpMsgBuf);\n+\n+\t LocalFree (lpMsgBuf);\n+\t exit (1);\n+\t}\n+ m->images[im.image_num] = (image_tracker) {pi.hProcess, IMAGE_OK};\n+ process_handles[im.image_num] = waiting_handles[im.image_num]\n+\t= pi.hProcess;\n+ thread_handles[im.image_num] = pi.hThread;\n+ envs[im.image_num] = new_env;\n+#else\n+#error \"no way known to start child processes.\"\n+#endif\n }\n- for (int j, i = 0; i < local->total_num_images; i++)\n+ for (int i = 0; i < local->total_num_images; i++)\n {\n- finished_pid = wait (&chstatus);\n+#ifdef HAVE_FORK\n+ caf_shmem_pid finished_pid = wait (&chstatus);\n+ int j;\n if (WIFEXITED (chstatus) && !WEXITSTATUS (chstatus))\n \t{\n \t for (j = 0;\n@@ -303,10 +397,77 @@ supervisor_main_loop (int *argc __attribute__ ((unused)), char ***argv,\n \t}\n /* Trigger waiting sync images aka sync_table. */\n for (j = 0; j < local->total_num_images; j++)\n-\tpthread_cond_signal (&SHMPTR_AS (pthread_cond_t *,\n-\t\t\t\t\t m->sync_shared.sync_images_cond_vars,\n-\t\t\t\t\t &local->sm)[j]);\n+\tcaf_shmem_cond_signal (&SHMPTR_AS (caf_shmem_condvar *,\n+\t\t\t\t\t m->sync_shared.sync_images_cond_vars,\n+\t\t\t\t\t &local->sm)[j]);\n counter_barrier_add (&m->num_active_images, -1);\n+#elif defined(WIN32)\n+ DWORD res = WaitForMultipleObjects (count_waiting, waiting_handles, FALSE,\n+\t\t\t\t\t INFINITE);\n+ HANDLE cand;\n+ bool progress = false;\n+ DWORD process_exit_code;\n+ if (res == WAIT_FAILED)\n+\tcaf_runtime_error (\"waiting for process termination failed.\");\n+ int index = res - WAIT_OBJECT_0, finished_process;\n+ bool fail;\n+\n+ do\n+\t{\n+\t cand = waiting_handles[index];\n+\t for (finished_process = 0;\n+\t finished_process < local->total_num_images\n+\t && cand != process_handles[finished_process];\n+\t ++finished_process)\n+\t ;\n+\n+\t GetExitCodeProcess (cand, &process_exit_code);\n+\t fail = process_exit_code != 0;\n+\t fprintf (stderr, \"terminating process %d with fail status %d (%ld)\\n\",\n+\t\t finished_process, fail, process_exit_code);\n+\t if (finished_process < local->total_num_images)\n+\t {\n+\t CloseHandle (process_handles[finished_process]);\n+\t process_handles[finished_process] = NULL;\n+\t CloseHandle (thread_handles[finished_process]);\n+\t FreeEnvironmentStrings (envs[finished_process]);\n+\t if (fail)\n+\t\t{\n+\t\t m->images[finished_process].status = IMAGE_FAILED;\n+\t\t atomic_fetch_add (&m->failed_images, 1);\n+\t\t if (*exit_code < process_exit_code)\n+\t\t *exit_code = process_exit_code;\n+\t\t}\n+\t else\n+\t\t{\n+\t\t m->images[finished_process].status = IMAGE_SUCCESS;\n+\t\t atomic_fetch_add (&m->finished_images, 1);\n+\t\t}\n+\t }\n+\t memmove (&waiting_handles[index], &waiting_handles[index + 1],\n+\t\t sizeof (HANDLE) * (count_waiting - index - 1));\n+\t --count_waiting;\n+\t counter_barrier_add (&m->num_active_images, -1);\n+\n+\t /* Check if more than one process has terminated already. */\n+\t progress = false;\n+\t for (index = 0; index < count_waiting; ++index)\n+\t if (WaitForSingleObject (waiting_handles[index], 0)\n+\t\t== WAIT_OBJECT_0)\n+\t {\n+\t\tprogress = true;\n+\t\t++i;\n+\t\tbreak;\n+\t }\n+\t}\n+ while (progress && count_waiting > 0);\n+#endif\n }\n+\n+#if defined(WIN32) && !defined(HAVE_FORK)\n+ free (process_handles);\n+ free (thread_handles);\n+ free (envs);\n+#endif\n return 0;\n }\ndiff --git a/libgfortran/caf/shmem/supervisor.h b/libgfortran/caf/shmem/supervisor.h\nindex 7afb8269674..7e5e19702e4 100644\n--- a/libgfortran/caf/shmem/supervisor.h\n+++ b/libgfortran/caf/shmem/supervisor.h\n@@ -25,6 +25,10 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see\n #ifndef SUPERVISOR_H\n #define SUPERVISOR_H\n \n+#ifdef HAVE_CONFIG_H\n+#include \"config.h\"\n+#endif\n+\n #include \"caf/libcaf.h\"\n #include \"alloc.h\"\n #include \"collective_subroutine.h\"\n@@ -42,7 +46,7 @@ typedef enum\n \n typedef struct\n {\n- pid_t pid;\n+ caf_shmem_pid pid;\n image_status status;\n } image_tracker;\n \n@@ -56,7 +60,10 @@ typedef struct supervisor\n atomic_int failed_images;\n atomic_int finished_images;\n counter_barrier num_active_images;\n- pthread_mutex_t image_tracker_lock;\n+ caf_shmem_mutex image_tracker_lock;\n+#ifdef WIN32\n+ size_t global_used_handles;\n+#endif\n image_tracker images[];\n } supervisor;\n \ndiff --git a/libgfortran/caf/shmem/sync.c b/libgfortran/caf/shmem/sync.c\nindex a456244629c..e1020a1e864 100644\n--- a/libgfortran/caf/shmem/sync.c\n+++ b/libgfortran/caf/shmem/sync.c\n@@ -33,13 +33,13 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see\n static inline void\n lock_table (sync_t *si)\n {\n- pthread_mutex_lock (&si->cis->sync_images_table_lock);\n+ caf_shmem_mutex_lock (&si->cis->sync_images_table_lock);\n }\n \n static inline void\n unlock_table (sync_t *si)\n {\n- pthread_mutex_unlock (&si->cis->sync_images_table_lock);\n+ caf_shmem_mutex_unlock (&si->cis->sync_images_table_lock);\n }\n \n void\n@@ -48,7 +48,7 @@ sync_init (sync_t *si, shared_memory sm)\n *si = (sync_t) {\n &this_image.supervisor->sync_shared,\n SHMPTR_AS (int *, this_image.supervisor->sync_shared.sync_images_table, sm),\n- SHMPTR_AS (pthread_cond_t *,\n+ SHMPTR_AS (caf_shmem_condvar *,\n \t this_image.supervisor->sync_shared.sync_images_cond_vars, sm)};\n }\n \n@@ -61,7 +61,7 @@ sync_init_supervisor (sync_t *si, alloc *ai)\n si->cis = &this_image.supervisor->sync_shared;\n \n initialize_shared_mutex (&si->cis->event_lock);\n- initialize_shared_condition (&si->cis->event_cond);\n+ initialize_shared_condition (&si->cis->event_cond, num_images);\n \n initialize_shared_mutex (&si->cis->sync_images_table_lock);\n \n@@ -69,14 +69,14 @@ sync_init_supervisor (sync_t *si, alloc *ai)\n = allocator_shared_malloc (alloc_get_allocator (ai), table_size_in_bytes);\n si->cis->sync_images_cond_vars\n = allocator_shared_malloc (alloc_get_allocator (ai),\n-\t\t\t sizeof (pthread_cond_t) * num_images);\n+\t\t\t sizeof (caf_shmem_condvar) * num_images);\n \n si->table = SHMPTR_AS (int *, si->cis->sync_images_table, ai->mem);\n si->triggers\n- = SHMPTR_AS (pthread_cond_t *, si->cis->sync_images_cond_vars, ai->mem);\n+ = SHMPTR_AS (caf_shmem_condvar *, si->cis->sync_images_cond_vars, ai->mem);\n \n for (int i = 0; i < num_images; i++)\n- initialize_shared_condition (&si->triggers[i]);\n+ initialize_shared_condition (&si->triggers[i], num_images);\n \n memset (si->table, 0, table_size_in_bytes);\n }\n@@ -103,7 +103,7 @@ sync_table (sync_t *si, int *images, int size)\n for (i = 0; i < size; ++i)\n \t{\n \t ++table[images[i] + img_c * this_image.image_num];\n-\t pthread_cond_signal (&si->triggers[images[i]]);\n+\t caf_shmem_cond_signal (&si->triggers[images[i]]);\n \t}\n for (;;)\n \t{\n@@ -114,7 +114,7 @@ sync_table (sync_t *si, int *images, int size)\n \t break;\n \t if (i == size)\n \t break;\n-\t pthread_cond_wait (&si->triggers[this_image.image_num],\n+\t caf_shmem_cond_wait (&si->triggers[this_image.image_num],\n \t\t\t &si->cis->sync_images_table_lock);\n \t}\n }\n@@ -127,7 +127,7 @@ sync_table (sync_t *si, int *images, int size)\n \t if (this_image.supervisor->images[map[i]].status != IMAGE_OK)\n \t continue;\n \t ++table[map[i] + size * this_image.image_num];\n-\t pthread_cond_signal (&si->triggers[map[i]]);\n+\t caf_shmem_cond_signal (&si->triggers[map[i]]);\n \t}\n for (;;)\n \t{\n@@ -138,7 +138,7 @@ sync_table (sync_t *si, int *images, int size)\n \t break;\n \t if (i == size)\n \t break;\n-\t pthread_cond_wait (&si->triggers[this_image.image_num],\n+\t caf_shmem_cond_wait (&si->triggers[this_image.image_num],\n \t\t\t &si->cis->sync_images_table_lock);\n \t}\n }\n@@ -160,23 +160,23 @@ sync_team (caf_shmem_team_t team)\n void\n lock_event (sync_t *si)\n {\n- pthread_mutex_lock (&si->cis->event_lock);\n+ caf_shmem_mutex_lock (&si->cis->event_lock);\n }\n \n void\n unlock_event (sync_t *si)\n {\n- pthread_mutex_unlock (&si->cis->event_lock);\n+ caf_shmem_mutex_unlock (&si->cis->event_lock);\n }\n \n void\n event_post (sync_t *si)\n {\n- pthread_cond_broadcast (&si->cis->event_cond);\n+ caf_shmem_cond_broadcast (&si->cis->event_cond);\n }\n \n void\n event_wait (sync_t *si)\n {\n- pthread_cond_wait (&si->cis->event_cond, &si->cis->event_lock);\n+ caf_shmem_cond_wait (&si->cis->event_cond, &si->cis->event_lock);\n }\ndiff --git a/libgfortran/caf/shmem/sync.h b/libgfortran/caf/shmem/sync.h\nindex a3e586bca24..a6d20614b67 100644\n--- a/libgfortran/caf/shmem/sync.h\n+++ b/libgfortran/caf/shmem/sync.h\n@@ -28,13 +28,11 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see\n #include \"alloc.h\"\n #include \"counter_barrier.h\"\n \n-#include <pthread.h>\n-\n typedef struct {\n /* Mutex and condition variable needed for signaling events. */\n- pthread_mutex_t event_lock;\n- pthread_cond_t event_cond;\n- pthread_mutex_t sync_images_table_lock;\n+ caf_shmem_mutex event_lock;\n+ caf_shmem_condvar event_cond;\n+ caf_shmem_mutex sync_images_table_lock;\n shared_mem_ptr sync_images_table;\n shared_mem_ptr sync_images_cond_vars;\n } sync_shared;\n@@ -42,10 +40,10 @@ typedef struct {\n typedef struct {\n sync_shared *cis;\n int *table; // we can cache the table and the trigger pointers here\n- pthread_cond_t *triggers;\n+ caf_shmem_condvar *triggers;\n } sync_t;\n \n-typedef pthread_mutex_t lock_t;\n+typedef caf_shmem_mutex lock_t;\n \n typedef int event_t;\n \ndiff --git a/libgfortran/caf/shmem/teams_mgmt.c b/libgfortran/caf/shmem/teams_mgmt.c\nindex 44a34d727c3..9bf8db2302c 100644\n--- a/libgfortran/caf/shmem/teams_mgmt.c\n+++ b/libgfortran/caf/shmem/teams_mgmt.c\n@@ -31,7 +31,7 @@ caf_shmem_team_t caf_teams_formed = NULL;\n void\n update_teams_images (caf_shmem_team_t team)\n {\n- pthread_mutex_lock (&team->u.image_info->image_count.mutex);\n+ caf_shmem_mutex_lock (&team->u.image_info->image_count.mutex);\n if (team->u.image_info->num_term_images\n != this_image.supervisor->finished_images\n \t + this_image.supervisor->failed_images)\n@@ -52,7 +52,7 @@ update_teams_images (caf_shmem_team_t team)\n \t\t\t\t old_num\n \t\t\t\t - team->u.image_info->num_term_images);\n }\n- pthread_mutex_unlock (&team->u.image_info->image_count.mutex);\n+ caf_shmem_mutex_unlock (&team->u.image_info->image_count.mutex);\n }\n \n void\ndiff --git a/libgfortran/caf/shmem/thread_support.c b/libgfortran/caf/shmem/thread_support.c\nold mode 100644\nnew mode 100755\nindex 572f39400b3..e2c53627c2f\n--- a/libgfortran/caf/shmem/thread_support.c\n+++ b/libgfortran/caf/shmem/thread_support.c\n@@ -28,6 +28,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see\n #include <stdlib.h>\n #include <stdio.h>\n \n+#if !defined(WIN32) && !defined(__CYGWIN__)\n+#include <pthread.h>\n+\n #define ERRCHECK(a) \\\n do \\\n { \\\n@@ -42,7 +45,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see\n while (0)\n \n void\n-initialize_shared_mutex (pthread_mutex_t *mutex)\n+initialize_shared_mutex (caf_shmem_mutex *mutex)\n {\n pthread_mutexattr_t mattr;\n ERRCHECK (pthread_mutexattr_init (&mattr));\n@@ -52,18 +55,18 @@ initialize_shared_mutex (pthread_mutex_t *mutex)\n }\n \n void\n-initialize_shared_errorcheck_mutex (pthread_mutex_t *mutex)\n+initialize_shared_errorcheck_mutex (caf_shmem_mutex *mutex)\n {\n pthread_mutexattr_t mattr;\n ERRCHECK (pthread_mutexattr_init (&mattr));\n- ERRCHECK (pthread_mutexattr_setpshared (&mattr, PTHREAD_PROCESS_SHARED));\n ERRCHECK (pthread_mutexattr_settype (&mattr, PTHREAD_MUTEX_ERRORCHECK));\n+ ERRCHECK (pthread_mutexattr_setpshared (&mattr, PTHREAD_PROCESS_SHARED));\n ERRCHECK (pthread_mutex_init (mutex, &mattr));\n ERRCHECK (pthread_mutexattr_destroy (&mattr));\n }\n \n void\n-initialize_shared_condition (pthread_cond_t *cond)\n+initialize_shared_condition (caf_shmem_condvar *cond, const int)\n {\n pthread_condattr_t cattr;\n ERRCHECK (pthread_condattr_init (&cattr));\n@@ -71,3 +74,302 @@ initialize_shared_condition (pthread_cond_t *cond)\n ERRCHECK (pthread_cond_init (cond, &cattr));\n ERRCHECK (pthread_condattr_destroy (&cattr));\n }\n+#else\n+#include \"../caf_error.h\"\n+#include \"supervisor.h\"\n+#include \"teams_mgmt.h\"\n+#include <windows.h>\n+#include <assert.h>\n+\n+static HANDLE *handles = NULL;\n+static size_t cap_handles = 0;\n+\n+static const int ULONGBITS = sizeof (unsigned long) << 3; // *8\n+\n+static size_t\n+smax (size_t a, size_t b)\n+{\n+ return a < b ? b : a;\n+}\n+\n+static HANDLE\n+get_handle (const size_t id, const char t)\n+{\n+ const int add = t == 'c' ? 1 : 0;\n+ while (id + add >= cap_handles)\n+ {\n+ cap_handles += 1024;\n+ if (handles)\n+\thandles = realloc (handles, sizeof (HANDLE) * cap_handles);\n+ else\n+\thandles = malloc (sizeof (HANDLE) * cap_handles);\n+ if (!handles)\n+\tcaf_runtime_error (\n+\t \"can not get buffer for synchronication objects, aborting\");\n+\n+ memset (&handles[cap_handles - 1024], 0, sizeof (HANDLE) * 1024);\n+ }\n+ if (!handles[id])\n+ {\n+ static char *pid = NULL;\n+ char name[MAX_PATH];\n+\n+ if (!pid)\n+\tpid = shared_memory_get_env ();\n+ snprintf (name, MAX_PATH, \"Global_gfortran-%s-%c-%zd\", pid, t, id);\n+ switch (t)\n+\t{\n+\tcase 'm':\n+\t handles[id] = CreateMutex (NULL, false, name);\n+\t break;\n+\tcase 'c':\n+\t {\n+\t handles[id] = CreateSemaphore (NULL, 0, __INT_MAX__, name);\n+\t snprintf (name, MAX_PATH, \"Global_gfortran-%s-%c-%zd_lock\", pid, t,\n+\t\t id);\n+\t handles[id + 1] = CreateSemaphore (NULL, 1, 1, name);\n+\t this_image.supervisor->global_used_handles\n+\t = smax (this_image.supervisor->global_used_handles, id + 2);\n+\t break;\n+\t }\n+\tdefault:\n+\t caf_runtime_error (\"Unknown handle type %c\", t);\n+\t exit (1);\n+\t}\n+ if (handles[id] == NULL)\n+\t{\n+\t caf_runtime_error (\n+\t \"Could not create synchronisation object, error: %d\",\n+\t GetLastError ());\n+\t return NULL;\n+\t}\n+\n+ this_image.supervisor->global_used_handles\n+\t= smax (this_image.supervisor->global_used_handles, id + 1);\n+ }\n+\n+ return handles[id];\n+}\n+\n+static HANDLE\n+get_mutex (caf_shmem_mutex *m)\n+{\n+ return get_handle (m->id, 'm');\n+}\n+\n+static HANDLE\n+get_condvar (caf_shmem_condvar *cv)\n+{\n+ return get_handle (cv->id, 'c');\n+}\n+\n+void\n+thread_support_init_supervisor (void)\n+{\n+ if (local->total_num_images > ULONGBITS * MAX_NUM_SIGNALED)\n+ caf_runtime_error (\"Maximum number of supported images is %zd.\",\n+\t\t ULONGBITS * MAX_NUM_SIGNALED);\n+ this_image.supervisor->global_used_handles = 0;\n+}\n+\n+int\n+caf_shmem_mutex_lock (caf_shmem_mutex *m)\n+{\n+ HANDLE mutex = get_mutex (m);\n+ DWORD res = WaitForSingleObject (mutex, INFINITE);\n+\n+ /* Return zero on success. */\n+ return res != WAIT_OBJECT_0;\n+}\n+\n+int\n+caf_shmem_mutex_trylock (caf_shmem_mutex *m)\n+{\n+ HANDLE mutex = get_mutex (m);\n+ DWORD res = WaitForSingleObject (mutex, 0);\n+\n+ return res == WAIT_OBJECT_0 ? 0 : EBUSY;\n+}\n+\n+int\n+caf_shmem_mutex_unlock (caf_shmem_mutex *m)\n+{\n+ HANDLE mutex = get_mutex (m);\n+ BOOL res = ReleaseMutex (mutex);\n+\n+ if (!res)\n+ {\n+ LPVOID lpMsgBuf;\n+ DWORD dw = GetLastError ();\n+\n+ if (FormatMessage (FORMAT_MESSAGE_ALLOCATE_BUFFER\n+\t\t\t | FORMAT_MESSAGE_FROM_SYSTEM\n+\t\t\t | FORMAT_MESSAGE_IGNORE_INSERTS,\n+\t\t\t NULL, dw, MAKELANGID (LANG_NEUTRAL, SUBLANG_DEFAULT),\n+\t\t\t (LPTSTR) &lpMsgBuf, 0, NULL)\n+\t == 0)\n+\t{\n+\t fprintf (stderr, \"%d: formatting the error message failed.\\n\",\n+\t\t this_image.image_num);\n+\t ExitProcess (dw);\n+\t}\n+\n+ fprintf (stderr, \"%d: unlock mutex failed: %d, %s\\n\",\n+\t this_image.image_num, dw, (LPCTSTR) lpMsgBuf);\n+\n+ LocalFree (lpMsgBuf);\n+ }\n+ return res ? 0 : EPERM;\n+}\n+\n+static bool\n+bm_is_set (volatile unsigned long mask[], const int b)\n+{\n+ return (mask[b / ULONGBITS] & (1UL << (b % ULONGBITS))) != 0;\n+}\n+\n+static void\n+bm_clear_bit (volatile unsigned long mask[], const int b)\n+{\n+ mask[b / ULONGBITS] &= ~(1UL << (b % ULONGBITS));\n+}\n+\n+static void\n+bm_set_mask (volatile unsigned long mask[], const int size)\n+{\n+ const int entries = size / ULONGBITS;\n+ const int rem = size % ULONGBITS;\n+ int i = 0;\n+ assert (entries >= 0);\n+\n+ for (; i < entries; ++i)\n+ mask[i] = ~0UL;\n+ if (rem != 0)\n+ mask[i] = ~0UL >> (ULONGBITS - rem);\n+}\n+\n+__attribute_used__ static bool\n+bm_is_none (volatile unsigned long mask[], const int size)\n+{\n+ const int entries = size / ULONGBITS;\n+ const int rem = size % ULONGBITS;\n+ int i = 0;\n+ for (; i < entries; ++i)\n+ if (mask[i] != 0)\n+ return false;\n+\n+ return rem == 0 || ((mask[i] & (~0UL >> (ULONGBITS - rem))) == 0);\n+}\n+\n+void\n+caf_shmem_cond_wait (caf_shmem_condvar *cv, caf_shmem_mutex *m)\n+{\n+ HANDLE mutex = get_mutex (m), condvar = get_condvar (cv),\n+\t lock = get_handle (cv->id + 1, 'c');\n+ HANDLE entry[3] = {mutex, condvar, lock};\n+ int res;\n+\n+ WaitForSingleObject (lock, INFINITE);\n+ for (;;)\n+ {\n+ if (bm_is_set (cv->signaled, this_image.image_num) || cv->any)\n+\t{\n+\t break;\n+\t}\n+ ReleaseMutex (mutex);\n+ ReleaseSemaphore (lock, 1, NULL);\n+ res = WaitForMultipleObjects (3, entry, true, INFINITE);\n+ if (res != WAIT_OBJECT_0)\n+\t{\n+\t fprintf (stderr, \"%d: failed to get all wait for: %d\\n\",\n+\t\t this_image.image_num, res);\n+\t fflush (stderr);\n+\t}\n+ ReleaseSemaphore (condvar, 1, NULL);\n+ }\n+ res = WaitForSingleObject (condvar, INFINITE);\n+ if (res != WAIT_OBJECT_0)\n+ {\n+ fprintf (stderr, \"%d: failed to get condvar: %d\\n\", this_image.image_num,\n+\t res);\n+ fflush (stderr);\n+ }\n+\n+ bm_clear_bit (cv->signaled, this_image.image_num);\n+ cv->any = 0;\n+ ReleaseSemaphore (lock, 1, NULL);\n+}\n+\n+void\n+caf_shmem_cond_broadcast (caf_shmem_condvar *cv)\n+{\n+ HANDLE condvar = get_condvar (cv), lock = get_handle (cv->id + 1, 'c');\n+\n+ WaitForSingleObject (lock, INFINITE);\n+ bm_set_mask (cv->signaled, cv->size);\n+ bm_clear_bit (cv->signaled, this_image.image_num);\n+\n+ ReleaseSemaphore (condvar, cv->size, NULL);\n+ ReleaseSemaphore (lock, 1, NULL);\n+}\n+\n+void\n+caf_shmem_cond_signal (caf_shmem_condvar *cv)\n+{\n+ HANDLE condvar = get_condvar (cv), lock = get_handle (cv->id + 1, 'c');\n+\n+ if (caf_current_team)\n+ {\n+ WaitForSingleObject (lock, INFINITE);\n+ }\n+ else\n+ return;\n+ /* The first image is zero, which wouldn't allow it to signal. */\n+ cv->any = this_image.image_num + 1;\n+ ReleaseSemaphore (condvar, 1, NULL);\n+ ReleaseSemaphore (lock, 1, NULL);\n+}\n+\n+void\n+caf_shmem_cond_update_count (caf_shmem_condvar *cv, int val)\n+{\n+ cv->size += val;\n+}\n+\n+void\n+initialize_shared_mutex (caf_shmem_mutex *m)\n+{\n+ *m = (caf_shmem_mutex) {this_image.supervisor->global_used_handles};\n+\n+ get_mutex (m);\n+}\n+\n+void\n+initialize_shared_errorcheck_mutex (caf_shmem_mutex *m)\n+{\n+ *m = (caf_shmem_mutex) {this_image.supervisor->global_used_handles};\n+\n+ get_mutex (m);\n+}\n+\n+void\n+initialize_shared_condition (caf_shmem_condvar *cv, const int size)\n+{\n+ *cv = (caf_shmem_condvar) {this_image.supervisor->global_used_handles,\n+\t\t\t 0,\n+\t\t\t size,\n+\t\t\t {}};\n+\n+ memset ((void *) cv->signaled, 0, sizeof (unsigned long) * MAX_NUM_SIGNALED);\n+ get_condvar (cv);\n+ assert (bm_is_none (cv->signaled, cv->size));\n+}\n+\n+void\n+thread_support_cleanup (void)\n+{\n+ for (size_t i = 0; i < this_image.supervisor->global_used_handles; ++i)\n+ if (handles[i])\n+ CloseHandle (handles[i]);\n+}\n+#endif\ndiff --git a/libgfortran/caf/shmem/thread_support.h b/libgfortran/caf/shmem/thread_support.h\nold mode 100644\nnew mode 100755\nindex e70b4b83c7d..351cdbbb868\n--- a/libgfortran/caf/shmem/thread_support.h\n+++ b/libgfortran/caf/shmem/thread_support.h\n@@ -25,14 +25,89 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see\n #ifndef THREAD_SUPPORT_H\n #define THREAD_SUPPORT_H\n \n+#ifdef HAVE_CONFIG_H\n+#include \"config.h\"\n+#endif\n+\n+#ifndef WIN32\n+#include <sys/types.h>\n+\n+typedef pid_t caf_shmem_pid;\n+typedef int caf_shmem_fd;\n+#else\n+#include <handleapi.h>\n+\n+typedef HANDLE caf_shmem_pid;\n+typedef HANDLE caf_shmem_fd;\n+#endif\n+\n+#if !defined(WIN32) && !defined(__CYGWIN__)\n #include <pthread.h>\n \n+typedef pthread_mutex_t caf_shmem_mutex;\n+typedef pthread_cond_t caf_shmem_condvar;\n+\n+#define CAF_SHMEM_MUTEX_INITIALIZER PTHREAD_MUTEX_INITIALIZER\n+#define CAF_SHMEM_COND_INITIALIZER PTHREAD_COND_INITIALIZER\n+\n+#define thread_support_init_supervisor() (void) 0\n+\n+#define caf_shmem_mutex_lock pthread_mutex_lock\n+#define caf_shmem_mutex_trylock pthread_mutex_trylock\n+#define caf_shmem_mutex_unlock pthread_mutex_unlock\n+\n+#define caf_shmem_cond_wait pthread_cond_wait\n+#define caf_shmem_cond_broadcast pthread_cond_broadcast\n+#define caf_shmem_cond_signal pthread_cond_signal\n+#define caf_shmem_cond_update_count(c, v) (void) 0\n+\n+#define thread_support_cleanup() (void) 0\n+#else\n+#include <synchapi.h>\n+#include <stddef.h>\n+\n+typedef struct caf_shmem_mutex\n+{\n+ size_t id;\n+} caf_shmem_mutex;\n+\n+#define MAX_NUM_SIGNALED 8\n+\n+typedef struct caf_shmem_condvar\n+{\n+ size_t id;\n+ volatile int any;\n+ int size;\n+ volatile unsigned long signaled[MAX_NUM_SIGNALED];\n+} caf_shmem_condvar;\n+\n+#define CAF_SHMEM_MUTEX_INITIALIZER (caf_shmem_mutex){0}\n+#define CAF_SHMEM_COND_INITIALIZER \\\n+ (caf_shmem_condvar) \\\n+ { \\\n+ 0, 0, 0, {} \\\n+ }\n+\n+void thread_support_init_supervisor (void);\n+\n+int caf_shmem_mutex_lock (caf_shmem_mutex *);\n+int caf_shmem_mutex_trylock (caf_shmem_mutex *);\n+int caf_shmem_mutex_unlock (caf_shmem_mutex *);\n+\n+void caf_shmem_cond_wait (caf_shmem_condvar *, caf_shmem_mutex *);\n+void caf_shmem_cond_broadcast (caf_shmem_condvar *);\n+void caf_shmem_cond_signal (caf_shmem_condvar *);\n+void caf_shmem_cond_update_count (caf_shmem_condvar *, int);\n+\n+void thread_support_cleanup (void);\n+#endif\n+\n /* Support routines to setup pthread structs in shared memory. */\n \n-void initialize_shared_mutex (pthread_mutex_t *);\n+void initialize_shared_mutex (caf_shmem_mutex *);\n \n-void initialize_shared_errorcheck_mutex (pthread_mutex_t *);\n+void initialize_shared_errorcheck_mutex (caf_shmem_mutex *);\n \n-void initialize_shared_condition (pthread_cond_t *);\n+void initialize_shared_condition (caf_shmem_condvar *, const int size);\n \n #endif\n", "prefixes": [ "8/13" ] }