Les constantes figuratives, *BLANKS, *HIVAL et les autres

Exemple 1 Chaque type de zone

Ce que chaque constante met dans la zone

VALEURS applique les constantes à des zones de tous les types, puis range, pour chacune, ce qu'elle affiche et ses octets dans un fichier. La procédure noter lit les octets par un pointeur posé sur l'adresse de la zone :

**free
// Constantes figuratives : chaque zone reçoit une constante, puis
// on range ce qu'elle affiche et ses octets dans le fichier RESULTAT.
ctl-opt dftactgrp(*no) actgrp(*new);

dcl-f RESULTAT usage(*output);

dcl-s nom char(6);
dcl-s libelle varchar(6);
dcl-s montant packed(5:2);
dcl-s quantite zoned(5:0);
dcl-s compteur int(10);
dcl-s taux float(8);
dcl-s jour date(*iso);
dcl-s jourMdy date(*mdy);
dcl-s heure time(*iso);
dcl-s instant timestamp;
dcl-s trouve ind;
dcl-s adresse pointer;

nom = *blanks;
noter('*BLANKS' : 'char(6)' : '[' + nom + ']' : %addr(nom) : %size(nom));
nom = *zeros;
noter('*ZEROS' : 'char(6)' : '[' + nom + ']' : %addr(nom) : %size(nom));
nom = *loval;
noter('*LOVAL' : 'char(6)' : '' : %addr(nom) : %size(nom));
nom = *hival;
noter('*HIVAL' : 'char(6)' : '' : %addr(nom) : %size(nom));
nom = *all'AB';
noter('*ALL''AB''' : 'char(6)' : '[' + nom + ']' : %addr(nom) : %size(nom));
nom = *allx'5C';
noter('*ALLX''5C''' : 'char(6)' : '[' + nom + ']' : %addr(nom) : %size(nom));

libelle = 'AB';
libelle = *blanks;
noter('*BLANKS' : 'varchar(6) = ''AB''' : '[' + libelle + ']'
     : %addr(libelle) : %size(libelle));
libelle = 'AB';
libelle = *hival;
noter('*HIVAL' : 'varchar(6) = ''AB''' : ''
     : %addr(libelle) : %size(libelle));

montant = *hival;
noter('*HIVAL' : 'packed(5:2)' : %char(montant)
     : %addr(montant) : %size(montant));
montant = *loval;
noter('*LOVAL' : 'packed(5:2)' : %char(montant)
     : %addr(montant) : %size(montant));
quantite = *hival;
noter('*HIVAL' : 'zoned(5:0)' : %char(quantite)
     : %addr(quantite) : %size(quantite));
quantite = *loval;
noter('*LOVAL' : 'zoned(5:0)' : %char(quantite)
     : %addr(quantite) : %size(quantite));
compteur = *hival;
noter('*HIVAL' : 'int(10)' : %char(compteur)
     : %addr(compteur) : %size(compteur));
compteur = *loval;
noter('*LOVAL' : 'int(10)' : %char(compteur)
     : %addr(compteur) : %size(compteur));
taux = *hival;
noter('*HIVAL' : 'float(8)' : %char(taux) : %addr(taux) : %size(taux));

jour = *loval;
noter('*LOVAL' : 'date(*iso)' : %char(jour) : %addr(jour) : %size(jour));
jour = *hival;
noter('*HIVAL' : 'date(*iso)' : %char(jour) : %addr(jour) : %size(jour));
jourMdy = *loval;
noter('*LOVAL' : 'date(*mdy)' : %char(jourMdy : *iso)
     : %addr(jourMdy) : %size(jourMdy));
jourMdy = *hival;
noter('*HIVAL' : 'date(*mdy)' : %char(jourMdy : *iso)
     : %addr(jourMdy) : %size(jourMdy));
heure = *hival;
noter('*HIVAL' : 'time(*iso)' : %char(heure) : %addr(heure) : %size(heure));
instant = *hival;
noter('*HIVAL' : 'timestamp' : %char(instant)
     : %addr(instant) : %size(instant));

trouve = *on;
noter('*ON' : 'ind' : trouve : %addr(trouve) : %size(trouve));
adresse = *null;
noter('*NULL' : 'pointer' : '' : %addr(adresse) : %size(adresse));

*inlr = *on;

// Range une ligne : la constante, la zone, son affichage et ses octets.
dcl-proc noter;
  dcl-pi *n;
    pConstante varchar(20) const;
    pZone varchar(20) const;
    pAffiche varchar(60) const;
    pAdresse pointer value;
    pTaille int(10) value;
  end-pi;
  dcl-s octets char(40) based(pAdresse);

  PROGRAMME = 'VALEURS';
  ORDRE += 1;
  CONSTANTE = pConstante;
  ZONE = pZone;
  AFFICHE = pAffiche;
  BRUT = %subst(octets : 1 : pTaille);
  LONGUEUR = pTaille;
  write RESULTATR;
