forked from schacon/perl
-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathos2ish.h
1250 lines (1052 loc) · 37.6 KB
/
os2ish.h
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
#include <signal.h>
#include <io.h>
/* #include <sys/select.h> */
/* HAS_IOCTL:
* This symbol, if defined, indicates that the ioctl() routine is
* available to set I/O characteristics
*/
#define HAS_IOCTL /**/
/* HAS_UTIME:
* This symbol, if defined, indicates that the routine utime() is
* available to update the access and modification times of files.
*/
#define HAS_UTIME /**/
/* BIG_TIME:
* This symbol is defined if Time_t is an unsigned type on this system.
*/
#define BIG_TIME
#define HAS_KILL
#define HAS_WAIT
#define HAS_DLERROR
#define HAS_WAITPID_RUNTIME (_emx_env & 0x200)
/* HAS_PASSWD
* This symbol, if defined, indicates that the getpwnam() and
* getpwuid() routines are available to get password entries.
* The getpwent() has a separate definition, HAS_GETPWENT.
*/
#define HAS_PASSWD
/* HAS_GROUP
* This symbol, if defined, indicates that the getgrnam() and
* getgrgid() routines are available to get group entries.
* The getgrent() has a separate definition, HAS_GETGRENT.
*/
#define HAS_GROUP
#define HAS_GETGRENT /* fake */
#define HAS_SETGRENT /* fake */
#define HAS_ENDGRENT /* fake */
/* USEMYBINMODE
* This symbol, if defined, indicates that the program should
* use the routine my_binmode(FILE *fp, char iotype, int mode) to insure
* that a file is in "binary" mode -- that is, that no translation
* of bytes occurs on read or write operations.
*/
#undef USEMYBINMODE
#define SOCKET_OPEN_MODE "b"
/* Stat_t:
* This symbol holds the type used to declare buffers for information
* returned by stat(). It's usually just struct stat. It may be necessary
* to include <sys/stat.h> and <sys/types.h> to get any typedef'ed
* information.
*/
#define Stat_t struct stat
/* USE_STAT_RDEV:
* This symbol is defined if this system has a stat structure declaring
* st_rdev
*/
#define USE_STAT_RDEV /**/
/* ACME_MESS:
* This symbol, if defined, indicates that error messages should be
* should be generated in a format that allows the use of the Acme
* GUI/editor's autofind feature.
*/
#undef ACME_MESS /**/
/* ALTERNATE_SHEBANG:
* This symbol, if defined, contains a "magic" string which may be used
* as the first line of a Perl program designed to be executed directly
* by name, instead of the standard Unix #!. If ALTERNATE_SHEBANG
* begins with a character other then #, then Perl will only treat
* it as a command line if if finds the string "perl" in the first
* word; otherwise it's treated as the first line of code in the script.
* (IOW, Perl won't hand off to another interpreter via an alternate
* shebang sequence that might be legal Perl code.)
*/
#define ALTERNATE_SHEBANG "extproc "
#ifndef SIGABRT
# define SIGABRT SIGILL
#endif
#ifndef SIGILL
# define SIGILL 6 /* blech */
#endif
#define ABORT() kill(PerlProc_getpid(),SIGABRT);
#define BIT_BUCKET "/dev/nul" /* Will this work? */
/* Apparently TCPIPV4 defines may be included even with only IAK present */
#if !defined(NO_TCPIPV4) && !defined(TCPIPV4)
# define TCPIPV4
# define TCPIPV4_FORCED /* Just in case */
#endif
#if defined(I_SYS_UN) && !defined(TCPIPV4)
/* It is not working without TCPIPV4 defined. */
# undef I_SYS_UN
#endif
#ifdef USE_ITHREADS
#define do_spawn(a) os2_do_spawn(aTHX_ (a))
#define do_aspawn(a,b,c) os2_do_aspawn(aTHX_ (a),(b),(c))
#define OS2_ERROR_ALREADY_POSTED 299 /* Avoid os2.h */
extern int rc;
#define MUTEX_INIT(m) \
STMT_START { \
int rc; \
if ((rc = _rmutex_create(m,0))) \
Perl_croak_nocontext("panic: MUTEX_INIT: rc=%i", rc); \
} STMT_END
#define MUTEX_LOCK(m) \
STMT_START { \
int rc; \
if ((rc = _rmutex_request(m,_FMR_IGNINT))) \
Perl_croak_nocontext("panic: MUTEX_LOCK: rc=%i", rc); \
} STMT_END
#define MUTEX_UNLOCK(m) \
STMT_START { \
int rc; \
if ((rc = _rmutex_release(m))) \
Perl_croak_nocontext("panic: MUTEX_UNLOCK: rc=%i", rc); \
} STMT_END
#define MUTEX_DESTROY(m) \
STMT_START { \
int rc; \
if ((rc = _rmutex_close(m))) \
Perl_croak_nocontext("panic: MUTEX_DESTROY: rc=%i", rc); \
} STMT_END
#define COND_INIT(c) \
STMT_START { \
int rc; \
if ((rc = DosCreateEventSem(NULL,c,0,0))) \
Perl_croak_nocontext("panic: COND_INIT: rc=%i", rc); \
} STMT_END
#define COND_SIGNAL(c) \
STMT_START { \
int rc; \
if ((rc = DosPostEventSem(*(c))) && rc != OS2_ERROR_ALREADY_POSTED)\
Perl_croak_nocontext("panic: COND_SIGNAL, rc=%ld", rc); \
} STMT_END
#define COND_BROADCAST(c) \
STMT_START { \
int rc; \
if ((rc = DosPostEventSem(*(c))) && rc != OS2_ERROR_ALREADY_POSTED)\
Perl_croak_nocontext("panic: COND_BROADCAST, rc=%i", rc); \
} STMT_END
/* #define COND_WAIT(c, m) \
STMT_START { \
if (WaitForSingleObject(*(c),INFINITE) == WAIT_FAILED) \
Perl_croak_nocontext("panic: COND_WAIT"); \
} STMT_END
*/
#define COND_WAIT(c, m) os2_cond_wait(c,m)
#define COND_WAIT_win32(c, m) \
STMT_START { \
int rc; \
if ((rc = SignalObjectAndWait(*(m),*(c),INFINITE,FALSE))) \
Perl_croak_nocontext("panic: COND_WAIT"); \
else \
MUTEX_LOCK(m); \
} STMT_END
#define COND_DESTROY(c) \
STMT_START { \
int rc; \
if ((rc = DosCloseEventSem(*(c)))) \
Perl_croak_nocontext("panic: COND_DESTROY, rc=%i", rc); \
} STMT_END
/*#define THR ((struct thread *) TlsGetValue(PL_thr_key))
*/
#ifdef USE_SLOW_THREAD_SPECIFIC
# define pthread_getspecific(k) (*_threadstore())
# define pthread_setspecific(k,v) (*_threadstore()=v,0)
# define pthread_key_create(keyp,flag) (*keyp=_gettid(),0)
#else /* USE_SLOW_THREAD_SPECIFIC */
# define pthread_getspecific(k) (*(k))
# define pthread_setspecific(k,v) (*(k)=(v),0)
# define pthread_key_create(keyp,flag) \
( DosAllocThreadLocalMemory(1,(unsigned long**)keyp) \
? Perl_croak_nocontext("LocalMemory"),1 \
: 0 \
)
#endif /* USE_SLOW_THREAD_SPECIFIC */
#define pthread_key_delete(keyp)
#define pthread_self() _gettid()
#define YIELD DosSleep(0)
#ifdef PTHREADS_INCLUDED /* For ./x2p stuff. */
int pthread_join(pthread_t tid, void **status);
int pthread_detach(pthread_t tid);
int pthread_create(pthread_t *tid, const pthread_attr_t *attr,
void *(*start_routine)(void*), void *arg);
#endif /* PTHREAD_INCLUDED */
#define THREADS_ELSEWHERE
#else /* USE_ITHREADS */
#define do_spawn(a) os2_do_spawn(a)
#define do_aspawn(a,b,c) os2_do_aspawn((a),(b),(c))
void Perl_OS2_init(char **);
void Perl_OS2_init3(char **envp, void **excH, int flags);
void Perl_OS2_term(void **excH, int exitstatus, int flags);
/* The code without INIT3 hideously puts env inside: */
/* These ones should be in the same block as PERL_SYS_TERM() */
#ifdef PERL_CORE
# define PERL_SYS_INIT3_BODY(argcp, argvp, envp) \
{ void *xreg[2]; \
MALLOC_CHECK_TAINT(*argcp, *argvp, *envp) \
_response(argcp, argvp); \
_wildcard(argcp, argvp); \
Perl_OS2_init3(*envp, xreg, 0); \
PERLIO_INIT
# define PERL_SYS_INIT_BODY(argcp, argvp) { \
{ void *xreg[2]; \
_response(argcp, argvp); \
_wildcard(argcp, argvp); \
Perl_OS2_init3(NULL, xreg, 0); \
PERLIO_INIT
#else /* Compiling embedded Perl or Perl extension */
# define PERL_SYS_INIT3_BODY(argcp, argvp, envp) \
{ void *xreg[2]; \
Perl_OS2_init3(*envp, xreg, 0); \
PERLIO_INIT
# define PERL_SYS_INIT_BODY(argcp, argvp) { \
{ void *xreg[2]; \
Perl_OS2_init3(NULL, xreg, 0); \
PERLIO_INIT
#endif
#define FORCE_EMX_DEINIT_EXIT 1
#define FORCE_EMX_DEINIT_CRT_TERM 2
#define FORCE_EMX_DEINIT_RUN_ATEXIT 4
#define PERL_SYS_TERM2(xreg,flags) \
Perl_OS2_term(xreg, 0, flags); \
PERLIO_TERM; \
MALLOC_TERM
#define PERL_SYS_TERM1(xreg) \
Perl_OS2_term(xreg, 0, FORCE_EMX_DEINIT_RUN_ATEXIT)
/* This one should come in pair with PERL_SYS_INIT_BODY() and in the same block */
#define PERL_SYS_TERM_BODY() \
PERL_SYS_TERM1(xreg); \
}
#ifndef __EMX__
# define PERL_CALLCONV _System
#endif
/* #define PERL_SYS_TERM_BODY() STMT_START { \
if (Perl_HAB_set) WinTerminate(Perl_hab); } STMT_END */
#define dXSUB_SYS OS2_XS_init()
#ifdef PERL_IS_AOUT
/* # define HAS_FORK */
/* # define HIDEMYMALLOC */
/* # define PERL_SBRK_VIA_MALLOC */ /* gets off-page sbrk... */
#else /* !PERL_IS_AOUT */
# ifndef PERL_FOR_X2P
# ifdef EMX_BAD_SBRK
# define USE_PERL_SBRK
# endif
# else
# define PerlIO FILE
# endif
# define SYSTEM_ALLOC(a) sys_alloc(a)
void *sys_alloc(int size);
#endif /* !PERL_IS_AOUT */
#if !defined(PERL_CORE) && !defined(PerlIO) /* a2p */
# define PerlIO FILE
#endif
/* os2ish is used from a2p/a2p.h without pTHX/pTHX_ first being
* defined. Hack around this to get us to compile.
*/
#ifdef PTHX_UNUSED
# ifndef pTHX
# define pTHX
# endif
# ifndef pTHX_
# define pTHX_
# endif
#endif
#define TMPPATH1 "plXXXXXX"
extern const char *tmppath;
PerlIO *my_syspopen(pTHX_ char *cmd, char *mode);
#ifdef PERL_CORE
/* Cannot prototype with I32, SV at this point (used in x2p too). */
PerlIO *my_syspopen4(pTHX_ char *cmd, char *mode, I32 cnt, SV** args);
#endif
int my_syspclose(PerlIO *f);
FILE *my_tmpfile (void);
char *my_tmpnam (char *);
int my_mkdir (__const__ char *, long);
int my_rmdir (__const__ char *);
struct passwd *my_getpwent (void);
void my_setpwent (void);
void my_endpwent (void);
char *gcvt_os2(double value, int digits, char *buffer);
extern int async_mssleep(unsigned long ms, int switch_priority);
extern unsigned long msCounter(void);
extern unsigned long InfoTable(int local);
extern unsigned long find_myself(void);
#define MAX_SLEEP (((1<30) / (1000/4))-1) /* 1<32 msec */
static __inline__ unsigned
my_sleep(unsigned sec)
{
int remain;
while (sec > MAX_SLEEP) {
sec -= MAX_SLEEP;
remain = sleep(MAX_SLEEP);
if (remain)
return remain + sec;
}
return sleep(sec);
}
#define sleep my_sleep
#ifndef INCL_DOS
unsigned long DosSleep(unsigned long);
unsigned long DosAllocThreadLocalMemory (unsigned long cb, unsigned long **p);
#endif
struct group *getgrent (void);
void setgrent (void);
void endgrent (void);
struct passwd *my_getpwuid (uid_t);
struct passwd *my_getpwnam (__const__ char *);
#undef L_tmpnam
#define L_tmpnam MAXPATHLEN
#define tmpfile my_tmpfile
#define tmpnam my_tmpnam
#define isatty _isterm
#define rand random
#define srand srandom
#define strtoll _strtoll
#define strtoull _strtoull
#define usleep(usec) ((void)async_mssleep(((usec)+500)/1000, 500))
/*
* fwrite1() should be a routine with the same calling sequence as fwrite(),
* but which outputs all of the bytes requested as a single stream (unlike
* fwrite() itself, which on some systems outputs several distinct records
* if the number_of_items parameter is >1).
*/
#define fwrite1 fwrite
#define my_getenv(var) getenv(var)
#define flock my_flock
#define rmdir my_rmdir
#define mkdir my_mkdir
#define setpwent my_setpwent
#define getpwent my_getpwent
#define endpwent my_endpwent
#define getpwuid my_getpwuid
#define getpwnam my_getpwnam
void *emx_calloc (size_t, size_t);
void emx_free (void *);
void *emx_malloc (size_t);
void *emx_realloc (void *, size_t);
/*****************************************************************************/
#include <stdlib.h> /* before the following definitions */
#include <unistd.h> /* before the following definitions */
#include <fcntl.h>
#include <sys/stat.h>
#define chdir _chdir2
#define getcwd _getcwd2
/* This guy is needed for quick stdstd */
#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
/* Perl uses ungetc only with successful return */
# define ungetc(c,fp) \
(FILE_ptr(fp) > FILE_base(fp) && c == (int)*(FILE_ptr(fp) - 1) \
? (--FILE_ptr(fp), ++FILE_cnt(fp), (int)c) : ungetc(c,fp))
#endif
#define PERLIO_IS_BINMODE_FD(fd) _PERLIO_IS_BINMODE_FD(fd)
#ifdef __GNUG__
# define HAS_BOOL
#endif
#ifndef HAS_BOOL
# define bool char
# define HAS_BOOL 1
#endif
#include <emx/io.h> /* for _fd_flags() prototype */
static inline bool
_PERLIO_IS_BINMODE_FD(int fd)
{
int *pflags = _fd_flags(fd);
return pflags && (*pflags) & O_BINARY;
}
/* ctermid is missing from emx0.9d */
char *ctermid(char *s);
#define OP_BINARY O_BINARY
#define OS2_STAT_HACK 1
#if OS2_STAT_HACK
#define Stat(fname,bufptr) os2_stat((fname),(bufptr))
#define Fstat(fd,bufptr) os2_fstat((fd),(bufptr))
#define Fflush(fp) fflush(fp)
#define Mkdir(path,mode) mkdir((path),(mode))
#define chmod(path,mode) os2_chmod((path),(mode))
#undef S_IFBLK
#undef S_ISBLK
#define S_IFBLK 0120000 /* Hacks to make things compile... */
#define S_ISBLK(mode) (((mode) & S_IFMT) == S_IFBLK)
int os2_chmod(const char *name, int pmode);
int os2_fstat(int handle, struct stat *st);
#else
#define Stat(fname,bufptr) stat((fname),(bufptr))
#define Fstat(fd,bufptr) fstat((fd),(bufptr))
#define Fflush(fp) fflush(fp)
#define Mkdir(path,mode) mkdir((path),(mode))
#endif
/* With SD386 it is impossible to debug register variables. */
#if !defined(PERL_IS_AOUT) && defined(DEBUGGING) && !defined(register)
# define register
#endif
/* Our private OS/2 specific data. */
typedef struct OS2_Perl_data {
unsigned long flags;
unsigned long phab;
int (*xs_init)();
unsigned long rc;
unsigned long severity;
unsigned long phmq; /* Handle to message queue */
unsigned long phmq_refcnt;
unsigned long phmq_servers;
unsigned long initial_mode; /* VIO etc. mode we were started in */
unsigned long morph_refcnt;
} OS2_Perl_data_t;
extern OS2_Perl_data_t OS2_Perl_data;
#define Perl_hab ((HAB)OS2_Perl_data.phab)
#define Perl_rc (OS2_Perl_data.rc)
#define Perl_severity (OS2_Perl_data.severity)
#define errno_isOS2 12345678
#define errno_isOS2_set 12345679
#define OS2_Perl_flags (OS2_Perl_data.flags)
#define Perl_HAB_set_f 1
#define Perl_HAB_set (OS2_Perl_flags & Perl_HAB_set_f)
#define set_Perl_HAB_f (OS2_Perl_flags |= Perl_HAB_set_f)
#define set_Perl_HAB(h) (set_Perl_HAB_f, Perl_hab = h)
#define _obtain_Perl_HAB (init_PMWIN_entries(), \
Perl_hab = (*PMWIN_entries.Initialize)(0), \
set_Perl_HAB_f, Perl_hab)
#define perl_hab_GET() (Perl_HAB_set ? Perl_hab : _obtain_Perl_HAB)
#define Acquire_hab() perl_hab_GET()
#define Perl_hmq ((HMQ)OS2_Perl_data.phmq)
#define Perl_hmq_refcnt (OS2_Perl_data.phmq_refcnt)
#define Perl_hmq_servers (OS2_Perl_data.phmq_servers)
#define Perl_os2_initial_mode (OS2_Perl_data.initial_mode)
#define Perl_morph_refcnt (OS2_Perl_data.morph_refcnt)
unsigned long Perl_hab_GET();
unsigned long Perl_Register_MQ(int serve);
void Perl_Deregister_MQ(int serve);
int Perl_Serve_Messages(int force);
/* Cannot prototype with I32 at this point. */
int Perl_Process_Messages(int force, long *cntp);
char *os2_execname(pTHX);
struct _QMSG;
struct PMWIN_entries_t {
unsigned long (*Initialize)( unsigned long fsOptions );
unsigned long (*CreateMsgQueue)(unsigned long hab, long cmsg);
int (*DestroyMsgQueue)(unsigned long hmq);
int (*PeekMsg)(unsigned long hab, struct _QMSG *pqmsg,
unsigned long hwndFilter, unsigned long msgFilterFirst,
unsigned long msgFilterLast, unsigned long fl);
int (*GetMsg)(unsigned long hab, struct _QMSG *pqmsg,
unsigned long hwndFilter, unsigned long msgFilterFirst,
unsigned long msgFilterLast);
void * (*DispatchMsg)(unsigned long hab, struct _QMSG *pqmsg);
unsigned long (*GetLastError)(unsigned long hab);
unsigned long (*CancelShutdown)(unsigned long hmq, unsigned long fCancelAlways);
};
extern struct PMWIN_entries_t PMWIN_entries;
void init_PMWIN_entries(void);
#define perl_hmq_GET(serve) Perl_Register_MQ(serve)
#define perl_hmq_UNSET(serve) Perl_Deregister_MQ(serve)
#define OS2_XS_init() (*OS2_Perl_data.xs_init)(aTHX)
#if _EMX_CRT_REV_ >= 60
# define os2_setsyserrno(rc) (Perl_rc = rc, errno = errno_isOS2_set, \
_setsyserrno(rc))
#else
# define os2_setsyserrno(rc) (Perl_rc = rc, errno = errno_isOS2)
#endif
/* The expressions below return true on error. */
/* INCL_DOSERRORS needed. rc should be declared outside. */
#define CheckOSError(expr) ((rc = (expr)) ? (FillOSError(rc), rc) : 0)
/* INCL_WINERRORS needed. */
#define CheckWinError(expr) ((expr) ? 0: (FillWinError, 1))
/* This form propagates the return value, setting $^E if needed */
#define SaveWinError(expr) ((expr) ? : (FillWinError, 0))
/* This form propagates the return value, dieing with $^E if needed */
#define SaveCroakWinError(expr,die,name1,name2) \
((expr) ? : (CroakWinError(die,name1 name2), 0))
#define FillOSError(rc) (os2_setsyserrno(rc), \
Perl_severity = SEVERITY_ERROR)
#define WinError_2_Perl_rc \
( init_PMWIN_entries(), \
Perl_rc=(*PMWIN_entries.GetLastError)(perl_hab_GET()) )
/* Calling WinGetLastError() resets the error code of the current thread.
Since for some Win* API return value 0 is normal, one needs to call
this before calling them to distinguish normal and anomalous returns. */
/*#define ResetWinError() WinError_2_Perl_rc */
/* At this moment init_PMWIN_entries() should be a nop (WinInitialize should
be called already, right?), so we do not risk stepping over our own error */
#define FillWinError ( WinError_2_Perl_rc, \
Perl_severity = ERRORIDSEV(Perl_rc), \
Perl_rc = ERRORIDERROR(Perl_rc), \
os2_setsyserrno(Perl_rc))
#define STATIC_FILE_LENGTH 127
/* This should match loadOrdinals[] array in os2.c */
enum entries_ordinals {
ORD_DosQueryExtLibpath,
ORD_DosSetExtLibpath,
ORD_DosVerifyPidTid,
ORD_SETHOSTENT,
ORD_SETNETENT,
ORD_SETPROTOENT,
ORD_SETSERVENT,
ORD_GETHOSTENT,
ORD_GETNETENT,
ORD_GETPROTOENT,
ORD_GETSERVENT,
ORD_ENDHOSTENT,
ORD_ENDNETENT,
ORD_ENDPROTOENT,
ORD_ENDSERVENT,
ORD_WinInitialize,
ORD_WinCreateMsgQueue,
ORD_WinDestroyMsgQueue,
ORD_WinPeekMsg,
ORD_WinGetMsg,
ORD_WinDispatchMsg,
ORD_WinGetLastError,
ORD_WinCancelShutdown,
ORD_RexxStart,
ORD_RexxVariablePool,
ORD_RexxRegisterFunctionExe,
ORD_RexxDeregisterFunction,
ORD_DOSSMSETTITLE,
ORD_PRF32QUERYPROFILESIZE,
ORD_PRF32OPENPROFILE,
ORD_PRF32CLOSEPROFILE,
ORD_PRF32QUERYPROFILE,
ORD_PRF32RESET,
ORD_PRF32QUERYPROFILEDATA,
ORD_PRF32WRITEPROFILEDATA,
ORD_WinChangeSwitchEntry,
ORD_WinQuerySwitchEntry,
ORD_WinQuerySwitchHandle,
ORD_WinQuerySwitchList,
ORD_WinSwitchToProgram,
ORD_WinBeginEnumWindows,
ORD_WinEndEnumWindows,
ORD_WinEnumDlgItem,
ORD_WinGetNextWindow,
ORD_WinIsChild,
ORD_WinQueryActiveWindow,
ORD_WinQueryClassName,
ORD_WinQueryFocus,
ORD_WinQueryWindow,
ORD_WinQueryWindowPos,
ORD_WinQueryWindowProcess,
ORD_WinQueryWindowText,
ORD_WinQueryWindowTextLength,
ORD_WinSetFocus,
ORD_WinSetWindowPos,
ORD_WinSetWindowText,
ORD_WinShowWindow,
ORD_WinIsWindow,
ORD_WinWindowFromId,
ORD_WinWindowFromPoint,
ORD_WinPostMsg,
ORD_WinEnableWindow,
ORD_WinEnableWindowUpdate,
ORD_WinIsWindowEnabled,
ORD_WinIsWindowShowing,
ORD_WinIsWindowVisible,
ORD_WinQueryWindowPtr,
ORD_WinQueryWindowULong,
ORD_WinQueryWindowUShort,
ORD_WinSetWindowBits,
ORD_WinSetWindowPtr,
ORD_WinSetWindowULong,
ORD_WinSetWindowUShort,
ORD_WinQueryDesktopWindow,
ORD_WinSetActiveWindow,
ORD_DosQueryModFromEIP,
ORD_Dos32QueryHeaderInfo,
ORD_DosTmrQueryFreq,
ORD_DosTmrQueryTime,
ORD_WinQueryActiveDesktopPathname,
ORD_WinInvalidateRect,
ORD_WinCreateFrameControls,
ORD_WinQueryClipbrdFmtInfo,
ORD_WinQueryClipbrdOwner,
ORD_WinQueryClipbrdViewer,
ORD_WinQueryClipbrdData,
ORD_WinOpenClipbrd,
ORD_WinCloseClipbrd,
ORD_WinSetClipbrdData,
ORD_WinSetClipbrdOwner,
ORD_WinSetClipbrdViewer,
ORD_WinEnumClipbrdFmts,
ORD_WinEmptyClipbrd,
ORD_WinAddAtom,
ORD_WinFindAtom,
ORD_WinDeleteAtom,
ORD_WinQueryAtomUsage,
ORD_WinQueryAtomName,
ORD_WinQueryAtomLength,
ORD_WinQuerySystemAtomTable,
ORD_WinCreateAtomTable,
ORD_WinDestroyAtomTable,
ORD_WinOpenWindowDC,
ORD_DevOpenDC,
ORD_DevQueryCaps,
ORD_DevCloseDC,
ORD_WinMessageBox,
ORD_WinMessageBox2,
ORD_WinQuerySysValue,
ORD_WinSetSysValue,
ORD_WinAlarm,
ORD_WinFlashWindow,
ORD_WinLoadPointer,
ORD_WinQuerySysPointer,
ORD_DosReplaceModule,
ORD_DosPerfSysCall,
ORD_RexxRegisterSubcomExe,
ORD_NENTRIES
};
/* RET: return type, AT: argument signature in (), ARGS: should be in () */
#define CallORD(ret,o,at,args) (((ret (*)at) loadByOrdinal(o, 1))args)
#define DeclFuncByORD(ret,name,o,at,args) \
ret name at { return CallORD(ret,o,at,args); }
#define DeclVoidFuncByORD(name,o,at,args) \
void name at { CallORD(void,o,at,args); }
/* This function returns error code on error, and saves the error info in $^E and Perl_rc */
#define DeclOSFuncByORD_native(ret,name,o,at,args) \
ret name at { unsigned long rc; return CheckOSError(CallORD(ret,o,at,args)); }
/* These functions return false on error, and save the error info in $^E and Perl_rc */
#define DeclOSFuncByORD(ret,name,o,at,args) \
ret name at { unsigned long rc; return !CheckOSError(CallORD(ret,o,at,args)); }
#define DeclWinFuncByORD(ret,name,o,at,args) \
ret name at { return SaveWinError(CallORD(ret,o,at,args)); }
#define AssignFuncPByORD(p,o) (*(Perl_PFN*)&(p) = (loadByOrdinal(o, 1)))
/* This flavor caches the procedure pointer (named as p__Win#name) locally */
#define DeclWinFuncByORD_CACHE(ret,name,o,at,args) \
DeclWinFuncByORD_CACHE_r(ret,name,o,at,args,0,1)
/* This flavor may reset the last error before the call (if ret=0 may be OK) */
#define DeclWinFuncByORD_CACHE_resetError(ret,name,o,at,args) \
DeclWinFuncByORD_CACHE_r(ret,name,o,at,args,1,1)
/* Two flavors below do the same as above, but do not auto-croak */
/* This flavor caches the procedure pointer (named as p__Win#name) locally */
#define DeclWinFuncByORD_CACHE_survive(ret,name,o,at,args) \
DeclWinFuncByORD_CACHE_r(ret,name,o,at,args,0,0)
/* This flavor may reset the last error before the call (if ret=0 may be OK) */
#define DeclWinFuncByORD_CACHE_resetError_survive(ret,name,o,at,args) \
DeclWinFuncByORD_CACHE_r(ret,name,o,at,args,1,0)
#define DeclWinFuncByORD_CACHE_r(ret,name,o,at,args,r,die) \
static ret (*CAT2(p__Win,name)) at; \
static ret name at { \
if (!CAT2(p__Win,name)) \
AssignFuncPByORD(CAT2(p__Win,name), o); \
if (r) ResetWinError(); \
return SaveCroakWinError(CAT2(p__Win,name) args, die, "[Win]", STRINGIFY(name)); }
/* These flavors additionally assume ORD is name with prepended ORD_Win */
#define DeclWinFunc_CACHE(ret,name,at,args) \
DeclWinFuncByORD_CACHE(ret,name,CAT2(ORD_Win,name),at,args)
#define DeclWinFunc_CACHE_resetError(ret,name,at,args) \
DeclWinFuncByORD_CACHE_resetError(ret,name,CAT2(ORD_Win,name),at,args)
#define DeclWinFunc_CACHE_survive(ret,name,at,args) \
DeclWinFuncByORD_CACHE_survive(ret,name,CAT2(ORD_Win,name),at,args)
#define DeclWinFunc_CACHE_resetError_survive(ret,name,at,args) \
DeclWinFuncByORD_CACHE_resetError_survive(ret,name,CAT2(ORD_Win,name),at,args)
void ResetWinError(void);
void CroakWinError(int die, char *name);
enum Perlos2_handler {
Perlos2_handler_mangle = 1,
Perlos2_handler_perl_sh,
Perlos2_handler_perllib_from,
Perlos2_handler_perllib_to,
};
enum dir_subst_e {
dir_subst_fatal = 1,
dir_subst_pathlike = 2
};
extern int Perl_OS2_handler_install(void *handler, enum Perlos2_handler how);
extern char *dir_subst(char *s, unsigned int l, char *b, unsigned int bl, enum dir_subst_e flags, char *msg);
extern unsigned long fill_extLibpath(int type, char *pre, char *post, int replace, char *msg);
#define PERLLIB_MANGLE(s, n) perllib_mangle((s), (n))
char *perllib_mangle(char *, unsigned int);
#define fork fork_with_resources
#ifdef EINTR /* x2p do not include perl.h!!! */
static __inline__ int
my_select(int nfds, fd_set *readfds, fd_set *writefds, fd_set *exceptfds, struct timeval *timeout)
{
if (nfds == 0 && timeout && (_emx_env & 0x200)) {
if (async_mssleep(1000 * timeout->tv_sec + (timeout->tv_usec + 500)/1000, 500))
return 0;
errno = EINTR;
return -1;
}
return select(nfds, readfds, writefds, exceptfds, timeout);
}
#define select my_select
#endif
typedef int (*Perl_PFN)();
Perl_PFN loadByOrdinal(enum entries_ordinals ord, int fail);
extern const Perl_PFN * const pExtFCN;
char *os2error(int rc);
int os2_stat(const char *name, struct stat *st);
int fork_with_resources();
int setpriority(int which, int pid, int val);
int getpriority(int which /* ignored */, int pid);
void croak_with_os2error(char *s) __attribute__((noreturn));
/* void return value */
#define os2cp_croak(rc,msg) (CheckOSError(rc) && (croak_with_os2error(msg),0))
/* propagates rc */
#define os2win_croak(rc,msg) \
SaveCroakWinError((expr), 1 /* die */, /* no prefix */, (msg))
/* propagates rc; use with functions which may return 0 on success */
#define os2win_croak_0OK(rc,msg) \
SaveCroakWinError((ResetWinError, (expr)), \
1 /* die */, /* no prefix */, (msg))
#ifdef PERL_CORE
int os2_do_spawn(pTHX_ char *cmd);
int os2_do_aspawn(pTHX_ SV *really, SV **vmark, SV **vsp);
#endif
#ifndef LOG_DAEMON
/* Replacement for syslog.h */
# define LOG_EMERG 0 /* system is unusable */
# define LOG_ALERT 1 /* action must be taken immediately */
# define LOG_CRIT 2 /* critical conditions */
# define LOG_ERR 3 /* error conditions */
# define LOG_WARNING 4 /* warning conditions */
# define LOG_NOTICE 5 /* normal but significant condition */
# define LOG_INFO 6 /* informational */
# define LOG_DEBUG 7 /* debug-level messages */
# define LOG_PRIMASK 0x007 /* mask to extract priority part (internal) */
/* extract priority */
# define LOG_PRI(p) ((p) & LOG_PRIMASK)
# define LOG_MAKEPRI(fac, pri) (((fac) << 3) | (pri))
/* facility codes */
# define LOG_KERN (0<<3) /* kernel messages */
# define LOG_USER (1<<3) /* random user-level messages */
# define LOG_MAIL (2<<3) /* mail system */
# define LOG_DAEMON (3<<3) /* system daemons */
# define LOG_AUTH (4<<3) /* security/authorization messages */
# define LOG_SYSLOG (5<<3) /* messages generated internally by syslogd */
# define LOG_LPR (6<<3) /* line printer subsystem */
# define LOG_NEWS (7<<3) /* network news subsystem */
# define LOG_UUCP (8<<3) /* UUCP subsystem */
# define LOG_CRON (15<<3) /* clock daemon */
/* other codes through 15 reserved for system use */
# define LOG_LOCAL0 (16<<3) /* reserved for local use */
# define LOG_LOCAL1 (17<<3) /* reserved for local use */
# define LOG_LOCAL2 (18<<3) /* reserved for local use */
# define LOG_LOCAL3 (19<<3) /* reserved for local use */
# define LOG_LOCAL4 (20<<3) /* reserved for local use */
# define LOG_LOCAL5 (21<<3) /* reserved for local use */
# define LOG_LOCAL6 (22<<3) /* reserved for local use */
# define LOG_LOCAL7 (23<<3) /* reserved for local use */
# define LOG_NFACILITIES 24 /* current number of facilities */
# define LOG_FACMASK 0x03f8 /* mask to extract facility part */
/* facility of pri */
# define LOG_FAC(p) (((p) & LOG_FACMASK) >> 3)
/*
* arguments to setlogmask.
*/
# define LOG_MASK(pri) (1 << (pri)) /* mask for one priority */
# define LOG_UPTO(pri) ((1 << ((pri)+1)) - 1) /* all priorities through pri */
/*
* Option flags for openlog.
*
* LOG_ODELAY no longer does anything.
* LOG_NDELAY is the inverse of what it used to be.
*/
# define LOG_PID 0x01 /* log the pid with each message */
# define LOG_CONS 0x02 /* log on the console if errors in sending */
# define LOG_ODELAY 0x04 /* delay open until first syslog() (default) */
# define LOG_NDELAY 0x08 /* don't delay open */
# define LOG_NOWAIT 0x10 /* don't wait for console forks: DEPRECATED */
# define LOG_PERROR 0x20 /* log to stderr as well */
#endif
/* ************************************************* */
#ifndef MAKEPLINFOSEG
/* From $DDK\base32\rel\os2c\include\base\os2\16bit\infoseg.h + typedefs */
/*
* The structure below defines the content and organization of the system
* information segment (InfoSeg). The actual table is statically defined in
* SDATA.ASM. Ring 0, read/write access is obtained by the clock device
* driver using the DevHlp GetDOSVar function. (GetDOSVar returns a ring 0,
* read-only selector to all other requestors.)
*
* In order to prevent an errant process from destroying the infoseg, two
* identical global infosegs are maintained. One is in the tiled shared
* arena and is accessible in user mode (and therefore can potentially be
* overwritten from ring 2), and the other is in the system arena and is
* accessible only in kernel mode. All kernel code (except the clock driver)
* is responsible for updating BOTH copies of the infoseg. The copy kept
* in the system arena is addressable as DOSGROUP:SISData, and the copy
* in the shared arena is addressable via a system arena alias. 16:16 and
* 0:32 pointers to the alias are stored in _Sis2.
*/
typedef struct InfoSegGDT {
/* Time (offset 0x00) */
unsigned long SIS_BigTime; /* Time from 1-1-1970 in seconds */
unsigned long SIS_MsCount; /* Freerunning milliseconds counter */
unsigned char SIS_HrsTime; /* Hours */
unsigned char SIS_MinTime; /* Minutes */
unsigned char SIS_SecTime; /* Seconds */
unsigned char SIS_HunTime; /* Hundredths of seconds */
unsigned short SIS_TimeZone; /* Timezone in min from GMT (Set to EST) */
unsigned short SIS_ClkIntrvl; /* Timer interval (units=0.0001 secs) */
/* Date (offset 0x10) */
unsigned char SIS_DayDate; /* Day-of-month (1-31) */
unsigned char SIS_MonDate; /* Month (1-12) */
unsigned short SIS_YrsDate; /* Year (>= 1980) */
unsigned char SIS_DOWDate; /* Day-of-week (1-1-80 = Tues = 3) */
/* Version (offset 0x15) */
unsigned char SIS_VerMajor; /* Major version number */
unsigned char SIS_VerMinor; /* Minor version number */
unsigned char SIS_RevLettr; /* Revision letter */
/* System Status (offset 0x18) */
unsigned char SIS_CurScrnGrp; /* Fgnd screen group # */
unsigned char SIS_MaxScrnGrp; /* Maximum number of screen groups */
unsigned char SIS_HugeShfCnt; /* Shift count for huge segments */
unsigned char SIS_ProtMdOnly; /* Protect-mode-only indicator */
unsigned short SIS_FgndPID; /* Foreground process ID */
/* Scheduler Parms (offset 0x1E) */
unsigned char SIS_Dynamic; /* Dynamic variation flag (1=enabled) */
unsigned char SIS_MaxWait; /* Maxwait (seconds) */
unsigned short SIS_MinSlice; /* Minimum timeslice (milliseconds) */
unsigned short SIS_MaxSlice; /* Maximum timeslice (milliseconds) */
/* Boot Drive (offset 0x24) */
unsigned short SIS_BootDrv; /* Drive from which system was booted */
/* RAS Major Event Code Table (offset 0x26) */
unsigned char SIS_mec_table[32]; /* Table of RAS Major Event Codes (MECs) */
/* Additional Session Data (offset 0x46) */
unsigned char SIS_MaxVioWinSG; /* Max. no. of VIO windowable SG's */
unsigned char SIS_MaxPresMgrSG; /* Max. no. of Presentation Manager SG's */
/* Error logging Information (offset 0x48) */
unsigned short SIS_SysLog; /* Error Logging Status */
/* Additional RAS Information (offset 0x4A) */
unsigned short SIS_MMIOBase; /* Memory mapped I/O selector */
unsigned long SIS_MMIOAddr; /* Memory mapped I/O address */
/* Additional 2.0 Data (offset 0x50) */
unsigned char SIS_MaxVDMs; /* Max. no. of Virtual DOS machines */
unsigned char SIS_Reserved;
unsigned char SIS_perf_mec_table[32]; /* varga 6/5/97 Table of Performance Major Event Codes (MECS) varga*/
} GINFOSEG, *PGINFOSEG;
#define SIS_LEN sizeof(struct InfoSegGDT)
/*
* InfoSeg LDT Data Segment Structure
*
* The structure below defines the content and organization of the system
* information in a special per-process segment to be accessible by the
* process through the LDT (read-only).
*
* As in the global infoseg, two copies of the current processes local
* infoseg exist, one accessible in both user and kernel mode, the other
* only in kernel mode. Kernel code is responsible for updating BOTH copies.
* Pointers to the local infoseg copy are stored in _Lis2.