quartus/server.tcl

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 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
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
###############################################################################
# Copyright (c) 2011-2024 by Altair Engineering, Inc.
# All rights reserved.
#
# Altair Engineering, Inc. makes this software available as part of the Vision
# tool platform.  As long as you are a licensee of the Vision tool platform
# you may make copies of the software and modify it to be used within the
# Vision tool platform, but you must include all of this notice on any copy.
# Redistribution without written permission to any third party, with or
# without modification, is not permitted.
# Altair Engineering, Inc. does not warrant that this software is error free
# or fit for any purpose.  Altair Engineering, Inc. disclaims any liability for
# all claims, expenses, losses, damages and costs any user may incur as a
# result of using, copying or modifying the software.
# =============================================================================
#   @userware
#       Quartus Link Server
#   @section
#       Link to Other Tools
#   @description
#       IMPORTANT: The script `quartus/server.tcl` is NOT a *Vision Userware.
#
#       It is a Tcl script that can be executed in Altera's Quartus/TimeQuest
#       tools to evaluate Tcl commands in the Quartus environment. The script
#       `quartus/client.tcl` is a *Vision Userware and implements the client
#       side.
#
#       Because quartus has no TCL main loop, vwait is used to
#       process incoming data (and freeze gui) until Server:Shutdown
#       is evaluated.
#   @files
#       quartus/server.tcl
#       quartus/client.tcl
#   @tag
#       rtl verilog fpga
###############################################################################


# =============================================================================
# Initialize the (private) Server array variables.
# =============================================================================
#
set Server(portno) 9999


# =============================================================================
# AcceptCB -
# =============================================================================
#
proc Server:AcceptCB {sock addr port} {
    global Server

    if { $Server(accepted) } {
        puts "$sock already serving."
        close $sock
        return
    }
    set Server(accepted) 1
    puts "accepted $sock from $addr"
    chan configure $sock -buffering line
    #checker exclude warnStyleCodeBlock
    #checker exclude warnStyleCodeBlockShort
    chan event $sock readable [list Server:ExecCB $sock]
}


# =============================================================================
# Close -
# =============================================================================
#
proc Server:Close {sock} {
    global Server

    puts "closing $sock connection."
    catch { close $sock }
    set Server(accepted) 0
}


# =============================================================================
# Shutdown -
# =============================================================================
#
proc Server:Shutdown {} {
    global Server

    puts "shutdown server."
    catch { close $Server(socket) }
    set Server(socket) {}  ;# exit vwait
}


# =============================================================================
# ExecCB -
# =============================================================================
#
proc Server:ExecCB {sock} {
    if {[eof $sock]} {
        Server:Close $sock
        return
    }

    if {[catch {gets $sock line} err]} {
        puts "Error: $err"
        Server:Close $sock
        return
    }

    ##
    # replace %s with actual socket
    #
    set line [string map [list %s $sock] $line]

    puts "evaluating: >>$line<<"
    if {[catch {uplevel #0 $line} result]} {
        puts "error $result"
        set result [string map {\n { }} $result]
        catch { puts $sock "error \{$result\}" }
    }

    ##
    # close socket to signal client the end of current command
    #
    Server:Close $sock
}


# =============================================================================
# Start -
# =============================================================================
#
proc Server:Start {port} {
    global Server

    set Server(socket) [socket -server Server:AcceptCB $port]
    set Server(accepted) 0
    vwait Server(socket)
}


##
#
#
Server:Start $Server(portno)