1 ; file: gnet-dbg-dmn.scm
  2 ; copyright (c) 2020 dmn <graahnul.grom@gmail.com>
  3 ; license: GPLv2+
  4 ;
  5 ; lepton-netlist backend for netlister testing
  6 ;
  7 ; - use as is: 'lepton-netlist -g dbg-dmn'
  8 ; - call individual funcs from this file:
  9 ;   ( primitive-load-path "gnet-dbg-dmn.scm" )
 10 ;
 11 
 12 ( use-modules ( netlist schematic ) )
 13 ( use-modules ( netlist schematic toplevel ) )
 14 ( use-modules ( netlist package ) )
 15 ( use-modules ( netlist schematic-component ) )
 16 ( use-modules ( netlist package-pin ) )
 17 ; ( use-modules ( netlist ) )
 18 
 19 ;
 20 ; NOTE: vim: hit ff on file name:
 21 ;   netlist.scm
 22 ;   package.scm
 23 ;   package-pin.scm
 24 ;
 25 
 26 ( define ( dbg-dmn output-filename ) ; backend entry point
 27     ( format #t " >> gnet-dbg-dmn():~%" )
 28     ; ( dbg-args )
 29     ( dbg-pkgs )
 30     ; ( dbg-attrs )
 31     ; ( dbg-nets )
 32     ( dbg-pins )
 33 )
 34 
 35 ( define ( request-netlist-mode ) ; called by netlister to set op mode
 36     ; return:
 37     ; 'geda
 38     'spice
 39 )
 40 
 41 
 42 
 43 ( define ( dbg-args )
 44     ( format #t " >> dbg-args():~%" )
 45     ( format #t "program-arguments():~%" )
 46     ( format #t "~{  ~a~%~}~%" (program-arguments) )
 47 )
 48 
 49 
 50 
 51 ( define ( dbg-pkgs )
 52 ( let*
 53     (
 54     ( TS    ( toplevel-schematic ) )
 55     ( pkgs  ( schematic-packages      TS ) ) ; => objects
 56     ( names ( schematic-package-names TS ) ) ; => refdes strings
 57     )
 58 
 59     ( format #t " >> dbg-pkgs():~%" )
 60     ( format #t "toplevel-schematic():       [~a]~%" TS )
 61     ( format #t "schematic-package-names(): ~{ ~a~}~%" names )
 62 
 63     ( format #t "~%" )
 64 
 65 ) ; let
 66 ) ; dbg-pkgs()
 67 
 68 
 69 
 70 ( define ( dbg-attrs )
 71 ( let*
 72     (
 73     ( TS   ( toplevel-schematic ) )
 74     ( pkgs ( schematic-packages TS ) )
 75     ; ( attrs ( package-attributes <pkg obj> 'source ) ) ; multi "source" attrs
 76     )
 77 
 78     ( define ( pa p a )
 79         ( package-attribute p a )
 80     )
 81 
 82     ( define ( pr p )
 83         ( package-refdes p )
 84     )
 85 
 86     ( define ( is_A p )
 87         ( string-prefix? "A" (pr p) )
 88     )
 89 
 90 
 91     ( format #t " >> dbg-attrs():~%" )
 92     ( for-each
 93     ( lambda( p )
 94         ( format #t "package-refdes():             [~a]~%" (pr p) )
 95 
 96         ( format #t "package-attribute( 'device ): [~a]~%" (pa p 'device) )
 97         ( format #t "package-attribute( 'file ):   [~a]~%" (pa p 'file) )
 98         ( format #t "package-attribute( 'author ): [~a]~%" (pa p 'author) )
 99     )
100     ( filter is_A pkgs )
101     )
102 
103     ( format #t "~%" )
104 
105 ) ; let
106 ) ; dbg-attrs()
107 
108 
109 
110 ( define ( dbg-nets )
111 ( let*
112     (
113     ( TS   ( toplevel-schematic ) )
114     ( nets ( schematic-nets TS ) )
115     )
116 
117     ( format #t " >> dbg-nets():~%" )
118     ( format #t "schematic-nets(): ~{ ~a~}~%" nets )
119 
120     ( format #t "~%" )
121 
122 ) ; let
123 ) ; dbg-nets()
124 
125 
126 
127 ( define ( dbg-pins )
128 ( let*
129     (
130     ( TS    ( toplevel-schematic ) )
131     ( comps ( schematic-components TS ) )
132     ( rd #f )
133     )
134 
135     ( define ( with_refdes c )
136         ( schematic-component-refdes c )
137     )
138 
139     ( define ( with_pins c )
140         ( not ( null? (schematic-component-pins c) ) )
141     )
142 
143     ( define ( not_gra c )
144         ( not (schematic-component-graphical? c) )
145     )
146 
147     ( define ( not_nc c )
148         ( not (schematic-component-nc? c) )
149     )
150 
151     ( define ( comp_ok c )
152         ( and
153             ( with_refdes c )
154             ( with_pins c )
155             ( not_gra c )
156             ( not_nc c )
157         )
158     )
159 
160     ( define ( pins_sort_by_pinseq pp ) ; pp: <package-pin> objs
161         ( define ( pin_pinseq_less p1 p2 )
162             ( <
163                 ( string->number (assoc-ref (package-pin-attribs p1) 'pinseq) )
164                 ( string->number (assoc-ref (package-pin-attribs p2) 'pinseq) )
165             )
166         )
167         ; return:
168         ( sort pp pin_pinseq_less )
169     )
170 
171     ( define ( dbg_print_pins pp )
172         ( for-each
173         ( lambda( p )
174             ( format #t "  pin: [~a]~%" p )
175             ( format #t
176                 "    lab: [~a]~%    seq: [~a]~%    num: [~a]~%"
177                 (assoc-ref (package-pin-attribs p) 'pinlabel)
178                 (assoc-ref (package-pin-attribs p) 'pinseq)
179                 (assoc-ref (package-pin-attribs p) 'pinnumber) )
180             ( format #t "    net: [~a] // <= package-pin-name( pinobj )~%"
181                 (package-pin-name p) )
182         )
183         pp
184         )
185     ) ; dbg_print_pins()
186 
187 
188     ;
189     ; TODO: discover:
190     ;   - <schematic-component>::net-maps
191     ;   - <package-pin>::<named-connection>
192     ;
193 
194     ( format #t " >> dbg-pins():~%" )
195     ( for-each
196     ( lambda( c )
197         ( set! rd ( schematic-component-refdes c ) )
198         ( format #t "schematic-component-refdes(): [~a]~%" rd )
199         ; ( dbg_print_pins (schematic-component-pins c) )
200         ( dbg_print_pins ( pins_sort_by_pinseq (schematic-component-pins c) ) )
201     )
202     ( filter comp_ok comps )
203     ; ( filter schematic-component-refdes comps )
204     ; comps
205     )
206 
207     ( format #t "~%" )
208 
209 ) ; let
210 ) ; dbg-pins()
211