

; Bliss-32 7.352	Saturday 22-AUG-1978 03:15:40	DBB3:[PATCH.SRC]PATLEX.B32;14					Page 1

; Digital Equipment Corporation

;

;	0001	MODULE PATLEX (

;	0002			%IF %VARIANT EQL 1

;     L 0003			%THEN

;	0004				ADDRESSING_MODE (EXTERNAL = LONG_RELATIVE, NONEXTERNAL = LONG_RELATIVE),

;	0005			%FI

;	0006			IDENT = 'X01.11'

;	0007			) =

;	0008	BEGIN

;	0009	

;	0010	!

;	0011	! COPYRIGHT (c) 1977,1978

;	0012	! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;	0013	!

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

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

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

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

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

;	0019	! TRANSFERRED.

;	0020	!

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

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

;	0023	! CORPORATION.

;	0024	!

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

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

;	0027	!

;	0028	

;	0029	!++

;	0030	! FACILITY:	PATCH

;	0031	!

;	0032	! ABSTRACT:	THIS MODULE CONTAINS A MARS SCANNER.

;	0033	!

;	0034	! ENVIRONMENT:	STARLET, user mode, interrupts disabled.

;	0035	!

;	0036	! AUTHOR: Carol Peters, CREATION DATE: 25 July 1977

;	0037	!

;	0038	! MODIFICATIONS:

;	0039	!  NO	DATE		PROGRAMMER		PURPOSE

;	0040	!  --	----		----------		-------

;	0041	!

;	0042	!  00	5-JAN-78	K.D. MORSE		ADAPT VERSION 15 FOR PATCH.

;	0043	!  01	24-JAN-78	K.D. MORSE		NO CHANGES FOR VERS 16.

;	0044	!  02	24-MAR-78	K.D. MORSE		NO CHANGES FOR VERS 17-18.

;	0045	!  03	14-APR-78	K.D. MORSE		NO CHANGES FOR VERS 19-20.

;	0046	!  04	25-APR-78	K.D. MORSE		CONVERT TO NATIVE COMPILER.

;	0047	!  05	26-APR-78	K.D. MORSE		INCLUDE CODE TO HANDLE KEYWORDS

;	0048	!						BEGINNING WITH A PERIOD.

;	0049	!  06	02-MAY-78	K.D. MORSE		CHANGE RETURNED TOKEN TYPE FROM

;	0050	!						ALPHA TO ALPHA_STR_TOKEN.

;	0051	!  07	17-MAY-78	K.D. MORSE		NO CHANGES FOR VERS 21.

;	0052	!  08	18-MAY-78	K.D. MORSE		NO CHANGES FOR VERS 22-23.

;	0053	!						DBGLEX.B32 BECAME DBGMAR.B32.

;	0054	!  09	18-MAY-78	K.D. MORSE		NO CHANGES FOR VERS 24.

;	0055	!  10	13-JUN-78	K.D. MORSE		ADD FAO COUNT TO SIGNALS.



; Bliss-32 7.352	Saturday 22-AUG-1978 03:15:40	DBB3:[PATCH.SRC]PATLEX.B32;14					Page 1-1

; Digital Equipment Corporation

;

;	0056	!  11	27-JUN-78	K.D. MORSE		NO CHANGES FOR VERS 25.

;	0057	!

;	0058	!--



; Bliss-32 7.352	Saturday 22-AUG-1978 03:15:40	DBB3:[PATCH.SRC]PATLEX.B32;14					Page 2

; Digital Equipment Corporation

;

;	0059	!

;	0060	! TABLE OF CONTENTS:

;	0061	!

;	0062	FORWARD ROUTINE

;	0063		PAT$MAR_GET_LEX;					! Extracts a MARS lexeme from the input buffer

;	0064	

;	0065	!

;	0066	! INCLUDE FILES:

;	0067	!

;	0068	

;	0069	LIBRARY 'SYS$LIBRARY:LIB.L32';

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

;	0110	REQUIRE 'SRC$:PATPCT.REQ';

;	0126	REQUIRE 'SRC$:CHRKEY.REQ';

;	0163	REQUIRE 'SRC$:PATGEN.REQ';

;	0342	REQUIRE 'SRC$:PATTER.REQ';			

;	0422	REQUIRE 'SRC$:SCALIT.REQ';

;	0463	REQUIRE 'LIB$:PATMSG.REQ';

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

;      R0629	SWITCHES LIST (SOURCE);

;      R0630	

;      R0631	EXTERNAL ROUTINE

;      R0632		PAT$fao_out;		! formats a line and outputs to the terminal

;      R0633	

;      R0634	SWITCHES LIST (NOSOURCE);

;	0679	

;	0680	!

;	0681	! MACROS:

;	0682	!

;	0683	

;	0684	!

;	0685	! EQUATED SYMBOLS:

;	0686	!

;	0687	

;	0688	!

;	0689	! OWN STORAGE:

;	0690	!

;	0691	

;	0692	!

;	0693	! EXTERNAL REFERENCES:

;	0694	!

;	0695	EXTERNAL ROUTINE

;	0696		PAT$RADX_CONVRT;					! Converts ASCII strings to binary numbers

;	0697	

;	0698	EXTERNAL

;	0699		PAT$GB_DEF_MOD : VECTOR [, BYTE],			! Mode structure

;	0700		PAT$GB_MOD_PTR : REF VECTOR [, BYTE];			! Holds current radix



; Bliss-32 7.352	Saturday 22-AUG-1978 03:15:40	DBB3:[PATCH.SRC]PATLEX.B32;14					Page 3

; Digital Equipment Corporation

;

;	0701	GLOBAL ROUTINE PAT$MAR_GET_LEX (input_stg_desc, lexeme_stg_desc) =	! gets a lexeme from input line

;	0702	

;	0703	!++

;	0704	! Functional description:

;	0705	!

;	0706	!	Using the character pointer for the input line, extracts a lexeme

;	0707	!	from the input line. A lexeme is defined as an operator, an

;	0708	!	alphanumeric string, a numeric string, or an

;	0709	!	illegal string. Blanks and comments are absorbed.

