dnl (c)INRIA,ROBOSOFT 1999 Christophe.Lavarenne@inria.fr, pierre@robosoft.fr dnl $Id: 555.m4x,v 1.6 1999/11/18 15:30:58 lavarenn Exp $ divert(-1) # SynDEx v5.1 generic executive kernel, adapted for mpc555. ifdef(`syndex.m4x_already_included',,`errprint( __file__:__line__: m4: syndex.m4x must be included before __file__! )m4exit(1)') ifdef( __file__`_already_included',`error_(`already included')', `define(__file__`_already_included')') # ---------------------------------------------------------------------------- # This file defines all TARGET LANGUAGE DEPENDENT macros (prefixed by `basic') # which customize the generic executive macros defined in the syndex.m4x file. # SynDEx generates for each processor one macro-executive file starting with a # `processor_' macro taking as argument the processor type, which is stored in # the `processorType_' macro, and used to include the processorType_.m4x file. # Application specific macros may be conditionned by `processorType_'=`555' # to generate different codes for different target processor types; # they may also be conditionned by `lang_' which may be defined # identically by different processorType_.m4x files: define(`lang_',`asm555') ############################# # MPC555 registers definition # WARNING: General Purpose Registers are defined in lowercase only # to simplify the following definition of the `MB' macro. # These definitions are inserted at the very beginning of the generated file, # undiverted by the `processor_' macro after generating file header comments: divert(1) /*------- General Purpose Registers -------*/ sp=1; SP=1; /* stack pointer */ r0=0; r1=1; r2=2; r3=3; r4=4; r5=5; r6=6; r7=7; r8=8; r9=9; r10=10; r11=11; r12=12; r13=13; r14=14; r15=15; r16=16; r17=17; r18=18; r19=19; r20=20; r21=21; r22=22; r23=23; r24=24; r25=25; r26=26; r27=27; r28=28; r29=29; r30=30; r31=31; /*------- Floating Point Registers -------*/ fr0=0; fr1=1; fr2=2; fr3=3; fr4=4; fr5=5; fr6=6; fr7=7; fr8=8; fr9=9; fr10=10; fr11=11; fr12=12; fr13=13; fr14=14; fr15=15; fr16=16; fr17=17; fr18=18; fr19=19; fr20=20; fr21=21; fr22=22; fr23=23; fr24=24; fr25=25; fr26=26; fr27=27; fr28=28; fr29=29; fr30=30; fr31=31; /*------- User-Level Special Purpose Registers -------*/ XER=1; LR=8; CTR=9; TBUR=268; TBLR=269; xer=1; lr=8; ctr=9; tbur=268; tblr=269; /*------- Supervisor-Level Special Purpose Registers -------*/ DSISR=18; DAR=19; DEC=22; SRR0=26; SRR1=27; EIE=80; EID=81; NRI=82; dsisr=18; dar=19; dec=22; srr0=26; srr1=27; eie=80; eid=81; nri=82; SPRG0=272; SPRG1=273; SPRG2=274; SPRG3=275; TBUW=284; TBLW=285; PVR=287; sprg0=272; sprg1=273; sprg2=274; sprg3=275; tbuw=284; tblw=285; pvr=287; ICCST=560; ICADR=561; ICDAT=562; FPECR=1022; iccst=560; icadr=561; icdat=562; fpecr=1022; /*------- Development-Support Special Purpose Registers -------*/ CMPA=144; CMPB=145; CMPC=146; CMPD=147; ECR=148; DER=149; cmpa=144; cmpb=145; cmpc=146; cmpd=147; ecr=148; der=149; COUNTA=150; COUNTB=151; CMPE=152; CMPF=153; CMPG=154; CMPH=155; counta=150; countb=151; cmpe=152; cmpf=153; cmpg=154; cmph=155; LCTRL1=156; LCTRL2=157; ICTRL=158; BAR=159; DPDR=630; lctrl1=156; lctrl2=157; ictrl=158; bar=159; dpdr=630; /*------- Peripherals Addresses -------*/ SIUMCR = 0x002FC000 # SIU Module Configuration Register (UM555 6.13.1.1) SYPCR = 0x002FC004 # System Protection Control Register (UM555 6.13.3.1) #SIPEND = 0x002FC010 # SIU Interrupt Pending (UM555 6.13.2.1) SIMASK = 0x002FC014 # SIU Mask (UM555 6.13.2.2) #SIEL = 0x002FC018 # Level and edge for external IRQ lines SIVEC = 0x002FC01C # Vector(level) when an interrupt occurs p6-26 EMCR = 0x002FC030 # External Master Control Register (see UM555 6.13.1.3) PDMCR = 0x002FC03C # Pad Module Configuration Register (see UM555 2.4.2) BR1 = 0x002FC108 # Memory Controller Base Register 1 (see UM555 10.8.3) OR1 = 0x002FC10C # Memory Controller Option Register 1 (see UM555 10.8.4) TBSCR = 0x002FC200 # Time Base Control and Status Reg. (see UM555 6.13.4.4) PISCR = 0x002FC240 # Periodic Interrupt Status and Ctrl Reg.(UM555 6.13.4.8) PITC = 0x002FC244 # Periodic Interrupt Timer Count Register (UM555 6.13.4.9) #PITR = 0x002FC248 # Periodic Interrupt Timer Register (see UM555 6.13.4.10) PLPRCR = 0x002FC284 # PLL, Low-Power, and Reset-Control Register (UM555 8.12.2) UMCR = 0x00307F80 # UIMB Module Configuration Register (see UM555 12.5.1) dnl Set32 0x2F,0xC03C, 0xF200,0x0000 # PDMCR: see table 2-3 dnl Set32 0x2F,0xC284, 0x0090,0x0000 # PLPRCR: see table 8-10 divert(-1)# End of insertion at the beginning of the generated file ################################## # Notes about PPC addressing modes (from asse4.htm file included in Diab Data # PPC HTML documentation) # Unary Operator | Description # ===============+============================================================= # expr@h | The most significant 16 bits of expr are extracted. # ---------------+------------------------------------------------------------- # expr@ha | The most significant 16 bits of expr are extracted and # | adjusted for the sign of the least significant 16 bits # | of expr. # ---------------+------------------------------------------------------------- # expr@l | The least significant 16 bits of expr are extracted. # ---------------+------------------------------------------------------------- # expr@sdarx | The 16 bit offset of expr from the SDA base register is # | calculated. The produced relocation will cause the linker # | to modify the destination register field in the instruction. # ---------------+------------------------------------------------------------- # expr@sdax | The 16 bit offset of expr from the SDA base register is # | calculated. ############################### # MPC555 direct addressing mode # Define the MB (Memory Big) macro to use more than 64K data (.data+.bss) # (command line: `m4 -DMB ...', or `define(`MB')' in your appli.m4x file). # Let MB undefined if you are sure that you will not use more than 64K data. # All mpc555 instructions are 32 bits long, some with 16 bits embedded literal, # which means that 32 bits literals, including direct addresses, must be split # among two instructions, a first "lis rA,value@h" to load the 16 high bits in # the rA register, then either an "ori rA,value@l" for the 16 low bits of a # literal, or a "ld/st rD,value@l(rA)" for the 16 low bits of a memory access # using the "register indirect with immediate index" addressing mode. # When the amount of data is less than 64K, a register may be dedicated to hold # the base address of all data, and the 16 bits offset from this base requires # a single instruction using "register indirect (base) with immediate index # (offset)" addressing. The default "-mdata-sysv" gcc compiler option requires # r13 to be dedicated to hold the base address of all data. # The `B' macro will translate its instruction argument into different memory # access instructions depending on the `MB' (Memory Big) macro being defined. # If `MB' is defined as an empty string, `B' generates 2 instructions: # `B(ld/st rX,var)' --> `lis r13,var@ha ; ld/st rX,var@l(r13)' # Otherwise `B' generates only the second instruction, ASSUMING THAT ALL DATA # SECTIONS ARE CONTIGUOUS (see the 555.ld file), THAT THEIR TOTAL SIZE IS NO # MORE THAN 64K, AND THAT r13 POINTS ON THE BASE OF ALL DATA SECTIONS. # The `_B' macro will always generate only the second instruction, whatever MB; # it is useful after a `B' macro accessing the same memory address, to avoid # the useless repetition of the `lis r13,var@ha' first instruction; example: # `B(lwz r0,var); addi r0,1; _B(stw r0,var)' will generate: # `lis r13,var@ha; lwz r0,var@l(r13); addi r0,1; stw r0,var@l(r13)' # ---------------------- # B(instr) and _B(instr) define(`B', `patsubst(`$*',`\(.*\),\(.*\)', `ifelse(MB,,`lis r13,(\2)@ha; ')\1,(\2)@l(r13)')') define(`_B',`pushdef(`MB',-)B(`$*')popdef(`MB')') ########## # COMMENTS # comment{Comments with {balanced} curly braces}comment # Assembler-style till-end-of-line comments: # The TARGET LANGUAGE DEPENDENT start-comment character (# for As) is given # as 3rd argument of the patsubst macro in the following definition: #define(`comment_',`changequote({,})patsubst({{$1}},{^},{# })changequote') # default C-style multi-line comments are ok with GNU as ############ # DATA TYPES # -------- # typedef_(name, size) defines a new type with its size in address units: # The TMS320C40 does not distinguish the float and double types. typedef_(`bool', 1) # MUST be defined typedef_(`char', 1) # SHOULD be defined typedef_(`int', 4) # SHOULD be defined typedef_(`float', 4) # SHOULD be defined typedef_(`double', 8) # SHOULD be defined ################### # MEMORY ALLOCATION # Data buffers for temporary signals, delays, windows and constants, # are located in the uninitialized .bss section (or in another unitialized # section named "syndexN", N being the "memBank" last optional macro argument) # and are referenced by the symbolic "label" given to the macros. # ----------- # basicAlloc_(label, memoryBank) # Only one memory bank on mpc555, allocated in multiples of 4 bytes # to keep addresses aligned to fasten memory accesses define(`basicAlloc_', `_(.lcomm $1,eval($1_size_*$1_type_()_size_+3&~3),4)') # ----------- # basicAlias_(newLabel,oldLabel[,offset=0]) # Makes an equivalence between newLabel and oldLabel+charOffset define(`basicAlias_', `_($1 = ifelse($3,,`$2',`($2+$3*$2_type_()_size_)'))') ################## # MEMORY TRANSFERS # ---------- # basicCopy_(destLabel,srceLabel,size) define(`basicCopy_', `pushdef(`size_',`eval($3*$2_type_()_size_)')dnl ifelse(dnl copy memory range. size_,1, `_(B(lbz r0,$2); _B(stb r0,$1))', dnl copy one byte. size_,2, `_(B(lhz r0,$2); _B(sth r0,$1))', dnl copy one halfword. size_,4, `_(B(lwz r0,$2); _B(stw r0,$1))', dnl copy one word. dnl copy several: eval(size_&1),1, `_(B(la r3,$1-1); B(la r4,$2-1); li r0,size_; mtspr CTR,r0)dnl _(0: lbzu r5,1(r4); stbu r5,1(r3); bdnz 0b)', dnl bytes. eval(size_&3),2, `_(B(la r3,$1-2); B(la r4,$2-2); li r0,size_/2; mtspr CTR,r0)dnl _(0: lhzu r5,2(r4); sthu r5,2(r3); bdnz 0b)', dnl halfwords. `_(B(la r3,$1-4); B(la r4,$2-4); li r0,size_/4; mtspr CTR,r0)dnl _(0: lwzu r5,4(r4); stwu r5,4(r3); bdnz 0b)' dnl words. )popdef(`size_')') #################### # CONTROL STRUCTURES # -------- # basicIf_(bool, tagforElseOrEndif) define(`basicIf_', `_(B(lbz r0,$1); cmpwi r0,0; beq Forward_$2)') # ----------- # basicIfnot_(bool, tagForElseOrEndif) define(`basicIfnot_',`_(B(lbz r0,$1); cmpwi r0,0; bne Forward_$2)') # ---------- # basicElse_(tagFromIf, tagForEndif) define(`basicElse_', `_(b Forward_$2)_(Forward_$1:)') # ----------- # basicEndif_(tagFromIfOrElse) define(`basicEndif_', `_(Forward_$1:)') # ---------- # basicLoop_(tagForEndloop) define(`basicLoop_', `ifdef(`NBITERATIONS', `dnl _(b Forward_$1 `# fixed number of iterations')dnl _(.data; Iterator_$1: .int NBITERATIONS `# iterations counter')dnl _(.text; Backward_$1: _B(stw r31,Iterator_$1))', `dnl _(Backward_$1:)')') # ------------- # basicEndloop_(tagFromLoop) define(`basicEndloop_', `ifdef(`NBITERATIONS', `dnl _(Forward_$1: `# fixed number of iterations')dnl _(B(lwz r31,Iterator_$1); subic. r31,r31,1; bge Backward_$1)', `dnl _(b Backward_$1 `# infinite loop')')') ############### # SYNCHRONIZERS # To synchronize main (priority=0) and communication sequences (priority=1). # semaphores_(...) ; allocate and initialize named semaphores n/0 def(`semaphores_', `number_($*) .lcomm sem_,$# `# each semaphore is one byte initially null'') define(`number_',`ifelse($1,,,`_($1=decr($#))`'number_(shift($*))')') # Pre0_(s) ; priority 1->0 precedence # PP: WARNING!!! In the Pre0_ definition the following line was responsible for a CRASH!!! # _(li r0,1; B(stb r0,sem_+$1) `# set semaphore $1')') # r0 should not be used here!!! it modifies the r0 which saves MSR state!!! # Let us use r31 instead which is totally free... def(`Pre0_', `dnl _(li r31,1; B(stb r31,sem_+$1) `# set semaphore $1')') # Suc0_(s) ; priority 0<-1 precedence def(`Suc0_', `dnl _(0: B(lbz r0,sem_+$1); cmpwi r0,0 `# test semaphore $1:')dnl _(beq 0b `# until set by Pre0_($1) on interrupt;')dnl _(li r0,0; _B(stb r0,sem_+$1) `# reset it.')') # Pre1_(s) ; priority 0->1 or 1->1 precedence # Note: Pre1_ disables interrupts when switching from main computation sequence # to communication sequence, and enables interrupts when switching back, # exactly the same way as hardware interrupts automatically do. # Note: r0, which saves MSR state, must not be used in communication sequence. def(`Pre1_', `ifdef(`inMain_',`dnl `Pre1_' between `main_' and `endmain_' _(mfmsr r0 `# save current MSR into r0 (bits 0:15 are already null)')dnl _(andi. r31,r0,0x7FFF `# clear bit16(EE) = disable external interrupts')dnl _(mtmsr r31 `# the following instructions are uninterruptible:')')dnl _(bl Suc_$1_ `# label Suc_$1_ defined by Suc1_($1)')dnl ifdef(`inMain_', `dnl `Pre1_' between `main_' and `endmain_' _(mtmsr r0 `# restore saved MSR (end of uninterruptible section)')dnl ')') # Suc1_(s) ; priority 1<-0 or 1<-1 precedence def(`Suc1_', `_(Suc_$1_: `# label CALLed by Pre1_($1)')dnl _(B(lbz r31,sem_+$1); xori r31,r31,1; _B(stb r31,sem_+$1) `# change semaphore $1')dnl _(cmpwi r31,0; bnelr `# if first pass, return')') ############### # MAIN sequence # ---------- # basicMain_() # calls `main_ini_' if defined to add application specific initializations define(`basicMain_', `dnl _(start: .global start `# linker default entry, called by bootloader')dnl indent_(+)dnl _(lis sp,__SP_INIT@ha; addi sp,sp,__SP_INIT@l `# init stack pointer')dnl _(lis r13,__SDATA_START@ha `# init base data page')dnl dnl WARNING: r13 required by default -mdata-sysv compilOpt, see also `MB' macro _(li r0,0; stwu r0,-64(sp) `# terminate stack, see regular crt0.s')dnl _(mflr r0; stw r0,36(sp) `# save return address to bootloader')dnl _(li r0,0xFFFFA042; andi. r0,r0,0xFFFF `# load MSR setting and keep only 16 low bits')dnl _(mtmsr r0 `# set EE FP IP RI, see 555UM p3-20')dnl _(`# disable software watchdog (see 555 UM 6.13.3.1)')dnl _(`# PP,TN: WARNING !!! default SYPCR setting can cause system reset')dnl _(`# PP: now done in bootloader')dnl _(`# li r30,0; lis r31,SYPCR@ha; stw r30,SYPCR@l(r31)')dnl _(`# setup ICRTL as in Robosoft crt0.s:')dnl _(li r0,7; mtictrl r0 `# see 555UM p21-47')dnl _(`# clear uninitialized data:')dnl _(lis r0,__BSS_SIZE@ha; addic. r0,r0,__BSS_SIZE@l `# test __BSS_SIZE=0')dnl _(beq 1f `# may only happen for manually written test applications')dnl _(mtctr r0; B(la r3,__BSS_START-4); li r0,0)dnl _(0: stwu r0,4(r3); bdnz 0b `# clear all uninitialized data')dnl _(1:)pushdef(`inMain_')dnl `inMain_' is for `Pre1_' _(`# -------------------------------------------------------------')dnl _(`# PIT (Periodic Interrupt Timer) initialization (see UM555 6.9)')dnl define(`IRQlevelPIT',0)dnl _(`# PIT Period = (PITC+1) / (External Clock / pre-divider)')dnl _(`#')dnl _(`# PP: In our case (see UM555 Table 8-1),hardware sets MODCK[1:3] to 010,')dnl _(`# corresponding to a 4MHz External Clock and a 256 pre-divider.')dnl _(`# Thus, we have PIT Period = (PITC+1) / 15625. This gives a range')dnl _(`# from 64us (with PITC=0x0000) to 4.19s (with PITC=0xFFFF).')dnl _(ifdef(`PITCOUNTER',,`define(`PITCOUNTER',15)'))dnl PIT Period = 1.024ms by default if not redefined by user. _(`# Set PIT Count')dnl _(li r0,PITCOUNTER; lis r31,PITC@ha; sth r0,PITC@l(r31))dnl _(`# - init PISCR (see UM555 6.13.4.8)')dnl _(`# bit15=1: PTE=(0/1) (stop/continue) counting')dnl _(`# bit13=1: PIE=(0/1) (dis/en)able PIT interrupt')dnl _(`# bit0-7: PIRQ determine the IRQ level of the PIT ')dnl _(`# (level 'IRQlevelPIT` correspond to bit'IRQlevelPIT`=1 and others set to 0)')dnl _(`li r0,0x'ifelse(IRQlevelPIT,0,`FFFF')`'eval(0x80>>IRQlevelPIT,16,2)`05; lis r31,PISCR@ha; sth r0,PISCR@l(r31)')dnl _(`# - install the PIT interrupt handler vector')dnl _(lis r0,PIT_it_@h; ori r0,r0,PIT_it_@l; `# handler entry point')dnl _(lis r31,SIVECtableLEVEL`'IRQlevelPIT@ha; stw r0,SIVECtableLEVEL`'IRQlevelPIT@l(r31))dnl _(`# - enable the corresponding internal interrupt setting SIMASK')dnl _(lis r31,SIMASK@ha; lwz r0,SIMASK@l(r31))dnl _(oris r0,r0,0x`'eval(0x4000>>(2*IRQlevelPIT),16,4); stw r0,SIMASK@l(r31); `# enable level 'IRQlevelPIT for PIT)dnl _(`# -------- END OF PIT INITIALIZATION --------------------------') ifdef(`main_ini_',`main_ini_()')dnl for application specific global init indent_(-)') # This is the prologue code of a separately compiled C function: # _(stwu r1,-32(r1); mflr r0; stw r31,28(r1); stw r0,36(r1); mr r31,r1)dnl # It uses r1 as stack pointer, r0 as scratch, and allocates 32 bytes of stack. # ------------- # basicEndmain_() define(`ITinput', 11) define(`ITcomput',12) define(`IToutput',13) define(`basicEndmain_', `popdef(`inMain_')dnl `inMain_' for `Pre1_' # ------------------------------------------------------------- # - reset PISCR (see UM555 6.13.4.8) # bit15=0: stop counting bit13=0: disable PIT interrupt li r0,0x0`'IRQlevelPIT`'00; lis r31,PISCR@ha; sth r0,PISCR@l(r31) # -------- END OF PIT FINALIZATION ---------------------------- lwz r0,36(sp); mtlr r0; addi sp,sp,64 # restore initial stack state blr # return to bootloader # ------------ end of main ---------------- # ------------------------------------------------------------- PIT_it_: # PIT interrupt handler (called by SIU interrupts handler) # Acknoledge interrupt by negating PS (PISCR bit8). # Refer to UM555 6.9 paragraph 3 for more information. lis r31,PISCR@ha; lhz r30,PISCR@l(r31); ori r30,r30,0x0080; sth r30,PISCR@l(r31) # -- inputs -------- undivert(ITinput) # -- computations -- undivert(ITcomput) # -- outputs ------- undivert(IToutput) b IThandlerEnd #################################################################### #################################################################### # # GESTION INTERRUPTIONS POUR ULTRA SON # #################################################################### .section .ithandler # SIU interrupts handler # This section is located at address 0xFFF00500 (see 555.ld linker script) # because the MSR.IP bit is set (see first instructions after start label) # This section must be less than 256 bytes = 64 instructions long, # because the next interrupt handler is located 256 bytes after. # allocate stack to save processor context: ASSUMES R1 ALWAYS USED AS SP!!! subi sp,sp,(5+30)*4 # 0:SRR0, 4:SRR1, 8:CR, 12:LR, 16:r0, 20:r2-31 (r1=sp) # save processor context (SRR0/SRR1 needed only if int is interruptible): stmw r2,20(sp); stw r0,16(sp) # it may be possible to save less registers... mflr r31; mfcr r30; mfsrr1 r29; mfsrr0 r28; stmw r28,0(sp) lis r13,__SDATA_START@ha # init base data page, in case user code changed it # get the SIU interrupt vector: lis r31,SIVEC@ha; lbz r30,SIVEC@l(r31) # r30=interrupt vector # andi. r30,r30,0x3C # not needed, see 6.4.1 555UM lis r31,SIVECtable@h; ori r31,r31,SIVECtable@l lwzx r30,r30,r31 # r30=IRQHandler entry address mtlr r30; blrl # call IRQHandler, with LR=returnAddress # The called interrupt sub-handlers may return here, # either by a "blr" or by a "b IThandlerEnd" IThandlerEnd: # on return from call, restore saved context: lmw r28,0(sp); mtsrr0 r28; mtsrr1 r29; mtcr r30; mtlr r31 lwz r0,16(sp); lmw r2,20(sp) # deallocate stack and return from interrupt: addi sp,sp,(5+30)*4 # see above rfi .text SIVECtable: # "IRQ" are external, "LEVEL" are internal SIVECtableIRQ0: .long DefaultIRQHandler # 0=HighestInterruptPriority SIVECtableLEVEL0: .long DefaultIRQHandler # 1 SIVECtableIRQ1: .long DefaultIRQHandler # 2 SIVECtableLEVEL1: .long DefaultIRQHandler # 3 SIVECtableIRQ2: .long DefaultIRQHandler # 4 # Interruption entrainee par l echo des capteurs ultra son SIVECtableLEVEL2: .long InterruptHandler2 # 5 #SIVECtableLEVEL2: .long DefaultIRQHandler # 5 SIVECtableIRQ3: .long DefaultIRQHandler # 6 SIVECtableLEVEL3: .long DefaultIRQHandler # 7 SIVECtableIRQ4: .long DefaultIRQHandler # 8 SIVECtableLEVEL4: .long DefaultIRQHandler # 9 SIVECtableIRQ5: .long DefaultIRQHandler # 10 SIVECtableLEVEL5: .long DefaultIRQHandler # 11 SIVECtableIRQ6: .long DefaultIRQHandler # 12 SIVECtableLEVEL6: .long DefaultIRQHandler # 13 SIVECtableIRQ7: .long DefaultIRQHandler # 14 # Interruption du PWM1 SIVECtableLEVEL7: .long InterruptHandler7 # 15=LowestInterruptPriority ################################### # Interruption du TPU ################################### InterruptHandler2 : UltraDistInt # Disable Interruption ReadEtatCap UltraRead3 # Lit la distance sur le capteur Ultra Son 4 addis r30,r31,0x0030 # Met la valeur dans un registre ori r30,r30,0x609A sth r27,0x0(r30) TPUInitUltra # Enable Interruption # Entraine le blocage du programme b IThandlerEnd ################################### # Interruption du PWM1 ################################## InterruptHandler7 : PWMDisInt # Disable Interruption li r31,0x0 addis r30,r31,0x0030 ori r30,r30,0x600E lhz r29,0x0(r30) # Read A_MPWMSM srawi r29,r29,0xF # Differencie les cas ou l interruption est due a un passage du PWM de 0 a 1 cmpwi r29,0x0 # ou de 1 a 0 beq pwm0 # addis r30,r31,0x0030 # Ne sert qu au test pour voir les valeurs qui ont entraine l interruption # ori r30,r30,0x609A # Met une valeur dans un registre que le root affichera avec la fonction DISPLAY # li r29,0x1 # sth r29,0x0(r30) TPU3Init # Initialisation du TPU : Le compteur demarre PWMEnInt # Enable Interruption # Entraine le blocage du programme b IThandlerEnd # return to .ithandler pwm0 : TPUStop # Arret du TPU et Reset # addis r30,r31,0x0030 # Ne sert qu au test pour voir les valeurs qui ont entraine l interruption # ori r30,r30,0x609A # Met une valeur dans un registre que le root affichera avec la fonction DISPLAY # li r29,0x0 # sth r29,0x0(r30) PWMEnInt # Enable Interruption # Entraine le blocage du programme b IThandlerEnd # return to .ithandler DefaultIRQHandler: blr # return to .ithandler .section .fpu # FPU exception handler # ".org 0xFFF00800" done in 555.ld linker script # This section must be less than 256 bytes = 64 instructions long, # because the next interrupt handler is located 256 bytes after. mtsprg0 r0; mfmsr r0 ori r0,r0,0x2002 # ref??? in 555UM mtmsr r0; mfsprg0 r0 rfi .section .dec # DEC exception handler # ".org 0xFFF00900" done in 555.ld linker script # This section must be less than 256 bytes = 64 instructions long, # because the next interrupt handler is located 256 bytes after. rfi ') # ------------------------ # spawn_thread_(mediaName) ; spawn the pseudo-parallel execution of a com.seq. def(`spawn_thread_', `dnl _(bl thread_$1_ `# label defined by thread_($1)')') # ----------------------- # basicThread_(mediaName) define(`basicThread_', `dnl _(thread_$1_: `# --------- start of Media $1 thread ----------')') # -------------------------- # basicEndthread_(mediaName) # PP: WARNING!!! As in the Pre0_ definition the following line was responsible for a CRASH!!! # _(li r0,1; B(stb r0,$1_empty_) `# set semaphore $1_empty_')dnl # r0 should not be used here!!! it modifies the r0 which saves MSR state!!! # Let us use r31 instead which is totally free... define(`basicEndthread_', `dnl _(.lcomm $1_empty_,4)dnl _(li r31,1; B(stb r31,$1_empty_) `# set semaphore $1_empty_')dnl _(blr `# return after CALL of `Pre1_' or of comINTshared_')dnl _(`# ------------- end of Media $1 thread ----------------')') # -------------------------- # wait_endthread_(mediaName) ; wait for com.seq. thread to terminate def(`wait_endthread_', `dnl _(0: B(lbz r0,$1_empty_) `# test semaphore $1_empty_:')dnl _(cmpwi r0,0; beq 0b `# until set by endthread on interrupt;')') ifelse(` ******ICI ###################### # CHRONOMETRIC LOGGING dnl GetTime_() ; read the PC real-time clock define(`GetTime_', `# Read PC timer, result in EAX: xorl %eax,%eax # clear MSW outb %al,`$'0x43 inb `$'0x40,%al # Read timer LSB value movb %al,%ah inb `$'0x40,%al # Read timer MSB value xchgb %al,%ah negw %ax # timer is decrementing') define(`GetTime_', `# Read PC timer@1,193,180 ticks/sec, result in EDX:EAX call _uclock # this takes about 155E-7 sec on a Pentium@100MHz') define(`CvtTime_', `# PC ticks at 1.19318 MHz, C40 ticks at 10 MHz movl `$'10000000,%ebx ; mull %ebx movl `$'1193180,%ebx ; divl %ebx') dnl Chronos_(size) ; size=number of (label,date) records def(`Chronos_', ` .data Chrono__: # chronometric (label,date) records buffer .int Chrono_base_ # current-record pointer, initialized Chrono_base_: # buffer base address .fill $1,2+4,0 # buffer body, all labels null Chrono_limit_: # buffer end address .int 0 # temp for `Chrono_store_' .text ChronoLap__: # AX= label movl Chrono__,%edi # EDI= current chrono record address stosw # store label GetTime_() # EAX= date (current time) stosl # store date cmpl `$'Chrono_limit_,%edi jnz 0f # if end of Chrono_limit_ reached: movl `$'Chrono_base_,%edi # wrap pointer to Chrono_base_ 0: movl %edi,Chrono__ # store back next record address ret') # ChronoLap_(label) def(`ChronoLap_', `dnl _(movw `$'$1,%ax)dnl _(call ChronoLap__)') # Chrono_() is there anything to initialize on 386? def(`Chrono_ini_', `pushtag(`Chrono') # first call takes care of initializations: GetTime_') # endChrono_() def(`endChrono_', `poptag(`Chrono') ifdef(`ChronoMulti', ` IOB=0x200 # TDMB410 motherboard I/O ports base address RXSTAT=IOB+0x02 # RO byte, 0=empty, otherwise 0FFh TXSTAT=IOB+0x03 # RO byte, 0=full, otherwise 0FFh RXDATA=IOB+0x10 # RO word, may be read when RXSTAT!=0 TXDATA=IOB+0x12 # WO word, may be written when TXSTAT!=0 #**** set offset from descendant to local time movw `$'TXDATA,%dx # send ready signal to C40 movw `$'(1193180 & 0xFFFF),%ax outw %ax,%dx movw `$'(1193180 >> 16),%ax outw %ax,%dx call Lgetd_ # wait for dated ping from C40 movl %eax,%ebx # EBX= C40 ping date(lo) GetTime_() # EAX= PC timer date when ping received CvtTime_() # convert into tenth of microseconds subl %eax,%ebx # EBX= dated pong = C40ping-PCtimer movw `$'TXDATA,%dx movl %ebx,%eax # return dated pong to C40 outw %ax,%dx # bits0-15 shrl `$'16,%eax outw %ax,%dx # bits16-31') #**** dump oldest part from current to Chrono_limit_ movl Chrono__,%esi # ESI= oldest record pointer cmpw `$'0,(%esi) # label non-null if pointer wrapped jz 1f # null if buffer not full of records 0:call Chrono_store_ # (see Chrono_store_ hereunder) cmpl `$'Chrono_limit_,%esi jnz 0b #**** dump newest part from Chrono_base_ to current 1:movl `$'Chrono_base_,%esi 2:cmpl Chrono__,%esi jz Ldescendants_ call Chrono_store_ # (see Chrono_store_ hereunder) jmp 2b #**** subroutines Chrono_store_ and Chrono_dstore_ Chrono_store_: # ESI+=4, use EAX,ECX xorl %eax,%eax lodsw # ESI=(label,date) record pointer movl %eax,%ecx # ECX=label lodsl # EAX=date CvtTime_() # convert into tenth of microseconds Chrono_dstore_: # EAX=date ECX=label xchgl Chrono_limit_,%eax negl %eax addl Chrono_limit_,%eax # time elapsed since last record pushl %eax pushl Chrono_limit_ pushl %ecx define(`args_', 3) printf_(`%6d %9d %9d') ret ifdef(`ChronoMulti', ` #**** subroutine Lgetd_ Lgetd_: # wait for data word from C40, use DX, return EAX call_args_(`kbhit') #allow loop exit with control-break movw `$'RXSTAT,%dx inb %dx,%al orb %al,%al jz Lgetd_ # until RX non empty movw `$'RXDATA,%dx xorl %eax,%eax inw %dx,%ax # bits0-15 movl %eax,%ebx inw %dx,%ax # bits16-31 shll `$'16,%eax orl %ebx,%eax ret #**** forward descendant dumps Ldescendants_: call Lgetd_ # wait for EAX=label from C40 movl %eax,%ecx # ECX=label jecxz 3f # until null label = end of dump pushl %ecx call Lgetd_ # EAX=date popl %ecx call Chrono_dstore_ jmp Ldescendants_ 3:', ` Ldescendants_: xorl %ecx,%ecx') call Chrono_dstore_ # last chrono labelled zero') ******JUSQUICI') ################## # Subroutine calls # For interfacing separately compiled C functions. # ------ # For the mpc555, the first parameters are passed directly in the registers, # the remaining parameters are passed in the stack. # Integer registers r0, (not r1, not r2), r3, r4 ... r10 are allocated in this # order for unsigned or signed integers (char, short, int) and for addresses. # Floating point registers fr0, fr1 ... fr10 are allocated in this order for # single and double precision reals (float, double). # The stack is growing downwards, and is allocated by chunks of 32 bytes. # Stack offsets are aligned by 4 for integer parameters, and by 8 for reals. # WARNING: in the present implementation, only register passing is supported, # a `too many arguments' error is generated if registers allocation is over. # The `return' result is passed back in r3 if integer, or in fr0 if real. # ------ # Cdecl_ generates the declaration of an separately C compiled function: # $1: return # $2: C function name (without the underscore prefix added by the assembler) # $n>2: argument (with `*' if passed by address) # Example m4 declaration: # Cdecl_(int,my_fun,int,int*,float) # | .global _my_fun ; int my_fun(int, int*, float); def(`Cdecl_', `dnl _(`.global _$2 # $1 $2('shift(shift($*))`);')') # ------ # Ccall_ mimics the ANSI C declaration of a separately compiled function: # $1: return and