end-proc;

Le contenu du fichier après l'appel, tel que le programme l'a rangé :

*HIVAL sur une zone caractère

Des x'FF', pas des 9 : c'est l'octet le plus haut dans l'ordre de tri EBCDIC. Il ne s'affiche pas, d'où la colonne vide. Pour un nombre, *HIVAL donne bien des 9 : 999.99 sur un packed(5:2), octets 99 99 9F.

*LOVAL sur une zone numérique

La plus petite valeur, donc négative : -999.99, avec le signe D dans le dernier demi-octet. Sur un int(10), -2147483648.

varchar(6)

Les deux premiers octets portent la longueur. La zone valait 'AB' (longueur 2) : après *blanks, elle vaut 00 06 suivi de six blancs. La constante remplit la longueur maximale, pas la longueur courante.

date(*mdy)

Une date sur deux chiffres d'année ne couvre que 1940 à 2039 : son *LOVAL est le 1er janvier 1940 et son *HIVAL le 31 décembre 2039. En *iso, de 0001-01-01 à 9999-12-31.

time et timestamp

*HIVAL donne 24.00.00, une heure qu'aucune horloge n'affiche, mais valide pour le RPG.

Piège 1 Une structure à blanc

*BLANKS sur une structure : l'erreur de données décimales

Une structure est vue comme une seule zone caractère. client = *blanks met donc des blancs partout, y compris dans les sous-zones packées, qui ne contiennent plus un nombre valide. PIEGEDS essaie un calcul après chaque étape :

**free
// Le piège de *BLANKS sur une structure : les sous-zones numériques
// reçoivent des blancs, et le premier calcul tombe en erreur.
ctl-opt dftactgrp(*no) actgrp(*new);

dcl-f RESULTAT usage(*output);

dcl-ds client qualified;
  numero packed(5:0);
  nom char(10);
  solde packed(9:2);
end-ds;
dcl-s total packed(9:2);

noter('au départ, sans INZ');
client = *blanks;
noter('client = *BLANKS');
clear client;
noter('CLEAR client');
client = *blanks;
noter('à nouveau *BLANKS');
client.solde = 0;
noter('puis client.solde = 0');

*inlr = *on;

// Essaie un calcul sur la sous-zone numérique et range le résultat
// avec les octets de la structure.
dcl-proc noter;
  dcl-pi *n;
    pEtape varchar(30) const;
  end-pi;
  dcl-s octets char(40) based(adresse);
  dcl-s adresse pointer;

  monitor;
    total = client.solde + 1;
    AFFICHE = 'client.solde + 1 = ' + %char(total);
  on-error;
    AFFICHE = 'erreur, statut ' + %editc(%status : 'X');
  endmon;
  adresse = %addr(client);
  PROGRAMME = 'PIEGEDS';
  ORDRE += 1;
  CONSTANTE = pEtape;
  ZONE = 'client';
  BRUT = %subst(octets : 1 : %size(client));
  LONGUEUR = %size(client);
  write RESULTATR;
end-proc;

Au départ, sans INZ

La structure démarre à blanc, comme après *blanks : le calcul échoue déjà, avec le statut 00907 (erreur de données décimales). Le remède : inz sur la structure, qui met chaque sous-zone à la valeur de son type.

CLEAR client

Des zéros dans les sous-zones numériques (00 00 0F), des blancs dans la zone caractère : le calcul passe.

Puis client.solde = 0

Corriger une seule sous-zone suffit pour ce calcul, mais numero reste à blanc (40 40 40) : l'erreur attend le premier qui s'en servira.

Le remède a été vérifié sur la même machine : avec dcl-ds client qualified inz;, la structure démarre à 00 00 0F, blancs, 00 00 00 00 0F, et le calcul passe. MONITOR intercepte l'erreur ici ; sans lui, le programme serait interrompu par l'erreur de données décimales (MCH1202).

Piège 2 La clé décroissante

*LOVAL, *HIVAL, *START et *END dans un fichier

Pour lire un fichier depuis le début, on écrit souvent setll *loval. Le fichier CLIENTS contient trois clients (101, 205 et 310), lus par deux index : CLIENTSI par numéro croissant, CLIENTSD par numéro décroissant.

**free
// *LOVAL, *HIVAL, *START et *END pour se placer au début ou à la
// fin d'un fichier : sur une clé croissante, puis décroissante.
ctl-opt dftactgrp(*no) actgrp(*new);

dcl-f CLIENTSI keyed;                              // NUMERO croissant
dcl-f CLIENTSD keyed rename(CLIENTR : CLIENTRD);   // NUMERO décroissant
dcl-f RESULTAT usage(*output);

