mim/development/mim/20/disk.mud

   1 "I/O for non-paged disk:  may or may not use buffers (according to user
   2  desires), never uses pmap.  Note that input and output use the same buffer,
   3 so this is not suitable for devices that don't random-access (chaos net, tty,
   4 ...)."
   5
   6 "Possible modes:  READ, CREATE, MODIFY, APPEND/ASCII, BINARY, 8BIT"
   7
   8 <DEFINE X$DISK-FILE-HANDLE (CHANNEL OPR "AUX" (DATA <T$CHANNEL-DATA .CHANNEL>))
   9   #DECL ((CHANNEL) T$CHANNEL (DATA) I$DISK-CHANNEL)
  10   <NS-JFN .DATA>>
  11
  12 <DEFINE X$DISK-QUERY (CHANNEL OPR BIT "AUX" (DATA <T$CHANNEL-DATA .CHANNEL>))
  13   #DECL ((CHANNEL) T$CHANNEL (BIT) FIX (DATA) I$DISK-CHANNEL)
  14   <COND (<==? .BIT ,T$BIT-ACCESS>
  15          T)>>
  16
  17 <DEFINE X$DISK-OPEN (STYPE OPR NAME MODS
  18                   "OPTIONAL" (BYTES "ASCII") (BUF? T) (THAWED? <>)
  19                   (NO-REF? <>)
  20                   "AUX" (NEW? <>) MODE JFN BSZ (APP? <>) PTR BUF)
  21         #DECL ((NAME MODS BYTES) STRING (NO-REF? THAWED? NEW?) <OR ATOM FALSE>
  22                (PTR MODE BSZ) FIX (JFN) <OR FIX FALSE>
  23                (BUF?) <OR ATOM FALSE>
  24                (APP?) <OR ATOM FALSE>)
  25         <COND (<S=? .MODS "READ">
  26                <SET MODE %<CHTYPE <ORB ,OF-RD ,OF-PLN> FIX>>)
  27               (<S=? .MODS "CREATE">
  28                <SET NEW? T>
  29                <SET MODE %<CHTYPE <ORB ,OF-RD ,OF-WR ,OF-PLN> FIX>>)
  30               (<S=? .MODS "MODIFY">
  31                <SET MODE %<CHTYPE <ORB ,OF-RD ,OF-WR ,OF-PLN> FIX>>)
  32               (<S=? .MODS "APPEND">
  33                <SET APP? T>
  34                <SET MODE %<CHTYPE <ORB ,OF-APP ,OF-RD ,OF-PLN> FIX>>)
  35               (T <ERROR %<P-E "ILLEGAL-MODE"> .MODS I$DISK-OPEN>)>
  36         <COND (<S=? .BYTES "ASCII"> <SET BSZ 7>)
  37               (<S=? .BYTES "8BIT"> <SET BSZ 8>)
  38               (<S=? .BYTES "BINARY"> <SET BSZ 36>)
  39               (T <ERROR %<P-E "ILLEGAL-BYTE-SIZE"> .BYTES I$DISK-OPEN>)>
  40         <COND (.THAWED? <SET MODE <ORB .MODE ,OF-THW>>)>
  41         <COND (.NO-REF? <SET MODE <ORB .MODE ,OF-PDT>>)>
  42         <COND (<SET JFN <T$GET-JFN .NAME .MODE .BSZ .NEW?>>
  43                <CHTYPE [.JFN
  44                         .MODE
  45                         .BSZ
  46                         <COND (.APP?
  47                                ;<CALL SYSOP SFPTR .JFN -1>
  48                                <SET PTR <T$GET-BYTE-COUNT .JFN .BSZ>>)
  49                               (<SET PTR 0>)>
  50                         .PTR
  51                         <SET BUF
  52                          <COND (.BUF?
  53                                 <COND (<==? .BSZ 7>
  54                                        <T$REQUEST-BUFFER <> T$STRING <>>)
  55                                       (<==? .BSZ 8>
  56                                        <T$REQUEST-BUFFER <> T$BYTES <>>)
  57                                       (T
  58                                        <T$REQUEST-BUFFER <> T$UVECTOR <>>)>)>>
  59                         0
  60                         0
  61                         <>
  62                         .BUF]
  63                        I$DISK-CHANNEL>)>>
  64
  65 <DEFINE X$DISK-FLUSH (CHANNEL OPER "AUX" (DATA <T$CHANNEL-DATA .CHANNEL>) VAL)
  66   #DECL ((CHANNEL) T$CHANNEL (DATA) I$DISK-CHANNEL)
  67   <SET VAL <CALL SYSOP CLOSF <ORB ,CZ-ABT <NS-JFN .DATA>>>>
  68   <COND (<NS-TBUF .DATA>
  69          <T$RELEASE-BUFFER <NS-TBUF .DATA>>)>
  70   <NS-BUF .DATA <>>
  71   <NS-TBUF .DATA <>>
  72   <NS-JFN .DATA -1>>
  73
  74 <DEFINE X$DISK-CLOSE (CHANNEL OPER "AUX" (DATA <T$CHANNEL-DATA .CHANNEL>) VAL)
  75         #DECL ((CHANNEL) T$CHANNEL (DATA) I$DISK-CHANNEL)
  76         <I$FLUSH-BUFFER .DATA>
  77         <COND (<NS-TBUF .DATA>
  78                <T$RELEASE-BUFFER <NS-TBUF .DATA>>)>
  79         <NS-TBUF .DATA <>>
  80         <NS-BUF .DATA <>>
  81         <SET VAL <CALL SYSOP CLOSF <NS-JFN .DATA>>>
  82         <NS-JFN .DATA -1>>
  83
  84 \\f
  85
  86 <DEFINE X$DISK-READ-BYTE (CHANNEL OPER
  87                        "AUX" (DATA <T$CHANNEL-DATA .CHANNEL>)
  88                        (BUF <NS-BUF .DATA>) BYTE BC)
  89         #DECL ((CHANNEL) T$CHANNEL (DATA) I$DISK-CHANNEL
  90                (BUF) <OR STRING BYTES FALSE UVECTOR> (BC) FIX)
  91         <COND (<NOT .BUF>
  92                <COND (<SET BYTE <CALL SYSOP BIN <NS-JFN .DATA> '(RETURN 2)>>
  93                       <NS-PTR .DATA <+ <NS-PTR .DATA> 1>>
  94                       <NS-SPTR .DATA <NS-PTR .DATA>>
  95                       <COND (<==? <NS-BSZ .DATA> 7> <CHTYPE .BYTE CHARACTER>)
  96                             (.BYTE)>)>)
  97               (T
  98                <PROG ((ONCE? <>))
  99                      #DECL ((ONCE?) <OR ATOM FALSE>)
 100                      <COND (<NOT <0? <SET BC <NS-BC .DATA>>>>
 101                             <SET BYTE <1 .BUF>>
 102                             <NS-PTR .DATA <+ <NS-PTR .DATA> 1>>
 103                             <NS-BUF .DATA <COND (<TYPE? .BUF STRING>
 104                                                  <REST .BUF>)
 105                                                 (<TYPE? .BUF UVECTOR>
 106                                                  <REST .BUF>)
 107                                                 (<TYPE? .BUF BYTES>
 108                                                  <REST .BUF>)>>
 109                             <NS-BC .DATA <- .BC 1>>
 110                             .BYTE)
 111                            (.ONCE? <>)
 112                            (<I$READ-BUFFER .DATA>
 113                             <SET BUF <NS-BUF .DATA>>
 114                             <SET ONCE? T>
 115                             <AGAIN>)>>)>>
 116
 117 <DEFINE I$DO-SOUT (JFN BUF LEN "AUX" VAL)
 118   #DECL ((JFN LEN) FIX)
 119   <COND (<0? .LEN> 0)
 120         (<SET VAL <CALL SYSOP SOUT .JFN .BUF <- .LEN>>>
 121          <- <CALL LENU .BUF>:FIX <CALL LENU .VAL>:FIX>)>>
 122
 123 <DEFINE I$DO-SIN (JFN BUF LEN START "AUX" VAL STS)
 124   #DECL ((START JFN LEN) FIX)
 125   <COND (<0? .LEN> 0)
 126         (<SET VAL <CALL SYSOP SIN-JSYS .JFN .BUF <- .LEN>>>
 127          <- <CALL LENU .BUF>:FIX <CALL LENU .VAL>:FIX>)
 128         (T
 129          <SET STS <CALL SYSOP GTSTS .JFN '(RETURN 2)>>
 130          <COND (<NOT <0? <ANDB .STS ,GS-EOF>>>
 131                 <- <CALL SYSOP RFPTR .JFN '(RETURN 2)>:FIX
 132                    .START>)
 133                (.VAL)>)>>
 134
 135 <DEFINE I$READ-BUFFER (DATA
 136                      "AUX" (JFN <NS-JFN .DATA>) CT (OB <NS-BUF .DATA>)
 137                            (BUF <NS-TBUF .DATA>)
 138                            STS)
 139         #DECL ((DATA) I$DISK-CHANNEL (STS CT) <OR FIX FALSE> (JFN) FIX
 140                (OB BUF) <OR BYTES UVECTOR STRING>)
 141         <COND (<NS-WRITE-BUF? .DATA> <I$FLUSH-BUFFER .DATA>)>
 142         <COND (<NOT <SET CT <I$DO-SIN .JFN .BUF
 143                                       <COND (<TYPE? .BUF STRING><LENGTH .BUF>)
 144                                             (<TYPE? .BUF UVECTOR><LENGTH .BUF>)
 145                                             (<LENGTH .BUF>)>
 146                                       <NS-SPTR .DATA>>>>
 147                <ERROR %<P-E "ERROR-ON-READ"> .CT I$READ-BUFFER>)>
 148         <NS-BUF .DATA .BUF>
 149         <NS-SPTR .DATA <+ <NS-SPTR .DATA> .CT>>
 150         <NS-BC .DATA .CT>
 151         <NS-OBC .DATA .CT>>
 152
 153 <DEFINE X$DISK-READ-BUFFER (CHANNEL OPER BUFFER
 154                          "OPTIONAL" CT (CONT 0)
 155                          "AUX" (DATA <T$CHANNEL-DATA .CHANNEL>)
 156                                (IBUF <NS-BUF .DATA>) TRANS BC RD
 157                                PT)
 158         #DECL ((CHANNEL) T$CHANNEL (BUFFER) <OR <PRIMTYPE STRING>
 159                                                 <PRIMTYPE BYTES>
 160                                                 <PRIMTYPE UVECTOR>>
 161                (CT CONT) FIX
 162                (DATA) I$DISK-CHANNEL (IBUF) <OR STRING UVECTOR FALSE BYTES>
 163                (BC) FIX (TRANS RD) <OR FIX FALSE>)
 164         <SET PT <ANDB ,M$$TYSAT <CALL TYPE .BUFFER>>>
 165         <COND (<AND .IBUF <N==? <ANDB ,M$$TYSAT <CALL TYPE .IBUF>> .PT>>
 166                <ERROR %<P-E "BUFFER-IS-WRONG-TYPE">
 167                       <TYPE .BUFFER> I$DISK-READ-BUFFER>)>
 168         <COND
 169          (<NOT <ASSIGNED? CT>>
 170           <SET CT
 171                <CASE ,==? .PT
 172                      (,M$$T-STR <LENGTH .BUFFER:STRING>)
 173                      (,M$$T-UVC <LENGTH .BUFFER:UVECTOR>)
 174                      (,M$$T-BYT <LENGTH .BUFFER:BYTES>)>>)>
 175         <SET CT <MIN .CT <CALL LENU .BUFFER>:FIX>>
 176         <COND
 177          (<0? .CT> 0)
 178          (T <REPEAT ((RD 0) DONE)
 179                 #DECL ((RD DONE) FIX)
 180                 <COND (<AND .IBUF <NOT <0? <SET BC <NS-BC .DATA>>>>>
 181                        <SET TRANS <MIN .BC .CT>>
 182                        <SET DONE 0>
 183                        <CASE ,==? .PT
 184                         (,M$$T-STR
 185                          <SUBSTRUC .IBUF:STRING 0 .TRANS .BUFFER:STRING>
 186                          <SET RD <+ .RD .TRANS>>
 187                          <SET CT <- .CT .TRANS>>
 188                          <NS-BUF .DATA <REST .IBUF:STRING .TRANS>>
 189                          <NS-BC .DATA <- .BC .TRANS>>
 190                          <SET BUFFER
 191                               <REST .BUFFER:STRING .TRANS>>
 192                          <NS-PTR .DATA <+ <NS-PTR .DATA> .TRANS>>)
 193                         (,M$$T-UVC
 194                          <SUBSTRUC .IBUF:UVECTOR 0 .TRANS .BUFFER:UVECTOR>
 195                          <SET RD <+ .RD .TRANS>>
 196                          <SET CT <- .CT .TRANS>>
 197                          <NS-BUF .DATA <REST .IBUF:UVECTOR .TRANS>>
 198                          <NS-BC .DATA <- .BC .TRANS>>
 199                          <SET BUFFER
 200                               <REST .BUFFER:UVECTOR .TRANS>>
 201                          <NS-PTR .DATA <+ <NS-PTR .DATA> .TRANS>>)
 202                         (,M$$T-BYT
 203                          <SUBSTRUC .IBUF:BYTES 0 .TRANS .BUFFER:BYTES>
 204                          <SET RD <+ .RD .TRANS>>
 205                          <SET CT <- .CT .TRANS>>
 206                          <NS-BUF .DATA <REST .IBUF:BYTES .TRANS>>
 207                          <NS-BC .DATA <- .BC .TRANS>>
 208                          <SET BUFFER
 209                               <REST .BUFFER:BYTES .TRANS>>
 210                          <NS-PTR .DATA <+ <NS-PTR .DATA> .TRANS>>)>)>
 211                 <COND (<NOT <0? .CT>>
 212                      ;"Only use the buffer here if it might save a system call"
 213                        <COND (<AND .IBUF
 214                                    <L? .CT <CASE ,==? .PT
 215                                                  (,M$$T-STR
 216                                                   <LENGTH
 217                                                    <NS-TBUF .DATA>:STRING>)
 218                                                  (,M$$T-UVC
 219                                                   <LENGTH
 220                                                    <NS-TBUF .DATA>:UVECTOR>)
 221                                                  (,M$$T-BYT
 222                                                   <LENGTH
 223                                                    <NS-TBUF .DATA>:BYTES>)>>>
 224                               <I$READ-BUFFER .DATA>
 225                               <COND (<0? <NS-BC .DATA>>
 226                                      <RETURN .RD>)>
 227                               <SET IBUF <NS-BUF .DATA>>)
 228                              (<SET TRANS
 229                                    <I$DO-SIN <NS-JFN .DATA>
 230                                              .BUFFER
 231                                              .CT
 232                                              <NS-SPTR .DATA>>>
 233                               <NS-PTR .DATA <+ <NS-PTR .DATA> .TRANS>>
 234                               <NS-SPTR .DATA <+ <NS-SPTR .DATA> .TRANS>>
 235                               <NS-OBC .DATA 0>
 236                               <COND (.IBUF <NS-BUF .DATA <NS-TBUF .DATA>>)>
 237                               <RETURN <+ .TRANS .RD>>)
 238                              (<RETURN .TRANS>)>)
 239                       (<RETURN .RD>)>>)>>
 240
 241 \\f
 242
 243 <DEFINE X$DISK-WRITE-BYTE (CHANNEL OPER BYTE
 244                         "AUX" (DATA <T$CHANNEL-DATA .CHANNEL>)
 245                               (BUF <NS-BUF .DATA>) (PT <ANDB <CALL TYPE .BUF>
 246                                                              ,M$$TYSAT>))
 247         #DECL ((CHANNEL) T$CHANNEL (BYTE) <OR FIX CHARACTER>
 248                (DATA) I$DISK-CHANNEL
 249                (BUF) <OR FALSE BYTES STRING UVECTOR>)
 250         <COND (<0? <ANDB <NS-MODE .DATA> %<+ ,OF-WR ,OF-APP>>>
 251                <ERROR %<P-E "CHANNEL-NOT-OPEN-FOR-WRITING">
 252                       .CHANNEL I$DISK-WRITE-BYTE>)>
 253         <COND (<NOT .BUF>
 254                <CALL SYSOP BOUT <NS-JFN .DATA> .BYTE>
 255                <NS-PTR .DATA <+ <NS-PTR .DATA> 1>>
 256                <NS-SPTR .DATA <+ <NS-SPTR .DATA> 1>>
 257                .BYTE)
 258               (T
 259                <COND (<CASE ,==? .PT
 260                             (,M$$T-STR <EMPTY? .BUF:STRING>)
 261                             (,M$$T-UVC <EMPTY? .BUF:UVECTOR>)
 262                             (,M$$T-BYT <EMPTY? .BUF:BYTES>)>
 263                       <I$FLUSH-BUFFER .DATA>
 264                       <SET BUF <NS-BUF .DATA>>)>
 265                <CASE ,==? .PT
 266                 (,M$$T-STR
 267                  <1 .BUF:STRING .BYTE>
 268                  <NS-BUF .DATA <SET BUF <REST .BUF:STRING>>>
 269                  <NS-OBC .DATA
 270                          <MAX <NS-OBC .DATA>
 271                               <- <LENGTH <NS-TBUF .DATA>:STRING>
 272                                  <LENGTH .BUF:STRING>>>>)
 273                 (,M$$T-UVC
 274                  <1 .BUF:UVECTOR .BYTE>
 275                  <NS-BUF .DATA <SET BUF <REST .BUF:UVECTOR>>>
 276                  <NS-OBC .DATA
 277                          <MAX <NS-OBC .DATA>
 278                               <- <LENGTH <NS-TBUF .DATA>:UVECTOR>
 279                                  <LENGTH .BUF:UVECTOR>>>>)
 280                 (,M$$T-BYT
 281                  <1 .BUF:BYTES .BYTE>
 282                  <NS-BUF .DATA <SET BUF <REST .BUF:BYTES>>>
 283                  <NS-OBC .DATA
 284                          <MAX <NS-OBC .DATA>
 285                               <- <LENGTH <NS-TBUF .DATA>:BYTES>
 286                                  <LENGTH .BUF:BYTES>>>>)>
 287                <NS-PTR .DATA <+ <NS-PTR .DATA> 1>>
 288                <NS-WRITE-BUF? .DATA T>
 289                <NS-BC .DATA <MAX 0 <- <NS-BC .DATA> 1>>>
 290                .BYTE)>>
 291
 292 <DEFINE I$FLUSH-BUFFER (DATA
 293                         "AUX" (BUF <NS-BUF .DATA>) LEN SP (JFN <NS-JFN .DATA>)
 294                               TB (PT <ANDB <CALL TYPE .BUF> ,M$$TYSAT>))
 295         #DECL ((DATA) I$DISK-CHANNEL (BUF) <OR BYTES UVECTOR STRING FALSE>
 296                (JFN SP LEN) FIX)
 297         <COND (<NS-WRITE-BUF? .DATA>
 298                <NS-WRITE-BUF? .DATA <>>
 299                <COND (.BUF
 300                       <SET SP <- <NS-PTR .DATA>
 301                                  <CASE ,==? .PT
 302                                        (,M$$T-STR
 303                                         <- <LENGTH
 304                                             <SET TB <NS-TBUF .DATA>:STRING>>
 305                                            <LENGTH .BUF:STRING>>)
 306                                        (,M$$T-UVC
 307                                         <- <LENGTH
 308                                             <SET TB <NS-TBUF .DATA>:UVECTOR>>
 309                                            <LENGTH .BUF:UVECTOR>>)
 310                                        (,M$$T-BYT
 311                                         <- <LENGTH
 312                                             <SET TB <NS-TBUF .DATA>:BYTES>>
 313                                            <LENGTH .BUF:BYTES>>)>>>
 314                       <COND (<N==? <NS-SPTR .DATA> .SP>
 315                              <CALL SYSOP SFPTR .JFN .SP>
 316                              <NS-SPTR .DATA .SP>)>
 317                       <COND (<NOT <0? <SET LEN <NS-OBC .DATA>>>>
 318                              <CALL SYSOP SOUT .JFN .TB <- .LEN>>)>
 319                       <SET SP <+ .LEN <NS-SPTR .DATA>>>
 320                       <COND (<N==? .SP <NS-PTR .DATA>>
 321                              <SET SP <NS-PTR .DATA>>
 322                              <NS-SPTR .DATA .SP>
 323                              <CALL SYSOP SFPTR .JFN .SP>)
 324                             (<NS-SPTR .DATA .SP>)>
 325                       <NS-BUF .DATA .TB>
 326                       <NS-BC .DATA 0>
 327                       <NS-OBC .DATA 0>)>)
 328               (T
 329                <COND (<N==? <NS-PTR .DATA> <NS-SPTR .DATA>>
 330                       <CALL SYSOP SFPTR .JFN <NS-PTR .DATA>>)>
 331                <NS-SPTR .DATA <NS-PTR .DATA>>
 332                <NS-BC .DATA 0>
 333                <NS-OBC .DATA 0>
 334                <COND (.BUF <NS-BUF .DATA
 335                                    <NS-TBUF .DATA>>)>)>>
 336
 337 <DEFINE X$DISK-WRITE-BUFFER (CHANNEL OPER BUFFER
 338                           "OPTIONAL" LEN
 339                           "AUX" (PT <ANDB <CALL TYPE .BUFFER> ,M$$TYSAT>)
 340                                 (DATA <T$CHANNEL-DATA .CHANNEL>)
 341                                 (IBUF <NS-BUF .DATA>) (JFN <NS-JFN .DATA>)
 342                                 VAL TIB)
 343    #DECL ((CHANNEL) T$CHANNEL (JFN LEN) FIX
 344           (DATA) I$DISK-CHANNEL (IBUF) <OR BYTES UVECTOR STRING FALSE>
 345           (VAL) <OR FALSE FIX> (TIB) FIX (BUFFER) <OR <PRIMTYPE UVECTOR>
 346                                                        <PRIMTYPE STRING>
 347                                                        <PRIMTYPE BYTES>>)
 348    <COND (<NOT <ASSIGNED? LEN>>
 349           <SET LEN
 350            <CASE ,==? .PT
 351                 (,M$$T-STR <LENGTH .BUFFER:STRING>)
 352                 (,M$$T-UVC <LENGTH .BUFFER:UVECTOR>)
 353                 (,M$$T-BYT <LENGTH .BUFFER:BYTES>)>>)>
 354    <SET LEN <MIN .LEN <CALL LENU .BUFFER>:FIX>>
 355    <COND (<0? <ANDB <NS-MODE .DATA> %<+ ,OF-WR ,OF-APP>>>
 356           <ERROR %<P-E "CHANNEL-NOT-OPEN-FOR-WRITING">
 357                  .CHANNEL I$DISK-WRITE-BUFFER>)>
 358    <COND (<0? .LEN> 0)
 359          (<NOT .IBUF>
 360           <COND (<SET VAL <I$DO-SOUT .JFN .BUFFER .LEN>>
 361                  <NS-PTR .DATA <+ <NS-PTR .DATA> .VAL>>
 362                  <NS-SPTR .DATA <+ <NS-SPTR .DATA> .VAL>>
 363                  .VAL)>)
 364          (<N==? .PT <ANDB <CALL TYPE .IBUF> ,M$$TYSAT>>
 365           <ERROR %<P-E "BUFFER-IS-WRONG-TYPE">
 366                  <TYPE .BUFFER> I$DISK-WRITE-BUFFER>)
 367          (T
 368           <SET TIB
 369                <CASE ,==? .PT
 370                      (,M$$T-STR <LENGTH <NS-TBUF .DATA>:STRING>)
 371                      (,M$$T-UVC <LENGTH <NS-TBUF .DATA>:UVECTOR>)
 372                      (,M$$T-BYT <LENGTH <NS-TBUF .DATA>:BYTES>)>>
 373           <REPEAT ((RD 0) TRANS (IBUF .IBUF) DONE)
 374                   #DECL ((RD TRANS) FIX (IBUF) <OR BYTES STRING UVECTOR>)
 375                   <COND (<NOT <CASE ,==? .PT
 376                                     (,M$$T-STR <EMPTY? .IBUF:STRING>)
 377                                     (,M$$T-UVC <EMPTY? .IBUF:UVECTOR>)
 378                                     (,M$$T-BYT <EMPTY? .IBUF:BYTES>)>>
 379                          <SET DONE 0>
 380                          <CASE ,==? .PT
 381                           (,M$$T-STR
 382                            <SET TRANS <MIN .LEN <LENGTH .IBUF:STRING>>>
 383                            <SUBSTRUC .BUFFER:STRING 0 .TRANS .IBUF:STRING>
 384                            <SET RD <+ .RD .TRANS>>
 385                            <SET LEN <- .LEN .TRANS>>
 386                            <SET BUFFER <REST .BUFFER:STRING .TRANS>>
 387                            <NS-WRITE-BUF? .DATA T>
 388                            <NS-BUF .DATA <SET IBUF <REST .IBUF:STRING .TRANS>>>
 389                            <NS-PTR .DATA <+ <NS-PTR .DATA> .TRANS>>
 390                            <NS-BC .DATA <MAX 0 <- <NS-BC .DATA> .TRANS>>>
 391                            <NS-OBC .DATA
 392                                    <MAX <NS-OBC .DATA>
 393                                         <- .TIB <LENGTH .IBUF:STRING>>>>)
 394                           (,M$$T-UVC
 395                            <SET TRANS <MIN .LEN <LENGTH .IBUF:UVECTOR>>>
 396                            <SUBSTRUC .BUFFER:UVECTOR 0 .TRANS .IBUF:UVECTOR>
 397                            <SET RD <+ .RD .TRANS>>
 398                            <SET LEN <- .LEN .TRANS>>
 399                            <SET BUFFER <REST .BUFFER:UVECTOR .TRANS>>
 400                            <NS-WRITE-BUF? .DATA T>
 401                            <NS-BUF .DATA
 402                                    <SET IBUF <REST .IBUF:UVECTOR .TRANS>>>
 403                            <NS-PTR .DATA <+ <NS-PTR .DATA> .TRANS>>
 404                            <NS-BC .DATA <MAX 0 <- <NS-BC .DATA> .TRANS>>>
 405                            <NS-OBC .DATA
 406                                    <MAX <NS-OBC .DATA>
 407                                         <- .TIB <LENGTH .IBUF:UVECTOR>>>>)
 408                           (,M$$T-BYT
 409                            <SET TRANS <MIN .LEN <LENGTH .IBUF:BYTES>>>
 410                            <SUBSTRUC .BUFFER:BYTES 0 .TRANS .IBUF:BYTES>
 411                            <SET RD <+ .RD .TRANS>>
 412                            <SET LEN <- .LEN .TRANS>>
 413                            <SET BUFFER <REST .BUFFER:BYTES .TRANS>>
 414                            <NS-WRITE-BUF? .DATA T>
 415                            <NS-BUF .DATA <SET IBUF <REST .IBUF:BYTES .TRANS>>>
 416                            <NS-PTR .DATA <+ <NS-PTR .DATA> .TRANS>>
 417                            <NS-BC .DATA <MAX 0 <- <NS-BC .DATA> .TRANS>>>
 418                            <NS-OBC .DATA
 419                                    <MAX <NS-OBC .DATA>
 420                                         <- .TIB <LENGTH .IBUF:BYTES>>>>)>)>
 421                   <COND (<NOT <0? .LEN>>
 422                          <I$FLUSH-BUFFER .DATA>
 423                          <COND (<G? .LEN .TIB>
 424                                 <SET TRANS
 425                                      <I$DO-SOUT .JFN .BUFFER .LEN>>
 426                                 <NS-SPTR .DATA <+ <NS-SPTR .DATA> .TRANS>>
 427                                 <NS-PTR .DATA <+ <NS-PTR .DATA> .TRANS>>
 428                                 <RETURN <+ .TRANS .RD>>)
 429                                (<SET IBUF <NS-BUF .DATA>>)>)
 430                         (<RETURN .RD>)>>)>>
 431
 432 \\f
 433
 434 <DEFINE X$DISK-ACCESS (CHANNEL OPER "OPTIONAL" PTR
 435                     "AUX" (DATA <T$CHANNEL-DATA .CHANNEL>) (JFN <NS-JFN .DATA>)
 436                           (OPTR <NS-PTR .DATA>) (BUF <NS-BUF .DATA>) INC TL L
 437                           (PT <ANDB <CALL TYPE .BUF> ,M$$TYSAT>))
 438         #DECL ((CHANNEL) T$CHANNEL (DATA) I$DISK-CHANNEL
 439                (TL L OPTR JFN INC) FIX (PTR) <OR FIX FALSE>)
 440         <COND (.BUF
 441                <CASE ,==? .PT
 442                      (,M$$T-STR
 443                       <SET L <LENGTH .BUF:STRING>>
 444                       <SET TL <LENGTH <NS-TBUF .DATA>:STRING>>)
 445                      (,M$$T-UVC
 446                       <SET L <LENGTH .BUF:UVECTOR>>
 447                       <SET TL <LENGTH <NS-TBUF .DATA>:UVECTOR>>)
 448                      (,M$$T-BYT
 449                       <SET L <LENGTH .BUF:BYTES>>
 450                       <SET TL <LENGTH <NS-TBUF .DATA>:BYTES>>)>)>
 451         <COND (<OR <NOT <ASSIGNED? PTR>>
 452                    <NOT .PTR>>
 453                <SET PTR .OPTR>)
 454               (<==? .PTR .OPTR>)
 455               (<AND .BUF
 456                     <G=? .PTR <- .OPTR <- .TL .L>>>
 457                     <L=? .PTR <+ .OPTR <NS-BC .DATA>>>>
 458                <COND (<G? .PTR .OPTR>
 459                       <NS-BC .DATA <- <NS-BC .DATA> <SET INC <- .PTR .OPTR>>>>
 460                       <CASE ,==? .PT
 461                             (,M$$T-STR
 462                              <NS-BUF .DATA <REST .BUF:STRING .INC>>)
 463                             (,M$$T-BYT
 464                              <NS-BUF .DATA <REST .BUF:BYTES .INC>>)
 465                             (,M$$T-UVC
 466                              <NS-BUF .DATA <REST .BUF:UVECTOR .INC>>)>)
 467                      (T
 468                       <NS-BUF .DATA
 469                               <CALL BACKU .BUF <SET INC <- .OPTR .PTR>>>>
 470                       <NS-BC .DATA <+ <NS-BC .DATA> .INC>>)>
 471                <NS-PTR .DATA .PTR>)
 472               (T
 473                <I$FLUSH-BUFFER .DATA>
 474                <CALL SYSOP SFPTR .JFN .PTR>
 475                <COND (<==? .PTR -1>
 476                       <SET PTR <CALL SYSOP RFPTR .JFN '(RETURN 2)>>)>
 477                <NS-PTR .DATA .PTR>
 478                <NS-SPTR .DATA .PTR>)>
 479         .PTR>
 480
 481 <DEFINE X$DISK-BUFOUT (CHANNEL OPER "OPTIONAL" (FORCE? T)
 482                        "AUX" (DATA <T$CHANNEL-DATA .CHANNEL>))
 483         #DECL ((CHANNEL) T$CHANNEL (DATA) I$DISK-CHANNEL
 484                (FORCE?) <OR ATOM FALSE>)
 485         <COND (<NS-WRITE-BUF? .DATA>
 486                <I$FLUSH-BUFFER .DATA>)>
 487         <COND (.FORCE?
 488                <T$CLOSE-OPEN <NS-JFN .DATA> <NS-MODE .DATA> <NS-BSZ .DATA>>)>
 489         <COND (<0? <ANDB <NS-MODE .DATA> ,OF-APP>>
 490                <CALL SYSOP SFPTR <NS-JFN .DATA> <NS-SPTR .DATA>>)>
 491         .CHANNEL>
 492
 493 <DEFINE X$DISK-FILE-LENGTH (CHANNEL:T$CHANNEL OPER
 494                             "OPT" (NEW-SIZE:<OR FALSE FIX> <>) (BSZ:FIX 7)
 495                             "AUX" (DATA:I$DISK-CHANNEL
 496                                    <T$CHANNEL-DATA .CHANNEL>))
 497         <COND
 498          (.NEW-SIZE
 499           <COND (<==? .NEW-SIZE -1>
 500                  <BIND (PGS MULT)
 501                    <SET PGS <CALL SYSOP SIZEF <NS-JFN .DATA> '(RETURN 3)>>
 502                    <SET MULT </ 36 .BSZ>>
 503                    <SET NEW-SIZE <* .MULT 512 .PGS>>>)>
 504           <CALL SYSOP CHFDB
 505                 <PUTLHW <NS-JFN .DATA> <ORB *400000* ,/FBBYV>>
 506                 ,FB-BSZ
 507                 <LSH .BSZ 24>>
 508           <CALL SYSOP CHFDB
 509                 <PUTLHW <NS-JFN .DATA> ,/FBSIZ>
 510                 -1
 511                 .NEW-SIZE>
 512           .NEW-SIZE)
 513          (T
 514           <X$DISK-BUFOUT .CHANNEL .OPER T>
 515           <T$GET-BYTE-COUNT <NS-JFN .DATA> <NS-BSZ .DATA>>)>>
 516 \\f
 517
 518 <DEFINE X$DISK-PRINT-DATA (CHANNEL OPER OUTCHAN
 519                           "AUX" (DATA <T$CHANNEL-DATA .CHANNEL>) BUF)
 520   #DECL ((CHANNEL) T$CHANNEL (DATA) I$DISK-CHANNEL)
 521   <PRINC "#DISK-CHANNEL [">
 522   <PRINC "JFN:">
 523   <PRIN1 <NS-JFN .DATA>>
 524   <PRINC " MODE:">
 525   <PRIN1 <NS-MODE .DATA>>
 526   <PRINC " BSZ:">
 527   <PRIN1 <NS-BSZ .DATA>>
 528   <PRINC " PTR:">
 529   <PRIN1 <NS-PTR .DATA>>
 530   <PRINC " SPTR:">
 531   <PRIN1 <NS-SPTR .DATA>>
 532   <PRINC " BUF:">
 533   <COND (<SET BUF <NS-BUF .DATA>>
 534          <PRIN1 <NS-BC .DATA>>
 535          <PRINC !\/>
 536          <COND (<TYPE? .BUF STRING>
 537                 <PRIN1 <- <LENGTH <NS-TBUF .DATA>>
 538                           <LENGTH <NS-BUF .DATA>>>>
 539                 <PRINC !\/>
 540                 <PRIN1 <LENGTH <NS-BUF .DATA>>>)
 541                (<PRIN1 <- <LENGTH <NS-TBUF .DATA>>
 542                           <LENGTH <NS-BUF .DATA>>>>
 543                 <PRINC !\/>
 544                 <PRIN1 <LENGTH <NS-BUF .DATA>>>)>)
 545         (T
 546          <PRINC "<>">)>
 547   <PRINC !\]>
 548   T>