$CODE_OFFSETS ON$                                                       00001000
$TABLES ON$                                                             00002000
$COPYRIGHT 'HEWLETT-PACKARD, CO.'$                                      00003000
$SEGMENT  'CONVERT7'$                                                   00004000
$STANDARD_LEVEL 'HP3000'$                                               00005000
PROGRAM isoutil (input, output);                                        00006000
                                                                        00007000
{---------------------------------------------------------}             00008000
{                                                         }             00009000
{                 File: S70S414A.HP32414.SUPPORT          }             00010000
{                                                         }             00011000
{  This program converts data in MPE text and data files  }             00012000
{  from an HP European 7-bit national substitution set    }             00013000
{  to the HP supported 8-bit character set for Europe,    }             00014000
{  ROMAN8.                                                }             00015000
{                                                         }             00016000
{---------------------------------------------------------}             00017000
                                                                        00018000
CONST maxrecsize = 8192;                                                00019000
TYPE isolang = (Compuspeak, SvenskSuomi, DanskNorsk, FrancaisM,         00020000
                Francais, Deutsch, UK, EspanolM, Espanol, Italiano );   00021000
     posint =   1..32767;                                               00022000
     smallint = -32768..32767;                                          00023000
     string6 = STRING[6];                                               00024000
     errorrec = RECORD                                                  00025000
                  error1 : smallint;                                    00026000
                  error2 : smallint;                                    00027000
                END;                                                    00028000
     charstring = PACKED ARRAY [1..maxrecsize] OF CHAR;                 00029000
     l_charstring = RECORD                                              00030000
                      chars : charstring;                               00031000
                    END;                                                00032000
     filetype = (dummyfile, textfile, datafile, testmode );             00033000
                                                                        00034000
CONST minlang = Compuspeak;                                             00035000
      maxlang = Italiano;                                               00036000
      minfile = dummyfile;                                              00037000
      maxfile = testmode;                                               00038000
      badlang = -1;                                                     00039000
      badchar = -2;                                                     00040000
      filerr  = -11;                                                    00041000
      CCG     = 0;                                                      00042000
      CCL     = 1;                                                      00043000
      CCE     = 2;                                                      00044000
      subsysno = 99;                                                    00045000
      no_response = '  ';                                               00046000
      maxfields = 256;                                                  00047000
      first_time = -1;                                                  00048000
                                                                        00049000
VAR                                                                     00050000
    filename : PACKED ARRAY [1..28] OF CHAR;                            00051000
    msgbuf : RECORD                                                     00052000
               chars : PACKED ARRAY [1..72] OF CHAR;                    00053000
             END;                                                       00054000
    lang : isolang;                                                     00055000
    ftype : filetype;                                                   00056000
    ctlytrap,                                                           00057000
    k,                                                                  00058000
    l,                                                                  00059000
    fields,                                                             00060000
    recsize,                                                            00061000
    strlength,                                                          00062000
    fold,                                                               00063000
    isolgth,                                                            00064000
    foptions,                                                           00065000
    fnew,                                                               00066000
    aoptions,                                                           00067000
    errorcode,                                                          00068000
    filecode,                                                           00069000
    blksize,                                                            00070000
    numextents,                                                         00071000
    userlabels                                                          00072000
        : smallint;                                                     00073000
    eof,                                                                00074000
    flimit, reccount, recpt : INTEGER;                                  00075000
    file_error, end_of_isofile, file_is_ksam : BOOLEAN;                 00076000
    isorecord : l_charstring;                                           00077000
    isodummy  : charstring;                                             00078000
    langchoice, ftypechoice : PACKED ARRAY [1..2] OF CHAR;              00079000
    errors : errorrec;                                                  00080000
    inbuf : STRING[80];                                                 00081000
    field_start, field_length : ARRAY [1..maxfields] OF smallint;       00082000
                                                                        00083000
  PROCEDURE fcheck;    INTRINSIC;                                       00084000
  FUNCTION fopen : smallint;  INTRINSIC;                                00085000
  PROCEDURE fgetinfo; INTRINSIC;                                        00086000
  PROCEDURE freadlabel;  INTRINSIC;                                     00087000
  PROCEDURE fwritelabel;  INTRINSIC;                                    00088000
  FUNCTION fread : smallint;  INTRINSIC;                                00089000
  FUNCTION freadc : smallint;  INTRINSIC;                               00090000
  PROCEDURE fpoint;  INTRINSIC;                                         00091000
  PROCEDURE fupdate; INTRINSIC;                                         00092000
  PROCEDURE fwrite; INTRINSIC;                                          00093000
  PROCEDURE fclose; INTRINSIC;                                          00094000
  PROCEDURE ferrmsg;  INTRINSIC;                                        00095000
  PROCEDURE setctlytrap ( VAR ctlyind : smallint );  EXTERNAL SPL;      00096000
$PAGE$                                                                  00097000
$SEGMENT  'NLS03'$                                                      00098000
PROCEDURE convert7to8 ( VAR instring : charstring;                      00099000
                       VAR outstring : charstring;                      00100000
                       stringlength : smallint;                         00101000
                       VAR error : errorrec;                            00102000
                       language: isolang );                             00103000
                                                                        00104000
LABEL 99;                                                               00105000
                                                                        00106000
VAR                                                                     00107000
  i        : posint;                                                    00108000
  j        : posint;                                                    00109000
                                                                        00110000
BEGIN                                                                   00111000
                                                                        00112000
  error.error1 := 0;                                                    00113000
  error.error2 := 0;                                                    00114000
                                                                        00115000
  IF language = Compuspeak THEN                                         00116000
  BEGIN                                                                 00117000
    FOR i := 1 TO stringlength DO                                       00118000
      outstring[i] := instring[i];                                      00119000
    GOTO 99;                                                            00120000
  END;                                                                  00121000
                                                                        00122000
  IF (language < minlang) OR (language > maxlang) THEN                  00123000
  BEGIN                                                                 00124000
    error.error1 := badlang;                                            00125000
    error.error2 := subsysno;                                           00126000
    GOTO 99;                                                            00127000
  END;                                                                  00128000
                                                                        00129000
  FOR i := 1 TO stringlength DO                                         00130000
    IF ord ( instring [i] ) > 127  THEN                                 00131000
    BEGIN     { extended character found in input string }              00132000
      error.error1 := badchar;                                          00133000
      error.error2 := subsysno;                                         00134000
      GOTO 99;                                                          00135000
    END;                                                                00136000
                                                                        00137000
                                                                        00138000
  i := 1;                                                               00139000
  j := 1;                                                               00140000
                                                                        00141000
  WHILE (i <= stringlength) DO                                          00142000
  BEGIN                                                                 00143000
    { Translate one byte }                                              00144000
    CASE language OF                                                    00145000
                                                                        00146000