setll *loval CLIENTSI;
read CLIENTSI;
noter('SETLL *LOVAL, READ' : 'croissante' : %eof(CLIENTSI));
setll *start CLIENTSI;
read CLIENTSI;
noter('SETLL *START, READ' : 'croissante' : %eof(CLIENTSI));
setgt *hival CLIENTSI;
readp CLIENTSI;
noter('SETGT *HIVAL, READP' : 'croissante' : %eof(CLIENTSI));
setll *end CLIENTSI;
readp CLIENTSI;
noter('SETLL *END, READP' : 'croissante' : %eof(CLIENTSI));

setll *loval CLIENTSD;
read CLIENTSD;
noter('SETLL *LOVAL, READ' : 'décroissante' : %eof(CLIENTSD));
setll *start CLIENTSD;
read CLIENTSD;
noter('SETLL *START, READ' : 'décroissante' : %eof(CLIENTSD));
setgt *hival CLIENTSD;
readp CLIENTSD;
noter('SETGT *HIVAL, READP' : 'décroissante' : %eof(CLIENTSD));
setll *end CLIENTSD;
readp CLIENTSD;
noter('SETLL *END, READP' : 'décroissante' : %eof(CLIENTSD));

*inlr = *on;

// Range la ligne : le client lu, ou la fin de fichier.
dcl-proc noter;
  dcl-pi *n;
    pOrdres varchar(30) const;
    pCle varchar(20) const;
    pFin ind const;
  end-pi;

  PROGRAMME = 'LECTURE';
  ORDRE += 1;
  CONSTANTE = pOrdres;
  ZONE = 'clé ' + pCle;
  if pFin;
    AFFICHE = 'fin de fichier';
  else;
    AFFICHE = 'client ' + %char(NUMERO) + ' ' + %trim(NOM);
  endif;
  BRUT = *blanks;
  LONGUEUR = 0;
  write RESULTATR;
end-proc;

Sur la clé croissante, les quatre façons se valent. Sur la clé décroissante, setll *loval se place en fin de fichier, puisque la plus petite clé y est rangée en dernier : le READ ne lit rien. *start et *end, eux, désignent le début et la fin du fichier quel que soit l'ordre de la clé. Ils s'emploient avec SETLL : setgt *end est refusé à la compilation (RNF5318).

RPG III En colonnes

Les mêmes constantes en RPG III

Le RPG III (RPG/400) connaît les mêmes constantes, en facteur 1 ou 2 des MOVE, COMP et SETLL. Dans VAL3, NOM6 et BRUTN, MONT et BRUTM partagent les mêmes octets : la seconde zone sert à relever le contenu de la première.

*...+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8
     F* Constantes figuratives en RPG III : MOVE, COMP, SETLL, SETGT
     F* Chaque essai range la zone et ses octets dans le fichier RES3
     FCLIENTSIIF  E           K        DISK
     FRES3    O   E                    DISK
     I* NOM6 et BRUTN, MONT et BRUTM occupent les memes octets
     IZONES       DS
     I                                        1   6 NOM6
     I                                        1   6 BRUTN
     I                                    P   7   92MONT
     I                                        7   9 BRUTM
     C* Zones alphanumeriques
     C                     MOVE *BLANK    NOM6
     C                     MOVEL'*BLANK'  CTE
     C                     EXSR NOTERN
     C                     MOVE *ZERO     NOM6
     C                     MOVEL'*ZERO'   CTE
     C                     EXSR NOTERN
     C                     MOVE *ALL'AB'  NOM6
     C                     MOVEL'*ALL'    CTE
     C                     EXSR NOTERN
     C                     MOVE *HIVAL    NOM6
     C                     MOVEL'*HIVAL'  CTE
     C                     EXSR NOTERN
     C* Zone numerique packee (5,2)
     C                     MOVE *HIVAL    MONT
     C                     MOVEL'*HIVAL'  CTE
     C                     EXSR NOTERM
     C                     MOVE *LOVAL    MONT
     C                     MOVEL'*LOVAL'  CTE
     C                     EXSR NOTERM
     C                     MOVE *BLANK    MONT
     C                     MOVEL'*BLANK'  CTE
     C                     EXSR NOTERM
     C* Indicateurs : *ON et *OFF
     C                     MOVE *ON       *IN50
     C                     MOVEL'*ON'     CTE
     C                     MOVEL'*IN50'   ZONE
     C                     MOVE *IN50     AFFICH
     C                     EXSR ECRIRE
     C* Comparaison : NOM6 a blanc ?
     C                     MOVE *BLANK    NOM6
     C           NOM6      COMP *BLANK                   51
     C                     MOVEL'*BLANK'  CTE
     C                     MOVEL'*IN51'   ZONE
     C                     MOVE *IN51     AFFICH
     C                     EXSR ECRIRE
     C* Premier et dernier client
     C           *LOVAL    SETLLCLIENTSI
     C                     READ CLIENTSI                 90
     C                     MOVEL'*LOVAL'  CTE
     C                     EXSR NOTERC
     C           *HIVAL    SETGTCLIENTSI
     C                     READPCLIENTSI                 90
     C                     MOVEL'*HIVAL'  CTE
     C                     EXSR NOTERC
     C                     MOVE *ON       *INLR
     C* Range NOM6 avec ses octets
     C           NOTERN    BEGSR
     C                     MOVEL'CHAR 6'  ZONE
     C                     MOVELNOM6      AFFICH
     C                     MOVELBRUTN     BRUT
     C                     EXSR ECRIRE
     C                     ENDSR
     C* Range MONT avec ses octets
     C           NOTERM    BEGSR
     C                     MOVEL'P 5,2'   ZONE
     C                     MOVELBRUTM     BRUT
     C                     EXSR ECRIRE
     C                     ENDSR
     C* Range le client lu, ou la fin de fichier
     C           NOTERC    BEGSR
     C                     MOVEL'CLIENTSI'ZONE
     C  N90                MOVELNOM       AFFICH
     C   90                MOVEL'FIN'     AFFICH
     C                     EXSR ECRIRE
     C                     ENDSR
     C* Ecrit la ligne puis remet les zones a blanc
     C           ECRIRE    BEGSR
     C           ORDRE     ADD  1         ORDRE
     C                     WRITERES3R
     C                     MOVE *BLANK    CTE
     C                     MOVE *BLANK    ZONE
     C                     MOVE *BLANK    AFFICH
     C                     MOVE *BLANK    BRUT
     C                     ENDSR

