.ad 8
.bm 8
.fm 4
.bt $Copyright (c) 2000-2005 SAP AG$$Page %$
.tm 12
.hm 6
.hs 3
.tt 1 $SQL$Project Distributed Database System$VGG02$
.tt 2 $$$
.tt 3 $ElkeZ$Codetransformation_and_Coding$1999-05-21$
***********************************************************
.nf
 
 .nf

    ========== licence begin  GPL
    Copyright (c) 2000-2005 SAP AG

    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License
    as published by the Free Software Foundation; either version 2
    of the License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
    ========== licence end
.fo

 
.fo
.nf
.sp
Module  : Codetransformation_and_Coding
=========
.sp
Purpose : Codetransformation from ASCII to EBCDIC and
          vice versa.
          Encryption and decryption of passwords.
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        VAR
              g02codetables : tgg04_CodeTables;
 
        PROCEDURE
              g02hex (
                    VAR source : tsp00_MoveObj;
                    source_pos : tsp00_Int4;
                    VAR dest   : tsp00_MoveObj;
                    dest_pos   : tsp00_Int4;
                    source_len : tsp00_Int4);
 
        PROCEDURE
              g02date_time_to_int (
                    date_str     : tsp00_Date;
                    time_str     : tsp00_Time;
                    VAR date_int : tsp00_Int4;
                    VAR time_int : tsp00_Int4);
 
        PROCEDURE
              g02datechange (
                    VAR sbuf : tsp00_Timestamp;
                    VAR dbuf : tsp00_MoveObj;
                    spos     : integer;
                    dpos     : tsp00_Int4;
                    format   : tgg00_DateTimeFormat;
                    VAR e    : tgg00_BasisError);
 
        PROCEDURE
              g02decrypt (
                    VAR clearname : tsp00_Name;
                    VAR crypt : tsp00_CryptPw);
&       ifndef AUDIT
 
        PROCEDURE
              g02dump (
                    VAR hostfile    : tgg00_VfFileref;
                    VAR buf         : tsp00_Page;
                    VAR out_pno     : tsp00_Int4;
                    VAR out_pos     : integer;
                    VAR host_err    : tsp00_VfReturn;
                    VAR errtext     : tsp00_ErrText);
&       endif
 
        PROCEDURE
              g02inittranslate_tables;
 
        PROCEDURE
              g02pascii_pos_ebcdic (
                    VAR source : tsp00_MoveObj;
                    srcind   : tsp00_Int4;
                    VAR dest : tsp00_MoveObj;
                    destind  : tsp00_Int4;
                    length   : tsp00_Int4);
 
        PROCEDURE
              g02p1ascii_pos_ebcdic (
                    VAR source : tsp00_MoveObj;
                    srcind   : tsp00_Int4;
                    VAR dest : tsp00_MoveObj;
                    destind  : tsp00_Int4;
                    length   : tsp00_Int4);
 
        PROCEDURE
              g02p2ascii_pos_ebcdic (
                    VAR source : tsp00_MoveObj;
                    srcind   : tsp00_Int4;
                    VAR dest : tsp00_MoveObj;
                    destind  : tsp00_Int4;
                    length   : tsp00_Int4);
 
        PROCEDURE
              g02p3ascii_pos_ebcdic (
                    VAR source : tsp00_MoveObj;
                    srcind   : tsp00_Int4;
                    VAR dest : tsp00_MoveObj;
                    destind  : tsp00_Int4;
                    length   : tsp00_Int4);
 
        PROCEDURE
              g02pebcdic_pos_ascii (
                    VAR source : tsp00_MoveObj;
                    srcind   : tsp00_Int4;
                    VAR dest : tsp00_MoveObj;
                    destind  : tsp00_Int4;
                    length   : tsp00_Int4);
 
        PROCEDURE
              g02p1ebcdic_pos_ascii (
                    VAR source : tsp00_MoveObj;
                    srcind   : tsp00_Int4;
                    VAR dest : tsp00_MoveObj;
                    destind  : tsp00_Int4;
                    length   : tsp00_Int4);
 
        PROCEDURE
              g02p2ebcdic_pos_ascii (
                    VAR source : tsp00_MoveObj;
                    srcind   : tsp00_Int4;
                    VAR dest : tsp00_MoveObj;
                    destind  : tsp00_Int4;
                    length   : tsp00_Int4);
 
        PROCEDURE
              g02p3ebcdic_pos_ascii (
                    VAR source : tsp00_MoveObj;
                    srcind   : tsp00_Int4;
                    VAR dest : tsp00_MoveObj;
                    destind  : tsp00_Int4;
                    length   : tsp00_Int4);
 
        PROCEDURE
              g02tascii_to_ebcdic (
                    VAR source : tsp00_MoveObj;
                    VAR dest : tsp00_MoveObj;
                    length   : tsp00_Int4);
 
        PROCEDURE
              g02t1ascii_to_ebcdic (
                    VAR source : tsp00_MoveObj;
                    VAR dest : tsp00_MoveObj;
                    length   : tsp00_Int4);
 
        PROCEDURE
              g02tebcdic_to_ascii (
                    VAR source : tsp00_MoveObj;
                    VAR dest : tsp00_MoveObj;
                    length   : tsp00_Int4);
 
        PROCEDURE
              g02t1ebcdic_to_ascii (
                    VAR source : tsp00_MoveObj;
                    VAR dest : tsp00_MoveObj;
                    length   : tsp00_Int4);
 
        FUNCTION
              g02toupper (
                    c         : char;
                    code_type : tsp00_CodeType ) : char;
 
        FUNCTION
              g02tolower (
                    c         : char;
                    code_type : tsp00_CodeType ) : char;
 
        PROCEDURE
              g02upstring (
                    VAR source : tsp00_MoveObj;
                    srcind   : tsp00_Int4;
                    VAR dest : tsp00_MoveObj;
                    destind  : tsp00_Int4;
                    length   : tsp00_Int4;
                    code_type : tsp00_CodeType );
 
        PROCEDURE
              g02lowstring (
                    VAR source : tsp00_MoveObj;
                    srcind   : tsp00_Int4;
                    VAR dest : tsp00_MoveObj;
                    destind  : tsp00_Int4;
                    length   : tsp00_Int4;
                    code_type : tsp00_CodeType );
 
        PROCEDURE
              g02timechange (
                    VAR sbuf : tsp00_Timestamp;
                    VAR dbuf : tsp00_MoveObj;
                    spos     : integer;
                    dpos     : tsp00_Int4;
                    format   : tgg00_DateTimeFormat;
                    VAR e    : tgg00_BasisError);
 
        PROCEDURE
              g02exporttables (
                    VAR upptab : tsp00_ObjAddr;
                    VAR lowtab : tsp00_ObjAddr;
                    VAR asctab : tsp00_ObjAddr;
                    VAR ebctab : tsp00_ObjAddr);
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              Configuration_Parameter : VGG01;
 
        PROCEDURE
              g01new_dump_page (
                    VAR hostfile : tgg00_VfFileref;
                    VAR buf      : tsp00_Page;
                    VAR out_pno  : tsp00_Int4;
                    VAR out_pos  : integer;
                    VAR host_err : tsp00_VfReturn;
                    VAR errtext  : tsp00_ErrText);
 
      ------------------------------ 
 
        FROM
              Check-Date-Time : VGG03;
 
        PROCEDURE
              g03dchange_format_date (
                    VAR sbuf : tsp00_Timestamp;
                    VAR dbuf : tsp00_MoveObj;
                    spos     : tsp00_Int4;
                    dpos     : tsp00_Int4;
                    format   : tgg00_DateTimeFormat;
                    VAR e    : tgg00_BasisError);
 
        PROCEDURE
              g03tchange_format_time (
                    VAR sbuf : tsp00_Timestamp;
                    VAR dbuf : tsp00_MoveObj;
                    spos     : tsp00_Int4;
                    dpos     : tsp00_Int4;
                    format   : tgg00_DateTimeFormat;
                    VAR e    : tgg00_BasisError);
 
      ------------------------------ 
 
        FROM
              Kernel_move_and_fill : VGG101;
 
        PROCEDURE
              SAPDB_PascalForcedMove (
                    source_upb  : tsp00_Int4;
                    destin_upb  : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;
                    source_pos  : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;
                    destin_pos  : tsp00_Int4;
                    length      : tsp00_Int4);
 
        PROCEDURE
              g10mv (
                    mod_id      : tsp00_C6;            
                    mod_num     : tsp00_Int4;
                    source_upb  : tsp00_Int4;          
                    dest_upb    : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;       
                    src_pos     : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;       
                    dest_pos    : tsp00_Int4;
                    length      : tsp00_Int4;
                    VAR e       : tgg00_BasisError);
 
        PROCEDURE
              s10mv (
                    source_upb  : tsp00_Int4;       
                    destin_upb  : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;    
                    source_pos  : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;    
                    destin_pos  : tsp00_Int4;
                    length      : tsp00_Int4);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-30 : VSP30;
 
        FUNCTION
              s30gad1 (VAR b : tsp00_Ctable): tsp00_ObjAddr;
 
        PROCEDURE
              s30map (
                    VAR code_t   : tsp00_Ctable;
                    VAR source   : tsp00_MoveObj;
                    source_pos   : tsp00_Int4;
                    VAR destin   : tsp00_MoveObj;
                    destin_pos   : tsp00_Int4;
                    length       : tsp00_Int4);
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              g03dchange_format_date;
 
              tsp00_MoveObj tsp00_Timestamp
 
        PROCEDURE
              g03tchange_format_time;
 
              tsp00_MoveObj tsp00_Timestamp
 
        FUNCTION
              s30gad;
 
              tsp00_MoveObj tsp00_Buf
              tsp00_Addr tsp_vf_bufaddr
 
        FUNCTION
              s30gad1;
 
              tsp00_MoveObj tsp00_Ctable
              tsp00_Addr tsp00_ObjAddr
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  : ElkeZ
.sp
.cp 3
Created : 1979-03-01
.sp
.cp 3
.sp
.cp 3
Release :      Date : 1999-05-21
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
.sp 2;.cp 7
Procedure G02DUMP
.sp
This procedure writes the following G02 variables
to the specified host file:
.nf;.sp
G02TABS:   Dump_code = 1051
           G02CODETABLES.TABLES     8 * 256 bytes (total:2048 bytes)
 
