Trailing-Edge
-
PDP-10 Archives
-
BB-AI48A-BM
-
datatrieve/get.bli
There are no other files named get.bli in the archive.
%TITLE 'GET PORT - A Callable Datatrieve Example'
MODULE GET (MAIN = MAINPROG) =
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
! G E T
!
!
! COPYRIGHT (c) 1984 BY
! DIGITAL EQUIPMENT CORPORATION, MAYNARD
! MASSACHUSETTS. ALL RIGHTS RESERVED.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY
! BE USED AND COPIED ONLY IN ACCORDANCE WITH THE
! TERMS OF SUCH LICENSE AND WITH THE INCLUSION OF THE
! ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE
! MADE AVAILABLE TO ANY OTHER PERSON. NO TITLE TO
! AND OWNERSHIP OF THE SOFTWARE IS HEREBY
! TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO
! CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED
! AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR
! RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS
! NOT SUPPLIED BY DIGITAL.
!
!
! FUNCTIONAL DESCRIPTION
! This module shows how records can be received from
! Datatrieve. When the caller sends a command instructing
! Datatrieve to store in a port domain, Datatrieve enters
! a DTR$K_STL_PGET stall point. The port name is included
! in the message buffer. The user program must then set the
! DAB[DAB$W_REC_LEN] and DAB[DAB$A_REC_BUF] to tell Datatrieve
! where to put the data record. DTR$GET_PORT is called to actually
! fetch the record.
!
! Note that the datatypes of the fields in the ports don't
! have to be the same as the datatypes of the fields assigned
! to the port in the store statement. Datatrieve does all
! necessary data conversion.
!
! Linking instructions:
! @LOAD GET,SYS:DTRLIB
!
! VERSION NUMBER
! 1
!
! HISTORY
!
!-----------------------------------------------------------------------
BEGIN
LIBRARY 'DABSYM'; ! Include Definitions Of The DAB
LIBRARY 'BLI:MONSYM'; ! Monitor symbols
LIBRARY 'DYNLIB'; ! Dynamic Library symbols
REQUIRE 'DAB.REQ'; ! The DAB itself
FORWARD ROUTINE
COMMAND : NOVALUE FORTRAN_FUNC,
MESSAGE : NOVALUE,
GET_PORT : NOVALUE,
MAINPROG : NOVALUE;
! Set the size of the buffers used
LITERAL
REC_LENGTH = 5;
! Get storage for global buffers
OWN
REC_BUF : VECTOR[REC_LENGTH];
! Macros for TTY IO
MACRO TTY_PUT_CRLF =
BEGIN
BUILTIN JSYS;
REGISTER AC1=1;
AC1 = %O'15';
JSYS(-1,PBOUT_,AC1);
AC1 = %O'12';
JSYS(-1,PBOUT_,AC1);
END % ;
MACRO TTY_PUT_MSG (BUFFER,LENGTH) =
IF LENGTH NEQ 0 THEN
BEGIN
BUILTIN JSYS;
REGISTER AC1=1,AC2=2,AC3=3;
AC1 = $PRIOU;
AC2 = CH$PTR(BUFFER);
AC3 = - LENGTH;
JSYS(-1,SOUT_,AC1,AC2,AC3);
END % ;
MACRO TTY_PUT_INTEGER (NUMBER) =
BEGIN
BUILTIN JSYS;
REGISTER AC1=1,AC2=2,AC3=3;
AC1 = $PRIOU;
AC2 = NUMBER;
AC3 = 10;
JSYS(1,NOUT_,AC1,AC2,AC3);
END % ;
ROUTINE GET_PORT(ADDR,LEN) : NOVALUE =
!+++++++++++++++++++++++++++++++++++++++++++++++++++
!
! G E T _ P O R T
!
! FUNCTIONAL DESCRIPTION
! When stopped at a Get Port Stall point, the following routine
! stores the record address, and calls DTR$GET_PORT in order to get
! the record.
!
! FORMAL PARAMETERS
! Address of record buffer
! Length of record buffer
!
! RETURNED VALUE
! None.
!
!------------------------------------------------------
BEGIN
DAB[DAB$W_REC_LEN] = .LEN;
IF (.DAB[DAB$W_STATE] EQL DTR$K_STL_PGET) THEN
BEGIN
DAB[DAB$A_REC_BUF] = .ADDR;
DTR$GET_PORT(DAB)
END;
END;
ROUTINE MAINPROG : NOVALUE =
!+++++++++++++++++++++++++++++++++++++++++++++++++++
!
! M A I N P R O G
!
! FUNCTIONAL DESCRIPTION
! This routine readies the domain yachts, then extracts the
! manufacturer,model and price of yachts
!
! FORMAL PARAMETERS
! None.
!
! RETURNED VALUE
! None.
!
!------------------------------------------------------
BEGIN
DY$MIN();
DTR$INIT(DAB);
COMMAND(UPLIT('READY YACHTS'),12);
MESSAGE();
COMMAND(UPLIT('DECLARE PORT PT1 01 BOAT. '),26);
MESSAGE();
COMMAND(UPLIT('02 BUILDER PIC X(10). '),22);
MESSAGE();
COMMAND(UPLIT('02 MODEL PIC X(10). '),20);
MESSAGE();
COMMAND(UPLIT('02 PRICE INTEGER. ;'),19);
MESSAGE();
COMMAND(UPLIT('FOR YACHTS STORE PT1 USING BEGIN'),32);
MESSAGE();
COMMAND(UPLIT('BUILDER = BUILDER; MODEL = MODEL;'),33);
MESSAGE();
COMMAND(UPLIT('PRICE = PRICE; END;'),19);
MESSAGE();
WHILE (.DAB[DAB$W_STATE] EQL DTR$K_STL_PGET) DO
BEGIN
GET_PORT(REC_BUF,REC_LENGTH);
IF (.REC_BUF[4] NEQ 0) THEN
BEGIN
TTY_PUT_MSG(UPLIT('Builder : '),10);
TTY_PUT_MSG(REC_BUF[0],10);
TTY_PUT_MSG(UPLIT(' Model : '),9);
TTY_PUT_MSG(REC_BUF[2],10);
TTY_PUT_MSG(UPLIT(' Price : '),9);
TTY_PUT_INTEGER(.REC_BUF[4],10,5);
TTY_PUT_CRLF;
END;
END;
MESSAGE();
END;
ROUTINE MESSAGE : NOVALUE =
!+++++++++++++++++++++++++++++++++++++++++++++++++++
!
! M E S S A G E
!
! FUNCTIONAL DESCRIPTION
! Accept messages from callable Datatrieve (all kinds)
! until Datatrieve wants something else (like a command).
!
! FORMAL PARAMETERS
! None.
!
! RETURNED VALUE
! None.
!
!------------------------------------------------------
BEGIN
WHILE ((.DAB[DAB$W_STATE] EQL DTR$K_STL_MSG) OR
(.DAB[DAB$W_STATE] EQL DTR$K_STL_LINE)) DO
BEGIN
IF (((.DAB[DAB$L_CONDITION] NEQ DTR$_SUCCESS) AND
(.DAB[DAB$L_CONDITION] NEQ DTR$_ERROR)) OR
(.DAB[DAB$W_STATE] EQL DTR$K_STL_LINE)) THEN
BEGIN
TTY_PUT_MSG(.DAB[DAB$A_MSG_BUF],.DAB[DAB$W_MSG_LEN]);
TTY_PUT_CRLF;
END;
DTR$CONTINUE(DAB);
END;
END;
ROUTINE COMMAND (PATTERN,PATTERN_LENGTH) : FORTRAN_FUNC NOVALUE =
!+++++++++++++++++++++++++++++++++++++++++++++++++++
!
! C O M M A N D
!
! FUNCTIONAL DESCRIPTION
! Formats a command line for Datatrieve and sends it.
! The pattern string contains substitution parameters which
! are filled in from later arguments. The substitution
! parameters are:
! !S - Address and length of string
! !F - Floating point number
! !I - Integer number
!
! FORMAL PARAMETERS
! Pattern string
! Length of pattern string
! .
! .
! .
!
! RETURNED VALUE
! None.
!
!------------------------------------------------------
BEGIN
BUILTIN
ACTUALCOUNT,
ACTUALPARAMETER;
LOCAL
CHAR,
PAT_PTR,
RES_PTR,
ARG_NUM;
! Set up source and destination pointers
PAT_PTR = CH$PTR(.PATTERN);
RES_PTR = CH$PTR(.DAB[DAB$A_VAL_BUF]);
ARG_NUM = 2;
! First match the command string pattern and fill in any fields starting
! with exclamation points. When the ! is encountered, the extra
! arguments are substituted in.
INCR CHARNUM FROM 1 TO .PATTERN_LENGTH DO BEGIN
CHAR = CH$RCHAR_A(PAT_PTR);
IF (.CHAR NEQ %C'!')
THEN CH$WCHAR_A(.CHAR,RES_PTR)
ELSE BEGIN
CHAR = CH$RCHAR_A(PAT_PTR);
CHARNUM = .CHARNUM + 1;
SELECTONE .CHAR OF SET
[%C'S'] : BEGIN
ARG_NUM = .ARG_NUM + 2;
RES_PTR = CH$MOVE(ACTUALPARAMETER(.ARG_NUM),
CH$PTR(ACTUALPARAMETER(.ARG_NUM - 1)),
.RES_PTR);
END;
[%C'I'] : BEGIN
BUILTIN JSYS;
REGISTER AC1=1,AC2=2,AC3=3;
AC1 = .RES_PTR;
AC2 = ACTUALPARAMETER(.ARG_NUM + 1);
AC3 = 10;
JSYS(1,NOUT_,AC1,AC2,AC3);
RES_PTR = .AC1;
ARG_NUM = .ARG_NUM + 1;
END;
[%C'F'] : BEGIN
BUILTIN JSYS;
REGISTER AC1=1,AC2=2,AC3=3;
AC1 = .RES_PTR;
AC2 = ACTUALPARAMETER(.ARG_NUM + 1);
AC3 = 0;
JSYS(1,FLOUT_,AC1,AC2,AC3);
RES_PTR = .AC1;
ARG_NUM = .ARG_NUM + 1;
END;
TES;
END;
END;
! Now show the user the command and pass it to Datatrieve
DAB[DAB$W_VAL_LEN] = CH$DIFF(.RES_PTR,CH$PTR(.DAB[DAB$A_VAL_BUF]));
TTY_PUT_MSG(.DAB[DAB$A_VAL_BUF],.DAB[DAB$W_VAL_LEN]);
TTY_PUT_CRLF;
IF (.DAB[DAB$W_STATE] EQL DTR$K_STL_CMD) THEN DTR$COMMAND(DAB);
END;
END
ELUDOM