;	0710	!

;	0711	!	The lexeme is returned in the lexeme buffer in the

;	0712	!	same form as in the input string, except for numeric

;	0713	!	strings, in which case the string is converted to a

;	0714	!	binary number and that is returned in the lexeme buffer.

;	0715	!	A token equivalent of the lexeme is the value of the

;	0716	!	routine.

;	0717	!

;	0718	! Calling Sequence:

;	0719	!

;	0720	!	CALL get_MAR_lexeme (input_stg_desc.rt.dd, lexeme_stg_desc.rt.dv)

;	0721	!

;	0722	! Formal parameters:

;	0723	!

;	0724	!	input_stg_desc	- string descriptor to the input buffer.

;	0725	!	lexeme_stg_desc	- varying string descriptor to the lexeme buffer

;	0726	!

;	0727	! Implicit inputs:

;	0728	!

;	0729	!	The character mapping table, char_type_table, that maps each

;	0730	!	ASCII character onto a dense list of equivalents.

;	0731	!	The token_table, that maps operators onto their token equivalents.

;	0732	!

;	0733	! Outputs:

;	0734	!

;	0735	!	input_stg_desc	- the field dsc$a_pointer is updated to point to

;	0736	!			  the next byte to be read in the input stream.

;	0737	!			  This byte is the delimiter of the lexeme found.

;	0738	!			  The field dsc$w_length contains the length of

;	0739	!			  the yet unread input line.

;	0740	!	lexeme_stg_desc	- the field dsc$w_length holds the actual length

;	0741	!			  in bytes of the lexeme found. The lexeme buffer

;	0742	!			  addressed by the field dsc$a_pointer holds the

;	0743	!			  lexeme string or value.

;	0744	!

;	0745	! Implicit outputs:

;	0746	!

;	0747	!	The ASCII representation of the lexeme is written into the

;	0748	!	string addressed by the dsc$a_pointer field of lexeme_stg_desc.

;	0749	!

;	0750	! Routine value:

;	0751	!

;	0752	!	the type of lexeme found, namely number, alpha string,

;	0753	!	operator, keyword token, illegal.

;	0754	!

;	0755	! Side effects:



; Bliss-32 7.352	Saturday 22-AUG-1978 03:15:40	DBB3:[PATCH.SRC]PATLEX.B32;14					Page 3-1

; Digital Equipment Corporation

;

;	0756	!

;	0757	!	none

;	0758	!--

;	0759	

;	0760	BEGIN

;	0761	

;	0762	LITERAL

;	0763		table_offset	= 9,

;	0764		operator_max	= 28;

;	0765	

;	0766	BIND

;	0767		token_table = UPLIT BYTE (

;	0768					op_paren_token,

;	0769					cl_paren_token,

;	0770					plus_token,

;	0771					minus_token,

;	0772					slash_token,

;	0773					colon_token,

;	0774					semi_colo_token,

;	0775					quote_token,

;	0776					up_arrow_token,

;	0777					backslash_token,

;	0778					at_sign_token,

;	0779					period_token,

;	0780					asterisk_token,

;	0781					langle_token,

;	0782					rangle_token,

;	0783					comma_token,

;	0784					equals_token,

;	0785					lsquare_token,

;	0786					rsquare_token,

;	0787					hash_token

;	0788							) : VECTOR [, BYTE];

;	0789	

;	0790	LITERAL

;	0791		max_state_index	= 4,					! index ranges from 0 to 4

;	0792		invalid_state	= 0,					! invalid character seen

;	0793		alpha_state	= 1,					! alphabetic string expected

;	0794		numeric_state	= 2,					! numeric string expected

;	0795		eol_token_state	= 3,					! logical end of line or error seen

;	0796		radix_state	= 4,					! radix setting expected

;	0797		unspec_state	= 5;					! unspecified state, probably special character operator

;	0798	

;	0799	BIND

;	0800		lex_type_tbl	= UPLIT (

;	0801					mask (illegal),

;	0802					mask (alpha, alpha_low, alpha_and_hex, alphalo_and_hex, period),

;	0803					mask (numeric),

;	0804					mask (ind_comment, end_of_line),

;	0805					mask (up_arrow)

;	0806								) : VECTOR;

;	0807	

;	0808	BIND

;	0809		lex_state_tbl	= UPLIT BYTE (

;	0810						invalid_state,



; Bliss-32 7.352	Saturday 22-AUG-1978 03:15:40	DBB3:[PATCH.SRC]PATLEX.B32;14					Page 3-2

; Digital Equipment Corporation

;

;	0811						alpha_state,

;	0812						numeric_state,

;	0813						eol_token_state,

;	0814						radix_state

;	0815								) : VECTOR [, BYTE];

;	0816	

;	0817	LITERAL

;	0818		radix_max	= 3;					! maximum number of MARS radices

;	0819	

;	0820	BIND

;	0821		radix_equiv_tbl = UPLIT BYTE (

;	0822						'B', binary_radix,

;	0823						'O', octal_radix,

;	0824						'D', decimal_radix,

;	0825						'X', hex_radix

;	0826								) : BLOCK [, WORD];

;	0827	

;	0828	MACRO

;	0829		radix_char	= 0, 8, 0%,				! radix ASCII character

;	0830		radix_equiv	= 8, 8, 0%;				! radix equivalent

;	0831	

;	0832	MAP

;	0833		input_stg_desc	: REF BLOCK [, BYTE],			! input string descriptor

;	0834		lexeme_stg_desc	: REF BLOCK [, BYTE];			! lexeme string descriptor

;	0835	

;	0836	LOCAL

;	0837		input_ptr,						! character pointer for input

;	0838		lexeme_ptr,						! character pointer for lexeme

;	0839		previous_radix,						! current local radix

;	0840		state_index,						! index into lex_state_tbl

;	0841		state,							! current state of lexical processor

;	0842		char,							! holds a single character

;	0843		count;							! counts characters used

;	0844	

;	0845	LABEL

;	0846		alpha_block,						! label for alpha case in the select

;	0847		radix_block;						! label for up arrow case in the select