.CM *-END-* specification -------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
 
.CM *-END-* description ---------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.nf
.oc _/1
Structure:
 
.CM *-END-* structure -----------------------------------
.sp 2
**********************************************************
.sp
.cp 10
.nf
.oc _/1
.CM -lll-
Code    :
 
 
CONST
      p4 = 2;
      p5 = 523;
      p6 = 133387;
 
 
(*------------------------------*) 
 
PROCEDURE
      g02hex (
            VAR source : tsp00_MoveObj;
            source_pos : tsp00_Int4;
            VAR dest   : tsp00_MoveObj;
            dest_pos   : tsp00_Int4;
            source_len : tsp00_Int4);
 
VAR
      pos      : tsp00_Int4;
      dec      : integer;
      i        : integer;
      hex_byte : ARRAY [ 1..2 ] OF integer;
 
BEGIN
FOR pos := source_pos TO source_pos + source_len - 1 DO
    BEGIN
    dec           := ord (source[ pos ]);
    hex_byte[ 1 ] := dec DIV 16;
    hex_byte[ 2 ] := dec MOD 16;
    FOR i := 1 TO 2 DO
        BEGIN
        IF  hex_byte[ i ] > 9
        THEN
            dest [ dest_pos ] := chr(ord('A')-10+ hex_byte[ i ])
        ELSE
            dest [ dest_pos ] := chr (ord('0') + hex_byte[ i ]);
        (*ENDIF*) 
        dest_pos := succ(dest_pos)
        END
    (*ENDFOR*) 
    END
