Google
 

Trailing-Edge - PDP-10 Archives - BB-X117B-SB_1986 - 10,7/tkb36/misc.bli
There are 4 other files named misc.bli in the archive. Click here to see a list.
!<REL4A.TKB-VNP>MISC.BLI.6,  3-Dec-79 14:34:50, Edit by SROBINSON
MODULE MISC (					!MISCELLANEOUS
		IDENT = 'X2.0'
		) =
BEGIN
!
!
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1980,1981,1982,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 WHICH IS NOT SUPPLIED BY DIGITAL.
!
!

!++
! FACILITY: TKB-20 AND VNP-20
!
! ABSTRACT:
!
!
! THIS MODULE PROVIDES SEVERAL MISCELLANEOUS SERVICES
!
!
! ENVIRONMENT: TOPS-20 USER MODE
!
! AUTHOR: J. SAUTER, CREATION DATE: 14-DEC-77
!
! MODIFIED BY:
!
!	Scott G. Robinson, 13-JUN-79 : VERSION X0.2
!	- Make a Call to ERROR fatal
!-----------------------------------------------------------------------
!
!	Scott G. Robinson, 3-DEC-79 : Version X2.0
!	- Ensure DECnet-10 Compatibility
!
!	, : VERSION
! 01	-
!--

!<BLF/PAGE>
!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
    ERROR : NOVALUE,				!PROGRAMMING ERROR
    R50TOA : NOVALUE,				!RADIX50_11 TO ASCII
    RX50,					!ASCII CHAR TO RADIX50
    ATOR50 : NOVALUE;				!ASCII TO RADIX50_11

!
! INCLUDE FILES:
!
!
! MACROS:
!
!	NONE
!
! EQUATED SYMBOLS:
!

LITERAL
    DEBUG = 0;

!
! OWN STORAGE:
!

OWN
    ERR_FLAG : INITIAL (0);

!
! EXTERNAL REFERENCES:
!

EXTERNAL ROUTINE
    FND_CHAIN,					!FIND A BLOCK IN A CHAIN
    OUTPUT : NOVALUE,				!WRITE ON A FILE
    OUTSTR : NOVALUE,				!WRITE A STRING ON A FILE
    PCRLF : NOVALUE,				!SEND CRLF TO A FILE
    STOP_PROGRAM : NOVALUE;			!TERMINATE EXECUTION

GLOBAL ROUTINE ERROR (MESSAGE) : NOVALUE = 	!SIGNAL A PROGRAMMING ERROR

!++
! FUNCTIONAL DESCRIPTION:
!
!	PRINT A MESSAGE DUE TO A PROGRAMMING ERROR IN TKB-20
!	TERMINATE THE PROGRAM AFTERWARDS
!
! FORMAL PARAMETERS:
!
!	MESSAGE - POINTER TO THE STRING DESCRIBING THE ERROR
!
! IMPLICIT INPUTS:
!
!	ERR_FLAG
!
! IMPLICIT OUTPUTS:
!
!	ERR_FLAG
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    IF (.ERR_FLAG EQL 0)
    THEN
	BEGIN
	ERR_FLAG = 1;
	PCRLF (0);
	OUTPUT (0, %C'?');
	OUTSTR (0, .MESSAGE);
	END;

    STOP_PROGRAM ();
    END;

GLOBAL ROUTINE R50TOA (R50, ASCVAL) : NOVALUE = 	!CONVERT RADIX50 TO ASCII

