home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / DIV / MM2LINK.M < prev    next >
Encoding:
Text File  |  1995-01-09  |  79.5 KB  |  3 lines
  1. ⓪ MODULE MM2Link; (*$Z+,M+,C-,Q+,P+,V+,R-*)
  2. ⓪ 
  3. ⓪ (*
  4. ⓪ IMPORT TOSDebug;
  5. ⓪ *)
  6. ⓪ 
  7. ⓪ (*
  8. ⓪!* Format der Argumentzeile beim Aufruf:
  9. ⓪!*   MM2LINK codename {-M|-V|-H|-F|-0|-1|-2|
  10. ⓪!*                     -Oprgname|-Rmaxreloc|-Sargs|-Iargs|
  11. ⓪!*                     -Ddatasize|-Ddatafile}
  12. ⓪!*)
  13. ⓪ 
  14. ⓪ (* Copyright (c) 1985 Juergen Mueller, 1986 Thomas Tempelmann
  15. ⓪ * V#0684
  16. ⓪ *
  17. ⓪ * 08.12.85 : Juergen Mueller : Grundversion 1.0
  18. ⓪ * 27.06.86 : TT              : Atari-Relozier-vers 1.0
  19. ⓪ * 21.07.86 : TT              : Atari-Relozier-vers 1.1 (schneller)
  20. ⓪ * 21.07.86 : TT              : V1.1 lauffähig für Atari
  21. ⓪ * 23.07.86 : TT              : V1.2 mit untersch. Suffixe f. Impl/Prg
  22. ⓪ * 24.10.86 : TT              : V1.3 Fehler in ImportLen behoben; Initmodul
  23. ⓪ *                              wird mit eingelinkt; ModLst wird abgelegt f.
  24. ⓪ *                              Loader; HeadSkip raus
  25. ⓪ * 27.10.86 : TT              : V1.4 neuer name: 'prginint.mod';
  26. ⓪ * 08.02.87 : TT              : V1.5, ShortModLst wird anders abgelegt.
  27. ⓪ * 11.02.87 : TT              : V1.6, SysVarSpace erweitert
  28. ⓪ * 01.03.87 : TT              : V1.7, Exportliste f. Vars nun richtig
  29. ⓪ * 09.05.87 : TT              : V1.8, Disk full wird erkannt
  30. ⓪ * 23.05.87 : TT              : V1.9, layout-Kennungen für REAL-Mode ausgewertet
  31. ⓪ * 24.05.87 : TT              : Umstellung auf MOS
  32. ⓪ * 06.06.87 : TT              : V1.10 Fehleranzeige, wenn Relocate() schiefgeht
  33. ⓪ * 07.06.87 : TT              : V1.11 Init-Prg darf importieren
  34. ⓪ * 11.06.87 : TT              : V1.12 Init-Mod erscheint nicht in ShModLst,
  35. ⓪ *                              dafür endlich letztes Modul.
  36. ⓪ * 14.06.87 : TT              : V1.13 ShModLst erweitert
  37. ⓪ * 17.06.87 : TT              : V1.14 Nur ein Main-Mod geht jetzt auch richtig.
  38. ⓪ * 19.06.87 : TT              : V1.15 Init-Aufrufe korrigiert
  39. ⓪ * 21.07.87 : TT              : V1.16 Modnames: nur erste 8 Zeichen signifikant
  40. ⓪ * 25.07.87 : TT              : V1.17 PDB um savedSSP,savedSR erweitert
  41. ⓪ * 30.08.87 : TT              :       Dateinamen besser behandelt, Codename wird
  42. ⓪ *                                    korrekt aus Modulcode geholt.
  43. ⓪ * 09.09.87 : TT              : V1.19 Stacksize bestimmbar
  44. ⓪ * 26.10.87 : TT              : V1.20 ShModLst: VarAd wird auch reloziert.
  45. ⓪ * 02.11.87 : MCH / TT        : V1.21 Accessory-fähig, geänd. Layout f. Init-Prg
  46. ⓪ * 04.11.87 : TT              : V1.22 Mehrere (>2) Moduln linkbar.
  47. ⓪ * 16.01.88 : TT              : V1.24 'sourceName' jetzt groß genug; ShModLst
  48. ⓪ *                                    erweitert.
  49. ⓪ * 22.01.88 : TT              : V1.25 Main-Mods werden auf ImpPath gesucht
  50. ⓪ * 29.05.88 : TT              : V2.0  Mal eben den Optimierer eingebaut;
  51. ⓪ *                                    Beim Linken v. 'MOS' o. 'MTP'-Moduln wird
  52. ⓪ *                                    automatisch der 'TOS' o. 'TTP' Suffix
  53. ⓪ *                                    verwendet.
  54. ⓪ * 07.06.88 : TT              :       Variablen-Importe werden beim Optimieren
  55. ⓪ *                                    auch berücksichtigt und ggf. ganze Module
  56. ⓪ *                                    wegoptimiert.
  57. ⓪ * 08.06.88 : TT              :       '-S' Option, um Shell zu linken (ProcSyms
  58. ⓪ *                                    werden entfernt). ProcSyms werden mit kor-
  59. ⓪ *                                    rigiert beim Optimieren.
  60. ⓪ * 10.06.88 : TT              :       ProcSyms bei lokalen Procs werden nicht
  61. ⓪ *                                    entfernt.
  62. ⓪ * 27.06.88 : TT              : V2.1  Wegoptimierte Module werden auf Bildschirm
  63. ⓪ *                                    vorm Relocate gelöscht.
  64. ⓪ * 14.07.88 : TT              : V2.2  Linken ohne Init-Mod lädt Hauptmod nicht
  65. ⓪ *                                    mehr doppelt.
  66. ⓪ * 29.07.88 : TT              :       Beim Linken von Mods mit und ohne Opti-
  67. ⓪ *                                    mierdaten wird Fehler angezeigt.
  68. ⓪ * 09.07.89 : TT              : V2.3  Relozieren etwas beschleunigt
  69. ⓪ * 10.07.89 : TT              :       Beim TW.Open nun 'noForce' statt
  70. ⓪ *                                    'forceCursor', weil sonst Löschen von opt.
  71. ⓪ *                                    Modulen falsch war (liegt an GotoXY in
  72. ⓪ *                                    TextWindows).
  73. ⓪ *                                    Option f. 'noProcSyms' nun "-M" statt "-S".
  74. ⓪ *                                    Optimierung bezgl. 'useCode' verbessert.
  75. ⓪ * 06.08.89 : TT              : V2.4  In ShellMsg.MaxLinkMod kann Anzahl der
  76. ⓪ *                                    linkbaren Module bestimmt werden.
  77. ⓪ * 17.08.89 : TT              : V2.5  Fehler v. 2.4 (Bus-Error b. Reloc) behoben
  78. ⓪ * 21.08.89 : TT              : V2.6  Neues Layout, neue ShortModList,
  79. ⓪ *                                    $B- erlaubt Entfernung des Body beim
  80. ⓪ *                                    selektiven Linken
  81. ⓪ * 31.08.89 : TT              : V2.7  .MAC als Endung f. ACCs
  82. ⓪ * 09.10.89 : TT              :       Proc-Verkettung und CodeStart (offset 42)
  83. ⓪ *                                    werden bezgl. Diff korrig.
  84. ⓪ * 19.02.90 : TT              :  2.8  Fastload-Bit wird immer gesetzt
  85. ⓪ * 28.02.90 : TT              :       Real-Format wird berücksichtigt, Real-Form
  86. ⓪ *                                    & ExtendedCode werden in PDB eingetragen,
  87. ⓪ *                                    MM2LnkIO übernimmt Ein-/Ausgaben
  88. ⓪ *                                    Mit Ctrl-Tastebeim Bestätigen eines Real-
  89. ⓪ *                                    Format-Fehlers wird dieser ignoriert.
  90. ⓪ * 14.03.90 : TT              :  2.9  Var-Adr wird wieder richtig in ShModList
  91. ⓪ *                                    eingetragen (BSSstart addiert);
  92. ⓪ *                                    Deutlich kürzere ShModLst wird erzeugt,
  93. ⓪ *                                    da restliche Daten auch aus verbleibendem
  94. ⓪ *                                    Header ermittelt werden können.
  95. ⓪ * 16.05.90 : TT              :  2.10 CodeID wird in Code eingefügt
  96. ⓪ * 16.07.90 : TT              :  2.11 Importliste wird mit übergeben; 1. Modul
  97. ⓪ *                                    (meist M2Init) wird auch in ShModList
  98. ⓪ *                                    eingetragen; mainMod werden markiert;
  99. ⓪ *                                    Format der RealFormat-Übergabe verändert.
  100. ⓪ * 18.08.90 : TT              :       Output-Name ersetzt HomeSymbol
  101. ⓪ * 04.09.90 : TT              :  2.12 PrgHeader-Flags über Argzeile bestimmbar.
  102. ⓪ * 07.10.90 : MCH             :  2.13 Anpassung an neues 'ShellMsg'
  103. ⓪ * 11.10.90 : TT              :  2.14 Neue Real-Kennungen ausgewertet
  104. ⓪ * 25.03.91 : TT              :  2.15 "-R" erlaubt Angabe der RelocTab-Größe
  105. ⓪ * 01.03.91 : M.Seyfried (MS) :       RelRelocTab von 'MM2CLink' ausgewertet.
  106. ⓪ * 25.04.91 : TT              :  2.16 Korrektur dialog/Relocate wg. ALLOCATEs,
  107. ⓪ *                                    führte zu "Out of memory" bei 4 MB.
  108. ⓪ * 03.05.91 : TT              :  2.17 Neue Fehlermeldung "Reloc. table overflow"
  109. ⓪ * 01.08.91 : TT/MS           :  2.18 Korrektur f. MM2CLink v. MS
  110. ⓪ * 16.10.91 : TT              :  2.19 Protokoll/MAP-File
  111. ⓪ * 28.11.92 : TT              :  2.20 InitList-Output (Option -I)
  112. ⓪ * 28.12.93 : TT              :  2.30 Konstanten hinter Code berücksichtigt, aber
  113. ⓪ *                                    noch kein eigenes DATA-Segment.
  114. ⓪ * 14.01.94 : TT              :  2.31 "-D" für DATA-Segment-Erzeugung
  115. ⓪ * 26.09.94 :                 :  2.32 s. Notiz zum Datum.
  116. ⓪ * 09.01.95 : TT              :  2.33 Abfrage auf Proc-Länge=0, damit keine End-
  117. ⓪ *                                    losschleife beim Opt. entsteht (getProcs).
  118. ⓪ *)
  119. ⓪ 
  120. ⓪ FROM SYSTEM IMPORT ASSEMBLER, ADDRESS, WORD, BYTE, ADR, TSIZE, LONGWORD, CAST;
  121. ⓪ FROM SysTypes IMPORT PtrAnyLongType;
  122. ⓪ FROM ArgCV     IMPORT PtrArgStr, InitArgCV;
  123. ⓪ FROM Storage   IMPORT ALLOCATE, DEALLOCATE, MemAvail;
  124. ⓪ FROM Strings   IMPORT Upper, Concat, Compare, Relation, Pos, Empty,
  125. ⓪7StrEqual, Split, Assign, Copy, PosLen, String, Append;
  126. ⓪ IMPORT FastStrings;
  127. ⓪ FROM Files IMPORT Open, Create, Access, Close, Remove, FILE, ReplaceMode,
  128. ⓪(State, ResetState;
  129. ⓪ FROM Paths IMPORT SearchFile, ListPos;
  130. ⓪ FROM PathEnv IMPORT ReplaceHome, HomePath;
  131. ⓪ FROM PathCtrl IMPORT PathList;
  132. ⓪ FROM Directory IMPORT MakeFullPath;
  133. ⓪ FROM FileNames IMPORT SplitPath, SplitName, ConcatName, ConcatPath,
  134. ⓪(FileSuffix;
  135. ⓪ FROM Binary IMPORT ReadBytes, WriteBytes, Seek, SeekMode, FileSize, WriteBlock;
  136. ⓪ FROM ShellMsg IMPORT ModPaths, ImpPaths, LLRange, ShellPath, LinkerParm;
  137. ⓪ FROM MOSCtrl IMPORT PDB;
  138. ⓪ FROM PrgCtrl IMPORT TermProcess;
  139. ⓪ FROM MOSConfig IMPORT DftSfx, ImpSfx, MaxBlSize;
  140. ⓪ IMPORT MOSGlobals, StrConv, Block;
  141. ⓪ FROM MM2LnkIO IMPORT ClearEOP, Report, Prompt, InitOutput, VerboseOutput,
  142. ⓪(Read, ReadString, WriteString, WriteMod,
  143. ⓪(ClearMod, DiscardMods, ReportRealFormat, BeginWriting, ReportCodeLen,
  144. ⓪(ReportLinkError, ReportIOError, ReportError, WritingOut, EndWriting,
  145. ⓪(MaxSymbolLen, ModList, ModDesc, SymbolEntry, SymbolList, LongSet,
  146. ⓪(OutputInitList, OutputSymbols;
  147.  
  148. ⓪ CONST PDBlayout = 4;
  149. ⓪&version = '2.33';    (* Linker-Version *)
  150. ⓪&CodeID = "Megamax Modula-2 V2";
  151. ⓪ 
  152. ⓪ (*
  153. ⓪!* Komprimierendes Verfahren beim nicht-vollständigen Optimieren:
  154. ⓪!*
  155. ⓪!*   Um z.B. bei der Shell Speicher zu gewinnen, wird im Prinzip
  156. ⓪!* der nach der Init-Phase nicht mehr benötigte Speicher freigegeben.
  157. ⓪!* Das wären z.B:
  158. ⓪!*   - die ShortModList, die nur vom Linker an ModBase
  159. ⓪!*     übergeben wird;
  160. ⓪!*   - alle Bodies und Hilfsroutinen, die nur vom Body
  161. ⓪!*     benutzt und nicht exportiert werden.
  162. ⓪!*
  163. ⓪!*)
  164. ⓪ 
  165. ⓪ VAR ok: BOOLEAN;
  166. ⓪ 
  167. ⓪ 
  168. ⓪ PROCEDURE conc (a,b:ARRAY OF CHAR):String;
  169. ⓪"VAR c:String;
  170. ⓪"BEGIN
  171. ⓪$concat (a,b,c,ok);
  172. ⓪$RETURN c
  173. ⓪"END conc;
  174. ⓪ 
  175. ⓪ 
  176. ⓪ CONST
  177. ⓪ 
  178. ⓪"SysVarSpace = 52;        (* layout,
  179. ⓪>^basePage (f. ArgV),
  180. ⓪>^modList (f. Loader),
  181. ⓪>Anzahl der Einträge in modLst,
  182. ⓪>processState,
  183. ⓪>BottomOfStack,
  184. ⓪>TopOfStack,
  185. ⓪>termState,
  186. ⓪>resident,
  187. ⓪>flags,
  188. ⓪>TermProcs,
  189. ⓪>^prev,
  190. ⓪>16 reserved bytes *)
  191. ⓪ 
  192. ⓪"ShModLstSpace = 14;      (* head0: ADDRESS;
  193. ⓪>var0: ADDRESS;
  194. ⓪>varlen0: LONGCARD;
  195. ⓪>flags: BITSET; *)
  196. ⓪ 
  197. ⓪(ESC = 33C;
  198. ⓪ 
  199. ⓪%BadIndex = 1000;
  200. ⓪'anykey = 0L;        (* Joker fuer Modul-Key *)
  201. ⓪$DefOutSuf = '.PRG';    (* Suffix f. Output, wenn keiner angegeben *)
  202. ⓪ 
  203. ⓪ VAR DefImpInSuf: ARRAY [0..2] OF CHAR; (* Suffix fuer Input Impl. Files *)
  204. ⓪$DefPrgInSuf: ARRAY [0..2] OF CHAR; (* Suffix fuer Input Main Files *)
  205. ⓪ 
  206. ⓪&ListMax: CARDINAL;   (* ehemals konstant 1000 *)
  207. ⓪ 
  208. ⓪ TYPE
  209. ⓪'tIndex = [0..BadIndex];  (* Index auf die Modul-Liste; BadIndex
  210. ⓪Ckodiert Sonderfaelle: kein gueltiger
  211. ⓪CIndex bzw. residentes Modul *)
  212. ⓪%tModName = string;
  213. ⓪ 
  214. ⓪%ptrModDesc = POINTER TO tModDesc;
  215. ⓪%tModDesc = RECORD
  216. ⓪2image: address;    (* ^Buffer beim Relozieren *)
  217. ⓪1codeAd: address;    (* StartAdr im ROM *)
  218. ⓪2varAd: address;    (* StartAdr der Variablen *)
  219. ⓪0codeEnd: LONGCARD;   (* entspr. Beginn der DATAs *)
  220. ⓪0dataEnd: LONGCARD;   (* Ende v. DATA+Code *)
  221. ⓪/varStart: LONGCARD;   (* Start der Variablen im Modul *)
  222. ⓪1varLen: LONGCARD;   (* Länge der Variablen *)
  223. ⓪3diff: longcard;   (* Laenge der entfernten Imp.Liste *)
  224. ⓪4key: longcard;   (* Key dieses Moduls *)
  225. ⓪1modlen: longcard;   (* Code-Länge dieses Moduls *)
  226. ⓪-sourcename: ARRAY [0..11] OF CHAR;
  227. ⓪-symbolname: ARRAY [0..11] OF CHAR;
  228. ⓪/codename: ARRAY [0..99] OF CHAR;
  229. ⓪3name: ARRAY [0..39] OF CHAR;  (* ModulName *)
  230. ⓪-symbolRoot: SymbolList;
  231. ⓪0procSym: BOOLEAN;
  232. ⓪/compopts: LongSet;
  233. ⓪.mayRemove: BOOLEAN;    (* FALSE: Body keinesfalls wegoptimieren!*)
  234. ⓪0mainMod: BOOLEAN;    (* FALSE: ist'n importiertes Modul *)
  235. ⓪.mayCrunch: BOOLEAN;    (* TRUE: Proc-Length-Liste vorhanden *)
  236. ⓪/crunched: BOOLEAN;
  237. ⓪+varsExported: BOOLEAN;    (* TRUE: Vars werden v. anderen Mods importiert *)
  238. ⓪0useCode: BOOLEAN;    (* FALSE: Modulcode wird nicht gebraucht *)
  239. ⓪-bodyMarked: BOOLEAN;
  240. ⓪1ImpLst: POINTER TO ARRAY tIndex OF tIndex; (* Liste der imp. Module *)
  241. ⓪/ImpIndex: tIndex;                 (* Anzahl imp. Module *)
  242. ⓪/finalIdx: tIndex;  (* Index für ModBase *)
  243. ⓪/END;
  244. ⓪ 
  245. ⓪$ErrType   = (NotFound, BadFormat, BadVersion, NoSpace, TooManyMods,
  246. ⓪1mustnotbeimpl, badlayout, readerr, relocerr, nooptimize,
  247. ⓪1badReal);
  248. ⓪0
  249. ⓪(pLONG = POINTER TO LONGCARD;
  250. ⓪ 
  251. ⓪ VAR
  252. ⓪'ModLst: POINTER TO ARRAY tIndex OF tModDesc;  (* Liste der geladenen Module *)
  253. ⓪%ModIndex: tIndex;                    (* ^ letzten Eintrag in ModLst *)
  254. ⓪$UsedCodes: tIndex;                    (* Anzahl der verw. Modulcodes *)
  255. ⓪&InitLst: POINTER TO ARRAY tIndex OF tIndex;    (* Liste der Init-Reihenfolge *)
  256. ⓪$InitIndex: tIndex;                    (* ^ letzten Eintrag in InitLst *)
  257. ⓪%InitIdx2: tIndex;                    (* ^ auf Second-Mod - InitLst *)
  258. ⓪$UsedInits: tIndex;                    (* Anzahl der zu init. Bodies *)
  259. ⓪ 
  260. ⓪&outName: string;                    (* Name des Codefiles *)
  261. ⓪!DATAFileName: String;
  262. ⓪#CodeSuffix: boolean;
  263. ⓪"LoadingMain: BOOLEAN;
  264. ⓪%IOResult,
  265. ⓪*ior: INTEGER;                   (* ZW fuer IOResults *)
  266. ⓪ 
  267. ⓪%LoadFile,                            (* geladene Module *)
  268. ⓪&OutFile: file;                      (* zu schreibendes Codefile *)
  269. ⓪ 
  270. ⓪%protocol: BOOLEAN;
  271. ⓪%initList: BOOLEAN;
  272. ⓪$symbolBuf: ADDRESS;
  273. ⓪$symBufEnd: ADDRESS;
  274. ⓪#symBufHead: ADDRESS;
  275. ⓪#symBufSize: LONGINT;
  276. ⓪#symBufFact: LONGCARD;
  277. ⓪"
  278. ⓪&DATALen: LONGINT;
  279. ⓪$DATAstart,
  280. ⓪%BSSstart: LONGCARD;                  (* Start-Adr fuer reloz. Vars *)
  281. ⓪&CodeNow,                            (* ^ zu vergebenden Codeplatz *)
  282. ⓪'VarNow: address;                   (* ^ zu vergebenden Varplatz *)
  283. ⓪"ShModLstLen: Longcard;                  (* Ges.länge der ModLst f.d. Loader *)
  284. ⓪$stacksize: LONGCARD;
  285. ⓪%initOffs: LONGCARD;                  (* rel. Adr. des Init-Einsprungs *)
  286. ⓪ 
  287. ⓪&BodyLen: LONGCARD;                  (* testweise f. Länge aller Bodies *)
  288. ⓪"
  289. ⓪&pRelTab,
  290. ⓪&eRelTab,
  291. ⓪%RelocTab: ADDRESS;
  292. ⓪!firstRelVal : longcard;
  293. ⓪"lastRelVal : longcard;
  294. ⓪!
  295. ⓪&dt_buf : RECORD   (* disk transfer buffer *)
  296. ⓪1dum0 : ARRAY [1..13] OF word;
  297. ⓪1flen : LONGCARD;
  298. ⓪1dum1 : ARRAY [16..22] OF word
  299. ⓪/END;
  300. ⓪&
  301. ⓪%singleMod: BOOLEAN;
  302. ⓪%
  303. ⓪)paths: PathList;
  304. ⓪ 
  305. ⓪&optProcs: BOOLEAN;  (* TRUE: Procs optimieren *)
  306. ⓪&noHeader: BOOLEAN;  (* TRUE: Header aus Moduln entfernen *)
  307. ⓪$noShModLst: BOOLEAN;  (* TRUE: ShortModList aus Moduln entfernen *)
  308. ⓪$noProcSyms: BOOLEAN;  (* TRUE: ProcSymbols vor Prozeduren entfernen *)
  309. ⓪ 
  310. ⓪"extendedCode: BOOLEAN;
  311. ⓪&realForm: CARDINAL;
  312. ⓪ 
  313. ⓪#HeaderFlags: BITSET;
  314. ⓪ 
  315. ⓪ 
  316. ⓪ PROCEDURE fputm ( f:file; VAR p:ARRAY OF word; c:LONGCARD );
  317. ⓪"BEGIN
  318. ⓪$WriteBytes (f, ADR (p), c);
  319. ⓪"END fputm;
  320. ⓪ 
  321. ⓪ 
  322. ⓪ PROCEDURE fput ( f:file; REF p: ARRAY OF BYTE );
  323. ⓪"BEGIN
  324. ⓪$IF NOT ODD (HIGH (p)) THEN HALT END;
  325. ⓪$WriteBlock (f, p);
  326. ⓪"END fput;
  327. ⓪ 
  328. ⓪ 
  329. ⓪ PROCEDURE hasSuffix (s: string): boolean;
  330. ⓪"VAR p: cardinal;
  331. ⓪"BEGIN
  332. ⓪$RETURN length (FileSuffix (s)) > 0;
  333. ⓪$(* in den letzten 4 Zeichen von s muss ein Punkt stehen! *)
  334. ⓪"END hasSuffix;
  335. ⓪ 
  336. ⓪ 
  337. ⓪ PROCEDURE entry (Index: address; Displacement: LONGCARD): LongCard;
  338. ⓪"(*** Long-Peek mit Displacement ***)
  339. ⓪"(*$L-*)
  340. ⓪"BEGIN
  341. ⓪$ASSEMBLER
  342. ⓪(MOVE.L  -(A3),A0
  343. ⓪(ADDA.L  -(A3),A0
  344. ⓪(MOVE.L  (A0),D0
  345. ⓪$END
  346. ⓪"END entry;
  347. ⓪"(*$L=*)
  348. ⓪ 
  349. ⓪ 
  350. ⓪ PROCEDURE enter (Index: address; Displacement: cardinal; value: LongCard);
  351. ⓪"(*** Long-Poke mit Displacement ***)
  352. ⓪"VAR p: POINTER TO LongCard;
  353. ⓪"BEGIN
  354. ⓪$p:= Index + address (long (Displacement));
  355. ⓪$p^:= value;
  356. ⓪"END enter;
  357. ⓪ 
  358. ⓪ 
  359. ⓪ PROCEDURE error (client, impmod: ARRAY OF CHAR; t: ErrType);
  360. ⓪ 
  361. ⓪"(*** Fehleranzeige auf dem Bildschirm; danach zurueck zum Aufrufer ***)
  362. ⓪"
  363. ⓪"VAR msg: String;
  364. ⓪"
  365. ⓪"BEGIN
  366. ⓪$CASE t OF
  367. ⓪+badReal: msg:= 'Different real-formats specified'; client[0]:= 0C |
  368. ⓪(badversion: msg:= 'Wrong module version' |
  369. ⓪)badformat: msg:= 'Wrong module format'; client[0]:= 0C |
  370. ⓪*notfound: msg:= 'Module not found'; client[0]:= 0C |
  371. ⓪+readerr: msg:= 'File is damaged'; client[0]:= 0C |
  372. ⓪+nospace: msg:= 'Out of memory'; client[0]:= 0C |
  373. ⓪'toomanymods: msg:= 'Too many modules (enlarge "max. Module")'; client[0]:= 0C|
  374. ⓪%mustnotbeimpl: msg:= 'Init-module must be program module'; client[0]:= 0C|
  375. ⓪)badlayout: msg:= 'Bad module layout'; client[0]:= 0C|
  376. ⓪*relocerr: msg:= 'Error in relocation list'; client[0]:= 0C|
  377. ⓪(nooptimize: msg:= 'Old module layout - may not be optimized'; client[0]:= 0C|
  378. ⓪$END; (* of case *)
  379. ⓪$ReportLinkError (impmod, client, msg)
  380. ⓪"END error;
  381. ⓪ 
  382. ⓪ 
  383. ⓪ PROCEDURE MyError (ior: integer);
  384. ⓪"BEGIN
  385. ⓪$ReportIOError (ior)
  386. ⓪"END MyError;
  387. ⓪ 
  388. ⓪ PROCEDURE RelError0 (REF s: ARRAY OF CHAR);
  389. ⓪"BEGIN
  390. ⓪$ReportError (s);
  391. ⓪$Remove (outfile);
  392. ⓪$TermProcess (MOSGlobals.OutOfMemory)
  393. ⓪"END RelError0;
  394. ⓪ 
  395. ⓪ PROCEDURE RelError (internalErr: BOOLEAN);
  396. ⓪"VAR s: String;
  397. ⓪"BEGIN
  398. ⓪$s:= 'Out of memory!';
  399. ⓪$IF internalErr THEN Append (' (internal error!)', s, ok) END;
  400. ⓪$RelError0 (s);
  401. ⓪"END RelError;
  402. ⓪ 
  403. ⓪ PROCEDURE RelError2;
  404. ⓪"BEGIN
  405. ⓪$RelError0 ('Relocation table overflow! Use "-R" option.');
  406. ⓪"END RelError2;
  407. ⓪ 
  408. ⓪ 
  409. ⓪ PROCEDURE GetStr (VAR p: address): tModName;
  410. ⓪"(* String aus der Importliste holen *)
  411. ⓪"VAR s: tModName;
  412. ⓪"BEGIN
  413. ⓪$ASSEMBLER
  414. ⓪,MOVE.L  p(A6),A1       ;Adresse von p
  415. ⓪,MOVE.L  (A1),A2        ;Wert von p
  416. ⓪,LEA     s(A6),A0
  417. ⓪%!RE13  MOVE.B  (A2)+,D2       ;Zeichen holen
  418. ⓪,CMPI.B  #$FE,D2
  419. ⓪,BCC     RE12           ; -> Endmarke
  420. ⓪,MOVE.B  D2,(A0)+
  421. ⓪,BRA     RE13
  422. ⓪%!RE12  BNE     RE14
  423. ⓪,ADDQ.L  #1,A2
  424. ⓪%!RE14  CLR.B   (A0)+
  425. ⓪,MOVE.L  A2,(A1)        ;p hochsetzen
  426. ⓪$END;
  427. ⓪$RETURN s
  428. ⓪"END GetStr;
  429. ⓪ 
  430. ⓪ PROCEDURE SkipStr (VAR p: address);
  431. ⓪"(* String aus der Importliste überspringen *)
  432. ⓪"(*$L-*)
  433. ⓪"BEGIN
  434. ⓪$ASSEMBLER
  435. ⓪,MOVE.L  -(A3),A1       ;Adresse von p
  436. ⓪,MOVE.L  (A1),A2        ;Wert von p
  437. ⓪%!RE13  CMPI.B  #$FF,(A2)+
  438. ⓪,BNE     RE13
  439. ⓪,MOVE.L  A2,(A1)        ;p hochsetzen
  440. ⓪$END;
  441. ⓪"END SkipStr;
  442. ⓪"(*$L=*)
  443. ⓪ 
  444. ⓪ PROCEDURE SkipImpList (VAR p: address);
  445. ⓪"(* Importliste überspringen *)
  446. ⓪"(*$L-*)
  447. ⓪"BEGIN
  448. ⓪$ASSEMBLER
  449. ⓪(MOVE.L  -(A3),A0
  450. ⓪(MOVE.L  (A0),A1
  451. ⓪%R6 MOVE.W  (A1)+,D0      ;imp. ItemNr
  452. ⓪(BEQ     R5            ;fertig mit diesem Import
  453. ⓪(MOVE.L  (A1)+,D1      ;importiertes Item
  454. ⓪(BRA     R6
  455. ⓪%R5 MOVE.L  A1,(A0)
  456. ⓪$END;
  457. ⓪"END SkipImpList;
  458. ⓪"(*$L=*)
  459. ⓪ 
  460. ⓪ 
  461. ⓪ PROCEDURE SplitFileName ( REF Source: ARRAY OF CHAR; VAR Name,sfx: ARRAY OF Char );
  462. ⓪"VAR dummy: MOSGlobals.PathStr;
  463. ⓪"BEGIN
  464. ⓪$SplitPath (source, dummy, name);
  465. ⓪$SplitName (name, name, sfx)
  466. ⓪"END SplitFileName;
  467. ⓪ 
  468. ⓪ 
  469. ⓪ 
  470. ⓪ PROCEDURE moveMem (olo, ohi, nlo: LONGCARD);
  471. ⓪"BEGIN
  472. ⓪$ASSEMBLER
  473. ⓪(MOVE.L  olo(A6),A0
  474. ⓪(MOVE.L  ohi(A6),A1
  475. ⓪(MOVE.L  nlo(A6),A2
  476. ⓪&L MOVE.W  (A0)+,(A2)+
  477. ⓪(CMPA.L  A1,A0
  478. ⓪(BCS     L
  479. ⓪$END
  480. ⓪"END moveMem;
  481. ⓪ 
  482. ⓪ 
  483. ⓪ PROCEDURE isCLinkMod (modidx: CARDINAL): BOOLEAN;
  484. ⓪ (*
  485. ⓪!* Wert: TRUE, wenn Modul von 'MM2CLink' erzeugt wurde.
  486. ⓪!*)
  487. ⓪"BEGIN
  488. ⓪$RETURN entry (ModLst^ [modidx].image, 50) # 0;
  489. ⓪"END isCLinkMod;
  490. ⓪ 
  491. ⓪ 
  492. ⓪ PROCEDURE Optimize;
  493. ⓪ 
  494. ⓪"TYPE RelocList = POINTER TO RECORD link: LONGCARD; procAddr: LONGCARD END;
  495. ⓪'ProcLenEntry = RECORD start: LONGCARD; len: LONGCARD END;
  496. ⓪'ProcLenList = POINTER TO ProcLenEntry;
  497. ⓪'ImportTable = POINTER TO RECORD item: CARDINAL; procAddr: LONGCARD END;
  498. ⓪ 
  499. ⓪"(*------------- Aufbau der Listen der relativen Referenzen: ----------
  500. ⓪#*
  501. ⓪#* In TC-Objektdateien kommen relative Referenzen sehr häufig vor. Diese
  502. ⓪#* müssen beim Optimierer sowohl beim Markieren der Procs, als auch bei der
  503. ⓪#* Korrektur der Referenzen berücksichtigt werden.
  504. ⓪#* TC unterscheidet zwischen 2 Byte (PCRelWordRef) und 4 Byte (PCRelLongRef)
  505. ⓪#* relativen Referenzen.
  506. ⓪#* Damit die relativen Referenzen durch den Optimierer berücksichtigt werden,
  507. ⓪#* gibt es für die 2 byte und 4 byte relativen Referenzen zwei Listen. Der
  508. ⓪#* Zeiger auf die erste Liste (2 byte relative Refs) steht im Modulheader bei
  509. ⓪#* Offset 50:
  510. ⓪#*
  511. ⓪#* WordRelRelocListOffset = entry (image, 50)
  512. ⓪#*
  513. ⓪#* Der Zeiger auf die zweite Liste (4 byte relative Refs) steht unmittelbar
  514. ⓪#* vor der ersten Liste:
  515. ⓪#*
  516. ⓪#* LongRelRelocListOffset = entry (image, WordRelRelocListOffset - 4)
  517. ⓪#*
  518. ⓪#* In den relativen Referenzlisten steht immer zuerst die Adresse, auf
  519. ⓪#* die sich die Referenz bezieht (Entryadresse). Dann kommt eine Liste von
  520. ⓪#* 2 byte bzw. 4 byte Werten, die die Lage der relativen Referenzen relativ
  521. ⓪#* zu der Entryadresse angeben. Dabei bedeuten positive Werte, daß die
  522. ⓪#* Referenzadresse vor der Entryadresse liegt. Um die Referenzadresse relativ
  523. ⓪#* zum Modulanfang zu erhalten, sind also die Werte von der Entryadresse zu
  524. ⓪#* subtrahieren! Die 2 byte bzw. 4 byte Werte sind absteigend geordnet.
  525. ⓪#*
  526. ⓪#* RelRelocList = { 4 byte Adresse, relativ zum Modulanfang
  527. ⓪#*                  { 2/4 byte Referenzadresse, relativ zu obiger Adresse
  528. ⓪#*                  } 2/4 byte Endmarke $0000
  529. ⓪#*                } 4 byte Endmarke $00000000
  530. ⓪#*
  531. ⓪#* Zugriffe auf diese Refernzliste erfolgen mit Hilfe der folgenden
  532. ⓪#* Zugriffskennung und fogenden Prozeduren:
  533. ⓪#*)
  534. ⓪'RelRelocList  = RECORD
  535. ⓪9pEntryAddr : POINTER TO LONGCARD; (* ^ Entryadresse *)
  536. ⓪9pRelocList : PtrAnyLongType;      (* ^ RelRelocList *)
  537. ⓪9long       : BOOLEAN;             (* 4/2 byte Addr  *)
  538. ⓪7END;
  539. ⓪7
  540. ⓪"PROCEDURE RelRefValue (REF hdl: RelRelocList): LONGINT; FORWARD;
  541. ⓪"PROCEDURE FirstRelRefValue (VAR hdl: RelRelocList): LONGINT; FORWARD;
  542. ⓪"PROCEDURE NextRelRefValue (VAR hdl: RelRelocList): LONGINT; FORWARD;
  543. ⓪ 
  544. ⓪"PROCEDURE NextRelRelocEntry (REF hdl: RelRelocList): RelRelocList;
  545. ⓪"(*
  546. ⓪#* Eingabe: Zugriffskennung auf relative Referenzliste
  547. ⓪#* Wert   : Zugriffskennung auf den nächsten Eintrag in der relativen
  548. ⓪#*          Referenzliste.
  549. ⓪#*)
  550. ⓪$VAR dummy: LONGINT;
  551. ⓪(newHdl: RelRelocList;
  552. ⓪$BEGIN
  553. ⓪&newHdl:= hdl;
  554. ⓪&(* restliche Refs. überspringen *)
  555. ⓪&IF RelRefValue (newHdl) # 0 THEN
  556. ⓪(WHILE NextRelRefValue (newHdl) # 0 DO END;
  557. ⓪&END;
  558. ⓪&WITH newHdl DO
  559. ⓪((* Endekennung überspringen *)
  560. ⓪(IF long THEN
  561. ⓪*pEntryAddr:= CAST (ADDRESS, pRelocList) + 4;
  562. ⓪(ELSE
  563. ⓪*pEntryAddr:= CAST (ADDRESS, pRelocList) + 2;
  564. ⓪(END;
  565. ⓪(IF pEntryAddr^ # 0 THEN
  566. ⓪*(* newHdl schon mal auf erste Ref. setzen *)
  567. ⓪*dummy:= FirstRelRefValue (newHdl);
  568. ⓪*IF pEntryAddr^ = 1 THEN
  569. ⓪,(* ausgeketteten Eintrag überspringen *)
  570. ⓪,RETURN NextRelRelocEntry (newHdl);
  571. ⓪*END;
  572. ⓪(END;
  573. ⓪&END;
  574. ⓪&RETURN newHdl;
  575. ⓪$END NextRelRelocEntry;
  576. ⓪$
  577. ⓪"PROCEDURE FirstRelRelocEntry (image: ADDRESS;
  578. ⓪@longList: BOOLEAN): RelRelocList;
  579. ⓪"(*
  580. ⓪#* Eingabe: image-Adresse; longList = TRUE => Liste mit 4 byte Werten, sonst 2
  581. ⓪#* Wert   : Zugriffskennung auf Liste der relativen Referenzen
  582. ⓪#*)
  583. ⓪$VAR hdl: RelRelocList;
  584. ⓪(RelRelocListOffset: LONGCARD;
  585. ⓪(dummy: LONGINT;
  586. ⓪$BEGIN
  587. ⓪&hdl.pEntryAddr:= NIL; (* Initialisierung *)
  588. ⓪&RelRelocListOffset:= entry (image, 50);
  589. ⓪&IF RelRelocListOffset = 0 THEN RETURN hdl END;
  590. ⓪&IF longList THEN
  591. ⓪(RelRelocListOffset:= entry (image, RelRelocListOffset - 4);
  592. ⓪(IF RelRelocListOffset = 0 THEN RETURN hdl END;
  593. ⓪&END;
  594. ⓪&WITH hdl DO
  595. ⓪(long:= longList;
  596. ⓪(pEntryAddr:= image + RelRelocListOffset;
  597. ⓪(IF pEntryAddr^ # 0 THEN
  598. ⓪*(* hdl schon mal auf erste Ref. setzen *)
  599. ⓪*dummy:= FirstRelRefValue (hdl);
  600. ⓪*IF pEntryAddr^ = 1 THEN
  601. ⓪,(* ausgeketteten Eintrag überspringen *)
  602. ⓪,RETURN NextRelRelocEntry (hdl);
  603. ⓪*END;
  604. ⓪(END;
  605. ⓪&END; (* WITH *)
  606. ⓪&RETURN hdl;
  607. ⓪$END FirstRelRelocEntry;
  608. ⓪$
  609. ⓪"PROCEDURE DisableRelRelocEntry (REF hdl: RelRelocList);
  610. ⓪"(*
  611. ⓪#* Eingabe: Zugriffskennung auf Referenzliste
  612. ⓪#* Effekt : Der aktuelle Eintrag in der Refernzliste wird ausgekettet
  613. ⓪#*)
  614. ⓪$BEGIN
  615. ⓪&hdl.pEntryAddr^:= 1;
  616. ⓪$END DisableRelRelocEntry;
  617. ⓪$
  618. ⓪"PROCEDURE EmptyRelRelocEntry (REF hdl: RelRelocList): BOOLEAN;
  619. ⓪"(*
  620. ⓪#* Eingabe: Zugriffskennung auf Referenzliste
  621. ⓪#* Wert   : TRUE, wenn keine weiteren Daten in der Liste
  622. ⓪#*)
  623. ⓪$BEGIN
  624. ⓪&WITH hdl DO
  625. ⓪(RETURN (pEntryAddr = NIL) OR (pEntryAddr^ = 0);
  626. ⓪&END;
  627. ⓪$END EmptyRelRelocEntry;
  628. ⓪$
  629. ⓪"PROCEDURE EntryOffset (REF hdl: RelRelocList): LONGCARD;
  630. ⓪"(*
  631. ⓪#* Eingabe: Zugriffskennung auf RelRelocList
  632. ⓪#* Wert   : Entryadresse relativ zum Modulanfang
  633. ⓪#*)
  634. ⓪$BEGIN
  635. ⓪&RETURN hdl.pEntryAddr^
  636. ⓪$END EntryOffset;
  637. ⓪$
  638. ⓪"PROCEDURE DecEntryOffset (REF hdl: RelRelocList; diff: LONGCARD);
  639. ⓪"(*
  640. ⓪#* Effekt: Von der aktuellen Entryadresse wird diff abgezogen.
  641. ⓪#*)
  642. ⓪$BEGIN
  643. ⓪&DEC (hdl.pEntryAddr^, diff);
  644. ⓪$END DecEntryOffset;
  645. ⓪ 
  646. ⓪"PROCEDURE RelRefValue (REF hdl: RelRelocList): LONGINT;
  647. ⓪"(*
  648. ⓪#* Eingabe: Zugriffskennung auf Referenzliste
  649. ⓪#* Wert   : Adresse der aktuellen Referenz auf EntryOffset (hdl) relativ zu
  650. ⓪#*          EntryOffset (hdl) oder 0 nach letztem Eintrag
  651. ⓪#*)
  652. ⓪$BEGIN
  653. ⓪&WITH hdl DO
  654. ⓪(IF long THEN
  655. ⓪*RETURN pRelocList^.li;
  656. ⓪(ELSE
  657. ⓪*RETURN pRelocList^.i1;
  658. ⓪(END;
  659. ⓪&END;
  660. ⓪$END RelRefValue;
  661. ⓪$
  662. ⓪"PROCEDURE RelRefOffset (REF hdl: RelRelocList): LONGCARD;
  663. ⓪"(*
  664. ⓪#* wie oben, nur relativ zum Modulanfang.
  665. ⓪#*)
  666. ⓪$VAR offset: LONGINT;
  667. ⓪$BEGIN
  668. ⓪&offset:= RelRefValue (hdl);
  669. ⓪&IF (offset = 0) OR (offset = 1) THEN
  670. ⓪(RETURN offset;
  671. ⓪&ELSE
  672. ⓪(RETURN VAL (LONGCARD, VAL (LONGINT, EntryOffset (hdl)) - offset);
  673. ⓪&END;
  674. ⓪$END RelRefOffset;
  675. ⓪$
  676. ⓪"PROCEDURE DecRelRefOffset (REF hdl: RelRelocList;
  677. ⓪Aimage: ADDRESS;
  678. ⓪Aoffset, diff: LONGINT);
  679. ⓪"(*
  680. ⓪#* Eingabe: Zugriffskennung auf Referenzliste
  681. ⓪#* Effekt : Die Adresse der aktuellen Referenz auf EntryOffset (hdl)
  682. ⓪#*          wird um diff erniedrigt.
  683. ⓪#*)
  684. ⓪$VAR RefImageAddr: PtrAnyLongType;
  685. ⓪$BEGIN
  686. ⓪&WITH hdl DO
  687. ⓪(IF long THEN
  688. ⓪*RefImageAddr:= image + CAST (ADDRESS, CAST (LONGINT, pEntryAddr^) -
  689. ⓪ApRelocList^.li + offset);
  690. ⓪*DEC (RefImageAddr^.li, diff);
  691. ⓪*DEC (pRelocList^.li, diff);
  692. ⓪(ELSE
  693. ⓪*RefImageAddr:= image + CAST (ADDRESS, CAST (LONGINT, pEntryAddr^) -
  694. ⓪AVAL (LONGINT, pRelocList^.i1) + offset);
  695. ⓪*DEC (RefImageAddr^.i1, diff);
  696. ⓪*DEC (pRelocList^.i1, diff);
  697. ⓪(END;
  698. ⓪&END;
  699. ⓪$END DecRelRefOffset;
  700. ⓪$
  701. ⓪"PROCEDURE DisableRelRef (REF hdl: RelRelocList);
  702. ⓪"(*
  703. ⓪#* Eingabe: Zugriffskennung auf Referenzliste
  704. ⓪#* Effekt : Die aktuelle Referenz wird aus der Liste ausgekettet
  705. ⓪#*)
  706. ⓪$BEGIN
  707. ⓪&WITH hdl DO
  708. ⓪(IF long THEN
  709. ⓪*pRelocList^.li:= 1;
  710. ⓪(ELSE
  711. ⓪*pRelocList^.i1:= 1;
  712. ⓪(END;
  713. ⓪&END;
  714. ⓪$END DisableRelRef;
  715. ⓪$
  716. ⓪"PROCEDURE FirstRelRefValue (VAR hdl: RelRelocList): LONGINT;
  717. ⓪"(*
  718. ⓪#* Eingabe: Zugriffskennung auf Referenzliste
  719. ⓪#* Effekt : Zeiger in Zugriffskennung wird auf erste Referenz gesetzt.
  720. ⓪#* Wert   : Adresse der ersten Referenz auf EntryOffset (hdl) relativ zu
  721. ⓪#*          EntryOffset (hdl) oder 0 bei leerer Liste
  722. ⓪#*)
  723. ⓪$VAR offset: LONGINT;
  724. ⓪$BEGIN
  725. ⓪&WITH hdl DO
  726. ⓪(pRelocList:= CAST (ADDRESS, pEntryAddr) + 4;
  727. ⓪&END;
  728. ⓪&offset:= RelRefValue (hdl);
  729. ⓪&IF offset = 1 THEN
  730. ⓪((* ausgekettete Referenzen überspringen *)
  731. ⓪(RETURN NextRelRefValue (hdl);
  732. ⓪&ELSE
  733. ⓪(RETURN offset;
  734. ⓪&END;
  735. ⓪$END FirstRelRefValue;
  736. ⓪$
  737. ⓪"PROCEDURE FirstRelRefOffset (VAR hdl: RelRelocList): LONGCARD;
  738. ⓪"(*
  739. ⓪#* wie oben, nur relativ zum Modulanfang
  740. ⓪#*)
  741. ⓪$VAR dummy: LONGINT;
  742. ⓪$BEGIN
  743. ⓪&dummy:= FirstRelRefValue (hdl);
  744. ⓪&RETURN RelRefOffset (hdl);
  745. ⓪$END FirstRelRefOffset;
  746. ⓪$
  747. ⓪"PROCEDURE NextRelRefValue (VAR hdl: RelRelocList): LONGINT;
  748. ⓪"(*
  749. ⓪#* Eingabe: Zugriffskennung auf Referenzliste
  750. ⓪#* Effekt : Zeiger in Zugriffskennung wird auf nächste Refernz gesetzt
  751. ⓪#* Wert   : Adresse der näcksten Refernz auf EntryOffset (hdl) relativ zu
  752. ⓪#*          EntryOffset (hdl) oder 0 bei Ende der Liste
  753. ⓪#*)
  754. ⓪$VAR offset: LONGINT;
  755. ⓪$BEGIN
  756. ⓪&WITH hdl DO
  757. ⓪(IF long THEN
  758. ⓪*INC (pRelocList, 4);
  759. ⓪(ELSE
  760. ⓪*INC (pRelocList, 2);
  761. ⓪(END;
  762. ⓪&END;
  763. ⓪&offset:= RelRefValue (hdl);
  764. ⓪&IF offset = 1 THEN
  765. ⓪((* ausgekettete Referenzen überspringen *)
  766. ⓪(RETURN NextRelRefValue (hdl);
  767. ⓪&ELSE
  768. ⓪(RETURN offset;
  769. ⓪&END;
  770. ⓪$END NextRelRefValue;
  771. ⓪ 
  772. ⓪"PROCEDURE NextRelRefOffset (VAR hdl: RelRelocList): LONGCARD;
  773. ⓪"(*
  774. ⓪#* wie oben, nur relativ zum Modulanfang
  775. ⓪#*)
  776. ⓪$VAR dummy: LONGINT;
  777. ⓪$BEGIN
  778. ⓪&dummy:= NextRelRefValue (hdl);
  779. ⓪&RETURN RelRefOffset (hdl);
  780. ⓪$END NextRelRefOffset;
  781. ⓪$
  782. ⓪"(*-----------------------------------------------------------------------*)
  783. ⓪$
  784. ⓪"PROCEDURE pStart (p: ProcLenList): LONGCARD;
  785. ⓪$(*$L-*)
  786. ⓪$BEGIN
  787. ⓪&ASSEMBLER
  788. ⓪(MOVE.L  -(A3),A0
  789. ⓪(MOVE.L  (A0),D0         ; p^.start
  790. ⓪(ANDI.L  #$00FFFFFF,D0
  791. ⓪&END;
  792. ⓪$END pStart;
  793. ⓪$(*$L=*)
  794. ⓪ 
  795. ⓪"PROCEDURE pEnd (p: ProcLenList): LONGCARD;
  796. ⓪$(*$L-*)
  797. ⓪$BEGIN
  798. ⓪&ASSEMBLER
  799. ⓪(MOVE.L  -(A3),A0
  800. ⓪(MOVE.L  (A0)+,D0        ; p^.start
  801. ⓪(ANDI.L  #$00FFFFFF,D0
  802. ⓪(ADD.L   (A0),D0         ; p^.len
  803. ⓪&END;
  804. ⓪$END pEnd;
  805. ⓪$(*$L=*)
  806. ⓪ 
  807. ⓪"PROCEDURE mark (p: ProcLenList; n: CARDINAL);
  808. ⓪$(* n: 1='lokal verwendet', 2='von anderem Modul importiert' *)
  809. ⓪$(*$L-*)
  810. ⓪$BEGIN
  811. ⓪&ASSEMBLER
  812. ⓪(MOVE.W  -(A3),D0
  813. ⓪(MOVE.L  -(A3),A0
  814. ⓪(MOVE.B  D0,(A0)         ; p^.start
  815. ⓪&END;
  816. ⓪$END mark;
  817. ⓪$(*$L=*)
  818. ⓪ 
  819. ⓪"PROCEDURE marked (p: ProcLenList): BOOLEAN;
  820. ⓪$(*$L-*)
  821. ⓪$BEGIN
  822. ⓪&ASSEMBLER
  823. ⓪(MOVE.L  -(A3),A0
  824. ⓪(TST.B   (A0)            ; p^.start
  825. ⓪(SNE     D0
  826. ⓪(ANDI    #1,D0
  827. ⓪&END;
  828. ⓪$END marked;
  829. ⓪$(*$L=*)
  830. ⓪ 
  831. ⓪"PROCEDURE markedValue (p: ProcLenList): CARDINAL;
  832. ⓪$(*$L-*)
  833. ⓪$BEGIN
  834. ⓪&ASSEMBLER
  835. ⓪(MOVE.L  -(A3),A0
  836. ⓪(CLR     D0
  837. ⓪(MOVE.B  (A0),D0         ; p^.start
  838. ⓪&END;
  839. ⓪$END markedValue;
  840. ⓪$(*$L=*)
  841. ⓪ 
  842. ⓪"PROCEDURE between (v, lo, hi: LONGCARD): BOOLEAN;
  843. ⓪$(*$L-*)
  844. ⓪$BEGIN
  845. ⓪&ASSEMBLER
  846. ⓪(MOVE.L  -(A3),D0  ; hi
  847. ⓪(MOVE.L  -(A3),D1  ; lo
  848. ⓪(MOVE.L  -(A3),D2  ; v
  849. ⓪(CMP.L   D1,D2
  850. ⓪(BCS     fals
  851. ⓪(CMP.L   D0,D2
  852. ⓪(BCC     fals
  853. ⓪(MOVEQ   #1,D0
  854. ⓪(RTS
  855. ⓪&fals
  856. ⓪(CLR     D0
  857. ⓪&END;
  858. ⓪$END between;
  859. ⓪$(*$L=*)
  860. ⓪ 
  861. ⓪"PROCEDURE advance (p: LONGCARD; VAR prl: ProcLenList);
  862. ⓪$(*$L-*)
  863. ⓪$BEGIN
  864. ⓪&ASSEMBLER
  865. ⓪(MOVE.L  -(A3),A2        ; ADR (prl)
  866. ⓪(MOVE.L  -(A3),-(A7)     ; p
  867. ⓪(MOVE.L  (A2),A1
  868. ⓪&lupo
  869. ⓪(MOVE.L  (A7),(A3)+
  870. ⓪(MOVE.L  A1,(A3)+
  871. ⓪(BSR     pStart/
  872. ⓪(MOVE.L  D0,(A3)+
  873. ⓪(MOVE.L  A1,(A3)+
  874. ⓪(BSR     pEnd/
  875. ⓪(MOVE.L  D0,(A3)+
  876. ⓪(BSR     between/
  877. ⓪(BNE     ende
  878. ⓪(ADDQ.L  #8,A1
  879. ⓪(BRA     lupo
  880. ⓪&ende
  881. ⓪(MOVE.L  A1,(A2)
  882. ⓪(ADDQ.L  #4,A7
  883. ⓪&END
  884. ⓪&(*
  885. ⓪&WHILE NOT between (p, pStart (prl), pEnd (prl)) DO
  886. ⓪(INC (prl, SHORT (SIZE (prl^)))
  887. ⓪&END;
  888. ⓪&*)
  889. ⓪$END advance;
  890. ⓪$(*$L=*)
  891. ⓪ 
  892. ⓪"PROCEDURE findListEntry (idx: tIndex; ad: LONGCARD; VAR prl: ProcLenList);
  893. ⓪$BEGIN
  894. ⓪&WITH ModLst^ [idx] DO
  895. ⓪(prl:= image + entry (image, 38)
  896. ⓪&END;
  897. ⓪&advance (ad, prl)
  898. ⓪$END findListEntry;
  899. ⓪ 
  900. ⓪"PROCEDURE markCalls (modidx: tIndex; start, ende: LONGCARD);
  901. ⓪ 
  902. ⓪$PROCEDURE MarkRelRefProcs (image: ADDRESS; long: BOOLEAN);
  903. ⓪$(*
  904. ⓪%* Eingabe: Image-Adresse des betreffenden Moduls; long = TRUE => 4 byte
  905. ⓪%*          relative Adressen.
  906. ⓪%* Effekt:  Markiert Prozeduren, die relativ referenziert werden.
  907. ⓪%*)
  908. ⓪&VAR
  909. ⓪*rRelocL: RelRelocList;
  910. ⓪*procAddr: LONGCARD;
  911. ⓪*prl: ProcLenList;
  912. ⓪*link: LONGCARD;
  913. ⓪*
  914. ⓪&BEGIN
  915. ⓪((* Kennung für RelRelocList *)
  916. ⓪(rRelocL:= FirstRelRelocEntry (image, long);
  917. ⓪(prl:= image + entry (image, 38); (* Zeiger auf Prozedurlängenliste *)
  918. ⓪(WHILE NOT EmptyRelRelocEntry (rRelocL) DO
  919. ⓪*(* relative Referenzliste abarbeiten *)
  920. ⓪*procAddr:= EntryOffset (rRelocL);
  921. ⓪*IF procAddr < entry (image, 6) THEN (* Proc, nicht Var oder Body *)
  922. ⓪,advance (procAddr, prl);
  923. ⓪,link:= FirstRelRefOffset (rRelocL);
  924. ⓪,LOOP
  925. ⓪.IF link = 0L THEN
  926. ⓪0EXIT
  927. ⓪.ELSIF between (link, start, ende) THEN
  928. ⓪0IF ~marked (prl) THEN
  929. ⓪2mark (prl,1);
  930. ⓪2markCalls (modidx, pStart (prl), pEnd (prl));
  931. ⓪0END;
  932. ⓪0EXIT;
  933. ⓪.END;
  934. ⓪.link:= NextRelRefOffset (rRelocL);
  935. ⓪,END
  936. ⓪*END;
  937. ⓪*rRelocL:= NextRelRelocEntry (rRelocL);
  938. ⓪(END;
  939. ⓪&END MarkRelRefProcs;
  940. ⓪ 
  941. ⓪$VAR
  942. ⓪&image, impImg: ADDRESS;
  943. ⓪&pra: RelocList;
  944. ⓪&prl: ProcLenList;
  945. ⓪&expl, pri: ADDRESS;
  946. ⓪&imptbl: ImportTable;
  947. ⓪&link: LONGCARD;
  948. ⓪&idx, impIdx: tIndex;
  949. ⓪ 
  950. ⓪$BEGIN
  951. ⓪&IF start >= ModLst^ [modidx].codeEnd THEN
  952. ⓪((* Dies ist keine Proc sondern wahrscheinlich eine Const -> Abbruch *)
  953. ⓪(RETURN
  954. ⓪&END;
  955. ⓪&
  956. ⓪&image:= ModLst^ [modidx].image;
  957. ⓪&
  958. ⓪&IF ModLst^ [modidx].mayCrunch THEN
  959. ⓪((*
  960. ⓪)* Nach lokalen Procs/Consts suchen, die vom Aufrufer (start..ende)
  961. ⓪)* benutzt werden:
  962. ⓪)*)
  963. ⓪(pra:= image + entry (image, 22); (* Liste mit Proc-Adr + Aufrufern *)
  964. ⓪(prl:= image + entry (image, 38); (* Liste aller Proc-Adr./Längen *)
  965. ⓪(WHILE pra^.link # NIL DO (* alle lokalen Procs/Consts durchgehen *)
  966. ⓪*IF pra^.procAddr < ModLst^ [modidx].dataEnd THEN
  967. ⓪,(* wir haben eine Proc o. Const *)
  968. ⓪,advance (pra^.procAddr, prl); (* Const-/Proc-Länge (prl) suchen *)
  969. ⓪,link:= pra^.link;
  970. ⓪,LOOP
  971. ⓪.(* Nun prüfen, ob diese Proc/Const vom Aufrufer benutzt wird,
  972. ⓪/* indem geprüft wird, ob die Adr. dieser Proc/Const im Bereich
  973. ⓪/* des Aufrufers (start..ende) einzutragen ist. *)
  974. ⓪.IF link = 0L THEN
  975. ⓪0EXIT (* Ende der Benutzerliste -> nicht gefunden *)
  976. ⓪.ELSIF between (link, start, ende) THEN
  977. ⓪0(* Gefunden: Die Proc/Const wird vom Aufrufer benutzt *)
  978. ⓪0IF ~marked (prl) THEN
  979. ⓪2mark (prl,1);
  980. ⓪2(* Falls dies eine Proc ist, auch die hiervon benutzten
  981. ⓪3* Consts/Procs markieren (Prüfung, ob's eine Proc ist,
  982. ⓪3* geschieht zu Beginn v. markCalls) *)
  983. ⓪2markCalls (modidx, pStart (prl), pEnd (prl))
  984. ⓪0END;
  985. ⓪0EXIT
  986. ⓪.END;
  987. ⓪.link:= entry (image, link)
  988. ⓪,END
  989. ⓪*END;
  990. ⓪*INC (pra, 8)
  991. ⓪(END;
  992. ⓪((*----------- relativ referenzierte Procs markieren --------------*)
  993. ⓪(MarkRelRefProcs (image, FALSE); (* für 2 byte relative Referenzen *)
  994. ⓪(MarkRelRefProcs (image, TRUE);  (* für 4 byte relative Referenzen *)
  995. ⓪((*----------------------------------------------------------------*)
  996. ⓪&END;
  997. ⓪&
  998. ⓪&(* Importierte Procs abarbeiten *)
  999. ⓪&pri:= image + entry (image, 14);
  1000. ⓪&FOR idx:= 1 TO ModLst^ [modidx].ImpIndex DO
  1001. ⓪((* jedes importierte Modul *)
  1002. ⓪(impIdx:= ModLst^ [modidx].ImpLst^[idx];
  1003. ⓪(INC (pri, 4); (* key *)
  1004. ⓪(skipStr (pri);  (* import-Name *)
  1005. ⓪(WHILE CARDINAL (pri^) # 0 DO
  1006. ⓪*(* jedes importierte Item *)
  1007. ⓪*IF ModLst^ [impIdx].mayCrunch THEN
  1008. ⓪,link:= entry (pri, 2);
  1009. ⓪,LOOP
  1010. ⓪.(* jeder Import des Items *)
  1011. ⓪.IF link = 0L THEN
  1012. ⓪0EXIT
  1013. ⓪.ELSIF between (link, start, ende) THEN
  1014. ⓪0(* Item in importiertem Modul finden *)
  1015. ⓪0impImg:= ModLst^ [impIdx].image;
  1016. ⓪0expl:= impImg + entry (impImg, 18);
  1017. ⓪0WHILE CARDINAL (expl^) # 0 DO
  1018. ⓪2IF expl^ = pri^ THEN
  1019. ⓪4(* Item gefunden *)
  1020. ⓪4IF entry (expl, 2) < ModLst^ [impIdx].dataEnd THEN
  1021. ⓪6(* Proc/Const *)
  1022. ⓪6findListEntry (impIdx, entry (expl, 2), prl);
  1023. ⓪6IF ~marked (prl) THEN
  1024. ⓪8mark (prl,2);
  1025. ⓪8markCalls (impIdx, pStart (prl), pEnd (prl))
  1026. ⓪6ELSE
  1027. ⓪8mark (prl,2);  (* als importiert markieren *)
  1028. ⓪6END
  1029. ⓪4ELSE
  1030. ⓪6ModLst^ [impIdx].varsExported:= TRUE
  1031. ⓪4END;
  1032. ⓪4(* Jetzt gleich den 'Body' d. imp. Mods 'usen' *)
  1033. ⓪4WITH ModLst^ [impIdx] DO
  1034. ⓪6IF NOT bodyMarked THEN
  1035. ⓪8(* wenn bisher unbenutzt, nun seine Calls markieren *)
  1036. ⓪8useCode:= TRUE;
  1037. ⓪8bodyMarked:= TRUE;
  1038. ⓪8markCalls (impIdx, entry (image, 6) (*body*), codeEnd)
  1039. ⓪6END
  1040. ⓪4END;
  1041. ⓪4EXIT
  1042. ⓪2ELSE
  1043. ⓪4INC (expl, 6)
  1044. ⓪2END
  1045. ⓪0END;
  1046. ⓪0HALT (* ! Item nicht gefunden *)
  1047. ⓪.END;
  1048. ⓪.link:= entry (image, link)
  1049. ⓪,END; (* LOOP *)
  1050. ⓪*END; (* IF mayCrunch *)
  1051. ⓪*INC (pri, 6)
  1052. ⓪(END; (* WHILE pri^ # 0 *)
  1053. ⓪(INC (pri, 2)
  1054. ⓪&END (* FOR *)
  1055. ⓪ 
  1056. ⓪$END markCalls;
  1057. ⓪"(*$D-*)
  1058. ⓪ 
  1059. ⓪ 
  1060. ⓪"PROCEDURE moveCode (modIdx: tIndex; lastEnde, start, ende, newStart: LONGCARD);
  1061. ⓪ 
  1062. ⓪$PROCEDURE CorrectRelRefs (image: ADDRESS; long: BOOLEAN);
  1063. ⓪$(*
  1064. ⓪%* Eingabe: Image-Adresse; long => 4 byte Werte korrigieren
  1065. ⓪%* Effekt:  Die relativen Referenzen werden korrigiert.
  1066. ⓪%*)
  1067. ⓪&VAR
  1068. ⓪*rRelocL: RelRelocList;
  1069. ⓪*procAddr: LONGCARD;
  1070. ⓪*link    : LONGCARD;
  1071. ⓪*offset  : LONGCARD;
  1072. ⓪*diff    : LONGCARD;
  1073. ⓪ 
  1074. ⓪&BEGIN
  1075. ⓪(diff:= start - lastEnde;  (* um diesen Wert werden Refs korrigiert *)
  1076. ⓪(offset:= lastEnde - newStart; (* auf link zu addierender Offset *)
  1077. ⓪(rRelocL:= FirstRelRelocEntry (image, long); (* Zugriffskennung *)
  1078. ⓪(WHILE NOT EmptyRelRelocEntry (rRelocL) DO
  1079. ⓪*(* Liste mit relativen Referenzen abarbeiten *)
  1080. ⓪*procAddr:= EntryOffset (rRelocL); (* Entryadresse merken *)
  1081. ⓪*IF between (procAddr, lastEnde, start) THEN
  1082. ⓪,(* Prozedur wird wegoptimiert => keine Referenzen auf diese Proc *)
  1083. ⓪,DisableRelRelocEntry (rRelocL);
  1084. ⓪*ELSE
  1085. ⓪,IF diff > 0 THEN
  1086. ⓪.link:= FirstRelRefOffset (rRelocL);
  1087. ⓪.(* Die Referenzen sind nach Codeadressen aufsteigend geordnet!!*)
  1088. ⓪.IF procAddr < newStart THEN
  1089. ⓪0WHILE (link # 0) AND (link < newStart) DO
  1090. ⓪2(* Refs, die nicht über wegoptimierte Procs gehen überspr. *)
  1091. ⓪2link:= NextRelRefOffset (rRelocL);
  1092. ⓪0END;
  1093. ⓪0WHILE (link # 0) AND (link + offset < start) DO
  1094. ⓪2(* Refs von wegoptimierter Proc disablen *)
  1095. ⓪2DisableRelRef (rRelocL);
  1096. ⓪2link:= NextRelRefOffset (rRelocL);
  1097. ⓪0END;
  1098. ⓪0WHILE (link # 0) DO
  1099. ⓪2(* restliche Refs gehen alle über wegoptimierte Proc *)
  1100. ⓪2(* Refs von höheren Adr. zu niedrigeren => diff addieren *)
  1101. ⓪2DecRelRefOffset (rRelocL, image,
  1102. ⓪Coffset, - VAL (LONGINT, diff));
  1103. ⓪2link:= NextRelRefOffset (rRelocL);
  1104. ⓪0END;
  1105. ⓪.ELSIF procAddr >= start THEN
  1106. ⓪0WHILE (link # 0) AND (link < lastEnde) DO
  1107. ⓪2(* Refs über wegoptimierte Proc korrigieren *)
  1108. ⓪2DecRelRefOffset (rRelocL, image,
  1109. ⓪C- VAL (LONGINT, offset), diff);
  1110. ⓪2link:= NextRelRefOffset (rRelocL);
  1111. ⓪0END;
  1112. ⓪0WHILE (link # 0) AND (link < start) DO
  1113. ⓪2(* Refs von wegoptimierter Proc disablen *)
  1114. ⓪2DisableRelRef (rRelocL);
  1115. ⓪2link:= NextRelRefOffset (rRelocL);
  1116. ⓪0END;
  1117. ⓪0(* restliche Refs gehen nicht über wegoptimierte Proc *)
  1118. ⓪.ELSE
  1119. ⓪0HALT; (* reloc-error *)
  1120. ⓪.END; (* IF *)
  1121. ⓪,END; (* IF *)
  1122. ⓪,IF between (procAddr, start, ende) THEN
  1123. ⓪.DecEntryOffset (rRelocL, offset + diff);
  1124. ⓪,END; (* IF *)
  1125. ⓪*END; (* IF *)
  1126. ⓪*rRelocL:= NextRelRelocEntry (rRelocL);
  1127. ⓪(END (* WHILE *);
  1128. ⓪&END CorrectRelRefs;
  1129. ⓪ 
  1130. ⓪$VAR pri, image: ADDRESS;
  1131. ⓪(link, offs: LONGCARD;
  1132. ⓪(p, plink: POINTER TO LONGCARD;
  1133. ⓪(pra: RelocList;
  1134. ⓪(idx: tIndex;
  1135. ⓪(expl: ImportTable;
  1136. ⓪ 
  1137. ⓪$PROCEDURE correct (VAR n: LONGCARD);
  1138. ⓪&(*$L-*)
  1139. ⓪&BEGIN
  1140. ⓪(ASSEMBLER
  1141. ⓪.MOVE.L  D2,A0
  1142. ⓪.MOVE.L  -(A3),A1
  1143. ⓪.MOVE.L  offs(A0),D0
  1144. ⓪.SUB.L   D0,(A1)
  1145. ⓪(END
  1146. ⓪&END correct;
  1147. ⓪&(*$L=*)
  1148. ⓪ 
  1149. ⓪$BEGIN
  1150. ⓪&ModLst^ [modIdx].crunched:= TRUE;
  1151. ⓪&image:= ModLst^ [modIdx].image;
  1152. ⓪&offs:= start - newStart;
  1153. ⓪&IF offs = 0L THEN HALT END;
  1154. ⓪&
  1155. ⓪&(*-------------- relative Relozierliste korrigieren ----------------*)
  1156. ⓪&CorrectRelRefs (image, FALSE); (* Korrektur für 2 byte Werte *)
  1157. ⓪&CorrectRelRefs (image, TRUE);  (* Korrektur für 4 byte Werte *)
  1158. ⓪&(*------------------------------------------------------------------*)
  1159. ⓪&
  1160. ⓪&(* Relozierliste korrigieren *)
  1161. ⓪&pra:= image + entry (image, 22);
  1162. ⓪&WHILE pra^.link # NIL DO
  1163. ⓪(IF pra^.procAddr # 0L THEN
  1164. ⓪*IF between (pra^.procAddr, newstart, ende) THEN
  1165. ⓪,IF pra^.procAddr < start THEN
  1166. ⓪.pra^.procAddr:= 0  (* Diese Proc nicht mehr relozieren ! *)
  1167. ⓪,ELSE
  1168. ⓪.correct (pra^.procAddr)
  1169. ⓪,END
  1170. ⓪*END;
  1171. ⓪*plink:= ADR (pra^.link);
  1172. ⓪*LOOP
  1173. ⓪,link:= plink^;
  1174. ⓪,IF link > entry (image, 22) THEN HALT (* reloc-error *) END;
  1175. ⓪,IF link < newstart THEN EXIT END;
  1176. ⓪,IF link < ende THEN
  1177. ⓪.IF link < start THEN
  1178. ⓪0WHILE link >= newstart DO
  1179. ⓪2link:= entry (image, link)
  1180. ⓪0END;
  1181. ⓪0(* wegoptimierte Procs aus Ref-Liste nehmen *)
  1182. ⓪0IF (link = 0L) & (plink = ADR (pra^.link)) THEN
  1183. ⓪2pra^.procAddr:= 0  (* ganze Ref-Liste auslassen *)
  1184. ⓪0ELSE
  1185. ⓪2plink^:= link;  (* unbenutze Ref auslinken *)
  1186. ⓪0END;
  1187. ⓪0EXIT
  1188. ⓪.ELSE
  1189. ⓪0correct (plink^)
  1190. ⓪.END
  1191. ⓪,END;
  1192. ⓪,plink:= image + link
  1193. ⓪*END;
  1194. ⓪(END; (* IF pra^.procAddr # 0L *)
  1195. ⓪(INC (pra, 8)
  1196. ⓪&END (* WHILE *);
  1197. ⓪&
  1198. ⓪&(* Importliste korrigieren *)
  1199. ⓪&pri:= image + entry (image, 14);
  1200. ⓪&FOR idx:= 1 TO ModLst^ [modidx].ImpIndex DO
  1201. ⓪((* jedes importierte Modul *)
  1202. ⓪(INC (pri, 4); (* key *)
  1203. ⓪(skipStr (pri);  (* import-Name *)
  1204. ⓪(WHILE CARDINAL (pri^) # 0 DO
  1205. ⓪*(* jedes imp. Item *)
  1206. ⓪*plink:= pri + 2L;
  1207. ⓪*LOOP
  1208. ⓪,link:= plink^;
  1209. ⓪,IF link > entry (image, 22) THEN HALT (* reloc-error *) END;
  1210. ⓪,IF link < newstart THEN EXIT END;
  1211. ⓪,IF link < ende THEN
  1212. ⓪.IF link < start THEN
  1213. ⓪0WHILE link >= newstart DO
  1214. ⓪2link:= entry (image, link)
  1215. ⓪0END;
  1216. ⓪0(* wegoptimierte Procs aus Ref-Liste nehmen *)
  1217. ⓪0plink^:= link;  (* unbenutze Ref auslinken *)
  1218. ⓪0EXIT
  1219. ⓪.ELSE
  1220. ⓪0correct (plink^)
  1221. ⓪.END
  1222. ⓪,END;
  1223. ⓪,plink:= image + link
  1224. ⓪*END;
  1225. ⓪*INC (pri, 6)
  1226. ⓪(END;
  1227. ⓪(INC (pri, 2)
  1228. ⓪&END; (* FOR idx *)
  1229. ⓪&
  1230. ⓪&(* Exportliste korrigieren *)
  1231. ⓪&expl:= image + entry (image, 18);
  1232. ⓪&WHILE expl^.item # 0 DO
  1233. ⓪(IF between (expl^.procAddr, newstart, ende) THEN
  1234. ⓪*IF expl^.procAddr < start THEN
  1235. ⓪,expl^.procAddr:= 0
  1236. ⓪*ELSE
  1237. ⓪,correct (expl^.procAddr)
  1238. ⓪*END
  1239. ⓪(END;
  1240. ⓪(INC (expl, 6)
  1241. ⓪&END (* WHILE *);
  1242. ⓪&
  1243. ⓪&(* Liste der Prozedurnamen korrigieren *)
  1244. ⓪&IF ModLst^ [modIdx].procSym THEN
  1245. ⓪(link:= entry (image, 6);
  1246. ⓪(LOOP
  1247. ⓪*plink:= image + link - 4L;
  1248. ⓪*link:= plink^;
  1249. ⓪*IF link > entry (image, 22) THEN HALT (* reloc-error *)
  1250. ⓪*ELSIF link < newStart THEN EXIT
  1251. ⓪*ELSIF link < ende THEN
  1252. ⓪,IF link < start THEN
  1253. ⓪.WHILE link >= newStart DO
  1254. ⓪0link:= entry (image, link-4L)
  1255. ⓪.END;
  1256. ⓪.(* wegoptimierte Procs aus Liste nehmen *)
  1257. ⓪.plink^:= link;
  1258. ⓪.EXIT
  1259. ⓪,ELSE
  1260. ⓪.correct (plink^)
  1261. ⓪,END
  1262. ⓪*END
  1263. ⓪(END
  1264. ⓪&END;
  1265. ⓪&
  1266. ⓪&(* Rumpfeinsprung korrigieren *)
  1267. ⓪&IF between (entry (image, 6), start, ende) THEN
  1268. ⓪(p:= image + 6L;
  1269. ⓪(correct (p^)
  1270. ⓪&END;
  1271. ⓪&
  1272. ⓪&(* Code verschieben *)
  1273. ⓪&moveMem (image + start, image + ende, image + newStart)
  1274. ⓪$END moveCode;
  1275. ⓪ 
  1276. ⓪ 
  1277. ⓪"PROCEDURE moveProcs (modIdx: tIndex);
  1278. ⓪ 
  1279. ⓪$VAR pri, imag: LONGCARD;
  1280. ⓪(lastFree, freeStart, usedStart, currEnd: ADDRESS;
  1281. ⓪(prl: ProcLenList;
  1282. ⓪(lastEnd: ADDRESS;
  1283. ⓪(offset: LONGCARD;
  1284. ⓪(hadSyms, remProcSym, procsExported, endOfLenList: BOOLEAN;
  1285. ⓪(symbol: SymbolList;
  1286. ⓪(body_prl: ProcLenEntry;
  1287. ⓪(ch: CHAR;
  1288. ⓪ 
  1289. ⓪$PROCEDURE getProc (at: LONGCARD; VAR prl: ProcLenList): BOOLEAN;
  1290. ⓪&(* stellt "prl" auf die Längen-Info, die zur Proc bei "at" gehört *)
  1291. ⓪&(*$L-*)
  1292. ⓪&BEGIN
  1293. ⓪(ASSEMBLER
  1294. ⓪0MOVE.L  -(A3),-(A7)
  1295. ⓪0MOVE.L  D2,A2
  1296. ⓪0MOVE.L  -(A3),D2
  1297. ⓪0
  1298. ⓪0; der Body erscheint nicht in der Längenliste, deswegen
  1299. ⓪0; hierfür zuerst eine Sonderabfrage:
  1300. ⓪0LEA     body_prl(A2),A1
  1301. ⓪0MOVE.L  A1,(A3)+
  1302. ⓪0BSR     pStart/
  1303. ⓪0CMP.L   D0,D2           ; 'at' = body_prl.start?
  1304. ⓪0BEQ     tr
  1305. ⓪0
  1306. ⓪0; ansonsten in Längenliste vom Modul suchen
  1307. ⓪0MOVE.L  imag(A2),A0
  1308. ⓪0MOVE.L  A0,A1
  1309. ⓪0ADDA.L  38(A1),A1
  1310. ⓪0
  1311. ⓪.lupo
  1312. ⓪0MOVE.L  A1,(A3)+
  1313. ⓪0BSR     pStart/
  1314. ⓪0BEQ     btrf
  1315. ⓪0CMP.L   D2,D0
  1316. ⓪0BNE     weiter
  1317. ⓪0; folg. Abfrage neu in V2.33:
  1318. ⓪0MOVE.L  A1,(A3)+
  1319. ⓪0BSR     pEnd/
  1320. ⓪0CMP.L   D2,D0
  1321. ⓪0BNE     tr
  1322. ⓪.weiter:
  1323. ⓪0ADDQ.L  #8,A1
  1324. ⓪0BRA     lupo
  1325. ⓪.tr
  1326. ⓪0MOVE.L  (A7)+,A0
  1327. ⓪0MOVE.L  A1,(A0)
  1328. ⓪0MOVEQ   #1,D0           ; RETURN TRUE
  1329. ⓪0RTS
  1330. ⓪.btrf
  1331. ⓪0MOVE.L  (A7)+,A0
  1332. ⓪0MOVE.L  A1,(A0)
  1333. ⓪0MOVE    #1,endOfLenList(A2)
  1334. ⓪0CLR     D0           ; RETURN FALSE
  1335. ⓪(END
  1336. ⓪&END getProc;
  1337. ⓪&(*$L=*)
  1338. ⓪ 
  1339. ⓪$PROCEDURE skipProcName (VAR ad: LONGCARD);
  1340. ⓪&(*$L-*)
  1341. ⓪&BEGIN
  1342. ⓪(ASSEMBLER
  1343. ⓪0MOVE.L  D2,A2
  1344. ⓪0MOVE.L  imag(A2),A0
  1345. ⓪0MOVE.L  -(A3),A1
  1346. ⓪0MOVE.L  (A1),D0
  1347. ⓪.L ADDQ.L  #2,D0
  1348. ⓪0TST.B   1(A0,D0.L)
  1349. ⓪0BNE     L
  1350. ⓪0ADDQ.L  #6,D0
  1351. ⓪0MOVE.L  D0,(A1)
  1352. ⓪(END;
  1353. ⓪&END skipProcName;
  1354. ⓪&(*$L=*)
  1355. ⓪ 
  1356. ⓪$PROCEDURE setBeforeProcName (VAR ad: LONGCARD);
  1357. ⓪&(*$L-*)
  1358. ⓪&BEGIN
  1359. ⓪(ASSEMBLER
  1360. ⓪0MOVE.L  D2,A2
  1361. ⓪0MOVE.L  imag(A2),A0
  1362. ⓪0MOVE.L  -(A3),A1
  1363. ⓪0MOVE.L  (A1),D0
  1364. ⓪0SUBQ.L  #6,D0
  1365. ⓪.L SUBQ.L  #2,D0
  1366. ⓪0TST.B   0(A0,D0.L)
  1367. ⓪0BNE     L
  1368. ⓪0MOVE.L  D0,(A1)
  1369. ⓪(END;
  1370. ⓪&END setBeforeProcName;
  1371. ⓪&(*$L=*)
  1372. ⓪ 
  1373. ⓪$PROCEDURE delSymAddr (diff: LONGCARD; ende: LONGCARD);
  1374. ⓪&BEGIN
  1375. ⓪(IF hadSyms & protocol & (symbol # NIL) THEN
  1376. ⓪*REPEAT
  1377. ⓪,symbol^.addr:= $00FFFFFF;
  1378. ⓪,symbol:= symbol^.next;
  1379. ⓪*UNTIL (symbol = NIL) OR (symbol^.addr = ende)
  1380. ⓪(END
  1381. ⓪&END delSymAddr;
  1382. ⓪ 
  1383. ⓪$PROCEDURE setSymAddr (diff: LONGCARD; ende: LONGCARD);
  1384. ⓪&BEGIN
  1385. ⓪(IF hadSyms & protocol & (symbol # NIL) THEN
  1386. ⓪*REPEAT
  1387. ⓪,DEC (symbol^.addr, diff);
  1388. ⓪,symbol:= symbol^.next;
  1389. ⓪*UNTIL (symbol = NIL) OR (symbol^.addr = ende)
  1390. ⓪(END
  1391. ⓪&END setSymAddr;
  1392. ⓪ 
  1393. ⓪$VAR movedDiff: LONGCARD; (* Offset d. Verschiebung *)
  1394. ⓪ 
  1395. ⓪$BEGIN (* moveProcs *)
  1396. ⓪&WITH ModLst^[modIdx] DO
  1397. ⓪(imag:= image;
  1398. ⓪(symbol:= symbolRoot;
  1399. ⓪(hadSyms:= procSym;
  1400. ⓪((*IF hadSyms THEN Debug.Active:= TRUE; Debug.Continuous:= FALSE; END;*)
  1401. ⓪(remProcSym:= noProcSyms & hadSyms;
  1402. ⓪(IF remProcSym THEN procSym:= FALSE END;
  1403. ⓪(currEnd:= entry (image, 42); (* Codebeginn *)
  1404. ⓪(freeStart:= currEnd;
  1405. ⓪(lastEnd:= currEnd;
  1406. ⓪(movedDiff:= 0;
  1407. ⓪(procsExported:= FALSE; (* noch keine Procs exportiert *)
  1408. ⓪(endOfLenList:= FALSE;
  1409. ⓪((*
  1410. ⓪)* Der Code vom Body macht Probleme, weil er nicht in der ProcLenList
  1411. ⓪)* auftaucht. Deshalb wird hier eine Hilfsvar. "body_prl" eingesetzt,
  1412. ⓪)* die ggf. v. "getProc" entsprechend benutzt wird:
  1413. ⓪)*)
  1414. ⓪(body_prl.start:= entry (imag, 6);
  1415. ⓪(IF hadSyms THEN (* start muß _vor_ Proc-Name stehen *)
  1416. ⓪*setBeforeProcName (body_prl.start);
  1417. ⓪(END;
  1418. ⓪(body_prl.len:= codeEnd - body_prl.start;
  1419. ⓪(mark (ADR(body_prl), 1); (* Body als benutzt markieren *)
  1420. ⓪(REPEAT
  1421. ⓪*(* Zu entfernende, hintereinander liegende Procs sammeln *)
  1422. ⓪*WHILE optProcs & getProc (currEnd, prl) & NOT marked (prl) DO
  1423. ⓪,currEnd:= pEnd (prl);
  1424. ⓪,delSymAddr (movedDiff, currEnd);
  1425. ⓪*END;
  1426. ⓪*usedStart:= currEnd;
  1427. ⓪*(* usedStart: Ende zu entfernender Procs/Anfang zu erhaltender Procs *)
  1428. ⓪*(*
  1429. ⓪,IF (modIdx = 26) & (currEnd>=codeEnd) THEN
  1430. ⓪.TOSDebug.Active:= TRUE; TOSDebug.Step:= 0; TOSDebug.Continuous:= FALSE
  1431. ⓪,END;(*$D+*)
  1432. ⓪**)
  1433. ⓪*LOOP
  1434. ⓪,(* zusammenhängende, nicht zu entfernende Procs sammeln *)
  1435. ⓪,IF ~getProc (currEnd, prl) THEN
  1436. ⓪.IF currEnd # dataEnd THEN HALT END;
  1437. ⓪.IF remProcSym THEN
  1438. ⓪0IF usedStart < codeEnd THEN skipProcName (usedStart) END;
  1439. ⓪.END;
  1440. ⓪.EXIT (* -> end of code & data *)
  1441. ⓪,END;
  1442. ⓪,IF marked (prl) OR ~optProcs THEN
  1443. ⓪.(* unbenutzt:
  1444. ⓪0IF markedValue (prl) = 2 THEN procsExported:= TRUE END;
  1445. ⓪.*)
  1446. ⓪.currEnd:= pEnd (prl);
  1447. ⓪.IF remProcSym THEN
  1448. ⓪0IF usedStart < codeEnd THEN skipProcName (usedStart) END;
  1449. ⓪0EXIT (* -> move single proc *)
  1450. ⓪.ELSIF hadSyms & protocol THEN
  1451. ⓪0EXIT (* -> move single proc *)
  1452. ⓪.END
  1453. ⓪,ELSE
  1454. ⓪.EXIT (* -> move one or more procs *)
  1455. ⓪,END
  1456. ⓪*END;
  1457. ⓪*setSymAddr (movedDiff, currEnd);
  1458. ⓪*IF usedStart # freeStart THEN
  1459. ⓪,moveCode (modIdx, lastEnd, usedStart, currEnd, freeStart);
  1460. ⓪,INC (movedDiff, LONGCARD(usedStart - lastEnd))
  1461. ⓪*END;
  1462. ⓪*(* Diese Abfrage trifft leider auch bei korrekten Modulen zu:
  1463. ⓪,IF lastEnd = currEnd THEN
  1464. ⓪.HALT (* Es kam eine leere Proc/Konstante vor! Muß übersprungen werden *)
  1465. ⓪,END;
  1466. ⓪**)
  1467. ⓪*lastEnd:= currEnd;
  1468. ⓪*lastFree:= freeStart;
  1469. ⓪*freeStart:= freeStart + (currEnd - usedStart);
  1470. ⓪(UNTIL endOfLenList;
  1471. ⓪(IF symbol # NIL THEN HALT END;
  1472. ⓪(offset:= usedStart - lastFree;
  1473. ⓪(DEC (codeEnd, offset);
  1474. ⓪(DEC (dataEnd, offset);
  1475. ⓪(DEC (varStart, offset);
  1476. ⓪&END;
  1477. ⓪$END moveProcs;
  1478. ⓪"(*$D-*)
  1479. ⓪ 
  1480. ⓪ 
  1481. ⓪"VAR modidx: tIndex;
  1482. ⓪ 
  1483. ⓪"BEGIN (* Optimize *)
  1484. ⓪$IF optProcs THEN
  1485. ⓪&Report (3, 'Optimizing');
  1486. ⓪&IF ~noShModLst THEN WriteString (' / leaving data for debugging') END;
  1487. ⓪&WriteString ('...');
  1488. ⓪&FOR modidx:= 1 TO ModIndex DO
  1489. ⓪(WITH ModLst^[modidx] DO
  1490. ⓪*useCode:= mainMod OR NOT mayRemove
  1491. ⓪(END
  1492. ⓪&END;
  1493. ⓪&FOR modidx:= 1 TO ModIndex DO
  1494. ⓪(WITH ModLst^[modidx] DO
  1495. ⓪*IF useCode & NOT bodyMarked THEN
  1496. ⓪,bodyMarked:= TRUE;
  1497. ⓪,markCalls (modidx, entry (image, 6) (* Body-Einsprung *), codeEnd)
  1498. ⓪*END
  1499. ⓪(END
  1500. ⓪&END;
  1501. ⓪$ELSIF noProcSyms THEN
  1502. ⓪&Report (3, 'Removing procedure labels...');
  1503. ⓪$END;
  1504. ⓪$IF optProcs OR noProcSyms OR noHeader OR noShModLst THEN
  1505. ⓪&FOR modidx:= 1 TO ModIndex DO
  1506. ⓪(WITH ModLst^[modidx] DO
  1507. ⓪*IF mayCrunch THEN
  1508. ⓪,moveProcs (modidx)
  1509. ⓪*END;
  1510. ⓪(END
  1511. ⓪&END;
  1512. ⓪$END;
  1513. ⓪"END Optimize;
  1514. ⓪"(*$D-*)
  1515. ⓪ 
  1516. ⓪ PROCEDURE GenerateSymbolList;
  1517. ⓪"VAR modidx: tIndex;
  1518. ⓪&pn: POINTER TO LONGCARD;
  1519. ⓪&p: POINTER TO BYTE;
  1520. ⓪&ps: SymbolList;
  1521. ⓪&i, len: CARDINAL;
  1522. ⓪&prevSym: ADDRESS;
  1523. ⓪&rec: SymbolEntry;
  1524. ⓪&body: BOOLEAN;
  1525. ⓪"BEGIN
  1526. ⓪$(* zuerst Platz für die einzelnen Modulbeschreibungen (ModDesc) reservieren *)
  1527. ⓪$INC (symBufHead, ModIndex * TSIZE (ModDesc));
  1528. ⓪$IF symBufHead >= symBufEnd THEN
  1529. ⓪&RelError (FALSE);
  1530. ⓪$END;
  1531. ⓪$(* nun die Symbole anfügen *)
  1532. ⓪$FOR modidx:= 1 TO ModIndex DO
  1533. ⓪&WITH ModLst^[modidx] DO
  1534. ⓪(IF procSym THEN
  1535. ⓪*body:= TRUE;
  1536. ⓪*prevSym:= NIL;
  1537. ⓪*pn:= image + entry (image, 6) (* ^Body *) - 4;
  1538. ⓪*LOOP (* jeden Proc-Namen... *)
  1539. ⓪,len:= SHORT(LONGCARD(ADR (rec.name) - ADR (rec))) + 2;
  1540. ⓪,p:= ADDRESS(pn) - 2;
  1541. ⓪,(* Beginn d. Namens finden, Länge zählen *)
  1542. ⓪,IF body THEN
  1543. ⓪.(* Body wird als "BEGIN" protok., deswg. diese Länge zählen: *)
  1544. ⓪.INC (len, LENGTH ("BEGIN")+1);
  1545. ⓪.IF ODD(len) THEN INC (len) END
  1546. ⓪,END;
  1547. ⓪,REPEAT
  1548. ⓪.IF ~body THEN INC (len, 2) END;
  1549. ⓪.DEC (p, 2);
  1550. ⓪,UNTIL p^ = BYTE(0);
  1551. ⓪,(* Namen in Symbol-Puffer eintragen, rückwärts verketten *)
  1552. ⓪,ps:= symBufHead;
  1553. ⓪,INC (symBufHead, len);
  1554. ⓪,IF symBufHead >= symBufEnd THEN
  1555. ⓪.RelError (FALSE);
  1556. ⓪,END;
  1557. ⓪,WITH ps^ DO
  1558. ⓪.typ := 0;
  1559. ⓪.next:= prevSym;
  1560. ⓪.addr:= p - image;
  1561. ⓪.IF body THEN
  1562. ⓪0body:= FALSE;
  1563. ⓪0name:= "BEGIN";
  1564. ⓪.ELSE
  1565. ⓪0i:= 0;
  1566. ⓪0REPEAT
  1567. ⓪2INC (p);
  1568. ⓪2name[i]:= CHAR(p^);
  1569. ⓪2INC (i);
  1570. ⓪0UNTIL (p^ = BYTE(0)) OR (i = MaxSymbolLen);
  1571. ⓪0name[i]:= 0C;
  1572. ⓪.END
  1573. ⓪,END;
  1574. ⓪,prevSym:= ps;
  1575. ⓪,(* next symbol... *)
  1576. ⓪,IF pn^ = 0 THEN EXIT (* end of list *) END;
  1577. ⓪,pn:= image + pn^ - 4
  1578. ⓪*END;
  1579. ⓪*symbolRoot:= ADDRESS(ps);
  1580. ⓪(END;
  1581. ⓪&END
  1582. ⓪$END
  1583. ⓪"END GenerateSymbolList;
  1584. ⓪ 
  1585. ⓪ PROCEDURE FixSymbols;
  1586. ⓪"VAR modidx: tIndex; p: SymbolList;
  1587. ⓪"BEGIN
  1588. ⓪$FOR modidx:= 1 TO ModIndex DO
  1589. ⓪&WITH ModLst^[modidx] DO
  1590. ⓪(IF useCode THEN
  1591. ⓪*p:= symbolRoot;
  1592. ⓪*WHILE p # NIL DO
  1593. ⓪,IF p^.addr < $FFFFFF THEN DEC (p^.addr, diff) END;
  1594. ⓪,p:= p^.next
  1595. ⓪*END;
  1596. ⓪(END
  1597. ⓪&END
  1598. ⓪$END
  1599. ⓪"END FixSymbols;
  1600. ⓪ 
  1601. ⓪ PROCEDURE SymbolOutput (REF symarg: ARRAY OF CHAR): BOOLEAN;
  1602. ⓪"VAR nextMod, m: ModList; modidx: tIndex;
  1603. ⓪"BEGIN
  1604. ⓪$(* reservierte ModDesc-Einträge (s. GenerateSymbolList) ausfüllen *)
  1605. ⓪$m:= symbolBuf;
  1606. ⓪$FOR modidx:= 1 TO ModIndex DO
  1607. ⓪&nextMod:= ADDRESS(m) + SIZE (ModDesc);
  1608. ⓪&IF modidx = ModIndex THEN nextMod:= NIL END;
  1609. ⓪&WITH ModLst^[modidx] DO
  1610. ⓪(m^.next:= nextMod;
  1611. ⓪(m^.codeAdr:= codeAd;
  1612. ⓪(IF useCode THEN
  1613. ⓪*m^.codeLen:= codeEnd-codeAd;
  1614. ⓪(ELSE
  1615. ⓪*m^.codeLen:= 0
  1616. ⓪(END;
  1617. ⓪(m^.varAdr:= varAd;
  1618. ⓪(m^.varLen:= varLen;
  1619. ⓪(m^.dataAdr:= NIL;
  1620. ⓪(m^.dataLen:= 0;
  1621. ⓪(m^.sourceName:= sourceName;
  1622. ⓪(m^.codeName:= codeName;
  1623. ⓪(m^.name:= name;
  1624. ⓪(m^.symbolRoot:= symbolRoot;
  1625. ⓪(m^.compOpts:= compOpts;
  1626. ⓪(m^.mainMod:= mainMod;
  1627. ⓪&END;
  1628. ⓪&m:= nextMod
  1629. ⓪$END;
  1630. ⓪$RETURN OutputSymbols (symarg, outName, symbolBuf);
  1631. ⓪"END SymbolOutput;
  1632. ⓪ 
  1633. ⓪ 
  1634. ⓪ PROCEDURE bit (n: CARDINAL; l: ARRAY OF WORD): BOOLEAN;
  1635. ⓪"(*$L-*)
  1636. ⓪"BEGIN
  1637. ⓪$ASSEMBLER
  1638. ⓪(MOVE.W  -(A3),D2
  1639. ⓪(MOVE.L  -(A3),A0
  1640. ⓪(MOVE.W  -(A3),D1
  1641. ⓪(TST     D2
  1642. ⓪(BEQ     wd
  1643. ⓪(MOVE.L  (A0),D0
  1644. ⓪(BRA     lg
  1645. ⓪%wd MOVE.W  (A0),D0
  1646. ⓪%lg BTST    D1,D0
  1647. ⓪(SNE     D0
  1648. ⓪(ANDI    #1,D0
  1649. ⓪$END
  1650. ⓪"END bit;
  1651. ⓪"(*$L=*)
  1652. ⓪ 
  1653. ⓪ 
  1654. ⓪ PROCEDURE ExecMod (mname: tModName;       (* Name des gewuenschten Moduls *)
  1655. ⓪2reqkey: LONGCARD;       (* gewuenschter Key *)
  1656. ⓪2client: tIndex)         (* Index des Klienten *)
  1657. ⓪8: tIndex;         (* vergebener Index *)
  1658. ⓪ 
  1659. ⓪"(* Laedt das Modul "mname" und liefert dessen Index in der "ModLst"
  1660. ⓪#* als Ergebnis.
  1661. ⓪#* Der Modulkey "reqkey" wird erwartet und ueberprueft.
  1662. ⓪#* Falls ein Fehler beim Relozieren oder Laden auftritt,
  1663. ⓪#* wird der benoetigte Speicher freigegeben und als Ergebnis
  1664. ⓪#* "BadIndex" geliefert
  1665. ⓪#*)
  1666. ⓪$
  1667. ⓪"VAR
  1668. ⓪.i: tIndex;
  1669. ⓪%clientname,
  1670. ⓪*fname: tModName;
  1671. ⓪-ad: address;
  1672. ⓪"
  1673. ⓪$
  1674. ⓪"PROCEDURE LoadMod (mname, fname: tModName): tIndex;
  1675. ⓪ 
  1676. ⓪$(* Laedt ein Modul in den Speicher, ueberprueft das Format
  1677. ⓪%* und traegt in die Modul-Liste ein. Reloziert nicht!
  1678. ⓪%* Wenn ein Fehler auftritt, wird der benutzte Speicher
  1679. ⓪%* freigegeben und als Modul-Index BadIndex geliefert
  1680. ⓪%*)
  1681. ⓪ 
  1682. ⓪$PROCEDURE ImportLen (image: address): LongCard;
  1683. ⓪&
  1684. ⓪&(* Laenge der Importliste des Moduls, das bei image steht,
  1685. ⓪)in Bytes ermitteln
  1686. ⓪&*)
  1687. ⓪&
  1688. ⓪&VAR s: address; n: LONGCARD;
  1689. ⓪&
  1690. ⓪&BEGIN
  1691. ⓪(s:= entry (image, 14);
  1692. ⓪(IF s = NIL THEN
  1693. ⓪*RETURN 0L
  1694. ⓪(ELSE
  1695. ⓪*n:= 4;  (* Platz für Import-Liste (s. PutMod) *)
  1696. ⓪*s:= s+image;
  1697. ⓪*WHILE entry (s, 0) # 0L DO
  1698. ⓪,inc (s, 4);
  1699. ⓪,WHILE cardinal (s^) MOD 256 # 255 DO inc (s, 2) END;
  1700. ⓪,inc (s, 2);
  1701. ⓪,WHILE cardinal (s^) # 0 DO inc (s, 6) END;
  1702. ⓪,inc (s, 2);
  1703. ⓪,INC (n, 4);
  1704. ⓪*END;
  1705. ⓪*RETURN s+4L-image-entry (image, 14) - n
  1706. ⓪(END
  1707. ⓪&END ImportLen;
  1708. ⓪$
  1709. ⓪$VAR    foundkey: LongCard;      (* Key des geladenen Moduls    *)
  1710. ⓪-ModAdr: Address;       (* Anfang des geladenen Moduls *)
  1711. ⓪.found: Boolean;       (* fuer FileSearch             *)
  1712. ⓪,DriveNr: Cardinal;      (*  "                          *)
  1713. ⓪.VolNr: Cardinal;      (*  "                          *)
  1714. ⓪0ad1: address;       (* fuer Storage-Anforderungen  *)
  1715. ⓪0len: longcard;      (*  -"-                        *)
  1716. ⓪-layout: CARDINAL;
  1717. ⓪+realCode: CARDINAL;
  1718. ⓪-mname0: POINTER TO tModName;
  1719. ⓪,badFile: BOOLEAN;
  1720. ⓪-dummys: ARRAY [0..127] OF CHAR;
  1721. ⓪$
  1722. ⓪$BEGIN (* LoadMod *)
  1723. ⓪&IF ModIndex < LinkerParm.maxLinkMod THEN
  1724. ⓪(inc (ModIndex);
  1725. ⓪&ELSE
  1726. ⓪((*** Leider ist die Liste übergelaufen: ***)
  1727. ⓪(error (clientname, mname, TooManyMods);
  1728. ⓪(DeAllocate (ad1,0L);
  1729. ⓪(RETURN BadIndex
  1730. ⓪&END;
  1731. ⓪&
  1732. ⓪&SearchFile (fname,paths,fromStart,found,fname);
  1733. ⓪&Open (loadFile,fname,readonly);
  1734. ⓪&IF state (loadfile) < 0 THEN
  1735. ⓪(error (clientname,mname,notfound);
  1736. ⓪(RETURN BadIndex
  1737. ⓪&END;
  1738. ⓪ 
  1739. ⓪&len:= FileSize (loadFile);
  1740. ⓪&Allocate (ad1, len);
  1741. ⓪&IF ad1 = NIL THEN
  1742. ⓪(Close (loadFile);
  1743. ⓪(error (clientname,mname,nospace);
  1744. ⓪(RETURN BadIndex
  1745. ⓪&END;
  1746. ⓪ 
  1747. ⓪&ReadBytes (loadFile, ad1, len, len);
  1748. ⓪&ior:= State (loadFile);
  1749. ⓪&ResetState (loadFile);
  1750. ⓪&Close (loadFile);
  1751. ⓪&IF IOR<0 THEN
  1752. ⓪(error (clientname,mname,readerr);
  1753. ⓪(DeAllocate (ad1,0L);
  1754. ⓪(RETURN BadIndex
  1755. ⓪&END;
  1756. ⓪ 
  1757. ⓪&ASSEMBLER
  1758. ⓪(MOVE.L  ad1(A6),A0
  1759. ⓪(CMPI.L  #$4D4D3243,(A0)+        ; "MM2C"
  1760. ⓪(BNE     nocode
  1761. ⓪(CMPI.L  #$6F646500,(A0)+        ; "ode"
  1762. ⓪&nocode
  1763. ⓪(SNE     D0
  1764. ⓪(ANDI    #1,D0
  1765. ⓪(MOVE    D0,badFile(A6)
  1766. ⓪&END;
  1767. ⓪&IF badFile THEN
  1768. ⓪(error (clientname,mname,badlayout);
  1769. ⓪(DeAllocate (ad1,0L);
  1770. ⓪(RETURN BadIndex
  1771. ⓪&END;
  1772. ⓪ 
  1773. ⓪&ModAdr:= ad1+8L;
  1774. ⓪ 
  1775. ⓪&layout:= Short (entry (ModAdr, 0) DIV 65536L);
  1776. ⓪&ASSEMBLER
  1777. ⓪(MOVE.W  layout(A6),D0
  1778. ⓪(LSR.B   #5,D0
  1779. ⓪(ANDI    #3,D0
  1780. ⓪(MOVE.W  D0,realCode(A6)
  1781. ⓪&END;
  1782. ⓪&(*
  1783. ⓪(IF (layout DIV 256) < 1 THEN
  1784. ⓪*error (clientname,mname,badlayout);
  1785. ⓪*DeAllocate (ad1,0L);
  1786. ⓪*RETURN BadIndex
  1787. ⓪(END;
  1788. ⓪&*)
  1789. ⓪&
  1790. ⓪&IF singleMod THEN
  1791. ⓪(singleMod:= FALSE;
  1792. ⓪(IF bit (1, layout) THEN
  1793. ⓪*error (clientname,mname,mustnotbeimpl);
  1794. ⓪*DeAllocate (ad1,0L);
  1795. ⓪*RETURN BadIndex
  1796. ⓪(END
  1797. ⓪&END;
  1798. ⓪&
  1799. ⓪&IF realCode # 0 THEN (* real im Code *)
  1800. ⓪(IF realForm # 0 THEN (* schon Real benutzt *)
  1801. ⓪*IF realCode # realForm THEN
  1802. ⓪,error (clientname,mname,badreal);
  1803. ⓪,DeAllocate (ad1,0L);
  1804. ⓪,RETURN BadIndex
  1805. ⓪*END
  1806. ⓪(ELSE
  1807. ⓪*ReportRealFormat (realCode-1);
  1808. ⓪*realForm:= realCode
  1809. ⓪(END
  1810. ⓪&END;
  1811. ⓪&
  1812. ⓪&foundkey:= entry (ModAdr, 2);
  1813. ⓪&IF (reqkey#anykey) & (reqkey#foundkey) THEN
  1814. ⓪(error (clientname,mname,badversion);
  1815. ⓪(DeAllocate (ad1,0L);
  1816. ⓪(RETURN BadIndex
  1817. ⓪&END;
  1818. ⓪&
  1819. ⓪&(*** Modul in ModLst eintragen ***)
  1820. ⓪*
  1821. ⓪&WITH ModLst^ [ModIndex] DO
  1822. ⓪(mainMod:= LoadingMain;
  1823. ⓪(useCode:= TRUE;
  1824. ⓪(varsExported:= FALSE;
  1825. ⓪(image := ModAdr;
  1826. ⓪(mayCrunch:= (layout DIV 256) >= 2;
  1827. ⓪(IF optProcs AND NOT mayCrunch THEN
  1828. ⓪*error (clientname,mname,nooptimize);
  1829. ⓪*RETURN BadIndex
  1830. ⓪(END;
  1831. ⓪(IF noHeader AND mayCrunch THEN
  1832. ⓪*diff:= entry (image, 42) (* ganzen Header weglassen *)
  1833. ⓪(ELSE
  1834. ⓪*diff:= ImportLen (image)
  1835. ⓪(END;
  1836. ⓪(varStart:= entry (ModAdr, 22);
  1837. ⓪(dataEnd:= varStart;
  1838. ⓪(codeEnd:= entry (ModAdr, 62);
  1839. ⓪(IF codeEnd = 0 THEN (* Data-Beginn undefiniert? *)
  1840. ⓪*codeEnd:= varStart;
  1841. ⓪(END;
  1842. ⓪(BodyLen:= BodyLen + (codeEnd - entry (ModAdr, 6));
  1843. ⓪(varAd := VarNow;
  1844. ⓪(varLen:= entry (ModAdr, 10) - varStart;
  1845. ⓪(key   := foundkey;
  1846. ⓪(mname0:= ADDRESS (entry (ModAdr, 26)) + ModAdr;
  1847. ⓪(SplitPath (mname0^,dummys,sourcename);
  1848. ⓪(mname0:= ADDRESS (entry (ModAdr, 30)) + ModAdr;
  1849. ⓪(Assign (mname0^,name,ok);
  1850. ⓪(mname0:= ADDRESS (entry (ModAdr, 34)) + ModAdr;
  1851. ⓪(SplitPath (mname0^,dummys,symbolname);
  1852. ⓪(Assign (fname,codename,ok);
  1853. ⓪(symbolRoot:= NIL;
  1854. ⓪(compopts:= LONGSet(entry (ModAdr, 46));
  1855. ⓪(mayRemove:= NOT bit (2, compopts);
  1856. ⓪(procSym:= bit (4, layout);
  1857. ⓪(bodyMarked:= FALSE;
  1858. ⓪(useCode:= TRUE;
  1859. ⓪(crunched:= FALSE;
  1860. ⓪(ImpIndex:= 0;
  1861. ⓪(ImpLst:= NIL;
  1862. ⓪(varNow:= varNow + varlen;
  1863. ⓪(IF isCLinkMod (ModIndex) THEN
  1864. ⓪*WriteMod (ModIndex, conc ('©', name), fname);
  1865. ⓪(ELSE
  1866. ⓪*WriteMod (ModIndex, name, fname);
  1867. ⓪(END;
  1868. ⓪&END;
  1869. ⓪&LoadingMain:= FALSE;
  1870. ⓪&RETURN ModIndex;
  1871. ⓪$END LoadMod;
  1872. ⓪ 
  1873. ⓪ 
  1874. ⓪"PROCEDURE ImportMods (myIndex: tIndex): Boolean;
  1875. ⓪"
  1876. ⓪$VAR ReqKey: LongCard;
  1877. ⓪)ImPtr: address;
  1878. ⓪'ImIndex: tIndex;
  1879. ⓪,ok: boolean;
  1880. ⓪-i: cardinal;
  1881. ⓪ 
  1882. ⓪$BEGIN
  1883. ⓪&WITH ModLst^ [myIndex] DO
  1884. ⓪((* Anzahl der importierten Module bestimmen *)
  1885. ⓪((* und entspr. Speicher allozieren          *)
  1886. ⓪(ImPtr:= image + entry (image, 14); (* ^ImportListe *)
  1887. ⓪(ReqKey:= entry (ImPtr, 0);         (* importiertes Modul *)
  1888. ⓪(i:= 2;
  1889. ⓪(WHILE ReqKey # 0L DO
  1890. ⓪*inc (ImPtr, 4);
  1891. ⓪*SkipStr (ImPtr);
  1892. ⓪*SkipImpList (ImPtr);
  1893. ⓪*inc(i);
  1894. ⓪*ReqKey:= entry (ImPtr, 0)
  1895. ⓪(END; (* alle Importe abgearbeitet *)
  1896. ⓪(ALLOCATE (ImpLst, LONG (i) * TSIZE (tIndex));
  1897. ⓪(IF ImpLst = NIL THEN
  1898. ⓪*error (clientname,name,nospace)
  1899. ⓪(END;
  1900. ⓪ 
  1901. ⓪(ImPtr:= image + entry (image, 14); (* ^ImportListe *)
  1902. ⓪(ReqKey:= entry (ImPtr, 0);         (* importiertes Modul *)
  1903. ⓪(ok:= true;
  1904. ⓪(WHILE (ReqKey # 0L) & ok DO
  1905. ⓪*inc (ImPtr, 4);
  1906. ⓪*ImIndex:= ExecMod (getstr (ImPtr), ReqKey, myIndex);
  1907. ⓪*IF ImIndex # BadIndex THEN
  1908. ⓪,SkipImpList (ImPtr);
  1909. ⓪,inc(ImpIndex);
  1910. ⓪,ImpLst^[ImpIndex]:= ImIndex
  1911. ⓪*ELSE
  1912. ⓪,ok:= false
  1913. ⓪*END;
  1914. ⓪*ReqKey:= entry (ImPtr, 0)
  1915. ⓪(END; (* alle Importe abgearbeitet *)
  1916. ⓪&END;
  1917. ⓪&RETURN ok
  1918. ⓪$END ImportMods;
  1919. ⓪"
  1920. ⓪"VAR s1,s2: tModName;
  1921. ⓪"
  1922. ⓪"BEGIN (* of ExecMod *)
  1923. ⓪$IF codesuffix THEN
  1924. ⓪&paths:= ImpPaths;
  1925. ⓪&ConcatName (mname, DefImpInSuf, fname)
  1926. ⓪$ELSE
  1927. ⓪&fname:= mname;
  1928. ⓪&SplitFileName (fname, mname, s1);
  1929. ⓪&Upper (s1);
  1930. ⓪&IF StrEqual (s1,DefImpInSuf) THEN
  1931. ⓪(paths:= ImpPaths
  1932. ⓪&ELSE
  1933. ⓪(paths:= ModPaths
  1934. ⓪&END
  1935. ⓪$END;
  1936. ⓪$codesuffix:= true;
  1937. ⓪$
  1938. ⓪$IF client = BadIndex THEN
  1939. ⓪&clientname:= mname
  1940. ⓪$ELSE
  1941. ⓪&Assign (ModLst^ [client].name, clientname, ok)
  1942. ⓪$END;
  1943. ⓪$
  1944. ⓪$Assign (mname,s1,ok);
  1945. ⓪$Upper (s1);
  1946. ⓪$FOR i:=1 TO ModIndex DO
  1947. ⓪&WITH ModLst^ [i] DO
  1948. ⓪(FastStrings.Assign (name,s2);
  1949. ⓪(Upper (s2);
  1950. ⓪(IF StrEqual (s1,s2) THEN
  1951. ⓪*IF (reqkey#anykey) & (reqkey#key) THEN
  1952. ⓪,error (clientname,mname,badversion);
  1953. ⓪,RETURN BadIndex
  1954. ⓪*ELSE
  1955. ⓪,(*** tatsaechlich: wir haben das richtige Modul im RAM ***)
  1956. ⓪,RETURN i
  1957. ⓪*END
  1958. ⓪(END
  1959. ⓪&END
  1960. ⓪$END;
  1961. ⓪$
  1962. ⓪$(*** Hier kommen wir an, wenn Modul nicht im RAM liegt ***)
  1963. ⓪$
  1964. ⓪$i:= LoadMod (mname, fname);
  1965. ⓪$IF i # BadIndex THEN (* Load war erfolgreich *)
  1966. ⓪&IF ImportMods (i) THEN
  1967. ⓪(inc (InitIndex);
  1968. ⓪(InitLst^[InitIndex]:= i;  (* i zum Initialisieren vormerken *)
  1969. ⓪(RETURN i
  1970. ⓪&ELSE (* ImportMods ist schiefgegangen *)
  1971. ⓪(RETURN BadIndex
  1972. ⓪&END;
  1973. ⓪$ELSE (* Load ist schiefgegangen *)
  1974. ⓪&RETURN BadIndex
  1975. ⓪$END
  1976. ⓪"END ExecMod;
  1977. ⓪ 
  1978. ⓪ 
  1979. ⓪ 
  1980. ⓪ (*$L-,R-*)
  1981. ⓪ PROCEDURE PutIntoRelTab ( v: longcard );
  1982. ⓪"(* VAR d:longcard; *)
  1983. ⓪"BEGIN
  1984. ⓪$ASSEMBLER
  1985. ⓪(MOVE.L  -(A3),D0
  1986. ⓪(TST.L   firstRelVal
  1987. ⓪(BNE     c0
  1988. ⓪(MOVE.L  D0,firstRelVal
  1989. ⓪(BRA     e0
  1990. ⓪ c0      CMP.L   lastRelVal,D0
  1991. ⓪(BHI     c1
  1992. ⓪ jErr    CLR     (A3)+
  1993. ⓪(JMP     RelError                ; Programmende
  1994. ⓪ c1      MOVE.L  D0,D1
  1995. ⓪(SUB.L   lastRelVal,D1
  1996. ⓪(
  1997. ⓪(MOVE.L  pRelTab,A0
  1998. ⓪ l1      CMPA.L  eRelTab,A0
  1999. ⓪(BCC     jErr                    ; Listenüberlauf
  2000. ⓪(CMPI.L  #256,D1
  2001. ⓪(BCS     c2
  2002. ⓪(MOVE.B  #1,(A0)+
  2003. ⓪(SUBI.L  #254,D1
  2004. ⓪(BRA     l1
  2005. ⓪ c2      MOVE.B  D1,(A0)+
  2006. ⓪(MOVE.L  A0,pRelTab
  2007. ⓪ 
  2008. ⓪ e0      MOVE.L  D0,lastRelVal
  2009. ⓪$END
  2010. ⓪"END PutIntoRelTab;
  2011. ⓪ (*$L+,R+*)
  2012. ⓪ 
  2013. ⓪ 
  2014. ⓪ (*
  2015. ⓪!* Globale Vars:
  2016. ⓪!*)
  2017. ⓪ VAR    ListTop: POINTER TO ARRAY [1..100000] OF pLONG;
  2018. ⓪'ListBeg: POINTER TO ARRAY [1..100000] OF pLONG;
  2019. ⓪%ListIndex: cardinal;
  2020. ⓪&LastDrop: pLONG;
  2021. ⓪)eoLists, Lists: pLONG;
  2022. ⓪ 
  2023. ⓪ 
  2024. ⓪ PROCEDURE dialog(): Boolean;
  2025. ⓪ 
  2026. ⓪"(*$R-*)
  2027. ⓪"PROCEDURE ClrList;
  2028. ⓪$VAR i : cardinal;
  2029. ⓪$BEGIN
  2030. ⓪&FOR i:= 1 TO ListIndex DO
  2031. ⓪(ListTop^[i]:= NIL
  2032. ⓪&END;
  2033. ⓪&ListIndex:= 0;
  2034. ⓪&LastDrop:= Lists
  2035. ⓪$END ClrList;
  2036. ⓪ 
  2037. ⓪"(*$R-,L-*)
  2038. ⓪"PROCEDURE SmallestInList() : LONGCARD;
  2039. ⓪$BEGIN
  2040. ⓪&ASSEMBLER
  2041. ⓪(MOVEQ   #-1,D0
  2042. ⓪(CLR.W   D1
  2043. ⓪(MOVEQ   #1,D2
  2044. ⓪&forloop0
  2045. ⓪(CMP     listIndex,D2
  2046. ⓪(BHI     forend0
  2047. ⓪(MOVE    D2,D3
  2048. ⓪(SUBQ    #1,D3
  2049. ⓪(ASL     #2,D3
  2050. ⓪(MOVE.L  ListTop,A0
  2051. ⓪(MOVE.L  0(A0,D3.W),A1
  2052. ⓪(CMPA.L  #NIL,A1
  2053. ⓪(BEQ     cont0
  2054. ⓪(MOVE.L  (A1),D4
  2055. ⓪(CMP.L   D4,D0
  2056. ⓪(BLS     cont0
  2057. ⓪(MOVE.L  D4,D0
  2058. ⓪(MOVE    D2,D1
  2059. ⓪&cont0
  2060. ⓪(ADDQ    #1,D2
  2061. ⓪(BRA     forloop0
  2062. ⓪&forend0
  2063. ⓪(TST     D1
  2064. ⓪(BEQ     ende
  2065. ⓪(SUBQ    #1,D1
  2066. ⓪(ASL     #2,D1
  2067. ⓪(MOVE.L  ListTop,A0
  2068. ⓪(MOVE.L  0(A0,D1.W),D2
  2069. ⓪(MOVE.L  ListBeg,A1
  2070. ⓪(CMP.L   0(A1,D1.W),D2
  2071. ⓪(BNE     cont1
  2072. ⓪(CLR.L   0(A0,D1.W)
  2073. ⓪(BRA     cont2
  2074. ⓪&cont1
  2075. ⓪(SUBQ.L  #4,0(A0,D1.W)
  2076. ⓪&cont2
  2077. ⓪(RTS
  2078. ⓪&ende
  2079. ⓪(CLR.L   D0
  2080. ⓪&END
  2081. ⓪$END SmallestInList;
  2082. ⓪"
  2083. ⓪"(*$R-,L+*)
  2084. ⓪"PROCEDURE reloc (myMod, imMod: ptrModDesc; VAR ImPtr: ADDRESS; VAR ok: BOOLEAN);
  2085. ⓪$BEGIN
  2086. ⓪&ASSEMBLER
  2087. ⓪(MOVEM.L D3/D4/D6/A4/A5,-(A7)
  2088. ⓪ 
  2089. ⓪(MOVE.L  myMod(A6),A4
  2090. ⓪(MOVE.L  tModDesc.image(A4),A4   ;^ zu relozierendes Modul
  2091. ⓪(
  2092. ⓪(MOVE.L  ImPtr(A6),A1
  2093. ⓪(MOVE.L  (A1),A1
  2094. ⓪(MOVEQ   #1,D6         ;noch ist alles 'ok'
  2095. ⓪(
  2096. ⓪(MOVE.L  A6,-(A7)
  2097. ⓪(MOVE.L  imMod(A6),A6            ;A6 ist ^ModLst^ [ImIndex]
  2098. ⓪(MOVE.L  tModDesc.image(A6),A2   ;A2 zeigt auf imp. Modul
  2099. ⓪!
  2100. ⓪!!RE6   MOVE.W  (A1)+,D0      ;imp. ItemNr
  2101. ⓪(BEQ.L   RE5           ;fertig mit diesem Import
  2102. ⓪(MOVE.L  18(A2),D3     ;Offset zur Exp.liste
  2103. ⓪(BEQ.L   BAD           ;keine da
  2104. ⓪(ADD.L   A2,D3
  2105. ⓪(MOVE.L  (A1)+,D1      ;importiertes Item
  2106. ⓪(BEQ     RE6           ; wird gar nicht benutzt
  2107. ⓪ 
  2108. ⓪(MOVE    ListIndex,D4
  2109. ⓪(CMP.W   ListMax,D4
  2110. ⓪(BCC.W   relerr2
  2111. ⓪(ADDQ    #1,ListIndex
  2112. ⓪(MOVE.L  ListBeg,A5
  2113. ⓪(MOVE    ListIndex,D4
  2114. ⓪(SUBQ    #1,D4
  2115. ⓪(LSL     #2,D4
  2116. ⓪(CLR.L   0(A5,D4.W)
  2117. ⓪ 
  2118. ⓪(MOVE.L  D3,A0
  2119. ⓪!!RE9   MOVE.W  (A0)+,D2      ;Item in Exportliste suchen
  2120. ⓪(BEQ.W   BAD           ; schade - Liste zuende
  2121. ⓪(CMP.W   D2,D0
  2122. ⓪(BEQ     RE10          ;gefunden
  2123. ⓪(ADDQ.L  #4,A0
  2124. ⓪(BRA     RE9
  2125. ⓪!!RE10  MOVE.L  (A0)+,D2      ;abs. ItemAdr ausrechnen
  2126. ⓪(BEQ     re6           ;wurde wegoptimiert
  2127. ⓪(CMP.L   22(A2),D2
  2128. ⓪(BCC     isVa2         ;das ist eine Var-Referenz
  2129. ⓪(ADD.L   tModDesc.codeAd(A6),D2 ;Prozeduren: + Modulanfang
  2130. ⓪(SUB.L   tModDesc.diff(A6),D2   ;            - Importlisten-Laenge
  2131. ⓪(BRA     RE11
  2132. ⓪!!isVa2 ADD.L   tModDesc.varAd(A6),D2  ;Variablen: + VarAnfang
  2133. ⓪(ADD.L   BSSstart,D2   ;Offset zu BSS addieren
  2134. ⓪(SUB.L   22(A2),D2
  2135. ⓪!!RE11  CMP.L   22(A4),D1     ;liegt Ref innerhalb des Codes ?
  2136. ⓪(BCC.W   bad
  2137. ⓪(MOVE.L  0(A4,D1.L),D0 ;ItemAdr im Modul nachtragen
  2138. ⓪(MOVE.L  D2,0(A4,D1.L)
  2139. ⓪ 
  2140. ⓪(MOVE.L  (A7),A6
  2141. ⓪(MOVE.L  A1,-(A7)
  2142. ⓪(MOVE.L  myMod(A6),A5
  2143. ⓪(MOVE.L  D1,D4
  2144. ⓪(ADD.L   tModDesc.codead(A5),D4
  2145. ⓪(SUB.L   tModDesc.diff(A5),D4
  2146. ⓪ 
  2147. ⓪(MOVE.L  lastDrop,A5
  2148. ⓪(CMPA.L  eoLists,A5
  2149. ⓪(BCC     relerr1
  2150. ⓪(MOVE.L  D4,(A5)
  2151. ⓪(MOVE    listIndex,D4
  2152. ⓪(SUBQ    #1,D4
  2153. ⓪(ASL     #2,D4
  2154. ⓪(MOVE.L  ListTop,A1
  2155. ⓪(MOVE.L  A5,0(A1,D4.W)
  2156. ⓪(MOVE.L  ListBeg,A1
  2157. ⓪(TST.L   0(A1,D4.W)
  2158. ⓪(BNE.S   cont2
  2159. ⓪(MOVE.L  A5,0(A1,D4.W)
  2160. ⓪&cont2
  2161. ⓪(ADDQ.L  #4,lastDrop
  2162. ⓪ 
  2163. ⓪(MOVE.L  (A7)+,A1
  2164. ⓪(MOVE.L  imMod(A6),A6            ;A6 ist ^ModLst^ [ImIndex]
  2165. ⓪ 
  2166. ⓪(MOVE.L  D0,D1
  2167. ⓪(BNE     RE11
  2168. ⓪(BRA     RE6
  2169. ⓪ 
  2170. ⓪&relerr2
  2171. ⓪(JMP     RelError2
  2172. ⓪&relerr1
  2173. ⓪(CLR     (A3)+
  2174. ⓪(JMP     RelError
  2175. ⓪ 
  2176. ⓪!!bad   CLR.W   D6            ;FehlerFlag
  2177. ⓪!!RE5   MOVE.L  (A7)+,A6      ;A6 wieder reparieren
  2178. ⓪(MOVE.L  ImPtr(A6),A0
  2179. ⓪(MOVE.L  A1,(A0)
  2180. ⓪(MOVE.L  ok(A6),A0
  2181. ⓪(MOVE.W  D6,(A0)
  2182. ⓪ 
  2183. ⓪(MOVEM.L (A7)+,D3/D4/D6/A4/A5
  2184. ⓪&END
  2185. ⓪$END reloc;
  2186. ⓪ 
  2187. ⓪"(*$R+,L+*)
  2188. ⓪"PROCEDURE Relocate ( myIndex: tIndex ) : Boolean;
  2189. ⓪"
  2190. ⓪$VAR      v: LongCard;
  2191. ⓪)ImPtr: address;
  2192. ⓪'ImIndex: tIndex;
  2193. ⓪,ok: boolean;
  2194. ⓪-i: cardinal;
  2195. ⓪!main, importn: tModName;
  2196. ⓪(ptrMod: ptrModDesc;
  2197. ⓪(
  2198. ⓪$BEGIN
  2199. ⓪&(*** Zuerst die Var/Proc-Liste abarbeiten ***)
  2200. ⓪&
  2201. ⓪&ptrMod:= ADR (ModLst^ [myIndex]);
  2202. ⓪&Assign (ptrMod^.name, main, ok);
  2203. ⓪&ClrList;
  2204. ⓪&
  2205. ⓪&ASSEMBLER
  2206. ⓪/MOVEM.L D3/D4/D5/D6/A4/A5/A6,-(A7)
  2207. ⓪/MOVE.L  ListTop,D4
  2208. ⓪/MOVE.L  ListBeg,D5
  2209. ⓪/MOVE.W  ListIndex,D6
  2210. ⓪/MOVE    D6,D3
  2211. ⓪/SUBQ    #1,D3
  2212. ⓪/ASL     #2,D3
  2213. ⓪/MOVE.L  lastDrop,A5
  2214. ⓪/MOVE.L  ptrMod(A6),A1
  2215. ⓪ 
  2216. ⓪/MOVE.L  tModDesc.image(A1),A4    ;A4 zeigt auf Modul-Bild im RAM
  2217. ⓪/MOVE.L  22(A4),A0       ;^Var/ProcListe
  2218. ⓪/ADDA.L  A4,A0
  2219. ⓪(!RE3   MOVE.L  (A0)+,D0        ;^letzte Ref
  2220. ⓪/BEQ.W   RE1             ;Ende der Liste
  2221. ⓪/
  2222. ⓪/MOVE.L  (A0)+,D1        ;rel. Adresse
  2223. ⓪/BEQ     re3             ;wurde wegoptimiert
  2224. ⓪ 
  2225. ⓪/CMP.W   ListMax,D6      ;ListIndex
  2226. ⓪/BCC.W   relerr2b
  2227. ⓪/ADDQ    #1,D6           ;ListIndex
  2228. ⓪/ADDQ    #4,D3
  2229. ⓪/MOVE.L  D5,A6
  2230. ⓪/CLR.L   0(A6,D3.W)
  2231. ⓪ 
  2232. ⓪/CMP.L   22(A4),D1
  2233. ⓪/BCC     isVar           ;das ist eine Var-Referenz
  2234. ⓪/ADD.L   tModDesc.codeAd(A1),D1   ;Prozeduren: + Modulanfang
  2235. ⓪/SUB.L   tModDesc.diff(A1),D1     ;            - Importlisten-Laenge
  2236. ⓪/BRA     RE2
  2237. ⓪(!isVar ADD.L   tModDesc.varAd(A1),D1    ;Variablen: + VarAnfang
  2238. ⓪/ADD.L   BSSstart,D1     ;Offset zu BSS addieren
  2239. ⓪/SUB.L   22(A4),D1
  2240. ⓪(!RE2   CMP.L   22(A4),D0       ;liegt Ref innerhalb des Codes ?
  2241. ⓪/BCC.S   bad2
  2242. ⓪/MOVE.L  0(A4,D0.L),D2   ;^naechste Ref
  2243. ⓪/MOVE.L  D1,0(A4,D0.L)   ;Adresse eintragen
  2244. ⓪ 
  2245. ⓪/ADD.L   tModDesc.codead(A1),D0
  2246. ⓪/SUB.L   tModDesc.diff(A1),D0
  2247. ⓪ 
  2248. ⓪/CMPA.L  eoLists,A5
  2249. ⓪/BCC.S   relerr
  2250. ⓪/MOVE.L  D0,(A5)
  2251. ⓪/MOVE.L  D4,A6
  2252. ⓪/MOVE.L  A5,0(A6,D3.W)
  2253. ⓪/MOVE.L  D5,A6
  2254. ⓪/TST.L   0(A6,D3.W)
  2255. ⓪/BNE.S   cont
  2256. ⓪/MOVE.L  A5,0(A6,D3.W)
  2257. ⓪-cont
  2258. ⓪/ADDQ.L  #4,A5
  2259. ⓪ 
  2260. ⓪/MOVE.L  D2,D0
  2261. ⓪/BNE     RE2             ;weitere Refs auf dieses Objekt
  2262. ⓪/BRA     RE3             ;pruefe, ob weitere Objekte
  2263. ⓪ 
  2264. ⓪-relerr
  2265. ⓪/CLR     (A3)+
  2266. ⓪/JMP     RelError
  2267. ⓪-relerr2b
  2268. ⓪/JMP     RelError2
  2269. ⓪ 
  2270. ⓪(!bad2
  2271. ⓪/MOVE.W  D6,ListIndex
  2272. ⓪/MOVE.L  A5,lastDrop
  2273. ⓪/MOVEM.L (A7)+,D3/D4/D5/D6/A4/A5/A6
  2274. ⓪/END; error ('',main,relocerr); ASSEMBLER
  2275. ⓪/BRA     RE0
  2276. ⓪ 
  2277. ⓪(!RE1   MOVE.L  A5,lastDrop
  2278. ⓪/MOVE.W  D6,ListIndex
  2279. ⓪/MOVEM.L (A7)+,D3/D4/D5/D6/A4/A5/A6
  2280. ⓪)RE0
  2281. ⓪&END;
  2282. ⓪ 
  2283. ⓪((*** Jetzt kümmern wir uns um die Importe ***)
  2284. ⓪&
  2285. ⓪&WITH ptrMod^ DO
  2286. ⓪(ImPtr:= image + entry (image, 14); (* ^ImportListe *)
  2287. ⓪(i:= 1;
  2288. ⓪(ok:= TRUE;
  2289. ⓪(WHILE ( i <= ImpIndex ) & ok DO
  2290. ⓪*inc (ImPtr, 4);
  2291. ⓪*Skipstr (ImPtr); (* ImPtr hinter Namen setzen *)
  2292. ⓪*ImIndex:= ImpLst^[i];
  2293. ⓪*Assign (ModLst^ [ImIndex].name, importn, ok);
  2294. ⓪*reloc (ptrMod, ADR (ModLst^ [ImIndex]), ImPtr, ok);
  2295. ⓪*IF ~ok THEN error (importn,main,relocerr) END;
  2296. ⓪*inc(i)
  2297. ⓪(END; (* alle Importe abgearbeitet *)
  2298. ⓪&END; (* with ModLst^ [myIndex] *)
  2299. ⓪ 
  2300. ⓪&(* Alle f. dieses Modul relozierten Adressen in RelTab eintragen *)
  2301. ⓪&
  2302. ⓪&v:= SmallestInList();
  2303. ⓪&WHILE v # 0L DO
  2304. ⓪(PutIntoRelTab(v);
  2305. ⓪(v:= SmallestInList()
  2306. ⓪&END;
  2307. ⓪&
  2308. ⓪&RETURN ok
  2309. ⓪$END Relocate;
  2310. ⓪ 
  2311. ⓪ 
  2312. ⓪"PROCEDURE setCodeAd;
  2313. ⓪$VAR i: tIndex;
  2314. ⓪$BEGIN
  2315. ⓪&FOR i:= 1 TO ModIndex DO
  2316. ⓪(WITH ModLst^ [i] DO
  2317. ⓪*IF useCode THEN
  2318. ⓪,modlen:= dataEnd - diff;
  2319. ⓪,codeAd:= CodeNow;
  2320. ⓪,CodeNow:= CodeNow + modlen
  2321. ⓪*ELSE
  2322. ⓪,ClearMod (i);
  2323. ⓪,DEC (UsedCodes);
  2324. ⓪,DEC (UsedInits);
  2325. ⓪,modlen:= 0
  2326. ⓪*END
  2327. ⓪(END
  2328. ⓪&END;
  2329. ⓪$END setCodeAd;
  2330. ⓪ 
  2331. ⓪ 
  2332. ⓪"PROCEDURE AnotherMod ():BOOLEAN;
  2333. ⓪$VAR c:CHAR;
  2334. ⓪$BEGIN
  2335. ⓪&Prompt (1, 'Another module (Y/N) ? ');
  2336. ⓪&REPEAT
  2337. ⓪(Read (c);
  2338. ⓪(c:=CAP(c);
  2339. ⓪&UNTIL (c='Y') OR (c='N') OR (c=33C) OR (c=15C);
  2340. ⓪&RETURN (c='Y') OR (c=15C)
  2341. ⓪$END AnotherMod;
  2342. ⓪"
  2343. ⓪"VAR    i,j: cardinal;
  2344. ⓪*ln: INTEGER;
  2345. ⓪%DriveNr: Cardinal;
  2346. ⓪'VolNr: Cardinal;
  2347. ⓪)len: Cardinal;
  2348. ⓪+f: file;
  2349. ⓪%modName: string;
  2350. ⓪ nameProvided: BOOLEAN;
  2351. ⓪"modNameIdx: CARDINAL;
  2352. ⓪&outsuf: String;
  2353. ⓪+s: string;
  2354. ⓪%symargs: String;
  2355. ⓪ initlistargs: String;
  2356. ⓪$outFirst: boolean;
  2357. ⓪%inFirst: boolean;
  2358. ⓪(argc: CARDINAL;
  2359. ⓪(argv: ARRAY [0..9] OF PtrArgStr;
  2360. ⓪%modIdx2: tIndex;
  2361. ⓪$firstMod: BOOLEAN;
  2362. ⓪#linkCount: CARDINAL;
  2363. ⓪%gotLast: BOOLEAN;
  2364. ⓪%tabSize: LONGCARD;
  2365. ⓪$l, avail: LONGINT;
  2366. ⓪ 
  2367. ⓪"PROCEDURE asn (i: CARDINAL; VAR d: ARRAY OF CHAR);
  2368. ⓪$BEGIN
  2369. ⓪&IF s[2] # 0C THEN
  2370. ⓪(INC (argv[i], 2);
  2371. ⓪(FastStrings.Assign (argv[i]^, d);
  2372. ⓪&END
  2373. ⓪$END asn;
  2374. ⓪ 
  2375. ⓪"BEGIN (* of Dialog *)
  2376. ⓪$optProcs:= FALSE;
  2377. ⓪$noHeader:= FALSE;
  2378. ⓪$noShModLst:= FALSE;
  2379. ⓪$noProcSyms:= FALSE;
  2380. ⓪$outname:= '';
  2381. ⓪$nameProvided:= FALSE;
  2382. ⓪$modNameIdx:= 0;
  2383. ⓪$HeaderFlags:= {};
  2384. ⓪$symBufFact:= 1000;
  2385. ⓪$DATALen:= 0;
  2386. ⓪$DATAFileName:= '';
  2387. ⓪$InitArgCV (argc,argv);
  2388. ⓪$FOR i:= 1 TO argc-1 DO
  2389. ⓪&Assign (argv[i]^, s, ok);
  2390. ⓪&Upper (s);
  2391. ⓪&IF (s[0] = '-') OR (s[0] = '/') THEN
  2392. ⓪(CASE s[1] OF
  2393. ⓪(| '0'..'9':
  2394. ⓪,j:= 1;
  2395. ⓪,INCL (HeaderFlags, StrConv.StrToCard (s,j,ok));
  2396. ⓪(| 'R':
  2397. ⓪,j:= 2;
  2398. ⓪,j:= StrConv.StrToCard (s,j,ok);
  2399. ⓪,IF j >= 100 THEN ListMax:= j END;
  2400. ⓪(| 'S':
  2401. ⓪,protocol:= TRUE;
  2402. ⓪,asn (i, symargs);
  2403. ⓪(| 'I':
  2404. ⓪,initList:= TRUE;
  2405. ⓪,asn (i, initlistargs);
  2406. ⓪(| 'H':
  2407. ⓪,optProcs:= TRUE;
  2408. ⓪(| 'F':
  2409. ⓪,optProcs:= TRUE;
  2410. ⓪,noHeader:= TRUE;
  2411. ⓪,noShModLst:= TRUE;
  2412. ⓪,noProcSyms:= TRUE;
  2413. ⓪(| 'M':
  2414. ⓪,noProcSyms:= TRUE;
  2415. ⓪(| 'V':
  2416. ⓪,VerboseOutput;
  2417. ⓪(| 'O':
  2418. ⓪,asn (i, outname);
  2419. ⓪(| 'D':
  2420. ⓪,j:= 2;
  2421. ⓪,DATALen:= StrConv.StrToLCard (s,j,ok);
  2422. ⓪,IF DATALen = 0 THEN
  2423. ⓪.asn (i, DATAFileName);
  2424. ⓪.IF Empty (DATAFileName) THEN
  2425. ⓪0ReportError ("Option 'D' needs a file name or a number for the DATA size");
  2426. ⓪.ELSE
  2427. ⓪0Open (f, DATAFileName, readonly);
  2428. ⓪0IF State (f) < 0 THEN
  2429. ⓪2ReportError (conc ('Cannot open DATA file: ', DATAFileName));
  2430. ⓪0ELSE
  2431. ⓪2DATALen:= FileSize (f);
  2432. ⓪2Close (f)
  2433. ⓪0END;
  2434. ⓪.END
  2435. ⓪,END
  2436. ⓪(ELSE
  2437. ⓪*ReportError (conc ('Illegal option character: ', s[1]));
  2438. ⓪(END;
  2439. ⓪(argv[i]^[0]:= 0C
  2440. ⓪&ELSE
  2441. ⓪(IF ~nameProvided THEN
  2442. ⓪*nameProvided:= TRUE;
  2443. ⓪*modNameIdx:= i;
  2444. ⓪(ELSE
  2445. ⓪*ReportError (conc ('Illegal cmdline argument: ', s));
  2446. ⓪(END;
  2447. ⓪&END
  2448. ⓪$END;
  2449. ⓪$outFirst:= TRUE;
  2450. ⓪$REPEAT
  2451. ⓪&IF outFirst & (outname[0] = '') THEN
  2452. ⓪(SplitPath (argv[modNameIdx]^,s,outName);
  2453. ⓪(SplitName (outName,outName,outSuf);
  2454. ⓪(IF outName[0] # '' THEN
  2455. ⓪*IF Compare (outsuf, 'MOS') = equal THEN
  2456. ⓪,Append ('.TOS', outname, ok)
  2457. ⓪*ELSIF Compare (outsuf, 'MTP') = equal THEN
  2458. ⓪,Append ('.TTP', outname, ok)
  2459. ⓪*ELSIF Compare (outsuf, 'MAC') = equal THEN
  2460. ⓪,Append ('.ACC', outname, ok)
  2461. ⓪*END;
  2462. ⓪*FastStrings.Insert (s, 0, outname)
  2463. ⓪(END
  2464. ⓪&END;
  2465. ⓪&IF ~outFirst OR (outname[0] = 0C) THEN
  2466. ⓪(Prompt (0, 'Output file name? ');
  2467. ⓪(ReadString (outName);
  2468. ⓪&END;
  2469. ⓪&outFirst:= FALSE;
  2470. ⓪&IF outname[0] = 0C THEN
  2471. ⓪(RETURN false
  2472. ⓪&ELSIF NOT hasSuffix (outName) THEN
  2473. ⓪(Append (DefOutSuf, outname, ok)
  2474. ⓪&END;
  2475. ⓪&ReplaceHome (outName);
  2476. ⓪&Report (0, 'Output file name: ');
  2477. ⓪&Upper (outName);
  2478. ⓪&WriteString (outName);
  2479. ⓪&
  2480. ⓪&Create (outFile, outName, writeOnly, replaceOld);
  2481. ⓪&
  2482. ⓪&ior:= State (outFile);
  2483. ⓪&IF ior<0 THEN
  2484. ⓪(MyError (ior)
  2485. ⓪&END;
  2486. ⓪$UNTIL ior=0;
  2487. ⓪$ClearEOP;
  2488. ⓪$
  2489. ⓪$CodeNow:= 18 + LENGTH (CodeID) + 1 + SysVarSpace;
  2490. ⓪F(* Platz fuer Start-LEA's/JMP und PDB *)
  2491. ⓪$VarNow:= 0L;
  2492. ⓪$BodyLen:= 0;
  2493. ⓪$
  2494. ⓪$ModIndex:= 0;
  2495. ⓪$modIdx2:=0;
  2496. ⓪$firstMod:= TRUE;
  2497. ⓪$linkCount:= MIN (LLRange);
  2498. ⓪$gotLast:= FALSE;
  2499. ⓪$LOOP
  2500. ⓪&inFirst:= TRUE;
  2501. ⓪&REPEAT
  2502. ⓪(IF inFirst & (nameProvided) THEN
  2503. ⓪*WHILE (linkCount<=MAX(LLRange)) & ~LinkerParm.linkList[linkCount].valid DO
  2504. ⓪,INC (linkCount)
  2505. ⓪*END;
  2506. ⓪*IF linkCount>MAX(LLRange) THEN
  2507. ⓪,Assign (ArgV[modNameIdx]^,ModName,ok);
  2508. ⓪,gotLast:= TRUE
  2509. ⓪*ELSE
  2510. ⓪,Assign (LinkerParm.linkList[linkCount].name,ModName,ok);
  2511. ⓪,INC (linkCount)
  2512. ⓪*END
  2513. ⓪(ELSIF nameProvided THEN
  2514. ⓪*ModName:= '' (* Programmabbruch *)
  2515. ⓪(ELSE
  2516. ⓪*Prompt (1, 'Module name? ');
  2517. ⓪*ReadString (ModName);
  2518. ⓪(END;
  2519. ⓪(inFirst:= FALSE;
  2520. ⓪(IF length (ModName) = 0 THEN
  2521. ⓪*Remove (outfile);
  2522. ⓪*RETURN false
  2523. ⓪(ELSIF NOT hasSuffix (ModName) THEN
  2524. ⓪*ConcatName (modname, DefPrgInSuf, modname);
  2525. ⓪(END;
  2526. ⓪(DiscardMods (modIdx2);
  2527. ⓪(Report (1, 'Module name: ');
  2528. ⓪(WriteString (ModName);
  2529. ⓪(IF firstMod THEN
  2530. ⓪*singleMod:= TRUE;
  2531. ⓪*InitIndex:= 0;
  2532. ⓪*ClearEOP;
  2533. ⓪(END;
  2534. ⓪((* Release geladene Moduln: *)
  2535. ⓪(WHILE ModIndex # modIdx2 DO
  2536. ⓪*DeAllocate (ModLst^ [ModIndex].ImpLst,0L);
  2537. ⓪*DeAllocate (ModLst^ [ModIndex].image,0L);
  2538. ⓪*DEC (ModIndex)
  2539. ⓪(END;
  2540. ⓪(LoadingMain:= TRUE;
  2541. ⓪(CodeSuffix:= false
  2542. ⓪&UNTIL ExecMod (modname, anykey, BadIndex) # BadIndex;
  2543. ⓪&IF firstMod THEN
  2544. ⓪(InitIdx2:= InitIndex
  2545. ⓪&END;
  2546. ⓪&IF nameProvided & gotLast THEN
  2547. ⓪(EXIT
  2548. ⓪&END;
  2549. ⓪&IF ~nameProvided & ~AnotherMod () THEN
  2550. ⓪(EXIT
  2551. ⓪&END;
  2552. ⓪&modIdx2:= ModIndex;
  2553. ⓪&firstMod:= FALSE
  2554. ⓪$END;
  2555. ⓪$
  2556. ⓪$(* Alles geladen, nun kann alles reloziert werden *)
  2557. ⓪$
  2558. ⓪$IF initList THEN
  2559. ⓪&IF NOT OutputInitList (initlistargs, outName, InitLst^, InitIndex, InitIdx2) THEN
  2560. ⓪(Remove (outfile);
  2561. ⓪(RETURN false
  2562. ⓪&END;
  2563. ⓪$END;
  2564. ⓪$
  2565. ⓪$(* Symbole in Liste eintragen *)
  2566. ⓪$IF protocol THEN
  2567. ⓪&symBufSize:= INT (MemAvail ()) - $1000;
  2568. ⓪&IF symBufSize < $1000 THEN RelError (FALSE) END;
  2569. ⓪&ALLOCATE (symbolBuf, symBufSize);
  2570. ⓪&symBufEnd:= symbolBuf + ORD(symBufSize);
  2571. ⓪&symBufHead:= symbolBuf;
  2572. ⓪&GenerateSymbolList;
  2573. ⓪$END;
  2574. ⓪$
  2575. ⓪$(* evtl. noch optimieren... *)
  2576. ⓪$Optimize;
  2577. ⓪$
  2578. ⓪$(* CodeNow & Adr. der Module ermitteln *)
  2579. ⓪$UsedCodes:= ModIndex;
  2580. ⓪$UsedInits:= InitIndex;
  2581. ⓪$setCodeAd;
  2582. ⓪$
  2583. ⓪$(* Symbolliste ausgeben und Speicher wieder freigeben *)
  2584. ⓪$IF protocol THEN
  2585. ⓪&FixSymbols;
  2586. ⓪&IF NOT SymbolOutput (symargs) THEN
  2587. ⓪(Remove (outfile);
  2588. ⓪(RETURN false
  2589. ⓪&END;
  2590. ⓪&DEALLOCATE (symbolBuf, 0);
  2591. ⓪$END;
  2592. ⓪$
  2593. ⓪$Report (3, 'Relocating...');
  2594. ⓪$
  2595. ⓪$tabSize:= SIZE (ListTop^[1]) * ListMax;
  2596. ⓪$avail:= INT (MemAvail ()) - $2000 - INT (MaxBlSize) - INT(2*tabSize);
  2597. ⓪$IF avail < $2000 THEN RelError (FALSE) END;
  2598. ⓪$ALLOCATE (ListTop, tabSize);
  2599. ⓪$ALLOCATE (ListBeg, tabSize);
  2600. ⓪$IF (ListTop = NIL) OR (ListBeg = NIL) THEN RelError (TRUE) END;
  2601. ⓪$DEC (avail, 2*tabSize);
  2602. ⓪$Allocate ( RelocTab, avail DIV 3 );
  2603. ⓪$pRelTab:= RelocTab; eRelTab:= RelocTab + ORD(avail) DIV 3 - 4;
  2604. ⓪$l:= avail - (avail DIV 3); IF ODD (l) THEN DEC (l) END;
  2605. ⓪$Allocate (Lists, l+4);
  2606. ⓪$ListIndex:= ListMax; eoLists:= ADDRESS (Lists) + ORD (l);
  2607. ⓪$IF (RelocTab = NIL)
  2608. ⓪$OR (Lists = NIL) THEN RelError (TRUE); END;
  2609. ⓪$
  2610. ⓪$IF noShModLst THEN
  2611. ⓪&ShModLstLen:= 0
  2612. ⓪$ELSE
  2613. ⓪&ShModLstLen:= long (UsedCodes) * ShModLstSpace;
  2614. ⓪$END;
  2615. ⓪$
  2616. ⓪$DATAStart:= CodeNow + long (4*(UsedInits-1)+8) + ShModLstLen;
  2617. ⓪$BSSstart:= DATAStart+ORD(DATALen);
  2618. ⓪$WITH ModLst^ [InitLst^[InitIdx2]] DO
  2619. ⓪&initOffs:= codeAd + entry (Image, 6) - diff;
  2620. ⓪$END;
  2621. ⓪$
  2622. ⓪$PutIntoRelTab(2L);   (* LEA reloz. *)
  2623. ⓪$PutIntoRelTab(8L);   (* LEA reloz. *)
  2624. ⓪$IF initOffs >= 32768 THEN
  2625. ⓪&PutIntoRelTab(14L);  (* JMP am Code-Anfang reloz. *)
  2626. ⓪$END;
  2627. ⓪$IF NOT noShModLst THEN
  2628. ⓪&PutIntoRelTab(24 + LENGTH (CodeID) + 1);  (* ^ShModLst reloz. *)
  2629. ⓪$END;
  2630. ⓪$
  2631. ⓪$FOR i:=1 TO ModIndex DO
  2632. ⓪&IF ModLst^ [i].useCode THEN
  2633. ⓪(IF ~Relocate(i) THEN
  2634. ⓪*Remove (outfile);
  2635. ⓪*RETURN false
  2636. ⓪(END
  2637. ⓪&END
  2638. ⓪$END;
  2639. ⓪$
  2640. ⓪$DEALLOCATE (ListTop, 0);
  2641. ⓪$DEALLOCATE (ListBeg, 0);
  2642. ⓪$DeAllocate (Lists, 0L);
  2643. ⓪$
  2644. ⓪$IF ~nameProvided THEN
  2645. ⓪&REPEAT
  2646. ⓪(Prompt (2, 'Stack size (0 for default)? ');
  2647. ⓪(ReadString (s);
  2648. ⓪(i:=0;
  2649. ⓪(stacksize:= StrConv.StrToLCard (s,i,ok)
  2650. ⓪&UNTIL (stacksize=0L) OR (stacksize>255L)
  2651. ⓪$ELSE
  2652. ⓪&stacksize:= LinkerParm.linkStackSize
  2653. ⓪$END;
  2654. ⓪$RETURN TRUE
  2655. ⓪"END dialog;
  2656. ⓪ 
  2657. ⓪ 
  2658. ⓪ PROCEDURE moveProcNames (image: ADDRESS; add: LONGINT);
  2659. ⓪"(*$L-*)
  2660. ⓪"BEGIN
  2661. ⓪$ASSEMBLER
  2662. ⓪(MOVE.L  -(A3),D0
  2663. ⓪(MOVE.L  -(A3),A0
  2664. ⓪(MOVE.L  6(A0),D1        ; BODY-OFFSET
  2665. ⓪%l: LEA     -4(A0,D1.L),A1
  2666. ⓪(MOVE.L  (A1),D1
  2667. ⓪(ADD.L   D0,(A1)
  2668. ⓪(TST.L   D1
  2669. ⓪(BNE     l
  2670. ⓪$END
  2671. ⓪"END moveProcNames;
  2672. ⓪"(*$L=*)
  2673. ⓪ 
  2674. ⓪ 
  2675. ⓪ PROCEDURE PutMod (i: tIndex);
  2676. ⓪ 
  2677. ⓪"(*
  2678. ⓪#*  ImportListe aus dem Modul entfernen, Exportliste umrechnen,
  2679. ⓪#*  Modul in outfile schreiben
  2680. ⓪#*)
  2681. ⓪"
  2682. ⓪"VAR  s,d, img: address; idx: tIndex; pl: POINTER TO LONGCARD;
  2683. ⓪"
  2684. ⓪"BEGIN
  2685. ⓪$WITH ModLst^ [i] DO
  2686. ⓪ 
  2687. ⓪&IF procSym AND (diff # 0L) THEN
  2688. ⓪((*** Proc-Namen-Liste bzgl. 'diff' korrigieren ***)
  2689. ⓪(moveProcNames (image, -LONGINT(diff));
  2690. ⓪&END;
  2691. ⓪ 
  2692. ⓪&IF noHeader & mayCrunch THEN
  2693. ⓪ 
  2694. ⓪(img:= image + entry (image, 42)
  2695. ⓪ 
  2696. ⓪&ELSE
  2697. ⓪&
  2698. ⓪((*** Importliste loeschen, aber Pointer-Liste anlegen ***)
  2699. ⓪(
  2700. ⓪(IF diff # 0L THEN
  2701. ⓪*pl:= image + entry (image, 14);       (* ^Importliste *)
  2702. ⓪*FOR idx:= 1 TO ImpIndex DO
  2703. ⓪,pl^:= ModLst^[ImpLst^[idx]].finalIdx;
  2704. ⓪,INC (pl,4)
  2705. ⓪*END;
  2706. ⓪*pl^:= 0;
  2707. ⓪*INC (pl,4);
  2708. ⓪*d:= pl;
  2709. ⓪*s:= d + diff;
  2710. ⓪*Block.Copy (s, (image + entry (image, 22)) - s, d);
  2711. ⓪(END;
  2712. ⓪(
  2713. ⓪((*** Exportliste umrechnen ***)
  2714. ⓪(
  2715. ⓪(d:= entry (image, 18);
  2716. ⓪(IF d # NIL THEN
  2717. ⓪*enter (image, 18, d - diff);                  (* ^ExportListe *)
  2718. ⓪*d:= d+image-diff;
  2719. ⓪*WHILE cardinal (d^) # 0 DO
  2720. ⓪,s:= entry (d, 2);
  2721. ⓪,IF s # 0L THEN
  2722. ⓪.IF s < entry (image, 22) THEN (* Procedure/Const *)
  2723. ⓪0enter (d, 2, s-diff)
  2724. ⓪.ELSE
  2725. ⓪0(*$r- die rel. Adressen der Variablen koennen negativ werden *)
  2726. ⓪0enter (d, 2, VarAd + BSSstart + s - entry (image, 22) - codeAd )
  2727. ⓪0(*$r=*)
  2728. ⓪.END;
  2729. ⓪,END;
  2730. ⓪,inc (d, 6)
  2731. ⓪*END
  2732. ⓪(END;
  2733. ⓪(
  2734. ⓪(img:= image
  2735. ⓪(
  2736. ⓪&END;
  2737. ⓪&
  2738. ⓪&enter (image,  6, entry (image,  6) - diff);    (* ^Modulrumpf  *)
  2739. ⓪&enter (image, 10, modlen);                      (* ^Modulende   *)
  2740. ⓪&enter (image, 22, 0);                           (* ^Var/Proc    *)
  2741. ⓪&enter (image, 42, entry (image, 42) - diff);    (* ^CodeStart   *)
  2742. ⓪ 
  2743. ⓪&(*** und wegschreiben ***)
  2744. ⓪ 
  2745. ⓪&fputm (outfile, img^, modlen)
  2746. ⓪ 
  2747. ⓪$END (* with ModLst^ [i] *)
  2748. ⓪"END PutMod;
  2749. ⓪#
  2750. ⓪#
  2751. ⓪ PROCEDURE CodeOutput;
  2752. ⓪ 
  2753. ⓪"(*  Relozierte Module ins Ausgabe-File wegschreiben.
  2754. ⓪#*  Dabei werden Import- und Relozierlisten entfernt,
  2755. ⓪#*  Exportlisten muessen umgerechnet werden!
  2756. ⓪#*)
  2757. ⓪#
  2758. ⓪"CONST  bra = $6000;
  2759. ⓪)nop = $4E71;
  2760. ⓪)jmp = $4EF9;
  2761. ⓪)jsr = $4EB9;
  2762. ⓪)rts = $4E75;
  2763. ⓪)lea1= $43F9;  (* LEA xxxxxxxx,A1 *)
  2764. ⓪)lea2= $45F9;  (* LEA xxxxxxxx,A2 *)
  2765. ⓪)
  2766. ⓪)bufsize = 4096;
  2767. ⓪"
  2768. ⓪"VAR   j,i: tIndex;
  2769. ⓪%k,wbuf: cardinal;
  2770. ⓪)li: LONGINT;
  2771. ⓪'lbuf: longcard;
  2772. ⓪*p: address;
  2773. ⓪)ch: CHAR;
  2774. ⓪)bs: BITSET;
  2775. ⓪&idBuf: ARRAY [0..LENGTH (CodeID)] OF CHAR;
  2776. ⓪&dataf: File;
  2777. ⓪%buffer: ADDRESS;
  2778. ⓪ 
  2779. ⓪"BEGIN
  2780. ⓪$(* Command File Header schreiben *)
  2781. ⓪$wbuf:= $601A;
  2782. ⓪$fput (outfile, wbuf);
  2783. ⓪$fput (outfile, DATAstart);  (* Länge TEXT *)
  2784. ⓪$fput (outfile, DATALen);    (* Länge DATA *)
  2785. ⓪$fput (outfile, VarNow);     (* Länge BSS *)
  2786. ⓪$lbuf:= 0L;
  2787. ⓪$fput (outfile, lbuf);
  2788. ⓪$lbuf:= 0L;
  2789. ⓪$fput (outfile, lbuf);
  2790. ⓪$lbuf:= CARDINAL (HeaderFlags); (* Fastload/Fast Code/Fast Memory-Bits *)
  2791. ⓪$fput (outfile, lbuf);
  2792. ⓪$wbuf:= 0;
  2793. ⓪$fput (outfile, wbuf);
  2794. ⓪$
  2795. ⓪$wbuf:= lea1;                (* Zeiger auf import. Moduladr. -> A1 *)
  2796. ⓪$fput (outfile, wbuf);
  2797. ⓪$lbuf:= CodeNow + ShModLstLen;
  2798. ⓪$fput (outfile, lbuf);
  2799. ⓪$
  2800. ⓪$wbuf:= lea2;                (* LEA  PDB,A2 *)
  2801. ⓪$fput (outfile, wbuf);
  2802. ⓪$fput (outfile, VAL (LONGCARD, 18 + LENGTH (CodeID) + 1));
  2803. ⓪$
  2804. ⓪$(* 26.09.94: falls Differenz < 32K, dann BRA statt JMP verwenden, *
  2805. ⓪%*           damit z.B. Templemon ohne Relozierung laufen kann.   *)
  2806. ⓪$WITH ModLst^ [InitLst^[InitIdx2]] DO
  2807. ⓪&lbuf:= codeAd + entry (Image, 6) - diff;
  2808. ⓪$END;
  2809. ⓪$IF initOffs # lbuf THEN HALT END; (* Zur Sicherheit *)
  2810. ⓪$IF initOffs >= 32768 THEN
  2811. ⓪&wbuf:= jmp;                 (* JMP zum Init-Modul *)
  2812. ⓪&fput (outfile, wbuf);
  2813. ⓪&fput (outfile, lbuf);
  2814. ⓪$ELSE
  2815. ⓪&wbuf:= nop;
  2816. ⓪&fput (outfile, wbuf);
  2817. ⓪&wbuf:= bra;                 (* BRA zum Init-Modul *)
  2818. ⓪&fput (outfile, wbuf);
  2819. ⓪&wbuf:= short (lbuf - 16);   (* rel. Offset ab BRA-Instr. bestimmen *)
  2820. ⓪&fput (outfile, wbuf);
  2821. ⓪$END;
  2822. ⓪$
  2823. ⓪$idBuf:= CodeID;
  2824. ⓪$fput (outfile, idBuf);
  2825. ⓪$
  2826. ⓪$(* PDB anlegen *)
  2827. ⓪$wbuf:= PDBlayout;
  2828. ⓪$fput (outfile, wbuf);       (* layout *)
  2829. ⓪$lbuf:= 0L;
  2830. ⓪$fput (outfile, lbuf);       (* ^basePage reservieren *)
  2831. ⓪$IF noShModLst THEN
  2832. ⓪&lbuf:= 0;
  2833. ⓪&wbuf:= 0
  2834. ⓪$ELSE
  2835. ⓪&lbuf:= codenow;
  2836. ⓪&wbuf:= UsedCodes;
  2837. ⓪$END;
  2838. ⓪$fput (outfile, lbuf);       (* ^ShModLst (f. Loader) *)
  2839. ⓪$fput (outfile, wbuf);       (* Anzahl der Einträge in ShModLst *)
  2840. ⓪$wbuf:= 0;
  2841. ⓪$fput (outfile, wbuf);       (* processState *)
  2842. ⓪$lbuf:= 0L;
  2843. ⓪$fput (outfile, lbuf);       (* BottomOfStack *)
  2844. ⓪$fput (outfile, stacksize);  (* TopOfStack *)
  2845. ⓪$fput (outfile, lbuf);       (* termState, resident *)
  2846. ⓪$ASSEMBLER
  2847. ⓪(MOVE    realForm,D0
  2848. ⓪(TST     extendedCode
  2849. ⓪(BEQ     noExtCode
  2850. ⓪(ADDQ    #4,D0
  2851. ⓪&noExtCode
  2852. ⓪(MOVE.W  D0,wbuf(A6)
  2853. ⓪$END;
  2854. ⓪$fput (outfile, wbuf);       (* flags *)
  2855. ⓪$fput (outfile, lbuf);       (* TermProcs *)
  2856. ⓪$fput (outfile, lbuf);       (* ^prev *)
  2857. ⓪$fput (outfile, lbuf);       (* reserved *)
  2858. ⓪$fput (outfile, lbuf);       (* reserved *)
  2859. ⓪$fput (outfile, lbuf);       (* reserved *)
  2860. ⓪$fput (outfile, lbuf);       (* reserved *)
  2861. ⓪$
  2862. ⓪$(* finalIdx berechnen *)
  2863. ⓪$j:= 0;
  2864. ⓪$FOR i:=1 TO ModIndex DO
  2865. ⓪&IF ModLst^ [i].useCode THEN
  2866. ⓪(INC (j);
  2867. ⓪(ModLst^ [i].finalIdx:= j;
  2868. ⓪&ELSE
  2869. ⓪(ModLst^ [i].finalIdx:= 0
  2870. ⓪&END
  2871. ⓪$END;
  2872. ⓪$IF UsedCodes # j THEN HALT END;
  2873. ⓪$
  2874. ⓪$(* Codes der Module ablegen *)
  2875. ⓪$FOR i:=1 TO ModIndex DO
  2876. ⓪&IF ModLst^ [i].useCode THEN
  2877. ⓪(WritingOut (i);
  2878. ⓪(PutMod (i);
  2879. ⓪(IF IOResult < 0 THEN
  2880. ⓪*MyError (IOResult);
  2881. ⓪*Remove (OutFile);
  2882. ⓪*RETURN
  2883. ⓪(END
  2884. ⓪&END
  2885. ⓪$END;
  2886. ⓪$
  2887. ⓪$IF NOT noShModLst THEN
  2888. ⓪&(* ShModLst ablegen *)
  2889. ⓪&j:= 0;
  2890. ⓪&FOR i:= 1 TO ModIndex DO
  2891. ⓪(WITH ModLst^ [i] DO
  2892. ⓪*IF useCode THEN
  2893. ⓪.(* head0: Adr. des Headers *)
  2894. ⓪0fput (outfile, codead);
  2895. ⓪0PutIntoRelTab ( codeNow + long (j) * ShModLstSpace );
  2896. ⓪.(* var0 *)
  2897. ⓪0lbuf:= varAd + BSSstart;
  2898. ⓪0fput (outfile, lbuf);
  2899. ⓪0PutIntoRelTab ( codeNow + long (j) * ShModLstSpace + 4 );
  2900. ⓪.(* varlen0 *)
  2901. ⓪0fput (outfile, varlen);
  2902. ⓪.(* flags *)
  2903. ⓪0bs:= {};
  2904. ⓪0IF procSym THEN INCL (bs,0) END;
  2905. ⓪0IF crunched THEN INCL (bs,1) END;
  2906. ⓪0IF NOT bit (25, compopts) (* $Y *) THEN INCL (bs, 2) END;
  2907. ⓪0IF mainMod THEN INCL (bs,3) END;
  2908. ⓪0fput (outfile, bs);
  2909. ⓪,INC (j)
  2910. ⓪*END
  2911. ⓪(END
  2912. ⓪&END
  2913. ⓪$END;
  2914. ⓪$
  2915. ⓪$(* Body-Adressen der Module zur Initialisierung in Liste schreiben *)
  2916. ⓪$
  2917. ⓪$j:= 0;
  2918. ⓪$(* vom ersten Modul importierte Moduladr. rausschreiben *)
  2919. ⓪$FOR i:=1 TO InitIdx2-1 (* Init-Mod nicht *) DO
  2920. ⓪&WITH ModLst^ [InitLst^[i]] DO
  2921. ⓪(IF useCode THEN
  2922. ⓪*lbuf:= CodeAd + entry (Image, 6) (* '-diff' in Putmod erledigt  *);
  2923. ⓪*fput (outfile, lbuf);
  2924. ⓪*PutIntoRelTab ( codeNow + ShModLstLen + long (j * 4) );
  2925. ⓪*INC (j)
  2926. ⓪(END;
  2927. ⓪&END;
  2928. ⓪$END;
  2929. ⓪$
  2930. ⓪$lbuf:= 0L;
  2931. ⓪$fput (outfile, lbuf); (* Endekennung *)
  2932. ⓪$INC (j);
  2933. ⓪$
  2934. ⓪$(* von weiteren Modulen importierte Moduladr. rausschreiben *)
  2935. ⓪$FOR i:=InitIdx2+1 TO InitIndex DO
  2936. ⓪&WITH ModLst^ [InitLst^[i]] DO
  2937. ⓪(IF useCode THEN
  2938. ⓪*lbuf:= CodeAd + entry (Image, 6) (* '-diff' in Putmod erledigt  *);
  2939. ⓪*fput (outfile, lbuf);
  2940. ⓪*PutIntoRelTab ( codeNow + ShModLstLen + long (j * 4) );
  2941. ⓪*INC (j)
  2942. ⓪(END
  2943. ⓪&END;
  2944. ⓪$END;
  2945. ⓪$
  2946. ⓪$lbuf:= 0L;
  2947. ⓪$fput (outfile, lbuf); (* Endekennung *)
  2948. ⓪$
  2949. ⓪$(* DATA-Segment erzeugen *)
  2950. ⓪$IF DATALen > 0 THEN
  2951. ⓪&ALLOCATE (buffer, bufsize); (* soviel wird sicher immer frei sein *)
  2952. ⓪&IF DATAFileName[0] # '' THEN
  2953. ⓪((* DATA aus Datei kopieren *)
  2954. ⓪(Open (dataf, DATAFileName, readonly);
  2955. ⓪&ELSE
  2956. ⓪((* Leeres DATA-Segment erzeugen *)
  2957. ⓪(Block.Clear (buffer, bufsize);
  2958. ⓪&END;
  2959. ⓪&WHILE DATALen > 0 DO
  2960. ⓪(li:= DATALen;
  2961. ⓪(IF li > bufsize THEN li:= bufsize END;
  2962. ⓪(IF DATAFileName[0] # '' THEN
  2963. ⓪*ReadBytes (dataf, buffer, li, lbuf)
  2964. ⓪(END;
  2965. ⓪(fputm (outfile, buffer^, li);
  2966. ⓪(DEC (DATALen, li);
  2967. ⓪&END;
  2968. ⓪&IF DATAFileName[0] # '' THEN
  2969. ⓪(Close (dataf)
  2970. ⓪&END
  2971. ⓪$END;
  2972. ⓪$
  2973. ⓪$(* Reloziertabelle schreiben *)
  2974. ⓪$lbuf:= pRelTab - RelocTab;
  2975. ⓪$IF lbuf > 32760L THEN
  2976. ⓪&ReportError (conc (conc ('Warning! Relocation table is ',
  2977. ⓪>StrConv.CardToStr (lbuf,0)),
  2978. ⓪9' bytes long (will not run on TOS 1.0/1.2)'));
  2979. ⓪$END;
  2980. ⓪$fput (outfile, firstRelVal);
  2981. ⓪$fputm (outfile, RelocTab^, lbuf);
  2982. ⓪$wbuf:= 0;
  2983. ⓪$fput (outfile, wbuf);
  2984. ⓪$
  2985. ⓪$Close (OutFile);
  2986. ⓪$IF State (outFile) < 0 THEN
  2987. ⓪&MyError (state(outfile));
  2988. ⓪&Remove (outfile);
  2989. ⓪$ELSE
  2990. ⓪&EndWriting;
  2991. ⓪$END;
  2992. ⓪"END CodeOutput;
  2993. ⓪ 
  2994. ⓪ 
  2995. ⓪ VAR dummy: PDB;
  2996. ⓪$ch: CHAR;
  2997. ⓪ 
  2998. ⓪ BEGIN (* ROMLoad *)
  2999. ⓪"IF SIZE (dummy.ModLst^[1]) # ShModLstSpace THEN HALT END;
  3000. ⓪"IF TSIZE (PDB) # SysVarSpace THEN HALT END;
  3001. ⓪"IF NOT ODD (LENGTH (CodeID)) THEN HALT END;
  3002. ⓪"
  3003. ⓪"IF LinkerParm.maxLinkMod >= (MAX (tIndex)-1) THEN
  3004. ⓪$LinkerParm.maxLinkMod:= MAX (tIndex)-2
  3005. ⓪"END;
  3006. ⓪"IF LinkerParm.maxLinkMod = 0 THEN LinkerParm.maxLinkMod:= 100 END;
  3007. ⓪"ListMax:= 1000;
  3008. ⓪"
  3009. ⓪"InitOutput (LinkerParm.maxLinkMod, conc ('Megamax Modula-2 Linker ',version));
  3010. ⓪"
  3011. ⓪"HomePath:= ShellPath; 
  3012. ⓪"
  3013. ⓪"ALLOCATE (ModLst, TSIZE (tModDesc) * LONG (LinkerParm.maxLinkMod+2));
  3014. ⓪"ALLOCATE (InitLst, TSIZE (tIndex) * LONG (LinkerParm.maxLinkMod+2));
  3015. ⓪"IF (ModLst = NIL) OR (ModLst = NIL) THEN
  3016. ⓪$ReportError ('Out of memory');
  3017. ⓪$TermProcess (MOSGlobals.OutOfMemory)
  3018. ⓪"END;
  3019. ⓪"DefPrgInSuf:= DftSfx;
  3020. ⓪"DefImpInSuf:= ImpSfx;
  3021. ⓪"RelocTab:= NIL;
  3022. ⓪"pRelTab:= NIL;
  3023. ⓪"firstRelVal:= 0L;
  3024. ⓪"lastRelVal:= 0L;
  3025. ⓪"realForm:= 0;
  3026. ⓪"extendedCode:= FALSE;
  3027. ⓪"IF dialog() THEN
  3028. ⓪$ReportCodeLen (DATAstart, VarNow, DATALen);
  3029. ⓪$BeginWriting;
  3030. ⓪$CodeOutput;
  3031. ⓪"ELSE
  3032. ⓪$TermProcess (1)
  3033. ⓪"END;
  3034. ⓪ END MM2Link.
  3035. ⓪ ə
  3036. (* $FFE1220A$0001156A$000125A1$FFFD709E$FFFD709E$FFFD709E$FFFD709E$FFFD709E$FFFD709E$FFFD709E$FFFD709E$00001DD2$FFFD709E$00013BC1$FFFD709E$0000ADB9$FFFD709E$FFFD709E$FFFD709E$FFFD709E$0000FE06$FFFD709E$FFFD709E$FFFD709E$FFFD709E$FFFD709E$FFF6AA4D$00009428$FFFD709E$0000A492$FFFD709E$0000AF05$FFFD709E$FFFD709E$00004289$FFFD709E$FFF6AAC9$FFFD709E$00008454$FFFD709E$FFFD709E$FFFD709EÇ$00001D7DT.......T.......T.......T.......T.......T.......T.......T.......T.......T......T$FF77848C$00001DA5$0000A941$0000A9CA$0000A971$00000036$00000049$00000036$00000044$0000A941$0000A9CA$0000AD52$0000ADC5$00001DCE$00001D7D$FF77848CêÇâ*)
  3037.