

; Bliss-32 7.352	Saturday 22-AUG-1978 04:01:20	DBB3:[DEBUG.SRC]DBGARI.B32;6					Page 1

; Digital Equipment Corporation

;

;	0001	MODULE DBGARI ( ADDRESSING_MODE (EXTERNAL = LONG_RELATIVE),

;	0002			IDENT = '000053') =

;	0003	BEGIN

;	0004	

;	0005	!

;	0006	!			  COPYRIGHT (c) 1977 BY

;	0007	!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;	0008	!

;	0009	! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED

;	0010	! ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE

;	0011	! INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER

;	0012	! COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY

;	0013	! OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY

;	0014	! TRANSFERRED.

;	0015	!

;	0016	! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE

;	0017	! AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT

;	0018	! CORPORATION.

;	0019	!

;	0020	! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS

;	0021	! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

;	0022	!

;	0023	

;	0024	!++

;	0025	! FACILITY:	DEBUG (DBG)

;	0026	!

;	0027	! ABSTRACT:

;	0028	!	processes names, displays expressions, and writes into memory.

;	0029	!

;	0030	! ENVIRONMENT:	VAX/VMS, user mode, interrupts disabled. non-AST level.

;	0031	!

;	0032	! Version:	53

;	0033	!

;	0034	! History:

;	0035	!	Author:

;	0036	!		Carol Peters, 26 Oct 1976: Version 01

;	0037	!

;	0038	!	Modified by:

;	0039	!		Kevin Pammett, 19-jun 1978:	53

;	0040	!

;	0041	! Revision history:

;	0042	!	10	08-03-77	CP	shorten FAO calls that contain fixed ASCII strings.

;	0043	!					change SHOW_EXP to get FAO control string more efficiently.

;	0044	!	11	24-MAR-77	KGP	-DELETED COUNTED_STRING IN FAVOR OF

;	0045	!					%ASCIC.  ALSO BEGAN CHANGES FOR

;	0046	!					NEW INPUT/OUTPUT MODES.

;	0047	!	12	29-03-77	CP	remove all routines that do arithmetic calculation.

;	0048	!					these are now in the parser itself.

;	0049	!					fix SHOW_EXP so that the address of RAD_LEN_DIREC

;	0050	!					is the argument to FAO.

;	0051	!					change to single MODE format, SET_ADR_LVL

;	0052	!					becomes SET_MOD_LVL, etc.

;	0053	!					remove zero argument in call to AEXAPRE.

;	0054	!	13	30-MAR-77	KGP	-FIXED PROBLEM IN dbg$SHOW_EXP

;	0055	!					WHICH RESULTED FROM THE FACT



; Bliss-32 7.352	Saturday 22-AUG-1978 04:01:20	DBB3:[DEBUG.SRC]DBGARI.B32;6					Page 1-1

; Digital Equipment Corporation

;

;	0056	!					THAT WE COULDN'T WRITE INTO

;	0057	!					THE FORMAT BECAUSE OF PSECT

;	0058	!					ATTRIBUTES.

;	0059	!	14	31-03-77	CP	removed processing for PLUS_TOKEN from

;	0060	!					AUQUNAM.

;	0061	!	15	08-04-77	CP	added processing in AUQUNAM for

;	0062	!					a quoted string.

;	0063	!	16	09-04-77	CP	If symbol cannot be matched,

;	0064	!					call end of line routine to

;	0065	!					clean up after the error.

;	0066	!	17	11-04-77	CP	Output a warning message if

;	0067	!					the user tries to input a quoted

;	0068	!					string longer than 4 characters.

;	0069	!	18	11-04-77	CP	To compute previous location,

;	0070	!					move inline to AUQUNAM the code that was

;	0071	!					previously the routine AEXAPRE.

;	0072	!					Delete routine AQUANAM, put in parser.

;	0073	!					Delete routine SHOW_EXP, no longer

;	0074	!					used.

;	0075	!	19	20-04-77	CP	Change VAXDEB.BEG file to be

;	0076	!					dbgGEN.BEG. Also, add dbgPCT.BEG

;	0077	!					file to declare PSECTs.

;	0078	!	20	21-04-77	CP	Change MACHINE to INSTRUCTION.

;	0079	!	21	22-04-77	CP	Add require file MARTOK.BEG for

;	0080	!					token name definitions.

;	0081	!	22	29-04-77	CP	Have AUQUNAM return a value,

;	0082	!					which if false, causes the

;	0083	!					parser to return. Also, change

;	0084	!					number_token processing to pass

;	0085	!					an address in which to place the

;	0086	!					converted value, and to expect

;	0087	!					a true or false return depending

;	0088	!					on the success of the conversion.

;	0089	!	23	03-05-77	CP	Modify write_mem to accept a

;	0090	!					length argument of any value.

;	0091	!					If the mode is instruction,

;	0092	!					use a string function to write

;	0093	!					the buffer addressed by VALUE

;	0094	!					into memory.

;	0095	!	24	04-05-77	CP	In AUQUNAM, when processing a

;	0096	!					quoted string, give a string

;	0097	!					truncation whenever the length

;	0098	!					of the string is longer than the

;	0099	!					current MODE_LENGTH permits.

;	0100	!	25	16-MAY-77	KGP	-Changed the calling sequence for

;	0101	!					 write_mem so that it doesn't have

;	0102	!					 to try and make a special case out of

;	0103	!					 writing an instruction (since just

;	0104	!					 having dbg$GB_MOD_PTR[ MODE_INSTRUC ]

;	0105	!					 on does not mean that we are actually 

;	0106	!					 writing an instruction.)  

;	0107	!	26	19-may-77	KGP	-Took out the code in dbg$AUQUNAM which

;	0108	!					 didn't allow 0 as a valid dbg$GL_LAST_LOC

;	0109	!					 since we now allow examining 0.

;	0110	!	27	14-07-77	CP	In AUQUNAM, for number_tokens,



; Bliss-32 7.352	Saturday 22-AUG-1978 04:01:20	DBB3:[DEBUG.SRC]DBGARI.B32;6					Page 1-2

; Digital Equipment Corporation

;

;	0111	!					simply return the value in the

;	0112	!					address field of the lexeme string

;	0113	!					string descriptor. Since number

;	0114	!					conversion has been done in the lexical

;	0115	!					phase, this value is the numeric

;	0116	!					value. For name_token, change to

;	0117	!					process a string descriptor.

;	0118	!	28	11-09-77	CP	Convert this file to be consistent

;	0119	!					with the latest release of DBGARI.

;	0120	!	29	23-09-77	CP	In auqunam, check number_token

;	0121	!					to see whether FORTRAN_mode is

;	0122	!					set to line_mode, in which case

;	0123	!					user must be advised that this

;	0124	!					is not yet implemented.

;	0125	!	30	05-10-77	CP	Change calls to error_reprt to

;	0126	!					SIGNALs.

;	0127	!	31	11-10-77	CP	Make auqunam a NOVALUE routine.

;	0128	!					Change its name to trans_name.

;	0129	!	32	12-10-77	CP	Add routines to translate array

;	0130	!					name to absolute address and

;	0131	!					vice versa.

;	0132	!	33	01-11-77	CP	Get dbg$k_reset_prt from DBGMSG.BEG.

;	0133	!	34	07-11-77	CP	Get the user registers from a

;	0134	!					REF BLOCK structure called

;	0135	!					dbg$gl_runframe instead of from

;	0136	!					dbg$gl_uregs.

;	0137	!	35	29-11-77	CP	Process FORTRAN line numbers in

;	0138	!					dbg$trans_name.

;	0139	!	36	30-11-77	CP	In trans_name, handle real_token

;	0140	!					for FORTRAN real and floating

;	0141	!					number conversion.

;	0142	!	37	06-12-77	CP	When a value is loaded into the

;	0143	!					parse stack, if this is FORTRAN,

;	0144	!					also load the type. Call the

;	0145	!					fortran input conversion routine

;	0146	!					with two final arguments of 0.

;	0147	!					Replace real_token with

;	0148	!					singlepr_token and doublepr_token.

;	0149	!	38	15-dec-77	KGP	-Change NAME_TOKEN case of TRANS_NAME

;	0150	!					 to use PC_RULE(0) to implement the

;	0151	!					 PC-rule of %line for FORTRAN because the

;	0152	!					 old way was cumbersom and didn't work.

;	0153	!	39	28-12-77	CP	Redefine grammar tokens.

;	0154	!					Make dimensions out of bounds a not

;	0155	!					fatal problem.

;	0156	!	40	30-dec-77	KGP	-ARI now doesn't use SYMBOL_VALUE.

;	0157	!					 A few old declarations are now

;	0158	!					 not WEAK.

;	0159	!	41	04-JAN-78	DAR	Changed require file MARTOK.BEG to

;	0160	!					COMTER.BEG also changed token names to

;	0161	!					those in COMTER.BEG.

