home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 8 Other / 08-Other.zip / S12114.ZIP / OS2LANGS.TXT
Text File  |  1988-11-10  |  26KB  |  1,043 lines
  1. Figure 1:  An OS/2 Rosetta Stone
  2.  
  3.  
  4. In C (using Microsoft C 5.1):
  5.  
  6. /* from bsedos.h */
  7. USHORT APIENTRY DosGetModName(HMODULE, USHORT, PCHAR);
  8.  
  9. /* enumdll.c */
  10. #include <stdio.h>
  11.  
  12. #define INCL_DOSMODULEMGR
  13. #include "os2.h"
  14.  
  15. main()
  16. {
  17.     char buf[128];
  18.     register unsigned int i;
  19.     
  20.     for (i=0; i<=0xFFFF; i++)
  21.         if (! DosGetModName(i, 128, buf))
  22.             printf("%u\t%s\n", i, buf);
  23. }
  24.  
  25.  
  26. In Forth (using Laboratory Microsystems 80286 UR/Forth 1.1 for OS/2):
  27.  
  28. \ no header files
  29.  
  30. CREATE BUF 128 ALLOT                    \ create a buffer
  31.  
  32. : ENUMDLL                               \ define a new word
  33.     65535 0 DO                          \ for i=0 to 65535 do
  34.         I 128 DS0 BUF DOSGETMODNAME     \ DosGetModName(i,128,ds:buf)
  35.         0= IF                           \ if no error
  36.             CR                          \ carriage return
  37.             I 5 U.R 3 SPACES            \ display i nicely
  38.             BUF -ASCIIZ COUNT TYPE      \ convert ASCII string and print it
  39.         THEN
  40.     LOOP ;
  41.  
  42. ENUMDLL                                 \ invoke the word
  43.  
  44.  
  45. In Lisp (using OS2XLISP, version 1.10):
  46.  
  47. ; no header files
  48.  
  49. (define doscalls (loadmodule "DOSCALLS"))
  50. (define dosgetmodname (getprocaddr doscalls "DOSGETMODNAME"))
  51. (define buf (make-string 32 128))           ; string of 128 spaces
  52.  
  53. (dotimes
  54.     (i #xFFFF)
  55.     (if (zerop (call dosgetmodname (word i) (word 128) buf))
  56.     ; then
  57.         (format stdout "~A\t~A\n" i buf)))
  58.  
  59.  
  60. In Modula-2 (using Stony Brook Software Modula-2 for OS/2):
  61.  
  62. (* from doscalls.def *)
  63. PROCEDURE DosGetModName ['DOSGETMODNAME'] (
  64.     ModuleHandle    : CARDINAL; (* the module handle to get name for *)
  65.     BufferLength    : CARDINAL; (* the length of the output buffer *)
  66.     Buffer          : Asciiz    (* the address of output buffer *)
  67.     ) : CARDINAL;
  68.  
  69. (* enumdll.mod *)        
  70. MODULE ENUMDLL;
  71.  
  72. FROM SYSTEM IMPORT ADR;
  73.  
  74. FROM InOut IMPORT Write, WriteLn, WriteString, WriteInt;
  75.  
  76. IMPORT DosCalls;
  77.  
  78. VAR
  79.     i : CARDINAL;
  80.     buf : ARRAY [0..128] OF CHAR;
  81.  
  82. BEGIN
  83.     FOR i := 0 TO 65535 DO
  84.         IF DosCalls.DosGetModName(i, 128, ADR(buf)) = 0 THEN
  85.             WriteInt(i, 5); Write(CHAR(9)); WriteString(buf); WriteLn;
  86.         END
  87.     END;
  88.  
  89. END ENUMDLL.
  90.  
  91.  
  92. In BASIC (using Microsoft BASIC Compiler 6.0):
  93.  
  94. ' enumdll.bas
  95. ' compile with /d so you can Ctrl-Break
  96.  
  97. ' from bsedospe.bi
  98. DECLARE FUNCTION DosGetModName%( _
  99.         BYVAL P1 AS INTEGER,_
  100.         BYVAL P2 AS INTEGER,_
  101.         BYVAL P3s AS INTEGER,_ 
  102.         BYVAL P3o AS INTEGER)
  103.  
  104. ' include file for Program Execution Support
  105. REM $INCLUDE: 'bsedospe.bi'
  106.  
  107. buf$ = SPACE$(128)
  108.  
  109. FOR i% = 0 TO 32765                 ' only signed integers available
  110.     Result = DosGetModName%(i%, 128, VARSEG(buf$), SADD(buf$))
  111.     IF Result = 0 THEN
  112.         PRINT i%, RTRIM$(buf$)
  113.         buf$ = SPACE$(128)          ' have to reset buffer, because
  114.     END IF                          ' BASIC doesn't know about ASCIIZ 
  115. NEXT i%
  116.  
  117.  
  118.  
  119. sample output:
  120.  
  121.         140     A:\HARDERR.EXE
  122.         220     D:\OS2\DLL\BMSCALLS.DLL
  123.         380     D:\OS2\SYS\SHELL.EXE
  124.         630     A:\SWAPPER.EXE
  125.         750     D:\OS2\DLL\BKSCALLS.DLL
  126.         930     D:\OS2\DLL\ANSICALL.DLL
  127.         1210    D:\OS2\DLL\EPS-LIB.DLL
  128.         1230    D:\OS2\DLL\MOUCALLS.DLL
  129.         1240    D:\OS2\DLL\QUECALLS.DLL
  130.         1330    D:\OS2\DLL\SESMGR.DLL
  131.         1340    D:\OS2\DLL\BVSCALLS.DLL
  132.         1380    D:\OS2\DLL\VIOCALLS.DLL
  133.         1390    D:\OS2\DLL\KBDCALLS.DLL
  134.         1480    D:\OS2\DLL\DOSCALL1.DLL
  135.         1490    D:\OS2\DLL\NLS.DLL
  136.         1550    D:\OS2\DLL\MSG.DLL
  137.         1590    D:\OS2\E\EPSILON.EXE
  138.         2240    D:\OS2\DLL\MONCALLS.DLL
  139.         2320    D:\URFOS2\FORTH.EXE
  140.         2960    D:\OS2\DLL\CRTLIB.DLL
  141.         2980    E:\XLISP\NEW\OS2XLISP.EXE
  142.         3190    D:\OS2\DLL\ALIAS.DLL
  143.         3630    D:\OS2\SYS\CMD.EXE
  144.  
  145.  
  146.  
  147.  
  148. Figure 2
  149.  
  150. A better Forth implementation of the Rosetta Stone Program
  151.  
  152.  
  153. FORGET ENUMDLL      \ get rid of previous definition
  154. CREATE BUF 128 ALLOT
  155. : MODULE? ( n -- flag )   128 DS0 BUF DOSGETMODNAME 0= ;
  156. : .ASCIIZ ( addr -- )   -ASCIIZ COUNT TYPE ;
  157. : .MODULE ( n -- )   CR   5 U.R   3 SPACES   BUF .ASCIIZ ;
  158. : ENUMDLL ( -- )   65535 0 DO I MODULE? IF I .MODULE THEN LOOP ;
  159.  
  160.  
  161.  
  162.  
  163. Figure 3
  164.  
  165. Code listing for threads.4th
  166.  
  167. \ threads.4th
  168. \ Andrew Schulman 23-July-1988
  169. \ revised 27-July: using GETNUM from input stream, not stack
  170. \ revised 3-August: using new TASKER.BIN (08-02-88)
  171.  
  172. TASKER
  173.  
  174. \ ============================================================
  175. \ note that each thread has its own view of the LDT
  176. VARIABLE GIS   VARIABLE LIS
  177. DS0 GIS DS0 LIS DOSGETINFOSEG DROP
  178.  
  179. : SELF ( -- thread# of current thread )   LIS @ 6 @L ;
  180.  
  181. : CHAR ( n -- char )   DUP 9 > IF 55 ELSE 48 THEN + ;
  182.  
  183. \ ============================================================
  184. \ stolen from os2demo.scr
  185. VARIABLE SEED
  186. : (RAND)   SEED @ 259 * 3 + 32767 AND DUP SEED ! ;
  187. : RANDOM   (RAND) 32767 */ ;
  188.  
  189. : RY ( -- y ) ?YMAX 1+ RANDOM ;
  190. : RX ( -- x ) SELF 4 MOD 20 * 20 + RANDOM SELF 4 MOD 20 * MAX;
  191.  
  192. \ ============================================================
  193. \ use UR/F semaphores, instead of directly calling OS/2
  194. SEMAPHORE SEM   
  195.  
  196. VARIABLE ID
  197. VARIABLE ATTR   12 ATTR !
  198.  
  199. \ display thread ID -- multiple threads will execute through
  200. \ this same code if the semaphore is removed, you can see
  201. \ each thread grab wrong thread id#
  202. : SHOW-ID ( -- )
  203.     BEGIN
  204.         SEM SGET
  205.         SELF CHAR ID !
  206.         \ use VioWrtCharStrAtt because it is properly 
  207.         \ reentrant and also does not screw with the cursor
  208.         \ position
  209.         DS0 ID   1   RY   RX   DS0 ATTR   0 VIOWRTCHARSTRATT   DROP
  210.         SEM SREL
  211.         PAUSE
  212.     AGAIN ;
  213.  
  214. \ ============================================================
  215. \ simulate the cobegin-coend construct, so all threads 
  216. \ start together
  217. : COBEGIN ( -- )   DOSENTERCRITSEC DROP ;
  218. : COEND ( -- )     DOSEXITCRITSEC DROP ;
  219.  
  220. \ ============================================================
  221. 2048 128 TCB THREAD1
  222. 2048 128 TCB THREAD2
  223. 2048 128 TCB THREAD3
  224. 2048 128 TCB THREAD4
  225.  
  226. : (START) ( tcb -- )   DUP START SHOW-ID WAKE ;
  227.  
  228. : START-IT ( -- )
  229.     COBEGIN
  230.         THREAD1 (START)
  231.         THREAD2 (START)
  232.         THREAD3 (START) 
  233.         THREAD4 (START)
  234.     COEND ;
  235.  
  236. \ ============================================================
  237. \ important to not stop thread while it's holding the semaphore
  238. : (STOP) ( tcb -- )
  239.    SEM SGET
  240.    STOP 
  241.    SEM SREL ;
  242.  
  243. : STOP-IT ( -- )
  244.     THREAD1 (STOP)
  245.     THREAD2 (STOP)
  246.     THREAD3 (STOP) 
  247.     THREAD4 (STOP) ;
  248.  
  249. \ ============================================================
  250. \ get a number from input stream, put on stack
  251. : GETNUM ( -- n )   BL WORD NUMBER? 2DROP ;
  252.  
  253. \ ============================================================
  254. \ UR/F tasks are OS/2 threads, so we can manipulate a task
  255. \ using OS/2 calls
  256.  
  257. \ important to claim semaphore, so we don't suspend a thread
  258. \ while it's holding on to the semaphore !
  259. : SUSPEND ( -- )   GETNUM SEM SGET DOSSUSPENDTHREAD SEM SREL DROP ;
  260. : RESUME ( -- )    GETNUM DOSRESUMETHREAD DROP ;
  261.  
  262. \ if entered from keyboard, suspend/resume all background
  263. \ tasks
  264. : CRIT ( -- )      DOSENTERCRITSEC DROP ;
  265. : XCRIT ( -- )     DOSEXITCRITSEC DROP ;
  266.  
  267. \ if entered from keyboard, also suspend/resume all
  268. \ background tasks
  269. : GETSEM ( -- )    SEM SGET ;
  270. : RELSEM ( -- )    SEM SREL ;
  271.  
  272. \ ============================================================
  273. VARIABLE PRTY
  274.  
  275. : GET-PRTY ( -- )   2 DS0 PRTY GETNUM DOSGETPRTY DROP PRTY @ . ;
  276.  
  277. : SET-IDLE ( -- )  2 1 0 GETNUM DOSSETPRTY DROP ;
  278. : SET-REG ( -- )   2 2 0 GETNUM DOSSETPRTY DROP ;
  279.  
  280. \ warning:  if you set a background thread to time-critical
  281. \ from the keyboard, you never get the keyboard back!
  282.  
  283. \ ============================================================
  284. : HELP ( -- )
  285.     CR ." Commands:" CR
  286.     ." HELP" CR
  287.     ." CRIT" CR
  288.     ." XCRIT" CR
  289.     ." GETSEM" CR
  290.     ." RELSEM" CR
  291.     ." SUSPEND <thread #>" CR
  292.     ." RESUME <thread #>" CR
  293.     ." GET-PRTY <thread #>" CR
  294.     ." SET-IDLE <thread #>" CR
  295.     ." SET-REG <thread #>" CR 
  296.     ." STOP-IT" CR ;
  297.  
  298. \ ============================================================
  299. CLS
  300. START-IT
  301. THREAD1 (STOP)        \ leave room for typing in commands
  302. PAUSE
  303. CLS
  304. HELP
  305.  
  306.  
  307.  
  308.  
  309. Figure 4
  310.  
  311. Code listing for xy.4th
  312.  
  313. \ xy.4th for UR/Forth
  314. \ get current cursor location, by programming the 6845 CRTC
  315.  
  316. 80 CONSTANT COLUMNS
  317.  
  318. HEX
  319. : CUR-LOC  ( -- reg14 reg15 )  E 3D4 PC!  3D5 PC@  F 3D4 PC!  3D5 PC@ ;
  320. : MK-WORD  ( w1 w2 -- w )  SWAP FF * + ;
  321. : COL-ROW  ( w -- x y )    DUP  COLUMNS MOD 1+  SWAP  COLUMNS / 1+ ;
  322. : CURS  CUR-LOC  MK-WORD  COL-ROW ;
  323. DECIMAL
  324.  
  325.  
  326.  
  327.  
  328. Figure 5
  329.  
  330. Dynamically linking to a DLL from OS2XLISP
  331.  
  332. ; chat.lsp
  333. ; Run-time dynamic linking to CHATLIB.DLL from OS2XLISP
  334.  
  335. (define chatlib (loadmodule "CHATLIB"))
  336. (define login (getprocaddr chatlib "LOGIN"))
  337. (define get-msg-cnt (getprocaddr chatlib "GET_MSG_CNT"))
  338. (define my-id (call login))
  339. (define msg-cnt (call get-msg-cnt (word my-id)))
  340.  
  341.  
  342.  
  343.  
  344. Figure 6
  345.  
  346. Code listing for makecall.lsp
  347.  
  348. ; makecall.lsp
  349. ; use Lisp symbolic manipulation 
  350. ; to create OS/2 API functions
  351. ; "I would rather write code to write code, than write code"
  352. ; Andrew Schulman 2-August-1988
  353.  
  354. ; filter sets up formal argument list to be passed to (define)
  355. (define (filter list &aux (lst (list nil)) elem)
  356.     (dotimes
  357.         ; for each element in list
  358.         (i (length list))
  359.         (setf elem (nth i list))
  360.         ; if it's a list, like (word freq)
  361.         (if (listp elem)
  362.             ; if it's not a retval directive, like 'word
  363.             (if (not (eq 'QUOTE (car elem)))
  364.                 (nconc lst (list (cadr elem))))
  365.         ;else
  366.             (nconc lst (list elem))))
  367.     (cdr lst))
  368.  
  369. (defmacro make-call (module func &rest args)
  370.     `(define ,(append (list func) (filter args))
  371.         (call
  372.             ,(getprocaddr
  373.                 (eval module)
  374.                 (if (eq module 'CRTLIB)
  375.                     (strcat "_" (string-downcase (symbol-name func)))
  376.                     (symbol-name func)))
  377.             ,@args)))
  378.  
  379. ; e.g.:
  380. ;       (make-call doscalls dosbeep (word freq) (word dur))
  381. ; produces:
  382. ;       (define (dosbeep freq dur)
  383. ;           (call <procaddr> (word freq) (word dur)))
  384. ; can then be called:
  385. ;       (dosbeep 880 100)
  386.  
  387.  
  388.  
  389.  
  390. Figure 7
  391.  
  392. Source code listing for segs.lsp
  393.  
  394. ; SEGS.LSP
  395. ; for OS2XLISP
  396. ; to examine OS/2 memory segments
  397. ; Andrew Schulman 2-August 1988
  398.  
  399. ; requested protection level of seg
  400. (defmacro rpl (x) `(logand ,x 3))
  401.         
  402. ; in LDT or GDT?
  403. (defmacro global? (x) `(zerop (logand ,x 4)))
  404.         
  405. ; does LAR represent accessed segment?
  406. (defmacro accessed? (x) `(= 1 (logand ,x 1)))
  407.  
  408. ; does LAR represent present segment?
  409. (defmacro present? (x) `(= 128 (logand ,x 128)))
  410.                 
  411. ; does LAR represent code segment?
  412. (defmacro code? (x) `(= 8 (logand ,x 8)))
  413.         
  414. ; does LAR represent call gate?
  415. (defmacro call-gate? (x) `(= #xE4 ,x))
  416.  
  417. ; does LAR represent readable code?
  418. (defmacro read? (x)
  419.     `(and
  420.         (code? ,x)
  421.         (= 2 (logand ,x 2))))
  422.                     
  423. ; does LAR represent writable data?
  424. (defmacro write? (x)
  425.     `(and
  426.         (not (code? ,x))
  427.         (= 2 (logand ,x 2))))
  428.  
  429. (define (enumsegs func)
  430.     (dotimes
  431.         ; for each possible segment....
  432.         (i #xFFFF)
  433.         ; if there's really a segment there....
  434.         (if (not (zerop (lar i)))
  435.             ; call the callback function,
  436.             ; passing it the segment number,
  437.             ; its access rights (LAR), and 
  438.             ; its size (LSL, remembering to
  439.             ; add 1 because LSL is zero-based)
  440.             (apply func (list i (lar i) (1+ (lsl i)))))))
  441.  
  442. ; this is a callback function, passed to (enumsegs) by (print-segs) below
  443. (define (show-seg seg seglar segsize)
  444.     (if (< (rpl seg) 3)
  445.         (format stdout "~A\n" seg)
  446.     ; only show details for one of the 
  447.     ; four identical segments
  448.         (progn
  449.             (format stdout "~A\t~A\t~A\t"
  450.                 ; print segment/selector number
  451.                 seg
  452.                 ; print whether global (GDT) or local (LDT)
  453.                 (if (global? seg)
  454.                     "GDT"
  455.                     "LDT")
  456.                 ; print what it is:  data, code, 
  457.                 ; or call gate
  458.                 (cond
  459.                     ((call-gate? seglar)
  460.                         "CALL GATE")
  461.                     ((code? seglar)
  462.                         (if (read? seglar)
  463.                             "READABLE CODE"
  464.                             "EXECUTE-ONLY CODE"))
  465.                     (t
  466.                         (if (write? seglar)
  467.                             "WRITABLE DATA"
  468.                             "READ-ONLY DATA"))))
  469.             ; if not a call gate, print its size
  470.             (if (not (call-gate? seglar))
  471.                 (format stdout "~A ~A"
  472.                     segsize
  473.                     (if (= 1 segsize) "byte" "bytes")))
  474.             ; if segment not present in memory, say so
  475.             (if (not (present? seglar))
  476.                 (format stdout " (not present)"))
  477.             ; print ruler at the bottom
  478.             (format stdout "\n~A\n" (make-string #\. 70)))))
  479.                 
  480. (define (print-segs)
  481.     (enumsegs #'show-seg))
  482.         
  483. ; non-transparent popup, invoke func inside popup, 
  484. ; wait for keystroke
  485. (define (popup func)
  486.     (call (getprocaddr viocalls "VIOPOPUP") ^(word 1) 
  487.             (word 0))
  488.     (apply func nil)
  489.     (read-char)
  490.     (call (getprocaddr viocalls "VIOENDPOPUP") (word 0)))
  491.                 
  492. ; takes optional keyword position-independent parameters, 
  493. ; e.g., (total-segs :bkgr t) ; 
  494. ; or (total-segs :bkgr t :pflag nil)
  495. (define (total-segs
  496.         &key (pflag t) (bkgr nil)
  497.         &aux (numsegs 0) (numbytes 0) (gnum 0) 
  498.              (lnum 0) (gbytes 0) (lbytes 0))
  499.     ; if running in background, make idle priority class
  500.     (if bkgr
  501.         (call
  502.             (getprocaddr doscalls "DOSSETPRTY")
  503.             (word 0) (word 1) (word 0) (word (getpid))))
  504.     (enumsegs
  505.         ; pass enumsegs a "nameless" function, 
  506.         ; created with (lambda)
  507.         (lambda (seg seglar segsize)
  508.             ; only do something for one out of the 
  509.             ; four identical segments 
  510.             (if (zerop (rpl seg))
  511.                 (progn
  512.                     (setf
  513.                         numsegs (1+ numsegs)
  514.                         numbytes (+ numbytes segsize))
  515.                     (if (global? seg)
  516.                         (setf
  517.                             gnum (1+ gnum)
  518.                             gbytes (+ gbytes segsize))
  519.                     ; else if local
  520.                         (setf
  521.                             lnum (1+ lnum)
  522.                             lbytes (+ lbytes segsize)))))))
  523.     ; since the operation takes a long time, 
  524.     ; they'll get popup notification when it's done.
  525.     (if bkgr
  526.         (popup 
  527.             (lambda ()
  528.                 (call
  529.                     (getprocaddr doscalls "DOSSETPRTY")
  530.                     (word 0) (word 2) (word 0) 
  531.                     (word (getpid)))
  532.                 (format stdout "OS2XLISP finished computing
  533.                                 TOTAL-SEGS!\n\n")
  534.                 (format stdout "SEGS: ~A\tBYTES: ~A\n\n"
  535.                   numsegs numbytes)
  536.                 (format stdout "Press any key to
  537.                                 continue\n\n"))))
  538.     ; either print out the results, or return them as a list
  539.     (if pflag
  540.         (not
  541.             (format stdout "Segs:  ~A (GDT ~A, LDT
  542.                             ~A)\tBytes: ~A (GDT ~A, LDT
  543.                             ~A)\n"
  544.                 numsegs gnum lnum numbytes gbytes lbytes))
  545.     ; else          
  546.         (list numsegs numbytes gnum gbytes lnum lbytes)))
  547.  
  548.  
  549.  
  550.  
  551.  
  552. Figure 10
  553.  
  554. Source Code listing for the Dining Philosphers
  555.  
  556. MODULE Dining;
  557.  
  558. (*
  559. The Five Dining Philosophers in Modula-2
  560. adapted from M. Ben-Ari, PRINCIPLES OF CONCURRENT PROGRAMMING 
  561. (Prentice-Hall, 1982), p.113
  562.  
  563. This module has no operating system dependencies, but depends 
  564. upon Sem, which has only been implemented for OS/2
  565. *)
  566.  
  567. FROM Processes IMPORT StartProcess;
  568.  
  569. FROM InOut IMPORT WriteString, WriteInt, WriteLn;
  570.  
  571. FROM Sem IMPORT
  572.     CountingSemaphore, P, V, CSInit,
  573.     BinarySemaphore, Request, Clear, BinInit,
  574.     cobegin, coend, self;
  575.  
  576. CONST
  577.     NUM_PHILOSOPHERS = 5;
  578.     NUM_FORKS = NUM_PHILOSOPHERS;
  579. VAR
  580.     fork : ARRAY [1..NUM_FORKS] OF BinarySemaphore;
  581.     room : CountingSemaphore;
  582.     fini : CountingSemaphore;
  583.     i : CARDINAL;
  584.  
  585. MODULE io;
  586. IMPORT
  587.     BinarySemaphore, Request, Clear, BinInit, WriteString, WriteInt, WriteLn;
  588. EXPORT think, eat;
  589. VAR
  590.     (* iosem has no bearing on problem itself; just for
  591.        printing strings *)
  592.     iosem : BinarySemaphore;    
  593.  
  594. PROCEDURE think (p : CARDINAL) ;
  595.     BEGIN
  596.         Request(iosem);
  597.         WriteString('thinking: '); WriteInt(p,1); WriteLn;
  598.         Clear(iosem);
  599.     END think;
  600.  
  601. PROCEDURE eat (p : CARDINAL) ;
  602.     BEGIN
  603.         Request(iosem);
  604.         WriteString('eating: '); WriteInt(p,1); WriteLn;
  605.         Clear(iosem);
  606.     END eat;
  607.  
  608. BEGIN
  609.     (* initialization for internal module *)
  610.     BinInit(iosem);
  611. END io;
  612.  
  613. PROCEDURE philosopher () ;
  614.     VAR
  615.         i : CARDINAL;
  616.         left, right : CARDINAL;
  617.     BEGIN
  618.         (*
  619.             these don't have to be done each time through
  620.             loop, since each philosopher/process has its own
  621.             stack
  622.         *)
  623.         i := self() - 1;
  624.         left := i;
  625.         right := (i MOD NUM_FORKS) + 1;
  626.  
  627.         P(fini);
  628.  
  629.         LOOP
  630.             think(i);
  631.             P(room);
  632.             Request(fork[left]);
  633.             Request(fork[right]);
  634.             eat(i);
  635.             Clear(fork[left]);
  636.             Clear(fork[right]);
  637.             V(room);
  638.         END;
  639.     END philosopher;
  640.  
  641. BEGIN
  642.     CSInit(room, NUM_FORKS - 1);
  643.     CSInit(fini, NUM_PHILOSOPHERS);
  644.  
  645.     FOR i := 1 TO NUM_FORKS DO
  646.         BinInit(fork[i]);
  647.     END;
  648.  
  649.     cobegin();
  650.         FOR i := 1 TO NUM_PHILOSOPHERS DO
  651.             StartProcess(philosopher, 2048);
  652.         END;
  653.     coend();
  654.  
  655.     P(fini);    (* never cleared! *)
  656. END Dining.
  657.  
  658.  
  659. DEFINITION MODULE Sem;
  660.  
  661. TYPE CountingSemaphore;
  662. PROCEDURE P ['P'] (VAR cs : CountingSemaphore);
  663. PROCEDURE V ['V'] (VAR cs : CountingSemaphore);
  664. PROCEDURE CSInit ['CSINIT'] (VAR cs : CountingSemaphore; count : CARDINAL);
  665.  
  666. TYPE BinarySemaphore;
  667. PROCEDURE Request ['REQUEST'] (VAR s : BinarySemaphore);
  668. PROCEDURE Clear ['CLEAR'] (VAR s : BinarySemaphore);
  669. PROCEDURE BinInit ['BININIT'] (VAR s : BinarySemaphore);
  670.  
  671. PROCEDURE cobegin ['COBEGIN'] () ;
  672. PROCEDURE coend ['COEND'] () ;
  673.  
  674. PROCEDURE self ['SELF'] () : CARDINAL ;
  675.     
  676. END Sem.
  677.  
  678.  
  679. IMPLEMENTATION MODULE Sem;
  680.  
  681. (*
  682. contains:
  683.     Counting Semaphores
  684.     Binary Semaphores
  685.     assorted thread-related procedures
  686. *)
  687.  
  688. FROM SYSTEM IMPORT ADDRESS, ADR;
  689.  
  690. FROM Storage IMPORT ALLOCATE;
  691.  
  692. FROM DosCalls IMPORT
  693.     DosSemClear, DosSemSet, DosSemRequest, DosSemWait,
  694.     DosEnterCritSec, DosExitCritSec, DosGetInfoSeg;
  695.  
  696. TYPE CountingSemaphore = POINTER TO
  697.     RECORD
  698.         cs : LONGINT;
  699.         ms : LONGINT;
  700.         count : CARDINAL;
  701.         countsem : ADDRESS;
  702.         mutexsem : ADDRESS;
  703.     END;
  704.  
  705. (*
  706.   note:  P() and V() adapted from Kevin Ruddell, "Using OS/2
  707.   Semaphores to Coordinate Concurrent Threads of Execution,"
  708.   MICROSOFT SYSTEMS JOURNAL, May 1988, Figure 9: "Simulating
  709.   a Counting Semaphore under OS/2," p.26 
  710. *)
  711.  
  712. PROCEDURE P ['P'] (VAR cs : CountingSemaphore);
  713.     VAR blocked : BOOLEAN;
  714.     BEGIN
  715.         blocked := TRUE;
  716.         WHILE blocked DO
  717.             DosSemWait(cs^.countsem, -1);
  718.             DosSemRequest(cs^.mutexsem, -1);
  719.             IF (cs^.count = 0) THEN
  720.                 DosSemSet(cs^.countsem);
  721.             ELSE
  722.                 DEC(cs^.count);
  723.                 blocked := FALSE;
  724.             END;
  725.             DosSemClear(cs^.mutexsem);
  726.         END;
  727.     END P;
  728.  
  729. PROCEDURE V ['V'] (VAR cs : CountingSemaphore);
  730.     BEGIN
  731.         DosSemRequest(cs^.mutexsem, -1);
  732.         INC(cs^.count);
  733.         DosSemClear(cs^.countsem);
  734.         DosSemClear(cs^.mutexsem);
  735.     END V;
  736.  
  737. PROCEDURE CSInit ['CSINIT'] (VAR cs : CountingSemaphore; count : CARDINAL);
  738.     BEGIN
  739.         NEW(cs);
  740.         cs^.cs := 0;
  741.         cs^.ms := 0;
  742.         cs^.count := count;
  743.         cs^.countsem := ADR(cs^.cs);
  744.         cs^.mutexsem := ADR(cs^.ms);
  745.     END CSInit;
  746.  
  747. TYPE BinarySemaphore = POINTER TO
  748.     RECORD
  749.         s : LONGINT;
  750.         sem : ADDRESS;
  751.     END;
  752.  
  753. PROCEDURE Request ['REQUEST'] (VAR s : BinarySemaphore);
  754.     BEGIN
  755.         DosSemRequest(s^.sem, -1);
  756.     END Request;
  757.  
  758. PROCEDURE Clear ['CLEAR'] (VAR s : BinarySemaphore);
  759.     BEGIN
  760.         DosSemClear(s^.sem);
  761.     END Clear;
  762.  
  763. PROCEDURE BinInit ['BININIT'] (VAR s : BinarySemaphore);
  764.     BEGIN
  765.         NEW(s);
  766.         s^.s := 0;
  767.         s^.sem := ADR(s^.s);
  768.     END BinInit;
  769.  
  770. (* simulate the cobegin-coend construct *)
  771. PROCEDURE cobegin ['COBEGIN'] ();
  772.     BEGIN
  773.         DosEnterCritSec();
  774.     END cobegin;
  775.  
  776. PROCEDURE coend ['COEND'] ();
  777.     BEGIN
  778.         DosExitCritSec();
  779.     END coend;
  780.  
  781. MODULE Self;
  782. IMPORT ADDRESS, DosGetInfoSeg;
  783. EXPORT self;
  784. VAR
  785.     A : ADDRESS;
  786.     LocalInfo : POINTER TO ARRAY [0..6] OF CARDINAL;
  787.  
  788. (* return a thread's ID number *)
  789. PROCEDURE self ['SELF'] () : CARDINAL;
  790.     BEGIN
  791.         RETURN LocalInfo^[3];
  792.     END self;
  793.  
  794. BEGIN
  795.     (* module initialization code *)
  796.     DosGetInfoSeg(A.OFFSET, A.SEGMENT);
  797.     A.OFFSET := 0;
  798.     LocalInfo := A;
  799. END Self;
  800.  
  801. END Sem.
  802.  
  803.  
  804. ; SEMAPH.DEF
  805.  
  806. LIBRARY SEM INITINSTANCE
  807. DESCRIPTION 'Counting and Binary Semaphores'
  808. DATA MULTIPLE
  809. EXPORTS
  810.     SEM         ; init
  811.     P
  812.     V
  813.     CSINIT
  814.     REQUEST
  815.     CLEAR
  816.     BININIT
  817.     COBEGIN
  818.     COEND
  819.     SELF
  820.  
  821.  
  822. ; START.ASM -- auto-init entry point
  823.  
  824. EXTRN   SEM:FAR
  825.  
  826.         DOSSEG
  827.         .MODEL large
  828.         .CODE
  829.  
  830. START   PROC FAR
  831.         call SEM
  832.         mov ax,1    ; return success
  833.         ret
  834. START   ENDP
  835.  
  836. END     START
  837.  
  838.  
  839. set m2lib=\os2\mod2\lib
  840.  
  841. m2 sem.def/data:l/thread && m2 sem/data:l/thread
  842. m2 dining/thread
  843.  
  844. ' to make DLL version:
  845. masm start.asm;
  846. link /dosseg start sem junk,sem.dll,,,semaph.def && imblib sem.lib semaph.def
  847. copy sem.dll \os2\dll       'copy to LIBPATH
  848. link dining,dining,,sem;
  849.  
  850. ' to make non-DLL version:
  851. link dining sem,dining;
  852.  
  853.  
  854.  
  855.  
  856.  
  857.  
  858. Figure 12
  859.  
  860.  
  861. ENUMPROC.BAS, a BASIC program that prints out a list of all 
  862. functions exported from a DLL.
  863.  
  864.  
  865. ' enumproc.bas
  866. ' bc /e enumproc; && link enumproc; && enumproc brun60ep
  867.  
  868. if command$ = "" then
  869.     dll$ = "BRUN60EP.DLL"
  870. elseif instr(command$, ".") then
  871.     dll$ = command$
  872. else
  873.     dll$ = command$ + ".DLL"
  874. endif
  875.  
  876. pipe = freefile
  877.  
  878. ' makes it easy to detect end of pipe's output
  879. on error goto closefile
  880.  
  881. foundit = 0
  882.  
  883. open "pipe:exehdr " + dll$ + " 2>nul" as pipe
  884.  
  885. foundfile = 1       ' found EXEHDR
  886.  
  887. ' get rid of initial EXEHDR output
  888. do while instr(buf$, "Exports:") = 0
  889.     line input #pipe, buf$
  890. loop
  891. line input #pipe, buf$
  892.  
  893. foundfile = 2       ' found named DLL
  894.  
  895. print "Routines exported by "; dll$
  896.  
  897. do while 1
  898.     line input #pipe, buf$
  899.     buf$ = mid$(buf$,16)
  900.     procname$ = left$(buf$, instr(buf$, " ") - 1)
  901.     print procname$
  902. loop
  903.  
  904. closefile:
  905.     if foundfile = 0 then
  906.         print "Can't find EXEHDR"
  907.     elseif foundfile = 1 then
  908.         print "Can't find "; dll$
  909.     endif
  910.     close pipe
  911.     system
  912.  
  913.  
  914.  
  915.  
  916.  
  917.  
  918.  
  919. Figure 13
  920.  
  921. Code Listing for PEEKER.BAS
  922.  
  923.  
  924. ' peeker.bas
  925. ' compile with bc peeker.bas /d/e/x; && link peeker;
  926.  
  927. on error goto errorhandler
  928.  
  929. do while 1
  930.     input; "seg"; sgm%
  931.     print chr$(9);
  932.     input; "offset"; ofs%
  933.     print chr$(9);
  934.  
  935.     def seg = sgm%
  936.     print peek(ofs%)
  937. loop
  938.  
  939. errorhandler:
  940.     if err = 70 then
  941.         print "Permission denied"
  942.         resume next
  943.     else
  944.         print "Unknown error #"; err
  945.         system
  946.     endif
  947.  
  948.  
  949.  
  950.  
  951.  
  952.  
  953. Figure 14
  954.  
  955. Code Listing For  SMSW.BAS
  956.  
  957.  
  958. ' smsw.bas
  959. ' compile with bc smsw.bas; && link smsw;
  960.  
  961. declare sub DosCreateCSAlias (byval p1%, seg p2%)
  962.  
  963. code$ = _
  964.     chr$(&hc8) + chr$(0) + _
  965.     chr$(0) + chr$(0) + _        ' enter 0,0
  966.     chr$(&h8b) + chr$(&h5e) + _
  967.     chr$(&h06) + _                ' mov bx,word ptr [bp+6]
  968.     chr$(&h0f) + chr$(&h01) + _
  969.     chr$(&h27) + _              ' smsw word ptr [bx]
  970.     chr$(&hc9) + _                ' leave
  971.     chr$(&hca) + chr$(&h02) + chr$(&h00)    ' retf 2
  972.  
  973. DosCreateCSAlias varseg(code$), csalias%
  974. def seg = csalias%
  975. call absolute(x%, sadd(code$))
  976.  
  977. if x% and 2 then
  978.     print "Coprocessor present"
  979. elseif x% and 4 then
  980.     print "No coprocessor -- emulate"
  981. else
  982.     print "Something is very wrong"
  983. endif
  984.  
  985.  
  986.  
  987.  
  988.  
  989.  
  990.  
  991. Figure 15
  992.  
  993. Source Code For SMSW2.BAS and PROTMODE.ASM
  994.  
  995.  
  996. ' smsw2.bas
  997. '
  998. ' To compile and link (all on the same line):
  999. ' bc smsw2.bas; && masm protmode.asm; && link smsw2 
  1000. '  protmode, smsw2;
  1001.  
  1002. declare sub SMSW alias "_SMSW" (x%)
  1003.  
  1004. smsw x%
  1005. if x% and 2 then
  1006.     print "Coprocessor present"
  1007. elseif x% and 4 then
  1008.     print "Using emulator"
  1009. else
  1010.     print "Something is wrong!"
  1011. endif
  1012.  
  1013.  
  1014.  
  1015. ; protmode.asm
  1016. ; requires MASM 5.1
  1017.  
  1018. .model medium,basic
  1019. .286p
  1020. .code
  1021.  
  1022. _smsw   proc far    arg1:near ptr word
  1023.         mov bx,arg1
  1024.         smsw word ptr [bx]
  1025.         ret
  1026. _smsw   endp
  1027.  
  1028. _lsl    proc far    segm:word
  1029.         sub dx,dx
  1030.         sub ax,ax
  1031.         lsl ax,segm
  1032.         ret
  1033. _lsl    endp
  1034.  
  1035. end
  1036.  
  1037.  
  1038.  
  1039.  
  1040.  
  1041.  
  1042.  
  1043.