!++
! FUNCTIONAL DESCRIPTION:
!
!	CONVERT PDP-11 FORMAT RADIX50 TO ASCII
!
! FORMAL PARAMETERS:
!
!	R50 - 32 BITS OF PDP-11 FORMAT RADIX50
!	ASCVAL - 7-CHARACTER STRING OF RESULTING ASCIZ
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    MAP
	ASCVAL : REF VECTOR [CH$ALLOCATION (7)];

    LOCAL
	ASCPTR,
	CHAR,
	TEMP1,
	TEMP2;

    ASCVAL [0] = 0;
    ASCVAL [1] = 0;
    ASCPTR = CH$PTR (ASCVAL [0], 5);

    INCR WORD_NUMBER FROM 0 TO 1 DO
	BEGIN
	TEMP1 = .R50<(IF (.WORD_NUMBER EQL 0) THEN 0 ELSE 16), 16>;

	INCR CHAR_NUMBER FROM 1 TO 3 DO
	    BEGIN
	    TEMP2 = .TEMP1 MOD %O'50';
	    TEMP1 = .TEMP1/%O'50';
	    CHAR = (CASE .TEMP2 FROM 0 TO (%O'50' - 1) OF
		SET
		[0] : %C' ';
		[1 TO 26] : %C'A' + (.TEMP2 - 1);
		[27] : %C'$';
		[28] : %C'.';
		[29] : %C'&';			!ACTUALLY UNDEFINED
		[30 TO 39] : %C'0' + (.TEMP2 - 30);
		[OUTRANGE] : %C'&';		!SHOULD NEVER HAPPEN
		TES);
	    CH$WCHAR (.CHAR, .ASCPTR);
	    ASCPTR = CH$PLUS (.ASCPTR, -1);
	    END;				!OF INCR CHARACTER

	END;					!OF INCR WORD

    CH$WCHAR (0, CH$PTR (ASCVAL [0], 6));	!APPEND 0 TO MAKE ASCIZ
    END;					!OF R50TOA

GLOBAL ROUTINE RX50 (CHAR) = 			!CONVERT ASCII CHAR TO RADIX50

!++
! FUNCTIONAL DESCRIPTION:
!
!	CONVERT ASCII CHARACTER TO RADIX50_11
!	 NULLS ARE CONVERTED TO SPACES.
!
! FORMAL PARAMETERS:
!
!	CHAR - ASCII CHARACTER
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	THE RADIX50 VALUE OF THE CHARACTER
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    SELECTONE .CHAR OF
	SET

	[%C' ', 0] :
	    0;

	[%C'A' TO %C'Z'] :
	    .CHAR + %O'1' - %C'A';

	[%C'$'] :
	    %O'33';

	[%C'.'] :
	    %O'34';

	[%C'0' TO %C'9'] :
	    .CHAR + %O'36' - %C'0';

	[%C'a' TO %C'z'] :
	    .CHAR + %O'1' - %C'a';

	[OTHERWISE] :
	    %O'35';
	TES

    END;					!OF RX50

GLOBAL ROUTINE ATOR50 (ASCVAL, R50) : NOVALUE = 	!CONVERT ASCII TO RADIX50

!++
! FUNCTIONAL DESCRIPTION:
!
!	CONVERT ASCII TO RADIX50_11
!
! FORMAL PARAMETERS:
!
!	ASCVAL - SIX CHARACTERS OF ASCII
!	R50 - POINTER TO VECTOR OF LENGTH 4 TO RECEIVE BYTES
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    MAP
	ASCVAL : REF VECTOR [CH$ALLOCATION (7)],
	R50 : REF VECTOR [4];

    LOCAL
	ASCPTR,
	CHAR1,
	CHAR2,
	CHAR3,
	R50_INDEX,
	TEMP;

    ASCPTR = CH$PTR (.ASCVAL, -1);
    R50_INDEX = 0;

    INCR COUNTER FROM 0 TO 1 DO
	BEGIN
	CHAR1 = CH$A_RCHAR (ASCPTR);
	CHAR2 = CH$A_RCHAR (ASCPTR);
	CHAR3 = CH$A_RCHAR (ASCPTR);
	TEMP = (((RX50 (.CHAR1)*%O'50') + RX50 (.CHAR2))*%O'50') + RX50 (.CHAR3);
	R50 [.R50_INDEX] = .TEMP<0, 8>;
	R50_INDEX = .R50_INDEX + 1;
	R50 [.R50_INDEX] = .TEMP<8, 8>;
	R50_INDEX = .R50_INDEX + 1;
	END;

    END;					!OF ATOR50

END

ELUDOM