Commit | Line | Data |
450a55e4 |
1 | extproc C:\binp\misc\perl.exe -S |
fe14fcc3 |
2 | #!perl |
450a55e4 |
3 | |
4 | # os2.pl: Demonstrates the OS/2 system calls and shows off some of the |
5 | # features in common with the UNIX version. |
6 | |
7 | do "syscalls.pl" || die "Cannot load syscalls.pl ($!)"; |
8 | |
9 | # OS/2 version number. |
10 | |
11 | $version = " "; syscall($OS2_GetVersion,$version); |
12 | ($minor, $major) = unpack("CC", $version); |
13 | print "You are using OS/2 version ", int($major/10), |
14 | ".", int($minor/10), "\n\n"; |
15 | |
16 | # Process ID. |
17 | print "This process ID is $$ and its parent's ID is ", |
18 | getppid(), "\n\n"; |
19 | |
20 | # Priority. |
21 | |
22 | printf "Current priority is %x\n", getpriority(0,0); |
23 | print "Changing priority by +5\n"; |
24 | print "Failed!\n" unless setpriority(0,0,+5); |
25 | printf "Priority is now %x\n\n", getpriority(0,0); |
26 | |
27 | # Beep. |
28 | print "Here is an A440.\n\n"; |
29 | syscall($OS2_Beep,440,50); |
30 | |
31 | # Pipes. Unlike MS-DOS, OS/2 supports true asynchronous pipes. |
32 | open(ROT13, '|perl -pe y/a-zA-Z/n-za-mN-ZA-M/') || die; |
33 | select(ROT13); $|=1; select(STDOUT); |
34 | print "Type two lines of stuff, and I'll ROT13 it while you wait.\n". |
35 | "If you type fast, you might be able to type both of your\n". |
36 | "lines before I get a chance to translate the first line.\n"; |
37 | $_ = <STDIN>; print ROT13 $_; |
38 | $_ = <STDIN>; print ROT13 $_; |
39 | close(ROT13); |
40 | print "Thanks.\n\n"; |
41 | |
42 | # Inspecting the disks. |
43 | print "Let's look at the disks you have installed...\n\n"; |
44 | |
45 | $x = "\0\0"; |
46 | syscall($OS2_Config, $x, 2); |
47 | print "You have ", unpack("S", $x), " floppy disks,\n"; |
48 | |
49 | $x = " "; |
50 | syscall($OS2_PhysicalDisk, 1, $x, 2, 0, 0); |
51 | ($numdisks) = unpack("S", $x); |
52 | |
53 | print "and $numdisks partitionable disks.\n\n"; |
54 | for ($i = 1; $i <= $numdisks; $i++) { |
55 | $disk = $i . ":"; |
56 | $handle = " "; |
57 | syscall($OS2_PhysicalDisk, 2, $handle, 2, $disk, 3); |
58 | ($numhandle) = unpack("S", $handle); |
59 | $zero = pack("C", 0); |
60 | $parmblock = " " x 16; |
61 | syscall($OS2_IOCtl, $parmblock, $zero, 0x63, 9, $numhandle); |
62 | ($x, $cylinders, $heads, $sect) = unpack("SSSS", $parmblock); |
63 | print "Hard drive #$i:\n"; |
64 | print " cylinders: $cylinders\n"; |
65 | print " heads: $heads\n"; |
66 | print " sect/trk: $sect\n"; |
67 | syscall($OS2_PhysicalDisk, 3, 0, 0, $handle, 2); |
68 | } |
69 | |
70 | # I won't bother with the other stuff. You get the idea. |
71 | |