;	0162	!	42	09-MAR-78	DAR	Conditionalized out routine DBG$GETARRAYELM

;	0163	!	43	22-mar-78	KGP	-Changed TRANS_NAME so that it handles

;	0164	!					 NAME_TOKENS only in fortran line_mode.

;	0165	!					 All the old stuff is now unnecessary



; Bliss-32 7.352	Saturday 22-AUG-1978 04:01:20	DBB3:[DEBUG.SRC]DBGARI.B32;6					Page 1-3

; Digital Equipment Corporation

;

;	0166	!					 since BUILD_PATH does ALL name translation

;	0167	!					 under the new scheme.

;	0168	!					-TRANS_NAME now handles %line as it used to.

;	0169	!					 (we tell SYM_TO_VAL not to look at

;	0170	!					  globals).

;	0171	!	44	23-MAR-78	DAR	Changed call to FOR$CNV_IN_DEFG to be

;	0172	!					compatible with the new OTS.

;	0173	!	45	24-MAR-78	DAR	Added FAO parameter count to SIGNAL for

;	0174	!					DBG$_BADBUG.

;	0175	!	46	04-apr-78	KGP	-New diagnostic in GETARRAYADR which

;	0176	!					 now also returns the array's type.

;	0177	!	47	11-apr-78	KGP	-TRANS_NAME now calls BUILD_PATH for

;	0178	!					 %LINE translations instead of

;	0179	!					 doing it itself.  This allowed me to

;	0180	!					 take out several EXTERNAL declarations

;	0181	!					 that we no longer needed.

;	0182	!	48	27-APR-78	DAR	Modified require and library declarations

;	0183	!					for native build.

;	0184	!	49	19-MAY-78	DAR	The signal for DBG$_INVNUMBER passes

;	0185	!					the address of the string descrtptor

;	0186	!					The routine DBG$GETARRAYELEM is deleted.

;	0187	!	50	19-may-78	KGP	-TRANS_NAME now knows nothing about

;	0188	!					 %LINE - this moved into PAR

;	0189	!	51	06-jun-89	KGP	-New parameterized message for

;	0190	!					 invalid array dimensions

;	0191	!	52	16-jun-78	KGP	-getarrayadr now knows about vectors

;	0192	!					 of CHARACTERs, etc.

;	0193	!	53	19-jun-78	KGP	-getarrayadr now knows how to take the

;	0194	!					 default size for CHARACTERs

;	0195	!--



; Bliss-32 7.352	Saturday 22-AUG-1978 04:01:20	DBB3:[DEBUG.SRC]DBGARI.B32;6					Page 2

; Digital Equipment Corporation

;

;	0196	! INCLUDE FILES:

;	0197	!

;	0198	%IF %VARIANT		! True for TEN.

;     L 0199	%THEN

;     U 0200	LIBRARY 'NEW:STARLE';

;     U 0201	

;     U 0202	REQUIRE 'DBGPCT.REQ';

;     U 0203	REQUIRE 'DBGGEN.REQ';

;     U 0204	REQUIRE 'VXSMAC.REQ';

;     U 0205	REQUIRE 'BSTRUC.REQ';

;     U 0206	REQUIRE 'DLLNAM.REQ';

;     U 0207	REQUIRE 'COMTER.REQ';

;     U 0208	REQUIRE 'DBGMSG.REQ';

;     U 0209	REQUIRE 'DBGRST.REQ';

;     U 0210	REQUIRE 'SYSLIT.REQ';

;     U 0211	REQUIRE 'SYSSER.REQ';

;     U 0212	%ELSE

;	0213	LIBRARY 'SYS$LIBRARY:STARLET.L32';

;	0214	

;	0215	REQUIRE 'SRC$:DBGPCT.REQ';

;	0227	REQUIRE 'SRC$:DBGGEN.REQ';

;	0477	REQUIRE 'SRC$:VXSMAC.REQ';

;	0517	REQUIRE 'SRC$:BSTRUC.REQ';

;	0568	REQUIRE 'SRC$:DLLNAM.REQ';

;	0619	REQUIRE 'SRC$:COMTER.REQ';

;	0711	REQUIRE 'LIB$:DBGMSG.REQ';

;	0990	REQUIRE 'SRC$:DBGRST.REQ';

;	2137	REQUIRE 'SRC$:SYSLIT.REQ';

;	2160	REQUIRE 'SRC$:SYSSER.REQ';

;      R2163	SWITCHES LIST (SOURCE);

;      R2164	

;      R2165	EXTERNAL ROUTINE

;      R2166		dbg$fao_out;				! formats a line and outputs to the terminal

;      R2167	

;      R2168	SWITCHES LIST (NOSOURCE);

;	2213	%FI

;	2214	

;	2215	!++

;	2216	! The following compile-time conditionals control the actualization

;	2217	! of this module as language-specific or capable of multi-language

;	2218	! functions.

;	2219	!--

;	2220	LITERAL

;	2221		dbg_multi_lang	= TRUE,			! multiple languages supported

;	2222		mars_syntax	= FALSE,		! MARS syntax only

;	2223		fortran_syntax	= FALSE,		! FORTRAN syntax only

;	2224		bliss_syntax	= FALSE;		! BLISS syntax only

;	2225	

;	2226	FORWARD ROUTINE

;	2227	

;	2228	%IF dbg_multi_lang OR fortran_syntax

;     L 2229	%THEN

;	2230		dbg$getarrayadr,			! gets the address of an array element

;	2231	%FI

;	2232	



; Bliss-32 7.352	Saturday 22-AUG-1978 04:01:20	DBB3:[DEBUG.SRC]DBGARI.B32;6					Page 2-1

; Digital Equipment Corporation

;

;	2233		dbg$trans_name : NOVALUE,		! TRANSFORMS A STRING INTO A VALUE

;	2234		dbg$write_mem;				! WRITES data TO MEMORY

;	2235	

;	2236	EXTERNAL ROUTINE

;	2237		dbg$set_overs : novalue,		! Set current MODE level

;	2238		dbg$fao_put : novalue,			! Do DEBUG I/O

;	2239		dbg$out_dimensn : NOVALUE,		! display dimension info

;	2240		dbg$check_prot,				! CHECKS THE PROTECTION OF A PAGE

;	2241	

;	2242	%IF dbg_multi_lang OR fortran_syntax

;     L 2243	%THEN

;	2244		for$cnv_in_defg,			! converts a floating or real

;	2245	%FI

;	2246		dbg$cnv_d_to_f,				! converts double to single precision

;	2247		dbg$redo_prot;				! RESETS THE PROTECTION OF A PAGE TO READ ONLY

;	2248	

;	2249	

;	2250	EXTERNAL

;	2251		dbg$gb_loc_type: BYTE,			! TYPE OF LAST LOCATION EXAMINED

;	2252		dbg$gl_mc_ptr : ref MC_RECORD,		! The RST's MC chain pointer.

;	2253		dbg$gb_mod_ptr: REF VECTOR [, BYTE],	! POINTER TO CURRENT MODES

;	2254		dbg$gl_csp_ptr,				! pointer to current scope

;	2255		dbg$gl_last_loc,			! CURRENT LOCATION

;	2256		dbg$gl_last_val,			! CURRENT VALUE

;	2257		dbg$gl_runframe: REF BLOCK [, BYTE],	! pointer to current run frame

;	2258		dbg$gl_buf_siz,				! standard DEBUG I/O 

;	2259		dbg$cp_out_str : ref vector[,byte],	! standard DEBUG I/O

;	2260		dbg$gl_seman1 : VECTOR,			! FIRST SEMANTIC STACK, HOLDS TOKENS,

;	2261		dbg$gl_seman2 : VECTOR;			! second semantic stack, holds types.

;	2262	

;	2263	LITERAL

;	2264		dbg_ari		= 0,			! for debugging purposes

;	2265		dbg_ari1	= 0,			! also for debugging purposes

;	2266		dbg_ari2	= 0,			! ditto

;	2267		dbg_ari_mar	= 0,			! debugging macro

;	2268		dbg_ari3	= 0,			! debugging floating numbers

;	2269		dbg_ari4	= 0;			! array desc -> address translation



; Bliss-32 7.352	Saturday 22-AUG-1978 04:01:20	DBB3:[DEBUG.SRC]DBGARI.B32;6					Page 3

; Digital Equipment Corporation

;

;	2270	%IF dbg_multi_lang OR fortran_syntax

;     L 2271	%THEN

;	2272	

;	2273	GLOBAL ROUTINE dbg$getarrayadr (descrip_block, dimen_list, absolute_adr) =

;	2274	

;	2275	!++

;	2276	! Functional description:

;	2277	!	Find the absolute address of a single array element,

;	2278	!	CHARACTER string, CHARACTER substring, or array CHARACTER

;	2279	!	string or substring.  ("vec(i)", "string", "string(from:to)",

;	2280	!	"strings(i)" or "strings(i)(from:to)", respectively.)

