#!/mit/perl5/bin/perl -w # # Perl script to generate a symbol table for use by get_symbol(). It should # be fed with the contents of the error table header files generated by # compile_et; these may either be specified on the command line or piped to # STDIN. It outputs the symbol table, created from the contents of the # afore-mentioned header files, and from data contained herein (see the # end of this file). Its output should be redirected into the file symbol.def, # for use with get_symbol. use strict; my @syms; # symbols... my %symt; # classification of those symbols (either INT or STR) @syms = (); while (<>) { # read input files.. next if (!/^\#define/); # Only the #define's, please my @tmp = (/^\#define\s+(\w+)/); # get symbol name... push @syms, $tmp[0]; # remember it... $symt{$tmp[0]} = 'INT'; # error tables are all ints close ARGV if ($tmp[0] =~ /ERROR_TABLE_BASE/); # end of part we want } while () { # read data at end of this file... my @tmp; # get next line, and if it's a comment or empty or does not match # this convoluted pattern, skip it. $tmp[0] == symbol's name, # $tmp[1] == symbol's type (INT or STR) next if (/^#/ || /^\s*$/ || !(@tmp = (/(\w+)\s+(\w+)/))); push @syms, $tmp[0]; # record symbol name... $symt{$tmp[0]} = $tmp[1]; # and type } @syms = sort @syms; # sort the symbols array... my $sym; ($sym, undef) = ($0 =~ /^(.*)\.pl$/); open(SYM, "> $sym"); foreach $sym (@syms) { # and print out the table print SYM "#ifdef $sym\n"; print SYM " TBL_$symt{$sym}($sym),\n"; print SYM "#endif /* $sym */\n"; } __DATA__ # data format: # # Obviously, comments are preceeded by '#'. Blank lines should be ignored, # and data is in the format # # SYMBOLNAME TYPE [VERSION] # # where TYPE may be one of INT or STR. The VERSION parameter, if provided, # is the applicable Athena version. # # This mechanism is used for data not stored in an error table file, such as # string constants defined in a header file, or flag values defined there. HM_SVCNAME STR HM_SRV_SVCNAME STR SERVER_SVCNAME STR SERVER_SERVICE STR SERVER_INSTANCE STR ZVERSIONHDR STR ZVERSIONMAJOR INT ZVERSIONMINOR INT Z_MAXPKTLEN INT Z_MAXHEADERLEN INT Z_MAXOTHERFIELDS INT Z_NUMFIELDS INT ZAUTH_FAILED INT ZAUTH_YES INT ZAUTH_NO INT UNSAFE INT UNACKED INT ACKED INT HMACK INT SERVACK INT SERVNAK INT CLIENTACK INT STAT INT Z_MAXQLEN INT ZERR_NONE INT # Other error codes are already taken care of... # Note this causes funny calling syntax, relative to Perl: functions # returning no error actually end up returning false values! HM_TIMEOUT INT SRV_TIMEOUT INT # natively, these are actually function pointers. Who wants to feed them # to Perl? I'll just write the appropriate glue to turn these integers # into the real function pointers. ZAUTH INT ZNOAUTH INT ZSRVACK_SENT STR ZSRVACK_NOTSENT STR ZSRVACK_FAIL STR ZEPHYR_ADMIN_CLASS STR ZEPHYR_CTL_CLASS STR ZEPHYR_CTL_REALM STR REALM_ADD_SUBSCRIBE STR REALM_REQ_SUBSCRIBE STR REALM_SUBSCRIBE STR REALM_UNSUBSCRIBE STR ZEPHYR_CTL_CLIENT STR CLIENT_SUBSCRIBE STR CLIENT_SUBSCRIBE_NODEFS STR CLIENT_UNSUBSCRIBE STR CLIENT_CANCELSUB STR CLIENT_GIMMESUBS STR CLIENT_GIMMEDEFS STR ZEPHYR_CTL_HM STR HM_BOOT STR HM_FLUSH STR HM_DETACH STR HM_ATTACH STR HM_CTL_CLASS STR SERVER_SHUTDOWN STR SERVER_PING STR HM_CTL_CLIENT STR CLIENT_FLUSH STR CLIENT_NEW_SERVER STR HM_STAT_CLASS STR HM_STAT_CLIENT STR HM_GIMMESTATS STR LOGIN_CLASS STR EXPOSE_NONE STR EXPOSE_OPSTAFF STR EXPOSE_REALMVIS STR EXPOSE_REALMANN STR EXPOSE_NETVIS STR EXPOSE_NETANN STR LOGIN_USER_LOGIN STR LOGIN_USER_LOGOUT STR LOGIN_USER_FLUSH STR LOCATE_CLASS STR LOCATE_HIDE STR LOCATE_UNHIDE STR LOCATE_LOCATE STR WG_CTL_CLASS STR WG_CTL_USER STR USER_REREAD STR USER_SHUTDOWN STR USER_STARTUP STR USER_EXIT STR PRED_UID INT PRED_MUID INT PRED_ALD INT ZN_VERSION_FLD STR ZN_KIND_FLD STR ZN_UID_FLD STR ZN_SENDADDR_FLD STR ZN_TIME_FLD STR ZN_PORT_FLD STR ZN_AUTH_FLD STR ZN_TARGETS_FLD STR ZN_OPCODE_FLD STR ZN_SENDER_FLD STR ZN_FORMAT_FLD STR ZN_MULTI_FLD STR ZN_MUID_FLD STR ZN_OTHER_FLD STR ZN_MESSAGE_FLD STR ZN_FROM_FLD STR