Programmer 7500

home *** CD-ROM | disk | FTP | other *** search

/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ECO30603.ZIP / ECO30603.LZH / ECOLIBBS / ECO_ASYN.PAS < prev next >

Wrap

Pascal/Delphi Source File | 1992-09-20 | 100.2 KB | 1,737 lines

(* ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓ ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓ ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓ ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓ ▓▓▓▓▓▓▓▓·── ──·▓▓▓▓▓▓▓▓▓▓▓ ▓▓▓▓▓▓▓▓│ │░░▓▓▓▓▓▓▓▓▓ ▓▓▓▓▓▓▓▓ Unit was Reconceived, Redesigned and Rewritten ░░▓▓▓▓▓▓▓▓▓ ▓▓▓▓▓▓▓▓ by Floor A.C. Naaijkens for ░░▓▓▓▓▓▓▓▓▓ ▓▓▓▓▓▓▓▓ UltiHouse Software / The ECO Group. ░░▓▓▓▓▓▓▓▓▓ ▓▓▓▓▓▓▓▓ ░░▓▓▓▓▓▓▓▓▓ ▓▓▓▓▓▓▓▓ MCMXCII by EUROCON PANATIONAL CORPORATION. ░░▓▓▓▓▓▓▓▓▓ ▓▓▓▓▓▓▓▓ All Rights Reserved for The ECO Group. ░░▓▓▓▓▓▓▓▓▓ ▓▓▓▓▓▓▓▓│ │░░▓▓▓▓▓▓▓▓▓ ▓▓▓▓▓▓▓▓·── ──·░░▓▓▓▓▓▓▓▓▓ ▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓ ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓ ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓ ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓ ┌───────────────────────────────────────────────────────────────────────┐ │ ECO_ASYN ─── Asynchronous I/O for TurboPascal │ ├───────────────────────────────────────────────────────────────────────┤ │ │ │ routines: │ │ │ │ bios_rs232_init ─── use bios to initialize port │ │ async_isr ─── com port interrupt service routine │ │ async_init ─── performs initialization. │ │ async_clear_errors ─── clear pending serial port errors │ │ async_reset_port ─── resets uart parameters for port │ │ async_open ─── sets up com port │ │ async_close ─── closes down com port │ │ async_carrier_detect ─── checks for modem carrier detect │ │ async_carrier_drop ─── checks for modem carrier drop │ │ async_buffer_check ─── checks if character in com buffer │ │ async_term_ready ─── toggles terminal ready status │ │ async_find_delay ─── find busy wait count for 1ms delay │ │ async_receive ─── reads character from com buffer │ │ async_receive_with_timeout │ │ ─── receives char. with timeout check │ │ async_ring_detect ─── if ringing detected │ │ async_send ─── transmits char over com port │ │ async_send_string ─── sends string over com port │ │ async_send_string_with_delays │ │ ─── sends string with timed delays │ │ async_send_break ─── sends break (attention) signal │ │ async_percentage_used ─── returns percentage com buffer used │ │ async_purge_buffer ─── purges receive buffer │ │ async_release_buffers ─── free memory for serial port queues │ │ async_setup_port ─── define port base, irq, rs232 addr │ │ async_stuff ─── insert char into receive buffer │ │ async_flush_output_buffer │ │ ─── flush serial port output buffer │ │ async_drain_output_buffer │ │ ─── wait for serial output to drain │ │ async_port_address_given │ │ ─── check if port address installed │ │ async_send_now ─── send character without buffering │ │ async_wait_for_quiet ─── wait for port to quiesce │ │ │ ├ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ┤ │ │ │ 1] set_params ─── set the parameters, requested by │ │ your program │ │ 2] initialize_modem ─── initialize the modem, using params │ │ 3] send_modem_command ─── send a commandstring to the modem │ │ │ └───────────────────────────────────────────────────────────────────────┘ Floor Naaijkens, 28-2-1990, MCMXCII *) unit eco_asyn; interface uses dos, crt ; const { 8086/8088 hardware flags } ff = 12; { form feed } cr = 13; { carriage return } dle = 16; { data link esc. } xon = 17; { xon } xoff = 19; { xoff } sub = 26; { end of file } esc = 27; { escape } del = 127; { delete } fk_cr : char = '|'; { function key definition cr } fk_delay : char = '~'; { function key def. 1 second wait } fk_wait_for : char = '`'; { function key wait for next char } fk_ctrl_mark : char = '^'; { marks next char as ctrl character } fk_script_ch : char = '@'; { script to execute follows } fk_delay_time : integer = 10; { delay to insert between each char } bs_string : string = ^h; { string to send when back space hit} ctrl_bs_string : string = #127; { string to send when ctrl bs hit } half_second_delay = 500; one_second_delay = 1000; two_second_delay = 2000; three_second_delay = 3000; tenth_of_a_second_delay = 100; on = true; off = false; data_bits : 5..8 = 8; parity : char = 'N'; stop_bits : 0..2 = 1; comm_port : 1..4 = 1; baud_rate : 110..38400 = 2400; cmd_line_port : 0..4 = 0; n_baud_rates = 11; baud_rates: array[ 1 .. n_baud_rates ] of word = ( 110, 150, 300, 600, 1200, 2400, 4800, 9600, 19200, 38400, 57600 ); modem_init : string = 'ATZ|~ATX1|'; modem_dial : string[30] = 'ATDT'; modem_dial_end : string[30] = '|'; modem_busy : string[30] = 'BUSY'; modem_connect : string[30] = 'CONNECT'; modem_no_carrier : string[30] = 'NO CARRIER'; modem_escape : string[30] = '+++'; modem_escape_time : integer = 1500; modem_hang_up : string[30] = 'ATH0|'; modem_time_out : longint = 60; modem_redial_delay : longint = 45; modem_answer : string[30] = 'ATA|'; modem_host_set : string = 'ATZ|~ATX1|~ATS0=1|'; modem_host_unset : string = 'ATZ|~ATX1|~ATS0=0|'; modem_command_delay : integer = 10; modem_carrier_high : boolean = false; modem_ring : string[30] = 'RING'; host_auto_baud : boolean = true; modem_hold_line : boolean = false; { communications hardware addresses } { these are specific to IBM PCs and Close compatibles. } uart_thr = $00; { offset from base of uart registers for ibm pc } uart_rbr = $00; uart_ier = $01; uart_iir = $02; uart_lcr = $03; uart_mcr = $04; uart_lsr = $05; uart_msr = $06; i8088_imr = $21; { port address of the interrupt mask register } com1_base = $03f8; { port addresses for the uart } com2_base = $02f8; com3_base = $03e8; com4_base = $02e8; com1_irq = 4; { interrupt line for the uart } com2_irq = 3; com3_irq = 4; com4_irq = 3; com1_int = $0c; { interrupt number for the uart } com2_int = $0b; com3_int = $0c; com4_int = $0b; rs232_base = $0400 { address of rs 232 com port pointer }; maxcomports = 4 { four ports allowed by this code }; { port addresses of each com port } default_com_base : array[1..maxcomports] of word = ( com1_base, com2_base, com3_base, com4_base ); { irq line for each port } default_com_irq : array[1..maxcomports] of integer = ( com1_irq, com2_irq, com3_irq, com4_irq ); { interrupt for each port } default_com_int : array[1..maxcomports] of integer = ( com1_int, com2_int, com3_int, com4_int ); {───────────────────────────────────────────────────────────────────────────} { } { communications buffer variables } { } { the communications buffers are implemented as circular (ring) } { buffers, or double-ended queues. the asynchronous i/o routines } { enter characters in the receive buffer as they arrive at the } { serial port. higher-level routines may extract characters from } { the receive buffer at leisure. higher-level routines insert } { characters into the send buffer. the asynchronous i/o routines } { then send characters out the serial port when possible. } { } {───────────────────────────────────────────────────────────────────────────} timeout = 256; { timeout value } async_xon = ^Q; { xon character } async_xoff = ^S; { xoff character } async_overrun_error = 2; { overrun } async_parity_error = 4; { parity error } async_framing_error = 8; { framing error } async_break_found = 16; { break interrupt } async_cts = $10; { clear to send } async_rts = $20; { request to send } async_dsr = $20; { data set ready } async_dtr = $10; { data terminal ready } async_rtsdtr = $30; { rts + dtr } type { i/o buffer type for serial port } async_buffer_type = array[0..1] of char; async_ptr = ^async_buffer_type; var { port addresses for serial ports } com_base : array[1..maxcomports] of word; { irq line for each serial port } com_irq : array[1..maxcomports] of integer; { interrupt for each serial port } com_int : array[1..maxcomports] of integer; async_buffer_ptr : async_ptr; { input buffer address } async_obuffer_ptr : async_ptr; { output buffer address } async_open_flag : boolean; { true if port opened } async_port : integer; { current open port number (1 ── 4) } async_base : integer; { base for current open port } async_irq : integer; { irq for current open port } async_int : integer; { interrupt # for current port } async_rs232 : integer; { rs232 address for current port } async_buffer_overflow : boolean; { true if buffer overflow's happened } async_buffer_used : integer; { amount of input buffer used so far } async_maxbufferused : integer; { maximum amount of input buffer used } { async_buffer empty if head = tail } async_buffer_head : integer; { loc in async_buf to put next char } async_buffer_tail : integer; { loc in async_buf to get next char } async_buffer_newtail : integer; { for updating tail value } async_obuffer_overflow : boolean; { true if buffer overflow's happened } async_obuffer_used : integer; { amount of output buffer used } async_maxobufferused : integer; { max amount of output buffer used } { async_buffer empty if head = tail } async_obuffer_head : integer; { loc in async_buf to put next char } async_obuffer_tail : integer; { loc in async_buf to get next char } async_obuffer_newtail : integer; { for updating tail value } async_buffer_low : integer; { low point in receive buffer for xon } async_buffer_high : integer; { high point in rec'buffer for xoff } async_buffer_high_2 : integer; { emergency point for xoff } async_xoff_sent : boolean; { if xoff sent } async_sender_on : boolean; { if sender is enabled } async_send_xoff : boolean; { true to send xoff asap } async_xoff_received : boolean; { if xoff received } async_xoff_rec_display : boolean; { if xoff received and displayed } async_xon_rec_display : boolean; { if xon received } async_baud_rate : word; { current baud rate } { save prev serial interrupt status } async_save_iaddr : pointer; async_do_cts : boolean; { true to do clear-to-send checking } async_do_dsr : boolean; { true to do data-set-ready checking } async_do_xonxoff : boolean; { true to do xon/xoff flow checking } async_ov_xonxoff : boolean; { true to do xon/xoff if buf overflow } async_hard_wired_on : boolean; { true if hard-wired connection } async_break_length : integer; { length of break in 1/10 seconds } async_line_status : byte; { line status reg at interrupt } async_modem_status : byte; { modem status reg at interrupt } async_line_error_flags : byte; { line status bits accumulated } async_buffer_size : integer; { stores input buffer size } async_obuffer_size : integer; { stores output buffer size } async_uart_ier : integer; { interrupt enable register address } async_uart_mcr : integer; { interrupt enable register address } async_uart_iir : integer; { interrupt id register address } async_uart_msr : integer; { modem status register address } async_uart_lsr : integer; { line status register address } async_output_delay : integer; { delay in ms when output buffer full } async_onemsdelay : integer; { loop count value to effect 1 ms delay } async_buffer_length : integer; { receive buffer length } async_obuffer_length : integer; { send buffer length } { pointer to async_send routine } async_send_addr : async_ptr; break_length : integer; current_carrier_status, new_carrier_status, attended_mode, hard_wired, reset_comm_port, comm_port_changed, check_cts,check_dsr, do_xon_xoff_checks : boolean; {──────────────────────────────────────────────────────────────────────} { multitasker definitions } {──────────────────────────────────────────────────────────────────────} type multitaskertype = ( multitasker_none, doubledos, desqview, topview, mswindows, apxcore, ezdosit, concurrent_dos, taskview, multilink, other ); var timesharingactive: boolean; { true if multitasker active } { which multitasker active } multitasker: multitaskertype; {──────────────────────────────────────────────────────────────────────} { dos jump stuff } {──────────────────────────────────────────────────────────────────────} {var}const heaptop : pointer = nil { top of heap at program start }; stacksafetymargin : word = 1000 { safety margin for stack }; minspacefordos : word = 20000 { minimum bytes for dos shell to run }; procedure bios_rs232_init(comport: integer; comparm: word); procedure async_close(drop_dtr: boolean); procedure async_clear_errors; procedure async_reset_port( comport : integer; baudrate : word; parity : char; wordsize : integer; stopbits : integer ); function async_open( comport : integer; baudrate : word; parity : char; wordsize : integer; stopbits : integer ): boolean; procedure async_send(c: char); function async_receive(var c: char): boolean; procedure async_receive_with_timeout(secs: integer; var c: integer); procedure async_stuff(ch: char); procedure async_find_delay(var one_ms_delay: integer); procedure async_init( async_buffer_max : integer; async_obuffer_max: integer; async_high_lev1 : integer; async_high_lev2 : integer; async_low_lev : integer ); function async_carrier_detect: boolean; function async_carrier_drop: boolean; procedure async_term_ready(ready_status: boolean); function async_buffer_check: boolean; function async_line_error(var error_flags: byte): boolean; function async_ring_detect: boolean; procedure async_send_break; procedure async_send_string(s: string); procedure async_send_string_with_delays( s : string; char_delay : integer; eos_delay : integer ); function async_percentage_used: real; procedure async_purge_buffer; function async_peek(nchars: integer): char; procedure async_setup_port( comport : integer; base_address : integer; irq_line : integer; int_numb : integer ); procedure async_release_buffers; procedure async_flush_output_buffer; procedure async_drain_output_buffer(max_wait_time: integer); function async_port_address_given(com_port: integer): boolean; procedure async_send_now(c: char); function async_wait_for_quiet( max_wait: longint; wait_time: longint ): boolean; { --- } procedure send_modem_command(modem_text: string); function set_params(first_time: boolean): boolean; procedure initialize_modem; implementation { ensure multitasking defined } {$DEFINE MTASK} { multitasker interface routines } function isnovellactive: boolean; var regs: registers; begin { isnovellactive } regs.cx := 0; regs.al := 0; { request workstation id. this should be ignored if novell } { network software isn't active. } regs.ah := $dc; msdos(regs); { if we got back a non-zero station id, then novell must be loaded. } isnovellactive := (regs.al <> 0); end; procedure turnontimesharing; var regs: registers; begin { turnontimesharing } case multitasker of { if ddos is active, $eb turns on timesharing } doubledos: begin regs.ax := $eb00; msdos(regs) end; { int 15h for topview family products } desqview,topview,mswindows, taskview: begin regs.ax := $101c; intr($15, regs) end; else; end { case }; end; procedure turnofftimesharing; var regs: registers; begin case multitasker of { if ddos is active, $ea suspends timesharing } doubledos: begin regs.ax := $ea00; msdos(regs) end; { int 15h for topview family products } desqview, topview, mswindows, taskview: begin regs.ax := $101b; intr($15 , regs) end; else; end { case }; end; procedure giveuptime(nslices: integer); { purpose: gives away time slices to other tasks } { calling sequence: } { nslices ─── # of slices (55 ms) to give away, if doubledos. } var regs: registers; begin { giveuptime } if (timesharingactive and (nslices > 0)) then case multitasker of doubledos: begin regs.ah := $ee; regs.al := nslices; msdos(regs); end; { function ee gives time to other part. } desqview, topview, mswindows, taskview: begin inline( $b8/$00/$10 { mov ax,$1000; give up time} /$cd/$15 { int $15} ); end; else; end; end; function timeofday: longint; var hours, minutes, seconds, sechun : word; timeval : longint; begin gettime(hours, minutes, seconds, sechun); timeval := hours; timeofday := timeval * 3600 + minutes * 60 + seconds; end; function timediff(timer1, timer2: longint): longint; const secs_per_day = 86400 { seconds in one day }; var tdiff: longint; begin { timediff } tdiff := timer2 - timer1; if (tdiff < 0) then tdiff := tdiff + secs_per_day; timediff := tdiff; end; function timeofdayh: longint; var hours, minutes, seconds, sechun : word; timerval : longint; begin gettime(hours, minutes, seconds, sechun); timerval := hours; timeofdayh := timerval * 360000 + minutes * 6000 + seconds * 100 + sechun; end; function timediffh(timer1, timer2: longint): longint; const hundredths_secs_per_day = 8640000 { 1/100 seconds in one day }; var tdiff: longint; begin { timediffh } tdiff := timer2 - timer1; if tdiff < 0 then tdiff := tdiff + hundredths_secs_per_day; timediffh := tdiff; end; {$DEFINE MTASK} procedure bios_rs232_init(comport: integer; comparm: word); var regs: registers; begin { bios_rs232_init } with regs do begin { initialize port } ax := comparm and $00ff; { ah=0; al=comparm } dx := comport; { port number to use } intr($14, regs); end; end; procedure async_isr( flags, cs, ip, ax, bx, cx, dx, si, di, ds, es, bp: word ); interrupt; begin inline( $fb/ { sti ;allow interrupts } { begin major polling loop over pending interrupts. } { the polling loop is needed because the 8259 cannot handle another 8250 } { interrupt while we service this interrupt. we keep polling here as long } { as an interrupt is received. } $8b/$16/>async_uart_iir/ {poll: mov dx,[>async_uart_iir] ;get interrupt ident register } $ec/ { in al,dx ;pick up interrupt type } $a8/$01/ { test al,1 ;see if any interrupt signalled. } $74/$03/ { jz polla ;yes ─── continue } $e9/$b9/$01/ { jmp near back ;no ─── return to invoker } { determine type of interrupt. } { possibilities: } { 0 = modem status changed } { 2 = transmit hold register empty (write char) } { 4 = character received from port } { 6 = line status changed } $24/$06/ {polla: and al,6 ;strip unwanted bits fr intr typ } $3c/$04/ { cmp al,4 ;check if interrupt >= 4 } $74/$03/ { je pollb ; } $e9/$db/$00/ { jmp near int2 } { write interrupts must be turned on if a higher-priority interrupt } { has been received, else the characters may not be sent (and a lockup } { may occur). } $50/ {pollb: push ax ;save interrupt type } $e8/$9f/$01/ { call enabwi ;enable write interrupts } $58/ { pop ax ;restore interrupt type } { ─── received a character ──── } $3c/$04/ {int4: cmp al,4 ;check for received char intr } $74/$03/ { je int4a ;yes ── process it. } $e9/$cf/$00/ { jmp near int2 ;no ── skip. } { read the character from the serial port. } $8b/$16/>async_base/ {int4a: mov dx,[>async_base] ;read character from port } $ec/ { in al,dx } { check if xon/xoff honored. if so, check if incoming character is } { an xon or an xoff. } $f6/$06/>async_do_xonxoff/$01/ { test byte [<async_do_xonxoff],1 ;see if we honor xon/xoff } $74/$25/ { jz int4d ;no ── skip xon/xoff checks } $3c/<xon/ { cmp al,<xon ;see if xon found } $74/$11/ { je int4b ;skip if xon found } $3c/<xoff/ { cmp al,<xoff ;see if xoff found } $75/$1d/ { jne int4d ;skip if xoff not found } { xoff received ── set flag indicating sending of chars isn't possible } $c6/$06/>async_xoff_received/$01/{ mov byte [<async_xoff_received],1 ;turn on rec' xoff flag } $c6/$06/>async_xoff_rec_display/ { mov byte [<async_xoff_rec_display],1 ;turn on display flag } $01/ $e9/$be/$ff/ { jmp near poll } { xon received ── allow more characters to be sent. } $c6/$06/>async_xoff_received/$00/{int4b: mov byte [<async_xoff_received],0 ;turn off rec'd xoff flag } $c6/$06/>async_xon_rec_display/ { mov byte [<async_xon_rec_display],1 ;turn on display flag } $01/$e8/$69/$01/ { call enabwi ;enable write interrupts } $e9/$9b/$00/ { jmp near int4z } { not xon/xoff ── handle other character. } $f6/$06/>async_line_status/$02/ {int4d: test byte [>async_line_status],2 ;check for buffer overrun } $74/$03/ { jz int4e ;yes ── don't store anything } $e9/$91/$00/ { jmp int4z } $8b/$1e/>async_buffer_head/ {int4e: mov bx,[>async_buffer_head] ;cur position in input buffer } $c4/$3e/>async_buffer_ptr/ { les di,[>async_buffer_ptr] ;pick up buffer address } $01/$df/ { add di,bx ;update position } $26/$88/$05/ { es: mov [di],al ;store rec'd character in buffer } $ff/$06/>async_buffer_used/ { inc word [>async_buffer_used] ;increment count of chars in buf } $a1/>async_buffer_used/ { mov ax,[>async_buffer_used] ;pick up buffer usage count } $3b/$06/>async_maxbufferused/ { cmp ax,[>async_maxbufferused] ;see if greater usage } $7e/$03/ { jle int4f ;skip if not } $a3/>async_maxbufferused/ { mov [>async_maxbufferused],ax ;this is greatest use thus far } $43/ {int4f: inc bx ;increment buffer pointer } $3b/$1e/>async_buffer_size/ { cmp bx,[>async_buffer_size] ;check if past end of buffer } $7e/$02/ { jle int4h } $31/$db/ { xor bx,bx ;if so, wrap around to front } $39/$1e/>async_buffer_tail/ {int4h: cmp word [>async_buffer_tail],bx ;check for overflow } $74/$60/ { je int4s ;jump if head ran into tail } $89/$1e/>async_buffer_head/ { mov [>async_buffer_head],bx ;update head pointer } { check for receive buffer nearly full here. } { if xon/xoff available, and buffer getting full, set up to send } { xoff to remote system. } { this happens in two possible stages: } { (1) an xoff is sent right when the buffer becomes 'Async_Buffer_High' } { characters full. } { (2) a second xoff is sent right when the buffer becomes } { 'Async_Buffer_High_2' characters full; this case is likely the } { result of the remote not having seen our xoff because it was } { lost in transmission. } { if cts/rts handshaking, then drop rts here if buffer nearly full. } { note that this has to be done even if the xoff is being sent as well. } { check receive buffer size against first high-water mark. } $3b/$06/>async_buffer_high/ { cmp ax,[>async_buffer_high] ;ax still has async_buffer_used } $7c/$5b/ { jl int4z ;not very full, so keep going. } { remember if we've already (supposedly) disabled sender. } $8a/$16/>async_sender_on/ { mov dl,[<async_sender_on] ;get sender enabled flag. } { drop through means receive buffer getting full. } { check for xon/xoff. } $f6/$06/>async_ov_xonxoff/$01/ { test byte [<async_ov_xonxoff],1 ;see if we honor xon/xoff } { ; for buffer overflow } $74/$1a/ { jz int4k ;no ── skip xon/xoff checks } { check if we've already sent XOFF. } $f6/$06/>async_xoff_sent/$01/ { test byte [<async_xoff_sent],1 ;rememb if we sent xoff or not } $74/$06/ { jz int4j ;no ── go send it now. } { check against second high-water mark. } { if we are right at it, send an xoff regardless of whether we've } { already sent one or not. (perhaps the first got lost.) } $3b/$06/>async_buffer_high_2/ { cmp ax,[>async_buffer_high_2] } $75/$0d/ { jne int4k ;not at 2nd mark ── skip } $c6/$06/>async_send_xoff/$01/ {int4j: mov byte [<async_send_xoff],1 ;indicate we need to send xoff } $e8/$06/$01/ { call enabwi ;ensure write intr enabled } $c6/$06/>async_sender_on/$00/ { mov byte [<async_sender_on],0 ;disable sender } { check here if we're doing hardware handshakes. } { drop rts if cts/rts handshaking. } { drop dtr if dsr/dtr handshaking. } $f6/$c2/$01/ {int4k: test dl,1 ;see if sender already disabled } $74/$31/ { jz int4z ;yes ── skip h/w handshakes. } $30/$e4/ { xor ah,ah ;no hardware handshakes } $f6/$06/>async_do_cts/$01/ { test byte [<async_do_cts],1 ;see if rts/cts checking } $74/$02/ { jz int4l ;no ── skip it } $b4/<async_rts/ { mov ah,<async_rts ;turn on rts bit } $f6/$06/>async_do_dsr/$01/ {int4l: test byte [<async_do_dsr],1 ;see if dsr/dtr checking } $74/$03/ { jz int4m ;no ── skip it } $80/$cc/<async_dtr/ { or ah,<async_dtr ;turn on dtr bit } $80/$fc/$00/ {int4m: cmp ah,0 ;any hardware signal? } $74/$17/ { jz int4z ;no ── skip } $8b/$16/>async_uart_mcr/ { mov dx,[>async_uart_mcr] ;get modem control register } $ec/ { in al,dx } $f6/$d4/ { not ah ;complement hardware flags } $20/$e0/ { and al,ah ;nuke rts/dtr } $ee/ { out dx,al } $c6/$06/>async_sender_on/$00/ { mov byte [<async_sender_on],0 ;indicate sender disabled } $e9/$05/$00/ { jmp int4z } { if we come here, then the input buffer has overflowed. } { characters will be thrown away until the buffer empties at least one slot. } $80/$0e/>async_line_status/$02/ {int4s: or byte ptr [>async_line_status],2 ;flag overrun } $e9/$10/$ff/ {int4z: jmp near poll } { ─── write a character ─── } $3c/$02/ {int2: cmp al,2 ;check for thre interrupt } $74/$03/ { je int2a ;yes ── process it. } $e9/$97/$00/ { jmp near int6 ;no ── skip. } { check first if we need to send an xoff to remote system. } $f6/$06/>async_send_xoff/$01/ {int2a: test byte [<async_send_xoff],1 ;see if we are sending xoff } $74/$34/ { jz int2d ;no ── skip it } { yes, we are to send xoff to remote. } { first, check dsr and cts as requested. } { if those status lines aren't ready, turn off write interrupts and } { try later, after a line status change. } $f6/$06/>async_do_dsr/$01/ { test byte [<async_do_dsr],1 ;see if dsr checking required } $74/$09/ { jz int2b ;no ── skip it } $8b/$16/>async_uart_msr/ { mov dx,[>async_uart_msr] ;get modem status register } $ec/ { in al,dx } $a8/<async_dsr/ { test al,<async_dsr ;check for data set ready } $74/$2e/ { jz int2e ;if not dsr, turn off writ intr } $f6/$06/>async_do_cts/$01/ {int2b: test byte [<async_do_cts],1 ;see if cts checking required } $74/$09/ { jz int2c ;no ── skip it } $8b/$16/>async_uart_msr/ { mov dx,[>async_uart_msr] ;get modem status register } $ec/ { in al,dx } $a8/<async_cts/ { test al,<async_cts ;check for clear to send } $74/$1e/ { jz int2e ;if not cts, turn off writ ints } { all status lines look ok. } { send the xoff. } $b0/<xoff/ {int2c: mov al,<xoff ;get xoff character } $8b/$16/>async_base/ { mov dx,[>async_base] ;get transmit hold reg address } $ee/ { out dx,al ;output the xoff } $c6/$06/>async_send_xoff/$00/ { mov byte [<async_send_xoff],0 ;turn off send xoff flag } $c6/$06/>async_xoff_sent/$01/ { mov byte [<async_xoff_sent],1 ;turn on sent xoff flag } $e9/$ce/$fe/ { jmp near poll ;return } { not sending xoff ── see if any character in buffer to be sent. } $8b/$1e/>async_obuffer_tail/ {int2d: mov bx,[>async_obuffer_tail] ;pick up output buffer pointers } $3b/$1e/>async_obuffer_head/ { cmp bx,[>async_obuffer_head] } $75/$0b/ { jne int2m ;skip if not equal ──> send } { if nothing to send, turn off write interrupts to avoid unnecessary } { time spent handling useless thre interrupts. } $8b/$16/>async_uart_ier/ {int2e: mov dx,[>async_uart_ier] ;if nothing ─or can't─ send ... } $ec/ { in al,dx ; } $24/$fd/ { and al,$fd ; } $ee/ { out dx,al ;... disable write interrupts } $e9/$b9/$fe/ { jmp near poll ; } { if something to send, ensure that remote system didn't send us XOFF. } { if it did, we can't send anything, so turn off write interrupts and } { wait for later (after an xon has been received). } $f6/$06/>async_xoff_received/$01/{int2m: test byte [<async_xoff_received],1 ;see if we received xoff } $75/$ee/ { jnz int2e ;yes ── can't send anything now } { if we can send character, check dsr and cts as requested. } { if those status lines aren't ready, turn off write interrupts and } { try later, after a line status change. } $8b/$16/>async_uart_msr/ { mov dx,[>async_uart_msr] ;otherwise get modem status } $ec/ { in al,dx } $a2/>async_modem_status/ { mov [>async_modem_status],al ;and save modem status for later } $f6/$06/>async_do_dsr/$01/ { test byte [<async_do_dsr],1 ;see if dsr checking required } $74/$04/ { jz int2n ;no ── skip it } $a8/<async_dsr/ { test al,<async_dsr ;check for data set ready } $74/$db/ { jz int2e ;if not dsr, turn off write ints } $f6/$06/>async_do_cts/$01/ {int2n: test byte [<async_do_cts],1 ;see if cts checking required } $74/$04/ { jz int2o ;no ── skip it } $a8/<async_cts/ { test al,<async_cts ;check for clear to send } $74/$d0/ { jz int2e ;if not cts, turn off write ints } { everything looks ok for sending, so send the character. } $c4/$3e/>async_obuffer_ptr/ {int2o: les di,[>async_obuffer_ptr] ;get output buffer pointer } $01/$df/ { add di,bx ;position to character to output } $26/$8a/$05/ { es: mov al,[di] ;get character to output } $8b/$16/>async_base/ { mov dx,[>async_base] ;get transmit hold reg address } $ee/ { out dx,al ;output the character } $ff/$0e/>async_obuffer_used/ { dec word [>async_obuffer_used] ;decrement count of chars in buf } $43/ { inc bx ;increment tail pointer } $3b/$1e/>async_obuffer_size/ { cmp bx,[>async_obuffer_size] ;see if past end of buffer } $7e/$02/ { jle int2z } $31/$db/ { xor bx,bx ;if so, wrap to front } $89/$1e/>async_obuffer_tail/ {int2z: mov [>async_obuffer_tail],bx ;store updated buffer tail } $e9/$72/$fe/ { jmp near poll } { ─── line status change ─── } $3c/$06/ {int6: cmp al,6 ;check for line status interrupt } $75/$11/ { jne int0 ;no ── skip. } $8b/$16/>async_uart_lsr/ { mov dx,[>async_uart_lsr] ;yes ── pick up line status reg } $ec/ { in al,dx ;and its contents } $24/$1e/ { and al,$1e ;strip unwanted bits } $a2/>async_line_status/ { mov [>async_line_status],al ;store for future reference } $08/$06/>async_line_error_flags/ { or [>async_line_error_flags],al ;add to any past transgressions } $e9/$5d/$fe/ { jmp near poll } { ─── modem status change ─── } $3c/$00/ {int0: cmp al,0 ;check for modem status change } $74/$03/ { je int0a ;yes ── handle it } $e9/$56/$fe/ { jmp near poll ;else get next interrupt } $8b/$16/>async_uart_msr/ {int0a: mov dx,[>async_uart_msr] ;pick up modem status reg. address } $ec/ { in al,dx ;and its contents } $a2/>async_modem_status/ { mov [>async_modem_status],al ;store for future reference } $e8/$03/$00/ { call enabwi ;turn on write interrupts, in case } { ;status change resulted fm cts/dsr } { ;changing state. } $e9/$48/$fe/ { jmp near poll } { internal subroutine to enable write interrupts. } {enabwi: ;proc near } $8b/$16/>async_uart_ier/ { mov dx,[>async_uart_ier] ;get interrupt enable register } $ec/ { in al,dx ;check contents of ier } $a8/$02/ { test al,2 ;see if write interrupt enabled } $75/$03/ { jnz enabret ;skip if so } $0c/$02/ { or al,2 ;else enable write interrupts ... } $ee/ { out dx,al ;... by rewriting ier contents } $c3/ {enabret: ret ;return to caller } { send non-specific eoi to 8259 controller. } $b0/$20/ {back: mov al,$20 ;eoi = $20 } $e6/$20 { out $20,al } ); end; procedure async_close(drop_dtr: boolean); var i: integer; m: integer; begin { async_close } if async_open_flag then begin { disable the irq on the 8259 } inline($fa); { disable interrupts } i := port[i8088_imr]; { get the interrupt mask register } m := 1 shl async_irq; { set mask to turn off interrupt } port[i8088_imr] := i or m; { disable the 8250 interrupts } port[uart_ier + async_base] := 0; { disable out2, rts, out1 on 8250, but possibly leave dtr enabled.} if drop_dtr then port[uart_mcr + async_base] := 0 else port[uart_mcr + async_base] := 1; inline($fb); { enable interrupts } { re-initialize our data areas so we know the port is closed } async_open_flag := false; async_xoff_sent := false; async_sender_on := false; { restore the previous interrupt pointers } setintvec(async_int , async_save_iaddr); end; end; procedure async_clear_errors; var i: integer; m: integer; begin { read the rbr and reset any pending error conditions. } { first turn off the divisor access latch bit to allow } { access to rbr, etc. } inline($fa); { disable interrupts } port[uart_lcr + async_base] := port[uart_lcr + async_base] and $7f; { read the line status register to reset any errors it indicates } i := port[uart_lsr + async_base]; { read the receiver buffer register in case it contains a character } i := port[uart_rbr + async_base]; { enable the irq on the 8259 controller } i := port[i8088_imr]; { get the interrupt mask register } m := (1 shl async_irq) xor $00ff; port[i8088_imr] := i and m; { enable out2 on 8250 } i := port[uart_mcr + async_base]; port[uart_mcr + async_base] := i or $0b; { enable the data ready interrupt on the 8250 } port[uart_ier + async_base] := $0f; { re-enable 8259 } port[$20] := $20; inline($fb); { enable interrupts } end; procedure async_reset_port( comport : integer; baudrate : word; parity : char; wordsize : integer; stopbits : integer ); const async_num_bauds = 11; async_baud_table : array [1..async_num_bauds] of record baud, bits: word; end = ( (baud: 110; bits: $00), (baud: 150; bits: $20), (baud: 300; bits: $40), (baud: 600; bits: $60), (baud: 1200; bits: $80), (baud: 2400; bits: $A0), (baud: 4800; bits: $C0), (baud: 9600; bits: $E0), (baud: 19200; bits: $E0), (baud: 38400; bits: $E0), (baud: 57600; bits: $E0) ); {────────────────────────────────────────────────} var { build the comparm for rs232_init } i, m, { see technical reference manual for description } comparm : integer; {────────────────────────────────────────────────} begin { set up the bits for the baud rate } if (baudrate > async_baud_table[async_num_bauds].baud) then baudrate := async_baud_table[async_num_bauds].baud else if (baudrate < async_baud_table[1].baud) then baudrate := async_baud_table[1].baud; { remember baudrate 4 purges } async_baud_rate := baudrate; i := 0; repeat inc(i) until ((i >= async_num_bauds) or (baudrate = async_baud_table[i].baud)); comparm := async_baud_table[i].bits; { choose parity. temporarily consider mark, space as none. } parity := upcase(parity); case parity of 'E': comparm := comparm or $0018; 'O': comparm := comparm or $0008; else ; end { case }; { choose number of data bits } wordsize := wordsize - 5; if (wordsize < 0) or (wordsize > 3) then wordsize := 3; comparm := comparm or wordsize; if stopbits = 2 then comparm := comparm or $0004; { choose stop bits } { default is 1 stop bit use the bios com port init routine } bios_rs232_init(comport - 1 , comparm); { if > 9600 baud, we have to screw around a bit } if (baudrate >= 19200) then begin i := port[ uart_lcr + async_base ]; port[uart_lcr + async_base] := i or $80; port[uart_thr + async_base] := 115200 div baudrate; port[uart_ier + async_base] := 0; i := port[ uart_lcr + async_base ]; port[uart_lcr + async_base] := i and $7f; end; { now fix up mark, space parity } if ((parity = 'M') or (parity = 'S')) then begin i := port[ uart_lcr + async_base ]; port[ uart_lcr + async_base ] := $80; comparm := wordsize or ((stopbits - 1) shl 2); case parity of 'M': comparm := comparm or $0028; 'S': comparm := comparm or $0038; else ; end; port[uart_lcr + async_base] := comparm; end; async_sender_on := true; { sender is enabled | clear any pending errors on async line } async_clear_errors; end; function async_open( comport : integer; baudrate : word; parity : char; wordsize : integer; stopbits : integer ): boolean; begin { if port open, close it down first. } if async_open_flag then async_close(false); { choose communications port } if (comport < 1) then comport := 1 else if (comport > maxcomports) then comport := maxcomports; async_port := comport; async_base := com_base[comport]; async_irq := com_irq[comport]; async_int := com_int[comport]; { set reg pointers for isr routine } async_uart_ier := async_base + uart_ier; async_uart_iir := async_base + uart_iir; async_uart_msr := async_base + uart_msr; async_uart_lsr := async_base + uart_lsr; async_uart_mcr := async_base + uart_mcr; { check if given port installed } if ( (port[uart_iir + async_base] and $00f8) <> 0 ) then async_open := false else begin { serial port not installed } getintvec(async_int , async_save_iaddr); setintvec(async_int , @async_isr); async_reset_port(comport, baudrate, parity, wordsize, stopbits); async_open := true; async_open_flag := true; end; end; procedure async_send(c: char); begin inline( $8b/$1e/>async_obuffer_head/ { mov bx,[>async_obuffer_head] ;get output queue head pointer } $c4/$3e/>async_obuffer_ptr/ { les di,[>async_obuffer_ptr] ;pick up output buffer address } $01/$df/ { add di,bx ;position to current character } $89/$da/ { mov dx,bx ;save previous head pointer } $43/ { inc bx ;increment head pointer } $3b/$1e/>async_obuffer_size/ { cmp bx,[>async_obuffer_size] ;see if past end of buffer } $7e/$02/ { jle send1 ;skip if not } $31/$db/ { xor bx,bx ;wrap to start of buffer } $3b/$1e/>async_obuffer_tail/ {send1: cmp bx,[>async_obuffer_tail] ;see if head collided with tail } $75/$1c/ { jne send4 ;no ── buffer didn't fill up } $8b/$0e/>async_output_delay/ { mov cx,[>async_output_delay] ;run delay loop & see if buf drains } $51/ {send2: push cx ;save milleseconds to go } $8b/$0e/>async_onemsdelay/ { mov cx,[>async_onemsdelay] ;get delay loop value for 1 ms } $e2/$fe/ {send3: loop send3 ;tight loop for 1 ms delay } $59/ { pop cx ;get back millesecond count } $3b/$1e/>async_obuffer_tail/ { cmp bx,[>async_obuffer_tail] ;see if buffer drained yet } $75/$0a/ { jne send4 ;yes ── ok, stop delay loop. } $e2/$f0/ { loop send2 ;decrement millisec count and loop } $c6/$06/>async_obuffer_overflow/{ mov byte [>async_obuffer_overflow],1 ;indicate output buf overflow } $01/$e9/$1a/$00/ { jmp send5 ;skip updating head pointers } $89/$1e/>async_obuffer_head/ {send4: mov [>async_obuffer_head],bx ;save updated head pointer } $8a/$46/<c/ { mov al,[bp+<c] ;pick up character to send } $26/$88/$05/ { es: mov [di],al ;place character in output buffer } $a1/>async_obuffer_used/ { mov ax,[>async_obuffer_used] ;get buffer use count } $40/ { inc ax ;increment buffer use count } $a3/>async_obuffer_used/ { mov [>async_obuffer_used],ax ;save new count } $3b/$06/>async_maxobufferused/ { cmp ax,[>async_maxobufferused] ;see if larger than ever before } $7e/$03/ { jle send5 ;skip if not } $a3/>async_maxobufferused/ { mov [>async_maxobufferused],ax ;save new maximum usage } $8b/$16/>async_uart_ier/ {send5: mov dx,[>async_uart_ier] ;get interrupt enable register } $ec/ { in al,dx ;check contents of ier } $a8/$02/ { test al,2 ;see if write interrupt enabled } $75/$03/ { jnz send6 ;skip if so } $0c/$02/ { or al,2 ;else enable write interrupts ... } $ee { out dx,al ;... by rewriting ier contents } ); {send6: } end; function async_receive(var c: char): boolean; begin inline( { check if any characters in input comm buffer } $a1/>async_buffer_tail/ { mov ax,[>async_buffer_tail] } $3b/$06/>async_buffer_head/{ cmp ax,[>async_buffer_head] } $75/$0b/ { jne rec1 } { buffer is empty ── return nul character } $c4/$7e/<c/ { les di,[bp+<c] ;get character address } $31/$c0/ { xor ax,ax ;clear out unused bits } $26/$88/$05/ { es: mov [di],al ;nul character } $e9/$69/$00/ { jmp return } { buffer not empty ── pick up next character. } $c4/$3e/>async_buffer_ptr/ {rec1: les di,[>async_buffer_ptr] ;pick up buffer address } $01/$c7/ { add di,ax ;add character offset } $26/$8a/$1d/ { es: mov bl,[di] ;get character from buffer } $c4/$7e/<c/ { les di,[bp+<c] ;get result address } $26/$88/$1d/ { es: mov [di],bl ;store character from buffer } $40/ { inc ax ;increment tail pointer } $3b/$06/>async_buffer_size/{ cmp ax,[>async_buffer_size] ;past end of buffer? } $7e/$02/ { jle rec2 ;no ── skip wrapping } $31/$c0/ { xor ax,ax ;yes ── point to start of buffer } $a3/>async_buffer_tail/ {rec2: mov [>async_buffer_tail],ax ;update tail pointer } $a1/>async_buffer_used/ { mov ax,[>async_buffer_used] ;pick up amount of buffer used } $48/ { dec ax ;update buffer use count } $a3/>async_buffer_used/ { mov [>async_buffer_used],ax ; } { check how empty the receive buffer is. } { we may have previously sent xoff, or dropped rts, to } { stop sender from sending. if so, and the buffer is } { now empty enough, we should re-enable the sender. } $f6/$06/>async_sender_on/ { test byte [<async_sender_on],1 ;see if sender enabled } $01/$75/$3d/ { jnz rec6 ;skip buffer tests if so } $3b/$06/>async_buffer_low/ { cmp ax,[>async_buffer_low] ;check if low enough } $7f/$37/ { jg rec6 ;still too full, skip } { buffer is reasonably empty, send xon to get things rolling again } { if xoff previously sent. } $f6/$06/>async_xoff_sent/ { test byte [<async_xoff_sent],1 ;check if xoff sent } $01/$74/$0d/ { jz rec3 ;no ── skip. } $b8/>xon/ { mov ax,>xon ;else push xon onto stack } $50/ { push ax } $ff/$1e/>async_send_addr/ { call far [>async_send_addr] ;call output routine } $c6/$06/>async_xoff_sent/ { mov byte [>async_xoff_sent],0 ;clear xoff flag } $00/ { if rts dropped because buffer was too full, enable rts. } $f6/$06/>async_do_cts/$01/ {rec3: test byte [<async_do_cts],1 ;check if cts/rts checking } $74/$08/ { jz rec4 ;no ── skip } $8b/$16/>async_uart_mcr/ { mov dx,[>async_uart_mcr] ;get modem control register } $ec/ { in al,dx } $0c/<async_rts/ { or al,<async_rts ;enable rts } $ee/ { out dx,al } { if dtr dropped because buffer was too full, enable dtr. } $f6/$06/>async_do_dsr/$01/ {rec4: test byte [<async_do_dsr],1 ;check if dsr/dtr checking } $74/$08/ { jz rec5 ;no ── skip } $8b/$16/>async_uart_mcr/ { mov dx,[>async_uart_mcr] ;get modem control register } $ec/ { in al,dx } $0c/<async_dtr/ { or al,<async_dtr ;enable dtr } $ee/ { out dx,al } $c6/$06/>async_sender_on/ {rec5: mov byte [>async_sender_on],1 ;indicate sender enabled } $01/ { indicate character found } $b8/$01/$00/ {rec6: mov ax,1 } $80/$26/>async_line_status/{return: and byte [>async_line_status],$fd ;remove overflow flag } $fd/$09/$c0/ { or ax,ax ;set zero flag to indicate return status } $89/$ec/ { mov sp,bp } $5d/ { pop bp } $ca/$04/$00 { retf 4 } ); end; procedure async_receive_with_timeout(secs: integer; var c: integer); begin inline( { check if a character in input comm buffer } $a1/>async_buffer_tail/ { mov ax,[>async_buffer_tail] } $3b/$06/>async_buffer_head/{ cmp ax,[>async_buffer_head] } $75/$29/ { jne rec1 } { buffer empty ── begin wait loop. } $8b/$46/<secs/ { mov ax,[bp+<secs] ;get seconds to wait } $b9/$0a/$00/ { mov cx,10 ;shift count = 2 ** 10 = 1024 } $d3/$e0/ { shl ax,cl ;seconds * 1024 = milleseconds } $89/$c1/ { mov cx,ax ;move to looping register } { delay for 1 ms. } $51/ {delay: push cx ;save milleseconds to go } $8b/$0e/>async_onemsdelay/ { mov cx,[>async_onemsdelay] ;get delay loop value for 1 ms } $e2/$fe/ {delay1: loop delay1 ;tight loop for 1 ms delay } { check if any character yet. } $59/ { pop cx ;get back millesecond count } $a1/>async_buffer_tail/ { mov ax,[>async_buffer_tail] } $3b/$06/>async_buffer_head/{ cmp ax,[>async_buffer_head] } $75/$0e/ { jne rec1 } { buffer still empty ── decrement elapsed time } $e2/$ed/ { loop delay ;decrement millesecond count and loop } { dropped through ── no character arrived in specified interval. } { return timeout as result. } $bb/>timeout/ { mov bx,>timeout ;pick up timeout value } $c4/$7e/<c/ { les di,[bp+<c] ;get result character address } $26/$89/$1d/ { es: mov [di],bx ;store timeout value } $e9/$68/$00/ { jmp return ;return to caller } { buffer not empty ── pick up next character. } $c4/$3e/>async_buffer_ptr/ {rec1: les di,[>async_buffer_ptr] ;pick up buffer address } $01/$c7/ { add di,ax ;add character offset } $26/$8a/$1d/ { es: mov bl,[di] ;get character from buffer } $30/$ff/ { xor bh,bh ;clear high-order bits } $c4/$7e/<c/ { les di,[bp+<c] ;get result address } $26/$89/$1d/ { es: mov [di],bx ;store character from buffer } $40/ { inc ax ;increment tail pointer } $3b/$06/>async_buffer_size/{ cmp ax,[>async_buffer_size] ;past end of buffer? } $7e/$02/ { jle rec2 ;no ── skip wrapping } $31/$c0/ { xor ax,ax ;yes ── point to start of buffer } $a3/>async_buffer_tail/ {rec2: mov [>async_buffer_tail],ax ;update tail pointer } $a1/>async_buffer_used/ { mov ax,[>async_buffer_used] ;pick up amount of buffer used } $48/ { dec ax ;update buffer use count } $a3/>async_buffer_used/ { mov [>async_buffer_used],ax ; } { check how empty the receive buffer is. } { we may have previously sent xoff, or dropped rts, to } { stop sender from sending. if so, and the buffer is } { now empty enough, we should re-enable the sender. } $f6/$06/>async_sender_on/ { test byte [<async_sender_on],1 ;see if sender enabled } $01/$75/$3d/ { jnz return ;skip buffer tests if so } $3b/$06/>async_buffer_low/ { cmp ax,[>async_buffer_low] ;check if low enough } $7f/$37/ { jg return ;still too full, skip } { buffer is reasonably empty, send xon to get things rolling again } { if xoff previously sent. } $f6/$06/>async_xoff_sent/ { test byte [<async_xoff_sent],1 ;check if xoff sent } $01/$74/$0d/ { jz rec3 ;no ── skip. } $b8/>xon/ { mov ax,>xon ;else push xon onto stack } $50/ { push ax } $ff/$1e/>async_send_addr/ { call far [>async_send_addr] ;call output routine } $c6/$06/>async_xoff_sent/ { mov byte [>async_xoff_sent],0 ;clear xoff flag } $00/ { if rts dropped because buffer was too full, enable rts. } $f6/$06/>async_do_cts/$01/ {rec3: test byte [<async_do_cts],1 ;check if cts/rts checking } $74/$08/ { jz rec4 ;no ── skip } $8b/$16/>async_uart_mcr/ { mov dx,[>async_uart_mcr] ;get modem control register } $ec/ { in al,dx } $0c/<async_rts/ { or al,<async_rts ;enable rts } $ee/ { out dx,al } { if dtr dropped because buffer was too full, enable dtr. } $f6/$06/>async_do_dsr/$01/ {rec4: test byte [<async_do_dsr],1 ;check if dsr/dtr checking } $74/$08/ { jz rec5 ;no ── skip } $8b/$16/>async_uart_mcr/ { mov dx,[>async_uart_mcr] ;get modem control register } $ec/ { in al,dx } $0c/<async_dtr/ { or al,<async_dtr ;enable dtr } $ee/ { out dx,al } $c6/$06/>async_sender_on/ {rec5: mov byte [>async_sender_on],1 ;indicate sender enabled } $01/ $80/$26/>async_line_status/{return: and byte [>async_line_status],$fd ;remove overflow flag } $fd ); end; procedure async_stuff(ch: char); var new_head: integer; begin async_buffer_ptr^[async_buffer_head] := ch; new_head := succ(async_buffer_head) mod succ(async_buffer_size); if ( (new_head = async_buffer_tail) ) then async_buffer_overflow := true else begin async_buffer_head := new_head; inc(async_buffer_used); if (async_buffer_used > async_maxbufferused) then async_maxbufferused := async_buffer_used; end; end; function async_wait_for_quiet( max_wait : longint; wait_time : longint ): boolean; var t1 : longint; w1 : longint; head : integer; begin { async_wait_for_quiet } t1 := timeofdayh; { get current time of day } { outer loop runs over maximum time to wait for quiet spell to appear } repeat { get time defining "quiet" for our purposes in 1/100th secs. } w1 := wait_time; { delay 1/100th second and then see if receive buffer head } { has changed or not. if head changed, drop through to start } { check over again. } repeat delay(10); dec(w1); until ((w1 = 0) or (head <> async_buffer_head)); { check if maximum wait time is exhausted ── quit if so. else } { if buffer head didn't change, then port is quiet, so quit. } { else keep on going. } until ( (timediffh(t1 , timeofday) > max_wait) or (head = async_buffer_head) ); { if we dropped through with the buffer head not changed, } { this means that the port is quiet. } async_wait_for_quiet := (head = async_buffer_head); end; procedure async_send_now(c: char); var timeout: word; begin port[uart_mcr + async_base] := $0b; { turn on out2, dtr, and rts } if async_do_dsr then begin { wait for dsr using busy wait } timeout := 65535; while ( ((port[uart_msr + async_base] and $20) = 0) and (timeout > 0) ) do dec(timeout); end; { wait for cts using busy wait } if async_do_cts then begin timeout := 65535; while ( ((port[uart_msr + async_base] and $10) = 0) and (timeout > 0) ) do dec(timeout); end; { wait for transmit hold register empty (thre) } if (timeout > 0) then timeout := 65535; while ( ((port[uart_lsr + async_base] and $20) = 0) and (timeout > 0) ) do dec(timeout); { send the character when port clear } inline($fa); { cli ─── disable interrupts } port[uart_thr + async_base] := ord(c); inline($fb); { sti ─── enable interrupts } end; procedure async_find_delay(var one_ms_delay: integer); const hi_timer : integer = 0 { saves high portion of timer }; lo_timer : integer = 0 { saves low portion of timer }; outcount : integer = 0 { accumulates outer loop counts }; begin inline( $31/$c0/ { xor ax,ax ;clear ax to zero } $8e/$c0/ { mov es,ax ;allow low-memory access } $c7/$06/>outcount/$00/$00/ { mov word [>outcount],0 ;clear outer loop counter } $fa/ { cli ;no interrupts while reading } $26/$8b/$0e/>$46e/ { es: mov cx,[>$46e] ;hi part of cpu timer value } $26/$8b/$16/>$46c/ { es: mov dx,[>$46c] ;lo part of cpu timer value } $fb/ { sti ;interrupts back on } $89/$0e/>hi_timer/ { mov [>hi_timer],cx ;save hi part of timer } $89/$16/>lo_timer/ { mov [>lo_timer],dx ;save low part of timer } $fa/ {loop1: cli ;no interrupts while reading } $26/$8b/$0e/>$46e/ { es: mov cx,[>$46e] ;hi part of cpu timer value } $26/$8b/$16/>$46c/ { es: mov dx,[>$46c] ;lo part of cpu timer value } $fb/ { sti ;interrupts back on } $89/$c8/ { mov ax,cx ;save cx and dx for later } $89/$d3/ { mov bx,dx } $2b/$06/>hi_timer/ { sub ax,[>hi_timer] ;subtract low order part } $1b/$1e/>lo_timer/ { sbb bx,[>lo_timer] ;subtract high order part } $74/$e6/ { je loop1 ;continue until non-0 tick difference } $89/$0e/>hi_timer/ { mov [>hi_timer],cx ;save hi part } $89/$16/>lo_timer/ { mov [>lo_timer],dx ;save low part } $b9/$6e/$00/ {loop2: mov cx,110 ;run short delay loop. } $e2/$fe/ {delay: loop delay } $fa/ { cli ;no interrupts while reading } $26/$8b/$0e/>$46e/ { es: mov cx,[>$46e] ;hi part of cpu timer value } $26/$8b/$16/>$46c/ { es: mov dx,[>$46c] ;lo part of cpu timer value } $fb/ { sti ;interrupts back on } $ff/$06/>outcount/ { inc word [>outcount] ;increment outer loop count } $2b/$0e/>hi_timer/ { sub cx,[>hi_timer] ;subtract low order part } $1b/$16/>lo_timer/ { sbb dx,[>lo_timer] ;subtract high order part } $74/$e1/ { je loop2 ;keep going if next tick not found } $a1/>outcount/ { mov ax,[>outcount] ;pick up outer loop counter } $d1/$e0/ { shl ax,1 ;* 2 = ticks for 1 ms delay } $c4/$be/>one_ms_delay/ { les di,[bp+>one_ms_delay] ;get address of result } $26/$89/$05 { es: mov [di],ax ;store result } ); end; procedure async_init( async_buffer_max : integer; async_obuffer_max: integer; async_high_lev1 : integer; async_high_lev2 : integer; async_low_lev : integer ); var i: integer; begin async_open_flag := false; { no port open yet. } async_xoff_sent := false; { no xon/xoff handling yet. } async_xoff_received := false; async_xoff_rec_display := false; async_xon_rec_display := false; async_send_xoff := false; async_sender_on := false; { sender not enabled. set up empty receive buffer } async_buffer_overflow := false; async_buffer_used := 0; async_maxbufferused := 0; async_buffer_head := 0; async_buffer_tail := 0; async_obuffer_overflow := false; { set up empty send buffer. } async_obuffer_used := 0; async_maxobufferused := 0; async_obuffer_head := 0; async_obuffer_tail := 0; { set default wait time for output; buffer to drain when it fills up.} async_output_delay := 500; { no modem or line errors yet. } async_line_status := 0; async_modem_status := 0; async_line_error_flags := 0; { get buffer sizes } if (async_buffer_max > 0) then async_buffer_size := async_buffer_max - 1 else async_buffer_size := 4095; if (async_obuffer_max > 0) then async_obuffer_size := async_obuffer_max - 1 else async_obuffer_size := 1131; { get receive buffer overflow; check-points. } if (async_low_lev > 0) then async_buffer_low := async_low_lev else async_buffer_low := async_buffer_size div 4; if (async_high_lev1 > 0) then async_buffer_high := async_high_lev1 else async_buffer_high := (async_buffer_size div 4) * 3; if (async_high_lev2 > 0) then async_buffer_high_2 := async_high_lev2 else async_buffer_high_2 := (async_buffer_size div 10) * 9; { allocate buffers } getmem(async_buffer_ptr, async_buffer_size + 1); getmem(async_obuffer_ptr, async_obuffer_size + 1); { no uart addresses defined yet } async_uart_ier := 0; async_uart_iir := 0; async_uart_msr := 0; async_uart_lsr := 0; async_uart_mcr := 0; { set default port addresses; and default irq lines } for i := 1 to maxcomports do begin com_base[i] := default_com_base [i]; com_irq [i] := default_com_irq [i]; com_int [i] := default_com_int [i]; end; { get the delay loop value for 1 ms delay loops. } { you should turn off time sharing if running under a multitasker } { to get an accurate delay loop value. if mtask is $defined, } { then the calls to the ECOMDOS routines for interfacing with } { multitaskers will be generated. } {$IFDEF MTASK} if timesharingactive then turnofftimesharing; {$ENDIF} async_find_delay(async_onemsdelay); {$IFDEF MTASK} if timesharingactive then turnontimesharing; {$ENDIF} end; function async_carrier_detect: boolean; begin async_carrier_detect := odd(port[uart_msr + async_base] shr 7) or async_hard_wired_on; end; function async_carrier_drop: boolean; begin async_carrier_drop := not( odd(port[ uart_msr + async_base ] shr 7) or async_hard_wired_on ); end; procedure async_term_ready(ready_status: boolean); var mcr_value: byte; begin mcr_value := port[uart_mcr + async_base]; if odd(mcr_value) then mcr_value := mcr_value - 1; if ready_status then mcr_value := mcr_value + 1; port[ uart_mcr + async_base ] := mcr_value; async_clear_errors; end; function async_buffer_check: boolean; begin async_buffer_check := (async_buffer_head <> async_buffer_tail); end; function async_line_error(var error_flags: byte): boolean; begin async_line_error := (async_line_error_flags <> 0); error_flags := async_line_error_flags; async_line_error_flags := 0; end; function async_ring_detect: boolean; begin async_ring_detect := odd(port[uart_msr + async_base] shr 6); end; procedure async_send_break; var old_lcr : byte; break_lcr: byte; begin old_lcr := port[ uart_lcr + async_base ]; break_lcr := old_lcr; if break_lcr > 127 then break_lcr := break_lcr - 128; if break_lcr <= 63 then break_lcr := break_lcr + 64; port[ uart_lcr + async_base ] := break_lcr; delay(async_break_length * 10); port[ uart_lcr + async_base ] := old_lcr; end; procedure async_send_string(s: string); var i: integer; begin for i := 1 to length(s) do async_send(s[i]) end; procedure async_send_string_with_delays( s : string; char_delay: integer; eos_delay : integer ); var i: integer; begin if char_delay <= 0 then async_send_string(s) else for i :=1 to length(s) do begin async_send(s[i]);delay(char_delay) end; if eos_delay > 0 then delay(eos_delay); end; function async_percentage_used: real; begin async_percentage_used := async_buffer_used / (async_buffer_size + 1); end; procedure async_purge_buffer; var c: char; l: integer; begin l := 10000 div async_baud_rate; if l <= 0 then l := 3; repeat delay(l) until (not async_receive(c)); end; function async_peek(nchars: integer): char; var i: integer; begin i := (async_buffer_tail + nchars) mod async_buffer_size; if (i > async_buffer_head) then async_peek := chr(0) else async_peek := async_buffer_ptr^[ i ]; end; procedure async_setup_port( comport : integer; base_address : integer; irq_line : integer; int_numb : integer ); var port_offset: integer; begin if ((comport > 0) and (comport <= maxcomports)) then begin if (base_address = -1) then base_address := default_com_base[comport]; if (irq_line = -1) then irq_line := default_com_irq[comport]; if (int_numb = -1) then int_numb := default_com_int[comport]; com_base[comport] := base_address; com_irq[comport] := irq_line; com_int[comport] := int_numb; port_offset := rs232_base + (pred(comport) shl 1); memw[$0:port_offset] := base_address; end; end; procedure async_release_buffers; begin { if port open, close it down first. } if async_open_flag then async_close(false); freemem(async_buffer_ptr, async_buffer_size + 1); freemem(async_obuffer_ptr, async_obuffer_size + 1); end; procedure async_flush_output_buffer; begin async_obuffer_head := async_obuffer_tail; async_obuffer_used := 0; end; procedure async_drain_output_buffer(max_wait_time: integer); var t1: longint; begin t1 := timeofday; while( (async_obuffer_head <> async_obuffer_tail) and (timediff(t1 , timeofday) <= max_wait_time) ) do {$IFDEF MTASK} giveuptime(1); {$ELSE} ; {$ENDIF} end; function async_port_address_given(com_port: integer): boolean; var port_offset: integer; begin if ((com_port > 0) and (com_port < maxcomports)) then begin port_offset := rs232_base + (pred(com_port) shl 1); async_port_address_given := (memw[$0:port_offset] <> 0); end else async_port_address_given := false; end; function yesno(st: string): boolean; var c: char; begin writeln(st); repeat c :=readkey until upcase(c) in ['Y','N']; if upcase(c)='Y' then yesno :=true else yesno :=false; end; procedure send_modem_command(modem_text: string); {----------------------------------------------------------------------} { remarks: } { } { if the string to be sent has not "Wait For" markers, then } { it is sent in its entirety in one call here. if there are } { "Wait For" characters, then the flag waitstring_mode is set } { true, script_when_text is set to the character to be found, } { and script_when_reply_text is set to the remainder of the } { function key string. this allows the terminal emulation to } { properly process any received characters while pibterm is } { waiting for the selected string to appear. } { } {----------------------------------------------------------------------} var i : integer; l : integer; ch : char; mo_char : char; done : boolean; begin { send_modem_command } l := length(modem_text); i := 1; done := false; while(i <= l) and (not done) do begin mo_char :=modem_text[i]; if mo_char = fk_cr then async_send_now(chr(cr)) else if mo_char = fk_delay then delay(one_second_delay) else if mo_char = fk_wait_for then begin { wait for } { inc(i); if (i<=l) then begin with script_wait_list[1] do begin new(wait_text); if (wait_text<>nil) then wait_text^ :=modem_text[i]; new(wait_reply); inc(i); if (wait_reply<>nil) then begin if (i<=l) then wait_reply^ :=copy(modem_text,i,succ(l-i)) end else wait_reply^ :=''; script_wait_check_length :=1; end; end; script_wait_count :=1; waitstring_mode :=true; really_wait_string :=true; script_wait_time :=script_default_wait_time; if (script_wait_time<=0) then script_wait_time :=60; script_wait_failure :=0; done :=true; script_wait_start :=timeofday; } end else if mo_char = fk_ctrl_mark then begin if ((i+2)<=l) then if (modem_text[succ(i)] = '''') then inc(i,2); async_send_now(modem_text[i]); end else begin async_send_now(modem_text[i]); if (modem_command_delay>0) then delay(modem_command_delay); end; inc(i); end; end; function set_params(first_time: boolean): boolean; var i: integer; begin { set_params } if first_time then begin for i := 1 to maxcomports do async_setup_port( i, default_com_base[i], default_com_irq[i], default_com_int[i] ); async_init(async_buffer_length, async_obuffer_length, 0, 0, 0); if ((async_buffer_ptr = nil) or (async_obuffer_ptr = nil)) then set_params := false else set_params := async_open( comm_port, baud_rate, parity, data_bits, stop_bits ); end else begin set_params :=true; if reset_comm_port then async_reset_port( comm_port, baud_rate, parity, data_bits, stop_bits ); end; async_do_cts := check_cts; { reset cts check on/off } async_do_dsr := check_dsr; { reset dsr check on/off } async_do_xonxoff := do_xon_xoff_checks; { reset xon/xoff check on/off } async_ov_xonxoff := do_xon_xoff_checks; async_hard_wired_on := hard_wired; { reset hard-wired status } async_break_length := break_length; { reset break length } end; {████████████████████████████████████████████████████████████████████████} procedure initialize_modem; var done_flag: boolean; f : text; ch : char; do_init : boolean; function modem_connected: boolean; var start_time: longint; timed_out: boolean; begin port[uart_mcr+async_base] :=$0b;{ turn on out2, dtr, and rts } async_clear_errors; { clear pending async errors } start_time :=timeofday; { wait for dsr using busy wait } timed_out :=false; if async_do_dsr then begin while ( (not timed_out) and ((port[uart_msr+async_base] and $20)=0) ) do timed_out :=(timediff(start_time,timeofday) > 2); if timed_out then if attended_mode then begin async_do_dsr := yesno( '*** Data Set ready Doesn''t Work, turn it off (Y/N) ? ' ); timed_out :=async_do_dsr; end else writeln('*** Data Set ready turned off.'); end; start_time :=timeofday; { wait for cts using busy wait } if async_do_cts then begin while ( (not timed_out) and ((port[uart_msr+async_base] and $10) = 0) ) do timed_out :=(timediff(start_time , timeofday) > 2); if timed_out then if attended_mode then begin async_do_cts := yesno( '*** Clear To send Doesn''t Work, turn it off (Y/N) ? ' ); timed_out :=async_do_cts; end else writeln('*** Clear To sEnd turned off.'); end; { wait for transmit hold register empty (thre) } start_time := timeofday; while ( (not timed_out) and ((port[uart_lsr+async_base] and $20) = 0) ) do timed_out :=(timediff(start_time , timeofday) > 2); { if we looped through, modem probably not connected. } modem_connected := (not timed_out); end; begin { ensure correct setting of carrier detect status variables. } current_carrier_status := async_carrier_detect; new_carrier_status := current_carrier_status; { check status of hardware lines } if (not modem_connected) then begin if (not hard_wired) then begin writeln('*** Modem appears to be turned off.'); writeln('*** Please turn it on and then hit any key to continue.'); end else begin writeln('*** Hard-wired connection may be bad.'); writeln('*** You may want to turn off CTS And DSR checking.'); writeln('*** Hit any key to continue.'); end; if attended_mode then begin ch := readkey; if (ch=#0) and keypressed then ch := readkey; end else writeln('*** Continuing anyway because of unattended mode.'); end; { issue modem initialization string } if (modem_init<>'') and (not hard_wired) then begin if async_carrier_detect then begin writeln('*** Session appears to be already in progress.'); if attended_mode then begin do_init := yesno('*** Send modem initialization anyway (Y/N) ? '); end else begin writeln('*** Modem initialization not performed.'); do_init := false; end; end else do_init :=true; if do_init then begin {writeln('Modem initialization: ',write_ctrls(modem_init));} send_modem_command(modem_init); delay(one_second_delay); async_purge_buffer; end; end; end; {unit}begin { default communications parameters } async_do_cts := false; async_do_dsr := false; async_hard_wired_on := false; async_break_length := 500; async_do_xonxoff := true; async_ov_xonxoff := true; async_buffer_length := 4096; async_obuffer_length := 1132; { port addresses of each com port } default_com_base[1] := com1_base; default_com_base[2] := com2_base; default_com_base[3] := com3_base; default_com_base[4] := com4_base; { irq line for each port } default_com_irq [1] := com1_irq; default_com_irq [2] := com2_irq; default_com_irq [3] := com3_irq; default_com_irq [4] := com4_irq; { pick up address of send-a-character routine, which is used by inline } { code. } async_send_addr := addr(async_send); {happy}end.