home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / LOADER.I < prev    next >
Encoding:
Text File  |  1995-04-11  |  55.6 KB  |  3 lines
  1. ⓪ IMPLEMENTATION MODULE Loader;
  2. ⓪ (*$Y+,C-,R-,P-*)
  3. ⓪ 
  4. ⓪ (* V#477 *)
  5. ⓪ (*----------------------------------------------------------------------------
  6. ⓪"25.10.86  TT  Grundversion
  7. ⓪"27.02.87  TT  VarSpc wird beim Start gelöscht.
  8. ⓪"03.03.87  TT  Layout wird endlich überprüft.
  9. ⓪"22.03.87  TT  TermProcs werden nun richtig am Ende des Modlevels aufgerufen.
  10. ⓪"16.05.87  TT  Komplette Umstrukturierung zusammen mit 'ModCtrl'
  11. ⓪"01.07.87  TT  Paths.SearchFile wird verwendet.
  12. ⓪"18.07.87  TT  Proc-Vars Loading/Releasing neu, varRef/Len und code/sourceName
  13. ⓪0werden aus Codefile geholt; ReadMod führt Directory-Search fort,
  14. ⓪0wenn beim Importieren der Modulname nicht stimmt.
  15. ⓪"23.07.87  TT  ExecBody rettet/restauriert SR und SSP
  16. ⓪"11.08.87  TT  DeAllocate korrekt, wenn Fehler bei ReadMod
  17. ⓪"25.08.87  TT  SplitName korigiert.
  18. ⓪"26.08.87  TT  CallModule kann auch gelinkte (TOS) Prg. starten
  19. ⓪"08.09.87  TT  Bei neuem Process wird "parent's basepage" gesetzt
  20. ⓪"17.10.87  TT  LoadModule auch für TOS-Prgs.
  21. ⓪"15.01.88  TT  ReadMod: Erkennt illeg. Layout sofort; FClose, wenn RETURN
  22. ⓪0aus ReadMod wg. 'no memory'.
  23. ⓪0Seltsam. Ich meine, ich hätte diese Fehler schon mal behoben...
  24. ⓪"16.01.88  TT  Kennung/Bit 4 als Flag f. 'procSym' wird erkannt
  25. ⓪"22.01.88  TT  Kein Search bei Call/Load v. Prgs.; beim Laden v. Prgs. wird
  26. ⓪0erste Hälfte der Basepage gerettet und bei Exec zurückkopiert
  27. ⓪"23.01.88  TT  Search wieder drin, Current Dirs/Drv werden bei prgExec gesetzt
  28. ⓪"04.03.88  TT  layout zw. 0 und 15 erlaubt (bisher nur 0).
  29. ⓪"14.05.88  TT  Module mit Namen > 8 Zeichen ausführbar.
  30. ⓪"08.06.88  TT  Gecrunchte Module können gelinkt werden. Nur wenn Exportliste
  31. ⓪0nicht vorhanden ist, gibt's 'ne Fehlermeldung.
  32. ⓪"10.06.88  TT  PRG-Files werden wiedergefunden, wenn geladen.
  33. ⓪"27.06.88  TT  Wenn Modul nicht gefunden, wird wieder richtige Melgung ange-
  34. ⓪0zeigt.
  35. ⓪"30.09.88  TT  ALLOCATE statt SysAlloc bei InitPrgSpace (da sowieso gleich
  36. ⓪0wieder freigegeben).
  37. ⓪"05.11.88  TT  Release nun im Loader über Proc-Var implementiert
  38. ⓪"10.12.88  TT  Pexec geändert, damit mit MOSLink lauffähig
  39. ⓪"20.12.88  TT  Pexec korrigiert: Speicher wird wieder freigegeben
  40. ⓪"01.01.89  TT  Infinite loop bei PrepareExec & release0 behoben (zirk. Importe)
  41. ⓪"17.02.89  TT  Nicht geladene, gelinkte Prgs liefern wieder korrekten Exitcode
  42. ⓪"12.06.89  TT  zirkulare Importe werden im Loader automatisch gelöst, Freigabe
  43. ⓪0nun auch schneller.
  44. ⓪"04.07.89  TT  Release nochmals überarbeitet und korrigiert
  45. ⓪0>>> Freigabe zusammen mit MODCtrl/MODBase in MAUS M & MS.
  46. ⓪"04.07.89  TT  Bei geladenen Prgs wird DATA-Bereich erst beim Starten kopiert.
  47. ⓪"06.07.89  TT  Importierte Module dürfen Load/CallModule schon aufrufen, bevor
  48. ⓪0Hauptmodul init. ist (um z.B. Treiber nachzuladen). Es gibt
  49. ⓪0übrigens *keine* Probleme, wenn beide Programm dasselbe Modul
  50. ⓪0importieren. Je nach Import-Reihenfolge wird dann das Modul
  51. ⓪0entweder schon im 1. Prozeß init. und bleibt dann auch für den
  52. ⓪02. Prozeß aktiv oder es wird erst im 2. Prozeß init., aber dann
  53. ⓪0wird es dort bei dem Prozeßende auch wieder deinit. und beim
  54. ⓪01. Prozeß wiederum neu initialisiert.
  55. ⓪"20.08.89  TT  Pexec verwendet nun wieder mode 0 -> Modload wiederum anpassen
  56. ⓪"08.09.89  TT  Kein Hänger mehr bei Removals
  57. ⓪"05.11.89  TT  Removals werden nun in korrekter Reihenfolge aufgerufen
  58. ⓪"20.12.89  TT  hahaha! 5.11. war auch nicht OK: Reihenfolge war genau andersrum
  59. ⓪"01.01.90  TT  Ich kapiert gar nix mehr... nun wieder wie am 5.11.
  60. ⓪"31.05.90  TT  Non-reentry-Behandlung fertig
  61. ⓪"16.07.90  TT  Nun werden ALLE importierten Module mit non-reentry initial.;
  62. ⓪0ExecMod räumt Speicher auch bei Fehlern korrekt wieder auf,
  63. ⓪0dadurch geht auch kein Speicher mehr beim Start geladener Prgs
  64. ⓪0verloren.
  65. ⓪"02.10.90  TT  prgExec übergibt Prgname, damit TEMPUS 2.10 nicht abstürzt
  66. ⓪"11.10.90  TT  Neue Real-Codes im Header ausgewertet
  67. ⓪"18.11.90  TT  CallModule: DriverList- und Stacksize-Parms raus. Die sollen
  68. ⓪0später im Modulcode enthalten sein oder von CallModule in
  69. ⓪0einem extra File selbst gesucht werden.
  70. ⓪"26.11.90  TT  ExecMod: "tooManyMods"-Fehler eingeführt (tritt auf, wenn
  71. ⓪0ExecList überläuft)
  72. ⓪"06.12.90  TT  MaxModExec jetzt dynamisch in MOSConfig bestimmbar; IsModule()
  73. ⓪0schließt nun Datei nach Zugriff; Module/Prgs werden nicht mehr
  74. ⓪0anhand von Suffix sondern am Header erkannt.
  75. ⓪"14.12.90  TT  Die Module mit $Y- werden NACH Aufruf aller Envelope-Routinen
  76. ⓪0für den Vater-Prozeß aufgerufen, damit die Envlp-Handler dann
  77. ⓪0noch auf die Vars des Vaters zugreifen können (um z.B. Werte
  78. ⓪0vom Vater an den Sohn zu kopieren - s. GEMEnv).
  79. ⓪"17.12.90  TT  Die Stacksize wird aus dem Modheader übernommen, falls # 0.
  80. ⓪"05.02.91  TT  Pfad wird aus Modulname bei Error-Msgs entfernt (errHandler);
  81. ⓪0"BadLayout"-Fehler kommt, wenn's kein Prg/Modul ist (check-
  82. ⓪0ExecRes).
  83. ⓪"24.02.91  TT  Beim Start von geladenen Prgs wird "p_hitpa" nun korrekt
  84. ⓪0verwaltet, so daß z.B. TEMPUS 2.10 wieder fehlerfrei läuft;
  85. ⓪0DefaultStackSize kann nun jeden Wert annehmen, auch Null.
  86. ⓪"28.02.91  TT  CallModule: Wenn 'arg[0]=CHR(127)', wird kein Längenbyte
  87. ⓪0eingefügt; Geladene Module/Prgs werden freigegeben, sobald der
  88. ⓪0Clienten-Prozeß terminiert und das Modul nicht mit SysAlloc
  89. ⓪0geladen wurde.
  90. ⓪"18.04.91  TT  gesetztes Bit 7 (68020-Code) erzeugt keine Fehlermeldung wg.
  91. ⓪0falscher FPU mehr.
  92. ⓪"15.09.91  MS  Relocate zerstört nicht mehr D3/A4
  93. ⓪"14.02.92  TT  CallSuper statt Supexec
  94. ⓪"23.02.92  TT  Stack wird in "CreateBasePage" alloziert.
  95. ⓪"12.12.93  TT  prgFlags werden bei MM2-Modulen ausgewertet (f. TT-RAM usw.),
  96. ⓪0bei gelinkten, geladenen Prgs vorerst nicht, da hier nicht klar
  97. ⓪0ist, wie das geht.
  98. ⓪"16.01.94  TT  Um das zu eigene Real-Format zu ermitteln, wird nicht mehr
  99. ⓪0FPU() aufgerufen, weil das nicht mit den gelinkten Libs über-
  100. ⓪0einstimmen muß, sondern es wird RealMode abgefragt.
  101. ⓪ *---------------------------------------------------------------------------*)
  102. ⓪ 
  103. ⓪ (* Beim Relozieren Bus/Addr-Error abfangen ! *)
  104. ⓪ 
  105. ⓪ FROM MOSGlobals IMPORT SfxStr, NameStr, PfxStr, MemArea, Overflow, IllegalState;
  106. ⓪ 
  107. ⓪ FROM PrgCtrl IMPORT EnvlpCarrier, SetEnvelope, RemoveEnvelope, TermProcess;
  108. ⓪ 
  109. ⓪ FROM MOSSupport IMPORT CallSuper;
  110. ⓪ 
  111. ⓪ IMPORT SystemError;
  112. ⓪ 
  113. ⓪ FROM SYSTEM IMPORT ASSEMBLER, CADR, ADR, WORD, ADDRESS, TSIZE, LONGWORD, BYTE;
  114. ⓪ 
  115. ⓪ FROM Strings IMPORT Upper, Concat, Length, Pos, Copy, Append, Insert, PosLen,
  116. ⓪4Compare, Relation, Empty, String, Assign, Split, Delete,
  117. ⓪4StrEqual;
  118. ⓪ 
  119. ⓪ FROM Storage IMPORT Inconsistent, SysAlloc, MemAvail, DeAllocate, ALLOCATE;
  120. ⓪ FROM StorBase IMPORT FullStorBaseAccess;
  121. ⓪ 
  122. ⓪ FROM MOSCtrl IMPORT RemovalRoot, RemovalEntry, CallSub, ProcessID, RealMode;
  123. ⓪ 
  124. ⓪ FROM SysTypes IMPORT PtrBP;
  125. ⓪ 
  126. ⓪ FROM ModBase IMPORT CallEnvelopes, ModLst, ModRef, ModStr, ModEntry,
  127. ⓪0GetModRef, Release, ModStates, ModState, SearchDesc,
  128. ⓪0SplitModName, ModLoaded, MarkState, Criterion, PtrBSS,
  129. ⓪0FreeMod, ExecProcess, CreateBasePage, ModHeader;
  130. ⓪ 
  131. ⓪ FROM Lists IMPORT ResetList, NextEntry, AppendEntry, RemoveEntry,
  132. ⓪(FindEntry, List, LDir;
  133. ⓪ 
  134. ⓪ FROM Paths IMPORT SearchFile, ListPos;
  135. ⓪ FROM PathCtrl IMPORT PathList;
  136. ⓪ 
  137. ⓪ FROM MOSConfig IMPORT LoaderMsg, MaxModExec;
  138. ⓪ 
  139. ⓪ FROM Directory IMPORT MakeFullPath;
  140. ⓪ FROM FileNames IMPORT FileSuffix, SplitName, FilePrefix, SplitPath;
  141. ⓪ IMPORT FileNames;
  142. ⓪ 
  143. ⓪ FROM SysInfo IMPORT UseStackFrame, CPU;
  144. ⓪ FROM MOSSupport IMPORT ToSuper, ToUser;
  145. ⓪ IMPORT XBRA;
  146. ⓪ IMPORT Block;
  147. ⓪ 
  148. ⓪ (*
  149. ⓪"FROM Terminal IMPORT WriteLn, WriteString, Read, Write;
  150. ⓪ *)
  151. ⓪ 
  152. ⓪ CONST Trace = FALSE;
  153. ⓪&Trace0 = FALSE; (* Prg Start *)
  154. ⓪&Trace2 = FALSE; (* release *)
  155. ⓪&Trace3 = FALSE; (* init *)
  156. ⓪ 
  157. ⓪ (*$ ? Trace OR Trace0 OR Trace2 OR Trace3:
  158. ⓪"VAR inch: CHAR;
  159. ⓪ *)
  160. ⓪ 
  161. ⓪ CONST
  162. ⓪#MaxModNest = 15;
  163. ⓪'anykey = 0L;        (* Joker fuer Modul-Key *)
  164. ⓪ 
  165. ⓪&Kennung = "MM2L";
  166. ⓪ 
  167. ⓪ TYPE tCallPtr = [0..MaxModNest];
  168. ⓪ 
  169. ⓪ 
  170. ⓪'ExecCondition = (ExecAlways, ExecNever, ExecNew);
  171. ⓪'
  172. ⓪'ArgStr = ARRAY [0..127] OF CHAR;
  173. ⓪&FileStr = ARRAY [0..141] OF CHAR;
  174. ⓪ 
  175. ⓪ VAR
  176. ⓪&CallPtr: tCallPtr;
  177. ⓪$ChainName: ARRAY tCallPtr OF FileStr;
  178. ⓪%ChainArg: ARRAY tCallPtr OF ArgStr;
  179. ⓪ 
  180. ⓪$error, ok: BOOLEAN;
  181. ⓪ 
  182. ⓪&ExecPtr: CARDINAL;
  183. ⓪%ExecList: POINTER TO ARRAY [0..5000] OF ModRef;
  184. ⓪ 
  185. ⓪ (* das geht nun über msr2:
  186. ⓪"PROCEDURE willBeInit (ref0:ModRef):BOOLEAN;
  187. ⓪$(*$L-*)
  188. ⓪$BEGIN
  189. ⓪&ASSEMBLER
  190. ⓪(MOVE.W  ExecPtr,D0
  191. ⓪(MOVE.L  ExecList,A0
  192. ⓪(MOVE.L  -(A3),D1
  193. ⓪(BRA     c
  194. ⓪&l CMP.L   (A0)+,D1
  195. ⓪&c DBEQ    D0,l
  196. ⓪(SEQ     D0
  197. ⓪(ANDI    #1,D0
  198. ⓪(MOVE    D0,(A3)+
  199. ⓪&END
  200. ⓪$END willBeInit;
  201. ⓪$(*$L=*)
  202. ⓪ *)
  203. ⓪ 
  204. ⓪ PROCEDURE markForInit (ref0: ModRef): BOOLEAN;
  205. ⓪"BEGIN
  206. ⓪$(*$ ? Trace3: WriteLn; WriteString (ref0^.codeName^); WriteString (' marked for init.'); *)
  207. ⓪$IF ExecPtr > MaxModExec THEN
  208. ⓪&RETURN FALSE
  209. ⓪$ELSE
  210. ⓪&ExecList^[ExecPtr]:= ref0; inc (ExecPtr);
  211. ⓪&RETURN TRUE
  212. ⓪$END
  213. ⓪"END markForInit;
  214. ⓪ 
  215. ⓪ 
  216. ⓪ VAR enterFailed: BOOLEAN;
  217. ⓪ 
  218. ⓪ PROCEDURE enterMods (open, child: BOOLEAN; VAR exitcode: INTEGER);
  219. ⓪"(* jedes Modul vorbereiten, ggf. VarSpace retten/löschen *)
  220. ⓪"VAR execThis: CARDINAL; ad: PtrBSS;
  221. ⓪"BEGIN
  222. ⓪$IF open & NOT child THEN
  223. ⓪&(* wir sind der letzte Env-Handler *)
  224. ⓪&execThis:= 0;
  225. ⓪&WHILE execThis < ExecPtr DO
  226. ⓪(WITH ExecList^[execThis]^ DO
  227. ⓪*IF ~(initialized IN state) THEN
  228. ⓪,Block.Clear (varRef, varLen)
  229. ⓪*ELSIF ~(reentrant IN state) & ~(installed IN state) THEN
  230. ⓪,(* bei nicht-reentrant-fähigen Modulen wird das alte BSS gerettet
  231. ⓪-* und dann der BSS-Bereich wie üblich gelöscht *)
  232. ⓪,(*$ ? Trace: WriteLn; WriteString (codename^); WriteString (' gets new BSS'); *)
  233. ⓪,ALLOCATE (ad, varLen + 4L);
  234. ⓪,IF ad = NIL THEN
  235. ⓪.enterfailed:= TRUE;
  236. ⓪.exitcode:= -39; (* out of mem *)
  237. ⓪.RETURN
  238. ⓪,END;
  239. ⓪,Block.Copy (varRef, varLen, ADDRESS(ad) + 4L);
  240. ⓪,ad^.prev:= prevBSS;
  241. ⓪,prevBSS:= ad;
  242. ⓪,Block.Clear (varRef, varLen)
  243. ⓪*END;
  244. ⓪(END;
  245. ⓪(INC (execThis);
  246. ⓪&END;
  247. ⓪&enterfailed:= FALSE;
  248. ⓪$END
  249. ⓪"END enterMods;
  250. ⓪ 
  251. ⓪ 
  252. ⓪ PROCEDURE Fopen ( REF fname: ARRAY OF CHAR; mode : Cardinal;
  253. ⓪2VAR handle : Cardinal; VAR ior : Integer ) : Boolean;
  254. ⓪"BEGIN
  255. ⓪$ASSEMBLER
  256. ⓪(MOVE    mode(A6),-(A7)
  257. ⓪(MOVE.L  fname(A6),-(A7)
  258. ⓪(MOVE    #$3D,-(A7)
  259. ⓪(TRAP    #1
  260. ⓪(ADDQ.L  #8,A7
  261. ⓪(CLR     D1
  262. ⓪(TST.L   D0
  263. ⓪(BMI     err
  264. ⓪(MOVE    D0,D1
  265. ⓪(CLR     D0
  266. ⓪"err   MOVE.L  ior(A6),A0
  267. ⓪(MOVE    D0,(A0)
  268. ⓪(MOVE.L  handle(A6),A0
  269. ⓪(MOVE    D1,(A0)
  270. ⓪$END;
  271. ⓪$RETURN ior = 0
  272. ⓪"END Fopen;
  273. ⓪ 
  274. ⓪ PROCEDURE Fseek (handle:Cardinal; n:LongCard; mode:Cardinal; VAR p:Longword);
  275. ⓪"BEGIN
  276. ⓪$ASSEMBLER
  277. ⓪(MOVE    mode(A6),-(A7)
  278. ⓪(MOVE    handle(A6),-(A7)
  279. ⓪(MOVE.L  n(A6),-(A7)
  280. ⓪(MOVE    #$42,-(A7)
  281. ⓪(TRAP    #1
  282. ⓪(ADDA.W  #10,A7
  283. ⓪(MOVE.L  p(A6),A0
  284. ⓪(MOVE.L  D0,(A0)
  285. ⓪$END;
  286. ⓪"END Fseek;
  287. ⓪ 
  288. ⓪ PROCEDURE Fclose (handle:Cardinal);
  289. ⓪"BEGIN
  290. ⓪$ASSEMBLER
  291. ⓪(MOVE    handle(A6),-(A7)
  292. ⓪(MOVE    #$3E,-(A7)
  293. ⓪(TRAP    #1
  294. ⓪(ADDQ.L  #4,A7
  295. ⓪$END
  296. ⓪"END Fclose;
  297. ⓪ 
  298. ⓪ PROCEDURE Fread (handle:Cardinal; p: Address; l:LongInt): LONGINT;
  299. ⓪"VAR res: LONGINT;
  300. ⓪"BEGIN
  301. ⓪$ASSEMBLER
  302. ⓪(MOVE.L  p(A6),-(A7)
  303. ⓪(MOVE.L  l(A6),-(A7)
  304. ⓪(MOVE    handle(A6),-(A7)
  305. ⓪(MOVE    #$3F,-(A7)
  306. ⓪(TRAP    #1
  307. ⓪(ADDA.W  #12,A7
  308. ⓪(MOVE.L  D0,res(A6)
  309. ⓪$END;
  310. ⓪$RETURN res
  311. ⓪"END Fread;
  312. ⓪ 
  313. ⓪ 
  314. ⓪ PROCEDURE ldHead (handle: CARDINAL;
  315. ⓪2VAR mlen: LONGCARD;
  316. ⓪2VAR mid: BYTE;
  317. ⓪2VAR loadres: LoaderResults);
  318. ⓪"VAR chead: RECORD
  319. ⓪/id: ARRAY [0..7] OF CHAR;
  320. ⓪/layout: BYTE;
  321. ⓪/modId: BYTE;
  322. ⓪/res: ARRAY [1..8] OF BYTE;
  323. ⓪/modlen: LONGCARD;
  324. ⓪-END;
  325. ⓪&l: LONGINT; modId2: CARDINAL;
  326. ⓪"BEGIN
  327. ⓪$l:= Fread (handle, ADR (chead), SIZE (chead));
  328. ⓪$IF l < 0L THEN
  329. ⓪&loadres := badFile;
  330. ⓪$ELSE
  331. ⓪&modId2:= ORD (chead.modId) MOD 16;
  332. ⓪&IF (Compare ("MM2Code", chead.id) # equal)
  333. ⓪&OR (ORD(chead.layout)>15)
  334. ⓪&OR ( (modId2#1) & (modId2#2) ) THEN
  335. ⓪(loadres:= badLayout;
  336. ⓪&ELSE
  337. ⓪(loadres:= noError;
  338. ⓪(mlen:= chead.modlen;
  339. ⓪(mid:= chead.modId
  340. ⓪&END
  341. ⓪$END;
  342. ⓪"END ldHead;
  343. ⓪ 
  344. ⓪ 
  345. ⓪ PROCEDURE IsModule ( REF fileName: ARRAY OF CHAR ): BOOLEAN;
  346. ⓪"VAR handle: CARDINAL; ior: INTEGER; r: BOOLEAN; res: LoaderResults;
  347. ⓪&lc: LONGCARD; b: BYTE;
  348. ⓪"BEGIN
  349. ⓪$IF Fopen (fileName,0,handle,ior) THEN
  350. ⓪&ldHead (handle, lc, b, res);
  351. ⓪&r:= res = noError;
  352. ⓪&Fclose (handle)
  353. ⓪$ELSE
  354. ⓪&r:= FALSE
  355. ⓪$END;
  356. ⓪$RETURN r
  357. ⓪"END IsModule;
  358. ⓪ 
  359. ⓪ 
  360. ⓪ PROCEDURE SetChain ( REF ModName, Arg : ARRAY OF Char );
  361. ⓪"(*
  362. ⓪#* Modul fuer Chaining vormerken
  363. ⓪#*)
  364. ⓪"BEGIN
  365. ⓪$Assign (ModName, ChainName [CallPtr],ok);
  366. ⓪$Copy (arg,0,127,ChainArg [CallPtr],ok);
  367. ⓪"END SetChain;
  368. ⓪ 
  369. ⓪ 
  370. ⓪ PROCEDURE prgLoad (REF n:ARRAY OF CHAR): LONGINT;
  371. ⓪"(*$L-*)
  372. ⓪"BEGIN
  373. ⓪$ASSEMBLER
  374. ⓪(CLR.L   -(A7)           ; Environment
  375. ⓪(MOVE.L  A7,-(A7)        ; Cmd-Line: Zeigt auf Leerstring
  376. ⓪(SUBQ.L  #2,A3
  377. ⓪(MOVE.L  -(A3),-(A7)     ; Name des Prg.
  378. ⓪(MOVE    #3,-(A7)        ; Load-Cmd
  379. ⓪(MOVE    #$4B,-(A7)      ; Pexec()
  380. ⓪(TRAP    #1
  381. ⓪(ADDA.W  #16,A7
  382. ⓪(MOVE.L  D0,(A3)+
  383. ⓪$END
  384. ⓪"END prgLoad;
  385. ⓪"(*$L=*)
  386. ⓪ 
  387. ⓪ 
  388. ⓪ PROCEDURE SetMsg (n: CARDINAL; VAR s: ARRAY OF CHAR);
  389. ⓪"BEGIN
  390. ⓪$IF LoaderMsg # NIL THEN
  391. ⓪&Assign (LoaderMsg^[n], s, ok);
  392. ⓪$END
  393. ⓪"END SetMsg;
  394. ⓪ 
  395. ⓪ PROCEDURE checkExecRes (execRes: INTEGER; VAR myRes: LoaderResults;
  396. ⓪9REF name: ARRAY OF CHAR; VAR myMsg: ARRAY OF CHAR);
  397. ⓪"VAR n: CARDINAL;
  398. ⓪"BEGIN
  399. ⓪$IF execRes = 0 THEN
  400. ⓪&myRes:= noError;
  401. ⓪&myMsg[0]:= ''
  402. ⓪$ELSE
  403. ⓪&IF (execRes = -46) OR (execRes = -33) OR (execRes = -34) THEN
  404. ⓪(myRes:= notFound;
  405. ⓪(n:= 11
  406. ⓪&ELSIF (execRes = -39) THEN
  407. ⓪(myRes:= outOfMemory;
  408. ⓪(n:= 6
  409. ⓪&ELSIF (execRes = -66) THEN
  410. ⓪(myRes:= badLayout;
  411. ⓪(n:= 4;
  412. ⓪&ELSE
  413. ⓪(myRes:= badFile;
  414. ⓪(n:= 10
  415. ⓪&END;
  416. ⓪&SetMsg (n, myMsg);
  417. ⓪&IF n = 4 THEN
  418. ⓪(n:= PosLen ('@I',myMsg,0);
  419. ⓪(Delete (myMsg,n,2,ok);
  420. ⓪(Insert (FilePrefix(name),n,myMsg,ok);
  421. ⓪&END
  422. ⓪$END
  423. ⓪"END checkExecRes;
  424. ⓪ 
  425. ⓪ 
  426. ⓪ PROCEDURE MovStr (VAR s:ARRAY OF CHAR;d:Longword);
  427. ⓪"(*$L-*)
  428. ⓪"BEGIN
  429. ⓪$ASSEMBLER
  430. ⓪&MOVE.L  -10(A3),(A3)+
  431. ⓪&MOVE.W  -10(A3),(A3)+
  432. ⓪&JSR     Length
  433. ⓪&MOVE.W  -(A3),D0
  434. ⓪&CMPI    #127,D0
  435. ⓪&BLS     ok0
  436. ⓪&MOVEQ   #127,D0
  437. ⓪$ok0
  438. ⓪&MOVE.L  -(A3),A2
  439. ⓪&SUBQ.L  #2,A3
  440. ⓪&MOVE.L  -(A3),A1
  441. ⓪&MOVE.B  D0,(A2)+
  442. ⓪&BRA     cop
  443. ⓪$clrlp
  444. ⓪&MOVE.B  (A1)+,(A2)+
  445. ⓪$cop
  446. ⓪&DBRA    D0,clrlp
  447. ⓪$END
  448. ⓪"END MovStr;
  449. ⓪"(*$L=*)
  450. ⓪ 
  451. ⓪ 
  452. ⓪ PROCEDURE Mfree (addr: ADDRESS);
  453. ⓪"(*$L-*)
  454. ⓪"BEGIN
  455. ⓪$ASSEMBLER
  456. ⓪(MOVE.L  -(A3),-(A7)
  457. ⓪(MOVE    #$49,-(A7)
  458. ⓪(TRAP    #1
  459. ⓪(ADDQ.L  #6,A7
  460. ⓪$END
  461. ⓪"END Mfree;
  462. ⓪"(*$L=*)
  463. ⓪ 
  464. ⓪ PROCEDURE prgUnload (bp:PtrBP);
  465. ⓪"BEGIN
  466. ⓪$(* nicht DEALLOCATE verwenden, da sonst u.U. Fehler passieren?! *)
  467. ⓪$Mfree (bp^.p_env); (* Environment freigeben *)
  468. ⓪$Mfree (bp)         (* TPA / Prg. *)
  469. ⓪"END prgUnload;
  470. ⓪ 
  471. ⓪ PROCEDURE Mshrink (addr: ADDRESS; newAmount: LONGCARD);
  472. ⓪"(*$L-*)
  473. ⓪"BEGIN
  474. ⓪$ASSEMBLER
  475. ⓪(MOVE.L  -(A3),-(A7)
  476. ⓪(MOVE.L  -(A3),-(A7)
  477. ⓪(CLR.W   -(A7)
  478. ⓪(MOVE    #$4A,-(A7)
  479. ⓪(TRAP    #1
  480. ⓪(ADDA.W  #12,A7
  481. ⓪$END
  482. ⓪"END Mshrink;
  483. ⓪"(*$L=*)
  484. ⓪ 
  485. ⓪ PROCEDURE envLength (env: ADDRESS): LONGCARD;
  486. ⓪"(* Liefert die Länge eines Environment-Strings *)
  487. ⓪"VAR (*$Reg*) p: POINTER TO CHAR;
  488. ⓪"BEGIN
  489. ⓪$p:= env;
  490. ⓪$WHILE p^ # 0C DO
  491. ⓪&REPEAT
  492. ⓪(INC (p)
  493. ⓪&UNTIL p^ = 0C;
  494. ⓪&INC (p)
  495. ⓪$END;
  496. ⓪$RETURN ADDRESS (p) - env + 2
  497. ⓪"END envLength;
  498. ⓪ 
  499. ⓪ PROCEDURE CodeSize (bp: PtrBP): LONGCARD;
  500. ⓪"(* Liefert Länge des statisch belegten Bereichs ohne den Heap-Bonus *)
  501. ⓪"BEGIN
  502. ⓪$WITH bp^ DO RETURN 256 + p_tlen + p_dlen + p_blen END
  503. ⓪"END CodeSize;
  504. ⓪ 
  505. ⓪ PROCEDURE prgPrepare (bp:PtrBP; heap:LONGCARD): BOOLEAN;
  506. ⓪"VAR newlen:LONGCARD; bpsize: LONGCARD;
  507. ⓪"BEGIN
  508. ⓪$(* belegter Speicher (TPA): *)
  509. ⓪$bpsize:= LONGCARD (bp^.p_hitpa) - LONGCARD (bp);
  510. ⓪$(* benötigter Speicher: *)
  511. ⓪$newlen:= CodeSize (bp) + heap;
  512. ⓪$(* Haben wir genug im TPA erhalten? *)
  513. ⓪$IF newlen > bpsize THEN
  514. ⓪&prgUnload (bp);
  515. ⓪&RETURN FALSE
  516. ⓪$END;
  517. ⓪$(* TPA verkleinern *)
  518. ⓪$Mshrink (bp, newlen);
  519. ⓪$bp^.p_hitpa:= ADDRESS (bp) + newlen;
  520. ⓪$RETURN TRUE
  521. ⓪"END prgPrepare;
  522. ⓪ 
  523. ⓪ VAR     CurrentField, CurrentBasePage: ADDRESS;
  524. ⓪(TPAOffset: LONGCARD;
  525. ⓪(GemdosEntry: ADDRESS;
  526. ⓪(StackFrameOffs: SHORTCARD;
  527. ⓪(Carrier: XBRA.Carrier;
  528. ⓪ 
  529. ⓪ PROCEDURE removeGemdosHdler;
  530. ⓪"(*
  531. ⓪#* Trägt den hiesigen GEMDOS-Handler (hdlGemdos) aus.
  532. ⓪#*)
  533. ⓪"(*$L-*)
  534. ⓪"BEGIN
  535. ⓪$ASSEMBLER
  536. ⓪(LEA     Carrier,A2
  537. ⓪(ADDA.W  #12,A2
  538. ⓪(LEA     $84,A0          ; A0: Vektoradr.
  539. ⓪%l: MOVE.L  (A0),A1
  540. ⓪(CMPA.L  A2,A1           ; 'entry' gefunden?
  541. ⓪(BEQ     f
  542. ⓪(CMPI.L  #$58425241,-12(A1) ; Ist dies ein XBRA-Eintrag?
  543. ⓪(BNE     n               ; Nein -> Ende
  544. ⓪(LEA     -4(A1),A0       ; Vorige Vektoradr. nach A0
  545. ⓪(CMPA.L  (A0),A1         ; Vektor zeigt auf sich selbst?
  546. ⓪(BEQ     n
  547. ⓪(BRA     l
  548. ⓪%f: MOVE.L  -4(A1),(A0)     ; Entry.old eintragen
  549. ⓪%n:
  550. ⓪$END;
  551. ⓪"END removeGemdosHdler;
  552. ⓪"(*$L=*)
  553. ⓪ 
  554. ⓪ PROCEDURE hdlGemdos;
  555. ⓪ (*
  556. ⓪!* Diese Funktion hängt im GEMDOS-TRAP-Handler und wartet darauf, daß
  557. ⓪!* das über 'CallProgram' gestartete Programm die 'Mshrink'-Funktion
  558. ⓪!* aufruft. Dann wird daraus die benötigte Heap-Größe ermittelt und
  559. ⓪!* diese Funktion wieder ausgehängt.
  560. ⓪!*)
  561. ⓪"(*$L-*)
  562. ⓪"BEGIN
  563. ⓪$ASSEMBLER
  564. ⓪(BTST.B  #5,(A7)         ; War Supervisormode aktiv ?
  565. ⓪(BNE.B   super           ; Ja, dann stehen Arg. auf SSP
  566. ⓪(MOVE.L  USP,A0
  567. ⓪(CMPI.W  #$4A,(A0)       ; Mshrink - Funktion ?
  568. ⓪(BEQ.B   hdlMshrinkUser
  569. ⓪ dos     ; normale GEMDOS-Funktion ausführen
  570. ⓪(MOVE.L  GemdosEntry,A0
  571. ⓪(MOVE.L  -4(A0),A0
  572. ⓪(JMP     (A0)
  573. ⓪ super   MOVE.W  StackFrameOffs,D0 ; damit es auch mit einer 68010/20/30 geht
  574. ⓪(CMPI.W  #$4A,6(A7,D0.W) ; Mshrink - Funktion ?
  575. ⓪(BNE.B   dos             ; Nein -> GEMDOS aufrufen
  576. ⓪(LEA     6(A7,D0.W),A0   ; Basis d. Argumente nach A0
  577. ⓪ hdlMshrinkUser
  578. ⓪(MOVE.L  4(A0),A1        ; Argument 'addr' von Mshrink (addr, newamount)
  579. ⓪(CMPA.L  CurrentBasePage,A1 ; ist es die TPA des gesuchten Programms?
  580. ⓪(BNE     dos
  581. ⓪(MOVE.L  8(A0),D0        ; 'newamount'-Parm von Mshrink: neue TPA-Größe
  582. ⓪(MOVE.L  D0,D1
  583. ⓪(ADD.L   A1,D0
  584. ⓪(CMP.L   4(A1),D0        ; newamout > p_hitpa (alte TPA-Größe)?
  585. ⓪(BHI     noNewHi         ;  dann ist zu wenig Speicher da
  586. ⓪(MOVE.L  D0,4(A1)        ; p_hitpa in Base Page neu setzen
  587. ⓪ noNewHi
  588. ⓪ (*
  589. ⓪(TST.L   UsedHeapSize
  590. ⓪(BPL     ignore          ; Heap-Größe wurde bereits ermittelt
  591. ⓪(SUB.L   TPAOffset,D1    ; Subtr. die Größe des stat. Bereichs ohne Heap
  592. ⓪(MOVE.L  D1,UsedHeapSize ; Das ist die gesuchte Heap-Größe
  593. ⓪(MOVE.L  CurrentField,A0
  594. ⓪(MOVE.L  D1,PrgEntry.neededHeapSize(A0)
  595. ⓪(CMP.L   PrgEntry.currentHeapSize(A0),D1
  596. ⓪(BCC     ignore
  597. ⓪(MOVE.L  D1,PrgEntry.currentHeapSize(A0)
  598. ⓪ ignore
  599. ⓪ *)
  600. ⓪(; Diese Routine kann nun aus dem GEMDOS-TRAP entfernt werden
  601. ⓪(JSR     removeGemdosHdler
  602. ⓪(BRA     dos     ; Nun lassen wir endlich Mshrink ausführen
  603. ⓪$END
  604. ⓪"END hdlGemdos;
  605. ⓪"(*$L=*)
  606. ⓪ 
  607. ⓪ PROCEDURE prgExec (bp:PtrBP; name: ADDRESS; REF arg: ArgStr;
  608. ⓪3env: ADDRESS; VAR res: INTEGER): BOOLEAN;
  609. ⓪"(*
  610. ⓪#* geladenes, gelinktes Programm starten
  611. ⓪#*)
  612. ⓪ 
  613. ⓪"VAR el, dl: LONGCARD; envcopy, hitpa, data: ADDRESS;
  614. ⓪ 
  615. ⓪"BEGIN
  616. ⓪$dl:= bp^.p_dlen + 128L;  (* Länge des zu rettenden Data/Basepage-Bereichs *)
  617. ⓪$ALLOCATE (data,dl);
  618. ⓪$IF data = NIL THEN
  619. ⓪&RETURN FALSE
  620. ⓪$END;
  621. ⓪$Block.Copy (bp,128,data);
  622. ⓪$Block.Copy (bp^.p_dbase,bp^.p_dlen,data+128L);
  623. ⓪$Block.Clear (bp^.p_bbase, bp^.p_hitpa - bp^.p_bbase);
  624. ⓪ 
  625. ⓪$(* Environment kopieren, da Pexec dies wie so vieles *
  626. ⓪%* beim Nur-Starten fälschlicherweise nicht tut.    *)
  627. ⓪$
  628. ⓪$IF env # 0 THEN
  629. ⓪&el:= envLength (env);
  630. ⓪&ALLOCATE (envcopy, el);
  631. ⓪&IF envcopy = NIL THEN
  632. ⓪(RETURN FALSE
  633. ⓪&END;
  634. ⓪&Block.Copy (env, el, envcopy);
  635. ⓪&bp^.p_env:= envcopy; (* p_env wird am Ende wg. ganzer BP restauriert *)
  636. ⓪$END;
  637. ⓪ 
  638. ⓪$Block.Copy (CADR(arg),128,ADR(bp^.cmdline));
  639. ⓪$(*$?Trace0:Write('4');Read(inch);IF Inconsistent() THEN HALT END;*)
  640. ⓪$ASSEMBLER
  641. ⓪(MOVE.L  bp(A6),A0
  642. ⓪(
  643. ⓪(; Pfade v. Parent übernehmen
  644. ⓪(MOVE.L  ProcessID,A2
  645. ⓪(MOVE.L  (A2),A2
  646. ⓪(MOVE.B  $37(A2),$37(A0) ; Default-Drive
  647. ⓪(MOVEQ   #7,D0           ; 16 Pfade (Bytes-Handles)
  648. ⓪(LEA     $40(A0),A1
  649. ⓪(LEA     $40(A2),A2
  650. ⓪&lll:
  651. ⓪(MOVE.W  (A2)+,(A1)+
  652. ⓪(DBRA    D0,lll
  653. ⓪(
  654. ⓪(; DTA auf Cmdline
  655. ⓪(MOVE.L  A0,A1
  656. ⓪(ADDA.W  #128,A1
  657. ⓪(MOVE.L  A1,PtrBP.p_dta(A0)
  658. ⓪$END;
  659. ⓪ 
  660. ⓪$(* 'hdlGemdos' in TRAP #1 einhängen *)
  661. ⓪$XBRA.Create (Carrier, Kennung, ADDRESS (hdlGemdos), GemdosEntry);
  662. ⓪$XBRA.Install (GemdosEntry, $84);
  663. ⓪ 
  664. ⓪$(* Prozeß starten *)
  665. ⓪$TPAOffset:= CodeSize (bp);
  666. ⓪$CurrentBasePage:= bp;
  667. ⓪$ASSEMBLER
  668. ⓪(; GEMDOS.Pexec (4, filename, bp, env, exitcode);
  669. ⓪(MOVE.L  env(A6),-(A7)   ; unused
  670. ⓪(MOVE.L  bp(A6),-(A7)    ; ^basepage
  671. ⓪(MOVE.L  name(A6),-(A7)  ; unused, f. Kompatibilität: ^path
  672. ⓪(MOVE    #4,-(A7)        ; Exec-Cmd
  673. ⓪(MOVE    #$4B,-(A7)      ; Pexec()
  674. ⓪(TRAP    #1
  675. ⓪(ADDA.W  #16,A7
  676. ⓪(MOVE.L  res(A6),A0
  677. ⓪(MOVE.W  D0,(A0)
  678. ⓪$END;
  679. ⓪$CurrentBasePage:= NIL;
  680. ⓪ 
  681. ⓪$(* 'hdlGemdos' wieder aushängen *)
  682. ⓪$ASSEMBLER
  683. ⓪(PEA     removeGemdosHdler
  684. ⓪(JSR     CallSuper
  685. ⓪(ADDQ.L  #4,A7
  686. ⓪$END;
  687. ⓪$
  688. ⓪$IF env # 0 THEN
  689. ⓪&DEALLOCATE (envcopy, 0)  (* Kopie vom Environment wieder freigeben *)
  690. ⓪$END;
  691. ⓪ 
  692. ⓪$(*$?Trace0:Write('5');Read(inch);IF Inconsistent() THEN HALT END;*)
  693. ⓪$hitpa:= bp^.p_hitpa;
  694. ⓪$Block.Copy (data,128,bp);
  695. ⓪$bp^.p_hitpa:= hitpa;
  696. ⓪$Block.Copy (data+128L,bp^.p_dlen,bp^.p_dbase);
  697. ⓪$DEALLOCATE (data, 0L);
  698. ⓪$RETURN TRUE
  699. ⓪"END prgExec;
  700. ⓪ 
  701. ⓪ (*
  702. ⓪ PROCEDURE tosPrg (VAR mname:ARRAY OF Char): BOOLEAN;
  703. ⓪"VAR sfx: SfxStr; i:CARDINAL;
  704. ⓪"BEGIN
  705. ⓪$sfx:= FileSuffix (mname);
  706. ⓪$IF sfx[0] # 0C THEN
  707. ⓪&Upper (sfx);
  708. ⓪&FOR i:=1 TO NoOfPrgSfx DO
  709. ⓪(IF StrEqual (PrgSfx [i], sfx) THEN
  710. ⓪*RETURN TRUE
  711. ⓪(END
  712. ⓪&END
  713. ⓪$END;
  714. ⓪$RETURN FALSE
  715. ⓪"END tosPrg;
  716. ⓪ *)
  717. ⓪ 
  718. ⓪ MODULE loader0;
  719. ⓪ 
  720. ⓪ IMPORT ASSEMBLER, ExecList, ExecPtr, ModRef, TermProcess, Block,
  721. ⓪'Monitor, ModState, ADDRESS, ModEntry (*, ModUtil2 *),
  722. ⓪'CPU, ToSuper, ToUser;
  723. ⓪ 
  724. ⓪ EXPORT initMods;
  725. ⓪ 
  726. ⓪ PROCEDURE execBody (mod0: ModRef; mon: ADDRESS);
  727. ⓪"(*$L-*)
  728. ⓪"BEGIN
  729. ⓪$ASSEMBLER
  730. ⓪&MOVE.L    -(A3),D0
  731. ⓪&MOVE.L    -(A3),A1
  732. ⓪&MOVEM.L D3-D7/A3-A6,-(A7)
  733. ⓪ 
  734. ⓪&PEA     modReturn(PC)
  735. ⓪ 
  736. ⓪&MOVE.L  ModEntry.header(A1),A1
  737. ⓪&ADDA.L  6(A1),A1     ;Adresse des Rumpfes berechnen
  738. ⓪&PEA     (A1)
  739. ⓪ 
  740. ⓪&TST.L   D0
  741. ⓪&BNE     moncall
  742. ⓪&RTS
  743. ⓪$moncall
  744. ⓪&MOVE.L  D0,A1
  745. ⓪&JMP     (A1)
  746. ⓪&
  747. ⓪$modReturn
  748. ⓪&MOVEM.L (A7)+,D3-D7/A3-A6
  749. ⓪$END
  750. ⓪"END execBody;
  751. ⓪"(*$L=*)
  752. ⓪ 
  753. ⓪ PROCEDURE initMods;
  754. ⓪"VAR execThis: CARDINAL; mod0: ModRef; mon: ADDRESS;
  755. ⓪"BEGIN
  756. ⓪$execThis:= 0;
  757. ⓪$mon:= NIL;
  758. ⓪$WHILE execThis < ExecPtr DO
  759. ⓪&mod0:= ExecList^[execThis];
  760. ⓪&INC (execThis);
  761. ⓪&WITH mod0^ DO
  762. ⓪(IF ~(initialized IN state) THEN
  763. ⓪*INCL (state,initialized);
  764. ⓪*INCL (state,firstcall);
  765. ⓪(END;
  766. ⓪&END;
  767. ⓪&IF execThis = ExecPtr THEN
  768. ⓪(mon:= ADDRESS (Monitor);
  769. ⓪&END;
  770. ⓪&(* ModUtil2.CallBody (mod0); *)
  771. ⓪&execBody (mod0, mon);
  772. ⓪&(* ModUtil2.LeaveBody (mod0); *)
  773. ⓪&EXCL (mod0^.state,firstcall)
  774. ⓪$END;
  775. ⓪"END initMods;
  776. ⓪ 
  777. ⓪ END loader0;
  778. ⓪ 
  779. ⓪ 
  780. ⓪ PROCEDURE outerErrHandler (REF name, clientname: ARRAY OF CHAR;
  781. ⓪;nowImport: BOOLEAN; errtype: LoaderResults;
  782. ⓪;VAR errmsg: ARRAY OF CHAR);
  783. ⓪"PROCEDURE get (idx,n:CARDINAL);
  784. ⓪$BEGIN
  785. ⓪&SetMsg (idx, errmsg);
  786. ⓪&IF n#0 THEN
  787. ⓪(idx:= PosLen ('@I',errmsg,0);
  788. ⓪(Delete (errmsg,idx,2,ok);
  789. ⓪(Insert (FilePrefix(name),idx,errmsg,ok);
  790. ⓪(IF n=2 THEN
  791. ⓪*idx:= PosLen ('@C',errmsg,0);
  792. ⓪*Delete (errmsg,idx,2,ok);
  793. ⓪*Insert (clientname,idx,errmsg,ok);
  794. ⓪(END
  795. ⓪&END
  796. ⓪$END get;
  797. ⓪"BEGIN
  798. ⓪$CASE errtype OF
  799. ⓪&badversion:
  800. ⓪(get (5,2)|
  801. ⓪&BadLayout:
  802. ⓪(get (4,1)|
  803. ⓪&NotFound:
  804. ⓪(IF nowImport THEN
  805. ⓪*get (1,2)
  806. ⓪(ELSE
  807. ⓪*get (0,1)
  808. ⓪(END|
  809. ⓪&BadFile:
  810. ⓪(get (2,1)|
  811. ⓪&BadData:
  812. ⓪(get (3,1)|
  813. ⓪&OutOfMemory:
  814. ⓪(get (6,0)|
  815. ⓪&denied:
  816. ⓪(get (7,1)|
  817. ⓪&initFault:
  818. ⓪(get (12,0)|
  819. ⓪&exitFault:
  820. ⓪(get (13,0)|
  821. ⓪¬Linkable:
  822. ⓪(get (14,1)|
  823. ⓪&wrongRealForm:
  824. ⓪(get (15,1)|
  825. ⓪&wrongFPUType:
  826. ⓪(get (16,1)|
  827. ⓪&tooManyMods:
  828. ⓪(get (17,0)|
  829. ⓪$ELSE HALT
  830. ⓪$END
  831. ⓪"END outerErrHandler;
  832. ⓪ 
  833. ⓪ (*$X+*)
  834. ⓪ PROCEDURE FlushCPUCache ();
  835. ⓪"BEGIN
  836. ⓪$ASSEMBLER
  837. ⓪(JSR     CPU
  838. ⓪(SUBQ.L  #4,A7
  839. ⓪(JSR     ToSuper
  840. ⓪(MOVE.L  -(A3),D0
  841. ⓪(CMPI.L  #68020,D0
  842. ⓪(BCS     ende
  843. ⓪(CMPI.L  #68040,D0
  844. ⓪(BCS     fl30
  845. ⓪(NOP
  846. ⓪(DC.W    $F4F8           ; CPUSHA BC
  847. ⓪(BRA     ende
  848. ⓪"fl30: MOVEC   CACR,D0
  849. ⓪(ORI     #$0808,D0
  850. ⓪(MOVEC   D0,CACR
  851. ⓪"ende: JSR     ToUser
  852. ⓪(ADDQ.L  #4,A7
  853. ⓪$END
  854. ⓪"END FlushCPUCache;
  855. ⓪ (*$X=*)
  856. ⓪ 
  857. ⓪ PROCEDURE ExecMod (REF mainName: ARRAY OF CHAR;  (* Name des gewuenschten Moduls *)
  858. ⓪4exec: ExecCondition;  (* wann ausfuehren? *)
  859. ⓪3Paths: PathList;
  860. ⓪1REF Arg: ArgStr;
  861. ⓪5env: ADDRESS;
  862. ⓪,VAR ExitCode: Integer;
  863. ⓪.VAR ErrMsg: ARRAY OF CHAR;
  864. ⓪-VAR loadres: LoaderResults)
  865. ⓪8: ModRef;         (* vergebener Index *)
  866. ⓪8
  867. ⓪#VAR nowimport: Boolean;
  868. ⓪'clientname: ModStr;
  869. ⓪ 
  870. ⓪"PROCEDURE errHandler (REF name:ARRAY OF CHAR; errtype:loaderresults);
  871. ⓪$BEGIN
  872. ⓪&outerErrHandler (name, clientname, nowImport, errtype, errmsg)
  873. ⓪$END errHandler;
  874. ⓪ 
  875. ⓪"PROCEDURE LinkMod (msname: ARRAY OF Char; (* Name des Moduls *)
  876. ⓪4reqkey: LONGCARD;       (* gewuenschter Key *)
  877. ⓪6exec: ExecCondition;  (* wann ausfuehren? *)
  878. ⓪4client: ModRef)         (* Index des Klienten *)
  879. ⓪:: ModRef;         (* vergebener Index *)
  880. ⓪"
  881. ⓪"(* Laedt das Modul "msname" und liefert dessen Index in der "ModLst"
  882. ⓪#* als Ergebnis.
  883. ⓪#* Der Modulkey "reqkey" wird erwartet und ueberprueft;
  884. ⓪#* Falls ein Fehler beim Relozieren oder Laden auftritt,
  885. ⓪#* wird der benoetigte Speicher freigegeben und als Ergebnis
  886. ⓪#* "NIL" geliefert
  887. ⓪#*)
  888. ⓪$
  889. ⓪$VAR newname: FileStr;
  890. ⓪"
  891. ⓪$PROCEDURE MakeImpList (ref0:ModRef); (* Importliste erstellen *)
  892. ⓪&
  893. ⓪&PROCEDURE getImport (VAR p:ADDRESS; VAR name: ARRAY OF CHAR): BOOLEAN;
  894. ⓪((*$L-*)
  895. ⓪(BEGIN
  896. ⓪*ASSEMBLER
  897. ⓪2MOVE    -(A3),D1
  898. ⓪2MOVE.L  -(A3),A0
  899. ⓪2MOVE.L  -(A3),A2
  900. ⓪2MOVE.L  (A2),A1
  901. ⓪2TST.L   (A1)+           ; KEY
  902. ⓪2BEQ     F
  903. ⓪2; NAMEN HOLEN
  904. ⓪0L MOVE.B  (A1)+,D0
  905. ⓪2CMPI.B  #$FE,D0
  906. ⓪2BCC     E
  907. ⓪2MOVE.B  D0,(A0)+
  908. ⓪2DBRA    D1,L
  909. ⓪2BRA     T
  910. ⓪0E CLR.B   (A0)+
  911. ⓪2BRA     T
  912. ⓪0M MOVE.B  (A1)+,D0
  913. ⓪0T ADDQ.B  #1,D0
  914. ⓪2BNE     M
  915. ⓪2; ENDE DES NAMENS ERREICHT; LISTENENDE SUCHEN
  916. ⓪0q TST     (A1)+
  917. ⓪2BEQ     O
  918. ⓪2ADDQ.L  #4,A1
  919. ⓪2BRA     q
  920. ⓪0O MOVE.L  A1,(A2)
  921. ⓪2MOVE    #1,(A3)+
  922. ⓪2RTS
  923. ⓪0F CLR     (A3)+
  924. ⓪*END
  925. ⓪(END getImport;
  926. ⓪((*$L+*)
  927. ⓪&
  928. ⓪&VAR implist: ADDRESS;
  929. ⓪*name: ModStr;
  930. ⓪*n: CARDINAL;
  931. ⓪*s: SearchDesc;
  932. ⓪*
  933. ⓪&BEGIN (* MakeImpList *)
  934. ⓪(ASSEMBLER
  935. ⓪*MOVE.L  ref0(A6),A0
  936. ⓪*MOVE.L  modref.header(A0),A1
  937. ⓪*MOVE.L  $E(A1),D0
  938. ⓪*ADD.L   A1,D0
  939. ⓪*MOVE.L  D0,modref.imports(A0)
  940. ⓪*MOVE.L  D0,implist(A6)
  941. ⓪(END;
  942. ⓪(n:=0;
  943. ⓪(WHILE getImport (implist,name) DO
  944. ⓪*s.mode:= modName;
  945. ⓪*s.mname:= ADR (name);
  946. ⓪*GetModRef (s,ref0^.imports^[n]);
  947. ⓪*INC (n)
  948. ⓪(END;
  949. ⓪(ref0^.imports^[n]:= NIL
  950. ⓪&END MakeImpList;
  951. ⓪ 
  952. ⓪$PROCEDURE ReadMod (REF fname: ARRAY OF CHAR;
  953. ⓪7VAR mname: ARRAY OF CHAR): ModRef;
  954. ⓪$(*-----------------------------------------------*)
  955. ⓪$(* Laedt ein Modul in den Speicher, ueberprueft das Format
  956. ⓪%* und traegt in die Modul-Liste ein. Reloziert nicht!
  957. ⓪%* Wenn ein Fehler auftritt, wird der benutzte Speicher
  958. ⓪%* freigegeben und als Modul-Index NIL geliefert.
  959. ⓪%* 'fname': Dateiname; 'mname': Modulname, wird ggf. korrgiert.
  960. ⓪%*)
  961. ⓪&
  962. ⓪$
  963. ⓪$TYPE BSET = SET OF [0..7];
  964. ⓪$
  965. ⓪$VAR modad: ADDRESS;
  966. ⓪'maxlen: LongCard;
  967. ⓪&loadlen,
  968. ⓪)cend,
  969. ⓪&headlen,
  970. ⓪'modlen: LongCard;
  971. ⓪'cstart: ADDRESS;
  972. ⓪(cname: POINTER TO ModStr;
  973. ⓪'cname0: ModStr;
  974. ⓪'cname1: ModStr;
  975. ⓪'dummyl,
  976. ⓪)flen: LongCard;
  977. ⓪%foundkey: LONGCARD;
  978. ⓪(found: boolean;
  979. ⓪(modId: BYTE;
  980. ⓪'modId3: BSET;
  981. ⓪%realCode: CARDINAL;
  982. ⓪'handle: Cardinal;
  983. ⓪#searchMode: ListPos;
  984. ⓪*ior: INTEGER;
  985. ⓪(modst: ModRef;
  986. ⓪&reenter: BOOLEAN;
  987. ⓪ 
  988. ⓪$BEGIN (* ReadMod *)
  989. ⓪&(*$ ? Trace: WriteLn; WriteString ('ReadMod: '); WriteString (fname); *)
  990. ⓪&searchMode:= fromStart;
  991. ⓪&IF nowimport THEN
  992. ⓪(Assign (mname, cname1, ok);
  993. ⓪(Upper (cname1);
  994. ⓪&ELSE
  995. ⓪((* Pfad entfernen für evtl. Fehlermeldung *)
  996. ⓪(SplitPath (mname, cname1(*dummy*), mname);
  997. ⓪&END;
  998. ⓪&REPEAT
  999. ⓪(SearchFile (fname,Paths,searchMode,found,newname);
  1000. ⓪(IF ~found THEN
  1001. ⓪*(*$ ? Trace: WriteLn; WriteString ('exit: not found'); *)
  1002. ⓪*loadres:= notfound;
  1003. ⓪*RETURN NIL
  1004. ⓪(END;
  1005. ⓪(searchMode:= fromNext;
  1006. ⓪(
  1007. ⓪(MakeFullPath (newname, ior);
  1008. ⓪(IF ~Fopen (newname,0,handle,ior) THEN
  1009. ⓪*IF (ior = -33) OR (ior = -34) OR (ior = -46) THEN
  1010. ⓪,(*$ ? Trace: WriteLn; WriteString ('exit: not found 2'); *)
  1011. ⓪,loadres:= notfound;
  1012. ⓪*ELSE
  1013. ⓪,(*$ ? Trace: WriteLn; WriteString ('exit: bad file'); *)
  1014. ⓪,loadres:= badFile;
  1015. ⓪*END;
  1016. ⓪*RETURN NIL
  1017. ⓪(END;
  1018. ⓪(
  1019. ⓪(ldHead (handle, modLen, modId, loadres);
  1020. ⓪(IF loadres # noError THEN
  1021. ⓪*Fclose (handle);
  1022. ⓪*RETURN NIL
  1023. ⓪(END;
  1024. ⓪(Fseek (handle,0,2,flen);           (* Get length of file *)
  1025. ⓪(Fseek (handle,8,0,dummyl);         (* Seek hinter "MM2Code" *)
  1026. ⓪(DEC (flen, 8); (* weil erst ab 8. byte geladen wird *)
  1027. ⓪ 
  1028. ⓪(modId3:= BSET (modId);
  1029. ⓪(ASSEMBLER
  1030. ⓪*MOVE.B  modId(A6),D0
  1031. ⓪*LSR.B   #5,D0
  1032. ⓪*ANDI.W  #3,D0
  1033. ⓪*MOVE.W  D0,realCode(A6)
  1034. ⓪(END;
  1035. ⓪ 
  1036. ⓪(IF flen > modlen THEN (* !!! *)
  1037. ⓪*loadlen := flen
  1038. ⓪(ELSE
  1039. ⓪*loadlen := modlen
  1040. ⓪(END;
  1041. ⓪ 
  1042. ⓪(loadLen:= loadLen + TSIZE (ModEntry);
  1043. ⓪ 
  1044. ⓪(SysAlloc (modst, loadlen);
  1045. ⓪(IF modst = NIL THEN
  1046. ⓪*(* ! Eigentlich sollte hier der Fehler noch nicht auftreten, weil
  1047. ⓪+*   noch nicht sicher ist, ob dies überhaupt das richtige File ist.*)
  1048. ⓪*(*$ ? Trace:
  1049. ⓪,WriteLn; WriteString ('exit: no memory');
  1050. ⓪**)
  1051. ⓪*Fclose (handle);
  1052. ⓪*loadres:= outofmemory;
  1053. ⓪*RETURN NIL
  1054. ⓪(END;
  1055. ⓪(
  1056. ⓪(modad:= ADDRESS (modst) + TSIZE (ModEntry);
  1057. ⓪(
  1058. ⓪(IF Fread (handle,modad,flen) <= 0L THEN
  1059. ⓪*(*$ ? Trace:
  1060. ⓪,WriteLn; WriteString ('exit: bad file 3');
  1061. ⓪**)
  1062. ⓪*Fclose (handle);
  1063. ⓪*loadres := badFile;
  1064. ⓪*DeAllocate (modst,0L);
  1065. ⓪*RETURN NIL
  1066. ⓪(END;
  1067. ⓪(
  1068. ⓪(Fclose (handle);
  1069. ⓪(
  1070. ⓪(ASSEMBLER
  1071. ⓪*MOVE.L  modad(A6),A0
  1072. ⓪*MOVE.L  2(A0),foundkey(A6)
  1073. ⓪*MOVE.L  42(A0),D0
  1074. ⓪*MOVE.L  D0,headlen(A6)
  1075. ⓪*ADD.L   A0,D0
  1076. ⓪*MOVE.L  D0,cstart(A6)
  1077. ⓪*MOVE.L  22(A0),cend(A6)
  1078. ⓪*MOVE.L  46(A0),D0     ; Options laden
  1079. ⓪*BTST    #25,D0        ; $Y+? dann ist Modul-Reentry möglich
  1080. ⓪*SNE     D0
  1081. ⓪*ANDI    #1,D0
  1082. ⓪*MOVE    D0,reenter(A6)
  1083. ⓪*MOVE.L  30(A0),D0
  1084. ⓪*ADD.L   A0,D0
  1085. ⓪*MOVE.L  D0,cname(A6)
  1086. ⓪(END;
  1087. ⓪(cname0:=cname^;
  1088. ⓪(Upper (cname0);
  1089. ⓪&UNTIL ~nowimport OR StrEqual (cname0,cname1);
  1090. ⓪&(*$ ? Trace:
  1091. ⓪(WriteLn; WriteString ('read ok');
  1092. ⓪&*)
  1093. ⓪ 
  1094. ⓪&IF realCode # 0 THEN
  1095. ⓪((*
  1096. ⓪)* Falls das Modul Reals benutzt, muß geprüft werden, ob
  1097. ⓪)* die vorhandenen Libs das richtige Format und die richtigen
  1098. ⓪)* Runtime-Calls unterstützt. Da wir auf jeden Fall Runtime
  1099. ⓪)* eingelinkt haben, können wir pauschal davon ausgehen, da0
  1100. ⓪)* zumindest einer der 3 mögl. Real-Modi gesetzt ist (theoretisch
  1101. ⓪)* gäbe es ja noch den Fall, daß keine der gelinkten Libs Reals
  1102. ⓪)* benutzt und daher das Format noch undefiniert wäre).
  1103. ⓪)*)
  1104. ⓪(IF RealMode # realCode THEN
  1105. ⓪*IF (realCode > 1) & (RealMode > 1) THEN
  1106. ⓪,loadres:= wrongFPUType; (* beides IEEE, aber falsche FPU *)
  1107. ⓪*ELSE
  1108. ⓪,loadres:= wrongRealForm; (* IEEE <-> MM2Reals *)
  1109. ⓪*END;
  1110. ⓪*Fclose (handle);
  1111. ⓪*DeAllocate (modst,0L);
  1112. ⓪*RETURN NIL
  1113. ⓪(END;
  1114. ⓪&END;
  1115. ⓪&
  1116. ⓪&Assign (cname^, mname, ok);
  1117. ⓪&
  1118. ⓪&IF (reqkey#anykey) & (reqkey#foundkey) THEN
  1119. ⓪((*$ ? Trace:
  1120. ⓪*WriteLn; WriteString ('exit: bad version');
  1121. ⓪(*)
  1122. ⓪(loadres := badversion;
  1123. ⓪(DeAllocate (modst,0L);
  1124. ⓪(RETURN NIL
  1125. ⓪&END;
  1126. ⓪&
  1127. ⓪&(* Modul in ModLst eintragen *)
  1128. ⓪&
  1129. ⓪&AppendEntry(ModLst,modst,error);
  1130. ⓪&IF error THEN
  1131. ⓪((*$ ? Trace:
  1132. ⓪*WriteLn; WriteString ('exit: no memory 2');
  1133. ⓪(*)
  1134. ⓪(DeAllocate (modst,0L);
  1135. ⓪(loadres:= outofmemory;
  1136. ⓪(RETURN NIL
  1137. ⓪&END;
  1138. ⓪&WITH modst^ DO
  1139. ⓪(codeName:= ADDRESS (cname);
  1140. ⓪(Assign (cname0,codeNameUp,ok);
  1141. ⓪((*SplitPath (newname, filePath, fn); SplitName (fn, fileName, sfx);*)
  1142. ⓪(fileName:= FilePrefix (newname);
  1143. ⓪(header:= modad;
  1144. ⓪(codeStart:= cstart;
  1145. ⓪(codeLen:= cend-headlen;
  1146. ⓪(varRef:= cend+modad;
  1147. ⓪(varLen:= modlen-cend;
  1148. ⓪(state:= ModStates {};
  1149. ⓪(IF 4 IN modId3 THEN INCL (state, procSym) END;
  1150. ⓪(IF reenter THEN INCL (state, reentrant) END;
  1151. ⓪(imports:= NIL;
  1152. ⓪(prevBSS:= NIL;
  1153. ⓪(IF FullStorBaseAccess () THEN
  1154. ⓪*owner:= NIL
  1155. ⓪(ELSE
  1156. ⓪*owner:= ProcessID^
  1157. ⓪(END
  1158. ⓪&END;
  1159. ⓪&Assign (cname^,clientname,ok);
  1160. ⓪&loadres:= noError;
  1161. ⓪&RETURN modst
  1162. ⓪$END ReadMod;
  1163. ⓪$
  1164. ⓪$
  1165. ⓪$PROCEDURE Relocate ( header: Address;
  1166. ⓪8myIndex: ModRef;
  1167. ⓪;exec: ExecCondition): BOOLEAN;
  1168. ⓪$
  1169. ⓪$VAR  Result: Boolean;
  1170. ⓪$
  1171. ⓪$BEGIN
  1172. ⓪&ASSEMBLER
  1173. ⓪,MOVEM.L D3/A4, -(SP)     ; !MS D3/A4 retten
  1174. ⓪,CLR.W   Result(A6)       ;kann nur noch besser werden
  1175. ⓪,MOVE.L  header(A6),A4    ;A4 zeigt auf zu relozierendes Modul
  1176. ⓪,MOVE.L  22(A4),A0
  1177. ⓪,ADDA.L  A4,A0
  1178. ⓪&!RE3  MOVE.L  (A0)+,D0    ;Var/Proc-Liste abarbeiten
  1179. ⓪,BEQ     RE1
  1180. ⓪,MOVE.L  (A0)+,D1
  1181. ⓪,ADD.L   A4,D1
  1182. ⓪&!RE2  MOVE.L  0(A4,D0.L),D2
  1183. ⓪,MOVE.L  D1,0(A4,D0.L)
  1184. ⓪,MOVE.L  D2,D0
  1185. ⓪,BNE     RE2
  1186. ⓪,BRA     RE3
  1187. ⓪,
  1188. ⓪&!RE1  MOVE.L  14(A4),A1   ;A1 zeigt auf Import-Liste
  1189. ⓪,ADDA.L  A4,A1
  1190. ⓪&!RE5  MOVE.L  (A1)+,D0    ;Key des importierten Moduls
  1191. ⓪,BEQ.L   RE4         ;keine IMPORTs mehr
  1192. ⓪,
  1193. ⓪,; wir bereiten den Filenamen vor. Zuerstmal auf den A3 Stack
  1194. ⓪,CLR.W   D1
  1195. ⓪&!RE13 MOVE.B  (A1)+,D2
  1196. ⓪,CMPI.B  #$FE,D2     ;statt BMI, damit auf öäü möglich ist.
  1197. ⓪,BCC     RE12
  1198. ⓪,MOVE.B  D2,(A3)+
  1199. ⓪,ADDQ.W  #1,D1
  1200. ⓪,BRA     RE13
  1201. ⓪&!RE12 ADDQ.B  #1,D2       ;Sync A1
  1202. ⓪,BEQ     RE14
  1203. ⓪,ADDQ.L  #1,A1
  1204. ⓪&!RE14 CLR.B   (A3)+
  1205. ⓪,MOVE.L  A3,D2
  1206. ⓪,BTST    #0,D2
  1207. ⓪,BEQ     nosync
  1208. ⓪,ADDQ    #1,D1
  1209. ⓪,ADDQ.L  #1,A3
  1210. ⓪%nosync ; nun den Kram aufn A7 Stack
  1211. ⓪,MOVE    D1,D2
  1212. ⓪,ADDQ    #1,D2
  1213. ⓪,LSR     #1,D2
  1214. ⓪,SUBQ    #1,D2
  1215. ⓪$trfname MOVE    -(A3),-(A7)
  1216. ⓪,DBRA    D2,trfname
  1217. ⓪,MOVE.L  A7,(A3)+    ;und die Adresse des Strings aufn A3
  1218. ⓪,MOVE.W  D1,(A3)+    ;samt dem High-Wert
  1219. ⓪,
  1220. ⓪,MOVE.L  D0,(A3)+           ;Key
  1221. ⓪,MOVE.W  exec(A6),(A3)+
  1222. ⓪,MOVE.L  myIndex(A6),(A3)+  ;myIndex ist klienten-Index
  1223. ⓪,MOVEM.L D1/A4/A1,-(A7)
  1224. ⓪,MOVE.L  (A6),A0            ;Dynamic Link fuer ProcCall
  1225. ⓪,MOVE.L  (A0),D2
  1226. ⓪,BSR     LinkMod
  1227. ⓪,(*$ ? Trace:
  1228. ⓪.END;
  1229. ⓪0Read (inch);
  1230. ⓪.ASSEMBLER
  1231. ⓪,*)
  1232. ⓪,MOVEM.L (A7)+,D1/A4/A1
  1233. ⓪,ADDQ.W  #1,D1
  1234. ⓪,ADDA.W  D1,A7       ;mname vom Stack runter
  1235. ⓪,MOVE.L  -(A3),D0    ;Index des importierten Moduls
  1236. ⓪,BEQ     BAD         ;da gab's wohl irgendwo einen Fehler
  1237. ⓪,MOVE.L  D0,A2
  1238. ⓪,MOVE.L  ModEntry.header(A2),A2
  1239. ⓪&!RE6  MOVE.W  (A1)+,D0    ;imp. ItemNr
  1240. ⓪,BEQ     RE5
  1241. ⓪,MOVE.L  18(A2),D3   ;Offset zur Exp.liste
  1242. ⓪,BEQ     BAD         ;keine da
  1243. ⓪,ADD.L   A2,D3
  1244. ⓪,MOVE.L  (A1)+,D1    ;importiertes Item
  1245. ⓪,BEQ     RE6
  1246. ⓪,MOVE.L  D3,A0
  1247. ⓪&!RE9  MOVE.W  (A0)+,D2    ;Item in Exportliste suchen
  1248. ⓪,BEQ     BAD
  1249. ⓪,CMP.W   D2,D0
  1250. ⓪,BEQ     RE10
  1251. ⓪,ADDQ.L  #4,A0
  1252. ⓪,BRA     RE9
  1253. ⓪&!RE10 MOVE.L  (A0)+,D2    ;abs. ItemAdr ausrechnen
  1254. ⓪,ADD.L   A2,D2
  1255. ⓪&!RE11 MOVE.L  0(A4,D1.L),D0 ;ItemAdr im Modul nachtragen
  1256. ⓪,MOVE.L  D2,0(A4,D1.L)
  1257. ⓪,MOVE.L  D0,D1
  1258. ⓪,BNE     RE11
  1259. ⓪,BRA     RE6
  1260. ⓪&!RE4  MOVE.W  #1,Result(A6) ;alles klar
  1261. ⓪&!BAD  MOVEM.L (SP)+, D3/A4  ; !MS Register restaurieren
  1262. ⓪&END;
  1263. ⓪&FlushCPUCache ();
  1264. ⓪&RETURN Result
  1265. ⓪$END Relocate;
  1266. ⓪"
  1267. ⓪"PROCEDURE PrepareExec (ref0:ModRef; mustBeDeInit:BOOLEAN): BOOLEAN;
  1268. ⓪$(*
  1269. ⓪%* Bereitet das geladene Modul und ggf. seine zu initialisierenden
  1270. ⓪%* Importe auf ein Init vor.
  1271. ⓪%* mustBeDeInit: "Modul muß deinit. sein, um gestartet werden zu dürfen"
  1272. ⓪%*)
  1273. ⓪$VAR j: POINTER TO ModRef;
  1274. ⓪$BEGIN
  1275. ⓪&WITH ref0^ DO
  1276. ⓪(INCL (state, msr1);
  1277. ⓪(IF ~(initialized IN state)              (* noch nicht init.? *)
  1278. ⓪(OR ~mustBeDeInit & (installed IN state) (* oder installed? *) THEN
  1279. ⓪*(*
  1280. ⓪+* Da das Modul noch nicht init. ist, wird es dafür vorgemerkt.
  1281. ⓪+* Zuvor müssen aber noch seine Importe geprüft werden:
  1282. ⓪+*)
  1283. ⓪*IF imports # NIL THEN
  1284. ⓪,j:= ADDRESS (imports);
  1285. ⓪,LOOP
  1286. ⓪.IF j^=NIL THEN EXIT END;
  1287. ⓪.IF NOT (msr1 IN j^^.state) THEN
  1288. ⓪0IF NOT PrepareExec (j^, TRUE) THEN RETURN FALSE END
  1289. ⓪.END;
  1290. ⓪.INC (j, 4)
  1291. ⓪,END
  1292. ⓪*END;
  1293. ⓪*(*$ ? Trace OR Trace3: WriteLn; WriteString (codename^); WriteString (' will be executed'); *)
  1294. ⓪*IF NOT (msr2 IN ref0^.state) THEN
  1295. ⓪,INCL (ref0^.state, msr2);
  1296. ⓪,IF NOT markForInit (ref0) THEN
  1297. ⓪.loadRes:= tooManyMods;
  1298. ⓪.errHandler (mainName,loadRes);
  1299. ⓪.RETURN FALSE
  1300. ⓪,END;
  1301. ⓪*END
  1302. ⓪(END;
  1303. ⓪&END;
  1304. ⓪&RETURN TRUE
  1305. ⓪$END PrepareExec;
  1306. ⓪"
  1307. ⓪"VAR fname : FileStr;
  1308. ⓪&execRel: ExecCondition;
  1309. ⓪&ref0: ModRef;
  1310. ⓪&basepage: PtrBP;
  1311. ⓪&ior: INTEGER;
  1312. ⓪&ploadres: LONGINT;
  1313. ⓪&found: BOOLEAN;
  1314. ⓪&fn: NameStr;
  1315. ⓪&sfx: ARRAY [0..2] OF CHAR;
  1316. ⓪ 
  1317. ⓪"PROCEDURE prgInstall (): BOOLEAN;
  1318. ⓪$VAR err: BOOLEAN;
  1319. ⓪$BEGIN
  1320. ⓪&SysAlloc (ref0,TSIZE (ModEntry));
  1321. ⓪&IF ref0 # NIL THEN
  1322. ⓪(Block.Clear (ref0,SIZE(ref0^));
  1323. ⓪(AppendEntry(ModLst,ref0,err);
  1324. ⓪&ELSE
  1325. ⓪(err:= TRUE;
  1326. ⓪&END;
  1327. ⓪&RETURN ~err
  1328. ⓪$END prgInstall;
  1329. ⓪ 
  1330. ⓪"BEGIN (* of LinkMod *)
  1331. ⓪$FlushCPUCache ();
  1332. ⓪$(*$ ? Trace: WriteLn; WriteString ('LinkMod: '); WriteString (msname); *)
  1333. ⓪$IF client # NIL THEN
  1334. ⓪&clientname := client^.codename^
  1335. ⓪$END;
  1336. ⓪$
  1337. ⓪$IF ModLoaded (msname,nowimport,fname,ref0) THEN
  1338. ⓪&(*$ ? Trace: WriteString (', already in RAM, '); *)
  1339. ⓪&WITH ref0^ DO
  1340. ⓪(IF program IN state THEN
  1341. ⓪*(*$ ? Trace: WriteString (' is program'); *)
  1342. ⓪*RETURN ref0
  1343. ⓪(ELSIF (reqkey#anykey) & (reqkey#header^.key) THEN
  1344. ⓪*(*$ ? Trace: WriteString ('bad version'); *)
  1345. ⓪*loadres := badversion;
  1346. ⓪*errHandler (codeName^,badversion);
  1347. ⓪*RETURN NIL
  1348. ⓪(ELSE (* tatsaechlich: wir haben das richtige Modul im RAM *)
  1349. ⓪*(*$ ? Trace: WriteString ('version ok.'); *)
  1350. ⓪*IF exec = execAlways (* zu startendes Hauptmodul *) THEN
  1351. ⓪,IF (installed IN state) OR ~(initialized IN state) THEN
  1352. ⓪.IF NOT (msr1 IN state) THEN
  1353. ⓪0IF NOT PrepareExec (ref0, FALSE) THEN
  1354. ⓪2RETURN NIL
  1355. ⓪0END
  1356. ⓪.END
  1357. ⓪,ELSE
  1358. ⓪.(*$ ? Trace: WriteLn; WriteString ('error: already initialized !'); *)
  1359. ⓪.loadres := denied;
  1360. ⓪.errHandler (codeName^,denied);
  1361. ⓪.RETURN NIL
  1362. ⓪,END
  1363. ⓪*ELSIF exec = execNew (* importiertes, bereits nachgeladenes Modul *) THEN
  1364. ⓪,IF NOT (msr1 IN state) THEN
  1365. ⓪.IF NOT PrepareExec (ref0, TRUE) THEN
  1366. ⓪0RETURN NIL
  1367. ⓪.END
  1368. ⓪,END
  1369. ⓪*END;
  1370. ⓪*RETURN ref0
  1371. ⓪(END
  1372. ⓪&END
  1373. ⓪$END;
  1374. ⓪$
  1375. ⓪$(*
  1376. ⓪%* Hier kommen wir an, wenn Modul nicht im RAM liegt
  1377. ⓪%*)
  1378. ⓪$
  1379. ⓪$IF Empty (FilePrefix (fname)) THEN
  1380. ⓪&(* ungültiger Modul-/Dateiname *)
  1381. ⓪&loadres:= notfound;
  1382. ⓪&SetMsg (8, errmsg);
  1383. ⓪&RETURN NIL
  1384. ⓪$END;
  1385. ⓪$
  1386. ⓪$ref0 := ReadMod (fname, msname);
  1387. ⓪$(*$ ? Trace: Read (inch); *)
  1388. ⓪$IF ref0 # NIL THEN (* Load war erfolgreich *)
  1389. ⓪&(*$ ? Trace: WriteLn; WriteString (msname); WriteString (': load ok'); *)
  1390. ⓪&nowimport:= True;
  1391. ⓪&IF exec = execNever THEN execRel:= execNever ELSE execRel:= execNew END;
  1392. ⓪&(*
  1393. ⓪'* Wir müssen hier schon das Modul markieren, weil sonst bei
  1394. ⓪'* zirkulären Importen dies Modul zu früh init. würde (z.B. beim
  1395. ⓪'* Compiler)
  1396. ⓪'*)
  1397. ⓪&INCL (ref0^.state, msr2);
  1398. ⓪&IF Relocate (ref0^.header, ref0, execRel) THEN
  1399. ⓪((*$ ? Trace: WriteLn; WriteString (msname); WriteString (': relocate ok, '); *)
  1400. ⓪(MakeImpList (ref0);
  1401. ⓪(IF exec # execNever THEN
  1402. ⓪*(*$ ? Trace: WriteString ('will be executed.'); *)
  1403. ⓪*IF NOT markForInit (ref0) THEN
  1404. ⓪,loadRes:= tooManyMods;
  1405. ⓪,errHandler (mainName,loadRes);
  1406. ⓪,Release (ref0,FALSE,FALSE);
  1407. ⓪,RETURN NIL
  1408. ⓪*END
  1409. ⓪(END;
  1410. ⓪(WITH ref0^ DO
  1411. ⓪*Loading (codeName^,newName,codeStart,codeLen,varRef,varLen);
  1412. ⓪(END;
  1413. ⓪(RETURN ref0
  1414. ⓪&ELSE (* Relocate ist schiefgegangen *)
  1415. ⓪((*$ ? Trace: WriteLn; WriteString (msname); WriteString (': relocate error'); *)
  1416. ⓪(IF loadRes = noError THEN
  1417. ⓪*loadRes:= notLinkable;
  1418. ⓪*errHandler (ref0^.codeName^,loadRes)
  1419. ⓪(END;
  1420. ⓪(MakeImpList (ref0); (* damit alle imp. Module wieder freigegb. werden*)
  1421. ⓪(Release (ref0,FALSE,FALSE);
  1422. ⓪(RETURN NIL
  1423. ⓪&END;
  1424. ⓪$ELSE (* Load ist schiefgegangen *)
  1425. ⓪&IF loadres # badLayout THEN
  1426. ⓪((*$ ? Trace: WriteLn; WriteString (msname); WriteString (': load error'); *)
  1427. ⓪(errHandler (msname,loadres);
  1428. ⓪(RETURN NIL
  1429. ⓪&ELSE
  1430. ⓪((* ...dann müßte es ein TOS-Prg sein *)
  1431. ⓪((*$ ? Trace: WriteString (', loading program.'); *)
  1432. ⓪(ploadres:= prgLoad (newname);
  1433. ⓪(IF ploadres < 0L THEN
  1434. ⓪*checkExecRes (SHORT (ploadres), loadRes, msname, errmsg);
  1435. ⓪*RETURN NIL
  1436. ⓪(ELSE
  1437. ⓪*errMsg[0]:=0C;
  1438. ⓪*basepage:= PtrBP (ploadres);
  1439. ⓪*IF prgPrepare (basepage, DefaultStackSize) & prgInstall() THEN
  1440. ⓪,WITH ref0^ DO
  1441. ⓪.(*SplitPath (newname, filePath, fn); SplitName (fn, fileName, sfx);*)
  1442. ⓪.fileName:= FilePrefix (newname);
  1443. ⓪.Assign (fileName, codeNameUp, ok); (* geht, weil fileName ohne Sfx*)
  1444. ⓪.codeName:= ADR (codeNameUp);
  1445. ⓪.codeStart:= basepage;
  1446. ⓪.header:= codeStart;
  1447. ⓪.codeLen:= basepage^.p_tlen;
  1448. ⓪.state:= ModStates {mainMod,program};
  1449. ⓪.owner:= ProcessID^;
  1450. ⓪.Loading (codeNameUp,newname,codeStart,codeLen,NIL,0L)
  1451. ⓪,END;
  1452. ⓪,loadRes:= NoError;
  1453. ⓪,RETURN ref0
  1454. ⓪*ELSE
  1455. ⓪,DEALLOCATE (ref0,0L);
  1456. ⓪,prgUnload (basepage);
  1457. ⓪,loadRes:= outOfMemory;
  1458. ⓪,errHandler (newname,loadRes);
  1459. ⓪,RETURN NIL
  1460. ⓪*END
  1461. ⓪(END
  1462. ⓪&END
  1463. ⓪$END (* IF tosPrg ... ELSE *)
  1464. ⓪"END LinkMod;
  1465. ⓪ 
  1466. ⓪"VAR DTA: ARRAY [1..22] OF WORD;
  1467. ⓪&basepage: PtrBP;
  1468. ⓪&stacksize: LONGCARD;
  1469. ⓪ 
  1470. ⓪"PROCEDURE exitMods;
  1471. ⓪$(* alten VarSpace wiederherstellen *)
  1472. ⓪$VAR execThis: CARDINAL; ad: PtrBSS;
  1473. ⓪$BEGIN
  1474. ⓪&execThis:= 0;
  1475. ⓪&WHILE execThis < ExecPtr DO
  1476. ⓪(WITH ExecList^[execThis]^ DO
  1477. ⓪*IF prevBSS # NIL THEN
  1478. ⓪,(*$ ? Trace: WriteLn; WriteString (codename^); WriteString (' restores BSS'); *)
  1479. ⓪,ad:= prevBSS;
  1480. ⓪,prevBSS:= prevBSS^.prev;
  1481. ⓪,Block.Copy (ADDRESS(ad) + 4L, varLen, varRef);
  1482. ⓪,DEALLOCATE (ad, 0);
  1483. ⓪*END;
  1484. ⓪(END;
  1485. ⓪(INC (execThis);
  1486. ⓪&END;
  1487. ⓪$END exitMods;
  1488. ⓪ 
  1489. ⓪"PROCEDURE initPrgSpace (prgFlags: LONGWORD) : Boolean;
  1490. ⓪$BEGIN
  1491. ⓪&(*$ ? Trace: WriteLn; WriteString ('CreatePB'); *)
  1492. ⓪&IF ~CreateBasePage (basepage, stacksize, CADR (mainName), prgFlags) THEN
  1493. ⓪(basepage:= NIL;
  1494. ⓪(RETURN FALSE
  1495. ⓪&END;
  1496. ⓪&Block.Copy (CADR(arg),128,ADR(basepage^.cmdline));
  1497. ⓪&basepage^.p_dta:= ADR(DTA);
  1498. ⓪&(*$ ? Trace: WriteString (' ok.'); *)
  1499. ⓪&RETURN true
  1500. ⓪$END initPrgSpace;
  1501. ⓪ 
  1502. ⓪"PROCEDURE removePrgSpace;
  1503. ⓪$BEGIN
  1504. ⓪&IF basepage # NIL THEN
  1505. ⓪((* nicht DEALLOCATE verwenden, da sonst u.U. Fehler passieren?! *)
  1506. ⓪(Mfree (basepage^.p_env);
  1507. ⓪(Mfree (basepage)
  1508. ⓪&END;
  1509. ⓪$END removePrgSpace;
  1510. ⓪"
  1511. ⓪"PROCEDURE outOfMem;
  1512. ⓪$BEGIN
  1513. ⓪&loadres := outofmemory;
  1514. ⓪&errHandler ('',loadres);
  1515. ⓪$END outOfMem;
  1516. ⓪"
  1517. ⓪"PROCEDURE reset (st: ModStates); (* Flags 'msr1' & 'msr2' löschen *)
  1518. ⓪$VAR i: ModRef;
  1519. ⓪$BEGIN
  1520. ⓪&ResetList (ModLst);
  1521. ⓪&LOOP
  1522. ⓪(i:= NextEntry (ModLst);
  1523. ⓪(IF i=NIL THEN EXIT END;
  1524. ⓪(i^.state:= i^.state - st
  1525. ⓪&END
  1526. ⓪$END reset;
  1527. ⓪ 
  1528. ⓪"PROCEDURE initNonReentrants (): BOOLEAN;
  1529. ⓪$(*
  1530. ⓪%* Es reicht nicht aus, in PrepareExec() alle Importe zum Init. zu prüfen.
  1531. ⓪%* Denn es kann vorkommen, daß z.B. über Treiber weitere Module abhängig
  1532. ⓪%* sind. Zwar sind diese schon initialisiert, wenn sie jedoch nicht
  1533. ⓪%* reentrant sind, müssen sie erneut init. werden.
  1534. ⓪%* Dies sollte darüber funktionieren, daß die Driver-Liste ausgewertet
  1535. ⓪%* wird. Solange dies noch nicht impl. ist, muß anders vorgegangen
  1536. ⓪%* werden:
  1537. ⓪%* Es werden zur Sicherheit einfach alle Module init., die schon
  1538. ⓪%* initialisiert & non-reentrant $ ~mainMod sind. Damit werden u.U.
  1539. ⓪%* zwar mehr Module als nötig init, das sollte aber nicht schaden.
  1540. ⓪%*)
  1541. ⓪$
  1542. ⓪$PROCEDURE check (i: ModRef): BOOLEAN;
  1543. ⓪&VAR j: POINTER TO ModRef;
  1544. ⓪&BEGIN
  1545. ⓪(WITH i^ DO
  1546. ⓪*INCL (state, msr1);
  1547. ⓪*IF imports # NIL THEN
  1548. ⓪,j:= ADDRESS (imports);
  1549. ⓪,LOOP
  1550. ⓪.IF j^ = NIL THEN EXIT END;
  1551. ⓪.IF NOT (msr1 IN j^^.state) THEN
  1552. ⓪0IF NOT check (j^) THEN RETURN FALSE END
  1553. ⓪.END;
  1554. ⓪.INC (j, 4)
  1555. ⓪,END
  1556. ⓪*END;
  1557. ⓪*IF NOT (reentrant IN state) & (initialized IN state)
  1558. ⓪*&  NOT (mainMod IN state)
  1559. ⓪*&  NOT (installed IN state) THEN
  1560. ⓪,IF NOT (msr2 IN i^.state) THEN
  1561. ⓪.INCL (i^.state, msr2);
  1562. ⓪.(*$ ? Trace OR Trace3: WriteLn; WriteString (codename^); WriteString (' will be executed'); *)
  1563. ⓪.IF NOT markForInit (i) THEN RETURN FALSE END
  1564. ⓪,END
  1565. ⓪*END
  1566. ⓪(END;
  1567. ⓪(RETURN TRUE
  1568. ⓪&END check;
  1569. ⓪$
  1570. ⓪$VAR i: ModRef;
  1571. ⓪$
  1572. ⓪$BEGIN
  1573. ⓪&ResetList (ModLst);
  1574. ⓪&LOOP
  1575. ⓪(i:= NextEntry (ModLst);
  1576. ⓪(IF i=NIL THEN EXIT END;
  1577. ⓪(IF NOT (msr1 IN i^.state) THEN
  1578. ⓪*IF NOT check (i) THEN
  1579. ⓪,RETURN FALSE
  1580. ⓪*END
  1581. ⓪(END
  1582. ⓪&END;
  1583. ⓪&RETURN TRUE
  1584. ⓪$END initNonReentrants;
  1585. ⓪ 
  1586. ⓪"VAR usedIndex: ModRef; lastExecPtr, termState: CARDINAL;
  1587. ⓪&ehdl: EnvlpCarrier;
  1588. ⓪&initOK: BOOLEAN; lastExecList: ADDRESS;
  1589. ⓪ 
  1590. ⓪ BEGIN (* ExecMod *)
  1591. ⓪"(*$?Trace0:Write('1');Read(inch);IF Inconsistent() THEN HALT END;*)
  1592. ⓪"errMsg[0]:=0C;
  1593. ⓪"loadres := noError;
  1594. ⓪"lastExecList:= ExecList;
  1595. ⓪"lastExecPtr:= ExecPtr;
  1596. ⓪"ALLOCATE (ExecList, (MaxModExec+1)*SIZE (ExecList^[0]));
  1597. ⓪"usedIndex:= NIL;
  1598. ⓪"IF ExecList = NIL THEN
  1599. ⓪$outOfMem
  1600. ⓪"ELSE
  1601. ⓪$ExecPtr := 0;
  1602. ⓪$nowimport := False;
  1603. ⓪$clientname:= '';
  1604. ⓪$IF exec # execNever THEN
  1605. ⓪&reset (ModStates{msr1,msr2});
  1606. ⓪&initOK:= initNonReentrants ();
  1607. ⓪&reset (ModStates{msr1})
  1608. ⓪$ELSE
  1609. ⓪&initOK:= TRUE
  1610. ⓪$END;
  1611. ⓪$IF initOK THEN
  1612. ⓪&usedIndex := LinkMod (mainName, anykey, exec, NIL);
  1613. ⓪&IF exec # execNever THEN reset (ModStates{msr1,msr2}) END;
  1614. ⓪&(*$ ? Trace OR Trace3: Read (inch); *)
  1615. ⓪&(*$?Trace0:Write('2');Read(inch);IF Inconsistent() THEN HALT END;*)
  1616. ⓪&IF usedIndex # NIL THEN
  1617. ⓪(INCL (usedIndex^.state, mainMod);
  1618. ⓪(IF program IN usedIndex^.state THEN
  1619. ⓪*(*$?Trace0:Write('3');Read(inch);IF Inconsistent() THEN HALT END;*)
  1620. ⓪*IF exec # ExecNever THEN
  1621. ⓪,IF NOT prgExec (usedIndex^.codeStart, CADR (mainName), arg, env, exitCode) THEN
  1622. ⓪.outOfMem
  1623. ⓪,END;
  1624. ⓪,(*$?Trace0:Write('6');Read(inch);IF Inconsistent() THEN HALT END;*)
  1625. ⓪*END
  1626. ⓪(ELSIF ExecPtr > 0 THEN
  1627. ⓪*stacksize:= usedIndex^.header^.stackSize;
  1628. ⓪*IF stacksize = 0 THEN
  1629. ⓪,stacksize := Defaultstacksize
  1630. ⓪*END;
  1631. ⓪*IF stacksize < 1024L THEN stacksize := 1024 END;
  1632. ⓪*IF odd (stacksize) THEN dec (stacksize) END;
  1633. ⓪*(*$ ? Trace: WriteLn; WriteString ('initPrgSpace'); *)
  1634. ⓪*IF ~initPrgSpace (usedIndex^.header^.prgFlags) THEN
  1635. ⓪,(*$ ? Trace: WriteString (' failed'); *)
  1636. ⓪,outOfMem;
  1637. ⓪,termState:= 2
  1638. ⓪*ELSE
  1639. ⓪,enterMods (TRUE, FALSE, exitCode);
  1640. ⓪,IF enterFailed THEN
  1641. ⓪.exitCode:= 0; outOfMem; termState:= 2
  1642. ⓪,ELSE
  1643. ⓪.(*$ ? Trace: WriteLn; WriteString ('ExecProcess'); *)
  1644. ⓪.INCL (usedIndex^.state, running);
  1645. ⓪.(*
  1646. ⓪0SetEnvelope (ehdl, enterMods, MemArea {NIL,0});
  1647. ⓪.*)
  1648. ⓪.ExecProcess (basepage, initMods, CADR (mainName),
  1649. ⓪;usedIndex^.header^.prgFlags, termState, exitCode);
  1650. ⓪.(*
  1651. ⓪0IF enterFailed THEN exitCode:= 0; outOfMem; termState:= 2 END;
  1652. ⓪0RemoveEnvelope (ehdl);
  1653. ⓪.*)
  1654. ⓪.EXCL (usedIndex^.state, running);
  1655. ⓪,END;
  1656. ⓪*END;
  1657. ⓪*(*$ ? Trace: WriteLn; WriteString ('removePrgSpace'); *)
  1658. ⓪*removePrgSpace;
  1659. ⓪*(*$?Trace0:Write('7');Read(inch);IF Inconsistent() THEN HALT END;*)
  1660. ⓪*exitMods;
  1661. ⓪*(*$?Trace0:Write('8');Read(inch);IF Inconsistent() THEN HALT END;*)
  1662. ⓪*IF termState#2 THEN
  1663. ⓪,IF termState<2 THEN
  1664. ⓪.loadres:= initFault
  1665. ⓪,ELSE
  1666. ⓪.loadres:= exitFault
  1667. ⓪,END;
  1668. ⓪,errHandler ('',loadres)
  1669. ⓪*END
  1670. ⓪(END
  1671. ⓪&END;
  1672. ⓪$ELSE
  1673. ⓪&loadRes:= tooManyMods;
  1674. ⓪&errHandler (mainName,loadRes)
  1675. ⓪$END;
  1676. ⓪$DEALLOCATE (ExecList, 0);
  1677. ⓪"END;
  1678. ⓪"ExecPtr:= lastExecPtr;
  1679. ⓪"ExecList:= lastExecList;
  1680. ⓪"(*$ ? Trace: WriteLn; WriteString ('End ExecMod'); *)
  1681. ⓪"(*$?Trace0:Write('9');Read(inch);IF Inconsistent() THEN HALT END;*)
  1682. ⓪"RETURN usedIndex
  1683. ⓪ END ExecMod;
  1684. ⓪ 
  1685. ⓪ 
  1686. ⓪ PROCEDURE Pexec ( VAR name, arg: ARRAY OF CHAR; env: ADDRESS; VAR execRes: INTEGER ): INTEGER;
  1687. ⓪"(*
  1688. ⓪#* Programm von Disk laden und starten
  1689. ⓪#*)
  1690. ⓪"VAR s:FileStr; i:INTEGER;
  1691. ⓪"BEGIN
  1692. ⓪$Assign (name,s,ok);
  1693. ⓪$ASSEMBLER
  1694. ⓪(MOVE.L  env(A6),-(A7)
  1695. ⓪(MOVE.L  arg(A6),-(A7)
  1696. ⓪(PEA     s(A6)
  1697. ⓪(CLR     -(A7)
  1698. ⓪(MOVE    #$4B,-(A7)
  1699. ⓪(TRAP    #1
  1700. ⓪(ADDA.W  #16,A7
  1701. ⓪(MOVE.L  execRes(A6),A0
  1702. ⓪(TST.L   D0
  1703. ⓪(BPL     execOK
  1704. ⓪(CLR     i(A6)
  1705. ⓪(MOVE.W  D0,(A0)
  1706. ⓪(BRA     ende
  1707. ⓪ execOK  MOVE    D0,i(A6)
  1708. ⓪(CLR.W   (A0)
  1709. ⓪ ende
  1710. ⓪&END;
  1711. ⓪$RETURN i
  1712. ⓪"END Pexec;
  1713. ⓪ 
  1714. ⓪ 
  1715. ⓪ TYPE modList = RECORD p: CARDINAL;
  1716. ⓪6a: POINTER TO ARRAY [0..5000] OF ModRef END;
  1717. ⓪ VAR exitList, removeList: modList;
  1718. ⓪ 
  1719. ⓪ PROCEDURE freeLists (olda, oldb: ADDRESS);
  1720. ⓪"BEGIN
  1721. ⓪$DEALLOCATE (exitList.a, 0);
  1722. ⓪$DEALLOCATE (removeList.a, 0);
  1723. ⓪$exitList.a:= olda;
  1724. ⓪$removeList.a:= oldb
  1725. ⓪"END freeLists;
  1726. ⓪ 
  1727. ⓪ PROCEDURE allocLists (VAR olda, oldb: ADDRESS): BOOLEAN;
  1728. ⓪"BEGIN
  1729. ⓪$olda:= exitList.a;
  1730. ⓪$oldb:= removeList.a;
  1731. ⓪$ALLOCATE (exitList.a, (MaxModExec+1)*SIZE(exitList.a^[0]));
  1732. ⓪$ALLOCATE (removeList.a, (MaxModExec+1)*SIZE(removeList.a^[0]));
  1733. ⓪$IF (exitList.a # NIL) & (removeList.a # NIL) THEN
  1734. ⓪&RETURN TRUE
  1735. ⓪$ELSE
  1736. ⓪&freeLists (olda, oldb);
  1737. ⓪&RETURN FALSE
  1738. ⓪$END
  1739. ⓪"END allocLists;
  1740. ⓪ 
  1741. ⓪ 
  1742. ⓪ PROCEDURE CallModule ( REF name     : ARRAY OF Char;
  1743. ⓪;Paths    : PathList;
  1744. ⓪7REF Arg      : ARRAY OF Char;
  1745. ⓪;env      : ADDRESS;
  1746. ⓪7VAR ExitCode : Integer;
  1747. ⓪7VAR ErrMsg   : ARRAY OF CHAR;
  1748. ⓪7VAR Result   : LoaderResults);
  1749. ⓪ 
  1750. ⓪"VAR myindex: ModRef;   (* Index wird gebraucht fuer Release *)
  1751. ⓪&mname: FileStr;
  1752. ⓪&fname: FileStr;
  1753. ⓪&arg0: ArgStr;
  1754. ⓪&myres: LoaderResults;
  1755. ⓪&mymsg: String;
  1756. ⓪&execRes: INTEGER;
  1757. ⓪&isPrg, isLoaded, found: BOOLEAN;
  1758. ⓪&save1, save2: ADDRESS;
  1759. ⓪ 
  1760. ⓪"PROCEDURE search (REF name: ARRAY OF CHAR);
  1761. ⓪$BEGIN
  1762. ⓪&SearchFile (name,Paths,fromStart,found,fname);
  1763. ⓪&isPrg:= found & ~IsModule (fname);
  1764. ⓪$END search;
  1765. ⓪ 
  1766. ⓪"BEGIN
  1767. ⓪$ExitCode := 0;
  1768. ⓪$errmsg[0]:= 0C;
  1769. ⓪$IF callptr = MaxModNest-1 THEN
  1770. ⓪&SetMsg (9, errmsg);
  1771. ⓪&Result := tooManyCalls
  1772. ⓪$ELSE
  1773. ⓪&inc (callptr);
  1774. ⓪&Assign (name,mname,ok);
  1775. ⓪&Assign (arg,arg0,ok);
  1776. ⓪&REPEAT
  1777. ⓪(IF arg0[0] # CHR(127) THEN
  1778. ⓪*Insert (CHR(Length(arg0)),0,arg0,ok)
  1779. ⓪(END;
  1780. ⓪(myMsg[0]:=0C;
  1781. ⓪(chainname [callptr] := '';
  1782. ⓪(isLoaded:= ModLoaded (mname, FALSE, fname, myindex);
  1783. ⓪(IF isLoaded & ~(loaded IN myindex^.state) & (LENGTH (FileSuffix(mname))>0) THEN
  1784. ⓪*(* Hier soll offenbar ein Prg. gestartet werden, das mit dem
  1785. ⓪+* selben Namen auch schon als residentes Modul vorkommt.
  1786. ⓪+* Prüfen, ob das File existiert und dann doch das File starten. *)
  1787. ⓪*search (mname);
  1788. ⓪*IF isPrg THEN isLoaded:= FALSE END
  1789. ⓪(ELSIF ~isLoaded THEN
  1790. ⓪*search (fname);
  1791. ⓪(END;
  1792. ⓪(IF ~isLoaded & ~found THEN
  1793. ⓪*myres:= notfound;
  1794. ⓪*mname:= '';
  1795. ⓪*outerErrHandler (FileNames.FileName (fname), '', FALSE, notfound, mymsg)
  1796. ⓪(ELSIF ~isLoaded & isPrg THEN
  1797. ⓪*exitCode:= Pexec (fname,arg0,env,execRes);
  1798. ⓪*mname:= '';
  1799. ⓪*checkExecRes (execRes, myRes, fname, myMsg);
  1800. ⓪(ELSE
  1801. ⓪*IF ~allocLists (save1, save2) THEN
  1802. ⓪,mname:= '';
  1803. ⓪,SetMsg (6, mymsg);
  1804. ⓪,myres := outofmemory;
  1805. ⓪*ELSE
  1806. ⓪,myindex:= execmod (mname,execalways,paths,arg0,env,exitcode,mymsg,myres);
  1807. ⓪,IF myindex # NIL THEN
  1808. ⓪.Release (myindex,FALSE,FALSE)
  1809. ⓪,END;
  1810. ⓪,freeLists (save1, save2);
  1811. ⓪,mname := chainname [callptr];
  1812. ⓪,arg0 := chainarg [callptr]
  1813. ⓪*END
  1814. ⓪(END
  1815. ⓪&UNTIL mname[0] = 0C;
  1816. ⓪&Assign (mymsg,ErrMsg,ok);
  1817. ⓪&Result:= myres;
  1818. ⓪&DEC (callptr);
  1819. ⓪$END
  1820. ⓪"END CallModule;
  1821. ⓪ 
  1822. ⓪ 
  1823. ⓪ PROCEDURE LoadModule ( REF mname   : ARRAY OF CHAR;
  1824. ⓪;paths   : PathList;
  1825. ⓪7VAR mname0  : ARRAY OF CHAR;
  1826. ⓪7VAR errMsg  : ARRAY OF CHAR;
  1827. ⓪7VAR result  : LoaderResults);
  1828. ⓪"
  1829. ⓪"VAR   dummy:INTEGER;
  1830. ⓪(sdum: ArgStr;
  1831. ⓪(idx: CARDINAL;
  1832. ⓪(save1, save2: ADDRESS;
  1833. ⓪(ref0:ModRef;
  1834. ⓪ 
  1835. ⓪"BEGIN
  1836. ⓪$(* darf hier nicht stehen wg. ggf. Alias zu 'mname': mname0[0]:= 0C; *)
  1837. ⓪$errmsg[0]:= 0C;
  1838. ⓪$IF ~allocLists (save1, save2) THEN
  1839. ⓪&SetMsg (6, errmsg);
  1840. ⓪&mname0[0]:= 0C;
  1841. ⓪&Result := outofmemory;
  1842. ⓪$ELSE
  1843. ⓪&ref0 := execmod (mname, execnever, paths, sdum, 0, dummy, errmsg, result);
  1844. ⓪&freeLists (save1, save2);
  1845. ⓪&IF ref0 # NIL THEN
  1846. ⓪(Assign (ref0^.codename^,mname0,ok);
  1847. ⓪(IF linked IN ref0^.state THEN
  1848. ⓪*result := denied;
  1849. ⓪*SetMsg (7, errmsg);
  1850. ⓪*idx:= PosLen ('@I',errmsg,0);
  1851. ⓪*Delete (errmsg,idx,2,ok);
  1852. ⓪*Insert (ref0^.codeName^,idx,errmsg,ok);
  1853. ⓪(ELSE
  1854. ⓪*INCL (ref0^.state,loaded);
  1855. ⓪(END
  1856. ⓪&ELSE
  1857. ⓪(mname0[0]:= 0C;
  1858. ⓪&END
  1859. ⓪$END
  1860. ⓪"END LoadModule;
  1861. ⓪ 
  1862. ⓪ 
  1863. ⓪ PROCEDURE freeModule (ref0: ModRef; VAR result: LoaderResults);
  1864. ⓪ 
  1865. ⓪"VAR save1, save2: ADDRESS;
  1866. ⓪ 
  1867. ⓪"BEGIN
  1868. ⓪$result := NoError;
  1869. ⓪$IF program IN ref0^.state THEN
  1870. ⓪&prgUnload (ref0^.codeStart);
  1871. ⓪&FindEntry (ModLst, ref0, ok);
  1872. ⓪&IF ok THEN
  1873. ⓪(RemoveEntry (ModLst,ok)
  1874. ⓪&END;
  1875. ⓪&DEALLOCATE (ref0,0L)
  1876. ⓪$ELSE
  1877. ⓪&IF loaded IN ref0^.state THEN
  1878. ⓪(EXCL (ref0^.state, loaded);
  1879. ⓪(IF ~ allocLists (save1, save2) THEN
  1880. ⓪*Result := outofmemory;
  1881. ⓪(ELSE
  1882. ⓪*Release (ref0, FALSE, FALSE);
  1883. ⓪*freeLists (save1, save2);
  1884. ⓪*IF ref0#NIL THEN
  1885. ⓪,result := notRemoved
  1886. ⓪*END
  1887. ⓪(END
  1888. ⓪&ELSE
  1889. ⓪(result:= denied (* Modul ist nicht geladen *)
  1890. ⓪&END;
  1891. ⓪$END
  1892. ⓪"END freeModule;
  1893. ⓪ 
  1894. ⓪ PROCEDURE UnLoadModule ( REF mname : ARRAY OF Char;
  1895. ⓪9VAR result: LoaderResults);
  1896. ⓪ 
  1897. ⓪"VAR ref0: ModRef; dummy: FileStr;
  1898. ⓪ 
  1899. ⓪"BEGIN
  1900. ⓪$IF ModLoaded (mname,FALSE,dummy,ref0) THEN
  1901. ⓪&freeModule (ref0,result)
  1902. ⓪$ELSE
  1903. ⓪&result := notFound
  1904. ⓪$END
  1905. ⓪"END UnLoadModule;
  1906. ⓪ 
  1907. ⓪ 
  1908. ⓪ 
  1909. ⓪ PROCEDURE FullRelease (VAR client: ModRef; dummy1, dummy2: BOOLEAN);
  1910. ⓪"(* 'client' wird auf NIL gesetzt, wenn Modul wirklich freigegeben wird *)
  1911. ⓪ 
  1912. ⓪"PROCEDURE DoRemoveInfo ( ad: ADDRESS; len: LONGCARD );
  1913. ⓪$BEGIN
  1914. ⓪&ASSEMBLER
  1915. ⓪(; Suche nach Prozeduren, die im angegebenen Code-Bereich liegen:
  1916. ⓪(MOVE.L  ad(A6),D1
  1917. ⓪(MOVE.L  D1,D2
  1918. ⓪(ADD.L   len(A6),D2
  1919. ⓪(LEA     RemovalRoot,A0
  1920. ⓪(MOVE.L  A0,A1
  1921. ⓪&l MOVE.L  RemovalEntry.prev(A0),A0 ; Liste rückwärts durchgehen
  1922. ⓪(CMPA.L  A1,A0                   ; Listenende ?
  1923. ⓪(BEQ     e
  1924. ⓪(MOVE.L  RemovalEntry.call(A0),D0
  1925. ⓪(CMP.L   D1,D0                   ; call < Code-Beginn ?
  1926. ⓪(BCS     l                       ;   ja, weitersuchen
  1927. ⓪(CMP.L   D2,D0                   ; call > Code-Ende ?
  1928. ⓪(BCC     l                       ;   ja, weitersuchen
  1929. ⓪(; Proc gefunden -> auslinken und Remove-Info
  1930. ⓪(MOVEM.L D1/D2/A0/A1,-(A7)
  1931. ⓪(MOVE.L  RemovalEntry.next(A0),A1
  1932. ⓪(MOVE.L  RemovalEntry.prev(A0),A2
  1933. ⓪(MOVE.L  A1,RemovalEntry.next(A2)
  1934. ⓪(MOVE.L  A2,RemovalEntry.prev(A1)
  1935. ⓪(MOVE.L  D0,(A3)+
  1936. ⓪(LEA     RemovalEntry.wsp(A0),A0
  1937. ⓪(MOVE.L  A0,(A3)+
  1938. ⓪(JSR     CallSub
  1939. ⓪(MOVEM.L (A7)+,D1/D2/A0/A1
  1940. ⓪(BRA     l                       ; falls mehrere Removals im Modul
  1941. ⓪&e
  1942. ⓪&END
  1943. ⓪$END DoRemoveInfo;
  1944. ⓪ 
  1945. ⓪"PROCEDURE markNonFree;
  1946. ⓪ 
  1947. ⓪$(*
  1948. ⓪%* Die Module werden folgendermaßen markiert:
  1949. ⓪%*   - folgende erhalten 'msr1' in 'state':
  1950. ⓪%*       - linked
  1951. ⓪%*       - program
  1952. ⓪%*       - mainMod & running + Importe
  1953. ⓪%*       - installed         + Importe
  1954. ⓪%*   - folgende erhalten 'loadImp' in 'state':
  1955. ⓪%*       - loaded            + Importe   (ohne die, die schon 'msr1' haben)
  1956. ⓪%*
  1957. ⓪%* Alle, die 'msr1' haben, können nicht deinitialisiert werden.
  1958. ⓪%* Alle, die 'msr1' oder 'loadImp' haben, können nicht freigegeben werden.
  1959. ⓪%*)
  1960. ⓪ 
  1961. ⓪$PROCEDURE presetFlags;
  1962. ⓪&VAR i: ModRef;
  1963. ⓪&BEGIN
  1964. ⓪(ResetList (ModLst);
  1965. ⓪(LOOP
  1966. ⓪*i:= NextEntry (ModLst);
  1967. ⓪*IF i=NIL THEN EXIT END;
  1968. ⓪*EXCL (i^.state, loadImp);
  1969. ⓪*IF (linked IN i^.state) OR (program IN i^.state) THEN
  1970. ⓪,INCL (i^.state, msr1);  (* Markiert fertige Module *)
  1971. ⓪*ELSE
  1972. ⓪,EXCL (i^.state, msr1);
  1973. ⓪*END
  1974. ⓪(END
  1975. ⓪&END presetFlags;
  1976. ⓪ 
  1977. ⓪$PROCEDURE markImported (i: ModRef; s: ModState);
  1978. ⓪&VAR j: POINTER TO ModRef;
  1979. ⓪&BEGIN
  1980. ⓪(INCL (i^.state, s);
  1981. ⓪(IF i^.imports # NIL THEN
  1982. ⓪*j:= ADR (i^.imports^);
  1983. ⓪*WHILE j^ # NIL DO
  1984. ⓪,IF NOT ( (msr1 IN j^^.state) OR (loadImp IN j^^.state) ) THEN
  1985. ⓪.markImported (j^, s);
  1986. ⓪,END;
  1987. ⓪,INC (j, 4)
  1988. ⓪*END
  1989. ⓪(END;
  1990. ⓪&END markImported;
  1991. ⓪ 
  1992. ⓪$VAR i: ModRef; s: ModStates;
  1993. ⓪ 
  1994. ⓪$BEGIN (* markNonFree *)
  1995. ⓪&presetFlags;
  1996. ⓪&ResetList (ModLst);
  1997. ⓪&LOOP
  1998. ⓪(i:= NextEntry (ModLst);
  1999. ⓪(IF i=NIL THEN EXIT END;
  2000. ⓪(s:= i^.state;
  2001. ⓪(IF NOT (msr1 IN s) THEN
  2002. ⓪*IF ( (mainMod IN s) AND (running IN s) ) OR (installed IN s) THEN
  2003. ⓪,markImported (i, msr1)
  2004. ⓪*ELSIF loaded IN s THEN
  2005. ⓪,markImported (i, loadImp)
  2006. ⓪*END
  2007. ⓪(END
  2008. ⓪&END;
  2009. ⓪&(*$ ? Trace:
  2010. ⓪(WriteLn;
  2011. ⓪(WriteString ('Freie Module:');
  2012. ⓪(ResetList (ModLst);
  2013. ⓪(LOOP
  2014. ⓪*i:= NextEntry (ModLst);
  2015. ⓪*IF i=NIL THEN EXIT END;
  2016. ⓪*IF NOT (msr1 IN i^.state) THEN
  2017. ⓪,WriteString (i^.codeName^);
  2018. ⓪,WriteString ('  ');
  2019. ⓪*END
  2020. ⓪(END;
  2021. ⓪(WriteLn;
  2022. ⓪(Read(inch);
  2023. ⓪&*)
  2024. ⓪$END markNonFree;
  2025. ⓪ 
  2026. ⓪"PROCEDURE release0 (VAR client: ModRef);
  2027. ⓪ 
  2028. ⓪$PROCEDURE add (VAR list: modList);
  2029. ⓪&BEGIN
  2030. ⓪(WITH list DO
  2031. ⓪*IF p > MaxModExec THEN
  2032. ⓪,ASSEMBLER
  2033. ⓪0TRAP    #6
  2034. ⓪0DC.W    Overflow-$8000
  2035. ⓪0ACZ     'Release: Too many modules'
  2036. ⓪,END
  2037. ⓪*END;
  2038. ⓪*a^[p]:= client;
  2039. ⓪*INC (p);
  2040. ⓪(END;
  2041. ⓪&END add;
  2042. ⓪ 
  2043. ⓪$VAR j, j2: ModRef; pj: POINTER TO ModRef; deInit, removable: BOOLEAN;
  2044. ⓪ 
  2045. ⓪$BEGIN (* release0 *)
  2046. ⓪&(*$ ? Trace: WriteLn; WriteString ('Release: '); WriteString (client^.codeName^); *)
  2047. ⓪&IF msr1 IN client^.state THEN
  2048. ⓪((*$ ? Trace: WriteString (' / is linked or already removed - no action'); *)
  2049. ⓪&ELSE
  2050. ⓪(INCL (client^.state,msr1);
  2051. ⓪(deInit:= initialized IN client^.state;
  2052. ⓪(removable:= NOT (loadImp IN client^.state);
  2053. ⓪(pj:= ADDRESS (client^.imports);
  2054. ⓪(IF pj # NIL THEN
  2055. ⓪*(*$ ? Trace: WriteLn; WriteString ('< releasing imports of '); WriteString (client^.codeName^); *)
  2056. ⓪*LOOP
  2057. ⓪,j:= pj^;
  2058. ⓪,IF j = NIL THEN EXIT END;
  2059. ⓪,j2:= j;
  2060. ⓪,pj^:= NIL;
  2061. ⓪,release0 (j2);  (* 'j2' wird ggf. auf NIL gesetzt *)
  2062. ⓪,pj^:= j;
  2063. ⓪,INC (pj, SIZE (pj^));
  2064. ⓪*END;
  2065. ⓪*(*$ ? Trace: WriteLn; WriteString ('> end of releasing imports of '); WriteString (client^.codeName^); *)
  2066. ⓪(END;
  2067. ⓪(IF deInit THEN add (exitList) END;
  2068. ⓪(IF removable THEN
  2069. ⓪*add (removeList);
  2070. ⓪*client:= NIL
  2071. ⓪(END
  2072. ⓪&END;
  2073. ⓪&(*$ ? Trace: Read(inch) *)
  2074. ⓪$END release0;
  2075. ⓪ 
  2076. ⓪"VAR listCnt: CARDINAL;
  2077. ⓪ 
  2078. ⓪"BEGIN (* FullRelease *)
  2079. ⓪$(*$ ? Trace2: WriteLn; WriteString ('Begin Release!'); *)
  2080. ⓪$IF NOT (program IN client^.state) & NOT (linked IN client^.state) THEN
  2081. ⓪&markNonFree;
  2082. ⓪&exitList.p:= 0;
  2083. ⓪&removeList.p:= 0;
  2084. ⓪&release0 (client);
  2085. ⓪&WITH exitList DO
  2086. ⓪(WHILE p > 0 DO
  2087. ⓪*DEC (p);
  2088. ⓪*(*$ ? Trace2 OR Trace: WriteLn; WriteString ('deinit '); WriteString (a^[p]^.codeName^); *)
  2089. ⓪*WITH a^[p]^ DO
  2090. ⓪,DoRemoveInfo (codeStart, codeLen);
  2091. ⓪,EXCL (state, initialized);
  2092. ⓪*END
  2093. ⓪(END
  2094. ⓪&END;
  2095. ⓪&WITH removeList DO
  2096. ⓪(WHILE p > 0 DO
  2097. ⓪*DEC (p);
  2098. ⓪*(*$ ? Trace: WriteLn; WriteString ('dealloc '); WriteString (a^[p]^.codeName^); *)
  2099. ⓪*FindEntry (ModLst, a^[p], ok);
  2100. ⓪*IF ok THEN
  2101. ⓪,RemoveEntry (ModLst,error);
  2102. ⓪,FreeMod (a^[p])
  2103. ⓪*ELSE
  2104. ⓪,ASSEMBLER
  2105. ⓪0TRAP    #6
  2106. ⓪0DC.W    IllegalState    ; interner Fehler!
  2107. ⓪,END
  2108. ⓪*END;
  2109. ⓪(END
  2110. ⓪&END;
  2111. ⓪&(*$ ? Trace2: Read(inch); *)
  2112. ⓪$END;
  2113. ⓪"END FullRelease;
  2114. ⓪ 
  2115. ⓪ 
  2116. ⓪ PROCEDURE DummyMonitor;
  2117. ⓪"(*$L-*)
  2118. ⓪"BEGIN
  2119. ⓪"END DummyMonitor;
  2120. ⓪"(*$L+*)
  2121. ⓪ 
  2122. ⓪ PROCEDURE DummyLoading (REF a,b:ARRAY OF CHAR;c:ADDRESS;d:LONGCARD;e:ADDRESS;f:LONGCARD);
  2123. ⓪"BEGIN
  2124. ⓪"END DummyLoading;
  2125. ⓪ 
  2126. ⓪ PROCEDURE envelope (open, child: BOOLEAN; VAR exitcode: INTEGER);
  2127. ⓪"(*
  2128. ⓪#* Kontrollieren, ob der Prozeß endet, unter dem ein Modul geladen wurde.
  2129. ⓪#* Dann das Modul freigeben. Da der 'owner' nur dann gesetzt wird, wenn
  2130. ⓪#* kein SysAlloc (FullStorBaseAccess) erfolgen konnte, passiert dies nur
  2131. ⓪#* auf dem TT oder wenn kein erw. Storage-Access erlaubt wird.
  2132. ⓪#*)
  2133. ⓪"VAR i: ModRef; result: LoaderResults;
  2134. ⓪"BEGIN
  2135. ⓪$IF NOT open AND child THEN
  2136. ⓪&ResetList (ModLst);
  2137. ⓪&LOOP
  2138. ⓪(i:= NextEntry (ModLst);
  2139. ⓪(IF i=NIL THEN EXIT END;
  2140. ⓪(IF (loaded IN i^.state) & (i^.owner = ProcessID^) THEN
  2141. ⓪*freeModule (i, result);
  2142. ⓪*ResetList (ModLst); (* wieder von vorn *)
  2143. ⓪(END
  2144. ⓪&END;
  2145. ⓪$END
  2146. ⓪"END envelope;
  2147. ⓪ 
  2148. ⓪ VAR ehdl: EnvlpCarrier;
  2149. ⓪ 
  2150. ⓪ BEGIN (* of Loader *)
  2151. ⓪"SetEnvelope (ehdl, envelope, MemArea {NIL,0});
  2152. ⓪"IF UseStackFrame () THEN StackFrameOffs:= 2 ELSE StackFrameOffs:= 0 END;
  2153. ⓪"callptr:= 1;
  2154. ⓪"ExecPtr:= 0;
  2155. ⓪"DefaultStackSize:= 16384;
  2156. ⓪"Loading:= DummyLoading;
  2157. ⓪"Monitor:= DummyMonitor;
  2158. ⓪"Release:= FullRelease;
  2159. ⓪"(*$P+*)
  2160. ⓪ END Loader.
  2161. ⓪ ə
  2162. (* $0000662F$000021CC$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$00005177$FFF09768$0000DC29$FFF09768$0000515F$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$00008304$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768Ç$00001C77T.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$FFAD4838$FFAD4838$00005162$00008834$00008822$FFAD4838$00008822$00005967$FFAD4838$00001CA5$FFAD4838$00005173$0000515F$00001C77$00005949$FFAD4838îÇâ*)
  2163.