1------------------------------------------------------------------------------ 2-- -- 3-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- 4-- -- 5-- S Y S T E M . O S _ I N T E R F A C E -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1991-1994, Florida State University -- 10-- Copyright (C) 1995-2003, Ada Core Technologies -- 11-- -- 12-- GNARL is free software; you can redistribute it and/or modify it under -- 13-- terms of the GNU General Public License as published by the Free Soft- -- 14-- ware Foundation; either version 2, or (at your option) any later ver- -- 15-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- 16-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 17-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- 18-- for more details. You should have received a copy of the GNU General -- 19-- Public License distributed with GNARL; see file COPYING. If not, write -- 20-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- 21-- MA 02111-1307, USA. -- 22-- -- 23-- As a special exception, if other files instantiate generics from this -- 24-- unit, or you link this unit with other files to produce an executable, -- 25-- this unit does not by itself cause the resulting executable to be -- 26-- covered by the GNU General Public License. This exception does not -- 27-- however invalidate any other reasons why the executable file might be -- 28-- covered by the GNU Public License. -- 29-- -- 30-- GNARL was developed by the GNARL team at Florida State University. -- 31-- Extensive contributions were provided by Ada Core Technologies, Inc. -- 32-- -- 33------------------------------------------------------------------------------ 34 35-- This is a OpenVMS/Alpha version of this package. 36 37-- This package encapsulates all direct interfaces to OS services 38-- that are needed by children of System. 39 40pragma Polling (Off); 41-- Turn off polling, we do not want ATC polling to take place during 42-- tasking operations. It causes infinite loops and other problems. 43 44with Interfaces.C; use Interfaces.C; 45with System.Machine_Code; use System.Machine_Code; 46 47package body System.OS_Interface is 48 49 ------------------ 50 -- pthread_self -- 51 ------------------ 52 53 function pthread_self return pthread_t is 54 use ASCII; 55 Self : pthread_t; 56 57 begin 58 Asm ("call_pal 0x9e" & LF & HT & 59 "bis $31, $0, %0", 60 Outputs => pthread_t'Asm_Output ("=r", Self), 61 Clobber => "$0"); 62 return Self; 63 end pthread_self; 64 65 ----------------- 66 -- sched_yield -- 67 ----------------- 68 69 function sched_yield return int is 70 procedure sched_yield_base; 71 pragma Import (C, sched_yield_base, "PTHREAD_YIELD_NP"); 72 73 begin 74 sched_yield_base; 75 return 0; 76 end sched_yield; 77 78end System.OS_Interface; 79