Google
 

Trailing-Edge - PDP-10 Archives - BB-H348C-RM_1982 - swskit-v21/listings/tkb-vnp/misc.bpt
There are no other files named misc.bpt in the archive.
		DSK:MISC.XRF[4,31]               31-Aug-79 14:46

   1	!<TKB-VNP>MISC.BLI.3, 13-Jun-79 07:55:34, Edit by SROBINSON
   2	!<SAUTER.TKB20>MISC.BLI.12, 17-Nov-78 16:09:52, Edit by SROBINSON
   3	!<SAUTER.VNP20>MISC.BLI.11, 30-Sep-78 11:28:28, Edit by SROBINSON
   4	MODULE MISC (					!MISCELLANEOUS
   5			IDENT = 'X0.2'
   6			) =
   7	BEGIN
   8	!
   9	!
  10	!
  11	! COPYRIGHT (C) 1978, 1979 BY
  12	! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
  13	!
  14	!
  15	! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
  16	! ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
  17	! INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
  18	! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
  19	! OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
  20	! TRANSFERRED.
  21	!
  22	!
  23	! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
  24	! AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
  25	! CORPORATION.
  26	!
  27	! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
  28	! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
  29	!
  30	
  31	!++
  32	! FACILITY: TKB-20 AND VNP-20
  33	!
  34	! ABSTRACT:
  35	!
  36	!
  37	! THIS MODULE PROVIDES SEVERAL MISCELLANEOUS SERVICES
  38	!
  39	!
  40	! ENVIRONMENT: TOPS-20 USER MODE
  41	!
  42	! AUTHOR: J. SAUTER, CREATION DATE: 14-DEC-77
  43	!
  44	! MODIFIED BY:
  45	!
  46	!	Scott G. Robinson, 13-JUN-79 : VERSION X0.2
  47	!	- Make a Call to ERROR fatal
  48	!
  49	!	, : VERSION
  50	! 01	-
  51	!--
  52	
  53	!<BLF/PAGE>
		DSK:MISC.XRF[4,31]               31-Aug-79 14:46

  54	!
  55	! TABLE OF CONTENTS:
  56	!
  57	
  58	FORWARD ROUTINE
  59	    ERROR : NOVALUE,				!PROGRAMMING ERROR
  60	    R50TOA : NOVALUE,				!RADIX50_11 TO ASCII
  61	    RX50,					!ASCII CHAR TO RADIX50
  62	    ATOR50 : NOVALUE;				!ASCII TO RADIX50_11
  63	
  64	!
  65	! INCLUDE FILES:
  66	!
  67	!
  68	! MACROS:
  69	!
  70	!	NONE
  71	!
  72	! EQUATED SYMBOLS:
  73	!
  74	
  75	LITERAL
  76	    DEBUG = 0;
  77	
  78	!
  79	! OWN STORAGE:
  80	!
  81	
  82	OWN
  83	    ERR_FLAG : INITIAL (0);
  84	
  85	!
  86	! EXTERNAL REFERENCES:
  87	!
  88	
  89	EXTERNAL ROUTINE
  90	    FND_CHAIN,					!FIND A BLOCK IN A CHAIN
  91	    OUTPUT : NOVALUE,				!WRITE ON A FILE
  92	    OUTSTR : NOVALUE,				!WRITE A STRING ON A FILE
  93	    PCRLF : NOVALUE,				!SEND CRLF TO A FILE
  94	    STOP_PROGRAM : NOVALUE;			!TERMINATE EXECUTION
  95	
		DSK:MISC.XRF[4,31]               31-Aug-79 14:46

  96	GLOBAL ROUTINE ERROR (MESSAGE) : NOVALUE = 	!SIGNAL A PROGRAMMING ERROR
  97	
  98	!++
  99	! FUNCTIONAL DESCRIPTION:
 100	!
 101	!	PRINT A MESSAGE DUE TO A PROGRAMMING ERROR IN TKB-20
 102	!	TERMINATE THE PROGRAM AFTERWARDS
 103	!
 104	! FORMAL PARAMETERS:
 105	!
 106	!	MESSAGE - POINTER TO THE STRING DESCRIBING THE ERROR
 107	!
 108	! IMPLICIT INPUTS:
 109	!
 110	!	ERR_FLAG
 111	!
 112	! IMPLICIT OUTPUTS:
 113	!
 114	!	ERR_FLAG
 115	!
 116	! ROUTINE VALUE:
 117	!
 118	!	NONE
 119	!
 120	! SIDE EFFECTS
 121	!
 122	!	NONE
 123	!
 124	!--
 125	
 126	    BEGIN
 127	
 128	    IF (.ERR_FLAG EQL 0)
 129	    THEN
 130		BEGIN
 131		ERR_FLAG = 1;
 132		PCRLF (0);
 133		OUTPUT (0, %C'?');
 134		OUTSTR (0, .MESSAGE);
 135		END;
 136	
 137	    STOP_PROGRAM ();
 138	    END;
 139	
		DSK:MISC.XRF[4,31]               31-Aug-79 14:46

 140	GLOBAL ROUTINE R50TOA (R50, ASCVAL) : NOVALUE = 	!CONVERT RADIX50 TO ASCII
 141	
 142	!++
 143	! FUNCTIONAL DESCRIPTION:
 144	!
 145	!	CONVERT PDP-11 FORMAT RADIX50 TO ASCII
 146	!
 147	! FORMAL PARAMETERS:
 148	!
 149	!	R50 - 32 BITS OF PDP-11 FORMAT RADIX50
 150	!	ASCVAL - 7-CHARACTER STRING OF RESULTING ASCIZ
 151	!
 152	! IMPLICIT INPUTS:
 153	!
 154	!	NONE
 155	!
 156	! IMPLICIT OUTPUTS:
 157	!
 158	!	NONE
 159	!
 160	! ROUTINE VALUE:
 161	!
 162	!	NONE
 163	!
 164	! SIDE EFFECTS
 165	!
 166	!	NONE
 167	!
 168	!--
 169	
 170	    BEGIN
 171	
 172	    MAP
 173		ASCVAL : REF VECTOR [CH$ALLOCATION (7)];
 174	
 175	    LOCAL
 176		ASCPTR,
 177		CHAR,
 178		TEMP1,
 179		TEMP2;
 180	
 181	    ASCVAL [0] = 0;
 182	    ASCVAL [1] = 0;
 183	    ASCPTR = CH$PTR (ASCVAL [0], 5);
 184	
 185	    INCR WORD_NUMBER FROM 0 TO 1 DO
 186		BEGIN
 187		TEMP1 = .R50<(IF (.WORD_NUMBER EQL 0) THEN 0 ELSE 16), 16>;
 188	
 189		INCR CHAR_NUMBER FROM 1 TO 3 DO
 190		    BEGIN
 191		    TEMP2 = .TEMP1 MOD %O'50';
 192		    TEMP1 = .TEMP1/%O'50';
 193		    CHAR = (CASE .TEMP2 FROM 0 TO (%O'50' - 1) OF
 194			SET
 195			[0] : %C' ';
		DSK:MISC.XRF[4,31]               31-Aug-79 14:46

 196			[1 TO 26] : %C'A' + (.TEMP2 - 1);
 197			[27] : %C'$';
 198			[28] : %C'.';
 199			[29] : %C'&';			!ACTUALLY UNDEFINED
 200			[30 TO 39] : %C'0' + (.TEMP2 - 30);
 201			[OUTRANGE] : %C'&';		!SHOULD NEVER HAPPEN
 202			TES);
 203		    CH$WCHAR (.CHAR, .ASCPTR);
 204		    ASCPTR = CH$PLUS (.ASCPTR, -1);
 205		    END;				!OF INCR CHARACTER
 206	
 207		END;					!OF INCR WORD
 208	
 209	    CH$WCHAR (0, CH$PTR (ASCVAL [0], 6));	!APPEND 0 TO MAKE ASCIZ
 210	    END;					!OF R50TOA
 211	
		DSK:MISC.XRF[4,31]               31-Aug-79 14:46

 212	GLOBAL ROUTINE RX50 (CHAR) = 			!CONVERT ASCII CHAR TO RADIX50
 213	
 214	!++
 215	! FUNCTIONAL DESCRIPTION:
 216	!
 217	!	CONVERT ASCII CHARACTER TO RADIX50_11
 218	!	 NULLS ARE CONVERTED TO SPACES.
 219	!
 220	! FORMAL PARAMETERS:
 221	!
 222	!	CHAR - ASCII CHARACTER
 223	!
 224	! IMPLICIT INPUTS:
 225	!
 226	!	NONE
 227	!
 228	! IMPLICIT OUTPUTS:
 229	!
 230	!	NONE
 231	!
 232	! ROUTINE VALUE:
 233	!
 234	!	THE RADIX50 VALUE OF THE CHARACTER
 235	!
 236	! SIDE EFFECTS
 237	!
 238	!	NONE
 239	!
 240	!--
 241	
 242	    BEGIN
 243	
 244	    SELECTONE .CHAR OF
 245		SET
 246	
 247		[%C' ', 0] :
 248		    0;
 249	
 250		[%C'A' TO %C'Z'] :
 251		    .CHAR + %O'1' - %C'A';
 252	
 253		[%C'$'] :
 254		    %O'33';
 255	
 256		[%C'.'] :
 257		    %O'34';
 258	
 259		[%C'0' TO %C'9'] :
 260		    .CHAR + %O'36' - %C'0';
 261	
 262		[%C'a' TO %C'z'] :
 263		    .CHAR + %O'1' - %C'a';
 264	
 265		[OTHERWISE] :
 266		    %O'35';
 267		TES
		DSK:MISC.XRF[4,31]               31-Aug-79 14:46

 268	
 269	    END;					!OF RX50
 270	
		DSK:MISC.XRF[4,31]               31-Aug-79 14:46

 271	GLOBAL ROUTINE ATOR50 (ASCVAL, R50) : NOVALUE = 	!CONVERT ASCII TO RADIX50
 272	
 273	!++
 274	! FUNCTIONAL DESCRIPTION:
 275	!
 276	!	CONVERT ASCII TO RADIX50_11
 277	!
 278	! FORMAL PARAMETERS:
 279	!
 280	!	ASCVAL - SIX CHARACTERS OF ASCII
 281	!	R50 - POINTER TO VECTOR OF LENGTH 4 TO RECEIVE BYTES
 282	!
 283	! IMPLICIT INPUTS:
 284	!
 285	!	NONE
 286	!
 287	! IMPLICIT OUTPUTS:
 288	!
 289	!	NONE
 290	!
 291	! ROUTINE VALUE:
 292	!
 293	!	NONE
 294	!
 295	! SIDE EFFECTS
 296	!
 297	!	NONE
 298	!
 299	!--
 300	
 301	    BEGIN
 302	
 303	    MAP
 304		ASCVAL : REF VECTOR [CH$ALLOCATION (7)],
 305		R50 : REF VECTOR [4];
 306	
 307	    LOCAL
 308		ASCPTR,
 309		CHAR1,
 310		CHAR2,
 311		CHAR3,
 312		R50_INDEX,
 313		TEMP;
 314	
 315	    ASCPTR = CH$PTR (.ASCVAL, -1);
 316	    R50_INDEX = 0;
 317	
 318	    INCR COUNTER FROM 0 TO 1 DO
 319		BEGIN
 320		CHAR1 = CH$A_RCHAR (ASCPTR);
 321		CHAR2 = CH$A_RCHAR (ASCPTR);
 322		CHAR3 = CH$A_RCHAR (ASCPTR);
 323		TEMP = (((RX50 (.CHAR1)*%O'50') + RX50 (.CHAR2))*%O'50') + RX50 (.CHAR3);
 324		R50 [.R50_INDEX] = .TEMP<0, 8>;
 325		R50_INDEX = .R50_INDEX + 1;
 326		R50 [.R50_INDEX] = .TEMP<8, 8>;
		DSK:MISC.XRF[4,31]               31-Aug-79 14:46

 327		R50_INDEX = .R50_INDEX + 1;
 328		END;
 329	
 330	    END;					!OF ATOR50
 331	
 332	END
 333	
 334	ELUDOM
		DSK:MISC.XRF[4,31]               31-Aug-79 14:46

ASCPTR		 176	 183#	 203	 204#	 308	 315#	 320
		 321	 322
ASCVAL		 140	 173	 181#	 182#	 183	 209	 271
		 304	 315
ATOR50		  62#	 271*
CH$WCHAR	 203	 209
CHAR		 177	 193#	 203	 212	 244	 251	 260
		 263
CHAR1		 309	 320#	 323
CHAR2		 310	 321#	 323
CHAR3		 311	 322#	 323
CHAR_NUMBER	 189
COUNTER		 318
ERROR		  59	  96*
ERR_FLAG	  83	 128	 131#
FND_CHAIN	  90*
MESSAGE		  96	 134
MISC		   4#
OUTPUT		  91	 133
OUTSTR		  92	 134
PCRLF		  93	 132
R50		 140	 187	 271	 305	 324#	 326#
R50TOA		  60	 140*
R50_INDEX	 312	 316#	 324	 325#	 326	 327#
RX50		  61	 212*	 323
STOP_PROGRAM	  94	 137
TEMP		 313	 323#	 324	 326
TEMP1		 178	 187#	 191	 192#
TEMP2		 179	 191#	 193	 196	 200
WORD_NUMBER	 185	 187