home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MYUTIL / PRGLOAD.OLD < prev    next >
Encoding:
Text File  |  1991-02-03  |  15.4 KB  |  3 lines
  1. ⓪ 
  2. ⓪ MODULE PrgLoad; (*$E MAC  -> Linker erzeugt ACC-Endung *)
  3. ⓪ 
  4. ⓪ (*
  5. ⓪!* Hinweis/Copyright:
  6. ⓪!* ------------------
  7. ⓪!*   Die Veröffentlichungsrechte dieses Programms und seiner Quellen liegt
  8. ⓪!*   beim Autor Thomas Tempelmann und der Zeitschrift TOS (ICP-Verlag,
  9. ⓪!*   München-Vaterstetten).
  10. ⓪!*
  11. ⓪!*   Mit Erwerb der Zeitschrift "TOS" steht es Ihnen frei, das Programm
  12. ⓪!*   zu nutzen. Das Programm ist also keine Freeware oder PD!
  13. ⓪!*   Sie dürfen das Programm verändern, jedoch nicht selbst "verbesserte"
  14. ⓪!*   Versionen dieses Programm verbreiten. Dies obliegt allein dem Urheber,
  15. ⓪!*   also Thomas Tempelmann.
  16. ⓪!*
  17. ⓪!*   Ich hoffe, Sie beachten diese Hinweise. Ich wäre schwer enttäuscht,
  18. ⓪!*   wenn plötzlich eine Version 2.1, die nicht von mir stammt, auf
  19. ⓪!*   dem PD- oder Raubkopiermarkt erscheint. Dann könnte dies der letzte
  20. ⓪!*   Beitrag von mir gewesen sein. Fairness und Vertrauen sind wichtig
  21. ⓪!*   für das Weiterleben dieser Form der Softwareveröffentlichung!
  22. ⓪!*
  23. ⓪!*   Für weitere Fragen und Wünsche wenden Sie sich bitte an mich:
  24. ⓪!*      Thomas Tempelmann, Nordendstr. 64, D-8000 München 40.
  25. ⓪!*
  26. ⓪!* Über dieses Programm:
  27. ⓪!* ---------------------
  28. ⓪!*   In der Ausgabe 4/91 der Zeitschrift TOS finden Sie die ausführliche
  29. ⓪!*   Beschreibung dieses nützlichen Programms.
  30. ⓪!*
  31. ⓪!*   Dieses Modul ist ohne Änderungen nur mit Megamax Modula-2 (System 2.2,
  32. ⓪!*   Compiler 4.0) oder höher übersetzbar. Desweiteren gehören die beiden
  33. ⓪!*   Quellen des Moduls "PrgLoader" (PRGLOADE.D & PRGLOADE.I) zu diesem
  34. ⓪!*   Programm und müssen zuvor übersetzt werden.
  35. ⓪!*
  36. ⓪!* Mögliche Verbesserungen:
  37. ⓪!* ------------------------
  38. ⓪!* - Überwachen, ob "UsedHeapSize" bei jedem Programmlauf gleich bleibt.
  39. ⓪!* - Selbstmodifizierenden Code erkennen und dann Warnung anzeigen mit
  40. ⓪!*   Option, das Programm freizugeben.
  41. ⓪!*
  42. ⓪!*----------------------------------------------------------------------------
  43. ⓪!* 22.10.88  TT  Grunderstellung ModLoad
  44. ⓪!* 21.12.88  TT  Fertigstellung der Version 1.0 aus ModLoad 1.0
  45. ⓪!* 20.12.90  TT  Fertigstellung der Version 2.0 aus ModLoad 1.3
  46. ⓪!*----------------------------------------------------------------------------
  47. ⓪!*)
  48. ⓪ 
  49. ⓪ (*$R-,S-  Keine Bereichs-, Überlauf- und Stack-Prüfungen erzeugen *)
  50. ⓪ 
  51. ⓪ FROM PrgLoader IMPORT
  52. ⓪"QueryLoaded, LoadProgram, UnLoadProgram, ProgramLoaded, CallProgram,
  53. ⓪"UsedHeapSize, LoaderResults;
  54. ⓪ 
  55. ⓪ FROM SYSTEM IMPORT
  56. ⓪"ASSEMBLER, CAST, ADDRESS, ADR, TSIZE, BYTE, WORD, LONGWORD;
  57. ⓪ 
  58. ⓪ FROM AESWindows IMPORT
  59. ⓪"UpdateWindow;
  60. ⓪ 
  61. ⓪ FROM AESForms IMPORT
  62. ⓪"FormAlert;
  63. ⓪ 
  64. ⓪ FROM AESMisc IMPORT
  65. ⓪"ShellFind;
  66. ⓪ 
  67. ⓪ FROM AESMisc IMPORT
  68. ⓪"SelectFile;
  69. ⓪ 
  70. ⓪ FROM EasyGEM0 IMPORT
  71. ⓪"WrapAlert;
  72. ⓪ 
  73. ⓪ FROM MOSGlobals IMPORT
  74. ⓪"PathStr, NameStr, FileStr, SfxStr, MemArea;
  75. ⓪ 
  76. ⓪ FROM FileNames IMPORT
  77. ⓪"FileName, PathConc, SplitPath, SplitName;
  78. ⓪ 
  79. ⓪ FROM Files IMPORT
  80. ⓪"File, Open, Close, EOF, State, Access;
  81. ⓪ 
  82. ⓪ FROM Text IMPORT
  83. ⓪"EOL, ReadFromLine, ReadLn;
  84. ⓪ 
  85. ⓪ FROM StrConv IMPORT
  86. ⓪"CardToStr, StrToLCard;
  87. ⓪ 
  88. ⓪ FROM GEMEnv IMPORT
  89. ⓪"InitApplication, ExitApplication;
  90. ⓪ 
  91. ⓪ FROM AESEvents IMPORT
  92. ⓪"MessageEvent, MessageBuffer, accOpen;
  93. ⓪ 
  94. ⓪ FROM AESMenus IMPORT
  95. ⓪"RegisterAcc;
  96. ⓪ 
  97. ⓪ FROM PrgCtrl IMPORT
  98. ⓪"Accessory;
  99. ⓪ 
  100. ⓪ FROM MOSCtrl IMPORT
  101. ⓪"ProcessID (* Zeiger auf den aktuellen GEMDOS-Prozeß *);
  102. ⓪ 
  103. ⓪ FROM SysInfo IMPORT
  104. ⓪"UseStackFrame;
  105. ⓪ 
  106. ⓪ FROM Directory IMPORT
  107. ⓪"GetDefaultPath;
  108. ⓪ 
  109. ⓪ IMPORT FuncStrings, Strings, XBRA, BIOS;
  110. ⓪ 
  111. ⓪ 
  112. ⓪ CONST   LoaderStackSize = 4000; (* Stackgröße zum Aufruf des Loaders *)
  113. ⓪ 
  114. ⓪(Kennung = 'PrgL';       (* XBRA-Kennung für TRAP #1-Handler *)
  115. ⓪(PrgName = 'PrgLoad';    (* Name dieses Moduls (auch ACC-Eintrag) *)
  116. ⓪(Version = '2.0';        (* Nicht ändern und veröffentlichen (s.o.)! *)
  117. ⓪(InfName = 'PRGLOAD.INF';(* Name der INF-Datei *)
  118. ⓪ 
  119. ⓪ 
  120. ⓪ TYPE PtrPexecPar = POINTER TO RECORD
  121. ⓪5mode: (loadExec, unused1, unused2, load, exec, create);
  122. ⓪5fileName: ADDRESS;
  123. ⓪5arg: ADDRESS;
  124. ⓪5env: ADDRESS
  125. ⓪3END;
  126. ⓪ 
  127. ⓪%PexecRes = RECORD
  128. ⓪2exitCode: INTEGER;
  129. ⓪2didExec: BOOLEAN;
  130. ⓪0END;
  131. ⓪ 
  132. ⓪ VAR
  133. ⓪"DefaultHeap: LONGCARD;    (* Heap-Größe, wenn keine andere Angabe *)
  134. ⓪"DidShowInfo, GotHeapSize, GetHeapSize: BOOLEAN;
  135. ⓪"Desktop: ADDRESS;         (* Prozeßkennung des Desktops, invariabel *)
  136. ⓪ 
  137. ⓪"myName: Strings.String;
  138. ⓪"path: ARRAY [0..127] OF CHAR;
  139. ⓪"arg: ARRAY [0..128] OF CHAR;
  140. ⓪ 
  141. ⓪"entry, at: ADDRESS;
  142. ⓪"carrier: XBRA.Carrier;
  143. ⓪"stackhi: ADDRESS;
  144. ⓪"doingPexec: BOOLEAN;
  145. ⓪"stackFrameOffs: SHORTCARD;
  146. ⓪"ok: BOOLEAN;
  147. ⓪ 
  148. ⓪ 
  149. ⓪ PROCEDURE Alert (s: ARRAY OF CHAR);
  150. ⓪ 
  151. ⓪"VAR button: CARDINAL;
  152. ⓪&ok: BOOLEAN;
  153. ⓪&msg: ARRAY [0..250] OF CHAR;
  154. ⓪ 
  155. ⓪"BEGIN
  156. ⓪$Strings.Assign (s, msg, ok);
  157. ⓪$(* Meldung mit FormAlert-Dialog anzeigen *)
  158. ⓪$WrapAlert (msg, 0);
  159. ⓪$Strings.Insert ('[0][', 0, msg, ok);
  160. ⓪$Strings.Append ('][ OK ]', msg, ok);
  161. ⓪$FormAlert (1, msg, button);
  162. ⓪"END Alert;
  163. ⓪ 
  164. ⓪ PROCEDURE doLoadWithMsg (REF name: ARRAY OF CHAR);
  165. ⓪"VAR result: LoaderResults;
  166. ⓪"BEGIN
  167. ⓪$IF ProcessID^ # Desktop THEN
  168. ⓪&Alert ("Das Laden ist nur vom Desktop aus möglich!")
  169. ⓪$ELSE
  170. ⓪&SplitPath (name, path, arg);
  171. ⓪&LoadProgram (name, DefaultHeap, result);
  172. ⓪&IF result = noError THEN
  173. ⓪(Strings.Append (' wurde geladen', arg, ok)
  174. ⓪&ELSIF result = alreadyLoaded THEN
  175. ⓪(Strings.Append (' ist bereits geladen', arg, ok)
  176. ⓪&ELSE
  177. ⓪(Strings.Append (' kann nicht geladen werden', arg, ok)
  178. ⓪&END;
  179. ⓪&Alert (arg)
  180. ⓪$END;
  181. ⓪"END doLoadWithMsg;
  182. ⓪ 
  183. ⓪ PROCEDURE doUnLoadWithMsg (REF name: ARRAY OF CHAR);
  184. ⓪"VAR result: LoaderResults;
  185. ⓪"BEGIN
  186. ⓪$SplitPath (name, path, arg);
  187. ⓪$UnLoadProgram (name, result);
  188. ⓪$IF result = noError THEN
  189. ⓪&Strings.Append (' wurde freigegeben', arg, ok);
  190. ⓪$ELSE
  191. ⓪&Strings.Append (' war nicht geladen', arg, ok)
  192. ⓪$END;
  193. ⓪$Alert (arg)
  194. ⓪"END doUnLoadWithMsg;
  195. ⓪ 
  196. ⓪ PROCEDURE hdlPexec (par: PtrPexecPar): PexecRes;
  197. ⓪"(* Return: TRUE: alte Pexec-Funktion aufrufen, sonst Trap beenden *)
  198. ⓪ 
  199. ⓪"PROCEDURE getArg (dosArg: ADDRESS; VAR txt: ARRAY OF CHAR);
  200. ⓪$(*
  201. ⓪%* Wandelt Pexec-Argumentzeile in String um
  202. ⓪%*)
  203. ⓪$BEGIN
  204. ⓪&ASSEMBLER
  205. ⓪(MOVE.L  dosArg(A6),A0           ; A0: dosArg
  206. ⓪(MOVE.L  txt(A6),A1              ; A1: ADR (txt)
  207. ⓪(CLR     D0
  208. ⓪(MOVE.B  (A0)+,D0                ; Länge der Arg-Zeile
  209. ⓪(BRA     c
  210. ⓪&l MOVE.B  (A0)+,(A1)+             ; Zeile kopieren
  211. ⓪&c DBRA    D0,l
  212. ⓪(CLR.B   (A1)                    ; String-Ende mit 0C abschließen
  213. ⓪&END
  214. ⓪$END getArg;
  215. ⓪ 
  216. ⓪"VAR fn: POINTER TO FileStr;
  217. ⓪&sfx: SfxStr;
  218. ⓪&exitCode: LONGINT;
  219. ⓪&result: LoaderResults;
  220. ⓪&res: PexecRes;
  221. ⓪&ok: BOOLEAN;
  222. ⓪ 
  223. ⓪"BEGIN (* hdlPexec *)
  224. ⓪$res.didExec:= FALSE;
  225. ⓪$res.exitCode:= 0;
  226. ⓪$fn:= par^.fileName;
  227. ⓪$IF par^.mode = loadExec (*trifft immer zu, da schon vorher geprüft*) THEN
  228. ⓪&IF (ProcessID^ = Desktop) & (BIOS.ControlKey IN BIOS.GetKBShift ()) THEN
  229. ⓪((* Das Laden ist nur vom Desktop aus erlaubt! *)
  230. ⓪(IF BIOS.LeftShift IN BIOS.GetKBShift () THEN
  231. ⓪*doUnLoadWithMsg (fn^)
  232. ⓪(ELSE
  233. ⓪*doLoadWithMsg (fn^)
  234. ⓪(END;
  235. ⓪(res.didExec:= TRUE
  236. ⓪&ELSE
  237. ⓪(IF GetHeapSize OR ProgramLoaded (fn^) THEN
  238. ⓪*(* hier normalerweise nur geladene Programme starten; nicht
  239. ⓪+* geladene Programme "normal" über GEMDOS starten lassen
  240. ⓪+* (s. 'hdlGemdos') *)
  241. ⓪*getArg (par^.arg, arg);
  242. ⓪*GotHeapSize:= TRUE;
  243. ⓪*CallProgram (fn^, arg, par^.env, exitCode);
  244. ⓪*res.exitCode:= SHORT (exitCode);
  245. ⓪*res.didExec:= TRUE
  246. ⓪(END
  247. ⓪&END;
  248. ⓪$END;
  249. ⓪$RETURN res
  250. ⓪"END hdlPexec;
  251. ⓪ 
  252. ⓪ VAR regStack: ARRAY [1..256] OF WORD; (* Stack für Register-Sicherung *)
  253. ⓪ 
  254. ⓪ PROCEDURE hdlGemdos;
  255. ⓪"(*$L-*)
  256. ⓪"BEGIN
  257. ⓪$ASSEMBLER
  258. ⓪(BTST.B  #5,(A7)         ; War Supervisormode aktiv ?
  259. ⓪(BNE.B   super           ; Ja, dann stehen Arg. auf SSP
  260. ⓪(MOVE.L  USP,A0
  261. ⓪(CMPI.W  #$4B,(A0)       ; Pexec - Funktion ?
  262. ⓪(BEQ.B   hdlPexecUser
  263. ⓪ dos     ; normale GEMDOS-Funktion ausführen
  264. ⓪(MOVE.L  entry,A0
  265. ⓪(MOVE.L  -4(A0),A0
  266. ⓪(JMP     (A0)
  267. ⓪ super   MOVE.W  stackFrameOffs,D0
  268. ⓪(CMPI.W  #$4B,6(A7,D0.W) ; Pexec - Funktion ?
  269. ⓪(BNE.B   dos             ; Nein -> GEMDOS aufrufen
  270. ⓪(LEA     6(A7,D0.W),A0   ; Basis d. Argumente nach A0
  271. ⓪ hdlPexecUser:
  272. ⓪(TST.W   doingPexec      ; ist dies der "Pexec" von "CallModule"?
  273. ⓪(BEQ     noPexec         ;   nein -> dann werten wir ihn selbst aus.
  274. ⓪ 
  275. ⓪(CLR.W   doingPexec
  276. ⓪(BRA     dos             ;   ja -> dann lassen wir ihn zum GEMDOS durch
  277. ⓪ 
  278. ⓪ noPexec ; prüfen, ob Prg gestartet & ausgeführt werden soll.
  279. ⓪(ADDQ.L  #2,A0
  280. ⓪(CMPI    #loadExec,PtrPexecPar.mode(A0)
  281. ⓪(BNE     dos
  282. ⓪ 
  283. ⓪(MOVE.L  stackhi,A1      ; neuen SP f. Modula-Funktionen laden
  284. ⓪(; Register auf regStack retten:
  285. ⓪(MOVEM.L D1-D7/A2-A6,-(A1)
  286. ⓪(MOVE.W  (A7)+,-(A1)     ; SR vom SSP retten
  287. ⓪(MOVE.L  (A7)+,-(A1)     ; PC vom SSP retten
  288. ⓪(TST.W   stackFrameOffs  ; StackFrame vorhanden?
  289. ⓪(BEQ     noSF1           ; nein
  290. ⓪(MOVE.W  (A7)+,-(A1)     ; StackFrame vom SSP retten
  291. ⓪ noSF1:  MOVE.L  USP,A2
  292. ⓪(MOVE.L  A2,-(A1)        ; USP retten
  293. ⓪(MOVE.L  A7,-(A1)        ; SSP retten
  294. ⓪(MOVE.L  A1,stackhi
  295. ⓪(MOVE.L  A1,USP          ; den regStack auch für Malloc-Aufruf nutzen
  296. ⓪(ANDI    #$CFFF,SR       ; User Mode aktivieren
  297. ⓪ 
  298. ⓪(; Stack f. Modula-Funktionen (Loader-Aufruf) reservieren
  299. ⓪(MOVE.L  A0,-(A7)
  300. ⓪(MOVE.L  #LoaderStackSize,-(A7)
  301. ⓪(MOVE    #$48,-(A7)      ; Malloc()
  302. ⓪(TRAP    #1
  303. ⓪(ADDQ.L  #6,A7
  304. ⓪(MOVE.L  (A7)+,A0
  305. ⓪(MOVE.L  D0,A3
  306. ⓪(LEA     LoaderStackSize(A3),A7
  307. ⓪ 
  308. ⓪(MOVE    #1,doingPexec
  309. ⓪(MOVE.L  A0,(A3)+
  310. ⓪(JSR     hdlPexec        ; Pexec-Sonderbehandlung
  311. ⓪(CLR.W   doingPexec
  312. ⓪(MOVE.L  -(A3),D0        ; Pexec - Rückgabewert
  313. ⓪ 
  314. ⓪(; Modula-Stack wieder freigeben
  315. ⓪(MOVE.L  stackhi,A7      ; regStack wieder für SP verwenden
  316. ⓪(MOVE.L  D0,-(A7)
  317. ⓪(MOVE.L  A3,-(A7)
  318. ⓪(MOVE    #$49,-(A7)      ; Mfree()
  319. ⓪(TRAP    #1
  320. ⓪(ADDQ.L  #6,A7
  321. ⓪(
  322. ⓪(; zurück in den Supervisor-Mode:
  323. ⓪(CLR.L   -(A7)
  324. ⓪(MOVE    #$20,-(A7)
  325. ⓪(TRAP    #1
  326. ⓪(ADDQ.L  #6,A7
  327. ⓪(MOVE.L  (A7)+,D0
  328. ⓪(
  329. ⓪(MOVE.L  A7,A1
  330. ⓪(MOVE.L  (A1)+,A7        ; SSP zurück
  331. ⓪(MOVE.L  (A1)+,A0        ; USP zurück
  332. ⓪(MOVE.L  A0,USP
  333. ⓪(TST.W   stackFrameOffs  ; StackFrame vorhanden?
  334. ⓪(BEQ     noSF2           ; nein
  335. ⓪(MOVE.W  (A1)+,-(A7)     ; StackFrame zurück
  336. ⓪ noSF2:  MOVE.L  (A1)+,-(A7)     ; PC zurück
  337. ⓪(MOVE.W  (A1)+,-(A7)     ; SR zurück
  338. ⓪(MOVEM.L (A1)+,D1-D7/A2-A6
  339. ⓪(MOVE.L  A1,stackhi
  340. ⓪ 
  341. ⓪(TST.W   D0
  342. ⓪(BEQ     dos             ; Wurde nicht ausgeführt -> GEMDOS aufrufen
  343. ⓪(
  344. ⓪(SWAP    D0              ; Exitcode liefern
  345. ⓪(EXT.L   D0
  346. ⓪(RTE
  347. ⓪$END
  348. ⓪"END hdlGemdos;
  349. ⓪"(*$L=*)
  350. ⓪ 
  351. ⓪ PROCEDURE readInfFile;
  352. ⓪"(*
  353. ⓪#* Liest die Datei "MODLOAD.INF" und lädt die darin angegebenen Module.
  354. ⓪#*)
  355. ⓪"
  356. ⓪"VAR f: File;
  357. ⓪&s, s2: Strings.String;
  358. ⓪&heapValid: BOOLEAN;
  359. ⓪&pos: CARDINAL;
  360. ⓪&heap: LONGCARD;
  361. ⓪&result: LoaderResults;
  362. ⓪"
  363. ⓪"BEGIN
  364. ⓪$s:= InfName;
  365. ⓪$ShellFind (s);
  366. ⓪$Open (f, s, readSeqTxt);
  367. ⓪$WHILE NOT EOF (f) DO
  368. ⓪&ReadFromLine (f, s);            (* Programmnamen einlesen *)
  369. ⓪&ReadLn (f);                     (* Zeilenende überlesen *)
  370. ⓪&Strings.Split (s, Strings.PosLen (' ', s, 0), s, s2, ok);
  371. ⓪&Strings.Upper (s);
  372. ⓪&pos:= 0;
  373. ⓪&heap:= StrToLCard (s2, pos, heapValid);
  374. ⓪&IF Strings.StrEqual (s, "HEAP") THEN
  375. ⓪(IF heapValid THEN DefaultHeap:= heap END
  376. ⓪&ELSE
  377. ⓪(IF NOT heapValid THEN heap:= DefaultHeap END;
  378. ⓪(LoadProgram (s, heap, result)   (* Programm laden *)
  379. ⓪&END
  380. ⓪$END;
  381. ⓪$Close (f);
  382. ⓪"END readInfFile;
  383. ⓪ 
  384. ⓪ PROCEDURE service;
  385. ⓪ 
  386. ⓪"VAR defbut, button: CARDINAL;
  387. ⓪&s: ARRAY [0..199] OF CHAR;
  388. ⓪&name: NameStr;
  389. ⓪&didShow, ok: BOOLEAN;
  390. ⓪ 
  391. ⓪"PROCEDURE showPrg (REF name: ARRAY OF CHAR; heapSize: LONGCARD;
  392. ⓪5noOfRuns: CARDINAL): BOOLEAN;
  393. ⓪$BEGIN
  394. ⓪&s:= "[0][ |";
  395. ⓪&Strings.Append (FileName (name), s, ok);
  396. ⓪&Strings.Append (" | |", s, ok);
  397. ⓪&IF noOfRuns > 0 THEN
  398. ⓪(Strings.Append ("Benutzte Heap-Größe: ", s, ok);
  399. ⓪(Strings.Append (CardToStr (heapSize, 0), s, ok);
  400. ⓪&ELSE
  401. ⓪(Strings.Append ("Wurde noch nicht gestartet", s, ok)
  402. ⓪&END;
  403. ⓪&Strings.Append (" | ][Weiter|Freigeben|Abbruch]", s, ok);
  404. ⓪&FormAlert (1, s, button);
  405. ⓪&IF button = 2 THEN
  406. ⓪(doUnLoadWithMsg (name)
  407. ⓪&END;
  408. ⓪&didShow:= TRUE;
  409. ⓪&RETURN button # 3
  410. ⓪$END showPrg;
  411. ⓪ 
  412. ⓪"BEGIN
  413. ⓪$IF GetHeapSize THEN
  414. ⓪&GetHeapSize:= FALSE;
  415. ⓪&IF NOT GotHeapSize THEN
  416. ⓪(Alert ('Sie haben doch noch kein Programm gestartet, oder?')
  417. ⓪&ELSIF UsedHeapSize = MAX (LONGCARD) THEN
  418. ⓪(Alert ('Das Programm scheint allen verfügbaren Speicher zu belegen')
  419. ⓪&ELSIF UsedHeapSize = 0 THEN
  420. ⓪(Alert ('Das Programm belegt keinen zusätzlichen Heap (Größe ist 0)')
  421. ⓪&ELSE
  422. ⓪(s:= 'Die belegte Heap-Größe ist:';
  423. ⓪(Strings.Append (CardToStr (UsedHeapSize,0), s, ok);
  424. ⓪(Alert (s)
  425. ⓪&END
  426. ⓪$END;
  427. ⓪$defbut:= 1;
  428. ⓪$LOOP
  429. ⓪&s:= "[0][         PrgLoad "+Version+"|"
  430. ⓪-+" |"
  431. ⓪-+"Erstellt von Thomas Tempelmann |"
  432. ⓪-+"     mit Megamax Modula-2|"
  433. ⓪-+"  für das TOS-Magazin (4/91)]"
  434. ⓪-+"[Mehr...|Info|Ausgang]";
  435. ⓪&IF NOT DidShowInfo THEN
  436. ⓪(defbut:= 2
  437. ⓪&END;
  438. ⓪&FormAlert (defbut, s, button);
  439. ⓪&IF button = 3 THEN
  440. ⓪(EXIT
  441. ⓪&ELSIF button = 2 THEN
  442. ⓪(FormAlert (1, "[0][Autor:      |  Thomas Tempelmann  |"
  443. ⓪3+"  Nordendstraße 64|  D-8000 München 40|  West Germany]"
  444. ⓪3+"[ OK ]", button);
  445. ⓪(Alert ("Ausführliche Informationen zu diesem Programm finden Sie "
  446. ⓪.+"im TOS-Magazin Ausgabe 4/91.");
  447. ⓪(DidShowInfo:= TRUE
  448. ⓪&ELSE (* button = 1 *)
  449. ⓪(s:=  "[0][ |Wählen Sie:| Geladene Programme zeigen |"
  450. ⓪,+" Heap-Größe ermitteln/setzen| ";
  451. ⓪(IF ProcessID^ = Desktop THEN
  452. ⓪*(* Das Laden ist nur vom Desktop aus erlaubt! *)
  453. ⓪*Strings.Append ("Programm laden", s, ok)
  454. ⓪(END;
  455. ⓪(Strings.Append ("][ Zeige | Heap ", s, ok);
  456. ⓪(IF ProcessID^ = Desktop THEN
  457. ⓪*Strings.Append ("| Lade ", s, ok)
  458. ⓪(END;
  459. ⓪(Strings.Append ("]", s, ok);
  460. ⓪(FormAlert (1, s, button);
  461. ⓪(IF button = 3 THEN
  462. ⓪*name:= '';
  463. ⓪*GetDefaultPath (path);
  464. ⓪*SelectFile (path, name, ok);
  465. ⓪*IF ok & (name[0] # '') THEN
  466. ⓪,doLoadWithMsg (PathConc (path, name));
  467. ⓪*END
  468. ⓪(ELSIF button = 1 THEN
  469. ⓪*didShow:= FALSE;
  470. ⓪*QueryLoaded (showPrg);
  471. ⓪*IF NOT didShow THEN
  472. ⓪,Alert ("Es ist kein Programm geladen")
  473. ⓪*END
  474. ⓪(ELSE
  475. ⓪*FormAlert (1, "[0][ |Wählen Sie:|"
  476. ⓪=+" Benutzte Heap-Größe eines |"
  477. ⓪=+"   Programm ermitteln|"
  478. ⓪=+" Heap-Größe setzen| ]"
  479. ⓪=+"[Ermitteln|Setzen]", button);
  480. ⓪*IF button = 1 THEN
  481. ⓪,Alert ("Starten Sie ein Programm und kehren Sie dann zurück");
  482. ⓪,GotHeapSize:= FALSE;
  483. ⓪,GetHeapSize:= TRUE;
  484. ⓪,RETURN
  485. ⓪*ELSE
  486. ⓪,LOOP
  487. ⓪.s:= "[0][Voreingestellte Heap-Größe|"
  488. ⓪1+"zum Laden eines Programms: | |";
  489. ⓪.Strings.Append (CardToStr (DefaultHeap, 15), s, ok);
  490. ⓪.Strings.Append ("| ][Mehr|Weniger|OK]", s, ok);
  491. ⓪.FormAlert (3, s, button);
  492. ⓪.IF button = 1 THEN
  493. ⓪0DefaultHeap:= DefaultHeap + DefaultHeap DIV 2
  494. ⓪.ELSIF button = 2 THEN
  495. ⓪0DefaultHeap:= DefaultHeap - DefaultHeap DIV 3
  496. ⓪.ELSE
  497. ⓪0EXIT
  498. ⓪.END
  499. ⓪,END
  500. ⓪*END
  501. ⓪(END
  502. ⓪&END;
  503. ⓪&defbut:= 3
  504. ⓪$END (* LOOP *)
  505. ⓪"END service;
  506. ⓪ 
  507. ⓪ VAR msg: MessageBuffer;
  508. ⓪$menuID: CARDINAL;
  509. ⓪$button: CARDINAL;
  510. ⓪ 
  511. ⓪ BEGIN
  512. ⓪"InitApplication (ok);
  513. ⓪"IF NOT Accessory () THEN
  514. ⓪$Alert ('PrgLoad läuft nur als Accessory!')
  515. ⓪"ELSE
  516. ⓪$doingPexec:= FALSE;
  517. ⓪$DefaultHeap:= 8192;    (* Heap-Größe, wenn keine andere Angabe *)
  518. ⓪$GetHeapSize:= FALSE;
  519. ⓪$DidShowInfo:= FALSE;
  520. ⓪$IF UseStackFrame () THEN stackFrameOffs:= 2 ELSE stackFrameOffs:= 0 END;
  521. ⓪$Desktop:= ProcessID^;
  522. ⓪$(* 'hdlGemdos' in TRAP #1 einhängen *)
  523. ⓪$IF NOT XBRA.Installed (Kennung, $84 (* GEMDOS/TRAP#1 *), at) THEN
  524. ⓪&XBRA.Create (carrier, Kennung, CAST (ADDRESS, hdlGemdos), entry);
  525. ⓪&XBRA.Install (entry, at);
  526. ⓪&stackhi:= ADR (regStack) + SIZE (regStack);
  527. ⓪&myName:= PrgName;
  528. ⓪&Strings.Insert ('  ', 0, myName, ok);
  529. ⓪&RegisterAcc (ADR (myName), menuID , ok);
  530. ⓪&UpdateWindow (TRUE);
  531. ⓪&readInfFile;
  532. ⓪&UpdateWindow (FALSE);
  533. ⓪&LOOP
  534. ⓪(MessageEvent (msg);
  535. ⓪(IF (msg.msgType = accOpen) THEN
  536. ⓪*service
  537. ⓪(END
  538. ⓪&END
  539. ⓪$END
  540. ⓪"END
  541. ⓪ END PrgLoad.
  542. ⓪ ə
  543. (* $FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$000032B5$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DA$FFE9E9DAÇ$000034EBT.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$FFED9C90$FFED9C90$00003311$0000331E$0000332D$00003298$000032B2$0000331B$00002FFC$00002F9B$000034E9$000034D0$000034EB$0000309E$000032EC$000032D4ÕÇé*)
  544.