;	2281	!

;	2282	!	The routine also passes back this element address (via

;	2283	!	'absolute_addr'), and then pass back the element's type

;	2284	!	(via RETURN).

;	2285	!

;	2286	! Calling sequence:

;	2287	!	CALLS #3, dbg$getarrayadr

;	2288	!

;	2289	! Inputs:

;	2290	!	descrip_block	- address of the array descriptor for the array

;	2291	!	dimen_list	- address of a nine longword vector that holds

;	2292	!			  the number of dimensions in the first location,

;	2293	!			  the dimensions of the array element in locations

;	2294	!			  two through eight, and an offset (in bytes)

;	2295	!			  for the whole array, in location nine.

;	2296	!

;	2297	! Implicit inputs:

;	2298	!	the contents of the array descriptor block

;	2299	!

;	2300	! Outputs:

;	2301	!	absolute_adr	- pointer to absolute address of the array element

;	2302	!

;	2303	! Implicit outputs:

;	2304	!	none

;	2305	!

;	2306	! Routine value:

;	2307	!	The type of the array.  (one of DSC$K_DTYPE_???)

;	2308	!

;	2309	! Side effects:

;	2310	!	SIGNALs if wrong number of dimensions, dimensions out of

;	2311	!	bounds, array descriptor is 'foreign', or CHARACTER

;	2312	!	substring designator tries to address out of bounds.

;	2313	!--

;	2314	BEGIN

;	2315	

;	2316		MAP

;	2317			descrip_block : REF BLOCK [, BYTE],

;	2318			dimen_list : REF VECTOR,

;	2319			absolute_adr : REF VECTOR;

;	2320	

;	2321		LITERAL

;	2322			max_dimensions	= 7;			! maximum number of dimensions

;	2323								! in a FORTRAN array

;	2324	



; Bliss-32 7.352	Saturday 22-AUG-1978 04:01:20	DBB3:[DEBUG.SRC]DBGARI.B32;6					Page 3-1

; Digital Equipment Corporation

;

;	2325		MACRO

;	2326			no_of_dimens	= 0%,			! offset in dimen_list to count item

;	2327			first_dimen	= 1%,			! offset to first dimension value

;	2328			array_offset	= 8%,			! offset for the entire

;	2329								!   array reference

;	2330			substring_flag	= 9%;			! 1 => substring designator given

;	2331	

;	2332	%if dbg_ari4

;     L 2333	%then

;     U 2334		$fao_tt_out('getarrayadr: class=!SB., addr=!XL, offset=!SL., len=!SL., typ=!SB.',

;     U 2335			.descrip_block[DSC$B_CLASS],.descrip_block[DSC$A_POINTER],

;     U 2336			.dimen_list[array_offset],.descrip_block[DSC$W_LENGTH],

;     U 2337			.descrip_block[DSC$B_DTYPE]);

;     U 2338	%FI

;	2339		! If the symbol we are to resolve is a CHARACTER or array-of-CHARACTER

;	2340		! reference, then we have some pre-processing to do.  Simple

;	2341		! array references skip the following code.  The check on

;	2342		! dimen_list[array_offset] is essentially a check to see if

;	2343		! a substring designator was given - like "string(from:to)"

;	2344		! or like "vec(i)(from:to)".  In either of these cases,

;	2345		! dimen_list[array_offset] contains the 'from' value.

;	2346	

;	2347		IF(  (.descrip_block[ DSC$B_CLASS ] EQL DSC$K_CLASS_S)

;	2348		   OR

;	2349		     (.dimen_list[array_offset] NEQ 0 )

;	2350		   OR

;	2351		     (.descrip_block[ DSC$B_DTYPE ] EQL DSC$K_DTYPE_T)

;	2352		  )

;	2353		THEN

;	2354			BEGIN

;	2355			LOCAL

;	2356				substring_size,

;	2357				from_character,

;	2358				to_character;

;	2359			LOCAL

;	2360					! Since the substring length is stored in the

;	2361					! MODE LENGTH field, and since we must be able

;	2362					! to reconstruct the original substring designator

;	2363					! even for error situations, we have to look

;	2364					! at this length as a SIGNED value so that

;	2365					! we can reconstruct "negative" lengths (e.g. 3:1).

;	2366				mode_signed : ref vector[,byte,signed];

;	2367	

;	2368			! If there was no substring designator "(from:to)"

;	2369			! then the default that we supply is the whole string.

;	2370			! i.e. 'from' is 1, and 'to' is the string length.

;	2371	

;	2372			IF( NOT .dimen_list[substring_flag] )

;	2373			then

;	2374				begin

;	2375				dbg$set_overs(override_mode, ascii_token);

;	2376				IF( (dbg$gb_mod_ptr[ MODE_LENGTH ] = .descrip_block[DSC$W_LENGTH]) GTR TTY_OUT_WIDTH )

;	2377				THEN

;	2378					! Don't let the line buffer overflow.

;	2379	



; Bliss-32 7.352	Saturday 22-AUG-1978 04:01:20	DBB3:[DEBUG.SRC]DBGARI.B32;6					Page 3-2

; Digital Equipment Corporation

;

;	2380					dbg$gb_mod_ptr[ MODE_LENGTH ] = TTY_OUT_WIDTH;

;	2381	

;	2382				dimen_list[array_offset] = 1;

;	2383				end;

;	2384	

;	2385			! Pick up the two character position indicators given

;	2386			! in the substring designator or supplied by default.

;	2387			! The given size is passed in MODE LENGTH.  See above.

;	2388	

;	2389			from_character = .dimen_list[array_offset];

;	2390			mode_signed = .dbg$gb_mod_ptr;

;	2391			substring_size = .mode_signed[MODE_LENGTH];

;	2392			to_character = .from_character + .substring_size -1;

;	2393	%if dbg_ari4

;     L 2394	%then

;     U 2395			$fao_tt_out('ari: from char=!SL, to char=!SL, substring size=!SL.',

;     U 2396				.from_character,.to_character,.substring_size);

;     U 2397	%FI

;	2398			! The beginning character position given in the substring

;	2399			! designator must be 1 or greater, and it must be

;	2400			! less than or equal to the maximum size of the string.

;	2401			! Likewise, the end character position must be 1 or greater,

;	2402			! and less than the string's size.  Finally, the two

;	2403			! character positions must not be 'reversed'.

;	2404	

;	2405			IF( (.from_character LSS 1 )

;	2406			   OR

;	2407			    (.from_character GTR .descrip_block[DSC$W_LENGTH] )

;	2408			   OR

;	2409			    (.to_character GTR .descrip_block[DSC$W_LENGTH] )

;	2410			   OR

;	2411			    (.from_character GTR .to_character )

;	2412			   OR

;	2413			    (.from_character GTR .descrip_block[DSC$W_LENGTH] )

;	2414			  )

;	2415			THEN

;	2416				begin

;	2417		

;	2418				! Simply output the message.

;	2419	%if dbg_ari4

;     L 2420	%then

;     U 2421				$fao_tt_out('invalid substring (!SL:!SL), was declared CHARACTER*!SL',

;     U 2422					.from_character,.to_character,.descrip_block[DSC$W_LENGTH]);

;     U 2423	%FI

;	2424				signal(DBG$_SUBSTRING, 3,.from_character,.to_character,.descrip_block[DSC$W_LENGTH]);

;	2425				! no return

;	2426				END;

;	2427	

;	2428			! All is OK.  The beginning of the CHARACTER vector

;	2429			! is all that we need thus far.  The optional

;	2430			! string offset is added later so that we can

;	2431			! handle character vectors as well as characters and vectors.

;	2432	

;	2433			absolute_adr[0] = .descrip_block[ DSC$A_POINTER ];

;	2434			END;



; Bliss-32 7.352	Saturday 22-AUG-1978 04:01:20	DBB3:[DEBUG.SRC]DBGARI.B32;6					Page 3-3

; Digital Equipment Corporation

;

;	2435	

;	2436		! For ordinary arrays, or for arrays or CHARACTER, we

;	2437		! still have to resolve the subscripting reference.

;	2438	

;	2439		IF( .descrip_block[ DSC$B_CLASS ] NEQ DSC$K_CLASS_S )

;	2440		THEN

;	2441			BEGIN

;	2442	

;	2443			! Standard array descriptors.  

;	2444	

;	2445			LOCAL

;	2446				dimen_count,				! number of dimensions

;	2447				span_block : REF VECTOR,		! pointer to block of

;	2448									! span information

;	2449				bounds_block : REF VECTOR,		! pointer to block of

;	2450									! bounds information

;	2451				poly_a,					! result of polya calculation

;	2452				constant,				! result of constant calculation

;	2453				ptr_to_dimens : REF VECTOR;		! pointer to dimension list after

;	2454									! the count item.

;	2455		

;	2456			!++

;	2457			! If the record is not of the right type, then signal and give up.

