TOS Silver 2000

home *** CD-ROM | disk | FTP | other *** search

/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / DIV / MODREF.M < prev

Wrap

Text File | 1991-03-04 | 27.2 KB | 3 lines

⓪ MODULE ModRef;⓪ (*$R-,Z+*)⓪ ⓪ (* TO DO⓪!- comp-opts auswerten - zumindest: $N, um Runtime mit in Liste aufzunehmen,⓪#ansonsten evtl. (optional?) $I, $C, $O, $U⓪ ⓪!- auch name des make-files bestimmbar machen!⓪ *)⓪ ⓪ (*---------------------------------------------------------------------------⓪!* BuildMakeFile-Utility für Megamax Modula-2⓪!*⓪!* Holt sich vom Benutzer eine Sourcedatei (per Fileselektor)⓪!* und erstellt dazu einen vollständigen Baum aller Import-⓪!* abhängigkeiten. Dieser Baum wird in einer Datei mit der⓪!* Endung M2M in einem Format abgelegt, das für das Make-⓪!* Utility lesbar ist (Definition siehe dort).⓪!*⓪!* Argumente: { Sourcefile | ["-"|"/"] Optionchar }⓪!* Optionchar: "C" unterdrückt evtl. Tastenabfrage am Ende⓪!* "Q" unterdrückt ALLE Ein-/Ausgaben⓪!*--------------------------------------------------------------------------⓪!* Version 1.4⓪!*--------------------------------------------------------------------------⓪!* CD : Christian Drießle⓪!* TT : Thomas Tempelmann⓪!*--------------------------------------------------------------------------⓪!* Datum Version Author Bemerkung (Arbeitsbericht)⓪!*--------------------------------------------------------------------------⓪!* 10.07.89 CD Programmstruktur erdacht, losprogrammiert.⓪!* 13.07.89 TT Programmstruktur überarbeitet, GetTok, Listen.⓪!* 27.07.89 1.0 CD Grundversion erstellt.⓪!* 03.08.89 TT Programm überarbeitet.⓪!* 19.08.89 TT 1. Modulsource ist Namensgeber f. Make-File⓪!* (Endung M2M); DefLibName wird auch ShellMsg⓪!* importiert; 1.Source wird mit "-MAIN" deklariert⓪!* 20.09.89 1.1 TT Optimierte Token-Routine von Pat Maupin;⓪!* Wildcards bei Cmdline-Namen möglich⓪!* 23.11.89 1.2 TT In Comments werden keine Token ausgewertet;⓪!* Bei Syntaxfehler wird Zeilennr. angezeigt.⓪!* 24.02.90 1.3 TT Explizit angegebene Def-/Imp-Texte werden auch⓪!* gescanned, so als ob sie importiert würden⓪!* 04.03.90 TT Fehlende Sources werden mit '-NOSRC' gekenn-⓪!* zeichnet, sodaß nur ihre Codes geprüft werden.⓪!* 10.11.90 TT $R-,Z+⓪!* 04.03.91 1.4 TT Option "-C" verhindert Warten am Ende.⓪!*)⓪ ⓪ ⓪ FROM Storage IMPORT ALLOCATE;⓪ ⓪ FROM GEMEnv IMPORT InitGem, RC, GemHandle, DeviceHandle,⓪3ExitGem, CurrGemHandle;⓪ ⓪ FROM MOSGlobals IMPORT defaultDrv, PathStr;⓪ ⓪ FROM EasyGEM1 IMPORT SelectMask, SelectFile;⓪ ⓪ FROM Strings IMPORT Upper, String, Assign, Append, StrEqual, Length,⓪4Empty, Pos, Space, Delete, Insert, Concat,⓪4Copy, Compare, Relation;⓪ ⓪ FROM StrConv IMPORT CardToStr;⓪ ⓪ FROM PathEnv IMPORT HomeReplaced, HomePath;⓪ FROM PathCtrl IMPORT PathList;⓪ FROM Paths IMPORT ListPos, SearchFile;⓪ ⓪ FROM ShellMsg IMPORT DefPaths, ImpPaths, ModPaths, SrcPaths,⓪5ShellPath, DefLibName, DefSfx, ImpSfx, ModSfx,⓪5DefSrcSfx, ImpSrcSfx, ModSrcSfx;⓪ ⓪ FROM Lists IMPORT List, CreateList, DeleteList, ListEmpty, RemoveEntry,⓪2NextEntry, AppendEntry, ResetList, CurrentEntry;⓪ ⓪ FROM Files IMPORT File, Access, ReplaceMode, Open, Create, Close, Remove, EOF;⓪ ⓪ FROM Directory IMPORT DefaultDrive, GetCurrentDir, SearchFirst, SearchNext,⓪6MakeFullPath, GetDTA, DTA, DirEntry, GetDTAEntry,⓪6QueryFiles;⓪ ⓪ FROM FileNames IMPORT SplitName, DriveToStr, SplitPath, PathConc, NameUnique,⓪6NameConc, FilePrefix, ConcatName, ConcatPath;⓪ ⓪ FROM AESForms IMPORT FormAlert;⓪ ⓪ FROM PrgCtrl IMPORT TermProcess;⓪ ⓪ IMPORT LibFiles;⓪ ⓪ FROM SYSTEM IMPORT ASSEMBLER, ADR;⓪ ⓪ FROM Text IMPORT WriteString, Write, WriteLn, ReadString, Read;⓪ ⓪ FROM ArgCV IMPORT InitArgCV, PtrArgStr;⓪ ⓪ FROM SysTypes IMPORT CHARSET;⓪ ⓪ IMPORT InOut;⓪ ⓪ (* FROM Binary IMPORT ReadBytes; *)⓪ ⓪ ⓪ TYPE⓪$ModTypes = (Mod, Imp, Def);⓪$ModStr = ARRAY [0..79] OF CHAR;⓪$ModStrPtr= POINTER TO ModStr;⓪$CharSet = SET OF CHAR;⓪$ErrType = (outOfMemory);⓪$ModList = List (* OF ModStrPtr *);⓪ ⓪ CONST⓪$MaxImpEnd = 6;⓪ ⓪ VAR⓪$SourceNotFound: BOOLEAN;⓪$WaitAtEnd : BOOLEAN;⓪$DoIO : BOOLEAN;⓪$ignoreCase : BOOLEAN; (* Modulnamen Case-Sensitiv vergleichen? *)⓪$ok, err : BOOLEAN;⓪$res : INTEGER;⓪$makef : File;⓪$LibOpened : BOOLEAN;⓪$Lib : LibFiles.LibFile;⓪$argc, argn : CARDINAL;⓪$DoingSearch: BOOLEAN;⓪$SearchPath : PathStr;⓪$argv : ARRAY [0..20] OF PtrArgStr;⓪$SystemName : String;⓪ ⓪ ⓪ PROCEDURE Quit (Str : ARRAY OF CHAR);⓪"VAR but : CARDINAL;⓪&AlStr : ARRAY [0..250] OF CHAR;⓪"BEGIN⓪$Remove (makef);⓪$IF LibOpened THEN LibFiles.CloseLib (Lib) END;⓪$IF Str [0] # 0C THEN⓪&Assign ('[3][', AlStr, ok);⓪&Append (Str, AlStr, ok);⓪&Append ('][Schade]', AlStr, ok);⓪&FormAlert (1, AlStr, but);⓪$END;⓪$TermProcess (1);⓪"END Quit;⓪ ⓪ ⓪ MODULE ModLists;⓪ ⓪"IMPORT ModList, AppendEntry, ResetList, NextEntry, RemoveEntry, err, Upper,⓪)ignoreCase, ModStr, StrEqual, Assign, ErrType, ModStrPtr, Quit, ADR,⓪)ALLOCATE;⓪ ⓪"EXPORT GetFromModList, InModList, PutInModList;⓪ ⓪"VAR ok: BOOLEAN;⓪ ⓪"PROCEDURE InModList (modName: ARRAY OF CHAR; list: ModList): BOOLEAN;⓪$VAR namePtr: ModStrPtr; name2: ModStr;⓪$BEGIN⓪&IF ignoreCase THEN Upper (modName) END;⓪&ResetList (list);⓪&LOOP⓪(namePtr:= NextEntry (list);⓪(IF namePtr = NIL THEN EXIT END;⓪(Assign (namePtr^, name2, ok);⓪(IF ignoreCase THEN Upper (name2) END;⓪(IF StrEqual (modName, name2) THEN⓪*RETURN TRUE⓪(END⓪&END;⓪&RETURN FALSE⓪$END InModList;⓪ ⓪"PROCEDURE PutInModList (modName: ARRAY OF CHAR; VAR list: ModList);⓪$VAR namePtr: ModStrPtr;⓪$BEGIN⓪&NEW (namePtr);⓪&IF namePtr = NIL THEN⓪(Quit (' Kann keine neuen Module | mehr aufnehmen! ');⓪&END;⓪&Assign (modName, namePtr^, ok);⓪&AppendEntry (list, namePtr, err);⓪&IF err THEN⓪(Quit (' Kann keine neuen Module | mehr aufnehmen! ');⓪&END;⓪$END PutInModList;⓪ ⓪"PROCEDURE GetFromModList (VAR modName: ARRAY OF CHAR;⓪<VAR list: ModList): BOOLEAN;⓪$VAR namePtr: ModStrPtr;⓪$BEGIN⓪&ResetList (list);⓪&namePtr:= NextEntry (list);⓪&IF namePtr = NIL THEN⓪(RETURN FALSE⓪&ELSE⓪(Assign (namePtr^, modName, ok);⓪(RemoveEntry (list, ok);⓪(RETURN TRUE⓪&END;⓪$END GetFromModList;⓪ ⓪"END ModLists;⓪ ⓪ ⓪ MODULE ProcessedMods;⓪ ⓪"IMPORT ModList, CreateList, ErrType, Quit, InModList, PutInModList, List;⓪ ⓪"EXPORT Processed;⓪ ⓪"VAR processedMods: List;⓪&err: BOOLEAN;⓪ ⓪"PROCEDURE Processed (modName: ARRAY OF CHAR): BOOLEAN;⓪$BEGIN⓪&IF InModList (modName, processedMods) THEN⓪(RETURN TRUE⓪&ELSE⓪(PutInModList (modName, processedMods);⓪(RETURN FALSE⓪&END⓪$END Processed;⓪ ⓪"BEGIN⓪$CreateList (processedMods, err);⓪$IF err THEN⓪&Quit (' Kann Liste >processedMods< | nicht anlegen!')⓪$END;⓪"END ProcessedMods;⓪ ⓪ ⓪ MODULE Tokens;⓪ ⓪"IMPORT⓪$File, Access, Open, Close, StrEqual, Copy, Length,⓪$Pos, CHARSET, EOF, InOut, ADR, ReadString, Read,⓪$ASSEMBLER, Assign, Compare, Relation;⓪ ⓪"EXPORT⓪$ImportTerminators, GetNextTok, OpenSrc, CloseSrc, Ident, Idents,⓪$currentFile, currentLine, linePtr;⓪ ⓪"TYPE⓪$Ident = (Eof, User, Comma, Semicolon, OpenBracket, CloseBracket,⓪.CommentBegin, CommentEnd,⓪.Operator, Number, StringConst,⓪.And, Array, Begin, By, Case, Const, Definition, Div, Do,⓪.Else, Elsif, End, Exit, Export, For, Forward, From, Goto,⓪.If, Implementation, Import, In, Loop, Modulo, Module, Not, Of,⓪.Or, Pervasive, Pointer, Procedure, Qualified, Record, Repeat,⓪.Return, Set, Table, Then, To, Type, Until, Var, While, With );⓪ ⓪$Idents = SET OF Ident;⓪ ⓪"CONST⓪$DLE = 20C; (* 16 dez. *)⓪$ImportTerminators = Idents {Export, Forward, Table, Type, Const,⓪@Module, Var, Procedure, Begin, End};⓪ ⓪"VAR⓪$currentFile: ARRAY [0..141] OF CHAR;⓪$currentLine: CARDINAL;⓪$line: ARRAY [0..255] OF CHAR;⓪$linePtr: CARDINAL;⓪$ok, opened: BOOLEAN;⓪$src: File;⓪ ⓪"PROCEDURE newLine (): BOOLEAN;⓪$VAR c: CHAR;⓪$BEGIN⓪&linePtr:= 0;⓪&LOOP⓪(IF EOF (src) THEN⓪*RETURN FALSE⓪(END;⓪(ReadString (src, line);⓪(IF line[0] # DLE THEN⓪*(*⓪,InOut.WriteString ('>');⓪,InOut.WriteString (line);⓪,InOut.WriteString ('<');⓪,InOut.WriteLn;⓪**)⓪*INC (currentLine);⓪*RETURN TRUE⓪(END;⓪(Read (src, c);⓪&END;⓪$END newLine;⓪ ⓪"PROCEDURE OpenSrc (name: ARRAY OF CHAR);⓪$VAR dummy: BOOLEAN;⓪$BEGIN⓪&IF opened THEN⓪(HALT⓪&ELSE⓪(opened:= TRUE;⓪(Open (src, name, readSeqTxt);⓪(currentLine:= 0;⓪(Assign (name, currentFile, dummy);⓪(dummy:= newLine ();⓪&END⓪$END OpenSrc;⓪ ⓪"PROCEDURE CloseSrc ();⓪$BEGIN⓪&opened:= FALSE;⓪&Close (src)⓪$END CloseSrc;⓪ ⓪"PROCEDURE CheckKeyWord(VAR s: ARRAY OF CHAR): Ident;⓪$PROCEDURE eq (REF s1: ARRAY OF CHAR): BOOLEAN;⓪&BEGIN RETURN StrEqual (s, s1) END eq;⓪$VAR s1: CHAR;⓪$BEGIN⓪&s1:= s[1];⓪&CASE s[0] OF⓪&| 'A': IF s1 = 'N' THEN⓪/IF eq ('AND') THEN RETURN And END⓪-ELSIF s1 = 'R' THEN⓪/IF eq ('ARRAY') THEN RETURN Array END⓪-END;⓪&| 'B': IF s1 = 'E' THEN⓪/IF eq ('BEGIN') THEN RETURN Begin END⓪-ELSIF (s1 = 'Y') AND (s[2] = CHR(0)) THEN RETURN By END⓪&| 'C': IF s1 = 'A' THEN⓪/IF eq ('CASE') THEN RETURN Case END⓪-ELSIF s1 = 'O' THEN⓪/IF eq ('CONST') THEN RETURN Const END⓪-END;⓪&| 'D': IF s1 ='E' THEN⓪/IF eq ('DEFINITION') THEN RETURN Definition END⓪-ELSIF s1 = 'I' THEN⓪/IF eq ('DIV') THEN RETURN Div END⓪-ELSIF (s1 = 'O') AND (s[2] = CHR(0)) THEN RETURN Do END⓪&| 'E': IF (s1 = 'L') AND (s[2] = 'S') THEN⓪/IF eq ('ELSE') THEN RETURN Else⓪/ELSIF eq ('ELSIF') THEN RETURN Elsif END⓪-ELSIF s1 = 'N' THEN⓪/IF eq ('END') THEN RETURN End END⓪-ELSIF s1 = 'X' THEN⓪/IF eq ('EXIT') THEN RETURN Exit⓪/ELSIF eq ('EXPORT') THEN RETURN Export END⓪-END;⓪&| 'F': IF (s1='O') AND (s[2] = 'R') THEN⓪/IF s[3] = CHR(0) THEN RETURN For⓪/ELSIF eq ('FORWARD') THEN RETURN Forward END⓪-ELSIF s1 = 'R' THEN⓪/IF eq ('FROM') THEN RETURN From END⓪-END;⓪&| 'I': IF s1 = 'F' THEN⓪/IF s[2] = CHR(0) THEN RETURN If END⓪-ELSIF (s1 = 'M') AND (s[2] = 'P') THEN⓪/IF eq ('IMPLEMENTATION') THEN RETURN Implementation⓪/ELSIF eq ('IMPORT') THEN RETURN Import END⓪-ELSIF (s1 = 'N') AND (s[2] = CHR(0)) THEN RETURN In END;⓪&| 'L': IF s1 = 'O' THEN⓪/IF eq ('LOOP') THEN RETURN Loop END⓪-END;⓪&| 'M': IF (s1 = 'O') AND (s[2] = 'D') THEN⓪/IF s[3] = CHR(0) THEN RETURN Modulo⓪/ELSIF eq ('MODULE') THEN RETURN Module END⓪-END;⓪&| 'N': IF (s1 = 'O') AND (s[2] = 'T') AND (s[3] = CHR(0)) THEN⓪/RETURN Not⓪-END;⓪&| 'O': IF s[2] = CHR(0) THEN⓪/IF s1 = 'F' THEN RETURN Of⓪/ELSIF s1 = 'R' THEN RETURN Or END⓪-END;⓪&| 'P': IF s1 = 'O' THEN⓪/IF eq ('POINTER') THEN RETURN Pointer END⓪-ELSIF s1 = 'R' THEN⓪/IF eq ('PROCEDURE') THEN RETURN Procedure END⓪-ELSIF s1 = 'E' THEN⓪/IF eq ('PERVASIVE') THEN RETURN Pervasive END⓪-END;⓪&| 'Q': IF eq ('QUALIFIED') THEN RETURN Qualified END⓪&| 'R': IF s1 = 'E' THEN⓪/IF s[2] = 'C' THEN⓪1IF eq ('RECORD') THEN RETURN Record END⓪/ELSIF s[2] = 'P' THEN⓪1IF eq ('REPEAT') THEN RETURN Repeat END⓪/ELSIF s[2] = 'T' THEN⓪1IF eq ('RETURN') THEN RETURN Return END⓪/END⓪-END;⓪&| 'S': IF (s1 = 'E') AND (s[2] = 'T') AND (s[3] = CHR(0)) THEN⓪/RETURN Set⓪-END;⓪&| 'T': IF s1 = 'H' THEN⓪/IF eq ('THEN') THEN RETURN Then END⓪-ELSIF s1 = 'O' THEN⓪/IF s[2] = CHR(0) THEN RETURN To END⓪-ELSIF s1 = 'Y' THEN⓪/IF eq ('TYPE') THEN RETURN Type END⓪-ELSIF s1 = 'A' THEN⓪/IF eq ('TABLE') THEN RETURN Table END⓪-END;⓪&| 'U': IF eq ('UNTIL') THEN RETURN Until END⓪&| 'V': IF (s1 = 'A') AND (s[2] = 'R') AND (s[3] = CHR(0)) THEN⓪/RETURN Var⓪-END;⓪&| 'W': IF s1 = 'H' THEN⓪/IF eq ('WHILE') THEN RETURN While END⓪-ELSIF s1 = 'I' THEN⓪/IF eq ('WITH') THEN RETURN With END⓪-END⓪&ELSE⓪&END;⓪&RETURN User⓪$END CheckKeyWord;⓪ ⓪"CONST⓪$Alphanumerics = CHARSET {'A'..'Z','a'..'z','0'..'9','_','@'};⓪$SecondLetters = CHARSET {'A','E','F','H','I','L'..'O','R','U','X','Y'};⓪ ⓪"PROCEDURE skipComment (): BOOLEAN;⓪ ⓪$(*$Z-*)⓪$PROCEDURE pos (REF s1: ARRAY OF CHAR; VAR s2: ARRAY OF CHAR; p: CARDINAL): INTEGER;⓪&(*$L-*) BEGIN ASSEMBLER JMP Pos END END pos; (*$L=*)⓪$(*$Z+*)⓪ ⓪$VAR nest, p: CARDINAL; p1, p2: INTEGER;⓪ ⓪$BEGIN⓪&p:= linePtr;⓪&nest:= 1;⓪&REPEAT⓪(p1:= pos ('(*', line, p);⓪(p2:= pos ('*)', line, p);⓪(IF (p1 >= 0) OR (p2 >= 0) THEN⓪*IF (p2 < 0) THEN⓪,INC (nest);⓪,p:= p1 + 2⓪*ELSIF p1 < 0 THEN⓪,DEC (nest);⓪,p:= p2 + 2⓪*ELSE⓪,IF p1 < p2 THEN⓪.INC (nest);⓪.p:= p1 + 2⓪,ELSE⓪.DEC (nest);⓪.p:= p2 + 2⓪,END⓪*END⓪(ELSE⓪*IF NOT newLine () THEN⓪,RETURN FALSE⓪*END;⓪*p:= linePtr⓪(END;⓪&UNTIL nest = 0;⓪&linePtr:= p;⓪&RETURN TRUE⓪$(*$D-*)⓪$END skipComment;⓪ ⓪"PROCEDURE GetToken (VAR s: ARRAY OF CHAR): Ident;⓪$VAR i: CARDINAL;⓪(ch: CHAR;⓪(myToken: Ident;⓪$BEGIN⓪&LOOP⓪(ch:= line[linePtr];⓪(IF ch > ' ' THEN EXIT END;⓪(IF ch = 0C THEN⓪*s[0]:= CHR(0);⓪*IF NOT newLine () THEN⓪,RETURN Eof⓪*END;⓪(ELSE⓪*INC (linePtr)⓪(END⓪&END;⓪ ⓪&i:= linePtr + 1;⓪&myToken:= Operator;⓪&s[0]:= ch;⓪&s[1]:= 0C;⓪ ⓪&CASE ch OF⓪&| '0'..'9': myToken:= Number;⓪2WHILE line[i] IN Alphanumerics DO⓪4INC(i)⓪2END;⓪2Copy (line, linePtr, i-linePtr, s, ok);⓪&| 'A'..'Z': WHILE line[i] IN CHARSET{'A'..'Z'} DO⓪4INC(i)⓪2END;⓪2IF line[i] IN Alphanumerics THEN⓪4REPEAT⓪6INC(i);⓪4UNTIL NOT (line[i] IN Alphanumerics);⓪4Copy (line, linePtr, i-linePtr, s, ok);⓪4myToken:= User⓪2ELSE⓪4(* Slice (s,line,linePtr,i-linePtr); *)⓪4Copy (line, linePtr, i-linePtr, s, ok);⓪4linePtr:= i;⓪4IF s[1] IN SecondLetters THEN⓪6RETURN CheckKeyWord(s)⓪4ELSE⓪6RETURN User⓪4END;⓪2END;⓪&| 'a'..'z',⓪('@','_': myToken:= User;⓪2WHILE line[i] IN Alphanumerics DO⓪4INC(i)⓪2END;⓪2Copy (line, linePtr, i-linePtr, s, ok);⓪&| '(': IF line[i] = '*' THEN⓪4INC (i);⓪4myToken:= CommentBegin⓪2END;⓪&| '*': IF line[i] = ')' THEN⓪4INC (i);⓪4myToken:= CommentEnd⓪2END;⓪&| "'",⓪)'"': myToken:= StringConst;⓪2LOOP⓪4IF line[i] = CHR(0) THEN EXIT END;⓪4IF line[i] = line[linePtr] THEN⓪6INC (i);⓪6EXIT⓪4END;⓪4INC (i)⓪2END;⓪&| ',': myToken:= Comma;⓪&| ';': myToken:= Semicolon;⓪&| '[': myToken:= OpenBracket;⓪&| ']': myToken:= CloseBracket;⓪&ELSE⓪(Copy (line, linePtr, i-linePtr, s, ok);⓪((* InOut.Write ('>'); InOut.WriteCard (ORD(line[linePtr]),0); *)⓪&END;⓪&linePtr:= i;⓪&RETURN myToken⓪$END GetToken;⓪ ⓪"PROCEDURE GetNextTok (VAR s: ARRAY OF CHAR): Ident;⓪$VAR myToken: Ident;⓪$BEGIN⓪&LOOP⓪(myToken:= GetToken (s);⓪(IF myToken = Eof THEN RETURN Eof END;⓪(IF myToken = CommentBegin THEN⓪*IF NOT skipComment () THEN RETURN Eof END;⓪(ELSE⓪*RETURN myToken⓪(END⓪&END;⓪$END GetNextTok;⓪ ⓪"BEGIN⓪$opened:= FALSE;⓪"END Tokens;⓪ ⓪ ⓪ PROCEDURE GetMainName (VAR s: ARRAY OF CHAR): BOOLEAN;⓪ ⓪"VAR⓪$path: ARRAY [0..127] OF CHAR;⓪$name, dummy: ARRAY [0..12] OF CHAR;⓪$ior: INTEGER; ch: CHAR; fok: BOOLEAN;⓪ ⓪"PROCEDURE getName;⓪$VAR dta: DTA; entry: DirEntry;⓪$BEGIN⓪&GetDTA (dta);⓪&GetDTAEntry (dta, entry);⓪&ConcatPath (SearchPath, entry.name, s)⓪$END getName;⓪ ⓪"PROCEDURE notfound;⓪$BEGIN⓪&IF DoIO THEN⓪(InOut.WriteString (s);⓪(InOut.WriteString (' nicht gefunden!');⓪(InOut.WriteLn ();⓪(InOut.FlushKbd ();⓪(InOut.Read (ch)⓪&END⓪$END notfound;⓪ ⓪"BEGIN⓪$IF DoingSearch THEN⓪&SearchNext (ior);⓪&IF ior >= 0 THEN⓪(getName;⓪(RETURN TRUE⓪&END;⓪&DoingSearch:= FALSE;⓪$END;⓪$IF argc > 1 THEN⓪&(* Namen aus Cmdline holen *)⓪&LOOP⓪(IF argn >= argc THEN⓪*RETURN FALSE⓪(ELSE⓪*Assign (argv[argn]^, path, ok);⓪*INC (argn);⓪*IF (path[0] # '-') & (path[0] # '/') THEN⓪,MakeFullPath (path, ior);⓪,SearchFile (path, SrcPaths, fromStart, fok, s);⓪,IF NOT fok THEN⓪.notfound;⓪.RETURN FALSE⓪,END;⓪,ConcatPath (s, path, s);⓪,EXIT⓪*END⓪(END⓪&END⓪$ELSE⓪&(* Namen erfragen *)⓪&ConcatPath (SelectMask, NameConc ('*', ModSrcSfx), SelectMask);⓪&s[0]:= 0C;⓪&SelectFile ('Wähle Hauptmodul', s, fok);⓪&IF NOT fok THEN⓪(RETURN FALSE⓪&END⓪$END;⓪$IF NOT NameUnique (s) THEN⓪&SearchFirst (s, QueryFiles, ior);⓪&DoingSearch:= (ior >= 0);⓪&IF DoingSearch THEN⓪(SplitPath (s, SearchPath, dummy);⓪(getName⓪&ELSE⓪(notfound;⓪(RETURN FALSE⓪&END;⓪$END;⓪$RETURN TRUE⓪"END GetMainName;⓪ ⓪ ⓪ PROCEDURE GetFileName (ModName, Sfx: ARRAY OF CHAR; Paths: PathList;⓪7VAR FileName: ARRAY OF CHAR; VAR found, inlib: BOOLEAN);⓪"VAR entry: LibFiles.LibEntry;⓪"BEGIN⓪$Assign (ModName, FileName, ok);⓪$Delete (FileName, 8, 99, ok);⓪$Append ('.', FileName, ok);⓪$Append (Sfx, FileName, ok);⓪$IF LibOpened & StrEqual (Sfx, DefSfx) THEN⓪&LibFiles.LookUp (Lib, FileName, entry, res);⓪&inlib:= res>= 0;⓪&IF inlib THEN RETURN END⓪$END;⓪$SearchFile (FileName, Paths, fromStart, found, FileName);⓪"END GetFileName;⓪ ⓪ ⓪ PROCEDURE SyntaxError (REF msg, s: ARRAY OF CHAR);⓪"VAR errStr: ARRAY [0..250] OF CHAR; c: CHAR; but: CARDINAL;⓪"BEGIN⓪$errStr:= ' Syntaxfehler in Datei: | ';⓪$Append (currentFile, errStr, ok);⓪$CloseSrc;⓪$IF s[0] # 0C THEN⓪&Append ('| Zeile: ', errStr, ok);⓪&Append (CardToStr (currentLine,0), errStr, ok);⓪&Append (', Spalte: ', errStr, ok);⓪&Append (CardToStr (linePtr,0), errStr, ok);⓪$END;⓪$Append ('| ', errStr, ok);⓪$Append (msg, errStr, ok);⓪$IF s[0] # 0C THEN⓪&Append ('| >', errStr, ok);⓪&Append (s, errStr, ok);⓪$END;⓪$Insert ('[3][', 0, errStr, ok);⓪$Append ('][Weiter|Abbruch]', errStr, ok);⓪$FormAlert (1, errStr, but);⓪$IF but = 2 THEN Quit ('') END;⓪"END SyntaxError;⓪ ⓪ PROCEDURE ReadModName (VAR ModName: ModStr; VAR typ: ModTypes): BOOLEAN;⓪"VAR s: ModStr;⓪&id: Ident;⓪&errStr: String;⓪"BEGIN⓪$id:= GetNextTok (s);⓪$IF id = Definition THEN⓪&typ:= Def;⓪&id:= GetNextTok (s);⓪$ELSIF id = Implementation THEN⓪&typ:= Imp;⓪&id:= GetNextTok (s);⓪$ELSE⓪&typ:= Mod⓪$END;⓪$IF id # Module THEN⓪&SyntaxError ('Moduldeklaration erwartet', s);⓪&RETURN FALSE⓪$END;⓪$id:= GetNextTok (ModName);⓪$IF id # User THEN⓪&SyntaxError ('Modulname erwartet', s);⓪&RETURN FALSE⓪$END;⓪$(* Semikolon wird in 'ReadImports' überlesen *)⓪$RETURN TRUE⓪"END ReadModName;⓪ ⓪ PROCEDURE ReadImports (VAR importedMods: List);⓪ ⓪"VAR Tok, modName: ModStr;⓪&id: Ident;⓪&len: CARDINAL;⓪&firstImp: BOOLEAN;⓪ ⓪"CONST argOffset = 10; (* Spaces vor Import-Liste *)⓪ ⓪"PROCEDURE dropName (): BOOLEAN;⓪$BEGIN⓪&IF GetNextTok (modName) <> User THEN⓪(SyntaxError ('Modulname erwartet', modName);⓪(RETURN FALSE⓪&ELSE⓪(IF NOT InModList (modName, importedMods) THEN⓪*PutInModList (modName, importedMods);⓪*IF firstImp THEN⓪,WriteString (makef, ' -IMPORT');⓪,len:= argOffset;⓪,firstImp:= FALSE⓪*END;⓪*IF (len # argOffset) & (len + Length (modName) > 77) THEN⓪,WriteLn (makef);⓪,WriteString (makef, ' ');⓪,len:= argOffset;⓪*END;⓪*INC (len, Length (modName) + 1);⓪*Write (makef, ' ');⓪*WriteString (makef, modName);⓪(END;⓪(RETURN TRUE⓪&END;⓪$END dropName;⓪ ⓪"BEGIN⓪$id:= GetNextTok (Tok); (* Semikolon überlesen *)⓪$IF id = OpenBracket THEN (* es war ein '[' *)⓪&id:= GetNextTok (Tok); (* Priority überlesen *)⓪&IF id # Number THEN SyntaxError ('Zahl erwartet', Tok); RETURN END;⓪&id:= GetNextTok (Tok); (* Priority überlesen *)⓪&IF id # CloseBracket THEN SyntaxError ('"]" erwartet', Tok); RETURN END;⓪&id:= GetNextTok (Tok); (* Semikolon überlesen *)⓪$END;⓪$IF id # Semicolon THEN SyntaxError ('";" erwartet', Tok); RETURN END;⓪ ⓪$firstImp:= TRUE;⓪$LOOP⓪&id:= GetNextTok (Tok);⓪&IF id = Eof THEN SyntaxError ('Dateiende erreicht', Tok); EXIT END;⓪ ⓪&(* Dabei gefundene Import-Namen in die Liste 'importedMods' einfügen: *)⓪&(* & Import-Namen merken *)⓪&IF id = From THEN⓪(IF NOT dropName () THEN EXIT END;⓪(id:= GetNextTok (Tok); (* Den Identifier IMPORT lesen *)⓪(REPEAT⓪*id:= GetNextTok (Tok);⓪*IF id = Eof THEN SyntaxError ('Dateiende erreicht', Tok); EXIT END;⓪(UNTIL id = Semicolon⓪&ELSIF id = Import THEN⓪(LOOP⓪*IF NOT dropName () THEN EXIT END;⓪*id:= GetNextTok (Tok);⓪*IF id = Semicolon THEN⓪,EXIT⓪*ELSIF id # Comma THEN⓪,SyntaxError ('"," erwartet', Tok);⓪,EXIT⓪*END⓪(END;⓪&ELSE⓪(IF NOT (id IN ImportTerminators) THEN⓪*SyntaxError ('unbekanntes Schlüsselwort', Tok)⓪(END;⓪(EXIT⓪&END;⓪$END;⓪$IF NOT firstImp THEN⓪&WriteString (makef, ';');⓪&WriteLn (makef);⓪$END⓪"END ReadImports;⓪ ⓪ PROCEDURE ProcessModule (mainModName: ARRAY OF CHAR);⓪ ⓪"VAR⓪$importedMods: List;⓪$modName : ModStr;⓪$typ : ModTypes;⓪$fileName : String;⓪$ignore : BOOLEAN;⓪$upperMainName: ModStr;⓪ ⓪"PROCEDURE reportMissingSource (typ: ModTypes);⓪$BEGIN⓪&SourceNotFound:= TRUE;⓪&IF DoIO THEN⓪(IF typ = Def THEN⓪*InOut.WriteString ('Definitions-')⓪(ELSIF typ = Imp THEN⓪*InOut.WriteString ('Implementations-')⓪(END;⓪(InOut.WriteString ('Source zu ');⓪(InOut.WriteString (mainModName);⓪(InOut.WriteString (' fehlt.');⓪(InOut.WriteLn ();⓪&END⓪$END reportMissingSource;⓪ ⓪"BEGIN⓪$IF NOT Processed (mainModName) THEN⓪ ⓪&Assign (mainModName, upperMainName, ok);⓪&IF ignoreCase THEN Upper (upperMainName) END;⓪&⓪&WriteString (makef, mainModName);⓪&WriteLn (makef);⓪ ⓪&(* Das SYSTEM-Modul ignorieren! *)⓪&ignore:= StrEqual (SystemName, upperMainName);⓪ ⓪&(* DEF-Code finden und ggf. merken *)⓪&IF ~ignore THEN⓪(GetFileName (mainModName, DefSfx, DefPaths, fileName, ok, ignore)⓪&END;⓪ ⓪&(* Befindet sich das Modul in der DEF-Library, wird es ignoriert *)⓪&IF ignore THEN⓪(WriteString (makef, ' -IGNORE');⓪(WriteLn (makef);⓪&ELSE⓪ ⓪((*⓪*InOut.WriteString ('Import: ');⓪*InOut.WriteString (mainModName);⓪*InOut.WriteLn ();⓪(*)⓪ ⓪(WriteString (makef, ' -DEF ');⓪(WriteString (makef, fileName);⓪(WriteLn (makef);⓪ ⓪((* Liste f. importierte Module anlegen *)⓪(CreateList (importedMods, err);⓪(IF err THEN⓪*Quit (' Kann Liste >importedMods< | nicht anlegen!')⓪(END;⓪ ⓪((* DEF-Source finden und ggf. merken *)⓪(GetFileName (mainModName, DefSrcSfx, SrcPaths, fileName, ok, err);⓪(IF ok THEN⓪*WriteString (makef, ' -SOURCE ');⓪*WriteString (makef, fileName);⓪*WriteLn (makef);⓪ ⓪*(* Falls Source vorhanden, diesen scannen *)⓪*OpenSrc (fileName);⓪*IF ReadModName (modName, typ) THEN⓪,IF typ # Def THEN⓪.SyntaxError ('Def-Modul erwartet', '')⓪,ELSE⓪.IF ignoreCase THEN Upper (modName) END;⓪.IF NOT StrEqual (modName, upperMainName) THEN⓪0SyntaxError ('Falsches Modul! Erwartet:', mainModName)⓪.ELSE⓪0ReadImports (importedMods)⓪.END⓪,END⓪*END;⓪*CloseSrc;⓪(ELSE⓪*WriteString (makef, ' -NOSRC');⓪*WriteLn (makef);⓪*reportMissingSource (Def)⓪(END;⓪ ⓪((* IMP-Codes finden und ggf. merken *)⓪(WriteString (makef, ' -IMP ');⓪(GetFileName (mainModName, ImpSfx, ImpPaths, fileName, ok, err);⓪(WriteString (makef, fileName);⓪(WriteLn (makef);⓪ ⓪((* IMP-Source finden und ggf. merken *)⓪(GetFileName (mainModName, ImpSrcSfx, SrcPaths, fileName, ok, err);⓪(IF ok THEN⓪*WriteString (makef, ' -SOURCE ');⓪*WriteString (makef, fileName);⓪*WriteLn (makef);⓪ ⓪*(* Falls IMP-Source vorhanden, diesen scannen *)⓪*OpenSrc (fileName);⓪*IF ReadModName (modName, typ) THEN⓪,IF ignoreCase THEN Upper (modName) END;⓪,IF typ # Imp THEN⓪.SyntaxError ('Impl-Modul erwartet', '')⓪,ELSE⓪.IF ignoreCase THEN Upper (modName) END;⓪.IF NOT StrEqual (modName, upperMainName) THEN⓪0SyntaxError ('Falsches Modul! Erwartet:', mainModName)⓪.ELSE⓪0ReadImports (importedMods)⓪.END⓪,END⓪*END;⓪*CloseSrc;⓪(ELSE⓪*WriteString (makef, ' -NOSRC');⓪*WriteLn (makef);⓪*reportMissingSource (Imp)⓪(END;⓪ ⓪((* Nun die importierten Moduln bearbeiten *)⓪(WHILE GetFromModList (modName, importedMods) DO⓪*ProcessModule (modName);⓪(END;⓪ ⓪(DeleteList (importedMods, ok)⓪&END⓪$END⓪"END ProcessModule;⓪ ⓪ ⓪ PROCEDURE ProcessMainSource (mainSourceName: ARRAY OF CHAR;⓪=first: BOOLEAN);⓪ ⓪"VAR⓪$importedMods : List;⓪$modName : ModStr;⓪$fileName : String;⓪$typ : ModTypes;⓪ ⓪"BEGIN⓪ ⓪$(* Liste f. importierte Module anlegen *)⓪$CreateList (importedMods, err);⓪$IF err THEN⓪&Quit (' Kann Liste >ImportedMods< | nicht anlegen!| (Speichermangel) ')⓪$END;⓪$⓪$OpenSrc (mainSourceName);⓪$IF ReadModName (modName, typ) THEN⓪&IF typ = Mod THEN⓪(IF NOT Processed (modName) THEN⓪*IF DoIO THEN⓪,InOut.WriteString ('Main: ');⓪,InOut.WriteString (modName);⓪,InOut.WriteLn ();⓪*END;⓪*WriteString (makef, modName);⓪*WriteLn (makef);⓪*WriteString (makef, ' -MAIN');⓪*WriteLn (makef);⓪*IF typ = Mod THEN⓪,WriteString (makef, ' -MOD ');⓪,GetFileName (modName, ModSfx, ModPaths, fileName, ok, err);⓪*(*⓪*ELSE⓪,WriteString (makef, ' -IMPMOD ');⓪,GetFileName (modName, ImpSfx, ImpPaths, fileName, ok, err);⓪**)⓪*END;⓪*WriteString (makef, fileName);⓪*WriteLn (makef);⓪*WriteString (makef, ' -SOURCE ');⓪*WriteString (makef, mainSourceName);⓪*WriteLn (makef);⓪*(* Source scannen *)⓪*ReadImports (importedMods);⓪(END;⓪&ELSE⓪((*⓪)* Imp/Def-Module werden wie importierte Module behandelt⓪)*)⓪(PutInModList (modName, importedMods);⓪&END;⓪$END;⓪$CloseSrc;⓪$⓪$(* Nun die importierten Module bearbeiten *)⓪$WHILE GetFromModList (modName, importedMods) DO⓪&ProcessModule (modName);⓪$END;⓪"⓪$DeleteList (importedMods, ok);⓪"END ProcessMainSource;⓪ ⓪ ⓪ PROCEDURE GetOptions;⓪"VAR argn: CARDINAL; s: String;⓪"BEGIN⓪$argn:= 1;⓪$WHILE argn < argc DO⓪&Assign (argv[argn]^, s, ok);⓪&INC (argn);⓪&IF (s[0] = '-') OR (s[0] = '/') THEN⓪(IF CAP (s[1]) = 'C' THEN⓪*WaitAtEnd:= FALSE⓪(ELSIF CAP (s[1]) = 'Q' THEN⓪*DoIO:= FALSE⓪(END⓪&END⓪$END⓪"END GetOptions;⓪ ⓪ ⓪ VAR⓪$DevHdl : DeviceHandle;⓪$GemHdl : GemHandle;⓪$first : BOOLEAN;⓪$int : INTEGER;⓪$c : CHAR;⓪$fn,⓪$modName : String;⓪ ⓪ BEGIN⓪"InitGem (RC, DevHdl, ok);⓪"IF ~ ok THEN HALT END;⓪"GemHdl:= CurrGemHandle ();⓪ ⓪"HomePath:= ShellPath;⓪"⓪"InitArgCV (argc, argv);⓪"argn:= 1;⓪"DoingSearch:= FALSE;⓪"WaitAtEnd:= TRUE;⓪"DoIO:= TRUE;⓪"SourceNotFound:= FALSE;⓪"first:= TRUE;⓪"ignoreCase:= TRUE;⓪"⓪"GetOptions;⓪"⓪ (*⓪"Comp[1]:= 'TYPE';⓪"Comp[2]:= 'CONST';⓪"Comp[3]:= 'VAR';⓪"Comp[4]:= 'PROCEDURE';⓪"Comp[5]:= 'BEGIN';⓪"Comp[6]:= 'END';⓪"From := 'FROM';⓪"Import := 'IMPORT';⓪"Module := 'MODULE';⓪"Implem := 'IMPLEMENTATION';⓪ *)⓪ ⓪"SystemName:= 'SYSTEM';⓪ ⓪"IF DoIO THEN⓪$InOut.WriteLn ();⓪$InOut.WriteString (' ModRef V1.4 für Megamax Modula-2');⓪$InOut.WriteLn ();⓪$InOut.WriteString (' Erstellt 7/1989 von Christian Drießle & Thomas Tempelmann');⓪$InOut.WriteLn ();⓪$InOut.WriteLn ();⓪"END;⓪ ⓪"makef:= File (NIL);⓪ ⓪"LibFiles.OpenLib (Lib, HomeReplaced (DefLibName), res);⓪"LibOpened:= res >= 0;⓪"⓪"WHILE GetMainName (modName) DO⓪$IF first THEN⓪&ConcatName (modName, 'M2M', fn);⓪&MakeFullPath (fn, int);⓪&Create (makef, fn, writeSeqTxt, replaceOld);⓪&IF DoIO THEN⓪(InOut.WriteString ('Erzeuge ');⓪(InOut.WriteString (fn);⓪(InOut.WriteLn ();⓪&END⓪$END;⓪$ProcessMainSource (modName, first);⓪$first:= FALSE;⓪"END;⓪ ⓪"IF DoIO & SourceNotFound THEN⓪$InOut.WriteString ('Die fehlenden Sources werden vom Make-Programm ignoriert!');⓪$IF WaitAtEnd THEN⓪&InOut.WriteLn;⓪&InOut.WriteString ('Taste...');⓪&InOut.FlushKbd ();⓪&InOut.Read (c)⓪$END⓪"END;⓪ ⓪"LibFiles.CloseLib (Lib);⓪"Close (makef);⓪"ExitGem (GemHdl);⓪ END ModRef.⓪ ə (* $FFEE9443$FFF029D2$FFF029D2$FFF029D2$FFF029D2$FFF029D2$FFF029D2$FFF029D2$FFF029D2$FFF029D2$FFF029D2$FFF029D2$FFF029D2$FFF029D2$FFF029D2$FFEC50C9$FFF029D2$FFF029D2$FFF029D2$FFF029D2$FFF029D2$FFEEF582$FFF029D2$FFF029D2$FFF029D2$00001C6E$FFF029D2$FFF029D2$FFF029D2$FFF029D2$FFF029D2$FFF029D2$FFF029D2$FFF029D2$FFF029D2$00002EFA$FFF029D2$FFF029D2$FFF029D2$FFF029D2$FFF029D2$FFF029D2Ç$0000653AT.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$00006343$FFED074A$00006358$0000631B$000064DE$0000653A$0000652F$FFED074A$FFED074A$FFED074A$00003F5D$00006382$000062DD$000062ED$0000633A$00006331£Çé*)