(**********  #File "CLIP_UNIX.PAS" (#Indent on, #Comment on)   *******)
  (*********************************************************************)
  (* Program:     CLIP_2   - Code from LIterate Program: 2-nd pass     *)
  (* Purpose:     Perform a run of the CLIP-system.                    *)
  (* Interface:   CLIP.INI:   File which contains all the information  *)
  (*                          for this particular run.                 *)
  (*              <sources>:  Files containing the refinements.        *)
  (*              <modules>:  Files containing the generated modules.  *)
  (*********************************************************************)
  PROGRAM CLIP_2 (INPUT, OUTPUT);
  (*-----------   Global parameters of the CLiP system  ---------------*)
  CONST
      CLiP =              'Code from Literate Programs';
      CLIP_VERSION =      'CLiP version 2.1';    (* Mod: EWvA 16/10/93 *)
      DFLT_INIFILE =      'CLIP.INI';            (* Mod: EWvA 16/10/93 *)
      DFLT_INIFILE_L =    8;                     (* Mod: EWvA 16/10/93 *)
      STRING_FIXED_L =        132;
      EMPTY_STRING_FIXED =    '                                            '+
                              '                                            '+
                              '                                            ';
      MAX_FILE_SPEC_L =       132;
      MAX_NR_FILE_SPECS =     64;
      MAX_CHOICE_L =          100;
      ALLOWED_ID_CHARS =      ['A'..'Z', 'a'..'z', '0'..'9', '.'];
      ERROR_MSG_LENGTH =      80;
      LOC_SPEC_L =            25;
      CORRUPT_INI_FILE  =     1;        (* Error_code used by CLIP_MNU *)
      FT_SIZE =               MAX_NR_FILE_SPECS;
      MAX_LINE =              132;
      ST_SIZE =               30000;
      SP_SIZE =               65000;
      SYNTAX_LEN =            10;
      MAX_MODE_L =            16;
      MAX_M_D_L =             10;
      MAX_NR_SRC_FILES =      MAX_NR_FILE_SPECS;
      MAX_NR_RSLT_MODULES =   10;
      MAX_EXTR_MODE_L =       9;
      MAX_FILE_EXT_L =        39;
      MAX_OPTION_LENGTH =     15;
      MAX_OPTIONS =           12;

  (*-----------   Constants to assist implemention of ADTs  -----------*)
  CONST
      MAX_NR_MESS =  35;
      MAX_ERROR = 100;
  CONST
      EMPTY_OPTION = '               ';

  (*-----------   Global simple types of the CLiP system  -------------*)
  TYPE
      TO_BE_DECIDED_LATER_ =  (DEFINED,UNDEFINED);
      LONGINTEGER =           -2147483647..2147483647;
      STRING_FIXED_ =         PACKED ARRAY[1..STRING_FIXED_L] OF CHAR;
      FILE_MODE_ =            (INSP_MODE, GEN_MODE);
      SPECIAL_CHOICE_ =       CHAR;
      ALLOWED_ANSW_ =         SET OF CHAR;
      ERROR_MSG_ =            STRING_FIXED_;
      SEV_CODE_ =             (WARN, ERR, FAIL, DUMP);
      LOC_SPEC_ =             PACKED ARRAY[1..LOC_SPEC_L] OF CHAR;
      FT_INDEX_ =             0..FT_SIZE;
      ERROR_CODE_ =           INTEGER;
      ST_INDEX_ =             -1..ST_SIZE;
      SEGMENT_TYPE_ =         (STUB, SLOT, CODE, END_STUB);
      SP_INDEX_ =             -1..SP_SIZE;
      SYNTAX_STRING_ =        STRING_FIXED_;
      MODE_ =                 STRING_FIXED_;
      MESSAGE_DESTINATION_ =  STRING_FIXED_;
      EXTR_MODE_ =            STRING_FIXED_;
      FILE_EXT_ =             STRING_FIXED_;
      CATEGORY_ =             (L1, L2, L3, L4, L5);
      SLT_PTR_ =              ^SLOT_DES_;
      STB_PTR_ =              ^STUB_DES_;
      SHADOW_PTR_ =           ^SHADOW_LIST_;

  (*-----------   Global structured types of the CLiP system  ---------*)
      STRING132_ =            RECORD
                                  BODY:   STRING_FIXED_;
                                  LENGTH: INTEGER;
                              END (*RECORD*);
      FILE_SPEC_ =            RECORD
                                  LENGTH:  INTEGER;
                                  BODY:    STRING_FIXED_;
                              END (*RECORD*);
      RSLT_MOD_SPEC_ =        RECORD
                                  FILE_NAME: FILE_SPEC_;
                                  PATH:      FILE_SPEC_;
                              END (*RECORD*);
      SOURCE_FILES_ =         ARRAY[1..MAX_NR_SRC_FILES] OF FILE_SPEC_;
      RSLT_MODULES_ =         ARRAY[1..MAX_NR_RSLT_MODULES] OF
                                                          RSLT_MOD_SPEC_;
      FILE_SPECS_ =           RECORD
                                  NR_FILE_SPECS: INTEGER;
                                  FILES: SOURCE_FILES_;
                              END (*RECORD*);
      LINE_DES_ =             RECORD
                                  CHARS:             STRING_FIXED_;
                                  INDENT:            INTEGER;
                                  USED:              INTEGER;
                                  ID:                INTEGER;
                                  POS_OPTION_MARKER: INTEGER;
                              END (*RECORD*);
      SEGMENT_DES_ =          RECORD
                                  FIRST:    ST_INDEX_;
                                  LAST:     ST_INDEX_;
                              END (*RECORD*);
      STRING_DES_ =           RECORD
                                  FIRST:  SP_INDEX_;
                                  LAST:   SP_INDEX_;
                              END (*RECORD*);
      SYNTAX_ =               RECORD
                                  BODY:   SYNTAX_STRING_;
                                  LENGTH: INTEGER;
                              END (*RECORD*);
      RUN_INFO_ = RECORD
                      CLIP_LPAR,
                      CLIP_RPAR:            SYNTAX_;
                      CLIP_CC:              CHAR;
                      CLIP_END:             SYNTAX_;
                      OPTION_MARKER:        CHAR;
                      MODE:                 MODE_;
                      INT_FAULT_CORR:       BOOLEAN;
                      MESSAGE_DESTINATION:  MESSAGE_DESTINATION_;
                      REPORT_FILE_SPEC:     FILE_SPEC_;
                      NR_SRC_FILES:         INTEGER;
                      SOURCE_FILES:         SOURCE_FILES_;
                      EXTR_MODE:            EXTR_MODE_;
                      NR_MODULES:           INTEGER;
                      RSLT_MODULES:         RSLT_MODULES_;
                      DFLT_EXT:             FILE_EXT_;
                      MODULE_DIRECTORY:     FILE_SPEC_;
                  END (*RECORD*);
      LINE_INFO_ =            RECORD
                                  LINE_ID:    STRING_DES_;
                                  CATEGORY:   CATEGORY_;
                                  OPTIONS:    BOOLEAN;
                              END (*RECORD*);
      OPTIONS_  =             RECORD
                                  QUICK,  MULTIPLE, OPTIONAL,  OVERRULE,
                                  LEADER, TRAILER,  SEPARATOR, DEFAULT,
                                  LINENUMBER:                     BOOLEAN;
                                  INDENT,
                                  FILE_NAME,
                                  COMMENT:                        STRING_DES_;
                              END (*RECORD*);
      STUB_DES_ =             RECORD
                                  NAME:       STRING_DES_ ;
                                  SRC_IMG:    SEGMENT_DES_;
                                  OPTIONS:    OPTIONS_    ;
                                  SLOTS:      SLT_PTR_    ;
                                  NEXT_TWIN,
                                  NEXT_STUB:  STB_PTR_    ;
                                  VISITED:    BOOLEAN     ;
                              END (*RECORD*);
      SLOT_DES_ =             RECORD
                                  NAME:       STRING_DES_;
                                  SRC_IMG:    SEGMENT_DES_;
                                  OPTIONS:    OPTIONS_;
                                  STUB_REF:   STB_PTR_;
                                  CODE:       SEGMENT_DES_;
                                  NEXT_SLOT:  SLT_PTR_;
                              END (*RECORD*);
      CODE_STRUCT_ =          RECORD
                                  FIRST_STUB: STB_PTR_;
                                  LAST_STUB:  STB_PTR_;
                              END (*RECORD*);
      SHADOW_LIST_ =          RECORD
                                  STUB_POINTER:   STB_PTR_;
                                  NEXT:           SHADOW_PTR_;
                              END (*RECORD*);

  (*-----------   Types to assist implemention of ADTs  ---------------*)
  TYPE
      SP_TYPE =   RECORD
                       CHARS: ARRAY[1..SP_SIZE] OF CHAR;
                       USED : SP_INDEX_;
                   END (*RECORD*);
      SP_PTR =     ^SP_TYPE;
  TYPE
      OPTION_KEYWORD_ =   PACKED ARRAY [1..MAX_OPTION_LENGTH] OF CHAR;

  (*-----------   Global variables of the CLiP system  ----------------*)
  VAR
      REPORT_FILE:    TEXT;
      REPORT_OK:      BOOLEAN;

  (*-----------   Variables to assist implemention of ADTs  -----------*)
  VAR
      START, STOP:    LONGINTEGER;
      CONTINUE:       BOOLEAN;
      RUN_INFO:       RUN_INFO_;
      CODE_STRUCT:    CODE_STRUCT_;
      (* STRING132:      STRING132_;   22/10/93  *)
      (* DUMMY_LINE:     LINE_DES_;    22/10/93  *)
      (* DUMMY_SEG:      SEGMENT_DES_; 22/10/93  *)
      DUMMY_ERROR:    INTEGER;
      INI_FILE:           TEXT;
      EXT_FILE_SPEC:      FILE_SPEC_;
      DUMMY_FILE_OK:      BOOLEAN;
      DUMMY_ERROR_MSG:    ERROR_MSG_;
      DUMMY_ERROR_CODE:   INTEGER;
      ERROR_CODE:         ERROR_CODE_;
      AUX_STRING_8:       PACKED ARRAY[1..8] OF CHAR;
      I:                  INTEGER;
          ERROR_MSG : ERROR_MSG_;
  VAR
      FILE_TABLE: ARRAY[1..FT_SIZE] OF RECORD
                      FILE_SPEC:  FILE_SPEC_;
                      FIRST:      INTEGER;
                      LAST:       INTEGER;
                  END (*RECORD*);
      LAST_LINE:  INTEGER;
      LAST_FILE:  FT_INDEX_;
      CURR_IN_FILE:   TEXT;
      CURR_OUT_FILE:  TEXT;
      SPACE:             SET OF CHAR;
  VAR
      SEGMENT_TABLE:  RECORD
                          LINES: ARRAY [1..ST_SIZE] OF LINE_DES_;
                          USED:  ST_INDEX_;
                      END (*RECORD*);
      LAST_READ_SEG:  RECORD
                          LAST_SEG:  SEGMENT_DES_;
                          LAST_LINE: ST_INDEX_;
                      END (*RECORD*);
  VAR
      STRING_POOL: SP_PTR;
      BUFFER:      STRING132_;
  VAR
      DIAG_TBL:   ARRAY[1..MAX_NR_MESS] OF
                      RECORD
                          MESSAGE:        STRING_FIXED_;
                          MESS_LOC:       LOC_SPEC_;
                          MESS_L:         INTEGER;
                      END (*RECORD*);
      NO_MESSAGES:    BOOLEAN;
      MSG_TBL:    ARRAY[1..MAX_ERROR+1] OF
                      RECORD
                          SEV:            SEV_CODE_;
                          LOC:            LOC_SPEC_;
                          SOURCE_LINE:    LINE_DES_;
                          SEGMENT:        SEGMENT_DES_;
                          STRING132:      STRING132_;
                          LINE_ABS:       INTEGER;
                      END (*RECORD*);
      NR_MSG:     INTEGER;
  VAR
      ALLOWED:        SET OF CHAR;
  VAR
      OPTION_TABLE:       ARRAY [1..MAX_OPTIONS] OF OPTION_KEYWORD_;
      OPT_SPACE:          SET OF CHAR;
      OPT_CHARS:          SET OF CHAR;
      DEFAULT_OPTIONS:    OPTIONS_;
      PASCAL_STRING:      STRING_FIXED_;
      FORTRAN_STRING:     STRING_FIXED_;
      C_STRING:           STRING_FIXED_;

  (*-----------   Forward declarations  -------------------------------*)
  PROCEDURE CLIP_STOP; FORWARD;
  PROCEDURE EXT_FILE_CLOSE( VAR FILE_VAR  : TEXT;
                            VAR ERROR_CODE: INTEGER);   FORWARD;
  PROCEDURE EXT_FILE_PREP (VAR FILE_VAR:     TEXT;
                           EXT_FILE_SPEC:    FILE_SPEC_;
                           FILE_MODE:        FILE_MODE_;
                           VAR FILE_OK:      BOOLEAN;
                           VAR ERROR_CODE:   INTEGER;
                           VAR ERROR_MSG:    ERROR_MSG_ );
                                                                 FORWARD;
  PROCEDURE READ_FILE_SPEC (VAR AUX_FILE_SPEC: FILE_SPEC_;
                            VAR FILE_SPEC_OK:  BOOLEAN);
                                                                 FORWARD;
  PROCEDURE UC_WORD (VAR STR:  PACKED ARRAY [ONE..LEN:INTEGER]
                                    OF CHAR);                FORWARD;
  PROCEDURE WRITE_STRING (VAR OUT_FILE:   TEXT;
                                   OUT_STRING: STRING_FIXED_;
                                   NR_CHARS:   INTEGER);     FORWARD;
  PROCEDURE WRLN_STRING (VAR OUT_FILE:   TEXT;
                                  OUT_STRING: STRING_FIXED_;
                                  NR_CHARS:   INTEGER;
                                  SPACE:      INTEGER);      FORWARD;
  FUNCTION  CHECK_SYNTAX (LPAR, RPAR, END_STRING: SYNTAX_;
                          CC, MARKER:             CHAR): BOOLEAN;
                                                                 FORWARD;
  PROCEDURE INIT_RUN_INFO (VAR INIT_INFO: RUN_INFO_);
                                                                 FORWARD;
  PROCEDURE READ_INI_FILE (VAR INI_FILE:      TEXT;
                           VAR READ_INFO:     RUN_INFO_;
                           EXT_FILE_SPEC:     FILE_SPEC_;
                           VAR FILE_OK:       BOOLEAN;
                           VAR ERROR_MSG:     ERROR_MSG_;
                           VAR ERROR_CODE:    INTEGER);
                                                                 FORWARD;
  PROCEDURE READ_LINE_SAFELY (VAR FILE_IN: TEXT);
                                                                 FORWARD;
  PROCEDURE READ_STRING (VAR IN_FILE:       TEXT;
                         VAR IN_STR_LN:     INTEGER;
                         VAR IN_STR_BODY:   STRING_FIXED_;
                         NR_CHARS_TO_READ:  INTEGER);
                                                                 FORWARD;
  FUNCTION  UC (INCHAR: CHAR): CHAR;
                                                                 FORWARD;
  PROCEDURE VAL_INI_DATA (VAR VAL_INFO: RUN_INFO_;
                          VAR OK:       BOOLEAN);
                                                                 FORWARD;
  FUNCTION  FT_ABS_LINE_NUMBER (SOURCE_LINE: LINE_DES_): INTEGER;
                                                                 FORWARD;
  FUNCTION  FT_CHECK_FILE (FILE_SPEC: FILE_SPEC_): ERROR_CODE_;
                                                                 FORWARD;
  FUNCTION  FT_EOF: BOOLEAN;
                                                                 FORWARD;
  FUNCTION  FT_GET_CHAR (SOURCE_LINE: LINE_DES_; INDEX: INTEGER): CHAR;
                                                                 FORWARD;
  PROCEDURE FT_GET_FILE_SPEC
                      (SOURCE_LINE:LINE_DES_; VAR FILE_SPEC:FILE_SPEC_);
                                                                 FORWARD;
  FUNCTION  FT_GET_INDENT (SOURCE_LINE: LINE_DES_): INTEGER;
                                                                 FORWARD;
  FUNCTION  FT_GET_LINE_LENGTH (SOURCE_LINE: LINE_DES_): INTEGER;
                                                                 FORWARD;
  FUNCTION  FT_GET_LINE_NUMBER (SOURCE_LINE: LINE_DES_): INTEGER;
                                                                 FORWARD;
  FUNCTION  FT_GET_POS_OPTION_MARKER (SOURCE_LINE: LINE_DES_): INTEGER;
                                                                 FORWARD;
  FUNCTION  FT_INCLOSE: ERROR_CODE_;
                                                                 FORWARD;
  PROCEDURE FT_INIT;
                                                                 FORWARD;
  PROCEDURE FT_INIT_LINE (VAR LINE: LINE_DES_);
                                                                 FORWARD;
  FUNCTION  FT_INOPEN (FILE_SPEC: FILE_SPEC_): ERROR_CODE_;
                                                                 FORWARD;
  FUNCTION  FT_OUTOPEN (FILE_SPEC: FILE_SPEC_): ERROR_CODE_;
                                                                 FORWARD;
  FUNCTION  FT_OUTCLOSE: ERROR_CODE_;
                                                                 FORWARD;
  PROCEDURE FT_RDLN (VAR LINE: LINE_DES_);
                                                                 FORWARD;
  PROCEDURE FT_WRLN (VAR LINE: LINE_DES_; NR_BLANKS:   INTEGER;
                                          DESTINATION: INTEGER);
                                                                 FORWARD;
  FUNCTION  ST_ABS_SEG (SEGMENT: SEGMENT_DES_):INTEGER;
                                                                 FORWARD;
  PROCEDURE ST_GET_FILE_SPEC (    SEGMENT: SEGMENT_DES_;
                              VAR FILE_SPEC: FILE_SPEC_);
                                                                 FORWARD;
  FUNCTION  ST_GET_INDENT (SEG: SEGMENT_DES_): INTEGER;
                                                                 FORWARD;
  PROCEDURE ST_GET_LINE (VAR LINE: LINE_DES_);
                                                                 FORWARD;
  PROCEDURE ST_GET_OPTION_LINE (SEG: SEGMENT_DES_; VAR LINE: LINE_DES_);
                                                                 FORWARD;
  PROCEDURE ST_GET_SEG (SEG: SEGMENT_DES_; VAR LINE: LINE_DES_);
                                                                 FORWARD;
  PROCEDURE ST_GET_SEG_RANGE (    SEGMENT: SEGMENT_DES_;
                              VAR FIRST, LAST:INTEGER);
                                                                 FORWARD;
  PROCEDURE ST_INIT;
                                                                 FORWARD;
  PROCEDURE ST_INIT_SEG  (VAR SEG: SEGMENT_DES_);
                                                                 FORWARD;
  FUNCTION  ST_IS_EMPTY_SEG (SEG: SEGMENT_DES_): BOOLEAN;
                                                                 FORWARD;
  FUNCTION  ST_NUMBER_OF_LINES (SEG: SEGMENT_DES_): INTEGER;
                                                                 FORWARD;
  PROCEDURE ST_PUT_LINE (LINE: LINE_DES_; VAR SEG: SEGMENT_DES_);
                                                                 FORWARD;
  PROCEDURE ST_PUT_SEG (LINE: LINE_DES_; VAR SEG: SEGMENT_DES_);
                                                                 FORWARD;
  PROCEDURE ST_FINIT;
                                                                 FORWARD;
  FUNCTION  ST_SEG_WIDTH (SEG: SEGMENT_DES_): INTEGER;
                                                                 FORWARD;
  PROCEDURE ST_WRITE_SEG (SEG: SEGMENT_DES_; BLANKS:      INTEGER;
                                             DESTINATION: INTEGER);
                                                                 FORWARD;
  PROCEDURE SP_ADD_CHAR (CH: CHAR; VAR STR: STRING_DES_);
                                                                 FORWARD;
  PROCEDURE SP_CONC_STR (VAR MASTER: STRING_DES_; SLAVE: STRING_DES_);
                                                                 FORWARD;
  FUNCTION  SP_EQ (STR1: STRING_DES_; STR2: STRING_DES_): BOOLEAN;
                                                                 FORWARD;
  PROCEDURE SP_EXTR_STR (STR: STRING_DES_; VAR STR132: STRING132_);
                                                                 FORWARD;
  FUNCTION  SP_GET_CHAR (INDEX: INTEGER; STR: STRING_DES_): CHAR;
                                                                 FORWARD;
  PROCEDURE SP_INIT;
                                                                 FORWARD;
  PROCEDURE SP_INIT_STR (VAR STR: STRING_DES_);
                                                                 FORWARD;
  FUNCTION  SP_IS_EMPTY_STR (STR: STRING_DES_): BOOLEAN;
                                                                 FORWARD;
  FUNCTION  SP_LENGTH_STR (STR: STRING_DES_): INTEGER;
                                                                 FORWARD;
  PROCEDURE SP_ADD_BUFFER (VAR STR: STRING_DES_);
                                                                 FORWARD;
  PROCEDURE SP_ADD_BUFFER_CHAR (CH: CHAR);
                                                                 FORWARD;
  FUNCTION  SP_GET_BUFFER_CHAR (INDEX: INTEGER): CHAR;
                                                                 FORWARD;
  PROCEDURE SP_INIT_BUFFER;
                                                                 FORWARD;

  (*-----------   General routines  -----------------------------------*)

  (*********************************************************************)
  (* Procedure:   CLIP_STOP (VAX-version)                              *)
  (* Purpose:     To halt a program without any message or dump.       *)
  (*********************************************************************)
  PROCEDURE CLIP_STOP;
  BEGIN
  HALT
  END (*PROCEDURE CLIP_STOP*);

  (*********************************************************************)
  (* Routine:     EXT_FILE_CLOSE (VAX-version)                         *)
  (* Purpose:     To close an external file.                           *)
  (* Interface:   FILE_VAR      - Pascal file in question              *)
  (*              ERROR_CODE    - Error indication to caller           *)
  (*********************************************************************)
  PROCEDURE EXT_FILE_CLOSE;
  BEGIN
      CLOSE (FILE_VAR);
      ERROR_CODE := 0;
  END (*EXT_FILE_CLOSE*);

  (*********************************************************************)
  (* Procedure:     EXT_FILE_PREP ( VAX-version )                      *)
  (* Purpose:       To prepare an external file for reading from it    *)
  (*                or writing to it.                                  *)
  (* Interface:     EXT_FILE_SPEC - VMS-file in question.              *)
  (*                FILE_MODE -     Mode indicator.                    *)
  (*                FILE_VAR -      Pascal file in question.           *)
  (*                FILE_OK  -      Indicates succesfull preparation.  *)
  (*                ERROR_CODE -    Error indication to caller.        *)
  (*                ERROR_MSG  -    Error message to caller.           *)
  (*********************************************************************)
  PROCEDURE EXT_FILE_PREP;
  VAR
      AUX_FILE_SPEC:  VARYING [MAX_FILE_SPEC_L] OF CHAR;
  BEGIN
      ERROR_CODE := -1;                     (* Initialization      *)
          AUX_FILE_SPEC := EXT_FILE_SPEC.BODY;
      IF (FILE_MODE = INSP_MODE) THEN
      BEGIN
          IF (EXT_FILE_SPEC.LENGTH <> 0) THEN
          BEGIN
              (* First the file has to be opened.                  *)
              OPEN (FILE_VAR,
                    AUX_FILE_SPEC,
                    'old',
                    ERROR_CODE);
              IF ERROR_CODE = 0 THEN
                  RESET (FILE_VAR);
          END (*IF*);
      END
      ELSE
      BEGIN
          (* FILE_MODE is gelijk aan GEN_MODE                      *)
          IF (EXT_FILE_SPEC.LENGTH <> 0) THEN
          BEGIN
              (* First the file has to be opened.                  *)
              OPEN (FILE_VAR,
                    AUX_FILE_SPEC,
                    'unknown',
                    ERROR_CODE);
              IF ERROR_CODE = 0 THEN
                  REWRITE (FILE_VAR);
          END (*IF*);
      END (*IF*);
    
      (* DEFAULT CODE: *)
      IF NOT (ERROR_CODE = 0) THEN
      BEGIN
          FILE_OK := FALSE;
          (* This string is a bit too short for the assignment,    *)
          (* but that is no problem in VAX-Pascal.                 *)
          CASE ERROR_CODE OF
             -1:  BEGIN
                      ERROR_MSG := 'Empty file name.';
                  END;
              2:  BEGIN
                      ERROR_MSG := 'File not found.';
                  END;
              OTHERWISE
                  ERROR_MSG := 'Unsuccesful performance';
          END (*CASE*);
      END (*IF*)
      ELSE
      BEGIN
          FILE_OK    := TRUE;
          ERROR_MSG  := 'Succesful performance. ';
          ERROR_CODE := 0;
      END (*IF*);
      (* END DEFAULT CODE *)
    
  END (*EXT_FILE_PREP*);

  (*********************************************************************)
  (* Procedure:   READ_FILE_SPEC                                       *)
  (* Purpose:     To read a filespecification from the terminal.       *)
  (* Interface:   AUX_FILE_SPEC - Returned file specification.         *)
  (*              FILE_SPEC_OK -  File specification from terminal.    *)
  (* Author/Date: Maarten Rooda, January 1991.                         *)
  (*********************************************************************)
  PROCEDURE READ_FILE_SPEC;
  VAR
      VAX_AUX_FILE_SPEC:  VARYING [MAX_FILE_SPEC_L] OF CHAR;
      I:                  INTEGER;  (* loopvariable.                   *)
          DUMMY_FILE: TEXT;
          FILE_OK:    BOOLEAN;
          ERROR_CODE: INTEGER;
          ERROR_MSG:  ERROR_MSG_;

  BEGIN
      FILE_SPEC_OK := TRUE;
      READLN (VAX_AUX_FILE_SPEC);
      FOR I := 1 TO LENGTH(VAX_AUX_FILE_SPEC) DO
      BEGIN
          AUX_FILE_SPEC.BODY[I] := VAX_AUX_FILE_SPEC[I];
      END (*FOR*);
      AUX_FILE_SPEC.LENGTH := LENGTH(VAX_AUX_FILE_SPEC)
  END (*PROCEDURE READ_FILE_SPEC*);

  (*********************************************************************)
  (* Routine:    UC_WORD                                               *)
  (* Pupose:     To convert a string to upper case .                   *)
  (* Interface:  STRING -   String to be converted                     *)
  (*********************************************************************)
  PROCEDURE UC_WORD;
  VAR
      COUNTER: INTEGER;
  BEGIN
      FOR COUNTER := ONE TO LEN DO
          STR[COUNTER] := UC (STR[COUNTER]);
  END (*UC_WORD*);

  (*********************************************************************)
  (* Procedure:   WRITE_STRING (VAX-version)                           *)
  (* Purpose:     Write a part of a text string to a text file         *)
  (* Interface:   OUT_FILE   - The file that is written to             *)
  (*              NR_CHARS   - The number of CHAR's that have to be    *)
  (*                           written to the file                     *)
  (*              OUT_STRING - The string to be written                *)
  (* Author/date: Hans Rabouw, March 1992                              *)
  (*********************************************************************)
  PROCEDURE WRITE_STRING;
  VAR
      I: INTEGER;
  BEGIN
      FOR I:= 1 TO NR_CHARS DO
          WRITE(OUT_FILE, OUT_STRING[I]);
  END;

  (*********************************************************************)
  (* Routine:     WRLN_STRING - WRiTeLN STRING. (VAX-version)          *)
  (* Purpose:     Write a part of a text string to a text file and     *)
  (*              jump to the next line in the file after that.        *)
  (* Interface:   OUT_FILE   - The file that is written to             *)
  (*              NR_CHARS   - The number of CHAR's that have to be    *)
  (*                           written to the file                     *)
  (*              OUT_STRING - The string to be written                *)
  (*              SPACE      - Number of spaces written before string. *)
  (* Author/date: Heleen Hollenberg, june 1992.                        *)
  (*********************************************************************)
  PROCEDURE WRLN_STRING;
  VAR
      I: INTEGER;
  BEGIN
      FOR I := 1 TO SPACE DO
          WRITE (OUT_FILE, ' ' );
      FOR I:= 1 TO NR_CHARS DO
          WRITE (OUT_FILE, OUT_STRING[I]);
      WRITELN (OUT_FILE);
  END;

  (*********************************************************************)
  (* Routine:     READ_LINE_SAFELY                                     *)
  (* Purpose:     To read a line from a file .                         *)
  (* Interface:   FILE_IN -   File to be read                          *)
  (* Author/date: Boudewijn Pelt, August 1991.                         *)
  (*********************************************************************)
  PROCEDURE READ_LINE_SAFELY;
  BEGIN
      IF NOT EOF (FILE_IN) THEN
          READLN (FILE_IN);
  END (*READ_LINE_SAFELY*);

  (*********************************************************************)
  (* Routine:     CHECK_SYNTAX                                         *)
  (* Purpose:     To check the syntax parameters of CLIP. If they are  *)
  (*              not legal then the function result is FALSE          *)
  (* Interface:   LPAR -          CLIP Left parenthesis definition     *)
  (*              RPAR -          CLIP Right parenthesis definition    *)
  (*              END_STRING -    End of stub indicator                *)
  (*              CC -            CLIP Control Character               *)
  (*              MARKER -                                             *)
  (*              CHECK_SYNTAX -  Show example of CLIP-syntax          *)
  (* Author/date: Boudewijn Pelt, July 1991                            *)
  (*********************************************************************)
  FUNCTION CHECK_SYNTAX;
  VAR
      COUNTER:  INTEGER;
      ERROR:    BOOLEAN;

  BEGIN
      ERROR := FALSE;
      FOR COUNTER := 1 TO SYNTAX_LEN DO
          IF MARKER IN [LPAR.BODY[COUNTER], RPAR.BODY[COUNTER],
                        END_STRING.BODY[COUNTER]] THEN
              ERROR := TRUE;
      IF MARKER = CC THEN
          ERROR := TRUE;

      IF LPAR.BODY[LPAR.LENGTH] <> CC THEN
          ERROR := TRUE;
      IF RPAR.BODY[1] <> CC THEN
          ERROR := TRUE;

      WITH LPAR DO
      BEGIN
          IF LENGTH <= 1 THEN
              ERROR := TRUE;
          FOR COUNTER := 1 TO LENGTH DO
              IF BODY[COUNTER] IN ALLOWED_ID_CHARS THEN
                  ERROR := TRUE;
      END (*WITH*);
      WITH RPAR DO
      BEGIN
          IF LENGTH <= 1 THEN
              ERROR := TRUE;
          FOR COUNTER := 1 TO LENGTH DO
              IF BODY[COUNTER] IN ALLOWED_ID_CHARS THEN
                  ERROR := TRUE;
      END (*WITH*);
      WITH END_STRING DO
      BEGIN
          IF LENGTH <= 0 THEN
              ERROR := TRUE;
          FOR COUNTER := 1 TO LENGTH DO
              IF NOT (BODY[COUNTER] IN ALLOWED_ID_CHARS) THEN
                  ERROR := TRUE;
      END (*WITH*);
      IF (CC IN ALLOWED_ID_CHARS) OR (CC = ' ') THEN
          ERROR := TRUE;
      IF (MARKER IN ALLOWED_ID_CHARS) OR (MARKER = ' ') THEN
          ERROR := TRUE;

      CHECK_SYNTAX :=  NOT ERROR;
  END (*CHECK_SYNTAX*);

  (*********************************************************************)
  (* Procedure:   INIT_RUN_INFO .                                      *)
  (* Purpose:     To initialize the fields of a record INIT_INFO of    *)
  (*              type RUN_INFO_ to default values.                    *)
  (* Interface:   INIT_INFO - Structure to initialize.                 *)
  (* Author/date: Maarten Rooda, January 1991.                         *)
  (*********************************************************************)
  PROCEDURE INIT_RUN_INFO;

  CONST
      AUX_STR_L = MAX_MODE_L;

  VAR
      I:    INTEGER;
      AUX_STRING: PACKED ARRAY[1..AUX_STR_L] OF CHAR;

  BEGIN
      (*******                INIT_RUN_INFO body                     *******)
      WITH INIT_INFO DO
      BEGIN
          (* additional parameters of init_info.                           *)
          CLIP_LPAR.BODY := EMPTY_STRING_FIXED;
          CLIP_LPAR.BODY[1] := '(';
          CLIP_LPAR.BODY[2] := '*';
          CLIP_LPAR.BODY[3] := '*';
          CLIP_LPAR.LENGTH := 3;
    
          CLIP_RPAR.BODY := EMPTY_STRING_FIXED;
          CLIP_RPAR.BODY[1] := '*';
          CLIP_RPAR.BODY[2] := '*';
          CLIP_RPAR.BODY[3] := ')';
          CLIP_RPAR.LENGTH := 3;
    
          CLIP_END.BODY := EMPTY_STRING_FIXED;
          CLIP_END.BODY[1] := 'E';
          CLIP_END.BODY[2] := 'N';
          CLIP_END.BODY[3] := 'D';
          CLIP_END.BODY[4] := 'O';
          CLIP_END.BODY[5] := 'F';
          CLIP_END.LENGTH := 5;
    
          CLIP_CC := '*';
          OPTION_MARKER := '#';
    
          (* old parameters.                                               *)
          MODE := EMPTY_STRING_FIXED;
          AUX_STRING := 'INTERACTIVE_MODE';
          FOR I := 1 TO MAX_MODE_L DO
              MODE[I] := AUX_STRING[I];
    
          INT_FAULT_CORR := TRUE;
    
          MESSAGE_DESTINATION := EMPTY_STRING_FIXED;
          AUX_STRING := 'TERMINAL        ';
          FOR I := 1 TO MAX_M_D_L DO
              MESSAGE_DESTINATION[I] := AUX_STRING[I];
    
          REPORT_FILE_SPEC.BODY := EMPTY_STRING_FIXED;
          REPORT_FILE_SPEC.BODY[1] := 'C';
          REPORT_FILE_SPEC.BODY[2] := 'L';
          REPORT_FILE_SPEC.BODY[3] := 'I';
          REPORT_FILE_SPEC.BODY[4] := 'P';
          REPORT_FILE_SPEC.BODY[5] := '.';
          REPORT_FILE_SPEC.BODY[6] := 'R';
          REPORT_FILE_SPEC.BODY[7] := 'P';
          REPORT_FILE_SPEC.BODY[8] := 'T';
          REPORT_FILE_SPEC.LENGTH := 8;
    
          NR_SRC_FILES := 0;
    
          (* Default:                                                      *)
          EXTR_MODE := EMPTY_STRING_FIXED;
          AUX_STRING := 'OMITTED         ';
          FOR I := 1 TO MAX_EXTR_MODE_L DO
              EXTR_MODE[I] := AUX_STRING[I];
    
          NR_MODULES:= 0;
          MODULE_DIRECTORY.BODY := EMPTY_STRING_FIXED;
          MODULE_DIRECTORY.LENGTH := 0;
    
      END (* WITH INIT_INFO *);
      (*****************  End of INIT_RUN_INFO body  ***********************)
  END (*INIT_RUN_INFO*);

  (*********************************************************************)
  (* Procedure:   READ_INI_FILE                                        *)
  (* Purpose:     To open an initializationfile and read data from     *)
  (*              it into a record READ_INFO of type RUN_INFO_ .       *)
  (* Interface:   INI_FILE:      The initializationfile in question.   *)
  (*              READ_INFO:     Information for a run of CLIP.        *)
  (*              EXT_FILE_SPEC: The filespecification                 *)
  (*              FILE_OK:       TRUE if data read successfully        *)
  (*              ERROR_MSG:     Error message.                        *)
  (*              ERROR_CODE:    Type of error.                        *)
  (* Author/date: Maarten Rooda, February 1991.                        *)
  (*********************************************************************)
  PROCEDURE READ_INI_FILE;
  VAR
      DUMMY_CODE: INTEGER;

  (*********************************************************************)
  (* Procedure:   READ_INI_DATA                                        *)
  (* Purpose:     To read data from an initializationfile into a       *)
  (*              record READ_INFO of type RUN_INFO_ .                 *)
  (* Interface:   INI_FILE -  INI-file to be read                      *)
  (*              READ_INFO - Structure to return the data.            *)
  (* Author/date: Boudewijn Pelt, May 1991.                            *)
  (*********************************************************************)
  PROCEDURE READ_INI_DATA(VAR INI_FILE:  TEXT;
                          VAR READ_INFO: RUN_INFO_);
  CONST
      SKIP_LINES = 5;
  VAR
      COUNTER:  INTEGER;
      LETTER:  STRING_FIXED_;  (* This is an array that can be read by *)
                               (* READ_STRING                          *)
      DUMMY_L: INTEGER;        (* A dummy parameter for READ_STRING    *)
      OK:  BOOLEAN;
      AUX_STR_34 : PACKED ARRAY[1..34] OF CHAR;


  (*********************************************************************)
  (* Routine:     GET_SOURCE_FILES                                     *)
  (* Purpose:     To read a number of filespecifications from an       *)
  (*              input file.                                          *)
  (* Interface:   FILE_IN -   File with data to be read                *)
  (*              FILES -     Data of files                            *)
  (*              NR_FILES -  Number of files                          *)
  (* Author/date: Boudewijn Pelt, August 1991                          *)
  (* Modified:    Hans Rabouw, March 1992                              *)
  (*********************************************************************)
  PROCEDURE GET_SOURCE_FILES
                (VAR FILE_IN:  TEXT;
                 VAR FILES:    SOURCE_FILES_;
                 VAR NR_FILES: INTEGER);
  VAR
      I:                INTEGER;
      READ_ON:          BOOLEAN;
      AUX_FILE_SPEC:    FILE_SPEC_;

  BEGIN
      I := 0;
      READ_ON := NOT (EOF (FILE_IN));
      WHILE READ_ON DO
      BEGIN
          WITH AUX_FILE_SPEC DO
              READ_STRING(FILE_IN, LENGTH, BODY, MAX_FILE_SPEC_L);
          READ_LINE_SAFELY(INI_FILE);
          IF (AUX_FILE_SPEC.BODY[1] = '-') OR
             (AUX_FILE_SPEC.LENGTH = 0) THEN
             (* AUX_FILE_SPEC was not read successfully.               *)
              READ_ON := FALSE
          ELSE IF I < MAX_NR_SRC_FILES THEN
          BEGIN
              (* AUX_FILE_SPEC was read successfully.                  *)
              I := I + 1;
              FILES[I] := AUX_FILE_SPEC;
          END (*IF.IF*);
      END (*WHILE*);
      NR_FILES := I;
  END (*GET_SOURCE_FILES*);


  (*********************************************************************)
  (* Routine:     GET_MODULES                                          *)
  (* Purpose:     To read a number of filespecifications from an       *)
  (*              input file.                                          *)
  (* Interface:   FILE_IN -   File with data to be read                *)
  (*              FILES -     Data of files                            *)
  (*              NR_FILES -  Number of files                          *)
  (* Author/date: Boudewijn Pelt, August 1991                          *)
  (* Modified:    Hans Rabouw, March 1992                              *)
  (*********************************************************************)
  PROCEDURE GET_MODULES
                (VAR FILE_IN:  TEXT;
                 VAR FILES:    RSLT_MODULES_;
                 VAR NR_FILES: INTEGER);

  VAR
      I:                INTEGER;
      READ_ON:          BOOLEAN;
      AUX_FILE_SPEC:    FILE_SPEC_;
      AUX_PATH_SPEC:    FILE_SPEC_;

  BEGIN
      I := 0;
      READ_ON := NOT (EOF (FILE_IN));
      WHILE READ_ON DO
      BEGIN
          WITH AUX_PATH_SPEC DO
              READ_STRING(FILE_IN, LENGTH, BODY, MAX_FILE_SPEC_L);
          READ_LINE_SAFELY(INI_FILE);
          IF (AUX_PATH_SPEC.BODY[1] = '-')
  (*          OR (AUX_PATH_SPEC.LENGTH = 0)    (EWvA nav. HR 17/11/92) *)
          THEN
             (* AUX_PATH_SPEC was not read successfully.               *)
              READ_ON := FALSE
          ELSE
          BEGIN
              WITH AUX_FILE_SPEC DO
                    READ_STRING(FILE_IN, LENGTH, BODY, MAX_FILE_SPEC_L);
              READ_LINE_SAFELY(INI_FILE);
              IF (AUX_FILE_SPEC.BODY[1] = '-') OR
                  (AUX_FILE_SPEC.LENGTH = 0) THEN
                  READ_ON := FALSE
              ELSE IF I < MAX_NR_RSLT_MODULES THEN
              BEGIN
                  (* AUX_FILE_SPEC was read successfully.                  *)
                  I := I + 1;
                  FILES[I].FILE_NAME := AUX_FILE_SPEC;
                  FILES[I].PATH := AUX_PATH_SPEC;
              END (*IF.IF*);
          END (*IF*);
      END (*WHILE*);
      NR_FILES := I;
  END (*GET_MODULES*);


  BEGIN
      (*******            READ_INI_DATA body                     *******)
      RESET (INI_FILE);
      FOR COUNTER := 1 TO SKIP_LINES DO
          READ_LINE_SAFELY(INI_FILE);
      WITH READ_INFO DO
      BEGIN
          (*********************  READ_INI_DATA (1)  ***********************)
          (** Read the data from INI_FILE into MODE, INT_FAULT_CORR,      **)
          (** MESSAGE_DESTINATION, REPORT_FILE_SPEC, CLIP_LPAR, CLIP_-    **)
          (** RPAR, CLIP_CC, CLIP_END, OPTION_MARKER, NR_SCR_FILES,       **)
          (** SOURCE_FILES, NR_MODULES, EXTR_MODE, RSLT_MODULES.          **)
          READ_STRING(INI_FILE, DUMMY_L, MODE, MAX_MODE_L);
          READ_LINE_SAFELY(INI_FILE);
          READ_STRING(INI_FILE, DUMMY_L, LETTER, 1);
          READ_LINE_SAFELY(INI_FILE);
          INT_FAULT_CORR := LETTER[1] = 'Y';
          READ_STRING(INI_FILE, DUMMY_L, MESSAGE_DESTINATION, MAX_M_D_L);
          READ_LINE_SAFELY(INI_FILE);
          WITH CLIP_LPAR DO
              READ_STRING(INI_FILE, LENGTH, BODY, SYNTAX_LEN);
        
          READ_LINE_SAFELY(INI_FILE);
          WITH CLIP_RPAR DO
              READ_STRING(INI_FILE, LENGTH, BODY, SYNTAX_LEN);
        
          READ_LINE_SAFELY(INI_FILE);
          READ_STRING(INI_FILE, DUMMY_L, LETTER, 1);
          READ_LINE_SAFELY(INI_FILE);
          CLIP_CC := LETTER[1];
          WITH CLIP_END DO
              READ_STRING(INI_FILE, LENGTH, BODY, SYNTAX_LEN);
        
          READ_LINE_SAFELY(INI_FILE);
          READ_STRING(INI_FILE, DUMMY_L, LETTER, 1);
          READ_LINE_SAFELY(INI_FILE);
          OPTION_MARKER := LETTER[1];
          READ_STRING(INI_FILE, DUMMY_L, EXTR_MODE, MAX_EXTR_MODE_L);
        
          READ_LINE_SAFELY(INI_FILE);
        
          (************************  READ_INI_DATA (1.1)  **********************)
          (** Read the file specifications REPORT_FILE_SPEC,                  **)
          (** SOURCE_FILES.FILES[1..NR_FILE_SPECS]                            **)
          (** RSLT_MODULES.FILES[1..NR_FILE_SPECS] from the INI_FILE.         **)
          READ_LINE_SAFELY(INI_FILE);               (* Skip -- REPORT FILE --  *)
          WITH REPORT_FILE_SPEC DO
              READ_STRING(INI_FILE, LENGTH, BODY, MAX_FILE_SPEC_L);
        
          READ_LINE_SAFELY(INI_FILE);
          READ_LINE_SAFELY(INI_FILE);               (* skip -- INPUT FILES --  *)
          GET_SOURCE_FILES (INI_FILE, SOURCE_FILES, NR_SRC_FILES);
          GET_MODULES (INI_FILE, RSLT_MODULES, NR_MODULES);
        
          (* There is no need to skip the '--- MODULE DIRECTORY ---' line *)
          (* because it is read by the GET_MODULES procedure              *)
        
          WITH MODULE_DIRECTORY DO
              READ_STRING(INI_FILE, LENGTH, BODY, MAX_FILE_SPEC_L);
        
          (*****************  End of READ_INI_DATA (1.1)  **********************)
        
          (************************  READ_INI_DATA (1.2)  **********************)
          (** CLIP_LPAR and CLIP_RPAR are not complete. An CLIP_CC needs to   **)
          (** be added.                                                       **)
          WITH CLIP_LPAR DO
          BEGIN
              IF LENGTH < SYNTAX_LEN THEN
                  LENGTH := LENGTH + 1;
              BODY[LENGTH] := CLIP_CC;
          END (*WITH*);
          WITH CLIP_RPAR DO
          BEGIN
              LENGTH := LENGTH + 1;
              IF LENGTH > SYNTAX_LEN THEN
                  LENGTH := SYNTAX_LEN;
              FOR COUNTER := LENGTH-1 DOWNTO 1 DO
                  BODY[COUNTER+1] := BODY[COUNTER];
              BODY[1] := CLIP_CC;
          END (*WITH*);
          (******************  End of READ_INI_DATA (1.2)  *********************)
        
          (*****************  End of READ_INI_DATA (1)  ********************)
      END (*WITH*);
    
      (*************************  READ_INI_DATA (2)  ***********************)
      (** Check if READ_INFO is valid. If not display an error message    **)
      (** and set READ_INFO to default values.                            **)
      VAL_INI_DATA (READ_INFO, OK);
      IF NOT OK THEN
      BEGIN
          (*********************  READ_INI_DATA (2.1)  *********************)
          (** Generate a warning message                                  **)
          ERROR_CODE := CORRUPT_INI_FILE;
          ERROR_MSG := EMPTY_STRING_FIXED;
          AUX_STR_34 := 'THE SPECIFIED INI-FILE IS CORRUPT.';
          FOR COUNTER := 1 TO 34 DO
              ERROR_MSG[COUNTER] := AUX_STR_34[COUNTER];
          (*****************  End of READ_INI_DATA (2.1)  ******************)
          INIT_RUN_INFO(READ_INFO);
      END (*IF*);
      (*********************  End of READ_INI_DATA (2)  ********************)
    
      (*****************  End of READ_INI_DATA body  ***********************)
  END (*READ_INI_DATA*);

  BEGIN
      FILE_OK := FALSE;
      EXT_FILE_PREP(INI_FILE, EXT_FILE_SPEC, INSP_MODE, FILE_OK,
                    ERROR_CODE, ERROR_MSG);
      IF FILE_OK THEN
      BEGIN
          READ_INI_DATA (INI_FILE, READ_INFO);
          (* If the INI-file contained an error, the READ_INFO record  *)
          (* was initialized by READ_INI_DATA.                         *)
          EXT_FILE_CLOSE (INI_FILE, DUMMY_CODE);     (* EWvA, 16/10/93 *)
      END (*IF*);
  END (*READ_INI_FILE*);

  (*********************************************************************)
  (* Procedure:   READ_STRING                                          *)
  (* Purpose:     read a string from a text file and determine its     *)
  (*              length.                                              *)
  (* Interface:   IN_FILE -       File to be read                      *)
  (*              IN_STR_LN -     Index in line to be read             *)
  (*              IN_STR_BODY -   Body of the line                     *)
  (* Author/date: Maarten Rooda, September 1990.                       *)
  (* Modified:    Boudewijn Pelt, June 1991 & July 1991.               *)
  (*              Hans Rabouw, March 1992                              *)
  (*********************************************************************)
  PROCEDURE READ_STRING;
  VAR
      INDEX: INTEGER;

  BEGIN
      (* File is already open and in inspection mode.                  *)
      (* A prompt, if needed, has already been issued.                 *)
      IN_STR_LN := 0;
      INDEX := 1;
      IF NOT (EOF(IN_FILE)) OR (EOLN (IN_FILE))  THEN
      BEGIN
          WHILE NOT (EOLN (IN_FILE) OR (INDEX > NR_CHARS_TO_READ)) DO
          BEGIN
              READ(IN_FILE, IN_STR_BODY[INDEX]);
              INDEX := INDEX + 1;
          END (*WHILE*);
          IN_STR_LN := INDEX - 1;
          IF IN_STR_LN > 0 THEN
              WHILE (IN_STR_BODY[IN_STR_LN] = ' ') AND
                    (IN_STR_LN > 1) DO
                   IN_STR_LN := IN_STR_LN - 1;

          (* If not all of the string has been filled, write spaces to *)
          (* the cells that have not been filled.                      *)

          FOR INDEX := INDEX TO STRING_FIXED_L DO
              IN_STR_BODY[INDEX] := ' ';
      END (*IF*);
  END (*READ_STRING*);

  (*********************************************************************)
  (* Routine:     UC - convert character to Upper-Case                 *)
  (* Purpose:     To transform lower case letters to their uppercase   *)
  (*              equivalent.                                          *)
  (* Interface:   INCHAR -    Character to be converted.               *)
  (*              <RETURNS> - Converted character.                     *)
  (* Author/Date: Vamp project management, october 1983.               *)
  (*********************************************************************)
  FUNCTION  UC;
  BEGIN
      IF (INCHAR >= 'a') AND (INCHAR <= 'z') THEN
          UC := CHR (ORD(INCHAR) - ORD('a') + ORD('A'))
      ELSE
          UC := INCHAR;
  END (*UC*);

  (*********************************************************************)
  (* Routine:     VAL_INI_DATA                                         *)
  (* Purpose:     Check if the run_info structure VAL_INFO is valid    *)
  (*              if this is not the case then attempt to fix it       *)
  (*              or return an error. (Make OK FALSE)                  *)
  (* Interface:   VAL_INFO -  Data from initialization.                *)
  (*              OK -        TRUE if data OK.                         *)
  (* Author/date: Boudewijn Pelt, June 1991.                           *)
  (*********************************************************************)
  PROCEDURE VAL_INI_DATA;
  CONST
      AUX_STR_L = MAX_MODE_L;

  VAR
      ERROR:      BOOLEAN;
      AUX_STRING: PACKED ARRAY [1..AUX_STR_L] OF CHAR;
      I:          INTEGER;

  BEGIN
      ERROR :=  FALSE;
      WITH VAL_INFO DO
      BEGIN
          IF NOT (CHECK_SYNTAX(CLIP_LPAR, CLIP_RPAR, CLIP_END,
                                CLIP_CC, OPTION_MARKER)) THEN
              ERROR := TRUE;

          (* Check MODE and set ERROR.                                *)
          IF MODE[1] IN ['I', 'i'] THEN
              AUX_STRING :='INTERACTIVE_MODE'
          ELSE IF MODE[1] IN ['A', 'a'] THEN
              AUX_STRING :='AUTO_MODE       '
          ELSE IF MODE[1] IN ['H', 'h'] THEN
              AUX_STRING :='HELPFUL_MODE    '
          ELSE IF MODE[1] IN ['D', 'd'] THEN
              AUX_STRING :='DEBUG_MODE      '
          ELSE
              ERROR := TRUE;
        
          IF NOT ERROR THEN
              FOR I := 1 TO MAX_MODE_L DO
                  MODE[I] := AUX_STRING[I];
        
          (* Check MESSAGE_DESTINATION and set ERROR.                 *)
          IF MESSAGE_DESTINATION[1] IN ['F', 'f'] THEN
              AUX_STRING := 'FILE            '
          ELSE IF MESSAGE_DESTINATION[1] IN ['T', 't'] THEN
              AUX_STRING := 'TERMINAL        '
          ELSE IF MESSAGE_DESTINATION[1] IN ['B', 'b'] THEN
              AUX_STRING := 'BOTH            '
          ELSE IF MESSAGE_DESTINATION[1] IN ['N', 'n'] THEN
              AUX_STRING := 'NONE            '
          ELSE
              ERROR := TRUE;
        
          IF NOT ERROR THEN
              FOR I := 1 TO MAX_M_D_L DO
                  MESSAGE_DESTINATION[I] := AUX_STRING[I];
        
          (* Check EXTR_MODE and set ERROR.                           *)
          IF EXTR_MODE[1] IN ['E', 'e'] THEN
              AUX_STRING := 'EXTRACTED       '
          ELSE IF EXTR_MODE[1] IN ['O', 'o'] THEN
              AUX_STRING := 'OMITTED         '
          ELSE
              ERROR := TRUE;
        
          IF NOT ERROR THEN
              FOR I := 1 TO MAX_EXTR_MODE_L DO
                  EXTR_MODE[I] := AUX_STRING[I];
        
      END (*WITH*);
      OK := NOT ERROR;
  END (*VAL_INI_DATA*);

  (*-----------   File Table routines (ADT)  --------------------------*)

  (*********************************************************************)
  (* Routine:     FT_ABS_LINE_NUMBER - File Table ABSolute LINE NUMBER.*)
  (* Purpose:     To return the absolute line number of a source line  *)
  (*              the source file.                                     *)
  (* Interface:   SOURCE_LINE -   The specified source line.           *)
  (*              RETURNS -       Absolute line number of the given    *)
  (*                              SOURCE_LINE.                         *)
  (*********************************************************************)
  FUNCTION FT_ABS_LINE_NUMBER;
  BEGIN
      FT_ABS_LINE_NUMBER := SOURCE_LINE.ID;
  END (*FUNCTION FT_ABS_LINE_NUMBER*);

  (*********************************************************************)
  (* Routine:     FT_CHECK_FILE                                        *)
  (* Purpose:     Checks whether a file is acccessable or not.         *)
  (* Interface:   FILE_SPEC - Specification of file to check.          *)
  (*              RETURNS -   Code of a possible error.                *)
  (* FT vars:     CURR_IN_FILE.                                        *)
  (*********************************************************************)
  FUNCTION FT_CHECK_FILE;
  VAR
      ERROR_CODE:         ERROR_CODE_;
      DUMMY_FILE_OK:      BOOLEAN;
      DUMMY_ERROR_MSG:    ERROR_MSG_;

  BEGIN
      EXT_FILE_PREP (CURR_IN_FILE, FILE_SPEC, INSP_MODE, DUMMY_FILE_OK,
                     ERROR_CODE, DUMMY_ERROR_MSG);
      IF ERROR_CODE<=0 THEN
          CLOSE (CURR_IN_FILE);
      FT_CHECK_FILE := ERROR_CODE;
  END (*FT_CHECK_FILE*);

  (*********************************************************************)
  (* Routine:     FT_EOF                                               *)
  (* Purpose:     The function examines if the currently read file is  *)
  (*              exhausted.                                           *)
  (* Interface:   RETURNS - TRUE if the file is exhausted.             *)
  (* FT vars:     CURR_IN_FILE.                                        *)
  (*********************************************************************)
  FUNCTION FT_EOF;
  BEGIN
      IF NOT EOF(CURR_IN_FILE) THEN
          FT_EOF := FALSE
      ELSE
          FT_EOF := TRUE;
  END (*FT_EOF*);

  (*********************************************************************)
  (* Routine:     FT_GET_CHAR                                          *)
  (* Purpose:     To locate a character at a given position in a       *)
  (*              source_line and to return this character.            *)
  (* Interface:   SOURCE_LINE -    The source line.                    *)
  (*              INDEX -          Index of the desired character.     *)
  (*              RETURNS -        The desired character.              *)
  (* CLIP objs:   MAX_LINE.                                            *)
  (*********************************************************************)
  FUNCTION FT_GET_CHAR;
  BEGIN
      IF (INDEX > MAX_LINE) OR (INDEX <= 0) THEN
      BEGIN
          WRITELN (OUTPUT, 'FT-GET-CHAR (a): ',
                           'System Failure... Call maintenance.');
          CLIP_STOP;
      END (*IF*);
      IF INDEX > SOURCE_LINE.USED THEN
      BEGIN
          WRITELN (OUTPUT, 'FT-GET-CHAR (B): ',
                           'System Failure... Call maintenance.');
          CLIP_STOP;
      END (*IF*);

      (* Index is within legal range. Proceed...                       *)
      FT_GET_CHAR := SOURCE_LINE.CHARS[INDEX];
  END (*FT_GET_CHAR*);

  (*********************************************************************)
  (* Routine:     FT_GET_FILE_SPEC                                     *)
  (* Purpose:     To return the file specification of a source line    *)
  (* Interface:   SOURCE_LINE -     The source line.                   *)
  (*              FILE_SPEC -       The wanted file specification.     *)
  (* FT vars:     FILE_TABLE.                                          *)
  (*********************************************************************)
  PROCEDURE FT_GET_FILE_SPEC;
  VAR
      INDEX: FT_INDEX_;

  BEGIN
      (* Beware of non-existing line identifications.                  *)
      IF (SOURCE_LINE.ID <= 0) OR
         (SOURCE_LINE.ID > FILE_TABLE[LAST_FILE].LAST) THEN
      BEGIN
          WRITELN (OUTPUT, 'FT-GET-FILE-SPEC: ',
                           'System Failure... Call maintenance.');
          CLIP_STOP;
      END (*IF*);

      (* Line surely exist in FT. Find its specification.              *)
      INDEX := 1;
      WHILE FILE_TABLE[INDEX].LAST < SOURCE_LINE.ID DO
          INDEX := INDEX+1;
      FILE_SPEC := FILE_TABLE[INDEX].FILE_SPEC;
  END (*FT_GET_FILE_SPEC*);

  (*********************************************************************)
  (* Routine:     FT_GET_INDENT                                        *)
  (* Purpose:     To return the indentation of a line                  *)
  (* Interface:   SOURCE_LINE -   The source line.                     *)
  (*              RETURNS -       The indentation of SOURCE_LINE.      *)
  (*********************************************************************)
  FUNCTION FT_GET_INDENT;
  BEGIN
      FT_GET_INDENT := SOURCE_LINE.INDENT;
  END (*FT_GET_INDENT*);

  (*********************************************************************)
  (* Routine:     FT_GET_LINE_LENGTH                                   *)
  (* Purpose:     To return the length of a line                       *)
  (* Interface:   SOURCE_LINE -   Line-descriptor to be examined.      *)
  (*              RETURNS -       Length of given line.                *)
  (*********************************************************************)
  FUNCTION FT_GET_LINE_LENGTH;
  BEGIN
      FT_GET_LINE_LENGTH := SOURCE_LINE.USED;
  END (*FT_GET_LINE_LENGTH*);

  (*********************************************************************)
  (* Routine:     FT_GET_LINE_NUMBER                                   *)
  (* Purpose:     To return the line number of a source line.          *)
  (* Interface:   SOURCE_LINE -   The source line                      *)
  (*              RETURNS -       Line number or error code.           *)
  (* FT vars:     FILE_TABLE.                                          *)
  (*********************************************************************)
  FUNCTION FT_GET_LINE_NUMBER;
  VAR
      INDEX:   FT_INDEX_;

  BEGIN
      (* Beware of non-existing line identifications.                  *)
      IF (SOURCE_LINE.ID <= 0) OR
          (SOURCE_LINE.ID > FILE_TABLE[LAST_FILE].LAST) THEN
      BEGIN
          WRITELN (OUTPUT, 'FT_GET_LINE_NUMBER: ',
                           'System Failure... Call maintenance.');
          CLIP_STOP;
      END (*IF*);

      (* Line surely exist in FT. Find its number.                     *)
      INDEX := 1;
      WHILE FILE_TABLE[INDEX].LAST < SOURCE_LINE.ID DO
          INDEX := INDEX + 1;
      FT_GET_LINE_NUMBER := SOURCE_LINE.ID - FILE_TABLE[INDEX].FIRST + 1;
  END (*FT_GET_LINE_NUMBER*);

  (*********************************************************************)
  (* Routine:     FT_GET_POS_OPTION_MARKER                             *)
  (* Purpose:     Return the value of POS_OPTION_MARKER.               *)
  (* Interface:   SOURCE_LINE -   Line-descriptor to be examined.      *)
  (*              RETURNS -       Position of the OPTION_MARKER.       *)
  (*********************************************************************)
  FUNCTION FT_GET_POS_OPTION_MARKER;
  BEGIN
      FT_GET_POS_OPTION_MARKER := SOURCE_LINE.POS_OPTION_MARKER;
  END (*FT_GET_POS_MARKER*);

  (*********************************************************************)
  (* Routine:     FT_INCLOSE                                           *)
  (* Purpose:     Close the current input file.                        *)
  (* Interface:   RETURNS -   Code of a possible error.                *)
  (* FT vars:     CURR_IN_FILE.                                        *)
  (*********************************************************************)
  FUNCTION FT_INCLOSE;
  VAR
      ERROR_CODE: ERROR_CODE_;

  BEGIN
      EXT_FILE_CLOSE (CURR_IN_FILE, ERROR_CODE);
      FT_INCLOSE := ERROR_CODE;
  END (*FT_INCLOSE*);

  (*********************************************************************)
  (* Routine:     FT_INIT                                              *)
  (* Purpose:     General initialization of the file table. It is only *)
  (*              activated once at the start of an run.               *)
  (* FT vars:     FILE_TABLE, LAST_LINE, LAST_FILE, SPACE.             *)
  (*********************************************************************)
  PROCEDURE FT_INIT;
  VAR
      K:  FT_INDEX_;

  BEGIN
      FOR K := 1 TO FT_SIZE DO
      WITH FILE_TABLE[K] DO
      BEGIN
          FILE_SPEC.LENGTH := 0;
          FIRST := 0;
          LAST  := 0;
      END (*WITH*);
      LAST_LINE := 0;
      LAST_FILE := 0;
      SPACE := [CHR(0)  .. CHR(9),  CHR(14) .. CHR(25),
                CHR(28) .. CHR(32), CHR(11),   CHR(127)];
  END (*FT_INIT*);

  (*********************************************************************)
  (* Routine:     FT_INIT_LINE                                         *)
  (* Purpose:     Initialization of a LINE_DES_-object.                *)
  (*********************************************************************)
  PROCEDURE FT_INIT_LINE;
  BEGIN
      WITH LINE DO
      BEGIN
          INDENT            := 0;
          USED              := 0;
          ID                := 0;
          POS_OPTION_MARKER := 0;
      END (*WITH*);
  END (*FT_INIT_LINE*);

  (*********************************************************************)
  (* Routine:     FT_INOPEN                                            *)
  (* Purpose:     Opens a new file with the given specification for    *)
  (*              read access.                                         *)
  (* Interface:   FILE_SPEC -    Specification of file to open.        *)
  (*              RETURNS -      Code of a possible error.             *)
  (* FT vars:     FILE_TABLE, LAST_FILE, CURR_IN_FILE.                 *)
  (*********************************************************************)
  FUNCTION FT_INOPEN;
  VAR
      ERROR_CODE:     ERROR_CODE_;
      DUMMY_FILE_OK:  BOOLEAN;
      DUMMY_ERROR_MSG: ERROR_MSG_;

  BEGIN
      EXT_FILE_PREP (CURR_IN_FILE, FILE_SPEC, INSP_MODE, DUMMY_FILE_OK,
                     ERROR_CODE, DUMMY_ERROR_MSG);
      IF ERROR_CODE = 0 THEN
      BEGIN
          LAST_FILE := LAST_FILE+1;
          FILE_TABLE[LAST_FILE].FILE_SPEC := FILE_SPEC;
      END (*IF*);
      FT_INOPEN := ERROR_CODE;
  END (*FT_INOPEN*);

  (*********************************************************************)
  (* Routine:     FT_OUTOPEN                                           *)
  (* Purpose:     Opens a new file with the given specification for    *)
  (*              write access.                                        *)
  (* Interface:   FILE_SPEC - Specification of outputfile.             *)
  (*              RETURNS -   Code of a possible error.                *)
  (* FT vars:     CURR_OUT_FILE.                                       *)
  (*********************************************************************)
  FUNCTION FT_OUTOPEN;
  VAR
      ERROR_CODE: ERROR_CODE_;
      DUMMY_FILE_OK:  BOOLEAN;
      DUMMY_ERROR_MSG: ERROR_MSG_;

  BEGIN
      EXT_FILE_PREP (CURR_OUT_FILE, FILE_SPEC, GEN_MODE, DUMMY_FILE_OK,
                     ERROR_CODE, DUMMY_ERROR_MSG);

      (* The opening was successfull. Make ERROR_CODE equal to         *)
      (* STATUS (CURR_OUT_FILE) in case an error occured during the    *)
      (* REWRITE operation (flagged by a value <> -1).                 *)
      FT_OUTOPEN := ERROR_CODE;
  END (*FT_OUTOPEN*);

  (*********************************************************************)
  (* Routine:     FT_OUTCLOSE                                          *)
  (* Purpose:     Close the current output file.                       *)
  (* Interface:   RETURNS -   Code of a possible error.                *)
  (* FT vars:     CURR_OUT_FILE.                                       *)
  (*********************************************************************)
  FUNCTION FT_OUTCLOSE;
  VAR
      ERROR_CODE: ERROR_CODE_;

  BEGIN
      EXT_FILE_CLOSE (CURR_OUT_FILE, ERROR_CODE);
      FT_OUTCLOSE := ERROR_CODE;
  END (*FT_OUTCLOSE*);

  (*********************************************************************)
  (* Routine:     FT_RDLN                                              *)
  (* Purpose:     Read the next line from the current source-file.     *)
  (* Interface:   LINE -  A source-line is returned in the form of a   *)
  (*                      line descriptor.                             *)
  (* FT vars:     SPACE                                                *)
  (*********************************************************************)
  PROCEDURE FT_RDLN;
  CONST
      TAB =   8;
  VAR
      STR132: STRING132_;
      INDEX,
      K:      INTEGER;

  BEGIN
      WITH LINE DO
      BEGIN
          INDENT := 0;
          USED := 0;
          POS_OPTION_MARKER := 0;
          WITH STR132 DO
          BEGIN
              BODY := EMPTY_STRING_FIXED;
              LENGTH := 0;
              WHILE (NOT EOLN(CURR_IN_FILE)) AND
                    (LENGTH < STRING_FIXED_L)     DO
              BEGIN
                  LENGTH := LENGTH + 1;
                  READ (CURR_IN_FILE, BODY[LENGTH]);
              END (*WHILE*);
              READLN (CURR_IN_FILE);

              (* Check spaces at beginning of string and calculate     *)
              (* INDENT.                                               *)
              INDEX := 1;
              WHILE (INDEX < LENGTH) AND (BODY[INDEX] IN SPACE) DO
              BEGIN
                  IF BODY[INDEX] = CHR(9) THEN
                      INDENT := INDENT + (TAB - (INDENT MOD TAB))
                  ELSE
                      INDENT := INDENT + 1;
                  INDEX := INDEX + 1;
              END (*WHILE*);

              LAST_LINE := LAST_LINE + 1;
              FOR K := INDEX TO LENGTH DO
                  CHARS[K-INDEX+1] := BODY[K];

              (* Remove spaces at the end of the line.                 *)
              IF LENGTH > 0 THEN
              BEGIN
                  USED  := LENGTH-INDEX+1;
  (*********************************************************************)
  (* Modified 14/10/93 by Mark Kramer to solve an index out of bound   *)
  (* problem when bound checks are on.                                 *)
  (*             WHILE  (USED >0) AND (CHARS[USED] IN SPACE) DO        *)
  (*                  USED := USED-1;                                  *)

                 WHILE  (USED > 1) AND (CHARS[USED] IN SPACE) DO
                      USED := USED-1;
                 IF (USED = 1) AND (CHARS[USED] IN SPACE) THEN
                      USED := USED-1;

  (* End of modification 14/10/93.                                     *)
  (*********************************************************************)
              END (*IF*);
              ID := LAST_LINE;
          END (*WITH*);

          (* Update the File Table.                                    *)
          IF FILE_TABLE[LAST_FILE].FIRST = 0 THEN
              FILE_TABLE[LAST_FILE].FIRST := LAST_LINE;
          FILE_TABLE[LAST_FILE].LAST := LAST_LINE;
      END (*WITH*);
  END (*FT_RDLN*);

  (*********************************************************************)
  (* Routine:     FT_WRLN                                              *)
  (* Purpose:     Write a line to the current output file.             *)
  (* Interface:   LINE -         The line to be written.               *)
  (*              NR_BLANKS -    The number of blanks leading the      *)
  (*                             first character of LINE.              *)
  (*              DESTINATION -  The destination of the line (screen,  *)
  (*                             output file, reportfile etc.)         *)
  (*              REPORT_FILE -  Report file for output.               *)
  (*********************************************************************)
  PROCEDURE FT_WRLN;
  VAR
      INDEX:              INTEGER;
      NR_TOTAL_BLANKS:    INTEGER;

  BEGIN (*FT_WRLN*)
      NR_TOTAL_BLANKS := LINE.INDENT + NR_BLANKS;
      CASE DESTINATION OF
      0:  BEGIN
              FOR INDEX := 1 TO LINE.USED DO
                  WRITE (OUTPUT, LINE.CHARS[INDEX]);
              WRITELN (OUTPUT);
          END;
      1:  BEGIN
              WRLN_STRING (CURR_OUT_FILE, LINE.CHARS, LINE.USED,
                           NR_TOTAL_BLANKS);
          END;
      2:  BEGIN
              FOR INDEX := 1 TO LINE.USED DO
                  WRITE (OUTPUT, LINE.CHARS[INDEX]);
              WRITELN (OUTPUT);
          END;
      3:  BEGIN
              WRLN_STRING (REPORT_FILE, LINE.CHARS, LINE.USED, 0);
          END;
      END (*CASE*);

  END (*FT_WRLN*);

  (*-----------   Segment Table routines (ADT)  -----------------------*)

  (*********************************************************************)
  (* Routine:     ST_RD - Segment Table ReaD.                          *)
  (* Purpose:     Read a line from the SEGMENT_TABLE.                  *)
  (* Interface:   LINE  - The line which is read.                      *)
  (*              INDEX - The position of the line in SEGMENT_TABLE.   *)
  (* ST vars:     SEGMENT_TABLE.                                       *)
  (*********************************************************************)
  PROCEDURE ST_RD (VAR LINE: LINE_DES_; INDEX: ST_INDEX_);
  BEGIN

      LINE := SEGMENT_TABLE.LINES[INDEX];
  END (*ST_READ*);

  (*********************************************************************)
  (* Routine:    ST_WR - Segment Table WRite.                          *)
  (* Purpose:    Write a line to the SEGMENT_TABLE.                    *)
  (* Interface:  LINE - The line which is written                      *)
  (*             INDEX- The position of the LINE.                      *)
  (* ST var:     SEGMENT_TABLE.                                        *)
  (*********************************************************************)
  PROCEDURE ST_WR (LINE: LINE_DES_; INDEX: ST_INDEX_);
  BEGIN

      SEGMENT_TABLE.LINES[INDEX] := LINE;
  END (*ST_WR*);

  (*********************************************************************)
  (* Routine:     ST_ABS_SEG - Segment Table ABSolute SEGment          *)
  (* Purpose:     To return the absolute line number of the first      *)
  (*              line of the segment.                                 *)
  (* Interface:   SEGMENT - Given segment                              *)
  (*              Function result - The absolute line number of the    *)
  (*                                first line of SEGMENT.             *)
  (* ST vars:     SEGMENT_TABLE.                                       *)
  (*********************************************************************)
  FUNCTION ST_ABS_SEG;
  VAR
      LINE: LINE_DES_;

  BEGIN
      IF SEGMENT.FIRST > 0 THEN
      BEGIN
          ST_RD (LINE, SEGMENT.FIRST);
          ST_ABS_SEG := FT_ABS_LINE_NUMBER (LINE);
      END (*IF*)
  END (*ST_ABS_SEG*);

  (*********************************************************************)
  (* Routine:     ST_GET_FILE_SPEC                                     *)
  (* Purpose:     To return the file specification of the source file  *)
  (*              of the segment.                                      *)
  (* Interface:   SEGMENT - Given segment.                             *)
  (*              FILE_SPEC  - The file specification.                 *)
  (* ST vars:     SEGMENT_TABLE.                                       *)
  (*********************************************************************)
  PROCEDURE ST_GET_FILE_SPEC;
  VAR
      LINE: LINE_DES_;

  BEGIN
      ST_RD (LINE, SEGMENT.FIRST);
      FT_GET_FILE_SPEC (LINE, FILE_SPEC);
  END (*ST_GET_FILE_SPEC*);

  (*********************************************************************)
  (* Routine:     ST_GET_INDENT                                        *)
  (* Purpose:     Return the indentation of segment.                   *)
  (* Interface:   SEG -       Segment to be investigated.              *)
  (*              RETURNS -   Indent value or error-code.              *)
  (*********************************************************************)
  FUNCTION ST_GET_INDENT;
  VAR
      LINE: LINE_DES_;

  BEGIN
      ST_RD (LINE, SEG.FIRST);
      ST_GET_INDENT := FT_GET_INDENT (LINE);
  END (*ST_GET_INDENT*);

  (*********************************************************************)
  (* Routine:     ST_GET_LINE                                          *)
  (* Purpose:     Retrieves next line from the currently read segment. *)
  (* Interface:   LINE -  Returned line.                               *)
  (* ST vars:     SEGMENT_TABLE, LAST_READ_SEG.                        *)
  (*********************************************************************)
  PROCEDURE ST_GET_LINE;
  VAR
      INDEX: ST_INDEX_;

  BEGIN
      WITH LAST_READ_SEG DO
      BEGIN
          IF ST_IS_EMPTY_SEG (LAST_SEG) THEN
          BEGIN
              (* ST_GET_LINE has not properly been prepared for reading.*)
              WRITELN (OUTPUT, 'ST-GET-LN: ',
                               'System Failure... Call maintenance.');
              CLIP_STOP;
          END
          ELSE
          BEGIN
              INDEX := LAST_LINE + 1;
              IF INDEX > LAST_SEG.LAST THEN
              BEGIN
                  (* Segment exhausted. Return LINE with ID value 0.   *)
                  LINE.ID := 0;
              END
              ELSE
              BEGIN
                  (* Retrieve line at position INDEX from the ST and   *)
                  (* update LAST_READ_SEG.                             *)
                  ST_RD (LINE, INDEX);
                  LAST_LINE := INDEX;
              END (*IF*);
         END (*IF*);
     END (*WITH*);
  END (*ST_GET_LINE*);

  (*********************************************************************)
  (* Routine:     ST_GET_OPTION_LINE                                   *)
  (* Purpose:     To retrieve the first line from a segment which      *)
  (*              holds an option marker.                              *)
  (* Interface:   SEG -     The segment                                *)
  (*              LINE -    The first line holding an option marker    *)
  (* ST vars:     SEGMENT_TABLE, LAST_READ_SEG.                        *)
  (*********************************************************************)
  PROCEDURE ST_GET_OPTION_LINE;
  VAR
      INDEX:     ST_INDEX_;
      POSITION:  INTEGER;
      AUX_LINE:  LINE_DES_;

  BEGIN
      INDEX := SEG.FIRST;
      POSITION := 0;
      IF INDEX > 0 THEN
      BEGIN
          WHILE (POSITION =0) AND (INDEX <= SEG.LAST) DO
          BEGIN
              ST_RD (AUX_LINE, INDEX);
              POSITION := FT_GET_POS_OPTION_MARKER (AUX_LINE);
              IF POSITION =0 THEN
                 INDEX := INDEX + 1;
          END (*WHILE*);
          IF POSITION =0 THEN
              LINE.ID := 0
          ELSE
              LINE := AUX_LINE;
          WITH LAST_READ_SEG DO
          BEGIN
              LAST_SEG  := SEG;
              LAST_LINE := INDEX;
          END (*WITH*);
      END
      ELSE
      BEGIN
          LAST_READ_SEG.LAST_SEG.FIRST := 0;
          LAST_READ_SEG.LAST_SEG.LAST  := 0;
          LAST_READ_SEG.LAST_LINE      := 0;
          LINE.ID := 0;
      END (*IF*);
  END (*ST_GET_OPTION_LINE*);

  (*********************************************************************)
  (* Routine:     ST_GET_SEG                                           *)
  (* Purpose:     Retrieve the first line of a given segment from ST.  *)
  (* Interface:   LINE -  Returned line.                               *)
  (*              SEG -   Segment to read from.                        *)
  (* ST vars:     SEGMENT_TABLE, LAST_READ_SEG.                        *)
  (*********************************************************************)
  PROCEDURE ST_GET_SEG;
  BEGIN
      IF ST_IS_EMPTY_SEG (SEG) THEN
      BEGIN
          (* Return virtual line and reset LAST_READ_SEG.              *)
          LINE.ID := 0;
          ST_INIT_SEG (LAST_READ_SEG.LAST_SEG);
          LAST_READ_SEG.LAST_LINE := 0;
      END
      ELSE
      BEGIN
          ST_RD (LINE, SEG.FIRST);
          WITH LAST_READ_SEG DO
          BEGIN
              LAST_SEG  := SEG;
              LAST_LINE := SEG.FIRST;
          END (*WITH*);
      END (*IF*);
  END (*ST_GET_SEG*);

  (*********************************************************************)
  (* Routine:     ST_GET_SEG_RANGE - Segment Table SEGMENT RANGE       *)
  (* Purpose:     To return the first and last relative line number of *)
  (*              a segment.                                           *)
  (* Interface:   SEGMENT - Given segment.                             *)
  (*              FIRST   - The line number of the first segment line. *)
  (*              LAST    - The line number of the last segment line.  *)
  (* ST vars:     SEGMENT_TABLE.                                       *)
  (*********************************************************************)
  PROCEDURE ST_GET_SEG_RANGE;
  VAR
      LINE: LINE_DES_;

  BEGIN
      FIRST := 0;
      LAST  := 0;
      IF SEGMENT.FIRST > 0 THEN
      BEGIN
          ST_RD (LINE, SEGMENT.FIRST);
          FIRST := FT_GET_LINE_NUMBER (LINE);
          ST_RD (LINE, SEGMENT.LAST);
          LAST  := FT_GET_LINE_NUMBER (LINE);
      END (*IF*);
  END (*ST_GET_SEG_RANGE*);

  (*********************************************************************)
  (* Routine:     ST_INIT                                              *)
  (* Purpose:     General initialization of the segment table. To be   *)
  (*              invoked only once at the beginning of a run.         *)
  (* ST vars:     SEGMENT_TABLE, LAST_READ_SEG.                        *)
  (*********************************************************************)
  PROCEDURE ST_INIT;
  BEGIN

      SEGMENT_TABLE.USED := 0;
      ST_INIT_SEG (LAST_READ_SEG.LAST_SEG);
      LAST_READ_SEG.LAST_LINE :=  0;
  END (*ST_INIT*);

  (*********************************************************************)
  (* Routine:     ST_INIT_SEG                                          *)
  (* Purpose:     To establish a new and empty segment.                *)
  (* Interface:   SEG -     the segment to initialize.                 *)
  (*********************************************************************)
  PROCEDURE ST_INIT_SEG;
  BEGIN
      SEG.FIRST :=  0;
      SEG.LAST  := -1;
  END (*ST_INIT_SEG*);

  (*********************************************************************)
  (* Routine:     ST_IS_EMPTY_SEG                                      *)
  (* Purpose:     To examine if a segment is empty or not.             *)
  (* Interface:   SEG -    Segment to be examined.                     *)
  (*********************************************************************)
  FUNCTION ST_IS_EMPTY_SEG;
  BEGIN
      ST_IS_EMPTY_SEG := (ST_NUMBER_OF_LINES (SEG) <= 0);
  END (*ST_IS_EMPTY_SEG*);

  (*********************************************************************)
  (* Routine:     ST_NUMBER_OF_LINES                                   *)
  (* Purpose:     To calculate the number of lines in a segment.       *)
  (* Interface:   SEG - Segment to be investigated.                    *)
  (*              RETURNS -   Number of lines contained by segment.    *)
  (*********************************************************************)
  FUNCTION ST_NUMBER_OF_LINES;
  BEGIN
      WITH SEG DO
      BEGIN
          IF (FIRST >= 0)  AND  (LAST >= FIRST -1) THEN
          BEGIN
              ST_NUMBER_OF_LINES := LAST - FIRST + 1;
          END
          ELSE
          BEGIN
              WRITELN (OUTPUT, 'ST-NUMBER-OF-LINES: ',
                               'System Failure... Call maintenance.');
              CLIP_STOP;
          END (*IF*);
      END (*WITH*);
  END (*ST_NUMBER_OF_LINES*);

  (*********************************************************************)
  (* Routine:     ST_PUT_LINE                                          *)
  (* Purpose:     Add a source line to the last segment in the table.  *)
  (* Interface:   LINE -  Source line to write.                        *)
  (*              SEG -   Segment to write to.                         *)
  (* ST vars:     SEGMENT_TABLE.                                       *)
  (*********************************************************************)
  PROCEDURE ST_PUT_LINE;
  BEGIN
      IF SEGMENT_TABLE.USED < ST_SIZE THEN
      BEGIN
          WITH SEGMENT_TABLE DO
          BEGIN
              (* Abort if the ST has become internally inconsistent.   *)
              (* Othewise add line to the table.                       *)
              IF SEG.LAST <> USED THEN
              BEGIN
                  WRITELN (OUTPUT, 'ST-PUT-LN: ',
                           'System Failure... Call maintenance.');
                  CLIP_STOP;
              END
              ELSE
              BEGIN
                  USED := USED + 1;
                  ST_WR (LINE, USED);
                  SEG.LAST := USED;
              END (*IF*)
          END (*WITH*);
      END
      ELSE
      BEGIN
          (* Segment Table to small for this application.              *)
          WRITELN (OUTPUT, 'ST-PUT-LN: ',
                           'Parameter Failure... Call maintenance.');
          CLIP_STOP;
      END (*IF*);
  END (*ST_PUT_LINE*);

  (*********************************************************************)
  (* Routine:     ST_PUT_SEG                                           *)
  (* Purpose:     Start a new segment in ST by writing its first line. *)
  (* Interface:   LINE -  The line to be written.                      *)
  (*              SEG -   The returned segment.                        *)
  (* ST vars:     SEGMENT_TABLE, LAST_READ_SEG.                        *)
  (*********************************************************************)
  PROCEDURE ST_PUT_SEG;
  BEGIN
      IF SEGMENT_TABLE.USED < ST_SIZE THEN
      BEGIN
          WITH SEGMENT_TABLE DO
          BEGIN
              USED := USED + 1;
              ST_WR (LINE, USED);
              SEG.FIRST := USED;
              SEG.LAST := USED;
          END (*WITH*);
      END
      ELSE
      BEGIN
          WRITELN (OUTPUT, 'ST-PUT-SEG: ',
                           'Parameter Failure... Call maintenance.');
          CLIP_STOP;
      END (*IF*);
  END (*ST_PUT_SEG*);

  (*********************************************************************)
  (* Routine:   ST_FINIT - FINIsh Segment Table                        *)
  (* Purpose:   Remove the segment-file from the directory.            *)
  (* Interface: -                                                      *)
  (* ST vars:   SEGMENT_TABLE.                                         *)
  (*********************************************************************)
  PROCEDURE ST_FINIT;
  BEGIN
  END (*ST_REMOVE*);

  (*********************************************************************)
  (* Routine:     ST_SEG_WIDTH -   Segment Table SEGment USED.          *)
  (* Purpose:     Return the horizontal length of a segment.           *)
  (* Interface:   SEGMENT  -  Given segment.                           *)
  (*              RETURNS -   Length of the given segment.             *)
  (* ST vars:     SEGMENT_TABLE.                                       *)
  (*********************************************************************)
  FUNCTION ST_SEG_WIDTH;
  VAR
      LINE: LINE_DES_;

  BEGIN
      ST_RD (LINE, SEG.FIRST);
      ST_SEG_WIDTH := FT_GET_LINE_LENGTH (LINE);
  END;

  (*********************************************************************)
  (* Routine:     ST_WRITE_SEG                                         *)
  (* Purpose:     To write a segment to an output file.                *)
  (* Interface:   SEG -       Segment to be written.                   *)
  (*              BLANKS -    Leading blanks for every line of the     *)
  (*                          segment.                                 *)
  (*              DESTINATION -   Indicates the destination of the     *)
  (*                              writing action.                      *)
  (*              REPORT_FILE -   Report file for output.              *)
  (*********************************************************************)
  PROCEDURE ST_WRITE_SEG;
  VAR
      K: ST_INDEX_;
      LINE: LINE_DES_;

  BEGIN
      IF SEG.FIRST >0 THEN
      FOR K := SEG.FIRST TO SEG.LAST DO
      BEGIN
          ST_RD (LINE, K);
          FT_WRLN (LINE, BLANKS, DESTINATION);
      END (*FOR*);
  END (*ST_WRITE_SEG*);

  (*-----------   String Pool routines (ADT)  -------------------------*)

  (*********************************************************************)
  (* Routine:     SP_ADD_CHAR                                          *)
  (* Purpose:     Add character to currently written string.           *)
  (* Interface:   CH  - Character to be added.                         *)
  (*              STR - String to add character to.                    *)
  (*********************************************************************)
  PROCEDURE SP_ADD_CHAR;
  BEGIN
      WITH STRING_POOL^ DO
      IF USED < SP_SIZE THEN
      BEGIN
          (* SP has enough space left to accept another character.     *)
          USED := USED + 1;
          CHARS[USED] := CH;
          IF STR.FIRST =0 THEN
          BEGIN
              (* First character of a new string.                      *)
              STR.FIRST := USED;
              STR.LAST  := USED;
          END
          ELSE
          BEGIN
              (* The string already exists. Abort if this string is    *)
              (* not physically the last one of the SP.                *)
              IF STR.LAST <>  USED - 1 THEN
              BEGIN
                  WRITELN (OUTPUT, 'SP-ADD-CHAR: ',
                                   'System Failure... Call maintenance.');
                  CLIP_STOP;
              END (*IF*);
              STR.LAST := USED;
          END (*IF*);
      END
      ELSE
      BEGIN
          WRITELN (OUTPUT, 'SP-ADD-CHAR: ',
                           'Parameter Failure... Call maintenance.');
          CLIP_STOP;
      END (*IF.WITH*);
  END (*SP_ADD_CHAR*);

  (*********************************************************************)
  (* Routine:     SP_CONC_STR                                          *)
  (* Purpose:     Concatenation of neighbouring strings.               *)
  (* Interface:   MASTER -    Recieving string.                        *)
  (*              SLAVE -     Concatented string                       *)
  (*********************************************************************)
  PROCEDURE SP_CONC_STR;
  BEGIN
      IF MASTER.FIRST =0 THEN
          (* An empty MASTER becomes a SLAVE...                        *)
          MASTER := SLAVE
      ELSE IF SLAVE.FIRST =0 THEN
          (* but an empty SLAVE does not bother its MASTER.            *)
          (* DO NOTHING...                                             *)
      ELSE IF MASTER.FIRST <>0 THEN
      BEGIN
          (* Concatenate only if SLAVE follows MASTER immediately.     *)
          IF MASTER.LAST + 1 = SLAVE.FIRST THEN
              MASTER.LAST := SLAVE.LAST
          ELSE
          BEGIN
              WRITELN (OUTPUT, 'SP-CONC-STR: ',
                               'System Failure... Call maintenance.');
              CLIP_STOP;
          END (*IF*);
      END (*IF*);
  END (*SP_CONC_STR*);

  (*********************************************************************)
  (* Routine:     SP_EQ                                                *)
  (* Purpose:     To decide if two strings are equal.                  *)
  (* Interface:   STR1:    First operand.                              *)
  (*              STR2:    Second operand.                             *)
  (*              RETURNS: TRUE if both operands are equal.            *)
  (* SP vars:     STRING_POOL.                                         *)
  (*********************************************************************)
  FUNCTION SP_EQ;
  VAR
      CONTINUE:   BOOLEAN;
      INDEX:      INTEGER;
      STR_L:      INTEGER;

  BEGIN
      STR_L := SP_LENGTH_STR (STR1);
      IF STR_L <> SP_LENGTH_STR (STR2) THEN
          SP_EQ := FALSE
      ELSE
      BEGIN
          INDEX    := 1;
          CONTINUE := TRUE;
          SP_EQ    := TRUE;
          WHILE (CONTINUE) AND (INDEX <= STR_L) DO
          BEGIN
              IF SP_GET_CHAR (INDEX, STR1)
                                 <> SP_GET_CHAR (INDEX, STR2) THEN
              BEGIN
                  CONTINUE := FALSE;
                  SP_EQ    := FALSE;
              END (*IF*);
              INDEX := INDEX + 1;
          END (*WHILE*);
      END (*IF*);
  END (*SP_EQ*);

  (*********************************************************************)
  (* Routine:     SP_EXTR_STR                                          *)
  (* Purpose:     To extract a sequence of characters out of the  SP   *)
  (*              and to store these characters in a packed array.     *)
  (* Interface:   STR     - Descriptor of the wanted string.           *)
  (*              STR132  - The extracted characters.                  *)
  (*********************************************************************)
  PROCEDURE SP_EXTR_STR;
  VAR
      I:         INTEGER;
      K:         SP_INDEX_;

  BEGIN
      IF STR.FIRST= 0 THEN
      BEGIN
          STR132.LENGTH := 0;
          STR132.BODY   := EMPTY_STRING_FIXED;
      END
      ELSE IF STR.LAST <= STRING_POOL^.USED THEN
      BEGIN
          STR132.BODY   := EMPTY_STRING_FIXED;
          I := 0;
          FOR K := STR.FIRST TO STR.LAST DO
          BEGIN
              I := I + 1;
              STR132.BODY[I] := STRING_POOL^.CHARS[K];
          END;
          STR132.LENGTH := I;
      END
      ELSE
      BEGIN
          WRITELN (OUTPUT, 'SP_EXTR_STR: ',
                           'System Failure... Call maintenance.');
          CLIP_STOP;
      END (*IF.IF*);
  END;

  (*********************************************************************)
  (* Routine:     SP_GET_CHAR                                          *)
  (* Purpose:     Get character from given position of a string.       *)
  (* Interface:   INDEX   -   Index of the wanted character.           *)
  (*              STR     -   String to be searched.                   *)
  (*              RETURNS -   Wanted character.                        *)
  (* SP vars:     STRING_POOL.                                         *)
  (* MOD1:        EWvA (18/12/91) ivm probleem met SCAN_LINE (7).      *)
  (*********************************************************************)
  FUNCTION SP_GET_CHAR;
  BEGIN
      WITH STR DO
      BEGIN
          (* Check if value of INDEX is within correct range.          *)
          IF ((LAST - FIRST +1) < INDEX)
              OR (INDEX <= 0) THEN
          BEGIN
  (* MOD1:    WRITELN (OUTPUT, 'SP-GET_CHAR: ',                        *)
  (* MOD1:                    'System Failure... Call maintenance.');  *)
  (* MOD1:    CLIP_STOP;                                                *)
              SP_GET_CHAR := CHR(0);                          (* MOD1: *)
          END
          ELSE
              (* INDEX and STR are sound. Proceed to retrieve          *)
              (* character.                                            *)
              SP_GET_CHAR := STRING_POOL^.CHARS [FIRST + INDEX -1];
      END (*IF*)
  END (*SP_GET_CHAR*);

  (*********************************************************************)
  (* Routine:     SP_INIT                                              *)
  (* Purpose:     General initialization of the String Pool. It is     *)
  (*              only activated once at the start of an CLIP-run.      *)
  (*********************************************************************)
  PROCEDURE SP_INIT;
  BEGIN
      NEW (STRING_POOL);
      STRING_POOL^.USED := 0;
  END (*SP_INIT*);

  (*********************************************************************)
  (* Routine:     SP_INIT_STR                                          *)
  (* Purpose:     Initialize a string                                  *)
  (* Interface:   STR - the string to be initialized.                  *)
  (*********************************************************************)
  PROCEDURE SP_INIT_STR;
  BEGIN
      STR.FIRST := 0;
      STR.LAST  := -1;
  END (*SP_INIT_STR*);

  (*********************************************************************)
  (* Routine:     SP_IS_EMPTY_STR                                      *)
  (* Purpose:     The function examines if a string is empty or not.   *)
  (* Interface:   STR     -    string to be examined.                  *)
  (*              RETURNS -    TRUE if string is empty.                *)
  (*********************************************************************)
  FUNCTION SP_IS_EMPTY_STR;
  BEGIN
      SP_IS_EMPTY_STR := (SP_LENGTH_STR(STR) = 0);
  END (*SP_IS_EMPTY_STR*);

  (*********************************************************************)
  (* Routine:     SP_LENGTH_STR                                        *)
  (* Purpose:     To calculate the length of a string.                 *)
  (* Interface:   STR:    Given string.                                *)
  (*              RESULT: Length of STRING.                            *)
  (*********************************************************************)
  FUNCTION SP_LENGTH_STR;
  BEGIN
      SP_LENGTH_STR := STR.LAST - STR.FIRST + 1;
  END (*SP_LENGTH_STR*);

  (*********************************************************************)
  (* Routine:   SP_ADD_BUFFER                                          *)
  (* Purpose:   Add the buffer to a string.                            *)
  (* Interface: STR - String to which the buffer is added.             *)
  (* SP vars:   BUFFER                                                 *)
  (*********************************************************************)
  PROCEDURE SP_ADD_BUFFER;
  VAR
      I : INTEGER;

  BEGIN
      SP_INIT_STR (STR);
      FOR I := 1 TO BUFFER.LENGTH DO
          SP_ADD_CHAR (BUFFER.BODY[I], STR);
  END (*SP_ADD_BUFFER*);

  (*********************************************************************)
  (* Routine:   SP_ADD_BUFFER_CHAR                                     *)
  (* Purpose:   Add a character to the buffer.                         *)
  (* Interface: CH - Character to be added.                            *)
  (* SP vars:   BUFFER                                                 *)
  (*********************************************************************)
  PROCEDURE SP_ADD_BUFFER_CHAR;
  BEGIN
      WITH BUFFER DO
      IF LENGTH < 132 THEN
      BEGIN
          LENGTH := LENGTH + 1;
          BODY[LENGTH] := CH;
      END
      ELSE
      BEGIN
          WRITELN (OUTPUT,'SP_ADD_BUFFER_CHAR system failure...',
                          'Call maintenance');
          CLIP_STOP;
      END (*IF*);
  END (*SP_ADD_BUFFER_CHAR*);

  (*********************************************************************)
  (* Routine:   SP_GET_BUFFER_CHAR                                     *)
  (* Purpose:   Get a character from the buffer.                       *)
  (* Interface: INDEX -              Index of the wanted character.    *)
  (*            SP_GET_BUFFER_CHAR - Character to get.                 *)
  (* SP vars:   BUFFER                                                 *)
  (*********************************************************************)
  FUNCTION SP_GET_BUFFER_CHAR;
  BEGIN
      IF INDEX IN [1..BUFFER.LENGTH] THEN
          SP_GET_BUFFER_CHAR := BUFFER.BODY[INDEX]
      ELSE
          SP_GET_BUFFER_CHAR := CHR(0);
  END (*SP_GET_BUFFER_CHAR*);

  (*********************************************************************)
  (* Routine:   SP_INIT_BUFFER                                         *)
  (* Purpose:   Initialize the buffer by making it empty.              *)
  (* SP vars:   BUFFER                                                 *)
  (*********************************************************************)
  PROCEDURE SP_INIT_BUFFER;
  BEGIN
      BUFFER.LENGTH := 0;
  END (*SP_INIT_BUFFER*);

  (*-----------   DIAGNOSTic routines (ADT)  --------------------------*)

  (*********************************************************************)
  (* Routine:   DIAGNOST_INIT - INITialize the variables of DIAGNOST.  *)
  (* Purpose:   Initialize the global variables of procdure DIAG.      *)
  (* Interface: -                                                      *)
  (* DIAGNOST vars: DIAG_TBL, NO_MESSAGES, NR_MSG.                     *)
  (*********************************************************************)
  PROCEDURE DIAGNOST_INIT;

  VAR
      K:                INTEGER;
      TBL_FILE:         TEXT;
      ERROR_CODE:       INTEGER;
      DUMMY_ERROR:      INTEGER;
      DUMMY_FILE_OK :   BOOLEAN;
      DUMMY_ERROR_MSG : ERROR_MSG_;
      AUX_STRING_8:     PACKED ARRAY[1..8] OF CHAR;
      TBL_FILE_NAME:    FILE_SPEC_;
      MESS_CNT:         INTEGER;
      CH : CHAR;


  BEGIN
      (*******        DIAGNOST_INIT body                         *******)
      NO_MESSAGES := FALSE;
      NR_MSG := 0;
      FOR K := 1 TO MAX_NR_MESS DO
          DIAG_TBL[K].MESS_LOC := '                         ';
    
      (* Clear the variable which is to hold the specification of the  *)
      (* error message file.                                           *)
      TBL_FILE_NAME.BODY := EMPTY_STRING_FIXED;
      TBL_FILE_NAME.LENGTH := 0;
    
      (*******      DIAGNOST_INIT Add environment (TP) (#Opt)    *******)
    
      (* Write name of message file to TBL_FLE_NAME. The length must   *)
      (* be exactly 8 characters.                                      *)
      AUX_STRING_8 := 'CLIP_MSG';
      WITH TBL_FILE_NAME DO
      BEGIN
          FOR K := 1 TO 8 DO
              BODY[LENGTH+K] := AUX_STRING_8[K];
          LENGTH := LENGTH + 8;
      END (* WITH *);
    
      (*******      DIAGNOST_INIT Add extension (TP) (#Opt)      *******)
    
      EXT_FILE_PREP (TBL_FILE, TBL_FILE_NAME, INSP_MODE, DUMMY_FILE_OK,
                     ERROR_CODE, DUMMY_ERROR_MSG);
      IF ERROR_CODE <> 0 THEN
      BEGIN
          NO_MESSAGES := TRUE;
          WRITELN ('Error message file (logical name: CLIP_MSG) not found.');
          WRITELN ('CLiP will continue without diagnostics');
          WRITELN;
      END
      ELSE
      BEGIN
          NO_MESSAGES := FALSE;
    
          (*********************  DIAGNOST_INIT (1)  ***********************)
          (** Initialize DIAG_TBL by reading the TBL_FILE.                **)
          MESS_CNT := 1;
          WHILE NOT EOF (TBL_FILE) DO
          BEGIN
              WITH DIAG_TBL[MESS_CNT] DO
              BEGIN
                  (*********************  DIAGNOST_INIT (1.1)  *****************)
                  (** Initialize DIAG_TBL[MESS_CNT].MESS_LOC.                 **)
                  READ (TBL_FILE, CH);
                  READ (TBL_FILE, CH);
                  READ (TBL_FILE, CH);
                  K := 1;
                  WHILE CH <> ':' DO
                  BEGIN
                      MESS_LOC[K] := CH;
                      READ (TBL_FILE, CH);
                      K := K + 1;
                  END (*WHILE*);
                  (*****************  End of DIAGNOST_INIT (1.1)  **************)
        
                  (*********************  DIAGNOST_INIT (1.2)  *****************)
                  (** Initialize DIAG_TBL[MESS_CNT].MESSAGE.                  **)
                  MESSAGE := EMPTY_STRING_FIXED;
                  READ (TBL_FILE, CH);
                  MESS_L := 1;
                  WHILE CH <> '%' DO
                  BEGIN
                      IF EOLN (TBL_FILE) THEN
                          READLN (TBL_FILE);
                      READ (TBL_FILE, CH);
                      IF CH <> '%' THEN
                      BEGIN
                          MESSAGE[MESS_L] := CH;
                          MESS_L := MESS_L + 1;
                      END (*IF*);
                  END (*WHILE*);
                  (*****************  End of DIAGNOST_INIT (1.2)  **************)
        
                  READLN (TBL_FILE);
              END (*WITH*);
              MESS_CNT := MESS_CNT + 1;
          END (*WHILE*);
          (*****************  End of DIAGNOST_INIT (1)  ********************)
    
          (* Close the TBL_FILE and ignore any errors that may occur.      *)
          EXT_FILE_CLOSE (TBL_FILE, DUMMY_ERROR);
      END (*IF*);
      (*****************  End of DIAGNOST_INIT body  *******************)

  END (*DIAGNOST_INIT*);

  (*********************************************************************)
  (* Routine:     DIAG  -  Issue a DIAGnostic message.                 *)
  (* Purpose:     Handling of all diagnostics by a message to the      *)
  (*              terminal.                                            *)
  (* Interface:   DIAG_TBL -      Internal table with messages.        *)
  (*              MSG_TBL -       Internal table with detected errors. *)
  (*              NR_MSG -        Counting error messages in MSG_TBL.  *)
  (*              SEV -           Severity of the diagnostic.          *)
  (*              LOC -           Program location which detected the  *)
  (*                              problem.                             *)
  (*              SOURCE_LINE -   Source line causing the problem.     *)
  (*              SEGMENT -       Segment causing the problem.         *)
  (*              STRING132 -     Keyword(s) indicating the specific   *)
  (*                              diagnostic.                          *)
  (*********************************************************************)
  PROCEDURE DIAG (SEV:           SEV_CODE_;
                  LOC:           LOC_SPEC_;
                  SOURCE_LINE:   LINE_DES_;
                  SEGMENT:       SEGMENT_DES_;
                  STRING132:     STRING132_);

  VAR
      K :               INTEGER;

  BEGIN
      (*************************  DIAG (body)  *****************************)
      IF NOT NO_MESSAGES THEN
      BEGIN
          IF NR_MSG < MAX_ERROR THEN
          BEGIN
              NR_MSG := NR_MSG + 1;
    
              (*********************  DIAG (1)  ************************)
              (** Store the actual parameters passed to DIAG in       **)
              (** MSG_TBL[NR_MSG].                                    **)
              MSG_TBL[NR_MSG].SEV := SEV;
              MSG_TBL[NR_MSG].LOC := LOC;
              MSG_TBL[NR_MSG].STRING132 := STRING132;
              MSG_TBL[NR_MSG].SOURCE_LINE := SOURCE_LINE;
              MSG_TBL[NR_MSG].SEGMENT := SEGMENT;
              IF NOT ST_IS_EMPTY_SEG (SEGMENT) THEN
                      MSG_TBL[NR_MSG].LINE_ABS := ST_ABS_SEG (SEGMENT)
              ELSE IF FT_GET_LINE_LENGTH (SOURCE_LINE) > 0 THEN
                      MSG_TBL[NR_MSG].LINE_ABS :=
                              FT_ABS_LINE_NUMBER (SOURCE_LINE)
              ELSE
              BEGIN
                  WRITELN ('Internal error DIAG (1)... Call maintenance');
                  WRITELN ('Troubles caused by an error detected by:  ');
                  FOR K := 1 TO LOC_SPEC_L DO
                      WRITE (LOC[K]);
                  NR_MSG := NR_MSG - 1;
              END (*IF.IF*);
              (*******************  End of DIAG (1)  *******************)
          END
          ELSE IF NR_MSG = MAX_ERROR THEN
          BEGIN
              WRITELN (OUTPUT, 'CLIP detected more then ',
                                                       NR_MSG,' errors');
              WRITELN (OUTPUT, 'Only first ', NR_MSG,
                               ' diagnostic messages will be generated');
              NR_MSG := NR_MSG + 1;
          END
          ELSE IF NR_MSG > MAX_ERROR THEN
          BEGIN
              (* Nothing remains to be done here.                      *)
          END (*IF.IF.IF*);
      END (*IF*);
      (*********************  End of DIAG (body)  **********************)

  END (*DIAG*);

  (*********************************************************************)
  (* Routine:     DIAGNOST_EXIT - Exit the diagnostic table.           *)
  (* Purpose:     Generate the cumulated list of diagnostics to the    *)
  (*              termnal and, if specified, to a report file.         *)
  (* Interface:   DIAGNOST module variables                            *)
  (*              REPORT_FILE -   From CLIP_CDL                        *)
  (*              REPORT_OK -     From CLIP_CDL                        *)
  (*              RUN_INFO variables                                   *)
  (*********************************************************************)
  PROCEDURE DIAGNOST_EXIT;

  VAR
      I, K:           INTEGER;
      MESS_INDEX:   INTEGER;
      FILE_SPEC:      FILE_SPEC_;
      FIRST, LAST:    INTEGER;
      TMP_STRING_8:   PACKED ARRAY [1..8] OF CHAR;
      J:              INTEGER;

  BEGIN
      (*********************  DIAGNOST_EXIT (body)  ************************)
      IF NOT NO_MESSAGES THEN
      BEGIN
          IF NR_MSG > MAX_ERROR THEN
              NR_MSG := MAX_ERROR;
    
          (*****************  DIAGNOST_EXIT (1)  ***************************)
          (** Sort MSG_TBL by absolute line numbers.                      **)
          FOR K :=  NR_MSG DOWNTO 1 DO
          BEGIN
              FOR I := 1 TO K-1 DO
              BEGIN
                  IF MSG_TBL[I].LINE_ABS > MSG_TBL[I+1].LINE_ABS THEN
                  BEGIN
                      MSG_TBL[MAX_ERROR+1] := MSG_TBL[I];
                      MSG_TBL[I] := MSG_TBL[I+1];
                      MSG_TBL[I+1] := MSG_TBL[MAX_ERROR+1];
                  END (*IF*);
              END (*FOR*);
          END (*FOR*);
          (*****************  End of DIAGNOST_EXIT (1)  ********************)
    
          (* Write the opening lines of the report(s).                     *)
          IF NR_MSG > 0 THEN
          BEGIN
              WRITELN (OUTPUT, '============================ ',
                           'Diagnostics ===============================');
              IF REPORT_OK THEN
                  WRITELN (REPORT_FILE, '============================ ',
                           'Diagnostics ===============================');
          END (* IF *);
    
          (*****************  DIAGNOST_EXIT (2)  ***************************)
          (** Generate messages from MSG_TBL and DIAG_TBL to OUTPUT and   **)
          (** also to REPORT_FILE if REPORT_OK is raised. Write a         **)
          (** diagnostic in case of trouble, but do not abort.            **)
          FOR K := 1 TO NR_MSG DO
          BEGIN
              MESS_INDEX := 0;
        
              (*****************  DIAGNOST_EXIT (2.1)  *************************)
              (** Search DIAG_TBL for MSG_TBL[K].LOC. Store the index in      **)
              (** MESS_INDEX.                                                 **)
              FOR I := 1 TO MAX_NR_MESS DO
              BEGIN
                  IF DIAG_TBL[I].MESS_LOC = MSG_TBL[K].LOC THEN
                      MESS_INDEX := I;
              END (*FOR*);
              (****************  End of DIAGNOST_EXIT (2.1)  *******************)
        
              IF MESS_INDEX = 0 THEN
              BEGIN
                  WRITELN (OUTPUT,
                           'system error DIAGNOST_EXIT  ..... call maintenance');
                  WRITELN ('Not able to generate diagnostic message.');
                  WRITE ('DIAGNOST_EXIT was called by : ');
                  FOR I := 1 TO LOC_SPEC_L DO
                       WRITE (MSG_TBL[K].LOC[I]);
        
                  IF REPORT_OK THEN
                  BEGIN
                      WRITELN (REPORT_FILE,
                           'system error DIAGNOST_EXIT  ..... call maintenance');
                      WRITELN (REPORT_FILE,
                                     'Not able to generate diagnostic message.');
                      WRITE (REPORT_FILE, 'DIAGNOST_EXIT was called by : ');
                      FOR I := 1 TO LOC_SPEC_L DO
                          WRITE (REPORT_FILE, MSG_TBL[K].LOC[I]);
                  END (* IF *);
              END
              ELSE
              BEGIN
                  (*****************  DIAGNOST_EXIT (2.2)  *********************)
                  (** Generate diagnostic using information stored in MSG_-   **)
                  (** TBL[K] and DIAG_TBL[MESS_INDEX].                        **)
                  WITH MSG_TBL[K] DO
                  BEGIN
                      CASE SEV OF
                      WARN:
                          TMP_STRING_8 := 'Warning ';
                      ERR:
                          TMP_STRING_8 := 'Error   ';
                      FAIL:
                          TMP_STRING_8 := 'Failure ';
                      DUMP:
                          CLIP_STOP;
                      END (*CASE*);
                      WRITE (OUTPUT, TMP_STRING_8);
                      IF REPORT_OK THEN
                          WRITE (REPORT_FILE, TMP_STRING_8);
                
                      IF NOT ST_IS_EMPTY_SEG (SEGMENT) THEN
                      BEGIN
                          ST_GET_SEG_RANGE (SEGMENT, FIRST, LAST);
                          ST_GET_FILE_SPEC (SEGMENT, FILE_SPEC);
                          WRITE (' between the lines ', FIRST:2, ' and ',
                                                   LAST:2, ' of file: ' );
                          FOR I := 1 TO FILE_SPEC.LENGTH DO
                              WRITE (FILE_SPEC.BODY[I]);
                          WRITELN;
                          WRITELN ('Source lines:');
                          WRITELN;
                
                          (* Write segement to OUTPUT.                             *)
                          ST_WRITE_SEG (SEGMENT, 0, 0);
                          WRITELN;
                
                          IF REPORT_OK THEN
                          BEGIN
                              WRITE (REPORT_FILE, ' between the lines ', FIRST:2,
                                                         ' and ', LAST:2, ' of file: ' );
                              FOR I := 1 TO FILE_SPEC.LENGTH DO
                                  WRITE (REPORT_FILE, FILE_SPEC.BODY[I]);
                              WRITELN (REPORT_FILE);
                              WRITELN (REPORT_FILE, 'Source lines:');
                              WRITELN (REPORT_FILE);
                
                              (* Write segement to file variable REPORT_FILE of FT *)
                              (* (see also DIAGNOST_EXIT (2)).                     *)
                              ST_WRITE_SEG (SEGMENT, 0, 3);
                              WRITELN (REPORT_FILE);
                          END (* IF *);
                      END
                      ELSE IF FT_GET_LINE_LENGTH (SOURCE_LINE) > 0 THEN
                      BEGIN
                          FT_GET_FILE_SPEC (SOURCE_LINE, FILE_SPEC);
                
                          WRITE ('in line ', FT_GET_LINE_NUMBER (SOURCE_LINE):4);
                          WRITE (' of file :');
                          FOR I := 1 TO FILE_SPEC.LENGTH DO
                              WRITE (FILE_SPEC.BODY[I]);
                          WRITELN;
                
                          (* Write line to OUTPUT.                                 *)
                          FT_WRLN (SOURCE_LINE, 0, 0);
                
                          IF REPORT_OK THEN
                          BEGIN
                              WRITE (REPORT_FILE, 'in line ',
                                                     FT_GET_LINE_NUMBER (SOURCE_LINE):4);
                              WRITE (REPORT_FILE, ' of file :');
                              FOR I := 1 TO FILE_SPEC.LENGTH DO
                                  WRITE (REPORT_FILE, FILE_SPEC.BODY[I]);
                              WRITELN (REPORT_FILE);
                
                              (* Write LINE to file variable REPORT_FILE of FT     *)
                              (* (see also DIAGNOST_EXIT (2)).                     *)
                              FT_WRLN (SOURCE_LINE, 0, 3);
                          END (* IF *);
                      END
                      ELSE
                      BEGIN
                          WRITELN ('Internal error DIAG...  Call maintenance');
                          IF REPORT_OK THEN
                              WRITELN (REPORT_FILE,
                                             'Internal error DIAG...  Call maintenance');
                      END (*IF.IF*);
                      WITH DIAG_TBL[MESS_INDEX] DO
                      BEGIN
                          FOR I := 1 TO MESS_L DO
                          BEGIN
                              IF MESSAGE[I] <> '@' THEN
                              BEGIN
                                  WRITE (MESSAGE[I]);
                                  IF REPORT_OK THEN
                                      WRITE (REPORT_FILE, MESSAGE[I]);
                              END
                              ELSE
                              BEGIN
                                  FOR J := 1 TO STRING132.LENGTH DO
                                  BEGIN
                                      WRITE (STRING132.BODY[J]);
                                      IF REPORT_OK THEN
                                          WRITE (REPORT_FILE, STRING132.BODY[J]);
                                  END (*FOR*);
                              END (*IF*);
                          END (*FOR*);
                      END(*WITH*);
                  END (*WITH*);
                  (****************  End of DIAGNOST_EXIT (2.2)  ***************)
              END (*IF*);
              WRITELN; WRITELN;
              WRITELN ('------------------------------------',
                       '------------------------------------');
        
              IF REPORT_OK THEN
              BEGIN
                  WRITELN (REPORT_FILE); WRITELN (REPORT_FILE);
                  WRITELN (REPORT_FILE, '------------------------------------',
                                      '------------------------------------');
              END (* IF *);
          END (*FOR*);
          (****************  End of DIAGNOST_EXIT (2)  *********************)
    
          (* Write closing remarks of the report(s). Don't forget to close *)
          (* the REPORT_FILE if it has been used. Ignore closing problems. *)
          IF NR_MSG > 0 THEN
          BEGIN
              WRITE (OUTPUT, 'Diagnostics TOTAL of: ',NR_MSG:1);
              IF REPORT_OK THEN
                  WRITE (REPORT_FILE, 'Diagnostics TOTAL of: ',NR_MSG:1);
    
              (* Print different text to distinguish between a for single  *)
              (* error situation and a multiple error situation.           *)
              IF NR_MSG = 1 THEN
              BEGIN
                  WRITELN (' error or warning detected.');
                  IF REPORT_OK THEN
                      WRITELN (REPORT_FILE, ' error or warning detected.');
              END
              ELSE
              BEGIN
                  WRITELN (' errors or warnings detected.');
                  IF REPORT_OK THEN
                      WRITELN (REPORT_FILE, ' errors or warnings detected.');
              END (* IF *);
    
              WRITELN;
              WRITELN ('============================ End of ',
                       'diagnostics ========================');
              WRITELN;
              IF REPORT_OK THEN
              BEGIN
                  WRITELN (REPORT_FILE);
                  WRITELN (REPORT_FILE,
                                   '============================ End of ',
                             'diagnostics ========================');
                  WRITELN (REPORT_FILE);
              END (* IF *);
          END (*IF*);
      END (*IF*);
      (****************  End of DIAGNOST_EXIT (body)  **********************)

  END (*DIAG*);


  (*-----------   Main components of the CLiP system  -----------------*)


  (*********************************************************************)
  (* Routine:   SCN_LINE_INIT - INITialize variables of SCN_LINE.      *)
  (* Purpose:   Initialize the global variables of procedure SCAN_LINE.*)
  (* Interface: -                                                      *)
  (* SCN_LINE vars: ALLOWED                                            *)
  (*********************************************************************)
  PROCEDURE SCN_LINE_INIT;
  BEGIN
      ALLOWED := ['A'..'Z', 'a'..'z', '0'..'9','.'];
  END;


  (*********************************************************************)
  (* Routine:     SCAN_LINE  - Scan a source line                      *)
  (* Purpose:     To examine to what sort of CLIP category a source    *)
  (*              line belongs to.                                     *)
  (* Interface:   SOURCE_LINE:    The line to be scanned.              *)
  (*              LINE_INFO:      A record structure that holding all  *)
  (*                              relevant info of this SOURCE_LINE.   *)
  (*              RUN_INFO:       General information for this run.    *)
  (*********************************************************************)
  PROCEDURE SCAN_LINE (VAR LINE_INFO:   LINE_INFO_;
                       VAR SOURCE_LINE: LINE_DES_;
                       RUN_INFO:        RUN_INFO_);

  VAR
      SCAN_LINE_CONTINUE: BOOLEAN;
      L2_LINE,
      L3_LINE,
      L4_LINE:            BOOLEAN;
      LENGTH_LINE:        INTEGER;
      START_INDEX,
      END_INDEX:          INTEGER;
      SEGMENT:            SEGMENT_DES_;
      STRING132:          STRING132_;
      OPEN_FOUND,
      CLOSE_FOUND:        BOOLEAN;
      X, Y:               INTEGER;
      CH:                 CHAR;
      CLIP_CCL:    CHAR;
      CLIP_CCR:    CHAR;

  BEGIN
      (*******                SCAN_LINE (body)                   *******)
    
      (*************************  SCAN_LINE (1)  ***************************)
      (** Initialize the Buffer and SCAN_LINE_CONTINUE.                   **)
      SP_INIT_BUFFER;
      SCAN_LINE_CONTINUE := TRUE;
      (*********************  End of SCAN_LINE (1)  ************************)
    
      (*************************  SCAN_LINE (2)  ***************************)
      (** Examine the length of SOURCE_LINE. Make SCAN_LINE_CONTINUE to   **)
      (** FALSE if this length is shorter then that of CLIP_LPAR and      **)
      (** CLIP_RPAR together and set LINE_INFO.CATEGORY to L5.            **)
      WITH RUN_INFO DO
      BEGIN
          LENGTH_LINE := FT_GET_LINE_LENGTH (SOURCE_LINE);
          IF LENGTH_LINE < CLIP_LPAR.LENGTH+CLIP_RPAR.LENGTH THEN
          BEGIN
              LINE_INFO.CATEGORY := L5;
              SCAN_LINE_CONTINUE := FALSE;
          END (*IF*);
      END (*WITH*);
      (*********************  End of SCAN_LINE (2)  ************************)
    
      IF SCAN_LINE_CONTINUE THEN
      BEGIN
          (*************************  SCAN_LINE (3)  ***********************)
          (** Examine if SOURCE_LINE starts with an CLIP_LPAR and ends    **)
          (** with an CLIP_RPAR. Set SCAN_LINE_CONTINUE to FALSE if this  **)
          (** is not the case. Generate error message using SOURCE_LINE   **)
          (** if only one of the two strings is detected.                 **)
          X := 1;
          OPEN_FOUND := TRUE;
          WITH RUN_INFO DO
          BEGIN
              WHILE (X <= CLIP_LPAR.LENGTH) AND (SCAN_LINE_CONTINUE) DO
              BEGIN
                  CH := FT_GET_CHAR (SOURCE_LINE, X);
                  IF CLIP_LPAR.BODY[X] <> CH THEN
                  BEGIN
                      SCAN_LINE_CONTINUE := FALSE;
                      OPEN_FOUND := FALSE;
                  END (*IF*);
               X := X+1;
               END (*WHILE*);
        
               X := LENGTH_LINE-CLIP_RPAR.LENGTH+1;
               Y := 1;
               CLOSE_FOUND := TRUE;
               WHILE (X <=LENGTH_LINE) DO
               BEGIN
                   CH := FT_GET_CHAR (SOURCE_LINE, X);
                   IF CLIP_RPAR.BODY[Y] <> CH THEN
                   BEGIN
                       CLOSE_FOUND := FALSE;
                       SCAN_LINE_CONTINUE := FALSE;
                   END (*IF*);
                   X := X+1;
                   Y := Y+1;
               END (*WHILE*);
          END (*WITH*);
        
          IF NOT SCAN_LINE_CONTINUE THEN
          BEGIN
              ST_INIT_SEG (SEGMENT);
              STRING132.LENGTH := 0;
              STRING132.BODY   := EMPTY_STRING_FIXED;
              IF (OPEN_FOUND) AND (NOT CLOSE_FOUND) THEN
                  DIAG (WARN, 'SCAN_LINE (3a)           ', SOURCE_LINE, SEGMENT,
                        STRING132)
              ELSE IF (CLOSE_FOUND) AND (NOT OPEN_FOUND) THEN
                  DIAG (WARN, 'SCAN_LINE (3b)           ', SOURCE_LINE, SEGMENT,
                        STRING132);
          END (*WITH*);
          (*********************  End of SCAN_LINE (3)  ********************)
    
          IF NOT SCAN_LINE_CONTINUE THEN
              LINE_INFO.CATEGORY := L5
          ELSE
          BEGIN
              L3_LINE := FALSE;
    
              (*********************  SCAN_LINE (4)  ***********************)
              (** Examine the character following CLIP_LPAR and the one   **)
              (** preceeding CLIP_RPAR. Set L3_LINE to TRUE if at least   **)
              (** one of these characters differs from CLIP_CC. Generate  **)
              (** an error message using SOURCE_LINE if only one CLIP_CC  **)
              (** is detected.                                            **)
              WITH RUN_INFO DO
              BEGIN
                  X := CLIP_LPAR.LENGTH+1;
                  Y := LENGTH_LINE-CLIP_RPAR.LENGTH;
                  CLIP_CCL := FT_GET_CHAR (SOURCE_LINE, X);
                  CLIP_CCR := FT_GET_CHAR (SOURCE_LINE, Y);
            
                  IF (CLIP_CCL <> CLIP_CC) AND (CLIP_CCR <> CLIP_CC) THEN
                  BEGIN
                      SCAN_LINE_CONTINUE := FALSE;
                      L3_LINE := TRUE;
                  END
                  ELSE IF (CLIP_CCL<>CLIP_CC) AND (CLIP_CCR=CLIP_CC) THEN
                  BEGIN
                      ST_INIT_SEG (SEGMENT);
                      STRING132.LENGTH := 0;
                      STRING132.BODY := EMPTY_STRING_FIXED;
                      DIAG (WARN, 'SCAN_LINE (4a)           ', SOURCE_LINE, SEGMENT,
                            STRING132);
                      SCAN_LINE_CONTINUE := FALSE;
                      L3_LINE := TRUE;
                  END
                  ELSE IF (CLIP_CCL = CLIP_CC) AND (CLIP_CCR <> CLIP_CC) THEN
                  BEGIN
                      ST_INIT_SEG (SEGMENT);
                      STRING132.LENGTH := 0;
                      STRING132.BODY := EMPTY_STRING_FIXED;
                      DIAG (WARN, 'SCAN_LINE (4b)           ', SOURCE_LINE, SEGMENT,
                            STRING132);
                      SCAN_LINE_CONTINUE := FALSE;
                      L3_LINE := TRUE;
                  END (*IF.IF.IF*);
              END (*WITH*);
              (*****************  End of SCAN_LINE (4)  ********************)
    
              IF (L3_LINE) AND (LINE_INFO.OPTIONS) THEN
              BEGIN
                  (* SOURCE_LINE holds only options which will be      *)
                  (* scanned in a later stadium. Nothing remains to    *)
                  (* be done here.                                     *)
              END
              ELSE
              BEGIN
                  WITH RUN_INFO DO
                  BEGIN
                      START_INDEX := CLIP_LPAR.LENGTH;
                      END_INDEX :=
                      SOURCE_LINE.USED-RUN_INFO.CLIP_RPAR.LENGTH;
                  END (*WITH*);
                  L4_LINE := TRUE;
    
                  (*********************  SCAN_LINE (5)  *******************)
                  (** Examine the characters in SOURCE_LINE starting at   **)
                  (** START_INDEX until a character not equal to CLIP_CC  **)
                  (** or until END_INDEX is reached. If such a character  **)
                  (** is detected, set L4_LINE to FALSE and store its     **)
                  (** position in START_INDEX.                            **)
                  WHILE (START_INDEX < END_INDEX) AND (L4_LINE) DO
                  BEGIN
                      CH := FT_GET_CHAR (SOURCE_LINE, START_INDEX);
                      IF CH <> RUN_INFO.CLIP_CC THEN
                          L4_LINE := FALSE
                      ELSE
                          START_INDEX := START_INDEX+1;
                  END (*WHILE*);
                  (*****************  End of SCAN_LINE (5)  ****************)
    
                  IF NOT L4_LINE THEN
                  BEGIN
                      IF NOT L3_LINE THEN
                      LINE_INFO.OPTIONS := FALSE;
                      X := START_INDEX;
                      WHILE (X <= END_INDEX) AND (NOT LINE_INFO.OPTIONS) DO
                      BEGIN
                          CH := FT_GET_CHAR (SOURCE_LINE, X);
                          IF  (CH IN ALLOWED) OR
                              (CH=RUN_INFO.OPTION_MARKER) THEN
                          BEGIN
                              IF CH=RUN_INFO.OPTION_MARKER THEN
                              BEGIN
                                  LINE_INFO.OPTIONS := TRUE;
                                  SOURCE_LINE.POS_OPTION_MARKER := X;
                              END
                              ELSE
                              BEGIN
                                  (*************  SCAN_LINE (6)  ***********)
                                  (** Add CH to the Buffer String.        **)
                                  SP_ADD_BUFFER_CHAR (UC (CH));
                                  (*********  End of SCAN_LINE (6)  ********)
                              END (*IF*);
                          END (*IF*);
                          X := X+1;
                      END (*WHILE*);
                      L2_LINE := TRUE;
    
                      (*****************  SCAN_LINE (7)  *******************)
                      (** Check if the first LENGTH (CLIP_END) chars of   **)
                      (** the Bufffer String are equal to CLIP_END. If    **)
                      (** not, set L2_LINE to FALSE.                      **)
                      WITH RUN_INFO DO
                      BEGIN
                          X := 1;
                          WHILE (X <= CLIP_END.LENGTH) AND (SCAN_LINE_CONTINUE) DO
                          BEGIN
                              CH := SP_GET_BUFFER_CHAR (X);
                              IF UC (CLIP_END.BODY[X]) <> UC (CH) THEN
                                  L2_LINE := FALSE;
                              X := X+1;
                          END (*WHILE*);
                      END (*WITH*);
                      (***************  End of SCAN_LINE (7)  **************)
                  END (*IF*);
              END (*IF*);
              IF L4_LINE THEN
                  LINE_INFO.CATEGORY := L4
              ELSE IF L3_LINE THEN
                  LINE_INFO.CATEGORY := L3
              ELSE IF L2_LINE THEN
                  LINE_INFO.CATEGORY := L2
              ELSE
                  LINE_INFO.CATEGORY := L1;
          END (*IF*);
      END (*IF*);
      (*********************  End of SCAN_LINE (body)  *****************)
  END (*PROCEDURE SCAN_LINE*);


  (********************************************************************)
  (* Routine:     CONVERT_OPTION                                      *)
  (* Purpose:     Covert an abbreviated option to its full length.    *)
  (* Interface:   OPTION:     Option to be converted.                 *)
  (*              ERROR_CODE:  0 - No Problems.                       *)
  (*                           1 - No Match found.                    *)
  (*                          -1 - More then one match found.         *)
  (********************************************************************)
  PROCEDURE CONVERT_OPTION (VAR OPTION:     OPTION_KEYWORD_;
                            VAR ERROR_CODE: ERROR_CODE_);

  VAR
      K, I:           INTEGER;
      LENGTH_OPTION:  INTEGER;
      LOCATED:        BOOLEAN;
      DUMMY:          OPTION_KEYWORD_;
      NR_MATCH:       INTEGER;

  BEGIN
      DUMMY := EMPTY_OPTION;
      K := 1;
      NR_MATCH := 0;
      WHILE OPTION[K] <> ' ' DO
          K := K + 1;
      LENGTH_OPTION := K-1;
      LOCATED := FALSE;
      I := 1;
      ERROR_CODE := 1;                       (* Assume no match found. *)
      WHILE  (I <=  MAX_OPTIONS) DO
      BEGIN
          K := 1;
          LOCATED := TRUE;
          WHILE  (K <= LENGTH_OPTION) AND (LOCATED) DO
          BEGIN
              IF UC (OPTION[K]) = UC (OPTION_TABLE[I,K]) THEN
                  LOCATED :=  TRUE
              ELSE
                  LOCATED := FALSE;
              K := K + 1;
          END (*WHILE*);

          IF LOCATED THEN
          BEGIN
              IF NR_MATCH = 0 THEN
              BEGIN
                  ERROR_CODE := 0;        (* One match has been found. *)
                  DUMMY := OPTION_TABLE[I];
                  NR_MATCH := NR_MATCH + 1;
              END
              ELSE
                  ERROR_CODE := -1;       (* More then one match found *)
          END (*IF*);
          I := I + 1;
      END (*WHILE*);
      IF ERROR_CODE = 0 THEN
          OPTION := DUMMY;
  END (*CONVERT_OPTION*);


  (*********************************************************************)
  (* Routine:   SCN_OPTS_INIT - INITialize the variables of SCN_OPTS.  *)
  (* Purpose:   Initialize the global variables of SCAN_OPTIONS.       *)
  (* Interface: -                                                      *)
  (* SCN_OPTS vars: OPT_SPACE, DEFAULT_OPTIONS, OPT_CHARS,             *)
  (*                PASCAL_STRING, C_STRING.                           *)
  (*********************************************************************)
  PROCEDURE SCN_OPTS_INIT;
  BEGIN
      OPTION_TABLE [ 1]   :=  'QUICK          ';
      OPTION_TABLE [ 2]   :=  'MULTIPLE       ';
      OPTION_TABLE [ 3]   :=  'OPTIONAL       ';
      OPTION_TABLE [ 4]   :=  'FILE           ';
      OPTION_TABLE [ 5]   :=  'INDENT         ';
      OPTION_TABLE [ 6]   :=  'COMMENT        ';
      OPTION_TABLE [ 7]   :=  'OVERRULE       ';
      OPTION_TABLE [ 8]   :=  'LEADER         ';
      OPTION_TABLE [ 9]   :=  'TRAILER        ';
      OPTION_TABLE [10]   :=  'SEPARATOR      ';
      OPTION_TABLE [11]   :=  'DEFAULT        ';
      OPTION_TABLE [12]   :=  'LINENUMBER     ';

      OPT_CHARS := ['A'..'Z', 'a'..'z', '0'..'9', '"'];

      WITH DEFAULT_OPTIONS DO
      BEGIN
          QUICK           :=  FALSE;
          MULTIPLE        :=  FALSE;
          OPTIONAL        :=  FALSE;
          OVERRULE        :=  FALSE;
          LEADER          :=  FALSE;
          DEFAULT         :=  FALSE;
          TRAILER         :=  FALSE;
          SEPARATOR       :=  FALSE;
          LINENUMBER      :=  FALSE;
          SP_INIT_STR (FILE_NAME);
          SP_INIT_STR (INDENT);
          SP_INIT_STR (COMMENT);
      END;

      PASCAL_STRING := EMPTY_STRING_FIXED;
      PASCAL_STRING[1] := 'P';
      PASCAL_STRING[2] := 'A';
      PASCAL_STRING[3] := 'S';
      PASCAL_STRING[4] := 'C';
      PASCAL_STRING[5] := 'A';
      PASCAL_STRING[6] := 'L';

      FORTRAN_STRING := EMPTY_STRING_FIXED;
      FORTRAN_STRING[1] := 'F';
      FORTRAN_STRING[2] := 'O';
      FORTRAN_STRING[3] := 'R';
      FORTRAN_STRING[4] := 'T';
      FORTRAN_STRING[5] := 'R';
      FORTRAN_STRING[6] := 'A';
      FORTRAN_STRING[7] := 'N';

      C_STRING := EMPTY_STRING_FIXED;
      C_STRING[1] := 'C';

  END;


  (*********************************************************************)
  (* Routine:     SCAN_OPTIONS - SCAN OPTIONS                          *)
  (* Purpose:     To scan and store the options that are specified by  *)
  (*              a stub or slot segment.                              *)
  (* Interface:   SEGMENT_OPTIONS -   The structure with options.      *)
  (*              SEGMENT         -   The segment to be scanned.       *)
  (*              RUN_INFO        -   The information for this run.    *)
  (*              SEGMENT_TYPE    -   Type of segment to be scanned.   *)
  (*********************************************************************)
  PROCEDURE SCAN_OPTIONS (VAR SEGMENT_OPTIONS: OPTIONS_;
                              SEGMENT:         SEGMENT_DES_;
                              RUN_INFO:        RUN_INFO_;
                              SEGMENT_TYPE:    SEGMENT_TYPE_);

  VAR
      OPTION_KEYWORD:     OPTION_KEYWORD_;
      LINE:                LINE_DES_;
      SEGMENT_EXHAUSTED:   BOOLEAN;
      INDEX:          INTEGER;
      CH:             CHAR;
      LENGTH_LINE:    INTEGER;
      OK:  BOOLEAN;
      STRING132:      STRING132_;
      I:              INTEGER;
      ERROR_CODE:     ERROR_CODE_;
      DUMMY_LINE:     LINE_DES_;
      AUX_STRING10:   PACKED ARRAY[1..10] OF CHAR;

  BEGIN
      (*******                SCAN_OPTIONS (body)                *******)

      (*************************  SCAN_OPTIONS (1)  ********************)
      (** Initialize OPTION_KEYWORD. Make SEGMENT_OPTIONS equal to    **)
      (** DEFAULT_OPTIONS and set SEGMENT_EXHAUSTED to FALSE.         **)
      OPTION_KEYWORD     :=  EMPTY_OPTION;
      SEGMENT_OPTIONS    :=  DEFAULT_OPTIONS;
      SEGMENT_EXHAUSTED  :=  FALSE;
      (*********************  End of SCAN_OPTIONS (1)  *****************)

      IF NOT ST_IS_EMPTY_SEG (SEGMENT) THEN
      BEGIN
          (*********************  SCAN_OPTIONS (2)  ********************)
          (** Retrieve first line from SEGMENT which holds an option  **)
          (** marker and store it in LINE. Set SEGMENT_EXHAUSTED to   **)
          (** TRUE if no such LINE could be found.                    **)
          ST_GET_OPTION_LINE (SEGMENT, LINE);
          IF LINE.ID =0 THEN
              SEGMENT_EXHAUSTED := TRUE;
          (*****************  End of SCAN_OPTIONS (2)  *****************)

          WHILE NOT SEGMENT_EXHAUSTED DO
          BEGIN
              (*********************  SCAN_OPTIONS (3)  ****************)
              (** Scan LINE for options with their arguments and put  **)
              (** the result in SEGMENT_OPTIONS. Generate diagnostic  **)
              (** message using SEGMENT in case of trouble.           **)
              INDEX := FT_GET_POS_OPTION_MARKER (LINE);
              IF INDEX = 0 THEN
                  INDEX := RUN_INFO.CLIP_LPAR.LENGTH + 1;
              LENGTH_LINE := FT_GET_LINE_LENGTH (LINE) - RUN_INFO.CLIP_RPAR.LENGTH;
              CH := FT_GET_CHAR (LINE, INDEX);
              WHILE INDEX < LENGTH_LINE DO
              BEGIN
                  WHILE (CH <> RUN_INFO.OPTION_MARKER) AND
                                (NOT  (CH IN OPT_CHARS)) AND
                                (INDEX < LENGTH_LINE)  DO
                  BEGIN
                      INDEX := INDEX + 1;
                      CH := FT_GET_CHAR (LINE, INDEX);
                  END (*WHILE*);
            
                  IF CH = RUN_INFO.OPTION_MARKER THEN
                  BEGIN
                      (*********************  SCAN_OPTIONS (3.1)  ******************)
                      (** Start of a new option in LINE. Check by an empty        **)
                      (** OPTION_KEYWORD if previous option is "closed" correctly **)
                      (** and issue a diagnostic if not. Read the characters      **)
                      (** following OPTION_MARKER until the next OPT_SPACE and    **)
                      (** store them in OPTION_KEYWORD. Read a possible argument  **)
                      (** and update SEGMENT_OPTIONS. Initialize OPTION_KEYWORD   **)
                      (** if all went well.                                       **)
                      IF OPTION_KEYWORD <> EMPTY_OPTION THEN
                      BEGIN
                          (*********************  SCAN_OPTIONS (3.1.1)  ********************)
                          (** Missing argument of option stored in OPTION_KEYWORD.        **)
                          (** Generate a diagnostic using OPTION_KEYWORD and SEGMENT.     **)
                          STRING132.LENGTH := 0;
                          STRING132.BODY := EMPTY_STRING_FIXED;
                          FOR I := 1 TO MAX_OPTION_LENGTH DO
                          BEGIN
                              IF OPTION_KEYWORD[I] <> ' ' THEN
                              BEGIN
                                  STRING132.BODY[I] := OPTION_KEYWORD[I];
                                  STRING132.LENGTH :=  STRING132.LENGTH + 1;
                              END (*IF*);
                          END (*FOR*);
                          DIAG (ERR, 'SCAN_OPTIONS (3.1.1)     ', DUMMY_LINE, SEGMENT, STRING132);
                          OPTION_KEYWORD := EMPTY_OPTION;
                          (*****************  End of SCAN_OPTIONS (3.1.1)  *****************)
                      END (*IF*);
                      OK := FALSE;
                    
                      (*********************  SCAN_OPTIONS (3.1.2)  ************************)
                      (** Store all characters following this OPTION_MARKER in OPTION_-   **)
                      (** KEYWORD until the first character that is not a member of       **)
                      (** OPT_CHARS. Try to located the option in OPTION_TABLE and make   **)
                      (** OK equal to TRUE if a match is found and store the full option  **)
                      (** in OPTION_KEYWORD. In case no match can be found generate a     **)
                      (** diagnostic message and jump to the next option marker.          **)
                      INDEX := INDEX + 1;
                      CH := FT_GET_CHAR (LINE, INDEX);
                      WHILE NOT (CH IN OPT_CHARS)            AND
                            (CH <> RUN_INFO.OPTION_MARKER) AND
                              (INDEX < LENGTH_LINE)        DO
                      BEGIN
                          INDEX := INDEX + 1;
                          CH := FT_GET_CHAR (LINE, INDEX);
                      END (*WHILE*);
                      I := 1;
                      WHILE CH IN OPT_CHARS DO
                      BEGIN
                          OPTION_KEYWORD [I] := CH;
                          I := I + 1;
                          INDEX := INDEX + 1;
                          CH := FT_GET_CHAR (LINE, INDEX);
                      END (*WHILE*);
                      CONVERT_OPTION (OPTION_KEYWORD, ERROR_CODE);
                      IF ERROR_CODE <> 0 THEN
                      BEGIN
                          STRING132.LENGTH := 0;
                          STRING132.BODY := EMPTY_STRING_FIXED;
                          FOR I := 1 TO MAX_OPTION_LENGTH DO
                          BEGIN
                              IF OPTION_KEYWORD[I] <> ' ' THEN
                              BEGIN
                                  STRING132.BODY[I] := OPTION_KEYWORD[I];
                                  STRING132.LENGTH :=  STRING132.LENGTH + 1;
                              END (*IF*);
                          END (*FOR*);
                          IF ERROR_CODE = -1 THEN
                          BEGIN
                              (* More then one match found in table.                       *)
                              DIAG (ERR, 'SCAN_OPTIONS (3.1.2)a    ',
                                         DUMMY_LINE, SEGMENT, STRING132);
                              OPTION_KEYWORD := EMPTY_OPTION;
                          END
                          ELSE IF ERROR_CODE = 1 THEN
                          BEGIN
                              (* No match found in the table.                              *)
                              DIAG (ERR, 'SCAN_OPTIONS (3.1.2)b    ',
                                         DUMMY_LINE, SEGMENT, STRING132);
                              OPTION_KEYWORD := EMPTY_OPTION;
                          END (*IF.IF*);
                    
                          (* Jump to the next OPTION_MARKER in LINE.                       *)
                          WHILE (CH <> RUN_INFO.OPTION_MARKER) AND
                                (INDEX<LENGTH_LINE)            DO
                          BEGIN
                              INDEX := INDEX + 1;
                              CH := FT_GET_CHAR (LINE, INDEX);
                          END (*WHILE*);
                      END
                      ELSE
                          OK := TRUE;
                      (*********************  End of SCAN_OPTIONS (3.1.2)  *****************)
                    
                      IF OK THEN
                      BEGIN
                          IF OPTION_KEYWORD = OPTION_TABLE[1] THEN
                          BEGIN
                              SEGMENT_OPTIONS.QUICK := TRUE;
                              OPTION_KEYWORD := EMPTY_OPTION;
                          END
                          ELSE IF OPTION_KEYWORD = OPTION_TABLE[2] THEN
                          BEGIN
                              SEGMENT_OPTIONS.MULTIPLE := TRUE;
                              OPTION_KEYWORD := EMPTY_OPTION;
                          END
                          ELSE IF OPTION_KEYWORD = OPTION_TABLE[3] THEN
                          BEGIN
                              SEGMENT_OPTIONS.OPTIONAL := TRUE;
                              OPTION_KEYWORD := EMPTY_OPTION;
                          END
                          ELSE IF OPTION_KEYWORD = OPTION_TABLE[4] THEN
                          BEGIN
                              (*****************  SCAN_OPTIONS (3.1.3)  ********************)
                              (** Add all characters from INDEX until the next member of  **)
                              (** OPT_SPACE to the string SEGMENT_OPTIONS.FILE_NAME.      **)
                              (** Generate a diagnostic message in case of trouble.       **)
                              WHILE  (NOT (CH IN OPT_CHARS)) AND
                                     (CH <> '"')           AND
                                     (INDEX<LENGTH_LINE)   DO
                              BEGIN
                                  INDEX := INDEX + 1;
                                  CH := FT_GET_CHAR (LINE, INDEX);
                              END (*WHILE*);
                              IF CH = '"' THEN
                              BEGIN
                                  INDEX := INDEX + 1;
                                  CH := FT_GET_CHAR (LINE, INDEX);
                                  WHILE  (CH <> '"') AND (INDEX < LENGTH_LINE) DO
                                  BEGIN
                              (*      SP_ADD_CHAR (UC (CH), SEGMENT_OPTIONS.FILE_NAME);  14/10/93) *)
                                      SP_ADD_CHAR (CH, SEGMENT_OPTIONS.FILE_NAME);
                                      INDEX := INDEX + 1;
                                      CH := FT_GET_CHAR (LINE, INDEX);
                                  END (*WHILE*);
                                  IF CH = '"' THEN
                                  BEGIN
                                      INDEX := INDEX + 1;
                                      CH := FT_GET_CHAR (LINE, INDEX);
                                  END
                                  ELSE
                                  BEGIN
                                      SP_EXTR_STR (SEGMENT_OPTIONS.FILE_NAME, STRING132);
                                      DIAG (ERR, 'SCAN_OPTIONS (3.1.3)a    ',
                                                 DUMMY_LINE, SEGMENT, STRING132);
                                      SP_INIT_STR (SEGMENT_OPTIONS.FILE_NAME);
                                      OPTION_KEYWORD := EMPTY_OPTION;
                                  END (*IF*);
                              END
                              ELSE IF (CH IN OPT_CHARS) THEN
                              BEGIN
                                  SP_EXTR_STR (SEGMENT_OPTIONS.FILE_NAME, STRING132);
                                  DIAG (ERR, 'SCAN_OPTIONS (3.1.3)b    ',
                                             DUMMY_LINE, SEGMENT, STRING132);
                                  SP_INIT_STR (SEGMENT_OPTIONS.FILE_NAME);
                                  OPTION_KEYWORD := EMPTY_OPTION;
                            
                                  (* Jump to the next option marker.                       *)
                                  WHILE  (CH <> RUN_INFO.OPTION_MARKER) AND
                                         (INDEX<LENGTH_LINE)            DO
                                  BEGIN
                                      INDEX := INDEX + 1;
                                      CH := FT_GET_CHAR (LINE, INDEX);
                                  END (*WHILE*);
                              END
                              ELSE IF INDEX = LENGTH_LINE THEN
                              BEGIN
                                  (* The file specification must be on the next line.      *)
                                  (* Nothing remains to be done here.                      *)
                              END (* IF.IF.IF*);
                              (*****************  End of SCAN_OPTIONS (3.1.3)  *************)
                    
                              IF NOT SP_IS_EMPTY_STR (SEGMENT_OPTIONS.FILE_NAME) THEN
                                  OPTION_KEYWORD := EMPTY_OPTION;
                          END
                          ELSE IF OPTION_KEYWORD = OPTION_TABLE[5] THEN
                          BEGIN
                              (*****************  SCAN_OPTIONS (3.1.4)  ********************)
                              (** Add all characters from INDEX until the next member of  **)
                              (** OPT_SPACE to the string SEGMENT_OPTIONS.INDENT. Give an **)
                              (** error and initialize SEGMENT_OPTIONS.INDENT and         **)
                              (** OPTION_KEYWORD and in case of trouble.                  **)
                              WHILE  (NOT  (CH IN OPT_CHARS)) AND
                                     (INDEX < LENGTH_LINE)  AND
                                     (CH <> RUN_INFO.OPTION_MARKER) DO
                              BEGIN
                                  INDEX := INDEX + 1;
                                  CH := FT_GET_CHAR (LINE, INDEX);
                              END (*WHILE*);
                              WHILE (CH IN OPT_CHARS) AND (INDEX < LENGTH_LINE) DO
                              BEGIN
                                  SP_ADD_CHAR (UC (CH), SEGMENT_OPTIONS.INDENT);
                                  INDEX := INDEX + 1;
                                  CH := FT_GET_CHAR (LINE, INDEX);
                              END (*WHILE*);
                              IF NOT SP_IS_EMPTY_STR (SEGMENT_OPTIONS.INDENT) THEN
                              BEGIN
                                  SP_EXTR_STR (SEGMENT_OPTIONS.INDENT, STRING132);
                                  IF  ((STRING132.BODY[1] <> 'O') OR
                                       (STRING132.BODY[2] <> 'N'))    AND
                                      ((STRING132.BODY[1] <> 'O') OR
                                       (STRING132.BODY[2] <> 'F') OR
                                       (STRING132.BODY[3] <> 'F'))    THEN
                                  BEGIN
                                      SP_INIT_STR (SEGMENT_OPTIONS.INDENT);
                                      OPTION_KEYWORD := EMPTY_OPTION;
                                      DIAG (ERR, 'SCAN_OPTIONS (3.1.4)     ',
                                                 DUMMY_LINE, SEGMENT, STRING132);
                                  END (*IF*);
                              END
                              ELSE
                              BEGIN
                                  (* The argument of the INDENT-option must be on the next *)
                                  (* line. Nothing remains to be done here.                *)
                              END (*IF*);
                              (*************  End of SCAN_OPTIONS (3.1.4)  *****************)
                    
                              IF NOT SP_IS_EMPTY_STR (SEGMENT_OPTIONS.INDENT) THEN
                                  OPTION_KEYWORD := EMPTY_OPTION;
                          END
                          ELSE IF OPTION_KEYWORD = OPTION_TABLE[6] THEN
                          BEGIN
                              (*****************  SCAN_OPTIONS (3.1.5)  ********************)
                              (** Add all characters from INDEX until the next member of  **)
                              (** OPT_SPACE to SEGMENT_OPTIONS.COMMENT. Issue diagnostic  **)
                              (** and initialize OPTION_KEYWORD and SEGMENT_OPTIONS.-     **)
                              (** COMMENT in case of trouble.                             **)
                              WHILE  (NOT  (CH IN OPT_CHARS)) AND
                                     (INDEX < LENGTH_LINE)  AND
                                     (CH <> RUN_INFO.OPTION_MARKER) DO
                              BEGIN
                                  INDEX := INDEX + 1;
                                  CH := FT_GET_CHAR (LINE, INDEX);
                              END (*WHILE*);
                              WHILE (CH IN OPT_CHARS) AND (INDEX < LENGTH_LINE) DO
                              BEGIN
                                  SP_ADD_CHAR (UC (CH), SEGMENT_OPTIONS.COMMENT);
                                  INDEX := INDEX + 1;
                                  CH := FT_GET_CHAR (LINE, INDEX);
                              END (*WHILE*);
                              IF NOT SP_IS_EMPTY_STR (SEGMENT_OPTIONS.COMMENT) THEN
                              BEGIN
                                  SP_EXTR_STR (SEGMENT_OPTIONS.COMMENT, STRING132);
                                  IF  (STRING132.BODY = PASCAL_STRING)  OR
                                      (STRING132.BODY = FORTRAN_STRING) OR
                                      (STRING132.BODY = C_STRING) THEN
                                  BEGIN
                                       DIAG (WARN, 'SCAN_OPTIONS (3.1.5)a    ',
                                                   DUMMY_LINE, SEGMENT, STRING132);
                                       SP_INIT_STR (SEGMENT_OPTIONS.COMMENT);
                                       OPTION_KEYWORD := EMPTY_OPTION;
                                  END
                                  ELSE IF ((STRING132.BODY[1] <> 'O') OR
                                           (STRING132.BODY[2] <> 'N'))    AND
                                          ((STRING132.BODY[1] <> 'O') OR
                                           (STRING132.BODY[2] <> 'F') OR
                                           (STRING132.BODY[3] <> 'F'))    THEN
                                  BEGIN
                                      DIAG (ERR, 'SCAN_OPTIONS (3.1.5)b    ',
                                                 DUMMY_LINE, SEGMENT, STRING132);
                                      SP_INIT_STR (SEGMENT_OPTIONS.COMMENT);
                                      OPTION_KEYWORD := EMPTY_OPTION;
                                  END (*IF.IF*);
                              END
                              ELSE
                              BEGIN
                                  (* The argument of the option COMMENT must be on the     *)
                                  (* next line. Nothing remains to be done here            *)
                              END (*IF*);
                              (*************  End of SCAN_OPTIONS (3.1.5)  *****************)
                    
                              IF NOT SP_IS_EMPTY_STR (SEGMENT_OPTIONS.COMMENT) THEN
                                  OPTION_KEYWORD := EMPTY_OPTION;
                          END
                          ELSE IF OPTION_KEYWORD = OPTION_TABLE[7] THEN
                          BEGIN
                              SEGMENT_OPTIONS.OVERRULE := TRUE;
                              OPTION_KEYWORD := EMPTY_OPTION;
                          END
                          ELSE IF OPTION_KEYWORD = OPTION_TABLE[8] THEN
                          BEGIN
                              SEGMENT_OPTIONS.LEADER := TRUE;
                              OPTION_KEYWORD := EMPTY_OPTION;
                          END
                          ELSE IF OPTION_KEYWORD = OPTION_TABLE[9] THEN
                          BEGIN
                              SEGMENT_OPTIONS.TRAILER := TRUE;
                              OPTION_KEYWORD := EMPTY_OPTION;
                          END
                          ELSE IF OPTION_KEYWORD = OPTION_TABLE[10] THEN
                          BEGIN
                              SEGMENT_OPTIONS.SEPARATOR := TRUE;
                              OPTION_KEYWORD := EMPTY_OPTION;
                          END
                          ELSE IF OPTION_KEYWORD = OPTION_TABLE[11] THEN
                          BEGIN
                              SEGMENT_OPTIONS.DEFAULT := TRUE;
                              OPTION_KEYWORD := EMPTY_OPTION;
                          END
                          ELSE IF OPTION_KEYWORD = OPTION_TABLE[12] THEN
                          BEGIN
                              SEGMENT_OPTIONS.LINENUMBER := TRUE;
                              OPTION_KEYWORD := EMPTY_OPTION;
                          END (*IF.IF.IF.IF.IF.IF.IF.IF.IF.IF.IF.IF*);
                      END (*IF*);
                      (*****************  End of SCAN_OPTIONS (3.1)  ***************)
                  END
                  ELSE IF CH IN OPT_CHARS THEN
                  BEGIN
                      (*********************  SCAN_OPTIONS (3.2)  ******************)
                      (** CH is only legal at this point as the first character   **)
                      (** of the argument of the previous option, i.e.            **)
                      (** OPTION_KEYWORD must not be empty. Read this argument.   **)
                      (** When problems arise, jump to next OPTION_MARKER and     **)
                      (** issue a diagnostic message.                             **)
                      IF OPTION_KEYWORD <> EMPTY_OPTION THEN
                      BEGIN
                          IF OPTION_KEYWORD = OPTION_TABLE[4] THEN
                          BEGIN
                              (*****************  SCAN_OPTIONS (3.2.1)  ********************)
                              (** Add characters from INDEX to SEGMENT_OPTIONS.FILE_NAME  **)
                              (** until the next OPT_SPACE is met. Diagnostic in case of  **)
                              (** trouble.                                                **)
                              WHILE  (NOT (CH IN OPT_CHARS)) AND
                                     (CH <> '"')           AND
                                     (INDEX < LENGTH_LINE) DO
                              BEGIN
                                  INDEX := INDEX + 1;
                                  CH := FT_GET_CHAR (LINE, INDEX);
                              END (*WHILE*);
                              IF CH = '"' THEN
                              BEGIN
                                  INDEX := INDEX + 1;
                                  CH := FT_GET_CHAR (LINE, INDEX);
                                  WHILE (CH <> '"') AND (INDEX <= LENGTH_LINE) DO
                                  BEGIN
                              (*      SP_ADD_CHAR (UC (CH), SEGMENT_OPTIONS.FILE_NAME);   14/10/93 *)
                                      SP_ADD_CHAR (CH, SEGMENT_OPTIONS.FILE_NAME);
                                      INDEX := INDEX + 1;
                                      CH := FT_GET_CHAR (LINE, INDEX);
                                  END (*WHILE*);
                                  IF CH='"' THEN
                                  BEGIN
                                      INDEX := INDEX + 1;
                                      CH := FT_GET_CHAR (LINE, INDEX);
                                  END
                                  ELSE
                                  BEGIN
                                      SP_EXTR_STR (SEGMENT_OPTIONS.FILE_NAME, STRING132);
                                      DIAG (ERR, 'SCAN_OPTIONS (3.2.1)a    ',
                                                 DUMMY_LINE, SEGMENT, STRING132);
                                      SP_INIT_STR (SEGMENT_OPTIONS.FILE_NAME);
                                      OPTION_KEYWORD := EMPTY_OPTION;
                                  END (*IF*);
                              END
                              ELSE IF (CH IN OPT_CHARS) THEN
                              BEGIN
                                  SP_EXTR_STR (SEGMENT_OPTIONS.FILE_NAME, STRING132);
                                  DIAG (ERR, 'SCAN_OPTIONS (3.2.1)b    ',
                                             DUMMY_LINE, SEGMENT, STRING132);
                                  SP_INIT_STR (SEGMENT_OPTIONS.FILE_NAME);
                                  OPTION_KEYWORD := EMPTY_OPTION;
                            
                                  (* Jump to the next option marker.                       *)
                                  WHILE (CH <> RUN_INFO.OPTION_MARKER) AND
                                        (INDEX<LENGTH_LINE)            DO
                                  BEGIN
                                      INDEX := INDEX + 1;
                                      CH := FT_GET_CHAR (LINE, INDEX);
                                  END (*WHILE*);
                              END
                              ELSE IF INDEX=LENGTH_LINE THEN
                              BEGIN
                                  (* The file specification must be on the next line.      *)
                                  (* Nothing remains to be done here.                      *)
                              END (*IF.IF.IF*);
                              (*************  End of SCAN_OPTIONS (3.2.1)  *****************)
                    
                              IF NOT SP_IS_EMPTY_STR (SEGMENT_OPTIONS.FILE_NAME) THEN
                                  OPTION_KEYWORD := EMPTY_OPTION;
                          END
                          ELSE IF OPTION_KEYWORD=OPTION_TABLE[5] THEN
                          BEGIN
                              (*****************  SCAN_OPTIONS (3.2.2)  ********************)
                              (** Add characters from INDEX to SEGMENT_OPTIONS.INDENT     **)
                              (** until the next OPT_SPACE is met. Generate a diagnostic  **)
                              (** message and reset OPTION_KEYWORD and SEGMENT_OPTIONS.-  **)
                              (** INDENT in case of trouble.                              **)
                              WHILE (NOT (CH IN OPT_CHARS)) AND
                                    (INDEX < LENGTH_LINE) DO
                              BEGIN
                                  INDEX := INDEX + 1;
                                  CH := FT_GET_CHAR (LINE, INDEX);
                              END (*WHILE*);
                              WHILE (CH IN OPT_CHARS)     AND
                                    (INDEX<LENGTH_LINE) DO
                              BEGIN
                                  SP_ADD_CHAR (UC (CH), SEGMENT_OPTIONS.INDENT);
                                  INDEX := INDEX + 1;
                                  CH := FT_GET_CHAR (LINE, INDEX);
                              END (*WHILE*);
                              IF NOT SP_IS_EMPTY_STR (SEGMENT_OPTIONS.INDENT) THEN
                              BEGIN
                                  SP_EXTR_STR (SEGMENT_OPTIONS.INDENT, STRING132);
                                  IF  ((STRING132.BODY[1] <> 'O') OR
                                       (STRING132.BODY[2] <> 'N'))    AND
                                      ((STRING132.BODY[1] <> 'O') OR
                                       (STRING132.BODY[2] <> 'F') OR
                                       (STRING132.BODY[3] <> 'F'))    THEN
                                  BEGIN
                                      SP_INIT_STR (SEGMENT_OPTIONS.INDENT);
                                      OPTION_KEYWORD := EMPTY_OPTION;
                                      DIAG (ERR, 'SCAN_OPTIONS (3.2.2)     ',
                                                 DUMMY_LINE, SEGMENT, STRING132);
                                  END (*IF*);
                              END
                              ELSE
                              BEGIN
                                  (* The argument of the option INDENT must be on the next *)
                                  (* line. Nothing remains to be done here                 *)
                              END (*IF*);
                              (*************  End of SCAN_OPTIONS (3.2.2)  *****************)
                    
                              IF NOT SP_IS_EMPTY_STR (SEGMENT_OPTIONS.INDENT) THEN
                                  OPTION_KEYWORD := EMPTY_OPTION;
                          END
                          ELSE IF OPTION_KEYWORD=OPTION_TABLE[6] THEN
                          BEGIN
                              (*****************  SCAN_OPTIONS (3.2.3)  ********************)
                              (** Add characters from INDEX to SEGMENT_OPTIONS.COMMENT    **)
                              (** until the next OPT_SPACE is met. Generate a diagnostic  **)
                              (** message and reset OPTION_KEYWORD and SEGMENT_OPTIONS.-  **)
                              (** COMMENT in case of trouble.                             **)
                              WHILE (NOT (CH IN OPT_CHARS)) AND
                                    (INDEX<LENGTH_LINE)   DO
                              BEGIN
                                  INDEX := INDEX + 1;
                                  CH := FT_GET_CHAR (LINE, INDEX);
                              END (*WHILE*);
                              WHILE (CH IN OPT_CHARS)     AND
                                    (INDEX<LENGTH_LINE) DO
                              BEGIN
                                  SP_ADD_CHAR (UC (CH), SEGMENT_OPTIONS.COMMENT);
                                  INDEX := INDEX + 1;
                                  CH := FT_GET_CHAR (LINE, INDEX);
                              END (*WHILE*);
                              IF NOT SP_IS_EMPTY_STR (SEGMENT_OPTIONS.COMMENT) THEN
                              BEGIN
                                  SP_EXTR_STR (SEGMENT_OPTIONS.COMMENT, STRING132);
                                  IF (STRING132.BODY = PASCAL_STRING) OR
                                     (STRING132.BODY = FORTRAN_STRING) OR
                                     (STRING132.BODY = C_STRING) THEN
                                  BEGIN
                                       DIAG (WARN, 'SCAN_OPTIONS (3.2.3)a    ',
                                                   DUMMY_LINE, SEGMENT, STRING132);
                                       SP_INIT_STR (SEGMENT_OPTIONS.COMMENT);
                                       OPTION_KEYWORD := EMPTY_OPTION;
                                  END
                                  ELSE IF ((STRING132.BODY[1] <> 'O') OR
                                           (STRING132.BODY[2] <> 'N'))    AND
                                          ((STRING132.BODY[1] <> 'O') OR
                                           (STRING132.BODY[2] <> 'F') OR
                                           (STRING132.BODY[3] <> 'F'))    THEN
                                  BEGIN
                                      DIAG (ERR, 'SCAN_OPTIONS (3.2.3)b    ',
                                                 DUMMY_LINE, SEGMENT, STRING132);
                                      SP_INIT_STR (SEGMENT_OPTIONS.COMMENT);
                                      OPTION_KEYWORD := EMPTY_OPTION;
                                  END (*IF.IF*);
                              END
                              ELSE
                              BEGIN
                                  (* The argument of the option COMMENT must be on the     *)
                                  (* next line. Nothing remains to be done here            *)
                              END (*IF*);
                              (*************  End of SCAN_OPTIONS (3.2.3)  *****************)
                              IF NOT SP_IS_EMPTY_STR (SEGMENT_OPTIONS.COMMENT) THEN
                                  OPTION_KEYWORD := EMPTY_OPTION;
                          END (*IF.IF.IF*);
                      END
                      ELSE
                      BEGIN
                          (*********************  SCAN_OPTIONS (3.2.4)  ********************)
                          (** Character is illegal at this position. Skip to next         **)
                          (** OPTION_MARKER or to end of this line. Generate a diagnostic **)
                          (** message using SEGMENT and LINE.                             **)
                          STRING132.LENGTH := 1;
                          STRING132.BODY[1] := CH;
                          DIAG (ERR, 'SCAN_OPTIONS (3.2.4)     ', DUMMY_LINE, SEGMENT, STRING132);
                          OPTION_KEYWORD := EMPTY_OPTION;
                          WHILE  (CH <> RUN_INFO.OPTION_MARKER) AND
                                 (INDEX < LENGTH_LINE)          DO
                          BEGIN
                              INDEX := INDEX + 1;
                              CH := FT_GET_CHAR (LINE, INDEX);
                          END (*WHILE*);
                          (*****************  End of SCAN_OPTIONS (3.2.4)  *****************)
                      END (*IF*);
                      (*****************  End of SCAN_OPTIONS (3.2)  ***************)
                  END (*IF*);
              END (*WHILE*);
              (*****************  End of SCAN_OPTIONS (3)  *************)

              (*****************  SCAN_OPTIONS (4)  ********************)
              (** Retrieve next LINE from SEGMENT. SEGMENT_EXHAUSTED  **)
              (** becomes TRUE if the segment is exhausted.           **)
              ST_GET_LINE (LINE);
              IF LINE.ID = 0 THEN
                  SEGMENT_EXHAUSTED := TRUE;
              (*************  End of SCAN_OPTIONS (4)  *****************)
          END (*WHILE*);
          IF SEGMENT_EXHAUSTED THEN
          BEGIN
              (*****************  SCAN_OPTIONS (5)  ********************)
              (** Check SEGMENT_OPTIONS for any errors. and generate  **)
              (** diagnostic message using SEGMENT if appropriate.    **)
              FT_INIT_LINE (DUMMY_LINE);
            
              (* 1. Check for a missing argument of the last option.   *)
              (*    This can be detected by a non-empty OPTION_KEYWORD.*)
              IF OPTION_KEYWORD <> EMPTY_OPTION THEN
              BEGIN
                  STRING132.LENGTH := 0;
                  STRING132.BODY := EMPTY_STRING_FIXED;
                  FOR I := 1 TO MAX_OPTION_LENGTH DO
                  BEGIN
                      IF OPTION_KEYWORD[I] <> ' ' THEN
                      BEGIN
                          STRING132.BODY[I] := OPTION_KEYWORD[I];
                          STRING132.LENGTH :=  STRING132.LENGTH + 1;
                      END (*IF*);
                  END (*FOR*);
                  DIAG (ERR, 'SCAN_OPTIONS (5a)        ', DUMMY_LINE, SEGMENT, STRING132);
              END (*IF*);
            
              (* 2. Check the use of stub options in a slot SEGMENT.   *)
              IF (SEGMENT_TYPE = SLOT) OR (SEGMENT_TYPE = CODE) THEN
              BEGIN
                  IF SEGMENT_OPTIONS.QUICK THEN
                  BEGIN
                      SEGMENT_OPTIONS.QUICK := FALSE;
                      STRING132.BODY[1] := 'Q';
                      STRING132.BODY[2] := 'U';
                      STRING132.BODY[3] := 'I';
                      STRING132.BODY[4] := 'C';
                      STRING132.BODY[5] := 'K';
                      STRING132.LENGTH := 5;
                      DIAG (ERR, 'SCAN_OPTIONS (5b)        ', DUMMY_LINE, SEGMENT,
                            STRING132);
                  END (*IF*);
                  IF NOT  (SP_IS_EMPTY_STR (SEGMENT_OPTIONS.FILE_NAME)) THEN
                  BEGIN
                      SP_INIT_STR (SEGMENT_OPTIONS.FILE_NAME);
                      STRING132.BODY[1] := 'F';
                      STRING132.BODY[2] := 'I';
                      STRING132.BODY[3] := 'L';
                      STRING132.BODY[4] := 'E';
                      STRING132.LENGTH := 4;
                      DIAG (ERR, 'SCAN_OPTIONS (5b)        ', DUMMY_LINE, SEGMENT,
                            STRING132);
                  END (*IF*);
                  IF SEGMENT_OPTIONS.OVERRULE THEN
                  BEGIN
                      SEGMENT_OPTIONS.OVERRULE := FALSE;
                      AUX_STRING10 := 'OVERRULE  ';
                      FOR I:= 1 TO 8 DO
                          STRING132.BODY[I] := AUX_STRING10[I];
                      STRING132.LENGTH := 8;
                      DIAG (ERR, 'SCAN_OPTIONS (5b)        ', DUMMY_LINE, SEGMENT,
                            STRING132);
                  END (*IF*);
                  IF SEGMENT_OPTIONS.LEADER THEN
                  BEGIN
                      SEGMENT_OPTIONS.LEADER := FALSE;
                      AUX_STRING10 := 'LEADER    ';
                      FOR I := 1 TO 6 DO
                      STRING132.BODY[I] := AUX_STRING10[I];
                      STRING132.LENGTH := 6;
                      DIAG (ERR, 'SCAN_OPTIONS (5b)        ', DUMMY_LINE, SEGMENT,
                            STRING132);
                  END (*IF*);
                  IF SEGMENT_OPTIONS.TRAILER THEN
                  BEGIN
                      SEGMENT_OPTIONS.TRAILER := FALSE;
                      AUX_STRING10 := 'TRAILER   ';
                      FOR I:= 1 TO 7 DO
                          STRING132.BODY[I] := AUX_STRING10[I];
                      STRING132.LENGTH := 7;
                      DIAG (ERR, 'SCAN_OPTIONS (5b)        ', DUMMY_LINE, SEGMENT,
                            STRING132);
                  END (*IF*);
                  IF SEGMENT_OPTIONS.SEPARATOR THEN
                  BEGIN
                      SEGMENT_OPTIONS.SEPARATOR := FALSE;
                      AUX_STRING10 := 'SEPARATOR ';
                      FOR I := 1 TO 9 DO
                          STRING132.BODY[I] := AUX_STRING10[I];
                      STRING132.LENGTH := 9;
                      DIAG (ERR, 'SCAN_OPTIONS (5b)        ', DUMMY_LINE, SEGMENT,
                            STRING132);
                  END (*IF*);
                  IF SEGMENT_OPTIONS.DEFAULT THEN
                  BEGIN
                      SEGMENT_OPTIONS.QUICK := FALSE;
                      AUX_STRING10 := 'DEFAULT   ';
                      FOR I := 1 TO 7 DO
                          STRING132.BODY[I] := AUX_STRING10[I];
                      STRING132.LENGTH := 7;
                      DIAG (ERR, 'SCAN_OPTIONS (5b)        ', DUMMY_LINE, SEGMENT,
                            STRING132);
                  END (*IF*);
              END
            
              (* 3. Check the use of slot options in a stub segment.   *)
              ELSE IF SEGMENT_TYPE = STUB THEN
              BEGIN
                  IF SEGMENT_OPTIONS.MULTIPLE THEN
                  BEGIN
                      SEGMENT_OPTIONS.MULTIPLE := FALSE;
                      AUX_STRING10 := 'MULTIPLE  ';
                      FOR I := 1 TO 8 DO
                          STRING132.BODY[I] := AUX_STRING10[I];
                      STRING132.LENGTH := 8;
                      DIAG (ERR, 'SCAN_OPTIONS (5c)        ', DUMMY_LINE, SEGMENT,
                            STRING132);
                  END (*IF*);
                  IF SEGMENT_OPTIONS.OPTIONAL THEN
                  BEGIN
                      SEGMENT_OPTIONS.OPTIONAL := FALSE;
                      AUX_STRING10 := 'OPTIONAL  ';
                      FOR I := 1 TO 8 DO
                          STRING132.BODY[I] := AUX_STRING10[I];
                      STRING132.LENGTH := 8;
                      DIAG (ERR, 'SCAN_OPTIONS (5c)        ', DUMMY_LINE, SEGMENT,
                            STRING132);
                  END (*IF*);
              END (*IF*);
            
              (* 4. Check illegal use of the options FILE, LEADER,     *)
              (*    TRAILER, SEPARATOR and DEFAULT in the segment.     *)
              WITH SEGMENT_OPTIONS DO
              BEGIN
                  IF  ( (NOT SP_IS_EMPTY_STR (FILE_NAME))                  AND
                      ( (DEFAULT) OR  (SEPARATOR) OR  (LEADER) OR  (TRAILER))) OR
                      ( (DEFAULT) AND  ( (SEPARATOR) OR  (LEADER) OR  (TRAILER))) OR
                      ( (LEADER) AND  ( (SEPARATOR) OR  (TRAILER)))  OR
                      ( (SEPARATOR) AND  (TRAILER)) THEN
                  BEGIN
                      DEFAULT := FALSE;
                      SEPARATOR := FALSE;
                      LEADER := FALSE;
                      TRAILER := FALSE;
                      STRING132.LENGTH := 0;
                      STRING132.BODY := EMPTY_STRING_FIXED;
                      DIAG (ERR, 'SCAN_OPTIONS (5d)        ', DUMMY_LINE, SEGMENT,
                            STRING132);
                  END (*IF*);
              END (*WITH*);
              (*****************  End of SCAN_OPTIONS (5)  *************)
          END (*IF*);
      END (*IF*);
      (*****************  End of SCAN_OPTIONS (body)  ******************)

  END (*PROCEDURE SCAN_OPTIONS*);


  (*********************************************************************)
  (* Routine:     BUILD_CODE_STRUCT - BUILD the structure CODE_STRUCT. *)
  (* Purpose:     Scan a stub block upon the different sort of         *)
  (*              segments and build the structure of stubs and slots. *)
  (* Interface:   CODE_STRUCT:  Anchors the datastructure representing *)
  (*                            the stubs and slots structure.         *)
  (*              RUN_INFO:     All information concerning this run.   *)
  (*              FIRST_LINE:   The first line of a stub block.        *)
  (*              LINE_INFO:    Scanned information of a line.         *)
  (*********************************************************************)
  PROCEDURE BUILD_CODE_STRUCT (VAR CODE_STRUCT:  CODE_STRUCT_;
                                   RUN_INFO:     RUN_INFO_;
                                   FIRST_LINE:   LINE_DES_;
                                   LINE_INFO:    LINE_INFO_);

  VAR
     SEGMENT_TYPE:    SEGMENT_TYPE_;
      END_OF_STUB_BLOCK:    BOOLEAN;
      SOURCE_LINE:          LINE_DES_;
      LAST_SLOT:  SLT_PTR_;
      STRING132:   STRING132_;
      SEGMENT:    SEGMENT_DES_;

  BEGIN
      (*******            BUILD_CODE_STRUCT (body)               *******)

      (*********************  BUILD_CODE_STRUCT (1)  *******************)
      (** FIRST_LINE marks a new stub segment. Link the stub into its **)
      (** position and let CODE_STRUCT.LAST_STUB refer to it. Set     **)
      (** LAST_SLOT to NIL. Initialize LAST_STUB. Add FIRST_LINE to   **)
      (** the segment LAST_STUB^.SRC_IMG. Use LINE_INFO to update     **)
      (** LAST_STUB^.NAME.                                            **)
      WITH CODE_STRUCT DO
      BEGIN
          LAST_SLOT := NIL;
          IF FIRST_STUB = NIL THEN
          BEGIN
              NEW (FIRST_STUB);
              LAST_STUB := FIRST_STUB;
          END
          ELSE
          BEGIN
              NEW (LAST_STUB^.NEXT_STUB);
              LAST_STUB := LAST_STUB^.NEXT_STUB;
          END (*IF*);
          WITH LAST_STUB^ DO
          BEGIN
              SLOTS := NIL;
              NEXT_STUB := NIL;
              NEXT_TWIN := NIL;
              ST_INIT_SEG (SRC_IMG);
              SP_INIT_STR (NAME);
              ST_PUT_SEG (FIRST_LINE, SRC_IMG);
              SP_ADD_BUFFER (LINE_INFO.LINE_ID);
              SP_CONC_STR (NAME, LINE_INFO.LINE_ID);
          END (*WITH*);
      END (*WITH*);
      (*****************  End of BUILD_CODE_STRUCT (1)  ****************)

      (* Set SEGMENT_TYPE to STUB since the first segment of a stub    *)
      (* block must be a stub segment. Initialize END_OF_STUB_BLOCK.   *)
      SEGMENT_TYPE := STUB;
      END_OF_STUB_BLOCK := FALSE;

      WHILE (NOT END_OF_STUB_BLOCK) AND (NOT FT_EOF) DO
      BEGIN
          FT_RDLN (SOURCE_LINE);

          (* Check wether or not we need to scan this line.            *)
          WITH RUN_INFO DO
          BEGIN
              IF FT_GET_LINE_LENGTH (SOURCE_LINE) >
                              CLIP_LPAR.LENGTH+CLIP_RPAR.LENGTH THEN
                  SCAN_LINE (LINE_INFO, SOURCE_LINE, RUN_INFO)
              ELSE
                  LINE_INFO.CATEGORY := L5;
          END (*WITH*);

          WITH CODE_STRUCT DO
          CASE LINE_INFO.CATEGORY OF
          L1:
              BEGIN
              IF LAST_SLOT = NIL THEN
              BEGIN
                  (*************  BUILD_CODE_STRUCT (2)  ***************)
                  (** The end of the previous stub segment. Scan the  **)
                  (** options of LAST_STUB^.SRC_IMG and store the     **)
                  (** found options in LAST_STUB^.OPTIONS. Add the    **)
                  (** buffer to LINE_INFO.LINE_ID.                    **)
                  WITH LAST_STUB^ DO
                      SCAN_OPTIONS (OPTIONS, SRC_IMG, RUN_INFO, SEGMENT_TYPE);
                  LINE_INFO.OPTIONS := FALSE;
                  SP_ADD_BUFFER (LINE_INFO.LINE_ID);
                  (*********  End of BUILD_CODE_STRUCT (2)  ************)

                  IF LAST_STUB^.OPTIONS.QUICK THEN
                  BEGIN
                      SEGMENT_TYPE := STUB;
                      (*************  BUILD_CODE_STRUCT (3)  ***********)
                      (** The end of the current stub block and the   **)
                      (** start a new one. Make an entry for this new **)
                      (** stub, let LAST_STUB point to it and initia- **)
                      (** lize its fields. Set LAST_SLOT to NIL. Add  **)
                      (** SOURCE_LINE to LAST_STUB^.SRC_IMG. Update   **)
                      (** LAST_STUB^.NAME with information from       **)
                      (** LINE_INFO.                                  **)
                      NEW (LAST_STUB^.NEXT_STUB);
                      LAST_STUB := LAST_STUB^.NEXT_STUB;
                      LAST_SLOT := NIL;
                      WITH LAST_STUB^ DO
                      BEGIN
                          SLOTS :=     NIL;
                          NEXT_STUB := NIL;
                          NEXT_TWIN := NIL;
                          ST_INIT_SEG (SRC_IMG);
                          SP_INIT_STR (NAME);
                          ST_PUT_SEG (SOURCE_LINE, SRC_IMG);
                          SP_CONC_STR (NAME, LINE_INFO.LINE_ID);
                      END (*WITH*);
                      (*********  End of BUILD_CODE_STRUCT (3)  ********)
                  END
                  ELSE
                  BEGIN
                      SEGMENT_TYPE :=  SLOT;
                      (*************  BUILD_CODE_STRUCT (4)  ***********)
                      (** First slot segment of this stub block. Make **)
                      (** entry for this new slot, let LAST_SLOT      **)
                      (** point to it and initialize its fields. Add  **)
                      (** SOURCE_LINE to segment LAST_SLOT^.SRC_IMG.  **)
                      (** Update LAST_SLOT with the information hold  **)
                      (** by LINE_INFO.                               **)
                      NEW (LAST_STUB^.SLOTS);
                      LAST_SLOT := LAST_STUB^.SLOTS;
                      WITH LAST_SLOT^ DO
                      BEGIN
                          SP_INIT_STR (NAME);
                          ST_INIT_SEG (SRC_IMG);
                          STUB_REF := NIL;
                          ST_INIT_SEG (CODE);
                          NEXT_SLOT := NIL;
                          ST_PUT_SEG (SOURCE_LINE, SRC_IMG);
                          SP_CONC_STR (NAME, LINE_INFO.LINE_ID);
                      END (*WITH*);
                      (*********  End of BUILD_CODE_STRUCT (4)  ********)
                  END (*IF*);
              END
              ELSE
              BEGIN
                  (*************  BUILD_CODE_STRUCT (5)  ***************)
                  (** End of the previous segment LAST_SLOT^.SRC_IMG. **)
                  (** Finish the segment by scanning its options      **)
                  (** using RUN_INFO. Store found options in          **)
                  (** LAST_SLOT^.OPTIONS. Add the buffer to LINE_-    **)
                  (** INFO.LINE_ID.                                   **)
                  WITH LAST_SLOT^ DO
                      SCAN_OPTIONS (OPTIONS, SRC_IMG, RUN_INFO, SEGMENT_TYPE);
                  LINE_INFO.OPTIONS := FALSE;
                  SP_ADD_BUFFER (LINE_INFO.LINE_ID);
                  (*********  End of BUILD_CODE_STRUCT (5)  ************)
                  IF LAST_STUB^.OPTIONS.QUICK THEN
                  BEGIN
                      SEGMENT_TYPE := STUB;
                      (*************  BUILD_CODE_STRUCT (6)  ***********)
                      (** End of current stub block and the start of  **)
                      (** a new one. Link this new stub into its po-  **)
                      (** sition, let LAST_STUB point to it and ini-  **)
                      (** tialize its fields. Add SOURCE_LINE to      **)
                      (** segment LAST_STUB^.SRC_IMG and update       **)
                      (** LAST_STUB^.NAME with the help of LINE_INFO. **)
                      NEW (LAST_STUB^.NEXT_STUB);
                      LAST_STUB := LAST_STUB^.NEXT_STUB;
                      LAST_SLOT := NIL;
                      WITH LAST_STUB^ DO
                      BEGIN
                          SLOTS :=     NIL;
                          NEXT_STUB := NIL;
                          NEXT_TWIN := NIL;
                          ST_INIT_SEG (SRC_IMG);
                          SP_INIT_STR (NAME);
                          ST_PUT_SEG (SOURCE_LINE, SRC_IMG);
                          SP_CONC_STR (NAME, LINE_INFO.LINE_ID);
                      END (*WITH*);
                      (*********  End of BUILD_CODE_STRUCT (6)  ********)
                  END
                  ELSE
                  BEGIN
                      SEGMENT_TYPE :=  SLOT;
                      (*************  BUILD_CODE_STRUCT (7)  ***********)
                      (** Start of a new slot segment. Link slot into **)
                      (** its position, let LAST_SLOT point to it and **)
                      (** initialize its fields. Add SOURCE_LINE to   **)
                      (** LAST_SLOT^.SRC_IMG and update LAST_SLOT^.-  **)
                      (** NAME with the help of LINE_INFO.            **)
                      NEW (LAST_SLOT^.NEXT_SLOT);
                      LAST_SLOT := LAST_SLOT^.NEXT_SLOT;
                      WITH LAST_SLOT^ DO
                      BEGIN
                          SP_INIT_STR (NAME);
                          ST_INIT_SEG (SRC_IMG);
                          STUB_REF := NIL;
                          ST_INIT_SEG (CODE);
                          NEXT_SLOT := NIL;
                          ST_PUT_SEG (SOURCE_LINE, SRC_IMG);
                          SP_CONC_STR (NAME, LINE_INFO.LINE_ID);
                      END (*WITH*);
                      (*********  End of BUILD_CODE_STRUCT (7)  ********)
                  END (*IF*);
              END(*IF*);
              END;
          L2:
              BEGIN
              (*****************  BUILD_CODE_STRUCT (8)  ***************)
              (** End of the previous slot or stub segment. Scan      **)
              (** LAST_<x>^.SRC_IMG for options and store them in     **)
              (** LAST_<x>^.OPTIONS. Add the buffer to LINE_INFO.-    **)
              (** LINE_ID after that. <x> reads "STUB" for a stub     **)
              (** and "SLOT" for a slot- or code-segment.             **)
              IF (SEGMENT_TYPE = STUB) THEN
              BEGIN
                  WITH LAST_STUB^ DO
                      SCAN_OPTIONS (OPTIONS, SRC_IMG, RUN_INFO, SEGMENT_TYPE)
              END
              ELSE
              BEGIN
                  WITH LAST_SLOT^ DO
                      SCAN_OPTIONS (OPTIONS, SRC_IMG, RUN_INFO, SEGMENT_TYPE);
              END (*IF*);
              LINE_INFO.OPTIONS := FALSE;
              SP_ADD_BUFFER (LINE_INFO.LINE_ID);
              (*************  End of BUILD_CODE_STRUCT (8)  ************)

              END_OF_STUB_BLOCK := TRUE;
              SEGMENT_TYPE := END_STUB;

              (*****************  BUILD_CODE_STRUCT (9)  ***************)
              (** Start of the end segment. Link slot into its posi-  **)
              (** tion, let LAST_SLOT point to it and initialize its  **)
              (** fields. Add SOURCE_LINE to the segment LAST_SLOT^.- **)
              (** SRC_IMG and update LAST_SLOT^.NAME using the infor- **)
              (** mation of LINE_INFO.                                **)
              IF LAST_SLOT<>NIL THEN
              BEGIN
                  NEW (LAST_SLOT^.NEXT_SLOT);
                  LAST_SLOT := LAST_SLOT^.NEXT_SLOT;
              END
              ELSE
              BEGIN
                  NEW (LAST_STUB^.SLOTS);
                  LAST_SLOT := LAST_STUB^.SLOTS;
              END (*IF*);
              WITH LAST_SLOT^ DO
              BEGIN
                  SP_INIT_STR (NAME);
                  ST_INIT_SEG (SRC_IMG);
                  STUB_REF := NIL;
                  ST_INIT_SEG (CODE);
                  NEXT_SLOT := NIL;
                  SCAN_OPTIONS (OPTIONS, SRC_IMG, RUN_INFO, SEGMENT_TYPE);
                  LINE_INFO.OPTIONS := FALSE;
                  ST_PUT_SEG (SOURCE_LINE, SRC_IMG);
                  SP_CONC_STR (NAME, LINE_INFO.LINE_ID);
              END; (*WITH*)
              (*************  End of BUILD_CODE_STRUCT (9)  ************)
              END;
          L3:
              BEGIN
              IF SEGMENT_TYPE = STUB THEN
              BEGIN
                  (*************  BUILD_CODE_STRUCT (10)  **************)
                  (** Continuation line of the stub segment. Add      **)
                  (** SOURCE_LINE to LAST_STUB^.SRC_IMG. Add buffer   **)
                  (** to LINE_INFO.LINE_ID and update LAST_STUB^.NAME **)
                  (** using LINE_INFO.                                **)
                  WITH LAST_STUB^ DO
                  BEGIN
                      ST_PUT_LINE (SOURCE_LINE, SRC_IMG);
                      SP_ADD_BUFFER (LINE_INFO.LINE_ID);
                      SP_CONC_STR (NAME, LINE_INFO.LINE_ID);
                  END (*WITH*);
                  (*********  End of BUILD_CODE_STRUCT (10)  ***********)
              END
              ELSE IF SEGMENT_TYPE = SLOT THEN
              BEGIN
                  (*************  BUILD_CODE_STRUCT (11)  **************)
                  (** Continuation of the current slot segment.       **)
                  (** Add SOURCE_LINE to LAST_SLOT^.SRC_IMG, add the  **)
                  (** buffer to LINE_INFO.LINE_ID and update LAST_-   **)
                  (** SLOT^.NAME using LINE_INFO.                     **)
                  WITH LAST_SLOT^ DO
                  BEGIN
                      ST_PUT_LINE (SOURCE_LINE, SRC_IMG);
                      SP_ADD_BUFFER (LINE_INFO.LINE_ID);
                      SP_CONC_STR (NAME, LINE_INFO.LINE_ID);
                  END (*WITH*);
                  (*********  End of BUILD_CODE_STRUCT (11)  ***********)
              END
              ELSE
              BEGIN
                  (*************  BUILD_CODE_STRUCT (12)  **************)
                  (** This orphan line cannot be paste to a stub- or  **)
                  (** slot-segment. Generate an error message using   **)
                  (** the information hold by SOURCE_LINE.            **)
                  ST_INIT_SEG (SEGMENT);
                  STRING132.LENGTH := 0;
                  STRING132.BODY := EMPTY_STRING_FIXED;
                  DIAG (WARN, 'BUILD_C_S (12)           ', SOURCE_LINE, SEGMENT, STRING132);
                  (*********  End of BUILD_CODE_STRUCT (12)  ***********)
              END (*IF.IF*);
              END;
          L4:
              BEGIN
              IF SEGMENT_TYPE = STUB THEN
              BEGIN
                  (*************  BUILD_CODE_STRUCT (13)  **************)
                  (** Continuation ofcurrent stub segment. Add        **)
                  (** SOURCE_LINE to segment LAST_STUB^.SRC_IMG.      **)
                  WITH LAST_STUB^ DO
                      ST_PUT_LINE (SOURCE_LINE, SRC_IMG);
                  (*********  End of BUILD_CODE_STRUCT (13)  ***********)
              END
              ELSE IF SEGMENT_TYPE = SLOT THEN
              BEGIN
                  (*************  BUILD_CODE_STRUCT (14)  **************)
                  (** Continuation of current slot segment. Add       **)
                  (** SOURCE_LINE to segment LAST_SLOT^.SRC_IMG.      **)
                  WITH LAST_SLOT^ DO
                      ST_PUT_LINE (SOURCE_LINE, SRC_IMG);
                  (*********  End of BUILD_CODE_STRUCT (14)  ***********)
              END
              ELSE IF SEGMENT_TYPE = CODE THEN
              BEGIN
                  (*************  BUILD_CODE_STRUCT (15)  **************)
                  (** Continuation of current code segment. Add       **)
                  (** SOURCE_LINE to segment LAST_SLOT^.CODE.         **)
                  WITH LAST_SLOT^ DO
                      ST_PUT_LINE (SOURCE_LINE, CODE);
                  (*********  End of BUILD_CODE_STRUCT (15)  ***********)
              END (*IF.IF.IF*);
              END;
          L5:
              BEGIN
              IF SEGMENT_TYPE = STUB THEN
              BEGIN
                  (*************  BUILD_CODE_STRUCT (16)  **************)
                  (** End of previous stub segment LAST_STUB^.-       **)
                  (** SRC_IMG. Complete that segment by scanning      **)
                  (** which are stored to LAST_STUB^.OPTIONS.         **)
                  WITH LAST_STUB^ DO
                      SCAN_OPTIONS (OPTIONS, SRC_IMG, RUN_INFO, SEGMENT_TYPE);
                  LINE_INFO.OPTIONS := FALSE;
                  (*********  End of BUILD_CODE_STRUCT (16)  ***********)

                  IF (LAST_STUB^.OPTIONS.QUICK) AND
                      (FT_GET_LINE_LENGTH (SOURCE_LINE) = 0) THEN
                  BEGIN
                      (*************  BUILD_CODE_STRUCT (17)  **********)
                      (** End of current stub block. Set Boolean      **)
                      (** END_OF_STUB_BLOCK to TRUE.                  **)
                      END_OF_STUB_BLOCK := TRUE;
                      (*********  End of BUILD_CODE_STRUCT (17)  *******)
                  END
                  ELSE
                  BEGIN
                      SEGMENT_TYPE := CODE;
                      (*************  BUILD_CODE_STRUCT (18)  **********)
                      (** Start of a new code-segment. Link a new     **)
                      (** entry for this slot into its position. Let  **)
                      (** LAST_SLOT refer to this slot and initialize **)
                      (** its fields. Add SOURCE_LINE to the new code **)
                      (** segment LAST_SLOT^.CODE.                    **)
                      NEW (LAST_STUB^.SLOTS);
                      LAST_SLOT := LAST_STUB^.SLOTS;
                      WITH LAST_SLOT^ DO
                      BEGIN
                          SP_INIT_STR (NAME);
                          ST_INIT_SEG (SRC_IMG);
                          STUB_REF := NIL;
                          ST_INIT_SEG (CODE);
                          NEXT_SLOT := NIL;
                          ST_PUT_SEG (SOURCE_LINE, CODE);
                      END (*WITH*);
                      (*********  END OF BUILD_CODE-STRUCT (18)  *******)
                  END (*IF.IF*);
              END
              ELSE IF SEGMENT_TYPE = SLOT THEN
              BEGIN
                  SEGMENT_TYPE := CODE;
                  (*************  BUILD_CODE_STRUCT (19)  **************)
                  (** Start of a new code segment immediately follo-  **)
                  (** wing a slot segment. Add SOURCE_LINE to the     **)
                  (** to the code segment LAST_SLOT^.CODE.            **)
                  WITH LAST_SLOT^ DO
                      ST_PUT_SEG (SOURCE_LINE, CODE);
                  (*********  End of BUILD_CODE_STRUCT (19)  ***********)
              END
              ELSE IF SEGMENT_TYPE = CODE THEN
              BEGIN
                  IF (CODE_STRUCT.LAST_STUB^.OPTIONS.QUICK) AND
                                (FT_GET_LINE_LENGTH (SOURCE_LINE)=0) THEN
                  BEGIN
                      (*************  BUILD_CODE_STRUCT (20)  **********)
                      (** End of current stub block. Scan options     **)
                      (** from LAST_SLOT^.SRC_IMG and store them in   **)
                      (** LAST_SLOT^.OPTIONS.                         **)
                      SCAN_OPTIONS (LAST_SLOT^.OPTIONS, LAST_SLOT^.SRC_IMG,
                                    RUN_INFO,           SEGMENT_TYPE);
                      LINE_INFO.OPTIONS := FALSE;
                      (*********  End of BUILD_CODE_STRUCT (20)  *******)

                      END_OF_STUB_BLOCK := TRUE;
                  END
                  ELSE
                  BEGIN
                      (*************  BUILD_CODE_STRUCT (21)  **********)
                      (** Continuation of the code segment. Add       **)
                      (** SOURCE_LINE to segment LAST_SLOT^.CODE.     **)
                      WITH LAST_SLOT^ DO
                          ST_PUT_LINE (SOURCE_LINE, CODE);
                      (*********  End of BUILD_CODE_STRUCT (21)  *******)
                  END (*IF*);
              END (*IF.IF.IF*);
          END;
          END (*CASE.WITH*);
      END (*WHILE*);

      IF (NOT END_OF_STUB_BLOCK) THEN
      BEGIN
          IF (NOT CODE_STRUCT.LAST_STUB^.OPTIONS.QUICK) THEN
          BEGIN
              (*************  BUILD_CODE_STRUCT (22)  ******************)
              (** File exhausted but current stub block not closed by **)
              (** a line of category L2. Issue an error using         **)
              (** FILE_SPEC.                                          **)
              STRING132.LENGTH := 0;
              STRING132.BODY := EMPTY_STRING_FIXED;
              FT_INIT_LINE (SOURCE_LINE);
              DIAG (WARN, 'BUILD_C_S (22)           ', SOURCE_LINE,
                          CODE_STRUCT.LAST_STUB^.SRC_IMG, STRING132);
              (*************  End of BUILD_CODE_STRUCT (22)  ***********)
          END
          ELSE IF SEGMENT_TYPE = CODE THEN
          BEGIN
              (*************  BUILD_CODE_STRUCT (23)  ******************)
              (** The last quick stub in the file didn't end with an  **)
              (** L5-line, but with EOF. So the options from LAST_-   **)
              (** SLOT.SRC_IMG must be scanned and stored in LAST_-   **)
              (** SLOT.OPTIONS here.                                  **)
              SCAN_OPTIONS (LAST_SLOT^.OPTIONS, LAST_SLOT^.SRC_IMG,
                            RUN_INFO,           SEGMENT_TYPE);
              LINE_INFO.OPTIONS := FALSE;
              (*************  End of BUILD_CODE_STRUCT (23)  ***********)
          END (*IF*);
      END (*IF*);
      (*************  End of BUILD_CODE_STRUCT (body)  *****************)

  END (*PROCEDURE BUILD_CODE_STRUCT*);


  (*********************************************************************)
  (* Routine:     SCAN_FILES   - SCAN all source FILES.                *)
  (* Purpose:     To coordinate the scanning of all the sourcefiles on *)
  (*              file level. More detailed activities are delegated.  *)
  (* Interface:   RUN_INFO:       Structure containing all needed info *)
  (*                              for this CLIP run.                   *)
  (*              CODE_STRUCT:    Internal representation of stub-,    *)
  (*                              slot- and code-segments.             *)
  (*********************************************************************)
  PROCEDURE SCAN_FILES (VAR CODE_STRUCT: CODE_STRUCT_;
                            RUN_INFO:    RUN_INFO_);

  VAR
      SCAN_FILE_STOP: BOOLEAN;
      FILE_CNT:   INTEGER;
      I:          INTEGER;
      LINE_INFO:          LINE_INFO_ ;
      SOURCE_LINE:        LINE_DES_  ;
      DUMMY:              ERROR_CODE_;
      STRING132:  STRING132_;
      SEGMENT:    SEGMENT_DES_;

  BEGIN
      (*******                SCAN_FILES (body)                  *******)
      SCAN_FILE_STOP :=   FALSE;

      (*********************  SCAN_FILES (1)  **************************)
      (** Try to open all source files of which the names are kept by **)
      (** RUN_INFO. List inaccessible files. Set SCAN_FILE_STOP to    **)
      (** TRUE when at least one file gives a problem.                **)
      WITH RUN_INFO DO
      FOR FILE_CNT := 1 TO NR_SRC_FILES DO
      BEGIN
          IF FT_CHECK_FILE (SOURCE_FILES [FILE_CNT]) <> 0 THEN
          BEGIN
              WRITE ('ERROR checking source file:  ');
              FOR I := 1 TO SOURCE_FILES [FILE_CNT].LENGTH DO
                  WRITE (SOURCE_FILES [FILE_CNT].BODY [I]);
              WRITELN;
    
              IF REPORT_OK THEN
              BEGIN
                  WRITE (REPORT_FILE, 'ERROR checking source file:  ');
                  FOR I := 1 TO SOURCE_FILES [FILE_CNT].LENGTH DO
                      WRITE (REPORT_FILE, SOURCE_FILES [FILE_CNT].BODY [I]);
                  WRITELN (REPORT_FILE);
              END (*IF*);
    
              SCAN_FILE_STOP := TRUE;
          END (*IF*);
      END (*FOR.WITH*);
      (*****************  End of SCAN_FILES (1)  ***********************)

      IF NOT SCAN_FILE_STOP THEN
      BEGIN
          (*********************  SCAN_FILES (2)  **********************)
          (** Build CODE_STRUCT from the source files specified by    **)
          (** RUN_INFO.                                               **)
          FOR FILE_CNT := 1 TO RUN_INFO.NR_SRC_FILES DO
          BEGIN
              (* Open and reset file with given specification using    *)
              (* the function FT_INOPEN from the module FT.            *)
              IF FT_INOPEN (RUN_INFO.SOURCE_FILES [FILE_CNT]) <= 0 THEN
              BEGIN
                  WRITE ('Scanning file: ');
                  FOR I := 1 TO RUN_INFO.SOURCE_FILES [FILE_CNT].LENGTH DO
                      WRITE (RUN_INFO.SOURCE_FILES [FILE_CNT].BODY[I]);
                  WRITELN;
        
                  IF REPORT_OK THEN
                  BEGIN
                      WRITE (REPORT_FILE, 'Scanning file: ');
                      FOR I := 1 TO RUN_INFO.SOURCE_FILES [FILE_CNT].LENGTH DO
                          WRITE (REPORT_FILE,
                                       RUN_INFO.SOURCE_FILES [FILE_CNT].BODY[I]);
                      WRITELN (REPORT_FILE);
                  END (*IF*);
        
                  WHILE NOT FT_EOF DO
                  BEGIN
                      (* Read the next line from the source file and   *)
                      (* initialize LINE_INFO and the Buffer.          *)
                      FT_RDLN (SOURCE_LINE);
                      WITH LINE_INFO DO
                          OPTIONS := FALSE;
                      SP_INIT_BUFFER;
        
                      (* Determine the category this line belongs to.  *)
                      WITH RUN_INFO DO
                      BEGIN
                          IF SOURCE_LINE.USED >
                                      CLIP_LPAR.LENGTH + CLIP_RPAR.LENGTH THEN
                              SCAN_LINE (LINE_INFO, SOURCE_LINE, RUN_INFO)
                          ELSE
                              LINE_INFO.CATEGORY := L5;
                      END (*WITH*);
        
                      (* Proces this line according to its catagory.   *)
                      CASE LINE_INFO.CATEGORY OF
                      L1:
                          BEGIN
                          (*************  SCAN_FILES (2.1)  ********************)
                          (** Start of a new stub. Switch to active mode and  **)
                          (** build CODE_STRUCT from successive lines using   **)
                          (** RUN_INFO, SOURCE_LINE and LINE_INFO.            **)
                        
                          BUILD_CODE_STRUCT (CODE_STRUCT, RUN_INFO, SOURCE_LINE, LINE_INFO);
                        
                          (*************  End of SCAN_FILES (2.1)  *************)
                          END;
                      L2:
                          BEGIN
                          (*************  SCAN_FILES (2.2)  ********************)
                          (** Illegal in passive mode. Generate an error from **)
                          (** the information in SOURCE_LINE.                 **)
                          ST_INIT_SEG (SEGMENT);
                          STRING132.BODY := EMPTY_STRING_FIXED;
                          STRING132.LENGTH := 0;
                          DIAG (WARN, 'SCAN_FILES (2.2)         ', SOURCE_LINE, SEGMENT, STRING132);
                          (*************  End of SCAN_FILES (2.2)  *************)
                          END;
                      L3:
                          BEGIN
                          (*************  SCAN_FILES (2.3)  ********************)
                          (** Illegal in passive mode. Generate an error from **)
                          (** the information in SOURCE_LINE.                 **)
                          ST_INIT_SEG (SEGMENT);
                          STRING132.LENGTH := 0;
                          STRING132.BODY := EMPTY_STRING_FIXED;
                          DIAG (ERR, 'SCAN_FILES (2.3)         ', SOURCE_LINE, SEGMENT, STRING132);
                          (*************  End of SCAN_FILES (2.3)  *************)
                          END;
                      L4,
                      L5:
                          BEGIN
                          (* Nothing to be done. Flush this line.              *)
                          END;
                      END (*CASE*);
                  END (*WHILE*);
                  DUMMY := FT_INCLOSE;
              END
              ELSE
              BEGIN
                  (*********************  SCAN_FILES (2.4)  ********************)
                  (** Access problem with this source file. Issue error using **)
                  (** its specification in RUN_INFO.                          **)
                  WITH RUN_INFO DO
                  BEGIN
                      WRITE ('ERROR opening source file:  ');
                      FOR I := 1 TO SOURCE_FILES [FILE_CNT].LENGTH DO
                          WRITE (SOURCE_FILES [FILE_CNT].BODY [I]);
                      WRITELN;
                
                      IF REPORT_OK THEN
                      BEGIN
                          WRITE (REPORT_FILE, 'ERROR opening source file:  ');
                          FOR I := 1 TO SOURCE_FILES [FILE_CNT].LENGTH DO
                              WRITE (REPORT_FILE, SOURCE_FILES [FILE_CNT].BODY [I]);
                          WRITELN (REPORT_FILE);
                      END (*IF*);
                  END (*WITH*);
                  (*****************  End of SCAN_FILES (2.4)  *****************)
              END (*IF*);
          END (*FOR*);
          (*****************  End of SCAN_FILES (2)  *******************)
      END (*IF*);
      (*****************  End of SCAN_FILES (body)  ********************)
  END (*PROCEDURE SCAN_FILES*);


  (*********************************************************************)
  (* Routine:    CHECK_CIRC  - CHECK FOR CIRCularity.                  *)
  (* Purpose:    To check possible circularity of CODE_STRUCT.         *)
  (* Interface:  CODE_STRUCT -   Structure to be examined.             *)
  (*             LIST_HEAD -     First element of shadow list.         *)
  (*********************************************************************)
  PROCEDURE CHECK_CIRC (VAR CODE_STRUCT: CODE_STRUCT_;
                        LIST_HEAD:   SHADOW_PTR_);

  VAR
      MAIN_STUB:      STB_PTR_;
      SHADOW_STUB:    SHADOW_PTR_;
      STUB:           STB_PTR_;
      CIRCULARITY,
      REMOVED:        BOOLEAN;

  (*******                CHECK_CIRC routines                    *******)

  (*********************************************************************)
  (* Routine:     LOCATE_CIRC -   LOCATE CIRCularity.                  *)
  (* Purpose:     Locate and remove circularity in CODE_STRUCT.        *)
  (* Interface:   CODE_STRUCT -   The structure to be checked.         *)
  (*              STUB -          The stub currently checked.          *)
  (*              CIRCULARITY -   Flags if circularity is detected.    *)
  (*              REMOVED -       Flags if circularity is removed.     *)
  (*********************************************************************)
  PROCEDURE LOCATE_CIRC (VAR CODE_STRUCT: CODE_STRUCT_;
                         VAR STUB:        STB_PTR_;
                         VAR CIRCULARITY: BOOLEAN;
                         VAR REMOVED:     BOOLEAN);

  (*******        LOCATE_CIRC labels (#Quick)                    *******)
  LABEL
      MYEXIT;

  VAR
      SLOT:       SLT_PTR_;
      HELP_STUB:  STB_PTR_;
      TWIN_STUB:  STB_PTR_;

  (*******    LOCATE_CIRC routines                               *******)

  (*********************************************************************)
  (* Routine:     TRACEBACK                                            *)
  (* Purpose:     -In case of an unremoved circularity: Remove circu-  *)
  (*              larity and show the responsible slot.                *)
  (*              -Show a stub of the circularity-chain.               *)
  (* Interface:   STUB -    The stub, which was being checked.         *)
  (*              SLOT -    The slot, at which STUB is pointing.       *)
  (*              REMOVED - Flags if the circularity is removed.       *)
  (*********************************************************************)
  PROCEDURE TRACEBACK (    STUB:    STB_PTR_;
                           SLOT:    SLT_PTR_;
                       VAR REMOVED: BOOLEAN);
  BEGIN
      IF NOT REMOVED THEN
      BEGIN
          SLOT^.STUB_REF := NIL;
          REMOVED := TRUE;
          WRITELN('Circularity detected !!! TRACE BACK:');
          WRITELN ('slot:');
          ST_WRITE_SEG (SLOT^.SRC_IMG, 0, 0);
          WRITELN;

          IF REPORT_OK THEN
          BEGIN
              WRITELN (REPORT_FILE,
                                 'Circularity detected !!! TRACE BACK:');
              WRITELN (REPORT_FILE, 'slot:');
              ST_WRITE_SEG (SLOT^.SRC_IMG, 0, 3);
              WRITELN (REPORT_FILE);
          END (*IF*);

      END(*IF*);
      IF NOT SP_IS_EMPTY_STR (STUB^.OPTIONS.FILE_NAME) THEN
      BEGIN
          WRITELN ('Main stub:');
          ST_WRITE_SEG (STUB^.SRC_IMG, 0, 0);
          WRITELN ('------------------------------------',
                   '------------------------------------');

          IF REPORT_OK THEN
          BEGIN
              WRITELN (REPORT_FILE, 'Main stub:');
              ST_WRITE_SEG (STUB^.SRC_IMG, 0, 3);
              WRITELN (REPORT_FILE,
                       '------------------------------------',
                       '------------------------------------');
          END (*IF*);
      END
      ELSE
      BEGIN
          WRITELN ('Stub:');
          ST_WRITE_SEG (STUB^.SRC_IMG, 0, 0);

          IF REPORT_OK THEN
          BEGIN
              WRITELN (REPORT_FILE, 'Stub:');
              ST_WRITE_SEG (STUB^.SRC_IMG, 0, 3);
          END (*IF*);
      END (*IF*);
      WRITELN;
   END (*TRACEBACK*);
  (*********************  End of LOCATE_CIRC routines  *****************)

  BEGIN
      (*******                LOCATE_CIRC (body)                 *******)
      WITH STUB^ DO
      BEGIN
          CIRCULARITY := STUB^.VISITED;
          IF NOT CIRCULARITY THEN
          BEGIN
              STUB^.VISITED := TRUE;
              SLOT := STUB^.SLOTS;
    
              (*********************  LOCATE_CIRC (1)  *********************)
              (** Check if the SLOTs of STUB are pointing at any stubs.   **)
              (** If so, locate circularities in these stubs and their    **)
              (** structure behind. Leave this level of the procedure     **)
              (** through MYEXIT in case of circularity.                  **)
              WHILE SLOT <> NIL DO
              BEGIN
                  IF SLOT^.STUB_REF <> NIL THEN
                  BEGIN
                      LOCATE_CIRC(CODE_STRUCT,SLOT^.STUB_REF,
                                              CIRCULARITY,REMOVED);
                      IF CIRCULARITY THEN
                      BEGIN
                          (*****************  LOCATE_CIRC (1.1)  *******************)
                          (** Remove the link causing the circularity in CODE_-   **)
                          (** STRUCT, if not removed already. Mention STUB in the **)
                          (** traceback. If this STUB is a main stub, set CIRCU-  **)
                          (** RITY, REMOVED and VISITED of all next stubs back to **)
                          (** FALSE and locate circularities in this new CODE_-   **)
                          (** STRUCT. Leave this level of the procedure through   **)
                          (** MYEXIT.                                             **)
                          TRACEBACK (STUB, SLOT, REMOVED);
                          IF NOT SP_IS_EMPTY_STR (STUB^.OPTIONS.FILE_NAME) THEN
                          BEGIN
                              CIRCULARITY := FALSE;
                              REMOVED := FALSE;
                              HELP_STUB := STUB;
                              WHILE HELP_STUB <> NIL DO
                              BEGIN
                                  HELP_STUB^.VISITED := FALSE;
                                  HELP_STUB := HELP_STUB^.NEXT_STUB;
                              END (*WHILE*);
                              LOCATE_CIRC (CODE_STRUCT, STUB, CIRCULARITY, REMOVED);
                          END(*IF*);
                          GOTO MYEXIT;
                          (*************  End of LOCATE_CIRC (1.1)  ****************)
                      END (*IF*);
            
                      (*****************  LOCATE_CIRC (1.2)  ***********************)
                      (** Check if SLOT^.STUB_REF is pointing at any twin stubs.  **)
                      (** If so, locate circularities in these stubs. In case of  **)
                      (** circularity, remove the responsible link, if not        **)
                      (** removed already, mention STUB in the traceback and      **)
                      (** leave this level of the procedure through MYEXIT.       **)
                      TWIN_STUB := SLOT^.STUB_REF^.NEXT_TWIN;
                      WHILE TWIN_STUB <> NIL DO
                      BEGIN
                          LOCATE_CIRC (CODE_STRUCT, TWIN_STUB, CIRCULARITY, REMOVED);
                          IF CIRCULARITY THEN
                          BEGIN
                              TRACEBACK (STUB, SLOT, REMOVED);
                              GOTO MYEXIT;
                          END (*IF*);
                          TWIN_STUB := TWIN_STUB^.NEXT_TWIN;
                      END (*WHILE*);
                      (*************  End of LOCATE_CIRC (1.2)  ********************)
            
                      SLOT^.STUB_REF^.VISITED := FALSE;
                  END (*IF*);
                  SLOT := SLOT^.NEXT_SLOT;
              END (*WHILE*);
              (*****************  End of LOCATE_CIRC (1)  ******************)
    
              STUB^.VISITED := FALSE;
          END (*IF*);
      END (*WITH*);
      MYEXIT:
      (*****************  End of LOCATE_CIRC (body)  *******************)
  END (*PROCEDURE LOCATE_CIRC*);
  (*****************  End of procedure LOCATE_CIRC  ********************)

  BEGIN
      SHADOW_STUB := LIST_HEAD;
      WHILE SHADOW_STUB <> NIL DO
      BEGIN
          MAIN_STUB := NIL;
    
          WITH SHADOW_STUB^.STUB_POINTER^ DO
          BEGIN
              IF NOT SP_IS_EMPTY_STR (OPTIONS.FILE_NAME) THEN
                  MAIN_STUB := SHADOW_STUB^.STUB_POINTER;
          END (*WITH*);
    
          IF MAIN_STUB <> NIL THEN
          BEGIN
              STUB := CODE_STRUCT.FIRST_STUB;
              WHILE STUB <> NIL DO
              BEGIN
                      STUB^.VISITED := FALSE;
                      STUB := STUB^.NEXT_STUB;
              END (*WHILE*);
    
              CIRCULARITY :=  FALSE;
              REMOVED :=      FALSE;
              LOCATE_CIRC (CODE_STRUCT, MAIN_STUB, CIRCULARITY, REMOVED);
          END (*IF*);
          SHADOW_STUB := SHADOW_STUB^.NEXT;
      END (*WHILE*)
  END (*PROCEDURE CHECK_CIRC*);


  (*********************************************************************)
  (* Routine:     ORDER_TWINS -   ORDER TWIN stub chains.              *)
  (* Purpose:     To (re)order the chains of twin stubs.               *)
  (* Interface:   SHADOW_LIST:    The list of pointers to the first    *)
  (*                              elements of the twin stub chain.     *)
  (*              CODE_STRUCT:    Structure of stubs and slots.        *)
  (*              LIST_HEAD:      Pointer to first element of the      *)
  (*                              shadow_list.                         *)
  (*********************************************************************)
  PROCEDURE ORDER_TWINS (VAR SHADOW_LIST:    SHADOW_LIST_;
                         VAR CODE_STRUCT:    CODE_STRUCT_;
                         VAR LIST_HEAD:      SHADOW_PTR_);

  VAR
      FIRST_TWIN:         STB_PTR_;
      SHADOW_STUB:        SHADOW_PTR_;
      PREV_SHADOW_STUB:   SHADOW_PTR_;
      TWIN_STUB:          STB_PTR_;
      PREV_TWIN:          STB_PTR_;
      CONTINUE:           BOOLEAN;
  LAST_TWIN:          STB_PTR_;
  SEPARATOR_STUB:     STB_PTR_;
  STUB_WALKER:        STB_PTR_;
  HELP_STUB:          STB_PTR_;
      ERROR:          BOOLEAN;
      DUMMY_LINE:     LINE_DES_;
      STRING132:      STRING132_;

  BEGIN
      (*********************  ORDER_TWINS body  ************************)
      PREV_SHADOW_STUB :=  NIL;
      SHADOW_STUB :=       LIST_HEAD;
      WHILE SHADOW_STUB <> NIL DO
      BEGIN
           FIRST_TWIN := SHADOW_STUB^.STUB_POINTER;
    
           (************************  ORDER_TWINS (1)  *********************)
           (** Order the twin stub chain headed by FIRST_TWIN. Make sure  **)
           (** that its first element remains accessible through by       **)
           (** SHADOW_STUB.                                               **)
           PREV_TWIN := NIL;
           TWIN_STUB := FIRST_TWIN;
           WHILE TWIN_STUB <> NIL DO
           BEGIN
               IF TWIN_STUB^.OPTIONS.DEFAULT THEN
               BEGIN
                   (*********************  ORDER_TWINS (1.1)  *******************)
                   (** Remove the TWIN_STUB from the list if it is no longer   **)
                   (** needed. Update SHADOW_LIST if needed.                   **)
                   IF (TWIN_STUB^.NEXT_TWIN <> NIL) AND
                       (PREV_TWIN = NIL)
                   THEN SHADOW_STUB^.STUB_POINTER := TWIN_STUB^.NEXT_TWIN
                   ELSE IF (TWIN_STUB^.NEXT_TWIN <> NIL) AND
                            (PREV_TWIN <> NIL)
                   THEN PREV_TWIN^.NEXT_TWIN := TWIN_STUB^.NEXT_TWIN
                   ELSE IF (TWIN_STUB^.NEXT_TWIN = NIL) AND
                           (PREV_TWIN <> NIL)
                   THEN PREV_TWIN^.NEXT_TWIN := NIL
                   ELSE
                   BEGIN
                       (* Nothing remains to be done here.              *)
                   END(*IF.IF.IF*);
                   (*****************  End of ORDER_TWINS (1.1)  ****************)
               END (*IF*);
               IF TWIN_STUB^.OPTIONS.LEADER THEN
               BEGIN
                   (*********************  ORDER_TWINS (1.2)  *******************)
                   (** Remove TWIN_STUB and put it ahead of the twin stub      **)
                   (** chain. Remove SHADOW_STUB from SHADOW_LIST if TWIN_STUB **)
                   (** is no longer needed.                                    **)
                   IF (TWIN_STUB^.NEXT_TWIN = NIL) AND (PREV_TWIN = NIL) THEN
                   BEGIN
                       IF PREV_SHADOW_STUB = NIL THEN
                       BEGIN
                           LIST_HEAD := SHADOW_STUB^.NEXT;
                           SHADOW_STUB := LIST_HEAD;
                           PREV_SHADOW_STUB := NIL;
                       END
                       ELSE
                       BEGIN
                           PREV_SHADOW_STUB^.NEXT := SHADOW_STUB^.NEXT;
                           SHADOW_STUB := PREV_SHADOW_STUB;
                       END (*IF*);
                   END
                   ELSE IF (TWIN_STUB^.NEXT_TWIN <> NIL) AND (PREV_TWIN <> NIL) THEN
                   BEGIN
                       PREV_TWIN^.NEXT_TWIN := TWIN_STUB^.NEXT_TWIN;
                       TWIN_STUB^.NEXT_TWIN := FIRST_TWIN;
                       SHADOW_STUB^.STUB_POINTER := TWIN_STUB;
                       TWIN_STUB := PREV_TWIN;
                       FIRST_TWIN := SHADOW_STUB^.STUB_POINTER;
                   END
                   ELSE IF (TWIN_STUB^.NEXT_TWIN = NIL) AND (PREV_TWIN <> NIL) THEN
                   BEGIN
                       PREV_TWIN^.NEXT_TWIN := NIL;
                       TWIN_STUB^.NEXT_TWIN := FIRST_TWIN;
                       SHADOW_STUB^.STUB_POINTER := TWIN_STUB;
                       TWIN_STUB := PREV_TWIN;
                       FIRST_TWIN := SHADOW_STUB^.STUB_POINTER;
                   END
                   ELSE
                   BEGIN
                      (* Leader stub is in place,nothing remains to be  *)
                      (* done here.                                     *)
                   END (*IF.IF.IF*);
                   (*****************  End of ORDER_TWINS (1.2)  ****************)
               END (*IF*);
               IF TWIN_STUB^.OPTIONS.TRAILER THEN
               BEGIN
                   (*********************  ORDER_TWINS (1.3)  *******************)
                   (** Remove TWIN_STUB and put it at the tail of the twin     **)
                   (** stub chain.                                             **)
                 
                   (* Locate the last stub in the twin stub chain       *)
                   LAST_TWIN := TWIN_STUB;
                   WHILE LAST_TWIN^.NEXT_TWIN <> NIL DO
                       LAST_TWIN := LAST_TWIN^.NEXT_TWIN;
                   IF (TWIN_STUB^.NEXT_TWIN = NIL) AND (PREV_TWIN = NIL) THEN
                   BEGIN
                       IF PREV_SHADOW_STUB = NIL THEN
                       BEGIN
                           LIST_HEAD := SHADOW_STUB^.NEXT;
                           SHADOW_STUB := LIST_HEAD;
                           PREV_SHADOW_STUB := NIL;
                       END
                       ELSE
                       BEGIN
                           PREV_SHADOW_STUB^.NEXT := SHADOW_STUB^.NEXT;
                           SHADOW_STUB := PREV_SHADOW_STUB;
                       END (*IF*);
                   END
                   ELSE IF (TWIN_STUB^.NEXT_TWIN <> NIL) AND (PREV_TWIN <> NIL) THEN
                   BEGIN
                       PREV_TWIN^.NEXT_TWIN := TWIN_STUB^.NEXT_TWIN;
                       LAST_TWIN^.NEXT_TWIN := TWIN_STUB;
                       LAST_TWIN := LAST_TWIN^.NEXT_TWIN;
                       LAST_TWIN^.NEXT_TWIN := NIL;
                       TWIN_STUB := PREV_TWIN;
                   END
                   ELSE IF (TWIN_STUB^.NEXT_TWIN <> NIL) AND (PREV_TWIN = NIL) THEN
                   BEGIN
                       SHADOW_STUB^.STUB_POINTER := TWIN_STUB^.NEXT_TWIN;
                       LAST_TWIN^.NEXT_TWIN := TWIN_STUB;
                       LAST_TWIN := LAST_TWIN^.NEXT_TWIN;
                       LAST_TWIN^.NEXT_TWIN := NIL;
                       FIRST_TWIN := SHADOW_STUB^.STUB_POINTER;
                       TWIN_STUB := FIRST_TWIN;
                       PREV_TWIN := NIL;
                   END
                   ELSE
                   BEGIN
                       (* Trailer stub is in position. Nothing remains  *)
                       (* to be done.                                   *)
                   END (*IF.IF.IF*);
                   (*****************  End of ORDER_TWINS (1.3)  ****************)
               END (*IF*);
               PREV_TWIN := TWIN_STUB;
               TWIN_STUB := TWIN_STUB^.NEXT_TWIN;
           END (*WHILE*);
           TWIN_STUB := FIRST_TWIN;
           PREV_TWIN := NIL;
           CONTINUE :=  TRUE;
           WHILE (TWIN_STUB^.NEXT_TWIN <> NIL) AND (CONTINUE) DO
           BEGIN
               IF TWIN_STUB^.OPTIONS.SEPARATOR THEN
               BEGIN
                   (*********************  ORDER_TWINS (1.4)  *******************)
                   (** Copy the seperator TWIN_STUB in between all other stubs **)
                   (** of the twin stub chain.                                 **)
                   IF PREV_TWIN = NIL THEN
                   BEGIN
                       FIRST_TWIN := TWIN_STUB^.NEXT_TWIN;
                       SHADOW_STUB^.STUB_POINTER := FIRST_TWIN;
                       SEPARATOR_STUB := TWIN_STUB;
                   END
                   ELSE
                   BEGIN
                       PREV_TWIN^.NEXT_TWIN := TWIN_STUB^.NEXT_TWIN;
                       SEPARATOR_STUB := TWIN_STUB;
                       TWIN_STUB := PREV_TWIN;
                   END (*IF*);
                   STUB_WALKER := FIRST_TWIN;
                   WHILE STUB_WALKER^.NEXT_TWIN <> NIL DO
                   BEGIN
                       HELP_STUB := STUB_WALKER^.NEXT_TWIN;
                       NEW (STUB_WALKER^.NEXT_TWIN);
                       STUB_WALKER :=  STUB_WALKER^.NEXT_TWIN;
                       STUB_WALKER^ := SEPARATOR_STUB^;
                       STUB_WALKER^.NEXT_TWIN := HELP_STUB;
                       STUB_WALKER :=  HELP_STUB;
                   END (*WHILE*);
                   (*****************  End of ORDER_TWINS (1.4)  ****************)
         
                    CONTINUE := FALSE;
               END (*IF*);
               PREV_TWIN := TWIN_STUB;
               TWIN_STUB := TWIN_STUB^.NEXT_TWIN;
           END (*WHILE*);
         
           (*************************  ORDER_TWINS (1.5)  ***********************)
           (** Examine the twin stub chain accessible by FIRST_TWIN. Generate  **)
           (** a diagnostic message in case the chain contains only LEADER,    **)
           (** SEPARATOR and TRAILER stubs.                                    **)
           ERROR := TRUE;
           STUB_WALKER := FIRST_TWIN;
           WHILE (STUB_WALKER <> NIL) AND (ERROR = TRUE) DO
           BEGIN
               IF (NOT STUB_WALKER^.OPTIONS.LEADER)    AND
                  (NOT STUB_WALKER^.OPTIONS.SEPARATOR) AND
                  (NOT STUB_WALKER^.OPTIONS.TRAILER)   THEN
                   ERROR := FALSE;
               STUB_WALKER := STUB_WALKER^.NEXT_TWIN;
           END (*WHILE*);
           IF (STUB_WALKER = NIL) AND (ERROR) THEN
           BEGIN
               STRING132.LENGTH := 0;
               STRING132.BODY := EMPTY_STRING_FIXED;
               FT_INIT_LINE (DUMMY_LINE);
               DIAG(WARN, 'ORDER_TWINS (1.5)        ', DUMMY_LINE,
                                       FIRST_TWIN^.SRC_IMG, STRING132);
               IF PREV_SHADOW_STUB = NIL THEN
               BEGIN
                   LIST_HEAD := SHADOW_STUB^.NEXT;
                   SHADOW_STUB := LIST_HEAD;
                   PREV_SHADOW_STUB := NIL;
               END
               ELSE
               BEGIN
                   PREV_SHADOW_STUB^.NEXT := SHADOW_STUB^.NEXT;
                   SHADOW_STUB := PREV_SHADOW_STUB;
               END (*IF*);
           END
           ELSE
           BEGIN
               (* The twin stub chain is ok and nothing remains to be   *)
               (* done here.                                            *)
           END (*IF*);
           (*********************  End of ORDER_TWINS (1.5)  ********************)
         
           (*********************  End of ORDER_TWINS (1)  ******************)
    
           PREV_SHADOW_STUB := SHADOW_STUB;
           SHADOW_STUB :=      SHADOW_STUB^.NEXT;
      END (*WHILE*);
      (*****************  End of ORDER_TWINS (body)  *******************)
  END (*PROCEDURE ORDER_TWINS*);


  (*********************************************************************)
  (* Routine:     ANALYSE - ANALYSEr phase                             *)
  (* Purpose:     To analyse the structure of stubs and slots.         *)
  (* Interface:   Input:  CODE_STRUCT  - the structure to be analyzed. *)
  (*              Output: CODE_STRUCT  - the analyzed structure.       *)
  (*********************************************************************)
  PROCEDURE ANALYSE (VAR CODE_STRUCT: CODE_STRUCT_);

  VAR
      SHADOW_LIST:    SHADOW_LIST_;
      LIST_HEAD:      SHADOW_PTR_;
      STRING132:      STRING132_;
      LAST_SHADOW:        SHADOW_PTR_;
      STUB:               STB_PTR_;
      LOCATED:            BOOLEAN;
      SHADOW_STUB:        SHADOW_PTR_;
  CANDIDATE_TWIN:     STB_PTR_;
      SLOT:               SLT_PTR_;
  STUB_REF:           STB_PTR_;
  DUMMY_LINE:         LINE_DES_;

  BEGIN
      (*********************  ANALYSE body  ****************************)

      LIST_HEAD := NIL;

      (*************************  ANALYSE (1)  *************************)
      (** Build SHADOW_LIST from the stub chain of CODE_STRUCT. Make  **)
      (** first element of SHADOW_LIST accessible by LIST_HEAD        **)
      STUB := CODE_STRUCT.FIRST_STUB;
      IF STUB <> NIL THEN
      BEGIN
          NEW (LIST_HEAD);
          LAST_SHADOW :=                  LIST_HEAD;
          LAST_SHADOW^.NEXT :=            NIL;
          LAST_SHADOW^.STUB_POINTER :=    STUB;
          STUB :=                         STUB^.NEXT_STUB;
          WHILE STUB <> NIL DO
          BEGIN
              (*********************  ANALYSE (1.1)  ***********************)
              (** Check if STUB^.NAME is already linked in SHADOW_LIST.   **)
              (** If not, make a new entry for this stub in SHADOW_LIST   **)
              (** and update LAST_SHADOW.                                 **)
              IF SP_IS_EMPTY_STR (STUB^.NAME) THEN
                  LOCATED := FALSE
              ELSE
              BEGIN
                  SHADOW_STUB := LIST_HEAD;
                  LOCATED := FALSE;
                  WHILE (NOT LOCATED) AND (SHADOW_STUB <> NIL) DO
                  BEGIN
                      IF SP_EQ (SHADOW_STUB^.STUB_POINTER^.NAME, STUB^.NAME) THEN
                          LOCATED := TRUE;
                      SHADOW_STUB := SHADOW_STUB^.NEXT;
                  END (*WHILE*);
              END (*IF*);
              IF NOT LOCATED THEN
              BEGIN
                  NEW (LAST_SHADOW^.NEXT);
                  LAST_SHADOW :=                  LAST_SHADOW^.NEXT;
                  LAST_SHADOW^.STUB_POINTER :=    STUB;
                  LAST_SHADOW^.NEXT :=            NIL;
              END (*IF*);
              (*****************  End of ANALYSE (1.1)  ********************)
    
              STUB := STUB^.NEXT_STUB;
          END (*WHILE*);
      END (*IF*);
      (*************************  End of ANALYSE (1)  **********************)

      IF LIST_HEAD <> NIL THEN
      BEGIN
          (************************  ANALYSE (2)  **********************)
          (** Link stubs with identical names into a twin stub chain  **)
          (** using NEXT_TWIN of the stub descriptor. Start each twin **)
          (** stub chain with the stub accessible by SHADOW_LIST.     **)
          SHADOW_STUB := LIST_HEAD;
          WHILE SHADOW_STUB <> NIL DO
          BEGIN
              STUB := SHADOW_STUB^.STUB_POINTER;
              IF NOT SP_IS_EMPTY_STR(STUB^.NAME) THEN
              WHILE STUB <> NIL DO
              BEGIN
                  (*****************  ANALYSE (2.1)  *******************)
                  (** Read through the list of stubs starting with    **)
                  (** STUB and set STUB^.NEXT_TWIN if a stub with     **)
                  (** the same name as STUB^.NAME found. Let          **)
                  (** CANDIDATE_TWIN refer to this stub.              **)
                  LOCATED := FALSE;
                  CANDIDATE_TWIN := STUB^.NEXT_STUB;
                  WHILE (CANDIDATE_TWIN <> NIL) AND (NOT LOCATED)  DO
                  BEGIN
                      IF SP_EQ (STUB^.NAME, CANDIDATE_TWIN^.NAME) THEN
                      BEGIN
                          LOCATED := TRUE;
                          STUB^.NEXT_TWIN := CANDIDATE_TWIN;
                      END
                      ELSE
                          CANDIDATE_TWIN := CANDIDATE_TWIN^.NEXT_STUB;
                  END (*WHILE*);
                  (*************  End of ANALYSE (2.1)  ****************)
        
                  STUB := CANDIDATE_TWIN;
              END (*WHILE*);
              SHADOW_STUB := SHADOW_STUB^.NEXT;
          END (*WHILE*);
          (*********************  End of ANALYSE (2)  ******************)

          (*********************  ANALYSE (3)  *************************)
          (** Reorder the twin stub chain by using the options of     **)
          (** the stub. SHADOW_LIST.STUB_POINTER must always refer to **)
          (** the first stub of the twin stub chain.                  **)
        
          ORDER_TWINS (SHADOW_LIST, CODE_STRUCT, LIST_HEAD);
        
          (*****************  End of ANALYSE (3)  **********************)

          (*********************  ANALYSE (4)  *************************)
          (** Update the field STUB_REF of the slots in the structure **)
          (** by searching a stub with the same name as the slot in   **)
          (** the structure. Use SHADOW_LIST to access the stubs.     **)
          (** Check if the option SLOT^.OPTIONS.MULTIPLE is used      **)
          (** correctly. Use SLOT^.SRC_IMG for diagnostics.           **)
          STUB := CODE_STRUCT.FIRST_STUB;
          WHILE STUB <> NIL DO
          BEGIN
              SLOT := STUB^.SLOTS;
              WHILE SLOT <> NIL DO
              BEGIN
                  (*****************  ANALYSE (4.1)  *******************)
                  (** Use SHADOW_LIST to search a stub with the same  **)
                  (** name as SLOT^.NAME and update SLOT^.STUB_REF if **)
                  (** such a stub is found. SLOT^.SRC_IMG serves for  **)
                  (** a diagnostic if multiple stubs are used in a    **)
                  (** slot without the MULTIPLE-option                **)
                  LOCATED := FALSE;
                  SHADOW_STUB := LIST_HEAD;
                  WHILE (SHADOW_STUB <> NIL)              AND
                        (NOT LOCATED)                     AND
                        (NOT SP_IS_EMPTY_STR(SLOT^.NAME)) DO
                  BEGIN
                      STUB_REF := SHADOW_STUB^.STUB_POINTER;
                      IF SP_EQ (STUB_REF^.NAME, SLOT^.NAME) THEN
                      BEGIN
                          LOCATED := TRUE;
                          SLOT^.STUB_REF := STUB_REF;
                          IF NOT SLOT^.OPTIONS.MULTIPLE THEN
                          BEGIN
                              IF STUB_REF^.NEXT_TWIN <> NIL THEN
                              BEGIN
                                  STRING132.LENGTH := 0;
                                  STRING132.BODY := EMPTY_STRING_FIXED;
                                  FT_INIT_LINE (DUMMY_LINE);
                                  DIAG (ERR, 'ANALYSE (4.1)            ', DUMMY_LINE,
                                              SLOT^.SRC_IMG, STRING132);
                                  SLOT^.OPTIONS.MULTIPLE := TRUE;
                              END (*IF*);
                          END (*IF*);
                      END
                      ELSE
                          SHADOW_STUB := SHADOW_STUB^.NEXT;
                  END (*WHILE*);
                  (*************  End of ANALYSE (4.1)  ****************)
        
                  SLOT := SLOT^.NEXT_SLOT;
              END (*WHILE*);
              STUB := STUB^.NEXT_STUB;
          END (*WHILE*);
          (*********************  End of ANALYSE (4)  ******************)

          (*********************  ANALYSE (5)  *************************)
          (** Check the resulting structure of CODE_STRUCT for        **)
          (** circularity. If circularity is detected, break the      **)
          (** responsible chain and generate a diagnostic.            **)
        
          CHECK_CIRC (CODE_STRUCT, LIST_HEAD);
        
          (*********************  End of ANALYSE (5)  ******************)
      END (*IF*)
      (*********************  End of ANALYSE body  *********************)
  END (*PROCEDURE ANALYSE*);


  (*********************************************************************)
  (* Routine:     GENMOD - MODule GENeration phase                     *)
  (* Purpose:     Generation of modules out of CODE_STRUCT.            *)
  (* Interface:   CODE_STRUCT -   Representation of the stub and slot  *)
  (*                              structure.                           *)
  (*              RUN_INFO:       User's information for this run.     *)
  (*********************************************************************)
  PROCEDURE GENMOD (CODE_STRUCT: CODE_STRUCT_; RUN_INFO: RUN_INFO_);

  VAR
      STB_PTR:            STB_PTR_;
      CONTINUE:           BOOLEAN;
      LOCATED:            BOOLEAN;
      OUT_FILE:           TEXT;
      NR_OPEN_SLOTS,
      NR_LINES,
      CORRECTION,
      INDENT:             INTEGER;
      AUX_STRING_132 :    STRING_FIXED_;
      AUX_STRING_9 :      PACKED ARRAY[1..9] OF CHAR;
      EXTRACTED:          BOOLEAN;
  CH1, CH2:   CHAR;
  I:          INTEGER;
  MODULE_NR:  INTEGER;
  ERROR_CODE:     ERROR_CODE_;
  X:              INTEGER;
  TEMP_FILE_SPEC: STRING132_;
  REAL_FILE_SPEC: FILE_SPEC_;
  DUMMY_LINE: LINE_DES_;
  STRING132:  STRING132_;

  (*************************  GENMOD routines  *************************)

  (*********************************************************************)
  (* Procedure:   BUILDER - BUILDER of module.                         *)
  (* Purpose:     Build one single module.                             *)
  (* Interface:   STUB -          Pointer to the starting point of the *)
  (*                              structure.                           *)
  (*              OUT_FILE -      File to accept the generated code.   *)
  (*              NR_OPEN_SLOTS - Number of open slots when ready.     *)
  (*              NR_LINES -      Number of generated code lines.      *)
  (*              INDENT -        Current indentation level.           *)
  (*              CORRECTION -    Correction value for indentation.    *)
  (*********************************************************************)
  PROCEDURE BUILDER (STUB:          STB_PTR_;
                    VAR OUT_FILE:   TEXT;     VAR NR_OPEN_SLOTS: INTEGER;
                    VAR NR_LINES:   INTEGER;  VAR INDENT:        INTEGER;
                    VAR CORRECTION: INTEGER);

  VAR
      PREV_INDENT:    INTEGER;
      TWIN_STUB:      STB_PTR_;
      SLOT:           SLT_PTR_;
      FIRST,
      LAST:           INTEGER;
      INFO_LINE:      LINE_DES_;
      SEG_LENGTH:     INTEGER;
      STRING132:      STRING132_;
      FILE_SPEC:      FILE_SPEC_;
      K:              INTEGER;
      DUMMY_FILE:
                      VARYING
                      [80]
                      OF CHAR;
      DUMMY:
                      VARYING
                      [132]
                      OF CHAR;

  BEGIN
      (*********************  BUILDER (body)  **************************)
      WITH STUB^ DO
      BEGIN
          CORRECTION := ST_GET_INDENT (STUB^.SRC_IMG);
          INDENT := INDENT-CORRECTION;
          IF STUB^.OPTIONS.LINENUMBER THEN
          BEGIN
              (*************************  BUILDER (1)  *********************)
              (** Use INDENT to write file specification and line number  **)
              (** of the source file from which STUB^.SRC_IMG is extrac-  **)
              (** ted to OUT_FILE.                                        **)
              ST_GET_SEG_RANGE (STUB^.SRC_IMG, FIRST, LAST);
              ST_GET_FILE_SPEC (STUB^.SRC_IMG, FILE_SPEC);
              FT_INIT_LINE (INFO_LINE);
              INFO_LINE.INDENT := ST_GET_INDENT (STUB^.SRC_IMG);            (* !!! *)
              DUMMY_FILE := '';
              FOR K := 1 TO FILE_SPEC.LENGTH DO
                  DUMMY_FILE := DUMMY_FILE + FILE_SPEC.BODY[K];
              DUMMY := '';
              WRITE (DUMMY, '(** Line: ', FIRST:1, '   File: ',
                                                       DUMMY_FILE); (* ISO vreemd  *)
              SEG_LENGTH := ST_SEG_WIDTH (STUB^.SRC_IMG);
              FOR K := LENGTH(DUMMY) TO (SEG_LENGTH - 4) DO
                  DUMMY := DUMMY + ' ';
              DUMMY := DUMMY + '**)';
              FOR K := 1 TO LENGTH(DUMMY) DO
                  INFO_LINE.CHARS[K] := DUMMY[K];                           (* !!! *)
              INFO_LINE.USED :=  LENGTH(DUMMY);                             (* !!! *)
              SP_EXTR_STR (STUB^.OPTIONS.INDENT, STRING132);
              IF (STRING132.BODY[1] = 'O') AND (STRING132.BODY[2] = 'N') THEN
                  FT_WRLN (INFO_LINE, INDENT,1)
              ELSE
                  FT_WRLN (INFO_LINE, 0, 1);
              (*********************  End of BUILDER (1)  ******************)
    
              NR_LINES := NR_LINES+1;
           END (*IF*);
    
          (*************************  BUILDER (2)  *************************)
          (** Use OPTIONS.COMMENT to decide if STUB^.SRC_IMG needs to be  **)
          (** written to OUT_FILE. If so, then increase NR_LINES accor-   **)
          (** dingly and use INDENT to position the segment.              **)
          SP_EXTR_STR (STUB^.OPTIONS.COMMENT, STRING132);
          IF (STRING132.BODY[1] = 'O') AND (STRING132.BODY[2] = 'N') THEN
          BEGIN
              SP_EXTR_STR (STUB^.OPTIONS.INDENT, STRING132);
              IF (STRING132.BODY[1] = 'O') AND (STRING132.BODY[2] = 'N') THEN
                  ST_WRITE_SEG (STUB^.SRC_IMG,INDENT,1)
              ELSE
                  ST_WRITE_SEG (STUB^.SRC_IMG,0,1);
              NR_LINES := NR_LINES + ST_NUMBER_OF_LINES (STUB^.SRC_IMG);
          END (*IF*);
          (*********************  End of BUILDER (2)  **********************)
    
          SLOT := STUB^.SLOTS;
          WHILE SLOT <> NIL DO
          BEGIN
              (*************************  BUILDER (3)  *********************)
              (** SLOT inherits the options INDENT and COMMENT from STUB  **)
              (** when they are not redefined. SLOT also inherits STUB^.- **)
              (** OPTIONS.LINENUMBER.                                     **)
              IF SP_IS_EMPTY_STR (SLOT^.OPTIONS.INDENT) THEN
                  SLOT^.OPTIONS.INDENT := STUB^.OPTIONS.INDENT;
              IF SP_IS_EMPTY_STR (SLOT^.OPTIONS.COMMENT) THEN
                  SLOT^.OPTIONS.COMMENT := STUB^.OPTIONS.COMMENT;
              SLOT^.OPTIONS.LINENUMBER := STUB^.OPTIONS.LINENUMBER;
              (*********************  End of BUILDER (3)  ******************)
    
              IF SLOT^.STUB_REF = NIL THEN
              BEGIN
                  (*********************  BUILDER (4)  *********************)
                  (** SLOT has no reference to a stub. Write segments     **)
                  (** SLOT^.SRC_IMG and SLOT^.CODE to OUT_FILE using      **)
                  (** COMMENT and INDENT. Update NR_LINES accodingly.     **)
                  WITH SLOT^ DO
                  BEGIN
                      SP_EXTR_STR (STUB^.OPTIONS.COMMENT, STRING132);
                      IF (STRING132.BODY[1] = 'O') AND (STRING132.BODY[2] = 'N') THEN
                      BEGIN
                          SP_EXTR_STR (SLOT^.OPTIONS.INDENT, STRING132);
                          IF (STRING132.BODY[1] = 'O') AND (STRING132.BODY[2] = 'N') THEN
                              ST_WRITE_SEG (SLOT^.SRC_IMG,INDENT,1)
                          ELSE
                              ST_WRITE_SEG (SLOT^.SRC_IMG, 0, 1);
                          NR_LINES := NR_LINES + ST_NUMBER_OF_LINES (SLOT^.SRC_IMG);
                      END (*IF*);
                      SP_EXTR_STR (SLOT^.OPTIONS.INDENT, STRING132);
                      IF (STRING132.BODY[1] = 'O') AND (STRING132.BODY[2] = 'N') THEN
                          ST_WRITE_SEG (CODE,INDENT,1)
                      ELSE
                          ST_WRITE_SEG (CODE, 0, 1);
                      NR_LINES := NR_LINES + ST_NUMBER_OF_LINES (SLOT^.CODE);
                  END(*WITH*);
                  (*****************  End of BUILDER (4)  ******************)
    
                  IF (SLOT^.NEXT_SLOT <> NIL)          AND
                     (NOT SP_IS_EMPTY_STR(SLOT^.NAME)) AND
                     (NOT SLOT^.OPTIONS.OPTIONAL)          THEN
                  BEGIN
                      IF NR_OPEN_SLOTS = 0 THEN
                      BEGIN
                          WRITELN ('The following open slots are found:');
                          WRITELN;
    
                          IF REPORT_OK THEN
                          BEGIN
                              WRITELN (REPORT_FILE,
                                      'The following open slots are found:');
                              WRITELN (REPORT_FILE);
                          END (*IF*);
                      END (*IF*);
    
                      (* Write slot to terminal and to output file.    *)
                      ST_WRITE_SEG (SLOT^.SRC_IMG, INDENT, 0);
                      WRITELN;
    
                      IF REPORT_OK THEN
                      BEGIN
                          ST_WRITE_SEG (SLOT^.SRC_IMG, INDENT, 3);
                          WRITELN (REPORT_FILE);
                      END (*IF*);
    
                      NR_OPEN_SLOTS := NR_OPEN_SLOTS+1;
                  END (*IF*);
              END
              ELSE
              BEGIN
                  (*********************  BUILDER (5)  *********************)
                  (** SLOT^.STUB_REF inherits the options INDENT and      **)
                  (** COMMENT from SLOT if they are not redefined by      **)
                  (** SLOT^.STUB_REF. SLOT^.STUB_REF also inherits        **)
                  (** LINENUMBER from SLOT.                               **)
                  IF SP_IS_EMPTY_STR (SLOT^.STUB_REF^.OPTIONS.INDENT) THEN
                      SLOT^.STUB_REF^.OPTIONS.INDENT := SLOT^.OPTIONS.INDENT;
                  IF SP_IS_EMPTY_STR (SLOT^.STUB_REF^.OPTIONS.COMMENT) THEN
                      SLOT^.STUB_REF^.OPTIONS.COMMENT := SLOT^.OPTIONS.COMMENT;
                  SLOT^.STUB_REF^.OPTIONS.LINENUMBER := SLOT^.OPTIONS.LINENUMBER;
                  (*****************  End of BUILDER (5)  ******************)
    
                  PREV_INDENT := INDENT;
                  INDENT := INDENT + ST_GET_INDENT (SLOT^.SRC_IMG);
                  BUILDER (SLOT^.STUB_REF, OUT_FILE, NR_OPEN_SLOTS,
                                           NR_LINES, INDENT, CORRECTION);
                  TWIN_STUB := SLOT^.STUB_REF^.NEXT_TWIN;
                  WHILE TWIN_STUB <> NIL DO
                  BEGIN
                      (*********************  BUILDER (6)  *****************)
                      (** TWIN_STUB inherits INDENT and COMMENT from      **)
                      (** SLOT when they are not redefined locally. In    **)
                      (** addition TWIN_STUB inherits LINENUMBER from     **)
                      (** SLOT.                                           **)
                      IF SP_IS_EMPTY_STR (TWIN_STUB^.OPTIONS.INDENT) THEN
                          TWIN_STUB^.OPTIONS.INDENT := SLOT^.OPTIONS.INDENT;
                      IF SP_IS_EMPTY_STR (TWIN_STUB^.OPTIONS.COMMENT) THEN
                          TWIN_STUB^.OPTIONS.COMMENT := SLOT^.OPTIONS.COMMENT;
                      TWIN_STUB^.OPTIONS.LINENUMBER := SLOT^.OPTIONS.LINENUMBER;
                      (*****************  End of BUILDER (6)  **************)
    
                      INDENT := ST_GET_INDENT (SLOT^.SRC_IMG);
                      BUILDER (TWIN_STUB, OUT_FILE, NR_OPEN_SLOTS,
                                          NR_LINES, INDENT, CORRECTION);
                      TWIN_STUB := TWIN_STUB^.NEXT_TWIN;
                  END (*WHILE*);
                  INDENT := PREV_INDENT;
    
                  (*********************  BUILDER (7)  *********************)
                  (** Write the segment SLOT^.CODE to OUT_FILE using the  **)
                  (** option SLOT^.INDENT.                                **)
                  SP_EXTR_STR (SLOT^.OPTIONS.INDENT, STRING132);
                  IF (STRING132.BODY[1] = 'O') AND
                     (STRING132.BODY[2] = 'F') AND
                     (STRING132.BODY[3] = 'F')     THEN
                      ST_WRITE_SEG (SLOT^.CODE, 0, 1)
                  ELSE
                      ST_WRITE_SEG (SLOT^.CODE,INDENT,1);
                  (*****************  End of BUILDER (7)  ******************)
    
                  NR_LINES := NR_LINES + ST_NUMBER_OF_LINES (SLOT^.CODE);
              END (*IF*);
              SLOT := SLOT^.NEXT_SLOT;
          END (*WHILE*);
      END (*WITH*);
      (*********************  End of BUILDER (body)  *******************)
  END (*PROCEDURE BUILDER*);

  (*********************  End of GENMOD routines  **********************)

  BEGIN
      (*********************  GENMOD (body)  ***************************)
      AUX_STRING_9 := 'EXTRACTED';
      AUX_STRING_132 := EMPTY_STRING_FIXED;
      FOR I:= 1 TO 9 DO
          AUX_STRING_132[I] := AUX_STRING_9[I];
      IF (RUN_INFO.EXTR_MODE <> AUX_STRING_132) THEN
          EXTRACTED := FALSE
      ELSE
          EXTRACTED := TRUE;
    
      STB_PTR := CODE_STRUCT.FIRST_STUB;
      WHILE STB_PTR <> NIL DO
      BEGIN
          LOCATED := FALSE;
          WHILE (STB_PTR <> NIL) AND (NOT LOCATED) DO
          BEGIN
              (*************************  GENMOD (1)  **********************)
              (** If STB_PTR refers to a main stub then use RUN_INFO to   **)
              (** check if the  module is desired by the user. Raise      **)
              (** LOCATED if this happens to be the case.                 **)
              WITH STB_PTR^ DO
              BEGIN
                  IF NOT SP_IS_EMPTY_STR (OPTIONS.FILE_NAME) THEN
                  BEGIN
                      (*********************  GENMOD (1.1)  ************************)
                      (** Use RUN_INFO to check if OPTIONS.FILE_NAME indicates a  **)
                      (** module that is wanted by the user. Raise LOCATED if     **)
                      (** this is the case. Default the options COMMENT and       **)
                      (** INDENT it they have not been set explictely.            **)
                      WITH RUN_INFO DO
                      BEGIN
                          CH1 := 'O';
                          CH2 := 'N';
                          IF SP_IS_EMPTY_STR (OPTIONS.INDENT) THEN
                          BEGIN
                              SP_ADD_CHAR (CH1,OPTIONS.INDENT);
                              SP_ADD_CHAR (CH2,OPTIONS.INDENT);
                          END (*IF*);
                          IF SP_IS_EMPTY_STR (OPTIONS.COMMENT) THEN
                          BEGIN
                              SP_ADD_CHAR (CH1,OPTIONS.COMMENT);
                              SP_ADD_CHAR (CH2,OPTIONS.COMMENT);
                          END (*IF*);
                          SP_EXTR_STR (STB_PTR^.OPTIONS.FILE_NAME, TEMP_FILE_SPEC);
                          LOCATED := FALSE;
                          FOR X := 1 TO RUN_INFO.NR_MODULES DO
                          BEGIN
                              IF TEMP_FILE_SPEC.BODY=
                                          RUN_INFO.RSLT_MODULES[X].FILE_NAME.BODY THEN
                              BEGIN
                                  LOCATED := TRUE;
                                  MODULE_NR := X;
                              END (*IF*);
                          END (*FOR*);
                    
                          (* Use the value of EXTRACTED to decide *)
                          (* whether the module is wanted or not. *)
                          IF EXTRACTED = FALSE THEN LOCATED := NOT LOCATED;
                      END (*WITH*);
                      (*****************  End of GENMOD (1.1)  *********************)
                  END (*IF*);
              END (*WITH*);
              (*********************  End of GENMOD (1)  *******************)
    
              IF NOT LOCATED THEN
                  STB_PTR := STB_PTR^.NEXT_STUB;
          END (*WHILE*);
          IF LOCATED THEN
          BEGIN
              CONTINUE := TRUE;
    
              (*************************  GENMOD (2)  **********************)
              (** Open OUT_FILE with a name specified by this main stub.  **)
              (** Set CONTINUE to FALSE if there is a problem. STB_PTR^.- **)
              (** OPTIONS.FILE_NAME caused the problem and displayed as   **)
              (** part of an error message.                               **)
            
              SP_EXTR_STR (STB_PTR^.OPTIONS.FILE_NAME, TEMP_FILE_SPEC);
            
              (* The type of TEMP_FILE_SPEC is not suitable for the File Table     *)
              (* routine which opens files. It is converted to a REAL_FILE_SPEC.   *)
            
              REAL_FILE_SPEC.BODY := EMPTY_STRING_FIXED;
              REAL_FILE_SPEC.LENGTH := 0;
            
              IF EXTRACTED THEN
              BEGIN
                  FOR I:= 1 TO RUN_INFO.RSLT_MODULES[MODULE_NR].PATH.LENGTH DO
                      REAL_FILE_SPEC.BODY[I] :=
                          RUN_INFO.RSLT_MODULES[MODULE_NR].PATH.BODY[I];
                  REAL_FILE_SPEC.LENGTH := RUN_INFO.RSLT_MODULES[MODULE_NR].PATH.LENGTH;
              END
              ELSE
              BEGIN
                  FOR I:= 1 TO RUN_INFO.MODULE_DIRECTORY.LENGTH DO
                      REAL_FILE_SPEC.BODY[I] := RUN_INFO.MODULE_DIRECTORY.BODY[I];
                  REAL_FILE_SPEC.LENGTH := RUN_INFO.MODULE_DIRECTORY.LENGTH;
              END; (*IF*)
            
              X := REAL_FILE_SPEC.LENGTH;
              I := 1;
              WHILE I <= TEMP_FILE_SPEC.LENGTH DO
              BEGIN
                  X:=X+1;
                  REAL_FILE_SPEC.BODY[X] := TEMP_FILE_SPEC.BODY[I];
                  I:=I+1;
              END (*WHILE*);
              REAL_FILE_SPEC.LENGTH := X;
            
              ERROR_CODE := FT_OUTOPEN (REAL_FILE_SPEC);
              IF ERROR_CODE > 0 THEN
              BEGIN
                  CONTINUE := FALSE;
            
                  (*********************  GENMOD (2.1)  ****************************)
                  (** Use STB_PTR^.OPTIONS.FILE_NAME and the returned ERROR_CODE  **)
                  (** to generate an error message.                               **)
                  FT_INIT_LINE (DUMMY_LINE);
                  SP_EXTR_STR (STB_PTR^.OPTIONS.FILE_NAME, STRING132);
                  DIAG (ERR, 'GENMOD (2.1)             ', DUMMY_LINE,
                        STB_PTR^.SRC_IMG, STRING132);
                  (*********************  End of GENMOD (2.1)  *********************)
              END (*IF*);
              (*********************  End of GENMOD (2)  *******************)
    
              IF CONTINUE THEN
              BEGIN
                  NR_OPEN_SLOTS := 0;
                  NR_LINES := 0;
    
                  (*********************  GENMOD (3)  **********************)
                  (** Generate the module indicated by STB_PTR into       **)
                  (** OUT_FILE. NR_OPEN_SLOTS and NR_LINES are maintained **)
                  (** as statistical data.                                **)
                  WRITE ('Generating file:  ');
                  FOR X := 1 TO REAL_FILE_SPEC.LENGTH DO
                      WRITE (REAL_FILE_SPEC.BODY[X]);
                  WRITELN;
                
                  IF REPORT_OK THEN
                  BEGIN
                      WRITE (REPORT_FILE, 'Generating file:  ');
                      FOR X := 1 TO REAL_FILE_SPEC.LENGTH DO
                          WRITE (REPORT_FILE, REAL_FILE_SPEC.BODY[X]);
                      WRITELN (REPORT_FILE);
                  END (*IF*);
                
                  INDENT :=        ST_GET_INDENT (STB_PTR^.SRC_IMG);
                  CORRECTION :=    0;
                  NR_LINES :=      0;
                  NR_OPEN_SLOTS := 0;
                  BUILDER (STB_PTR, OUT_FILE, NR_OPEN_SLOTS, NR_LINES,
                                                             INDENT, CORRECTION);
                  (*******************  End of GENMOD (3)  *****************)
    
                  WRITELN ('Number of open slots in this module: ',
                            NR_OPEN_SLOTS:1);
                  WRITELN ('Number of generated lines:  ',NR_LINES:1);
    
                  WRITELN ('------------------------------------',
                           '------------------------------------');
                  WRITELN;
    
                  IF REPORT_OK THEN
                  BEGIN
                      WRITELN (REPORT_FILE, 'Number of open slots',
                                       ' in this module: ', NR_OPEN_SLOTS:1);
                      WRITELN (REPORT_FILE, 'Number of generated lines:  '
                                                                ,NR_LINES:1);
                      WRITELN (REPORT_FILE,
                               '------------------------------------',
                               '------------------------------------');
                      WRITELN (REPORT_FILE);
                  END (*IF*);
    
                  (*********************  GENMOD (4)  **********************)
                  (** Close OUT_FILE. Generate an error message in case   **)
                  (** of trouble.                                         **)
                  ERROR_CODE := FT_OUTCLOSE;
                  IF ERROR_CODE <> 0 THEN
                  BEGIN
                      (*************************  GENMOD (4.1)  ************************)
                      (** Use STB_PTR^.OPTIONS.FILE_NAME and STB_PTR^.SRC_IMG to      **)
                      (** generate a diagnostic message.                              **)
                      FT_INIT_LINE (DUMMY_LINE);
                      SP_EXTR_STR (STB_PTR^.OPTIONS.FILE_NAME, STRING132);
                      DIAG (ERR, 'GENMOD (4.1)             ', DUMMY_LINE,
                            STB_PTR^.SRC_IMG, STRING132);
                      (*********************  End of GENMOD (4.1)  *********************)
                  END(*IF*);
                  (*****************  End of GENMOD (4)  *******************)
              END (*IF*);
              STB_PTR := STB_PTR^.NEXT_STUB;
          END (*IF*);
      END (*WHILE*);
      (*********************  End of GENMOD (body)  ********************)

  END (*GENMOD*);



  BEGIN
      (*******                CLIP_2 (body)                      *******)
      CONTINUE := TRUE;
    
      (*****************************  CLIP_2 (1)  **************************)
      (** Read the contents of CLIP.INI into RUN_INFO. Set CONTINUE to    **)
      (** FALSE in case of trouble.                                       **)
      EXT_FILE_SPEC.BODY := EMPTY_STRING_FIXED;
      AUX_STRING_8 := DFLT_INIFILE;
      FOR I := 1 TO 8 DO
          EXT_FILE_SPEC.BODY[I] := AUX_STRING_8[I];
      EXT_FILE_SPEC.LENGTH := 8;
      EXT_FILE_PREP (INI_FILE, EXT_FILE_SPEC, INSP_MODE, DUMMY_FILE_OK,
                     ERROR_CODE, DUMMY_ERROR_MSG);
      IF ERROR_CODE > 0 THEN
      BEGIN
          WRITELN ('The initializationfile could not be read succesfully.');
          CONTINUE := FALSE;
      END
      ELSE
      BEGIN                                              (* EWvA: 16/10/93 *)
          EXT_FILE_CLOSE (INI_FILE, DUMMY_ERROR_CODE);   (* EWvA: 16/10/93 *)
          READ_INI_FILE (INI_FILE, RUN_INFO, EXT_FILE_SPEC, DUMMY_FILE_OK,
                         DUMMY_ERROR_MSG, DUMMY_ERROR_CODE);
      END (* IF *);                                      (* EWvA: 16/10/93 *)
      (*************************  End of CLIP_2 (1)  ***********************)
    
      IF CONTINUE THEN
      BEGIN
          (*************************  CLIP_2 (2)  **************************)
          (** Initialize CODE_STRUCT and the hidden variables of FT, ST,  **)
          (** SP, SCN_LINE, SCN_OPTS and DIAG_TBL.                        **)
          FT_INIT;
          ST_INIT;
          SP_INIT;
          SCN_LINE_INIT;
          SCN_OPTS_INIT;
          DIAGNOST_INIT;
          CODE_STRUCT.LAST_STUB  := NIL;
          CODE_STRUCT.FIRST_STUB := NIL;
          (*********************  End of CLIP_2 (2)  ***********************)
    
          (*************************  CLIP_2 (3)  **************************)
          (** Prepare a REPORT_FILE file from RUN_INFO.REPORT_FILE_SPEC   **)
          (** and raise REPORT_OK if this succeeded.                      **)
                                       (* Modified by EWvA on 16/10/93     *)
          IF (RUN_INFO.REPORT_FILE_SPEC.BODY <> EMPTY_STRING_FIXED)   AND
             (RUN_INFO.MESSAGE_DESTINATION[1] IN ['R','r','F','f','B','b'])
                                       (* End of modification dd. 16/10/93 *)
          THEN
          BEGIN
              EXT_FILE_PREP (REPORT_FILE, RUN_INFO.REPORT_FILE_SPEC, GEN_MODE,
                             REPORT_OK, ERROR_CODE, ERROR_MSG);
              IF ERROR_CODE <> 0 THEN
              BEGIN
                  WRITELN (OUTPUT, ERROR_MSG);
                  WRITELN (OUTPUT, 'Continue without report file...');
                  WRITELN;
                  REPORT_OK := FALSE;
              END
              ELSE
                  REPORT_OK := TRUE;
          END
          ELSE                                          (* EWvA: 16/10/93 *)
              REPORT_OK := FALSE;                       (* EWvA: 16/10/93 *)
          (*****************  End of DIAGNOST_EXIT (2)  ********************)
    
          START := CLOCK;
          STOP := START;
    
          (*************************  CLIP_2 (4)  **************************)
          (** Scan the source files as specified in RUN_INFO and build    **)
          (** the structure of stubs and slots CODE_STRUCT. LPT_FILE_OK   **)
          (** decides if info for the terminal is copied to REPORT_FILE.  **)
          WRITELN;
          WRITELN ('============================ ', CLIP_VERSION,
                   ' ==========================');
          WRITELN;
          WRITELN ('============================ Busy scanning ',
                   '=============================');
          IF REPORT_OK THEN
          BEGIN
              WRITELN (REPORT_FILE);
              WRITELN (REPORT_FILE,
                       '============================ ', CLIP_VERSION,
                       ' ==========================');
              WRITELN (REPORT_FILE);
              WRITELN (REPORT_FILE,
                       '============================ Busy scanning ',
                       '=============================');
          END (*IF*);
        
          SCAN_FILES (CODE_STRUCT, RUN_INFO);
        
          WRITELN ('============================ End scanning ',
                   '==============================');
          WRITELN;
          IF REPORT_OK THEN
          BEGIN
              WRITELN (REPORT_FILE);
              WRITELN (REPORT_FILE,
                       '============================ End scanning ',
                       '==============================');
          END (*IF*);
          (*********************  End of  CLIP_2 (4)  **********************)
    
          IF CODE_STRUCT.FIRST_STUB <> NIL THEN
          BEGIN
              (*************************  CLIP_2 (5)  **********************)
              (** Analyse CODE_STRUCT. LPT_FILE_OK decides if info to the **)
              (** terminal is copied to REPORT_FILE also.                 **)
              WRITELN ('============================ Busy analysing ',
                       '============================');
              IF REPORT_OK THEN
              BEGIN
                  WRITELN (REPORT_FILE);
                  WRITELN (REPORT_FILE,
                           '============================ Busy analysing ',
                           '============================');
              END (*IF*);
            
              ANALYSE (CODE_STRUCT);
            
              WRITELN ('============================ End analysing ',
                       '=============================');
              WRITELN;
              IF REPORT_OK THEN
              BEGIN
                  WRITELN (REPORT_FILE);
                  WRITELN (REPORT_FILE,
                           '============================ End analysing ',
                           '=============================');
              END (*IF*);
              (*********************  End of CLIP_2 (5)  *******************)
    
              (*************************  CLIP_2 (6)  **********************)
              (** Generate the modules as specified in RUN_INFO out of    **)
              (** CODE_STRUCT. LPT_FILE_OK decides if info for terminal   **)
              (** is also copied to REPORT_FILE.                          **)
              WRITELN ('============================ Busy generating ',
                       '===========================');
              IF REPORT_OK THEN
              BEGIN
                  WRITELN (REPORT_FILE);
                  WRITELN (REPORT_FILE,
                           '============================ Busy generating ',
                           '===========================');
              END (*IF*);
            
              GENMOD (CODE_STRUCT, RUN_INFO);
            
              WRITELN ('============================ End generating ',
                       '============================');
              WRITELN;
              IF REPORT_OK THEN
              BEGIN
                  WRITELN (REPORT_FILE);
                  WRITELN (REPORT_FILE,
                           '============================ End generating ',
                           '============================');
              END (*IF*);
              (*********************  End of CLIP_2 (6)  *******************)
    
              STOP := CLOCK;
          END (*IF*);
    
      (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
              +++++++++++   EWvA, jan6, 1993: Report file   ++++++++++++
          FT_INIT_LINE (DUMMY_LINE);
          ST_INIT_SEG (DUMMY_SEG);
          STRING132.LENGTH := 0;
          STRING132.BODY := EMPTY_STRING_FIXED;
          DIAG (WARN, 'CLIP_2                   ', DUMMY_LINE, DUMMY_SEG,
                STRING132);
      ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
    
      (* Generate error messages to terminal and possibly report file      *)
      DIAGNOST_EXIT;
    
          (* Delete the segment-table.                                 *)
          ST_FINIT;
    
          (* Display a goodbye message.                                *)
          WRITELN ('Used (CPU) time :', (STOP-START)/1000:4:2, ' Sec.');
          WRITELN ('See you next time !');
    
          IF REPORT_OK THEN
          BEGIN
              WRITELN (REPORT_FILE, 'Used (CPU) time :',
                                             (STOP-START)/1000:4:2, ' Sec.');
              WRITELN (REPORT_FILE, 'See you next time !');
              EXT_FILE_CLOSE (REPORT_FILE, DUMMY_ERROR);
          END (*FI*);
      END (*IF*);
      (*********************  End of CLIP_2 (body)  ********************)
  END (*CLIP_2*).
  (*******************  End of module clip_unix.pas  *******************)