Mehr TURBO-Kompatibilität für MAXON-PASCAL

Eine Unit, in der zusätzliche Befehle für MAXONPASCAL bereitgestellt werden, erhöht die Kompatibilität zu TURBO ganz erheblich. Und auch auf das Utility BINOBJ muß man unter TOS nun nicht mehr verzichten.

Mit der Version 1.5 hat MAXON-Pascal ein beachtliches Maß an TURBO-Kompatibilität erreicht. Dennoch ist man vor einigen Enttäuschungen nicht gefeit, wenn man Quellen vom IBM-PC ohne Änderungen auf dem Atari übersetzen will: so moniert vielleicht der Compiler daß er die Befehle Sound() und NoSound nicht kennt, und Systemaufrufe über Intr() sind ihm natürlich auch fremd. Bleiben einem solche Fehlermeldungen erspart, gibt es dafür u.U. beim Programmlauf einige Überraschungen: daß anstatt der Blockgrafiksymbole hebräische Buchstaben erscheinen, hatte man ja noch erwartet, schwerwiegender ist dagegen, daß auf Funktionstasten nicht reagiert wird und beispielsweise der Programmabbruch über Alt-X auch nicht funktioniert. Alle diese Macken lassen sich relativ einfach mittels einer geeigneten Unit beheben, wie im folgenden gezeigt werden soll. Dabei wurden die Prozeduren weitestgehend in Assembler geschrieben, um einen kompakten und vor allem schnellen Code zu erhalten. Zusätzlich zur Kompatibilitäts-Unit wurde das unter MS-DOS bekannte und geschätzte Utility BINOBJ nachempfunden.

Tasten und Töne

In TURBO-Pascal liefert ReadKey beim Drücken von Sondertasten erst einmal chr(0) und beim nächsten Aufruf den Scancode der Taste zurück, in MAXON-Pascal beschränkt sich die Funktion in diesem Falle auf ersteres. Da die Tastatur-Scancodes des Atari weitgehend mit denen des PC übereinstimmen, ist es kein Problem, ein ReadKey zu schreiben, das sich 100%ig turbolike verhält. Mit diesen Eigenschaften ist die neue Funktion sicher nicht nur für die Umsetzung von TURBO-Quellen interessant, da nun Funktionstasten abgefragt werden können, ohne auf Systemaufrufe zurückgreifen zu müssen.

Nächstes Manko sind die fehlenden Prozeduren Sound() und NoSound, die ebenfalls problemlos auf dem Atari implementiert werden können. Die bescheidenen Möglichkeiten des PC zur Tonerzeugung emuliert der Soundchip spielend, wenn man ihm die Parameter ein wenig aufbereitet.

DOS-Interrupts

Sicher ist es nicht sinnvoll, alle DOS-lnterrupts, die möglicherweise einmal in einem Programm benutzt werden könnten, zu emulieren, auf einige wird jedoch besonders häufig zurückgegriffen, so daß eine Nachbildung nützlich erscheint. Je nach Bedarf läßt sich die Unit an dieser Stelle problemlos um weitere Funktionen erweitern.

Der wohl am häufigsten in TURBO-Pascal benutzte Interrupt ist Nr. 5 - die Bildschirm-Hardcopy. Diese Funktion wird auf dem Atari am sichersten realisiert, indem man die Systemvariable _prt_cnt ($4ee, word) auf 0 setzt. Eine andere Möglichkeit wäre der Aufruf der Funktion scrdmp in der Unit BIOS, die jedoch mit einigen nachladbaren Hardcopy-Routinen nicht ganz zurechtzukommen scheint (oder umgekehrt). Damit bietet sich die hier gezeigte Lösung allgemein als Alternative zu dieser Funktion an.

Ebenfalls recht häufig genutzt wird die DOS-Funktion zur Cursor-Konfiguration, meistens um ihn aus- oder einzuschalten. Da sich die Konfigurationsmöglichkeiten auf PC und Atari beträchtlich unterscheiden, wurde nur das Aus-und Einschalten emuliert. Schließlich wurde noch die Abfrage des Umschaltstatus’ der Tastatur mit aufgenommen, allerdings sind hier einige Unterschiede in der Bedeutung der einzelnen Bits zu beachten:

Blockgrafik inklusive

Um die Kompatibilität auch auf solche mehr ästhetischen Aspekte wie die Verfügbarkeit der Blockgrafik auszudehnen, wurde nach einer Möglichkeit gesucht, unabhängig vom eingebauten System-Font zur Programmlaufzeit den vollen IBM-Zeichensatz zur Verfügung zu haben. Das Problem dabei war, daß die Zeichensatzdaten möglichst mit in den Programmcode gelinkt werden sollten, also als Objekt-File vorliegen mußten. Den entsprechenden Zeiger dann auf diese Daten und bei Programmende wieder auf den System-Font zu setzen war demgegenüber eine leichte Übung.

