; ______________________________________________________________________________ ; .............................................................................. ; ...................................................................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........................| AMOSPro Compiler ; .200002........................................| Internal library ; 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. ; ______________________________________________________________________________ Include "+CLib_Size.S" Include "+AMOS_Includes.s" Include "+Version.s" ; ______________________________________________________________________________ Start dc.l C_Lib-C_Off dc.l 0 dc.l C_End-C_Lib dc.l 0 dc.w 0 ;--------------------------------------------------------------------- ; Creates the pointers to functions ;--------------------------------------------------------------------- MCInit C_Off REPT Lib_Size MC ENDR ;--------------------------------------------------------------------- Lib_Ini 0 ;--------------------------------------------------------------------- C_Lib ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Reservatioin du STACK si <>4k *** ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp Stack_Reserve ; - - - - - - - - - - - - - ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; RESERVATION / LIBERATION MEMOIRE (ancienne!) ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Mise a zero! ; ~~~~~~~~~~~~~~~~~~ Lib_Cmp RamFast move.l a0,-(sp) SyCall MemFastClear move.l a0,d0 move.l (sp)+,a0 rts Lib_Cmp RamFast2 move.l a0,-(sp) SyCall MemFast move.l a0,d0 move.l (sp)+,a0 rts Lib_Cmp RamChip move.l a0,-(sp) SyCall MemChipClear move.l a0,d0 move.l (sp)+,a0 rts Lib_Cmp RamChip2 move.l a0,-(sp) SyCall MemChip move.l a0,d0 move.l (sp)+,a0 rts Lib_Cmp RamFree move.l a0,-(sp) SyCall MemFree move.l (sp)+,a0 rts ; ; Reserve / Libere le buffer temporaire ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Lib_Cmp ResTempBuffer ResTempBuffer movem.l d1/a1,-(sp) move.l d0,d1 ; Libere l'ancien buffer move.l TempBuffer(a5),d0 beq.s .NoLib move.l d0,a1 move.l -(a1),d0 addq.l #4,d0 SyCall MemFree clr.l TempBuffer(a5) ; Reserve le nouveau .NoLib move.l d1,d0 beq.s .Exit addq.l #4,d0 SyCall MemFastClear beq.s .Exit move.l d1,(a0)+ move.l a0,TempBuffer(a5) move.l d1,d0 ; Branche les routines de liberation automatique movem.l a0-a2/d0-d1,-(sp) lea .LibClr(pc),a1 lea Sys_ClearRoutines(a5),a2 SyCall AddRoutine lea .LibErr(pc),a1 lea Sys_ErrorRoutines(a5),a2 SyCall AddRoutine movem.l (sp)+,a0-a2/d0-d1 .Exit movem.l (sp)+,d1/a1 rts ; Structures liberation ; ~~~~~~~~~~~~~~~~~~~~~ .LibClr dc.l 0 moveq #0,d0 bra.s ResTempBuffer .LibErr dc.l 0 moveq #0,d0 bra.s ResTempBuffer ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Wait vbl multi tache ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp Sys_WaitMul ; - - - - - - - - - - - - - movem.l a0-a1/a6/d0-d1,-(sp) ; Inhibition SyCall Test_Cyclique ; Attente multitache move.l T_GfxBase(a5),a6 jsr -270(a6) movem.l (sp)+,a0-a1/a6/d0-d1 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Retourne le message default resource D0 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp Def_GetMessage ; - - - - - - - - - - - - - move.l Sys_Resource(a5),a0 add.l 6(a0),a0 Rbra L_GetMessage ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Retourne le message system D0 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp Sys_GetMessage ; - - - - - - - - - - - - - move.l Sys_Messages(a5),a0 Rbra L_GetMessage ; - - - - - - - - - - - - - Lib_Cmp GetMessage ; - - - - - - - - - - - - - move.w d1,-(sp) clr.w d1 cmp.l #0,a0 beq.s .Big addq.l #1,a0 bra.s .In .Loop move.b (a0),d1 cmp.b #$ff,d1 beq.s .Big lea 2(a0,d1.w),a0 .In subq.w #1,d0 bgt.s .Loop .Out move.w (sp)+,d1 move.b (a0)+,d0 rts .Big lea .Fake(pc),a0 bra.s .Out .Fake dc.b 0,0,0,0 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; ADDITIONNE LE PATH DU SYSTEME AU NOM A0 >>> NAME1 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp Sys_AddPath ; - - - - - - - - - - - - - Rbsr L_Sys_GetPath Va chercher le path du systeme movem.l a1/a2,-(sp) move.l Name1(a5),a2 move.l a0,a1 .Ess move.b (a1)+,d0 cmp.b #":",d0 beq.s .Cop2 tst.b d0 bne.s .Ess lea Sys_Pathname(a5),a1 .Cop1 move.b (a1)+,(a2)+ bne.s .Cop1 subq.l #1,a2 .Cop2 move.b (a0)+,(a2)+ bne.s .Cop2 movem.l (sp)+,a1/a2 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; TROUVE LE PATH DU SYSTEME ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp Sys_GetPath ; - - - - - - - - - - - - - tst.b Sys_Pathname(a5) bne.s .Fin ; Demande le path si non defini movem.l a0-a3/d0-d7,-(sp) moveq #1,d0 Acces au path Rbsr L_Sys_GetMessage move.l a0,d1 Demande le lock moveq #-2,d2 DosCall _LVOLock tst.l d0 Rbeq L_DiskError Rbsr L_AskDir2 Demande le directory move.l Buffer(a5),a0 Copie le directory lea 384(a0),a0 lea Sys_Pathname(a5),a1 .CC move.b (a0)+,(a1)+ bne.s .CC movem.l (sp)+,a0-a3/d0-d7 ; Termine! .Fin rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; ROUTINES DE DEBUGGAGE! ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp BugBug ; - - - - - - - - - - - - - movem.l d0-d2/a0-a2,-(sp) .Ll move.w #$FF0,$DFF180 btst #6,$BFE001 bne.s .Ll move.w #20,d0 .L0 move.w #10000,d1 .L1 move.w d0,$DFF180 dbra d1,.L1 dbra d0,.L0 btst #6,$BFE001 beq.s .Ill movem.l (sp)+,d0-d2/a0-a2 rts .Ill EcCalD AMOS_WB,0 movem.l (sp)+,d0-d2/a0-a2 illegal rts ; - - - - - - - - - - - - - Lib_Cmp PreBug ; - - - - - - - - - - - - - btst #6,$BFE001 Rbeq L_BugBug rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; RECOP ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp ReCop ; - - - - - - - - - - - - - SyCall WaitVbl EcCall CopForce rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; GESTION DES LISTES ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Cree un element de liste en CHIP MEM ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Lib_Cmp Lst.ChipNew move.l #Chip|Clear|Public,d1 Rbra L_Lst.Cree ; Cree une element de liste en FAST MEM ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Lib_Cmp Lst.New move.l #Clear|Public,d1 Rbra L_Lst.Cree ; Cree un �l�ment en tete de liste A0 / longueur D0 / Memoire D1 ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Lib_Cmp Lst.Cree movem.l a0/d0,-(sp) addq.l #8,d0 SyCall MemReserve move.l a0,a1 movem.l (sp)+,a0/d1 beq.s .Out move.l (a0),(a1) move.l a1,(a0) move.l d1,4(a1) move.l a1,d0 .Out rts ; Efface une liste entiere A0 ; ~~~~~~~~~~~~~~~~~~~~~~~~ Lib_Cmp Lst.DelAll bra.s .In .Loop move.l d0,a1 Rbsr L_Lst.Del .In move.l (a0),d0 bne.s .Loop rts ; Efface un �l�ment de liste A1 / Debut liste A0 ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Lib_Cmp Lst.Del movem.l a0/d0-d2,-(sp) move.l a1,d0 move.l a0,a1 move.l (a1),d2 beq.s .NFound .Loop move.l a1,d1 move.l d2,a1 cmp.l d0,a1 beq.s .Found move.l (a1),d2 bne.s .Loop bra.s .NFound ; Enleve de la liste .Found move.l d1,a0 move.l (a1),(a0) move.l 4(a1),d0 addq.l #8,d0 SyCall MemFree .NFound movem.l (sp)+,a0/d0-d2 rts ; INSERE un �l�ment A1 en tete de liste A0 ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Lib_Cmp Lst.Insert move.l (a0),(a1) move.l a1,(a0) rts ; Enleve un �l�ment de liste A1 / Debut liste A0 ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Lib_Cmp Lst.Remove movem.l a0/a1/d0-d2,-(sp) move.l a1,d0 move.l a0,a1 move.l (a1),d2 beq.s .NFound .Loop move.l a1,d1 move.l d2,a1 cmp.l d0,a1 beq.s .Found move.l (a1),d2 bne.s .Loop bra.s .NFound ; Enleve de la liste .Found move.l d1,a0 move.l (a1),(a0) .NFound movem.l (sp)+,a0/a1/d0-d2 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Trouve le directory courant > ; >>> Buffer + 384 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp AskDir ; - - - - - - - - - - - - - move.l Buffer(a5),a0 clr.w (a0) clr.w 384(a0) move.l a0,d1 moveq #-2,d2 DosCall _LVOLock tst.l d0 Rbne L_AskDir2 rts ; - - - - - - - - - - - - - Lib_Cmp AskDir2 ; - - - - - - - - - - - - - clr.l -(sp) ADir0: move.l d0,-(sp) move.l d0,d1 DosCall _LVOParentDir tst.l d0 bne.s ADir0 * Redescend les LOCKS en demandant le NOM! move.l Buffer(a5),a2 lea 384(a2),a2 clr.b (a2) moveq #":",d2 ADir1: move.l (sp)+,d1 beq.s ADir4 move.l Buffer(a5),a1 movem.l d1/d2/a1/a2,-(sp) move.l a1,d2 DosCall _LVOExamine movem.l (sp)+,d1/d2/a1/a2 tst.l d0 beq.s ADir3 lea 8(a1),a1 ADir2: move.b (a1)+,(a2)+ bne.s ADir2 move.b d2,-1(a2) clr.b (a2) moveq #"/",d2 ADir3 DosCall _LVOUnLock bra.s ADir1 ADir4 moveq #0,d0 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; TOKENISATEUR POUR LE COMPILATEUR ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp Tokenisation ; - - - - - - - - - - - - - bra Tokenise bra Tok_Init bra Tok_Del ; Initialisation des tables de tokenisation ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Tok_Init tst.l Ed_BufT(a5) bne MTokX ; Reserve le buffer de tokenisation... ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ move.l #EdBTT,d0 Rjsr L_RamFast beq MTError move.l d0,Ed_BufT(a5) ; Fabrique les tables de tokenisation ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ move.l #1024*12,d0 Rjsr L_ResTempBuffer beq MTError lea AdTokens(a5),a3 lea AdTTokens(a5),a4 moveq #-4,d7 MTok1 addq.w #4,d7 cmp.w #26*4,d7 bcc MTokX move.l 0(a3,d7.w),d6 beq.s MTok1 move.l d6,a1 addq.l #6,a1 ; Premiere table move.l TempBuffer(a5),a6 move.l a6,a0 lea 2048(a0),a2 moveq #0,d0 MTok2 move.l a1,d1 lea 4(a1),a1 MTok0 move.b (a1)+,d0 bpl.s MTok3 and.w #$7f,d0 subq.l #1,a1 MTok3 cmp.b #"!",d0 beq.s MTok0 cmp.b #" ",d0 beq.s MTok0 bsr MnD0 cmp.b #"a",d0 bcs.s MTok4 cmp.b #"z",d0 bhi.s MTok4 move.w d0,(a0)+ sub.l d6,d1 move.w d1,(a2)+ MTok4 bsr EdlNext bne.s MTok2 move.w #-1,(a0)+ ; Deuxieme table move.l a0,d0 sub.l a6,d0 add.l #26*4+2+4,d0 move.l d0,d1 Rjsr L_RamFast beq MTError move.l d0,a0 move.l a0,0(a4,d7.w) move.l a0,a1 move.l a0,d3 move.l d1,(a1)+ lea 26*2+2(a1),a2 moveq #"a",d5 move.w #2048,d4 MTok5 move.l a2,d0 sub.l d3,d0 move.w d0,(a1)+ move.l a6,a0 MTok6 move.w (a0)+,d0 bmi.s MTok7 cmp.w d0,d5 bne.s MTok6 move.w -2(a0,d4.w),(a2)+ bra.s MTok6 MTok7 clr.w (a2)+ addq.w #1,d5 cmp.w #"z",d5 bls.s MTok5 clr.w (a1)+ bra MTok1 MTokX moveq #0,d0 Rjsr L_ResTempBuffer moveq #0,d0 rts ; Out of memory! ; ~~~~~~~~~~~~~~ MTError moveq #0,d0 Rjsr L_ResTempBuffer moveq #1,d0 rts ; Routine: token suivant ; ~~~~~~~~~~~~~~~~~~~~~~ EdlNext tst.b (a1)+ ; Saute le nom bpl.s EdlNext .Tkln1 tst.b (a1)+ ; Saute les params bpl.s .Tkln1 move.w a1,d1 btst #0,d1 ; Rend pair beq.s .Tkln2 addq.l #1,a1 .Tkln2 tst.w (a1) rts ; Routine: D0 minuscule MnD0 cmp.b #"A",d0 bcs.s .Mnd0a cmp.b #"Z",d0 bhi.s .Mnd0a add.b #32,d0 .Mnd0a rts ; Effacement de la tokenisation ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Tok_Del ; Efface le buffer de tokenisation move.l Ed_BufT(a5),d0 beq.s DlTkX clr.l Ed_BufT(a5) move.l d0,a1 move.l #EdBTT,d0 Rjsr L_RamFree ; Efface les tables de tokens rapide lea AdTTokens(a5),a2 moveq #25,d1 DlTk1 move.l (a2)+,d0 beq.s DlTk2 clr.l -4(a2) move.l d0,a1 move.l (a1),d0 Rjsr L_RamFree DlTk2 dbra d1,DlTk1 DlTkX rts ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ;+ TOKENISE LA LIGNE COURANTE ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Tokenise: movem.l a1-a6/d2-d7,-(sp) * Sauve le debut de la ligne move.l a1,a4 move.l a0,a3 pea 512(a4) clr.w d5 * RAZ de tous les flags clr.w (a4)+ ; ----- Compte les TABS moveq #0,d1 TokT: addq.w #1,d1 move.b (a3)+,d0 beq TokVide cmp.b #32,d0 beq.s TokT subq.l #1,a3 cmp.w #127,d1 bcs.s TokT1 moveq #127,d1 TokT1: move.b d1,-1(a4) ; ----- Un chiffre au debut de la ligne? move.b (a3),d0 cmp.b #"0",d0 bcs.s TokT2 cmp.b #"9",d0 bhi.s TokT2 bset #1,d5 * Flag VARIABLE bset #4,d5 * Flag LABEL move.l a4,TkAd(a5) move.w #_TkVar,(a4)+ clr.l (a4)+ move.b (a3)+,(a4)+ ; ----- Une apostrophe en debut de ligne? TokT2: cmp.b #"'",d0 bne.s TokLoop addq.l #1,a3 move.w #_TkRem2,(a4)+ bra TkKt2 ; ----- Prend une lettre TokLoop: cmp.l (sp),a4 bhi TokFin move.b (a3)+,d0 beq TokFin * Rem en route? btst #5,d5 beq.s TkROn move.b d0,(a4)+ bra.s TokLoop TkROn: * Variable en route? btst #1,d5 bne TkVD * Chaine en route? btst #0,d5 beq.s TkC2 cmp.b TkChCar(a5),d0 beq.s TkC1 move.b d0,(a4)+ bra.s TokLoop * Fin d'une chaine alphanumerique TkChf: subq.l #1,a3 TkC1: bclr #0,d5 move.l a4,d0 btst #0,d0 beq.s TkC0 clr.b (a4)+ TkC0: move.l TkAd(a5),a0 sub.l a0,d0 subq.w #4,d0 move.w d0,2(a0) bra.s TokLoop * Debut d'une chaine alphanumerique? TkC2: cmp.b #'"',d0 beq TkC2a cmp.b #"'",d0 bne TkOtre TkC2a: move.b d0,TkChCar(a5) move.l a4,TkAd(a5) cmp.b #"'",d0 beq.s TkC2b move.w #_TkCh1,(a4)+ bra.s TkC2c TkC2b: move.w #_TkCh2,(a4)+ TkC2c: clr.w (a4)+ bset #0,d5 bra.s TokLoop * Variable en route TkVD: bsr Minus * Numero de ligne en route TkFV: moveq #0,d1 move.l TkAd(a5),a0 btst #4,d5 beq.s TkV2 cmp.b #"0",d0 bcs.s TkV0 cmp.b #"9",d0 bls.s TkV3 TkV0: bset #3,d5 Fin du debut de ligne! bclr #4,d5 Fin du numero de ligne cmp.b #":",d0 beq.s TkV1 subq.l #1,a3 bra.s TkV1 * Variable normale / label TkV2: cmp.b #"_",d0 beq.s TkV3 cmp.b #"0",d0 bcs.s TkV4 cmp.b #"9",d0 bls.s TkV3 cmp.b #"a",d0 bcs.s TkV4 cmp.b #"z",d0 bls.s TkV3 cmp.b #128,d0 bls.s TkV4 TkV3: move.b d0,(a4)+ bra TokLoop * Fin de la variable/label/label goto TkV4: bset #3,d5 * Si pas debut de ligne bne.s TkV5 cmp.b #":",d0 * Si : bne.s TkV5 TkV1: move.w #_TkLab,(a0) bra.s TkV7 TkV5: subq.l #1,a3 moveq #2,d1 cmp.b #"$",d0 beq.s TkV6 moveq #1,d1 cmp.b #"#",d0 beq.s TkV6 moveq #0,d1 bra.s TkV7 TkV6: addq.w #1,a3 TkV7: move.w a4,d2 * Rend pair btst #0,d2 beq.s TkV8 clr.b (a4)+ TkV8: move.l a4,d0 sub.l a0,d0 subq.l #6,d0 move.b d0,4(a0) * Poke la longueur move.b d1,5(a0) * Poke le flag bclr #1,d5 bra TokLoop * Saute les 32 TkOtre: cmp.b #" ",d0 beq TokLoop * Est-ce un chiffre? lea -1(a3),a0 Pointe le debut du chiffre moveq #0,d0 Ne pas tenir compte du signe (valtok) Rbsr L_CValRout bne.s TkK move.l a0,a3 move.w d1,(a4)+ move.l d3,(a4)+ cmp.w #_TkDFl,d1 bne TokLoop move.l d4,(a4)+ bra TokLoop TkK: ; ----- Tokenisation RAPIDE! moveq #-4,d7 * D7--> Numero de l'extension lea AdTokens(a5),a6 moveq #0,d3 lea -10(sp),sp * Prend le premiere caractere... moveq #0,d0 move.b -1(a3),d0 bsr MinD0 move.l d0,d2 lea Dtk_Operateurs(pc),a1 Operateur, LENTS en 1er... bra TkLIn * Lent ou rapide? TkUn cmp.b #"a",d2 bcs.s Tkl1 cmp.b #"z",d2 bhi.s Tkl1 bset #31,d2 move.w d2,d6 sub.w #"a",d6 lsl.w #1,d6 * Mode rapide: init! Tkr1 lea AdTTokens(a5),a2 move.l 0(a2,d7.w),d0 beq.s Tkl1 move.l d0,a2 move.w 4(a2,d6.w),d0 add.w d0,a2 * A2-> Adresse des adresses bset #31,d6 bra TkRNext * Tokens lents Tkl1 move.l 0(a6,d7.w),d0 beq TkNext move.l d0,a1 addq.l #6,a1 TkLIn bclr #31,d6 cmp.b #"!",d2 Entree pour les operateurs... beq TkKF cmp.b #"?",d2 bne.s Tkl2 move.l a3,a0 Tkl1a move.b (a0)+,d0 * ? PRINT / ? PRINT # beq.s Tkl1b cmp.b #"#",d0 beq.s Tkl1c cmp.s #" ",d0 beq.s Tkl1a Tkl1b move.w #_TkPr,d4 bra TkKt0 Tkl1c move.l a0,a3 move.w #_TkHPr,d4 bra TkKt0 Tkl2 move.l a1,d4 * Recherche la 1ere lettre lea 4(a1),a1 move.w d2,d0 Tkl0 move.b (a1)+,d1 bmi Tkl4 cmp.b #" ",d1 beq.s Tkl0 cmp.b #"!",d1 beq.s Tkl0 cmp.b d0,d1 beq.s TkRe0 Tkl3 bsr TklNext bne.s Tkl2 * Tableau de token suivant! TkNext addq.l #4,d7 beq TkUn cmp.l #4*26,d7 bcc.s .TrouV tst.l d2 bpl.s Tkl1 bra Tkr1 .TrouV tst.w d3 beq TkKF move.l (sp),d4 move.l 4(sp),a3 move.w 8(sp),d7 bra TklT * Trouve 1 lettre lent? Tkl4 subq.l #1,a1 and.b #$7f,d1 cmp.b #" ",d1 beq TklT cmp.b d0,d1 bne.s Tkl3 bra TklT * Token rapide suivant TkRNext move.w (a2)+,d0 beq TkNext move.l 0(a6,d7.w),a1 add.w d0,a1 move.l a1,d4 lea 5(a1),a1 move.b -1(a1),d0 cmp.b #"!",d0 beq.s TkRe0a cmp.b #" ",d0 bne.s TkRe0 TkRe0a addq.l #1,a1 * Explore les autres lettres du token TkRe0 move.l a3,a0 TkRe1 move.b (a0)+,d0 bsr MinD0 TkRe2 move.b (a1)+,d1 bmi.s TkKt cmp.b #" ",d1 bne.s TkRe3 cmp.b d1,d0 bne.s TkRe2 beq.s TkRe1 TkRe3 cmp.b d0,d1 beq.s TkRe1 * Mot cle suivant TkRe4 tst.l d6 bpl Tkl3 bmi.s TkRNext * Mot trouve? TkKt: subq.l #1,a0 subq.l #1,a1 and.b #$7f,d1 cmp.b #" ",d1 beq.s TkKt1 cmp.b d0,d1 bne.s TkRe4 addq.l #1,a0 TkKt1: tst.l d6 bpl.s TklTl move.l a1,d0 sub.l d4,d0 cmp.w d3,d0 bls.s TkRe4 move.w d0,d3 move.l d4,(sp) move.l a0,4(sp) move.w d7,8(sp) bra.s TkRe4 TklTl move.l a0,a3 ** Token trouve! TklT tst.w d7 Une extension bgt TkKtE beq.s .Norm Un operateur? lea Dtk_OpFin(pc),a0 sub.l a0,d4 bra.s TkKt0 .Norm sub.l AdTokens(a5),d4 Un token librairie principale TkKt0: lea 10(sp),sp move.w d4,(a4)+ bclr #4,d5 Plus de numero de ligne bset #3,d5 Plus debut de ligne cmp.w #_TkEqu,d4 Tokens de structure? bcs.s .SkS cmp.w #_TkStruS,d4 bls TkKt5 .SkS cmp.w #_TkOn,d4 beq.s TkKt7 cmp.w #_TkData,d4 beq TkKt3 cmp.w #_TkRem1,d4 beq.s TkKt2 cmp.w #_TkFor,d4 beq.s TkKt3 cmp.w #_TkRpt,d4 beq.s TkKt3 cmp.w #_TkWhl,d4 beq.s TkKt3 cmp.w #_TkDo,d4 beq.s TkKt3 cmp.w #_TkExit,d4 beq.s TkKt4 cmp.w #_TkExIf,d4 beq.s TkKt4 cmp.w #_TkIf,d4 beq.s TkKt3 cmp.w #_TkElse,d4 beq.s TkKta cmp.w #_TkElsI,d4 beq.s TkKt3 cmp.w #_TkThen,d4 beq.s TkKtb cmp.w #_TkProc,d4 beq.s TkKt6 cmp.w #_TkDPre,d4 beq.s TkKDPre bra TokLoop * ON TkKt7: clr.l (a4)+ bra TokLoop * Debut d'une REM TkKt2: clr.w (a4)+ move.l a4,TkAd(a5) bset #5,d5 bra TokLoop * Poke les blancss TkKt6 clr.w (a4)+ 8 octets TkKt5 clr.w (a4)+ 6 octets TkKt4 clr.w (a4)+ 4 octets TkKt3 clr.w (a4)+ 2 octets bra TokLoop * Token double precision: flags � 1 TkKDPre or.b #%10000011,MathFlags(a5) bra TokLoop * Token d'extension! .w EXT/.b #Ext/.b Nb Par/.w TOKEN TkKtE: lea 10(sp),sp move.w #_TkExt,(a4)+ move.w d7,d0 lsr.w #2,d0 move.b d0,(a4)+ clr.b (a4)+ lea AdTokens(a5),a6 sub.l 0(a6,d7.w),d4 move.w d4,(a4)+ bclr #4,d5 bset #3,d5 bra TokLoop * ELSE/THEN: regarde si numero de ligne apres! TkKta: clr.w (a4)+ TkKtb: move.l a3,a0 TkKtc: move.b (a0)+,d0 beq TokLoop cmp.b #" ",d0 beq TkKtc cmp.b #"0",d0 bcs TokLoop cmp.b #"9",d0 bhi TokLoop move.l a0,a3 move.w #_TkLGo,d1 bra.s TkKf2 ; ----- Rien trouve ===> debut d'une variable TkKF: lea 10(sp),sp move.w #_TkVar,d1 move.b -1(a3),d0 TkKf0: cmp.b #"A",d0 bcs.s TkKf1 cmp.b #"Z",d0 bhi.s TkKf1 add.b #"a"-"A",d0 TkKf1: cmp.b #"_",d0 beq.s TkKf2 cmp.b #128,d0 bcc.s TkKf2 cmp.b #"a",d0 bcs TokLoop cmp.b #"z",d0 bhi TokLoop TkKf2: move.l a4,TkAd(a5) move.w d1,(a4)+ clr.l (a4)+ move.b d0,(a4)+ bset #1,d5 bra TokLoop * Appel d'un label? TkKf3: move.w #_TkLGo,d1 cmp.b #"0",d0 bcs.s TkKf0 cmp.b #"9",d0 bls.s TkKf2 bra.s TkKf0 ; ----- Fin de la tokenisation TokFin: btst #1,d5 Fin de variable bne TkFV btst #0,d5 Fin de chaine alphanumerique bne TkChf moveq #1,d0 * Quelquechose dans la ligne! btst #5,d5 REM beq.s TokPaR move.w a4,d1 btst #0,d1 Rend pair la REM! beq.s FRem move.b #" ",(a4)+ FRem: move.l a4,d1 Calcule et stocke la longueur move.l TkAd(a5),a0 sub.l a0,d1 move.w d1,-2(a0) * Marque la fin TokPaR: clr.w (a4)+ clr.w (a4) * Poke la longueur de la ligne / 2 move.l a4,d1 addq.l #4,sp move.l a3,a0 movem.l (sp)+,a1-a6/d2-d7 sub.l a1,d1 cmp.w #510,d1 bcc.s .Long lsr.w #1,d1 move.b d1,(a1) lsl.w #1,d1 ext.l d1 * Fini! tst.w d0 rts * Trop longue! .Long clr.w (a1) * <0= Trop longue moveq #0,d1 moveq #-1,d0 rts * Ligne vide! TokVide moveq #0,d0 * = 0 Vide moveq #0,d1 bra.s TokPaR * Routine: D0 minuscule MinD0 cmp.b #"A",d0 bcs.s Mnd0a cmp.b #"Z",d0 bhi.s Mnd0a add.b #32,d0 Mnd0a rts * Routine: token suivant TklNext tst.b (a1)+ * Saute le nom bpl.s TklNext Tkln1 tst.b (a1)+ * Saute les params bpl.s Tkln1 move.w a1,d1 btst #0,d1 * Rend pair beq.s Tkln2 addq.l #1,a1 Tkln2 tst.w (a1) rts ; Passe en minuscules ; ~~~~~~~~~~~~~~~~~~~~~~~~~ Minus: cmp.b #"A",d0 bcs.s .Skip cmp.b #"Z",d0 bhi.s .Skip add.b #"a"-"A",d0 .Skip rts ; Table des operateurs ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Dtk_Operateurs dc.w 1,1 dc.b " xor"," "+$80,"O00",-1 dc.w 1,1 dc.b " or"," "+$80,"O00",-1 dc.w 1,1 dc.b " and"," "+$80,"O00",-1 dc.w 1,1 dc.b "<",">"+$80,"O20",-1 dc.w 1,1 dc.b ">","<"+$80,"O20",-1 dc.w 1,1 dc.b "<","="+$80,"O20",-1 dc.w 1,1 dc.b "=","<"+$80,"O20",-1 dc.w 1,1 dc.b ">","="+$80,"O20",-1 dc.w 1,1 dc.b "=",">"+$80,"O20",-1 dc.w 1,1 dc.b "="+$80,"O20",-1 dc.w 1,1 dc.b "<"+$80,"O20",-1 dc.w 1,1 dc.b ">"+$80,"O20",-1 dc.w 1,1 dc.b "+"+$80,"O22",-1 dc.w 1,1 dc.b "-"+$80,"O22",-1 dc.w 1,1 dc.b " mod"," "+$80,"O00",-1 dc.w 1,1 dc.b "*"+$80,"O00",-1 dc.w 1,1 dc.b "/"+$80,"O00",-1 dc.w 1,1 dc.b "^"+$80,"O00",-1 even Dtk_OpFin dc.l 0 ExtNot dc.b "Extension ",$80 Even ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; TEST DU PROGRAMME POUR COMPILATEUR ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp Testing ; - - - - - - - - - - - - - bra Init bra PTest bra Fin bra Detok 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 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; INITIALISATION ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Init bsr ClearVar rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; FIN ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Fin bsr ClearVar bsr Equ_Free bsr Includes_Clear rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; TEST DU PROGRAMME ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - PTest: move.l sp,BasSp(a5) Sauve la pile movem.l a2-a4/a6/d2-d7,-(sp) Sauvegarde registres ; 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) clr.b VerNot1.3(a5) Compatible, au depart... ; 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 les tables ; ~~~~~~~~~~~~~~~~~ bsr Free_VerTables ; Termine!!! ; ~~~~~~~~~~ moveq #0,d0 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 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 VerLoop 57-APCmp Call IFNE Debug=2 V1_Debug bra VerDP 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_CValRout,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 ; lea Equ_Free(pc),a0 ; lea Equ_FlushStructure(pc),a1 ; move.l a0,(a1) ; SyCall AddFlushRoutine ; Charge le fichier moveq #9,d0 Rjsr L_Sys_GetMessage Rjsr L_Sys_AddPath move.l #1005,d2 bsr VD_Open beq.s .Err ; Trouve la taille du fichier! moveq #0,d2 moveq #1,d3 bsr VD_Seek moveq #0,d2 moveq #-1,d3 bsr VD_Seek ; Reserve la memoire move.l d0,d3 move.l #Fast|Public,d1 lea Equ_Base(a5),a0 bsr VA5_Reserve beq.s .Err ; Charge le fichier move.l a0,d2 bsr VD_Read bne.s .Err ; Ferme le fichier bsr VD_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 bsr VD_Close bsr Equ_Free moveq #52,d0 bra VerErr ; Libere le fichier d'equates ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equ_Free lea Equ_Base(a5),a0 bsr VA5_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) 5-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 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 Rjsr L_RamFree 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 Rjsr L_RamFast beq VerOut move.l d0,a0 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) ; Plus de buffers! ; ~~~~~~~~~~~~~~~~ bsr ClearBuffers movem.l (sp)+,d0-d7/a0-a6 rts ; Nettoie tous les buffers ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ClearBuffers moveq #0,d0 JJsr L_ResTempBuffer moveq #0,d1 bsr ResVarBuf clr.w VarBufFlg(a5) moveq #0,d1 bsr ResVNom 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 Rjsr L_RamFree Vbr1 move.l d1,d0 beq.s Vbr2 Rjsr L_RamFast beq VerOut move.l d0,a0 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) Rjsr L_RamFree RVn1 move.l d1,d0 beq.s RVn2 Rjsr L_RamFast beq VerOut move.l d0,a0 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 VA5_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 bsr VD_Open beq .DErr ; Verifie entete, prend la taille du source move.l Buffer(a5),d2 moveq #16+4,d3 bsr VD_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 VA5_Reserve beq .MErr lea 20(a0),a2 Saute le header 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 bsr VD_Read bne .DErr add.l d0,a2 bsr VD_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 bsr VD_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) bsr VD_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 ; Effacement des buffers includes / Retour � la normale ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Includes_Clear movem.l a0-a1/d0-d1,-(sp) lea Prg_FullSource(a5),a0 bsr VA5_Free lea Prg_Includes(a5),a0 bsr VA5_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 ; Reserve un espace m�moire sur (a5) ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; A0= Adresse dans (a5) ; D0= Longueur ; D1= Flags VA5_Reserve movem.l d0-d2/a1-a2/a6,-(sp) move.l a0,a2 addq.l #4,d0 move.l d0,d2 move.l $4.w,a6 jsr _LVOAllocMem(a6) tst.l d0 beq.s .Out move.l d0,a0 move.l d2,(a0)+ move.l a0,(a2) .Out movem.l (sp)+,d0-d2/a1-a2/a6 rts ; Efface un espace m�moire sur (a5) ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; A0= Adresse dans (a5) VA5_Free movem.l a0-a1/d0-d1/a6,-(sp) move.l (a0),d0 beq.s .Skip clr.l (a0) move.l d0,a1 move.l -(a1),d0 move.l $4.w,a6 jsr _LVOFreeMem(a6) .Skip movem.l (sp)+,a0-a1/d0-d1/a6 rts ; 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 ; 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 ; ; NOUVELLE ROUTINES DISQUE ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; ; OPEN: ouvre le fichier systeme (diskname1) access mode D2 ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ VD_Open move.l Name1(a5),d1 VD_OpenD1 move.l a6,-(sp) move.l DosBase(a5),a6 jsr _LVOOpen(a6) move.l (sp)+,a6 move.l d0,Handle(a5) rts ; CLOSE fichier systeme ; ~~~~~~~~~~~~~~~~~~~~~ VD_Close movem.l d0/d1/a0/a1/a6,-(sp) move.l Handle(a5),d1 beq.s .Skip clr.l Handle(a5) move.l DosBase(a5),a6 jsr _LVOClose(a6) .Skip movem.l (sp)+,d0/d1/a0/a1/a6 rts ; READ fichier systeme D3 octets dans D2 ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ VD_Read movem.l d1/a0/a1/a6,-(sp) move.l Handle(a5),d1 move.l DosBase(a5),a6 jsr _LVORead(a6) movem.l (sp)+,d1/a0/a1/a6 cmp.l d0,d3 rts ; WRITE fichier systeme D3 octets de D2 ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ VD_Write movem.l d1/a0/a1/a6,-(sp) move.l Handle(a5),d1 move.l DosBase(a5),a6 jsr _LVOWrite(a6) movem.l (sp)+,d1/a0/a1/a6 cmp.l d0,d3 rts ; SEEK fichier system D3 mode D2 deplacement ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ VD_Seek move.l Handle(a5),d1 move.l a6,-(sp) move.l DosBase(a5),a6 jsr _LVOSeek(a6) move.l (sp)+,a6 tst.l d0 rts ; ___________________________________________________________________________ ; ; DETOKENISATION ; ___________________________________________________________________________ ; ; A0: Ligne � detokeniser ; A1: Buffer ; D0: Adresse � d�tecter ; ___________________________________________________________________________ ; Mon_Detok moveq #-1,d1 bra.s Dtk Detok: moveq #0,d1 Dtk movem.l d2-d7/a2-a6,-(sp) lea 2(a1),a4 * Place pour la taille move.l a0,a6 move.l d0,a3 move.l a4,a2 clr.w -(sp) * Position du curseur ; ----- Met les espaces devant? tst.w d1 Mode monitor bne.s DtkMon tst.b (a6) Mode normal beq DtkFin clr.w d0 move.b 1(a6),d0 subq.w #2,d0 bmi.s Dtk2 Dtk1: move.b #" ",(a4)+ dbra d0,Dtk1 Dtk2: addq.l #2,a6 DtkMon clr.w d5 ; ----- Boucle de detokenisation DtkLoop:cmp.l a3,a6 Trouve la P en X? bne.s Dtk0 move.l a4,d0 sub.l a2,d0 move.w d0,(sp) Dtk0: move.l a3,d0 Detournement? bpl.s .Skip neg.l d0 move.l d0,a0 jsr (a0) .Skip move.w (a6)+,d0 beq DtkFin cmp.w #_TkLGo,d0 bls DtkVar cmp.w #_TkExt,d0 bcs DtkCst bclr #0,d5 tst.w d0 bmi DtkOpe Un operateur? lea AdTokens(a5),a0 cmp.w #_TkPar1,d0 beq DtkP cmp.w #_TkDFl,d0 beq DtkCst cmp.w #_TkExt,d0 bne.s Dtk0a * Detokenise une extension move.w 2(a6),d1 move.b (a6),d2 ext.w d2 move.w d2,d3 lsl.w #2,d2 tst.l 0(a0,d2.w) beq.s DtkEe move.l 0(a0,d2.w),a0 lea 4(a0,d1.w),a0 move.l a0,a1 bra.s Dtk3 * Extension not present DtkEe: lea ExtNot(pc),a0 add.b #"A",d3 add.b #$80,d3 move.l a0,a1 DtkEee tst.b (a1)+ bpl.s DtkEee move.b d3,-1(a1) move.w #"I",d3 bra.s Dtk3a * Un operateur DtkOpe lea Tst_Jumps(pc),a0 bra.s Dtk0b * Instruction normale Dtk0a move.l AdTokens(a5),a0 Dtk0b lea 4(a0,d0.w),a0 move.l a0,a1 Dtk3: tst.b (a1)+ bpl.s Dtk3 move.b (a1),d3 cmp.b #"O",d3 beq.s Dtk4 cmp.b #"V",d3 beq.s Dtk4 cmp.b #"0",d3 0->8 des fonctions bcs.s Dtk3a cmp.b #"9",d3 bcs.s Dtk4 * Met un espace avant s'il n'y en a pas! Dtk3a: cmp.l a4,a2 * Debut de la ligne? beq.s Dtk4 cmp.b #" ",-1(a4) beq.s Dtk4 move.b #" ",(a4)+ * Doit prendre le token prececent? Dtk4: move.b (a0),d1 cmp.b #$80,d1 bcs.s Dtk4x cmp.b #$9f,d1 bhi.s Dtk4x subq.l #4,a0 sub.b #$80,d1 beq.s Dtk4a ext.w d1 sub.w d1,a0 bra.s Dtk4x Dtk4a: move.b -(a0),d1 cmp.b #"!",d1 beq.s Dtk4x cmp.b #$80,d1 bne.s Dtk4a bra.s Dtk4 * Ecrit le mot Dtk4x: cmp.b #"!",d1 bne.s Dtk4y addq.l #1,a0 Dtk4y: move.b DtkMaj1(a5),d1 beq.s Dtk5 cmp.b #1,d1 beq.s Dtk6 bne.s Dtk8 * 0- Ecrit en MINUSCULES Dtk5: move.b (a0)+,(a4)+ bpl.s Dtk5 and.b #$7f,-1(a4) bra.s DtkE * 1- Ecrit en MAJUSCULES Dtk6: move.b (a0)+,d1 move.b d1,d2 and.b #$7f,d1 cmp.b #"a",d1 bcs.s Dtk7 cmp.b #"z",d1 bhi.s Dtk7 sub.b #"a"-"A",d1 Dtk7: move.b d1,(a4)+ tst.b d2 bpl.s Dtk6 bra DtkE * 2- Ecrit AVEC UNE MAJUSCULE Dtk8: move.b (a0)+,d1 move.b d1,d2 and.b #$7f,d1 cmp.b #"a",d1 bcs.s Dtk9 cmp.b #"z",d1 bhi.s Dtk9 sub.b #"a"-"A",d1 Dtk9: move.b d1,(a4)+ tst.b d2 bmi.s DtkE Dtk9a: move.b (a0)+,d1 move.b d1,(a4)+ bmi.s Dtk9b cmp.b #" ",d1 bne.s Dtk9a bra.s Dtk8 Dtk9b: and.b #$7f,-1(a4) * Met une espace si c'est une INSTRUCTION DtkE: cmp.w #_TkRem1,d0 beq DtkRem cmp.w #_TkRem2,d0 beq DtkRem cmp.b #"I",d3 bne.s DtkE1 move.b #" ",(a4)+ * Saute le token... DtkE1: move.l a6,a0 bsr TInst move.l a0,a6 bra DtkLoop * Ouverture de parenthese, jamais d'espace! DtkP: cmp.l a4,a2 beq.s DtkP1 cmp.b #" ",-1(a4) bne.s DtkP1 subq.l #1,a4 DtkP1: move.b #"(",(a4)+ bra.s DtkE1 ; ----- Detokenisation de VARIABLE DtkVar: btst #0,d5 * Si variable juste avant, met 32 beq.s DtkV0 cmp.b #" ",-1(a4) beq.s DtkV0 move.b #" ",(a4)+ DtkV0: moveq #0,d2 move.b 2(a6),d2 * Longueur move.w d2,d1 subq.w #1,d1 move.b 3(a6),d3 FLAG lea 4(a6),a0 moveq #0,d4 cmp.w #_TkLab,d0 bne.s DtkV1 moveq #1,d4 D4: 0=> Variable cmp.b #"0",(a0) 1=> Label bcs.s DtkV1 -1=> Numero ligne cmp.b #"9",(a0) bhi.s DtkV1 moveq #-1,d4 DtkV1: move.b DtkMaj2(a5),d0 beq.s DtkV2 cmp.b #1,d0 beq.s DtkV3 bne.s DtkV5 * 0- En MINUSCULES DtkV2: move.b (a0)+,d0 beq DtkVF move.b d0,(a4)+ dbra d1,DtkV2 bra DtkVF * 1- En MAJUSCULES DtkV3: move.b (a0)+,d0 beq DtkVF cmp.b #"a",d0 bcs.s DtkV4 cmp.b #"z",d0 bhi.s DtkV4 sub.b #"a"-"A",d0 DtkV4: move.b d0,(a4)+ dbra d1,DtkV3 bra DtkVF * 2- Avec UNE MAJUSCULE DtkV5: move.b (a6)+,d0 cmp.b #"a",d0 bcs.s DtkV6 cmp.b #"z",d0 bhi.s DtkV6 sub.b #"a"-"A",d0 DtkV6: move.b d0,(a4)+ dbra d1,DtkV2 * Saute la variable / met le flag de la variable DtkVF: bset #0,d5 lea 4(a6,d2.w),a6 moveq #":",d0 tst.w d4 bmi DtkLoop bne.s DtkV7 moveq #"#",d0 and.b #3,d3 cmp.b #1,d3 beq.s DtkV7 moveq #"$",d0 cmp.b #2,d3 bne DtkLoop DtkV7: move.b d0,(a4)+ bra DtkLoop ; ----- Detokenise des constantes DtkCst: bclr #0,d5 Si variable avant, met un espace! beq.s DtkC0 cmp.b #" ",-1(a4) beq.s DtkC0 move.b #" ",(a4)+ DtkC0: cmp.w #_TkEnt,d0 beq.s DtkC3 cmp.w #_TkHex,d0 beq.s DtkC4 cmp.w #_TkBin,d0 beq.s DtkC5 cmp.w #_TkFl,d0 beq.s DtkC6 cmp.w #_TkDFl,d0 beq.s DtkC7 * Detokenise une chaine alphanumerique cmp.w #_TkCh1,d0 bne.s DtkC0a moveq #'"',d0 bra.s DtkC0b DtkC0a: moveq #"'",d0 DtkC0b: move.b d0,(a4)+ move.w (a6)+,d1 subq.w #1,d1 bmi.s DtkC2 DtkC1: move.b (a6)+,(a4)+ dbra d1,DtkC1 move.w a6,d1 btst #0,d1 beq.s DtkC2 addq.l #1,a6 DtkC2: move.b d0,(a4)+ bra DtkLoop * Detokenise un chiffre entier DtkC3: move.l (a6)+,d0 move.l a4,a0 JJsrR L_LongToDec,a1 move.l a0,a4 bra DtkLoop * Detokenise un chiffre HEXA DtkC4: move.l (a6)+,d0 move.l a4,a0 JJsrR L_LongToHex,a1 move.l a0,a4 bra DtkLoop * Detokenise un chiffre BINAIRE DtkC5: move.l (a6)+,d0 move.l a4,a0 JJsrR L_LongToBin,a1 move.l a0,a4 bra DtkLoop * Detokenise un chiffre FLOAT simple precision DtkC6: move.l (a6)+,d0 move.l a4,a0 moveq #-1,d4 moveq #0,d5 JJsrR L_FloatToAsc,a1 exg a0,a4 bra.s DtkC8 * Detokenise un chiffre FLOAT double precision DtkC7 move.l (a6)+,d0 move.l (a6)+,d1 pea 2.w Automatique pea 15.w 15 maxi move.l a4,-(sp) Buffer move.l d1,-(sp) Le chiffre move.l d0,-(sp) JJsrR L_DoubleToAsc,a1 lea 20(sp),sp move.l a4,a0 .Fin tst.b (a4)+ bne.s .Fin subq.l #1,a4 ; Si pas 0.0, le met! DtkC8 move.b (a0)+,d0 * Si pas de .0, le met! beq.s DtkC9 cmp.b #".",d0 beq DtkLoop cmp.b #"E",d0 beq DtkLoop bra.s DtkC8 DtkC9 move.b #".",(a4)+ move.b #"0",(a4)+ bra DtkLoop ; ----- Token d'extension DtkX: bra DtkLoop ; ----- REMarque DtkRem: addq.w #2,a6 Saute la longueur DtkR: tst.b (a6) beq DtkLoop move.b (a6)+,(a4)+ bra.s DtkR ; Fin de la DETOKENISATION DtkFin: sub.l a2,a4 * Ramene PX move.w a4,-2(a2) move.l a4,a0 move.w (sp)+,d0 movem.l (sp)+,d2-d7/a2-a6 rts ; RAMENE LA TAILLE DE L'INSTRUCTION D0 en D1 ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ TInst: tst.w d0 beq TFin cmp.w #_TkLGo,d0 bls TVar cmp.w #_TkCh1,d0 beq TCh cmp.w #_TkCh2,d0 beq TCh cmp.w #_TkRem1,d0 beq TCh cmp.w #_TkRem2,d0 beq TCh cmp.w #_TkDFl,d0 beq.s T8 cmp.w #_TkFl,d0 bls.s T4 cmp.w #_TkExt,d0 beq.s T4 cmp.w #_TkFor,d0 beq.s T2 cmp.w #_TkRpt,d0 beq.s T2 cmp.w #_TkWhl,d0 beq.s T2 cmp.w #_TkDo,d0 beq.s T2 cmp.w #_TkExit,d0 beq.s T4 cmp.w #_TkExIf,d0 beq.s T4 cmp.w #_TkIf,d0 beq.s T2 cmp.w #_TkElse,d0 beq.s T2 cmp.w #_TkElsI,d0 beq.s T2 cmp.w #_TkData,d0 beq.s T2 cmp.w #_TkProc,d0 beq.s T8 cmp.w #_TkOn,d0 beq.s T4 cmp.w #_TkEqu,d0 bcs.s T0 cmp.w #_TkStruS,d0 bls.s T6 T0: moveq #1,d1 TFin: rts T2: addq.l #2,a0 bra.s T0 T4: addq.l #4,a0 bra.s T0 T8: addq.l #8,a0 bra.s T0 T6: addq.l #6,a0 bra.s T0 TCh: add.w (a0)+,a0 move.w a0,d1 btst #0,d1 beq.s T0 addq.l #1,a0 bra.s T0 TVar: moveq #0,d1 move.b 2(a0),d1 lea 4(a0,d1.w),a0 bra.s T0 ; 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 ; Donnees ; ~~~~~~~~~~~~~ H_1.3 dc.b "AMOS Basic v134 " H_Pro dc.b "AMOS Pro101v",0,0,0,0 Equ_LVO dc.b 10,"_LVO",0 Equ_Nul dc.b 10,0 even ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; SOUS PROGRAMME UTILISE PAR VAL ET INPUT ; D0= Tenir compte du signe (TRUE) ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp CValRout ; - - - - - - - - - - - - - movem.l a1-a2/d5-d7,-(sp) move.l a0,d7 moveq #0,d4 move.l a0,a2 tst.w d0 beq.s Cal1c ; y-a-t'il un signe devant? Cal1: move.b (a0)+,d0 beq Cal10 cmp.b #32,d0 beq.s Cal1 move.l a0,a2 subq.l #1,a2 cmp.b #"-",d0 bne.s Cal1a not d4 bra.s Cal1c Cal1a: cmp.b #"+",d0 beq.s Cal1c Cal1b: subq.l #1,a0 Cal1c ; Explore le chiffre ; ~~~~~~~~~~~~~~~~~~ move.b (a0)+,d0 beq Cal10 cmp.b #32,d0 beq.s Cal1c cmp.b #"$",d0 ;chiffre HEXA beq Cal5 cmp.b #"%",d0 ;chiffre BINAIRE beq Cal6 cmp.b #".",d0 beq.s Cal2 cmp.b #"0",d0 bcs Cal10 cmp.b #"9",d0 bhi Cal10 ; c'estn chiffre DECIMAL: entier ou float? Cal2: subq.l #1,a0 move.l a0,a1 ;si float: trouve la fin du chiffre clr d3 Cal3: move.b (a1)+,d0 beq.s Cal4 cmp.b #32,d0 beq.s Cal3 cmp.b #"0",d0 bcs.s Cal3z cmp.b #"9",d0 bls.s Cal3 Cal3z: cmp.b #".",d0 ;cherche une "virgule" bne.s Cal3a bset #0,d3 ;si deux virgules: fin du chiffre beq.s Cal3 bne.s Cal4 Cal3a: cmp.b #"e",d0 ;cherche un exposant beq.s Cal3b cmp.b #"E",d0 ;autre caractere: fin du chiffre bne.s Cal4 Cal3ab: move.b #"e",-1(a1) ;met un E minuscule!!! Cal3b: move.b (a1)+,d0 ;apres un E, accepte -/+ et chiffres cmp.b #32,d0 beq.s Cal3b cmp.b #"+",d0 beq.s Cal3c cmp.b #"-",d0 bne.s Cal3e Cal3c: bset #1,d3 ;+ ou -: c'est un float! Cal3d: move.b (a1)+,d0 ;puis cherche la fin de l'exposant cmp.b #32,d0 beq.s Cal3d Cal3e: cmp.b #"0",d0 bcs.s Cal4 cmp.b #"9",d0 ;chiffre! c'est un float bls.s Cal3c Cal4: tst d3 ;si d3=0: c'est un entier beq Cal7 ; conversion ASCII--->FLOAT move.l a2,a0 subq.l #1,a1 movem.l a1/a3-a6,-(sp) lea BuFloat(a5),a2 move.l a2,-(sp) moveq #32,d1 Ca1: cmp.l a0,a1 beq.s Ca2 move.b (a0)+,d0 cmp.b #32,d0 beq.s Ca1 move.b d0,(a2)+ dbra d1,Ca1 Ca2: clr.b (a2) clr.b 1(a2) tst.b MathFlags(a5) Simple ou double precision? bmi.s .Double ; Simple precision Rjsr L_AscToFloat addq.l #4,sp move.l d0,d3 moveq #1,d2 move.w #_TkFl,d1 chiffre FLOAT bset #0,MathFlags(a5) Un peu de maths bra.s .FQuit ; Double precision .Double Rjsr L_AscToDouble addq.l #4,sp move.l d0,d3 move.l d1,d4 moveq #1,d2 move.w #_TkDFl,d1 .FQuit movem.l (sp)+,a0/a3-a6 moveq #0,d0 bra.s CalOut ; chiffre hexa Cal5: bsr Cexalong move.w #_TkHex,d2 bra.s Cal8 ; chiffre binaire Cal6: bsr Cinlong move.w #_TkBin,d2 bra.s Cal8 ; chiffre entier Cal7: bsr Ceclong move.w #_TkEnt,d2 Cal8: exg d2,d1 ;type de conversion--->d1 tst d2 bne.s Cal10 ;si probleme: ramene zero! move.l d0,d3 ; Test du signe, si entier tst d4 beq.s Cal8a neg.l d3 Cal8a: moveq #0,d2 bra.s CalOut ; ramene zero Cal10: moveq #0,d2 Erreur: ramene zero! moveq #0,d3 move.l d7,a0 moveq #1,d0 ; Sortie CalOut movem.l (sp)+,a1-a2/d5-d7 rts ; MINI CHRGET POUR LES CONVERSIONS ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Cinichr move.b (a0)+,d2 beq.s .mc1 cmp.b #32,d2 beq.s Cinichr cmp.b #"a",d2 ;si minuscule: majuscule bcs.s .mc0 sub.b #"a"-"A",d2 .mc0 sub.b #48,d2 rts .mc1 move.b #-1,d2 rts ; Minichr pour hexa ; ~~~~~~~~~~~~~~~~~ Cinichr2 move.b (a0)+,d2 beq.s .mc1 cmp.b #"a",d2 ;si minuscule: majuscule bcs.s .mc0 sub.b #"a"-"A",d2 .mc0: sub.b #48,d2 rts .mc1: move.b #-1,d2 rts ; CONVERSION DECIMAL->HEXA SUR QUATRE OCTETS, SIGNE! ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ceclong moveq #0,d0 moveq #0,d2 moveq #0,d3 move.l a0,-(sp) Cdh1: bsr Cinichr Cdh1a: cmp.b #10,d2 bcc.s Cdh5 move d0,d1 mulu #10,d1 swap d0 mulu #10,d0 swap d0 tst d0 bne.s Cdh2 add.l d1,d0 bcs.s Cdh2 add.l d2,d0 bmi.s Cdh2 addq #1,d3 bra.s Cdh1 Cdh2: move.l (sp)+,a0 moveq #1,d1 ;out of range: bpl, et recupere l'adresse rts Cdh5: subq.l #1,a0 addq.l #4,sp tst d3 beq.s Cdh7 moveq #0,d1 ;OK: chiffre en d0, et beq rts Cdh7: moveq #-1,d1 ;pas de chiffre: bmi rts ; CONVERSION HEXA-ASCII EN HEXA-HEXA ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Cexalong moveq #0,d0 moveq #0,d2 moveq #0,d3 move.l a0,-(sp) .hh1 bsr Cinichr2 cmp.b #10,d2 bcs.s .hh2 cmp.b #17,d2 bcs.s Cdh5 subq.w #7,d2 .hh2 cmp.b #16,d2 bcc.s Cdh5 lsl.l #4,d0 or.b d2,d0 addq.w #1,d3 cmp #9,d3 bne.s .hh1 beq.s Cdh2 ; CONVERSION BINAIRE ASCII ---> HEXA SUR QUATRE OCTETS ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Cinlong moveq #0,d0 moveq #0,d2 moveq #0,d3 move.l a0,-(sp) .bh1 bsr Cinichr cmp.b #2,d2 bcc.s Cdh5 roxr #1,d2 roxl.l #1,d0 bcs.s Cdh2 addq.w #1,d3 cmp.w #33,d3 bne.s .bh1 beq Cdh1 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; INITIALISATION PROGRAMME COMPILE PART 1 ; D0= Longueur du stack ; D1= Longueur buffer ; D2= Flags initialisation ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp CmpInit1 ; - - - - - - - - - - - - - ; Branche la routine de fin, si non definie tst.l Prg_JError(a5) bne.s .Skip lea CmpQuit(pc),a0 move.l a0,Prg_JError(a5) .Skip ; Stocke les flags de demarrage. Negatif >>> abort! move.w d2,DefFlag(a5) bmi.s .Mem ; Longueur du stack *** ; Flag WB2.0 move.l $4.w,a0 cmp.w #36,$14(a0) bcs.s .Pa20 move.w $14(a0),WB2.0(a5) .Pa20 ; Init VARBUF move.l d1,d0 SyCall MemFastClear beq.s .Mem move.l a0,VarBuf(a5) move.l d1,VarBufL(a5) ; Ok, Passe aux autres inits move.w #-1,T_AMOState(a5) rts ; Out of memory .Mem moveq #2,d0 move.l Prg_JError(a5),a1 jmp (a1) ; - - - - - - - - - - - - - CmpQuit ; - - - - - - - - - - - - - movem.l a0/d0,-(sp) Sauve les erreurs move.w #-2,DefFlag(a5) Rbsr L_DefRun1 Rjsr L_Bnk.EffAll Rbsr L_CmpClearVar Rbsr L_CmpLibrariesStop lea Sys_EndRoutines(a5),a1 Appelle les routines de fin SyCall CallRoutines SyCall MemFlush Enleve les routines flush Rbsr L_CmpLibClose Rbsr L_CmpEffVarBuf ; Retourne a l'appellant! movem.l (sp)+,a0/d0 move.l BasSp(a5),sp rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; INITIALISATION PROGRAMME COMPILE PART 2 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp CmpInit2 ; - - - - - - - - - - - - - tst.l d0 Un probleme dans les extensions? bne.s .Quit ; Initialisation ecrans move.w DefFlag(a5),d5 Flags de demarrage moveq #-2,d0 btst #FPrg_Default,d5 Ecran par defaut? beq.s .Skip1 moveq #-1,d0 .Skip1 move.w d0,DefFlag(a5) btst #FPrg_DefRunAcc,d5 Programme en accessoire? bne.s .Acc Rbsr L_DefRun1 Rbsr L_DefRun2 bra.s .Skip2 .Acc Rbsr L_DefRunAcc .Skip2 move.w #-1,DefFlag(a5) Pour le prochaine Default ; Force l'affichage SyCall WaitVbl EcCall CopForce ; Fin de l'init Rbsr L_CmpClearVar >>> Change A6 ; Fait passer devant le workbench? btst #FPrg_Wb,d5 Flag workbench? bne.s .WB EcCalD AMOS_WB,1 .WB rts .Quit move.l Prg_JError(a5),a1 jmp (a1) ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; INITIALISATION / SORTIE AMOS ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp AMOSInit ; - - - - - - - - - - - - - move.l (sp)+,a1 ; Sauvegarde des donnees du programme courant ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ movem.l a3-a6/d6/d7,-(sp) move.l Prg_JError(a5),-(sp) move.l EveLabel(a5),-(sp) move.l BasSp(a5),-(sp) move.l sp,BasSp(a5) ; Preparation des variables du programme ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ lea AMOSQuit(pc),a0 move.l a0,Prg_JError(a5) clr.l EveLabel(a5) move.l TabBas(a5),d7 sub.l a6,a6 jmp (a1) ; - - - - - - - - - - - - - AMOSQuit ; - - - - - - - - - - - - - move.l BasSp(a5),sp move.l (sp)+,BasSp(a5) move.l (sp)+,EveLabel(a5) move.l (sp)+,Prg_JError(a5) movem.l (sp)+,a3-a6/d6/d7 ; Si erreur dans le programme: appelle les routines DEFAULT / END ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ movem.l a0/d0,-(sp) lea Sys_ErrorRoutines(a5),a1 SyCall CallRoutines lea Sys_ClearRoutines(a5),a1 SyCall CallRoutines lea Sys_DefaultRoutines(a5),a1 SyCall CallRoutines lea Sys_EndRoutines(a5),a1 SyCall CallRoutines movem.l (sp)+,a0/d0 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; MODE DEBUG: rajoute "At Line" au message d'erreur ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp CmpDbMode ; - - - - - - - - - - - - - move.l (sp),a0 Branche la routine sur le retour lea .Debug(pc),a1 move.l a1,(sp) move.l sp,BasSp(a5) jmp (a0) .Debug tst.w d0 Une erreur? beq.s .End move.l d0,-(sp) lea .Buffer(pc),a2 move.l a0,d1 beq.s .NoMess move.l d1,a1 .Copy1 move.b (a1)+,(a2)+ bne.s .Copy1 subq.l #1,a2 .NoMess lea .Atline(pc),a1 .Copy2 move.b (a1)+,(a2)+ bne.s .Copy2 lea -1(a2),a0 moveq #0,d0 move.w Cmp_Ligne(a5),d0 Rjsr L_LongToDec clr.b (a0) move.l (sp)+,d0 lea .Buffer(pc),a0 ; Retourne au header .End rts .Buffer ds.b 128 .Atline dc.b " at line ",0 even ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; MODE DEBUG 1 : imprime le numero de la ligne sur le CLI ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp CmpLineCLI ; - - - - - - - - - - - - - moveq #0,d0 move.w Cmp_Ligne(a5),d0 move.l Buffer(a5),a0 move.b #"(",(a0)+ Rjsr L_LongToDec move.b #")",(a0)+ move.l a0,d3 move.l Buffer(a5),d2 sub.l d2,d3 Rbra L_CmpPrintCLI ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; MODE DEBUG 2 : imprime le numero su run ecran AMOS en front ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp CmpLineSER ; - - - - - - - - - - - - - moveq #0,d0 move.w Cmp_Ligne(a5),d0 move.l Buffer(a5),a0 move.b #"(",(a0)+ Rjsr L_LongToDec move.b #")",(a0)+ move.l a0,d3 move.l Buffer(a5),d2 sub.l d2,d3 Rbra L_CmpPrintSER ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Imprime la chaine D2/D3 sur le CLI ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp CmpPrintCLI ; - - - - - - - - - - - - - move.l a6,-(sp) move.l DosBase(a5),a6 jsr -60(a6) move.l d0,d1 beq.s .Exit jsr _LVOWrite(a6) .Exit move.l (sp)+,a6 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Imprime la chaine D2/D3 sur le AMOS ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp CmpPrintSER ; - - - - - - - - - - - - - ; tst.w Cmp_DebugScreen(a5) ; bne.s .Done ; movem.l d0-d7/a0-a3,-(sp) ; moveq #8,d1 Ecran editeur ; move.w #640,d2 ; move.w #8*8,d3 ; moveq #2,d4 ; move.w #$8000,d5 ; moveq #4,d6 ; lea DefPal(a5),a1 ; EcCall Cree ; beq.s .End ; move.w #8,Cmp_DebugScreen(a5) ;.Done rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Effacement du buffer de variables ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp CmpEffVarBuf ; - - - - - - - - - - - - - move.l VarBuf(a5),d0 beq.s .skip move.l d0,a1 move.l VarBufL(a5),d0 SyCall MemFree clr.l VarBuf(a5) .skip rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; APPEL INITIALISATION DES EXTENSIONS ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp CmpLibrariesInit ; - - - - - - - - - - - - - tst.b AdTokens(a5,d0.w) bne.s .Dejala addq.b #1,AdTokens(a5,d0.w) On la met! move.w d0,-(sp) # extension move.l Name1(a5),a1 Command line vide clr.b (a1) move.l #"APex",d1 Code AMOSPro move.l #VerNumber,d2 Numero de version jsr (a0) Appel move.w (sp)+,d3 ext.w d0 Refuse de charger... bpl.s .Nomi move.l a0,d0 cmp.l #"Err!",d1 Un Message? beq.s .Mess .Err moveq #-2,d0 Message header 1: cannot load ext bra.s .Out .Mess moveq #-1,d0 Message en A0 .Out rts .Nomi cmp.w d0,d3 Bon numero d'extension? bne.s .Err .Dejala moveq #0,d0 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; ARRET DES LIBRAIRIES Extensions ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp CmpLibrariesStop ; - - - - - - - - - - - - - - - - movem.l a2-a6/d2-d7,-(sp) moveq #26-1,d2 lea ExtAdr+26*16-16(a5),a2 lea AdTokens+26-1(a5),a3 .Loop tst.b (a3) Une extension? beq.s .Next subq.b #1,(a3) Decremente le compteur bne.s .Next move.l 8(a2),d0 Une routine de fin? beq.s .Next move.l d0,a0 movem.l a2/a3/d2,-(sp) Appel de la routine de fin jsr (a0) movem.l (sp)+,a2/a3/d2 move.l a2,a0 clr.l (a0)+ Efface les pointeurs clr.l (a0)+ clr.l (a0)+ clr.l (a0)+ .Next lea -16(a2),a2 subq.l #1,a3 dbra d2,.Loop movem.l (sp)+,a2-a6/d2-d7 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Ferme les libraries mathematiques ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp CmpLibClose ; - - - - - - - - - - - - - move.l a6,-(sp) move.l $4.w,a6 move.l FloatBase(a5),d0 beq.s .SkipM1 move.l d0,a1 jsr _LVOCloseLibrary(a6) clr.l FloatBase(a5) .SkipM1 move.l MathBase(a5),d0 beq.s .SkipM2 move.l d0,a1 jsr _LVOCloseLibrary(a6) clr.l MathBase(a5) .SkipM2 move.l DFloatBase(a5),d0 beq.s .SkipM3 move.l d0,a1 jsr _LVOCloseLibrary(a6) clr.l DFloatBase(a5) .SkipM3 move.l DMathBase(a5),d0 beq.s .SkipM4 move.l d0,a1 jsr _LVOCloseLibrary(a6) clr.l DMathBase(a5) .SkipM4 move.l (sp)+,a6 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; NETTOYAGES DES VARIABLES pour programme CLI ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp CmpClearVar ; - - - - - - - - - - - - - movem.l d0-d6/a0-a5,-(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 Rjsr 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 ; ~~~~~~~~~~~~~~~~~~~~~~~~ Rjsr L_Bnk.EffTemp Rjsr L_Bnk.Change Rjsr L_MenuReset Rjsr L_Dia_WarmInit clr.l EveLabel(a5) ; Rjsr L_FillFFree * Fait! ; Rjsr L_CloAll * Fait! ; Rjsr L_PRT_Close * Fait! ; Rjsr L_Dev.Close * Fait! ; Rjsr L_Lib.Close * Fait! ; Rjsr L_Arx_Close * Fait! ; Rjsr L_MnRaz * Fait! ; Rjsr L_OMnEff * Fait! ; Rjsr L_Dia_CloseChannels * Fait! ; Rjsr L_ResTempBuffer * Fait! ; Variables ; ~~~~~~~~~ move.l VarBuf(a5),d0 beq.s .Nul move.l d0,a0 move.l a0,a1 add.l VarBufL(a5),a1 move.l a1,TabBas(a5) move.l a1,d7 VGlobales ; clr.l VarLoc(a5) Au depart sub.l a6,a6 move.l a0,LoChaine(a5) move.l a0,ChVide(a5) move.l a0,ParamC(a5) clr.w (a0)+ move.l a0,HiChaine(a5) .Nul ; Init float ; ~~~~~~~~~~ move.w #-1,FixFlg(a5) clr.w ExpFlg(a5) movem.l (sp)+,d0-d6/a0-a5 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Operateur PLUS ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp PlusF ; - - - - - - - - - - - - - moveq #_LVOSPAdd,d2 Rjmpt L_Float_Operation ; - - - - - - - - - - - - - Lib_Cmp PlusC ; - - - - - - - - - - - - - move.l d3,a0 move.l (a3)+,a2 moveq #0,d3 move.w (a0),d3 ;taille de la deuxieme chaine beq.s plus11 ;deuxieme chaine nulle moveq #0,d0 move.w (a2),d0 beq.s plus10 ;premiere chaine nulle add.l d0,d3 cmp.l #String_Max,d3 Rbcc L_StooLong ;string too long! move.l a0,-(sp) Rbsr L_Demande move.w d3,(a0)+ ;poke la taille resultante move.w (a2)+,d0 beq.s plus4 subq.w #1,d0 plus3: move.b (a2)+,(a0)+ ;recopie de la premiere chaine dbra d0,plus3 plus4: move.l (sp)+,a2 move.w (a2)+,d0 beq.s plus6 subq #1,d0 plus5: move.b (a2)+,(a0)+ dbra d0,plus5 plus6: move.w a0,d0 ;rend pair btst #0,d0 beq.s plus7 addq.l #1,a0 plus7: move.l a0,HiChaine(a5) move.l a1,d3 rts plus10: move.l a0,d3 ;premiere chaine nulle: ramene la deuxieme rts plus11: move.l a2,d3 ;deuxieme chaine nulle: ramene la premiere rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Operateur moins ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp MoinsF ; - - - - - - - - - - - - - moveq #_LVOSPSub,d2 Rjmpt L_Float_Operation ; - - - - - - - - - - - - - Lib_Cmp MoinsC ; - - - - - - - - - - - - - move.l d3,d4 ;sauve pour plus tard move.l (a3)+,a2 clr.l d3 move.w (a2)+,d3 move.l d3,d1 Rbsr L_Demande ;prend la place une fois pour toute! move.w d3,(a0)+ beq.s ms4 addq #1,d3 lsr #1,d3 subq #1,d3 ms3: move.w (a2)+,(a0)+ ;recopie la chaine dbra d3,ms3 ms4: move.l a0,HiChaine(a5) addq.l #2,a1 ;chaine dont auquelle on soustrait en a1/d1 move.l d4,a2 clr.l d2 move (a2)+,d2 ;chaine a soustraire en a2/d2 ms5: clr.l d4 movem.l d1-d2/a1-a3,-(sp) Rbsr L_InstrFind movem.l (sp)+,d1-d2/a1-a3 tst.l d3 beq.s ms9 move.l a1,a0 move.l a1,d4 ;pour plus tard! subq.l #1,d3 move.l d3,d5 ;taille du debut a garder add.l d3,a1 ;pointe ou transferer la fin add.l d2,d3 add.l d3,a0 ;pointe la fin a recopier sub.l d3,d1 add.l d1,d5 ;taille finale en memoire subq.l #1,d1 bmi.s ms7 ms6: move.b (a0)+,(a1)+ dbra d1,ms6 ms7: move a0,d0 ;rend pair btst #0,d0 beq.s ms8 addq.l #1,a0 ms8: move.l a0,HiChaine(a5) move.l d4,a1 move.w d5,-2(a1) move.l d5,d1 bra.s ms5 ms9: moveq #2,d2 move.l a1,d3 subq.l #2,d3 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Operateur MULTIPLIE ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp MultE ; - - - - - - - - - - - - - move.l (a3)+,d2 clr d4 ;multiplication signee 32*32 bits tst.l d3 ;aabb*ccdd bpl.s mlt1 neg.l d3 not d4 mlt1: tst.l d2 ;tests des signes bpl.s mlt2 neg.l d2 not d4 * Peut on faire une mult rapide? mlt2: cmp.l #$00010000,d3 bcc.s mlt0 cmp.l #$00010000,d2 bcc.s mlt0 mulu d2,d3 ;quand on le peut: multiplication directe! tst.w d4 beq.s mltF neg.l d3 bra.s mltF * Multipcation lente mlt0: move d2,d1 mulu d3,d1 bmi.s mltO swap d2 move d2,d0 mulu d3,d0 swap d0 bmi.s mltO tst d0 bne.s mltO add.l d0,d1 bvs.s mltO swap d3 move d2,d0 mulu d3,d0 bne.s mltO swap d2 move d2,d0 mulu d3,d0 swap d0 bmi.s mltO tst d0 bne.s mltO add.l d0,d1 bvs.s mltO tst d4 ;signe du resultat beq.s mlt3 neg.l d1 mlt3: move.l d1,d3 mltF: rts mltO Rbra L_OverFlow ; - - - - - - - - - - - - - Lib_Cmp MultF ; - - - - - - - - - - - - - moveq #_LVOSPMul,d2 Rjmpt L_Float_Operation ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Operateur DIVISE ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp DiviseE ; - - - - - - - - - - - - - move.l (a3)+,d2 moveq #0,d4 tst.l d2 bpl.s dva bset #31,d4 neg.l d2 dva: tst.l d3 Rbeq L_DByZero ;division par zero! bpl.s dvb bchg #31,d4 neg.l d3 dvb: cmp.l #$10000,d3 ;Division rapide ou non? bcc.s dv0 move.l d2,d0 divu d3,d0 ;division rapide: 32/16 bits bvs.s dv0 moveq #0,d3 move d0,d3 bra.s dvc dv0: move.w #31,d4 ;division lente: 32/32 bits moveq #-1,d5 clr.l d1 dv2: lsl.l #1,d2 roxl.l #1,d1 cmp.l d3,d1 bcs.s dv1 sub.l d3,d1 lsr.l #1,d5 ;met X a un! dv1: roxl.l #1,d0 dbra d4,dv2 move.l d0,d3 dvc: tst.l d4 bpl.s dvd neg.l d3 dvd: rts ; - - - - - - - - - - - - - Lib_Cmp DiviseF ; - - - - - - - - - - - - - Rjsrt L_Float_Test Rbeq L_DByZero moveq #_LVOSPDiv,d2 Rjmpt L_Float_Operation ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Operateur PUISSANCE ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp Puissance ; - - - - - - - - - - - - - moveq #_LVOSPPow,d2 Rjmpt L_Math_Operation ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Operateur MODULO ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp Modulo ; - - - - - - - - - - - - - move.l d6,-(sp) move.l (a3)+,d6 tst.l d3 bpl.s mdv3 neg.l d3 mdv3: moveq #31,d2 ;division lente: 32/32 bits moveq #-1,d4 clr.l d1 mdv2: lsl.l #1,d6 roxl.l #1,d1 cmp.l d3,d1 bcs.s mdv1 sub.l d3,d1 lsr #1,d4 ;met X a un! mdv1: roxl.l #1,d0 dbra d2,mdv2 move.l d1,d3 ;prend le reste! move.l (sp)+,d6 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Comparaison de deux chaines ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp Chaine_Compare ; - - - - - - - - - - - - - move.l (a3)+,a0 move.l d3,a1 moveq #0,d3 moveq #0,d4 clr.b d2 move.w (a0)+,d0 move.w (a1)+,d1 beq.s cpch8 tst d0 beq.s cpch7 cpch1: cmpm.b (a0)+,(a1)+ bne.s cpch6 subq #1,d0 beq.s cpch3 subq #1,d1 bne.s cpch1 ; on est arrive au bout d'une des chaines cpch2: moveq #1,d4 A$>B$ bra.s cpch5 cpch3: subq #1,d1 egalite! beq.s cpch5 cpch4: moveq #1,d3 B$>A$ cpch5: cmp.l d4,d3 Positionne les bits rts ; on est arrive au bout des chaines cpch6: bcc.s cpch4 bcs.s cpch2 ; a$ est nulle cpch7: tst d1 bne.s cpch4 ;B$>A$ bra.s cpch5 ; b$ est nulle cpch8: tst d0 bne.s cpch2 ;A$>B$ bra.s cpch5 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; DEFRUN: initialisation graphique ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp DefRun1 ; - - - - - - - - - - - - - tst.w DefFlag(a5) beq DRunX movem.l d0-d7/a0-a6,-(sp) ; Enleve les animations ; ~~~~~~~~~~~~~~~~~~~~~ SyCall AMALClr clr.w PAmalE(a5) ; Enleve les rainbows ; ~~~~~~~~~~~~~~~~~~~ EcCalD RainDel,-1 ; Appel des routines de nettoyage ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ lea Sys_DefaultRoutines(a5),a1 SyCall CallRoutines ; Enleve tous les ecrans ; ~~~~~~~~~~~~~~~~~~~~~~ move.w PI_DefEBa(a5),ColBack(a5) moveq #0,d1 moveq #7,d2 EcCall DelAll clr.w ScOn(a5) clr.l ScOnAd(a5) move.w #8,CurTab(a5) Tab par defaut ; Enleve le tempras ; ~~~~~~~~~~~~~~~~~ clr.l RasLock(a5) Rjsr L_FreeRas ; Enleve les blocs! ; ~~~~~~~~~~~~~~~~~ EcCall CBlRaz EcCall BlRaz ; Enleve les font-infos ; ~~~~~~~~~~~~~~~~~~~~~ EcCall FFonts ; RAZ des canaux d'animation ; ~~~~~~~~~~~~~~~~~~~~~~~~~~ lea AnCanaux(a5),a0 moveq #0,d0 DRun1: clr.b (a0)+ move.b d0,(a0)+ addq.w #1,d0 cmp.w #64,d0 bne.s DRun1 ; Priority off ; ~~~~~~~~~~~~ moveq #0,d1 moveq #0,d2 SyCall SPrio ; RAZ des scrollings ; ~~~~~~~~~~~~~~~~~~ moveq #NDScrolls-1,d0 lea DScrolls(a5),a0 DRun2: move.w #$8000,(a0) lea 12(a0),a0 dbra d0,DRun2 ; Interruptions branchees ; ~~~~~~~~~~~~~~~~~~~~~~~ clr.w InterOff(a5) move.w InterOff(a5),d1 SyCall SetSync move.w #%0111000100000000,ActuMask(a5) clr.w VBLDelai(a5) clr.w VBLOCount(a5) ; Copie la palette par defaut ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~ lea PI_DefEPa(a5),a0 lea DefPal(a5),a1 moveq #31,d0 EdTr: move.w (a0)+,(a1)+ dbra d0,EdTr ; Call extensions ; ~~~~~~~~~~~~~~~ Rbsr L_DefRunExtensions ; Cree l'ecran (si pas system!) ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ cmp.w #-2,DefFlag(a5) beq.s DRex0 move.w PI_DefETx(a5),d2 ext.l d2 move.w PI_DefETy(a5),d3 ext.l d3 move.w PI_DefECo(a5),d4 ext.l d4 move.w PI_DefEMo(a5),d5 move.w PI_DefECoN(a5),d6 moveq #0,d7 lea DefPal(a5),a1 EcCalD Cree,0 bne.s DRex0 move.l a0,ScOnAd(a5) move.w #1,ScOn(a5) move.l #EntNul,d4 move.l d4,d5 move.w PI_DefEWx(a5),d2 Si non initialise... bne.s .Skip1 move.l d4,d2 .Skip1 move.w PI_DefEWy(a5),d3 bne.s .Skip2 move.l d4,d3 .Skip2 EcCalD AView,0 ; Fait flasher la couleur 3 (si plus de 2 couleurs) ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ cmp.w #1,PI_DefECo(a5) beq.s DRex0 moveq #3,d1 moveq #46,d0 Rjsr L_Sys_GetMessage move.l a0,a1 EcCall Flash DRex0 movem.l (sp)+,d0-d7/a0-a6 DRunX rts ; - - - - - - - - - - - - - Lib_Cmp DefRun2 ; - - - - - - - - - - - - - tst.w DefFlag(a5) beq.s .Out clr.w DefFlag(a5) ; Limite la souris ; ~~~~~~~~~~~~~~~~ move.w T_DefWX(a5),d1 move.w T_DefWY(a5),d2 move.w PI_DefETx(a5),d3 move.w PI_DefETy(a5),d4 subq.w #1,d3 subq.w #1,d4 add.w d1,d3 add.w d2,d4 lsl.w #1,d1 lsl.w #1,d2 lsl.w #1,d3 lsl.w #1,d4 lea LimSave(a5),a0 move.w d1,(a0)+ move.w d2,(a0)+ move.w d3,(a0)+ move.w d4,(a0)+ lea T_MouXMin(a5),a0 tst.l (a0) bne.s .Skip move.w d1,(a0)+ move.w d2,(a0)+ move.w d3,(a0)+ move.w d4,(a0)+ .Skip move.l PI_ParaTrap+16(a5),d1 * Nombre de lignes SyCall SBufHs SyCall OffHs SyCall StoreM SyCall StoreM SyCall AffHs .Out rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; DEFRUNACC: semi initialisation graphique pour accessoires ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp DefRunAcc ; - - - - - - - - - - - - - movem.l d0-d7/a0-a6,-(sp) ; Appel des routines de nettoyage ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ lea Sys_DefaultRoutines(a5),a1 SyCall CallRoutines ; Enleve les animations ; ~~~~~~~~~~~~~~~~~~~~~ SyCall AMALClr clr.w PAmalE(a5) ; RAZ des canaux d'animation ; ~~~~~~~~~~~~~~~~~~~~~~~~~~ lea AnCanaux(a5),a0 moveq #0,d0 .DRun1 clr.b (a0)+ move.b d0,(a0)+ addq.w #1,d0 cmp.w #64,d0 bne.s .DRun1 ; Priority off ; ~~~~~~~~~~~~ moveq #0,d1 moveq #0,d2 SyCall SPrio ; RAZ des scrollings ; ~~~~~~~~~~~~~~~~~~ moveq #NDScrolls-1,d0 lea DScrolls(a5),a0 .DRun2 move.w #$8000,(a0) lea 12(a0),a0 dbra d0,.DRun2 ; Interruptions branchees ; ~~~~~~~~~~~~~~~~~~~~~~~ clr.w InterOff(a5) move.w InterOff(a5),d1 SyCall SetSync move.w #%0111000100000000,ActuMask(a5) clr.w VBLDelai(a5) clr.w VBLOCount(a5) ; Call extensions ; ~~~~~~~~~~~~~~~ Rbsr L_DefRunExtensions ; Sprites ; ~~~~~~~ SyCall OffHs SyCall AffHs move.w #1,DefFlag(a5) movem.l (sp)+,d0-d7/a0-a6 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; INITIALISATION ECRAN DES EXTENSIONS ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp DefRunExtensions ; - - - - - - - - - - - - - movem.l a2-a6/d2-d7,-(sp) .DRex0 lea ExtAdr(a5),a0 moveq #26-1,d0 .DRex1 move.l 4(a0),d1 beq.s .DRex2 move.l d1,a1 movem.l a0/d0,-(sp) jsr (a1) movem.l (sp)+,a0/d0 .DRex2 lea 16(a0),a0 dbra d0,.DRex1 movem.l (sp)+,a2-a6/d2-d7 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; END ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InEnd ; - - - - - - - - - - - - - moveq #NbEnd,d0 Rbra L_GoError ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; TEST INTER SANS SAUT ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp Test_PaSaut ; - - - - - - - - - - - - - movem.l d0-d7/a0-a2,-(sp) bset #Bit_PaSaut,Test_Flags(a5) Rbsr L_Test_Normal bclr #Bit_PaSaut,Test_Flags(a5) movem.l (sp)+,d0-d7/a0-a2 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; TEST NORMAL ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp Test_Normal ; - - - - - - - - - - - - - moveq #1,d6 tst.b T_Actualise(a5) Rbmi L_Test_Force rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; TEST FORCE ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp Test_Force ; - - - - - - - - - - - - - move.w ActuMask(a5),d4 ; Inhibition par un autre AMOS? ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ SyCall Test_Cyclique ; Les dialogues??? ; ~~~~~~~~~~~~~~~~ move.l Cur_Dialogs(a5),a0 Un dialogue? tst.l (a0) beq.s .NoDia move.l GoTest_Dialog(a5),a0 jsr (a0) beq.s .NoDia add.w #IDia_Errors,d0 Rbra L_Error .NoDia ; Les menus??? ; ~~~~~~~~~~~~ btst #BitMenu,d4 Menus en route? beq.s Tst0 tst.l MnBase(a5) Un menu defini? beq.s Tst0 tst.w MnProc(a5) Pas dans une procedure menu bne.s Tst0 tst.l T_ClLast(a5) Une touche? beq.s Tst0a tst.w Direct(a5) Pas en mode direct bne.s Tst0a move.l GoTest_MenuKey(a5),a0 Appelle la routine jsr (a0) Tst0a btst #10,$dff016 Afficher le menu? bne.s Tst0 move.l GoTest_Menus(a5),a0 jsr (a0) Rbne L_Error ; Autres choses??? ; ~~~~~~~~~~~~~~~~ Tst0 move.w T_Actualise(a5),d3 bclr #BitControl,d3 bne.s Tst00 and.w d4,d3 beq TstX1 bra.s Tst1 ; CONTROLE-C? ; ~~~~~~~~~~~ Tst00 tst.l Mon_Base(a5) Retour au moniteur? bne.s IStop btst #BitControl,d4 Break autorise? beq.s Tst01 IStop move.w d3,T_Actualise(a5) moveq #9,d0 Rbra L_Error Tst01 move.w d3,T_Actualise(a5) move.l GoTest_OnBreak(a5),d0 beq.s Tst1a move.l d0,a0 jsr (a0) bra.s Tst1a ; Branchement automatique aux menus? ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Tst1 bclr #BitJump,d3 beq.s Tst1a move.l GoTest_GoMenu(a5),a0 jsr (a0) ; Actualisation des ecrans/animations ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Tst1a move.w T_VblCount+2(a5),d0 sub.w VBLOCount(a5),d0 cmp.w VBLDelai(a5),d0 bcs TstX1 move.w T_VblCount+2(a5),VBLOCount(a5) ; Bobs? bclr #BitBobs,d3 beq.s Tst2 SyCall EffBob SyCall ActBob SyCall AffBob EcCall SwapScS ; Hard Sprites? Tst2: bclr #BitSprites,d3 beq.s Tst3 SyCall ActHs SyCall AffHs ; Extensions? Tst3: lsr.b #1,d3 beq.s Tst4 lea ExtTests(a5),a1 bra.s Tst3b Tst3a move.l (a1),d0 beq.s Tst3b move.l d0,a0 jsr (a0) Tst3b addq.l #4,a1 lsr.b #1,d3 bcs.s Tst3a bne.s Tst3b ; Ecrans? Tst4: bclr #BitEcrans,d3 beq.s Tst5 EcCall CopMake Tst5: ; Correction du bug CONTROL-C / Beaucoup de sprites move.w T_Actualise(a5),d0 and.w #%0000000100000000,d0 BITCONTROL=8 or.w d0,d3 ; Every ; ~~~~~ TstX1 move.w d3,T_Actualise(a5) btst #BitEvery,d4 beq.s TstX2 tst.w T_EveCpt(a5) bgt.s TstX2 move.w EveCharge(a5),T_EveCpt(a5) bclr #BitEvery,d4 move.l GoTest_Every(a5),a0 jsr (a0) TstX2 bclr #BitVBL,T_Actualise(a5) rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Fait le branchement ON MENU ; Appele par TESTS ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp GoMenu ; - - - - - - - - - - - - - tst.w EveLabel(a5) bmi.s .GoMX lea MnChoix(a5),a0 move.w (a0),d0 beq.s .GoMX cmp.w OMnNb(a5),d0 bls.s .GoMGo .GoMX: rts ; Fait le branchement .GoMGo bclr #BitJump,d4 Restore les actualisations move.w d4,ActuMask(a5) move.w d3,T_Actualise(a5) Rbsr L_GetInstruction Adresse de l'instruction courante moveq #1,d6 Pour les erreurs move.l BasA3(a5),a3 Pile parametres move.l Cmp_LowPile(a5),sp move.l OMnBase(a5),a0 lsl.w #2,d0 move.l -4(a0,d0.w),a0 Adresse du saut tst.w OMnType(a5) bmi.s GoMG2 beq.s GoMG1 ; 1: Procedure! move.l a1,-(sp) Adresse de retour jmp (a0) ; 0: Gosub GoMG1 move.l a1,-(sp) Simple JSR move.l sp,Cmp_LowPile(a5) jmp (a0) ; -1: Goto GoMG2 jmp (a0) Simple JMP ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Fait le branchement a ON BREAK *** Brancher / Tester ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp OnBreakGo ; - - - - - - - - - - - - - btst #Bit_PaSaut,Test_Flags(a5) beq.s .Skip tst.l OnBreak(a5) bne.s .Jmp .Skip rts .Jmp Rbsr L_GetInstruction Instruction courante moveq #1,d6 Pas d'erreur move.l Cmp_LowPile(a5),sp move.l a1,-(sp) move.l OnBreak(a5),a0 jmp (a0) ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Fait le branchement a EVERY *** Tester ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp EveJump ; - - - - - - - - - - - - - tst.l EveLabel(a5) bne.s EveJ1 EveJ0 rts ; Branche! EveJ1 bmi.s EveJ0 bclr #BitEvery,d4 move.w d4,ActuMask(a5) Rbsr L_GetInstruction Adresse instruction courante moveq #1,d6 Pas de probleme erreur move.l Cmp_LowPile(a5),sp Restore la pile move.l EveLabel(a5),a0 Le label tst.w EveType(a5) bne.s EveJ2 ; Gosub! move.l a1,-(sp) move.l sp,Cmp_LowPile(a5) jmp (a0) ; Procedure! EveJ2 move.l a1,-(sp) jmp (a0) ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Erreurs de la premiere partie ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; - - - - - - - - - - - - - Lib_Cmp RIllDir ; - - - - - - - - - - - - - moveq #17,d0 Rbra L_Error ; - - - - - - - - - - - - - Lib_Cmp OOfData ; - - - - - - - - - - - - - moveq #33,d0 Rbra L_Error ; - - - - - - - - - - - - - Lib_Cmp OOfBuf ; - - - - - - - - - - - - - moveq #11,d0 Out of buffer space Rbra L_Error ; - - - - - - - - - - - - - Lib_Cmp InpTL ; - - - - - - - - - - - - - moveq #DEBase+20,d0 Rbra L_Error ; - - - - - - - - - - - - - Lib_Cmp EProErr ; - - - - - - - - - - - - - moveq #8,d0 Rbra L_Error ; - - - - - - - - - - - - - Lib_Cmp ResLNo ; - - - - - - - - - - - - - moveq #6,d0 Rbra L_Error ; - - - - - - - - - - - - - Lib_Cmp NoOnErr ; - - - - - - - - - - - - - moveq #5,d0 Rbra L_Error ; - - - - - - - - - - - - - Lib_Cmp ResPLab ; - - - - - - - - - - - - - moveq #4,d0 Rbra L_Error ; - - - - - - - - - - - - - Lib_Cmp NoResume ; - - - - - - - - - - - - - moveq #3,d0 Rbra L_Error ; - - - - - - - - - - - - - Lib_Cmp NoErr ; - - - - - - - - - - - - - moveq #7,d0 Rbra L_Error ; - - - - - - - - - - - - - Lib_Cmp OofStack ; - - - - - - - - - - - - - moveq #13,d0 Rbra L_Error ; - - - - - - - - - - - - - Lib_Cmp NonDim ; - - - - - - - - - - - - - moveq #27,d0 Rbra L_Error ; - - - - - - - - - - - - - Lib_Cmp AlrDim ; - - - - - - - - - - - - - moveq #28,d0 Rbra L_Error ; - - - - - - - - - - - - - Lib_Cmp DByZero ; - - - - - - - - - - - - - moveq #20,d0 Rbra L_Error ; - - - - - - - - - - - - - Lib_Cmp OverFlow ; - - - - - - - - - - - - - moveq #29,d0 Rbra L_Error ; - - - - - - - - - - - - - Lib_Cmp RetGsb ; - - - - - - - - - - - - - moveq #1,d0 Rbra L_Error ; - - - - - - - - - - - - - Lib_Cmp PopGsb ; - - - - - - - - - - - - - moveq #2,d0 Rbra L_Error ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; TRAITEMENT DES ERREURS RunErr: ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp Error ; - - - - - - - - - - - - - moveq #19,d1 moveq #-1,d2 Rbra L_ErrorExt ; - - - - - - - - - - - - - Lib_Cmp ErrorExt ; - - - - - - - - - - - - - ; Recupere les registres? ; ~~~~~~~~~~~~~~~~~~~~~~~ tst.b ErrorRegs(a5) beq.s .Skip clr.b ErrorRegs(a5) movem.l ErrorSave(a5),d6-d7 .Skip ; Ferme toutes les routines appellees ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; Rjsr L_D_Close ; Rjsr L_ResTempBuffer ; Rjsr L_MnEnd rajouter lors de procedure menu! movem.l d0-d3/a0,-(sp) lea Sys_ErrorRoutines(a5),a1 SyCall CallRoutines movem.l (sp)+,d0-d3/a0 ; Peut-on detourner l'erreur? ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~ clr.l PrintPos(a5) clr.w InputFlg(a5) clr.w ContFlg(a5) cmp.w #11,d0 Variable space? beq.s .skip cmp.w d1,d0 bcs rErr1 .skip cmp.w #1000,d0 Edit / Direct? bcc rErr1 tst.w Direct(a5) Mode direct bne rErr1 tst.w ErrorOn(a5) Erreur en route bne rErr1 Rbsr L_GetInstruction Trouve l'adresse de l'instruction cmp.l TrapAdr(a5),a1 TRAP? beq.s .ETrap tst.l OnErrLine(a5) On error goto beq rErr1 ; Erreurs detournees ; ~~~~~~~~~~~~~~~~~~ clr.l TrapAdr(a5) Plus de trap clr.w TrapErr(a5) addq.w #1,d0 addq.w #1,d2 lsl.w #8,d2 or.w d2,d0 move.w d0,ErrorOn(a5) Numero de l'erreur move.l BasA3(a5),a3 Restore les piles move.l Cmp_LowPile(a5),sp tst.w ErrorChr(a5) bmi.s .rErr0 move.l a1,ErrorChr(a5) move.l OnErrLine(a5),a0 jmp (a0) ; ON ERROR PROC ; ~~~~~~~~~~~~~ .rErr0 move.l a1,-(sp) Adresse de l'instruction move.l OnErrLine(a5),a0 Adresse de la procedure jmp 2(a0) D0= ErrorOn / Skippe le moveq #0,d0 ; Nouvelle intruction TRAP ; ~~~~~~~~~~~~~~~~~~~~~~~~ .ETrap clr.l TrapAdr(a5) addq.w #1,d2 lsl.w #8,d2 or.w d2,d0 move.w d0,TrapErr(a5) move.l BasA3(a5),a3 move.l Cmp_LowPile(a5),sp jmp (a2) Continue a l'instruction suivante ; Une erreur extension? ; ~~~~~~~~~~~~~~~~~~~~~ rErr1 move.l Prg_JError(a5),a2 Branchement de fin ext.l d0 move.l d0,d1 tst.w d2 bpl.s .ExtErr ; Erreur normale ; ~~~~~~~~~~~~~~ cmp.w #NbEnd,d0 End beq.s .Nul cmp.w #1000,d0 Edit / Direct bcc.s .Nul move.l Ed_RunMessages(a5),a0 Trouve le message addq.w #1,d0 Rbsr L_GetMessage move.l d1,d0 jmp (a2) ; Erreur extension: trouve le message ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .ExtErr tst.l d3 beq.s .Ext lea .MNul(pc),a0 bra.s .ExtOut .ELoop tst.b (a0)+ bne.s .ELoop .Ext dbra d1,.ELoop .ExtOut swap d2 clr.w d2 or.l d2,d0 D0= Message / Extension jmp (a2) .Nul moveq #0,d0 Pas d'erreur! jmp (a2) .MNul dc.w 0 Message nul! ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; DEBUT DES SWAPS AMOS / CLI ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; INSTRUCTION RUN ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InRun0 ; - - - - - - - - - - - - - rts ; - - - - - - - - - - - - - Lib_Cmp InRun0CLI ; - - - - - - - - - - - - - rts ; - - - - - - - - - - - - - Lib_Cmp InRun1 ; - - - - - - - - - - - - - tst.l Mon_Base(a5) bne.s .Acc tst.b Prg_Accessory(a5) bne.s .Acc ; Verifie la presence du programme move.l d3,a2 move.w (a2)+,d2 move.l Name1(a5),a0 Rjsr L_ChVerBuf2 Rjsr L_Dsk.PathIt move.l #1005,d2 Verifie la presence du fichier! Rbsr L_D_Open Rbeq L_DiskError Rbsr L_D_Close Le ferme! ; Branche a la routine RUN suite! moveq #-1,d0 sub.l a0,a0 move.l Prg_JError(a5),a1 jmp (a1) .Acc moveq #102,d0 Rbra L_Error ; - - - - - - - - - - - - - Lib_Cmp InRun1CLI ; - - - - - - - - - - - - - Rbsr L_RunName ; Short mem ou non? ; ~~~~~~~~~~~~~~~~ move.l Buffer(a5),a0 lea TBuffer-256-6(a0),a0 cmp.l #"CmdL",(a0)+ bne .Normal move.l 2(a0),d0 cmp.l #"-Mem",d0 beq.s .Short cmp.l #"-Def",d0 bne .Normal ; SHORT Mem, on ferme tout! ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .Short move.l d0,-(sp) move.w (a0),d0 Recopie la fin de la ligne de commande subq.w #5,d0 bpl.s .Skyp moveq #0,d0 .Skyp move.w d0,(a0)+ beq.s .Skop lea 5(a0),a1 subq.w #1,d0 .Loop move.b (a1)+,(a0)+ dbra d0,.Loop .Skop move.w #-2,DefFlag(a5) Rbsr L_DefRun1 cmp.l #"-Def",(sp)+ beq.s .Normal Rjsr L_Bnk.EffAll Rbsr L_CmpClearVar Rbsr L_CmpLibrariesStop Arret des extensions clr.l Prg_JError(a5) clr.l Sys_ErrorRoutines(a5) clr.l Sys_DefaultRoutines(a5) lea Sys_EndRoutines(a5),a1 Appelle les routines de fin SyCall CallRoutines SyCall MemFlush Enleve les routines flush Rbsr L_CmpLibClose Ferme les librairies Rbsr L_CmpEffVarBuf Efface les variables ; Branche au header, short mem reload!!! move.l BasSp(a5),sp move.l (sp)+,a0 jmp 8(a0) ; Assez de memoire, on reste tel quel ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .Normal ; Plus de variable Rjsr L_Bnk.EffAll Rbsr L_CmpClearVar lea Sys_DefaultRoutines(a5),a1 SyCall CallRoutines Rbsr L_CmpLibrariesStop Arret des extensions clr.l Prg_JError(a5) clr.l Sys_ErrorRoutines(a5) Plus d'effacement lea Sys_DefaultRoutines(a5),a1 SyCall CallRoutines lea Sys_EndRoutines(a5),a1 Appelle les routines de fin SyCall CallRoutines SyCall MemFlush Enleve les routines flush Rbsr L_CmpLibClose Ferme les librairies Rbsr L_CmpEffVarBuf Efface les variables ; Branche au header, normalement move.l BasSp(a5),sp move.l (sp)+,a0 jmp 4(a0) ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; PRUN en AMOS ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InPRun ; - - - - - - - - - - - - - tst.l Mon_Base(a5) bne .Acc move.l d3,a2 move.w (a2)+,d2 move.l Name1(a5),a0 Rjsr L_ChVerBuf2 ; Sauve le programme courant movem.l a3-a6/d6/d7,-(sp) move.l BasSp(a5),-(sp) ; Le programme est-il deja charge? JJsr L_Prg_AccAdr beq.s .Loadit move.l a0,a6 JJsr L_Prg_DejaRunned beq.s .Runit ; Il faut charger: verifie la presence du programme .Loadit Rjsr L_Dsk.PathIt move.l #1005,d2 Verifie la presence du fichier! Rbsr L_D_Open Rbeq L_DiskError Rbsr L_D_Close Le ferme! ; Ouvre une nouvelle structure moveq #0,d0 Pas de buffer JJsr L_Prg_NewStructure Ouvre la structure Rbeq L_OOfMem move.l d0,a6 ; Charge le programme moveq #-1,d0 Toujours adapter JJsr L_Prg_Load tst.w d0 bne .LErr move.l a6,-(sp) Remet les banques move.l Prg_Runned(a5),a6 du premier programme JJsr L_Prg_SetBanks move.l (sp)+,a6 ; Programme charge: on le demarre! .Runit moveq #-1,d0 Semi init graphique lea PRun_Errors(pc),a1 Retour en cas d'erreur sub.l a2,a2 Pas de message move.l sp,BasSp(a5) Bas de la pile JJsr L_Prg_RunIt bra.s .OMm ; Erreur lors du chargement .LErr move.w d0,d1 moveq #101,d0 cmp.w #-1,d1 beq.s .Goerr .OMm moveq #36,d0 ; Revient au programme, avec un message d'erreur .Goerr move.l d0,-(sp) tst.b Prg_Edited(a6) Efface la structure s'il faut bne.s .Edited JJsr L_Prg_DelStructure .Edited move.l Prg_Runned(a5),a6 JJsr L_Prg_SetBanks Rjsr L_Bnk.Change move.l (sp)+,d0 move.l Ed_RunMessages(a5),a0 Rjsr L_GetMessage move.l (sp)+,BasSp(a5) movem.l (sp)+,a3-a6/d6/d7 move.l sp,BasSp(a5) Rbra L_ZapReturn .Acc moveq #102,d0 Rbra L_Error ; Retour d'erreur lors de PRUN ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ PRun_Errors move.l BasSp(a5),sp move.l (sp)+,BasSp(a5) movem.l (sp)+,a3-a6/d6/d7 Restore le programme movem.l d6/d7,ErrorSave(a5) Au cas zou movem.l a0-a1/d0-d1,-(sp) JJsr L_Open_MathLibraries Rouvre les libraries movem.l (sp)+,a0-a1/d0-d1 cmp.w #10,d0 beq.s .Nul cmp.w #1000,d0 blt.s .Null .Nul moveq #0,d0 .Null move.l ChVide(a5),a0 Rbra L_ZapReturn ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; INSTRUCTION PRUN sous CLI ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InPRunCLI ; - - - - - - - - - - - - - L_DSave equ DataLong-DosBase+8*4 Rbsr L_RunName ; Sauve les donnees du programme courant move.l #L_DSave,d0 Reserve une zone de sauvegarde SyCall MemFast Rbeq L_OOfMem move.l a0,Prg_Run(a5) movem.l a3-a6/d6/d7,(a0) Sauve les registres lea 6*4(a0),a0 lea DosBase(a5),a1 move.l #(DataLong-DosBase)/2-1,d0 .Copy move.w (a1)+,(a0)+ Recopie les donnees dbra d0,.Copy move.l DosBase(a5),-(sp) Sauve DOSBASE ; Effacement selectif SyCall MemFlush Enleve les routines flush clr.l DFloatBase(a5) clr.l DMathBase(a5) clr.l FloatBase(a5) clr.l MathBase(a5) clr.l Sys_Banks(a5) Les messages systeme clr.l Ed_RunMessages(a5) clr.l Cmp_CurBanks(a5) Dialogues / banks programme clr.l Cmp_CurDialogs(a5) clr.l Sys_EndRoutines(a5) Routines flush clr.l Sys_ClearRoutines(a5) clr.l Sys_ErrorRoutines(a5) clr.l Sys_DefaultRoutines(a5) clr.l EveLabel(a5) Every! clr.l MnBase(a5) Menus clr.w OMnNb(a5) clr.l OMnBase(a5) clr.l Patch_Errors(a5) Plus de patchs clr.l Patch_Menage(a5) clr.l Patch_ScFront(a5) clr.l Patch_ScCopy(a5) bclr #1,ActuMask+1(a5) 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 lea .NextQuit(pc),a0 Effacement du programme suivant! move.l a0,Prg_JError(a5) ; Charge le programme move.l Name1(a5),d1 move.l (sp),a6 jsr _LVOLoadSeg(a6) move.l d0,Prg_Runned(a5) Les segments beq.s .Err lsl.l #2,d0 move.l d0,a0 addq.l #4,a0 move.l 2(a0),d2 Les flags move.l 2+6(a0),d3 bset #FHead_PRun,d2 C'est un PRUN! bset #FHead_Run,d2 C'est egalement un RUN! bset #FPrg_DefRunAcc+16,d2 DEFRUNACC pour le programme jsr 6+6(a0) On y va! ; Retour du programme suivant! .Back move.l (sp),a6 move.l d0,(sp) move.l Prg_Runned(a5),d1 Libere le programme beq.s .Nolib jsr _LVOUnLoadSeg(a6) .Nolib move.l Prg_Run(a5),a0 Recopie les donnees move.l a0,a1 movem.l (a0)+,a3-a6/d6/d7 lea DosBase(a5),a2 move.l #(DataLong-DosBase)/2-1,d0 .Copy2 move.w (a0)+,(a2)+ Recopie les donnees dbra d0,.Copy2 move.l #L_DSave,d0 Libere le buffer SyCall MemFree ; Remet les banques Rjsr L_Bnk.Change ; Met le PARAM move.l (sp)+,ParamE(a5) rts ; Out of memory .Err moveq #24,d0 bra.s .Back ; Effacement du programme suivant .NextQuit movem.l a0/d0,-(sp) Sauve les erreurs lea Sys_DefaultRoutines(a5),a1 SyCall CallRoutines lea Sys_EndRoutines(a5),a1 Appelle les routines de fin SyCall CallRoutines SyCall MemFlush Enleve les routines flush Rjsr L_Bnk.EffAll Rbsr L_CmpClearVar Rbsr L_CmpLibrariesStop Rbsr L_CmpLibClose Rbsr L_CmpEffVarBuf ; Retourne a l'appellant (le header du deuxieme) movem.l (sp)+,a0/d0 move.l BasSp(a5),sp rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; ASK EDITOR ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InAskEditor1 ; - - - - - - - - - - - - - move.l d3,-(a3) move.l #EntNul,d3 move.l d3,-(a3) Rbra L_InAskEditor3 ; - - - - - - - - - - - - - Lib_Cmp InAskEditor1CLI ; - - - - - - - - - - - - - Rbra L_FonCall ; - - - - - - - - - - - - - Lib_Cmp InAskEditor2 ; - - - - - - - - - - - - - move.l d3,-(a3) move.l #EntNul,d3 Rbra L_InAskEditor3 ; - - - - - - - - - - - - - Lib_Cmp InAskEditor2CLI ; - - - - - - - - - - - - - Rbra L_FonCall ; - - - - - - - - - - - - - Lib_Cmp InAskEditor3 ; - - - - - - - - - - - - - Rbsr L_Ed_Par tst.l Edit_Segment(a5) Rbeq L_FonCall JJsr L_Ed_ZapFonction move.l d0,ParamE(a5) move.l ChVide(a5),ParamC(a5) tst.w d2 beq.s .Skip Rjsr L_A0ToChaine move.l a0,ParamC(a5) .Skip rts ; - - - - - - - - - - - - - Lib_Cmp InAskEditor3CLI ; - - - - - - - - - - - - - Rbra L_FonCall ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; ZAPPEUSE D'EDITEUR! ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InCallEditor1 ; - - - - - - - - - - - - - move.l d3,-(a3) move.l #EntNul,d3 move.l d3,-(a3) Rbra L_InCallEditor3 ; - - - - - - - - - - - - - Lib_Cmp InCallEditor1CLI ; - - - - - - - - - - - - - Rbra L_FonCall ; - - - - - - - - - - - - - Lib_Cmp InCallEditor2 ; - - - - - - - - - - - - - move.l d3,-(a3) move.l #EntNul,d3 Rbra L_InCallEditor3 ; - - - - - - - - - - - - - Lib_Cmp InCallEditor2CLI ; - - - - - - - - - - - - - Rbra L_FonCall ; - - - - - - - - - - - - - Lib_Cmp InCallEditor3 ; - - - - - - - - - - - - - Rbsr L_Ed_Par Recupere les parametres tst.l Edit_Segment(a5) Editeur present? Rbeq L_FonCall move.l BasSp(a5),-(sp) Sauve le bas de la pile movem.l a3-a6/d6/d7,-(sp) Pousse tout move.l sp,BasSp(a5) subq.l #4,BasSp(a5) Change le bas de la pile JJsr L_Ed_ZapIn Appel de l'editeur, avec ADTOKENS movem.l (sp)+,a3-a6/d6/d7 Recupere tout move.l (sp)+,BasSp(a5) Remet BasSp! Rbra L_ZapReturn ; - - - - - - - - - - - - - Lib_Cmp InCallEditor3CLI ; - - - - - - - - - - - - - Rbra L_FonCall ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; MET LES BANQUES DU PROGRAMME PRECEDENT, SI DEFINI ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp Bnk.PrevProgram ; - - - - - - - - - - - - - Si programme AMOS move.l a4,-(sp) move.l AdTokens(a5),a4 Ijsr L_Bnk.PrevProgram move.l (sp)+,a4 rts ; - - - - - - - - - - - - - Lib_Cmp Bnk.PrevProgramCLI ; - - - - - - - - - - - - - Si Programme CLI moveq #0,d0 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; MET LES BANQUES DU PROGRAMME COURANT, SI DEFINI ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp Bnk.CurProgram ; - - - - - - - - - - - - - Si programme AMOS move.l a4,-(sp) move.l AdTokens(a5),a4 Ijsr L_Bnk.CurProgram move.l (sp)+,a4 rts ; - - - - - - - - - - - - - Lib_Cmp Bnk.CurProgramCLI ; - - - - - - - - - - - - - Si programme CLI rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; =Prg Under ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp FnPrgUnder ; - - - - - - - - - - - - - Si sous AMOS move.l a4,-(sp) move.l AdTokens(a5),a4 Ijsr L_FnPrgUnder move.l (sp)+,a4 rts ; - - - - - - - - - - - - - Lib_Cmp FnPrgUnderCLI ; - - - - - - - - - - - - - Si programme CLI tst.l Prg_Runned(a5) sne d3 ext.w d3 ext.l d3 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; CLOSE EDITOR ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InCloseEditor ; - - - - - - - - - - - - - move.l a4,-(sp) move.l AdTokens(a5),a4 Ijsr L_InCloseEditor move.l (sp)+,a4 rts ; - - - - - - - - - - - - - Lib_Cmp InCloseEditorCLI ; - - - - - - - - - - - - - rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; KILL EDITOR ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InKillEditor ; - - - - - - - - - - - - - move.l a4,-(sp) move.l AdTokens(a5),a4 Ijsr L_InKillEditor move.l (sp)+,a4 rts ; - - - - - - - - - - - - - Lib_Cmp InKillEditorCLI ; - - - - - - - - - - - - - rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; MONITOR ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InMonitor ; - - - - - - - - - - - - - rts ; - - - - - - - - - - - - - Lib_Cmp InMonitorCLI ; - - - - - - - - - - - - - rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; FIN DES ROUTINES AMOS / CLI ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; VERIFICATION DU FICHIER RUN / PRUN CLI ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp RunName ; - - - - - - - - - - - - - move.l d3,a2 Rbsr L_NomDisc move.l Name1(a5),a0 .Run0 tst.b (a0)+ bne.s .Run0 subq.l #1,a0 lea Suffix(pc),a1 .Run1 move.b -(a0),d0 cmp.b #"a",d0 bcs.s .Run1a cmp.b #"z",d0 bhi.s .Run1a sub.b #32,d0 .Run1a move.b (a1)+,d1 beq.s .Run2 cmp.b d0,d1 bne.s .Run3 beq.s .Run1 .Run2 clr.b 1(a0) ; Ouvre le fichier (si present) .Run3 move.l #1005,d2 Rbsr L_D_Open Rbeq L_DiskError ; Charge l'entete move.l Name2(a5),d2 moveq #5*4,d3 Rbsr L_D_Read Rbne L_DiskError ; Un programme? move.l d2,a2 add.l d3,d2 cmp.l #$3F3,(a2) Rbne L_DiskError ; Ok, on peut fermer Rbsr L_D_Close rts .NoF moveq #81,d0 Erreur normale! Rbra L_Error Suffix dc.b "SOMA.",0 even ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Recupere les parametres ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp Ed_Par ; - - - - - - - - - - - - - move.l Name1(a5),a0 move.l Name2(a5),a1 clr.w (a1) move.l d3,d0 beq.s .Skip move.l d0,a2 move.w (a2)+,d2 move.w d2,(a1) Rjsr L_ChVerBuf2 .Skip move.l (a3)+,d1 move.l (a3)+,d0 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Retour de zappeuse ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp ZapReturn ; - - - - - - - - - - - - - move.l ChVide(a5),ParamC(a5) ext.l d0 move.l d0,ParamE(a5) beq.s .Skip Rjsr L_A0ToChaine move.l a0,ParamC(a5) .Skip rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; =Prg State ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp FnPrgState ; - - - - - - - - - - - - - move.w T_AMOState(a5),d3 ext.l d3 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; TROUVE LE DEBUT DE L'INSTRUCTION ACTUELLE >>> A1 / A2 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp GetInstruction ; - - - - - - - - - - - - - move.l Cmp_LowPile(a5),a1 move.l -4(a1),a1 Adresse de retour subq.l #2,a1 Au milieu du jsr Rbra L_GetInstruction2 ; - - - - - - - - - - - - - Lib_Cmp GetInstruction2 ; - - - - - - - - - - - - - movem.l a0/d0-d3,-(sp) move.l Cmp_ListInst(a5),a0 move.l (a0)+,d3 move.w (a0)+,d1 Nombre d'instructions sub.l d3,a1 En relatif lsr.w #1,d1 move.w d1,d2 ; Boucle de recherche .Loop move.w d1,d0 lsl.w #2,d0 cmp.l -4(a0,d0.w),a1 bcs.s .Prev cmp.l 0(a0,d0.w),a1 bcs.s .Found lsr.w #1,d2 beq.s .Pas add.w d2,d1 bra.s .Loop .Prev lsr.w #1,d2 beq.s .Pas subx.w d2,d1 bra.s .Loop ; Pas trouve, cherche au dessus .Pas lea 0(a0,d0.w),a2 .Find cmp.l (a2)+,a1 bcc.s .Find subq.l #8,a2 bra.s .Return .Found lea -4(a0,d0.w),a2 .Return move.l (a2)+,a1 move.l (a2),a2 add.l d3,a1 add.l d3,a2 movem.l (sp)+,a0/d0-d3 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; SYSTEM ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InSystem ; - - - - - - - - - - - - - move.w #1002,d0 Rbra L_GoError ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; EDIT ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InEdit ; - - - - - - - - - - - - - move.w #1000,d0 Rbra L_GoError ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; DIRECT ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InDirect ; - - - - - - - - - - - - - move.w #1001,d0 Rbra L_GoError ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; BREAK ON / OFF ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InBreakOn ; - - - - - - - - - - - - - bset #BitControl,ActuMask(a5) clr.l OnBreak(a5) rts ; - - - - - - - - - - - - - Lib_Cmp InBreakOff ; - - - - - - - - - - - - - bclr #BitControl,ActuMask(a5) rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; ON BREAK PROC ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InOnBreak ; - - - - - - - - - - - - - move.l a0,OnBreak(a5) bclr #BitControl,ActuMask(a5) Rlea L_OnBreakGo,0 La routine de branchement move.l a0,GoTest_OnBreak(a5) rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; ON ERROR ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InOnError ; - - - - - - - - - - - - - tst.w ErrorOn(a5) Rbne L_NoResume clr.l OnErrLine(a5) clr.l ErrorChr(a5) rts ; - - - - - - - - - - - - - Lib_Cmp InOnErrorGoto ; - - - - - - - - - - - - - tst.w ErrorOn(a5) Rbne L_NoResume move.l a0,OnErrLine(a5) clr.l ErrorChr(a5) rts ; - - - - - - - - - - - - - Lib_Cmp InOnErrorProc ; - - - - - - - - - - - - - tst.w ErrorOn(a5) Rbne L_NoResume move.l a0,OnErrLine(a5) clr.l ErrorChr(a5) bset #7,ErrorChr(a5) rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; RESUME LABEL ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InResumeLabel ; - - - - - - - - - - - - - tst.w ErrorOn(a5) Rbeq L_NoErr Rbsr L_PopP clr.w ErrorOn(a5) move.l ErrorChr(a5),d0 bclr #31,d0 Rbeq L_NoOnErr tst.l d0 Rbeq L_ResLNo move.l d0,a0 jmp (a0) ; - - - - - - - - - - - - - Lib_Cmp InResumeLabel1 ; - - - - - - - - - - - - - tst.l OnErrLine(a5) Rbeq L_NoOnErr tst.w ErrorChr(a5) Rbpl L_NoOnErr move.l a0,d0 bset #31,d0 move.l d0,ErrorChr(a5) rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; RESUME [label] ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InResume ; - - - - - - - - - - - - - Rbsr L_Test_PaSaut tst.w ErrorOn(a5) Rbeq L_NoErr move.l ErrorChr(a5),d0 bmi.s L985a move.l d0,a0 clr.w ErrorOn(a5) jmp (a0) L985a Rbsr L_PopP clr.w ErrorOn(a5) jmp (a0) ; - - - - - - - - - - - - - Lib_Cmp InResume1 ; - - - - - - - - - - - - - move.l a0,-(sp) Rbsr L_Test_PaSaut move.l (sp)+,a0 tst.w ErrorOn(a5) Rbeq L_NoErr clr.w ErrorOn(a5) tst.w ErrorChr(a5) Rbmi L_ResPLab jmp (a0) ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; RESUME NEXT ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InResumeNext ; - - - - - - - - - - - - - Rbsr L_Test_PaSaut tst.w ErrorOn(a5) Rbeq L_NoErr move.l ErrorChr(a5),d0 Une procedure? bpl.s .Skip Rbsr L_PopP subq.l #4,sp Pour le depilage! move.l a0,d0 .Skip move.l d0,a1 Cherche l'instruction suivante Rbsr L_GetInstruction2 clr.w ErrorOn(a5) addq.l #4,sp Depile la fonction jmp (a2) Branche ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; TRAP ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InTrap ; - - - - - - - - - - - - - move.l (sp),TrapAdr(a5) L'adresse de retour! clr.w TrapErr(a5) rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; =TRAPERR ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp FnErrTrap ; - - - - - - - - - - - - - moveq #0,d3 move.w TrapErr(a5),d3 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; EVERY GOSUB ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InEveryGosub ; - - - - - - - - - - - - - clr.w EveType(a5) Rbra L_InEvery ; - - - - - - - - - - - - - Lib_Cmp InEveryProc ; - - - - - - - - - - - - - move.w #-1,EveType(a5) Rbra L_InEvery ; - - - - - - - - - - - - - Lib_Cmp InEvery ; - - - - - - - - - - - - - bclr #BitEvery,ActuMask(a5) move.l a0,EveLabel(a5) Rlea L_EveJump,0 Routine de branchement move.l a0,GoTest_Every(a5) move.l (a3)+,d0 Rbeq L_FonCall cmp.l #32767,d0 Rbcc L_FonCall move.w d0,EveCharge(a5) move.w d0,T_EveCpt(a5) bset #BitEvery,ActuMask(a5) rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; EVERY OFF ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InEveryOff ; - - - - - - - - - - - - - bclr #BitEvery,ActuMask(a5) rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; EVERY ON ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InEveryOn ; - - - - - - - - - - - - - bset #BitEvery,ActuMask(a5) rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; NEXT ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InNext ; - - - - - - - - - - - - - move.l (a2)+,d4 move.l (a2)+,d5 move.l (a2),a2 add.l d4,(a2) tst.l d4 bmi.s L51a cmp.l (a2),d5 blt.s L51b addq.l #4,sp jmp (a1) L51a cmp.l (a2),d5 bgt.s L51b addq.l #4,sp jmp (a1) L51b rts ; - - - - - - - - - - - - - Lib_Cmp InNextF ; - - - - - - - - - - - - - move.l a6,-(sp) move.l (a2)+,d4 move.l (a2)+,d5 move.l (a2),a2 move.l FloatBase(a5),a6 move.l d4,d1 jsr SPTst(a6) move.l d0,d6 move.l d4,d0 move.l (a2),d1 jsr SPAdd(a6) move.l d0,(a2) move.l d5,d1 jsr SPCmp(a6) move.l (sp)+,a6 blt.s NxtF1 tst.l d6 bpl.s NxtS bmi.s NxtR NxtF1 tst.l d6 bpl.s NxtR bmi.s NxtS NxtR addq.l #4,sp jmp (a1) NxtS rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; RETURN ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InReturn ; - - - - - - - - - - - - - cmp.l Cmp_LowPileP(a5),sp beq.s .err addq.l #4,Cmp_LowPile(a5) rts .err moveq #1,d0 Rbra L_Error ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; POP ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InPop ; - - - - - - - - - - - - - move.l (sp)+,a0 cmp.l Cmp_LowPileP(a5),sp beq.s .err addq.l #4,sp move.l sp,Cmp_LowPile(a5) jmp (a0) .err moveq #2,d0 Rbra L_GoError ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Procedure ; D0= ErrorOn ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp DProc1 ; - - - - - - - - - - - - - move.l (sp)+,a2 ; Empile les params ; Adresse de retour -(sp) RTS move.l a6,-(sp) 0 move.l Cmp_AdLabels(a5),-(sp) 1 ; move.l VarLoc(a5),-(sp) 2= A6! move.l Cmp_AForNext(a5),-(sp) 3 move.l Cmp_ListInst(a5),-(sp) ! move.l TabBas(a5),-(sp) 4 move.l OnErrLine(a5),-(sp) 5 move.l ErrorChr(a5),-(sp) 6 move.w ErrorOn(a5),-(sp) 7 move.l PData(a5),-(sp) 8 move.l AData(a5),-(sp) 9 move.l Cmp_LowPile(a5),-(sp) 10 move.l Cmp_LowPileP(a5),-(sp) 11 move.l sp,Cmp_LowPileP(a5) move.l sp,Cmp_LowPile(a5) clr.l OnErrLine(a5) move.w d0,ErrorOn(a5) jmp (a2) ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Debut procedure 2: affect les variables / Float ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp DProc2F ; - - - - - - - - - - - - - move.w d3,d2 beq.s .Nopar lsl.w #2,d2 lea 0(a3,d2.w),a2 Pointeur sur les parametres subq.w #1,d3 Compteur .Loop move.l (a2)+,d0 lsr.l #1,d4 Flags variables bcs.s .Flt ; On veut un entier lsr.l #1,d5 Flags parametres bcc.s .Loke move.l a6,-(sp) move.l FloatBase(a5),a6 jsr _LVOSPFix(a6) move.l (sp)+,a6 bra.s .Loke ; On veut un float .Flt lsr.l #1,d5 bcs.s .Loke move.l a6,-(sp) move.l FloatBase(a5),a6 jsr _LVOSPFlt(a6) move.l (sp)+,a6 ; Affecte la variable .Loke move.l (a3)+,a0 move.l d0,(a0) dbra d3,.Loop move.l a2,a3 .Nopar rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Debut procedure 2: affect les variables / Double ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp DProc2D ; - - - - - - - - - - - - - move.w d3,d2 beq.s .Nopar lsl.w #2,d2 lea 0(a3,d2.w),a2 Pointeur sur les parametres subq.w #1,d3 Compteur .Loop lsr.l #1,d4 bcs.s .Flt ; On veut un entier lsr.l #1,d5 bcc.s .Loke1 movem.l (a2)+,d0-d1 move.l a6,-(sp) move.l DFloatBase(a5),a6 jsr _LVOIEEEDPFix(a6) move.l (sp)+,a6 move.l (a3)+,a0 move.l d0,(a0) bra.s .Next .Loke1 move.l (a3)+,a0 move.l (a2)+,(a0) bra.s .Next ; On veut un double .Flt lsr.l #1,d5 bcs.s .Loke2 move.l (a2)+,d0 move.l a6,-(sp) move.l DFloatBase(a5),a6 jsr _LVOIEEEDPFlt(a6) move.l (sp)+,a6 move.l (a3)+,a0 movem.l d0-d1,(a0) bra.s .Next .Loke2 move.l (a3)+,a0 movem.l (a2)+,d0-d1 movem.l d0-d1,(a0) .Next dbra d3,.Loop move.l a2,a3 .Nopar rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; FIN PROCEDURE ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp FProc ; - - - - - - - - - - - - - tst.w ErrorOn(a5) Rbne L_EProErr move.l Cmp_LowPileP(a5),sp move.l (sp)+,Cmp_LowPileP(a5) 11 move.l (sp)+,Cmp_LowPile(a5) 10 move.l (sp)+,AData(a5) 9 move.l (sp)+,PData(a5) 8 move.w (sp)+,ErrorOn(a5) 7 move.l (sp)+,ErrorChr(a5) 6 move.l (sp)+,OnErrLine(a5) 5 move.l (sp)+,TabBas(a5) 4 move.l (sp)+,Cmp_ListInst(a5) ! move.l (sp)+,Cmp_AForNext(a5) 3 ; move.l (sp)+,VarLoc(a5) 2= A6! move.l (sp)+,Cmp_AdLabels(a5) 1 move.l (sp)+,a6 0 rts RTS ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; ENTREE PROGRAMME : RESERVE / INIT L'ESPACE VARIABLES / FLOAT ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp PrgInF ; - - - - - - - - - - - - - move.l d0,Cmp_AdLabels(a5) move.l a0,Cmp_ListInst(a5) move.l (sp),(a0) move.l a2,AData(a5) move.l a2,PData(a5) move.l TabBas(a5),a0 ; Verifie la taille move.l a6,-(a0) Debut des prochaines vlocales move.w #$FFFF,-(a0) moveq #0,d0 move.w (a1)+,d1 Taille du buffer FOR-NEXT move.w (a1)+,d0 Taille des VARLOC add.w d1,d0 sub.l d0,a0 lea -8(a0),a2 Adresse minimale, avec securite cmp.l HiChaine(a5),a2 bls.s .Outb move.l a0,Cmp_AForNext(a5) Buffer for/next move.l a0,TabBas(a5) Haut des tableaux lea 0(a0,d1.w),a6 A6= Varloc= Debut Variables locales moveq #1,d6 Pour les erreurs ; Cree la table moveq #0,d0 move.b (a1)+,d0 Une table? bpl.s .Table rts .Table or.w #$0400,d0 move.l ChVide(a5),d1 move.l a6,a0 .Loop move.w d0,(a0)+ Met le flag cmp.b #2,d0 bne.s .Ent move.l d1,(a0)+ Chaine bra.s .Next .Ent clr.l (a0)+ Entier / Float / Tableau .Next move.b (a1)+,d0 bpl.s .Loop rts ; Erreur, pas assez de place dans le buffer! .Outb move.l d0,d3 Demande TROP add.w #32,d3 Rbsr L_PopP move.l a0,-(sp) Adresse d'appel de la procedure Rbra L_Demande Pour forcer le menage ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; ENTREE PROGRAMME : RESERVE / INIT L'ESPACE VARIABLES / DOUBLE ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp PrgInD ; - - - - - - - - - - - - - move.l d0,Cmp_AdLabels(a5) move.l a0,Cmp_ListInst(a5) move.l (sp),(a0) move.l a2,AData(a5) move.l a2,PData(a5) move.l TabBas(a5),a0 ; Verifie la taille move.l a6,-(a0) Debut des prochaines vlocales move.w #$FFFF,-(a0) moveq #0,d0 move.w (a1)+,d1 Taille du buffer FOR-NEXT move.w (a1)+,d0 Taille des VARLOC add.w d1,d0 sub.l d0,a0 lea -8(a0),a2 Adresse minimale, avec securite cmp.l HiChaine(a5),a2 bls.s .Outb move.l a0,Cmp_AForNext(a5) Buffer for/next move.l a0,TabBas(a5) Haut des tableaux lea 0(a0,d1.w),a6 A6= Varloc= Debut Variables locales moveq #1,d6 Pour les erreurs ; Cree la table moveq #0,d0 move.b (a1)+,d0 Une table? bpl.s .Table rts .Table or.w #$0400,d0 move.l ChVide(a5),d1 move.l a6,a0 .Loop cmp.b #1,d0 beq.s .Dbl cmp.b #2,d0 bne.s .Ent move.w d0,(a0)+ move.l d1,(a0)+ Chaine bra.s .Next .Dbl move.w #$0801,(a0)+ Flag Double clr.l (a0)+ Double clr.l (a0)+ bra.s .Next .Ent move.w d0,(a0)+ Entier clr.l (a0)+ .Next move.b (a1)+,d0 beq.s .Ent bpl.s .Loop rts ; Erreur, pas assez de place dans le buffer! .Outb move.l d0,d3 Demande TROP add.w #32,d3 Rbsr L_PopP move.l a0,-(sp) Adresse d'appel de la procedure Rbra L_Demande Pour forcer le menage ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; ROUTINE POP PROC ; A0--> Adresse de retour ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp PopP ; - - - - - - - - - - - - - move.l (sp)+,a1 move.l Cmp_LowPileP(a5),sp move.l (sp)+,Cmp_LowPileP(a5) 11 move.l (sp)+,Cmp_LowPile(a5) 10 move.l (sp)+,AData(a5) 9 move.l (sp)+,PData(a5) 8 move.w (sp)+,ErrorOn(a5) 7 move.l (sp)+,ErrorChr(a5) 6 move.l (sp)+,OnErrLine(a5) 5 move.l (sp)+,TabBas(a5) 4 move.l (sp)+,Cmp_ListInst(a5) ! move.l (sp)+,Cmp_AForNext(a5) 3 ; move.l (sp)+,VarLoc(a5) 2= A6 move.l (sp)+,Cmp_AdLabels(a5) 1 move.l (sp)+,a6 0 move.l (sp)+,a0 RTS jmp (a1) ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; GET LABEL expression ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp GetLabelE ; - - - - - - - - - - - - - move.l d3,d0 move.l BufLabel(a5),a0 move.l a0,a2 Rjsr L_LongToDec move.l a0,d2 sub.l a2,d2 Rbra L_GetLabel ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; GET LABEL alphanumerique ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp GetLabelA ; - - - - - - - - - - - - - move.l d3,a1 move.w (a1)+,d2 Rbeq L_FonCall cmp.w #32,d2 Rbcc L_FonCall move.w d2,d1 subq.w #1,d1 move.l BufLabel(a5),a0 move.l a0,a2 L58a move.b (a1)+,d0 cmp.b #"A",d0 bcs.s L58b cmp.b #"Z",d0 bhi.s L58b add.b #32,d0 L58b move.b d0,(a0)+ dbra d1,L58a Rbra L_GetLabel ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; GET LABEL ; D5= Numero de procedure ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp GetLabel ; - - - - - - - - - - - - - btst #0,d2 beq.s L59a clr.b (a0)+ addq.w #1,d2 * Trouve le label L59a move.w d5,(a0)+ move.w d2,d3 lsr.w #1,d3 addq.w #2,d2 move.l Cmp_AdLabels(a5),a1 move.l a2,d4 L59b move.w (a1),d1 Rbeq L_FonCall cmp.w d2,d1 bne.s L59n move.l d4,a2 lea 6(a1),a0 move.w d3,d0 L59c cmp.w (a0)+,(a2)+ bne.s L59n dbra d0,L59c * Trouve! move.l 2(a1),a0 rts * Label suivant L59n lea 6(a1,d1.w),a1 bra.s L59b ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; DIM ; A0= Adresse variable ; D0= Nombre params ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InDim ; - - - - - - - - - - - - - tst.l (a0) Already dimensionned bne EAlrDim ; Recupere et compte les params moveq #0,d5 moveq #2,d4 Taille des variables move.b -1(a0),d5 Le flag and.w #$000F,d5 cmp.b #1,d5 Float? bne.s .Skip tst.b MathFlags(a5) Double? bpl.s .Skip moveq #3,d4 Variables sur 8 octets! .Skip moveq #1,d3 move.w d0,d2 move.l Buffer(a5),a2 move.b d0,(a2)+ Nombre de dimensions move.b d4,(a2)+ Taille des variables Dim1: move.l (a3)+,d1 Fabrique l'entete cmp.l #$FFFF,d1 Rbcc L_FonCall move.w d1,(a2)+ move.w d3,(a2)+ addq.w #1,d1 mulu d1,d3 cmp.l #$10000,d3 Rbcc L_FonCall subq.w #1,d0 bne.s Dim1 lsl.l d4,d3 Taille du tableau move.l d3,d4 Rbeq L_FonCall lsr.l #2,d4 Nombre de mots long a nettoyer add.l a2,d3 sub.l Buffer(a5),d3 Plus taille du header move.l TabBas(a5),a2 Descend le bas tableaux sub.l d3,a2 cmp.l HiChaine(a5),a2 bcc.s DimM1 movem.l a0-a1/d0-d1,-(sp) Rbsr L_Menage movem.l (sp)+,a0-a1/d0-d1 cmp.l HiChaine(a5),a2 Rbcs L_OOfBuf DimM1 move.l a2,(a0) Stocke l'adresse du tableau move.l a2,TabBas(a5) move.l Buffer(a5),a0 Copie l'entete move.w (a0)+,(a2)+ DimM2 move.l (a0)+,(a2)+ subq.w #1,d2 bne.s DimM2 * Nettoie le tableau moveq #0,d0 cmp.w #2,d5 bne.s Dim5 move.l ChVide(a5),d0 Dim5: move.l d0,(a2)+ subq.l #1,d4 bne.s Dim5 rts EAlrDim moveq #28,d0 Rbra L_GoError ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Trouve un element de tableau ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp GetTablo ; - - - - - - - - - - - - - move.l (a0),d0 Base du tableau Rbeq L_NonDim move.l d0,a0 move.b (a0)+,d3 Nombre de dims move.b (a0)+,d4 Taille des variables moveq #0,d0 moveq #0,d2 GetT1 move.w (a0)+,d0 move.l (a3)+,d1 cmp.l d0,d1 Rbhi L_FonCall mulu (a0)+,d1 add.l d1,d2 subq.b #1,d3 bne.s GetT1 lsl.l d4,d2 add.l d2,a0 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; =ARRAY$(a$(0)) ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp FnArray ; - - - - - - - - - - - - - move.l (a0),d3 Rbeq L_NonDim rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; =FN ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp FnFn ; - - - - - - - - - - - - - move.l (a0),d1 Adresse de la routine beq EFnNDef move.l d1,a2 move.w d0,-(sp) Nombre de parametres beq.s L955e L955a jsr (a2) Appel du parametres cmp.w (a3)+,d2 Compare avec le type demande beq.s L955d move.l a0,-(sp) tst.b d2 bne.s L955b Rjsrt L_FlToInt2 bra.s L955c L955b Rjsrt L_IntToFl2 L955c move.l (sp)+,a0 L955d cmp.b #1,d2 bne.s .Ent tst.b MathFlags(a5) Double bpl.s .Ent movem.l (a3)+,d3/d4 move.l d3,(a0)+ Egalisation move.l d4,(a0) bra.s .Next .Ent move.l (a3)+,(a0) .Next subq.w #1,(sp) Encore un parametre bne.s L955a L955e addq.l #2,sp jmp (a2) Branche a la routine EFnNDef moveq #15,d0 Rbra L_GoError ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; SWAP ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InSwap ; - - - - - - - - - - - - - move.l (a3)+,a1 En entier/float/chaine move.l (a0),d0 move.l (a1),(a0) move.l d0,(a1) rts ; - - - - - - - - - - - - - Lib_Cmp InSwapD ; - - - - - - - - - - - - - move.l (a3)+,a1 move.l (a0),d0 move.l (a1),(a0)+ move.l d0,(a1)+ move.l (a0),d0 move.l (a1),(a0) move.l d0,(a1) rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; MAX / MIN ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp FnMax ; - - - - - - - - - - - - - - - - cmp.l (a3),d3 bge.s .Skip move.l (a3),d3 .Skip addq.l #4,a3 rts ; - - - - - - - - - - - - - Lib_Cmp FnMaxS ; - - - - - - - - - - - - - move.l (a3),-(a3) Rbsr L_Chaine_Compare ble.s .Skip move.l (a3),d3 .Skip addq.l #4,a3 rts ; - - - - - - - - - - - - - - - - Lib_Cmp FnMin ; - - - - - - - - - - - - - - - - cmp.l (a3),d3 ble.s .Skip move.l (a3),d3 .Skip addq.l #4,a3 rts ; - - - - - - - - - - - - - Lib_Cmp FnMinS ; - - - - - - - - - - - - - move.l (a3),-(a3) Rbsr L_Chaine_Compare ble.s .Skip move.l (a3),d3 .Skip addq.l #4,a3 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; INC + DEC ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InAdd4 ; - - - - - - - - - - - - - - - - move.l (a0),d0 move.l (a3)+,d2 move.l (a3)+,d1 add.l (a3)+,d0 cmp.l d1,d0 blt.s IAdd4m cmp.l d2,d0 bgt.s IAdd4p move.l d0,(a0) rts IAdd4m: move.l d2,(a0) rts IAdd4p: move.l d1,(a0) rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; SORT ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InSort ; - - - - - - - - - - - - - - - - Rbsr L_GTablo ;va chercher les caracteristiques du tableau move.l d6,d3 or4: lsr.l #1,d3 ;E=d3 beq XSort moveq #1,d5 ;NA=d5 or5: move.l d5,d4 ;NR=d4 -> NR=NA or6: movem.l d3-d6/a1,-(sp) move.l a1,a0 subq.l #1,d4 move.l d4,d0 move.l d3,d1 Rbsr L_AdSort movem.l a0/a1/d2,-(sp) movem.l (a0),d0-d1 movem.l (a1),d3-d4 Rbsr L_CpBis movem.l (sp)+,a0/a1/d2 bge.s or8 ; fait le swap move.l (a0),d0 move.l (a1),(a0) move.l d0,(a1) cmp.b #3,d7 bne.s .Skip move.l 4(a0),d0 move.l 4(a1),4(a0) move.l d0,4(a1) .Skip movem.l (sp)+,d3-d6/a1 sub.l d3,d4 ;NR=NR-E beq.s or9 bcc.s or6 bra.s or9 or8: movem.l (sp)+,d3-d6/a1 or9: addq.l #1,d5 ;NA=NA+1 move.l d6,d0 sub.l d3,d0 cmp.l d0,d5 bls.s or5 bra.s or4 XSort Rjsr L_LoadRegs rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; =MATCH ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp FnMatch ; - - - - - - - - - - - - - - - - Rbsr L_GTablo cmp.b #3,d7 beq.s .Dble move.l (a3)+,d3 bra.s di3 .Dble movem.l (a3)+,d3/d4 ; recherche! di3: moveq #0,d5 move.l d6,d1 lsr.l #1,d6 di4: movem.l a1/d1-d7,-(sp) add.l d6,d5 move.l d5,d1 move.l a1,a0 moveq #0,d0 Rbsr L_AdSort movem.l (a1),d0-d1 Rbsr L_CpBis movem.l (sp)+,a1/d1-d7 beq.s di11 blt.s di5 add.l d6,d5 di5: tst.l d6 beq.s di7 lsr.l #1,d6 bra.s di4 ; pas trouve: cherche le premier element superieur di7: cmp.l d1,d5 bcc.s di8 movem.l a1/d1-d7,-(sp) move.l d5,d1 move.l a1,a0 moveq #0,d0 Rbsr L_AdSort movem.l (a1),d0-d1 Rbsr L_CpBis movem.l (sp)+,a1/d1-d7 beq.s di11 blt.s di8 addq.l #1,d5 bra.s di7 di8: move.l d5,d3 addq.l #1,d3 neg.l d3 bra.s di12 ; trouve! di11: move.l d5,d3 add.l d6,d3 ; Sortie di12 Rjsr L_LoadRegs rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Trouve les parametres tableau pour SORT et FIND ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp GTablo ; - - - - - - - - - - - - - GTablo Rjsr L_SaveRegs move.l (a0),d0 Rbeq L_NonDim move.l d0,a0 move.b (a0)+,d0 Nombre de dims move.b (a0)+,d7 Taille des variables moveq #0,d1 moveq #1,d6 L957a addq.l #4,a3 move.w (a0)+,d1 addq.w #1,d1 mulu d1,d6 addq.l #2,a0 subq.b #1,d0 bne.s L957a move.l a0,a1 rts * Trouve l'adresse D0/D1 >>> A0/A1 ; - - - - - - - - - - - - - Lib_Cmp AdSort ; - - - - - - - - - - - - - lsl.l d7,d0 add.l d0,a0 move.l a0,a1 lsl.l d7,d1 add.l d1,a1 rts * Comparaison pour SORT/FIND ; - - - - - - - - - - - - - Lib_Cmp CpBis ; - - - - - - - - - - - - - cmp.b #1,d2 beq.s .Flt bcs.s .Ent move.l d0,-(a3) Chaine Rbra L_Chaine_Compare .Ent cmp.l d0,d3 Entier rts .Flt cmp.b #3,d7 beq.s .Dble move.l d0,-(a3) Rjmp L_Float_Compare .Dble movem.l d0-d1,-(a3) Rjmp L_Float_Compare ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; READ ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InRead ; - - - - - - - - - - - - - move.l a0,-(sp) Read ENTIERS move.l PData(a5),a2 jsr (a2) Rbmi L_OOfData cmp.l #EntNul,d3 beq.s L975a subq.b #1,d2 bmi.s L975b Rbne L_TypeMis Rjsrt L_FlToInt1 bra.s L975b L975a moveq #0,d3 L975b move.l (sp)+,a0 move.l d3,(a0) move.l a2,PData(a5) rts ; - - - - - - - - - - - - - Lib_Cmp InReadF ; - - - - - - - - - - - - - move.l a0,-(sp) Pour les float move.l PData(a5),a2 jsr (a2) Rbmi L_OOfData cmp.l #EntNul,d3 beq.s L976a subq.b #1,d2 beq.s L976b Rbpl L_TypeMis Rjsrt L_IntToFl1 bra.s L976b L976a moveq #0,d3 moveq #0,d4 L976b move.l (sp)+,a0 move.l d3,(a0)+ tst.b MathFlags(a5) bpl.s .Skip move.l d4,(a0) .Skip move.l a2,PData(a5) rts ; - - - - - - - - - - - - - Lib_Cmp InReadS ; - - - - - - - - - - - - - move.l a0,-(sp) Pour les chaines move.l PData(a5),a2 jsr (a2) Rbmi L_OOfData cmp.l #EntNul,d3 beq.s L977a cmp.b #2,d2 beq.s L977b Rbra L_TypeMis L977a move.l ChVide(a5),d3 L977b move.l (sp)+,a0 move.l d3,(a0) move.l a2,PData(a5) rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; RESTORE ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InRestore ; - - - - - - - - - - - - - move.l AData(a5),PData(a5) rts ; - - - - - - - - - - - - - Lib_Cmp InRestore1 ; - - - - - - - - - - - - - lea 4(a0),a0 cmp.w #$4E71,(a0) * (NOP) bne.s .Err move.l a0,PData(a5) rts .Err moveq #41,d0 No data Rbra L_GoError ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Source: Diskio.s ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; FIELD ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InField ; - - - - - - - - - - - - - exg d0,d3 Rbsr L_GetFile Rbeq L_FilNO ; Reserve la memoire necessaire move.w d3,d0 mulu #6,d0 addq.l #8,d0 SyCall MemFastClear Rbeq L_OOfMem move.l a0,FhF(a2) move.l a0,a1 move.w d3,d0 lsl.w #3,d0 add.w d0,a3 move.l a3,-(sp) lea 8(a1),a0 move.w d3,(a1) subq.w #1,d3 moveq #0,d2 Fld2 move.l -(a3),d0 beq FldFonc add.l d0,d2 cmp.l #String_Max,d2 bcc FldFonc move.w d0,(a0)+ move.l -(a3),(a0)+ dbra d3,Fld2 move.w d2,2(a1) * Taille du fichier move.l (sp)+,a3 move.l a1,-(sp) move.l FhA(a2),d1 moveq #0,d2 moveq #1,d3 DosCall _LVOSeek move.l FhA(a2),d1 moveq #0,d2 moveq #-1,d3 DosCall _LVOSeek move.l (sp)+,a1 move.l d0,4(a1) rts ; FonCall field! FldFonc Rjsr L_Cloa1 Rbra L_FonCall ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; LINE INPUT FICHIER ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InLineInputH ; - - - - - - - - - - - - - clr.w -(sp) move.l d3,d0 Rbsr L_GetFile Rbeq L_FilNO move.l a2,PrintFile(a5) moveq #0,d3 Rbra L_Input ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; INPUT FICHIER ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InInputH ; - - - - - - - - - - - - - move.w #",",-(sp) move.l d3,d0 Rbsr L_GetFile Rbeq L_FilNO move.l a2,PrintFile(a5) moveq #0,d3 Rbra L_Input ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; INPUT CLAVIER ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InInput ; - - - - - - - - - - - - - tst.w ScOn(a5) Rbeq L_ScNOp move.w #",",-(sp) clr.l PrintFile(a5) Rbra L_Input ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; LINE INPUT CLAVIER ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InLineInput ; - - - - - - - - - - - - - tst.w ScOn(a5) Rbeq L_ScNOp clr.w -(sp) clr.l PrintFile(a5) Rbra L_Input ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; INPUT! ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp Input ; - - - - - - - - - - - - - move.l d3,-(sp) Chaine a imprimer move.w d5,d0 Nombre de variables mulu #6,d0 add.w d0,a3 clr.l DeFloat(a5) IInp0 movem.l a3/d5,-(sp) move.l Buffer(a5),a0 clr.b (a0) tst.l PrintFile(a5) bne.s ReDInp ; Imprimer la chaine move.l 8(sp),d0 beq.s L111a move.l d0,a2 move.w (a2)+,d2 beq.s ReInp move.b 0(a2,d2.w),d3 clr.b 0(a2,d2.w) move.l a2,a1 WiCall Print move.b d3,0(a2,d2.w) bra.s ReInp ; Imprime le ? L111a moveq #"?",d1 WiCall ChrOut moveq #" ",d1 WiCall ChrOut ; Rempli le buffer! ReInp: * Clavier lea Es_LEd(a5),a0 move.l Buffer(a5),a1 clr.b (a1) move.l a1,a2 move.w #(1< D3 ; INPUT/LINE INPUT: interprete le buffer! InnPut: move.l Buffer(a5),a2 Inn1: move.w -2(a3),d2 cmp.b #2,d2 bne.s Inn5 * Variable alphanumerique move.l -6(a3),a0 move.l ChVide(a5),(a0) * Libere la memoire! tst.l d3 beq Inn10 Rbsr L_DDemande addq.l #2,a0 move.b 12+1(sp),d1 Inn2: move.b (a2)+,d0 move.b d0,(a0)+ beq.s Inn3 cmp.b d0,d1 bne.s Inn2 Inn3: subq.l #1,a0 subq.l #1,a2 move.l a0,d0 sub.l a1,d0 subq.l #2,d0 move.w d0,(a1) btst #0,d0 beq.s Inn4 addq.l #1,a0 Inn4: move.l a0,HiChaine(a5) move.l -6(a3),a0 move.l a1,(a0) bra.s Inn10 * Variable numerique Inn5: move.l a2,a0 moveq #1,d0 Tenir compte du signe move.w -2(a3),d2 Le type desire Rjsr L_ValRout move.l a0,a2 move.b (a2),d0 Caractere de fin beq.s Inn6 Zero=> ok cmp.b 12+1(sp),d0 Ou stop bne InnRedo Inn6 move.l -6(a3),a0 Adresse de la variable move.l d3,(a0) Poke! move.w -2(a3),d0 Type= float? beq.s Inn10 tst.b MathFlags(a5) Double? bpl.s Inn10 move.l d4,4(a0) Oui, poke double! ; Encore une variable a prendre??? Inn10: subq.l #6,a3 subq.w #1,d5 beq.s Inn11 cmp.b #",",(a2)+ beq Inn1 * ?? tst.l PrintFile(a5) bne ReDInp WiCalA Print,InnEnc(pc) move.l Buffer(a5),a0 clr.b (a0) bra ReInp * Fini! Inn11: movem.l (sp)+,a3/d5 addq.l #6,sp Rbsr L_EndByte rts * Redo from start InnRedo Rbsr L_EndByte tst.l PrintFile(a5) Rbne L_TypeMis Rbsr L_CRet moveq #15,d0 Rjsr L_Def_GetMessage move.l a0,a1 WiCall Print Rbsr L_CRet movem.l (sp)+,a3/d5 bra IInp0 InnEnc: dc.b 13,10,"?? ",0 even ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Retour chariot ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp CRet ; - - - - - - - - - - - - - WiCalA Print,InnRet(pc) rts InnRet: dc.b 13,10,0,0 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; DEBUT PRINT H ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InPrintH ; - - - - - - - - - - - - - move.l d3,d0 Rbsr L_GetFile tst.l FhA(a2) Rbeq L_FilNO btst #0,FhT(a2) Rbeq L_FilTM cmp.w #1,d0 Rbeq L_FilTM move.l a2,PrintFile(a5) rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; IMPRESSION d'un chiffre ENTIER ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp PrintE ; - - - - - - - - - - - - - move.l d3,d0 moveq #-1,d3 ;proportionnel moveq #1,d4 ;avec signe move.l Buffer(a5),a0 Rjsr L_LongToAsc clr.b (a0) rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; IMPRESSION d'un chiffre FLOAT ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp PrintF ; - - - - - - - - - - - - - move.l Buffer(a5),a0 Rjsr L_Float2Ascii clr.b (a0) rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; IMPRESSION d'une chaine ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp PrintS ; - - - - - - - - - - - - - move.l d3,a2 move.w (a2)+,d2 L35r: move.l Buffer(a5),a0 beq.s L35c move.w #255,d0 L35a: move.b (a2)+,(a0)+ subq.w #1,d2 beq.s L35c dbra d0,L35a L35b movem.l a2/d2,-(sp) Rbsr L_PrintX movem.l (sp)+,a2/d2 tst.w d2 bra.s L35r L35c clr.b (a0) rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; FIN IMPRESSION NORMALE ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp PrintX ; - - - - - - - - - - - - - move.l Buffer(a5),a1 WiCall Print rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; FIN IMPRESSION NORMALE IMPRIMANTE ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp LPrintX ; - - - - - - - - - - - - - move.l Buffer(a5),a0 Rbra L_PRT_Print ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; PRINT seul ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp CRPrint ; - - - - - - - - - - - - - move.l Buffer(a5),a0 move.l #$0D0A0000,(a0) rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; IMPRESSION d'une chaine dans un fichier ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp HPrintS ; - - - - - - - - - - - - - move.l d3,a0 moveq #0,d3 move.w (a0)+,d3 beq.s L825x move.l a0,d2 move.l PrintFile(a5),a0 move.l FhA(a0),d1 DosCall _LVOWrite cmp.l d0,d3 Rbne L_DiskError L825x move.l Buffer(a5),a0 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; PRINT RETOUR CHARIOT ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp PrtRet ; - - - - - - - - - - - - - move.b #13,(a0)+ move.b #10,(a0)+ clr.b (a0) rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; PRINT VIRGULE ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp PrtVir ; - - - - - - - - - - - - - move.b #9,(a0)+ clr.b (a0) rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; FIN IMPRESSION NORMALE dans un fichier ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp HPrintX ; - - - - - - - - - - - - - move.l PrintFile(a5),a1 move.l FhA(a1),d1 move.l Buffer(a5),d2 move.l a0,d3 sub.l d2,d3 DosCall DosWrite cmp.l d0,d3 Rbne L_DiskError rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; USING CHIFFRES ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp UsingC ; - - - - - - - - - - - - - move.l (a3)+,a0 Chaine de formattage movem.l a3/d6/d7,-(sp) move.l Buffer(a5),a1 lea 256(a1),a1 move.w (a0)+,d0 beq.s l41a3 cmp.w #127,d0 bcs.s l41a1 moveq #127,d0 l41a1: subq.w #1,d0 l41a2: move.b (a0)+,(a1)+ dbra d0,l41a2 l41a3: clr.b (a1) ; USING pour les CHIFFRES move.l Buffer(a5),a1 lea 128(a1),a2 moveq #127,d0 us2: move.b (a1),(a2)+ ;recopie la chaine, et fait le menage!!! move.b #32,(a1)+ dbra d0,us2 move.l Buffer(a5),a0 lea 128(a0),a1 ;a1 pointe la chaine move.l a1,d6 ;debut chaine a formatter move.l Buffer(a5),a2 lea 256(a2),a2 ;a2 pointe la chaine de definition move.l a2,d7 ;debut chaine de format us3: move.b (a2),d0 beq.s us5 cmp.b #".",d0 ;cherche la fin du format de chiffre beq.s us5 cmp.b #";",d0 beq.s us5 cmp.b #"^",d0 beq.s us5 addq.l #1,a0 addq.l #1,a2 bra.s us3 us5: move.b (a1),d0 beq.s us6 cmp.b #".",d0 ;trouve le point de la chaine a formatter beq.s us6 ;ou la fin cmp.b #"E",d0 beq.s us6 addq.l #1,a1 bra.s us5 us6: movem.l a0-a2,-(sp) ; ecris la gauche du chiffre us7: cmp.l d7,a2 ;fini a gauche??? beq us15 move.b -(a2),d0 cmp.b #"#",d0 beq.s us8 cmp.b #"-",d0 beq.s us11 cmp.b #"+",d0 beq.s us12 move.b d0,-(a0) ;aucun signe reserve: le met simplement! bra.s us7 us8: cmp.l d6,a1 ;-----> "#" bne.s us10 us9: move.b #" ",-(a0) ;arrive au debut du chiffre! bra.s us7 us10: move.b -(a1),d0 cmp.b #"0",d0 ;pas un chiffre (signe) bcs.s us9 cmp.b #"9",d0 bhi.s us9 move.b d0,-(a0) ;OK, chiffre: poke! bra.s us7 us11: move.l d6,a3 ;-----> "-" move.b (a3),-(a0) ;met le "signe": 32 ou "-" bra.s us7 us12: move.l d6,a3 move.b (a3),d0 cmp.b #"-",d0 beq.s us13 move.b #"+",d0 us13: move.b d0,-(a0) ;-----> "+" bra us7 ; ecrit la droite du chiffre us15: movem.l (sp)+,a0-a2 ;recupere les adresses pivot clr.l d2 ;flag puissance cmp.b #".",(a1) ;saute le point dans le chiffre a afficher bne.s us16 addq.l #1,a1 us16: move.b (a2)+,d0 beq finus ;fini OUF! cmp.b #";",d0 ;";" marque la virgule sans l'ecrire! beq.s us18z cmp.b #"#",d0 beq.s us17 cmp.b #"^",d0 beq.s us20 move.b d0,(a0)+ ;ne correspond a rien: POKE! bra.s us16 us17: move.b (a1),d0 ;-----> "#" bne.s us19 us18: tst d2 beq.s us18a us18z: move.b #" ",(a0)+ ;si puissance passee: met des espaces bra.s us16 us18a: move.b #"0",(a0)+ ;fin du chiffre: met un zero apres la virgule bra.s us16 us19: cmp.b #"0",d0 bcs.s us18 cmp.b #"9",d0 bhi.s us18 addq.l #1,a1 move.b d0,(a0)+ bra us16 us20: tst d2 ;-----> "^" bmi.s us24 bne.s us25 us21: move.b (a1),d0 beq.s us22 cmp.b #"E",d0 beq.s us23 addq.l #1,a1 bra.s us21 us22: moveq #1,d2 ;pas de puissance: en fabrique une! bra.s us25 us23: moveq #-1,d2 us24: move.b (a1),d0 ;si fin du chiffre: met des espaces beq us18 addq.l #1,a1 cmp.b #32,d0 ;saute l'espace entre E et +/- beq.s us24 move.b d0,(a0)+ bra us16 us25: lea usip(pc),a3 move.b -1(a3,d2.w),(a0)+ ;met une fausse puissance! cmp.b #6,d2 beq us16 addq #1,d2 bra us16 finus: movem.l (sp)+,a3/d6/d7 clr.b (a0) rts usip: dc.b "E+000 " even ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; USING CHAINES ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp UsingS ; - - - - - - - - - - - - - move.l d3,a0 Chaine � formater move.l Buffer(a5),a1 lea 128(a1),a1 move.w (a0)+,d0 beq.s l42c cmp.w #127,d0 bcs.s l42a moveq #127,d0 l42a subq.w #1,d0 l42b move.b (a0)+,(a1)+ dbra d0,l42b l42c clr.b (a1) move.l (a3)+,a0 * Chaine de formatage move.l Buffer(a5),a1 lea 256(a1),a1 move.w (a0)+,d0 beq.s l42a3 cmp.w #127,d0 bcs.s l42a1 moveq #127,d0 l42a1: subq.w #1,d0 l42a2: move.b (a0)+,(a1)+ dbra d0,l42a2 l42a3: clr.b (a1) move.l Buffer(a5),a0 lea 128(a0),a1 lea 128(a1),a2 ; ecris la chaine dans le buffer us52: move.b (a2)+,d0 beq.s fnusc cmp.b #"~",d0 beq.s us53 move.b d0,(a0)+ bra.s us52 us53: move.b (a1),d0 ;----> "~" bne.s us54 move.b #32,(a0)+ bra.s us52 us54: addq.l #1,a1 move.b d0,(a0)+ bra.s us52 fnusc: clr.b (a0) rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Source: Ecrans.s ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; DEFAULT PALETTE ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InDefaultPalette ; - - - - - - - - - - - - - lea DefPal(a5),a0 Rbra L_Plt ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; PALETTE ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InPalette ; - - - - - - - - - - - - - tst.w ScOn(a5) Rbeq L_ScNOp moveq #15,d1 move.l Buffer(a5),a0 move.l a0,a1 Pal1: move.l #-1,(a1)+ dbra d1,Pal1 Rbsr L_Plt EcCall SPal Rbne L_EcWiErr rts ; - - - - - - - - - - - - - Lib_Cmp Plt ; - - - - - - - - - - - - - move.w d0,d1 lsl.w #2,d1 add.w d1,a3 move.l a3,a2 subq.w #1,d0 Plt1: move.l -(a2),d2 bmi.s Plt2 and.w #$FFF,d2 move.w d2,(a0) Plt2: addq.l #2,a0 dbra d0,Plt1 move.l Buffer(a5),a1 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; FADE ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InFade1 ; - - - - - - - - - - - - - move.l Buffer(a5),a0 move.l a0,a1 moveq #31,d0 .Loop clr.w (a0)+ dbra d0,.Loop Rbra L_InFade ; - - - - - - - - - - - - - Lib_Cmp InFade2 ; - - - - - - - - - - - - - moveq #-1,d3 Rbra L_InFade3 ; - - - - - - - - - - - - - Lib_Cmp InFade3 ; - - - - - - - - - - - - - move.l (a3)+,d1 bpl.s IFat1 Rjsr L_Bnk.GetBobs <0 -->> sprite palette Rbeq L_BkNoRes move.w (a0)+,d0 lsl.w #3,d0 lea 0(a0,d0.w),a0 bra.s IFat2 IFat1 Rjsr L_GetEc lea EcPal(a0),a0 IFat2 Rbsr L_PalRout Rbra L_InFade ; - - - - - - - - - - - - - Fade a,b,c,d Lib_Cmp InFadePal ; - - - - - - - - - - - - - moveq #15,d1 move.l Buffer(a5),a0 move.l a0,a1 IFap move.l #-1,(a1)+ dbra d1,IFap Rbsr L_Plt Rbra L_InFade ; - - - - - - - - - - - - - Lib_Cmp InFade ; - - - - - - - - - - - - - Lance le fade tst.w ScOn(a5) Rbeq L_ScNOp move.l (a3)+,d1 Rbls L_FonCall EcCall FadeOn Rbne L_FonCall rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; POLYLINE ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InPolyline ; - - - - - - - - - - - - - tst.w ScOn(a5) Rbeq L_ScNOp move.w d0,d3 lsl.w #3,d0 add.w d0,a3 move.l a3,a2 move.l T_RastPort(a5),a1 move.l Buffer(a5),a0 moveq #0,d0 tst.w d1 bne.s L315a move.w 36(a1),d1 move.w 38(a1),d2 addq.w #1,d3 bra.s L315b L315a move.l -(a2),d1 move.l -(a2),d2 L315b move.w d1,(a0)+ move.w d2,(a0)+ addq.w #1,d0 subq.w #1,d3 bne.s L315a move.l Buffer(a5),a0 move.w (a0),36(a1) move.w 2(a0),38(a1) move.w #PolyDraw,d5 Rjmp L_GfxFunc ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; POLYGON ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InPolygon ; - - - - - - - - - - - - - tst.w ScOn(a5) Rbeq L_ScNOp move.w d0,d5 move.w d1,d4 ; Initialise le buffer AREADRAW ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ lea AAreaInfo(a5),a0 lea AAreaBuf(a5),a1 moveq #AAreaSize,d0 move.l T_RastPort(a5),a2 move.l a0,16(a2) GfxCa5 InitArea move.w d5,d0 lsl.w #3,d0 add.w d0,a3 move.l a3,a0 move.l T_RastPort(a5),a1 move.l Buffer(a5),a2 tst.w d4 beq.s L341a move.l -(a0),d0 move.l -(a0),d1 subq.w #1,d5 bra.s L341b L341a move.w 36(a1),d0 move.w 38(a1),d1 L341b GfxCa5 AreaMove L341c move.l -(a0),d0 move.l -(a0),d1 GfxCa5 AreaDraw subq.w #1,d5 bne.s L341c Rjsr L_GetRas GfxCa5 AreaEnd Rjmp L_FreeRas ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; CHANNEL x TO SPRITE x ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp ChannelToSprite ; - - - - - - - - - - - - - moveq #0,d0 moveq #64,d1 Rbra L_InChannel ; - - - - - - - - - - - - - Lib_Cmp ChannelToBob ; - - - - - - - - - - - - - moveq #1,d0 moveq #64,d1 Rbra L_InChannel ; - - - - - - - - - - - - - Lib_Cmp ChannelToSDisplay ; - - - - - - - - - - - - - moveq #2,d0 moveq #8,d1 Rbra L_InChannel ; - - - - - - - - - - - - - Lib_Cmp ChannelToSSize ; - - - - - - - - - - - - - moveq #3,d0 moveq #8,d1 Rbra L_InChannel ; - - - - - - - - - - - - - Lib_Cmp ChannelToSOffset ; - - - - - - - - - - - - - moveq #4,d0 moveq #8,d1 Rbra L_InChannel ; - - - - - - - - - - - - - Lib_Cmp ChannelToRainbow ; - - - - - - - - - - - - - moveq #6,d0 moveq #4,d1 Rbra L_InChannel ; - - - - - - - - - - - - - Lib_Cmp InChannel ; - - - - - - - - - - - - - move.l (a3)+,d4 cmp.l #64,d4 Rbcc L_FonCall cmp.l d1,d3 Rbcc L_FonCall lsl.w #1,d4 lea AnCanaux(a5),a0 move.b d0,0(a0,d4.w) * 1 => TYPE move.b d3,1(a0,d4.w) * 2 => NUMERO rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; BSETBCLRBCHGBTSTROLROR ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InBset ; - - - - - - - - - - - - - move.l (a3)+,d0 move.l (a0),d1 bset d0,d1 move.l d1,(a0) rts ; - - - - - - - - - - - - - Lib_Cmp InBset1 ; - - - - - - - - - - - - - move.l d3,a0 move.l (a3)+,d0 bset d0,(a0) rts ; - - - - - - - - - - - - - Lib_Cmp InBclr ; - - - - - - - - - - - - - move.l (a3)+,d0 move.l (a0),d1 bclr d0,d1 move.l d1,(a0) rts ; - - - - - - - - - - - - - Lib_Cmp InBclr1 ; - - - - - - - - - - - - - move.l d3,a0 move.l (a3)+,d0 bclr d0,(a0) rts ; - - - - - - - - - - - - - Lib_Cmp InBchg ; - - - - - - - - - - - - - move.l (a3)+,d0 move.l (a0),d1 bchg d0,d1 move.l d1,(a0) rts ; - - - - - - - - - - - - - Lib_Cmp InBchg1 ; - - - - - - - - - - - - - move.l d3,a0 move.l (a3)+,d0 bchg d0,(a0) rts ; - - - - - - - - - - - - - Lib_Cmp FnBtst ; - - - - - - - - - - - - - move.l (a3)+,d0 move.l (a0),d1 btst d0,d1 Rbne L_FnTrue Rbra L_FnFalse ; - - - - - - - - - - - - - Lib_Cmp FnBtst1 ; - - - - - - - - - - - - - move.l d3,a0 move.l (a3)+,d0 btst d0,(a0) Rbne L_FnTrue Rbra L_FnFalse ; - - - - - - - - - - - - - Lib_Cmp InRorB ; - - - - - - - - - - - - - move.l (a3)+,d0 move.b 3(a0),d1 ror.b d0,d1 move.b d1,3(a0) rts ; - - - - - - - - - - - - - Lib_Cmp InRorB1 ; - - - - - - - - - - - - - move.l d3,a0 move.l (a3)+,d0 move.b (a0),d1 ror.b d0,d1 move.b d1,(a0) rts ; - - - - - - - - - - - - - Lib_Cmp InRorW ; - - - - - - - - - - - - - move.l (a3)+,d0 move.w 2(a0),d1 ror.w d0,d1 move.w d1,2(a0) rts ; - - - - - - - - - - - - - Lib_Cmp InRorW1 ; - - - - - - - - - - - - - move.l d3,a0 move.l (a3)+,d0 move.w (a0),d1 ror.w d0,d1 move.w d1,(a0) rts ; - - - - - - - - - - - - - Lib_Cmp InRorL ; - - - - - - - - - - - - - move.l (a3)+,d0 move.l (a0),d1 ror.l d0,d1 move.l d1,(a0) rts ; - - - - - - - - - - - - - Lib_Cmp InRorL1 ; - - - - - - - - - - - - - move.l d3,a0 move.l (a3)+,d0 move.l (a0),d1 ror.l d0,d1 move.l d1,(a0) rts ; - - - - - - - - - - - - - Lib_Cmp InRolB ; - - - - - - - - - - - - - move.l (a3)+,d0 move.b 3(a0),d1 rol.b d0,d1 move.b d1,3(a0) rts ; - - - - - - - - - - - - - Lib_Cmp InRolB1 ; - - - - - - - - - - - - - move.l d3,a0 move.l (a3)+,d0 move.b (a0),d1 rol.b d0,d1 move.b d1,(a0) rts ; - - - - - - - - - - - - - Lib_Cmp InRolW ; - - - - - - - - - - - - - move.l (a3)+,d0 move.w 2(a0),d1 rol.w d0,d1 move.w d1,2(a0) rts ; - - - - - - - - - - - - - Lib_Cmp InRolW1 ; - - - - - - - - - - - - - move.l d3,a0 move.l (a3)+,d0 move.w (a0),d1 rol.w d0,d1 move.w d1,(a0) rts ; - - - - - - - - - - - - - Lib_Cmp InRolL ; - - - - - - - - - - - - - move.l (a3)+,d0 move.l (a0),d1 rol.l d0,d1 move.l d1,(a0) rts ; - - - - - - - - - - - - - Lib_Cmp InRolL1 ; - - - - - - - - - - - - - move.l d3,a0 move.l (a3)+,d0 move.l (a0),d1 rol.l d0,d1 move.l d1,(a0) rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; CALL ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InCall ; - - - - - - - - - - - - - move.l d3,d0 Rjsr L_Bnk.OrAdr movem.l d6-d7/a3-a6,-(sp) move.l a0,a4 lea CallReg(a5),a6 move.l a6,-(sp) movem.l (a6),d0-d7/a0-a2 jsr (a4) .Return move.l (sp)+,a6 movem.l d0-d7/a0-a2,(a6) movem.l (sp)+,d6-d7/a3-a6 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; =STRUC= ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InStruc ; - - - - - - - - - - - - - move.l (a3)+,a0 move.l a0,d1 jmp .Jmp(pc,d0.w) .Jmp bra.s .Byte bra.s .Word bra.s .Long bra.s .Byte bra.s .Word bra.s .Long bra.s .Long .Byte move.b d0,(a0) rts .Word btst #0,d1 Rbne L_AdrErr move.w d3,(a0) rts .Long btst #0,d1 Rbne L_AdrErr move.l d3,(a0) rts ; - - - - - - - - - - - - - Lib_Cmp FnStruc ; - - - - - - - - - - - - - move.l d3,a0 move.l d3,d1 moveq #0,d3 jmp .Jmp(pc,d0.w) .Jmp bra.s .Byte bra.s .Word bra.s .Long bra.s .UByte bra.s .UWord bra.s .ULong bra.s .ULong .Byte move.b (a0),d3 ext.w d3 ext.l d3 rts .Word btst #0,d1 Rbne L_AdrErr move.w (a0),d3 ext.l d3 rts .Long btst #0,d1 Rbne L_AdrErr move.l (a0),d3 rts .UByte move.b (a0),d3 rts .UWord btst #0,d1 Rbne L_AdrErr move.w (a0),d3 rts .ULong btst #0,d1 Rbne L_AdrErr move.l (a0),d3 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; =STRUC$= ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InStrucD ; - - - - - - - - - - - - - move.l (a3)+,a0 move.l a0,d1 btst #0,d1 Rbne L_AdrErr clr.l (a0) move.l d3,a2 move.w (a2)+,d2 cmp.l #"|00|",(a2) beq.s .Skp moveq #2,d3 add.w d2,d3 Rjsr L_Demande lea 2(a0,d3.w),a0 move.w a0,d0 and.w #1,d0 add.w d0,a0 move.l a0,HiChaine(a5) move.l (sp)+,a0 move.l a1,(a0) move.w d2,(a1) addq.w #1,(a1)+ subq.w #1,d2 bmi.s .Skp .Lop move.b (a2)+,(a1)+ dbra d2,.Lop clr.b (a1) .Skp rts ; - - - - - - - - - - - - - Lib_Cmp FnStrucD ; - - - - - - - - - - - - - move.l d3,a0 btst #0,d3 Rbne L_AdrErr move.l (a0),d0 Rbeq L_Ret_ChVide move.l d0,a0 Rjsr L_A0ToChaine move.l a0,d3 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Source: String.s ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Demande de l'espace pour les chaines ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp Demande ; - - - - - - - - - - - - - dem0 move.l HiChaine(a5),a0 move.l a0,a1 add.l d3,a1 addq.l #4,a1 cmp.l TabBas(a5),a1 bcc.s dem1 move.l a0,a1 rts ; Va faire le menage, si revient: OK! dem1: tst.b ErrorRegs(a5) Recharger les registres? beq.s .NoReg movem.l ErrorSave(a5),d6-d7 .NoReg Rbsr L_Menage Va faire le menage ; Ca marche maintenant? move.l HiChaine(a5),a1 Ca marche maintenant? add.l d3,a1 addq.l #4,a1 cmp.l TabBas(a5),a1 bcc FinMenE ; Ca a marche, un patch? tst.l Patch_Menage(a5) bne.s dem3 ; Que faire? tst.l d6 beq.s FinMenE Plus de memoire cmp.l #-1,d6 Menage simple: revient a l'appelant beq.s dem0 ; On vient de le faire? Rbsr L_GetInstruction Pointe l'instruction cmp.l d6,a1 La meme que la derniere fois? beq FinMenE move.l a1,d6 On stocke move.l Cmp_LowPile(a5),sp move.l BasA3(a5),a3 jmp (a1) On rebranche a l'instruction! ; Branche au patch dem3 move.l Patch_Menage(a5),a0 jmp (a0) ; Erreur! FinMenE moveq #11,d0 Out of buffer space Rbra L_Error ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Demande chaine sans erreur ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp DDemande ; - - - - - - - - - - - - - move.l #-1,d6 Flag pour le menage Rbsr L_Demande Va demander moveq #1,d6 Empeche les erreurs rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; MENAGE ALPHANUMERIQUE ; Taille maximum chaine: 65472 ($FFC0) ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp Menage ; - - - - - - - - - - - - - movem.l d1-d7/a2-a6,-(sp) ; IFNE Debug>1 ; movem.l d0-d7/a0-a6,-(sp) ; moveq #70,d3 ; JJsrIns L_InBell1,1 ; movem.l (sp)+,d0-d7/a0-a6 ; ENDC ; IFNE Debug>2 ; Rjsr L_PreBug ; ENDC move.l a6,VarLoc(a5) ; Essaie de proceder � un FAST-MENAGE! ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ move.l HiChaine(a5),d7 move.l LoChaine(a5),d6 move.l d7,d0 sub.l d6,d0 cmp.l #$3FFFFE*2,d0 8 Megas maximum! bcc SLOW_MENAGE move.l d0,d5 SyCall MemFast beq SLOW_MENAGE FAST_MENAGE move.l a0,a4 move.l a0,a2 clr.w (a2)+ FfMen0 move.l VarLoc(a5),a6 ;Debut des variables moveq #-1,d2 ;Maxi dans le tableau ; Rempli la table intermediaire FfMen1 moveq #0,d4 .Loop move.w (a6)+,d0 Prend le flag beq.s .Loop Nul: non initialise! bmi.s .Proc Negatif: fin de chunk .Var btst #1,d0 Une chaine? bne.s .Alpha lsr.w #8,d0 Recupere la taille add.w d0,a6 move.w (a6)+,d0 Suivante beq.s .Loop bpl.s .Var .Proc move.l (a6),d0 Chunk suivant beq FfMenX Le dernier? move.l d0,a6 Non, on boucle! bra.s .Loop ; Variable alphanumerique .Alpha move.l a6,a3 move.l (a6)+,d1 beq.s .Loop Non initialise! btst #6,d0 Un tableau? beq.s FfMen4 move.l d1,a3 Un tableau! moveq #0,d0 move.b (a3)+,d0 Nombre de dimensions addq.l #1,a3 Taille des variables subq.w #1,d0 moveq #1,d4 FfMen2 move.w (a3)+,d1 Calcule nombre de variable addq.l #2,a3 addq.w #1,d1 mulu d1,d4 dbra d0,FfMen2 subq.l #1,d4 ; Recopie la chaine dans le buffer intermediaire FfMen4 move.l (a3),a0 cmp.l d6,a0 Dans le buffer? bcs.s FfMenN cmp.l d7,a0 bcc.s FfMenN move.w (a0),d0 Chaine vide? beq.s FfMenV move.w d0,d1 and.w #$FFC0,d1 Chaine deja copiee? cmp.w #$FFC0,d1 beq.s FfMenD Deja fait! move.l a2,d2 sub.l a4,d2 move.l d2,d1 add.l d6,d1 move.l d1,(a3)+ Change le pointeur move.w d0,(a2)+ addq.w #1,d0 lsr.w #1,d0 subq.w #1,d0 lea 2(a0),a1 FfMen5 move.w (a1)+,(a2)+ dbra d0,FfMen5 lsr.l #1,d2 / 2 car pair or.l #$FFC00000,d2 Masque move.l d2,(a0) Marque la chaine... FfSuiv subq.l #1,d4 bpl.s FfMen4 bmi FfMen1 ; Chaine deja copiee FfMenD move.l (a0),d0 and.l #$003FFFFF,d0 lsl.l #1,d0 add.l d6,d0 move.l d0,(a3)+ bra.s FfSuiv ; Chaine vide FfMenV move.l ChVide(a5),(a3)+ bra.s FfSuiv ; Chaine en dehors du buffer FfMenN addq.l #4,a3 bra.s FfSuiv ; Recopie le tout dans le buffer FfMenX move.l a4,a0 move.l d6,a1 FfMenX1 move.w (a0)+,(a1)+ cmp.l a2,a0 bcs.s FfMenX1 move.l a1,HiChaine(a5) ; Libere le buffer temporaire move.l a4,a1 move.l d5,d0 SyCall MemFree bra FinMenS ; ------------------------------------------------------------------------ SLOW_MENAGE * Reserve la memoire, ou prend le BUFFER si rien du tout!!! move.l #TMenage+16,d0 SyCall MemFast bne.s L47a move.l #-1,BMenage(a5) move.l Buffer(a5),d5 bra.s L47b L47a move.l a0,BMenage(a5) move.l a0,d5 * Menage L47b move.l d5,d6 add.l #TMenage,d6 ;Fin TI move.l LoChaine(a5),d7 ;Ad mini de recopie move.l HiChaine(a5),a4 ;Ad maxi des chaines! addq.l #2,d7 ;Chaine vide move.l d7,a1 ;Si ya pas de variable! Men0: move.l VarLoc(a5),a6 ;Debut des variables moveq #-1,d2 ;Maxi dans le tableau moveq #0,d4 ;Cpt tableau---> 0 move.l d5,d3 ;Rien dans la TI move.l d3,a0 move.l #$7fffffff,(a0) ; Rempli la table intermediaire Men1 .Loop move.w (a6)+,d0 Prend le flag beq.s .Loop Nul: non initialise! bmi.s .Proc Negatif: fin de chunk .Var btst #1,d0 Une chaine? bne.s .Alpha lsr.w #8,d0 Recupere la taille add.w d0,a6 move.w (a6)+,d0 Suivante beq.s .Loop bpl.s .Var .Proc move.l (a6),d0 Chunk suivant beq Men20 Le dernier? move.l d0,a6 Non, on boucle! bra.s .Loop ; Variable alphanumerique .Alpha move.l a6,a3 move.l (a6)+,d1 Initialise? beq.s Men1 btst #6,d0 beq.s Men4 move.l d1,a3 moveq #0,d0 move.b (a3)+,d0 addq.l #1,a3 subq.w #1,d0 moveq #1,d4 Men2: move.w (a3)+,d1 Calcule nombre de variable addq.l #2,a3 addq.w #1,d1 mulu d1,d4 dbra d0,Men2 Men3: subq.l #1,d4 ; Essai de poker dans la TI Men4: move.l (a3),d0 cmp.l d7,d0 ;< au minimum? bcs.s Men10 cmp.l a4,d0 ;Dans le source? bcc.s Men10 cmp.l d2,d0 ;>= au maximum? bcc.s Men10 move.l d5,a0 Men6: cmp.l (a0),d0 lea 8(a0),a0 bcc.s Men6 cmp.l d6,a0 bne.s Men7 move.l d0,d2 ;C'est le dernier element! move.l d6,d3 bra.s Men9 Men7: move.l d3,a1 ;Decale les adresses au dessus cmp.l d6,d3 bcs.s Men7a lea -8(a1),a1 move.l -8(a1),d2 ;Remonte la limite haute bra.s Men8 Men7a: addq.l #8,d3 move.l #$7fffffff,8(a1) Men8: move.l -(a1),8(a1) move.l -(a1),8(a1) cmp.l a0,a1 bcc.s Men8 Men9: move.l a3,-(a0) ;Poke dans la table move.l d0,-(a0) Men10: addq.l #4,a3 tst.l d4 bne.s Men3 beq Men1 ; Recopie toutes les chaines du buffer Men20: move.l d5,a3 ;Adresse TI move.l d7,a1 ;Adresse de recopie moveq #0,d7 Men21: cmp.l d3,a3 ;Fini-ni? bcc.s Men26 move.l (a3),a0 ;Adresse de la chaine lea 8(a3),a3 cmp.l a0,d7 ;Chaine deja bougee? beq.s Men25 move.l a0,d7 cmp.l a0,a1 ;Au meme endroit? bne.s Men22 ; Les 2 chaines sont au meme endroit! move.l a1,d1 moveq #0,d0 move.w (a1)+,d0 add.l d0,a1 move.w a1,d0 btst #0,d0 beq.s Men21 addq.l #1,a1 bra.s Men21 ; Recopie la chaine Men22: move.l -4(a3),a2 ;Change la variable move.l a1,(a2) move.l a1,d1 move.w (a0)+,d0 ;Recopie la chaine beq.s Men24 move.w d0,(a1)+ subq.w #1,d0 lsr.w #1,d0 Men23: move.w (a0)+,(a1)+ dbra d0,Men23 bra.s Men21 ; Chaine vide au milieu: pointe la vraie Men24: move.l ChVide(a5),d1 move.l d1,(a2) bra.s Men21 ; La variable pointait la meme chaine que la precedente Men25: move.l -4(a3),a2 move.l d1,(a2) bra.s Men21 ; Est-ce completement fini? Men26: cmp.l d6,d3 ;Buffer TI rempli? bcs.s FinMen ;NON---> c'est fini! ;-----> Reexplore les variables a la recherche de la DERNIERE CHAINE move.l VarLoc(a5),a6 ;Table des ad strings moveq #0,d4 ;Cpt tableau---> 0 move.l d1,d2 ;Feneant! ; Rempli la table intermediaire Men31: .Loop move.w (a6)+,d0 Prend le flag beq.s .Loop Nul: non initialise! bmi.s .Proc Negatif: fin de chunk .Var btst #1,d0 Une chaine? bne.s .Alpha lsr.w #8,d0 Recupere la taille add.w d0,a6 move.w (a6)+,d0 Suivante beq.s .Loop bpl.s .Var .Proc move.l (a6),d0 Chunk suivant beq Men40 Le dernier? move.l d0,a6 Non, on boucle! bra.s .Loop ; Variable alphanumerique .Alpha move.l a6,a3 move.l (a6)+,d1 beq.s Men31 btst #6,d0 beq.s Men34 move.l d1,a3 moveq #0,d0 move.b (a3)+,d0 addq.l #1,a3 subq.w #1,d0 moveq #1,d4 Men32: move.w (a3)+,d1 ;Calcule nombre de variable addq.l #2,a3 addq.w #1,d1 mulu d1,d4 dbra d0,Men32 Men33: subq.l #1,d4 ; La variable pointe elle la meme chaine? Men34: cmp.l (a3)+,d7 beq.s Men36 tst.l d4 bne.s Men33 beq.s Men31 Men36: move.l d2,-4(a3) tst.l d4 bne.s Men33 beq.s Men31 ;-----> Refait un tour! Men40: move.l a1,d7 ;Monte la limite < bra Men0 ;-----> Menage fini! FinMen move.l a1,HiChaine(a5) ; Libere la m�moire move.l BMenage(a5),d0 bmi.s Finm1 move.l d0,a1 move.l #TMenage+16,d0 SyCall MemFree Finm1 clr.l BMenage(a5) ;-----> FIN DES DEUX MENAGES : ca marche maintenant? FinMenS movem.l (sp)+,d1-d7/a2-a6 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; LEFT$= ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InLeft ; - - - - - - - - - - - - - Rbsr L_RInMid move.l (a3)+,d4 moveq #0,d5 Rbra L_RInMid2 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Fonction LEFT$ ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp FnLeft ; - - - - - - - - - - - - - move.l d3,d4 move.l (a3)+,a2 moveq #0,d2 move.w (a2)+,d2 moveq #0,d5 Rbra L_RFnMid ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; =RIGHT$= ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InRight ; - - - - - - - - - - - - - Rbsr L_RInMid move.l (a3)+,d4 Rbmi L_FonCall moveq #0,d5 cmp.l d3,d4 Rbcc L_RInMid2 move.l d3,d5 sub.l d4,d5 addq.l #1,d5 Rbra L_RInMid2 ; - - - - - - - - - - - - - Lib_Cmp FnRight ; - - - - - - - - - - - - - move.l d3,d5 Rbmi L_FonCall move.l (a3)+,a2 moveq #0,d2 move.w (a2)+,d2 move.l #$ffff,d4 cmp.l d2,d5 bcs L73c move.l d2,d5 L73c: neg.l d5 add.l d2,d5 addq.l #1,d5 Rbra L_RFnMid ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; MID$= ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InMid2 ; - - - - - - - - - - - - - Rbsr L_RInMid move.l (a3)+,d5 move.l #$FFFF,d4 Rbra L_RInMid2 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp FnMid2 ; - - - - - - - - - - - - - move.l d3,d5 move.l (a3)+,a2 moveq #0,d2 move.w (a2)+,d2 move.l #$FFFF,d4 Rbra L_RFnMid ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; =MID$() 3 params ; - - - - - - - - - - - - - Lib_Cmp InMid3 ; - - - - - - - - - - - - - Rbsr L_RInMid move.l (a3)+,d4 move.l (a3)+,d5 Rbra L_RInMid2 ; - - - - - - - - - - - - - Lib_Cmp FnMid3 ; - - - - - - - - - - - - - move.l d3,d4 move.l (a3)+,d5 move.l (a3)+,a2 moveq #0,d2 move.w (a2)+,d2 Rbra L_RFnMid ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Commun LEFT MID RIGHT ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp RFnMid ; - - - - - - - - - - - - - tst.l d5 ;pointe au milieu de la chaine Rbmi L_FonCall beq.s mi2 subq.l #1,d5 mi2: add.l d5,a2 cmp.l d2,d5 ;pas pointe trop loin?? bcc.s RVide ;si! chaine vide mi3: tst.l d4 beq.s RVide Rbmi L_FonCall mi4: add.l d5,d4 cmp.l d2,d4 bls.s mi5 move.l d2,d4 mi5: sub.l d5,d4 mi6: move.l d4,d3 Rjsr L_Demande move d4,(a0)+ ;poke la longueur subq.l #1,d4 bmi.s mi8 mi7: move.b (a2)+,(a0)+ dbra d4,mi7 move a0,d0 ;rend pair btst #0,d0 beq.s mi8 addq.l #1,a0 mi8: move.l a0,HiChaine(a5) move.l a1,d3 rts RVide: move.l ChVide(a5),d3 ;ramene la chaine vide rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Commun MID LEFT RIGHT = / A0= adresse variable ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp RInMid ; - - - - - - - - - - - - - moveq #0,d3 move.l a0,a2 move.l (a2),a1 move.w (a1)+,d3 Rbsr L_Demande move.l (a2),d0 move.l a0,(a2) ;Change la variable move.l d0,a2 move.w d3,d2 move.w d2,(a0)+ ;Longueur subq.w #1,d2 lsr.w #2,d2 addq.l #2,a2 L77b: move.l (a2)+,(a0)+ dbra d2,L77b move.l a0,HiChaine(a5) addq.l #2,a1 moveq #0,d2 ;A1/D3= destination move.l (a3)+,a2 ;A2/D2= source move.w (a2)+,d2 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Commun LEFT MID RIGHT II ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp RInMid2 ; - - - - - - - - - - - - - tst.l d5 Rbmi L_FonCall beq.s mdst2 subq.l #1,d5 mdst2: add.l d5,a1 ;situe dans la chaine a changer cmp.l d3,d5 bcc.s mdst10 ;trop loin: ne change rien tst.l d4 Rbmi L_FonCall beq.s mdst10 add.l d5,d4 cmp.l d3,d4 bls.s mdst3 move.l d3,d4 mdst3: sub.l d5,d4 cmp.l d2,d4 ;limite par la taille de la chaine source bls.s mdst4 move.l d2,d4 mdst4: subq.l #1,d4 ;la chaine source est nulle! bmi.s mdst10 mdst5: move.b (a2)+,(a1)+ dbra d4,mdst5 mdst10: rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; =VAL / D2= type desire ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp FnVal ; - - - - - - - - - - - - - move.w d2,d4 move.l d3,a2 move.w (a2)+,d2 beq.s .Vide Rjsr L_ChVerBuf Recopie la chaine dans le buffer move.l Buffer(a5),a0 moveq #1,d0 Tenir compte du signe move.w d4,d2 Type desire Rjmp L_ValRout .Vide moveq #0,d3 Retourne un 0 entier / float / double moveq #0,d4 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; =RESOURCE$(n) ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp FnResource ; - - - - - - - - - - - - - ; Un message normal? move.l d3,d0 ble.s .Skip1 Rbsr L_Dia_GetPuzzle move.l a2,a0 move.l d3,d0 Rjsr L_GetMessage bra .Fin ; Le path du systeme? (0) .Skip1 neg.l d0 bne.s .Skip2 Rbsr L_Sys_GetPath Va chercher le pathname lea Sys_Pathname(a5),a0 Additionne! bra.s .Fin ; Un message systeme? (-1) .Skip2 cmp.l #1001,d0 bcc.s .Skip3 move.l Sys_Messages(a5),a0 bra.s .Fin0 ; Un message systeme editeur? (-1000) .Skip3 sub.l #1000,d0 cmp.l #1001,d0 bcc.s .Skip4 move.l Ed_Systeme(a5),a0 bra.s .Fin0 ; Un message de menu editeur? (-2000) .Skip4 sub.l #1000,d0 cmp.l #1001,d0 bcc.s .Skip5 move.l EdM_Messages(a5),a0 bra.s .Fin0 ; Un message editeur? (-3000) .Skip5 sub.l #1000,d0 cmp.l #1001,d0 bcc.s .Skip6 move.l Ed_Messages(a5),a0 bra.s .Fin0 ; Un message de test? (-4000) .Skip6 sub.l #1000,d0 cmp.l #1001,d0 bcc.s .Skip7 move.l Ed_TstMessages(a5),a0 bra.s .Fin0 ; Un message run-time? (-5000) .Skip7 sub.l #1000,d0 cmp.l #1001,d0 Rbcc L_FonCall move.l Ed_RunMessages(a5),a0 ; Retourne la chaine .Fin0 Rjsr L_GetMessage .Fin move.l a0,a2 Rbra L_Str2Chaine ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Source: Menus.s ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; MENU KEY ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InMenuKey ; - - - - - - - - - - - - - Rbsr L_MnDim tst.l MnLat(a2) Rbne L_FonCall clr.b MnKFlag(a2) rts ; - - - - - - - - - - - - - Lib_Cmp InMenuKey1 ; - - - - - - - - - - - - - Rbsr L_MnDim tst.l MnLat(a2) Rbne L_FonCall move.l (a3)+,a0 tst.w (a0)+ Rbeq L_FonCall move.b (a0),MnKAsc(a2) move.b #1,MnKFlag(a2) rts ; - - - - - - - - - - - - - Lib_Cmp InMenuKey2 ; - - - - - - - - - - - - - Rbsr L_MnDim tst.l MnLat(a2) Rbne L_FonCall move.l (a3)+,d2 moveq #0,d3 Rbra L_MnKy ; - - - - - - - - - - - - - Lib_Cmp InMenuKey3 ; - - - - - - - - - - - - - Rbsr L_MnDim tst.l MnLat(a2) Rbne L_FonCall move.l (a3)+,d3 move.l (a3)+,d2 Rbra L_MnKy ; - - - - - - - - - - - - - Lib_Cmp MnKy ; - - - - - - - - - - - - - L966 cmp.l #256,d3 Rbcc L_FonCall move.b d3,MnKSh(a2) cmp.l #128,d2 Rbcc L_FonCall move.b d2,MnKSc(a2) move.b #-1,MnKFlag(a2) rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; INSTRUCTION ON MENU ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InOnMenu ; - - - - - - - - - - - - - Rjsr L_OMnEff Rlea L_GoMenu,0 Branche la routine au test move.l a0,GoTest_GoMenu(a5) move.w d0,OMnType(a5) ext.l d1 move.w d1,OMnNb(a5) move.w d1,d2 * Nb de labesl*4 lsl.w #2,d1 move.l d1,d0 SyCall MemFast Rbeq L_OOfMem move.l a0,OMnBase(a5) add.l d1,a0 * Poke les jumps subq.w #1,d2 OnMn2 move.l (a3)+,-(a0) dbra d2,OnMn2 * Plus de branchements bclr #BitJump,ActuMask(a5) * Branche la routine Clearvar lea .Struc(pc),a1 lea Sys_ClearRoutines(a5),a2 SyCall AddRoutine rts ; Structure clearvar ; ~~~~~~~~~~~~~~~~~~ .Struc dc.l 0 Rbra L_OMnEff ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; MENU$(,,,)= ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InMenu ; - - - - - - - - - - - - - move.l #EntNul,d3 move.l d3,-(a3) move.l d3,-(a3) move.l d3,-(a3) Rbra L_InMenu4 ; - - - - - - - - - - - - - Lib_Cmp InMenu2 ; - - - - - - - - - - - - - move.l #EntNul,d3 move.l d3,-(a3) move.l d3,-(a3) Rbra L_InMenu4 ; - - - - - - - - - - - - - Lib_Cmp InMenu3 ; - - - - - - - - - - - - - move.l #EntNul,-(a3) Rbra L_InMenu4 ; - - - - - - - - - - - - - Lib_Cmp InMenu4 ; - - - - - - - - - - - - - Rjsr L_MnClearVar Routine pour ClearVar move.l a3,-(sp) lea 4*4(a3),a3 Pointe les dimensions move.w d5,d0 lsl.w #2,d0 pea 0(a3,d0.w) Position par defaut de la pile Rjsr L_MnFind bne.s IMenA Rjsr L_MnIns IMenA move.l 4(sp),a3 Repointe les chaines * Parametres par defaut move.l ScOnAd(a5),a0 cmp.l MnAdEc(a5),a0 beq.s IMen6 tst.l MnAdEc(a5) Rbne L_ScNOp move.l a0,MnAdEc(a5) IMen6: move.l EcWindow(a0),a0 move.b WiPaper+1(a0),d0 move.b WiPen+1(a0),d1 move.b d0,MnInkA1(a2) move.b d1,MnInkB1(a2) move.b d0,MnInkC1(a2) move.b d1,MnInkA2(a2) move.b d0,MnInkB2(a2) move.b d0,MnInkC2(a2) * Prend la chaine OBF lea MnObF(a2),a0 bsr MnOob * Prend la chaine OBOFF lea MnOb3(a2),a0 bsr MnOob * Prend la chaine OB2 lea MnOb2(a2),a0 bsr MnOob * Prend la chaine OB1 lea MnOb1(a2),a0 bsr MnOob * Ca y est!!! IMenX: addq.w #1,MnChange(a5) move.l (sp)+,a3 addq.l #4,sp rts ; Petite routine de creation ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ MnOob move.l (a3)+,d3 cmp.l #EntNul,d3 beq MnOob0 move.l d3,a1 tst.w (a1) bne MnOob1 * Efface la chaine MnOobE move.l (a0),d0 beq.s MnOob0 clr.l (a0) move.l d0,a1 moveq #0,d0 move.w (a1),d0 SyCall MemFree MnOob0 rts * Une chaine! MnOob1 movem.l a0/a1,-(sp) * Efface l'ancienne bsr.s MnOobE movem.l (sp)+,a0/a1 Rjsr L_MnObjet * Cree la nouvelle Rbeq L_OOfMem Rbmi L_FonCall move.l d0,(a0) rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; MENU DEL ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InMenuDel ; - - - - - - - - - - - - - Rjmp L_MnRaz ; - - - - - - - - - - - - - Lib_Cmp InMenuDel1 ; - - - - - - - - - - - - - Rbsr L_MnDim move.l a2,d0 moveq #0,d5 addq.w #1,MnChange(a5) Rjsr L_MnEff rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; SET MENU ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp InSetMenu ; - - - - - - - - - - - - - Rbsr L_MnDim move.l (a3)+,d3 move.l #EntNul,d0 cmp.l d0,d3 beq.s ISMn1 move.w d3,MnY(a2) bset #MnFixed,MnFlag(a2) ISMn1 move.l (a3)+,d1 cmp.l d0,d1 beq.s ISMn2 move.w d1,MnX(a2) bset #MnFixed,MnFlag(a2) ISMn2 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Trouve l'adresse d'un objet de menu ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp MnDim ; - - - - - - - - - - - - - tst.w d5 bne.s MnDim1 tst.l d3 Rbeq L_FonCall cmp.l #MnNDim,d3 Rbhi L_FonCall lea MnDFlags(a5),a0 lea -1(a0,d3.w),a0 rts * Cherche l'adresse D'UN objet MnDim1 Rjsr L_MnFind lsl.w #2,d5 add.w d5,a3 Saute les parametres tst.w d0 beq.s .Nd lea MnFlag(a2),a0 rts .Nd moveq #39,d0 Menu item not defined Rbra L_GoError ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Entree procedure menu *** illegal ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp MenuProcedure ; - - - - - - - - - - - - - rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; SOUS PROGRAMME UTILISE PAR VAL ET INPUT ; D0= Tenir compte du signe (TRUE) ; D2= Type voulu: 0= Entier / 1= Float / -1= le mieux ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp ValRout ; - - - - - - - - - - - - - movem.l a1-a2/d5-d7,-(sp) move.w d2,-(sp) move.l a0,d7 moveq #0,d4 move.l a0,a2 tst.w d0 beq.s val1c ; y-a-t'il un signe devant? ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ val1: move.b (a0)+,d0 beq val10 cmp.b #32,d0 beq.s val1 move.l a0,a2 subq.l #1,a2 cmp.b #"-",d0 bne.s val1a not d4 bra.s val1c val1a: cmp.b #"+",d0 beq.s val1c val1b: subq.l #1,a0 val1c ; Explore le debut du chiffre ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ move.b (a0)+,d0 beq val10 cmp.b #32,d0 beq.s val1c cmp.b #"$",d0 ;chiffre HEXA beq CHexa cmp.b #"%",d0 ;chiffre BINAIRE beq CBin cmp.b #".",d0 beq.s val2 cmp.b #"0",d0 bcs val10 cmp.b #"9",d0 bhi val10 ; Copie le chiffre dans BuFloat ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ val2: subq.l #1,a0 move.l a0,a1 Si float: trouve la fin du chiffre clr.w d3 Les flags lea BuFloat(a5),a2 moveq #60,d2 Taille maxi du buffer val3: move.b (a1)+,d0 cmp.b #32,d0 beq.s val3 move.b d0,(a2)+ beq.s val4 subq.w #1,d2 Au bout du buffer? beq.s val4 cmp.b #"0",d0 bcs.s val3z cmp.b #"9",d0 bls.s val3 val3z: cmp.b #".",d0 Cherche une "virgule" bne.s val3a bset #0,d3 Si deux virgules: fin du chiffre beq.s val3 bne.s val4 val3a: cmp.b #"e",d0 Cherche un exposant beq.s val3b cmp.b #"E",d0 Autre caractere: fin du chiffre bne.s val4 val3ab: move.b #"e",-1(a2) Met un E minuscule!!! val3b: move.b (a1)+,d0 Apres un E, accepte -/+ et chiffres cmp.b #32,d0 beq.s val3b cmp.b #"+",d0 beq.s val3c cmp.b #"-",d0 bne.s val3e val3c: bset #1,d3 + ou -: c'est un float! move.b d0,(a2)+ val3d: subq.w #1,d2 Au bout du buffer? beq.s val4 move.b (a1)+,d0 Puis cherche la fin de l'exposant cmp.b #32,d0 beq.s val3d val3e: move.b d0,(a2)+ subq.w #1,d2 Au bout du buffer? beq.s val4 cmp.b #"0",d0 bcs.s val4 cmp.b #"9",d0 Chiffre! c'est un float bls.s val3c val4: clr.b (a2) clr.b -(a2) Recule d'un > fin du float subq.l #1,a1 Reste sur la fin du chiffre lea BuFloat(a5),a0 Le buffer de conversion tst.w (sp) Un entier quoi qu'il arrive beq.s CEntier bpl.s .Float btst #0,MathFlags(a5) Si indifferent, beq.s CEntier Entier, si pas de math ; Conversion ASCII ---> FLOAT ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .Float move.l a1,-(sp) Rjsr L_Ascii2Float move.l d0,d3 move.l d1,d4 move.l (sp)+,a0 Pointe la fin du chiffre moveq #1,d2 Un float moveq #0,d0 Pas d'erreur bra.s ValOut La sortie ; Converti vers un chiffre entier ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; chiffre entier CEntier move.l a1,-(sp) bsr declong Conversion a partir de BuFloat move.l (sp)+,a0 Pointe la fin du chiffre bra.s CFin ; chiffre hexa CHexa: bsr hexalong bra.s CFin ; chiffre binaire CBin bsr binlong ; Test du signe CFin move.l d0,d3 Retourne en D3 tst.w d1 Conversion valide? beq.s .Ok moveq #0,d3 Si probleme: ramene zero! .Ok tst.w d4 beq.s ECheck neg.l d3 ; Verification du type ; ~~~~~~~~~~~~~~~~~~~~~~~~~~ ECheck moveq #0,d0 Pas d'erreur moveq #0,d2 Entier tst.w (sp) Que veut-on? beq.s .Ent Un entier bpl.s .Flt Un float! btst #0,MathFlags(a5) On sait pas, si float present... beq.s .Ent ...retourne un float .Flt movem.l d0-d1/a0,-(sp) Rjsrt L_IntToFl1 movem.l (sp)+,d0-d1/a0 moveq #1,d2 .Ent bra.s ValOut ; Erreur, ramene zero ; ~~~~~~~~~~~~~~~~~~~~~~~~~ val10: moveq #0,d3 moveq #1,d0 move.l d7,a0 Repointe le debut bra.s ECheck ; Sortie ValOut addq.l #2,sp movem.l (sp)+,a1-a2/d5-d7 tst.l d0 rts ; MINI CHRGET POUR LES CONVERSIONS ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ minichr move.b (a0)+,d2 beq.s mc1 cmp.b #32,d2 beq.s minichr cmp.b #"a",d2 ;si minuscule: majuscule bcs.s mc0 sub.b #"a"-"A",d2 mc0 sub.b #48,d2 rts mc1 move.b #-1,d2 rts ; Minichr pour hexa ; ~~~~~~~~~~~~~~~~~ minichr2 move.b (a0)+,d2 beq.s .mc1 cmp.b #"a",d2 ;si minuscule: majuscule bcs.s .mc0 sub.b #"a"-"A",d2 .mc0: sub.b #48,d2 rts .mc1: move.b #-1,d2 rts ; CONVERSION DECIMAL->HEXA SUR QUATRE OCTETS, SIGNE! ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ declong moveq #0,d0 moveq #0,d2 moveq #0,d3 move.l a0,-(sp) ddh1: bsr minichr ddh1a: cmp.b #10,d2 bcc.s ddh5 move d0,d1 mulu #10,d1 swap d0 mulu #10,d0 swap d0 tst d0 bne.s ddh2 add.l d1,d0 bcs.s ddh2 add.l d2,d0 bmi.s ddh2 addq #1,d3 bra.s ddh1 ddh2: move.l (sp)+,a0 moveq #1,d1 ;out of range: bpl, et recupere l'adresse rts ddh5: subq.l #1,a0 addq.l #4,sp tst d3 beq.s ddh7 moveq #0,d1 ;OK: chiffre en d0, et beq rts ddh7: moveq #-1,d1 ;pas de chiffre: bmi rts ; CONVERSION HEXA-ASCII EN HEXA-HEXA ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ hexalong moveq #0,d0 moveq #0,d2 moveq #0,d3 move.l a0,-(sp) hh1: bsr minichr2 cmp.b #10,d2 bcs.s hh2 cmp.b #17,d2 bcs.s ddh5 subq.w #7,d2 hh2: cmp.b #16,d2 bcc.s ddh5 lsl.l #4,d0 or.b d2,d0 addq.w #1,d3 cmp #9,d3 bne.s hh1 beq.s ddh2 ; CONVERSION BINAIRE ASCII ---> HEXA SUR QUATRE OCTETS ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ binlong moveq #0,d0 moveq #0,d2 moveq #0,d3 move.l a0,-(sp) bh1: bsr minichr cmp.b #2,d2 bcc.s ddh5 roxr #1,d2 roxl.l #1,d0 bcs.s ddh2 addq.w #1,d3 cmp.w #33,d3 bne.s bh1 beq ddh1 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; DEBUT DES SWAP FLOAT ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Ouverture des libraries mathematiques ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp CmpInitFloat ; - - - - - - - - - - - - - move.b d0,MathFlags(a5) Stocke les flags move.l a6,-(sp) move.l $4.w,a6 move.l #$c90fd942,ValPi(a5) Simple precision move.l #$b4000048,Val180(a5) ; Init float.library moveq #0,d0 lea FloatName(pc),a1 jsr _LVOOpenLibrary(a6) move.l d0,FloatBase(a5) beq.s .Err ; Init mathffp.library btst #1,MathFlags(a5) Des maths? beq.s .Ok moveq #0,d0 lea MathName(pc),a1 jsr _LVOOpenLibrary(a6) move.l d0,MathBase(a5) beq.s .Err .Ok moveq #0,d0 bra.s .Out .Err moveq #1,d0 .Out move.l (sp)+,a6 rts FloatName dc.b "mathffp.library",0 MathName dc.b "mathtrans.library",0 even ; - - - - - - - - - - - - - Lib_Cmp CmpInitDouble ; - - - - - - - - - - - - - move.l a6,-(sp) move.b d0,MathFlags(a5) Stocke les flags move.l $4.w,a6 ; Init float.library moveq #0,d0 lea .FloatName(pc),a1 jsr _LVOOpenLibrary(a6) move.l d0,FloatBase(a5) beq.s .Err ; Init mathffp.library moveq #0,d0 lea .MathName(pc),a1 jsr _LVOOpenLibrary(a6) move.l d0,MathBase(a5) beq.s .Err ; Pi / 180 move.l #$40668000,Val180(a5) move.l #$00000000,Val180+4(a5) move.l #$400921fb,ValPi(a5) move.l #$54442eea,ValPi+4(a5) ; Init Dfloat moveq #0,d0 lea .DFloatName(pc),a1 jsr _LVOOpenLibrary(a6) move.l d0,DFloatBase(a5) beq.s .Err ; Init DMath moveq #0,d0 lea .DMathName(pc),a1 jsr _LVOOpenLibrary(a6) move.l d0,DMathBase(a5) beq.s .Err ; OK! .Ok moveq #0,d0 bra.s .Out .Err moveq #1,d0 .Out move.l (sp)+,a6 rts .FloatName dc.b "mathffp.library",0 .MathName dc.b "mathtrans.library",0 .DFloatName dc.b "mathieeedoubbas.library",0 .DMathName dc.b "mathieeedoubtrans.library",0 even ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; ENTIER >>> FLOAT ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Conversion entier >>> float dans le dernier operateur ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp IntToFl1 ; - - - - - - - - - - - - - move.l d3,d0 move.l a6,d3 move.l FloatBase(a5),a6 jsr _LVOSPFlt(a6) move.l d3,a6 move.l d0,d3 rts ; - - - - - - - - - - - - - Lib_Cmp DIntToFl1 ; - - - - - - - - - - - - - move.l d3,d0 move.l a6,d3 move.l DFloatBase(a5),a6 jsr _LVOIEEEDPFlt(a6) move.l d3,a6 move.l d0,d3 move.l d1,d4 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; ENTIER >>> FLOAT ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Conversion entier >>> float dans la pile ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp IntToFl2 ; - - - - - - - - - - - - - move.l (a3),d0 move.l a6,d4 move.l FloatBase(a5),a6 jsr _LVOSPFlt(a6) move.l d4,a6 move.l d0,(a3) rts ; - - - - - - - - - - - - - Lib_Cmp DIntToFl2 ; - - - - - - - - - - - - - movem.l (a3),d0-d1 move.l a6,d2 move.l DFloatBase(a5),a6 jsr _LVOIEEEDPFlt(a6) move.l d2,a6 movem.l d0-d1,(a3) rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; FLOAT >>> ENTIER ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Conversion float >>> entier dans le dernier operateur ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp FlToInt1 ; - - - - - - - - - - - - - move.l d3,d0 move.l a6,d3 move.l FloatBase(a5),a6 jsr _LVOSPFix(a6) move.l d3,a6 move.l d0,d3 rts ; - - - - - - - - - - - - - Lib_Cmp DFlToInt1 ; - - - - - - - - - - - - - move.l d3,d0 move.l d4,d1 move.l a6,d3 move.l DFloatBase(a5),a6 jsr _LVOIEEEDPFix(a6) move.l d3,a6 move.l d0,d3 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; FLOAT >>> ENTIER ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Conversion float >>> entier dans la pile ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp FlToInt2 ; - - - - - - - - - - - - - move.l (a3),d0 move.l a6,d4 move.l FloatBase(a5),a6 jsr _LVOSPFix(a6) move.l d4,a6 move.l d0,(a3) rts ; - - - - - - - - - - - - - Lib_Cmp DFlToInt2 ; - - - - - - - - - - - - - movem.l (a3),d0-d1 move.l a6,d2 move.l DFloatBase(a5),a6 jsr _LVOIEEEDPFix(a6) move.l d2,a6 movem.l d0-d1,(a3) rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; FONCTION MATHEMATIQUE ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Fait une fonction mathematique ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp Math_Fonction ; - - - - - - - - - - - - - move.l d3,d0 move.l a6,d3 move.l MathBase(a5),a6 jsr 0(a6,d2.w) move.l d3,a6 move.l d0,d3 rts ; - - - - - - - - - - - - - Lib_Cmp DMath_Fonction ; - - - - - - - - - - - - - move.l d3,d0 move.l d4,d1 move.l a6,d3 move.l DMathBase(a5),a6 jsr 0(a6,d2.w) move.l d3,a6 move.l d0,d3 move.l d1,d4 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; COMPARAISONS FLOAT ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Fait une comparaison float ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp Float_Compare ; - - - - - - - - - - - - - move.l d3,d0 move.l (a3)+,d1 move.l a6,d3 move.l FloatBase(a5),a6 jsr _LVOSPCmp(a6) move.l d3,a6 rts ; - - - - - - - - - - - - - Lib_Cmp DFloat_Compare ; - - - - - - - - - - - - - move.l d3,d0 move.l d4,d1 movem.l (a3)+,d2-d3 move.l a6,d5 move.l DFloatBase(a5),a6 jsr _LVOIEEEDPCmp(a6) move.l d5,a6 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Operation FLOAT ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Fait une operation float ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp Float_Operation ; - - - - - - - - - - - - - move.l (a3)+,d0 move.l d3,d1 move.l a6,d4 move.l FloatBase(a5),a6 jsr 0(a6,d2.w) move.l d4,a6 move.l d0,d3 rts ; - - - - - - - - - - - - - Lib_Cmp DFloat_Operation ; - - - - - - - - - - - - - movem.l (a3)+,d0-d1 exg d3,d2 exg d4,d3 move.l a6,d5 move.l DFloatBase(a5),a6 jsr 0(a6,d4.w) move.l d5,a6 move.l d0,d3 move.l d1,d4 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; FLOAT= ZERO? ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Fait un TST sur le float D3 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp Float_Test ; - - - - - - - - - - - - - move.l d3,d1 move.l a6,d4 move.l FloatBase(a5),a6 jsr _LVOSPTst(a6) move.l d4,a6 rts ; - - - - - - - - - - - - - Lib_Cmp Float_TestF ; - - - - - - - - - - - - - move.l d3,d0 move.l d4,d1 move.l a6,d2 move.l DFloatBase(a5),a6 jsr _LVOIEEEDPTst(a6) move.l d2,a6 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Operation MATH ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Fait une operation Math ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp Math_Operation ; - - - - - - - - - - - - - move.l (a3)+,d0 move.l d3,d1 move.l a6,d4 move.l MathBase(a5),a6 jsr 0(a6,d2.w) move.l d4,a6 move.l d0,d3 rts ; - - - - - - - - - - - - - Lib_Cmp DMath_Operation ; - - - - - - - - - - - - - movem.l (a3)+,d0-d1 exg d3,d2 exg d4,d3 move.l a6,d5 move.l DMathBase(a5),a6 jsr 0(a6,d4.w) move.l d5,a6 move.l d0,d3 move.l d1,d4 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; FONCTION FLOAT ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Fait une fonction float ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp Float_Fonction ; - - - - - - - - - - - - - move.l d3,d0 move.l a6,d3 move.l FloatBase(a5),a6 jsr 0(a6,d2.w) move.l d3,a6 move.l d0,d3 rts ; - - - - - - - - - - - - - Lib_Cmp DFloat_Fonction ; - - - - - - - - - - - - - move.l d3,d0 move.l d4,d1 move.l a6,d5 move.l DFloatBase(a5),a6 jsr 0(a6,d2.w) move.l d5,a6 move.l d0,d3 move.l d1,d4 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Verifie que le float est positif ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp FlPos Simple precision ; - - - - - - - - - - - - - btst #7,d3 Rbne L_FonCall rts ; - - - - - - - - - - - - - Lib_Cmp FlPosD Double precision ; - - - - - - - - - - - - - btst #31,d3 Rbne L_FonCall rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; RETOURNE UN ANGLE ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp AAngle SFloat ; - - - - - - - - - - - - - move.l d3,d0 Appel de la fonction move.l a6,d3 move.l MathBase(a5),a6 jsr 0(a6,d2.w) tst.w Angle(a5) beq.s .AAnX move.l FloatBase(a5),a6 move.l ValPi(a5),d1 jsr _LVOSPDiv(a6) move.l Val180(a5),d1 jsr _LVOSPMul(a6) .AAnX move.l d3,a6 move.l d0,d3 rts ; - - - - - - - - - - - - - Lib_Cmp AAngleD DFloat ; - - - - - - - - - - - - - move.l d3,d0 Appel de la fonction move.l d4,d1 move.l a6,d5 move.l DMathBase(a5),a6 jsr 0(a6,d2.w) tst.w Angle(a5) beq.s .AAnY move.l DFloatBase(a5),a6 move.l ValPi(a5),d2 move.l ValPi+4(a5),d3 jsr _LVOSPDiv(a6) move.l Val180(a5),d2 move.l Val180+4(a5),d3 jsr _LVOSPMul(a6) .AAnY move.l d5,a6 move.l d0,d3 move.l d1,d4 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; TRANSFORME EN ANGLE ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp FFAngle SFloat ; - - - - - - - - - - - - - tst.w Angle(a5) bne.s .Conv rts ; Conversion--> radian .Conv move.l d3,d0 move.l a6,d3 move.l FloatBase(a5),a6 move.l Val180(a5),d1 jsr _LVOSPDiv(a6) move.l ValPi(a5),d1 jsr _LVOSPMul(a6) move.l d3,a6 move.l d0,d3 rts ; - - - - - - - - - - - - - Lib_Cmp FAngleD DFloat ; - - - - - - - - - - - - - tst.w Angle(a5) bne.s .Conv rts ; Conversion--> radian .Conv move.l d3,d0 move.l d4,d1 move.l a6,d5 move.l DFloatBase(a5),a6 move.l Val180(a5),d2 move.l Val180+4(a5),d3 jsr _LVOSPDiv(a6) move.l ValPi(a5),d2 move.l ValPi+4(a5),d3 jsr _LVOSPMul(a6) move.l d5,a6 move.l d0,d3 move.l d1,d4 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; PARAM FLOAT (!) ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp FnParamF SFloat ; - - - - - - - - - - - - - move.l ParamF(a5),d3 rts ; - - - - - - - - - - - - - Lib_Cmp FnParamD DFloat ; - - - - - - - - - - - - - move.l ParamF(a5),d3 move.l ParamF2(a5),d4 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; ASCII Vers Float ; A0 Buffer ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp Ascii2Float ; - - - - - - - - - - - - - move.l a0,-(sp) Rjsr L_AscToFloat addq.l #4,sp rts ; - - - - - - - - - - - - - Lib_Cmp Ascii2FloatD ; - - - - - - - - - - - - - move.l a0,-(sp) Rjsr L_AscToDouble addq.l #4,sp rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Float vers ascii ; D3/D4 Float ; A0 Buffer ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp Float2Ascii ; - - - - - - - - - - - - - move.l d3,d0 Simple precision move.w FixFlg(a5),d4 move.w ExpFlg(a5),d5 bclr #31,d4 Rjmp L_FloatToAsc ; - - - - - - - - - - - - - Lib_Cmp Float2AsciiD ; - - - - - - - - - - - - - moveq #2,d0 Double precision moveq #15,d1 tst.w FixFlg(a5) bmi.s .Ok move.w FixFlg(a5),d1 Nombre de chiffres tst.w ExpFlg(a5) beq.s .Ok moveq #0,d0 .Ok movem.l a0-a1,-(sp) btst #31,d3 Si positif bne.s .Neg move.b #" ",(a0)+ Un espace devant .Neg move.l d0,-(sp) move.l d1,-(sp) move.l a0,-(sp) move.l d4,-(sp) move.l d3,-(sp) Rjsr L_DoubleToAsc lea 20(sp),sp movem.l (sp)+,a0/a1 .Lop tst.b (a0)+ Pointe la fin bne.s .Lop subq.l #1,a0 rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; MAX en simple/double precision ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp FnMaxF ; - - - - - - - - - - - - - move.l (a3),-(a3) Rjsrt L_Float_Compare ble.s .Skip move.l (a3),d3 .Skip addq.l #4,a3 rts ; - - - - - - - - - - - - - Lib_Cmp FnMaxD ; - - - - - - - - - - - - - movem.l (a3),d0-d1 movem.l d0-d1,-(sp) movem.l d3-d4,-(sp) Rjsrt L_Float_Compare ble.s .Skip movem.l (sp),d3-d4 bra.s .Out .Skip movem.l 8(sp),d3-d4 .Out lea 16(sp),sp rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; MIN en simple/double precision ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Cmp FnMinF ; - - - - - - - - - - - - - move.l (a3),-(a3) Rjsrt L_Float_Compare bge.s .Skip move.l (a3),d3 .Skip addq.l #4,a3 rts ; - - - - - - - - - - - - - Lib_Cmp FnMinD ; - - - - - - - - - - - - - movem.l (a3),d0-d1 movem.l d0-d1,-(sp) movem.l d3-d4,-(sp) Rjsrt L_Float_Compare bge.s .Skip movem.l (sp),d3-d4 bra.s .Out .Skip movem.l 8(sp),d3-d4 .Out lea 16(sp),sp rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Espace pour le compilateur! ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_Pos 500 ; - - - - - - - - - - - - - ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Finish the library ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lib_End ; - - - - - - - - - - - - - ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; END OF THE EXTENSION ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - C_End dc.w 0 even