;	0848	

;	0849	!++

;	0850	! See whether there is any input line left. If not, signal internal error.

;	0851	!--

;	0852	IF .input_stg_desc [dsc$w_length] LSS 0

;	0853	THEN SIGNAL (PAT$_PARSEERR);

;	0854	

;	0855	!++

;	0856	! Make the string pointers into formal BLISS character pointers.

;	0857	!--

;	0858	input_ptr = ch$ptr (.input_stg_desc [dsc$a_pointer]);

;	0859	lexeme_ptr = ch$ptr (.lexeme_stg_desc [dsc$a_pointer]);

;	0860	

;	0861	!++

;	0862	! Save the radix in case it changes temporarily.

;	0863	!--

;	0864	previous_radix = .PAT$gb_mod_ptr [mode_radix];

;	0865	count = 0;



; Bliss-32 7.352	Saturday 22-AUG-1978 03:15:40	DBB3:[PATCH.SRC]PATLEX.B32;14					Page 3-3

; Digital Equipment Corporation

;

;	0866	REPEAT								! skip leading blanks

;	0867		BEGIN

;	0868		char = ch$rchar (.input_ptr);

;	0869		IF .char_type_table [.char] NEQ blanks

;	0870		THEN

;	0871			BEGIN

;	0872			input_stg_desc [dsc$w_length] = .input_stg_desc [dsc$w_length] - .count;

;	0873			EXITLOOP

;	0874			END

;	0875		ELSE

;	0876			BEGIN

;	0877			input_ptr = ch$plus (.input_ptr, 1);

;	0878			count = .count + 1;

;	0879			END;

;	0880		END;

;	0881	

;	0882	!++

;	0883	! Convert the mapping of the first significant character into a lexical state.

;	0884	! This state drives the later CASE processing.

;	0885	!--

;	0886	state_index = 0;

;	0887	REPEAT

;	0888		BEGIN

;	0889		IF .lex_type_tbl [.state_index] ^ .char_type_table [.char] LSS 0

;	0890		THEN

;	0891			BEGIN

;	0892			state = .lex_state_tbl [.state_index];

;	0893			EXITLOOP

;	0894			END

;	0895		ELSE

;	0896			BEGIN

;	0897			state_index = .state_index + 1;

;	0898			IF .state_index GTR max_state_index

;	0899			THEN

;	0900				BEGIN

;	0901				state = unspec_state;

;	0902				EXITLOOP

;	0903				END;

;	0904			END;

;	0905		END;

;	0906	

;	0907	REPEAT CASE .state FROM 0 to max_state_index + 1 OF		! analyze current state

;	0908		SET

;	0909	

;	0910		[invalid_state]:					! if illegal, just signal

;	0911			SIGNAL (PAT$_INVCHAR);



; Bliss-32 7.352	Saturday 22-AUG-1978 03:15:40	DBB3:[PATCH.SRC]PATLEX.B32;14					Page 4

; Digital Equipment Corporation

;

;	0912		[alpha_state]:						! alphanumeric string

;	0913	alpha_block:

;	0914			BEGIN

;	0915			!++

;	0916			! This is an alphanumeric string.  If the

;	0917			! character is a period, see whether the next character is

;	0918			! an alphabetic. If it is, this must be a logical operator

;	0919			! keyword, so allow the leading dot.  Otherwise, it is an error.

;	0920			!--

;	0921			LOCAL

;	0922				period_present;

;	0923	

;	0924			count = 0;

;	0925			IF .char EQL asc_period

;	0926			THEN

;	0927				BEGIN

;	0928	

;	0929				LOCAL

;	0930					new_char;

;	0931	

;	0932				new_char = ch$rchar (ch$plus (.input_ptr, 1));

;	0933				IF NOT (oneof (.char_type_table [.new_char], alpha, alpha_low,

;     P 0934						alpha_and_hex, alphalo_and_hex))

;	0935				THEN

;	0936					BEGIN

;	0937	!				IF .char_type_table [.new_char] EQL numeric

;	0938	!				THEN state = numeric_state

;	0939	!				ELSE state = unspec_state;

;	0940					STATE = UNSPEC_STATE;		! DON'T ACCEPT NUMBERS WITH DECIMAL POINTS

;	0941					LEAVE alpha_block;

;	0942					END

;	0943				ELSE period_present = TRUE;

;	0944				END

;	0945			ELSE period_present = FALSE;

;	0946	

;	0947			!++

;	0948			! Now read the input buffer until a non-alpha and non-numeric

;	0949			! character is encountered. Store each character found in the

;	0950			! buffer for the lexeme unless the length of that buffer is

;	0951			! expended.

;	0952			!--

;	0953			DO

;	0954				BEGIN

;	0955				IF (oneof (.char_type_table [.char], alpha_low, alphalo_and_hex))

;	0956				THEN char = .char - upper_case_dif;

;	0957				count = .count + 1;

;	0958				IF .count LEQ sym_max_length

;	0959				THEN ch$wchar_a (.char, lexeme_ptr);

;	0960				char = ch$a_rchar (input_ptr);

;	0961				END

;	0962			WHILE

;	0963				(oneof (.char_type_table [.char], alpha, alpha_low, numeric,

;     P 0964						alpha_and_hex, alphalo_and_hex, period));

;	0965	

;	0966			!++



; Bliss-32 7.352	Saturday 22-AUG-1978 03:15:40	DBB3:[PATCH.SRC]PATLEX.B32;14					Page 4-1

; Digital Equipment Corporation

;

;	0967			! Now see whether the next character is a period

;	0968			! AND the string started with a period. In this case, store the

;	0969			! ending period also.

;	0970			!--

;	0971	!		IF .char EQL asc_period AND .period_present

;	0972	!		THEN

;	0973	!			BEGIN

;	0974	!			count = .count + 1;

;	0975	!			IF .count LEQ sym_max_length

;	0976	!			THEN ch$wchar (.char, .lexeme_ptr);

;	0977	!			input_ptr = ch$plus (.input_ptr, 1);

;	0978	!			END;

;	0979	

