(* Communications library for Turbo Pascal. This library is designed to simplify porting communications related operations to other micros by providing standard communications procedures and functions. This library is for DEC Rainbow 100 (MSDOS). It supports communications on AUX and PRINTER ports . No parity or baud rate settings are allowed. On the Rainbow these routines will allow a connect mode at or near 9600 baud, if delays are minimized in the calling program. These routines were written by Jeff Duncan. If there are problems or comments, I can be reached at (617) 839-5673 (evenings) or as LSM.DUNCAN at DEC-MARLBORO. MSDOS-modifications by B.Eiben (MARKET::EIBEN) *) (*--------------------------------------------------------------*) type c__Regs = Record case Integer of 1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : INTEGER); 2: (AL,AH,BL,BH,CL,CH,DL,DH : Char); end; c__IOCtl_pack = Record { IO-Control-Block for Extended IO functions } sub_func : Byte; func_ret_code : Byte; io_char : Char; char_stat : Byte; buffer : Array[0..255]of Byte; end; c__ports = (port_not_set, default, aux, printer); (* possible port settings *) c__port_names = array[0..4] of string[10]; (* number of possible ports + 1 for null terminator *) c__bauds = (baud_not_set, baud_default); (* possible baud rates *) c__baud_names = array[0..2] of string[10]; (* number of possible baud rates + 1 for null terminator *) c__parities = (parity_not_set, parity_default); (* possible parity values *) c__parity_names = array[0..2] of string[10]; (* parity names *) (* number of possible parity settings + 1 for null terminator *) c__port_record = record c_baud : integer; c_parity : integer; end; (* record *) const c_lib_version = 'DEC Rainbow (MSDOS) - Rev. 0.1 - 22 April 1985'; c_port_str : c__port_names = ('NOT SET', 'DEFAULT', 'AUX', 'PRINTER', ''); (* port names + null at end for terminator *) c_baud_str : c__baud_names = ('NOT SET', 'DEFAULT', ''); (* baud rate names + null at end for terminator *) c_parity_str : c__parity_names = ('NOT SET', 'DEFAULT', ''); (* parity names + null at end for terminator *) var c__Registers : c__Regs; { Register definitions } c__Save : c__Regs ; { Save Registers over Firmware Call } c__IOCtl : c__IOCtl_pack; { IO Control-Block } c__port_var : c__ports; (* list of ports available *) c__parity_var : c__parities; c__baud_var : c__bauds; c__port_values : array[c__ports] of c__port_record; (* variables available for use by main program. *) c_comm_char : char; (* returned comm port character *) c_kbd_char : char; (* returned keyboard character *) c_current_port : integer; (* number of the currently selected port *) c_current_baud : integer; (* baud rate on selected port *) c_current_parity : integer; (* parity of selected port *) (*--------------------------------------------------------------*) function c_set_port(port : integer) : boolean; (* Set the communications port to the desired port. Number of the port is entered. 0 is port not set, for initializing reasons, 1 is default port, comm (or reader), also for initializing. 2 is AUX, and 3 is PRINTER. If an invalid port is set, the port does not change. If no port had been previously set, AUX is set as port. *) var good : boolean; procedure set_reader; (* set port as reader/punch *) begin c__port_var := AUX; c_current_port := 2; good := true; end; begin case port of 1, 2 : set_reader; (* use reader for default or AUX *) 3 : begin c__port_var := PRINTER; c_current_port := 3; good := true; end; else good := false; end; (* case *) if good then c_set_port := true else begin if c__port_var = port_not_set then set_reader; c_set_port := false; end; (* set the current values for baud rate and parity. The two ports may have different characteristics. *) c_current_baud := c__port_values[c__port_var].c_baud; c_current_parity := c__port_values[c__port_var].c_parity; end; (*--------------------------------------------------------------*) function c_set_baud( baudrate : integer) : boolean; begin (* c_setbaud *) c__port_values[c__port_var].c_baud := 1; (* force default condition *) if baudrate = 1 then c_set_baud := true (* default port only is allowed *) else c_set_baud := false; (* no baud rates settable *) c_current_baud := c__port_values[c__port_var].c_baud; end; (* c_setbaud *) (*--------------------------------------------------------------*) function c_set_parity(parity : integer) : boolean; begin (* c_set_parity *) c__port_values[c__port_var].c_parity := 1; (* default value *); if parity = 1 then c_set_parity := true (* default parity only *) else c_set_parity := false; (* no other parity allowed *) c_current_parity := c__port_values[c__port_var].c_parity; end; (* c_set_parity *) (*--------------------------------------------------------------*) function c_init(port : integer; baud, parity : integer) : boolean; (* Set a communications port as selected port. This routine must ALWAYS be called at the beginning of a program or strange results will occur. If the ports have not been set before, and an invalid port is selected, the reader/punch port is selected. This is to try to prevent very odd results with initialized variables. *) var c_ok : boolean; count : integer; begin (* c_init *) for count := 1 to ord(printer) do (* initialize everthing to defaults *) with c__port_values[c__ports(count)] do begin c_baud := 1; c_parity := 1; end; (* with *) c__port_var := port_not_set; c_ok := false; if c_set_port(port) then (* try to set the port *) c_ok := true; if c_set_baud(baud) then (* try to set the baud rate *) c_ok := true; if c_set_parity(parity) then (* try to set the parity *) c_ok := true; if c_ok then (* was everything ok? *) c_init := true else c_init := false; end; (* c_init *) (*--------------------------------------------------------------*) function c_reset : boolean; (* reset any parameters required before exiting *) begin (* c_reset *) c_reset := true; (* there's nothing to do for Rainbow MSDOS *) end; (* c_reset *) (*--------------------------------------------------------------*) function c_get_comm_char : boolean; (* This function will attempt to get a new character from the previously selected communications port. It will return TRUE if a character was available, and FALSE if no character was available. The actual character is returned in the global variable 'c_comm_char'. *) begin (* c_get_comm_char *) c__IOCtl.sub_func := 7; { Read from port below/NOWAIT } c__IOCtl.buffer[0]:= c_current_port + 1; { Device Nr. } c__Registers.AX := $4402; { Sub-function } c__Registers.BX := c_current_port + 1; { Device Nr. } c__Registers.DX := OFS(C__IOCtl); c__Registers.DS := SEG(C__IOCtl); Intr($21,C__Registers); { Is there a char ? } if c__IOCtl.func_ret_code = 255 then begin c_comm_char := c__IOCtl.io_char; c_get_comm_char := true; end else c_get_comm_char := false; end; (* c_get_comm_char *) (*--------------------------------------------------------------*) procedure c_put_comm_char(c_comm_out_char : char); (* This procedure will write a byte to the selected comm port. *) begin (* c_put_comm_char *) c__IOCtl.io_char := c_comm_out_char; { Store char } c__IOCtl.sub_func := 11; { Write to port below/NOWAIT } c__IOCtl.buffer[0]:= c_current_port + 1; { Device Nr. } c__Registers.AX := $4402; { Sub-function } c__Registers.BX := c_current_port + 1; { Device Nr. } c__Registers.DX := OFS(C__IOCtl); c__Registers.DS := SEG(C__IOCtl); Intr($21,C__Registers); { Get Char. out } end; (* c_put_comm_char *) (*--------------------------------------------------------------*) function c_get_kbd_char : boolean; (* This function will attempt to get a new character from the keyboard. It will return TRUE if a character was available, and FALSE if no character was available. The actual character is returned in the global variable 'c_kbd_char'. *) begin (* c_get_kbd_char *) c__Save := c__Registers; {Save them} c__Registers.CX := 0; c__Registers.DI := 2; { Firmware Level 2 Keyboard IN } Intr(24,C__Registers); { Do we have a Char in the Buffer ? } if c__Registers.CL = chr(255) then begin c_kbd_char := c__Registers.AL; { Yes we do ! } c_get_kbd_char := true; end else c_get_kbd_char := false; c__Registers := c__Save; {and restore them} end; (* c_get_kbd_char *) (*--------------------------------------------------------------*) procedure c_put_scr_char(c_scr_out_char : char); (* write char to screen *) begin (* c_put_scr_char *) c__Save := c__Registers; {Save Them} c__Registers.AL := c_scr_out_char; c__Registers.CX := 0; c__Registers.DI := 0; { Firmware Console OUT } Intr(24,c__Registers); { Here it goes } c__Registers := c__Save; {and restore them} end; (* c_put_scr_char *) (*--------------------------------------------------------------*) Function c_send_break : boolean; (* Send a BREAK *) begin (* c_send_break *) c__IOCtl.sub_func := 15; { Transmit BREAK } c__IOCtl.buffer[0]:= c_current_port + 1; { Device Nr. } c__Registers.AX := $4402; { Sub-function } c__Registers.BX := c_current_port + 1; { Device Nr. } c__Registers.DX := OFS(C__IOCtl); c__Registers.DS := SEG(C__IOCtl); Intr($21,C__Registers); { Start BREAK } Delay (250); c__IOCtl.sub_func := 16; { Cease BREAK } c__IOCtl.buffer[0]:= c_current_port + 1; { Device Nr. } c__Registers.AX := $4402; { Sub-function } c__Registers.BX := c_current_port + 1; { Device Nr. } c__Registers.DX := OFS(C__IOCtl); c__Registers.DS := SEG(C__IOCtl); Intr($21,C__Registers); { Stop BREAK } c_send_break := true; end; (* c_send_break *)