SYSTEM.LST 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358
  1. Listing:
  2. 1 (* Release 3.10 *)
  3. 2 (*-------------------------------------------------------------------------*
  4. 3 * *
  5. 4 * SYSTEM.MOD - Machine-level support *
  6. 5 * *
  7. 6 * COPYRIGHT (C) 1988..1992 Clarion Software Corporation. *
  8. 7 * All Rights Reserved *
  9. 8 * *
  10. 9 *--------------------------------------------------------------------------*)
  11. 10
  12. 11 (*%F _fdata *)
  13. 12 (*# call(seg_name => null) *)
  14. 13 (*# data(seg_name => null) *)
  15. 14 (*%E *)
  16. 15 (*# module(implementation=>off) *)
  17. 16 (*# call(o_a_copy => off) *)
  18. 17 (*# check(stack=>off,index=>off,range=>off,overflow=>off,nil_ptr=>off) *)
  19. 18
  20. 19 IMPLEMENTATION MODULE SYSTEM;
  21. 20 (*%F _OS2 *)
  22. 21 IMPORT CoreMain;
  23. 22 (*%E *)
  24. 23 (*%T _OS2 *)
  25. 24 IMPORT Lib,Dos,CoreSig,CoreMath;
  26. 25 (*%E *)
  27. 26
  28. 27 (*%F _OS2 *)
  29. 28 PROCEDURE NEWPROCESS(P: PROC; A: FarADDRESS; S: CARDINAL; VAR P1: FarADDRESS); IN CoreProc;
  30. 29 PROCEDURE TRANSFER (VAR P1,P2: FarADDRESS); IN CoreProc;
  31. 30 PROCEDURE IOTRANSFER (VAR P1,P2: FarADDRESS; I: CARDINAL); IN CoreProc;
  32. 31 PROCEDURE CurrentProcess():ADDRESS; IN CoreProc;
  33. 32 PROCEDURE initprocess(); IN CoreProc;
  34. 33 PROCEDURE CurrentPriority() : CARDINAL; IN CoreProc;
  35. 34 PROCEDURE NewPriority(PR: CARDINAL); IN CoreProc;
  36. 35 PROCEDURE Listen(Mask: BITSET); IN CoreProc;
  37. 36 PROCEDURE InterruptRegisters(P: FarADDRESS): FarADDRESS; IN CoreProc;
  38. 37 (*%E *)
  39. 38
  40. 39 (*%T _OS2 *)
  41. 40 CONST
  42. 41 OS2MaxThreads = 64;
  43. 42
  44. 43 VAR
  45. 44 ProcessSem : ARRAY[1..OS2MaxThreads] OF LONGCARD;
  46. ***** ^ not supported yet
  47. ***** ^ undeclared identifier
  48. 45 (* ADR(ProcessSem[T]) is process id and HSEM *)
  49. 46
  50. 47 LaunchSem : LONGCARD; (* Set when launching new process *)
  51. ***** ^ undeclared identifier
  52. 48 LaunchProc : PROC;
  53. ***** ^ undeclared identifier
  54. 49 LI : Dos.PLINFOSEG;
  55. ***** ^ not supported yet
  56. 50
  57. 51
  58. 52 (*# save *)
  59. 53 (*# call(near_call=>off, reg_param=>(), reg_saved=>(di,si,ds,st1,st2)) *)
  60. 54 PROCEDURE Launch; (* Stub to launch new process *)
  61. 55 (* Input LaunchProc *)
  62. 56 VAR
  63. 57 p : Dos.THREAD;
  64. ***** ^ not supported yet
  65. 58 mp : Dos.HSEM;
  66. ***** ^ not supported yet
  67. 59 r : CARDINAL;
  68. 60 BEGIN
  69. 61 mp := FarADR(ProcessSem[LI^.tidCurrent]);
  70. ***** ^ not supported yet
  71. ***** ^ undeclared identifier
  72. ***** ^ not supported yet
  73. ***** ^ not supported yet
  74. ***** ^ not supported yet
  75. 62 p := Dos.THREAD(LaunchProc);
  76. ***** ^ not supported yet
  77. ***** ^ not supported yet
  78. ***** ^ not supported yet
  79. ***** ^ not supported yet
  80. 63 r := Dos.SemSet(mp);
  81. ***** ^ not supported yet
  82. ***** ^ not supported yet
  83. ***** ^ not supported yet
  84. 64 r := Dos.SemClear(FarADR(LaunchSem));
  85. ***** ^ not supported yet
  86. ***** ^ not supported yet
  87. ***** ^ undeclared identifier
  88. ***** ^ not supported yet
  89. 65 r := Dos.SemWait(mp,Dos.SEM_INDEFINITE_WAIT);
  90. ***** ^ not supported yet
  91. ***** ^ not supported yet
  92. ***** ^ not supported yet
  93. ***** ^ not supported yet
  94. ***** ^ not supported yet
  95. 66 p();
  96. ***** ^ not supported yet
  97. ***** ^ not supported yet
  98. 67 Lib.RunTimeError(CoreSig._FatalErrorPos(), 0CDH, Lib.NilStr);
  99. ***** ^ not supported yet
  100. ***** ^ not supported yet
  101. ***** ^ not supported yet
  102. ***** ^ not supported yet
  103. ***** ^ not supported yet
  104. ***** ^ not supported yet
  105. ***** ^ not supported yet
  106. 68 END Launch;
  107. ***** ^ not supported yet
  108. 69 (*#restore *)
  109. 70
  110. 71 PROCEDURE NEWPROCESS(P: PROC; A: FarADDRESS; S: CARDINAL; VAR P1: FarADDRESS);
  111. ***** ^ undeclared identifier
  112. ***** ^ undeclared identifier
  113. ***** ^ undeclared identifier
  114. 72 VAR mp : Dos.HSEM;
  115. ***** ^ not supported yet
  116. 73 r : CARDINAL;
  117. 74 tid : CARDINAL;
  118. 75 BEGIN
  119. 76 (*%T _mthread *)
  120. 77 CoreMath._FloatInitInstance(CARDINAL(LONGCARD(A) >> 16));
  121. ***** ^ not supported yet
  122. ***** ^ not supported yet
  123. ***** ^ undeclared identifier
  124. ***** ^ not supported yet
  125. ***** ^ arithmetic operand must be numeric
  126. 78 INC(CARDINAL(A),S);
  127. ***** ^ undeclared identifier
  128. ***** ^ not supported yet
  129. ***** ^ not supported yet
  130. 79 r := Dos.SemRequest(FarADR(LaunchSem),Dos.SEM_INDEFINITE_WAIT);
  131. ***** ^ not supported yet
  132. ***** ^ not supported yet
  133. ***** ^ undeclared identifier
  134. ***** ^ not supported yet
  135. ***** ^ not supported yet
  136. ***** ^ not supported yet
  137. 80 LaunchProc := P;
  138. ***** ^ not supported yet
  139. ***** ^ not supported yet
  140. 81 IF Dos.CreateThread(Launch,tid,A) # 0 THEN (* Start process *)
  141. ***** ^ not supported yet
  142. ***** ^ not supported yet
  143. ***** ^ not supported yet
  144. ***** ^ not supported yet
  145. 82 Lib.RunTimeError(CoreSig._FatalErrorPos(), 0CAH, Lib.NilStr);
  146. ***** ^ not supported yet
  147. ***** ^ not supported yet
  148. ***** ^ not supported yet
  149. ***** ^ not supported yet
  150. ***** ^ not supported yet
  151. ***** ^ not supported yet
  152. ***** ^ not supported yet
  153. 83 END;
  154. 84 IF tid>OS2MaxThreads THEN
  155. 85 Lib.RunTimeError(CoreSig._FatalErrorPos(), 0CBH, Lib.NilStr);
  156. ***** ^ not supported yet
  157. ***** ^ not supported yet
  158. ***** ^ not supported yet
  159. ***** ^ not supported yet
  160. ***** ^ not supported yet
  161. ***** ^ not supported yet
  162. ***** ^ not supported yet
  163. 86 END;
  164. 87 r := Dos.SemWait(FarADR(LaunchSem),Dos.SEM_INDEFINITE_WAIT);
  165. ***** ^ not supported yet
  166. ***** ^ not supported yet
  167. ***** ^ undeclared identifier
  168. ***** ^ not supported yet
  169. ***** ^ not supported yet
  170. ***** ^ not supported yet
  171. 88 P1 := FarADR(ProcessSem[tid]);
  172. ***** ^ not supported yet
  173. ***** ^ undeclared identifier
  174. ***** ^ not supported yet
  175. ***** ^ not supported yet
  176. 89 (*%E *)
  177. 90 END NEWPROCESS;
  178. ***** ^ not supported yet
  179. 91
  180. 92 PROCEDURE TRANSFER (VAR P1,P2: FarADDRESS);
  181. ***** ^ undeclared identifier
  182. 93 VAR mp,pp : Dos.HSEM;
  183. ***** ^ not supported yet
  184. 94 r : CARDINAL ;
  185. 95 BEGIN
  186. 96 (*%T _mthread *)
  187. 97 pp := P2;
  188. ***** ^ not supported yet
  189. ***** ^ not supported yet
  190. 98 mp := FarADR(ProcessSem[LI^.tidCurrent]);
  191. ***** ^ not supported yet
  192. ***** ^ undeclared identifier
  193. ***** ^ not supported yet
  194. ***** ^ not supported yet
  195. ***** ^ not supported yet
  196. 99 P1 := mp;
  197. ***** ^ not supported yet
  198. ***** ^ not supported yet
  199. 100 r := Dos.SemSet(mp);
  200. ***** ^ not supported yet
  201. ***** ^ not supported yet
  202. ***** ^ not supported yet
  203. 101 r := Dos.SemClear(pp);
  204. ***** ^ not supported yet
  205. ***** ^ not supported yet
  206. ***** ^ not supported yet
  207. 102 r := Dos.SemWait(mp,Dos.SEM_INDEFINITE_WAIT);
  208. ***** ^ not supported yet
  209. ***** ^ not supported yet
  210. ***** ^ not supported yet
  211. ***** ^ not supported yet
  212. ***** ^ not supported yet
  213. 103 (*%E *)
  214. 104 END TRANSFER;
  215. ***** ^ not supported yet
  216. 105
  217. 106 PROCEDURE IOTRANSFER (VAR P1,P2: FarADDRESS; I: CARDINAL);
  218. ***** ^ undeclared identifier
  219. 107 VAR mp,pp : Dos.HSEM;
  220. ***** ^ not supported yet
  221. 108 r : CARDINAL ;
  222. 109 BEGIN
  223. 110 (*%T _mthread *)
  224. 111 IF (I<>8) THEN
  225. 112 Lib.RunTimeError(CoreSig._FatalErrorPos(), 0CCH, Lib.NilStr);
  226. ***** ^ not supported yet
  227. ***** ^ not supported yet
  228. ***** ^ not supported yet
  229. ***** ^ not supported yet
  230. ***** ^ not supported yet
  231. ***** ^ not supported yet
  232. ***** ^ not supported yet
  233. 113 END;
  234. 114 pp := P2;
  235. ***** ^ not supported yet
  236. ***** ^ not supported yet
  237. 115 mp := FarADR(ProcessSem[LI^.tidCurrent]);
  238. ***** ^ not supported yet
  239. ***** ^ undeclared identifier
  240. ***** ^ not supported yet
  241. ***** ^ not supported yet
  242. ***** ^ not supported yet
  243. 116 P1 := mp;
  244. ***** ^ not supported yet
  245. ***** ^ not supported yet
  246. 117 r := Dos.SemSet(mp);
  247. ***** ^ not supported yet
  248. ***** ^ not supported yet
  249. ***** ^ not supported yet
  250. 118 r := Dos.SemClear(pp);
  251. ***** ^ not supported yet
  252. ***** ^ not supported yet
  253. ***** ^ not supported yet
  254. 119 r := Dos.SemWait(mp,20);
  255. ***** ^ not supported yet
  256. ***** ^ not supported yet
  257. ***** ^ not supported yet
  258. ***** ^ not supported yet
  259. 120 P2 := FarADR(ProcessSem[LI^.tidCurrent]);
  260. ***** ^ not supported yet
  261. ***** ^ undeclared identifier
  262. ***** ^ not supported yet
  263. ***** ^ not supported yet
  264. ***** ^ not supported yet
  265. 121 (*%E *)
  266. 122 END IOTRANSFER;
  267. ***** ^ not supported yet
  268. 123
  269. 124
  270. 125 PROCEDURE CurrentProcess() : ADDRESS;
  271. ***** ^ undeclared identifier
  272. 126 BEGIN
  273. 127 RETURN ADR(ProcessSem[LI^.tidCurrent]);
  274. ***** ^ undeclared identifier
  275. ***** ^ not supported yet
  276. ***** ^ not supported yet
  277. ***** ^ not supported yet
  278. 128 END CurrentProcess;
  279. ***** ^ not supported yet
  280. 129
  281. 130 PROCEDURE initprocess();
  282. 131
  283. 132 BEGIN
  284. 133
  285. 134 END initprocess;
  286. ***** ^ not supported yet
  287. 135
  288. 136 PROCEDURE CurrentPriority() : CARDINAL;
  289. 137
  290. 138 TYPE
  291. 139 PrType = RECORD
  292. 140 CASE: BOOLEAN OF
  293. ***** ^ not supported yet
  294. ***** ^ 'POINTER' expected
  295. 141 | TRUE :
  296. 142 var: CARDINAL;
  297. 143 | FALSE :
  298. 144 pl, pc: SHORTCARD;
  299. 145 END;
  300. 146 END;
  301. 147 VAR
  302. 148 Pr: PrType;
  303. 149 BEGIN
  304. 150 Dos.GetPrty(2, Pr.var, 0);
  305. 151 RETURN CARDINAL(Pr.pl);
  306. 152 END CurrentPriority;
  307. 153
  308. 154 PROCEDURE NewPriority(PR: CARDINAL);
  309. 155
  310. 156 BEGIN
  311. 157 Dos.SetPrty(2, 0, PR, 0);
  312. 158 END NewPriority;
  313. 159
  314. 160 PROCEDURE Init;
  315. 161 VAR i,g,l : CARDINAL;
  316. 162 BEGIN
  317. 163 FOR i := 1 TO OS2MaxThreads DO ProcessSem[i] := 0 END;
  318. 164 LI := FarNIL;
  319. 165 IF Lib.ProtectedMode() THEN
  320. 166 Dos.GetInfoSeg(g,l);
  321. 167 LI := [l:0];
  322. 168 END;
  323. 169 END Init;
  324. 170
  325. 171 PROCEDURE Listen(Mask: BITSET);
  326. 172
  327. 173 BEGIN
  328. 174 END Listen;
  329. 175
  330. 176 PROCEDURE InterruptRegisters(P: FarADDRESS): FarADDRESS;
  331. 177
  332. 178 BEGIN
  333. 179 RETURN FarNIL;
  334. 180 END InterruptRegisters;
  335. 181
  336. 182 (*%E*)
  337. 183
  338. 184 VAR
  339. 185 HB: FarADDRESS;
  340. 186
  341. 187 BEGIN
  342. 188 (*%F _OS2 *)
  343. 189 HB := CoreMain._getheapbase();
  344. 190 HeapBase := Seg(HB^);
  345. 191 (*%T _mthread *)
  346. 192 initprocess();
  347. 193 (*%E *)
  348. 194 (*%E *)
  349. 195 (*%T _OS2 *)
  350. 196 Init;
  351. 197 (*%E *)
  352. 198 END SYSTEM.
  353. 199
  354. 153 errors