Die Zeichensatzdaten (ohne Fontheader) lagen als Binär-File vor, das für den Linker in ein Objekt-File umgewandelt werden mußte. In TURBO-Pascal gibt es für solche Fälle das Utility BINOBJ. Mit Kenntnis des DR-Objektformats für den Atari ist es nicht allzu schwer, ein analoges Programm zu schreiben. Allerdings ist bei MAXON-Pascal eine Besonderheit zu beachten: da es kein Data-Segment gibt, müssen die Daten im Textsegment abgelegt werden. Da bei MAXON-Pascal ein Codesegment maximal 32K groß sein darf, wird die Konvertierung größerer Binär-Files von vornherein abgewiesen.

Nach der Konvertierung wird man feststellen, daß das Objekt-File nahezu doppelt so groß ist wie das ursprüngliche Binär-File. Flier handelt es sich nicht um einen Fehler in BINO, sondern die Ursache liegt im Aufbau des DR-Objektformats, genauer der sogenannten Fixuptable, die für die Relozierbarkeit der Programme notwendig ist. Obwohl in unserem Falle diese Tabelle aus lauter Nullen besteht, besteht der Linker auf ihrem Vorhandensein in voller Länge (= Länge der Binärdaten).

Die Quelltexte von TPASCAL und BINO können gleichermaßen mit den Versionen 1.1 und 1.5 von MAXON-Pascal, BINO zusätzlich auch mit TURBO-Pascal compiliert werden.

Literatur:

[1] Christoph Conrad, Resource-Einhindung in C, ST-Computer 1/1991

program bino;
{ Binär-Files in DR-Objekt-Format wandeln }
{ Daten werden für MAXON-PASCAL-Linker im Text- }
{ segment abgelegt. j
{ Aufruf: }
{ BXNO <src[.BIN]> [<dest[.0]> [<name>]] [/H] }
{ wird nur «•source. [BIN] > angegeben, sind Wild- }
{ cards möglich }
{ Option </H> für Halten des Bildschirms bis }
{ Tastendruck }

{ W. Schneider, Berlin 12/1991 }
{ (c) 1992 MAXON Computer }

{$R-,I-,D- , F+} 
uses crt,dos;

var mkres       :longint;
    bnnm,obnm   :pathstr;
    tmpdr       :dirstr;
    tmpnm       :namestr;
    tmpex       :extstr;
    lbnm        :string;
    nms,flcnt   :integer;
    hldscr      :boolean;
    bnrec       :searchrec;

{*** Erzeugen des Objekt-Files ***} 
function makeobj (binfl,objfl :pathstr;
                  labname :string):longint; 
var infl,outfl  :file;
    binsz       :longint;
    binbf       :pointer;
    blkres,i    :integer;
    outbt       :shortint;

{$IFNDEF ATARI)
{* TURBO-PASCAL kennt kein Hi-/LowWord() *}
function hiword(lv :longint):word;
begin
    hiword:=lv shr 16; 
end;
function lowordtlv :longint):word; 
begin
    loword:=lv and $ffff; 
end;
{$ENDIF)
procedure wrlong(outvl :longint); 
begin
    outbt:=hi(hiword(outvl)); 
    blockwrite(outfl,outbt,1,blkres); 
    outbt:=lo(hiword(outvl));
    blockwrite(outfl,outbt,1,blkres); 
    outbt:=hi(loword(outvl)); 
    blockwrite(outfl,outbt,1,blkres); 
    outbt:=lo(loword(outvl)); 
    blockwrite(outf1,outbt,1,blkres); 
end;

procedure wrword(outvl :longint); begin
    outbt:=hi(loword(outvl)); 
    blockwrite(outfl,outbt,1,blkres); 
    outbt:=lo(loword(outvl)); 
    blockwrite(outfl,outbt,1,blkres); 
end;

