misc/mu4sim/mu4sim.pl- Source code ソースコード - XEiJ - STUDIO KAMADA
misc/mu4sim/mu4sim.pl

    use integer;
    use strict;
    use utf8;
    use warnings;

    my $DELAY_n384FS = 0;  #n384FSの遅延。0～3

    #回路の要素
    my $ATOM = 0;
    my $NOT = 1;
    my $AND = 2;
    my $EOR = 3;
    my $IOR = 4;

    #ノードの種類
    my $PORT = 0;
    my $NODE = 1;
    my $IOPIN = 2;
    my $REG = 3;

    #ノードと回路の追加
    #  名前の先頭1文字はグループ
    #    (接続される可能性のある)異なるグループには異なる文字を割り当てること
    #    a  Artemis
    #    d  Delay
    #    j  JP2,JP3
    #    l  Lunar
    #    m  YMF288 MASTER
    #    o  X1,X2,X3
    #    s  YMF288 SLAVE
    #    t  TC9245F
    #    x  X68KBUS
    #    ノードの値を参照するとき
    #      参照先がIOPINかつ参照元と参照先のグループが異なるとき
    #        outを参照する
    #      さもなくば
    #        valを参照する
    my $ADDITION = {

      #artemis
      a_A10 => { ncct => [$ATOM, 'x_A10'] },  #artemis 125 I/O80 [A10] X68KBUS B15 AB10
      a_A11 => { ncct => [$ATOM, 'x_A11'] },  #artemis 123 I/O78 [A11] X68KBUS B16 AB11
      a_A12 => { ncct => [$ATOM, 'x_A12'] },  #artemis 121 I/O76 [A12] X68KBUS B17 AB12
      a_A13 => { ncct => [$ATOM, 'x_A13'] },  #artemis 119 I/O74 [A13] X68KBUS B18 AB13
      a_A14 => { ncct => [$ATOM, 'x_A14'] },  #artemis 117 I/O72 [A14] X68KBUS B19 AB14
      a_A15 => { ncct => [$ATOM, 'x_A15'] },  #artemis 44 I/O22 [A15] X68KBUS B20 AB15
      a_A16 => { ncct => [$ATOM, 'x_A16'] },  #artemis 108 I/O70 [A16] X68KBUS B22 AB16
      a_A17 => { ncct => [$ATOM, 'x_A17'] },  #artemis 107 I/O69 [A17] X68KBUS B23 AB17
      a_A18 => { ncct => [$ATOM, 'x_A18'] },  #artemis 105 I/O67 [A18] X68KBUS B24 AB18
      a_A19 => { ncct => [$ATOM, 'x_A19'] },  #artemis 103 I/O65 [A19] X68KBUS B25 AB19
      a_A20 => { ncct => [$ATOM, 'x_A20'] },  #artemis 101 I/O63 [A20] X68KBUS B26 AB20
      a_A21 => { ncct => [$ATOM, 'x_A21'] },  #artemis 99 I/O61 [A21] X68KBUS B27 AB21
      a_A22 => { ncct => [$ATOM, 'x_A22'] },  #artemis 96 I/O59 [A22] X68KBUS B28 AB22
      a_A23 => { ncct => [$ATOM, 'x_A23'] },  #artemis 94 I/O57 [A23] X68KBUS B29 AB23
      a_A3 => { ncct => [$ATOM, 'x_A3'] },  #artemis 12 I/O94 [A3] X68KBUS B7 AB3
      a_A4 => { ncct => [$ATOM, 'x_A4'] },  #artemis 10 I/O92 [A4] X68KBUS B8 AB4
      a_A5 => { ncct => [$ATOM, 'x_A5'] },  #artemis 8 I/O90 [A5] X68KBUS B9 AB5
      a_A6 => { ncct => [$ATOM, 'x_A6'] },  #artemis 6 I/O88 [A6] X68KBUS B10 AB6
      a_A7 => { ncct => [$ATOM, 'x_A7'] },  #artemis 4 I/O86 [A7] X68KBUS B12 AB7
      a_A8 => { ncct => [$ATOM, 'x_A8'] },  #artemis 2 I/O84 [A8] X68KBUS B13 AB8
      a_A9 => { ncct => [$ATOM, 'x_A9'] },  #artemis 127 I/O82 [A9] X68KBUS B14 AB9
      a_AS => { ncct => [$ATOM, 'x_AS'] },  #artemis 100 I/O62 [AS_] X68KBUS A27 AS_
      a_CLK10M_ => { ncct => [$ATOM, 'x_10M_'] },  #artemis 15 Y0 [10M_] X68KBUS B3 10M_
      a_CLK12M => { ncct => [$ATOM, 'o_X1'] },  #artemis 54 I/O26 [12M] 12.288MHz OSC X1 OUT
      a_CLK16M => { ncct => [$ATOM, 'o_X2'] },  #artemis 53 I/O25 [16M] 16.9344MHz OSC X2 OUT
      a_CLK18M => { ncct => [$ATOM, 'o_X3'] },  #artemis 52 I/O24 [18M] 18.432MHz OSC X3 OUT
      a_CLK20M => { ncct => [$ATOM, 'x_20M'] },  #artemis 80 Y2 [20M] X68KBUS A2 20M
      a_D0 => { icct => [$ATOM, 'x_D0w'] },  #artemis 25 I/O4 [D0] X68KBUS A4 DB0
      a_D1 => { icct => [$ATOM, 'x_D1w'] },  #artemis 24 I/O3 [D1] X68KBUS A5 DB1
      a_D10 => { icct => [$ATOM, 'x_D10w'] },  #artemis 126 I/O81 [D10] X68KBUS A15 DB10
      a_D11 => { icct => [$ATOM, 'x_D11w'] },  #artemis 124 I/O79 [D11] X68KBUS A16 DB11
      a_D12 => { icct => [$ATOM, 'x_D12w'] },  #artemis 122 I/O77 [D12] X68KBUS A17 DB12
      a_D2 => { icct => [$ATOM, 'x_D2w'] },  #artemis 22 I/O1 [D2] X68KBUS A6 DB2
      a_D3 => { icct => [$ATOM, 'x_D3w'] },  #artemis 13 I/O95 [D3] X68KBUS A7 DB3
      a_D4 => { icct => [$ATOM, 'x_D4w'] },  #artemis 11 I/O93 [D4] X68KBUS A8 DB4
      a_D5 => { icct => [$ATOM, 'x_D5w'] },  #artemis 9 I/O91 [D5] X68KBUS A9 DB5
      a_D6 => { icct => [$ATOM, 'x_D6w'] },  #artemis 7 I/O89 [D6] X68KBUS A10 DB6
      a_D7 => { icct => [$ATOM, 'x_D7w'] },  #artemis 5 I/O87 [D7] X68KBUS A12 DB7
      a_D8 => { icct => [$ATOM, 'x_D8w'] },  #artemis 3 I/O85 [D8] X68KBUS A13 DB8
      a_D9 => { icct => [$ATOM, 'x_D9w'] },  #artemis 128 I/O83 [D9] X68KBUS A14 DB9
      a_DATAEXT => { ncct => [$ATOM, 't_DATA'] },  #artemis 74 I/O44 [DATAEXT] TC9245F 16 DATA 光入力データ
      a_ERROR => { ncct => [$ATOM, 't_ERROR'] },  #artemis 75 I/O45 [ERR] TC9245F 20 ERROR 光入力エラー
      a_EXACK => { ncct => [$ATOM, 'x_EXACK'] },  #artemis 88 I/O51 [EXACK_] X68KBUS B37 EXACK_
      #EXPCLOUTの.oeは他のボードの邪魔をしないため。入力はない
      a_EXPCLOUT => { icct => [$ATOM, '1'] },  #artemis 41 I/O19 [EXPCLOUT_] 74LS07 9 - X68KBUS B38 EXPCL_
      #EXREQOUTの.oeは他のボードの邪魔をしないため。入力はない
      a_EXREQOUT => { icct => [$ATOM, '1'] },  #artemis 89 I/O52 [EXREQOUT_] 74LS07 11 - X68KBUS B36 EXREQ_
      a_EXRESET => { ncct => [$ATOM, 'x_EXRESET'] },  #artemis 84 IN4 [EXRESET_] X68KBUS A37 EXRESET_
      a_FS1 => { ncct => [$ATOM, 't_FS1'] },  #artemis 77 I/O47 [FS1] TC9245F 26 FS1 サンプリング周波数
      a_FS2 => { ncct => [$ATOM, 't_FS2'] },  #artemis 76 I/O46 [FS2] TC9245F 27 FS2 サンプリング周波数
      a_HSYNC => { ncct => [$ATOM, 'x_HSYNC'] },  #artemis 61 I/O33 [HSYNC] X68KBUS B32 HSYNC
      a_IACK2 => { ncct => [$ATOM, 'x_IACK2'] },  #artemis 87 I/O50 [IACK2] X68KBUS B44 IACK2
      a_IACK4 => { ncct => [$ATOM, 'x_IACK4'] },  #artemis 86 I/O49 [IACK4] X68KBUS B45 IACK4
      a_IYAN => { ncct => [$ATOM, 'j_J3'] },  #artemis 32 I/O11 [THRU] JP3 THRU - GND
      a_LDS => { ncct => [$ATOM, 'x_LDS'] },  #artemis 98 I/O60 [LDS] X68KBUS A28 LDS
      a_LRCKEXT => { ncct => [$ATOM, 't_LRCK'] },  #artemis 72 I/O42 [LRCKEXT] TC9245F 18 LRCK LRクロック
      a_R_W_ => { ncct => [$ATOM, 'x_R_W_'] },  #artemis 93 I/O56 [R/W_] X68KBUS A30 R/W_
      a_SOUT => { ncct => [$ATOM, 'l_SOUT'] },  #artemis 110 IN5 [SOUT] lunar 13 I/O4 SOUT
      a_UDS => { ncct => [$ATOM, 'x_UDS'] },  #artemis 95 I/O58 [UDS] X68KBUS A29 UDS
      a_VSYNC => { ncct => [$ATOM, 'x_VSYNC'] },  #artemis 56 I/O28 [VSYNC] X68KBUS B33 VSYNC
      a_n384FS => ($DELAY_n384FS == 0 ?
                   { ncct => [$ATOM, 'a_n384FSOUT1'] } :  #artemis 83 Y1 [384FS1] artemis 36 I/O14
                   { ncct => [$ATOM, 'd_n384FS'] }),  #ディレイ
      a_n384FSEXT => { ncct => [$ATOM, 't_FS384'] },  #artemis 71 I/O41 [384FSEXT] TC9245F 22 FS384 384fsクロック

      #ディレイ
      d_n384FS => ($DELAY_n384FS == 0 ?
                   '' :
                   $DELAY_n384FS == 1 ?
                   { ncct => [$AND,
                              [$ATOM, 'a_n384FSOUT1'],
                              [$ATOM, 'a_n384FSOUT1']] } :
                   $DELAY_n384FS == 2 ?
                   { ncct => [$AND,
                              [$AND,
                               [$ATOM, 'a_n384FSOUT1'],
                               [$ATOM, 'a_n384FSOUT1']],
                              [$AND,
                               [$ATOM, 'a_n384FSOUT1'],
                               [$ATOM, 'a_n384FSOUT1']]] } :
                   $DELAY_n384FS == 3 ?
                   { ncct => [$AND,
                              [$AND,
                               [$AND,
                                [$ATOM, 'a_n384FSOUT1'],
                                [$ATOM, 'a_n384FSOUT1']],
                               [$AND,
                                [$ATOM, 'a_n384FSOUT1'],
                                [$ATOM, 'a_n384FSOUT1']]],
                              [$AND,
                               [$AND,
                                [$ATOM, 'a_n384FSOUT1'],
                                [$ATOM, 'a_n384FSOUT1']],
                               [$AND,
                                [$ATOM, 'a_n384FSOUT1'],
                                [$ATOM, 'a_n384FSOUT1']]]] } :
                   die),

      #lunar
      l_AD1 => { ncct => [$ATOM, 'a_AD1'] },  #lunar 40 IN3 [AD1] artemis 73 I/O43 AD1
      l_CLK10M => { ncct => [$ATOM, 'x_10M'] },  #lunar 5 Y0 [10M] X68KBUS B2 10M
      l_CLK10M_ => { ncct => [$ATOM, 'x_10M_'] },  #lunar 29 Y1/RESET [10M_] X68KBUS B3 10M_
      l_D0 => { icct => [$ATOM, 'x_D0w'] },  #lunar 19 I/O8 [D0] X68KBUS A4 DB0
      l_D1 => { icct => [$ATOM, 'x_D1w'] },  #lunar 20 I/O9 [D1] X68KBUS A5 DB1
      l_D10 => { icct => [$ATOM, 'x_D10w'] },  #lunar 33 I/O18 [D10] X68KBUS A15 DB10
      l_D11 => { icct => [$ATOM, 'x_D11w'] },  #lunar 34 I/O19 [D11] X68KBUS A16 DB11
      l_D12 => { icct => [$ATOM, 'x_D12w'] },  #lunar 35 I/O20 [D12] X68KBUS A17 DB12
      l_D13 => { icct => [$ATOM, 'x_D13w'] },  #lunar 36 I/O21 [D13] X68KBUS A18 DB13
      l_D14 => { icct => [$ATOM, 'x_D14w'] },  #lunar 37 I/O22 [D14] X68KBUS A19 DB14
      l_D15 => { icct => [$ATOM, 'x_D15w'] },  #lunar 38 I/O23 [D15] X68KBUS A20 DB15
      l_D2 => { icct => [$ATOM, 'x_D2w'] },  #lunar 21 I/O10 [D2] X68KBUS A6 DB2
      l_D3 => { icct => [$ATOM, 'x_D3w'] },  #lunar 22 I/O11 [D3] X68KBUS A7 DB3
      l_D4 => { icct => [$ATOM, 'x_D4w'] },  #lunar 23 I/O12 [D4] X68KBUS A8 DB4
      l_D5 => { icct => [$ATOM, 'x_D5w'] },  #lunar 24 I/O13 [D5] X68KBUS A9 DB5
      l_D6 => { icct => [$ATOM, 'x_D6w'] },  #lunar 25 I/O14 [D6] X68KBUS A10 DB6
      l_D7 => { icct => [$ATOM, 'x_D7w'] },  #lunar 26 I/O15 [D7] X68KBUS A12 DB7
      l_D8 => { icct => [$ATOM, 'x_D8w'] },  #lunar 31 I/O16 [D8] X68KBUS A13 DB8
      l_D9 => { icct => [$ATOM, 'x_D9w'] },  #lunar 32 I/O17 [D9] X68KBUS A14 DB9
      l_EXRESET => { ncct => [$ATOM, 'x_EXRESET'] },  #lunar 14 I/O5 [EXRESET] X68KBUS A37 EXRESET
      l_FMVR => { ncct => [$ATOM, 'a_FMVR'] },  #lunar 44 I/O27 [FMVR] artemis 37 I/O15 FMVR
      l_FMVW => { ncct => [$ATOM, 'a_FMVW'] },  #lunar 12 I/O3 [FMVW] artemis 38 I/O16 FMVW
      l_G1R => { ncct => [$ATOM, 'a_G1R'] },  #lunar 43 I/O26 [G1R] artemis 55 I/O27 G1R
      l_IACKx => { ncct => [$ATOM, 'j_J2'] },  #lunar 10 I/O1 [IACKX] JP2 2  1 [IACK2] X68KBUS B44  3 [IACK4] X68KBUS B45
      l_IRQM => { ncct => [$ATOM, 'm_IRQ'] },  #lunar 16 I/O7 [IRQM] YMF288 MASTER 15 IRQ
      l_LDS => { ncct => [$ATOM, 'x_LDS'] },  #lunar 2 I/O29 [LDS] X68KBUS A28 LDS
      l_LROM => { ncct => [$ATOM, 'm_LRO'] },  #lunar 15 I/O6 [LROM] YAC512 MASTER 7 LRCK / YMF288 MASTER 26 LRO
      l_LROS => { ncct => [$ATOM, 's_LRO'] },  #lunar 4 I/O31 [LROS] YAC513 SLAVE 7 LRCK / YMF288 SRAVE 26 LRO
      l_R_W_ => { ncct => [$ATOM, 'x_R_W_'] },  #lunar 9 I/O0 [R/W_] X68KBUS A30 R/W_
      l_S0 => { ncct => [$ATOM, 'a_S0'] },  #lunar 8 SDI/IN0 [SDI] [SDO] artemis 50 SDO/NC [S0] artemis 30 I/O9 S0
      l_S1 => { ncct => [$ATOM, 'a_S1'] },  #lunar 18 SDO/IN1 [SDO] ISP CABLE 2 SDO [S1] artemis 31 I/O10 S1
      l_SIN => { ncct => [$ATOM, 'a_SIN'] },  #lunar 30 MODE/IN2 [MODE] artemis 46 MODE/IN1 / ISP CABLE 6 MODE [SIN] artemis 40 I/O18 SIN
      l_n384FS => { ncct => [$ATOM, 'a_n384FSOUT0'] },  #lunar 27 SCLK/Y2 [SCLK] artemis 78 SCLK/IN3 / ISP CABLE 8 SCLK [384FS0] artemis 67 I/O37 n384FSOUT0

      #X68KBUS
      x_10M => {
        ccct => [$ATOM, 'x_20M'],
        rcct => [$NOT, [$ATOM, 'x_10M']],
      },  #10Mは20Mの立ち上がりで反転する
      x_10M_ => {
        ncct => [$NOT, [$ATOM, 'x_10M']],
      },  #10M_は10Mを反転したもの
      x_20M => {},
      x_A10 => {},
      x_A11 => {},
      x_A12 => {},
      x_A13 => {},
      x_A14 => {},
      x_A15 => {},
      x_A16 => {},
      x_A17 => {},
      x_A18 => {},
      x_A19 => {},
      x_A20 => {},
      x_A21 => {},
      x_A22 => {},
      x_A23 => {},
      x_A3 => {},
      x_A4 => {},
      x_A5 => {},
      x_A6 => {},
      x_A7 => {},
      x_A8 => {},
      x_A9 => {},
      x_AS => {},
      #データバス
      #  拡張スロット基板でプルアップされている
      #  誰もアクティブにしていなければ1
      #  !(a_DOE || l_DOE) || (a_DOE && a_D0) || (l_DOE && l_D0)
      #  ArtemisはD12まで、LunarはD15まで
      x_D0r => { ncct => [$IOR,
                          [$NOT, [$IOR, [$ATOM, 'a_DOE'], [$ATOM, 'l_DOE']]],
                          [$IOR,
                           [$AND, [$ATOM, 'a_DOE'], [$ATOM, 'a_D0']],
                           [$AND, [$ATOM, 'l_DOE'], [$ATOM, 'l_D0']]]] },
      x_D0w => {},
      x_D1r => { ncct => [$IOR,
                          [$NOT, [$IOR, [$ATOM, 'a_DOE'], [$ATOM, 'l_DOE']]],
                          [$IOR,
                           [$AND, [$ATOM, 'a_DOE'], [$ATOM, 'a_D1']],
                           [$AND, [$ATOM, 'l_DOE'], [$ATOM, 'l_D1']]]] },
      x_D1w => {},
      x_D10r => { ncct => [$IOR,
                           [$NOT, [$IOR, [$ATOM, 'a_DOE'], [$ATOM, 'l_DOE']]],
                           [$IOR,
                            [$AND, [$ATOM, 'a_DOE'], [$ATOM, 'a_D10']],
                            [$AND, [$ATOM, 'l_DOE'], [$ATOM, 'l_D10']]]] },
      x_D10w => {},
      x_D11r => { ncct => [$IOR,
                           [$NOT, [$IOR, [$ATOM, 'a_DOE'], [$ATOM, 'l_DOE']]],
                           [$IOR,
                            [$AND, [$ATOM, 'a_DOE'], [$ATOM, 'a_D11']],
                            [$AND, [$ATOM, 'l_DOE'], [$ATOM, 'l_D11']]]] },
      x_D11w => {},
      x_D12r => { ncct => [$IOR,
                           [$NOT, [$IOR, [$ATOM, 'a_DOE'], [$ATOM, 'l_DOE']]],
                           [$IOR,
                            [$AND, [$ATOM, 'a_DOE'], [$ATOM, 'a_D12']],
                            [$AND, [$ATOM, 'l_DOE'], [$ATOM, 'l_D12']]]] },
      x_D12w => {},
      x_D13r => { ncct => [$IOR,
                           [$NOT, [$ATOM, 'l_DOE']],
                           [$AND, [$ATOM, 'l_DOE'], [$ATOM, 'l_D13']]] },
      x_D13w => {},
      x_D14r => { ncct => [$IOR,
                           [$NOT, [$ATOM, 'l_DOE']],
                           [$AND, [$ATOM, 'l_DOE'], [$ATOM, 'l_D14']]] },
      x_D14w => {},
      x_D15r => { ncct => [$IOR,
                           [$NOT, [$ATOM, 'l_DOE']],
                           [$AND, [$ATOM, 'l_DOE'], [$ATOM, 'l_D15']]] },
      x_D15w => {},
      x_D2r => { ncct => [$IOR,
                          [$NOT, [$IOR, [$ATOM, 'a_DOE'], [$ATOM, 'l_DOE']]],
                          [$IOR,
                           [$AND, [$ATOM, 'a_DOE'], [$ATOM, 'a_D2']],
                           [$AND, [$ATOM, 'l_DOE'], [$ATOM, 'l_D2']]]] },
      x_D2w => {},
      x_D3r => { ncct => [$IOR,
                          [$NOT, [$IOR, [$ATOM, 'a_DOE'], [$ATOM, 'l_DOE']]],
                          [$IOR,
                           [$AND, [$ATOM, 'a_DOE'], [$ATOM, 'a_D3']],
                           [$AND, [$ATOM, 'l_DOE'], [$ATOM, 'l_D3']]]] },
      x_D3w => {},
      x_D4r => { ncct => [$IOR,
                          [$NOT, [$IOR, [$ATOM, 'a_DOE'], [$ATOM, 'l_DOE']]],
                          [$IOR,
                           [$AND, [$ATOM, 'a_DOE'], [$ATOM, 'a_D4']],
                           [$AND, [$ATOM, 'l_DOE'], [$ATOM, 'l_D4']]]] },
      x_D4w => {},
      x_D5r => { ncct => [$IOR,
                          [$NOT, [$IOR, [$ATOM, 'a_DOE'], [$ATOM, 'l_DOE']]],
                          [$IOR,
                           [$AND, [$ATOM, 'a_DOE'], [$ATOM, 'a_D5']],
                           [$AND, [$ATOM, 'l_DOE'], [$ATOM, 'l_D5']]]] },
      x_D5w => {},
      x_D6r => { ncct => [$IOR,
                          [$NOT, [$IOR, [$ATOM, 'a_DOE'], [$ATOM, 'l_DOE']]],
                          [$IOR,
                           [$AND, [$ATOM, 'a_DOE'], [$ATOM, 'a_D6']],
                           [$AND, [$ATOM, 'l_DOE'], [$ATOM, 'l_D6']]]] },
      x_D6w => {},
      x_D7r => { ncct => [$IOR,
                          [$NOT, [$IOR, [$ATOM, 'a_DOE'], [$ATOM, 'l_DOE']]],
                          [$IOR,
                           [$AND, [$ATOM, 'a_DOE'], [$ATOM, 'a_D7']],
                           [$AND, [$ATOM, 'l_DOE'], [$ATOM, 'l_D7']]]] },
      x_D7w => {},
      x_D8r => { ncct => [$IOR,
                          [$NOT, [$IOR, [$ATOM, 'a_DOE'], [$ATOM, 'l_DOE']]],
                          [$IOR,
                           [$AND, [$ATOM, 'a_DOE'], [$ATOM, 'a_D8']],
                           [$AND, [$ATOM, 'l_DOE'], [$ATOM, 'l_D8']]]] },
      x_D8w => {},
      x_D9r => { ncct => [$IOR,
                          [$NOT, [$IOR, [$ATOM, 'a_DOE'], [$ATOM, 'l_DOE']]],
                          [$IOR,
                           [$AND, [$ATOM, 'a_DOE'], [$ATOM, 'a_D9']],
                           [$AND, [$ATOM, 'l_DOE'], [$ATOM, 'l_D9']]]] },
      x_D9w => {},
      x_DTACK => { ncct => [$ATOM, 'a_DTACKOUT_PIN'] },
      x_EXACK => {},
      x_EXPCL => { ncct => [$ATOM, 'a_EXPCLOUT'] },
      x_EXREQ => { ncct => [$ATOM, 'a_EXREQOUT'] },
      x_EXRESET => {},
      x_HSYNC => {},
      x_IACK2 => {},
      x_IACK4 => {},
      x_LDS => {},
      x_R_W_ => {},
      x_UDS => {},
      x_VDISP => {},
      x_VSYNC => {},

      #X1,X2,X3
      o_X1 => {},
      o_X2 => {},
      o_X3 => {},

      #TC9245F
      t_DATA => { ncct => [$ATOM, '0'] },
      t_ERROR => { ncct => [$ATOM, '0'] },
      t_FS1 => { ncct => [$ATOM, '0'] },
      t_FS2 => { ncct => [$ATOM, '0'] },
      t_FS384 => { ncct => [$ATOM, '0'] },
      t_LRCK => { ncct => [$ATOM, '0'] },

      #JP2,JP3
      j_J2 => { ncct => [$ATOM, 'x_IACK2'] },
      j_J3 => { ncct => [$ATOM, '0'] },

      #YMF288 MASTER
      m_IRQ => { ncct => [$ATOM, '0'] },
      m_LRO => { ncct => [$ATOM, '0'] },

      #YMF288 SLAVE
      s_LRO => { ncct => [$ATOM, '0'] },

    };

    #単項
    sub parse_unary {
      my ($s) = @_;
      if ($s =~ /^\s*(\w+)/) {  #数値とシンボル
        $s = $';
        return ([$ATOM, $1], $s);
      } elsif ($s =~ /^\s*\(/) {  #括弧
        $s = $';
        my ($v, $t) = parse_ior ($s);
        $t =~ /^\s*\)/ or die $t;
        $t = $';
        return ($v, $t);
      } elsif ($s =~ /^\s*\!/) {  #論理否定
        $s = $';
        my ($v, $t) = parse_unary ($s);
        return ([$NOT, $v], $t);
      } else {
        die $s;
      }
    }

    #論理積
    sub parse_and {
      my ($s) = @_;
      my ($v, $t) = parse_unary ($s);
      $t =~ /^\s*\&/ or return ($v, $t);
      my $w = [$AND, $v];
      do {
        $t = $';
        ($v, $t) = parse_unary ($t);
        push @$w, $v;
      } while ($t =~ /^\s*\&/);
      return ($w, $t);
    }

    #排他的論理和
    sub parse_eor {
      my ($s) = @_;
      my ($v, $t) = parse_and ($s);
      $t =~ /^\s*\$/ or return ($v, $t);
      my $w = [$EOR, $v];
      do {
        $t = $';
        ($v, $t) = parse_and ($t);
        push @$w, $v;
      } while ($t =~ /^\s*\$/);
      return ($w, $t);
    }

    #包含的論理和
    sub parse_ior {
      my ($s) = @_;
      my ($v, $t) = parse_eor ($s);
      $t =~ /^\s*\#/ or return ($v, $t);
      my $w = [$IOR, $v];
      do {
        $t = $';
        ($v, $t) = parse_eor ($t);
        push @$w, $v;
      } while ($t =~ /^\s*\#/);
      return ($w, $t);
    }

    #組み合わせ回路を文字列から木構造に変換する
    sub parse {
      my ($s) = @_;
      my ($v, $t) = parse_ior ($s);
      $t =~ /^\s*$/ or die $t;
      return $v;
    }

    my $symbol_to_signal = {};

    #組み合わせ回路を木構造からC言語に変換する
    sub generate {
      my ($symbol, $v) = @_;
      my $type = $v->[0];
      if ($type == $ATOM) {  #数値とシンボル
        my $s = $v->[1];
        if ($s !~ /^\d/) {
          my $up_symbol = $s;
          my $up_signal = $symbol_to_signal->{$up_symbol};
          my $up_type = $up_signal->{'type'};
          if ($up_type == $IOPIN &&  #参照先がIOPINかつ
              (ord $symbol) ne (ord $up_symbol)) {  #参照元と参照先のグループが異なるとき
            $s .= '->out';
          } else {  #さもなくば
            $s .= '->val';
          }
        }
        return $s;
      } elsif ($type == $NOT) {  #論理否定
        my $s = '!';
        $v->[1]->[0] < $NOT or $s .= '(';
        $s .= generate ($symbol, $v->[1]);
        $v->[1]->[0] < $NOT or $s .= ')';
        return $s;
      } else {  #論理積と排他的論理和と包含的論理和
        my $s = '';
        for (my $i = 1; $i < @$v; $i++) {
          $i == 1 or $s .= ($type == $AND ? ' && ' :
                            $type == $EOR ? ' != ' :
                            $type == $IOR ? ' || ' :
                            die $type);
          $v->[$i]->[0] <= $NOT or $s .= '(';
          $s .= generate ($symbol, $v->[$i]);
          $v->[$i]->[0] <= $NOT or $s .= ')';
        }
        return $s;
      }
    }

    sub collect {
      my ($v) = @_;
      my @v = @$v;
      my $type = shift @v;
      if ($type == $ATOM) {  #数値とシンボル
        my $s = shift @v;
        return $s =~ /^\d/ ? () : ($s);
      }
      (map { collect ($_) } @v);
    }

    sub depth {
      my ($v) = @_;
      my @v = @$v;
      my $type = shift @v;
      if ($type == $ATOM) {
        return 0;
      }
      my $d = 0;
      while (@v) {
        my $e = depth (shift @v);
        $d < $e and $d = $e;
      }
      $d + 1;
    }

    {
      #  signal
      #    symbol
      #    cct  node
      #      occt  iopin
      #      rcct  reg
      #    dcct  iopin
      #    ccct  reg
      foreach my $module_name ('artemis', 'lunar') {
        my $module_head = substr $module_name, 0, 1;
        my $file_name = "$module_name.abl.txt";
        open IN, '<:encoding(utf8)', $file_name or die "cannot open $file_name to read";
        my $body = join '', <IN>;
        close IN;
        while ($body ne '') {
          if ($body =~ /^\s+/) {
            $body = $';
            next;
          }
          if ($body =~ /^(?:\/\/|\")/) {
            $body =~ /(?:\r?\n|$)/;
            $body = $';
            next;
          }
          if ($body =~ /^(?:end|equations|module|title)/i) {
            $body =~ /(?:\r?\n|$)/;
            $body = $';
            next;
          }
          if ($body =~ /^plsi/i) {
            $body =~ /(?:;|$)/;
            $body = $';
            next;
          }
          if ($body =~ /^!?[A-Z_a-z]\w*(?:\s*,\s*!?[A-Z_a-z]\w*)*\s+(?:node|pin)/i) {
            $body =~ /(?:;|$)/;
            $body = $';
            next;
          }
          if ($body =~ /^(?<symbol>[A-Z_a-z]\w*)(?<mode>\.clk|\.oe)?\s*:?=/) {
            my $symbol = $+{'symbol'};
            my $mode = $+{'mode'} // '';
            $body = $';
            $body =~ /(?:;|$)/;
            my $cct = $`;
            $body = $';
            $symbol = $module_head . '_' . $symbol;
            $cct =~ s/\s+//g;
            $cct =~ s/[A-Z_a-z]\w*/$module_head . '_' . $&/eg;
            my $signal;
            if (exists $symbol_to_signal->{$symbol}) {
              $signal = $symbol_to_signal->{$symbol};
            } else {
              $signal = $symbol_to_signal->{$symbol} = {
                symbol => $symbol,
              };
            }
            #回路をcct,dcct,ccctのいずれかに入れる
            if ($mode eq '.oe') {
              exists $signal->{'dcct'} and die;
              $signal->{'dcct'} = parse ($cct);
            } elsif ($mode eq '.clk') {
              exists $signal->{'ccct'} and die;
              $signal->{'ccct'} = parse ($cct);
            } else {
              exists $signal->{'cct'} and die;
              $signal->{'cct'} = parse ($cct);
            }
            #回路で使われているシンボルがなければ作る
            foreach my $symbol2 ($cct =~ /([A-Z_a-z]\w*)/g) {
              if (!exists $symbol_to_signal->{$symbol2}) {
                $symbol_to_signal->{$symbol2} = {
                  symbol => $symbol2,
                };
              }
            }
            next;
          }
          die;
        }
      }
      #cctをncct,occt,rcctに振り分ける
      foreach my $symbol (sort { $a cmp $b } keys %$symbol_to_signal) {
        my $signal = $symbol_to_signal->{$symbol};
        exists $signal->{'cct'} or next;
        if (exists $signal->{'dcct'}) {  #入出力ピン
          $signal->{'occt'} = $signal->{'cct'};
          delete $signal->{'cct'};
        } elsif (exists $signal->{'ccct'}) {  #レジスタ
          $signal->{'rcct'} = $signal->{'cct'};
          delete $signal->{'cct'};
        } else {  #ノード、入力ピン、出力ピン
          $signal->{'ncct'} = $signal->{'cct'};
          delete $signal->{'cct'};
        }
      }
      #ノードと回路を追加する
      foreach my $symbol (sort { $a cmp $b } keys %$ADDITION) {
        my $addition = $ADDITION->{$symbol};
        $addition or next;
        exists $symbol_to_signal->{$symbol} or $symbol_to_signal->{$symbol} = {};
        my $signal = $symbol_to_signal->{$symbol};
        foreach my $key (sort { $a cmp $b } keys %$addition) {
          exists $signal->{$key} and die "$symbol $key";
          $signal->{$key} = $addition->{$key};
        }
      }
      #回路の組み合わせを確認する
      foreach my $symbol (sort { $a cmp $b } keys %$symbol_to_signal) {
        my $signal = $symbol_to_signal->{$symbol};
        if ((!exists $signal->{'ccct'}) &&
            (!exists $signal->{'dcct'}) &&
            (!exists $signal->{'icct'}) &&
            (!exists $signal->{'occt'}) &&
            (!exists $signal->{'ncct'}) &&
            (!exists $signal->{'rcct'})) {  #ポート
          $signal->{'type'} = $PORT
        } elsif ((!exists $signal->{'ccct'}) &&
                 (!exists $signal->{'dcct'}) &&
                 (!exists $signal->{'icct'}) &&
                 (!exists $signal->{'occt'}) &&
                 (exists $signal->{'ncct'}) &&
                 (!exists $signal->{'rcct'})) {  #ノード、入力ピン、出力ピン
          $signal->{'type'} = $NODE;
        } elsif ((!exists $signal->{'ccct'}) &&
                 (exists $signal->{'dcct'}) &&
                 (exists $signal->{'icct'}) &&
                 (exists $signal->{'occt'}) &&
                 (!exists $signal->{'ncct'}) &&
                 (!exists $signal->{'rcct'})) {  #入出力ピン
          $signal->{'type'} = $IOPIN;
        } elsif ((exists $signal->{'ccct'}) &&
                 (!exists $signal->{'dcct'}) &&
                 (!exists $signal->{'icct'}) &&
                 (!exists $signal->{'occt'}) &&
                 (!exists $signal->{'ncct'}) &&
                 (exists $signal->{'rcct'})) {  #レジスタ
          $signal->{'type'} = $REG;
        } else {
          die $symbol;
        }
      }
      #シンボル毎に直下のシンボルの集合を作る
      #  すべてのシンボルについて
      #    rcctを除くすべての回路について
      #      回路に含まれる自分以外のすべてのシンボルについて
      #        そのシンボルの直下のシンボルの集合に自分を加える
      foreach my $symbol (sort { $a cmp $b } keys %$symbol_to_signal) {  #すべてのシンボルについて
        my $head = substr $symbol, 0, 1;
        my $signal = $symbol_to_signal->{$symbol};
        foreach my $prefix ('c', 'd', 'i', 'n', 'o') {  #'r'を除く
          my $Xcct = "${prefix}cct";
          my $Xdown = "${prefix}down";
          exists $signal->{$Xcct} or next;
          my $cct = $signal->{$Xcct};
          foreach my $up_symbol (collect ($cct)) {  #回路に含まれる自分以外のすべてのシンボルについて
            $up_symbol ne $symbol or next;
            my $up_head = substr $up_symbol, 0, 1;
            my $up_signal = $symbol_to_signal->{$up_symbol};
            exists $up_signal->{$Xdown}->{$symbol} or $up_signal->{$Xdown}->{$symbol} = {};
            $up_signal->{$Xdown}->{$symbol} = 1;  #そのシンボルの直下のシンボルの集合に自分を加える
          }
        }
      }
      #  downをHASHからARRAYに変更する
      foreach my $symbol (sort { $a cmp $b } keys %$symbol_to_signal) {
        my $signal = $symbol_to_signal->{$symbol};
        foreach my $prefix ('c', 'd', 'i', 'n', 'o') {  #'r'を除く
          my $Xdown = "${prefix}down";
          exists $signal->{$Xdown} or next;
          $signal->{$Xdown} = [sort { $a cmp $b } keys %{$signal->{$Xdown}}];
        }
      }
      #コードを生成する
      #宣言
      foreach my $symbol (sort { $a cmp $b } keys %$symbol_to_signal) {
        my $signal = $symbol_to_signal->{$symbol};
        my $simbol = $signal->{'symbol'};
        print "node_t *$symbol;\n";
      }
      #回路
      foreach my $symbol (sort { $a cmp $b } keys %$symbol_to_signal) {
        my $signal = $symbol_to_signal->{$symbol};
        foreach my $prefix ('c', 'd', 'i', 'n', 'o', 'r') {
          my $Xcct = "${prefix}cct";
          exists $signal->{$Xcct} or next;
          my $cct = $signal->{$Xcct};
          if ($cct) {
            my $code = generate ($symbol, $cct);
            print "_Bool ${symbol}_$Xcct () {\n";
            print "  return $code;\n";
            print "}\n";
          } else {
            print "_Bool ${symbol}_$Xcct ();  //to be defined later\n";
          }
        }
      }
      #直下のシンボル
      foreach my $symbol (sort { $a cmp $b } keys %$symbol_to_signal) {
        my $signal = $symbol_to_signal->{$symbol};
        foreach my $prefix ('c', 'd', 'i', 'n', 'o') {  #'r'を除く
          my $Xdown = "${prefix}down";
          exists $signal->{$Xdown} or next;
          my $count_plus_1 = @{$signal->{$Xdown}} + 1;
          print "node_t *${symbol}_${Xdown}[$count_plus_1];\n";
        }
      }
      #初期化
      print "void create_nodes () {\n";
      #  ノードを作る
      print "  node_count = 0;\n";
      foreach my $symbol (sort { $a cmp $b } keys %$symbol_to_signal) {
        my $signal = $symbol_to_signal->{$symbol};
        if ($signal->{'type'} == $PORT) {
          print "  $symbol = new_port (\"$symbol\"";
          print ", 0";
          print ");\n";
        } elsif ($signal->{'type'} == $NODE) {
          my $ncct = $signal->{'ncct'};
          my $ndpt = depth ($ncct);
          print "  $symbol = new_node (\"$symbol\"";
          if ($ncct->[0] == $ATOM && $ncct->[1] eq '1') {
            print ", 1";  #定数のとき一度も評価されないので式が1を返しても値が1にならない
          } else {
            print ", 0";
          }
          print ", ${symbol}_ncct, $ndpt";
          print ");\n";
        } elsif ($signal->{'type'} == $IOPIN) {
          my $ddpt = depth ($signal->{'dcct'});
          my $idpt = depth ($signal->{'icct'});
          my $odpt = depth ($signal->{'occt'});
          print "  $symbol = new_iopin (\"$symbol\"";
          print ", 0";
          print ", ${symbol}_dcct, $ddpt";
          print ", ${symbol}_icct, $idpt";
          print ", ${symbol}_occt, $odpt";
          print ");\n";
        } elsif ($signal->{'type'} == $REG) {
          my $cdpt = depth ($signal->{'ccct'});
          my $rdpt = depth ($signal->{'rcct'});
          print "  $symbol = new_reg (\"$symbol\"";
          print ", 0";
          print ", ${symbol}_ccct, $cdpt";
          print ", ${symbol}_rcct, $rdpt";
          print ");\n";
        } else {
          die;
        }
      }
      #  直下のノードの集合を作る
      foreach my $symbol (sort { $a cmp $b } keys %$symbol_to_signal) {
        my $signal = $symbol_to_signal->{$symbol};
        foreach my $prefix ('c', 'd', 'i', 'n', 'o') {  #'r'を除く
          my $Xdown = "${prefix}down";
          exists $signal->{$Xdown} or next;
          my $down = $signal->{$Xdown};
          my $count = @$down;
          for (my $i = 0; $i < $count; $i++) {
            print "  ${symbol}_${Xdown}[$i] = $down->[$i];\n";
          }
          print "  ${symbol}_${Xdown}[$count] = NULL;\n";
          print "  $symbol->$Xdown = ${symbol}_$Xdown;\n";
        }
      }
      print "}\n";
      #  すべてのポートに0を入力するイベントを作成する
      print "void input_zeros () {\n";
      foreach my $symbol (sort { $a cmp $b } keys %$symbol_to_signal) {
        my $signal = $symbol_to_signal->{$symbol};
        $signal->{'type'} == $PORT or next;
        print "  add_event (event_time + GATE_DELAY, $symbol, VAL, 0);\n";
      }
      print "}\n";
    }

STUDIO KAMADA
Copyright © 1999-2026 Makoto Kamada