; ASYNC.SAL Driver for RS232 fra Turbo Pascal V4
; Version 2.0
;     Date: 87-11-19, 20:10

            saljmp short
            salcmp unsigned
            salmac :=     mov &-,&+

include pascal.mac

buffers struc
    PortNr  dw ?
    IntNr   dw ?

    oldModemCntrReg db ?
    oldLevel        db ?
    oldVector       dd ?

    Inx     dw ?
    R_Buf2  dw ?
    OutX    dw ?
    SizeX   dw ?
    LimitX  dw ?

    InT     dw ?
    OutT    dw ?
    T_Buf2  dw ?
    SizeT   dw ?
    Send_T  dw ?

    Show_X  dw ?
    Show_X2 dw ?

    Toggle_Xoff dd ?
    RLS_user    dd ?
    MODEM_user  dd ?

    Ctrl_P  db ?

    UseTInt db ?
    HostX   db ?
    Bfull   db ?

    AutoX   db ?
    AltX    db ?

    Xoff1C  db ?
    Xoff2C  db ?
    Xon1C   db ?
    Xon2C   db ?

    Line_Status  db ?
    MODEM_Status db ?

    WaitTX  db ?
    Int_Mask db ?

buffers ends

DXofs MACRO ofs
    mif ofs
        ife ofs - 1
            inc dx
        else
            ife ofs + 1
                dec dx
            else
                add dx,ofs
            endif
        endif
    endif
ENDM

InPort MACRO ofs
    dx := [bx.PortNr]
    DXofs <ofs>
    in al,dx
ENDM

OutPort MACRO ofs
    dx := [bx.PortNr]
    DXofs <ofs>
    out dx,al
ENDM

InPOfs MACRO ofs
    DXofs <ofs>
    in al,dx
ENDM

OutPOfs MACRO ofs
    DXofs <ofs>
    out dx,al
ENDM

    LineContrReg    = 3   ; (* to specify format of transmitted data *)
    LowBaudRateDiv  = 0   ; (* lower byte of divisor to select baud rate *)
    HighBaudRateDiv = 1   ; (* higher byte of divisor *)
    LineStatusReg   = 5   ; (* holds status info on the data transfer *)
    ReceiverReg     = 0   ; (* received CHAR is in this register *)
    TransmitReg     = 0   ; (* CHAR to send is to put in this reg *)
    IntEnableReg    = 1   ; (* to enable the selected interrupt *)
    IntIdentReg     = 2   ; (* to identify the interrupt *)
    ModemContrReg   = 4   ; (* controls the interface to a modem *)
    ModemStatusReg  = 6   ; (* holds status of line (BREAK etc.) *)

    Icntrlw2 = 20h                     ;Interrupt controller
    SEOI1    = 64h                     ;EOI for COM1
    SEOI2    = 63h                     ;EOI for COM2

    FALSE    = 0
    TRUE     = 1

    RLSint   = 6
    RDRint   = 4
    THREint  = 2
    MODEMint = 0

DATA SEGMENT WORD PUBLIC
    ASSUME DS:DATA

EXTRN RS_BufPtr:WORD
EXTRN RS_TimeOut:WORD
DATA ENDS

CODE SEGMENT BYTE PUBLIC
    ASSUME CS:CODE

    public Rs_Com4int
Rs_Com4int proc far
    push ax
    push bx
    mov bx,offset DATA:rs_bufptr[12]
    jmp short comcont

    public rs_com3int
rs_com3int proc far
    push ax
    push bx
    mov bx,offset DATA:rs_bufptr[8]
    jmp short comcont

    public rs_com2int
rs_com2int proc far
    push ax
    push bx
    mov bx,offset DATA:rs_bufptr[4]
    jmp short comcont

    public rs_com1int
rs_com1int proc far
    push ax
    push bx
    mov bx,offset DATA:rs_bufptr[0]
comcont:
    push ds
    mov ax, DATA
    mov ds,ax
ASSUME DS:DATA

    mov bx,[bx]

; Reset Video TimeOut Count
    rs_timeout := 0

;   STI                                ;Enable int's

    push cx
    push dx
    push di
    push si
    push es