$PAGE$                                                                  00147000
    SvenskSuomi:                                                        00148000
      BEGIN                                                             00149000
        CASE instring[i] OF                                             00150000
        '@':                                                            00151000
          outstring[j] := 'É';                                          00152000
        '[':                                                            00153000
          outstring[j] := 'Ä';                                          00154000
        '\':                                                            00155000
          outstring[j] := 'Ö';                                          00156000
        ']':                                                            00157000
          outstring[j] := 'Å';                                          00158000
        '^':                                                            00159000
          outstring[j] := 'Ü';                                          00160000
        '`':                                                            00161000
          outstring[j] := 'é';                                          00162000
        '{':                                                            00163000
          outstring[j] := 'ä';                                          00164000
        '|':                                                            00165000
          outstring[j] := 'ö';                                          00166000
        '}':                                                            00167000
          outstring[j] := 'å';                                          00168000
        '~':                                                            00169000
          outstring[j] := 'ü';                                          00170000
        OTHERWISE                                                       00171000
          outstring[j] := instring[i];                                  00172000
        END;                                                            00173000
      END;                                                              00174000
$PAGE$                                                                  00175000
    DanskNorsk:                                                         00176000
      BEGIN                                                             00177000
        CASE instring[i] OF                                             00178000
        '[':                                                            00179000
          outstring[j] := 'Æ';                                          00180000
        '\':                                                            00181000
          outstring[j] := 'Ø';                                          00182000
        ']':                                                            00183000
          outstring[j] := 'Å';                                          00184000
        '{':                                                            00185000
          outstring[j] := 'æ';                                          00186000
        '|':                                                            00187000
          outstring[j] := 'ø';                                          00188000
        '}':                                                            00189000
          outstring[j] := 'å';                                          00190000
        OTHERWISE                                                       00191000
          outstring[j] := instring[i];                                  00192000
        END;                                                            00193000
      END;                                                              00194000
$PAGE$                                                                  00195000
    FrancaisM:                                                          00196000
      BEGIN                                                             00197000
        CASE instring[i] OF                                             00198000
        '#':                                                            00199000
          outstring[j] := '£';                                          00200000
        '@':                                                            00201000
          outstring[j] := 'à';                                          00202000
        '[':                                                            00203000
          outstring[j] := '°';                                          00204000
        '\':                                                            00205000
          outstring[j] := 'ç';                                          00206000
        ']':                                                            00207000
          outstring[j] := '§';                                          00208000
        '^':                                                            00209000
          IF i < stringlength THEN                                      00210000
          BEGIN                                                         00211000
            i := i + 1;                                                 00212000
            CASE instring[i] OF                                         00213000
              'a': outstring[j] := 'â';                                 00214000
              'e': outstring[j] := 'ê';                                 00215000
              'i': outstring[j] := 'î';                                 00216000
              'o': outstring[j] := 'ô';                                 00217000
              'u': outstring[j] := 'û';                                 00218000
            OTHERWISE                                                   00219000
              i := i - 1;                                               00220000
              outstring[j] := '^';                                      00221000
            END;                                                        00222000
          END                                                           00223000
          ELSE                                                          00224000
            outstring[j] := '^';                                        00225000
        '{':                                                            00226000
          outstring[j] := 'é';                                          00227000
        '|':                                                            00228000
          outstring[j] := 'ù';                                          00229000
        '}':                                                            00230000
          outstring[j] := 'è';                                          00231000
        '~':                                                            00232000
          IF i < stringlength THEN                                      00233000
          BEGIN                                                         00234000
            i := i + 1;                                                 00235000
            CASE instring[i] OF                                         00236000
              'a': outstring[j] := 'ä';                                 00237000
              'e': outstring[j] := 'ë';                                 00238000
              'i': outstring[j] := 'ï';                                 00239000
              'o': outstring[j] := 'ö';                                 00240000
              'u': outstring[j] := 'ü';                                 00241000
              'A': outstring[j] := 'Ä';                                 00242000
              'O': outstring[j] := 'Ö';                                 00243000
              'U': outstring[j] := 'Ü';                                 00244000
            OTHERWISE                                                   00245000
              i := i - 1;                                               00246000
              outstring[j] := '¨';                                      00247000
            END;                                                        00248000
          END                                                           00249000
          ELSE                                                          00250000
            outstring[j] := '¨';                                        00251000
        OTHERWISE                                                       00252000
          outstring[j] := instring[i];                                  00253000
        END;                                                            00254000
      END;                                                              00255000
$PAGE$                                                                  00256000
    Francais:                                                           00257000
      BEGIN                                                             00258000
        CASE instring[i] OF                                             00259000
        '#':                                                            00260000
          outstring[j] := '£';                                          00261000
        '@':                                                            00262000
          outstring[j] := 'à';                                          00263000
        '[':                                                            00264000
          outstring[j] := '°';                                          00265000
        '\':                                                            00266000
          outstring[j] := 'ç';                                          00267000
        ']':                                                            00268000
          outstring[j] := '§';                                          00269000
        '^':                                                            00270000
          outstring[j] := '^';                                          00271000
        '{':                                                            00272000
          outstring[j] := 'é';                                          00273000
        '|':                                                            00274000
          outstring[j] := 'ù';                                          00275000
        '}':                                                            00276000
          outstring[j] := 'è';                                          00277000
        '~':                                                            00278000
          outstring[j] := '¨';                                          00279000
        OTHERWISE                                                       00280000
          outstring[j] := instring[i];                                  00281000
        END;                                                            00282000
      END;                                                              00283000
