15.4.1586  src/lib/x-kit/xclient/src/iccc/atom-imp-old.pkg

## atom-imp-old.pkg
#
# A Client-side server for atoms.
#
# See also:
#
#     src/lib/x-kit/xclient/src/iccc/atom-old.pkg

# Compiled by:
#     src/lib/x-kit/xclient/xclient-internals.sublib



stipulate
    include package   threadkit;                                        # threadkit             is from   src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg
    #
    package xt  =  xtypes;                                              # xtypes                is from   src/lib/x-kit/xclient/src/wire/xtypes.pkg
    package xok =  xsocket_old;                                         # xsocket_old           is from   src/lib/x-kit/xclient/src/wire/xsocket-old.pkg
    package w2v =  wire_to_value;                                       # wire_to_value         is from   src/lib/x-kit/xclient/src/wire/wire-to-value.pkg
    package v2w =  value_to_wire;                                       # value_to_wire         is from   src/lib/x-kit/xclient/src/wire/value-to-wire.pkg
    package aht =  atom_table;                                          # atom_table            is from   src/lib/x-kit/xclient/src/iccc/atom-table.pkg
    package dy  =  display_old;                                         # display_old           is from   src/lib/x-kit/xclient/src/wire/display-old.pkg
herein

    package   atom_imp_old
    : (weak)  Atom_Imp_Old                                              # Atom_Imp_Old          is from   src/lib/x-kit/xclient/src/iccc/atom-imp-old.api
    {
        Atom = xt::Atom;

        Plea_Mail
          = PLEA_INTERN  (String, Oneshot_Maildrop(         Atom   ))
          | PLEA_LOOKUP  (String, Oneshot_Maildrop( Null_Or(Atom)  ))
          | PLEA_NAME    (Atom,   Oneshot_Maildrop(         String ))
          ;

        Atom_Imp
            =
            ATOM_IMP  Mailslot( Plea_Mail );

        fun intern connection arg
            =
            w2v::decode_intern_atom_reply
                (block_until_mailop_fires
                    (xok::send_xrequest_and_read_reply
                        connection
                        (v2w::encode_intern_atom  arg)
                )   );

        fun make_atom_imp ({ xsocket, ... }: dy::Xdisplay)
            =
            ATOM_IMP plea_slot
            where 

                plea_slot =   make_mailslot ();

                # NOTE: We are currently not using the local table;
                #       We also need to have a String --> atom mapping,
                #       and should initialize it with the standard atoms.  XXX BUGGO FIXME
                #

                 atom_table =  aht::make_hashtable  { size_hint => 32,  not_found_exception => DIE "AtomTable" };
                 insert     =  aht::set atom_table;
                 find       =  aht::find atom_table;

                 fun do_plea (PLEA_INTERN (id, reply_1shot))
                        =>
                        put_in_oneshot (reply_1shot, intern xsocket { name => id, only_if_exists => FALSE } );

                    do_plea (PLEA_LOOKUP (id, reply_1shot))
                        =>
                        case (intern xsocket { name => id, only_if_exists => TRUE } )
                            #
                            (xt::XATOM 0u0) =>   put_in_oneshot (reply_1shot, NULL    );
                            atom            =>   put_in_oneshot (reply_1shot, THE atom);
                        esac;

                    do_plea (PLEA_NAME (atom, reply_1shot))
                        =>
                        put_in_oneshot (reply_1shot, name)
                        where 

                            name = w2v::decode_get_atom_name_reply (
                                       block_until_mailop_fires (
                                           xok::send_xrequest_and_read_reply  xsocket  (
                                               v2w::encode_get_atom_name { atom }
                                           )
                                       )
                                   );
                       end;
                 end;

                 fun loop ()
                     =
                     {    do_plea  (take_from_mailslot  plea_slot);
                          loop();
                     };

                 make_thread "atom imp" loop;
            end;                                #  fun make_server 

        fun rpc req_g (ATOM_IMP plea_slot) arg
            =
            {   reply_1shot =   make_oneshot_maildrop ();
                #
                put_in_mailslot  (plea_slot,  req_g (arg, reply_1shot));

                get_from_oneshot  reply_1shot;
            };

        make_atom      =  rpc PLEA_INTERN;
        find_atom      =  rpc PLEA_LOOKUP;
        atom_to_string =  rpc PLEA_NAME;

    };                                  #  atom_imp 
end;