MODULE sca_psect; !+ ! This program generates lots of PSECT declarations. It generates ! $TOKEN, $MACRO and $CODE. It also generates $DATA and put any ! static variables there. For every COMMON variable, a PSECT of ! the same name is generated to contain it. READ and WRITE statements ! without file variables implicitly declare COMMON file variables ! called SYS$INPUT and SYS$OUTPUT. ! ! Unfortunately, you can't display SCAN psects directly with SCA ! commands. (Or if you can, I don't know how.) So this has to ! be an ANADUMP test. Ugh!!! ! ! Melinda Barton - 7-APR-1989 !- !+ ! COMMON storage at the module level !- DECLARE some_file: COMMON FILE; DECLARE a,b,c : COMMON INTEGER; DECLARE some_str: COMMON STRING (25); DECLARE some_tree: COMMON TREE (STRING, INTEGER) OF STRING; !+ ! GLOBAL storage !- DECLARE glob_int: GLOBAL INTEGER; DECLARE glob_str: GLOBAL STRING; CONSTANT compile_file = 2; !+ ! Variables that are declared but never referenced are not allocated. ! Therefore, they should not get PSECT information. !- DECLARE not_alloc: COMMON INTEGER; !+ ! Generate some tokens and macros. The tables go in $TOKEN and $MACRO !- SET non_quote ( NOT( s'eol' OR s'eos' OR '''' ) ); SET eol ( s'eol' OR s'eos' ); SET non_eol ( NOT eol ); SET alpha ( 'a'..'z' OR 'A'..'Z' ); SET other ( alpha OR '0'..'9' OR '_' OR '$' ); TOKEN require CASELESS { 'require' }; TOKEN name { alpha [ other... ] }; TOKEN semi ALIAS ';' { ';' }; TOKEN space IGNORE { { ' ' | s'ht' | s'ff' }... }; TOKEN comment { '!' non_eol... eol }; TOKEN spec { '''' non_quote... '''' }; !+ ! Declare some $DATA static storage at the module level !- DECLARE reference: TREE( integer, string, string ) of integer; DECLARE file_name: string; DECLARE file_type: integer; MACRO find_require_reference trigger { require s:spec semi }; !+ ! Declare COMMON storage within a PSECT !- DECLARE var_in_macro: COMMON INTEGER; s = trim( s, ''''); reference( file_type, file_name, s ) = 0; var_in_macro = 0; END MACRO; PROCEDURE main MAIN ( ); !+ ! These are dynamic, and should NOT have psects !- DECLARE file_spec,full_file_name: STRING; DECLARE context: INTEGER; !+ ! Generate the SYS$INPUT and SYS$OUTPUT psects !- WRITE 'file spec to process:'; READ file_spec; !+ ! Reference all the variables, so the allocator will allocate them. !- glob_int = 27; glob_str = 'I am a global string'; OPEN FILE( some_file ) AS 'foo.bar' FOR OUTPUT; a = 1; b = 2; c = a + b; some_str = 'hello world'; some_tree ('foobar', 27) = 'hello'; full_file_name = 'dtm_tst:sca_psect.scn'; context = 0; END PROCEDURE; PROCEDURE some_proc (); !+ ! Procedure level declarations. Only STATIC and COMMON get psects. !- DECLARE p0: STATIC TREEPTR( integer ) TO TREE( string,string ) of integer; DECLARE p1: TREEPTR( string ) TO TREE( string ) of integer; DECLARE p2: COMMON TREEPTR( string ) TO integer; DECLARE line,command: STATIC string; DECLARE i: integer; IF EXISTS( reference( compile_file )) THEN p1 = first( reference( compile_file ) ); WHILE p1 >< NIL; p1 = NEXT( p1 ); IF p1 <> NIL THEN line = line & ', -'; END IF; END WHILE; END IF; p0 = first( reference ); WHILE p0 >< NIL; p1 = first( p0 ); p2 = first( p1 ); END WHILE; command = 'do this NOW!'; I = 0; END PROCEDURE; !+ ! COMMON variables with the same name over overlaid within the same ! PSECT. The size of the PSECT should be the same size as the largest ! variable that it contains. Make sure this is the case. !- PROCEDURE com_over1 ( ); DECLARE over1: COMMON INTEGER; DECLARE over2: COMMON STRING (20); over1 = 27; over2 = '12345678901234567890'; END PROCEDURE; PROCEDURE com_over2 ( ); DECLARE over1: COMMON STRING (10); DECLARE over2: COMMON STRING (10); over1 = 'Hello there!!!'; over2 = '0987654321'; END PROCEDURE; PROCEDURE com_over3 ( ); DECLARE over1: COMMON STRING (8); over1 = '12345678'; END PROCEDURE; END MODULE;