.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$VSP78$
.tt 2 $$$
.tt 3 $$date_time_formatting$2000-05-04$
***********************************************************
.nf
 
 .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
 
 
.fo
.nf
.sp
Module  : date_time_formatting
=========
.sp
Purpose : Constants and types used for formatting of date, time or timestamps
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        PROCEDURE
              s78dict_next_msgno (VAR msgno : tsp00_Int2;
                    VAR done : boolean);
 
        PROCEDURE
              s78dict_insert_row (VAR dictionary : tsp6_dictionary;
                    bufptr        : tsp00_MoveObjPtr;
                    buf_len       : tsp00_Int4;
                    VAR is_ok     : boolean);
 
        PROCEDURE
              s78lang_spell_init (VAR dictionary : tsp6_dictionary;
                    bufptr        : tsp00_MoveObjPtr;
                    buf_len       : tsp00_Int4;
                    dict_kind     : integer;
                    VAR i         : integer;
                    VAR is_ok     : boolean);
 
        PROCEDURE
              s78language (VAR dictionaries : tsp6_dictionaries;
                    VAR language_name : tsp00_C3;
                    VAR language_no   : tsp6_language;
                    for_init          : boolean;
                    VAR is_ok         : boolean);
 
        PROCEDURE
              s78df_analyze (format_addr : tsp00_MoveObjPtr;
                    format_len     : tsp00_Int2;
                    dest_addr      : tsp00_MoveObjPtr;
                    VAR dest_len   : tsp00_Int2;
                    to_date_format : boolean;
                    VAR e          : tsp6_date_error);
 
        PROCEDURE
              s78df_default (dest_addr : tsp00_MoveObjPtr;
                    VAR dest_len : tsp00_Int2;
                    VAR e        : tsp6_date_error);
 
        PROCEDURE
              s78df_len1 (format_addr : tsp00_MoveObjPtr;
                    format_len  : tsp00_Int2;
                    VAR df_elem : tsp6_date_fmt_elem;
                    VAR e       : tsp6_date_error);
 
        PROCEDURE
              s78df_clear (VAR dictionary : tsp6_dictionary;
                    format_addr : tsp00_MoveObjPtr;
                    format_len  : integer;
                    dest_addr   : tsp00_MoveObjPtr;
                    dest_size   : integer);
 
        PROCEDURE
              s78d2c_to_char (VAR dictionary : tsp6_dictionary;
                    ts_addr      : tsp00_MoveObjPtr;
                    format_addr  : tsp00_MoveObjPtr;
                    format_len   : integer;
                    dest_size    : integer;
                    dest_addr    : tsp00_MoveObjPtr;
                    VAR dest_pos : integer;
                    dest_len     : integer;
                    VAR e        : tsp6_date_error);
 
        PROCEDURE
              s78c2d_to_date (VAR dictionary : tsp6_dictionary;
                    curr_date    : tsp00_MoveObjPtr;
                    fmt_addr     : tsp00_MoveObjPtr;
                    fmt_len      : tsp00_Int4;
                    src_addr     : tsp00_MoveObjPtr;
                    src_len      : tsp00_Int4;
                    dest_addr    : tsp00_MoveObjPtr;
                    VAR dest_pos : tsp00_Int4;
                    VAR e        : tsp6_date_error);
 
        PROCEDURE
              s78ints_from_buf (VAR buf : tsp00_MoveObj;
                    pos           : tsp00_Int4;
                    VAR timestamp : tsp6_timestamp_array;
                    VAR e         : tsp6_date_error);
 
        PROCEDURE
              s78ints_to_buf (VAR buf : tsp00_MoveObj;
                    pos           : tsp00_Int4;
                    VAR timestamp : tsp6_timestamp_array);
 
        PROCEDURE
              s78time_from_buf (VAR buf : tsp00_MoveObj;
                    timepos  : tsp00_Int4;
                    timelen  : integer;
                    VAR hour : integer;
                    VAR min  : integer;
                    VAR sec  : integer;
                    VAR e    : tsp6_date_error);
 
        PROCEDURE
              s78val_from_buf (VAR buf : tsp00_MoveObj;
                    pos           : tsp00_Int4;
                    VAR year_hour : integer;
                    VAR month_min : integer;
                    VAR day_sec   : integer;
                    ret_error     : tsp6_date_error;
                    VAR e         : tsp6_date_error);
 
        PROCEDURE
              s78val_to_buf (VAR buf : tsp00_MoveObj;
                    pos       : tsp00_Int4;
                    year_hour : integer;
                    month_min : integer;
                    day_sec   : integer);
 
        PROCEDURE
              s78year_month_day (VAR datbuf : tsp00_MoveObj;
                    datpos    : tsp00_Int4;
                    VAR year  : integer;
                    VAR month : integer;
                    VAR day   : integer;
                    VAR e     : tsp6_date_error);
 
        PROCEDURE
              s78week_and_day (VAR datbuf : tsp00_MoveObj;
                    datpos          : tsp00_Int4;
                    VAR week        : integer;
                    VAR day_of_week : integer;
                    VAR e           : tsp6_date_error);
 
        PROCEDURE
              s78year_and_day (VAR datbuf : tsp00_MoveObj;
                    datpos    : tsp00_Int4;
                    VAR year  : integer;
                    VAR day   : integer;
                    VAR e     : tsp6_date_error);
 
        FUNCTION
              s78day_sec (VAR datbuf : tsp00_MoveObj;
                    datpos : tsp00_Int4;
                    VAR e  : tsp6_date_error) : integer;
 
        FUNCTION
              s78days_of_month (year : integer; month : integer): integer;
 
        FUNCTION
              s78t_dest_len_date_format (VAR format : tsp00_MoveObj;
                    fmt_pos : tsp00_Int4;
                    fmt_len : tsp00_Int4) : tsp00_Int2;
 
        FUNCTION
              s78is_leap_year (year : integer) : boolean;
 
        FUNCTION
              s78days_of_year (year : integer) : integer;
 
        FUNCTION
              s78diff_year_day (year1 : integer;
                    day1  : integer;
                    year2 : integer;
                    day2  : integer) : tsp00_Int4;
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              Kernel_move_and_fill : VGG101;
 
        PROCEDURE
              SAPDB_PascalForcedFill (
                    size        : tsp00_Int4;
                    m           : tsp00_MoveObjPtr;
                    pos         : tsp00_Int4;
                    len         : tsp00_Int4;
                    fillchar    : char);
 
        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
              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;
 
        PROCEDURE
              s30cmp (VAR buf1   : tsp00_MoveObj;
                    fieldpos1    : tsp00_Int4;
                    fieldlength1 : tsp00_Int4;
                    VAR buf2     : tsp00_C12;
                    fieldpos2    : tsp00_Int4;
                    fieldlength2 : tsp00_Int4;
                    VAR l_result : tsp00_LcompResult);
 
        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
              s30cmp;
 
              tsp00_MoveObj tsp00_C12
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  :
.sp
.cp 3
Created : 1997-06-03
.sp
.cp 3
.sp
.cp 3
Release :      Date : 2000-05-04
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
.fo
.sp 2;.cp 3
Procedure S78ONE_SPELL_DICT_INIT
.sp
Initializes parts of the given dictionary with the values
described by the 80 byte long string pointer to by bufptr.
 
 
.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
      monday               = 1;
      (*   tuesday         = 2;   *)
      (*   wednesday       = 3;   *)
      (*   thursday        = 4;   *)
      friday               = 5;
      saturday             = 6;
      sunday               = 7;
      c_ordinal            = true;    (* g03dict_...  *)
      c_julian_base_year   = 763;
      c_julian_base_day    = 261;     (* 18.09.       *)
      c_julian_base_offset = 2000000; (* 18.09.0763   *)
      c_julian_min_day     = 1721424; (* 01.01.0001   *)
      c_format_magic       = 16;
      c_to_date_format     = true;    (* s78df_analyze *)
      csp78_19_min_msgno     = 17610;
      csp78_19_max_msgno     = 17613;
      csp78_90_min_msgno     = 17620;
      csp78_90_max_msgno     = 17621;
      csp78_19th_min_msgno   = 17630;
      csp78_19th_max_msgno   = 17633;
      csp78_90th_min_msgno   = 17640;
      csp78_90th_max_msgno   = 17641;
      csp78_etc_min_msgno    = 17650;
      csp78_etc_max_msgno    = 17651;
      csp78_mon_min_msgno    = 17660;
      csp78_mon_max_msgno    = 17662;
      csp78_day_min_msgno    = 17670;
      csp78_day_max_msgno    = 17671;
      csp78_rom_min_msgno    = 17680;
      csp78_rom_max_msgno    = 17682;
      csp78_mer_min_msgno    = 17690;
      csp78_mer_max_msgno    = 17691;
 
TYPE
 
      format_cast = RECORD
            CASE boolean OF
                true :
                    (format_int : tsp00_Uint1);
                false :
                    (fmt        : tsp6_date_fmt_elem);
                END;
            (*ENDCASE*) 
 
      mod_set = SET OF (
            mod_upper,
            mod_lower,
            mod_fill,
            mod_exact,
            mod_spelled,
            mod_ordinal,
            mod_iso,
            mod_signed_years);
 
      modifier_cast = RECORD
            CASE boolean OF
                true :
                    (mod_int : tsp00_Uint1);
                false :
                    (mods    : mod_set);
                END;
            (*ENDCASE*) 
 
 
 
(*------------------------------*) 
 
PROCEDURE
      s78dict_next_msgno (VAR msgno : tsp00_Int2;
            VAR done : boolean);
 
BEGIN
IF  done
THEN
    BEGIN
    done  := false;
    msgno := csp78_19_min_msgno
    END
ELSE
    CASE msgno OF (* switch to the next message number. *)
        csp78_19_max_msgno:
            msgno := csp78_90_min_msgno;
        csp78_90_max_msgno:
            msgno := csp78_19th_min_msgno;
        csp78_19th_max_msgno:
            msgno := csp78_90th_min_msgno;
        csp78_90th_max_msgno:
            msgno := csp78_etc_min_msgno;
        csp78_etc_max_msgno:
            msgno := csp78_mon_min_msgno;
        csp78_mon_max_msgno:
            msgno := csp78_day_min_msgno;
        csp78_day_max_msgno:
            msgno := csp78_rom_min_msgno;
        csp78_rom_max_msgno:
            msgno := csp78_mer_min_msgno;
        OTHERWISE
            IF  msgno < csp78_mer_max_msgno
            THEN
                msgno := succ (msgno)
            ELSE
                done  := true
            (*ENDIF*) 
        END
    (*ENDCASE*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      s78dict_insert_row (VAR dictionary : tsp6_dictionary;
            bufptr        : tsp00_MoveObjPtr;
            buf_len       : tsp00_Int4;
            VAR is_ok     : boolean);
 
VAR
      i          : integer;
      j          : integer;
      l          : integer;
      curr_spell : tsp6_spell_dict;
      curr_dict  : integer;
      ordinal    : boolean;
 
      index : RECORD
            CASE integer OF
                1 :
                    (i : tsp00_Uint1);
                2 :
                    (e : tsp6_dict_etc);
                3 :
                    (o : tsp6_date_fmt_elem);
                END;
            (*ENDCASE*) 
 
 
LABEL
      999;
 
BEGIN
curr_dict := ord (bufptr^[ 1 ]) - ord ('0');
ordinal   := bufptr^[ 2 ] <> ' ';
i         := (ord (bufptr^[ 3 ]) - ord ('0')) * 10
      +ord (bufptr^[ 4 ]) - ord ('0');
IF  (i         >= 0) AND (i         <= 36) AND
    (curr_dict >= 1) AND (curr_dict <= 7)
THEN
    BEGIN
    l := 5;
    j := 1;
    IF  is_ok
    THEN
        WHILE (j <= 5) AND is_ok DO
            IF  bufptr^[ l ] in [ '0'..'9' ]
            THEN
                BEGIN
                WITH curr_spell DO
                    BEGIN
                    length := (ord (bufptr^[ l   ]) - ord ('0')) * 10
                          +   (ord (bufptr^[ l+1 ]) - ord ('0'));
                    l := l + 2;
                    s10mv (buf_len, sizeof (string),
                          @bufptr^, l, @string, 1, mxsp_c12);
                    END;
                (*ENDWITH*) 
                l       := l + mxsp_c12;
                j       := succ (j);
                index.i := i;
                CASE curr_dict OF
                    1:
                        IF  (index.i >= 0) AND
                            (index.i <= 19)
                        THEN
                            dictionary.dict_19[ index.i, ordinal ] := curr_spell;
                        (*ENDIF*) 
                    2:
                        IF  (index.i >= 2) AND
                            (index.i <= 9)
                        THEN
                            dictionary.dict_90[ index.i, ordinal ] := curr_spell;
                        (*ENDIF*) 
                    3:
                        IF  (index.e >= sp6d_and) AND
                            (index.e <= sp6d_millions)
                        THEN
                            dictionary.dict_etc[ index.e, ordinal ] := curr_spell;
                        (*ENDIF*) 
                    4:
                        IF  (index.i >= 1) AND
                            (index.i <= 12)
                        THEN
                            BEGIN
                            IF  dictionary.max_month_len < curr_spell.length
                            THEN
                                dictionary.max_month_len := curr_spell.length;
                            (*ENDIF*) 
                            dictionary.dict_mon[ index.i ] := curr_spell
                            END;
                        (*ENDIF*) 
                    5:
                        IF  (index.i >= 1) AND
                            (index.i <= 7)
                        THEN
                            BEGIN
                            IF   dictionary.max_day_len < curr_spell.length
                            THEN
                                dictionary.max_day_len := curr_spell.length;
                            (*ENDIF*) 
                            dictionary.dict_day[ index.i ] := curr_spell
                            END;
                        (*ENDIF*) 
                    6:
                        IF  (index.i >= 1) AND
                            (index.i <= 12)
                        THEN
                            dictionary.dict_rom[ index.i ] := curr_spell;
                        (*ENDIF*) 
                    7:
                        IF  (index.i >= ord (sp6df_meridian_a_m_)) AND
                            (index.i <= ord (sp6df_anno_bc))
                        THEN
                            dictionary.dict_mer[ index.o ] := curr_spell;
                        (*ENDIF*) 
                    OTHERWISE
                        i := pred (i)
                    END;
                (*ENDCASE*) 
                i := succ (i)
                END
            ELSE
                IF  bufptr^[ l ] = ' '
                THEN
                    j := 6
                ELSE
                    is_ok := false
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDWHILE*) 
    (*ENDIF*) 
    END;
(*ENDIF*) 
999:;
END;
 
(*------------------------------*) 
 
PROCEDURE
      s78lang_spell_init (VAR dictionary : tsp6_dictionary;
            bufptr        : tsp00_MoveObjPtr;
            buf_len       : tsp00_Int4;
            dict_kind     : integer;
            VAR i         : integer;
            VAR is_ok     : boolean);
 
VAR
      j          : integer;
      l          : integer;
      curr_spell : tsp6_language_spell;
 
BEGIN
l     := 1;
j     := 1;
is_ok := true;
WHILE (j <= 5) AND is_ok DO
    IF  bufptr^[ l ] in [ '0'..'9' ]
    THEN
        BEGIN
        WITH curr_spell DO
            BEGIN
            length := (
                  (ord (bufptr^[ l   ]) - ord ('0')) * 10 +
                  (ord (bufptr^[ l+1 ]) - ord ('0')));
            l := l + 2;
            string := bsp_c24;
            s10mv (buf_len, sizeof (string), @bufptr^, l, @string, 1, 12);
            l := l + 12;
            END;
        (*ENDWITH*) 
        j       := succ (j);
        CASE dict_kind OF
            4:
                IF  (i >= 1) AND (i <= 12)
                THEN
                    dictionary.dict_lang_month[ i ] := curr_spell;
                (*ENDIF*) 
            5:
                IF  (i >= 1) AND (i <= 7)
                THEN
                    dictionary.dict_lang_day[ i ] := curr_spell;
                (*ENDIF*) 
            OTHERWISE
                i := pred (i);
            END;
        (*ENDCASE*) 
        i := succ (i)
        END
    ELSE
        IF  bufptr^[ l ] = ' '
        THEN
            j := 6
        ELSE
            is_ok := false;
        (*ENDIF*) 
    (*ENDIF*) 