;	2458			! Also signal if this is not a FORTRAN array or if

;	2459			! not all the information required is present.

;	2460			!--

;	2461			IF (.descrip_block [dsc$b_class] NEQ dsc$k_class_a) OR

;	2462				(NOT .descrip_block [dsc$v_fl_column]) OR

;	2463				(NOT .descrip_block [dsc$v_fl_coeff]) OR

;	2464				(NOT .descrip_block [dsc$v_fl_bounds])

;	2465			THEN SIGNAL (dbg$_invarrdsc);

;	2466		

;	2467			!++

;	2468			! See whether the number of dimensions given is correct.

;	2469			! If not, SIGNAL an error and return.

;	2470			!--

;	2471			dimen_count = .dimen_list [no_of_dimens];

;	2472			IF .dimen_count NEQ .descrip_block [dsc$b_dimct]

;	2473			THEN

;	2474				begin

;	2475				local

;	2476					out_buf : vector[TTY_OUT_WIDTH,BYTE];

;	2477		

;	2478				! The message includes a re-work of the string

;	2479				! originally given in the DIMENSION statement.

;	2480		

;	2481				dbg$out_dimensn(.descrip_block,out_buf);

;	2482				signal( DBG$_INVDIM, 1, out_buf);

;	2483				! no return

;	2484				END;

;	2485		

;	2486			!++

;	2487			! Now set up pointers to the blocks that describe the spans

;	2488			! of each dimension and the bounds of each dimension.

;	2489			!--



; Bliss-32 7.352	Saturday 22-AUG-1978 04:01:20	DBB3:[DEBUG.SRC]DBGARI.B32;6					Page 3-4

; Digital Equipment Corporation

;

;	2490			span_block = descrip_block [dsc$l_m1];

;	2491			bounds_block = .span_block + (.descrip_block [dsc$b_dimct] * %UPVAL);

;	2492		

;	2493			!++

;	2494			! See whether each dimension specified is within the proper

;	2495			! bounds. If not, SIGNAL a message and get out.

;	2496			!--

;	2497			INCR count FROM 1 to .dimen_count DO

;	2498				BEGIN

;	2499				IF (.dimen_list [.count] LSS .bounds_block [(.count - 1) * 2])

;	2500					OR (.dimen_list [.count] GTR .bounds_block [((.count - 1) * 2) + 1])

;	2501				THEN

;	2502					begin

;	2503					local

;	2504						out_buf : vector[TTY_OUT_WIDTH,BYTE];

;	2505			

;	2506					! The message includes a re-work of the string

;	2507					! originally given in the DIMENSION statement.

;	2508			

;	2509					dbg$out_dimensn(.descrip_block,out_buf);

;	2510					signal( DBG$_INVDIM, 1, out_buf);

;	2511					! no return

;	2512					END;

;	2513				END;

;	2514		

;	2515			!++

;	2516			! Perform the calculation that gives the address of the array

;	2517			! element. Starting at the last dimension, add the value of

;	2518			! the dimension to a working sum, and multiply that sum by the

;	2519			! span of the dimension that precedes the current dimension.

;	2520			! Simultaneously, add the lower bound of the current

;	2521			! dimension to another working sum (called "constant"), and

;	2522			! multiple "constant" by the span of the dimension that precedes

;	2523			! the current dimension. For the final dimension (the first 

;	2524			! specified in the reference), omit the multiplications.

;	2525			!

;	2526			! The formula is

;	2527			!	( ... ( d(n) * s(n-1) + d(n-1) ) * s(n-2) + d(n-2) ... )

;	2528			!		* s(1) + d(1)

;	2529			! where "d" is dimension, and "s" is span.

;	2530			!--

;	2531			dimen_count = .dimen_count - 1;

;	2532			ptr_to_dimens = dimen_list [first_dimen];

;	2533			poly_a = 0;

;	2534			constant = 0;

;	2535			REPEAT

;	2536				BEGIN

;	2537				poly_a = .poly_a + .ptr_to_dimens [.dimen_count];

;	2538				constant = .constant + .bounds_block [.dimen_count * 2];

;	2539				dimen_count = .dimen_count - 1;

;	2540				IF .dimen_count LSS 0

;	2541				THEN EXITLOOP;

;	2542				poly_a = .poly_a * .span_block [.dimen_count];

;	2543				constant = .constant * .span_block [.dimen_count];

;	2544				END;



; Bliss-32 7.352	Saturday 22-AUG-1978 04:01:20	DBB3:[DEBUG.SRC]DBGARI.B32;6					Page 3-5

; Digital Equipment Corporation

;

;	2545	

;	2546			absolute_adr [0] = .descrip_block [dsc$a_pointer] +

;	2547				((.poly_a - .constant) * .descrip_block [dsc$w_length]);

;	2548			END;

;	2549	

;	2550		! Now see if the entire CHARACTER reference, or the entire

;	2551		! CHARACTER array reference is to be offset by a given

;	2552		! number of bytes.

;	2553	

;	2554		IF( .dimen_list[array_offset] neqa 0 )

;	2555		THEN

;	2556			BEGIN

;	2557	%if dbg_ari4

;     L 2558	%then

;     U 2559			$fao_tt_out('offsetting !XL by !SL. bytes',

;     U 2560				.absolute_adr[0],.dimen_list[array_offset]);

;     U 2561	%FI

;	2562		

;	2563			absolute_adr[0] = .absolute_adr[0] + .dimen_list[array_offset] -1;

;	2564			END;

;	2565	

;	2566	%if dbg_ari3

;     L 2567	%then

;     U 2568		$fao_tt_out('getarrayadr: type is !SB.',.descrip_block[dsc$b_dtype]);

;     U 2569	%FI

;	2570		! Return the element's type.

;	2571	

;	2572		return( .descrip_block[ dsc$b_dtype] );

;	2573		END;





							    .TITLE  DBGARI

							    .IDENT  \000053\



							    .GLOBL  DBG$_RST_BEGIN, DBG$FAO_OUT, DBG$SET_OVERS, DBG$FAO_PUT

							    .GLOBL  DBG$OUT_DIMENSN, DBG$CHECK_PROT, FOR$CNV_IN_DEFG

							    .GLOBL  DBG$CNV_D_TO_F, DBG$REDO_PROT, DBG$GB_LOC_TYPE

							    .GLOBL  DBG$GL_MC_PTR, DBG$GB_MOD_PTR, DBG$GL_CSP_PTR

							    .GLOBL  DBG$GL_LAST_LOC, DBG$GL_LAST_VAL, DBG$GL_RUNFRAME

							    .GLOBL  DBG$GL_BUF_SIZ, DBG$CP_OUT_STR, DBG$GL_SEMAN1

							    .GLOBL  DBG$GL_SEMAN2

							    .WEAK   ACCESS_CHECK



							    .PSECT  DBG$CODE,NOWRT,  SHR,  PIC,0



					 0FFC 00000 	    .ENTRY  DBG$GETARRAYADR, Save R2,R3,R4,R5,R6,R7,R8,R9,R10,R11     ; 2273

		         59 00000000G  EF  9E 00002 	    MOVAB   DBG$OUT_DIMENSN, R9					      ;

		         5A 00000000G  EF  9E 00009 	    MOVAB   DBG$GB_MOD_PTR, R10					      ;

		         5B 00000000G  00  9E 00010 	    MOVAB   LIB$SIGNAL, R11					      ;

		         5E	FF7C   CE  9E 00017 	    MOVAB   -132(SP), SP					      ;

		         53	  04   AC  D0 0001C 	    MOVL    DESCRIP_BLOCK, R3					      ; 2347

		         01	  03   A3  91 00020 	    CMPB    3(R3), #1						      ;

				       0F  13 00024 	    BEQL    1$							      ;

		         50	  08   AC  D0 00026 	    MOVL    DIMEN_LIST, R0					      ; 2349

				  20   A0  D5 0002A 	    TSTL    32(R0)						      ;



; Bliss-32 7.352	Saturday 22-AUG-1978 04:01:20	DBB3:[DEBUG.SRC]DBGARI.B32;6					Page 3-6

; Digital Equipment Corporation