Une différence avec le full free : MOVE *BLANK vers la zone packée MONT est accepté, et y met des zéros (00 00 0F), comme la documentation le prévoit pour MOVE, alors que montant = *blanks est refusé en RPG IV. *ON et *OFF existent aussi : MOVE *ON allume l'indicateur 50.

Piège 3 Le faux ami du CL

En CL, *BLANKS n'est pas une constante

Le CL a ses valeurs spéciales, mais ce sont des valeurs de paramètres de commande (*LIBL, *CURLIB, *ALL…), pas des constantes figuratives. Écrire *BLANKS dans une condition compile pourtant :

/* En CL, *BLANKS n'est pas une constante figurative : le       */
/* compilateur l'accepte, mais compare la zone au texte *BLANKS. */
PGM
  DCL VAR(&NOM) TYPE(*CHAR) LEN(10)
  DCL VAR(&TEST) TYPE(*CHAR) LEN(30)
  DCL VAR(&VRAI) TYPE(*CHAR) LEN(3)

  /* &NOM est à blanc : on la compare à *BLANKS, puis à ' ' */
  CHGVAR VAR(&TEST) VALUE('vide, *EQ *BLANKS')
  CHGVAR VAR(&VRAI) VALUE('non')
  IF COND(&NOM *EQ *BLANKS) THEN(CHGVAR VAR(&VRAI) VALUE('oui'))
  CALLSUBR SUBR(NOTER)

  CHGVAR VAR(&TEST) VALUE('vide, *EQ un blanc')
  CHGVAR VAR(&VRAI) VALUE('non')
  IF COND(&NOM *EQ ' ') THEN(CHGVAR VAR(&VRAI) VALUE('oui'))
  CALLSUBR SUBR(NOTER)

  /* &NOM contient le texte *BLANKS */
  CHGVAR VAR(&NOM) VALUE('*BLANKS')
  CHGVAR VAR(&TEST) VALUE('texte *BLANKS, *EQ *BLANKS')
  CHGVAR VAR(&VRAI) VALUE('non')
  IF COND(&NOM *EQ *BLANKS) THEN(CHGVAR VAR(&VRAI) VALUE('oui'))
  CALLSUBR SUBR(NOTER)
  RETURN

  /* Range le test et son résultat dans RESULTAT */
  SUBR SUBR(NOTER)
    RUNSQL SQL('INSERT INTO RESULTAT VALUES(''VALCL'', +
             (SELECT COUNT(*) + 1 FROM RESULTAT WHERE +
             PROGRAMME = ''VALCL''), ''' *CAT &TEST *TCAT +
             ''', ''&NOM'', ''' *CAT &VRAI *TCAT ''', '' '', 0)') +
             COMMIT(*NONE) NAMING(*SYS)
  ENDSUBR
ENDPGM

La variable vide n'est pas égale à *BLANKS ; celle qui contient le texte *BLANKS, si. Pour tester une variable vide en CL, on la compare à ' ' : le blanc est complété à la longueur de la variable.