;	0980			!++

;	0981			! Return the alpha_str_token lexeme.

;	0982			!--

;	0983			IF .count GTR sym_max_length

;	0984			THEN

;	0985				BEGIN

;	0986				SIGNAL (PAT$_STGTRUNC);

;	0987				lexeme_stg_desc [dsc$w_length] = sym_max_length;

;	0988				END

;	0989			ELSE lexeme_stg_desc [dsc$w_length] = .count;

;	0990			input_stg_desc [dsc$a_pointer] = .input_ptr;

;	0991			input_stg_desc [dsc$w_length] = .input_stg_desc [dsc$w_length] - .count;

;	0992			RETURN alpha_str_token

;	0993			END;



; Bliss-32 7.352	Saturday 22-AUG-1978 03:15:40	DBB3:[PATCH.SRC]PATLEX.B32;14					Page 5

; Digital Equipment Corporation

;

;	0994		[numeric_state]:					! numeric string

;	0995			BEGIN

;	0996			!++

;	0997			! Now read the input buffer until a non-numeric character is

;	0998			! encountered. Ignore all leading zeroes unless a decimal point

;	0999			! was present.  Store each character found in the buffer for

;	1000			! the lexeme unless the length of that buffer is expended.

;	1001			!--

;	1002			count = 0;

;	1003			WHILE

;	1004				.char EQL '0'

;	1005			DO

;	1006				BEGIN

;	1007				count = .count + 1;

;	1008				char = ch$a_rchar (input_ptr);

;	1009				END;

;	1010	

;	1011			!++

;	1012			! If the entire number was zero, put a single

;	1013			! zero in the lexeme buffer and return.

;	1014			!--

;	1015			input_stg_desc [dsc$w_length] = .input_stg_desc [dsc$w_length] - .count;

;	1016			count = 0;

;	1017			IF .char_type_table [.char] NEQ numeric

;	1018				AND NOT (oneof (.char_type_table [.char], alpha_and_hex, alphalo_and_hex))

;	1019			THEN

;	1020				BEGIN

;	1021				ch$wchar (0, .lexeme_ptr);

;	1022				lexeme_stg_desc [dsc$w_length] = 1;

;	1023				input_stg_desc [dsc$a_pointer] = .input_ptr;

;	1024				RETURN digit_str_token

;	1025				END;

;	1026	

;	1027			!++

;	1028			! This is the normal store and pick up next numeric character.

;	1029			!--

;	1030			DO

;	1031				BEGIN

;	1032				IF .char_type_table [.char] EQL alphalo_and_hex

;	1033				THEN char = .char - upper_case_dif;

;	1034				count = .count + 1;

;	1035				IF .count GTR num_max_length

;	1036				THEN

;	1037					BEGIN

;	1038					ch$move (num_max_length - 1,

;	1039						ch$plus (ch$ptr (.lexeme_stg_desc [dsc$a_pointer]), 1),

;	1040						ch$ptr (.lexeme_stg_desc [dsc$a_pointer]));

;	1041					ch$wchar (.char, .lexeme_ptr-1);

;	1042					END

;	1043				ELSE ch$wchar_a (.char, lexeme_ptr);

;	1044				char = ch$a_rchar (input_ptr);

;	1045				END

;	1046			WHILE

;	1047				(oneof (.char_type_table [.char], numeric,

;     P 1048					alpha_and_hex, alphalo_and_hex));



; Bliss-32 7.352	Saturday 22-AUG-1978 03:15:40	DBB3:[PATCH.SRC]PATLEX.B32;14					Page 5-1

; Digital Equipment Corporation

;

;	1049	

;	1050	

;	1051			!++

;	1052			! Convert the number, restore the old radix,

;	1053			! and return the numeric lexeme.

;	1054			!--

;	1055			PAT$radx_convrt (.lexeme_stg_desc [dsc$a_pointer],

;	1056				.lexeme_stg_desc [dsc$a_pointer]);

;	1057			PAT$gb_mod_ptr [mode_radix] = .previous_radix;

;	1058			lexeme_stg_desc [dsc$w_length] = 4;

;	1059			input_stg_desc [dsc$a_pointer] = .input_ptr;

;	1060			input_stg_desc [dsc$w_length] = .input_stg_desc [dsc$w_length] - .count;

;	1061			RETURN digit_str_token

;	1062		END;



; Bliss-32 7.352	Saturday 22-AUG-1978 03:15:40	DBB3:[PATCH.SRC]PATLEX.B32;14					Page 6

; Digital Equipment Corporation

;

;	1063		[eol_token_state]:					! logical end of line

;	1064			BEGIN

;	1065			!++

;	1066			! The length of the input line should be set to zero here.

;	1067			! Reduce it one so that it is less than zero. This will cause

;	1068			! an error if this same input line ever comes back to the lex

;	1069			! routine.

;	1070			!--

;	1071			lexeme_stg_desc [dsc$w_length] = 0;

;	1072			input_stg_desc [dsc$a_pointer] = ch$plus (.input_ptr, 1);

;	1073			input_stg_desc [dsc$w_length] = .input_stg_desc [dsc$w_length] - 1;

;	1074			RETURN eol_token

;	1075			END;



; Bliss-32 7.352	Saturday 22-AUG-1978 03:15:40	DBB3:[PATCH.SRC]PATLEX.B32;14					Page 7

; Digital Equipment Corporation

;

;	1076		[radix_state]:						! up arrow, quote, percent sign

;	1077	

;	1078	radix_block:	BEGIN						! MARS handling

;	1079	

;	1080			!++

;	1081			! An up arrow can occur as a standalone character meaning

;	1082			! previous location, or as a special character that indicates

;	1083			! radix. In the latter case, the up arrow is followed by one of

;	1084			! the letters 'B', 'O', or 'X', and then a numeric string

;	1085			! (without an intervening space).  First check for the letter.

;	1086			!--

;	1087			LOCAL

;	1088				new_char;

;	1089	

;	1090			char = ch$rchar (ch$plus (.input_ptr, 1));

;	1091			IF (oneof (.char_type_table [.char], alpha_low, alphalo_and_hex))