(*ENDWHILE*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      s78language (VAR dictionaries : tsp6_dictionaries;
            VAR language_name : tsp00_C3;
            VAR language_no   : tsp6_language;
            for_init          : boolean;
            VAR is_ok         : boolean);
 
VAR
      comp_result : tsp00_LcompResult;
      curr_no     : tsp00_Uint1;
 
BEGIN
is_ok       := true;
curr_no     := 1;
language_no := 1; (* h.b. PTS 1106502 *)
comp_result := l_undef;
WITH dictionaries  DO
    BEGIN (* search for language_name *)
    WHILE (curr_no <= count) AND (comp_result = l_undef) DO
        IF  dict[ curr_no ].lang <> language_name
        THEN
            curr_no := succ (curr_no)
        ELSE
            comp_result := l_equal;
        (*ENDIF*) 
    (*ENDWHILE*) 
    IF  comp_result = l_equal
    THEN
        language_no := curr_no
    ELSE
        IF  for_init AND (count < csp6_languages)
        THEN
            BEGIN
            count       := succ (count);
            language_no := count;
            WITH dict[ language_no ] DO
                BEGIN
                lang                 := language_name;
                max_day_len          := 0;
                max_month_len        := 0;
                dict_mon[ 1 ].length := 0;
                dict_upp_table       := NIL;
                dict_low_table       := NIL;
                END
            (*ENDWITH*) 
            END
        ELSE
            is_ok := false
        (*ENDIF*) 
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      sp78elem_date_format (VAR format : tsp00_MoveObj;
            len       : tsp00_Int4;
            pos       : tsp00_Int4;
            VAR modif : tsp6_date_fmt_modifier) : tsp6_date_fmt_elem;
 
VAR
      found : tsp6_date_fmt_elem;
      curr  : char;
 
BEGIN
found := sp6df_no_correct_format;
modif := [ ];
IF  pos <= len
THEN
    BEGIN
    curr  := format[ pos ];
    IF  (curr = 'S') OR (curr = 's')
    THEN
        BEGIN (* FormatModifier 'S' for signed years/centuries. *)
        IF  pos+1 <= len
        THEN
            IF  (format[ pos+1 ] = 'Y') OR (format[ pos+1 ] = 'y')
            THEN
                modif := modif + [ sp6dfm_signed_years ];
            (*ENDIF*) 
        (*ENDIF*) 
        IF  pos+2 <= len
        THEN
            IF  ((format[ pos+1 ] = 'C') OR (format[ pos+1 ] = 'c')) AND
                ((format[ pos+2 ] = 'C') OR (format[ pos+2 ] = 'c'))
            THEN
                modif := modif + [ sp6dfm_signed_years ];
            (*ENDIF*) 
        (*ENDIF*) 
        IF  (sp6dfm_signed_years in modif) AND (pos < len)
        THEN (* skip this modifier in input. *)
            BEGIN
            pos  := succ (pos);
            curr := format[ pos ]
            END
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  (curr = 'I') OR (curr = 'i')
    THEN (* FormatModifier 'I' for iso years/weeks. *)
        BEGIN
        modif := modif + [ sp6dfm_iso ];
        curr  := 'Y'; (* 'I', 'IY', 'IYY' or 'IYYY' *)
        IF  pos+1 <= len
        THEN
            IF  (format[ pos+1 ] = 'W') OR (format[ pos+1 ] = 'w')
            THEN (* 'IW' *)
                curr := 'W'
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    CASE curr OF
        'A', 'a':
            BEGIN
            IF  pos+1 <= len
            THEN
                CASE  format[ pos+1 ] OF
                    'D', 'd': (* 'AD' *)
                        found := sp6df_anno_ad;
                    'M', 'm': (* 'AM' *)
                        found := sp6df_meridian_am;
                    OTHERWISE;
                    END;
                (*ENDCASE*) 
            (*ENDIF*) 
            IF  pos+3 <= len
            THEN
                IF  (format[ pos+1 ] = '.') AND (format[ pos+3 ] = '.')
                THEN
                    CASE  format[ pos+2 ] OF
                        'D', 'd': (* 'A.D.' *)
                            found := sp6df_anno_a_d_;
                        'M', 'm': (* 'A.M.' *)
                            found := sp6df_meridian_a_m_;
                        OTHERWISE;
                        END;
                    (*ENDCASE*) 
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        'B', 'b':
            IF  pos+1 <= len
            THEN
                IF  (format[ pos+1 ] = 'C') OR (format[ pos+1 ] = 'c')
                THEN (* 'BC' *)
                    found := sp6df_anno_bc
                ELSE
                    IF  pos+3 <= len
                    THEN
                        IF  (format[ pos+1 ] = '.') AND (format[ pos+3 ] = '.') AND
                            ((format[ pos+2 ] = 'C') OR (format[ pos+2 ] = 'c'))
                        THEN (* 'B.C.' *)
                            found := sp6df_anno_b_c_;
                        (*ENDIF*) 
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
        'C', 'c':
            IF  pos+1 <= len
            THEN
                IF  (format[ pos+1 ] = 'C') OR (format[ pos+1 ] = 'c')
                THEN (* 'CC' *)
                    found := sp6df_century;
                (*ENDIF*) 
            (*ENDIF*) 
        'D', 'd':
            BEGIN
            found := sp6df_day_of_week_numeric; (* 'D' *)
            IF  pos+1 <= len
            THEN
                BEGIN
                IF  (format[ pos+1 ] = 'Y') OR (format[ pos+1 ] = 'y')
                THEN (* 'DY' *)
                    found := sp6df_day_of_week_short;
                (*ENDIF*) 
                IF  (format[ pos+1 ] = 'D') OR (format[ pos+1 ] = 'd')
                THEN (* 'DD' *)
                    found := sp6df_day_of_month
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            IF  pos+2 <= len
            THEN
                BEGIN
                IF  ((format[ pos+1 ] = 'A') OR (format[ pos+1 ] = 'a')) AND
                    ((format[ pos+2 ] = 'Y') OR (format[ pos+2 ] = 'y'))
                THEN (* 'DAY' *)
                    found := sp6df_day_of_week_long;
                (*ENDIF*) 
                IF  ((format[ pos+1 ] = 'D') OR (format[ pos+1 ] = 'd')) AND
                    ((format[ pos+2 ] = 'D') OR (format[ pos+2 ] = 'd'))
                THEN (* 'DDD' *)
                    found := sp6df_day_of_year
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            END;
        'F', 'f':
            IF  pos+1 <= len
            THEN
                CASE format[ pos+1 ] OF
                    'M', 'm': (* 'FM' *)
                        found := sp6df_fill_mode_toggle;
                    'X', 'x': (* 'FX' *)
                        found := sp6df_exact_mode_toggle;
                    OTHERWISE;
                    END;
                (*ENDCASE*) 
            (*ENDIF*) 
        'H', 'h':
            IF  pos+1 <= len
            THEN
                IF  (format[ pos+1 ] = 'H') OR (format[ pos+1 ] = 'h')
                THEN
                    BEGIN
                    found := sp6df_hour;
                    IF  pos+3 <= len
                    THEN
                        BEGIN
                        IF  (format[pos+2] = '2') AND (format[pos+3] = '4')
                        THEN (* 'HH24' *)
                            found := sp6df_hour_24;
                        (*ENDIF*) 
                        IF  (format[pos+2] = '1') AND (format[pos+3] = '2')
                        THEN (* 'HH12' *)
                            found := sp6df_hour_12
                        (*ENDIF*) 
                        END
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
        'J', 'j': (* 'J' *)
            found := sp6df_julian_day;
        'M', 'm':
            BEGIN
            IF  pos+1 <= len
            THEN
                IF  (format[ pos+1 ] = 'M') OR (format[ pos+1 ] = 'm')
                THEN (* 'MM' *)
                    found := sp6df_month_numeric
                ELSE
                    IF  (format[ pos+1 ] = 'I') OR (format[ pos+1 ] = 'i')
                    THEN (* 'MI' *)
                        found := sp6df_minute
                    ELSE
                        IF  (*g01glob.db_is_for_sapr3 AND*)
                            ((format[pos+1] = 'S') OR (format[pos+1] = 's'))
                        THEN (* 'MS' *)
                            found := sp6df_microseconds;
                        (*ENDIF*) 
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
            IF  pos+2 <= len
            THEN
                IF  ((format[ pos+1 ] = 'O') OR (format[ pos+1 ] = 'o')) AND
                    ((format[ pos+2 ] = 'N') OR (format[ pos+2 ] = 'n'))
                THEN
                    BEGIN (* 'MON' *)
                    found := sp6df_month_short;
                    IF  pos+4 <= len
                    THEN
                        IF  ((format[pos+3]='T') OR (format[pos+3]='t')) AND
                            ((format[pos+4]='H') OR (format[pos+4]='h'))
                        THEN (* 'MONTH' *)
                            found := sp6df_month_long
                        (*ENDIF*) 
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        'P', 'p':
            BEGIN
            IF  pos+1 <= len
            THEN
                IF  (format[ pos+1 ] = 'M') OR (format[ pos+1 ] = 'm')
                THEN (* 'PM' *)
                    found := sp6df_meridian_pm;
                (*ENDIF*) 
            (*ENDIF*) 
            IF  pos+3 <= len
            THEN
                IF  ((format[ pos+1 ] = '.')) AND
                    ((format[ pos+3 ] = '.')) AND
                    ((format[ pos+2 ] = 'M') OR (format[ pos+2 ] = 'm'))
                THEN (* 'P.M.' *)
                    found := sp6df_meridian_p_m_
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        'Q', 'q': (* 'Q' *)
            found := sp6df_quarter;
        'R', 'r':
            IF  pos+1 <= len
            THEN
                CASE format[ pos+1 ] OF
                    'M', 'm': (* 'RM' *)
                        found := sp6df_month_roman;
                    'R', 'r': (* 'RR' *)
                        found := sp6df_year_10_relative;
                    OTHERWISE;
                    END;
                (*ENDCASE*) 
            (*ENDIF*) 
        'S', 's':
            IF  pos+1 <= len
            THEN
                BEGIN
                IF  ((format[ pos+1 ] = 'S') OR (format[ pos+1 ] = 's'))
                THEN
                    found := sp6df_seconds_of_minute;
                (*ENDIF*) 
                IF  pos+4 <= len
                THEN
                    IF  ((format[pos+2] = 'S') OR (format[pos+2] = 's')) AND
                        ((format[pos+3] = 'S') OR (format[pos+3] = 's')) AND
                        ((format[pos+4] = 'S') OR (format[pos+4] = 's'))
                    THEN (* 'SSSSS' *)
                        found := sp6df_seconds_of_day
                    (*ENDIF*) 
                (*ENDIF*) 
                END;
            (*ENDIF*) 
        'W', 'w':
            BEGIN
            found := sp6df_week_of_month; (* 'W' *)
            IF  pos+1 <= len
            THEN
                IF      (format[ pos+1 ] = 'W') OR (format[ pos+1 ] = 'w')
                THEN (* 'WW' *)
                    found := sp6df_week_of_year
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        'Y', 'y':
            BEGIN
            found := sp6df_year_1; (* 'Y' *)
            IF  pos+1 <= len
            THEN
                IF  (format[ pos+1 ] = 'Y') OR (format[ pos+1 ] = 'y')
                THEN
                    BEGIN
                    found := sp6df_year_10;
                    IF  pos+2 <= len
                    THEN
                        IF  (format[ pos+2 ] = 'Y') OR (format[ pos+2 ] = 'y')
                        THEN
                            BEGIN
                            found := sp6df_year_100;
                            IF  pos+3 <= len
                            THEN
                                IF  (format[ pos+3 ] = 'Y') OR
                                    (format[ pos+3 ] = 'y')
                                THEN (* 'YYYY' *)
                                    found := sp6df_year
                                (*ENDIF*) 
                            (*ENDIF*) 
                            END
                        (*ENDIF*) 
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
            IF  pos+3 <= len
            THEN
                IF  ((format[ pos+1 ] = 'E') OR (format[ pos+1 ] = 'e')) AND
                    ((format[ pos+2 ] = 'A') OR (format[ pos+2 ] = 'a')) AND
                    ((format[ pos+3 ] = 'R') OR (format[ pos+3 ] = 'r'))
                THEN (* 'YEAR' *)
                    found := sp6df_year_short;
                (*ENDIF*) 
            (*ENDIF*) 
            IF  pos+4 <= len
            THEN
                IF  ( format[ pos+1 ] = ',') AND
                    ((format[ pos+2 ] = 'Y') OR (format[ pos+2 ] = 'y')) AND
                    ((format[ pos+3 ] = 'Y') OR (format[ pos+3 ] = 'y')) AND
                    ((format[ pos+4 ] = 'Y') OR (format[ pos+4 ] = 'y'))
                THEN (* 'Y,YYY' *)
                    found := sp6df_year_comma;
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        '"': (* double quote. *)
            found := sp6df_quoted_text;
        OTHERWISE
            IF  NOT (curr in [ 'A'..'I', 'J'..'R', 'S'..'Z',
                'a'..'i', 'j'..'r', 's'..'z', '0'..'9' ])
            THEN
                found := sp6df_special_char;
            (*ENDIF*) 
        END
    (*ENDCASE*) 
    END;
(*ENDIF*) 
sp78elem_date_format := found
END;
 
(*------------------------------*) 
 
PROCEDURE
      s78df_analyze (
            format_addr    : tsp00_MoveObjPtr;
            format_len     : tsp00_Int2;
            dest_addr      : tsp00_MoveObjPtr;
            VAR dest_len   : tsp00_Int2;
            to_date_format : boolean;
            VAR e          : tsp6_date_error);
 
VAR
      curr_fmt   : tsp6_date_fmt_elem;
      modif      : tsp6_date_fmt_modifier;
      fmt_pos    : tsp00_Int4;
      copy_len   : integer;
      zero_fill  : boolean;
      exact_mode : boolean;
      is_unique  : boolean;
      spell_kind : tsp6_date_spell_kind;
      dest_pos   : integer;
      specs      : ARRAY [ tsp6_date_fmt_elem ] OF boolean;
 
LABEL
      999;
 
BEGIN
e          := sp6de_ok;
zero_fill  := true;
exact_mode := false;
fmt_pos    := 2;
dest_pos   := 2;
dest_addr^[ 1 ] := chr (c_format_magic);
IF  to_date_format
THEN
    FOR curr_fmt := sp6df_no_correct_format TO sp6df_microseconds DO
        specs[ curr_fmt ] := false;
    (*ENDFOR*) 
(*ENDIF*) 
WHILE fmt_pos <= format_len DO
    BEGIN
    is_unique := to_date_format;
    curr_fmt  := sp78elem_date_format (format_addr^,
          format_len, fmt_pos, modif);
    CASE curr_fmt OF
        sp6df_no_correct_format:
            BEGIN
            e := sp6de_format_not_recognized;
            goto 999
            END;
        sp6df_week_of_month, sp6df_week_of_year,
        sp6df_century, sp6df_quarter:
            IF  to_date_format
            THEN
                BEGIN
                e := sp6de_no_to_date_format;
                goto 999
                END;
            (*ENDIF*) 
        sp6df_year, sp6df_year_1, sp6df_year_10,
        sp6df_year_10_relative, sp6df_year_100,
        sp6df_year_comma, sp6df_year_short:
            IF  to_date_format AND (sp6dfm_iso in modif)
            THEN
                BEGIN
                e := sp6de_no_to_date_format;
                goto 999
                END;
            (*ENDIF*) 
        sp6df_fill_mode_toggle, sp6df_exact_mode_toggle,
        sp6df_quoted_text, sp6df_special_char:
            is_unique := false;
        OTHERWISE;
        END;
    (*ENDCASE*) 
    IF   is_unique
    THEN
        BEGIN
        IF  specs[ curr_fmt ]
        THEN
            BEGIN
            e := sp6de_duplicate_format;
            goto 999
            END;
        (*ENDIF*) 
        specs[ curr_fmt ] := true
        END;
    (*ENDIF*) 
    sp78suffix_date_format (format_addr^,
          format_len, fmt_pos, curr_fmt, modif);
    spell_kind := sp78df_spell_kind (format_addr^,
          format_len, fmt_pos);
    CASE curr_fmt OF
        sp6df_fill_mode_toggle:
            zero_fill  := NOT zero_fill;
        sp6df_exact_mode_toggle:
            exact_mode := NOT exact_mode;
        sp6df_special_char:
            BEGIN
            IF  dest_pos + 2 > dest_len
            THEN
                BEGIN
                e := sp6de_overflow;
                goto 999
                END
            ELSE
                BEGIN
                dest_addr^[ dest_pos   ] := chr (ord (curr_fmt));
                dest_addr^[ dest_pos+1 ] := format_addr^[ fmt_pos ];
                dest_pos := dest_pos + 2
                END
            (*ENDIF*) 
            END;
        sp6df_quoted_text:
            BEGIN
            copy_len := 0;
            WHILE (fmt_pos + copy_len + 1 <= format_len) AND
                  (format_addr^ [fmt_pos+copy_len+1] <> '"') DO
                copy_len := succ (copy_len);
            (*ENDWHILE*) 
            IF  copy_len > 0
            THEN
                IF  dest_pos + 2 + copy_len > dest_len
                THEN
                    BEGIN
                    e := sp6de_overflow;
                    goto 999
                    END
                ELSE
                    BEGIN
                    dest_addr^[ dest_pos   ] := chr (ord (curr_fmt));
                    dest_addr^[ dest_pos+1 ] := chr (copy_len);
                    dest_pos := dest_pos + 2;
                    sp78append_to_workbuf (format_addr, fmt_pos+1,
                          dest_len, dest_addr, dest_pos, dest_len, copy_len);
                    END
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        OTHERWISE
            IF  dest_pos + 2 > dest_len
            THEN
                BEGIN
                e := sp6de_overflow;
                goto 999
                END
            ELSE
                BEGIN
                dest_addr^[ dest_pos ] := chr (ord (curr_fmt));
                dest_pos := succ (dest_pos);
                sp78put_modifier (dest_addr, dest_pos,
                      modif, zero_fill, exact_mode, spell_kind);
                END
            (*ENDIF*) 
        END;
    (*ENDCASE*) 
    sp78new_pos_date_format (format_addr^,
          format_len, curr_fmt, modif, fmt_pos)
    END;
(*ENDWHILE*) 
IF  to_date_format
THEN
    IF  ( ord (specs [sp6df_hour])
        + ord (specs [sp6df_hour_12])
        + ord (specs [sp6df_hour_24]) > 1) OR
        ( ord (specs [sp6df_meridian_am])
        + ord (specs [sp6df_meridian_a_m_])
        + ord (specs [sp6df_meridian_pm])
        + ord (specs [sp6df_meridian_p_m_])
        + ord (specs [sp6df_hour_24]) > 1) OR
        ( ord (specs [sp6df_year   ])
        + ord (specs [sp6df_year_100])
        + ord (specs [sp6df_year_1 ])
        + ord (specs [sp6df_year_10_relative])
        + ord (specs [sp6df_year_10])
        + ord (specs [sp6df_year_comma]) > 1) OR
        ( ord (specs [sp6df_day_of_week_long])
        + ord (specs [sp6df_day_of_week_short])
        + ord (specs [sp6df_day_of_week_numeric]) > 1) OR
        ( ord (specs [sp6df_month_long])
        + ord (specs [sp6df_month_short])
        + ord (specs [sp6df_month_numeric])
        + ord (specs [sp6df_month_roman]) > 1) OR
        ( ord (specs [sp6df_julian_day])
        + ord (specs [sp6df_day_of_year]) > 1)
    THEN
        BEGIN
        e := sp6de_duplicate_format;
        goto 999
        END;
    (*ENDIF*) 
(*ENDIF*) 
IF  dest_pos <= dest_len
THEN
    BEGIN
    dest_addr^[ dest_pos ] := chr (ord (sp6df_no_correct_format));
    dest_len               := dest_pos
    END;
(*ENDIF*) 
999:;
END;
 
(*------------------------------*) 
 
PROCEDURE
      s78df_default (
            dest_addr      : tsp00_MoveObjPtr;
            VAR dest_len   : tsp00_Int2;
            VAR e          : tsp6_date_error);
 
CONST
      c_df_default = '\16\14\05\04-\21\05\04-\26\05\00';
 
VAR
      df_default : tsp00_C12;
 
BEGIN
df_default := c_df_default;
IF  dest_len < sizeof (df_default)
THEN
    e := sp6de_overflow
ELSE
    BEGIN
    e        := sp6de_ok;
    dest_len := sizeof (df_default);
    s10mv (sizeof (df_default), sizeof (dest_addr^),
          @df_default, 1, @dest_addr^, 1, sizeof (df_default))
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      s78df_clear (VAR dictionary : tsp6_dictionary;
            format_addr : tsp00_MoveObjPtr;
            format_len  : integer;
            dest_addr   : tsp00_MoveObjPtr;
            dest_size   : integer);
 
VAR
      fmt_pos    : integer;
      copy_len   : integer;
      zero_fill  : boolean;
      this_fill  : boolean;
      exact_mode : boolean;
      this_exact : boolean;
      modif      : tsp6_date_fmt_modifier;
      spell_kind : tsp6_date_spell_kind;
      dest_pos   : integer;
      this_fmt   : tsp00_C5;
      curr_fmt   : format_cast;
      table_ptr  : ^tsp00_Ctable;
      fmt_mptr   : tsp00_MoveObjPtr;
 
BEGIN
zero_fill  := true;
exact_mode := false;
fmt_pos    := 2;
dest_pos   := 2;
SAPDB_PascalForcedFill (dest_size, @dest_addr^, 1, dest_size,
      csp_ascii_blank);
IF  ord (format_addr^[ 1 ]) = c_format_magic
THEN
    REPEAT
        curr_fmt.format_int := ord (format_addr^[ fmt_pos ]);
        fmt_pos             := succ (fmt_pos);
        CASE curr_fmt.fmt OF
            sp6df_no_correct_format:
                BEGIN
                END;
            sp6df_quoted_text:
                BEGIN
                copy_len := ord (format_addr^[ fmt_pos ]);
                dest_addr^[ dest_pos ] := '"';
                dest_pos := succ (dest_pos);
                sp78append_to_workbuf (format_addr, fmt_pos+1,
                      dest_size, dest_addr, dest_pos, dest_size,
                      copy_len);
                dest_addr^[ dest_pos ] := '"';
                dest_pos := succ (dest_pos);
                fmt_pos  := fmt_pos  + copy_len + 1
                END;
            sp6df_special_char:
                BEGIN
                dest_addr^[ dest_pos ] := format_addr^[ fmt_pos ];
                fmt_pos  := succ (fmt_pos);
                dest_pos := succ (dest_pos);
                END;
            OTHERWISE
                BEGIN
                sp78get_modifier (format_addr, fmt_pos,
                      modif, this_fill, this_exact, spell_kind);
                IF  this_fill <> zero_fill
                THEN
                    BEGIN
                    zero_fill := this_fill;
                    this_fmt  := 'fm   ';
                    sp78append_to_workbuf (@this_fmt, 1,
                          dest_size, dest_addr, dest_pos, dest_size, 2);
                    END;
                (*ENDIF*) 
                IF  this_exact <> exact_mode
                THEN
                    BEGIN
                    exact_mode := this_exact;
                    this_fmt   := 'fx   ';
                    sp78append_to_workbuf (@this_fmt, 1,
                          dest_size, dest_addr, dest_pos, dest_size, 2);
                    END;
                (*ENDIF*) 
                CASE curr_fmt.fmt OF
                    sp6df_seconds_of_minute:
                        this_fmt := 'Ss   ';
                    sp6df_seconds_of_day:
                        this_fmt := 'Sssss';
                    sp6df_minute:
                        this_fmt := 'Mi   ';
                    sp6df_hour:
                        this_fmt := 'Hh   ';
                    sp6df_hour_12:
                        this_fmt := 'Hh12 ';
                    sp6df_hour_24:
                        this_fmt := 'Hh24 ';
                    sp6df_day_of_week_numeric:
                        this_fmt := 'D    ';
                    sp6df_day_of_week_long:
                        this_fmt := 'Dy   ';
                    sp6df_day_of_week_short:
                        this_fmt := 'Day  ';
                    sp6df_day_of_month:
                        this_fmt := 'Dd   ';
                    sp6df_day_of_year:
                        this_fmt := 'Ddd  ';
                    sp6df_julian_day:
                        this_fmt := 'J    ';
                    sp6df_week_of_month:
                        this_fmt := 'W    ';
                    sp6df_week_of_year:
                        this_fmt := 'Ww   ';
                    sp6df_month_numeric:
                        this_fmt := 'Mm   ';
                    sp6df_month_long:
                        this_fmt := 'Month';
                    sp6df_month_short:
                        this_fmt := 'Mon  ';
                    sp6df_month_roman:
                        this_fmt := 'Rm   ';
                    sp6df_quarter:
                        this_fmt := 'Q    ';
                    sp6df_year:
                        this_fmt := 'Yyyy ';
                    sp6df_year_1:
                        this_fmt := 'Y    ';
                    sp6df_year_10:
                        this_fmt := 'Yy   ';
                    sp6df_year_10_relative:
                        this_fmt := 'Rr   ';
                    sp6df_year_100:
                        this_fmt := 'Yyy  ';
                    sp6df_year_comma:
                        this_fmt := 'Y,yyy';
                    sp6df_year_short:
                        this_fmt := 'Year ';
                    sp6df_century:
                        this_fmt := 'Cc   ';
                    sp6df_meridian_a_m_:
                        this_fmt := 'A.m. ';
                    sp6df_meridian_p_m_:
                        this_fmt := 'P.m. ';
                    sp6df_meridian_am:
                        this_fmt := 'Am   ';
                    sp6df_meridian_pm:
                        this_fmt := 'Pm   ';
                    sp6df_anno_a_d_:
                        this_fmt := 'A.d. ';
                    sp6df_anno_b_c_:
                        this_fmt := 'Bc   ';
                    sp6df_anno_ad:
                        this_fmt := 'Ad   ';
                    sp6df_anno_bc:
                        this_fmt := 'Bc   ';
                    sp6df_microseconds:
                        this_fmt := 'Ms   ';
                    END;
                (*ENDCASE*) 
                IF  sp6dfm_iso in modif
                THEN
                    this_fmt[ 1 ] := 'I';
                (*ENDIF*) 
                copy_len := 0;
                WHILE (copy_len < 5) AND (this_fmt[ copy_len+1 ] <> ' ') DO
                    copy_len := succ (copy_len);
                (*ENDWHILE*) 
                CASE spell_kind OF
                    sp6dfs_spell_upper:
                        IF  dictionary.dict_upp_table <> NIL
                        THEN
                            BEGIN
                            fmt_mptr  := @this_fmt;
                            table_ptr := @dictionary.dict_upp_table^;
                            s30map (table_ptr^,
                                  fmt_mptr^, 1, fmt_mptr^, 1, copy_len);
                            END;
                        (*ENDIF*) 
                    sp6dfs_spell_lower:
                        IF  dictionary.dict_low_table <> NIL
                        THEN
                            BEGIN
                            fmt_mptr  := @this_fmt;
                            table_ptr := @dictionary.dict_low_table^;
                            s30map (table_ptr^,
                                  fmt_mptr^, 1, fmt_mptr^, 1, copy_len);
                            END;
                        (*ENDIF*) 
                    OTHERWISE;
                    END;
                (*ENDCASE*) 
                sp78append_to_workbuf (@this_fmt, 1,
                      dest_size, dest_addr, dest_pos, dest_size,
                      copy_len);
                IF  sp6dfm_ordinal in modif
                THEN
                    BEGIN
                    IF  spell_kind = sp6dfs_spell_upper
                    THEN
                        this_fmt  := 'TH   '
                    ELSE
                        this_fmt  := 'th   ';
                    (*ENDIF*) 
                    sp78append_to_workbuf (@this_fmt, 1,
                          dest_size, dest_addr, dest_pos, dest_size, 2);
                    END;
                (*ENDIF*) 
                IF  sp6dfm_spelled in modif
                THEN
                    BEGIN
                    IF  spell_kind = sp6dfs_spell_upper
                    THEN
                        this_fmt  := 'SP   '
                    ELSE
                        this_fmt  := 'sp   ';
                    (*ENDIF*) 
                    sp78append_to_workbuf (@this_fmt, 1,
                          dest_size, dest_addr, dest_pos, dest_size, 2);
                    END;
                (*ENDIF*) 
                END;
            END;
        (*ENDCASE*) 
    UNTIL
        (fmt_pos > format_len) OR
        (curr_fmt.fmt = sp6df_no_correct_format);
    (*ENDREPEAT*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      s78df_len1 (format_addr : tsp00_MoveObjPtr;
            format_len  : tsp00_Int2;
            VAR df_elem : tsp6_date_fmt_elem;
            VAR e       : tsp6_date_error);
 
VAR
      comp_buf : tsp00_C120;
      comp_len : tsp00_Int2;
      curr_fmt : format_cast;
 
BEGIN
comp_len := sizeof (comp_buf);
s78df_analyze (format_addr, format_len,
      @comp_buf, comp_len, NOT c_to_date_format, e);
IF  e = sp6de_ok
THEN
    IF  comp_len > 4
    THEN
        e := sp6de_overflow
    ELSE
        BEGIN
        curr_fmt.format_int := ord (comp_buf[ 2 ]);
        df_elem             := curr_fmt.fmt
        END
    (*ENDIF*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp78get_modifier (format_addr : tsp00_MoveObjPtr;
            VAR fmt_pos    : integer;
            VAR modif      : tsp6_date_fmt_modifier;
            VAR zero_fill  : boolean;
            VAR exact_mode : boolean;
            VAR spell_kind : tsp6_date_spell_kind);
 
VAR
      curr_mod : modifier_cast;
 
BEGIN
curr_mod.mod_int := ord (format_addr^[ fmt_pos ]);
fmt_pos          := succ (fmt_pos);
IF  mod_upper in curr_mod.mods
THEN
    spell_kind := sp6dfs_spell_upper
ELSE
    IF  mod_lower in curr_mod.mods
    THEN
        spell_kind := sp6dfs_spell_lower
    ELSE
        spell_kind := sp6dfs_spell_mixed;
    (*ENDIF*) 
(*ENDIF*) 
zero_fill  := mod_fill  in curr_mod.mods;
exact_mode := mod_exact in curr_mod.mods;
modif      := [ ];
IF  mod_spelled in curr_mod.mods
THEN
    modif := modif + [ sp6dfm_spelled ];
(*ENDIF*) 
IF  mod_ordinal in curr_mod.mods
THEN
    modif := modif + [ sp6dfm_ordinal ];
(*ENDIF*) 
IF  mod_iso in curr_mod.mods
THEN
    modif := modif + [ sp6dfm_iso ];
(*ENDIF*) 
IF  mod_signed_years in curr_mod.mods
THEN
    modif := modif + [ sp6dfm_signed_years ];
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp78put_modifier (dest_addr : tsp00_MoveObjPtr;
            VAR dest_pos : integer;
            modif        : tsp6_date_fmt_modifier;
            zero_fill    : boolean;
            exact_mode   : boolean;
            spell_kind   : tsp6_date_spell_kind);
 
VAR
      curr_mod : modifier_cast;
 
BEGIN
curr_mod.mods := [ ];
CASE spell_kind OF
    sp6dfs_spell_upper:
        curr_mod.mods := curr_mod.mods + [ mod_upper ];
    sp6dfs_spell_lower:
        curr_mod.mods := curr_mod.mods + [ mod_lower ];
    OTHERWISE;
    END;
(*ENDCASE*) 
IF  zero_fill
THEN
    curr_mod.mods := curr_mod.mods + [ mod_fill ];
(*ENDIF*) 
IF  exact_mode
THEN
    curr_mod.mods := curr_mod.mods + [ mod_exact ];
(*ENDIF*) 
IF  sp6dfm_spelled in modif
THEN
    curr_mod.mods := curr_mod.mods + [ mod_spelled ];
(*ENDIF*) 
IF  sp6dfm_ordinal in modif
THEN
    curr_mod.mods := curr_mod.mods + [ mod_ordinal ];
(*ENDIF*) 
IF  sp6dfm_iso in modif
THEN
    curr_mod.mods := curr_mod.mods + [ mod_iso ];
(*ENDIF*) 
IF  sp6dfm_signed_years in modif
THEN
    curr_mod.mods := curr_mod.mods + [ mod_signed_years ];
(*ENDIF*) 
dest_addr^[ dest_pos ] := chr (curr_mod.mod_int);
dest_pos := succ (dest_pos);
END;
 
(*------------------------------*) 
 
PROCEDURE
      s78d2c_to_char (VAR dictionary : tsp6_dictionary;
            ts_addr      : tsp00_MoveObjPtr;
            format_addr  : tsp00_MoveObjPtr;
            format_len   : integer;
            dest_size    : integer;
            dest_addr    : tsp00_MoveObjPtr;
            VAR dest_pos : integer;
            dest_len     : integer;
            VAR e        : tsp6_date_error);
 
VAR
      fmt_pos        : tsp00_Int4;
      copy_len       : integer;
      this_number    : integer;
      num_lg         : integer;
      curr_month     : integer;
      curr_year      : integer;
      iso_week       : integer;
      iso_day        : integer;
      diff_days      : integer;
      days_in_year   : integer;
      zero_fill      : boolean;
      year_filler    : tsp6_dict_etc;
      fill_char      : char;
      spell_kind     : tsp6_date_spell_kind;
      timestamp      : tsp6_timestamp_array;
      curr_fmt       : format_cast;
      modif          : tsp6_date_fmt_modifier;
      exact_mode     : boolean;
      language_found : boolean;
 
LABEL
      999;
 
BEGIN
e := sp6de_ok;
IF  (ts_addr^[ 1 ]     = csp_undef_byte) OR
    (format_addr^[ 1 ] = csp_undef_byte)
THEN
    BEGIN
    dest_addr^[ dest_pos ] := csp_undef_byte;
    goto 999
    END;
(*ENDIF*) 
IF  format_addr^[ 1 ] <> chr (c_format_magic)
THEN
    BEGIN
    e := sp6de_format_not_recognized;
    goto 999
    END;
(*ENDIF*) 
s78ints_from_buf (ts_addr^, 2, timestamp, e);
IF  e <> sp6de_ok
THEN
    goto 999;
(*ENDIF*) 
fmt_pos        := 2;
zero_fill      := true;
language_found := dictionary.dict_mon[ 1 ].length > 0;
REPEAT
    curr_fmt.format_int := ord (format_addr^[ fmt_pos ]);
    fmt_pos             := succ (fmt_pos);
    CASE curr_fmt.fmt OF
        sp6df_no_correct_format:
            BEGIN
            END;
        sp6df_special_char:
            BEGIN
            dest_addr^[ dest_pos ] := format_addr^[ fmt_pos ];
            dest_pos := succ (dest_pos);
            fmt_pos  := succ (fmt_pos);
            END;
        sp6df_quoted_text:
            BEGIN
            copy_len := ord (format_addr^[ fmt_pos ]);
            sp78append_to_workbuf (format_addr, fmt_pos+1,
                  dest_size, dest_addr, dest_pos, dest_size, copy_len);
            fmt_pos  := fmt_pos  + copy_len + 1
            END;
        OTHERWISE
            BEGIN
            sp78get_modifier (format_addr, fmt_pos,
                  modif, zero_fill, exact_mode, spell_kind);
            this_number := -1;
            curr_year   := timestamp [1];
            IF  (sp6dfm_iso in modif) OR
                (curr_fmt.fmt in  [
                sp6df_day_of_week_numeric,
                sp6df_day_of_week_long,
                sp6df_day_of_week_short])
            THEN
                BEGIN
                s78week_and_day (ts_addr^, 1, iso_week,iso_day, e);
                IF  e <> sp6de_ok
                THEN
                    goto 999;
                (*ENDIF*) 
                IF  sp6dfm_iso in modif
                THEN
                    IF  (timestamp [2] = 1) AND (iso_week > 50)
                    THEN (* week 52/53 in january must be from last year. *)
                        curr_year := pred (curr_year)
                    ELSE
                        IF  (timestamp [2] = 12) AND (iso_week = 1)
                        THEN (* week 1 in december must be from next year. *)
                            curr_year := succ (curr_year);
                        (*ENDIF*) 
                    (*ENDIF*) 
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            IF  sp6dfm_signed_years in modif
            THEN
                BEGIN
                IF  timestamp [1] < 0
                THEN (* this can't happen with our date representation. *)
                    fill_char   := '-'
                ELSE
                    fill_char   := ' ';
                (*ENDIF*) 
                IF  zero_fill OR (fill_char <> ' ')
                THEN
                    BEGIN
                    dest_addr^[ dest_pos ] := fill_char;
                    dest_pos               := succ (dest_pos)
                    END
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            IF  curr_fmt.fmt in [
                sp6df_day_of_year,
                sp6df_week_of_year,
                sp6df_julian_day]
            THEN
                BEGIN
                days_in_year := timestamp [3]; (*days in this month*)
                FOR curr_month := 1 TO timestamp [2]-1 DO
                    (* add days of past months of this year. *)
                    days_in_year := days_in_year +
                          s78days_of_month (timestamp [1], curr_month);
                (*ENDFOR*) 
                END;
            (*ENDIF*) 
            CASE curr_fmt.fmt OF
                sp6df_year:
                    BEGIN
                    num_lg      := 4;
                    this_number := curr_year
                    END;
                sp6df_year_1:
                    BEGIN
                    num_lg      := 1;
                    this_number := curr_year MOD 10
                    END;
                sp6df_year_10, sp6df_year_10_relative:
                    BEGIN
                    num_lg      := 2;
                    this_number := curr_year MOD 100
                    END;
                sp6df_year_100:
                    BEGIN
                    num_lg      := 3;
                    this_number := curr_year MOD 1000
                    END;
                sp6df_year_comma:
                    BEGIN
                    num_lg      := 5;
                    this_number := curr_year
                    END;
                sp6df_year_short:
                    IF  language_found
                    THEN
                        BEGIN (* nineteen-ninety-four *)
                        sp78spell_number (dictionary,
                              timestamp [1] DIV 100, false,
                              spell_kind, dest_size, dest_addr^, dest_pos, e);
                        IF  e <> sp6de_ok
                        THEN
                            goto 999;
                        (*ENDIF*) 
                        IF  dictionary.lang = 'DEU'
                        THEN
                            year_filler := sp6d_hundred
                        ELSE
                            year_filler := sp6d_and;
                        (*ENDIF*) 
                        WITH dictionary.dict_etc [year_filler, NOT c_ordinal] DO
                            BEGIN
                            s10mv (sizeof (string), dest_size,
                                  @string, 1, @dest_addr^, dest_pos, length);
                            IF  e <> sp6de_ok
                            THEN
                                goto 999;
                            (*ENDIF*) 
                            dest_pos := dest_pos + length
                            END;
                        (*ENDWITH*) 
                        sp78spell_number (dictionary,
                              timestamp [1] MOD 100, false,
                              spell_kind, dest_size, dest_addr^, dest_pos, e);
                        IF  e <> sp6de_ok
                        THEN
                            goto 999;
                        (*ENDIF*) 
                        END
                    ELSE
                        sp78fill_missing_language (dest_addr^, dest_pos, '?');
                    (*ENDIF*) 
                sp6df_quarter:
                    BEGIN
                    num_lg      := 1;
                    this_number := (timestamp [2]-1) DIV 3 + 1
                    END;
                sp6df_meridian_am,   sp6df_meridian_pm,
                sp6df_meridian_a_m_, sp6df_meridian_p_m_,
                sp6df_anno_ad,       sp6df_anno_bc,
                sp6df_anno_a_d_,     sp6df_anno_b_c_:
                    IF  language_found
                    THEN
                        BEGIN
                        CASE curr_fmt.fmt OF
                            sp6df_anno_bc:
                                IF  timestamp [1] >= 0
                                THEN
                                    curr_fmt.fmt := sp6df_anno_ad;
                                (*ENDIF*) 
                            sp6df_anno_ad:
                                IF  timestamp [1] < 0
                                THEN
                                    curr_fmt.fmt := sp6df_anno_bc;
                                (*ENDIF*) 
                            sp6df_anno_b_c_:
                                IF  timestamp [1] >= 0
                                THEN
                                    curr_fmt.fmt := sp6df_anno_a_d_;
                                (*ENDIF*) 
                            sp6df_anno_a_d_:
                                IF  timestamp [1] < 0
                                THEN
                                    curr_fmt.fmt := sp6df_anno_b_c_;
                                (*ENDIF*) 
                            sp6df_meridian_am:
                                IF  timestamp [4] >= 12
                                THEN
                                    curr_fmt.fmt := sp6df_meridian_pm;
                                (*ENDIF*) 
                            sp6df_meridian_pm:
                                IF  timestamp [4] < 12
                                THEN
                                    curr_fmt.fmt := sp6df_meridian_am;
                                (*ENDIF*) 
                            sp6df_meridian_a_m_:
                                IF  timestamp [4] >= 12
                                THEN
                                    curr_fmt.fmt := sp6df_meridian_p_m_;
                                (*ENDIF*) 
                            sp6df_meridian_p_m_:
                                IF  timestamp [4] < 12
                                THEN
                                    curr_fmt.fmt := sp6df_meridian_a_m_;
                                (*ENDIF*) 
                            END;
                        (*ENDCASE*) 
                        sp78spell_it (dictionary, curr_fmt.fmt, 0,
                              zero_fill, spell_kind,
                              dest_size, dest_addr, dest_pos, e);
                        END
                    ELSE
                        sp78fill_missing_language (dest_addr^, dest_pos, '?');
                    (*ENDIF*) 
                sp6df_century:
                    BEGIN
                    num_lg      := 2;
                    this_number := timestamp [1] DIV 100 + 1
                    END;
                sp6df_julian_day:
                    BEGIN
                    num_lg    := 7;
                    (* s78diff_year_day returns the difference always as a positive *)
                    (* number, so we have to check wheather to add or subtract it.  *)
                    diff_days := s78diff_year_day (timestamp [1], days_in_year,
                          c_julian_base_year, c_julian_base_day);
                    IF  ( timestamp [1] > c_julian_base_year) OR
                        ((timestamp [1] = c_julian_base_year) AND
                        ( days_in_year   > c_julian_base_day))
                    THEN
                        this_number := c_julian_base_offset + diff_days
                    ELSE
                        this_number := c_julian_base_offset - diff_days
                    (*ENDIF*) 
                    END;
                sp6df_month_numeric:
                    BEGIN
                    num_lg      := 2;
                    this_number := timestamp [2]
                    END;
                sp6df_month_roman, sp6df_month_long, sp6df_month_short:
                    IF  language_found
                    THEN
                        sp78spell_it (dictionary, curr_fmt.fmt, timestamp [2],
                              zero_fill, spell_kind,
                              dest_size, dest_addr, dest_pos, e)
                    ELSE
                        sp78fill_missing_language (dest_addr^, dest_pos, '?');
                    (*ENDIF*) 
                sp6df_day_of_week_short, sp6df_day_of_week_long:
                    IF  language_found
                    THEN
                        sp78spell_it (dictionary, curr_fmt.fmt, iso_day,
                              zero_fill, spell_kind,
                              dest_size, dest_addr, dest_pos, e)
                    ELSE
                        sp78fill_missing_language (dest_addr^, dest_pos, '?');
                    (*ENDIF*) 
                sp6df_day_of_week_numeric:
                    BEGIN
                    num_lg := 1;
                    IF  dictionary.lang = 'DEU'
                    THEN
                        this_number := iso_day
                    ELSE
                        this_number := (iso_day MOD 7) + 1
                    (*ENDIF*) 
                    END;
                sp6df_day_of_month:
                    BEGIN
                    num_lg      := 2;
                    this_number := timestamp [3]
                    END;
                sp6df_day_of_year:
                    BEGIN
                    num_lg      := 3;
                    this_number := days_in_year
                    END;
                sp6df_week_of_year:
                    BEGIN
                    num_lg := 2;
                    IF  sp6dfm_iso in modif
                    THEN
                        this_number := iso_week
                    ELSE (* Divide days in year by seven. *)
                        this_number := (days_in_year-1) DIV 7 + 1;
                    (*ENDIF*) 
                    END;
                sp6df_week_of_month:
                    BEGIN
                    num_lg      := 1;
                    this_number := (timestamp [3]-1) DIV 7 + 1;
                    END;
                sp6df_hour_24:
                    BEGIN
                    num_lg      := 2;
                    this_number := timestamp [4]
                    END;
                sp6df_hour_12, sp6df_hour:
                    BEGIN
                    num_lg      := 2;
                    this_number := timestamp [4] MOD 12;
                    IF  this_number = 0
                    THEN
                        this_number := 12;
                    (*ENDIF*) 
                    END;
                sp6df_minute:
                    BEGIN
                    num_lg      := 2;
                    this_number := timestamp [5]
                    END;
                sp6df_seconds_of_minute:
                    BEGIN
                    num_lg      := 2;
                    this_number := timestamp [6]
                    END;
                sp6df_microseconds:
                    BEGIN
                    num_lg      := 2;
                    this_number := timestamp [7] DIV 10000;
                    END;
                sp6df_seconds_of_day:
                    BEGIN
                    num_lg      := 5;
                    this_number := timestamp [6]        (* seconds *)
                          +        timestamp [5]*60     (* minutes *)
                          +        timestamp [4]*60*60; (* hours   *)
                    END;
                OTHERWISE;
                END;
            (*ENDCASE*) 
            IF  this_number >= 0
            THEN
                IF  sp6dfm_spelled in modif
                THEN
                    IF  language_found
                    THEN
                        sp78spell_number (dictionary,
                              this_number, sp6dfm_ordinal in modif,
                              spell_kind, dest_size, dest_addr^, dest_pos, e)
                    ELSE
                        sp78fill_missing_language (dest_addr^, dest_pos, '?')
                    (*ENDIF*) 
                ELSE
                    BEGIN
                    sp78intlj_into_str (this_number, zero_fill,
                          curr_fmt.fmt = sp6df_year_comma, num_lg,
                          dest_size, dest_addr, dest_pos, dest_len);
                    IF  sp6dfm_ordinal in modif
                    THEN
                        sp78ordinal_suffix (dictionary, this_number,
                              spell_kind, dest_size, dest_addr, dest_pos);
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
            IF  e <> sp6de_ok
            THEN
                goto 999
            (*ENDIF*) 
            END
        END
    (*ENDCASE*) 
UNTIL
    (fmt_pos > format_len) OR (curr_fmt.fmt = sp6df_no_correct_format);
(*ENDREPEAT*) 
999:;
END;
 
(*------------------------------*) 
 
PROCEDURE
      s78c2d_to_date (VAR dictionary : tsp6_dictionary;
            curr_date    : tsp00_MoveObjPtr;
            fmt_addr     : tsp00_MoveObjPtr;
            fmt_len      : tsp00_Int4;
            src_addr     : tsp00_MoveObjPtr;
            src_len      : tsp00_Int4;
            dest_addr    : tsp00_MoveObjPtr;
            VAR dest_pos : tsp00_Int4;
            VAR e        : tsp6_date_error);
 
VAR
      curr_fmt       : format_cast;
      result         : tsp6_date_fmt_elem;
      modif          : tsp6_date_fmt_modifier;
      spell_kind     : tsp6_date_spell_kind;
      src_pos        : integer;
      fmt_pos        : integer;
      check_pos      : integer;
      check_len      : integer;
      num_lg         : integer;
      zero_fill      : boolean;
      exact_mode     : boolean;
      weekday_given  : boolean;
      language_found : boolean;
      ignored        : boolean;
      min_value      : integer;
      max_value      : integer;
      diff           : integer;
      rest_of_year   : integer;
      days           : integer;
      iso_week       : integer;
      iso_day        : integer;
      timestamp      : tsp6_timestamp_array;
      specs          : ARRAY [ tsp6_date_fmt_elem ] OF boolean;
      value          : ARRAY [ tsp6_date_fmt_elem ] OF integer;
      curr_year      : integer;
      curr_month     : integer;
      curr_day       : integer;
 
LABEL
      999;
 
BEGIN
e := sp6de_ok;
(* dest_addr^[ dest_pos ] is the byte behind def-byte or the first of variable 
IF  (src_addr^[ 1 ] = csp_undef_byte) OR
    (fmt_addr^[ 1 ] = csp_undef_byte)
THEN
    BEGIN
    dest_addr^[ dest_pos ] := csp_undef_byte;
    goto 999
    END;
    *)
(*ENDIF*) 
IF  fmt_addr^[ 1 ] <> chr (c_format_magic)
THEN
    BEGIN
    e := sp6de_format_not_recognized;
    goto 999
    END;
(*ENDIF*) 
zero_fill      := true;
exact_mode     := false;
weekday_given  := false;
language_found := dictionary.dict_mon[ 1 ].length > 0;
FOR result := sp6df_no_correct_format TO sp6df_microseconds DO
    BEGIN
    specs[ result ] := false;
    value[ result ] := 0
    END;
(*ENDFOR*) 
s78year_month_day (curr_date^, 1,
      curr_year, curr_month, curr_day, e);
value[ sp6df_year ]          := curr_year;
value[ sp6df_month_numeric ] := curr_month;
value[ sp6df_day_of_month ]  := 1;
fmt_pos := 2;
src_pos := 1;
REPEAT
    curr_fmt.format_int := ord (fmt_addr^[ fmt_pos ]);
    fmt_pos   := succ (fmt_pos);
    ignored   := false;
    num_lg    := 2;
    min_value := 0;
    max_value := 12;
    sp78skip_layout (src_addr^, src_pos, src_len,
          exact_mode);
    CASE curr_fmt.fmt OF
        sp6df_no_correct_format:
            ignored := true;
        sp6df_quoted_text, sp6df_special_char:
            BEGIN (* Dependend of exact_mode Oracle7 does:                  *)
            (*       false: ignores the given number of chars in input;     *)
            (*       true:  checks if exactly the given chars are in input. *)
            ignored := true;
            IF  curr_fmt.fmt = sp6df_special_char
            THEN
                IF  exact_mode OR (fmt_addr^[ fmt_pos ] <> ' ')
                THEN (* exactly one char to compare. *)
                    check_len := 1
                ELSE (* Blanks are handled by sp78skip_layout. *)
                    check_len := 0
                (*ENDIF*) 
            ELSE
                BEGIN
                check_len := ord (fmt_addr^[ fmt_pos ]);
                fmt_pos   := succ (fmt_pos)
                END;
            (*ENDIF*) 
            IF  (check_len > 0) AND (src_pos+check_len-1 > src_len)
            THEN
                BEGIN
                e := sp6de_too_short_input;
                goto 999
                END;
            (*ENDIF*) 
            IF  exact_mode
            THEN
                FOR check_pos := 0 TO check_len-1 DO
                    IF  src_addr^[ src_pos+check_pos ] <>
                        fmt_addr^[ fmt_pos+check_pos ]
                    THEN
                        BEGIN
                        e := sp6de_inconsistent;
                        goto 999
                        END;
                    (*ENDIF*) 
                (*ENDFOR*) 
            (*ENDIF*) 
            src_pos := src_pos + check_len;
            IF  curr_fmt.fmt = sp6df_special_char
            THEN
                fmt_pos := succ (fmt_pos)
            ELSE
                fmt_pos := fmt_pos + check_len
            (*ENDIF*) 
            END;
        OTHERWISE
            BEGIN
            sp78get_modifier (fmt_addr, fmt_pos,
                  modif, zero_fill, exact_mode, spell_kind);
            CASE curr_fmt.fmt OF
                sp6df_seconds_of_minute, sp6df_minute:
                    max_value := 59;
                sp6df_seconds_of_day:
                    BEGIN
                    num_lg    := 5;
                    max_value := 86399
                    END;
                sp6df_microseconds:
                    BEGIN
                    max_value := 99;
                    END;
                sp6df_hour, sp6df_hour_12:
                    min_value := 1;
                sp6df_hour_24:
                    max_value := 23;
                sp6df_day_of_week_numeric:
                    BEGIN
                    num_lg        := 1;
                    max_value     := 7;
                    weekday_given := true
                    END;
                sp6df_day_of_week_short, sp6df_day_of_week_long:
                    BEGIN
                    IF  NOT  language_found
                    THEN
                        BEGIN
                        e := sp6de_unknown_day;
                        goto 999
                        END;
                    (*ENDIF*) 
                    num_lg := 0;
                    sp78scan_it (dictionary, curr_fmt.fmt, src_addr^,
                          src_pos, src_len,
                          value[ sp6df_day_of_week_numeric ], e);
                    weekday_given := true
                    END;
                sp6df_day_of_month:
                    BEGIN
                    min_value := 1;
                    max_value := 31
                    END;
                sp6df_day_of_year:
                    BEGIN
                    num_lg    := 3;
                    min_value := 1;
                    max_value := 366
                    END;
                sp6df_julian_day:
                    BEGIN
                    num_lg    := 7;
                    min_value := 1;
                    max_value := 3442447
                    END;
                sp6df_month_numeric:
                    min_value := 1;
                sp6df_month_short, sp6df_month_long, sp6df_month_roman:
                    BEGIN
                    IF  NOT  language_found
                    THEN
                        BEGIN
                        e := sp6de_unknown_month;
                        goto 999
                        END;
                    (*ENDIF*) 
                    num_lg := 0;
                    sp78scan_it (dictionary, curr_fmt.fmt, src_addr^,
                          src_pos, src_len,
                          value[ sp6df_month_numeric ], e)
                    END;
                sp6df_year, sp6df_year_comma:
                    BEGIN
                    num_lg    := 4;
                    min_value := 1;
                    (* PTS 1121793 E.Z. *)
                    max_value := 9999
                    END;
                sp6df_year_1:
                    BEGIN
                    num_lg    := 1;
                    max_value := 9
                    END;
                sp6df_year_10, sp6df_year_10_relative:
                    max_value := 99;
                sp6df_year_100:
                    BEGIN
                    num_lg    := 3;
                    max_value := 999
                    END;
                sp6df_meridian_am, sp6df_meridian_pm,
                sp6df_meridian_a_m_, sp6df_meridian_p_m_:
                    BEGIN
                    IF  NOT  language_found
                    THEN
                        BEGIN
                        e := sp6de_unknown_meridian;
                        goto 999
                        END;
                    (*ENDIF*) 
                    num_lg := 0;
                    sp78scan_meridian (dictionary, src_addr^, src_pos, src_len,
                          sp6df_meridian_a_m_, sp6df_meridian_pm, result, e);
                    IF  (e = sp6de_ok) AND
                        (result in  [sp6df_meridian_pm, sp6df_meridian_p_m_])
                    THEN
                        value[ curr_fmt.fmt ] := 12
                    (*ENDIF*) 
                    END;
                sp6df_anno_ad, sp6df_anno_bc, sp6df_anno_a_d_, sp6df_anno_b_c_:
                    BEGIN
                    IF  NOT  language_found
                    THEN
                        BEGIN
                        e := sp6de_unknown_meridian;
                        goto 999
                        END;
                    (*ENDIF*) 
                    num_lg := 0;
                    sp78scan_meridian (dictionary, src_addr^, src_pos, src_len,
                          sp6df_anno_a_d_, sp6df_anno_bc, result, e);
                    IF  (e = sp6de_ok) AND
                        (result in  [sp6df_anno_bc, sp6df_anno_b_c_])
                    THEN (* there are no dates before christ in out db. *)
                        e := sp6de_invalid_date
                    (*ENDIF*) 
                    END;
                OTHERWISE;
                END;
            (*ENDCASE*) 
            END;
        END;
    (*ENDCASE*) 
    IF  e <> sp6de_ok
    THEN
        goto 999;
    (*ENDIF*) 
    IF  NOT ignored
    THEN
        BEGIN
        IF  specs [curr_fmt.fmt]
        THEN
            BEGIN
            e := sp6de_duplicate_format;
            goto 999
            END;
        (*ENDIF*) 
        specs[ curr_fmt.fmt ] := true;
        IF  num_lg > 0
        THEN
            BEGIN
            IF  src_pos > src_len
            THEN
                BEGIN
                e := sp6de_too_short_input;
                goto 999
                END;
            (*ENDIF*) 
            sp78str_into_int (src_addr^, src_pos, src_len,
                  num_lg, value[ curr_fmt.fmt ], e);
            IF  e <> sp6de_ok
            THEN
                goto 999;
            (*ENDIF*) 
            IF  (value[ curr_fmt.fmt ] < min_value) OR
                (value[ curr_fmt.fmt ] > max_value)
            THEN
                BEGIN
                e := sp6de_out_of_range;
                goto 999
                END;
            (*ENDIF*) 
            IF  (curr_fmt.fmt = sp6df_day_of_week_numeric) AND
                (dictionary.lang <> 'DEU')
            THEN (* Americans start counting the week at sunday. *)
                IF  value[ sp6df_day_of_week_numeric ] = 1
                THEN
                    value[ sp6df_day_of_week_numeric ] := 7
                ELSE
                    value[ sp6df_day_of_week_numeric ] :=
                          pred (value[ sp6df_day_of_week_numeric ])
                (*ENDIF*) 
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END
    (*ENDIF*) 
UNTIL
    (fmt_pos > fmt_len) OR (curr_fmt.fmt = sp6df_no_correct_format);
(*ENDREPEAT*) 
(* Now check, if we read the entire input string. *)
sp78skip_layout (src_addr^, src_pos, src_len,
      exact_mode);
IF  src_pos <= src_len
THEN
    BEGIN
    e := sp6de_too_long_input;
    goto 999
    END;
(*ENDIF*) 
IF  specs [sp6df_hour]
THEN
    value[ sp6df_hour_24 ] := value[ sp6df_hour ];
(*ENDIF*) 
IF  specs[ sp6df_hour_12 ]
THEN
    value[ sp6df_hour_24 ] := value[ sp6df_hour_12 ];
(* PTS 1117000 E.Z. *)
(* PTS 1121594 E.Z. *)
(*ENDIF*) 
IF  specs [sp6df_hour] OR specs[ sp6df_hour_12 ]
THEN
    IF  value[ sp6df_hour_24 ] = 12
    THEN
        value[ sp6df_hour_24 ] := 0;
    (*ENDIF*) 
(*ENDIF*) 
value[ sp6df_hour_24 ] := value[ sp6df_hour_24 ]
      + value[ sp6df_meridian_am ] + value[ sp6df_meridian_a_m_ ]
      + value[ sp6df_meridian_pm ] + value[ sp6df_meridian_p_m_ ];
IF  specs[ sp6df_year_comma ]
THEN
    value[ sp6df_year ] := value[ sp6df_year_comma ];
(*ENDIF*) 
IF  specs[ sp6df_year_1 ]
THEN
    value[ sp6df_year ] := value[ sp6df_year_1 ] + (curr_year DIV 10)*10;
(*ENDIF*) 
IF  specs[ sp6df_year_10_relative ]
THEN
    BEGIN
    value[ sp6df_year_10 ] := value[ sp6df_year_10_relative ];
    IF  (value[ sp6df_year_10 ] >= 50) AND (curr_year MOD 100 < 50)
    THEN
        value[ sp6df_year_10 ] := value[ sp6df_year_10 ] - 100
    ELSE
        IF  (value[ sp6df_year_10 ] < 50) AND (curr_year MOD 100 >= 50)
        THEN
            value[ sp6df_year_10 ] := value[ sp6df_year_10 ] + 100
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  specs[ sp6df_year_10 ] OR specs[ sp6df_year_10_relative ]
THEN
    value[ sp6df_year ] := value[ sp6df_year_10 ]
          + (curr_year DIV 100) * 100;
(*ENDIF*) 
IF  specs[ sp6df_year_100 ]
THEN
    value[ sp6df_year ] := value[ sp6df_year_100 ]
          + (curr_year DIV 1000) * 1000;
(*ENDIF*) 
IF  specs[ sp6df_seconds_of_day ]
THEN
    BEGIN
    timestamp[ 4 ] :=  value[ sp6df_seconds_of_day ] DIV 3600;
    timestamp[ 5 ] := (value[ sp6df_seconds_of_day ] MOD 3600) DIV 60;
    timestamp[ 6 ] :=  value[ sp6df_seconds_of_day ] MOD 60;
    IF  (specs[ sp6df_hour ] AND
        (timestamp[ 4 ] <> value[ sp6df_hour_24 ]))
        OR
        (specs [sp6df_minute] AND
        (timestamp[ 5 ] <> value[ sp6df_minute ]))
        OR
        (specs[ sp6df_seconds_of_minute ] AND
        (timestamp[ 6 ] <> value[ sp6df_seconds_of_minute ]))
    THEN
        BEGIN
        e := sp6de_inconsistent;
        goto 999
        END;
    (*ENDIF*) 
    value[ sp6df_hour_24           ] := timestamp[ 4 ]; (* hours   *)
    value[ sp6df_minute            ] := timestamp[ 5 ]; (* minutes *)
    value[ sp6df_seconds_of_minute ] := timestamp[ 6 ]; (* seconds *)
    END;
(*ENDIF*) 
IF  specs[ sp6df_julian_day ]
THEN
    BEGIN
    IF  value[ sp6df_julian_day ] < c_julian_min_day
    THEN
        BEGIN
        e := sp6de_num_overflow;
        goto 999
        END;
    (*ENDIF*) 
    diff           := value[ sp6df_julian_day ] - c_julian_base_offset;
    timestamp[ 1 ] := c_julian_base_year;
    timestamp[ 3 ] := c_julian_base_day;
    IF  diff > 0
    THEN
        REPEAT
            rest_of_year := s78days_of_year (timestamp[ 1 ])
                  - timestamp[ 3 ];
            IF  rest_of_year >= diff
            THEN
                BEGIN
                timestamp[ 3 ] := timestamp[ 3 ] + diff;
                diff           := 0
                END
            ELSE
                BEGIN
                diff           := diff - rest_of_year;
                timestamp[ 1 ] := succ (timestamp[ 1 ]);
                timestamp[ 3 ] := 0
                END
            (*ENDIF*) 
        UNTIL
            diff <= 0
        (*ENDREPEAT*) 
    ELSE
        BEGIN
        diff := -diff;
        REPEAT
            IF  diff < timestamp[ 3 ]
            THEN
                BEGIN
                timestamp[ 3 ] := timestamp[ 3 ] - diff;
                diff           := 0
                END
            ELSE
                BEGIN
                diff           := diff - timestamp[ 3 ];
                timestamp[ 1 ] := pred (timestamp[ 1 ]);
                timestamp[ 3 ] := s78days_of_year (timestamp[ 1 ]);
                END
            (*ENDIF*) 
        UNTIL
            diff <= 0
        (*ENDREPEAT*) 
        END;
    (*ENDIF*) 
    IF  (specs[ sp6df_year ]   OR specs[ sp6df_year_100 ]         OR
        specs[ sp6df_year_1 ]  OR specs[ sp6df_year_10_relative ] OR
        specs[ sp6df_year_10 ] OR specs[ sp6df_year_comma ])
        AND (timestamp[ 1 ] <> value[ sp6df_year ])
    THEN
        BEGIN
        e := sp6de_inconsistent;
        goto 999
        END;
    (*ENDIF*) 
    value[ sp6df_year ] := timestamp[ 1 ]
    END;
(*ENDIF*) 
IF  specs[ sp6df_day_of_year ]
THEN
    BEGIN
    IF  s78is_leap_year (value[ sp6df_year ]) AND
        (value[ sp6df_day_of_year ] = 366)
    THEN
        BEGIN
        e := sp6de_out_of_range;
        goto 999
        END;
    (*ENDIF*) 
    timestamp[ 3 ] := value[ sp6df_day_of_year ]
    END;
(*ENDIF*) 
IF  specs[ sp6df_day_of_year ] OR specs[ sp6df_julian_day ]
THEN
    BEGIN
    timestamp[ 2 ] := 1; (* month := January *)
    days := s78days_of_month (value[ sp6df_year ], timestamp[ 2 ]);
    WHILE days < timestamp[ 3 ] DO
        BEGIN
        timestamp[ 3 ] := timestamp[ 3 ] - days;
        timestamp[ 2 ] := succ (timestamp[ 2 ]);
        days := s78days_of_month (value[ sp6df_year ], timestamp[ 2 ])
        END;
    (*ENDWHILE*) 
    IF  (( specs[ sp6df_month_numeric ] OR specs[ sp6df_month_roman ]
        OR specs[ sp6df_month_short ]   OR specs[ sp6df_month_long ])
        AND (timestamp[ 2 ] <> value[ sp6df_month_numeric ]))
        OR
        (specs [sp6df_day_of_month]
        AND (timestamp[ 3 ] <> value[ sp6df_day_of_month ]))
    THEN
        BEGIN
        e := sp6de_inconsistent;
        goto 999
        END;
    (*ENDIF*) 
    value[ sp6df_month_numeric ] := timestamp[ 2 ];
    value[ sp6df_day_of_month ]  := timestamp[ 3 ]
    END;
(*ENDIF*) 
IF  value[ sp6df_day_of_month ]
    > s78days_of_month (value[ sp6df_year ], value[ sp6df_month_numeric ])
THEN
    BEGIN
    e := sp6de_invalid_day;
    goto 999
    END;
(*ENDIF*) 
timestamp[ 1 ] := value[ sp6df_year ];
timestamp[ 2 ] := value[ sp6df_month_numeric ];
timestamp[ 3 ] := value[ sp6df_day_of_month ];
timestamp[ 4 ] := value[ sp6df_hour_24 ];
timestamp[ 5 ] := value[ sp6df_minute ];
timestamp[ 6 ] := value[ sp6df_seconds_of_minute ];
timestamp[ 7 ] := value[ sp6df_microseconds ] * 10000;
s78ints_to_buf (dest_addr^,
      dest_pos, timestamp);
IF  weekday_given
THEN      (* The user may give the D/DY/DAY format, but we *)
    BEGIN (* only have to check the consistence of it.     *)
    s78week_and_day (dest_addr^, pred(dest_pos),
          iso_week, iso_day, e);
    IF  (e <> sp6de_ok) OR (iso_day <> value[ sp6df_day_of_week_numeric ])
    THEN
        BEGIN
        e := sp6de_inconsistent;
        goto 999
        END
    (*ENDIF*) 
    END;
(*ENDIF*) 
dest_pos := dest_pos + mxsp_exttimestamp;
999:;
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp78scan_it (VAR dictionary : tsp6_dictionary;
            curr_fmt    : tsp6_date_fmt_elem;
            VAR operand : tsp00_MoveObj;
            VAR src_pos : integer;
            src_len     : tsp00_Int2;
            VAR result  : integer;
            VAR e       : tsp6_date_error);
 
VAR
      max_value  : integer;
      curr_value : integer;
      cmp_len    : tsp00_Int2;
      curr_len   : tsp00_Int2;
      cmp_str    : tsp00_C12;
      in_word    : boolean;
      up_lo_diff : integer;
      curr_ch    : char;
      cmp_result : tsp00_LcompResult;
 
BEGIN
max_value := 0; (* just to avoid warnings: uninitialized max_value *)
CASE curr_fmt OF
    sp6df_day_of_week_long, sp6df_day_of_week_short:
        BEGIN
        e         := sp6de_unknown_day;
        max_value := 7
        END;
    sp6df_month_long, sp6df_month_short, sp6df_month_roman:
        BEGIN
        e         := sp6de_unknown_month;
        max_value := 12
        END;
    END;
(*ENDCASE*) 
curr_value := 0;
WHILE (curr_value < max_value) AND (e <> sp6de_ok) DO
    BEGIN
    curr_value := succ (curr_value);
    CASE  curr_fmt OF
        sp6df_day_of_week_long:
            WITH dictionary.dict_day [ curr_value ] DO
                BEGIN
                cmp_len := length;
                cmp_str := string
                END;
            (*ENDWITH*) 
        sp6df_day_of_week_short:
            WITH dictionary.dict_day[ curr_value ] DO
                BEGIN
                cmp_len := 3;
                cmp_str := string
                END;
            (*ENDWITH*) 
        sp6df_month_roman:
            WITH dictionary.dict_rom[ curr_value ] DO
                BEGIN
                cmp_len := length;
                cmp_str := string
                END;
            (*ENDWITH*) 
        sp6df_month_long:
            WITH dictionary.dict_mon[ curr_value ] DO
                BEGIN
                cmp_len := length;
                cmp_str := string
                END;
            (*ENDWITH*) 
        sp6df_month_short:
            WITH dictionary.dict_mon[ curr_value ] DO
                BEGIN
                cmp_len := 3;
                cmp_str := string
                END;
            (*ENDWITH*) 
        END;
    (*ENDCASE*) 
    curr_len := 0;
    in_word  := true;
    WHILE in_word AND (src_pos + curr_len <= src_len) DO
        BEGIN
        up_lo_diff := 0;
        curr_ch    := operand [src_pos + curr_len];
        IF  curr_ch in ['A'..'I', 'J'..'R', 'S'..'Z']
        THEN
            BEGIN
            curr_len := succ (curr_len);
            IF  curr_len > 1
            THEN
                up_lo_diff := ord ('a') - ord ('A');
            (*ENDIF*) 
            END
        ELSE
            IF  curr_ch in ['a'..'i', 'j'..'r', 's'..'z']
            THEN
                BEGIN
                curr_len := succ (curr_len);
                IF  curr_len = 1
                THEN
                    up_lo_diff := ord ('A') - ord ('a');
                (*ENDIF*) 
                END
            ELSE
                in_word := false;
            (*ENDIF*) 
        (*ENDIF*) 
        IF  up_lo_diff <> 0
        THEN
            operand [src_pos+curr_len-1] := chr (ord (curr_ch) + up_lo_diff);
        (*ENDIF*) 
        END;
    (*ENDWHILE*) 
    IF  curr_len = 0
    THEN
        e := sp6de_no_letter
    ELSE
        IF  curr_len >= cmp_len
        THEN
            BEGIN
            s30cmp (operand, src_pos, cmp_len, cmp_str, 1,
                  cmp_len, cmp_result);
            IF  cmp_result = l_equal
            THEN
                BEGIN
                e       := sp6de_ok;
                src_pos := src_pos + cmp_len;
                result  := curr_value
                END
            (*ENDIF*) 
            END
        (*ENDIF*) 
    (*ENDIF*) 
    END
(*ENDWHILE*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp78scan_meridian (VAR dictionary : tsp6_dictionary;
            VAR operand : tsp00_MoveObj;
            VAR src_pos : integer;
            src_len     : tsp00_Int2;
            min_value   : tsp6_date_fmt_elem;
            max_value   : tsp6_date_fmt_elem;
            VAR result  : tsp6_date_fmt_elem;
            VAR e       : tsp6_date_error);
 
VAR
      curr_len   : tsp00_Int2;
      in_word    : boolean;
      up_lo_diff : integer;
      curr_ch    : char;
      cmp_result : tsp00_LcompResult;
 
      curr_value : RECORD
            CASE boolean OF
                true :
                    (o : tsp6_date_fmt_elem);
                false :
                    (i : tsp00_Uint1);
                END;
            (*ENDCASE*) 
 
 
BEGIN
e            := sp6de_unknown_meridian;
curr_value.o := min_value;
WHILE (curr_value.i <= ord (max_value)) AND (e <> sp6de_ok) DO
    BEGIN
    WITH dictionary.dict_mer [curr_value.o] DO
        BEGIN
        curr_len := 0;
        in_word  := true;
        WHILE in_word AND (src_pos + curr_len <= src_len) DO
            BEGIN
            up_lo_diff := 0;
            curr_ch    := operand [src_pos + curr_len];
            IF  curr_ch in ['A'..'D', 'M', 'P']
            THEN
                BEGIN
                curr_len := succ (curr_len);
                IF  curr_len > 1
                THEN
                    up_lo_diff := ord ('a') - ord ('A');
                (*ENDIF*) 
                END
            ELSE
                IF  curr_ch in ['a'..'d', 'm', 'p']
                THEN
                    BEGIN
                    curr_len := succ (curr_len);
                    IF  curr_len = 1
                    THEN
                        up_lo_diff := ord ('A') - ord ('a');
                    (*ENDIF*) 
                    END
                ELSE
                    IF  curr_ch = '.'
                    THEN
                        curr_len := succ (curr_len)
                    ELSE
                        in_word := false;
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
            IF  up_lo_diff <> 0
            THEN
                operand [src_pos+curr_len-1] :=
                      chr (ord (curr_ch) + up_lo_diff);
            (*ENDIF*) 
            END;
        (*ENDWHILE*) 
        IF  curr_len >= length
        THEN
            BEGIN
            s30cmp (operand, src_pos, length, string, 1, length, cmp_result);
            IF  cmp_result = l_equal
            THEN
                BEGIN
                e       := sp6de_ok;
                src_pos := src_pos + length;
                result  := curr_value.o
                END
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END;
    (*ENDWITH*) 
    curr_value.i := succ (curr_value.i)
    END
(*ENDWHILE*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp78fill_missing_language (VAR dest_buf : tsp00_MoveObj;
            VAR dest_pos : integer;
            fill_char    : char);
 
VAR
      i : integer;
 
BEGIN
FOR i := 1 TO 3 DO
    BEGIN
    dest_buf[ dest_pos ] := fill_char;
    dest_pos             := succ (dest_pos)
    END;
(*ENDFOR*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp78skip_layout (VAR operand : tsp00_MoveObj;
            VAR src_pos : integer;
            src_len     : integer;
            exact_mode  : boolean);
 
BEGIN
IF  NOT exact_mode
THEN
    WHILE (src_pos <= src_len) AND (operand [src_pos] = ' ') DO
        src_pos := succ (src_pos)
    (*ENDWHILE*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp78ordinal_suffix (VAR dictionary : tsp6_dictionary;
            this_number  : integer;
            spell_kind   : tsp6_date_spell_kind;
            dest_size    : integer;
            dest_addr    : tsp00_MoveObjPtr;
            VAR dest_pos : integer);
 
VAR
      suffix  : tsp00_C12;
      suf_lg  : integer;
      last    : integer;
 
BEGIN (* Let's finish it with the ordinal suffix. *)
IF  dictionary.lang = 'DEU'
THEN
    BEGIN
    suffix := '.           ';
    suf_lg := 1
    END
ELSE
    BEGIN
    suf_lg := 2;
    last   := this_number MOD 100;
    IF  (last >= 10) AND (last <= 20)
    THEN (* For the teens there is always the suffix 'th'. *)
        suffix := 'th          '
    ELSE (* We have to check the last digit for 1, 2 or 3. *)
        CASE (last MOD 10) OF
            1:
                suffix := 'st          ';
            2:
                suffix := 'nd          ';
            3:
                suffix := 'rd          ';
            OTHERWISE:
                suffix := 'th          ';
            END;
        (*ENDCASE*) 
    (*ENDIF*) 
    s10mv (sizeof (suffix), dest_size,
          @suffix, 1, @dest_addr^, dest_pos, suf_lg);
    IF  spell_kind = sp6dfs_spell_upper
    THEN
        IF  dictionary.dict_upp_table <> NIL
        THEN
            s30map (dictionary.dict_upp_table^,
                  dest_addr^, dest_pos, dest_addr^, dest_pos, suf_lg);
        (*ENDIF*) 
    (*ENDIF*) 
    dest_pos := dest_pos + suf_lg
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp78spell_it (VAR dictionary : tsp6_dictionary;
            fmt          : tsp6_date_fmt_elem;
            value        : integer;
            zero_fill    : boolean;
            spell_kind   : tsp6_date_spell_kind;
            dest_size    : integer;
            dest_addr    : tsp00_MoveObjPtr;
            VAR dest_pos : integer;
            VAR e        : tsp6_date_error);
 
LABEL
      999;
 
VAR
      out_string : tsp00_C12;
      copy_len   : integer;
      table_ptr  : ^tsp00_Ctable;
 
BEGIN
IF  (fmt in [ sp6df_month_long, sp6df_month_short, sp6df_month_roman])
    AND (value >= 1) AND (value <= 12)
THEN
    IF  fmt = sp6df_month_roman
    THEN
        WITH dictionary.dict_rom[ value ] DO
            BEGIN
            out_string := string;
            copy_len   := length
            END
        (*ENDWITH*) 
    ELSE
        WITH dictionary.dict_mon[ value ] DO
            BEGIN
            out_string := string;
            copy_len   := length
            END
        (*ENDWITH*) 
    (*ENDIF*) 
ELSE
    IF  (fmt in  [sp6df_day_of_week_short, sp6df_day_of_week_long]) AND
        (value >= 1) AND (value <= 7)
    THEN
        WITH dictionary.dict_day[ value ] DO
            BEGIN
            out_string := string;
            copy_len   := length
            END
        (*ENDWITH*) 
    ELSE
        IF  fmt in  [sp6df_meridian_a_m_ .. sp6df_anno_bc]
        THEN
            WITH dictionary.dict_mer[ fmt ] DO
                BEGIN
                out_string := string;
                copy_len   := length
                END
            (*ENDWITH*) 
        ELSE
            BEGIN
            out_string := '???         ';
            copy_len   := 3
            END;
        (*ENDIF*) 
    (*ENDIF*) 
(*ENDIF*) 
IF  fmt in  [sp6df_day_of_week_short, sp6df_month_short]
THEN
    copy_len := 3
ELSE
    IF  zero_fill
    THEN
        CASE fmt OF
            sp6df_month_roman:
                copy_len := 4;
            sp6df_day_of_week_long:
                copy_len := dictionary.max_day_len;
            sp6df_month_long:
                copy_len := dictionary.max_month_len;
            OTHERWISE;
                (* there is nothing to fill up... *)
            END;
        (*ENDCASE*) 
    (*ENDIF*) 
(*ENDIF*) 
IF  (dest_pos + copy_len - 1 > dest_size)
THEN
    BEGIN
    e := sp6de_overflow;
    goto 999
    END;
(*ENDIF*) 
s10mv (sizeof (out_string), dest_size,
      @out_string, 1, @dest_addr^, dest_pos, copy_len);
CASE spell_kind OF
    sp6dfs_spell_upper:
        table_ptr := @dictionary.dict_upp_table^;
    sp6dfs_spell_lower:
        table_ptr := @dictionary.dict_low_table^;
    OTHERWISE
        table_ptr := NIL
    END;
(*ENDCASE*) 
IF  table_ptr <> NIL
THEN
    s30map (table_ptr^, dest_addr^, dest_pos,
          dest_addr^, dest_pos, copy_len);
(*ENDIF*) 
dest_pos := dest_pos + copy_len;
999:;
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp78spell_number (VAR dictionary : tsp6_dictionary;
            number       : tsp00_Int4;
            ordinal      : boolean;
            spell_kind   : tsp6_date_spell_kind;
            outbuf_size  : tsp00_Int4;
            VAR outbuf   : tsp00_MoveObj;
            VAR dest_pos : integer;
            VAR e        : tsp6_date_error);
 
LABEL
      999;
 
VAR
      add       : tsp6_dict_etc;
      tenth     : tsp00_Int4;
      rest1000  : tsp00_Int4;
      digit     : tsp00_Int4;
      start_pos : integer;
 
BEGIN
e         := sp6de_ok;
start_pos := dest_pos;
IF  number = 0
THEN (* the simple case. *)
    BEGIN
    sp78spell_digit (dictionary, number,
          ordinal, outbuf_size, outbuf, dest_pos);
    IF  e <> sp6de_ok
    THEN
        goto 999;
    (*ENDIF*) 
    END
ELSE
    BEGIN
    tenth    := 0;
    rest1000 := -1;
    (* Since the julian days can reach up to 3 1/2 million, *)
    (* we have to deal with that large numbers too.         *)
    WHILE (number > 0) OR (rest1000 >= 0) DO
        BEGIN
        add := sp6d_no_etc;
        IF  tenth > 0
        THEN
            BEGIN
            digit  := tenth;
            tenth  := 0;
            number := 0
            END
        ELSE
            IF  number >= 1000000
            THEN
                BEGIN
                digit  := number DIV 1000000;
                number := number MOD 1000000;
                IF  digit = 1
                THEN
                    add := sp6d_million
                ELSE
                    add := sp6d_millions
                (*ENDIF*) 
                END
            ELSE
                BEGIN
                IF  number >= 1000
                THEN
                    BEGIN
                    rest1000 := number MOD 1000;
                    number   := number DIV 1000
                    END;
                (*ENDIF*) 
                IF  number > 100
                THEN
                    BEGIN
                    digit  := number DIV 100;
                    number := number MOD 100;
                    add    := sp6d_hundred
                    END
                ELSE
                    IF  number > 20
                    THEN
                        BEGIN
                        IF  dictionary.lang = 'DEU'
                        THEN
                            BEGIN
                            tenth  := number - (number MOD 10);
                            digit  := number MOD 10
                            END
                        ELSE
                            BEGIN
                            digit  := number - (number MOD 10);
                            number := number - digit
                            END;
                        (*ENDIF*) 
                        IF  digit > 0
                        THEN
                            add := sp6d_and
                        (*ENDIF*) 
                        END
                    ELSE
                        BEGIN
                        digit := number;
                        IF  rest1000 >= 0
                        THEN
                            BEGIN
                            number   := rest1000;
                            rest1000 := -1;
                            add      := sp6d_thousand
                            END
                        ELSE
                            number := 0
                        (*ENDIF*) 
                        END
                    (*ENDIF*) 
                (*ENDIF*) 
                END;
            (*ENDIF*) 
        (*ENDIF*) 
        IF  digit > 0
        THEN
            sp78spell_digit (dictionary, digit,
                  ordinal AND (number = 0) AND
                  (add = sp6d_no_etc) AND (rest1000 < 0),
                  outbuf_size, outbuf, dest_pos);
        (*ENDIF*) 
        IF  e <> sp6de_ok
        THEN
            goto 999;
        (*ENDIF*) 
        IF  add <> sp6d_no_etc
        THEN
            WITH dictionary.dict_etc [add, ordinal AND (number = 0)] DO
                BEGIN
                s10mv (sizeof (string), outbuf_size,
                      @string, 1, @outbuf, dest_pos, length);
                dest_pos := dest_pos + length
                END
            (*ENDWITH*) 
        (*ENDIF*) 
        END
    (*ENDWHILE*) 
    END;
(*ENDIF*) 
IF  spell_kind <> sp6dfs_spell_mixed
THEN
    CASE spell_kind OF
        sp6dfs_spell_upper:
            IF  dictionary.dict_upp_table <> NIL
            THEN
                s30map (dictionary.dict_upp_table^,
                      outbuf, start_pos, outbuf, start_pos,
                      dest_pos-start_pos+1);
            (*ENDIF*) 
        sp6dfs_spell_lower:
            IF  dictionary.dict_low_table <> NIL
            THEN
                s30map (dictionary.dict_low_table^,
                      outbuf, start_pos, outbuf, start_pos,
                      dest_pos-start_pos+1)
            (*ENDIF*) 
        END;
    (*ENDCASE*) 
(*ENDIF*) 
999 : ;
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp78spell_digit (VAR dictionary : tsp6_dictionary;
            digit        : tsp00_Int2;
            ordinal      : boolean;
            buf_size     : tsp00_Int4;
            VAR buf      : tsp00_MoveObj;
            VAR dest_pos : integer);
 
VAR
      illegal_digit : tsp00_C12;
 
BEGIN
IF  (digit < 0) OR (digit >= 100)
THEN
    BEGIN
    illegal_digit := '???         ';
    s10mv (sizeof (illegal_digit), buf_size,
          @illegal_digit, 1, @buf, dest_pos + 1, 3);
    dest_pos := dest_pos + 3
    END
ELSE
    IF  digit <= 19
    THEN
        WITH dictionary.dict_19 [digit, ordinal] DO
            BEGIN
            s10mv (sizeof (string), buf_size,
                  @string, 1, @buf, dest_pos, length);
            dest_pos := dest_pos + length
            END
        (*ENDWITH*) 
    ELSE
        WITH dictionary.dict_90 [digit DIV 10, ordinal] DO
            BEGIN
            s10mv (sizeof (string), buf_size,
                  @string, 1, @buf, dest_pos, length);
            dest_pos := dest_pos + length
            END;
        (*ENDWITH*) 
    (*ENDIF*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      sp78df_spell_kind (VAR format : tsp00_MoveObj;
            len : integer;
            pos : tsp00_Int4) : tsp6_date_spell_kind;
 
VAR
      found : tsp6_date_spell_kind;
 
BEGIN
found := sp6dfs_spell_mixed;
IF  (pos+1 <= len)
THEN
    IF  format[ pos ] in [ 'a'..'i', 'j'..'r', 's'..'z' ]
    THEN
        found := sp6dfs_spell_lower
    ELSE
        IF  (    format[ pos   ] in [ 'A'..'I', 'J'..'R', 'S'..'Z' ]) AND
            NOT (format[ pos+1 ] in [ 'a'..'i', 'j'..'r', 's'..'z' ])
        THEN (* Note: A.M. is regarded as upper too. *)
            found := sp6dfs_spell_upper;
        (*ENDIF*) 
    (*ENDIF*) 
(*ENDIF*) 
sp78df_spell_kind := found;
END;
 
(*------------------------------*) 
 
FUNCTION
      s78t_dest_len_date_format (VAR format : tsp00_MoveObj;
            fmt_pos : tsp00_Int4;
            fmt_len : tsp00_Int4) : tsp00_Int2;
 
VAR
      text_pos : tsp00_Int2;
      fmt_end  : tsp00_Int4;
      dest_len : tsp00_Int2;
      curr_fmt : tsp6_date_fmt_elem;
      modif    : tsp6_date_fmt_modifier;
 
BEGIN
dest_len := 0;
fmt_end  := fmt_pos+fmt_len-1;
WHILE (fmt_pos <= fmt_end) AND (dest_len < mxsp6_date_format) DO
    BEGIN
    curr_fmt := sp78elem_date_format (format, fmt_end, fmt_pos, modif);
    sp78suffix_date_format (format, fmt_end, fmt_pos, curr_fmt, modif);
    IF  sp6dfm_spelled IN modif
    THEN
        dest_len := mxsp6_date_format
    ELSE
        BEGIN
        CASE curr_fmt OF
            sp6df_no_correct_format, sp6df_year_short:
                dest_len := mxsp6_date_format;
            sp6df_day_of_week_numeric, sp6df_quarter,
            sp6df_week_of_month, sp6df_year_1, sp6df_special_char:
                dest_len := dest_len + 1;
            sp6df_century, sp6df_day_of_month, sp6df_hour,
            sp6df_hour_24, sp6df_hour_12, sp6df_month_numeric,
            sp6df_minute, sp6df_week_of_year, sp6df_year_10,
            sp6df_year_10_relative, sp6df_seconds_of_minute,
            sp6df_anno_ad, sp6df_anno_bc, sp6df_meridian_am,
            sp6df_meridian_pm, sp6df_microseconds:
                dest_len := dest_len + 2;
            sp6df_day_of_year, sp6df_month_short, sp6df_year_100,
            sp6df_day_of_week_short:
                dest_len := dest_len + 3;
            sp6df_year, sp6df_month_roman, sp6df_anno_a_d_,
            sp6df_anno_b_c_, sp6df_meridian_a_m_, sp6df_meridian_p_m_:
                dest_len := dest_len + 4;
            sp6df_seconds_of_day, sp6df_year_comma:
                dest_len := dest_len + 5;
            sp6df_julian_day:
                dest_len := dest_len + 7;
            sp6df_month_long, sp6df_day_of_week_long:
                dest_len := dest_len + 12; (* longest possible. *)
            sp6df_quoted_text:
                BEGIN
                text_pos := succ (fmt_pos); (* Skipping the leading quote. *)
                WHILE (text_pos <= fmt_end) AND
                      (format[ text_pos ] <> '"') DO
                    BEGIN
                    text_pos := succ (text_pos);
                    dest_len := succ (dest_len)
                    END
                (*ENDWHILE*) 
                END;
            OTHERWISE;
            END;
        (*ENDCASE*) 
        IF  sp6dfm_ordinal IN modif
        THEN
            dest_len := dest_len + 2;
        (*ENDIF*) 
        IF  sp6dfm_signed_years IN modif
        THEN
            dest_len := dest_len + 1;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    sp78new_pos_date_format (format, fmt_end,
          curr_fmt, modif, fmt_pos);
    END;
(*ENDWHILE*) 
s78t_dest_len_date_format := dest_len;
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp78suffix_date_format (VAR format : tsp00_MoveObj;
            len       : tsp00_Int4;
            pos       : tsp00_Int4;
            last_fmt  : tsp6_date_fmt_elem;
            VAR modif : tsp6_date_fmt_modifier);
 
VAR
      round   : integer;
 
BEGIN
IF  last_fmt in [ sp6df_day_of_week_numeric, sp6df_julian_day,
    sp6df_quarter, sp6df_week_of_month, sp6df_year_1, sp6df_century,
    sp6df_day_of_month, sp6df_hour_12, sp6df_hour, sp6df_month_numeric,
    sp6df_minute, sp6df_week_of_year, sp6df_year_10,
    sp6df_year_10_relative, sp6df_day_of_year, sp6df_year_100,
    sp6df_year_comma, sp6df_hour_24, sp6df_year,
    sp6df_seconds_of_minute, sp6df_seconds_of_day, sp6df_microseconds ]
THEN
    BEGIN
    pos := pos;
    sp78new_pos_date_format (format, len, last_fmt, modif, pos);
    FOR round := 1 TO 2 DO
        BEGIN
        IF  NOT (sp6dfm_spelled in modif) AND
            (pos+1 <= len)         AND
            ((format[ pos   ] = 'S') OR (format[ pos   ] = 's')) AND
            ((format[ pos+1 ] = 'P') OR (format[ pos+1 ] = 'p'))
        THEN
            BEGIN
            modif := modif + [ sp6dfm_spelled ];
            pos   := pos + 2
            END;
        (*ENDIF*) 
        IF  NOT (sp6dfm_ordinal in modif) AND
            (pos+1 <= len)         AND
            ((format[ pos   ] = 'T') OR (format[ pos   ] = 't')) AND
            ((format[ pos+1 ] = 'H') OR (format[ pos+1 ] = 'h'))
        THEN
            BEGIN
            modif := modif + [ sp6dfm_ordinal ];
            pos   := pos + 2
            END;
        (*ENDIF*) 
        END
    (*ENDFOR*) 
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp78new_pos_date_format (VAR format : tsp00_MoveObj;
            len      : tsp00_Int4;
            last_fmt : tsp6_date_fmt_elem;
            last_mod : tsp6_date_fmt_modifier;
            VAR pos  : tsp00_Int4);
 
BEGIN
CASE last_fmt OF
    sp6df_no_correct_format:
        ;
    sp6df_day_of_week_numeric, sp6df_julian_day, sp6df_quarter,
    sp6df_week_of_month, sp6df_year_1, sp6df_special_char:
        pos := pos + 1;
    sp6df_century, sp6df_day_of_week_short, sp6df_day_of_month,
    sp6df_hour, sp6df_month_numeric, sp6df_minute, sp6df_week_of_year,
    sp6df_year_10, sp6df_year_10_relative, sp6df_month_roman,
    sp6df_fill_mode_toggle, sp6df_exact_mode_toggle,
    sp6df_seconds_of_minute, sp6df_microseconds, sp6df_anno_ad,
    sp6df_anno_bc, sp6df_meridian_am, sp6df_meridian_pm:
        pos := pos + 2;
    sp6df_day_of_week_long, sp6df_day_of_year, sp6df_month_short,
    sp6df_year_100:
        pos := pos + 3;
    sp6df_hour_24, sp6df_hour_12, sp6df_year, sp6df_year_short,
    sp6df_anno_a_d_, sp6df_anno_b_c_, sp6df_meridian_a_m_,
    sp6df_meridian_p_m_:
        pos := pos + 4;
    sp6df_month_long, sp6df_seconds_of_day, sp6df_year_comma:
        pos := pos + 5;
    sp6df_quoted_text:
        BEGIN
        pos := succ (pos); (* Skipping the leading double quote. *)
        WHILE (pos <= len) AND (format[ pos ] <> '"') DO
            pos := succ (pos);
        (*ENDWHILE*) 
        pos := succ (pos); (* Skipping the trailing double quote. *)
        END;
    END;
(*ENDCASE*) 
IF  sp6dfm_spelled IN last_mod
THEN
    pos := pos + 2;
(*ENDIF*) 
IF  sp6dfm_ordinal IN last_mod
THEN
    pos := pos + 2;
(*ENDIF*) 
IF  sp6dfm_signed_years IN last_mod
THEN
    pos := pos + 1;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      s78week_and_day (VAR datbuf : tsp00_MoveObj;
            datpos          : tsp00_Int4;
            VAR week        : integer;
            VAR day_of_week : integer;
            VAR e           : tsp6_date_error);
 
CONST
      first_jan = 1;
 
VAR
      first_jan_day : integer;
      day_of_year   : integer;
      year          : integer;
      (* Rule : 1. The first thursday in the year          *)
      (*           determines the first week of the year   *)
      (*                                                   *)
      (*           ==> IF JAN 1st is                       *)
      (*               monday, tuesday, wednesday, thursday*)
      (*               THEN   the week is 1 of current year*)
      (*               ELSE   the week is last of last year*)
      (*        2. IF JAN 1st is                           *)
      (*               friday the week is 53 of last year  *)
      (*               saturday and last year was leap     *)
      (*                      the week is 53 of last year  *)
      (*               saturday and last year was not leap *)
      (*                      the week is 52 of last year  *)
      (*               sunday the week is 52 of last year  *)
 
BEGIN
e := sp6de_ok;
s78year_and_day (datbuf, datpos, year, day_of_year, e);
IF  e = sp6de_ok
THEN
    BEGIN
    day_of_week   := sp78weekday (year, day_of_year);
    first_jan_day := sp78weekday (year, first_jan);
    day_of_year   := day_of_year + first_jan_day - 2;
    IF  first_jan_day >= friday
    THEN
        day_of_year := day_of_year - 7;
    (*ENDIF*) 
    IF  day_of_year >= 0
    THEN
        BEGIN
        week := (day_of_year DIV 7) + 1;
        IF  week >= 53
        THEN
            BEGIN
            first_jan_day := sp78weekday (year+1, first_jan);
            IF  first_jan_day < friday
            THEN
                BEGIN
                year := succ (year);
                week := 1
                END
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END
    ELSE
        BEGIN (* friday, saturday or sunday in last week of prev year. *)
        year := pred (year);
        CASE first_jan_day OF
            friday:
                week := 53;
            saturday:
                IF  s78is_leap_year (year)
                THEN
                    week := 53
                ELSE
                    week := 52;
                (*ENDIF*) 
            sunday:
                week := 52;
            END
        (*ENDCASE*) 
        END;
    (*ENDIF*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      sp78weekday (year : integer; day : integer): integer;
 
CONST
      (* Monday: JAN/06/1986 *)
      fix_year = 1986;
      fix_day  = 6;
 
VAR
      diff     : integer;
      week_day : integer;
 
BEGIN
diff := s78diff_year_day (year, day, fix_year, fix_day) MOD 7;
IF  (year < fix_year) OR
    ((year = fix_year) AND (day < fix_day))
THEN
    BEGIN
    week_day := monday - (diff MOD 7);
    IF  week_day < 1
    THEN
        week_day := week_day + 7
    (*ENDIF*) 
    END
ELSE
    week_day := monday + (diff MOD 7);
(*ENDIF*) 
sp78weekday := week_day
END;
 
(*------------------------------*) 
 
PROCEDURE
      s78year_and_day (VAR datbuf : tsp00_MoveObj;
            datpos    : tsp00_Int4;
            VAR year  : integer;
            VAR day   : integer;
            VAR e     : tsp6_date_error);
 
VAR
      i     : integer;
      month : integer;
 
BEGIN
e := sp6de_ok;
sp78int_from_buf (datbuf, datpos + 1, 4, year, sp6de_invalid_date, e);
IF  e = sp6de_ok
THEN
    sp78int_from_buf (datbuf, datpos + 5, 2, month, sp6de_invalid_date, e);
(*ENDIF*) 
IF  e = sp6de_ok
THEN
    sp78int_from_buf (datbuf, datpos + 7, 2, day, sp6de_invalid_date, e);
(*ENDIF*) 
IF  e = sp6de_ok
THEN
    BEGIN
    IF  (month < 1) OR (month > 12)
    THEN
        e := sp6de_invalid_date
    ELSE
        IF  (day < 1) OR (day > s78days_of_month (year, month))
        THEN
            e := sp6de_invalid_date
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  e = sp6de_ok
THEN
    FOR i := 1 TO month-1 DO
        day := day + s78days_of_month (year, i);
    (*ENDFOR*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      s78days_of_month (year : integer; month : integer): integer;
 
VAR
      days : integer;
 
BEGIN
CASE month OF
    1, 3, 5, 7, 8, 10, 12:
        days := 31;
    4, 6, 9, 11:
        days := 30;
    2:
        IF  s78is_leap_year (year)
        THEN
            days := 29
        ELSE
            days := 28;
        (*ENDIF*) 
    OTHERWISE
        days := 0
    END;
(*ENDCASE*) 
s78days_of_month := days
END;
 
(*------------------------------*) 
 
FUNCTION
      s78is_leap_year (year : integer) : boolean;
 
VAR
      leap_year : boolean;
 
BEGIN
leap_year := false;
IF  year MOD 4 = 0
THEN
    BEGIN
    leap_year := true;
    IF  (year MOD 100 = 0) AND (year MOD 400 <> 0)
    THEN
        leap_year := false
    (*ENDIF*) 
    END;
(*ENDIF*) 
s78is_leap_year := leap_year
END;
 
(*------------------------------*) 
 
FUNCTION
      s78diff_year_day (year1 : integer;
            day1  : integer;
            year2 : integer;
            day2  : integer) : tsp00_Int4;
 
VAR
      min_day  : integer;
      max_day  : integer;
      min_year : integer;
      max_year : integer;
      diff     : tsp00_Int4;
 
BEGIN
diff := 0;
IF  (year1 < year2) OR ((year1 = year2) AND (day1 <= day2))
THEN
    BEGIN
    min_year := year1;
    min_day  := day1;
    max_year := year2;
    max_day  := day2
    END
ELSE
    BEGIN
    min_year := year2;
    min_day  := day2;
    max_year := year1;
    max_day  := day1
    END;
(*ENDIF*) 
WHILE min_year < max_year DO
    BEGIN
    diff     := diff + s78days_of_year (min_year);
    min_year := min_year + 1
    END;
(*ENDWHILE*) 
diff := diff + (max_day - min_day);
s78diff_year_day := diff
END;
 
(*------------------------------*) 
 
PROCEDURE
      s78year_month_day (VAR datbuf : tsp00_MoveObj;
            datpos    : tsp00_Int4;
            VAR year  : integer;
            VAR month : integer;
            VAR day   : integer;
            VAR e     : tsp6_date_error);
 
BEGIN
e := sp6de_ok;
sp78int_from_buf (datbuf, datpos + 1, 4, year, sp6de_invalid_date, e);
IF  e = sp6de_ok
THEN
    sp78int_from_buf (datbuf, datpos + 5, 2, month, sp6de_invalid_date, e);
(*ENDIF*) 
IF  e = sp6de_ok
THEN
    sp78int_from_buf (datbuf, datpos + 7, 2, day, sp6de_invalid_date, e);
(*ENDIF*) 
IF  e = sp6de_ok
THEN
    BEGIN
    IF  (month < 1) OR (month > 12)
    THEN
        e := sp6de_invalid_date
    ELSE
        IF  (day < 1) OR (day > s78days_of_month (year, month))
        THEN
            e := sp6de_invalid_date
        (*ENDIF*) 
    (*ENDIF*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      s78days_of_year (year : integer) : integer;
 
VAR
      days : integer;
 
BEGIN
IF  s78is_leap_year (year)
THEN
    days := 366
ELSE
    days := 365;
(*ENDIF*) 
s78days_of_year := days
END;
 
(*------------------------------*) 
 
FUNCTION
      s78day_sec (VAR datbuf : tsp00_MoveObj;
            datpos : tsp00_Int4;
            VAR e  : tsp6_date_error) : integer;
 
VAR
      day_sec : integer;
      hour    : integer;
      minute  : integer;
      sec     : integer;
 
LABEL
      999;
 
BEGIN
e       := sp6de_ok;
day_sec := 0;
sp78int_from_buf (datbuf, datpos + 9, 2,
      hour, sp6de_invalid_date, e);
IF  e <> sp6de_ok
THEN
    goto 999;
(*ENDIF*) 
sp78int_from_buf (datbuf, datpos + 11, 2,
      minute, sp6de_invalid_date, e);
IF  e <> sp6de_ok
THEN
    goto 999;
(*ENDIF*) 
sp78int_from_buf (datbuf, datpos + 13, 2,
      sec, sp6de_invalid_date, e);
IF  (hour < 0) OR (hour > 23)
THEN
    BEGIN
    e := sp6de_invalid_date;
    goto 999;
    END
ELSE
    IF  (minute < 0) OR (minute > 59)
    THEN
        BEGIN
        e := sp6de_invalid_date;
        goto 999;
        END
    ELSE
        IF  (sec < 0) OR (sec > 59)
        THEN
            BEGIN
            e := sp6de_invalid_date;
            goto 999;
            END;
        (*ENDIF*) 
    (*ENDIF*) 
(*ENDIF*) 
day_sec := hour * 3600 + minute * 60 + sec;
999:;
s78day_sec := day_sec;
END;
 
(*------------------------------*) 
 
PROCEDURE
      s78val_from_buf (VAR buf : tsp00_MoveObj;
            pos           : tsp00_Int4;
            VAR year_hour : integer;
            VAR month_min : integer;
            VAR day_sec   : integer;
            ret_error     : tsp6_date_error;
            VAR e         : tsp6_date_error);
 
BEGIN
sp78int_from_buf (buf, pos    , 4, year_hour, ret_error, e);
sp78int_from_buf (buf, pos + 4, 2, month_min, ret_error, e);
sp78int_from_buf (buf, pos + 6, 2, day_sec,   ret_error, e);
END;
 
(*------------------------------*) 
 
PROCEDURE
      s78val_to_buf (VAR buf : tsp00_MoveObj;
            pos       : tsp00_Int4;
            year_hour : integer;
            month_min : integer;
            day_sec   : integer);
 
BEGIN
buf[ pos ] := csp_ascii_blank;
sp78int_to_buf (buf, pos + 1, 4, year_hour);
sp78int_to_buf (buf, pos + 5, 2, month_min);
sp78int_to_buf (buf, pos + 7, 2, day_sec  )
END;
 
(*------------------------------*) 
 
PROCEDURE
      s78time_from_buf (VAR buf : tsp00_MoveObj;
            timepos  : tsp00_Int4;
            timelen  : integer;
            VAR hour : integer;
            VAR min  : integer;
            VAR sec  : integer;
            VAR e    : tsp6_date_error);
 
VAR
      intlen : integer;
 
BEGIN
e    := sp6de_ok;
hour := 0;
min  := 0;
sec  := 0;
(* timelen - defined byte *)
IF  timelen - 1 > mxsp_time
THEN
    e := sp6de_invalid_time
ELSE
    IF  timelen > 5
    THEN
        sp78int_from_buf (buf, timepos + 1, timelen - 5, hour,
              sp6de_invalid_time, e);
    (*ENDIF*) 
(*ENDIF*) 
IF  (e = sp6de_ok) AND (timelen > 3)
THEN
    BEGIN
    IF  timelen = 4
    THEN
        intlen := 1
    ELSE
        intlen := 2;
    (*ENDIF*) 
    sp78int_from_buf (buf, timepos + timelen - 2 - intlen, intlen, min,
          sp6de_invalid_time, e)
    END;
(*ENDIF*) 
IF  e = sp6de_ok
THEN
    BEGIN
    IF  timelen = 2
    THEN
        intlen := 1
    ELSE
        intlen := 2;
    (*ENDIF*) 
    sp78int_from_buf (buf, timepos + timelen - intlen, intlen, sec,
          sp6de_invalid_time, e)
    END;
(*ENDIF*) 
IF  e = sp6de_ok
THEN
    BEGIN
    IF  (min > 59) OR (sec > 59)
    THEN
        e := sp6de_invalid_time
    (*ENDIF*) 
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp78str_into_int (VAR operand : tsp00_MoveObj;
            VAR op_pos : integer;
            op_len     : integer;
            num_len    : integer;
            VAR result : integer;
            VAR e      : tsp6_date_error);
 
VAR
      digit_found : boolean;
 
BEGIN
e      := sp6de_no_number;
result := 0;
IF  op_len >  op_pos + num_len - 1
THEN
    op_len := op_pos + num_len - 1;
(*ENDIF*) 
digit_found := true;
WHILE (op_pos <= op_len) AND digit_found DO
    BEGIN
    IF  operand [op_pos] in  ['0' .. '9']
    THEN
        BEGIN
        e      := sp6de_ok;
        result := 10*result + ord (operand [op_pos]) - ord ('0');
        op_pos := succ (op_pos)
        END
    ELSE
        digit_found := false
    (*ENDIF*) 
    END
(*ENDWHILE*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp78intlj_into_str (source_num : tsp00_Int4;
            zero_fill    : boolean;
            with_comma   : boolean;
            fill_len     : tsp00_Int2;
            dest_size    : integer;
            dest_addr    : tsp00_MoveObjPtr;
            VAR dest_pos : integer;
            dest_len     : integer);
 
VAR
      temp           : tsp00_Buf;
      i              : integer;
      stop_when_zero : boolean;
 
BEGIN (* This is a modified version of i35intlj_into_str. *)
IF  NOT zero_fill
THEN
    fill_len := 10;
(*ENDIF*) 
i := fill_len;
stop_when_zero := (NOT zero_fill) OR with_comma;
REPEAT
    temp [i]  := chr (ord ('0') + source_num MOD 10);
    i          := pred (i);
    source_num := source_num DIV 10;
UNTIL
    ((source_num = 0) AND stop_when_zero) OR (i = 0);
(*ENDREPEAT*) 
IF  with_comma AND (i > 0)
THEN
    BEGIN
    temp [i  ] := temp [i+1];
    temp [i+1] := ',';
    i := pred (i)
    END;
(*ENDIF*) 
sp78append_to_workbuf (@temp, i+1,
      dest_size, dest_addr, dest_pos, dest_len, fill_len-i);
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp78append_to_workbuf (operand_addr : tsp00_MoveObjPtr;
            src_pos      : integer;
            dest_size    : integer;
            dest_addr    : tsp00_MoveObjPtr;
            VAR dest_pos : integer;
            dest_len     : integer;
            len          : integer);
 
BEGIN
IF  (len > dest_len - dest_pos)
THEN
    len := dest_len - dest_pos;
(*ENDIF*) 
IF  len > 0
THEN
    BEGIN
    s10mv (sizeof (operand_addr^), dest_size,
          @operand_addr^, src_pos,
          @dest_addr^, dest_pos, len);
    dest_pos := dest_pos + len
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      s78ints_from_buf (VAR buf : tsp00_MoveObj;
            pos           : tsp00_Int4;
            VAR timestamp : tsp6_timestamp_array;
            VAR e         : tsp6_date_error);
 
BEGIN
s78year_month_day (buf, pos-1,
      timestamp[ 1 ], timestamp[ 2 ], timestamp[ 3 ], e);
IF  e = sp6de_ok
THEN
    BEGIN
    sp78int_from_buf (buf, pos+8,  2,
          timestamp[ 4 ], sp6de_invalid_time, e);
    IF  e = sp6de_ok
    THEN
        BEGIN
        sp78int_from_buf (buf, pos+10, 2,
              timestamp[ 5 ], sp6de_invalid_time, e);
        IF  e = sp6de_ok
        THEN
            BEGIN
            sp78int_from_buf (buf, pos+12, 2,
                  timestamp[ 6 ], sp6de_invalid_time, e);
            IF  e = sp6de_ok
            THEN
                sp78int_from_buf (buf, pos+14, 6,
                      timestamp[ 7 ], sp6de_invalid_time, e);
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp78int_from_buf (VAR buf : tsp00_MoveObj;
            pos        : tsp00_Int4;
            len        : integer;
            VAR result : integer;
            ret_error  : tsp6_date_error;
            VAR e      : tsp6_date_error);
 
VAR
      i     : integer;
      fac   : integer;
      digit : integer;
 
BEGIN
e      := sp6de_ok;
fac    := 1;
result := 0;
i      := len;
WHILE (e = sp6de_ok) AND (i > 0) DO
    BEGIN
    digit := ord(buf[ pos+i-1 ]);
    IF  (digit >= ord(csp_ascii_zero)  ) AND
        (digit <= ord(csp_ascii_zero)+9)
    THEN
        result := result + (fac * (digit - ord(csp_ascii_zero)))
    ELSE
        e := ret_error;
    (*ENDIF*) 
    fac := fac * 10;
    i   := i - 1
    END
(*ENDWHILE*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      s78ints_to_buf (VAR buf : tsp00_MoveObj;
            pos           : tsp00_Int4;
            VAR timestamp : tsp6_timestamp_array);
 
BEGIN
sp78int_to_buf (buf, pos     , 4, timestamp[ 1 ]);
sp78int_to_buf (buf, pos +  4, 2, timestamp[ 2 ]);
sp78int_to_buf (buf, pos +  6, 2, timestamp[ 3 ]);
sp78int_to_buf (buf, pos +  8, 2, timestamp[ 4 ]);
sp78int_to_buf (buf, pos + 10, 2, timestamp[ 5 ]);
sp78int_to_buf (buf, pos + 12, 2, timestamp[ 6 ]);
sp78int_to_buf (buf, pos + 14, 6, timestamp[ 7 ])
END;
 
(*------------------------------*) 
 
PROCEDURE
      sp78int_to_buf (VAR buf : tsp00_MoveObj;
            pos : tsp00_Int4;
            len : integer;
            int : integer);
 
VAR
      i   : integer;
      rem : integer;
 
BEGIN
rem := int;
FOR i := len DOWNTO 1 DO
    BEGIN
    buf[ pos+i-1 ] := chr ((rem MOD 10) + ord(csp_ascii_zero));
    rem := rem DIV 10
    END
(*ENDFOR*) 
END;
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
.PA 