repeat_int:

    CLI
    InPort IntIdentReg                 ;Hvorfor er jeg her?

    if al = RDRint then
        call ReadInt
        jmp repeat_int
    endif
    if al = THREint then               ;TX int
        call SendNext                  ;Restart
        jmp repeat_int
    endif
    if al = RLSint then
        InPOfs <LineStatusReg - IntIdentReg>
        and al,1Eh                     ;Keep OE(2),PE(4),FE(8) and BI(10)
        or [bx.Line_Status],al
        jmp repeat_int
    endif
    if al = MODEMint then
        InPOfs <ModemStatusReg-IntIdentReg> ;Restart async chip
        or [bx.MODEM_Status],al
        if word ptr [bx].MODEM_user <> 0 then
            push bx
            push ds
            call dword ptr [bx+MODEM_user]
            pop ds
            pop bx
        endif
        jmp repeat_int
    endif

    InPOfs <ModemStatusReg-IntIdentReg> ;Restart async chip
    or [bx.MODEM_Status],al
    jmp $+2
    InPOfs <LineStatusReg-ModemStatusReg>
    and al,1Eh                         ;Keep OE(2),PE(4),FE(8) and BI(10)
    or [bx.Line_Status],al

    pop  es
    pop  si
    pop  di
    pop  dx
    pop  cx

    pop  ds
    pop  bx

; Enable HW int's

    CLI
    al := 20h
    out Icntrlw2,al

    pop  ax
    iret
rs_com1int endp
rs_com2int endp
rs_com3int endp
rs_com4int endp

ReadInt Proc near

    InPOfs <ReceiverReg - IntIdentReg> ;Get received char

; Test if room in buffer

    les si,dword ptr [bx.InX]          ;Get buffer Address
    lea di,[si+1]
    if di >= [bx.SizeX] then xor di,di

    if di <> [bx.OutX] then            ;Buffer not full
        es:[si] := al
        [bx.InX] := di
    else
        or [bx.Line_Status],20h        ;Overrun Error!
    endif

    STI

    if [bx.AutoX] = FALSE then ret

; Test if XOFF or XON
    ah := al                           ; Test if XOFF or XON
    and ah,7fh                         ; Use 7 low bits!

    if [bx.Ctrl_P] < 1 then
            if [bx.HostX] = FALSE then
                cmp ah,[BX.Xoff1C]
                je TurnOff
                if [bx.AltX] = TRUE then
                    cmp ah,[bx.Xoff2C]
                    je TurnOff
                endif
        endif
        cmp ah,[BX.Xon1C]
        je TurnOn
        cmp [bx.AltX],TRUE
        jne nochange
        cmp ah,[bx.Xon2C]
        je TurnOn
        jmp short nochange
    endif
    if = then                          ; if [bx.Ctrl_P] = 1 then
            if ah = 10h then
                [bx.Ctrl_P] := 2
                jmp short nochange
            endif
            cmp [bx.HostX],TRUE
            je TurnOn
            cmp ah,[bx.Xoff1C]
            je TurnOff
            jmp short nochange
    endif
    if [bx.Ctrl_P] = 2 then
            [bx.Ctrl_P] := 3
            jmp short nochange
    endif
    [bx.Ctrl_P] := 1
    jmp short nochange

TurnOn:
    [bx.HostX] := FALSE                ; Save new value
    call StartSender
    al := ' '
    jmp short updateX

TurnOff:
    [bx.HostX] := TRUE
    al := 'X'
UpdateX:
    if [bx.Show_X2] <> 0 then
        les di,dword ptr [bx.Show_X]
        es:[di] := al
    endif
NoChange:

; Test if buffer almost full

    dx := [bx.OutX]
    di := [bx.InX]
    inc di
    sub dx,di                                 ;InX
    if carry then add dx,[bx.SizeX]

; dx = Free space in buffer

    cmp dx,[bx.LimitX]
    jbe almost_full
    ret                                ;Buffer not full, early exit
Almost_Full:
    test [bx.Bfull],1                  ;Is our bit set?
    jnz Second_Limit                   ;Yes, check if past second limit
    or [bx.Bfull],1                    ;Set our bit
Stop_Rec:
    if [bx.UseTint] = TRUE then
            al := [bx.Xoff1C]
            ah := TRUE
            [bx.Send_T] := ax          ;Send before all others
            call StartSender
            ret                        ;Exit after XOFF sent
    endif
    call WaitTHRE
    al := [bx.Xoff1C]
    out dx,al
    ret

Second_Limit:
    shl dx,1
    cmp dx,[bx.LimitX]
    jbe Stop_Rec
    ret