;	1092			THEN char = .char - upper_case_dif;

;	1093			IF NOT ((.char EQL 'B') OR (.char EQL 'O') OR (.char EQL 'D') OR (.char EQL 'X'))

;	1094			THEN

;	1095				BEGIN

;	1096				!++

;	1097				! This is the single character meaning previous location.

;	1098				! Just update the string descriptors, write the up arrow

;	1099				! into the lexeme buffer, and return.

;	1100				!--

;	1101				char = asc_up_arrow;

;	1102				state = unspec_state;

;	1103				LEAVE radix_block;

;	1104				END;

;	1105	

;	1106			!++

;	1107			! This looks like a radix indicator. If a number follows, it

;	1108			! must be. In this case, set the current mode according to the

;	1109			! radix encoding. Then leave this code block. The effect is that

;	1110			! on the next loop through the CASE expression, control will

;	1111			! stop at the numeric processing block.

;	1112			!--

;	1113			new_char = ch$rchar (ch$plus (.input_ptr, 2));

;	1114			IF (oneof (.char_type_table [.new_char], numeric,

;     P 1115					alpha_and_hex, alphalo_and_hex))

;	1116			THEN

;	1117				BEGIN

;	1118				input_ptr = ch$plus (.input_ptr, 2);

;	1119				INCR index FROM 0 TO radix_max DO

;	1120					IF .char EQL .radix_equiv_tbl [.index, radix_char]

;	1121					THEN

;	1122						BEGIN

;	1123						PAT$gb_mod_ptr [mode_radix] =

;	1124							.radix_equiv_tbl [.index, radix_equiv];

;	1125						EXITLOOP

;	1126						END;

;	1127				char = .new_char;

;	1128				input_stg_desc [dsc$w_length] = .input_stg_desc [dsc$w_length] - 2;

;	1129				state = numeric_state;

;	1130				LEAVE radix_block;



; Bliss-32 7.352	Saturday 22-AUG-1978 03:15:40	DBB3:[PATCH.SRC]PATLEX.B32;14					Page 7-1

; Digital Equipment Corporation

;

;	1131				END

;	1132			ELSE

;	1133				BEGIN

;	1134				!++

;	1135				! This is not a radix indicator after all. Just return

;	1136				! the up arrow.

;	1137				!--

;	1138				char = asc_up_arrow;

;	1139				state = unspec_state;

;	1140				LEAVE radix_block;

;	1141				END;

;	1142			END;



; Bliss-32 7.352	Saturday 22-AUG-1978 03:15:40	DBB3:[PATCH.SRC]PATLEX.B32;14					Page 8

; Digital Equipment Corporation

;

;	1143		[unspec_state]:						! special character like operator or illegal

;	1144			BEGIN

;	1145			!++

;	1146			! Most likely, this is a single character operator. Write its

;	1147			! ASCII value into the lexeme buffer, and return its equivalent

;	1148			! token.

;	1149			!--

;	1150			IF .char_type_table [.char] GEQ table_offset

;	1151				AND .char_type_table [.char] LEQ operator_max

;	1152			THEN

;	1153				BEGIN

;	1154	

;	1155				LOCAL

;	1156					index;

;	1157	

;	1158				index = table_offset;

;	1159				REPEAT

;	1160					BEGIN

;	1161					IF .char_type_table [.char] EQL .index

;	1162					THEN

;	1163						BEGIN

;	1164						ch$wchar (.char, .lexeme_ptr);

;	1165						lexeme_stg_desc [dsc$w_length] = 1;

;	1166						input_stg_desc [dsc$a_pointer] = ch$plus (.input_ptr, 1);

;	1167						input_stg_desc [dsc$w_length] = .input_stg_desc [dsc$w_length] - 1;

;	1168						RETURN .token_table [.index - table_offset]

;	1169						END

;	1170					ELSE index = .index + 1;

;	1171					IF .index GTR operator_max

;	1172					THEN EXITLOOP;

;	1173					END;

;	1174				END;

;	1175	

;	1176			!++

;	1177			! This doesn't seem to be anything about which we know.

;	1178			! SIGNAL invalid character.

;	1179			!--

;	1180			SIGNAL (PAT$_INVCHAR);

;	1181			END;

;	1182	

;	1183		TES;

;	1184	

;	1185	END;								! end of get_mar_lexeme





							    .TITLE  PATLEX

							    .IDENT  \X01.11\



							    .PSECT  _PAT$PLIT,NOWRT,NOEXE,0



					      00000 P.AAA:  .BYTE   6, 0, 0, 0, 0, 0, 0, 0, 0, 4, 6, 6, 6, 6, 0, 0, 0, 0, 0, -;

								    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 5, 16, 28, 1, - ;

								    0, 0, 16, 9, 10, 21, 11, 24, 12, 20, 13, 2, 2, 2, 2, 2, - ;

								    2, 2, 2, 2, 2, 14, 15, 22, 25, 23, 0, 19, 3, 3, 3, 3, 3, -;

								    3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, -;



; Bliss-32 7.352	Saturday 22-AUG-1978 03:15:40	DBB3:[PATCH.SRC]PATLEX.B32;14					Page 8-1

; Digital Equipment Corporation