;

				       06  12 0002D 	    BNEQ    1$							      ;

		         0E	  02   A3  91 0002F 	    CMPB    2(R3), #14						      ; 2351

				       71  12 00033 	    BNEQ    6$							      ;

		         52	  08   AC  D0 00035 1$:     MOVL    DIMEN_LIST, R2					      ; 2372

		         25	  24   A2  E8 00039 	    BLBS    36(R2), 3$						      ;

				       05  DD 0003D 	    PUSHL   #5							      ; 2375

				       02  DD 0003F 	    PUSHL   #2							      ;

	      00000000G  EF	       02  FB 00041 	    CALLS   #2, DBG$SET_OVERS					      ;

		         50	       6A  D0 00048 	    MOVL    DBG$GB_MOD_PTR, R0					      ; 2376

		         51	       63  3C 0004B 	    MOVZWL  (R3), R1						      ;

		    01   A0	       51  90 0004E 	    MOVB    R1, 1(R0)						      ;

		  0084   8F	       51  B1 00052 	    CMPW    R1, #132						      ;

				       05  1B 00057 	    BLEQU   2$							      ;

		    01   A0	  84   8F  90 00059 	    MOVB    #-124, 1(R0)					      ; 2380

		    20   A2	       01  D0 0005E 2$:     MOVL    #1, 32(R2)						      ; 2382

		         50	  20   A2  D0 00062 3$:     MOVL    32(R2), FROM_CHARACTER				      ; 2389

		         51	       6A  D0 00066 	    MOVL    DBG$GB_MOD_PTR, MODE_SIGNED				      ; 2390

		         51	  01   A1  98 00069 	    CVTBL   1(MODE_SIGNED), SUBSTRING_SIZE			      ; 2391

		         51	  FF A140  9E 0006D 	    MOVAB   -1(SUBSTRING_SIZE)[FROM_CHARACTER], TO_CHARACTER	      ; 2392

		         01	       50  D1 00072 	    CMPL    FROM_CHARACTER, #1					      ; 2405

				       1A  19 00075 	    BLSS    4$							      ;

	   63	         10	       00  ED 00077 	    CMPZV   #0, #16, (R3), FROM_CHARACTER			      ; 2407

				       50     0007B									      ;

				       13  19 0007C 	    BLSS    4$							      ;

	   63	         10	       00  ED 0007E 	    CMPZV   #0, #16, (R3), TO_CHARACTER				      ; 2409

				       51     00082									      ;

				       0C  19 00083 	    BLSS    4$							      ;

		         51	       50  D1 00085 	    CMPL    FROM_CHARACTER, TO_CHARACTER			      ; 2411

				       07  14 00088 	    BGTR    4$							      ;

	   63	         10	       00  ED 0008A 	    CMPZV   #0, #16, (R3), FROM_CHARACTER			      ; 2413

				       50     0008E									      ;

				       10  18 0008F 	    BGEQ    5$							      ;

		         7E	       63  3C 00091 4$:     MOVZWL  (R3), -(SP)						      ; 2424

				       03  BB 00094 	    PUSHR   #^M<R0,R1>						      ;

				       03  DD 00096 	    PUSHL   #3							      ;

			    00028110   8F  DD 00098 	    PUSHL   #164112						      ;

		         6B	       05  FB 0009E 	    CALLS   #5, LIB$SIGNAL					      ;

		    0C   BC	  04   A3  D0 000A1 5$:     MOVL    4(R3), @ABSOLUTE_ADR				      ; 2433

		         01	  03   A3  91 000A6 6$:     CMPB    3(R3), #1						      ; 2439

				       03  12 000AA 	    BNEQ    7$							      ;

				     00BE  31 000AC 	    BRW     16$							      ;

		         04	  03   A3  91 000AF 7$:     CMPB    3(R3), #4						      ; 2461

				       0F  12 000B3 	    BNEQ    8$							      ;

	   0A	    0A   A3	       05  E1 000B5 	    BBC     #5, 10(R3), 8$					      ; 2462

	   05	    0A   A3	       06  E1 000BA 	    BBC     #6, 10(R3), 8$					      ; 2463

	   09	    0A   A3	       07  E0 000BF 	    BBS     #7, 10(R3), 9$					      ; 2464

			    000281B0   8F  DD 000C4 8$:     PUSHL   #164272						      ; 2465

		         6B	       01  FB 000CA 	    CALLS   #1, LIB$SIGNAL					      ;

		         56	  08   BC  D0 000CD 9$:     MOVL    @DIMEN_LIST, DIMEN_COUNT				      ; 2471

      0B   A3	         08	       00  ED 000D1 	    CMPZV   #0, #8, 11(R3), DIMEN_COUNT				      ; 2472

				       56     000D6									      ;

				       14  13 000D7 	    BEQL    10$							      ;

				4008   8F  BB 000D9 	    PUSHR   #^M<R3,SP>						      ; 2481

		         69	       02  FB 000DD 	    CALLS   #2, DBG$OUT_DIMENSN					      ;

				       5E  DD 000E0 	    PUSHL   SP							      ; 2482



; Bliss-32 7.352	Saturday 22-AUG-1978 04:01:20	DBB3:[DEBUG.SRC]DBGARI.B32;6					Page 3-7

; Digital Equipment Corporation

;

				       01  DD 000E2 	    PUSHL   #1							      ;

			    00028240   8F  DD 000E4 	    PUSHL   #164416						      ;

		         6B	       03  FB 000EA 	    CALLS   #3, LIB$SIGNAL					      ;

	   54	         53	       14  C1 000ED 10$:    ADDL3   #20, R3, SPAN_BLOCK					      ; 2490

		         50	  0B   A3  9A 000F1 	    MOVZBL  11(R3), R0						      ; 2491

		         55	     6440  DE 000F5 	    MOVAL   (SPAN_BLOCK)[R0], BOUNDS_BLOCK			      ;

				       52  D4 000F9 	    CLRL    COUNT						      ; 2497

				       2A  11 000FB 	    BRB     13$							      ;

	   50	         52	       01  78 000FD 11$:    ASHL    #1, COUNT, R0					      ; 2499

		    F8 A540	  08 BC42  D1 00101 	    CMPL    @DIMEN_LIST[COUNT], -8(BOUNDS_BLOCK)[R0]		      ;

				       09  19 00108 	    BLSS    12$							      ;

		    FC A540	  08 BC42  D1 0010A 	    CMPL    @DIMEN_LIST[COUNT], -4(BOUNDS_BLOCK)[R0]		      ; 2500

				       14  15 00111 	    BLEQ    13$							      ;

				4008   8F  BB 00113 12$:    PUSHR   #^M<R3,SP>						      ; 2509

		         69	       02  FB 00117 	    CALLS   #2, DBG$OUT_DIMENSN					      ;

				       5E  DD 0011A 	    PUSHL   SP							      ; 2510

				       01  DD 0011C 	    PUSHL   #1							      ;

			    00028240   8F  DD 0011E 	    PUSHL   #164416						      ;

		         6B	       03  FB 00124 	    CALLS   #3, LIB$SIGNAL					      ;

	   D2	         52	       56  F3 00127 13$:    AOBLEQ  DIMEN_COUNT, COUNT, 11$				      ; 2497

				       56  D7 0012B 	    DECL    DIMEN_COUNT						      ; 2531

	   51	    08   AC	       04  C1 0012D 	    ADDL3   #4, DIMEN_LIST, PTR_TO_DIMENS			      ; 2532

				       50  D4 00132 	    CLRL    POLY_A						      ; 2533

				       58  D4 00134 	    CLRL    CONSTANT						      ; 2534

	   52	         56	       02  78 00136 	    ASHL    #2, DIMEN_COUNT, R2					      ; 2537

				     6241  9F 0013A 14$:    PUSHAB  (R2)[PTR_TO_DIMENS]					      ;

		         50	       9E  C0 0013D 	    ADDL2   @(SP)+, POLY_A					      ;

	   57	         56	       01  78 00140 	    ASHL    #1, DIMEN_COUNT, R7					      ; 2538

		         58	     6547  C0 00144 	    ADDL2   (BOUNDS_BLOCK)[R7], CONSTANT			      ;

				       56  D7 00148 	    DECL    DIMEN_COUNT						      ; 2539

				       12  19 0014A 	    BLSS    15$							      ; 2540

	   52	         56	       02  78 0014C 	    ASHL    #2, DIMEN_COUNT, R2					      ; 2542

				     6244  9F 00150 	    PUSHAB  (R2)[SPAN_BLOCK]					      ;

		         50	       9E  C4 00153 	    MULL2   @(SP)+, POLY_A					      ;

				     6244  9F 00156 	    PUSHAB  (R2)[SPAN_BLOCK]					      ; 2543

		         58	       9E  C4 00159 	    MULL2   @(SP)+, CONSTANT					      ;

				       DC  11 0015C 	    BRB     14$							      ; 2534

		         50	       58  C2 0015E 15$:    SUBL2   CONSTANT, R0					      ; 2547

		         51	       63  3C 00161 	    MOVZWL  (R3), R1						      ;

		         50	       51  C4 00164 	    MULL2   R1, R0						      ;

      0C   BC	         50	  04   A3  C1 00167 	    ADDL3   4(R3), R0, @ABSOLUTE_ADR				      ; 2546

		         50	  08   AC  D0 0016D 16$:    MOVL    DIMEN_LIST, R0					      ; 2554

				  20   A0  D5 00171 	    TSTL    32(R0)						      ;

				       0B  13 00174 	    BEQL    17$							      ;

	   50	    0C   BC	  20   A0  C1 00176 	    ADDL3   32(R0), @ABSOLUTE_ADR, R0				      ; 2563

      0C   BC	         50	       01  C3 0017C 	    SUBL3   #1, R0, @ABSOLUTE_ADR				      ;

		         50	  02   A3  9A 00181 17$:    MOVZBL  2(R3), R0						      ; 2572

					   04 00185 	    RET     							      ; 2273