begin
    {$IFDEF ATARI)
        reset(infl,binfl);
    {$ELSE)
        assign(infl,binfl); 
        reset(infl,1);
    {$ENDIF)
    if ioresult<>0 then
        begin makeobj :=-1; exit; end; 
    binsz:=filesize(infl); 
    if binsz>$7fff then 
    begin
        close(infl); 
        makeobj:=-4; 
        exit; 
    end;
    if maxavail<binsz then
        begin makeobj:=-3; exit; end; 
    getmem(binbf,binsz);
    blockread(infl,binbf^,binsz,blkres); 
    close(infl);
    {$IFDEF ATARI) 
        erase(objfl); 
        rewrite(outfl,objfl);
    {$ELSE}
        assign(outfl,objfl); 
        rewrite(outfl,1);
    {$ENDTF}
    if ioresult<>0 then
        begin makeobj:=-2; exit; end; 
    wrword($601a);                      { Magic $601A }
    wrlong{binsz);                      { TEXT-Size }
    wrlong(0);                          { DATA-Size }
    wrlong(0);                          { BSS-Size )
    wrlong(14);                         { Symtablesize }
    for i:=1 to 5 do wrword(0);         { reserved }
    blockwrite(outfl,binbf^,binsz,blkres);{ TEXT } 
    for i:=1 to 8 do                    { Symboltable: }
    begin                               { ..Name }
        if i<=length(labname) then
            outbt:=ord(upcase(labname[i])) 
        else
            outbt:=0; 
        blockwrite(outfl,outbt,1,blkres); 
    end;
    wrword($a200);                      { ..Typ }
    wrlong(0);                          { ..Offset }
    { Fixuptable (lauter Nullen) schreiben }
    {$IFDEF ATARI)}
        asm
                 move.l binsz,d0 
                 move.l binbf,a0 
            @ll: clr.b (a0)+
                 dbra d0,@ll
        end;
        blockwrite(outfl,binbf^,binsz,blkres);
    {$ELSE}
        outbt:=0;
        for i:=1 to binsz do 
        blockwrite(outfl,outbt,1,blkres);
    {$ENDIF}
    freemem(binbf,binsz); 
    close (outfl); 
    if ioresult<> then 
        makeobj:=-5 
    else
        makeobj:=binsz; 
end;{makeobj)

{*** Extension ggf. an Namen anhängen ***} 
procedure extend(var expth:pathstr; extl;extstr); 
var exnm        :namestr;
    exdr        :dirstr;
    exex        :extstr;
begin
    fsplit(expth,exdr,exnm,exex); 
    if (exex='') or (exex='.') then 
        expth:=exdr+exnm+extl;
end;

{*** String in Großbuchst. wandeln ***} 
function upstr(lwstr :string):string; 
var i :integer;
    s :string; 
begin 
    s:='';
    for i:=1 to length(lwstr) do 
        s:=s+upcase(lwstr[i]); 
    upstr:=s; 
end;

{*** ein File behandeln ***}
procedure processfile; 
begin
    extend(bnnm,'.BIN'); 
    extend(obnm,'.O'); 
    writeln('converting : ',bnnm); 
    writeln('to         : ',obnm);
    writeln('public name: ',lbnm); 
    mkres :=makeobj(bnnm,obnm,lbnm); 
    if mkres>=0 then 
    begin
        writeln(mkres,' bytes converted'); 
        inc(flcnt); 
    end 
    else
        case mkres of
            -1: writeln('Can''t open infile !');
            -2: writeln('Can''t create outfile !');
            -3: writeln('Not enough memory !');
            -4: writeln('Infile too large !');
            -5: writeln('Can''t close outfile !'); 
        end; 
    writeln;
end;

{**** HauptProgramm ****}

begin
    nms:=parameount; 
    flcnt:=0;
    hldscr:=upstr(paramstr(nms))='/H';
    if hldscr then
    begin
        dec(nms); 
        clrscr; 
    end;
    writeln;
    write('BIN to O Convexter for MAXON-PASCAL '); 
    writeln('Version 1.0 W. Schneider, Berlin 12/1991'); 
    case nms of 
        0: begin
            write('Usage: BINO[.TTP] <src[.BIN]>[<de3t[.0]>'); 
            writeln(' [<public name>]] [/H]'); 
            writeln('Press any key');
            repeat until readkey<>#0; 
            writeln; 
            halt; 
        end;
        1: begin
            bnnm:=upstr(paramstr(1)); 
            fsplit(bnnm,tmpdr,tmpnm,tmpex); 
            findfirst(bnnm,0,bnrec); 
            while (doserror=0) do 
            begin
                with bnrec do 
                begin
                    bnnm:=tmpdr+name; 
                    fsplit(bnnm,tmpdr,tmpnm,tmpex); obnm:=tmpdr+tmpnm+'.O'; 
                    lbnm:=tmpnm; 
                    processfile; 
                end;
                findnext(bnrec);
                if keypressed then if readkey=#27 
                    then doserror:=-1;
            end;
            writeln(flcnt,' files converted'); 
        end;
        2: begin
                bnnm:=upstr(paramstr(1)); 
                obnm:=upstr(paramstr(2)); 
                fsplit(obnm,tmpdr,tmpnm,tmpex); 
                lbnm:= tmpnm; 
                processfile; 
            end;
        3: begin
                bnnm:=upstr(paramstr(1)); 
                obnm:=upstr(paramstr(2)); 
                lbnm:=upstr(paramstr(3)); 
                processfile; 
            end;
    end;
    if hldscr then 
    begin
        writeln('Press any key');
        repeat until readkey<>#0; 
    end;

unit tpascal;
{ Proceduren und Funtionen, die in MAXON-PASCAL } 
{ nicht existieren oder andere Ergebnisse lie-  } 
{ fern, werden bereitgestellt bzw. redefiniert. }