ReadInt endp

WaitTHRE proc near
    mov dx,[bx].PortNr
    DXofs LineStatusReg
    repeat
        in al,dx
        ah := al
        and ah,1Eh
        or [bx.Line_Status],ah
    until al AND 20h true
    DXofs <TransmitReg - LineStatusReg>
    ret
WaitTHRE endp

SendByte proc near                     ; Sending WO TX-int
; INPUT   al : byte to send
; OUTPUT  ah : status
; REG'S   dx

    push ax
    call WaitTHRE
    pop ax

    ah := FALSE;
    if [bx.HostX] = FALSE then
        out dx,al
        ah := TRUE
    endif

    ret
SendByte EndP

SendInt Proc near
; Use buffered sending
; INPUT   al : byte to send
; OUTPUT  ah : status
; REG'S   dx,si,di,es,

    si := [bx.InT]
    lea di,[si+1]
    if di >= [bx.SizeT] then xor di,di

    ah := FALSE
    if di <> [bx.OutT] then
        es := [bx.T_Buf2]
        es:[si] := al

        [bx.InT] := di                 ;Update input pointer
        ah := TRUE
    endif

    call StartSender                   ;Restart if neccessary

    ret
SendInt endp

StartSender proc near
    push ax
    call SendNext
                                       ;Turn on TX int's again!
    InPort IntEnableReg
    or al,2
    out dx,al

    pop ax
    ret
StartSender endp

SendNoMore:
; Turn off TX int's when no more data
    InPort IntEnableReg
    and al,NOT 2
    out dx,al
    ret

SendNext Proc near                     ;SI
; INPUT
; OUTPUT
; REG'S   dx,ax,si,es

    if [bx.WaitTX] = FALSE then
        InPort LineStatusReg
        ah := al
        and ah,1Eh
        or [bx.Line_Status],ah

        if al AND 20h true then
            DXofs <TransmitReg - LineStatusReg>

            xor ax,ax
            xchg ax,[bx.Send_T]

            if ah <> FALSE then
                out dx,al
            elseif [bx.HostX] = FALSE then
                les si, dword ptr [bx.OutT]
                if si = [bx.InT] then jmp SendNoMore
                cld
                lods byte ptr es:[si]
                if si >= [bx.SizeT] then xor si,si
                [bx.OutT] := si
                out dx,al
            endif
        endif
    endif
    STI
    ret
SendNext endp

avail proc near
; INPUT
; OUTPUT  cx : bytes in input buffer
; REG'S   cx

    cx := [bx.InX]
    sub cx,[bx.OutX]
    if carry then add cx,[bx.sizeX]
    ret
avail endp

checkempty proc near                   ;Local proc for read and readblock
; INPUT
; OUTPUT
; REG'S   cx,ax
    if [bx.Bfull] and 1 true then
        call avail
        if cx <= [bx.LimitX] then
            and [bx.Bfull],254
            if zero then
                [bx.WaitTX] := TRUE    ;Allocate TX
                call WaitTHRE
                al := [bx.Xon1C]
                out dx,al
                [bx.WaitTX] := FALSE
            endif
        endif
    endif
    ret
checkempty endp

intro MACRO com
    bx := [bp+com]
    shl bx,1
    shl bx,1
    bx := rs_bufptr[bx-4]
ENDM

PasProc rs_readblock <bufs, buf, max, byts, byt, com> FAR
; REG'S   dx,cx,si,di,es,bx,ax

    intro com

    xor dx,dx                          ;zero bytes read
    call avail
    if cx > [bp].max then cx := [bp].max ;max bytes
    jcxz skipblock

    mov si,[bx.OutX]                   ;output index

    les di,[bp].buf                    ;buffer address
    cld                                ;les forover!

    dx := [bx.SizeX]                   ;Copy of size

  push ds
    ds := [bx.R_buf2]                  ;Segment of buffer
    push bx
    xor bx,bx                          ;bytes read

    repeat
        lodsb
        if si >= dx then xor si,si

        ah := al
        inc ah
        and ah,7fh
        if ah <= ' ' then
            if bx <> 0 then
                if si = 0 then si := dx
                dec si
                leave
            endif
            stosb
            inc bx
            leave
        endif

        stosb
        inc bx
    until loop

    dx := bx                           ;Save bytes read
    pop bx
  pop ds

    [bx.OutX] := si