$PAGE$                                                                  00284000
    Deutsch:                                                            00285000
      BEGIN                                                             00286000
        CASE instring[i] OF                                             00287000
        '#':                                                            00288000
          outstring[j] := '£';                                          00289000
        '@':                                                            00290000
          outstring[j] := '§';                                          00291000
        '[':                                                            00292000
          outstring[j] := 'Ä';                                          00293000
        '\':                                                            00294000
          outstring[j] := 'Ö';                                          00295000
        ']':                                                            00296000
          outstring[j] := 'Ü';                                          00297000
        '{':                                                            00298000
          outstring[j] := 'ä';                                          00299000
        '|':                                                            00300000
          outstring[j] := 'ö';                                          00301000
        '}':                                                            00302000
          outstring[j] := 'ü';                                          00303000
        '~':                                                            00304000
          outstring[j] := 'ß';                                          00305000
        OTHERWISE                                                       00306000
          outstring[j] := instring[i];                                  00307000
        END;                                                            00308000
      END;                                                              00309000
$PAGE$                                                                  00310000
    UK:                                                                 00311000
      BEGIN                                                             00312000
        CASE instring[i] OF                                             00313000
        '#':                                                            00314000
          outstring[j] := '£';                                          00315000
        OTHERWISE                                                       00316000
          outstring[j] := instring[i];                                  00317000
        END;                                                            00318000
      END;                                                              00319000
