mim/development/mim/vax/mimlib/hosts.mud

   1 <PACKAGE "HOSTS">
   2
   3 <ENTRY HOST NICKNAMES SITE-ENTRY HOST-NAME>
   4
   5 <SETG BREAKS <STRING <ASCII 13> <ASCII 10> <ASCII 32> <ASCII 9>>>
   6
   7 <GDECL (BREAKS) STRING>
   8
   9 <SETG WH-HOSTNUM 1>
  10
  11 <SETG WH-HOSTNAME 2>
  12
  13 <SETG WH-NICKNAMES 3>
  14
  15 <SETG WH-NUMHOST 4>
  16
  17 <SETG WH-ENTRY 5>
  18
  19 <MANIFEST WH-HOSTNUM WH-HOSTNAME WH-NICKNAMES WH-NUMHOST WH-ENTRY>
  20
  21 <DEFINE NICKNAMES (WHICH)
  22   #DECL ((WHICH) <OR FIX STRING>)
  23   <SEARCH-HOSTS .WHICH ,WH-NICKNAMES>>
  24
  25 <DEFINE HOST-NAME (WHICH)
  26   #DECL ((WHICH) <OR FIX STRING>)
  27   <SEARCH-HOSTS .WHICH ,WH-HOSTNAME>>
  28
  29 <DEFINE SITE-ENTRY (WHICH)
  30   #DECL ((WHICH) <OR FIX STRING>)
  31   <SEARCH-HOSTS .WHICH ,WH-ENTRY>>
  32
  33 <DEFINE HOST (WHICH)
  34         #DECL ((WHICH) <OR STRING FIX>)
  35         <SEARCH-HOSTS .WHICH <COND (<TYPE? .WHICH FIX> ,WH-NUMHOST)
  36                                   (T ,WH-HOSTNUM)>>>
  37
  38 <DEFINE NUM2STR (SPEC STR "AUX" (CT 0))
  39         #DECL ((SPEC) FIX)
  40         <SET CT <PUTFIELD <GETBITS .SPEC <BITS 8 0>> .STR .CT>>
  41         <PUT .STR <SET CT <+ .CT 1>> !\.>
  42         <SET CT <PUTFIELD <GETBITS .SPEC <BITS 8 8>> .STR .CT>>
  43         <PUT .STR <SET CT <+ .CT 1>> !\.>
  44         <SET CT <PUTFIELD <GETBITS .SPEC <BITS 8 16>> .STR .CT>>
  45         <PUT .STR <SET CT <+ .CT 1>> !\.>
  46         <SET CT <PUTFIELD <GETBITS .SPEC <BITS 8 24>> .STR .CT>>
  47         <SUBSTRUC .STR 0 .CT <REST .STR <- <LENGTH .STR> .CT>>>>
  48
  49 <DEFINE PUTFIELD (VAL STR STRT "AUX" (DIV 100) (ANY? <>))
  50         #DECL ((VAL) FIX (STR) STRING (STRT DIV) FIX)
  51         <REPEAT (TMP)
  52                 <COND (<OR <NOT <0? <SET TMP </ .VAL .DIV>>>> .ANY?>
  53                        <PUT .STR
  54                             <SET STRT <+ .STRT 1>>
  55                             <ASCII <+ .TMP <ASCII !\0>>>>
  56                        <SET VAL <MOD .VAL .DIV>>
  57                        <SET ANY? T>)>
  58                 <COND (<0? <SET DIV </ .DIV 10>>>
  59                        <COND (<NOT .ANY?>
  60                               <PUT .STR <SET STRT <+ .STRT 1>> !\0>)>
  61                        <RETURN .STRT>)>>>
  62
  63 <DEFINE SEARCH-HOSTS (ITARG WHICH "AUX" TARG (NUM? <>)
  64                       (STR <STACK <ISTRING <COND (<TYPE? .ITARG FIX> 15)
  65                                                  (T <LENGTH .ITARG>)>>>)
  66                       (BUF <STACK <ISTRING 512>>)
  67                       (CH <>))
  68    #DECL ((TARG) STRING (FIRST?) <OR ATOM !<FALSE>> (BUF) STRING
  69           (CH) <OR <CHANNEL 'DISK> FALSE> (ITARG) <OR STRING FIX>)
  70    <COND (<TYPE? .ITARG FIX>
  71           <SET TARG <NUM2STR .ITARG .STR>>
  72           <SET NUM? T>)
  73          (T
  74           <MAPR <>
  75             <FUNCTION (S1 S2 "AUX" (CHR <1 .S1>))
  76               #DECL ((S1 S2) STRING)
  77               <COND (<AND <G=? <ASCII .CHR> <ASCII !\A>>
  78                           <L=? <ASCII .CHR> <ASCII !\Z>>>
  79                      <SET CHR <ASCII <- <ASCII .CHR>
  80                                         %<- <ASCII !\A> <ASCII !\a>>>>>)>
  81               <1 .S2 .CHR>>
  82             .ITARG .STR>
  83           <SET TARG .STR>)>
  84   <UNWIND
  85    <COND
  86     (<SET CH <CHANNEL-OPEN DISK "/ETC/HOSTS" "READ" "ASCII" <>>>
  87      <REPEAT (CS (NS "") (STR <>) MSTR)
  88              #DECL ((NS MSTR) STRING (CS STR) <OR STRING FALSE>)
  89              <COND (<NOT .STR>
  90                     <SUBSTRUC .NS 0 <LENGTH .NS> <SET MSTR .BUF>>
  91                     <SET STR .MSTR>
  92                     <COND (<0? <CHANNEL-OP .CH
  93                                            READ-BUFFER
  94                                            <REST .BUF <LENGTH .NS>>>:FIX>
  95                            <CLOSE .CH>
  96                            <RETURN <>>)>)
  97                    (T <SET MSTR .STR>)>
  98              <COND (<SET CS <MEMBER .TARG .MSTR>>
  99                     <SET NS <LINE-BEGIN .CS .BUF>>
 100                     <COND (<==? <1 .NS> !\#> <SET STR <LINE-END .MSTR>>)
 101                           (<AND <OR <==? .CS .NS>
 102                                     <MEMQ <1 <BACK .CS>> ,BREAKS>>
 103                                 <G? <LENGTH .CS> <LENGTH .TARG>>
 104                                 <MEMQ <NTH .CS <+ <LENGTH .TARG> 1>> ,BREAKS>>
 105                            <COND (<NOT <SET STR <LINE-END .CS>>> <AGAIN>)>
 106                            <COND (<COND (.NUM? <==? .CS .NS>)
 107                                         (T <N==? .CS .NS>)>
 108                                   <CLOSE .CH>
 109                                   <RETURN <WINNER .TARG .WHICH .NS .STR>>)>)
 110                           (<L=? <LENGTH .CS> <LENGTH .TARG>> <SET STR <>>)
 111                           (T <SET STR <REST .CS <LENGTH .TARG>>>)>)
 112                    (T
 113                     <SET NS <LINE-BEGIN <REST .MSTR <LENGTH .MSTR>> .BUF>>
 114                     <SET STR <>>)>>)>
 115   <COND (<AND .CH <CHANNEL-OPEN? .CH>> <CLOSE .CH> <>)>>>
 116
 117 <DEFINE LINE-BEGIN (STR TOP)
 118         #DECL ((STR TOP) STRING)
 119         <REPEAT (CHR)
 120                 <COND (<==? .STR .TOP> <RETURN .STR>)>
 121                 <COND (<==? <1 <SET STR <BACK .STR>>> <ASCII 10>>
 122                        <RETURN <REST .STR>>)>>>
 123
 124 <DEFINE LINE-END (STR)
 125         #DECL ((STR) STRING)
 126         <REPEAT ()
 127                 <COND (<EMPTY? .STR> <RETURN <>>)>
 128                 <COND (<==? <1 .STR> <ASCII 10>> <RETURN <REST .STR>>)>
 129                 <SET STR <REST .STR>>>>
 130
 131 \\f
 132
 133 <DEFINE WINNER (TARG WHICH NS STR "AUX" NNS TS)
 134         #DECL ((TARG NS STR) STRING (WHICH) FIX)
 135         <CASE ,==?
 136               .WHICH
 137               (,WH-ENTRY <SUBSTRUC .NS 0 <- <LENGTH .NS> <LENGTH .STR> 1>>)
 138               (,WH-HOSTNUM
 139                <REPEAT ((HNUM 0) (CT 0) (ACC 0) CHR)
 140                        <COND (<==? <SET CHR <1 .NS>> !\.>
 141                               <SET HNUM
 142                                    <PUTBITS .HNUM <BITS 8 <* .CT 8>> .ACC>>
 143                               <SET ACC 0>
 144                               <SET CT <+ .CT 1>>)
 145                              (<AND <G=? <ASCII .CHR> <ASCII !\0>>
 146                                    <L=? <ASCII .CHR> <ASCII !\9>>>
 147                               <SET ACC
 148                                    <+ <* .ACC 10>
 149                                       <- <ASCII .CHR> <ASCII !\0>>>>)
 150                              (T
 151                               <SET HNUM
 152                                    <PUTBITS .HNUM <BITS 8 <* .CT 8>> .ACC>>
 153                               <RETURN .HNUM>)>
 154                        <SET NS <REST .NS>>>)
 155               (!'(,WH-NUMHOST ,WH-HOSTNAME)
 156                <SET NS <FIND-BREAK .NS .STR>>
 157                <SET NS <FIND-NON-BREAK .NS .STR>>
 158                <SET STR <FIND-BREAK .NS .STR>>
 159                <SUBSTRUC .NS 0 <- <LENGTH .NS> <LENGTH .STR>>>)
 160               (,WH-NICKNAMES
 161                <SET NS <FIND-NON-BREAK <FIND-BREAK .NS .STR> .STR>>
 162                <MAPF ,VECTOR
 163                  <FUNCTION ()
 164                     <SET NNS <FIND-BREAK .NS .STR>>
 165                     <COND (<==? <1 .NNS> <ASCII 10>>
 166                            <MAPSTOP
 167                             <SUBSTRUC .NS 0 <- <LENGTH .NS> <LENGTH .NNS>>>>)
 168                           (T
 169                            <SET TS
 170                             <SUBSTRUC .NS 0 <- <LENGTH .NS> <LENGTH .NNS>>>>
 171                            <SET NS <FIND-NON-BREAK .NNS .STR>>
 172                            .TS)>>>)>>
 173
 174 <DEFINE FIND-BREAK (STRT END)
 175   #DECL ((STRT END) STRING)
 176   <REPEAT ()
 177     <COND (<==? .STRT .END> <RETURN <>>)>
 178     <COND (<MEMQ <1 .STRT> ,BREAKS> <RETURN .STRT>)>
 179     <SET STRT <REST .STRT>>>>
 180
 181 <DEFINE FIND-NON-BREAK (STRT END)
 182   #DECL ((STRT END) STRING)
 183   <REPEAT ()
 184     <COND (<==? .STRT .END> <RETURN <>>)>
 185     <COND (<NOT <MEMQ <1 .STRT> ,BREAKS>> <RETURN .STRT>)>
 186     <SET STRT <REST .STRT>>>>
 187
 188 <ENDPACKAGE>