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