mim/development/mim/20/tway.mud

   1 <PACKAGE "TWAY">
   2
   3 <ENTRY TS-RJFN TS-MODE TS-BSZ TS-RBUF TS-RBC TS-WJFN TS-WBUF
   4        TS-WBC TS-EXTRA TWAY-READ-BYTE TWAY-READ-BUFFER TWAY-WRITE-BUFFER
   5        TWAY-WRITE-BYTE TTY-CHANNEL DUMP-WRITE-BUFFER TWAY-BUFOUT>
   6
   7 <NEW-CHANNEL-TYPE TWAY DEFAULT
   8                  OPEN TWAY-OPEN
   9                  CLOSE TWAY-CLOSE
  10                  READ-BYTE TWAY-READ-BYTE
  11                  FILL-READ-BUFFER TWAY-FILL-READ
  12                  WRITE-BYTE TWAY-WRITE-BYTE
  13                  READ-BUFFER TWAY-READ-BUFFER
  14                  WRITE-BUFFER TWAY-WRITE-BUFFER
  15                  BUFOUT TWAY-BUFOUT
  16                  PRINT-DATA TWAY-PRINT-DATA>
  17
  18 <MSETG TS-RJFN %<OFFSET 1 '<OR TTY-CHANNEL TWAY-BASE>>>
  19 <MSETG TS-MODE %<OFFSET 2 '<OR TTY-CHANNEL TWAY-BASE>>>
  20 <MSETG TS-BSZ %<OFFSET 3 '<OR TTY-CHANNEL TWAY-BASE>>>
  21 <MSETG TS-RBUF %<OFFSET 4 '<OR TTY-CHANNEL TWAY-BASE>>>
  22 <MSETG TS-RBC %<OFFSET 5 '<OR TTY-CHANNEL TWAY-BASE>>>
  23 <MSETG TS-WJFN %<OFFSET 6 '<OR TTY-CHANNEL TWAY-BASE>>>
  24 <MSETG TS-WBUF %<OFFSET 7 '<OR TTY-CHANNEL TWAY-BASE>>>
  25 <MSETG TS-WBC %<OFFSET 8 '<OR TTY-CHANNEL TWAY-BASE>>>
  26 <MSETG TS-EXTRA %<OFFSET 9 '<OR TTY-CHANNEL TWAY-BASE>>>
  27
  28 ;"<NEWSTRUC TWAY-CHANNEL (VECTOR)
  29           TS-RJFN FIX
  30           TS-MODE FIX
  31           TS-BSZ FIX
  32           TS-RBUF <OR FALSE STRING UVECTOR>
  33           TS-RBC FIX
  34           TS-WJFN <OR FIX FALSE>
  35           TS-WBUF <OR FALSE STRING UVECTOR>
  36           TS-WBC FIX
  37           \"REST\"
  38           TS-EXTRA ANY>"
  39
  40 <NEWSTRUC TWAY-BASE VECTOR
  41           TB-RJFN FIX
  42           TB-MODE FIX
  43           TB-BSZ FIX
  44           TB-RBUF <OR FALSE STRING UVECTOR>
  45           TB-RBC FIX
  46           TB-WJFN <OR FIX FALSE>
  47           TB-WBUF <OR FALSE STRING UVECTOR>
  48           TB-WBC FIX>
  49
  50 <SETG BUFFERED <UVECTOR %,/DVDSK %,/DVMTA %,/DVLPT %,/DVNUL %,/DVNET>>
  51
  52 <GDECL (BUFFERED) <UVECTOR [REST FIX]>>
  53
  54 <DEFINE TWAY-OPEN (STYPE OPER NAME MODS
  55                    "OPTIONAL" (BYTES "ASCII") (OBUF? 1) (IBUF? 1)
  56                    "AUX" (NEW? <>) MODE RJFN WJFN BSZ (WRITE? <>) (BUF? <>))
  57         #DECL ((NAME MODS BYTES) STRING (IBUF? OBUF?) <OR FIX ATOM FALSE>
  58                (NEW? BUF?) <OR ATOM FALSE> (MODE BSZ) FIX
  59                (RJFN WJFN) <OR FIX FALSE>)
  60         <COND (<=? .MODS "READ">
  61                <SET MODE %<CHTYPE <ORB ,OF-RD ,OF-EX ,OF-PLN> FIX>>)
  62               (<=? .MODS "CREATE">
  63                <SET NEW? T>
  64                <SET WRITE? T>
  65                <SET MODE %<CHTYPE <ORB ,OF-RD ,OF-WR ,OF-EX ,OF-PLN> FIX>>)
  66               (<=? .MODS "MODIFY">
  67                <SET WRITE? T>
  68                <SET MODE %<CHTYPE <ORB ,OF-RD ,OF-WR ,OF-EX ,OF-PLN> FIX>>)
  69               (T <ERROR ILLEGAL-MODE .MODS TWAY-OPEN>)>
  70         <COND (<=? .BYTES "ASCII"> <SET BSZ 7>)
  71               (<=? .BYTES "BINARY"> <SET BSZ 36>)
  72               (T <ERROR ILLEGAL-BYTE-SIZE .BYTES TWAY-OPEN>)>
  73         <COND (<SET RJFN <GET-JFN .NAME .MODE .BSZ .NEW?>>
  74                <COND (<OR <TYPE? .IBUF? FIX> <TYPE? .OBUF? FIX>>
  75                       <COND (<MEMQ <GET-DEVICE-TYPE .RJFN> ,BUFFERED>
  76                              <SET BUF? T>)>
  77                       <COND (<TYPE? .IBUF? FIX> <SET IBUF? .BUF?>)>
  78                       <COND (<TYPE? .OBUF? FIX> <SET OBUF? .BUF?>)>)>
  79                <CHTYPE [.RJFN
  80                         .MODE
  81                         .BSZ
  82                         <COND (.IBUF? <MAKE-BUFFER .BSZ>)>
  83                         0
  84                         <COND (.WRITE? .RJFN)>
  85                         <COND (<AND .WRITE? .OBUF?> <MAKE-BUFFER .BSZ>)>
  86                         0] TWAY-BASE>)>>
  87
  88 <DEFINE MAKE-BUFFER (BSZ)
  89   #DECL ((BSZ) FIX)
  90   <COND (<==? .BSZ 7>
  91          <ISTRING 320>)
  92         (<IUVECTOR 64>)>>
  93 \\f
  94
  95 <DEFINE TWAY-READ-BYTE TWB (CHANNEL OPER "AUX" (DATA <CHANNEL-DATA .CHANNEL>)
  96                         (IBUF <TS-RBUF .DATA>) VAL)
  97   #DECL ((CHANNEL) CHANNEL (DATA) <OR TWAY-BASE TTY-CHANNEL>
  98          (IBUF) <OR FALSE STRING UVECTOR>)
  99   <COND (.IBUF
 100          <COND (<0? <TS-RBC .DATA>>
 101                 ; "This allows CHANNELs to do funny buffering without
 102                    re-inventing the wheel."
 103                 <COND (<NOT <SET VAL <FCHANNEL-OP .CHANNEL FILL-READ-BUFFER>>>
 104                        <RETURN .VAL .TWB>)>
 105                 <SET IBUF <TS-RBUF .DATA>>)>
 106          <COND (<0? <TS-RBC .DATA>>
 107                 <>)
 108                (T
 109                 <SET VAL <1 .IBUF>>
 110                 <TS-RBC .DATA <- <TS-RBC .DATA> 1>>
 111                 <TS-RBUF .DATA <REST .IBUF>>
 112                 .VAL)>)
 113         (T
 114          <COND (<SET VAL <CALL SYSOP BIN <TS-RJFN .DATA> '(RETURN 2)>>
 115                 <COND (<==? <TS-BSZ .DATA> 7> <CHTYPE .VAL CHARACTER>)
 116                       (.VAL)>)>)>>
 117
 118 <DEFINE TWAY-FILL-READ (CHANNEL OPER
 119                         "AUX" (DATA <CHANNEL-DATA .CHANNEL>)
 120                               (JFN <TS-RJFN .DATA>) (BUF <TOP <TS-RBUF .DATA>>)
 121                               NB CT)
 122         #DECL ((CHANNEL) CHANNEL (DATA) <OR TWAY-BASE TTY-CHANNEL> (JFN) FIX
 123                (BUF) <OR STRING UVECTOR> (CT) <OR FIX FALSE>)
 124         <COND (<SET NB <CALL SYSOP SIN-JSYS .JFN .BUF
 125                              <- <SET CT <LENGTH .BUF>>>>>
 126                <SET CT <- .CT <LENGTH .NB>>>
 127                <TS-RBUF .DATA .BUF>
 128                <TS-RBC .DATA .CT>
 129                .CT)>>
 130
 131 <DEFINE TWAY-READ-BUFFER (CHANNEL OPER BUF "OPTIONAL" (LEN <LENGTH .BUF>)
 132                           (CONT 0)
 133                           "AUX" (DATA <CHANNEL-DATA .CHANNEL>)
 134                                 (IBUF <TS-RBUF .DATA>) BC)
 135   #DECL ((CHANNEL) CHANNEL (BUF) <OR STRING UVECTOR> (BC LEN CONT) FIX
 136          (DATA) <OR TWAY-BASE TTY-CHANNEL> (IBUF) <OR FALSE STRING UVECTOR>)
 137   <SET LEN <MIN .LEN <CALL LENU .BUF>:FIX>>
 138   <COND (<NOT .IBUF>
 139          <COND (<SET IBUF <CALL SYSOP SIN-JSYS <TS-RJFN .DATA>
 140                                 <REST .BUF .CONT> <- <SET BC <- .LEN .CONT>>>>>
 141                 <SET BC <- .BC <LENGTH .IBUF>>>
 142                 <+ .CONT .BC>)>)
 143         (T
 144          <COND (<N==? <PRIMTYPE .IBUF> <PRIMTYPE .BUF>>
 145                 <ERROR WRONG-TYPE-BUFFER .BUF TWAY-READ-BUFFER>)>
 146          <SET BUF <REST .BUF .CONT>>
 147          <SET LEN <- .LEN .CONT>>
 148          <REPEAT ((RD .CONT) (TRANS -1))
 149            #DECL ((RD) FIX (ONCE?) <OR ATOM FALSE>)
 150            <COND (<NOT <0? <SET BC <TS-RBC .DATA>>>>
 151                   <SET TRANS <MIN .BC .LEN>>
 152                   <PROG ((CT 0))
 153                     #DECL ((CT) FIX)
 154                     <COND (<TYPE? .IBUF STRING>
 155                            <MAPR <>
 156                              <FUNCTION (IB B)
 157                                #DECL ((IB B) STRING)
 158                                <1 .B <1 .IB>>
 159                                <COND (<G=? <SET CT <+ .CT 1>> .TRANS>
 160                                       <MAPLEAVE>)>>
 161                               .IBUF <CHTYPE .BUF STRING>>)
 162                           (<TYPE? .IBUF UVECTOR>
 163                            <MAPR <>
 164                              <FUNCTION (IB B)
 165                                #DECL ((IB B) UVECTOR)
 166                                <1 .B <1 .IB>>
 167                                <COND (<G=? <SET CT <+ .CT 1>> .TRANS>
 168                                       <MAPLEAVE>)>>
 169                              <CHTYPE .IBUF UVECTOR>
 170                              <CHTYPE .BUF UVECTOR>>)>>
 171                   <SET BUF <REST .BUF .TRANS>>
 172                   <SET RD <+ .TRANS .RD>>
 173                   <TS-RBUF .DATA <REST .IBUF .TRANS>>
 174                   <TS-RBC .DATA <- .BC .TRANS>>
 175                   <SET LEN <- .LEN .TRANS>>)>
 176            <COND (<OR <0? .LEN> <0? .TRANS>>
 177                   <RETURN .RD>)
 178                  (T
 179                   <COND (<OR <NOT <FCHANNEL-OP .CHANNEL FILL-READ-BUFFER>>
 180                              <0? <TS-RBC .DATA>>>
 181                          <RETURN .RD>)>
 182                   <SET IBUF <TS-RBUF .DATA>>)>>)>>
 183 \\f
 184 <DEFINE TWAY-WRITE-BYTE (CHANNEL OPER BYTE "AUX" (DATA <CHANNEL-DATA .CHANNEL>)
 185                          (JFN <TS-WJFN .DATA>) (BUF <TS-WBUF .DATA>))
 186   #DECL ((CHANNEL) CHANNEL (BYTE) <OR CHARACTER FIX>
 187          (DATA) <OR TWAY-BASE TTY-CHANNEL> (JFN) <OR FALSE FIX>)
 188   <COND (<NOT .JFN>
 189          <ERROR CHANNEL-NOT-OPEN-FOR-WRITING .CHANNEL TWAY-WRITE-BYTE>)>
 190   <COND (<NOT .BUF>
 191          <CALL SYSOP BOUT .JFN <CHTYPE .BYTE FIX> '(RETURN 2)>)
 192         (T
 193          <COND (<EMPTY? .BUF>
 194                 <DUMP-WRITE-BUFFER .DATA>
 195                 <SET BUF <TS-WBUF .DATA>>)>
 196          <1 .BUF <COND (<TYPE? .BUF UVECTOR>
 197                         <CHTYPE .BYTE FIX>)
 198                        (<CHTYPE .BYTE CHARACTER>)>>
 199          <TS-WBUF .DATA <REST .BUF>>
 200          <TS-WBC .DATA <+ <TS-WBC .DATA> 1>>)>
 201   .BYTE>
 202
 203 <DEFINE DUMP-WRITE-BUFFER (DATA "AUX" VAL BUF)
 204   #DECL ((DATA) <OR TWAY-BASE TTY-CHANNEL>)
 205   <COND (<NOT <0? <TS-WBC .DATA>>>
 206          <COND (<SET VAL <CALL SYSOP SOUT <TS-WJFN .DATA>
 207                                <SET BUF <CALL TOPU <TS-WBUF .DATA>>>
 208                                <- <TS-WBC .DATA>>>>
 209                 <TS-WBC .DATA 0>)>)>
 210   <TS-WBUF .DATA <TOP <TS-WBUF .DATA>>>>
 211
 212 <DEFINE TWAY-BUFOUT (CHANNEL OPER "OPTIONAL" (FORCE? T)
 213                      "AUX" (DATA <CHANNEL-DATA .CHANNEL>)
 214                      (JFN <TS-WJFN .DATA>) (BC <TS-WBC .DATA>)
 215                      (BUF <TS-WBUF .DATA>))
 216   #DECL ((CHANNEL) CHANNEL (DATA) <OR TWAY-BASE TTY-CHANNEL> (JFN) <OR FALSE FIX>
 217          (BC) FIX (BUF) <OR FALSE UVECTOR STRING> (FORCE?) <OR ATOM FALSE>)
 218   <COND (.JFN
 219          <COND (<AND .BUF <NOT <0? .BC>>>
 220                 <DUMP-WRITE-BUFFER .DATA>)>
 221          <COND (.FORCE? <CALL SYSOP DOBE .JFN>)>
 222          T)>>
 223
 224 <DEFINE TWAY-WRITE-BUFFER (CHANNEL OPER BUF "OPTIONAL" (LEN <CALL LENU .BUF>)
 225                            "AUX" (DATA <CHANNEL-DATA .CHANNEL>)
 226                                  (JFN <TS-WJFN .DATA>) (OBUF <TS-WBUF .DATA>))
 227   #DECL ((CHANNEL) CHANNEL (BUF) <OR STRING BYTES UVECTOR> (JFN) <OR FIX FALSE>
 228          (LEN) FIX)
 229   <COND (<NOT .JFN>
 230          <ERROR CHANNEL-NOT-OPEN-FOR-WRITING .CHANNEL TWAY-WRITE-BUFFER>)>
 231   <SET LEN <MIN .LEN <CALL LENU .BUF>:FIX>>
 232   <COND (<OR <NOT .OBUF>
 233              <N==? <ANDB <CALL TYPE .OBUF> *7*>
 234                    <ANDB <CALL TYPE .BUF> *7*>>>
 235          <COND (.OBUF
 236                 <DUMP-WRITE-BUFFER .DATA>)>
 237          <COND (<G? .LEN 0>
 238                 <COND (<SET OBUF <CALL SYSOP SOUT .JFN .BUF <- .LEN>>>
 239                        <- <CALL LENU .BUF>:FIX <CALL LENU .OBUF>:FIX>)>)
 240                (0)>)
 241         (T
 242          <REPEAT ((RD 0) TRANS CT)
 243            #DECL ((CT RD TRANS) FIX)
 244            <COND (<0? .LEN>
 245                   <RETURN .RD>)
 246                  (<EMPTY? .OBUF>
 247                   <DUMP-WRITE-BUFFER .DATA>
 248                   <SET OBUF <TS-WBUF .DATA>>)>
 249            <SET CT 0>
 250            <SET TRANS <MIN <CALL LENU .OBUF>:FIX .LEN>>
 251            <COND (<TYPE? .BUF STRING>
 252                   <MAPR <>
 253                     <FUNCTION (B OB)
 254                       #DECL ((B OB) STRING)
 255                       <1 .OB <1 .B>>
 256                       <COND (<G=? <SET CT <+ .CT 1>> .TRANS>
 257                              <MAPLEAVE>)>>
 258                     .BUF <CHTYPE .OBUF STRING>>)
 259                  (<MAPR <>
 260                     <FUNCTION (B OB)
 261                       #DECL ((B OB) UVECTOR)
 262                       <1 .OB <1 .B>>
 263                       <COND (<G=? <SET CT <+ .CT 1>> .TRANS>
 264                              <MAPLEAVE>)>>
 265                     <CHTYPE .BUF UVECTOR>
 266                     <CHTYPE .OBUF UVECTOR>>)>
 267            <SET BUF <REST .BUF .TRANS>>
 268            <TS-WBUF .DATA <SET OBUF <REST .OBUF .TRANS>>>
 269            <TS-WBC .DATA <+ <TS-WBC .DATA> .TRANS>>
 270            <SET RD <+ .RD .TRANS>>
 271            <SET LEN <- .LEN .TRANS>>>)>>
 272 \\f
 273 <DEFINE TWAY-CLOSE (CHANNEL OPER "AUX" (DATA <CHANNEL-DATA .CHANNEL>))
 274   #DECL ((CHANNEL) CHANNEL (DATA) <OR TWAY-BASE TTY-CHANNEL>)
 275   <COND (<TS-WJFN .DATA>
 276          <COND (<TS-WBUF .DATA>
 277                 <DUMP-WRITE-BUFFER .DATA>)>
 278          <CALL SYSOP CLOSF <TS-WJFN .DATA>>)>
 279   <COND (<N==? <TS-RJFN .DATA> <TS-WJFN .DATA>>
 280          <CALL SYSOP CLOSF <TS-RJFN .DATA>>)>
 281   <TS-WJFN .DATA -1>
 282   <TS-RJFN .DATA -1>>
 283
 284 <DEFINE TWAY-PRINT-DATA (CHANNEL OPER OUTCHAN
 285                          "AUX" (DATA <CHANNEL-DATA .CHANNEL>))
 286   #DECL ((CHANNEL) CHANNEL (DATA) <OR TWAY-BASE TTY-CHANNEL>)
 287   <PRINC "#TWAY-CHANNEL [">
 288   <PRINC "RJFN:">
 289   <PRINC <TS-RJFN .DATA>>
 290   <PRINC " MODE:">
 291   <PRIN1 <TS-MODE .DATA>>
 292   <PRINC " BSZ:">
 293   <PRIN1 <TS-BSZ .DATA>>
 294   <COND (<TS-RBUF .DATA>
 295          <PRINC " RBUF:">
 296          <PRIN1 <TS-RBC .DATA>>
 297          <PRINC !\/>
 298          <PRIN1 <LENGTH <TOP <TS-RBUF .DATA>>>>)>
 299   <COND (<TS-WJFN .DATA>
 300          <PRINC " WJFN:">
 301          <PRINC <TS-WJFN .DATA>>
 302          <COND (<TS-WBUF .DATA>
 303                 <PRINC " WBUF:">
 304                 <PRIN1 <TS-WBC .DATA>>
 305                 <PRINC !\/>
 306                 <PRIN1 <LENGTH <TOP <TS-WBUF .DATA>>>>)>)>
 307   <PRINC !\]>
 308   T>
 309
 310 <ENDPACKAGE>