; Routine Size:  390 bytes





;	2574	%FI



; Bliss-32 7.352	Saturday 22-AUG-1978 04:01:20	DBB3:[DEBUG.SRC]DBGARI.B32;6					Page 4

; Digital Equipment Corporation

;

;	2575	GLOBAL ROUTINE dbg$trans_name (semsp, lexeme_stg_desc) : NOVALUE =

;	2576	

;	2577	!++

;	2578	! Functional description:

;	2579	!	Transforms the simplest element of a DEBUG expression

;	2580	!	into a binary value. Tokens expected are digit_str_token,

;	2581	!	and the tokens for current location,

;	2582	!	last value displayed, next location, and previous location.

;	2583	!

;	2584	!	A name token is represented as a length count and a buffer

;	2585	!	address in the string descriptor. A number token is represented as

;	2586	!	a length count and a 32-bit or 64-bit precision number in

;	2587	!	the buffer address.

;	2588	!

;	2589	! Calling sequence:

;	2590	!	CALLS #2, dbg$trans_name

;	2591	!

;	2592	! Inputs:

;	2593	!	semsp		- offset in parse stack that holds the

;	2594	!			  current token.

;	2595	!	lexeme_stg_desc	- string descriptor to number or name

;	2596	!

;	2597	! Implicit inputs:

;	2598	!	current mode, last value, current location, next location

;	2599	!

;	2600	! Outputs:

;	2601	!	none

;	2602	!

;	2603	! Implicit outputs:

;	2604	!	pushes a value onto the stack in the place of the token found

;	2605	!

;	2606	! Routine value:

;	2607	!	novalue

;	2608	!

;	2609	! Side effects:

;	2610	!	none

;	2611	!--

;	2612	

;	2613		BEGIN

;	2614	

;	2615		MAP

;	2616			lexeme_stg_desc : REF BLOCK [, BYTE];

;	2617	

;	2618		BIND

;	2619			register_vector	= dbg$gl_runframe [dbg$l_user_regs] : VECTOR;

;	2620	

;	2621	%IF dbg_ari

;     L 2622	%THEN

;     U 2623		$fao_tt_out ('token is !SL', .dbg$gl_seman1 [.semsp]);

;     U 2624		IF .dbg$gl_seman1 [.semsp] NEQ digit_str_token

;     U 2625		THEN $fao_tt_out ('string is "!AS"', .lexeme_stg_desc);

;     U 2626	%FI

;	2627	

;	2628		dbg$gl_seman1 [.semsp] = (SELECTONE .dbg$gl_seman1 [.semsp] OF

;	2629	



; Bliss-32 7.352	Saturday 22-AUG-1978 04:01:20	DBB3:[DEBUG.SRC]DBGARI.B32;6					Page 4-1

; Digital Equipment Corporation

;

;	2630			SET

;	2631	

;	2632			[digit_str_token]:

;	2633				BEGIN

;	2634	

;	2635	%IF dbg_multi_lang OR fortran_syntax

;     L 2636	%THEN

;	2637				dbg$gl_seman2 [.semsp] = dsc$k_dtype_l;

;	2638	%FI

;	2639	

;	2640				.(.lexeme_stg_desc [dsc$a_pointer])

;	2641				END;

;	2642	

;	2643	

;	2644			[period_token]:

;	2645				BEGIN

;	2646	

;	2647	%IF dbg_multi_lang OR fortran_syntax

;     L 2648	%THEN

;	2649				dbg$gl_seman2 [.semsp] = dsc$k_dtype_l;

;	2650	%FI

;	2651	

;	2652				.dbg$gl_last_loc

;	2653				END;

;	2654	

;	2655	

;	2656			[up_arrow_token]:

;	2657				BEGIN

;	2658	

;	2659	%IF dbg_ari

;     L 2660	%THEN

;     U 2661				$fao_tt_out ('computing previous location');

;     U 2662	%FI

;	2663	

;	2664	%IF dbg_multi_lang OR fortran_syntax

;     L 2665	%THEN

;	2666				dbg$gl_seman2 [.semsp] = dsc$k_dtype_l;

;	2667	%FI

;	2668	

;	2669				IF .dbg$gb_loc_type EQL memory_loc

;	2670				THEN .dbg$gl_last_loc - .dbg$gb_mod_ptr [mode_length]

;	2671				ELSE

;	2672					BEGIN

;	2673	

;	2674					LOCAL

;	2675						reg_index;

;	2676	

;	2677					reg_index = (.dbg$gl_last_loc - dbg$gl_runframe [dbg$l_user_regs]) / %UPVAL;

;	2678					IF .reg_index LEQ 0

;	2679					THEN dbg$gl_runframe [dbg$l_user_r0]

;	2680					ELSE register_vector [.reg_index - 1]

;	2681					END

;	2682				END;

;	2683	

;	2684	



; Bliss-32 7.352	Saturday 22-AUG-1978 04:01:20	DBB3:[DEBUG.SRC]DBGARI.B32;6					Page 4-2

; Digital Equipment Corporation

;

;	2685			[backslash_token]:

;	2686				BEGIN

;	2687	

;	2688	%IF dbg_multi_lang OR fortran_syntax

;     L 2689	%THEN

;	2690				dbg$gl_seman2 [.semsp] = dsc$k_dtype_l;

;	2691	%FI

;	2692	

;	2693				.dbg$gl_last_val

;	2694				END;

;	2695	

;	2696	

;	2697	%IF dbg_multi_lang OR fortran_syntax

;     L 2698	%THEN

;	2699			[single_fl_token, double_fl_token]:

;	2700				BEGIN

;	2701	

;	2702				LOCAL

;	2703					status,

;	2704					value : VECTOR [2];

;	2705	

;	2706				value [0] = 0;

;	2707				value [1] = 0;

;	2708				status = for$cnv_in_defg (.lexeme_stg_desc, value);

;	2709				IF NOT .status

;	2710				THEN

;	2711					BEGIN

;	2712	

;	2713	%IF dbg_ari

;     L 2714	%THEN

;     U 2715					$fao_tt_out ('cnv_in_defg failed, status is !XL', .status);

;     U 2716	%FI

;	2717	

;	2718					SIGNAL (dbg$_invnumber, 1, .lexeme_stg_desc);

;	2719					RETURN

;	2720					END;

;	2721				IF .dbg$gl_seman1 [.semsp] EQL single_fl_token

;	2722				THEN

;	2723					BEGIN

;	2724					dbg$cnv_d_to_f (value);

;	2725					dbg$gl_seman1 [.semsp + 1] = 0;

;	2726					dbg$gl_seman2 [.semsp] = dsc$k_dtype_f;

;	2727	

;	2728	%IF dbg_ari3

;     L 2729	%THEN

;     U 2730					$fao_tt_out ('single, value is !XL!XL, type is !SL',

;     U 2731						.value [1], .value [0], .dbg$gl_seman2 [.semsp]);

;     U 2732	%FI

;	2733	

;	2734					END

;	2735				ELSE

;	2736					BEGIN

;	2737					dbg$gl_seman1 [.semsp + 1] = .value [1];

;	2738					dbg$gl_seman2 [.semsp] = dsc$k_dtype_d;

;	2739	



; Bliss-32 7.352	Saturday 22-AUG-1978 04:01:20	DBB3:[DEBUG.SRC]DBGARI.B32;6					Page 4-3

; Digital Equipment Corporation

;

;	2740	%IF dbg_ari3

;     L 2741	%THEN

;     U 2742					$fao_tt_out ('double, value is !XL!XL, type is !SL',

;     U 2743						.value [1], .value [0], .dbg$gl_seman2 [.semsp]);

;     U 2744	%FI

;	2745	

;	2746					END;

;	2747				.value [0]

;	2748				END;

;	2749	%FI

;	2750	

;	2751	

;	2752			[OTHERWISE]:

;	2753				SIGNAL (dbg$_parseerr);

;	2754	

;	2755			TES);

;	2756	

;	2757	%IF dbg_ari

;     L 2758	%THEN

;     U 2759		$fao_tt_out ('expression = !XL!XL, type = !XL !SL', .dbg$gl_seman1 [.semsp+1],

;     U 2760			.dbg$gl_seman1 [.semsp],.dbg$gl_seman2[.semsp+1],  .dbg$gl_seman2 [.semsp]);

;     U 2761	%FI

;	2762	