$PAGE$                                                                  00320000
    EspanolM:                                                           00321000
      BEGIN                                                             00322000
        CASE instring[i] OF                                             00323000
        '''':                                                           00324000
          IF i < stringlength THEN                                      00325000
          BEGIN                                                         00326000
            i := i + 1;                                                 00327000
            CASE instring[i] OF                                         00328000
              'a': outstring[j] := 'á';                                 00329000
              'e': outstring[j] := 'é';                                 00330000
              'i': outstring[j] := 'í';                                 00331000
              'o': outstring[j] := 'ó';                                 00332000
              'u': outstring[j] := 'ú';                                 00333000
            OTHERWISE                                                   00334000
              i := i - 1;                                               00335000
              outstring[j] := '´';                                      00336000
            END;                                                        00337000
          END                                                           00338000
          ELSE                                                          00339000
            outstring[j] := '´';                                        00340000
        '[':                                                            00341000
          outstring[j] := '¡';                                          00342000
        '\':                                                            00343000
          outstring[j] := 'Ñ';                                          00344000
        ']':                                                            00345000
          outstring[j] := '¿';                                          00346000
        '^':                                                            00347000
          outstring[j] := '°';                                          00348000
        '|':                                                            00349000
          outstring[j] := 'ñ';                                          00350000
        OTHERWISE                                                       00351000
          outstring[j] := instring[i];                                  00352000
        END;                                                            00353000
      END;                                                              00354000
$PAGE$                                                                  00355000
    Espanol:                                                            00356000
      BEGIN                                                             00357000
        CASE instring[i] OF                                             00358000
        '[':                                                            00359000
          outstring[j] := '¡';                                          00360000
        '\':                                                            00361000
          outstring[j] := 'Ñ';                                          00362000
        ']':                                                            00363000
          outstring[j] := '¿';                                          00364000
        '^':                                                            00365000
          outstring[j] := '°';                                          00366000
        '|':                                                            00367000
          outstring[j] := 'ñ';                                          00368000
        OTHERWISE                                                       00369000
          outstring[j] := instring[i];                                  00370000
        END;                                                            00371000
      END;                                                              00372000
$PAGE$                                                                  00373000
    Italiano:                                                           00374000
      BEGIN                                                             00375000
        CASE instring[i] OF                                             00376000
        '#':                                                            00377000
          outstring[j] := '£';                                          00378000
        '[':                                                            00379000
          outstring[j] := '°';                                          00380000
        '\':                                                            00381000
          outstring[j] := 'ç';                                          00382000
        ']':                                                            00383000
          outstring[j] := 'é';                                          00384000
        '`':                                                            00385000
          outstring[j] := 'ù';                                          00386000
        '{':                                                            00387000
          outstring[j] := 'à';                                          00388000
        '|':                                                            00389000
          outstring[j] := 'ò';                                          00390000
        '}':                                                            00391000
          outstring[j] := 'è';                                          00392000
        '~':                                                            00393000
          outstring[j] := 'ì';                                          00394000
        OTHERWISE                                                       00395000
          outstring[j] := instring[i];                                  00396000
        END;                                                            00397000
      END;                                                              00398000
$PAGE$                                                                  00399000
  END;         { CASE statement }                                       00400000
                                                                        00401000
  i := i + 1;                                                           00402000
  j := j + 1;                                                           00403000
                                                                        00404000
  END;         { WHILE i <= stringlength }                              00405000
                                                                        00406000
  IF j <= stringlength THEN                                             00407000
  BEGIN  { mute(s) caused shifting; blank fill }                        00408000
    FOR j := j TO stringlength DO                                       00409000
      outstring[j] := ' ';                                              00410000
  END;                                                                  00411000
                                                                        00412000
99:                                                                     00413000
                                                                        00414000
END;           { PROCEDURE convert7to8 }                                00415000
                                                                        00416000
$PAGE$                                                                  00417000
$SEGMENT  'CONVERT7'$                                                   00418000
PROCEDURE display_languages;                                            00419000
BEGIN                                                                   00420000
  WRITELN;                                                              00421000
  WRITELN ( 'HP European 7-Bit character sets are:' );                  00422000
  WRITELN;                                                              00423000
  WRITELN ( ' 1. SVENSK/SUOMI' );                                       00424000
  WRITELN ( ' 2. DANSK/NORSK' );                                        00425000
  WRITELN ( ' 3. FRANCAIS M' );                                         00426000
  WRITELN ( ' 4. FRANCAIS' );                                           00427000
  WRITELN ( ' 5. DEUTSCH' );                                            00428000
  WRITELN ( ' 6. U K' );                                                00429000
  WRITELN ( ' 7. ESPANOL M' );                                          00430000
  WRITELN ( ' 8. ESPANOL' );                                            00431000
  WRITELN ( ' 9. ITALIANO' );                                           00432000
  WRITELN;                                                              00433000
  PROMPT ( 'From which character set should conversion be done: ' );    00434000
END;                                                                    00435000
$PAGE$                                                                  00436000
PROCEDURE display_french_warn;                                          00437000
BEGIN                                                                   00438000
  WRITELN;                                                              00439000
  WRITELN ('WARNING: Conversion will be done from a character ',        00440000
           'set with mute characters-' );                               00441000
  WRITELN ('     circumflex (94) followed by a,e,i,o,u will be ',       00442000
           'converted to the' );                                        00443000
  WRITELN ('                    corresponding ROMAN8 vowel ',           00444000
           'with circumflex above it;' );                               00445000
  WRITELN ('     diaresis (126) followed by a,e,i,o,u,A,O,U ',          00446000
           'will be converted to' );                                    00447000
  WRITELN ('                    the corresponding ROMAN8 vowel ',       00448000
           'with diaresis above it;' );                                 00449000
  WRITELN ('       in other words, two characters are converted ',      00450000
           'to one.' );                                                 00451000
  WRITELN ('     Circumflex (94) followed by any other character',      00452000
           ' will be converted to' );                                   00453000
  WRITELN ('                    to the ROMAN8 circumflex accent',       00454000
           ' (170).' );                                                 00455000
  WRITELN ('     Diaresis (126) followed by any other character ',      00456000
           'will be converted' );                                       00457000
  WRITELN ('                    to the ROMAN8 diaresis character',      00458000
           ' (171).' );                                                 00459000
END;                                                                    00460000
$PAGE$                                                                  00461000
PROCEDURE display_spanish_warn;                                         00462000
BEGIN                                                                   00463000
  WRITELN;                                                              00464000
  WRITELN ('WARNING: Conversion will be done from a character ',        00465000
           'set with a mute character-' );                              00466000
  WRITELN ('     apostrophe (39) followed by a,e,i,o,u will be ',       00467000
           'converted to the' );                                        00468000
  WRITELN ('                    corresponding ROMAN8 vowel ',           00469000
           'with an acute accent above it;' );                          00470000
  WRITELN ('       in other words, two characters are converted ',      00471000
           'to one.' );                                                 00472000
  WRITELN ('     Apostrophe (39) followed by any other character ',     00473000
           'will be converted' );                                       00474000
  WRITELN ('                    to the ROMAN8 acute accent',            00475000
           ' (168).' );                                                 00476000
END;                                                                    00477000
$PAGE$                                                                  00478000
PROCEDURE display_file_types;                                           00479000
BEGIN                                                                   00480000
  WRITELN;                                                              00481000
  WRITELN ( 'File types which can be converted are:' );                 00482000
  WRITELN;                                                              00483000
  WRITELN (' 1. MPE text files (each record converted as one field)');  00484000
  IF (lang = FrancaisM) OR (lang = EspanolM) THEN                       00485000
  WRITELN ('       WARNING: mutes cause all data to shift to the ',     00486000
           'left' );                                                    00487000
  WRITELN (' 2. MPE data files (fields must be',                        00488000
           ' defined; only defined fields are converted)' );            00489000
  IF (lang = FrancaisM) OR (lang = EspanolM) THEN                       00490000
  WRITELN ('       WARNING: mutes cause data within a field to ',       00491000
           'shift to the left' );                                       00492000
  WRITELN (' 3. Test Conversion' );                                     00493000
  WRITELN;                                                              00494000
  PROMPT ('Type of file to be converted: ');                            00495000
END;                                                                    00496000
$PAGE$                                                                  00497000
FUNCTION ksam ( foption : smallint ) : BOOLEAN;                         00498000
  CONST ksam_bit_factor = 2048;                                         00499000
BEGIN                                                                   00500000
  ksam := ( (foption DIV ksam_bit_factor) MOD 2 = 1 );                  00501000
END;                                                                    00502000
$PAGE$                                                                  00503000
FUNCTION str_octal ( nbr : smallint ) : string6;                        00504000
                                                                        00505000
  TYPE oct_powers = ARRAY [0..4] OF smallint;                           00506000
  CONST oct_values = oct_powers  [1,8,64,512,4096];                     00507000
  VAR res : STRING[6];                                                  00508000
      dig, ind, cnt : smallint;                                         00509000
                                                                        00510000
BEGIN                                                                   00511000
                                                                        00512000
  res := '0';                                                           00513000
  ind := 2;                                                             00514000
  FOR cnt := 4 DOWNTO 0 DO                                              00515000
  BEGIN                                                                 00516000
    dig := nbr DIV oct_values[cnt];                                     00517000
    STRWRITE ( res, ind, ind, dig:1 );                                  00518000
    nbr := nbr - dig * oct_values[cnt];                                 00519000
  END;                                                                  00520000
  str_octal := res;                                                     00521000
END;                                                                    00522000
$PAGE$                                                                  00523000
PROCEDURE open_isofile;                                                 00524000
  VAR i : smallint;                                                     00525000
BEGIN                                                                   00526000
  foptions := 1;    { old system file }                                 00527000
  aoptions := 5;    { update }                                          00528000
  fold := fopen ( filename                                              00529000
                 ,foptions                                              00530000
                 ,aoptions                                              00531000
                );                                                      00532000
   IF ccode <> CCE THEN                                                 00533000
   BEGIN                                                                00534000
    fcheck ( 0, errorcode );                                            00535000
    WRITELN ( '** ERROR: FILE OPEN ERROR ', errorcode:1 );              00536000
    ferrmsg ( errorcode, msgbuf, l );                                   00537000
    WRITELN ( '      ', msgbuf.chars:l );                               00538000
    file_error := TRUE;                                                 00539000
  END                                                                   00540000
  ELSE                                                                  00541000
  BEGIN                                                                 00542000
    fgetinfo ( fold,filename,foptions,,recsize,,,,filecode,,eof,        00543000
               flimit,,,blksize,,numextents,userlabels );               00544000
    IF ccode <> CCE THEN                                                00545000
    BEGIN                                                               00546000
      fcheck ( fold, errorcode );                                       00547000
      WRITELN ( '** ERROR: ', errorcode, ' OBTAINING RECORD SIZE' );    00548000
      file_error := TRUE;                                               00549000
    END                                                                 00550000
    ELSE                                                                00551000
    BEGIN                                                               00552000
      IF recsize > 0 THEN                                               00553000
      BEGIN                                                             00554000
        recsize := - recsize * 2;                                       00555000
        blksize := - blksize * 2;                                       00556000
      END;                                                              00557000
      IF recsize < -maxrecsize THEN                                     00558000
      BEGIN                                                             00559000
      WRITELN ( '** ERROR: RECORD SIZE > ', -maxrecsize:3, ' BYTES' );  00560000
        file_error := TRUE;                                             00561000
      END                                                               00562000
      ELSE                                                              00563000
      BEGIN                                                             00564000
        file_error := FALSE;                                            00565000
        end_of_isofile := FALSE;                                        00566000
        file_is_ksam := KSAM ( foptions );                              00567000
        recpt := first_time;                                            00568000
        reccount := 0;                                                  00569000
{       WRITELN ('         ----------------------------------------',   00570000
                 '--------' );                                          00571000
        WRITELN ('         -- File info for ', filename,                00572000
                 ' --' );                                               00573000
        WRITELN ('         --foptions=     ', str_octal(foptions),      00574000
                  '  filecode=', filecode, ' --' );                     00575000
        WRITELN ('         --recsize=', -recsize,'B  blksize=',         00576000
                 -blksize, 'B--' );                                     00577000
        WRITELN ('         --flimit=',flimit,'        eof=',eof,        00578000
                 ' --' );                                               00579000
        WRITELN ('         --           numextents = ', numextents,     00580000
                 '        --' );                                        00581000
        WRITELN ('         ----------------------------------------',   00582000
                 '--------' );                                          00583000
}                                                                       00584000
        WRITELN ('  File ', filename, ' contains ', eof:1,              00585000
                 ' records.' );                                         00586000
      END;                                                              00587000
    END;                                                                00588000
  END;                                                                  00589000
END;                                                                    00590000
$PAGE$                                                                  00591000
PROCEDURE open_newfile;                                                 00592000
  LABEL 18;                                                             00593000
  VAR i : smallint;                                                     00594000
  FUNCTION fopen : smallint;  INTRINSIC;                                00595000
BEGIN                                                                   00596000
  IF (recsize = 0) OR (eof = 0)THEN                                     00597000
  BEGIN                                                                 00598000
    WRITELN ( '** ERROR: NOTHING TO CONVERT' );                         00599000
    file_error := TRUE;                                                 00600000
    GOTO 18;                                                            00601000
  END;                                                                  00602000
  IF file_is_ksam THEN                                                  00603000
  BEGIN                                                                 00604000
    fnew := fold;                                                       00605000
    WRITELN;                                                            00606000
    WRITELN ( '  File is KSAM; updating in place' );                    00607000
  END                                                                   00608000
  ELSE                                                                  00609000
  BEGIN                                                                 00610000
    foptions := ( foptions DIV 4 ) * 4; { 0 bits 14,15: new file }      00611000
    aoptions := 1;     { write only }                                   00612000
    fnew := fopen ( filename, foptions, aoptions, recsize,,,            00613000
                    userlabels, blksize DIV recsize,,flimit,            00614000
                    numextents,,filecode );                             00615000
    IF ccode <> CCE THEN                                                00616000
    BEGIN                                                               00617000
      fcheck ( 0, errorcode );                                          00618000
      WRITELN ( '** ERROR: ', errorcode, ' OPENING NEW FILE' );         00619000
      ferrmsg ( errorcode, msgbuf, l );                                 00620000
      WRITELN ( '       ', msgbuf.chars:l );                            00621000
      file_error := TRUE;                                               00622000
      GOTO 18;                                                          00623000
    END;                                                                00624000
    fgetinfo ( fnew,,,aoptions );                                       00625000
    IF (ccode <> CCE) OR (aoptions <> 1) THEN                           00626000
    BEGIN                                                               00627000
      WRITELN ( '** ERROR: File cannot be opened for write access' );   00628000
      file_error := TRUE;                                               00629000
      GOTO 18;                                                          00630000
    END;                                                                00631000
    { copy user labels }                                                00632000
    IF (userlabels > 0) AND NOT file_error THEN                         00633000
    BEGIN                                                               00634000
      WRITELN;                                                          00635000
      WRITELN ( '++ File contains ', userlabels:1, ' user labels.' );   00636000
      WRITELN ( '++ Copying user labels unchanged.' );                  00637000
      FOR i := 0 to userlabels - 1 DO                                   00638000
      BEGIN                                                             00639000
        freadlabel ( fold, isorecord, 128, i );                         00640000
        fwritelabel ( fnew, isorecord, 128, i );                        00641000
      END;                                                              00642000
    END;                                                                00643000
  END;                                                                  00644000
                                                                        00645000
18:                                                                     00646000
                                                                        00647000
END;                                                                    00648000
$PAGE$                                                                  00649000
PROCEDURE read_isofile;                                                 00650000
BEGIN                                                                   00651000
  IF ctlytrap <> 0 THEN                                                 00652000
  BEGIN                                                                 00653000
    WRITELN ( reccount, ' records converted so far ...' );              00654000
    ctlytrap := 0;                                                      00655000
  END;                                                                  00656000
  IF file_is_ksam THEN                                                  00657000
  BEGIN                                                                 00658000
    strlength := freadc ( fold, isorecord, recsize );                   00659000
    IF recpt <> first_time THEN                                         00660000
      strlength := freadc ( fold, isorecord, recsize );                 00661000
    fgetinfo ( fold,,,,,,,,,recpt );                                    00662000
    fpoint ( fold, recpt );                                             00663000
  END                                                                   00664000
  ELSE                                                                  00665000
    strlength := fread ( fold, isorecord, recsize );                    00666000
  CASE ccode OF                                                         00667000
    CCE:  { do nothing } ;                                              00668000
    CCG:  end_of_isofile := TRUE;                                       00669000
    CCL:  BEGIN                                                         00670000
            fcheck ( fold, errorcode );                                 00671000
            WRITELN ( '** ERROR: READ FAILURE ', errorcode );           00672000
            file_error := TRUE;                                         00673000
            strlength := 0;                                             00674000
          END;                                                          00675000
  END;                                                                  00676000
END;                                                                    00677000
$PAGE$                                                                  00678000
PROCEDURE write_isofile;                                                00679000
BEGIN                                                                   00680000
  IF file_is_ksam THEN                                                  00681000
  BEGIN                                                                 00682000
    fupdate ( fold, isorecord, -strlength );                            00683000
    IF ccode <> CCE THEN                                                00684000
    BEGIN                                                               00685000
      fcheck ( fold, errorcode );                                       00686000
      WRITELN ( '** ERROR: UPDATE FAILURE ', errorcode );               00687000
      file_error := TRUE;                                               00688000
    END;                                                                00689000
    fpoint ( fold, recpt );                                             00690000
  END                                                                   00691000
  ELSE                                                                  00692000
  BEGIN                                                                 00693000
    fwrite ( fnew, isorecord, -strlength, 0 );                          00694000
    IF ccode <> CCE THEN                                                00695000
    BEGIN                                                               00696000
      fcheck ( fnew, errorcode );                                       00697000
      WRITELN ( '** ERROR: WRITE FAILURE ', errorcode );                00698000
      file_error := TRUE;                                               00699000
    END;                                                                00700000
  END;                                                                  00701000
END;                                                                    00702000
$PAGE$                                                                  00703000
PROCEDURE close_isofile;                                                00704000
BEGIN                                                                   00705000
  IF file_is_ksam THEN                                                  00706000
  BEGIN                                                                 00707000
    fclose ( fold, 0, 0 );                                              00708000
    IF ccode <> CCE THEN                                                00709000
    BEGIN                                                               00710000
      fcheck ( fold, errorcode );                                       00711000
      WRITELN ( '** ERROR: ', errorcode, ' CLOSING KSAM FILE' );        00712000
    END;                                                                00713000
  END                                                                   00714000
  ELSE                                                                  00715000
  BEGIN                                                                 00716000
    fclose ( fold, 4, 0 );       { delete old file }                    00717000
    IF ccode <> CCE THEN                                                00718000
    BEGIN                                                               00719000
      fcheck ( fold, errorcode );                                       00720000
      WRITELN ( '** ERROR: ', errorcode, ' CLOSING OLD FILE' );         00721000
    END;                                                                00722000
    fclose ( fnew, 1, 0 );       { make new file permanent }            00723000
    IF ccode <> CCE THEN                                                00724000
    BEGIN                                                               00725000
      fcheck ( fnew, errorcode );                                       00726000
      WRITELN ( '** ERROR: ', errorcode, ' CLOSING NEW FILE' );         00727000
    END;                                                                00728000
  END;                                                                  00729000
END;                                                                    00730000
$PAGE$                                                                  00731000
FUNCTION get_integer ( VAR buffer : STRING; VAR nbr : smallint ) :      00732000
                   BOOLEAN;                                             00733000
  LABEL 16;                                                             00734000
  CONST numeric = ['0'..'9'];                                           00735000
        default = 0;                                                    00736000
  VAR i,t : smallint;                                                   00737000
                                                                        00738000
BEGIN                                                                   00739000
  get_integer := TRUE;                                                  00740000
  buffer := strltrim ( buffer );                                        00741000
  IF strlen ( buffer ) = 0 THEN                                         00742000
  BEGIN                                                                 00743000
    nbr := default;                                                     00744000
    GOTO 16;                                                            00745000
  END;                                                                  00746000
  IF strlen ( buffer ) < 80 THEN                                        00747000
    strappend ( buffer, ' ' );    { append terminator }                 00748000
  i := 1;                                                               00749000
  WHILE (buffer[i] IN numeric) AND (i < 5) DO                           00750000
    i := i + 1;                                                         00751000
  IF  (buffer[i] = ' ') OR (buffer[i] = ',')  { valid separators }      00752000
  THEN                                                                  00753000
  BEGIN                                                                 00754000
    strread ( buffer, 1, t, nbr );                                      00755000
    strdelete ( buffer, 1, t );                                         00756000
  END                                                                   00757000
  ELSE                                                                  00758000
  BEGIN                                                                 00759000
    WRITELN ( 'invalid positive integer' );                             00760000
    get_integer := FALSE;                                               00761000
  END;                                                                  00762000
                                                                        00763000
16:                                                                     00764000
                                                                        00765000
END;                                                                    00766000
$PAGE$                                                                  00767000
PROCEDURE fatal_error;                                                  00768000
BEGIN                                                                   00769000
  WRITE ( '** FATAL ERROR: ' );                                         00770000
  CASE errors.error1 OF                                                 00771000
    badlang: WRITELN ( '(INTERNAL) Bad Language to convert7to8' );      00772000
    badchar: WRITELN ( '8 Bit data encountered' );                      00773000
    filerr:  WRITELN ( 'File System' );                                 00774000
  END;                                                                  00775000
  WRITELN ( '   Cannot continue with this file' );                      00776000
  IF file_is_ksam THEN                                                  00777000
  BEGIN                                                                 00778000
    fclose ( fold, 0, 0 );                                              00779000
    WRITELN ( reccount:4, ' records converted in ', filename );         00780000
  END                                                                   00781000
  ELSE                                                                  00782000
  BEGIN                                                                 00783000
    fclose ( fold, 0, 0 );       { keep old }                           00784000
    fclose ( fnew, 4, 0 );       { delete new }                         00785000
  END;                                                                  00786000
END;                                                                    00787000
$PAGE$                                                                  00788000
PROCEDURE convert_textfile;                                             00789000
  LABEL 97;                                                             00790000
BEGIN                                                                   00791000
  open_isofile;                                                         00792000
  IF file_error THEN                                                    00793000
    GOTO 97;                                                            00794000
  open_newfile;                                                         00795000
  IF file_error THEN                                                    00796000
  BEGIN                                                                 00797000
    fclose ( fold, 0, 0 );                                              00798000
    GOTO 97;                                                            00799000
  END;                                                                  00800000
                                                                        00801000
    read_isofile;                                                       00802000
    WHILE NOT end_of_isofile AND NOT file_error DO                      00803000
    BEGIN                                                               00804000
      convert7to8 ( isorecord.chars, isorecord.chars,                   00805000
                    strlength, errors, lang );                          00806000
      IF errors.error1 <> 0 THEN                                        00807000
      BEGIN                                                             00808000
        IF errors.error1 < 0 THEN                                       00809000
        BEGIN                                                           00810000
          fatal_error;                                                  00811000
          GOTO 97;                                                      00812000
        END                                                             00813000
        ELSE                                                            00814000
          WRITELN ( '** ERROR: ', errors.error1, ' ON CONVERSION' );    00815000
      END;                                                              00816000
      reccount := reccount + 1;                                         00817000
      write_isofile;                                                    00818000
      read_isofile;                                                     00819000
    END;                                                                00820000
    IF file_error THEN                                                  00821000
    BEGIN                                                               00822000
      errors.error1 := filerr;                                          00823000
      fatal_error;                                                      00824000
      GOTO 97;                                                          00825000
    END;                                                                00826000
    close_isofile;                                                      00827000
                                                                        00828000
  WRITELN ( reccount:4, ' records converted in ', filename );           00829000
97:                                                                     00830000
                                                                        00831000
END;                                                                    00832000
$PAGE$                                                                  00833000
FUNCTION field_within_record : BOOLEAN;                                 00834000
BEGIN                                                                   00835000
        { test for field out of record }                                00836000
        field_within_record := FALSE;                                   00837000
        IF (field_start[fields] <= 0) OR                                00838000
           (field_length[fields] <= 0) THEN                             00839000
          WRITELN ( 'invalid positive integer' )                        00840000
        ELSE                                                            00841000
        IF field_start[fields]+field_length[fields]-1 > -recsize THEN   00842000
          WRITELN ( 'field is beyond record size ', -recsize:4 )        00843000
        ELSE                                                            00844000
          field_within_record := TRUE;                                  00845000
END;                                                                    00846000
$PAGE$                                                                  00847000
FUNCTION field_doesnt_overlap : BOOLEAN;                                00848000
  LABEL 40;                                                             00849000
  VAR i : INTEGER;                                                      00850000
BEGIN                                                                   00851000
        { test for overlapping fields }                                 00852000
        i := 0;                                                         00853000
        WHILE i < field_length[fields] DO                               00854000
        BEGIN                                                           00855000
          IF isodummy[field_start[fields]+i] = 'X' THEN                 00856000
          BEGIN                                                         00857000
            WRITELN ( 'fields may not overlap' );                       00858000
            field_doesnt_overlap := FALSE;                              00859000
            GOTO 40;                                                    00860000
          END;                                                          00861000
          i := i+1;                                                     00862000
        END;                                                            00863000
        FOR i := field_start[fields] TO field_start[fields]             00864000
                                          +field_length[fields] - 1     00865000
          DO isodummy[i] := 'X';                                        00866000
        field_doesnt_overlap := TRUE;                                   00867000
40:                                                                     00868000
                                                                        00869000
END;                                                                    00870000
$PAGE$                                                                  00871000
PROCEDURE convert_datafile;                                             00872000
  LABEL 20, 96;                                                         00873000
  VAR i, j : smallint;                                                  00874000
BEGIN                                                                   00875000
  open_isofile;                                                         00876000
  IF file_error THEN                                                    00877000
    GOTO 96;                                                            00878000
  open_newfile;                                                         00879000
  IF file_error THEN                                                    00880000
    GOTO 96;                                                            00881000
20:                                                                     00882000
  WRITELN;                                                              00883000
  WRITELN ( '  Please supply one at a time the fields to be ',          00884000
            'converted (the first byte is 1)' );                        00885000
  WRITELN;                                                              00886000
  PROMPT ( '  Start, Length: ' );                                       00887000
  READLN ( inbuf );                                                     00888000
  { setup for overlapping field test }                                  00889000
  FOR i := 1 TO -recsize DO isodummy[i] := ' ';                         00890000
  fields := 0;                                                          00891000
  WHILE (strlen (inbuf) > 0) AND (fields < maxfields) DO                00892000
  BEGIN                                                                 00893000
    fields := fields + 1;                                               00894000
    IF get_integer ( inbuf, field_start[fields] ) AND                   00895000
      get_integer ( inbuf, field_length[fields] ) AND                   00896000
      field_within_record  AND  field_doesnt_overlap                    00897000
    THEN                                                                00898000
      { do nothing }                                                    00899000
    ELSE                                                                00900000
    BEGIN                                                               00901000
      WRITELN ( '** ERROR: INVALID INPUT' );                            00902000
      fields := fields - 1;                                             00903000
    END;                                                                00904000
    PROMPT ( '  Start, Length: ' );                                     00905000
    READLN ( inbuf );                                                   00906000
  END;                                                                  00907000
  IF fields = 0 THEN                                                    00908000
  BEGIN                                                                 00909000
    fclose ( fold, 0, 0 );                                              00910000
    fclose ( fnew, 4, 0 );                                              00911000
    GOTO 96;                                                            00912000
  END;                                                                  00913000
  WRITELN;                                                              00914000
  IF fields = maxfields THEN                                            00915000
  BEGIN                                                                 00916000
    WRITELN ( '  WARNING: Maximum ', maxfields,' fields' );             00917000
    WRITELN;                                                            00918000
  END;                                                                  00919000
  WRITELN ( 'Data File ', filename, ': fields to be converted are' );   00920000
  FOR i := 1 TO fields DO                                               00921000
    WRITELN ( field_start[i]:6, ', ',field_length[i]:6 );               00922000
  PROMPT ( 'Correct? ' );                                               00923000
  READLN ( inbuf );                                                     00924000
  IF (strlen (inbuf) = 0) OR (inbuf[1] = 'Y') OR (inbuf[1] = 'y') THEN  00925000
    { continue }                                                        00926000
  ELSE                                                                  00927000
    GOTO 20;                                                            00928000
  read_isofile;                                                         00929000
  WHILE NOT end_of_isofile AND NOT file_error DO                        00930000
  BEGIN                                                                 00931000
    i := 0;                                                             00932000
    WHILE i < fields DO                                                 00933000
    BEGIN                                                               00934000
      i := i + 1;                                                       00935000
      IF field_start[i] + field_length[i] - 1 > strlength THEN          00936000
        WRITELN ('WARNING: field',                                      00937000
                           field_start[i]:4,                            00938000
                           ',',                                         00939000
                           field_length[i]:4,                           00940000
                           ' outside variable record',                  00941000
                           reccount+1,                                  00942000
                           '- field not converted' )                    00943000
      ELSE                                                              00944000
      BEGIN                                                             00945000
        FOR j:= 1 TO field_length[i] DO isodummy[j] :=                  00946000
                             isorecord.chars[field_start[i]+j-1];       00947000
        convert7to8 ( isodummy, isodummy, field_length[i], errors,      00948000
                     lang );                                            00949000
        IF errors.error1 <> 0 THEN                                      00950000
        BEGIN                                                           00951000
          IF errors.error1 < 0 THEN                                     00952000
          BEGIN                                                         00953000
            fatal_error;                                                00954000
            GOTO 96;                                                    00955000
          END                                                           00956000
          ELSE                                                          00957000
            WRITELN ( '** ERROR: ', errors.error1, ' ON CONVERSION' );  00958000
        END;                                                            00959000
        FOR j :=1 TO field_length[i] DO                                 00960000
             isorecord.chars[field_start[i]+j-1] := isodummy[j];        00961000
      END;                                                              00962000
    END;                                                                00963000
    write_isofile;                                                      00964000
    reccount := reccount + 1;                                           00965000
    read_isofile;                                                       00966000
  END;                                                                  00967000
    IF file_error THEN                                                  00968000
    BEGIN                                                               00969000
      errors.error1 := filerr;                                          00970000
      fatal_error;                                                      00971000
      GOTO 96;                                                          00972000
    END;                                                                00973000
  close_isofile;                                                        00974000
                                                                        00975000
  WRITELN ( reccount:4, ' records converted in ', filename );           00976000
                                                                        00977000
96:                                                                     00978000
                                                                        00979000
END;                                                                    00980000
$PAGE$                                                                  00981000
PROCEDURE convert_vplus_file;                                           00982000
BEGIN                                                                   00983000
  WRITELN ( '  VPLUS file conversion not yet implemented' );            00984000
END;                                                                    00985000
$PAGE$                                                                  00986000
PROCEDURE test_mode;                                                    00987000
                                                                        00988000
  VAR i : INTEGER;                                                      00989000
      dummy_read : PACKED ARRAY [1..2] OF CHAR;                         00990000
      test_string : PACKED ARRAY [1..80] OF CHAR;                       00991000
                                                                        00992000
BEGIN                                                                   00993000
  WRITELN;                                                              00994000
  WRITELN ( 'If your terminal is configurable, please switch it now');  00995000
  WRITELN ( '  to 7 Bit mode for language = ', lang );                  00996000
  WRITELN ( 'Press "RETURN" when you are ready to continue' );          00997000
  READLN ( dummy_read );                                                00998000
  WRITELN;                                                              00999000
  WRITELN ( 'Enter a string to be converted: ' );                       01000000
  READLN ( test_string );                                               01001000
  WHILE test_string[1] <> ' ' DO                                        01002000
  BEGIN                                                                 01003000
    FOR i := 1 TO 80 DO isodummy[i] := test_string[i];                  01004000
    convert7to8 ( isodummy, isodummy, 80, errors, lang );               01005000
    WRITELN ( ' will be converted to:');                                01006000
    FOR i := 1 TO 80 DO                                                 01007000
      IF ord(isodummy[i]) > 127 THEN                                    01008000
        WRITE ( '(', ord(isodummy[i]):3, ')' )                          01009000
      ELSE                                                              01010000
        WRITE ( isodummy[i] );                                          01011000
    WRITELN;  WRITELN;                                                  01012000
    WRITELN ( 'Enter a string to be converted:' );                      01013000
    READLN ( test_string );                                             01014000
  END;                                                                  01015000
END;                                                                    01016000
$PAGE$                                                                  01017000
BEGIN                                                                   01018000
  RESET ( input, '$STDINX' );                                           01019000
  { WRITE BANNER }                                                      01020000
  WRITELN ( 'HP32414A.02.00  N7MF8CNV/3000  (C) HEWLETT-PACKARD ',      01021000
            'CO., 1983 ' );                                             01022000
  WRITELN;                                                              01023000
  WRITELN ( '     (7-Bit ---> ROMAN8 Conversion Utility)' );            01024000
  WRITELN;                                                              01025000
  { set control-y trap }                                                01026000
  ctlytrap := 0;                                                        01027000
  setctlytrap ( ctlytrap );                                             01028000
  display_languages;                                                    01029000
  READLN ( inbuf );                                                     01030000
  WHILE STRLEN ( inbuf ) > 0 DO                                         01031000
  BEGIN                                                                 01032000
    IF get_integer ( inbuf, k ) AND                                     01033000
        (k > ord(minlang)) AND (k <= ord(maxlang)) THEN                 01034000
    BEGIN                                                               01035000
      { lang := isolang (k) }                                           01036000
      lang := minlang;      FOR l := 1 TO k DO lang := succ(lang);      01037000
      IF lang = FrancaisM THEN                                          01038000
        display_french_warn;                                            01039000
      IF lang = EspanolM THEN                                           01040000
        display_spanish_warn;                                           01041000
      display_file_types;                                               01042000
      READLN ( inbuf );                                                 01043000
      WHILE STRLEN ( inbuf ) > 0 DO                                     01044000
      BEGIN                                                             01045000
        IF get_integer ( inbuf, k ) AND                                 01046000
           (k > ord(minfile)) AND (k <= ord(maxfile)) THEN              01047000
        BEGIN                                                           01048000
          { ftype := filetype (k) }                                     01049000
          ftype := minfile;   FOR l := 1 TO k DO ftype := succ(ftype);  01050000
          CASE ftype OF                                                 01051000
            textfile :                                                  01052000
              BEGIN                                                     01053000
                WRITELN;                                                01054000
                PROMPT ( 'Name of text file to be converted: ' );       01055000
                READLN ( filename );                                    01056000
                WHILE filename <> '  ' DO                               01057000
                BEGIN                                                   01058000
                  convert_textfile;                                     01059000
                  WRITELN;                                              01060000
                  PROMPT ( 'Name of text file to be converted: ' );     01061000
                  READLN ( filename );                                  01062000
                END;                                                    01063000
              END;                                                      01064000
            datafile :                                                  01065000
              BEGIN                                                     01066000
                WRITELN;                                                01067000
                PROMPT ( 'Name of data file to be converted: ' );       01068000
                READLN ( filename );                                    01069000
                WHILE filename <> '  ' DO                               01070000
                BEGIN                                                   01071000
                  convert_datafile;                                     01072000
                  WRITELN;                                              01073000
                  PROMPT ( 'Name of data file to be converted: ' );     01074000
                  READLN ( filename );                                  01075000
                END;                                                    01076000
              END;                                                      01077000
            testmode:                                                   01078000
              BEGIN                                                     01079000
                test_mode;                                              01080000
              END;                                                      01081000
          END;                                                          01082000
        END                                                             01083000
        ELSE                                                            01084000
          WRITELN ( '** ERROR: INVALID FILE TYPE (1-3)' );              01085000
        display_file_types;                                             01086000
        READLN ( inbuf );                                               01087000
      END;     { WHILE STRLEN ( inbuf ) > 0 }                           01088000
    END                                                                 01089000
    ELSE                                                                01090000
      WRITELN ( '** ERROR: INVALID LANGUAGE (1-9)' );                   01091000
    display_languages;                                                  01092000
    READLN ( inbuf );                                                   01093000
  END;   { WHILE STRLEN ( inbuf ) > 0 }                                 01094000
END.                                                                    01095000
