; ______________________________________________________________________________ ; .............................................................................. ; ...................................................................2222222.... ; ................................................................22222222220... ; ...................................................222........222222.....222.. ; ..............................................2202222222222..22000............ ; ..................................22000.....20222222222200000200002........... ; .................................2002202...2222200222.220000000200000000022... ; ....................220002......22222200..2200002.......2200000...20000000000. ; ....................22222202....2220000022200000..........200002........200000 ; .....200000.........2222200000222200220000000002..........200002........20000. ; .....00222202........2220022000000002200002000002........2000002000020000000.. ; ....2222200000.......220002200000002.2000000000000222222000000..2000000002.... ; ....220000200002......20000..200002..220000200000000000000002.......22........ ; ...2220002.220000 2....220002...22.....200002..0000000000002................... ; ...220000..222000002...20000..........200000......2222........................ ; ...000000000000000000..200000..........00002.................................. ; ..220000000022020000002.200002.........22.......______________________________ ; ..0000002........2000000220022.................| ; .200000............2002........................| GESTION SOURCE ; .200002........................................| CHARGEMENT / TEST / VERIF ; 220002.........................................|______________________________ ; ______________________________________________________________________________ ; ; Published under the MIT Licence ; ; Copyright (c) 1992 Europress Software ; Copyright (c) 2020 Francois Lionet ; ; Permission is hereby granted, free of charge, to any person ; obtaining a copy of this software and associated documentation ; files (the "Software"), to deal in the Software without ; restriction, including without limitation the rights to use, ; copy, modify, merge, publish, distribute, sublicense, and/or ; sell copies of the Software, and to permit persons to whom the ; Software is furnished to do so, subject to the following ; conditions: ; ; The above copyright notice and this permission notice shall be ; included in all copies or substantial portions of the Software. ; ; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, ; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES ; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND ; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT ; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, ; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ; ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR ; THE USE OR OTHER DEALINGS IN THE SOFTWARE. ; ; ______________________________________________________________________________ Reloc_Step equ 1024 TablA_Step equ 1024 Reloc_End equ $80 Reloc_Var equ $82 Reloc_Long equ $84 Reloc_NewBuffer equ $86 Reloc_Proc1 equ $88 Reloc_Proc2 equ $8A Reloc_Proc3 equ $8C Reloc_Proc4 equ $8E Reloc_Debug equ $90 Reloc_Label equ $92 ;_____________________________________________________________________________ ; ; Test en mode direct ;_____________________________________________________________________________ ; VerDirect Ver_Direct tst.l VarBuf(a5) Buffer general deja reserve? bne.s .PaVar move.l #4*1024,d1 bsr ResVarBuf .PaVar bsr ResDir Espace pour variables directes tst.l VNmMini(a5) Buffer noms deja reserve? bne.s .PaNom move.l PI_VNmMax(a5),d1 bsr ResVNom .PaNom tst.w Stack_Size(a5) Buffer des boucles deja reserve? bne.s .PaSt move.w #10,Stack_Size(a5) .PaSt move.l Ed_BufT(a5),Prg_Test(a5) Adresse de test move.l Prg_Test(a5),Prg_Run(a5) Adresse de run clr.l Edt_Runned(a5) Securites! clr.l Prg_Runned(a5) move.w #1,Phase(a5) Parametres de test move.w #1,DirFlag(a5) bsr SsTest bsr Free_VerTables Efface les tables bsr Ver_Run Table de tokens rts ;_____________________________________________________________________________ ; ; Test du programme ;_____________________________________________________________________________ ; PTest: movem.l a2-a4/a6/d2-d7,-(sp) clr.b VerNot1.3(a5) Compatible, au depart... ; Recherche les includes / Met l'adresse du programme � runner... ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ move.l Prg_Source(a5),Prg_Run(a5) Par defaut bsr Get_Includes tst.l Prg_FullSource(a5) Faut-il changer? beq.s .Skip move.l Prg_FullSource(a5),Prg_Run(a5) .Skip move.l Prg_Run(a5),Prg_Test(a5) A tester ; RAZ de toutes les variables ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ move.l #8*1024,d1 bsr ResVarBuf move.l PI_VNmMax(a5),d1 bsr ResVNom clr.w Phase(a5) clr.w ErrRet(a5) clr.w DirFlag(a5) clr.w VarBufFlg(a5) move.w #51,Stack_Size(a5) clr.b Prg_Accessory(a5) clr.b MathFlags(a5) Plus de double precision clr.b Ver_SPConst(a5) Plus de flags clr.b Ver_DPConst(a5) clr.l VerNInst(a5) ; PHASE 1: exploration du programme principal ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .ReVer clr.w VarLong(a5) move.l DVNmBas(a5),a0 move.l a0,VNmHaut(a5) clr.w -(a0) move.l a0,VNmBas(a5) bsr SsTest bne.s .ReVer move.l Ver_TablA(a5),d0 move.l d0,Ver_MainTablA(a5) Stocke la table beq.s .Skop addq.l #4,d0 Si table il y a .Skop clr.l Ver_TablA(a5) Une nouvelle table move.l VNmBas(a5),DVNmBas(a5) Variables move.l VNmHaut(a5),DVNmHaut(a5) move.w VarLong(a5),GloLong(a5) ; Exploration de la TablA a la recherche des procedures ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ tst.l d0 Une table? beq.s .Fini .PLoop move.l d0,a0 cmp.b #1<>> locales bsr SsTest move.l Prg_Test(a5),a0 Longueur variable procedure move.w VarLong(a5),6(a0) move.l (sp)+,d0 bne.s .PLoop .Fini ; Libere l'espace pour les variables globales ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ move.l LabBas(a5),a1 clr.l -(a1) move.w #-1,-(a1) * Marque la fin des variables move.l a1,a0 sub.w GloLong(a5),a0 cmp.l HiChaine(a5),a0 bcs VerVNm move.l a0,VarGlo(a5) move.l a0,VarLoc(a5) move.l a0,TabBas(a5) move.l a1,d0 * Nettoie les variables globales sub.l a0,d0 beq.s .Clr3 lsr.l #2,d0 bcc.s .Clr1 clr.w (a0)+ .Clr1 subq.w #1,d0 .Clr2 clr.l (a0)+ dbra d0,.Clr2 .Clr3 ; Rend toutes les variables GLOBALES ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ bsr Globale ; Libere les tables ; ~~~~~~~~~~~~~~~~~ bsr Free_VerTables ; Remet la table de tokenisation ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ bsr Ver_Run ; Verification compatibilite sur le nombre de banques ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ clr.b VerCheck1.3(a5) Plus de check 1.3 move.l Cur_Banks(a5),a0 bra.s .Next .Loop move.l d0,a0 cmp.l #16,8(a0) Numero de la banque bhi.s .Non .Next move.l (a0),d0 bne.s .Loop beq.s .Oui .Non move.b #1,VerNot1.3(a5) Flag, directement... .Oui ; Termine!!! ; ~~~~~~~~~~ movem.l (sp)+,a2-a4/a6/d2-d7 rts ; Libere les tables de verification ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Free_VerTables bsr Free_Reloc bsr Free_TablA La courante move.l Ver_MainTablA(a5),Ver_TablA(a5) clr.l Ver_MainTablA(a5) bsr Free_TablA La principale rts ; Met le flag 1.3! ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ SetNot1.3 move.b #1,VerNot1.3(a5) tst.b VerCheck1.3(a5) bne.s .Stop rts .Stop moveq #47,d0 bra VerErr ; Sous programme de verification ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ SsTest: clr.l ErrRet(a5) clr.w Passe(a5) clr.w Ver_NBoucles(a5) clr.w Ver_PBoucles(a5) bsr Ver_Verif bsr Reserve_Reloc bsr Reserve_TablA move.l Prg_Test(a5),a6 move.l a6,a3 tst.w DirFlag(a5) bne.s VerD tst.w Phase(a5) bne.s VerDd ; Debut d'une ligne ; ~~~~~~~~~~~~~~~~~ VerD move.l a6,VDLigne(a5) tst.w (a6)+ beq VerX ; Definition procedures / Data en debut de ligne ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ VerDd: move.l a6,VerPos(a5) move.w (a6)+,d0 beq.s VerD bmi VerSynt move.l AdTokens(a5),a0 move.b 0(a0,d0.w),d1 bpl.s VLoop1 addq.l #1,VerNInst(a5) ext.w d1 asl.w #2,d1 jmp .Jmp(pc,d1.w) bra VerSha FA-Global (Nouvelle maniere) bra VerSha FB-Shared bra VerDFn FC-Def Fn bra VerData FD-Debut data bra V1_EndProc FE-Fin procedure bra V1_Procedure FF-Debut procedure .Jmp ; Boucle de test dans une ligne ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ VerLoop move.l a6,VerPos(a5) Position du test move.w (a6)+,d0 beq VerD bmi VerSynt move.l AdTokens(a5),a0 move.b 0(a0,d0.w),d1 VLoop1 addq.l #1,VerNInst(a5) Un instruction de plus! ext.w d1 asl.w #2,d1 jmp .Jmp(pc,d1.w) Branche � la fonction ; Table des sauts pour les instructions particulieres ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ bra VerShal FA-Global (Nouvelle maniere) bra VerShal FB-Shared bra VerDaL FC-Def Fn bra VerDaL FD-Debut data bra VerPDb FE-Fin procedure bra VerPDb FF-Debut procedure .Jmp bra Ver_Normal 00-Instruction normale bra VerSynt 01-Syntax error bra VerRem 02-Rem bra VerSBu 03-Set Buffer bra VerDPre 04-Set Double Precision bra VerSStack 05-Set Stack bra VerVar 06-Variable bra VerLab 07-Un label bra VerPro 08-Un appel de procedure bra VerDim 09-DIM bra VerPr 0A-Print bra VerDPr 0B-Print # bra VerInp 0C-Input / Line Input bra VerDInp 0D-Input # bra VerInc 0E-Dec bra V1_Proc 0F-Proc IFNE Debug=2 bra V1_Debug 10- Debugging ENDC IFEQ Debug=2 bra Ver_Normal ENDC bra VerPal 11-Default Palette bra VerPal 12-Palette bra VerRead 13-Read bra VerRest 14-Restore bra VerChan 15-Channel bra VerInc 16-Inc bra VerAdd 17-Add bra VerPo 18-Polyline/Gon bra VerFld 19-Field bra VerCall 1A-Call bra VerMn 1B-Menu bra VerMnD 1C-Menu Del bra VerSmn 1D-Set Menu bra VerMnK 1E-Menu Key bra VerIMn 1F-Menu diverse bra VerFade 20-Fade bra VerSort 21-Sort bra VerSwap 22-Swap bra VerFol 23-Follow bra VerSetA 24-Set Accessory bra VerTrap 25-Trap bra VerStruI 26-Struc bra VerStruIS 27-Struc$ bra Ver_Extension 28-Token d'extension bra Ver_NormalPro 29-Instruction AMOSPro bra Ver_DejaTesteePro 2A-Instruction AMOSPro deja testee bra Ver_VReservee 2B-Variable reservee bra Ver_VReserveePro 2C-Variable reservee AMOSPro bra Ver_DejaTestee 2D-Instruction normale deja testee bra VerD 2E-LIBRE bra VerD 2F-Fin de ligne bra V1_For 30-For bra V1_Next 31-Next bra V1_Repeat 32-Repeat bra V1_Until 33-Until bra V1_While 34-While bra V1_Wend 35-Wend bra V1_Do 36-Do bra V1_Loop 37-Loop bra V1_Exit 38-Exit bra V1_ExitI 39-Exit If bra V1_If 3A-If bra V1_Else 3B-Else bra V1_ElseIf 3C-ElseIf bra V1_EndI 3D-EndIf bra V1_Goto 3E-Goto bra V1_Gosub 3F-Gosub bra V1_OnError 40-OnError bra V1_OnBreak 41-OnBreak bra V1_OnMenu 42-OnMenu bra V1_On 43-On bra V1_Resume 44-Resume bra V1_ResLabel 45-ResLabel bra V1_PopProc 46-PopProc bra V1_Every 47-Every bra VerPr 48-LPrint bra VerInp 49-Line Input bra VerDInp 4A-Line Input # bra VerMid 4B-Mid3 bra VerMid 4C-Mid2 bra VerMid 4D-Left bra VerMid 4E-Right bra VerAdd 4F-Add bra Ver_NormalPro 50-Dialogues bra Ver_Normal 51-Dir bra VerSynt 52-Then bra Ver_Normal 53-Return bra Ver_Normal 54-Pop bra Ver_NormalPro 55-Procedure langage machine bra Ver_Normal 56-Bset/Bchg/Ror/// bra VerSynt 57-APCmp Call IFNE Debug=2 V1_Debug move.b #Reloc_Debug,d0 Dans relocation bsr New_Reloc lea V2_Debug(pc),a0 Dans TablA move.w #_TkDP,d0 moveq #0,d1 moveq #1< Prend les variables! ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ VDfnR cmp.w #_TkPar1,(a6) bne.s .Exit addq.l #2,a6 .Loop bsr VerGV cmp.w #_TkVir,(a6)+ beq.s .Loop cmp.w #_TkPar2,-2(a6) bne VerSynt .Exit rts ; Verification PRINT/LPRINT ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ VerDPr bsr Ver_ExpE cmp.w #_TkVir,(a6)+ bne VerSynt VerPr: bset #0,VarBufFlg(a5) move.w (a6),d0 cmp.w #_TkDieze,d0 bne.s VerPr1 addq.l #2,a6 bsr Ver_Expression cmp.b #"2",d2 beq VerType cmp.w #_TkVir,(a6) bne VerDP addq.l #2,a6 VerPr1: bsr Finie beq VerDP move.l a6,VerPos(a5) cmp.w #_TkUsing,(a6) bne.s VerPr2 addq.l #2,a6 bsr Ver_ExpA cmp.w #_TkPVir,(a6)+ bne VerSynt VerPr2 bsr Ver_Expression move.w (a6)+,d0 cmp.w #_TkVir,d0 beq.s VerPr1 cmp.w #_TkPVir,d0 beq.s VerPr1 subq.l #2,a6 bra VerDP ; Verification INPUT / LINE INPUT ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ VerDInp bsr Ver_ExpE cmp.w #_TkVir,(a6)+ bne VerSynt bra.s VerIn1 VerInp: bset #0,VarBufFlg(a5) cmp.w #_TkVar,(a6) beq.s VerIn1 bsr Ver_Expression cmp.b #"2",d2 bne VerType cmp.w #_TkPVir,(a6)+ bne VerSynt VerIn1: bsr VerGV cmp.w #_TkVir,(a6)+ beq.s VerIn1 cmp.w #_TkPVir,-2(a6) beq VerDP subq.l #2,a6 bra VerDP ; Verification PALETTE / DEFAULT PALETTE ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ VerFa1: addq.l #2,a6 VerPal: clr.w d0 VPal: bset #0,VarBufFlg(a5) addq.w #1,d0 move.w d0,-(sp) bsr Ver_ExpE move.w (sp)+,d0 cmp.w #_TkVir,(a6) bne VerDP addq.l #2,a6 cmp.w #32,d0 bcs.s VPal bra VerDP ; Verification FADE ; ~~~~~~~~~~~~~~~~~~~~~~~ VerFade bset #0,VarBufFlg(a5) bsr Ver_ExpE cmp.w #_TkVir,d0 beq.s VerFa1 cmp.w #_TkTo,d0 bne VerDP addq.l #2,a6 bsr Ver_ExpE cmp.w #_TkVir,(a6) bne VerDP addq.l #2,a6 bsr Ver_ExpE bra VerDP ; Verification instructions MENU ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; Instruction MENU$(,,)= ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ VerMn bsr VerTablo cmp.w #MnNDim,d0 bcc VerSynt cmp.w #_TkEg,(a6)+ bne VerSynt ; Chaines alphanumeriques ; ~~~~~~~~~~~~~~~~~~~~~~~ cmp.w #_TkVir,(a6) beq.s VerMn1 bsr Ver_ExpA cmp.w #_TkVir,(a6) bne VerDP VerMn1 addq.l #2,a6 cmp.w #_TkVir,(a6) beq.s VerMn2 bsr Ver_ExpA cmp.w #_TkVir,(a6) bne VerDP VerMn2 addq.l #2,a6 cmp.w #_TkVir,(a6) beq.s VerMn3 bsr Ver_ExpA cmp.w #_TkVir,(a6) bne VerDP VerMn3 addq.l #2,a6 bsr Ver_ExpA bra VerDP ; Instructions diverses flags ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ VerIMn bset #0,VarBufFlg(a5) cmp.w #_TkPar1,(a6) beq.s VIMn1 cmp.w #_TkMnCl,(a6) bcc VerSynt bsr Ver_ExpE bra VerDP VIMn1 bsr VerTablo cmp.w #MnNDim,d0 bcc VerSynt bra VerDP ; Menu del ; ~~~~~~~~~~~~~~ VerMnD bset #0,VarBufFlg(a5) cmp.w #_TkPar1,(a6) bne VerDP bra.s VIMn1 ; Set Menu ; ~~~~~~~~~~~~~~ VerSmn bset #0,VarBufFlg(a5) bsr VerTablo cmp.w #MnNDim,d0 bcc VerSynt cmp.w #_TkTo,(a6)+ bne VerSynt bsr Ver_ExpE cmp.w #_TkVir,(a6)+ bne VerSynt bsr Ver_ExpE bra VerDP ; On menu ; ~~~~~~~~~~~~~ V1_OnMenu move.w (a6)+,d0 cmp.w #_TkGto,d0 beq.s .Goto cmp.w #_TkGsb,d0 beq.s .Goto cmp.w #_TkPrc,d0 beq.s .Proc bra VerSynt ; Goto, prend le label ; ~~~~~~~~~~~~~~~~~~~~ .Goto bsr V1_GoLabel cmp.w #_TkVir,(a6)+ beq.s .Goto subq.l #2,a6 bra VerDP ; Procedure ; ~~~~~~~~~ .Proc bsr V1_GoProcedureNoParam cmp.w #_TkVir,(a6)+ beq.s .Proc subq.l #2,a6 bra VerDP ; Menu key ; ~~~~~~~~~~~~~~ VerMnK bset #0,VarBufFlg(a5) bsr VerTablo cmp.w #MnNDim,d0 bcc VerSynt cmp.w #_TkTo,(a6) bne VerDP addq.l #2,a6 bsr Ver_Evalue cmp.b #"2",d2 beq VerDP cmp.b #"0",d2 bne VerType cmp.w #_TkVir,(a6) bne VerDP addq.l #2,a6 bsr Ver_ExpE bra VerDP ; Verification FOLLOW ; ~~~~~~~~~~~~~~~~~~~~~~~~~ VerFol bsr Finie beq VerDP .Loop bsr Ver_Expression cmp.w #_TkVir,(a6)+ beq.s .Loop subq.l #2,a6 bra VerDP ; Verification DATAS ; ~~~~~~~~~~~~~~~~~~~~~~~~ VerData bset #0,VarBufFlg(a5) move.l a6,d0 sub.l VDLigne(a5),d0 move.w d0,(a6) .Loop addq.l #2,a6 bsr Ver_Expression cmp.w #_TkVir,(a6) beq.s .Loop bra VerDP ; Verification READ ; ~~~~~~~~~~~~~~~~~~~~~~~ VerRead bset #0,VarBufFlg(a5) bsr VerGV cmp.w #_TkVir,(a6) bne VerDP addq.l #2,a6 bra.s VerRead ; Verification RESTORE ; ~~~~~~~~~~~~~~~~~~~~~~~~~~ VerRest bsr Finie beq VerDP bsr V1_GoLabel bra VerDP ; Verification CHANNEL x TO SPRITE x ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ VerChan bset #0,VarBufFlg(a5) bsr Ver_ExpE cmp.w #_TkTo,(a6)+ bne VerSynt move.w (a6)+,d0 cmp.w #_TkScD,d0 beq.s VerCh1 cmp.w #_TkScO,d0 beq.s VerCh1 cmp.w #_TkScS,d0 beq.s VerCh1 cmp.w #_TkBob,d0 beq.s VerCh1 cmp.w #_TkSpr,d0 beq VerCh1 cmp.w #_TkRn,d0 beq.s VerCh1 subq.l #2,a6 * Channel to ADRESS! VerCh1: bsr Ver_ExpE bra VerDP ; Verification POLYLINE/POLYGON ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ VerPo bset #0,VarBufFlg(a5) cmp.w #_TkTo,(a6) beq.s VerPo1 VerPo0 bsr Ver_ExpE cmp.w #_TkVir,(a6)+ bne VerSynt bsr Ver_ExpE VerPo1 cmp.w #_TkTo,(a6)+ beq.s VerPo0 subq.l #2,a6 bra VerDP ; Verification MID/LEFT/RIGHT en instruction ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ VerMid: bset #0,VarBufFlg(a5) move.w d0,-(sp) move.l a6,-(sp) addq.b #1,Ver_NoReloc(a5) addq.l #2,a6 bsr VerVarA subq.b #1,Ver_NoReloc(a5) cmp.w #_TkVir,(a6)+ bne VerSynt move.l (sp)+,a6 move.w (sp)+,d0 move.l AdTokens(a5),a0 move.l a0,VerBase(a5) bsr Ver_OlDInst bsr VerF cmp.w #_TkEg,(a6)+ bne VerSynt bsr Ver_Expression cmp.b #"2",d2 bne VerType bra VerDP ; Verification INC/DEC ; ~~~~~~~~~~~~~~~~~~~~~~~~~~ VerInc: bset #0,VarBufFlg(a5) bsr VerVEnt bsr VerGV bra VerDP ; Verification ADD ; ~~~~~~~~~~~~~~~~~~~~~~ VerAdd: bset #0,VarBufFlg(a5) move.w #_TkAd2,-2(a6) move.l a6,-(sp) bsr VerVEnt bsr VerGV cmp.w #_TkVir,(a6)+ bne VerSynt bsr Ver_ExpE cmp.w #_TkVir,(a6) bne VerAdX ; Plus de 2 parametres ; ~~~~~~~~~~~~~~~~~~~~ move.l (sp),a0 move.w #_TkAd4,-2(a0) addq.l #2,a6 bsr Ver_ExpE cmp.w #_TkTo,(a6)+ bne VerAdX bsr Ver_ExpE VerAdX: addq.l #4,sp bra VerDP ; Verification FIELD ; ~~~~~~~~~~~~~~~~~~~~~~~~ VerFld bset #0,VarBufFlg(a5) bsr Ver_ExpE cmp.w #_TkVir,(a6) bne VerSynt .Loop addq.l #2,a6 bsr Ver_ExpE cmp.w #_TkAs,(a6)+ bne VerSynt bsr VerVarA cmp.w #_TkVir,(a6) beq.s .Loop bra VerDP ; CALL ; ~~~~~~~~~~ VerCall bset #0,VarBufFlg(a5) bsr Ver_ExpE .Loop cmp.w #_TkVir,(a6) bne VerDP addq.l #2,a6 bsr Ver_Expression bra.s .Loop ; STRUCTURE en instruction ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ VerStruI bset #0,VarBufFlg(a5) bsr VStru cmp.b #7,d2 bcc EquType moveq #"0",d2 bra.s VStru2 VerStruIS bsr VStru cmp.b #6,d2 bne EquType moveq #"2",d2 ; Fin verification VStru2 cmp.w #_TkEg,(a6)+ bne VerSynt move.w d2,-(sp) bsr Ver_Expression ext.w d2 cmp.w (sp)+,d2 bne VerType bra VerDP ; Routine verification VStru move.l a6,-(sp) addq.l #6,a6 cmp.w #_TkPar1,(a6)+ bne VerSynt bsr Ver_Expression cmp.b #"0",d2 bne VerType cmp.w #_TkVir,(a6)+ bne VerSynt move.l (sp)+,a1 lea Equ_Nul(pc),a0 bsr Equ_Verif move.b 4(a1),d2 cmp.w #_TkPar2,(a6)+ bne VerSynt rts EquType moveq #54,d0 bra VerErr ; Verification d'un Equate / Structure ; A0= Header equate ; A1= Debut des donnees ; A6= Debut de la chaine ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equ_Verif bsr SetNot1.3 AMOSPro! btst #7,5(a1) Flag, equate correct? bne .Ok ; Poke l'equate dans le buffer, � la suite du header ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ movem.l a0-a2,-(sp) move.l a1,-(sp) move.l Buffer(a5),a2 .Cop move.b (a0)+,(a2)+ bne.s .Cop subq.l #1,a2 move.w (a6),d0 cmp.w #_TkCh1,d0 beq.s .Ch cmp.w #_TkCh2,d0 bne VerSynt .Ch move.w 2(a6),d0 beq VerSynt cmp.w #127,d0 bcc VerSynt move.w d0,d2 move.l a2,a1 lea 4(a6),a0 subq.w #1,d0 .Lop2 move.b (a0)+,(a1)+ dbra d0,.Lop2 move.b #":",(a1)+ move.l Buffer(a5),a2 move.l a1,d2 sub.l a2,d2 ; Va charger le fichier d'equates>>> A1/D1 positionnes ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ bsr Equ_Load ; Recherche dans le fichier ; ~~~~~~~~~~~~~~~~~~~~~~~~~ movem.l a1/d1/d2,-(sp) moveq #0,d4 JJsr L_InstrFind *** movem.l (sp)+,a1/d1/d2 tst.l d3 beq .NoDef ; Trouve: poke dans le listing ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ lea -1(a1,d3.l),a1 .Fnd cmp.b #":",(a1)+ Trouve le debut bne.s .Fnd clr.w -(sp) move.l a1,a0 cmp.b #"-",(a0) bne.s .Pam addq.w #1,(sp) addq.l #1,a0 .Pam moveq #0,d0 Pas de signe! JJsrR L_ValRout,a1 bne.s .Bad cmp.w #_TkFl,d1 beq.s .Bad cmp.w #_TkDFl,d1 beq.s .Bad tst.w (sp)+ beq.s .Pamm neg.l d0 .Pamm move.l (sp),a2 move.l d0,(a2) cmp.b #",",(a0)+ bne.s .Bad move.b (a0),d0 sub.b #"0",d0 cmp.b #7,d0 bhi.s .Bad move.b d0,4(a2) bset #7,5(a2) addq.l #4,sp movem.l (sp)+,a0-a2 ; Saute la variable alphanumerique ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .Ok move.w 2(a6),d0 move.w d0,d1 and.w #1,d1 add.w d1,d0 lea 4(a6,d0.w),a6 rts ; Not defined! ; ~~~~~~~~~~~~ .NoDef moveq #51,d0 bra VerErr ; Bad equates file ; ~~~~~~~~~~~~~~~~ .Bad moveq #53,d0 bra VerErr ; Charge le fichier d'equates dans un buffer ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equ_Load movem.l a0/d2/d3,-(sp) tst.l Equ_Base(a5) bne .Ok ; Branche la routine de FLUSH equates JLea L_Equ_Free,a0 lea Equ_FlushStructure(pc),a1 move.l a0,(a1) SyCall AddFlushRoutine ; Charge le fichier moveq #9,d0 JJsr L_Sys_GetMessage JJsrR L_Sys_AddPath,a1 move.l #1005,d2 jsr D_Open beq.s .Err ; Trouve la taille du fichier! moveq #0,d2 moveq #1,d3 jsr D_Seek moveq #0,d2 moveq #-1,d3 jsr D_Seek ; Reserve la memoire move.l d0,d3 move.l #Fast|Public,d1 lea Equ_Base(a5),a0 bsr A5_Reserve beq.s .Err ; Charge le fichier move.l a0,d2 jsr D_Read bne.s .Err ; Ferme le fichier jsr D_Close ; Retourne l'adresse et la longueur .Ok move.l Equ_Base(a5),a1 move.l -4(a1),d1 movem.l (sp)+,a0/d2/d3 rts ; Erreur! .Err jsr D_Close bsr Equ_Free moveq #52,d0 bra VerErr ; Structure FLUSH pour les equates ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equ_FlushStructure dc.l 0 ; Libere le fichier d'equates (ne pas bouger!) ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equ_Free lea Equ_Base(a5),a0 bsr A5_Free rts ; Routine, veut une variable numerique ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ VerVEnt move.l a6,-(sp) cmp.w #_TkVar,(a6)+ bne VerSynt bsr VarA0 tst.b d0 bne VerType move.l (sp)+,a6 rts ; Routine, veut une variable seule alphanumerique ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ VerVarA:bsr VerGV cmp.b #"2",d2 bne VerType rts ; RouRoutine, veut une variable, SEULE ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ VerGV: move.l a6,VerPos(a5) cmp.w #_TkVar,(a6)+ bne VerSynt and.b #%00001111,3(a6) RAZ du flag! bsr VarA0 cmp.w #_TkPar1,(a0) TABLEAU? bne.s VGv1 bset #6,3(a6) Met le flag tableau! move.b 3(a6),d3 bsr V1_StoVar Le tableau doit etre cree avant bne VerNDim bsr VerTablo Verifie les params d'un tableau bra.s VGv2 VGv1: bsr V1_StoVar VGv2: rts ; Verification des procedures ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; Instruction Proc ; ~~~~~~~~~~~~~~~~~~~~~~ V1_OnBreak V1_Proc tst.w Direct(a5) bne VerIlD bset #0,VarBufFlg(a5) cmp.w #_TkVar,(a6) Un variable? beq.s .Skip cmp.w #_TkPro,(a6) Un procedure bne VerSynt .Skip move.l a6,-(sp) addq.l #2,a6 bsr V1_IVariable move.l (sp)+,a0 cmp.w #_TkPro,(a0) bne VerUndP bra VerDP ; Debut de procedure ; ~~~~~~~~~~~~~~~~~~~~~~~~ V1_Procedure bset #0,VarBufFlg(a5) subq.l #2,a6 tst.w Direct(a5) bne VerIlD tst.w Phase(a5) bne V1_ProcedureIn ; PHASE 0: Stocke et saute le nom et les params ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ subq.l #1,VerNInst(a5) Retabli le compte... btst #6,8(a6) Decoder la procedure? beq.s .Skip0 btst #5,8(a6) beq.s .Skip0 bsr ProCode .Skip0 sub.l a0,a0 move.w #_TkProc,d0 moveq #4,d1 moveq #1<0, Passe 1, stocke les variables! ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ V1_ProcedureIn btst #4,8(a6) Procedure Machine? bne.s .PMach lea 12(a6),a6 move.b 2(a6),d0 ext.w d0 lea 4(a6,d0.w),a6 cmp.w #_TkBra1,(a6) Pointe les parametres bne VerDP .Loop addq.l #4,a6 bsr V1_StoVar cmp.w #_TkVir,(a6) beq.s .Loop addq.l #2,a6 bra VerDP .PMach move.w 6(a6),VarLong(a5) Recopie le nombre de params bra VerX Et on sort! ; END PROC [expression] ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~ V1_EndProc tst.w Direct(a5) bne VerIlD tst.w Phase(a5) beq VerPNo cmp.w #_TkBra1,(a6)+ bne.s .Skip bsr Ver_Expression .Skip bra VerX ; Verification des test, boucles et branchements ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; Flags pour table-A VF_Boucles equ 0 VF_If equ 1 VF_Proc equ 2 VF_Exit equ 3 VF_Goto equ 4 VF_Debug equ 5 ; FOR / Passe 1 ; ~~~~~~~~~~~~~~~~~~~ V1_For addq.w #1,Ver_NBoucles(a5) Une boucle de plus add.w #TForNxt,Ver_PBoucles(a5) lea V2_For(pc),a0 moveq #2,d1 bsr Init_TablABoucle ; Verification clr.w (a6)+ movem.l a0/a6,-(sp) bsr VerGV La variable movem.l (sp)+,a0/a1 move.w 2(a1),Vta_Variable(a0) Stocke l'offset de la variable cmp.b #"0",d2 bne VerType move.w d2,-(sp) Verifie la suite cmp.w #_TkEg,(a6)+ = bne VerSynt bsr Ver_Expression Expression cmp.b 1(sp),d2 Meme type bne VerType move.l a6,VerPos(a5) cmp.w #_TkTo,(a6)+ To bne VerSynt bsr Ver_Expression Expression cmp.b 1(sp),d2 Meme type bne VerType cmp.w #_TkStp,(a6) Step? bne.s .Skip addq.l #2,a6 bsr Ver_Expression Expression cmp.b 1(sp),d2 Meme type bne VerType .Skip addq.l #2,sp OK! bra VerDP ; FOR / Passe 2 : cherche le NEXT ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ V2_For move.l a0,a1 move.w #1<>> Rien! moveq #0,d2 bra.s .j0 .j2 lea V2_ElsI(pc),a2 moveq #1,d2 move.l a6,d0 bra.s .j0 .j1 lea V2_Else(pc),a2 moveq #0,d2 move.l a6,d0 .j0 move.l a2,Vta_Jump(a0) ; Doke dans le source, en tenant compte des boucles... ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ V2_IfDoke exg a0,a1 move.l Vta_Prog(a0),a6 bsr Goto_Loops Verifie la validite du saut sub.l a6,d0 subq.l #2,d0 cmp.l #$10000,d0 bcc VerLong tst.w d2 beq.s .Skip bset #0,d0 .Skip move.w d0,(a6)+ rts ; ELSE IF / Passe 1 ; ~~~~~~~~~~~~~~~~~~~~~~~ V1_ElseIf lea VerElI(pc),a0 Else without If moveq #4,d1 moveq #1<>> Rien! moveq #0,d2 bra.s .j0 .j2 lea V2_ElsI(pc),a2 moveq #1,d2 move.l a6,d0 bra.s .j0 .j1 lea V2_Else(pc),a2 moveq #0,d2 move.l a6,d0 .j0 move.l a2,Vta_Jump(a0) bra V2_IfDoke ; ELSE Passe 1 ; ~~~~~~~~~~~~~~~~~~ V1_Else lea VerElI(pc),a0 Else without If moveq #8,d1 moveq #1<>> Pas d'erreur move.l Vta_Variable(a0),a6 Adresse de saut bsr Find_End moveq #0,d2 bra V2_IfDoke ; ENDIF Passe 1 ; ~~~~~~~~~~~~~~~~~~~ V1_EndI lea VerEIf(pc),a0 EndIf without If moveq #4,d1 moveq #1<>> met les flags ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ope_Math or.b #%00000011,MathFlags(a5) bra.s Ope_Normal ; Nouvelle fonction normale AMOSPro ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ope_ProNormal bsr SetNot1.3 ; Gestion d'un operande normal ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ope_Normal move.l a0,VerBase(a5) bsr Ver_DInst Pointe la definition move.w d0,d2 bsr VerF Va verifier ; Compute type in D2>>> float / integer ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ope_CheckType addq.l #2,sp moveq #0,d0 move.b d2,d0 sub.w #"0",d0 lsl.w #1,d0 jmp .jmp(pc,d0.w) .jmp rts 0 Entier bra.s .Float 1 Float rts 2 Chaine rts 3 Entier/Chaine ??? Impossible bra.s .Indif 4 Entier/Float .Math bset #1,MathFlags(a5) Angle (=math) .Float bset #0,MathFlags(a5) .Indif move.b #"0",d2 rts ; Gestion d'une variable reservee ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ope_VReservee move.l a0,VerBase(a5) bsr Ver_DInst Pointe la definition move.b (a0)+,d2 bsr VerF bra Ope_CheckType ; Operande deja teste +++ rapide (jamais une vreservee) ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ope_DejaTeste bsr Ver_DInst Pointe la definition move.w d0,d2 bsr VerF_DejaTeste Va verifier bra.s Ope_CheckType ; Une extension: toutes les possibilites ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ope_Extension move.b (a6)+,d1 move.l a6,-(sp) tst.b (a6)+ move.w (a6)+,d0 ext.w d1 lsl.w #2,d1 lea AdTokens(a5),a0 tst.l 0(a0,d1.w) beq VerExN move.l 0(a0,d1.w),a0 clr.w -(sp) Flag librairie 2.0 ou ancienne btst #LBF_20,LB_Flags(a0) Librarie 2.0? beq.s .Old move.w #-1,(sp) ; Verifie Fonction / Variable reservee, sans table! .Old move.l a0,VerBase(a5) Debut de tokenisation bsr Ver_OlDInst move.w d0,d2 cmp.b #"I",d2 beq VerSynt cmp.b #"V",d2 Variable r�servee bne.s .Skip move.b (a0)+,d2 .Skip bsr VerF Va verifier ; Poke le nombre de parametres tst.w (sp)+ Le flag move.l (sp)+,a0 Poke le nombre de params... beq.s .Old2 move.b #-1,(a0) Nouvelle extension: pas de params! bra Ope_CheckType .Old2 move.b d0,(a0) Ancienne extension: des params... bra Ope_CheckType ; Une instruction, essaie de trouver une fonction apres! ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ope_InstFonction move.l a0,VerBase(a5) lea 0(a0,d0.w),a0 .Loop0 move.l a0,d1 addq.l #4,a0 .Loop1 tst.b (a0)+ bpl.s .Loop1 move.b (a0)+,d2 cmp.b #"I",d2 bne.s .Ok .Loop2 tst.b (a0)+ bpl.s .Loop2 move.b -1(a0),d0 cmp.b #-3,d0 bne VerSynt move.w a0,d0 and.w #$0001,d0 add.w d0,a0 bra.s .Loop0 ; Trouve, change le token .Ok sub.l VerBase(a5),d1 move.w d1,-2(a6) bsr VerF bra Ope_CheckType ; Fin: une virgule avant---> ommis! ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ope_Fin1 cmp.w #_TkVir,-4(a6) bne VerSynt ; Fin, avec une virgule: le parametre est ommis ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ope_Fin2 subq.l #2,a6 moveq #"0",d2 tst.w (sp)+ bne VerSynt rts ; Ouverture d'un parenthese ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ope_Parenth addq.w #1,Parenth(a5) bsr Ver_REvalue addq.l #2,sp rts ; Variable en fonction ; ~~~~~~~~~~~~~~~~~~~~~~~~~~ Ope_Variable bsr V1_FVariable addq.l #2,sp rts ; Varptr(var) ; ~~~~~~~~~~~~~~~~~ Ope_Varptr cmp.w #_TkPar1,(a6)+ bne VerSynt cmp.w #_TkVar,(a6)+ bne VerSynt bsr V1_FVariable cmp.w #_TkPar2,(a6)+ bne VerSynt moveq #"0",d2 addq.l #2,sp rts ; Constante entiere ; ~~~~~~~~~~~~~~~~~~~~~~~ Ope_ConstEnt addq.l #4,a6 moveq #"0",d2 addq.l #2,sp rts ; Constante string ; ~~~~~~~~~~~~~~~~~~~~~~ Ope_ConstStr move.w (a6)+,d0 * Saute la chaine move.w d0,d1 and.w #$0001,d1 add.w d1,d0 lea 0(a6,d0.w),a6 moveq #"2",d2 addq.l #2,sp rts ; Constante float simple precision ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ope_ConstFl addq.l #4,a6 move.b #1,Ver_SPConst(a5) bset #0,MathFlags(a5) Flag: un peu de maths! moveq #"0",d2 addq.l #2,sp rts ; Constante float double precision ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ope_ConstDFl addq.l #8,a6 move.b #1,Ver_DPConst(a5) bset #0,MathFlags(a5) Flag: un peu de maths! bsr SetNot1.3 Non compatible! moveq #"0",d2 addq.l #2,sp rts ; =Array(a$()) ; ~~~~~~~~~~~~~~~~~~ Ope_Array bsr SetNot1.3 Non compatible ; =Match(a$()) ; ~~~~~~~~~~~~~~~~~~ Ope_Match move.l a6,-(sp) move.l a0,VerBase(a5) bsr Ver_DInst bsr VerF moveq #"0",d2 BUG, type= 0, entier! move.l (sp)+,a0 btst #6,5+2(a0) La variable est-elle un tableau? bne Ope_CheckType bra VerSynt ; =MIN / MAX ; ~~~~~~~~~~~~~~~~ Ope_MinMax cmp.w #_TkPar1,(a6)+ bne VerSynt move.w Parenth(a5),-(sp) bsr Ver_Expression move.w d2,-(sp) cmp.w #_TkVir,(a6)+ bne VerSynt bsr Ver_Evalue cmp.w #-1,Parenth(a5) bne VerSynt move.w (sp)+,d1 cmp.b d1,d2 bne VerType move.w (sp)+,Parenth(a5) addq.l #2,sp rts ; NOT ; ~~~~~~~~~ Ope_Not move.w Parenth(a5),-(sp) bsr Ver_Evalue tst.w Parenth(a5) bne VerSynt move.w (sp)+,Parenth(a5) cmp.b #"2",d2 beq VerType addq.l #2,sp rts ; = Fn AKJDKJS(k,d,d,d) ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~ V2_OpeFn tst.w -(sp) Ope_Fn cmp.w #_TkVar,(a6)+ bne VerSynt and.b #%00001111,3(a6) bset #3,3(a6) bsr VarA0 move.w d2,-(sp) bsr V1_StoVar bne VerNFn * Verifie les parametres cmp.w #_TkPar1,(a6) bne.s VerFn3 addq.l #2,a6 move.w Parenth(a5),-(sp) VerFn1 bsr Ver_Evalue tst.w Parenth(a5) bne.s VerFn2 cmp.w #_TkVir,(a6)+ beq.s VerFn1 bne VerSynt VerFn2 cmp.w #-1,Parenth(a5) bne VerSynt move.w (sp)+,Parenth(a5) * Ok! VerFn3 move.w (sp)+,d2 addq.w #2,sp moveq #0,d0 rts ; =XY MENU(,,) / =MENU(,,) ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ope_XYMn bsr VerTablo cmp.w #MnNDim,d0 bcc VerSynt moveq #"0",d2 addq.l #2,sp rts ; STRUC / STRUC$ ; ~~~~~~~~~~~~~~~~~~~~ Ope_Struc move.w Parenth(a5),-(sp) bsr VStru move.w (sp)+,Parenth(a5) cmp.b #7,d2 bcc VerType moveq #"0",d2 addq.l #2,sp rts Ope_StrucS move.w Parenth(a5),-(sp) bsr VStru move.w (sp)+,Parenth(a5) cmp.b #6,d2 bne VerType moveq #"2",d2 addq.l #2,sp rts ; Equates / LVO ; ~~~~~~~~~~~~~ Ope_Equ lea Equ_Nul(pc),a0 bra VEqu Ope_LVO lea Equ_LVO(pc),a0 VEqu move.l a6,a1 addq.l #6,a6 cmp.w #_TkPar1,(a6)+ bne VerSynt bsr Equ_Verif cmp.w #_TkPar2,(a6)+ bne VerSynt moveq #"0",d2 addq.l #2,sp rts ; Verification instruction deja testee ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ VerI_DejaTestee move.b (a0)+,d0 Un parametre? bmi.s .Ok .Loop move.l a0,-(sp) bsr Ver_Evalue Evaluation move.l (sp)+,a0 tst.b (a0)+ Un separateur? bmi.s .Ok addq.l #1,a0 Un autre parametre! addq.l #2,a6 Saute le separateur bra.s .Loop .Ok rts ; Verification d'une instruction standart ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; A0= Position dans la table de tokens ; A6= Instruction + 2 VerI: move.w d2,-(sp) pea -2(a6) * Adresse de l'instruction move.l a0,-(sp) clr.w -(sp) * Position dans definition clr.l -(sp) * Chaine SOURCE clr.l -(sp) clr.l -(sp) clr.l -(sp) clr.l -(sp) move.b #-1,(sp) move.w (a6),d0 * Fin ligne? bsr FinieB beq VerI6 * Compte les parametres VerI2: bsr Ver_Evalue move.w 20(sp),d0 move.b d2,0(sp,d0.w) move.b #-1,1(sp,d0.w) addq.w #1,d0 cmp.w #19,d0 bcs.s VerI3 subq.w #1,d0 VerI3: move.w d0,20(sp) tst.w Parenth(a5) bne VerSynt moveq #",",d2 move.w (a6),d1 cmp.w #_TkVir,d1 beq.s VerI4 moveq #"t",d2 cmp.w #_TkTo,d1 bne VerI6 VerI4: addq.l #2,a6 move.b d2,0(sp,d0.w) move.b #-1,1(sp,d0.w) addq.w #1,d0 cmp.w #19,d0 bcs.s VerI5 subq.w #1,d0 VerI5: move.w d0,20(sp) bra.s VerI2 * Compare la chaine cree aux parametres VerI6: bsr VerC * C'est bon: depile move.w 20(sp),d0 * Nombre de parametres! addq.w #1,d0 lsr.w #1,d0 lea 30(sp),sp move.w (sp)+,d2 rts ; Verification fonction deja testee ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ VerF_DejaTeste move.b (a0)+,d0 Un parametre? bmi.s .Fin move.w d2,-(sp) move.w Parenth(a5),-(sp) .Loop addq.l #2,a6 Parenth / Separateur move.l a0,-(sp) bsr Ver_Evalue Evaluation move.l (sp)+,a0 tst.b (a0)+ Un separateur? bmi.s .Ok addq.l #1,a0 Un autre parametre! bra.s .Loop .Ok move.w (sp)+,Parenth(a5) move.w (sp)+,d2 .Fin rts ; Verification d'une fonction standart ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ VerF: move.w d2,-(sp) move.w Parenth(a5),-(sp) pea -2(a6) * Adresse de l'instruction move.l a0,-(sp) * Adresse definition clr.w -(sp) * Position dans definition clr.l -(sp) * Chaine SOURCE clr.l -(sp) clr.l -(sp) clr.l -(sp) clr.l -(sp) move.b #-1,(sp) cmp.w #_TkPar1,(a6) bne Verf6 addq.l #2,a6 cmp.w #_TkPar2,(a6)+ beq Verf6 subq.l #2,a6 * Compte les parametres Verf2: bsr Ver_Evalue move.w 20(sp),d0 move.b d2,0(sp,d0.w) move.b #-1,1(sp,d0.w) addq.w #1,d0 cmp.w #19,d0 bcs.s Verf3 subq.w #1,d0 Verf3: move.w d0,20(sp) cmp.w #-1,Parenth(a5) beq.s Verf6 tst.w Parenth(a5) bne VerSynt moveq #",",d2 move.w (a6)+,d1 cmp.w #_TkVir,d1 beq.s Verf4 moveq #"t",d2 cmp.w #_TkTo,d1 bne VerSynt Verf4: move.b d2,0(sp,d0.w) move.b #-1,1(sp,d0.w) addq.w #1,d0 cmp.w #19,d0 bcs.s Verf5 subq.w #1,d0 Verf5: move.w d0,20(sp) bra.s Verf2 * Compare la chaine cree aux parametres Verf6: bsr VerC * C'est bon: depile et ramene le type move.w 20(sp),d0 addq.w #1,d0 lsr.w #1,d0 lea 30(sp),sp move.w (sp)+,Parenth(a5) move.w (sp)+,d2 rts ; Verification standart: compare la chaine cree aux parametres ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ VerC: move.l (sp)+,a2 * Adresse de retour lea (sp),a0 move.l 22(sp),a1 * Pas de definition: PROCEDURE! cmp.l #0,a1 beq VerCF * Pas de parametre? move.b (a1),d1 bpl.s VerC0 tst.b (a0) bmi.s VerCF bra.s VerC3 VerC0: tst.b (a0) bmi.s VerC3 * Explore les params VerC1: move.b (a1)+,d1 bmi.s VerC4 move.b (a0)+,d0 cmp.b #"3",d1 Indifferent? beq.s VerC1a cmp.b #"2",d1 Chaine beq.s .Comp moveq #"0",d1 Sinon, un chiffre! .Comp cmp.b d0,d1 bne VerType VerC1a: move.b (a0)+,d0 bmi.s VerC2 move.b (a1)+,d1 bmi.s VerC4 cmp.b d0,d1 beq.s VerC1 bra VerC3 VerC2: move.b (a1)+,d1 bpl.s VerC3 * OK! VerCF: jmp (a2) * Essaie les params suivants VerC3: move.b (a1)+,d1 bpl.s VerC3 VerC4: cmp.b #-2,d1 * Change le numero de l'instruction bne VerSynt move.l a1,d0 btst #0,d0 beq.s VerC5 addq.l #1,a1 addq.l #1,d0 VerC5: sub.l VerBase(a5),d0 move.l 26(sp),a0 move.w d0,(a0) addq.l #4,a1 VerC6: tst.b (a1)+ bpl.s VerC6 lea (sp),a0 cmp.b #"V",(a1)+ bne.s VerC1 addq.l #1,a1 bra.s VerC1 ; Pointe la liste des params d'une instruction ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ver_DInst: add.w d0,a0 move.b 2(a0),d0 ext.w d0 add.w d0,a0 move.b (a0)+,d0 bpl.s .Skip subq.l #1,a0 .Skip rts ; DInst, ancienne maniere ; ~~~~~~~~~~~~~~~~~~~~~~~ Ver_OlDInst lea 4(a0,d0.w),a0 .Loop tst.b (a0)+ bpl.s .Loop move.b (a0)+,d0 bpl.s .Skip subq.l #1,a0 .Skip rts ; Verification / Stockage des variables ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; Variable en INSTRUCTION: egalisation ou appel procedure ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ V1_IVariable move.w #_TkVar,-2(a6) Force le token and.b #%00001111,3(a6) RAZ du flag! bsr VarA0 moveq #0,d4 Pour CallProc cmp.w #_TkEg,(a0) Egal=> egalisation (!) beq.s .VVi1 cmp.w #_TkPar1,(a0) Une procedure! bne V1_CallProc ; Un tableau ; ~~~~~~~~~~ move.w d2,-(sp) bset #6,3(a6) Met le flag tableau! bsr V1_StoVar bne VerNDim bsr VerTablo Verifie les params d'un tableau cmp.b 4(a1),d0 bne VerIlP Illegal numbre of dimensions bra.s .VVi2 ; Une variable normale ; ~~~~~~~~~~~~~~~~~~~~ .VVi1 move.w d2,-(sp) bsr V1_StoVar ; Verifie l'expression ; ~~~~~~~~~~~~~~~~~~~~ .VVi2 cmp.w #_TkEg,(a6)+ bne VerSynt move.l a6,VerPos(a5) bsr Ver_Expression move.w (sp)+,d0 cmp.b d0,d2 bne VerType rts ; VARIABLE EN FONCTION ; ~~~~~~~~~~~~~~~~~~~~~~~~~~ V1_FVariable and.b #%00001111,3(a6) RAZ du flag bsr VarA0 cmp.w #_TkPar1,(a0) bne V1_StoVar bset #6,3(a6) Met le flag tableau! bsr V1_StoVar bne VerNDim bsr VerTablo Verifie les params d'un tableau cmp.b 4(a1),d0 bne VerIlP Illegal numbre of dimensions rts ; Routine, veut un appel de procedure ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ V1_GoProcedureParam moveq #1,d4 bra.s GoPro V1_GoProcedureNoParam moveq #0,d4 GoPro move.w (a6)+,d0 cmp.w #_TkPro,d0 beq.s V1_CallProc cmp.w #_TkVar,d0 bne VerSynt ; Appel de procedure ; ~~~~~~~~~~~~~~~~~~~~~~~~ V1_CallProc tst.w Direct(a5) bne VerIlD move.b #Reloc_Proc1,d0 Flag un appel de procedure bsr New_Reloc Force la relocation en V2 bsr VarA0 move.w #_TkPro,-2(a6) or.b #$80,3(a6) Change le flag move.l a0,a6 ; Saute les params move.l a6,VerPos(a5) cmp.w #_TkBra1,(a6) bne.s .NopA tst.w d4 bne VerSynt .Loop addq.l #2,a6 bsr Ver_Expression move.b #Reloc_Proc2,d0 bsr New_Reloc move.b d2,d0 Stocke dans la table de relocation bsr Out_Reloc cmp.w #_TkVir,(a6) beq.s .Loop move.l a6,VerPos(a5) cmp.w #_TkBra2,(a6)+ bne VerSynt move.b #Reloc_Proc3,d0 bsr New_Reloc .Out rts .NopA move.b #Reloc_Proc4,d0 bsr New_Reloc rts ; Appel de procedure passe2, premiere etape ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ V2_CallProc1 move.l a6,VerPos(a5) moveq #0,d0 Retrouve le label bsr V2_FindLabelP beq VerUndP move.l d0,a3 lea 12(a3),a3 move.b 2(a3),d0 ext.w d0 lea 4(a3,d0.w),a3 Pointe le debut de la procedure cmp.w #_TkBra1,(a3)+ beq.s .Skip sub.l a3,a3 .Skip rts ; Appel de procedure passe2, pas de parametre ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ V2_CallProc4 move.l a3,d0 bne VerIlP rts ; Appel de procedure passe2, deuxieme etape ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ V2_CallProc2 move.l a3,d0 beq VerIlP move.l a6,VerPos(a5) cmp.w #_TkBra2,(a3) beq VerIlP cmp.w #_TkVir,(a3) bne.s .Sko addq.l #2,a3 .Sko move.b 5(a3),d1 and.w #$0F,d1 cmp.w #1,d1 bne.s .Skip moveq #0,d1 .Skip add.b #"0",d1 cmp.b (a4)+,d1 bne VerType move.b 4(a3),d0 ext.w d0 lea 6(a3,d0.w),a3 rts ; Appel de procedure passe3, derniere etape ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ V2_CallProc3 move.l a6,VerPos(a5) cmp.w #_TkBra2,(a3) bne VerIlP rts ; Stockage des labels ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; Verification d'un label / Expression ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ V1_GoLabel move.w (a6),d0 cmp.w #_TkLGo,d0 bne.s .Skip move.w #_TkVar,d0 move.w d0,(a6) .Skip cmp.w #_TkVar,d0 bne.s .Expr move.b 5(a6),d2 and.b #$0F,d2 bne.s .Expr ; Est-ce REEELEMENT un label? ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~ move.b 4(a6),d0 ext.w d0 lea 6(a6,d0.w),a0 move.w (a0),d0 beq.s .Label cmp.w #_TkVir,d0 beq.s .Label bsr FinieB bne.s .Expr ; C'est un label GOTO! Change le token! ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .Label move.w #_TkLGo,(a6)+ move.b #Reloc_Label,d0 Un label bsr New_Reloc Relocation en passe2 move.l a0,a6 rts ; C'est une expression: va evaluer! ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .Expr bsr Ver_Evalue rts ; Retourne en D0 l'adresse d'un label, si vrai label ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ V2_GoLabel cmp.w #_TkLGo,(a6)+ bne.s .Nul move.w (a6)+,d0 move.l LabHaut(a5),a0 move.b (a6),d1 ext.w d1 lea 2(a6,d1.w),a6 move.l 0(a0,d0.w),d0 rts .Nul moveq #0,d0 rts ; STOCKAGE D'UN LABEL / PASSE 1 ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ V1_StockLabel move.w Phase(a5),d0 bsr Get_Label bne VerLb2 ; Cree le label ; ~~~~~~~~~~~~~ move.w d1,d3 move.l LabBas(a5),a0 Baisse le bas des labels subq.l #8,a0 sub.w d1,a0 cmp.l LabMini(a5),a0 Attention aux boucles bcs VerVNm move.l a0,LabBas(a5) move.l a0,a2 move.l d0,(a0)+ Longueur / Flags / Phase lea 4(a6),a1 addq.l #4,a0 lsr.w #1,d3 Copie le nom subq.w #1,d3 .N1 move.w (a1)+,(a0)+ dbra d3,.N1 lea 4(a6,d1.w),a6 Saute le label move.l a6,a0 Trouve l'adresse de saut tst.w (a0) bne.s .N2 tst.w 2(a0) Pointe la ligne suivante si on peut beq.s .N2 addq.l #4,a0 .N2 move.l a0,4(a2) Poke l'adresse, A2= pointeur rts ; STOCKAGE LABEL PASSE 2 : essaie de retrouver le label ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ V2_FindLabel move.w Phase(a5),d0 Niveau de procedure V2_FindLabelP bsr Get_Label Va chercher beq.s .NFnd ; Label trouve, LOKE dans le listing / saute le label ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ move.l a0,a2 addq.l #4,a0 sub.l LabHaut(a5),a0 move.w a0,(a6) move.l 4(a2),d0 .NFnd rts ; Routine: retrouve un label dans la liste. D0=Phase ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Get_Label move.b 3(a6),d2 Flag moveq #0,d1 move.b 2(a6),d1 Longueur du nom swap d0 move.b d1,d0 lsl.w #8,d0 move.b d2,d0 swap d0 ; Boucle de recherche + rapide ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ move.l LabBas(a5),a0 moveq #0,d3 move.b (a0),d3 beq.s .Nouvo .Loop cmp.l (a0),d0 beq.s .Test .Loop2 lea 8(a0,d3.w),a0 move.b (a0),d3 bne.s .Loop bra.s .Nouvo .Test lea 4(a6),a1 lea 8(a0),a2 move.w d3,d4 lsr.w #1,d4 subq.w #1,d4 .Test2 cmp.w (a1)+,(a2)+ dbne d4,.Test2 tst.w d4 bpl.s .Loop2 move.w #%00000,CCR BNE: trouve, A0=adresse rts .Nouvo move.w #%00100,CCR BEQ: pas trouve rts ******* ENLEVE TOUS LES FLAGS VARIABLE GLOBALE! Locale: move.l DVNmBas(a5),a0 bra.s LoK2 LoK1: ext.w d0 cmp.b #2,5(a0) beq.s LoK0 clr.b 5(a0) LoK0: lea 6(a0,d0.w),a0 LoK2: move.b (a0),d0 bne.s LoK1 rts ******* MET TOUS LES FLAGS VARIABLE GLOBALE! Globale:move.l DVNmBas(a5),a0 bra.s GlK2 GlK1: ext.w d0 move.b #1,5(a0) lea 6(a0,d0.w),a0 GlK2: move.b (a0),d0 bne.s GlK1 rts ; STOCKAGE VARIABLE PASSE 1 ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ V1_StoVar movem.l d2/d3/a3/a4,-(sp) lea 4(a6),a0 * Pointe le nom move.l a0,d0 move.b 2(a6),d1 ext.w d1 * Longueur variable move.b 3(a6),d2 * Flag move.l a6,a3 tst.w Phase(a5) beq.s StV1 ; Essaie de trouver les variables globales ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ move.l DVNmBas(a5),a4 * Prend les noms GLOBAUX move.l a4,a1 StV1a: move.l a1,a2 move.b (a1),d3 beq.s StV1 ext.w d3 tst.b 5(a1) beq.s StV1n cmp.w d1,d3 bne.s StV1n cmp.b 1(a1),d2 bne.s StV1n move.w d3,d4 lsr.w #1,d4 subq.w #1,d4 addq.w #6,a1 move.l d0,a0 StV1b: cmp.w (a0)+,(a1)+ bne.s StV1n dbra d4,StV1b move.l a2,a1 * Ramene l'adresse variable move.l a2,d0 sub.l DVNmHaut(a5),d0 * Offset / Table variables neg.w d0 * >0===> GLOBALES! move.w d0,(a6) moveq #0,d0 * Deja existante bra Rn1VFin * Va terminer StV1n: lea 6(a2,d3.w),a1 bra.s StV1a ; Trouve la variable LOCALE! ; ~~~~~~~~~~~~~~~~~~~~~~~~~~ StV1: move.l VNmBas(a5),a4 move.l a4,a1 Rn1Va: move.l d0,a0 move.l a1,a2 move.b (a1)+,d3 beq.s Rn1Vx ext.w d3 cmp.b d1,d3 * Longueur egale? bne.s Rn1Vn cmp.b (a1)+,d2 * Flag egal? bne.s Rn1Vn tst.w (a1)+ * Saute DIVERS move.w d3,d4 lsr.w #1,d4 subq.w #1,d4 addq.w #2,a1 Rn1Vb: cmp.w (a0)+,(a1)+ bne.s Rn1Vn dbra d4,Rn1Vb moveq #0,d0 * Variable deja existante bra.s Rn1Vz ; Passe a la variable suivante ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Rn1Vn: lea 6(a2,d3.w),a1 bra.s Rn1Va ; Cree la variable ; ~~~~~~~~~~~~~~~~ Rn1Vx: lea -6(a4),a2 sub.w d1,a2 cmp.l VNmMini(a5),a2 bcs VerNmO move.l a2,VNmBas(a5) move.l a2,a1 move.b d1,(a1)+ * Poke la longueur move.b d2,(a1)+ * Poke le flag move.w VarLong(a5),(a1)+ * Pointeur clr.w (a1)+ * Variables Locale-Non dim addq.w #6,VarLong(a5) * Place pour le type ; Si float DP, non tableau: variable sur 10 octets... cmp.b #1,d2 bne.s .Skip tst.b MathFlags(a5) bpl.s .Skip addq.w #4,VarLong(a5) .Skip move.w d1,d3 lsr.w #1,d3 subq.w #1,d3 move.l d0,a0 Rn1Vy: move.w (a0)+,(a1)+ dbra d3,Rn1Vy moveq #-1,d0 * Variable nouvelle! ; Variable trouvee ; ~~~~~~~~~~~~~~~~ Rn1Vz: move.l a2,a1 * Ramene l'adresse variable sub.l VNmHaut(a5),a2 * Offset / Table variables move.w a2,(a6) ; Force la relocation en passe 2 ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Rn1VFin movem.l (sp)+,d2/d3/a3/a4 move.w d0,-(sp) move.b #Reloc_Var,d0 bsr New_Reloc * Nouvelle relocation lea 4(a6,d1.w),a6 * Saute la variable tst.w (sp)+ * Positionne le flag rts ; STOCKAGE VARIABLE DEUXIEME PASSE: retrouve l'adresse ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ V2_StoVar lea 4(a6),a0 * Pointe le nom move.b 2(a6),d1 ext.w d1 * Longueur variable move.w (a6),d3 bpl.s .Skip ; DOKE le pointeur, variable locale (<0!) ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ move.l VNmHaut(a5),a1 lea 0(a1,d3.w),a1 move.w 2(a1),(a6) bra.s .Out ; Variable GLOBALE (>0!) ; ~~~~~~~~~~~~~~~~~~~~~~ .Skip neg.w d3 move.l DVNmHaut(a5),a1 lea 0(a1,d3.w),a1 move.w 2(a1),d0 addq.w #1,d0 neg.w d0 move.w d0,(a6) .Out rts ; Saute le nom d'une variable / A0 ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ VarA0: lea 2(a6),a0 move.b (a0)+,d1 ext.w d1 move.b (a0)+,d3 move.b d3,d0 moveq #"0",d2 and.b #%111,d0 beq.s .Skip cmp.b #1,d0 beq.s .Skip moveq #"2",d2 .Skip add.w d1,a0 rts ; Verifie les params d'un tableau ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ VerTablo move.w d2,-(sp) move.l a1,-(sp) move.l a6,VerPos(a5) cmp.w #_TkPar1,(a6)+ bne VerSynt move.w Parenth(a5),-(sp) clr.w -(sp) .VTab move.l a6,VerPos(a5) addq.w #1,(sp) bsr Ver_Evalue Verifie les parametres cmp.b #"0",d2 bne VerType tst.w Parenth(a5) bne.s .VTab1 cmp.w #_TkVir,(a6)+ beq.s .VTab bne VerSynt .VTab1 cmp.w #-1,Parenth(a5) bne VerSynt move.w (sp)+,d0 Nombre de dimensions move.w (sp)+,Parenth(a5) move.l (sp)+,a1 move.w (sp)+,d2 rts ; Initialisation de la table de relocation ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Reserve_Reloc bsr Free_Reloc lea Ver_Reloc(a5),a0 move.l a0,Ver_CReloc(a5) clr.l Ver_FReloc(a5) clr.b Ver_NoReloc(a5) sub.l a4,a4 rts ; Efface les buffers de relocation ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Free_Reloc move.l Ver_Reloc(a5),d2 beq.s .Out .Loop move.l d2,a1 move.l (a1),d2 move.l #Reloc_Step,d0 SyCall MemFree tst.l d2 bne.s .Loop .Out clr.l Ver_Reloc(a5) clr.l Ver_FReloc(a5) rts ; Poke le pointeur actuel dans la table de relocation ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ New_Reloc tst.b Ver_NoReloc(a5) Relocation autorisee??? bne.s .Out cmp.l Ver_FReloc(a5),a4 Sorti de la table? bcc.s .NewBuf move.l d0,-(sp) move.l a6,d0 sub.l a3,d0 beq.s .ReJ5 bls.s .Bug .ReJ1 cmp.l #254,d0 bls.s .ReJ4 cmp.l #254*3,d0 bls.s .ReJ3 cmp.l #65534,d0 bls.s .ReJ2 ; >65534 move.b #Reloc_Long,(a4)+ move.b #$FF,(a4)+ move.b #$FE,(a4)+ sub.l #65534,d0 bra.s .ReJ1 ; >254*3 <65536 .ReJ2 move.b #Reloc_Long,(a4)+ move.b d0,1(a4) ror.w #8,d0 move.b d0,(a4) addq.l #2,a4 bra.s .ReJ5 ; >254 <254*3 .ReJ3 move.b #127,(a4)+ sub.l #254,d0 bra.s .ReJ1 ; <254 .ReJ4 lsr.w #1,d0 move.b d0,(a4)+ ; Fini .ReJ5 move.l a6,a3 move.l (sp)+,d0 move.b d0,(a4)+ .Out rts .Bug illegal ; Nouveau buffer de relocation ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .NewBuf tst.l Ver_FReloc(a5) Premiere table? beq.s .Init move.b #Reloc_NewBuffer,(a4)+ Code de changement .Init movem.l a0/a1/d0/d1,-(sp) move.l #Reloc_Step,d0 SyCall MemFastClear beq VerOut move.l Ver_CReloc(a5),a1 move.l a0,(a1) move.l a0,Ver_CReloc(a5) move.l a0,a4 clr.l (a4)+ lea Reloc_Step-32(a0),a0 move.l a0,Ver_FReloc(a5) movem.l (sp)+,a0/a1/d0/d1 bra New_Reloc ; Simple sortie d'un chiffre ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Out_Reloc tst.b Ver_NoReloc(a5) Relocation autorisee??? bne.s .Out move.b d0,(a4)+ .Out rts ******* SHARED a,b() ******* Routine SHARED: cree les variables VpSha: addq.l #2,a6 VpSha1: bsr VpGv cmp.w #_TkVir,(a6)+ beq.s VpSha1 move.w -(a6),d0 move.l a6,VerPos(a5) tst.w d0 bne VerSynt rts * Verification des variables VpGv: move.l a6,VerPos(a5) cmp.w #_TkVar,(a6)+ bne VerSynt * Premiere passe and.b #%00001111,3(a6) bsr VarA0 cmp.w #_TkPar1,(a0) bne V1_StoVar cmp.w #_TkPar2,2(a0) bne VerNoPa lea 4(a0),a6 rts ******* Verification proprement dite VerSha bset #0,VarBufFlg(a5) subq.l #2,a6 tst.w Direct(a5) bne VerIlD * GLOBAL: Cree les variables move.l DVNmBas(a5),-(sp) tst.w Phase(a5) bne VSh0a move.l a6,-(sp) bsr VpSha move.l (sp)+,a6 move.l VNmBas(a5),(sp) * Ok! verifie VSh0a: addq.l #2,a6 * Passe 1 VSh1a: move.l a6,VerPos(a5) cmp.w #_TkVar,(a6)+ bne VerSynt lea 4(a6),a0 * Pointe le nom move.l a0,d0 move.b 2(a6),d1 ext.w d1 * Longueur variable and.b #%00001111,3(a6) move.b 3(a6),d2 * Flag lea 4(a6,d1.w),a6 cmp.w #_TkPar1,(a6) bne.s Sh1d bset #6,d2 bset #6,-1(a0) cmp.w #_TkPar2,2(a6) bne VerNoPa addq.l #4,a6 * Cherche la variable dans les variables globales Sh1d: move.l (sp),a1 Sh1a: move.l a1,a2 move.b (a1),d3 beq VerNDim * PaG * Pas une variable GLOBALE! ext.w d3 cmp.w d1,d3 bne.s Sh1n cmp.b 1(a1),d2 bne.s Sh1n move.w d3,d4 lsr.w #1,d4 subq.w #1,d4 addq.w #6,a1 move.l d0,a0 Sh1b: cmp.w (a0)+,(a1)+ bne.s Sh1n dbra d4,Sh1b cmp.b #2,5(a2) * Already GLOBALE! beq.s Sh1c move.b #1,5(a2) * Marque la variable tst.w Phase(a5) bne.s Sh1c addq.b #1,5(a2) * Devient globale! bra.s Sh1c Sh1n: lea 6(a2,d3.w),a1 bra.s Sh1a * Une autre variable? Sh1c: move.w (a6)+,d0 cmp.w #_TkVir,d0 beq VSh1a addq.l #4,sp tst.w d0 bne VerShal bra VerD *********************************************************** ******* Instruction finie?? Finie: move.w (a6),d0 FinieB: beq.s Finy cmp.w #_TkDP,d0 beq.s Finy cmp.w #_TkThen,d0 beq.s Finy cmp.w #_TkElse,d0 Finy: rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; NETTOYAGES DES VARIABLES ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ClearVar ; - - - - - - - - - - - - - movem.l d0-d7/a0-a6,-(sp) ; Variables du programme ; ~~~~~~~~~~~~~~~~~~~~~~ lea DebRaz(a5),a0 lea FinRaz(a5),a1 ClV1: clr.w (a0)+ cmp.l a1,a0 bcs.s ClV1 clr.b Test_Flags(a5) ; Initialisation du disque ; ~~~~~~~~~~~~~~~~~~~~~~~~ move.l #$FFFFFFFF,IffMask(a5) moveq #47,d0 JJsr L_Sys_GetMessage move.l DirFNeg(a5),a1 ClV2: move.b (a0)+,(a1)+ bne.s ClV2 move.w PI_DirSize(a5),DirLNom(a5) clr.l T_ClLast(a5) move.w #$0A0D,ChrInp(a5) ; DREG/AREG ; ~~~~~~~~~ lea CallReg(a5),a0 move.l a5,(8+5)*4(a0) * A5-> Datazone move.l T_ClAsc(a5),(8+4)*4(a0) * A4-> Clavier actuel move.l Prg_Source(a5),(8+3)*4(a0) * A3-> Bas du programme move.l T_RastPort(a5),(8+0)*4(a0) * A0-> Rastport move.l DosBase(a5),7*4(a0) * D7-> Dos Base move.l T_GfxBase(a5),6*4(a0) * D6-> Gfx Base move.l T_IntBase(a5),5*4(a0) * D5-> Int Base move.l BasSp(a5),4*4(a0) * D4-> BasSp lea Ed_Config(a5),a1 * D3-> Configuration Base Editor move.l a1,3*4(a0) ; Ferme toutes les routines appellees ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ lea Sys_ClearRoutines(a5),a1 SyCall CallRoutines ; Initialisations diverses ; ~~~~~~~~~~~~~~~~~~~~~~~~ JJsr L_Bnk.EffTemp JJsr L_Bnk.Change JJsr L_MenuReset JJsr L_Dia_WarmInit ; Plus de buffers! ; ~~~~~~~~~~~~~~~~ bsr ClearBuffers ; Init float ; ~~~~~~~~~~ move.w #-1,FixFlg(a5) clr.w ExpFlg(a5) movem.l (sp)+,d0-d7/a0-a6 rts ; Nettoie tous les buffers ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ClearBuffers moveq #0,d1 bsr ResVarBuf clr.w VarBufFlg(a5) moveq #0,d1 bsr ResVNom clr.w Stack_Size(a5) bsr Stack_Reserve rts ; Reservation de la memoire pour la pile ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Stack_Reserve move.w Stack_CSize(a5),d0 cmp.w Stack_Size(a5),d0 beq.s .Ok tst.w d0 beq.s .NoFree clr.w Stack_CSize(a5) addq.w #1,d0 mulu #Stack_ProcSize,d0 move.l BaLoop(a5),a1 SyCall MemFree .NoFree move.w Stack_Size(a5),d0 beq.s .Ok move.w d0,Stack_CSize(a5) addq.w #1,d0 mulu #Stack_ProcSize,d0 move.l d0,d1 SyCall MemFastClear beq .Out move.l a0,BaLoop(a5) add.l d1,a0 move.l a0,HoLoop(a5) .Ok move.w Stack_CSize(a5),d0 rts .Out moveq #0,d0 rts ; RESERVE DE L'ESPACE POUR LES VARIABLES DIRECTES ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ResDir: movem.l d0/d1/a0,-(sp) tst.w TVMax(a5) bne.s RsD3 move.l TabBas(a5),d1 move.l d1,a0 sub.l HiChaine(a5),d1 bcs.s RsD3 moveq #0,d0 move.w PI_TVDirect(a5),d0 cmp.l d1,d0 bls.s RsD1 move.l d1,d0 RsD1: divu #6,d0 mulu #6,d0 subq.l #6,d0 beq.s RsD3 move.l VarLoc(a5),-(a0) move.w #$FFFF,-(a0) sub.l d0,a0 move.l a0,VarLoc(a5) move.l a0,TabBas(a5) move.w d0,TVMax(a5) lsr.w #1,d0 subq.w #1,d0 bmi.s RsD3 RsD2: clr.w (a0)+ dbra d0,RsD2 RsD3: movem.l (sp)+,d0/d1/a0 rts ; Reserve le buffer chaines / variables ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; D1= Taille ResVarBuf move.l VarBuf(a5),d0 beq.s Vbr1 clr.l VarBuf(a5) move.l d0,a1 move.l VarBufL(a5),d0 SyCall MemFree Vbr1 move.l d1,d0 beq.s Vbr2 SyCall MemFastClear beq VerOut move.l a0,VarBuf(a5) lea 0(a0,d1.l),a1 * Adresses dans ce buffer move.l a1,LabHaut(a5) clr.w -(a1) move.l a1,LabBas(a5) clr.l -(a1) move.w #-1,-(a1) move.l a1,VarGlo(a5) move.l a1,TabBas(a5) move.l a1,VarLoc(a5) * Chaines move.l a0,LoChaine(a5) move.l a0,ChVide(a5) move.l a0,ParamC(a5) clr.w (a0)+ move.l a0,HiChaine(a5) move.l a0,LabMini(a5) * Fini! Vbr2 clr.w VarLong(a5) clr.w GloLong(a5) clr.w TVMax(a5) move.l d1,VarBufL(a5) rts ; Reserve le buffer des noms de variable ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; D1= taille ResVNom move.l VNmMini(a5),d0 beq.s RVn1 clr.l VNmMini(a5) move.l d0,a1 move.l VNmLong(a5),d0 clr.l VNmLong(a5) SyCall MemFree RVn1 move.l d1,d0 beq.s RVn2 SyCall MemFastClear beq VerOut move.l a0,VNmMini(a5) move.l d1,VNmLong(a5) add.l d1,a0 move.l a0,DVNmHaut(a5) clr.w -(a0) move.l a0,DVNmBas(a5) move.l a0,VNmHaut(a5) clr.w -(a0) move.l a0,VNmBas(a5) RVn2 rts ; Inclus les INCLUDES dans le programme courant ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Get_Includes ; Efface d'eventuels anciens bsr Includes_Clear ; Demande un buffer lea Prg_Includes(a5),a0 move.l #20*16,d0 move.l #Public|Clear,d1 bsr A5_Reserve beq .XX move.l a0,a3 ; Explore le d�but move.l Prg_Source(a5),a0 move.l a0,(a3) moveq #0,d6 moveq #0,d7 moveq #0,d0 bsr Tk_FindL beq .Inclus .Incl1 cmp.w #_TkIncl,2(a0) beq.s .Inclu bsr Tk_FindN bne.s .Incl1 bra .Inclus ; Une inclusion .Inclu bsr SetNot1.3 Non compatible! addq.w #1,d7 move.l a0,d0 sub.l (a3),d0 move.l a0,(a3) add.l d0,d6 move.l d0,4(a3) ; Ouvre le fichier, sauve le lock cmp.w #_TkCh1,4(a0) bne .SErr lea 6(a0),a0 move.w (a0)+,d0 subq.w #1,d0 bmi .SErr cmp.w #107,d0 bcc .SErr move.l Name1(a5),a1 .Incl2 move.b (a0)+,(a1)+ dbra d0,.Incl2 clr.b (a1) move.l #1005,d2 jsr D_Open beq .DErr ; Verifie entete, prend la taille du source move.l Buffer(a5),d2 moveq #16+4,d3 jsr D_Read bne .DErr move.l d2,a2 move.l d2,a1 Entete AMOSPRO lea H_Pro(pc),a0 moveq #8-1,d0 .Ver1 cmp.b (a0)+,(a1)+ bne .13 dbra d0,.Ver1 bra.s .Ver3 .13 move.l d2,a1 Entete AMOS1.3 lea H_1.3(pc),a0 moveq #10-1,d0 .Ver2 cmp.b (a0)+,(a1)+ bne .AErr dbra d0,.Ver2 .Ver3 add.l 16(a2),d6 Taille du source move.l 16(a2),12(a3) move.l Handle(a5),8(a3) Sauve le lock clr.l Handle(a5) ; Reprend le cours move.l (a3),a0 bsr Tk_FindN move.l a0,d0 sub.l (a3),d0 move.l d0,16(a3) lea 20(a3),a3 move.l a0,(a3) bra .Incl1 ; Reserve le buffer / Charge les programmes ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .Inclus move.l a0,d0 sub.l (a3),d0 move.l a0,(a3) move.l d0,4(a3) tst.w d7 beq .PaIncl add.l d6,d0 Taille du dernier incluse addq.l #4,d0 move.l #Public,d1 lea Prg_FullSource(a5),a0 bsr A5_Reserve beq .MErr move.l a0,a2 move.l Prg_Includes(a5),a3 move.l Prg_Source(a5),a4 ; Copie le programme .Copy move.l 4(a3),d0 lsr.l #1,d0 beq.s .Copf .Cop move.w (a4)+,(a2)+ subq.l #1,d0 bne.s .Cop .Copf ; Charge le chunk move.l 8(a3),Handle(a5) beq.s .X move.l a2,d2 move.l 12(a3),d3 jsr D_Read bne .DErr add.l d0,a2 jsr D_Close clr.l 8(a3) ; Le suivant! add.l 16(a3),a4 Saute le INCLUDE lea 20(a3),a3 Suivant bra.s .Copy ; Fini .X clr.l (a2)+ .XX rts ; Pas d'include ; ~~~~~~~~~~~~~ .PaIncl bsr Includes_Clear rts ; Erreur dans les includes ; ~~~~~~~~~~~~~~~~~~~~~~~~ .MErr moveq #36,d0 bra.s .Err .DErr moveq #45,d0 bra.s .Err .AErr moveq #46,d0 bra.s .Err .SErr moveq #35,d0 .Err move.l d0,-(sp) move.l (a3),VerPos(a5) ; Ferme tous les fichiers jsr D_Close move.l Prg_Includes(a5),a3 .Clo move.l 8(a3),d0 beq.s .Nx clr.l 8(a3) move.l d0,Handle(a5) jsr D_Close .Nx lea 20(a3),a3 subq.w #1,d7 bne.s .Clo ; Efface les zones bsr Includes_Clear ; Erreur! move.l (sp)+,d0 bra VerErr ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; INCLUDES ET FIN DE PROGRAMME ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Effacement des buffers includes / Retour � la normale ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Includes_Clear movem.l a0-a1/d0-d1,-(sp) lea Prg_FullSource(a5),a0 bsr A5_Free lea Prg_Includes(a5),a0 bsr A5_Free movem.l (sp)+,a0-a1/d0-d1 rts ; Transforme une adresse FullSource (eventuellement) en adresse Source ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Includes_Adr movem.l a1/d0-d1,-(sp) move.l Prg_Includes(a5),d1 beq.s .Out move.l d1,a1 lea -20(a1),a1 sub.l Prg_FullSource(a5),a0 moveq #0,d1 moveq #0,d2 ; Chunk de source .Loop lea 20(a1),a1 add.l 4(a1),d2 Longueur de source cmp.l d2,a0 bcs.s .Source ; Chunk d'include tst.l 12(a1) beq.s .Out add.l 12(a1),d1 A soustraire au source sub.l 16(a1),d1 Sans l'include lui meme add.l 12(a1),d2 cmp.l d2,a0 bcc.s .Loop ; Dans un include move.l (a1),a0 bra.s .Out ; Dans le source .Source sub.l d1,a0 add.l Prg_Source(a5),a0 ; Sortie .Out movem.l (sp)+,a1/d0-d1 rts Equ_LVO dc.b 10,"_LVO",0 Equ_Nul dc.b 10,0 even ; __________________________________________________________________________ ; ; CHARGEMENTS / SAUVEGARDE PROGRAMMES ; __________________________________________________________________________ ; ; Entete AMOS Basic ; ~~~~~~~~~~~~~~~~~ H_1.3 dc.b "AMOS Basic v134 " H_Pro dc.b "AMOS Pro101v",0,0,0,0 even ; ___________________________________________________________________ ; ; RUN programme general (A6) ; ; D0= 0:Normal / 1:Accessoire / -1:PRUN ; A1= Adresse Errors ; A2= Patches lors du test ; ___________________________________________________________________ ; Prg_RunIt movem.l a2-a6/d2-d7,-(sp) move.w d0,d2 ; Deja en route? ; ~~~~~~~~~~~~~~ bsr Prg_DejaRunned bne .Deja ; Sauve les donnees courantes ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~ bsr Prg_Push bne .Omm ; Va tester le programme ; ~~~~~~~~~~~~~~~~~~~~~~ move.l a1,Prg_JError(a5) bsr Prg_SetBanks Banques courantes JJsr L_Bnk.Change Envoie aux trappes clr.b Prg_Not1.3(a6) Non compatible au depart move.l a2,d0 Premier affichage beq.s .Skip1 jsr (a2) .Skip1 bsr ClearVar Plus de variables bsr PTest Tests clr.b Prg_StModif(a6) Programme teste! move.b VerNot1.3(a5),Prg_Not1.3(a6) Stocke la comptibilite move.b MathFlags(a5),Prg_MathFlags(a6) Double precision move.l a2,d0 Deuxieme affichage beq.s .Skip2 jsr 4(a2) ; Initialisation graphique ; ~~~~~~~~~~~~~~~~~~~~~~~~ .Skip2 tst.w d2 Un accessoire beq.s .Nor bmi.s .PRun ; Accessoire tst.b Prg_Accessory(a5) Vraiment un accessoire? beq.s .Nor ; PRun .PRun JJsr L_DefRunAcc JJsr L_ReCop JJsr L_WOption AMOS en premier s'il faut! JJmp L_New_ChrGet ; Programme normal .Nor move.w #-1,DefFlag(a5) Non, programme normal JJsr L_DefRun1 move.l a2,d0 beq.s .Skip3 jsr 8(a2) .Skip3 JJsr L_DefRun2 JJsr L_ReCop EcCalD Active,0 clr.b Prg_Accessory(a5) JJsr L_WOption AMOS en premier s'il faut! JJmp L_New_ChrGet ; Out of memory ; ~~~~~~~~~~~~~ .Omm moveq #0,d0 bra.s .Out ; Deja runned ; ~~~~~~~~~~~ .Deja moveq #-1,d0 .Out movem.l (sp)+,a2-a6/d2-d7 rts ; ___________________________________________________________________ ; ; TEST programme general (A6) ; ; A1= Adresse Errors ; A2= Patches lors du test ; ___________________________________________________________________ ; Prg_TestIt movem.l a2-a6/d2-d7,-(sp) move.w d0,d2 ; Deja en route? ; ~~~~~~~~~~~~~~ bsr Prg_DejaRunned bne.s .Deja ; Sauve les donnees courantes ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~ bsr Prg_Push bne .Omm ; Va tester le programme ; ~~~~~~~~~~~~~~~~~~~~~~ move.l a1,Prg_JError(a5) bsr Prg_SetBanks clr.b Prg_Not1.3(a6) Non compatible au depart move.l a2,d0 Premier affichage beq.s .Skip1 jsr (a2) .Skip1 bsr ClearVar Plus de variables bsr PTest Tests clr.b Prg_StModif(a6) Programme teste! move.b VerNot1.3(a5),Prg_Not1.3(a6) Stocke la compatibilite move.b MathFlags(a5),Prg_MathFlags(a6) Double precision move.l a2,d0 Deuxieme affichage beq.s .Skip2 jsr 4(a2) .Skip2 ; Depile le programme ; ~~~~~~~~~~~~~~~~~~~ bsr Prg_Pull moveq #0,d0 .Out movem.l (sp)+,a2-a6/d2-d7 rts ; Deja runned ; ~~~~~~~~~~~ .Deja moveq #-1,d0 bra.s .Out ; Out of memory ; ~~~~~~~~~~~~~ .Omm moveq #0,d0 bra.s .Out ; ; Regarde si le programme A6 est deja RUNNE! ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Prg_DejaRunned movem.l a0-a1/d0-d1,-(sp) move.l Prg_Runned(a5),d0 beq.s .Ok .DejaL move.l d0,a0 cmp.l a0,a6 beq.s .Deja move.l Prg_Previous(a0),d0 bne.s .DejaL .Ok moveq #0,d0 bra.s .Out .Deja moveq #-1,d0 .Out movem.l (sp)+,a0-a1/d0-d1 rts ; ; STOCKAGE DES DONNEES DU PROGRAMME A6 ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; Prg_Push movem.l a0-a4/a6/d1-d7,-(sp) move.l Prg_Runned(a5),d0 move.l a6,Prg_Runned(a5) move.l d0,Prg_Previous(a6) beq .Ok ; Programme en route, stocke les donn�es pour les programmes suivants ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ move.l Prg_Previous(a6),a0 lea Prg_RunData(a0),a0 bsr Prg_DataSave beq .Err ; Prepare le nouveau programme ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ bsr Prg_DataNew ; Pas d'erreur ; ~~~~~~~~~~~~ .Ok moveq #0,d0 .Out movem.l (sp)+,a0-a4/a6/d1-d7 rts ; Out of mem ; ~~~~~~~~~~ .Err move.l Prg_Previous(a6),Prg_Runned(a5) clr.l Prg_Previous(a6) moveq #-1,d0 bra.s .Out ; ; RESTAURATION DES DONNEES DU PROGRAMME POUSSE ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; Prg_Pull movem.l a0-a4/a6/d0-d7,-(sp) move.l Prg_Runned(a5),d0 beq.s .Skip move.l d0,a6 Prend l'ancien programme move.l Prg_Previous(a6),d0 Programme precedent clr.l Prg_Previous(a6) Plus de programme precedent! move.l d0,Prg_Runned(a5) Le programme actuel beq.s .Skip Si dernier programme, on garde tout! ; Efface les variables ; ~~~~~~~~~~~~~~~~~~~~ bsr ClearVar bsr Includes_Clear ; Efface la structure programme ancienne, si non editee... ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ tst.b Prg_Edited(a6) bne.s .Edited bsr Prg_DelStructure .Edited ; Remet les donnees ; ~~~~~~~~~~~~~~~~~ move.l Prg_Runned(a5),a6 lea Prg_RunData(a6),a0 bsr Prg_DataLoad ; Fini! ; ~~~~~ .Skip movem.l (sp)+,a0-a4/a6/d0-d7 rts ; ; Programme en route, stocke les donn�es pour les programmes suivants ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; A0= Adresse ou poker la structure ; Prg_DataSave move.l #FinSave-DebSave+4+4+4*32,d0 move.l #Public|Clear,d1 bsr A5_Reserve beq .Err move.l a0,a1 ; Sauve les donnees ; ~~~~~~~~~~~~~~~~~ lea DebSave(a5),a0 move.w #(FinSave-DebSave)/2-1,d0 .Copy1 move.w (a0)+,(a1)+ dbra d0,.Copy1 ; Sauve la liste CLEARVAR ; ~~~~~~~~~~~~~~~~~~~~~~~ lea Sys_ClearRoutines(a5),a2 move.l (a2),d0 .Loop move.l d0,(a1)+ beq.s .Out move.l d0,a0 move.l (a0),d0 lsl.l #1,d0 bra.s .Loop .Out ; Pas d'erreur ; ~~~~~~~~~~~~ moveq #-1,d0 rts .Err moveq #0,d0 rts ; ; Remet les donn�es pour retour de programme ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; A0= Adresse ou prendre la structure ; Prg_DataLoad move.l a0,a2 move.l (a2),a0 lea DebSave(a5),a1 move.w #(FinSave-DebSave)/2-1,d0 .Copy1 move.w (a0)+,(a1)+ dbra d0,.Copy1 ; Remet la liste CLEARVAR ; ~~~~~~~~~~~~~~~~~~~~~~~ lea Sys_ClearRoutines(a5),a1 move.l (a0)+,d0 move.l d0,(a1) bra.s .In .Loop move.l d0,a1 move.l (a0)+,d0 move.l d0,d1 lsr.l #1,d1 bset #31,d1 move.l d1,(a1) .In tst.l d0 bne.s .Loop ; Remet le moniteur s'il faut ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~ move.w Cur_ChrJump(a5),d0 JJsr L_SetChrPatch ; Les banques ont change ; ~~~~~~~~~~~~~~~~~~~~~~ JJsr L_Bnk.Change ; Efface la zone de donn�es ; ~~~~~~~~~~~~~~~~~~~~~~~~~ move.l a2,a0 bsr A5_Free moveq #0,d0 rts ; Nettoie les structures interpreteur pour appel en boucle ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Prg_DataNew clr.l VarBuf(a5) Plus de buffers clr.l VNmMini(a5) clr.w Stack_Size(a5) clr.w Stack_CSize(a5) clr.l MnBase(a5) Plus de menus clr.w OMnNb(a5) clr.l OMnBase(a5) clr.l Prg_Includes(a5) Plus d'includes clr.l Prg_FullSource(a5) clr.l Patch_Errors(a5) Plus de moniteur clr.l Patch_Menage(a5) clr.l Patch_ScFront(a5) clr.l Patch_ScCopy(a5) bclr #1,ActuMask+1(a5) moveq #0,d0 JJsr L_SetChrPatch clr.b Ed_Zappeuse(a5) Plus de zappeuse clr.b Prg_Accessory(a5) Plus une accessoire lea Fichiers(a5),a0 Plus de fichiers moveq #NFiche-1,d0 .New1 clr.l (a0) lea TFiche(a0),a0 dbra d0,.New1 lea Dev_List(a5),a0 Plus de devices (12 byte/device) moveq #(3*Dev_Max)-1,d0 .New2 clr.l (a0)+ dbra d0,.New2 lea Lib_List(a5),a0 Plus de librairies moveq #Lib_Max-1,d0 .New3 clr.l (a0)+ dbra d0,.New3 rts ; ; Ouvre une structure de programme ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; IN D0= Longueur buffer ; OUT D0= 0(rate) Structure(reussi) Prg_NewStructure movem.l d2/a6,-(sp) move.l d0,d2 ; Reserve la structure move.l #Prg_Long,d0 SyCall SyFast beq .Err2 move.l d0,a0 ; Insere dans la liste move.l Prg_List(a5),Prg_Next(a0) move.l a0,Prg_List(a5) ; Reserve le buffer move.l a0,a6 move.l d2,d0 bsr Prg_ChgTTexte beq.s .Err1 move.l a6,d0 movem.l (sp)+,d2/a6 rts ; Rate: efface le buffer .Err1 bsr Prg_DelStructure .Err2 moveq #0,d0 movem.l (sp)+,d2/a6 rts ; ; Ferme une structure de programme ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; IN A6= Adresse structure Prg_DelStructure movem.l a0-a6/d0-d7,-(sp) ; Efface le programme tst.l Prg_StTTexte(a6) Efface programme + Banques beq.s .Skip bsr Prg_SetBanks bsr ClearVar JJsr L_Bnk.EffAll Enleve les banques moveq #0,d0 Efface le buffer de texte bsr Prg_ChgTTexte ; Enleve de la liste .Skip move.l a6,a1 Enleve de la liste move.l Prg_List(a5),d0 cmp.l d0,a6 beq.s .First .Loop move.l d0,a0 move.l Prg_Next(a0),d0 cmp.l d0,a6 bne.s .Loop move.l Prg_Next(a6),Prg_Next(a0) bra.s .End .First move.l Prg_Next(a6),Prg_List(a5) ; Efface la structure .End move.l #Prg_Long,d0 Efface la structure move.l a6,a1 SyCall SyFree movem.l (sp)+,a0-a6/d0-d7 rts ; ; Programme A6 >>> Programme courant ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Prg_ReSetBanks move.l a6,-(sp) move.l Prg_Runned(a5),a6 bsr.s Prg_SetBanks move.l (sp)+,a6 rts Prg_SetBanks move.l a0,-(sp) lea Prg_Banks(a6),a0 move.l a0,Cur_Banks(a5) lea Prg_Dialogs(a6),a0 move.l a0,Cur_Dialogs(a5) move.l Prg_StBas(a6),Prg_Source(a5) move.l (sp)+,a0 rts ; New du program A6 - D0=0 Pas de DEFRUN 1- DEFRUN -2-DEFRUN sans ecran ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Prg_New move.w d0,-(sp) ; Plus rien dans le buffer clr.w Prg_NLigne(a6) tst.l Prg_StTTexte(a6) beq.s .Vide move.l Prg_StHaut(a6),a0 clr.w -(a0) move.l a0,Prg_StBas(a6) ; Plus de nom! clr.b Prg_NamePrg(a6) clr.b Prg_Change(a6) move.b #1,Prg_StModif(a6) clr.b Prg_MathFlags(a6) ; Raz des banques .Vide clr.b T_Actualise(a5) bsr Prg_SetBanks JJsr L_Bnk.EffAll bsr ClearVar ; Raz de l'affichage move.w (sp)+,d0 beq.s .Skip move.w d0,DefFlag(a5) JJsr L_DefRun1 JJsr L_DefRun2 .Skip rts ; ; Change la taille du buffer de texte ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; IN D0= Nouvelle taille ; A6= Structure programme ; OUT D0= 0(rate) StBas(reussi) Prg_ChgTTexte movem.l d1/a1,-(sp) and.l #$FFFFFFFE,d0 move.l d0,d1 move.l Prg_StTTexte(a6),d0 beq.s .Ctt1 move.l Prg_StMini(a6),a1 SyCall MemFree clr.l Prg_StTTexte(a6) .Ctt1 move.l d1,d0 beq.s .Ctt2 SyCall MemFastClear beq.s .Ctt3 move.l d1,Prg_StTTexte(a6) Raz du programme move.l a0,Prg_StMini(a6) add.l d1,a0 move.l a0,Prg_StHaut(a6) clr.w -(a0) move.l a0,Prg_StBas(a6) ; Ok! .Ctt2 move.l a0,d0 .Ctt3 movem.l (sp)+,d1/a1 rts ; ; Charge un programme ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; IN Name1= nom du programme ; A6 structure dans laquelle charger ; D0= <1: TOUJOURS adapter ; =0: Adapter si necessaire ; >0: Revenir si trop petit Prg_Load movem.l a2-a4/d2-d7,-(sp) move.w d0,-(sp) move.l #1005,d2 jsr D_Open beq .DErr ; Verifie l'entete 1.3 ou pro ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~ move.l Buffer(a5),d2 moveq #16+4,d3 jsr D_Read bne .DErr move.l d2,a2 clr.b Prg_MathFlags(a6) ; 1.3? clr.b Prg_Not1.3(a6) lea H_1.3(pc),a0 move.l d2,a1 moveq #10-1,d0 .Ver1 cmp.b (a0)+,(a1)+ bne.s .P13 dbra d0,.Ver1 moveq #0,d7 bra.s .Load ; Pro? .P13 move.b #1,Prg_Not1.3(a6) lea H_Pro(pc),a0 move.l d2,a1 moveq #8-1,d0 .Ver2 cmp.b (a0)+,(a1)+ bne .PAmos dbra d0,.Ver2 move.l d2,a1 Prend le flag maths... move.b 15(a1),d7 ; Verifie la taille du buffer ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~ .Load move.l 16(a2),d3 move.l d3,d1 tst.w (sp) beq.s .Sin� bmi.s .2Joor ; Charge si possible cmp.l Prg_StTTexte(a6),d1 blt.s .CBon add.l #256,d1 bra.s .Papo ; Adapter si necessaire .Sin� cmp.l Prg_StTTexte(a6),d1 blt.s .CBon ; Adapter! .2Joor add.l #256,d1 move.l d1,d0 bsr Prg_ChgTTexte beq.s .MErr .CBon move.l Prg_StHaut(a6),a0 clr.w -(a0) move.l a0,d2 sub.l d3,d2 ; Charge le fichier ; ~~~~~~~~~~~~~~~~~ jsr D_Read bne .DErr move.l d2,Prg_StBas(a6) ; Charge les banques ; ~~~~~~~~~~~~~~~~~~ bsr Prg_SetBanks move.l #EntNul,d0 JJsr L_Bnk.Load bne .Out ; Change le nom ; ~~~~~~~~~~~~~ move.l Name1(a5),a0 lea Prg_NamePrg(a6),a1 .Copy move.b (a0)+,(a1)+ bne.s .Copy ; Programme non modifie ; ~~~~~~~~~~~~~~~~~~~~~ bsr Prg_CptLines clr.b Prg_Change(a6) move.b d7,Prg_MathFlags(a6) moveq #0,d0 bra.s .Out ; Erreur de disque ; ~~~~~~~~~~~~~~~~ .DErr moveq #-1,d0 bra.s .Out ; Out of mem ; ~~~~~~~~~~ .MErr moveq #-2,d0 bra.s .Out ; Pas un programme AMOS ; ~~~~~~~~~~~~~~~~~~~~~ .PAmos moveq #-3,d0 bra.s .Out ; Impossible de charger: buffer trop petit ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .Papo moveq #1,d0 ; Ferme le fichier et sort ; ~~~~~~~~~~~~~~~~~~~~~~~~ .Out jsr D_Close addq.l #2,sp movem.l (sp)+,a2-a4/d2-d7 tst.l d0 rts ; ; COMPTE LE NOMBRE DE LIGNES ; ~~~~~~~~~~~~~~~~~~~~~~~~~~ Prg_CptLines move.l Prg_StBas(a6),a0 moveq #0,d0 moveq #0,d1 CpL1 add.w d1,a0 add.w d1,a0 CpL2 move.b (a0),d1 beq.s CpLx addq.w #1,d0 cmp.w #_TkProc,2(a0) bne.s CpL1 ; Saute une procedure fermee tst.b 10(a0) bpl.s CpL1 add.l 4(a0),a0 moveq #(10+2+2)/2,d1 bra.s CpL1 ; Nombre de lignes CpLx move.w d0,Prg_NLigne(a6) rts ; ; TROUVE L'ADRESSE DU PROGRAMME NAME1 ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; In Name1 Nom � cherche ; Out Trouve BNE, A0=adresse ; Non BEQ ; Prg_AccAdr movem.l a2-a3/d2,-(sp) move.l Name1(a5),a0 JJsrR L_Dsk.DNom,a3 move.l a0,d2 move.l Prg_List(a5),d0 beq.s .Out .Loop0 move.l d0,a2 lea Prg_NamePrg(a2),a0 JJsrR L_Dsk.DNom,a3 move.l d2,a1 .Loop1 move.b (a0)+,d0 bsr MajD0 move.b d0,d1 move.b (a1)+,d0 bsr MajD0 cmp.b d0,d1 bne.s .Next or.b d1,d0 bne.s .Loop1 move.l a2,d0 bra.s .Ok .Next move.l Prg_Next(a2),d0 bne.s .Loop0 .Out moveq #0,d0 .Ok move.l d0,a0 movem.l (sp)+,a2-a3/d2 rts MajD0 cmp.b #"a",d0 bcs.s .Ski cmp.b #"z",d0 bhi.s .Ski sub.b #$20,d0 .Ski rts ; ; Sauve un programme ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; IN Name1= nom du programme ; A6 structure � sauver Prg_Save movem.l a2/d2-d4,-(sp) move.l #1006,d2 jsr D_Open beq .Err ; Sauve le header du programme: PRO / 1.3 ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ lea H_Pro(pc),a0 Header PRO move.b Prg_MathFlags(a6),15(a0) Double precision tst.b Prg_Not1.3(a6) bne.s .N13 lea H_1.3(pc),a0 .N13 moveq #"V",d0 Teste! tst.b Prg_StModif(a6) beq.s .Skip moveq #"v",d0 Non teste! .Skip move.b d0,11(a0) Met la marque move.l a0,d2 moveq #16,d3 jsr D_Write bne .Err ; Trouve la fin REELLE du programme (pas les zeros de fin!) ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ move.l Prg_StBas(a6),a0 .Loop bsr Tk_FindN Explore le programme bne.s .Loop .Fin move.l a0,d4 Stoppe sur le premier zero ; Sauve la taille PRG ; ~~~~~~~~~~~~~~~~~~~ move.l Buffer(a5),a0 move.l d4,d0 sub.l Prg_StBas(a6),d0 move.l d0,(a0) move.l a0,d2 moveq #4,d3 jsr D_Write bne .Err ; Sauve le corps du programme ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~ move.l Prg_StBas(a6),d2 move.l d4,d3 sub.l d2,d3 jsr D_Write bne .Err ; Sauve les banques.... ; ~~~~~~~~~~~~~~~~~~~~~ bsr Prg_SetBanks JJsr L_Bnk.SaveAll bne .Err ; Fin de la sauvegarde ; ~~~~~~~~~~~~~~~~~~~~ jsr D_Close ; Change le nom ; ~~~~~~~~~~~~~ move.l Name1(a5),a0 lea Prg_NamePrg(a6),a1 .Copy move.b (a0)+,(a1)+ bne.s .Copy ; Pas d'erreur ; ~~~~~~~~~~~~ clr.b Prg_Change(a6) moveq #0,d0 bra.s .Out .Err moveq #-1,d0 .Out movem.l (sp)+,a2/d2-d4 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; ROUTINES GESTION SOURCE ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; FIND_LINE ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; Trouve la ligne D0 ; Debut source A0 ; Debut Proc >>> A1 Tk_FindN moveq #1,d0 Tk_FindL move.l d1,-(sp) moveq #0,d1 sub.l a1,a1 subq.w #1,d0 bmi.s FndT ; Boucle principale Fnd1 move.b (a0),d1 beq.s FndT cmp.w #_TkProc,2(a0) beq.s Fnd4 Fnd2 add.w d1,a0 add.w d1,a0 Fnd3 dbra d0,Fnd1 bra.s FndT ; Debut de procedure Fnd4 tst.w 10(a0) * Fermee bpl.s Fnd5 move.l 4(a0),d1 lea 12+2(a0,d1.l),a0 moveq #0,d1 bra.s Fnd3 Fnd5 move.l a0,a1 * Ouverte bra.s Fnd7 Fnd6 move.b (a0),d1 beq.s FndT cmp.w #_TkEndP,2(a0) beq.s Fnd8 Fnd7 add.w d1,a0 add.w d1,a0 dbra d0,Fnd6 bra.s FndT Fnd8 sub.l a1,a1 bra.s Fnd2 ; Trouve! FndT move.l (sp)+,d1 move.w (a0),d0 beq.s FndT1 cmp.w #_TkProc,2(a0) bne.s FndT1 move.l a0,a1 FndT1 tst.w d0 rts ; Taille de la ligne A0 ; ~~~~~~~~~~~~~~~~~~~~~ Tk_SizeL moveq #0,d0 move.b (a0),d0 beq.s .Out cmp.w #_TkProc,2(a0) beq.s .Proc .Ouv lsl.w #1,d0 .Out rts .Proc tst.w 10(a0) bpl.s .Ouv moveq #12+2,d0 add.l 4(a0),d0 rts ; La ligne courante est-elle editable? ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Tk_EditL tst.b (a0) beq.s .Oui cmp.w #_TkProc,2(a0) bne.s .Oui btst #7,10(a0) beq.s .Oui move.w #%00100,CCR BEQ>>> faux rts .Oui move.w #%00000,CCR BNE>>> vrai rts ; TROUVE LE NUMERO ET LE DEBUT DE LA LIGNE A0 ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; A1-> Debut du buffer ; D0-> Numero ; D1-> Adresse debut proc Tk_FindA movem.l d2/a2,-(sp) move.l a1,a2 moveq #-1,d0 moveq #0,d1 moveq #0,d2 FdA1: addq.l #1,d0 move.l a2,a1 move.b (a2),d2 beq.s FdAT cmp.w #_TkProc,2(a2) beq.s FdA4 FdA2 add.w d2,a2 add.w d2,a2 FdA3 cmp.l a0,a2 bls.s FdA1 bra.s FdAT ; Une procedure FdA4 tst.w 10(a2) bpl.s FdA2 move.l a2,d1 btst #4,10(a2) beq.s FdA6 add.l 4(a2),a2 lea 12+2(a2),a2 moveq #0,d2 bra.s FdA6 FdA5 move.l a2,a1 move.b (a2),d2 beq.s FdAT cmp.w #_TkEndP,2(a2) beq.s FdA7 FdA6 add.w d2,a2 add.w d2,a2 cmp.l a0,a2 bls.s FdA5 bra.s FdAT FdA7 moveq #0,d1 bra.s FdA2 ; Trouve! FdAT move.l a1,a0 movem.l (sp)+,d2/a2 rts ; Codage / Decodage procedure LOCKEE ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; A6---> "PROC" ProCode movem.l d0-d7/a0-a6,-(sp) btst #4,8(a6) * Flag COMPILED? bne PaCo move.l 2(a6),d0 lea 10+2+4(a6,d0.l),a2 * A2---> ENDPROC move.w -2(a6),d0 lsr.w #8,d0 lsl.w #1,d0 lea -2(a6,d0.w),a1 * A1---> Ligne suivante move.l 2(a6),d5 rol.l #8,d5 move.b 9(a6),d5 moveq #1,d4 move.w 6(a6),d3 bra.s PrCo2 PrCo1 eor.w d5,(a0)+ add.w d4,d5 add.w d3,d4 ror.l #1,d5 cmp.l a0,a1 bne.s PrCo1 PrCo2 move.l a1,a0 move.w (a0)+,d0 lsr.w #8,d0 lsl.w #1,d0 lea -2(a0,d0.w),a1 addq.l #2,a0 cmp.l a0,a2 bne.s PrCo1 * Change le flag bchg #5,8(a6) PaCo movem.l (sp)+,d0-d7/a0-a6 rts ; Echange des tables de tokenisation ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ver_Verif moveq #-1,d3 bra.s Ver_Echange Ver_Run moveq #0,d3 Ver_Echange lea AdTokens(a5),a2 moveq #27-1,d2 .Loop tst.l (a2) beq.s .Next move.l (a2),a1 tst.l LB_Verif(a1) Une table? beq.s .Next tst.w d3 Run (0) ou Verif (1) bne.s .Verif ; Run! bclr #LBF_Verif,LB_Flags(a1) Deja RUN? beq .Next bsr.s Ver_Ech On echange bra.s .Next ; Verif! .Verif bset #LBF_Verif,LB_Flags(a1) Deja VERIF? bne .Next bsr.s Ver_Ech ; Table suivante .Next addq.l #4,a2 dbra d2,.Loop rts ; Echange des tables ; ~~~~~~~~~~~~~~~~~~ Ver_Ech move.l a1,a0 Debut des tokens move.l LB_Verif(a0),a1 Adresse table move.w (a1)+,d1 Longueur table ext.l d1 add.l a1,d1 Fin table .Loop move.l (a0),d0 move.l (a1),(a0)+ move.l d0,(a1)+ .Skip1 tst.b (a0)+ bpl.s .Skip1 .Skip2 tst.b (a0)+ bpl.s .Skip2 move.w a0,d0 and.w #$0001,d0 add.w d0,a0 cmp.l d1,a1 bcs.s .Loop rts ; Table des operateurs / Test ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Tst_Operateurs bra Tst_Chiffre dc.b " xor"," "+$80,"O00",-1 bra Tst_Chiffre dc.b " or"," "+$80,"O00",-1 bra Tst_Chiffre dc.b " and"," "+$80,"O00",-1 bra Tst_Comp dc.b "<",">"+$80,"O20",-1 bra Tst_Comp dc.b ">","<"+$80,"O20",-1 bra Tst_Comp dc.b "<","="+$80,"O20",-1 bra Tst_Comp dc.b "=","<"+$80,"O20",-1 bra Tst_Comp dc.b ">","="+$80,"O20",-1 bra Tst_Comp dc.b "=",">"+$80,"O20",-1 bra Tst_Comp dc.b "="+$80,"O20",-1 bra Tst_Comp dc.b "<"+$80,"O20",-1 bra Tst_Comp dc.b ">"+$80,"O20",-1 bra Tst_Mixte dc.b "+"+$80,"O22",-1 bra Tst_Mixte dc.b "-"+$80,"O22",-1 bra Tst_Chiffre dc.b " mod"," "+$80,"O00",-1 bra Tst_Chiffre dc.b "*"+$80,"O00",-1 bra Tst_Chiffre dc.b "/"+$80,"O00",-1 bra Tst_Puis dc.b "^"+$80,"O00",-1 even Tst_Jumps dc.l 0