package provide ServerAccess 2.0


set ServerAccessTrace 0
set MIDASAccessServer "Undefined"
set LastSOAPMethodName "Undefined"

if {[info commands __eg__] == "" && [info commands eg] == "eg"} then {rename eg __eg__} ;# rename original eg  library command once 

proc eg {arg} {
    global ServerAccessTrace MIDASAccessServer

#    this takes the old EG command argument string and converts into the new format

   if {$ServerAccessTrace} {insert-debug "eg received args $arg"}

   set Arg [string range $arg 1 [expr [string length $arg]-2]]  ;#   remove outer ()s 

   set Querys 0
   set Actions 0
   set Values 0
   set Names 0
   set Patterns 0
   set Paths 0
   set Classes 0
   set Objects 0

   set Action ""
   set Query ""
   set Execute ""
   set Name ""
   set Class ""
   set Value ""

   switch [first $Arg] {

       register {

          set Cmd [regsub -all ' [tail $Arg] \"]      ;#    We need to replace ' characters in the old syntax with " characters

          set i 0
          while {$i < [llength $Cmd]} {
            set p [lindex $Cmd $i]
            incr i

            switch $p {

                :name     {set Name [lindex $Cmd $i]; incr Names; incr i}
                :pattern  {set Name [lindex $Cmd $i]; incr Patterns; incr i}
                :class    {set Class [lindex $Cmd $i]; incr Classes; incr i}

                :timeout  {incr i}

                :value    {set Execute $p; set Value "[lindex $Cmd $i]"; incr Values; incr i}
                :object   {set Execute $p; set Value "[lindex $Cmd $i]"; incr Objects; incr i}

                ?names  -
                ?value -
                ?names-and-values -
                ?object -
                ?names-and-objects -
                ?names-and-classes -
                ?class    {set Query $p; incr Querys}

                !new -
                !delete -
                !initialise -
                !ping     {set Action $p; incr Actions;}

                default {error 0x2000e "Invalid token: $p"}
            }
          }

          if {$Actions > 1} {error 0x2000e "More than 1 action token: $Cmd"}
          if {$Querys > 1} {error 0x2000e "More than 1 query token: $Cmd"}
          if {[expr $Actions + $Querys + $Values +$Objects] != 1} {error 0x2000e "Command structure error: $Cmd"}

          if {[expr $Names + $Patterns] != 1} {error 0x2000e "Command structure error: $Cmd"}

          if {$Classes > 1} {error 0x2000e "More than 1 :class token: $Cmd"}
          if {$Objects > 1} {error 0x2000e "More than 1 :object token: $Cmd"}
          if {$Values > 1}  {error 0x2000e "More than 1 :value token: $Cmd"}

          if {[expr $Actions + $Querys] == 0 && [expr $Values + $Objects] != 1} {error 0x2000e "Command structure error: $Cmd"}


#    look at :name or :pattern token (one must be present) and extract the server

          if {[llength [split $Name /]] == 3} then {     ;#  format is  /server/register
              set server [second [split $Name /]]
              set register [third [split $Name /]]
          } else {
              set server $MIDASAccessServer              ;#  default
              set register $Name
          }

          switch $Action {

             !new {
                 if {[expr $Names + $Classes] != 2} {error 0x2000e "Command structure error: $Cmd" }
                 set rc [MIDASDefineRegister /$server/$register $Class ""]
                 if {[first $rc] != 0} then {error [first $rc] "[second $rc]"} else {return 0}
             }

             !delete {
                 if {$Names == 1} then {
                     set rc [MIDASDeleteRegister /$server/$register]
                     if {[first $rc] != 0} then {error [first $rc] "[second $rc]"} else {return 0}
                 } else {
                     set rc [MIDASDeleteRegisters /$server/$register]
                     return 0
                 }
             }

             !initialise {
                 if {$Names == 1} then {
                     set rc [MIDASInitialiseRegister /$server/$register]
                     if {[first $rc] != 0} then {error [first $rc] "[second $rc]"} else {return 0}
                 } else {
                     set rc [MIDASInitialiseRegisters /$server/$register]
                     return 0
                 }

             }

             !ping {return 0}
          }

          switch $Query {

              ?names {
                  set rc [MIDASInquireRegisters /$server/$register]
                  if {[head $rc] != 0} then {error [first $rc] "[second $rc]"} else {return [tail $rc]}
              }

              ?value {
                  set rc [MIDASReadRegister /$server/$register]
                  if {[head $rc] != 0} then {error [first $rc] "[second $rc]"} else {return [tail $rc]}
              }

              ?object {
                  set rc [MIDASReadRegisterAttributes /$server/$register]
                  if {[head $rc] != 0} then {error [first $rc] "[second $rc]"} else {return [tail $rc]}
              }

              ?class {
                  set rc [MIDASReadRegisterClass /$server/$register]
                  if {[head $rc] != 0} then {error [first $rc] "[second $rc]"} else {return [tail $rc]}
              }

              ?names-and-values {
                  set rc [MIDASReadRegisters /$server/$register]
                  if {[head $rc] != 0} then {error [first $rc] "[second $rc]"} else {
                      if {[llength [tail $rc]] == 1} then {return [first [tail $rc]]} else {return [tail $rc]}
                  }
              }

              ?names-and-objects {
                  set rc [MIDASReadRegistersAttributes /$server/$register]
                  if {[head $rc] != 0} then {error [first $rc] "[second $rc]"} else {
                      if {[llength [tail $rc]] == 1} then {return [first [tail $rc]]} else {return [tail $rc]}
                  }
              }

              ?names-and-classes {
                  set rc [MIDASReadRegistersClasses /$server/$register]
                  if {[head $rc] != 0} then {error [first $rc] "[second $rc]"} else {
                      if {[llength [tail $rc]] == 1} then {return [first [tail $rc]]} else {return [tail $rc]}
                  }
              }

          }

          switch $Execute {

              :value {
                 if {$Names == 1} then {
                     set rc [MIDASWriteRegister /$server/$register $Value]
                     if {[first $rc] != 0} then {error [first $rc] "[second $rc]"} else {return 0}
                 } else {
                     set rc [MIDASWriteRegisters /$server/$register $Value]
                     return 0
                 }

              }

              :object {                       ;#    process $Value (the attributes) so that -a0x1234 => -a 0x1234
                 set attributes ""
                 foreach vl $Value {
                     if {[string equal -length 1 $vl "-"]} then {
                         append attributes " [string range $vl 0 1] [string range $vl 2 end]"
                     } else {
                         append attributes " $vl"
                     }
                 }
                 if {$Names == 1} then {
                     set rc [MIDASWriteRegisterAttributes /$server/$register $attributes]
                     if {[first $rc] != 0} then {error [first $rc] "[second $rc]"} else {return 0}
                 } else {
                     set rc [MIDASWriteRegistersAttributes /$server/$register $attributes]
                     return 0
                 }

              }

          }

          error 0x2000e    ;#   We should never get here!

       }

       tape {__eg__ "$arg"}

       spectrum {__eg__ "$arg"}

       default {__eg__ "$arg"}

   }

}


#    Error messages for EG  -  taken from eglib.h   (some messages not applicable to register access are omitted)

set EGerrInfoMsg(0) "OK"   ;#  So we can use same code for a good return

set EGerrInfoMsg(0x10001) "Not yet implemented"
set EGerrInfoMsg(0x10002) "No suitable resource claimed"
set EGerrInfoMsg(0x10003) "Name or pattern too long"
set EGerrInfoMsg(0x10004) "Register not known"
set EGerrInfoMsg(0x10008) "No experiment connected"
set EGerrInfoMsg(0x10015) "Cannot create RPC client"
set EGerrInfoMsg(0x1001c) "No reply from ping attempt"

set EGerrInfoMsg(0x20001) "Resource not known"
set EGerrInfoMsg(0x20002) "Resource already in use"
set EGerrInfoMsg(0x20003) "Capability invalid"
set EGerrInfoMsg(0x20004) "Register not known"
set EGerrInfoMsg(0x20005) "Types incompatible"
set EGerrInfoMsg(0x20006) "Register already defined"
set EGerrInfoMsg(0x20007) "Class not known"
set EGerrInfoMsg(0x20008) "Application not responding"
set EGerrInfoMsg(0x20009) "Invalid cookie"
set EGerrInfoMsg(0x2000a) "Application detected failure"
set EGerrInfoMsg(0x2000b) "Illegal register name"
set EGerrInfoMsg(0x2000c) "Out of memory"
set EGerrInfoMsg(0x2000d) "Count too small"
set EGerrInfoMsg(0x2000e) "Bad request"
set EGerrInfoMsg(0x2000f) "Invalid file name"

proc EGerrInfo {rc} {
    global EGerrInfoMsg

    if {[info exists EGerrInfoMsg($rc)]} then {return "$EGerrInfoMsg($rc)"} else {return "Unknown error"}
}

proc Obtain_SOAPservers {server register} {

#       We have a problem here because the RPC servers included multiple functions
#       For example the VME server also included  sigTask and generic (netvar) classes.
#       So
#           if the register name begins SigTask. then we look for a Role  SigTask before using the supplied server
#           if the register name begins NetVar. then we look for a Role  NetVar before using the supplied server
#           if the register name begins sigtask. then we look for server  sigtask before using the supplied server
#           if the register name begins netvar. then we look for a server netvar before using the supplied server

     if {[string equal -length 8 $register "SigTask."]} {
         set SOAPservers [inform ex obtain_SOAPServer_byRole "SigTask"]   ;# Role gets priority
         if {$SOAPservers != ""} {return [list "SigTask" $SOAPservers]}
     }
     if {[string equal -length 8 $register "sigtask."]} {
         set SOAPservers [inform ex obtain_SOAPServer_byName "sigtask"] 
         if {$SOAPservers != ""} {return [list "sigtask" $SOAPservers]}
     }

     if {[string equal -length 7 $register "NetVar."]} {
         set SOAPservers [inform ex obtain_SOAPServer_byRole "NetVar"]   ;# Role gets priority
         if {$SOAPservers != ""} {return [list "NetVar" $SOAPservers]}
     }
     if {[string equal -length 7 $register "netvar."]} {
         set SOAPservers [inform ex obtain_SOAPServer_byName "netvar"] 
         if {$SOAPservers != ""} {return [list "netvar" $SOAPservers]}
     }

#    end of special case checks

     set SOAPservers [inform ex obtain_SOAPServer_byRole $server]   ;# Role gets priority
     if {$SOAPservers != ""} {return [list $server $SOAPservers]}

     set SOAPservers [inform ex obtain_SOAPServer_byName $server]
     if {$SOAPservers != ""} {return [list $server $SOAPservers]}

     return ""     ;#  no suitable SOAP server found
}

proc MIDASRegisterAccess {Method Name args} {
    global MIDASAccessServer ServerAccessTrace LastSOAPMethodName

     if {$ServerAccessTrace} {insert-debug "MIDASRegisterAccess: $Method $Name NumArgs=[llength $args] Args=$args"}

#    look at the Name argument and split into server + register

      if {[llength [split $Name /]] == 3} then {     ;#  format is  /server/register
          set server [second [split $Name /]]
          set register [third [split $Name /]]
      } else {
          set server $MIDASAccessServer     ;#  default
          set register $Name
      }

#    start to determine the access method
#    server is either an apparatus Role or is the name of a specific apparatus

#    first try legacy RPC servers

     set RPCservers [inform ex obtain_RPCServer_byRole $server]   ;# Role gets priority
     if {$RPCservers == ""} then {set RPCservers [inform ex obtain_RPCServer_byName $server]}

#    then try SOAP/XML servers

     set SOAPservers [Obtain_SOAPservers $server $register]

     if {$SOAPservers == "" && $RPCservers == ""} {
         return -code error -errorcode 0x10002  -errorinfo "No suitable resource claimed"
     }

     if {$ServerAccessTrace} {insert-debug "RPCservers=$RPCservers; SOAPservers=$SOAPservers"}

     if {$SOAPservers == ""} then {    ;# if no SOAP servers use legacy RPC method

        if {$ServerAccessTrace} {insert-debug "Using RPC $Method /$server/$register $args"}

        switch $Method  {

            DefineRegister           {
                set z [catch {__eg__ "(register :name  '/$server/$register' :class '[first $args]' !new)"} reply]
                if {$z != 0} then {set rc [first $reply]; return code=error -errorcode $rc -errorInfo "[EGerrInfo $rc]"}
                if {[second $args] != ""} then {
                    set z [catch {__eg__ "(register :name '/$server/$register' :object '[second $args]')"} reply]
                }
                if {$z != 0} then {set rc [first $reply]; return code=error -errorcode $rc -errorInfo "[EGerrInfo $rc]"} else {return 0}
            }

            WriteRegister            {
                set z [catch {__eg__ "(register :name    '/$server/$register' :value  '[first $args]')"} reply]
                if {$z != 0} then {set rc [first $reply]; return code=error -errorcode $rc -errorInfo "[EGerrInfo $rc]"} else {return 0}
            }

            WriteRegisterAttributes  {
                set z [catch {__eg__ "(register :name    '/$server/$register' :object '[first $args]')"} reply]
                if {$z != 0} then {set rc [first $reply]; return code=error -errorcode $rc -errorInfo "[EGerrInfo $rc]"} else {return 0}
            }

            WriteRegisters           {
                set z [catch {__eg__ "(register :pattern '/$server/$register' :value  '[first $args]')"} reply]
                if {$z != 0} then {set rc [first $reply]; return code=error -errorcode $rc -errorInfo "[EGerrInfo $rc]"} else {return 0}
            }

            WriteRegistersAttributes {
                set z [catch {__eg__ "(register :pattern '/$server/$register' :object '[first $args]')"} reply]
                if {$z != 0} then {set rc [first $reply]; return code=error -errorcode $rc -errorInfo "[EGerrInfo $rc]"} else {return 0}
            }

            InitialiseRegister       {
                set z [catch {__eg__ "(register :name    '/$server/$register' !initialise)"} reply]
                if {$z != 0} then {set rc [first $reply]; return code=error -errorcode $rc -errorInfo "[EGerrInfo $rc]"} else {return 0}
            }

            DeleteRegister           {
                set z [catch {__eg__ "(register :name    '/$server/$register' !delete)"} reply]
                if {$z != 0} then {set rc [first $reply]; return code=error -errorcode $rc -errorInfo "[EGerrInfo $rc]"} else {return 0}
            }

            InitialiseRegisters      {
                set z [catch {__eg__ "(register :pattern '/$server/$register' !initialise)"} reply]
                if {$z != 0} then {set rc [first $reply]; return code=error -errorcode $rc -errorInfo "[EGerrInfo $rc]"} else {return 0}
            }

            DeleteRegisters          {
                set z [catch {__eg__ "(register :pattern '/$server/$register' !delete)"} reply]
                if {$z != 0} then {set rc [first $reply]; return code=error -errorcode $rc -errorInfo "[EGerrInfo $rc]"} else {return 0}
            }

            ReadRegister             {
                set z [catch {__eg__ "(register :name    '/$server/$register' ?value)"} reply]
                if {$z != 0} then {set rc [first $reply]; return code=error -errorcode $rc -errorInfo "[EGerrInfo $rc]"} else {return $reply}
            }

            ReadRegisterAttributes   {
                set z [catch {__eg__ "(register :name    '/$server/$register' ?object)"} reply]
                if {$z != 0} then {set rc [first $reply]; return code=error -errorcode $rc -errorInfo "[EGerrInfo $rc]"} else {return $reply}
            }

            ReadRegisterClass        {
                set z [catch {__eg__ "(register :name    '/$server/$register' ?class)"} reply]
                if {$z != 0} then {set rc [first $reply]; return code=error -errorcode $rc -errorInfo "[EGerrInfo $rc]"} else {return $reply}
            }

            InquireRegisters         {
                set z [catch {__eg__ "(register :pattern '/$server/$register' ?names)"} reply]
                if {$z != 0} then {set rc [first $reply]; return code=error -errorcode $rc -errorInfo "[EGerrInfo $rc]"} else {return reply}
            }

            ReadRegisters            {
                set z [catch {__eg__ "(register :pattern '/$server/$register' ?names-and-values)"} reply]
                if {$z != 0} then {set rc [first $reply]; return code=error -errorcode $rc -errorInfo "[EGerrInfo $rc]"} else {return $reply}
            }

            ReadRegistersAttributes  {
                set z [catch {__eg__ "(register :pattern '/$server/$register' ?names-and-objects)"} reply]
                if {$z != 0} then {set rc [first $reply]; return code=error -errorcode $rc -errorInfo "[EGerrInfo $rc]"} else {return $reply}
            }

            ReadRegistersClasses     {
                set z [catch {__eg__ "(register :pattern '/$server/$register' ?names-and-classes)"} reply]
                if {$z != 0} then {set rc [first $reply]; return code=error -errorcode $rc -errorInfo "[EGerrInfo $rc]"} else {return $reply}
            }

            ServerVerbose {}

            default {return -code error -errorcode 0x10001 -errorinfo "Internal logic error"}
        }

        return -code error -errorcode 0x10001 -errorinfo "Internal logic error"
     }


#    Try both RPC and SOAP servers as available

     set rc {}

     if {$RPCservers != ""} then {    ;#  first try RPC servers 

           if {$ServerAccessTrace} {insert-debug "Using RPC $Method /$server/$register $args"}

           switch $Method  {

               DefineRegister           {
                   set z [catch {__eg__ "(register :name  '/$server/$register' :class '[first $args]' !new)"} m]
                   if {$z == 0 && [second $args] != ""} then {
                       set z [catch {__eg__ "(register :name '/$server/$register' :object '[second $args]')"} m]
                   }
               }

               WriteRegister            {set z [catch {__eg__ "(register :name    '/$server/$register' :value  '[first $args]')"} m]}
               WriteRegisterAttributes  {set z [catch {__eg__ "(register :name    '/$server/$register' :object '[first $args]')"} m]}

               WriteRegisters           {set z [catch {__eg__ "(register :pattern '/$server/$register' :value  '[first $args]')"} m]}
               WriteRegistersAttributes {set z [catch {__eg__ "(register :pattern '/$server/$register' :object '[first $args]')"} m]}

               InitialiseRegister       {set z [catch {__eg__ "(register :name    '/$server/$register' !initialise)"} m]}
               DeleteRegister           {set z [catch {__eg__ "(register :name    '/$server/$register' !delete)"} m]}

               InitialiseRegisters      {set z [catch {__eg__ "(register :pattern '/$server/$register' !initialise)"} m]}
               DeleteRegisters          {set z [catch {__eg__ "(register :pattern '/$server/$register' !delete)"} m]}

               ReadRegister             {set z [catch {__eg__ "(register :name    '/$server/$register' ?value)"} m]}
               ReadRegisterAttributes   {set z [catch {__eg__ "(register :name    '/$server/$register' ?object)"} m]}
               ReadRegisterClass        {set z [catch {__eg__ "(register :name    '/$server/$register' ?class)"} m]}

               InquireRegisters         {set z [catch {__eg__ "(register :pattern '/$server/$register' ?names)"} m]}
               ReadRegisters            {set z [catch {__eg__ "(register :pattern '/$server/$register' ?names-and-values)"} m]}
               ReadRegistersAttributes  {set z [catch {__eg__ "(register :pattern '/$server/$register' ?names-and-objects)"} m]}
               ReadRegistersClasses     {set z [catch {__eg__ "(register :pattern '/$server/$register' ?names-and-classes)"} m]}

               ServerVerbose {}
           }


           switch $Method  {
                DefineRegister           -
                WriteRegister            -
                WriteRegisterAttributes  -
                InitialiseRegister       -
                DeleteRegister           {
                    if {$z == 0} then {return 0}   ;# done it and only one operation required
                    return code=error -errorcode $m -errorInfo "[EGerrInfo $m]"
                }

                WriteRegisters           -
                WriteRegistersAttributes -
                InitialiseRegisters      -
                DeleteRegisters          {
                    set rc 0
                }

                ReadRegister             -
                ReadRegisterAttributes   -
                ReadRegisterClass        {
                    if {$z == 0} then {return $m}   ;# done it and only one operation required
                    return code=error -errorcode $m -errorInfo "[EGerrInfo $m]"
                }

                InquireRegisters         -
                ReadRegisters            -
                ReadRegistersAttributes  -
                ReadRegistersClasses     {
                    if {$z == 0} then {lappend rc $reply}
                    return code=error -errorcode $m -errorInfo "[EGerrInfo $m]"
                }

                ServerVerbose {}
            }

         }   ;#  end of $RPCservers != ""


         foreach SOAPserver [tail $SOAPservers] {

             set Info   [inform ex obtain_SOAPServerInfo $SOAPserver [head $SOAPservers]]
             
#  example info     vme1 localhost:8015 VME VMEAccessServer VMEAccessServer VMEAccessClient

             set Class [lindex $Info 3]
             set Urn   [lindex $Info 4]
             set Cmd   [lindex $Info 5]

             if {$ServerAccessTrace} {insert-debug "Using SOAP  $SOAPserver $Cmd  $Method $Urn  $register  $args"}

             package require $Cmd

             SOAP::configure [set Cmd]__$Method -proxy "http://$SOAPserver/$Urn" -uri "urn:$Urn"
             set LastSOAPMethodName [set Cmd]__$Method


             switch $Method  {
                DefineRegister           {
                    set reply [[set Cmd]__$Method $register [first $args] [second $args]]
                }

                WriteRegister            -
                WriteRegisters           {
                    set reply [[set Cmd]__$Method $register "[first $args]"]
                }

                WriteRegisterAttributes  -
                WriteRegistersAttributes {
                    set reply [[set Cmd]__$Method $register "[first $args]"]
                }

                InitialiseRegister       -
                DeleteRegister           {
                    set reply [[set Cmd]__$Method $register]
                }

                InitialiseRegisters      -
                DeleteRegisters          {
                    set reply [[set Cmd]__$Method $register]
                }

                ReadRegister             -
                ReadRegisterAttributes   -
                ReadRegisterClass        {
                    set reply [[set Cmd]__$Method $register]
                }

                InquireRegisters         -
                ReadRegisters            -
                ReadRegistersAttributes  -
                ReadRegistersClasses     {
                    set reply [[set Cmd]__$Method $register]
                }

                ServerVerbose               {
                    set reply [[set Cmd]__$Method "[first $args]"]
                }
             }

             if {$ServerAccessTrace} {insert-debug "reply: $reply"}


           switch $Method  {
                DefineRegister           -
                WriteRegister            -
                WriteRegisterAttributes  -
                InitialiseRegister       -
                DeleteRegister           {
                    return $reply               ;# done it and only one operation required
                }


                ServerVerbose      -
                WriteRegisters           -
                WriteRegistersAttributes -
                InitialiseRegisters      -
                DeleteRegisters          {
                    set rc 0
                }

                ReadRegister             -
                ReadRegisterAttributes   -
                ReadRegisterClass        {
                    return $reply               ;# done it and only one operation required
                }

                InquireRegisters         -
                ReadRegisters            -
                ReadRegistersAttributes  -
                ReadRegistersClasses     {
                    lappend rc $reply
                }
            }

         }   ;#   end of  "foreach SOAPserver $SOAPservers"

     return $rc       ;#  done it
}


#    New style register access procedures
#      Name is of the form  /server/register   or    register
#      If omitted server defaults to to global variable MIDASAccessServer
#    In the event of an error being detected (which includes application detected errors) a Tcl error is generated
#    The global variables errorCode and errorInfo contain further information about the error

proc MIDASDeleteRegister            {Name}            {return [MIDASRegisterAccess DeleteRegister $Name]}
proc MIDASDeleteRegisters           {Name}            {return [MIDASRegisterAccess DeleteRegisters $Name]}
proc MIDASWriteRegister             {Name Value}      {return [MIDASRegisterAccess WriteRegister $Name "$Value"]}
proc MIDASWriteRegisters            {Name Value}      {return [MIDASRegisterAccess WriteRegisters $Name "$Value"]}
proc MIDASInitialiseRegister        {Name}            {return [MIDASRegisterAccess InitialiseRegister $Name]}
proc MIDASInitialiseRegisters       {Name}            {return [MIDASRegisterAccess InitialiseRegisters $Name]}
proc MIDASWriteRegisterAttributes   {Name Attributes} {return [MIDASRegisterAccess WriteRegisterAttributes $Name $Attributes]}
proc MIDASWriteRegistersAttributes  {Name Attributes} {return [MIDASRegisterAccess WriteRegistersAttributes $Name "$Attributes"]}
proc MIDASInquireRegisters          {Name}            {return [MIDASRegisterAccess InquireRegisters $Name]}
proc MIDASReadRegister              {Name}            {return [MIDASRegisterAccess ReadRegister $Name]}
proc MIDASReadRegisters             {Name}            {return [MIDASRegisterAccess ReadRegisters $Name]}
proc MIDASReadRegisterAttributes    {Name}            {return [MIDASRegisterAccess ReadRegisterAttributes $Name]}
proc MIDASReadRegistersAttributes   {Name}            {return [MIDASRegisterAccess ReadRegistersAttributes $Name]}
proc MIDASReadRegisterClass         {Name}            {return [MIDASRegisterAccess ReadRegisterClass $Name]}
proc MIDASReadRegistersClasses      {Name}            {return [MIDASRegisterAccess ReadRegistersClasses $Name]}
proc MIDASDefineRegister            {Name Class Attributes}  {return [MIDASRegisterAccess DefineRegister $Name $Class "$Attributes"]}
proc MIDASSetVerbose                {Name Value}      {return [MIDASRegisterAccess ServerVerbose $Name $Value]}