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