]> rtime.felk.cvut.cz Git - fpga/rpi-motor-control.git/blob - pmsm-control/rpi_pmsm_control.vhdl
Correct logic to detect failed SPI communication and add option switch PWM to pass...
[fpga/rpi-motor-control.git] / pmsm-control / rpi_pmsm_control.vhdl
1 --
2 -- * Raspberry Pi BLDC/PMSM motor control design for RPi-MI-1 board *
3 -- The toplevel component file
4 --
5 -- (c) 2015 Martin Prudek <prudemar@fel.cvut.cz>
6 -- Czech Technical University in Prague
7 --
8 -- Project supervision and original project idea
9 -- idea by Pavel Pisa <pisa@cmp.felk.cvut.cz>
10 --
11 -- Related RPi-MI-1 hardware is designed by Petr Porazil,
12 -- PiKRON Ltd  <http://www.pikron.com>
13 --
14 -- VHDL design reuses some components and concepts from
15 -- LXPWR motion power stage board and LX_RoCoN system
16 -- developed at PiKRON Ltd with base code implemented
17 -- by Marek Peca <hefaistos@gmail.com>
18 --
19 -- license: GNU LGPL and GPLv3+
20 --
21
22 library ieee;
23 use ieee.std_logic_1164.all;
24 use ieee.numeric_std.all;
25 use work.util.all;
26
27 entity rpi_pmsm_control is
28 generic(
29         pwm_width : natural:=11
30         );
31 port (
32         gpio2: in std_logic; -- SDA
33         gpio3: in std_logic; -- SCL
34         gpio4: in std_logic; -- CLK           (gpio_clk)
35         gpio14: in std_logic; -- Tx
36         gpio15: in std_logic; -- Rx
37         gpio17: inout std_logic; -- RTS       (irc_i)
38         gpio18: in std_logic; -- PWM0/PCMCLK  (pwm_in/pwm1)
39         gpio27: inout std_logic; -- SD1DAT3   (irc_b)
40         gpio22: in std_logic; -- SD1CLK       (pwm_dir_in/pwm1_en)
41         gpio23: inout std_logic; -- SD1CMD    (irc_a)
42         gpio24: inout std_logic; -- SD1DAT0   (irc_a)
43         gpio10: in std_logic; -- SPI0MOSI     (spi_mosi)
44         gpio9: out std_logic; -- SPI0MISO     (spi_miso)
45         gpio25: inout std_logic; -- SD1DAT1   (irc_b)
46         gpio11: in std_logic; -- SPI0SCLK     (spi_clk)
47         gpio8: in std_logic; -- SPI0CE0
48         gpio7: in std_logic; -- SPI0CE1       (spi_ce)
49         gpio5: in std_logic; -- GPCLK1
50         gpio6: in std_logic; -- GPCLK2
51         gpio12: in std_logic; -- PWM0         (pwm3)
52         gpio13: in std_logic; -- PWM1         (pwm2)
53         gpio19: in std_logic; -- PWM1/SPI1MISO/PCMFS (pwm2_en)
54         gpio16: in std_logic; -- SPI1CE2
55         gpio26: in std_logic; -- SD1DAT2      (pwm3_en)
56         gpio20: in std_logic; -- SPI1MOSI/PCMDIN/GPCLK0
57         gpio21: in std_logic; -- SPI1SCLK/PCMDOUT/GPCLK1
58         --
59         -- PWM
60         -- Each PWM signal has cooresponding shutdown
61         pwm: out std_logic_vector (1 to 3);
62         shdn: out std_logic_vector (1 to 3);
63         -- Fault/power stage status
64         stat: in std_logic_vector (1 to 3);
65         -- HAL inputs
66         hal_in: in std_logic_vector (1 to 3);
67         -- IRC inputs
68         irc_a: in std_logic;
69         irc_b: in std_logic;
70         irc_i: in std_logic;
71         -- Power status
72         power_stat: in std_logic;
73         -- ADC for current
74         adc_miso: in std_logic;
75         adc_mosi: out std_logic;
76         adc_sclk: out std_logic;
77         adc_scs: out std_logic;
78         -- Extarnal SPI
79         ext_miso: in std_logic; --master in slave out
80         ext_mosi: in std_logic; --master out slave in
81         ext_sclk: in std_logic;
82         ext_scs0: in std_logic;
83         ext_scs1: in std_logic;
84         ext_scs2: in std_logic;
85         -- RS-485 Transceiver
86         rs485_rxd: in std_logic;
87         rs485_txd: out std_logic;
88         rs485_dir: out std_logic;
89         -- CAN Transceiver
90         can_rx: in std_logic;
91         can_tx: in std_logic;
92         -- DIP switch
93         dip_sw: in std_logic_vector (1 to 3); --na desce je prohozene cislovanni
94         -- Unused terminal to keep design tools silent
95         dummy_unused : out std_logic
96 );
97 end rpi_pmsm_control;
98
99
100 architecture behavioral of rpi_pmsm_control is
101         attribute syn_noprune :boolean;
102         attribute syn_preserve :boolean;
103         attribute syn_keep :boolean;
104         attribute syn_hier :boolean;
105
106         -- Actel lib
107         component pll50to200
108                 port (
109                         powerdown, clka: in std_logic;
110                         lock, gla: out std_logic
111                 );
112         end component;
113         
114         component CLKINT
115                 port (A: in std_logic; Y: out std_logic);
116         end component;
117         
118         component qcounter
119         port (
120                 clock: in std_logic;
121                 reset: in std_logic;
122                 a0, b0: in std_logic;
123                 qcount: out std_logic_vector (31 downto 0);
124                 a_rise, a_fall, b_rise, b_fall, ab_event: out std_logic;
125                 ab_error: out std_logic
126         );
127         end component;
128
129         component mcpwm is
130         generic (
131                 pwm_width: natural
132         );
133         port (
134                 clock: in std_logic;
135                 sync: in std_logic;                             --flag that counter "restarts-overflows"
136                 data_valid:in std_logic;                        --indicates data is consistent
137                 failsafe: in std_logic;                         --turn off both transistors
138                 en_p, en_n: in std_logic;                       --enable positive & enable shutdown
139                 match: in std_logic_vector (pwm_width-1 downto 0); --posion of counter when we swap output logic
140                 count: in std_logic_vector (pwm_width-1 downto 0); --we use an external counter
141                 out_p, out_n: out std_logic                     --pwm outputs: positive & shutdown
142                 --TODO add the rest of pwm signals, swap match to pwm_word
143         );
144         end component;
145         
146         --frequency division by 12
147         component cnt_div is
148         generic (
149                 cnt_width_g : natural := 4
150         );
151         port
152         (
153                 clk_i     : in std_logic;                               --clk to divide
154                 en_i      : in std_logic;                               --enable bit?
155                 reset_i   : in std_logic;                               --asynch. reset
156                 ratio_i   : in std_logic_vector(cnt_width_g-1 downto 0);--initial value
157                 q_out_o   : out std_logic                               --generates puls when counter underflows
158         );
159         end component;
160         
161         component adc_reader is
162         port (
163                 clk: in std_logic;                                      --input clk
164                 divided_clk : in std_logic;                             --divided clk - value suitable to sourcing voltage
165                 adc_reset: in std_logic;
166                 adc_miso: in std_logic;                                 --spi master in slave out
167                 adc_channels: out std_logic_vector (35 downto 0);       --consistent data of 3 channels
168                 adc_sclk: out std_logic;                                --spi clk
169                 adc_scs: out std_logic;                                 --spi slave select
170                 adc_mosi: out std_logic;                                --spi master out slave in
171                 measur_count: out std_logic_vector(8 downto 0)          --number of accumulated measurments
172         
173         );
174         end component;
175         
176         component dff3 is
177         port(
178                 clk_i   : in std_logic;
179                 d_i     : in std_logic;
180                 q_o     : out std_logic
181         );
182         end component;
183         
184         --resetovatelna delicka
185         component div128 is
186         port (
187                 clk_in: in std_logic;
188                 rst: in std_logic;
189                 fail_safe: out std_logic
190         );
191         end component;
192         
193         component div256 is
194         port (
195                 clk_in: in std_logic;
196                 div256: out std_logic
197         );
198         end component;
199         
200         
201         signal adc_channels: std_logic_vector(71 downto 0);
202         signal adc_m_count: std_logic_vector(8 downto 0);
203
204         --clock signals for logic and master fail monitoring
205         signal gpio_clk: std_logic;
206         signal pll_clkin, pll_clkout, pll_lock: std_logic;
207         signal clkmon_dly1, clkmon_dly2: std_logic;
208         signal clkmon_fail, clkmon_fail_next: std_logic;
209         signal clkmon_wdg: integer range 0 to 6;
210         signal reset_sync, reset_async: std_logic;
211         signal failsafe, next_failsafe: std_logic;
212
213         --RPi SPI interface signals named aliases
214         signal spi_clk, spi_ce, spi_mosi, spi_miso : std_logic;
215         signal spiclk_old: std_logic_vector(1 downto 0); --pro detekci hrany SPI hodin
216
217         --signal pwm_in, pwm_dir_in: std_logic;
218         signal dat_reg : STD_LOGIC_VECTOR (127 downto 0); --shift register for spi
219         signal position: std_logic_vector(31 downto 0); --pozice z qcounteru
220         signal index_position: std_logic_vector(11 downto 0);           --pozice irc_i
221         signal ce0_old: std_logic_vector(1 downto 0);
222         
223         --pwm signals
224         constant pwm_n: natural := 3;                                   --number of pwm outputs
225         --number of ticks per pwm cycle, 2^11=2048
226         constant pwm_period : std_logic_vector (pwm_width-1 downto 0) := (others=>'1'); 
227         type pwm_res_type is array(1 to 3) of std_logic_vector (pwm_width-1 downto 0);
228         
229         signal pwm_match: pwm_res_type;                                 --point of reversion of pwm output, 0 to 2047
230         signal pwm_count: std_logic_vector (pwm_width-1 downto 0);      --counter, 0 to 2047
231         signal pwm_sync_at_next: std_logic;
232         signal pwm_sync: std_logic;
233         signal pwm_en_p: std_logic_vector(1 to 3);
234         signal pwm_en_n: std_logic_vector(1 to 3);
235         signal pwm_sig: std_logic_vector(1 to 3);
236         signal shdn_sig: std_logic_vector (1 to 3);
237         
238         signal income_data_valid: std_logic;
239         signal spi_timout_pulse: std_logic;
240         
241         signal clk_4M17: std_logic;
242
243         -- irc signals processing
244         signal irc_i_prev: std_logic;
245
246         -- function configuration options
247         -- direct IRC channel A, B and I output to RPi/SoC
248         signal fnccfg_direct_irc: std_logic;
249         -- direct 3 phase PWM output
250         signal fnccfg_direct_3ph_pwm: std_logic;
251         -- PWM1 and PWM2 controlled by PWM input and direction
252         signal fnccfg_pwm12_by_pwm_and_dir: std_logic;
253         
254         --filetered irc signals
255         signal irc_a_dff3: std_logic;
256         signal irc_b_dff3: std_logic;
257         
258         --16k3 clk signal
259         signal clk_16k3: std_logic;
260         --detekce prichazejicich prikazu po SPI
261
262         --  attribute syn_noprune of gpio2 : signal is true;
263         --  attribute syn_preserve of gpio2 : signal is true;
264         --  attribute syn_keep of gpio2 : signal is true;
265         --  attribute syn_hier of gpio2 : signal is true;
266
267 begin
268         -- PLL as a reset generator
269         
270         --zesileni signalu GPIO CLK
271         copyclk2: CLKINT
272         port map (
273                 a => gpio4,
274                 y => gpio_clk
275         );
276         
277         pll: pll50to200
278         port map (
279                 powerdown => '1',
280                 clka => pll_clkin,
281                 gla => pll_clkout,
282                 lock => pll_lock);
283
284         reset_async <= not pll_lock or clkmon_fail;
285
286         pll_clkin <= gpio_clk;
287         
288         qcount: qcounter
289         port map (
290                 clock => gpio_clk,
291                 reset => '0',
292                 a0 => irc_a_dff3,
293                 b0 => irc_b_dff3,
294                 qcount => position,
295                 a_rise => open,
296                 a_fall => open,
297                 b_rise => open,
298                 b_fall => open,
299                 ab_event => open,
300                 ab_error => open
301         );
302         
303         pwm_block: for i in pwm_n downto 1 generate
304                 pwm_map: mcpwm
305                 generic map (
306                         pwm_width => pwm_width
307                 )
308                 port map (
309                         clock => gpio_clk,                              --50 Mhz clk from gpclk on raspberry
310                         sync => pwm_sync,                               --counter restarts
311                         data_valid => pwm_sync_at_next,                 
312                         failsafe => failsafe,
313                         --
314                         -- pwm config bits & match word
315                         --
316                         en_n => pwm_en_n(i),                            --enable positive pwm
317                         en_p => pwm_en_p(i),                            --enable "negative" ->activate shutdown
318                         match => pwm_match(i),
319                         count => pwm_count,
320                         -- outputs
321                         out_p => pwm_sig(i),                            --positive signal
322                         out_n => shdn_sig(i)                            --reverse signal is in shutdown mode
323                 );
324         end generate;
325         
326         
327         div12_map: cnt_div
328         generic map (
329                 cnt_width_g => 4
330         )
331         port map(
332                 clk_i  => gpio_clk,
333                 en_i   =>'1',
334                 reset_i   =>'0',
335                 ratio_i   =>"1101", --POZN.: counter detekuje cnt<=1
336                 q_out_o   =>clk_4M17
337         );
338
339         clk_16k3_div: cnt_div
340         generic map (
341                 cnt_width_g => 8
342         )
343         port map(
344                 clk_i  => gpio_clk,
345                 en_i   => clk_4M17,
346                 reset_i   => '0',
347                 ratio_i   => "11111111",
348                 q_out_o   => clk_16k3
349         );
350
351         spi_timeout_div : cnt_div
352         generic map (
353                 cnt_width_g => 7
354         )
355         port map(
356                 clk_i  => gpio_clk,
357                 en_i   => clk_16k3,
358                 reset_i   => income_data_valid,
359                 ratio_i   => "1111111",
360                 q_out_o   => spi_timout_pulse
361         );
362
363         -- ADC needs 3.2 MHz clk when powered from +5V Vcc
364         --           2.0 MHz clk when +2.7V Vcc
365         -- on the input is 4.17Mhz,but this frequency is divided inside adc_reader by 2 to 2.08 Mhz,
366         --        while we use +3.3V Vcc
367         adc_reader_map: adc_reader
368         port map(
369                 clk => gpio_clk,
370                 divided_clk => clk_4M17,
371                 adc_reset => income_data_valid, --reset at each SPI cycle,TODO: replace with PLL reset
372                 adc_miso => adc_miso,
373                 adc_channels => adc_channels,
374                 adc_sclk => adc_sclk,
375                 adc_scs => adc_scs,
376                 adc_mosi => adc_mosi,
377                 measur_count => adc_m_count
378                 
379         );
380         
381         dff3_a: dff3
382         port map(       
383                 clk_i => gpio_clk,
384                 d_i   => irc_a,
385                 q_o   => irc_a_dff3
386         );
387         
388         dff3_b: dff3
389         port map(       
390                 clk_i => gpio_clk,
391                 d_i   => irc_b,
392                 q_o   => irc_b_dff3
393         );
394
395         dummy_unused <= gpio2 and gpio3 and
396                 gpio5 and gpio6 and
397                 gpio12 and gpio13 and gpio14 and
398                 gpio15 and gpio16 and gpio19 and
399                 gpio20 and gpio21 and gpio26 and
400                 stat(1) and stat(2) and stat(3) and
401                 hal_in(1) and hal_in(2) and hal_in(3) and
402                 irc_i and power_stat and
403                 adc_miso and
404                 rs485_rxd and
405                 can_rx and can_tx and
406                 irc_a and irc_b and
407                 gpio17 and gpio18 and gpio27 and gpio22 and gpio23 and gpio24 and gpio25 and
408                 gpio8  and
409                 ext_scs1 and ext_scs2 and ext_miso and ext_mosi and ext_sclk and ext_scs0;
410
411         fnccfg_direct_irc <= not dip_sw(1);
412         fnccfg_direct_3ph_pwm <= not dip_sw(2) and dip_sw(3);
413         fnccfg_pwm12_by_pwm_and_dir <= not dip_sw(2) and not dip_sw(3);
414                         
415         rs485_txd <= '1';
416         rs485_dir <= '0';
417
418         spi_clk <= gpio11;
419         spi_ce <= gpio7;
420         spi_mosi <= gpio10;
421         gpio9 <= spi_miso;
422
423         irc_direct_output_selection: process(fnccfg_direct_irc, irc_a, irc_b, irc_i)
424         begin
425                 if fnccfg_direct_irc = '1' then
426                         gpio23 <= irc_a;
427                         gpio24 <= irc_a;
428                         gpio27 <= irc_b;
429                         gpio25 <= irc_b;
430                         gpio17 <= irc_i;
431                 else
432                         gpio23 <= 'Z';
433                         gpio24 <= 'Z';
434                         gpio27 <= 'Z';
435                         gpio25 <= 'Z';
436                         gpio17 <= 'Z';
437                 end if;
438         end process;
439
440         pwm_output_selection: process(pwm_sig, shdn_sig,
441                 fnccfg_direct_3ph_pwm, fnccfg_pwm12_by_pwm_and_dir,
442                 fnccfg_pwm12_by_pwm_and_dir, gpio12, gpio13, gpio18, gpio19,
443                 gpio22, gpio26)
444         begin
445                 if fnccfg_direct_3ph_pwm = '1' then
446                         pwm(1) <= gpio18;
447                         pwm(2) <= gpio13;
448                         pwm(3) <= gpio12;
449                         shdn(1) <= not gpio22;
450                         shdn(2) <= not gpio19;
451                         shdn(3) <= not gpio26;
452                 elsif fnccfg_pwm12_by_pwm_and_dir = '1' then
453                         -- pwm(1) <= pwm_in and not pwm_dir_in;
454                         pwm(1) <= gpio18 and not gpio22;
455                         -- pwm(2) <= pwm_in and pwm_dir_in;;
456                         pwm(2) <= gpio18 and gpio22;
457                         pwm(3) <= '0';
458                         shdn(1) <= '0';
459                         shdn(2) <= '0';
460                         shdn(3) <= '1';
461                 else
462                         pwm <= pwm_sig;
463                         shdn <= shdn_sig;
464                 end if;
465         end process;
466
467         process
468         begin
469                 wait until (gpio_clk'event and gpio_clk='1');
470                 if irc_i_prev = '0' and irc_i = '1' then
471                         index_position(11 downto 0)<=position(11 downto 0);
472                 end if;
473                 irc_i_prev<=irc_i;
474         end process;
475         
476         process
477         begin
478                 wait until (gpio_clk'event and gpio_clk='1');
479                 IF pwm_count = std_logic_vector(unsigned(pwm_period) - 1) THEN                          
480                         --end of period nearly reached
481                         --fetch new pwm match data
482                         pwm_sync_at_next <= '1';
483                 else
484                         pwm_sync_at_next <= '0';
485                 end if;
486                 
487                 if pwm_sync_at_next='1' then
488                         --end of period reached
489                         pwm_count <= (others=>'0');      --reset counter
490                         pwm_sync <= '1';                                -- inform PWM logic about new period start
491                 ELSE                                                    --end of period not reached
492                         pwm_count <= std_logic_vector(unsigned(pwm_count)+1);           --increment counter
493                         pwm_sync <= '0';
494                 END IF;
495         end process;
496         
497         process
498         begin
499                 --position is obtained on rising edge -> we should write it on next cycle
500                 wait until (gpio_clk'event and gpio_clk='1');
501                 
502                 --SCLK edge detection
503                 spiclk_old(0)<=spi_clk;
504                 spiclk_old(1)<=spiclk_old(0);
505                 
506                 --SS edge detection
507                 ce0_old(0)<=spi_ce;
508                 ce0_old(1)<=ce0_old(0);
509                 
510                 if (spiclk_old="01") then --rising edge, faze cteni
511                         if (spi_ce = '0') then             -- SPI CS must be selected
512                                 -- shift serial data into dat_reg on each rising edge
513                                 -- of SCK, MSB first
514                                 dat_reg(127 downto 0) <= dat_reg(126 downto 0) & spi_mosi;
515                                 end if;
516                 elsif (spiclk_old="10" ) then --falling edge, faze zapisu
517                         if (spi_ce = '0') then
518                                 spi_miso <= dat_reg(127); --zapisujeme nejdriv MSB
519                         end if;
520                 end if;
521                 
522
523                 if (ce0_old = "10" ) then
524                         income_data_valid <= '1';
525                 else
526                         income_data_valid <= '0';
527                 end if;
528
529                 --sestupna hrana SS, pripravime data pro prenos
530                 if (ce0_old = "10" ) then
531                         dat_reg(127 downto 96) <= position(31 downto 0); --pozice
532                         dat_reg(95 downto 93) <= hal_in(1 to 3); --halovy sondy
533                         dat_reg(92 downto 81) <= index_position(11 downto 0);   --position of irc_i
534                         dat_reg(80 downto 72) <=adc_m_count(8 downto 0);        --count of measurments
535                         --data order schould be: ch2 downto ch0 downto ch1
536                         dat_reg(71 downto 0) <= adc_channels(71 downto 0);      --current mesurments
537                         spi_miso <= position(31);               --prepare the first bit on SE activation
538                 elsif (ce0_old = "01") then --rising edge of SS, we should read the data
539                         pwm_en_p(1 to 3)<=dat_reg(126 downto 124);
540                         pwm_en_n(1 to 3)<=dat_reg(123 downto 121);
541                         --usable for up to 16-bit PWM duty cycle resolution (pwm_width):
542                         pwm_match(1)(pwm_width-1 downto 0)<=dat_reg(pwm_width+31 downto 32);
543                         pwm_match(2)(pwm_width-1 downto 0)<=dat_reg(pwm_width+15 downto 16);
544                         pwm_match(3)(pwm_width-1 downto 0)<=dat_reg(pwm_width-1 downto 0);
545                 end if;
546         end process;
547
548         clock_monitor: process (pll_clkout, gpio_clk, clkmon_dly1, clkmon_wdg, clkmon_fail_next)
549         begin
550                 if pll_clkout'event and pll_clkout = '1' then
551                         clkmon_dly1 <= gpio_clk;
552                         clkmon_dly2 <= clkmon_dly1;
553                         if clkmon_dly1 = '0' and clkmon_dly2 = '1' then
554                                 clkmon_wdg <= 6;
555                                 clkmon_fail_next <= '0';
556                         elsif clkmon_wdg > 0 then
557                                 clkmon_wdg <= clkmon_wdg - 1;
558                                 clkmon_fail_next <= '0';
559                         else
560                                 clkmon_wdg <= 0;
561                                 clkmon_fail_next <= '1';
562                         end if;
563                         clkmon_fail <= clkmon_fail_next;
564                 end if;
565         end process;
566
567         failsafe_spi_monitor: process (failsafe, spi_timout_pulse, income_data_valid)
568         begin
569                 -- the failasfe signal from communication block if CRC is used
570                 -- or simple watchdog for SPI communication
571                 if income_data_valid = '1' then
572                         next_failsafe <= '0';
573                 elsif spi_timout_pulse = '1' then
574                         next_failsafe <= '1';
575                 else
576                         next_failsafe <= failsafe;
577                 end if;
578         end process;
579
580         async_rst: process (gpio_clk, reset_async, reset_sync)
581         begin
582                 if reset_async = '1' then
583                         failsafe <= '1';
584                 elsif gpio_clk'event and gpio_clk = '1' then
585                         failsafe <= next_failsafe or reset_sync;
586                 end if;
587         end process;
588
589         sync_rst: process (gpio_clk, reset_async)
590         begin
591                 if gpio_clk'event and gpio_clk = '1' then
592                         reset_sync <= reset_async;
593                 end if;
594         end process;
595
596 end behavioral;
597