Trailing-Edge
-
PDP-10 Archives
-
decuslib20-07
-
decus/20-0172/parse1.bli
There is 1 other file named parse1.bli in the archive. Click here to see a list.
!<BLF/lowercase_user>
!<BLF/uppercase_key>
MODULE prs1 ( !
%IF %BLISS (BLISS32)
%THEN
ADDRESSING_MODE (EXTERNAL = LONG_RELATIVE, !
NONEXTERNAL = LONG_RELATIVE) ,
%FI
IDENT = '6.3-9'
) =
BEGIN
!++
! Facility: BLISS Formatter
!
! Abstract:
!
! This module contains routines which format blocks, PLITs,
! modules and switches. It also contains the main routine
! for the parser, 'prs$main'.
!
! Environment: transportable, with Xport
!
!
! Modifications:
! Nov 1978 SPR04: Weaken 'Block' definition to include [],<>.
!
!
! REVISION HISTORY
!
! 15-Sep-81 TT Don't call lex if we find s_forward or
! s_external tokens. If we take the next token
! here, format screws up and the lines aren't
! broken properly in LSTING (I believe). This is
! in routine PRS$BODY.
!
! 28-Sep-81 TT New syntax allows complete PSECTs within Plits.
! Change PRS$PLIT_BODY to handle a psect.
!
! END OF REVSISION HISTORY
!--
!<BLF/page>
!
! Table of contents:
!
FORWARD ROUTINE
prs$block : NOVALUE,
prs$body : NOVALUE,
prs$main : NOVALUE,
prs$module : NOVALUE,
prs$plit_body : NOVALUE,
prs$switches : NOVALUE;
!
! Include files:
!
REQUIRE 'BLFMAC'; ! Defines macros 'lex', 'msg', 'write'
REQUIRE 'SYMCOD'; ! Defines symbol property table, 'sym...'
REQUIRE 'TOKTYP'; ! Defines 'token' and the token type values 's_...'
REQUIRE 'UTLCOD'; ! Defines error codes, i.e. 'er_...'
!
! Macros:
!--
!
! Equated symbols:
!--
LITERAL
true = 1 EQL 1,
false = 1 NEQ 1;
!
! Own storage:
!--
!
! External references:
!--
EXTERNAL ROUTINE
lex$getsym : NOVALUE,
lst$module : NOVALUE,
out$break : NOVALUE,
out$default : NOVALUE,
out$erase : NOVALUE,
out$eject : NOVALUE,
out$force : NOVALUE,
out$indent : NOVALUE,
out$mark : NOVALUE,
out$ntbreak : NOVALUE,
out$pop_marks : NOVALUE,
out$push_marks : NOVALUE,
out$space : NOVALUE,
out$stoks : NOVALUE,
out$terminal : NOVALUE,
out$tok : NOVALUE,
prs$decl : NOVALUE, ! parse2
prs$expression : NOVALUE, ! parse3
prs$set_level : NOVALUE, ! Parse2
utl$error : NOVALUE;
EXTERNAL
nolabl, ! true in decl context
tok,
token : tok_block, ! One symbol at a time
symprop : sym_table;
GLOBAL ROUTINE prs$block : NOVALUE =
!++
! Functional description:
! This routine formats 'BEGIN' or '(' blocks.
!
! Formal parameters:
! None
!
! Implicit inputs:
! None
!
! Implicit outputs:
! None
!
! Routine value:
! None
!
! Side effects:
! None
!--
BEGIN
LOCAL
which; ! The open bracket for the block
WHILE .tok EQL s_name DO
BEGIN
!+
! Process a label
!-
! The following test is heuristic: if the expected colon is
! one space beyond the current name, we can pre-recognize it
! and left-adjust the label. Otherwise the label will be
! indented with the surrounding text.
IF CH$RCHAR (CH$PLUS (.token [tok_cp], .token [tok_len])) EQL %C' ' AND !
CH$RCHAR (CH$PLUS (.token [tok_cp], .token [tok_len] + 1)) EQL %C':' !
AND NOT .nolabl
THEN
out$ntbreak ()
ELSE
out$break ();
out$tok (); ! Label
lex;
IF .tok EQL s_colon
THEN ! Now we surely have a label.
BEGIN
out$tok (); ! ":"
out$force ();
lex;
END
ELSE
utl$error (er_colon);
END; ! Process a label
!+
! Now the unlabelled block
!-
which = .tok;
IF .tok EQL s_begin
THEN
out$force ()
ELSE
IF .symprop [.tok, sym_type] NEQ open_bracket
THEN
(utl$error (er_block_start); out$default ();
lex; RETURN );
out$tok (); ! "(" or "BEGIN"
IF .tok EQL s_begin THEN out$force (); ! Force newline after the BEGIN
lex;
prs$body (.which);
END; ! End of routine 'prs$block'
GLOBAL ROUTINE prs$body (block_context) : NOVALUE = !
!++
! Functional description:
! This routine formats the block body
!
! Formal parameters:
! block_context - open bracket, either BEGIN or '('
!
! Implicit inputs:
! None
!
! Implicit outputs:
! None
!
! Routine value:
! None
!
! Side effects:
! None
!--
BEGIN
LOCAL
expr_type;
out$push_marks (); ! Push down mark stack
expr_type = null_symbol;
WHILE .tok NEQ s_end_of_file DO
BEGIN
SELECTONE .tok OF
SET
[s_end, s_rparen, s_rbracket, s_rangle, s_end_of_file, s_percent] :
EXITLOOP;
[first_decl TO last_decl] :
prs$decl (.block_context);
[OTHERWISE] : ! It should be an expression
BEGIN
out$indent (-1); ! Prs$expression will re-indent
expr_type = .tok;
prs$expression (.block_context);
out$indent (1);
!+
! Next token is an expr-terminator
!-
SELECTONE .tok OF
SET
[s_end, s_rparen, s_rbracket, s_rangle, s_end_of_file, s_percent] :
EXITLOOP;
[s_semicolon] :
BEGIN
out$erase ();
out$tok (); ! ";"
lex;
IF .block_context EQL s_lparen
THEN
BEGIN
out$space (1);
out$pop_marks ();
out$push_marks ();
out$mark (0);
END
ELSE
out$force ();
END;
[s_comma] :
BEGIN
! This treatment of commas is not correct
! according to BLISS syntax, but is needed
! To handle references to unexpanded keyword macros.
IF .block_context EQL s_begin THEN utl$error (er_end_block);
out$tok ();
out$space (1);
lex;
END;
[s_forward, s_external]: ! TT 15-Sep-81
0;
[OTHERWISE] :
BEGIN
out$default (); ! Something unexpected, but put it out.
lex;
END;
TES;
expr_type = null_symbol;
END
TES;
END;
out$pop_marks ();
IF .tok EQL s_end_of_file AND .block_context EQL s_end_of_file OR !
.tok EQL s_percent AND .block_context EQL s_percent
THEN ! Called from prs$main, so...
(0) ! Ready to exit
ELSE
BEGIN
IF .tok EQL s_end AND .block_context EQL s_begin
THEN
BEGIN
out$break ();
out$tok (); ! "END"
lex;
IF .tok NEQ s_semicolon THEN out$force ();
END
ELSE
BEGIN
IF .tok EQL s_rparen AND .block_context EQL s_lparen OR !
.tok EQL s_rbracket AND .block_context EQL s_lbracket OR !
.tok EQL s_rangle AND .block_context EQL s_langle !
THEN
out$tok ()
ELSE
(utl$error (er_end_block); out$default (); );
lex;
END;
END;
END; ! End of routune 'prs$body'
GLOBAL ROUTINE prs$main : NOVALUE = !
!++
! Functional description:
! Main entry to parser.
! A BLISS file may consist of one or more modules,
! or a sequence of declarations, or it may contain
! references to predefined macros or conditional
! compilation directives (%IF...). The most useful
! point at which to begin the parse is to assume that
! the file consists of a block body, which may contain
! any of these.
!
! Formal parameters:
! None
!
! Implicit inputs:
! None
!
! Implicit outputs:
! None
!
! Routine value:
! None
!
! Side effects:
! None
!--
BEGIN
tok = s_eludom; ! Assure second files handled OK.
prs$set_level (); ! Set macro level to 0
lex; ! Look at first thing in the file.
UNTIL .tok EQL s_end_of_file DO
prs$body (s_end_of_file);
out$break (); ! Flush any partial line
END; ! End of routine 'prs$main'
GLOBAL ROUTINE prs$module : NOVALUE = !
!++
! Functional description:
! Parses Module declarations.
!
! Formal parameters:
! None
!
! Implicit inputs:
! None
!
! Implicit outputs:
! None
!
! Routine value:
! None
!
! Side effects:
! None
!--
BEGIN
out$eject (s_module); ! Provide for future ejects
IF .tok NEQ s_name ! A name is of course expected here
THEN
utl$error (er_name);
out$tok (); ! Output the module name
! Save the module name for the listing file headings
lst$module (.token [tok_len], .token [tok_cp]);
out$terminal (); ! Display the name of the module
lex;
!+
! Either switch list or nothing
!-
IF .tok EQL s_lparen
THEN
BEGIN
out$space (1);
out$tok (); ! " ("
out$indent (4);
lex;
prs$switches (); ! Switches, ...
IF .tok EQL s_rparen
THEN
(out$break (); out$tok (); lex; ) ! ")"
ELSE
utl$error (er_rparen);
out$indent (-4);
END;
IF .tok EQL s_equal
THEN
BEGIN
out$stoks (); ! " = "
out$force ();
lex;
END
ELSE
utl$error (er_pmodule);
prs$block (); ! Parse a block
UNTIL .tok EQL s_eludom DO
BEGIN
!+
! An extra block END has occurred.
! Note that ELUDOM was expected, but indent one level
! and assume a block body follows.
!-
utl$error (er_pmodule);
out$default ();
out$indent (1);
lex;
prs$body (s_begin);
END;
END; ! End of routine 'prs$module'
GLOBAL ROUTINE prs$plit_body (block_context) : NOVALUE = !
!++
! Functional description:
! This routine formats the body of a PLIT.
! It is called recursively on a nested PLIT.
!
! Formal parameters:
! None
!
! Implicit inputs:
! None
!
! Implicit outputs:
! None
!
! Routine value:
! None
!
! Side effects:
! None
!--
BEGIN
!+
! Check for allocation unit
!-
IF .symprop [.tok, sym_type] EQL alloc_unit
THEN
BEGIN
out$tok (); ! "BYTE", "WORD", or "LONG"
lex;
END;
IF .tok EQL s_psect ! TT 28-Sep-81
THEN
prs$decl (.block_context);
prs$block ();
END; ! End of routine 'prs$plit_body'
GLOBAL ROUTINE prs$switches (context) : NOVALUE =
!++
! Functional description:
! This routine formats either a switches declaration,
! Or the module head switches.
!
! Formal parameters:
! None
!
! Implicit inputs:
! None
!
! Implicit outputs:
! None
!
! Routine value:
! None
!
! Side effects:
! None
!--
!<BLF/page>
BEGIN
LOCAL
plev; ! Parenthesis level
plev = 0;
WHILE .tok NEQ s_end_of_file DO
BEGIN
SELECTONE .tok OF
SET
[s_rparen] :
BEGIN
plev = .plev - 1;
IF .plev LSS 0 ! End of switch list in module header
THEN
EXITLOOP ! Caller will handle this token
ELSE
out$tok (); ! ") "
out$space (1);
END;
[s_lparen] :
BEGIN
plev = .plev + 1;
out$space (1);
out$tok (); ! "("
END;
[s_comma] :
BEGIN
out$tok (); ! ","
IF .plev EQL 0 THEN out$force () ELSE out$space (1);
END;
[s_semicolon] :
BEGIN
IF .plev EQL 0
THEN
EXITLOOP ! Caller will handle this token
ELSE
(out$tok (); out$force (); ); ! " ; "
END;
[first_decl TO last_decl] :
out$tok ();
[OTHERWISE] :
out$default (); ! Anything, usually identifiers
TES;
lex;
END;
END; ! End of routine 'prs$switches'
%TITLE 'Last page of PARSE1.BLI'
END ! End of module 'PARSE1'
ELUDOM