Overview
Comment: | Some updates from code review |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.80 |
Files: | files | file ages | folders |
SHA1: |
448f45b91b3ce48a246f73f80677367e |
User & Date: | mrwellan on 2023-04-10 16:16:10 |
Other Links: | branch diff | manifest | tags |
Context
2023-04-10
| ||
19:36 | Improved run away server throttling check-in: 4115ca72bc user: matt tags: v1.80 | |
16:16 | Some updates from code review check-in: 448f45b91b user: mrwellan tags: v1.80 | |
11:58 | Merged fork check-in: 962cf22780 user: mrwellan tags: v1.80 | |
Changes
Modified tcp-transportmod.scm from [456ca5eb0a] to [4f582ce483].
︙ | ︙ | |||
152 153 154 155 156 157 158 | port: port host-port: host-port dbfname: dbfname servinf-file: servinffile server-id: server-id server-start: start-time pid: pid))) | < | > > | < | | 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 | port: port host-port: host-port dbfname: dbfname servinf-file: servinffile server-id: server-id server-start: start-time pid: pid))) ;; verify we can talk to this server (let* ((ping-res (tt:ping host port server-id))) (case ping-res ((running) (hash-table-set! (tt-conns ttdat) dbfname conn) ;;; is this ok to save before validating that the connection is good? conn) ((starting) (thread-sleep! 0.5) (tt:client-connect-to-server ttdat dbfname run-id testsuite)) (else (let* ((curr-secs (current-seconds))) ;; rm the (last server) would go here (if (> (- curr-secs (tt-last-serv-start ttdat)) 10) (begin (tt-last-serv-start-set! ttdat curr-secs) (server-start-proc))) ;; start server if 30 sec since last attempt (thread-sleep! 1) (tt:client-connect-to-server ttdat dbfname run-id testsuite))))))) (else ;; no good server found, if haven't started server in > 5 secs, start another (if (> (- (current-seconds) (tt-last-serv-start ttdat)) 5) ;; BUG - grow this number really do not want to swamp the machine with servers (begin (debug:print-info 0 *default-log-port* "No server found. Starting one for run-id "run-id" in dbfile "dbfname) (server-start-proc) (tt-last-serv-start-set! ttdat (current-seconds)))) (thread-sleep! 1) (tt:client-connect-to-server ttdat dbfname run-id testsuite))))))) |
︙ | ︙ | |||
742 743 744 745 746 747 748 | ;;====================================================================== ;; find a port and start tcp-server. This only starts the tcp portion of ;; the server, look at (tt:start-server ...) above for the entry point ;; for the entire server system ;; (define (tt:start-tcp-server ttdat) | | | | > | | | | | | | | | | | 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 | ;;====================================================================== ;; find a port and start tcp-server. This only starts the tcp portion of ;; the server, look at (tt:start-server ...) above for the entry point ;; for the entire server system ;; (define (tt:start-tcp-server ttdat) (setup-listener-portlogger ttdat) ;; set up tcp-listener (let* ((socket (tt-socket ttdat)) (handler (tt-handler ttdat)) ;; the handler comes from our client setting a handler function (handler-proc (lambda () (let* ((indat (deserialize)) (result #f) (exn-result #f) (stdout-result (with-output-to-string (lambda () (let ((res (handle-exceptions exn (let* ((errdat (condition->list exn))) (set! exn-result errdat) (debug:print 0 *default-log-port* "ERROR: handler exception, these are bad, will exit in five seconds.") (pp errdat *default-log-port*) ;; these are always bad, set up an exit thread (thread-start! (make-thread (lambda () (thread-sleep! 5) (exit)))) #f) (handler indat) ;; this is the proc being called by the remote client ))) (set! result res))))) (full-result (list result exn-result (if (equal? stdout-result "") #f stdout-result)))) (handle-exceptions exn (begin (debug:print 0 *default-log-port* "Serialization failure. full-result="full-result) ;; (serialize '(#f #f #f)) ;; doesn't work - the first call to serialize caused failure ) (serialize full-result)))))) ((make-tcp-server socket handler-proc) #f ;; yes, send error messages to std-err ))) ;; create a tcp listener and return a populated udat struct with ;; my port, address, hostname, pid etc. ;; return #f if fail to find a port to allocate. ;; ;; if udata-in is #f create the record ;; if there is already a serv-listener return the udata ;; ;; (define (setup-listener uconn #!optional (port 4242)) ;; (assert (tt? uconn) "FATAL: setup-listener called with wrong struct "uconn) ;; (handle-exceptions ;; exn ;; (if (< port 65535) ;; (begin ;; (thread-sleep! 0.25) ;; (setup-listener uconn (+ port 1))) ;; #f) ;; (connect-listener uconn port))) (define (setup-listener-portlogger uconn) (let ((port (portlogger:open-run-close portlogger:find-port))) (assert (tt? uconn) "FATAL: setup-listener called with wrong struct "uconn) (handle-exceptions exn (if (< port 65535) |
︙ | ︙ |
Modified utils/plot-code.scm from [2b6e0cd992] to [692dd68f5f].
︙ | ︙ | |||
21 22 23 24 25 26 27 | ;; Coming soon (right?) Usage: plot-code file1.scm,file2.scm "fun1,fun2,x*" *.scm > plot.dot ;; Usage: plot-code file1.scm,file2.scm *.scm > plot.dot ;; dot -Tpdf plot.dot > plot.pdf ;; first param is comma separated list of files to include in the map, use - to do all ;; second param is list of regexs for functions to include in the map ;; third param is list of files to scan | | > > > > > > > > | > > | > > > > > > > > > > > | | | | < | 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 | ;; Coming soon (right?) Usage: plot-code file1.scm,file2.scm "fun1,fun2,x*" *.scm > plot.dot ;; Usage: plot-code file1.scm,file2.scm *.scm > plot.dot ;; dot -Tpdf plot.dot > plot.pdf ;; first param is comma separated list of files to include in the map, use - to do all ;; second param is list of regexs for functions to include in the map ;; third param is list of files to scan ;; (use regex srfi-69 srfi-1 srfi-13) (module plot-code * (import scheme chicken.base chicken.port chicken.string chicken.io) (import chicken.process-context) (import regex srfi-1 srfi-69 srfi-13 matchable) (define files #f) (define targs #f) (define function-patt #f) (define targs #f) (match (command-line-arguments) ((targfiles fnrx . scanfiles) (set! targs (string-split-fields "," targfiles #:infix)) (set! function-patt fnrx) (set! files scanfiles)) (else (print "Usage: plot-code file1.scm,file2.scm *.scm > plot.dot dot -Tpdf plot.dot > plot.pdf") (exit))) ;; (define files (cdr (cddddr (argv)))) ;; ;; (let ((targdat (cadddr (argv)))) ;; (if (equal? targdat "-") ;; (set! targs files) ;; (set! targs (string-split targdat ",")))) (define function-rx (regexp function-patt)) (define filedat-defns (make-hash-table)) (define filedat-usages (make-hash-table)) (define defn-rx (regexp "^\\s*\\(define\\s+\\(([^\\s\\)]+).*")) (define all-regexs (make-hash-table)) |
︙ | ︙ | |||
195 196 197 198 199 200 201 | "\"" fnname "\" -> \"" callname "\";")) calls))) function-calls) (print "}") (exit) | > | 215 216 217 218 219 220 221 222 | "\"" fnname "\" -> \"" callname "\";")) calls))) function-calls) (print "}") (exit) ) |