;

								    1, 1, 26, 18, 27, 17, 1, 0, 8, 8, 8, 8, 8, 8, 7, 7, 7, -  ;

								    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 0, 0, -;

								    0, 0, 0						      ;

					      00080 P.AAB:  .BYTE   73, 63, 76, 70, 82, 64, 81, 77, 83, 62, 61, 75, 60, 68, - ;

								    79, 65, 66, 69, 80, 67				      ;

					      00094 P.AAC:  .LONG   -2147483648, 1367345152, 536870912, 100663296, 16384      ;

					      000A8 P.AAD:  .BYTE   0, 1, 2, 3, 4					      ;

					      000AD	    .BLKB   3

					      000B0 P.AAE:  .ASCII  \B\							      ;

					      000B1 	    .BYTE   2							      ;

					      000B2 	    .ASCII  \O\							      ;

					      000B3 	    .BYTE   8							      ;

					      000B4 	    .ASCII  \D\							      ;

					      000B5 	    .BYTE   10							      ;

					      000B6 	    .ASCII  \X\							      ;

					      000B7 	    .BYTE   16							      ;



						    CHAR_TYPE_TABLE=	P.AAA

						    TOKEN_TABLE=	P.AAB

						    LEX_TYPE_TBL=	P.AAC

						    LEX_STATE_TBL=	P.AAD

						    RADIX_EQUIV_TBL=	P.AAE

							    .GLOBL  PAT$FAO_OUT, PAT$RADX_CONVRT, PAT$GB_DEF_MOD, PAT$GB_MOD_PTR



							    .PSECT  _PAT$CODE,NOWRT,2



					 0FFC 00000 	    .ENTRY  PAT$MAR_GET_LEX, Save R2,R3,R4,R5,R6,R7,R8,R9,R10,R11     ; 0701

		         5E	       10  C2 00002 	    SUBL2   #16, SP						      ;

		         57	  04   AC  D0 00005 	    MOVL    INPUT_STG_DESC, R7					      ; 0852

				  04   A7  9F 00009 	    PUSHAB  4(R7)						      ; 0858

		         58	  00   BE  D0 0000C 	    MOVL    @0(SP), INPUT_PTR					      ;

		    04   AE	  08   AC  D0 00010 	    MOVL    LEXEME_STG_DESC, 4(SP)				      ; 0859

	   50	    04   AE	       04  C1 00015 	    ADDL3   #4, 4(SP), R0					      ;

		    08   AE	       60  D0 0001A 	    MOVL    (R0), 8(SP)						      ;

		         5B	  08   AE  D0 0001E 	    MOVL    8(SP), LEXEME_PTR					      ;

		    10   AE 00000000G  FF  9A 00022 	    MOVZBL  @PAT$GB_MOD_PTR, PREVIOUS_RADIX			      ; 0864

				       59  D4 0002A 	    CLRL    COUNT						      ; 0865

		         56	       68  9A 0002C 1$:     MOVZBL  (INPUT_PTR), CHAR					      ; 0868

		         04 00000000'EF46  91 0002F 	    CMPB    CHAR_TYPE_TABLE[CHAR], #4				      ; 0869

				       05  13 00037 	    BEQL    2$							      ;

		         67	       59  A2 00039 	    SUBW2   COUNT, (R7)						      ; 0872

				       06  11 0003C 	    BRB     3$							      ; 0873

				       58  D6 0003E 2$:     INCL    INPUT_PTR						      ; 0877

				       59  D6 00040 	    INCL    COUNT						      ; 0878

				       E8  11 00042 	    BRB     1$							      ; 0865

				       50  D4 00044 3$:     CLRL    STATE_INDEX						      ; 0886

	   51 00000000'EF40 00000000'EF46  78 00046 4$:     ASHL    CHAR_TYPE_TABLE[CHAR], LEX_TYPE_TBL[STATE_INDEX], R1      ; 0889

				       0B  18 00054 	    BGEQ    5$							      ;

		    0C   AE 00000000'EF40  9A 00056 	    MOVZBL  LEX_STATE_TBL[STATE_INDEX], STATE			      ; 0892

				       0B  11 0005F 	    BRB     7$							      ; 0893

				       50  D6 00061 5$:     INCL    STATE_INDEX						      ; 0897

		         04	       50  D1 00063 	    CMPL    STATE_INDEX, #4					      ; 0898

				       DE  15 00066 	    BLEQ    4$							      ;

		    0C   AE	       05  D0 00068 6$:     MOVL    #5, STATE						      ; 0901

	   05	         00	  0C   AE  CF 0006C 7$:     CASEL   STATE, #0, #5					      ; 0907



; Bliss-32 7.352	Saturday 22-AUG-1978 03:15:40	DBB3:[PATCH.SRC]PATLEX.B32;14					Page 8-2

; Digital Equipment Corporation

