PROCEDURE MakeInternalLBDR(EntryPoint : St_Address;
                               LineTable  : integer;
                               GlobalSize : Word;
                               Appetite   : Word);
      (* The procedure makes a Internal LBDR *)
 
      VAR
        LBDR : TypeExternalLBDR;
        i    : integer;


      BEGIN
          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' START','  MakeInternalLBDR');
          (*ENDTEST#*)

        PutCodeBuffer(0);
        PutCodeBuffer(Ord(InternalLBDR));
        
        (* Put entry point *)

        WordByte.w := EntryPoint.Va_Low;
        PutCodeBuffer(WordByte.Byte1);
        PutCodeBuffer(WordByte.Byte2);
        WordByte.w := EntryPoint.Va_High;
        PutCodeBuffer(WordByte.Byte1);
        PutCodeBuffer(WordByte.Byte2);         


        (* Put LineTable *)
        LBDR.LineTable := LineTable;



        (* Put GlobalSize *)
        LBDR.GlobalSize := GlobalSize;




        IF (Appetite MOD 16) = 0 THEN LBDR.Appetite := Appetite DIV 16
                                 ELSE LBDR.Appetite := (Appetite DIV 16) + 1;
          (* Appetite is transfere to paragrahps *)
 
        FOR i := 1 TO LengthOfInternalLBDR
          DO
            BEGIN
              PutCodeBuffer( LBDR.Byt[i]);
            END;


        IF ( InternalOffset > (Max_Word - LengthOfInternalLBDR)) THEN Fatal_Error(Pass4,4);
        InternalOffset := InternalOffset + LengthOfInternalLBDR;


          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' SLUT','  MakeInternalLBDR ');
          (*ENDTEST#*)
      END; (* MakeInternalLBDR *)




    (* --------------------------------------------------- *)


    PROCEDURE MakeExternalLBDR(SymbolPoint : St_Address;
                               EntryPoint : St_Address;
                               LineTable : integer;
                               GlobalSize : Word;
                               Appetite : Word;
                               BlName : SpixRange;
                               BlKind : integer);
      (* The procedure makes a external LBDR *)
 
      VAR
        LBDR : TypeExternalLBDR;
        i : integer;
        Str : Ptr_String;
        ch : char;

      BEGIN
          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' START','  MakeExternalLBDR');
          (*ENDTEST#*)

        PutCodeBuffer(0);
        PutCodeBuffer(ord(ExternalLBDR));
        
        (* Put entry point *)

        WordByte.w := EntryPoint.Va_Low;
        PutCodeBuffer(WordByte.Byte1);
        PutCodeBuffer(WordByte.Byte2);
        WordByte.w := EntryPoint.Va_High;
        PutCodeBuffer(WordByte.Byte1);
        PutCodeBuffer(WordByte.Byte2);

        (* Put LineTable *)
        LBDR.LineTable := LineTable;



        (* Put GlobalSize *)
        LBDR.GlobalSize := GlobalSize;



        IF (Appetite MOD 16) = 0 THEN LBDR.Appetite := Appetite DIV 16
                                 ELSE LBDR.Appetite := (Appetite DIV 16) + 1;
          (* Appetite is transfere to paragrahps *)
 



        LBDR.LinkCount := 0;
        LBDR.Next1 := 0;
        LBDR.Next2 := 0;


       
        (* Put BlName   *)
        St_NameOfSpix(BlName,Str);
        (*IF Str^.length <= 12 THEN LBDR.BlName.Length := Str^.Length
                             ELSE LBDR.BlName.Length := 12;*)

        (* TURBO *)
        LBDR.BlName := Str^;

        FOR i := 1 TO length(LBDR.BlName) DO
          BEGIN
            (* transform small letters to great letters *)
            Ch := Str^[i];
            IF (( ord('a') <= ord(ch) ) AND (ord(ch) <= ord('z')))
              THEN Ch := CHR(ord(ch) - ord('a') + ord('A'));

            LBDR.BlName[i] := Ch;
          END;


        FOR i := length(LBDR.BlName) + 1 TO 12 DO
          LBDR.BLName[i] := ' ';




        (* Put BlKind *)
        LBDR.BlKind := BlKind;


        FOR i := 1 TO LengthOfExternalLBDR
          DO
            BEGIN
              CodeBuffer[BufferIndex] := LBDR.Byt[i];
              BufferIndex := (BufferIndex + 1) MOD LengthOfCodeBuffer;;
            END;

        NoBytesInBuffer := NoBytesInBuffer + LengthOfExternalLBDR;
        InternalOffset := LengthOfExternalLBDR;


          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' SLUT','  MakeExternalLBDR ');
          (*ENDTEST#*)
      END; (* MakeExternalLBDR *)



   (* -------------------------------------------------------------- *)


    PROCEDURE MakeProgramDesc(ProgOffset : Word; ProgState : State;
                              PoolParam : boolean; lab : St_Address);
      (* The procedure generate code to make the program describtion at 
         address 'Addr'. This procedure has to be change if the pi3 type
         programdescribtion is change *)

      VAR
        Str   : Ptr_String;
        Ch    : Char;
        Str12 : String[12];
        i     : integer;

      BEGIN

          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' START','  MakeProgramDesc ');
          (*ENDTEST#*)

        IF ProgState = Internal THEN
          (* Make the buffer empty *)
          MakeFreeCodeBuffer(LengthOfCodeBuffer);




        (* Generate code to push the parameter to init_internal or
           init_external  *)

        CodeReg(iPUSH,w,DS);
        
        CodeRegConst(iMOV,w,AX,ProgOffset);
        CodeReg(iPUSH,w,AX);

        CodeRegConst(iMOV,w,AX,ord(PoolParam));
        CodeReg(iPUSH,w,AX);

        IF ProgState = Internal THEN
          BEGIN
            CodeReg(iPUSH,w,CS);
            CodeRegConst(iMOV,w,AX,LastInternalLBDROffset);
            CodeReg(iPUSH,w,AX);

            (* push a pointer to the name *)
            CodeReg(iPUSH,w,CS);
            CodeLoadEffAddr(AX,Lab,0);  
            CodeReg(iPUSH,w,AX);




            CallRoutine(AnonymousSpix,Init_Internal,St_extern);
          END
        ELSE
          CallRoutine(AnonymousSpix,Init_External,St_Extern);


        

          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' START','  MakeProgramDesc ');
          (*ENDTEST#*)
      END; (* MakeProgramDesc *)

  (* ------------------------------------------------------------- *)




    PROCEDURE StopBlock;
      (* The procedure is called when there is no more code for
         the block. The procedure makes the <Object Block> for the block
         That is the secound pass is made *)

      BEGIN  (* StopBlock *)

        DumpFaultThunk;
        InitFaultInfo;

        MakeFreeCodeBuffer(LengthOfCodeBuffer);

        EmptyFileBuffer;

        (* Make <object block > for the block *)

        reset(TBinFile,1);
        IF Make_Code THEN reset(TSymFile);



        MakePass4_2(FileOffset);



        (* Make ready to the next block *)


        rewrite(TBinFile,1);
        IF Make_Code THEN rewrite(TSymFile);


        InternalOffset := 0;
        FileOffset := 0;

        LastJmpOffset := 0;
        LastLabelOffset := 0;

        LengthOfAllExtName := 0;
        NoExtDecl := 0;
        FirstExtDec := St_NillAddr;

        FirstFixUpp := St_NillAddr;
        NoFixUpp := 0;
        LastFixUpp := St_NillAddr;

        LastNameEntry := St_NillAddr;
        LengthOfNameTabel := 2;

      END;  (* StopBlock *)



 (* ---------------------------------------------------------- *)





    PROCEDURE StopCodeGene;
      (* The procedure is called when where is no more code to be
         generated. *)

      VAR step : word;
          checksum : word;

      BEGIN  (* StopCodeGene *)
          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' START','  StopCodeGene');
          (*ENDTEST#*)



          WriteEmptyRecord(Lastrc);


          (* insert segdef for segnumber 2... lastsegment *)
          For step := 2 to Last_Segment do
             BEGIN
               wordbyte.w := Segment_Info[step].Size;
               Files_Abs_Write(FilePtrToSecSegDef,WordByte.byte1);
               FilePtrToSecSegDef := FilePtrToSecSegDef + 1;
               Files_Abs_Write(FilePtrToSecSegDef,WordByte.byte2);
               FilePtrToSecSegDef := FilePtrToSecSegDef + 1;
               Checksum := ($98 + 3 + WordByte.Byte1 + WordByte.Byte2)
                          MOD MaxByte;
               CheckSum := MaxByte - CheckSum;
               Files_Abs_Write(FilePtrToSecSegDef,CheckSum);
               FilePtrToSecSegDef := FilePtrToSecSegDef + 4;
             END;


          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' SLUT','  StopCodeGene');
          (*ENDTEST#*)
      END; (* StopCodeGene *)




  (*-------------------------------------------------------- *)



    PROCEDURE GenCode(Inst : Instruction);
      (* Generate a instruction without parameter *)

      VAR
        op : Byte;

      BEGIN
          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' START','  GenCode ', ord(Inst));
          (*ENDTEST#*)

        op := OpcodeNoOpr[Inst];


        (* Put to code buffer *)
        Put1CodeFormat(op);

        (* Print to TSymFile *)
        IF CodeOn THEN writeln(TSymFile,InstructionName[Inst]);
        
          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' SLUT','  GenCode ');
          (*ENDTEST#*)
      END;  (* GenCode *)


    (* ---------------------------------------------------- *)


    PROCEDURE CodeConst(Inst : Instruction;  Value : Word );
      (* Generate a instruction with a constant parametre *)
      
      VAR
        op : Byte;

      BEGIN
          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' START','  CodeConst ', ord(Inst),' '
                                                               , Value);
          (*ENDTEST#*)

        op := OpcodeCOpr[Inst];


        IF (( Inst = iRETWS) OR ( INST = iRETIS )) THEN
          BEGIN   (* a word constant *)
            WordByte.w := Value;
            Put3CodeFormat(op,WordByte.Byte1,WordByte.Byte2);
          END
        ELSE
          BEGIN  (* a byte constant *)
            Put2CodeFormat(op,Value);
          END;

        (* Print to TSymFile *)
        IF CodeOn THEN
          BEGIN
            write(TSymFile,InstructionName[Inst]);
            writeln(TSymFile,' ',Value);
          END;

          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' SLUT','  CodeConst');
          (*ENDTEST#*)
      END; (* CodeConst *)


    (* ----------------------------------------------------*)



    PROCEDURE CodeAddr(Inst : Instruction; InstType : InstrucType;
                                          VAR a : Address);
      (* Generate a instruction with a address as parametre *)

      VAR
        op : Byte;

      BEGIN
          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' START',' CodeAddr ',ord(Inst),' ',
                                                      ord(InstType));
          (*ENDTEST#*)

        op := OpcodeR_M[Inst];
        IF ((Inst <> iPUSH) AND (Inst <> iPOP)) THEN
          op := op + ord(InstType);

        PutR_MOperand(op, a, OpcodeCRegField[Inst]);

        (* Print to TSymFile *)
        IF CodeOn THEN
          BEGIN
            write(TSymFile,InstructionName[Inst]);
            PrintAddr(a);
            writeln(TSymFile);
          END;

          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' SLUT','  CodeAddr');
          (*ENDTEST#*)
      END;  (* CodeAddr *)


    (* ---------------------------------------------------- *)


    PROCEDURE CodeReg(Inst : Instruction; InstType : InstrucType;
                                            r : Register );
      (* Generate a instruction with a register as parametre *)

      VAR
        op : Byte;
        x  : Byte;

      BEGIN
          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' START','  CodeReg ', ord(Inst),' ',
                              ord(InstType),' ', ord(r));
          (*ENDTEST#*)

        IF (( ord(ES) <= ord(r)) AND ( ord(r) <= ord(DS) )) THEN
          BEGIN  (* r is a seg register. Inst is push or pop *)
            op := OpcodeSROpr[Inst];
            PackField(op,3,ord(r) - ord(ES));

            Put1CodeFormat(op);
          END
        ELSE
          IF (( ord(iPUSH) <= ord(Inst)) AND ( ord(Inst) <= ord(iDEC))
                                        AND ( InstType <> b ))
          THEN
            BEGIN  (* Register packed into opcode *)
              op := OpcodeRegOpr[Inst];
              PackField(op, 0, RegField(r));
              
              Put1CodeFormat(op);
            END
          ELSE
            BEGIN  (* operand of R_M type *)
              op := OpcodeR_M[Inst] + ord(InstType);;

              x := RegField(r);
              PackField(x, 6, 3); (* Register mode *)
              PackField(x, 3, OpcodeCRegField[Inst]);

              Put2CodeFormat(op,x);
            END;

        (* Print to TSymFile *)
        IF CodeOn THEN
          BEGIN
            write(TSymFile, InstructionName[Inst]);
            PrintReg(r, InstType);
            IF ((InstType = vb) OR (InstType = vw)) THEN
              write(TSymFile,', CX');
            writeln(TSymFile);
          END;

          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' SLUT','  CodeReg ');
          (*ENDTEST#*)
      END; (* CodeReg *)


    (* ---------------------------------------------- *)




    PROCEDURE CodeAddrConst(Inst : Instruction; InstType : InstrucType;
                           VAR a : Address; Value : Word   );
      (* Generate a instruction with a address as the first parametre
         and a constant as the secend parametre *)

      VAR
        op : Byte;
        help : InstrucType;

      BEGIN
          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' START','  CodeAddrConst ', ord(Inst),
                                   ' ',ord(InstType), ' ',Value);
          (*ENDTEST#*)

        op := OpcodeR_MandConst[Inst] + ord(InstType);
        help := InstType;

        wordbyte.w := value;

        IF (( InstType = w ) AND (-128 <= wordbyte.i) AND (wordbyte.i <= 127)
             AND ( ord(iADD) <= ord(Inst)) AND (ord(Inst) <= ord(iCMP)))
        THEN
          BEGIN  (* sign extente *)
            PackField(op, 1, 1);
            help := b;
          END;
        
        PutR_MOprandConst(op, a, OpcodeCRegField[Inst],
                                                     help, Value);

        (* Print to TSymFile *)
        IF CodeOn THEN
          BEGIN
            write(TSymFile,InstructionName[Inst]);
            PrintAddr(a);
            write(TSymFile,',');
            writeln(TSymFile,' ',value);
          END;

          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' SLUT','  CodeAddrConst ');
          (*ENDTEST#*)
      END;  (* CodeAddrConst *)


    (* ----------------------------------------------------- *)


 

    PROCEDURE CodeAddrReg(Inst : Instruction; InstType : InstrucType;
                          VAR a : Address; r : Register );
      (* Generate a instruction with an address as first parametre
         and an register as secend parameter      *)

      VAR 
        op : Byte;

      BEGIN
          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' START','  CodeAddrReg ', ord(Inst),' ',
                                        ord(InstType),' ', ord(r));
          (*ENDTEST#*)

        IF ( (ord(ES) <= ord(r)) AND
             (ord(r) <= ord(DS)) AND
             (Inst = iMOV)) THEN
          BEGIN
            op := OpcodeMovSegToR_M;
            PutR_MOperand(op,a,ord(r) - ord(ES));
          END
        ELSE
          BEGIN
            op := OpcodeR_M[Inst] + ord(InstType);

            (* direction = 0 *)


            PutR_MOperand(op, a, RegField(r));
          END;

        (* Print to TSymFile *)
        IF CodeOn THEN
          BEGIN
            write(TSymFile, InstructionName[Inst]);
            PrintAddr(a);
            write(TSymFile,',');
            PrintReg(r, InstType);
            writeln(TSymFile);
          END;

          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' SLUT','  CodeAddrReg ');
          (*ENDTEST#*)
      END; (* CodeAddrReg *)


    (*-------------------------------------------------------- *)



    PROCEDURE CodeRegAddr(Inst : InStruction; InstType : InstrucType;
                                r : Register; VAR a : Address   );
      (* Generate a instruction with a register as first parametre
         and an adddress as secend parametre  *)

      VAR 
        op : Byte;
        SegReg : Register;

      BEGIN
          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' START','  CodeRegAddr ', ord(Inst),
                                        ' ',ord(InstType),' ',ord(r));
          (*ENDTEST#*)

        IF ( (ord(ES) <= ord(r)) AND
             (ord(r) <= ord(DS)) AND
             (Inst = iMOV)) THEN
          BEGIN
            op := OpcodeMovR_MToSeg;
            PutR_MOperand(op,a,ord(r) - ord(ES));
          END
        ELSE
          BEGIN
            op := OpcodeR_M[Inst];

            IF (( Inst <> iLEA) AND
                ( Inst <> iLDS) AND
                ( Inst <> iLES)) THEN
              BEGIN
                op := op + ord(InstType);


                (* direction = 1 *)
                IF Inst <> iXCHG THEN PackField(op,1,1);
              END;

            IF Inst = iLEA THEN
              BEGIN (* need not be prefixed *)
                SegReg := a.Seg;
                a.Seg := SS;	
              END;
            PutR_MOperand(op, a, RegField(r));
          END;

        (* Print to TSymFile *)
        IF CodeOn THEN
          BEGIN
            write(TSymFile, InstructionName[Inst]);
            PrintReg(r, InstType);
            write(TSymFile,' ,');
            PrintAddr(a);
            writeln(TSymFile);
          END;

        IF Inst = iLEA THEN a.Seg := SegReg;


          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' SLUT','  CodeRegAddr ');
          (*ENDTEST#*)
      END; (* CodeRegAddr *)


    (* ------------------------------------------------ *)



    PROCEDURE CodeRegConst(Inst : Instruction; InstType : InstrucType;
                                   r : Register; Value : Word );
      (* Generate a instruction with a register as the first
         parametre and a constant as the secend parametre *)

      VAR
        op : Byte;
        length : integer;
        help : InstrucType;
        Reg : Byte;

      BEGIN
          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' START','  CodeRegConst ', ord(Inst),
                         ' ',ord(InstType),' ',ord(r),' ',Value);
          (*ENDTEST#*)

        IF (( INST <> iMOV ) AND ( r = AX )) 
        THEN
          BEGIN  (* Immediate to accumulator *)
            op := OpcodeConstandAcc[Inst] + ord(InstType);

            (* Put to Codebuffer *)
            IF InstType = w
            THEN   (* word constant *)
              BEGIN
                WordByte.w := Value;
                Put3CodeFormat(op,WordByte.Byte1,WordByte.Byte2);
              END
            ELSE (* byte constant *)
              BEGIN
                Put2CodeFormat(op,Value);
              END
          END
        ELSE
          IF iMOV = Inst
          THEN
            BEGIN  (*  Move Immediate to register *)
              op := OpcodeMovImmToReg;
              PackField(op, 0, RegField(r));
              IF InstType = w THEN
                BEGIN
                  PackField(op,3,1);
                  WordByte.i := Value;
                  Put3CodeFormat(op,WordByte.Byte1,WordByte.Byte2);
                END
              ELSE
                BEGIN
                  PackField(op,3,0);
                  Put2CodeFormat(op,Value);
                END;

            END
          ELSE 
            BEGIN
              op := OpcodeR_MAndConst[Inst] + ord(InstType);
              help := InstType;
 
              wordbyte.w := Value;
              IF (( InstType = w ) AND (-128 <= wordbyte.i ) AND( wordbyte.i <= 127) AND
                  ( ord(iADD) <= ord(Inst)) AND (ord(Inst) <= ord(iCMP)))
              THEN
                BEGIN  (* Sign extension *)
                  PackField(op,1,1);
                  help := b;
                END;

              Reg := RegField(r);
              PackField(Reg, 3, OpcodeCRegField[Inst]);
              PackField(Reg, 6, 3); (* register mode *)

              IF help = b 
              THEN
                BEGIN   (* Byte constant *)
                  Put3CodeFormat(op,Reg,Value);
                END
              ELSE
                BEGIN  (* word constant *)
                  Put4CodeFormat(op, Reg, WordByte.Byte1,WordByte.Byte2);
                END;
            END;
         
        (* Print to TSymFile *)
        IF CodeOn THEN
          BEGIN
            write(TSymFile, InstructionName[Inst]);
            PrintReg(r,InstType);
            writeln(TSymFile,' , ',Value);
          END;

          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' SLUT','  CodeRegConst ');
          (*ENDTEST#*)
      END; (* CodeRegConst *)


  (* -------------------------------------------------------- *)


    PROCEDURE CodeRegReg(Inst : Instruction; InstType : InstrucType;
                                             r1, r2 : Register );
      (* Generate a instruction where both parametres are registers *)

      VAR
        op : Byte;
        x : Byte;
 
      BEGIN
          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' START','  CodeRegReg ', ord(Inst),' ',
                              ord(InstType),' ',ord(r1),' ',ord(r2));
          (*ENDTEST#*)


        IF ( (ord(ES) <= ord(r1)) AND
             (ord(r1) <= ord(DS)) AND
             (Inst = iMOV)) THEN
          BEGIN
            op := OpcodeMovR_MToSeg;
            IF ( (ord(ES) <= ord(r2)) AND
                 (ord(r2) <= ord(DS))) THEN
              Fatal_Error(Pass4,7)
            ELSE
              BEGIN
                x := RegField(r2);
                PackField(x,6,3);
                PackField(x,3,ord(r1) - ord(ES));
              END;
          END
        ELSE
        IF ( (ord(ES) <= ord(r2)) AND
             (ord(r2) <= ord(DS)) AND
             (Inst = iMOV)) THEN
          BEGIN
            op := OpcodeMovSegToR_M;
            IF ( (ord(ES) <= ord(r1)) AND
                 (ord(r1) <= ord(DS))) THEN
              Fatal_Error(Pass4,7)
            ELSE
              BEGIN
                x := RegField(r1);
                PackField(x,6,3);
                PackField(x,3,ord(r2) - ord(ES));
              END;
          END
        ELSE
          BEGIN
            op := OpcodeR_M[Inst] + ord(InstType);
 
            x := RegField(r1);
            PackField(x, 6, 3); (* Register mode *)
            PackField(x, 3, RegField(r2));
          END;


        Put2CodeFormat(op,x);


        (* Print to TSymFile *)
        IF CodeOn THEN
          BEGIN
            write(TSymFile, InstructionName[Inst]);
            PrintReg(r1,InstType);
            write(TSymFile,' ,');
            PrintReg(r2,InstType);
            writeln(TSymFile);
          END;

          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' SLUT','  CodeRegReg ');
          (*ENDTEST#*)
      END; (* CodeRegReg *)


  (* ------------------------------------------------------------- *)



    PROCEDURE CallRoutine(Spix : SpixRange; Number : Word;
                                                         RKind : St_DeclareMode);
      (* The procedure generates code for an external or an open routine call*)

      VAR
        i :integer;
        Index, LastIndex , Leng,codelength : Word;
        dump_symcode: boolean;
        Str : Ptr_String;
      BEGIN
        IF CodeOn THEN
          BEGIN
            IF RKind <> St_Open THEN
              BEGIN
                IF RKind = St_Jump
                  THEN write(TSymFile,InstructionName[iJMP])
                  ELSE write(TSymFile,InstructionName[iCall]);
              END
            ELSE write(TSymFile,'////');
            IF Spix = AnonymousSpix THEN Spix := PreExtName[Number];

            St_NameOfSpix(Spix,Str);
            FOR i := 1 TO length(Str^) DO
              write(TSymFile,Str^[i]);
            write(TSymfile,' ');
            if RKind <> St_open Then writeln(TSymFile);

          END;

        IF (RKind = St_Extern) OR (RKind = St_Jump) THEN
          BEGIN
            (* an external routine call *)
            if Number <= noofPI3Routines then
            PreExtCalled[Number] := true;
            PutCodeBuffer(0);
            IF RKind = St_Extern THEN PutCodeBuffer(ord(ExternalCall))
                                 ELSE PutCodeBuffer(ord(ExternalJump));
            wordbyte.w := Number;
            PutCodeBuffer(WordByte.Byte1);
            PutCodeBuffer(WordByte.Byte2);
            IF ( InternalOffset > (Max_Word - 5)) THEN
              Fatal_Error(Pass4,4);

            InternalOffset := InternalOffset + 5;

          END

        ELSE
            (* An open routine call *)
          BEGIN
            dump_symcode:= false;
            WordByte.Byte1 := CodeOfOpenRoutines[(Number * 2) + 2];
            WordByte.Byte2 := CodeOfOpenRoutines[(Number * 2) + 3];
            Index := WordByte.w + 2;

            (* The index to the open routines length is in Index *)

            WordByte.Byte1 := CodeOfOpenRoutines[Index];
            WordByte.Byte2 := CodeOfOpenRoutines[Index + 1];

            LastIndex := Index + WordByte.w - 1;

            Index := Index + 2;
            WHILE Index <= LastIndex DO

            BEGIN
              WordByte.Byte1 := CodeOfOpenRoutines[Index];
              WordByte.Byte2 := CodeOfOpenRoutines[Index + 1];
              Index:= Index+2;
              leng := WordByte.w;

              if leng>0 then begin
              IF dump_symcode THEN
              BEGIN
                write(TSymFile,'////');
                writeln(TSymFile);
              END
              else
               if CodeOn then
                writeln(TSymFile);
              dump_symcode:= CodeOn;
              putcodebuffer(leng);


              FOR i :=1  TO leng DO
              BEGIN
                PutCodeBuffer(CodeOfOpenRoutines[Index]);
                Index:=Index+1;
              END;

              IF ( InternalOffset > (Max_Word - Leng)) THEN
                Fatal_Error(Pass4,4);

              InternalOffset := InternalOffset + Leng;
              end;

              IF Index <= LastIndex THEN (* Special Dump *)
              BEGIN
                WordByte.Byte1 := CodeOfOpenRoutines[Index + 1];
                WordByte.Byte2 := CodeOfOpenRoutines[Index + 2];

                callroutine(Anonymousspix,wordbyte.w,st_extern);

                index := index + 3;

              END;
            END;

          END;
      END;

    (* ------------------------------------------------------ *)


    PROCEDURE CodeJump(Inst : Instruction; Lab : St_Address);
      (* Generate a instruction with a label as operand *)

      VAR
        Ptr : st_ElemPtr;
        Lab1 : St_Address;
        Bool : Boolean;
        InstLength : word;

      BEGIN
        IF (( Inst = iJMP ) AND (LastLabelOffset = InternalOffset)) THEN
          BEGIN
            (* A superflous is elemined *)
            (* Make sure lab is not defined as lastlabel *)
            Bool := true;
            Lab1 := Lab;
            WHILE Bool AND Not Equal_Addr(Lab1,St_Nilladdr) DO
              IF Equal_Addr(Lab1,LastLabel)
                THEN Bool := false
                ELSE
                  BEGIN
                    ST_Retrieve(Lab1,Ptr);
                    Lab1 := Ptr^.DefAsLabel;
                  END;

            IF Bool THEN
              BEGIN
                (* The superflous can be elemined *)
                St_Get(LastLabel,Ptr);
                Ptr^.Label_Offset := 0;
                GenAsLabel(LastLabel,Lab);
                LastLabelOffset := 0;
              END
            ELSE
              (* the jmp may not be delete *)
              LastJMPOffset := 0;
          END;

        (* If this is a JMP instruction and the last instruction was a JMP
           too this instruction is not generated *)
        IF not ((Inst = iJMP) AND ( LastJMPOffset = InternalOffset)) THEN
          BEGIN   (* generated the instruction *)

            PutCodeBuffer(0);

            (* NEAR jump is assumed *)
            IF (( Inst = iJMP) OR (Inst = iCALL))
            THEN
              BEGIN  (* Near uncond jump *)
                PutCodeBuffer(ord(NearUnCondJump));
                PutCodeBuffer(ord(Inst));

                InstLength := 3;
              END
            ELSE
              BEGIN  (* Near cond jump *)
                PutCodeBuffer(ord(NearCondJump));
                PutCodeBuffer(ord(Inst));

                InstLength := 5;
              END;



           (* Put label *)
            WordByte.w := Lab.Va_Low;
            PutCodeBuffer(WordByte.Byte1);
            PutCodeBuffer(WordByte.Byte2);

            WordByte.w := Lab.Va_High;
            PutCodeBuffer(WordByte.Byte1);
            PutCodeBuffer(WordByte.Byte2);


            IF ( InternalOffset > (Max_Word - InstLength)) THEN
              Fatal_Error(Pass4,4);
            InternalOffset := InternalOffset + InstLength;

            IF Inst = iJMP THEN LastJMPOffset := InternalOffset;

          END;
          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' SLUT','  CodeJump ');
          (*ENDTEST#*)
      END; (* CodeJump *)


  (* --------------------------------------------------------- *)





    PROCEDURE CodeIndJump(Lab : St_Address; IndexReg : Register);
      (* Generate a indirect jump at address CS: Lab.Offset [IndexReg] *)

      VAR
        R_M : Byte;

      BEGIN
          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' START','  CodeIndJump ');
          (*ENDTEST#*)

        PutCodeBuffer(0);
        PutCodeBuffer(ord(AddLabelToDis));
        PutCodeBuffer(5); (* length of code *)

        PutCodeBuffer(OpcodeCSPreFix);
        PutCodeBuffer(OpcodeJumpIndirect);

        IF IndexReg = BX 
          THEN R_M := $07 (*111B*)
          ELSE R_M := $04 (*100B*) + ord(IndexReg) - ord(SI);

        PackField(R_M,3,CRegFieldJumpIndirect);
        PackField(R_M,6,$02 (*10B*));

        PutCodeBuffer(R_M);


        PutCodeBuffer(0);
        PutCodeBuffer(0);


        WordByte.w := Lab.Va_Low;
        PutCodeBuffer(WordByte.Byte1);
        PutCodeBuffer(WordByte.Byte2);

        WordByte.w := Lab.Va_High;
        PutCodeBuffer(WordByte.Byte1);
        PutCodeBuffer(WordByte.Byte2);


        IF CodeOn THEN
          BEGIN
            write(TSymFile,InstructionName[iJMP]);
            write(TSymFile,'CS: ');
            IF IndexReg = BX THEN write(TSymFile,'[BX] ');
            IF IndexReg = DI THEN write(TSymFile,'[DI]');
            IF IndexReg = SI THEN write(TSymFile,'[SI]');
            writeln(TSymFile);
          END;


        IF ( InternalOffset > (Max_Word - 5)) THEN Fatal_Error(Pass4,4);
        InternalOffset := InternalOffset + 5;

          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' SLUT','  CodeIndJump ');
          (*ENDTEST#*)
      END; (* CodeIndJump *)



  (* --------------------------------------------------------- *)


    PROCEDURE CodeFaultAX(ErrorInt, ErrorExc: WORD);
     var s : string;
         ptr : St_elemPtr;
     BEGIN
(*      CodeRegConst(imov,w,AX,ErrorExc);
      CodeReg(ipush,w,AX);
      CallRoutine(anonymousspix, fault, st_extern); *)

      with FaultInfo[ErrorExc] do
        BEGIN
          IF not used then
            BEGIN
              used := true;
              str(number,s);
              s := 'FAULT_'+ s;
              St_Declaration(cLabel,Anonymousname,FaultThunk,ptr);
              Ptr^.St_Spix := st_SpixOfName(s);
            END;
          CodeJump(iCALL,FaultThunk);
        END;
    END;

    PROCEDURE CodeFault(ErrorInt, ErrorExc: WORD);
    BEGIN
(*      if computer=0 then (* PI3 *) (* CodeConst(iint, ErrorInt) else
      if computer=1 then (* PARTNER *) CodeFaultAX(ErrorInt,ErrorExc) (*else
      CodeConst(iint, ErrorInt);*)
    END;


  (* --------------------------------------------------------- *)



    PROCEDURE CodeLoadEffAddr(Reg : Register; Lab : St_Address; Offset : Word);
      (* Generate code to load Reg with the effectiv address of Lab: + offset *)

      VAR
        Op : Byte;
        i : integer;
        Str : ptr_String;

      BEGIN
          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' START','  CodeLoadEffAddr ');
          (*ENDTEST#*)

        PutCodeBuffer(0);
        PutCodeBuffer(ord(AddLabelToDis));

        PutCodeBuffer(3); (* length of code *)

        Op := OpCodeMovImmToReg;
        PackField(Op,0,RegField(Reg));
        PackField(Op,3,1);
        PutCodeBuffer(Op);

        (* put offset *)
        WordByte.w := Offset;
        PutCodeBuffer(WordByte.Byte1);
        PutCodeBuffer(WordByte.Byte2);


        WordByte.w := Lab.Va_Low;
        PutCodeBuffer(WordByte.Byte1);
        PutCodeBuffer(WordByte.Byte2);

        WordByte.w := Lab.Va_High;
        PutCodeBuffer(WordByte.Byte1);
        PutCodeBuffer(WordByte.Byte2);
                 

        IF CodeOn THEN
          BEGIN
            write(TSymFile,InstructionName[iMOV]);
            PrintReg(Reg,w);
            write(TSymFile,' , ');

            writeln(TSymFile,Offset,' + ');
          END;


        IF ( InternalOffset > (Max_Word - 3)) THEN Fatal_Error(Pass4,4);
        InternalOffset := InternalOffset + 3;

          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' SLUT','  CodeLoadEffAddr ');
          (*ENDTEST#*)
      END; (* CodeLoadEffAddr *)


  (* --------------------------------------------------------- *)



    PROCEDURE GenerateLabel(Lab : St_Address);
      (* Generate the label given by Lab *)

      VAR Ptr : St_Elemptr;
      BEGIN
          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' START','  GenerateLabel ');
          (*ENDTEST#*)

        IF ((LastLabelOffset = InternalOffset) AND 
            ( NOT Equal_Addr(Lab,LastLabel)))THEN
          BEGIN
            (* One label has been generated with this offset *)
            GenAsLabel(Lab,LastLabel);
          END
        ELSE
          BEGIN
            (* generate the label *)
            PutCodeBuffer(0);
            PutCodeBuffer(0);

            (* Put label *)
            WordByte.w := Lab.Va_Low;
            PutCodeBuffer(WordByte.Byte1);
            PutCodeBuffer(WordByte.Byte2);

            WordByte.w := Lab.Va_High;
            PutCodeBuffer(WordByte.Byte1);
            PutCodeBuffer(WordByte.Byte2);

            St_Get(Lab,Ptr);
            Ptr^.Label_Offset := InternalOffset;

            LastLabelOffset := InternalOffset;
            LastLabel := Lab;
          END;

          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' SLUT','  GenerateLabel ');
          (*ENDTEST#*)
      END;  (* GenerateLabel *)


   (* --------------------------------------------------------- *)


    PROCEDURE GenAsLabel(Lab1, Lab2 : St_Address);
      (* The offset of Lab1 is defined by the offset of Lab2
         Lab1 is never generated  *)
      VAR
        Ptr : St_ElemPtr;

      BEGIN
          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' START','  GenAsLabel');
          (*ENDTEST#*)

        St_Get(Lab1,Ptr);

        Ptr^.DefAsLabel := Lab2;


          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' SLUT','  GenAsLabel');
          (*ENDTEST#*)
      END;  (* GenAsLabel *)







    PROCEDURE InitCodeGenerator;
      (* The procedure initialize the codegenerator *)

      VAR
        i : integer;
        PreName : string[16];



      BEGIN
          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' START','  InitCodeGenerator');
          (*ENDTEST#*)


        (* Initialize the ShiftFactor *)
        ShiftFactor[0] := 1;
        FOR i := 1 TO 7 DO
          ShiftFactor[i] := ShiftFactor[i-1] * 2;



        (* Initialize the NegInst tabel *)
        NegInstruction[iJE] := iJNE;
        NegInstruction[iJL] := iJGE;
        NegInstruction[iJLE] := iJG;
        NegInstruction[iJB] := iJAE;
        NegInstruction[iJBE] := iJA;
        NegInstruction[iJNE] := iJE;
        NegInstruction[iJGE] := iJL;
        NegInstruction[iJG] := iJLE;
        NegInstruction[iJAE] := iJB;
        NegInstruction[iJA] := iJBE;


        (* Initialize Opcode tabels *)
        OpCodeNoOpr[iINTO] := $CE; (*11001110B;*)
        OpCodeNoOpr[iCWD] := $99; (*10011001B;*)
        OpcodeNoOpr[iCLD] := $FC; (*11111100B;*)
        OpcodeNoOpr[iCLI] := $FA; (*11111010B;*)
        OpcodeNoOpr[iSTI] := $FB; (*11111011B;*)
        OpcodeNoOpr[iREP] := $F3; (*11110011B;*)
        OpcodeNoOpr[iMOVSB] := $A4; (*10100100B;*)
        OpcodeNoOpr[iMOVSW] := $A5; (*10100101B;*)
        OpcodeNoOpr[iSTOSB] := $AA; (*10101010B;*)
        OpcodeNoOpr[iSTOSW] := $AB; (*10101011B;*)
        OpcodeNoOpr[iCMPSB] := $A6; (*10100110B;*)
        OpcodeNoOpr[iCMPSW] := $A7; (*10100111B;*)
        OpCodeNoOpr[iSCASB] := $AE; (*10101110B;*)
        OpCodeNoOpr[iNOOP2] := $BA; (*10111010B*)
        OpCodeNoOpr[iINT] := $CC; (*11001100B;*)
        OpCodeNoOpr[iRETWS] := $C3; (*11000011B;*)
        OpCodeNoOpr[iRETIS] := $CB; (*11001011B;*)


        OpCodeCOpr[iINT] := $CD; (*11001101B;*)
        OpCodeCOpr[iRETWS] := $C2; (*11000010B;*)
        OpCodeCOpr[iRETIS] := $CA; (*11001010B;*)









        OpCodeShort[iJE] := $74; (*01110100B;*)
        OpCodeShort[iJL] := $7C; (*01111100B;*)
        OpCodeShort[iJLE] := $7E; (*01111110B;*)
        OpCodeShort[iJB] := $72; (*01110010B;*)
        OpCodeShort[iJBE] := $76; (*01110110B;*)
        OpCodeShort[iJNE] := $75; (*01110101B;*)
        OpCodeShort[iJGE] := $7D; (*01111101B;*)
        OpCodeShort[iJG] := $7F; (*01111111B;*)
        OpCodeShort[iJAE] := $73; (*01110011B;*)
        OpCodeShort[iJA] := $77; (*01110111B;*)
        OpCodeShort[iLOOP] := $E2; (*11100010B;*)
        OpCodeShort[iJCXZ] := $E3; (*11100011B;*)
        OpCodeShort[iJMP] := $EB; (*11101011B;*)



        OpcodeNear[iJMP] := $E9; (*11101001B;*)
        OpcodeNear[iCALL] := $E8; (*11101000B;*)

        OpcodeSROpr[iPUSH] := $06; (*00000110B;*)
        OpcodeSROpr[iPOP] := $07; (*00000111B;*)

        OpcodeRegOpr[iPUSH] := $50; (*01010000B;*)
        OpcodeRegOpr[iPOP] := $58; (*01011000B;*)
        OpcodeRegOpr[iINC] := $40; (*01000000B;*)
        OpcodeRegOpr[iDEC] := $48; (*01001000B;*)


        OpcodeR_M[iPUSH] := $FF; (*11111111B;*)
        OpcodeR_M[iPOP] := $8F; (*10001111B;*)
        OpcodeR_M[iINC] := $FE; (*11111110B;*)
        OpcodeR_M[iDEC] := $FE; (*11111110B;*)
        OpCodeR_M[iNEG] := $F6; (*11110110B;*)
        OpCodeR_M[iMUL] := $F6; (*11110110B;*)
        OpCodeR_M[iIMUL] := $F6; (*11110110B;*)
        OpCodeR_M[iDIV] := $F6; (*11110110B;*)
        OpCodeR_M[iIDIV] := $F6; (*11110110B;*)
        OpCodeR_M[iNOT] := $F6; (*11110110B;*)
        OpCodeR_M[iSHL] := $D0; (*11010000B;*)
        OpCodeR_M[iSHR] := $D0; (*11010000B;*)
        OpCodeR_M[iSAR] := $D0; (*11010000B;*)
        OpcodeR_M[iMOV] := $88; (*10001000B;*)
        OpcodeR_M[iADD] := $00; (*00000000B;*)
        OpcodeR_M[iSUB] := $28; (*00101000B;*)
        OpcodeR_M[iCMP] := $38; (*00111000B;*)
        OpcodeR_M[iAND] := $20; (*00100000B;*)
        OpcodeR_M[iTEST] := $10; (*00010000B;*)
        OpcodeR_M[iOR] := $08; (*00001000B;*)
        OpcodeR_M[iXOR] := $30; (*00110000B;*)
        OpcodeR_M[iLEA] := $8D; (*10001101B;*)
        OpcodeR_M[iLES] := $C4; (*11000100B;*)
        OpcodeR_M[iXCHG] := $86; (*10000110B;*)


        OpcodeCRegField[iPUSH] := $6; (*110B;*)
        OpcodeCRegField[iPOP] := $0; (*000B;*)
        OpcodeCRegField[iINC] := $0; (*000B;*)
        OpcodeCRegField[iDEC] := $1; (*001B;*)
        OpcodeCRegField[iNEG] := $3; (*011B;*)
        OpcodeCRegField[iMUL] := $4; (*100B;*)
        OpcodeCRegField[iIMUL] := $5; (*101B;*)
        OpcodeCRegField[iDIV] := $6; (*110B;*)
        OpcodeCRegField[iIDIV] := $7; (*111B;*)
        OpcodeCRegField[iNOT] := $2; (*010B;*)
        OpcodeCRegField[iSHL] := $4; (*100B;*)
        OpcodeCRegField[iSHR] := $5; (*101B;*)
        OpcodeCRegField[iSAR] := $7; (*111B;*)
        OpcodeCRegField[iMOV] := $0; (*000B;*)
        OpcodeCRegField[iADD] := $0; (*000B;*)
        OpcodeCRegField[iSUB] := $5; (*101B;*)
        OpcodeCRegField[iCMP] := $7; (*111B;*)
        OpcodeCRegField[iAND] := $4; (*100B;*)
        OpcodeCRegField[iTEST] := $0; (*000B;*)
        OpcodeCRegField[iOR] := $1; (*001B;*)
        OpcodeCRegField[iXOR] := $6; (*110B;*)

        OpcodeR_MAndConst[iMOV] := $C6; (*11000110B;*)
        OpcodeR_MAndConst[iADD] := $80; (*10000000B;*)
        OpcodeR_MAndConst[iSUB] := $80; (*10000000B;*)
        OpcodeR_MAndConst[iCMP] := $80; (*10000000B;*)
        OpcodeR_MAndConst[iAND] := $80; (*10000000B;*)
        OpcodeR_MAndConst[iTEST] := $F6; (*11110110B;*)
        OpcodeR_MAndConst[iOR] := $80; (*10000000B;*)
        OpcodeR_MAndConst[iXOR] := $80; (*10000000B;*)



        OpcodeConstAndAcc[iADD] := $04; (*00000100B;*)
        OpcodeConstAndAcc[iSUB] := $2C; (*00101100B;*)
        OpcodeConstAndAcc[iCMP] := $3C; (*00111100B;*)
        OpcodeConstAndAcc[iAND] := $24; (*00100100B;*)
        OpcodeConstAndAcc[iTEST] := $A8; (*10101000B;*)
        OpcodeConstAndAcc[iOR] := $0C; (*00001100B;*)
        OpcodeConstAndAcc[iXOR] := $34; (*00110100B;*)




        Filebufferindex := 0;
        CodeOn := false;
        InternalOffset := 0;
        FileOffset := 0;
        NoBytesInBuffer := 0;
        BufferIndex := 0;
        FirstIndex := 0;

        LastLabelOffset := 0;
        LastJMPOffset := 0;
        LastLabel := St_NillAddr;

        Spacing := Call_Options.Spacing;
        LineTabel := (Spacing <> 0);
        LastNameEntry := St_NillAddr;
        LengthOfNameTabel := 2;

        CurrentSegNo := 1;

        InitFaultInfo;

        (* reads the code for the open routines *)
        i := 0;
        WHILE NOT EOF(OpenRoutine) DO
          BEGIN
            IF i > MaxLengthOfOpenRoutines THEN
              Fatal_Error(Pass4,9);

            read(OpenRoutine,CodeOfOpenRoutines[i]);
            (*
            CodeOfOpenRoutines[i] := OpenRoutine^;
            get(OpenRoutine);*)
            i := i + 1;
          END;






        InitPass4_2;



        NoPreExtDecl := NoOfPi3Routines;
        (* Initialize the the list of External Name  *)
        for i := 1 to NoOfPi3Routines do PreExtCalled[i] := false;


        PreName := 'FAULT';
        (*Name.Length := 5;
        FOR i := 1 TO 5 DO
          BEGIN
            Name.Name[i] := PreName[i];
          END;
          *)
        PreExtName[fault] := St_SpixOfName(PreName);
        LengthOfAllPreExtName := LengthOfAllPreExtName + 5;


        if computer =  Partner then
        begin
          Prename := 'FAULT';
          LengthOfAllPreExtName := LengthOfAllPreExtName + 5;
        end
        else
        begin
          PreName := 'RESUME';
          LengthOfAllPreExtName := LengthOfAllPreExtName + 6;
        end;
        PreExtName[resume] := St_SpixOfName(PreName);


        PreName := 'ALLOCPOOL';
        PreExtName[AllocPool] := St_spixOfName(PreName);
        LengthOfAllPreExtName := LengthOfAllPreExtName + 9;



        PreName := 'INIT_SEMAPHORE';
        PreExtName[INIT_Semaphore] := St_spixOfName(PreName);
        LengthOfAllPreExtName := LengthOfAllPreExtName + 14;


        PreName := 'WAITS';
(*      Name.Length := 5;
        FOR i := 1 TO 5 DO
          BEGIN
            Name.Name[i] := PreName[i];
          END;
*)
        PreExtName[WAITS] := St_spixOfName(PreName);
        LengthOfAllPreExtName := LengthOfAllPreExtName + 5;


        PreName := 'SET_EXCEPTION';
(*        Name.Length := 13;
        FOR i := 1 TO 13 DO
          BEGIN
            Name.Name[i] := PreName[i];
          END;
*)
        PreExtName[Set_Exception ] := St_SpixOfName(PreName);
        LengthOfAllPreExtName := LengthOfAllPreExtName + 13;


        PreName := 'INIT_REFERENCE';
(*        Name.Length := 14;
        FOR i := 1 TO 14 DO
          BEGIN
            Name.Name[i] := PreName[i];
          END;
*)
        PreExtName[Init_Reference] := St_spixOfName(PreName);
        LengthOfAllPreExtName := LengthOfAllPreExtName + 14;



        PreName := 'INIT_CHAIN';
(*        Name.Length := 10;
        FOR i := 1 TO 10 DO
          BEGIN
            Name.Name[i] := PreName[i];
          END;
*)
        PreExtName[Init_Chain] := St_spixOfName(PreName);
        LengthOfAllPreExtName := LengthOfAllPreExtName + 10;



        PreName := 'INIT_SHARED';
(*        Name.Length := 11;
        FOR i := 1 TO 11 DO
          BEGIN
            Name.Name[i] := PreName[i];
          END;
*)
        PreExtName[Init_Shared] := St_spixOfName(PreName);
        LengthOfAllPreExtName := LengthOfAllPreExtName + 11;



        PreName := 'INIT_MAILBOX';
(*        Name.Length := 12;
        FOR i := 1 TO 12 DO
          BEGIN
            Name.Name[i] := PreName[i];
          END;
*)
        PreExtName[Init_MailBox] := St_spixOfName(PreName);
        LengthOfAllPreExtName := LengthOfAllPreExtName + 12;




        PreName := 'INIT_PROCESS';
(*        Name.Length := 12;
        FOR i := 1 TO 12 DO
          BEGIN
            Name.Name[i] := PreName[i];
          END;
*)
        PreExtName[Init_Process] := St_spixOfName(PreName);
        LengthOfAllPreExtName := LengthOfAllPreExtName + 12;



        PreName := 'INIT_INTERNAL';
(*        Name.Length := 13;
        FOR i := 1 TO 13 DO
          BEGIN
            Name.Name[i] := PreName[i];
          END;
*)
        PreExtName[Init_Internal] := St_spixOfName(PreName);
        LengthOfAllPreExtName := LengthOfAllPreExtName + 13;



        PreName := 'INIT_EXTERNAL';
(*        Name.Length := 13;
        FOR i := 1 TO 13 DO
          BEGIN
            Name.Name[i] := PreName[i];
          END;
*)
        PreExtName[Init_External] := St_spixOfName(PreName);
        LengthOfAllPreExtName := LengthOfAllPreExtName + 13;



        PreName := 'INIT_PORT';
(*        Name.Length := 9;
        FOR i := 1 TO 9 DO
          BEGIN
            Name.Name[i] := PreName[i];
          END;
*)
        PreExtName[Init_Port] := St_spixOfName(PreName);
        LengthOfAllPreExtName := LengthOfAllPreExtName + 9;


        PreName := 'SIGNALS';
(*        Name.Length := 7;
        FOR i := 1 TO 7 DO
          BEGIN
            Name.Name[i] := PreName[i];
          END;
*)
        PreExtName[SignalS] := St_spixOfName(PreName);
        LengthOfAllPreExtName := LengthOfAllPreExtName + 7;


        PreName := 'INIT_POOL';
(*        Name.Length := 9;
        FOR i := 1 TO 9 DO
          BEGIN
            Name.Name[i] := PreName[i];
          END;
*)
        PreExtName[Init_Pool] := St_spixOfName(PreName);
        LengthOfAllPreExtName := LengthOfAllPreExtName + 9;


        PreName := 'ENDPROCESS';
(*        Name.Length := 10;
        FOR i := 1 TO 10 DO
          BEGIN
            Name.Name[i] := PreName[i];
          END;
*)
        PreExtName[EndProcess] := St_spixOfName(PreName);
        LengthOfAllPreExtName := LengthOfAllPreExtName + 10;


        PreName := 'MARK_LOCALREF';
(*        Name.Length := 13;
        FOR i := 1 TO 13 DO
          BEGIN
            Name.Name[i] := PreName[i];
          END;
*)
        PreExtName[Mark_LocalRef] := St_spixOfName(PreName);
        LengthOfAllPreExtName := LengthOfAllPreExtName + 13;


        PreName := 'UNCHAIN_LOCALREF'; (* EF  insert  *)
(*        Name.Length := 16;
        FOR i := 1 TO 14 DO
          BEGIN
            Name.Name[i] := PreName[i];
          END;
        Name.Name[15] := 'E';
        Name.Name[16] := 'F';
*)
        PreExtName[UnChain_LocalRef] := St_spixOfName(PreName);
        LengthOfAllPreExtName := LengthOfAllPreExtName + 16;


        PreName := 'INIT_LOCALREF';
(*        Name.Length := 13;
        FOR i := 1 TO 13 DO
          BEGIN
            Name.Name[i] := PreName[i];
          END;
*)
        PreExtName[Init_LocalRef] := St_spixOfName(PreName);
        LengthOfAllPreExtName := LengthOfAllPreExtName + 13;


        IF Make_Set THEN
          BEGIN
            NoPreExtDecl := NoPreExtDecl + NoOfSetRoutines;

            PreName := 'ASSIGNSET';
       (*   Name.Length := 9;
            FOR i := 1 TO 9 DO
              BEGIN
                Name.Name[i] := PreName[i];
              END;
       *)
            PreExtName[AssignSet] := St_spixOfName(PreName);
            LengthOfAllPreExtName := LengthOfAllPreExtName + 9;


            PreName := 'PUSHSET';
(*          Name.Length := 7;
            FOR i := 1 TO 7 DO
              BEGIN
                Name.Name[i] := PreName[i];
              END;
*)
            PreExtName[PushSet] := St_spixOfName(PreName);
            LengthOfAllPreExtName := LengthOfAllPreExtName + 7;


            PreName := 'ADDSET';
(*          Name.Length := 6;
            FOR i := 1 TO 6 DO
              BEGIN
                Name.Name[i] := PreName[i];
              END;
*)
            PreExtName[AddSet] := St_spixOfName(PreName);
            LengthOfAllPreExtName := LengthOfAllPreExtName + 6;


            PreName := 'SUBSET';
(*          Name.Length := 6;
            FOR i := 1 TO 6 DO
              BEGIN
                Name.Name[i] := PreName[i];
              END;
*)
            PreExtName[SubSet] := St_spixOfName(PreName);
            LengthOfAllPreExtName := LengthOfAllPreExtName + 6;


            PreName := 'MULTSET';
(*            Name.Length := 7;
            FOR i := 1 TO 7 DO
              BEGIN
                Name.Name[i] := PreName[i];
              END;
*)
            PreExtName[MultSet] := St_spixOfName(PreName);
            LengthOfAllPreExtName := LengthOfAllPreExtName + 7;


            PreName := 'GESET';
(*          Name.Length := 5;
            FOR i := 1 TO 5 DO
              BEGIN
                Name.Name[i] := PreName[i];
              END;
*)
            PreExtName[GESet] := St_spixOfName(PreName);
            LengthOfAllPreExtName := LengthOfAllPreExtName + 5;


            PreName := 'EQSET';
(*            Name.Length := 5;
            FOR i := 1 TO 5 DO
              BEGIN
                Name.Name[i] := PreName[i];
              END;
*)
            PreExtName[EQSet] := St_spixOfName(PreName);
            LengthOfAllPreExtName := LengthOfAllPreExtName + 5;


            PreName := 'NESET';
(*            Name.Length := 5;
            FOR i := 1 TO 5 DO
              BEGIN
                Name.Name[i] := PreName[i];
              END;
*)
            PreExtName[NESet] := St_spixOfName(PreName);
            LengthOfAllPreExtName := LengthOfAllPreExtName + 5;


            PreName := 'LESET';
(*            Name.Length := 5;
            FOR i := 1 TO 5 DO
              BEGIN
                Name.Name[i] := PreName[i];
              END;
*)
            PreExtName[LESet] := St_spixOfName(PreName);
            LengthOfAllPreExtName := LengthOfAllPreExtName + 5;


            PreName := 'INSET';
(*            Name.Length := 5;
            FOR i := 1 TO 5 DO
              BEGIN
                Name.Name[i] := PreName[i];
              END;
*)
            PreExtName[INSet] := St_spixOfName(PreName);
            LengthOfAllPreExtName := LengthOfAllPreExtName + 5;


            PreName := 'MAKESET';
(*            Name.Length := 7;
            FOR i := 1 TO 7 DO
              BEGIN
                Name.Name[i] := PreName[i];
              END;
*)
            PreExtName[MakeSet] := St_spixOfName(PreName);
            LengthOfAllPreExtName := LengthOfAllPreExtName + 7;


          END;



          (*#BEGINTEST
             IF TestPass4 >= 10 THEN
               writeln(TestOutput,' SLUT','  InitCodeGenerator');
          (*ENDTEST#*)
      END;  (* InitCodeGenerator *)