home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MYUTIL / CMPMODS2.M < prev    next >
Encoding:
Text File  |  1991-07-16  |  31.7 KB  |  3 lines
  1. ⓪ MODULE CmpMods2; (*$Z+,M+,C-,Q+,P+,V+,R-*)
  2. ⓪ 
  3. ⓪ FROM InOut IMPORT Write, WriteLn, WriteString, WriteInt, WriteCard,
  4. ⓪"OpenOutput, CloseOutput;
  5. ⓪ 
  6. ⓪ FROM SYSTEM IMPORT ASSEMBLER, ADDRESS, WORD, BYTE, ADR, TSIZE, LONGWORD, CAST;
  7. ⓪ FROM SysTypes IMPORT PtrAnyLongType;
  8. ⓪ FROM ArgCV     IMPORT PtrArgStr, InitArgCV;
  9. ⓪ FROM Storage   IMPORT ALLOCATE, DEALLOCATE, MemAvail;
  10. ⓪ FROM Strings   IMPORT Upper, Concat, Compare, Relation, Pos, Empty,
  11. ⓪7StrEqual, Split, Assign, Copy, PosLen, String, Append;
  12. ⓪ IMPORT FastStrings;
  13. ⓪ FROM Files IMPORT Open, Create, Access, Close, Remove, FILE, ReplaceMode,
  14. ⓪(State, ResetState;
  15. ⓪ FROM Paths IMPORT SearchFile, ListPos;
  16. ⓪ FROM PathEnv IMPORT ReplaceHome, HomePath;
  17. ⓪ FROM PathCtrl IMPORT PathList;
  18. ⓪ FROM Directory IMPORT MakeFullPath;
  19. ⓪ FROM FileNames IMPORT SplitPath, SplitName, ConcatName, ConcatPath,
  20. ⓪(FileSuffix;
  21. ⓪ FROM Binary IMPORT ReadBytes, WriteBytes, Seek, SeekMode, FileSize, WriteBlock;
  22. ⓪ FROM ShellMsg IMPORT ModPaths, ImpPaths, LLRange, ShellPath, LinkerParm;
  23. ⓪ FROM MOSCtrl IMPORT PDB;
  24. ⓪ FROM PrgCtrl IMPORT TermProcess;
  25. ⓪ FROM MOSConfig IMPORT DftSfx, ImpSfx, MaxBlSize;
  26. ⓪ IMPORT MOSGlobals, StrConv, Block;
  27. ⓪ FROM MM2LnkIO IMPORT ClearEOP, Report, Prompt, InitOutput, VerboseOutput,
  28. ⓪(Read, ReadString, WriteString, WriteMod,
  29. ⓪(ClearMod, DiscardMods, ReportRealFormat, BeginWriting, ReportCodeLen,
  30. ⓪(ReportLinkError, ReportIOError, ReportError, WritingOut, EndWriting;
  31.  
  32. ⓪ CONST PDBlayout = 4;
  33. ⓪&version = '2.17';    (* Linker-Version *)
  34. ⓪&CodeID = "Megamax Modula-2 V2";
  35. ⓪ 
  36. ⓪ VAR ok: BOOLEAN;
  37. ⓪ 
  38. ⓪ 
  39. ⓪ PROCEDURE conc (a,b:ARRAY OF CHAR):String;
  40. ⓪"VAR c:String;
  41. ⓪"BEGIN
  42. ⓪$concat (a,b,c,ok);
  43. ⓪$RETURN c
  44. ⓪"END conc;
  45. ⓪ 
  46. ⓪ 
  47. ⓪ CONST
  48. ⓪ 
  49. ⓪"SysVarSpace = 52;        (* layout,
  50. ⓪>^basePage (f. ArgV),
  51. ⓪>^modList (f. Loader),
  52. ⓪>Anzahl der Einträge in modLst,
  53. ⓪>processState,
  54. ⓪>BottomOfStack,
  55. ⓪>TopOfStack,
  56. ⓪>termState,
  57. ⓪>resident,
  58. ⓪>flags,
  59. ⓪>TermProcs,
  60. ⓪>^prev,
  61. ⓪>16 reserved bytes *)
  62. ⓪ 
  63. ⓪"ShModLstSpace = 14;      (* head0: ADDRESS;
  64. ⓪>var0: ADDRESS;
  65. ⓪>varlen0: LONGCARD;
  66. ⓪>flags: BITSET; *)
  67. ⓪ 
  68. ⓪(ESC = 33C;
  69. ⓪ 
  70. ⓪%BadIndex = 1000;
  71. ⓪'anykey = 0L;        (* Joker fuer Modul-Key *)
  72. ⓪$DefOutSuf = '.PRG';    (* Suffix f. Output, wenn keiner angegeben *)
  73. ⓪ 
  74. ⓪ VAR DefImpInSuf: ARRAY [0..2] OF CHAR; (* Suffix fuer Input Impl. Files *)
  75. ⓪$DefPrgInSuf: ARRAY [0..2] OF CHAR; (* Suffix fuer Input Main Files *)
  76. ⓪ 
  77. ⓪&ListMax: CARDINAL;   (* ehemals konstant 1000 *)
  78. ⓪ 
  79. ⓪ TYPE
  80. ⓪'tIndex = [0..BadIndex];  (* Index auf die Modul-Liste; BadIndex
  81. ⓪Ckodiert Sonderfaelle: kein gueltiger
  82. ⓪CIndex bzw. residentes Modul *)
  83. ⓪%tModName = string;
  84. ⓪ 
  85. ⓪%ptrModDesc = POINTER TO tModDesc;
  86. ⓪ 
  87. ⓪%tModDesc = RECORD
  88. ⓪2image: address;    (* ^Buffer beim Relozieren *)
  89. ⓪1codeAd: address;    (* StartAdr im ROM *)
  90. ⓪0codeEnd: LONGCARD;
  91. ⓪2varAd: address;    (* StartAdr der Variablen *)
  92. ⓪1varLen: LONGCARD;   (* Länge der Variablen *)
  93. ⓪3diff: longcard;   (* Laenge der entfernten Imp.Liste *)
  94. ⓪4key: longcard;   (* Key dieses Moduls *)
  95. ⓪1modlen: longcard;   (* Code-Länge dieses Moduls *)
  96. ⓪-sourcename: ARRAY [0..11] OF CHAR;
  97. ⓪-symbolname: ARRAY [0..11] OF CHAR;
  98. ⓪3name: ARRAY [0..39] OF CHAR;  (* ModulName *)
  99. ⓪0procSym: BOOLEAN;
  100. ⓪/compopts: LONGWORD;
  101. ⓪.mayRemove: BOOLEAN;    (* FALSE: Body keinesfalls wegoptimieren!*)
  102. ⓪0mainMod: BOOLEAN;    (* FALSE: ist'n importiertes Modul *)
  103. ⓪.mayCrunch: BOOLEAN;    (* TRUE: Proc-Length-Liste vorhanden *)
  104. ⓪/crunched: BOOLEAN;
  105. ⓪+varsExported: BOOLEAN;    (* TRUE: Vars werden v. anderen Mods importiert *)
  106. ⓪0useCode: BOOLEAN;    (* FALSE: Modulcode wird nicht gebraucht *)
  107. ⓪-bodyMarked: BOOLEAN;
  108. ⓪1ImpLst: POINTER TO ARRAY tIndex OF tIndex; (* Liste der imp. Module *)
  109. ⓪/ImpIndex: tIndex;                 (* Anzahl imp. Module *)
  110. ⓪/finalIdx: tIndex;  (* Index für ModBase *)
  111. ⓪0END;
  112. ⓪ 
  113. ⓪$ErrType   = (NotFound, BadFormat, BadVersion, NoSpace, TooManyMods,
  114. ⓪1mustnotbeimpl, badlayout, readerr, relocerr, nooptimize,
  115. ⓪1badReal);
  116. ⓪0
  117. ⓪(pLONG = POINTER TO LONGCARD;
  118. ⓪ 
  119. ⓪ VAR
  120. ⓪'ModLst: POINTER TO ARRAY tIndex OF tModDesc;  (* Liste der geladenen Module *)
  121. ⓪%ModIndex: tIndex;                    (* ^ letzten Eintrag in ModLst *)
  122. ⓪$UsedCodes: tIndex;                    (* Anzahl der verw. Modulcodes *)
  123. ⓪&InitLst: POINTER TO ARRAY tIndex OF tIndex;    (* Liste der Init-Reihenfolge *)
  124. ⓪$InitIndex: tIndex;                    (* ^ letzten Eintrag in InitLst *)
  125. ⓪%InitIdx2: tIndex;                    (* ^ auf Second-Mod - InitLst *)
  126. ⓪$UsedInits: tIndex;                    (* Anzahl der zu init. Bodies *)
  127. ⓪ 
  128. ⓪#CodeSuffix: boolean;
  129. ⓪"LoadingMain: BOOLEAN;
  130. ⓪%IOResult,
  131. ⓪*ior: INTEGER;                   (* ZW fuer IOResults *)
  132. ⓪ 
  133. ⓪%LoadFile,                            (* geladene Module *)
  134. ⓪&OutFile: file;                      (* zu schreibendes Codefile *)
  135. ⓪ 
  136. ⓪%BSSstart: address;                   (* Start-Adr fuer reloz. Vars *)
  137. ⓪&CodeNow,                            (* ^ zu vergebenden Codeplatz *)
  138. ⓪'VarNow: address;                   (* ^ zu vergebenden Varplatz *)
  139. ⓪"ShModLstLen: Longcard;                  (* Ges.länge der ModLst f.d. Loader *)
  140. ⓪$stacksize: LONGCARD;
  141. ⓪ 
  142. ⓪&BodyLen: LONGCARD;                  (* testweise f. Länge aller Bodies *)
  143. ⓪"
  144. ⓪&pRelTab,
  145. ⓪&eRelTab,
  146. ⓪%RelocTab: ADDRESS;
  147. ⓪!firstRelVal : longcard;
  148. ⓪"lastRelVal : longcard;
  149. ⓪!
  150. ⓪&dt_buf : RECORD   (* disk transfer buffer *)
  151. ⓪1dum0 : ARRAY [1..13] OF word;
  152. ⓪1flen : LONGCARD;
  153. ⓪1dum1 : ARRAY [16..22] OF word
  154. ⓪/END;
  155. ⓪&
  156. ⓪%singleMod: BOOLEAN;
  157. ⓪%
  158. ⓪)paths: PathList;
  159. ⓪ 
  160. ⓪&optProcs: BOOLEAN;  (* TRUE: Procs optimieren *)
  161. ⓪&noHeader: BOOLEAN;  (* TRUE: Header aus Moduln entfernen *)
  162. ⓪$noShModLst: BOOLEAN;  (* TRUE: ShortModList aus Moduln entfernen *)
  163. ⓪$noProcSyms: BOOLEAN;  (* TRUE: ProcSymbols vor Prozeduren entfernen *)
  164. ⓪ 
  165. ⓪"extendedCode: BOOLEAN;
  166. ⓪&realForm: CARDINAL;
  167. ⓪ 
  168. ⓪#HeaderFlags: BITSET;
  169. ⓪ 
  170. ⓪ 
  171. ⓪ PROCEDURE fputm ( f:file; VAR p:ARRAY OF word; c:LONGCARD );
  172. ⓪"BEGIN
  173. ⓪$WriteBytes (f, ADR (p), c);
  174. ⓪"END fputm;
  175. ⓪ 
  176. ⓪ 
  177. ⓪ PROCEDURE fput ( f:file; REF p: ARRAY OF BYTE );
  178. ⓪"BEGIN
  179. ⓪$IF NOT ODD (HIGH (p)) THEN HALT END;
  180. ⓪$WriteBlock (f, p);
  181. ⓪"END fput;
  182. ⓪ 
  183. ⓪ 
  184. ⓪ PROCEDURE hasSuffix (s: string): boolean;
  185. ⓪"VAR p: cardinal;
  186. ⓪"BEGIN
  187. ⓪$RETURN length (FileSuffix (s)) > 0;
  188. ⓪$(* in den letzten 4 Zeichen von s muss ein Punkt stehen! *)
  189. ⓪"END hasSuffix;
  190. ⓪ 
  191. ⓪ 
  192. ⓪ PROCEDURE entry (Index: address; Displacement: LONGCARD): LongCard;
  193. ⓪"(*** Long-Peek mit Displacement ***)
  194. ⓪"(*$L-*)
  195. ⓪"BEGIN
  196. ⓪$ASSEMBLER
  197. ⓪(MOVE.L  -(A3),A0
  198. ⓪(ADDA.L  -(A3),A0
  199. ⓪(MOVE.L  (A0),D0
  200. ⓪$END
  201. ⓪"END entry;
  202. ⓪"(*$L=*)
  203. ⓪ 
  204. ⓪ 
  205. ⓪ PROCEDURE enter (Index: address; Displacement: cardinal; value: LongCard);
  206. ⓪"(*** Long-Poke mit Displacement ***)
  207. ⓪"VAR p: POINTER TO LongCard;
  208. ⓪"BEGIN
  209. ⓪$p:= Index + address (long (Displacement));
  210. ⓪$p^:= value;
  211. ⓪"END enter;
  212. ⓪ 
  213. ⓪ 
  214. ⓪ PROCEDURE error (client, impmod: ARRAY OF CHAR; t: ErrType);
  215. ⓪ 
  216. ⓪"(*** Fehleranzeige auf dem Bildschirm; danach zurueck zum Aufrufer ***)
  217. ⓪"
  218. ⓪"VAR msg: String;
  219. ⓪"
  220. ⓪"BEGIN
  221. ⓪$CASE t OF
  222. ⓪+badReal: msg:= 'Different real-formats specified'; client[0]:= 0C |
  223. ⓪(badversion: msg:= 'Wrong module version' |
  224. ⓪)badformat: msg:= 'Wrong module format'; client[0]:= 0C |
  225. ⓪*notfound: msg:= 'Module not found'; client[0]:= 0C |
  226. ⓪+readerr: msg:= 'File is damaged'; client[0]:= 0C |
  227. ⓪+nospace: msg:= 'Out of memory'; client[0]:= 0C |
  228. ⓪'toomanymods: msg:= 'Too many modules (enlarge "max. Module")'; client[0]:= 0C|
  229. ⓪%mustnotbeimpl: msg:= 'Init-module must be program module'; client[0]:= 0C|
  230. ⓪)badlayout: msg:= 'Bad module layout'; client[0]:= 0C|
  231. ⓪*relocerr: msg:= 'Error in relocation list'; client[0]:= 0C|
  232. ⓪(nooptimize: msg:= 'Old module layout - may not be optimized'; client[0]:= 0C|
  233. ⓪$END; (* of case *)
  234. ⓪$ReportLinkError (impmod, client, msg)
  235. ⓪"END error;
  236. ⓪ 
  237. ⓪ 
  238. ⓪ PROCEDURE MyError (ior: integer);
  239. ⓪"BEGIN
  240. ⓪$ReportIOError (ior)
  241. ⓪"END MyError;
  242. ⓪ 
  243. ⓪ PROCEDURE RelError0 (REF s: ARRAY OF CHAR);
  244. ⓪"BEGIN
  245. ⓪$ReportError (s);
  246. ⓪$Remove (outfile);
  247. ⓪$TermProcess (MOSGlobals.OutOfMemory)
  248. ⓪"END RelError0;
  249. ⓪ 
  250. ⓪ PROCEDURE RelError (internalErr: BOOLEAN);
  251. ⓪"VAR s: String;
  252. ⓪"BEGIN
  253. ⓪$s:= 'Out of memory!';
  254. ⓪$IF internalErr THEN Append (' (internal error!)', s, ok) END;
  255. ⓪$RelError0 (s);
  256. ⓪"END RelError;
  257. ⓪ 
  258. ⓪ PROCEDURE RelError2;
  259. ⓪"BEGIN
  260. ⓪$RelError0 ('Relocation table overflow! Use "-R" option.');
  261. ⓪"END RelError2;
  262. ⓪ 
  263. ⓪ 
  264. ⓪ PROCEDURE GetStr (VAR p: address): tModName;
  265. ⓪"(* String aus der Importliste holen *)
  266. ⓪"VAR s: tModName;
  267. ⓪"BEGIN
  268. ⓪$ASSEMBLER
  269. ⓪,MOVE.L  p(A6),A1       ;Adresse von p
  270. ⓪,MOVE.L  (A1),A2        ;Wert von p
  271. ⓪,LEA     s(A6),A0
  272. ⓪%!RE13  MOVE.B  (A2)+,D2       ;Zeichen holen
  273. ⓪,CMPI.B  #$FE,D2
  274. ⓪,BCC     RE12           ; -> Endmarke
  275. ⓪,MOVE.B  D2,(A0)+
  276. ⓪,BRA     RE13
  277. ⓪%!RE12  BNE     RE14
  278. ⓪,ADDQ.L  #1,A2
  279. ⓪%!RE14  CLR.B   (A0)+
  280. ⓪,MOVE.L  A2,(A1)        ;p hochsetzen
  281. ⓪$END;
  282. ⓪$RETURN s
  283. ⓪"END GetStr;
  284. ⓪ 
  285. ⓪ PROCEDURE SkipStr (VAR p: address);
  286. ⓪"(* String aus der Importliste überspringen *)
  287. ⓪"(*$L-*)
  288. ⓪"BEGIN
  289. ⓪$ASSEMBLER
  290. ⓪,MOVE.L  -(A3),A1       ;Adresse von p
  291. ⓪,MOVE.L  (A1),A2        ;Wert von p
  292. ⓪%!RE13  CMPI.B  #$FF,(A2)+
  293. ⓪,BNE     RE13
  294. ⓪,MOVE.L  A2,(A1)        ;p hochsetzen
  295. ⓪$END;
  296. ⓪"END SkipStr;
  297. ⓪"(*$L=*)
  298. ⓪ 
  299. ⓪ PROCEDURE SkipImpList (VAR p: address);
  300. ⓪"(* Importliste überspringen *)
  301. ⓪"(*$L-*)
  302. ⓪"BEGIN
  303. ⓪$ASSEMBLER
  304. ⓪(MOVE.L  -(A3),A0
  305. ⓪(MOVE.L  (A0),A1
  306. ⓪%R6 MOVE.W  (A1)+,D0      ;imp. ItemNr
  307. ⓪(BEQ     R5            ;fertig mit diesem Import
  308. ⓪(MOVE.L  (A1)+,D1      ;importiertes Item
  309. ⓪(BRA     R6
  310. ⓪%R5 MOVE.L  A1,(A0)
  311. ⓪$END;
  312. ⓪"END SkipImpList;
  313. ⓪"(*$L=*)
  314. ⓪ 
  315. ⓪ 
  316. ⓪ PROCEDURE SplitFileName ( REF Source: ARRAY OF CHAR; VAR Name,sfx: ARRAY OF Char );
  317. ⓪"VAR dummy: MOSGlobals.PathStr;
  318. ⓪"BEGIN
  319. ⓪$SplitPath (source, dummy, name);
  320. ⓪$SplitName (name, name, sfx)
  321. ⓪"END SplitFileName;
  322. ⓪ 
  323. ⓪ 
  324. ⓪ 
  325. ⓪ PROCEDURE moveMem (olo, ohi, nlo: LONGCARD);
  326. ⓪"BEGIN
  327. ⓪$ASSEMBLER
  328. ⓪(MOVE.L  olo(A6),A0
  329. ⓪(MOVE.L  ohi(A6),A1
  330. ⓪(MOVE.L  nlo(A6),A2
  331. ⓪&L MOVE.W  (A0)+,(A2)+
  332. ⓪(CMPA.L  A1,A0
  333. ⓪(BCS     L
  334. ⓪$END
  335. ⓪"END moveMem;
  336. ⓪ 
  337. ⓪ 
  338. ⓪ PROCEDURE isCLinkMod (modidx: CARDINAL): BOOLEAN;
  339. ⓪ (*
  340. ⓪!* Wert: TRUE, wenn Modul von 'MM2CLink' erzeugt wurde.
  341. ⓪!*)
  342. ⓪"BEGIN
  343. ⓪$RETURN entry (ModLst^ [modidx].image, 50) # 0;
  344. ⓪"END isCLinkMod;
  345. ⓪ 
  346. ⓪ 
  347. ⓪ PROCEDURE Vergleiche;
  348. ⓪ 
  349. ⓪"TYPE RelocList = POINTER TO RECORD link: LONGCARD; procAddr: LONGCARD END;
  350. ⓪'ProcLenList = POINTER TO RECORD start: LONGCARD; len: LONGCARD END;
  351. ⓪'ImportTable = POINTER TO RECORD item: CARDINAL; procAddr: LONGCARD END;
  352. ⓪$
  353. ⓪"PROCEDURE pStart (p: ProcLenList): LONGCARD;
  354. ⓪$(*$L-*)
  355. ⓪$BEGIN
  356. ⓪&ASSEMBLER
  357. ⓪(MOVE.L  -(A3),A0
  358. ⓪(MOVE.L  (A0),D0         ; p^.start
  359. ⓪(ANDI.L  #$00FFFFFF,D0
  360. ⓪&END;
  361. ⓪$END pStart;
  362. ⓪$(*$L=*)
  363. ⓪ 
  364. ⓪"PROCEDURE pEnd (p: ProcLenList): LONGCARD;
  365. ⓪$(*$L-*)
  366. ⓪$BEGIN
  367. ⓪&ASSEMBLER
  368. ⓪(MOVE.L  -(A3),A0
  369. ⓪(MOVE.L  (A0)+,D0        ; p^.start
  370. ⓪(ANDI.L  #$00FFFFFF,D0
  371. ⓪(ADD.L   (A0),D0         ; p^.len
  372. ⓪&END;
  373. ⓪$END pEnd;
  374. ⓪$(*$L=*)
  375. ⓪ 
  376. ⓪"PROCEDURE mark (p: ProcLenList; n: CARDINAL);
  377. ⓪$(* n: 1='lokal verwendet', 2='von anderem Modul importiert' *)
  378. ⓪$(*$L-*)
  379. ⓪$BEGIN
  380. ⓪&ASSEMBLER
  381. ⓪(MOVE.W  -(A3),D0
  382. ⓪(MOVE.L  -(A3),A0
  383. ⓪(MOVE.B  D0,(A0)         ; p^.start
  384. ⓪&END;
  385. ⓪$END mark;
  386. ⓪$(*$L=*)
  387. ⓪ 
  388. ⓪"PROCEDURE marked (p: ProcLenList): BOOLEAN;
  389. ⓪$(*$L-*)
  390. ⓪$BEGIN
  391. ⓪&ASSEMBLER
  392. ⓪(MOVE.L  -(A3),A0
  393. ⓪(TST.B   (A0)            ; p^.start
  394. ⓪(SNE     D0
  395. ⓪(ANDI    #1,D0
  396. ⓪&END;
  397. ⓪$END marked;
  398. ⓪$(*$L=*)
  399. ⓪ 
  400. ⓪"PROCEDURE markedValue (p: ProcLenList): CARDINAL;
  401. ⓪$(*$L-*)
  402. ⓪$BEGIN
  403. ⓪&ASSEMBLER
  404. ⓪(MOVE.L  -(A3),A0
  405. ⓪(CLR     D0
  406. ⓪(MOVE.B  (A0),D0         ; p^.start
  407. ⓪&END;
  408. ⓪$END markedValue;
  409. ⓪$(*$L=*)
  410. ⓪ 
  411. ⓪"PROCEDURE between (v, lo, hi: LONGCARD): BOOLEAN;
  412. ⓪$(*$L-*)
  413. ⓪$BEGIN
  414. ⓪&ASSEMBLER
  415. ⓪(MOVE.L  -(A3),D0  ; hi
  416. ⓪(MOVE.L  -(A3),D1  ; lo
  417. ⓪(MOVE.L  -(A3),D2  ; v
  418. ⓪(CMP.L   D1,D2
  419. ⓪(BCS     fals
  420. ⓪(CMP.L   D0,D2
  421. ⓪(BCC     fals
  422. ⓪(MOVEQ   #1,D0
  423. ⓪(RTS
  424. ⓪&fals
  425. ⓪(CLR     D0
  426. ⓪&END;
  427. ⓪$END between;
  428. ⓪$(*$L=*)
  429. ⓪ 
  430. ⓪"PROCEDURE advance (p: LONGCARD; VAR prl: ProcLenList);
  431. ⓪$(*$L-*)
  432. ⓪$BEGIN
  433. ⓪&ASSEMBLER
  434. ⓪(MOVE.L  -(A3),A2        ; ADR (prl)
  435. ⓪(MOVE.L  -(A3),-(A7)     ; p
  436. ⓪(MOVE.L  (A2),A1
  437. ⓪&lupo
  438. ⓪(MOVE.L  (A7),(A3)+
  439. ⓪(MOVE.L  A1,(A3)+
  440. ⓪(BSR     pStart/
  441. ⓪(MOVE.L  D0,(A3)+
  442. ⓪(MOVE.L  A1,(A3)+
  443. ⓪(BSR     pEnd/
  444. ⓪(MOVE.L  D0,(A3)+
  445. ⓪(BSR     between/
  446. ⓪(BNE     ende
  447. ⓪(ADDQ.L  #8,A1
  448. ⓪(BRA     lupo
  449. ⓪&ende
  450. ⓪(MOVE.L  A1,(A2)
  451. ⓪(ADDQ.L  #4,A7
  452. ⓪&END
  453. ⓪&(*
  454. ⓪&WHILE NOT between (p, pStart (prl), pEnd (prl)) DO
  455. ⓪(INC (prl, SHORT (SIZE (prl^)))
  456. ⓪&END;
  457. ⓪&*)
  458. ⓪$END advance;
  459. ⓪$(*$L=*)
  460. ⓪ 
  461. ⓪"PROCEDURE findListEntry (idx: tIndex; ad: LONGCARD; VAR prl: ProcLenList);
  462. ⓪$BEGIN
  463. ⓪&WITH ModLst^ [idx] DO
  464. ⓪(prl:= image + entry (image, 38)
  465. ⓪&END;
  466. ⓪&advance (ad, prl)
  467. ⓪$END findListEntry;
  468. ⓪ 
  469. ⓪ 
  470. ⓪$VAR
  471. ⓪&image1, image2: ADDRESS;
  472. ⓪&pra1, pra2: RelocList;
  473. ⓪&prl1, prl2: ProcLenList;
  474. ⓪&link1, link2: LONGCARD;
  475. ⓪ 
  476. ⓪"BEGIN (* Vergleiche *)
  477. ⓪$image1:= ModLst^ [1].image;
  478. ⓪$image2:= ModLst^ [2].image;
  479. ⓪$
  480. ⓪$pra1:= image1 + entry (image1, 22);
  481. ⓪$prl1:= image1 + entry (image1, 38);
  482. ⓪$
  483. ⓪$pra2:= image2 + entry (image2, 22);
  484. ⓪$prl2:= image2 + entry (image2, 38);
  485. ⓪$
  486. ⓪$OpenOutput ('TXT');
  487. ⓪$
  488. ⓪$WHILE pra1^.link # NIL DO
  489. ⓪&IF pra1^.procAddr < entry (image1, 22) THEN (* Proc, nicht Var *)
  490. ⓪(advance (pra1^.procAddr, prl1);
  491. ⓪(link1:= pra^.link1;
  492. ⓪(LOOP
  493. ⓪*IF link = 0L THEN
  494. ⓪,EXIT
  495. ⓪*ELSIF between (link, start, ende) THEN
  496. ⓪,IF ~marked (prl) THEN
  497. ⓪.mark (prl,1);
  498. ⓪.markCalls (modidx, pStart (prl), pEnd (prl))
  499. ⓪,END;
  500. ⓪,EXIT
  501. ⓪*END;
  502. ⓪*link:= entry (image, link)
  503. ⓪(END
  504. ⓪&END;
  505. ⓪&INC (pra, 8)
  506. ⓪$END;
  507. ⓪ 
  508. ⓪$CloseOutput;
  509. ⓪ 
  510. ⓪"END Vergleiche;
  511. ⓪ 
  512. ⓪ 
  513. ⓪ PROCEDURE bit (n: CARDINAL; l: ARRAY OF WORD): BOOLEAN;
  514. ⓪"(*$L-*)
  515. ⓪"BEGIN
  516. ⓪$ASSEMBLER
  517. ⓪(MOVE.W  -(A3),D2
  518. ⓪(MOVE.L  -(A3),A0
  519. ⓪(MOVE.W  -(A3),D1
  520. ⓪(TST     D2
  521. ⓪(BEQ     wd
  522. ⓪(MOVE.L  (A0),D0
  523. ⓪(BRA     lg
  524. ⓪%wd MOVE.W  (A0),D0
  525. ⓪%lg BTST    D1,D0
  526. ⓪(SNE     D0
  527. ⓪(ANDI    #1,D0
  528. ⓪$END
  529. ⓪"END bit;
  530. ⓪"(*$L=*)
  531. ⓪ 
  532. ⓪ 
  533. ⓪ PROCEDURE ExecMod (mname: tModName;       (* Name des gewuenschten Moduls *)
  534. ⓪2reqkey: LONGCARD;       (* gewuenschter Key *)
  535. ⓪2client: tIndex)         (* Index des Klienten *)
  536. ⓪8: tIndex;         (* vergebener Index *)
  537. ⓪ 
  538. ⓪"(* Laedt das Modul "mname" und liefert dessen Index in der "ModLst"
  539. ⓪#* als Ergebnis.
  540. ⓪#* Der Modulkey "reqkey" wird erwartet und ueberprueft.
  541. ⓪#* Falls ein Fehler beim Relozieren oder Laden auftritt,
  542. ⓪#* wird der benoetigte Speicher freigegeben und als Ergebnis
  543. ⓪#* "BadIndex" geliefert
  544. ⓪#*)
  545. ⓪$
  546. ⓪"VAR
  547. ⓪.i: tIndex;
  548. ⓪%clientname,
  549. ⓪*fname: tModName;
  550. ⓪-ad: address;
  551. ⓪"
  552. ⓪$
  553. ⓪"PROCEDURE LoadMod (mname, fname: tModName): tIndex;
  554. ⓪ 
  555. ⓪$(* Laedt ein Modul in den Speicher, ueberprueft das Format
  556. ⓪%* und traegt in die Modul-Liste ein. Reloziert nicht!
  557. ⓪%* Wenn ein Fehler auftritt, wird der benutzte Speicher
  558. ⓪%* freigegeben und als Modul-Index BadIndex geliefert
  559. ⓪%*)
  560. ⓪ 
  561. ⓪$PROCEDURE ImportLen (image: address): LongCard;
  562. ⓪&
  563. ⓪&(* Laenge der Importliste des Moduls, das bei image steht,
  564. ⓪)in Bytes ermitteln
  565. ⓪&*)
  566. ⓪&
  567. ⓪&VAR s: address; n: LONGCARD;
  568. ⓪&
  569. ⓪&BEGIN
  570. ⓪(s:= entry (image, 14);
  571. ⓪(IF s = NIL THEN
  572. ⓪*RETURN 0L
  573. ⓪(ELSE
  574. ⓪*n:= 4;  (* Platz für Import-Liste (s. PutMod) *)
  575. ⓪*s:= s+image;
  576. ⓪*WHILE entry (s, 0) # 0L DO
  577. ⓪,inc (s, 4);
  578. ⓪,WHILE cardinal (s^) MOD 256 # 255 DO inc (s, 2) END;
  579. ⓪,inc (s, 2);
  580. ⓪,WHILE cardinal (s^) # 0 DO inc (s, 6) END;
  581. ⓪,inc (s, 2);
  582. ⓪,INC (n, 4);
  583. ⓪*END;
  584. ⓪*RETURN s+4L-image-entry (image, 14) - n
  585. ⓪(END
  586. ⓪&END ImportLen;
  587. ⓪$
  588. ⓪$VAR    foundkey: LongCard;      (* Key des geladenen Moduls    *)
  589. ⓪-ModAdr: Address;       (* Anfang des geladenen Moduls *)
  590. ⓪.found: Boolean;       (* fuer FileSearch             *)
  591. ⓪,DriveNr: Cardinal;      (*  "                          *)
  592. ⓪.VolNr: Cardinal;      (*  "                          *)
  593. ⓪0ad1: address;       (* fuer Storage-Anforderungen  *)
  594. ⓪0len: longcard;      (*  -"-                        *)
  595. ⓪-layout: CARDINAL;
  596. ⓪+realCode: CARDINAL;
  597. ⓪-mname0: POINTER TO tModName;
  598. ⓪,badFile: BOOLEAN;
  599. ⓪-dummys: ARRAY [0..127] OF CHAR;
  600. ⓪$
  601. ⓪$BEGIN (* LoadMod *)
  602. ⓪&IF ModIndex < LinkerParm.maxLinkMod THEN
  603. ⓪(inc (ModIndex);
  604. ⓪&ELSE
  605. ⓪((*** Leider ist die Liste übergelaufen: ***)
  606. ⓪(error (clientname, mname, TooManyMods);
  607. ⓪(DeAllocate (ad1,0L);
  608. ⓪(RETURN BadIndex
  609. ⓪&END;
  610. ⓪&
  611. ⓪&SearchFile (fname,paths,fromStart,found,fname);
  612. ⓪&Open (loadFile,fname,readonly);
  613. ⓪&IF state (loadfile) < 0 THEN
  614. ⓪(error (clientname,mname,notfound);
  615. ⓪(RETURN BadIndex
  616. ⓪&END;
  617. ⓪ 
  618. ⓪&len:= FileSize (loadFile);
  619. ⓪&Allocate (ad1, len);
  620. ⓪&IF ad1 = NIL THEN
  621. ⓪(Close (loadFile);
  622. ⓪(error (clientname,mname,nospace);
  623. ⓪(RETURN BadIndex
  624. ⓪&END;
  625. ⓪ 
  626. ⓪&ReadBytes (loadFile, ad1, len, len);
  627. ⓪&ior:= State (loadFile);
  628. ⓪&ResetState (loadFile);
  629. ⓪&Close (loadFile);
  630. ⓪&IF IOR<0 THEN
  631. ⓪(error (clientname,mname,readerr);
  632. ⓪(DeAllocate (ad1,0L);
  633. ⓪(RETURN BadIndex
  634. ⓪&END;
  635. ⓪ 
  636. ⓪&ASSEMBLER
  637. ⓪(MOVE.L  ad1(A6),A0
  638. ⓪(CMPI.L  #$4D4D3243,(A0)+        ; "MM2C"
  639. ⓪(BNE     nocode
  640. ⓪(CMPI.L  #$6F646500,(A0)+        ; "ode"
  641. ⓪&nocode
  642. ⓪(SNE     D0
  643. ⓪(ANDI    #1,D0
  644. ⓪(MOVE    D0,badFile(A6)
  645. ⓪&END;
  646. ⓪&IF badFile THEN
  647. ⓪(error (clientname,mname,badlayout);
  648. ⓪(DeAllocate (ad1,0L);
  649. ⓪(RETURN BadIndex
  650. ⓪&END;
  651. ⓪ 
  652. ⓪&ModAdr:= ad1+8L;
  653. ⓪ 
  654. ⓪&layout:= Short (entry (ModAdr, 0) DIV 65536L);
  655. ⓪&ASSEMBLER
  656. ⓪(MOVE.W  layout(A6),D0
  657. ⓪(LSR.B   #5,D0
  658. ⓪(ANDI    #3,D0
  659. ⓪(MOVE.W  D0,realCode(A6)
  660. ⓪&END;
  661. ⓪&(*
  662. ⓪(IF (layout DIV 256) < 1 THEN
  663. ⓪*error (clientname,mname,badlayout);
  664. ⓪*DeAllocate (ad1,0L);
  665. ⓪*RETURN BadIndex
  666. ⓪(END;
  667. ⓪&*)
  668. ⓪&
  669. ⓪&IF singleMod THEN
  670. ⓪(singleMod:= FALSE;
  671. ⓪&END;
  672. ⓪&
  673. ⓪&IF realCode # 0 THEN (* real im Code *)
  674. ⓪(IF realForm # 0 THEN (* schon Real benutzt *)
  675. ⓪*IF realCode # realForm THEN
  676. ⓪,error (clientname,mname,badreal);
  677. ⓪,DeAllocate (ad1,0L);
  678. ⓪,RETURN BadIndex
  679. ⓪*END
  680. ⓪(ELSE
  681. ⓪*ReportRealFormat (realCode-1);
  682. ⓪*realForm:= realCode
  683. ⓪(END
  684. ⓪&END;
  685. ⓪&
  686. ⓪&foundkey:= entry (ModAdr, 2);
  687. ⓪&IF (reqkey#anykey) & (reqkey#foundkey) THEN
  688. ⓪(error (clientname,mname,badversion);
  689. ⓪(DeAllocate (ad1,0L);
  690. ⓪(RETURN BadIndex
  691. ⓪&END;
  692. ⓪&
  693. ⓪&(*** Modul in ModLst eintragen ***)
  694. ⓪*
  695. ⓪&WITH ModLst^ [ModIndex] DO
  696. ⓪(mainMod:= LoadingMain;
  697. ⓪(useCode:= TRUE;
  698. ⓪(varsExported:= FALSE;
  699. ⓪(image := ModAdr;
  700. ⓪(mayCrunch:= (layout DIV 256) >= 2;
  701. ⓪(IF optProcs AND NOT mayCrunch THEN
  702. ⓪*error (clientname,mname,nooptimize);
  703. ⓪*RETURN BadIndex
  704. ⓪(END;
  705. ⓪(IF noHeader AND mayCrunch THEN
  706. ⓪*diff:= entry (image, 42) (* ganzen Header weglassen *)
  707. ⓪(ELSE
  708. ⓪*diff:= ImportLen (image)
  709. ⓪(END;
  710. ⓪(codeEnd:= entry (ModAdr, 22);
  711. ⓪(BodyLen:= BodyLen + (codeEnd - entry (ModAdr, 6));
  712. ⓪(varAd := VarNow;
  713. ⓪(varLen:= entry (ModAdr, 10) - entry (ModAdr, 22);
  714. ⓪(key   := foundkey;
  715. ⓪(mname0:= ADDRESS (entry (ModAdr, 26)) + ModAdr;
  716. ⓪(SplitPath (mname0^,dummys,sourcename);
  717. ⓪(mname0:= ADDRESS (entry (ModAdr, 30)) + ModAdr;
  718. ⓪(Assign (mname0^,name,ok);
  719. ⓪(mname0:= ADDRESS (entry (ModAdr, 34)) + ModAdr;
  720. ⓪(SplitPath (mname0^,dummys,symbolname);
  721. ⓪(compopts:= LONGWORD (entry (ModAdr, 46));
  722. ⓪(mayRemove:= NOT bit (2, compopts);
  723. ⓪(procSym:= bit (4, layout);
  724. ⓪(bodyMarked:= FALSE;
  725. ⓪(useCode:= TRUE;
  726. ⓪(crunched:= FALSE;
  727. ⓪(ImpIndex:= 0;
  728. ⓪(ImpLst:= NIL;
  729. ⓪(varNow:= varNow + varlen;
  730. ⓪(IF isCLinkMod (ModIndex) THEN
  731. ⓪*WriteMod (ModIndex, conc ('©', name), fname);
  732. ⓪(ELSE
  733. ⓪*WriteMod (ModIndex, name, fname);
  734. ⓪(END;
  735. ⓪&END;
  736. ⓪&LoadingMain:= FALSE;
  737. ⓪&RETURN ModIndex;
  738. ⓪$END LoadMod;
  739. ⓪ 
  740. ⓪ 
  741. ⓪"PROCEDURE ImportMods (myIndex: tIndex): Boolean;
  742. ⓪"
  743. ⓪$VAR ReqKey: LongCard;
  744. ⓪)ImPtr: address;
  745. ⓪'ImIndex: tIndex;
  746. ⓪,ok: boolean;
  747. ⓪-i: cardinal;
  748. ⓪ 
  749. ⓪$BEGIN
  750. ⓪&WITH ModLst^ [myIndex] DO
  751. ⓪((* Anzahl der importierten Module bestimmen *)
  752. ⓪((* und entspr. Speicher allozieren          *)
  753. ⓪(ImPtr:= image + entry (image, 14); (* ^ImportListe *)
  754. ⓪(ReqKey:= entry (ImPtr, 0);         (* importiertes Modul *)
  755. ⓪(i:= 2;
  756. ⓪(WHILE ReqKey # 0L DO
  757. ⓪*inc (ImPtr, 4);
  758. ⓪*SkipStr (ImPtr);
  759. ⓪*SkipImpList (ImPtr);
  760. ⓪*inc(i);
  761. ⓪*ReqKey:= entry (ImPtr, 0)
  762. ⓪(END; (* alle Importe abgearbeitet *)
  763. ⓪(ALLOCATE (ImpLst, LONG (i) * TSIZE (tIndex));
  764. ⓪(IF ImpLst = NIL THEN
  765. ⓪*error (clientname,name,nospace)
  766. ⓪(END;
  767. ⓪ 
  768. ⓪(ImPtr:= image + entry (image, 14); (* ^ImportListe *)
  769. ⓪(ReqKey:= entry (ImPtr, 0);         (* importiertes Modul *)
  770. ⓪(ok:= true;
  771. ⓪(WHILE (ReqKey # 0L) & ok DO
  772. ⓪*inc (ImPtr, 4);
  773. ⓪*ImIndex:= ExecMod (getstr (ImPtr), ReqKey, myIndex);
  774. ⓪*IF ImIndex # BadIndex THEN
  775. ⓪,SkipImpList (ImPtr);
  776. ⓪,inc(ImpIndex);
  777. ⓪,ImpLst^[ImpIndex]:= ImIndex
  778. ⓪*ELSE
  779. ⓪,ok:= false
  780. ⓪*END;
  781. ⓪*ReqKey:= entry (ImPtr, 0)
  782. ⓪(END; (* alle Importe abgearbeitet *)
  783. ⓪&END;
  784. ⓪&RETURN ok
  785. ⓪$END ImportMods;
  786. ⓪"
  787. ⓪"VAR s1,s2: tModName;
  788. ⓪"
  789. ⓪"BEGIN (* of ExecMod *)
  790. ⓪$IF codesuffix THEN
  791. ⓪&paths:= ImpPaths;
  792. ⓪&ConcatName (mname, DefImpInSuf, fname)
  793. ⓪$ELSE
  794. ⓪&fname:= mname;
  795. ⓪&SplitFileName (fname, mname, s1);
  796. ⓪&Upper (s1);
  797. ⓪&IF StrEqual (s1,DefImpInSuf) THEN
  798. ⓪(paths:= ImpPaths
  799. ⓪&ELSE
  800. ⓪(paths:= ModPaths
  801. ⓪&END
  802. ⓪$END;
  803. ⓪$codesuffix:= true;
  804. ⓪$
  805. ⓪$i:= LoadMod (mname, fname);
  806. ⓪$IF i # BadIndex THEN (* Load war erfolgreich *)
  807. ⓪&RETURN i
  808. ⓪$ELSE (* Load ist schiefgegangen *)
  809. ⓪&RETURN BadIndex
  810. ⓪$END
  811. ⓪"END ExecMod;
  812. ⓪ 
  813. ⓪ 
  814. ⓪ 
  815. ⓪ (*$L-,R-*)
  816. ⓪ PROCEDURE PutIntoRelTab ( v: longcard );
  817. ⓪"(* VAR d:longcard; *)
  818. ⓪"BEGIN
  819. ⓪$ASSEMBLER
  820. ⓪(MOVE.L  -(A3),D0
  821. ⓪(TST.L   firstRelVal
  822. ⓪(BNE     c0
  823. ⓪(MOVE.L  D0,firstRelVal
  824. ⓪(BRA     e0
  825. ⓪ c0      CMP.L   lastRelVal,D0
  826. ⓪(BHI     c1
  827. ⓪ jErr    CLR     (A3)+
  828. ⓪(JMP     RelError                ; Programmende
  829. ⓪ c1      MOVE.L  D0,D1
  830. ⓪(SUB.L   lastRelVal,D1
  831. ⓪(
  832. ⓪(MOVE.L  pRelTab,A0
  833. ⓪ l1      CMPA.L  eRelTab,A0
  834. ⓪(BCC     jErr                    ; Listenüberlauf
  835. ⓪(CMPI.L  #256,D1
  836. ⓪(BCS     c2
  837. ⓪(MOVE.B  #1,(A0)+
  838. ⓪(SUBI.L  #254,D1
  839. ⓪(BRA     l1
  840. ⓪ c2      MOVE.B  D1,(A0)+
  841. ⓪(MOVE.L  A0,pRelTab
  842. ⓪ 
  843. ⓪ e0      MOVE.L  D0,lastRelVal
  844. ⓪$END
  845. ⓪"END PutIntoRelTab;
  846. ⓪ (*$L+,R+*)
  847. ⓪ 
  848. ⓪ 
  849. ⓪ (*
  850. ⓪!* Globale Vars:
  851. ⓪!*)
  852. ⓪ VAR    ListTop: POINTER TO ARRAY [1..100000] OF pLONG;
  853. ⓪'ListBeg: POINTER TO ARRAY [1..100000] OF pLONG;
  854. ⓪%ListIndex: cardinal;
  855. ⓪&LastDrop: pLONG;
  856. ⓪)eoLists, Lists: pLONG;
  857. ⓪ 
  858. ⓪ 
  859. ⓪ PROCEDURE dialog(): Boolean;
  860. ⓪ 
  861. ⓪"(*$R-*)
  862. ⓪"PROCEDURE ClrList;
  863. ⓪$VAR i : cardinal;
  864. ⓪$BEGIN
  865. ⓪&FOR i:= 1 TO ListIndex DO
  866. ⓪(ListTop^[i]:= NIL
  867. ⓪&END;
  868. ⓪&ListIndex:= 0;
  869. ⓪&LastDrop:= Lists
  870. ⓪$END ClrList;
  871. ⓪ 
  872. ⓪"(*$R-,L-*)
  873. ⓪"PROCEDURE SmallestInList() : LONGCARD;
  874. ⓪$BEGIN
  875. ⓪&ASSEMBLER
  876. ⓪(MOVEQ   #-1,D0
  877. ⓪(CLR.W   D1
  878. ⓪(MOVEQ   #1,D2
  879. ⓪&forloop0
  880. ⓪(CMP     listIndex,D2
  881. ⓪(BHI     forend0
  882. ⓪(MOVE    D2,D3
  883. ⓪(SUBQ    #1,D3
  884. ⓪(ASL     #2,D3
  885. ⓪(MOVE.L  ListTop,A0
  886. ⓪(MOVE.L  0(A0,D3.W),A1
  887. ⓪(CMPA.L  #NIL,A1
  888. ⓪(BEQ     cont0
  889. ⓪(MOVE.L  (A1),D4
  890. ⓪(CMP.L   D4,D0
  891. ⓪(BLS     cont0
  892. ⓪(MOVE.L  D4,D0
  893. ⓪(MOVE    D2,D1
  894. ⓪&cont0
  895. ⓪(ADDQ    #1,D2
  896. ⓪(BRA     forloop0
  897. ⓪&forend0
  898. ⓪(TST     D1
  899. ⓪(BEQ     ende
  900. ⓪(SUBQ    #1,D1
  901. ⓪(ASL     #2,D1
  902. ⓪(MOVE.L  ListTop,A0
  903. ⓪(MOVE.L  0(A0,D1.W),D2
  904. ⓪(MOVE.L  ListBeg,A1
  905. ⓪(CMP.L   0(A1,D1.W),D2
  906. ⓪(BNE     cont1
  907. ⓪(CLR.L   0(A0,D1.W)
  908. ⓪(BRA     cont2
  909. ⓪&cont1
  910. ⓪(SUBQ.L  #4,0(A0,D1.W)
  911. ⓪&cont2
  912. ⓪(RTS
  913. ⓪&ende
  914. ⓪(CLR.L   D0
  915. ⓪&END
  916. ⓪$END SmallestInList;
  917. ⓪"
  918. ⓪"(*$R-,L+*)
  919. ⓪"PROCEDURE reloc (myMod, imMod: ptrModDesc; VAR ImPtr: ADDRESS; VAR ok: BOOLEAN);
  920. ⓪$BEGIN
  921. ⓪&ASSEMBLER
  922. ⓪(MOVEM.L D3/D4/D6/A4/A5,-(A7)
  923. ⓪ 
  924. ⓪(MOVE.L  myMod(A6),A4
  925. ⓪(MOVE.L  tModDesc.image(A4),A4   ;^ zu relozierendes Modul
  926. ⓪(
  927. ⓪(MOVE.L  ImPtr(A6),A1
  928. ⓪(MOVE.L  (A1),A1
  929. ⓪(MOVEQ   #1,D6         ;noch ist alles 'ok'
  930. ⓪(
  931. ⓪(MOVE.L  A6,-(A7)
  932. ⓪(MOVE.L  imMod(A6),A6            ;A6 ist ^ModLst^ [ImIndex]
  933. ⓪(MOVE.L  tModDesc.image(A6),A2   ;A2 zeigt auf imp. Modul
  934. ⓪!
  935. ⓪!!RE6   MOVE.W  (A1)+,D0      ;imp. ItemNr
  936. ⓪(BEQ.L   RE5           ;fertig mit diesem Import
  937. ⓪(MOVE.L  18(A2),D3     ;Offset zur Exp.liste
  938. ⓪(BEQ.L   BAD           ;keine da
  939. ⓪(ADD.L   A2,D3
  940. ⓪(MOVE.L  (A1)+,D1      ;importiertes Item
  941. ⓪(BEQ     RE6           ; wird gar nicht benutzt
  942. ⓪ 
  943. ⓪(MOVE    ListIndex,D4
  944. ⓪(CMP.W   ListMax,D4
  945. ⓪(BCC.W   relerr2
  946. ⓪(ADDQ    #1,ListIndex
  947. ⓪(MOVE.L  ListBeg,A5
  948. ⓪(MOVE    ListIndex,D4
  949. ⓪(SUBQ    #1,D4
  950. ⓪(LSL     #2,D4
  951. ⓪(CLR.L   0(A5,D4.W)
  952. ⓪ 
  953. ⓪(MOVE.L  D3,A0
  954. ⓪!!RE9   MOVE.W  (A0)+,D2      ;Item in Exportliste suchen
  955. ⓪(BEQ.W   BAD           ; schade - Liste zuende
  956. ⓪(CMP.W   D2,D0
  957. ⓪(BEQ     RE10          ;gefunden
  958. ⓪(ADDQ.L  #4,A0
  959. ⓪(BRA     RE9
  960. ⓪!!RE10  MOVE.L  (A0)+,D2      ;abs. ItemAdr ausrechnen
  961. ⓪(BEQ     re6           ;wurde wegoptimiert
  962. ⓪(CMP.L   22(A2),D2
  963. ⓪(BCC     isVa2         ;das ist eine Var-Referenz
  964. ⓪(ADD.L   tModDesc.codeAd(A6),D2 ;Prozeduren: + Modulanfang
  965. ⓪(SUB.L   tModDesc.diff(A6),D2   ;            - Importlisten-Laenge
  966. ⓪(BRA     RE11
  967. ⓪!!isVa2 ADD.L   tModDesc.varAd(A6),D2  ;Variablen: + VarAnfang
  968. ⓪(ADD.L   BSSstart,D2   ;Codelänge addieren
  969. ⓪(SUB.L   22(A2),D2
  970. ⓪!!RE11  CMP.L   22(A4),D1     ;liegt Ref innerhalb des Codes ?
  971. ⓪(BCC.W   bad
  972. ⓪(MOVE.L  0(A4,D1.L),D0 ;ItemAdr im Modul nachtragen
  973. ⓪(MOVE.L  D2,0(A4,D1.L)
  974. ⓪ 
  975. ⓪(MOVE.L  (A7),A6
  976. ⓪(MOVE.L  A1,-(A7)
  977. ⓪(MOVE.L  myMod(A6),A5
  978. ⓪(MOVE.L  D1,D4
  979. ⓪(ADD.L   tModDesc.codead(A5),D4
  980. ⓪(SUB.L   tModDesc.diff(A5),D4
  981. ⓪ 
  982. ⓪(MOVE.L  lastDrop,A5
  983. ⓪(CMPA.L  eoLists,A5
  984. ⓪(BCC     relerr1
  985. ⓪(MOVE.L  D4,(A5)
  986. ⓪(MOVE    listIndex,D4
  987. ⓪(SUBQ    #1,D4
  988. ⓪(ASL     #2,D4
  989. ⓪(MOVE.L  ListTop,A1
  990. ⓪(MOVE.L  A5,0(A1,D4.W)
  991. ⓪(MOVE.L  ListBeg,A1
  992. ⓪(TST.L   0(A1,D4.W)
  993. ⓪(BNE.S   cont2
  994. ⓪(MOVE.L  A5,0(A1,D4.W)
  995. ⓪&cont2
  996. ⓪(ADDQ.L  #4,lastDrop
  997. ⓪ 
  998. ⓪(MOVE.L  (A7)+,A1
  999. ⓪(MOVE.L  imMod(A6),A6            ;A6 ist ^ModLst^ [ImIndex]
  1000. ⓪ 
  1001. ⓪(MOVE.L  D0,D1
  1002. ⓪(BNE     RE11
  1003. ⓪(BRA     RE6
  1004. ⓪ 
  1005. ⓪&relerr2
  1006. ⓪(JMP     RelError2
  1007. ⓪&relerr1
  1008. ⓪(CLR     (A3)+
  1009. ⓪(JMP     RelError
  1010. ⓪ 
  1011. ⓪!!bad   CLR.W   D6            ;FehlerFlag
  1012. ⓪!!RE5   MOVE.L  (A7)+,A6      ;A6 wieder reparieren
  1013. ⓪(MOVE.L  ImPtr(A6),A0
  1014. ⓪(MOVE.L  A1,(A0)
  1015. ⓪(MOVE.L  ok(A6),A0
  1016. ⓪(MOVE.W  D6,(A0)
  1017. ⓪ 
  1018. ⓪(MOVEM.L (A7)+,D3/D4/D6/A4/A5
  1019. ⓪&END
  1020. ⓪$END reloc;
  1021. ⓪ 
  1022. ⓪"(*$R+,L+*)
  1023. ⓪"PROCEDURE Relocate ( myIndex: tIndex ) : Boolean;
  1024. ⓪"
  1025. ⓪$VAR      v: LongCard;
  1026. ⓪)ImPtr: address;
  1027. ⓪'ImIndex: tIndex;
  1028. ⓪,ok: boolean;
  1029. ⓪-i: cardinal;
  1030. ⓪!main, importn: tModName;
  1031. ⓪(ptrMod: ptrModDesc;
  1032. ⓪(
  1033. ⓪$BEGIN
  1034. ⓪&(*** Zuerst die Var/Proc-Liste abarbeiten ***)
  1035. ⓪&
  1036. ⓪&ptrMod:= ADR (ModLst^ [myIndex]);
  1037. ⓪&Assign (ptrMod^.name, main, ok);
  1038. ⓪&ClrList;
  1039. ⓪&
  1040. ⓪&ASSEMBLER
  1041. ⓪/MOVEM.L D3/D4/D5/D6/A4/A5/A6,-(A7)
  1042. ⓪/MOVE.L  ListTop,D4
  1043. ⓪/MOVE.L  ListBeg,D5
  1044. ⓪/MOVE.W  ListIndex,D6
  1045. ⓪/MOVE    D6,D3
  1046. ⓪/SUBQ    #1,D3
  1047. ⓪/ASL     #2,D3
  1048. ⓪/MOVE.L  lastDrop,A5
  1049. ⓪/MOVE.L  ptrMod(A6),A1
  1050. ⓪ 
  1051. ⓪/MOVE.L  tModDesc.image(A1),A4    ;A4 zeigt auf Modul-Bild im RAM
  1052. ⓪/MOVE.L  22(A4),A0       ;^Var/ProcListe
  1053. ⓪/ADDA.L  A4,A0
  1054. ⓪(!RE3   MOVE.L  (A0)+,D0        ;^letzte Ref
  1055. ⓪/BEQ.W   RE1             ;Ende der Liste
  1056. ⓪/
  1057. ⓪/MOVE.L  (A0)+,D1        ;rel. Adresse
  1058. ⓪/BEQ     re3             ;wurde wegoptimiert
  1059. ⓪ 
  1060. ⓪/CMP.W   ListMax,D6      ;ListIndex
  1061. ⓪/BCC.W   relerr2b
  1062. ⓪/ADDQ    #1,D6           ;ListIndex
  1063. ⓪/ADDQ    #4,D3
  1064. ⓪/MOVE.L  D5,A6
  1065. ⓪/CLR.L   0(A6,D3.W)
  1066. ⓪ 
  1067. ⓪/CMP.L   22(A4),D1
  1068. ⓪/BCC     isVar           ;das ist eine Var-Referenz
  1069. ⓪/ADD.L   tModDesc.codeAd(A1),D1   ;Prozeduren: + Modulanfang
  1070. ⓪/SUB.L   tModDesc.diff(A1),D1     ;            - Importlisten-Laenge
  1071. ⓪/BRA     RE2
  1072. ⓪(!isVar ADD.L   tModDesc.varAd(A1),D1    ;Variablen: + VarAnfang
  1073. ⓪/ADD.L   BSSstart,D1     ;Codelänge addieren
  1074. ⓪/SUB.L   22(A4),D1
  1075. ⓪(!RE2   CMP.L   22(A4),D0       ;liegt Ref innerhalb des Codes ?
  1076. ⓪/BCC.S   bad2
  1077. ⓪/MOVE.L  0(A4,D0.L),D2   ;^naechste Ref
  1078. ⓪/MOVE.L  D1,0(A4,D0.L)   ;Adresse eintragen
  1079. ⓪ 
  1080. ⓪/ADD.L   tModDesc.codead(A1),D0
  1081. ⓪/SUB.L   tModDesc.diff(A1),D0
  1082. ⓪ 
  1083. ⓪/CMPA.L  eoLists,A5
  1084. ⓪/BCC.S   relerr
  1085. ⓪/MOVE.L  D0,(A5)
  1086. ⓪/MOVE.L  D4,A6
  1087. ⓪/MOVE.L  A5,0(A6,D3.W)
  1088. ⓪/MOVE.L  D5,A6
  1089. ⓪/TST.L   0(A6,D3.W)
  1090. ⓪/BNE.S   cont
  1091. ⓪/MOVE.L  A5,0(A6,D3.W)
  1092. ⓪-cont
  1093. ⓪/ADDQ.L  #4,A5
  1094. ⓪ 
  1095. ⓪/MOVE.L  D2,D0
  1096. ⓪/BNE     RE2             ;weitere Refs auf dieses Objekt
  1097. ⓪/BRA     RE3             ;pruefe, ob weitere Objekte
  1098. ⓪ 
  1099. ⓪-relerr
  1100. ⓪/CLR     (A3)+
  1101. ⓪/JMP     RelError
  1102. ⓪-relerr2b
  1103. ⓪/JMP     RelError2
  1104. ⓪ 
  1105. ⓪(!bad2
  1106. ⓪/MOVE.W  D6,ListIndex
  1107. ⓪/MOVE.L  A5,lastDrop
  1108. ⓪/MOVEM.L (A7)+,D3/D4/D5/D6/A4/A5/A6
  1109. ⓪/END; error ('',main,relocerr); ASSEMBLER
  1110. ⓪/BRA     RE0
  1111. ⓪ 
  1112. ⓪(!RE1   MOVE.L  A5,lastDrop
  1113. ⓪/MOVE.W  D6,ListIndex
  1114. ⓪/MOVEM.L (A7)+,D3/D4/D5/D6/A4/A5/A6
  1115. ⓪)RE0
  1116. ⓪&END;
  1117. ⓪ 
  1118. ⓪((*** Jetzt kümmern wir uns um die Importe ***)
  1119. ⓪&
  1120. ⓪&WITH ptrMod^ DO
  1121. ⓪(ImPtr:= image + entry (image, 14); (* ^ImportListe *)
  1122. ⓪(i:= 1;
  1123. ⓪(ok:= TRUE;
  1124. ⓪(WHILE ( i <= ImpIndex ) & ok DO
  1125. ⓪*inc (ImPtr, 4);
  1126. ⓪*Skipstr (ImPtr); (* ImPtr hinter Namen setzen *)
  1127. ⓪*ImIndex:= ImpLst^[i];
  1128. ⓪*Assign (ModLst^ [ImIndex].name, importn, ok);
  1129. ⓪*reloc (ptrMod, ADR (ModLst^ [ImIndex]), ImPtr, ok);
  1130. ⓪*IF ~ok THEN error (importn,main,relocerr) END;
  1131. ⓪*inc(i)
  1132. ⓪(END; (* alle Importe abgearbeitet *)
  1133. ⓪&END; (* with ModLst^ [myIndex] *)
  1134. ⓪ 
  1135. ⓪&(* Alle f. dieses Modul relozierten Adressen in RelTab eintragen *)
  1136. ⓪&
  1137. ⓪&v:= SmallestInList();
  1138. ⓪&WHILE v # 0L DO
  1139. ⓪(PutIntoRelTab(v);
  1140. ⓪(v:= SmallestInList()
  1141. ⓪&END;
  1142. ⓪&
  1143. ⓪&RETURN ok
  1144. ⓪$END Relocate;
  1145. ⓪ 
  1146. ⓪ 
  1147. ⓪"PROCEDURE setCodeAd;
  1148. ⓪$VAR i: tIndex;
  1149. ⓪$BEGIN
  1150. ⓪&FOR i:= 1 TO ModIndex DO
  1151. ⓪(WITH ModLst^ [i] DO
  1152. ⓪*IF useCode THEN
  1153. ⓪,modlen:= codeEnd - diff;
  1154. ⓪,codeAd:= CodeNow;
  1155. ⓪,CodeNow:= CodeNow + modlen
  1156. ⓪*ELSE
  1157. ⓪,ClearMod (i);
  1158. ⓪,DEC (UsedCodes);
  1159. ⓪,DEC (UsedInits);
  1160. ⓪,modlen:= 0
  1161. ⓪*END
  1162. ⓪(END
  1163. ⓪&END;
  1164. ⓪$END setCodeAd;
  1165. ⓪ 
  1166. ⓪ 
  1167. ⓪"PROCEDURE AnotherMod ():BOOLEAN;
  1168. ⓪$VAR c:CHAR;
  1169. ⓪$BEGIN
  1170. ⓪&Prompt (1, 'Another module (Y/N) ? ');
  1171. ⓪&REPEAT
  1172. ⓪(Read (c);
  1173. ⓪(c:=CAP(c);
  1174. ⓪&UNTIL (c='Y') OR (c='N') OR (c=33C) OR (c=15C);
  1175. ⓪&RETURN (c='Y') OR (c=15C)
  1176. ⓪$END AnotherMod;
  1177. ⓪"
  1178. ⓪"VAR    i,j: cardinal;
  1179. ⓪*ln: INTEGER;
  1180. ⓪%DriveNr: Cardinal;
  1181. ⓪'VolNr: Cardinal;
  1182. ⓪)len: Cardinal;
  1183. ⓪+f: file;
  1184. ⓪%ModName: string;
  1185. ⓪&outsuf: String;
  1186. ⓪+s: string;
  1187. ⓪$outFirst: boolean;
  1188. ⓪%inFirst: boolean;
  1189. ⓪(argc: CARDINAL;
  1190. ⓪(argv: ARRAY [0..9] OF PtrArgStr;
  1191. ⓪%modIdx2: tIndex;
  1192. ⓪$firstMod: BOOLEAN;
  1193. ⓪#linkCount: CARDINAL;
  1194. ⓪%gotLast: BOOLEAN;
  1195. ⓪%tabSize: LONGCARD;
  1196. ⓪$l, avail: LONGINT;
  1197. ⓪%outName: string;                    (* Name des Codefiles *)
  1198. ⓪ 
  1199. ⓪"BEGIN (* of Dialog *)
  1200. ⓪$optProcs:= FALSE;
  1201. ⓪$noHeader:= FALSE;
  1202. ⓪$noShModLst:= FALSE;
  1203. ⓪$noProcSyms:= FALSE;
  1204. ⓪$outname:= '';
  1205. ⓪$HeaderFlags:= {};
  1206. ⓪$InitArgCV (argc,argv);
  1207. ⓪$FOR i:= 1 TO argc-1 DO
  1208. ⓪&Assign (argv[i]^, s, ok);
  1209. ⓪&Upper (s);
  1210. ⓪&IF (s[0] = '-') OR (s[0] = '/') THEN
  1211. ⓪(CASE s[1] OF
  1212. ⓪(| '0'..'9':
  1213. ⓪,j:= 1;
  1214. ⓪,INCL (HeaderFlags, StrConv.StrToCard (s,j,ok));
  1215. ⓪(| 'R':
  1216. ⓪,j:= 2;
  1217. ⓪,j:= StrConv.StrToCard (s,j,ok);
  1218. ⓪,IF j >= 100 THEN ListMax:= j END;
  1219. ⓪(| 'H':
  1220. ⓪,optProcs:= TRUE;
  1221. ⓪(| 'F':
  1222. ⓪,optProcs:= TRUE;
  1223. ⓪,noHeader:= TRUE;
  1224. ⓪,noShModLst:= TRUE;
  1225. ⓪,noProcSyms:= TRUE;
  1226. ⓪(| 'M':
  1227. ⓪,noProcSyms:= TRUE;
  1228. ⓪(| 'V':
  1229. ⓪,VerboseOutput;
  1230. ⓪(| 'O':
  1231. ⓪,IF s[2] # 0C THEN
  1232. ⓪.(* Output name directly appended *)
  1233. ⓪.INC (argv[i], 2);
  1234. ⓪.FastStrings.Assign (argv[i]^, outname);
  1235. ⓪,ELSIF i < argc-1 THEN
  1236. ⓪.(* Output name in next word *)
  1237. ⓪.FastStrings.Assign (argv[i+1]^, outname);
  1238. ⓪,END
  1239. ⓪(ELSE
  1240. ⓪*ReportError (conc ('Illegal option character: ', s[1]));
  1241. ⓪(END;
  1242. ⓪(argv[i]^[0]:= 0C
  1243. ⓪&END
  1244. ⓪$END;
  1245. ⓪$ClearEOP;
  1246. ⓪$
  1247. ⓪$CodeNow:= 18 + LENGTH (CodeID) + 1 + SysVarSpace;
  1248. ⓪F(* Platz fuer Start-LEA's/JMP und PDB *)
  1249. ⓪$VarNow:= 0L;
  1250. ⓪$BodyLen:= 0;
  1251. ⓪$
  1252. ⓪$ModIndex:= 0;
  1253. ⓪$modIdx2:=0;
  1254. ⓪$firstMod:= TRUE;
  1255. ⓪$linkCount:= MIN (LLRange);
  1256. ⓪$gotLast:= FALSE;
  1257. ⓪$LOOP
  1258. ⓪&inFirst:= TRUE;
  1259. ⓪&REPEAT
  1260. ⓪(Prompt (1, 'Module name? ');
  1261. ⓪(ReadString (ModName);
  1262. ⓪(inFirst:= FALSE;
  1263. ⓪(IF length (ModName) = 0 THEN
  1264. ⓪*Remove (outfile);
  1265. ⓪*RETURN false
  1266. ⓪(ELSIF NOT hasSuffix (ModName) THEN
  1267. ⓪*ConcatName (modname, DefPrgInSuf, modname);
  1268. ⓪(END;
  1269. ⓪(DiscardMods (modIdx2);
  1270. ⓪(Report (1, 'Module name: ');
  1271. ⓪(WriteString (ModName);
  1272. ⓪(IF firstMod THEN
  1273. ⓪*singleMod:= TRUE;
  1274. ⓪*InitIndex:= 0;
  1275. ⓪*ClearEOP;
  1276. ⓪(END;
  1277. ⓪((* Release geladene Moduln: *)
  1278. ⓪(WHILE ModIndex # modIdx2 DO
  1279. ⓪*DeAllocate (ModLst^ [ModIndex].ImpLst,0L);
  1280. ⓪*DeAllocate (ModLst^ [ModIndex].image,0L);
  1281. ⓪*DEC (ModIndex)
  1282. ⓪(END;
  1283. ⓪(LoadingMain:= TRUE;
  1284. ⓪(CodeSuffix:= false
  1285. ⓪&UNTIL ExecMod (modname, anykey, BadIndex) # BadIndex;
  1286. ⓪&IF firstMod THEN
  1287. ⓪(InitIdx2:= InitIndex
  1288. ⓪&END;
  1289. ⓪&IF (argc>=2) & gotLast THEN
  1290. ⓪(EXIT
  1291. ⓪&END;
  1292. ⓪&IF (argc<2) & ~AnotherMod () THEN
  1293. ⓪(EXIT
  1294. ⓪&END;
  1295. ⓪&modIdx2:= ModIndex;
  1296. ⓪&firstMod:= FALSE
  1297. ⓪$END;
  1298. ⓪$
  1299. ⓪$(* Alles geladen, nun kann alles reloziert werden *)
  1300. ⓪$
  1301. ⓪$Vergleiche;
  1302. ⓪$
  1303. ⓪$HALT;
  1304. ⓪$RETURN TRUE
  1305. ⓪"END dialog;
  1306. ⓪ 
  1307. ⓪ VAR dummy: PDB;
  1308. ⓪$ch: CHAR;
  1309. ⓪ 
  1310. ⓪ BEGIN (* ROMLoad *)
  1311. ⓪"IF SIZE (dummy.ModLst^[1]) # ShModLstSpace THEN HALT END;
  1312. ⓪"IF TSIZE (PDB) # SysVarSpace THEN HALT END;
  1313. ⓪"IF NOT ODD (LENGTH (CodeID)) THEN HALT END;
  1314. ⓪"
  1315. ⓪"IF LinkerParm.maxLinkMod >= (MAX (tIndex)-1) THEN
  1316. ⓪$LinkerParm.maxLinkMod:= MAX (tIndex)-2
  1317. ⓪"END;
  1318. ⓪"IF LinkerParm.maxLinkMod = 0 THEN LinkerParm.maxLinkMod:= 100 END;
  1319. ⓪"ListMax:= 1000;
  1320. ⓪"
  1321. ⓪"InitOutput (LinkerParm.maxLinkMod, conc ('Megamax Modula-2 Linker ',version));
  1322. ⓪"
  1323. ⓪"HomePath:= ShellPath; 
  1324. ⓪"
  1325. ⓪"ALLOCATE (ModLst, TSIZE (tModDesc) * LONG (LinkerParm.maxLinkMod+2));
  1326. ⓪"ALLOCATE (InitLst, TSIZE (tIndex) * LONG (LinkerParm.maxLinkMod+2));
  1327. ⓪"IF (ModLst = NIL) OR (ModLst = NIL) THEN
  1328. ⓪$ReportError ('Out of memory');
  1329. ⓪$TermProcess (MOSGlobals.OutOfMemory)
  1330. ⓪"END;
  1331. ⓪"DefPrgInSuf:= DftSfx;
  1332. ⓪"DefImpInSuf:= ImpSfx;
  1333. ⓪"RelocTab:= NIL;
  1334. ⓪"pRelTab:= NIL;
  1335. ⓪"firstRelVal:= 0L;
  1336. ⓪"lastRelVal:= 0L;
  1337. ⓪"realForm:= 0;
  1338. ⓪"extendedCode:= FALSE;
  1339. ⓪"IF dialog() THEN
  1340. ⓪"END;
  1341. ⓪ END CmpMods2.
  1342. ⓪ ə
  1343. (* $FFF20C02$FFF698A3$FFFD709E$FFFD709E$FFFD709E$FFFD709E$FFFD709E$FFFD709E$FFFD709E$FFFD709E$FFFD709E$FFFD709E$FFFD709E$FFFD709E$FFFD709E$FFE7FB26$FFFD709E$FFFD709E$FFFD709E$FFFD709E$00006FEC$FFFD709E$FFFD709E$FFFD709E$FFFD709E$FFFD709E$FFF6AA4D$FFE7FB26$FFFD709E$FFE7FB26$FFFD709E$FFE7FB26$FFFD709E$FFFD709E$00002111$FFFD709E$FFF6AAC9$FFFD709E$FFE7FB26$FFFD709E$FFFD709E$FFFD709EÇ$00003171T.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$000030BD$0000317E$00003197$000031B1$000031E1$000031F1$000031FB$00003208$00000093$00000078$00003171$00003315$0000316E$000031D4$0000313F$0000314FÕÇâ*)
  1344.