Google
 

Trailing-Edge - PDP-10 Archives - bb-h138f-bm - 7-sources/faoput.bli
There are 3 other files named faoput.bli in the archive. Click here to see a list.
!++
!	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1986.
!	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.
!--

! Declare $FAO_PUT macro for BLISS-36

MACRO  $FAO_PUT (indent, faostring) [] = 

    ! This MACRO is intended to provide an easier interface to the $FAO
    ! system service.  Using this, a control string, and the FAO arguments
    ! to that string are given.  If the FAO service completes successfully,
    ! the formatted ASCII text is printed on SYS$OUTPUT.  If not, the error
    ! status from $FAO is returned, and no text is printed.   The indent
    ! parameter will be used to determine how many <tabs> to place in front
    ! of the FAO control string.  This will be from one to n "!_" prefixing
    ! the string argument given.  (Note that indent is treated as a value
    ! and not an address)

BEGIN

     OWN
        fao_text : VECTOR [CH$ALLOCATION (255)],
        fao_len,
        fao_desc : $STR_DESCRIPTOR (STRING = (255, CH$PTR (fao_text))),
        control : $STR_DESCRIPTOR (CLASS = DYNAMIC),
        terminal : $XPO_IOB ();

    $STR_DESC_INIT (DESCRIPTOR = control, CLASS = DYNAMIC);

    ! Proper indentation...
    IF indent GTR 0
       THEN INCR idx FROM 1 TO indent
	    DO $STR_APPEND (string = '!_', TARGET = control);
		         
    $STR_APPEND (string = faostring, target = control);

    fao_len = 0;
    $FAO (control, fao_len, fao_desc, %REMAINING);
    fao_desc [STR$H_LENGTH] = .fao_len;

    $XPO_OPEN (IOB = terminal, FILE_SPEC = $XPO_OUTPUT);

    ! Print the string
    $XPO_PUT (IOB = terminal, STRING = fao_desc);
    fao_desc [STR$H_LENGTH] = 255;
    $XPO_FREE_MEM (STRING = control);

    $XPO_CLOSE (IOB = terminal);

END%;