[Back to COMM SWAG index] [Back to Main SWAG index] [Original]

    unit ddfossil;
    {$S-,V-,R-}

    interface
    uses dos;

    const
     name='Fossil drivers for TP 4.0';
     author='Scott Baker';
    type
     fossildatatype = record
                       strsize: word;
                       majver: byte;
                       minver: byte;
                       ident: pointer;
                       ibufr: word;
                       ifree: word;
                       obufr: word;
                       ofree: word;
                       swidth: byte;
                       sheight: byte;
                       baud: byte;
                      end;
    var
     port_num: integer;
     fossildata: fossildatatype;

    procedure async_send(ch: char);
    procedure async_send_string(s: string);
    function async_receive(var ch: char): boolean;
    function async_carrier_drop: boolean;
    function async_carrier_present: boolean;
    function async_buffer_check: boolean;
    function async_init_fossil: boolean;
    procedure async_deinit_fossil;
    procedure async_flush_output;
    procedure async_purge_output;
    procedure async_purge_input;
    procedure async_set_dtr(state: boolean);
    procedure async_watchdog_on;
    procedure async_watchdog_off;
    procedure async_warm_reboot;
    procedure async_cold_reboot;
    procedure async_Set_baud(n: integer);
    procedure async_set_flow(SoftTran,Hard,SoftRecv: boolean);
    procedure Async_Buffer_Status(var Insize,Infree,OutSize,Outfree: word);

    implementation

    procedure async_send(ch: char);
    var
     regs: registers;
    begin;
     regs.al:=ord(ch);
     regs.dx:=port_num;
     regs.ah:=1;
     intr($14,regs);
    end;

    procedure async_send_string(s: string);
    var
     a: integer;
    begin;
     for a:=1 to length(s) do async_send(s[a]);
    end;

    function async_receive(var ch: char): boolean;
    var
     regs: registers;
    begin;
     ch:=#0;
     regs.ah:=3;
     regs.dx:=port_num;
     intr($14,regs);
     if (regs.ah and 1)=1 then begin;
      regs.ah:=2;
      regs.dx:=port_num;
      intr($14,regs);
      ch:=chr(regs.al);
      async_receive:=true;
     end else async_receive:=false;
    end;

    function async_carrier_drop: boolean;
    var
     regs: registers;
    begin;
     regs.ah:=3;
     regs.dx:=port_num;
     intr($14,regs);
     if (regs.al and $80)<>0 then async_carrier_drop:=false else async_carrier_drop:=true;
    end;

    function async_carrier_present: boolean;
    var
     regs: registers;
    begin;
     regs.ah:=3;
     regs.dx:=port_num;
     intr($14,regs);
     if (regs.al and $80)<>0 then async_carrier_present:=true else async_carrier_present:=false;
    end;

    function async_buffer_check: boolean;
    var
     regs: registers;
    begin;
     regs.ah:=3;
     regs.dx:=port_num;
     intr($14,regs);
     if (regs.ah and 1)=1 then async_buffer_check:=true else async_buffer_check:=false;
    end;

    function async_init_fossil: boolean;
    var
     regs: registers;
    begin;
     regs.ah:=4;
     regs.bx:=0;
     regs.dx:=port_num;
     intr($14,regs);
     if regs.ax=$1954 then async_init_fossil:=true else async_init_fossil:=false;
    end;

    procedure async_deinit_fossil;
    var
     regs: registers;
    begin;
     regs.ah:=5;
     regs.dx:=port_num;
     intr($14,regs);
    end;

    procedure async_set_dtr(state: boolean);
    var
     regs: registers;
    begin;
     regs.ah:=6;
     if state then regs.al:=1 else regs.al:=0;
     regs.dx:=port_num;
     intr($14,regs);
    end;

    procedure async_flush_output;
    var
     regs: registers;
    begin;
     regs.ah:=8;
     regs.dx:=port_num;
     intr($14,regs);
    end;

    procedure async_purge_output;
    var
     regs: registers;
    begin;
     regs.ah:=9;
     regs.dx:=port_num;
     intr($14,regs);
    end;

    procedure async_purge_input;
    var
     regs: registers;
    begin;
     regs.ah:=$0a;
     regs.dx:=port_num;
     intr($14,regs);
    end;

    procedure async_watchdog_on;
    var
     regs: registers;
    begin;
     regs.ah:=$14;
     regs.al:=01;
     regs.dx:=port_num;
     intr($14,regs);
    end;

    procedure async_watchdog_off;
    var
     regs: registers;
    begin;
     regs.ah:=$14;
     regs.al:=00;
     regs.dx:=port_num;
     intr($14,regs);
    end;

    procedure async_warm_reboot;
    var
     regs: registers;
    begin;
     regs.ah:=$17;
     regs.al:=01;
     intr($14,regs);
    end;

    procedure async_cold_reboot;
    var
     regs: registers;
    begin;
     regs.ah:=$17;
     regs.al:=00;
     intr($14,regs);
    end;

    procedure async_set_baud(n: integer);
    var
     regs: registers;
    begin;
     regs.ah:=00;
     regs.al:=3;
     regs.dx:=port_num;
     case n of
      300: regs.al:=regs.al or $40;
      1200: regs.al:=regs.al or $80;
      2400: regs.al:=regs.al or $A0;
      4800: regs.al:=regs.al or $C0;
      9600: regs.al:=regs.al or $E0;
      19200: regs.al:=regs.al or $00;
     end;
     intr($14,regs);
    end;

    procedure async_set_flow(SoftTran,Hard,SoftRecv: boolean);
    var
     regs: registers;
    begin;
     regs.ah:=$0F;
     regs.al:=00;
     if softtran then regs.al:=regs.al or $01;
     if Hard then regs.al:=regs.al or $02;
     if SoftRecv then regs.al:=regs.al or $08;
     regs.al:=regs.al or $F0;
     Intr($14,regs);
    end;

    procedure async_get_fossil_data;
    var
     regs: registers;
    begin;
     regs.ah:=$1B;
     regs.cx:=sizeof(fossildata);
     regs.dx:=port_num;
     regs.es:=seg(fossildata);
     regs.di:=ofs(fossildata);
     intr($14,regs);
    end;

    procedure Async_Buffer_Status(var Insize,Infree,OutSize,Outfree: word);
    begin;
     async_get_fossil_data;
     insize:=fossildata.ibufr;
     infree:=fossildata.ifree;
     outsize:=fossildata.obufr;
     outfree:=fossildata.ofree;
    end;

    end.

[Back to COMM SWAG index] [Back to Main SWAG index] [Original]