;

	 008E	       000F	     01FE     00071 8$:     .WORD   37$-8$,-						      ;

	 01C4	       013D	     012E     00077		    9$-8$,-						      ;

								    17$-8$,-						      ;

								    26$-8$,-						      ;

								    27$-8$,-						      ;

								    34$-8$						      ;

				     01EF  31 0007D 	    BRW     37$							      ; 0911

				       59  D4 00080 9$:     CLRL    COUNT						      ; 0924

		         2E	       56  D1 00082 	    CMPL    CHAR, #46						      ; 0925

				       18  12 00085 	    BNEQ    10$							      ;

		         50	  01   A8  9A 00087 	    MOVZBL  1(INPUT_PTR), NEW_CHAR				      ; 0932

	   50 51800000   8F 00000000'EF40  78 0008B 	    ASHL    CHAR_TYPE_TABLE[NEW_CHAR], #1367343104, R0		      ; 0934

				       CE  18 00098 	    BGEQ    6$							      ; 0933

		         50	       01  D0 0009A 	    MOVL    #1, PERIOD_PRESENT					      ; 0943

				       02  11 0009D 	    BRB     11$							      ; 0925

				       50  D4 0009F 10$:    CLRL    PERIOD_PRESENT					      ; 0945

		         51 00000000'EF46  9E 000A1 11$:    MOVAB   CHAR_TYPE_TABLE[CHAR], R1				      ; 0955

	   50 01800000   8F	       61  78 000A9 12$:    ASHL    (R1), #25165824, R0					      ;

				       03  18 000B1 	    BGEQ    13$							      ;

		         56	       20  C2 000B3 	    SUBL2   #32, CHAR						      ; 0956

				       59  D6 000B6 13$:    INCL    COUNT						      ; 0957

		         0F	       59  D1 000B8 	    CMPL    COUNT, #15						      ; 0958

				       03  14 000BB 	    BGTR    14$							      ;

		         8B	       56  90 000BD 	    MOVB    CHAR, (LEXEME_PTR)+					      ; 0959

				       58  D6 000C0 14$:    INCL    INPUT_PTR						      ; 0960

		         56	       68  9A 000C2 	    MOVZBL  (INPUT_PTR), CHAR					      ;

		         51 00000000'EF46  9E 000C5 	    MOVAB   CHAR_TYPE_TABLE[CHAR], R1				      ; 0964

	   50 71800800   8F	       61  78 000CD 	    ASHL    (R1), #1904216064, R0				      ;

				       D2  19 000D5 	    BLSS    12$							      ; 0963

		         0F	       59  D1 000D7 	    CMPL    COUNT, #15						      ; 0983

				       13  15 000DA 	    BLEQ    15$							      ;

			    006D8033   8F  DD 000DC 	    PUSHL   #7176243						      ; 0986

	      00000000G  00	       01  FB 000E2 	    CALLS   #1, LIB$SIGNAL					      ;

		    04   BE	       0F  B0 000E9 	    MOVW    #15, @4(SP)						      ; 0987

				       04  11 000ED 	    BRB     16$							      ; 0983

		    04   BE	       59  B0 000EF 15$:    MOVW    COUNT, @4(SP)					      ; 0989

		    00   BE	       58  D0 000F3 16$:    MOVL    INPUT_PTR, @0(SP)					      ; 0990

		         67	       59  A2 000F7 	    SUBW2   COUNT, (R7)						      ; 0991

		         50	  47   8F  9A 000FA 	    MOVZBL  #71, R0						      ; 0992

					   04 000FE 	    RET     							      ;

				       59  D4 000FF 17$:    CLRL    COUNT						      ; 1002

		         30	       56  D1 00101 18$:    CMPL    CHAR, #48						      ; 1004

				       09  12 00104 	    BNEQ    19$							      ;

				       59  D6 00106 	    INCL    COUNT						      ; 1007

				       58  D6 00108 	    INCL    INPUT_PTR						      ; 1008

		         56	       68  9A 0010A 	    MOVZBL  (INPUT_PTR), CHAR					      ;

				       F2  11 0010D 	    BRB     18$							      ; 1003

		         67	       59  A2 0010F 19$:    SUBW2   COUNT, (R7)						      ; 1015

				       59  D4 00112 	    CLRL    COUNT						      ; 1016

		         02 00000000'EF46  91 00114 	    CMPB    CHAR_TYPE_TABLE[CHAR], #2				      ; 1017

				       1B  13 0011C 	    BEQL    20$							      ;

	   50 10800000   8F 00000000'EF46  78 0011E 	    ASHL    CHAR_TYPE_TABLE[CHAR], #276824064, R0		      ; 1018

				       0C  19 0012B 	    BLSS    20$							      ;

				       6B  94 0012D 	    CLRB    (LEXEME_PTR)					      ; 1021

		    04   BE	       01  B0 0012F 	    MOVW    #1, @4(SP)						      ; 1022



; Bliss-32 7.352	Saturday 22-AUG-1978 03:15:40	DBB3:[PATCH.SRC]PATLEX.B32;14					Page 8-3

; Digital Equipment Corporation

;

		    00   BE	       58  D0 00133 	    MOVL    INPUT_PTR, @0(SP)					      ; 1023

				       61  11 00137 	    BRB     25$							      ; 1024

		         5A 00000000'EF46  9E 00139 20$:    MOVAB   CHAR_TYPE_TABLE[CHAR], R10				      ; 1032

		         08	       6A  91 00141 21$:    CMPB    (R10), #8						      ;

				       03  12 00144 	    BNEQ    22$							      ;

		         56	       20  C2 00146 	    SUBL2   #32, CHAR						      ; 1033

				       59  D6 00149 22$:    INCL    COUNT						      ; 1034

		         14	       59  D1 0014B 	    CMPL    COUNT, #20						      ; 1035

				       10  15 0014E 	    BLEQ    23$							      ;

	   7E	    08   AE	       01  C1 00150 	    ADDL3   #1, 8(SP), -(SP)					      ; 1038

      08   BE	         9E	       13  28 00155 	    MOVC3   #19, @(SP)+, @8(SP)					      ;

		    FF   AB	       56  90 0015A 	    MOVB    CHAR, -1(LEXEME_PTR)				      ; 1041

				       03  11 0015E 	    BRB     24$							      ; 1035

		         8B	       56  90 00160 23$:    MOVB    CHAR, (LEXEME_PTR)+					      ; 1043

				       58  D6 00163 24$:    INCL    INPUT_PTR						      ; 1044

		         56	       68  9A 00165 	    MOVZBL  (INPUT_PTR), CHAR					      ;

		         5A 00000000'EF46  9E 00168 	    MOVAB   CHAR_TYPE_TABLE[CHAR], R10				      ; 1048

	   50 30800000   8F	       6A  78 00170 	    ASHL    (R10), #813694976, R0				      ;

				       C7  19 00178 	    BLSS    21$							      ; 1047

				  08   AE  DD 0017A 	    PUSHL   8(SP)						      ; 1055

				  0C   AE  DD 0017D 	    PUSHL   12(SP)						      ;

	      00000000G  EF	       02  FB 00180 	    CALLS   #2, PAT$RADX_CONVRT					      ;

	      00000000G  FF	  10   AE  90 00187 	    MOVB    PREVIOUS_RADIX, @PAT$GB_MOD_PTR			      ; 1057

		    04   BE	       04  B0 0018F 	    MOVW    #4, @4(SP)						      ; 1058

		    00   BE	       58  D0 00193 	    MOVL    INPUT_PTR, @0(SP)					      ; 1059

		         67	       59  A2 00197 	    SUBW2   COUNT, (R7)						      ; 1060

		         50	  48   8F  9A 0019A 25$:    MOVZBL  #72, R0						      ; 1061

					   04 0019E 	    RET     							      ;

				  04   BE  B4 0019F 26$:    CLRW    @4(SP)						      ; 1071

      00   BE	         58	       01  C1 001A2 	    ADDL3   #1, INPUT_PTR, @0(SP)				      ; 1072

				       67  B7 001A7 	    DECW    (R7)						      ; 1073

		         50	  63   8F  9A 001A9 	    MOVZBL  #99, R0						      ; 1074

					   04 001AD 	    RET     							      ;

		         56	  01   A8  9A 001AE 27$:    MOVZBL  1(INPUT_PTR), CHAR					      ; 1090

	   50 01800000   8F 00000000'EF46  78 001B2 	    ASHL    CHAR_TYPE_TABLE[CHAR], #25165824, R0		      ; 1091

				       03  18 001BF 	    BGEQ    28$							      ;

		         56	       20  C2 001C1 	    SUBL2   #32, CHAR						      ; 1092

	      00000042   8F	       56  D1 001C4 28$:    CMPL    CHAR, #66						      ; 1093

				       1B  13 001CB 	    BEQL    29$							      ;

	      0000004F   8F	       56  D1 001CD 	    CMPL    CHAR, #79						      ;

				       12  13 001D4 	    BEQL    29$							      ;

	      00000044   8F	       56  D1 001D6 	    CMPL    CHAR, #68						      ;

				       09  13 001DD 	    BEQL    29$							      ;

	      00000058   8F	       56  D1 001DF 	    CMPL    CHAR, #88						      ;

				       46  12 001E6 	    BNEQ    33$							      ;

		         51	  02   A8  9A 001E8 29$:    MOVZBL  2(INPUT_PTR), NEW_CHAR				      ; 1113

	   50 30800000   8F 00000000'EF41  78 001EC 	    ASHL    CHAR_TYPE_TABLE[NEW_CHAR], #813694976, R0		      ; 1115

				       33  18 001F9 	    BGEQ    33$							      ; 1114

		         58	       02  C0 001FB 	    ADDL2   #2, INPUT_PTR					      ; 1118

				       50  D4 001FE 	    CLRL    INDEX						      ; 1119

			    00000000'EF40  3F 00200 30$:    PUSHAW  RADIX_EQUIV_TBL[INDEX]				      ; 1120

	   9E	         08	       00  ED 00207 	    CMPZV   #0, #8, @(SP)+, CHAR				      ;

				       56     0020B									      ;

				       10  12 0020C 	    BNEQ    31$							      ;

			    00000000'EF40  3F 0020E 	    PUSHAW  RADIX_EQUIV_TBL+1[INDEX]				      ; 1123