(*ENDFOR*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      g02date_time_to_int (
            date_str     : tsp00_Date;
            time_str     : tsp00_Time;
            VAR date_int : tsp00_Int4;
            VAR time_int : tsp00_Int4);
 
VAR
      i      : integer;
      factor : tsp00_Int4;
 
BEGIN
date_int := 0;
time_int := 0;
IF  date_str <> bsp_date
THEN
    BEGIN
    factor := 1;
    FOR i := sizeof (date_str) DOWNTO 1 DO
        BEGIN
        date_int := date_int + factor * (ord (date_str[i]) - ord ('0'));
        factor := factor * 10
        END
    (*ENDFOR*) 
    END;
(*ENDIF*) 
IF  time_str <> bsp_time
THEN
    BEGIN
    factor := 1;
    FOR i := sizeof (time_str) DOWNTO 1 DO
        BEGIN
        time_int := time_int + factor * (ord (time_str[i]) - ord ('0'));
        factor := factor * 10
        END
    (*ENDFOR*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      g02datechange (
             VAR sbuf : tsp00_Timestamp;
            VAR dbuf : tsp00_MoveObj;
            spos     : integer;
            dpos     : tsp00_Int4;
            format   : tgg00_DateTimeFormat;
            VAR e    : tgg00_BasisError);
 
BEGIN
g03dchange_format_date(sbuf, dbuf, spos, dpos, format, e);
END;
 
(*------------------------------*) 
 
PROCEDURE
      g02decrypt (
            VAR clearname : tsp00_Name;
            VAR crypt : tsp00_CryptPw);
 
VAR
      i     : integer;
      left  : tsp00_Int4;
      right : tsp00_Int4;
      exp1  : tsp00_Int4;
      exp2  : tsp00_Int4;
      exp3  : tsp00_Int4;
      aux   : tsp00_CryptName;
 
BEGIN
s10mv (sizeof (crypt), sizeof (aux), @crypt, 1, @aux, 1, sizeof (crypt));
FOR i := 1 TO csp_cryptname DO
    IF  odd(aux[ i ])
    THEN
        aux[ i ] := - aux[ i ];
    (*ENDIF*) 
(*ENDFOR*) 
FOR i := 1 TO csp_cryptname DO
    BEGIN
    IF  i < csp_cryptname - 1
    THEN
        right := aux[ i + 1 ]
    ELSE
        right := p5;
    (*ENDIF*) 
    aux[ i ] := aux[ i ] - ((right MOD 61) * (p6 * 128 - 1));
    END;
(*ENDFOR*) 
FOR i := csp_cryptname DOWNTO 1 DO
    BEGIN
    IF  i > 1
    THEN
        left := aux[ i - 1 ]
    ELSE
        left := p6;
    (*ENDIF*) 
    aux[ i ] := aux[ i ] - ((left MOD 61) * (p6 * 126 - 1));
    END;
(*ENDFOR*) 
FOR i := 1 TO csp_cryptname DO
    BEGIN
    exp3 := aux[ i ];
    exp1 := exp3 DIV p6;
    exp2 := exp3 MOD p6;
    clearname[ 3*i - 2 ] := chr(exp1);
    exp3 := exp2;
    exp1 := exp3 DIV p5;
    exp2 := exp3 MOD p5;
    clearname[ 3*i - 1 ] := chr(exp1);
    exp3 := exp2;
    exp1 := exp3 DIV p4;
    exp2 := exp3 MOD p4;
    clearname[ 3*i ] := chr(exp1);
    END;
(*ENDFOR*) 
END;
 
&ifndef AUDIT
(*------------------------------*) 
 
PROCEDURE
      g02dump (
            VAR hostfile    : tgg00_VfFileref;
            VAR buf         : tsp00_Page;
            VAR out_pno     : tsp00_Int4;
            VAR out_pos     : integer;
            VAR host_err    : tsp00_VfReturn;
            VAR errtext     : tsp00_ErrText);
 
CONST
      mark1_g02tabs   = 'G02TABS ';
      code1_g02tabs   = 1051;
      mark2_g02term   = 'G02CSET ';
      code2_g02term   = 1052;
      fill_code       = 254;
 
VAR
      i2        : tsp_int_map_c2;
      i         : integer;
      dump_mark : tsp00_C8;
      buf_ptr   : tsp_vf_bufaddr;
 
BEGIN
host_err := vf_ok;
buf_ptr  := @buf;
g01new_dump_page (hostfile, buf, out_pno, out_pos, host_err, errtext);
IF  host_err = vf_ok
THEN
    BEGIN
    (* ---  G 0 2 T A B S  --- *)
    dump_mark := mark1_g02tabs;
    s10mv (sizeof (dump_mark), sizeof (buf), @dump_mark, 1,
          @buf, out_pos, sizeof (dump_mark));
    out_pos := out_pos + sizeof (dump_mark);
    i2.map_int        := code1_g02tabs;
    buf [ out_pos ]   := i2.map_c2[ 1 ];
    buf [ out_pos+1 ] := i2.map_c2[ 2 ];
    out_pos := out_pos + 2;
    WITH g02codetables DO
        FOR i := 1 TO MAX_CODE_TABLES_GG00 DO
            BEGIN
            s10mv (sizeof (tables [i]), sizeof (buf), @tables [i], 1,
                  @buf, out_pos, sizeof (tables [i]));
            out_pos := out_pos + sizeof (tables [i])
            END
        (*ENDFOR*) 
    (*ENDWITH*) 
    END;
(*ENDIF*) 
IF  (out_pos <> 1) AND (host_err = vf_ok)
THEN
    g01new_dump_page (hostfile, buf, out_pno, out_pos, host_err, errtext)
(*ENDIF*) 
END;
 
&endif
(*------------------------------*) 
 
PROCEDURE
      g02inittranslate_tables;
 
BEGIN
gg02it_one_part  (g02codetables);
gg02it_rest_part (g02codetables);
END;
 
(*------------------------------*) 
 
PROCEDURE
      g02pascii_pos_ebcdic (
            VAR source : tsp00_MoveObj;
            srcind   : tsp00_Int4;
            VAR dest : tsp00_MoveObj;
            destind  : tsp00_Int4;
            length   : tsp00_Int4);
 
BEGIN
s30map(g02codetables.tables[ cgg04_to_ebcdic ], source, srcind,
      dest, destind, length)
END;
 
(*------------------------------*) 
 
PROCEDURE
      g02p1ascii_pos_ebcdic(
            VAR source : tsp00_MoveObj;
            srcind   : tsp00_Int4;
            VAR dest : tsp00_MoveObj;
            destind  : tsp00_Int4;
            length   : tsp00_Int4);
 
BEGIN
s30map (g02codetables.tables[ cgg04_to_ebcdic ], source, srcind,
      dest, destind, length)
END;
 
(*------------------------------*) 
 
PROCEDURE
      g02p2ascii_pos_ebcdic(
            VAR source : tsp00_MoveObj;
            srcind   : tsp00_Int4;
            VAR dest : tsp00_MoveObj;
            destind  : tsp00_Int4;
            length   : tsp00_Int4);
 
BEGIN
s30map (g02codetables.tables[ cgg04_to_ebcdic ], source, srcind,
      dest, destind, length)
END;
 
(*------------------------------*) 
 
PROCEDURE
      g02p3ascii_pos_ebcdic(
            VAR source : tsp00_MoveObj;
            srcind   : tsp00_Int4;
            VAR dest : tsp00_MoveObj;
            destind  : tsp00_Int4;
            length   : tsp00_Int4);
 
BEGIN
s30map (g02codetables.tables[ cgg04_to_ebcdic ], source, srcind,
      dest, destind, length)
END;
 
(*------------------------------*) 
 
PROCEDURE
      g02pebcdic_pos_ascii (
            VAR source : tsp00_MoveObj;
            srcind   : tsp00_Int4;
            VAR dest : tsp00_MoveObj;
            destind  : tsp00_Int4;
            length   : tsp00_Int4);
 
BEGIN
s30map (g02codetables.tables[ cgg04_to_ascii ], source, srcind,
      dest, destind, length)
END;
 
(*------------------------------*) 
 
PROCEDURE
      g02p1ebcdic_pos_ascii (
            VAR source : tsp00_MoveObj;
            srcind   : tsp00_Int4;
            VAR dest : tsp00_MoveObj;
            destind  : tsp00_Int4;
            length   : tsp00_Int4);
 
BEGIN
s30map (g02codetables.tables[ cgg04_to_ascii ], source, srcind,
      dest, destind, length)
END;
 
(*------------------------------*) 
 
PROCEDURE
      g02p2ebcdic_pos_ascii (
            VAR source : tsp00_MoveObj;
            srcind   : tsp00_Int4;
            VAR dest : tsp00_MoveObj;
            destind  : tsp00_Int4;
            length   : tsp00_Int4);
 
BEGIN
s30map (g02codetables.tables[ cgg04_to_ascii ], source, srcind,
      dest, destind, length)
END;
 
(*------------------------------*) 
 
PROCEDURE
      g02p3ebcdic_pos_ascii (
            VAR source : tsp00_MoveObj;
            srcind   : tsp00_Int4;
            VAR dest : tsp00_MoveObj;
            destind  : tsp00_Int4;
            length   : tsp00_Int4);
 
BEGIN
s30map (g02codetables.tables[ cgg04_to_ascii ], source, srcind,
      dest, destind, length)
END;
 
(*------------------------------*) 
 
PROCEDURE
      g02tascii_to_ebcdic (
            VAR source : tsp00_MoveObj;
            VAR dest : tsp00_MoveObj;
            length   : tsp00_Int4);
 
BEGIN
s30map (g02codetables.tables[ cgg04_to_ebcdic ],
      source, 1, dest, 1, length)
END;
 
(*------------------------------*) 
 
PROCEDURE
      g02t1ascii_to_ebcdic (
            VAR source : tsp00_MoveObj;
            VAR dest : tsp00_MoveObj;
            length   : tsp00_Int4);
 
BEGIN
s30map (g02codetables.tables[ cgg04_to_ebcdic ],
      source, 1, dest, 1, length)
END;
 
(*------------------------------*) 
 
PROCEDURE
      g02tebcdic_to_ascii (
            VAR source : tsp00_MoveObj;
            VAR dest : tsp00_MoveObj;
            length   : tsp00_Int4);
 
BEGIN
s30map (g02codetables.tables[ cgg04_to_ascii ],
      source, 1, dest, 1, length)
END;
 
(*------------------------------*) 
 
PROCEDURE
      g02t1ebcdic_to_ascii (
            VAR source : tsp00_MoveObj;
            VAR dest : tsp00_MoveObj;
            length   : tsp00_Int4);
 
BEGIN
s30map (g02codetables.tables[ cgg04_to_ascii ],
      source, 1, dest, 1, length)
END;
 
(*------------------------------*) 
 
FUNCTION
      g02toupper (
            c : char;
            code_type : tsp00_CodeType ) : char;
 
BEGIN
IF  code_type = csp_ascii
THEN
    g02toupper := g02codetables.tables[ cgg04_up_ascii ] [ ord(c) + 1 ]
ELSE
    g02toupper := g02codetables.tables[ cgg04_up_ebcdic ] [ ord(c) + 1 ]
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      g02tolower (
            c : char;
            code_type : tsp00_CodeType ) : char;
 
BEGIN
IF  code_type = csp_ascii
THEN
    g02tolower := g02codetables.tables[ cgg04_low_ascii ] [ ord(c) + 1 ]
ELSE
    g02tolower := g02codetables.tables[ cgg04_low_ebcdic ] [ ord(c) + 1 ]
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      g02upstring (
            VAR source : tsp00_MoveObj;
            srcind   : tsp00_Int4;
            VAR dest : tsp00_MoveObj;
            destind  : tsp00_Int4;
            length   : tsp00_Int4;
            code_type : tsp00_CodeType );
 
BEGIN
IF  code_type = csp_ascii
THEN
    s30map (g02codetables.tables[ cgg04_up_ascii ],
          source, srcind, dest, destind, length)
ELSE
    s30map (g02codetables.tables[ cgg04_up_ebcdic ],
          source, srcind, dest, destind, length)
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      g02lowstring (
            VAR source : tsp00_MoveObj;
            srcind   : tsp00_Int4;
            VAR dest : tsp00_MoveObj;
            destind  : tsp00_Int4;
            length   : tsp00_Int4;
            code_type : tsp00_CodeType );
 
BEGIN
IF  code_type = csp_ascii
THEN
    s30map (g02codetables.tables[ cgg04_low_ascii ],
          source, srcind, dest, destind, length)
ELSE
    s30map (g02codetables.tables[ cgg04_low_ebcdic ],
          source, srcind, dest, destind, length)
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      g02timechange (
             VAR sbuf : tsp00_Timestamp;
            VAR dbuf : tsp00_MoveObj;
            spos     : integer;
            dpos     : tsp00_Int4;
            format   : tgg00_DateTimeFormat;
            VAR e    : tgg00_BasisError);
 
BEGIN
g03tchange_format_time (sbuf, dbuf, spos, dpos, format, e);
END;
 
(*------------------------------*) 
 
PROCEDURE
      gg02it_one_part(VAR codetabs : tgg04_CodeTables);
 
VAR
      i : integer;
 
BEGIN
WITH codetabs DO
    BEGIN
    (* asciiebcdic  => codetabs.tables[ x ], x = ord(ascii) *)
    tables[ cgg04_to_ebcdic,   1 ] := chr (  0); (* nul *)
    tables[ cgg04_to_ebcdic,   2 ] := chr (  1); (* soh *)
    tables[ cgg04_to_ebcdic,   3 ] := chr (  2); (* stx *)
    tables[ cgg04_to_ebcdic,   4 ] := chr (  3); (* etx *)
    tables[ cgg04_to_ebcdic,   5 ] := chr ( 55); (* eot *)
    tables[ cgg04_to_ebcdic,   6 ] := chr ( 45); (* enq *)
    tables[ cgg04_to_ebcdic,   7 ] := chr ( 46); (* ack *)
    tables[ cgg04_to_ebcdic,   8 ] := chr ( 47); (* bel *)
    tables[ cgg04_to_ebcdic,   9 ] := chr ( 22); (* bs  *)
    tables[ cgg04_to_ebcdic,  10 ] := chr (  5); (* ht *)
    tables[ cgg04_to_ebcdic,  11 ] := chr ( 37); (* lf *)
    tables[ cgg04_to_ebcdic,  12 ] := chr ( 11); (* vt *)
    tables[ cgg04_to_ebcdic,  13 ] := chr ( 12); (* ff *)
    tables[ cgg04_to_ebcdic,  14 ] := chr ( 13); (* cr *)
    tables[ cgg04_to_ebcdic,  15 ] := chr ( 14); (* so *)
    tables[ cgg04_to_ebcdic,  16 ] := chr ( 15); (* si *)
    tables[ cgg04_to_ebcdic,  17 ] := chr ( 16); (* dle *)
    tables[ cgg04_to_ebcdic,  18 ] := chr ( 17); (* dc1 *)
    tables[ cgg04_to_ebcdic,  19 ] := chr ( 18); (* dc2 *)
    tables[ cgg04_to_ebcdic,  20 ] := chr ( 19); (* dc3 *)
    tables[ cgg04_to_ebcdic,  21 ] := chr ( 60); (* dc4 *)
    tables[ cgg04_to_ebcdic,  22 ] := chr ( 61); (* nak *)
    tables[ cgg04_to_ebcdic,  23 ] := chr ( 50); (* syn *)
    tables[ cgg04_to_ebcdic,  24 ] := chr ( 38); (* etb *)
    tables[ cgg04_to_ebcdic,  25 ] := chr ( 24); (* can *)
    tables[ cgg04_to_ebcdic,  26 ] := chr ( 25); (* em *)
    tables[ cgg04_to_ebcdic,  27 ] := chr ( 63); (* sub *)
    tables[ cgg04_to_ebcdic,  28 ] := chr ( 39); (* esc *)
    tables[ cgg04_to_ebcdic,  29 ] := chr ( 28); (* fs *)
    tables[ cgg04_to_ebcdic,  30 ] := chr ( 29); (* gs *)
    tables[ cgg04_to_ebcdic,  31 ] := chr ( 30); (* rs *)
    tables[ cgg04_to_ebcdic,  32 ] := chr ( 31); (* us *)
    tables[ cgg04_to_ebcdic,  33 ] := chr ( 64); (* sp *)
    tables[ cgg04_to_ebcdic,  34 ] := chr ( 79); (* ! *)
    tables[ cgg04_to_ebcdic,  35 ] := chr (127); (* " *)
    tables[ cgg04_to_ebcdic,  36 ] := chr (123); (* # *)
    tables[ cgg04_to_ebcdic,  37 ] := chr ( 91); (* $ *)
    tables[ cgg04_to_ebcdic,  38 ] := chr (108); (* % *)
    tables[ cgg04_to_ebcdic,  39 ] := chr ( 80); (* & *)
    tables[ cgg04_to_ebcdic,  40 ] := chr (125); (* ' *)
    tables[ cgg04_to_ebcdic,  41 ] := chr ( 77); (* ( *)
    tables[ cgg04_to_ebcdic,  42 ] := chr ( 93); (* ) *)
    tables[ cgg04_to_ebcdic,  43 ] := chr ( 92); (* * *)
    tables[ cgg04_to_ebcdic,  44 ] := chr ( 78); (* + *)
    tables[ cgg04_to_ebcdic,  45 ] := chr (107); (* , *)
    tables[ cgg04_to_ebcdic,  46 ] := chr ( 96); (* - *)
    tables[ cgg04_to_ebcdic,  47 ] := chr ( 75); (* . *)
    tables[ cgg04_to_ebcdic,  48 ] := chr ( 97); (* / *)
    tables[ cgg04_to_ebcdic,  49 ] := chr (240); (* 0 *)
    tables[ cgg04_to_ebcdic,  50 ] := chr (241); (* 1 *)
    tables[ cgg04_to_ebcdic,  51 ] := chr (242); (* 2 *)
    tables[ cgg04_to_ebcdic,  52 ] := chr (243); (* 3 *)
    tables[ cgg04_to_ebcdic,  53 ] := chr (244); (* 4 *)
    tables[ cgg04_to_ebcdic,  54 ] := chr (245); (* 5 *)
    tables[ cgg04_to_ebcdic,  55 ] := chr (246); (* 6 *)
    tables[ cgg04_to_ebcdic,  56 ] := chr (247); (* 7 *)
    tables[ cgg04_to_ebcdic,  57 ] := chr (248); (* 8 *)
    tables[ cgg04_to_ebcdic,  58 ] := chr (249); (* 9 *)
    tables[ cgg04_to_ebcdic,  59 ] := chr (122); (* : *)
    tables[ cgg04_to_ebcdic,  60 ] := chr ( 94); (* ; *)
    tables[ cgg04_to_ebcdic,  61 ] := chr ( 76); (* < *)
    tables[ cgg04_to_ebcdic,  62 ] := chr (126); (* = *)
    tables[ cgg04_to_ebcdic,  63 ] := chr (110); (* > *)
    tables[ cgg04_to_ebcdic,  64 ] := chr (111); (* ?? *)
    tables[ cgg04_to_ebcdic,  65 ] := chr (124); (* @ *)
    tables[ cgg04_to_ebcdic,  66 ] := chr (193); (* A *)
    tables[ cgg04_to_ebcdic,  67 ] := chr (194); (* B *)
    tables[ cgg04_to_ebcdic,  68 ] := chr (195); (* C *)
    tables[ cgg04_to_ebcdic,  69 ] := chr (196); (* D *)
    tables[ cgg04_to_ebcdic,  70 ] := chr (197); (* E *)
    tables[ cgg04_to_ebcdic,  71 ] := chr (198); (* F *)
    tables[ cgg04_to_ebcdic,  72 ] := chr (199); (* G *)
    tables[ cgg04_to_ebcdic,  73 ] := chr (200); (* H *)
    tables[ cgg04_to_ebcdic,  74 ] := chr (201); (* I *)
    tables[ cgg04_to_ebcdic,  75 ] := chr (209); (* J *)
    tables[ cgg04_to_ebcdic,  76 ] := chr (210); (* K *)
    tables[ cgg04_to_ebcdic,  77 ] := chr (211); (* L *)
    tables[ cgg04_to_ebcdic,  78 ] := chr (212); (* M *)
    tables[ cgg04_to_ebcdic,  79 ] := chr (213); (* N *)
    tables[ cgg04_to_ebcdic,  80 ] := chr (214); (* O *)
    tables[ cgg04_to_ebcdic,  81 ] := chr (215); (* P *)
    tables[ cgg04_to_ebcdic,  82 ] := chr (216); (* Q *)
    tables[ cgg04_to_ebcdic,  83 ] := chr (217); (* R *)
    tables[ cgg04_to_ebcdic,  84 ] := chr (226); (* S *)
    tables[ cgg04_to_ebcdic,  85 ] := chr (227); (* T *)
    tables[ cgg04_to_ebcdic,  86 ] := chr (228); (* U *)
    tables[ cgg04_to_ebcdic,  87 ] := chr (229); (* V *)
    tables[ cgg04_to_ebcdic,  88 ] := chr (230); (* W *)
    tables[ cgg04_to_ebcdic,  89 ] := chr (231); (* X *)
    tables[ cgg04_to_ebcdic,  90 ] := chr (232); (* Y *)
    tables[ cgg04_to_ebcdic,  91 ] := chr (233); (* Z *)
    tables[ cgg04_to_ebcdic,  92 ] := chr ( 74); (* [  *)
    tables[ cgg04_to_ebcdic,  93 ] := chr (224); (* backslash *)
    tables[ cgg04_to_ebcdic,  94 ] := chr ( 90); (*  ] *)
    tables[ cgg04_to_ebcdic,  95 ] := chr ( 95); (* roof *)
    tables[ cgg04_to_ebcdic,  96 ] := chr (109); (* _ *)
    tables[ cgg04_to_ebcdic,  97 ] := chr (121);
    tables[ cgg04_to_ebcdic,  98 ] := chr (129); (* a *)
    tables[ cgg04_to_ebcdic,  99 ] := chr (130); (* b *)
    tables[ cgg04_to_ebcdic, 100 ] := chr (131); (* c *)
    tables[ cgg04_to_ebcdic, 101 ] := chr (132); (* d *)
    tables[ cgg04_to_ebcdic, 102 ] := chr (133); (* e *)
    tables[ cgg04_to_ebcdic, 103 ] := chr (134); (* f *)
    tables[ cgg04_to_ebcdic, 104 ] := chr (135); (* g *)
    tables[ cgg04_to_ebcdic, 105 ] := chr (136); (* h *)
    tables[ cgg04_to_ebcdic, 106 ] := chr (137); (* i *)
    tables[ cgg04_to_ebcdic, 107 ] := chr (145); (* j *)
    tables[ cgg04_to_ebcdic, 108 ] := chr (146); (* k *)
    tables[ cgg04_to_ebcdic, 109 ] := chr (147); (* l *)
    tables[ cgg04_to_ebcdic, 110 ] := chr (148); (* m *)
    tables[ cgg04_to_ebcdic, 111 ] := chr (149); (* n *)
    tables[ cgg04_to_ebcdic, 112 ] := chr (150); (* o *)
    tables[ cgg04_to_ebcdic, 113 ] := chr (151); (* p *)
    tables[ cgg04_to_ebcdic, 114 ] := chr (152); (* q *)
    tables[ cgg04_to_ebcdic, 115 ] := chr (153); (* r *)
    tables[ cgg04_to_ebcdic, 116 ] := chr (162); (* s *)
    tables[ cgg04_to_ebcdic, 117 ] := chr (163); (* t *)
    tables[ cgg04_to_ebcdic, 118 ] := chr (164); (* u *)
    tables[ cgg04_to_ebcdic, 119 ] := chr (165); (* v *)
    tables[ cgg04_to_ebcdic, 120 ] := chr (166); (* w *)
    tables[ cgg04_to_ebcdic, 121 ] := chr (167); (* x *)
    tables[ cgg04_to_ebcdic, 122 ] := chr (168); (* y *)
    tables[ cgg04_to_ebcdic, 123 ] := chr (169); (* z *)
    tables[ cgg04_to_ebcdic, 124 ] := chr (192);
    tables[ cgg04_to_ebcdic, 125 ] := chr (187); (* vertical line *)
    tables[ cgg04_to_ebcdic, 126 ] := chr (208);
    tables[ cgg04_to_ebcdic, 127 ] := chr (161);
    tables[ cgg04_to_ebcdic, 128 ] := chr (  7); (* del *)
    tables[ cgg04_to_ebcdic, 129 ] := chr (  4);
    tables[ cgg04_to_ebcdic, 130 ] := chr (  6);
    tables[ cgg04_to_ebcdic, 131 ] := chr (  8);
    tables[ cgg04_to_ebcdic, 132 ] := chr (  9);
    tables[ cgg04_to_ebcdic, 133 ] := chr ( 10);
    tables[ cgg04_to_ebcdic, 134 ] := chr ( 20);
    tables[ cgg04_to_ebcdic, 135 ] := chr ( 21);
    tables[ cgg04_to_ebcdic, 136 ] := chr ( 23);
    tables[ cgg04_to_ebcdic, 137 ] := chr ( 26);
    tables[ cgg04_to_ebcdic, 138 ] := chr ( 27);
    tables[ cgg04_to_ebcdic, 139 ] := chr ( 32);
    tables[ cgg04_to_ebcdic, 140 ] := chr ( 33);
    tables[ cgg04_to_ebcdic, 141 ] := chr ( 34);
    tables[ cgg04_to_ebcdic, 142 ] := chr ( 35);
    tables[ cgg04_to_ebcdic, 143 ] := chr ( 36);
    tables[ cgg04_to_ebcdic, 144 ] := chr ( 40);
    tables[ cgg04_to_ebcdic, 145 ] := chr ( 41);
    tables[ cgg04_to_ebcdic, 146 ] := chr ( 42);
    tables[ cgg04_to_ebcdic, 147 ] := chr ( 43);
    tables[ cgg04_to_ebcdic, 148 ] := chr ( 44);
    tables[ cgg04_to_ebcdic, 149 ] := chr ( 48);
    tables[ cgg04_to_ebcdic, 150 ] := chr ( 49);
    tables[ cgg04_to_ebcdic, 151 ] := chr ( 51);
    tables[ cgg04_to_ebcdic, 152 ] := chr ( 52);
    tables[ cgg04_to_ebcdic, 153 ] := chr ( 53);
    tables[ cgg04_to_ebcdic, 154 ] := chr ( 54);
    tables[ cgg04_to_ebcdic, 155 ] := chr ( 56);
    tables[ cgg04_to_ebcdic, 156 ] := chr ( 57);
    tables[ cgg04_to_ebcdic, 157 ] := chr ( 58);
    tables[ cgg04_to_ebcdic, 158 ] := chr ( 59);
    tables[ cgg04_to_ebcdic, 159 ] := chr ( 62);
    tables[ cgg04_to_ebcdic, 160 ] := chr (255);
    tables[ cgg04_to_ebcdic, 161 ] := chr ( 65);
    tables[ cgg04_to_ebcdic, 162 ] := chr (170);
    tables[ cgg04_to_ebcdic, 163 ] := chr (176);
    tables[ cgg04_to_ebcdic, 164 ] := chr (177);
    tables[ cgg04_to_ebcdic, 165 ] := chr (159);
    tables[ cgg04_to_ebcdic, 166 ] := chr (178);
    tables[ cgg04_to_ebcdic, 167 ] := chr (106);
    tables[ cgg04_to_ebcdic, 168 ] := chr (181);
    tables[ cgg04_to_ebcdic, 169 ] := chr (189);
    tables[ cgg04_to_ebcdic, 170 ] := chr (180);
    tables[ cgg04_to_ebcdic, 171 ] := chr (154);
    tables[ cgg04_to_ebcdic, 172 ] := chr (138);
    tables[ cgg04_to_ebcdic, 173 ] := chr (186);
    tables[ cgg04_to_ebcdic, 174 ] := chr (202);
    tables[ cgg04_to_ebcdic, 175 ] := chr (175);
    tables[ cgg04_to_ebcdic, 176 ] := chr (188);
    tables[ cgg04_to_ebcdic, 177 ] := chr (144);
    tables[ cgg04_to_ebcdic, 178 ] := chr (143);
    tables[ cgg04_to_ebcdic, 179 ] := chr (234);
    tables[ cgg04_to_ebcdic, 180 ] := chr (250);
    tables[ cgg04_to_ebcdic, 181 ] := chr (190);
    tables[ cgg04_to_ebcdic, 182 ] := chr (160);
    tables[ cgg04_to_ebcdic, 183 ] := chr (182);
    tables[ cgg04_to_ebcdic, 184 ] := chr (179);
    tables[ cgg04_to_ebcdic, 185 ] := chr (157);
    tables[ cgg04_to_ebcdic, 186 ] := chr (218);
    tables[ cgg04_to_ebcdic, 187 ] := chr (155);
    tables[ cgg04_to_ebcdic, 188 ] := chr (139);
    tables[ cgg04_to_ebcdic, 189 ] := chr (183);
    tables[ cgg04_to_ebcdic, 190 ] := chr (184);
    tables[ cgg04_to_ebcdic, 191 ] := chr (185);
    tables[ cgg04_to_ebcdic, 192 ] := chr (171);
    tables[ cgg04_to_ebcdic, 193 ] := chr (100);
    tables[ cgg04_to_ebcdic, 194 ] := chr (101);
    tables[ cgg04_to_ebcdic, 195 ] := chr ( 98);
    tables[ cgg04_to_ebcdic, 196 ] := chr (102);
    tables[ cgg04_to_ebcdic, 197 ] := chr ( 99);
    tables[ cgg04_to_ebcdic, 198 ] := chr (103);
    tables[ cgg04_to_ebcdic, 199 ] := chr (158);
    tables[ cgg04_to_ebcdic, 200 ] := chr (104);
    tables[ cgg04_to_ebcdic, 201 ] := chr (116);
    tables[ cgg04_to_ebcdic, 202 ] := chr (113);
    tables[ cgg04_to_ebcdic, 203 ] := chr (114);
    tables[ cgg04_to_ebcdic, 204 ] := chr (115);
    tables[ cgg04_to_ebcdic, 205 ] := chr (120);
    tables[ cgg04_to_ebcdic, 206 ] := chr (117);
    tables[ cgg04_to_ebcdic, 207 ] := chr (118);
    tables[ cgg04_to_ebcdic, 208 ] := chr (119);
    tables[ cgg04_to_ebcdic, 209 ] := chr (172);
    tables[ cgg04_to_ebcdic, 210 ] := chr (105);
    tables[ cgg04_to_ebcdic, 211 ] := chr (237);
    tables[ cgg04_to_ebcdic, 212 ] := chr (238);
    tables[ cgg04_to_ebcdic, 213 ] := chr (235);
    tables[ cgg04_to_ebcdic, 214 ] := chr (239);
    tables[ cgg04_to_ebcdic, 215 ] := chr (236);
    tables[ cgg04_to_ebcdic, 216 ] := chr (191);
    tables[ cgg04_to_ebcdic, 217 ] := chr (128);
    tables[ cgg04_to_ebcdic, 218 ] := chr (253);
    tables[ cgg04_to_ebcdic, 219 ] := chr (254);
    tables[ cgg04_to_ebcdic, 220 ] := chr (251);
    tables[ cgg04_to_ebcdic, 221 ] := chr (252);
    tables[ cgg04_to_ebcdic, 222 ] := chr (173);
    tables[ cgg04_to_ebcdic, 223 ] := chr (174);
    tables[ cgg04_to_ebcdic, 224 ] := chr ( 89);
    tables[ cgg04_to_ebcdic, 225 ] := chr ( 68);
    tables[ cgg04_to_ebcdic, 226 ] := chr ( 69);
    tables[ cgg04_to_ebcdic, 227 ] := chr ( 66);
    tables[ cgg04_to_ebcdic, 228 ] := chr ( 70);
    tables[ cgg04_to_ebcdic, 229 ] := chr ( 67);
    tables[ cgg04_to_ebcdic, 230 ] := chr ( 71);
    tables[ cgg04_to_ebcdic, 231 ] := chr (156);
    tables[ cgg04_to_ebcdic, 232 ] := chr ( 72);
    tables[ cgg04_to_ebcdic, 233 ] := chr ( 84);
    tables[ cgg04_to_ebcdic, 234 ] := chr ( 81);
    tables[ cgg04_to_ebcdic, 235 ] := chr ( 82);
    tables[ cgg04_to_ebcdic, 236 ] := chr ( 83);
    tables[ cgg04_to_ebcdic, 237 ] := chr ( 88);
    tables[ cgg04_to_ebcdic, 238 ] := chr ( 85);
    tables[ cgg04_to_ebcdic, 239 ] := chr ( 86);
    tables[ cgg04_to_ebcdic, 240 ] := chr ( 87);
    tables[ cgg04_to_ebcdic, 241 ] := chr (140);
    tables[ cgg04_to_ebcdic, 242 ] := chr ( 73);
    tables[ cgg04_to_ebcdic, 243 ] := chr (205);
    tables[ cgg04_to_ebcdic, 244 ] := chr (206);
    tables[ cgg04_to_ebcdic, 245 ] := chr (203);
    tables[ cgg04_to_ebcdic, 246 ] := chr (207);
    tables[ cgg04_to_ebcdic, 247 ] := chr (204);
    tables[ cgg04_to_ebcdic, 248 ] := chr (225);
    tables[ cgg04_to_ebcdic, 249 ] := chr (112);
    tables[ cgg04_to_ebcdic, 250 ] := chr (221);
    tables[ cgg04_to_ebcdic, 251 ] := chr (222);
    tables[ cgg04_to_ebcdic, 252 ] := chr (219);
    tables[ cgg04_to_ebcdic, 253 ] := chr (220);
    tables[ cgg04_to_ebcdic, 254 ] := chr (141);
    tables[ cgg04_to_ebcdic, 255 ] := chr (142);
    tables[ cgg04_to_ebcdic, 256 ] := chr (223);
    FOR i := 1 TO 256 DO
        tables[ cgg04_to_ascii, succ(ord(tables[ cgg04_to_ebcdic,i ])) ] :=
              chr(pred(i));
    (*ENDFOR*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      gg02it_rest_part (VAR codetabs : tgg04_CodeTables);
 
VAR
      i : integer;
 
BEGIN
WITH codetabs DO
    BEGIN
    (* tables[ 4 ] ::= small_ascii_to_capital_ascii *)
    FOR i := 0 TO 255 DO
        tables[ cgg04_up_ascii, i+1 ] := chr (i);
    (*ENDFOR*) 
    FOR i := 97 TO 122 DO
        tables[ cgg04_up_ascii, i+1 ] := chr (i-32);
    (*ENDFOR*) 
    FOR i := 224 TO 246 DO
        tables[ cgg04_up_ascii, i+1 ] := chr (i-32);
    (*ENDFOR*) 
    FOR i := 248 TO 254 DO
        tables[ cgg04_up_ascii, i+1 ] := chr (i-32);
    (*ENDFOR*) 
    (* tables[ 8 ] ::= capital_ascii_to_small_ascii *)
    FOR i := 0 TO 255 DO
        tables[ cgg04_low_ascii, i+1 ] := chr (i);
    (*ENDFOR*) 
    FOR i := 65 TO 90 DO (* 'A' to 'Z' *)
        tables[ cgg04_low_ascii, i+1 ] := chr (i+32);
    (*ENDFOR*) 
    FOR i := 192 TO 214 DO
        tables[ cgg04_low_ascii, i+1 ] := chr (i+32);
    (*ENDFOR*) 
    FOR i := 216 TO 222 DO
        tables[ cgg04_low_ascii, i+1 ] := chr (i+32);
    (*ENDFOR*) 
    (* tables[ 3 ] ::= small_ebcdic_to_capital_ebcdic *)
    FOR i := 0 TO 255 DO
        tables[ cgg04_up_ebcdic, i+1 ] := tables[ cgg04_to_ascii, i+1 ];
    (*ENDFOR*) 
    FOR i := 0 TO 255 DO
        tables[ cgg04_up_ebcdic, i+1 ] :=
              tables[ cgg04_up_ascii, succ(ord(tables[ cgg04_up_ebcdic, i+1 ])) ];
    (*ENDFOR*) 
    FOR i := 0 TO 255 DO
        tables[ cgg04_up_ebcdic, i+1 ] :=
              tables[ cgg04_to_ebcdic, succ(ord(tables[ cgg04_up_ebcdic, i+1 ])) ];
    (*ENDFOR*) 
    (* tables[ 7 ] ::= capital_ebcdic_to_small_ebcdic *)
    FOR i := 0 TO 255 DO
        tables[ cgg04_low_ebcdic, i+1 ] := tables[ cgg04_to_ascii, i+1 ];
    (*ENDFOR*) 
    FOR i := 0 TO 255 DO
        tables[ cgg04_low_ebcdic, i+1 ] :=
              tables[ cgg04_low_ascii, succ(ord(tables[ cgg04_low_ebcdic,i+1 ])) ];
    (*ENDFOR*) 
    FOR i := 0 TO 255 DO
        tables[ cgg04_low_ebcdic, i+1 ] :=
              tables[ cgg04_to_ebcdic, succ(ord(tables[ cgg04_low_ebcdic,i+1 ])) ];
    (*ENDFOR*) 
    (* tables[ 5 ] ::= small_ascii_to_capital_ebcdic*)
    tables[ cgg04_to_up_ebcdic ] := tables[ cgg04_to_ebcdic ];
    FOR i := 0 TO 255 DO
        tables[ cgg04_to_up_ebcdic, i+1 ] :=
              tables[ cgg04_up_ebcdic,
              succ(ord(tables[ cgg04_to_up_ebcdic, i+1 ])) ];
    (*ENDFOR*) 
    (* tables[ 6 ] ::= small_ebcdic_to_capital_ascii *)
    tables[ cgg04_to_up_ascii ] := tables[ cgg04_to_ascii ];
    FOR i := 0 TO 255 DO
        tables[ cgg04_to_up_ascii, i+1 ] :=
              tables[ cgg04_up_ascii,
              succ(ord(tables[ cgg04_to_up_ascii, i+1 ])) ];
    (*ENDFOR*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      g02exporttables (
            VAR upptab : tsp00_ObjAddr;
            VAR lowtab : tsp00_ObjAddr;
            VAR asctab : tsp00_ObjAddr;
            VAR ebctab : tsp00_ObjAddr);
 
BEGIN
WITH g02codetables DO
    BEGIN
    IF  bsp_c1 = chr(32)
    THEN
        BEGIN
        upptab := s30gad1(tables[cgg04_up_ascii]);
        lowtab := s30gad1(tables[cgg04_low_ascii]);
        END
    ELSE
        BEGIN
        upptab := s30gad1(tables[cgg04_up_ebcdic]);
        lowtab := s30gad1(tables[cgg04_low_ebcdic]);
        END;
    (*ENDIF*) 
    asctab := s30gad1(tables[cgg04_to_ascii]);
    ebctab := s30gad1(tables[cgg04_to_ebcdic]);
    END;
(*ENDWITH*) 
END;
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
.PA 