skipblock:
    les di,[bp].byt
    es:[di] := dx                      ;bytes read in block
    call checkempty

PasRet

PasProc rs_busyread <chrs, chr, dones, done, com> FAR
    intro com

    si := [bx.OutX]

    ax := FALSE
    if si <> [bx.InX] then
        es := [bx.R_Buf2]
        cld
        lods byte ptr es:[si]
        if si >= [bx.SizeX] then xor si,si
        [bx.OutX] := si

        les di,[bp+chr]                ;ch
        stosb

        call checkempty

        al := TRUE
    endif

    les di,[bp.done]
    stosb

PasRet

PasProc rs_getchar <chrs, chr, com> FAR

    intro com

    si := [bx.OutX]

    xor ax,ax                          ; Return value

    if si <> [bx.InX] then
        es := [bx.R_Buf2]
        cld
        lods byte ptr es:[si]
        xor dx,dx
        ah := al
        inc ah
        and ah,7fh
        if ah > ' ' then
            if si >= [bx.SizeX] then xor si,si
            [bx.OutX] := si

            les di,[bp+chr]            ;ch
            stosb
            call checkempty
            dl := TRUE
        endif
        ax := dx
    endif
PasRet

PasProc rs_write <chr, dones, done, com> FAR
    intro com

    al := [bp+chr]

    if [bx.UseTInt] = TRUE then
        call SendInt
    else
        call SendByte
    endif

    les di,[bp.done]
    es:[di] := ah
PasRet

PasProc rs_writeblock <bufs, buf, len, byts, byt, com> FAR
    intro com

    cld                                ;Forward

    if [bx.UseTint] = FALSE then

        les si,[bp+buf]                ;buf
        cx := [bp+len]                 ;len
        dx := cx                       ;bytes sent
        jcxz skipwr

        push dx
        repeat
            lods byte ptr es:[si]
            call SendByte
            if ah = FALSE then leave
        until loop
        pop dx
        sub dx,cx
skipwr:
        ax := dx                       ;Bytes sent

    else                               ;Use TX int's

; Compute free room in TX buffer

        cx := [bx.OutT]
        di := [bx.InT]
        lea si,[di+1]
        ax := [bx.SizeT]

        sub cx,si                      ; OutT - (InT+1)
        if carry then add cx,ax

        if cx > [bp+len] then cx := [bp+len] ;Min(room,len)

        push cx                            ;Bytes sent

        jcxz skipwblock                    ;Request to send zero bytes!

        es := [bx.T_Buf2]
;       di := [bx.InT]                 ; OK from start

        push ds
        mov ds,[bp+bufs]
;******************* Her peker DS p bufferet, ikke p RS_Buffer!
        mov si,[bp+buf]                    ;buf

        sub ax,di                          ;Size - InT
        if ax < cx then                    ;Room on top of buffer?
            sub cx,ax                      ;Overflow part
            xchg cx,ax                     ;Room on top
            rep movsb                      ;First block
            xor di,di                      ;Continue from start of TX buffer
            cx := ax                       ;last part
        endif
        rep movsb                          ;Second block

        pop ds
;******************** N er DS:BX ok igjen!

        if di >= [bx.SizeT] then xor di,di
        [bx.InT] := di

skipwblock:
        pop ax                         ; # of bytes sent

    endif

    les di,[bp+done]
    stosw
    call StartSender

PasRet

PasProc rs_avail <com> FAR
    intro com
    call avail
    ax := cx
PasRet

PasProc rs_room <com> FAR              ;Room in output buffer
    intro com
    ax := [bx.OutT]
    dx := [bx.InT]

    inc dx
    sub ax,dx
    if carry then add ax,[bx].SizeT

PasRet

PasProc rs_enable <com> FAR
    intro com
    [bx.HostX] := FALSE
    mov al,0
    OutPort IntEnableReg
    al := [bx].Int_Mask
    out dx,al
    al := TRUE
    xchg al,[bx.WaitTX]
    if al = FALSE then
        call StartSender
        [bx.WaitTX] := FALSE
    endif
PasRet

PasProc rs_writefirst <chr, com> FAR
    intro com

    [bx.WaitTX] := TRUE                ;Allocate transmitter!
    call WaitTHRE
    al := [bp+chr]                     ;ch to send first
    out dx,al
    [bx.WaitTX] := FALSE
PasRet

CODE ENDS

    END