Annotation of rpl/src/instructions_h2.c, revision 1.1
1.1 ! bertrand 1: /*
! 2: ================================================================================
! 3: RPL/2 (R) version 4.0.9
! 4: Copyright (C) 1989-2010 Dr. BERTRAND Joël
! 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:
! 23: #include "rpl.conv.h"
! 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
CVSweb interface <joel.bertrand@systella.fr>