TheIndustriousRabbit/amos-professional
1
0
Fork 0
Code Issues 31 Pull Requests Packages Projects Releases Wiki Activity
80c4982ad8
amos-professional/AMOSPro Sources/+comp.s

6679 lines
121 KiB
ArmAsm
Raw Normal View History

Initial commit
2020-04-26 00:58:13 +00:00
;---------------------------------------------------------------------
;
; 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.
;
;---------------------------------------------------------------------
*
INCDIR ":AMOS.S/Common/"
Include "_Equ.s"
RsSet DataLong
Include "_Pointe.s"
*
Include "_WEqu.s"
Include "_CEqu.s"
Include "_LEqu.s"
*
CDebug set 0
*
F_Courant equ 0
F_Source equ 1
F_Objet equ 2
F_Libs equ 3
M_Libs equ 27
M_Fichiers equ F_Libs+M_Libs
Mes_Base equ 14+26
Mes_BaseCh equ 36
Mes_BaseNoms equ 46
*
Bra CliIn
Bra AMOSIn1
Bra AMOSIn2
dc.b "ACmp"
;---------------------------------------------------------------------
dc.b 0,"$VER: 1.36",0
even
; Modifs 1.34b / 1.34
; - Print # avec des ;
;
;---------------------------------------------------------------------
*
Ext_Nb equ 5
Ext_TkCmp equ 6
Ext_TkCOp equ $14
Ext_TkTston equ $28
Ext_TkTstof equ $3a
Ext_TkTst equ $4e
*
;---------------------------------------------------------------------
; *** *** ** ** **** **** ** ** ** ** ** *** ***
; ** ** ** *** *** ** ** ** ** ** **** *** *** ** ** **
; ** ** ** ** * ** ** ** ** ** ** ** ** ** * ** ** ** ***
; ** ** ** ** ** **** ** ** ****** ** ** ** ** **
; ** ** ** ** ** ** ** ** ** ** ** ** ** ** * **
; *** *** ** ** ** **** **** ** ** ** ** *** ***
;---------------------------------------------------------------------
; Entree AMOS mode direct
;---------------------------------------------------------------------
AMOSIn1 move.l a5,a4
lea DZ(pc),a5
bsr ResetDZ
move.w #1,Flag_AMOS(a5)
bra.s AMOS_Suite
;---------------------------------------------------------------------
; *** *** ** ** **** **** ** ** ** ** ** *** ***
; ** ** ** *** *** ** ** ** ** ** **** *** *** ** ** **
; ** ** ** ** * ** ** ** ** ** ** ** ** ** * ** ** ** ***
; ** ** ** ** ** **** ** ** ****** ** ** ** ** **
; ** ** ** ** ** ** ** ** ** ** ** ** ** ** * **
; *** *** ** ** ** **** **** ** ** ** ** *** ***
;---------------------------------------------------------------------
; Entree AMOS compiler.amos
;---------------------------------------------------------------------
AMOSIn2 lea AMOS_Save(pc),a1
movem.l a3-a6,(a1)
move.l a5,a4
lea DZ(pc),a5
bsr ResetDZ
move.w #-1,Flag_Quiet(a5)
move.w #-1,Flag_AMOS(a5)
AMOS_Suite
move.l IconBase(a4),C_IconBase(a5)
bne.s .skip
move.w #-1,IconAMOS(a5)
.skip move.l DosBase(a4),C_DosBase(a5)
move.l T_GfxBase(a4),C_GfxBase(a5)
move.l a4,AMOS_Dz(a5)
bra Go_On
;---------------------------------------------------------------------
; *** *** ** ** **** **** ** ** ** ** ** *** ***
; ** ** ** *** *** ** ** ** ** ** **** *** *** ** ** **
; ** ** ** ** * ** ** ** ** ** ** ** ** ** * ** ** ** ***
; ** ** ** ** ** **** ** ** ****** ** ** ** ** **
; ** ** ** ** ** ** ** ** ** ** ** ** ** ** * **
; *** *** ** ** ** **** **** ** ** ** ** *** ***
;---------------------------------------------------------------------
; Entree CLI
;---------------------------------------------------------------------
CliIn lea DZ(pc),a5
bsr ResetDZ
clr.w Flag_AMOS(a5)
* Entree commune
Go_On move.l sp,C_Pile(a5)
move.l a0,a1
move.l d0,d1
* Buffer de travail
move.l #256,d0
bsr ResBuffer
beq OOfMem
move.l a0,B_Work(a5)
* Recopie la ligne de commande
subq.l #1,d1
bmi.s .loop3
.loop1 move.b (a1)+,d0
cmp.b #32,d0
bcs.s .loop2
move.b d0,(a0)+
.loop2 dbra d1,.loop1
.loop3 clr.b (a1)
* Init de l'amigados
bsr IniDisc
* Liste par defaut
lea Def_Liste(pc),a0
lea Nom_Liste(a5),a1
.Init0 move.b (a0)+,(a1)+
bne.s .Init0
moveq #3,d0
bsr GoPos
* Flash par defaut, aucun!
move.w #32,Flag_Flash(a5)
* Explore la ligne de commande (si option -C)
move.l B_Work(a5),a0
bsr CommandLine
* Charge la LIB LISTE / Explore sa ligne de commande (si option -E)
lea Nom_Liste(a5),a1
bsr LoadInBuffer
moveq #1,d3
bsr ListeNom
move.l B_DiskIn(a5),a0
bsr CommandLine
move.l d0,-(sp)
* Encore un coup la vraie...
move.l B_Work(a5),a0
bsr CommandLine
move.l d0,-(sp)
* Ca y est! On peut trouver les noms
bsr InitListe
* Des erreurs?
move.l (sp)+,d0
bne ErrCommand
move.l (sp)+,d0
bne ErrComList
* Imprime le titre
moveq #20,d0
bsr MesPrint
* Ouvre l'icon.library
bsr InitIcons
* Longueur des buffers
moveq #1,d0
bsr GetChiffre
move.l d0,L_Bso(a5)
moveq #2,d0
bsr GetChiffre
move.l d0,MaxBob(a5)
* 1ere phase terminee
moveq #6,d0
bsr GoPos
* Debut de compilation
Compile
* Initialisations
bsr IniSource
bsr IniNOb
moveq #9,d0
bsr GoPos
bsr IniObjet
moveq #12,d0
bsr GoPos
moveq #18,d0
bsr CompPos
bsr InitLibs
bsr FActualise
* Compilation
bsr Passe1
bsr Passe2
* Sauvegarde
bsr SObject
bsr SIcon
move.w #143,d0
bsr GoPos
bsr FActualise
* Nettoyage
CFin
moveq #29,d0
bsr MesPrint
move.l MaxMem(a5),d0
bsr Digit
moveq #31,d0
bsr MesPrint
*
moveq #30,d0
bsr MesPrint
move.l L_Objet(a5),d0
bsr Digit
moveq #31,d0
bsr MesPrint
*
moveq #32,d0
bsr MesPrint
IFNE CDebug
bsr Print_Buffers
ENDC
moveq #0,d0
move.l L_Objet(a5),d1
moveq #0,d2
move.w NbInstr(a5),d2
bra CFini
******* Re-initialisation Datazone
ResetDZ
movem.l a0/d0,-(sp)
move.l a5,a0
move.w #LDZ-1,d0
Rdz clr.b (a0)+
dbra d0,Rdz
movem.l (sp)+,a0/d0
rts
******* Exploration d'une ligne de commande...
CommandLine:
; Saute le d<>but
.Cli0 move.b (a0)+,d0
beq .CliX
cmp.b #" ",d0
beq.s .Cli0
subq.l #1,a0
; Nom du programme SOURCE?
cmp.b #"-",(a0)
beq.s .CliO
lea Nom_Source(a5),a1
move.l a1,d2
bsr .CliNom
; Options
.CliO move.b (a0)+,d0
beq .CliX
cmp.b #" ",d0
beq.s .CliO
cmp.b #"-",d0
bne .CliE
move.b (a0)+,d0
beq .CliE
bsr D0Maj
cmp.b #"D",d0
beq .ClioD
cmp.b #"O",d0
beq .ClioO
cmp.b #"C",d0
beq .ClioC
cmp.b #"F",d0
beq .ClioF
cmp.b #"E",d0
beq .ClioE
cmp.b #"S",d0
beq .ClioS
cmp.b #"T",d0
beq .ClioT
cmp.b #"W",d0
beq .ClioW
cmp.b #"Q",d0
beq .ClioQ
cmp.b #"L",d0
beq .ClioL
cmp.b #"Z",d0
beq .ClioZ
** Erreur dans la commandline
.CliE moveq #-1,d0
rts
** OK!
.CliX moveq #0,d0
rts
** OPTION -D<source><sbjet>
.ClioD bsr .Cli01
move.w d0,Flag_Source(a5)
bsr .Cli01
move.w d0,Flag_Objet(a5)
bra .CliO
** OPTION -Errors
.ClioE bsr .Cli01
move.w d0,Flag_Errors(a5)
bra .CliO
** OPTION -L
.ClioL move.w #1,Flag_Long(a5)
bra .CliO
** OPTION -Screen
.ClioS bsr .Cli01
move.w d0,Flag_Default(a5)
bra .CliO
** OPTION -Object
.ClioO lea Nom_Objet(a5),a1
bsr .CliNom
bra .CliO
** OPTION -Configuration
.ClioC lea Nom_Liste(a5),a1
bsr .CliNom
bra .CliO
** OPTION -FromDEVICE:
.ClioF lea Nom_From(a5),a1
bsr .CliNom
bra .CliO
** OPTION Type : 0=WB / 1=CLI / 2=Backstart / 3=AMOS
.ClioT bsr .CliDigit
move.w d0,Flag_Type(a5)
bra .CliO
** OPTION Wb01 : 0= AMOS / 1= WB
.ClioW bsr .Cli01
move.w d0,Flag_WB(a5)
bra .CliO
** OPTION Quiet
.ClioQ or.w #1,Flag_Quiet(a5)
bra .CliO
** OPTION Z
.ClioZ bsr .CliDigit
move.w d0,d1
mulu #10,d1
bsr .CliDigit
add.b d0,d1
move.w d1,Flag_Flash(a5)
bra .CliO
** Routines
.CliNom move.b #" ",d1
move.b (a0),d0
beq.s .Clin1
cmp.b #'"',d0
beq.s .ClinB
cmp.b #"'",d0
bne.s .Clin0
.ClinB move.b d0,d1
addq.l #1,a0
.Clin0 move.b (a0),d0
beq.s .Clin1
addq.l #1,a0
cmp.b d0,d1
beq.s .Clin1
move.b d0,(a1)+
bra.s .Clin0
.Clin1 clr.b (a1)
rts
.Cli01 move.b (a0)+,d1
beq .CliE
clr.w d0
cmp.b #"0",d1
beq.s .Cli01x
cmp.b #"1",d1
bne .CliE
subq.w #1,d0
.Cli01x rts
.CliDigit
moveq #0,d0
move.b (a0)+,d0
beq .CliE
sub.b #"0",d0
bcs .CliE
rts
D0Maj cmp.b #"a",d0
bcs.s D0mx
cmp.b #"z",d0
bhi.s D0mx
sub.b #$20,d0
D0mx rts
******* Fabrique le nom du programme OBJET, si NOM.AMOS!
IniNOb tst.b Nom_Objet(a5)
bne.s NObX
lea Nom_Source(a5),a1
move.l a1,d2
.Nob tst.b (a1)+
bne.s .Nob
subq.l #1,a1
lea SOMA(pc),a2
.Cli2 cmp.l d2,a1
bls.s NObx
move.b (a2)+,d1
beq.s .Cli3
move.b -(a1),d0
bsr D0Maj
cmp.b d0,d1
beq.s .Cli2
bne.s NObx
.Cli3 exg d2,a1
lea Nom_Objet(a5),a2
.Cli4 move.b (a1)+,(a2)+
cmp.l d2,a1
bcs.s .Cli4
; Si type=4, nom= nom_C.AMOS
cmp.w #3,Flag_Type(a5)
bne.s .Cli6
lea _C.AMOS(pc),a1
.Cli5 move.b (a1)+,(a2)+
bne.s .Cli5
.Cli6 clr.b (a2)
NObX rts
;---------------------------------------------------------------------
; *** *** ** ** **** **** ** ** ** ** ** *** ***
; ** ** ** *** *** ** ** ** ** ** **** *** *** ** ** **
; ** ** ** ** * ** ** ** ** ** ** ** ** ** * ** ** ** ***
; ** ** ** ** ** **** ** ** ****** ** ** ** ** **
; ** ** ** ** ** ** ** ** ** ** ** ** ** ** * **
; *** *** ** ** ** **** **** ** ** ** ** *** ***
;---------------------------------------------------------------------
; SORTIE compilation
;---------------------------------------------------------------------
******* Actualisation position compilateur
Actualise
tst.w Flag_AMOS(a5)
bpl.s .End
move.l AMOS_Dz(a5),a0
tst.b T_Actualise(a0)
bne.s DoVbl
.End rts
* Un VBL!
DoVbl movem.l a1-a6/d1-d7,-(sp)
lea AMOS_Save(pc),a0
movem.l (a0),a3-a6
* Actualise
SyCall Synchro
* Break
move.w T_Actualise(a5),d7
clr.w T_Actualise(a5)
bclr #BitControl,d7
beq.s .cont
movem.l (sp)+,a1-a6/d1-d7
bra ErrAbort
* Affiche le bob?
.cont bclr #BitBobs,d7
beq.s .skip
SyCall ActBob
SyCall AffBob
.skip movem.l (sp)+,a1-a6/d1-d7
rts
******* Set compiler position...
GoPos bsr CompPos
bra FActualise
CompPos tst.w Flag_AMOS(a5)
bmi.s .Yes
rts
.Yes movem.l d0-d7/a1-a6,-(sp)
move.l AMOS_Dz(a5),a5
moveq #-1,d1
moveq #0,d2
moveq #0,d3
SyCall AMALReg
movem.l (sp)+,d0-d7/a1-a6
move.w d0,(a0)
move.w d0,Pour_Pos(a5)
rts
******* Fait progresser la fleche -> fin
FActualise
tst.w Flag_AMOS(a5)
bmi.s .Loop
rts
.Loop bsr Actualise
movem.l d1-d7/a1-a2/a5,-(sp)
move.l AMOS_Dz(a5),a5
moveq #-1,d1
moveq #0,d2
moveq #1,d3
SyCall AMALReg
movem.l (sp)+,d1-d7/a1-a2/a5
move.w (a0),d0
cmp.w Pour_Pos(a5),d0
bcs.s .loop
rts
******* Set pourcentage
* D0= largeur alouee
* D1= nombre de pas
SetPour divu d0,d1
tst.w d1
bne.s .skip
moveq #1,d1
.skip move.w d1,Pour_Base(a5)
move.w d1,Pour_Cpt(a5)
add.w Pour_Pos(a5),d0
bra CompPos
******* Un pas d'affichage...
AffPour tst.w Flag_AMOS(a5)
bpl.s .Skip
subq.w #1,Pour_Cpt(a5)
bne.s .Skip
move.w Pour_Base(a5),Pour_Cpt(a5)
bsr DoVBL
.Skip rts
******* Print un chiffre!
Digit movem.l d1-d7/a0-a2,-(sp)
move.l B_Work(a5),a0
bsr LongDec
clr.b (a0)
move.l B_Work(a5),a0
bsr StrPrint
movem.l (sp)+,d1-d7/a0-a2
rts
******* Syntax error!
Synt
moveq #7,d0
NoQuiet
move.w Flag_Quiet(a5),-(sp)
bmi.s .skip
clr.w Flag_Quiet(a5)
bsr MesPrint
bsr FindL
bsr Digit
bsr Return
.skip
move.w (sp)+,Flag_Quiet(a5)
moveq #12,d0
bra SyntOut
******* Compilation aborted!
ErrAbort
moveq #9,d0
bra.s ErrPrint
******* Erreur: program not tested!
ErrNotest
moveq #12,d0
bra.s ErrPrint
******* Erreur: not an AMOS program!
ErrNoAMOS
moveq #13,d0
bra.s ErrPrint
******* Erreur: label not defined
ErrLabel
bclr #31,d0
move.l d0,a6
moveq #14,d0
bra.s NoQuiet
******* Erreur program already compiled
ErrAlready
moveq #15,d0
bra.s ErrPrint
******* Erreur: use the -l option
ErrDoLong
moveq #16,d0
bra.s ErrPrint
******* Erreur: nothing to compile!
ErrNothing
moveq #10,d0
bra.s ErrPrint
******* Erreur: bad list!
ErrListe
moveq #4,d0
bra.s ErrPrint
******* Erreur: cannot uncode procedure
NoCode
moveq #8,d0
bra.s ErrPrint
******* Erreur: extension not loaded.
ErrExt
moveq #3,d0
bra.s ErrPrint
******* Syntax error dans la ligne de commande
ErrCommand
moveq #1,d0
bra.s ErrPrint
******* Syntax error dans la ligne de commande LISTE
ErrComList
moveq #2,d0
bra.s ErrPrint
******* Syntax error dans la configuration
ErrConfig
moveq #11,d0
bra.s ErrPrint
******* Erreur disque
DError
moveq #5,d0
bra.s ErrPrint
******* Erreur icons
NoIcons
moveq #4,d0
bra.s ErrPrint
******* Out of mem
Oofmem
moveq #6,d0
******* Sortie avec erreur!
ErrPrint
move.w d0,-(sp)
move.w Flag_Quiet(a5),-(sp)
bmi.s .skip
clr.w Flag_Quiet(a5)
bsr MesPrint
.skip
move.w (sp)+,Flag_Quiet(a5)
move.w (sp)+,d0
SyntOut
add.w #Mes_BaseNoms,d0
bsr GetNom
lea Nom_Source(a5),a1
.loop move.b (a0)+,(a1)+
beq.s .loop1
cmp.b #32,-1(a1)
bcc.s .loop
subq.l #1,a1
bra.s .loop
.loop1 tst.l B_Noms(a5)
beq.s .loop2
moveq #32,d0
bsr MesPrint
.loop2
; Efface l'objet, si cree
bsr KObject
; Retour de parametres
moveq #10,d0
moveq #0,d1
moveq #0,d2
******* Abort general!
CFini movem.l d0/d1/d2,-(sp)
bsr EraBuffer
bsr FinIcons
bsr FinDisc
movem.l (sp)+,d0/d1/d2
CFini2 lea Nom_Source(a5),a0
move.l C_Pile(a5),sp
rts
IFNE CDebug
******* Imprime l'etat des buffers
Print_Buffers:
lea Mes_Buffers(pc),a4
lea B_Work(a5),a3
.Loop0 move.l a4,a0
bsr StrPrint
move.l (a3),d0
beq.s .Loop3
move.l d0,a2
move.l -4(a2),d6
subq.l #4,d6
lea 0(a2,d6.l),a1
.Loop1 tst.l -(a1)
bne.s .Loop2
cmp.l a2,a1
bhi.s .Loop1
.Loop2 addq.l #4,a1
move.l a1,d7
sub.l a2,d7
move.l d7,d0
bsr Digit
lea Mes_Bufs2(pc),a0
bsr StrPrint
move.l d6,d0
bsr Digit
lea Mes_Bufs3(pc),a0
bsr StrPrint
move.l d6,d0
sub.l d7,d0
bsr Digit
bsr Return
.Loop3 tst.b (a4)+
bne.s .Loop3
addq.l #4,a3
tst.b (a4)
bne.s .Loop0
bsr Return
rts
ENDC
******* Trouve le num<EFBFBD>ro de la ligne pointee par A6->D0
FindL move.l a6,d2
move.l #20,a6
moveq #0,d1
.Loop0 addq.l #1,d1
bsr GetWord
lsr.w #8,d0
beq.s .Loop2
lsl.w #1,d0
lea -2(a6,d0.w),a6
cmp.l d2,a6
bcs.s .Loop0
* Trouve!
.Loop1 move.l d1,d0
rts
* Pas trouve!
.Loop2 moveq #-1,d0
rts
******* Imprime le message D0
MesPrint
tst.w Flag_Quiet(a5)
bne.s PrintXXX
* Imprime le message...
movem.l a0-a6/d0-d7,-(sp)
add.w #Mes_BaseNoms,d0
bsr GetNom
tst.w Flag_Amos(a5)
bne.s AMOSPrint
move.l d0,d3
move.l a0,d2
move.l C_DosBase(a5),a6
jsr -60(a6)
move.l d0,d1
jsr DosWrite(a6)
movem.l (sp)+,a0-a6/d0-d7
PrintXXX
rts
AMOSPrint
move.l B_DiskIn(a5),a1
.Loop1 move.b (a0)+,(a1)+
beq.s .Loop2
cmp.b #10,-1(a1)
bne.s .Loop1
move.b #13,-1(a1)
move.b #10,(a1)+
bra.s .Loop1
.Loop2 clr.b (a1)
move.l B_DiskIn(a5),a1
move.l AMOS_Dz(a5),a5
WiCall Print
movem.l (sp)+,a0-a6/d0-d7
rts
******* Imprime la chaine A0 sur l'output standart
StrPrint
tst.w Flag_Quiet(a5)
bne.s Clip1
movem.l a0-a6/d0-d7,-(sp)
tst.w Flag_AMOS(a5)
bne.s AMOSPrint
move.l a0,-(sp)
move.l C_DosBase(a5),a6
jsr -60(a6)
move.l d0,d1
move.l (sp)+,d2
move.l d2,a0
Clip0 tst.b (a0)+
bne.s Clip0
move.l a0,d3
sub.l d2,d3
subq.l #1,d3
jsr DosWrite(a6)
movem.l (sp)+,a0-a6/d0-d7
Clip1 rts
******* Return
Return
lea Mes_return(pc),a0
bra.s StrPrint
; CONVERSION HEXA--->DECIMAL SUR QUATRE OCTETS
longdec1: move #-1,d3 ;proportionnel
moveq #1,d4 ;avec signe
bra.s longent
longdec: clr.l d4 ;proportionnel, sans espace si positif!
move.l #-1,d3
; conversion proprement dite: LONG-->ENTIER
longent: move.l a1,-(sp)
tst.l d0 ;test du signe!
bpl.s hexy
move.b #"-",(a0)+
neg.l d0
bra.s hexz
hexy: tst d4
beq.s hexz
move.b #32,(a0)+
hexz: tst.l d3
bmi.s hexv
neg.l d3
add.l #10,d3
hexv: move.l #9,d4
lea multdix(pc),a1
hxx0: move.l (a1)+,d1 ;table des multiples de dix
move.b #$ff,d2
hxx1: addq.b #1,d2
sub.l d1,d0
bcc.s hxx1
add.l d1,d0
tst.l d3
beq.s hxx4
bpl.s hxx3
btst #31,d4
bne.s hxx4
tst d4
beq.s hxx4
tst.b d2
beq.s hxx5
bset #31,d4
bra.s hxx4
hxx3: subq.l #1,d3
bra.s hxx5
hxx4: add #48,d2
move.b d2,(a0)+
hxx5: dbra d4,hxx0
move.l (sp)+,a1
rts
* TABLE DES MULTIPLES DE DIX
multdix: dc.l 1000000000,100000000,10000000,1000000
dc.l 100000,10000,1000,100,10,1,0
;---------------------------------------------------------------------
; *** *** ** ** **** **** ** ** ** ** ** *** ***
; ** ** ** *** *** ** ** ** ** ** **** *** *** ** ** **
; ** ** ** ** * ** ** ** ** ** ** ** ** ** * ** ** ** ***
; ** ** ** ** ** **** ** ** ****** ** ** ** ** **
; ** ** ** ** ** ** ** ** ** ** ** ** ** ** * **
; *** *** ** ** ** **** **** ** ** ** ** *** ***
;---------------------------------------------------------------------
; PASSE 1-> Fabrication du code
;---------------------------------------------------------------------
Passe1
* Reservation des buffers
moveq #8,d0
bsr GetChiffre
bsr ResBuffer
move.l a0,B_FlagVarL(a5)
moveq #7,d0
bsr GetChiffre
bsr ResBuffer
move.l a0,B_FlagVarG(a5)
move.l a0,A_FlagVarL(a5)
moveq #5,d0
bsr GetChiffre
bsr ResBuffer
move.l a0,B_Chaines(a5)
move.l a0,A_Chaines(a5)
moveq #8,d0
bsr GetChiffre
bsr ResBuffer
move.l a0,B_Lea(a5)
move.l a0,A_Lea(a5)
move.l #$7FFFFFFF,(a0)
moveq #6,d0
bsr GetChiffre
bsr ResBuffer
move.l a0,B_Labels(a5)
moveq #7,d0
bsr GetChiffre
bsr ResBuffer
move.l a0,B_Bcles(a5)
move.l a0,A_Bcles(a5)
move.l #128,d0
bsr ResBuffer
move.l a0,B_Stock(a5)
move.l a0,A_Stock(a5)
* Longueur du buffer par default
move.l #8,L_Buf(a5)
* Relocation
bsr InitRel
* Adresses SORTIE / ENTREE
sub.l a4,a4
lea 20,a6
******* Message
moveq #22,d0
bsr MesPrint
moveq #36,d0
moveq #0,d1
move.w NL_Source(a5),d1
bsr SetPour
******* Va fabriquer le header
bsr Header
;-----> Debut du hunk programme
moveq #NH_Prog,d1
moveq #Hunk_Public,d2
bsr DebHunk
;-----> Debut de la relocation
move.l a4,DebRel(a5)
move.l a4,OldRel(a5)
;-----> NO DATAS
bsr CreNoData
;-----> Appel des routines d'init
bsr CreeInits
;-----> Code bug
IFNE CDebug
lea BugCode(pc),a0
bsr OutCode
ENDC
;--------------------------------------> Programme principal
bsr PrgIn
moveq #L_PrgIn,d0
bsr CreFonc
ChrGet bsr AffPour
cmp.l A_Banks(a5),a6
beq.s ChrEnd
bsr GetWord
beq.s ChrEnd
; Regarde la table des branchements en avant
Chr0 move.l B_Lea(a5),a0
cmp.l (a0),a6
bcs.s Chr1
bsr PokeAd
bra.s Chr0
; Appelle l'instruction
Chr1 bsr GetWord
beq.s ChrGet
addq.w #1,NbInstr(a5)
lea Tk(pc),a0
move.w 0(a0,d0.w),d1
bne.s Chr2
bsr IStandard
bra.s Chr0
Chr2 jsr 0(a0,d1.w) * Une autre instruction
bra.s Chr0
* Appelle la routine de fin
ChrEnd move.w #L_End,d0
bsr CreJmp
move.l AdAdress(a5),AdAdAdress(a5)
move.w Flag_Labels(a5),OFlag_Labels(a5)
move.w Flag_Procs(a5),OFlag_Procs(a5)
move.l B_FlagVarL(a5),A_FlagVarL(a5)
move.l A_Datas(a5),A_ADatas(a5)
move.w M_ForNext(a5),MM_ForNext(a5)
* Quelque chose <EFBFBD> compiler???
tst.w NbInstr(a5)
beq ErrNothing
;--------------------------------------> Procedures
move.l B_Labels(a5),A_Proc(a5)
PChr1 move.l A_Proc(a5),a0
moveq #-6,d0
PChr2 lea 6(a0,d0.w),a0
move.w (a0),d0
beq PChrX
move.l 2(a0),d1
bclr #30,d1
beq.s PChr2
move.l d1,a6
move.l a4,2(a0)
* Adresse de la fin de la procedure
bsr GetLong
subq.l #4,a6
lea 10-2(a6,d0.l),a0
move.l a0,F_Proc(a5)
* Stockage position actuelle
move.w CMvqd0(pc),d0
bsr OutWord
moveq #L_DProc1,d0
bsr CreFonc
bsr PrgIn
moveq #L_PrgIn,d0
bsr CreFonc
* Adresse des variables
lea 10(a6),a6
bsr Sovar
moveq #0,d7
moveq #0,d6
bsr GetWord
subq.l #2,a6
cmp.w #TkBra1-Tk,d0
bne.s DPro6
addq.l #2,a6
DPro0 addq.l #2,a6
lsl.l #1,d6
addq.l #1,d7
movem.l d6/d7,-(sp)
bsr VarAdr
movem.l (sp)+,d6/d7
cmp.b #1,d2
bne.s DPro1
bset #0,d6
DPro1 tst.w d1
bmi.s DPro4
beq.s DPro2
; Variable GLOBALE
move.w CLea2a0a0(pc),d0
bra.s DPro3
; Variable LOCALE
DPro2 move.w CLea2a6a0(pc),d0
DPro3 bsr OutWord
move.w d3,d0
bsr OutWord
bra.s DPro5
; Variable TABLEAU
DPro4 moveq #L_GetTablo,d0
bsr CreFonc
DPro5 move.w Cmva0ma3(pc),d0
bsr OutWord
; Encore un param?
bsr GetWord
cmp.w #TkBra2-Tk,d0
bne.s DPro0
* Entete de la procedure
move.w Cmvqd4(pc),d0 * N params
move.b d7,d0
bsr OutWord
move.w Cmvid5(pc),d0 * Flags des params
bsr OutWord
move.l d6,d0
bsr OutLong
moveq #L_DProc2,d0 * Routine d'egalisation
bsr CreFonc
* Pas de melange des labels!
DPro6 addq.w #1,N_Proc(a5)
* CHRGET!
addq.l #2,a6
ProChr bsr AffPour
bsr GetWord
beq Synt
;
ProChr0 move.l B_Lea(a5),a0
cmp.l (a0),a6
bcs.s ProChr1
bsr PokeAd
bra.s ProChr0
;
ProChr1 bsr GetWord
beq.s ProChr
addq.w #1,NbInstr(a5)
lea Tk(pc),a0
move.w 0(a0,d0.w),d1
bne.s ProChr2
bsr IStandard
bra.s ProChr0
ProChr2 jsr 0(a0,d1.w) * Une autre instruction
bra.s ProChr0
; Fin procedure
CEProc addq.l #4,sp
bsr GetWord * Un parametre???
subq.w #2,a6
cmp.w #TkBra1-Tk,d0
bne.s CEpr2
bsr FnEval
addq.l #2,a6
move.l CdEProE(pc),d0
and.b #$0F,d2
subq.b #1,d2
bmi.s CEpr1
move.l CdEProF(pc),d0
tst.b d2
beq.s CEpr1
move.l CdEProS(pc),d0
CEpr1 bsr OutLong
CEpr2 moveq #L_FProc,d0
bsr CreJmp
move.l A_FlagVarL(a5),a0
bsr PrgOut
bra PChr1
PChrX
;-----> Variables globales
move.l AdAdAdress(a5),AdAdress(a5)
move.l B_FlagVarG(a5),a0
move.l A_ADatas(a5),A_Datas(a5)
move.w OFlag_Labels(a5),Flag_Labels(a5)
move.w OFlag_Procs(a5),Flag_Procs(a5)
move.w MM_ForNext(a5),M_ForNext(a5)
clr.w N_Proc(a5)
bsr PrgOut
;------------------------------------> COPIE LES ROUTINES LIBRAIRIE
moveq #23,d0
bsr MesPrint
bsr FActualise
moveq #36,d0
move.l #36*12,d1
bsr SetPour
move.l B_Bcles(a5),a6
CLib0 lea BufLibs(a5),a2
moveq #-1,d6
CLib1 addq.l #1,d6
move.l (a2)+,d0
bne.s CLib2
cmp.w #M_Libs-1,d6
bne.s CLib1
tst.l d6
bmi.s CLib0
moveq #0,d0
bsr OutRel
bsr OutRel
bra CLibFin
; Une librairie chargee
CLib2 move.l d0,a1
tst.w (a1)
bne.s CLib3
; Pas appel<65>e: met un RTS!
move.l a4,4(a1)
move.w CRts(pc),d0
bsr OutWord
bra.s CLib1
; Appell<6C>e
CLib3 lea 4-10(a1),a1
moveq #-10,d5
CLib4 add.l #10,d5
lea 10(a1),a1
move.l (a1),d0
beq.s CLib4
bmi.s CLib1
subq.l #1,d0
bne.s CLib4
movem.l a1/a2,-(sp)
bsr GetRout
movem.l (sp)+,a1/a2
bset #31,d6
bra.s CLib4
******* Routine recursive de copie d'une routine
* D6= # librairie
* D5= # routine
GetRout movem.l d5/d6,-(sp)
* Actions particulieres sur librairie principale...
tst.w d6
bne.s PaPrin
; Copie les routines FLOAT?
cmp.w #L_FlRout*10,d5
bne.s .PaFl
btst #0,Flag_Math(a5)
bne.s .PaFl
move.w #L_FoFloat*10,d5
.PaFl
; Copie des RUN et ERROR (.AMOS)
cmp.w #3,Flag_Type(a5)
bne.s PaPrin
cmp.w #L_Error*10,d5
bne.s PaPrin
move.w #L_ErrorAMOS*10,d5
PaPrin
; Pointe la librairie
move.w d6,d0
lsl.w #2,d0
lea BufLibs(a5),a2
move.l 0(a2,d0.w),d0
beq DError
move.l d0,a2
move.w 2(a2),d1
move.w d1,MaxCLibs(a5)
addq.l #4,a2
; Est-ce la routine d'erreur d'une extension???
tst.w d6 ; Librairie extension?
beq.s .skip
mulu #10,d1
move.w d5,d0
add.w #20,d0
cmp.w d0,d1 ; Avant derniere routine?
bne.s .skip
tst.w Flag_Errors(a5) ; Erreurs a charger?
bne.s .skip
add.w #10,d5 ; PAS D'ERREURS!!!
.skip
; Continue
move.w d5,d0
add.w d0,a2
move.l (a2),d0
cmp.l #1,d0
bhi GRouX
; Charge la routine dans le buffer
moveq #24,d0
bsr MesPrint
bsr AffPour
move.l a4,(a2) ; Poke l'adresse de la routine
move.l a4,-(sp)
move.w #-1,(a6)+
** Init recopie routine
move.l 4(a2),P_Clib(a5)
moveq #0,d0
move.w 8(a2),d0
lsl.l #1,d0
move.l d0,T_Clib(a5)
moveq #0,d4 * P_CLIB-> D4
** Boucle de recopie, D3 octets
GRou0 bsr LdClib
GRou1 move.b (a2),d0
cmp.b #C_Code1,d0
beq GRou10
GRou2 move.w (a2)+,d0
bsr OutWord
addq.l #2,d4
GRouR cmp.l d3,d4
bcs.s GRou1
cmp.l T_Clib(a5),d4
bcs.s GRou0
; Branche les routines demandees
GRou4 move.w -(a6),d0
bmi.s GRou6
move.w d0,d5
bsr GetRout
move.l a4,d2
move.l -(a6),a4
move.l d0,d1
sub.l a4,d0
cmp.l #-32760,d0
ble.s GRou5
cmp.l #+32760,d0
bge.s GRou5
; Saut relatif OK!
bsr OutWord
move.l d2,a4
bra.s GRou4
; Saut en ARRIERE trop long: BRA-> JMP
GRou5 move.l d2,d0 * 1-> BRA sur le JMP
sub.l a4,d0
cmp.l #-32760,d0
ble DError
cmp.l #+32760,d0
bge DError
bsr OutWord
move.l d2,a4 * 2-> JMP sur la routine
move.w CJmp(pc),d0
bsr OutWord
bsr RelJsr
move.l d1,d0
bsr OutLong
bra.s GRou4
; Ramene l'adresse de la routine
GRou6 move.l (sp)+,d0
;-----> Fin copie routine
GRouX movem.l (sp)+,d5/d6
rts
******* Charge la routine dans le buffer
LdClib move.w d6,d1
addq.w #F_Libs,d1
move.l d4,d2
add.l P_Clib(a5),d2
moveq #-1,d3
bsr FSeek
move.w d6,d1
addq.w #F_Libs,d1
move.l B_DiskIn(a5),d2
move.l T_Clib(a5),d3
sub.l d4,d3
clr.l -(sp)
cmp.l #L_DiscIn,d3
bcs.s Ldcl1
move.l #L_DiscIn,d3
move.l #8,(sp)
Ldcl1 bsr FRead
beq DError
move.l d2,a2
add.l d4,d3
sub.l (sp)+,d3
rts
;-----> Instruction speciale
GRou10 move.w (a2),d0
move.b d0,d2
and.b #$0F,d0
cmp.b #C_Code2,d0
bne GRou2
and.w #$00F0,d2
lsr.w #1,d2
lea GRout(pc),a1
jmp 0(a1,d2.w)
;-----> Table des sauts
GRout bra.s GRouJ ; 0 - RJmp
jmp $FFFFF0
bra.s GRouJ ; 1 - RJsr
jsr $FFFFF0
bra GRouB ; 2 - RBra
bra GRout
bra GRouB ; 3 - RBsr
bsr GRout
bra GRouB ; 4 - RBeq
beq GRout
bra GRouB ; 5 - RBne
bne GRout
bra GRouB ; 6 - RBcs
bcs GRout
bra GRouB ; 7 - RBcc
bcc GRout
bra GRouB ; 8 - RBlt
blt GRout
bra GRouB ; 9 - RBge
bge GRout
bra GRouB ; 10- RBls
bls GRout
bra GRouB ; 11- RBhi
bhi GRout
bra GRouB ; 12- RBle
ble GRout
bra GRouB ; 13- RBpl
bpl GRout
bra GRouB ; 14- RBmi
bmi GRout
bra GRouD ; 15- RData
;-----> RJMP / RJSR
GRouJ cmp.b #C_CodeJ,2(a2)
bne GRou2
moveq #0,d1
move.b 3(a2),d1
cmp.b #27,d1
bcc GRou2
move.w 4(a2),d0
; Poke l'appel
move.w 2(a1,d2.w),d0
bsr OutWord
bsr RelJsr
move.w 4(a2),d0
mulu #10,d0
swap d0
lsl.w #2,d1
move.w d1,d0
swap d0
bset #BitLib,d0
bsr OutLong
addq.l #6,a2
addq.l #6,d4
; Marque la librairie
lea BufLibs(a5),a0
move.l 0(a0,d1.w),d2
beq DError
move.l d2,a0
tst.l 4(a0,d0.w)
bne GRou1
move.l #1,4(a0,d0.w)
bra GRouR
;-----> RBRA etc..
GRouB move.w 2(a2),d1
cmp.w MaxClibs(a5),d1
bcc GRou2
mulu #10,d1
move.w 4(a1,d2.w),d0
bsr OutWord
move.l a4,(a6)+
move.w d1,(a6)+
addq.l #4,a2
addq.l #4,d4
addq.l #2,a4
bra GRouR
;-----> Instruction RDATA
GRouD cmp.w #C_CodeD,2(a2)
bne GRou2
addq.l #4,a2
addq.l #4,d4
move.w CNop(pc),d0
bsr OutWord
bsr OutWord
GRouD1 cmp.l d3,d4
bcc GRouD2
move.w (a2)+,d0
bsr OutWord
addq.l #2,d4
bra.s GRouD1
GRouD2 cmp.l T_Clib(a5),d4
bcc GRou4
bsr LdClib
bra.s GRouD1
CLibFin
; lea Protect(pc),a0
; bsr OutCode
bsr Return
;-----> Copie les constantes alphanumeriques
move.l B_Chaines(a5),a1
bra.s c_ch5
c_ch1 move.l d0,a6
move.l a4,(a1)
bsr GetWord
move.w d0,d1
bsr OutWord
addq.w #1,d1
lsr.w #1,d1
subq.w #1,d1
bmi.s c_ch4
c_ch3 bsr GetWord
bsr OutWord
dbra d1,c_ch3
c_ch4 addq.l #4,a1
c_ch5 move.l (a1),d0
bne.s c_ch1
; Securite un mot long
moveq #0,d0
bsr OutLong
;-----> Fin du hunk programme
moveq #NH_Prog,d1
bsr FinHunk
bsr FActualise
******* HUNK 2: Table de relocation
moveq #NH_Reloc,d1
moveq #Hunk_Public,d2 * En PUBLIC Mem
bsr DebHunk
move.l a4,AA_Reloc(a5)
; Copie
move.l B_Reloc(a5),a1
CRel1 move.b (a1)+,d0
bsr OutByte
tst.b d0
bne.s CRel1
sub.l B_Reloc(a5),a1
move.w a1,L_Reloc(a5)
; Fin du hunk reloc
moveq #NH_Reloc,d1
bsr FinHunk
moveq #93,d0
bsr GoPos
******* Copie du systeme?
cmp.w #3,Flag_Type(a5)
bne CSystem
* AMOS: Copie la fin de la procedure
moveq #0,d0
bsr OutWord
move.l a4,AA_EProc(a5)
move.w #$0301,d0
bsr OutWord
move.w #TkEndP-Tk,d0
bsr OutWord
clr.w d0
bsr OutWord
moveq #108,d0
bsr GoPos
bra NoSystem
******* HUNK 2: W.Lib
CSystem moveq #25,d0
bsr MesPrint
moveq #NH_W.Lib,d1
moveq #Hunk_Public,d2 * PUBLIC mem
moveq #$20,d3 * Pas d'entete
moveq #4,d4
moveq #4-1,d0
bsr GetNom
move.l a0,a1
bsr CopyHunk
moveq #96,d0
bsr GoPos
******* HUNK 4: .Env
moveq #NH_Env,d1
moveq #Hunk_Public,d2
bsr DebHunk
moveq #0,d0 * Mot vide!!!
bsr OutLong
moveq #1,d0
bsr GetNom
move.l a0,a1
moveq #F_Courant,d1
bsr FOpenOld
beq DError
moveq #F_Courant,d1
bsr FLof
move.l d0,d6
moveq #F_Courant,d1
move.l B_Work(a5),d2 * Longueur DATAZONE
moveq #$24,d3
bsr FRead
beq DError
move.l d2,a0
move.l $20(a0),d0
bsr OutLong
sub.l #$24,d6
move.l d6,d0 * Longueur donnees
bsr OutLong
moveq #F_Courant,d1
move.l d6,d3 * Charge
bsr OutFRead
moveq #F_Courant,d1
bsr FClose
moveq #NH_Env,d1
bsr FinHunk
moveq #99,d0
bsr GoPos
******* HUNK 5: Mouse.Abk
moveq #NH_Mouse,d1
move.l #Hunk_Chip,d2 * CHIP mem
bsr DebHunk
move.l a4,-(sp)
lea 16*2(a4),a4 * Place pour la palette
moveq #9-1,d0
bsr GetNom
move.l a0,a1
moveq #F_Courant,d1
bsr FOpenOld
beq DError
moveq #F_Courant,d1
moveq #6,d2
moveq #-1,d3
bsr FSeek
moveq #F_Courant,d1
bsr FLof
moveq #F_Courant,d1
move.l d0,d3 * Tout sauf la palette
sub.l #32*2+6,d3
bsr OutFRead
moveq #-1,d0 * Marque la fin
bsr OutWord
moveq #F_Courant,d1
moveq #16*2,d2 * Saute 1ere moitie palette
moveq #0,d3
bsr FSeek
move.l (sp)+,d0
move.l a4,-(sp)
move.l d0,a4
moveq #16*2,d3
moveq #F_Courant,d1
bsr OutFRead
moveq #F_Courant,d1
bsr FClose
move.l (sp)+,a4
moveq #NH_Mouse,d1
bsr FinHunk
moveq #102,d0
bsr GoPos
******* HUNK 6: Default.Font
moveq #NH_Font,d1 * Numero 5
moveq #Hunk_Public,d2 * PUBLIC mem
moveq #0,d3
moveq #0,d4
moveq #10-1,d0
bsr GetNom
move.l a0,a1
bsr CopyHunk
moveq #105,d0
bsr GoPos
******* HUNK 7: Default.Key
moveq #NH_Key,d1 * Numero 6
moveq #Hunk_Public,d2 * PUBLIC mem
moveq #0,d3
moveq #0,d4
moveq #11-1,d0
bsr GetNom
move.l a0,a1
bsr CopyHunk
moveq #108,d0
bsr GoPos
NoSystem:
******* HUNK 8 - 25 : Banques
moveq #26,d0
bsr MesPrint
moveq #16,d0
moveq #16,d1
bsr SetPour
move.l A_Banks(a5),a6
cmp.w #3,Flag_Type(a5)
beq BankAMOS
* Copie les banques NORMALE
addq.l #4,a6
bsr GetWord
move.w d0,d6
beq P1Finie
moveq #N_HunkSys,d5
BkLoop bsr AffPour
bsr GetLong
cmp.l #"AmSp",d0
beq.s BklS
cmp.l #"AmIc",d0
beq.s BklI
* Banque normale
bsr GetWord * Numero banque
move.w d0,-(sp)
bsr GetWord
moveq #Hunk_Public,d2
move.w d0,-(sp)
bne.s Bkl1
move.l #Hunk_Chip,d2
Bkl1 move.l d5,d1
bsr DebHunk
move.l a4,d7
bsr GetLong
move.l d0,d3 0-> Longueur reelle
and.l #$FFFFFFF,d3 avec flags: 31-> DATA, 30-> CHIP
tst.w (sp)+
bne.s Bkl1a
bset #30,d0
Bkl1a bsr OutLong
move.w (sp)+,d0 4-> Numero
bsr OutWord
clr.w d0 6-> 0
bsr OutWord
bsr CopySrce
bra BklEnd
* Banque de sprites/Icones
BklS pea Nom_Spr(pc)
move.w #-1,-(sp)
bra.s Bkl2
BklI pea Nom_Ico(pc)
move.w #-2,-(sp)
Bkl2 move.l d5,d1
move.l #Hunk_Chip,d2
bsr DebHunk
move.l a4,d7
bsr GetWord 0-> Nombre sprite/icones
ext.l d0
bsr OutLong
move.w d0,d4
move.w (sp)+,d0 4-> -1 sprites / -2 icones
bsr OutWord
clr.w d0 6-> 0
bsr OutWord
* Place pour la table d'entete
move.l (sp)+,a1
move.l (a1)+,d0
bsr OutLong
move.l (a1)+,d0
bsr OutLong
move.l a4,a3
move.w d4,d0
lsl.w #3,d0
lea 2+64+6(a4,d0.w),a4
move.w d4,d2
subq.w #1,d2
bmi.s Bkl4
move.l B_Lea(a5),a2
* Copie les bobs
Bkl3 move.l a4,d7
bsr GetWord TX
move.w d0,d3
bsr OutWord
bsr GetWord TY
mulu d0,d3
bsr OutWord
bsr GetWord NPlan
mulu d0,d3
bsr OutWord
bsr GetLong
bsr OutLong
lsl.l #1,d3
beq.s Bkl3a
bsr CopySrce
bra.s Bkl3c
Bkl3a lea -10(a4),a4
Bkl3c bsr Mult8
move.l a4,d0
sub.l d7,d0
move.l d0,(a2)+
dbra d2,Bkl3
* Refait l'entete
Bkl4 exg a4,a3
move.w d4,d0
bsr OutWord
subq.w #1,d4
bmi.s Bkl4b
move.l B_Lea(a5),a2
Bkl4a move.l (a2)+,d0
bsr OutLong
moveq #0,d0
bsr OutLong
dbra d4,Bkl4a
Bkl4b moveq #64,d3
bsr CopySrce
exg a4,a3
move.l a4,d7
* Fin de la banque
BklEnd bsr Mult8
move.l d5,d1
bsr FinHunk
addq.w #1,d5
subq.w #1,d6
bne BkLoop
bra P1Finie
******* Copie les banques / AMOS
BankAMOS
move.l L_Source(a5),d3 FACILE!
sub.l a6,d3
bsr CopySrce
******* Fin de la passe 1
P1Finie bsr FActualise
move.l a4,L_Objet(a5)
rts
* ROUTINE: rend multiple de 8
Mult8 move.l a4,d0
sub.l d7,d0
and.l #7,d0
beq.s Mu8.2
moveq #8,d1
sub.l d0,d1
beq.s Mu8.2
lsr.w #1,d1
Mu8.1 moveq #0,d0
bsr OutWord
subq.w #1,d1
bne.s Mu8.1
Mu8.2 rts
* ROUTINE: Entree programme/procedure
PrgIn move.l a4,AdAdress(a5)
move.w Cleaa0(pc),d0
bsr OutWord
bsr RelJsr
addq.l #4,a4
move.w Cleaa1(pc),d0
bsr OutWord
bsr RelJsr
addq.l #4,a4
move.w Cleaa2(pc),d0
bsr OutWord
bsr RelJsr
addq.l #4,a4
move.l A_FlagVarL(a5),a0
clr.w (a0)
clr.l A_Datas(a5)
clr.w Flag_Labels(a5)
clr.w Flag_Procs(a5)
clr.w M_ForNext(a5)
rts
* ROUTINE -> Sortie programme/procedures
* A0-> Buffer a copier
PrgOut move.l a4,-(sp)
move.l a0,-(sp)
tst.w Flag_Labels(a5)
beq.s PaClb
move.w N_Proc(a5),d7
move.l B_Labels(a5),a2
move.w (a2),d2
beq.s ClbX
Clb1 cmp.w -2+6(a2,d2.w),d7
beq.s Clb0
tst.w Flag_Procs(a5) * Pour le moment PROC a$, interdit!
beq.s Clb3
tst.w -2+6(a2,d2.w)
bpl.s Clb3
Clb0 move.w d2,d0
bsr OutWord
bsr RelJsr
move.l 2(a2),d0
bsr OutLong
lea 6(a2),a1
move.w d2,d1
lsr.w #1,d1
subq.w #1,d1
Clb2 move.w (a1)+,d0
bsr OutWord
dbra d1,Clb2
Clb3 lea 6(a2,d2.w),a2
move.w (a2),d2
bne.s Clb1
ClbX moveq #0,d0
bsr OutWord
clr.w Flag_Labels(a5)
* Copie la table des flags variable
PaClb move.l (sp),a1
move.l a4,(sp)
move.w M_ForNext(a5),d0
bsr OutWord
move.w (a1)+,d0
moveq #0,d1
move.w d0,d1
neg.w d0
bsr OutWord
divu #6,d1
subq.w #1,d1
bmi.s CFg2
CFg1 move.b (a1)+,d0
bsr OutByte
dbra d1,CFg1
CFg2 moveq #-1,d0
bsr OutByte
bsr A4Pair
* Change les adresses au debut de la procedure
move.l a4,-(sp)
move.l AdAdress(a5),a4
addq.l #2,a4
move.l 8(sp),d0
bsr OutLong
addq.l #2,a4
move.l 4(sp),d0
bsr OutLong
addq.l #2,a4
move.l A_Datas(a5),d0
bne.s CFg3
move.l A_EDatas(a5),d0
CFg3 bsr OutLong
move.l (sp)+,a4
addq.l #8,sp
rts
*********************************************************************
* Fabrique le header...
Header cmp.w #3,Flag_Type(a5)
beq HeaderAMOS
******* Programme NORMAL
* Fabrique le HUNK entete
move.l #$3F3,d0 * AmigaDos
bsr OutLong
moveq #0,d0 * Pas de nom
bsr OutLong
move.w N_Banks(a5),d1
ext.l d1
addq.w #N_HunkSys,d1
move.l d1,d0
bsr OutLong
moveq #0,d0 * Debut=0
bsr OutLong
move.l d1,d0
subq.l #1,d0
bsr OutLong
lsl.w #2,d1 * Saute les tailles
lea 0(a4,d1.w),a4
* Fabrique le hunk header
moveq #NH_Header,d1
moveq #Hunk_Public,d2
bsr DebHunk
moveq #5-1,d0
cmp.w #2,Flag_Type(a5)
bne.s .Skip
moveq #6-1,d0
.Skip bsr GetNom
move.l a0,a1
moveq #F_Courant,d1
bsr FOpenOld
beq DError
moveq #F_Courant,d1
move.l B_Work(a5),d2
moveq #$20+2+4,d3
bsr FRead
beq DError
move.l d2,a1
; Envoie le BRA
move.w $22(a1),d0
bsr Outword
; Envoie les FLAGS
moveq #0,d0
move.w Flag_Flash(a5),d0 Couleur a flasher
lsl.w #8,d0
tst.w Flag_WB(a5) Workbench???
bne.s .Skip1
bset #0,d0
.Skip1 bsr OutWord
; Envoie le reste
moveq #0,d3
move.w $20(a1),d3
sub.w #4,d3
moveq #F_Courant,d1
bsr OutFRead
moveq #F_Courant,d1
bsr FClose
moveq #NH_Header,d1
bsr FinHunk
rts
******* Programme AMOS
HeaderAMOS
moveq #7-1,d0
bsr GetNom
move.l a0,a1
bsr LoadInBuffer
move.l d5,a1
* Recopie le header AMOS Basic
moveq #3,d1
.loop0 move.l (a1)+,d0
bsr OutLong
dbra d1,.loop0
move.l a4,AA_Long(a5)
* Recopie en cherchant le SET BUFFER
.loop1 move.w (a1)+,d0
bsr OutWord
cmp.w #TkSBu-Tk,d0
bne.s .loop1
move.l a4,AA_SBuf(a5)
* Cherche maintenant le PROCEDURE
.loop2 move.w (a1)+,d0
bsr OutWord
cmp.w #TkProc-Tk,d0
bne.s .loop2
move.l a4,AA_Proc(a5)
move.l (a1)+,d0
bsr OutLong
move.l (a1)+,d0
or.w #%0101000000000000,d0
bsr OutLong
* Cherche maintenant le CMPCALL
.loop3 move.w (a1)+,d0
bsr OutWord
cmp.w #TkExt-Tk,d0
bne.s .loop3
cmp.w #Ext_Nb*256,(a1)
bne.s .loop3
cmp.w #Ext_TkCmp,2(a1)
bne.s .loop3
move.l (a1)+,d0
bsr OutLong
* Sort des zeros
move.l a4,A_InitMath(a5)
moveq #0,d0
bsr OutWord
bsr OutLong
bsr OutLong
* Efface le programme
bsr EraInBuffer
* Debut du programme proprement dit!
rts
***********************************************************************
* Fabrique les routines d'init
CreeInits
cmp.w #3,Flag_Type(a5)
beq InitAMOS
******* Programme normal
move.l a4,A_InitMath(a5)
move.w CMvqd0(pc),d0 * Flags
bsr OutWord
move.w CMvid1(pc),d0 * Taille du buffer
bsr OutWord
moveq #0,d0
bsr OutLong
moveq #L_Init1,d0
bsr CreFonc
lea BufLibs+4(a5),a1
moveq #1,d1
IInit0 move.l (a1)+,d0
beq.s IInit1
move.l d0,a0
move.w (a0),-(sp)
movem.l d1/a0/a1,-(sp)
moveq #0,d0
bsr CreFoncExt
movem.l (sp)+,d1/a0/a1
move.w (sp)+,(a0)
IInit1 addq.w #1,d1
cmp.w #26,d1
bls.s IInit0
moveq #L_Init2,d0
bsr CreFonc
rts
******* Programme .AMOS
InitAMOS
move.w #L_AMOSIn,d0
bsr CreFonc
rts
;---------------------------------------------------------------------
; *** *** ** ** **** **** ** ** ** ** ** *** ***
; ** ** ** *** *** ** ** ** ** ** **** *** *** ** ** **
; ** ** ** ** * ** ** ** ** ** ** ** ** ** * ** ** ** ***
; ** ** ** ** ** **** ** ** ****** ** ** ** ** **
; ** ** ** ** ** ** ** ** ** ** ** ** ** ** * **
; *** *** ** ** ** **** **** ** ** ** ** *** ***
;---------------------------------------------------------------------
; PASSE 2-> Relocation
;---------------------------------------------------------------------
Passe2
cmp.w #3,Flag_Type(a5)
beq P2AMOS
******* Copie toutes les longueurs de HUNKS dans l'entete
sub.l a4,a4
lea 20(a4),a4
moveq #N_HunkSys-1,d4
add.w N_Banks(a5),d4
lea T_Hunks(a5),a1
CLhu1 move.l 4(a1),d0
bsr OutLong
addq.l #8,a1
dbra d4,CLhu1
******* Longueur du hunk programme
moveq #NH_Header,d1
bsr MarkHunk
moveq #NH_Prog,d1
bsr MarkHunk
******* Flags ouverture...
move.l A_InitMath(a5),a4
move.w CMvqd0(pc),d0
move.b Flag_Math(a5),d0
tst.w Flag_Default(a5)
beq.s .Label
bset #2,d0
.Label bsr OutWord
addq.l #2,a4
move.l L_Buf(a5),d0
mulu #1024,d0
add.l #512,d0
bsr OutLong
bra P2Reloc
******* Programme .AMOS, fabrique l'entete
P2AMOS move.l AA_Long(a5),a4 * Longueur du source
move.l AA_EProc(a5),d0
add.l #6-4,d0
sub.l a4,d0
bsr OutLong
move.l AA_SBuf(a5),a4 * Instruction Set Buffer
addq.l #2,a4
move.l L_Buf(a5),d0
* add.l #512,d0
bsr OutLong
move.l AA_Proc(a5),a4
move.l AA_EProc(a5),d0
sub.l a4,d0
subq.l #4,d0
bsr OutLong
move.l A_InitMath(a5),a4 * Flags maths
moveq #0,d0
move.b Flag_Math(a5),d0
bsr OutWord
move.l AA_Reloc(a5),d0 * Pointeur sur relocation
sub.l a4,d0
bsr OutLong
******* Reloge le programme
P2Reloc
moveq #10,d0
moveq #0,d1
move.w L_Reloc(a5),d1
bsr SetPour
move.l DebRel(a5),d7 ;Base de toute les adresses
move.l d7,a4 ;Debut de l'exploration
move.l B_Reloc(a5),a6 ;Table de relocation
P2a: bsr AffPour
move.b (a6)+,d0
beq.s P2Fin
cmp.b #1,d0
bne.s P2b
lea 508(a4),a4
bra.s P2a
; Affyche la position
P2b: and.w #$FF,d0
lsl.w #1,d0
add.w d0,a4
bsr GtoLong
subq.l #4,a4
bclr #BitLib,d0
bne.s P2L
bclr #BitChaine,d0
bne.s P2S
bclr #BitLabel,d0
bne.s P2G
; Simple JSR
sub.l d7,d0
bsr OutLong
subq.l #4,a4
bra.s P2a
; Trouve l'adresse d'une routine librairie
P2L move.w d0,d1
swap d0
lea BufLibs(a5),a0
move.l 0(a0,d0.w),a0
move.l 4(a0,d1.w),d0 ;Adresse absolue de la routine
sub.l d7,d0
bsr OutLong
subq.l #4,a4
bra.s P2a
; Trouve l'adresse d'une chaine
P2S move.l d0,a1
move.l (a1),d0
sub.l d7,d0
bsr OutLong
subq.l #4,a4
bra.s P2a
; Adresse d'un label
P2G move.l d0,a1
move.l 2(a1),d0
bmi ErrLabel
sub.l d7,d0
bsr OutLong
subq.l #4,a4
bra.s P2a
P2Fin
******* Marque les longueurs des HUNKS
cmp.w #3,Flag_Type(a5)
beq.s P2Finie
moveq #NH_Reloc,d2
move.w N_Banks(a5),d3
add.w #N_HunkSys-3,d3
P2hu move.w d2,d1
bsr MarkHunk
addq.w #1,d2
dbra d3,P2Hu
******* Fin passe 2
P2Finie bsr FActualise
rts
;---------------------------------------------------------------------
; *** *** ** ** **** **** ** ** ** ** ** *** ***
; ** ** ** *** *** ** ** ** ** ** **** *** *** ** ** **
; ** ** ** ** * ** ** ** ** ** ** ** ** ** * ** ** ** ***
; ** ** ** ** ** **** ** ** ****** ** ** ** ** **
; ** ** ** ** ** ** ** ** ** ** ** ** ** ** * **
; *** *** ** ** ** **** **** ** ** ** ** *** ***
;---------------------------------------------------------------------
; Gestion des librairies / Relocation
;---------------------------------------------------------------------
******* Charge la LIB LIST et les datas. Fabrique la liste des noms.
InitListe
; Trouve le nom des datas
moveq #2,d3 PAL
move.l C_GfxBase(a5),a0
move.w 212(a0),d0
cmp.w #300,d0
bcc.s .skip
moveq #3,d3 NTSC
.skip tst.w Flag_Errors(a5)
bne.s .Init0
moveq #4,d3 NO ERRORS
.Init0 move.w d3,d7
bsr ListeNom
move.l B_DiskIn(a5),a3
lea 128(a3),a3
move.l a3,d3
moveq #-1,d2
bsr CopyNom
* Charge les datas
move.l d3,d1
move.l C_DosBase(a5),a6
jsr DosLoadSeg(a6)
tst.l d0
beq DError
move.l d0,d4
lsl.l #2,d0
addq.l #8,d0
move.l d0,a4
* Estimation de la taille
moveq #0,d2
move.w d7,d3
bsr InitNoms
* Reserve le buffer, recommence!
move.l d2,d0
addq.l #8,d0
bsr ResBuffer
move.l a0,a3
move.l a0,B_Noms(a5)
moveq #-1,d2
move.w d7,d3
bsr InitNoms
* Reserve le buffer des pointeurs
move.l d3,d0
lsl.w #1,d0
addq.w #8,d0
bsr ResBuffer
move.l a0,B_Pointeurs(a5)
move.l B_Noms(a5),a1
subq.w #1,d3
.Init1 move.l a1,d1
.Init2 tst.b (a1)+
bne.s .Init2
sub.l a1,d1
neg.l d1
move.w d1,(a0)+
dbra d3,.Init1
* Enleve le .Env
move.l C_DosBase(a5),a6
move.l d4,d1
jsr DosULoadSeg(a6)
* Enleve le buffer et revient.
bsr EraInBuffer
rts
** Charge le fichier dans un buffer...
LoadInBuffer
moveq #F_Courant,d1
bsr FOpenOld
beq DError
moveq #F_Courant,d1
bsr FLof
move.l d0,d6
bsr RamFast
move.l d0,d5
beq OOfMem
move.l d5,InBuf(a5)
move.l d6,InBufs(a5)
moveq #F_Courant,d1
move.l d5,d2
move.l d6,d3
bsr FRead
beq DError
moveq #F_Courant,d1
bsr FClose
rts
** Enleve le buffer
EraInBuffer
move.l InBuf(a5),d0
beq.s EraIb
clr.l InBuf(a5)
move.l d0,a1
move.l InBufs(a5),d0
bsr RamFree
EraIb rts
** Trouve les noms des librairies principales
InitNoms
* .Env
bsr ListeNom
bsr CopyNom
* Librairies principales
moveq #5,d3
.Init1 bsr ListeNom
bsr CopyNom
addq.w #1,d3
cmp.w #11,d3
bcs.s .Init1
* Trouve les noms des fichiers par defaut
bsr ListeNom
move.w #ANMouse,d0
bsr GetA1
bsr EnvOuListe
moveq #12,d3
bsr ListeNom
move.w #ANFonte,d0
bsr GetA1
bsr EnvOuListe
moveq #13,d3
bsr ListeNom
move.w #AKyNom,d0
bsr GetA1
bsr EnvOuListe
* Trouve les noms des extensions
moveq #14,d3
move.w #AExtNames,d0
bsr GetA1
move.l a1,a2
.Init2 bsr ListeNom
move.l a2,a1
bsr EnvOuListe
.Init3 tst.b (a2)+
bne.s .Init3
addq.w #1,d3
cmp.w #14+26,d3
bcs.s .Init2
* Trouve les messages du compilateur
moveq #Mes_Base,d3
.Init4 bsr ListeNom
bne.s .Init5
bsr Copy
addq.w #1,d3
bra.s .Init4
.Init5 move.w d3,d0
rts
** Routine: trouve le nom #D3 dans la liste
ListeNom
move.l d5,a0
bsr.s .Liste
bne.s .ListeE
move.w d3,d0
subq.w #2,d0
bmi.s .List1
.List0 bsr.s .Liste
bne.s .ListeE
dbra d0,.List0
.List1 move.l B_DiskIn(a5),a1
.List2 move.b (a0)+,(a1)
beq.s .ListeE
cmp.b #"}",(a1)+
bne.s .List2
clr.b -1(a1)
move.l B_DiskIn(a5),a0
moveq #0,d0
rts
.Liste tst.b (a0)
beq.s .ListeE
cmp.b #"{",(a0)+
bne.s .Liste
rts
.ListeE moveq #-1,d0
rts
** Routine: adresse string dans les datas
GetA1 sub.w -2(a4),d0
move.l a4,a1
sub.l -4(a4),a1
add.w 0(a4,d0.w),a1
rts
** Routine: copie ou nom dans la liste
EnvOuListe
exg a0,a1
tst.b (a1)
beq.s CopyNom
move.l a1,a0
cmp.w #$2E00,(a0)
bne.s CopyNom
clr.b (a0)
** Routine: copie dans les noms, inclus le NOM_PATH, si defini!
CopyNom tst.b (a0)
beq.s Copy
tst.b Nom_From(a5)
beq.s Copy
move.l a0,a1
.Copy1 tst.b (a1)+
bne.s .Copy1
.Copy2 move.b -(a1),d0
cmp.l a0,a1
bcs.s .Copy3
cmp.b #"/",d0
beq.s .Copy3
cmp.b #":",d0
bne.s .Copy2
.Copy3 lea Nom_From(a5),a0
bsr Copy
subq.l #1,a3
lea 1(a1),a0
* Routine de copie / comptage
Copy tst.l d2
bmi.s List4
; Compte la taille
List3 addq.l #1,d2
tst.b (a0)+
bne.s List3
rts
; Recopie
List4 move.b (a0)+,(a3)+
bne.s List4
rts
******* Trouve le nom #D0 dans la liste-> A0
GetNom tst.l B_Noms(a5)
beq.s .Nom2
move.l d1,-(sp)
move.l B_Pointeurs(a5),a0
moveq #0,d1
subq.w #2,d0
bmi.s .Nom1
.Nom0 add.w (a0)+,d1
dbra d0,.Nom0
.Nom1 moveq #0,d0
move.w (a0),d0
subq.w #1,d0
move.l B_Noms(a5),a0
lea 0(a0,d1.w),a0
move.l (sp)+,d1
tst.b (a0)
rts
* Si noms pas charg<EFBFBD>s: messages d'urgence!
.Nom2 lea Mes_OOfMem(pc),a0
cmp.w #Mes_BaseNoms+6,d0
beq.s .Nom3
lea Mes_DError(pc),a0
.Nom3 move.l a0,d0
.Nom4 tst.b (a0)+
bne.s .Nom4
sub.l d0,a0
exg d0,a0
rts
******* Trouve le chiffre #D dans la liste -> D0
GetChiffre
add.w #Mes_BaseCh,d0
bsr GetNom
moveq #0,d0
moveq #0,d2
ddh1: move.b (a0)+,d2
beq.s ddh2
cmp.b #32,d2
beq.s ddh1
sub.b #48,d2
cmp.b #10,d2
bcc ErrConfig
move d0,d1
mulu #10,d1
swap d0
mulu #10,d0
swap d0
tst d0
bne ErrConfig
add.l d1,d0
bcs ErrConfig
add.l d2,d0
bmi ErrConfig
addq #1,d3
bra.s ddh1
ddh2: rts ;OK: chiffre en d0, et beq
******* Initialisation de toutes les librairies
InitLibs
moveq #21,d0
bsr MesPrint
* Charge AMOS.Lib
moveq #3-1,d0
moveq #0,d1
bsr GetNom
bsr InitLib
* Charge les librairies!
moveq #12-1,d0
moveq #1,d1
Ilib5 movem.l d0/d1,-(sp)
bsr GetNom
movem.l (sp)+,d0/d1
beq.s Ilib6
bsr InitLib
Ilib6 addq.w #1,d0
addq.w #1,d1
cmp.w #27,d1
bcs.s ILib5
rts
******* Initialisation librairie D1, nom A0
InitLib movem.l a0-a6/d0-d7,-(sp)
move.l a0,a1
move.w d1,d0
lsl.w #2,d0
lea BufLibs(a5),a2
lea BufToks(a5),a3
add.w d0,a2 * A2-> Pointeur librairie
add.w d0,a3 * A3-> Pointeurs tokens/erreurs
addq.l #F_Libs,d1
move.l d1,d6
bsr FOpenOld
beq DError
move.l d6,d1
move.l B_DiskIn(a5),d2
moveq #$20+$12,d3
bsr FRead
beq DError
move.l d2,a0
* Charge le catalogue
move.l $20(a0),d3 * Longueur du catalogue
move.l d6,d1
add.l #$32,d2
bsr FRead
beq DError
move.l d2,a1
; Reserve le buffer
lsr.w #1,d3
move.w d3,d0
mulu #10,d0
add.l #16,d0
bsr ResBuffer
move.l a0,(a2)
; Calcule les offsets des routines
move.l B_DiskIn(a5),a2
move.w $20+$10(a2),(a0)+ * Compteur / Signal
move.w d3,(a0)+ * Nombre d'instructions
moveq #$20+$12,d1
add.l $20(a2),d1
add.l $24(a2),d1
subq.w #1,d3
ILib1 clr.l (a0)+
move.l d1,d0
move.l d0,(a0)+
moveq #0,d2
move.w (a1)+,d2
move.w d2,(a0)+
lsl.l #1,d2
add.l d2,d1
dbra d3,ILib1
move.l #-1,(a0)+
* Charge la table des tokens?
move.l B_DiskIn(a5),a2
move.l $20+4(a2),d3
beq.s ILib0
move.l d3,d0
bsr ResBuffer
move.l a0,(a3)
move.l a0,d2
move.l d6,d1
bsr FRead
beq DError
* Ca y est!
ILib0 bsr Actualise
movem.l (sp)+,a0-a6/d0-d7
rts
******* Relocation
;-----> Init relocation
InitRel moveq #4,d0
bsr GetChiffre
bsr ResBuffer
move.l a0,B_Reloc(a5)
move.l a0,a3
rts
;-----> Cree un appel a la routine #D0
CreJmp: mulu #10,d0
move.l d0,a0
move.w #CiJmp,d0
bra.s CreF
;-----> Cree un appel a un sous programme #D0
CreFonc:mulu #10,d0
move.l d0,a0
move.w #CiJsr,d0 ;Dans le source: JSR
CreF: bsr OutWord
bsr RelJsr ;Pointe la table de relocation ici
move.l a0,d0
bset #BitLib,d0
bsr OutLong ;#ROUTINE.L
; Met le flag dans buffer
move.l BufLibs(a5),a0
move.w #1,(a0)
move.l #1,4(a0,d0.w)
rts
;-----> Cree un appel a un sous programme #D0, librairie #D1
; Incrementer flag: D2=0 / D2=1
CreFoncExt
mulu #10,d0
move.l d0,a0
move.w #CiJsr,d0 ;Dans le source: JSR
bsr OutWord
bsr RelJsr ;Pointe la table de relocation ici
lsl.w #2,d1
move.w d1,d0
swap d0
move.w a0,d0
bset #BitLib,d0
bsr OutLong ;#ROUTINE.L
; Met le flag dans buffer
lea BufLibs(a5),a0
move.l 0(a0,d1.w),d1
beq Synt
move.l d1,a0
move.w #1,(a0)
move.l #1,4(a0,d0.w)
rts
;-----> Marque la table de relocation
RelJsr: move.l d0,-(sp)
move.l a4,d0
sub.l OldRel(a5),d0
.ReJ1: cmp.w #510,d0
beq.s .Rej2
cmp.w #508,d0
bls.s .ReJ2
bsr OutRel1
sub.w #508,d0
bra.s .ReJ1
.ReJ2: lsr.w #1,d0
bsr OutRel
move.l a4,OldRel(a5)
move.l (sp)+,d0
rts
; Poke un octet dans la table de relocation
OutRel move.b d0,(a3)+
rts
OutRel1 move.b #1,(a3)+
rts
;---------------------------------------------------------------------
; *** *** ** ** **** **** ** ** ** ** ** *** ***
; ** ** ** *** *** ** ** ** ** ** **** *** *** ** ** **
; ** ** ** ** * ** ** ** ** ** ** ** ** ** * ** ** ** ***
; ** ** ** ** ** **** ** ** ****** ** ** ** ** **
; ** ** ** ** ** ** ** ** ** ** ** ** ** ** * **
; *** *** ** ** ** **** **** ** ** ** ** *** ***
;---------------------------------------------------------------------
; Routines compilateur
;---------------------------------------------------------------------
******* Reservation memoire
ResBuffer
movem.l d0/d1,-(sp)
addq.l #4,d0
move.l d0,d1
bsr RamFast
beq Oofmem
move.l d0,a0
move.l d1,(a0)+
add.l d1,MaxMem(a5)
movem.l (sp)+,d0/d1
rts
******* Effacement memoire
EraBuffer
lea D_Buffers(a5),a2
lea F_Buffers(a5),a0
move.l a0,d2
EBuf1 move.l (a2)+,d0
beq.s EBuf2
move.l d0,a1
move.l -(a1),d0
bsr RamFree
EBuf2 cmp.l d2,a2
bcs.s EBuf1
bsr EraInBuffer
bsr EraObjet
rts
******* Fabrication des hunks
;-----> Debut HUNK D1, type D2
DebHunk
cmp.w #3,Flag_Type(a5)
beq.s PasHunk
movem.l d0-d2/a0-a1,-(sp)
move.l #$3E9,d0
or.l d2,d0
bsr OutLong
moveq #0,d0
bsr OutLong
lsl.w #3,d1
lea T_Hunks(a5),a1
move.l a4,0(a1,d1.w)
move.l d2,4(a1,d1.w)
movem.l (sp)+,d0-d2/a0-a1
rts
;-----> Fin d'un hunk
FinHunk
cmp.w #3,Flag_Type(a5)
bne.s FHu0
; Rend pair...
PasHunk move.w a4,d0
and.w #$0001,d0
add.w d0,a4
rts
; Fait le HUNK
FHu0 movem.l d0-d2/a0-a1,-(sp)
lsl.w #3,d1
lea T_Hunks(a5),a1
move.l a4,d0
sub.l 0(a1,d1.w),d0
and.w #$0003,d0
beq.s FHu1
neg.w d0
addq.w #4,d0
add.w d0,a4
FHu1 move.l a4,d0
sub.l 0(a1,d1.w),d0
lsr.l #2,d0
or.l d0,4(a1,d1.w)
move.l #$3F2,d0
bsr OutLong
movem.l (sp)+,d0-d2/a0-a1
rts
;-----> Marque la longueur d'un hunk
MarkHunk
movem.l d0-d2/a0-a1,-(sp)
lsl.w #3,d1
lea T_Hunks(a5),a1
move.l 0(a1,d1.w),a4
subq.l #4,a4
move.l 4(a1,d1.w),d0
and.l #$00FFFFFF,d0
bsr OutLong
movem.l (sp)+,d0-d2/a0-a1
rts
;-----> Copie D3 octets, fichier D1 en (a4)
OutFRead
movem.l a0-a2/d0-d7,-(sp)
move.l d1,d5
move.l B_DiskIn(a5),d2
move.l d3,d6
Ofr0 move.l #L_DiscIn,d3
cmp.l d6,d3
bcs.s Ofr1
move.l d6,d3
Ofr1 move.l d5,d1
bsr FRead
beq DError
sub.l d3,d6
move.l d2,a2
move.w d3,d4
lsr.l #2,d3
beq.s Ofr3
sub.w #1,d3
Ofr2 move.l (a2)+,d0
bsr OutLong
dbra d3,Ofr2
Ofr3 and.w #$0003,d4
beq.s Ofr5
subq.w #1,d4
Ofr4 move.b (a2)+,d0
bsr OutByte
dbra d4,Ofr4
Ofr5 tst.l d6
bne.s Ofr0
movem.l (sp)+,a0-a2/d0-d7
rts
;-----> Copie D3 octets source->objet
CopySrce
tst.l d3
beq.s CpyS
CpyS1 bsr GetWord
bsr OutWord
subq.l #2,d3
bcs.s CpyS
bne.s CpyS1
CpyS rts
;-----> Copie d'un fichier
; A0= Nom du fichier
; D1/D2= definition hunk
; D3= Nombre d'octets <20> sauter au debut!
; D4= A sauter a la fin
CopyHunk
move.l d1,-(sp) * Cree le hunk
move.l d3,-(sp)
move.l d4,-(sp)
bsr DebHunk
moveq #F_Courant,d1
bsr FOpenOld * Ouvre le fichier
beq DError
moveq #F_Courant,d1
bsr FLof * Taille
sub.l (sp)+,d0
moveq #-1,d3
move.l (sp)+,d2
sub.l d2,d0
move.l d0,-(sp)
moveq #F_Courant,d1
bsr FSeek * Saute le debut
move.l (sp)+,d3 * Charge
moveq #F_Courant,d1
bsr OutFRead
moveq #F_Courant,d1
bsr FClose
move.l (sp)+,d1 * Fin du hunk
bsr FinHunk
rts
******* Initialisation disque
IniDisc movem.l a0-a2/d0-d7,-(sp)
move.l #$1000,L_DiscIn(a5) * Buffer disque
move.l #128,BordBso(a5) * Bordure source
move.l #768,BordBob(a5) * Bordure objet
tst.w Flag_AMOS(a5)
bne.s InidX
* Ouvre le DOS
moveq #0,d0
move.l $4,a6
lea Nom_Dos(pc),a1
jsr OpenLib(a6)
move.l d0,C_DosBase(a5)
beq CFini2
* Ouvre la graphics library
moveq #0,d0
lea Nom_Graphic(pc),a1
jsr OpenLib(a6)
move.l d0,C_GfxBase(a5)
beq DError
* Buffer disque
InidX move.l #L_DiscIn,d0
bsr ResBuffer
move.l a0,B_DiskIn(a5)
movem.l (sp)+,a0-a2/d0-d7
rts
******* FIN DISQUE
FinDisc
* Ferme tous les fichiers
bsr CloseAll
* Ferme les librairies, si pas AMOS
tst.w Flag_AMOS(a5)
bne.s FDi2
tst.l C_DosBase(a5)
beq.s FDi1
move.l C_DosBase(a5),a1
move.l $4.w,a6
jsr CloseLib(a6)
* Ferme la GFX
FDi1 move.l C_GfxBase(a5),d0
beq.s FDi2
move.l d0,a1
move.l $4.w,a6
jsr CloseLib(a6)
FDi2 rts
******* Initialisation des icones
InitIcons
tst.w Flag_Type(a5)
bne.s .Iicx
tst.l C_IconBase(a5)
bne.s .Iic1
moveq #0,d0
lea Nom_IconLib(pc),a1
move.l $4,a6
jsr OpenLib(a6)
move.l d0,C_IconBase(a5)
beq NoIcons
; Charge l'icone par defaut
.Iic1 move.l C_IconBase(a5),a6
moveq #8-1,d0
bsr GetNom
jsr -78(a6)
move.l d0,C_Icon(a5)
beq NoIcons
move.l d0,a0
move.l #$80000000,d0
move.l d0,$3a(a0)
move.l d0,$3e(a0)
; Ok!
.Iicx rts
******* Fin des icones
FinIcons
move.l C_IconBase(a5),d0
beq.s .FicX
move.l d0,a6
move.l C_Icon(a5),d0
beq.s .Fic1
move.l d0,a0
jsr -90(a6)
.Fic1
tst.w IconAMOS(a5)
bne.s .FicX
move.l a6,a1
move.l $4.w,a6
jsr CloseLib(a6)
.FicX rts
******* Sauve l'icone du programme
SIcon tst.w Flag_Type(a5)
bne.s .SicX
move.l a6,-(sp)
lea Nom_Objet(a5),a0
move.l C_Icon(a5),a1
move.l C_IconBase(a5),a6
jsr -84(a6)
move.l (sp)+,a6
tst.l d0
beq DError
.SicX rts
*********************************************************************
* GESTION SOURCE
******* Initilialisation SOURCE
IniSource
moveq #27,d0
bsr MesPrint
lea Nom_Source(a5),a0
bsr StrPrint
bsr Return
tst.w Flag_Source(a5)
bne.s IniS2
* Tout en RAM
lea Nom_Source(a5),a1
moveq #F_Source,d1
bsr FOpenOld
beq DError
moveq #F_Source,d1
bsr FLof
move.l d0,L_Source(a5)
move.l d0,d3
addq.l #8,d0
bsr ResBuffer
move.l a0,B_Source(a5)
move.l a0,d2
moveq #F_Source,d1
bsr FRead
moveq #F_Source,d1
bsr FClose
bra HVerif
******* Petit buffer
IniS2 move.l L_BSo(a5),d0
move.l d0,MaxBso(a5)
bsr ResBuffer
move.l a0,B_Source(a5)
lea Nom_Source(a5),a1
moveq #F_Source,d1
bsr FOpenOld
beq DError
moveq #F_Source,d1
bsr FLof
move.l d0,L_Source(a5)
; Charge le debut
clr.l DebBso(a5)
move.l d0,TopSou(a5)
move.l MaxBso(a5),FinBso(a5)
bsr LoadBso
* Verifie le HEADER
HVerif: move.l B_Source(a5),a0
lea HeadAMOS(pc),a1
moveq #10-1,d0
OpSo cmpm.b (a0)+,(a1)+
bne ErrNoAMOS
dbra d0,OpSo
* Si V>1.3, est-ce teste???
move.b 1(a0),d0
cmp.b #"v",d0
beq ErrNoTest
* Adresse des banques
move.l B_Source(a5),a0
move.l 16(a0),d0
lea 20(a0,d0.l),a0
sub.l B_Source(a5),a0
move.l a0,A_Banks(a5)
lea 4(a0),a6
bsr GetWord
move.w d0,N_Banks(a5)
* Estime le nombre de lignes
move.l L_Source(a5),d0
lsr.l #4,d0
mulu #584,d0
divu #19000,d0
lsl.w #4,d0
move.w d0,NL_Source(a5)
rts
;-----> Prend un MOT du programme (A6)
GetWord:tst.w Flag_Source(a5)
bne.s Gsw
add.l B_Source(a5),a6
move.w (a6)+,d0
sub.l B_Source(a5),a6
rts
Gsw move.l a0,-(sp)
bsr SoDisk
move.w (a0),d0
addq.l #2,a6
move.l (sp)+,a0
rts
;-----> Prend un MOTLONG du programme (A6)
GetLong:tst.w Flag_Source(a5)
bne.s Gsl
add.l B_Source(a5),a6
move.l (a6)+,d0
sub.l B_Source(a5),a6
rts
Gsl move.l a0,-(sp)
bsr SoDisk
move.l (a0),d0
addq.l #4,a6
move.l (sp)+,a0
rts
;-----> Gestion du buffer entree SOURCE
SoDisk: cmp.l DebBso(a5),a6
bcs.s SoDi1
lea 4(a6),a0
cmp.l FinBso(a5),a0
bcc.s SoDi1
; Adresse RELATIVE dans le buffer
move.l a6,a0
sub.l DebBso(a5),a0
add.l B_Source(a5),a0
rts
; Change la position du buffer
SoDi1: movem.l d0-d7/a1,-(sp)
; Bouge le bout
move.l DebBso(a5),d0
move.l FinBso(a5),d1
move.l MaxBso(a5),d2
sub.l BordBso(a5),d2
lea 4(a6),a0
SoDi3: cmp.l d0,a6
bcs.s SoDi4
cmp.l d1,a0
bcs.s SoDi5
; Monte le buffer
add.l d2,d0
add.l d2,d1
bra.s SoDi3
; Descend le buffer
SoDi4: sub.l d2,d0
sub.l d2,d1
bra.s SoDi3
SoDi5: move.l d0,DebBso(a5)
move.l d1,FinBso(a5)
bsr LoadBso
; Trouve l'adresse relative
movem.l (sp)+,d0-d7/a1
move.l a6,a0
sub.l DebBso(a5),a0
add.l B_Source(a5),a0
rts
;-----> Charge le buffer SOURCE
LoadBso:moveq #F_Source,d1
move.l DebBso(a5),d2
moveq #-1,d3
bsr FSeek
; Sauve l'ancien
moveq #F_Source,d1
move.l B_Source(a5),d2
move.l TopSou(a5),d3
sub.l DebBso(a5),d3
cmp.l MaxBso(a5),d3
bcs.s SoDi2
move.l FinBso(a5),d3
sub.l DebBso(a5),d3
SoDi2: bra FRead
*********************************************************************
* GESTION OBJET
******* Initialisation OBJET
IniObjet
tst.w Flag_Objet(a5)
bne.s IObdisc
* En m<EFBFBD>moire, reserve le 1er buffer
moveq #3,d0
bsr GetChiffre
move.l d0,L_Bob(a5)
add.l #16,d0
bsr ResBuffer
move.l a0,Bb_Objet_Base(a5)
move.l a0,Bb_OBjet(a5)
move.l #L_Bob,4(a0)
rts
* Sur disque
IObDisc move.l #L_Bob,d0
move.l d0,L_Bob(a5)
bsr ResBuffer
move.l a0,B_Objet(a5)
clr.l DebBob(a5)
move.l #L_Bob,FinBob(a5)
clr.l TopOb(a5)
lea Nom_Objet(a5),a1
moveq #F_Objet,d1
bsr FOpenNew
beq DError
rts
******* Efface tous les buffers objets
EraObjet
move.l Bb_Objet_Base(a5),d3
beq.s .skip
.loop move.l d3,a1
move.l 8(a1),d3
move.l -(a1),d0
bsr RamFree
tst.l d3
bne.s .loop
.skip rts
******* Sauve/Ferme le programme objet
SObject
moveq #28,d0
bsr MesPrint
lea Nom_Objet(a5),a0
bsr StrPrint
bsr Return
tst.w Flag_Objet(a5)
bne.s SObj1
lea Nom_Objet(a5),a1
moveq #F_Objet,d1
bsr FOpenNew
beq DError
move.l BB_Objet_Base(a5),d4
.loop move.l d4,a0
move.l (a0)+,d0
move.l (a0)+,d3
move.l (a0)+,d4
move.l a0,d2
add.l d3,d0
cmp.l L_Objet(a5),d0
bls.s .loop1
sub.l L_Objet(a5),d0
sub.l d0,d3
beq.s SObj2
.loop1 moveq #F_Objet,d1
bsr FWrite
beq DError
.loop2 tst.l d4
bne.s .loop
bra.s SObj2
* Sur disque: sauve le dernier buffer!
SObj1 bsr SaveBob
SObj2 moveq #F_Objet,d1
bsr FClose
rts
;-----> En cas d'erreur, KILL OBJECT!
KObject moveq #F_Objet,d1
bsr FHandle
beq.s KObx
; Ferme le fichier
clr.l (a0)
move.w #DosClose,d7
bsr DosCall
; Efface le fichier
lea Nom_Objet(a5),a0
move.l a0,d1
move.w #DosDel,d7
bsr DosCall
; Fini
KObX rts
;-----> Trouve le buffer objet contenant A4
GetBob movem.l a1/d0/d1,-(sp)
move.l Bb_Objet_Base(a5),a0
.loop move.l a0,a1
move.l (a0),d1
add.l 4(a0),d1
cmp.l d1,a4
bcs.s .loop2
move.l 8(a0),d0
move.l d0,a0
bne.s .loop
; Il faut en reserver un autre...
.loop1 move.l #L_Bob,d0
add.l #16,d0
bsr ResBuffer
move.l a0,8(a1)
; En reserver ENCORE un autre?
move.l d1,(a0)
move.l #L_Bob,4(a0)
move.l a0,a1
add.l #L_Bob,d1
cmp.l d1,a4
bcc.s .loop1
* Ok!
.loop2 move.l a1,Bb_Objet(a5)
movem.l (sp)+,a1/d0/d1
rts
;-----> Poke un BYTE dans l'objet
OutByte:tst.w Flag_Objet(a5)
bne.s OutbD
* En m<EFBFBD>moire
movem.l a0/a4,-(sp)
.Reskip move.l Bb_Objet(a5),a0
sub.l (a0),a4
cmp.l 4(a0),a4
bcc.s .skip
add.l a0,a4
move.b d0,12(a4)
movem.l (sp)+,a0/a4
addq.l #1,a4
rts
.skip movem.l (sp),a0/a4
bsr GetBob
bra.s .ReSkip
* Sur disque
OutbD move.l a0,-(sp)
bsr ObDisk
move.b d0,(a0)+
addq.l #1,a4
move.l (sp)+,a0
cmp.l TopOb(a5),a4
bcs.s PamB
move.l a4,TopOb(a5)
PamB: rts
;-----> Poke un MOT dans l'objet
OutWord:tst.w Flag_Objet(a5)
bne.s OutwD
* En m<EFBFBD>moire
OutW movem.l a0/a4,-(sp)
.Reskip move.l Bb_Objet(a5),a0
sub.l (a0),a4
cmp.l 4(a0),a4
bcc.s .skip
add.l a0,a4
move.w d0,12(a4)
movem.l (sp)+,a0/a4
addq.l #2,a4
rts
.skip movem.l (sp),a0/a4
bsr GetBob
bra.s .ReSkip
* Sur disque
OutwD move.l a0,-(sp)
bsr ObDisk
move.w d0,(a0)+
addq.l #2,a4
move.l (sp)+,a0
cmp.l TopOb(a5),a4
bcs.s PamW
move.l a4,TopOb(a5)
PamW: rts
;-----> Poke un MOT LONG dans l'objet
OutLong:tst.w Flag_Objet(a5)
bne.s OutlD
* En m<EFBFBD>moire
movem.l a0/a4,-(sp)
.Reskip move.l Bb_Objet(a5),a0
sub.l (a0),a4
cmp.l 4(a0),a4
bcc.s .skip
addq.l #4,a4
cmp.l 4(a0),a4
bhi.s .probleme
add.l a0,a4
move.l d0,12-4(a4)
movem.l (sp)+,a0/a4
addq.l #4,a4
rts
.skip movem.l (sp),a0/a4
bsr GetBob
bra.s .ReSkip
.probleme
movem.l (sp)+,a0/a4
swap d0
bsr OutW
swap d0
bra OutW
* Sur disque
OutlD move.l a0,-(sp)
bsr ObDisk
move.l d0,(a0)+
addq.l #4,a4
move.l (sp)+,a0
cmp.l TopOb(a5),a4
bcs.s PamL
move.l a4,TopOb(a5)
PamL: rts
;-----> Debuggage
;Protect
; move.l #0,-(sp)
; move.l #0,-(sp)
; move.l #0,-(sp)
; move.l #0,-(sp)
; bsr *+$212
; lea $10(sp),sp
; rts
; dc.w $4321
;-----> Prend un mot long dans l'objet
GtoLong:tst.w Flag_Objet(a5)
bne.s PaGL
* En memoire
bsr GtoW
swap d0
bsr GtoW
tst.l d0
rts
GtoW movem.l a0/a4,-(sp)
.Reskip move.l Bb_Objet(a5),a0
sub.l (a0),a4
cmp.l 4(a0),a4
bcc.s .skip
add.l a0,a4
move.w 12(a4),d0
movem.l (sp)+,a0/a4
addq.l #2,a4
rts
.skip movem.l (sp),a0/a4
bsr GetBob
bra.s .ReSkip
* Sur disque
PaGL move.l a0,-(sp)
bsr ObDisk
move.l (a0)+,d0
addq.l #4,a4
move.l (sp)+,a0
rts
;-----> Sortie de code
OutCode move.l d0,-(sp)
move.w (a0)+,d0
OutC1 bsr OutWord
move.w (a0)+,d0
cmp.w #$4321,d0
bne.s OutC1
move.l (sp)+,d0
rts
;-----> GESTION DU BUFFER OBJET DISQUE
ObDisk: cmp.l DebBob(a5),a4
bcs.s ObDi1
lea 4(a4),a0
cmp.l FinBob(a5),a0
bcc.s ObDi1
; Adresse RELATIVE dans le buffer
move.l a4,a0
sub.l DebBob(a5),a0
add.l B_Objet(a5),a0
rts
; Change la position du buffer
ObDi1: movem.l d0-d7/a0-a2,-(sp)
; Sauve le buffer
bsr SaveBob
; Bouge le bout
move.l DebBob(a5),d0
move.l FinBob(a5),d1
move.l #L_Bob,d2
sub.l BordBob(a5),d2
lea 4(a4),a0
ObDi3: cmp.l d0,a4
bcs.s ObDi4
cmp.l d1,a0
bcs.s ObDi5
; Monte le buffer
add.l d2,d0
add.l d2,d1
bra.s ObDi3
; Descend le buffer
ObDi4: sub.l d2,d0
sub.l d2,d1
bra.s ObDi3
ObDi5: move.l d0,DebBob(a5)
move.l d1,FinBob(a5)
; Charge le nouveau bout
moveq #F_Objet,d1
move.l DebBob(a5),d2
moveq #-1,d3
bsr FSeek
move.l FinBob(a5),d3
cmp.l TopOb(a5),d3
bcs.s ObDi6
move.l TopOb(a5),d3
ObDi6: sub.l DebBob(a5),d3
beq.s ObDi7
moveq #F_Objet,d1
move.l B_Objet(a5),d2
bsr FRead
; Trouve l'adresse relative
ObDi7: movem.l (sp)+,d0-d7/a0-a2
move.l a4,a0
sub.l DebBob(a5),a0
add.l B_Objet(a5),a0
rts
;-----> Sauve le buffer OBJET
SaveBob:moveq #F_Objet,d1
move.l DebBob(a5),d2
moveq #-1,d3
bsr FSeek
; Sauve l'ancien
moveq #F_Objet,d1
move.l B_Objet(a5),d2
move.l TopOb(a5),d3
sub.l DebBob(a5),d3
cmp.l #L_Bob,d3
bcs.s ObDi2
move.l FinBob(a5),d3
sub.l DebBob(a5),d3
ObDi2: bsr FWrite
rts
******* DOS CALL: appelle une routine DOS D7
DosCall
movem.l a5/a6,-(sp)
move.l C_DosBase(a5),a6
move.l a6,a5
add.w d7,a5
jsr (a5)
movem.l (sp)+,a5/a6
tst.l d0
rts
******* Trouve le handle #D1
FHandle move.w d1,d0
lsl.w #2,d0
lea T_Handles(a5),a0
add.w d0,a0
move.l (a0),d1
rts
******* OPEN: ouvre le fichier A0, # Handle D1, acces D2
FOpenOld
move.l #1005,d2
bra.s FOpen
FOpenNew
move.l #1006,d2
FOpen
bsr FHandle
bne DError
move.l a0,-(sp)
move.l a1,d1
move.w #DosOpen,d7
bsr DosCall
move.l (sp)+,a0
move.l d0,(a0)
rts
******* CLOSE fichier D1
FClose
bsr FHandle
beq PaFCl
clr.l (a0)
move.w #DosClose,d7
bsr DosCall
PaFCl: rts
******* CLOSE TOUS les fichiers
CloseAll
moveq #M_Fichiers-1,d6
ClAl move.l d6,d1
bsr FClose
dbra d6,ClAl
rts
******* READ fichier D1, D3 octets dans D2
FRead:
movem.l d1/a6,-(sp)
bsr FHandle
move.l C_DosBase(a5),a6
jsr DosRead(a6)
movem.l (sp)+,d1/a6
tst.l d0
beq.s ErdE
bmi.s ErdE
cmp.l d0,d3
bne.s ErdE
ErdB moveq #-1,d7
rts
ErdE moveq #0,d7
rts
******* WRITE fichier D1, D3 octets de D2
FWrite: movem.l d1/a6,-(sp)
bsr FHandle
move.l C_DosBase(a5),a6
jsr DosWrite(a6)
movem.l (sp)+,d1/a6
tst.l d0
beq.s ErdE
bmi.s ErdE
cmp.l d0,d3
bne.s ErdE
bra.s ErdB
******* SEEK fichier D1, D3 mode D2 deplacement
FSeek:
movem.l d1/a6,-(sp)
bsr FHandle
move.l C_DosBase(a5),a6
jsr DosSeek(a6)
movem.l (sp)+,d1/a6
tst.l d0
bmi.s ErdE
bra.s ErdB
******* LOF fichier D1
FLof
bsr FHandle
FLof2 move.l d1,-(sp)
moveq #0,d2 * Seek --> fin
moveq #1,d3
move.w #DosSeek,d7
bsr DosCall
move.l (sp)+,d1
move.l d0,d2 * Seek --> debut!
moveq #-1,d3
bra DosCall
*
A4Pair move.w a4,d0
btst #0,d0
beq.s A4p
addq.l #1,a4
A4p rts
******* Mise a zero!
RamFast movem.l d1-d2/a0-a2/a6,-(sp)
move.l #Public|Clear,d1
ExeCall AllocMem
movem.l (sp)+,d1-d2/a0-a2/a6
tst.l d0
rts
RamChip movem.l d1-d2/a0-a2/a6,-(sp)
move.l #Public|Chip|Clear,d1
ExeCall AllocMem
movem.l (sp)+,d1-d2/a0-a2/a6
tst.l d0
rts
******* Liberation
RamFree movem.l d0-d2/a0-a2/a6,-(sp)
ExeCall FreeMem
movem.l (sp)+,d0-d2/a0-a2/a6
rts
******* stocke la position dans l'objet
StockOut
move.l a0,-(sp)
move.l A_Stock(a5),a0
move.l a3,(a0)+
move.l a4,(a0)+
move.l OldRel(a5),(a0)+
move.l a0,A_Stock(a5)
move.l (sp)+,a0
rts
RestOut
move.l a0,-(sp)
move.l A_Stock(a5),a0
move.l -(a0),OldRel(a5)
move.l -(a0),a4
move.l -(a0),a3
move.l a0,A_Stock(a5)
move.l (sp)+,a0
rts
SautOut
sub.l #12,A_Stock(a5)
rts
;---------------------------------------------------------------------
; *** *** ** ** **** **** ** ** ** ** ** *** ***
; ** ** ** *** *** ** ** ** ** ** **** *** *** ** ** **
; ** ** ** ** * ** ** ** ** ** ** ** ** ** * ** ** ** ***
; ** ** ** ** ** **** ** ** ****** ** ** ** ** **
; ** ** ** ** ** ** ** ** ** ** ** ** ** ** * **
; *** *** ** ** ** **** **** ** ** ** ** *** ***
;---------------------------------------------------------------------
; Instructions / Fonctions standart
;---------------------------------------------------------------------
;-----> CONTROLE COMPILATEUR
CTstOn clr.w Flag_NoTests(a5)
rts
CTstOf move.w #-1,Flag_NoTests(a5)
rts
CTst move.w #L_Tests,d0
bra CreFonc
COpt bsr StockOut
bsr Evalue
bra RestOut
;-----> Instruction etendue...
IExtension
bsr GetWord
lsr.w #8,d0
move.w d0,d2
lsl.w #2,d0
lea BufToks(a5),a2
move.l 0(a2,d0.w),d0
beq ErrExt
move.l d0,a2
bsr GetWord
move.w d0,d4
move.w 0(a2,d0.w),d1
lea 4(a2,d0.w),a2
* Est-ce un instruction de controle COMPILER?
cmp.w #Ext_Nb,d2
bne.s .PaCont
cmp.w #Ext_TkCmp,d0
beq ErrAlready
cmp.w #Ext_TkCOp,d0
beq COpt
cmp.w #Ext_TkTstOn,d0
beq CTstOn
cmp.w #Ext_TkTstOf,d0
beq CTstOf
cmp.w #Ext_TkTst,d0
beq CTst
.PaCont
* Est-ce un .AMOS?
moveq #-1,d3
cmp.w #3,Flag_Type(a5)
bne IStan
moveq #0,d3
bsr IStan
bra ExtCall
;-----> Fonction etendue
FExtension
bsr GetWord
lsr.w #8,d0
move.w d0,d2
lsl.w #2,d0
lea BufToks(a5),a2
move.l 0(a2,d0.w),d0
beq ErrExt
move.l d0,a2
bsr GetWord
move.w d0,d4
addq.w #2,d4
move.w 2(a2,d0.w),d1
lea 4(a2,d0.w),a2
; Est-ce un .AMOS?
cmp.w #3,Flag_Type(a5)
beq.s .Skip1
moveq #-1,d3
bsr FStan
bra.s .Skip2
.Skip1 moveq #0,d3
bsr FStan
bsr ExtCall
.Skip2
; Pousse le parametre dans la pile et revient...
move.w CMvd3ma3(pc),d0
bra OutWord
* Routine: appelle l'extension en .AMOS
ExtCall move.w Cmviwd0(pc),d0
bsr OutWord
move.w d1,d0
lsl.w #2,d0
bsr OutWord
move.w Cmviwd1(pc),d0
bsr OutWord
move.w d3,d0
bsr OutWord
move.w #L_ExtCall,d0
bra CreFonc
;-----> Instruction standard
IStandard
move.w 2(a0,d0.w),d1
moveq #0,d2
moveq #-1,d3
lea 4(a0,d0.w),a2
bra IStan
;-----> Fonction standard
FStandard
move.w 2(a0,d0.w),d1
FStand
moveq #0,d2
moveq #-1,d3
lea 4(a0,d0.w),a2
bra FStan
* Routine instruction
IStan movem.w d1/d2/d3/d4,-(sp)
IStan0 tst.b (a2)+
bpl.s IStan0
move.b (a2)+,d0
; Instruction
cmp.b #"I",d0
bne.s IStan1
bsr OutLea
bsr CParams
movem.w (sp)+,d0/d1/d2/d3
tst.w d2
bne CreFoncExt
rts
; Variable reservee en instruction
IStan1 cmp.b #"V",d0
bne Synt
move.b (a2)+,d0
sub.b #"0",d0
move.w d0,-(sp)
tst.b (a2) * Saute la parenthese!
bmi.s IStan1a
addq.l #2,a6
bsr CParams
IStan1a bsr GetWord
cmp.w #TkEg-Tk,d0
bne Synt
bsr Evalue
move.w (sp)+,d1
cmp.b d1,d2
beq.s IStan3
subq.b #1,d1
bmi.s IStan2
bne Synt
bsr IntToFl
bra.s IStan3
IStan2 bsr FlToInt
IStan3 movem.w (sp)+,d0/d1/d2/d3
tst.w d2
bne CreFoncExt
rts
* Routine fonction
FStan movem.w d1/d2/d3/d4,-(sp)
FStan0 tst.b (a2)+
bpl.s FStan0
move.b (a2)+,d0
; Fonction
cmp.b #"2",d0
bhi.s FStan2
FStand1 and.w #$00FF,d0
sub.b #"0",d0
move.w d0,-(sp)
tst.b (a2)
bmi.s FStan1a
addq.l #2,a6
bsr CParams
FStan1a move.w (sp)+,d4
cmp.b #1,d4
bne.s FStan1b
bset #0,Flag_Math(a5)
FStan1b movem.w (sp)+,d0/d1/d2/d3
exg d2,d4
tst.w d4
bne CreFoncExt
rts
; Variable reservee en fonction
FStan2 cmp.b #"V",d0
bne Synt
addq.w #1,(sp)
move.b (a2)+,d0
bra.s FStand1
* ROUTINE > recupere les parametres standards
CParams move.b (a2)+,d0
bmi.s CParX
CPar1 move.l a2,-(sp)
cmp.b #"3",d0
beq.s .Con
sub.b #48+1,d0
bmi.s CPar3
beq.s CPar2
; Une chaine
bsr Evalue
cmp.b #2,d2
beq.s CParL
bra Synt
; N'importe quoi (entier/float)
.Con bsr Evalue
cmp.b #1,d0
bne.s CParL
bsr FlToInt
bra.s CParL
; Un float
CPar2 bset #0,Flag_Math(a5)
bsr Evalue
subq.b #1,d2
beq.s CParL
bpl Synt
bsr IntToFl
bra.s CParL
; Entier
CPar3 bsr Evalue
subq.b #1,d2
bmi.s CParL
bne Synt
bsr FlToInt
; Encore un param?
CParL move.l (sp)+,a2
tst.b (a2)+
bmi.s CParX
addq.l #2,a6
move.b (a2)+,d0
bra.s CPar1
CParX rts
;---------------------------------------------------------------------
; *** *** ** ** **** **** ** ** ** ** ** *** ***
; ** ** ** *** *** ** ** ** ** ** **** *** *** ** ** **
; ** ** ** ** * ** ** ** ** ** ** ** ** ** * ** ** ** ***
; ** ** ** ** ** **** ** ** ****** ** ** ** ** **
; ** ** ** ** ** ** ** ** ** ** ** ** ** ** * **
; *** *** ** ** ** **** **** ** ** ** ** *** ***
;---------------------------------------------------------------------
; Evaluations / Calculs
;---------------------------------------------------------------------
******* SET BUFFER
CSBuf addq.l #2,a6
bsr GetLong
move.l d0,L_Buf(a5)
rts
******* GLOBAL / SHARED -> saute les variables
CGlob
CShar addq.l #2,a6
bsr GetWord
move.w d0,d3
bsr GetWord
moveq #0,d2
move.b d0,d2
lsr.w #8,d0
add.w d0,a6
bsr VAdr0
CSh1 bsr GetWord
cmp.w #TkVir-Tk,d0
beq.s CShar
cmp.w #TkPar1-Tk,d0
bne.s CSh2
addq.l #2,a6
bra.s CSh1
CSh2 subq.l #2,a6
rts
******* Prise d'une variable
IVar bsr OutLea
IVarBis move.l a6,-(sp)
bsr SoVar
move.w d2,-(sp)
bsr FnEval
move.b d2,d5
move.w (sp),d2
and.w #$07,d2
cmp.b #1,d2
bne.s .skip
bset #0,Flag_Math(a5)
.skip cmp.b d2,d5
beq.s IVr1
tst.b d2
bne.s IVr0
bsr FlToInt
bra.s IVr1
IVr0 bsr IntToFl
IVr1 addq.l #2,sp
move.l (sp),d0
move.l a6,(sp)
move.l d0,a6
bsr VarAdr
move.l (sp)+,a6
bmi.s IVrT
beq.s IVrL
* Variable GLOBALE
move.w CVrG(pc),d0
bra.s IVr2
CVrG move.l (a3)+,2(a0)
* Variable LOCALE
IVrL move.w CVrL(pc),d0
IVr2 bsr OutWord
move.w d3,d0
bra OutWord
CVrL move.l (a3)+,2(a6)
* Variable TABLEAU
IVrT moveq #L_GetTablo,d0
bsr CreFonc
move.w CVrT(pc),d0
bra OutWord
CVrT move.l (a3)+,(a0)
******* Met l'adresse de base d'une variable en A0
AdBase tst.w d1
beq.s AdA0L
bpl.s AdA0G
rts
* Variable GLOBALE
AdA0G move.w CLea2a0a0(pc),d0
bra.s IVr2
* Variable LOCALE
Ada0L move.w CLea2a6a0(pc),d0
bra.s IVr2
******* Met l'adresse d'une variable en A0
AdToA0 tst.w d1
beq.s AdA0L
bpl.s AdA0G
moveq #L_GetTablo,d0
bra CreFonc
******* Variable en fonction
FVar bsr VarAdr
and.w #$000F,d2
cmp.b #1,d2
bne.s .skip
bset #0,Flag_Math(a5)
.skip tst.w d1
bmi.s FVrT
beq.s FVrL
; Variable globale
move.w Cmv2a0Ma3(pc),d0 Globale
bra.s FVr
; Variable locale
FVrL move.w Cmv2a6Ma3(pc),d0 Locale
FVr bsr OutWord
move.w d3,d0
bra OutWord
; Variable tableau
FVrT moveq #L_GetTablo,d0
bsr CreFonc
move.w Cmvpa0Ma3(pc),d0
bra OutWord
** Saute une variable
SoVar bsr GetWord
bsr GetWord
move.b d0,d2
lsr.w #8,d0
add.w d0,a6
btst #6,d2
beq.s SoV3
; Saute les params du tableau
clr.w d1
SoV1 bsr GetWord
cmp.w #TkPar1-Tk,d0
bne.s SoV2
addq.w #1,d1
SoV2 cmp.w #TkPar2-Tk,d0
bne.s SoV1
subq.w #1,d1
bne.s SoV1
; Met le flag float!
SoV3 rts
** Trouve l'adresse d'une variable D2-D3
VarAdr bsr GetWord
move.w d0,d3
bsr GetWord
move.b d0,d2
lsr.w #8,d0
add.w d0,a6
btst #6,d2
bne VAdrT
VAdr0 moveq #0,d0
tst.w d3
bmi.s VAdrL
* >0: Variable LOCALE
move.w d3,d0
move.l A_FlagVarL(a5),a0
bsr VMark
addq.w #6,d3
neg.w d3
moveq #0,d1
rts
* <0: Variable GLOBALE
VAdrL addq.w #1,d3
move.w d3,d0
neg.w d0
move.l B_FlagVarG(a5),a0
bsr VMark
sub.w #12,d3
move.l CVarGlo(pc),d0
bsr OutLong
moveq #1,d1
rts
CVarGlo move.l VarGlo(a5),a0
* Variable tableau
VAdrT movem.w d2/d3,-(sp)
addq.l #2,a6
clr.w -(sp)
VAdrt1 addq.w #1,(sp)
bsr Expentier
cmp.w #TkPar2-Tk,d0
beq.s VAdrt2
bsr GetWord
cmp.w #TkVir-Tk,d0
beq.s VAdrt1
bra Synt
VAdrt2 move.w (sp)+,d7
movem.w (sp)+,d2/d3
bsr VAdr0
tst.w d1
beq.s VAtl
move.w Clea2a0a0(pc),d0
bra.s VAtt
VAtl move.w Clea2a6a0(pc),d0
VAtt bsr OutWord
move.w d3,d0
bsr OutWord
moveq #-1,d1
rts
* Marque le flag de la variable
VMark addq.w #6,d0
cmp.w (a0),d0
bcs.s Vml1
move.w d0,(a0)
Vml1 divu #6,d0
and.b #%01001111,d2
lea 2-1(a0,d0.w),a0
move.b d2,(a0)
rts
** Trouve l'adresse d'une variable D2-D3, SPECIAL FN
VarAdrFn
bsr GetWord
move.w d0,d3
bsr GetWord
move.b d0,d2
lsr.w #8,d0
add.w d0,a6
moveq #0,d0
tst.w d3
bmi.s .VAdrL
* >0: Variable LOCALE
move.w d3,d0
move.l A_FlagVarL(a5),a0
bsr .VMark
addq.w #6,d3
neg.w d3
moveq #0,d1
rts
* <0: Variable GLOBALE
.VAdrL addq.w #1,d3
move.w d3,d0
neg.w d0
move.l B_FlagVarG(a5),a0
bsr.s .VMark
sub.w #12,d3
move.l CVarGlo(pc),d0
bsr OutLong
moveq #1,d1
rts
* PREND le flag de la variable SPECIAL Def Fn
.VMark addq.w #6,d0
divu #6,d0
lea 2-1(a0,d0.w),a0
move.b (a0),d2
rts
******* DIM
CDim bsr OutLea
addq.l #2,a6
bsr VarAdr
move.w Cmvqd0(pc),d0
move.b d7,d0
bsr OutWord
moveq #L_Dim,d0
bsr CreFonc
bsr GetWord
cmp.w #TkVir-Tk,d0
beq.s CDim
subq.l #2,a6
rts
******* DEF FN
CDefFn bsr OutLea
addq.l #2,a6
bsr VarAdr
move.l a0,-(sp) Adresse du flag!
bsr AdBase
lea CdDfn1(pc),a0
bsr OutCode
move.l a4,-(sp)
bsr GetWord
cmp.w #TkPar1-Tk,d0
bne.s Cdfn2
* Prend les variables (<EFBFBD> l'envers)
clr.w N_Dfn(a5)
Cdfn0 addq.l #2,a6
move.l a6,-(sp)
addq.w #1,N_Dfn(a5)
bsr SoVar
bsr GetWord
cmp.w #TkVir-Tk,d0
beq.s Cdfn0
addq.l #2,a6
move.l a6,A_Dfn(a5)
Cdfn1 move.l (sp)+,a6
bsr VarAdr
bsr AdBase
move.w Cmvqd2(pc),d0
and.b #$03,d2
move.b d2,d0
bsr OutWord
lea CdDfn2(pc),a0
bsr OutCode
subq.w #1,N_Dfn(a5)
bne.s Cdfn1
move.l A_Dfn(a5),a6
* Fonction!
Cdfn2 bsr Evalue
move.l 4(sp),a0
and.b #%00000011,d2
bset #3,d2
move.b d2,(a0)
move.w CRts(pc),d0
bsr OutWord
* Saute le tout!
move.l a4,d0
move.l (sp),a4
move.l d0,(sp)
subq.l #2,a4
sub.l a4,d0
bsr OutWord
move.l (sp)+,a4
addq.l #4,sp
rts
CdDfn1 lea *+10(pc),a1
move.l a1,(a0)
bra CdDfn2
dc.w $4321
CdDfn2 lea *+6(pc),a2
rts
dc.w $4321
******* =FN
CFn addq.l #2,a6
move.l a6,-(sp)
bsr SoVar
clr.w -(sp)
bsr GetWord
cmp.w #TkPar1-Tk,d0
bne.s CFn2
* Prend les parametres
CFn1 addq.w #1,(sp)
bsr Evalue
move.w Cmvima3(pc),d0
bsr OutWord
and.w #$0F,d2
move.w d2,d0
bsr OutWord
bsr GetWord
cmp.w #TkVir-Tk,d0
beq.s CFn1
* Appelle la fonction
CFn2 subq.l #2,a6
move.l 2(sp),d0
move.l a6,2(sp)
move.l d0,a6
bsr VarAdrFn
bsr AdBase
move.w (sp)+,d1
move.w Cmvqd0(pc),d0
move.b d1,d0
bsr OutWord
move.l (sp)+,a6
move.w #L_FN,d0
bsr CreFonc
and.w #$03,d2
rts
******* SORT a()
CSort bsr OutLea
addq.l #2,a6
bsr VarAdr
bsr AdBase
move.w Cmvqd2(pc),d0
and.w #$03,d2
move.b d2,d0
bsr OutWord
move.w #L_Sort,d0
bra CreFonc
******* =MATCH(a(),b)
CMatch bsr OutLea
addq.l #4,a6
move.l a6,-(sp)
bsr SoVar
and.w #$0f,d2
move.w d2,-(sp)
addq.l #2,a6
bsr Evalue
move.w (sp)+,d1
bsr EqType
move.l (sp),d0
move.l a6,(sp)
move.l d0,a6
bsr VarAdr
bsr AdBase
move.w Cmvqd2(pc),d0
and.w #$0f,d2
move.b d2,d0
bsr OutWord
move.w #L_FFind,d0
bsr CreFonc
move.l (sp)+,a6
moveq #0,d2
rts
******* Evaluation d'expression
FnEval: addq.l #2,a6
Evalue: move.w #$7FFF,d0
bra.s Eva1
Eva0: move.w d2,-(sp)
Eva1: move.w d0,-(sp)
bsr Operande
Eva2: bsr GetWord
cmp.w (sp),d0
bhi.s Eva0
subq.l #2,a6
move.w (sp)+,d1
bpl.s Eva3
move.w (sp)+,d5
lea Tk(pc),a0
move.w 0(a0,d1.w),d1
beq Synt
addq.w #1,NbInstr(a5)
jsr 0(a0,d1.w)
clr.w Flag_Const(a5)
bra.s Eva2
Eva3: cmp.w #TkPar2-Tk,d0
bne.s Eva4
addq.l #2,a6
Eva4: rts
** Recupere un operande
Operande:
clr.w -(sp)
Ope0: addq.w #1,NbInstr(a5)
bsr GetWord
lea Tk(pc),a0
tst.w 0(a0,d0.w)
bne.s Ope0a
bsr FStandard
bra.s Ope0b
Ope0a move.w 2(a0,d0.w),d1
beq Synt
jsr 0(a0,d1.w)
Ope0b clr.w Flag_Const(a5)
* Changement de signe non effectue?
Const tst.w (sp)+
bne.s Chs0
rts
Chs0: tst.b d2
bne.s Chs1
move.w CChsI(pc),d0
bra OutWord
Chs1: moveq #L_NegFl,d0
bra CreFonc
CChsI neg.l (a3)
dc.w $4321
* Signe moins devant
OpeM: addq.l #4,sp
addq.w #1,(sp)
bra.s Ope0
;-----> VIRGULE / : / TO / THEN / ELSE ---> pas de parametre, entier
FNull lea CNull(pc),a0
bsr OutCode
moveq #0,d2
subq.l #2,a6
rts
CNull move.l #EntNul,-(a3)
dc.w $4321
;-----> CONSTANTE Entiere/Hex/Bin
FEnt move.w CCst(pc),d0
bsr OutWord
bsr GetLong
tst.w 4(sp)
beq FEnt1
clr.w 4(sp)
neg.l d0
FEnt1 move.l d0,d3
bsr OutLong
moveq #0,d2
bra.s DoConst
;-----> CONSTANTE Float
FFloat bset #0,Flag_Math(a5)
move.w CCst(pc),d0
bsr OutWord
bsr GetLong
tst.w 4(a7)
beq FFlo1
clr.w 4(a7)
; Change le signe!
tst.b d0
beq.s FFlo1
bchg #7,d0
FFlo1 bsr OutLong
moveq #1,d2
bra.s DoConst
CCst move.l #$55555555,-(a3)
;-----> CONSTANTE Chaine
FChaine move.w CCst(pc),d0
bsr OutWord
bsr RelJsr
move.l A_Chaines(a5),d0
move.l d0,a1
bset #BitChaine,d0
bsr OutLong
move.l a6,(a1)
addq.l #4,A_Chaines(a5)
; Saute la constante
bsr GetWord
btst #0,d0
beq.s FCh1
addq.w #1,d0
FCh1 add.w d0,a6
moveq #2,d2
; Marque le flag CONSTANTE
DoConst lea Const(pc),a0
move.l a0,(sp)
rts
******* Fonctions compilo
FnExpentier
addq.l #2,a6
Expentier
bsr Evalue
DoEntier
tst.b d2
bne FlToInt
rts
Compat
cmp.b d2,d5
beq.s CptX
bsr QueFloat
CptX subq.w #1,d5
bne.s CptX1
bset #0,Flag_Math(a5)
CptX1 tst.b d5
rts
QuEntier
tst.b d2
beq.s Que1
moveq #L_FlToInt,d0
bsr CreFonc
moveq #0,d2
Que1 tst.b d5
beq.s Que2
move.w #L_FlToInt2,d0
bsr CreFonc
moveq #0,d5
Que2 rts
QueFloat
bset #0,Flag_Math(a5)
tst.b d2
bne.s QueF1
moveq #L_IntToFl,d0
bsr CreFonc
moveq #1,d2
QueF1 tst.b d5
bne.s QueF2
move.w #L_IntToFl2,d0
bsr CreFonc
moveq #1,d5
QueF2 rts
EqType
cmp.b d1,d2
bne.s Eqt1
rts
Eqt1 tst.b d1
bne.s IntToFl
beq.s FlToInt
FnFloat
bset #0,Flag_Math(a5)
bsr FnEval
tst.b d2
bne.s FnFl1
moveq #L_IntToFl,d0
bsr CreFonc
moveq #1,d2
FnFl1 rts
IntToFl
movem.l d0-d1/a0-a2,-(sp)
bset #0,Flag_Math(a5)
moveq #L_IntToFl,d0
bsr CreFonc
moveq #1,d2
movem.l (sp)+,d0-d1/a0-a2
rts
FlToInt
movem.l d0-d1/a0-a2,-(sp)
bset #0,Flag_Math(a5)
moveq #L_FlToInt,d0
bsr CreFonc
moveq #0,d2
movem.l (sp)+,d0-d1/a0-a2
rts
;-----> Operateur +
CPlus bsr Compat
bmi.s CPl2
beq.s CPl1
* Chaines
moveq #L_PlusC,d0
bsr CreFonc
moveq #2,d2
rts
* Float
CPl1 moveq #L_PlusF,d0
bsr CreFonc
bset #0,Flag_Math(a5)
moveq #1,d2
rts
* Entiere
CPl2 lea CcPlus(pc),a0
bra OutCode
CcPlus move.l (a3)+,d0
add.l d0,(a3)
dc.w $4321
;-----> Operateur -
CMoins bsr Compat
bmi.s CMn2
beq.s CMn1
* Chaines
moveq #L_MoinsC,d0
bsr CreFonc
moveq #2,d2
rts
* Float
CMn1 moveq #L_MoinsF,d0
bsr CreFonc
bset #0,Flag_Math(a5)
moveq #1,d2
rts
* Entiere
CMn2 lea CcMoins(pc),a0
bra OutCode
CcMoins move.l (a3)+,d0
sub.l d0,(a3)
dc.w $4321
;-----> Operateur *
CMult: moveq #L_Mult,d0
bsr COpe
move.w d1,d2
rts
;-----> Operateur /
CDiv moveq #L_Div,d0
bsr COpe
move.w d1,d2
rts
;-----> Operateur MODULO
CMod bsr Quentier
moveq #L_Mod,d0
bra CreFonc
;-----> Operateur PUISSANCE
CPuis: bsr QueFloat
bset #1,Flag_Math(a5)
moveq #L_Puis,d0
bra CreFonc
;-----> Operateur =
CEg: moveq #L_Eg,d0
bra.s COpe
;-----> Operateur <>
CDif: moveq #L_Dif,d0
bra.s COpe
;-----> Operateur <
CInf: moveq #L_Inf,d0
bra.s COpe
;-----> Operateur >
CSup: moveq #L_Sup,d0
bra.s COpe
;-----> Operateur <=
CInfEg moveq #L_InfEg,d0
bra.s COpe
;-----> Operateur >=
CSupEg moveq #L_SupEg,d0
COpe move.w d0,-(sp)
bsr Compat
bmi.s COp2
beq.s COp1
; Chaines
move.w (sp)+,d0
addq.w #2,d0
bsr CreFonc
moveq #0,d2
moveq #2,d1
rts
; Float
COp1 move.w (sp)+,d0
addq.w #1,d0
bsr CreFonc
bset #0,Flag_Math(a5)
moveq #0,d2
moveq #1,d1
rts
; Entier
COp2 move.w (sp)+,d0
bsr CreFonc
moveq #0,d2
moveq #0,d1
rts
;-----> Operateur OR
COr: bsr Quentier
lea COr2(pc),a0
COr1: bsr OutCode
moveq #0,d2
rts
COr2: move.l (a3)+,d0
or.l d0,(a3)
dc.w $4321
;-----> Operateur AND
CAnd: bsr Quentier
lea CAnd1(pc),a0
bra.s COr1
CAnd1: move.l (a3)+,d0
and.l d0,(a3)
dc.w $4321
;-----> Operateur XOR
CXor: bsr Quentier
lea CXor1(pc),a0
bra.s COr1
CXor1: move.l (a3)+,d0
eor.l d0,(a3)
dc.w $4321
;-----> Fonction NOT
CNot: bsr Expentier
lea CNt(pc),a0
bra.s COr1
CNt: not.l (a3)
dc.w $4321
;-----> FALSE / TRUE
CFalse moveq #0,d2
lea CdFal(pc),a0
bra OutCode
CTrue moveq #0,d2
lea CdTru(pc),a0
bra OutCode
CdFal clr.l -(a3)
dc.w $4321
CdTru move.l #-1,-(a3)
dc.w $4321
;-----> SWAP
CSwap bsr OutLea
addq.l #2,a6
bsr VarAdr
bsr AdToA0
move.w Cmva0ma3(pc),d0
bsr OutWord
addq.l #4,a6
bsr VarAdr
bsr AdToA0
move.w #L_Swap,d0
bra CreFonc
******* MIN + MAX
CMin move.w #L_MinE,-(sp)
bra.s CMinMax
CMax move.w #L_MaxE,-(sp)
CMinMax bsr FnEval
move.w d2,-(sp)
bsr FnEval
move.w (sp)+,d5
bsr Compat
bmi.s Cmm3
beq.s Cmm2
Cmm1 addq.w #1,(sp)
Cmm2 addq.w #1,(sp)
Cmm3 move.w (sp)+,d0
bra CreFonc
******* ABS
CInt bsr FnEval
tst.b d2
beq.s CInt2
move.w #L_IntF,d0
bsr CreFonc
moveq #1,d2
CInt2 rts
CAbs bsr FnEval
move.w #L_AbsE,d0
tst.b d2
beq CreFonc
addq.w #1,d0
bra CreFonc
CSgn bsr FnEval
move.w #L_SgnE,d0
tst.b d2
beq CreFonc
addq.w #1,d0
moveq #0,d2
bra CreFonc
CSqr move.w #L_Sqr,d0
bra.s CMath
CLog move.w #L_Log,d0
bra.s CMath
CLn move.w #L_Ln,d0
bra.s CMath
CExp move.w #L_Exp,d0
bra.s CMath
CSin move.w #L_Sin,d0
bra.s CMath
CCos move.w #L_Cos,d0
bra.s CMath
CTan move.w #L_Tan,d0
bra.s CMath
CASin move.w #L_ASin,d0
bra.s CMath
CACos move.w #L_ACos,d0
bra.s CMath
CATan move.w #L_ATan,d0
bra.s CMath
CHsin move.w #L_HSin,d0
bra.s CMath
CHCos move.w #L_HCos,d0
bra.s CMath
CHTan move.w #L_HTan,d0
* Appel de la fonction
CMath bset #0,Flag_Math(a5)
bset #1,Flag_Math(a5)
move.w d0,-(sp)
bsr FnFloat
move.w (sp)+,d0
moveq #1,d2
bra CreFonc
******* INC
CInc pea CdInc(pc)
bra.s CIncDec
CDec pea CdDec(pc)
CIncDec bsr OutLea
addq.l #2,a6
bsr VarAdr
bsr AdToA0
move.l (sp)+,a0
bra OutCode
CdInc addq.l #1,(a0)
dc.w $4321
CdDec subq.l #1,(a0)
dc.w $4321
******* ADD a,b
CAdd2 bsr OutLea
addq.l #2,a6
move.l a6,-(sp)
bsr SoVar
bsr FnExpentier
move.l (sp),d0
move.l a6,(sp)
move.l d0,a6
bsr VarAdr
bsr AdToA0
lea CdAdd1(pc),a0
bsr OutCode
move.l (sp)+,a6
rts
CdAdd1 move.l (a3)+,d0
add.l d0,(a0)
dc.w $4321
******* ADD a,b,c to d
CAdd4 bsr OutLea
addq.l #2,a6
move.l a6,-(sp)
bsr SoVar
bsr FnExpentier
bsr FnExpentier
bsr FnExpentier
move.l (sp),d0
move.l a6,(sp)
move.l d0,a6
bsr VarAdr
bsr AdToA0
move.l (sp)+,a6
move.w #L_Add4,d0
bra CreFonc
******* Instruction finie??
Finie: bsr GetWord
FinieB: beq.s Finy
cmp.w #TkDP-Tk,d0
beq.s Finy
cmp.w #TkThen-Tk,d0
beq.s Finy
cmp.w #TkElse-Tk,d0
Finy: rts
******* Appel de la routine de test
CTests tst.w Flag_NoTests(a5)
bne.s .skip
move.w #L_Tests,d0
bsr CreFonc
.skip rts
******* =PARAM
CparamE moveq #0,d2
move.l CdParE(pc),d0
bra OutLong
CparamF moveq #1,d2
bset #0,Flag_Math(a5)
move.l CdParF(pc),d0
bra OutLong
CparamC moveq #2,d2
move.l CdParS(pc),d0
bra OutLong
******* FOLLOW
CFollow bsr Finie
subq.l #2,a6
beq.s CFol3
CFol1 bsr Evalue
bsr GetWord
cmp.w #TkVir-Tk,d0
beq.s CFol1
CFol2 subq.l #2,a6
CFol3 rts
******* VARPTR
CVarptr addq.l #4,a6
bsr VarAdr
bsr AdToA0
addq.l #2,a6
and.w #$F,d2
subq.w #1,d2
bhi.s CVpt1
move.w Cmva0ma3(pc),d0
bsr OutWord
moveq #0,d2
rts
CVpt1 lea CVpt2(pc),a0
bsr OutCode
moveq #0,d2
rts
CVpt2 move.l (a0),-(a3)
addq.l #2,(a3)
dc.w $4321
******* DATA
CData addq.l #2,a6
move.l CBra(pc),d0
bsr OutLong
move.l a4,-(sp)
tst.l A_Datas(a5)
bne.s CDt1
move.l a4,A_Datas(a5)
bra.s CDt2
CDt1 move.l a4,-(sp)
move.l a4,d0
move.l A_JDatas(a5),a4
bsr OutLong
move.l (sp)+,a4
CDt2 move.w CNop(pc),d0 * Signal-> DATAS!
bsr OutWord
bsr Evalue
move.w Cmvqd2(pc),d0
and.w #$000F,d2
move.b d2,d0
bsr OutWord
move.w Cleaa2(pc),d0
bsr OutWord
bsr RelJsr
move.l a4,A_JDatas(a5)
move.l A_EDatas(a5),d0
bsr OutLong
move.w CRts(pc),d0
bsr OutWord
bsr GetWord
cmp.w #TkVir-Tk,d0
beq.s CDt1
subq.l #2,a6
* Met le BRA
move.l a4,d0
move.l (sp),a4
move.l d0,(sp)
subq.l #2,a4
sub.l a4,d0
bsr OutWord
move.l (sp)+,a4
rts
CdDNul clr.l -(a3)
moveq #-1,d2
rts
dc.w $4321
******* Cree la routine NO DATA
CreNoData
tst.l A_EDatas(a5)
bne.s CnDtX
move.l a4,A_EDatas(a5)
addq.l #2,A_EDatas(a5)
lea Cd0Data(pc),a0
bsr OutCode
CnDtX rts
Cd0Data bra.s Cd1Data
moveq #-1,d0
moveq #-1,d2
rts
Cd1Data dc.w $4321
******* RESTORE
CRest bsr OutLea
move.w #L_Rest0,d1
bsr Finie
subq.l #2,a6
beq.s CRest1
move.w N_Proc(a5),d7
bsr GetLabel
move.w #L_Rest1,d1
CRest1 move.w d1,d0
bra CreFonc
******* READ
CRead bsr OutLea
addq.l #2,a6
bsr VarAdr
bsr AdToA0
and.w #$000F,d2
move.w #L_ReadE,d0
subq.b #1,d2
bmi.s Cread1
addq.w #1,d0
tst.b d2
beq.s Cread1
addq.w #1,d0
Cread1 bsr CreFonc
bsr GetWord
cmp.w #TkVir-TK,d0
beq.s Cread
subq.l #2,a6
rts
;---------------------------------------------------------------------
; *** *** ** ** **** **** ** ** ** ** ** *** ***
; ** ** ** *** *** ** ** ** ** ** **** *** *** ** ** **
; ** ** ** ** * ** ** ** ** ** ** ** ** ** * ** ** ** ***
; ** ** ** ** ** **** ** ** ****** ** ** ** ** **
; ** ** ** ** ** ** ** ** ** ** ** ** ** ** * **
; *** *** ** ** ** **** **** ** ** ** ** *** ***
;---------------------------------------------------------------------
; CHAINES / TEXTE
;---------------------------------------------------------------------
;------> MID en fonction
CFLeft move.w #L_FLeft,d1
bra FStand
CFRight move.w #L_FRight,d1
bra FStand
CFMid2 move.w #L_FMid2,d1
bra FStand
CFMid3 move.w #L_FMid3,d1
bra FStand
;------> MID en instruction
CIMid3 move.w #L_IMid3,-(sp)
bra.s CIMid
CIMid2 move.w #L_IMid2,-(sp)
bra.s CIMid
CILeft move.w #L_ILeft,-(sp)
bra.s CIMid
CIRight move.w #L_IRight,-(sp)
CIMid bsr OutLea
addq.l #4,a6
move.l a6,-(sp)
bsr SoVar
addq.l #2,a6
bsr Expentier
cmp.w #L_IMid3,4(sp)
bne.s CIMd
addq.l #2,a6
bsr Expentier
CIMd addq.l #2,a6
bsr Evalue
move.l a6,d0
move.l (sp)+,a6
move.l d0,-(sp)
bsr VarAdr
bsr AdToA0
move.l (sp)+,a6
move.w (sp)+,d0
bra CreFonc
;------> =STR$(n)
CStr bsr FnEval
moveq #L_StrE,d0
move.w d2,d1
moveq #2,d2
subq.w #1,d1
bmi CreFonc
moveq #L_StrF,d0
bra CreFonc
;------> =VAL(a$)
CVal bsr FnEval
moveq #L_Val,d0
moveq #0,d2
btst #0,Flag_Math(a5)
beq CreFonc
moveq #1,d2
bra CreFonc
;---------------------------------------------------------------------
; *** *** ** ** **** **** ** ** ** ** ** *** ***
; ** ** ** *** *** ** ** ** ** ** **** *** *** ** ** **
; ** ** ** ** * ** ** ** ** ** ** ** ** ** * ** ** ** ***
; ** ** ** ** ** **** ** ** ****** ** ** ** ** **
; ** ** ** ** ** ** ** ** ** ** ** ** ** ** * **
; *** *** ** ** ** **** **** ** ** ** ** *** ***
;---------------------------------------------------------------------
; Boucles/Structure
;---------------------------------------------------------------------
******* REMs
CRem subq.w #1,NbInstr(a5)
bsr GetWord
add.w d0,a6
rts
;----------------------> TRAITEMENT DES ERREURS
OutLea move.l CLeapca4(pc),d0
bra OutLong
;----------------------> PROCEDURES
******* Codage / Decodage procedure LOCKEE
* A6---> "PROC"
ProCode movem.l d0-d7/a0-a6,-(sp)
move.l 2(a6),d0
lea 10+2+4(a6,d0.l),a2 * A2---> ENDPROC
move.w -2(a6),d0
lsr.w #8,d0
lsl.w #1,d0
lea -2(a6,d0.w),a1 * A1---> Ligne suivante
move.l 2(a6),d5
rol.l #8,d5
move.b 9(a6),d5
moveq #1,d4
move.w 6(a6),d3
bra.s PrCo2
PrCo1 eor.w d5,(a0)+
add.w d4,d5
add.w d3,d4
ror.l #1,d5
cmp.l a0,a1
bne.s PrCo1
PrCo2 move.l a1,a0
move.w (a0)+,d0
lsr.w #8,d0
lsl.w #1,d0
lea -2(a0,d0.w),a1
addq.l #2,a0
cmp.l a0,a2
bne.s PrCo1
* Change le flag
bchg #5,8(a6)
movem.l (sp)+,d0-d7/a0-a6
rts
******* Debut de procedure, premiere exploration
CProc subq.w #1,NbInstr(a5)
* Decode la procedure si codee...
move.l a6,-(sp)
addq.l #6,a6
bsr GetWord
btst #6+8,d0
beq.s VPr0
btst #5+8,d0
beq.s VPr0
tst.w Flag_Source(a5)
bne NoCode
move.l (sp),a6
subq.l #2,a6
add.l B_Source(a5),a6
bsr ProCode
VPr0 move.l (sp)+,a6
* Stocke le label et les types
bsr GetLong
subq.l #4,a6
pea 8(a6,d0.l)
pea (a6)
lea 8+2(a6),a6
moveq #-1,d7
bsr RLabel
move.l (sp)+,d0
bset #30,d0
move.l d0,2(a2)
move.l (sp)+,a6
rts
******* Proc
CPrc
addq.l #2,a6
******* Appel de procedure
CDoPro
bsr OutLea
subq.l #2,a6
move.l a6,-(sp)
bsr StockOut
moveq #-1,d7
bsr GetLabel
bsr RestOut
moveq #0,d7
bsr GetWord
subq.l #2,a6
cmp.w #TkBra1-Tk,d0
bne.s CDop3
addq.l #2,a6
CDop1 lsl.l #1,d7
move.l d7,-(sp)
bsr Evalue
move.l (sp)+,d7
cmp.b #1,d2
bne.s CDop2
bset #0,d7
CDop2 bsr GetWord
cmp.w #TkBra2-Tk,d0
bne.s CDop1
CDop3 move.l a6,d0
move.l (sp),a6
move.l d0,(sp)
move.l d7,-(sp)
moveq #-1,d7
bsr GetLabel
lea CdDop(pc),a0
move.w (a0)+,d0
bsr OutWord
addq.l #4,a0
move.l (sp)+,d0
bsr OutLong
bsr OutCode
move.l (sp)+,a6
rts
CdDop move.l #0,d6
jsr (a0)
dc.w $4321
******* POP PROC
CPopP moveq #L_FProc,d0
bra CreJmp
;----------------------> FOR / TO / NEXT
CFor
bsr OutLea
; Prend et egalise la variable
bsr GetWord ; Teste?
beq Synt
pea -2(a6,d0.w) ; Adresse du NEXT
addq.l #2,a6
move.l a6,-(sp)
bsr StockOut ; Saute la variable
bsr IVarBis
bsr RestOut
and.w #$0F,d2
move.w d2,-(sp) ; Sauve le type
; Compile le TO
addq.l #2,a6
bsr Evalue
move.w (sp),d1
bsr EqType ; Egalise les types
; Compile le STEP
move.w #-1,Flag_Const(a5)
bsr GetWord
subq.l #2,a6
cmp.w #TkStp-Tk,d0
bne.s CFor3
addq.l #2,a6
bsr Evalue ; va chercher le STEP
bra.s CFor4
CFor3 lea ForCd1(pc),a0
bsr OutCode
moveq #1,d3
moveq #0,d2
CFor4 move.w (sp),d1
bsr EqType ; Egalise les type TO / STEP
move.l d3,-(sp)
; Compile la variable
move.l 4+2(sp),d0
move.l a6,4+2(sp)
move.l d0,a6
bsr IVarBis
bsr AdToA0
move.l 4+2(sp),a6
; Adresse des adresses
move.w M_ForNext(a5),d1
lea forcd2(pc),a0
bsr RForNxt
bsr OutCode
; Fonction de demarrage de la boucle
moveq #0,d7
tst.w Flag_Const(a5)
beq.s CForPaR
tst.w 4(sp)
bne.s CForPar
moveq #-1,d7
CForPaR
; Poke les tables du compilateur
move.l A_Bcles(a5),a1
move.w d7,(a1)+ ; 0 Flag rapide
move.w 4(sp),(a1)+ ; 2 Type
move.l (sp),(a1)+ ; 4 Step
move.l a4,(a1)+ ; 8 -6 Adresse dans le programme
move.w M_ForNext(a5),(a1)+ ; 12 Position de la boucle
move.w #16,(a1)+ ; 14 -2 Taille FOR/NEXT
move.l a1,A_Bcles(a5)
; Un FOR/NEXT de plus!
add.w #12,M_ForNext(a5)
addq.w #1,N_Bcles(a5)
lea 14(sp),sp
rts
forcd1: move.l #$1,-(a3)
dc.w $4321
forcd2: move.l AForNext(a5),a2
lea 0(a2),a2
move.l (a3)+,(a2)+
move.l (a3)+,(a2)+
move.l a0,(a2)
dc.w $4321
;-----------------------------------> NEXT
CNext:
bsr OutLea
bsr CTests
; Saute la variable
bsr GetWord
subq.l #2,a6
cmp.w #TkVar-Tk,d0
bne.s CNx0
addq.l #2,a6
bsr SoVar
; Depile la boucle
CNx0 move.l A_Bcles(a5),a1
sub.w -2(a1),a1
move.w 12(a1),d1 * P_FORNEXT
tst.w (a1)
beq.s CNx2
; Une boucle "rapide"
lea CdNx(pc),a0
bsr RForNxt
bsr OutCode
move.w CBgtS(pc),d7
swap d7
move.w CBle(pc),d7
tst.l 4(a1)
bmi.s CNx1
move.w CBltS(pc),d7
swap d7
move.w CBge(pc),d7
CNx1 moveq #0,d5
move.l 8(a1),d6
bsr DoTest
bra.s CNxX
* Boucle lente
CNx2 lea CdNx(pc),a0
bsr RForNxt
move.w CLeaa1(pc),d7
swap d7
move.w CLeapca1(pc),d7
move.l 8(a1),d6
moveq #0,d5
bsr DoLea
moveq #L_NextE,d0
tst.w 2(a1)
beq.s CNx6
moveq #L_NextF,d0
CNx6 bsr CreFonc
* Fin de la boucle
CNxX bra UnPile
; Routine
RForNxt move.l (a0)+,d0
bsr OutLong
tst.w d1
beq.s .Skip1
move.w (a0),d0
bsr OutWord
move.w d1,d0
bsr OutWord
.Skip1 addq.l #4,a0
rts
; Code RAPIDE
CdNx move.l AForNext(a5),a2
lea 0(a2),a2
move.l (a2)+,d0
move.l (a2)+,d1
move.l (a2),a2
add.l d0,(a2)
cmp.l (a2),d1
dc.w $4321
;------------------------------> REPEAT / UNTIL
CDo
CRepeat move.l A_Bcles(a5),a1
move.l a4,(a1)+ ; 0 6 Adresse boucle
bsr GetWord
beq Synt
lea -2(a6,d0.w),a0
move.w #6,(a1)+
move.l a1,A_Bcles(a5)
addq.w #1,N_Bcles(a5)
rts
CUntil
bsr OutLea
bsr CTests
bsr Evalue
lea CdUntil(pc),a0
bsr OutCode
move.l A_Bcles(a5),a1
move.w CBne8(pc),d7
swap d7
move.w CBeq(pc),d7
move.l -6(a1),d6
moveq #0,d5
bsr DoTest
bra UnPile
CdWhile
CdUntil tst.l (a3)+
dc.w $4321
;------------------------------> LOOP
CLoop
bsr OutLea
bsr CTests
moveq #0,d5
move.l A_Bcles(a5),a1
move.l -6(a1),d6
bsr DoBra
bra UnPile
;------------------------------> WHILE / WEND
CWhile
bsr GetWord
beq Synt
; Retour du WEND
move.l A_Bcles(a5),a1
move.l a6,(a1)+
move.w CJmp(pc),d0
bsr OutWord
bsr RelJsr
addq.l #4,a4
move.l a4,(a1)+
move.w #10,(a1)+
move.l a1,A_Bcles(a5)
addq.w #1,N_Bcles(a5)
; Saute l'expression
bsr StockOut
bsr Evalue
bsr RestOut
rts
CWend
bsr OutLea
bsr CTests
move.l A_Bcles(a5),a1
; Reloge le JMP du debut
move.l a4,-(sp)
move.l a4,d0
move.l -6(a1),a4
subq.l #4,a4
bsr OutLong
move.l (sp)+,a4
; Evalue l'expression
movem.l a1/a6,-(sp)
move.l -10(a1),a6
bsr Expentier
movem.l (sp)+,a1/a6
move.w Ctsta3p(pc),d0
bsr OutWord
; Met le branchement
moveq #0,d5
move.l -6(a1),d6
move.w CBeq8(pc),d7
swap d7
move.w CBne(pc),d7
bsr DoTest
bra UnPile
;------------------------------> EXIT / EXIT IF
CExitIf
bsr OutLea
bsr GetWord
move.w d0,d1
beq Synt
bsr GetWord
beq Synt
pea 0(a6,d1.w)
bsr Expentier
bsr GetWord
subq.l #2,a6
cmp.w #TkVir-Tk,d0
bne.s CEIf0
addq.l #2+6,a6
CEIf0 move.w Ctsta3p(pc),d0
bsr OutWord
move.l (sp)+,d5
moveq #0,d6
move.w Cbeq8(pc),d7
swap d7
move.w Cbne(pc),d7
bsr DoTest
rts
CExit
bsr GetWord
move.w d0,d1
beq Synt
bsr GetWord
beq Synt
lea 0(a6,d1.w),a0
move.l a0,d5
bsr GetWord
subq.l #2,a6
cmp.w #TkEnt-Tk,d0
bne.s Cexi1
addq.l #6,a6
Cexi1 moveq #0,d6
bsr DoBra
rts
;------------------------------> IF / THEN / ELSE
CIf
bsr OutLea
bsr GetWord
beq Synt
pea 0(a6,d0.w)
bsr Expentier
CIf0
move.w Ctsta3p(pc),d0
bsr OutWord
move.l (sp)+,d5
moveq #0,d6
move.w CBne8(pc),d7
swap d7
move.w CBeq(pc),d7
bsr DoTest
rts
CElse
bsr GetWord
beq Synt
lea 0(a6,d0.w),a0
move.l a0,d5
moveq #0,d6
bsr DoBra
rts
******* DEUX POINTS
CIDP subq.w #1,NbInstr(a5)
CINop rts
;-------------------------------------> GOTO / LABELS
;-----> LABEL:
CLabel
move.w N_Proc(a5),d7
bsr RLabel
tst.l 2(a2)
bpl Synt
move.l a4,2(a2)
rts
;-----> GOTO
CLGoto
subq.l #2,a6
CGoto
bsr OutLea
bsr CTests
move.w N_Proc(a5),d7
bsr GetLabel
CGoto1 move.w Cjmpa0(pc),d0
bra OutWord
;-----> THEN ligne
CGoto2
bsr OutLea
bsr CTests
bsr CGlab1
bra.s CGoto1
;-----> EVERY n GOSUB / PROC
CEvery
bsr Expentier
bsr GetWord
cmp.w #TkPrc-Tk,d0
beq.s CEv1
; Every GOSUB
move.w N_Proc(a5),d7
bsr GetLabel
move.w #L_EvGosub,d0
bra CreFonc
; Every PROC
CEv1 moveq #-1,d7
bsr GetLabel
move.w #L_EvProc,d0
bra CreFonc
;-----> GOSUB
CGosub
bsr OutLea
bsr CTests
move.w N_Proc(a5),d7
bsr GetLabel
lea CdGsb(pc),a0
bra OutCode
CdGsb: lea -4(sp),a1
move.l a1,LowPile(a5)
jsr (a0)
dc.w $4321
;-----> RETURN
CReturn
bsr OutLea
bsr CTests
moveq #L_Return,d0
bra CreJmp
;-----> POP
CPop
bsr OutLea
bsr CTests
moveq #L_Pop,d0
bra CreFonc
;-----> ON exp GOTO / GOSUB
COn
bsr OutLea
bsr CTests
bsr GetWord
beq Synt
lea 2(a6,d0.w),a1
bsr GetWord
move.w d0,-(sp)
beq Synt
move.l a1,-(sp)
bsr Expentier
bsr GetWord
move.w d0,-(sp)
lea CdOn(pc),a0
move.w (a0)+,d0
move.b 6+1(sp),d0
bsr OutWord
bsr OutCode
move.w N_Proc(a5),d7
move.w (sp)+,d0
cmp.w #TkGsb-Tk,d0
beq.s COn1
cmp.w #TkPrc-Tk,d0
beq.s COnP
; On...Goto
move.w Cjmpa0(pc),d0
bra.s COnP1
; On...Gosub
COn1 lea CdGsb(pc),a0
bsr OutCode
bra.s COn2
; On...Proc
COnP moveq #-1,d7
move.w Cjsra0(pc),d0
COnP1 bsr OutWord
move.w CNop(pc),d0
bsr OutWord
bsr OutWord
bsr OutWord
bsr OutWord
; Bra final
COn2 move.w CBra(pc),d0
move.l a4,d4
move.l (sp)+,d5
bsr OutWord
addq.l #2,a4
bsr MarkAd
; Met les labels
move.w (sp),d0
move.l a4,-(sp)
move.l a4,-(sp)
lsl.w #1,d0
add.w d0,a4
COn3 move.l a4,d0
move.l a4,d4
move.l (sp),a4
sub.l 4(sp),d0
bsr OutWord
addq.l #2,(sp)
move.l d4,a4
bsr GetLabel
move.w CRts(pc),d0
bsr OutWord
addq.l #2,a6
subq.w #1,8(sp)
bne.s COn3
; Ouf!
subq.l #2,a6
lea 10(sp),sp
rts
CdOn moveq #0,d1
move.l (a3)+,d0
beq.s CdOn1+10
cmp.l d1,d0
bhi.s CdOn1+10
lsl.w #1,d0
move.w CdOn1+10+4-2(pc,d0.w),d0
jsr CdOn1+10+4(pc,d0.w)
CdOn1 dc.w $4321
******* ON ERROR
COnErr bsr OutLea
move.w #L_OnErr0,d1
bsr GetWord
cmp.w #TkPrc-Tk,d0
beq.s CerP
cmp.w #TkGto-Tk,d0
bne.s Cer0
* On error GOTO
move.l a6,-(sp)
bsr GetWord
cmp.w #TkEnt-Tk,d0
bne.s CerG
bsr GetLong
tst.l d0
bne.s CerG
addq.l #4,sp
bra.s Cer1
CerG move.l (sp)+,a6
move.w N_Proc(a5),d7
bsr GetLabel
move.w #L_OnErr1,d0
bra CreFonc
* On error PROC
CerP moveq #-1,d7
bsr GetLabel
move.w #L_OnErr2,d0
bra CreFonc
* On error RIEN
Cer0 subq.l #2,a6
Cer1 move.w #L_OnErr0,d0
bra CreFonc
******* RESUME
CRes bsr OutLea
bsr Finie
subq.l #2,a6
beq.s CRes0
move.w N_Proc(a5),d7
bsr GetLabel
move.w #L_Res1,d0
bra CreJmp
CRes0 move.w #L_Res0,d0
bra CreJmp
******* RESUME LABEL
CResL bsr OutLea
bsr Finie
subq.l #2,a6
beq.s CResl0
move.w N_Proc(a5),d7
bsr GetLabel
move.w #L_Resl1,d0
bra CreFonc
Cresl0 move.w #L_Resl0,d0
bra CreFonc
* ROUTINE -> adresse d'un label
* OUT >>> lea label,a0
* Retour VRAI si FIXE / FAUX si variable
GetLabel
bsr GetWord
cmp.w #TkLGo-Tk,d0
beq Cglab1
cmp.w #TkPro-Tk,d0
beq Cglab1
; Expression
subq.w #2,a6
addq.w #1,Flag_Labels(a5) ; Copier la table!
move.w #-1,Flag_Const(a5)
bsr StockOut
move.w d7,-(sp)
bsr Evalue
move.w (sp)+,d7
moveq #L_GetLabA,d1
cmp.b #2,d2
beq Glab0a
tst.b d2
beq.s Glab0
bsr FlToInt
Glab0 moveq #L_GetLabE,d1
tst.w Flag_Const(a5)
bne.s Clab0b
; Expression variable!
Glab0a bsr SautOut
move.w Cmviwd6(pc),d0
bsr OutWord
move.w N_Proc(a5),d0
bsr OutWord
move.w d1,d0
bra CreFonc
; Numero de ligne FIXE
Clab0b subq.w #1,Flag_Labels(a5)
bsr RestOut
move.l d3,d0
moveq #-1,d3
moveq #0,d4
move.l B_Work(a5),a2
move.l a2,a0
bsr HexToAsc
move.l a0,a1
move.l a1,d6
btst #0,d6
beq.s Clab0c
clr.b (a1)+
addq.l #1,d6
Clab0c sub.l a2,d6
move.w d6,d5
lsr.w #1,d5
bsr CLabBis
bra.s Cglab0
; Label simple
Cglab1 bsr RLabel
Cglab0 move.w CLeaa0(pc),d0
bsr OutWord
bsr RelJsr
move.l a2,d0
bset #BitLabel,d0
bra OutLong
* ROUTINE -> Trouve / Cree / Saute le label (a6)
* Entree D7= Numero procedure
* Retour A2= Label
RLabel
addq.l #2,a6
moveq #0,d0
bsr GetWord
lsr.w #8,d0
move.w d0,d6
lsr.w #1,d0
move.w d0,d5
move.w d0,d1
move.l B_Work(a5),a1
CLab1 bsr GetWord
move.w d0,(a1)+
subq.b #1,d1
bne.s CLab1
CLabBis move.w d7,(a1)+
addq.w #2,d6
* addq.w #1,d5 Pour DBRA!
; Recherche dans la table
move.l B_Labels(a5),a2
moveq #-6,d1
CLab3 lea 6(a2,d1.w),a2
move.w (a2),d1
beq.s CLab5
cmp.w d6,d1
bne.s CLab3
move.l B_Work(a5),a0
lea 6(a2),a1
move.w d5,d0
CLab4 cmp.w (a0)+,(a1)+
bne.s CLab3
dbra d0,CLab4
rts
; Cree le nouveau
CLab5 move.w d6,(a2)
move.l a6,d0
bset #31,d0
move.l d0,2(a2)
move.l B_Work(a5),a0
lea 6(a2),a1
CLab6 move.w (a0)+,(a1)+
dbra d5,CLab6
lea 6(a2,d6.w),a0
clr.w (a0)
rts
* ROUTINE -> Conversion HEX- > DEC
HexToAsc
tst.l d0
bpl.s Chexy
move.b #"-",(a0)+
neg.l d0
bra.s Chexz
Chexy: tst d4
beq.s Chexz
move.b #32,(a0)+
Chexz: tst.l d3
bmi.s Chexv
neg.l d3
add.l #10,d3
Chexv: move.l #9,d4
lea Cmdx(pc),a1
Chxx0: move.l (a1)+,d1 ;table des multiples de dix
move.b #$ff,d2
Chxx1: addq.b #1,d2
sub.l d1,d0
bcc.s Chxx1
add.l d1,d0
tst.l d3
beq.s Chxx4
bpl.s Chxx3
btst #31,d4
bne.s Chxx4
tst d4
beq.s Chxx4
tst.b d2
beq.s Chxx5
bset #31,d4
bra.s Chxx4
Chxx3: subq.l #1,d3
bra.s Chxx5
Chxx4: add #48,d2
move.b d2,(a0)+
Chxx5: dbra d4,Chxx0
rts
Cmdx: dc.l 1000000000,100000000,10000000,1000000
dc.l 100000,10000,1000,100,10,1,0
* ROUTINE -> BRA/JMP
* D5= adresse en AVANT
* D6= adresse en ARRIERE
DoBra move.w CJmp(pc),d7
swap d7
move.w CBra(pc),d7
* Entree pour LEA / LEA (pc)
DoLea tst.l d5
bne.s DBr2
* En arriere!
move.l d6,d1
sub.l a4,d1
subq.l #2,d1
cmp.l #32764,d1
bge.s Dbr1
cmp.l #-32764,d1
ble.s DBr1
; Ok, en SHORT!
DBr0 move.w d7,d0
bsr OutWord
move.w d1,d0
bra OutWord
; En LONG!
Dbr1 swap d7
move.w d7,d0
bsr OutWord
bsr RelJsr
move.l d6,d0
bra OutLong
* En avant!
Dbr2 move.l a4,d4
tst.w Flag_Long(a5)
bne.s DBr3
; En short
Dbr4 move.w d7,d0
bsr OutWord
addq.l #2,a4
bra.s MarkAd
; En long
Dbr3 bset #31,d4
swap d7
move.w d7,d0
bsr OutWord
bsr RelJsr
addq.l #4,a4
bra.s MarkAd
* ROUTINE -> TEST ET BRANCHEMENT
* D5= adresse en AVANT
* D6= adresse en ARRIERE
DoTest tst.l d5
bne.s DTst2
* En arriere!
move.l d6,d1
sub.l a4,d1
subq.l #2,d1
cmp.l #32764,d1
bge.s Dtst1
cmp.l #-32764,d1
bge.s Dbr0
; En LONG!
Dtst1 swap d7
move.w d7,d0
bsr OutWord
move.w CJmp(pc),d0
bsr OutWord
bsr RelJsr
move.l d6,d0
bra OutLong
* En Avant!
DTst2 move.l a4,d4
tst.w Flag_Long(a5)
beq.s DBr4
; En long!
bset #31,d4
addq.l #2,d4
swap d7
move.w d7,d0
bsr OutWord
move.w CJmp(pc),d0
bsr OutWord
bsr RelJsr
addq.l #4,a4
* Marque la table des branch forward
MarkAd
movem.l a0/a1,-(sp)
move.l B_Lea(a5),a0
MAd1 cmp.l (a0),d5
addq.l #8,a0
bcc.s MAd1
subq.l #8,a0
; Fait une place
move.l A_Lea(a5),a1
MAd2 move.l (a1),8(a1)
move.l 4(a1),12(a1)
subq.l #8,a1
cmp.l a0,a1
bcc.s MAd2
; Poke le nouveau
move.l d5,(a0)+
move.l d4,(a0)
addq.l #8,A_Lea(a5)
movem.l (sp)+,a0/a1
rts
* ROUTINE -> Poke l'adresse d'une ligne
PokeAd move.l a4,-(sp)
move.l a4,d0
move.l B_Lea(a5),a2
move.l 4(a2),d1
bmi.s JAbs
; Branchement (pc)
addq.l #2,d1
move.l d1,a4
sub.l d1,d0
cmp.l #32764,d0
bgt ErrDoLong
cmp.l #-32764,d0
blt ErrDoLong
bsr OutWord
; Enleve de la table
ETable move.l A_Lea(a5),a1
PAd1 move.l 8(a2),(a2)+
move.l 8(a2),(a2)+
cmp.l a1,a2
bcs.s PAd1
subq.l #8,A_Lea(a5)
move.l (sp)+,a4
rts
; Branchement absolu
JAbs bclr #31,d1
addq.l #2,d1
move.l d1,a4
bsr OutLong
bra.s ETable
* ROUTINE -> Depile une boucle -> A1
UnPile move.l A_Bcles(a5),a1
sub.w -2(a1),a1
move.l a1,A_Bcles(a5)
subq.w #1,N_Bcles(a5)
rts
;---------------------------------------------------------------------
; *** *** ** ** **** **** ** ** ** ** ** *** ***
; ** ** ** *** *** ** ** ** ** ** **** *** *** ** ** **
; ** ** ** ** * ** ** ** ** ** ** ** ** ** * ** ** ** ***
; ** ** ** ** ** **** ** ** ****** ** ** ** ** **
; ** ** ** ** ** ** ** ** ** ** ** ** ** ** * **
; *** *** ** ** ** **** **** ** ** ** ** *** ***
;---------------------------------------------------------------------
; Entree / Sortie
;---------------------------------------------------------------------
Lp1 lea Lp1(pc),a4 ; Debut expression
dc.w $4321
;-----> LPRINT
CLPrnt: move.w #1,-(sp)
bra.s Cp2
;-----> PRINT #
CHPrnt move.w #-1,-(sp)
bsr Expentier
addq.l #2,a6
move.w #L_HPrintD,d0
bsr CreFonc
bra.s Cp2
;-----> PRINT
CPrnt: clr.w -(sp)
; Prend les expressions
Cp2 bsr Finie
bne.s Cp3
subq.l #2,a6
moveq #L_CRPrint,d0
bsr CreFonc
bra Cp13
Cp3 lea Lp1(pc),a0
bsr OutCode
* USING: prend la chaine et marque le using
clr.w -(sp)
cmp.w #TkUsing-Tk,d0
bne.s Cp4
subq.w #1,(sp)
bsr Evalue
addq.l #4,a6
cmp.b #2,d2
bne Synt
; Prend l'expression
Cp4 subq.l #2,a6
bsr Evalue
subq.w #1,d2
bmi.s Cp5
beq.s Cp6
* Chaine
tst.w (sp)+
bne.s Cp4a
moveq #L_PrintS,d0 ; Pas using
tst.w (sp)
beq.s Cp7a
moveq #L_PrintS,d0 ; ILLEGAL!!
tst.w (sp)
bpl.s Cp7a
move.w #L_HPrintS,d0
bra.s Cp7a
cp4a moveq #L_UsingS,d0 ; Using
bra.s Cp7a
* Entier
cp5 bclr #6,2(sp)
move.w #L_PrintE,d0
bsr CreFonc
moveq #L_UsingC,d0
bra.s Cp7
* Float
cp6 bset #0,Flag_Math(a5)
bclr #6,2(sp)
moveq #L_PrintF,d0
bsr CreFonc
moveq #L_UsingC,d0
Cp7: and.w (sp)+,d0
beq.s Cp7b
Cp7a bsr CreFonc
Cp7b
; Prend le separateur
Cp8: bsr GetWord
cmp.w #TkPVir-Tk,d0
beq.s Cp13
bclr #6,(sp)
cmp.w #TkVir-Tk,d0
beq.s Cp11
subq.l #2,a6
moveq #L_PrtRet,d0
bra.s Cp12
Cp11: moveq #L_PrtVir,d0
Cp12: bsr CreFonc
; Imprime!
Cp13 moveq #L_PrintX,d0
tst.w (sp)
beq.s Cp14
moveq #L_LPrintX,d0
tst.w (sp)
bpl.s Cp14
bset #6,(sp)
bne.s Cp15
move.w #L_HPrintX,d0
Cp14 bsr CreFonc
Cp15
* Encore quelque chose a imprimer?
bsr Finie
bne Cp3
* Termine!
subq.l #2,a6
tst.w (sp)+
rts
;----------------------------------> INPUT #
CInputH
move.w #-1,-(sp)
move.w #L_InputH,-(sp)
bra.s CIn0
;----------------------------------> INPUT #
CLInputH
move.w #-1,-(sp)
move.w #L_LInputH,-(sp)
CIn0 bsr OutLea
bsr Stockout
move.l a6,-(sp)
bsr Expentier
bsr RestOut
addq.l #2,a6
bra.s CIn7
;----------------------------------> LINE INPUT
CLInput clr.w -(sp)
move.w #L_LInputC,-(sp)
bra.s CIn1
;----------------------------------> INPUT
CInput clr.w -(sp)
move.w #L_InputC,-(sp)
CIn1: bsr OutLea
bsr GetWord
subq.l #2,a6
; Saute la chaine alphanumerique
clr.l -(sp)
cmp.w #TkVar-Tk,d0
beq.s CIn7
move.l a6,(sp)
bsr Stockout
bsr Evalue
bsr RestOut
addq.l #2,a6
* Stocke la liste des variable ---> -(A3) / moveq #NB,d6
CIn7: clr.w -(sp)
CIn8: addq.l #2,a6
bsr VarAdr
bsr AdToA0
and.w #$000F,d2
lea CdInp(pc),a0
move.w (a0)+,d0
bsr OutWord
move.w d2,d0
bsr OutWord
addq.l #2,a0
move.w (a0)+,d0
bsr OutWord
addq.w #1,(sp)
bsr GetWord
cmp.w #TkVir-Tk,d0
beq.s CIn8
CIn9: subq.l #2,a6
******* Input clavier...
tst.w 8(sp)
bne.s CIn11
; Evalue la chaine
move.l 2(sp),d0
bne.s Cin10
move.w Cclrma3(pc),d0
bsr OutWord
bra.s CIn12
CIn10 move.l a6,2(sp)
move.l d0,a6
bsr Evalue
move.l 2(sp),a6
bra.s CIn12
; Evalue le fichier
CIn11 move.l 2(sp),d0
move.l a6,2(sp)
move.l d0,a6
bsr Expentier
move.l 2(sp),a6
; Moveq nombre de params
CIn12 move.w cmvqd6(pc),d0
move.w (sp)+,d1
move.b d1,d0
bsr Outword
addq.l #4,sp
; Appele la fonction
move.w (sp)+,d0
bsr CreFonc
; Un point virgule?
tst.w (sp)+
bne CInX
bsr GetWord
cmp.w #TkPVir-Tk,d0
beq.s CInX
moveq #L_CRet,d0
bsr CreFonc
subq.l #2,a6
CInX rts
CdInp move.w #$ffff,-(a3)
move.l a0,-(a3)
dc.w $4321
;-----> FIELD
CField bsr OutLea
bsr Stockout
move.l a6,-(sp)
bsr Expentier
bsr RestOut
addq.l #2,a6
clr.w -(sp)
Cfld1 addq.w #1,(sp)
bsr Expentier
addq.l #4,a6
bsr VarAdr
bsr AdToA0
move.w Cmva0ma3(pc),d0
bsr OutWord
bsr GetWord
cmp.w #TkVir-Tk,d0
beq.s CFld1
subq.l #2,a6
; Handle fichier
move.l 2(sp),d0
move.l a6,2(sp)
move.l d0,a6
bsr Expentier
move.l 2(sp),a6
; Nombre de champs
move.w Cmvqd0(pc),d0
move.w (sp)+,d1
move.b d1,d0
bsr OutWord
; Appelle la fontion
addq.l #4,sp
move.w #L_Field,d0
bra CreFonc
;---------------------------------------------------------------------
; *** *** ** ** **** **** ** ** ** ** ** *** ***
; ** ** ** *** *** ** ** ** ** ** **** *** *** ** ** **
; ** ** ** ** * ** ** ** ** ** ** ** ** ** * ** ** ** ***
; ** ** ** ** ** **** ** ** ****** ** ** ** ** **
; ** ** ** ** ** ** ** ** ** ** ** ** ** ** * **
; *** *** ** ** ** **** **** ** ** ** ** *** ***
;---------------------------------------------------------------------
; ECRANS / GRAPHIQUES
;---------------------------------------------------------------------
******* PALETTEs
CDPal move.w #L_DPal,-(sp)
bra.s CPal0
CPal move.w #L_Pal,-(sp)
CPal0 bsr OutLea
clr.w -(sp)
CPal1 addq.w #1,(sp)
bsr Expentier
bsr GetWord
cmp.w #TKVir-Tk,d0
beq.s CPal1
subq.l #2,a6
move.w CMvqd0(pc),d0
move.w (sp)+,d1
move.b d1,d0
bsr OutWord
move.w (sp)+,d0
bsr CreFonc
rts
******* FADE
CFade bsr OutLea
bsr Expentier
bsr GetWord
move.w #L_FadeN,-(sp)
cmp.w #TkVir-Tk,d0
beq.s CPal0
cmp.w #TkTo-Tk,d0
beq.s CFad1
subq.l #2,a6
move.w #L_Fade1,(sp)
bra CFadX
CFad1 move.w #L_Fade2,(sp)
bsr Expentier
bsr GetWord
subq.l #2,a6
cmp.w #TkVir-Tk,d0
bne.s CFadX
move.w #L_Fade3,(sp)
bsr FnExpentier
CFadX move.w (sp)+,d0
bra CreFonc
******* POLYLINE / POLYGON
CPoLine move.w #L_Polyl,-(sp)
bra.s CPol
CPoGone move.w #L_Pogo,-(sp)
CPol clr.l -(sp)
bsr OutLea
bsr GetWord
cmp.w #TkTo-Tk,d0
beq.s CPol1
subq.l #2,a6
move.w #-1,2(sp)
bsr Expentier
addq.l #2,a6
bsr Expentier
addq.w #1,(sp)
addq.l #2,a6
CPol1 addq.w #1,(sp)
bsr Expentier
addq.l #2,a6
bsr Expentier
bsr GetWord
cmp.w #TkTo-Tk,d0
beq.s CPol1
subq.l #2,a6
move.w Cmvqd0(pc),d0
move.w (sp)+,d1
move.b d1,d0
bsr OutWord
move.w CMvqd1(pc),d0
move.w (sp)+,d1
move.b d1,d0
bsr OutWord
move.w (sp)+,d0
bra CreFonc
;---------------------------------------------------------------------
; *** *** ** ** **** **** ** ** ** ** ** *** ***
; ** ** ** *** *** ** ** ** ** ** **** *** *** ** ** **
; ** ** ** ** * ** ** ** ** ** ** ** ** ** * ** ** ** ***
; ** ** ** ** ** **** ** ** ****** ** ** ** ** **
; ** ** ** ** ** ** ** ** ** ** ** ** ** ** * **
; *** *** ** ** ** **** **** ** ** ** ** *** ***
;---------------------------------------------------------------------
; MEMOIRE
;---------------------------------------------------------------------
******* BSET
CBset move.w #L_Bset,-(sp)
bra.s BsRout
CBclr move.w #L_Bclr,-(sp)
bra.s BsRout
CBchg move.w #L_Bchg,-(sp)
bra.s BsRout
CBtst addq.l #2,a6
move.w #L_BTst,-(sp)
bra.s BsRout
******* ROR / ROL
CRorb move.w #L_BRor,-(sp)
bra.s BsRout
CRorw move.w #L_WRor,-(sp)
bra.s BsRout
CRorl move.w #L_LRor,-(sp)
bra.s BsRout
CRolb move.w #L_BRol,-(sp)
bra.s BsRout
CRolw move.w #L_WRol,-(sp)
bra.s BsRout
CRoll move.w #L_LRol,-(sp)
******* Routine: ramene l'adresse a affecter!
BsRout bsr OutLea
move.l A_Stock(a5),-(sp)
bsr Expentier
addq.l #2,a6
bsr GetWord
cmp.w #TkVar-Tk,d0
bne.s BsR3
* Une variable
BsR1 bsr StockOut
move.l a6,-(sp)
bsr VarAdr
bsr AdToA0
bsr Finie
bne.s BsR2
subq.l #2,a6
BsR0 addq.l #4,sp
bra.s BsR4
BsR2 cmp.w #TkPar2-Tk,d0
beq.s BsR0
bsr RestOut
move.l (sp)+,a6
* Une adresse
BsR3 addq.w #1,4(sp)
subq.l #2,a6
bsr Expentier
* Fin...
BsR4 move.l (sp)+,A_Stock(a5)
move.w (sp)+,d0
bra CreFonc
******* CALL
CCall bsr OutLea
move.w Cmva3msp(pc),d0
bsr OutWord
move.l a6,-(sp)
bsr StockOut
bsr Expentier
bsr RestOut
CCal0 bsr GetWord
cmp.w #TkVir-Tk,d0
bne.s CCal1
bsr Evalue
bra.s CCal0
CCal1 move.l (sp)+,d0
pea -2(a6)
move.l d0,a6
bsr Expentier
move.l (sp)+,a6
move.w #L_Call,d0
bsr CreFonc
move.w Cmvpspa3(pc),d0
bra OutWord
;---------------------------------------------------------------------
; *** *** ** ** **** **** ** ** ** ** ** *** ***
; ** ** ** *** *** ** ** ** ** ** **** *** *** ** ** **
; ** ** ** ** * ** ** ** ** ** ** ** ** ** * ** ** ** ***
; ** ** ** ** ** **** ** ** ****** ** ** ** ** **
; ** ** ** ** ** ** ** ** ** ** ** ** ** ** * **
; *** *** ** ** ** **** **** ** ** ** ** *** ***
;---------------------------------------------------------------------
; BOB/SPRITES et autres
;---------------------------------------------------------------------
******* Channel
CChannel
bsr OutLea
bsr Expentier
addq.l #2,a6
bsr GetWord
move.w #L_ChaSpr,d1
cmp.w #TkSpr-Tk,d0
beq.s CChaX
move.w #L_ChaBob,d1
cmp.w #TkBob-Tk,d0
beq.s CChaX
move.w #L_ChaScD,d1
cmp.w #TkScD-Tk,d0
beq.s CChaX
move.w #L_ChaScO,d1
cmp.w #TkScO-Tk,d0
beq.s CChaX
move.w #L_ChaScS,d1
cmp.w #TkScS-Tk,d0
beq.s CChaX
move.w #L_ChaRain,d1
CChaX move.w d1,-(sp)
bsr Expentier
move.w (sp)+,d0
bra CreFonc
;---------------------------------------------------------------------
; *** *** ** ** **** **** ** ** ** ** ** *** ***
; ** ** ** *** *** ** ** ** ** ** **** *** *** ** ** **
; ** ** ** ** * ** ** ** ** ** ** ** ** ** * ** ** ** ***
; ** ** ** ** ** **** ** ** ****** ** ** ** ** **
; ** ** ** ** ** ** ** ** ** ** ** ** ** ** * **
; *** *** ** ** ** **** **** ** ** ** ** *** ***
;---------------------------------------------------------------------
; MENUS
;---------------------------------------------------------------------
;-----> MENU$(,,)=
CMenu bsr OutLea
move.w #L_Imen1-1,-(sp)
bsr MPar
subq.l #2,a4
move.w d1,-(sp)
addq.l #2,a6
CMenL addq.w #1,2(sp)
bsr Evalue
bsr GetWord
cmp.w #TkVir-Tk,d0
beq.s CMenL
subq.l #2,a6
move.w Cmvqd7(pc),d0
move.w (sp)+,d1
move.b d1,d0
bsr OutWord
move.w (sp)+,d0
bra CreFonc
;-----> MENU DEL
CMnDel bsr OutLea
bsr GetWord
subq.l #2,a6
cmp.w #TkPar1-Tk,d0
beq.s CMnD1
move.w #L_MnDl0,d0
bra CreFonc
CMnD1 bsr MPar
move.w #L_MnDl1,d0
bra CreFonc
;-----> SET MENU
CSMenu bsr OutLea
move.l a6,-(sp)
bsr Stockout
bsr MPar
bsr Restout
addq.l #2,a6
bsr Expentier
addq.l #2,a6
bsr Expentier
move.l (sp),d0
move.l a6,(sp)
move.l d0,a6
bsr MPar
move.l (sp)+,a6
move.w #L_SMen,d0
bra CreFonc
;-----> Instruction flags
CXMenu
move.w #L_XMen,d0
bra.s GoFlag
CYMenu
move.w #L_YMen,d0
bra.s GoFlag
CmnBar
move.w #L_MnBa,d0
bra.s GoFlag
Cmnline
move.w #L_MnLi,d0
bra.s GoFlag
Cmntline
move.w #L_Mntl,d0
bra.s GoFlag
Cmnmove
move.w #L_Mnmv,d0
bra.s GoFlag
Cmnsta
move.w #L_Mnst,d0
bra.s GoFlag
Cmnimove
move.w #L_mnimv,d0
bra.s GoFlag
Cmnista
move.w #L_mnist,d0
bra.s GoFlag
Cmnact
move.w #L_Mnact,d0
bra.s GoFlag
Cmninact
move.w #L_Mnina,d0
bra.s GoFlag
Cmnsep
move.w #L_Mnsep,d0
bra.s GoFlag
CMnlink
move.w #L_Mnlnk,d0
bra.s GoFlag
CMnCall
move.w #L_MnCl,d0
bra.s GoFlag
CMnOnce
move.w #L_Mnncl,d0
;
GoFlag move.w d0,-(sp)
bsr OutLea
bsr MPar
move.w (sp)+,d0
bra CreFonc
;-----> MENU KEY
CMnKey bsr OutLea
move.l a6,-(sp)
bsr Stockout
bsr MPar
bsr GetWord
cmp.w #TkTo-Tk,d0
beq.s CMnk1
* MENU KEY (,,) seul
bsr SautOut
subq.l #2,a6
addq.l #4,sp
move.w #L_MnKey0,d0
bra CreFonc
* MENU KEY (,,) TO
Cmnk1 bsr RestOut
move.w #L_MnKey1,-(sp)
bsr Evalue
cmp.b #2,d2
beq.s Cmnk2
bsr DoEntier
move.w #L_MnKey2,(sp)
bsr GetWord
subq.l #2,a6
cmp.w #TkVir-Tk,d0
bne.s Cmnk2
move.w #L_MnKey3,(sp)
bsr FnExpentier
Cmnk2 move.l 2(sp),d0
move.l a6,2(sp)
move.l d0,a6
bsr MPar
move.w (sp)+,d0
bsr CreFonc
move.l (sp)+,a6
rts
;-----> ON MENU got/gosub/proc
Conmen bsr OutLea
bsr GetWord
moveq #-1,d1
move.w N_Proc(a5),d7
cmp.w #TkGto-Tk,d0
beq.s Com0
addq.l #1,d1
cmp.w #TkGsb-Tk,d0
beq.s Com0
addq.l #1,d1
moveq #-1,d7
Com0 move.w d1,-(sp)
clr.w -(sp)
Com1 addq.w #1,(sp)
bsr GetLabel
move.w Cmva0ma3(pc),d0
bsr OutWord
bsr GetWord
cmp.w #TkVir-Tk,d0
beq.s Com1
subq.l #2,a6
move.w Cmvqd0(pc),d0
move.b 3(sp),d0
bsr OutWord
move.w Cmvqd1(pc),d0
move.b 1(sp),d0
bsr OutWord
addq.l #4,sp
move.w #L_OnMen,d0
bra CreFonc
;-----> Prend les parametres menus
MPar bsr GetWord
cmp.w #TkPar1-Tk,d0
beq.s MPar1
; Une dimension
subq.l #2,a6
bsr Expentier
move.w Cmvqd7(pc),d0
bra OutWord
; Un objet de menu
MPar1 clr.w -(sp)
MPar2 addq.w #1,(sp)
bsr Expentier
bsr GetWord
cmp.w #TkVir-Tk,d0
beq.s MPar2
subq.l #2,a6
move.w Cmvqd7(pc),d0
move.w (sp)+,d1
move.b d1,d0
bra OutWord
;---------------------------------------------------------------------
BugCode btst #6,CiaaPra
bne.s BugCode1
illegal
BugCode1 dc.w $4321
* Endproc / Param
CdEproE move.l (a3)+,ParamE(a5)
CdEproF move.l (a3)+,ParamF(a5)
CdEproS move.l (a3)+,ParamC(a5)
CdParE move.l ParamE(a5),-(a3)
CdParF move.l ParamF(a5),-(a3)
CdParS move.l ParamC(a5),-(a3)
CJsr jsr $fffff0
CBsr bsr CBsr
CJmp jmp $fffff0
Cjmpa0 jmp (a0)
Cjsra0 jsr (a0)
CBra bra CBra
Cble ble Cble
Cbge bge Cbge
CbltS blt.s *+8
CbgtS bgt.s *+8
Cbeq beq CBeq
Cbeq8 beq.s *+8
Cbeq10 beq.s *+10
Cbeq12 beq.s *+12
Cbne bne CBne
Cbne8 bne.s *+8
Cbne10 bne.s *+10
Cbne12 bne.s *+12
CLea2a3a3 lea 2(a3),a3
Clea2a0a0 lea 2(a0),a0
Clea2a6a0 lea 2(a6),a0
Cleapca4 lea Cleapca4(pc),a4
CLeapca0 lea Cjsr(pc),a0
Cleapca1 lea Cjsr(pc),a1
Cleapca2 lea Cjsr(pc),a2
Cleaa0 lea $fffff0,a0
Cleaa1 lea $fffff0,a1
Cleaa2 lea $fffff0,a2
Cmv2a0ma3 move.l 2(a0),-(a3)
Cmv2a6Ma3 move.l 2(a6),-(a3)
Cmvpa0Ma3 move.l (a0),-(a3)
Cmva3msp move.l a3,-(sp)
Cmvpspa3 move.l (sp)+,a3
Cmva0ma3 move.l a0,-(a3)
Cmvi2a5 move.l #-1,2(a5)
Cmvd3ma3 move.l d3,-(a3)
Cmvima3 move.w #0,-(a3)
Cmvid1 move.l #0,d1
Cmvid5 move.l #0,d5
Cmviwd0 move.w #0,d0
Cmviwd1 move.w #0,d1
Cmviwd6 move.w #0,d6
Cmvqd0 moveq #0,d0
Cmvqd1 moveq #0,d1
Cmvqd2 moveq #0,d2
Cmvqd4 moveq #0,d4
Cmvqd6 moveq #0,d6
Cmvqd7 moveq #0,d7
CTsta3p tst.l (a3)+
Cillegal illegal
CRts rts
CClrma3 clr.l -(a3)
Cnop nop
;---------------------------------------------------------------------
Include "_TokTab.s"
;---------------------------------------------------------------------
; *** *** ** ** **** **** ** ** ** ** ** *** ***
; ** ** ** *** *** ** ** ** ** ** **** *** *** ** ** **
; ** ** ** ** * ** ** ** ** ** ** ** ** ** * ** ** ** ***
; ** ** ** ** ** **** ** ** ****** ** ** ** ** **
; ** ** ** ** ** ** ** ** ** ** ** ** ** ** * **
; *** *** ** ** ** **** **** ** ** ** ** *** ***
;---------------------------------------------------------------------
; Zone de donnees
;---------------------------------------------------------------------
AMOS_Save ds.l 4
Nom_Dos dc.b "dos.library",0
Nom_Graphic dc.b "graphics.library",0
Nom_IconLib dc.b "icon.library",0
Def_Liste dc.b ":AMOS_System/Compiler_Configuration",0
HeadAMOS dc.b "AMOS Basic "
SOMA dc.b "SOMA.",0
_C.AMOS dc.b "_C.AMOS",0
Mes_DError dc.b "Could not load .ENV or Compiler_Configuration file.",10,0
Mes_OOfMem dc.b "Out of memory when loading Compiler_Configuration file.",10,0
even
Nom_Spr dc.b "Sprites "
Nom_Ico dc.b "Icons "
even
Mes_Return dc.b 13,10,0
IFNE CDebug
Mes_Buffers:
dc.b "Buffer work: ",0
dc.b "Buffer relocation: ",0
dc.b "Buffer object: ",0
dc.b "Buffer flags local: ",0
dc.b "Buffer flags global: ",0
dc.b "Buffer strings: ",0
dc.b "Buffer leas: ",0
dc.b "Buffer labels: ",0
dc.b "Buffer loops: ",0
dc.b "Buffer discin: ",0
dc.b "Buffer stock: ",0
dc.b 0
Mes_Bufs2 dc.b " / ",0
Mes_Bufs3 dc.b " - Free: ",0
ENDC
even
RsReset
Nom_Source rs.b 108
Nom_Objet rs.b 108
Nom_Liste rs.b 108
Nom_From rs.b 108
Nom_Messages rs.b 108
C_Pile rs.l 1
Flag_Source rs.w 1
Flag_Objet rs.w 1
Flag_AMOS rs.w 1
Flag_Errors rs.w 1
Flag_Default rs.w 1
Flag_Type rs.w 1
Flag_WB rs.w 1
Flag_Quiet rs.w 1
Flag_NoTests rs.w 1
Flag_Flash rs.w 1
PrintJSR rs.l 1
C_GfxBase rs.l 1
C_DosBase rs.l 1
C_IconBase rs.l 1
C_Icon rs.l 1
AMOS_Dz rs.l 1
OldRel rs.l 1
DebRel rs.l 1
Sa3 rs.l 1
Sa4 rs.l 1
SOldRel rs.l 1
A_Chaines rs.l 1
A_Bcles rs.l 1
A_Lea rs.l 1
A_Proc rs.l 1
N_Bcles rs.w 1
N_Proc rs.w 1
Flag_Const rs.w 1
Flag_Labels rs.w 1
Flag_Procs rs.w 1
OFlag_Labels rs.w 1
OFlag_Procs rs.w 1
Flag_Long rs.w 1
Flag_Val rs.w 1
Flag_Math rs.w 1
AdAdress rs.l 1
AdAdAdress rs.l 1
F_Proc rs.l 1
A_FlagVarL rs.l 1
L_Buf rs.l 1
P_Source rs.l 1
A_Banks rs.l 1
A_InitMath rs.l 1
A_Dfn rs.l 1
N_Dfn rs.w 1
A_Datas rs.l 1
A_ADatas rs.l 1
A_EDatas rs.l 1
A_JDatas rs.l 1
A_Stock rs.l 1
AA_Proc rs.l 1
AA_EProc rs.l 1
AA_SBuf rs.l 1
AA_Reloc rs.l 1
AA_Long rs.l 1
MaxMem rs.l 1
Pour_Cpt rs.w 1
Pour_Base rs.w 1
Pour_Pos rs.w 1
L_Reloc rs.w 1
M_ForNext rs.w 1
MM_ForNext rs.w 1
NbInstr rs.w 1
IconAMOS rs.w 1
* Source
L_Source rs.l 1
NL_Source rs.w 1
DebBso rs.l 1
FinBso rs.l 1
MaxBso rs.l 1
BordBso rs.l 1
TopSou rs.l 1
L_Bso rs.l 1
* Objet
L_Objet rs.l 1
DebBob rs.l 1
FinBob rs.l 1
MaxBob rs.l 1
TopOb rs.l 1
BordBob rs.l 1
BB_Objet_Base rs.l 1
BB_Objet rs.l 1
L_Bob rs.l 1
* Banques
N_Banks rs.w 1
* Disque
L_DiscIn rs.l 1
T_Handles rs.l M_Fichiers
P_Clib rs.l 1
T_Clib rs.l 1
MaxClibs rs.w 1
* Table des hunks
T_Hunks rs.l 24*2
* Buffers reserves
InBuf rs.l 1
InBufs rs.l 1
D_Buffers equ __Rs
B_Noms rs.l 1
B_Pointeurs rs.l 1
B_Work rs.l 1
B_Reloc rs.l 1
B_Objet rs.l 1
B_FlagVarL rs.l 1
B_FlagVarG rs.l 1
B_Chaines rs.l 1
B_Lea rs.l 1
B_Labels rs.l 1
B_Bcles rs.l 1
B_DiskIn rs.l 1
B_Stock rs.l 1
B_Source rs.l 1
BufLibs rs.l M_Libs
BufToks rs.l M_Libs
F_Buffers equ __Rs
LDZ equ __Rs
even
DZ ds.b LDZ
even
Reference in New Issue Copy Permalink