7774 lines
171 KiB
ArmAsm
7774 lines
171 KiB
ArmAsm
|
||
;---------------------------------------------------------------------
|
||
;
|
||
; 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.
|
||
;
|
||
;---------------------------------------------------------------------
|
||
|
||
;---------------------------------------------------------------------
|
||
Lib_Ini 0
|
||
;---------------------------------------------------------------------
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; INITIALISATION LIBRAIRIE
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def Init
|
||
Init
|
||
; - - - - - - - - - - - - -
|
||
move.w #$00FF,d0 Librairie numero 0
|
||
move.w #Ver_Number,d1
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; ROUTINES A NETTOYER
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
|
||
; Routines de chargement
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
Lib_Int Edit_Load
|
||
Lib_Int Edit_Free
|
||
Lib_Int Mon_Load
|
||
Lib_Int Mon_Free
|
||
|
||
; Entrees dans le moniteur (5 places)
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
Lib_Def Mon_Start
|
||
Lib_Def Mon_In_Editor
|
||
Lib_Def Mon_In_Program
|
||
Lib_Def Mon_MonitorChr
|
||
Lib_Def Mon_Free2
|
||
Lib_Def Mon_Free3
|
||
|
||
; Entrees dans l'editeur (15 places)
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
Lib_Def Ed_Start
|
||
Lib_Def Ed_Cold 0
|
||
Lib_Def Ed_Title 1
|
||
Lib_Def Ed_End 2
|
||
Lib_Def Ed_Loop 3
|
||
Lib_Def Ed_ErrRun 4
|
||
Lib_Def Ed_CloseEditor 5
|
||
Lib_Def Ed_KillEditor 6
|
||
Lib_Def Ed_ZapFonction 7
|
||
Lib_Def Ed_ZapIn 8
|
||
Lib_Def Ed_RunDirect 9
|
||
Lib_Def Tokenise 10
|
||
Lib_Def Detok 11
|
||
Lib_Def Mon_Detok 12
|
||
Lib_Def TInst 13
|
||
Lib_Def Ed_Free1 14
|
||
Lib_Def Ed_Free2 15
|
||
Lib_Def Ed_Free3 16
|
||
Lib_Def Ed_Free1 17
|
||
Lib_Def Ed_Free2 18
|
||
|
||
; Routines dans la verification
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
Lib_Int Tk_FindA
|
||
Lib_Int Tk_EditL
|
||
Lib_Int Tk_FindL
|
||
Lib_Int Tk_FindN
|
||
Lib_Int Tk_SizeL
|
||
Lib_Int Prg_RunIt
|
||
Lib_Int Prg_TestIt
|
||
Lib_Int Prg_Save
|
||
Lib_Int Prg_Load
|
||
Lib_Int Prg_New
|
||
Lib_Int Prg_NewStructure
|
||
Lib_Int Prg_DelStructure
|
||
Lib_Int Prg_AccAdr
|
||
Lib_Int Prg_DejaRunned
|
||
Lib_Int Prg_DataLoad
|
||
Lib_Int Prg_DataSave
|
||
Lib_Int Prg_DataNew
|
||
Lib_Int Prg_CptLines
|
||
Lib_Int Prg_ChgTTexte
|
||
Lib_Int Prg_SetBanks
|
||
Lib_Int Prg_ReSetBanks
|
||
Lib_Int Prg_SetBanks
|
||
Lib_Int Prg_Pull
|
||
Lib_Int ClearVar
|
||
Lib_Int PTest
|
||
Lib_Int SsTest
|
||
Lib_Int ResVNom
|
||
Lib_Int ResDir
|
||
Lib_Int ResVarBuf
|
||
Lib_Int VerDirect
|
||
Lib_Int Stack_Reserve
|
||
Lib_Int Includes_Clear
|
||
Lib_Int Includes_Adr
|
||
Lib_Int Equ_Free
|
||
|
||
; Routines internes <20> "+b.s"
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
Lib_Int RamFast Ram Access
|
||
Lib_Int RamFast2
|
||
Lib_Int RamChip
|
||
Lib_Int RamChip2
|
||
Lib_Int RamFree
|
||
Lib_Int ResTempBuffer
|
||
|
||
Lib_Int Math_Close
|
||
Lib_Int Sys_WaitMul
|
||
Lib_Int Def_GetMessage
|
||
Lib_Int Sys_GetMessage
|
||
Lib_Int GetMessage
|
||
Lib_Int Sys_AddPath
|
||
Lib_Def Sys_GetPath Pour le compilateur!
|
||
Lib_Int Sys_UnCode
|
||
Lib_Int MemMaximum
|
||
Lib_Int MemDelBanks
|
||
Lib_Int TheEnd
|
||
Lib_Int UserReg
|
||
Lib_Int VersionN
|
||
Lib_Int BugBug
|
||
Lib_Int PreBug
|
||
Lib_Int Sys_ClearCache
|
||
Lib_Int WOption
|
||
Lib_Int ReCop
|
||
|
||
Lib_Int Lst.ChipNew Gestion des listes
|
||
Lib_Int Lst.New
|
||
Lib_Int Lst.Cree
|
||
Lib_Int Lst.DelAll
|
||
Lib_Int Lst.Del
|
||
Lib_Int Lst.Insert
|
||
Lib_Int Lst.Remove
|
||
Lib_Int Bnk.PrevProgram
|
||
Lib_Int Bnk.CurProgram
|
||
Lib_Int AskDir
|
||
Lib_Int AskDir2
|
||
|
||
; Special compilateur
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
Lib_Def Tokenisation Routines pour APCMP
|
||
Lib_Def Testing
|
||
Lib_Def CValRout
|
||
|
||
Lib_Def CmpInit1 Routines d'initialisation
|
||
Lib_Def CmpInit2
|
||
Lib_Def AMOSInit
|
||
Lib_Def CmpDbMode
|
||
Lib_Def CmpLineCLI
|
||
Lib_Def CmpLineSER
|
||
Lib_Def CmpPrintCLI
|
||
Lib_Def CmpPrintSER
|
||
Lib_Def CmpEffVarBuf
|
||
Lib_Def CmpLibrariesInit
|
||
Lib_Def CmpLibrariesStop
|
||
Lib_Def CmpEndRoutines
|
||
Lib_Def CmpLibClose
|
||
Lib_Def CmpClearVar
|
||
|
||
Lib_Def PlusF Routines d'operateurs
|
||
Lib_Def PlusC
|
||
Lib_Def MoinsF
|
||
Lib_Def MoinsC
|
||
Lib_Def MultE
|
||
Lib_Def MultF
|
||
Lib_Def DiviseE
|
||
Lib_Def DiviseF
|
||
Lib_Def Puissance
|
||
Lib_Def Modulo
|
||
Lib_Def Chaine_Compare
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; DEFRUN: initialisation graphique
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def DefRun1
|
||
; - - - - - - - - - - - - -
|
||
tst.w DefFlag(a5)
|
||
beq DRunX
|
||
movem.l d0-d7/a0-a6,-(sp)
|
||
; Enleve les animations
|
||
; ~~~~~~~~~~~~~~~~~~~~~
|
||
SyCall AMALClr
|
||
clr.w PAmalE(a5)
|
||
; Enleve les rainbows
|
||
; ~~~~~~~~~~~~~~~~~~~
|
||
EcCalD RainDel,-1
|
||
; Appel des routines de nettoyage
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
lea Sys_DefaultRoutines(a5),a1
|
||
SyCall CallRoutines
|
||
; Enleve tous les ecrans
|
||
; ~~~~~~~~~~~~~~~~~~~~~~
|
||
move.w PI_DefEBa(a5),ColBack(a5)
|
||
moveq #0,d1
|
||
moveq #7,d2
|
||
EcCall DelAll
|
||
clr.w ScOn(a5)
|
||
clr.l ScOnAd(a5)
|
||
move.w #8,CurTab(a5) Tab par defaut
|
||
; Enleve le tempras
|
||
; ~~~~~~~~~~~~~~~~~
|
||
clr.l RasLock(a5)
|
||
Rjsr L_FreeRas
|
||
; Enleve les blocs!
|
||
; ~~~~~~~~~~~~~~~~~
|
||
EcCall CBlRaz
|
||
EcCall BlRaz
|
||
; Enleve les font-infos
|
||
; ~~~~~~~~~~~~~~~~~~~~~
|
||
EcCall FFonts
|
||
; RAZ des canaux d'animation
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
lea AnCanaux(a5),a0
|
||
moveq #0,d0
|
||
DRun1: clr.b (a0)+
|
||
move.b d0,(a0)+
|
||
addq.w #1,d0
|
||
cmp.w #64,d0
|
||
bne.s DRun1
|
||
; Priority off
|
||
; ~~~~~~~~~~~~
|
||
moveq #0,d1
|
||
moveq #0,d2
|
||
SyCall SPrio
|
||
; RAZ des scrollings
|
||
; ~~~~~~~~~~~~~~~~~~
|
||
moveq #NDScrolls-1,d0
|
||
lea DScrolls(a5),a0
|
||
DRun2: move.w #$8000,(a0)
|
||
lea 12(a0),a0
|
||
dbra d0,DRun2
|
||
; Interruptions branchees
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~
|
||
clr.w InterOff(a5)
|
||
move.w InterOff(a5),d1
|
||
SyCall SetSync
|
||
move.w #%0111000100000000,ActuMask(a5)
|
||
clr.w VBLDelai(a5)
|
||
clr.w VBLOCount(a5)
|
||
; Copie la palette par defaut
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
lea PI_DefEPa(a5),a0
|
||
lea DefPal(a5),a1
|
||
moveq #31,d0
|
||
EdTr: move.w (a0)+,(a1)+
|
||
dbra d0,EdTr
|
||
; Cree l'ecran (si pas system!)
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
cmp.w #-2,DefFlag(a5)
|
||
beq.s DRex0
|
||
move.w PI_DefETx(a5),d2
|
||
ext.l d2
|
||
move.w PI_DefETy(a5),d3
|
||
ext.l d3
|
||
move.w PI_DefECo(a5),d4
|
||
ext.l d4
|
||
move.w PI_DefEMo(a5),d5
|
||
move.w PI_DefECoN(a5),d6
|
||
moveq #0,d7
|
||
lea DefPal(a5),a1
|
||
EcCalD Cree,0
|
||
bne.s DRex0
|
||
move.l a0,ScOnAd(a5)
|
||
move.w #1,ScOn(a5)
|
||
move.l #EntNul,d4
|
||
move.l d4,d5
|
||
move.w PI_DefEWx(a5),d2 Si non initialise...
|
||
bne.s .Skip1
|
||
move.l d4,d2
|
||
.Skip1 move.w PI_DefEWy(a5),d3
|
||
bne.s .Skip2
|
||
move.l d4,d3
|
||
.Skip2 EcCalD AView,0
|
||
; Fait flasher la couleur 3 (si plus de 2 couleurs)
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
cmp.w #1,PI_DefECo(a5)
|
||
beq.s DRex0
|
||
moveq #3,d1
|
||
moveq #46,d0
|
||
Rjsr L_Sys_GetMessage
|
||
move.l a0,a1
|
||
EcCall Flash
|
||
; Call extensions
|
||
; ~~~~~~~~~~~~~~~
|
||
Rbsr L_DefRunExtensions
|
||
; Fini
|
||
; ~~~~
|
||
DRex0 movem.l (sp)+,d0-d7/a0-a6
|
||
DRunX: rts
|
||
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def DefRun2
|
||
; - - - - - - - - - - - - -
|
||
tst.w DefFlag(a5)
|
||
beq.s DRunX
|
||
clr.w DefFlag(a5)
|
||
; Limite la souris
|
||
; ~~~~~~~~~~~~~~~~
|
||
move.w T_DefWX(a5),d1
|
||
move.w T_DefWY(a5),d2
|
||
move.w PI_DefETx(a5),d3
|
||
move.w PI_DefETy(a5),d4
|
||
subq.w #1,d3
|
||
subq.w #1,d4
|
||
add.w d1,d3
|
||
add.w d2,d4
|
||
lsl.w #1,d1
|
||
lsl.w #1,d2
|
||
lsl.w #1,d3
|
||
lsl.w #1,d4
|
||
lea LimSave(a5),a0
|
||
move.w d1,(a0)+
|
||
move.w d2,(a0)+
|
||
move.w d3,(a0)+
|
||
move.w d4,(a0)+
|
||
lea T_MouXMin(a5),a0
|
||
tst.l (a0)
|
||
bne.s .Skip
|
||
move.w d1,(a0)+
|
||
move.w d2,(a0)+
|
||
move.w d3,(a0)+
|
||
move.w d4,(a0)+
|
||
.Skip move.l PI_ParaTrap+16(a5),d1 * Nombre de lignes
|
||
SyCall SBufHs
|
||
SyCall OffHs
|
||
SyCall StoreM
|
||
SyCall StoreM
|
||
SyCall AffHs
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; DEFRUNACC: semi initialisation graphique pour accessoires
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def DefRunAcc
|
||
; - - - - - - - - - - - - -
|
||
movem.l d0-d7/a0-a6,-(sp)
|
||
; Appel des routines de nettoyage
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
lea Sys_DefaultRoutines(a5),a1
|
||
SyCall CallRoutines
|
||
; Enleve les animations
|
||
; ~~~~~~~~~~~~~~~~~~~~~
|
||
SyCall AMALClr
|
||
clr.w PAmalE(a5)
|
||
; RAZ des canaux d'animation
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
lea AnCanaux(a5),a0
|
||
moveq #0,d0
|
||
.DRun1 clr.b (a0)+
|
||
move.b d0,(a0)+
|
||
addq.w #1,d0
|
||
cmp.w #64,d0
|
||
bne.s .DRun1
|
||
; Priority off
|
||
; ~~~~~~~~~~~~
|
||
moveq #0,d1
|
||
moveq #0,d2
|
||
SyCall SPrio
|
||
; RAZ des scrollings
|
||
; ~~~~~~~~~~~~~~~~~~
|
||
moveq #NDScrolls-1,d0
|
||
lea DScrolls(a5),a0
|
||
.DRun2 move.w #$8000,(a0)
|
||
lea 12(a0),a0
|
||
dbra d0,.DRun2
|
||
; Interruptions branchees
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~
|
||
clr.w InterOff(a5)
|
||
move.w InterOff(a5),d1
|
||
SyCall SetSync
|
||
move.w #%0111000100000000,ActuMask(a5)
|
||
clr.w VBLDelai(a5)
|
||
clr.w VBLOCount(a5)
|
||
; Call extensions
|
||
; ~~~~~~~~~~~~~~~
|
||
Rbsr L_DefRunExtensions
|
||
; Sprites
|
||
; ~~~~~~~
|
||
SyCall OffHs
|
||
SyCall AffHs
|
||
move.w #1,DefFlag(a5)
|
||
movem.l (sp)+,d0-d7/a0-a6
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; INITIALISATION ECRAN DES EXTENSIONS
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def DefRunExtensions
|
||
; - - - - - - - - - - - - -
|
||
movem.l a2-a6/d2-d7,-(sp)
|
||
.DRex0 lea ExtAdr(a5),a0
|
||
moveq #26-1,d0
|
||
.DRex1 move.l 4(a0),d1
|
||
beq.s .DRex2
|
||
move.l d1,a1
|
||
movem.l a0/d0,-(sp)
|
||
jsr (a1)
|
||
movem.l (sp)+,a0/d0
|
||
.DRex2 lea 16(a0),a0
|
||
dbra d0,.DRex1
|
||
movem.l (sp)+,a2-a6/d2-d7
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Set Patch sur CHRGET
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def SetChrPatch
|
||
; - - - - - - - - - - - - -
|
||
move.w d0,Cur_ChrJump(a5)
|
||
lea _Poke(pc),a1
|
||
tst.w d0
|
||
beq.s .Norm
|
||
move.w .Mon(pc),(a1)+
|
||
lsl.w #2,d0
|
||
neg.w d0
|
||
sub.w #LB_Size+4,d0
|
||
move.w d0,(a1)+
|
||
bra.s .Clear
|
||
.Norm move.l .Chr(pc),(a1)+
|
||
.Clear Rjsr L_Sys_ClearCache
|
||
rts
|
||
.Chr move.l -LB_Size(a4,d1.w),a0
|
||
.Mon move.l 0(a4),a0
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; ENTREE DU CHRGET
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def Pos_IRet
|
||
; - - - - - - - - - - - - -
|
||
dc.w _IRet-_DChr
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def New_ChrGet
|
||
; - - - - - - - - - - - - - - -
|
||
_DChr move.l BasSp(a5),sp
|
||
move.l AdTokens(a5),a4
|
||
|
||
; Adresse du retour d'instructions
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
lea _IRet(pc),a0
|
||
move.l a0,Prg_InsRet(a5)
|
||
; Buffer des boucles
|
||
; ~~~~~~~~~~~~~~~~~~
|
||
Rjsrt L_Stack_Reserve
|
||
; beq VerOut *** Illegal!
|
||
move.l HoLoop(a5),a3
|
||
move.l a3,PLoop(a5)
|
||
move.l a3,BasA3(a5)
|
||
move.l BaLoop(a5),MinLoop(a5)
|
||
add.l #64,MinLoop(a5)
|
||
|
||
; Ouverture des librairies mathematiques / Choix des routines dans la librarie
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
bsr Open_MathLibraries
|
||
|
||
; Autres inits
|
||
; ~~~~~~~~~~~~
|
||
clr.w T_Actualise(a5)
|
||
clr.l AData(a5)
|
||
move.w #1,DefFlag(a5)
|
||
move.l Prg_Run(a5),a6
|
||
move.l a6,DProc(a5)
|
||
move.l a6,PData(a5)
|
||
|
||
; Debuggage
|
||
IFNE Debug>1
|
||
move.l VarBufL(a5),d0
|
||
cmp.l #1024*1,d0
|
||
bne.s .NoBug
|
||
Rjsr L_PreBug
|
||
.NoBug
|
||
ENDC
|
||
|
||
; Boucle du ChrGet
|
||
; ~~~~~~~~~~~~~~~~~~~~~~
|
||
move.l AdTokens(a5),a4
|
||
_NLine tst.w (a6)+
|
||
beq.s InEnd
|
||
_ILoop move.w (a6)+,d0
|
||
beq.s _NLine
|
||
_Inst move.l a6,d7
|
||
move.w 0(a4,d0.w),d1 Pointe la table de tokens
|
||
_Poke move.l -LB_Size(a4,d1.w),a0
|
||
IFNE Debug
|
||
move.l a3,Chr_Debug(a5)
|
||
movem.l d6/d7,Chr_Debug+4(a5)
|
||
ENDC
|
||
jsr (a0)
|
||
_IRet
|
||
IFNE Debug>1
|
||
move.l Chr_Debug(a5),a0
|
||
movem.l Chr_Debug+4(a5),d0/d1
|
||
cmp.l a0,a3 Test valide PLOOP
|
||
bne.s .Bug
|
||
cmp.l d0,d6 Test sauvegarde D6/D7
|
||
bne.s .Bug
|
||
cmp.l d1,d7
|
||
beq.s .Skip
|
||
.Bug Rjsr L_BugBug
|
||
Rjsr L_InMonitor
|
||
ENDC
|
||
IFNE Debug
|
||
move.l Chr_Debug(a5),a0
|
||
movem.l Chr_Debug+4(a5),d0/d1
|
||
cmp.l a0,a3 Test valide PLOOP
|
||
bne.s .Bug1
|
||
cmp.l d0,d6 Test sauvegarde D6/D7
|
||
bne.s .Bug1
|
||
cmp.l d1,d7
|
||
beq.s .Skip
|
||
.Bug1 Rjsr L_InMonitor
|
||
ENDC
|
||
.Skip
|
||
move.w (a6)+,d0
|
||
bne.s _Inst
|
||
tst.w (a6)+
|
||
bne.s _ILoop
|
||
bra.s InEnd
|
||
|
||
; - - - - - - - - - - - - -
|
||
Lib_Par InEnd
|
||
; - - - - - - - - - - - - -
|
||
InEnd moveq #NbEnd,d0
|
||
bra RunErr
|
||
|
||
; Librairies ouvertes par le ChrGet
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
MathName dc.b "mathtrans.library",0
|
||
DFloatName dc.b "mathieeedoubbas.library",0
|
||
DMathName dc.b "mathieeedoubtrans.library",0
|
||
even
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; EXTENSION INSTRUCTION CALL
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InExtCall
|
||
; - - - - - - - - - - - - -
|
||
move.b (a6)+,d1 # Extension
|
||
move.b (a6)+,d0 Nombre de params
|
||
bpl.s .Old NOUVELLE extension?
|
||
; Nouvelle extension AMOSPro II
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
ext.w d1
|
||
lsl.w #2,d1
|
||
move.l AdTokens(a5,d1.w),a0
|
||
move.w (a6)+,d0
|
||
move.w 0(a0,d0.w),d1 # du jump dans la librarie
|
||
move.w 2(a0,d0.w),d2 Nombre de parametres
|
||
move.l -LB_Size(a0,d1.w),a0 Adresse du saut
|
||
jmp (a0) On y va!
|
||
; Ancienne extension
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~
|
||
.Old move.w (a6)+,d2
|
||
ext.w d1
|
||
lsl.w #2,d1
|
||
move.l AdTokens(a5,d1.w),a0
|
||
add.w 0(a0,d2.w),a0
|
||
ext.w d0
|
||
beq.s .Skip
|
||
move.l a0,-(sp)
|
||
move.w d0,-(sp)
|
||
.Loop bsr New_Evalue
|
||
cmp.b #1,d2
|
||
bne.s .Ent
|
||
Rjsrt L_FlToInt1
|
||
.Ent move.l d3,-(a3)
|
||
addq.l #2,a6
|
||
subq.w #1,(sp)
|
||
bne.s .Loop
|
||
subq.l #2,a6
|
||
addq.l #2,sp
|
||
move.l (sp)+,a0
|
||
.Skip movem.l d6-d7,ErrorSave(a5)
|
||
move.b #1,ErrorRegs(a5)
|
||
jsr (a0)
|
||
movem.l ErrorSave(a5),d6-d7
|
||
clr.b ErrorRegs(a5)
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; EXTENSION FUNCTION CALL
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def FnExtCall
|
||
; - - - - - - - - - - - - -
|
||
move.b (a6)+,d1
|
||
move.b (a6)+,d0
|
||
bpl.s .Old NOUVELLE extension?
|
||
; Nouvelle extension AMOSPro II
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
ext.w d1
|
||
lsl.w #2,d1
|
||
move.l AdTokens(a5,d1.w),a0
|
||
move.w (a6)+,d0
|
||
move.w 0(a0,d0.w),d1 # du jump dans la librarie
|
||
move.w 2(a0,d0.w),d2 Nombre de parametres
|
||
move.l -LB_Size-4(a0,d1.w),a0 Adresse du saut
|
||
jmp (a0) On y va!
|
||
; Ancienne extension
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~
|
||
.Old move.w (a6)+,d2
|
||
ext.w d1
|
||
lsl.w #2,d1
|
||
move.l AdTokens(a5,d1.w),a0
|
||
add.w 2(a0,d2.w),a0
|
||
ext.w d0
|
||
beq.s .Skip
|
||
move.l a0,-(sp)
|
||
move.w d0,-(sp)
|
||
.Loop bsr Fn_New_Evalue
|
||
cmp.b #1,d2
|
||
bne.s .Ent
|
||
Rjsrt L_FlToInt1
|
||
.Ent move.l d3,-(a3)
|
||
subq.w #1,(sp)
|
||
bne.s .Loop
|
||
addq.l #2,sp
|
||
move.l (sp)+,a0
|
||
.Skip movem.l d6-d7,ErrorSave(a5)
|
||
move.b #1,ErrorRegs(a5)
|
||
jsr (a0)
|
||
movem.l ErrorSave(a5),d6-d7
|
||
clr.b ErrorRegs(a5)
|
||
rts
|
||
|
||
; Ouverture / Echange des routines mathemetiques
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def Open_MathLibraries
|
||
; - - - - - - - - - - - - -
|
||
Open_MathLibraries
|
||
move.l a6,-(sp)
|
||
move.l #$c90fd942,ValPi(a5) Simple precision
|
||
move.l #$b4000048,Val180(a5)
|
||
move.l #$04040404,Long_Var(a5)
|
||
move.l $4.w,a6
|
||
btst #1,MathFlags(a5) Simple precision
|
||
beq.s .M1
|
||
tst.l MathBase(a5)
|
||
bne.s .M1
|
||
moveq #0,d0
|
||
lea MathName(pc),a1
|
||
jsr _LVOOpenLibrary(a6)
|
||
move.l d0,MathBase(a5)
|
||
beq ErrMLibs
|
||
.M1 tst.b MathFlags(a5) Double precicion
|
||
bpl.s .M3
|
||
move.l #$40668000,Val180(a5)
|
||
move.l #$00000000,Val180+4(a5)
|
||
move.l #$400921fb,ValPi(a5)
|
||
move.l #$54442eea,ValPi+4(a5)
|
||
move.l #$04080404,Long_Var(a5)
|
||
tst.l DFloatBase(a5)
|
||
bne.s .M2
|
||
moveq #0,d0
|
||
lea DFloatName(pc),a1
|
||
jsr _LVOOpenLibrary(a6)
|
||
move.l d0,DFloatBase(a5)
|
||
beq ErrMLibs
|
||
.M2 tst.l DMathBase(a5)
|
||
bne.s .M3
|
||
moveq #0,d0
|
||
lea DMathName(pc),a1
|
||
jsr _LVOOpenLibrary(a6)
|
||
move.l d0,DMathBase(a5)
|
||
beq ErrMLibs
|
||
.M3 bsr Lib_FloatSwap Echange les routines float
|
||
Rjsr L_Sys_ClearCache
|
||
move.l (sp)+,a6
|
||
rts
|
||
|
||
; Echange des routines float dans la librarie
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
Lib_FloatSwap
|
||
movem.l a2/d2,-(sp)
|
||
lea AdTokens(a5),a2
|
||
moveq #27-1,d2
|
||
.Loop tst.l (a2)
|
||
beq.s .MSkip
|
||
move.l (a2),a1
|
||
tst.w LB_FFloatSwap(a1)
|
||
beq.s .MSkip
|
||
tst.b MathFlags(a5)
|
||
bmi.s .MDble
|
||
btst #LBF_DFloat,LB_Flags(a4)
|
||
bne.s .MSwap
|
||
beq.s .MSkip
|
||
.MDble btst #LBF_DFloat,LB_Flags(a4)
|
||
bne.s .MSkip
|
||
.MSwap bsr Lib_FSwap
|
||
.MSkip addq.l #4,a2
|
||
dbra d2,.Loop
|
||
movem.l (sp)+,a2/d2
|
||
rts
|
||
; Routine d'echange
|
||
; ~~~~~~~~~~~~~~~~~
|
||
Lib_FSwap
|
||
bchg #LBF_DFloat,LB_Flags(a4)
|
||
move.w LB_DFloatSwap(a1),d0
|
||
lsl.w #2,d0
|
||
neg.w d0
|
||
lea -LB_Size-4(a1,d0.w),a0
|
||
move.w LB_FFloatSwap(a1),d1
|
||
sub.w LB_DFloatSwap(a1),d1
|
||
ext.l d1
|
||
lsr.l #1,d1
|
||
subq.w #1,d1
|
||
bmi.s .Skip
|
||
.Loop move.l -4(a0),d0
|
||
move.l -8(a0),-4(a0)
|
||
move.l d0,-8(a0)
|
||
lea -8(a0),a0
|
||
dbra d1,.Loop
|
||
.Skip rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; INTERPRETEUR SEUL: recuperation des parametres...
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def Parameters
|
||
; - - - - - - - - - - - - -
|
||
Par dc.w Ent_0-Par 0>>> Entier normal
|
||
dc.w Ent_1-Par 1
|
||
dc.w Ent_2-Par 2
|
||
dc.w Ent_3-Par 3
|
||
dc.w Ent_4-Par 4
|
||
dc.w Ent_N-Par 5
|
||
dc.w Flt_0-Par 6>>> Float normal
|
||
dc.w Flt_1-Par 7
|
||
dc.w Flt_2-Par 8
|
||
dc.w Flt_N-Par 9
|
||
dc.w Flt_N-Par 10
|
||
dc.w Flt_N-Par 11
|
||
dc.w IVar_0-Par 12>> Variable reservee
|
||
dc.w IVar_1-Par 13
|
||
dc.w IVar_2-Par 14
|
||
dc.w IVar_3-Par 15
|
||
dc.w IVar_4-Par 16
|
||
dc.w IVar_N-Par 17
|
||
dc.w Par_Angle-Par 18>> Fonction angle
|
||
dc.w Par_Math-Par 19>> Fonction math
|
||
; Si extensions (D2= nombre de params)
|
||
dc.w Ent_0-Par 0>>> Entier normal
|
||
dc.w Ent_1-Par 1
|
||
dc.w Ent_2-Par 2
|
||
dc.w Ent_3-Par 3
|
||
dc.w Ent_4-Par 4
|
||
dc.w EEnt_N-Par 5
|
||
dc.w Flt_0-Par 6>>> Float normal
|
||
dc.w Flt_1-Par 7
|
||
dc.w Flt_2-Par 8
|
||
dc.w EFlt_N-Par 9
|
||
dc.w EFlt_N-Par 10
|
||
dc.w EFlt_N-Par 11
|
||
dc.w IVar_0-Par 12>> Variable reservee
|
||
dc.w IVar_1-Par 13
|
||
dc.w IVar_2-Par 14
|
||
dc.w IVar_3-Par 15
|
||
dc.w IVar_4-Par 16
|
||
dc.w EIVar_N-Par 17
|
||
dc.w Par_Angle-Par 18>> Fonction angle
|
||
dc.w Par_Math-Par 19>> Fonction math
|
||
|
||
; Variable reserve en instruction, 1 param
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
EIVar_N
|
||
bsr EFEnt_N
|
||
bra.s IVar
|
||
IVar_N bsr FEnt_N
|
||
bra.s IVar
|
||
IVar_4 bsr.s FEnt_4
|
||
bra.s IVar
|
||
IVar_3 bsr.s FEnt_3
|
||
bra.s IVar
|
||
IVar_2 bsr.s FEnt_2
|
||
bra.s IVar
|
||
IVar_1 bsr.s FEnt_1
|
||
IVar move.l d3,-(a3)
|
||
IVar_0 bsr Fn_New_Evalue Recolte du parametre a affecter
|
||
cmp.b #1,d2
|
||
beq.s .Ent
|
||
rts
|
||
.Ent Rjmpt L_FlToInt1
|
||
|
||
; QUATRE parametres ENTIER / CHAINE
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
FEnt_4 addq.l #2,a6
|
||
Ent_4 bsr New_Evalue
|
||
cmp.b #1,d2
|
||
bne.s .Ent
|
||
Rjsrt L_FlToInt1
|
||
.Ent move.l d3,-(a3)
|
||
; TROIS parametres ENTIER / CHAINE
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
FEnt_3 addq.l #2,a6
|
||
Ent_3 bsr New_Evalue
|
||
cmp.b #1,d2
|
||
bne.s .Ent
|
||
Rjsrt L_FlToInt1
|
||
.Ent move.l d3,-(a3)
|
||
; DEUX parametres ENTIER / CHAINE
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
FEnt_2 addq.l #2,a6
|
||
Ent_2 bsr New_Evalue
|
||
cmp.b #1,d2
|
||
bne.s .Ent
|
||
Rjsrt L_FlToInt1
|
||
.Ent move.l d3,-(a3)
|
||
; UN parametre ENTIER / CHAINE
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
FEnt_1 addq.l #2,a6
|
||
Ent_1 bsr New_Evalue
|
||
cmp.b #1,d2
|
||
beq.s Ent
|
||
Ent_0 rts
|
||
Ent Rjmpt L_FlToInt1
|
||
|
||
; Fonction ANGLE, toujours float, appel FAngle
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
Par_Angle
|
||
bsr Fn_New_Evalue
|
||
tst.b d2
|
||
bne.s .Flaot
|
||
Rjsrt L_IntToFl1
|
||
.Flaot Rjmpt L_FFAngle
|
||
|
||
; Fonction mathematique: 1 param, branchement >entier >float
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
Par_Math
|
||
addq.l #4,sp
|
||
move.w d1,-(sp)
|
||
bsr Fn_New_Evalue
|
||
move.w (sp)+,d0
|
||
tst.b d2
|
||
bne.s .Float
|
||
move.l -LB_Size-4(a4,d0.w),a0 Saute l'appel params
|
||
jmp 4(a0)
|
||
.Float move.l -LB_Size-8(a4,d0.w),a0 Pas d'appel params ici...
|
||
jmp (a0)
|
||
|
||
; N Parametres FLOAT / CHAINES
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
EFFlt_N addq.l #2,a6
|
||
EFlt_N move.w d2,-(sp)
|
||
bra.s SOne
|
||
FFlt_N addq.l #2,a6
|
||
Flt_N move.w 2(a4,d0.w),-(sp)
|
||
bra.s SOne
|
||
SLoop move.l d3,-(a3)
|
||
addq.l #2,a6
|
||
SOne bsr New_Evalue
|
||
tst.b d2
|
||
bne.s SOk
|
||
Rjsrt L_IntToFl1
|
||
SOk subq.w #1,(sp)
|
||
bne.s SLoop
|
||
rtr
|
||
; DEUX parametres FLOAT / CHAINE
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
FFlt_2 addq.l #2,a6
|
||
Flt_2 bsr New_Evalue
|
||
tst.b d2
|
||
bne.s .Ent
|
||
Rjmpt L_IntToFl1
|
||
.Ent move.l d3,-(a3)
|
||
; UN parametre FLOAT / CHAINE
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
FFlt_1 addq.l #2,a6
|
||
Flt_1 bsr New_Evalue
|
||
tst.b d2
|
||
beq.s Flt
|
||
Flt_0 rts
|
||
Flt Rjmpt L_IntToFl1
|
||
|
||
; N parametres ENTIERS / CHAINE
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
EFEnt_N addq.l #2,a6
|
||
EEnt_N move.w d2,-(sp)
|
||
bra.s _POne
|
||
FEnt_N addq.l #2,a6
|
||
Ent_N move.w 2(a4,d0.w),-(sp)
|
||
bra.s _POne
|
||
_PLoop move.l d3,-(a3)
|
||
addq.l #2,a6
|
||
_POne bsr New_Evalue
|
||
cmp.b #1,d2
|
||
bne.s _POk
|
||
Rjsrt L_FlToInt1
|
||
_POk subq.w #1,(sp)
|
||
bne.s _PLoop
|
||
rtr
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; TEST INTER SANS SAUT
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def Test_PaSaut
|
||
Test_PaSaut
|
||
; - - - - - - - - - - - - -
|
||
movem.l d0-d7/a0-a6,-(sp)
|
||
bset #Bit_PaSaut,Test_Flags(a5)
|
||
bsr.s Test_Normal
|
||
bclr #Bit_PaSaut,Test_Flags(a5)
|
||
movem.l (sp)+,d0-d7/a0-a6
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; TEST NORMAL
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def Test_Normal
|
||
Test_Normal
|
||
; - - - - - - - - - - - - -
|
||
tst.b T_Actualise(a5)
|
||
bmi.s Test_Force
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; TEST FORCE
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def Test_Force
|
||
Test_Force
|
||
; - - - - - - - - - - - - -
|
||
move.w ActuMask(a5),d4
|
||
|
||
; Inhibition par un autre AMOS?
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
SyCall Test_Cyclique
|
||
|
||
; Les dialogues???
|
||
; ~~~~~~~~~~~~~~~~
|
||
move.l Cur_Dialogs(a5),a0 Un dialogue?
|
||
tst.l (a0)
|
||
beq.s .NoDia
|
||
Rjsr L_Dia_AutoTest
|
||
beq.s .NoDia
|
||
add.w #IDia_Errors,d0
|
||
Rbra L_Error
|
||
.NoDia
|
||
; Les menus???
|
||
; ~~~~~~~~~~~~
|
||
btst #BitMenu,d4 Menus en route?
|
||
beq.s Tst0
|
||
tst.l MnBase(a5) Un menu defini?
|
||
beq.s Tst0
|
||
tst.w MnProc(a5) Pas dans une procedure menu
|
||
bne.s Tst0
|
||
tst.l T_ClLast(a5) Une touche?
|
||
beq.s Tst0a
|
||
tst.w Direct(a5) Pas en mode direct
|
||
bne.s Tst0a
|
||
Rjsr L_MenuKeyExplore
|
||
Tst0a btst #10,$dff016 Afficher le menu?
|
||
bne.s Tst0
|
||
Rjsr L_MnGere
|
||
bne RunErr
|
||
|
||
; Autres choses???
|
||
; ~~~~~~~~~~~~~~~~
|
||
Tst0 move.w T_Actualise(a5),d3
|
||
bclr #BitControl,d3
|
||
bne.s Tst00
|
||
and.w d4,d3
|
||
beq TstX1
|
||
bra.s Tst1
|
||
; CONTROLE-C?
|
||
; ~~~~~~~~~~~
|
||
Tst00 tst.l Mon_Base(a5) Retour au moniteur?
|
||
bne.s IStop
|
||
btst #BitControl,d4 Break autorise?
|
||
beq.s Tst01
|
||
IStop move.w d3,T_Actualise(a5)
|
||
moveq #9,d0
|
||
bra RunErr
|
||
Tst01 move.w d3,T_Actualise(a5)
|
||
Rjsr L_OnBreakGo
|
||
bra.s Tst1a
|
||
|
||
; Branchement automatique aux menus?
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
Tst1 bclr #BitJump,d3
|
||
beq.s Tst1a
|
||
Rjsr L_GoMenu
|
||
|
||
; Actualisation des ecrans/animations
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
Tst1a move.w T_VblCount+2(a5),d0
|
||
sub.w VBLOCount(a5),d0
|
||
cmp.w VBLDelai(a5),d0
|
||
bcs TstX1
|
||
move.w T_VblCount+2(a5),VBLOCount(a5)
|
||
; Bobs?
|
||
bclr #BitBobs,d3
|
||
beq.s Tst2
|
||
SyCall EffBob
|
||
SyCall ActBob
|
||
SyCall AffBob
|
||
EcCall SwapScS
|
||
; Hard Sprites?
|
||
Tst2: bclr #BitSprites,d3
|
||
beq.s Tst3
|
||
SyCall ActHs
|
||
SyCall AffHs
|
||
; Extensions?
|
||
Tst3: lsr.b #1,d3
|
||
beq.s Tst4
|
||
lea ExtTests(a5),a1
|
||
bra.s Tst3b
|
||
Tst3a move.l (a1),d0
|
||
beq.s Tst3b
|
||
move.l d0,a0
|
||
jsr (a0)
|
||
Tst3b addq.l #4,a1
|
||
lsr.b #1,d3
|
||
bcs.s Tst3a
|
||
bne.s Tst3b
|
||
; Ecrans?
|
||
Tst4: bclr #BitEcrans,d3
|
||
beq.s Tst5
|
||
EcCall CopMake
|
||
Tst5:
|
||
|
||
; Correction du bug CONTROL-C / Beaucoup de sprites
|
||
move.w T_Actualise(a5),d0
|
||
and.w #%0000000100000000,d0 BITCONTROL=8
|
||
or.w d0,d3
|
||
; Every
|
||
; ~~~~~
|
||
TstX1 move.w d3,T_Actualise(a5)
|
||
btst #BitEvery,d4
|
||
beq.s TstX2
|
||
tst.w T_EveCpt(a5)
|
||
bgt.s TstX2
|
||
move.w EveCharge(a5),T_EveCpt(a5)
|
||
bclr #BitEvery,d4
|
||
Rjsr L_EveJump
|
||
|
||
TstX2 bclr #BitVBL,T_Actualise(a5)
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Fait le branchement ON MENU
|
||
; Appele par TESTS
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def GoMenu
|
||
GoMenu
|
||
; - - - - - - - - - - - - -
|
||
btst #Bit_PaSaut,Test_Flags(a5) * Sauts autorises?
|
||
bne.s GoMX
|
||
tst.w Direct(a5) * Mode direct???
|
||
bne GoMX
|
||
lea MnChoix(a5),a0
|
||
move.w (a0),d0
|
||
beq.s GoMX
|
||
cmp.w OMnNb(a5),d0
|
||
bls.s GoMGo
|
||
* Rien trouve: FINI!
|
||
GoMX: rts
|
||
; Fait le branchement
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
GoMGo bclr #BitJump,d4 * Plus de jump!
|
||
move.w d4,ActuMask(a5)
|
||
move.w d3,T_Actualise(a5) * Derniere bug avant master!
|
||
move.l BasSp(a5),sp
|
||
move.l Prg_InsRet(a5),-(sp)
|
||
move.l OMnBase(a5),a0
|
||
lsl.w #2,d0
|
||
move.l -4(a0,d0.w),d0
|
||
move.w OMnType(a5),d1
|
||
cmp.w #_TkGto,d1
|
||
beq.s GoMG2
|
||
cmp.w #_TkGsb,d1
|
||
beq.s GoMG1
|
||
; Procedure!
|
||
; ~~~~~~~~~~
|
||
move.l d7,a6
|
||
subq.l #2,a6
|
||
move.l d0,a2
|
||
clr.w -(sp)
|
||
bra InProE
|
||
; Gosub
|
||
; ~~~~~
|
||
GoMG1 move.l d7,a6
|
||
subq.l #2,a6
|
||
bra Gos2
|
||
; Goto
|
||
; ~~~~
|
||
GoMG2 move.l d0,a6
|
||
bra LGoto
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; ON BREAK : Fait le branchement en cas de BREAK
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def OnBreakGo
|
||
; - - - - - - - - - - - - -
|
||
btst #Bit_PaSaut,Test_Flags(a5)
|
||
beq.s .Jmp
|
||
.Skip rts
|
||
.Jmp move.l OnBreak(a5),d0
|
||
beq.s .Skip
|
||
move.l d0,a2
|
||
move.l BasSp(a5),sp
|
||
move.l Prg_InsRet(a5),-(sp)
|
||
move.l d7,a6
|
||
subq.l #2,a6
|
||
clr.w -(sp)
|
||
bra InProE
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Fait le branchement a EVERY
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def EveJump
|
||
EveJump
|
||
; - - - - - - - - - - - - -
|
||
tst.l EveLabel(a5)
|
||
bne.s .Jmp
|
||
.Skip rts
|
||
.Jmp btst #Bit_PaSaut,Test_Flags(a5)
|
||
bne.s .Skip
|
||
move.w d4,ActuMask(a5)
|
||
move.l BasSp(a5),sp
|
||
move.l Prg_InsRet(a5),-(sp)
|
||
move.w EveType(a5),d0
|
||
cmp.w #_TkGsb,d0
|
||
beq.s .Gsb
|
||
; Procedure!
|
||
; ~~~~~~~~~~
|
||
move.l d7,a6
|
||
subq.l #2,a6
|
||
move.l EveLabel(a5),a2
|
||
clr.w -(sp)
|
||
bra InProE
|
||
; Gosub
|
||
; ~~~~~
|
||
.Gsb move.l EveLabel(a5),d0
|
||
move.l d7,a6
|
||
subq.l #2,a6
|
||
bra Gos2
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Source: b.s
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; ERREURS
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; - - - - - - - - - - - - -
|
||
ErrMLibs
|
||
; - - - - - - - - - - - - - Cannot open math libraries
|
||
move.l Prg_Run(a5),a6 Au debut du programme!
|
||
moveq #12,d0
|
||
bra.s RunErr
|
||
; - - - - - - - - - - - - -
|
||
MnINDef
|
||
; - - - - - - - - - - - - -
|
||
moveq #39,d0
|
||
bra.s RunErr
|
||
|
||
|
||
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def RIllDir
|
||
RIllDir
|
||
; - - - - - - - - - - - - -
|
||
moveq #17,d0
|
||
bra.s RunErr
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def OOfData
|
||
; - - - - - - - - - - - - -
|
||
OOfData moveq #33,d0
|
||
bra.s RunErr
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def OOfBuf
|
||
; - - - - - - - - - - - - -
|
||
OOfBuf moveq #11,d0 Out of buffer space
|
||
bra.s RunErr
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InpTL
|
||
InpTL
|
||
; - - - - - - - - - - - - -
|
||
moveq #DEBase+20,d0
|
||
bra.s RunErr
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def EProErr
|
||
EProErr
|
||
; - - - - - - - - - - - - -
|
||
moveq #8,d0
|
||
bra.s RunErr
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def ResLNo
|
||
ResLNo
|
||
; - - - - - - - - - - - - -
|
||
moveq #6,d0
|
||
bra.s RunErr
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def NoOnErr
|
||
NoOnErr
|
||
; - - - - - - - - - - - - -
|
||
moveq #5,d0
|
||
bra.s RunErr
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def ResPLab
|
||
ResPLab
|
||
; - - - - - - - - - - - - -
|
||
moveq #4,d0
|
||
bra.s RunErr
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def NoResume
|
||
NoResum
|
||
; - - - - - - - - - - - - -
|
||
moveq #3,d0
|
||
bra.s RunErr
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def NoErr
|
||
NoErr
|
||
; - - - - - - - - - - - - -
|
||
moveq #7,d0
|
||
bra.s RunErr
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def OofStack
|
||
OofStack
|
||
; - - - - - - - - - - - - -
|
||
moveq #13,d0
|
||
bra.s RunErr
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def NonDim
|
||
NonDim
|
||
; - - - - - - - - - - - - -
|
||
moveq #27,d0
|
||
bra.s RunErr
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def AlrDim
|
||
AlrDim
|
||
; - - - - - - - - - - - - -
|
||
moveq #28,d0
|
||
bra.s RunErr
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def DByZero
|
||
DByZero
|
||
; - - - - - - - - - - - - -
|
||
moveq #20,d0
|
||
bra.s RunErr
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def OverFlow
|
||
OverFlow
|
||
; - - - - - - - - - - - - -
|
||
moveq #29,d0
|
||
bra.s RunErr
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def RetGsb
|
||
RetGsb
|
||
; - - - - - - - - - - - - -
|
||
moveq #1,d0
|
||
bra.s RunErr
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def PopGsb
|
||
PopGsb
|
||
; - - - - - - - - - - - - -
|
||
moveq #2,d0
|
||
bra.s RunErr
|
||
; - - - - - - - - - - - - -
|
||
TypeMis
|
||
; - - - - - - - - - - - - -
|
||
moveq #34,d0
|
||
|
||
; __________________________________________________________________________
|
||
;
|
||
; Traitement des erreurs RUN TIME
|
||
; __________________________________________________________________________
|
||
;
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def Error
|
||
; - - - - - - - - - - - - -
|
||
RunErr: moveq #19,d1
|
||
moveq #-1,d2
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def ErrorExt
|
||
; - - - - - - - - - - - - -
|
||
RunErrExt
|
||
; Recupere les registres?
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~
|
||
tst.b ErrorRegs(a5)
|
||
beq.s .Skip
|
||
clr.b ErrorRegs(a5)
|
||
movem.l ErrorSave(a5),d6-d7
|
||
.Skip
|
||
; Appel des routines de fermeture
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
movem.l d0-d2/a0,-(sp)
|
||
lea Sys_ErrorRoutines(a5),a1
|
||
SyCall CallRoutines
|
||
movem.l (sp)+,d0-d2/a0
|
||
; Erreurs patchees?
|
||
; ~~~~~~~~~~~~~~~~~
|
||
tst.l Patch_Errors(a5)
|
||
bne J_EPatch
|
||
; Peut-on detourner l'erreur?
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
clr.l PrintPos(a5)
|
||
clr.w InputFlg(a5)
|
||
clr.w ContFlg(a5)
|
||
cmp.w #11,d0 * Variable space?
|
||
beq.s .skip
|
||
cmp.w d1,d0
|
||
bcs rErr1
|
||
.skip cmp.w #1000,d0 * Edit / Direct?
|
||
bcc rErr1
|
||
tst.w Direct(a5) * Mode direct
|
||
bne rErr1
|
||
tst.w ErrorOn(a5) * Erreur en route
|
||
bne rErr1
|
||
cmp.l TrapAdr(a5),d7 * TRAP?
|
||
beq.s .ETrap
|
||
tst.l OnErrLine(a5) * On error goto
|
||
beq rErr1
|
||
; ON ERROR GOTO
|
||
; ~~~~~~~~~~~~~
|
||
clr.l TrapAdr(a5) Plus de trap
|
||
clr.w TrapErr(a5)
|
||
addq.w #1,d0
|
||
addq.w #1,d2
|
||
lsl.w #8,d2
|
||
or.w d2,d0
|
||
move.w d0,ErrorOn(a5) Numero de l'erreur
|
||
move.l PLoop(a5),a3 Position pile expression
|
||
move.l BasSp(a5),sp
|
||
move.l Prg_InsRet(a5),-(sp)
|
||
move.l d7,d5
|
||
subq.l #2,d5
|
||
tst.w ErrorChr(a5)
|
||
bmi.s .rErr0
|
||
move.l d5,ErrorChr(a5) On error GOTO
|
||
move.l OnErrLine(a5),a6
|
||
rts
|
||
; ON ERROR PROC
|
||
; ~~~~~~~~~~~~~
|
||
.rErr0 move.l d5,a6 Retour procedure= RESUME
|
||
move.l OnErrLine(a5),a2
|
||
move.w ErrorOn(a5),-(sp)
|
||
bra InProE
|
||
; Nouvelle intruction TRAP
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~
|
||
.ETrap clr.l TrapAdr(a5)
|
||
addq.w #1,d2
|
||
lsl.w #8,d2
|
||
or.w d2,d0
|
||
move.w d0,TrapErr(a5)
|
||
move.l PLoop(a5),a3
|
||
move.l BasSp(a5),sp
|
||
move.l Prg_InsRet(a5),-(sp)
|
||
move.l d7,d5
|
||
subq.l #2,d5
|
||
move.l d5,a0
|
||
.ResN1 move.w (a0)+,d0
|
||
bsr TInst
|
||
bne.s .ResN2
|
||
tst.w (a0)
|
||
beq.s .ResN2
|
||
addq.l #2,a0
|
||
.ResN2 tst.w d0
|
||
bsr FinieB
|
||
bne.s .ResN1
|
||
move.l a0,a6
|
||
rts
|
||
|
||
; Erreurs non d<>tourn<72>es : les menus sont ouverts.
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
E_Retour:
|
||
rErr1:
|
||
; Un peu de menage...
|
||
; ~~~~~~~~~~~~~~~~~~~
|
||
movem.l a0/d0-d2,-(sp)
|
||
; Effacement des includes
|
||
move.l d7,a0
|
||
subq.l #2,a0
|
||
Rjsr L_Includes_Adr
|
||
move.l a0,VerPos(a5)
|
||
Rjsr L_Includes_Clear
|
||
; Depile le programme
|
||
move.l Prg_JError(a5),a2
|
||
Rjsr L_Prg_Pull
|
||
; Une erreur extension?
|
||
; ~~~~~~~~~~~~~~~~~~~~~
|
||
movem.l (sp)+,a0/d0-d2
|
||
move.w d0,d1
|
||
tst.w d2
|
||
bpl.s .Ext
|
||
; Erreur normale, branche a l'editeur
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
sub.l a0,a0
|
||
bra.s .Jmp
|
||
; Erreur extension: trouve le message
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
.ELoop tst.b (a0)+
|
||
bne.s .ELoop
|
||
.Ext dbra d1,.ELoop
|
||
moveq #1,d0 Change le numero message!
|
||
; Branche <20> la routine courante
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
.Jmp jmp (a2)
|
||
; Branchement <20> un detournement des erreurs
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
J_EPatch
|
||
move.l Patch_Errors(a5),a0
|
||
jmp (a0)
|
||
|
||
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; DEBUT DES ROUTINES AMOS / CLI
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def Start_Type
|
||
; - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; ||APCMP|| appel de procedure compilee
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def InAPCmp
|
||
; - - - - - - - - - - - - -
|
||
jsr APrg_Program(a6) Appelle le programme
|
||
move.l AdTokens(a5),a4 Recharge a4
|
||
tst.l d0
|
||
bmi RunII -1 >>> deuxieme partie de RUN
|
||
bne.s .Err Si erreur >>> BREAK!
|
||
lea APrg_EndProc(a6),a6 Pointe le delta a la fin
|
||
add.l (a6),a6
|
||
IFNE Debug
|
||
move.l a3,Chr_Debug(a5)
|
||
movem.l d6/d7,Chr_Debug+4(a5)
|
||
ENDC
|
||
rts
|
||
.Err move.l #512,d1 Force l'arret!
|
||
moveq #-1,d2
|
||
Rbra L_ErrorExt
|
||
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InAPCmpCLI
|
||
; - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; INSTRUCTION RUN
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InRun0
|
||
; - - - - - - - - - - - - -
|
||
tst.w Direct(a5)
|
||
beq Synt
|
||
Rjmpt L_Ed_RunDirect
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InRun0CLI
|
||
; - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - -
|
||
Lib_Par InRun1
|
||
; - - - - - - - - - - - - -
|
||
tst.w Direct(a5)
|
||
bne RIllDir
|
||
tst.l Mon_Base(a5)
|
||
bne PRun_Acc
|
||
tst.b Prg_Accessory(a5)
|
||
bne PRun_Acc
|
||
; Verifie la presence du programme
|
||
move.l d3,a2
|
||
move.w (a2)+,d2
|
||
move.l Name1(a5),a0
|
||
Rjsr L_ChVerBuf2
|
||
Rjsr L_Dsk.PathIt
|
||
move.l #1005,d2 Verifie la presence du fichier!
|
||
Rbsr L_D_Open
|
||
beq JDisk
|
||
Rbsr L_D_Close Le ferme!
|
||
; Effacement des includes
|
||
lea -2(a4),a0
|
||
Rjsr L_Includes_Adr
|
||
move.l a0,VerPos(a5)
|
||
Rjsr L_Includes_Clear
|
||
; - - - - - - - - - - - - -
|
||
RunII
|
||
; - - - - - - - - - - - - -
|
||
; Fait un new, sans effacer les ecrans
|
||
move.l Prg_Runned(a5),a6
|
||
moveq #0,d0 Pas d'effacement
|
||
Rjsr L_Prg_New
|
||
; Depile le programme
|
||
Rjsr L_Prg_Pull
|
||
; Charge le nouveau programme dans la structure
|
||
move.b #1,Prg_Reloaded(a6)
|
||
moveq #-1,d0 Toujours adapter!
|
||
Rjsr L_Prg_Load
|
||
cmp.w #-1,d0
|
||
beq.s .DErr
|
||
cmp.w #-2,d0
|
||
ble.s .OMem
|
||
; Run le nouveau programme
|
||
moveq #-1,d0 Semi init graphique
|
||
move.l Prg_JError(a5),a1 Ou se brancher en erreur
|
||
sub.l a2,a2 Pas de message
|
||
Rjsr L_Prg_RunIt
|
||
; Erreurs
|
||
; ~~~~~~~
|
||
.OMem moveq #36,d0
|
||
bra.s .Err
|
||
.DErr moveq #101,d0
|
||
.Err sub.l a0,a0
|
||
move.l Prg_JError(a5),a1
|
||
jmp (a1)
|
||
Rn_NoF moveq #81,d0 Erreur normale!
|
||
Rjmp L_Error
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InRun1CLI
|
||
; - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; INSTRUCTION PRUN
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InPRun
|
||
; - - - - - - - - - - - - -
|
||
tst.w Direct(a5)
|
||
bne RIllDir
|
||
tst.l Mon_Base(a5)
|
||
bne PRun_Acc
|
||
; tst.b Prg_Accessory(a5)
|
||
; bne PRun_Acc
|
||
move.l d3,a2
|
||
move.w (a2)+,d2
|
||
move.l Name1(a5),a0
|
||
Rjsr L_ChVerBuf2
|
||
; Sauve le programme courant
|
||
movem.l a3-a6/d6/d7,-(sp)
|
||
; Le programme est-il deja charge?
|
||
Rjsr L_Prg_AccAdr
|
||
beq.s .Loadit
|
||
move.l a0,a6
|
||
Rjsr L_Prg_DejaRunned
|
||
beq.s .Runit
|
||
; Il faut charger: verifie la presence du programme
|
||
.Loadit Rjsr L_Dsk.PathIt
|
||
move.l #1005,d2 Verifie la presence du fichier!
|
||
Rbsr L_D_Open
|
||
beq JDisk
|
||
Rbsr L_D_Close Le ferme!
|
||
; Ouvre une nouvelle structure
|
||
moveq #0,d0 Pas de buffer
|
||
Rjsr L_Prg_NewStructure Ouvre la structure
|
||
beq OOfMem
|
||
move.l d0,a6
|
||
; Charge le programme
|
||
moveq #-1,d0 Toujours adapter
|
||
Rjsr L_Prg_Load
|
||
tst.w d0
|
||
bne .LErr
|
||
move.l a6,-(sp) Remet les banques
|
||
move.l Prg_Runned(a5),a6 du premier programme
|
||
Rjsr L_Prg_SetBanks
|
||
move.l (sp)+,a6
|
||
; Programme charge: on le demarre!
|
||
.Runit moveq #-1,d0 Semi init graphique
|
||
lea PRun_Errors(pc),a1 Retour en cas d'erreur
|
||
sub.l a2,a2 Pas de message
|
||
move.l sp,BasSp(a5) Bas de la pile
|
||
Rjsr L_Prg_RunIt
|
||
bra.s .OMm
|
||
; Erreur lors du chargement
|
||
.LErr move.w d0,d1
|
||
moveq #101,d0
|
||
cmp.w #-1,d1
|
||
beq.s .Goerr
|
||
.OMm moveq #36,d0
|
||
; Revient au programme, avec un message d'erreur
|
||
.Goerr move.l d0,-(sp)
|
||
tst.b Prg_Edited(a6) Efface la structure s'il faut
|
||
bne.s .Edited
|
||
Rjsr L_Prg_DelStructure
|
||
.Edited move.l Prg_Runned(a5),a6
|
||
Rjsr L_Prg_SetBanks
|
||
Rjsr L_Bnk.Change
|
||
move.l (sp)+,d0
|
||
move.l Ed_RunMessages(a5),a0
|
||
Rjsr L_GetMessage
|
||
movem.l (sp)+,a3-a6/d6/d7
|
||
move.l sp,BasSp(a5)
|
||
Rbra L_ZapReturn
|
||
PRun_Acc
|
||
moveq #102,d0
|
||
Rjmp L_Error
|
||
; Retour d'erreur lors de PRUN
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
PRun_Errors
|
||
move.l BasSp(a5),sp
|
||
movem.l (sp)+,a3-a6/d6/d7 Restore le programme
|
||
move.l sp,BasSp(a5)
|
||
movem.l d6/d7,ErrorSave(a5) Au cas zou
|
||
IFNE Debug
|
||
movem.l d6/d7,Chr_Debug+4(a5) Pour empecher le plantage
|
||
ENDC
|
||
movem.l a0-a1/d0-d1,-(sp)
|
||
bsr Open_MathLibraries Rouvre les libraries
|
||
movem.l (sp)+,a0-a1/d0-d1
|
||
|
||
cmp.w #10,d0
|
||
beq.s .Nul
|
||
cmp.w #1000,d0
|
||
blt.s .Null
|
||
.Nul moveq #0,d0
|
||
.Null move.l ChVide(a5),a0
|
||
Rbra L_ZapReturn
|
||
JDisk Rjmp L_DiskError
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InPRunCLI
|
||
; - - - - - - - - - - - - -
|
||
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; ASK EDITOR
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InAskEditor1
|
||
; - - - - - - - - - - - - -
|
||
move.l d3,-(a3)
|
||
move.l #EntNul,d3
|
||
move.l d3,-(a3)
|
||
Rbra L_InAskEditor3
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InAskEditor1CLI
|
||
; - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - -
|
||
Lib_Par InAskEditor2
|
||
; - - - - - - - - - - - - -
|
||
move.l d3,-(a3)
|
||
move.l #EntNul,d3
|
||
Rbra L_InAskEditor3
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InAskEditor2CLI
|
||
; - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - -
|
||
Lib_Par InAskEditor3
|
||
; - - - - - - - - - - - - -
|
||
bsr Ed_Par
|
||
tst.l Edit_Segment(a5)
|
||
beq FonCall
|
||
Rjsrt L_Ed_ZapFonction
|
||
move.l d0,ParamE(a5)
|
||
move.l ChVide(a5),ParamC(a5)
|
||
tst.w d2
|
||
beq.s .Skip
|
||
Rjsr L_A0ToChaine
|
||
move.l a0,ParamC(a5)
|
||
.Skip rts
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InAskEditor3CLI
|
||
; - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; ZAPPEUSE D'EDITEUR!
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InCallEditor1
|
||
; - - - - - - - - - - - - -
|
||
move.l d3,-(a3)
|
||
move.l #EntNul,d3
|
||
move.l d3,-(a3)
|
||
Rbra L_InCallEditor3
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InCallEditor1CLI
|
||
; - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - -
|
||
Lib_Par InCallEditor2
|
||
; - - - - - - - - - - - - -
|
||
move.l d3,-(a3)
|
||
move.l #EntNul,d3
|
||
Rbra L_InCallEditor3
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InCallEditor2CLI
|
||
; - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - -
|
||
Lib_Par InCallEditor3
|
||
; - - - - - - - - - - - - -
|
||
bsr Ed_Par Recupere les parametres
|
||
tst.l Edit_Segment(a5)
|
||
beq FonCall
|
||
move.l BasSp(a5),-(sp) Pousse la pile
|
||
movem.l a3-a6/d6/d7,-(sp) Pousse le programme
|
||
move.l sp,BasSp(a5)
|
||
subq.l #4,BasSp(a5)
|
||
Rjsrt L_Ed_ZapIn Appel de l'editeur
|
||
movem.l (sp)+,a3-a6/d6/d7
|
||
move.l (sp)+,BasSp(a5)
|
||
Rbra L_ZapReturn
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InCallEditor3CLI
|
||
; - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - -
|
||
Lib_Int Bnk.PrevProgram
|
||
Lib_Def Bnk.PrevProgramCLI
|
||
; - - - - - - - - - - - - -
|
||
; - - - - - - - - - - - - -
|
||
Lib_Int Bnk.CurProgram
|
||
Lib_Def Bnk.CurProgramCLI
|
||
; - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; =Prg Under
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par FnPrgUnder
|
||
; - - - - - - - - - - - - -
|
||
moveq #-1,d3
|
||
tst.l Mon_Base(a5) Si moniteur: RIEN!
|
||
bne.s .Exit
|
||
move.l Prg_Runned(a5),a0 Un programme en dessous?
|
||
move.l Prg_Previous(a0),d0 Non!
|
||
bne.s .Out
|
||
move.l Edt_Current(a5),d0 Le programme courant?
|
||
beq.s .Exit
|
||
move.l d0,a1
|
||
move.l Edt_Prg(a1),d0
|
||
cmp.l d0,a0 Non!
|
||
beq.s .Exit
|
||
tst.l Edit_Segment(a5) Editeur KILL?
|
||
beq.s .Out
|
||
moveq #1,d3 OUIIIIIII
|
||
bra.s .Out
|
||
.Exit moveq #0,d3
|
||
.Out Ret_Int
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def FnPrgUnderCLI
|
||
; - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - -
|
||
Lib_Int InCloseEditor
|
||
Lib_Def InCloseEditorCLI
|
||
Lib_Int InKillEditor
|
||
Lib_Def InKillEditorCLI
|
||
Lib_Int InMonitor
|
||
Lib_Def InMonitorCLI
|
||
; - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; FIN DES ROUTINES AMOS / CLI
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def End_Type
|
||
; - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def RunName
|
||
; - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Recupere les parametres
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def Ed_Par
|
||
; - - - - - - - - - - - - -
|
||
Ed_Par move.l Name1(a5),a0
|
||
move.l Name2(a5),a1
|
||
clr.w (a1)
|
||
cmp.l #EntNul,d3
|
||
beq.s .Skip
|
||
move.l d3,a2
|
||
move.w (a2)+,d2
|
||
move.w d2,(a1)
|
||
Rjsr L_ChVerBuf2
|
||
.Skip move.l (a3)+,d1
|
||
move.l (a3)+,d0
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Retour de zappeuse
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def ZapReturn
|
||
; - - - - - - - - - - - - -
|
||
move.l ChVide(a5),ParamC(a5)
|
||
ext.l d0
|
||
move.l d0,ParamE(a5)
|
||
beq.s .Bof
|
||
Rjsr L_A0ToChaine
|
||
move.l a0,ParamC(a5)
|
||
.Bof rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; =Prg State
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par FnPrgState
|
||
; - - - - - - - - - - - - -
|
||
move.w T_AMOState(a5),d3
|
||
ext.l d3
|
||
Ret_Int
|
||
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def GetInstruction
|
||
Lib_Def GetInstruction2
|
||
; - - - - - - - - - - - - -
|
||
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; REM
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InRem
|
||
; - - - - - - - - - - - - -
|
||
add.w (a6)+,a6
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; SET BUFFER / SET STACK
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InSetBuffer
|
||
; - - - - - - - - - - - - -
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Source: branch.s
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; SAUTE UN LABEL
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InLab
|
||
; - - - - - - - - - - - - - - - -
|
||
moveq #0,d0
|
||
move.b 2(a6),d0
|
||
lea 4(a6,d0.w),a6
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; SYSTEM
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InSystem
|
||
InSystem
|
||
; - - - - - - - - - - - - -
|
||
move.w #1002,d0
|
||
bra RunErr
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; EDIT
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InEdit
|
||
InEdit
|
||
; - - - - - - - - - - - - -
|
||
move.w #1000,d0
|
||
bra RunErr
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; DIRECT
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InDirect
|
||
InDirect
|
||
; - - - - - - - - - - - - -
|
||
move.w #1001,d0
|
||
bra RunErr
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; BREAK ON / OFF
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InBreakOn
|
||
InBreakOn
|
||
; - - - - - - - - - - - - -
|
||
bset #BitControl,ActuMask(a5)
|
||
clr.l OnBreak(a5)
|
||
rts
|
||
; - - - - - - - - - - - - -
|
||
Lib_Par InBreakOff
|
||
InBreakOff
|
||
; - - - - - - - - - - - - -
|
||
bclr #BitControl,ActuMask(a5)
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; ON BREAK PROC label
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InOnBreak
|
||
InOnBreak
|
||
; - - - - - - - - - - - - -
|
||
bsr GetLabel
|
||
beq LbNDef
|
||
move.l d0,OnBreak(a5)
|
||
bclr #BitControl,ActuMask(a5)
|
||
; Rlea L_OnBreakGo,0 Pas de routine de branchement
|
||
; move.l a0,GoTest_OnBreak(a5)
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; ON ERROR ...
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InOnError
|
||
InOnError
|
||
; - - - - - - - - - - - - -
|
||
tst.w ErrorOn(a5) Error not resumed!
|
||
bne NoResum
|
||
clr.l OnErrLine(a5)
|
||
clr.l ErrorChr(a5)
|
||
cmp.w #_TkPrc,(a6)
|
||
beq.s OnEPrc
|
||
cmp.w #_TkGto,(a6)
|
||
bne.s .Skip
|
||
addq.l #2,a6
|
||
cmp.w #_TkEnt,(a6)
|
||
bne.s OnEg1
|
||
move.l 2(a6),d0
|
||
bne.s OnEg1
|
||
addq.l #6,a6
|
||
.Skip rts
|
||
|
||
OnEg1 bsr GetLabel
|
||
beq LbNDef
|
||
move.l d0,OnErrLine(a5)
|
||
rts
|
||
|
||
* ON ERROR PROC
|
||
OnEPrc: addq.l #4,a6
|
||
move.w (a6)+,d0
|
||
move.b (a6),d1
|
||
ext.w d1
|
||
lea 2(a6,d1.w),a6
|
||
move.l LabHaut(a5),a2
|
||
move.l 0(a2,d0.w),OnErrLine(a5)
|
||
bset #7,ErrorChr(a5)
|
||
rts
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InOnErrorGoto
|
||
Lib_Def InOnErrorProc
|
||
; - - - - - - - - - - - - -
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; RESUME LABEL
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InResumeLabel
|
||
InResumeLabel
|
||
; - - - - - - - - - - - - -
|
||
bsr Finie
|
||
beq.s ResL1
|
||
tst.l OnErrLine(a5)
|
||
beq NoOnErr
|
||
tst.w ErrorChr(a5)
|
||
bpl NoOnErr
|
||
bsr GetLabel
|
||
beq LbNDef
|
||
bset #31,d0
|
||
move.l d0,ErrorChr(a5)
|
||
rts
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InResumeLabel1
|
||
; - - - - - - - - - - - - -
|
||
* Resume label proprement dit
|
||
ResL1: bsr Test_Normal
|
||
tst.w ErrorOn(a5)
|
||
beq NoErr
|
||
bsr PopP
|
||
clr.w ErrorOn(a5)
|
||
move.l ErrorChr(a5),d0
|
||
bclr #31,d0
|
||
beq NoOnErr
|
||
tst.l d0
|
||
beq ResLNo
|
||
move.l d0,a6
|
||
bra LGoto
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; RESUME [label]
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InResume
|
||
InResume
|
||
; - - - - - - - - - - - - -
|
||
bsr Test_Normal
|
||
tst.w ErrorOn(a5)
|
||
beq NoErr
|
||
tst.w ErrorChr(a5)
|
||
bmi.s ResP
|
||
bsr Finie
|
||
bne.s ResL
|
||
clr.w ErrorOn(a5)
|
||
move.l ErrorChr(a5),a6
|
||
bra LGoto
|
||
ResL: bsr GetLabel
|
||
beq LbNDef
|
||
clr.w ErrorOn(a5)
|
||
move.l d0,a6
|
||
bra LGoto
|
||
* PROCEDURE ERREUR!
|
||
ResP: bsr Finie * Pas de label!
|
||
bne ResPLab
|
||
bsr PopP * POPpe la procedure
|
||
clr.w ErrorOn(a5)
|
||
bra LGoto
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InResume1
|
||
; - - - - - - - - - - - - -
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; RESUME NEXT
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InResumeNext
|
||
InResumeNext
|
||
; - - - - - - - - - - - - -
|
||
bsr Test_Normal
|
||
tst.w ErrorOn(a5)
|
||
beq NoErr
|
||
tst.w ErrorChr(a5)
|
||
bmi.s ResNP
|
||
clr.w ErrorOn(a5)
|
||
move.l ErrorChr(a5),a0
|
||
ResN1: move.w (a0)+,d0
|
||
bsr TInst
|
||
bne.s ResN2
|
||
tst.w (a0)
|
||
beq.s ResN2
|
||
addq.l #2,a0
|
||
ResN2: tst.w d0
|
||
bsr FinieB
|
||
bne.s ResN1
|
||
move.l a0,a6
|
||
bra LGoto
|
||
* Procedure erreur!
|
||
ResNP: bsr PopP
|
||
move.l a6,a0
|
||
clr.w ErrorOn(a5)
|
||
bra.s ResN1
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; TRAP
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InTrap
|
||
InTrap
|
||
; - - - - - - - - - - - - -
|
||
lea 2(a6),a0
|
||
move.l a0,TrapAdr(a5)
|
||
clr.w TrapErr(a5)
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; =TRAPERR
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par FnErrTrap
|
||
FnErrTrap
|
||
; - - - - - - - - - - - - -
|
||
moveq #0,d3
|
||
move.w TrapErr(a5),d3
|
||
Ret_Int
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; EVERY n PROC GOSUB label
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def InEveryGosub
|
||
Lib_Def InEveryProc
|
||
Lib_Par InEvery
|
||
InEvery
|
||
; - - - - - - - - - - - - -
|
||
; Rlea L_EveJump,0 Pas de routine de branchement!
|
||
; move.l a0,GoTest_Every(a5)
|
||
bclr #BitEvery,ActuMask(a5)
|
||
bsr New_Expentier
|
||
tst.l d3
|
||
beq FonCall
|
||
cmp.l #32767,d3
|
||
bcc FonCall
|
||
move.w d3,EveCharge(a5)
|
||
move.w d3,T_EveCpt(a5)
|
||
move.w (a6)+,EveType(a5)
|
||
bsr GetLabel
|
||
beq LbNDef
|
||
move.l d0,EveLabel(a5)
|
||
bset #BitEvery,ActuMask(a5)
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; EVERY OFF
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InEveryOff
|
||
InEveryOff
|
||
; - - - - - - - - - - - - -
|
||
bclr #BitEvery,ActuMask(a5)
|
||
rts
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; EVERY ON
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InEveryOn
|
||
InEveryOn
|
||
; - - - - - - - - - - - - -
|
||
bset #BitEvery,ActuMask(a5)
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; FOR
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InFor
|
||
InFor
|
||
; - - - - - - - - - - - - -
|
||
move.w (a6)+,d0 Pousse l'adresse du NEXT
|
||
pea 0(a6,d0.w)
|
||
bsr FindVar
|
||
move.w d2,-(sp)
|
||
move.l a0,-(sp)
|
||
bsr Fn_New_Evalue Egalise la variable
|
||
move.w 4(sp),d1
|
||
bsr MMType
|
||
move.l (sp)+,a0
|
||
move.l d3,(a0)
|
||
move.l a0,-(a3)
|
||
bsr Fn_New_Evalue Cherche la limite
|
||
move.w (sp),d1
|
||
bsr MMType
|
||
move.l d3,-(a3)
|
||
moveq #0,d2
|
||
moveq #1,d3
|
||
cmp.w #_TkStp,(a6)
|
||
bne.s For3
|
||
bsr Fn_New_Evalue Cherche la STEP
|
||
For3: move.w (sp)+,d1
|
||
bsr MMType
|
||
move.l d3,-(a3)
|
||
move.w d2,-(a3) Poke le type
|
||
move.l (sp)+,a0
|
||
moveq #TForNxt,d0
|
||
bra Rpt0
|
||
* Egalise le type D3 au type demande (D1)
|
||
MMType: cmp.b d1,d2
|
||
bne.s MMt1
|
||
rts
|
||
MMt1: tst.b d2
|
||
beq.s .Int
|
||
Rjmpt L_FlToInt1
|
||
.Int Rjmpt L_IntToFl1
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; NEXT
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InNext
|
||
InNext
|
||
; - - - - - - - - - - - - -
|
||
tst.b T_Actualise(a5)
|
||
bmi.s TNext
|
||
RNext move.l 20(a3),a2
|
||
tst.b 11(a3)
|
||
bne.s NextF
|
||
move.l 12(a3),d3
|
||
move.l 16(a3),d4
|
||
; TRAVAILLE SUR ENTIERS
|
||
add.l d3,(a2) ;ENTIER
|
||
tst.l d3
|
||
bpl.s next1
|
||
; step negative: inferieur
|
||
cmp.l (a2),d4
|
||
ble.s nextR
|
||
bra.s nextS
|
||
; step positive: superieur
|
||
next1: cmp.l (a2),d4
|
||
blt.s nextS
|
||
; ON RESTE DANS LA BOUCLE!
|
||
nextR: move.l 6(a3),a6
|
||
rts
|
||
; ON SORT DE LA BOUCLE!
|
||
nextS: add.w #TForNxt,a3
|
||
move.l a3,PLoop(a5)
|
||
IFNE Debug
|
||
move.l a3,Chr_Debug(a5)
|
||
ENDC
|
||
cmp.w #_TkVar,(a6) Saute la variable
|
||
bne.s .Skip
|
||
bsr FindVar
|
||
.Skip rts
|
||
; Appel du test
|
||
TNext: bsr Test_Force
|
||
bra.s RNext
|
||
; TRAVAILLE SUR FLOAT simple precision
|
||
NextF: move.l 12(a3),d3
|
||
move.l 16(a3),d4
|
||
move.l a6,-(sp)
|
||
move.l FloatBase(a5),a6
|
||
move.l d3,d1
|
||
jsr SPTst(a6)
|
||
move.l d0,d2
|
||
move.l d3,d0
|
||
move.l (a2),d1
|
||
jsr SPAdd(a6)
|
||
move.l d0,(a2)
|
||
move.l d4,d1
|
||
jsr SPCmp(a6)
|
||
move.l (sp)+,a6
|
||
blt NextF1
|
||
tst.l d2
|
||
bpl.s nextS
|
||
bmi.s nextR
|
||
NextF1 tst.l d2
|
||
bpl.s nextR
|
||
bmi.s nextS
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InNextF
|
||
Lib_Def InNextD
|
||
; - - - - - - - - - - - - -
|
||
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; REPEAT
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InRepeat
|
||
InRepeat
|
||
; - - - - - - - - - - - - -
|
||
move.w (a6)+,d0
|
||
lea 0(a6,d0.w),a0
|
||
moveq #TRptUnt,d0
|
||
Rpt0: tst.w (a6)+
|
||
bne.s Rpt1
|
||
addq.l #2,a6
|
||
Rpt1: move.l a6,-(a3)
|
||
move.l a0,-(a3)
|
||
move.w d0,-(a3)
|
||
cmp.l MinLoop(a5),a3
|
||
bcs OofStack
|
||
move.l a3,PLoop(a5)
|
||
IFNE Debug
|
||
move.l a3,Chr_Debug(a5)
|
||
ENDC
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; UNTIL
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InUntil
|
||
InUntil
|
||
; - - - - - - - - - - - - -
|
||
tst.b T_Actualise(a5)
|
||
bmi.s TUnt
|
||
RUnt bsr New_Expentier
|
||
tst.l d3
|
||
bne.s Unt1
|
||
* On reste dans la boucle
|
||
move.l 6(a3),a6
|
||
rts
|
||
* On sort de la boucle
|
||
Unt1: lea TRptUnt(a3),a3
|
||
move.l a3,PLoop(a5)
|
||
IFNE Debug
|
||
move.l a3,Chr_Debug(a5)
|
||
ENDC
|
||
rts
|
||
TUnt bsr Test_Force
|
||
bra.s RUnt
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; WHILE
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InWhile
|
||
InWhile
|
||
; - - - - - - - - - - - - -
|
||
move.w (a6)+,d0
|
||
move.l a6,-(a3)
|
||
add.w d0,a6
|
||
move.l a6,-(a3)
|
||
move.w #TWhlWnd,-(a3)
|
||
cmp.l MinLoop(a5),a3
|
||
bcs OofStack
|
||
move.l a3,PLoop(a5)
|
||
IFNE Debug
|
||
move.l a3,Chr_Debug(a5)
|
||
ENDC
|
||
bra RWend
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; WEND
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InWend
|
||
InWend
|
||
; - - - - - - - - - - - - -
|
||
tst.b T_Actualise(a5)
|
||
bmi.s TWend
|
||
RWend move.l a6,-(sp)
|
||
move.l 6(a3),a6
|
||
bsr New_Expentier
|
||
tst.l d3
|
||
beq.s Wnd1
|
||
* On reste dans la boucle
|
||
addq.l #4,sp
|
||
rts
|
||
* On sort de la boucle
|
||
Wnd1: move.l (sp)+,a6
|
||
lea TWhlWnd(a3),a3
|
||
move.l a3,PLoop(a5)
|
||
IFNE Debug
|
||
move.l a3,Chr_Debug(a5)
|
||
ENDC
|
||
rts
|
||
TWend bsr Test_Force
|
||
bra.s RWend
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; DO
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InDo
|
||
InDo
|
||
; - - - - - - - - - - - - -
|
||
bra InRepeat
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; LOOP
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InLoop
|
||
InLoop
|
||
; - - - - - - - - - - - - -
|
||
tst.b T_Actualise(a5)
|
||
bmi.s TLoop
|
||
RLoop move.l 6(a3),a6
|
||
rts
|
||
TLoop bsr Test_Force
|
||
bra.s RLoop
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; EXIT
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InExit
|
||
InExit
|
||
; - - - - - - - - - - - - -
|
||
tst.b T_Actualise(a5)
|
||
bmi.s TExit
|
||
RExit move.w (a6)+,d0
|
||
add.w (a6)+,a3
|
||
move.l a3,PLoop(a5)
|
||
IFNE Debug
|
||
move.l a3,Chr_Debug(a5)
|
||
ENDC
|
||
add.w d0,a6
|
||
rts
|
||
TExit: bsr Test_Force
|
||
bra.s RExit
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; EXIT IF
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InExitIf
|
||
InExitIf
|
||
; - - - - - - - - - - - - -
|
||
move.l a6,-(sp)
|
||
addq.l #4,a6
|
||
bsr New_Expentier
|
||
tst.l d3
|
||
beq.s Exi1
|
||
move.l (sp)+,a6
|
||
bra InExit
|
||
Exi1: addq.l #4,sp
|
||
cmp.w #_TkVir,(a6)
|
||
bne.s .Skip
|
||
addq.l #8,a6
|
||
.Skip rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; IF
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InIf
|
||
InIf
|
||
; - - - - - - - - - - - - -
|
||
.Loop move.l a6,-(sp)
|
||
addq.l #2,a6
|
||
bsr New_Expentier
|
||
tst.l d3
|
||
bne.s .IfV
|
||
; Faux: ELSE/ENDIF ou ELSE IF
|
||
move.l (sp)+,a6
|
||
move.w (a6)+,d0
|
||
bclr #0,d0 Bit 0=0 => ELSE / ENDIF
|
||
add.w d0,a6
|
||
beq LGoto ENDIF ou ELSE => fini
|
||
subq.l #2,a6
|
||
bra.s .Loop
|
||
; Vrai
|
||
.IfV addq.l #4,sp
|
||
cmp.w #_TkThen,(a6)
|
||
bne.s .Skip
|
||
addq.l #2,a6
|
||
.Skip rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; ELSE IF
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InElseIf
|
||
InElseIf
|
||
; - - - - - - - - - - - - -
|
||
subq.l #2,a6
|
||
bra InElse
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; ELSE
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InElse
|
||
InElse
|
||
; - - - - - - - - - - - - -
|
||
move.w (a6)+,d0
|
||
bclr #0,d0
|
||
add.w d0,a6
|
||
bne.s InElseIf
|
||
cmp.w #_TkElse,-4(a6)
|
||
beq.s InElseIf
|
||
bra LGoto
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def FnElse
|
||
; - - - - - - - - - - - - -
|
||
move.l #EntNul,d3
|
||
Ret_Int
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; GOSUB
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InGosub
|
||
InGosub
|
||
; - - - - - - - - - - - - -
|
||
tst.b T_Actualise(a5)
|
||
bmi.s TGosub
|
||
RGosub bsr GetLabel
|
||
beq LbNDef
|
||
Gos2: move.l BasA3(a5),-(a3)
|
||
move.l a6,-(a3)
|
||
move.l #"Gosb",-(a3)
|
||
cmp.l MinLoop(a5),a3
|
||
bcs OofStack
|
||
move.l a3,PLoop(a5)
|
||
IFNE Debug
|
||
move.l a3,Chr_Debug(a5)
|
||
ENDC
|
||
move.l a3,BasA3(a5)
|
||
move.l d0,a6
|
||
rts
|
||
TGosub: bsr Test_Force
|
||
bra.s RGosub
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; RETURN
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InReturn
|
||
InReturn
|
||
; - - - - - - - - - - - - -
|
||
tst.b T_Actualise(a5)
|
||
bmi.s TRetN
|
||
RRetN move.l BasA3(a5),a3
|
||
move.l #"Gosb",d0
|
||
cmp.l (a3)+,d0
|
||
bne RetGsb
|
||
move.l (a3)+,a6
|
||
move.l (a3)+,BasA3(a5)
|
||
move.l a3,PLoop(a5)
|
||
IFNE Debug
|
||
move.l a3,Chr_Debug(a5)
|
||
ENDC
|
||
rts
|
||
TRetN bsr Test_Force
|
||
bra.s RRetN
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; POP
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InPop
|
||
InPop
|
||
; - - - - - - - - - - - - -
|
||
tst.b T_Actualise(a5)
|
||
bmi.s TPop
|
||
RPop move.l BasA3(a5),a3 BUG si POP au milieu d'une boucle
|
||
move.l #"Gosb",d0
|
||
cmp.l (a3)+,d0
|
||
bne PopGsb
|
||
addq.l #4,a3
|
||
move.l (a3)+,BasA3(a5)
|
||
move.l a3,PLoop(a5)
|
||
IFNE Debug
|
||
move.l a3,Chr_Debug(a5)
|
||
ENDC
|
||
bra LGoto
|
||
TPop: bsr Test_Force
|
||
bra RPop
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; PASSAGE SUR PROCEDURE
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def DProc1
|
||
Lib_Def DProc2F
|
||
Lib_Def DProc2D
|
||
Lib_Def FProc
|
||
Lib_Def PrgInF
|
||
Lib_Def PrgInD
|
||
; - - - - - - - - - - - - -
|
||
Lib_Par InProcedure
|
||
InProcedure
|
||
; - - - - - - - - - - - - -
|
||
move.l (a6)+,d0
|
||
lea 4(a6,d0.l),a6
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; PROC
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InProc
|
||
InProc
|
||
; - - - - - - - - - - - - -
|
||
addq.w #2,a6
|
||
bra CallProc
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; APPEL PROCEDURE
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def CallProc
|
||
CallProc
|
||
; - - - - - - - - - - - - -
|
||
tst.b T_Actualise(a5)
|
||
bmi TInPro
|
||
RInPro move.w (a6)+,d0
|
||
move.b (a6),d1
|
||
ext.w d1
|
||
lea 2(a6,d1.w),a6
|
||
move.l LabHaut(a5),a2
|
||
move.l 0(a2,d0.w),a2
|
||
clr.w -(sp)
|
||
* Entree pour la routine d'erreur
|
||
InProE clr.l -(sp)
|
||
* Bas de la zone de variables
|
||
InPrOn2 addq.l #6,a2
|
||
* Assez de m<EFBFBD>moire?
|
||
move.l TabBas(a5),a1
|
||
lea -6-4(a1),a0
|
||
sub.w (a2),a0
|
||
cmp.l HiChaine(a5),a0
|
||
bcc.s InP0b
|
||
move.l a1,-(sp)
|
||
moveq #0,d3
|
||
Rbsr L_Menage
|
||
move.l (sp)+,a1
|
||
|
||
; IFNE Debug>1
|
||
; movem.l d0-d7/a0-a6,-(sp)
|
||
; moveq #20,d3
|
||
; JJsrIns L_InBell1,1
|
||
; movem.l (sp)+,d0-d7/a0-a6
|
||
; ENDC
|
||
; IFNE Debug>3
|
||
; Rjsr L_PreBug
|
||
; ENDC
|
||
|
||
* Recule les piles de variables
|
||
InP0b move.l VarLoc(a5),-(a1)
|
||
move.w #$FFFF,-(a1)
|
||
move.l a1,a0
|
||
sub.w (a2)+,a0
|
||
addq.l #2,a2
|
||
move.l a0,-(sp)
|
||
* Nettoie les variables
|
||
move.l a1,d0
|
||
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 move.b 4(a2),d0
|
||
ext.w d0
|
||
lea 6(a2,d0.w),a2
|
||
cmp.w #_TkBra1,(a6)
|
||
bne.s InPx
|
||
* Recupere les variables
|
||
InPa: addq.l #2,a6
|
||
pea 4(a2)
|
||
bsr New_Evalue
|
||
move.l (sp)+,a2
|
||
move.w (a2)+,d0
|
||
bmi InPaGlo
|
||
move.l (sp),a1
|
||
lea 2(a1,d0.w),a1
|
||
InPa0 move.b (a2)+,d0
|
||
ext.w d0
|
||
move.b (a2)+,d1
|
||
add.w d0,a2
|
||
and.w #$0F,d1
|
||
lea Long_Var(a5),a0
|
||
move.b 0(a0,d1.w),-2(a1) Longueur de la variable
|
||
move.b d1,-1(a1) Flag
|
||
cmp.b d1,d2 Des conversions?
|
||
beq.s InPe
|
||
move.l a1,-(sp)
|
||
tst.b d2
|
||
bne.s InPc
|
||
Rjsrt L_IntToFl1
|
||
bra.s InPd
|
||
InPc Rjsrt L_FlToInt1
|
||
InPd move.l (sp)+,a1
|
||
InPe move.l d3,(a1)
|
||
cmp.b #8,-2(a1) Si Float double
|
||
bne.s .Skip
|
||
move.l d4,4(a1) Met la suite
|
||
.Skip cmp.w #_TkVir,(a6)
|
||
beq.s InPa
|
||
addq.l #2,a6
|
||
addq.l #2,a2
|
||
* Descend les limites
|
||
InPx move.l (sp)+,a0
|
||
lea -8(a0),a1
|
||
cmp.l HiChaine(a5),a1
|
||
bcs.s ReFaire
|
||
move.l (sp)+,d0
|
||
beq.s InPx1
|
||
move.l d0,a6
|
||
InPx1 move.l BasA3(a5),-(a3)
|
||
move.l VarLoc(a5),-(a3)
|
||
move.l TabBas(a5),-(a3)
|
||
move.l OnErrLine(a5),-(a3)
|
||
move.l ErrorChr(a5),-(a3)
|
||
move.w ErrorOn(a5),-(a3)
|
||
move.l PData(a5),-(a3)
|
||
move.l AData(a5),-(a3)
|
||
move.l DProc(a5),-(a3)
|
||
move.l a6,-(a3)
|
||
move.l #"Proc",-(a3) * Code anti crash!!!
|
||
cmp.l MinLoop(a5),a3
|
||
bcs OofStack
|
||
move.l a3,PLoop(a5)
|
||
IFNE Debug
|
||
move.l a3,Chr_Debug(a5)
|
||
ENDC
|
||
move.l a3,BasA3(a5)
|
||
move.l a0,VarLoc(a5)
|
||
move.l a0,TabBas(a5)
|
||
clr.l OnErrLine(a5)
|
||
move.l a2,a6
|
||
addq.l #2,a2
|
||
move.l a2,DProc(a5)
|
||
move.l a2,PData(a5)
|
||
clr.l AData(a5)
|
||
* Erreurs
|
||
move.w (sp)+,ErrorOn(a5)
|
||
* Branche a la procedure
|
||
rts
|
||
* Les variables ont ete effacees par les chaines!
|
||
ReFaire move.l TabBas(a5),d3
|
||
lea -16(a0),a0
|
||
sub.l a0,d3
|
||
bra Demande
|
||
* Test entree de procedure
|
||
TInPro bsr Test_Force
|
||
bra RInPro
|
||
* Si variable globale
|
||
InPaGlo move.l VarGlo(a5),a1
|
||
neg.w d0
|
||
lea 1(a1,d0.w),a1
|
||
bra InPa0
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; END PROC
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InEndProc
|
||
InEndProc
|
||
; - - - - - - - - - - - - -
|
||
tst.b T_Actualise(a5)
|
||
bmi.s TEProc
|
||
REProc cmp.w #_TkBra1,(a6)
|
||
bne.s EPro1
|
||
bsr FnEProc
|
||
EPro1: tst.w ErrorOn(a5)
|
||
bne EProErr
|
||
* Protection anti crash!!!
|
||
EPro2 move.l (a3),d0
|
||
addq.l #2,a3
|
||
cmp.l #"Proc",d0
|
||
bne.s EPro2
|
||
addq.l #2,a3
|
||
* Ok!
|
||
move.l (a3)+,d0
|
||
move.l (a3)+,DProc(a5)
|
||
move.l (a3)+,AData(a5)
|
||
move.l (a3)+,PData(a5)
|
||
move.w (a3)+,ErrorOn(a5)
|
||
move.l (a3)+,ErrorChr(a5)
|
||
move.l (a3)+,OnErrLine(a5)
|
||
move.l (a3)+,TabBas(a5)
|
||
move.l (a3)+,VarLoc(a5)
|
||
move.l (a3)+,BasA3(a5)
|
||
move.l a3,PLoop(a5)
|
||
IFNE Debug
|
||
move.l a3,Chr_Debug(a5)
|
||
ENDC
|
||
move.l d0,a6
|
||
tst.l d0
|
||
beq.s .Menu
|
||
rts
|
||
* Retour au MENU!!!
|
||
.Menu move.l MnPile(a5),a0
|
||
lea -4(a0),sp
|
||
rts
|
||
TEProc: bsr Test_Force
|
||
bra.s REProc
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Routine: retourne ENDPROC[x]
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
FnEProc
|
||
; - - - - - - - - - - - - -
|
||
bsr Fn_New_Evalue
|
||
subq.b #1,d2
|
||
bmi.s FnE1
|
||
beq.s FnE2
|
||
move.l d3,ParamC(a5)
|
||
rts
|
||
FnE1: move.l d3,ParamE(a5)
|
||
rts
|
||
FnE2: move.l d3,ParamF(a5)
|
||
tst.b MathFlags(a5)
|
||
bmi.s .Dble
|
||
rts
|
||
.Dble move.l d4,ParamF2(a5)
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; POP PROC
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InPopProc
|
||
InPopProc
|
||
; - - - - - - - - - - - - -
|
||
tst.b T_Actualise(a5)
|
||
bmi.s TPopPro
|
||
RPopPro tst.w ErrorOn(a5)
|
||
bne EProErr
|
||
cmp.w #_TkBra1,(a6)
|
||
bne.s .Skip
|
||
bsr.s FnEProc
|
||
.Skip bsr PopP
|
||
rts
|
||
TPopPro bsr Test_Force
|
||
bra.s RPopPro
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Routine Pop Proc
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def PopP
|
||
PopP
|
||
; - - - - - - - - - - - - -
|
||
move.l BasA3(a5),a3
|
||
* Protection anti crash!!!
|
||
.Loop move.l (a3),d0
|
||
addq.l #2,a3
|
||
cmp.l #"Proc",d0
|
||
bne.s .Loop
|
||
addq.l #2,a3
|
||
* Ok!
|
||
move.l (a3)+,d0
|
||
move.l (a3)+,DProc(a5)
|
||
move.l (a3)+,AData(a5)
|
||
move.l (a3)+,PData(a5)
|
||
move.w (a3)+,ErrorOn(a5)
|
||
move.l (a3)+,ErrorChr(a5)
|
||
move.l (a3)+,OnErrLine(a5)
|
||
move.l (a3)+,TabBas(a5)
|
||
move.l (a3)+,VarLoc(a5)
|
||
tst.l d0
|
||
beq FonCall
|
||
move.l d0,a6
|
||
move.l (a3)+,BasA3(a5)
|
||
move.l a3,PLoop(a5)
|
||
IFNE Debug
|
||
move.l a3,Chr_Debug(a5)
|
||
ENDC
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; GOTO interne: appel direct
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def Goto2
|
||
Goto2
|
||
; - - - - - - - - - - - - -
|
||
move.w (a6),d0
|
||
move.l LabHaut(a5),a0
|
||
move.l 0(a0,d0.w),a6
|
||
bra.s LGoto
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; GOTO
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InGoto
|
||
InGoto
|
||
; - - - - - - - - - - - - -
|
||
tst.b T_Actualise(a5)
|
||
bmi.s TGoto
|
||
RGoto bsr GetLabel
|
||
beq LbNDef
|
||
move.l d0,a6
|
||
; Routine GOTO
|
||
; ~~~~~~~~~~~~~~~~~~
|
||
LGoto move.l BasA3(a5),d0
|
||
.Loop cmp.l d0,a3
|
||
bcc.s .Ret
|
||
cmp.l 6(a3),a6
|
||
bcs.s .Skip
|
||
cmp.l 2(a3),a6
|
||
bls.s .Ret
|
||
.Skip add.w (a3),a3
|
||
bra.s .Loop
|
||
.Ret move.l a3,PLoop(a5)
|
||
IFNE Debug
|
||
move.l a3,Chr_Debug(a5)
|
||
ENDC
|
||
rts
|
||
; Test pour GOTO
|
||
; ~~~~~~~~~~~~~~
|
||
TGoto: bsr Test_Force
|
||
bra.s RGoto
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; ON
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InOn
|
||
InOn
|
||
; - - - - - - - - - - - - -
|
||
tst.b T_Actualise(a5)
|
||
bmi TOn
|
||
ROn move.w (a6)+,d0
|
||
pea 2(a6,d0.w)
|
||
move.w (a6)+,-(sp)
|
||
bsr New_Expentier
|
||
moveq #0,d2
|
||
move.w (sp),d2
|
||
move.w (a6)+,(sp)
|
||
subq.l #1,d3
|
||
bmi.s OnR
|
||
beq.s OnG
|
||
cmp.l d2,d3
|
||
bcc.s OnR
|
||
* Pointe le bon label et fait le saut
|
||
move.w d3,-(sp)
|
||
On1 bsr GetLabel
|
||
* Pour version 2!
|
||
* cmp.w #_TkBra1,(a6)+
|
||
* bne.s On1b
|
||
*On1a cmp.w #_TkBra2,(a6)+
|
||
* bne.s On1a
|
||
* cmp.w #_TkVir,(a6)
|
||
* bne.s On1a
|
||
addq.l #2,a6
|
||
On1b subq.w #1,(sp)
|
||
bne.s On1
|
||
addq.l #2,sp
|
||
OnG: move.w (sp)+,d1
|
||
move.l (sp)+,a0
|
||
cmp.w #_TkGto,d1
|
||
beq InGoto
|
||
cmp.w #_TkPrc,d1
|
||
beq.s ROnP
|
||
move.l BasA3(a5),-(a3) On Gosub
|
||
move.l a0,-(a3)
|
||
move.l #"Gosb",-(a3)
|
||
cmp.l MinLoop(a5),a3
|
||
bcs OofStack
|
||
bsr GetLabel
|
||
beq LbNDef
|
||
move.l d0,a6
|
||
move.l a3,PLoop(a5)
|
||
IFNE Debug
|
||
move.l a3,Chr_Debug(a5)
|
||
ENDC
|
||
move.l a3,BasA3(a5)
|
||
rts
|
||
* Appel d'une procedure
|
||
ROnP clr.w -(sp) * Flag
|
||
move.l a0,-(sp) * Adresse de retour
|
||
bsr GetLabel
|
||
move.l d0,a2 * Adresse procedure
|
||
bra InPrOn2
|
||
* Passe a l'instruction suivante
|
||
OnR: addq.l #2,sp
|
||
move.l (sp)+,a6
|
||
rts
|
||
; Test pour ON
|
||
; ~~~~~~~~~~~~
|
||
TOn bsr Test_Force
|
||
bra ROn
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; GETLABEL
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def GetLabelE
|
||
Lib_Def GetLabelA
|
||
Lib_Def GetLabel
|
||
GetLabel
|
||
; - - - - - - - - - - - - -
|
||
move.w (a6)+,d0
|
||
cmp.w #_TkPro,d0
|
||
beq.s GLb0
|
||
cmp.w #_TkLGo,d0
|
||
bne.s GLb1
|
||
* Un label NORMAL!!!
|
||
GLb0 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
|
||
* Une expression
|
||
GLb1 subq.l #2,a6
|
||
bsr New_Evalue
|
||
subq.b #1,d2
|
||
bmi.s GLb2
|
||
bne.s GLb3
|
||
Rjsrt L_FlToInt1
|
||
* Ecrit le chiffre dans le buffer!
|
||
GLb2 move.l BufLabel(a5),a1
|
||
move.l a1,a0
|
||
move.l d3,d0
|
||
Rjsr L_LongToDec
|
||
move.l a0,d2
|
||
sub.l a1,d2
|
||
beq.s GLabE
|
||
move.l a1,d3
|
||
bra.s GLab
|
||
* Chaine alphanumerique
|
||
GLb3 move.l d3,a2
|
||
move.w (a2)+,d2
|
||
beq.s GLabE
|
||
cmp.w #32,d2
|
||
bcc.s GLabE
|
||
move.w d2,d1
|
||
subq.w #1,d1
|
||
move.l BufLabel(a5),a0
|
||
move.l a0,d3
|
||
GLab0 move.b (a2)+,d0
|
||
cmp.b #"A",d0
|
||
bcs.s GLab1
|
||
cmp.b #"Z",d0
|
||
bhi.s GLab1
|
||
add.b #32,d0
|
||
GLab1 move.b d0,(a0)+
|
||
dbra d1,GLab0
|
||
* Rend pair
|
||
GLab btst #0,d2
|
||
beq.s GLab2
|
||
clr.b (a0)+
|
||
addq.w #1,d2
|
||
* Trouve le label
|
||
GLab2 move.l LabBas(a5),a1
|
||
GLab3 move.l a1,a0
|
||
move.b (a0),d1
|
||
beq.s GLabE
|
||
ext.w d1
|
||
cmp.w d2,d1
|
||
bne.s GLabN
|
||
move.l d3,a2
|
||
addq.l #8,a0
|
||
move.w d1,d0
|
||
subq.w #1,d0
|
||
GLab4 cmp.b (a0)+,(a2)+
|
||
bne.s GLabN
|
||
dbra d0,GLab4
|
||
* Label trouve!
|
||
GLabT move.l 4(a1),d0
|
||
rts
|
||
* Label suivant
|
||
GLabN lea 8(a1,d1.w),a1
|
||
bra.s GLab3
|
||
* Label pas trouve!
|
||
GLabE moveq #0,d0
|
||
rts
|
||
* Erreur!
|
||
LbNDef: moveq #40,d0
|
||
bra RunErr
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Instruction finie?
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def Finie
|
||
Finie
|
||
; - - - - - - - - - - - - -
|
||
move.w (a6),d0
|
||
FinieB beq.s .Skip
|
||
cmp.w #_TkDP,d0
|
||
beq.s .Skip
|
||
cmp.w #_TkThen,d0
|
||
beq.s .Skip
|
||
cmp.w #_TkElse,d0
|
||
.Skip rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; RAMENE LA TAILLE DE L'INSTRUCTION D0 en D1
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def TInst
|
||
TInst
|
||
; - - - - - - - - - - - - -
|
||
tst.w d0
|
||
beq TFin
|
||
cmp.w #_TkLGo,d0
|
||
bls TVar
|
||
cmp.w #_TkCh1,d0
|
||
beq TCh
|
||
cmp.w #_TkCh2,d0
|
||
beq TCh
|
||
cmp.w #_TkRem1,d0
|
||
beq TCh
|
||
cmp.w #_TkRem2,d0
|
||
beq TCh
|
||
cmp.w #_TkDFl,d0
|
||
beq.s T8
|
||
cmp.w #_TkFl,d0
|
||
bls.s T4
|
||
cmp.w #_TkExt,d0
|
||
beq.s T4
|
||
cmp.w #_TkFor,d0
|
||
beq.s T2
|
||
cmp.w #_TkRpt,d0
|
||
beq.s T2
|
||
cmp.w #_TkWhl,d0
|
||
beq.s T2
|
||
cmp.w #_TkDo,d0
|
||
beq.s T2
|
||
cmp.w #_TkExit,d0
|
||
beq.s T4
|
||
cmp.w #_TkExIf,d0
|
||
beq.s T4
|
||
cmp.w #_TkIf,d0
|
||
beq.s T2
|
||
cmp.w #_TkElse,d0
|
||
beq.s T2
|
||
cmp.w #_TkElsI,d0
|
||
beq.s T2
|
||
cmp.w #_TkData,d0
|
||
beq.s T2
|
||
cmp.w #_TkProc,d0
|
||
beq.s T8
|
||
cmp.w #_TkOn,d0
|
||
beq.s T4
|
||
cmp.w #_TkEqu,d0
|
||
bcs.s T0
|
||
cmp.w #_TkStruS,d0
|
||
bls.s T6
|
||
T0: moveq #1,d1
|
||
TFin: rts
|
||
T2: addq.l #2,a0
|
||
bra.s T0
|
||
T4: addq.l #4,a0
|
||
bra.s T0
|
||
T8: addq.l #8,a0
|
||
bra.s T0
|
||
T6: addq.l #6,a0
|
||
bra.s T0
|
||
TCh: add.w (a0)+,a0
|
||
move.w a0,d1
|
||
btst #0,d1
|
||
beq.s T0
|
||
addq.l #1,a0
|
||
bra.s T0
|
||
TVar: moveq #0,d1
|
||
move.b 2(a0),d1
|
||
lea 4(a0,d1.w),a0
|
||
bra.s T0
|
||
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Source: Evalue.s
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; EVALUATION D'EXPRESSION
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Operateur nul (:)
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def L_OpeNul
|
||
; - - - - - - - - - - - - -
|
||
move.l #EntNul,d3
|
||
Ret_Int
|
||
; Table des operateurs
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
Tk_Operateurs
|
||
bra Op_Xor
|
||
dc.b " xor"," "+$80,"O00",-1
|
||
bra Op_Or
|
||
dc.b " or"," "+$80,"O00",-1
|
||
bra Op_And
|
||
dc.b " and"," "+$80,"O00",-1
|
||
bra Op_Diff
|
||
dc.b "<",">"+$80,"O20",-1
|
||
bra Op_Diff
|
||
dc.b ">","<"+$80,"O20",-1
|
||
bra Op_InfEg
|
||
dc.b "<","="+$80,"O20",-1
|
||
bra Op_InfEg
|
||
dc.b "=","<"+$80,"O20",-1
|
||
bra Op_SupEg
|
||
dc.b ">","="+$80,"O20",-1
|
||
bra Op_SupEg
|
||
dc.b "=",">"+$80,"O20",-1
|
||
TOpEg bra Op_Egal
|
||
dc.b "="+$80,"O20",-1
|
||
bra Op_Inf
|
||
dc.b "<"+$80,"O20",-1
|
||
bra Op_Sup
|
||
dc.b ">"+$80,"O20",-1
|
||
bra Op_Plus
|
||
dc.b "+"+$80,"O22",-1
|
||
TOpM bra Op_Moins
|
||
dc.b "-"+$80,"O22",-1
|
||
bra Op_Modulo
|
||
dc.b " mod"," "+$80,"O00",-1
|
||
bra Op_Mult
|
||
dc.b "*"+$80,"O00",-1
|
||
bra Op_Div
|
||
dc.b "/"+$80,"O00",-1
|
||
TOpPuis bra Op_Puis
|
||
dc.b "^"+$80,"O00",-1
|
||
even
|
||
OP_Jumps
|
||
dc.l 0
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Entree evaluation
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par Fn_New_Evalue
|
||
Fn_New_Evalue
|
||
; - - - - - - - - - - - - -
|
||
addq.l #2,a6
|
||
|
||
; Debut de parenthese
|
||
; ~~~~~~~~~~~~~~~~~~~
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Entree de l'evaluation
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def New_Evalue
|
||
New_Evalue
|
||
; - - - - - - - - - - - - -
|
||
|
||
IFNE Debug>1
|
||
move.l VarBufL(a5),d0 Debuggage
|
||
cmp.l #1024*1,d0
|
||
bne.s .NoBug
|
||
Rjsr L_PreBug
|
||
.NoBug
|
||
ENDC
|
||
|
||
move.w #$7FFF,d0
|
||
bra.s Eva1
|
||
Eva0 movem.l d2/d3/d4,-(a3)
|
||
Eva1 move.w d0,-(a3)
|
||
; Recolte d'un operande
|
||
; ~~~~~~~~~~~~~~~~~~~~~
|
||
clr.w -(sp)
|
||
OpeRe move.w (a6)+,d0
|
||
bmi.s OpeM
|
||
move.w 0(a4,d0.w),d1
|
||
move.l -LB_Size-4(a4,d1.w),a0
|
||
jsr (a0)
|
||
tst.w (sp)+
|
||
bne.s Chs0
|
||
; Nouvel operateur
|
||
; ~~~~~~~~~~~~~~~~
|
||
OP_Ret move.w (a6)+,d0
|
||
cmp.w (a3),d0
|
||
bhi.s Eva0
|
||
subq.l #2,a6
|
||
move.w (a3)+,d1
|
||
bpl.s Eva3
|
||
jmp OP_Jumps(pc,d1.w)
|
||
Eva3 cmp.w #_TkPar2,d0
|
||
beq.s Eva4
|
||
rts
|
||
Eva4 move.w (a6)+,d0
|
||
rts
|
||
; Changement de signe avant l'operande
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
Chs0 tst.b d2
|
||
bne.s Chs1
|
||
neg.l d3
|
||
bra.s OP_Ret
|
||
Chs1 tst.b MathFlags(a5)
|
||
bmi.s Dble
|
||
bchg #7,d3
|
||
bra.s OP_Ret
|
||
Dble bchg #31,d3
|
||
bra.s OP_Ret
|
||
; Signe moins devant
|
||
; ~~~~~~~~~~~~~~~~~~
|
||
OpeM addq.w #1,(sp)
|
||
bra OpeRe
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; OPERATEUR PLUS
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Op_Plus
|
||
; - - - - - - - - - - - - -
|
||
bsr Compat
|
||
bmi.s plus1
|
||
bne.s plus2
|
||
; Plus float!
|
||
moveq #_LVOSPAdd,d2
|
||
Rjsrt L_Float_Operation
|
||
lea 12(a3),a3
|
||
bra OP_Ret
|
||
; Addition entiere
|
||
plus1: add.l 4(a3),d3
|
||
bvs OverFlow
|
||
lea 12(a3),a3
|
||
bra OP_Ret
|
||
; Addition de chaines
|
||
plus2: move.l d3,a2
|
||
move.l d3,-(sp)
|
||
clr.l d3
|
||
move (a2),d3 ;taille de la deuxieme chaine
|
||
beq.s plus11 ;deuxieme chaine nulle
|
||
move.l 4(a3),a2
|
||
clr.l d0
|
||
move (a2),d0
|
||
beq.s plus10 ;premiere chaine nulle
|
||
add.l d0,d3
|
||
cmp.l #String_Max,d3
|
||
bcc StooLong ;string too long!
|
||
bsr Demande
|
||
move d3,(a0)+ ;poke la taille resultante
|
||
move (a2)+,d0
|
||
beq.s plus4
|
||
subq #1,d0
|
||
plus3: move.b (a2)+,(a0)+ ;recopie de la premiere chaine
|
||
dbra d0,plus3
|
||
plus4: move.l (sp)+,a2
|
||
move (a2)+,d0
|
||
beq.s plus6
|
||
subq #1,d0
|
||
plus5: move.b (a2)+,(a0)+
|
||
dbra d0,plus5
|
||
plus6: move a0,d0 ;rend pair
|
||
btst #0,d0
|
||
beq.s plus7
|
||
addq.l #1,a0
|
||
plus7: move.l a0,HiChaine(a5)
|
||
move.l a1,d3
|
||
lea 12(a3),a3
|
||
bra OP_Ret
|
||
plus10: move.l (sp)+,d3 ;premiere chaine nulle: ramene la deuxieme
|
||
lea 12(a3),a3
|
||
bra OP_Ret
|
||
plus11: addq.l #4,sp ;deuxieme chaine nulle: ramene la premiere
|
||
move.l 4(a3),d3
|
||
lea 12(a3),a3
|
||
bra OP_Ret
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; OPERATEUR MOINS
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Op_Moins
|
||
; - - - - - - - - - - - - -
|
||
bsr Compat
|
||
bmi.s ms1
|
||
bne.s ms2
|
||
; Moins float
|
||
moveq #_LVOSPSub,d2
|
||
Rjsrt L_Float_Operation
|
||
lea 12(a3),a3
|
||
bra OP_Ret
|
||
; Moins entier
|
||
ms1: move.l 4(a3),d0
|
||
sub.l d3,d0 ;soustraction entiere
|
||
bvs OverFlow
|
||
move.l d0,d3
|
||
lea 12(a3),a3
|
||
bra OP_Ret
|
||
; Soustraction de chaines EXCLUSIF!!!
|
||
ms2: move.l d5,-(sp)
|
||
move.l d3,d4 ;sauve pour plus tard
|
||
move.l 4(a3),a2
|
||
clr.l d3
|
||
move.w (a2)+,d3
|
||
move.l d3,d1
|
||
bsr Demande ;prend la place une fois pour toute!
|
||
move.w d3,(a0)+
|
||
beq.s ms4
|
||
addq #1,d3
|
||
lsr #1,d3
|
||
subq #1,d3
|
||
ms3: move.w (a2)+,(a0)+ ;recopie la chaine
|
||
dbra d3,ms3
|
||
ms4: move.l a0,HiChaine(a5)
|
||
addq.l #2,a1 ;chaine dont auquelle on soustrait en a1/d1
|
||
move.l d4,a2
|
||
clr.l d2
|
||
move (a2)+,d2 ;chaine a soustraire en a2/d2
|
||
|
||
ms5: clr.l d4
|
||
movem.l d1-d2/a1-a3,-(sp)
|
||
Rjsr L_InstrFind
|
||
movem.l (sp)+,d1-d2/a1-a3
|
||
tst.l d3
|
||
beq.s ms9
|
||
move.l a1,a0
|
||
move.l a1,d4 ;pour plus tard!
|
||
subq.l #1,d3
|
||
move.l d3,d5 ;taille du debut a garder
|
||
add.l d3,a1 ;pointe ou transferer la fin
|
||
add.l d2,d3
|
||
add.l d3,a0 ;pointe la fin a recopier
|
||
sub.l d3,d1
|
||
add.l d1,d5 ;taille finale en memoire
|
||
subq.l #1,d1
|
||
bmi.s ms7
|
||
ms6: move.b (a0)+,(a1)+
|
||
dbra d1,ms6
|
||
ms7: move a0,d0 ;rend pair
|
||
btst #0,d0
|
||
beq.s ms8
|
||
addq.l #1,a0
|
||
ms8: move.l a0,HiChaine(a5)
|
||
move.l d4,a1
|
||
move.w d5,-2(a1)
|
||
move.l d5,d1
|
||
bra.s ms5
|
||
ms9: moveq #2,d2
|
||
move.l a1,d3
|
||
subq.l #2,d3
|
||
move.l (sp)+,d5
|
||
lea 12(a3),a3
|
||
bra OP_Ret
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; OPERATEUR ETOILE
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Op_Mult
|
||
; - - - - - - - - - - - - -
|
||
bsr Compat
|
||
bmi.s milt1
|
||
; Multiplie float
|
||
moveq #_LVOSPMul,d2
|
||
Rjsrt L_Float_Operation
|
||
lea 12(a3),a3
|
||
bra OP_Ret
|
||
; Entier!
|
||
milt1: move.l 4(a3),d2
|
||
clr d4 ;multiplication signee 32*32 bits
|
||
tst.l d3 ;aabb*ccdd
|
||
bpl.s mlt1
|
||
neg.l d3
|
||
not d4
|
||
mlt1: tst.l d2 ;tests des signes
|
||
bpl.s mlt2
|
||
neg.l d2
|
||
not d4
|
||
* Peut on faire une mult rapide?
|
||
mlt2: cmp.l #$00010000,d3
|
||
bcc.s mlt0
|
||
cmp.l #$00010000,d2
|
||
bcc.s mlt0
|
||
mulu d2,d3 ;quand on le peut: multiplication directe!
|
||
tst.w d4
|
||
beq.s mltF
|
||
neg.l d3
|
||
bra.s mltF
|
||
* Multipcation lente
|
||
mlt0: move d2,d1
|
||
mulu d3,d1
|
||
bmi OverFlow
|
||
swap d2
|
||
move d2,d0
|
||
mulu d3,d0
|
||
swap d0
|
||
bmi OverFlow
|
||
tst d0
|
||
bne OverFlow
|
||
add.l d0,d1
|
||
bvs OverFlow
|
||
swap d3
|
||
move d2,d0
|
||
mulu d3,d0
|
||
bne OverFlow
|
||
swap d2
|
||
move d2,d0
|
||
mulu d3,d0
|
||
swap d0
|
||
bmi OverFlow
|
||
tst d0
|
||
bne OverFlow
|
||
add.l d0,d1
|
||
bvs OverFlow
|
||
tst d4 ;signe du resultat
|
||
beq.s mlt3
|
||
neg.l d1
|
||
mlt3: move.l d1,d3
|
||
mltF: moveq #0,d2
|
||
lea 12(a3),a3
|
||
bra OP_Ret
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; OPERATEUR DIVISE
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Op_Div
|
||
; - - - - - - - - - - - - -
|
||
bsr Compat
|
||
bmi.s div1
|
||
; Divise float
|
||
Rjsrt L_Float_Test
|
||
beq DByZero
|
||
move.w #_LVOSPDiv,d2
|
||
Rjsrt L_Float_Operation
|
||
lea 12(a3),a3
|
||
bra OP_Ret
|
||
; Divise entier
|
||
div1: move.l 4(a3),d2
|
||
moveq #0,d4
|
||
tst.l d2
|
||
bpl.s dva
|
||
bset #31,d4
|
||
neg.l d2
|
||
dva: tst.l d3
|
||
beq DByZero ;division par zero!
|
||
bpl.s dvb
|
||
bchg #31,d4
|
||
neg.l d3
|
||
dvb: cmp.l #$10000,d3 ;Division rapide ou non?
|
||
bcc.s dv0
|
||
move.l d2,d0
|
||
divu d3,d0 ;division rapide: 16/16 bits
|
||
bvs.s dv0
|
||
moveq #0,d3
|
||
move.w d0,d3
|
||
bra.s dvc
|
||
dv0: move.w #31,d4 ;division lente: 32/32 bits
|
||
moveq #-1,d5
|
||
clr.l d1
|
||
dv2: lsl.l #1,d2
|
||
roxl.l #1,d1
|
||
cmp.l d3,d1
|
||
bcs.s dv1
|
||
sub.l d3,d1
|
||
lsr.l #1,d5 ;met X a un!
|
||
dv1: roxl.l #1,d0
|
||
dbra d4,dv2
|
||
move.l d0,d3
|
||
dvc: tst.l d4
|
||
bpl.s dvd
|
||
neg.l d3
|
||
dvd: moveq #0,d2
|
||
lea 12(a3),a3
|
||
bra OP_Ret
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; OPERATEUR PUISSANCE
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Op_Puis
|
||
; - - - - - - - - - - - - -
|
||
bsr QueFloat ;que des float
|
||
move.w #_LVOSPPow,d2
|
||
Rjsrt L_Math_Operation Fait une operation math
|
||
lea 12(a3),a3
|
||
bra OP_Ret
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; OPERATEUR MODULO
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Op_Modulo
|
||
bsr QuEntier ;Que des entiers!
|
||
move.l d6,-(sp)
|
||
move.l 4(a3),d6
|
||
tst.l d3
|
||
bpl.s mdv3
|
||
neg.l d3
|
||
mdv3: moveq #31,d2 ;division lente: 32/32 bits
|
||
moveq #-1,d4
|
||
clr.l d1
|
||
mdv2: lsl.l #1,d6
|
||
roxl.l #1,d1
|
||
cmp.l d3,d1
|
||
bcs.s mdv1
|
||
sub.l d3,d1
|
||
lsr #1,d4 ;met X a un!
|
||
mdv1: roxl.l #1,d0
|
||
dbra d2,mdv2
|
||
move.l d1,d3 ;prend le reste!
|
||
moveq #0,d2
|
||
move.l (sp)+,d6
|
||
lea 12(a3),a3
|
||
bra OP_Ret
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; OPERATEUR EGAL
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Op_Egal
|
||
; - - - - - - - - - - - - - - - -
|
||
bsr Compat
|
||
egbis bmi.s eg1 ;entree pour find
|
||
bne.s eg2
|
||
Rjsrt L_Float_Compare
|
||
bne.s Faux
|
||
bra.s Vrai
|
||
eg1: cmp.l 4(a3),d3
|
||
beq.s Vrai
|
||
Faux: moveq #0,d3
|
||
moveq #0,d2
|
||
lea 12(a3),a3
|
||
bra OP_Ret
|
||
Vrai: moveq #-1,d3
|
||
moveq #0,d2
|
||
lea 12(a3),a3
|
||
bra OP_Ret
|
||
eg2: bsr compch
|
||
cmp.l d4,d3
|
||
beq.s Vrai
|
||
bra.s Faux
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; OPERATEUR INFERIEUR
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Op_Inf
|
||
; - - - - - - - - - - - - - - - -
|
||
bsr Compat
|
||
bmi.s inf1
|
||
bne.s inf2
|
||
Rjsrt L_Float_Compare
|
||
blt Vrai
|
||
bra Faux
|
||
inf1: cmp.l 4(a3),d3
|
||
bgt.s Vrai
|
||
bra.s Faux
|
||
inf2: bsr compch
|
||
cmp.l d4,d3
|
||
bgt.s Vrai
|
||
bra.s Faux
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; OPERATEUR INFERIEUR OU EGAL
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Op_InfEg
|
||
; - - - - - - - - - - - - - - - -
|
||
bsr Compat
|
||
bmi.s infeg1
|
||
bne.s infeg2
|
||
Rjsrt L_Float_Compare
|
||
ble Vrai
|
||
bra Faux
|
||
infeg1: cmp.l 4(a3),d3
|
||
bge Vrai
|
||
bra Faux
|
||
infeg2: bsr compch
|
||
cmp.l d4,d3
|
||
bge Vrai
|
||
bra Faux
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; OPERATEUR DIFFERENT
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Op_Diff
|
||
; - - - - - - - - - - - - - - - -
|
||
bsr Compat
|
||
bmi.s dif1
|
||
bne.s dif2
|
||
Rjsrt L_Float_Compare
|
||
bne Vrai
|
||
bra Faux
|
||
dif1: cmp.l 4(a3),d3
|
||
bne Vrai
|
||
bra Faux
|
||
dif2: bsr compch
|
||
cmp.l d4,d3
|
||
bne Vrai
|
||
bra Faux
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; OPERATEUR SUPERIEUR
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Op_Sup
|
||
; - - - - - - - - - - - - - - - -
|
||
bsr Compat
|
||
bmi.s sup1
|
||
bne.s sup2
|
||
Rjsrt L_Float_Compare
|
||
bgt Vrai
|
||
bra Faux
|
||
sup1: cmp.l 4(a3),d3
|
||
blt Vrai
|
||
bra Faux
|
||
sup2: bsr compch
|
||
cmp.l d4,d3
|
||
blt Vrai
|
||
bra Faux
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; OPERATEUR SUPERIEUR OU EGAL
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Op_SupEg
|
||
; - - - - - - - - - - - - - - - -
|
||
bsr Compat
|
||
bmi.s supeg1
|
||
bne.s supeg2
|
||
Rjsrt L_Float_Compare
|
||
bge Vrai
|
||
bra Faux
|
||
supeg1: cmp.l 4(a3),d3
|
||
ble Vrai
|
||
bra Faux
|
||
supeg2: bsr compch
|
||
cmp.l d4,d3
|
||
ble Vrai
|
||
bra Faux
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; OPERATEUR AND
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Op_And
|
||
; - - - - - - - - - - - - - - - -
|
||
bsr QuEntier
|
||
and.l 4(a3),d3
|
||
lea 12(a3),a3
|
||
bra OP_Ret
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; OPERATEUR OR
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Op_Or
|
||
; - - - - - - - - - - - - - - - -
|
||
bsr QuEntier
|
||
or.l 4(a3),d3
|
||
lea 12(a3),a3
|
||
bra OP_Ret
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; OPERATEUR XOR
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Op_Xor
|
||
; - - - - - - - - - - - - - - - -
|
||
bsr QuEntier
|
||
move.l 4(a3),d0
|
||
eor.l d0,d3
|
||
lea 12(a3),a3
|
||
bra OP_Ret
|
||
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; ROUTINES INTERNES
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
|
||
; Que des floats
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
QueFloat
|
||
tst.b d2
|
||
bne.s Compat
|
||
Rjsrt L_IntToFl1
|
||
; Rend compatible les deux operandes
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
Compat: move.b 3(a3),d1
|
||
cmp.b d1,d2
|
||
bne.s Cpt1
|
||
subq.b #1,d1
|
||
rts
|
||
Cpt1 tst.b d2
|
||
bne.s Cpt2
|
||
Rjsrt L_IntToFl1 Change D2/D3/D4 en float
|
||
moveq #0,d1
|
||
rts
|
||
Cpt2 Rjsrt L_IntToFl2 Change (a3) en float
|
||
moveq #0,d1
|
||
rts
|
||
; Que des entiers
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
QuEntier
|
||
tst.b d2
|
||
beq.s .Quent1
|
||
Rjsrt L_FlToInt1 Change d2-d4 en entier
|
||
.Quent1 tst.b 3(a3)
|
||
bne.s .Cpt3
|
||
rts
|
||
.Cpt3 Rjmpt L_FlToInt2 Change (a3) en entier
|
||
|
||
; COMPARAISON DE DEUX CHAINES
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
compch: move.l 4(a3),a0
|
||
move.l d3,a1
|
||
moveq #0,d3
|
||
moveq #0,d4
|
||
clr.b d2
|
||
move.w (a0)+,d0
|
||
move.w (a1)+,d1
|
||
beq.s cpch8
|
||
tst d0
|
||
beq.s cpch7
|
||
cpch1: cmpm.b (a0)+,(a1)+
|
||
bne.s cpch6
|
||
subq #1,d0
|
||
beq.s cpch3
|
||
subq #1,d1
|
||
bne.s cpch1
|
||
; on estrrive au bout d'une des chaines
|
||
cpch2: moveq #1,d4 ;A$>B$
|
||
rts
|
||
cpch3: subq #1,d1 ;egalite!
|
||
beq.s cpch5
|
||
cpch4: moveq #1,d3 ;B$>A$
|
||
cpch5: rts
|
||
; on estas arrive au bout des chaines
|
||
cpch6: bcc.s cpch4
|
||
bcs.s cpch2
|
||
; a$ estulle
|
||
cpch7: tst d1
|
||
beq.s cpch5 ;deux chaines nulles
|
||
bne.s cpch4 ;B$>A$
|
||
; b$ estulle
|
||
cpch8: tst d0
|
||
beq.s cpch5 ;deux chaines nulles
|
||
bne.s cpch2 ;A$>B$
|
||
|
||
; Saute D0 params
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
Saut_D0Param
|
||
subq.l #2,a6
|
||
Fn_Saut_D0Param
|
||
move.w d0,-(sp)
|
||
.Loop bsr Fn_New_Evalue
|
||
subq.w #1,(sp)
|
||
bne.s .Loop
|
||
addq.l #2,sp
|
||
rts
|
||
; Recupere D0 params
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
ParD0 subq.l #2,a6
|
||
FnParD0 move.w d0,-(sp)
|
||
.Loop bsr Fn_New_Evalue
|
||
cmp.b #1,d2
|
||
bne.s .Skip
|
||
Rjsrt L_FlToInt1
|
||
.Skip move.l d3,-(a3)
|
||
subq.w #1,(sp)
|
||
bne.s .Loop
|
||
addq.l #2,sp
|
||
rts
|
||
|
||
; Expentier: retourne un parametre entier / chaine
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
Fn_New_Expentier
|
||
addq.l #2,a6
|
||
New_Expentier
|
||
bsr New_Evalue
|
||
cmp.b #1,d2
|
||
beq.s .Skip
|
||
rts
|
||
.Skip Rjmpt L_FlToInt1
|
||
|
||
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Instruction vide
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def InNull
|
||
; - - - - - - - - - - - - -
|
||
rts
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; OPERATEUR NULL
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par FnNull
|
||
; - - - - - - - - - - - - -
|
||
move.l #EntNul,d3
|
||
subq.l #2,a6
|
||
Ret_Int
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; VARIABLE EN INSTRUCTION
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InVar
|
||
; - - - - - - - - - - - - -
|
||
move.w (a6)+,d0
|
||
bmi.s .Glo
|
||
move.l VarLoc(a5),a0
|
||
lea 2(a0,d0.w),a0
|
||
.Glo2 moveq #0,d1
|
||
move.b (a6)+,d1
|
||
move.b (a6)+,d2
|
||
add.w d1,a6
|
||
btst #6,d2 * Si tableau, pointe l'interieur
|
||
bne.s InVarT
|
||
move.l a0,-(sp)
|
||
move.w d2,-(sp)
|
||
bsr Fn_New_Evalue * Va evaluer
|
||
move.w (sp)+,d5
|
||
cmp.b d5,d2 ??? Possible probleme si autres flags?
|
||
beq.s .Skip2
|
||
tst.b d2
|
||
bne.s .Skip1
|
||
Rjsrt L_IntToFl1
|
||
bra.s .Skip2
|
||
.Skip1 Rjsrt L_FlToInt1
|
||
.Skip2 move.l (sp)+,a0
|
||
cmp.b #1,d2
|
||
beq.s .Flt
|
||
.Ent move.b #4,-2(a0) La longueur
|
||
move.b d5,-1(a0) Le flag
|
||
move.l d3,(a0) La valeur
|
||
rts
|
||
; Si variable globale
|
||
.Glo move.l VarGlo(a5),a0
|
||
neg.w d0
|
||
lea 1(a0,d0.w),a0
|
||
bra.s .Glo2
|
||
; Si float
|
||
; ~~~~~~~~
|
||
.Flt tst.b MathFlags(a5)
|
||
bpl.s .Ent
|
||
move.b #8,-2(a0)
|
||
move.b d5,-1(a0)
|
||
move.l d3,(a0)
|
||
move.l d4,4(a0)
|
||
rts
|
||
; Un tableau: ne poke pas les flags
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
InVarT bsr GetTablo
|
||
and.w #$000F,d2
|
||
move.l a0,-(sp)
|
||
move.w d2,-(sp)
|
||
bsr Fn_New_Evalue * Va evaluer
|
||
move.w (sp)+,d1
|
||
cmp.b d1,d2
|
||
beq.s .Skip2
|
||
tst.b d2
|
||
bne.s .Skip1
|
||
Rjsrt L_IntToFl1
|
||
bra.s .Skip2
|
||
.Skip1 Rjsrt L_FlToInt1
|
||
.Skip2 move.l (sp)+,a0
|
||
cmp.b #1,d2
|
||
beq.s .Flt
|
||
.Ent move.l d3,(a0)
|
||
rts
|
||
.Flt tst.b MathFlags(a5)
|
||
bpl.s .Ent
|
||
move.l d3,(a0)
|
||
move.l d4,4(a0)
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; VARIABLE EN FONCTION
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par FnVar
|
||
; - - - - - - - - - - - - -
|
||
move.w (a6)+,d0
|
||
bmi.s .Glo
|
||
move.l VarLoc(a5),a0
|
||
lea 2(a0,d0.w),a0
|
||
.Glo2 moveq #0,d1
|
||
move.b (a6)+,d1
|
||
move.b (a6)+,d2
|
||
add.w d1,a6
|
||
btst #6,d2
|
||
beq.s .FnV1 * Tableau
|
||
bsr GetTablo
|
||
.FnV1 and.w #$F,d2
|
||
beq.s .Ent
|
||
cmp.b #2,d2
|
||
beq.s .Str
|
||
; Float : simple ou double?
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
tst.b MathFlags(a5)
|
||
bpl.s .Ent
|
||
move.l (a0)+,d3
|
||
move.l (a0),d4
|
||
rts
|
||
; Si variable globale
|
||
; ~~~~~~~~~~~~~~~~~~~
|
||
.Glo move.l VarGlo(a5),a0
|
||
neg.w d0
|
||
lea 1(a0,d0.w),a0
|
||
bra.s .Glo2
|
||
; Ramene la valeur ENTIERE / FLOAT simple
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
.Ent move.l (a0),d3
|
||
rts
|
||
; Ramene la valeur CHAINE
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~
|
||
.Str move.l (a0),d3
|
||
beq.s .Vide
|
||
rts
|
||
.Vide move.l ChVide(a5),d3 Initialise la variable
|
||
move.w #$0402,-2(a0) Le flag
|
||
move.l d3,(a0) La variable
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Trouve l'adresse d'une variable > A0
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
FindVar
|
||
; - - - - - - - - - - - - -
|
||
addq.l #2,a6
|
||
move.w (a6)+,d0
|
||
bmi.s .Glo
|
||
move.l VarLoc(a5),a0
|
||
lea 2(a0,d0.w),a0
|
||
.Glo2 moveq #0,d1
|
||
move.b (a6)+,d1
|
||
move.b (a6)+,d2
|
||
add.w d1,a6
|
||
btst #6,d2
|
||
beq.s .FdV0
|
||
bsr GetTablo Tableau: pas de flag
|
||
and.w #$0F,d2 Isole le flag
|
||
cmp.b #2,d2
|
||
beq.s .Str
|
||
rts
|
||
; Si variable globale
|
||
.Glo move.l VarGlo(a5),a0
|
||
neg.w d0
|
||
lea 1(a0,d0.w),a0
|
||
bra.s .Glo2
|
||
; Si pas tableau
|
||
.FdV0 move.b #4,-2(a0) Met la longueur
|
||
move.b d2,-1(a0) Variable simple: met le flag
|
||
; and.w #$F,d2 ???
|
||
beq.s .Fin
|
||
cmp.b #1,d2
|
||
beq.s .Flt
|
||
.Str tst.l (a0) Une chaine, initialisee?
|
||
bne.s .Fin
|
||
move.l ChVide(a5),(a0)
|
||
rts
|
||
.Flt tst.b MathFlags(a5) Un float simple ou double?
|
||
bpl.s .Fin
|
||
move.b #8,-2(a0)
|
||
.Fin rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; DIM
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InDim
|
||
InDim
|
||
; - - - - - - - - - - - - - - - -
|
||
addq.l #2,a6
|
||
move.w (a6)+,d0
|
||
bmi DimGlo
|
||
move.l VarLoc(a5),a0
|
||
lea 2(a0,d0.w),a0
|
||
Dim0 moveq #0,d1
|
||
move.b (a6)+,d1
|
||
move.b (a6)+,d2
|
||
add.w d1,a6
|
||
tst.l (a0) Already dimensionned
|
||
bne AlrDim
|
||
moveq #2,d1 Taille variable (nombre de LSL)
|
||
and.w #$F,d2
|
||
cmp.b #1,d2
|
||
bne.s .Skip
|
||
tst.b MathFlags(a5)
|
||
bpl.s .Skip
|
||
moveq #3,d1 Variable double
|
||
.Skip move.w d2,-(sp) Nombre de dims
|
||
move.l a0,-(sp) Adresse du tableau
|
||
move.w d1,-(sp) Taille variable
|
||
* Recupere et compte les params
|
||
clr.w -(sp)
|
||
move.w #1,-(sp)
|
||
Dim1: bsr Fn_New_Evalue
|
||
tst.b d2
|
||
beq.s Dim2
|
||
move.w d0,-(sp)
|
||
Rjsrt L_FlToInt1
|
||
move.w (sp)+,d0
|
||
Dim2: cmp.l #$FFFF,d3
|
||
bcc FonCall
|
||
move.w d3,-(a3)
|
||
addq.w #1,d3
|
||
addq.w #1,2(sp)
|
||
mulu (sp),d3
|
||
cmp.w #_TkPar2,d0
|
||
beq.s Dim3
|
||
cmp.l #$10000,d3
|
||
bcc FonCall
|
||
move.w d3,(sp)
|
||
cmp.w #_TkVir,(a6)
|
||
beq.s Dim1
|
||
bra Synt
|
||
Dim3: addq.l #2,sp
|
||
move.w (sp)+,d2 Nb de dimensions
|
||
move.l d3,d0
|
||
move.w (sp)+,d4 Taille variable
|
||
lsl.l d4,d3
|
||
move.l d3,d5
|
||
lsr.l #2,d5 Nombre de mots long a nettoyer
|
||
move.l TabBas(a5),a0 Descend le bas tableaux
|
||
move.l a0,a2 Pour le nettoyage
|
||
sub.l d3,a0
|
||
move.w d2,d0 Taille du header
|
||
lsl.w #2,d0
|
||
addq.l #2,d0
|
||
sub.w d0,a0
|
||
cmp.l HiChaine(a5),a0
|
||
bcc DimM1
|
||
movem.l a0-a1/d0-d1,-(sp)
|
||
Rbsr L_Menage
|
||
movem.l (sp)+,a0-a1/d0-d1
|
||
cmp.l HiChaine(a5),a0
|
||
bcs OOfBuf
|
||
DimM1 move.l (sp),a1 Stocke l'adresse du tableau
|
||
move.l a0,(a1)
|
||
move.l a0,TabBas(a5)
|
||
move.b d2,(a0) Stocke le nb de dim
|
||
move.b d4,1(a0) Nombre de LSL
|
||
lea 0(a0,d0.w),a0
|
||
move.l a0,a1 Pointe le premier element
|
||
moveq #1,d1
|
||
subq.w #1,d2
|
||
Dim4: move.w d1,-(a0) Stocke taille et multiplicateur
|
||
move.w (a3)+,d0
|
||
move.w d0,-(a0)
|
||
addq.w #1,d0
|
||
mulu d0,d1
|
||
dbra d2,Dim4
|
||
; Poke le flag du tableau
|
||
move.l (sp)+,a0 Adresse du pointeur
|
||
move.w (sp)+,d2 Flag
|
||
move.w d2,d0
|
||
or.w #$0440,d0 4 octets / Tableau
|
||
move.w d0,-2(a0)
|
||
; Nettoyage
|
||
moveq #0,d0
|
||
cmp.w #2,d2
|
||
bne.s .Clean
|
||
move.l ChVide(a5),d0
|
||
.Clean move.l d0,(a1)+
|
||
subq.l #1,d5
|
||
bne.s .Clean
|
||
; Une autre variable
|
||
cmp.w #_TkVir,(a6)+
|
||
beq InDim
|
||
; Fin du dim!
|
||
subq.l #2,a6
|
||
rts
|
||
; Si variable globale
|
||
DimGlo move.l VarGlo(a5),a0
|
||
neg.w d0
|
||
lea 1(a0,d0.w),a0
|
||
bra Dim0
|
||
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; TROUVE ELEMENT DE TABLEAU
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def GetTablo
|
||
GetTablo
|
||
; - - - - - - - - - - - - - - - -
|
||
movem.l d2/d3/d4,-(sp)
|
||
move.l (a0),d0
|
||
beq NonDim
|
||
move.l d0,a0
|
||
moveq #0,d0
|
||
move.b (a0)+,d0 Nombre de dims
|
||
move.w d0,-(sp)
|
||
move.b (a0)+,d0 Taille variables
|
||
move.w d0,-(sp)
|
||
move.l a0,-(sp)
|
||
clr.l -(sp)
|
||
GetT1: bsr Fn_New_Evalue
|
||
subq.w #1,10(sp)
|
||
beq.s GetT3
|
||
tst.b d2
|
||
beq.s GetT2
|
||
Rjsrt L_FlToInt1
|
||
GetT2: move.l 4(sp),a0
|
||
moveq #0,d0
|
||
move.w (a0)+,d0
|
||
cmp.l d0,d3
|
||
bhi FonCall
|
||
mulu (a0)+,d3
|
||
add.l d3,(sp)
|
||
move.l a0,4(sp)
|
||
bra.s GetT1
|
||
GetT3: tst.b d2
|
||
beq.s GetT4
|
||
Rjsrt L_FlToInt1
|
||
GetT4: move.l (sp)+,d2
|
||
move.l (sp)+,a0
|
||
moveq #0,d0
|
||
move.w (a0)+,d0
|
||
cmp.l d0,d3
|
||
bhi FonCall
|
||
add.l d3,d2
|
||
move.w (sp)+,d0 Taille variable
|
||
lsl.l d0,d2
|
||
addq.l #2,sp
|
||
lea 2(a0,d2.l),a0
|
||
movem.l (sp)+,d2/d3/d4
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; VARPTR
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par FnVarPtr
|
||
; - - - - - - - - - - - - -
|
||
addq.l #2,a6
|
||
bsr FindVar
|
||
addq.l #2,a6
|
||
cmp.b #2,d2
|
||
beq.s .Str
|
||
.Ent move.l a0,d3
|
||
Ret_Int
|
||
.Str move.l (a0),d3
|
||
addq.l #2,d3
|
||
Ret_Int
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; =ARRAY$(a$(0))
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par FnArray
|
||
; - - - - - - - - - - - - -
|
||
addq.l #4,a6
|
||
move.w (a6)+,d0
|
||
bmi.s .Glo
|
||
move.l VarLoc(a5),a0
|
||
lea 2(a0,d0.w),a0
|
||
.Glo2 moveq #0,d1
|
||
move.b (a6)+,d1
|
||
move.b (a6)+,d2
|
||
add.w d1,a6
|
||
move.l (a0),d0
|
||
beq NonDim
|
||
; Saute les params
|
||
move.l d0,-(sp)
|
||
move.l d0,a0
|
||
moveq #0,d0
|
||
move.b (a0),d0
|
||
bsr Saut_D0Param
|
||
move.l (sp)+,d3
|
||
; Retour valeur
|
||
Ret_Int
|
||
; Si variable globale
|
||
.Glo move.l VarGlo(a5),a0
|
||
neg.w d0
|
||
lea 1(a0,d0.w),a0
|
||
bra.s .Glo2
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; PREND UNE CONSTANTE ENTIERE
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par FnCEntier
|
||
; - - - - - - - - - - - - -
|
||
move.l (a6)+,d3
|
||
Ret_Int
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; PREND UN FLOAT SIMPLE PRECISION
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par FnCstFl
|
||
; - - - - - - - - - - - - -
|
||
tst.b MathFlags(a5)
|
||
bmi.s .DFlt
|
||
move.l (a6)+,d3
|
||
Ret_Float
|
||
.DFlt move.l (a6)+,d0
|
||
Rjsr L_FFP2Ieee
|
||
Rjsr L_Sp2Dp
|
||
move.l d0,d3
|
||
move.l d1,d4
|
||
Ret_Float
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; PREND UN FLOAT DOUBLE PRECISION
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par FnCstDFl
|
||
; - - - - - - - - - - - - -
|
||
tst.b MathFlags(a5)
|
||
bpl.s .SFlt
|
||
move.l (a6)+,d3
|
||
move.l (a6)+,d4
|
||
Ret_Float
|
||
.SFlt move.l (a6)+,d0
|
||
move.l (a6)+,d1
|
||
Rjsr L_Dp2Sp
|
||
Rjsr L_Ieee2FFP
|
||
move.l d0,d3
|
||
Ret_Float
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; PREND UNE CHAINE
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par FnCstCh
|
||
; - - - - - - - - - - - - -
|
||
move.l a6,d3
|
||
move.w (a6)+,d0
|
||
add.w d0,a6
|
||
btst #0,d0
|
||
beq.s .CstC0
|
||
addq.l #1,a6
|
||
.CstC0: tst.w Direct(a5)
|
||
bne.s .CstC1
|
||
Ret_String
|
||
; Mode direct: recopier la chaine
|
||
.CstC1: move.l d3,a2
|
||
moveq #0,d3
|
||
move.w (a2)+,d3
|
||
bsr Demande
|
||
move.w d3,(a0)+
|
||
addq.w #1,d3
|
||
lsr.w #1,d3
|
||
subq.w #1,d3
|
||
bmi.s .CstC3
|
||
.CstC2: move.w (a2)+,(a0)+
|
||
dbra d3,.CstC2
|
||
.CstC3: move.l a1,d3
|
||
move.l a0,HiChaine(a5)
|
||
Ret_String
|
||
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; SHARED / GLOBAL
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InShared
|
||
; - - - - - - - - - - - - - - - -
|
||
Sha0 move.b 4(a6),d0
|
||
ext.w d0
|
||
lea 6(a6,d0.w),a6
|
||
cmp.w #_TkPar1,(a6)
|
||
bne.s Sha1
|
||
addq.l #4,a6
|
||
Sha1: cmp.w #_TkVir,(a6)+
|
||
beq.s Sha0
|
||
subq.l #2,a6
|
||
rts
|
||
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; DEF FN / =FN
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InDFn
|
||
; - - - - - - - - - - - - - - - -
|
||
bsr FindVar
|
||
move.l a6,(a0)
|
||
move.l d7,a6
|
||
subq.l #4,a6
|
||
moveq #0,d0
|
||
move.b (a6),d0
|
||
lsl.w #1,d0
|
||
lea -2(a6,d0.w),a6 Branche a la fin de la ligne
|
||
rts
|
||
; - - - - - - - - - - - - - - - -
|
||
Lib_Par FnFn
|
||
; - - - - - - - - - - - - - - - -
|
||
bsr FindVar
|
||
move.l (a0),d0
|
||
beq FnNDef
|
||
move.l d0,a2
|
||
; Egalise les params
|
||
move.w (a6),d0
|
||
cmp.w #_TkPar1,d0
|
||
bne.s FFn5
|
||
addq.l #2,a6
|
||
FFn1 cmp.w (a2)+,d0
|
||
bne FnIlNb
|
||
move.l a2,-(sp)
|
||
bsr New_Evalue
|
||
movem.l d2/d3/d4/a6,-(sp)
|
||
move.l 4*4(sp),a6
|
||
bsr FindVar
|
||
move.w d2,d1
|
||
move.l a6,a2
|
||
movem.l (sp)+,d2/d3/d4/a6
|
||
addq.l #4,sp
|
||
cmp.b d1,d2
|
||
beq.s FFn3
|
||
cmp.b #1,d1
|
||
bhi TypeMis
|
||
bne.s FFn2
|
||
move.l a0,-(sp)
|
||
Rjsrt L_IntToFl1
|
||
move.l (sp)+,a0
|
||
bra.s FFn3
|
||
FFn2 cmp.b #1,d2
|
||
bhi TypeMis
|
||
move.l a0,-(sp)
|
||
Rjsrt L_FlToInt1
|
||
move.l (sp)+,a0
|
||
FFn3 cmp.b #1,d1
|
||
bne.s .Ent
|
||
tst.b MathFlags(a5)
|
||
bpl.s .Ent
|
||
move.l d4,4(a0)
|
||
.Ent move.l d3,(a0)
|
||
move.w (a6)+,d0
|
||
cmp.w #_TkVir,d0
|
||
beq.s FFn1
|
||
subq.l #2,a6
|
||
cmp.w #_TkPar2,(a2)+
|
||
bne.s FnIlNb
|
||
FFn5 cmp.w #_TkEg,(a2)+
|
||
bne.s FnIlNb
|
||
; Appelle la fonction
|
||
; ~~~~~~~~~~~~~~~~~~~
|
||
movem.l a3-a6,-(sp)
|
||
move.l a2,a6
|
||
bsr New_Evalue
|
||
movem.l (sp)+,a3-a6
|
||
rts
|
||
FnIlNb moveq #16,d0
|
||
bra RunErr
|
||
FnNDef moveq #15,d0
|
||
bra RunErr
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; SWAP
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InSwap
|
||
; - - - - - - - - - - - - - - - -
|
||
bsr FindVar
|
||
move.l a0,-(sp)
|
||
addq.l #2,a6
|
||
bsr FindVar
|
||
move.l (sp)+,a1
|
||
move.l (a0),d0
|
||
move.l (a1),(a0)
|
||
move.l d0,(a1)
|
||
cmp.b #1,d2
|
||
bne.s .Fin
|
||
tst.b MathFlags(a5)
|
||
bpl.s .Fin
|
||
move.l 4(a0),d0
|
||
move.l 4(a1),4(a0)
|
||
move.l d0,4(a1)
|
||
.Fin rts
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InSwapD
|
||
; - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; NOT
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par FnNot
|
||
; - - - - - - - - - - - - - - - -
|
||
bsr New_Evalue
|
||
tst.b d2
|
||
beq.s .Skip
|
||
Rjsrt L_FlToInt1
|
||
.Skip not.l d3
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; MAX / MIN
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par FnMax
|
||
; - - - - - - - - - - - - - - - -
|
||
bsr MinMax
|
||
ble.s FMx2
|
||
FMx1 movem.l 4(a3),d3/d4
|
||
FMx2 lea 12(a3),a3
|
||
rts
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def FnMaxS
|
||
; - - - - - - - - - - - - -
|
||
; - - - - - - - - - - - - - - - -
|
||
Lib_Par FnMin
|
||
; - - - - - - - - - - - - - - - -
|
||
bsr MinMax
|
||
ble.s FMx1
|
||
bra.s FMx2
|
||
; Routine min max
|
||
; ~~~~~~~~~~~~~~~
|
||
MinMax bsr Fn_New_Evalue
|
||
movem.l d2/d3/d4,-(a3)
|
||
bsr Fn_New_Evalue
|
||
bsr Compat
|
||
bmi.s MMx1
|
||
bne.s MMx2
|
||
movem.l d2-d4,-(sp) * Float
|
||
Rjsrt L_Float_Compare
|
||
movem.l (sp)+,d2-d4
|
||
rts
|
||
MMx1 move.l 4(a3),d4
|
||
cmp.l d3,d4 * Int
|
||
rts
|
||
MMx2 movem.l d2-d4,-(sp) * Chaine
|
||
bsr compch
|
||
move.l d3,d0
|
||
move.l d4,d1
|
||
movem.l (sp)+,d2-d4
|
||
cmp.l d3,d4
|
||
rts
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def FnMinS
|
||
; - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; INC + DEC
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InInc
|
||
; - - - - - - - - - - - - - - - -
|
||
bsr FindVar
|
||
addq.l #1,(a0)
|
||
rts
|
||
; - - - - - - - - - - - - - - - -
|
||
Lib_Par InDec
|
||
; - - - - - - - - - - - - - - - -
|
||
bsr FindVar
|
||
subq.l #1,(a0)
|
||
rts
|
||
; - - - - - - - - - - - - - - - -
|
||
Lib_Par InAdd2
|
||
; - - - - - - - - - - - - - - - -
|
||
bsr FindVar
|
||
move.l a0,-(sp)
|
||
bsr Fn_New_Evalue
|
||
move.l (sp)+,a0
|
||
add.l d3,(a0)
|
||
rts
|
||
; - - - - - - - - - - - - - - - -
|
||
Lib_Par InAdd4
|
||
; - - - - - - - - - - - - - - - -
|
||
bsr FindVar
|
||
move.l a0,-(sp)
|
||
moveq #3,d0
|
||
bsr FnParD0
|
||
move.l (sp)+,a0
|
||
move.l (a0),d0
|
||
move.l (a3)+,d2
|
||
move.l (a3)+,d1
|
||
add.l (a3)+,d0
|
||
cmp.l d1,d0
|
||
blt.s IAdd4m
|
||
cmp.l d2,d0
|
||
bgt.s IAdd4p
|
||
move.l d0,(a0)
|
||
rts
|
||
IAdd4m: move.l d2,(a0)
|
||
rts
|
||
IAdd4p: move.l d1,(a0)
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; SORT
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InSort
|
||
; - - - - - - - - - - - - - - - -
|
||
bsr GTablo ;va chercher les caracteristiques du tableau
|
||
move.l d6,d3
|
||
or4: lsr.l #1,d3 ;E=d3
|
||
beq XSort
|
||
moveq #1,d5 ;NA=d5
|
||
or5: move.l d5,d4 ;NR=d4 -> NR=NA
|
||
or6: movem.l d3-d6/a1,-(sp)
|
||
move.l a1,a0
|
||
subq.l #1,d4
|
||
move.l d4,d0
|
||
move.l d3,d1
|
||
bsr AdSort
|
||
movem.l a0/a1/d2,-(sp)
|
||
move.l 4(a0),-(a3)
|
||
move.l (a0),-(a3)
|
||
subq.l #4,a3
|
||
movem.l (a1),d3-d4
|
||
bsr CpBis
|
||
lea 12(a3),a3
|
||
movem.l (sp)+,a0/a1/d2
|
||
ble.s or8
|
||
; fait le swap
|
||
move.l (a0),d0
|
||
move.l (a1),(a0)
|
||
move.l d0,(a1)
|
||
cmp.b #3,d7
|
||
bne.s .Skip
|
||
move.l 4(a0),d0
|
||
move.l 4(a1),4(a0)
|
||
move.l d0,4(a1)
|
||
.Skip movem.l (sp)+,d3-d6/a1
|
||
sub.l d3,d4 ;NR=NR-E
|
||
beq.s or9
|
||
bcc.s or6
|
||
bra.s or9
|
||
or8: movem.l (sp)+,d3-d6/a1
|
||
or9: addq.l #1,d5 ;NA=NA+1
|
||
move.l d6,d0
|
||
sub.l d3,d0
|
||
cmp.l d0,d5
|
||
bls.s or5
|
||
bra.s or4
|
||
XSort Rjsr L_LoadRegs
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; =MATCH
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par FnMatch
|
||
; - - - - - - - - - - - - - - - -
|
||
addq.l #2,a6
|
||
bsr GTablo
|
||
movem.l a1/d2/d6/d7,-(sp)
|
||
bsr Fn_New_Evalue
|
||
movem.l (sp)+,a1/d5/d6/d7
|
||
* Etabli la compatibilite entre variables
|
||
cmp.b d2,d5
|
||
beq.s di3
|
||
subq.w #1,d5
|
||
beq.s di2
|
||
bpl TypeMis
|
||
Rjsrt L_FlToInt1
|
||
bra.s di3
|
||
di2: Rjsrt L_IntToFl1
|
||
; recherche!
|
||
di3: moveq #0,d5
|
||
move.l d6,d1
|
||
lsr.l #1,d6
|
||
di4: movem.l a1/d1-d7,-(sp)
|
||
add.l d6,d5
|
||
move.l d5,d1
|
||
move.l a1,a0
|
||
moveq #0,d0
|
||
bsr AdSort
|
||
move.l 4(a1),-(a3)
|
||
move.l (a1),-(a3)
|
||
subq.l #4,a3
|
||
bsr CpBis
|
||
lea 12(a3),a3
|
||
movem.l (sp)+,a1/d1-d7
|
||
beq.s di11
|
||
bgt.s di5
|
||
add.l d6,d5
|
||
di5: tst.l d6
|
||
beq.s di7
|
||
lsr.l #1,d6
|
||
bra.s di4
|
||
; pas trouve: cherche le premier element superieur
|
||
di7: cmp.l d1,d5
|
||
bcc.s di8
|
||
movem.l a1/d1-d7,-(sp)
|
||
move.l d5,d1
|
||
move.l a1,a0
|
||
moveq #0,d0
|
||
bsr AdSort
|
||
move.l 4(a1),-(a3)
|
||
move.l (a1),-(a3)
|
||
subq.l #4,a3
|
||
bsr CpBis
|
||
lea 12(a3),a3
|
||
movem.l (sp)+,a1/d1-d7
|
||
beq.s di11
|
||
bgt.s di8
|
||
addq.l #1,d5
|
||
bra.s di7
|
||
di8: move.l d5,d3
|
||
addq.l #1,d3
|
||
neg.l d3
|
||
bra.s di12
|
||
; trouve!
|
||
di11: move.l d5,d3
|
||
add.l d6,d3
|
||
; Sortie
|
||
di12 Rjsr L_LoadRegs
|
||
Ret_Int
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Trouve les parametres tableau pour SORT et FIND
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def GTablo
|
||
; - - - - - - - - - - - - -
|
||
GTablo Rjsr L_SaveRegs
|
||
addq.l #2,a6
|
||
move.w (a6)+,d0
|
||
bmi.s GTbG
|
||
move.l VarLoc(a5),a0
|
||
lea 2(a0,d0.w),a0
|
||
GTb0 move.b (a6)+,d1
|
||
move.b (a6)+,d2
|
||
ext.w d1
|
||
add.w d1,a6
|
||
move.l (a0),d0
|
||
beq NonDim
|
||
move.l d0,a1
|
||
moveq #0,d0
|
||
move.b (a1)+,d0 Nombre de dims
|
||
move.b (a1)+,d7 Taille des variables
|
||
move.w d0,d1
|
||
moveq #1,d6
|
||
GTb1: move.w (a1)+,d3
|
||
addq.l #2,a1
|
||
addq.w #1,d3
|
||
mulu d3,d6
|
||
subq.w #1,d1
|
||
bne.s GTb1
|
||
and.w #$F,d2
|
||
* Saute les params
|
||
movem.l a1/a3/d2/d6/d7,-(sp)
|
||
bsr FnParD0
|
||
movem.l (sp)+,a1/a3/d2/d6/d7
|
||
rts
|
||
; Si variable globale
|
||
GTbG move.l VarGlo(a5),a0
|
||
neg.w d0
|
||
lea 1(a0,d0.w),a0
|
||
bra.s GTb0
|
||
|
||
* Trouve l'adresse D0/D1 >>> A0/A1
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def AdSort
|
||
AdSort
|
||
; - - - - - - - - - - - - -
|
||
lsl.l d7,d0
|
||
add.l d0,a0
|
||
move.l a0,a1
|
||
lsl.l d7,d1
|
||
add.l d1,a1
|
||
rts
|
||
* Comparaison pour SORT/FIND
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def CpBis
|
||
CpBis
|
||
; - - - - - - - - - - - - -
|
||
cmp.b #1,d2
|
||
beq.s .Flt
|
||
bcs.s .Ent
|
||
bsr compch
|
||
cmp.l d3,d4
|
||
rts
|
||
.Ent move.l 4(a3),d4
|
||
cmp.l d3,d4
|
||
rts
|
||
.Flt Rjmpt L_Float_Compare
|
||
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Instruction DATA
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InData
|
||
; - - - - - - - - - - - - - - - -
|
||
move.w (a6),d0 Passe a la fin de la ligne
|
||
sub.w d0,a6
|
||
moveq #0,d0
|
||
move.b (a6),d0
|
||
lsl.w #1,d0
|
||
lea -2(a6,d0.w),a6
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Instruction READ
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InRead
|
||
; - - - - - - - - - - - - - - - -
|
||
* Va chercher la variable
|
||
LRead bsr FindVar
|
||
* Va chercher le data
|
||
move.l a0,-(sp)
|
||
move.w d2,-(sp)
|
||
move.l a6,-(sp)
|
||
move.l AData(a5),d0
|
||
beq.s NxD0
|
||
move.l d0,a6
|
||
bra.s NxD3
|
||
NxD0: move.l PData(a5),d0
|
||
beq OOf
|
||
move.l d0,a6
|
||
NxD1: tst.w (a6)
|
||
beq OOf
|
||
lea 2(a6),a0
|
||
move.w (a0),d0
|
||
cmp.w #_TkEndP,d0
|
||
beq OOf
|
||
cmp.w #_TkProc,d0
|
||
beq.s NxD6
|
||
cmp.w #_TkData,d0 * DATA direct
|
||
beq.s NxD2
|
||
cmp.w #_TkLab,d0 * LABEL: DATA
|
||
bne.s NxD5
|
||
move.b 6(a6),d0
|
||
ext.w d0
|
||
lea 8(a6,d0.w),a0
|
||
cmp.w #_TkData,(a0)
|
||
beq.s NxD2
|
||
NxD5: moveq #0,d0
|
||
move.b (a6),d0
|
||
lsl.w #1,d0
|
||
lea 0(a6,d0.w),a6
|
||
bra.s NxD1
|
||
NxD6: move.l 2(a0),d0
|
||
lea 10(a0,d0.l),a6
|
||
bra.s NxD1
|
||
NxD2: moveq #0,d0
|
||
move.b (a6),d0
|
||
lsl.w #1,d0
|
||
lea 0(a6,d0.w),a6
|
||
move.l a6,PData(a5)
|
||
lea 4(a0),a6
|
||
* Virgule---> SPECIAL!
|
||
NxD3: move.w (a6),d0
|
||
beq.s InRdV
|
||
cmp.w #_TkVir,d0
|
||
bne.s InRd0
|
||
InRdV: moveq #0,d3
|
||
moveq #0,d2
|
||
move.w 4(sp),d5
|
||
subq.w #2,d5
|
||
bmi.s InRd1
|
||
move.l ChVide(a5),d3
|
||
moveq #2,d2
|
||
bra.s InRd1
|
||
* Evaluation normale
|
||
InRd0: bsr New_Evalue
|
||
* Pointe la fin du data
|
||
InRd1: tst.w (a6)+
|
||
bne.s InRd2
|
||
sub.l a6,a6
|
||
InRd2: move.l a6,AData(a5)
|
||
* Egalise
|
||
move.l (sp)+,a6
|
||
move.w (sp)+,d1
|
||
move.l (sp)+,a2
|
||
cmp.b d2,d1
|
||
beq.s InRd5
|
||
cmp.b #2,d1
|
||
beq RTypeM
|
||
cmp.b #2,d2
|
||
beq RTypeM
|
||
tst.b d1
|
||
beq.s InRd4
|
||
Rjsrt L_IntToFl1
|
||
bra.s InRd5
|
||
InRd4 Rjsrt L_FlToInt1
|
||
InRd5 cmp.b #1,d2 Float?
|
||
bne.s InRd6
|
||
tst.b MathFlags(a5) Double precision?
|
||
bpl.s InRd6
|
||
move.l d4,4(a2)
|
||
InRd6 move.l d3,(a2)
|
||
* Encore une variable?
|
||
cmp.w #_TkVir,(a6)+
|
||
beq LRead
|
||
subq.l #2,a6
|
||
rts
|
||
OOf clr.l PData(a5)
|
||
bra OOfData
|
||
RTypeM: moveq #34,d0
|
||
bra RunErr
|
||
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InReadF
|
||
Lib_Def InReadS
|
||
; - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Instruction RESTORE
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InRestore
|
||
; - - - - - - - - - - - - - - - -
|
||
bsr Finie
|
||
bne.s InRs1
|
||
* Sans label
|
||
move.l DProc(a5),PData(a5)
|
||
clr.l AData(a5)
|
||
rts
|
||
* Avec label
|
||
InRs1: bsr GetLabel
|
||
beq LbNDef
|
||
move.l d0,a0
|
||
cmp.w #_TkData,(a0)+
|
||
bne.s InRs2
|
||
move.w (a0),d0
|
||
sub.w d0,a0
|
||
move.l a0,PData(a5)
|
||
clr.l AData(a5)
|
||
rts
|
||
InRs2 moveq #41,d0
|
||
bra RunErr
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InRestore1
|
||
; - - - - - - - - - - - - -
|
||
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Source: Diskio.s
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; FIELD n,AA as A$
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InField
|
||
; - - - - - - - - - - - - -
|
||
bsr New_Expentier
|
||
move.l d3,d0
|
||
Rjsr L_GetFile
|
||
beq FilNO
|
||
move.l a3,-(sp)
|
||
move.l a2,-(sp)
|
||
clr.w -(sp)
|
||
* Recupere les variables
|
||
Fld1 addq.l #2,a6
|
||
bsr New_Expentier
|
||
move.l d3,-(a3)
|
||
addq.l #2,a6
|
||
bsr FindVar
|
||
move.l a0,-(a3)
|
||
addq.w #1,(sp)
|
||
cmp.w #_TkVir,(a6)
|
||
beq.s Fld1
|
||
* Reserve la memoire necessaire
|
||
move.w (sp),d0
|
||
mulu #6,d0
|
||
addq.l #8,d0
|
||
SyCall MemFastClear
|
||
beq OOfMem
|
||
move.w (sp)+,d1
|
||
move.l (sp)+,a2
|
||
move.l a0,FhF(a2)
|
||
move.l a0,a1
|
||
lea 8(a1),a0
|
||
move.w d1,(a1)
|
||
subq.w #1,d1
|
||
moveq #0,d2
|
||
move.l (sp),a3
|
||
Fld2 move.l -(a3),d0
|
||
beq FldFonc
|
||
add.l d0,d2
|
||
cmp.l #String_Max,d2
|
||
bcc FldFonc
|
||
move.w d0,(a0)+
|
||
move.l -(a3),(a0)+
|
||
dbra d1,Fld2
|
||
move.w d2,2(a1)
|
||
* Taille du fichier
|
||
move.l (sp)+,a3
|
||
move.l a1,-(sp)
|
||
move.l FhA(a2),d1
|
||
moveq #0,d2
|
||
moveq #1,d3
|
||
DosCall _LVOSeek
|
||
move.l FhA(a2),d1
|
||
moveq #0,d2
|
||
moveq #-1,d3
|
||
DosCall _LVOSeek
|
||
move.l (sp)+,a1
|
||
move.l d0,4(a1)
|
||
rts
|
||
* FonCall field!
|
||
FldFonc Rjsr L_Cloa1
|
||
bra FonCall
|
||
FilNO moveq #DEBase+18,d0
|
||
bra RunErr
|
||
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; INPUT #
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InLineInputH
|
||
; - - - - - - - - - - - - -
|
||
clr.w -(sp)
|
||
bra.s DInp0
|
||
; - - - - - - - - - - - - -
|
||
Lib_Par InInputH
|
||
; - - - - - - - - - - - - -
|
||
move.w #",",-(sp)
|
||
DInp0 bsr New_Expentier
|
||
addq.l #2,a6
|
||
move.l d3,d0
|
||
Rjsr L_GetFile
|
||
beq FilNO
|
||
move.l a2,PrintFile(a5)
|
||
clr.l DeFloat(a5)
|
||
Rjsr L_SaveRegs
|
||
bra ReInp
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; INPUT
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InInput
|
||
; - - - - - - - - - - - - -
|
||
move.w #",",-(sp)
|
||
bra.s IInp0
|
||
; - - - - - - - - - - - - -
|
||
Lib_Par InLineInput
|
||
; - - - - - - - - - - - - -
|
||
clr.w -(sp)
|
||
IInp0: Rjsr L_SaveRegs
|
||
clr.l DeFloat(a5)
|
||
clr.l PrintFile(a5)
|
||
tst.w ScOn(a5)
|
||
beq ScNOp
|
||
move.l Buffer(a5),a0
|
||
clr.b (a0)
|
||
moveq #1,d7
|
||
* Chaine a imprimer?
|
||
cmp.w #_TkVar,(a6)
|
||
beq.s IInp1
|
||
bsr New_Evalue
|
||
move.l d3,a2
|
||
move.w (a2)+,d2
|
||
addq.l #2,a6
|
||
moveq #0,d7
|
||
tst.w d2
|
||
beq.s IInp1
|
||
move.b 0(a2,d2.w),d6
|
||
clr.b 0(a2,d2.w)
|
||
move.l a2,a1
|
||
WiCall Print
|
||
move.b d6,0(a2,d2.w)
|
||
* Imprime le ?
|
||
IInp1: tst.w d7
|
||
beq.s ReInp
|
||
WiCalA Print,InnInt(pc)
|
||
clr.l DeFloat(a5)
|
||
|
||
; Rempli le buffer!
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~
|
||
ReInp: tst.l PrintFile(a5)
|
||
bne.s ReDInp
|
||
* Clavier
|
||
lea Es_LEd(a5),a0
|
||
move.l Buffer(a5),a1
|
||
clr.b (a1)
|
||
move.l a1,a2
|
||
move.w #(1<<LEd_FCursor)|(1<<LEd_FTests)|(1<<LEd_FMulti),d0
|
||
moveq #0,d1 Curseur <EFBFBD> zero
|
||
move.w #256,d2 256 caracteres maxi
|
||
moveq #-1,d3 Largeur maxi
|
||
move.l a3,-(sp)
|
||
Rjsr L_LEd_Init
|
||
bne FonCall Trop <EFBFBD> droite...
|
||
Rjsr L_LEd_Loop
|
||
move.l (sp)+,a3
|
||
move.l d0,d3
|
||
tst.w d2
|
||
bmi IStop
|
||
bra InnPut
|
||
* Fichier!
|
||
ReDInp move.l PrintFile(a5),a2
|
||
move.l Buffer(a5),a1
|
||
clr.b (a1)
|
||
moveq #0,d1
|
||
move.w (sp),d2
|
||
move.b ChrInp+1(a5),d3
|
||
move.b ChrInp(a5),d4
|
||
bra.s InpD1
|
||
InpD0 move.b d0,(a1)+
|
||
addq.w #1,d1
|
||
cmp.w #1000,d1
|
||
bcc InpTL
|
||
InpD1 Rjsr L_GetByte
|
||
cmp.b d0,d2 * Stop aux virgules
|
||
beq.s InpD2
|
||
cmp.b d0,d3 * Premier caractere?
|
||
bne.s InpD0
|
||
tst.b d4 * Sauter le deuxieme?
|
||
bmi.s InpD2
|
||
Rjsr L_GetByte
|
||
InpD2 clr.b (a1)
|
||
move.l a1,d3
|
||
sub.l Buffer(a5),d3 * Nombre de caracteres -> D3
|
||
|
||
******* INPUT/LINE INPUT: interprete le buffer!
|
||
InnPut move.l Buffer(a5),a2
|
||
Inn1: move.l a2,-(sp)
|
||
bsr FindVar
|
||
move.l (sp)+,a2
|
||
movem.l a0/d2,-(sp)
|
||
cmp.b #2,d2
|
||
bne.s Inn5
|
||
* Variable alphanumerique
|
||
move.l ChVide(a5),(a0) * Libere la memoire!
|
||
bsr DDemande
|
||
addq.l #2,a0
|
||
move.b 8+1(sp),d1
|
||
Inn2: move.b (a2)+,d0
|
||
move.b d0,(a0)+
|
||
beq.s Inn3
|
||
cmp.b d0,d1
|
||
bne.s Inn2
|
||
Inn3: subq.l #1,a0
|
||
subq.l #1,a2
|
||
move.l a0,d0
|
||
sub.l a1,d0
|
||
subq.l #2,d0
|
||
move.w d0,(a1)
|
||
btst #0,d0
|
||
beq.s Inn4
|
||
addq.l #1,a0
|
||
Inn4: move.l a0,HiChaine(a5)
|
||
movem.l (sp)+,a0/d2
|
||
move.l a1,(a0)
|
||
bra.s Inn10
|
||
* Variable numerique
|
||
Inn5: move.l a2,a0
|
||
moveq #1,d0 Tenir compte du signe
|
||
Rjsr L_ValRout
|
||
move.l a0,a2
|
||
movem.l (sp)+,a1/d1
|
||
move.b (a2),d0
|
||
beq.s Inn6
|
||
cmp.b 1(sp),d0
|
||
bne InnRedo
|
||
Inn6: cmp.b d1,d2
|
||
beq.s Inn8
|
||
tst.b d1
|
||
beq.s Inn7
|
||
move.l a1,-(sp)
|
||
Rjsrt L_IntToFl1
|
||
move.l (sp)+,a1
|
||
bra.s Inn8
|
||
Inn7: move.l a1,-(sp)
|
||
Rjsrt L_FlToInt1
|
||
move.l (sp)+,a1
|
||
Inn8: move.l d3,(a1) Poke la variable
|
||
cmp.b #1,d2 Float?
|
||
bne.s Inn10
|
||
tst.b MathFlags(a5) Double?
|
||
bpl.s Inn10
|
||
move.l d4,4(a1) Poke la 2eme partie
|
||
* Encore une variable a prendre???
|
||
Inn10: cmp.w #_TkVir,(a6)+
|
||
bne.s Inn11
|
||
cmp.b #",",(a2)+
|
||
beq Inn1
|
||
* ??
|
||
tst.l PrintFile(a5)
|
||
bne ReInp
|
||
WiCalA Print,InnEnc(pc)
|
||
move.l Buffer(a5),a0
|
||
clr.b (a0)
|
||
bra ReInp
|
||
* Fini!
|
||
Inn11: subq.l #2,a6
|
||
addq.l #2,sp
|
||
Rjsr L_EndByte
|
||
tst.l PrintFile(a5)
|
||
bne.s InnFin
|
||
cmp.w #_TkPVir,(a6)+
|
||
beq.s InnFin
|
||
subq.l #2,a6
|
||
WiCalA Print,InnRet(pc)
|
||
bra.s InnFin
|
||
* Redo from start
|
||
InnRedo Rjsr L_EndByte
|
||
tst.l PrintFile(a5)
|
||
bne TypeMis
|
||
WiCalA Print,InnRet(pc)
|
||
moveq #15,d0
|
||
Rjsr L_Def_GetMessage
|
||
move.l a0,a1
|
||
WiCall Print
|
||
WiCalA Print,InnRet(pc)
|
||
Rjsr L_LoadRegs
|
||
move.l d7,a6
|
||
bra IInp0
|
||
* Fini!
|
||
InnFin Rjsr L_LoadRegs
|
||
rts
|
||
InnRet: dc.b 13,10,0
|
||
InnInt: dc.b "? ",0
|
||
InnEnc: dc.b 13,10,"?? ",0
|
||
even
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def Input
|
||
Lib_Def CRet
|
||
; - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; PRINT #n,"kjfdjkf";
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InPrintH
|
||
; - - - - - - - - - - - - -
|
||
bsr New_Expentier
|
||
addq.l #2,a6
|
||
move.l d3,d0
|
||
Rjsr L_GetFile
|
||
tst.l FhA(a2)
|
||
beq FilNO
|
||
btst #0,FhT(a2)
|
||
beq FilTM
|
||
cmp.w #1,d0
|
||
beq FilTM
|
||
move.l a2,PrintFile(a5)
|
||
clr.w ImpFlg(a5)
|
||
bra.s Print0
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; LPRINT
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InLPrint
|
||
; - - - - - - - - - - - - -
|
||
clr.l PrintFile(a5)
|
||
move #1,ImpFlg(a5)
|
||
bra.s Print0
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; PRINT
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InPrint
|
||
; - - - - - - - - - - - - -
|
||
clr ImpFlg(a5)
|
||
clr.l PrintFile(a5)
|
||
* Entree commune
|
||
Print0 Rjsr L_SaveRegs
|
||
move.l PrintPos(a5),d0
|
||
beq.s Print1
|
||
move.l d0,a6
|
||
bclr #7,PrintFlg(a5)
|
||
* Boucle
|
||
Print1 clr PrintFlg(a5)
|
||
Prunt2 bsr ssprint
|
||
beq FinPrint
|
||
tst.w d7
|
||
beq.s Prunt2
|
||
move.l PrintFile(a5),d0
|
||
bne.s Print4
|
||
* A l'ecran / Imprimante
|
||
move.l Buffer(a5),a0
|
||
Rjsr L_ImpChaine
|
||
bra.s Prunt2
|
||
* Impression dans un fichier
|
||
Print4 move.l d0,a0
|
||
move.l FhA(a0),d1
|
||
Print5 move.l Buffer(a5),d2
|
||
move.l d3,-(sp)
|
||
moveq #0,d3
|
||
move.w d7,d3
|
||
DosCall _LVOWrite
|
||
move.l d3,d1
|
||
move.l (sp)+,d3
|
||
cmp.l d0,d1
|
||
beq.s Prunt2
|
||
Rjmp L_DiskError
|
||
* Fin du print
|
||
FinPrint:
|
||
Rjsr L_LoadRegs
|
||
clr.l PrintPos(a5)
|
||
clr.l PrintFile(a5)
|
||
rts
|
||
|
||
; ROUTINE DE PRINT: REMPLI LE BUFFER, REVIENT D7=LONGUEUR A IMPRIMER!
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
ssprint btst #7,PrintFlg(a5) impression de chaine en route!
|
||
bne sp2a
|
||
btst #6,PrintFlg(a5) fini?
|
||
bne sp17
|
||
move.l Buffer(a5),a0
|
||
cmp.w #_TkUsing,(a6) Using?
|
||
beq.s sp20
|
||
bsr Finie Print termine?
|
||
beq sp11
|
||
bra.s spa
|
||
; USING "+ - #### . ^^^^ ~~~~": debut, STOCKE LA CHAINE
|
||
sp20: bsr Fn_New_Evalue
|
||
move.l d3,a2
|
||
move.w (a2)+,d2
|
||
cmp #120,d2 pas plus de 200 caracteres
|
||
bcc FonCall
|
||
move.l Buffer(a5),a0
|
||
lea 256(a0),a0
|
||
Rjsr L_ChVerBuf2 copie la chaine dans le buffer
|
||
move #1,UsingFlg(a5)
|
||
addq.l #2,a6 Saute le ;
|
||
bra.s spb
|
||
* Prend le param
|
||
spa: clr UsingFlg(a5)
|
||
spb: bsr New_Evalue
|
||
move.l d7,d0
|
||
bne.s spb0
|
||
move.l MenA4(a5),d7
|
||
spb0: move.l Buffer(a5),a0
|
||
subq.b #1,d2
|
||
bmi.s sp1
|
||
bne.s sp2
|
||
; IMPRESSION D'UN CHIFFRE FLOAT
|
||
RjsrtR L_Float2Ascii,1 ;va ecrire dans le buffer
|
||
bra using1
|
||
; IMPRESSION D'UN CHIFFRE ENTIER
|
||
sp1: move.l d3,d0
|
||
moveq #-1,d3 ;proportionnel
|
||
moveq #1,d4 ;avec signe
|
||
Rjsr L_LongToAsc
|
||
bra using1
|
||
; IMPRESSION D'UNE CHAINE -debut-
|
||
sp2: move.l d3,a2
|
||
move.w (a2)+,d3
|
||
bne.s sp3
|
||
bra using50
|
||
; IMPRESSION D'UNE CHAINE -milieu-
|
||
sp2a: move.l Buffer(a5),a0
|
||
sp3: moveq #120,d0
|
||
sp4: move.b (a2)+,(a0)+ ;imprime par salves de 120 caracteres,
|
||
subq #1,d3
|
||
beq.s sp5
|
||
dbra d0,sp4
|
||
bset #7,PrintFlg(a5) ;on a pas fini d'imprimer la chaine!
|
||
bra.s sp11
|
||
sp5: bclr #7,PrintFlg(a5) ;on a fini!
|
||
bra using50
|
||
; fin du sspgm/retour du USING
|
||
sp11: clr UsingFlg(a5) ;une seule expression par USING
|
||
btst #7,PrintFlg(a5) ;pas fini: ne fait rien!
|
||
bne.s sp15
|
||
move.w (a6),d0
|
||
cmp.w #_TkVir,d0
|
||
beq.s sp12
|
||
cmp.b #_TkPVir,d0 ;point virgule: ne fait rien!
|
||
beq.s sp13
|
||
bra.s sp14
|
||
sp12: move.b #9,(a0)+ ;TAB
|
||
sp13: addq.l #2,a6
|
||
bsr Finie
|
||
beq.s sp14a
|
||
bne.s sp15
|
||
sp14: move.b #13,(a0)+ ;met le RETURN
|
||
move.b #10,(a0)+
|
||
sp14a: bset #6,PrintFlg(a5) ;flag: c'est fini apres!
|
||
sp15: clr.b (a0)
|
||
sub.l Buffer(a5),a0
|
||
move.l a0,d7 ;taille du buffer
|
||
btst #7,PrintFlg(a5)
|
||
bne.s sp16
|
||
move.l a6,PrintPos(a5) ;position du CHRGET PRINT
|
||
sp16: moveq #1,d0 ;retour: quelque chose a imprimer!
|
||
rts
|
||
sp17: moveq #0,d0
|
||
rts
|
||
|
||
; USING pour les CHIFFRES
|
||
using1: tst UsingFlg(a5) Si pas using: revient imprimer
|
||
beq sp11
|
||
clr.b (a0) Stoppe la chaine
|
||
move.l Buffer(a5),a1
|
||
lea 128(a1),a2
|
||
moveq #127,d0
|
||
us2: move.b (a1),(a2)+ recopie la chaine, et fait le menage!!!
|
||
move.b #32,(a1)+
|
||
dbra d0,us2
|
||
move.l Buffer(a5),a0
|
||
lea 128(a0),a1 a1 pointe la chaine
|
||
move.l a1,d6 debut chaine a formatter
|
||
move.l Buffer(a5),a2
|
||
lea 256(a2),a2 a2 pointe la chaine de definition
|
||
move.l a2,d7 debut chaine de format
|
||
us3: move.b (a2),d0
|
||
beq.s us5
|
||
cmp.b #".",d0 cherche la fin du format de chiffre
|
||
beq.s us5
|
||
cmp.b #";",d0
|
||
beq.s us5
|
||
cmp.b #"^",d0
|
||
beq.s us5
|
||
addq.l #1,a0
|
||
addq.l #1,a2
|
||
bra.s us3
|
||
us5: move.b (a1),d0
|
||
beq.s us6
|
||
cmp.b #".",d0 trouve le point de la chaine a formatter
|
||
beq.s us6 ou la fin
|
||
cmp.b #"E",d0
|
||
beq.s us6
|
||
addq.l #1,a1
|
||
bra.s us5
|
||
us6: movem.l a0-a3,-(sp)
|
||
; ecris la gauche du chiffre
|
||
us7: cmp.l d7,a2 fini a gauche???
|
||
beq us15
|
||
move.b -(a2),d0
|
||
cmp.b #"#",d0
|
||
beq.s us8
|
||
cmp.b #"-",d0
|
||
beq.s us11
|
||
cmp.b #"+",d0
|
||
beq.s us12
|
||
move.b d0,-(a0) aucun signe reserve: le met simplement!
|
||
bra.s us7
|
||
us8: cmp.l d6,a1 -----> "#"
|
||
bne.s us10
|
||
us9: move.b #" ",-(a0) arrive au debut du chiffre!
|
||
bra.s us7
|
||
us10: move.b -(a1),d0
|
||
cmp.b #"0",d0 pas un chiffre (signe)
|
||
bcs.s us9
|
||
cmp.b #"9",d0
|
||
bhi.s us9
|
||
move.b d0,-(a0) OK, chiffre: poke!
|
||
bra.s us7
|
||
us11: move.l d6,a3 -----> "-"
|
||
move.b (a3),-(a0) met le "signe": 32 ou "-"
|
||
bra.s us7
|
||
us12: move.l d6,a3
|
||
move.b (a3),d0
|
||
cmp.b #"-",d0
|
||
beq.s us13
|
||
move.b #"+",d0
|
||
us13: move.b d0,-(a0) -----> "+"
|
||
bra us7
|
||
; ecrit la droite du chiffre
|
||
us15: movem.l (sp)+,a0-a3 recupere les adresses pivot
|
||
clr.l d2 flag puissance
|
||
cmp.b #".",(a1) saute le point dans le chiffre a afficher
|
||
bne.s us16
|
||
addq.l #1,a1
|
||
us16: move.b (a2)+,d0
|
||
beq sp11 fini OUF!
|
||
cmp.b #";",d0 ";" marque la virgule sans l'ecrire!
|
||
beq.s us18z
|
||
cmp.b #"#",d0
|
||
beq.s us17
|
||
cmp.b #"^",d0
|
||
beq.s us20
|
||
move.b d0,(a0)+ ne correspond a rien: POKE!
|
||
bra.s us16
|
||
us17: move.b (a1),d0 -----> "#"
|
||
bne.s us19
|
||
us18: tst d2
|
||
beq.s us18a
|
||
us18z: move.b #" ",(a0)+ si puissance passee: met des espaces
|
||
bra.s us16
|
||
us18a: move.b #"0",(a0)+ Fin du chiffre: met un zero apres la virgule
|
||
bra.s us16
|
||
us19: cmp.b #"0",d0
|
||
bcs.s us18
|
||
cmp.b #"9",d0
|
||
bhi.s us18
|
||
addq.l #1,a1
|
||
move.b d0,(a0)+
|
||
bra us16
|
||
us20: tst d2 -----> "^"
|
||
bmi.s us24
|
||
bne.s us25
|
||
us21: move.b (a1),d0
|
||
beq.s us22
|
||
cmp.b #"E",d0
|
||
beq.s us23
|
||
addq.l #1,a1
|
||
bra.s us21
|
||
us22: move #1,d2 pas de puissance: en fabrique une!
|
||
bra.s us25
|
||
us23: move #-1,d2
|
||
us24: move.b (a1),d0 si fin du chiffre: met des espaces
|
||
beq us18
|
||
addq.l #1,a1
|
||
cmp.b #32,d0 saute l'espace entre E et +/-
|
||
beq.s us24
|
||
move.b d0,(a0)+
|
||
bra us16
|
||
us25: move.l a3,-(sp)
|
||
lea UsPuiss(pc),a3
|
||
move.b -1(a3,d2.w),(a0)+ met une fausse puissance!
|
||
move.l (sp)+,a3
|
||
cmp.b #6,d2
|
||
beq us16
|
||
addq #1,d2
|
||
bra us16
|
||
|
||
; PRINT USING POUR DES CHAINES +++facile
|
||
using50:tst UsingFlg(a5) si pas using, va imprimer
|
||
beq sp11
|
||
move.l a2,-(sp)
|
||
clr.b (a0) stoppe la chaine
|
||
move.l Buffer(a5),a0
|
||
lea 128(a0),a1
|
||
moveq #127,d0
|
||
us51: move.b (a0)+,(a1)+ recopie la chaine, et fait le menage!!!
|
||
dbra d0,us51
|
||
move.l Buffer(a5),a0
|
||
lea 128(a0),a1 a1 pointe la chaine
|
||
lea 128(a1),a2 a2 pointe la chaine de definition
|
||
; ecris la chaine dans le buffer
|
||
us52: move.b (a2)+,d0
|
||
beq.s us55 fini!
|
||
cmp.b #"~",d0
|
||
beq.s us53
|
||
move.b d0,(a0)+
|
||
bra.s us52
|
||
us53: move.b (a1),d0 ----> "~"
|
||
bne.s us54
|
||
move.b #32,(a0)+
|
||
bra.s us52
|
||
us54: addq.l #1,a1
|
||
move.b d0,(a0)+
|
||
bra.s us52
|
||
us55: move.l (sp)+,a2
|
||
bra sp11
|
||
UsPuiss dc.b "E+000 "
|
||
even
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Pour le compilateur
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def PrintE
|
||
Lib_Def PrintF
|
||
Lib_Def PrintS
|
||
Lib_Def PrintX
|
||
Lib_Def LPrintX
|
||
Lib_Def CRPrint
|
||
Lib_Def HPrintS
|
||
Lib_Def PrtRet
|
||
Lib_Def PrtVir
|
||
Lib_Def HPrintX
|
||
Lib_Def UsingC
|
||
Lib_Def UsingS
|
||
; - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Source: Ecrans.s
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; DEFAULT PALETTE
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InDefaultPalette
|
||
; - - - - - - - - - - - - -
|
||
lea DefPal(a5),a0
|
||
bsr Plt
|
||
rts
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; PALETTE
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InPalette
|
||
; - - - - - - - - - - - - -
|
||
tst.w ScOn(a5)
|
||
beq ScNOp
|
||
moveq #15,d0
|
||
move.l Buffer(a5),a0
|
||
move.l a0,a1
|
||
Pal1: move.l #-1,(a1)+
|
||
dbra d0,Pal1
|
||
bsr Plt
|
||
EcCall SPal
|
||
bne EcWiErr
|
||
rts
|
||
|
||
* Routine palette
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def Plt
|
||
; - - - - - - - - - - - - -
|
||
Plt: move.l a0,-(sp)
|
||
bsr New_Evalue
|
||
subq.b #1,d2
|
||
bmi.s Plt1
|
||
Rjsrt L_IntToFl1
|
||
Plt1: move.l (sp)+,a0
|
||
tst.l d3
|
||
bmi.s Plt2
|
||
and.w #$FFF,d3
|
||
move.w d3,(a0)
|
||
Plt2: addq.l #2,a0
|
||
move.w (a6)+,d0
|
||
cmp.w #_TkVir,d0
|
||
beq.s Plt
|
||
subq.l #2,a6
|
||
move.l Buffer(a5),a1
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; FADE
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def InFade1
|
||
Lib_Def InFade2
|
||
Lib_Def InFade3
|
||
Lib_Def InFadePal
|
||
Lib_Par InFade
|
||
; - - - - - - - - - - - - -
|
||
bsr New_Expentier
|
||
move.l d3,-(a3)
|
||
move.w (a6),d0
|
||
cmp.w #_TkTo,d0
|
||
beq.s IFaTo
|
||
cmp.w #_TkVir,d0
|
||
beq.s IFaPal
|
||
* FADE n
|
||
move.l Buffer(a5),a0
|
||
move.l a0,a1
|
||
moveq #31,d0
|
||
IFad0 clr.w (a0)+
|
||
dbra d0,IFad0
|
||
bra.s IFadT
|
||
* FADE TO
|
||
IFaTo bsr Fn_New_Expentier
|
||
tst.l d3
|
||
bpl.s IFat1
|
||
Rjsr L_Bnk.GetBobs <0 -->> sprite palette
|
||
beq BkNoRes
|
||
move.w (a0)+,d0
|
||
lsl.w #3,d0
|
||
lea 0(a0,d0.w),a0
|
||
bra.s IFat2
|
||
IFat1 move.l d3,d1 * Dans un ecran
|
||
Rjsr L_GetEc
|
||
lea EcPal(a0),a0
|
||
IFat2 moveq #-1,d3
|
||
cmp.w #_TkVir,(a6)
|
||
bne.s IFat3
|
||
move.l a0,-(sp)
|
||
bsr Fn_New_Expentier
|
||
move.l (sp)+,a0
|
||
IFat3 Rjsr L_PalRout
|
||
bra.s IFadT
|
||
* FADE palette
|
||
IFaPal moveq #15,d0
|
||
move.l Buffer(a5),a0
|
||
move.l a0,a1
|
||
IFap move.l #-1,(a1)+
|
||
dbra d0,IFap
|
||
addq.l #2,a6
|
||
bsr Plt
|
||
* Appelle!
|
||
IFadT tst.w ScOn(a5)
|
||
beq ScNOp
|
||
move.l (a3)+,d1
|
||
bls FonCall
|
||
EcCall FadeOn
|
||
bne FonCall
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; POLYLINE
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InPolyline
|
||
; - - - - - - - - - - - - -
|
||
tst.w ScOn(a5)
|
||
beq ScNOp
|
||
clr.w -(sp)
|
||
move.l T_RastPort(a5),a1
|
||
move.l Buffer(a5),a2
|
||
cmp.w #_TkTo,(a6)
|
||
bne.s PLi1
|
||
move.w 36(a1),d0
|
||
move.w 38(a1),d1
|
||
bra.s PLi2
|
||
PLi1: movem.l a1/a2,-(sp)
|
||
bsr New_Expentier
|
||
move.l d3,-(a3)
|
||
bsr Fn_New_Expentier
|
||
movem.l (sp)+,a1/a2
|
||
move.l d3,d1
|
||
move.l (a3)+,d0
|
||
PLi2: move.w d0,(a2)+
|
||
move.w d1,(a2)+
|
||
addq.w #1,(sp)
|
||
cmp.w #_TkTo,(a6)+
|
||
beq.s PLi1
|
||
subq.l #2,a6
|
||
move.w (sp)+,d0
|
||
cmp.w #1,d0
|
||
bls FonCall
|
||
move.l Buffer(a5),a0
|
||
move.w (a0),36(a1)
|
||
move.w 2(a0),38(a1)
|
||
move.w #PolyDraw,d5
|
||
Rjsr L_GfxFunc
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; POLYGON
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InPolygon
|
||
; - - - - - - - - - - - - -
|
||
tst.w ScOn(a5)
|
||
beq ScNOp
|
||
|
||
; Initialise le buffer AREADRAW
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
lea AAreaInfo(a5),a0
|
||
lea AAreaBuf(a5),a1
|
||
moveq #AAreaSize,d0
|
||
move.l T_RastPort(a5),a2
|
||
move.l a0,16(a2)
|
||
GfxCa5 InitArea
|
||
|
||
move.l T_RastPort(a5),a1
|
||
move.l Buffer(a5),a2
|
||
cmp.w #_TkTo,(a6)
|
||
bne.s PGi0
|
||
addq.l #2,a6
|
||
move.w 36(a1),d0
|
||
move.w 38(a1),d1
|
||
bra.s PGi1
|
||
PGi0: move.l a1,-(sp)
|
||
bsr New_Expentier
|
||
move.l d3,-(a3)
|
||
bsr Fn_New_Expentier
|
||
move.l (sp)+,a1
|
||
addq.l #2,a6
|
||
move.l d3,d1
|
||
move.l (a3)+,d0
|
||
PGi1: GfxCa5 AreaMove
|
||
PGi2: move.l a1,-(sp)
|
||
bsr New_Expentier
|
||
move.l d3,-(a3)
|
||
bsr Fn_New_Expentier
|
||
move.l (sp)+,a1
|
||
move.l d3,d1
|
||
move.l (a3)+,d0
|
||
GfxCa5 AreaDraw
|
||
cmp.w #_TkTo,(a6)+
|
||
beq.s PGi2
|
||
subq.l #2,a6
|
||
FinRas Rjsr L_GetRas
|
||
GfxCa5 AreaEnd
|
||
Rjsr L_FreeRas
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Source: Sprite.s
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; CHANNEL x TO SPRITE x
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def ChannelToSprite
|
||
Lib_Def ChannelToBob
|
||
Lib_Def ChannelToSDisplay
|
||
Lib_Def ChannelToSSize
|
||
Lib_Def ChannelToSOffset
|
||
Lib_Def ChannelToRainbow
|
||
; - - - - - - - - - - - - -
|
||
Lib_Par InChannel
|
||
; - - - - - - - - - - - - -
|
||
bsr New_Expentier
|
||
cmp.l #64,d3
|
||
bcc FonCall
|
||
addq.l #2,a6
|
||
move.w (a6)+,d0
|
||
moveq #0,d4 * 0-> Sprites
|
||
moveq #64,d5
|
||
cmp.w #_TkSpr,d0
|
||
beq.s ChaX
|
||
addq.w #1,d4 * 1-> Bobs
|
||
moveq #64,d5
|
||
cmp.w #_TkBob,d0
|
||
beq.s ChaX
|
||
addq.w #1,d4 * 2-> Screen display
|
||
moveq #8,d5
|
||
cmp.w #_TkScD,d0
|
||
beq.s ChaX
|
||
addq.w #1,d4 * 3-> Screen size
|
||
cmp.w #_TkScS,d0
|
||
beq.s ChaX
|
||
addq.w #1,d4 * 4-> Screen offset
|
||
cmp.w #_TkScO,d0
|
||
beq.s ChaX
|
||
addq.w #2,d4 * 6-> Rainbow
|
||
moveq #4,d5
|
||
ChaX: movem.l d3-d5,-(sp)
|
||
bsr New_Expentier
|
||
move.l d3,d2
|
||
movem.l (sp)+,d3-d5
|
||
cmp.l d5,d2
|
||
bcc FonCall
|
||
lsl.w #1,d3
|
||
lea AnCanaux(a5),a0
|
||
move.b d4,0(a0,d3.w) * 1 => TYPE
|
||
move.b d2,1(a0,d3.w) * 2 => NUMERO
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Source: memory.s
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; BSET / BTST / BCHG / BCLR
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InBset
|
||
; - - - - - - - - - - - - -
|
||
IBset: bsr BsRout
|
||
bmi.s IBs1
|
||
move.l (a0),d1
|
||
bset d0,d1
|
||
move.l d1,(a0)
|
||
rts
|
||
IBs1: bset d0,(a0)
|
||
rts
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InBset1
|
||
; - - - - - - - - - - - - -
|
||
; - - - - - - - - - - - - -
|
||
Lib_Par InBclr
|
||
; - - - - - - - - - - - - -
|
||
bsr BsRout
|
||
bmi.s IBc1
|
||
move.l (a0),d1
|
||
bclr d0,d1
|
||
move.l d1,(a0)
|
||
rts
|
||
IBc1: bclr d0,(a0)
|
||
rts
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InBclr1
|
||
; - - - - - - - - - - - - -
|
||
; - - - - - - - - - - - - -
|
||
Lib_Par InBchg
|
||
; - - - - - - - - - - - - -
|
||
bsr BsRout
|
||
bmi.s IBh1
|
||
move.l (a0),d1
|
||
bchg d0,d1
|
||
move.l d1,(a0)
|
||
rts
|
||
IBh1: bchg d0,(a0)
|
||
rts
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InBchg1
|
||
; - - - - - - - - - - - - -
|
||
; - - - - - - - - - - - - -
|
||
Lib_Par FnBtst
|
||
; - - - - - - - - - - - - -
|
||
addq.w #2,a6
|
||
bsr BsRout
|
||
bmi.s IBt1
|
||
move.l (a0),d1
|
||
btst d0,d1
|
||
bne.s IbtT
|
||
bra.s IbtF
|
||
IBt1: btst d0,(a0)
|
||
bne.s IbtT
|
||
IbtF: moveq #0,d3
|
||
Ret_Int
|
||
IbtT: moveq #-1,d3
|
||
Ret_Int
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def FnBtst1
|
||
; - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; ROR ROL
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InRorB
|
||
; - - - - - - - - - - - - -
|
||
bsr BsRout
|
||
bmi.s Brr1
|
||
move.b 3(a0),d1
|
||
ror.b d0,d1
|
||
move.b d1,3(a0)
|
||
rts
|
||
Brr1: move.b (a0),d1
|
||
ror.b d0,d1
|
||
move.b d1,(a0)
|
||
rts
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InRorB1
|
||
; - - - - - - - - - - - - -
|
||
; - - - - - - - - - - - - -
|
||
Lib_Par InRorW
|
||
; - - - - - - - - - - - - -
|
||
bsr BsRout
|
||
bmi.s Wrr1
|
||
move.w 2(a0),d1
|
||
ror.w d0,d1
|
||
move.w d1,2(a0)
|
||
rts
|
||
Wrr1: move.w (a0),d1
|
||
ror.w d0,d1
|
||
move.w d1,(a0)
|
||
rts
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InRorW1
|
||
; - - - - - - - - - - - - -
|
||
; - - - - - - - - - - - - -
|
||
Lib_Par InRorL
|
||
; - - - - - - - - - - - - -
|
||
bsr BsRout
|
||
bmi.s Lrr1
|
||
move.l (a0),d1
|
||
ror.l d0,d1
|
||
move.l d1,(a0)
|
||
rts
|
||
Lrr1: move.l (a0),d1
|
||
ror.l d0,d1
|
||
move.l d1,(a0)
|
||
rts
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InRorL1
|
||
; - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - -
|
||
Lib_Par InRolB
|
||
; - - - - - - - - - - - - -
|
||
bsr BsRout
|
||
bmi.s Brl1
|
||
move.b 3(a0),d1
|
||
rol.b d0,d1
|
||
move.b d1,3(a0)
|
||
rts
|
||
Brl1: move.b (a0),d1
|
||
rol.b d0,d1
|
||
move.b d1,(a0)
|
||
rts
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InRolB1
|
||
; - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - -
|
||
Lib_Par InRolW
|
||
; - - - - - - - - - - - - -
|
||
bsr BsRout
|
||
bmi.s Wrl1
|
||
move.w 2(a0),d1
|
||
rol.w d0,d1
|
||
move.w d1,2(a0)
|
||
rts
|
||
Wrl1: move.w (a0),d1
|
||
rol.w d0,d1
|
||
move.w d1,(a0)
|
||
rts
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InRolW1
|
||
; - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - -
|
||
Lib_Par InRolL
|
||
; - - - - - - - - - - - - -
|
||
bsr BsRout
|
||
bmi.s Lrl1
|
||
move.l (a0),d1
|
||
rol.l d0,d1
|
||
move.l d1,(a0)
|
||
rts
|
||
Lrl1: move.l (a0),d1
|
||
rol.l d0,d1
|
||
move.l d1,(a0)
|
||
rts
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InRolL1
|
||
; - - - - - - - - - - - - -
|
||
|
||
******* Routine: ramene l'adresse a affecter!
|
||
BsRout bsr New_Expentier
|
||
tst.l d3
|
||
bmi FonCall
|
||
addq.w #2,a6
|
||
cmp.w #_TkVar,(a6)
|
||
beq.s BsR1
|
||
* Une adresse
|
||
bset #31,d3
|
||
move.l d3,-(a3)
|
||
bsr New_Expentier
|
||
move.l d3,a0
|
||
move.l (a3)+,d0
|
||
rts
|
||
* Une variable
|
||
BsR1 move.l a6,-(sp)
|
||
move.l d3,-(a3)
|
||
bsr FindVar
|
||
cmp.w #_TkPar2,(a6)+
|
||
beq.s BsR2
|
||
subq.l #2,a6
|
||
bsr Finie
|
||
bne.s BsR3
|
||
BsR2 addq.l #4,sp
|
||
move.l (a3)+,d0
|
||
rts
|
||
* He non! Une adresse!
|
||
BsR3 move.l (sp)+,a6
|
||
bsr New_Expentier
|
||
move.l d3,a0
|
||
move.l (a3)+,d0
|
||
moveq #-1,d1
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; CALL PROCEDURE LANGAGE MACHINE
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par In_apml_
|
||
; - - - - - - - - - - - - -
|
||
; Des parametres <20> empiler?
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
move.w (a6)+,d0
|
||
beq.s .PaPar
|
||
moveq #0,d1
|
||
lea -2+2(a6,d0.w),a2
|
||
.PaL move.w (a2)+,d0
|
||
bmi.s .Glo
|
||
move.l VarLoc(a5),a0
|
||
lea 2(a0,d0.w),a0
|
||
.Glo2 move.l (a0),-(a3)
|
||
move.b (a2)+,d1
|
||
lea 1(a2,d1.w),a2
|
||
cmp.w #_TkVir,(a2)+
|
||
addq.l #2,a2
|
||
beq.s .PaL
|
||
; Appelle la routine
|
||
; ~~~~~~~~~~~~~~~~~~
|
||
.PaPar movem.l a3-a6/d6-d7,-(sp)
|
||
lea CallReg(a5),a4
|
||
move.l a4,-(sp)
|
||
movem.l (a4),d0-d7/a0-a2
|
||
jsr (a6)
|
||
.Return move.l (sp)+,a4
|
||
movem.l d0-d7/a0-a2,(a4)
|
||
movem.l (sp)+,a3-a6/d6-d7
|
||
move.l d0,ParamE(a5)
|
||
bra PopP
|
||
; Si variable globale
|
||
.Glo move.l VarGlo(a5),a0
|
||
neg.w d0
|
||
lea 1(a0,d0.w),a0
|
||
bra.s .Glo2
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; CALL
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InCall
|
||
; - - - - - - - - - - - - -
|
||
bsr New_Expentier
|
||
move.l d3,d0
|
||
Rjsr L_Bnk.OrAdr
|
||
move.l a0,-(sp)
|
||
; Evalue les params!
|
||
.Loop cmp.w #_TkVir,(a6)
|
||
bne.s .Call
|
||
addq.l #2,a6
|
||
bsr New_Expentier
|
||
move.l d3,-(a3)
|
||
bra.s .Loop
|
||
; Appel
|
||
.Call move.l (sp)+,a0
|
||
movem.l d6-d7/a3-a6,-(sp)
|
||
move.l a0,a4
|
||
lea CallReg(a5),a6
|
||
move.l a6,-(sp)
|
||
movem.l (a6),d0-d7/a0-a2
|
||
jsr (a4)
|
||
.Return move.l (sp)+,a6
|
||
movem.l d0-d7/a0-a2,(a6)
|
||
movem.l (sp)+,d6-d7/a3-a6
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; =LVO =EQU
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par FnEqu
|
||
; - - - - - - - - - - - - -
|
||
move.l (a6),d3
|
||
moveq #0,d2
|
||
move.w 6+2+2(a6),d0
|
||
move.w d0,d1
|
||
and.w #1,d1
|
||
add.w d1,d0
|
||
lea 6+2+4+2(a6,d0.w),a6
|
||
Ret_Int
|
||
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; =STRUC=
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InStruc
|
||
; - - - - - - - - - - - - -
|
||
bsr GStruc
|
||
movem.l a0/d0/d1,-(sp)
|
||
addq.l #2,a6
|
||
bsr New_Expentier
|
||
movem.l (sp)+,a0/d0/d1
|
||
lsl.w #1,d0
|
||
jmp .Jmp(pc,d0.w)
|
||
.Jmp bra.s .Byte
|
||
bra.s .Word
|
||
bra.s .Long
|
||
bra.s .Byte
|
||
bra.s .Word
|
||
bra.s .Long
|
||
bra.s .Long
|
||
.Byte move.b d0,(a0)
|
||
rts
|
||
.Word btst #0,d1
|
||
bne AdrErr
|
||
move.w d3,(a0)
|
||
rts
|
||
.Long btst #0,d1
|
||
bne AdrErr
|
||
move.l d3,(a0)
|
||
rts
|
||
; - - - - - - - - - - - - -
|
||
Lib_Par FnStruc
|
||
; - - - - - - - - - - - - -
|
||
bsr GStruc
|
||
moveq #0,d3
|
||
lsl.w #1,d0
|
||
jmp .Jmp(pc,d0.w)
|
||
.Jmp bra.s .Byte
|
||
bra.s .Word
|
||
bra.s .Long
|
||
bra.s .UByte
|
||
bra.s .UWord
|
||
bra.s .ULong
|
||
bra.s .ULong
|
||
.Byte move.b (a0),d3
|
||
ext.w d3
|
||
ext.l d3
|
||
Ret_Int
|
||
.Word btst #0,d1
|
||
bne AdrErr
|
||
move.w (a0),d3
|
||
ext.l d3
|
||
Ret_Int
|
||
.Long btst #0,d1
|
||
bne AdrErr
|
||
move.l (a0),d3
|
||
Ret_Int
|
||
.UByte move.b (a0),d3
|
||
Ret_Int
|
||
.UWord btst #0,d1
|
||
bne AdrErr
|
||
move.w (a0),d3
|
||
Ret_Int
|
||
.ULong btst #0,d1
|
||
bne AdrErr
|
||
move.l (a0),d3
|
||
Ret_Int
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; =STRUC$=
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InStrucD
|
||
; - - - - - - - - - - - - -
|
||
bsr GStruc
|
||
btst #0,d1
|
||
bne AdrErr
|
||
clr.l (a0)
|
||
move.l a0,-(sp)
|
||
bsr Fn_New_Evalue
|
||
move.l d3,a2
|
||
move.w (a2)+,d2
|
||
cmp.l #"|00|",(a2)
|
||
beq.s .Skp
|
||
moveq #2,d3
|
||
add.w d2,d3
|
||
bsr Demande
|
||
lea 2(a0,d3.w),a0
|
||
move.w a0,d0
|
||
and.w #1,d0
|
||
add.w d0,a0
|
||
move.l a0,HiChaine(a5)
|
||
move.l (sp)+,a0
|
||
move.l a1,(a0)
|
||
move.w d2,(a1)
|
||
addq.w #1,(a1)+
|
||
subq.w #1,d2
|
||
bmi.s .Skp
|
||
.Lop move.b (a2)+,(a1)+
|
||
dbra d2,.Lop
|
||
clr.b (a1)
|
||
.Skp rts
|
||
; - - - - - - - - - - - - -
|
||
Lib_Par FnStrucD
|
||
; - - - - - - - - - - - - -
|
||
bsr GStruc
|
||
btst #0,d1
|
||
bne AdrErr
|
||
move.l (a0),d0
|
||
beq.s .Vide
|
||
move.l d0,a0
|
||
Rjsr L_A0ToChaine
|
||
move.l a0,d3
|
||
Ret_String
|
||
.Vide Rjmp L_Ret_ChVide
|
||
; Routine de saisie des parametres
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
GStruc move.l (a6)+,-(sp) Equate
|
||
move.w (a6)+,-(sp) Type
|
||
addq.l #2,a6 Saute (
|
||
bsr New_Expentier Adresse de base
|
||
move.w 2+2(a6),d0 Saute la chaine et la )
|
||
move.w d0,d1
|
||
and.w #1,d1
|
||
add.w d1,d0
|
||
lea 2+4+2(a6,d0.w),a6
|
||
move.w (sp)+,d0
|
||
lsr.w #8,d0
|
||
move.l d3,d1
|
||
add.l (sp)+,d1
|
||
move.l d1,a0 Adresse resultante
|
||
rts
|
||
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Source: String.s
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Demande de l'espace pour les chaines
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def Demande
|
||
Demande
|
||
; - - - - - - - - - - - - -
|
||
move.l HiChaine(a5),a0
|
||
move.l a0,a1
|
||
add.l d3,a1
|
||
addq.l #4,a1
|
||
cmp.l TabBas(a5),a1
|
||
bcc.s dem1
|
||
move.l a0,a1
|
||
rts
|
||
; Va faire le menage
|
||
dem1 tst.b ErrorRegs(a5) Recharger les registres?
|
||
beq.s .NoReg
|
||
movem.l ErrorSave(a5),d6-d7
|
||
.NoReg Rbsr L_Menage Va faire le menage
|
||
; Ca marche maintenant?
|
||
move.l HiChaine(a5),a1 Ca marche maintenant?
|
||
add.l d3,a1
|
||
addq.l #4,a1
|
||
cmp.l TabBas(a5),a1
|
||
bcc FinMenE
|
||
; Ca a marche, un patch?
|
||
tst.l Patch_Menage(a5)
|
||
bne.s dem3
|
||
move.l d7,d0 Ou en est-ton?
|
||
bmi.s Demande Menage simple: ca va revenir!
|
||
beq.s FinMenE Deux fois sur la meme instruction
|
||
; Rebranche au debut de l'instruction
|
||
move.l PLoop(a5),a3
|
||
move.l BasSp(a5),sp
|
||
move.l Prg_InsRet(a5),-(sp)
|
||
move.l d7,a6
|
||
move.l d7,MenA4(a5)
|
||
moveq #0,d7 Signal pour nouveau menage
|
||
movem.l d6-d7,ErrorSave(a5) Au cas zou!
|
||
IFNE Debug
|
||
movem.l d6/d7,Chr_Debug+4(a5)
|
||
ENDC
|
||
move.w -2(a6),d0
|
||
move.w 0(a4,d0.w),d1 Pointe la table de tokens
|
||
move.l -LB_Size(a4,d1.w),a0
|
||
jmp (a0) Rebranche
|
||
; Branche au patch
|
||
dem3 move.l Patch_Menage(a5),a0
|
||
jmp (a0)
|
||
; Erreur: out of string space!
|
||
FinMenE move.l d7,d0 A4>0
|
||
bgt OOfBuf
|
||
move.l MenA4(a5),d7 Non, charge l'instruction
|
||
bra OOfBuf
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Demande chaine sans erreur
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def DDemande
|
||
DDemande
|
||
; - - - - - - - - - - - - -
|
||
move.l d7,MenA4(a5)
|
||
moveq #-1,d7
|
||
movem.l d6-d7,ErrorSave(a5)
|
||
IFNE Debug
|
||
movem.l d6/d7,Chr_Debug+4(a5)
|
||
ENDC
|
||
bsr Demande
|
||
move.l MenA4(a5),d7
|
||
movem.l d6-d7,ErrorSave(a5)
|
||
IFNE Debug
|
||
movem.l d6/d7,Chr_Debug+4(a5)
|
||
ENDC
|
||
rts
|
||
|
||
|
||
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; MENAGE ALPHANUMERIQUE
|
||
; Taille maximum chaine: 65472 ($FFC0)
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def Menage
|
||
; - - - - - - - - - - - - -
|
||
movem.l d1-d7/a2-a6,-(sp)
|
||
|
||
IFNE Debug>1
|
||
movem.l d0-d7/a0-a6,-(sp)
|
||
moveq #70,d3
|
||
JJsrIns L_InBell1,1
|
||
movem.l (sp)+,d0-d7/a0-a6
|
||
ENDC
|
||
IFNE Debug>1
|
||
Rjsr L_PreBug
|
||
ENDC
|
||
|
||
******* Essaie de proceder <EFBFBD> un FAST-MENAGE!
|
||
move.l HiChaine(a5),d7
|
||
move.l LoChaine(a5),d6
|
||
move.l d7,d0
|
||
sub.l d6,d0
|
||
cmp.l #$3FFFFE*2,d0 8 Megas maximum!
|
||
bcc SLOW_MENAGE
|
||
move.l d0,d5
|
||
SyCall MemFast
|
||
beq SLOW_MENAGE
|
||
|
||
*********************************************************************
|
||
FAST_MENAGE
|
||
move.l a0,a4
|
||
move.l a0,a2
|
||
clr.w (a2)+
|
||
FfMen0 move.l VarLoc(a5),a6 ;Debut des variables
|
||
moveq #-1,d2 ;Maxi dans le tableau
|
||
; Rempli la table intermediaire
|
||
FfMen1 moveq #0,d4
|
||
.Loop move.w (a6)+,d0 Prend le flag
|
||
beq.s .Loop Nul: non initialise!
|
||
bmi.s .Proc Negatif: fin de chunk
|
||
.Var btst #1,d0 Une chaine?
|
||
bne.s .Alpha
|
||
lsr.w #8,d0 Recupere la taille
|
||
add.w d0,a6
|
||
move.w (a6)+,d0 Suivante
|
||
beq.s .Loop
|
||
bpl.s .Var
|
||
.Proc move.l (a6),d0 Chunk suivant
|
||
beq FfMenX Le dernier?
|
||
move.l d0,a6 Non, on boucle!
|
||
bra.s .Loop
|
||
; Variable alphanumerique
|
||
.Alpha move.l a6,a3
|
||
move.l (a6)+,d1
|
||
beq.s .Loop Non initialise!
|
||
btst #6,d0 Un tableau?
|
||
beq.s FfMen4
|
||
move.l d1,a3 Un tableau!
|
||
moveq #0,d0
|
||
move.b (a3)+,d0 Nombre de dimensions
|
||
addq.l #1,a3 Taille des variables
|
||
subq.w #1,d0
|
||
moveq #1,d4
|
||
FfMen2 move.w (a3)+,d1 Calcule nombre de variable
|
||
addq.l #2,a3
|
||
addq.w #1,d1
|
||
mulu d1,d4
|
||
dbra d0,FfMen2
|
||
subq.l #1,d4
|
||
; Recopie la chaine dans le buffer intermediaire
|
||
FfMen4 move.l (a3),a0
|
||
cmp.l d6,a0 Dans le buffer?
|
||
bcs.s FfMenN
|
||
cmp.l d7,a0
|
||
bcc.s FfMenN
|
||
move.w (a0),d0 Chaine vide?
|
||
beq.s FfMenV
|
||
move.w d0,d1
|
||
and.w #$FFC0,d1 Chaine deja copiee?
|
||
cmp.w #$FFC0,d1
|
||
beq.s FfMenD Deja fait!
|
||
move.l a2,d2
|
||
sub.l a4,d2
|
||
move.l d2,d1
|
||
add.l d6,d1
|
||
move.l d1,(a3)+ Change le pointeur
|
||
move.w d0,(a2)+
|
||
addq.w #1,d0
|
||
lsr.w #1,d0
|
||
subq.w #1,d0
|
||
lea 2(a0),a1
|
||
FfMen5 move.w (a1)+,(a2)+
|
||
dbra d0,FfMen5
|
||
lsr.l #1,d2 / 2 car pair
|
||
or.l #$FFC00000,d2 Masque
|
||
move.l d2,(a0) Marque la chaine...
|
||
FfSuiv subq.l #1,d4
|
||
bpl.s FfMen4
|
||
bmi FfMen1
|
||
; Chaine deja copiee
|
||
FfMenD move.l (a0),d0
|
||
and.l #$003FFFFF,d0
|
||
lsl.l #1,d0
|
||
add.l d6,d0
|
||
move.l d0,(a3)+
|
||
bra.s FfSuiv
|
||
; Chaine vide
|
||
FfMenV move.l ChVide(a5),(a3)+
|
||
bra.s FfSuiv
|
||
; Chaine en dehors du buffer
|
||
FfMenN addq.l #4,a3
|
||
bra.s FfSuiv
|
||
; Recopie le tout dans le buffer
|
||
FfMenX move.l a4,a0
|
||
move.l d6,a1
|
||
FfMenX1 move.w (a0)+,(a1)+
|
||
cmp.l a2,a0
|
||
bcs.s FfMenX1
|
||
move.l a1,HiChaine(a5)
|
||
; Libere le buffer temporaire
|
||
move.l a4,a1
|
||
move.l d5,d0
|
||
SyCall MemFree
|
||
bra FinMenS
|
||
*********************************************************************
|
||
SLOW_MENAGE
|
||
* Reserve la memoire, ou prend le BUFFER si rien du tout!!!
|
||
move.l #TMenage+16,d0
|
||
SyCall MemFast
|
||
bne.s L47a
|
||
move.l #-1,BMenage(a5)
|
||
move.l Buffer(a5),d5
|
||
bra.s L47b
|
||
L47a move.l a0,BMenage(a5)
|
||
move.l a0,d5
|
||
* Menage
|
||
L47b move.l d5,d6
|
||
add.l #TMenage,d6 ;Fin TI
|
||
move.l LoChaine(a5),d7 ;Ad mini de recopie
|
||
move.l HiChaine(a5),a4 ;Ad maxi des chaines!
|
||
addq.l #2,d7 ;Chaine vide
|
||
move.l d7,a1 ;Si ya pas de variable!
|
||
|
||
Men0: move.l VarLoc(a5),a6 ;Debut des variables
|
||
moveq #-1,d2 ;Maxi dans le tableau
|
||
moveq #0,d4 ;Cpt tableau---> 0
|
||
move.l d5,d3 ;Rien dans la TI
|
||
move.l d3,a0
|
||
move.l #$7fffffff,(a0)
|
||
; Rempli la table intermediaire
|
||
Men1
|
||
.Loop move.w (a6)+,d0 Prend le flag
|
||
beq.s .Loop Nul: non initialise!
|
||
bmi.s .Proc Negatif: fin de chunk
|
||
.Var btst #1,d0 Une chaine?
|
||
bne.s .Alpha
|
||
lsr.w #8,d0 Recupere la taille
|
||
add.w d0,a6
|
||
move.w (a6)+,d0 Suivante
|
||
beq.s .Loop
|
||
bpl.s .Var
|
||
.Proc move.l (a6),d0 Chunk suivant
|
||
beq Men20 Le dernier?
|
||
move.l d0,a6 Non, on boucle!
|
||
bra.s .Loop
|
||
; Variable alphanumerique
|
||
.Alpha move.l a6,a3
|
||
move.l (a6)+,d1 Initialise?
|
||
beq.s Men1
|
||
btst #6,d0
|
||
beq.s Men4
|
||
move.l d1,a3
|
||
moveq #0,d0
|
||
move.b (a3)+,d0
|
||
addq.l #1,a3
|
||
subq.w #1,d0
|
||
moveq #1,d4
|
||
Men2: move.w (a3)+,d1 Calcule nombre de variable
|
||
addq.l #2,a3
|
||
addq.w #1,d1
|
||
mulu d1,d4
|
||
dbra d0,Men2
|
||
Men3: subq.l #1,d4
|
||
; Essai de poker dans la TI
|
||
Men4: move.l (a3),d0
|
||
cmp.l d7,d0 ;< au minimum?
|
||
bcs.s Men10
|
||
cmp.l a4,d0 ;Dans le source?
|
||
bcc.s Men10
|
||
cmp.l d2,d0 ;>= au maximum?
|
||
bcc.s Men10
|
||
move.l d5,a0
|
||
Men6: cmp.l (a0),d0
|
||
lea 8(a0),a0
|
||
bcc.s Men6
|
||
cmp.l d6,a0
|
||
bne.s Men7
|
||
move.l d0,d2 ;C'est le dernier element!
|
||
move.l d6,d3
|
||
bra.s Men9
|
||
Men7: move.l d3,a1 ;Decale les adresses au dessus
|
||
cmp.l d6,d3
|
||
bcs.s Men7a
|
||
lea -8(a1),a1
|
||
move.l -8(a1),d2 ;Remonte la limite haute
|
||
bra.s Men8
|
||
Men7a: addq.l #8,d3
|
||
move.l #$7fffffff,8(a1)
|
||
Men8: move.l -(a1),8(a1)
|
||
move.l -(a1),8(a1)
|
||
cmp.l a0,a1
|
||
bcc.s Men8
|
||
Men9: move.l a3,-(a0) ;Poke dans la table
|
||
move.l d0,-(a0)
|
||
Men10: addq.l #4,a3
|
||
tst.l d4
|
||
bne.s Men3
|
||
beq Men1
|
||
|
||
; Recopie toutes les chaines du buffer
|
||
Men20: move.l d5,a3 ;Adresse TI
|
||
move.l d7,a1 ;Adresse de recopie
|
||
moveq #0,d7
|
||
Men21: cmp.l d3,a3 ;Fini-ni?
|
||
bcc.s Men26
|
||
move.l (a3),a0 ;Adresse de la chaine
|
||
lea 8(a3),a3
|
||
cmp.l a0,d7 ;Chaine deja bougee?
|
||
beq.s Men25
|
||
move.l a0,d7
|
||
cmp.l a0,a1 ;Au meme endroit?
|
||
bne.s Men22
|
||
; Les 2 chaines sont au meme endroit!
|
||
move.l a1,d1
|
||
moveq #0,d0
|
||
move.w (a1)+,d0
|
||
add.l d0,a1
|
||
move.w a1,d0
|
||
btst #0,d0
|
||
beq.s Men21
|
||
addq.l #1,a1
|
||
bra.s Men21
|
||
; Recopie la chaine
|
||
Men22: move.l -4(a3),a2 ;Change la variable
|
||
move.l a1,(a2)
|
||
move.l a1,d1
|
||
move.w (a0)+,d0 ;Recopie la chaine
|
||
beq.s Men24
|
||
move.w d0,(a1)+
|
||
subq.w #1,d0
|
||
lsr.w #1,d0
|
||
Men23: move.w (a0)+,(a1)+
|
||
dbra d0,Men23
|
||
bra.s Men21
|
||
; Chaine vide au milieu: pointe la vraie
|
||
Men24: move.l ChVide(a5),d1
|
||
move.l d1,(a2)
|
||
bra.s Men21
|
||
; La variable pointait la meme chaine que la precedente
|
||
Men25: move.l -4(a3),a2
|
||
move.l d1,(a2)
|
||
bra.s Men21
|
||
; Est-ce completement fini?
|
||
Men26: cmp.l d6,d3 ;Buffer TI rempli?
|
||
bcs.s FinMen ;NON---> c'est fini!
|
||
|
||
;-----> Reexplore les variables a la recherche de la DERNIERE CHAINE
|
||
move.l VarLoc(a5),a6 ;Table des ad strings
|
||
moveq #0,d4 ;Cpt tableau---> 0
|
||
move.l d1,d2 ;Feneant!
|
||
; Rempli la table intermediaire
|
||
Men31:
|
||
.Loop move.w (a6)+,d0 Prend le flag
|
||
beq.s .Loop Nul: non initialise!
|
||
bmi.s .Proc Negatif: fin de chunk
|
||
.Var btst #1,d0 Une chaine?
|
||
bne.s .Alpha
|
||
lsr.w #8,d0 Recupere la taille
|
||
add.w d0,a6
|
||
move.w (a6)+,d0 Suivante
|
||
beq.s .Loop
|
||
bpl.s .Var
|
||
.Proc move.l (a6),d0 Chunk suivant
|
||
beq Men40 Le dernier?
|
||
move.l d0,a6 Non, on boucle!
|
||
bra.s .Loop
|
||
; Variable alphanumerique
|
||
.Alpha move.l a6,a3
|
||
move.l (a6)+,d1
|
||
beq.s Men31
|
||
btst #6,d0
|
||
beq.s Men34
|
||
move.l d1,a3
|
||
moveq #0,d0
|
||
move.b (a3)+,d0
|
||
addq.l #1,a3
|
||
subq.w #1,d0
|
||
moveq #1,d4
|
||
Men32: move.w (a3)+,d1 ;Calcule nombre de variable
|
||
addq.l #2,a3
|
||
addq.w #1,d1
|
||
mulu d1,d4
|
||
dbra d0,Men32
|
||
Men33: subq.l #1,d4
|
||
; La variable pointe elle la meme chaine?
|
||
Men34: cmp.l (a3)+,d7
|
||
beq.s Men36
|
||
tst.l d4
|
||
bne.s Men33
|
||
beq.s Men31
|
||
Men36: move.l d2,-4(a3)
|
||
tst.l d4
|
||
bne.s Men33
|
||
beq.s Men31
|
||
|
||
;-----> Refait un tour!
|
||
Men40: move.l a1,d7 ;Monte la limite <
|
||
bra Men0
|
||
;-----> Menage fini!
|
||
FinMen move.l a1,HiChaine(a5)
|
||
; Libere la m<>moire
|
||
move.l BMenage(a5),d0
|
||
bmi.s Finm1
|
||
move.l d0,a1
|
||
move.l #TMenage+16,d0
|
||
SyCall MemFree
|
||
Finm1 clr.l BMenage(a5)
|
||
|
||
;-----> FIN DES DEUX MENAGES
|
||
FinMenS movem.l (sp)+,d1-d7/a2-a6
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; LEFT$=
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InLeft
|
||
; - - - - - - - - - - - - -
|
||
bsr RInMid
|
||
movem.l a2/d2,-(sp)
|
||
bsr Fn_New_Expentier
|
||
move.l d3,d4
|
||
moveq #0,d5
|
||
bra RInMid2
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Fonction LEFT$
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par FnLeft
|
||
; - - - - - - - - - - - - -
|
||
bsr FEnt_2
|
||
move.l d3,d4
|
||
move.l (a3)+,a2
|
||
moveq #0,d2
|
||
move.w (a2)+,d2
|
||
moveq #0,d5
|
||
bra RFnMid
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; =RIGHT$=
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InRight
|
||
; - - - - - - - - - - - - -
|
||
bsr RInMid
|
||
movem.l a2/d2,-(sp)
|
||
bsr Fn_New_Expentier
|
||
move.l d3,d4
|
||
bmi FonCall
|
||
move.l (sp),d2
|
||
moveq #0,d5
|
||
cmp.l d2,d4
|
||
bcc RInMid2
|
||
move.l d2,d5
|
||
sub.l d4,d5
|
||
addq.l #1,d5
|
||
bra RInMid2
|
||
; - - - - - - - - - - - - -
|
||
Lib_Par FnRight
|
||
; - - - - - - - - - - - - -
|
||
bsr FEnt_2
|
||
move.l d3,d5
|
||
bmi FonCall
|
||
move.l (a3)+,a2
|
||
moveq #0,d2
|
||
move.w (a2)+,d2
|
||
move.l #$ffff,d4
|
||
cmp.l d2,d5
|
||
bcs L73c
|
||
move.l d2,d5
|
||
L73c: neg.l d5
|
||
add.l d2,d5
|
||
addq.l #1,d5
|
||
bra RFnMid
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; MID$=
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InMid2
|
||
; - - - - - - - - - - - - -
|
||
bsr RInMid
|
||
movem.l a2/d2,-(sp)
|
||
bsr Fn_New_Expentier
|
||
move.l d3,d5
|
||
* addq.l #1,d5
|
||
move.l #$FFFF,d4
|
||
bra RInMid2
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par FnMid2
|
||
; - - - - - - - - - - - - -
|
||
bsr FEnt_2
|
||
move.l d3,d5
|
||
move.l (a3)+,a2
|
||
moveq #0,d2
|
||
move.w (a2)+,d2
|
||
move.l #$FFFF,d4
|
||
bra RFnMid
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; =MID$() 3 params
|
||
; - - - - - - - - - - - - -
|
||
Lib_Par InMid3
|
||
; - - - - - - - - - - - - -
|
||
bsr RInMid
|
||
movem.l a2/d2,-(sp)
|
||
bsr Fn_New_Expentier
|
||
move.l d3,-(sp)
|
||
bsr Fn_New_Expentier
|
||
move.l d3,d4
|
||
move.l (sp)+,d5
|
||
* addq.l #1,d5
|
||
bra RInMid2
|
||
; - - - - - - - - - - - - -
|
||
Lib_Par FnMid3
|
||
; - - - - - - - - - - - - -
|
||
bsr FEnt_3
|
||
move.l d3,d4
|
||
move.l (a3)+,d5
|
||
move.l (a3)+,a2
|
||
moveq #0,d2
|
||
move.w (a2)+,d2
|
||
bra RFnMid
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Commun LEFT MID RIGHT
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def RFnMid
|
||
RFnMid
|
||
; - - - - - - - - - - - - -
|
||
tst.l d5 ;pointe au milieu de la chaine
|
||
bmi FonCall
|
||
beq.s mi2
|
||
subq.l #1,d5
|
||
mi2: add.l d5,a2
|
||
cmp.l d2,d5 ;pas pointe trop loin??
|
||
bcc.s RVide ;si! chaine vide
|
||
mi3: tst.l d4
|
||
beq.s RVide
|
||
bmi FonCall
|
||
mi4: add.l d5,d4
|
||
cmp.l d2,d4
|
||
bls.s mi5
|
||
move.l d2,d4
|
||
mi5: sub.l d5,d4
|
||
mi6: move.l d4,d3
|
||
bsr Demande
|
||
move d4,(a0)+ ;poke la longueur
|
||
subq.l #1,d4
|
||
bmi.s mi8
|
||
mi7: move.b (a2)+,(a0)+
|
||
dbra d4,mi7
|
||
move a0,d0 ;rend pair
|
||
btst #0,d0
|
||
beq.s mi8
|
||
addq.l #1,a0
|
||
mi8: move.l a0,HiChaine(a5)
|
||
move.l a1,d3
|
||
Ret_String
|
||
RVide: move.l ChVide(a5),d3 ;ramene la chaine vide
|
||
Ret_String
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Commun MID LEFT RIGHT =
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def RInMid
|
||
RInMid
|
||
; - - - - - - - - - - - - -
|
||
addq.w #2,a6 Saute la parenthese
|
||
bsr FindVar
|
||
move.l (a0),a2 Recopie la variable!
|
||
moveq #0,d2
|
||
move.w (a2)+,d2
|
||
beq.s L77c
|
||
L77a: move.l a0,-(sp) Sauve l'adresse de la variable
|
||
move.l d2,d3
|
||
bsr Demande Recopie la chaine dans le source
|
||
move.w d2,(a1)+ Longueur
|
||
move.w d2,d0
|
||
subq.w #1,d0
|
||
lsr.w #2,d0
|
||
L77b: move.l (a2)+,(a1)+
|
||
dbra d0,L77b
|
||
move.l a1,HiChaine(a5)
|
||
move.l (sp)+,a1
|
||
move.l a0,(a1) Change la variable
|
||
lea 2(a0),a2
|
||
L77c: rts
|
||
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Commun LEFT MID RIGHT II
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def RInMid2
|
||
RInMid2
|
||
; - - - - - - - - - - - - -
|
||
movem.l d4/d5,-(sp)
|
||
bsr Fn_New_Expentier
|
||
move.l d3,a2
|
||
moveq #0,d2
|
||
move.w (a2)+,d2
|
||
movem.l (sp)+,d4/d5
|
||
movem.l (sp)+,a1/d1
|
||
tst.l d5
|
||
bmi FonCall
|
||
beq.s mdst2
|
||
subq.l #1,d5
|
||
mdst2: add.l d5,a1 ;situe dans la chaine a changer
|
||
cmp.l d1,d5
|
||
bcc.s mdst10 ;trop loin: ne change rien
|
||
tst.l d4
|
||
bmi FonCall
|
||
beq.s mdst10
|
||
add.l d5,d4
|
||
cmp.l d1,d4
|
||
bls.s mdst3
|
||
move.l d1,d4
|
||
mdst3: sub.l d5,d4
|
||
cmp.l d2,d4 ;limite par la taille de la chaine source
|
||
bls.s mdst4
|
||
move.l d2,d4
|
||
mdst4: subq.l #1,d4 ;la chaine source est nulle!
|
||
bmi.s mdst10
|
||
mdst5: move.b (a2)+,(a1)+
|
||
dbra d4,mdst5
|
||
mdst10: rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; =VAL
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par FnVal
|
||
; - - - - - - - - - - - - -
|
||
move.l d3,a2
|
||
move.w (a2)+,d2
|
||
beq.s val11
|
||
Rjsr L_ChVerBuf recopie la chaine dans le buffer
|
||
move.l Buffer(a5),a0
|
||
moveq #1,d0 Tenir compte du signe
|
||
Rjsr L_ValRout
|
||
rts
|
||
val11 moveq #0,d3
|
||
Ret_Int
|
||
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; =RESOURCE$(n)
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par FnResource
|
||
; - - - - - - - - - - - - -
|
||
; Un message normal?
|
||
move.l d3,d0
|
||
ble.s .Skip1
|
||
Rjsr L_Dia_GetPuzzle
|
||
move.l a2,a0
|
||
move.l d3,d0
|
||
Rjsr L_GetMessage
|
||
bra .Fin
|
||
; Le path du systeme? (0)
|
||
.Skip1 neg.l d0
|
||
bne.s .Skip2
|
||
lea Sys_Pathname(a5),a0
|
||
bra.s .Fin
|
||
; Un message systeme? (-1)
|
||
.Skip2 cmp.l #1001,d0
|
||
bcc.s .Skip3
|
||
move.l Sys_Messages(a5),a0
|
||
bra.s .Fin0
|
||
; Un message systeme editeur? (-1000)
|
||
.Skip3 sub.l #1000,d0
|
||
cmp.l #1001,d0
|
||
bcc.s .Skip4
|
||
move.l Ed_Systeme(a5),a0
|
||
bra.s .Fin0
|
||
; Un message de menu editeur? (-2000)
|
||
.Skip4 sub.l #1000,d0
|
||
cmp.l #1001,d0
|
||
bcc.s .Skip5
|
||
move.l EdM_Messages(a5),a0
|
||
bra.s .Fin0
|
||
; Un message editeur? (-3000)
|
||
.Skip5 sub.l #1000,d0
|
||
cmp.l #1001,d0
|
||
bcc.s .Skip6
|
||
move.l Ed_Messages(a5),a0
|
||
bra.s .Fin0
|
||
; Un message de test? (-4000)
|
||
.Skip6 sub.l #1000,d0
|
||
cmp.l #1001,d0
|
||
bcc.s .Skip7
|
||
move.l Ed_TstMessages(a5),a0
|
||
bra.s .Fin0
|
||
; Un message run-time? (-5000)
|
||
.Skip7 sub.l #1000,d0
|
||
cmp.l #1001,d0
|
||
bcc FonCall
|
||
move.l Ed_RunMessages(a5),a0
|
||
; Retourne la chaine
|
||
.Fin0 Rjsr L_GetMessage
|
||
.Fin move.l a0,a2
|
||
Rjmp L_Str2Chaine
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Source: Menus.s
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; MENU KEY
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InMenuKey
|
||
; - - - - - - - - - - - - -
|
||
bsr MnDim
|
||
tst.l MnLat(a2)
|
||
bne FonCall
|
||
cmp.w #_TkTo,(a6)
|
||
bne.s IMnk2
|
||
move.l a2,-(sp)
|
||
addq.l #2,a6
|
||
bsr New_Evalue
|
||
cmp.b #2,d2
|
||
beq.s IMnk1
|
||
* Scancode, shifts
|
||
move.l d3,-(sp)
|
||
moveq #0,d3
|
||
cmp.w #_TkVir,(a6)
|
||
bne.s IMnk0
|
||
bsr Fn_New_Expentier
|
||
IMnk0 move.l (sp)+,d2
|
||
move.l (sp)+,a2
|
||
cmp.l #256,d3
|
||
bcc FonCall
|
||
move.b d3,MnKSh(a2)
|
||
cmp.l #128,d2
|
||
bcc FonCall
|
||
move.b d2,MnKSc(a2)
|
||
move.b #-1,MnKFlag(a2)
|
||
rts
|
||
* "n"
|
||
IMnk1 move.l (sp)+,a2
|
||
move.l d3,a0
|
||
tst.w (a0)+
|
||
beq FonCall
|
||
move.b (a0),MnKAsc(a2)
|
||
move.b #1,MnKFlag(a2)
|
||
rts
|
||
* Arret!
|
||
IMnk2 clr.b MnKFlag(a2)
|
||
rts
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InMenuKey1
|
||
Lib_Def InMenuKey2
|
||
Lib_Def InMenuKey3
|
||
Lib_Def MnKy
|
||
; - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; ON MENU
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InOnMenu
|
||
; - - - - - - - - - - - - -
|
||
Rjsr L_OMnEff
|
||
; Rlea L_GoMenu,0 Pas de routine de branchement
|
||
; move.l a0,GoTest_GoMenu(a5)
|
||
move.w (a6)+,-(sp)
|
||
* Cherche les labels
|
||
clr.w -(sp)
|
||
OnMn1 bsr GetLabel
|
||
beq LbNDef
|
||
move.l d0,-(a3)
|
||
addq.w #1,(sp)
|
||
cmp.w #_TkVir,(a6)+
|
||
beq.s OnMn1
|
||
subq.l #2,a6
|
||
* Taille
|
||
move.w (sp)+,d2
|
||
move.w d2,OMnNb(a5)
|
||
moveq #0,d1
|
||
move.w d2,d1 * Nb de labesl*4
|
||
lsl.w #2,d1
|
||
move.l d1,d0
|
||
SyCall MemFast
|
||
beq OOfMem
|
||
move.l a0,OMnBase(a5)
|
||
add.l d1,a0
|
||
* Poke les jumps
|
||
subq.w #1,d2
|
||
OnMn2 move.l (a3)+,-(a0)
|
||
dbra d2,OnMn2
|
||
* Goto/Gosub/Proc
|
||
move.w (sp)+,OMnType(a5)
|
||
* Plus de branchements
|
||
bclr #BitJump,ActuMask(a5)
|
||
* Branche la routine Clearvar
|
||
lea .Struc(pc),a1
|
||
lea Sys_ClearRoutines(a5),a2
|
||
SyCall AddRoutine
|
||
rts
|
||
; Structure clearvar
|
||
; ~~~~~~~~~~~~~~~~~~
|
||
.Struc dc.l 0
|
||
Rjmp L_OMnEff
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; MENU$(,,,)=
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InMenu
|
||
; - - - - - - - - - - - - -
|
||
move.l a3,-(sp)
|
||
clr.w -(sp)
|
||
* Branche la routine pour CLEARVAR
|
||
Rjsr L_MnClearVar
|
||
* Empile les parametres
|
||
IMen1: addq.w #1,(sp)
|
||
bsr Fn_New_Expentier
|
||
move.l d3,-(a3)
|
||
cmp.w #_TkVir,(a6)
|
||
beq.s IMen1
|
||
* Trouve le menu
|
||
move.w (sp)+,d5
|
||
Rjsr L_MnFind
|
||
bne.s IMenA
|
||
Rjsr L_MnIns
|
||
IMenA: move.l (sp)+,a3
|
||
* Prend les parametres
|
||
* cmp.w #_TkEg,(a6)
|
||
* bne.s IMenI
|
||
******* Fonction MENU$="jfkjdkfjkdj"
|
||
move.l ScOnAd(a5),a0
|
||
cmp.l MnAdEc(a5),a0
|
||
beq.s IMen6
|
||
tst.l MnAdEc(a5)
|
||
bne ScNOp
|
||
move.l a0,MnAdEc(a5)
|
||
IMen6: move.l EcWindow(a0),a0
|
||
move.b WiPaper+1(a0),d0
|
||
move.b WiPen+1(a0),d1
|
||
move.b d0,MnInkA1(a2)
|
||
move.b d1,MnInkB1(a2)
|
||
move.b d0,MnInkC1(a2)
|
||
move.b d1,MnInkA2(a2)
|
||
move.b d0,MnInkB2(a2)
|
||
move.b d0,MnInkC2(a2)
|
||
* Prend la chaine OB1
|
||
lea MnOb1(a2),a0
|
||
bsr MnOob
|
||
* Prend la chaine OB2
|
||
IMen7 cmp.w #_TkVir,(a6)
|
||
bne.s IMenX
|
||
lea MnOb2(a2),a0
|
||
bsr MnOob
|
||
* Prend la chaine OBOFF
|
||
IMen8 cmp.w #_TkVir,(a6)
|
||
bne.s IMenX
|
||
lea MnOb3(a2),a0
|
||
bsr MnOob
|
||
* Prend la chaine OBF
|
||
IMen9 cmp.w #_TkVir,(a6)
|
||
bne.s IMenX
|
||
lea MnObF(a2),a0
|
||
bsr MnOob
|
||
* Ca y est!!!
|
||
IMenX: addq.w #1,MnChange(a5)
|
||
rts
|
||
|
||
* bclr #BitMenu,ActuMask(a5)
|
||
|
||
; Petite routine de creation
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
MnOob movem.l a0-a2,-(sp)
|
||
bsr Fn_New_Evalue *** ?
|
||
movem.l (sp)+,a0-a2
|
||
cmp.l #EntNul,d3
|
||
beq MnOob0
|
||
move.l d3,a1
|
||
tst.w (a1)
|
||
bne MnOob1
|
||
* Efface la chaine
|
||
MnOobE move.l (a0),d0
|
||
beq.s MnOob0
|
||
clr.l (a0)
|
||
move.l d0,a1
|
||
moveq #0,d0
|
||
move.w (a1),d0
|
||
SyCall MemFree
|
||
MnOob0 rts
|
||
* Une chaine!
|
||
MnOob1 movem.l a0/a1,-(sp) * Efface l'ancienne
|
||
bsr.s MnOobE
|
||
movem.l (sp)+,a0/a1
|
||
Rjsr L_MnObjet * Cree la nouvelle
|
||
beq OOfMem
|
||
bmi FonCall
|
||
move.l d0,(a0)
|
||
rts
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InMenu2
|
||
Lib_Def InMenu3
|
||
Lib_Def InMenu4
|
||
; - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; MENU DEL [(coordonnees,,)]
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InMenuDel
|
||
; - - - - - - - - - - - - -
|
||
cmp.w #_TkPar1,(a6)
|
||
beq.s IMnD1
|
||
Rjsr L_MnRaz
|
||
rts
|
||
IMnD1 bsr MnDim
|
||
move.l a2,d0
|
||
moveq #0,d5
|
||
addq.w #1,MnChange(a5)
|
||
Rjsr L_MnEff
|
||
rts
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def InMenuDel1
|
||
; - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; SET MENU
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Par InSetMenu
|
||
; - - - - - - - - - - - - -
|
||
bsr MnDim
|
||
move.l a2,-(sp)
|
||
bsr Fn_New_Expentier
|
||
move.l d3,-(a3)
|
||
bsr Fn_New_Expentier
|
||
move.l (sp)+,a2
|
||
move.l #EntNul,d0
|
||
cmp.l d0,d3
|
||
beq.s ISMn1
|
||
move.w d3,MnY(a2)
|
||
bset #MnFixed,MnFlag(a2)
|
||
ISMn1 move.l (a3)+,d1
|
||
cmp.l d0,d1
|
||
beq.s ISMn2
|
||
move.w d1,MnX(a2)
|
||
bset #MnFixed,MnFlag(a2)
|
||
ISMn2 rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Routine-> adresse du flag
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def MnDim
|
||
MnDim
|
||
; - - - - - - - - - - - - -
|
||
cmp.w #_TkPar1,(a6)
|
||
beq.s MnDim1
|
||
bsr New_Expentier
|
||
tst.l d3
|
||
beq FonCall
|
||
cmp.l #MnNDim,d3
|
||
bhi FonCall
|
||
lea MnDFlags(a5),a0
|
||
lea -1(a0,d3.w),a0
|
||
rts
|
||
; Cherche l'adresse D'UN objet
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
MnDim1 move.l a3,-(sp)
|
||
clr.w -(sp)
|
||
MnDim2 addq.w #1,(sp)
|
||
bsr Fn_New_Expentier
|
||
move.l d3,-(a3)
|
||
cmp.w #_TkVir,(a6)
|
||
beq.s MnDim2
|
||
* Trouve le menu
|
||
move.w (sp)+,d5
|
||
Rjsr L_MnFind
|
||
move.l (sp)+,a3
|
||
tst.l d0
|
||
beq MnINDef
|
||
lea MnFlag(a2),a0
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Entree appel de procedure menu
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def MenuProcedure
|
||
; - - - - - - - - - - - - -
|
||
move.l a0,d3 Le nom du label
|
||
bsr GLb3 Va chercher le label
|
||
beq.s .Err
|
||
move.l d0,a2 Adresse de la procedure
|
||
sub.l a6,a6 Pas de retour!
|
||
move.l Prg_InsRet(a5),-(sp)
|
||
clr.w -(sp) Pas d'erreur
|
||
bra InProE Va a la procedure
|
||
.Err moveq #-1,d0 Une Erreur!
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; SOUS PROGRAMME UTILISE PAR VAL ET INPUT
|
||
; D0= Tenir compte du signe (TRUE)
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def ValRout
|
||
; - - - - - - - - - - - - -
|
||
movem.l a1-a2/d5-d7,-(sp)
|
||
move.l a0,d7
|
||
moveq #0,d4
|
||
move.l a0,a2
|
||
tst.w d0
|
||
beq.s val1c
|
||
; y-a-t'il un signe devant?
|
||
val1: move.b (a0)+,d0
|
||
beq val10
|
||
cmp.b #32,d0
|
||
beq.s val1
|
||
move.l a0,a2
|
||
subq.l #1,a2
|
||
cmp.b #"-",d0
|
||
bne.s val1a
|
||
not d4
|
||
bra.s val1c
|
||
val1a: cmp.b #"+",d0
|
||
beq.s val1c
|
||
val1b: subq.l #1,a0
|
||
val1c
|
||
; Explore le chiffre
|
||
; ~~~~~~~~~~~~~~~~~~
|
||
move.b (a0)+,d0
|
||
beq val10
|
||
cmp.b #32,d0
|
||
beq.s val1c
|
||
cmp.b #"$",d0 ;chiffre HEXA
|
||
beq val5
|
||
cmp.b #"%",d0 ;chiffre BINAIRE
|
||
beq val6
|
||
cmp.b #".",d0
|
||
beq.s val2
|
||
cmp.b #"0",d0
|
||
bcs val10
|
||
cmp.b #"9",d0
|
||
bhi val10
|
||
; c'estn chiffre DECIMAL: entier ou float?
|
||
val2: subq.l #1,a0
|
||
move.l a0,a1 ;si float: trouve la fin du chiffre
|
||
clr d3
|
||
val3: move.b (a1)+,d0
|
||
beq.s val4
|
||
cmp.b #32,d0
|
||
beq.s val3
|
||
cmp.b #"0",d0
|
||
bcs.s val3z
|
||
cmp.b #"9",d0
|
||
bls.s val3
|
||
val3z: cmp.b #".",d0 ;cherche une "virgule"
|
||
bne.s val3a
|
||
bset #0,d3 ;si deux virgules: fin du chiffre
|
||
beq.s val3
|
||
bne.s val4
|
||
val3a: cmp.b #"e",d0 ;cherche un exposant
|
||
beq.s val3b
|
||
cmp.b #"E",d0 ;autre caractere: fin du chiffre
|
||
bne.s val4
|
||
val3ab: move.b #"e",-1(a1) ;met un E minuscule!!!
|
||
val3b: move.b (a1)+,d0 ;apres un E, accepte -/+ et chiffres
|
||
cmp.b #32,d0
|
||
beq.s val3b
|
||
cmp.b #"+",d0
|
||
beq.s val3c
|
||
cmp.b #"-",d0
|
||
bne.s val3e
|
||
val3c: bset #1,d3 ;+ ou -: c'est un float!
|
||
val3d: move.b (a1)+,d0 ;puis cherche la fin de l'exposant
|
||
cmp.b #32,d0
|
||
beq.s val3d
|
||
val3e: cmp.b #"0",d0
|
||
bcs.s val4
|
||
cmp.b #"9",d0 ;chiffre! c'est un float
|
||
bls.s val3c
|
||
val4: tst d3 ;si d3=0: c'est un entier
|
||
beq val7
|
||
; conversion ASCII--->FLOAT
|
||
move.l a2,a0
|
||
subq.l #1,a1
|
||
movem.l a1/a3-a6,-(sp)
|
||
lea BuFloat(a5),a2
|
||
moveq #32,d1
|
||
Ca1: cmp.l a0,a1
|
||
beq.s Ca2
|
||
move.b (a0)+,d0
|
||
cmp.b #32,d0
|
||
beq.s Ca1
|
||
move.b d0,(a2)+
|
||
dbra d1,Ca1
|
||
Ca2: clr.b (a2)
|
||
clr.b 1(a2)
|
||
tst.b MathFlags(a5) Simple ou double precision?
|
||
bmi.s .Double
|
||
; Simple precision
|
||
lea BuFloat(a5),a0
|
||
move.l a0,-(sp)
|
||
Rjsr L_AscToFloat
|
||
addq.l #4,sp
|
||
move.l d0,d3
|
||
moveq #1,d2
|
||
move.w #_TkFl,d1 ;chiffre FLOAT
|
||
bra.s .FQuit
|
||
; Double precision
|
||
.Double lea BuFloat(a5),a0
|
||
move.l a0,-(sp)
|
||
Rjsr L_AscToDouble
|
||
addq.l #4,sp
|
||
move.l d0,d3
|
||
move.l d1,d4
|
||
moveq #1,d2
|
||
move.w #_TkDFl,d1
|
||
.FQuit movem.l (sp)+,a0/a3-a6
|
||
moveq #0,d0
|
||
bra.s valOut
|
||
; chiffre hexa
|
||
val5: bsr hexalong
|
||
move.w #_TkHex,d2
|
||
bra.s val8
|
||
; chiffre binaire
|
||
val6: bsr binlong
|
||
move.w #_TkBin,d2
|
||
bra.s val8
|
||
; chiffre entier
|
||
val7: bsr declong
|
||
move.w #_TkEnt,d2
|
||
val8: exg d2,d1 ;type de conversion--->d1
|
||
tst d2
|
||
bne.s val10 ;si probleme: ramene zero!
|
||
move.l d0,d3
|
||
; Test du signe, si entier
|
||
tst d4
|
||
beq.s val8a
|
||
neg.l d3
|
||
val8a: moveq #0,d2
|
||
bra.s valOut
|
||
; ramene zero
|
||
val10: moveq #0,d2 Erreur: ramene zero!
|
||
moveq #0,d3
|
||
move.l d7,a0
|
||
moveq #1,d0
|
||
; Sortie
|
||
valOut movem.l (sp)+,a1-a2/d5-d7
|
||
rts
|
||
|
||
; MINI CHRGET POUR LES CONVERSIONS
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
minichr move.b (a0)+,d2
|
||
beq.s mc1
|
||
cmp.b #32,d2
|
||
beq.s minichr
|
||
cmp.b #"a",d2 ;si minuscule: majuscule
|
||
bcs.s mc0
|
||
sub.b #"a"-"A",d2
|
||
mc0 sub.b #48,d2
|
||
rts
|
||
mc1 move.b #-1,d2
|
||
rts
|
||
; Minichr pour hexa
|
||
; ~~~~~~~~~~~~~~~~~
|
||
minichr2
|
||
move.b (a0)+,d2
|
||
beq.s .mc1
|
||
cmp.b #"a",d2 ;si minuscule: majuscule
|
||
bcs.s .mc0
|
||
sub.b #"a"-"A",d2
|
||
.mc0: sub.b #48,d2
|
||
rts
|
||
.mc1: move.b #-1,d2
|
||
rts
|
||
|
||
; CONVERSION DECIMAL->HEXA SUR QUATRE OCTETS, SIGNE!
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
declong moveq #0,d0
|
||
moveq #0,d2
|
||
moveq #0,d3
|
||
move.l a0,-(sp)
|
||
ddh1: bsr minichr
|
||
ddh1a: cmp.b #10,d2
|
||
bcc.s ddh5
|
||
move d0,d1
|
||
mulu #10,d1
|
||
swap d0
|
||
mulu #10,d0
|
||
swap d0
|
||
tst d0
|
||
bne.s ddh2
|
||
add.l d1,d0
|
||
bcs.s ddh2
|
||
add.l d2,d0
|
||
bmi.s ddh2
|
||
addq #1,d3
|
||
bra.s ddh1
|
||
ddh2: move.l (sp)+,a0
|
||
moveq #1,d1 ;out of range: bpl, et recupere l'adresse
|
||
rts
|
||
ddh5: subq.l #1,a0
|
||
addq.l #4,sp
|
||
tst d3
|
||
beq.s ddh7
|
||
moveq #0,d1 ;OK: chiffre en d0, et beq
|
||
rts
|
||
ddh7: moveq #-1,d1 ;pas de chiffre: bmi
|
||
rts
|
||
|
||
; CONVERSION HEXA-ASCII EN HEXA-HEXA
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
hexalong
|
||
moveq #0,d0
|
||
moveq #0,d2
|
||
moveq #0,d3
|
||
move.l a0,-(sp)
|
||
hh1: bsr minichr2
|
||
cmp.b #10,d2
|
||
bcs.s hh2
|
||
cmp.b #17,d2
|
||
bcs.s ddh5
|
||
subq.w #7,d2
|
||
hh2: cmp.b #16,d2
|
||
bcc.s ddh5
|
||
lsl.l #4,d0
|
||
or.b d2,d0
|
||
addq.w #1,d3
|
||
cmp #9,d3
|
||
bne.s hh1
|
||
beq.s ddh2
|
||
|
||
; CONVERSION BINAIRE ASCII ---> HEXA SUR QUATRE OCTETS
|
||
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
binlong moveq #0,d0
|
||
moveq #0,d2
|
||
moveq #0,d3
|
||
move.l a0,-(sp)
|
||
bh1: bsr minichr
|
||
cmp.b #2,d2
|
||
bcc.s ddh5
|
||
roxr #1,d2
|
||
roxl.l #1,d0
|
||
bcs.s ddh2
|
||
addq.w #1,d3
|
||
cmp.w #33,d3
|
||
bne.s bh1
|
||
beq ddh1
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; DEBUT DES SWAP FLOAT
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def Start_FloatSwap
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def CmpInitFloat
|
||
Lib_Def CmpInitDouble
|
||
; - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; ENTIER >>> FLOAT
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Conversion entier >>> float dans le dernier operateur
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def IntToFl1
|
||
; - - - - - - - - - - - - -
|
||
move.l d3,d0
|
||
move.l a6,d3
|
||
move.l FloatBase(a5),a6
|
||
jsr _LVOSPFlt(a6)
|
||
move.l d3,a6
|
||
move.l d0,d3
|
||
Ret_Float
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def DIntToFl1
|
||
; - - - - - - - - - - - - -
|
||
move.l d3,d0
|
||
move.l a6,d3
|
||
move.l DFloatBase(a5),a6
|
||
jsr _LVOIEEEDPFlt(a6)
|
||
move.l d3,a6
|
||
move.l d0,d3
|
||
move.l d1,d4
|
||
Ret_Float
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; ENTIER >>> FLOAT
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Conversion entier >>> float dans la pile
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def IntToFl2
|
||
; - - - - - - - - - - - - -
|
||
move.l 4(a3),d0
|
||
move.l a6,d4
|
||
move.l FloatBase(a5),a6
|
||
jsr _LVOSPFlt(a6)
|
||
move.l d4,a6
|
||
move.l d0,4(a3)
|
||
move.b #1,3(a3)
|
||
rts
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def DIntToFl2
|
||
; - - - - - - - - - - - - -
|
||
movem.l 4(a3),d0-d1
|
||
move.l a6,-(sp)
|
||
move.l DFloatBase(a5),a6
|
||
jsr _LVOIEEEDPFlt(a6)
|
||
move.l (sp)+,a6
|
||
movem.l d0-d1,4(a3)
|
||
move.b #1,3(a3)
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; FLOAT >>> ENTIER
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Conversion float >>> entier dans le dernier operateur
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def FlToInt1
|
||
; - - - - - - - - - - - - -
|
||
move.l d3,d0
|
||
move.l a6,d3
|
||
move.l FloatBase(a5),a6
|
||
jsr _LVOSPFix(a6)
|
||
move.l d3,a6
|
||
move.l d0,d3
|
||
Ret_Int
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def DFlToInt1
|
||
; - - - - - - - - - - - - -
|
||
move.l d3,d0
|
||
move.l d4,d1
|
||
move.l a6,d3
|
||
move.l DFloatBase(a5),a6
|
||
jsr _LVOIEEEDPFix(a6)
|
||
move.l d3,a6
|
||
move.l d0,d3
|
||
Ret_Int
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; FLOAT >>> ENTIER
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Conversion float >>> entier dans la pile
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def FlToInt2
|
||
; - - - - - - - - - - - - -
|
||
move.l 4(a3),d0
|
||
move.l a6,d4
|
||
move.l FloatBase(a5),a6
|
||
jsr _LVOSPFix(a6)
|
||
move.l d4,a6
|
||
move.l d0,4(a3)
|
||
clr.b 3(a3)
|
||
rts
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def DFlToInt2
|
||
; - - - - - - - - - - - - -
|
||
movem.l 4(a3),d0-d1
|
||
move.l a6,-(sp)
|
||
move.l DFloatBase(a5),a6
|
||
jsr _LVOIEEEDPFix(a6)
|
||
move.l (sp)+,a6
|
||
movem.l d0-d1,4(a3)
|
||
clr.b 3(a3)
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; FONCTION MATHEMATIQUE
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Fait une fonction mathematique
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def Math_Fonction
|
||
; - - - - - - - - - - - - -
|
||
move.l d3,d0
|
||
move.l a6,d3
|
||
move.l MathBase(a5),a6
|
||
jsr 0(a6,d2.w)
|
||
move.l d3,a6
|
||
move.l d0,d3
|
||
Ret_Float
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def DMath_Fonction
|
||
; - - - - - - - - - - - - -
|
||
move.l d3,d0
|
||
move.l d4,d1
|
||
move.l a6,d3
|
||
move.l DMathBase(a5),a6
|
||
jsr 0(a6,d2.w)
|
||
move.l d3,a6
|
||
move.l d0,d3
|
||
move.l d1,d4
|
||
Ret_Float
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; COMPARAISONS FLOAT
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Fait une comparaison float
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def Float_Compare
|
||
; - - - - - - - - - - - - -
|
||
move.l d3,d1
|
||
move.l 4(a3),d0
|
||
move.l a6,d3
|
||
move.l FloatBase(a5),a6
|
||
jsr _LVOSPCmp(a6)
|
||
move.l d3,a6
|
||
rts
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def DFloat_Compare
|
||
; - - - - - - - - - - - - -
|
||
movem.l 4(a3),d0-d1
|
||
move.l d3,d2
|
||
move.l d4,d3
|
||
move.l a6,d4
|
||
move.l DFloatBase(a5),a6
|
||
jsr _LVOIEEEDPCmp(a6)
|
||
move.l d4,a6
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Operation FLOAT
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Fait une operation float
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def Float_Operation
|
||
; - - - - - - - - - - - - -
|
||
move.l 4(a3),d0
|
||
move.l d3,d1
|
||
move.l a6,d4
|
||
move.l FloatBase(a5),a6
|
||
jsr 0(a6,d2.w)
|
||
move.l d4,a6
|
||
move.l d0,d3
|
||
Ret_Float
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def DFloat_Operation
|
||
; - - - - - - - - - - - - -
|
||
movem.l 4(a3),d0-d1
|
||
exg d3,d2
|
||
exg d4,d3
|
||
move.l a6,-(sp)
|
||
move.l DFloatBase(a5),a6
|
||
jsr 0(a6,d4.w)
|
||
move.l (sp)+,a6
|
||
move.l d0,d3
|
||
move.l d1,d4
|
||
Ret_Float
|
||
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; FLOAT= ZERO?
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Fait un TST sur le float D3
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def Float_Test
|
||
; - - - - - - - - - - - - -
|
||
move.l d3,d1
|
||
move.l a6,d4
|
||
move.l FloatBase(a5),a6
|
||
jsr _LVOSPTst(a6)
|
||
move.l d4,a6
|
||
rts
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def Float_TestF
|
||
; - - - - - - - - - - - - -
|
||
move.l d3,d0
|
||
move.l d4,d1
|
||
move.l a6,d5
|
||
move.l DFloatBase(a5),a6
|
||
jsr _LVOIEEEDPTst(a6)
|
||
move.l d5,a6
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Operation MATH
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Fait une operation Math
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def Math_Operation
|
||
; - - - - - - - - - - - - -
|
||
move.l 4(a3),d0
|
||
move.l d3,d1
|
||
move.l a6,d4
|
||
move.l MathBase(a5),a6
|
||
jsr 0(a6,d2.w)
|
||
move.l d4,a6
|
||
move.l d0,d3
|
||
Ret_Float
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def DMath_Operation
|
||
; - - - - - - - - - - - - -
|
||
movem.l 4(a3),d0-d1
|
||
exg d3,d2
|
||
exg d4,d3
|
||
move.l a6,-(sp)
|
||
move.l DMathBase(a5),a6
|
||
jsr 0(a6,d4.w)
|
||
move.l (sp)+,a6
|
||
move.l d0,d3
|
||
move.l d1,d4
|
||
Ret_Float
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; FONCTION FLOAT
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Fait une fonction float
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def Float_Fonction
|
||
; - - - - - - - - - - - - -
|
||
move.l d3,d0
|
||
move.l a6,d3
|
||
move.l FloatBase(a5),a6
|
||
jsr 0(a6,d2.w)
|
||
move.l d3,a6
|
||
move.l d0,d3
|
||
Ret_Float
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def DFloat_Fonction
|
||
; - - - - - - - - - - - - -
|
||
move.l d3,d0
|
||
move.l d4,d1
|
||
move.l a6,d3
|
||
move.l DFloatBase(a5),a6
|
||
jsr 0(a6,d2.w)
|
||
move.l d3,a6
|
||
move.l d0,d3
|
||
move.l d1,d4
|
||
Ret_Float
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Verifie que le float est positif
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def FlPos Simple precision
|
||
; - - - - - - - - - - - - -
|
||
btst #7,d3
|
||
Rbne L_FonCall
|
||
rts
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def FlPosD Double precision
|
||
; - - - - - - - - - - - - -
|
||
btst #31,d3
|
||
Rbne L_FonCall
|
||
rts
|
||
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; RETOURNE UN ANGLE
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def AAngle SFloat
|
||
; - - - - - - - - - - - - -
|
||
move.l d3,d0 Appel de la fonction
|
||
move.l a6,d3
|
||
move.l MathBase(a5),a6
|
||
jsr 0(a6,d2.w)
|
||
tst.w Angle(a5)
|
||
beq.s .AAnX
|
||
move.l FloatBase(a5),a6
|
||
move.l ValPi(a5),d1
|
||
jsr _LVOSPDiv(a6)
|
||
move.l Val180(a5),d1
|
||
jsr _LVOSPMul(a6)
|
||
.AAnX move.l d3,a6
|
||
move.l d0,d3
|
||
Ret_Float
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def AAngleD DFloat
|
||
; - - - - - - - - - - - - -
|
||
move.l d3,d0 Appel de la fonction
|
||
move.l d4,d1
|
||
move.l a6,-(sp)
|
||
move.l DMathBase(a5),a6
|
||
jsr 0(a6,d2.w)
|
||
tst.w Angle(a5)
|
||
beq.s .AAnY
|
||
move.l DFloatBase(a5),a6
|
||
move.l ValPi(a5),d2
|
||
move.l ValPi+4(a5),d3
|
||
jsr _LVOSPDiv(a6)
|
||
move.l Val180(a5),d2
|
||
move.l Val180+4(a5),d3
|
||
jsr _LVOSPMul(a6)
|
||
.AAnY move.l (sp)+,a6
|
||
move.l d0,d3
|
||
move.l d1,d4
|
||
Ret_Float
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; TRANSFORME EN ANGLE
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def FFAngle SFloat
|
||
; - - - - - - - - - - - - -
|
||
tst.w Angle(a5)
|
||
bne.s .Conv
|
||
rts
|
||
; Conversion--> radian
|
||
.Conv move.l d3,d0
|
||
move.l a6,d3
|
||
move.l FloatBase(a5),a6
|
||
move.l Val180(a5),d1
|
||
jsr _LVOSPDiv(a6)
|
||
move.l ValPi(a5),d1
|
||
jsr _LVOSPMul(a6)
|
||
move.l d3,a6
|
||
move.l d0,d3
|
||
Ret_Float
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def FAngleD DFloat
|
||
; - - - - - - - - - - - - -
|
||
tst.w Angle(a5)
|
||
bne.s .Conv
|
||
rts
|
||
; Conversion--> radian
|
||
.Conv move.l d3,d0
|
||
move.l d4,d1
|
||
move.l a6,-(sp)
|
||
move.l DFloatBase(a5),a6
|
||
move.l Val180(a5),d2
|
||
move.l Val180+4(a5),d3
|
||
jsr _LVOSPDiv(a6)
|
||
move.l ValPi(a5),d2
|
||
move.l ValPi+4(a5),d3
|
||
jsr _LVOSPMul(a6)
|
||
move.l (sp)+,a6
|
||
move.l d0,d3
|
||
move.l d1,d4
|
||
Ret_Float
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; PARAM FLOAT
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def FnParamF SFloat
|
||
; - - - - - - - - - - - - -
|
||
move.l ParamF(a5),d3
|
||
Ret_Float
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def FnParamD DFloat
|
||
; - - - - - - - - - - - - -
|
||
move.l ParamF(a5),d3
|
||
move.l ParamF2(a5),d4
|
||
Ret_Float
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; ASCII Vers Float
|
||
; A0 Buffer
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def Ascii2Float
|
||
; - - - - - - - - - - - - -
|
||
move.l a0,-(sp)
|
||
Rjsr L_AscToFloat
|
||
addq.l #4,sp
|
||
rts
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def Ascii2FloatD
|
||
; - - - - - - - - - - - - -
|
||
move.l a0,-(sp)
|
||
Rjsr L_AscToDouble
|
||
addq.l #4,sp
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Float vers ascii
|
||
; D3/D4 Float
|
||
; A0 Buffer
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def Float2Ascii
|
||
; - - - - - - - - - - - - -
|
||
move.l d3,d0 Simple precision
|
||
move.w FixFlg(a5),d4
|
||
move.w ExpFlg(a5),d5
|
||
bclr #31,d4
|
||
Rjmp L_FloatToAsc
|
||
; - - - - - - - - - - - - -
|
||
Lib_Def Float2AsciiD
|
||
; - - - - - - - - - - - - -
|
||
moveq #2,d0 Double precision
|
||
moveq #15,d1
|
||
tst.w FixFlg(a5)
|
||
bmi.s .Ok
|
||
move.w FixFlg(a5),d1 Nombre de chiffres
|
||
tst.w ExpFlg(a5)
|
||
beq.s .Ok
|
||
moveq #0,d0
|
||
.Ok movem.l a0-a1,-(sp)
|
||
btst #31,d3 Si positif
|
||
bne.s .Neg
|
||
move.b #" ",(a0)+ Un espace devant
|
||
.Neg move.l d0,-(sp)
|
||
move.l d1,-(sp)
|
||
move.l a0,-(sp)
|
||
move.l d4,-(sp)
|
||
move.l d3,-(sp)
|
||
Rjsr L_DoubleToAsc
|
||
lea 20(sp),sp
|
||
movem.l (sp)+,a0/a1
|
||
.Lop tst.b (a0)+
|
||
bne.s .Lop
|
||
subq.l #1,a0
|
||
rts
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Pour le compilateur, fonctions internes
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def FnMaxF
|
||
Lib_Def FnMaxD
|
||
Lib_Def FnMinF
|
||
Lib_Def FnMinD
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; FIN DES SWAP FLOAT
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Def End_FloatSwap
|
||
; - - - - - - - - - - - - -
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Relai de saut aux erreurs principales
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
FonCall Rbra L_FonCall
|
||
Synt Rbra L_Syntax
|
||
OOfMem Rbra L_OOfMem
|
||
StooLong Rbra L_StooLong
|
||
ScNOp Rbra L_ScNOp
|
||
FilTM Rbra L_FilTM
|
||
AdrErr Rbra L_AdrErr
|
||
EcWiErr Rbra L_EcWiErr
|
||
BkNoRes Rbra L_BkNoRes
|
||
|
||
|
||
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
; Espace pour le compilateur!
|
||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||
Lib_Pos 500
|
||
; - - - - - - - - - - - - -
|