; Bliss-32 7.352	Saturday 22-AUG-1978 03:15:40	DBB3:[PATCH.SRC]PATLEX.B32;14					Page 8-4

; Digital Equipment Corporation

;

	      00000000G  FF	       9E  90 00215 	    MOVB    @(SP)+, @PAT$GB_MOD_PTR				      ;

				       04  11 0021C 	    BRB     32$							      ; 1125

	   DE	         50	       03  F3 0021E 31$:    AOBLEQ  #3, INDEX, 30$					      ; 1119

		         56	       51  D0 00222 32$:    MOVL    NEW_CHAR, CHAR					      ; 1127

		         67	       02  A2 00225 	    SUBW2   #2, (R7)						      ; 1128

		    0C   AE	       02  D0 00228 	    MOVL    #2, STATE						      ; 1129

				       4E  11 0022C 	    BRB     38$							      ; 1130

		         56	  5E   8F  9A 0022E 33$:    MOVZBL  #94, CHAR						      ; 1138

				     FE33  31 00232 	    BRW     6$							      ; 1139

		         51 00000000'EF46  9E 00235 34$:    MOVAB   CHAR_TYPE_TABLE[CHAR], R1				      ; 1150

		         09	       61  91 0023D 	    CMPB    (R1), #9						      ;

				       2D  1F 00240 	    BLSSU   37$							      ;

		         1C	       61  91 00242 	    CMPB    (R1), #28						      ; 1151

				       28  1A 00245 	    BGTRU   37$							      ;

		         50	       09  D0 00247 	    MOVL    #9, INDEX						      ; 1158

	   61	         08	       00  ED 0024A 35$:    CMPZV   #0, #8, (R1), INDEX					      ; 1161

				       50     0024E									      ;

				       17  12 0024F 	    BNEQ    36$							      ;

		         6B	       56  90 00251 	    MOVB    CHAR, (LEXEME_PTR)					      ; 1164

		    04   BE	       01  B0 00254 	    MOVW    #1, @4(SP)						      ; 1165

      00   BE	         58	       01  C1 00258 	    ADDL3   #1, INPUT_PTR, @0(SP)				      ; 1166

				       67  B7 0025D 	    DECW    (R7)						      ; 1167

		         50 00000000'EF40  9A 0025F 	    MOVZBL  TOKEN_TABLE-9[INDEX], R0				      ; 1168

					   04 00267 	    RET     							      ;

				       50  D6 00268 36$:    INCL    INDEX						      ; 1170

		         1C	       50  D1 0026A 	    CMPL    INDEX, #28						      ; 1171

				       DB  15 0026D 	    BLEQ    35$							      ;

			    006D80BA   8F  DD 0026F 37$:    PUSHL   #7176378						      ; 1180

	      00000000G  00	       01  FB 00275 	    CALLS   #1, LIB$SIGNAL					      ;

				     FDED  31 0027C 38$:    BRW     7$							      ; 0905



; Routine Size:  639 bytes







; Bliss-32 7.352	Saturday 22-AUG-1978 03:15:40	DBB3:[PATCH.SRC]PATLEX.B32;14					Page 9

; Digital Equipment Corporation

;

;	1186	END								! End of module

;	1187	ELUDOM









							    .GLOBL  LIB$SIGNAL



;				       PSECT SUMMARY

;

;	Name		 Bytes			       Attributes

;

;  _PAT$PLIT      	   184  NOWRT,  RD ,NOEXE,NOSHR,  LCL,  REL,  CON,NOPIC,ALIGN(0)

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

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









;				LIBRARY STATISTICS

;

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

;	File				     Total    Loaded   Percent      Read

;

;  DBA4:[SYSLIB]LIB.L32;1		      5582         5         0       223











; Size:		639 code + 184 data bytes

; Run Time:	00:32.7

; Elapsed Time:	01:09.4

; Memory Used:	465 pages

; Compilation Complete

