mim/development/mim/vax/mimlib/lup-user.mud

   1 ;"*****************************************************************************
   2
   3   This file defines library update routines for use with either network
   4   libraries or resident libraries.
   5
   6   LUP-USER.MUD: EDIT HISTORY                                Machine Independent
   7
   8   COMPILATION: Spliced in at compile time.
   9
  10     JUN84 [Shane] - Created.
  11   31OCT84 [Shane] - Commented, cleaned up.
  12   10NOV84 [Shane] - LUP-ADD-FILE, LUP-DEL-FILE
  13   ****************************************************************************"
  14
  15 ;"ACTLIB -- The active library represented as a channel. If the library is
  16   resident, we never write to this channel, since LUPI-KEY in LUP-BASE
  17   contains the actual shadow library (ACTLIB is the channel that the write
  18   lock is placed on.)"
  19
  20 <OR <GASSIGNED? ACTLIB> <SETG ACTLIB %<> '<OR CHANNEL FALSE>>>
  21
  22 ;"LUP-CREATE --
  23   Effect:   Create library named NAME with associated log file. Second name
  24             defaults to LIBMIM (LOG for log file). NBKTS is the number of
  25             buckets to use.
  26   Returns:  The full name of the library file."
  27
  28 <DEFINE LUP-CREATE ("OPT" (NAME:STRING "LIBMIM") (NBKTS:FIX ,INITIAL-BUCKETS))
  29    <LUPI-CREATE .NAME .NBKTS>>
  30
  31 ;"LUP-ABORT --
  32   Effect:   If there is an update in progress, abort all changes after the
  33             last install or lock."
  34
  35 <DEFINE LUP-ABORT ("AUX" (LIBC:<OR CHANNEL FALSE> ,ACTLIB)
  36                          (OUTCHAN:CHANNEL .OUTCHAN))
  37    <SETG ACTLIB %<>>
  38    <COND (.LIBC
  39           <IFSYS ("VAX"
  40                   <COND (<REMOTE? .LIBC>
  41                          <COND (<CHANNEL-OPEN? .LIBC>
  42                                 <CHANNEL-OP .LIBC:NET WRITE-BUFFER
  43                                              ![%,UPDATE-ABORT]>)>)
  44                         (T
  45                          <LUPI-ABORT>)>)
  46                  ("TOPS20"
  47                   <LUPI-ABORT>)>
  48           <COND (<CHANNEL-OPEN? .LIBC> <CLOSE .LIBC>)>
  49           <PRINTSTRING "Pending requests aborted.">
  50           <CRLF>)>>
  51 \f
  52 ;"LUP-ACT --
  53   Effect:   Lock the library named LIBS if there is no pre-existing lock.
  54   Returns:  T if successful, otherwise FALSE."
  55
  56 <DEFINE LUP-ACT ("OPT" (LIBS:STRING ,PUBLIC-LIBRARY)
  57                  "AUX" (OUTCHAN:CHANNEL .OUTCHAN)
  58                        (LIBC:<OR CHANNEL FALSE> %<>))
  59    <UNWIND
  60     <PROG (LOCK:<OR CHANNEL FALSE>)
  61        <COND (,ACTLIB <RETURN #FALSE ("LIBRARY ALREADY ACTIVATED")>)
  62              (<NOT <SET LIBC <LIBRARY-OPEN .LIBS>>> <RETURN .LIBC>)>
  63        <IFSYS ("VAX"
  64                <COND (<REMOTE? .LIBC>
  65                       <CHANNEL-OP .LIBC:NET TIMEOUT ,UPDATE-TIMEOUT>
  66                       <BIND ((MSG:UVECTOR <STACK <UVECTOR ,UPDATE-REQUEST>>))
  67                          <CHANNEL-OP .LIBC:NET WRITE-BUFFER .MSG>
  68                          <COND (<NOT <GET-REMOTE-RESPONSE .LIBC .MSG>>
  69                                 <CLOSE .LIBC>
  70                                 <RETURN #FALSE ("NETWORK ERROR")>)
  71                                (<N==? <1 .MSG> ,ACK>
  72                                 <CLOSE .LIBC>
  73                                 <RETURN #FALSE ("LOCKED")>)>
  74                          <SETG ACTLIB .LIBC>
  75                          <PRINTSTRING ,SERVER-NAME>
  76                          <PRINTSTRING " locked. ">
  77                          <CRLF>
  78                          <RETURN>>)>)>
  79        <COND (<SET LOCK <LUPI-LOCK .LIBC>>
  80               <SETG ACTLIB <SET LIBC .LOCK>>
  81               <PRINTSTRING <CHANNEL-OP .LIBC:DSK NAME>>
  82               <PRINTSTRING " locked. ">
  83               <CRLF>)
  84              (T
  85               <CLOSE .LIBC>
  86               .LOCK)>>
  87     <BIND ()
  88        <LUP-ABORT>
  89        <COND (<AND .LIBC <CHANNEL-OPEN? .LIBC>> <CLOSE .LIBC>)>>>>
  90 \f
  91 ;"LUP-DCT --
  92   Effect:   Unlock the active library and install all changes since the
  93             last lock or install.
  94   Returns:  T if successful, otherwise FALSE."
  95
  96 <DEFINE LUP-DCT ("AUX" (LIBC:<OR CHANNEL FALSE> ,ACTLIB))
  97    <UNWIND
  98     <PROG ((OUTCHAN:CHANNEL .OUTCHAN))
  99        <COND (<NOT .LIBC> <RETURN #FALSE ("NO LIBRARY ACTIVATED")>)>
 100        <IFSYS ("VAX"
 101                <COND (<REMOTE? .LIBC>
 102                       <BIND ((MSG:UVECTOR <STACK <UVECTOR ,UPDATE-UNLOCK>>))
 103                          <CHANNEL-OP .LIBC:NET WRITE-BUFFER .MSG>
 104                          <PRINTSTRING ,SERVER-NAME>
 105                          <COND (<AND <GET-REMOTE-RESPONSE .LIBC .MSG>
 106                                      <==? <1 .MSG> ,ACK>>
 107                                 <PRINTSTRING " unlocked. ">
 108                                 <CRLF>
 109                                 <CLOSE .LIBC>
 110                                 <SETG ACTLIB %<>>
 111                                 <RETURN T>)
 112                                (T
 113                                 <PRINTSTRING " update error.">
 114                                 <CRLF>
 115                                 <LUP-ABORT>
 116                                 <RETURN #FALSE ("UPDATE FAILED")>)>>)>)>
 117        <PRINTSTRING <CHANNEL-OP .LIBC:DSK NAME>>
 118        <COND (<LUPI-COMMIT>
 119               <CLOSE .LIBC>
 120               <SETG ACTLIB %<>>
 121               <PRINTSTRING " unlocked.">
 122               <CRLF>
 123               <RETURN T>)
 124              (T
 125               <PRINTSTRING " update error.">
 126               <CRLF>
 127               <LUP-ABORT>
 128               <RETURN #FALSE ("UPDATE FAILED")>)>>
 129     <LUP-ABORT>>>
 130 \f
 131 ;"LUP-INSTALL --
 132   Effect:   Install changes made since last lock or install without releasing
 133             lock.
 134   Returns:  T if successful, FALSE otherwise."
 135
 136 <DEFINE LUP-INSTALL ("AUX" (LIBC:<OR CHANNEL FALSE> ,ACTLIB))
 137    <UNWIND
 138     <PROG ((OUTCHAN:CHANNEL .OUTCHAN) LOCK:<OR CHANNEL FALSE>)
 139        <COND (<NOT .LIBC> <RETURN #FALSE ("NO LIBRARY ACTIVATED")>)>
 140        <IFSYS ("VAX"
 141                <COND (<REMOTE? .LIBC>
 142                       <BIND ((MSG:UVECTOR <STACK <UVECTOR ,UPDATE-INSTALL>>))
 143                          <CHANNEL-OP .LIBC:NET WRITE-BUFFER .MSG>
 144                          <PRINTSTRING ,SERVER-NAME>
 145                          <COND (<AND <GET-REMOTE-RESPONSE .LIBC .MSG>
 146                                      <==? <1 .MSG> ,ACK>>
 147                                 <PRINTSTRING " installed and locked.">
 148                                 <CRLF>
 149                                 <RETURN T>)
 150                                (T
 151                                 <PRINTSTRING " update error.">
 152                                 <CRLF>
 153                                 <LUP-ABORT>
 154                                 <RETURN #FALSE ("UPDATE FAILED")>)>>)>)>
 155        <PRINTSTRING <CHANNEL-OP .LIBC:DSK NAME>>
 156        <COND (<SET LOCK <LUPI-INSTALL>>
 157               <COND (<CHANNEL-OPEN? .LIBC> <CLOSE .LIBC>)>
 158               <SETG ACTLIB .LOCK>
 159               <PRINTSTRING " installed and locked.">
 160               <CRLF>
 161               <RETURN T>)
 162              (T
 163               <PRINTSTRING " update error.">
 164               <CRLF>
 165               <LUP-ABORT>
 166               <RETURN #FALSE ("UPDATE FAILED")>)>>
 167     <LUP-ABORT>>>
 168 \f
 169 ;"LUP-ADD-PACK --
 170   Effect:   Add module named PKG to library. The files for PKG are found in
 171             L-SEARCH-PATH. An optional documentation file may be specified:
 172             %<> means none. STRING means documentation is string rather than
 173             file. [] = [NM1 NM2] specifies file in search path. [NAME] means
 174             full file name. And finally [NM1 NM2 DEV SNM]. ABSTRACT? means
 175             generate and ABSTR file if non-false. COPY?, if FALSE, causes
 176             the library to point at the files where they are found rather than
 177             copying them to library directory (meaningful only for local
 178             libraries).
 179    Returns: T if successful, otherwise FALSE."
 180
 181 <DEFINE LUP-ADD-PACK (PKG:STRING
 182                       "OPT" (DOC:<OR STRING <VECTOR [REST STRING]> FALSE> %<>)
 183                             (ABSTRACT?:<OR ATOM FALSE> T)
 184                             (COPY?:<OR ATOM FALSE> T)
 185                       "AUX" (LIBC:<OR CHANNEL FALSE> ,ACTLIB))
 186    <UNWIND
 187     <PROG (PKGI:<OR FALSE PKGINFO> ABSTR:<OR VECTOR FALSE>
 188            (OUTCHAN:CHANNEL .OUTCHAN)
 189            (RECORD:UVECTOR <STACK <IUVECTOR ,MAXREC>>))
 190        <COND (<NOT .LIBC>
 191               <RETURN #FALSE ("NO LIBRARY ACTIVATED")>)
 192              (<NOT <SET PKGI <DESCRIBE-PACKAGE .PKG .ABSTRACT?>>>
 193               <RETURN .PKGI>)
 194              (<LIBRARY-RECORD-EXISTS? <PKG-NAME .PKGI> .LIBC>
 195               <COND (<ERROR LIBRARY-CONTAINS-MODULE!-ERRORS <PKG-NAME .PKGI>
 196                             ERRET-T-TO-UPDATE-FALSE-TO-EXIT!-ERRORS
 197                             LUP-ADD-PACK>
 198                      <COND (<NOT <LUP-DEL-PACK <PKG-NAME .PKGI>>>
 199                             <LUP-ABORT>
 200                             <RETURN #FALSE ("UPDATE FAILED")>)>)
 201                     (T
 202                      <RETURN %<>>)>)>
 203        <COND                                ;"Figure out where documentation is."
 204         (<TYPE? .DOC VECTOR>
 205          <COND (<EMPTY? .DOC> <SET DOC [<PKG-NAME .PKGI> "DOC"]>)>
 206          <COND (<==? <LENGTH .DOC> 2>
 207                 <SET DOC <OR <SEARCH <1 .DOC> VECTOR ,L-SEARCH-PATH <REST .DOC>>
 208                              <CHTYPE (!.DOC) FALSE>>>)
 209                (<OR <==? <LENGTH .DOC> 1> <==? <LENGTH .DOC> 4>>
 210                 <PROG (NM1:<SPECIAL STRING> NM2:<SPECIAL STRING>
 211                        DEV:<SPECIAL STRING> SNM:<SPECIAL STRING>
 212                        NAME:STRING FN:<CHANNEL 'PARSE>)
 213                    <COND (<==? <LENGTH .DOC> 4>
 214                           <SET DEV <3 .DOC>>
 215                           <SET SNM <4 .DOC>>
 216                           <SET NM1 <1 .DOC>>
 217                           <SET NM2 <2 .DOC>>
 218                           <SET FN <CHANNEL-OPEN PARSE .NM1>>
 219                           <SET NAME <CHANNEL-OP .FN NAME>>
 220                           <CLOSE .FN>)
 221                          (T
 222                           <SET FN <CHANNEL-OPEN PARSE <1 .DOC>>>
 223                           <SET NM1 <CHANNEL-OP .FN NM1>>
 224                           <SET NM2 <CHANNEL-OP .FN NM2>>
 225                           <SET DEV <CHANNEL-OP .FN DEV>>
 226                           <SET SNM <CHANNEL-OP .FN SNM>>
 227                           <SET NAME <CHANNEL-OP .FN NAME>>
 228                           <CLOSE .FN>)>
 229                    <COND (<FILE-EXISTS? .NAME>
 230                           <SET DOC [.NAME .NM1 .NM2 .DEV .SNM]>)
 231                          (T
 232                           <SET DOC <CHTYPE (!.DOC) FALSE>>)>>)
 233                (T
 234                 <SET DOC <CHTYPE (!.DOC) FALSE>>)>
 235 \f
 236          <COND (<NOT .DOC>
 237                 <COND (<ERROR FILE-NOT-FOUND!-ERRORS .DOC
 238                               ERRET-T-TO-EXIT-FALSE-TO-IGNORE!-ERRORS
 239                               LUP-ADD-PACK>
 240                        <RETURN %<>>)>)>)
 241         (<AND <TYPE? .DOC STRING> <G? <LENGTH .DOC> ,MAXSTRS>>
 242          <COND (<ERROR DOCUMENTATION-EXCEEDS-MAXIMUM-LENGTH!-ERRORS
 243                        ,MAXSTRS <LENGTH .DOC>
 244                        ERRET-T-TO-EXIT-FALSE-TO-IGNORE!-ERRORS
 245                        LUP-ADD-PACK>
 246                 <RETURN %<>>)
 247                (T
 248                 <SET DOC %<>>)>)>
 249        <IFSYS ("VAX" <COND (<REMOTE? .LIBC> <SET COPY? T>)>)>
 250        <COND (<PKG-ABSTRACT .PKGI>          ;"Write abstract to file."
 251               <BIND ((OBLIST:<SPECIAL LIST> <2 <PKG-ABSTRACT .PKGI>>)
 252                      (ABSTRACT:LIST <1 <PKG-ABSTRACT .PKGI>>)
 253                      (NM1:<SPECIAL STRING> <PKG-NAME .PKGI>)
 254                      (NM2:<SPECIAL STRING> "ABSTR")
 255                      (FN:<CHANNEL 'PARSE> <CHANNEL-OPEN PARSE .NM1>)
 256                      (NAME:STRING <CHANNEL-OP .FN NAME>)
 257                      (CH:CHANNEL <CHANNEL-OPEN DISK .NAME "CREATE" "ASCII">))
 258                  <CLOSE .FN>
 259                  <MAPF %<> <FUNCTION (F:FORM) <PRIN1 .F .CH>> .ABSTRACT>
 260                  <SET ABSTR [.NAME .NM1 .NM2
 261                              <CHANNEL-OP .CH DEV> <CHANNEL-OP .CH SNM>]>
 262                  <CLOSE .CH>>)
 263              (T
 264               <SET ABSTR %<>>)>
 265        <PRINTSTRING <PKG-NAME .PKGI>>
 266        <PRINTSTRING ": module addition request.">
 267        <CRLF>
 268        <BUILD-RECORD <PKG-NAME .PKGI> <==? <PKG-TYPE .PKGI> PACKAGE> .COPY?
 269                      <PKG-CODE .PKGI> <PKG-SOURCE .PKGI> .ABSTR .DOC
 270                      <PKG-ENTRYS .PKGI> <PKG-RENTRYS .PKGI> <PKG-USES .PKGI>
 271                      <PKG-EXPORTS .PKGI> <PKG-INCLUDES .PKGI> .RECORD>
 272        <IFSYS ("VAX"
 273                <COND (<REMOTE? .LIBC>
 274                       <COND
 275                        (<REMOTE-UPDATE .RECORD .LIBC
 276                                        <PKG-CODE .PKGI> <PKG-SOURCE .PKGI>
 277                                        .ABSTR <AND <TYPE? .DOC VECTOR> .DOC>>
 278                         <RETURN T>)
 279                        (T
 280                         <LUP-ABORT>
 281                         <RETURN #FALSE ("UPDATE FAILED")>)>)>)>
 282        <COND (<LOCAL-UPDATE .RECORD .COPY? .LIBC
 283                             <PKG-CODE .PKGI> <PKG-SOURCE .PKGI> .ABSTR
 284                             <AND <TYPE? .DOC VECTOR> .DOC>>
 285               <RETURN T>)
 286              (T
 287               <LUP-ABORT>
 288               <RETURN #FALSE ("UPDATE FAILED")>)>>
 289     <LUP-ABORT>>>
 290 \f
 291 ;"LUP-DEL-PACK --
 292   Effect:   Remove module named PKG from active library.
 293   Returns:  T if successful, otherwise FALSE."
 294
 295 <DEFINE LUP-DEL-PACK (PKG:STRING "AUX" (LIBC:<OR FALSE CHANNEL> ,ACTLIB))
 296    <UNWIND
 297     <PROG ((OUTCHAN:CHANNEL .OUTCHAN))
 298        <COND (<NOT .LIBC>
 299               <RETURN #FALSE ("NO LIBRARY ACTIVATED")>)
 300              (<NOT <LIBRARY-RECORD-EXISTS? .PKG .LIBC>>
 301               <RETURN #FALSE ("NO SUCH MODULE")>)>
 302        <PRINTSTRING .PKG>
 303        <PRINTSTRING ": module deletion request.">
 304        <CRLF>
 305        <IFSYS
 306         ("VAX"
 307          <COND (<REMOTE? .LIBC>
 308                 <BIND ((MSG:UVECTOR
 309                         <STACK <UVECTOR <ORB ,UPDATE-DEL
 310                                              <LSH <LENGTH .PKG> 8>>>>))
 311                    <CHANNEL-OP .LIBC:NET WRITE-BUFFER .MSG>
 312                    <CHANNEL-OP .LIBC:NET WRITE-BUFFER .PKG>
 313                    <COND (<AND <GET-REMOTE-RESPONSE .LIBC .MSG>
 314                                <==? <1 .MSG> ,ACK>>
 315                           <RETURN T>)
 316                          (T
 317                           <LUP-ABORT>
 318                           <RETURN #FALSE ("UPDATE FAILED")>)>>)>)>
 319        <COND (<LUPI-DEL-PACK .PKG>
 320               <RETURN T>)
 321              (T
 322               <LUP-ABORT>
 323               <RETURN #FALSE ("UPDATE FAILED")>)>>
 324     <LUP-ABORT>>>
 325 \f
 326 ;"LUP-GC --
 327   Effect:   Garbage collect the active library. NBKTS is the number of
 328             buckets to use.
 329   Returns:  T if successful, otherwise FALSE."
 330
 331 <DEFINE LUP-GC ("OPT" (NBKTS:FIX ,INITIAL-BUCKETS)
 332                 "AUX" (LIBC:<OR CHANNEL FALSE> ,ACTLIB))
 333    <UNWIND
 334     <PROG ((OUTCHAN:CHANNEL .OUTCHAN))
 335        <COND (<NOT .LIBC> <RETURN #FALSE ("NO LIBRARY ACTIVATED")>)>
 336        <PRINTSTRING "Library GC...">
 337        <IFSYS
 338         ("VAX"
 339          <COND (<REMOTE? .LIBC>
 340                 <BIND ((MSG:UVECTOR <STACK <UVECTOR ,UPDATE-GC>>))
 341                    <CHANNEL-OP .LIBC:NET WRITE-BUFFER .MSG>
 342                    <CHANNEL-OP .LIBC:NET TIMEOUT %<* 2 ,UPDATE-TIMEOUT>>
 343                    <COND (<AND <GET-REMOTE-RESPONSE .LIBC .MSG>
 344                                <==? <1 .MSG> ,ACK>>
 345                           <CHANNEL-OP .LIBC:NET TIMEOUT ,UPDATE-TIMEOUT>
 346                           <PRINTSTRING "Done.">
 347                           <CRLF>
 348                           <RETURN T>)
 349                          (T
 350                           <PRINTSTRING "Failed.">
 351                           <CRLF>
 352                           <LUP-ABORT>
 353                           <RETURN %<>>)>>)>)>
 354        <COND (<LUPI-GC .NBKTS>
 355               <PRINTSTRING "Done.">
 356               <CRLF>
 357               <RETURN T>)
 358              (T
 359               <PRINTSTRING "Failed.">
 360               <CRLF>
 361               <LUP-ABORT>
 362               <RETURN %<>>)>>
 363     <LUP-ABORT>>>
 364 \f
 365 ;"LUP-ADD-FILE --
 366   Effect:   Copies the file named NAME to the directory of the active library.
 367   Returns:  T if successful, FALSE otherwise."
 368
 369 <DEFINE LUP-ADD-FILE (NAME:STRING "AUX" (LIB:<OR CHANNEL FALSE> ,ACTLIB)
 370                                         (FIL:<OR CHANNEL FALSE> %<>)
 371                                         (CPY:<OR CHANNEL FALSE> %<>))
 372    <UNWIND
 373     <PROG ((OUTCHAN:CHANNEL .OUTCHAN))
 374        <COND (<NOT .LIB> <RETURN #FALSE ("NO LIBRARY ACTIVATED")>)
 375              (<NOT <SET FIL <SEARCH .NAME CHANNEL>>> <RETURN #FALSE ("NOT FOUND")>)>
 376        <SET NAME <STRING <CHANNEL-OP .FIL:DSK NM1> !\. <CHANNEL-OP .FIL:DSK NM2>>>
 377        <COND (<LIBRARY-FILE-EXISTS? .NAME .LIB>
 378               <COND (<ERROR LIBRARY-FILE-EXISTS!-ERRORS .NAME
 379                             ERRET-T-TO-UPDATE-FALSE-TO-EXIT!-ERRORS LUP-ADD-FILE>
 380                      <COND (<NOT <LUP-DEL-FILE .NAME>>
 381                             <LUP-ABORT>
 382                             <CLOSE .FIL>
 383                             <RETURN #FALSE ("UPDATE FAILED")>)>)
 384                     (T
 385                      <CLOSE .FIL>
 386                      <RETURN %<>>)>)>
 387        <PRINTSTRING .NAME>
 388        <PRINTSTRING ": file addition request.">
 389        <CRLF>
 390        <PRINTSTRING "Copying ">
 391        <PRINTSTRING <CHANNEL-OP .FIL:DSK NAME>>
 392        <CRLF>
 393        <IFSYS
 394         ("VAX"
 395          <COND (<REMOTE? .LIB>
 396                 <BIND ((R:UVECTOR <IUVECTOR 4>))
 397                    <1 .R <ORB ,UPDATE-ADD ,UPDATE-FILE <LSH <LENGTH .NAME> 8>>>
 398                    <CHANNEL-OP .LIB:NET WRITE-BUFFER .R 1>
 399                    <CHANNEL-OP .LIB:NET WRITE-BUFFER .NAME>
 400                    <CHANNEL-OP .LIB:NET LISTEN-ON-DATA>
 401                    <CHANNEL-OP .LIB:NET GET-DATA-ADDRESS <CHTYPE .R NET-ADDRESS>>
 402                    <CHANNEL-OP .LIB:NET WRITE-BUFFER .R>
 403                    <COND (<NOT <SET CPY <CHANNEL-OP .LIB:NET CONNECT-DATA-CHANNEL>>>
 404                           <ERROR CANT-OPEN-DATA-CONNECTION!-ERRORS
 405                                  <SYS-ERR "" .CPY %<>> .CPY LUP-ADD-FILE>)
 406                          (<AND <NET-FILE-COPY .FIL .CPY .LIB>
 407                                <GET-REMOTE-RESPONSE .LIB .R>
 408                                <==? <1 .R> ,ACK>>
 409                           <CLOSE .FIL>
 410                           <CHANNEL-OP .LIB:NET CLOSE-DATA-CHANNEL>
 411                           <RETURN T>)>
 412                    <CHANNEL-OP .LIB:NET CLOSE-DATA-CHANNEL>
 413                    <LUP-ABORT>
 414                    <CLOSE .FIL>
 415                    <RETURN #FALSE ("UPDATE FAILED")>>)>)>
 416        <SET CPY <CHANNEL-OPEN DISK <LUPI-GENTEMP> "CREATE" "ASCII">>
 417        <DSK-FILE-COPY .FIL .CPY>
 418        <SET NAME <CHANNEL-OP .FIL:DSK NM1>>
 419        <PROG ((DEV:<SPECIAL STRING> <CHANNEL-OP .LIB:DSK DEV>)
 420               (SNM:<SPECIAL STRING> <CHANNEL-OP .LIB:DSK SNM>)
 421               (NM2:<SPECIAL STRING> <CHANNEL-OP .FIL:DSK NM2>)
 422               (FN:<CHANNEL 'PARSE> <CHANNEL-OPEN PARSE .NAME>))
 423           <LUPI-ADD-FILE <CHANNEL-OP .CPY:DSK NAME> <CHANNEL-OP .FN NAME>>
 424           <CLOSE .FN>
 425           <CLOSE .CPY>
 426           <CLOSE .FIL>>
 427        <RETURN T>>
 428     <BIND ()
 429        <LUP-ABORT>
 430        <COND (<AND .CPY <CHANNEL-OPEN? .CPY>> <CLOSE .CPY>)>
 431        <COND (<AND .FIL <CHANNEL-OPEN? .FIL>> <CLOSE .FIL>)>>>>
 432 \f
 433 ;"LUP-DEL-FILE
 434   Effect:   Remove file named NAME from active library directory.
 435   Returns:  T if successful, FALSE otherwise."
 436
 437 <DEFINE LUP-DEL-FILE (NAME:STRING "AUX" (LIBC:<OR FALSE CHANNEL> ,ACTLIB))
 438    <PROG ((OUTCHAN:CHANNEL .OUTCHAN))
 439       <COND (<NOT .LIBC>
 440              <RETURN #FALSE ("NO LIBRARY ACTIVATED")>)
 441             (<NOT <LIBRARY-FILE-EXISTS? .NAME .LIBC>>
 442              <RETURN #FALSE ("NO SUCH FILE")>)>
 443       <PRINTSTRING .NAME>
 444       <PRINTSTRING ": file deletion request.">
 445       <CRLF>
 446       <IFSYS ("VAX"
 447               <COND (<REMOTE? .LIBC>
 448                      <BIND ((R:UVECTOR
 449                              <STACK <UVECTOR <ORB ,UPDATE-DEL ,UPDATE-FILE
 450                                                   <LSH <LENGTH .NAME> 8>>>>))
 451                         <CHANNEL-OP .LIBC:NET WRITE-BUFFER .R>
 452                         <CHANNEL-OP .LIBC:NET WRITE-BUFFER .NAME>
 453                         <COND (<AND <GET-REMOTE-RESPONSE .LIBC .R>
 454                                     <==? <1 .R> ,ACK>>
 455                                <RETURN T>)
 456                               (T
 457                                <LUP-ABORT>
 458                                <RETURN #FALSE ("UPDATE FAILED")>)>>)>)>
 459       <RETURN <LUPI-DEL-FILE .NAME>>>>
 460
 461 ;"LIBRARY-RECORD-EXISTS? --
 462   Effect:   Determine if active library contains module named PKG.
 463   Returns:  T if it exists, otherwise FALSE."
 464
 465 <DEFINE LIBRARY-RECORD-EXISTS? (PKG:STRING LIBC:CHANNEL)
 466    <PROG ()
 467       <IFSYS ("VAX"
 468               <COND (<REMOTE? .LIBC>
 469                      <BIND ((MSG:UVECTOR
 470                              <STACK <UVECTOR <ORB ,UPDATE-EXISTS?
 471                                                   <LSH <LENGTH .PKG> 8>>>>))
 472                         <CHANNEL-OP .LIBC:NET WRITE-BUFFER .MSG>
 473                         <CHANNEL-OP .LIBC:NET WRITE-BUFFER .PKG>
 474                         <RETURN <AND <GET-REMOTE-RESPONSE .LIBC .MSG>
 475                                      <==? <1 .MSG> ,ACK>>>>)>)>
 476       <RETURN <LUPI-RECORD-EXISTS? .PKG>>>>
 477
 478 ;"LIBRARY-FILE-EXISTS? --
 479   Effect:   Determine if active library directory contains file named NAME.
 480   Returns:  T if it exists, otherwise FALSE."
 481
 482 <DEFINE LIBRARY-FILE-EXISTS? (NAME:STRING LIBC:CHANNEL)
 483    <PROG ()
 484       <IFSYS ("VAX"
 485               <COND (<REMOTE? .LIBC>
 486                      <BIND ((MSG:UVECTOR
 487                              <STACK <UVECTOR <ORB ,UPDATE-EXISTS? ,UPDATE-FILE
 488                                                   <LSH <LENGTH .NAME> 8>>>>))
 489                         <CHANNEL-OP .LIBC:NET WRITE-BUFFER .MSG>
 490                         <CHANNEL-OP .LIBC:NET WRITE-BUFFER .NAME>
 491                         <RETURN <AND <GET-REMOTE-RESPONSE .LIBC .MSG>
 492                                      <==? <1 .MSG> ,ACK>>>>)>)>
 493       <RETURN <LUPI-FILE-EXISTS? .NAME>>>>
 494 \f
 495 ;"DSK-FILE-COPY --
 496   Effect:   Copy FROM to TO.
 497   Modifies: FROM, TO."
 498
 499 <DEFINE DSK-FILE-COPY (FROM:<CHANNEL 'DISK> TO:<CHANNEL 'DISK>)
 500    <REPEAT ((BUFFER:STRING <STACK <ISTRING 1024>>) AMOUNT:FIX)
 501       <SET AMOUNT <OR <CHANNEL-OP .FROM READ-BUFFER .BUFFER> 0>>
 502       <CHANNEL-OP .TO WRITE-BUFFER .BUFFER .AMOUNT>
 503       <COND (<==? .AMOUNT 0> <RETURN>)>>>
 504
 505 ;"LOCAL-UPDATE --
 506   Effect:   Add a module to a local library. The module is represented
 507             by RECORD. COPY? specifies whether or not files are to be
 508             copied. FILES is (in order, some missing possibly) the file
 509             spec vectors for MSUBR, MUD, ABSTR, DOC. A file spec vector
 510             is [NAME NM1 NM2 DEV SNM].
 511   Returns:  T if successful, FALSE otherwise.
 512   Requires: RECORD is properly formatted library record as defined in
 513             LIBRARY.FORMAT."
 514
 515 <DEFINE LOCAL-UPDATE (RECORD:UVECTOR COPY?:<OR ATOM FALSE>
 516                       LIBC:<CHANNEL 'DISK> "TUPLE" FILES:<PRIMTYPE VECTOR>)
 517    <PROG ((ADD:LIST ()) (TMP:LIST ()) (OUTCHAN:CHANNEL .OUTCHAN)
 518           (DEV:<SPECIAL STRING> <CHANNEL-OP .LIBC DEV>)
 519           (SNM:<SPECIAL STRING> <CHANNEL-OP .LIBC SNM>)
 520           NM2:<SPECIAL STRING> FROM:<CHANNEL 'DISK> TO:<CHANNEL 'DISK>
 521           NAME:STRING FN:<CHANNEL 'PARSE>)
 522       <MAPF %<>                             ;"Copy files."
 523             <FUNCTION (FV:<OR <VECTOR [5 STRING]> FALSE>)
 524                <COND (.FV
 525                       <COND (<OR .COPY?
 526                                  <AND <=? .DEV <4 .FV>> <=? .SNM <5 .FV>>>>
 527                              ;"We have to copy files in library directory
 528                                regardless of COPY? since user may have moved
 529                                files there without updating library. Thus, if
 530                                he deleted a record, we would delete new files."
 531                              <COND (.COPY?
 532                                     <PRINTSTRING "Copying ">
 533                                     <PRINTSTRING <1 .FV>>
 534                                     <CRLF>)>
 535                              <SET FROM <CHANNEL-OPEN DISK <1 .FV> "READ">>
 536                              <SET NAME <LUPI-GENTEMP>>
 537                              <SET TO <CHANNEL-OPEN DISK .NAME "CREATE">>
 538                              <DSK-FILE-COPY .FROM .TO>
 539                              <CLOSE .FROM>
 540                              <CLOSE .TO>
 541                              <SET NM2 <3 .FV>>
 542                              <SET FN <CHANNEL-OPEN PARSE <2 .FV>>>
 543                              <SET ADD (<CHANNEL-OP .FN NAME> !.ADD)>
 544                              <CLOSE .FN>
 545                              <SET TMP (.NAME !.TMP)>)>)>>
 546             .FILES>
 547       <LUPI-ADD-PACK .RECORD .ADD .TMP>>>
 548 \f
 549 ;"BUILD-RECORD --
 550   Effect:   Create a library record.
 551   Returns:  The actual length of the record.
 552   Modifies: Record.
 553   Note:     CFN, SFN, AFN, DOC are file specs (except DOC can be string).
 554             USES, EXPORTS, INCLUDES are lists of modules referenced by
 555             the module. ENTRYS, RENTRYS are the obvious."
 556
 557 <DEFINE BUILD-RECORD (NAME:STRING PACKAGE?:<OR ATOM FALSE>
 558                       COPY?:<OR ATOM FALSE> CFN:<OR VECTOR STRING FALSE>
 559                       SFN:<OR VECTOR STRING FALSE> AFN:<OR VECTOR STRING FALSE>
 560                       DOC:<OR VECTOR STRING FALSE> ENTRYS:VECTOR RENTRYS:VECTOR
 561                       USES:VECTOR EXPORTS:VECTOR INCLUDES:VECTOR RECORD:UVECTOR
 562                       "AUX"
 563                       (RECLEN:FIX <LENGTH .RECORD>) (SFNLEN:FIX 0)
 564                       (PDNLEN:FIX <LENGTHW .NAME>) (CFNLEN:FIX 0)
 565                       (AFNLEN:FIX 0) (DOCLEN:FIX 0) DELTAE:FIX DELTAU:FIX)
 566    <1 .RECORD                               ;"File bits for record info word."
 567       <ORB <COND (.CFN ,RINFO-CFN?) (T 0)>
 568            <COND (.AFN ,RINFO-AFN?) (T 0)>
 569            <COND (.SFN ,RINFO-SFN?) (T 0)>
 570            <COND (.PACKAGE? ,RINFO-PKG?) (T 0)>
 571            <COND (<TYPE? .DOC STRING> ,RINFO-DOC?) (.DOC ,RINFO-DFN?) (T 0)>
 572            .PDNLEN>>                        ;"And length of name in words."
 573    <S2UV .NAME <SET RECORD <REST .RECORD>>> ;"Module name."
 574    <SET RECORD <REST .RECORD <+ .PDNLEN 3>>>
 575    <COND                                    ;"Encode file names."
 576     (.COPY?                                 ;"COPY? -> NM1.NM2."
 577      <COND (<TYPE? .CFN VECTOR>             ;"Implies default SNM, DEV."
 578             <SET CFNLEN <LENGTHW <SET CFN <STRING <2 .CFN> !\. <3 .CFN>>>>>
 579             <S2UV .CFN .RECORD>
 580             <SET RECORD <REST .RECORD .CFNLEN>>)>
 581      <COND (<TYPE? .SFN VECTOR>
 582             <SET SFNLEN <LENGTHW <SET SFN <STRING <2 .SFN> !\. <3 .SFN>>>>>
 583             <S2UV .SFN .RECORD>
 584             <SET RECORD <REST .RECORD .SFNLEN>>)>
 585      <COND (<TYPE? .AFN VECTOR>
 586             <SET AFNLEN <LENGTHW <SET AFN <STRING <2 .AFN> !\. <3 .AFN>>>>>
 587             <S2UV .AFN .RECORD>
 588             <SET RECORD <REST .RECORD .AFNLEN>>)>
 589      <COND (.DOC
 590             <COND (<TYPE? .DOC VECTOR>
 591                    <SET DOC <STRING <2 .DOC> !\. <3 .DOC>>>)>
 592             <SET DOCLEN <LENGTHW .DOC>>
 593             <S2UV .DOC .RECORD>
 594             <SET RECORD <REST .RECORD .DOCLEN>>)>)
 595     (T                                      ;"Otherwise full name."
 596      <COND (<TYPE? .CFN VECTOR>
 597             <SET CFNLEN <LENGTHW <SET CFN <1 .CFN>>:STRING>>
 598             <S2UV .CFN .RECORD>
 599             <SET RECORD <REST .RECORD .CFNLEN>>)>
 600      <COND (<TYPE? .SFN VECTOR>
 601             <SET SFNLEN <LENGTHW <SET SFN <1 .SFN>>:STRING>>
 602             <S2UV .SFN .RECORD>
 603             <SET RECORD <REST .RECORD .SFNLEN>>)>
 604      <COND (<TYPE? .AFN VECTOR>
 605             <SET AFNLEN <LENGTHW <SET AFN <1 .AFN>>:STRING>>
 606             <S2UV .AFN .RECORD>
 607             <SET RECORD <REST .RECORD .AFNLEN>>)>
 608      <COND (.DOC
 609             <COND (<TYPE? .DOC VECTOR> <SET DOC <1 .DOC>>)>
 610             <SET DOCLEN <LENGTHW .DOC:STRING>>
 611             <S2UV .DOC .RECORD>
 612             <SET RECORD <REST .RECORD .DOCLEN>>)>)>
 613 \f
 614    <SET DELTAE <- .RECLEN <LENGTH .RECORD>>>    ;"Start of r/entry list."
 615    <REPEAT (ERNAME:ATOM ERLEN:FIX (TYPES:VECTOR ,L-ERTYPES))
 616       ;"The ENTRY and RENTRY vectors are sorted. Now we merge sort them
 617         into the record."
 618       <COND (<AND <EMPTY? .ENTRYS> <EMPTY? .RENTRYS>>
 619              <SET ENTRYS <TOP .ENTRYS>>
 620              <SET RENTRYS <TOP .RENTRYS>>
 621              <RETURN>)
 622             (<EMPTY? .RENTRYS>
 623              <SET ERNAME <1 .ENTRYS>>
 624              <SET ENTRYS <REST .ENTRYS>>)
 625             (<OR <EMPTY? .ENTRYS>
 626                  <G? <STRCOMP <SPNAME <1 .ENTRYS>> <SPNAME <1 .RENTRYS>>> 0>>
 627              <SET ERNAME <1 .RENTRYS>>
 628              <SET RENTRYS <REST .RENTRYS>>)
 629             (T
 630              <SET ERNAME <1 .ENTRYS>>
 631              <SET ENTRYS <REST .ENTRYS>>)>
 632       ;"Construct r/entry descriptor. Name length, type info, name."
 633       <1 .RECORD
 634          <ORB <SET ERLEN <LENGTHW <SPNAME .ERNAME>>>
 635               <COND (<GASSIGNED? .ERNAME>
 636                      <ORB <LSH <- 8 <LENGTH <MEMQ <TYPE ,.ERNAME> .TYPES>>> 8>
 637                           <COND (<APPLICABLE? ,.ERNAME> ,ERTYP-APPLICABLE)
 638                                 (T 0)>>)
 639                     (T 0)>
 640               <COND (<N==? <OBLIST? .ERNAME> %<ROOT>> ,ERTYP-ENTRY?) (T 0)>
 641               <COND (<MANIFEST? .ERNAME> ,ERTYP-MANIFEST?) (T 0)>
 642               <COND (<TYPE-NAME? .ERNAME> ,ERTYP-TYPE?) (T 0)>
 643               <LSH <- .RECLEN <LENGTH .RECORD>> 16>>>
 644       <S2UV <SPNAME .ERNAME> <SET RECORD <REST .RECORD>>>
 645       <SET RECORD <REST .RECORD .ERLEN>>>
 646    <SET DELTAU <- .RECLEN <LENGTH .RECORD>>>    ;"Start of U/X/I list."
 647    <REPEAT (UXINAME:<OR STRING FALSE> UXITYPE:FIX UXILEN:FIX)
 648       ;"Again, the vectors are sorted and we merge sort them into record."
 649       <COND (<EMPTY? .USES>
 650              <SET UXINAME %<>>)
 651             (T
 652              <SET UXINAME <1 .USES>>
 653              <SET UXITYPE ,UXI-USED?>)>
 654       <COND (<AND <NOT <EMPTY? .INCLUDES>>
 655                   <OR <NOT .UXINAME> <G? <STRCOMP .UXINAME <1 .INCLUDES>> 0>>>
 656              <SET UXINAME <1 .INCLUDES>>
 657              <SET UXITYPE ,UXI-INCLUDED?>)>
 658       <COND (<AND <NOT <EMPTY? .EXPORTS>>
 659                   <OR <NOT .UXINAME> <G? <STRCOMP .UXINAME <1 .EXPORTS>> 0>>>
 660              <SET UXINAME <1 .EXPORTS>>
 661              <SET UXITYPE ,UXI-EXPORTED?>)>
 662       <COND (<NOT .UXINAME>
 663              <SET USES <TOP .USES>>
 664              <SET EXPORTS <TOP .EXPORTS>>
 665              <SET INCLUDES <TOP .INCLUDES>>
 666              <RETURN>)
 667             (<==? .UXITYPE ,UXI-USED?>
 668              <SET USES <REST .USES>>)
 669             (<==? .UXITYPE ,UXI-INCLUDED?>
 670              <SET INCLUDES <REST .INCLUDES>>)
 671             (T
 672              <SET EXPORTS <REST .EXPORTS>>)>
 673       ;"Construct descriptor. Bit indicating reference type, name length, name."
 674       <1 .RECORD <ORB .UXITYPE <SET UXILEN <LENGTHW .UXINAME>>>>
 675       <S2UV .UXINAME <SET RECORD <REST .RECORD>>>
 676       <SET RECORD <REST .RECORD .UXILEN>>>
 677 \f
 678    ;"Compute length of record and shove into record info word. Fix up
 679      r/entry count - displacement word. Fixup U/X/I count - displacement
 680      word."
 681    <SET RECLEN <- .RECLEN <LENGTH .RECORD>>>
 682    <1 <SET RECORD <TOP .RECORD>>
 683       <ORB <1 .RECORD> <LSH .RECLEN 16>>>
 684    <1 <SET RECORD <REST .RECORD <+ 1 .PDNLEN>>>
 685       <ORB <LSH .DOCLEN 24> <LSH .AFNLEN 16> <LSH .SFNLEN 8> .CFNLEN>>
 686    <1 <SET RECORD <REST .RECORD>>
 687       <ORB <LSH .DELTAE 16> <+ <LENGTH .ENTRYS> <LENGTH .RENTRYS>>>>
 688    <1 <REST .RECORD>
 689       <ORB <LSH .DELTAU 16>
 690            <+ <LENGTH .USES> <LENGTH .INCLUDES> <LENGTH .EXPORTS>>>>
 691    .RECLEN>