program ENT(input,output); (* Wandeln von SOL-ENT-Dateien vom ASCII-Format in eine .COM-Datei Format der ENT Datei: Erste Zeile : 'ENTER 0000' Datenzeilen : '0000: 00 00 00 00 C3 5A 06 19 D2 20 45 20 D6 20 45 20' Letzte Zeile: '0DD0: 00 00/' Geschrieben fuer CP/M-80 TURBO-PASCAL 3.x Werner Cirsovius, Dezember 2002 Ergaenzung September 2004 Wegen abweichender Zeilen: Erste Zeile : 'EN XXXX' ++++ Die Adresse XXXX kann aus 1 bis 4 Ziffern bestehen. Letzte Zeile: '0DD0: 00 00 /' ++++ Vor dem Endzeichen '/' kann ein Leerzeichen stehen. *) const ENT1 = 'ENTER '; ENT2 = 'EN '; EOFCHR = $1A; HEXLEN = 4; RECLEN = 128; type HexString = string[HEXLEN]; FSTR = string[ 20]; LSTR = string[255]; var FINAME : FSTR; Fi : text; Fo : file; Optr : byte; Obuff : array[1..RECLEN] of byte; LINE : LSTR; StrAdr, EndAdr, EntAdr : integer; EndCode : boolean; procedure ABORT(MSG:LSTR); (* Ausgabe einer Fehlermeldung und Abbruch *) Begin writeln(MSG); halt; End; procedure GetFileName; (* Eingabe des Namens der Quelldatei *) var i : integer; Begin repeat write('Dateiname [.ENT] '); readln(FINAME); until (length(FINAME)>0); for i:=1 to length(FINAME) do FINAME[i]:=upcase(FINAME[i]); End; procedure OpenFiles; (* Oeffnen der benoetigten Dateien *) var p : integer; Begin p:=pos('.',FINAME); if (p=0) then FINAME:=FINAME+'.ENT'; assign(Fi,FINAME); {$I-}reset(Fi);{$I+} if (IOResult<>0) then ABORT('Kann Datei '+FINAME+' nicht oeffnen'); p:=pos('.',FINAME); FINAME:=copy(FINAME,1,p-1)+'.COM'; assign(Fo,FINAME); {$I-}rewrite(Fo);{$I+} if (IOResult<>0) then ABORT('Kann Datei '+FINAME+' nicht anlegen'); Optr:=0; EndCode:=FALSE; End; function GetHex(L:LSTR; dig:integer):integer; (* Wandeln einer Zeichenkette in Hex-Wert *) var i,x,ch : integer; Begin x:=0; for i:=1 to dig do begin if (L[i] in ['0'..'9','A'..'F']) then begin ch:=ord(L[i])-ord('0'); if (ch>9) then ch:=ch-(ord('A')-ord('0')-10); x:=x*16+ch; end else ABORT('Ungueltiges Hex-Zeichen: '+L[i]); end; GetHex:=x; End; procedure LineRead; (* Zeile einlesen, Leerzeilen ignorieren *) Begin repeat readln(Fi,LINE); until (length(LINE)<>0); End; procedure Sync; (* Suche nach Start der ENT-DAtei *) var len : integer; Begin LineRead; if (pos(ENT1,LINE)=0) then begin if (pos(ENT2,LINE)=0) then begin writeln('Ungueltige erste Zeile (',LINE,')'); writeln('- Erwartet: "',ENT1,'(xxx)x"'); writeln(' oder: "',ENT2,'(xxx)x"'); halt; end else len:=length(ENT2); end else len:=length(ENT1); delete(LINE,1,len); len:=length(LINE); if (len>HEXLEN) then ABORT('Start-Adresse "'+LINE+'" zu lang (In Zeile 1)'); EntAdr:=GetHex(LINE,len); StrAdr:=EntAdr; EndAdr:=EntAdr; End; procedure FPUT(b:byte); (* Byte in COM-Datei schreiben *) Begin EndAdr:=EndAdr+1; Optr:=Optr+1; Obuff[Optr]:=b; if (Optr=RECLEN) then begin blockwrite(Fo,Obuff,1); for Optr:=1 to RECLEN do Obuff[Optr]:=EOFCHR; Optr:=0; end; End; procedure CloseFiles; (* Dateien schliessen *) Begin if (Optr<>0) then blockwrite(Fo,Obuff,1); close(Fo); close(Fi); End; function Hex(Number: integer):HexString; (* Ganze Zahl nach Hex wandeln *) const HexDigit:array[0..15]of char='0123456789ABCDEF'; var N : integer; IntStr : HexString; Begin IntStr:='0000'; for N:=HEXLEN downto 1 do begin IntStr[N]:=HexDigit[Number and $0F]; Number:=Number shr 4; end; Hex:=IntStr; End; procedure ProcLine; (* ASCII-Zeile bearbeiten *) var LinAdr,i : integer; AscHex : LSTR; BytHex : byte; Begin LineRead; LinAdr:=GetHex(LINE,4); if (LinAdr<>EntAdr) then ABORT('Ungueltige Start-Adresse: '+Hex(LinAdr)+'H - erwartet: '+Hex(EntAdr)+'H'); EntAdr:=EntAdr+16; if (LINE[5]<>':') then ABORT('":" fehlt in Zeile: '+LINE); i:=1; repeat AscHex:=copy(LINE,3*(i+1),3); EndCode:=((AscHex[1]='/') or ((AscHex[2]='/'))); if not EndCode then begin if AscHex[1]<>' ' then ABORT('Leerzeichen an erster Stelle erwartet in: '+AscHex); Delete(AscHex,1,1); BytHex:=GetHex(AscHex,2); FPUT(BytHex); i:=i+1; end; until (i=17) or EndCode; End; BEGIN (* Hauptprogramm *) GetFileName; OpenFiles; Sync; repeat ProcLine until EndCode; CloseFiles; writeln('Datei ',FINAME,' beschrieben von ',HEX(StrAdr),'H-',HEX(EndAdr-1),'H'); END.