(***************************************) (* (c) Copyright 1987 by Jens Kalski *) (***************************************) (* Programm : FORMPAS *) (* Version : 2.0 (20.02.1988) *) (* Sprache : TURBO-PASCAL 3.0 *) (* Programmiert auf : Schneider CPC464 *) (* Betriebssystem : CP/M 2.2 *) (***************************************) (*$U-,C-*) PROGRAM FORMPAS; TYPE Kommando = STRING(.10.); FileName = STRING(.14.); Line = STRING(.128.); CONST Neu : ARRAY(.1..163.) OF Kommando = ('Abs', 'ABSOLUTE', 'Addr', 'AND', 'ArcTan', 'ARRAY', 'Assign', 'AUX', 'AuxInPtr', 'AuxOutPtr', 'BDOS', 'BDOSHL', 'BEGIN', 'BIOS', 'BIOSHL', 'BlockRead', 'BlockWrite', 'BOOLEAN', 'BUFLEN', 'BYTE', 'CASE', 'CBREAK', 'Chain', 'CHAR', 'Chr', 'Close', 'ClrEol', 'ClrScr', 'CON', 'Concat', 'ConInPtr', 'ConOutPtr', 'CONST', 'ConStPtr', 'Copy', 'Cos', 'CrtExit', 'CrtInit', 'Delay', 'Delete', 'DelLine', 'Dispose', 'DIV', 'DO', 'DOWNTO', 'ELSE', 'END', 'EoF', 'EoLn', 'Erase', 'ErrorPtr', 'Execute', 'EXIT', 'Exp', 'EXTERNAL', 'FALSE', 'FILE', 'FilePos', 'FileSize', 'FillChar', 'Flush', 'FOR', 'FORWARD', 'Frac', 'FreeMem', 'FUNCTION', 'GetMem', 'GOTO', 'GotoXY', 'HALT', 'HeapPtr', 'Hi', 'HighVideo', 'IF', 'IN', 'INLINE', 'INPUT', 'Insert', 'InsLine', 'Int', 'INTEGER', 'IOResult', 'KBD', 'KeyPressed', 'LABEL', 'Length', 'Ln', 'Lo', 'LowVideo', 'LST', 'LstOutPtr', 'Mark', 'MaxAvail', 'MaxInt', 'MEM', 'MemAvail', 'MOD', 'Move', 'New', 'NIL', 'NormVideo', 'NOT', 'Odd', 'OF', 'OR', 'Ord', 'OUTPUT', 'OVERLAY', 'PACKED', 'ParamCount', 'ParamStr', 'PI', 'Port', 'Pos', 'Pred', 'PROCEDURE', 'PROGRAM', 'Ptr', 'Random', 'Randomize', 'Read', 'ReadLn', 'REAL', 'RECORD', 'Release', 'ReName', 'REPEAT', 'Reset', 'ReWrite', 'Round', 'Seek', 'SeekEoF', 'SeekEoLn', 'SET', 'SHL', 'SHR', 'Sin', 'SizeOf', 'Sqr', 'Sqrt', 'Str', 'STRING', 'Succ', 'Swap', 'TEXT', 'THEN', 'TO', 'TRM', 'TRUE', 'Trunc', 'TYPE', 'UNTIL', 'UpCase', 'USR', 'UsrInPtr', 'UsrOutPtr', 'Val', 'VAR', 'WHILE', 'WITH', 'Write', 'WriteLn', 'XOR'); VAR stringflag, kommentarflag : BOOLEAN; i,Zaehler : INTEGER; InZeile : Line; InFileName, Outfilename : FileName; InFile, OutFile : TEXT; PROCEDURE Forme(VAR InZeile:Line); VAR exflag : BOOLEAN; Laenge : BYTE ABSOLUTE InZeile; i,it : INTEGER; c1,c2 : CHAR; a : Line; PROCEDURE Wandel(Zeile:Line); FUNCTION Turbo_Wort(Zeile:Line):INTEGER; CONST Turbo : ARRAY(.1..163.) OF Kommando = ('ABS', 'ABSOLUTE', 'ADDR', 'AND', 'ARCTAN', 'ARRAY', 'ASSIGN', 'AUX', 'AUXINPTR', 'AUXOUTPTR', 'BDOS', 'BDOSHL', 'BEGIN', 'BIOS', 'BIOSHL', 'BLOCKREAD', 'BLOCKWRITE', 'BOOLEAN', 'BUFLEN', 'BYTE', 'CASE', 'CBREAK', 'CHAIN', 'CHAR', 'CHR', 'CLOSE', 'CLREOL', 'CLRSCR', 'CON', 'CONCAT', 'CONINPTR', 'CONOUTPTR', 'CONST', 'CONSTPTR', 'COPY', 'COS', 'CRTEXIT', 'CRTINIT', 'DELAY', 'DELETE', 'DELLINE', 'DISPOSE', 'DIV', 'DO', 'DOWNTO', 'ELSE', 'END', 'EOF', 'EOLN', 'ERASE', 'ERRORPTR', 'EXECUTE', 'EXIT', 'EXP', 'EXTERNAL', 'FALSE', 'FILE', 'FILEPOS', 'FILESIZE', 'FILLCHAR', 'FLUSH', 'FOR', 'FORWARD', 'FRAC', 'FREEMEM', 'FUNCTION', 'GETMEM', 'GOTO', 'GOTOXY', 'HALT', 'HEAPPTR', 'HI', 'HIGHVIDEO', 'IF', 'IN', 'INLINE', 'INPUT', 'INSERT', 'INSLINE', 'INT', 'INTEGER', 'IORESULT', 'KBD', 'KEYPRESSED', 'LABEL', 'LENGTH', 'LN', 'LO', 'LOWVIDEO', 'LST', 'LSTOUTPTR', 'MARK', 'MAXAVAIL', 'MAXINT', 'MEM', 'MEMAVAIL', 'MOD', 'MOVE', 'NEW', 'NIL', 'NORMVIDEO', 'NOT', 'ODD', 'OF', 'OR', 'ORD', 'OUTPUT', 'OVERLAY', 'PACKED', 'PARAMCOUNT', 'PARAMSTR', 'PI', 'PORT', 'POS', 'PRED', 'PROCEDURE', 'PROGRAM', 'PTR', 'RANDOM', 'RANDOMIZE', 'READ', 'READLN', 'REAL', 'RECORD', 'RELEASE', 'RENAME', 'REPEAT', 'RESET', 'REWRITE', 'ROUND', 'SEEK', 'SEEKEOF', 'SEEKEOLN', 'SET', 'SHL', 'SHR', 'SIN', 'SIZEOF', 'SQR', 'SQRT', 'STR', 'STRING', 'SUCC', 'SWAP', 'TEXT', 'THEN', 'TO', 'TRM', 'TRUE', 'TRUNC', 'TYPE', 'UNTIL', 'UPCASE', 'USR', 'USRINPTR', 'USROUTPTR', 'VAL', 'VAR', 'WHILE', 'WITH', 'WRITE', 'WRITELN', 'XOR'); VAR Laenge : BYTE ABSOLUTE Zeile; i,j,m : INTEGER; BEGIN Turbo_Wort:=0; CASE Laenge OF 2..10 : BEGIN FOR i:=1 TO Laenge DO Zeile(.i.):=UpCase(Zeile(.i.)); i:=1; j:=163; REPEAT m:=(i+j) SHR 1; IF Zeile<=Turbo(.m.) THEN j:=m ELSE i:=Succ(m); UNTIL i=j; IF Turbo(.i.)=Zeile THEN Turbo_Wort:=i; END; END; END; BEGIN IF a<>'' THEN IF NOT KommentarFlag AND NOT StringFlag THEN BEGIN it:=Turbo_Wort(a); IF it > 0 THEN Write(OutFile,Neu(.it.)) ELSE Write(OutFile,a); END ELSE Write(OutFile,a); END; BEGIN a:=''; i:=1; WHILE i<=Laenge DO BEGIN CASE InZeile(.i.) OF 'A'..'Z','a'..'z' : BEGIN a:=InZeile(.i.); exflag:=FALSE; i:=Succ(i); WHILE (NOT exflag) AND (i <= Laenge) DO CASE InZeile(.i.) OF '0'..'9','A'..'Z','_','a'..'z' : BEGIN a:=a+InZeile(.i.); i:=Succ(i); END; ELSE exflag:=TRUE; END; END ELSE (* case *) Wandel(a); a:=''; Write(OutFile,InZeile(.i.)); c1:=InZeile(.i.); c2:=InZeile(.Succ(i).); IF (NOT stringflag) AND ((c1='{') OR ((c1='(') AND (c2='*'))) THEN kommentarflag:=TRUE; IF (NOT stringflag) AND ((c1='}') OR ((c1='*') AND (c2=')'))) THEN kommentarflag:=FALSE; StringFlag:=StringFlag XOR (NOT (kommentarflag) AND (c1=#39)); i:=Succ(i); END; END; IF a<>'' THEN Wandel(a); WriteLn(OutFile); stringflag:=FALSE; END; BEGIN stringflag:=FALSE; kommentarflag:=FALSE; CrtInit; ClrScr; WriteLn('FORMPAS 2.0 (20.02.1988)'); WriteLn; IF ParamCount=1 THEN BEGIN InFileName:=ParamStr(1); OutFileName:=InFileName; i:=Pos('.',OutFileName); IF i <> 0 THEN OutFileName:=Copy(OutFileName,1,Pred(i)); OutFileName:=OutFileName; WriteLn('Ich bearbeite ',InFileName); Assign(InFile,InFileName); (*$I-*) Reset(InFile); (*$I+*) IF IOResult = 0 THEN BEGIN Assign(OutFile,OutFileName+'$$$'); (*$I-*) ReWrite(OutFile); (*$I+*) IF IOResult = 0 THEN BEGIN Zaehler:=0; WriteLn; Write(' Zeilen bearbeitet'); WHILE NOT (EoF(InFile)) DO BEGIN ReadLn(InFile,InZeile); Zaehler:=Succ(Zaehler); Write(#13,Zaehler:4); Forme(InZeile); END; WriteLn; Close(InFile); ReName(InFile,OutFileName+'.BAK'); Close(OutFile); ReName(OutFile,InFileName); END ELSE BEGIN Close(InFile); WriteLn; LowVideo; Write(' FEHLER : '); NormVideo; WriteLn(OutFileName,'.$$$ kann nicht geoeffnet werden !'); END; END ELSE BEGIN WriteLn; LowVideo; Write(' FEHLER : '); NormVideo; WriteLn(InFileName,' nicht gefunden !'); END; END ELSE BEGIN WriteLn('Bitte rufen Sie das Programm folgenderma~en auf :'); WriteLn; WriteLn('FORMPAS BEISPIEL.PAS'); WriteLn; LowVideo; WriteLn(' Die Eingabedatei heisst BEISPIEL.BAK '); WriteLn(' Die Ausgabedatei heisst BEISPIEL.PAS '); NormVideo; END; END. (* -------------------------- Programmende -------------------------- *)