{  W. Schneider, Berlin 12/1991                 }
{  (c) 1992 MAXON Computer                      }

Interface
{$R-,D-,F+}

Type Registers=Record 
     Case Integer of 
        0: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags :Word);
        1: (AL,AH,BL,BH,CL,CH,DL,DH :Byte);
    End;

Function ReadKey :Char;
Procedure Sound (frq :Word);
Procedure NoSound;
Procedure Intr(IntNo:Integer; Var Regs:Registers);

Implementation

var scancd          :word;
    oldfont,oldexit :pointer;

(*** Redefinition von ReadKey ***}
function readkey:char; assembler;
asm
        tst.w   scancd
        beg     @rk1
        move.w  scancd,@result 
        clr.w   scancd
        bra     @rkend
    @rk1:
        move.w  #2,-(sp) 
        move.w  #2,-(sp) 
        trap    #13
        addq.l  #4,sp
        move.w  d0,@result 
        clr.w   scancd
        tst.b   d0
        bne     @rkend
        swap    d0
        move.w  d0,scancd 
    @rkend: 
end;

{ einfache Soundbefehle, nutzer Kanal A des }
{ Soundchips                                }
{*** Sound abschalten ***} 
procedure nosound; assembler; 
asm
        move.w  #135,-(sp) 
        move.w  #$ff,-(sp) 
        move.w  #28,-(sp) 
        trap    #14 
        addq.l  #6,sp
end;

{*** Ton erzeugen, max. Lautstärke ***} 
procedure sound(frq :word); 
var tc :integer; 
begin
    if (frq>30) and (frq<20000) then 
    begin
        tc:=round(125000/frq); 
        asm
            move.w  tc,d5 
            clr.w   d0 
            move.b  d5,d0 
            move.w  #128,-(sp) 
            move.w  d0,-(sp) 
            move.w  #28,-(sp) 
            trap    #14 
            addq.l  #6,sp

            lsr.w   #8,d5 
            clr.w   d0 
            move.b  d5,d0 
            move.w  #129,-(sp) 
            move.w  d0,-(sp) 
            move.w  #28,-(sp) 
            trap    #14
            addq.l  #6,sp

            move.w  #136,-(sp) 
            move.w  #$0f,-(sp) 
            move.w  #28,-(sp) 
            trap    #14 
            addq.l  #6,sp

            move.w  #135,-(sp) 
            move.w  #$fe,-(sp) 
            move.w  #28,-(sp) 
            trap    #14
            addq.l  #6,sp
        end;
    end;
end;

{ Einige oft genutzte DOS-Interrupts emulieren } 
procedure intr(intno :integer;var regs:registers); 
var temp :integer; 
begin
    if intno=5 then
        asm         { Bildschirm-Hardcopy auslösen }
            pea     @sdstrt
            move.w  #38,-(sp) 
            trap    #14
            addq.l  #2,sp
            bra     @sdend
         @sdstrt:
            clr.w   $4ee
            rts 
         @sdend: 
        end
    else with regs do 
    begin
        if (intno=$10) and (ah=1) then  { Cursor konf. } 
        begin
            if ch= $20 then
                asm                     { Cursor aus )
                    move.w  #0,-(sp) 
                    move.w  #0,-(sp) 
                    move.w  #21,-(sp) 
                    trap    #14 
                    addq.l #6,sp
                end;
            if ch<>$20 then
                asm                     { Cursor ein }
                    move.w  #0,-(sp) 
                    move.w  #1,—(sp) 
                    move.w  #21,-(sp) 
                    trap    #14 
                    addq.l  #6,sp
                end;
        end;
        if (intno=$16) and (ah=2) then
        begin   { Umschaltst. Tastatur ermitteln } 
            asm
                move.w  #-1,-(sp) 
                move.w  #11,-(sp) 
                trap    #13 
                addq.l  #4, sp
                move.w  d0,temp
            end;
            al :=temp; 
        end;
    end;
end;

{ IBM-Zeichensatz zur Verfügung stellen }
{*** Zeichensatzdaten ***} 
procedure ibmfont; external;
{$L a:\ibmfont.o)

{*** Zeichensatz für TOS installieren ***} 
function instfont(newfont :pointer):pointer; 
assembler; 
asm
    dc.w    $a000
    move.l  -$16(a0),@result
    move.l  newfont,-$16(a0)
end;

{ nach Programmende alten Zeichensatz inst. }
procedure tpexit;
begin
    oldfont:=instfont(oldfont); 
    exitproc:=oldexit; 
end;

{ diverse Initialisierungen }

begin
    oldexit:=exitprcc; 
    exitproc:=@tpexit; 
    oldfont:=instfont(@ibmfont); 
    scancd:=0; 
end.