Return to instructions_h2.c CVS log

Up to [local] / rpl / src

Annotation of rpl/src/instructions_h2.c, revision 1.29

1.1       bertrand    1: /*
                      2: ================================================================================
1.29    ! bertrand    3:   RPL/2 (R) version 4.1.5
1.15      bertrand    4:   Copyright (C) 1989-2011 Dr. BERTRAND Joël
1.1       bertrand    5: 
                      6:   This file is part of RPL/2.
                      7: 
                      8:   RPL/2 is free software; you can redistribute it and/or modify it
                      9:   under the terms of the CeCILL V2 License as published by the french
                     10:   CEA, CNRS and INRIA.
                     11:  
                     12:   RPL/2 is distributed in the hope that it will be useful, but WITHOUT
                     13:   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
                     14:   FITNESS FOR A PARTICULAR PURPOSE.  See the CeCILL V2 License
                     15:   for more details.
                     16:  
                     17:   You should have received a copy of the CeCILL License
                     18:   along with RPL/2. If not, write to info@cecill.info.
                     19: ================================================================================
                     20: */
                     21: 
                     22: 
1.11      bertrand   23: #include "rpl-conv.h"
1.1       bertrand   24: 
                     25: 
                     26: /*
                     27: ================================================================================
                     28:   Fonction 'head'
                     29: ================================================================================
                     30:   Entrées :
                     31: --------------------------------------------------------------------------------
                     32:   Sorties :
                     33: --------------------------------------------------------------------------------
                     34:   Effets de bord : néant
                     35: ================================================================================
                     36: */
                     37: 
                     38: void
                     39: instruction_head(struct_processus *s_etat_processus)
                     40: {
                     41:    integer8                                longueur;
                     42: 
                     43:    struct_liste_chainee                    *l_element_courant;
                     44: 
                     45:    struct_objet                            *s_objet_argument;
                     46:    struct_objet                            *s_objet_resultat;
                     47: 
                     48:    (*s_etat_processus).erreur_execution = d_ex;
                     49: 
                     50:    if ((*s_etat_processus).affichage_arguments == 'Y')
                     51:    {
                     52:        printf("\n  HEAD ");
                     53: 
                     54:        if ((*s_etat_processus).langue == 'F')
                     55:        {
                     56:            printf("(remplace une liste par son premier élément)\n\n");
                     57:        }
                     58:        else
                     59:        {
                     60:            printf("(replace a list by its first element)\n\n");
                     61:        }
                     62: 
                     63:        printf("    1: %s\n", d_LST);
                     64:        printf("->  1: %s\n", d_LST);
                     65: 
                     66:        return;
                     67:    }
                     68:    else if ((*s_etat_processus).test_instruction == 'Y')
                     69:    {
                     70:        (*s_etat_processus).nombre_arguments = -1;
                     71:        return;
                     72:    }
                     73: 
                     74:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                     75:    {
                     76:        if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
                     77:        {
                     78:            return;
                     79:        }
                     80:    }
                     81: 
                     82:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                     83:            &s_objet_argument) == d_erreur)
                     84:    {
                     85:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                     86:        return;
                     87:    }
                     88: 
                     89:    if ((*s_objet_argument).type == LST)
                     90:    {
                     91:        if ((s_objet_resultat = allocation(s_etat_processus, LST)) == NULL)
                     92:        {
                     93:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                     94:            return;
                     95:        }
                     96: 
                     97:        l_element_courant = (*s_objet_argument).objet;
                     98:        longueur = 0;
                     99: 
                    100:        while(l_element_courant != NULL)
                    101:        {
                    102:            longueur++;
                    103:            l_element_courant = (*l_element_courant).suivant;
                    104:        }
                    105: 
                    106:        if (longueur == 0)
                    107:        {
                    108:            (*s_objet_resultat).objet = NULL;
                    109:        }
                    110:        else
                    111:        {
                    112:            if (((*s_objet_resultat).objet =
                    113:                    allocation_maillon(s_etat_processus)) == NULL)
                    114:            {
                    115:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    116:                return;
                    117:            }
                    118: 
                    119:            (*((struct_liste_chainee *) (*s_objet_resultat).objet)).suivant =
                    120:                    NULL;
                    121: 
                    122:            if (((*((struct_liste_chainee *) (*s_objet_resultat).objet)).donnee
                    123:                    = copie_objet(s_etat_processus, (*((struct_liste_chainee *)
                    124:                    (*s_objet_argument).objet)).donnee, 'N')) == NULL)
                    125:            {
                    126:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    127:                return;
                    128:            }
                    129:        }
                    130:    }
                    131:    else
                    132:    {
                    133:        liberation(s_etat_processus, s_objet_argument);
                    134: 
                    135:        (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
                    136:        return;
                    137:    }
                    138: 
                    139:    if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    140:            s_objet_resultat) == d_erreur)
                    141:    {
                    142:        return;
                    143:    }
                    144: 
                    145:    liberation(s_etat_processus, s_objet_argument);
                    146: 
                    147:    return;
                    148: }
                    149: 
                    150: // vim: ts=4