home *** CD-ROM | disk | FTP | other *** search
Wrap
OPT OSVERSION=37 /* Traitements des erreurs */ /*SF*/ ENUM OUT_OF_MEMORY,ARGS_ERROR,IO_ERROR,WRONG_PAMF,WRONG_MACRO_CALL RAISE OUT_OF_MEMORY IF New()=NIL, OUT_OF_MEMORY IF List()=NIL, OUT_OF_MEMORY IF String()=NIL, ARGS_ERROR IF ReadArgs()=NIL, IO_ERROR IF Open()=NIL /*EF*/ /* Definition des constantes */ /*SF*/ CONST LONG_DEF_MACRO=3 CONST LONG_MORCEAU_CORPS=6 /*EF*/ /* Definition des objets */ /*SF*/ OBJECT ident_hash ident :LONG hash :LONG ENDOBJECT OBJECT def_macro nom :LONG nbre_args :LONG corps :LONG ENDOBJECT OBJECT morceau_chaine macro :LONG ptr_macro :LONG /* si c'est une macro */ parametres :LONG chaine_traite :LONG ptr_texte :LONG /* si c'est une macro */ longueur :LONG ENDOBJECT /*EF*/ /* Definition des variables globales */ /*SF*/ DEF table_macros[256]:ARRAY OF LONG DEF num_ligne=1 /*EF*/ /**********************/ /* Corps du programme */ /**********************/ PROC main() HANDLE /*SF*/ DEF rdargs=NIL,arguments:PTR TO LONG,nom_fichier:PTR TO LONG DEF version,i Vprintf(' \c1;33;40\cMac2E\c0;31;40\c v3.1\n',[$9B,$6D,$9B,$6D]) PutStr('Copyright © 1993, Lionel Vintenat\n') Vprintf('\c1;32;40\c---------------------------------\c0;31;40\c\n',[$9B,$6D,$9B,$6D]) version:='$VER: Mac2E 3.1 (12.07.94)' arguments:=[NIL,NIL,NIL] rdargs:=ReadArgs('FROM/A,TO/A,WITH/A/M',arguments,NIL) FOR i:=0 TO 255 DO table_macros[i]:=NIL nom_fichier:=arguments[2] WHILE nom_fichier[0] DO charger_fichier_macros(nom_fichier[0]++) Vprintf('Begining macro replacement in \s...\n',[arguments[0]]) traiter_source(arguments[0],arguments[1]) FreeArgs(rdargs) EXCEPT SELECT exception CASE ARGS_ERROR PrintFault(IoErr(),NIL) CASE OUT_OF_MEMORY PutStr('Out of memory !\n') CASE IO_ERROR PrintFault(IoErr(),NIL) CASE WRONG_PAMF PutStr('Incorrect pre-analysed macro file !\n') ENDSELECT IF rdargs THEN FreeArgs(rdargs) CleanUp(100) ENDPROC /*EF*/ /*******************************************/ /* Charge un fichier de macros pre-analyse */ /*******************************************/ PROC charger_fichier_macros(nom_fichier:PTR TO CHAR) /*SF*/ DEF fichier,long_fichier,adr_fichier DEF liste_macros_hash:PTR TO def_macro DEF nbre_macros,nbre,ptr_chaine:PTR TO CHAR,i,j Vprintf('Loading pre-analysed macro file \s...\n',[nom_fichier]) fichier:=Open(nom_fichier,OLDFILE) long_fichier:=FileLength(nom_fichier) adr_fichier:=New(long_fichier) Read(fichier,adr_fichier,long_fichier) Close(fichier) ptr_chaine:=adr_fichier IF StrCmp(ptr_chaine,'PreMac2E_Save_Format_V1.0',ALL) ptr_chaine:=ptr_chaine+26 /* ptr_chaine:=ptr_chaine+StrLen('PreMac2E_Save_Format_V1.0')+1 */ FOR i:=0 TO 255 nbre_macros:=Char(ptr_chaine++)*256+Char(ptr_chaine++) liste_macros_hash:=table_macros[i] FOR j:=1 TO nbre_macros liste_macros_hash:=Link(List(LONG_DEF_MACRO),liste_macros_hash) nbre:=Char(ptr_chaine++) liste_macros_hash.nom:=ptr_chaine ptr_chaine:=ptr_chaine+nbre+1 liste_macros_hash.nbre_args:=Char(ptr_chaine++) nbre:=Char(ptr_chaine++)*256+Char(ptr_chaine++) liste_macros_hash.corps:=ptr_chaine ptr_chaine:=ptr_chaine+nbre+1 ENDFOR table_macros[i]:=liste_macros_hash ENDFOR ELSE Raise(WRONG_PAMF) ENDIF ENDPROC /*EF*/ /************************************************************************************/ /* Fait une passe de remplacement des macros du fichier source vers celui d'arrivee */ /************************************************************************************/ PROC traiter_source(fichier_source:PTR TO CHAR,fichier_destination:PTR TO CHAR) HANDLE /*SF*/ DEF fichier,adr_fichier,long_fichier,fin_fichier DEF deb_phrase,fin_phrase,ident_courant:ident_hash DEF ptr_macro:PTR TO def_macro,args_macro:PTR TO LONG DEF car,pointeur_car:PTR TO CHAR,i fichier:=Open(fichier_source,OLDFILE) long_fichier:=FileLength(fichier_source) adr_fichier:=New(long_fichier) fin_fichier:=adr_fichier+long_fichier Read(fichier,adr_fichier,long_fichier) Close(fichier) fichier:=Open(fichier_destination,NEWFILE) pointeur_car:=adr_fichier deb_phrase:=adr_fichier WHILE pointeur_car<fin_fichier /* IF (car:=Char(pointeur_car++))=10 THEN INC num_ligne */ MOVE.L pointeur_car,A0 CLR.L D0 MOVE.B (A0)+,D0 MOVE.L A0,pointeur_car CMP.B #10,D0 BNE.B ts_non_add_ligne1 INC num_ligne ts_non_add_ligne1: MOVE.L D0,car SELECT car CASE "/" /* IF (Char(pointeur_car)="*") AND (pointeur_car<fin_fichier) INC pointeur_car level_comment:=1 WHILE (pointeur_car<fin_fichier) AND (level_comment>0) IF (car:=Char(pointeur_car++))=10 THEN INC num_ligne SELECT car CASE "*" IF (pointeur_car<fin_fichier) AND (Char(pointeur_car)="/") DEC level_comment INC pointeur_car ENDIF CASE "/" IF (pointeur_car<fin_fichier) AND (Char(pointeur_car)="*") INC level_comment INC pointeur_car ENDIF ENDSELECT ENDWHILE ENDIF */ MOVE.L pointeur_car,A0 MOVE.L fin_fichier,A1 CMPA.L A0,A1 BEQ.W ts_fin_while2 MOVE.B (A0),D0 CMP.B #"*",D0 BNE.W ts_fin_while2 ADDQ.L #1,A0 MOVE.L #1,D2 ts_while1: TST.L D2 BEQ.B ts_fin_while1 CMPA.L A0,A1 BEQ.B ts_fin_while1 ts_while2: MOVE.B (A0)+,D0 CMP.B #10,D0 BNE.B ts_non_add_ligne2 INC num_ligne ts_non_add_ligne2: CMPA.L A0,A1 BEQ.B ts_fin_while1 CMP.B #"*",D0 BNE.B ts_non_etoile MOVE.B (A0),D1 CMP.B #"/",D1 BNE.B ts_while2 SUBQ.L #1,D2 ADDQ.L #1,A0 BRA.B ts_while1 ts_non_etoile: CMP.B #"/",D0 BNE.B ts_while2 MOVE.B (A0),D1 CMP.B #"*",D1 BNE.B ts_while2 ADDQ.L #1,D2 ADDQ.L #1,A0 BRA.B ts_while1 ts_fin_while1: MOVE.L A0,pointeur_car ts_fin_while2: CASE "'" /* IF (Char(pointeur_car-2)<>34) OR ((pointeur_car-2)<adr_fichier) WHILE (pointeur_car<fin_fichier) AND ((car:=Char(pointeur_car++))<>"'") IF car=10 THEN INC num_ligne ENDWHILE ENDIF */ MOVE.L pointeur_car,A0 MOVE.L fin_fichier,A1 CMPI.B #34,-2(A0) BNE.B ts_while MOVE.L adr_fichier,A2 ADDQ.L #1,A2 CMPA.L A0,A2 BNE.B ts_fin_while_bis ts_while: CMPA.L A0,A1 BEQ.B ts_fin_while MOVE.B (A0)+,D0 CMP.B #10,D0 BNE.B ts_non_add_ligne3 INC num_ligne ts_non_add_ligne3: CMP.B #"'",D0 BNE.B ts_while ts_fin_while: MOVE.L A0,pointeur_car ts_fin_while_bis: DEFAULT DEC pointeur_car fin_phrase:=pointeur_car pointeur_car:=chercher_identificateur_hash(pointeur_car,fin_fichier,ident_courant) IF ident_courant.ident IF ptr_macro:=est_ce_macro(ident_courant.ident,ident_courant.hash) Write(fichier,deb_phrase,fin_phrase-deb_phrase) IF ptr_macro.nbre_args args_macro:=List(ptr_macro.nbre_args) pointeur_car:=recuperer_args_macro(pointeur_car,fin_fichier,ptr_macro,args_macro) FOR i:=0 TO ptr_macro.nbre_args-1 DO args_macro[i]:=traiter_chaine(args_macro[i]) placer_corps_macro(fichier,ptr_macro,args_macro) ELSE IF (Char(pointeur_car)<>"(") OR (pointeur_car=fin_fichier) Write(fichier,ptr_macro.corps,StrLen(ptr_macro.corps)) ELSE Vprintf('Wrong number of args in \s call in line \d !\n',[ptr_macro.nom,num_ligne]) Raise(WRONG_MACRO_CALL) ENDIF ENDIF deb_phrase:=pointeur_car ENDIF ELSE INC pointeur_car ENDIF ENDSELECT ENDWHILE Write(fichier,deb_phrase,pointeur_car-deb_phrase) Close(fichier) EXCEPT Close(fichier) Raise(WRONG_MACRO_CALL) ENDPROC /*EF*/ /********************************************************************************************/ /* Retourne l'identificateur pointe actuellement dans le fichier, avec sa valeur hash-codee */ /********************************************************************************************/ PROC chercher_identificateur_hash(pointeur_car:PTR TO CHAR,fin_fichier,ident_reconnu:PTR TO ident_hash) /*SF*/ DEF debut_ident,long_ident,hash debut_ident:=pointeur_car MOVE.L pointeur_car,A0 MOVE.L fin_fichier,A1 CLR.L D1 /* WHILE (caractere(Char(pointeur_car))) AND (pointeur_car<fin_fichier) DO INC pointeur_car */ cih_while: CMPA.L A1,A0 /* pointeur_car=fin_fichier ? */ BEQ.B cih_fin_while MOVE.B (A0)+,D0 ADD.B D0,D1 CMP.B #"_",D0 /* Char(pointeur_car)="_" ? */ BEQ.B cih_while CMP.B #"A",D0 /* Char(pointeur_car)E["A".."Z"] ?*/ BCS.B cih_non_majuscule CMP.B #"Z",D0 BLS.B cih_while cih_non_majuscule: CMP.B #"a",D0 /* Char(pointeur_car)E["a".."z"] ?*/ BCS.B cih_non_minuscule CMP.B #"z",D0 BLS.B cih_while cih_non_minuscule: CMP.B #"0",D0 /* Char(pointeur_car)E["0".."9"] ?*/ BCS.B cih_non_chiffre CMP.B #"9",D0 BLS.B cih_while cih_non_chiffre: SUBQ.L #1,A0 SUB.B D0,D1 cih_fin_while: MOVE.L A0,pointeur_car MOVE.L D1,hash IF long_ident:=(pointeur_car-debut_ident) ident_reconnu.ident:=String(long_ident) StrCopy(ident_reconnu.ident,debut_ident,long_ident) ident_reconnu.hash:=hash ELSE ident_reconnu.ident:=NIL ENDIF ENDPROC pointeur_car /*EF*/ /****************************************************************************************/ /* Retourne un pointeur sur le descriptif de la macro dont le nom est passe en argument */ /****************************************************************************************/ PROC est_ce_macro(nom_macro:PTR TO CHAR,hash_code) /*SF*/ DEF liste_macros_hash:PTR TO def_macro liste_macros_hash:=table_macros[hash_code] WHILE liste_macros_hash DO IF StrCmp(liste_macros_hash.nom,nom_macro,ALL) THEN RETURN liste_macros_hash ELSE liste_macros_hash:=Next(liste_macros_hash) ENDPROC NIL /*EF*/ /*******************************************************/ /* Retourne un tableau des arguments passes a la macro */ /*******************************************************/ PROC recuperer_args_macro(pointeur_car:PTR TO CHAR,fin_chaine,ptr_macro:PTR TO def_macro,parametres:PTR TO LONG) /*SF*/ DEF car,encore=TRUE,level=0 DEF deb_arg,long_arg,num_arg num_arg:=ptr_macro.nbre_args-1 IF pointeur_car<fin_chaine IF (car:=Char(pointeur_car++))="(" deb_arg:=pointeur_car WHILE (pointeur_car<fin_chaine) AND encore car:=Char(pointeur_car++) SELECT car CASE 10 Vprintf('Unexpected end of line in \s call in line \d !\n',[ptr_macro.nom,num_ligne]) Raise(WRONG_MACRO_CALL) CASE 34 pointeur_car:=pointeur_car+2 CASE "," IF level=0 long_arg:=pointeur_car-deb_arg-1 parametres[num_arg]:=String(long_arg) StrCopy(parametres[num_arg],deb_arg,long_arg) DEC num_arg deb_arg:=pointeur_car IF num_arg<0 Vprintf('Wrong number of args in \s call in line \d !\n',[ptr_macro.nom,num_ligne]) Raise(WRONG_MACRO_CALL) ENDIF ENDIF CASE "(" INC level CASE ")" IF level DEC level ELSE long_arg:=pointeur_car-deb_arg-1 parametres[num_arg]:=String(long_arg) StrCopy(parametres[num_arg],deb_arg,long_arg) DEC num_arg encore:=FALSE ENDIF CASE "'" WHILE (pointeur_car<fin_chaine) AND (Char(pointeur_car)<>"'") DO INC pointeur_car INC pointeur_car ENDSELECT ENDWHILE IF encore Vprintf('Unexpected end of file in the middle of \s call in line \d !\n',[ptr_macro.nom,num_ligne]) Raise(WRONG_MACRO_CALL) ENDIF ELSE DEC pointeur_car IF car=10 THEN DEC num_ligne ENDIF ENDIF IF num_arg>=0 Vprintf('Wrong number of args in \s call in line \d !\n',[ptr_macro.nom,num_ligne]) Raise(WRONG_MACRO_CALL) ENDIF ENDPROC pointeur_car /*EF*/ /****************************************************************************************/ /* Remplace dans chaine_avant toutes les macros par leur corps et retourne chaine_apres */ /****************************************************************************************/ PROC traiter_chaine(chaine_avant:PTR TO CHAR) /*SF*/ DEF chaine_apres:PTR TO CHAR,long_chaine_apres=0,fin_chaine_avant DEF nom_ident:ident_hash,ptr_macro:PTR TO def_macro,long_temp DEF deb_morceau,morceaux:PTR TO morceau_chaine,morceaux_temp:PTR TO morceau_chaine DEF morceau:PTR TO morceau_chaine,parametres:PTR TO LONG DEF pointeur_car,pointeur_car_temp,i fin_chaine_avant:=chaine_avant+EstrLen(chaine_avant) morceaux:=NIL pointeur_car:=chaine_avant deb_morceau:=chaine_avant WHILE pointeur_car<fin_chaine_avant pointeur_car_temp:=pointeur_car pointeur_car:=chercher_identificateur_hash(pointeur_car,fin_chaine_avant,nom_ident) IF nom_ident.ident IF ptr_macro:=est_ce_macro(nom_ident.ident,nom_ident.hash) IF long_temp:=(pointeur_car_temp-deb_morceau) morceaux:=Link(List(LONG_MORCEAU_CORPS),morceaux) morceaux.macro:=FALSE morceaux.ptr_texte:=deb_morceau morceaux.longueur:=long_temp long_chaine_apres:=long_chaine_apres+morceaux.longueur ENDIF morceaux:=Link(List(LONG_MORCEAU_CORPS),morceaux) morceaux.macro:=TRUE morceaux.ptr_macro:=ptr_macro IF ptr_macro.nbre_args morceaux.parametres:=List(ptr_macro.nbre_args) pointeur_car:=recuperer_args_macro(pointeur_car,fin_chaine_avant,ptr_macro,morceaux.parametres) ELSE IF (Char(pointeur_car)="(") AND (pointeur_car<>fin_chaine_avant) Vprintf('Wrong number of args in \s call in line \d !\n',[ptr_macro.nom,num_ligne]) Raise(WRONG_MACRO_CALL) ENDIF ENDIF deb_morceau:=pointeur_car ENDIF ELSE IF (Char(pointeur_car)="'") AND ((Char(pointeur_car-1)<>34) OR ((pointeur_car-1)<chaine_avant)) INC pointeur_car WHILE (pointeur_car<fin_chaine_avant) AND (Char(pointeur_car)<>"'") DO INC pointeur_car ENDIF INC pointeur_car ENDIF ENDWHILE IF long_temp:=(pointeur_car-deb_morceau) morceaux:=Link(List(LONG_MORCEAU_CORPS),morceaux) morceaux.macro:=FALSE morceaux.ptr_texte:=deb_morceau morceaux.longueur:=long_temp long_chaine_apres:=long_chaine_apres+morceaux.longueur ENDIF morceaux_temp:=NIL WHILE morceaux morceau:=morceaux morceaux:=Next(morceaux) morceaux_temp:=Link(morceau,morceaux_temp) IF morceau.macro ptr_macro:=morceau.ptr_macro IF ptr_macro.nbre_args parametres:=morceau.parametres FOR i:=0 TO ptr_macro.nbre_args-1 DO parametres[i]:=traiter_chaine(parametres[i]) morceau.chaine_traite:=traiter_corps_macro(ptr_macro,parametres) ELSE morceau.chaine_traite:=String(StrLen(ptr_macro.corps)) StrCopy(morceau.chaine_traite,ptr_macro.corps,ALL) ENDIF long_chaine_apres:=long_chaine_apres+EstrLen(morceau.chaine_traite) ENDIF ENDWHILE chaine_apres:=String(long_chaine_apres) morceaux:=morceaux_temp WHILE morceaux IF morceaux.macro THEN StrAdd(chaine_apres,morceaux.chaine_traite,ALL) ELSE StrAdd(chaine_apres,morceaux.ptr_texte,morceaux.longueur) morceaux:=Next(morceaux) ENDWHILE ENDPROC chaine_apres /*EF*/ /*************************************************************/ /* Retourne le corps de la macro en remplacant les arguments */ /*************************************************************/ PROC traiter_corps_macro(ptr_macro:PTR TO def_macro,parametres:PTR TO LONG) /*SF*/ DEF long_corps,long_corps_temp,long_args:PTR TO LONG DEF corps_macro_expandee,car,pos:PTR TO CHAR,i long_args:=List(ptr_macro.nbre_args) FOR i:=0 TO ptr_macro.nbre_args-1 DO long_args[i]:=EstrLen(parametres[i]) long_corps:=StrLen(ptr_macro.corps) long_corps_temp:=long_corps pos:=ptr_macro.corps FOR i:=0 TO long_corps_temp-1 DO IF (car:=pos[i])>=128 THEN long_corps:=long_corps+long_args[car-128]-1 corps_macro_expandee:=String(long_corps) pos:=ptr_macro.corps FOR i:=0 TO long_corps_temp-1 DO IF (car:=pos[i])>=128 THEN StrAdd(corps_macro_expandee,parametres[car-128],ALL) ELSE StrAdd(corps_macro_expandee,(pos+i),1) ENDPROC corps_macro_expandee /*EF*/ /**************************************************************************/ /* Ecrit le corps de la macro dans le fichier en remplacant les arguments */ /**************************************************************************/ PROC placer_corps_macro(fichier,ptr_macro:PTR TO def_macro,parametres:PTR TO LONG) /*SF*/ DEF car,pos:PTR TO CHAR,deb:PTR TO CHAR deb:=ptr_macro.corps pos:=ptr_macro.corps WHILE (car:=Char(pos))<>0 IF car>=128 Write(fichier,deb,pos-deb) Write(fichier,parametres[car-128],EstrLen(parametres[car-128])) deb:=pos+1 ENDIF INC pos ENDWHILE Write(fichier,deb,pos-deb) ENDPROC /*EF*/