-- $Source: /commtar/monoBANK/RTS/tKtc.bdy,v $ -- $Revision: 1.6 $ $Date: 88/07/07 04:08:12 $ $Author: stt $ with System; with RTS_CICS_Exceptions; package body RTS_CICS_Terminal_Control is package RCE renames RTS_CICS_Exceptions; subtype Halfword is integer range -2**15 .. 2**15-1; type Estring_Ptr is access Estring(1..Halfword'LAST); procedure Receive( Buffer : out Estring; Last : out Integer ) is procedure ASM_Read( Input_Ptr : in out Estring_Ptr; Len : out Halfword ); pragma Interface(AIE_Assembler, ASM_Read); pragma Link_Name(ASM_Read, "CIC$RCV"); Local_Ptr : Estring_Ptr; Local_Len : Halfword; Local_Last : Integer; begin begin ASM_Read(Local_Ptr, Local_Len); exception when RCE.EOC => null; -- Ignore EOC after RECEIVE end; -- exception block if Local_Len > Buffer'LENGTH then -- String was longer, just truncate for now Local_Len := Buffer'LENGTH; end if; Local_Last := Buffer'FIRST + Local_Len - 1; Buffer(Buffer'FIRST .. Local_Last) := Local_Ptr.all(1..Local_Len); Last := Local_Last; end Receive; procedure Send( Buffer : Estring; Length : Integer; Erase : Boolean ) is procedure ASM_Send( From : Estring; Len : Halfword; Erase : Boolean ); pragma Interface(AIE_Assembler, ASM_Send); pragma Link_Name(ASM_Send, "CIC$SND"); begin ASM_Send(Buffer, Halfword(Length), Erase); end Send; end RTS_CICS_Terminal_Control; -- $Cprt start$ -- -- Copyright (C) 1988 by Intermetrics, Inc. -- -- This material may be used duplicated or disclosed by or for the -- U.S. Government pursuant to the copyright license under DAR clause -- 7-104.9(a) (May 1981). -- -- This project was spnsored by the STARS Foundation -- Naval Research Laboratory, Washington DC -- -- $Cprt end$