;	2763		END;











					 0F3C 00186 	    .ENTRY  DBG$TRANS_NAME, Save R2,R3,R4,R5,R8,R9,R10,R11	      ; 2575

		         58 00000000G  00  9E 00188 	    MOVAB   LIB$SIGNAL, R8					      ;

		         59 00000000G  EF  9E 0018F 	    MOVAB   DBG$GL_LAST_LOC, R9					      ;

		         5A 00000000G  EF  9E 00196 	    MOVAB   DBG$GL_SEMAN1+4, R10				      ;

		         5B 00000000G  EF  9E 0019D 	    MOVAB   DBG$GL_SEMAN2, R11					      ;

		         5E	       08  C2 001A4 	    SUBL2   #8, SP						      ;

	   54 00000000G  EF	       04  C1 001A7 	    ADDL3   #4, DBG$GL_RUNFRAME, R4				      ; 2619

		         51	       54  D0 001AF 	    MOVL    R4, R1						      ; 2613

		         52	  04   AC  D0 001B2 	    MOVL    SEMSP, R2						      ; 2628

		         53	  FC AA42  DE 001B6 	    MOVAL   DBG$GL_SEMAN1[R2], R3				      ;

		         55	       01  CE 001BB 	    MNEGL   #1, R5						      ;

	      0000004B   8F	       63  D1 001BE 	    CMPL    (R3), #75						      ;

				       0E  12 001C5 	    BNEQ    1$							      ;

		       6B42	       08  D0 001C7 	    MOVL    #8, DBG$GL_SEMAN2[R2]				      ; 2637

		         50	  08   AC  D0 001CB 	    MOVL    LEXEME_STG_DESC, R0					      ; 2640

		         55	  04   B0  D0 001CF 	    MOVL    @4(R0), R5						      ; 2628

				       5D  11 001D3 	    BRB     7$							      ;

	      0000004E   8F	       63  D1 001D5 1$:     CMPL    (R3), #78						      ;

				       09  12 001DC 	    BNEQ    2$							      ;

		       6B42	       08  D0 001DE 	    MOVL    #8, DBG$GL_SEMAN2[R2]				      ; 2649

		         55	       69  D0 001E2 	    MOVL    DBG$GL_LAST_LOC, R5					      ; 2628

				       4B  11 001E5 	    BRB     7$							      ;

	      00000057   8F	       63  D1 001E7 2$:     CMPL    (R3), #87						      ;

				       32  12 001EE 	    BNEQ    6$							      ;

		       6B42	       08  D0 001F0 	    MOVL    #8, DBG$GL_SEMAN2[R2]				      ; 2666

			    00000000G  EF  95 001F4 	    TSTB    DBG$GB_LOC_TYPE					      ; 2669



; Bliss-32 7.352	Saturday 22-AUG-1978 04:01:20	DBB3:[DEBUG.SRC]DBGARI.B32;6					Page 4-4

; Digital Equipment Corporation

;

				       11  12 001FA 	    BNEQ    3$							      ;

		         50 00000000G  EF  D0 001FC 	    MOVL    DBG$GB_MOD_PTR, R0					      ; 2670

		         50	  01   A0  9A 00203 	    MOVZBL  1(R0), R0						      ;

	   50	         69	       50  C3 00207 	    SUBL3   R0, DBG$GL_LAST_LOC, R0				      ;

				       13  11 0020B 	    BRB     5$							      ; 2669

	   50	         69	       54  C3 0020D 3$:     SUBL3   R4, DBG$GL_LAST_LOC, R0				      ; 2677

		         50	       04  C6 00211 	    DIVL2   #4, REG_INDEX					      ;

				       05  14 00214 	    BGTR    4$							      ; 2678

		         50	       54  D0 00216 	    MOVL    R4, R0						      ;

				       7D  11 00219 	    BRB     14$							      ;

		         50	  FC A140  DE 0021B 4$:     MOVAL   -4(R1)[REG_INDEX], R0				      ; 2680

				       76  11 00220 5$:     BRB     14$							      ; 2628

		         3E	       63  D1 00222 6$:     CMPL    (R3), #62						      ;

				       0D  12 00225 	    BNEQ    8$							      ;

		       6B42	       08  D0 00227 	    MOVL    #8, DBG$GL_SEMAN2[R2]				      ; 2690

		         55 00000000G  EF  D0 0022B 	    MOVL    DBG$GL_LAST_VAL, R5					      ; 2628

				       67  11 00232 7$:     BRB     15$							      ;

	      00000042   8F	       63  D1 00234 8$:     CMPL    (R3), #66						      ;

				       09  13 0023B 	    BEQL    9$							      ;

	      00000055   8F	       63  D1 0023D 	    CMPL    (R3), #85						      ;

				       49  12 00244 	    BNEQ    13$							      ;

				       6E  7C 00246 9$:     CLRQ    VALUE						      ; 2706

				       5E  DD 00248 	    PUSHL   SP							      ; 2708

				  08   AC  DD 0024A 	    PUSHL   LEXEME_STG_DESC					      ;

	      00000000G  EF	       02  FB 0024D 	    CALLS   #2, FOR$CNV_IN_DEFG					      ;

		         0F	       50  E8 00254 	    BLBS    STATUS, 10$						      ; 2709

				  08   AC  DD 00257 	    PUSHL   LEXEME_STG_DESC					      ; 2718

				       01  DD 0025A 	    PUSHL   #1							      ;

			    000281D0   8F  DD 0025C 	    PUSHL   #164304						      ;

		         68	       03  FB 00262 	    CALLS   #3, LIB$SIGNAL					      ;

					   04 00265 	    RET     							      ; 2719

	      00000055   8F	       63  D1 00266 10$:    CMPL    (R3), #85						      ; 2721

				       12  12 0026D 	    BNEQ    11$							      ;

				       5E  DD 0026F 	    PUSHL   SP							      ; 2724

	      00000000G  EF	       01  FB 00271 	    CALLS   #1, DBG$CNV_D_TO_F					      ;

				     6A42  D4 00278 	    CLRL    DBG$GL_SEMAN1+4[R2]					      ; 2725

		       6B42	       0A  D0 0027B 	    MOVL    #10, DBG$GL_SEMAN2[R2]				      ; 2726

				       09  11 0027F 	    BRB     12$							      ; 2721

		       6A42	  04   AE  D0 00281 11$:    MOVL    VALUE+4, DBG$GL_SEMAN1+4[R2]			      ; 2737

		       6B42	       0B  D0 00286 	    MOVL    #11, DBG$GL_SEMAN2[R2]				      ; 2738

		         55	       6E  D0 0028A 12$:    MOVL    VALUE, R5						      ; 2628

				       0C  11 0028D 	    BRB     15$							      ;

			    00028248   8F  DD 0028F 13$:    PUSHL   #164424						      ; 2753

		         68	       01  FB 00295 	    CALLS   #1, LIB$SIGNAL					      ;

		         55	       50  D0 00298 14$:    MOVL    R0, R5						      ; 2628

		         63	       55  D0 0029B 15$:    MOVL    R5, (R3)						      ;

					   04 0029E 	    RET     							      ; 2575



; Routine Size:  281 bytes







; Bliss-32 7.352	Saturday 22-AUG-1978 04:01:20	DBB3:[DEBUG.SRC]DBGARI.B32;6					Page 5

; Digital Equipment Corporation

;

;	2764	GLOBAL ROUTINE dbg$write_mem (dest_address, src_address, length) =

;	2765	

;	2766	!++

;	2767	! FUNCTIONAL DESCRIPTION:

;	2768	!	Writes a sequence of values (bytes) to memory in

;	2769	!	the user program.  The destination, source, and

;	2770	!	number of bytes to write are all passed as parameters.

;	2771	!

;	2772	!	THE PROTECTION OF THE FIRST BYTE TO BE WRITTEN AND THE LAST

;	2773	!	BYTE TO BE WRITTEN ARE BOTH CHECKED. THE STATUS OF BOTH PAGES

;	2774	!	(THEY MAY BE THE SAME PAGE) IS SAVED. THEN THE VALUE IS WRITTEN

;	2775	!	TO THE ADDRESS (THE PAGE PROTECTION IS CHANGED DURING THE

;	2776	!	CHECKING OPERATION).

;	2777	!

;	2778	!	THEN, IF THE PROTECTION WAS CHANGED IN EITHER CASE, THE

;	2779	!	PROTECTION IS REESTABLISHED. IF EVERYTHING WAS SUCCESSFUL,

;	2780	!	THE ROUTINE RETURNS TRUE. OTHERWISE, IT RETURNS FALSE.

;	2781	!

;	2782	! CALLING SEQUENCE:

;	2783	!	dbg$write_mem ()

;	2784	!

;	2785	! INPUTS:

;	2786	!	dest_address	- THE ADDRESS OF THE LOCATION TO BE CHANGED

;	2787	!	src_address	- The address of where the bytes are stored.

;	2788	!	length		- The number of bytes to be written.

;	2789	!

;	2790	! IMPLICIT INPUTS:

;	2791	!	None.

;	2792	!

;	2793	! OUTPUTS:

;	2794	!	TRUE OR FALSE

;	2795	!

;	2796	! IMPLICIT OUTPUTS:

;	2797	!	THE PAGE PROTECTION MAY BE MOMENTARILY ALTERED, THEN REINSTALLED.

;	2798	!

;	2799	! ROUTINE VALUE:

;	2800	!	TRUE OR FALSE

;	2801	!

;	2802	! SIDE EFFECTS:

;	2803	!	THE VALUE IS WRITTEN TO MEMORY

;	2804	!--

;	2805	

;	2806		BEGIN

;	2807		MAP

;	2808			dest_address	: REF VECTOR[,BYTE],

;	2809			src_address	: REF VECTOR[,BYTE];

;	2810	

;	2811		LOCAL

;	2812			prot_status_1,

;	2813			protection_1: BYTE,

;	2814			prot_status_2,

;	2815			protection_2: BYTE;

;	2816	

;	2817	%IF dbg_ari

;     L 2818	%THEN



; Bliss-32 7.352	Saturday 22-AUG-1978 04:01:20	DBB3:[DEBUG.SRC]DBGARI.B32;6					Page 5-1

; Digital Equipment Corporation

;

;     U 2819		$fao_tt_out ('length is !SL', .length);

;     U 2820	%FI

;	2821		IF ((prot_status_1 = dbg$check_prot (.dest_address, protection_1)) NEQ 0) 

;	2822			AND ((prot_status_2 = dbg$check_prot (.dest_address + .length - 1, protection_2)) NEQ 0)

;	2823		THEN

;	2824			BEGIN

;	2825	

;	2826			!++

;	2827			! PROTECTION HAS EITHER BEEN ALTERED SUCCESSFULLY, OR IT

;	2828			! DID NOT NEED TO BE ALTERED. NOW WRITE THE VALUE INTO THE

;	2829			! ADDRESS.

;	2830			!--

;	2831	%IF dbg_ari1

;     L 2832	%THEN

;     U 2833			$fao_tt_out ('protection checked successfully');

;     U 2834			$fao_tt_out ('protection one is !XB', .protection_1);

;     U 2835			$fao_tt_out ('protection two is !XB', .protection_2);

;     U 2836	%FI

;	2837	

;	2838			CH$MOVE (.length, src_address [0], dest_address [0]);

;	2839	

;	2840			!++

;	2841			! IF EITHER OF THE PROTECTION STATUSES SAY RESET THE PROTECTION

;	2842			! (TO READ ONLY), THEN RESET THE PROTECTION ON THAT PAGE.

;	2843			!--

;	2844	

;	2845			IF .prot_status_1 EQL dbg$k_reset_prt

;	2846			THEN

;	2847				BEGIN

;	2848	%IF dbg_ari1

;     L 2849	%THEN

;     U 2850				$fao_tt_out ('resetting protection one');

;     U 2851	%FI

;	2852				dbg$redo_prot (.dest_address, protection_1);

;	2853	%IF dbg_ari1

;     L 2854	%THEN

;     U 2855				$fao_tt_out ('after redo, protection one is !XB', .protection_1);

;     U 2856	%FI

;	2857				END;

;	2858	

;	2859			IF (.length NEQ 1) AND (.prot_status_2 EQL dbg$k_reset_prt)

;	2860			THEN

;	2861				BEGIN

;	2862	%IF dbg_ari1

;     L 2863	%THEN

;     U 2864				$fao_tt_out ('resetting protection two');

;     U 2865	%FI

;	2866				dbg$redo_prot (.dest_address + .length - 1, protection_2);

;	2867	%IF dbg_ari1

;     L 2868	%THEN

;     U 2869				$fao_tt_out ('after redo, protection two is !XB', .protection_2);

;     U 2870	%FI

;	2871				END;

;	2872	

;	2873			!++



; Bliss-32 7.352	Saturday 22-AUG-1978 04:01:20	DBB3:[DEBUG.SRC]DBGARI.B32;6					Page 5-2

; Digital Equipment Corporation

;

;	2874			! NOW RETURN TRUE BECAUSE EVERYTHING WORKED JUST FINE.

;	2875			!--

;	2876			RETURN TRUE

;	2877			END

;	2878		ELSE RETURN FALSE

;	2879		END;











					 0DFC 0029F 	    .ENTRY  DBG$WRITE_MEM, Save R2,R3,R4,R5,R6,R7,R8,R10,R11	      ; 2764

		         5A 00000000G  EF  9E 002A1 	    MOVAB   DBG$CHECK_PROT, R10					      ;

		         5B 00000000G  EF  9E 002A8 	    MOVAB   DBG$REDO_PROT, R11					      ;

		         5E	       08  C2 002AF 	    SUBL2   #8, SP						      ;

				  04   AE  9F 002B2 	    PUSHAB  PROTECTION_1					      ; 2821

		         58	  04   AC  D0 002B5 	    MOVL    DEST_ADDRESS, R8					      ;

				       58  DD 002B9 	    PUSHL   R8							      ;

		         6A	       02  FB 002BB 	    CALLS   #2, DBG$CHECK_PROT					      ;

		         56	       50  D0 002BE 	    MOVL    R0, PROT_STATUS_1					      ;

				       41  13 002C1 	    BEQL    3$							      ;

				       5E  DD 002C3 	    PUSHL   SP							      ; 2822

	   50	         58	  0C   AC  C1 002C5 	    ADDL3   LENGTH, R8, R0					      ;

				  FF   A0  9F 002CA 	    PUSHAB  -1(R0)						      ;

		         6A	       02  FB 002CD 	    CALLS   #2, DBG$CHECK_PROT					      ;

		         57	       50  D0 002D0 	    MOVL    R0, PROT_STATUS_2					      ;

				       2F  13 002D3 	    BEQL    3$							      ;

	   68	    08   BC	  0C   AC  28 002D5 	    MOVC3   LENGTH, @SRC_ADDRESS, (R8)				      ; 2838

		         02	       56  D1 002DB 	    CMPL    PROT_STATUS_1, #2					      ; 2845

				       08  12 002DE 	    BNEQ    1$							      ;

				  04   AE  9F 002E0 	    PUSHAB  PROTECTION_1					      ; 2852

				       58  DD 002E3 	    PUSHL   R8							      ;

		         6B	       02  FB 002E5 	    CALLS   #2, DBG$REDO_PROT					      ;

		         01	  0C   AC  D1 002E8 1$:     CMPL    LENGTH, #1						      ; 2859

				       12  13 002EC 	    BEQL    2$							      ;

		         02	       57  D1 002EE 	    CMPL    PROT_STATUS_2, #2					      ;

				       0D  12 002F1 	    BNEQ    2$							      ;

				       5E  DD 002F3 	    PUSHL   SP							      ; 2866

	   50	         58	  0C   AC  C1 002F5 	    ADDL3   LENGTH, R8, R0					      ;

				  FF   A0  9F 002FA 	    PUSHAB  -1(R0)						      ;

		         6B	       02  FB 002FD 	    CALLS   #2, DBG$REDO_PROT					      ;

		         50	       01  D0 00300 2$:     MOVL    #1, R0						      ; 2876

					   04 00303 	    RET     							      ;

				       50  D4 00304 3$:     CLRL    R0							      ; 2878

					   04 00306 	    RET     							      ; 2764



; Routine Size:  104 bytes







; Bliss-32 7.352	Saturday 22-AUG-1978 04:01:20	DBB3:[DEBUG.SRC]DBGARI.B32;6					Page 6

; Digital Equipment Corporation

;

;	2880	END

;	2881	ELUDOM









							    .GLOBL  LIB$SIGNAL



;				       PSECT SUMMARY

;

;	Name		 Bytes			       Attributes

;

;  DBG$CODE       	   775  NOWRT,  RD ,  EXE,  SHR,  LCL,  REL,  CON,  PIC,ALIGN(0)

;  $CODE$         	     0  NOWRT,  RD ,  EXE,NOSHR,  LCL,  REL,  CON,NOPIC,ALIGN(2)









;				LIBRARY STATISTICS

;

;					     -------- Symbols --------    Blocks

;	File				     Total    Loaded   Percent      Read

;

;  DBA4:[SYSLIB]STARLET.L32;1		      2688        18         0       112













;			COMPILER INTERNAL TIMING



;	Phase	    Faults	Cpu-time      Elapsed-time

;	LEXSYN	      545	00:27.0		00:48.9

;	FLOWAN	       23	00:02.4		00:04.2

;	DELAY	       25	00:01.2		00:03.0

;	TNBIND	       29	00:01.6		00:02.4

;	CODE	       64	00:02.9		00:06.9

;	FINAL	      103	00:04.5		00:06.9

;	Total	      789	00:39.5		01:12.3



; Size:		775 code + 0 data bytes

; Run Time:	00:40.1

; Elapsed Time:	01:13.9

; Memory Used:	316 pages

; Compilation Complete

